diff --git a/Ipopt-3.13.4/.coin-or/config.yml b/Ipopt-3.13.4/.coin-or/config.yml new file mode 100644 index 000000000..17c81db6d --- /dev/null +++ b/Ipopt-3.13.4/.coin-or/config.yml @@ -0,0 +1,64 @@ +Description: + Slug: Ipopt + ShortName: Ipopt + LongName: + ShortDescription: A solver for general large-scale nonlinear continuous optimization. + LongDescription: |2 + "Ipopt is an open-source solver for large-scale nonlinear continuous optimization. + It can be used from modeling environments, such as AIMMS, AMPL, GAMS, or Matlab, and it is also available as callable library with interfaces to C++, C, Fortran, Java, and R. + Ipopt uses an interior point method, together with a filter linear search procedure." + Manager: Andreas Waechter + Homepage: https://github.com/coin-or/Ipopt + License: Eclipse Public License 2.0 + LicenseURL: http://www.opensource.org/licenses/EPL-2.0 + Appveyor: + Slug: ipopt-5qaur + Language: + - C++ + Categories: + - Optimization deterministic nonlinear + +Dependencies: + - Description: ThirdParty wrapper for building ASL + URL: https://github.com/coin-or-tools/ThirdParty-ASL + Version: stable/2.0 + Required: Optional + - Description: ThirdParty wrapper for building Mumps + URL: https://github.com/coin-or-tools/ThirdParty-Mumps + Version: stable/2.1 + Required: Optional + - Description: ThirdParty wrapper for building HSL codes + URL: https://github.com/coin-or-tools/ThirdParty-HSL + Version: stable/2.1 + Required: Optional + - Description: Parallel Sparse Direct Solver from Pardiso-Project + URL: http://www.pardiso-project.org/ + Required: Optional + - Description: Parallel Sparse Direct Solver from Intel MKL + URL: https://software.intel.com/content/www/us/en/develop/tools/math-kernel-library.html + Required: Optional + - Description: Watson Sparse Matrix Package + URL: http://researcher.ibm.com/view_project.php?id=1426 + Required: Optional + - Description: Basic Linear Algebra Subroutines (BLAS) + URL: http://www.netlib.org/blas + Required: Required + - Description: Linear Algebra Package (LAPACK) + URL: http://www.netlib.org/lapack + Required: Required + +DevelopmentStatus: + activityStatus: Active + maturityLevel: 5 + testedPlatforms: + - operatingSystem: Linux + compiler: gcc + - operatingSystem: macOS + compiler: + - gcc + - clang + - operatingSystem: Microsoft Windows with MSys2 + compiler: + - gcc + - cl+ifort + - icl+ifort diff --git a/Ipopt-3.13.4/.gitattributes b/Ipopt-3.13.4/.gitattributes new file mode 100644 index 000000000..fd60f9b8b --- /dev/null +++ b/Ipopt-3.13.4/.gitattributes @@ -0,0 +1,4 @@ +# Set the default behavior, in case people don't have core.autocrlf set. +# This should usually take care of everything, but to be sure, we setup +# extra rules below. +* text=auto diff --git a/Ipopt-3.13.4/.gitignore b/Ipopt-3.13.4/.gitignore new file mode 100644 index 000000000..143773d5c --- /dev/null +++ b/Ipopt-3.13.4/.gitignore @@ -0,0 +1,25 @@ +.DS_Store +Desktop.ini + +# Thumbnail cache files +._* +Thumbs.db + +# Files that might appear on external disks +.Spotlight-V100 +.Trashes + +# Compiled Python files +*.pyc + +# Compiled C++ files +*.out + +# Application specific files +venv/ +node_modules/ +.idea/ +cmake-*/ + +# Project specific +.coin-or/ diff --git a/Ipopt-3.13.4/.gitmodules b/Ipopt-3.13.4/.gitmodules new file mode 100644 index 000000000..e69de29bb diff --git a/Ipopt-3.13.4/.travis.yml b/Ipopt-3.13.4/.travis.yml new file mode 100644 index 000000000..b20160b2a --- /dev/null +++ b/Ipopt-3.13.4/.travis.yml @@ -0,0 +1,77 @@ +language: cpp + +matrix: + include: + - os: linux + addons: + apt: + packages: + - gfortran + - liblapack-dev + - libmetis-dev + env: ENABLEDEBUG=true + - os: linux + dist: bionic + addons: + apt: + packages: + - gfortran + - liblapack-dev + - libmetis-dev + env: VISHIDDEN=true + - os: osx + osx_image: xcode11.3 + env: OSX=10.14 VISHIDDEN=true + compiler: clang + - os: osx + osx_image: xcode11 + env: OSX=10.14 VISHIDDEN=true NOF77=true + compiler: clang + +before_script: + - export VISHIDDEN=${VISHIDDEN:-false} + - export NOF77=${NOF77:-false} + - export ENABLEDEBUG=${ENABLEDEBUG:-false} + - if [[ "$TRAVIS_OS_NAME" == "osx" ]] && ! $NOF77; then brew update; brew install bash gcc metis; export CC=gcc-9 ; export CXX=g++-9 ; $CC --version; $CXX --version; gfortran --version; fi + +script: + - git clone --depth 1 --branch stable/2.0 https://github.com/coin-or-tools/ThirdParty-ASL + - pushd ThirdParty-ASL && ./get.ASL && ./configure --prefix=$HOME/install && make && make install && popd + - if $NOF77 ; then echo "Skipping Mumps build." ; else git clone --depth 1 --branch stable/2.1 https://github.com/coin-or-tools/ThirdParty-Mumps ; pushd ThirdParty-Mumps && ./get.Mumps && ./configure --prefix=$HOME/install && make && make install && popd ; fi + - mkdir build + - pushd build + - export ADD_CFLAGS="-Wall -Wextra -Werror" + - export ADD_CXXFLAGS="-Wall -Wextra -Werror" + - if $VISHIDDEN ; then ADD_CFLAGS="$ADD_CFLAGS -fvisibility=hidden" ; fi + - if $VISHIDDEN ; then ADD_CXXFLAGS="$ADD_CXXFLAGS -fvisibility=hidden" ; fi + - export CFGFLAGS="" + - if $NOF77 ; then CFGFLAGS="$CFGFLAGS --disable-f77" ; fi + - if $ENABLEDEBUG ; then CFGFLAGS="$CFGFLAGS --enable-debug --with-ipopt-checklevel=5 --with-ipopt-verbosity=5" ; fi + - ../configure --prefix=$HOME/install $CFGFLAGS + - make + - if $NOF77 ; then echo "skip test as no linear solver" ; else make test ; fi + - make install + - pushd examples/Cpp_example + - make + - if ! $NOF77 ; then ./cpp_example ; fi + - popd + - pushd examples/hs071_c + - make + - if ! $NOF77 ; then ./hs071_c ; fi + - popd + - pushd examples/hs071_cpp + - make + - if ! $NOF77 ; then ./hs071_cpp ; fi + - popd + - if ! $NOF77 ; then pushd examples/hs071_f && make && ./hs071_f && popd ; fi + - pushd examples/ScalableProblems + - make + - if ! $NOF77 ; then ./solve_problem MBndryCntrl1 10 ; fi + - popd + - pushd examples/recursive_nlp + - make + - if ! $NOF77 ; then ./recursive_nlp ; fi + - popd + +after_failure: + - find . -name config.log -exec tail -n 1000 {} \; diff --git a/Ipopt-3.13.4/AUTHORS b/Ipopt-3.13.4/AUTHORS new file mode 100644 index 000000000..76b5534b2 --- /dev/null +++ b/Ipopt-3.13.4/AUTHORS @@ -0,0 +1,142 @@ +Main authors: + +Andreas Waechter, project leader (IBM) +Carl Laird (IBM, Carnegie Mellon University) + + +Contributors: + +- Yoshiaki Kawajiri (Carnegie Mellon Univeristy): + First version of Latex documentation file + + Docs/documentation.tex + +- Olaf Schenk (University of Basel): + Modifications to the PARDISO interface in the files + + Algorithm/LinearSolvers/IpPardisoSolverInterface.cpp + Algorithm/LinearSolvers/IpPardisoSolverInterface.hpp + +- Michael Hagemann (University of Basel): + MA57 interface + + Algorithm/LinearSolvers/IpMa57SolverInterface.cpp + Algorithm/LinearSolvers/IpMa57SolverInterface.hpp + +- Damien Hocking (KBC Advanced Technologies) + MUMPS interface + + Algorithm/LinearSolvers/IpMumpsSolverInterface.cpp + Algorithm/LinearSolvers/IpMumpsSolverInterface.hpp + +- Jon Lee (IBM Research) + example nl file (writting by hand) for unitTest + + Test/mytoy.nl + +- Peter Carbonetto (University of British Columbia) + Matlab interface + + [removed from Ipopt source as unmaintained] + +- Rafael de Pelegrini Soares (VRTech Industrial Technologies) + and Tong Kewei (Beihang University, Beijing) + Java interface files + + contrib/JavaInterface + src/Interfaces/IpStdJInterface.cpp + src/Interfaces/Ipopt.java + examples/hs071_java/HS071.java + examples/ScalableProblems_java/*.java + +- Lifeng Chen/Zaiwen Wen (Columbia University) + Changes and additions to the implementation of the Chen-Goldfarb + penalty function algorithm + + src/contrib/CGPenalty/IpCGPenaltyCq.cpp + src/contrib/CGPenalty/IpCGPenaltyCq.hpp + src/contrib/CGPenalty/IpCGPenaltyData.cpp + src/contrib/CGPenalty/IpCGPenaltyData.hpp + src/contrib/CGPenalty/IpCGPenaltyLSAcceptor.cpp + src/contrib/CGPenalty/IpCGPenaltyLSAcceptor.hpp + src/contrib/CGPenalty/IpCGPenaltyRegOp.cpp + src/contrib/CGPenalty/IpCGPenaltyRegOp.hpp + src/contrib/CGPenalty/IpCGPerturbationHandler.cpp + src/contrib/CGPenalty/IpCGPerturbationHandler.hpp + src/contrib/CGPenalty/IpCGSearchDirCalc.cpp + src/contrib/CGPenalty/IpCGSearchDirCalc.hpp + src/contrib/CGPenalty/IpPiecewisePenalty.cpp + src/contrib/CGPenalty/IpPiecewisePenalty.hpp + +- Stefan Vigerske (GAMS) + Dynamic loading of linear solver shared libraries + + src/contrib/LinearSolverLoader/HSLLoader.c + src/contrib/LinearSolverLoader/HSLLoader.h + src/contrib/LinearSolverLoader/LibraryHandler.c + src/contrib/LinearSolverLoader/LibraryHandler.h + src/contrib/LinearSolverLoader/PardisoLoader.c + src/contrib/LinearSolverLoader/PardisoLoader.h + +- Marcel Roelofs (AIMMS) + MSVC project files for Intel Fortran compiler, creating a DLL + + [removed from Ipopt source as unmaintained] + +- Jonathan Hogg (STFC Rutherford Appleton Laboratory) + MA77 interface + + src/Algorithm/LinearSolvers/hsl_ma77d.h + src/Algorithm/LinearSolvers/IpMa77SolverInterface.hpp + src/Algorithm/LinearSolvers/IpMa77SolverInterface.cpp + + MA86 interface + + src/Algorithm/LinearSolvers/hsl_ma86d.h + src/Algorithm/LinearSolvers/hsl_mc68i.h + src/Algorithm/LinearSolvers/IpMa86SolverInterface.hpp + src/Algorithm/LinearSolvers/IpMa86SolverInterface.cpp + + MA97 interface + + src/Algorithm/LinearSolvers/hsl_ma97d.h + src/Algorithm/LinearSolvers/IpMa97SolverInterface.hpp + src/Algorithm/LinearSolvers/IpMa97SolverInterface.cpp + +- Hans Pirnay (RWTH Aachen) + Rodrigo Lopez-Negrete (Carnegie Mellon University) + + Sensitivity Based on IPOPT + + contrib/sIPOPT (formerly called contrib/AsNMPC) + +- Jelmer Ypma (University College London) + R interface with examples, all files in directory (and subdirectory of) + + contrib/RInterface + +- Tony Kelman (Berkeley) + improvements to Matlab interface + + Ipopt/contrib/MatlabInterface + +- Gabriel Hackebeil + improved use compound component spaces + +- Nai-Yuan Chiang and Victor M. Zavala Tejeda (Argonne National Laboratory) + inertia free curvature test in solution of primal-dual system (full approach) + +- Brad Bell + recursive NLP example + + examples/recursive_nlp/recursive_nlp.cpp + +Contributors of code that is no longer included in Ipopt distribution: + +- Yifan Hu (Wolfram): Contributed TAUCS interface, implemented in the files + + PDSystemImpl/PDFullSpace/IpTAUCSSolverInterface.hpp + PDSystemImpl/PDFullSpace/IpTAUCSSolverInterface.cpp + + [These files have been removed, since TAUCS is not supported] + diff --git a/Ipopt-3.13.4/CMakeLists.txt b/Ipopt-3.13.4/CMakeLists.txt new file mode 100644 index 000000000..d789b404d --- /dev/null +++ b/Ipopt-3.13.4/CMakeLists.txt @@ -0,0 +1,703 @@ +cmake_minimum_required(VERSION 2.8) +project(IpOpt) + +# FUNNY_LAPACK_FINT + +#undef HAVE_MPI_INITIALIZED - Define to 1 if you have the `MPI_Initialized' function. + +option(COIN_ENABLE_READLINE "Enable the use of the readline library" OFF) + +option(IPOPT_HAS_AMPL "Enable Ampl interface" OFF) +option(IPOPT_HAS_PARDISO "Enable Pardiso solver" OFF) +option(IPOPT_HAS_PARDISO_MKL "Enable if you are using Pardiso from MKL" OFF) +option(IPOPT_HAS_PARDISO_OLDINTERFACE "Enable if you are not using at least a 4.0 version of Pardiso" OFF) +option(IPOPT_HAS_PARDISO_PARALLEL "Enable if you are using the parallel version of Pardiso" OFF) +option(IPOPT_HAS_HSL "Enable HSL interface" OFF) +option(IPOPT_HAS_WSMP "Enable WSMP solver" OFF) +option(IPOPT_HAS_MUMPS "Enable Mumps solver" ON) +option(IPOPT_BUILD_EXAMPLES "Enable the building of examples" OFF) +option(IPOPT_ENABLE_LINEARSOLVERLOADER "Build the dynamic linear solver loader" OFF) +option(IPOPT_ENABLE_PARDISOSOLVERLOADER "Build the dynamic pardiso solver loader" OFF) +option(IPOPT_ENABLE_INEXACT "Build the inexact solver" OFF) + +set(IPOPT_CHECKLEVEL "0" CACHE STRING "The debug sanity check level of IpOpt (0 if no test)") +set(IPOPT_VERBOSITY "0" CACHE STRING "The debug verbosity level of IpOpt (0 if no output)") + +set(IPOPT_HAS_MUMPS ON CACHE BOOL "Enable the Mumps linear solver (default solver enabled)" FORCE) +set(IPOPT_HAS_MUMPS_INCLUDE_PATH "None" CACHE PATH "The MUMPS linear solver include Path") +set(IPOPT_HAS_MUMPS_LIBRARY_PATH "None" CACHE PATH "The MUMPS linear solver absolute library Path") + +set(IPOPT_HAS_WSMP OFF CACHE BOOL "Enable the WSMP linear solver" FORCE) +set(COIN_HAS_WSMP_INCLUDE_PATH "None" CACHE PATH "The WSMP linear solver include Path") +set(COIN_HAS_WSMP_LIBRARY_PATH "None" CACHE PATH "The WSMP linear solver absolute library Path") + +# Compilation options +option(IPOPT_BUILD_SHARED_LIBS "Build libraries as shared libraries" OFF) +option(COIN_COMPILE_STATIC "Activate the static linking" ON) +option(COIN_COMPILE_COVERAGE "Activate the code coverage compilation" OFF) +option(COIN_COMPILE_PROFILE "Activate the code profiling compilation" OFF) +option(COIN_COMPILE_PROFILE_VALGRIND "Activate the code profiling compilation for valgrind" OFF) +option(COIN_COMPILE_LTO "Activate the whole program optimization" OFF) # GCC macOS does not support this +option(COIN_HAS_MKL "Use Intel MKL library (requires Intel compiler)" OFF) +option(COIN_USE_FAST_CODE "Use intensive optimization flags" ON) +option(COIN_COMPILE_WARNINGS "Activate a set of warning options" OFF) +option(COIN_COMPILE_CXX11 "Activate C++11 compilation" ON) +option(COIN_TESTS_DISABLE_TIMEOUT "Disable the timeout of the tests" OFF) +option(COIN_ENABLE_DOXYGEN "Enable the build of doxygen documentation" OFF) + +option(USE_PROCESSOR_EXTENSIONS "Use sse / mmx / avx extensions during compilation" OFF) +option(COIN_ENABLE_COMPAT "Enable libc compatibility" OFF) # Do not compile if ON + +# Set paths of source +set(COIN_DIR "${CMAKE_CURRENT_SOURCE_DIR}" CACHE PATH "The Cbc Path") + +set(COIN_COVERAGE_CTEST_LABEL "SAMPLE" CACHE PATH "The label sent to ctest during coverage") + +mark_as_advanced(COIN_ENABLE_READLINE + COIN_COMPILE_STATIC + COIN_COMPILE_COVERAGE + COIN_COMPILE_PROFILE + COIN_COMPILE_PROFILE_VALGRIND + COIN_COMPILE_LTO + COIN_HAS_MKL + COIN_USE_FAST_CODE + COIN_COMPILE_WARNINGS + COIN_COMPILE_CXX11 + IPOPT_HAS_MUMPS + IPOPT_HAS_MUMPS_INCLUDE_PATH + IPOPT_HAS_MUMPS_LIBRARY_PATH + IPOPT_HAS_WSMP + COIN_HAS_WSMP_INCLUDE_PATH + COIN_HAS_WSMP_LIBRARY_PATH + COIN_DIR + IPOPT_HAS_PARDISO_MKL + IPOPT_HAS_PARDISO_OLDINTERFACE + IPOPT_HAS_PARDISO_PARALLEL + IPOPT_CHECKLEVEL + IPOPT_VERBOSITY + USE_PROCESSOR_EXTENSIONS + COIN_COVERAGE_CTEST_LABEL) + +# Set paths for binary and library generation inside the build directory: +# set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/bin) +# set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/bin) +# set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/bin) + +set(CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} + ${CMAKE_CURRENT_SOURCE_DIR}/cmake) + +if (COIN_COMPILE_CXX11) + set (CMAKE_CXX_STANDARD 11) +endif () + +include(coin-macros) +include(GetAcInitVersion) +include(CheckCLinkerFlag) +include(GNUInstallDirs) + +Enable_Testing () + +#------------------------------------------------------------ +# Check options +#------------------------------------------------------------ + +if (IPOPT_ENABLE_INEXACT AND NOT (IPOPT_HAS_PARDISO OR IPOPT_HAS_PARDISO_MKL OR IPOPT_HAS_PARDISO_OLDINTERFACE OR IPOPT_HAS_PARDISO_PARALLEL)) + message(FATAL_ERROR "Error: Inexact solver is only available through MKL. Please activate the MKL") +endif () + +# if (NOT IPOPT_ENABLE_INEXACT) +# message(WARNING "If you have MKL, you can activate IPOPT_ENABLE_INEXACT") +# endif () + +#------------------------------------------------------------ +# Detect 64 bits +#------------------------------------------------------------ + +if (CMAKE_SIZEOF_VOID_P EQUAL 4) + set(HAVE_64_BIT 0) +else () + set(HAVE_64_BIT 1) +endif () + +# Various definitions + +# Name of package +set(PACKAGE "IpOpt") +# Define to the address where bug reports for this package should be sent. +set(PACKAGE_BUGREPORT "bugs@coin-or.org") +# Define to the full name of this package. +set(PACKAGE_NAME "IpOpt") +# Define to the full name and version of this package. +set(PACKAGE_STRING "IpOpt") +# Define to the one symbol short name of this package. +set(PACKAGE_TARNAME "ipopt") + +if (CMAKE_INSTALL_PREFIX_INITIALIZED_TO_DEFAULT) + set(CMAKE_INSTALL_PREFIX "${CMAKE_CURRENT_BINARY_DIR}/ipopt_binary" + CACHE PATH "IpOpt install prefix" FORCE) +endif () + +include(CheckCCompilerFlag) +if (COIN_COMPILE_LTO) + if (NOT CMAKE_VERSION VERSION_LESS "3.9") + cmake_policy(SET CMP0069 NEW) + include(CheckIPOSupported) + check_ipo_supported() + endif () +endif () + +if (COIN_ENABLE_COMPAT) + # Disable extra stdc++ symbols (@GLIBCXX_3.4.21) + add_definitions(-D_GLIBCXX_USE_CXX11_ABI=0) + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -include ${CMAKE_CURRENT_SOURCE_DIR}/cmake/compatibility.h") + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -include ${CMAKE_CURRENT_SOURCE_DIR}/cmake/compatibility.h") +endif () + +# Desactivate some relocation types for portability +if (UNIX AND COIN_ENABLE_COMPAT) + check_c_compiler_flag("-Wa,-mrelax-relocations=no" HAVE_RELAX_RELOC_FLAG) + if (HAVE_RELAX_RELOC_FLAG) + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -Wa,-mrelax-relocations=no") + endif () +endif () + +# Check for readline +set(COIN_HAS_READLINE "OFF") +if (COIN_ENABLE_READLINE) + find_package(Readline) + if (READLINE_FOUND) + set(COIN_HAS_READLINE "ON") + + include_directories(${READLINE_INCLUDE_DIR}) + endif () +endif () + +if (USE_PROCESSOR_EXTENSIONS) + # Check for SSE* and AVX* + find_package(SSE) + if (MMX_FOUND OR + SSE2_FOUND OR SSE3_FOUND OR SSSE3_FOUND OR SSE4_1_FOUND OR SSE4_2_FOUND OR + AVX_FOUND OR AVX2_FOUND) + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} ${SSE_COMPILER_FLAGS}") + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} ${SSE_COMPILER_FLAGS}") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${SSE_COMPILER_FLAGS}") + endif () +endif () + +# Check for MKL +if (COIN_HAS_MKL) + find_package(MKL) + + if (MKL_FOUND) + message(STATUS "MKL library found") + else () + message(STATUS "MKL library not found") + endif () + + # Copy libiomp5md.dll in the build directory + if (WIN32) + if (HAVE_64_BIT) + set(MKL_DLL_DIR ${MKL_ROOT}/bin/intel64) + else () + set(MKL_DLL_DIR ${MKL_ROOT}/bin/ia32) + endif () + + execute_process(COMMAND ${CMAKE_COMMAND} -E make_directory ${CMAKE_CURRENT_BINARY_DIR}/bin/ + COMMAND ${CMAKE_COMMAND} -E copy ${MKL_DLL_DIR}/libiomp5md.dll ${CMAKE_CURRENT_BINARY_DIR}/bin/ + COMMAND ${CMAKE_COMMAND} -E echo "Copying ${MKL_DLL_DIR}/libiomp5md.dll into ${CMAKE_CURRENT_BINARY_DIR}/bin/") + endif () + + set(COIN_MKL_LIBS "${MKL_LIBRARIES}") + if (WIN32) + set(COIN_MKL_LIBS ${COIN_MKL_LIBS} mkl_intel_thread libiomp5md) + else () + set(COIN_MKL_LIBS ${COIN_MKL_LIBS} mkl_gnu_thread gomp dl) + endif () + + include_directories(${MKL_INCLUDE_DIRS}) + + if (HAVE_64_BIT) + link_directories(${MKLROOT_PATH}/mkl/lib/intel64) + else () + link_directories(${MKLROOT_PATH}/mkl/lib/ia32) + endif () + + set(IPOPT_HAS_LAPACK ON CACHE BOOL "Use Intel MKL library (requires Intel compiler)") +endif () + +# Check some directories + +coin_check_and_add_include_path(IPOPT_HAS_MUMPS_INCLUDE_PATH) +coin_check_and_add_library_path(IPOPT_HAS_MUMPS_LIBRARY_PATH) +coin_check_and_add_include_path(COIN_HAS_WSMP_INCLUDE_PATH) +coin_check_and_add_library_path(COIN_HAS_WSMP_LIBRARY_PATH) + +#----------------------------------------------------------------------------- +# Manage compilation options +#----------------------------------------------------------------------------- + +if (UNIX) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-deprecated") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -Wno-deprecated") + + if (NOT IPOPT_BUILD_SHARED_LIBS) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fPIC") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -fPIC") + endif () + if (COIN_COMPILE_WARNINGS) + # Try to locate unitizalized variables + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wall -Wshadow -Wuninitialized ") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -Wall -Wshadow -Wmissing-prototypes -Wuninitialized ") + endif () + if (COIN_COMPILE_STATIC) + if (CMAKE_CXX_COMPILER_ID STREQUAL "GNU" AND NOT APPLE) + set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} -static") + + check_c_linker_flag("-z muldef" ZFLAGDEFINED) + if (ZFLAGDEFINED) + set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} -z muldefs") + endif () + endif () + endif () + if (COIN_COMPILE_COVERAGE) + if (CMAKE_CXX_COMPILER_ID STREQUAL "GNU") + set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} -O0 --coverage") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -O0 --coverage") + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -O0 --coverage") + endif () + if (CMAKE_CXX_COMPILER_ID STREQUAL "Clang") + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fprofile-arcs -ftest-coverage -Xclang -coverage-cfg-checksum -Xclang -coverage-no-function-names-in-data -Xclang -coverage-version='408*'") + endif () + endif () + if (COIN_COMPILE_PROFILE) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -pg") + set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} -pg") + endif () + if (COIN_COMPILE_PROFILE_VALGRIND) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -p") + set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} -p") + else () + if (CMAKE_CXX_COMPILER_ID STREQUAL "GNU" AND NOT APPLE) + check_c_linker_flag("-z muldef" ZFLAGDEFINED) + if (ZFLAGDEFINED) + set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} -z muldefs") + endif () + endif () + endif () +endif () + +#----------------------------------------------------------------------------- +# Manage specific VS flags +#----------------------------------------------------------------------------- + +if (MSVC) + # Avoid Warning C4530 by using the flag /EHsc + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} /EHsc ") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} /EHsc ") +endif () + +#----------------------------------------------------------------------------- +# Manage threads include dir under Windows +#----------------------------------------------------------------------------- + +if (MSVC) + if (NOT COIN_THREADS_INC_PATH STREQUAL "None") + include_directories(${COIN_THREADS_INC_PATH}) + endif () + if (NOT COIN_THREADS_LIB_PATH STREQUAL "None") + link_directories(${COIN_THREADS_LIB_PATH}) + endif () +endif () + +# Check for a fortran compiler +enable_language(Fortran) +# include(CMakeDetermineFortranCompiler) +if (NOT CMAKE_Fortran_COMPILER) + message(STATUS "WARNING: fortran compiler not found. Disabling f77/f95 bindings") +endif () + +# Define IPOPT_FORTRAN_INTEGER_TYPE for Ipopt. +set(IPOPT_FORTRAN_INTEGER_TYPE int) + +#----------------------------------------------------------------------------- +# Detect name mangling convention used between Fortran and C +#----------------------------------------------------------------------------- + +if (CMAKE_Fortran_COMPILER) + enable_language(Fortran) + + include(FortranCInterface) + + FortranCInterface_HEADER(${CMAKE_CURRENT_BINARY_DIR}/F77Mangle.h + MACRO_NAMESPACE "F77_" + SYMBOL_NAMESPACE "F77_") + + file(STRINGS ${CMAKE_CURRENT_BINARY_DIR}/F77Mangle.h CONTENTS REGEX "F77_GLOBAL\\(.*,.*\\) +(.*)") + string(REGEX MATCH "F77_GLOBAL\\(.*,.*\\) +(.*)" RESULT ${CONTENTS}) + set(F77_FUNC "F77_FUNC(name,NAME) ${CMAKE_MATCH_1}") + set(IPOPT_LAPACK_FUNC "IPOPT_LAPACK_FUNC(name,NAME) ${CMAKE_MATCH_1}") + + file(STRINGS ${CMAKE_CURRENT_BINARY_DIR}/F77Mangle.h CONTENTS REGEX "F77_GLOBAL_\\(.*,.*\\) +(.*)") + string(REGEX MATCH "F77_GLOBAL_\\(.*,.*\\) +(.*)" RESULT ${CONTENTS}) + set(F77_FUNC_ "F77_FUNC_(name,NAME) ${CMAKE_MATCH_1}") + set(IPOPT_LAPACK_FUNC_ "IPOPT_LAPACK_FUNC_(name,NAME) ${CMAKE_MATCH_1}") +else () + set(F77_FUNC "F77_FUNC(name,NAME) name##_") + set(F77_FUNC_ "F77_FUNC_(name,NAME) name##__") + set(IPOPT_LAPACK_FUNC "IPOPT_LAPACK_FUNC(name,NAME) name##_") + set(IPOPT_LAPACK_FUNC_ "IPOPT_LAPACK_FUNC_(name,NAME) name##__") +endif () + +set(F77_DUMMY_MAIN "" CACHE STRING "Define to dummy 'main' function (if any) required to link to the Fortran libraries.") +set(FC_DUMMY_MAIN "" CACHE STRING "Define to dummy 'main' function (if any) required to link to the Fortran libraries.") +option(FC_DUMMY_MAIN_EQ_F77 "Define if F77 and FC dummy 'main' functions are identical." OFF) + +if (FC_DUMMY_MAIN_EQ_F77) + set(FC_DUMMY_MAIN "${F77_DUMMY_MAIN}") +endif () + +mark_as_advanced(F77_FUNC + F77_FUNC_ + F77_DUMMY_MAIN + FC_DUMMY_MAIN + FC_DUMMY_MAIN_EQ_F77) + +# Manage coverage via lcov automatically + +if (COIN_COMPILE_COVERAGE AND NOT ((CMAKE_BUILD_TYPE MATCHES "Debug") OR (CMAKE_BUILD_TYPE STREQUAL "RelWithDebInfo"))) + message(STATUS "Warning: to enable coverage, you must compile in DEBUG ou RELWITHDEBINFO mode") +endif () + +if (COIN_COMPILE_COVERAGE) + if (WIN32) + message(FATAL_ERROR "Error: code coverage analysis is only available under Linux for now.") + endif () + + find_program(GCOV_PATH gcov) + find_program(LCOV_PATH lcov) + find_program(GENHTML_PATH genhtml) + + if (NOT GCOV_PATH) + message(FATAL_ERROR "gcov not found! Please install lcov and gcov. Aborting...") + endif () + + if (NOT LCOV_PATH) + message(FATAL_ERROR "lcov not found! Please install lcov and gcov. Aborting...") + endif () + + if (NOT GENHTML_PATH) + message(FATAL_ERROR "genhtml not found! Please install lcov and gcov. Aborting...") + endif () + + # /!\ FAILURE IF AT LEAST ONE TEST FAILS + # Capturing lcov counters and generating report + add_custom_target(coverage + COMMAND ${LCOV_PATH} --directory ${CMAKE_CURRENT_BINARY_DIR} --zerocounters + COMMAND ${LCOV_PATH} --capture --initial --directory ${CMAKE_CURRENT_BINARY_DIR} --output-file ${CMAKE_CURRENT_BINARY_DIR}/coverage.info + COMMAND ${CMAKE_COMMAND} -E chdir ${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_CTEST_COMMAND} -LE "(LONG|FAIL)" -L "${COIN_COVERAGE_CTEST_LABEL}" || true + COMMAND ${LCOV_PATH} --capture --directory ${CMAKE_CURRENT_BINARY_DIR} --output-file ${CMAKE_CURRENT_BINARY_DIR}/coverage.info + COMMAND ${LCOV_PATH} --remove ${CMAKE_CURRENT_BINARY_DIR}/coverage.info "*/usr/include/*" '${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/*' --output-file ${CMAKE_CURRENT_BINARY_DIR}/coverage.info.cleaned + COMMAND ${GENHTML_PATH} -o ${CMAKE_CURRENT_BINARY_DIR}/coverage ${CMAKE_CURRENT_BINARY_DIR}/coverage.info.cleaned + COMMAND ${CMAKE_COMMAND} -E remove ${CMAKE_CURRENT_BINARY_DIR}/coverage.info ${CMAKE_CURRENT_BINARY_DIR}/coverage.info.cleaned + VERBATIM + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} + COMMENT "Resetting code coverage counters to zero. +Processing code coverage counters and generating report. +You can zip the directory ${CMAKE_CURRENT_BINARY_DIR}/coverage and upload the content to a web server.") +endif () + + +# Directories where to find the source code + +set(Ipopt_DIR ${COIN_DIR}) + +# End of coverage + +include(CheckIncludeFileCXX) +include(CheckIncludeFile) +include(VA_COPY) + +check_include_file("assert.h" HAVE_ASSERT_H) +check_include_file("bzlib.h" HAVE_BZLIB_H) +check_include_file("ctype.h" HAVE_CTYPE_H) +check_include_file("dlfcn.h" HAVE_DLFCN_H) +check_include_file("endian.h" HAVE_ENDIAN_H) +check_include_file("float.h" HAVE_FLOAT_H) +check_include_file("ieeefp.h" HAVE_IEEEFP_H) +check_include_file("inttypes.h" HAVE_INTTYPES_H) +check_include_file("math.h" HAVE_MATH_H) +check_include_file("memory.h" HAVE_MEMORY_H) +if (COIN_ENABLE_READLINE) + check_include_file("readline/readline.h" HAVE_READLINE_READLINE_H) +endif () +check_include_file("stdint.h" HAVE_STDINT_H) +check_include_file("stdlib.h" HAVE_STDLIB_H) +check_include_file("stdio.h" HAVE_STDIO_H) +check_include_file("stdarg.h" HAVE_STDARG_H) +check_include_file("stddef.h" HAVE_STDDEF_H) +check_include_file("strings.h" HAVE_STRINGS_H) +check_include_file("string.h" HAVE_STRING_H) +check_include_file("sys/stat.h" HAVE_SYS_STAT_H) +check_include_file("sys/types.h" HAVE_SYS_TYPES_H) +check_include_file("time.h" HAVE_TIME_H) +check_include_file("unistd.h" HAVE_UNISTD_H) +check_include_file("windows.h" HAVE_WINDOWS_H) +check_include_file("zlib.h" HAVE_ZLIB_H) +check_include_file_cxx("cctype" HAVE_CCTYPE) +check_include_file_cxx("cmath" HAVE_CMATH) +check_include_file_cxx("cieeefp" HAVE_CIEEEFP) +check_include_file_cxx("cfloat" HAVE_CFLOAT) +check_include_file_cxx("cinttypes" HAVE_CINTTYPES) +check_include_file_cxx("cassert" HAVE_CASSERT) +check_include_file_cxx("cstdio" HAVE_CSTDIO) +check_include_file_cxx("cstdlib" HAVE_CSTDLIB) +check_include_file_cxx("cstdarg" HAVE_CSTDARG) +check_include_file_cxx("cstddef" HAVE_CSTDDEF) +check_include_file_cxx("cstring" HAVE_CSTRING) +check_include_file_cxx("ctime" HAVE_CTIME) + +string(SUBSTRING ${CMAKE_SHARED_LIBRARY_SUFFIX} 1 -1 SHAREDLIBEXT) + +include(CheckCXXCompilerFlag) + + +check_cxx_compiler_flag(-Qunused-arguments HAVE_QUNUSED_ARGUMENTS) +if (HAVE_QUNUSED_ARGUMENTS) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Qunused-arguments") +endif () + +if (UNIX) + if (CMAKE_CXX_COMPILER_ID STREQUAL "GNU" AND NOT APPLE) + check_cxx_compiler_flag(-Wno-unused-local-typedefs GCC_HAS_TYPEDEFS) + if (GCC_HAS_TYPEDEFS) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-unused-local-typedefs") + endif () + endif () + + if (NOT APPLE) + check_cxx_compiler_flag(-Wno-narrowing GCC_HAS_NARROWING) + if (GCC_HAS_NARROWING) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-narrowing") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -Wno-narrowing") + endif () + endif () +endif () + +include(CheckTypeSize) + +check_type_size("int *" SIZEOF_INT_P) + +include(CheckSymbolExists) +include(CheckCXXSymbolExists) +include(CheckFunctionExists) + +if(COIN_COMPILE_CXX11) + set(IPOPT_C_FINITE std::isfinite) +else() + check_symbol_exists(isfinite "math.h" IPOPT_C_FINITE_R) + if (IPOPT_C_FINITE_R) + set(IPOPT_C_FINITE isfinite) + endif () + + if (NOT IPOPT_C_FINITE_R) + check_symbol_exists(_finite "math.h" IPOPT_C_FINITE_R) + if (IPOPT_C_FINITE_R) + set(IPOPT_C_FINITE _finite) + endif () + endif () + + if (NOT IPOPT_C_FINITE_R) + check_symbol_exists(finite "math.h" IPOPT_C_FINITE_R) + if (IPOPT_C_FINITE_R) + set(IPOPT_C_FINITE finite) + endif () + endif () + + if (NOT IPOPT_C_FINITE_R) + message(WARNING "Cannot find a function for checking Inf.") + endif() +endif() + +check_symbol_exists(clock_gettime time.h HAVE_CLOCK_GETTIME) +check_symbol_exists(gettimeofday sys/time.h HAVE_GETTIMEOFDAY) + +check_function_exists(dran48 IPOPT_HAS_DRAND48) +check_function_exists(rand IPOPT_HAS_RAND) +check_function_exists(snprintf HAVE_SNPRINTF) +check_function_exists(std::rand HAVE_STD__RAND) +check_function_exists(va_copy IPOPT_HAS_VA_COPY) +check_function_exists(vsnprintf HAVE_VSNPRINTF) +check_function_exists(_snprintf HAVE__SNPRINTF) +check_function_exists(_vsnprintf HAVE__VSNPRINTF) + +if (MSVC) + # snprintf not correctly detected under Visual Studio. + # Hack: we just activate snprintf under Windows. + # TO BE FIXED + set(HAVE_STDIO_H 1) + set(HAVE_SNPRINTF 1) + set(HAVE__SNPRINTF 1) + set(HAVE_VSNPRINTF 1) + set(HAVE__VSNPRINTF 1) + set(IPOPT_HAS_VA_COPY 1) +endif () + +if (COIN_USE_FAST_CODE) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fomit-frame-pointer ") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -fomit-frame-pointer ") + + if (CMAKE_CXX_COMPILER_ID STREQUAL "Intel") + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fno-math-errno -fp-trap=none ") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -fno-math-errno -fp-trap=none ") + endif () + + if (CMAKE_CXX_COMPILER_ID STREQUAL "GNU") + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -ffast-math -fno-math-errno -fno-trapping-math ") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -ffast-math -fno-math-errno -fno-trapping-math ") + endif () + +endif () + +include(AC_HEADER_STDC) + +add_definitions(-DHAVE_CONFIG_H) + +if (("${MSVC_VERSION}" STREQUAL "1900") OR ("${MSVC_VERSION}" STREQUAL "1910")) + add_definitions(/DHAVE_SNPRINTF /DHAVE_STRUCT_TIMESPEC) +endif () + +#----------------------------------------------- +# Doxygen documentation +#----------------------------------------------- + +set(coin_doxy_logname ) # output warning to stderr +set(coin_doxy_excludes "*/.git*") +set(coin_doxy_tagfiles ) +set(coin_doxy_tagname ) + +find_package(Doxygen) + +if (DOXYGEN AND COIN_ENABLE_DOXYGEN) + configure_file(${CMAKE_CURRENT_SOURCE_DIR}/doxydoc/doxygen.conf.in ${CMAKE_CURRENT_BINARY_DIR}/doxydoc/doxygen.conf) + + add_custom_target(docs + ${DOXYGEN_EXECUTABLE} ${CMAKE_CURRENT_BINARY_DIR}/doxydoc/doxygen.conf) +endif () + +add_subdirectory(ThirdParty) + +include_directories(${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/include + ${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/include/ampl) +link_directories(${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/lib + ${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/lib64) + +# +# HSL Management +# + +if (COIN_ENABLE_DOWNLOAD_METIS) # METIS found + add_definitions(-DCOINHSL_HAS_METIS) +endif () + +if (IPOPT_ENABLE_LINEARSOLVERLOADER OR IPOPT_ENABLE_PARDISOSOLVERLOADER) + add_definitions(-DHAVE_LINEARSOLVERLOADER) + + find_package(DL) +endif () + +if (IPOPT_HAS_MUMPS) + add_definitions(-DHAVE_MUMPS) + + set(COINHSL_HAS_MUMPS ON) +endif () + +if (IPOPT_HAS_WSMP) + add_definitions(-DHAVE_WSMP) + + set(COINHSL_HAS_WSMP ON) +endif () + +add_subdirectory(Ipopt) + +# +# Packaging +# + +set(CPACK_PACKAGE_NAME "${PACKAGE_NAME}") +set(CPACK_PACKAGE_FILE_NAME "${CPACK_PACKAGE_NAME}-${IPOPT_VERSION}-${CMAKE_SYSTEM_NAME}") + +message(STATUS "Package filename: ${CPACK_PACKAGE_FILE_NAME}") + +set(CPACK_PACKAGE_INSTALL_DIRECTORY "${PACKAGE_NAME}") +set(CPACK_PACKAGE_VERSION "${IPOPT_VERSION}") + +set(CPACK_PACKAGE_RELOCATABLE TRUE) + +if (WIN32) + set(CPACK_PACKAGE_INSTALL_REGISTRY_KEY "${CPACK_PACKAGE_NAME}") + set(CPACK_MONOLITHIC_INSTALL ON) + set(CPACK_NSIS_CONTACT "${PACKAGE_BUGREPORT}") + set(CPACK_NSIS_MODIFY_PATH ON) + set(CPACK_NSIS_PACKAGE_NAME "IpOpt ${IPOPT_VERSION}") +elseif (APPLE) + set(CPACK_COMPONENTS_ALL_IN_ONE_PACKAGE ON) + set(CPACK_PACKAGE_DEFAULT_LOCATION "/opt/${CPACK_PACKAGE_NAME}") + set(CPACK_PACKAGING_INSTALL_PREFIX "/") +else (WIN32) + set(CPACK_COMPONENTS_ALL_IN_ONE_PACKAGE ON) + set(CPACK_PACKAGE_DEFAULT_LOCATION "/opt/${CPACK_PACKAGE_NAME}") + set(CPACK_PACKAGING_INSTALL_PREFIX "/") + + set(CPACK_DEBIAN_PACKAGE_SECTION "Libraries") + set(CPACK_DEBIAN_PACKAGE_MAINTAINER "${PACKAGE_BUGREPORT}") + + set(CPACK_RPM_COMPONENT_INSTALL ON) + set(CPACK_RPM_PACKAGE_RELOCATABLE ON) + set(CPACK_RPM_PACKAGE_LICENSE "Copyrighted") + set(CPACK_RPM_PACKAGE_GROUP "Development/Libraries") + set(CPACK_RPM_PACKAGE_URL "${PACKAGE_URL}") + set(CPACK_RPM_PACKAGE_SUMMARY "IpOpt is a non linear constrained solver library from CoinOR.") + set(CPACK_RPM_PACKAGE_DESCRIPTION + "The CoinUtils suite includes: + + * The IpOpt non linear constrained solver. +" + ) +endif () + +include(CPack) +include(CTest) + +########################### +# # +# Sum-up of configuration # +# # +########################### + +# available colors: {u,b,bg, } black, red, green, yellow, blue, purple, cyan, white, reset + +# color_message("${color_green}") +# color_message("************************") +# color_message("* *") +# color_message("* Configuration sum-up *") +# color_message("* *") +# color_message("************************") +# color_message("${color_reset} ") + +# color_message("${color_cyan}Installation directory:${color_reset} ${CMAKE_INSTALL_PREFIX}") +# color_message("${color_cyan}Build type:${color_reset} ${CMAKE_BUILD_TYPE}") + +# get_directory_property(ALL_INCLUDES INCLUDE_DIRECTORIES) +# get_directory_property(ALL_LINKS LINK_DIRECTORIES) +# get_directory_property(ALL_DEFS COMPILE_DEFINITIONS) + +# message(STATUS "${color_cyan}Include directories:${color_reset} ${ALL_INCLUDES}") +# message(STATUS "${color_cyan}Link directories:${color_reset} ${ALL_LINKS}") +# message(STATUS "${color_cyan}Compilation definitions:${color_reset} ${ALL_DEFS}") + +# +# Install part +# + +install(FILES LICENSE README.md + DESTINATION ${CMAKE_INSTALL_DOCDIR}) diff --git a/Ipopt-3.13.4/ChangeLog b/Ipopt-3.13.4/ChangeLog new file mode 100644 index 000000000..46f60b5fc --- /dev/null +++ b/Ipopt-3.13.4/ChangeLog @@ -0,0 +1,705 @@ +Here we list changes of Ipopt since the release of version 3.0.0. +More detailed information about incremental changes can be found in the +commit history. + +unreleased: 3.13.5 + - Allow to use --without-pardiso to disable check for MKL Pardiso [#454] + (note: name of this option will change to --disable-pardisomkl + with Ipopt 3.14) + +2021-02-24: 3.13.4 + - Fixed a linking issue for ipopt_sens [#418] + - Fixed Makefile for Java example regarding location of jar file + - Fixed build of R interface if using -fvisibility=hidden. + +2020-10-16: 3.13.3 + - Members of AmplTNLP class are now protected instead of private. + - Updated Eclipse Public License from 1.0 to 2.0. + - Fixed dangling pointer problems with Journalist used for debugging + (--with-ipopt-verbosity > 0) when more than one IpoptApplication + is used. [#393, thanks to Brad Bell] + - Fixed build problem when using HSL library that does not include + MA27, MA57, or MC19. [#395] + - Added example recursive_nlp that uses Ipopt to solves an + optimization problem for the evaluation of the objective function. + [contributed by Brad Bell] + - Fixed build of linear-solver loader on Windows [#408] + +2020-04-30: 3.13.2 + - The C-preprocessor defines COIN_IPOPT_CHECKLEVEL, + COIN_IPOPT_VERBOSITY, and FORTRAN_INTEGER_TYPE, which are defined + by IpoptConfig.h, have been renamed to IPOPT_CHECKLEVEL, + IPOPT_VERBOSITY, and IPOPT_FORTRAN_INTEGER_TYPE, respectively. + They are still available under their previous name, but these + will be removed in Ipopt 3.14. + - Changed dependencies as used by coinbrew to use new versions (2.1) + of ThirdParty/HSL and ThirdParty/MUMPS and dropped ThirdParty/Metis. + The new versions of the HSL and MUMPS build scripts now look + for a Metis library in the system and should work with both + Metis 4 and Metis 5. + - Changed location where Java interface jar gets installed from + $libdir to $datadir/java/. + - minor fixes to buildsystem + +2020-03-11: 3.13.1 + - Added asserts that check whether sparsity pattern of Jacobian + and Hessian as returned by TNLP are within range w.r.t. number + of variables and constraints. [#350] + - TNLPAdapter::ResortBnds now initializes complete output arrays + with 0.0 before filling in values for non-fixed variables. Use + new argument clearorig to turn this off. [#352] + - bring back configure variables ADD_{C,CXX,F}FLAGS + - added configure option --enable-relocatable to make prefix in + pkg-config files relative to pcfiledir (assuming that --libdir + hasn't been set) + - bring back configall_system.h for build without config header + - minor fixes to buildsystem + +2019-10-19: 3.13.0 + This major release comes with a larger renovation of the build + system and a changed directory structure (eliminated top directory), + which is the result of a long and still on-going effort to use + recent autotools versions for various COIN-OR projects, reduce + future maintenance efforts, and adapting behaviors of standard + autotools-based projects. + As a consequence, a monolithic build of Ipopt, which builds Ipopt + with all its dependencies in one run of configure and make is no + longer possible. Dependencies should now be build and installed + before building Ipopt. + Additionally, support for some outdated versions of dependencies + and unmaintained components of Ipopt have been dropped and some + improvements that may require changes on the users side have been + applied. + A more detailed, probably incomplete, list of changes follows: + - Removed git submodules. Dependencies (HSL, Mumps, ASL, etc) now + need to be build and installed in advance, either manually or + by using coinbrew. + - Dropped support for HSL < 2013. + - Dropped support for MA28 in the linear solver loader. + - Dropped support for Pardiso < 4.0 from pardiso-project.org. + - Added support for Mumps 5.2.x, though initial experiments on + CUTEst indicated that, on average, performance is worse than + when using Mumps 4.10.0. + - Dropped CUTEr interface, the successor CUTEst includes an + interface to Ipopt. + - Dropped Matlab interface as it is unmaintained and it was + reported that it stopped functioning. + Use https://github.com/ebertolazzi/mexIPOPT instead. + - Dropped MSVS project files as unmaintained and not functioning + with current Ipopt anymore. + - Integrated Java interface into the main Ipopt library, that is, + it is handled equivalently to the C and Fortran interfaces: + - The source moved into src/Interfaces. + - The JNI functions are now included in the main Ipopt library, + thus an extra jipopt library is no longer build or necessary. + - The Java class and org.coinor.ipopt.jar package are build and + installed as part of the main Ipopt build. + - The examples moved into examples/*_java. + - A Java interface test is executed by make test. + - To build javadoc, run make javadoc in the main build directory. + - The configure flag --disable-java can be used to disable the + check for Java and build of the Java interface. + - DLLPATH and DLLNAME have been removed from the Ipopt class and + constructors that works without arguments and with only one + argument (specifying the Ipopt library namestem) have been added. + - Method Ipopt::finalize has been marked as deprecated and will + be removed in some future Ipopt version. Users must call + dispose() explicitly. + - Integrated sIpopt into the main Ipopt build, that is, it is now + build together with Ipopt, but installed as separate library + and executable. Use --disable-sipopt to disable building sIpopt. + - IPOPT_THREAD_LOCAL now uses C++11's thread_local keyword if C++11 + is available. + - When using a GCC-compatible compiler, Ipopt and sIpopt interface + functions are now declared with visibility(default)-attribute, + thus building Ipopt with -fvisibility=hidden still produces a + usable library. + - When using a MSVC-compatible compiler, Ipopt and sIpopt interface + functions are now declared with dllimport-attribute, so that an + Ipopt C++ DLL can be used. + - Under Windows/Msys2, DLLs are now build by default. + - Cygwin and MSys1 are not supported. + - pkg-config is now mandatory to use dependencies like ASL or HSL. + On Windows, make sure to use a pkg-config version that produces + Unix-style paths. + - Script "compile" is now used to wrap around calls of cl/icl/ifort + and translate GCC-style compiler flags to MSVC style. + - "Addlibs" files have been removed, pkg-config should be used instead. + - Header files are now installed in the better named + $prefix/include/coin-or instead of $prefix/include/coin + - The default for --prefix is no longer the build directory, but + the autotools-default, probably /usr/local. + - The check for a Fortran compiler can be disabled via --disable-f77 + and Ipopt can easier be build without a Fortran compiler. + - Lapack is no longer optional, but required. The separate check + for Blas and the --with-blas flags have been removed. + - --enable-debug does not imply --disable-shared anymore. + - Removed --enable-debug-ipopt, use --enable-debug instead. + - Removed configure variables ADD/OPT/DBG_C/CXX/F77FLAGS. Use + C/CXX/F77FLAGS instead. + - Silent build output is now enabled by default, use configure + flag --disable-silent-rules or call make with V=1 to disable. + - Also for static builds, PIC objects are now generated by default, + use --without-pic to disable. + - The --with-*-incdir and --with-*-lib configure flags have been + replaced by corresponding --with-*-cflags and --with-*-lflags + flags. Note that the include directories need to be specified + via -I in --with-*-cflags. + - Fixed handling of ma77_default_control in LSL_setMA77(). + - Fixed calculation of quality function when setting option + quality_function_centrality to reciprocal. + - Fixed compiler warnings, in particular when using -Wunused-parameter. + - Changed default for ma97_print_level to -1. This avoids messages + about numerical singular systems written to stdout by default. + +2019-04-08 releases/3.12.13 + - fixed Pardiso settings when using Pardiso from Pardiso project + website (by Olaf Schenk): the new settings should provide much + better performance; the default for option pardiso_order changed + from five to metis + - changed distinction of MKL and Basel Pardiso in configure: to + use MKL Pardiso, only specify MKL for Blas; to use Basel Pardiso, + use --with-pardiso + +2018-11-17 releases/3.12.12 + - allow for --without-matlab-home to disable check for Matlab [r2748] + - add dppsv to v8-ifort [r2746] + - disable error in LibraryHandler.c if snprintf detection failed [r2751] + +2018-09-16 releases/3.12.11 + - fill Mumps struct with zeros when allocating in Mumps interface [r2724] + - minor fix in build-system of ThirdParty/ASL + +2018-06-02 releases/3.12.10 + - fixed setting for parallel solve when using MKL Pardiso + (by t1393988511) [r2711]: parallel solve was disabled (which + is not the default); note, that the setting for parallel + factorization was not affected + - fixed invalid read in AMPL interface for problems without + objective function [r2715, #305] + - updated ThirdParty/ASL to retrieve updated ASL (20180528) [#305] + - name JIpopt library libjipopt.dylib on Mac OS X [r2718, #275] + +2018-01-15 releases/3.12.9 + - fixed memory leak in MA86 interface (by mhahn) [r2700,#283] + - fixed handling of time limit when reoptimizing: CPU time spend + was accumulated when reoptimizing, while it should have been + reset for each solve (by paul-scott) [r2702,r2703] + - fixed sign in Jacobian finite-difference approximation when point + was close to variable upper bounds (by Enrico Bertolazzi) [r2704] + +2017-06-12 releases/3.12.8 + - add define for FORTRAN_INTEGER_TYPE to config_ipopt_default.h + - IpoptApplication::RethrowNonIpoptException() now returns whether + non-ipopt exceptions were rethrown before the method was called. + +2017-02-25 releases/3.12.7 + - removed compiler flag -pedantic-errors to avoid problems with some + configure tests when using recent GCC versions + - fixed rare bug in handling variable/constraint names in AmplTNLP + (by G. Hackebeil) [r2673] + - the get.Mumps script in ThirdParty/Mumps now renames libseq/mpi.h + to libseq/mumps_mpi.h to avoid conflicts when building in a MPI + environment (by T. Ralphs); note that if updating an existing + checkout/download of Ipopt, you may have to rerun get.Mumps + +2016-07-20 releases/3.12.6 + - better support for custom algorithm development [r2659] + (by Gabriel Hackebeil) https://github.com/coin-or/Ipopt/pull/5: + "Reorganization of the AlgorithmBuilder class to allow easier + customization of the Ipopt algorithm. In particular, we wanted to + make use of the code that creates the SymLinearSolver object to + implement our own SymLinearSolver without copy-pasting everything + in AlgorithmBuilder. + AlgorithmBuilder::BuildBasicAlgorithm now consists of 8 method calls + that build the core components passed into the arguments of the + IpoptAlgorithm class. These calls are ordered based on any dependencies + they might have. In addition, all code for creating the PDSystemSolver, + AugSystemSolver, and SymLinearSolver has been moved into separate factory + methods. + Also, included is a change to install a few more header files with Ipopt. + Some of these are required to subclass AlgorithmBuilder, and the others + are simply some matrix types that we require." + - extend build system to work without Fortran compiler [r2660,r2661] + If no Fortran compiler is available (F77=unavailable), then + the build system checks for functions in Blas, Lapack, and + Pardiso via C linkage. This seems to work when using the Intel MKL, + thus allowing to build Ipopt with C/C++ compilers and MKL only. + The linear solver loader and the CuteR interface are disabled when + no Fortran compiler is available. A user may have to adjust the + definition of F77_FUNC in Ipopt/src/Common/IpoptConfig.h. + +2016-04-30 releases/3.12.5 + - changed fptr from long to void*: the Fortran side needs to + make sure that it uses a big enough integer type to store a + C pointer, thus void* can be used on the C side [r2599] + - added additional second-order-correction method, which can be + selected by setting the new option soc_method to 1 (by Wei Wan) + [r2606, r2607] + - added parameter allow_clobber with default value false to + IpoptApplication::Initialize and OptionsList::ReadFromStream + +2015-08-09 releases/3.12.4 + - option to use regularized Hessian when doing a curvature test + without inertia information (neg_curv_test_tol > 0), new + option neg_curv_test_reg to switch back to original behavior + (by N.-Y. Chiang and V. Zavala Tejeda) [r2579] + - sIpopt: Added access to sensitivity directional derivative + vector (ds/dp*(p-p0) Eq. 14 sIpopt implementation paper). Also, + added an option to compute the sensitivity matrix and provide + access to it. Finally, added an example that shows how to + access the new information. (by R. Lopez-Negrete) + - use workaround for failing check for random number generator + with any gcc 4.8.x (x >= 2) + +2015-04-15 releases/3.12.3 and releases/3.11.11 + - fixed bug in MA97 interface that lead to conversion issues + (by J. Hogg) [r2566, #260] + +2015-04-04 releases/3.12.2 + - revised integration of doxygen documentation into build system + (by T. Ralphs) + +2015-02-13 releases/3.12.1 + - fixes to build system for dependency linking and library versioning + - Ipopt will now report an NLP with inconsistent variable bounds + or inconsistent constraints sides as infeasible instead of + throwing an invalid TNLP exception (by T. Kelman) [r2548] + +2015-01-23 releases/3.12.0 + - Library dependencies are now recorded in shared library builds, + which is intended to simplify linking against the Ipopt library. + However, the pkg-config and ipopt_addlibs files do not reflect + this change yet (it is rather experimental, imho). To restore + the previous behavior, use --disable-dependency-linking as + configure option. In case of problems, contact Ted Ralphs. + - If linking against Intel MKL for Blas/lapack, use of Pardiso + from MKL is now automatically enabled. Note, that this will + change the default solver on Ipopt builds without any of the + linear solvers MA27, MA57, MA97, and MA86 (these take preference + over Pardiso). [#216] + - dropped support for old HSL sources (<2013; ThirdParty/HSLold) + - updated ASL sources, now downloaded from AMPL-MP (github) + - some internal changes to data structures (improved use of compound + component spaces) and addition of IpLapackDppsv (by Gabe Hackebeil) + +2015-01-18 releases/3.11.10 + - fix a memory allocation in Java interface in cases where jint + has a different size than int [r2513] + - the buildsystem now tries the Accelerate framework instead of + vecLib for finding Blas/Lapack on MacOS X + +2014-08-16 releases/3.11.9 + - fix compilation issue of Java interface on systems where Index + and jint have different size [r2498, #241] + - work around failing check for random number generator with gcc + 4.8.3 [r2495, r2496] + - readded IpTaggedObject.cpp to list of sources to compile in + MSVS v8-ifort project file [r2492] + - work around missing support for thread-local storage with gcc < 4.5 + on MacOS X [r2491, #243] + - fix call to MKL Pardiso init function [r2489] + - speed up Triplet to CSR converter [r2487, #234] + - fixed a bug in equilibration scaling where average values were + computed incorrectly (by V. Zverovich) [r2483] + +2014-04-08 releases/3.11.8 + - fixed a bug, introduced with Ipopt 3.11.0, where the tag in the + Ipopt's caching mechanism was not unique over time, which lead + ot failures of Ipopt that were difficult to debug or recognize + (e.g., Ipopt may have stopped with an restoration failure for + instances that solved fine with Ipopt 3.10) [r2472, r2473] + I'm very thankful to Gabriel Hackebeil and Kurt Majewski for + their debugging effort on this issue. + - building Mumps with pthreads is now disabled by default [#229] + - fixed setting of LD on Windows (now set to link only iff using + MS/Intel compilers) [#230] + - fixed download link for Gnumex [r2471] + - for some messages about too-few-degrees-of-freedom and restoration + failure, the message level changed from error to strong-warning + [r2460, r2469] + - revised calls to MPI_Init and MPI_Finalize in Mumps interface [r2467] + (MPI_Init is now called only if function MPI_Initialized is available + and MPI has not been initialized already; MPI_Finalize is only called + if Ipopt also called MPI_Init; ...) + +2013-12-18 releases/3.11.7 + - adapted PARDISO parameters when using MKL PARDISO to be close + to using Basel PARDISO + - added options pardiso_max_iterative_refinement_steps and + pardiso_order; the former defaults to 1 in case of MKL PARDISO, + which may help on instances that otherwise fail due to numerical issues + - removed duplicate code in IpQualityFunctionMuOracle.cpp [#225, r2445] + - fixed bug in triplet to csr converter [#226, r2446] + - minor changes in buildsystem + +2013-11-16 releases/3.11.6 + - updates to Matlab Interface build system (by T. Kelman) + - fix to updates of R Interface [r2416, #223] + - fixed SHAREDLIBEXT in v8-ifort's config.h [r2426, #224] + - minor fixes to the buildsystem + +2013-10-26 releases/3.11.5 + - added method IpoptApplication::RethrowNonIpoptException() to enable + rethrowing of non-ipopt and non-bad_alloc exceptions catched in + the *Optimize() and Initialization() methods; default is still to + return with NonIpopt_Exception_Thrown status + - minor fixes to the buildsystem [#215, #222] + +2013-09-12 releases/3.11.4 + - hopefully fixed non-working linear solver loader in DLLs build with + MSVS/v8-ifort project files [r2365] + - allow MC19 to be loaded via linear solver loader (by J. Currie) [r2366] + - fixed new point flag when running dependendency detector [r2368] + - experimental: adapt Pardiso interface to work with MKL Pardiso + (by J. Currie, T. Kelman) [r2369, #216]: + - in a few tests it has been found that Pardiso from Intel MKL nowadays + seems to work fine with Ipopt + - to use Intel MKL with Ipopt 3.11, one has to specify the MKL libs via + --with-pardiso and add -DHAVE_PARDISO_MKL -DHAVE_PARDISO_PARALLEL + to the compiler flags + - note that this is still an experimental feature (and thus not enabled + by default) + - updated Ipopt/R interface to version 0.8.4 [r2373] + - additional variables have been included in the object returned from ipoptr: + z_L : final values for the lower bound multipliers + z_U : final values for the upper bound multipliers + constraints : final values for the constraints + lambda : final values for the Lagrange multipliers + - removed ipoptr_environment as argument in ipoptr (see also r2372) + - fixed bug in penalty term for centrality in quality function (not used by + default) [#219, r2374] + - minor bugfixes in AMPL interface, debug print statements, and compound matrix + (by G. Hackebeil) [#218, r2371, r2377, r2378, r2379] + - download scripts for ASL, Blas, and Lapack now first try to download tarball + copies from the COIN-OR server + +2013-08-08 releases/3.11.3 + - get.* scripts for ThirdParty/{ASL,Blas,Lapack} now work around broken + ftp access to www.netlib.org. + +2013-07-01 releases/3.11.2 + - changed default for option option_file_name to ipopt.opt; specifying an + empty string for this option now disables reading of an option file [r2339] + - missing initial values are now set to 0.0, projected onto variable bounds, + in AMPL interface [r2340, #205] + - fixed missing variable initialization in MA97 interface [r2341, #206] + +2013-06-14 releases/3.11.1 + - the setup for the v8-ifort MSVS project changed to use dynamic runtime + DLLs instead of static linking, which caused crashes in debug mode + (by M. Roelofs) [r2301] + - fixed memory leaks in Java Interface (by javier) [#200, r2312] + - updates and fixes to MA77 and MA87 interfaces, adding support of + HSL 2013 codes (by J. Hogg); + HSL 2012 still supported when compiled with Ipopt, but the linear solver + loader to dynamically load a HSL library at runtime now assumes HSL 2013 + - added option ma97_solve_blas3 (by J. Hogg) [r2329] + - changed default for option ma27_meminc_factor from 10.0 to 2.0 [r2330] + - fixed bug in ipopt_auxdata of MATLAB Interface related to iterfunc [r2325] + +2013-05-07 releases/3.11.0 + - update and extension of Ipopt documentation + - updated build of doxygen documentation to comply with other COIN-OR projects + - localized global variables in TaggedObject and RegisteredOption, + so that Ipopt should now be threadsafe as long as Ipopt objects + (esp. SmartPtr's) are not shared between threads and a threadsafe + linear solver is used (e.g., MA27) [#167] + - no more need for whitespace character at end of options file + - added options print_frequency_iter and print_frequency_time to regulate + which iteration summary lines should be printed [#161] + - function evaluation timings are now available in OrigIpoptNLP [#86] + - some fixes to uncommon issues with the Ipopt SmartPtr [#162] + + - new build system for Harwell codes (ThirdParty/HSL), which requires + the coin-hsl archives from http://www.hsl.rl.ac.uk/ipopt/; + previously downloaded HSL sources can still be used by placing them + into ThirdParty/HSLold, but this option may be removed in a future + Ipopt version + - new interfaces for Harwell codes HSL_MA77, HSL_MA86, and HSL_MA97; + see http://www.hsl.rl.ac.uk/ipopt/ about help on when to use which solver; + especially MA57 and HSL_MA97 should be considered as replacement for MA27; + however, MA27 is still the default for now + - changed default of ma57_automatic_scaling to no (faster in general, + but for higher reliability, you may want to set this option to yes) + + - major improvements for building the MATLAB interface (see documentation) + - MATLAB interface now returns number of function evaluations, too + - the MA57 interface can now be used with the MA57 library that comes with + MATLAB (configure option --enable-matlab-ma57; cannot use Metis) + - auxdata is now handled by a wrapper function ipopt_auxdata.m instead + of internally within the mex code (replace Matlab call to ipopt with + ipopt_auxdata if using auxiliary data in any callbacks) [r2282] + - exposed more intermediate Ipopt information to iterfunc callback [r2283] + + - fixes to JIpopt buildsystem (now may work on windows and uses libtool) + - JIpopt now reads options file ipopt.opt by default, if present + - removed predefined KEY_ strings in JIpopt + - renamed API functions that retrieve solution values in JIpopt + + - simplified installation of R interface + +2013-05-05 releases/3.10.4 + - fixed sign of dual values in AMPL solution again (with help of Gabe) + [r2169, r2170, r2184, #183] + - fixed bugs with reoptimizing a TNLP with all variables fixed [r2172, r2173, #179] + - fixed more issues with sparse data structures and non-double numbers + in Matlab interface (by T. Kelman) [r2191] + - added missing final int for Ipopt return code Maximum_CpuTime_Exceeded + in Java interface [r2216] + - fixed bug when trying to warmstart Ipopt in Java interface [r2253] + - fixed wrong use of SmartPtr's in Java interface [r2255, r2263] + - fixed bug in returning final solution in Java interface [r2258] + - included patch in ThirdParty/Mumps to work around bugs in Mumps + matrix ordering routines AMF and QAMD (now give preference to AMD and METIS) + +2012-11-19 releases/3.10.3 + - minor fixes in MA86 interface (by Jonathan Hogg) [r2069, r2086] + - fix in IpTripletToCSRConverter for CSR forms with + extra entries (by Jonathan Hogg) [r2087] + - workaround problems with MacOSX-Lion's blas library + (by Frederic Hetch) [r2102, #181] + - the C interface now catches also Ipopt exceptions thrown + within the OptimizeTNLP call and returns Ipopt::Unrecoverable_Exception + as status [r2094, #144] + - fixed segmentation fault in adaptive barrier parameter update rule + when using the mehrotra option on unconstrained problems [r2114, #114] + - fixed segmentation fault in case no iterate is available in case of + catastrophic failure in restoration phase [r2115] + - fixed default for mumps_dep_tol to work with current Mumps versions [r2116] + - fixed sign of dual values in AMPL solution [r2123, #183] + - fixed issue with sparse gradients in Matlab interface + (by T. Kelman) [r2133, #187] + - sIPOPT (by H. Pirnay): + - starting values in C++ version of parametric example now + match AMPL version [r2098] + - numerical values in parametric example now match publication [r2099] + - added options n_sens_steps and sens_boundcheck as AMPL options [r2099] + - any non-zero suffix value is now accepted for sens_init_constr [r2100] + - fix typo in AMPL interface (by Weifeng Chen) [r2110] + - fix bug when compiling without AMPL interface [r2113] + - build system: + - updated instruction on using nowadays HSL sources (by T. Kelman) + - fixed issue with libdir being /lib64 + - other minor fixes + +2012-02-12 releases/3.10.2 + - updates to HSL interface (by Jonathan Hogg): + - MC68 can now be loaded dynamically, too + - MA86 exploits built-in scaling + - MA86 can choose best ordering from AMD and Metis + - fix for return code of MA86 for singular matrices + - corrected computation of Upsilon (norm of step SQUARED) + - updates to MSVS v8-ifort project files and addition of vc10 + project files (using vc8-generated IpoptFSS.dll) (by Marcel Roelofs) + - minor bugfixes, include updates in BuildTools + +2011-09-20 releases/3.10.1 + - include updates in BuildTools, including new ThirdParty/Metis + (fix for URL to download Metis 4.0.3 release) + - linear solver loader prints error code when failing to load + library under Windows + - message on failure when reallocating memory in Mumps now includes + size of memory that was tried to be allocated + - added missing include of cstdio/stdio.h to IpJournalist.hpp + - minor fixes to build system + +2011-06-20 releases/3.10.0 + - move to new COIN-OR configuration and installation convention + - primal infeasibility output is now true infeasibility in original + problem formulation + +2011-04-07 releases/3.9.3 + - include updates in BuildTools, including new ThirdParty/Metis + (required to work with current metis release) + +2010-12-22 releases/3.9.2 + - converted from Common Public License to Eclipse Public License + - some bugfixes from BuildTools + +2010-11-26 releases/3.9.1 + - improved Hessian update for restoration phase + - added intermediate callback feature to C and Fortran interface + +2010-11-05 releases/3.9.0 + - switching to new BuildTools system + - added R interface (contributed by Jelmer Ypma) + - updates in AsNMPC (by Hans Pirnay) + +2010-06-29 releases/3.8.3 + - restated SolveStatistics::TotalCPUTime method for backward + compatibility + +2010-06-16 releases/3.8.2 + - uses MUMPS version 4.9 and Lapack version 3.2.1 + - added AsNMPC contribution made by Hans Pirnay + - enhanced MA57 options + - several bug fixes and minor additions + +2009-10-30 releases/3.8.1 + - Bugfix in NLP function evaluation timing measurement. The + time for the objective function gradient had been forgotten. + +2009-10-29 releases/3.8.0 + - Added MSVC solution with Intel Fortran compiler to generate DLLs + (contributed by Marcel Roelofs). To make this work, a lot of methods + in exported headers have been made virtual + - changed default convergence tolerance in restoration phase (now same + as regular tolerance) + - output is flushed after each iteration + +2009-10-06 releases/3.7.1 + - bugfix for square problems + - correct timinig information (obj gradient was forgotten) + - flush output buffer after each iteration + - first code for iterative WSMP version (experimental and undocumented) + +2009-07-16 releases/3.7.0 + - a number of fixes (including those from 2009 COIN Bug Squashing + Party) + - changes in some exposed header files to provide access to internal + data structures for specific applications + +2009-05-01 releases/3.6.1 + - minor corrections in tutorial files + +2009-04-29 releases/3.6.0 + - new Matlab interface + - added new option to limit cpu time (max_cpu_time) + - added ThirdParty directory for Metis to be used with MUMPS or MA57 + - updated CUTEr Makefile to make it work with CUTEr2 + - added files for a tutorial (including coding exercise) + +2009-01-13 releases/3.5.5 + - minor fixes regarding compilation + - undocumented version of inexact method + +2008-09-29 releases/3.5.4 + - changed to MUMPS version 4.8.3 in externals (Mumps developers + seem to have removed 4.8.1). + +2008-09-19 releases/3.5.3 + - changed back to MUMPS version 4.8.1 since there seem to be issues + on Windows + +2008-09-18 releases/3.5.2 + - changed to latest version of MUMPS (4.8.2) + - some bugfixes (linear algebra objects, automatic problem scaling) + - made sure the subversion revision number is correct in all files + - allowed general additional data and cq in IpData and IpCq + +2008-08-26 releases/3.5.1 + - changed to latest version of MUMPS (4.8.1) + +2008-08-25 releases/3.5.0 + - added ComputeRowAMax and ComputeColAMax methods to Matrix base class + - changed externals for MUMPS to stable/1.1 + - call finalize solution in more failure cases + (this means that AMPL writes .sol file in more situations) + - added IpTNLPReducer as simple way to exclude constraints from problem + - several fixes, also from COIN Bug Squashing Party 2008 + +2008-07-18 releases/3.4.2 + - some bug fixes + - added wallclock time routine + - penalty function version does not longer crash if it + wants to go to restoration phase (not that this really helps + converence though) + +2008-05-30 releases/3.4.1 + - some bug fixes + - deleted v9 MSVC files again (since v8 works fine for v9) + - print Ipopt version in default print level + - added option that allows to change name of options file + (option_file_name) + +2008-04-25 releases/3.4.0 + - added support to dynamically load HSL or Pardiso: + If Ipopt has been compiled without some HSL or Pardiso solver, + it can now load those solvers from a shared library at runtime + without recompilation. This will make ditribution of binaries + easier. Does not work on all platforms yet. + - several bugfixes + - ensured compilation of MSVS project files (v8 and v9) + - new special return code for square problems + (Feasible_Point_Found returned if dual inf not small) + - new initialization option for bound multipliers + (see option bound_mult_init_method) + - added simple penalty function line search option + (line_search_method=penalty) - not guaranteed to converge, see + Ipopt implementation paper (in MathProg) + - some very basic method to approximate constraint Jacobian by + finite differences (not efficient, but will hopefully be extended) + +2008-02-28 releases/3.3.5 + - corrected links for Ipopt mailing list + - added missing Makefile.in for Matlab interface + - the addlibs* files are now installed in share/doc/coin/Ipopt + instead of lib + - updates in Matlab interface + - bugfix for ticket #56 + +2007-12-27 releases/3.3.4 + - headers are now installed in include/coin + (no longer in include/ipopt) + - default for dual_inf_tol is now 1 (instead of 1e-4) + - In matlab interface, here the text from Peter Carbonetto: + There have been several significant changes made to the MATLAB interface since the last release. The most important two changes are: 1) Following the "warm start" feature of IPOPT, you may pass in initial estimates for the Lagrange multipliers. 2) Callback routines for computing the objective, gradient (etc.) are now specified using function handles instead of strings. (Thanks to Marcus Brubaker at the University of Toronto for the initial suggestion.) + +2007-09-25 releases/3.3.3 + - minor changes, bug fixes + +2007-06-20 releases/3.3.1 + synchronized with all changes in trunk; probably more than to be + remembered. In the following a few: + - support for Mumps linear solver (contributed by Damian Hocking) + - --print-options flag for ipopt ASL solver executable to see all + Ipopt options (available through ipopt.opt file) + - added Matlab interface (contributed by Peter Carbonetto) + - added support for f2c compiler to compiler Fortran code with + MSVC++ compiler + - new MSVisualStudio support (now within MSVisualStudio project + and also with f2c) + - a number of small changes/bug fixes/improvements + - small change in interface (e.g., FinalizeSolution method) + +2007-04-24 releases/3.2.4 + - updated download script for Blas to fit netlib's + recent changes + - using a more recent version of BuildTools + +2006-11-29 release/3.2.3 + - updated download script for Lapack to fit to netlib's + recent changes + +2006-10-11 stable/3.2 r795 + - Bugfix in L-BFGS update + - fix in configure with detection of sizeof(int *) on Cygwin + +2006-07-14 - version 3.2.1 - dev release number 764 + - Bugfix in least square multiplier estimate. + It mainly showed up in LBFGS with restoration phase as seg fault + +2006-07-07 - version 3.2.0 - dev 757 + - changed installation procedure and directory structure to + conform with new COIN-OR convention + +2006-04-08 - version 3.1.0 - dev release number 714 + Several bug-fixes, improvements and additions. In particular: + - new quasi-Newton approximation using L-BFGS + - interfaces to linear solver MA57, WSMP, Pardiso + (MUMPS and TAUCS not yet completed) + - derivative checker + - unit test + - configure supports compilation under Cygwin with native + Windows compilers + - ScalableExample + - user call-back method in TNLP + +2005-12-04 - version 3.0.1 - fixes independent of dev + (already taken care of there) + Several corrections to Windows files + Fix termination if number of iterations is exceeded in restoration phase +2005-08-26 - version 3.0.0 - dev release number 510 + First official release of the new C++ implementation of Ipopt. + diff --git a/Ipopt-3.13.4/Ipopt/CMakeLists.txt b/Ipopt-3.13.4/Ipopt/CMakeLists.txt new file mode 100644 index 000000000..b4fd53502 --- /dev/null +++ b/Ipopt-3.13.4/Ipopt/CMakeLists.txt @@ -0,0 +1,957 @@ +# TODO: +# add ScalableProblems_java + +get_ac_init_version(${Ipopt_DIR}/configure.ac IPOPT) + +set(IPOPT_VERSION_MAJOR "${IPOPT_MAJOR_VERSION}" CACHE STRING "The IpOpt major version number") +set(IPOPT_VERSION_MINOR "${IPOPT_MINOR_VERSION}" CACHE STRING "The IpOpt minor version number") +set(IPOPT_VERSION_RELEASE "${IPOPT_PATCH_VERSION}" CACHE STRING "The IpOpt patch version number") +set(IPOPT_VERSION "${IPOPT_VERSION_STRING}" CACHE STRING "The IpOpt version") +set(PACKAGE_VERSION "${IPOPT_VERSION}") + + +set(IPOPT_WC_REVISION "0") +if (EXISTS "${Ipopt_DIR}/.svn") + find_package(Subversion) + if (Subversion_FOUND) + Subversion_WC_INFO(${Ipopt_DIR} IPOPT) + endif () +endif () + +if (EXISTS "${Ipopt_DIR}/.git") + find_package(Git) + if (Git_FOUND) + include(export_git) + GIT_WC_INFO(${Ipopt_DIR} IPOPT) + set(IPOPT_WC_REVISION "${IPOPT_WC_SVNEQUIV}") # alphanumeric rev not yet managed + endif () +endif () + +message(STATUS "Current IPOPT revision is ${IPOPT_WC_REVISION}") +set(IPOPT_SVN_REV "${IPOPT_WC_REVISION}" CACHE STRING "The IPOPT subversion revision" FORCE) + +mark_as_advanced(IPOPT_VERSION_MAJOR + IPOPT_VERSION_MINOR + IPOPT_VERSION_RELEASE + IPOPT_VERSION + IPOPT_SVN_REV) + +add_definitions(-DIPOPTLIB_BUILD) + +configure_file(${CMAKE_CURRENT_SOURCE_DIR}/include/config.h.in ${CMAKE_CURRENT_BINARY_DIR}/Ipopt/include/config.h) +configure_file(${CMAKE_CURRENT_SOURCE_DIR}/include/config_ipopt.h.in ${CMAKE_CURRENT_BINARY_DIR}/Ipopt/include/config_ipopt.h) + +# +# pkg-config file generation +# + +set(prefix "${CMAKE_INSTALL_PREFIX}") +set(exec_prefix "\${prefix}") +set(libdir "${CMAKE_INSTALL_PREFIX}/${CMAKE_INSTALL_LIBDIR}") +set(includedir "${CMAKE_INSTALL_PREFIX}/${CMAKE_INSTALL_INCLUDEDIR}") +set(IPOPTLIB_LFLAGS_NOPC "-lm -ldl") +set(IPOPTLIB_PCFILES "") +if (IPOPT_HAS_LAPACK OR COIN_USE_SYSTEM_LAPACK) + set(IPOPTLIB_PCFILES "${IPOPTLIB_PCFILES} -llapack") +endif () +if (COIN_HAS_BLAS OR COIN_USE_BLAS) + set(IPOPTLIB_PCFILES "${IPOPTLIB_PCFILES} -lblas") +endif () +if (COIN_ENABLE_DOWNLOAD_CLAPACK) + set(IPOPTLIB_PCFILES "${IPOPTLIB_PCFILES} -lf2c") +endif () + +configure_file(${Ipopt_DIR}/ipopt.pc.in ${CMAKE_CURRENT_BINARY_DIR}/Ipopt/ipopt.pc @ONLY) + +set(libdir "${Ipopt_DIR}") +set(abs_source_dir "${CMAKE_CURRENT_BINARY_DIR}/bin") + +install(FILES ${CMAKE_CURRENT_BINARY_DIR}/Ipopt/ipopt.pc + DESTINATION ${CMAKE_INSTALL_LIBDIR}/pkg-config/) + +# +# Build +# + +set (IPOPT_SRC_ALGORITHM_LIST ${Ipopt_DIR}/src/Algorithm/IpAdaptiveMuUpdate.cpp + ${Ipopt_DIR}/src/Algorithm/IpAlgBuilder.cpp + ${Ipopt_DIR}/src/Algorithm/IpAlgorithmRegOp.cpp + ${Ipopt_DIR}/src/Algorithm/IpAugRestoSystemSolver.cpp + ${Ipopt_DIR}/src/Algorithm/IpBacktrackingLineSearch.cpp + ${Ipopt_DIR}/src/Algorithm/IpDefaultIterateInitializer.cpp + ${Ipopt_DIR}/src/Algorithm/IpEquilibrationScaling.cpp + ${Ipopt_DIR}/src/Algorithm/IpExactHessianUpdater.cpp + ${Ipopt_DIR}/src/Algorithm/IpFilterLSAcceptor.cpp + ${Ipopt_DIR}/src/Algorithm/IpFilter.cpp + ${Ipopt_DIR}/src/Algorithm/IpGenAugSystemSolver.cpp + ${Ipopt_DIR}/src/Algorithm/IpGradientScaling.cpp + ${Ipopt_DIR}/src/Algorithm/IpIpoptAlg.cpp + ${Ipopt_DIR}/src/Algorithm/IpIpoptCalculatedQuantities.cpp + ${Ipopt_DIR}/src/Algorithm/IpIpoptData.cpp + ${Ipopt_DIR}/src/Algorithm/IpIteratesVector.cpp + ${Ipopt_DIR}/src/Algorithm/IpLeastSquareMults.cpp + ${Ipopt_DIR}/src/Algorithm/IpLimMemQuasiNewtonUpdater.cpp + ${Ipopt_DIR}/src/Algorithm/IpLoqoMuOracle.cpp + ${Ipopt_DIR}/src/Algorithm/IpLowRankAugSystemSolver.cpp + ${Ipopt_DIR}/src/Algorithm/IpLowRankSSAugSystemSolver.cpp + ${Ipopt_DIR}/src/Algorithm/IpMonotoneMuUpdate.cpp + ${Ipopt_DIR}/src/Algorithm/IpNLPBoundsRemover.cpp + ${Ipopt_DIR}/src/Algorithm/IpNLPScaling.cpp + ${Ipopt_DIR}/src/Algorithm/IpOptErrorConvCheck.cpp + ${Ipopt_DIR}/src/Algorithm/IpOrigIpoptNLP.cpp + ${Ipopt_DIR}/src/Algorithm/IpOrigIterationOutput.cpp + ${Ipopt_DIR}/src/Algorithm/IpPDFullSpaceSolver.cpp + ${Ipopt_DIR}/src/Algorithm/IpPDPerturbationHandler.cpp + ${Ipopt_DIR}/src/Algorithm/IpPDSearchDirCalc.cpp + ${Ipopt_DIR}/src/Algorithm/IpPenaltyLSAcceptor.cpp + ${Ipopt_DIR}/src/Algorithm/IpProbingMuOracle.cpp + ${Ipopt_DIR}/src/Algorithm/IpQualityFunctionMuOracle.cpp + ${Ipopt_DIR}/src/Algorithm/IpRestoConvCheck.cpp + ${Ipopt_DIR}/src/Algorithm/IpRestoFilterConvCheck.cpp + ${Ipopt_DIR}/src/Algorithm/IpRestoIpoptNLP.cpp + ${Ipopt_DIR}/src/Algorithm/IpRestoIterateInitializer.cpp + ${Ipopt_DIR}/src/Algorithm/IpRestoIterationOutput.cpp + ${Ipopt_DIR}/src/Algorithm/IpRestoMinC_1Nrm.cpp + ${Ipopt_DIR}/src/Algorithm/IpRestoPenaltyConvCheck.cpp + ${Ipopt_DIR}/src/Algorithm/IpRestoRestoPhase.cpp + ${Ipopt_DIR}/src/Algorithm/IpStdAugSystemSolver.cpp + ${Ipopt_DIR}/src/Algorithm/IpTimingStatistics.cpp + ${Ipopt_DIR}/src/Algorithm/IpUserScaling.cpp + ${Ipopt_DIR}/src/Algorithm/IpWarmStartIterateInitializer.cpp) + +set (IPOPT_SRC_ALGORITHM_INEXACT_LIST ${Ipopt_DIR}/src/Algorithm/Inexact/IpInexactAlgBuilder.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpInexactCq.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpInexactData.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpInexactDoglegNormal.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpInexactLSAcceptor.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpInexactNewtonNormal.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpInexactNormalTerminationTester.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpInexactRegOp.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpInexactSearchDirCalc.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpInexactTSymScalingMethod.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpIterativeSolverTerminationTester.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpInexactPDSolver.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpInexactPDTerminationTester.cpp + ${Ipopt_DIR}/src/Algorithm/Inexact/IpIterativePardisoSolverInterface.cpp) + +set (IPOPT_SRC_ALGORITHM_LINEARSOLVERS_LIST ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpLinearSolversRegOp.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpSlackBasedTSymScalingMethod.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpTripletToCSRConverter.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpTSymDependencyDetector.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpTSymLinearSolver.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpMa27TSolverInterface.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpMa57TSolverInterface.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpMa86SolverInterface.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpMa97SolverInterface.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpMc19TSymScalingMethod.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpMa28TDependencyDetector.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpMa77SolverInterface.cpp) + +if (IPOPT_ENABLE_LINEARSOLVERLOADER OR COIN_ENABLE_COMPILE_HSL OR COIN_USE_COINHSL) + enable_language(Fortran) +endif () + +if (IPOPT_ENABLE_LINEARSOLVERLOADER AND (NOT "${CMAKE_Fortran_COMPILER}" STREQUAL "")) + set (IPOPT_SRC_ALGORITHM_LINEARSOLVERS_LIST ${IPOPT_SRC_ALGORITHM_LINEARSOLVERS_LIST} + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpPardisoSolverInterface.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpMa28Partition.F) +else () + if (IPOPT_HAS_PARDISO) + set (IPOPT_SRC_ALGORITHM_LINEARSOLVERS_LIST ${IPOPT_SRC_ALGORITHM_LINEARSOLVERS_LIST} + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpPardisoSolverInterface.cpp) + endif () + if (COINHSL_HAS_MA28 AND (NOT "${CMAKE_Fortran_COMPILER}" STREQUAL "")) + set (IPOPT_SRC_ALGORITHM_LINEARSOLVERS_LIST ${IPOPT_SRC_ALGORITHM_LINEARSOLVERS_LIST} + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpMa28Partition.F) + endif () +endif () + +if (IPOPT_HAS_WSMP) + set (IPOPT_SRC_ALGORITHM_LINEARSOLVERS_LIST ${IPOPT_SRC_ALGORITHM_LINEARSOLVERS_LIST} + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpWsmpSolverInterface.cpp + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpIterativeWsmpSolverInterface.cpp) +endif () + +if (IPOPT_HAS_MUMPS) + set (IPOPT_SRC_ALGORITHM_LINEARSOLVERS_LIST ${IPOPT_SRC_ALGORITHM_LINEARSOLVERS_LIST} + ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpMumpsSolverInterface.cpp) +endif () + +set (IPOPT_SRC_APPS_CUTERINTERFACE_LIST ) +set (IPOPT_SRC_APPS_AMPLSOLVER_LIST ) + +set (IPOPT_SRC_CONTRIB_CGPENALTY_LIST ${Ipopt_DIR}/src/contrib/CGPenalty/IpCGPenaltyCq.cpp + ${Ipopt_DIR}/src/contrib/CGPenalty/IpCGPenaltyData.cpp + ${Ipopt_DIR}/src/contrib/CGPenalty/IpCGPenaltyLSAcceptor.cpp + ${Ipopt_DIR}/src/contrib/CGPenalty/IpCGPenaltyRegOp.cpp + ${Ipopt_DIR}/src/contrib/CGPenalty/IpCGPerturbationHandler.cpp + ${Ipopt_DIR}/src/contrib/CGPenalty/IpCGSearchDirCalc.cpp + ${Ipopt_DIR}/src/contrib/CGPenalty/IpPiecewisePenalty.cpp) + +set (IPOPT_SRC_CONTRIB_LINEARSOLVERLOADER_LIST ${Ipopt_DIR}/src/contrib/LinearSolverLoader/LibraryHandler.c + ${Ipopt_DIR}/src/contrib/LinearSolverLoader/HSLLoader.c) + +if (IPOPT_ENABLE_LINEARSOLVERLOADER) + set(IPOPT_SRC_CONTRIB_LINEARSOLVERLOADER_LIST ${IPOPT_SRC_CONTRIB_LINEARSOLVERLOADER_LIST} + ${Ipopt_DIR}/src/contrib/LinearSolverLoader/PardisoLoader.c) +endif () + +set (IPOPT_SRC_COMMON_LIST ${Ipopt_DIR}/src/Common/IpJournalist.cpp + ${Ipopt_DIR}/src/Common/IpObserver.cpp + ${Ipopt_DIR}/src/Common/IpOptionsList.cpp + ${Ipopt_DIR}/src/Common/IpRegOptions.cpp + ${Ipopt_DIR}/src/Common/IpTaggedObject.cpp + ${Ipopt_DIR}/src/Common/IpUtils.cpp) + +set (IPOPT_SRC_INTERFACES_LIST ${Ipopt_DIR}/src/Interfaces/IpInterfacesRegOp.cpp + ${Ipopt_DIR}/src/Interfaces/IpIpoptApplication.cpp + ${Ipopt_DIR}/src/Interfaces/IpSolveStatistics.cpp + ${Ipopt_DIR}/src/Interfaces/IpStdCInterface.cpp + ${Ipopt_DIR}/src/Interfaces/IpStdFInterface.c + ${Ipopt_DIR}/src/Interfaces/IpStdInterfaceTNLP.cpp + ${Ipopt_DIR}/src/Interfaces/IpTNLPAdapter.cpp + ${Ipopt_DIR}/src/Interfaces/IpTNLPReducer.cpp) + +set (IPOPT_SRC_LINALG_LIST ${Ipopt_DIR}/src/LinAlg/IpBlas.cpp + ${Ipopt_DIR}/src/LinAlg/IpCompoundMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpCompoundSymMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpCompoundVector.cpp + ${Ipopt_DIR}/src/LinAlg/IpDenseGenMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpDenseSymMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpDenseVector.cpp + ${Ipopt_DIR}/src/LinAlg/IpDiagMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpExpandedMultiVectorMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpExpansionMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpIdentityMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpLapack.cpp + ${Ipopt_DIR}/src/LinAlg/IpLowRankUpdateSymMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpMultiVectorMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpScaledMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpSumMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpSumSymMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpSymScaledMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpTransposeMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpVector.cpp + ${Ipopt_DIR}/src/LinAlg/IpZeroMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/IpZeroSymMatrix.cpp) + +set (IPOPT_SRC_LINALG_TMATRICES ${Ipopt_DIR}/src/LinAlg/TMatrices/IpGenTMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/TMatrices/IpSymTMatrix.cpp + ${Ipopt_DIR}/src/LinAlg/TMatrices/IpTripletHelper.cpp) + +set (IPOPT_SRC_LIST ${IPOPT_SRC_ALGORITHM_LIST} + ${IPOPT_SRC_ALGORITHM_LINEARSOLVERS_LIST} + ${IPOPT_SRC_APPS_CUTERINTERFACE_LIST} + ${IPOPT_SRC_APPS_AMPLSOLVER_LIST} + ${IPOPT_SRC_CONTRIB_CGPENALTY_LIST} + ${IPOPT_SRC_CONTRIB_LINEARSOLVERLOADER_LIST} + ${IPOPT_SRC_COMMON_LIST} + ${IPOPT_SRC_INTERFACES_LIST} + ${IPOPT_SRC_LINALG_LIST} + ${IPOPT_SRC_LINALG_TMATRICES}) + +if (IPOPT_ENABLE_INEXACT) + set(IPOPT_SRC_LIST ${IPOPT_SRC_LIST} + ${IPOPT_SRC_ALGORITHM_INEXACT_LIST}) +endif () + +macro(set_include_directories TARGET) + target_include_directories(${TARGET} BEFORE PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/Ipopt/include) +endmacro () + +if (EXISTS ${Ipopt_DIR}/ThirdParty/HSL) + include_directories(${Ipopt_DIR}/ThirdParty/HSL) +endif () + +include_directories(${Ipopt_DIR}/src/Algorithm) +include_directories(${Ipopt_DIR}/src/Algorithm/LinearSolvers) +include_directories(${Ipopt_DIR}/src/Algorithm/Inexact) +include_directories(${Ipopt_DIR}/src/contrib/CGPenalty) +include_directories(${Ipopt_DIR}/src/contrib/LinearSolverLoader) +include_directories(${Ipopt_DIR}/src/Interfaces) +include_directories(${Ipopt_DIR}/src/Common) +include_directories(${Ipopt_DIR}/src/LinAlg) +include_directories(${Ipopt_DIR}/src/Apps/AmplSolver) +include_directories(${Ipopt_DIR}/src/LinAlg/TMatrices) + +if (MSCV) + add_definitions(-D_CRT_SECURE_NO_WARNINGS -D_CRT_SECURE_NO_DEPRECATE) +endif () + +if (IPOPT_HAS_PARDISO) + add_definition(-DHAVE_PARDISO=1) + if (IPOPT_HAS_PARDISO_MKL) + add_definition(-DHAVE_PARDISO_MKL=1) + endif () + if (IPOPT_HAS_PARDISO_OLDINTERFACE) + add_definition(-DHAVE_PARDISO_OLDINTERFACE=1) + endif () + if (IPOPT_HAS_PARDISO_PARALLEL) + add_definition(-DHAVE_PARDISO_PARALLEL=1) + endif () +endif () + +if (IPOPT_HAS_AMPL) + set(IPOPT_SRC_LIST ${IPOPT_SRC_LIST} + ${Ipopt_DIR}/src/Apps/AmplSolver/AmplTNLP.cpp) +endif () + +if (IPOPT_BUILD_SHARED_LIBS) + add_library_mod(ipopt SHARED ${IPOPT_SRC_LIST}) +else () + add_library_mod(ipopt STATIC ${IPOPT_SRC_LIST}) + target_link_libraries(ipopt PUBLIC quadmath) +endif () +if (COIN_COMPILE_LTO) + set_target_properties(ipopt PROPERTIES INTERPROCEDURAL_OPTIMIZATION true) +endif () + +set_include_directories(ipopt) + +if (IPOPT_HAS_AMPL) + set (IPOPT_AMPL_SRC_LIST ${Ipopt_DIR}/src/Apps/AmplSolver/ampl_ipopt.cpp) + + add_definitions(-DIPOPTAMPL_BUILD) + + add_executable_mod(ipoptapp ${IPOPT_AMPL_SRC_LIST}) + + target_link_libraries(ipoptapp ipopt) + if (IPOPT_HAS_MUMPS) + target_link_libraries(ipoptapp dmumps mumps_common seq pthread) + endif () + if (COIN_ENABLE_COMPILE_HSL) + if (IPOPT_ENABLE_LINEARSOLVERLOADER) + target_link_libraries(ipoptapp hsl) + else () + target_link_libraries(ipoptapp hsl-static) + endif () + if (IPOPT_HAS_HSL_OTHER) + target_link_libraries(ipoptapp hsl-other) + endif () + endif () + if (MKL_FOUND) + target_link_libraries(ipoptapp ${COIN_MKL_LIBS}) + else () + if (IPOPT_HAS_LAPACK OR COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_USE_SYSTEM_LAPACK) + target_link_libraries(ipoptapp lapack blas) + endif () + if (COIN_ENABLE_DOWNLOAD_CLAPACK) + target_link_libraries(ipoptapp f2c) + endif () + endif () + if (COIN_ENABLE_COMPILE_HSL OR COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_ENABLE_DOWNLOAD_MUMPS OR COIN_ENABLE_COMPILE_HSL OR IPOPT_HAS_MUMPS OR COIN_USE_SYSTEM_LAPACK) + target_link_libraries(ipoptapp gfortran) + endif () + if ((IPOPT_ENABLE_LINEARSOLVERLOADER OR COIN_ENABLE_DOWNLOAD_ASL OR IPOPT_BUILD_SHARED_LIBS) AND UNIX) + target_link_libraries(ipoptapp dl) + endif () + if (COIN_ENABLE_DOWNLOAD_ASL) + target_link_libraries(ipoptapp amplsolver) + endif () + if (COIN_ENABLE_DOWNLOAD_METIS) + target_link_libraries(ipoptapp metis) + endif () + if (IPOPT_HAS_WSMP) + target_link_libraries(ipoptapp wsmp) + endif () + if (IPOPT_HAS_PARDISO) + target_link_libraries(ipoptapp wsmp) + if (WIN32) + if (CMAKE_SIZEOF_VOID_P EQUAL 4) + target_link_libraries(ipoptapp mkl_intel_c.lib mkl_sequential.lib mkl_core.lib) + else () + target_link_libraries(ipoptapp mkl_intel_lp64.lib mkl_sequential.lib mkl_core.lib) + endif () + else () + set(MKL_TMP_LIB "-Wl,--start-group -lmkl_core") + if (CMAKE_SIZEOF_VOID_P EQUAL 4) + set(MKL_TMP_LIB "${MKL_TMP_LIB} -lmkl_intel") + else () + set(MKL_TMP_LIB "${MKL_TMP_LIB} -lmkl_intel_lp64") + endif () + if (IPOPT_HAS_PARDISO_PARALLEL) + set(MKL_TMP_LIB "${MKL_TMP_LIB} -lmkl_intel_thread") + else () + set(MKL_TMP_LIB "${MKL_TMP_LIB} -lmkl_sequential") + endif () + set(MKL_TMP_LIB "${MKL_TMP_LIB} -Wl,--end-group") + + target_link_libraries(ipoptapp ${MKL_TMP_LIB}) + endif () + endif () + + set_include_directories(ipoptapp) + + install(TARGETS ipoptapp + DESTINATION ${CMAKE_INSTALL_BINDIR}) + + include(${CMAKE_CURRENT_SOUR_DIR}/ThirdParty/IpoptTests.cmake) +endif () + +if (IPOPT_BUILD_EXAMPLES) + set(ScalableProblems_SRCS ${Ipopt_DIR}/examples/ScalableProblems/LuksanVlcek1.cpp + ${Ipopt_DIR}/examples/ScalableProblems/LuksanVlcek2.cpp + ${Ipopt_DIR}/examples/ScalableProblems/LuksanVlcek3.cpp + ${Ipopt_DIR}/examples/ScalableProblems/LuksanVlcek4.cpp + ${Ipopt_DIR}/examples/ScalableProblems/LuksanVlcek5.cpp + ${Ipopt_DIR}/examples/ScalableProblems/LuksanVlcek6.cpp + ${Ipopt_DIR}/examples/ScalableProblems/LuksanVlcek7.cpp + ${Ipopt_DIR}/examples/ScalableProblems/MittelmannBndryCntrlDiri3Dsin.cpp + ${Ipopt_DIR}/examples/ScalableProblems/MittelmannBndryCntrlDiri3D_27.cpp + ${Ipopt_DIR}/examples/ScalableProblems/MittelmannBndryCntrlDiri3D.cpp + ${Ipopt_DIR}/examples/ScalableProblems/MittelmannDistCntrlDiri.cpp + ${Ipopt_DIR}/examples/ScalableProblems/MittelmannBndryCntrlDiri.cpp + ${Ipopt_DIR}/examples/ScalableProblems/MittelmannDistCntrlNeumA.cpp + ${Ipopt_DIR}/examples/ScalableProblems/MittelmannDistCntrlNeumB.cpp + ${Ipopt_DIR}/examples/ScalableProblems/MittelmannBndryCntrlNeum.cpp + ${Ipopt_DIR}/examples/ScalableProblems/RegisteredTNLP.cpp + ${Ipopt_DIR}/examples/ScalableProblems/solve_problem.cpp) + + add_executable_mod(solve_problem ${ScalableProblems_SRCS}) + target_link_libraries(solve_problem ipopt) + if (COIN_COMPILE_LTO) + set_target_properties(solve_problem PROPERTIES INTERPROCEDURAL_OPTIMIZATION true) + endif () + if (IPOPT_HAS_MUMPS) + target_link_libraries(solve_problem dmumps mumps_common seq pthread) + endif () + if (COIN_ENABLE_COMPILE_HSL) + if (IPOPT_ENABLE_LINEARSOLVERLOADER) + target_link_libraries(solve_problem hsl) + else () + target_link_libraries(solve_problem hsl-static) + endif () + if (IPOPT_HAS_HSL_OTHER) + target_link_libraries(solve_problem hsl-other) + endif () + endif () + if (MKL_FOUND) + target_link_libraries(solve_problem ${COIN_MKL_LIBS}) + else () + if (IPOPT_HAS_LAPACK OR COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_USE_SYSTEM_LAPACK) + target_link_libraries(solve_problem lapack blas) + endif () + if (COIN_ENABLE_DOWNLOAD_CLAPACK) + target_link_libraries(solve_problem f2c) + endif () + endif () + if (COIN_ENABLE_COMPILE_HSL OR COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_ENABLE_COMPILE_HSL OR COIN_ENABLE_DOWNLOAD_MUMPS OR IPOPT_HAS_MUMPS OR COIN_USE_SYSTEM_LAPACK) + target_link_libraries(solve_problem gfortran) + endif () + if ((IPOPT_ENABLE_LINEARSOLVERLOADER OR COIN_ENABLE_DOWNLOAD_ASL OR IPOPT_BUILD_SHARED_LIBS) AND UNIX) + target_link_libraries(solve_problem dl) + endif () + if (COIN_ENABLE_DOWNLOAD_METIS) + target_link_libraries(solve_problem metis) + endif () + include_directories(${Ipopt_DIR}/examples/ScalableProblems) + set_include_directories(solve_problem) + + add_test(NAME ipopt_example_luksan_LukVlE1 + COMMAND $ LukVlE1 10) + set_tests_properties(ipopt_example_luksan_LukVlE1 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlE1 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlE2 + COMMAND $ LukVlE2 14) + set_tests_properties(ipopt_example_luksan_LukVlE2 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlE2 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlE3 + COMMAND $ LukVlE3 10) + set_tests_properties(ipopt_example_luksan_LukVlE3 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlE3 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlE4 + COMMAND $ LukVlE4 10) + set_tests_properties(ipopt_example_luksan_LukVlE4 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlE4 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlE5 + COMMAND $ LukVlE5 10) + set_tests_properties(ipopt_example_luksan_LukVlE5 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlE5 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlE6 + COMMAND $ LukVlE6 10) + set_tests_properties(ipopt_example_luksan_LukVlE6 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlE6 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlE7 + COMMAND $ LukVlE7 4) + set_tests_properties(ipopt_example_luksan_LukVlE7 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlE7 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlI1 + COMMAND $ LukVlI1 10) + set_tests_properties(ipopt_example_luksan_LukVlI1 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlI1 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlI2 + COMMAND $ LukVlI2 14) + set_tests_properties(ipopt_example_luksan_LukVlI2 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlI2 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlI3 + COMMAND $ LukVlI3 10) + set_tests_properties(ipopt_example_luksan_LukVlI3 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlI3 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlI4 + COMMAND $ LukVlI4 10) + set_tests_properties(ipopt_example_luksan_LukVlI4 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlI4 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlI5 + COMMAND $ LukVlI5 10) + set_tests_properties(ipopt_example_luksan_LukVlI5 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlI5 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlI6 + COMMAND $ LukVlI6 10) + set_tests_properties(ipopt_example_luksan_LukVlI6 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlI6 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_LukVlI7 + COMMAND $ LukVlI7 4) + set_tests_properties(ipopt_example_luksan_LukVlI7 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_LukVlI7 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MBndryCntrl1 + COMMAND $ MBndryCntrl1 10) + set_tests_properties(ipopt_example_luksan_MBndryCntrl1 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MBndryCntrl1 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MBndryCntrl2 + COMMAND $ MBndryCntrl2 14) + set_tests_properties(ipopt_example_luksan_MBndryCntrl2 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MBndryCntrl2 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MBndryCntrl3 + COMMAND $ MBndryCntrl3 10) + set_tests_properties(ipopt_example_luksan_MBndryCntrl3 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MBndryCntrl3 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MBndryCntrl4 + COMMAND $ MBndryCntrl4 10) + set_tests_properties(ipopt_example_luksan_MBndryCntrl4 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MBndryCntrl4 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MBndryCntrl5 + COMMAND $ MBndryCntrl5 10) + set_tests_properties(ipopt_example_luksan_MBndryCntrl5 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MBndryCntrl5 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MBndryCntrl6 + COMMAND $ MBndryCntrl6 10) + set_tests_properties(ipopt_example_luksan_MBndryCntrl6 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MBndryCntrl6 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MBndryCntrl7 + COMMAND $ MBndryCntrl7 10) + set_tests_properties(ipopt_example_luksan_MBndryCntrl7 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MBndryCntrl7 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MBndryCntrl8 + COMMAND $ MBndryCntrl8 10) + set_tests_properties(ipopt_example_luksan_MBndryCntrl8 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MBndryCntrl8 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MBndryCntrl_3D + COMMAND $ MBndryCntrl_3D 10) + set_tests_properties(ipopt_example_luksan_MBndryCntrl_3D PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MBndryCntrl_3D PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MBndryCntrl_3D_27 + COMMAND $ MBndryCntrl_3D_27 10) + set_tests_properties(ipopt_example_luksan_MBndryCntrl_3D_27 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MBndryCntrl_3D_27 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MBndryCntrl_3D_27BT + COMMAND $ MBndryCntrl_3D_27BT 10) + set_tests_properties(ipopt_example_luksan_MBndryCntrl_3D_27BT PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MBndryCntrl_3D_27BT PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MBndryCntrl_3Dsin + COMMAND $ MBndryCntrl_3Dsin 10) + set_tests_properties(ipopt_example_luksan_MBndryCntrl_3Dsin PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MBndryCntrl_3Dsin PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MDistCntrl1 + COMMAND $ MDistCntrl1 10) + set_tests_properties(ipopt_example_luksan_MDistCntrl1 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MDistCntrl1 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MDistCntrl2 + COMMAND $ MDistCntrl2 10) + set_tests_properties(ipopt_example_luksan_MDistCntrl2 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MDistCntrl2 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MDistCntrl3 + COMMAND $ MDistCntrl3 10) + set_tests_properties(ipopt_example_luksan_MDistCntrl3 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MDistCntrl3 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MDistCntrl3a + COMMAND $ MDistCntrl3a 10) + set_tests_properties(ipopt_example_luksan_MDistCntrl3a PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MDistCntrl3a PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MDistCntrl4 + COMMAND $ MDistCntrl4 10) + set_tests_properties(ipopt_example_luksan_MDistCntrl4 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MDistCntrl4 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MDistCntrl4a + COMMAND $ MDistCntrl4a 10) + set_tests_properties(ipopt_example_luksan_MDistCntrl4a PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MDistCntrl4a PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MDistCntrl5 + COMMAND $ MDistCntrl5 10) + set_tests_properties(ipopt_example_luksan_MDistCntrl5 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MDistCntrl5 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MDistCntrl5a + COMMAND $ MDistCntrl5a 10) + set_tests_properties(ipopt_example_luksan_MDistCntrl5a PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MDistCntrl5a PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MDistCntrl6 + COMMAND $ MDistCntrl6 10) + set_tests_properties(ipopt_example_luksan_MDistCntrl6 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MDistCntrl6 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MDistCntrl6a + COMMAND $ MDistCntrl6a 10) + set_tests_properties(ipopt_example_luksan_MDistCntrl6a PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MDistCntrl6a PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MPara5_1 + COMMAND $ MPara5_1 10) + set_tests_properties(ipopt_example_luksan_MPara5_1 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MPara5_1 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MPara5_2_1 + COMMAND $ MPara5_2_1 10) + set_tests_properties(ipopt_example_luksan_MPara5_2_1 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MPara5_2_1 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MPara5_2_2 + COMMAND $ MPara5_2_2 10) + set_tests_properties(ipopt_example_luksan_MPara5_2_2 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MPara5_2_2 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + add_test(NAME ipopt_example_luksan_MPara5_2_3 + COMMAND $ MPara5_2_3 10) + set_tests_properties(ipopt_example_luksan_MPara5_2_3 PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_luksan_MPara5_2_3 PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + set(Cpp_example_SRCS ${Ipopt_DIR}/examples/Cpp_example/cpp_example.cpp + ${Ipopt_DIR}/examples/Cpp_example/MyNLP.cpp) + + add_executable_mod(cpp_example ${Cpp_example_SRCS}) + target_link_libraries(cpp_example ipopt) + if (COIN_COMPILE_LTO) + set_target_properties(cpp_example PROPERTIES INTERPROCEDURAL_OPTIMIZATION true) + endif () + if (IPOPT_HAS_MUMPS) + target_link_libraries(cpp_example dmumps mumps_common seq pthread) + endif () + if (COIN_ENABLE_COMPILE_HSL) + if (IPOPT_ENABLE_LINEARSOLVERLOADER) + target_link_libraries(cpp_example hsl) + else () + target_link_libraries(cpp_example hsl-static) + endif () + if (IPOPT_HAS_HSL_OTHER) + target_link_libraries(cpp_example hsl-other) + endif () + endif () + if (MKL_FOUND) + target_link_libraries(cpp_example ${COIN_MKL_LIBS}) + else () + if (IPOPT_HAS_LAPACK OR COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_USE_SYSTEM_LAPACK) + target_link_libraries(cpp_example lapack blas libquadmath) + endif () + if (COIN_ENABLE_DOWNLOAD_CLAPACK) + target_link_libraries(cpp_example f2c) + endif () + endif () + if (COIN_ENABLE_COMPILE_HSL OR COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_ENABLE_COMPILE_HSL OR COIN_ENABLE_DOWNLOAD_MUMPS OR IPOPT_HAS_MUMPS OR COIN_USE_SYSTEM_LAPACK) + target_link_libraries(cpp_example gfortran) + endif () + if ((IPOPT_ENABLE_LINEARSOLVERLOADER OR COIN_ENABLE_DOWNLOAD_ASL OR IPOPT_BUILD_SHARED_LIBS) AND UNIX) + target_link_libraries(cpp_example dl) + endif () + if (COIN_ENABLE_DOWNLOAD_METIS) + target_link_libraries(cpp_example metis) + endif () + if (UNIX) + target_link_libraries(cpp_example m) + endif () + set_include_directories(cpp_example) + + add_test(NAME ipopt_example_cpp_example + COMMAND $) + set_tests_properties(ipopt_example_cpp_example PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_cpp_example PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + + set(hs071_c_SRCS ${Ipopt_DIR}/examples/hs071_c/hs071_c.c) + + add_executable_mod(hs071_c ${hs071_c_SRCS}) + target_link_libraries(hs071_c ipopt) + if (COIN_COMPILE_LTO) + set_target_properties(hs071_c PROPERTIES INTERPROCEDURAL_OPTIMIZATION true) + endif () + if (IPOPT_HAS_MUMPS) + target_link_libraries(hs071_c dmumps mumps_common seq pthread) + endif () + if (COIN_ENABLE_COMPILE_HSL) + if (IPOPT_ENABLE_LINEARSOLVERLOADER) + target_link_libraries(hs071_c hsl) + else () + target_link_libraries(hs071_c hsl-static) + endif () + if (IPOPT_HAS_HSL_OTHER) + target_link_libraries(hs071_c hsl-other) + endif () + endif () + if (MKL_FOUND) + target_link_libraries(hs071_c ${COIN_MKL_LIBS}) + else () + if (IPOPT_HAS_LAPACK OR COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_USE_SYSTEM_LAPACK) + target_link_libraries(hs071_c lapack blas) + endif () + if (COIN_ENABLE_DOWNLOAD_CLAPACK) + target_link_libraries(hs071_c f2c) + endif () + endif () + if (COIN_ENABLE_COMPILE_HSL OR COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_ENABLE_COMPILE_HSL OR COIN_ENABLE_DOWNLOAD_MUMPS OR IPOPT_HAS_MUMPS OR COIN_USE_SYSTEM_LAPACK) + target_link_libraries(hs071_c gfortran) + endif () + if ((IPOPT_ENABLE_LINEARSOLVERLOADER OR COIN_ENABLE_DOWNLOAD_ASL OR IPOPT_BUILD_SHARED_LIBS) AND UNIX) + target_link_libraries(hs071_c dl) + endif () + if (COIN_ENABLE_DOWNLOAD_METIS) + target_link_libraries(hs071_c metis) + endif () + if (UNIX) + target_link_libraries(hs071_c m) + endif () + set_include_directories(hs071_c) + + add_test(NAME ipopt_example_hs071_c + COMMAND $) + set_tests_properties(ipopt_example_hs071_c PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_hs071_c PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + + set(hs071_cpp_SRCS ${Ipopt_DIR}/examples/hs071_cpp/hs071_main.cpp + ${Ipopt_DIR}/examples/hs071_cpp/hs071_nlp.cpp) + + add_executable_mod(hs071_cpp ${hs071_cpp_SRCS}) + target_link_libraries(hs071_cpp ipopt) + if (COIN_COMPILE_LTO) + set_target_properties(hs071_cpp PROPERTIES INTERPROCEDURAL_OPTIMIZATION true) + endif () + if (IPOPT_HAS_MUMPS) + target_link_libraries(hs071_cpp dmumps mumps_common seq gfortran pthread) + endif () + if (COIN_ENABLE_COMPILE_HSL) + if (IPOPT_ENABLE_LINEARSOLVERLOADER) + target_link_libraries(hs071_cpp hsl) + else () + target_link_libraries(hs071_cpp hsl-static) + endif () + if (IPOPT_HAS_HSL_OTHER) + target_link_libraries(hs071_cpp hsl-other) + endif () + endif () + if (MKL_FOUND) + target_link_libraries(hs071_cpp ${COIN_MKL_LIBS}) + else () + if (IPOPT_HAS_LAPACK OR COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_USE_SYSTEM_LAPACK) + target_link_libraries(hs071_cpp lapack blas) + endif () + if (COIN_ENABLE_DOWNLOAD_CLAPACK) + target_link_libraries(hs071_cpp f2c) + endif () + endif () + if (COIN_ENABLE_COMPILE_HSL OR COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_ENABLE_COMPILE_HSL OR COIN_ENABLE_DOWNLOAD_MUMPS OR IPOPT_HAS_MUMPS OR COIN_USE_SYSTEM_LAPACK) + target_link_libraries(hs071_cpp gfortran) + endif () + if ((IPOPT_ENABLE_LINEARSOLVERLOADER OR COIN_ENABLE_DOWNLOAD_ASL OR IPOPT_BUILD_SHARED_LIBS) AND UNIX) + target_link_libraries(hs071_cpp dl) + endif () + if (COIN_ENABLE_DOWNLOAD_METIS) + target_link_libraries(hs071_cpp metis) + endif () + if (UNIX) + target_link_libraries(hs071_cpp m) + endif () + set_include_directories(hs071_cpp) + + add_test(NAME ipopt_example_hs071_cpp + COMMAND $) + set_tests_properties(ipopt_example_hs071_cpp PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_hs071_cpp PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + + + if (NOT "${CMAKE_Fortran_COMPILER}" STREQUAL "") + if (HAVE_64_BIT) + set(BIT32FCOMMENT "C") + set(BIT64FCOMMENT "") + else () + set(BIT32FCOMMENT "") + set(BIT64FCOMMENT "C") + endif () + + configure_file(${Ipopt_DIR}/examples/hs071_f/hs071_f.f.in ${CMAKE_CURRENT_BINARY_DIR}/hs071_f.f) + set(hs071_f_SRCS ${CMAKE_CURRENT_BINARY_DIR}/hs071_f.f) + + add_executable_mod(hs071_f ${hs071_f_SRCS}) + target_link_libraries(hs071_f ipopt) + if (COIN_COMPILE_LTO) + set_target_properties(hs071_f PROPERTIES INTERPROCEDURAL_OPTIMIZATION true) + endif () + if (IPOPT_HAS_MUMPS) + target_link_libraries(hs071_f dmumps mumps_common seq pthread) + endif () + if (COIN_ENABLE_COMPILE_HSL) + if (IPOPT_ENABLE_LINEARSOLVERLOADER) + target_link_libraries(hs071_f hsl) + else () + target_link_libraries(hs071_f hsl-static) + endif () + if (IPOPT_HAS_HSL_OTHER) + target_link_libraries(hs071_f hsl-other) + endif () + endif () + if (MKL_FOUND) + target_link_libraries(hs071_f ${COIN_MKL_LIBS}) + else () + if (IPOPT_HAS_LAPACK OR COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_USE_SYSTEM_LAPACK) + target_link_libraries(hs071_f lapack blas) + endif () + if (COIN_ENABLE_DOWNLOAD_CLAPACK) + target_link_libraries(hs071_f f2c) + endif () + endif () + if (COIN_ENABLE_COMPILE_HSL OR COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_ENABLE_COMPILE_HSL OR COIN_ENABLE_DOWNLOAD_MUMPS OR IPOPT_HAS_MUMPS OR COIN_USE_SYSTEM_LAPACK) + target_link_libraries(hs071_f gfortran) + endif () + if ((IPOPT_ENABLE_LINEARSOLVERLOADER OR COIN_ENABLE_DOWNLOAD_ASL OR IPOPT_BUILD_SHARED_LIBS) AND UNIX) + target_link_libraries(hs071_f dl) + endif () + if (COIN_ENABLE_DOWNLOAD_METIS) + target_link_libraries(hs071_f metis) + endif () + if (UNIX) + target_link_libraries(hs071_f m) + endif () + set_include_directories(hs071_f) + add_test(NAME ipopt_example_hs071_f + COMMAND $) + set_tests_properties(ipopt_example_hs071_f PROPERTIES TIMEOUT 30) + set_tests_properties(ipopt_example_hs071_f PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") + endif () +endif () + +# +# Install part +# + +set(LINALG_HDRS ${Ipopt_DIR}/src/LinAlg/IpMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/IpSymMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/IpExpansionMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/IpVector.hpp + ${Ipopt_DIR}/src/LinAlg/IpDenseVector.hpp + ${Ipopt_DIR}/src/LinAlg/IpCompoundVector.hpp + ${Ipopt_DIR}/src/LinAlg/IpCompoundMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/IpCompoundSymMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/IpSumSymMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/IpDiagMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/IpIdentityMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/IpScaledMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/IpSymScaledMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/IpZeroSymMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/IpBlas.hpp + ${Ipopt_DIR}/src/LinAlg/IpLapack.hpp) + +set(TMATRICES_HDRS ${Ipopt_DIR}/src/LinAlg/TMatrices/IpGenTMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/TMatrices/IpSymTMatrix.hpp + ${Ipopt_DIR}/src/LinAlg/TMatrices/IpTripletHelper.hpp) + +set(INTERFACES_HDRS ${Ipopt_DIR}/src/Interfaces/IpAlgTypes.hpp + ${Ipopt_DIR}/src/Interfaces/IpIpoptApplication.hpp + ${Ipopt_DIR}/src/Interfaces/IpNLP.hpp + ${Ipopt_DIR}/src/Interfaces/IpReturnCodes.h + ${Ipopt_DIR}/src/Interfaces/IpReturnCodes.hpp + ${Ipopt_DIR}/src/Interfaces/IpReturnCodes_inc.h + ${Ipopt_DIR}/src/Interfaces/IpReturnCodes.inc + ${Ipopt_DIR}/src/Interfaces/IpSolveStatistics.hpp + ${Ipopt_DIR}/src/Interfaces/IpStdCInterface.h + ${Ipopt_DIR}/src/Interfaces/IpTNLP.hpp + ${Ipopt_DIR}/src/Interfaces/IpTNLPAdapter.hpp + ${Ipopt_DIR}/src/Interfaces/IpTNLPReducer.hpp) + +set(COMMON_HDRS ${Ipopt_DIR}/src/Common/IpCachedResults.hpp + ${Ipopt_DIR}/src/Common/IpDebug.hpp + ${Ipopt_DIR}/src/Common/IpException.hpp + ${Ipopt_DIR}/src/Common/IpJournalist.hpp + ${Ipopt_DIR}/src/Common/IpObserver.hpp + ${Ipopt_DIR}/src/Common/IpOptionsList.hpp + ${Ipopt_DIR}/src/Common/IpoptConfig.h + ${Ipopt_DIR}/src/Common/config_ipopt_default.h + ${Ipopt_DIR}/src/Common/IpReferenced.hpp + ${Ipopt_DIR}/src/Common/IpRegOptions.hpp + ${Ipopt_DIR}/src/Common/IpSmartPtr.hpp + ${Ipopt_DIR}/src/Common/IpTaggedObject.hpp + ${Ipopt_DIR}/src/Common/IpTimedTask.hpp + ${Ipopt_DIR}/src/Common/IpTypes.hpp + ${Ipopt_DIR}/src/Common/IpUtils.hpp) + +set(ALGORITHMS_HDRS ${Ipopt_DIR}/src/Algorithm/IpIpoptCalculatedQuantities.hpp + ${Ipopt_DIR}/src/Algorithm/IpIpoptData.hpp + ${Ipopt_DIR}/src/Algorithm/IpIteratesVector.hpp + ${Ipopt_DIR}/src/Algorithm/IpTimingStatistics.hpp + ${Ipopt_DIR}/src/Algorithm/IpIpoptNLP.hpp + ${Ipopt_DIR}/src/Algorithm/IpOrigIpoptNLP.hpp + ${Ipopt_DIR}/src/Algorithm/IpNLPScaling.hpp + ${Ipopt_DIR}/src/Algorithm/IpAlgBuilder.hpp + ${Ipopt_DIR}/src/Algorithm/IpIpoptAlg.hpp + ${Ipopt_DIR}/src/Algorithm/IpAlgStrategy.hpp + ${Ipopt_DIR}/src/Algorithm/IpSearchDirCalculator.hpp + ${Ipopt_DIR}/src/Algorithm/IpLineSearch.hpp + ${Ipopt_DIR}/src/Algorithm/IpMuUpdate.hpp + ${Ipopt_DIR}/src/Algorithm/IpConvCheck.hpp + ${Ipopt_DIR}/src/Algorithm/IpIterateInitializer.hpp + ${Ipopt_DIR}/src/Algorithm/IpIterationOutput.hpp + ${Ipopt_DIR}/src/Algorithm/IpHessianUpdater.hpp + ${Ipopt_DIR}/src/Algorithm/IpEqMultCalculator.hpp + ${Ipopt_DIR}/src/Algorithm/IpAugSystemSolver.hpp + ${Ipopt_DIR}/src/Algorithm/IpPDSystemSolver.hpp) + +set(LINEARSOLVERS_HDRS ${Ipopt_DIR}/src/Algorithm/LinearSolvers/IpSymLinearSolver.hpp) + +set(ALL_HDRS ${LINALG_HDRS} + ${TMATRICES_HDRS} + ${INTERFACES_HDRS} + ${COMMON_HDRS} + ${ALGORITHMS_HDRS} + ${LINEARSOLVERS_HDRS}) + + +install(TARGETS ipopt + RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} + LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} + ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR}) + +install(FILES ${ALL_HDRS} + DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/Ipopt) + +install(FILES ${Ipopt_DIR}/AUTHORS + DESTINATION ${CMAKE_INSTALL_DOCDIR}/Ipopt/) diff --git a/Ipopt-3.13.4/Ipopt/doxydoc/doxygen.conf.in b/Ipopt-3.13.4/Ipopt/doxydoc/doxygen.conf.in new file mode 100644 index 000000000..30cbeb423 --- /dev/null +++ b/Ipopt-3.13.4/Ipopt/doxydoc/doxygen.conf.in @@ -0,0 +1,1517 @@ +# Doxyfile 1.6.1 + +# This file describes the settings to be used by the documentation system +# doxygen (www.doxygen.org) for a project +# +# All text after a hash (#) is considered a comment and will be ignored +# The format is: +# TAG = value [value, ...] +# For lists items can also be appended using: +# TAG += value [value, ...] +# Values that contain spaces should be placed between quotes (" ") + +#--------------------------------------------------------------------------- +# Project related configuration options +#--------------------------------------------------------------------------- + +# This tag specifies the encoding used for all characters in the config file +# that follow. The default is UTF-8 which is also the encoding used for all +# text before the first occurrence of this tag. Doxygen uses libiconv (or the +# iconv built into libc) for the transcoding. See +# http://www.gnu.org/software/libiconv for the list of possible encodings. + +DOXYFILE_ENCODING = UTF-8 + +# The PROJECT_NAME tag is a single word (or a sequence of words surrounded +# by quotes) that should identify the project. + +PROJECT_NAME = @PACKAGE_NAME@ + +# The PROJECT_NUMBER tag can be used to enter a project or revision number. +# This could be handy for archiving the generated documentation or +# if some version control system is used. + +PROJECT_NUMBER = @PACKAGE_VERSION@ + +# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) +# base path where the generated documentation will be put. +# If a relative path is entered, it will be relative to the location +# where doxygen was started. If left blank the current directory will be used. + +OUTPUT_DIRECTORY = doxydoc + +# If the CREATE_SUBDIRS tag is set to YES, then doxygen will create +# 4096 sub-directories (in 2 levels) under the output directory of each output +# format and will distribute the generated files over these directories. +# Enabling this option can be useful when feeding doxygen a huge amount of +# source files, where putting all generated files in the same directory would +# otherwise cause performance problems for the file system. + +CREATE_SUBDIRS = NO + +# The OUTPUT_LANGUAGE tag is used to specify the language in which all +# documentation generated by doxygen is written. Doxygen will use this +# information to generate all constant output in the proper language. +# The default language is English, other supported languages are: +# Afrikaans, Arabic, Brazilian, Catalan, Chinese, Chinese-Traditional, +# Croatian, Czech, Danish, Dutch, Esperanto, Farsi, Finnish, French, German, +# Greek, Hungarian, Italian, Japanese, Japanese-en (Japanese with English +# messages), Korean, Korean-en, Lithuanian, Norwegian, Macedonian, Persian, +# Polish, Portuguese, Romanian, Russian, Serbian, Serbian-Cyrilic, Slovak, +# Slovene, Spanish, Swedish, Ukrainian, and Vietnamese. + +OUTPUT_LANGUAGE = English + +# If the BRIEF_MEMBER_DESC tag is set to YES (the default) Doxygen will +# include brief member descriptions after the members that are listed in +# the file and class documentation (similar to JavaDoc). +# Set to NO to disable this. + +BRIEF_MEMBER_DESC = YES + +# If the REPEAT_BRIEF tag is set to YES (the default) Doxygen will prepend +# the brief description of a member or function before the detailed description. +# Note: if both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the +# brief descriptions will be completely suppressed. + +REPEAT_BRIEF = YES + +# This tag implements a quasi-intelligent brief description abbreviator +# that is used to form the text in various listings. Each string +# in this list, if found as the leading text of the brief description, will be +# stripped from the text and the result after processing the whole list, is +# used as the annotated text. Otherwise, the brief description is used as-is. +# If left blank, the following values are used ("$name" is automatically +# replaced with the name of the entity): "The $name class" "The $name widget" +# "The $name file" "is" "provides" "specifies" "contains" +# "represents" "a" "an" "the" + +ABBREVIATE_BRIEF = + +# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then +# Doxygen will generate a detailed section even if there is only a brief +# description. + +ALWAYS_DETAILED_SEC = NO + +# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all +# inherited members of a class in the documentation of that class as if those +# members were ordinary class members. Constructors, destructors and assignment +# operators of the base classes will not be shown. + +INLINE_INHERITED_MEMB = NO + +# If the FULL_PATH_NAMES tag is set to YES then Doxygen will prepend the full +# path before files name in the file list and in the header files. If set +# to NO the shortest path that makes the file name unique will be used. + +FULL_PATH_NAMES = YES + +# If the FULL_PATH_NAMES tag is set to YES then the STRIP_FROM_PATH tag +# can be used to strip a user-defined part of the path. Stripping is +# only done if one of the specified strings matches the left-hand part of +# the path. The tag can be used to show relative paths in the file list. +# If left blank the directory from which doxygen is run is used as the +# path to strip. + +STRIP_FROM_PATH = "@abs_top_srcdir@/" + +# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of +# the path mentioned in the documentation of a class, which tells +# the reader which header file to include in order to use a class. +# If left blank only the name of the header file containing the class +# definition is used. Otherwise one should specify the include paths that +# are normally passed to the compiler using the -I flag. + +STRIP_FROM_INC_PATH = + +# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter +# (but less readable) file names. This can be useful is your file systems +# doesn't support long names like on DOS, Mac, or CD-ROM. + +SHORT_NAMES = NO + +# If the JAVADOC_AUTOBRIEF tag is set to YES then Doxygen +# will interpret the first line (until the first dot) of a JavaDoc-style +# comment as the brief description. If set to NO, the JavaDoc +# comments will behave just like regular Qt-style comments +# (thus requiring an explicit @brief command for a brief description.) + +JAVADOC_AUTOBRIEF = YES + +# If the QT_AUTOBRIEF tag is set to YES then Doxygen will +# interpret the first line (until the first dot) of a Qt-style +# comment as the brief description. If set to NO, the comments +# will behave just like regular Qt-style comments (thus requiring +# an explicit \brief command for a brief description.) + +QT_AUTOBRIEF = YES + +# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make Doxygen +# treat a multi-line C++ special comment block (i.e. a block of //! or /// +# comments) as a brief description. This used to be the default behaviour. +# The new default is to treat a multi-line C++ comment block as a detailed +# description. Set this tag to YES if you prefer the old behaviour instead. + +MULTILINE_CPP_IS_BRIEF = NO + +# If the INHERIT_DOCS tag is set to YES (the default) then an undocumented +# member inherits the documentation from any documented member that it +# re-implements. + +INHERIT_DOCS = YES + +# If the SEPARATE_MEMBER_PAGES tag is set to YES, then doxygen will produce +# a new page for each member. If set to NO, the documentation of a member will +# be part of the file/class/namespace that contains it. + +SEPARATE_MEMBER_PAGES = NO + +# The TAB_SIZE tag can be used to set the number of spaces in a tab. +# Doxygen uses this value to replace tabs by spaces in code fragments. + +TAB_SIZE = 8 + +# This tag can be used to specify a number of aliases that acts +# as commands in the documentation. An alias has the form "name=value". +# For example adding "sideeffect=\par Side Effects:\n" will allow you to +# put the command \sideeffect (or @sideeffect) in the documentation, which +# will result in a user-defined paragraph with heading "Side Effects:". +# You can put \n's in the value part of an alias to insert newlines. + +ALIASES = + +# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C +# sources only. Doxygen will then generate output that is more tailored for C. +# For instance, some of the names that are used will be different. The list +# of all members will be omitted, etc. + +OPTIMIZE_OUTPUT_FOR_C = NO + +# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java +# sources only. Doxygen will then generate output that is more tailored for +# Java. For instance, namespaces will be presented as packages, qualified +# scopes will look different, etc. + +OPTIMIZE_OUTPUT_JAVA = NO + +# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran +# sources only. Doxygen will then generate output that is more tailored for +# Fortran. + +OPTIMIZE_FOR_FORTRAN = NO + +# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL +# sources. Doxygen will then generate output that is tailored for +# VHDL. + +OPTIMIZE_OUTPUT_VHDL = NO + +# Doxygen selects the parser to use depending on the extension of the files it parses. +# With this tag you can assign which parser to use for a given extension. +# Doxygen has a built-in mapping, but you can override or extend it using this tag. +# The format is ext=language, where ext is a file extension, and language is one of +# the parsers supported by doxygen: IDL, Java, Javascript, C#, C, C++, D, PHP, +# Objective-C, Python, Fortran, VHDL, C, C++. For instance to make doxygen treat +# .inc files as Fortran files (default is PHP), and .f files as C (default is Fortran), +# use: inc=Fortran f=C. Note that for custom extensions you also need to set FILE_PATTERNS otherwise the files are not read by doxygen. + +EXTENSION_MAPPING = + +# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want +# to include (a tag file for) the STL sources as input, then you should +# set this tag to YES in order to let doxygen match functions declarations and +# definitions whose arguments contain STL classes (e.g. func(std::string); v.s. +# func(std::string) {}). This also make the inheritance and collaboration +# diagrams that involve STL classes more complete and accurate. + +BUILTIN_STL_SUPPORT = YES + +# If you use Microsoft's C++/CLI language, you should set this option to YES to +# enable parsing support. + +CPP_CLI_SUPPORT = NO + +# Set the SIP_SUPPORT tag to YES if your project consists of sip sources only. +# Doxygen will parse them like normal C++ but will assume all classes use public +# instead of private inheritance when no explicit protection keyword is present. + +SIP_SUPPORT = NO + +# For Microsoft's IDL there are propget and propput attributes to indicate getter +# and setter methods for a property. Setting this option to YES (the default) +# will make doxygen to replace the get and set methods by a property in the +# documentation. This will only work if the methods are indeed getting or +# setting a simple type. If this is not the case, or you want to show the +# methods anyway, you should set this option to NO. + +IDL_PROPERTY_SUPPORT = YES + +# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC +# tag is set to YES, then doxygen will reuse the documentation of the first +# member in the group (if any) for the other members of the group. By default +# all members of a group must be documented explicitly. + +DISTRIBUTE_GROUP_DOC = NO + +# Set the SUBGROUPING tag to YES (the default) to allow class member groups of +# the same type (for instance a group of public functions) to be put as a +# subgroup of that type (e.g. under the Public Functions section). Set it to +# NO to prevent subgrouping. Alternatively, this can be done per class using +# the \nosubgrouping command. + +SUBGROUPING = YES + +# When TYPEDEF_HIDES_STRUCT is enabled, a typedef of a struct, union, or enum +# is documented as struct, union, or enum with the name of the typedef. So +# typedef struct TypeS {} TypeT, will appear in the documentation as a struct +# with name TypeT. When disabled the typedef will appear as a member of a file, +# namespace, or class. And the struct will be named TypeS. This can typically +# be useful for C code in case the coding convention dictates that all compound +# types are typedef'ed and only the typedef is referenced, never the tag name. + +TYPEDEF_HIDES_STRUCT = NO + +# The SYMBOL_CACHE_SIZE determines the size of the internal cache use to +# determine which symbols to keep in memory and which to flush to disk. +# When the cache is full, less often used symbols will be written to disk. +# For small to medium size projects (<1000 input files) the default value is +# probably good enough. For larger projects a too small cache size can cause +# doxygen to be busy swapping symbols to and from disk most of the time +# causing a significant performance penality. +# If the system has enough physical memory increasing the cache will improve the +# performance by keeping more symbols in memory. Note that the value works on +# a logarithmic scale so increasing the size by one will rougly double the +# memory usage. The cache size is given by this formula: +# 2^(16+SYMBOL_CACHE_SIZE). The valid range is 0..9, the default is 0, +# corresponding to a cache size of 2^16 = 65536 symbols + +SYMBOL_CACHE_SIZE = 0 + +#--------------------------------------------------------------------------- +# Build related configuration options +#--------------------------------------------------------------------------- + +# If the EXTRACT_ALL tag is set to YES doxygen will assume all entities in +# documentation are documented, even if no documentation was available. +# Private class members and static file members will be hidden unless +# the EXTRACT_PRIVATE and EXTRACT_STATIC tags are set to YES + +EXTRACT_ALL = YES + +# If the EXTRACT_PRIVATE tag is set to YES all private members of a class +# will be included in the documentation. + +EXTRACT_PRIVATE = YES + +# If the EXTRACT_STATIC tag is set to YES all static members of a file +# will be included in the documentation. + +EXTRACT_STATIC = YES + +# If the EXTRACT_LOCAL_CLASSES tag is set to YES classes (and structs) +# defined locally in source files will be included in the documentation. +# If set to NO only classes defined in header files are included. + +EXTRACT_LOCAL_CLASSES = YES + +# This flag is only useful for Objective-C code. When set to YES local +# methods, which are defined in the implementation section but not in +# the interface are included in the documentation. +# If set to NO (the default) only methods in the interface are included. + +EXTRACT_LOCAL_METHODS = NO + +# If this flag is set to YES, the members of anonymous namespaces will be +# extracted and appear in the documentation as a namespace called +# 'anonymous_namespace{file}', where file will be replaced with the base +# name of the file that contains the anonymous namespace. By default +# anonymous namespace are hidden. + +EXTRACT_ANON_NSPACES = YES + +# If the HIDE_UNDOC_MEMBERS tag is set to YES, Doxygen will hide all +# undocumented members of documented classes, files or namespaces. +# If set to NO (the default) these members will be included in the +# various overviews, but no documentation section is generated. +# This option has no effect if EXTRACT_ALL is enabled. + +HIDE_UNDOC_MEMBERS = NO + +# If the HIDE_UNDOC_CLASSES tag is set to YES, Doxygen will hide all +# undocumented classes that are normally visible in the class hierarchy. +# If set to NO (the default) these classes will be included in the various +# overviews. This option has no effect if EXTRACT_ALL is enabled. + +HIDE_UNDOC_CLASSES = NO + +# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, Doxygen will hide all +# friend (class|struct|union) declarations. +# If set to NO (the default) these declarations will be included in the +# documentation. + +HIDE_FRIEND_COMPOUNDS = NO + +# If the HIDE_IN_BODY_DOCS tag is set to YES, Doxygen will hide any +# documentation blocks found inside the body of a function. +# If set to NO (the default) these blocks will be appended to the +# function's detailed documentation block. + +HIDE_IN_BODY_DOCS = NO + +# The INTERNAL_DOCS tag determines if documentation +# that is typed after a \internal command is included. If the tag is set +# to NO (the default) then the documentation will be excluded. +# Set it to YES to include the internal documentation. + +INTERNAL_DOCS = NO + +# If the CASE_SENSE_NAMES tag is set to NO then Doxygen will only generate +# file names in lower-case letters. If set to YES upper-case letters are also +# allowed. This is useful if you have classes or files whose names only differ +# in case and if your file system supports case sensitive file names. Windows +# and Mac users are advised to set this option to NO. + +CASE_SENSE_NAMES = YES + +# If the HIDE_SCOPE_NAMES tag is set to NO (the default) then Doxygen +# will show members with their full class and namespace scopes in the +# documentation. If set to YES the scope will be hidden. + +HIDE_SCOPE_NAMES = NO + +# If the SHOW_INCLUDE_FILES tag is set to YES (the default) then Doxygen +# will put a list of the files that are included by a file in the documentation +# of that file. + +SHOW_INCLUDE_FILES = YES + +# If the INLINE_INFO tag is set to YES (the default) then a tag [inline] +# is inserted in the documentation for inline members. + +INLINE_INFO = YES + +# If the SORT_MEMBER_DOCS tag is set to YES (the default) then doxygen +# will sort the (detailed) documentation of file and class members +# alphabetically by member name. If set to NO the members will appear in +# declaration order. + +SORT_MEMBER_DOCS = NO + +# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the +# brief documentation of file, namespace and class members alphabetically +# by member name. If set to NO (the default) the members will appear in +# declaration order. + +SORT_BRIEF_DOCS = NO + +# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the (brief and detailed) documentation of class members so that constructors and destructors are listed first. If set to NO (the default) the constructors will appear in the respective orders defined by SORT_MEMBER_DOCS and SORT_BRIEF_DOCS. This tag will be ignored for brief docs if SORT_BRIEF_DOCS is set to NO and ignored for detailed docs if SORT_MEMBER_DOCS is set to NO. + +SORT_MEMBERS_CTORS_1ST = NO + +# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the +# hierarchy of group names into alphabetical order. If set to NO (the default) +# the group names will appear in their defined order. + +SORT_GROUP_NAMES = NO + +# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be +# sorted by fully-qualified names, including namespaces. If set to +# NO (the default), the class list will be sorted only by class name, +# not including the namespace part. +# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. +# Note: This option applies only to the class list, not to the +# alphabetical list. + +SORT_BY_SCOPE_NAME = NO + +# The GENERATE_TODOLIST tag can be used to enable (YES) or +# disable (NO) the todo list. This list is created by putting \todo +# commands in the documentation. + +GENERATE_TODOLIST = YES + +# The GENERATE_TESTLIST tag can be used to enable (YES) or +# disable (NO) the test list. This list is created by putting \test +# commands in the documentation. + +GENERATE_TESTLIST = YES + +# The GENERATE_BUGLIST tag can be used to enable (YES) or +# disable (NO) the bug list. This list is created by putting \bug +# commands in the documentation. + +GENERATE_BUGLIST = YES + +# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or +# disable (NO) the deprecated list. This list is created by putting +# \deprecated commands in the documentation. + +GENERATE_DEPRECATEDLIST= YES + +# The ENABLED_SECTIONS tag can be used to enable conditional +# documentation sections, marked by \if sectionname ... \endif. + +ENABLED_SECTIONS = + +# The MAX_INITIALIZER_LINES tag determines the maximum number of lines +# the initial value of a variable or define consists of for it to appear in +# the documentation. If the initializer consists of more lines than specified +# here it will be hidden. Use a value of 0 to hide initializers completely. +# The appearance of the initializer of individual variables and defines in the +# documentation can be controlled using \showinitializer or \hideinitializer +# command in the documentation regardless of this setting. + +MAX_INITIALIZER_LINES = 30 + +# Set the SHOW_USED_FILES tag to NO to disable the list of files generated +# at the bottom of the documentation of classes and structs. If set to YES the +# list will mention the files that were used to generate the documentation. + +SHOW_USED_FILES = YES + +# If the sources in your project are distributed over multiple directories +# then setting the SHOW_DIRECTORIES tag to YES will show the directory hierarchy +# in the documentation. The default is NO. + +SHOW_DIRECTORIES = YES + +# Set the SHOW_FILES tag to NO to disable the generation of the Files page. +# This will remove the Files entry from the Quick Index and from the +# Folder Tree View (if specified). The default is YES. + +SHOW_FILES = YES + +# Set the SHOW_NAMESPACES tag to NO to disable the generation of the +# Namespaces page. +# This will remove the Namespaces entry from the Quick Index +# and from the Folder Tree View (if specified). The default is YES. + +SHOW_NAMESPACES = YES + +# The FILE_VERSION_FILTER tag can be used to specify a program or script that +# doxygen should invoke to get the current version for each file (typically from +# the version control system). Doxygen will invoke the program by executing (via +# popen()) the command , where is the value of +# the FILE_VERSION_FILTER tag, and is the name of an input file +# provided by doxygen. Whatever the program writes to standard output +# is used as the file version. See the manual for examples. + +FILE_VERSION_FILTER = + +# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed by +# doxygen. The layout file controls the global structure of the generated output files +# in an output format independent way. The create the layout file that represents +# doxygen's defaults, run doxygen with the -l option. You can optionally specify a +# file name after the option, if omitted DoxygenLayout.xml will be used as the name +# of the layout file. + +LAYOUT_FILE = + +#--------------------------------------------------------------------------- +# configuration options related to warning and progress messages +#--------------------------------------------------------------------------- + +# The QUIET tag can be used to turn on/off the messages that are generated +# by doxygen. Possible values are YES and NO. If left blank NO is used. + +QUIET = NO + +# The WARNINGS tag can be used to turn on/off the warning messages that are +# generated by doxygen. Possible values are YES and NO. If left blank +# NO is used. + +WARNINGS = YES + +# If WARN_IF_UNDOCUMENTED is set to YES, then doxygen will generate warnings +# for undocumented members. If EXTRACT_ALL is set to YES then this flag will +# automatically be disabled. + +WARN_IF_UNDOCUMENTED = YES + +# If WARN_IF_DOC_ERROR is set to YES, doxygen will generate warnings for +# potential errors in the documentation, such as not documenting some +# parameters in a documented function, or documenting parameters that +# don't exist or using markup commands wrongly. + +WARN_IF_DOC_ERROR = YES + +# This WARN_NO_PARAMDOC option can be abled to get warnings for +# functions that are documented, but have no documentation for their parameters +# or return value. If set to NO (the default) doxygen will only warn about +# wrong or incomplete parameter documentation, but not about the absence of +# documentation. + +WARN_NO_PARAMDOC = NO + +# The WARN_FORMAT tag determines the format of the warning messages that +# doxygen can produce. The string should contain the $file, $line, and $text +# tags, which will be replaced by the file and line number from which the +# warning originated and the warning text. Optionally the format may contain +# $version, which will be replaced by the version of the file (if it could +# be obtained via FILE_VERSION_FILTER) + +WARN_FORMAT = "$file:$line: $text" + +# The WARN_LOGFILE tag can be used to specify a file to which warning +# and error messages should be written. If left blank the output is written +# to stderr. + +WARN_LOGFILE = @coin_doxy_logname@ + +#--------------------------------------------------------------------------- +# configuration options related to the input files +#--------------------------------------------------------------------------- + +# The INPUT tag can be used to specify the files and/or directories that +# contain documented source files. You may enter file names like "myfile.cpp" +# or directories like "/usr/src/myproject". Separate the files or directories +# with spaces. For COIN, the default is the package base to suck in all +# source directories present in the package. Externals will be processed +# if present. + +INPUT = @Ipopt_DIR@/src + +# This tag can be used to specify the character encoding of the source files +# that doxygen parses. Internally doxygen uses the UTF-8 encoding, which is +# also the default input encoding. Doxygen uses libiconv (or the iconv built +# into libc) for the transcoding. See http://www.gnu.org/software/libiconv for +# the list of possible encodings. + +INPUT_ENCODING = UTF-8 + +# If the value of the INPUT tag contains directories, you can use the +# FILE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp +# and *.h) to filter out the source-files in the directories. If left +# blank the following patterns are tested: +# *.c *.cc *.cxx *.cpp *.c++ *.java *.ii *.ixx *.ipp *.i++ *.inl *.h *.hh *.hxx +# *.hpp *.h++ *.idl *.odl *.cs *.php *.php3 *.inc *.m *.mm *.py *.f90 + +FILE_PATTERNS = *.hpp \ + *.h + +# The RECURSIVE tag can be used to turn specify whether or not subdirectories +# should be searched for input files as well. Possible values are YES and NO. +# If left blank NO is used. + +RECURSIVE = YES + +# The EXCLUDE tag can be used to specify files and/or directories that should +# excluded from the INPUT source files. This way you can easily exclude a +# subdirectory from a directory tree whose root is specified with the INPUT tag. + +EXCLUDE = + +# The EXCLUDE_SYMLINKS tag can be used select whether or not files or +# directories that are symbolic links (a Unix filesystem feature) are excluded +# from the input. + +EXCLUDE_SYMLINKS = NO + +# If the value of the INPUT tag contains directories, you can use the +# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude +# certain files from those directories. Note that the wildcards are matched +# against the file with absolute path, so to exclude all test directories +# for example use the pattern */test/* + +EXCLUDE_PATTERNS = */.svn* @coin_doxy_excludes@ + +# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names +# (namespaces, classes, functions, etc.) that should be excluded from the +# output. The symbol name can be a fully qualified name, a word, or if the +# wildcard * is used, a substring. Examples: ANamespace, AClass, +# AClass::ANamespace, ANamespace::*Test + +EXCLUDE_SYMBOLS = + +# The EXAMPLE_PATH tag can be used to specify one or more files or +# directories that contain example code fragments that are included (see +# the \include command). + +EXAMPLE_PATH = + +# If the value of the EXAMPLE_PATH tag contains directories, you can use the +# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp +# and *.h) to filter out the source-files in the directories. If left +# blank all files are included. + +EXAMPLE_PATTERNS = + +# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be +# searched for input files to be used with the \include or \dontinclude +# commands irrespective of the value of the RECURSIVE tag. +# Possible values are YES and NO. If left blank NO is used. + +EXAMPLE_RECURSIVE = NO + +# The IMAGE_PATH tag can be used to specify one or more files or +# directories that contain image that are included in the documentation (see +# the \image command). + +IMAGE_PATH = + +# The INPUT_FILTER tag can be used to specify a program that doxygen should +# invoke to filter for each input file. Doxygen will invoke the filter program +# by executing (via popen()) the command , where +# is the value of the INPUT_FILTER tag, and is the name of an +# input file. Doxygen will then use the output that the filter program writes +# to standard output. +# If FILTER_PATTERNS is specified, this tag will be +# ignored. + +INPUT_FILTER = + +# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern +# basis. +# Doxygen will compare the file name with each pattern and apply the +# filter if there is a match. +# The filters are a list of the form: +# pattern=filter (like *.cpp=my_cpp_filter). See INPUT_FILTER for further +# info on how filters are used. If FILTER_PATTERNS is empty, INPUT_FILTER +# is applied to all files. + +FILTER_PATTERNS = + +# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using +# INPUT_FILTER) will be used to filter the input files when producing source +# files to browse (i.e. when SOURCE_BROWSER is set to YES). + +FILTER_SOURCE_FILES = NO + +#--------------------------------------------------------------------------- +# configuration options related to source browsing +#--------------------------------------------------------------------------- + +# If the SOURCE_BROWSER tag is set to YES then a list of source files will +# be generated. Documented entities will be cross-referenced with these sources. +# Note: To get rid of all source code in the generated output, make sure also +# VERBATIM_HEADERS is set to NO. + +SOURCE_BROWSER = YES + +# Setting the INLINE_SOURCES tag to YES will include the body +# of functions and classes directly in the documentation. + +INLINE_SOURCES = NO + +# Setting the STRIP_CODE_COMMENTS tag to YES (the default) will instruct +# doxygen to hide any special comment blocks from generated source code +# fragments. Normal C and C++ comments will always remain visible. + +STRIP_CODE_COMMENTS = YES + +# If the REFERENCED_BY_RELATION tag is set to YES +# then for each documented function all documented +# functions referencing it will be listed. + +REFERENCED_BY_RELATION = NO + +# If the REFERENCES_RELATION tag is set to YES +# then for each documented function all documented entities +# called/used by that function will be listed. + +REFERENCES_RELATION = NO + +# If the REFERENCES_LINK_SOURCE tag is set to YES (the default) +# and SOURCE_BROWSER tag is set to YES, then the hyperlinks from +# functions in REFERENCES_RELATION and REFERENCED_BY_RELATION lists will +# link to the source code. +# Otherwise they will link to the documentation. + +REFERENCES_LINK_SOURCE = YES + +# If the USE_HTAGS tag is set to YES then the references to source code +# will point to the HTML generated by the htags(1) tool instead of doxygen +# built-in source browser. The htags tool is part of GNU's global source +# tagging system (see http://www.gnu.org/software/global/global.html). You +# will need version 4.8.6 or higher. + +USE_HTAGS = NO + +# If the VERBATIM_HEADERS tag is set to YES (the default) then Doxygen +# will generate a verbatim copy of the header file for each class for +# which an include is specified. Set to NO to disable this. + +VERBATIM_HEADERS = YES + +#--------------------------------------------------------------------------- +# configuration options related to the alphabetical class index +#--------------------------------------------------------------------------- + +# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index +# of all compounds will be generated. Enable this if the project +# contains a lot of classes, structs, unions or interfaces. + +ALPHABETICAL_INDEX = YES + +# If the alphabetical index is enabled (see ALPHABETICAL_INDEX) then +# the COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns +# in which this list will be split (can be a number in the range [1..20]) + +COLS_IN_ALPHA_INDEX = 3 + +# In case all classes in a project start with a common prefix, all +# classes will be put under the same header in the alphabetical index. +# The IGNORE_PREFIX tag can be used to specify one or more prefixes that +# should be ignored while generating the index headers. + +IGNORE_PREFIX = + +#--------------------------------------------------------------------------- +# configuration options related to the HTML output +#--------------------------------------------------------------------------- + +# If the GENERATE_HTML tag is set to YES (the default) Doxygen will +# generate HTML output. + +GENERATE_HTML = YES + +# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. +# If a relative path is entered the value of OUTPUT_DIRECTORY will be +# put in front of it. If left blank `html' will be used as the default path. + +HTML_OUTPUT = html + +# The HTML_FILE_EXTENSION tag can be used to specify the file extension for +# each generated HTML page (for example: .htm,.php,.asp). If it is left blank +# doxygen will generate files with .html extension. + +HTML_FILE_EXTENSION = .html + +# The HTML_HEADER tag can be used to specify a personal HTML header for +# each generated HTML page. If it is left blank doxygen will generate a +# standard header. + +HTML_HEADER = + +# The HTML_FOOTER tag can be used to specify a personal HTML footer for +# each generated HTML page. If it is left blank doxygen will generate a +# standard footer. + +HTML_FOOTER = + +# The HTML_STYLESHEET tag can be used to specify a user-defined cascading +# style sheet that is used by each HTML page. It can be used to +# fine-tune the look of the HTML output. If the tag is left blank doxygen +# will generate a default style sheet. Note that doxygen will try to copy +# the style sheet file to the HTML output directory, so don't put your own +# stylesheet in the HTML output directory as well, or it will be erased! + +HTML_STYLESHEET = + +# If the HTML_ALIGN_MEMBERS tag is set to YES, the members of classes, +# files or namespaces will be aligned in HTML using tables. If set to +# NO a bullet list will be used. + +HTML_ALIGN_MEMBERS = YES + +# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML +# documentation will contain sections that can be hidden and shown after the +# page has loaded. For this to work a browser that supports +# JavaScript and DHTML is required (for instance Mozilla 1.0+, Firefox +# Netscape 6.0+, Internet explorer 5.0+, Konqueror, or Safari). + +HTML_DYNAMIC_SECTIONS = YES + +# If the GENERATE_DOCSET tag is set to YES, additional index files +# will be generated that can be used as input for Apple's Xcode 3 +# integrated development environment, introduced with OSX 10.5 (Leopard). +# To create a documentation set, doxygen will generate a Makefile in the +# HTML output directory. Running make will produce the docset in that +# directory and running "make install" will install the docset in +# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find +# it at startup. +# See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html for more information. + +GENERATE_DOCSET = NO + +# When GENERATE_DOCSET tag is set to YES, this tag determines the name of the +# feed. A documentation feed provides an umbrella under which multiple +# documentation sets from a single provider (such as a company or product suite) +# can be grouped. + +DOCSET_FEEDNAME = "Doxygen generated docs" + +# When GENERATE_DOCSET tag is set to YES, this tag specifies a string that +# should uniquely identify the documentation set bundle. This should be a +# reverse domain-name style string, e.g. com.mycompany.MyDocSet. Doxygen +# will append .docset to the name. + +DOCSET_BUNDLE_ID = org.doxygen.Project + +# If the GENERATE_HTMLHELP tag is set to YES, additional index files +# will be generated that can be used as input for tools like the +# Microsoft HTML help workshop to generate a compiled HTML help file (.chm) +# of the generated HTML documentation. + +GENERATE_HTMLHELP = NO + +# If the GENERATE_HTMLHELP tag is set to YES, the CHM_FILE tag can +# be used to specify the file name of the resulting .chm file. You +# can add a path in front of the file if the result should not be +# written to the html output directory. + +CHM_FILE = + +# If the GENERATE_HTMLHELP tag is set to YES, the HHC_LOCATION tag can +# be used to specify the location (absolute path including file name) of +# the HTML help compiler (hhc.exe). If non-empty doxygen will try to run +# the HTML help compiler on the generated index.hhp. + +HHC_LOCATION = + +# If the GENERATE_HTMLHELP tag is set to YES, the GENERATE_CHI flag +# controls if a separate .chi index file is generated (YES) or that +# it should be included in the master .chm file (NO). + +GENERATE_CHI = NO + +# If the GENERATE_HTMLHELP tag is set to YES, the CHM_INDEX_ENCODING +# is used to encode HtmlHelp index (hhk), content (hhc) and project file +# content. + +CHM_INDEX_ENCODING = + +# If the GENERATE_HTMLHELP tag is set to YES, the BINARY_TOC flag +# controls whether a binary table of contents is generated (YES) or a +# normal table of contents (NO) in the .chm file. + +BINARY_TOC = NO + +# The TOC_EXPAND flag can be set to YES to add extra items for group members +# to the contents of the HTML help documentation and to the tree view. + +TOC_EXPAND = NO + +# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and QHP_VIRTUAL_FOLDER +# are set, an additional index file will be generated that can be used as input for +# Qt's qhelpgenerator to generate a Qt Compressed Help (.qch) of the generated +# HTML documentation. + +GENERATE_QHP = NO + +# If the QHG_LOCATION tag is specified, the QCH_FILE tag can +# be used to specify the file name of the resulting .qch file. +# The path specified is relative to the HTML output folder. + +QCH_FILE = + +# The QHP_NAMESPACE tag specifies the namespace to use when generating +# Qt Help Project output. For more information please see +# http://doc.trolltech.com/qthelpproject.html#namespace + +QHP_NAMESPACE = + +# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating +# Qt Help Project output. For more information please see +# http://doc.trolltech.com/qthelpproject.html#virtual-folders + +QHP_VIRTUAL_FOLDER = doc + +# If QHP_CUST_FILTER_NAME is set, it specifies the name of a custom filter to add. +# For more information please see +# http://doc.trolltech.com/qthelpproject.html#custom-filters + +QHP_CUST_FILTER_NAME = + +# The QHP_CUST_FILT_ATTRS tag specifies the list of the attributes of the custom filter to add.For more information please see +# Qt Help Project / Custom Filters. + +QHP_CUST_FILTER_ATTRS = + +# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this project's +# filter section matches. +# Qt Help Project / Filter Attributes. + +QHP_SECT_FILTER_ATTRS = + +# If the GENERATE_QHP tag is set to YES, the QHG_LOCATION tag can +# be used to specify the location of Qt's qhelpgenerator. +# If non-empty doxygen will try to run qhelpgenerator on the generated +# .qhp file. + +QHG_LOCATION = + +# The DISABLE_INDEX tag can be used to turn on/off the condensed index at +# top of each HTML page. The value NO (the default) enables the index and +# the value YES disables it. + +DISABLE_INDEX = NO + +# This tag can be used to set the number of enum values (range [1..20]) +# that doxygen will group on one line in the generated HTML documentation. + +ENUM_VALUES_PER_LINE = 4 + +# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index +# structure should be generated to display hierarchical information. +# If the tag value is set to YES, a side panel will be generated +# containing a tree-like index structure (just like the one that +# is generated for HTML Help). For this to work a browser that supports +# JavaScript, DHTML, CSS and frames is required (i.e. any modern browser). +# Windows users are probably better off using the HTML help feature. + +GENERATE_TREEVIEW = NO + +# By enabling USE_INLINE_TREES, doxygen will generate the Groups, Directories, +# and Class Hierarchy pages using a tree view instead of an ordered list. + +USE_INLINE_TREES = NO + +# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be +# used to set the initial width (in pixels) of the frame in which the tree +# is shown. + +TREEVIEW_WIDTH = 250 + +# Use this tag to change the font size of Latex formulas included +# as images in the HTML documentation. The default is 10. Note that +# when you change the font size after a successful doxygen run you need +# to manually remove any form_*.png images from the HTML output directory +# to force them to be regenerated. + +FORMULA_FONTSIZE = 10 + +# When the SEARCHENGINE tag is enable doxygen will generate a search box for the HTML output. The underlying search engine uses javascript +# and DHTML and should work on any modern browser. Note that when using HTML help (GENERATE_HTMLHELP) or Qt help (GENERATE_QHP) +# there is already a search function so this one should typically +# be disabled. + +SEARCHENGINE = YES + +#--------------------------------------------------------------------------- +# configuration options related to the LaTeX output +#--------------------------------------------------------------------------- + +# If the GENERATE_LATEX tag is set to YES (the default) Doxygen will +# generate Latex output. + +GENERATE_LATEX = NO + +# The LATEX_OUTPUT tag is used to specify where the LaTeX docs will be put. +# If a relative path is entered the value of OUTPUT_DIRECTORY will be +# put in front of it. If left blank `latex' will be used as the default path. + +LATEX_OUTPUT = latex + +# The LATEX_CMD_NAME tag can be used to specify the LaTeX command name to be +# invoked. If left blank `latex' will be used as the default command name. + +LATEX_CMD_NAME = latex + +# The MAKEINDEX_CMD_NAME tag can be used to specify the command name to +# generate index for LaTeX. If left blank `makeindex' will be used as the +# default command name. + +MAKEINDEX_CMD_NAME = makeindex + +# If the COMPACT_LATEX tag is set to YES Doxygen generates more compact +# LaTeX documents. This may be useful for small projects and may help to +# save some trees in general. + +COMPACT_LATEX = YES + +# The PAPER_TYPE tag can be used to set the paper type that is used +# by the printer. Possible values are: a4, a4wide, letter, legal and +# executive. If left blank a4wide will be used. + +PAPER_TYPE = letter + +# The EXTRA_PACKAGES tag can be to specify one or more names of LaTeX +# packages that should be included in the LaTeX output. + +EXTRA_PACKAGES = + +# The LATEX_HEADER tag can be used to specify a personal LaTeX header for +# the generated latex document. The header should contain everything until +# the first chapter. If it is left blank doxygen will generate a +# standard header. Notice: only use this tag if you know what you are doing! + +LATEX_HEADER = + +# If the PDF_HYPERLINKS tag is set to YES, the LaTeX that is generated +# is prepared for conversion to pdf (using ps2pdf). The pdf file will +# contain links (just like the HTML output) instead of page references +# This makes the output suitable for online browsing using a pdf viewer. + +PDF_HYPERLINKS = YES + +# If the USE_PDFLATEX tag is set to YES, pdflatex will be used instead of +# plain latex in the generated Makefile. Set this option to YES to get a +# higher quality PDF documentation. + +USE_PDFLATEX = YES + +# If the LATEX_BATCHMODE tag is set to YES, doxygen will add the \\batchmode. +# command to the generated LaTeX files. This will instruct LaTeX to keep +# running if errors occur, instead of asking the user for help. +# This option is also used when generating formulas in HTML. + +LATEX_BATCHMODE = NO + +# If LATEX_HIDE_INDICES is set to YES then doxygen will not +# include the index chapters (such as File Index, Compound Index, etc.) +# in the output. + +LATEX_HIDE_INDICES = NO + +# If LATEX_SOURCE_CODE is set to YES then doxygen will include source code with syntax highlighting in the LaTeX output. Note that which sources are shown also depends on other settings such as SOURCE_BROWSER. + +LATEX_SOURCE_CODE = NO + +#--------------------------------------------------------------------------- +# configuration options related to the RTF output +#--------------------------------------------------------------------------- + +# If the GENERATE_RTF tag is set to YES Doxygen will generate RTF output +# The RTF output is optimized for Word 97 and may not look very pretty with +# other RTF readers or editors. + +GENERATE_RTF = NO + +# The RTF_OUTPUT tag is used to specify where the RTF docs will be put. +# If a relative path is entered the value of OUTPUT_DIRECTORY will be +# put in front of it. If left blank `rtf' will be used as the default path. + +RTF_OUTPUT = rtf + +# If the COMPACT_RTF tag is set to YES Doxygen generates more compact +# RTF documents. This may be useful for small projects and may help to +# save some trees in general. + +COMPACT_RTF = NO + +# If the RTF_HYPERLINKS tag is set to YES, the RTF that is generated +# will contain hyperlink fields. The RTF file will +# contain links (just like the HTML output) instead of page references. +# This makes the output suitable for online browsing using WORD or other +# programs which support those fields. +# Note: wordpad (write) and others do not support links. + +RTF_HYPERLINKS = NO + +# Load stylesheet definitions from file. Syntax is similar to doxygen's +# config file, i.e. a series of assignments. You only have to provide +# replacements, missing definitions are set to their default value. + +RTF_STYLESHEET_FILE = + +# Set optional variables used in the generation of an rtf document. +# Syntax is similar to doxygen's config file. + +RTF_EXTENSIONS_FILE = + +#--------------------------------------------------------------------------- +# configuration options related to the man page output +#--------------------------------------------------------------------------- + +# If the GENERATE_MAN tag is set to YES (the default) Doxygen will +# generate man pages + +GENERATE_MAN = NO + +# The MAN_OUTPUT tag is used to specify where the man pages will be put. +# If a relative path is entered the value of OUTPUT_DIRECTORY will be +# put in front of it. If left blank `man' will be used as the default path. + +MAN_OUTPUT = man + +# The MAN_EXTENSION tag determines the extension that is added to +# the generated man pages (default is the subroutine's section .3) + +MAN_EXTENSION = .3 + +# If the MAN_LINKS tag is set to YES and Doxygen generates man output, +# then it will generate one additional man file for each entity +# documented in the real man page(s). These additional files +# only source the real man page, but without them the man command +# would be unable to find the correct page. The default is NO. + +MAN_LINKS = NO + +#--------------------------------------------------------------------------- +# configuration options related to the XML output +#--------------------------------------------------------------------------- + +# If the GENERATE_XML tag is set to YES Doxygen will +# generate an XML file that captures the structure of +# the code including all documentation. + +GENERATE_XML = NO + +# The XML_OUTPUT tag is used to specify where the XML pages will be put. +# If a relative path is entered the value of OUTPUT_DIRECTORY will be +# put in front of it. If left blank `xml' will be used as the default path. + +XML_OUTPUT = xml + +# The XML_SCHEMA tag can be used to specify an XML schema, +# which can be used by a validating XML parser to check the +# syntax of the XML files. + +XML_SCHEMA = + +# The XML_DTD tag can be used to specify an XML DTD, +# which can be used by a validating XML parser to check the +# syntax of the XML files. + +XML_DTD = + +# If the XML_PROGRAMLISTING tag is set to YES Doxygen will +# dump the program listings (including syntax highlighting +# and cross-referencing information) to the XML output. Note that +# enabling this will significantly increase the size of the XML output. + +XML_PROGRAMLISTING = YES + +#--------------------------------------------------------------------------- +# configuration options for the AutoGen Definitions output +#--------------------------------------------------------------------------- + +# If the GENERATE_AUTOGEN_DEF tag is set to YES Doxygen will +# generate an AutoGen Definitions (see autogen.sf.net) file +# that captures the structure of the code including all +# documentation. Note that this feature is still experimental +# and incomplete at the moment. + +GENERATE_AUTOGEN_DEF = NO + +#--------------------------------------------------------------------------- +# configuration options related to the Perl module output +#--------------------------------------------------------------------------- + +# If the GENERATE_PERLMOD tag is set to YES Doxygen will +# generate a Perl module file that captures the structure of +# the code including all documentation. Note that this +# feature is still experimental and incomplete at the +# moment. + +GENERATE_PERLMOD = NO + +# If the PERLMOD_LATEX tag is set to YES Doxygen will generate +# the necessary Makefile rules, Perl scripts and LaTeX code to be able +# to generate PDF and DVI output from the Perl module output. + +PERLMOD_LATEX = NO + +# If the PERLMOD_PRETTY tag is set to YES the Perl module output will be +# nicely formatted so it can be parsed by a human reader. +# This is useful +# if you want to understand what is going on. +# On the other hand, if this +# tag is set to NO the size of the Perl module output will be much smaller +# and Perl will parse it just the same. + +PERLMOD_PRETTY = YES + +# The names of the make variables in the generated doxyrules.make file +# are prefixed with the string contained in PERLMOD_MAKEVAR_PREFIX. +# This is useful so different doxyrules.make files included by the same +# Makefile don't overwrite each other's variables. + +PERLMOD_MAKEVAR_PREFIX = + +#--------------------------------------------------------------------------- +# Configuration options related to the preprocessor +#--------------------------------------------------------------------------- + +# If the ENABLE_PREPROCESSING tag is set to YES (the default) Doxygen will +# evaluate all C-preprocessor directives found in the sources and include +# files. + +ENABLE_PREPROCESSING = YES + +# If the MACRO_EXPANSION tag is set to YES Doxygen will expand all macro +# names in the source code. If set to NO (the default) only conditional +# compilation will be performed. Macro expansion can be done in a controlled +# way by setting EXPAND_ONLY_PREDEF to YES. + +MACRO_EXPANSION = YES + +# If the EXPAND_ONLY_PREDEF and MACRO_EXPANSION tags are both set to YES +# then the macro expansion is limited to the macros specified with the +# PREDEFINED and EXPAND_AS_DEFINED tags. + +EXPAND_ONLY_PREDEF = YES + +# If the SEARCH_INCLUDES tag is set to YES (the default) the includes files +# in the INCLUDE_PATH (see below) will be search if a #include is found. + +SEARCH_INCLUDES = YES + +# The INCLUDE_PATH tag can be used to specify one or more directories that +# contain include files that are not input files but should be processed by +# the preprocessor. + +INCLUDE_PATH = + +# You can use the INCLUDE_FILE_PATTERNS tag to specify one or more wildcard +# patterns (like *.h and *.hpp) to filter out the header-files in the +# directories. If left blank, the patterns specified with FILE_PATTERNS will +# be used. + +INCLUDE_FILE_PATTERNS = + +# The PREDEFINED tag can be used to specify one or more macro names that +# are defined before the preprocessor is started (similar to the -D option of +# gcc). The argument of the tag is a list of macros of the form: name +# or name=definition (no spaces). If the definition and the = are +# omitted =1 is assumed. To prevent a macro definition from being +# undefined via #undef or recursively expanded use the := operator +# instead of the = operator. + +PREDEFINED = + +# If the MACRO_EXPANSION and EXPAND_ONLY_PREDEF tags are set to YES then +# this tag can be used to specify a list of macro names that should be expanded. +# The macro definition that is found in the sources will be used. +# Use the PREDEFINED tag if you want to use a different macro definition. + +EXPAND_AS_DEFINED = + +# If the SKIP_FUNCTION_MACROS tag is set to YES (the default) then +# doxygen's preprocessor will remove all function-like macros that are alone +# on a line, have an all uppercase name, and do not end with a semicolon. Such +# function macros are typically used for boiler-plate code, and will confuse +# the parser if not removed. + +SKIP_FUNCTION_MACROS = YES + +#--------------------------------------------------------------------------- +# Configuration::additions related to external references +#--------------------------------------------------------------------------- + +# The TAGFILES option can be used to specify one or more tagfiles. +# Optionally an initial location of the external documentation +# can be added for each tagfile. The format of a tag file without +# this location is as follows: +# +# TAGFILES = file1 file2 ... +# Adding location for the tag files is done as follows: +# +# TAGFILES = file1=loc1 "file2 = loc2" ... +# where "loc1" and "loc2" can be relative or absolute paths or +# URLs. If a location is present for each tag, the installdox tool +# does not have to be run to correct the links. +# Note that each tag file must have a unique name +# (where the name does NOT include the path) +# If a tag file is not located in the directory in which doxygen +# is run, you must also specify the path to the tagfile here. + +TAGFILES = @coin_doxy_tagfiles@ + +# When a file name is specified after GENERATE_TAGFILE, doxygen will create +# a tag file that is based on the input files it reads. + +GENERATE_TAGFILE = @coin_doxy_tagname@ + +# If the ALLEXTERNALS tag is set to YES all external classes will be listed +# in the class index. If set to NO only the inherited external classes +# will be listed. + +ALLEXTERNALS = YES + +# If the EXTERNAL_GROUPS tag is set to YES all external groups will be listed +# in the modules index. If set to NO, only the current project's groups will +# be listed. + +EXTERNAL_GROUPS = YES + +# The PERL_PATH should be the absolute path and name of the perl script +# interpreter (i.e. the result of `which perl'). + +PERL_PATH = /usr/bin/perl + +#--------------------------------------------------------------------------- +# Configuration options related to the dot tool +#--------------------------------------------------------------------------- + +# If the CLASS_DIAGRAMS tag is set to YES (the default) Doxygen will +# generate a inheritance diagram (in HTML, RTF and LaTeX) for classes with base +# or super classes. Setting the tag to NO turns the diagrams off. Note that +# this option is superseded by the HAVE_DOT option below. This is only a +# fallback. It is recommended to install and use dot, since it yields more +# powerful graphs. + +CLASS_DIAGRAMS = YES + +# You can define message sequence charts within doxygen comments using the \msc +# command. Doxygen will then run the mscgen tool (see +# http://www.mcternan.me.uk/mscgen/) to produce the chart and insert it in the +# documentation. The MSCGEN_PATH tag allows you to specify the directory where +# the mscgen tool resides. If left empty the tool is assumed to be found in the +# default search path. + +MSCGEN_PATH = + +# If set to YES, the inheritance and collaboration graphs will hide +# inheritance and usage relations if the target is undocumented +# or is not a class. + +HIDE_UNDOC_RELATIONS = YES + +# If you set the HAVE_DOT tag to YES then doxygen will assume the dot tool is +# available from the path. This tool is part of Graphviz, a graph visualization +# toolkit from AT&T and Lucent Bell Labs. The other options in this section +# have no effect if this option is set to NO (the default) + +HAVE_DOT = YES + +# By default doxygen will write a font called FreeSans.ttf to the output +# directory and reference it in all dot files that doxygen generates. This +# font does not include all possible unicode characters however, so when you need +# these (or just want a differently looking font) you can specify the font name +# using DOT_FONTNAME. You need need to make sure dot is able to find the font, +# which can be done by putting it in a standard location or by setting the +# DOTFONTPATH environment variable or by setting DOT_FONTPATH to the directory +# containing the font. + +DOT_FONTNAME = FreeSans + +# The DOT_FONTSIZE tag can be used to set the size of the font of dot graphs. +# The default size is 10pt. + +DOT_FONTSIZE = 10 + +# By default doxygen will tell dot to use the output directory to look for the +# FreeSans.ttf font (which doxygen will put there itself). If you specify a +# different font using DOT_FONTNAME you can set the path where dot +# can find it using this tag. + +DOT_FONTPATH = + +# If the CLASS_GRAPH and HAVE_DOT tags are set to YES then doxygen +# will generate a graph for each documented class showing the direct and +# indirect inheritance relations. Setting this tag to YES will force the +# the CLASS_DIAGRAMS tag to NO. + +CLASS_GRAPH = YES + +# If the COLLABORATION_GRAPH and HAVE_DOT tags are set to YES then doxygen +# will generate a graph for each documented class showing the direct and +# indirect implementation dependencies (inheritance, containment, and +# class references variables) of the class with other documented classes. + +COLLABORATION_GRAPH = YES + +# If the GROUP_GRAPHS and HAVE_DOT tags are set to YES then doxygen +# will generate a graph for groups, showing the direct groups dependencies + +GROUP_GRAPHS = YES + +# If the UML_LOOK tag is set to YES doxygen will generate inheritance and +# collaboration diagrams in a style similar to the OMG's Unified Modeling +# Language. + +UML_LOOK = NO + +# If set to YES, the inheritance and collaboration graphs will show the +# relations between templates and their instances. + +TEMPLATE_RELATIONS = YES + +# If the ENABLE_PREPROCESSING, SEARCH_INCLUDES, INCLUDE_GRAPH, and HAVE_DOT +# tags are set to YES then doxygen will generate a graph for each documented +# file showing the direct and indirect include dependencies of the file with +# other documented files. + +INCLUDE_GRAPH = YES + +# If the ENABLE_PREPROCESSING, SEARCH_INCLUDES, INCLUDED_BY_GRAPH, and +# HAVE_DOT tags are set to YES then doxygen will generate a graph for each +# documented header file showing the documented files that directly or +# indirectly include this file. + +INCLUDED_BY_GRAPH = YES + +# If the CALL_GRAPH and HAVE_DOT options are set to YES then +# doxygen will generate a call dependency graph for every global function +# or class method. Note that enabling this option will significantly increase +# the time of a run. So in most cases it will be better to enable call graphs +# for selected functions only using the \callgraph command. + +CALL_GRAPH = NO + +# If the CALLER_GRAPH and HAVE_DOT tags are set to YES then +# doxygen will generate a caller dependency graph for every global function +# or class method. Note that enabling this option will significantly increase +# the time of a run. So in most cases it will be better to enable caller +# graphs for selected functions only using the \callergraph command. + +CALLER_GRAPH = NO + +# If the GRAPHICAL_HIERARCHY and HAVE_DOT tags are set to YES then doxygen +# will graphical hierarchy of all classes instead of a textual one. + +GRAPHICAL_HIERARCHY = YES + +# If the DIRECTORY_GRAPH, SHOW_DIRECTORIES and HAVE_DOT tags are set to YES +# then doxygen will show the dependencies a directory has on other directories +# in a graphical way. The dependency relations are determined by the #include +# relations between the files in the directories. + +DIRECTORY_GRAPH = YES + +# The DOT_IMAGE_FORMAT tag can be used to set the image format of the images +# generated by dot. Possible values are png, jpg, or gif +# If left blank png will be used. + +DOT_IMAGE_FORMAT = png + +# The tag DOT_PATH can be used to specify the path where the dot tool can be +# found. If left blank, it is assumed the dot tool can be found in the path. + +DOT_PATH = + +# The DOTFILE_DIRS tag can be used to specify one or more directories that +# contain dot files that are included in the documentation (see the +# \dotfile command). + +DOTFILE_DIRS = + +# The DOT_GRAPH_MAX_NODES tag can be used to set the maximum number of +# nodes that will be shown in the graph. If the number of nodes in a graph +# becomes larger than this value, doxygen will truncate the graph, which is +# visualized by representing a node as a red box. Note that doxygen if the +# number of direct children of the root node in a graph is already larger than +# DOT_GRAPH_MAX_NODES then the graph will not be shown at all. Also note +# that the size of a graph can be further restricted by MAX_DOT_GRAPH_DEPTH. + +DOT_GRAPH_MAX_NODES = 50 + +# The MAX_DOT_GRAPH_DEPTH tag can be used to set the maximum depth of the +# graphs generated by dot. A depth value of 3 means that only nodes reachable +# from the root by following a path via at most 3 edges will be shown. Nodes +# that lay further from the root node will be omitted. Note that setting this +# option to 1 or 2 may greatly reduce the computation time needed for large +# code bases. Also note that the size of a graph can be further restricted by +# DOT_GRAPH_MAX_NODES. Using a depth of 0 means no depth restriction. + +MAX_DOT_GRAPH_DEPTH = 0 + +# Set the DOT_TRANSPARENT tag to YES to generate images with a transparent +# background. This is disabled by default, because dot on Windows does not +# seem to support this out of the box. Warning: Depending on the platform used, +# enabling this option may lead to badly anti-aliased labels on the edges of +# a graph (i.e. they become hard to read). + +DOT_TRANSPARENT = NO + +# Set the DOT_MULTI_TARGETS tag to YES allow dot to generate multiple output +# files in one run (i.e. multiple -o and -T options on the command line). This +# makes dot run faster, but since only newer versions of dot (>1.8.10) +# support this, this feature is disabled by default. + +DOT_MULTI_TARGETS = YES + +# If the GENERATE_LEGEND tag is set to YES (the default) Doxygen will +# generate a legend page explaining the meaning of the various boxes and +# arrows in the dot generated graphs. + +GENERATE_LEGEND = YES + +# If the DOT_CLEANUP tag is set to YES (the default) Doxygen will +# remove the intermediate dot files that are used to generate +# the various graphs. + +DOT_CLEANUP = YES diff --git a/Ipopt-3.13.4/Ipopt/include/config.h.in b/Ipopt-3.13.4/Ipopt/include/config.h.in new file mode 100644 index 000000000..6adafe816 --- /dev/null +++ b/Ipopt-3.13.4/Ipopt/include/config.h.in @@ -0,0 +1,233 @@ +/* config.h. Generated from Ipopt/include/config.h.in by CMake. */ + +/* Define to 1 if the inexact linear solver option is included */ +#cmakedefine BUILD_INEXACT + +/* Define to be the name of C-function for Inf check */ +#cmakedefine IPOPT_C_FINITE @IPOPT_C_FINITE@ + +/* Define to 1 if the ASL package is available */ +#cmakedefine IPOPT_HAS_ASL + +/* If defined, the BLAS Library is available. */ +#cmakedefine COIN_HAS_BLAS + +/* Define to 1 if the HSL package is available */ +#cmakedefine IPOPT_HAS_HSL + +/* If defined, the LAPACK Library is available. */ +#cmakedefine IPOPT_HAS_LAPACK + +/* Define to 1 if the Mumps package is available */ +#cmakedefine IPOPT_HAS_MUMPS + +/* Define to the debug sanity check level (0 is no test) */ +#define IPOPT_CHECKLEVEL @IPOPT_CHECKLEVEL@ + +/* Define to the debug verbosity level (0 is no output) */ +#define IPOPT_VERBOSITY @IPOPT_VERBOSITY@ + +/* Define to dummy `main' function (if any) required to link to the Fortran + libraries. */ +#cmakedefine F77_DUMMY_MAIN @F77_DUMMY_MAIN@ + +/* Define to a macro mangling the given C identifier (in lower and upper + case), which must not contain underscores, for linking with Fortran. */ +#define @F77_FUNC@ + +/* Define to a macro mangling the given C identifier (in lower and upper + case), which must not contain underscores, for linking with Fortran. */ +#define @IPOPT_LAPACK_FUNC@ + +/* As F77_FUNC, but for C identifiers containing underscores. */ +#define @F77_FUNC_@ + +/* Define if F77 and FC dummy `main' functions are identical. */ +#cmakedefine FC_DUMMY_MAIN_EQ_F77 @FC_DUMMY_MAIN_EQ_F77@ + +/* Define to the C type corresponding to Fortran INTEGER */ +#define IPOPT_FORTRAN_INTEGER_TYPE @IPOPT_FORTRAN_INTEGER_TYPE@ + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_ASSERT_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_CASSERT + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_CCTYPE + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_CFLOAT + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_CIEEEFP + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_CMATH + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_CSTDARG + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_CSTDDEF + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_CSTDIO + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_CSTDLIB + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_CSTRING + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_CTIME + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_CTYPE_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_DLFCN_H + +/* Define to 1 if function drand48 is available */ +#cmakedefine IPOPT_HAS_DRAND48 + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_FLOAT_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_IEEEFP_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_INTTYPES_H + +/* Define to 1 if the linear solver loader should be compiled to allow dynamic + loading of shared libraries with linear solvers */ +#cmakedefine HAVE_LINEARSOLVERLOADER + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_MATH_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_MEMORY_H + +/* Define to 1 if you have the `MPI_Initialized' function. */ +#cmakedefine HAVE_MPI_INITIALIZED + +/* Define to 1 if Pardiso is available */ +#cmakedefine HAVE_PARDISO + +/* Define to 1 if you are using Pardiso from MKL */ +#cmakedefine HAVE_PARDISO_MKL + +/* Define to 1 if you are not using at least a 4.0 version of Pardiso */ +#cmakedefine HAVE_PARDISO_OLDINTERFACE + +/* Define to 1 if you are using the parallel version of Pardiso */ +#cmakedefine HAVE_PARDISO_PARALLEL + +/* Define to 1 if function rand is available */ +#cmakedefine IPOPT_HAS_RAND + +/* Define to 1 if you have the `snprintf' function. */ +#cmakedefine HAVE_SNPRINTF + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_STDARG_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_STDDEF_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_STDINT_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_STDIO_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_STDLIB_H + +/* Define to 1 if function std::rand is available */ +#cmakedefine HAVE_STD__RAND + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_STRINGS_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_STRING_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_SYS_STAT_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_SYS_TYPES_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_TIME_H + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_UNISTD_H + +/* Define to 1 if va_copy is available */ +#cmakedefine IPOPT_HAS_VA_COPY + +/* Define to 1 if you have the `vsnprintf' function. */ +#cmakedefine HAVE_VSNPRINTF + +/* Define to 1 if you have the header file. */ +#cmakedefine HAVE_WINDOWS_H + +/* Define to 1 if WSMP is available */ +#cmakedefine HAVE_WSMP + +/* Define to 1 if you have the `_snprintf' function. */ +#cmakedefine HAVE__SNPRINTF + +/* Define to 1 if you have the `_vsnprintf' function. */ +#cmakedefine HAVE__VSNPRINTF + +/* SVN revision number of project */ +#define IPOPT_SVN_REV @IPOPT_SVN_REV@ + +/* Version number of project */ +#define IPOPT_VERSION "@IPOPT_VERSION@" + +/* Major Version number of project */ +#define IPOPT_VERSION_MAJOR @IPOPT_VERSION_MAJOR@ + +/* Minor Version number of project */ +#define IPOPT_VERSION_MINOR @IPOPT_VERSION_MINOR@ + +/* Release Version number of project */ +#define IPOPT_VERSION_RELEASE @IPOPT_VERSION_RELEASE@ + +/* Name of package */ +#define PACKAGE "@PACKAGE@" + +/* Define to the address where bug reports for this package should be sent. */ +#define PACKAGE_BUGREPORT "@PACKAGE_BUGREPORT@" + +/* Define to the full name of this package. */ +#define PACKAGE_NAME "@PACKAGE_NAME@" + +/* Define to the full name and version of this package. */ +#define PACKAGE_STRING "@PACKAGE_STRING@" + +/* Define to the one symbol short name of this package. */ +#define PACKAGE_TARNAME "@PACKAGE_TARNAME@" + +/* Define to the version of this package. */ +#define PACKAGE_VERSION "@PACKAGE_VERSION@" + +/* Set to extension for shared libraries in quotes. */ +#define SHAREDLIBEXT "@SHAREDLIBEXT@" + +/* The size of a `int *', as computed by sizeof. */ +#define SIZEOF_INT_P @SIZEOF_INT_P@ + +/* Define to 1 if you have the ANSI C header files. */ +#cmakedefine STDC_HEADERS @STDC_HEADERS@ + +/* Version number of package */ +// #define VERSION "@VERSION@" diff --git a/Ipopt-3.13.4/Ipopt/include/config_coinhsl.h.in b/Ipopt-3.13.4/Ipopt/include/config_coinhsl.h.in new file mode 100644 index 000000000..f31f5d306 --- /dev/null +++ b/Ipopt-3.13.4/Ipopt/include/config_coinhsl.h.in @@ -0,0 +1,48 @@ +/* config_coinhsl.h.in. */ + +#ifndef __CONFIG_COINHSL_H__ +#define __CONFIG_COINHSL_H__ + +/* Define to 1 if MA27 is available. */ +#cmakedefine COINHSL_HAS_MA27 + +/* Define to 1 if MA28 is available. */ +#cmakedefine COINHSL_HAS_MA28 + +/* Define to 1 if MA57 is available. */ +#cmakedefine COINHSL_HAS_MA57 + +/* Define to 1 if MA77 is available. */ +#cmakedefine COINHSL_HAS_MA77 + +/* Define to 1 if MA86 is available. */ +#cmakedefine COINHSL_HAS_MA86 + +/* Define to 1 if MA97 is available. */ +#cmakedefine COINHSL_HAS_MA97 + +/* Define to 1 if MC19 is available. */ +#cmakedefine COINHSL_HAS_MC19 + +/* Define to 1 if MC68 is available. */ +#cmakedefine COINHSL_HAS_MC68 + +/* Define to 1 if METIS is available */ +#cmakedefine COINHSL_HAS_METIS + +/* Define to 1 if HSL library is from 2013 */ +#cmakedefine COINHSL_HSL2013 + +/* Version number of project */ +#define COINHSL_VERSION "@COINHSL_VERSION@" + +/* Major Version number of project */ +#define COINHSL_VERSION_MAJOR @COINHSL_VERSION_MAJOR@ + +/* Minor Version number of project */ +#define COINHSL_VERSION_MINOR @COINHSL_VERSION_MINOR@ + +/* Release Version number of project */ +#define COINHSL_VERSION_RELEASE @COINHSL_VERSION_RELEASE@ + +#endif diff --git a/Ipopt-3.13.4/Ipopt/include/config_ipopt.h.in b/Ipopt-3.13.4/Ipopt/include/config_ipopt.h.in new file mode 100644 index 000000000..c38012b8d --- /dev/null +++ b/Ipopt-3.13.4/Ipopt/include/config_ipopt.h.in @@ -0,0 +1,21 @@ +/* src/Common/config_ipopt.h.in. */ + +#ifndef __CONFIG_IPOPT_H__ +#define __CONFIG_IPOPT_H__ + +/* Version number of project */ +#define IPOPT_VERSION "@IPOPT_VERSION@" + +/* Major Version number of project */ +#define IPOPT_VERSION_MAJOR @IPOPT_VERSION_MAJOR@ + +/* Minor Version number of project */ +#define IPOPT_VERSION_MINOR @IPOPT_VERSION_MINOR@ + +/* Release Version number of project */ +#define IPOPT_VERSION_RELEASE @IPOPT_VERSION_RELEASE@ + +/* Define to the C type corresponding to Fortran INTEGER */ +#define IPOPT_FORTRAN_INTEGER_TYPE @IPOPT_FORTRAN_INTEGER_TYPE@ + +#endif diff --git a/Ipopt-3.13.4/LICENSE b/Ipopt-3.13.4/LICENSE new file mode 100644 index 000000000..c300a4c84 --- /dev/null +++ b/Ipopt-3.13.4/LICENSE @@ -0,0 +1,261 @@ +Eclipse Public License - v 2.0 + + THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE + PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION + OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + a) in the case of the initial Contributor, the initial content + Distributed under this Agreement, and + + b) in the case of each subsequent Contributor: + i) changes to the Program, and + ii) additions to the Program; + where such changes and/or additions to the Program originate from + and are Distributed by that particular Contributor. A Contribution + "originates" from a Contributor if it was added to the Program by + such Contributor itself or anyone acting on such Contributor's behalf. + Contributions do not include changes or additions to the Program that + are not Modified Works. + +"Contributor" means any person or entity that Distributes the Program. + +"Licensed Patents" mean patent claims licensable by a Contributor which +are necessarily infringed by the use or sale of its Contribution alone +or when combined with the Program. + +"Program" means the Contributions Distributed in accordance with this +Agreement. + +"Recipient" means anyone who receives the Program under this Agreement +or any Secondary License (as applicable), including Contributors. + +"Derivative Works" shall mean any work, whether in Source Code or other +form, that is based on (or derived from) the Program and for which the +editorial revisions, annotations, elaborations, or other modifications +represent, as a whole, an original work of authorship. + +"Modified Works" shall mean any work in Source Code or other form that +results from an addition to, deletion from, or modification of the +contents of the Program, including, for purposes of clarity any new file +in Source Code form that contains any contents of the Program. Modified +Works shall not include works that contain only declarations, +interfaces, types, classes, structures, or files of the Program solely +in each case in order to link to, bind by name, or subclass the Program +or Modified Works thereof. + +"Distribute" means the acts of a) distributing or b) making available +in any manner that enables the transfer of a copy. + +"Source Code" means the form of a Program preferred for making +modifications, including but not limited to software source code, +documentation source, and configuration files. + +"Secondary License" means either the GNU General Public License, +Version 2.0, or any later versions of that license, including any +exceptions or additional permissions as identified by the initial +Contributor. + +2. GRANT OF RIGHTS + + a) Subject to the terms of this Agreement, each Contributor hereby + grants Recipient a non-exclusive, worldwide, royalty-free copyright + license to reproduce, prepare Derivative Works of, publicly display, + publicly perform, Distribute and sublicense the Contribution of such + Contributor, if any, and such Derivative Works. + + b) Subject to the terms of this Agreement, each Contributor hereby + grants Recipient a non-exclusive, worldwide, royalty-free patent + license under Licensed Patents to make, use, sell, offer to sell, + import and otherwise transfer the Contribution of such Contributor, + if any, in Source Code or other form. This patent license shall + apply to the combination of the Contribution and the Program if, at + the time the Contribution is added by the Contributor, such addition + of the Contribution causes such combination to be covered by the + Licensed Patents. The patent license shall not apply to any other + combinations which include the Contribution. No hardware per se is + licensed hereunder. + + c) Recipient understands that although each Contributor grants the + licenses to its Contributions set forth herein, no assurances are + provided by any Contributor that the Program does not infringe the + patent or other intellectual property rights of any other entity. + Each Contributor disclaims any liability to Recipient for claims + brought by any other entity based on infringement of intellectual + property rights or otherwise. As a condition to exercising the + rights and licenses granted hereunder, each Recipient hereby + assumes sole responsibility to secure any other intellectual + property rights needed, if any. For example, if a third party + patent license is required to allow Recipient to Distribute the + Program, it is Recipient's responsibility to acquire that license + before distributing the Program. + + d) Each Contributor represents that to its knowledge it has + sufficient copyright rights in its Contribution, if any, to grant + the copyright license set forth in this Agreement. + + e) Notwithstanding the terms of any Secondary License, no + Contributor makes additional grants to any Recipient (other than + those set forth in this Agreement) as a result of such Recipient's + receipt of the Program under the terms of a Secondary License + (if permitted under the terms of Section 3). + +3. REQUIREMENTS + +3.1 If a Contributor Distributes the Program in any form, then: + + a) the Program must also be made available as Source Code, in + accordance with section 3.2, and the Contributor must accompany + the Program with a statement that the Source Code for the Program + is available under this Agreement, and informs Recipients how to + obtain it in a reasonable manner on or through a medium customarily + used for software exchange; and + + b) the Contributor may Distribute the Program under a license + different than this Agreement, provided that such license: + i) effectively disclaims on behalf of all other Contributors all + warranties and conditions, express and implied, including + warranties or conditions of title and non-infringement, and + implied warranties or conditions of merchantability and fitness + for a particular purpose; + + ii) effectively excludes on behalf of all other Contributors all + liability for damages, including direct, indirect, special, + incidental and consequential damages, such as lost profits; + + iii) does not attempt to limit or alter the recipients' rights + in the Source Code under section 3.2; and + + iv) requires any subsequent distribution of the Program by any + party to be under a license that satisfies the requirements + of this section 3. + +3.2 When the Program is Distributed as Source Code: + + a) it must be made available under this Agreement, or if the + Program (i) is combined with other material in a separate file or + files made available under a Secondary License, and (ii) the initial + Contributor attached to the Source Code the notice described in + Exhibit A of this Agreement, then the Program may be made available + under the terms of such Secondary Licenses, and + + b) a copy of this Agreement must be included with each copy of + the Program. + +3.3 Contributors may not remove or alter any copyright, patent, +trademark, attribution notices, disclaimers of warranty, or limitations +of liability ("notices") contained within the Program from any copy of +the Program which they Distribute, provided that Contributors may add +their own appropriate notices. + +4. COMMERCIAL DISTRIBUTION + +Commercial distributors of software may accept certain responsibilities +with respect to end users, business partners and the like. While this +license is intended to facilitate the commercial use of the Program, +the Contributor who includes the Program in a commercial product +offering should do so in a manner which does not create potential +liability for other Contributors. Therefore, if a Contributor includes +the Program in a commercial product offering, such Contributor +("Commercial Contributor") hereby agrees to defend and indemnify every +other Contributor ("Indemnified Contributor") against any losses, +damages and costs (collectively "Losses") arising from claims, lawsuits +and other legal actions brought by a third party against the Indemnified +Contributor to the extent caused by the acts or omissions of such +Commercial Contributor in connection with its distribution of the Program +in a commercial product offering. The obligations in this section do not +apply to any claims or Losses relating to any actual or alleged +intellectual property infringement. In order to qualify, an Indemnified +Contributor must: a) promptly notify the Commercial Contributor in +writing of such claim, and b) allow the Commercial Contributor to control, +and cooperate with the Commercial Contributor in, the defense and any +related settlement negotiations. The Indemnified Contributor may +participate in any such claim at its own expense. + +For example, a Contributor might include the Program in a commercial +product offering, Product X. That Contributor is then a Commercial +Contributor. If that Commercial Contributor then makes performance +claims, or offers warranties related to Product X, those performance +claims and warranties are such Commercial Contributor's responsibility +alone. Under this section, the Commercial Contributor would have to +defend claims against the other Contributors related to those performance +claims and warranties, and if a court requires any other Contributor to +pay any damages as a result, the Commercial Contributor must pay +those damages. + +5. NO WARRANTY + +EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT +PERMITTED BY APPLICABLE LAW, THE PROGRAM IS PROVIDED ON AN "AS IS" +BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR +IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF +TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR +PURPOSE. Each Recipient is solely responsible for determining the +appropriateness of using and distributing the Program and assumes all +risks associated with its exercise of rights under this Agreement, +including but not limited to the risks and costs of program errors, +compliance with applicable laws, damage to or loss of data, programs +or equipment, and unavailability or interruption of operations. + +6. DISCLAIMER OF LIABILITY + +EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT +PERMITTED BY APPLICABLE LAW, NEITHER RECIPIENT NOR ANY CONTRIBUTORS +SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST +PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE +EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + +7. GENERAL + +If any provision of this Agreement is invalid or unenforceable under +applicable law, it shall not affect the validity or enforceability of +the remainder of the terms of this Agreement, and without further +action by the parties hereto, such provision shall be reformed to the +minimum extent necessary to make such provision valid and enforceable. + +If Recipient institutes patent litigation against any entity +(including a cross-claim or counterclaim in a lawsuit) alleging that the +Program itself (excluding combinations of the Program with other software +or hardware) infringes such Recipient's patent(s), then such Recipient's +rights granted under Section 2(b) shall terminate as of the date such +litigation is filed. + +All Recipient's rights under this Agreement shall terminate if it +fails to comply with any of the material terms or conditions of this +Agreement and does not cure such failure in a reasonable period of +time after becoming aware of such noncompliance. If all Recipient's +rights under this Agreement terminate, Recipient agrees to cease use +and distribution of the Program as soon as reasonably practicable. +However, Recipient's obligations under this Agreement and any licenses +granted by Recipient relating to the Program shall continue and survive. + +Everyone is permitted to copy and distribute copies of this Agreement, +but in order to avoid inconsistency the Agreement is copyrighted and +may only be modified in the following manner. The Agreement Steward +reserves the right to publish new versions (including revisions) of +this Agreement from time to time. No one other than the Agreement +Steward has the right to modify this Agreement. The Eclipse Foundation +is the initial Agreement Steward. The Eclipse Foundation may assign the +responsibility to serve as the Agreement Steward to a suitable separate +entity. Each new version of the Agreement will be given a distinguishing +version number. The Program (including Contributions) may always be +Distributed subject to the version of the Agreement under which it was +received. In addition, after a new version of the Agreement is published, +Contributor may elect to Distribute the Program (including its +Contributions) under the new version. + +Except as expressly stated in Sections 2(a) and 2(b) above, Recipient +receives no rights or licenses to the intellectual property of any +Contributor under this Agreement, whether expressly, by implication, +estoppel or otherwise. All rights in the Program not expressly granted +under this Agreement are reserved. Nothing in this Agreement is intended +to be enforceable by any entity that is not a Contributor or Recipient. +No third-party beneficiary rights are created under this Agreement. diff --git a/Ipopt-3.13.4/Makefile.am b/Ipopt-3.13.4/Makefile.am new file mode 100644 index 000000000..3bd8c7409 --- /dev/null +++ b/Ipopt-3.13.4/Makefile.am @@ -0,0 +1,47 @@ +# Copyright (C) 2004, 2008 International Business Machines and others. +# All Rights Reserved. +# This file is distributed under the Eclipse Public License. +# +# Authors: Carl Laird, Andreas Waechter IBM 2004-08-13 + +SUBDIRS = src/Common src/LinAlg src/Algorithm src/contrib/CGPenalty + +if BUILD_LINEARSOLVERLOADER + SUBDIRS += src/contrib/LinearSolverLoader +endif + +SUBDIRS += src/Interfaces src/Apps + +if BUILD_SIPOPT + SUBDIRS += contrib/sIPOPT +endif + +doc_DATA = README.md AUTHORS LICENSE + +.PHONY: test unitTest doc javadoc astyle + +test: unitTest + +unitTest: all + cd test; $(MAKE) test + +doc : + cd doc && doxygen + +if BUILD_JAVA +javadoc : + $(JAVADOC) -d javadoc -windowtitle "JIpopt API documentation" $(srcdir)/src/Interfaces/Ipopt.java +endif + +clean-doc: + cd doc && rm -rf html *.log *.tag + rm -rf javadoc + +clean-local : clean-doc + +astyle: + cd $(srcdir) && astyle --mode=c -A1 --indent=spaces=3 --indent-switches --min-conditional-indent=1 --convert-tabs --align-pointer=type --pad-oper --add-brackets -n -r "*.hpp" "*.h" "*.cpp" "*.c" + cd $(srcdir) && astyle --mode=java -A1 --indent=spaces=3 --indent-switches --min-conditional-indent=1 --convert-tabs --align-pointer=type --pad-oper --add-brackets -n -r "*.java" + +pkgconfiglibdir = $(libdir)/pkgconfig +pkgconfiglib_DATA = ipopt.pc diff --git a/Ipopt-3.13.4/Makefile.in b/Ipopt-3.13.4/Makefile.in new file mode 100644 index 000000000..5e150d639 --- /dev/null +++ b/Ipopt-3.13.4/Makefile.in @@ -0,0 +1,875 @@ +# Makefile.in generated by automake 1.16.2 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2020 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +# Copyright (C) 2004, 2008 International Business Machines and others. +# All Rights Reserved. +# This file is distributed under the Eclipse Public License. +# +# Authors: Carl Laird, Andreas Waechter IBM 2004-08-13 + +VPATH = @srcdir@ +am__is_gnu_make = { \ + if test -z '$(MAKELEVEL)'; then \ + false; \ + elif test -n '$(MAKE_HOST)'; then \ + true; \ + elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ + true; \ + else \ + false; \ + fi; \ +} +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +@BUILD_LINEARSOLVERLOADER_TRUE@am__append_1 = src/contrib/LinearSolverLoader +@BUILD_SIPOPT_TRUE@am__append_2 = contrib/sIPOPT +subdir = . +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +DIST_COMMON = $(srcdir)/Makefile.am $(top_srcdir)/configure \ + $(am__configure_deps) +am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \ + configure.lineno config.status.lineno +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/src/Common/config.h \ + $(top_builddir)/src/Common/config_ipopt.h +CONFIG_CLEAN_FILES = ipopt.pc doc/Doxyfile \ + examples/Cpp_example/Makefile examples/recursive_nlp/Makefile \ + examples/hs071_cpp/Makefile examples/hs071_c/Makefile \ + examples/ScalableProblems/Makefile \ + tutorial/CodingExercise/C/1-skeleton/Makefile \ + tutorial/CodingExercise/C/2-mistake/Makefile \ + tutorial/CodingExercise/C/3-solution/Makefile \ + tutorial/CodingExercise/Cpp/1-skeleton/Makefile \ + tutorial/CodingExercise/Cpp/2-mistake/Makefile \ + tutorial/CodingExercise/Cpp/3-solution/Makefile \ + tutorial/CodingExercise/Matlab/1-skeleton/startup.m \ + tutorial/CodingExercise/Matlab/2-mistake/startup.m \ + tutorial/CodingExercise/Matlab/3-solution/startup.m \ + examples/hs071_f/hs071_f.f examples/hs071_f/Makefile \ + tutorial/CodingExercise/Fortran/1-skeleton/TutorialFortran.f \ + tutorial/CodingExercise/Fortran/2-mistake/TutorialFortran.f \ + tutorial/CodingExercise/Fortran/3-solution/TutorialFortran.f \ + tutorial/CodingExercise/Fortran/1-skeleton/Makefile \ + tutorial/CodingExercise/Fortran/2-mistake/Makefile \ + tutorial/CodingExercise/Fortran/3-solution/Makefile \ + examples/hs071_java/Makefile \ + examples/ScalableProblems_java/Makefile \ + contrib/sIPOPT/examples/parametric_cpp/Makefile \ + contrib/sIPOPT/examples/parametric_dsdp_cpp/Makefile \ + contrib/sIPOPT/examples/redhess_cpp/Makefile \ + contrib/RInterface/src/Makevars.win \ + contrib/RInterface/src/Makevars ipoptamplinterface.pc +CONFIG_CLEAN_VPATH_FILES = contrib/RInterface/DESCRIPTION \ + contrib/RInterface/NAMESPACE contrib/RInterface/inst/CITATION \ + contrib/RInterface/inst/doc/ipoptr.Rnw \ + contrib/RInterface/inst/doc/ipoptr.pdf \ + contrib/RInterface/inst/doc/reflist.bib \ + contrib/RInterface/man/ipoptr-package.Rd \ + contrib/RInterface/man/ipoptr.Rd \ + contrib/RInterface/man/is.ipoptr.Rd \ + contrib/RInterface/man/make.sparse.Rd \ + contrib/RInterface/man/plot.sparseness.Rd \ + contrib/RInterface/man/print.ipoptr.Rd \ + contrib/RInterface/man/print.sparseness.Rd \ + contrib/RInterface/R/get.option.types.R \ + contrib/RInterface/R/ipoptr.R contrib/RInterface/R/is.ipoptr.R \ + contrib/RInterface/R/make.sparse.R \ + contrib/RInterface/R/plot.sparseness.R \ + contrib/RInterface/R/print.ipoptr.R \ + contrib/RInterface/R/print.sparseness.R \ + contrib/RInterface/tests/approx_banana.R \ + contrib/RInterface/tests/banana.R \ + contrib/RInterface/tests/hs071_nlp.R \ + contrib/RInterface/tests/lasso.R \ + contrib/RInterface/tests/mynlp.R \ + contrib/RInterface/tests/parameters.R \ + contrib/RInterface/tests/sparseness.R \ + contrib/RInterface/src/ipoptr.cpp \ + contrib/RInterface/src/IpoptRJournal.cpp \ + contrib/RInterface/src/IpoptRNLP.cpp \ + examples/Cpp_example/cpp_example.cpp \ + examples/Cpp_example/MyNLP.cpp examples/Cpp_example/MyNLP.hpp \ + examples/hs071_cpp/hs071_main.cpp \ + examples/hs071_cpp/hs071_nlp.cpp \ + examples/hs071_cpp/hs071_nlp.hpp examples/hs071_c/hs071_c.c \ + examples/hs071_java/HS071.java \ + tutorial/AmplExperiments/hs71.mod \ + tutorial/AmplExperiments/infeasible.mod \ + tutorial/AmplExperiments/MoreAmplModels.txt \ + tutorial/AmplExperiments/car1.run \ + tutorial/AmplExperiments/car1.gp tutorial/Modeling/bad1.mod \ + tutorial/Modeling/bad1-fix1.mod \ + tutorial/Modeling/bad1-fix2.mod \ + tutorial/CodingExercise/exercise_example.mod \ + tutorial/CodingExercise/C/1-skeleton/TutorialC.c \ + tutorial/CodingExercise/C/2-mistake/TutorialC.c \ + tutorial/CodingExercise/C/3-solution/TutorialC.c \ + tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_main.cpp \ + tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.hpp \ + tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.cpp \ + tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_main.cpp \ + tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.hpp \ + tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.cpp \ + tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_main.cpp \ + tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.hpp \ + tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.cpp \ + tutorial/CodingExercise/Matlab/1-skeleton/TutorialMatlab.m \ + tutorial/CodingExercise/Matlab/2-mistake/TutorialMatlab.m \ + tutorial/CodingExercise/Matlab/3-solution/TutorialMatlab.m \ + contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp \ + contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp \ + contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.hpp \ + contrib/sIPOPT/examples/parametric_dsdp_cpp/parametric_dsdp_driver.cpp \ + contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.cpp \ + contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.hpp \ + contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp \ + contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.hpp \ + contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +SOURCES = +RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \ + ctags-recursive dvi-recursive html-recursive info-recursive \ + install-data-recursive install-dvi-recursive \ + install-exec-recursive install-html-recursive \ + install-info-recursive install-pdf-recursive \ + install-ps-recursive install-recursive installcheck-recursive \ + installdirs-recursive pdf-recursive ps-recursive \ + tags-recursive uninstall-recursive +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; +am__install_max = 40 +am__nobase_strip_setup = \ + srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` +am__nobase_strip = \ + for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" +am__nobase_list = $(am__nobase_strip_setup); \ + for p in $$list; do echo "$$p $$p"; done | \ + sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ + $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ + if (++n[$$2] == $(am__install_max)) \ + { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ + END { for (dir in files) print dir, files[dir] }' +am__base_list = \ + sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ + sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' +am__uninstall_files_from_dir = { \ + test -z "$$files" \ + || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ + || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ + $(am__cd) "$$dir" && rm -f $$files; }; \ + } +am__installdirs = "$(DESTDIR)$(docdir)" "$(DESTDIR)$(pkgconfiglibdir)" +DATA = $(doc_DATA) $(pkgconfiglib_DATA) +RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \ + distclean-recursive maintainer-clean-recursive +am__recursive_targets = \ + $(RECURSIVE_TARGETS) \ + $(RECURSIVE_CLEAN_TARGETS) \ + $(am__extra_recursive_targets) +AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS \ + cscope +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +CSCOPE = cscope +DIST_SUBDIRS = src/Common src/LinAlg src/Algorithm \ + src/contrib/CGPenalty src/contrib/LinearSolverLoader \ + src/Interfaces src/Apps contrib/sIPOPT +ACLOCAL = @ACLOCAL@ +ADD_CFLAGS = @ADD_CFLAGS@ +ADD_CXXFLAGS = @ADD_CXXFLAGS@ +ADD_FFLAGS = @ADD_FFLAGS@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AR = @AR@ +AS = @AS@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +BIT32FCOMMENT = @BIT32FCOMMENT@ +BIT64FCOMMENT = @BIT64FCOMMENT@ +BITS_PER_POINTER = @BITS_PER_POINTER@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +COIN_PKG_CONFIG_PATH = @COIN_PKG_CONFIG_PATH@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CXX = @CXX@ +CXXCPP = @CXXCPP@ +CXXDEPMODE = @CXXDEPMODE@ +CXXFLAGS = @CXXFLAGS@ +CXXLIBS = @CXXLIBS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DLLTOOL = @DLLTOOL@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +F77 = @F77@ +FFLAGS = @FFLAGS@ +FGREP = @FGREP@ +FLIBS = @FLIBS@ +GREP = @GREP@ +HSLLIB_CFLAGS = @HSLLIB_CFLAGS@ +HSLLIB_CFLAGS_NOPC = @HSLLIB_CFLAGS_NOPC@ +HSLLIB_LFLAGS = @HSLLIB_LFLAGS@ +HSLLIB_LFLAGS_NOPC = @HSLLIB_LFLAGS_NOPC@ +HSLLIB_PCFILES = @HSLLIB_PCFILES@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +IPALLLIBS = @IPALLLIBS@ +IPOPTAMPLINTERFACELIB_CFLAGS = @IPOPTAMPLINTERFACELIB_CFLAGS@ +IPOPTAMPLINTERFACELIB_CFLAGS_NOPC = @IPOPTAMPLINTERFACELIB_CFLAGS_NOPC@ +IPOPTAMPLINTERFACELIB_LFLAGS = @IPOPTAMPLINTERFACELIB_LFLAGS@ +IPOPTAMPLINTERFACELIB_LFLAGS_NOPC = @IPOPTAMPLINTERFACELIB_LFLAGS_NOPC@ +IPOPTAMPLINTERFACELIB_PCFILES = @IPOPTAMPLINTERFACELIB_PCFILES@ +IPOPTLIB_CFLAGS = @IPOPTLIB_CFLAGS@ +IPOPTLIB_CFLAGS_NOPC = @IPOPTLIB_CFLAGS_NOPC@ +IPOPTLIB_LFLAGS = @IPOPTLIB_LFLAGS@ +IPOPTLIB_LFLAGS_NOPC = @IPOPTLIB_LFLAGS_NOPC@ +IPOPTLIB_PCFILES = @IPOPTLIB_PCFILES@ +JAR = @JAR@ +JAVA = @JAVA@ +JAVAC = @JAVAC@ +JAVADOC = @JAVADOC@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +LT_LDFLAGS = @LT_LDFLAGS@ +LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ +MAINT = @MAINT@ +MAKEINFO = @MAKEINFO@ +MANIFEST_TOOL = @MANIFEST_TOOL@ +MKDIR_P = @MKDIR_P@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PKG_CONFIG = @PKG_CONFIG@ +RANLIB = @RANLIB@ +RPATH_FLAGS = @RPATH_FLAGS@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +SIPOPTAMPLINTERFACELIB_CFLAGS = @SIPOPTAMPLINTERFACELIB_CFLAGS@ +SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC = @SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC@ +SIPOPTAMPLINTERFACELIB_LFLAGS = @SIPOPTAMPLINTERFACELIB_LFLAGS@ +SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC = @SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC@ +SIPOPTAMPLINTERFACELIB_PCFILES = @SIPOPTAMPLINTERFACELIB_PCFILES@ +STRIP = @STRIP@ +VERSION = @VERSION@ +_ACJNI_JAVAC = @_ACJNI_JAVAC@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_AR = @ac_ct_AR@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_CXX = @ac_ct_CXX@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +ac_ct_F77 = @ac_ct_F77@ +ac_ct_PKG_CONFIG = @ac_ct_PKG_CONFIG@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +coin_doxy_logname = @coin_doxy_logname@ +coin_doxy_tagfiles = @coin_doxy_tagfiles@ +coin_doxy_tagname = @coin_doxy_tagname@ +coin_doxy_usedot = @coin_doxy_usedot@ +coin_have_doxygen = @coin_have_doxygen@ +coin_have_latex = @coin_have_latex@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +SUBDIRS = src/Common src/LinAlg src/Algorithm src/contrib/CGPenalty \ + $(am__append_1) src/Interfaces src/Apps $(am__append_2) +doc_DATA = README.md AUTHORS LICENSE +pkgconfiglibdir = $(libdir)/pkgconfig +pkgconfiglib_DATA = ipopt.pc +all: all-recursive + +.SUFFIXES: +am--refresh: Makefile + @: +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + echo ' cd $(srcdir) && $(AUTOMAKE) --foreign'; \ + $(am__cd) $(srcdir) && $(AUTOMAKE) --foreign \ + && exit 0; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + echo ' $(SHELL) ./config.status'; \ + $(SHELL) ./config.status;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__maybe_remake_depfiles)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__maybe_remake_depfiles);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + $(SHELL) ./config.status --recheck + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + $(am__cd) $(srcdir) && $(AUTOCONF) +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + $(am__cd) $(srcdir) && $(ACLOCAL) $(ACLOCAL_AMFLAGS) +$(am__aclocal_m4_deps): +ipopt.pc: $(top_builddir)/config.status $(srcdir)/ipopt.pc.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +doc/Doxyfile: $(top_builddir)/config.status $(top_srcdir)/doc/Doxyfile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +examples/Cpp_example/Makefile: $(top_builddir)/config.status $(top_srcdir)/examples/Cpp_example/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +examples/recursive_nlp/Makefile: $(top_builddir)/config.status $(top_srcdir)/examples/recursive_nlp/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +examples/hs071_cpp/Makefile: $(top_builddir)/config.status $(top_srcdir)/examples/hs071_cpp/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +examples/hs071_c/Makefile: $(top_builddir)/config.status $(top_srcdir)/examples/hs071_c/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +examples/ScalableProblems/Makefile: $(top_builddir)/config.status $(top_srcdir)/examples/ScalableProblems/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/C/1-skeleton/Makefile: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/C/1-skeleton/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/C/2-mistake/Makefile: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/C/2-mistake/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/C/3-solution/Makefile: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/C/3-solution/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/Cpp/1-skeleton/Makefile: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/Cpp/1-skeleton/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/Cpp/2-mistake/Makefile: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/Cpp/2-mistake/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/Cpp/3-solution/Makefile: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/Cpp/3-solution/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/Matlab/1-skeleton/startup.m: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/Matlab/1-skeleton/startup.m.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/Matlab/2-mistake/startup.m: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/Matlab/2-mistake/startup.m.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/Matlab/3-solution/startup.m: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/Matlab/3-solution/startup.m.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +examples/hs071_f/hs071_f.f: $(top_builddir)/config.status $(top_srcdir)/examples/hs071_f/hs071_f.f.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +examples/hs071_f/Makefile: $(top_builddir)/config.status $(top_srcdir)/examples/hs071_f/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/Fortran/1-skeleton/TutorialFortran.f: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/Fortran/1-skeleton/TutorialFortran.f.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/Fortran/2-mistake/TutorialFortran.f: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/Fortran/2-mistake/TutorialFortran.f.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/Fortran/3-solution/TutorialFortran.f: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/Fortran/3-solution/TutorialFortran.f.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/Fortran/1-skeleton/Makefile: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/Fortran/1-skeleton/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/Fortran/2-mistake/Makefile: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/Fortran/2-mistake/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +tutorial/CodingExercise/Fortran/3-solution/Makefile: $(top_builddir)/config.status $(top_srcdir)/tutorial/CodingExercise/Fortran/3-solution/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +examples/hs071_java/Makefile: $(top_builddir)/config.status $(top_srcdir)/examples/hs071_java/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +examples/ScalableProblems_java/Makefile: $(top_builddir)/config.status $(top_srcdir)/examples/ScalableProblems_java/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +contrib/sIPOPT/examples/parametric_cpp/Makefile: $(top_builddir)/config.status $(top_srcdir)/contrib/sIPOPT/examples/parametric_cpp/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +contrib/sIPOPT/examples/parametric_dsdp_cpp/Makefile: $(top_builddir)/config.status $(top_srcdir)/contrib/sIPOPT/examples/parametric_dsdp_cpp/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +contrib/sIPOPT/examples/redhess_cpp/Makefile: $(top_builddir)/config.status $(top_srcdir)/contrib/sIPOPT/examples/redhess_cpp/Makefile.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +contrib/RInterface/src/Makevars.win: $(top_builddir)/config.status $(top_srcdir)/contrib/RInterface/src/Makevars.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +contrib/RInterface/src/Makevars: $(top_builddir)/config.status $(top_srcdir)/contrib/RInterface/src/Makevars.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +ipoptamplinterface.pc: $(top_builddir)/config.status $(top_srcdir)/src/Apps/AmplSolver/ipoptamplinterface.pc.in + cd $(top_builddir) && $(SHELL) ./config.status $@ + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +distclean-libtool: + -rm -f libtool config.lt +install-docDATA: $(doc_DATA) + @$(NORMAL_INSTALL) + @list='$(doc_DATA)'; test -n "$(docdir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(docdir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(docdir)" || exit 1; \ + fi; \ + for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + echo "$$d$$p"; \ + done | $(am__base_list) | \ + while read files; do \ + echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(docdir)'"; \ + $(INSTALL_DATA) $$files "$(DESTDIR)$(docdir)" || exit $$?; \ + done + +uninstall-docDATA: + @$(NORMAL_UNINSTALL) + @list='$(doc_DATA)'; test -n "$(docdir)" || list=; \ + files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ + dir='$(DESTDIR)$(docdir)'; $(am__uninstall_files_from_dir) +install-pkgconfiglibDATA: $(pkgconfiglib_DATA) + @$(NORMAL_INSTALL) + @list='$(pkgconfiglib_DATA)'; test -n "$(pkgconfiglibdir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(pkgconfiglibdir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(pkgconfiglibdir)" || exit 1; \ + fi; \ + for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + echo "$$d$$p"; \ + done | $(am__base_list) | \ + while read files; do \ + echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(pkgconfiglibdir)'"; \ + $(INSTALL_DATA) $$files "$(DESTDIR)$(pkgconfiglibdir)" || exit $$?; \ + done + +uninstall-pkgconfiglibDATA: + @$(NORMAL_UNINSTALL) + @list='$(pkgconfiglib_DATA)'; test -n "$(pkgconfiglibdir)" || list=; \ + files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ + dir='$(DESTDIR)$(pkgconfiglibdir)'; $(am__uninstall_files_from_dir) + +# This directory's subdirectories are mostly independent; you can cd +# into them and run 'make' without going through this Makefile. +# To change the values of 'make' variables: instead of editing Makefiles, +# (1) if the variable is set in 'config.status', edit 'config.status' +# (which will cause the Makefiles to be regenerated when you run 'make'); +# (2) otherwise, pass the desired values on the 'make' command line. +$(am__recursive_targets): + @fail=; \ + if $(am__make_keepgoing); then \ + failcom='fail=yes'; \ + else \ + failcom='exit 1'; \ + fi; \ + dot_seen=no; \ + target=`echo $@ | sed s/-recursive//`; \ + case "$@" in \ + distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \ + *) list='$(SUBDIRS)' ;; \ + esac; \ + for subdir in $$list; do \ + echo "Making $$target in $$subdir"; \ + if test "$$subdir" = "."; then \ + dot_seen=yes; \ + local_target="$$target-am"; \ + else \ + local_target="$$target"; \ + fi; \ + ($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ + || eval $$failcom; \ + done; \ + if test "$$dot_seen" = "no"; then \ + $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \ + fi; test -z "$$fail" + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-recursive +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \ + include_option=--etags-include; \ + empty_fix=.; \ + else \ + include_option=--include; \ + empty_fix=; \ + fi; \ + list='$(SUBDIRS)'; for subdir in $$list; do \ + if test "$$subdir" = .; then :; else \ + test ! -f $$subdir/TAGS || \ + set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \ + fi; \ + done; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-recursive + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscope: cscope.files + test ! -s cscope.files \ + || $(CSCOPE) -b -q $(AM_CSCOPEFLAGS) $(CSCOPEFLAGS) -i cscope.files $(CSCOPE_ARGS) +clean-cscope: + -rm -f cscope.files +cscope.files: clean-cscope cscopelist +cscopelist: cscopelist-recursive + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + -rm -f cscope.out cscope.in.out cscope.po.out cscope.files +check-am: all-am +check: check-recursive +all-am: Makefile $(DATA) +installdirs: installdirs-recursive +installdirs-am: + for dir in "$(DESTDIR)$(docdir)" "$(DESTDIR)$(pkgconfiglibdir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-recursive +install-exec: install-exec-recursive +install-data: install-data-recursive +uninstall: uninstall-recursive + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-recursive +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-recursive + +clean-am: clean-generic clean-libtool clean-local mostlyclean-am + +distclean: distclean-recursive + -rm -f $(am__CONFIG_DISTCLEAN_FILES) + -rm -f Makefile +distclean-am: clean-am distclean-generic distclean-libtool \ + distclean-tags + +dvi: dvi-recursive + +dvi-am: + +html: html-recursive + +html-am: + +info: info-recursive + +info-am: + +install-data-am: install-docDATA install-pkgconfiglibDATA + +install-dvi: install-dvi-recursive + +install-dvi-am: + +install-exec-am: + +install-html: install-html-recursive + +install-html-am: + +install-info: install-info-recursive + +install-info-am: + +install-man: + +install-pdf: install-pdf-recursive + +install-pdf-am: + +install-ps: install-ps-recursive + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-recursive + -rm -f $(am__CONFIG_DISTCLEAN_FILES) + -rm -rf $(top_srcdir)/autom4te.cache + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-recursive + +mostlyclean-am: mostlyclean-generic mostlyclean-libtool + +pdf: pdf-recursive + +pdf-am: + +ps: ps-recursive + +ps-am: + +uninstall-am: uninstall-docDATA uninstall-pkgconfiglibDATA + +.MAKE: $(am__recursive_targets) install-am install-strip + +.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am \ + am--refresh check check-am clean clean-cscope clean-generic \ + clean-libtool clean-local cscope cscopelist-am ctags ctags-am \ + distclean distclean-generic distclean-libtool distclean-tags \ + dvi dvi-am html html-am info info-am install install-am \ + install-data install-data-am install-docDATA install-dvi \ + install-dvi-am install-exec install-exec-am install-html \ + install-html-am install-info install-info-am install-man \ + install-pdf install-pdf-am install-pkgconfiglibDATA install-ps \ + install-ps-am install-strip installcheck installcheck-am \ + installdirs installdirs-am maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-generic \ + mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \ + uninstall-am uninstall-docDATA uninstall-pkgconfiglibDATA + +.PRECIOUS: Makefile + + +.PHONY: test unitTest doc javadoc astyle + +test: unitTest + +unitTest: all + cd test; $(MAKE) test + +doc : + cd doc && doxygen + +@BUILD_JAVA_TRUE@javadoc : +@BUILD_JAVA_TRUE@ $(JAVADOC) -d javadoc -windowtitle "JIpopt API documentation" $(srcdir)/src/Interfaces/Ipopt.java + +clean-doc: + cd doc && rm -rf html *.log *.tag + rm -rf javadoc + +clean-local : clean-doc + +astyle: + cd $(srcdir) && astyle --mode=c -A1 --indent=spaces=3 --indent-switches --min-conditional-indent=1 --convert-tabs --align-pointer=type --pad-oper --add-brackets -n -r "*.hpp" "*.h" "*.cpp" "*.c" + cd $(srcdir) && astyle --mode=java -A1 --indent=spaces=3 --indent-switches --min-conditional-indent=1 --convert-tabs --align-pointer=type --pad-oper --add-brackets -n -r "*.java" + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/Ipopt-3.13.4/README.md b/Ipopt-3.13.4/README.md new file mode 100644 index 000000000..5e8d05ebe --- /dev/null +++ b/Ipopt-3.13.4/README.md @@ -0,0 +1,11 @@ +COIN-OR IPOPT with cmake +======================== + +COIN-OR v3.13.0 with cmake support. + +``` +git remotes +----------- +origin : https://github.com/rjodon/coinor-ipopt-with-cmake.git +Upstream: https://github.com/coin-or/Ipopt.git +``` diff --git a/Ipopt-3.13.4/ThirdParty/ASL/AMPLConfig.cmake.in b/Ipopt-3.13.4/ThirdParty/ASL/AMPLConfig.cmake.in new file mode 100644 index 000000000..2089f7847 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/ASL/AMPLConfig.cmake.in @@ -0,0 +1,3 @@ +set(AMPL_INCLUDE_DIRS ${CMAKE_CURRENT_SOURCE_DIR} + ${CMAKE_CURRENT_BINARY_DIR}) +set(AMPL_LIBRARY_DIRS ${CMAKE_CURRENT_BINARY_DIR}) diff --git a/Ipopt-3.13.4/ThirdParty/ASL/CMakeLists.txt b/Ipopt-3.13.4/ThirdParty/ASL/CMakeLists.txt new file mode 100644 index 000000000..59d656c63 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/ASL/CMakeLists.txt @@ -0,0 +1,162 @@ +cmake_minimum_required(VERSION 3.0.2) + +project(amplsolver) + +set(CMAKE_MODULE_PATH ${CMAKE_CURRENT_SOURCE_DIR} + ${CMAKE_MODULE_PATH}) + +set(ExportTarget ${CMAKE_PROJECT_NAME}-targets CACHE STRING "Name for the export target for ${CMAKE_PROJECT_NAME}") + +include(GNUInstallDirs) + +include_directories(${amplsolver_SOURCE_DIR} + ${amplsolver_BINARY_DIR}) + +set(genarith_srcs arithchk.c) +if(WIN32) + set_source_files_properties(arithchk.c PROPERTIES COMPILE_FLAGS "-DNO_FPINIT") +else () + list(APPEND genarith_srcs fpinit.c) +endif () +add_executable(genarith ${genarith_srcs}) +if(UNIX) + target_link_libraries(genarith m) +endif () + +configure_file(${amplsolver_SOURCE_DIR}/stdio1.h0 ${amplsolver_BINARY_DIR}/stdio1.h) + +if (UNIX) + find_program(UNAME uname) + if (UNAME) + execute_process(COMMAND ${UNAME} -sr OUTPUT_VARIABLE System_details) + endif () +else () + set(System_details "${CMAKE_SYSTEM_NAME}") +endif () + +string(REPLACE "\n" "" System_details "${System_details}") +configure_file(${amplsolver_SOURCE_DIR}/details.c0.cmake.in ${amplsolver_BINARY_DIR}/details.c) + +# If genarith command fails, a zero length arith.h will be generated, +# so remove on failure to cause later build failure +add_custom_command(OUTPUT ${amplsolver_BINARY_DIR}/arith.h + COMMAND genarith > ${amplsolver_BINARY_DIR}/arith.h || ${CMAKE_COMMAND} -E remove ${amplsolver_BINARY_DIR}/arith.h) + +set(amplsolver_SRCS ${amplsolver_BINARY_DIR}/arith.h + ${amplsolver_BINARY_DIR}/details.c + asldate.c + atof.c + auxinfo.c + #avldelete.c + avltree.c + b_search.c + basename.c + bscanf.c + com2eval.c + comeval.c + con1ival.c + con2ival.c + con2val.c + conadj.c + conpval.c + conscale.c + conval.c + derprop.c + dtoa1.c + duthes.c + dynlink.c + f_read.c + fg_read.c + fg_write.c + fgh_read.c + fpecatch.c + fpinit.c + fullhes.c + func_add.c + funcadd1.c + g_fmt.c + genrowno.c + getenv.c + getstub.c + htcl.c + jac0dim.c + jac2dim.c + jacdim.c + jacinc.c + jacinc1.c + mach.c + mainexit.c + mip_pri.c + misc.c + mypow.c + names.c + nl_obj.c + nqpcheck.c + obj2val.c + obj_prec.c + objconst.c + objval.c + objval_.c + op_type.c + pfg_read.c + pfghread.c + printf.c + pshvprod.c + punknown.c + qp_read.c + qpcheck.c + qsortv.c + readsol.c + repwhere.c + rops.c + rops2.c + sigcatch.c + sos_add.c + sphes.c + sscanf.c + stderr.c + studchk0.c + suf_sos.c + value.c + writesol.c + wrtsol_.c + ws_desc.c + wsu_desc.c + x2check.c + xectim.c + xp1known.c + xp2known.c + obj_adj.c + mpec_adj.c + libnamsave.c) + +add_library(amplsolver ${amplsolver_SRCS}) + +option(AMPL_HAVE_DLOPEN "Toggle support for dlopen in AMPL" OFF) +if (AMPL_HAVE_DLOPEN) + find_package(DL) + if (DL_FOUND) + add_definitions("-DAMPL_HAVE_DLOPEN") + else () + message(WARNING "dlopen requested, but not found") + endif () +endif () + +if (UNIX) + target_link_libraries(amplsolver ${DL_LIBRARY}) +endif () + +# Allow AMPL build to be shared among several source packages +configure_file(${CMAKE_CURRENT_SOURCE_DIR}/AMPLConfig.cmake.in ${CMAKE_CURRENT_BINARY_DIR}/AMPLConfig.cmake) + +install(TARGETS amplsolver + EXPORT ${ExportTarget} + DESTINATION ${CMAKE_INSTALL_LIBDIR}) + +file(GLOB ampl_headers *.h *.hd) + +install(FILES ${ampl_headers} + DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/ampl) + +install(FILES ${amplsolver_BINARY_DIR}/arith.h ${amplsolver_BINARY_DIR}/stdio1.h + DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/ampl) diff --git a/Ipopt-3.13.4/ThirdParty/ASL/FindDL.cmake b/Ipopt-3.13.4/ThirdParty/ASL/FindDL.cmake new file mode 100644 index 000000000..59a83c2b8 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/ASL/FindDL.cmake @@ -0,0 +1,35 @@ +############################################################################### +# CMake macro to find libdl library. +# +# On success, the macro sets the following variables: +# DL_FOUND = if the library found +# DL_LIBRARY = full path to the library +# DL_INCLUDE_DIR = where to find the library headers +# +# Author: Mateusz Loskot +# +# Redistribution and use is allowed according to the terms of the BSD license. +# For details see the accompanying COPYING-CMAKE-SCRIPTS file. +# +############################################################################### +if(DL_INCLUDE_DIR) + set(DL_FIND_QUIETLY TRUE) +endif() + +find_path(DL_INCLUDE_DIR dlfcn.h) +find_library(DL_LIBRARY NAMES dl) + +include(FindPackageHandleStandardArgs) +find_package_handle_standard_args(DL DEFAULT_MSG DL_LIBRARY DL_INCLUDE_DIR) + +if(NOT DL_FOUND) + # if dlopen can be found without linking in dl then, + # dlopen is part of libc, so don't need to link extra libs. + check_function_exists(dlopen DL_FOUND) + set(DL_LIBRARY "") +endif() + +set(DL_LIBRARIES ${DL_LIBRARY}) + +mark_as_advanced(DL_LIBRARY DL_INCLUDE_DIR) + diff --git a/Ipopt-3.13.4/ThirdParty/ASL/details.c0.cmake.in b/Ipopt-3.13.4/ThirdParty/ASL/details.c0.cmake.in new file mode 100644 index 000000000..0cefe13db --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/ASL/details.c0.cmake.in @@ -0,0 +1,5 @@ +/* For operating-system and compiler details... */ +/* Obtain details.c by changeing "System_details" */ +/* to the appropriate string. */ + +char sysdetails_ASL[] = "@System_details@"; diff --git a/Ipopt-3.13.4/ThirdParty/CMakeLists.txt b/Ipopt-3.13.4/ThirdParty/CMakeLists.txt new file mode 100644 index 000000000..e97bfffb4 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/CMakeLists.txt @@ -0,0 +1,639 @@ +# CMakeLists.txt designed for +# downloading/configuring/building/installing +# Thirdparty dependencies + +if (APPLE) + # Disable annoying "has no symbols" warnings + set(CMAKE_C_ARCHIVE_CREATE " Scr ") + set(CMAKE_CXX_ARCHIVE_CREATE " Scr ") + set(CMAKE_C_ARCHIVE_FINISH " -no_warning_for_no_symbols -c ") + set(CMAKE_CXX_ARCHIVE_FINISH " -no_warning_for_no_symbols -c ") +endif() + +option(COIN_ENABLE_DOWNLOAD_MUMPS "Enable the download / compilation of Mumps" OFF) +option(COIN_ENABLE_DOWNLOAD_METIS "Enable the download / compilation of Metis" OFF) +option(COIN_ENABLE_DOWNLOAD_ASL "Enable the download / compilation of Ampl Solver Library" OFF) +option(COIN_ENABLE_DOWNLOAD_MINGW_LAPACK "Enable the download / compilation of MinGW compiled Blas / Lapack" OFF) +option(COIN_ENABLE_DOWNLOAD_LAPACK "Enable the download / compilation of Blas / Lapack" OFF) +option(COIN_ENABLE_DOWNLOAD_CLAPACK "Enable the download / compilation of CBlas / CLapack" OFF) +option(COIN_ENABLE_DOWNLOAD_MINLPLIB "Enable the download / run of minlp benchmark" OFF) +option(COIN_USE_SYSTEM_LAPACK "Enable the use of the system Lapack" ON) +option(COIN_ENABLE_COMPILE_HSL "Enable the compilation of HSL" OFF) +option(COIN_USE_COINHSL "Use Coin HSL to compile the solver" OFF) +option(COIN_DISABLE_THIRDPARTY "Disable the build of the dependencies" OFF) +if (WIN32) + option(COIN_ENABLE_DOWNLOAD_PATCH "Enable the download / use of Patch exe (for Windows)" OFF) +endif () + +set(COIN_HSL_PATH "None" CACHE PATH "The HSL source Path") + +if (COIN_DISABLE_THIRDPARTY) + return () +endif () + +# Prevent the "make clean" from cleaning this directory +set_directory_properties(PROPERTIES CLEAN_NO_CUSTOM TRUE) + +include(ExternalProject) + +set(EP_InstallDir ${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}) + +if (NOT EXISTS ${EP_InstallDir}) + make_directory(${EP_InstallDir}) +endif () +if (NOT EXISTS ${EP_InstallDir}/bin) + make_directory(${EP_InstallDir}/bin) +endif () +if (NOT EXISTS ${EP_InstallDir}/lib) + make_directory(${EP_InstallDir}/lib) +endif () +if (NOT EXISTS ${EP_InstallDir}/include) + make_directory(${EP_InstallDir}/include) +endif () + +set(CMAKE_GENERATOR_OLD "${CMAKE_GENERATOR}") +set(CMAKE_MAKE_PROGRAM_OLD "${CMAKE_MAKE_PROGRAM}") +if (WIN32) + set(CMAKE_GENERATOR "NMake Makefiles") + set(CMAKE_MAKE_PROGRAM "nmake.exe") + set(CMAKE_OPT "") +else () + set(CMAKE_GENERATOR "Unix Makefiles") + set(CMAKE_MAKE_PROGRAM "make") + set(CMAKE_OPT "-j 16") +endif () + +if (NOT COIN_ENABLE_DOWNLOAD_MINGW_LAPACK AND + NOT COIN_ENABLE_DOWNLOAD_LAPACK AND + NOT COIN_ENABLE_DOWNLOAD_CLAPACK AND + NOT COIN_USE_SYSTEM_LAPACK) + message(WARNING "One kind of Blas / Lapack can be selected: + - COIN_ENABLE_DOWNLOAD_MINGW_LAPACK AND + - COIN_ENABLE_DOWNLOAD_LAPACK AND + - COIN_ENABLE_DOWNLOAD_CLAPACK AND + - COIN_USE_SYSTEM_LAPACK") +endif () + +# ################################################# +# ===> System Lapack +# ################################################# + +if (COIN_USE_SYSTEM_LAPACK) + find_package(LAPACK REQUIRED) + + set(COIN_ENABLE_DOWNLOAD_LAPACK OFF CACHE BOOL "Enable the download / compilation of Blas / Lapack") + set(COIN_ENABLE_DOWNLOAD_CLAPACK OFF CACHE BOOL "Enable the download / compilation of CBlas / CLapack") + + get_filename_component(LAPACK_LINK_PATH "${LAPACK_LIBRARIES}" DIRECTORY) +endif () + +# ################################################# +# <=== System Lapack +# ################################################# + +# ################################################# +# ===> CLapack +# ################################################# + +if (COIN_ENABLE_DOWNLOAD_CLAPACK) + set(CLAPACK_VERSION "3.2.1") + + if (UNIX) + set(CLAPACK_C_FLAGS "-w") + set(CLAPACK_LINKER_FLAGS "-w") + if (NOT HAVE_64_BIT) + set(CLAPACK_C_FLAGS "-fPIC -w") + set(CLAPACK_LINKER_FLAGS "-fPIC -w") + endif () + endif () + + set(IPOPT_HAS_LAPACK ON CACHE BOOL "Enable the Lapack support of CoinUtils" FORCE) + set(COIN_HAS_BLAS ON CACHE BOOL "Enable the Blas support of CoinUtils" FORCE) + + set(CLAPACK_URL "http:////netlib.sandia.gov/clapack/clapack-${CLAPACK_VERSION}-CMAKE.tgz" CACHE FILEPATH "Path to clapack-${CLAPACK_VERSION}-CMAKE.tgz source archive") + set(CLAPACK_InstallDir "${EP_InstallDir}/CLapack-${CLAPACK_VERSION}/${CMAKE_CFG_INTDIR}/") + + if (WIN32 AND NOT MINGW) + ExternalProject_Add(EP_Lapack + PREFIX ${CLAPACK_InstallDir} + URL ${CLAPACK_URL} + UPDATE_COMMAND "" + PATCH_COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/f2c.h ${CLAPACK_InstallDir}/src/EP_Lapack/INCLUDE/ + && ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/f2c.h ${CLAPACK_InstallDir}/src/EP_Lapack/F2CLIBS/libf2c/ + CONFIGURE_COMMAND ${CMAKE_COMMAND} -E make_directory ${CLAPACK_InstallDir}/src/EP_Lapack/build + && ${CMAKE_COMMAND} -E chdir ${CLAPACK_InstallDir}/src/EP_Lapack/build ${CMAKE_COMMAND} -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE} -DCMAKE_INSTALL_PREFIX=${EP_InstallDir} -DCMAKE_C_FLAGS:String=${CLAPACK_C_FLAGS} -DCMAKE_EXE_LINKER_FLAGS:String=${CLAPACK_LINKER_FLAGS} -DCMAKE_TOOLCHAIN_FILE=${CMAKE_TOOLCHAIN_FILE} -G ${CMAKE_GENERATOR} .. + BUILD_COMMAND ${CMAKE_COMMAND} -E chdir ${CLAPACK_InstallDir}/src/EP_Lapack/build ${CMAKE_MAKE_PROGRAM} + INSTALL_COMMAND ${CMAKE_COMMAND} -E copy ${CLAPACK_InstallDir}/src/EP_Lapack/build/SRC/lapack.lib ${EP_InstallDir}/lib + && ${CMAKE_COMMAND} -E copy ${CLAPACK_InstallDir}/src/EP_Lapack/build/F2CLIBS/libf2c/libf2c.lib ${EP_InstallDir}/lib/f2c.lib + && ${CMAKE_COMMAND} -E copy ${CLAPACK_InstallDir}/src/EP_Lapack/build/BLAS/SRC/blas.lib ${EP_InstallDir}/lib + ) + elseif (UNIX) + ExternalProject_Add(EP_Lapack + PREFIX ${CLAPACK_InstallDir} + URL ${CLAPACK_URL} + UPDATE_COMMAND "" + PATCH_COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/f2c.h ${CLAPACK_InstallDir}/src/EP_Lapack/INCLUDE/ + && ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/f2c.h ${CLAPACK_InstallDir}/src/EP_Lapack/F2CLIBS/libf2c/ + CONFIGURE_COMMAND ${CMAKE_COMMAND} -E make_directory ${CLAPACK_InstallDir}/src/EP_Lapack/build + && ${CMAKE_COMMAND} -E chdir ${CLAPACK_InstallDir}/src/EP_Lapack/build ${CMAKE_COMMAND} -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE} -DCMAKE_INSTALL_PREFIX=${EP_InstallDir} -DCMAKE_C_FLAGS:String=${CLAPACK_C_FLAGS} -DCMAKE_EXE_LINKER_FLAGS:String=${CLAPACK_LINKER_FLAGS} -DCMAKE_TOOLCHAIN_FILE=${CMAKE_TOOLCHAIN_FILE} .. + BUILD_COMMAND ${CMAKE_COMMAND} -E chdir ${CLAPACK_InstallDir}/src/EP_Lapack/build ${CMAKE_MAKE_PROGRAM} -j 16 + INSTALL_COMMAND ${CMAKE_COMMAND} -E copy ${CLAPACK_InstallDir}/src/EP_Lapack/build/SRC/liblapack.a ${EP_InstallDir}/lib + && ${CMAKE_COMMAND} -E copy ${CLAPACK_InstallDir}/src/EP_Lapack/build/F2CLIBS/libf2c/libf2c.a ${EP_InstallDir}/lib + && ${CMAKE_COMMAND} -E copy ${CLAPACK_InstallDir}/src/EP_Lapack/build/BLAS/SRC/libblas.a ${EP_InstallDir}/lib + ) + endif () +endif () + +# ################################################# +# <=== CLapack +# ################################################# + +# ################################################# +# ===> Lapack +# ################################################# + +if (COIN_ENABLE_DOWNLOAD_LAPACK) + set(LAPACK_VERSION "3.8.0") + + enable_language(Fortran) + + if (UNIX) + set(LAPACK_C_FLAGS "-w") + set(LAPACK_LINKER_FLAGS "-w") + if (NOT HAVE_64_BIT) + set(LAPACK_C_FLAGS "-fPIC -w") + set(LAPACK_LINKER_FLAGS "-fPIC -w") + endif () + endif () + + set(IPOPT_HAS_LAPACK ON CACHE BOOL "Enable the Lapack support of CoinUtils" FORCE) + set(COIN_HAS_BLAS ON CACHE BOOL "Enable the Blas support of CoinUtils" FORCE) + + set(LAPACK_URL "http:////www.netlib.org/lapack/lapack-${LAPACK_VERSION}.tar.gz" CACHE FILEPATH "Path to lapack-${LAPACK_VERSION}.tgz source archive") + set(LAPACK_InstallDir "${EP_InstallDir}/Lapack-${LAPACK_VERSION}/${CMAKE_CFG_INTDIR}/") + + if (WIN32 AND NOT MINGW) + ExternalProject_Add(EP_Lapack + PREFIX ${LAPACK_InstallDir} + URL ${LAPACK_URL} + UPDATE_COMMAND "" + CONFIGURE_COMMAND ${CMAKE_COMMAND} -E make_directory ${LAPACK_InstallDir}/src/EP_Lapack/build + && ${CMAKE_COMMAND} -E chdir ${LAPACK_InstallDir}/src/EP_Lapack/build ${CMAKE_COMMAND} -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE} -DCMAKE_INSTALL_PREFIX=${EP_InstallDir} -DBUILD_DEPRECATED:Bool=ON -DLAPACKE:Bool=ON -DLAPACKE_WITH_TMG:Bool=ON -DCMAKE_C_FLAGS:String=${CLAPACK_C_FLAGS} -DCMAKE_EXE_LINKER_FLAGS:String=${LAPACK_LINKER_FLAGS} -DCMAKE_TOOLCHAIN_FILE=${CMAKE_TOOLCHAIN_FILE} -G ${CMAKE_GENERATOR} .. + BUILD_COMMAND ${CMAKE_COMMAND} -E chdir ${LAPACK_InstallDir}/src/EP_Lapack/build ${CMAKE_MAKE_PROGRAM} + INSTALL_COMMAND ${CMAKE_COMMAND} -E copy ${LAPACK_InstallDir}/src/EP_Lapack/build/lib/lapack.lib ${EP_InstallDir}/lib + && ${CMAKE_COMMAND} -E copy ${LAPACK_InstallDir}/src/EP_Lapack/build/lib/lapacke.lib ${EP_InstallDir}/lib + && ${CMAKE_COMMAND} -E copy ${LAPACK_InstallDir}/src/EP_Lapack/build/lib/blas.lib ${EP_InstallDir}/lib + && ${CMAKE_COMMAND} -E copy ${LAPACK_InstallDir}/src/EP_Lapack/build/lib/tmglib.lib ${EP_InstallDir}/lib + ) + elseif (UNIX) + ExternalProject_Add(EP_Lapack + PREFIX ${LAPACK_InstallDir} + URL ${LAPACK_URL} + UPDATE_COMMAND "" + CONFIGURE_COMMAND ${CMAKE_COMMAND} -E make_directory ${LAPACK_InstallDir}/src/EP_Lapack/build + && ${CMAKE_COMMAND} -E chdir ${LAPACK_InstallDir}/src/EP_Lapack/build ${CMAKE_COMMAND} -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE} -DCMAKE_INSTALL_PREFIX=${EP_InstallDir} -DBUILD_DEPRECATED:Bool=ON -DLAPACKE:Bool=ON -DLAPACKE_WITH_TMG:Bool=ON -DCMAKE_C_FLAGS:String=${CLAPACK_C_FLAGS} -DCMAKE_EXE_LINKER_FLAGS:String=${LAPACK_LINKER_FLAGS} -DCMAKE_TOOLCHAIN_FILE=${CMAKE_TOOLCHAIN_FILE} .. + BUILD_COMMAND ${CMAKE_COMMAND} -E chdir ${LAPACK_InstallDir}/src/EP_Lapack/build ${CMAKE_MAKE_PROGRAM} -j 16 + INSTALL_COMMAND ${CMAKE_COMMAND} -E copy ${LAPACK_InstallDir}/src/EP_Lapack/build/lib/liblapack.a ${EP_InstallDir}/lib + && ${CMAKE_COMMAND} -E copy ${LAPACK_InstallDir}/src/EP_Lapack/build/lib/liblapacke.a ${EP_InstallDir}/lib + && ${CMAKE_COMMAND} -E copy ${LAPACK_InstallDir}/src/EP_Lapack/build/lib/libblas.a ${EP_InstallDir}/lib + && ${CMAKE_COMMAND} -E copy ${LAPACK_InstallDir}/src/EP_Lapack/build/lib/libtmglib.a ${EP_InstallDir}/lib + ) + endif () +endif () + +if (COIN_ENABLE_FIND_LAPACK) + find_package(LAPACK) + find_package(BLAS) + + if (LAPACK_FOUND AND BLAS_FOUND) + set(IPOPT_HAS_LAPACK ON CACHE BOOL "Enable the Lapack support of CoinUtils" FORCE) + set(COIN_HAS_BLAS ON CACHE BOOL "Enable the Blas support of CoinUtils" FORCE) + else () + set(IPOPT_HAS_LAPACK OFF CACHE BOOL "Enable the Lapack support of CoinUtils" FORCE) + set(COIN_HAS_BLAS OFF CACHE BOOL "Enable the Blas support of CoinUtils" FORCE) + endif () +endif () + +# ################################################# +# <=== Lapack +# ################################################# + +# ################################################# +# ===> MinGW Lapack +# ################################################# + +if (COIN_ENABLE_DOWNLOAD_MINGW_LAPACK) + set(COIN_MINGW_LAPACK_ZIP_FILE "None" CACHE FILEPATH "Path to the zip file containing MinGW Lapack") + + set(IPOPT_HAS_LAPACK ON CACHE BOOL "Enable the Lapack support of CoinUtils" FORCE) + set(COIN_HAS_BLAS ON CACHE BOOL "Enable the Blas support of CoinUtils" FORCE) + + ExternalProject_Add(EP_Lapack + PREFIX ${EP_InstallDir}/MinGW-Lapack + URL ${COIN_MINGW_LAPACK_ZIP_FILE} + UPDATE_COMMAND "" + CONFIGURE_COMMAND "" + BUILD_COMMAND "" + INSTALL_COMMAND ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/lib/liblapack.lib ${EP_InstallDir}/lib/lapack.lib + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/lib/libblas.lib ${EP_InstallDir}/lib/blas.lib + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/lib/libtmglib.lib ${EP_InstallDir}/lib/tmglib.lib + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/liblapack.dll ${EP_InstallDir}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/libblas.dll ${EP_InstallDir}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/libtmglib.dll ${EP_InstallDir}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/libgcc_s_seh-1.dll ${EP_InstallDir}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/libgfortran-3.dll ${EP_InstallDir}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/libquadmath-0.dll ${EP_InstallDir}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/libwinpthread-1.dll ${EP_InstallDir}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/liblapack.dll ${CMAKE_CURRENT_BINARY_DIR}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/libblas.dll ${CMAKE_CURRENT_BINARY_DIR}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/libtmglib.dll ${CMAKE_CURRENT_BINARY_DIR}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/libgcc_s_seh-1.dll ${CMAKE_CURRENT_BINARY_DIR}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/libgfortran-3.dll ${CMAKE_CURRENT_BINARY_DIR}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/libquadmath-0.dll ${CMAKE_CURRENT_BINARY_DIR}/bin + && ${CMAKE_COMMAND} -E copy ${EP_InstallDir}/MinGW-Lapack/src/EP_Lapack/bin/libwinpthread-1.dll ${CMAKE_CURRENT_BINARY_DIR}/bin + ) +endif () + +# ################################################# +# <=== MinGW Lapack +# ################################################# + +# ################################################# +# ===> Metis compilation +# ################################################# + +if (COIN_ENABLE_DOWNLOAD_METIS) + set(METIS_VERSION "4.0.3") + + if (NOT EXISTS ${EP_InstallDir}/include/metis) + make_directory(${EP_InstallDir}/include/metis) + endif () + + set(METIS_URL "http:////glaros.dtc.umn.edu/gkhome/fetch/sw/metis/OLD/metis-${METIS_VERSION}.tar.gz" CACHE FILEPATH "Path to metis-${METIS_VERSION}.tar.gz source archive") + set(METIS_InstallDir "${EP_InstallDir}/Metis-${METIS_VERSION}/${CMAKE_CFG_INTDIR}/") + + ExternalProject_Add(EP_Metis + PREFIX ${METIS_InstallDir} + URL ${METIS_URL} + UPDATE_COMMAND "" + PATCH_COMMAND "" + CONFIGURE_COMMAND "" + BUILD_COMMAND ${CMAKE_COMMAND} -E chdir ${METIS_InstallDir}/src/EP_Metis/ ${CMAKE_MAKE_PROGRAM} -j 16 + INSTALL_COMMAND ${CMAKE_COMMAND} -E copy ${METIS_InstallDir}/src/EP_Metis/libmetis.a ${EP_InstallDir}/lib + && ${CMAKE_COMMAND} -E copy ${METIS_InstallDir}/src/EP_Metis/Lib/macros.h ${EP_InstallDir}/include/metis/ + && ${CMAKE_COMMAND} -E copy ${METIS_InstallDir}/src/EP_Metis/Lib/struct.h ${EP_InstallDir}/include/metis/ + && ${CMAKE_COMMAND} -E copy ${METIS_InstallDir}/src/EP_Metis/Lib/proto.h ${EP_InstallDir}/include/metis/ + && ${CMAKE_COMMAND} -E copy ${METIS_InstallDir}/src/EP_Metis/Lib/metis.h ${EP_InstallDir}/include/metis/ + && ${CMAKE_COMMAND} -E copy ${METIS_InstallDir}/src/EP_Metis/Lib/defs.h ${EP_InstallDir}/include/metis/ + && ${CMAKE_COMMAND} -E copy ${METIS_InstallDir}/src/EP_Metis/Lib/rename.h ${EP_InstallDir}/include/metis/ + ) +endif () + +# ################################################# +# <=== Metis compilation +# ################################################# + +# ################################################# +# ===> Mumps compilation +# ################################################# + +# # Normally this would optionally download MUMPS and compile it as external project. +# # But we always need MUMPS with OpenModelica. So we have pre-downloaded MUMPS, applied +# # the patches Ipopt has for it, and added CMake configuration support for it. +# # So we just add it as a subdirectory here and keep COIN_ENABLE_DOWNLOAD_MUMPS disabled. +add_subdirectory(MUMPS) + +if (COIN_ENABLE_DOWNLOAD_MUMPS) + set(MUMPS_VERSION "4.10.0") + set(IPOPT_HAS_MUMPS ON CACHE BOOL "Clp uses the MUMPS linear solver" FORCE) + set(IPOPT_HAS_MUMPS ON CACHE BOOL "Enable Mumps solver" FORCE) + + set(MUMPS_DEPENDS "") + + if (COIN_ENABLE_DOWNLOAD_METIS) + set(MUMPS_METIS_INC_PATH "${EP_InstallDir}/include/metis" CACHE PATH "The METIS library include Path" FORCE) + set(MUMPS_METIS_LIB_PATH "${EP_InstallDir}/lib" CACHE PATH "The METIS library library Path" FORCE) + else () + set(MUMPS_METIS_INC_PATH "None" CACHE PATH "The METIS library include Path" FORCE) + set(MUMPS_METIS_LIB_PATH "None" CACHE PATH "The METIS library library Path" FORCE) + endif () + + if (COIN_ENABLE_DOWNLOAD_CLAPACK OR COIN_ENABLE_DOWNLOAD_LAPACK) + set(MUMPS_DEPENDS ${MUMPS_DEPENDS} EP_Lapack) + endif () + if (COIN_ENABLE_DOWNLOAD_METIS) + set(MUMPS_DEPENDS ${MUMPS_DEPENDS} EP_Metis) + endif () + + set(MUMPS_URL "http:////mumps.enseeiht.fr/MUMPS_${MUMPS_VERSION}.tar.gz" CACHE FILEPATH "Path to MUMPS_${MUMPS_VERSION}.tar.gz source archive") + set(MUMPS_InstallDir "${EP_InstallDir}/Mumps-${MUMPS_VERSION}/${CMAKE_CFG_INTDIR}/") + + if (COIN_USE_SYSTEM_LAPACK) + set(MUMPS_LAPACK_PATH "${LAPACK_LINK_PATH}") + else () + set(MUMPS_LAPACK_PATH "${EP_InstallDir}/lib") + endif () + + # TODO: we need to add the path to mumps_mpi.h once Mumps is patched ... + ExternalProject_Add(EP_Mumps + PREFIX ${MUMPS_InstallDir} + DEPENDS ${MUMPS_DEPENDS} + URL ${MUMPS_URL} + UPDATE_COMMAND "" + PATCH_COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/CMakeLists_mumps.txt ${MUMPS_InstallDir}/src/EP_Mumps/CMakeLists.txt + # && ${CMAKE_COMMAND} -E chdir ${MUMPS_InstallDir}/src/EP_Mumps ${PATCH_EXECUTABLE} -p1 < ${CMAKE_CURRENT_SOURCE_DIR}/mumps_mpi.patch + # && ${CMAKE_COMMAND} -E chdir ${MUMPS_InstallDir}/src/EP_Mumps ${PATCH_EXECUTABLE} -p1 < ${CMAKE_CURRENT_SOURCE_DIR}/mumps.patch + CONFIGURE_COMMAND ${CMAKE_COMMAND} -E make_directory ${MUMPS_InstallDir}/src/EP_Mumps/build + && ${CMAKE_COMMAND} -E chdir ${MUMPS_InstallDir}/src/EP_Mumps/build ${CMAKE_COMMAND} -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE} -DCMAKE_INSTALL_PREFIX=${EP_InstallDir} -DMUMPS_USE_LIBSEQ=ON -DMUMPS_USE_METIS=${COIN_ENABLE_DOWNLOAD_METIS} -DMUMPS_LAPACK_LIB_PATH:Path=${MUMPS_LAPACK_PATH} -DMUMPS_METIS_INC_PATH:Path=${MUMPS_METIS_INC_PATH} -DMUMPS_METIS_LIB_PATH:Path=${MUMPS_METIS_LIB_PATH} -DMUMPS_INSTALL_COIN=ON -DMUMPS_USE_F2C=${COIN_ENABLE_DOWNLOAD_CLAPACK} -DCMAKE_TOOLCHAIN_FILE=${CMAKE_TOOLCHAIN_FILE} -G ${CMAKE_GENERATOR} .. + BUILD_COMMAND ${CMAKE_COMMAND} -E chdir ${MUMPS_InstallDir}/src/EP_Mumps/build ${CMAKE_MAKE_PROGRAM} -j 16 + INSTALL_COMMAND ${CMAKE_COMMAND} -E chdir ${MUMPS_InstallDir}/src/EP_Mumps/build ${CMAKE_MAKE_PROGRAM} install + ) +endif () +# ################################################# +# <=== Mumps compilation +# ################################################# + +# ################################################# +# ===> ASL compilation +# ################################################# + +if (COIN_ENABLE_DOWNLOAD_ASL) + set(ASL_VERSION "3.1.0") + set(IPOPT_HAS_ASL ON CACHE BOOL "Enable the ASL support" FORCE) + + set(ASL_URL "https:////github.com/ampl/mp/archive/${ASL_VERSION}.tar.gz" CACHE FILEPATH "Path to ${ASL_VERSION}.tar.gz source archive") + set(ASL_InstallDir "${EP_InstallDir}/ASL-${ASL_VERSION}/${CMAKE_CFG_INTDIR}/") + + ExternalProject_Add(EP_ASL + PREFIX ${ASL_InstallDir} + URL ${ASL_URL} + UPDATE_COMMAND "" + PATCH_COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/ASL/AMPLConfig.cmake.in ${ASL_InstallDir}/src/EP_ASL/src/asl/solvers/ + && ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/ASL/CMakeLists.txt ${ASL_InstallDir}/src/EP_ASL/src/asl/solvers/ + && ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/ASL/FindDL.cmake ${ASL_InstallDir}/src/EP_ASL/src/asl/solvers/ + && ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/ASL/details.c0.cmake.in ${ASL_InstallDir}/src/EP_ASL/src/asl/solvers/ + CONFIGURE_COMMAND ${CMAKE_COMMAND} -E make_directory ${ASL_InstallDir}/src/EP_ASL/src/asl/solvers/build + && ${CMAKE_COMMAND} -E chdir ${ASL_InstallDir}/src/EP_ASL/src/asl/solvers/build ${CMAKE_COMMAND} -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE} -DCMAKE_INSTALL_PREFIX=${EP_InstallDir} -DCMAKE_TOOLCHAIN_FILE=${CMAKE_TOOLCHAIN_FILE} -G ${CMAKE_GENERATOR} .. + BUILD_COMMAND ${CMAKE_COMMAND} -E chdir ${ASL_InstallDir}/src/EP_ASL/src/asl/solvers/build ${CMAKE_MAKE_PROGRAM} + INSTALL_COMMAND ${CMAKE_COMMAND} -E chdir ${ASL_InstallDir}/src/EP_ASL/src/asl/solvers/build ${CMAKE_MAKE_PROGRAM} install + ) + + set(IPOPT_HAS_AMPL ON CACHE BOOL "Enable Ampl interface") +endif () + +# ################################################# +# <=== ASL compilation +# ################################################# + +# ################################################# +# ===> HSL +# ################################################# + +if ((COIN_ENABLE_COMPILE_HSL OR COIN_USE_COINHSL) AND NOT COIN_HSL_PATH STREQUAL "None") + set(IPOPT_HAS_HSL ON CACHE BOOL "Enable the HSL support" FORCE) + set(IPOPT_HAS_HSL_OTHER OFF CACHE BOOL "Enable the non local solver HSL support" FORCE) + + set(COINHSL_HAS_METIS "${COIN_ENABLE_DOWNLOAD_METIS}") + set(COINHSL_HSL2013 OFF) + set(IPOPT_HAS_HSL_OTHER OFF) + + set(COINHSL_VERSION "2014.01.17") + set(COINHSL_VERSION_MAJOR 2014) + set(COINHSL_VERSION_MINOR 1) + set(COINHSL_VERSION_RELEASE 17) + + set(HSL_SOLVER_SRCS ) + set(HSL_OTHER_SRCS ) + + set(IPOPT_HAS_HSL OFF CACHE INTERNAL "") + set(COINHSL_HAS_MA27 OFF CACHE INTERNAL "") + set(COINHSL_HAS_MA28 OFF CACHE INTERNAL "") + set(COINHSL_HAS_MC19 OFF CACHE INTERNAL "") + set(COINHSL_HAS_MA57 OFF CACHE INTERNAL "") + set(COINHSL_HAS_MA86 OFF CACHE INTERNAL "") + set(COINHSL_HAS_MA77 OFF CACHE INTERNAL "") + set(COINHSL_HAS_MC68 OFF CACHE INTERNAL "") + set(COINHSL_HAS_MA97 OFF CACHE INTERNAL "") + set(IPOPT_HAS_HSL_OTHER OFF CACHE INTERNAL "") + + if (COIN_USE_COINHSL) + set(IPOPT_HAS_HSL ON CACHE INTERNAL "") + set(COINHSL_HAS_MA27 ON CACHE INTERNAL "") + set(COINHSL_HAS_MA28 ON CACHE INTERNAL "") + set(COINHSL_HAS_MC19 ON CACHE INTERNAL "") + + add_definitions(-DCOINHSL_HAS_MA27 -DCOINHSL_HAS_MA28 -DCOINHSL_HAS_MC19) + + set(HSL_SOLVER_SRCS ${HSL_SOLVER_SRCS} + ${COIN_HSL_PATH}/ma27/ma27d.f + ${COIN_HSL_PATH}/ma28/ma28d.f + ${COIN_HSL_PATH}/mc19/mc19d.f + ${COIN_HSL_PATH}/common/deps.f) + else () + if (EXISTS ${COIN_HSL_PATH}/ma27/ma27d.f) + set(COINHSL_HAS_MA27 ON CACHE INTERNAL "") + set(IPOPT_HAS_HSL ON CACHE INTERNAL "") + + add_definitions(-DCOINHSL_HAS_MA27) + + set(HSL_SOLVER_SRCS ${HSL_SOLVER_SRCS} + ${COIN_HSL_PATH}/ma27/ma27d.f) + endif () + if (EXISTS ${COIN_HSL_PATH}/ma28/ma28d.f) + set(COINHSL_HAS_MA28 ON CACHE INTERNAL "") + set(IPOPT_HAS_HSL ON CACHE INTERNAL "") + + add_definitions(-DCOINHSL_HAS_MA28) + + set(HSL_SOLVER_SRCS ${HSL_SOLVER_SRCS} + ${COIN_HSL_PATH}/ma28/ma28d.f) + endif () + if (EXISTS ${COIN_HSL_PATH}/mc19/mc19d.f) + set(COINHSL_HAS_MC19 ON CACHE INTERNAL "") + set(IPOPT_HAS_HSL ON CACHE INTERNAL "") + + add_definitions(-DCOINHSL_HAS_MC19) + + set(HSL_SOLVER_SRCS ${HSL_SOLVER_SRCS} + ${COIN_HSL_PATH}/mc19/mc19d.f) + endif () + endif () + + if (EXISTS ${COIN_HSL_PATH}/ma57/ma57d.f) + set(COINHSL_HAS_MA57 ON CACHE INTERNAL "") + set(IPOPT_HAS_HSL_OTHER ON CACHE INTERNAL "") + + add_definitions(-DCOINHSL_HAS_MA57) + + set(HSL_OTHER_SRCS ${HSL_OTHER_SRCS} + ${COIN_HSL_PATH}/ma57/ma57d.f) + endif () + if (EXISTS ${COIN_HSL_PATH}/ma86/ma86d.f) + set(COINHSL_HAS_MA86 ON CACHE INTERNAL "") + set(IPOPT_HAS_HSL_OTHER ON CACHE INTERNAL "") + + add_definitions(-DCOINHSL_HAS_MA86) + + set(HSL_OTHER_SRCS ${HSL_OTHER_SRCS} + ${COIN_HSL_PATH}/ma86/ma86d.f) + endif () + if (EXISTS ${COIN_HSL_PATH}/ma77/ma77d.f) + set(COINHSL_HAS_MA77 ON CACHE INTERNAL "") + set(IPOPT_HAS_HSL_OTHER ON CACHE INTERNAL "") + + add_definitions(-DCOINHSL_HAS_MA77) + + set(HSL_OTHER_SRCS ${HSL_OTHER_SRCS} + ${COIN_HSL_PATH}/ma77/ma77d.f) + endif () + if (EXISTS ${COIN_HSL_PATH}/mc68/mc68.f) + set(COINHSL_HAS_MC68 ON CACHE INTERNAL "") + set(IPOPT_HAS_HSL_OTHER ON CACHE INTERNAL "") + + add_definitions(-DCOINHSL_HAS_MC68) + + set(HSL_OTHER_SRCS ${HSL_OTHER_SRCS} + ${COIN_HSL_PATH}/mc68/mc68.f) + endif () + if (EXISTS ${COIN_HSL_PATH}/ma97/ma97d.f) + set(COINHSL_HAS_MA97 ON CACHE INTERNAL "") + set(IPOPT_HAS_HSL_OTHER ON CACHE INTERNAL "") + + add_definitions(-DCOINHSL_HAS_MA97) + + set(HSL_OTHER_SRCS ${HSL_OTHER_SRCS} + ${COIN_HSL_PATH}/ma97/ma97d.f) + endif () + + if (COINHSL_HSL2013) + set(IPOPT_HAS_HSL ON CACHE INTERNAL "") + + add_definitions(-DCOINHSL_HSL2013) + endif () + + configure_file(${CMAKE_CURRENT_SOURCE_DIR}/../Ipopt/include/config_coinhsl.h.in ${CMAKE_CURRENT_BINARY_DIR}/Ipopt/include/config_coinhsl.h) + configure_file(${CMAKE_CURRENT_SOURCE_DIR}/../Ipopt/include/config_coinhsl.h.in ${CMAKE_CURRENT_BINARY_DIR}/Ipopt/include/CoinHslConfig.h) + + add_library(hsl SHARED ${HSL_SOLVER_SRCS}) + add_library(hsl-static STATIC ${HSL_SOLVER_SRCS}) + if (IPOPT_HAS_HSL_OTHER) + add_library(hsl-other STATIC ${HSL_OTHER_SRCS}) + endif () + + if (IPOPT_ENABLE_LINEARSOLVERLOADER) + install(TARGETS hsl) + endif () +endif () + +# ################################################# +# <=== HSL +# ################################################# + +# ################################################# +# ===> Tests +# ################################################# + +if (COIN_ENABLE_DOWNLOAD_MINLPLIB) + set(MINLPLIB_URL "http:////www.minlplib.org/minlplib_nl.zip" CACHE FILEPATH "Path to MinLpNl source archive") + + ExternalProject_Add(EP_MINLPLIB + PREFIX ${EP_InstallDir}/MINLPLIB + URL ${MINLPLIB_URL} + PATCH_COMMAND "" + UPDATE_COMMAND "" + CONFIGURE_COMMAND "" + BUILD_COMMAND "" + INSTALL_COMMAND "" + ) + + include(MinLpTests.cmake) +endif () + +# ################################################# +# <=== Tests +# ################################################# + +# ################################################# +# ===> Patch +# ################################################# + +if (WIN32 AND COIN_ENABLE_DOWNLOAD_PATCH) + set(PATCH_VERSION "2.5.9-7") + + set(PATCH_URL "https:////sourceforge.net//projects//gnuwin32//files//patch//${PATCH_VERSION}//patch-${PATCH_VERSION}-bin.zip" CACHE FILEPATH "Path to Patch-${PATCH_VERSION} binary archive") + + ExternalProject_Add(EP_PATCH + PREFIX ${EP_InstallDir}/Patch-${PATCH_VERSION}/ + URL ${PATCH_URL} + PATCH_COMMAND "" + UPDATE_COMMAND "" + CONFIGURE_COMMAND "" + BUILD_COMMAND "" + INSTALL_COMMAND "" + ) + + set(PATCH_EXECUTABLE "${EP_InstallDir}/Patch-${PATCH_VERSION}/src/EP_PATCH/bin/patch.exe" CACHE FILEPATH "Path to the patch executable") +else () + find_program(TMP_PATCH_EXECUTABLE patch) + set(PATCH_EXECUTABLE "${TMP_PATCH_EXECUTABLE}" CACHE FILEPATH "Path to the patch executable") +endif () + +# ################################################# +# <=== Patch +# ################################################# + +set(CMAKE_GENERATOR "${CMAKE_GENERATOR_OLD}") +set(CMAKE_MAKE_PROGRAM "${CMAKE_MAKE_PROGRAM_OLD}") + +# ################################################# +# ===> Restart cmake +# ################################################# + +## Overload some CMake command to avoid modif all sub-projects CMakLists.txt file +## The original built-in commands are prefixed with an underscore if overriding any of them +## Prevent the modification of all sub-project + +macro(add_library_mod _target) + add_library (${_target} ${ARGN}) + + ## We have pre-downloaded MUMPS and added it as a cmake sub_directory + ## So just link to the library here. add_dependency does not apply here. + # if (COIN_ENABLE_DOWNLOAD_MUMPS) + # add_dependencies(${_target} EP_Mumps) + # endif () + target_link_libraries(${_target} PUBLIC coinmumps) + ## IF the MUMPS source has been patched with the Ipopt MPI patche already + ## we need to define this to signigy that. + target_compile_definitions(${_target} PRIVATE COIN_USE_MUMPS_MPI_H) + + if (COIN_ENABLE_DOWNLOAD_METIS) + add_dependencies(${_target} EP_Metis) + endif () + if (COIN_ENABLE_DOWNLOAD_ASL) + add_dependencies(${_target} EP_ASL) + endif () + if (COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_ENABLE_DOWLOAD_CLAPACK) + add_dependencies(${_target} EP_Lapack) + endif () +endmacro () + +macro(add_executable_mod _target) + add_executable (${_target} ${ARGN}) + + if (COIN_ENABLE_DOWNLOAD_MUMPS) + add_dependencies(${_target} EP_Mumps) + endif () + if (COIN_ENABLE_DOWNLOAD_METIS) + add_dependencies(${_target} EP_Metis) + endif () + if (COIN_ENABLE_DOWNLOAD_ASL) + add_dependencies(${_target} EP_ASL) + endif () + if (COIN_ENABLE_DOWNLOAD_LAPACK OR COIN_ENABLE_DOWLOAD_CLAPACK) + add_dependencies(${_target} EP_Lapack) + endif () +endmacro () + +# ################################################# +# <=== Restart cmake +# ################################################# diff --git a/Ipopt-3.13.4/ThirdParty/CMakeLists_mumps.txt b/Ipopt-3.13.4/ThirdParty/CMakeLists_mumps.txt new file mode 100644 index 000000000..65e9c3fae --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/CMakeLists_mumps.txt @@ -0,0 +1,433 @@ +# This file is copied into MUMPS folder once the library downloaded +# + +project (MUMPS C CXX Fortran) + +cmake_minimum_required (VERSION 2.8) + +option(MUMPS_USE_LIBSEQ "Use the MUMPS sequential MPI stub" OFF) +option(MUMPS_USE_METIS "Use the Metis library" ON) +option(MUMPS_USE_F2C "F2c was used to compiled CLapack" OFF) +option(MUMPS_INSTALL_COIN "Install MUMPS for CoinOR" ON) + +set(MUMPS_METIS_INC_PATH "None" CACHE PATH "The METIS library include Path") +set(MUMPS_METIS_LIB_PATH "None" CACHE PATH "The METIS library library Path") + +set(MUMPS_LAPACK_LIB_PATH "None" CACHE PATH "The Lapack library library Path") + +set(INCLUDEDIR ${CMAKE_CURRENT_SOUR_DIR}/../../../include) + +include(GNUInstallDirs) + +#------------------------------------------------------------ +# End of user config part +#------------------------------------------------------------ + +set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/bin) +set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/bin) +set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/bin) + +#------------------------------------------------------------ +# Detect 64 bits +#------------------------------------------------------------ + +if (CMAKE_SIZEOF_VOID_P EQUAL 4) + set(HAVE_64_BIT 0) +else () + set(HAVE_64_BIT 1) +endif () + +#------------------------------------------------------------ +# MPI +#------------------------------------------------------------ + +if (NOT MUMPS_USE_LIBSEQ AND NOT MPI_FOUND) + # Use MPI_EXTRA_LIBNAMES to specify required libraries under MPI + set(MPI_EXTRA_LIBNAMES fmpich mpich) + find_package(MPI) +endif () + +if (NOT MUMPS_USE_LIBSEQ) + if (WIN32) + add_definitions("/Dpord") + add_definitions("/DOMPI_IMPORTS /DOPAL_IMPORTS /DORTEIMPORTS") + else () + add_definitions("-Dpord") + endif () +endif () + +#------------------------------------------------------------ +# ATLAS / MKL +#------------------------------------------------------------ + +# Use MKL_LIBS to specify the required libs under MKL +if (WIN32) + if (HAVE_64_BIT) + set(MKL_LIBS mkl_lapack95_lp64 + mkl_blas95_lp64 + mkl_solver_lp64 + mkl_intel_lp64 + mkl_intel_thread + mkl_core + mkl_blacs_lp64_dll) + else () + set(MKL_LIBS mkl_lapack95 + mkl_blas95 + mkl_solver + mkl_intel_c + mkl_intel_thread + mkl_core + mkl_blacs_dll) + endif () +else () + set(MKL_LIBS mkl_lapack95_lp64 + mkl_blas95_lp64 + mkl_solver_lp64 + mkl_intel_lp64 + mkl_intel_thread + mkl_core + mkl_blacs_openmpi_lp64) +endif () + + +if (NOT BLAS_FOUND OR NOT LAPACK_FOUND) + message(STATUS "Searching for BLAS and LAPACK") + find_package(BLAS REQUIRED) + find_package(LAPACK REQUIRED) +endif () + +#------------------------------------------------------------ +# configure config*.h +#------------------------------------------------------------ + +# if MPI found, then do not compile libseq ... + +include_directories(${CMAKE_CURRENT_SOURCE_DIR}/include) +include_directories(${CMAKE_CURRENT_SOURCE_DIR}/src) + +if (MPI_FOUND) + include_directories(${MPI_INCLUDE_PATH}) +endif () + +if (MUMPS_USE_LIBSEQ) + include_directories(${CMAKE_CURRENT_SOURCE_DIR}/libseq) +endif () + +if (MKL_FOUND) + link_directories(${MKL_PATH}) +endif () + +if (MPI_FOUND) + link_directories(${MPI_LIBRARY_PATH}) +endif () + +#------------------------------------------------------------ +# METIS +#------------------------------------------------------------ + +if (MUMPS_USE_METIS) + add_definitions(-Dmetis) +endif () + +if (NOT MUMPS_METIS_INC_PATH STREQUAL "None") + include_directories(${MUMPS_METIS_INC_PATH}) +endif () +if (NOT MUMPS_METIS_LIB_PATH STREQUAL "None") + link_directories(${MUMPS_METIS_LIB_PATH}) +endif () +if (NOT MUMPS_LAPACK_LIB_PATH STREQUAL "None") + link_directories(${MUMPS_LAPACK_LIB_PATH}) +endif () + +#------------------------------------------------------------ +# Build +#------------------------------------------------------------ + +set(MUMPS_PORD_SRCS PORD/lib/graph.c + PORD/lib/gbipart.c + PORD/lib/gbisect.c + PORD/lib/ddcreate.c + PORD/lib/ddbisect.c + PORD/lib/nestdiss.c + PORD/lib/multisector.c + PORD/lib/gelim.c + PORD/lib/bucket.c + PORD/lib/tree.c + PORD/lib/symbfac.c + PORD/lib/interface.c + PORD/lib/sort.c + PORD/lib/minpriority.c) + +set(MUMPS_LIBSEQ_SRCS libseq/mpi.f + libseq/mpic.c + libseq/elapse.c) + +set(MUMPS_COMMON_SRCS src/mumps_part9.F + src/mumps_common.c + src/mumps_ooc_common.F + src/mumps_orderings.c + src/mumps_size.c + src/mumps_io.c + src/mumps_io_basic.c + src/mumps_io_thread.c + src/mumps_io_err.c + src/mumps_static_mapping.F + src/tools_common_mod.F + src/mumps_sol_es.F) + +set(MUMPS_C_SRCS src/cmumps_part1.F + src/cmumps_part2.F + src/cmumps_part3.F + src/cmumps_part4.F + src/cmumps_part5.F + src/cmumps_part6.F + src/cmumps_part7.F + src/cmumps_part8.F + src/cmumps_comm_buffer.F + src/cmumps_load.F + src/mumps_c.c + src/cmumps_ooc_buffer.F + src/cmumps_ooc.F + src/cmumps_struc_def.F) + +set(MUMPS_D_SRCS src/dmumps_part1.F + src/dmumps_part2.F + src/dmumps_part3.F + src/dmumps_part4.F + src/dmumps_part5.F + src/dmumps_part6.F + src/dmumps_part7.F + src/dmumps_part8.F + src/dmumps_comm_buffer.F + src/dmumps_load.F + src/mumps_c.c + src/dmumps_ooc_buffer.F + src/dmumps_ooc.F + src/dmumps_struc_def.F) + +set(MUMPS_S_SRCS src/smumps_part1.F + src/smumps_part2.F + src/smumps_part3.F + src/smumps_part4.F + src/smumps_part5.F + src/smumps_part6.F + src/smumps_part7.F + src/smumps_part8.F + src/smumps_comm_buffer.F + src/smumps_load.F + src/mumps_c.c + src/smumps_ooc_buffer.F + src/smumps_ooc.F + src/smumps_struc_def.F) + +set(MUMPS_Z_SRCS src/zmumps_part1.F + src/zmumps_part2.F + src/zmumps_part3.F + src/zmumps_part4.F + src/zmumps_part5.F + src/zmumps_part6.F + src/zmumps_part7.F + src/zmumps_part8.F + src/zmumps_comm_buffer.F + src/zmumps_load.F + src/mumps_c.c + src/zmumps_ooc_buffer.F + src/zmumps_ooc.F + src/zmumps_struc_def.F) + +# Warnings are disabled +if (WIN32) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /fpp /nologo /reentrancy /fixed /warn:noalignments /Qsave /Qzero /libs:static /threads /traceback /D_CRT_SECURE_NO_WARNINGS /DALLOW_NON_INIT /Dintel_ ") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} /nologo /D_CRT_SECURE_NO_WARNINGS /DAdd_ ") +else () + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp -w -fcray-pointer -fall-intrinsics -finit-local-zero -DALLOW_NON_INIT -Dintel_ ") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -w -DAdd_ ") +endif () + +if (WIN32) + if (MUMPS_USE_LIBSEQ) + set(LINK_LIBS ${LINK_LIBS} + libseq) + else () + set(LINK_LIBS ${LINK_LIBS} + ${MPI_LIB_NAME}) + endif () + + if (MKL_FOUND) + set(LINK_LIBS ${LINK_LIBS} + ${ATLAS_LIBRARIES} + libiomp5mt) + endif () +else () + if (MKL_FOUND) + set(LINK_LIBS ${LINK_LIBS} + ${ATLAS_LIBRARIES} + iomp5) + endif () + + if (MUMPS_USE_LIBSEQ) + set(LINK_LIBS ${LINK_LIBS} + libseq) + else () + set(LINK_LIBS ${LINK_LIBS} + ${MPI_LIB_NAME}) + endif () + + if (BLAS_FOUND) + set(LINK_LIBS ${LINK_LIBS} + blas) + endif () + + if (LAPACK_FOUND) + set(LINK_LIBS ${LINK_LIBS} + lapack) + endif () + + if (MUMPS_USE_F2C) + set(LINK_LIBS ${LINK_LIBS} + f2c) + endif () + + set(LINK_LIBS ${LINK_LIBS} + pthread) +endif () + +if (MUMPS_USE_METIS) + set(LINK_LIBS ${LINK_LIBS} + metis m) +endif () + +if (MUMPS_USE_LIBSEQ) + add_library(libseq STATIC ${MUMPS_LIBSEQ_SRCS}) + if (NOT WIN32) + set_target_properties(libseq PROPERTIES PREFIX "") + endif () +endif () + +add_library(libpord STATIC ${MUMPS_PORD_SRCS}) +target_include_directories(libpord BEFORE PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/PORD/include) +if (NOT WIN32) + set_target_properties(libpord PROPERTIES PREFIX "") +endif () + +add_library(libmumps_common STATIC ${MUMPS_COMMON_SRCS}) +if (NOT WIN32) + set_target_properties(libmumps_common PROPERTIES PREFIX "") +endif () + +add_library(libcmumps STATIC ${MUMPS_C_SRCS}) +if (NOT WIN32) + set_target_properties(libcmumps PROPERTIES PREFIX "") +endif () +target_link_libraries(libcmumps libmumps_common) + +add_library(libdmumps STATIC ${MUMPS_D_SRCS}) +if (NOT WIN32) + set_target_properties(libdmumps PROPERTIES PREFIX "") +endif () +target_link_libraries(libdmumps libmumps_common) + +add_library(libsmumps STATIC ${MUMPS_S_SRCS}) +if (NOT WIN32) + set_target_properties(libsmumps PROPERTIES PREFIX "") +endif () +target_link_libraries(libsmumps libmumps_common) + +add_library(libzmumps STATIC ${MUMPS_Z_SRCS}) +if (NOT WIN32) + set_target_properties(libzmumps PROPERTIES PREFIX "") +endif () +target_link_libraries(libzmumps libmumps_common) + +if (WIN32) + set_property(TARGET libsmumps PROPERTY COMPILE_FLAGS "/DMUMPS_ARITH=MUMPS_ARITH_s") + set_property(TARGET libdmumps PROPERTY COMPILE_FLAGS "/DMUMPS_ARITH=MUMPS_ARITH_d") + set_property(TARGET libcmumps PROPERTY COMPILE_FLAGS "/DMUMPS_ARITH=MUMPS_ARITH_c") + set_property(TARGET libzmumps PROPERTY COMPILE_FLAGS "/DMUMPS_ARITH=MUMPS_ARITH_z") +else () + set_property(TARGET libsmumps PROPERTY COMPILE_FLAGS "-DMUMPS_ARITH=MUMPS_ARITH_s") + set_property(TARGET libdmumps PROPERTY COMPILE_FLAGS "-DMUMPS_ARITH=MUMPS_ARITH_d") + set_property(TARGET libcmumps PROPERTY COMPILE_FLAGS "-DMUMPS_ARITH=MUMPS_ARITH_c") + set_property(TARGET libzmumps PROPERTY COMPILE_FLAGS "-DMUMPS_ARITH=MUMPS_ARITH_z") +endif () + +# To allow the link of examples on the cluster +if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") + set(LINK_LIBS ${LINK_LIBS} + ifcore) +endif () + +add_executable(ssimple_test examples/ssimpletest.F) +target_link_libraries(ssimple_test libsmumps libmumps_common libpord ${LINK_LIBS}) +set_target_properties(ssimple_test PROPERTIES LINKER_LANGUAGE Fortran) + +add_executable(dsimple_test examples/dsimpletest.F) +target_link_libraries(dsimple_test libdmumps libmumps_common libpord ${LINK_LIBS}) +set_target_properties(dsimple_test PROPERTIES LINKER_LANGUAGE Fortran) + +add_executable(csimple_test examples/csimpletest.F) +target_link_libraries(csimple_test libcmumps libmumps_common libpord ${LINK_LIBS}) +set_target_properties(csimple_test PROPERTIES LINKER_LANGUAGE Fortran) + +add_executable(zsimple_test examples/zsimpletest.F) +target_link_libraries(zsimple_test libzmumps libmumps_common libpord ${LINK_LIBS}) +set_target_properties(zsimple_test PROPERTIES LINKER_LANGUAGE Fortran) + +add_executable(c_example examples/c_example.c) +target_link_libraries(c_example libdmumps libmumps_common libpord ${LINK_LIBS}) +if (WIN32) + # Under windows, this line is required to allow compilation of the MUMPS C example. + # Under Linux, this line makes the link phase hangs because of multiply defined main symbol + set_target_properties(c_example PROPERTIES LINKER_LANGUAGE Fortran) +endif () + +# Install rules +if (MUMPS_USE_LIBSEQ) + install(TARGETS libseq + DESTINATION ${LIBDIR}) +endif () + +install(TARGETS libpord + DESTINATION ${LIBDIR}) + +install(TARGETS libmumps_common + DESTINATION ${LIBDIR}) + +install(TARGETS libcmumps + DESTINATION ${LIBDIR}) + +install(TARGETS libdmumps + DESTINATION ${LIBDIR}) + +install(TARGETS libsmumps + DESTINATION ${LIBDIR}) + +install(TARGETS libzmumps + DESTINATION ${LIBDIR}) + +if (MUMPS_USE_LIBSEQ) + install(DIRECTORY libseq/ + DESTINATION ${INCLUDEDIR}/ + PATTERN "*.h") + + if (MUMPS_INSTALL_COIN) + install(FILES libseq/mpi.h + DESTINATION ${INCLUDEDIR}/ + RENAME mumps_mpi.h) + endif () +else () + if (MUMPS_INSTALL_COIN) + install(FILES ${MPI_C_INCLUDE_PATH}/libseq/mpi.h + DESTINATION ${INCLUDEDIR}/ + RENAME mumps_mpi.h) + endif () +endif () + +install(DIRECTORY include/ + DESTINATION ${INCLUDEDIR}/ + PATTERN "*.h") + +install(DIRECTORY PORD/include/ + DESTINATION ${INCLUDEDIR}/ + PATTERN "*.h") + diff --git a/Ipopt-3.13.4/ThirdParty/HSL/CMakeLists.txt b/Ipopt-3.13.4/ThirdParty/HSL/CMakeLists.txt new file mode 100644 index 000000000..a1944b98e --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/HSL/CMakeLists.txt @@ -0,0 +1,15 @@ +cmake_minimum_required(VERSION 2.6) +#include base etk functionality + +project(hsl Fortran) + +file(GLOB SRCS "*.f") + +add_library(hsl ${SRCS}) +#Need to get it to use the rigth runtime library + +set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} /NODEFAULTLIB}") + +set_target_properties(hsl PROPERTIES DEBUG_POSTFIX -d) + +install(TARGETS hsl DESTINATION $ENV{ETK_BINARIES}) diff --git a/Ipopt-3.13.4/ThirdParty/HSL/REPLACE-Windows-ifort.cmake b/Ipopt-3.13.4/ThirdParty/HSL/REPLACE-Windows-ifort.cmake new file mode 100644 index 000000000..6561dec7e --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/HSL/REPLACE-Windows-ifort.cmake @@ -0,0 +1,71 @@ +set(CMAKE_LIBRARY_PATH_FLAG "-LIBPATH:") +set(CMAKE_LINK_LIBRARY_FLAG "") +set(WIN32 1) +if(CMAKE_VERBOSE_MAKEFILE) + set(CMAKE_CL_NOLOGO) +else(CMAKE_VERBOSE_MAKEFILE) + set(CMAKE_CL_NOLOGO "/nologo") +endif(CMAKE_VERBOSE_MAKEFILE) + +set(CMAKE_Fortran_MODDIR_FLAG "-module:") + +set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_OBJECTS 1) + +set(CMAKE_Fortran_CREATE_SHARED_LIBRARY + "link ${CMAKE_CL_NOLOGO} ${CMAKE_START_TEMP_FILE} /out: /dll ${CMAKE_END_TEMP_FILE}") + +set(CMAKE_Fortran_CREATE_SHARED_MODULE ${CMAKE_Fortran_CREATE_SHARED_LIBRARY}) + +# create a C++ static library +set(CMAKE_Fortran_CREATE_STATIC_LIBRARY "lib ${CMAKE_CL_NOLOGO} /out: ") + +# compile a C++ file into an object file +set(CMAKE_Fortran_COMPILE_OBJECT + " ${CMAKE_START_TEMP_FILE} ${CMAKE_CL_NOLOGO} /fpp /Fo -c ${CMAKE_END_TEMP_FILE}") + +set(CMAKE_COMPILE_RESOURCE "rc /fo ") + +set(CMAKE_Fortran_LINK_EXECUTABLE + " ${CMAKE_CL_NOLOGO} ${CMAKE_START_TEMP_FILE} /Fe -link ${CMAKE_END_TEMP_FILE}") + +set(CMAKE_CREATE_WIN32_EXE /subsystem:windows) +set(CMAKE_CREATE_CONSOLE_EXE /subsystem:console) + +if(CMAKE_GENERATOR MATCHES "Visual Studio 6") + set(CMAKE_NO_BUILD_TYPE 1) +endif(CMAKE_GENERATOR MATCHES "Visual Studio 6") + +if(CMAKE_GENERATOR MATCHES "Visual Studio 7" OR CMAKE_GENERATOR MATCHES "Visual Studio 8") + set(CMAKE_NO_BUILD_TYPE 1) + set(CMAKE_CONFIGURATION_TYPES "Debug;Release;MinSizeRel;RelWithDebInfo" CACHE STRING + "Semicolon separated list of supported configuration types, only supports Debug, Release, MinSizeRel, and RelWithDebInfo, anything else will be ignored.") +endif(CMAKE_GENERATOR MATCHES "Visual Studio 7" OR CMAKE_GENERATOR MATCHES "Visual Studio 8") +# does the compiler support pdbtype and is it the newer compiler + +set(CMAKE_BUILD_TYPE_INIT Debug) +set(CMAKE_Fortran_FLAGS_INIT "/W1 /nologo /fpp ") +set(CMAKE_Fortran_FLAGS_DEBUG_INIT "/debug:full /Od /gen-interfaces /warn:interfaces /libs:dll /threads /c /dbglibs") +set(CMAKE_Fortran_FLAGS_MINSIZEREL_INIT "/O2 /D NDEBUG /gen-interfaces /warn:interfaces /libs:dll /threads /c") +set(CMAKE_Fortran_FLAGS_RELEASE_INIT "/MD /O1 /D NDEBUG /gen-interfaces /warn:interfaces /libs:dll /threads /c") +set(CMAKE_Fortran_FLAGS_RELWITHDEBINFO_INIT "/O1 /debug:full /D NDEBUG /gen-interfaces /warn:interfaces /libs:dll /threads /c") + +set(CMAKE_Fortran_STANDARD_LIBRARIES_INIT "user32.lib") + +# executable linker flags +set(CMAKE_LINK_DEF_FILE_FLAG "/DEF:") +set(CMAKE_EXE_LINKER_FLAGS_INIT " /INCREMENTAL:YES") + +if(CMAKE_COMPILER_SUPPORTS_PDBTYPE) + set(CMAKE_EXE_LINKER_FLAGS_DEBUG_INIT "/debug /pdbtype:sept") + set(CMAKE_EXE_LINKER_FLAGS_RELWITHDEBINFO_INIT "/debug /pdbtype:sept") +else(CMAKE_COMPILER_SUPPORTS_PDBTYPE) + set(CMAKE_EXE_LINKER_FLAGS_DEBUG_INIT "/debug") + set(CMAKE_EXE_LINKER_FLAGS_RELWITHDEBINFO_INIT "/debug") +endif(CMAKE_COMPILER_SUPPORTS_PDBTYPE) + +set(CMAKE_SHARED_LINKER_FLAGS_INIT ${CMAKE_EXE_LINKER_FLAGS_INIT}) +set(CMAKE_SHARED_LINKER_FLAGS_DEBUG_INIT ${CMAKE_EXE_LINKER_FLAGS_DEBUG_INIT}) +set(CMAKE_SHARED_LINKER_FLAGS_RELWITHDEBINFO_INIT ${CMAKE_EXE_LINKER_FLAGS_DEBUG_INIT}) +set(CMAKE_MODULE_LINKER_FLAGS_INIT ${CMAKE_SHARED_LINKER_FLAGS_INIT}) +set(CMAKE_MODULE_LINKER_FLAGS_DEBUG_INIT ${CMAKE_SHARED_LINKER_FLAGS_DEBUG_INIT}) +set(CMAKE_MODULE_LINKER_FLAGS_RELWITHDEBINFO_INIT ${CMAKE_EXE_LINKER_FLAGS_RELWITHDEBINFO_INIT}) diff --git a/Ipopt-3.13.4/ThirdParty/IpoptTests.cmake b/Ipopt-3.13.4/ThirdParty/IpoptTests.cmake new file mode 100644 index 000000000..1a53a4e0d --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/IpoptTests.cmake @@ -0,0 +1,170 @@ +include(coin-macros) + +set(EP_InstallDir ${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}) +set(IPOPT_INSTANCES_DIR "${EP_InstallDir}/ASL-1.3.0/src/EP_ASL/test/data") + +# Invalide nl tests: +# +# ampl_sudokuVeryEasy_nl_ipopt_standard +# ampl_flowshp1_nl_ipopt_standard +# ampl_max-with-zero-args_nl_ipopt_standard +# ampl_test_nl_ipopt_standard +# ampl_assign1_nl_ipopt_standard +# ampl_element_nl_ipopt_standard +# ampl_send-most-money_nl_ipopt_standard +# ampl_ssd_nl_ipopt_standard +# ampl_party1_nl_ipopt_standard +# ampl_nqueens_nl_ipopt_standard +# ampl_openshop_nl_ipopt_standard +# ampl_send-more-money_nl_ipopt_standard +# ampl_photo9_nl_ipopt_standard +# ampl_min-with-zero-args_nl_ipopt_standard +# ampl_mapcoloring_nl_ipopt_standard +# ampl_sudokuHard_nl_ipopt_standard +# ampl_feasible_nl_ipopt_standard +# ampl_flowshp2_nl_ipopt_standard + +# Unknown Error: Invalid number in NLP function or derivative detected. +# smps/three-stage.nl +# smps/nonlinear.nl +# infeasible.nl +# sched1.nl +# nqueens0.nl +# numberof.nl +# noobj.nl +# sched2.nl + +# https://icwww.epfl.ch/~sam/Coconut-benchs/CSP-benchs.tar.gz +# https://vanderbei.princeton.edu/ampl/nlmodels/cute.tar.gz +# https://vanderbei.princeton.edu/ampl/nlmodels/noncute.tar.gz +# http://www.netlib.org/ampl/models.tgz + +# TODO: +# 1494 - ampl_seq0a_nl_ipopt_standard (Failed) +# 1515 - ipopt_example_luksan_LukVlE7 (Failed) +# 1522 - ipopt_example_luksan_LukVlI7 (Failed) +# 1524 - ipopt_example_luksan_MBndryCntrl2 (Failed) +# 1534 - ipopt_example_luksan_MBndryCntrl_3Dsin (Timeout) +# 1544 - ipopt_example_luksan_MDistCntrl6a (Failed) +# 1546 - ipopt_example_luksan_MPara5_2_1 (Failed) +# 1547 - ipopt_example_luksan_MPara5_2_2 (Failed) + +set(IPOPT_TEST_LIST magic.nl + sudokuVeryEasy.nl + objconst.nl + flowshp1.nl + seq0.nl + max-with-zero-args.nl + smps/inconsistent-probabilities.nl + smps/zero-core-con.nl + smps/zero-core-coefs.nl + smps/three-stage.nl + smps/range-con.nl + smps/single-stage.nl + smps/vars-not-in-stage-order.nl + smps/random-bound.nl + smps/random-con-matrix2.nl + smps/int-var.nl + smps/single-scenario.nl + smps/random-con-matrix.nl + smps/nonlinear.nl + smps/random-rhs.nl + test.nl + balassign0.nl + miplib/assign1.nl + balassign1.nl + assign1.nl + grpassign0.nl + unbounded.nl + infeasible.nl + sched1.nl + nqueens0.nl + element.nl + send-most-money.nl + ssd.nl + numberof.nl + party1.nl + nqueens.nl + simple.nl + flowshp0.nl + seq0a.nl + assign0.nl + noobj.nl + openshop.nl + send-more-money.nl + suffix.nl + sched0.nl + sched2.nl + objconstint.nl + photo9.nl + min-with-zero-args.nl + mapcoloring.nl + sudokuHard.nl + feasible.nl + flowshp2.nl + ) + +add_ipopt_test_list(ampl ipopt_standard IPOPT_TEST_LIST "NL;IPOPT" 30) + +set_tests_properties(ampl_sudokuVeryEasy_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_flowshp1_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_max_with_zero_args_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_smps_three_stage_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_smps_nonlinear_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_test_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_miplib_assign1_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_assign1_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_infeasible_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_sched1_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_nqueens0_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_element_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_send_most_money_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_ssd_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_numberof_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_party1_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_nqueens_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_noobj_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_openshop_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_send_more_money_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_sched2_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_photo9_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_min_with_zero_args_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_mapcoloring_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_sudokuHard_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_feasible_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_feasible_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") +set_tests_properties(ampl_flowshp2_nl_ipopt_standard PROPERTIES LABELS "NL;IPOPT;FAIL") + +set_tests_properties(ampl_assign0_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_balassign0_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_balassign1_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_flowshp0_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_infeasible_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_miplib_assign1_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_noobj_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_nqueens0_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_numberof_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_objconstint_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_objconst_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sched0_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sched1_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sched2_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_seq0a_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_seq0_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_simple_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smps_inconsistent_probabilities_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smps_int_var_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smps_nonlinear_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smps_random_bound_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smps_random_con_matrix2_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smps_random_con_matrix_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smps_random_rhs_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smps_range_con_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smps_single_scenario_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smps_single_stage_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smps_three_stage_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smps_vars_not_in_stage_order_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smps_zero_core_coefs_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smps_zero_core_con_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_suffix_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_unbounded_nl_ipopt_standard PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Iterates diverging; problem might be unbounded.") diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/CMakeLists.txt b/Ipopt-3.13.4/ThirdParty/MUMPS/CMakeLists.txt new file mode 100644 index 000000000..9995992e1 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/CMakeLists.txt @@ -0,0 +1,206 @@ + +cmake_minimum_required (VERSION 2.8) +project (MUMPS C CXX Fortran) + +## The OM Ipopt uses libseq always. I think libseq contains stubs for MPI. +## OM does not use MPI as far as I know so we are good. The alternative to +## libseq is maybe to use MPI. This is what I have understood so far. +# option(MUMPS_USE_LIBSEQ "Use the MUMPS sequential MPI stub" ON) + +option(MUMPS_BUILD_SHARED_LIBS "Build libraries as shared libraries" OFF) +option(MUMPS_USE_METIS "Use the Metis library" OFF) + +find_package(LAPACK REQUIRED) +find_package(Threads REQUIRED) + + +#------------------------------------------------------------ +# Sources +#------------------------------------------------------------ + +set(MUMPS_PORD_SRCS PORD/lib/graph.c + PORD/lib/gbipart.c + PORD/lib/gbisect.c + PORD/lib/ddcreate.c + PORD/lib/ddbisect.c + PORD/lib/nestdiss.c + PORD/lib/multisector.c + PORD/lib/gelim.c + PORD/lib/bucket.c + PORD/lib/tree.c + PORD/lib/symbfac.c + PORD/lib/interface.c + PORD/lib/sort.c + PORD/lib/minpriority.c) + +set(MUMPS_LIBSEQ_SRCS libseq/mpi.f + libseq/mpic.c + libseq/elapse.c) + +set(MUMPS_COMMON_SRCS src/mumps_part9.F + src/mumps_common.c + src/mumps_ooc_common.F + src/mumps_orderings.c + src/mumps_size.c + src/mumps_io.c + src/mumps_io_basic.c + src/mumps_io_thread.c + src/mumps_io_err.c + src/mumps_static_mapping.F + src/tools_common_mod.F + src/mumps_sol_es.F) + +set(MUMPS_C_SRCS src/cmumps_part1.F + src/cmumps_part2.F + src/cmumps_part3.F + src/cmumps_part4.F + src/cmumps_part5.F + src/cmumps_part6.F + src/cmumps_part7.F + src/cmumps_part8.F + src/cmumps_comm_buffer.F + src/cmumps_load.F + src/mumps_c.c + src/cmumps_ooc_buffer.F + src/cmumps_ooc.F + src/cmumps_struc_def.F) + +set(MUMPS_D_SRCS src/dmumps_part1.F + src/dmumps_part2.F + src/dmumps_part3.F + src/dmumps_part4.F + src/dmumps_part5.F + src/dmumps_part6.F + src/dmumps_part7.F + src/dmumps_part8.F + src/dmumps_comm_buffer.F + src/dmumps_load.F + src/mumps_c.c + src/dmumps_ooc_buffer.F + src/dmumps_ooc.F + src/dmumps_struc_def.F) + +set(MUMPS_S_SRCS src/smumps_part1.F + src/smumps_part2.F + src/smumps_part3.F + src/smumps_part4.F + src/smumps_part5.F + src/smumps_part6.F + src/smumps_part7.F + src/smumps_part8.F + src/smumps_comm_buffer.F + src/smumps_load.F + src/mumps_c.c + src/smumps_ooc_buffer.F + src/smumps_ooc.F + src/smumps_struc_def.F) + +set(MUMPS_Z_SRCS src/zmumps_part1.F + src/zmumps_part2.F + src/zmumps_part3.F + src/zmumps_part4.F + src/zmumps_part5.F + src/zmumps_part6.F + src/zmumps_part7.F + src/zmumps_part8.F + src/zmumps_comm_buffer.F + src/zmumps_load.F + src/mumps_c.c + src/zmumps_ooc_buffer.F + src/zmumps_ooc.F + src/zmumps_struc_def.F) + + + +# Warnings are disabled +if (MSVC) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /fpp /nologo /reentrancy /fixed /warn:noalignments /Qsave /Qzero /libs:static /threads /traceback /D_CRT_SECURE_NO_WARNINGS /DALLOW_NON_INIT /Dintel_ ") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} /nologo /D_CRT_SECURE_NO_WARNINGS /DAdd_ ") +else () + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp -w -fcray-pointer -fall-intrinsics -finit-local-zero -DALLOW_NON_INIT -Dintel_ ") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -w -DAdd_ ") +endif () + + +if(MUMPS_BUILD_SHARED_LIBS) + add_library(coinmumps SHARED ${MUMPS_D_SRCS} ${MUMPS_COMMON_SRCS} ${MUMPS_LIBSEQ_SRCS}) +else() + add_library(coinmumps STATIC ${MUMPS_D_SRCS} ${MUMPS_COMMON_SRCS} ${MUMPS_LIBSEQ_SRCS}) +endif() + +if (MSVC) + target_compile_definitions(coinmumps PRIVATE "/DMUMPS_ARITH=MUMPS_ARITH_d") +else () + target_compile_definitions(coinmumps PRIVATE "-DMUMPS_ARITH=MUMPS_ARITH_d") +endif () +target_link_libraries(coinmumps PUBLIC ${LAPACK_LIBRARIES}) + +if(THREADS_HAVE_PTHREAD_ARG) + target_compile_options(coinmumps PUBLIC pthread) +endif() +if(CMAKE_THREAD_LIBS_INIT) + target_link_libraries(coinmumps PUBLIC ${CMAKE_THREAD_LIBS_INIT}) +endif() + +target_include_directories(coinmumps PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/include) +target_include_directories(coinmumps PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/libseq) + + +# if (MUMPS_USE_METIS) +# target_link_libraries(dmumps PUBLIC metis m) +# target_compile_definitions(dmumps PRIVATE -Dmetis) +# endif () + +## If you want to check dmumps lib works fine. +## See examples/README for instructions running the tests +# add_executable(dsimple_test examples/dsimpletest.F) +# target_link_libraries(dsimple_test dmumps ${LINK_LIBS}) + + + +install(TARGETS coinmumps + RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} + LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} + ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR}) + + +# ---------------------------------------------------------------------- + + +# # If you want to build the other mumps libs, e.g. single precision (smumps) or complex mumps (cmumps) +# # copy what is done for dmumps above and adjust it. It is also a good idea to build mumps_common, +# # libseq, and pord as separate libraries in that case. Right now since we only want dmumps we just +# # build it using all need sources to avoid creating unnecessary libraries that are linked just once. + +# add_library(seq STATIC ${MUMPS_LIBSEQ_SRCS}) + +# add_library(pord STATIC ${MUMPS_PORD_SRCS}) +# target_include_directories(pord BEFORE PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/PORD/include) + +# add_library(mumps_common STATIC ${MUMPS_COMMON_SRCS}) + + + +# add_library(cmumps STATIC ${MUMPS_C_SRCS}) +# target_link_libraries(cmumps mumps_common) + +# add_library(smumps STATIC ${MUMPS_S_SRCS}) +# target_link_libraries(smumps mumps_common) + +# add_library(zmumps STATIC ${MUMPS_Z_SRCS}) +# target_link_libraries(zmumps mumps_common) + +# if (MSVC) +# target_compile_definitions(smumps PRIVATE "/DMUMPS_ARITH=MUMPS_ARITH_s") +# target_compile_definitions(dmumps PRIVATE "/DMUMPS_ARITH=MUMPS_ARITH_d") +# target_compile_definitions(cmumps PRIVATE "/DMUMPS_ARITH=MUMPS_ARITH_c") +# target_compile_definitions(zmumps PRIVATE "/DMUMPS_ARITH=MUMPS_ARITH_z") +# else () +# target_compile_definitions(smumps PRIVATE "-DMUMPS_ARITH=MUMPS_ARITH_s") +# target_compile_definitions(dmumps PRIVATE "-DMUMPS_ARITH=MUMPS_ARITH_d") +# target_compile_definitions(cmumps PRIVATE "-DMUMPS_ARITH=MUMPS_ARITH_c") +# target_compile_definitions(zmumps PRIVATE "-DMUMPS_ARITH=MUMPS_ARITH_z") +# endif () + + + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/ChangeLog b/Ipopt-3.13.4/ThirdParty/MUMPS/ChangeLog new file mode 100644 index 000000000..2d5390433 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/ChangeLog @@ -0,0 +1,436 @@ +------------- += ChangeLog = +------------- + +Changes from 4.9.2 to 4.10.0 +* Modified variable names and variable contents in Make.inc/Makefile* + for Windows (Makefile.inc from an older version needs modifications, + please do a diff) +* Option to discard factors during factorization when + not needed (ICNTL(31)) +* Option to compute the determinant (ICNTL(33)) +* Experimental "A-1" functionality (ICNTL(30)) +* Matlab interface updated for 64-bit machines +* Improved users' guide +* Suppressed a memory leak occurring when Scalapack is used + and user does loops on JOB=6 without JOB=-2/JOB=-1 in-between +* Avoid occasional deadlock with huge values of ICNTL(14) +* Avoid problem of -17 error code during solve phase +* Avoid checking association of pointer arrays ISOL_loc and SOL_loc + on procs with no components of solution (small problems) +* Some data structures were not free at the end of the parallel analysis. Bug fixed. +* Fixed unsafe test of overflow "IF (WFLG+N .LE. WFLG)" +* Large Schur complements sent by blocks if ICNTL(19)=1 (but + options ICNTL(19)=2 or 3 are recommended when Schur complement + is large) +* Corrected problem with sparse RHS + unsymmetric permutation + + transpose solve (problem appeared in 4.9) +* Case where ICNTL(19)=2 or 3 and small value of SIZE_SCHUR + causing problems in parallel solved. +* In case an error is detected, solved occasional problem of + deallocating non-allocated local array PERM. +* Correction in computation of matrix norm in complex arithmetic + (MPI_COMPLEX was used in place of MPI_REAL in MPI_REDUCE) +* Scaling works on singular matrices +* Compilation problem with -i8 solved +* MUMPS_INT used in OOC layer to facilitate compilation with + 64 bit integers + +Changes from 4.9.1 to 4.9.2 +* Compressed orderings (ICNTL(12)=2) are now compatible with PORD + and PT-Scotch +* Mapping problem on large numbers of MPI processes, leading to + INFOG(1)=-135 on "special" matrices solved (problem appeared + in 4.9.1) + +Changes from 4.9 to 4.9.1 +* Balancing on the processors of both work and memory improved. + In a parallel environment memory consumption should be reduced + and performance improved +* Modification of the amalgamation to solve both the problem of + small root nodes and the problem of tiny nodes implying too many + small MPI messages +* Corrected bug occurring on big-endian environments when passing + a 64-bit integer argument in place of 32-bit one. This was causing + problems in parallel, when ScaLAPACK is used, on IBM machines. +* Internal ERROR 2 in MUMPS_271 now impossible (was + already not happening in practice) +* Solved compiler warnings (or even errors) related to the + order of the declarations of arrays and array sizes +* Parallel analysis: fixed the problem due to the invocation of the size + function on non-allocated pointers, corrected a bug due to initialization + of pointers in the declaration statements, and improved the Makefiles +* Corrected bug in the reallocation of arrays +* Corrected several accesses to uninitialized variables +* Internal Error (4) in OOC (MUMPS_597) no more occurs +* Suppressed possible printing of "Internal WARNING 1 in CMUMPS_274" +* (Minor) numerical pivoting problem in parallel LDLt solved +* Estimated flops corrected when SYM=2 and Scalapack is used (because + we use LU on the root node, not LDLt, in that case) +* Scaling option effectively used is now returned in INFOG(33) and + ICNTL(8) is no more modified by the package +* INFO(25) is now correctly documented, new statistic INFO(27) added + +Changes from 4.8.4 to 4.9 +* Parallel analysis available +* Use of 64-bit integer addressing for large internal workarrays +* overflow in computation of INFO(9) in out-of-core corrected +* fixed Matlab and Scilab interfaces to sparse RHS functionality +* time cost of analysis reduced for "optimisation" matrices +* time to gather solution on processor 0 reduced and automatic copying + of some routine arguments by some compilers resolved. +* extern "C" added to header file mpi.h of libseq for C++ compilers +* Problem with NZ_loc=0 and scaling with ifort 10 solved +* Statistics about current state of the factorization + produced/printed even in case of error. +* Avoid using complex arrays as real workspace (complex versions) +* New error code -40 (instead of -10) when SYM=1 is used and ScaLAPACK + detects a negative pivot +* Solved problem of "Internal error 1" in [SDCZ]MUMPS_264 and [SDCZ]MUMPS_274 +* Solved undeterministic bug occurring with asynchronous OOC + panels + when uninitialized memory access had value -7777 +* Fixed a remaining problem with OOC filenames having more than 150 characters +* Fixed some problems related to the usage of intrinsic functions inside PARAMETER + statements (HP-UX compilers) +* Fixed problem of explicit interface in [SDCZ]MUMPS_521 +* Out-of-core strategy from 4.7.3 can be reactivated with -DOLD_OOC_NOPANEL +* Message "problem with NIV2_FLOPS message" no more occurs +* Avoid compilation problem with old versions of gfortran + + +Changes from 4.8.3 to 4.8.4 +* Absolute threshold criterion for null pivot detection added to CNTL(3) +* Problems related to messages "Increase small buffer size ..." solved. +* New option for ICNTL(8) to scale matrices. Default scaling cheaper to + compute +* Problem of filename clash with unsymmetric matrices on Windows + platforms solved +* Allow for longer filenames for temporary OOC files +* Strategy to update blocksize during factorization of frontal + matrices modified to avoid too large messages during pipelined + factorization (that could lead to a -17 error code) +* Messages corresponding to delayed pivots can now be sent + in several packets. This avoids some other cases of error -17 +* One rare case of deadlock solved +* Corrected values and sign of INFO(8) and INFO(20) + +Changes from 4.8.2 to 4.8.3 +* Fix compilation issues on Windows platforms +* Fix ranlib issue with libseq on MacOSX platforms +* Fix a few problems of uninitialized variables + +Changes from 4.8.1 to 4.8.2 +* Problem of wrong argument in the call to [sdcz]mumps_246 solved +* Limit occurrence of error -11 in the in-core case +* Problem with the use of SIZE on an unassociated pointer solved +* Problem with distributed solution combined with non-working host solved +* Fix generation of MM matrices +* Fix of a minor bug in OOC error management +* Fix portability issues on usleep + +Changes from 4.8.0 to 4.8.1 +* New distributed scaling is now on by default for distributed matrices +* Error management corrected in case of 32-bit overflow during factorization +* SEPARATOR is now defined as "\\" in Windows version +* Bug fix in OOC panel version + +Changes from 4.7.3 to 4.8.0 +* Parallel scalings algorithms available +* Possibility to dump a matrix in matrix-market format from both + C and Fortran interfaces +* Correction when dumping a distributed matrix in matrix-market format +* Minor numerical stability problem in some LDL^t parallel + factorizations corrected. +* Memory usage significantly reduced in both parallel and sequential + (limit communication buffers, in-place assembly for assembled matrices, + overlapping during stack). +* Better alignment properties of mumps_struc.h +* Reduced time for static mapping during the analysis phase. +* Correction in dynamic scheduler +* "Internal error 2 in DMUMPS_26" no more occurs, even if SIZE_SCHUR=0 +* Corrections in the management of ICNTL(25), some useful code was + protected with -Dtry_null_space and not compiled. +* Scaling arrays are now declared real even in complex versions +* Out-of-core functionality storing factors on disk +* Possibility to tell MUMPS how much memory the package is allowed + to allocate (ICNTL(23)) +* Estimated and effective number of entries in factors returned to user +* API change: MAXS and MAXIS have disappeared from the interface, + please use ICNTL(14) and ICNTL(23) to control the memory usage +* Error code -11 raised less often, especially in out-of-core executions +* Error code -14 should no more occur +* Memory used at the solve phase is now returned to the user +* Possibility to control the blocking size for multiple right-hand sides + (strong impact on performance, in particular for out-of-core executions) +* Solved problems of 32-bit integer overflows during analysis related + to memory estimations. +* New error code -37 related to integer overflows during + factorization +* Compile one single arithmetic with make s, make d, make c or make z, + examples are now in examples/, test/ has disappeared. +* Arithmetic-independent parts are isolated into a libmumps_common.a, that + must now be linked too (see examples/Makefile). + +Changes from 4.7.2 to 4.7.3 +* detection of null pivots for unsymmetric matrices corrected +* improved pivoting in parallel symmetric solver +* possible problem when Schur on and out-of-core : Schur was splitted +* type of parameters of intrinsic function MAX not compatible in + single precision arithmetic versions. +* minor changes for Windows +* correction with reduced RHS functionality in parallel case + +Changes from 4.7.1 to 4.7.2 +* negative loads suppressed in mumps distribution + +Changes from 4.7 to 4.7.1 +* Release number in Fortran interface corrected +* "Negative load !!" message replaced by a warning + +Changes from 4.6.4 to 4.7 +* New functionality: build reduced RHS / use partial solution +* New functionality: detection of zero pivots +* Memory reduced (especially communication buffers) +* Problem of integer overflow "MEMORY_SENT" corrected +* Error code -20 used when receive buffer too small + (instead of -17 in some cases) +* Erroneous memory access with singular matrices (since 4.6.3) corrected +* Minor bug correction in hybrid scheduler +* Parallel solution step uses less memory +* Performance and memory usage of solution step improved +* String containing the version number now available as a + component of the MUMPS structure +* Case of error "-9964" has disappeared + +Changes from 4.6.3 to 4.6.4 +* Avoid name clashes (F_INT, ...) when C interface is used and + user wants to include, say, smumps_c.h, zmumps_c.h (etc.) at + the same time +* Avoid large array copies (by some compilers) in distributed + matrix entry functionality +* Default ordering less dependent on number of processors +* New garbage collector for contribution blocks +* Original matrix in "arrowhead form" on candidate processors + only (assembled case) +* Corrected bug occurring rarely, on large number of + processors, and that depended on value of uninitialized + data +* Parallel LDL^t factorization numerically improved +* Less memory allocation in mapping phase (in some cases) + +Changes from 4.6.2 to 4.6.3 +* Reduced memory usage for symmetric matrices (compressed CB) +* Reduced memory allocation for parallel executions +* Scheduler parameters for parallel executions modified +* Memory estimates (that were too large) corrected with + 2Dcyclic Schur complement option +* Portability improved (C/Fortran interfacing for strings) +* The situation leading to Warning "RHS associated in MUMPS_301" + no more occurs. +* Parameters INFO/RINFO from the Scilab/Matlab API are now called + INFOG/RINFOG in order to match the MUMPS user's guide. + +Changes from 4.6.1 to 4.6.2 +* Metis ordering now available with Schur option +* Schur functionality correctly working with Scilab interface +* Occasional SIGBUS problem on single precision versions corrected + +Changes from 4.6 to 4.6.1 +* Problem with hybrid scheduler and elemental matrix entry corrected +* Improved numerical processing of symmetric matrices with quasi-dense rows +* Better use of Blacs/Scalapack on processor grids smaller than MPI_COMM_WORLD +* Block sizes improved for large symmetric matrices + +Changes from 4.5.6 to 4.6 +* Official release with Scilab and Matlab interfaces available +* Correction in 2x2 pivots for symmetric indefinite complex matrices +* New hybrid scheduler active by default + +Changes from 4.5.5 to 4.5.6 +* Preliminary developments for an out-of-core code (not yet available) +* Improvement in parallel symmetric indefinite solver +* Preliminary distribution of a SCILAB and a MATLAB interface + to MUMPS. + +Changes from 4.5.4 to 4.5.5 +* Improved tree management +* Improved weighted matching preprocessing: + duplicates allowed, overflow avoided, dense rows +* Improved strategy for selecting default ordering +* Improved node amalgamation + +Changes from 4.5.3 to 4.5.4 +* Double complex version no more depends on + double precision version. +* Simplification of some complex indirections in + mumps_cv.F that were causing difficultiels to + some compilers. + +Changes from 4.5.2 to 4.5.3 +* Correction of a minor problem leading to + INFO(1)=-135 in some cases. + +Changes from 4.5.1 to 4.5.2 +* correction of two uninitialized variables in + proportional mapping + +Changes from 4.5.0 to 4.5.1 +* better management of contribution messages +* minor modifications in symmetric preprocessing step + +Changes from 4.4.0 to 4.5.0 +* improved numerical features for symmetric indefinite matrices + - two-by-two pivots + - symmetric scaling + - ordering based on compressed graph prserving two by two pivots + - constrained ordering +* 2D cyclic Schur better validated +* problems resulting from automatic array copies done by compiler corrected +* reduced memory requirement for maximum transversal features + +Changes from 4.3.4 to 4.4.0 +* 2D block cyclic Schur complement matrix +* symmetric indefinite matrices better handled +* Right-hand side vectors can be sparse +* Solution can be kept distributed on the processors +* METIS allowed for element-entry +* Parallel performance and memory usage improved: + - load is updated more often for type 2 nodes + - scheduling under memory constraints + - reduced message sizes in symmetric case + - some linear searches avoided when sending contributions +* Avoid array copies in the call to the partial mapping routine +(candidates); such copies appeared with intel compiler version 8.0. +* Workaround MPI_AllReduce problem with booleans if mpich + and MUMPS are compiled with different compilers +* Reduced message sizes for CB blocks in symmetric case +* Various minor improvements + +Changes from 4.3.3 to 4.3.4 +* Copies of some large CB blocks suppressed + in local assemblies from child to parent +* gathering of solution optimized in solve phase + +Changes from 4.3.2 to 4.3.3 +* Control parameters of symbolic factorization modified. +* Global distribution time and arrowheads computation + slightly optimized. +* Multiple Right-Hand-Side implemented. + +Changes from 4.3.1 to 4.3.2 +* Thresholds for symbolic factorization modified. +* Use merge sort for candidates (faster) +* User's communicator copied when entering MUMPS +* Code to free CB areas factorized in various places +* One array suppressed in solve phase + +Changes from 4.3 to 4.3.1 +* Memory leaks in PORD corrected +* Minor compilation problem on T3E solved +* Avoid taking into account absolute criterion + CNTL(3) for partial LDLt factorization when whole + column is known (relative stability is enough). +* Symbol MPI_WTICK removed from mpif.h +* Bug wrt inertia computation INFOG(12) corrected + +Changes from 4.2beta to 4.3 +* C INTERFACE CHANGE: comm_fortran must be defined + from the calling program, since MUMPS uses a Fortran + communicator (see user guide). +* LAPACK library is no more required +* User guide improved +* Default ordering changed +* Return number of negative diagonal elements in LDLt + factorization (except for root node if treated in parallel) +* Rank-revealing options no more available by default +* Improved parallel performance + - new incremental mechanism for load information + - new communicator dedicated to load information + - improved candidate strategy + - improved management of SMP platforms +* Include files can be used in both free and fixed forms +* Bug fixes: + - some uninitialized values + - pbs with size of data on t3e + - minor problems corrected with distributed matrix entry + - count of negative pivots corrected + - AMD for element entries + - symbolic factorization + - memory leak in tree reordering and in solve step +* Solve step uses less memory (and should be more efficient) + +Changes from 4.1.6 to 4.2beta +* More precisions available (single, double, complex, double complex). +* Uniprocessor version available (doesn't require MPI installed) +* Interface changes (Users of MUMPS 4.1.6 will have to slightly + modify their codes): + - MUMPS -> ZMUMPS, CMUMPS, SMUMPS, DMUMPS depending the precision + - the Schur complement matrix should now be allocated by the + user before the call to MUMPS + - NEW: C interface available. + - ICNTL(6)=6 in 4.1.6 (automatic choice) is now ICNTL(6)=7 in 4.2 +* Tighter integration of new ordering packages (for assembled matrices), + see the description of ICNTL(7): + - AMF, + - Metis, + - PORD, +* Memory usage decreased and memory scalability improved. +* Problem when using multiple instances solved. +* Various improvments and bug fixes. + +Changes from 4.1.4 to 4.1.6 +* Modifications/Tuning done by P.Amestoy during his + visit at NERSC. +* Additional memory and communication statistics. +* minor pbs solved. + +Changes from 4.0.4 to 4.1.4 +* Tuning on Cray T3e (and minor debugging) +* Improved strategy for asynchronous + communications + (irecv during factorization) +* Improved Dynamic scheduling + and splitting strategies +* New maximal transversal strategies +* New Option (default) automatic decision + for scaling and maximum transversal + + + +------------------- += Release history = +------------------- + +Release 4.10.0 : May 2011 +Release 4.9.2 : November 2009 +Release 4.9.1 : October 2009 +Release 4.9 : July 2009 +Release 4.8.4 : December 2008 +Release 4.8.3 : September 2008 +Release 4.8.2 : September 2008 +Release 4.8.1 : August 2008 +Release 4.8.0 : July 2008 +Release 4.7.3 : May 2007 +Release 4.7.2 : April 2007 +Release 4.7.1 : April 2007 +Release 4.7 : April 2007 +Release 4.6.4 : January 2007 +Release 4.6.3 : June 2006 +Release 4.6.2 : April 2006 +Release 4.6.1 : February 2006 +Release 4.6 : January 2006 +Release 4.5.6 : December 2005, internal release +Release 4.5.5 : October 2005 +Release 4.5.4 : September 2005 +Release 4.5.3 : September 2005 +Release 4.5.2 : September 2005 +Release 4.5.1 : September 2005 +Release 4.5.0 : July 2005 +Releases 4.3.3 -- 4.4.3 : internal releases +Release 4.3.2 : November 2003 +Release 4.3.1 : October 2003 +Release 4.3 : July 2003 +Release 4.2 (beta) : December 2002 +Release 4.1.6 : March 2000 +Release 4.0.4 : Wed Sept 22, 1999 <-- Final version from PARASOL + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/LICENSE b/Ipopt-3.13.4/ThirdParty/MUMPS/LICENSE new file mode 100644 index 000000000..55128493f --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/LICENSE @@ -0,0 +1,44 @@ + + This version of MUMPS is provided to you free of charge. It is public + domain, based on public domain software developed during the Esprit IV + European project PARASOL (1996-1999). Since this first public domain + version in 1999, research and developments have been supported by the + following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + INRIA, and University of Bordeaux. + + The MUMPS team at the moment of releasing this version includes + Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + Ucar and Clement Weisbecker. + + We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + have been contributing to this project. + + Up-to-date copies of the MUMPS package can be obtained + from the Web pages: + http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + + + THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + + + User documentation of any code that uses this software can + include this complete notice. You can acknowledge (using + references [1] and [2]) the contribution of this package + in any scientific publication dependent upon the use of the + package. You shall use reasonable endeavours to notify + the authors of the package of this publication. + + [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + A fully asynchronous multifrontal solver using distributed dynamic + scheduling, SIAM Journal of Matrix Analysis and Applications, + Vol 23, No 1, pp 15-41 (2001). + + [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + S. Pralet, Hybrid scheduling for the parallel solution of linear + systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/Makefile b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/Makefile new file mode 100644 index 000000000..41f1eb19b --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/Makefile @@ -0,0 +1,33 @@ +# Please only change make.inc, not this Makefile +include make.inc + +# MUMPS include files +INCMUMPS = -I$(MUMPS_DIR)/include + +# MUMPS libraries +LIBMUMPS = -L$(MUMPS_DIR)/lib -l$(ARITH)mumps -lmumps_common + +# Stub MPI/BLACS/ScaLAPACK +INCSEQ = -I$(MUMPS_DIR)/libseq +LIBSEQ = -L$(MUMPS_DIR)/libseq -lmpiseq + +# MUMPS includes +INC = $(INCMUMPS) $(IORDERINGS) $(INCSEQ) +LIB = $(LIBMUMPS) $(LORDERINGS) $(LIBSEQ) $(LIBBLAS) $(LIBFORT) + +all: d z + +d: + $(MAKE) ARITH=d dmumpsmex.stamp +z: + $(MAKE) ARITH=z zmumpsmex.stamp + +clean: + rm -f dmumpsmex.* zmumpsmex* + +$(ARITH)mumpsmex.stamp: mumpsmex.c + cp -f mumpsmex.c $(ARITH)mumpsmex.c + $(MEX) $(OPTC) $(ARITH)mumpsmex.c -DMUMPS_ARITH=MUMPS_ARITH_$(ARITH) $(INC) $(LIB) + rm -f $(ARITH)mumpsmex.c + touch $@ + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/README b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/README new file mode 100644 index 000000000..634b70923 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/README @@ -0,0 +1,119 @@ +README +************************************************************************ +* This MATLAB interface to MUMPS is provided to you free of charge. * +* It is part of the MUMPS package (see ../Conditions_of_use) and is * +* public domain. Up-to-date copies can be obtained from the Web * +* pages http://mumps.enseeiht.fr/ or * +* http://graal.ens-lyon.fr/MUMPS * +* * +* THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY * +* EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. * +* * +* More info is available in the main MUMPS users' guide and in: * +* * +* [2006] Aurelia Fevre, Jean-Yves L'Excellent and Stephane Pralet * +* MATLAB and Scilab interfaces to MUMPS. LIP Report RR2006-06. * +* Also available as an INRIA and an ENSEEIHT-IRIT Technical Report. * +* * +************************************************************************ + + +************************************************************************ + COMPATIBILITY WITH OCTAVE: + Thanks to the Octave MEX compatibility, it is pretty straightforward + to generate an Octave interface for MUMPS. Please refer to the comments + inside the make.inc file for instructions on how to do it. Everything + said below applies for both cases where a MATLAB or an Octave interface + is needed. + Thanks to Carlo De Falco from "Politecnico di Milano" for support + provided on the usage of Octave. +************************************************************************ + + + CONTENT OF DIRECTORY: + + README + Makefile + make.inc + initmumps.m + mumps.m + other *.m files: examples of usage + mumpsmex.c : MATLAB CMEX-file to let you use sequential MUMPS + in double precision from MATLAB. + + + + USAGE: + see example below and MUMPS documentation + + + + INSTALLATION: + You need + 1- + to have compiled/linked a sequential version of MUMPS with both double + precision and double complex arithmetics ("make d" and "make z", + or "make all"). The code must be position-independent (with gfortran, + please add the option -fPIC in both FC, CC, and FL of the main + Makefile.inc). Note that this also applies to other external + libraries, such as METIS, SCOTCH, BLAS, etc. + + + 2- + to edit make.inc. + Modify paths for orderings and BLAS. You should also + give the path to the runtime libraries of your FORTRAN 90 + compiler. Some commented examples are provided. + + You can use something like + nm -o /opt/intel/compiler80/lib/*.a | grep + to find which libraries should be added + + 3- + to run the make command + + 4- We advise you to run the 4 examples + simple_example.m, multiplerhs_example.m, sparserhs_example.m and + schurrhs_example.m + and to check that everything runs smoothly. + +****************************************************************************** + + LIMITATION: + + This interface enables you to call MUMPS from MATLAB only + in sequential for double precision and double complex versions. + For example it does not support: + - other versions (single precision arithmetic, parallel version...) + - elemental format + +****************************************************************************** + + +%Example of using MUMPS in matlab +% initialization of a matlab MUMPS structure +id = initmumps; +% here JOB = -1, the call to MUMPS will initialize C and fortran MUMPS structure +id = dmumps(id); +% load a sparse matrix +load lhr01; +mat = Problem.A; +% JOB = 6 means analysis+facto+solve +id.JOB = 6; +id.ICNTL(6) = 0; +% we set the rigth hand side +id.RHS = ones(size(mat,1),1); +%call to mumps +id = dmumps(id,mat); +% we see that there is a memory problem in INFO(1) and INFO(2) +id.INFOG(1) +id.INFOG(2) +% we activate the numerical maximum transversal +id.ICNTL(6) = 6; +id = dmumps(id,mat); +norm(mat*id.SOL - ones(size(mat,1),1),'inf') +% solution OK +% destroy mumps instance +id.JOB = -2; +id = dmumps(id) + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/dmumps.m b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/dmumps.m new file mode 100644 index 000000000..c5ab68e08 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/dmumps.m @@ -0,0 +1,83 @@ +function [id]=dmumps(id,mat) +% +% [id]=dmumps(id,mat) +% id is a structure (see details in initmumps.m and MUMPS documentation) +% mat is optional if the job is -1 or -2 +% mat is a square sparse matrice +% information are return in id fields +% +% Use help mumps_help for detailed information +% + +errmsg = nargoutchk(1,1,nargout); +if(~isempty(errmsg)) + disp(errmsg); + return; +end + +arithtype = 1; + +if(id.JOB == -2) + if(id.INST==-9999) + disp('Uninitialized instance'); + return; + end + if(id.TYPE ~= arithtype) + disp('You are trying to call z/d version on a d/z instance'); + return; + end + dmumpsmex(id.SYM,id.JOB,id.ICNTL,id.CNTL,id.PERM_IN,id.COLSCA,id.ROWSCA,id.RHS,id.VAR_SCHUR,id.INST,id.REDRHS); + id = []; + return; +end + + +if(id.JOB == -1) + if(id.INST~=-9999) + disp('Allready initialized instance'); + return; + end + [inform,rinform,sol,inst,schur,redrhs,pivnul_list,sym_perm,uns_perm,icntl,cntl] = dmumpsmex(id.SYM,id.JOB,id.ICNTL,id.CNTL,id.PERM_IN,id.COLSCA,id.ROWSCA,id.RHS,id.VAR_SCHUR,id.INST,id.REDRHS); + id.INFOG = inform; + id.RINFOG = rinform; + id.SOL = sol; + id.INST = inst; + id.SCHUR = schur; + id.REDRHS = redrhs; + id.PIVNUL_LIST = pivnul_list; + id.SYM_PERM = sym_perm; + id.UNS_PERM = uns_perm; + id.TYPE = arithtype; + id.ICNTL=icntl; + id.CNTL=cntl; + return; +end + +if(id.INST==-9999) + disp('Uninitialized instance'); + return; +end + +if(id.TYPE ~= arithtype) + disp('You are trying to call z/d version on a d/z instance'); + return; +end + +[inform,rinform,sol,inst,schur,redrhs,pivnul_list,sym_perm,uns_perm,icntl,cntl] = dmumpsmex(id.SYM,id.JOB,id.ICNTL,id.CNTL,id.PERM_IN,id.COLSCA,id.ROWSCA,id.RHS,id.VAR_SCHUR,id.INST,id.REDRHS,mat); +id.INFOG = inform; +id.RINFOG = rinform; +id.SOL = sol; +id.INST = inst; +if(id.JOB == 2 | id.JOB == 4 | id.JOB == 6) + if(id.SYM == 0) + id.SCHUR = schur'; + else + id.SCHUR = triu(schur)+tril(schur',-1); + end +end +id.REDRHS = redrhs; +id.PIVNUL_LIST = pivnul_list; +id.SYM_PERM(sym_perm) = [1:size(mat,1)]; +id.UNS_PERM = uns_perm; +id.ICNTL=icntl; +id.CNTL=cntl; diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/initmumps.m b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/initmumps.m new file mode 100644 index 000000000..356bee20f --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/initmumps.m @@ -0,0 +1,13 @@ +function id = initmumps() +% +% id = initmumps +% it returns a default matlab MUMPS structure +% +% Use help mumps_help for detailed information +% +errmsg = nargoutchk(1,1,nargout); +if(~isempty(errmsg)) + disp(errmsg); + return; +end +id = struct('SYM',0,'JOB',-1,'ICNTL',zeros(1,40)-9998,'CNTL',zeros(1,15)-9998,'PERM_IN',-9999,'COLSCA',-9999,'ROWSCA',-9999,'RHS',-9999,'INFOG',zeros(1,40)-9998,'RINFOG',zeros(1,40)-9998,'VAR_SCHUR',-9999,'SCHUR',-9999,'INST',-9999,'SOL',-9999,'REDRHS',-9999,'PIVNUL_LIST',-9999,'MAPPING',-9999,'SYM_PERM',-9999,'UNS_PERM',-9999,'TYPE',0); diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/lhr01.mat b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/lhr01.mat new file mode 100644 index 000000000..ffffdd821 Binary files /dev/null and b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/lhr01.mat differ diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/make.inc b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/make.inc new file mode 100644 index 000000000..1b2c0af0e --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/make.inc @@ -0,0 +1,49 @@ +# It is possible to generate a MATLAB or an Octave interface thanks to +# the Octave MEX file compatibility. Comment/uncomment the lines below +# depending on whether you want to generate the MATLAB or the Octave +# interface + +# To generate the MATLAB interface uncomment the following line +# ( the use of -largeArrayDims is necessary to work with sparse +# matrices since R2006b) +MEX = /opt/matlab/bin/mex -g -largeArrayDims + +# To generate the Octave interface uncomment the following line +# MEX = mkoctfile -g --mex + +# Main MUMPS_DIR +MUMPS_DIR = $(HOME)/MUMPS_4.10.0 + +# Orderings (see main Makefile.inc file from MUMPS) +LMETISDIR = $(HOME)/metis-4.0 +LMETIS = -L$(LMETISDIR) -lmetis +LPORDDIR = $(MUMPS_DIR)/PORD/lib +LPORD = -L$(LPORDDIR) -lpord +LORDERINGS = $(LPORD) $(LMETIS) + +# Fortran runtime library +# Please find out the path and name of your +# Fortran runtime, examples below: +# g95: +# LIBFORT = /usr/lib/libf95.a /usr/lib/libgcc.a +# Intel: +# LIBFORT = /opt/intel80/lib/libifcore.a /opt/intel80/lib/libifport.a /opt/intel80/lib/libirc.a +# PGI: +# LIBFORT = -L/usr/local/pgi/linux86/5.2/lib -llapack -lblas -lpgf90 -lpgc -lpgf90rtl -lpgftnrtl -lpgf902 -lpgf90_rpm1 -lpghpf2 +# SGI 32-bit +# LIBFORT = -L/usr/lib32 -lblas -L/usr/lib32/mips4 -lfortran +# Sun +# LIBFORT = -L/opt2/SUNWspro7/lib -lsunperf -lfminvai -lfai2 -lfsu -lfmaxvai -lfmaxlai -lfai -lfsumai -lLIBFORT = /usr/local/lib/libgfortran.a + +# We use gfortran + LIBFORT = /usr/lib/gcc/x86_64-linux-gnu/4.3/libgfortran.so + +# BLAS library: +# LIBBLAS = -L/usr/lib/atlas -lblas +# LIBBLAS = -lsunperf -lf77compat +# LIBBLAS = -lblas + LIBBLAS = /home/jylexcel/libs_courge/libgoto_opteronp-r1.26.a + +# extra options passed via mex command +OPTC = -O + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/multiplerhs_example.m b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/multiplerhs_example.m new file mode 100644 index 000000000..d7dd9a5e8 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/multiplerhs_example.m @@ -0,0 +1,23 @@ +%Example of using MUMPS in matlab with multiple right hand side + +% initialization of a matlab MUMPS structure +id = initmumps; +id = dmumps(id); +load lhr01; +mat = Problem.A; +% JOB = 6 means analysis+facto+solve +id.JOB = 6; +% we set the rigth hand side +id.RHS = ones(size(mat,1),2); +id.RHS(:,2) = 2*id.RHS(:,2); +%call to mumps +id = dmumps(id,mat); +if(norm(mat*id.SOL - id.RHS,'inf') > sqrt(eps)) + disp('WARNING : precision may not be OK'); +else + disp('SOLUTION OK'); +end +norm(mat*id.SOL - id.RHS,'inf') +% destroy mumps instance +id.JOB = -2; +id = dmumps(id) diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/mumps_help.m b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/mumps_help.m new file mode 100644 index 000000000..5efe21992 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/mumps_help.m @@ -0,0 +1,44 @@ +%**************************************** +%This help menu gives details about the use of dmumps, zmumps and initmumps +%**************************************** +% +%--------------- Input Parameters --------------- +% +% - mat: sparse matrix which has to be provided as the second argument of dmumps if id.JOB is strictly larger than 0. +% +% - id.SYM: controls the matrix type (symmetric positive definite, symmetric indefinite or unsymmetric) and it has do be initialized by the user before the initialization phase of MUMPS (see id.JOB). Its value is set to 0 after the call of initmumps. +% +% - id.JOB: defines the action that will be realized by MUMPS: initialize, analyze and/or factorize and/or solve and release MUMPS internal C/Fortran data. It has to be set by the user before any call to MUMPS (except after a call to initmumps, which sets its value to -1). +% +% - id.ICNTL and id.CNTL: define control parameters that can be set after the initialization call (id.JOB = -1). See Section ``Control parameters'' of the MUMPS user's guide for more details. If the user does not modify an entry in id.ICNTL then MUMPS uses the default parameter. For example, if the user wants to use the AMD ordering, he/she should set id.ICNTL(7) = 0. Note that the following parameters are inhibited because they are automatically set within the interface: id.ICNTL(19) which controls the Schur complement option and id.ICNTL(20) which controls the format of the right-hand side. Note that parameters id.ICNTL(1:4) may not work properly depending on your compiler and your environment. In case of problem, we recommand to swith printing off by setting id.ICNL(1:4)=-1. +% +% - id.PERM\_IN: corresponds to the given ordering option (see Section ``Input and output parameters'' of the MUMPS user's guide for more details). Note that this permutation is only accessed if the parameter id.ICNTL(7) is set to 1. +% +% - id.COLSCA and id.ROWSCA: are optional scaling arrays (see Section ``Input and output parameters'' of the MUMPS user's guide for more details) +% +% - id.RHS: defines the right-hand side. The parameter id.ICNTL(20) related to its format (sparse or dense) is automatically set within the interface. Note that id.RHS is not modified (as in MUMPS), the solution is returned in id.SOL. +% +% - id.VAR\_SCHUR: corresponds to the list of variables that appear in the Schur complement matrix (see Section ``Input and output parameters'' of the MUMPS user's guide for more details). +% +% - id.REDRHS(input parameter only if id.VAR\_SCHUR was provided during the factorization and if ICNTL(26)=2 on entry to the solve phase): partial solution on the variables corresponding to the Schur complement. It is provided by the user and normally results from both the Schur complement and the reduced right-hand side that were returned by MUMPS in a previous call. When ICNTL(26)=2, MUMPS uses this information to build the solution id.SOL on the complete problem. See Section ``Schur complement'' of the MUMPS user's guide for more details. +% +%--------------- Output Parameters --------------- +% +% - id.SCHUR: if id.VAR\_SCHUR is provided of size SIZE\_SCHUR, then id.SCHUR corresponds to a dense array of size (SIZE\_SCHUR,SIZE\_SCHUR) that holds the Schur complement matrix (see Section ``Input and output parameters'' of the MUMPS user's guide for more details). The user does not have to initialize it. +% +% - id.REDRHS(output parameter only if ICNTL(26)=1 and id.VAR\_SCHUR was defined): Reduced right-hand side (or condensed right-hand side on the variables associated to the Schur complement). It is computed by MUMPS during the solve stage if ICNTL(26)=1. It can then be used outside MUMPS, together with the Schur complement, to build a solution on the interface. See Section ``Schur complement'' of the MUMPS user's guide for more details. +% +% - id.INFOG and id.RINFOG: information parameters (see Section ``Information parameters'' of the MUMPS user's guide ). +% +% - id.SYM\_PERM: corresponds to a symmetric permutation of the variables (see discussion regarding ICNTL(7) in Section ``Control parameters'' of the MUMPS user's guide ). This permutation is computed during the analysis and is followed by the numerical factorization except when numerical pivoting occurs. +% +% - id.UNS\_PERM: column permutation (if any) on exit from the analysis phase of MUMPS (see discussion regarding ICNTL(6) in Section ``Control parameters'' of the MUMPS user's guide ). +% +% - id.SOL: dense vector or matrix containing the solution after MUMPS solution phase. +% +%--------------- Internal Parameters --------------- +% +% - id.INST: (MUMPS reserved component) MUMPS internal parameter. +% +% - id.TYPE: (MUMPS reserved component) defines the arithmetic (complex or double precision). +% diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/mumpsmex.c b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/mumpsmex.c new file mode 100644 index 000000000..5f675b3e1 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/mumpsmex.c @@ -0,0 +1,614 @@ +#include "mex.h" + +#define MUMPS_ARITH_d 2 +#define MUMPS_ARITH_z 8 + + +#if MUMPS_ARITH == MUMPS_ARITH_z + +# include "zmumps_c.h" +# define dmumps_c zmumps_c +# define dmumps_par zmumps_par +# define DMUMPS_STRUC_C ZMUMPS_STRUC_C +# define DMUMPS_alloc ZMUMPS_alloc +# define DMUMPS_free ZMUMPS_free +# define double2 mumps_double_complex +# define mxREAL2 mxCOMPLEX + +#elif MUMPS_ARITH == MUMPS_ARITH_d + +# include "dmumps_c.h" +# define double2 double +# define mxREAL2 mxREAL +# define EXTRACT_CMPLX_FROM_C_TO_MATLAB EXTRACT_FROM_C_TO_MATLAB +# define EXTRACT_CMPLX_FROM_MATLAB_TOPTR EXTRACT_FROM_MATLAB_TOPTR + +#else + +# error "Only d and z arithmetics are supported" + +#endif + +#define SYM (prhs[0]) +#define JOB (prhs[1]) +#define ICNTL (prhs[2]) +#define CNTL (prhs[3]) +#define PERM_IN (prhs[4]) +#define COLSCA (prhs[5]) +#define ROWSCA (prhs[6]) +#define RHS (prhs[7]) +#define VAR_SCHUR (prhs[8]) +#define INST (prhs[9]) +#define REDRHS_IN (prhs[10]) +#define A_IN (prhs[11]) + +#define INFO_OUT (plhs[0]) +#define RINFO_OUT (plhs[1]) +#define RHS_OUT (plhs[2]) +#define INST_OUT (plhs[3]) +#define SCHUR_OUT (plhs[4]) +#define REDRHS_OUT (plhs[5]) +#define PIVNUL_LIST (plhs[6]) +#define PERM_OUT (plhs[7]) +#define UNS_PERM (plhs[8]) +#define ICNTL_OUT (plhs[9]) +#define CNTL_OUT (plhs[10]) + + +#define MYMALLOC(ptr,l,type) \ + if(!(ptr = (type *) malloc(l*sizeof(type)))){ \ + mexErrMsgTxt ("Malloc failed in mumpsmex.c"); \ + } + + + +#define MYFREE(ptr) \ + if(ptr){ \ + free(ptr); \ + ptr = 0; \ + } + + + +#define EXTRACT_FROM_MATLAB_TOPTR(mxcomponent,mumpspointer,type,length) \ + ptr_matlab = mxGetPr(mxcomponent); \ + MYFREE(mumpspointer); \ + if(ptr_matlab[0] != -9999){ \ + MYMALLOC(mumpspointer,length,type); \ + for(i=0;iirn ); + MYFREE( (*dmumps_par)->jcn ); + MYFREE( (*dmumps_par)->a ); + MYFREE( (*dmumps_par)->irn_loc ); + MYFREE( (*dmumps_par)->jcn_loc ); + MYFREE( (*dmumps_par)->a_loc ); + MYFREE( (*dmumps_par)->eltptr ); + MYFREE( (*dmumps_par)->eltvar ); + MYFREE( (*dmumps_par)->a_elt ); + MYFREE( (*dmumps_par)->perm_in ); + MYFREE( (*dmumps_par)->colsca ); + MYFREE( (*dmumps_par)->rowsca ); + MYFREE( (*dmumps_par)->pivnul_list ); + MYFREE( (*dmumps_par)->listvar_schur ); + MYFREE( (*dmumps_par)->sym_perm ); + MYFREE( (*dmumps_par)->uns_perm ); + MYFREE( (*dmumps_par)->irhs_ptr); + MYFREE( (*dmumps_par)->irhs_sparse); + MYFREE( (*dmumps_par)->rhs_sparse); + MYFREE( (*dmumps_par)->rhs); + MYFREE( (*dmumps_par)->redrhs); + MYFREE(*dmumps_par); + } +} + +void DMUMPS_alloc(DMUMPS_STRUC_C **dmumps_par){ + + MYMALLOC((*dmumps_par),1,DMUMPS_STRUC_C); + (*dmumps_par)->irn = NULL; + (*dmumps_par)->jcn = NULL; + (*dmumps_par)->a = NULL; + (*dmumps_par)->irn_loc = NULL; + (*dmumps_par)->jcn_loc = NULL; + (*dmumps_par)->a_loc = NULL; + (*dmumps_par)->eltptr = NULL; + (*dmumps_par)->eltvar = NULL; + (*dmumps_par)->a_elt = NULL; + (*dmumps_par)->perm_in = NULL; + (*dmumps_par)->colsca = NULL; + (*dmumps_par)->rowsca = NULL; + (*dmumps_par)->rhs = NULL; + (*dmumps_par)->redrhs = NULL; + (*dmumps_par)->rhs_sparse = NULL; + (*dmumps_par)->irhs_sparse = NULL; + (*dmumps_par)->irhs_ptr = NULL; + (*dmumps_par)->pivnul_list = NULL; + (*dmumps_par)->listvar_schur = NULL; + (*dmumps_par)->schur = NULL; + (*dmumps_par)->sym_perm = NULL; + (*dmumps_par)->uns_perm = NULL; +} + + + +void mexFunction(int nlhs, mxArray *plhs[ ], + int nrhs, const mxArray *prhs[ ]) { + + int i,j,pos; + int *ptr_int; + double *ptr_double; + double *ptr_matlab; +#if MUMPS_ARITH == MUMPS_ARITH_z + double *ptri_matlab; +#endif + mwSize tmp_m,tmp_n; + + /* C pointer for input parameters */ + size_t inst_address; + mwSize n,m,ne, netrue ; + int inst,job; + mwIndex *irn_in,*jcn_in; + + /* variable for multiple and sparse rhs */ + int posrhs; + mwSize nbrhs,ldrhs, nz_rhs; + mwIndex *irhs_ptr, *irhs_sparse; + double *rhs_sparse; +#if MUMPS_ARITH == MUMPS_ARITH_z + double *im_rhs_sparse; +#endif + + DMUMPS_STRUC_C *dmumps_par; + int dosolve = 0; + int donullspace = 0; + int doanal = 0; + + + EXTRACT_FROM_MATLAB_TOVAL(JOB,job); + + + dosolve = (job == 3 || job == 5 || job == 6); + doanal = (job == 1 || job == 4 || job == 6); + + if(job == -1){ + DMUMPS_alloc(&dmumps_par); + EXTRACT_FROM_MATLAB_TOVAL(SYM,dmumps_par->sym); + dmumps_par->job = -1; + dmumps_par->par = 1; + dmumps_c(dmumps_par); + dmumps_par->nz = -1; + dmumps_par->nz_alloc = -1; + }else{ + EXTRACT_FROM_MATLAB_TOVAL(INST,inst_address); + ptr_int = (int *) inst_address; + + dmumps_par = (DMUMPS_STRUC_C *) ptr_int; + + if(job == -2){ + dmumps_par->job = -2; + dmumps_c(dmumps_par); + DMUMPS_free(&dmumps_par); + }else{ + + /* check of input arguments */ + n = mxGetN(A_IN); + m = mxGetM(A_IN); + + if (!mxIsSparse(A_IN) || n != m ) + mexErrMsgTxt("Input matrix must be a sparse square matrix"); + + jcn_in = mxGetJc(A_IN); + ne = jcn_in[n]; + irn_in = mxGetIr(A_IN); + dmumps_par->n = (int)n; + if(dmumps_par->n != n) + mexErrMsgTxt("Input is too big; will not work...barfing out\n"); + + if(dmumps_par->sym != 0) + netrue = (n+ne)/2; + else + netrue = ne; + + if(dmumps_par->nz_alloc < netrue || dmumps_par->nz_alloc >= 2*netrue){ + MYFREE(dmumps_par->jcn); + MYFREE(dmumps_par->irn); + MYFREE(dmumps_par->a); + MYMALLOC((dmumps_par->jcn),(int)netrue,int); + MYMALLOC((dmumps_par->irn),(int)netrue,int); + MYMALLOC((dmumps_par->a),(int)netrue,double2); + dmumps_par->nz_alloc = (int)netrue; + if (dmumps_par->nz_alloc != netrue) + mexErrMsgTxt("Input is too big; will not work...barfing out\n"); + } + + + if(dmumps_par->sym == 0){ + /* if analysis already performed then we only need to read + numerical values + Note that we suppose that matlab did not change the internal + format of the matrix between the 2 calls */ + if(doanal){ + /* || dmumps_par->info[22] == 0 */ + for(i=0;in;i++){ + for(j=jcn_in[i];jjcn)[j] = i+1; + (dmumps_par->irn)[j] = ((int)irn_in[j])+1; + } + } + } + dmumps_par->nz = (int)ne; + if( dmumps_par->nz != ne) + mexErrMsgTxt("Input is too big; will not work...barfing out\n"); +#if MUMPS_ARITH == MUMPS_ARITH_z + ptr_matlab = mxGetPr(A_IN); + for(i=0;inz;i++){ + ((dmumps_par->a)[i]).r = ptr_matlab[i]; + } + ptr_matlab = mxGetPi(A_IN); + if(ptr_matlab){ + for(i=0;inz;i++){ + ((dmumps_par->a)[i]).i = ptr_matlab[i]; + } + }else{ + for(i=0;inz;i++){ + ((dmumps_par->a)[i]).i = 0.0; + } + } +#else + ptr_matlab = mxGetPr(A_IN); + for(i=0;inz;i++){ + (dmumps_par->a)[i] = ptr_matlab[i]; + } +#endif + + }else{ + /* in the symmetric case we do not need to check doanal */ + pos = 0; + ptr_matlab = mxGetPr(A_IN); +#if MUMPS_ARITH == MUMPS_ARITH_z + ptri_matlab = mxGetPi(A_IN); +#endif + for(i=0;in;i++){ + for(j=jcn_in[i];j= i){ + if(pos >= netrue) + mexErrMsgTxt("Input matrix must be symmetric"); + (dmumps_par->jcn)[pos] = i+1; + (dmumps_par->irn)[pos] = (int)irn_in[j]+1; +#if MUMPS_ARITH == MUMPS_ARITH_z + ((dmumps_par->a)[pos]).r = ptr_matlab[j]; + if(ptri_matlab){ + ((dmumps_par->a)[pos]).i = ptri_matlab[j]; + }else{ + ((dmumps_par->a)[pos]).i = 0.0; + } +#else + (dmumps_par->a)[pos] = ptr_matlab[j]; +#endif + pos++; + } + } + } + dmumps_par->nz = pos; + } + + + EXTRACT_FROM_MATLAB_TOVAL(JOB,dmumps_par->job); + EXTRACT_FROM_MATLAB_TOARR(ICNTL,dmumps_par->icntl,int,40); + EXTRACT_FROM_MATLAB_TOARR(CNTL,dmumps_par->cntl,double,15); + EXTRACT_FROM_MATLAB_TOPTR(PERM_IN,(dmumps_par->perm_in),int,((int)n)); + + EXTRACT_FROM_MATLAB_TOPTR(COLSCA,(dmumps_par->colsca),double,((int)n)); + EXTRACT_FROM_MATLAB_TOPTR(ROWSCA,(dmumps_par->rowsca),double,((int)n)); + + dmumps_par->size_schur = (int)mxGetN(VAR_SCHUR); + EXTRACT_FROM_MATLAB_TOPTR(VAR_SCHUR,(dmumps_par->listvar_schur),int,dmumps_par->size_schur); + if(!dmumps_par->listvar_schur) dmumps_par->size_schur = 0; + + ptr_matlab = mxGetPr (RHS); + +/* + * To follow the "spirit" of the matlab/scilab interfaces, treat case of null + * space separately. In that case, we initialize lrhs and nrhs automatically + * allocate the space needed, and do not rely on what is provided by the user + * in component RHS, that is not touched. + * + * Note that at the moment the user should not call the solution step combined + * with the factorization step when he/she sets icntl[25-1] to a non-zero value. + * Hence we suppose infog[28-1] is available and we can use it. + * + * For users of scilab/matlab, it would still be nice to be able to set ICNTL(25)=-1, + * and use JOB=6. If we want to make this functionality available, we should + * call separately job=2 and job=3 even if job=5 or 6 and set nbrhs (and allocate + * space correctly) between job=2 and job=3 calls to MUMPS. + * + */ + if ( dmumps_par->icntl[25-1] == -1 && dmumps_par->infog[28-1] > 0 ) { + dmumps_par->nrhs=dmumps_par->infog[28-1]; + donullspace = dosolve; + } + else if ( dmumps_par->icntl[25-1] > 0 && dmumps_par->icntl[25-1] <= dmumps_par->infog[28-1] ) { + dmumps_par->nrhs=1; + donullspace = dosolve; + } + else { + donullspace=0; + } + if (donullspace) { + nbrhs=dmumps_par->nrhs; ldrhs=n; + dmumps_par->lrhs=(int)n; + MYMALLOC((dmumps_par->rhs),((dmumps_par->n)*(dmumps_par->nrhs)),double2); + } + else if((!dosolve) || ptr_matlab[0] == -9999 ) { /* rhs not already provided, or not used */ +/*JY: Case where dosolve is true and ptr_matlab[0]=-9999, this could cause problems: + * 1/ RHS was not initialized while it should have been + * 2/ RHS was explicitely initialized to -9999 but is not allocated of the right size + */ + EXTRACT_CMPLX_FROM_MATLAB_TOPTR(RHS,(dmumps_par->rhs),double,1); + }else{ + nbrhs = mxGetN(RHS); + ldrhs = mxGetM(RHS); + dmumps_par->nrhs = (int)nbrhs; + dmumps_par->lrhs = (int)ldrhs; + if(ldrhs != n){ + mexErrMsgTxt ("Incompatible number of rows in RHS"); + } + if (!mxIsSparse(RHS)){ /* full rhs */ + dmumps_par->icntl[19] = 0; + EXTRACT_CMPLX_FROM_MATLAB_TOPTR(RHS,(dmumps_par->rhs),double,(int)( dmumps_par->nrhs*ldrhs)); + }else{ /* sparse rhs */ + /* printf("sparse RHS ldrhs = %d nrhs = %d\n",ldrhs,nbrhs); */ + dmumps_par->icntl[19] = 1; + irhs_ptr = mxGetJc(RHS); + irhs_sparse = mxGetIr(RHS); + rhs_sparse = mxGetPr(RHS); +#if MUMPS_ARITH == MUMPS_ARITH_z + im_rhs_sparse = mxGetPi(RHS); +#endif + + nz_rhs = irhs_ptr[nbrhs]; + dmumps_par->nz_rhs = (int)nz_rhs; + + MYMALLOC((dmumps_par->irhs_ptr),(dmumps_par->nrhs+1),int); + MYMALLOC((dmumps_par->irhs_sparse), dmumps_par->nz_rhs,int); + MYMALLOC((dmumps_par->rhs_sparse), dmumps_par->nz_rhs,double2); + /* dmumps_par->rhs will store the solution*/ + MYMALLOC((dmumps_par->rhs),((dmumps_par->nrhs*dmumps_par->lrhs)),double2); + + for(i=0;i< dmumps_par->nrhs;i++){ + for(j=irhs_ptr[i];jirhs_sparse)[j] = irhs_sparse[j]+1; + } + (dmumps_par->irhs_ptr)[i] = irhs_ptr[i]+1; + } + (dmumps_par->irhs_ptr)[dmumps_par->nrhs] = dmumps_par->nz_rhs+1; +#if MUMPS_ARITH == MUMPS_ARITH_z + if(im_rhs_sparse){ + for(i=0;inz_rhs;i++){ + ((dmumps_par->rhs_sparse)[i]).r = rhs_sparse[i]; + ((dmumps_par->rhs_sparse)[i]).i = im_rhs_sparse[i]; + } + }else{ + for(i=0;inz_rhs;i++){ + ((dmumps_par->rhs_sparse)[i]).r = rhs_sparse[i]; + ((dmumps_par->rhs_sparse)[i]).i = 0.0; + } + } +#else + for(i=0;inz_rhs;i++){ + (dmumps_par->rhs_sparse)[i] = rhs_sparse[i]; + } +#endif + } + } + + if(dmumps_par->size_schur > 0){ + MYMALLOC((dmumps_par->schur),((dmumps_par->size_schur)*(dmumps_par->size_schur)),double2); + dmumps_par->icntl[18] = 1; + }else{ + dmumps_par->icntl[18] = 0; + } + /* Reduced RHS */ + if ( dmumps_par->size_schur > 0 && dosolve ) { + if ( dmumps_par->icntl[26-1] == 2 ) { + /* REDRHS is on input */ + tmp_m= mxGetM(REDRHS_IN); + tmp_n= mxGetN(REDRHS_IN); + if (tmp_m != dmumps_par->size_schur || tmp_n != dmumps_par->nrhs) { + mexErrMsgTxt ("bad dimensions for REDRHS in mumpsmex.c"); + } + EXTRACT_CMPLX_FROM_MATLAB_TOPTR(REDRHS_IN,(dmumps_par->redrhs),double,((int)tmp_m*tmp_n)); + dmumps_par->lredrhs=dmumps_par->size_schur; + } + if ( dmumps_par->icntl[26-1] == 1 ) { + /* REDRHS on output. Must be allocated before the call */ + MYFREE(dmumps_par->redrhs); + if(!(dmumps_par->redrhs=(double2 *)malloc((dmumps_par->size_schur*dmumps_par->nrhs)*sizeof(double2)))){ + mexErrMsgTxt("malloc redrhs failed in intmumpsc.c"); + } + } + } + dmumps_c(dmumps_par); + } + } + if(nlhs > 0){ + EXTRACT_FROM_C_TO_MATLAB( INFO_OUT ,(dmumps_par->infog),40); + EXTRACT_FROM_C_TO_MATLAB( RINFO_OUT ,(dmumps_par->rinfog),40); + if(dmumps_par->rhs && dosolve){ + /* nbrhs may not have been set (case of null space) */ + nbrhs=dmumps_par->nrhs; + RHS_OUT = mxCreateDoubleMatrix (dmumps_par->n,dmumps_par->nrhs,mxREAL2); + ptr_matlab = mxGetPr (RHS_OUT); +#if MUMPS_ARITH == MUMPS_ARITH_z + ptri_matlab = mxGetPi (RHS_OUT); + for(j=0;jnrhs;j++){ + posrhs = j*(int)n; + for(i=0;in;i++){ + ptr_matlab[posrhs+i]= (dmumps_par->rhs)[posrhs+i].r; + ptri_matlab[posrhs+i]= (dmumps_par->rhs)[posrhs+i].i; + } + } +#else + for(j=0;jnrhs;j++){ + posrhs = j*dmumps_par->n; + for(i=0;in;i++){ + ptr_matlab[posrhs+i]= (dmumps_par->rhs)[posrhs+i]; + } + } +#endif + }else{ + EXTRACT_CMPLX_FROM_C_TO_MATLAB( RHS_OUT,(dmumps_par->rhs),1); + } + + ptr_int = (int *)dmumps_par; + inst_address = (size_t) ptr_int; + EXTRACT_FROM_C_TO_MATLAB( INST_OUT ,&inst_address,1); + EXTRACT_FROM_C_TO_MATLAB( PIVNUL_LIST ,dmumps_par->pivnul_list,dmumps_par->infog[27]); + EXTRACT_FROM_C_TO_MATLAB( PERM_OUT ,dmumps_par->sym_perm,dmumps_par->n); + EXTRACT_FROM_C_TO_MATLAB( UNS_PERM ,dmumps_par->uns_perm,dmumps_par->n); + EXTRACT_FROM_C_TO_MATLAB( ICNTL_OUT ,dmumps_par->icntl,40); + EXTRACT_FROM_C_TO_MATLAB( CNTL_OUT ,dmumps_par->cntl,15); + + if(dmumps_par->size_schur > 0){ + SCHUR_OUT = mxCreateDoubleMatrix(dmumps_par->size_schur,dmumps_par->size_schur,mxREAL2); + ptr_matlab = mxGetPr (SCHUR_OUT); +#if MUMPS_ARITH == MUMPS_ARITH_z + ptri_matlab = mxGetPi (SCHUR_OUT); + for(i=0;isize_schur;i++){ + pos = i*(dmumps_par->size_schur); + for(j=0;jsize_schur;j++){ + ptr_matlab[j+pos] = ((dmumps_par->schur)[j+pos]).r; + ptri_matlab[j+pos] = ((dmumps_par->schur)[j+pos]).i; + } + } +#else + for(i=0;isize_schur;i++){ + pos = i*(dmumps_par->size_schur); + for(j=0;jsize_schur;j++){ + ptr_matlab[j+pos] = (dmumps_par->schur)[j+pos]; + } + } +#endif + }else{ + SCHUR_OUT = mxCreateDoubleMatrix(1,1,mxREAL2); + ptr_matlab = mxGetPr (SCHUR_OUT); + ptr_matlab[0] = -9999; +#if MUMPS_ARITH == MUMPS_ARITH_z + ptr_matlab = mxGetPi (SCHUR_OUT); + ptr_matlab[0] = -9999; +#endif + } + /* REDRHS on output */ + if ( dmumps_par->icntl[26-1]==1 && dmumps_par->size_schur > 0 && dosolve ) { + REDRHS_OUT = mxCreateDoubleMatrix(dmumps_par->size_schur,dmumps_par->nrhs,mxREAL2); + ptr_matlab = mxGetPr(REDRHS_OUT); +#if MUMPS_ARITH == MUMPS_ARITH_z + ptri_matlab = mxGetPi (REDRHS_OUT); +#endif + for(i=0;inrhs*dmumps_par->size_schur;i++){ +#if MUMPS_ARITH == MUMPS_ARITH_z + ptr_matlab[i] = ((dmumps_par->redrhs)[i]).r; + ptri_matlab[i] = ((dmumps_par->redrhs)[i]).i; +#else + ptr_matlab[i] = ((dmumps_par->redrhs)[i]); +#endif + } + }else{ + REDRHS_OUT = mxCreateDoubleMatrix(1,1,mxREAL2); + ptr_matlab = mxGetPr (REDRHS_OUT); + ptr_matlab[0] = -9999; +#if MUMPS_ARITH == MUMPS_ARITH_z + ptr_matlab = mxGetPi (REDRHS_OUT); + ptr_matlab[0] = -9999; +#endif + } + + + MYFREE(dmumps_par->redrhs); + MYFREE(dmumps_par->schur); + MYFREE(dmumps_par->irhs_ptr); + MYFREE(dmumps_par->irhs_sparse); + MYFREE(dmumps_par->rhs_sparse); + MYFREE(dmumps_par->rhs); + } +} diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/printmumpsstat.m b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/printmumpsstat.m new file mode 100644 index 000000000..f202d8cb8 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/printmumpsstat.m @@ -0,0 +1,22 @@ +function printmumpsstat(id) +% +% printmumpsstat(id) +% print mumps info +% + +disp(['After analysis : Estimated operations ' num2str(id.RINFOG(1))]); +disp(['After analysis : Estimated space for factors ' int2str(id.INFOG(3))]); +disp(['After analysis : Estimated integer space ' int2str(id.INFOG(4))]); +disp(['After analysis : Estimated max front size ' int2str(id.INFOG(5))]); +disp(['After analysis : Number of node in the tree ' int2str(id.INFOG(6))]); +disp(['After analysis : Estimated total size (Mbytes) ' int2str(id.INFOG(17))]); + +disp(['After factorization : Assembly operations ' num2str(id.RINFOG(2))]); +disp(['After factorization : Elimination operations ' num2str(id.RINFOG(3))]); +disp(['After factorization : Real/Complex space to store LU ' int2str(id.INFOG(9))]); +disp(['After factorization : Integer space to store LU ' int2str(id.INFOG(10))]); +disp(['After factorization : Largest front size ' int2str(id.INFOG(11))]); +disp(['After factorization : Number of off-diagonal pivots ' int2str(id.INFOG(12))]); +disp(['After factorization : Number of delayed pivots ' int2str(id.INFOG(13))]); +disp(['After factorization : Number of memory compresses ' int2str(id.INFOG(14))]); +disp(['After factorization : Total size needed (Mbytes) ' int2str(id.INFOG(19))]); diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/schur_example.m b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/schur_example.m new file mode 100644 index 000000000..5d864fe75 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/schur_example.m @@ -0,0 +1,92 @@ +%Example of using MUMPS in matlab with schur option + +% initialization of a matlab MUMPS structure +id = initmumps; +id = dmumps(id); +load lhr01; +mat = Problem.A; +themax = max(max(abs(mat))); +n = size(mat,1); +mat = mat+sparse(1:n,1:n,3*themax*ones(n,1)); + +% initialization of Schur option +id.VAR_SCHUR = [n-9:n]; + +% JOB = 6 means analysis+facto+solve +id.JOB = 6; +id.RHS = ones(size(mat,1),1); +%call to mumps +id = dmumps(id,mat); +disp('*** check solution restricted to mat(1:n-10,1:n-10)'); +if(norm(mat(1:n-10,1:n-10)*id.SOL(1:n-10) - ones(n-10,1),'inf') > sqrt(eps)) + disp('WARNING : precision may not be OK'); +else + disp('SCHUR SOLUTION CHECK1 OK'); +end +norm(mat(1:n-10,1:n-10)*id.SOL(1:n-10) - ones(n-10,1),'inf') + + +% we want to use Schur complement to solve +% A * sol = rhs +% with sol = x and rhs = rhs1 +% y rhs2 +% +% check that the complete solution verify +% y = S^(-1) * (rhs2 - A_{2,1} * A_{1,1}^(-1) * rhs1) +% and +% x = A_{1,1}^(-1) * rhs1) - A_{1,2} * y +% +sol1 = id.SOL(1:n-10); +rhsy = ones(10,1)-mat(n-9:n,1:n-10)*sol1; + +%%%%%%%%%%%%%%%%%%% +% TO CHANGE : +% usually the resolution below is replaced by an iterative scheme +y = id.SCHUR \ rhsy; +%%%%%%%%%%%%%%%%%%%% + +rhsx = mat(1:n-10,n-9:n)*y; +id.JOB = 3; +id.RHS(1:n-10) = rhsx; +id = dmumps(id,mat); +rhsx = id.SOL(1:n-10); +x = sol1-rhsx; +sol = [x;y]; +r = mat*sol - ones(n,1); +disp('*** check complete solution'); +if( norm(r,'inf') > sqrt(eps)) + disp('WARNING : precision may not be OK'); +else + disp('SCHUR SOLUTION CHECK2 OK'); +end +norm(r,'inf') + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% NOW TRY REDUCED RHS FUNCTIONALITY +% (easier to use than previous +% computations) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +id.JOB=3; +% Do forward solution step to obtain a reduced RHS +id.ICNTL(26)=1; +RHS=mat*ones(n,1); +id.RHS=RHS; +id = dmumps(id,mat); +% Solve the problem on the interface +id.REDRHS = id.SCHUR \ id.REDRHS; + +% Do backward solution stage to expand the solution +id.ICNTL(26)=2; +id = dmumps(id,mat); +r = mat*id.SOL-RHS; +disp('*** check solution when REDRHS is used'); +if( norm(r,'inf') > sqrt(eps)) + disp('WARNING : precision may not be OK'); +else + disp('SCHUR SOLUTION CHECK3 OK'); +end +norm(r,'inf') + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/simple_example.m b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/simple_example.m new file mode 100644 index 000000000..fd8188e6c --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/simple_example.m @@ -0,0 +1,43 @@ +% Simple example of using MUMPS in matlab + +% initialization of a matlab MUMPS structure +id = initmumps; +id.SYM = 0; + +% here JOB = -1, the call to MUMPS will initialize C +% and fortran MUMPS structure +id = dmumps(id); +% load a sparse matrix +load lhr01; +mat = Problem.A; +% JOB = 6 means analysis+facto+solve + +%prob = UFget(373); +%mat = prob.A; +id.JOB = 6; +%%%%%%% BEGIN OPTIONAL PART TO ILLUSTRATE THE USE OF MAXIMUM TRANSVERSAL +id.ICNTL(7) = 5; +id.ICNTL(6) = 1; +id.ICNTL(8) = 7; +id.ICNTL(14) = 80; +% we set the rigth hand side +id.RHS = ones(size(mat,1),1); +%call to mumps +id = dmumps(id,mat); +% we see that there is a memory problem in INFOG(1) and INFOG(2) +id.INFOG(1) +id.INFOG(2) +% we activate the numerical maximun transversal +fprintf('total number of nonzeros in factors %d\n', id.INFOG(10)); + +%%%%%%% END OPTIONAL PART %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if(norm(mat*id.SOL - ones(size(mat,1),1),'inf') > sqrt(eps)) + disp('WARNING : precision may not be OK'); +else + disp('SOLUTION OK'); +end +norm(mat*id.SOL - ones(size(mat,1),1),'inf') +% destroy mumps instance +SOL = id.SOL; +id.JOB = -2; +id = dmumps(id) diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/sparserhs_example.m b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/sparserhs_example.m new file mode 100644 index 000000000..5d5895f00 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/sparserhs_example.m @@ -0,0 +1,28 @@ +%Example of using MUMPS in matlab with sparse right hansd side + +% initialization of a matlab MUMPS structure +id = initmumps; +id = dmumps(id); +load lhr01; +mat = Problem.A; +% JOB = 6 means analysis+facto+solve +id.JOB = 6; +% we set the rigth hand side +id.RHS = ones(size(mat,1),2); +id.RHS(:,2) = 2*id.RHS(:,2); +id.RHS = sparse(id.RHS); +%call to mumps +id = dmumps(id,mat); +if(norm(mat*id.SOL - id.RHS,'inf') > sqrt(eps)) + disp('WARNING : precision may not be OK'); +else + disp('SOLUTION OK'); +end +norm(mat*id.SOL - id.RHS,'inf') +% solution OK +% destroy mumps instance +id.JOB = -2; +id = dmumps(id) + + + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/zmumps.m b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/zmumps.m new file mode 100644 index 000000000..38146f004 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/zmumps.m @@ -0,0 +1,83 @@ +function [id]=zmumps(id,mat) +% +% [id]=zmumps(id,mat) +% id is a structure (see details in initmumps.m and MUMPS documentation) +% mat is optional if the job is -1 or -2 +% mat is a square sparse matrice +% information are return in id fields +% +% Use help mumps_help for detailed information +% + +errmsg = nargoutchk(1,1,nargout); +if(~isempty(errmsg)) + disp(errmsg); + return; +end + +arithtype = 2; + +if(id.JOB == -2) + if(id.INST==-9999) + disp('Uninitialized instance'); + return; + end + if(id.TYPE ~= arithtype) + disp('You are trying to call z/d version on a d/z instance'); + return; + end + zmumpsmex(id.SYM,id.JOB,id.ICNTL,id.CNTL,id.PERM_IN,id.COLSCA,id.ROWSCA,id.RHS,id.VAR_SCHUR,id.INST,id.REDRHS); + id = []; + return; +end + + +if(id.JOB == -1) + if(id.INST~=-9999) + disp('Allready initialized instance'); + return; + end + [inform,rinform,sol,inst,schur,redrhs,pivnul_list,sym_perm,uns_perm,icntl,cntl] = zmumpsmex(id.SYM,id.JOB,id.ICNTL,id.CNTL,id.PERM_IN,id.COLSCA,id.ROWSCA,id.RHS,id.VAR_SCHUR,id.INST,id.REDRHS); + id.INFOG = inform; + id.RINFOG = rinform; + id.SOL = sol; + id.INST = inst; + id.SCHUR = schur; + id.REDRHS = redrhs; + id.PIVNUL_LIST = pivnul_list; + id.SYM_PERM = sym_perm; + id.UNS_PERM = uns_perm; + id.TYPE = arithtype; + id.ICNTL=icntl; + id.CNTL=cntl; + return; +end + +if(id.INST==-9999) + disp('Uninitialized instance'); + return; +end + +if(id.TYPE ~= arithtype) + disp('You are trying to call z/d version on a d/z instance'); + return; +end + +[inform,rinform,sol,inst,schur,redrhs,pivnul_list,sym_perm,uns_perm,icntl,cntl] = zmumpsmex(id.SYM,id.JOB,id.ICNTL,id.CNTL,id.PERM_IN,id.COLSCA,id.ROWSCA,id.RHS,id.VAR_SCHUR,id.INST,id.REDRHS,mat); +id.INFOG = inform; +id.RINFOG = rinform; +id.SOL = sol; +id.INST = inst; +if(id.JOB == 2 | id.JOB == 4 | id.JOB == 6) + if(id.SYM == 0) + id.SCHUR = schur'; + else + id.SCHUR = triu(schur)+tril(schur',-1); + end +end +id.REDRHS = redrhs; +id.PIVNUL_LIST = pivnul_list; +id.SYM_PERM(sym_perm) = [1:size(mat,1)]; +id.UNS_PERM = uns_perm; +id.ICNTL=icntl; +id.CNTL=cntl; diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/zsimple_example.m b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/zsimple_example.m new file mode 100644 index 000000000..480ae0e7a --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/MATLAB/zsimple_example.m @@ -0,0 +1,69 @@ +% Simple example of using MUMPS in matlab + +% initialization of a matlab MUMPS structure +id = initmumps; +% here JOB = -1, the call to MUMPS will initialize C +% and fortran MUMPS structure +id = zmumps(id); +% load a sparse matrix +load lhr01; +mat = Problem.A; +n = size(mat,1); +mat = mat + sparse(1:n,1:n,i*ones(n,1)); +% JOB = 6 means analysis+facto+solve +id.JOB = 6; +id.ICNTL(6) = 0; +% we set the rigth hand side +id.RHS = ones(size(mat,1),1); +%call to mumps +id = zmumps(id,mat); +% we see that there is a memory problem in INFOG(1) and INFOG(2) +id.INFOG(1) +id.INFOG(2) +% we activate the numerical maximun transversal +id.ICNTL(6) = 6; +id = zmumps(id,mat); +if(norm(mat*id.SOL - ones(size(mat,1),1),'inf') > sqrt(eps)) + disp('WARNING : precision may not be OK'); +else + disp('SOLUTION OK'); +end +norm(mat*id.SOL - ones(size(mat,1),1),'inf') +% destroy mumps instance +id.JOB = -2; +id = zmumps(id) + +disp('Press any key'); +pause; + +% initialization of a matlab MUMPS structure +id = initmumps; +% here JOB = -1, the call to MUMPS will initialize C +% and fortran MUMPS structure +id = zmumps(id); +% load a sparse matrix +load lhr01; +mat = Problem.A; +n = size(mat,1); +% JOB = 6 means analysis+facto+solve +id.JOB = 6; +id.ICNTL(6) = 0; +% we set the rigth hand side +id.RHS = ones(size(mat,1),1); +%call to mumps +id = zmumps(id,mat); +% we see that there is a memory problem in INFOG(1) and INFOG(2) +id.INFOG(1) +id.INFOG(2) +% we activate the numerical maximun transversal +id.ICNTL(6) = 6; +id = zmumps(id,mat); +if(norm(mat*id.SOL - ones(size(mat,1),1),'inf') > sqrt(eps)) + disp('WARNING : precision may not be OK'); +else + disp('SOLUTION OK'); +end +norm(mat*id.SOL - ones(size(mat,1),1),'inf') +% destroy mumps instance +id.JOB = -2; +id = zmumps(id) diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.ALPHA_linux.PAR b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.ALPHA_linux.PAR new file mode 100644 index 000000000..9a2592641 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.ALPHA_linux.PAR @@ -0,0 +1,89 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +################################################################################ + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = cc +FC = fort +FL = fort +AR = ar vr +RANLIB = echo +SCALAP = /home/gil/SCALAPACK/libscalapack.a /home/gil/BLACS/LIB/blacs_MPI-LINUX-0.a /home/gil/BLACS/LIB/blacsCinit_MPI-LINUX-0.a /home/gil/BLACS/LIB/blacs_MPI-LINUX-0.a +INCPAR = -I/home/gil/include +LIBPAR = $(SCALAP) -L/home/gil/lib -lmpich +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBBLAS = /home/gil/lib/blas.a +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd__ +#Begin Optimized options +OPTF = -I. -O -DALPHA_ -nopipeline +OPTL = -O +OPTC = -O -DMAIN_COMP +#End Optimized options +INCS = $(INCPAR) +LIBS = $(LIBPAR) +LIBSEQNEEDED = diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.ALPHA_linux.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.ALPHA_linux.SEQ new file mode 100644 index 000000000..f3feb56a2 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.ALPHA_linux.SEQ @@ -0,0 +1,86 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +################################################################################ + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = cc +FC = fort +FL = fort +AR = ar vr +RANLIB = echo +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBBLAS = /home/gil/lib/blas.a +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd__ +#Begin Optimized options +OPTF = -I. -O -DALPHA_ -nopipeline +OPTL = -O +OPTC = -O -DMAIN_COMP +#End Optimized options +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.ALPHA_true64.PAR b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.ALPHA_true64.PAR new file mode 100644 index 000000000..449a22fe6 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.ALPHA_true64.PAR @@ -0,0 +1,89 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +################################################################################ + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = cc +FC = f90 +FL = f90 +AR = ar vr +RANLIB = echo +SCALAP = -L/usr/local/lib -lscalapack_ALPHA -lpblas_ALPHA -lblacsCinit_MPI-ALPHA-0 -lblacsF77init_MPI-ALPHA-0 -lblacs_MPI-ALPHA-0 -lblacsF77init_MPI-ALPHA-0 -lblacs_MPI-ALPHA-0 +INCPAR = +LIBPAR = $(SCALAP) -lmpi -lelan +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBBLAS = -ldxml +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ +#Begin Optimized options +OPTF = -I. -O -DALPHA_ -nopipeline +OPTL = -O +OPTC = -O -DMAIN_COMP +#End Optimized options +INCS = $(INCPAR) +LIBS = $(LIBPAR) +LIBSEQNEEDED = diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.ALPHA_true64.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.ALPHA_true64.SEQ new file mode 100644 index 000000000..fa18fa69f --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.ALPHA_true64.SEQ @@ -0,0 +1,86 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +################################################################################ + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = cc +FC = f90 +FL = f90 +AR = ar vr +RANLIB = echo +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBBLAS = -ldxml +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ +#Begin Optimized options +OPTF = -I. -O -DALPHA_ -nopipeline +OPTL = -O +OPTC = -O -DMAIN_COMP +#End Optimized options +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.G95.PAR b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.G95.PAR new file mode 100644 index 000000000..b063c3d49 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.G95.PAR @@ -0,0 +1,96 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +################################################################################ + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = gcc +FC = g95 +FL = g95 +AR = ar vr +RANLIB = echo + +SCALAP = /usr/local/SCALAPACK/libscalapack.a /usr/local/BLACS/LIB/blacsCinit_MPI-LINUX-0.a /usr/local/BLACS/LIB/blacsF77init_MPI-LINUX-0.a /usr/local/BLACS/LIB/blacs_MPI-LINUX-0.a +INCPAR = -I/usr/local/mpich-1.2.7p1/include +LIBPAR = $(SCALAP) -L/usr/local/mpich-1.2.7p1/lib -lfmpich -lmpich + +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq + +#LIBBLAS = /usr/local/lib/libgoto_coppermine32p-r1.00.so +LIBBLAS =/usr/local/ATLAS/lib/Linux_P4SSE2/libf77blas.a /usr/local/ATLAS/lib/Linux_P4SSE2/libatlas.a -lg2c +LIBOTHERS = -lpthread + +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd__ + +#Begin Optimization options +OPTF = -O -i4 +OPTL = -O +OPTC = -O -DMAIN_COMP +#End Optimization options + +INCS = $(INCPAR) +LIBS = $(LIBPAR) +LIBSEQNEEDED = diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.G95.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.G95.SEQ new file mode 100644 index 000000000..98c653628 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.G95.SEQ @@ -0,0 +1,93 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +################################################################################ + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = gcc +FC = g95 +FL = g95 +AR = ar vr +RANLIB = echo + + +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq + +#LIBBLAS = /usr/local/lib/libgoto_coppermine32p-r1.00.so +LIBBLAS =/usr/local/ATLAS/lib/Linux_P4SSE2/libf77blas.a /usr/local/ATLAS/lib/Linux_P4SSE2/libatlas.a -lg2c +LIBOTHERS = -lpthread + +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd__ + +#Begin Optimization options +OPTF = -O -i4 +OPTL = -O +OPTC = -O -DMAIN_COMP +#End Optimization options + +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.INTEL.PAR b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.INTEL.PAR new file mode 100644 index 000000000..c7803ad09 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.INTEL.PAR @@ -0,0 +1,94 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +################################################################################ + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = gcc +FC = ifort +FL = ifort +AR = ar vr +#RANLIB = ranlib +RANLIB = echo +SCALAP = /local/SCALAPACK/libscalapack.a /local/BLACS/LIB/blacs_MPI-LINUX-0.a /local/BLACS/LIB/blacsF77init_MPI-LINUX-0.a /local/BLACS/LIB/blacs_MPI-LINUX-0.a +INCPAR = -I/usr/local/include +# LIBPAR = $(SCALAP) -L/usr/local/lib/ -llamf77mpi -lmpi -llam +LIBPAR = $(SCALAP) -L/usr/local/lib/ -llammpio -llamf77mpi -lmpi -llam -lutil -ldl -lpthread +#LIBPAR = -lmpi++ -lmpi -ltstdio -ltrillium -largs -lt +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +#LIBBLAS = -L/usr/lib/xmm/ -lf77blas -latlas +LIBBLAS = -L/local/BLAS -lblas +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ + +#Begin Optimized options +OPTF = -O -DALLOW_NON_INIT -nofor_main +OPTL = -O -nofor_main +OPTC = -O +#End Optimized options +INCS = $(INCPAR) +LIBS = $(LIBPAR) +LIBSEQNEEDED = diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.INTEL.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.INTEL.SEQ new file mode 100644 index 000000000..da30f7d0f --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.INTEL.SEQ @@ -0,0 +1,89 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +################################################################################ + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = gcc +FC = ifort +FL = ifort +AR = ar vr +#RANLIB = ranlib +RANLIB = echo +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +#LIBBLAS = -L/usr/lib/xmm/ -lf77blas -latlas +LIBBLAS = -L/local/BLAS -lblas +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ + +#Begin Optimized options +OPTF = -O -DALLOW_NON_INIT -nofor_main +OPTL = -O -nofor_main +OPTC = -O +#End Optimized options +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.NEC.PAR b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.NEC.PAR new file mode 100644 index 000000000..804a22f96 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.NEC.PAR @@ -0,0 +1,97 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +################################################################################ +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = sxcc +FC = sxmpif90 +FL = sxmpif90 +AR = sxar vr +RANLIB = echo + +# +# Use module load scalapack, module load blas, etc. +# +#SCALAP = -lscalapack -lblacs -lblacsCinit -lblacsF90init +#INCPAR = -I/usr/lib +#LIBPAR = $(SCALAP) -L/usr/lib -lmpi -lmpi++ + +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq + +# LIBBLAS = -lcblas -lblas +LIBOTHERS = -lpthread + +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ + +#Begin Optimization options +OPTF = -DALLOW_NON_INIT +OPTL = +OPTC = -Kc99 -O -I +#End Optimization options + +INCS = $(INCPAR) +LIBS = $(LIBPAR) +LIBSEQNEEDED = diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.NEC.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.NEC.SEQ new file mode 100644 index 000000000..893efdacb --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.NEC.SEQ @@ -0,0 +1,94 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +################################################################################ +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = sxcc +FC = sxmpif90 +FL = sxmpif90 +AR = sxar vr +RANLIB = echo + +# +# Use module load scalapack, module load blas, etc. +# + +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq + +# LIBBLAS = -lcblas -lblas +LIBOTHERS = -lpthread + +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ + +#Begin Optimization options +OPTF = -DALLOW_NON_INIT +OPTL = +OPTC = -Kc99 -O -I +#End Optimization options + +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SGI.PAR b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SGI.PAR new file mode 100644 index 000000000..120ed7540 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SGI.PAR @@ -0,0 +1,92 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +######################################################################## + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = cc +FC = f90 +FL = f90 +AR = ar vr +RANLIB = echo +SCALAP = -L/usr/lib64 -lscalapack64 -lmpiblacs64 +INCPAR = -I/usr/include/ +LIBPAR = $(SCALAP) -L/usr/lib64/ -lmpi +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBBLAS = -lblas +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ + + +#Begin Optimization options +OPTF = -Dsgi -O -OPT:Olimit=0 -mips4 -64 -align64 -DALLOW_NON_INIT +OPTL = -O -OPT:Olimit=0 -mips4 -64 -align64 +OPTC = -O -OPT:Olimit=0 -mips4 -64 -align64 +NOOPT = -Dsgi -mips4 -64 -align64 +#End Optimization options +INCS = $(INCPAR) +LIBS = $(LIBPAR) +LIBSEQNEEDED = diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SGI.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SGI.SEQ new file mode 100644 index 000000000..7e8e4f887 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SGI.SEQ @@ -0,0 +1,89 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +######################################################################## + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = cc +FC = f90 +FL = f90 +AR = ar vr +RANLIB = echo +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBBLAS = -lblas +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ + + +#Begin Optimization options +OPTF = -Dsgi -O -OPT:Olimit=0 -mips4 -64 -align64 -DALLOW_NON_INIT +OPTL = -O -OPT:Olimit=0 -mips4 -64 -align64 +OPTC = -O -OPT:Olimit=0 -mips4 -64 -align64 +NOOPT = -Dsgi -mips4 -64 -align64 +#End Optimization options +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SP.PAR b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SP.PAR new file mode 100644 index 000000000..5a591c9ed --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SP.PAR @@ -0,0 +1,94 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSC = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +#ORDERINGSF = -WF,-Dscotch -WF,-Dmetis -WF,-Dpord -WF,-Dptscotch -WF,-Dparmetis +ORDERINGSC = -Dpord +ORDERINGSF = -WF,-Dpord + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +######################################################################## + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = mpcc +FC = mpxlf90 +FL = mpxlf90 +AR = ar vr +RANLIB = ranlib + + +SCALAP = -lpessl -lblacs + +INCPAR = # -I/usr/lpp/ppe.poe/include +LIBPAR = $(SCALAP) # -L/usr/lpp/ppe.poe/lib -lmpi +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBBLAS = -lessl +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = + +#Begin Optimization options +OPTF = -WF,-DPESSL -WF,-DSP_ -WF,-DALLOW_NON_INIT -O3 -qstrict -qmaxmem=-1 -Q -qfixed -qalign=4k -qarch=auto -qtune=auto -qcache=auto -q32 -bmaxdata:0x80000000 -B/usr/lib/ -tF +OPTC = -O3 -qstrict -qarch=auto -qtune=auto -qcache=auto -Q=150 -s -qmaxmem=-1 -qcpluscmt -q32 -bmaxdata:0x80000000 +OPTL = -O3 -qstrict -Q -qfixed -qalign=4k -q32 -bmaxdata:0x80000000 +#End Optimization options +INCS = $(INCPAR) +LIBS = $(LIBPAR) +LIBSEQNEEDED = diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SP.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SP.SEQ new file mode 100644 index 000000000..fcbf214da --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SP.SEQ @@ -0,0 +1,91 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSC = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +#ORDERINGSF = -WF,-Dscotch -WF,-Dmetis -WF,-Dpord -WF,-Dptscotch -WF,-Dparmetis +ORDERINGSC = -Dpord +ORDERINGSF = -WF,-Dpord + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +######################################################################## + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = cc +FC = xlf90 +FL = xlf90 +AR = ar vr +RANLIB = ranlib + + + +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBBLAS = -lessl +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = + +#Begin Optimization options +OPTF = -WF,-DPESSL -WF,-DSP_ -WF,-DALLOW_NON_INIT -O3 -qstrict -qmaxmem=-1 -Q -qfixed -qalign=4k -qarch=auto -qtune=auto -qcache=auto -q32 -bmaxdata:0x80000000 -B/usr/lib/ -tF +OPTC = -O3 -qstrict -qarch=auto -qtune=auto -qcache=auto -Q=150 -s -qmaxmem=-1 -qcpluscmt -q32 -bmaxdata:0x80000000 +OPTL = -O3 -qstrict -Q -qfixed -qalign=4k -q32 -bmaxdata:0x80000000 +#End Optimization options +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SP64.PAR b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SP64.PAR new file mode 100644 index 000000000..4714ede56 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SP64.PAR @@ -0,0 +1,94 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSC = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +#ORDERINGSF = -WF,-Dscotch -WF,-Dmetis -WF,-Dpord -WF,-Dptscotch -WF,-Dparmetis +ORDERINGSC = -Dpord +ORDERINGSF = -WF,-Dpord + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +######################################################################## + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = mpcc_r +FC = mpxlf90_r +FL = mpxlf90_r +AR = ar -X64 vr +RANLIB = ranlib + + +SCALAP = -lpesslsmp -lblacssmp + +INCPAR = # -I/usr/lpp/ppe.poe/include +LIBPAR = $(SCALAP) # -L/usr/lpp/ppe.poe/lib -lmpi +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBBLAS = -lessl +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = + +#Begin Optimization options +OPTF = -WF,-DPESSL -WF,-DSP_ -WF,-DALLOW_NON_INIT -O3 -qstrict -qmaxmem=-1 -Q -qfixed -qalign=4k -qarch=auto -qtune=auto -qcache=auto -q64 -B/usr/lib/ -tF +OPTC = -O3 -qstrict -qarch=auto -qtune=auto -qcache=auto -Q=150 -s -qmaxmem=-1 -qcpluscmt -q64 +OPTL = -O3 -qstrict -Q -qfixed -qalign=4k -q64 +#End Optimization options +INCS = $(INCPAR) +LIBS = $(LIBPAR) +LIBSEQNEEDED = diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SP64.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SP64.SEQ new file mode 100644 index 000000000..f2d29e21a --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SP64.SEQ @@ -0,0 +1,91 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSC = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +#ORDERINGSF = -WF,-Dscotch -WF,-Dmetis -WF,-Dpord -WF,-Dptscotch -WF,-Dparmetis +ORDERINGSC = -Dpord +ORDERINGSF = -WF,-Dpord + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +######################################################################## + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = cc_r +FC = xlf90_r +FL = xlf90_r +AR = ar -X64 vr +RANLIB = ranlib + + + +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBBLAS = -lessl +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = + +#Begin Optimization options +OPTF = -WF,-DPESSL -WF,-DSP_ -WF,-DALLOW_NON_INIT -O3 -qstrict -qmaxmem=-1 -Q -qfixed -qalign=4k -qarch=auto -qtune=auto -qcache=auto -q64 -B/usr/lib/ -tF +OPTC = -O3 -qstrict -qarch=auto -qtune=auto -qcache=auto -Q=150 -s -qmaxmem=-1 -qcpluscmt -q64 +OPTL = -O3 -qstrict -Q -qfixed -qalign=4k -q64 +#End Optimization options +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SUN.PAR b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SUN.PAR new file mode 100644 index 000000000..17c7a967c --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SUN.PAR @@ -0,0 +1,92 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +######################################################################## + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +CPP = /lib/cpp -P -C +RM = /bin/rm -f +CC = cc +FC = f90 +FL = f90 +AR = ar vr +RANLIB = echo + +SCALAP = -ls3l -lhpcshm +INCPAR = -I/opt/SUNWhpc/include +LIBPAR = -L/opt/SUNWhpc/lib -R/opt/SUNWhpc/lib $(SCALAP) -lmpi +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBBLAS = -lsunperf -lf77compat +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ + +#Begin Optimized options +OPTF = -O -DALLOW_NON_INIT -DSUN_ +OPTL = -O +OPTC = -O +#End Optimized options +INCS = $(INCPAR) +LIBS = $(LIBPAR) +LIBSEQNEEDED = diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SUN.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SUN.SEQ new file mode 100644 index 000000000..748c5572f --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.SUN.SEQ @@ -0,0 +1,89 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +######################################################################## + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +CPP = /lib/cpp -P -C +RM = /bin/rm -f +CC = cc +FC = f90 +FL = f90 +AR = ar vr +RANLIB = echo + +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBBLAS = -lsunperf -lf77compat +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ + +#Begin Optimized options +OPTF = -O -DALLOW_NON_INIT -DSUN_ +OPTL = -O +OPTC = -O +#End Optimized options +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.WIN.MS-G95.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.WIN.MS-G95.SEQ new file mode 100644 index 000000000..db881c252 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.WIN.MS-G95.SEQ @@ -0,0 +1,102 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +# We are grateful to Evgenii Rudnyi for his help and suggestions +# regarding Windows installation. +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS, PATHMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#PATHSCOTCH = -LIBPATH:$(SCOTCHDIR)/lib +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = libscotch.lib libscotcherr.lib +#LSCOTCH = libptscotch.lib libptscotcherr.lib + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +PATHPORD = -LIBPATH:$(LPORDDIR) +LPORD = libpord.lib + +#LMETISDIR = /local/metis/ +#PATHMETIS = -LIBPATH:$(PATHMETIS) +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = libmetis.lib +#LMETIS = libparmetis.lib libmetis.lib + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +PATHORDERINGS = $(PATHMETIS) $(PATHPORD) $(PATHSCOTCH) +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +# FOr Windows +#End orderings +######################################################################## +######################################################################## +################################################################################ + +PLAT = +LIBEXT = .lib +OUTC = -Fo +OUTF = -o +RM = /bin/rm -f +CC = cl +FC = g95 +FL = cl +AR = lib -out: +RANLIB = echo + + +INCSEQ = -I$(topdir)/libseq +#LIBSEQ = -L$(topdir)/libseq -lmpiseq +LIBSEQ = $(topdir)/libseq/libmpiseq.lib +#LIBBLAS = /usr/local/lib/libgoto_coppermine32p-r1.00.so +#LIBBLAS =/usr/local/ATLAS/lib/Linux_P4SSE2/libf77blas.a /usr/local/ATLAS/lib/Linux_P4SSE2/libatlas.a -lg2c +LIBBLAS = mkl_intel_c.lib mkl_intel_thread.lib mkl_core.lib libiomp5md.lib +#LIBOTHERS = -lpthread +LIBOTHERS = libf95.lib libgcc.lib -link $(PATHORDERINGS) +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd__ + +#Begin Optimization options +OPTF = -O -i4 -fno-underscoring -fcase-upper +OPTL = +OPTC = -O2 -MD +#End Optimization options + +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.WIN.MS-Intel.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.WIN.MS-Intel.SEQ new file mode 100644 index 000000000..192f9b18b --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.WIN.MS-Intel.SEQ @@ -0,0 +1,99 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +# We are grateful to Evgenii Rudnyi for his help and suggestions +# regarding Windows installation. +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS, PATHMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#PATHSCOTCH = -LIBPATH:$(SCOTCHDIR)/lib +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = libscotch.lib libscotcherr.lib +#LSCOTCH = libptscotch.lib libptscotcherr.lib + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +PATHPORD = -LIBPATH:$(LPORDDIR) +LPORD = libpord.lib + +#LMETISDIR = /local/metis/ +#PATHMETIS = -LIBPATH:$(PATHMETIS) +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = libmetis.lib +#LMETIS = libparmetis.lib libmetis.lib + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +PATHORDERINGS = $(PATHMETIS) $(PATHPORD) $(PATHSCOTCH) +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +# FOr Windows +#End orderings +######################################################################## +######################################################################## +################################################################################ + +PLAT = +LIBEXT = .lib +OUTC = -Fo +OUTF = -Fo +RM = /bin/rm -f +CC = cl +FC = ifort +FL = ifort +AR = lib -out: +#RANLIB = ranlib +RANLIB = echo +INCSEQ = -I$(topdir)/libseq +LIBSEQ = $(topdir)/libseq/libmpiseq.lib +#LIBBLAS = -L/usr/lib/xmm/ -lf77blas -latlas +#LIBBLAS = -L/local/BLAS -lblas +LIBBLAS = mkl_intel_c.lib mkl_intel_thread.lib mkl_core.lib libiomp5md.lib +#LIBOTHERS = -lpthread +LIBOTHERS = -link $(PATHORDERINGS) +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ + +#Begin Optimized options +OPTF = -O -MD -Dintel_ -DALLOW_NON_INIT -fpp +OPTL = +OPTC = -O2 -MD +#End Optimized options +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.gfortran.PAR b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.gfortran.PAR new file mode 100644 index 000000000..972bccc08 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.gfortran.PAR @@ -0,0 +1,95 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +################################################################################ + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = gcc +FC = gfortran +FL = gfortran +AR = ar vr +#RANLIB = ranlib +RANLIB = echo +SCALAP = /local/SCALAPACK/libscalapack.a /local/BLACS/LIB/blacs_MPI-LINUX-0.a /local/BLACS/LIB/blacsF77init_MPI-LINUX-0.a /local/BLACS/LIB/blacs_MPI-LINUX-0.a +#INCPAR = -I/usr/local/include +INCPAR = -I/usr/local/mpich/include +# LIBPAR = $(SCALAP) -L/usr/local/lib/ -llammpio -llamf77mpi -lmpi -llam -lutil -ldl -lpthread +LIBPAR = $(SCALAP) -L/usr/local/mpich/lib/ -lmpich +# See point 17 in the FAQ to have more details on the compilation of mpich with gfortran +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +#LIBBLAS = -L/usr/lib/xmm/ -lf77blas -latlas +LIBBLAS = -L/local/BLAS -lblas +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ + +#Begin Optimized options +OPTF = -O -DALLOW_NON_INIT +OPTL = -O +OPTC = -O +#End Optimized options +INCS = $(INCPAR) +LIBS = $(LIBPAR) +LIBSEQNEEDED = diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.gfortran.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.gfortran.SEQ new file mode 100644 index 000000000..2a6966d0d --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.gfortran.SEQ @@ -0,0 +1,90 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +#Begin orderings + +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +################################################################################ + +PLAT = +LIBEXT = .a +OUTC = -o +OUTF = -o +RM = /bin/rm -f +CC = gcc +FC = gfortran +FL = gfortran +AR = ar vr +#RANLIB = ranlib +RANLIB = echo +# See point 17 in the FAQ to have more details on the compilation of mpich with gfortran +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -L$(topdir)/libseq -lmpiseq +#LIBBLAS = -L/usr/lib/xmm/ -lf77blas -latlas +LIBBLAS = -L/local/BLAS -lblas +LIBOTHERS = -lpthread +#Preprocessor defs for calling Fortran from C (-DAdd_ or -DAdd__ or -DUPPER) +CDEFS = -DAdd_ + +#Begin Optimized options +OPTF = -O -DALLOW_NON_INIT +OPTL = -O +OPTC = -O +#End Optimized options +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.inc.generic b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.inc.generic new file mode 100644 index 000000000..d0daa9ac2 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.inc.generic @@ -0,0 +1,158 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +################################################################################ +# +# Makefile.inc.generic +# +# This defines some parameters dependent on your platform; you should +# look for the approriate file in the directory ./Make.inc/ and copy it +# into a file called Makefile.inc. For example, from the MUMPS root +# directory, use +# "cp Make.inc/Makefile.inc.generic ./Makefile.inc" +# (see the main README file for details) +# +# If you do not find any suitable Makefile in Makefile.inc, use this file: +# "cp Make.inc/Makefile.inc.generic ./Makefile.inc" and modify it according +# to the comments given below. If you manage to build MUMPS on a new platform, +# and think that this could be useful to others, you may want to send us +# the corresponding Makefile.inc file. +# +################################################################################ + + +######################################################################## +#Begin orderings +# +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## +# DEFINE HERE SOME COMMON COMMANDS, THE COMPILER NAMES, ETC... + +# PLAT : use it to add a default suffix to the generated libraries +PLAT = +# Library extension, + C and Fortran "-o" option +# may be different under Windows +LIBEXT = .a +OUTC = -o +OUTF = -o +# RM : remove files +RM = /bin/rm -f +# CC : C compiler +CC = cc +# FC : Fortran 90 compiler +FC = f90 +# FL : Fortran linker +FL = f90 +# AR : Archive object in a library +# keep a space at the end if options have to be separated from lib name +AR = ar vr +# RANLIB : generate index of an archive file +# (optionnal use "RANLIB = echo" in case of problem) +RANLIB = ranlib +#RANLIB = echo + +# SCALAP should define the SCALAPACK and BLACS libraries. +SCALAP = -lscalapack -lblacs + +# INCLUDE DIRECTORY FOR MPI +INCPAR = -I/usr/include + +# LIBRARIES USED BY THE PARALLEL VERSION OF MUMPS: $(SCALAP) and MPI +LIBPAR = $(SCALAP) -L/usr/lib -lmpi + +# The parallel version is not concerned by the next two lines. +# They are related to the sequential library provided by MUMPS, +# to use instead of ScaLAPACK and MPI. +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -Llibseq -lmpiseq + +# DEFINE HERE YOUR BLAS LIBRARY + +LIBBLAS = -lblas + +# DEFINE YOUR PTHREAD LIBRARY +LIBOTHERS = -lpthread + +# FORTRAN/C COMPATIBILITY: +# Use: +# -DAdd_ if your Fortran compiler adds an underscore at the end +# of symbols, +# -DAdd__ if your Fortran compiler adds 2 underscores, +# +# -DUPPER if your Fortran compiler uses uppercase symbols +# +# leave empty if your Fortran compiler does not change the symbols. +# + +CDEFS = -DAdd_ + +#COMPILER OPTIONS +OPTF = -O +OPTC = -O -I. +OPTL = -O + +# CHOOSE BETWEEN USING THE SEQUENTIAL OR THE PARALLEL VERSION. + +#Sequential: +#INCS = $(INCSEQ) +#LIBS = $(LIBSEQ) +#LIBSEQNEEDED = libseqneeded + +#Parallel: +INCS = $(INCPAR) +LIBS = $(LIBPAR) +LIBSEQNEEDED = + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.inc.generic.SEQ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.inc.generic.SEQ new file mode 100644 index 000000000..a52d14b23 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Make.inc/Makefile.inc.generic.SEQ @@ -0,0 +1,147 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +################################################################################ +# +# Makefile.inc.generic.SEQ +# +# Generic Makefile.inc for sequential (MPI free, Scalapack free) version +# +# +# This defines some parameters dependent on your platform; you should +# look for the approriate file in the directory ./Make.inc/ and copy it +# into a file called Makefile.inc. For example, from the MUMPS root +# directory, use +# "cp Make.inc/Makefile.inc.generic.SEQ ./Makefile.inc" +# (see the main README file for details) +# +# If you do not find any suitable Makefile in Makefile.inc, use this file: +# "cp Make.inc/Makefile.inc.generic ./Makefile.inc" and modify it according +# to the comments given below. If you manage to build MUMPS on a new platform, +# and think that this could be useful to others, you may want to send us +# the corresponding Makefile.inc file. +# +################################################################################ + + +################################################################################ +#Begin orderings +# NOTE that PORD is distributed within MUMPS by default. If you would like to +# use other orderings, you need to obtain the corresponding package and modify +# the variables below accordingly. +# For example, to have Metis available within MUMPS: +# 1/ download Metis and compile it +# 2/ uncomment (suppress # in first column) lines +# starting with LMETISDIR, LMETIS +# 3/ add -Dmetis in line ORDERINGSF +# ORDERINGSF = -Dpord -Dmetis +# 4/ Compile and install MUMPS +# make clean; make (to clean up previous installation) +# +# Metis/ParMetis and SCOTCH/PT-SCOTCH (ver 5.1 and later) orderings are now available for MUMPS. +# + +#SCOTCHDIR = ${HOME}/scotch_5.1_esmumps +#ISCOTCH = -I$(SCOTCHDIR)/include +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dscotch in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dptscotch in the ORDERINGSF variable below) + +#LSCOTCH = -L$(SCOTCHDIR)/lib -lesmumps -lscotch -lscotcherr +#LSCOTCH = -L$(SCOTCHDIR)/lib -lptesmumps -lptscotch -lptscotcherr + + +LPORDDIR = $(topdir)/PORD/lib/ +IPORD = -I$(topdir)/PORD/include/ +LPORD = -L$(LPORDDIR) -lpord + +#LMETISDIR = /local/metis/ +#IMETIS = # Should be provided if you use parmetis + +# You have to choose one among the following two lines depending on +# the type of analysis you want to perform. If you want to perform only +# sequential analysis choose the first (remember to add -Dmetis in the ORDERINGSF +# variable below); for both parallel and sequential analysis choose the second +# line (remember to add -Dparmetis in the ORDERINGSF variable below) + +#LMETIS = -L$(LMETISDIR) -lmetis +#LMETIS = -L$(LMETISDIR) -lparmetis -lmetis + +# The following variables will be used in the compilation process. +# Please note that -Dptscotch and -Dparmetis imply -Dscotch and -Dmetis respectively. +#ORDERINGSF = -Dscotch -Dmetis -Dpord -Dptscotch -Dparmetis +ORDERINGSF = -Dpord +ORDERINGSC = $(ORDERINGSF) + +LORDERINGS = $(LMETIS) $(LPORD) $(LSCOTCH) +IORDERINGSF = $(ISCOTCH) +IORDERINGSC = $(IMETIS) $(IPORD) $(ISCOTCH) + +#End orderings +######################################################################## + +######################################################################## +# DEFINE HERE SOME COMMON COMMANDS, THE COMPILER NAMES, ETC... + +# PLAT : use it to add a default suffix to the generated libraries +PLAT = +# Library extension, + C and Fortran "-o" option +# may be different under Windows +LIBEXT = .a +OUTC = -o +OUTF = -o +# RM : remove files +RM = /bin/rm -f +# CC : C compiler +CC = cc +# FC : Fortran 90 compiler +FC = f90 +# FL : Fortran linker +FL = f90 +# AR : Archive object in a library +# keep a space at the end if options have to be separated from lib name +AR = ar vr +# RANLIB : generate index of an archive file +# (optionnal use "RANLIB = echo" in case of problem) +RANLIB = ranlib +#RANLIB = echo + +# The next two lines should not be modified. They concern +# the sequential library provided by MUMPS, to use instead +# of ScaLAPACK and MPI. +INCSEQ = -I$(topdir)/libseq +LIBSEQ = -Llibseq -lmpiseq + +# DEFINE HERE YOUR BLAS LIBRARY + +LIBBLAS = -lblas + +# DEFINE HERE YOUR PTHREAD LIBRARY +LIBOTHERS = -lpthread + +# FORTRAN/C COMPATIBILITY: +# Use: +# -DAdd_ if your Fortran compiler adds an underscore at the end +# of symbols, +# -DAdd__ if your Fortran compiler adds 2 underscores, +# +# -DUPPER if your Fortran compiler uses uppercase symbols +# +# leave empty if your Fortran compiler does not change the symbols. +# + +CDEFS = -DAdd_ + +#COMPILER OPTIONS + +OPTF = -O +OPTC = -O -I. +OPTL = -O + +#Sequential: + +INCS = $(INCSEQ) +LIBS = $(LIBSEQ) +LIBSEQNEEDED = libseqneeded diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/Makefile b/Ipopt-3.13.4/ThirdParty/MUMPS/Makefile new file mode 100644 index 000000000..fc1cb67b7 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/Makefile @@ -0,0 +1,79 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +topdir = . +libdir = $(topdir)/lib + +default: dexamples + +.PHONY: default alllib all s d c z \ + sexamples dexamples cexamples zexamples \ + mumps_lib requiredobj libseqneeded clean + +alllib: s d c z +all: sexamples dexamples cexamples zexamples + +s: + $(MAKE) ARITH=s mumps_lib +d: + $(MAKE) ARITH=d mumps_lib +c: + $(MAKE) ARITH=c mumps_lib +z: + $(MAKE) ARITH=z mumps_lib + + +# Is Makefile.inc available ? +Makefile.inc: + @echo "######################################################################" + @echo "# BEFORE COMPILING MUMPS, YOU SHOULD HAVE AN APPROPRIATE FILE" + @echo "# Makefile.inc AVALAIBLE. PLEASE LOOK IN THE DIRECTORY ./Make.inc FOR" + @echo "# EXAMPLES OF Makefile.inc FILES, AT Make.inc/Makefile.inc.generic" + @echo "# IN CASE YOU NEED TO BUILD A NEW ONE AND READ THE MAIN README FILE" + @echo "######################################################################" + @exit 1 + +include Makefile.inc + +mumps_lib: requiredobj + (cd src ; $(MAKE) $(ARITH)) + +sexamples: s + (cd examples ; $(MAKE) s) + +dexamples: d + (cd examples ; $(MAKE) d) + +cexamples: c + (cd examples ; $(MAKE) c) + +zexamples: z + (cd examples ; $(MAKE) z) + + +requiredobj: Makefile.inc $(LIBSEQNEEDED) $(libdir)/libpord$(PLAT)$(LIBEXT) + +# dummy MPI library (sequential version) + +libseqneeded: + (cd libseq; $(MAKE)) + +# Build the libpord.a library and copy it into $(topdir)/lib +$(libdir)/libpord$(PLAT)$(LIBEXT): + if [ "$(LPORDDIR)" != "" ] ; then \ + cd $(LPORDDIR); \ + $(MAKE) CC="$(CC)" CFLAGS="$(OPTC)" AR="$(AR)" RANLIB="$(RANLIB)" OUTC=$(OUTC) LIBEXT=$(LIBEXT); \ + fi; + if [ "$(LPORDDIR)" != "" ] ; then \ + cp $(LPORDDIR)/libpord$(LIBEXT) $@; \ + fi; + +clean: + (cd src; $(MAKE) clean) + (cd examples; $(MAKE) clean) + (cd $(libdir); $(RM) *$(PLAT)$(LIBEXT)) + (cd libseq; $(MAKE) clean) + if [ $(LPORDDIR) != "" ] ; then \ + cd $(LPORDDIR); $(MAKE) realclean; \ + fi; + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/README b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/README new file mode 100644 index 000000000..d7bdc446a --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/README @@ -0,0 +1,14 @@ +ACKNOWLEDGEMENT: + +This directory contains an implementation of the PORD algorithm, +as described in: + "Towards a tighter coupling of bottom-up and top-down sparse + matrix ordering methods, J. Schulze, BIT, 41:4, pp 800, 2001." + +It is extracted from the SPACE-1.0 package developed at the +University of Paderborn by Juergen Schulze (js@juergenschulze.de). +A lot of the code in SPACE-1.0 was itself based on the SPOOLES +package by Cleve Ashcraft. + +We are grateful to Juergen Schulze for letting us distribute PORD. + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/const.h b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/const.h new file mode 100644 index 000000000..96e1f2cf9 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/const.h @@ -0,0 +1,129 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: const.h +/ +/ author J"urgen Schulze, University of Paderborn +/ created 99sep14 +/ +/ This file contains constant definitions +/ +******************************************************************************/ + +/* matrix types */ +#define GRID 0 +#define MESH 1 +#define TORUS 2 +#define HB 3 + +/* graph types */ +#define UNWEIGHTED 0 +#define WEIGHTED 1 + +/* type of ordering */ +#define MINIMUM_PRIORITY 0 +#define INCOMPLETE_ND 1 +#define MULTISECTION 2 +#define TRISTAGE_MULTISECTION 3 + +/* fill-reducing node selection strategies */ +#define AMD 0 +#define AMF 1 +#define AMMF 2 +#define AMIND 3 + +/* node selection strategies for generating the domain decompositions */ +#define QMD 0 +#define QMRDV 1 +#define QRAND 2 + +/* default options for SPACE */ +#define SPACE_ORDTYPE MULTISECTION +#define SPACE_NODE_SELECTION1 AMMF +#define SPACE_NODE_SELECTION2 AMMF +#define SPACE_NODE_SELECTION3 QMRDV +#define SPACE_DOMAIN_SIZE 200 +#define SPACE_MSGLVL 2 +#define SPACE_ETREE_NONZ 256 +#define SPACE_ETREE_BAL 5 +#define SPACE_MASK_OFFSET 2 + +/* misc. constants */ +#define TRUE 1 +#define FALSE 0 +#define ERR -1 +#define NOERR 0 +#define MAX_LINE_LEN 255 +#define MAX_INT ((1<<30)-1) +#define MAX_FLOAT 1e31 +#define EPS 0.001 + +/* constants used in color array */ +/* these constants are also used as an index (do not change) */ +#define GRAY 0 +#define BLACK 1 +#define WHITE 2 + +/* constants for the Dulmage-Mendelsohn decomposition (dmflags) */ +/* these constants are also used as an index (do not change) */ +#define SI 0 /* node e X is reachable via exposed node e X */ +#define SX 1 /* node e X is reachable via exposed node e Y */ +#define SR 2 /* SR = X - (SI u SX) */ +#define BI 3 /* node e Y is reachable via exposed node e Y */ +#define BX 4 /* node e Y is reachable via exposed node e X */ +#define BR 5 /* BR = Y - (BI u BX) */ + +/* size/indices of option array (do not change) */ +#define ORD_OPTION_SLOTS 7 + +#define OPTION_ORDTYPE 0 +#define OPTION_NODE_SELECTION1 1 +#define OPTION_NODE_SELECTION2 2 +#define OPTION_NODE_SELECTION3 3 +#define OPTION_DOMAIN_SIZE 4 +#define OPTION_MSGLVL 5 +#define OPTION_ETREE_NONZ 6 + +/* size/indices for timing array in ordering computation */ +#define ORD_TIME_SLOTS 12 + +#define TIME_COMPRESS 0 /* 0. TIME_COMPRESS */ +#define TIME_MS 1 /* 1. TIME_MS */ +#define TIME_MULTILEVEL 2 /* 1.1 TIME_MULTILEVEL */ +#define TIME_INITDOMDEC 3 /* 1.1.1 TIME_INITDOMDEC */ +#define TIME_COARSEDOMDEC 4 /* 1.1.2 TIME_COARSEDOMDEC */ +#define TIME_INITSEP 5 /* 1.1.3 TIME_INITSEP */ +#define TIME_REFINESEP 6 /* 1.1.4 TIME_REFINESEP */ +#define TIME_SMOOTH 7 /* 1.2 TIME_SMOOTH */ +#define TIME_BOTTOMUP 8 /* 2. TIME_BOTTOMUP */ +#define TIME_UPDADJNCY 9 /* 2.1 TIME_UPDADJNCY */ +#define TIME_FINDINODES 10 /* 2.2 TIME_FINDINODES */ +#define TIME_UPDSCORE 11 /* 2.3 TIME_UPDSCORE */ + +/* size/indices for timing array in sequential numerical factorization */ +#define NUMFAC_TIME_SLOTS 4 + +#define TIME_INITFRONT 0 +#define TIME_EXADD 1 +#define TIME_KERNEL 2 +#define TIME_INITUPD 3 + +/* size/indices for timing array in parallel numerical factorization */ +#define NUMFACPAR_TIME_SLOTS 9 + +#define TIME_INITFRONT 0 +#define TIME_EXADD 1 +#define TIME_KERNEL 2 +#define TIME_INITUPD 3 +#define TIME_EXCHANGE 4 +#define TIME_INITFRONTPAR 5 +#define TIME_EXADDPAR 6 +#define TIME_KERNELPAR 7 +#define TIME_INITUPDPAR 8 + +/* size/indices for timing array in parallel kernel */ +#define KERNELPAR_TIME_SLOTS 4 + +#define TIME_PIVOT 0 +#define TIME_PIVOT_WAIT 1 +#define TIME_CMOD 2 +#define TIME_CMOD_WAIT 3 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/eval.h b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/eval.h new file mode 100644 index 000000000..a78bbe27f --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/eval.h @@ -0,0 +1,52 @@ +/***************************************************************************** +/ +/ PORD Ordering Library: eval.h +/ +/ author J"urgen Schulze, University of Paderborn +/ created 99mar30 +/ +/ This file contains the definition of various separator evaluation functions +/ +******************************************************************************/ + +#define F eval1 /* default separator evaluation function */ + + + /* --------------------------------------------------------------------- */ + /* SEPARATOR EVALUATION FUNCTION 1 */ + /* Size of domains W and B is allowed to differ TOLERANCE * 100 percent. */ + /* Within this tolerance the difference is not penalized and only the */ + /* size of the separator is returned. Additionally, the mantissa of the */ + /* returned value is set to (max-min)/max. */ + /* --------------------------------------------------------------------- */ + +#define TOL1 0.50 /* tolerated imbalance induced by bisector */ +#define PEN1 100 /* penalty in case of higher imbalance */ + +#define eval1(S, B, W) \ + S + PEN1 * max(0, max(W,B) * (1-TOL1) - min(W,B)) \ + + (FLOAT)(max(W,B)-min(W,B)) / (FLOAT)max(W,B) + + /* --------------------------------------------------------------------- */ + /* SEPARATOR EVALUATION FUNCTION 2 */ + /* Ashcraft and Liu (Using domain decomposition to find graph bisectors) */ + /* --------------------------------------------------------------------- */ + +#define alpha 0.1 +#define TOL2 0.70 +#define PEN2 100 + +#define eval2(S, B, W) \ + S * (1 + alpha * ((FLOAT)max(W,B)/(FLOAT)max(1,min(W,B)))) \ + + PEN2 * max(0, max(W,B) * (1-TOL2) - min(W,B)) + + /* --------------------------------------------------------------------- */ + /* SEPARATOR EVALUATION FUNCTION 3 */ + /* Ashcraft and Liu (Generalized nested dissection:some recent progress) */ + /* --------------------------------------------------------------------- */ + +#define alpha2 0.33 + +#define eval3(S, B, W) \ + S * S + alpha2 * (max(W,B)-min(W,B)) * (max(W,B)-min(W,B)) + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/macros.h b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/macros.h new file mode 100644 index 000000000..b2acdba38 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/macros.h @@ -0,0 +1,86 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: macros.h +/ +/ author J"urgen Schulze, University of Paderborn +/ created 99jan24 +/ +/ This file contains some useful macros +/ +******************************************************************************/ + +/* Some compilers (VC++ for instance) define a min and a max in the stdlib */ +#ifdef min +# undef min +#endif +#ifdef max +# undef max +#endif +#define min(a,b) ((a) < (b) ? (a) : (b)) +#define max(a,b) ((a) > (b) ? (a) : (b)) + +#define mymalloc(ptr, nr, type) \ + if (!(ptr = (type*)malloc((max(nr,1)) * sizeof(type)))) \ + { printf("malloc failed on line %d of file %s (nr=%d)\n", \ + __LINE__, __FILE__, nr); \ + exit(ERR); \ + } + +#define myrealloc(ptr, nr, type) \ + if (!(ptr = (type*)realloc(ptr, (nr) * sizeof(type)))) \ + { printf("realloc failed on line %d of file %s (nr=%d)\n", \ + __LINE__, __FILE__, nr); \ + exit(ERR); \ + } + +#define myrandom(range) \ + rand() % (range); + +#define swap(a, b, tmp) \ + { (tmp) = (a); (a) = (b); (b) = (tmp); } + +#define seed() \ + srand((int)time(0) % 10000); + +#define bit(var, d) \ + ((var) & (1 << (d))) + +#define negbit(var, d) \ + ((var) ^ (1 << (d))) + +#define waitkey() \ + { char _s[MAX_LINE_LEN]; printf("\n"); gets(_s); } + +#define resettimer(var) \ + var = 0; + +#define starttimer(var) \ + var -= ((FLOAT)clock()/CLOCKS_PER_SEC); + +#define stoptimer(var) \ + var += ((FLOAT)clock()/CLOCKS_PER_SEC); + +#define quit() \ + exit(ERR); + +#ifdef PARIX +#undef starttimer(var) +#ifdef __EPX +#define starttimer(var) \ + var -= ((FLOAT)TimeNow()/CLOCK_TICK); +#else +#define starttimer(var) \ + var -= ((FLOAT)TimeNowHigh()/CLK_TCK_HIGH); +#endif +#undef stoptimer(var) +#ifdef __EPX +#define stoptimer(var) \ + var += ((FLOAT)TimeNow()/CLOCK_TICK); +#else +#define stoptimer(var) \ + var += ((FLOAT)TimeNowHigh()/CLK_TCK_HIGH); +#endif +#undef quit() +#define quit() \ + exit(ERR); +#endif diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/params.h b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/params.h new file mode 100644 index 000000000..8f3949705 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/params.h @@ -0,0 +1,20 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: params.h +/ +/ author J"urgen Schulze, University of Paderborn +/ created 99sep14 +/ +/ This file contains parameter definitions +/ +******************************************************************************/ + +/* default parameters */ +#define MAX_BAD_FLIPS 100 /* interrupt/stop FM */ +#define COMPRESS_FRACTION 0.75 /* node reduction in compressed graph */ +#define MIN_NODES 100 /* stop recursive separator construction */ +#define DEFAULT_SEPS 31 /* default number of separators */ +#define MAX_SEPS 255 /* max. number of separators */ +#define MIN_DOMAINS 100 /* min. number of domains in a decomp. */ +#define MAX_COARSENING_STEPS 10 /* max. number of generated dom. decomp. */ + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/protos.h b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/protos.h new file mode 100644 index 000000000..93ea4fb63 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/protos.h @@ -0,0 +1,307 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: protos.h +/ +/ author J"urgen Schulze, University of Paderborn +/ created 99sep14 +/ +/ This file contains the prototypes of all non-static functions +/ +******************************************************************************/ + +/* functions in lib/greg_pord.h */ +int greg_pord(int, int, int *, int *, int *, int *, int *); + +/* functions in lib/graph.c */ +graph_t* newGraph(int, int); +void freeGraph(graph_t*); +void printGraph(graph_t*); +void randomizeGraph(graph_t*); +graph_t* setupSubgraph(graph_t*, int*, int, int*); +graph_t* setupGraphFromMtx(inputMtx_t*); +graph_t* setupGridGraph(int, int, int); +int connectedComponents(graph_t*); +graph_t* compressGraph(graph_t*, int*); + +/* functions in lib/gbisect.c */ +gbisect_t* newGbisect(graph_t*); +void freeGbisect(gbisect_t*); +void printGbisect(gbisect_t*); +void checkSeparator(gbisect_t*); +void constructSeparator(gbisect_t*, options_t*, timings_t*); +int smoothBy2Layers(gbisect_t*, int*, int*, int, int); +void smoothSeparator(gbisect_t*, options_t*); + +/* functions in lib/ddcreate.c */ +domdec_t* newDomainDecomposition(int, int); +void freeDomainDecomposition(domdec_t*); +void printDomainDecomposition(domdec_t*); +void checkDomainDecomposition(domdec_t*); +void buildInitialDomains(graph_t*, int*, int*, int*); +void mergeMultisecs(graph_t *G, int*, int*); +domdec_t* initialDomainDecomposition(graph_t*, int*, int*, int*); +domdec_t* constructDomainDecomposition(graph_t*, int*); +void computePriorities(domdec_t*, int*, int*, int); +void eliminateMultisecs(domdec_t*, int*, int*); +void findIndMultisecs(domdec_t*, int*, int*); +domdec_t* coarserDomainDecomposition(domdec_t*, int*); +void shrinkDomainDecomposition(domdec_t*, int); + +/* functions in lib/ddbisect.c */ +void checkDDSep(domdec_t*); +int findPseudoPeripheralDomain(domdec_t*, int); +void constructLevelSep(domdec_t*, int); +void initialDDSep(domdec_t*); +void updateB2W(bucket_t*, bucket_t*, domdec_t*, int, int*, + int*, int*, int*); +void updateW2B(bucket_t*, bucket_t*, domdec_t*, int, int*, + int*, int*, int*); +void improveDDSep(domdec_t*); + +/* functions in lib/gbipart.c */ +gbipart_t* newBipartiteGraph(int, int, int); +void freeBipartiteGraph(gbipart_t*); +void printGbipart(gbipart_t*); +gbipart_t* setupBipartiteGraph(graph_t*, int*, int, int, int*); +void maximumMatching(gbipart_t*, int*); +void maximumFlow(gbipart_t*, int*, int*); +void DMviaMatching(gbipart_t*, int*, int*, int*); +void DMviaFlow(gbipart_t*, int*, int*, int*, int*); + +/* functions in lib/nestdiss.c */ +nestdiss_t* newNDnode(graph_t*, int*, int); +void freeNDnode(nestdiss_t*); +nestdiss_t* setupNDroot(graph_t*, int*); +void splitNDnode(nestdiss_t*, options_t*, timings_t*); +void buildNDtree(nestdiss_t*, options_t*, timings_t*); +void freeNDtree(nestdiss_t*); + +/* functions in lib/multisector.c */ +multisector_t* newMultisector(graph_t*); +void freeMultisector(multisector_t*); +multisector_t* trivialMultisector(graph_t*); +multisector_t* constructMultisector(graph_t*, options_t*, timings_t*); +multisector_t* extractMS2stage(nestdiss_t*); +multisector_t* extractMSmultistage(nestdiss_t*); + +/* functions in lib/gelim.c */ +gelim_t* newElimGraph(int, int); +void freeElimGraph(gelim_t*); +void printElimGraph(gelim_t*); +gelim_t* setupElimGraph(graph_t*); +int crunchElimGraph(gelim_t*); +void buildElement(gelim_t *Gelim, int me); +void updateAdjncy(gelim_t*, int*, int, int*, int*); +void findIndNodes(gelim_t*, int*, int, int*, int*, int*, int*); +void updateDegree(gelim_t*, int*, int, int*); +void updateScore(gelim_t*, int*, int, int, int*); +elimtree_t* extractElimTree(gelim_t*); + +/* functions in lib/bucket.c */ +bucket_t* newBucket(int, int, int); +void freeBucket(bucket_t*); +bucket_t* setupBucket(int, int, int); +int minBucket(bucket_t*); +void insertBucket(bucket_t*, int, int); +void removeBucket(bucket_t*, int); + +/* functions in lib/minpriority.c */ +minprior_t* newMinPriority(int nvtx, int nstages); +void freeMinPriority(minprior_t*); +minprior_t* setupMinPriority(multisector_t*); +elimtree_t* orderMinPriority(minprior_t*, options_t*, timings_t*); +void eliminateStage(minprior_t*, int, int, timings_t*); +int eliminateStep(minprior_t*, int, int); + +/* functions in lib/tree.c */ +elimtree_t* newElimTree(int, int); +void freeElimTree(elimtree_t*); +void printElimTree(elimtree_t *); +int firstPostorder(elimtree_t*); +int firstPostorder2(elimtree_t*, int); +int nextPostorder(elimtree_t*, int); +int firstPreorder(elimtree_t*); +int nextPreorder(elimtree_t*, int); +elimtree_t* setupElimTree(graph_t*, int*, int*); +void initFchSilbRoot(elimtree_t*); +void permFromElimTree(elimtree_t*, int*); +elimtree_t* expandElimTree(elimtree_t*, int*, int); +elimtree_t* permuteElimTree(elimtree_t*, int*); +elimtree_t* fundamentalFronts(elimtree_t*); +elimtree_t* mergeFronts(elimtree_t*, int); +elimtree_t* compressElimTree(elimtree_t*, int*, int); +int justifyFronts(elimtree_t*); +int nWorkspace(elimtree_t*); +int nFactorIndices(elimtree_t*); +int nFactorEntries(elimtree_t*); +FLOAT nFactorOps(elimtree_t*); +void subtreeFactorOps(elimtree_t*, FLOAT*); +FLOAT nTriangularOps(elimtree_t*); + +/* functions in lib/matrix.c */ +inputMtx_t* newInputMtx(int, int); +void freeInputMtx(inputMtx_t*); +void printInputMtx(inputMtx_t*); +denseMtx_t* newDenseMtx(workspace_t*, int); +void freeDenseMtx(denseMtx_t*); +void printDenseMtx(denseMtx_t*); +void checkDenseMtx(denseMtx_t*); +workspace_t* initWorkspaceForDenseMtx(int, int); +FLOAT* getWorkspaceForDenseMtx(workspace_t*, int); +void freeWorkspaceForDenseMtx(workspace_t*); +inputMtx_t* setupInputMtxFromGraph(graph_t*); +inputMtx_t* setupLaplaceMtx(int, int, int); +inputMtx_t* permuteInputMtx(inputMtx_t*, int*); + +/* functions in lib/symbfac.c */ +css_t* newCSS(int, int, int); +void freeCSS(css_t*); +css_t* setupCSSFromGraph(graph_t*, int*, int*); +css_t* setupCSSFromFrontSubscripts(frontsub_t*); +frontsub_t* newFrontSubscripts(elimtree_t*); +void freeFrontSubscripts(frontsub_t*); +void printFrontSubscripts(frontsub_t*); +frontsub_t* setupFrontSubscripts(elimtree_t*, inputMtx_t*); +factorMtx_t* newFactorMtx(int); +void freeFactorMtx(factorMtx_t*); +void printFactorMtx(factorMtx_t*); +void initFactorMtx(factorMtx_t *L, inputMtx_t*); +void initFactorMtxNEW(factorMtx_t *L, inputMtx_t*); + +/* functions in lib/numfac.c */ +void numfac(factorMtx_t *L, timings_t *cpus); +denseMtx_t* setupFrontalMtx(workspace_t*, factorMtx_t*, int); +void initLocalIndices(denseMtx_t*, int*, int*); +denseMtx_t* extendedAdd(denseMtx_t*, denseMtx_t*, int*, int*); +denseMtx_t* setupUpdateMtxFromFrontalMtx(denseMtx_t*, factorMtx_t*); + +/* functions in lib/kernel.c */ +denseMtx_t* factorize1x1Kernel(denseMtx_t*, int); +denseMtx_t* factorize2x2Kernel(denseMtx_t*, int); +denseMtx_t* factorize3x3Kernel(denseMtx_t*, int); + +/* functions in lib/triangular.c */ +void forwardSubst1x1(factorMtx_t*, FLOAT*); +void backwardSubst1x1(factorMtx_t*, FLOAT*); +void forwardSubst1x1NEW(factorMtx_t*, FLOAT*); +void backwardSubst1x1NEW(factorMtx_t*, FLOAT*); + +/* functions in lib/mapping.c */ +mapping_t* newMapping(elimtree_t*, int); +void freeMapping(mapping_t*); +void printMapping(mapping_t*); +void listing(mapping_t*, int, int, int, FLOAT*, FLOAT*); +mapping_t* setupMapping(elimtree_t*, int, int); +void split(mapping_t*, int, int, int, int*, int*, FLOAT*, int); + +/* functions in lib/interface.c */ +elimtree_t* SPACE_ordering(graph_t*, options_t*, timings_t*); +elimtree_t* SPACE_transformElimTree(elimtree_t*, int); +factorMtx_t* SPACE_symbFac(elimtree_t*, inputMtx_t*); +void SPACE_numFac(factorMtx_t*, timings_t*); +void SPACE_solveTriangular(factorMtx_t *L, FLOAT *rhs, FLOAT *xvec); +void SPACE_solve(inputMtx_t*, FLOAT*, FLOAT*, options_t*, + timings_t*); +void SPACE_solveWithPerm(inputMtx_t*, int*, FLOAT*, FLOAT*, + options_t*, timings_t*); +mapping_t* SPACE_mapping(graph_t*, int*, options_t*, timings_t*); + +/* functions in lib/sort.c */ +void insertUpInts(int, int*); +void insertUpIntsWithStaticIntKeys(int, int*, int*); +void insertDownIntsWithStaticFloatKeys(int, int*, FLOAT*); +void insertUpFloatsWithIntKeys(int, FLOAT*, int*); +void qsortUpInts(int, int*, int*); +void qsortUpFloatsWithIntKeys(int, FLOAT*, int*, int*); +void distributionCounting(int, int*, int*); + +/* functions in lib/read.c */ +graph_t* readChacoGraph(char*); +inputMtx_t* readHarwellBoeingMtx(char*); + +/* functions in libPAR/topology.c */ +topology_t* newTopology(int); +void freeTopology(topology_t*); +void printTopology(topology_t*); +topology_t* setupTopology(void); +void recMapCube(topology_t*, int, int, int, int, int, int); +void sendCube(topology_t*, void*, size_t, int); +size_t recvCube(topology_t*, void*, size_t, int); +int myrank(void); + +/* functions in libPAR/mask.c */ +mask_t* newMask(int); +void freeMask(mask_t*); +mask_t* setupMask(int, int, int); + +/* functions in libPAR/broadcast.c */ +void broadcastInputMtx(topology_t*, inputMtx_t**); +void broadcastElimTree(topology_t*, elimtree_t**); +void broadcastArray(topology_t*, char*, size_t); + +/* functions in libPAR/buffer.c */ +buffer_t* newBuffer(size_t); +void freeBuffer(buffer_t*); +buffer_t* exchangeBuffer(topology_t*, buffer_t*, int); +buffer_t* setupSymbFacBuffer(frontsub_t*, int*); +void readoutSymbFacBuffer(buffer_t*, frontsub_t*, int*); +buffer_t* setupNumFacBuffer(workspace_t*, mask_t*, int); +void readoutNumFacBuffer(workspace_t*, buffer_t*, denseMtx_t**); +buffer_t* setupTriangularBuffer(frontsub_t*, int*, FLOAT*); +void readoutTriangularBuffer(buffer_t*, frontsub_t*, int*, FLOAT*); + +/* functions in libPAR/symbfacPAR.c */ +frontsub_t* newFrontSubscriptsPAR(mask_t*, mapping_t*, elimtree_t*); +frontsub_t* setupFrontSubscriptsPAR(topology_t*, mask_t*, mapping_t*, + elimtree_t*, inputMtx_t*); +css_t* setupCSSFromFrontSubscriptsPAR(mask_t*, mapping_t*, + frontsub_t*); +void initFactorMtxPAR(mask_t*, mapping_t*, factorMtx_t*, + inputMtx_t*); + +/* functions in libPAR/numfacPAR.c */ +void numfacPAR(topology_t*, mask_t*, mapping_t*, factorMtx_t*, + int msglvl, timings_t*); +denseMtx_t* setupFrontalMtxPAR(mask_t*, int, workspace_t*, factorMtx_t*, + int); +void initLocalIndicesPAR(denseMtx_t*, int*, int*); +denseMtx_t* extendedAddPAR(denseMtx_t*, denseMtx_t*, int*, int*); +denseMtx_t* setupUpdateMtxFromFrontalMtxPAR(denseMtx_t*, factorMtx_t*); +denseMtx_t* setupUpdateMtxFromBuffer(workspace_t*, FLOAT*); +void splitDenseMtxColumnWise(denseMtx_t*, mask_t*, buffer_t*, int); +void splitDenseMtxRowWise(denseMtx_t*, mask_t*, buffer_t*, int); + +/* functions in libPAR/kernelPAR.c */ +denseMtx_t* factorize1x1KernelPAR(topology_t*, mask_t*, int, denseMtx_t*, + frontsub_t*, timings_t*); +denseMtx_t* factorize2x2KernelPAR(topology_t*, mask_t*, int, denseMtx_t*, + frontsub_t*, timings_t*); +denseMtx_t* factorize3x3KernelPAR(topology_t*, mask_t*, int, denseMtx_t*, + frontsub_t*, timings_t*); + +/* functions in libPAR/triangularPAR.c */ +void forwardSubst1x1PAR(topology_t*, mask_t*, mapping_t*, + factorMtx_t*, FLOAT*, FLOAT*); +void backwardSubst1x1PAR(topology_t*, mask_t*, mapping_t*, + factorMtx_t*, FLOAT*); +void forwardSubst1x1KernelPAR(topology_t*, mask_t*, int, int, + factorMtx_t*, FLOAT*, FLOAT*); +void backwardSubst1x1KernelPAR(topology_t*, mask_t*, int, int, + factorMtx_t*, FLOAT*); +void accumulateVector(topology_t*, mask_t*, mapping_t*, + factorMtx_t*, FLOAT*); + +/* functions in libPAR/interfacePAR.c */ +topology_t* SPACE_setupTopology(void); +mask_t* SPACE_setupMask(topology_t*, int); +void SPACE_cleanup(topology_t*, mask_t*); +factorMtx_t* SPACE_symbFacPAR(topology_t*, mask_t*, mapping_t*, elimtree_t*, + inputMtx_t*); +void SPACE_numFacPAR(topology_t*, mask_t*, mapping_t*, factorMtx_t*, + int msglvl, timings_t*); +void SPACE_solveTriangularPAR(topology_t*, mask_t*, mapping_t*, + factorMtx_t*, FLOAT*, FLOAT*); +void SPACE_solveWithPermPAR(topology_t *top, mask_t *mask, + inputMtx_t *A, int *perm, FLOAT *rhs, FLOAT *xvec, + options_t *options, timings_t *cpus); + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/space.h b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/space.h new file mode 100644 index 000000000..5d41c7f69 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/space.h @@ -0,0 +1,65 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: space.h +/ +/ author J"urgen Schulze, University of Paderborn +/ created 99sep14 +/ +/ This file includes all necessary header files +/ +******************************************************************************/ + +#include +#include +#include +#include +#include +#ifndef _WIN32 +#include +#endif +#if defined(__MINGW32__) +#include +#endif +#include + +#ifdef PARIX +#ifdef __EPX +#include +#include +#include +#include +#include +#include +#include +#else +#include +#include +#include +#include +#include +#include +#include +#endif +#include +#endif + +#ifdef MPI +#include "mpi.h" +#endif + +#include "const.h" +#include "params.h" +#include "macros.h" +#include "types.h" +#include "protos.h" +#include "eval.h" + +#define FORTRAN(nu,nl,pl,pc) \ +void nu (); \ +void nl pl \ +{ nu pc; } \ +void nl##_ pl \ +{ nu pc; } \ +void nl##__ pl \ +{ nu pc; } \ +void nu pl diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/types.h b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/types.h new file mode 100644 index 000000000..de1305562 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/include/types.h @@ -0,0 +1,281 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: types.h +/ +/ author J"urgen Schulze, University of Paderborn +/ created 99sep14 +/ +/ This file contains the fundamental data structures +/ +******************************************************************************/ + +typedef double FLOAT; +typedef int options_t; +typedef FLOAT timings_t; + +/***************************************************************************** +Graph object +******************************************************************************/ +typedef struct _graph { + int nvtx; + int nedges; + int type; + int totvwght; + int *xadj; + int *adjncy; + int *vwght; +} graph_t; + +/***************************************************************************** +Graph bisection object +******************************************************************************/ +typedef struct _gbisect { + graph_t *G; + int *color; + int cwght[3]; +} gbisect_t; + +/***************************************************************************** +Domain decomposition object +******************************************************************************/ +typedef struct _domdec { + graph_t *G; + int ndom; + int domwght; + int *vtype; + int *color; + int cwght[3]; + int *map; + struct _domdec *prev, *next; +} domdec_t; + +/***************************************************************************** +Bipartite graph object +******************************************************************************/ +typedef struct _gbipart { + graph_t *G; + int nX; + int nY; +} gbipart_t; + +/***************************************************************************** +Recursive nested dissection object +******************************************************************************/ +typedef struct _nestdiss { + graph_t *G; + int *map; + int depth; + int nvint; + int *intvertex; + int *intcolor; + int cwght[3]; + struct _nestdiss *parent, *childB, *childW; +} nestdiss_t; + +/***************************************************************************** +Multisector object +******************************************************************************/ +typedef struct _multisector { + graph_t *G; + int *stage; + int nstages; + int nnodes; + int totmswght; +} multisector_t; + +/***************************************************************************** +Elimination graph object +******************************************************************************/ +typedef struct _gelim { + graph_t *G; + int maxedges; + int *len; + int *elen; + int *parent; + int *degree; + int *score; +} gelim_t; + +/***************************************************************************** +Bucket structure object +******************************************************************************/ +typedef struct _bucket { + int maxbin, maxitem; + int offset; + int nobj; + int minbin; + int *bin; + int *next; + int *last; + int *key; +} bucket_t; + +/***************************************************************************** +Minimum priority object +******************************************************************************/ +typedef struct _stageinfo stageinfo_t; +typedef struct _minprior { + gelim_t *Gelim; + multisector_t *ms; + bucket_t *bucket; + stageinfo_t *stageinfo; + int *reachset; + int nreach; + int *auxaux; + int *auxbin; + int *auxtmp; + int flag; +} minprior_t; +struct _stageinfo { + int nstep; + int welim; + int nzf; + FLOAT ops; +}; + +/***************************************************************************** +Elimination tree object +******************************************************************************/ +typedef struct _elimtree { + int nvtx; + int nfronts; + int root; + int *ncolfactor; + int *ncolupdate; + int *parent; + int *firstchild; + int *silbings; + int *vtx2front; +} elimtree_t; + +/***************************************************************************** +Input matrix object +******************************************************************************/ +typedef struct _inputMtx { + int neqs; + int nelem; + FLOAT *diag; + FLOAT *nza; + int *xnza; + int *nzasub; +} inputMtx_t; + +/***************************************************************************** +Dense matrix object +******************************************************************************/ +typedef struct _workspace workspace_t; +typedef struct _denseMtx { + workspace_t *ws; + int front; + int owned; + int ncol; + int nrow; + int nelem; + int nfloats; + int *colind; + int *rowind; + int *collen; + FLOAT *entries; + FLOAT *mem; + struct _denseMtx *prevMtx, *nextMtx; +} denseMtx_t; +struct _workspace { + FLOAT *mem; + int size; + int maxsize; + int incr; + denseMtx_t *lastMtx; +}; + +/***************************************************************************** +Compressed subscript structure object +******************************************************************************/ +typedef struct _css { + int neqs; + int nind; + int owned; + int *xnzl; + int *nzlsub; + int *xnzlsub; +} css_t; + +/***************************************************************************** +Front subscript object +******************************************************************************/ +typedef struct _frontsub { + elimtree_t *PTP; + int nind; + int *xnzf; + int *nzfsub; +} frontsub_t; + +/***************************************************************************** +Factor matrix object +******************************************************************************/ +typedef struct _factorMtx { + int nelem; + int *perm; + FLOAT *nzl; + css_t *css; + frontsub_t *frontsub; +} factorMtx_t; + +/***************************************************************************** +Mapping object +******************************************************************************/ +typedef struct _groupinfo groupinfo_t; +typedef struct { + elimtree_t *T; + int dimQ; + int maxgroup; + int *front2group; + groupinfo_t *groupinfo; +} mapping_t; +struct _groupinfo { + FLOAT ops; + int nprocs; + int nfronts; +}; + +/***************************************************************************** +Topology object +******************************************************************************/ +typedef struct { + int nprocs; + int mygridId; + int dimX; + int dimY; + int myQId; + int dimQ; + int *cube2grid; +#ifdef PARIX + LinkCB_t **link; +#endif +#ifdef MPI + MPI_Comm comm; + MPI_Status status; +#endif +} topology_t; + +/***************************************************************************** +Communication buffer object +******************************************************************************/ +typedef struct { + char *data; + size_t len; + size_t maxlen; +} buffer_t; + +/***************************************************************************** +Bit mask object +******************************************************************************/ +typedef struct { + int dimQ; + int maxgroup; + int mygroupId; + int offset; + int *group; + int *colbits, *colmask; + int *rowbits, *rowmask; +} mask_t; + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/Makefile b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/Makefile new file mode 100644 index 000000000..de56d2384 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/Makefile @@ -0,0 +1,32 @@ + +# To compile directly, uncomment the line below. +# include ../Make.in +# +# Otherwise, adequate variables for CC, CFLAGS, AR and +# RANLIB must be passed to make. +# + +INCLUDES = -I../include + +COPTIONS = $(INCLUDES) $(CFLAGS) $(OPTFLAGS) + +OBJS = graph.o gbipart.o gbisect.o ddcreate.o ddbisect.o nestdiss.o \ + multisector.o gelim.o bucket.o tree.o \ + symbfac.o interface.o sort.o minpriority.o + +# Note: numfac.c read.c mapping.c triangular.c matrix.c kernel.c +# were not direcly used by MUMPS and have been removed from the +# original SPACE package. + +.c.o: + $(CC) $(COPTIONS) -c $*.c $(OUTC)$*.o + +libpord$(LIBEXT):$(OBJS) + $(AR)$@ $(OBJS) + $(RANLIB) $@ + +clean: + rm -f *.o + +realclean: + rm -f *.o libpord.a diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/bucket.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/bucket.c new file mode 100644 index 000000000..10d10a02d --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/bucket.c @@ -0,0 +1,246 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: bucket.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 12/06/00 +/ +/ This file contains functions dealing with buckets. +/ +****************************************************************************** + +Data type: struct bucket + int maxbin; maximal bin in bucket + int maxitem; maximal item that can be stored in bucket + int offset; to store items with negative key-value + int nobj; number of items in bucket + int minbin; leftmost non-empty bin + int *bin; there are maxbin+1 bins (bin[0]...bin[maxbin]) + int *next; next[item] points to next item in bin + int *last; last[item] points to previous item in bin + int *key; holds key of item (MAX_INT if item not in bucket) +Comments: + o Any implementation of a bucket should enable insert/remove operations in + constant time + o There a two special bins: + bin[0] contains all items u with key[u] + offset < 0 + bin[maxbin] contains all items u with key[u] + offset > maxbin +Methods in lib/bucket.c: +- bucket = newBucket(int maxbin, int maxitem, int offset); + o Initial: nobj = 0 and minbin = MAX_INT +- void freeBucket(bucket_t *bucket); +- bucket = setupBucket(int maxbin, int maxitem, int offset); + o allocates memory for the bucket by calling newBucket and initializes + the vectors, i.e. bin[i] = -1 for all 0 <= i <= maxbin, + next[u] = last[u] = -1, and key[u] = MAX_INT for all 0 <= u <= maxitem +- int minBucket(bucket_t *bucket); + o returns the item whose key-value is minimal; this item is stored in + bin[minbin]; if minbin = 0 or minbin = maxbin, the whole bin must be + searched, since the items stored herein may have different keys + o if nobj = 0, the function returns -1 +- void insertBucket(bucket_t *bucket, int k, int item); + o insert item with key k in bucket; if key[item] != MAX_INT (i.e. item + already in bucket) or if item > maxitem the program terminates +- void removeBucket(bucket_t *bucket, int item); + o removes item from bucket; if key[item] == MAX_INT (i.e. item not in + bucket) the program terminates + +******************************************************************************/ + +#include + + +/****************************************************************************** +******************************************************************************/ +bucket_t* +newBucket(int maxbin, int maxitem, int offset) +{ bucket_t *bucket; + + mymalloc(bucket, 1, bucket_t); + mymalloc(bucket->bin, (maxbin+1), int); + mymalloc(bucket->next, (maxitem+1), int); + mymalloc(bucket->last, (maxitem+1), int); + mymalloc(bucket->key, (maxitem+1), int); + + bucket->maxbin = maxbin; + bucket->maxitem = maxitem; + bucket->offset = offset; + bucket->nobj = 0; + bucket->minbin = MAX_INT; + + return(bucket); +} + + +/****************************************************************************** +******************************************************************************/ +void +freeBucket(bucket_t *bucket) +{ + free(bucket->bin); + free(bucket->next); + free(bucket->last); + free(bucket->key); + free(bucket); +} + + +/****************************************************************************** +******************************************************************************/ +bucket_t* +setupBucket(int maxbin, int maxitem, int offset) +{ bucket_t *bucket; + int i, u; + + if (offset < 0) + { fprintf(stderr, "\nError in function setupBucket\n" + " offset must be >= 0\n"); + quit(); + } + + bucket = newBucket(maxbin, maxitem, offset); + + for (i = 0; i <= maxbin; i++) + bucket->bin[i] = -1; + for (u = 0; u <= maxitem; u++) + { bucket->next[u] = bucket->last[u] = -1; + bucket->key[u] = MAX_INT; + } + + return(bucket); +} + + +/****************************************************************************** +******************************************************************************/ +int +minBucket(bucket_t *bucket) +{ int *bin, *next, *key, maxbin, minbin, nobj; + int item, bestitem, bestkey; + + maxbin = bucket->maxbin; + nobj = bucket->nobj; + minbin = bucket->minbin; + bin = bucket->bin; + next = bucket->next; + key = bucket->key; + + if (nobj > 0) + { /* --------------------------------------------- + get the first item from leftmost nonempty bin + --------------------------------------------- */ + while (bin[minbin] == -1) minbin++; + bucket->minbin = minbin; + bestitem = bin[minbin]; + bestkey = minbin; + + /* -------------------------------------------------- + items in bins 0 and maxbin can have different keys + => search for item with smallest key + -------------------------------------------------- */ + if ((minbin == 0) || (minbin == maxbin)) + { item = next[bestitem]; + while (item != -1) + { if (key[item] < bestkey) + { bestitem = item; + bestkey = key[item]; + } + item = next[item]; + } + } + /* --------------------------------- + return the item with smallest key + --------------------------------- */ + return(bestitem); + } + else return(-1); +} + + +/****************************************************************************** +******************************************************************************/ +void +insertBucket(bucket_t *bucket, int k, int item) +{ int s, nextitem; + + /* ------------------------------------ + check whether there are any problems + ------------------------------------ */ + if (abs(k) >= MAX_INT - bucket->offset - 1) + { fprintf(stderr, "\nError in function insertBucket\n" + " key %d too large/small for bucket\n", k); + quit(); + } + if (item > bucket->maxitem) + { fprintf(stderr, "\nError in function insertBucket\n" + " item %d too large for bucket (maxitem is %d)\n", item, + bucket->maxitem); + quit(); + } + if (bucket->key[item] != MAX_INT) + { fprintf(stderr, "\nError in function insertBucket\n" + " item %d already in bucket\n", item); + quit(); + } + + /* ------------------------------------- + determine the bin that holds the item + ------------------------------------- */ + s = max(0, (k + bucket->offset)); + s = min(s, bucket->maxbin); + + /* -------------------------------------------------------------- + adjust minbin, increase nobj, and mark item as being in bucket + -------------------------------------------------------------- */ + bucket->minbin = min(bucket->minbin, s); + bucket->nobj++; + bucket->key[item] = k; + + /* ----------------------------- + finally, insert item in bin s + ----------------------------- */ + nextitem = bucket->bin[s]; + if (nextitem != -1) + bucket->last[nextitem] = item; + bucket->next[item] = nextitem; + bucket->last[item] = -1; + bucket->bin[s] = item; +} + + +/****************************************************************************** +******************************************************************************/ +void +removeBucket(bucket_t *bucket, int item) +{ int s, nextitem, lastitem; + + /* ---------------------------- + check whether item in bucket + ---------------------------- */ + if (bucket->key[item] == MAX_INT) + { fprintf(stderr, "\nError in function removeBucket\n" + " item %d is not in bucket\n", item); + quit(); + } + + /* ----------------------- + remove item from bucket + ----------------------- */ + nextitem = bucket->next[item]; + lastitem = bucket->last[item]; + if (nextitem != -1) + bucket->last[nextitem] = lastitem; + if (lastitem != -1) + bucket->next[lastitem] = nextitem; + else + { s = max(0, (bucket->key[item] + bucket->offset)); + s = min(s, bucket->maxbin); + bucket->bin[s] = nextitem; + } + + /* -------------------------------------------- + decrease nobj and mark item as being removed + -------------------------------------------- */ + bucket->nobj--; + bucket->key[item] = MAX_INT; +} diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/ddbisect.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/ddbisect.c new file mode 100644 index 000000000..6780e8034 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/ddbisect.c @@ -0,0 +1,841 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: ddbisect.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 00mar09 +/ +/ This file contains code for the construction/improvement of a vertex +/ separator for a domain decomposition +/ +****************************************************************************** + +Data type: struct domdec + graph_t *G; pointer to graph object + int ndom; number of domains + int domwght; total weight of domains + int *vtype; type of node (DOMAIN or MULTISEC) + int *color; color of node (GRAY, BLACK, or WHITE) + int cwght[3]; weights of GRAY, BLACK, WHITE partitions + int *map; maps nodes to next coarser domain decomp. + struct domdec *prev; pointer to previous finer domain decomp. + struct domdec *next; pointer to next coarser domain decomp. +Comments: + o Structure holds the domain decompositions constructed by the + coarsening process; it also holds the colorings of the domain decomp. + computed by the refinement process + o vtype[v]: represents the status of a node in the domain decomposition + 0, iff status of v is unknown + 1, iff v is a domain vertex + 2, iff v is a multisector vertex + 3, iff multisec v is eliminated and now forms a domain + 4, iff multisec v is absorbed by another multisec/domain +Methods in lib/ddbisect.c: +- void checkDDSep(domdec_t *dd); +- int findPseudoPeripheralDomain(domdec_t *dd, int domain); + o returns a domain with maximal excentricity by repeated breadth first + search; first bfs starts at node domain +- void constructLevelSep(domdec_t *dd, int domain); + o determines a vertex separator by breadth first search starting at node + domain; +- void initialDDSep(domdec_t *dd); + o computes an initial separator for the domain decomposition dd; + initially, all domains/multisecs are colored black; the function scans + over all connected components of dd; it first calls findPseudoPeripheral- + Domain to obtain a domain with maximal excentricity and then it calls + constructLevelSep for that domain. +- void updateB2W(bucket_t *w_bucket, bucket_t *b_bucket, domdec_t *dd, + int domain, int *tmp_color, int *deltaW, int *deltaB, int *deltaS); + o if domain flips its color from BLACK to WHITE, all neighboring domains + that share a common variable have to be updated (see my PhD thesis) +- void updateW2B(bucket_t *w_bucket, bucket_t *b_bucket, domdec_t *dd, + int domain, int *tmp_color, int *deltaW, int *deltaB, int *deltaS); + o if domain flips its color from WHITE to BLACK, all neighboring domains + that share a common variable have to be updated (see my PhD thesis) +- void improveDDSep(domdec_t *dd); + o Fiducia-Mattheyses variant to improve the coloring/separator of a + domain decomposition (see my PhD thesis) + +******************************************************************************/ + +#include +/* #define DEBUG */ + + +/****************************************************************************** +******************************************************************************/ +void +checkDDSep(domdec_t *dd) +{ int *xadj, *adjncy, *vwght, *vtype, *color, *cwght; + int nvtx, err, u, v, i, istart, istop, nBdom, nWdom; + int checkS, checkB, checkW; + + nvtx = dd->G->nvtx; + xadj = dd->G->xadj; + adjncy = dd->G->adjncy; + vwght = dd->G->vwght; + vtype = dd->vtype; + color = dd->color; + cwght = dd->cwght; + + err = FALSE; + printf("checking separator of domain decomposition (S %d, B %d, W %d)\n", + cwght[GRAY], cwght[BLACK], cwght[WHITE]); + + checkS = checkB = checkW = 0; + for (u = 0; u < nvtx; u++) + /* check neighborhood of multisector nodes */ + if (vtype[u] == 2) + { nBdom = nWdom = 0; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if (color[v] == BLACK) nBdom++; + if (color[v] == WHITE) nWdom++; + } + switch(color[u]) + { case GRAY: + checkS += vwght[u]; + if ((nBdom == 0) || (nWdom == 0)) + printf("WARNING: multisec %d belongs to S, but nBdom = %d and " + "nWdom = %d\n", u, nBdom, nWdom); + break; + case BLACK: + checkB += vwght[u]; + if (nWdom > 0) + { printf("ERROR: black multisec %d adjacent to white domain\n", u); + err = TRUE; + } + break; + case WHITE: + checkW += vwght[u]; + if (nBdom > 0) + { printf("ERROR: white multisec %d adjacent to black domain\n", u); + err = TRUE; + } + break; + default: + printf("ERROR: multisec %d has unrecognized color %d\n", u, + color[u]); + err = TRUE; + } + } + + /* sum up size of white/black domains */ + else /* if (vtype[u] == 1) */ + switch(color[u]) + { case BLACK: + checkB += vwght[u]; break; + case WHITE: + checkW += vwght[u]; break; + default: + printf("ERROR: domain %d has unrecognized color %d\n", u, color[u]); + err = TRUE; + } + + /* check cwght[GRAY], cwght[BLACK], cwght[WHITE] */ + if ((checkS != cwght[GRAY]) || (checkB != cwght[BLACK]) + || (checkW != cwght[WHITE])) + { printf("ERROR in partitioning: checkS %d (S %d), checkB %d (B %d), " + "checkW %d (W %d)\n", checkS, cwght[GRAY], checkB, cwght[BLACK], + checkW, cwght[WHITE]); + err = TRUE; + } + if (err) quit(); +} + + +/***************************************************************************** +******************************************************************************/ +int +findPseudoPeripheralDomain(domdec_t* dd, int domain) +{ int *xadj, *adjncy, *vtype, *level, *queue; + int nvtx, qhead, qtail, nlev, lastdomain, u, v, i, istart, istop; + + nvtx = dd->G->nvtx; + xadj = dd->G->xadj; + adjncy = dd->G->adjncy; + vtype = dd->vtype; + + /* ------------------------ + allocate working storage + ------------------------ */ + mymalloc(level, nvtx, int); + mymalloc(queue, nvtx, int); + + /* --------------------------------------- + find a domain with maximal excentricity + --------------------------------------- */ + nlev = 0; lastdomain = domain; + while (TRUE) + { for (u = 0; u < nvtx; u++) + level[u] = -1; + queue[0] = domain; level[domain] = 0; + qhead = 0; qtail = 1; + while (qhead != qtail) + { u = queue[qhead++]; + if (vtype[u] == 1) /* remember last domain */ + lastdomain = u; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if (level[v] == -1) + { queue[qtail++] = v; + level[v] = level[u] + 1; + } + } + } + if (level[lastdomain] > nlev) + { nlev = level[lastdomain]; + domain = lastdomain; + } + else break; + } + + /* ------------------------------- + free working storage and return + ------------------------------- */ + free(level); free(queue); + return(domain); +} + + +/***************************************************************************** +*****************************************************************************/ +void +constructLevelSep(domdec_t* dd, int domain) +{ int *xadj, *adjncy, *vwght, *vtype, *color, *cwght; + int *queue, *deltaS, *deltaB, *deltaW; + int nvtx, bestvalue, weight, qhead, qtail, qopt, q, dS, dB, dW; + int u, v, w, i, istart, istop, j, jstart, jstop; + + /* ====================================================================== + vtype[u]: (u domain) + 1 => domain u has not been touched yet (not in queue, no color flip) + -1 => domain u is in queue and its deltaS, deltaB, deltaW values + have to be updated + -2 => domain u is in queue and no update necessary + -3 => domain u has flipped its color to black + deltaS[u], deltaB[u], deltaW[u]: + u domain: denotes the change in partition size, if u flips its color + u multisec: deltaB/deltaW denote number of adj. black/white domains + ====================================================================== */ + + nvtx = dd->G->nvtx; + xadj = dd->G->xadj; + adjncy = dd->G->adjncy; + vwght = dd->G->vwght; + vtype = dd->vtype; + color = dd->color; + cwght = dd->cwght; + + /* ------------------------------------------ + allocate working storage + initializations + ------------------------------------------ */ + mymalloc(queue, nvtx, int); + mymalloc(deltaS, nvtx, int); + mymalloc(deltaB, nvtx, int); + mymalloc(deltaW, nvtx, int); + for (u = 0; u < nvtx; u++) + { deltaS[u] = deltaB[u] = deltaW[u] = 0; + if (vtype[u] == 2) + deltaW[u] = xadj[u+1] - xadj[u]; + } + + /* --------------------------------------------- + build a BFS tree rooted at domain + the separator is given by the level structure + --------------------------------------------- */ + queue[0] = domain; + qhead = 0; qtail = 1; + vtype[domain] = -1; + while ((cwght[BLACK] < cwght[WHITE]) && (qhead != qtail)) + { qopt = 0; + bestvalue = MAX_INT; + + /* -------------------------------------------------------------------- + run through queue, update domains if necessary, and find best domain + -------------------------------------------------------------------- */ + for (q = qhead; q < qtail; q++) + { u = queue[q]; + if (vtype[u] == -1) + { dB = vwght[u]; dW = -dB; dS = 0; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; /* color of multisec v */ + weight = vwght[v]; /* is GRAY or WHITE */ + if (color[v] == WHITE) + { dW -= weight; dS += weight; } /* multisec will move to S */ + else if (deltaW[v] == 1) + { dB += weight; dS -= weight; } /* multisec will move to B */ + } + deltaS[u] = dS; deltaB[u] = dB; deltaW[u] = dW; + vtype[u] = -2; + } + if (cwght[GRAY] + deltaS[u] < bestvalue) + { bestvalue = cwght[GRAY] + deltaS[u]; + qopt = q; + } + } + + /* ---------------------------------------------------- + move best domain to head of queue and color it black + ---------------------------------------------------- */ + u = queue[qopt]; + swap(queue[qopt], queue[qhead], v); + qhead++; + color[u] = BLACK; + cwght[GRAY] += deltaS[u]; + cwght[BLACK] += deltaB[u]; + cwght[WHITE] += deltaW[u]; + vtype[u] = -3; + + /* ------------------------------------------------------------ + update all multisecs that are adjacent to domain u and check + domains adjacent to the multisecs + ------------------------------------------------------------ */ + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + deltaB[v]++; deltaW[v]--; + if (deltaW[v] == 0) /* color of multisec v changed to BLACK */ + color[v] = BLACK; + else if (deltaB[v] == 1) /* color of multisec v changed to GRAY */ + { color[v] = GRAY; + jstart = xadj[v]; + jstop = xadj[v+1]; + for (j = jstart; j < jstop; j++) + { w = adjncy[j]; + if (vtype[w] == 1) /* a new domain enters the queue */ + { queue[qtail++] = w; + vtype[w] = -1; + } + else if (vtype[w] == -2) /* update (old) domain in queue */ + vtype[w] = -1; + } + } + else if (deltaW[v] == 1) /* color of multisec v remains GRAY for */ + { jstart = xadj[v]; /* the last time */ + jstop = xadj[v+1]; + for (j = jstart; j < jstop; j++) + { w = adjncy[j]; + if (vtype[w] == -2) + vtype[w] = -1; + } + } + } + } + + /* --------------------------- + reset vtype and free memory + --------------------------- */ + for (i = 0; i < qtail; i++) + { u = queue[i]; + vtype[u] = 1; + } + free(queue); + free(deltaS); free(deltaB); free(deltaW); +} + + +/***************************************************************************** +******************************************************************************/ +void +initialDDSep(domdec_t *dd) +{ int *vtype, *color, *cwght; + int nvtx, totvwght, domain, u; + + nvtx = dd->G->nvtx; + totvwght = dd->G->totvwght; + vtype = dd->vtype; + color = dd->color; + cwght = dd->cwght; + + /* -------------------------------------------------------- + initializations (all nodes are colored white by default) + -------------------------------------------------------- */ + cwght[GRAY] = 0; + cwght[BLACK] = 0; + cwght[WHITE] = totvwght; + for (u = 0; u < nvtx; u++) + color[u] = WHITE; + + /* ---------------------------------------------------------------------- + scan over connected components and create level based vertex separator + ---------------------------------------------------------------------- */ + for (u = 0; u < nvtx; u++) + if ((vtype[u] == 1) && (color[u] == WHITE)) + { domain = findPseudoPeripheralDomain(dd, u); + constructLevelSep(dd, domain); + if (cwght[BLACK] >= cwght[WHITE]) + break; + } +} + + +/***************************************************************************** +*****************************************************************************/ +void +updateB2W(bucket_t *w_bucket, bucket_t *b_bucket, domdec_t *dd, int domain, + int *tmp_color, int *deltaW, int *deltaB, int *deltaS) +{ int *xadj, *adjncy, *vwght, *vtype; + int weight, u, v, i, istart, istop, j, jstart, jstop; + + xadj = dd->G->xadj; + adjncy = dd->G->adjncy; + vwght = dd->G->vwght; + vtype = dd->vtype; + + istart = xadj[domain]; + istop = xadj[domain+1]; + for (i = istart; i < istop; i++) + { u = adjncy[i]; + weight = vwght[u]; + jstart = xadj[u]; + jstop = xadj[u+1]; + + /* --------------------------------------------------------------- + subcase (1): before flipping domain to WHITE there was only one + other WHITE domain v. update deltaB[v] and deltaS[v] + --------------------------------------------------------------- */ + if (deltaW[u] < 0) + { v = -(deltaW[u]+1); + deltaW[u] = 1; + +#ifdef DEBUG + printf(" B2W case (1): (via multisec %d) removing domain %d from " + "w_bucket\n", u, v); +#endif + + removeBucket(w_bucket, v); + deltaB[v] -= weight; deltaS[v] += weight; + insertBucket(w_bucket, deltaS[v], v); + } + + /* --------------------------------------------------------------- + subcase (2): all other domains are BLACK. update deltaB, deltaS + of these BLACK domains. NOTE: subcase (3) may directly follow + --------------------------------------------------------------- */ + if (deltaW[u] == 0) + { tmp_color[u] = GRAY; + for (j = jstart; j < jstop; j++) + { v = adjncy[j]; + if (vtype[v] == 1) + { +#ifdef DEBUG + printf(" B2W case (2): (via multisec %d) removing domain %d from " + "b_bucket\n", u, v); +#endif + + removeBucket(b_bucket, v); + deltaB[v] += weight; deltaS[v] -= weight; + insertBucket(b_bucket, deltaS[v], v); + } + } + } + + if (deltaB[u] < 0) deltaB[u] = 1; /* the unique BLACK dom. flipped */ + deltaB[u]--; deltaW[u]++; + + /* ------------------------------------------------------------- + subcase (3): after flipping domain to WHITE there is only one + remaining BLACK domain. search it and update deltaW, deltaS + furthermore, store the remaining BLACK domain in deltaB[u] + ------------------------------------------------------------- */ + if (deltaB[u] == 1) + { for (j = jstart; j < jstop; j++) + { v = adjncy[j]; + if ((tmp_color[v] == BLACK) && (vtype[v] == 1)) + { +#ifdef DEBUG + printf(" B2W case (3): (via multisec %d) removing domain %d from " + "b_bucket\n", u, v); +#endif + + removeBucket(b_bucket, v); + deltaW[v] += weight; deltaS[v] -= weight; + deltaB[u] = -(v+1); + insertBucket(b_bucket, deltaS[v], v); + } + } + } + + /* ------------------------------------------------------------- + subcase (4): after flipping domain to WHITE there is no other + BLACK domain. update deltaW, deltaS of the WHITE domains + ------------------------------------------------------------- */ + if (deltaB[u] == 0) + { tmp_color[u] = WHITE; + for (j = jstart; j < jstop; j++) + { v = adjncy[j]; + if (vtype[v] == 1) + { +#ifdef DEBUG + printf(" B2W case (4): (via multisec %d) removing domain %d from " + "w_bucket\n", u, v); +#endif + + removeBucket(w_bucket, v); + deltaW[v] -= weight; deltaS[v] += weight; + insertBucket(w_bucket, deltaS[v], v); + } + } + } + } +} + + +/***************************************************************************** +*****************************************************************************/ +void +updateW2B(bucket_t *w_bucket, bucket_t *b_bucket, domdec_t *dd, int domain, + int *tmp_color, int *deltaW, int *deltaB, int *deltaS) +{ int *xadj, *adjncy, *vwght, *vtype; + int weight, u, v, i, istart, istop, j, jstart, jstop; + + xadj = dd->G->xadj; + adjncy = dd->G->adjncy; + vwght = dd->G->vwght; + vtype = dd->vtype; + + istart = xadj[domain]; + istop = xadj[domain+1]; + for (i = istart; i < istop; i++) + { u = adjncy[i]; + weight = vwght[u]; + jstart = xadj[u]; + jstop = xadj[u+1]; + + /* --------------------------------------------------------------- + subcase (1): before flipping domain to BLACK there was only one + other BLACK domain v. update deltaW[v] and deltaS[v] + --------------------------------------------------------------- */ + if (deltaB[u] < 0) + { v = -(deltaB[u]+1); + deltaB[u] = 1; + +#ifdef DEBUG + printf(" W2B case (1): (via multisec %d) removing domain %d from " + "b_bucket\n", u, v); +#endif + + removeBucket(b_bucket, v); + deltaW[v] -= weight; deltaS[v] += weight; + insertBucket(b_bucket, deltaS[v], v); + } + + /* --------------------------------------------------------------- + subcase (2): all other domains are WHITE. update deltaW, deltaS + of these WHITE domains. NOTE: subcase (3) may directly follow + --------------------------------------------------------------- */ + if (deltaB[u] == 0) + { tmp_color[u] = GRAY; + for (j = jstart; j < jstop; j++) + { v = adjncy[j]; + if (vtype[v] == 1) + { +#ifdef DEBUG + printf(" W2B case (2): (via multisec %d) removing domain %d from " + "w_bucket\n", u, v); +#endif + + removeBucket(w_bucket, v); + deltaW[v] += weight; deltaS[v] -= weight; + insertBucket(w_bucket, deltaS[v], v); + } + } + } + + if (deltaW[u] < 0) deltaW[u] = 1; /* the unique WHITE dom. flipped */ + deltaB[u]++; deltaW[u]--; + + /* ------------------------------------------------------------- + subcase (3): after flipping domain to BLACK there is only one + remaining WHITE domain. search it and update deltaB, deltaS + furthermore, store the remaining WHITE domain in deltaW[u] + ------------------------------------------------------------- */ + if (deltaW[u] == 1) + { for (j = jstart; j < jstop; j++) + { v = adjncy[j]; + if ((tmp_color[v] == WHITE) && (vtype[v] == 1)) + { +#ifdef DEBUG + printf(" W2B case (3): (via multisec %d) removing domain %d from " + "w_bucket\n", u, v); +#endif + + removeBucket(w_bucket, v); + deltaB[v] += weight; deltaS[v] -= weight; + deltaW[u] = -(v+1); + insertBucket(w_bucket, deltaS[v], v); + } + } + } + + /* --------------------------------------------------------------- + subcase (4): after flipping domain to BLACK there is no other + WHITE domain. update deltaB, deltaS of the BLACK domains + --------------------------------------------------------------- */ + if (deltaW[u] == 0) + { tmp_color[u] = BLACK; + for (j = jstart; j < jstop; j++) + { v = adjncy[j]; + if (vtype[v] == 1) + { +#ifdef DEBUG + printf(" W2B case (4): (via multisec %d) removing domain %d from " + "b_bucket\n", u, v); +#endif + + removeBucket(b_bucket, v); + deltaB[v] -= weight; deltaS[v] += weight; + insertBucket(b_bucket, deltaS[v], v); + } + } + } + } +} + + +/***************************************************************************** +******************************************************************************/ +void +improveDDSep(domdec_t *dd) +{ bucket_t *b_bucket, *w_bucket; + int *xadj, *adjncy, *vwght, *vtype, *color, *cwght; + int *tmp_color, *deltaS, *deltaB, *deltaW; + int nvtx, weight, tmp_S, tmp_B, tmp_W; + int pos, bestglobalpos, badflips, b_domain, w_domain, domain, nxtdomain; + int fhead, ftail, u, v, i, istart, istop; + FLOAT bestglobalvalue, b_value, w_value, value; + + /* ====================================================================== + vtype[u]: (u domain) + 1 => color of domain u has not been changed + < 0 => points to next domain in flipping list + (fhead points to first, ftail points to last domain in list) + = 0 => domain is last domain in flipping list + ====================================================================== */ + + nvtx = dd->G->nvtx; + xadj = dd->G->xadj; + adjncy = dd->G->adjncy; + vwght = dd->G->vwght; + vtype = dd->vtype; + color = dd->color; + cwght = dd->cwght; + + mymalloc(tmp_color, nvtx, int); + mymalloc(deltaS, nvtx, int); + mymalloc(deltaB, nvtx, int); + mymalloc(deltaW, nvtx, int); + +OUTER_LOOP_START: + + /* ---------------------------------------------------------------------- + copy data of actual bisection and initialize buckets and flipping list + ---------------------------------------------------------------------- */ + tmp_S = cwght[GRAY]; + tmp_B = cwght[BLACK]; + tmp_W = cwght[WHITE]; + bestglobalpos = badflips = 0; + bestglobalvalue = F(tmp_S, tmp_B, tmp_W); + + b_bucket = setupBucket(nvtx, nvtx, (nvtx >> 1)); + w_bucket = setupBucket(nvtx, nvtx, (nvtx >> 1)); + + fhead = 0; ftail = -1; + pos = 0; + + /* ---------------------------------------------------------- + initialize tmp_color, deltaB, and deltaW for all multisecs + ---------------------------------------------------------- */ + for (u = 0; u < nvtx; u++) + if (vtype[u] == 2) + { deltaB[u] = deltaW[u] = 0; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if (color[v] == BLACK) deltaB[u]++; + else deltaW[u]++; + } + if ((deltaB[u] > 0) && (deltaW[u] > 0)) /* update multisec coloring */ + tmp_color[u] = GRAY; + else if (deltaB[u] > 0) tmp_color[u] = BLACK; + else tmp_color[u] = WHITE; + color[u] = tmp_color[u]; + } + + /* ----------------------------------------------------------------- + initialize tmp_color, deltaS,B,W for all domains and fill buckets + ----------------------------------------------------------------- */ + for (u = 0; u < nvtx; u++) + if (vtype[u] == 1) + { tmp_color[u] = color[u]; + if (tmp_color[u] == BLACK) /* domain may be flipped to WHITE */ + { deltaW[u] = vwght[u]; deltaB[u] = -deltaW[u]; deltaS[u] = 0; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; /* tmp_color[v] e {GRAY, BLACK} */ + weight = vwght[v]; + if (tmp_color[v] == BLACK) /* multisec v will move into S */ + { deltaB[u] -= weight; + deltaS[u] += weight; + } + else if (deltaB[v] == 1) /* multisec v will move into W */ + { deltaW[u] += weight; + deltaS[u] -= weight; + deltaB[v] = -(u+1); + } + } + insertBucket(b_bucket, deltaS[u], u); + } + if (tmp_color[u] == WHITE) /* domain may be flipped to BLACK */ + { deltaB[u] = vwght[u]; deltaW[u] = -deltaB[u]; deltaS[u] = 0; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; /* tmp_color[v] e {GRAY, WHITE} */ + weight = vwght[v]; + if (tmp_color[v] == WHITE) /* multisec v will move into S */ + { deltaW[u] -= weight; + deltaS[u] += weight; + } + else if (deltaW[v] == 1) /* multisec v will move into B */ + { deltaB[u] += weight; + deltaS[u] -= weight; + deltaW[v] = -(u+1); + } + } + insertBucket(w_bucket, deltaS[u], u); + } + } + +#ifdef DEBUG + printf("starting inner loop: b_bucket->nobj %d, w_bucket->nobj %d\n", + b_bucket->nobj, w_bucket->nobj); + waitkey(); +#endif + +INNER_LOOP_START: + + /* ------------------------------------------- + extract best domain from b_bucket, w_bucket + ------------------------------------------- */ + b_value = w_value = MAX_FLOAT; + if ((b_domain = minBucket(b_bucket)) != -1) + { b_value = F((tmp_S+deltaS[b_domain]), (tmp_B+deltaB[b_domain]), + (tmp_W+deltaW[b_domain])); + +#ifdef DEBUG + printf("best black domain: %d, deltaS %d, deltaB %d, deltaW %d, " + "cost %7.2f\n", b_domain, deltaS[b_domain], deltaB[b_domain], + deltaW[b_domain], b_value); +#endif + } + if ((w_domain = minBucket(w_bucket)) != -1) + { w_value = F((tmp_S+deltaS[w_domain]), (tmp_B+deltaB[w_domain]), + (tmp_W+deltaW[w_domain])); + +#ifdef DEBUG + printf("best white domain: %d, deltaS %d, deltaB %d, deltaW %d, " + "cost %7.2f\n", w_domain, deltaS[w_domain], deltaB[w_domain], + deltaW[w_domain], w_value); +#endif + } + + if ((b_domain == ERR) && (w_domain == ERR)) goto INNER_LOOP_END; + + if (b_value + EPS < w_value) + { domain = b_domain; value = b_value; + removeBucket(b_bucket, domain); + } + else + { domain = w_domain; value = w_value; + removeBucket(w_bucket, domain); + } + +#ifdef DEBUG + printf(" domain %d removed from bucket\n", domain); +#endif + + /* ------------------------------------------------------------------- + flip the color of domain and put it in list of log. flipped domains + ------------------------------------------------------------------- */ + if (ftail != -1) + vtype[ftail] = -(domain+1); /* append domain */ + else fhead = -(domain+1); /* list starts with domain */ + vtype[domain] = 0; /* mark end of list */ + ftail = domain; /* domain is last element in list */ + + if (tmp_color[domain] == BLACK) + { tmp_color[domain] = WHITE; + updateB2W(w_bucket,b_bucket,dd,domain,tmp_color,deltaW,deltaB,deltaS); + } + else if (tmp_color[domain] == WHITE) + { tmp_color[domain] = BLACK; + updateW2B(w_bucket,b_bucket,dd,domain,tmp_color,deltaW,deltaB,deltaS); + } + tmp_S += deltaS[domain]; + tmp_B += deltaB[domain]; + tmp_W += deltaW[domain]; + + pos++; + if (value + EPS < bestglobalvalue) + { bestglobalvalue = value; + bestglobalpos = pos; + badflips = 0; + } + else badflips++; + if (badflips < MAX_BAD_FLIPS) goto INNER_LOOP_START; + +INNER_LOOP_END: + + /* -------------------------------------------- + end of inner loop: now do the physical flips + -------------------------------------------- */ + pos = 0; + nxtdomain = fhead; + while (nxtdomain != 0) + { domain = -nxtdomain - 1; + if (pos < bestglobalpos) + { if (color[domain] == BLACK) color[domain] = WHITE; + else color[domain] = BLACK; + cwght[GRAY] += deltaS[domain]; + cwght[BLACK] += deltaB[domain]; + cwght[WHITE] += deltaW[domain]; + pos++; + } + nxtdomain = vtype[domain]; + vtype[domain] = 1; + } + + /* ---------------------------------------------- + partition improved => re-start the whole stuff + ---------------------------------------------- */ +#ifdef DEBUG + printf(" INNER_LOOP_END (#pyhs. flips %d): S %d, B %d, W %d (%7.2f)\n", + bestglobalpos, cwght[GRAY], cwght[BLACK], cwght[WHITE], + bestglobalvalue); + waitkey(); +#endif + + /* JY: moved next instruction after the two + * freeBucket instructions because + * this was the cause of a memory leak. + * if (bestglobalpos > 0) goto OUTER_LOOP_START; + */ + + freeBucket(b_bucket); + freeBucket(w_bucket); + + if (bestglobalpos > 0) goto OUTER_LOOP_START; + free(tmp_color); free(deltaS); free(deltaB); free(deltaW); +} + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/ddcreate.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/ddcreate.c new file mode 100644 index 000000000..e7053023e --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/ddcreate.c @@ -0,0 +1,940 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: ddcreate.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 00nov28 +/ +/ This file contains functions dealing with construction/coarsening +/ of a domain decomposition +/ +****************************************************************************** + +Data type: struct domdec + graph_t *G; pointer to graph object + int ndom; number of domains + int domwght; total weight of domains + int *vtype; type of node (see comment below) + int *color; color of node (GRAY, BLACK, or WHITE) + int cwght[3]; weights of GRAY, BLACK, WHITE partitions + int *map; maps nodes to next coarser domain decomp. + struct domdec *prev; pointer to previous finer domain decomp. + struct domdec *next; pointer to next coarser domain decomp. +Comments: + o Structure holds the domain decompositions constructed by the + coarsening process; it also holds the colorings of the domain decomp. + computed by the refinement process + o vtype[v]: represents the status of a node in the domain decomposition + 0, iff status of v is unknown + 1, iff v is a domain vertex + 2, iff v is a multisector vertex + 3, iff multisec v is eliminated and now forms a domain + 4, iff multisec v is absorbed by another multisec/domain +Methods in lib/ddcreate.c: +- dd = newDomainDecomposition(int nvtx, int nedges); + o Initial: ndom = domwght = 0, + cwght[GRAY] = cwght[BLACK] = cwght[WHITE] = 0, + and prev = next = NULL +- void freeDomainDecomposition(domdec_t *dd); +- void printDomainDecomposition(domdec_t *dd); +- void checkDomainDecomposition(domdec_t *dd); +- void buildInitialDomains(graph_t *G, int *vtxlist, int *vtype, int *rep); + o determines initial domains according to the order of nodes in vtxlist; + furthermore, it sets rep[u] = v for all multisecs u that are adjacent + to only one domain v + o on start vtype[u] = 0 for all 0 <= u < nvtx, on return + vtype[u] = 1, iff u belongs to a domain (rep[u]=u => u is seed of domain) + vtype[u] = 2, iff u belongs to a multisec (rep[u]=u => u is seed) +- void mergeMultisecs(graph_t *G, int *vtype, int *rep); + o merges all adjacent multisecs that do not share a common domain + o on return vtype[w] = 4, iff multisec w belongs to multisec cluster + u = rep[w] +- dd = initialDomainDecomposition(graph_t *G, int *map, int *vtype, int *rep); + o allocates memory for the initial domain decomposition of G by calling + newDomainDecomposition and creates the domain decomposition according + to the vectors vtype and rep; the map vector maps vertices of G onto + vertices of dd +- dd = constructDomainDecomposition(graph_t *G, int *map); + o constructs an initial domain decomposition for the graph G by calling + the functions (a) buildInitialDomains + (b) mergeMultisecs + (c) initialDomainDecomposition + vextor map identifies vertices of G in the domain decomposition +- void computePriorities(domdec_t *dd, int *msvtxlist, int *key, int scoretype); + o computes for each multisec u in msvtxlist its priority key[u] according + to the node selection strategy scoretype +- void eliminateMultisecs(domdec_t *dd, int *msvtxlist, int *rep); + o eliminates multisecs according to their order in msvtxlist; furthermore, + it sets rep[u] = v for all multisecs u that are adjacent to only one + newly formed domain v + o on return + dd->vtype[u] = 1, iff u is a domain (rep[u] = u) + dd->vtype[u] = 2, iff u is an uneliminated multisec (rep[u] = u) + dd->vtype[u] = 3, iff u is an eliminated multisec (rep[u] = u) + dd->vtype[u] = 4, iff multisec u is absorbed by new domain v = rep[u]; +- void findIndMultisecs(domdec_t *dd, int *msvtxlist, int *rep); + o searches all unelim./unabsorbed multisecs in msnvtxlist for + indistinguishable multisecs; sets dd->vtype[u] = 4 and rep[u] = v, iff + u, v are indistinguishable and v is the representative of u +- dd2 = coarserDomainDecomposition(domdec_t* dd1, int *rep); + o allocates memory for the coarser domain decomposition by calling + newDomainDecomposition and creates the domain decomposition according + to the vectors dd1->vtype and rep; vector dd1->map identifies the + vertices of dd1 in dd2 +- void shrinkDomainDecomposition(domdec_t *dd, int scoretype); + o shrinks dd according to a chosen node selection strategy by calling + the functions (a) computePriorities + (b) eliminateMultisecs + (c) findIndMultisecs + (d) coarserDomainDecomposition + the coarser domain decomposition is appended to dd via prev/next pointers + +******************************************************************************/ + +#include + + +/***************************************************************************** +******************************************************************************/ +domdec_t* +newDomainDecomposition(int nvtx, int nedges) +{ domdec_t *dd; + + mymalloc(dd, 1, domdec_t); + mymalloc(dd->vtype, nvtx, int); + mymalloc(dd->color, nvtx, int); + mymalloc(dd->map, nvtx, int); + + dd->G = newGraph(nvtx, nedges); + dd->ndom = dd->domwght = 0; + dd->cwght[GRAY] = dd->cwght[BLACK] = dd->cwght[WHITE] = 0; + dd->prev = dd->next = NULL; + + return(dd); +} + + +/***************************************************************************** +******************************************************************************/ +void +freeDomainDecomposition(domdec_t *dd) +{ + freeGraph(dd->G); + free(dd->vtype); + free(dd->color); + free(dd->map); + free(dd); +} + + +/***************************************************************************** +******************************************************************************/ +void +printDomainDecomposition(domdec_t *dd) +{ graph_t *G; + int count, u, v, i, istart, istop; + + G = dd->G; + printf("\n#nodes %d (#domains %d, weight %d), #edges %d, totvwght %d\n", + G->nvtx, dd->ndom, dd->domwght, G->nedges >> 1, G->totvwght); + printf("partition weights: S %d, B %d, W %d\n", dd->cwght[GRAY], + dd->cwght[BLACK], dd->cwght[WHITE]); + for (u = 0; u < G->nvtx; u++) + { count = 0; + printf("--- adjacency list of node %d (vtype %d, color %d, map %d\n", + u, dd->vtype[u], dd->color[u], dd->map[u]); + istart = G->xadj[u]; + istop = G->xadj[u+1]; + for (i = istart; i < istop; i++) + { v = G->adjncy[i]; + printf("%5d (vtype %2d, color %2d)", v, dd->vtype[v], dd->color[v]); + if ((++count % 3) == 0) + printf("\n"); + } + if ((count % 3) != 0) + printf("\n"); + } +} + + +/***************************************************************************** +******************************************************************************/ +void +checkDomainDecomposition(domdec_t *dd) +{ int *xadj, *adjncy, *vwght, *vtype; + int err, nvtx, ndom, domwght, dom, multi, u, v, i, istart, istop; + + nvtx = dd->G->nvtx; + xadj = dd->G->xadj; + adjncy = dd->G->adjncy; + vwght = dd->G->vwght; + vtype = dd->vtype; + + err = FALSE; + printf("checking domain decomposition (#nodes %d, #edges %d)\n", + dd->G->nvtx, dd->G->nedges >> 1); + + ndom = domwght = 0; + for (u = 0; u < nvtx; u++) + { /* check node type */ + if ((vtype[u] != 1) && (vtype[u] != 2)) + { printf("ERROR: node %d is neither DOMAIN nor MULTISEC\n", u); + err = TRUE; + } + /* count domains and sum up their weight */ + if (vtype[u] == 1) + { ndom++; + domwght += vwght[u]; + } + /* check number of neighboring domains and multisecs */ + dom = multi = 0; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if (vtype[v] == 1) dom++; + if (vtype[v] == 2) multi++; + } + if ((vtype[u] == 1) && (dom > 0)) + { printf("ERROR: domain %d is adjacent to other domain\n", u); + err = TRUE; + } + if ((vtype[u] == 2) && (dom < 2)) + { printf("ERROR: less than 2 domains adjacent to multisec node %d\n", u); + err = TRUE; + } + if ((vtype[u] == 2) && (multi > 0)) + { printf("ERROR: multisec %d is adjacent to other multisec nodes\n", u); + err = TRUE; + } + } + /* check number and weight of domains */ + if ((ndom != dd->ndom) || (domwght != dd->domwght)) + { printf("ERROR: number/size (%d/%d) of domains does not match with those in" + " domain decomp. (%d/%d)\n", ndom, domwght, dd->ndom, dd->domwght); + err = TRUE; + } + if (err) quit(); +} + + +/***************************************************************************** +******************************************************************************/ +void +buildInitialDomains(graph_t *G, int *vtxlist, int *vtype, int *rep) +{ int *xadj, *adjncy; + int nvtx, u, v, w, i, j, jstart, jstop; + + xadj = G->xadj; + adjncy = G->adjncy; + nvtx = G->nvtx; + + /* -------------------------------------------------------------------- + determine initial domains according to the order of nodes in vtxlist + -------------------------------------------------------------------- */ + for (i = 0; i < nvtx; i++) + { u = vtxlist[i]; + if (vtype[u] == 0) + { vtype[u] = 1; + jstart = xadj[u]; + jstop = xadj[u+1]; + for (j = jstart; j < jstop; j++) + { v = adjncy[j]; + vtype[v] = 2; + } + } + } + + /* ------------------------------------------------------------ + eliminate all multisecs that are adjacent to only one domain + ------------------------------------------------------------ */ + for (i = 0; i < nvtx; i++) + { u = vtxlist[i]; + if (vtype[u] == 2) + { v = -1; + jstart = xadj[u]; + jstop = xadj[u+1]; + for (j = jstart; j < jstop; j++) + { w = adjncy[j]; + if (vtype[w] == 1) + { if (v == -1) + v = rep[w]; /* u adjacent to domain v = rep[w] */ + else if (v != rep[w]) + { v = -1; /* u adjacent to another domain */ + break; + } + } + } + if (v != -1) /* u absorbed by domain v */ + { vtype[u] = 1; + rep[u] = v; + } + } + } +} + + +/***************************************************************************** +******************************************************************************/ +void +mergeMultisecs(graph_t *G, int *vtype, int *rep) +{ int *xadj, *adjncy, *tmp, *queue; + int nvtx, qhead, qtail, flag, keepon, u, v, w, x; + int i, istart, istop, j, jstart, jstop; + + nvtx = G->nvtx; + xadj = G->xadj; + adjncy = G->adjncy; + + /* ------------------------ + allocate working storage + ------------------------ */ + mymalloc(tmp, nvtx, int); + mymalloc(queue, nvtx, int); + for (u = 0; u < nvtx; u++) + tmp[u] = -1; + + /* ------------------------------------------------------- + merge all adjacent multisecs that do not share a domain + ------------------------------------------------------- */ + flag = 1; + for (u = 0; u < nvtx; u++) + if (vtype[u] == 2) + { qhead = 0; qtail = 1; + queue[0] = u; + vtype[u] = -2; + + /* multisec u is the seed of a new cluster, mark all adj. domains */ + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if (vtype[v] == 1) + tmp[rep[v]] = flag; + } + + /* and now build the cluster */ + while (qhead != qtail) + { v = queue[qhead++]; + istart = xadj[v]; + istop = xadj[v+1]; + for (i = istart; i < istop; i++) + { keepon = TRUE; + w = adjncy[i]; + if (vtype[w] == 2) + { jstart = xadj[w]; + jstop = xadj[w+1]; + for (j = jstart; j < jstop; j++) + { x = adjncy[j]; + if ((vtype[x] == 1) && (tmp[rep[x]] == flag)) + { keepon = FALSE; + break; + } + } + if (keepon) + /* multisecs v and w have no domain in common; mark */ + /* all domains adjacent to w and put w in cluster u */ + { for (j = jstart; j < jstop; j++) + { x = adjncy[j]; + if (vtype[x] == 1) tmp[rep[x]] = flag; + } + queue[qtail++] = w; + rep[w] = u; + vtype[w] = -2; + } + } + } + } + + /* clear tmp vector for next round */ + flag++; + } + + /* ------------------------------------ + reset vtype and free working storage + ------------------------------------ */ + for (u = 0; u < nvtx; u++) + if (vtype[u] == -2) + vtype[u] = 2; + free(tmp); free(queue); +} + + +/***************************************************************************** +******************************************************************************/ +domdec_t* +initialDomainDecomposition(graph_t *G, int *map, int *vtype, int *rep) +{ domdec_t *dd; + int *xadj, *adjncy, *vwght, *xadjdd, *adjncydd, *vwghtdd, *vtypedd; + int *tmp, *bin, nvtx, nedges, nvtxdd, nedgesdd, ndom, domwght, flag; + int i, j, jstart, jstop, u, v, w; + + nvtx = G->nvtx; + nedges = G->nedges; + xadj = G->xadj; + adjncy = G->adjncy; + vwght = G->vwght; + + /* ------------------------ + allocate working storage + ------------------------ */ + mymalloc(tmp, nvtx, int); + mymalloc(bin, nvtx, int); + for (u = 0; u < nvtx; u++) + { tmp[u] = -1; + bin[u] = -1; + } + + /* ------------------------------------------------------------- + allocate memory for the dd using upper bounds nvtx and nedges + ------------------------------------------------------------- */ + dd = newDomainDecomposition(nvtx, nedges); + xadjdd = dd->G->xadj; + adjncydd = dd->G->adjncy; + vwghtdd = dd->G->vwght; + vtypedd = dd->vtype; + + /* ------------------------------------------------------- + put all nodes u belonging to representative v in bin[v] + ------------------------------------------------------- */ + for (u = 0; u < nvtx; u++) + { v = rep[u]; + if (u != v) + { bin[u] = bin[v]; + bin[v] = u; + } + } + + /* ---------------------------------------------- + and now build the initial domain decomposition + ---------------------------------------------- */ + flag = 1; + nedgesdd = nvtxdd = 0; + ndom = domwght = 0; + for (u = 0; u < nvtx; u++) + if (rep[u] == u) + { xadjdd[nvtxdd] = nedgesdd; + vtypedd[nvtxdd] = vtype[u]; + vwghtdd[nvtxdd] = 0; + tmp[u] = flag; + + /* find all cluster that are adjacent to u in dom. dec. */ + v = u; + do + { map[v] = nvtxdd; + vwghtdd[nvtxdd] += vwght[v]; + jstart = xadj[v]; + jstop = xadj[v+1]; + for (j = jstart; j < jstop; j++) + { w = adjncy[j]; + if ((vtype[w] != vtype[u]) && (tmp[rep[w]] != flag)) + { tmp[rep[w]] = flag; + adjncydd[nedgesdd++] = rep[w]; + } + } + v = bin[v]; + } while (v != -1); + + if (vtypedd[nvtxdd] == 1) + { ndom++; + domwght += vwghtdd[nvtxdd]; + } + nvtxdd++; + flag++; + } + + /* -------------------------------------------- + finalize the new domain decomposition object + -------------------------------------------- */ + xadjdd[nvtxdd] = nedgesdd; + dd->G->nvtx = nvtxdd; + dd->G->nedges = nedgesdd; + dd->G->type = WEIGHTED; + dd->G->totvwght = G->totvwght; + for (i = 0; i < nedgesdd; i++) + adjncydd[i] = map[adjncydd[i]]; + for (u = 0; u < nvtxdd; u++) + dd->color[u] = dd->map[u] = -1; + dd->ndom = ndom; + dd->domwght = domwght; + + /* ------------------------------- + free working storage and return + ------------------------------- */ + free(tmp); free(bin); + return(dd); +} + + +/***************************************************************************** +******************************************************************************/ +domdec_t* +constructDomainDecomposition(graph_t *G, int *map) +{ domdec_t *dd; + int *xadj, *adjncy, *vwght, *vtxlist, *vtype, *key, *rep; + int nvtx, deg, u, i, istart, istop; + + nvtx = G->nvtx; + xadj = G->xadj; + adjncy = G->adjncy; + vwght = G->vwght; + + /* --------------------------------------------------------- + sort the vertices in G in ascending order of their degree + --------------------------------------------------------- */ + mymalloc(vtxlist, nvtx, int); + mymalloc(key, nvtx, int); + for (u = 0; u < nvtx; u++) + { vtxlist[u] = u; + istart = xadj[u]; + istop = xadj[u+1]; + switch(G->type) + { case UNWEIGHTED: + deg = istop - istart; + break; + case WEIGHTED: + deg = 0; + for (i = istart; i < istop; i++) + deg += vwght[adjncy[i]]; + break; + default: + fprintf(stderr, "\nError in function constructDomainDecomposition\n" + " unrecognized graph type %d\n", G->type); + quit(); + } + key[u] = deg; + } + distributionCounting(nvtx, vtxlist, key); + free(key); + + /* ------------------------------------------------------------- + build initial domains and cluster multisecs that do not share + a common domain + ------------------------------------------------------------- */ + mymalloc(vtype, nvtx, int); + mymalloc(rep, nvtx, int); + for (u = 0; u < nvtx; u++) + { vtype[u] = 0; + rep[u] = u; + } + buildInitialDomains(G, vtxlist, vtype, rep); + mergeMultisecs(G, vtype, rep); + free(vtxlist); + + /* -------------------------------------------------- + finally, build the domain decomposition and return + -------------------------------------------------- */ + dd = initialDomainDecomposition(G, map, vtype, rep); + free(vtype); free(rep); + return(dd); +} + + +/***************************************************************************** +******************************************************************************/ +void +computePriorities(domdec_t *dd, int *msvtxlist, int *key, int scoretype) +{ int *xadj, *adjncy, *vwght, *marker; + int nvtx, nlist, k, weight, deg, u, v, w; + int i, istart, istop, j, jstart, jstop; + + nvtx = dd->G->nvtx; + xadj = dd->G->xadj; + adjncy = dd->G->adjncy; + vwght = dd->G->vwght; + marker = dd->map; + nlist = nvtx - dd->ndom; + + switch(scoretype) + { case QMRDV: /* maximal relative decrease of variables in quotient graph */ + for (k = 0; k < nlist; k++) + { u = msvtxlist[k]; + weight = vwght[u]; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + weight += vwght[adjncy[i]]; + key[u] = weight / vwght[u]; + } + break; + + case QMD: /* ----------------------- minimum degree in quotient graph */ + for (k = 0; k < nlist; k++) + { u = msvtxlist[k]; + marker[u] = -1; + } + for (k = 0; k < nlist; k++) + { u = msvtxlist[k]; + marker[u] = u; + deg = 0; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + jstart = xadj[v]; + jstop = xadj[v+1]; + for (j = jstart; j < jstop; j++) + { w = adjncy[j]; + if (marker[w] != u) + { marker[w] = u; + deg += vwght[w]; + } + } + } + key[u] = deg; + } + break; + + case QRAND: /* ------------------------------------------------- random */ + for (k = 0; k < nlist; k++) + { u = msvtxlist[k]; + key[u] = myrandom(nvtx); + } + break; + + default: + fprintf(stderr, "\nError in internal function computePriorities\n" + " unrecognized node selection strategy %d\n", scoretype); + quit(); + } +} + + +/***************************************************************************** +******************************************************************************/ +void +eliminateMultisecs(domdec_t *dd, int *msvtxlist, int *rep) +{ int *xadj, *adjncy, *vtype; + int nvtx, nlist, keepon, u, v, w, k, i, istart, istop; + + nvtx = dd->G->nvtx; + xadj = dd->G->xadj; + adjncy = dd->G->adjncy; + vtype = dd->vtype; + nlist = nvtx - dd->ndom; + + /* ------------------------------------------------------- + eliminate multisecs according to the order in msvtxlist + ------------------------------------------------------- */ + for (k = 0; k < nlist; k++) + { u = msvtxlist[k]; + istart = xadj[u]; + istop = xadj[u+1]; + keepon = TRUE; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if (rep[v] != v) /* domain already absorbed by an eliminated */ + { keepon = FALSE; /* multisec => multisec u cannot be deleted */ + break; + } + } + if (keepon) + { vtype[u] = 3; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + rep[v] = u; + } + } + } + + /* ------------------------------------------------------------ + eliminate all multisecs that are adjacent to only one domain + ------------------------------------------------------------ */ + for (k = 0; k < nlist; k++) + { u = msvtxlist[k]; + if (vtype[u] == 2) + { v = -1; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { w = adjncy[i]; + if (v == -1) + v = rep[w]; /* u adjacent to domain v = rep[w] */ + else if (v != rep[w]) + { v = -1; /* u adjacent to another domain */ + break; + } + } + if (v != -1) /* u absorbed by domain v */ + { vtype[u] = 4; + rep[u] = v; + } + } + } +} + + +/***************************************************************************** +******************************************************************************/ +void +findIndMultisecs(domdec_t *dd, int *msvtxlist, int *rep) +{ int *xadj, *adjncy, *vtype, *tmp, *bin, *checksum, *next, *key; + int nvtx, nlist, flag, keepon, deg, chk, ulast, u, v, k, i, istart, istop; + + nvtx = dd->G->nvtx; + xadj = dd->G->xadj; + adjncy = dd->G->adjncy; + vtype = dd->vtype; + nlist = nvtx - dd->ndom; + checksum = dd->map; + + /* ------------------------ + allocate working storage + ------------------------ */ + mymalloc(tmp, nvtx, int); + mymalloc(bin, nvtx, int); + mymalloc(next, nvtx, int); + mymalloc(key, nvtx, int); + for (u = 0; u < nvtx; u++) + { tmp[u] = -1; + bin[u] = -1; + } + + /* ------------------------------------------------------------------- + compute checksums for all unelim./unabsorbed multisecs in msvtxlist + ------------------------------------------------------------------- */ + flag = 1; + for (k = 0; k < nlist; k++) + { u = msvtxlist[k]; + if (vtype[u] == 2) + { deg = chk = 0; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if (tmp[rep[v]] != flag) + { tmp[rep[v]] = flag; + chk += rep[v]; + deg++; + } + } + chk = chk % nvtx; + checksum[u] = chk; + key[u] = deg; + next[u] = bin[chk]; + bin[chk] = u; + flag++; + } + } + + /* --------------------------------- + merge indistinguishable multisecs + --------------------------------- */ + for (k = 0; k < nlist; k++) + { u = msvtxlist[k]; + if (vtype[u] == 2) + { chk = checksum[u]; + v = bin[chk]; /* examine all multisecs in bin[hash] */ + bin[chk] = -1; /* do this only once */ + while (v != -1) + { istart = xadj[v]; + istop = xadj[v+1]; + for (i = istart; i < istop; i++) + tmp[rep[adjncy[i]]] = flag; + ulast = v; /* v is principal and u is a potiential */ + u = next[v]; /* nonprincipal variable */ + while (u != -1) + { keepon = TRUE; + if (key[u] != key[v]) + keepon = FALSE; + if (keepon) + { istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + if (tmp[rep[adjncy[i]]] != flag) + { keepon = FALSE; + break; + } + } + if (keepon) /* found it! mark u as nonprincipal */ + { rep[u] = v; + /* printf(" >> mapping %d onto %d\n", u, v); */ + vtype[u] = 4; + u = next[u]; + next[ulast] = u; /* remove u from bin */ + } + else /* failed */ + { ulast = u; + u = next[u]; + } + } + v = next[v]; /* no more variables can be absorbed by v */ + flag++; /* clear tmp vector for next round */ + } + } + } + + /* -------------------- + free working storage + -------------------- */ + free(tmp); free(bin); + free(next); free(key); +} + + +/***************************************************************************** +******************************************************************************/ +domdec_t* +coarserDomainDecomposition(domdec_t* dd1, int *rep) +{ domdec_t *dd2; + int *xadjdd1, *adjncydd1, *vwghtdd1, *vtypedd1, *mapdd1; + int *xadjdd2, *adjncydd2, *vwghtdd2, *vtypedd2; + int *tmp, *bin, nvtxdd1, nedgesdd1, nvtxdd2, nedgesdd2; + int ndom, domwght, flag, u, v, w, i, istart, istop; + + nvtxdd1 = dd1->G->nvtx; + nedgesdd1 = dd1->G->nedges; + xadjdd1 = dd1->G->xadj; + adjncydd1 = dd1->G->adjncy; + vwghtdd1 = dd1->G->vwght; + vtypedd1 = dd1->vtype; + mapdd1 = dd1->map; + + /* ------------------------ + allocate working storage + ------------------------ */ + mymalloc(tmp, nvtxdd1, int); + mymalloc(bin, nvtxdd1, int); + for (u = 0; u < nvtxdd1; u++) + { tmp[u] = -1; + bin[u] = -1; + } + + /* ------------------------------------------------------------ + allocate memory using the upper bounds nvtxdd1 and nedgesdd1 + ------------------------------------------------------------ */ + dd2 = newDomainDecomposition(nvtxdd1, nedgesdd1); + xadjdd2 = dd2->G->xadj; + adjncydd2 = dd2->G->adjncy; + vwghtdd2 = dd2->G->vwght; + vtypedd2 = dd2->vtype; + + /* ------------------------------------------------------- + put all nodes u belonging to representative v in bin[v] + ------------------------------------------------------- */ + for (u = 0; u < nvtxdd1; u++) + { v = rep[u]; + if (u != v) + { bin[u] = bin[v]; + bin[v] = u; + } + } + + /* ---------------------------------------------- + and now build the coarser domain decomposition + ---------------------------------------------- */ + flag = 1; + nvtxdd2 = nedgesdd2 = 0; + ndom = domwght = 0; + for (u = 0; u < nvtxdd1; u++) + if (rep[u] == u) + { xadjdd2[nvtxdd2] = nedgesdd2; + vwghtdd2[nvtxdd2] = 0; + vtypedd2[nvtxdd2] = vtypedd1[u]; + if (vtypedd2[nvtxdd2] == 3) + vtypedd2[nvtxdd2] = 1; + tmp[u] = flag; + + /* find all cluster that are adjacent to u in dom. dec. */ + v = u; + do + { mapdd1[v] = nvtxdd2; + vwghtdd2[nvtxdd2] += vwghtdd1[v]; + if ((vtypedd1[v] == 1) || (vtypedd1[v] == 2)) + { istart = xadjdd1[v]; + istop = xadjdd1[v+1]; + for (i = istart; i < istop; i++) + { w = adjncydd1[i]; + if (tmp[rep[w]] != flag) + { tmp[rep[w]] = flag; + adjncydd2[nedgesdd2++] = rep[w]; + } + } + } + v = bin[v]; + } while (v != -1); + + if (vtypedd2[nvtxdd2] == 1) + { ndom++; + domwght += vwghtdd2[nvtxdd2]; + } + nvtxdd2++; + flag++; + } + + /* -------------------------------------------- + finalize the new domain decomposition object + -------------------------------------------- */ + xadjdd2[nvtxdd2] = nedgesdd2; + dd2->G->nvtx = nvtxdd2; + dd2->G->nedges = nedgesdd2; + dd2->G->type = WEIGHTED; + dd2->G->totvwght = dd1->G->totvwght; + for (i = 0; i < nedgesdd2; i++) + adjncydd2[i] = mapdd1[adjncydd2[i]]; + for (u = 0; u < nvtxdd2; u++) + dd2->color[u] = dd2->map[u] = -1; + dd2->ndom = ndom; + dd2->domwght = domwght; + + /* -------------------------- + set back node types in dd1 + -------------------------- */ + for (u = 0; u < nvtxdd1; u++) + if ((vtypedd1[u] == 3) || (vtypedd1[u] == 4)) + vtypedd1[u] = 2; + + /* ------------------------------- + free working storage and return + ------------------------------- */ + free(tmp); free(bin); + return(dd2); +} + + +/***************************************************************************** +******************************************************************************/ +void +shrinkDomainDecomposition(domdec_t* dd1, int scoretype) +{ domdec_t *dd2; + int *msvtxlist, *rep, *key; + int nvtxdd1, nlist, u; + + nvtxdd1 = dd1->G->nvtx; + mymalloc(msvtxlist, nvtxdd1, int); + mymalloc(rep, nvtxdd1, int); + mymalloc(key, nvtxdd1, int); + + /* --------------- + initializations + --------------- */ + nlist = 0; + for (u = 0; u < nvtxdd1; u++) + { if (dd1->vtype[u] == 2) + msvtxlist[nlist++] = u; + rep[u] = u; + } + + /* ------------------------------------- + compute priorities and sort multisecs + ------------------------------------- */ + computePriorities(dd1, msvtxlist, key, scoretype); + distributionCounting(nlist, msvtxlist, key); + + /* ---------------------------------------------------------- + eliminate multisecs and build coarser domain decomposition + ---------------------------------------------------------- */ + eliminateMultisecs(dd1, msvtxlist, rep); + findIndMultisecs(dd1, msvtxlist, rep); + dd2 = coarserDomainDecomposition(dd1, rep); + + /* ----------------------------------- + append coarser domain decomposition + ----------------------------------- */ + dd1->next = dd2; + dd2->prev = dd1; + + free(msvtxlist); + free(rep); + free(key); +} diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/gbipart.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/gbipart.c new file mode 100644 index 000000000..1c6228884 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/gbipart.c @@ -0,0 +1,614 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: gbipart.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 00dec26 +/ +/ This file contains functions dealing with bipartite graphs +/ +****************************************************************************** + +Data type: struct gbipart + graph_t *G; pointer to graph object with E c X x Y + int nX; the vertices 0,...,nX-1 belong to X + int nY; the vertices nX,...,nX+nY-1 belong to Y +Comments: + o Structure used to smooth a separator computed for a subgraph Gbisect. + The separator is paired with the border vertices in black/white partition, + thus, resulting in a bipartite graph. +Methods in lib/gbipart.c: +- Gbipart = newBipartiteGraph(int nX, int nY, int nedges); +- void freeBipartiteGraph(gbipart_t *Gbipart); +- void printGbipart(gbipart_t *Gbipart); +- Gbipart = setupBipartiteGraph(graph_t *G, int *bipartvertex, int nX, int nY, + int *vtxmap) + o Gbipart is induced by the vertices in bipartvertex. The first + nX vertices are the vertices 0...nX-1 and the last nY vertices + are the vertices nX...nX+nY-1 of Gbipart. Vector vtxmap maps the + vertices in bipartvertex to the vertices of the bipartite graph. +- void maximumMatching(gbipart_t *Gbipart, int *matching); +- void maximumFlow(gbipart_t *Gbipart, int *flow, int *rc) + o flow[i] stores the flow over the edge in adjncy[i] of Gbipart. It is + positive, if the edge is from X to Y, otherwise flow is negative. + o rc[u] stores the residual capacity of edge (source,u), u e X, + respectively (u,sink), u e Y. All edges between X and Y have + infinite capacity, therefore, no rc value must be computed for them. +- void DMviaMatching(gbipart_t *Gbipart, int *matching, int *dmflag, + int *dmwght); + o on return. vector dmflag is filled with the following values: + / SI, iff x e X is reachable via exposed node e X + dmflag[x] = < SX, iff x e X is reachable via exposed node e Y + \ SR, iff x e X - (SI u SX) + / BI, iff y e Y is reachable via exposed node e Y + dmflag[y] = < BX, iff y e Y is reachable via exposed node e X + \ BR, iff y e Y - (BI u BX) + o on return, vector dmwght is filled with the following values: + dmwght[SI] - weight of SI dmwght[BI] - weight of BI + dmwght[SX] - weight of SX dmwght[BX] - weight of BX + dmwght[SR] - weight of SR dmwght[BR] - weight of BR +- void DMviaFlow(gbipart_t *Gbipart, int *flow, int *rc, int *dmflag, + int *dmwght); + o vectors dmflag and dmwght are filled as described above + +******************************************************************************/ + +#include + +#define FREE -1 +#define SOURCE -2 +#define SINK -3 + + +/***************************************************************************** +******************************************************************************/ +gbipart_t* +newBipartiteGraph(int nX, int nY, int nedges) +{ gbipart_t *Gbipart; + + mymalloc(Gbipart, 1, gbipart_t); + Gbipart->G = newGraph(nX+nY, nedges); + Gbipart->nX = nX; + Gbipart->nY = nY; + + return(Gbipart); +} + + +/***************************************************************************** +******************************************************************************/ +void +freeBipartiteGraph(gbipart_t *Gbipart) +{ + freeGraph(Gbipart->G); + free(Gbipart); +} + + +/***************************************************************************** +******************************************************************************/ +void +printGbipart(gbipart_t *Gbipart) +{ graph_t *G; + int count, u, i, istart, istop; + + G = Gbipart->G; + printf("\n#vertices %d (nX %d, nY %d), #edges %d, type %d, totvwght %d\n", + G->nvtx, Gbipart->nX, Gbipart->nY, G->nedges >> 1, G->type, + G->totvwght); + for (u = 0; u < G->nvtx; u++) + { count = 0; + printf("--- adjacency list of vertex %d (weight %d):\n", u, G->vwght[u]); + istart = G->xadj[u]; + istop = G->xadj[u+1]; + for (i = istart; i < istop; i++) + { printf("%5d", G->adjncy[i]); + if ((++count % 16) == 0) + printf("\n"); + } + if ((count % 16) != 0) + printf("\n"); + } +} + + +/***************************************************************************** +******************************************************************************/ +gbipart_t* +setupBipartiteGraph(graph_t *G, int *bipartvertex, int nX, int nY, int *vtxmap) +{ gbipart_t *Gbipart; + int *xadj, *adjncy, *vwght, *xadjGb, *adjncyGb, *vwghtGb; + int nvtx, nedgesGb, totvwght, u, x, y, i, j, jstart, jstop, ptr; + + nvtx = G->nvtx; + xadj = G->xadj; + adjncy = G->adjncy; + vwght = G->vwght; + + /* ---------------------------------------------------------------- + compute number of edges and local indices of vertices in Gbipart + ---------------------------------------------------------------- */ + nedgesGb = 0; + for (i = 0; i < nX+nY; i++) + { u = bipartvertex[i]; + if ((u < 0) || (u >= nvtx)) + { fprintf(stderr, "\nError in function setupBipartiteGraph\n" + " node %d does not belong to graph\n", u); + quit(); + } + jstart = xadj[u]; + jstop = xadj[u+1]; + for (j = jstart; j < jstop; j++) + vtxmap[adjncy[j]] = -1; + nedgesGb += (jstop - jstart); + } + for (i = 0; i < nX+nY; i++) + { u = bipartvertex[i]; + vtxmap[u] = i; + } + + Gbipart = newBipartiteGraph(nX, nY, nedgesGb); + xadjGb = Gbipart->G->xadj; + adjncyGb = Gbipart->G->adjncy; + vwghtGb = Gbipart->G->vwght; + + /* --------------------------------- + build the induced bipartite graph + --------------------------------- */ + totvwght = 0; ptr = 0; + for (i = 0; i < nX; i++) + { x = bipartvertex[i]; + xadjGb[i] = ptr; + vwghtGb[i] = vwght[x]; + totvwght += vwght[x]; + jstart = xadj[x]; + jstop = xadj[x+1]; + for (j = jstart; j < jstop; j++) + { y = adjncy[j]; + if (vtxmap[y] >= nX) + adjncyGb[ptr++] = vtxmap[y]; + } + } + for (i = nX; i < nX+nY; i++) + { y = bipartvertex[i]; + xadjGb[i] = ptr; + vwghtGb[i] = vwght[y]; + totvwght += vwght[y]; + jstart = xadj[y]; + jstop = xadj[y+1]; + for (j = jstart; j < jstop; j++) + { x = adjncy[j]; + if ((vtxmap[x] >= 0) && (vtxmap[x] < nX)) + adjncyGb[ptr++] = vtxmap[x]; + } + } + xadjGb[nX+nY] = ptr; + Gbipart->G->type = G->type; + Gbipart->G->totvwght = totvwght; + return(Gbipart); +} + + +/***************************************************************************** +******************************************************************************/ +void +maximumMatching(gbipart_t *Gbipart, int *matching) +{ int *xadj, *adjncy, *level, *marker, *queue, *stack; + int top, top2, u, x, x2, y, y2, nX, nY, i, istart, istop; + int qhead, qtail, max_level; + + xadj = Gbipart->G->xadj; + adjncy = Gbipart->G->adjncy; + nX = Gbipart->nX; + nY = Gbipart->nY; + + mymalloc(level, (nX+nY), int); + mymalloc(marker, (nX+nY), int); + mymalloc(queue, nX, int); + mymalloc(stack, nY, int); + + /* ------------------- + initialize matching + ------------------- */ + for (u = 0; u < nX+nY; u++) + matching[u] = FREE; + + /* --------------------------------------------------- + construct maximal matching in bipartite graph (X,Y) + --------------------------------------------------- */ + for (x = 0; x < nX; x++) + { istart = xadj[x]; + istop = xadj[x+1]; + for (i = istart; i < istop; i++) + { y = adjncy[i]; + if (matching[y] == FREE) + { matching[x] = y; + matching[y] = x; + break; + } + } + } + + /* -------------------------------------------------------------------- + construct maximum matching in bipartite graph (X,Y) (Hopcroft, Karp) + -------------------------------------------------------------------- */ + while (TRUE) + { for (u = 0; u < nX+nY; u++) + level[u] = marker[u] = -1; + qhead = qtail = 0; /* fill queue with free X nodes */ + for (x = 0; x < nX; x++) + if (matching[x] == FREE) + { queue[qtail++] = x; + level[x] = 0; + } + + /* -------------------------------------------------------------- + breadth first search to construct layer network containing all + vertex disjoint augmenting paths of minimal length + -------------------------------------------------------------- */ + top = 0; + max_level = MAX_INT; + while (qhead != qtail) + { x = queue[qhead++]; /* note: queue contains only */ + if (level[x] < max_level) /* nodes from X */ + { istart = xadj[x]; + istop = xadj[x+1]; + for (i = istart; i < istop; i++) + { y = adjncy[i]; + if (level[y] == -1) + { level[y] = level[x] + 1; + if (matching[y] == FREE) + { max_level = level[y]; /* note: stack contains only */ + stack[top++] = y; /* nodes form Y */ + } + else if (level[y] < max_level) + { x2 = matching[y]; + level[x2] = level[y] + 1; + queue[qtail++] = x2; + } + } + } + } + } + if (top == 0) break; /* no augmenting path found */ + + /* ------------------------------------------------------------ + restricted depth first search to construct maximal number of + vertex disjoint augmenting paths in layer network + ------------------------------------------------------------ */ + while (top > 0) + { top2 = top--; + y = stack[top2-1]; /* get the next exposed node in Y */ + marker[y] = xadj[y]; /* points to next neighbor of y */ + + while (top2 > top) + { y = stack[top2-1]; + i = marker[y]++; + if (i < xadj[y+1]) /* not all neighbors of y visited */ + { x = adjncy[i]; + if ((marker[x] == -1) && (level[x] == level[y]-1)) + { marker[x] = 0; + if (level[x] == 0) /* augmenting path found */ + while (top2 > top) /* pop stack */ + { y2 = stack[--top2]; + x2 = matching[y2]; /* / o == o */ + matching[x] = y2; /* / */ + matching[y2] = x; /* x -- y2 == x2 -- y */ + x = x2; /* \ */ + } /* \ o == o */ + else + { y2 = matching[x]; + stack[top2++] = y2; + marker[y2] = xadj[y2]; + } + } + } + else top2--; + } + } + } + + /* ------------------------------- + free working storage and return + ------------------------------- */ + free(level); free(marker); + free(queue); free(stack); +} + + +/***************************************************************************** +******************************************************************************/ +void +maximumFlow(gbipart_t *Gbipart, int *flow, int *rc) +{ int *xadj, *adjncy, *vwght, *parent, *marker, *queue; + int nedges, u, v, x, y, nX, nY, j, i, istart, istop; + int qhead, qtail, capacity; + + nedges = Gbipart->G->nedges; + xadj = Gbipart->G->xadj; + adjncy = Gbipart->G->adjncy; + vwght = Gbipart->G->vwght; + nX = Gbipart->nX; + nY = Gbipart->nY; + + mymalloc(parent, (nX+nY), int); + mymalloc(marker, (nX+nY), int); + mymalloc(queue, (nX+nY), int); + + /* ------------------------------------- + initialize flow and residual capacity + ------------------------------------- */ + for (u = 0; u < nX+nY; u++) + rc[u] = vwght[u]; + for (i = 0; i < nedges; i++) + flow[i] = 0; + + /* -------------------------------------------------- + determine an initial flow in the bipartite network + -------------------------------------------------- */ + for (x = 0; x < nX; x++) + { istart = xadj[x]; + istop = xadj[x+1]; + for (i = istart; i < istop; i++) + { y = adjncy[i]; + capacity = min(rc[x], rc[y]); + if (capacity > 0) + { rc[x] -= capacity; + rc[y] -= capacity; + flow[i] = capacity; + for (j = xadj[y]; adjncy[j] != x; j++); + flow[j] = -capacity; + } + if (rc[x] == 0) break; + } + } + + /* ----------------------------------------------------------- + construct maximum flow in bipartite network (Edmonds, Karp) + ----------------------------------------------------------- */ + while (TRUE) + { for (u = 0; u < nX+nY; u++) + parent[u] = marker[u] = -1; + qhead = qtail = 0; /* fill queue with free X nodes */ + for (x = 0; x < nX; x++) + if (rc[x] > 0) + { queue[qtail++] = x; + parent[x] = x; + } + + /* --------------------------------------------------------- + breadth first search to find the shortest augmenting path + --------------------------------------------------------- */ + capacity = 0; + while (qhead != qtail) + { u = queue[qhead++]; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if ((parent[v] == -1) && ((v >= nX) || (flow[i] < 0))) + /* v >= nX => u->v is a forward edge having infty capacity */ + /* otherwise u<-v is a backward edge and (v,u) must have */ + /* positive capacity (i.e. (u,v) has neg. capacity) */ + { parent[v] = u; + marker[v] = i; + queue[qtail++] = v; + if ((v >= nX) && (rc[v] > 0)) /* found it! */ + { u = v; /* (v,sink) is below capacity */ + capacity = rc[u]; + while (parent[u] != u) /* get minimal residual capa. */ + { i = marker[u]; + u = parent[u]; + if (u >= nX) + capacity = min(capacity, -flow[i]); + } + capacity = min(capacity, rc[u]); + rc[v] -= capacity; /* augment flow by min. rc */ + while (parent[v] != v) + { i = marker[v]; + u = parent[v]; + flow[i] += capacity; + for (j = xadj[v]; adjncy[j] != u; j++); + flow[j] = -flow[i]; + v = u; + } + rc[v] -= capacity; + qhead = qtail; /* escape inner while loop */ + break; + } + } + } + } + + if (capacity == 0) + break; + } + + free(parent); free(marker); + free(queue); +} + + +/***************************************************************************** +******************************************************************************/ +void +DMviaMatching(gbipart_t *Gbipart, int *matching, int *dmflag, int *dmwght) +{ int *xadj, *adjncy, *vwght, *queue, qhead, qtail; + int u, x, nX, y, nY, i, istart, istop; + + xadj = Gbipart->G->xadj; + adjncy = Gbipart->G->adjncy; + vwght = Gbipart->G->vwght; + nX = Gbipart->nX; + nY = Gbipart->nY; + + mymalloc(queue, (nX+nY), int); + + /* ---------------------------------------------------------------------- + mark all exposed nodes of X with SI and all exposed nodes of Y with BI + ---------------------------------------------------------------------- */ + qhead = qtail = 0; + for (x = 0; x < nX; x++) + if (matching[x] == FREE) + { queue[qtail++] = x; + dmflag[x] = SI; + } + else dmflag[x] = SR; + for (y = nX; y < nX+nY; y++) + if (matching[y] == FREE) + { queue[qtail++] = y; + dmflag[y] = BI; + } + else dmflag[y] = BR; + + /* ------------------------------------------------------------------ + construct Dulmage-Mendelsohn decomp. starting with SI and BI nodes + ------------------------------------------------------------------ */ + while (qhead != qtail) + { u = queue[qhead++]; + istart = xadj[u]; + istop = xadj[u+1]; + switch(dmflag[u]) + { case SI: + for (i = istart; i < istop; i++) + { y = adjncy[i]; + if (dmflag[y] == BR) + { queue[qtail++] = y; + dmflag[y] = BX; + } + } + break; + case BX: + x = matching[u]; + dmflag[x] = SI; + queue[qtail++] = x; + break; + case BI: + for (i = istart; i < istop; i++) + { x = adjncy[i]; + if (dmflag[x] == SR) + { queue[qtail++] = x; + dmflag[x] = SX; + } + } + break; + case SX: + y = matching[u]; + dmflag[y] = BI; + queue[qtail++] = y; + break; + } + } + + /* ---------------------- + fill the dmwght vector + ---------------------- */ + dmwght[SI] = dmwght[SX] = dmwght[SR] = 0; + for (x = 0; x < nX; x++) + switch(dmflag[x]) + { case SI: dmwght[SI] += vwght[x]; break; + case SX: dmwght[SX] += vwght[x]; break; + case SR: dmwght[SR] += vwght[x]; break; + } + dmwght[BI] = dmwght[BX] = dmwght[BR] = 0; + for (y = nX; y < nX+nY; y++) + switch(dmflag[y]) + { case BI: dmwght[BI] += vwght[y]; break; + case BX: dmwght[BX] += vwght[y]; break; + case BR: dmwght[BR] += vwght[y]; break; + } + + free(queue); +} + + +/***************************************************************************** +******************************************************************************/ +void +DMviaFlow(gbipart_t *Gbipart, int *flow, int *rc, int *dmflag, int *dmwght) +{ int *xadj, *adjncy, *vwght, *queue, qhead, qtail; + int u, v, x, nX, y, nY, i, istart, istop; + + xadj = Gbipart->G->xadj; + adjncy = Gbipart->G->adjncy; + vwght = Gbipart->G->vwght; + nX = Gbipart->nX; + nY = Gbipart->nY; + + mymalloc(queue, (nX+nY), int); + + /* ---------------------------------------------------------- + mark all nodes reachable from source/sink with SOURCE/SINK + ---------------------------------------------------------- */ + qhead = qtail = 0; + for (x = 0; x < nX; x++) + if (rc[x] > 0) + { queue[qtail++] = x; + dmflag[x] = SOURCE; + } + else dmflag[x] = FREE; + for (y = nX; y < nX+nY; y++) + if (rc[y] > 0) + { queue[qtail++] = y; + dmflag[y] = SINK; + } + else dmflag[y] = FREE; + + /* -------------------------------------------------------------------- + construct Dulmage-Mendelsohn decomp. starting with SOURCE/SINK nodes + -------------------------------------------------------------------- */ + while (qhead != qtail) + { u = queue[qhead++]; + istart = xadj[u]; + istop = xadj[u+1]; + switch(dmflag[u]) + { case SOURCE: + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if ((dmflag[v] == FREE) && ((v >= nX) || (flow[i] < 0))) + { queue[qtail++] = v; + dmflag[v] = SOURCE; /* v reachable via forward edge u->v */ + } /* or via backward edge u<-v */ + } + break; + case SINK: + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if ((dmflag[v] == FREE) && ((v < nX) || (flow[i] > 0))) + { queue[qtail++] = v; + dmflag[v] = SINK; /* u reachable via forward edge v->u */ + } /* or via backward edge v<-u */ + } + break; + } + } + + /* ----------------------------------------------------- + all nodes x in X with dmflag[x] = SOURCE belong to SI + all nodes x in X with dmflag[x] = SINK belong to SX + all nodes x in X with dmflag[x] = FREE belong to SR + ----------------------------------------------------- */ + dmwght[SI] = dmwght[SX] = dmwght[SR] = 0; + for (x = 0; x < nX; x++) + switch(dmflag[x]) + { case SOURCE: dmflag[x] = SI; dmwght[SI] += vwght[x]; break; + case SINK: dmflag[x] = SX; dmwght[SX] += vwght[x]; break; + default: dmflag[x] = SR; dmwght[SR] += vwght[x]; + } + + /* ----------------------------------------------------- + all nodes y in Y with dmflag[y] = SOURCE belong to BX + all nodes y in Y with dmflag[y] = SINK belong to BI + all nodes y in Y with dmflag[y] = FREE belong to BR + ----------------------------------------------------- */ + dmwght[BI] = dmwght[BX] = dmwght[BR] = 0; + for (y = nX; y < nX+nY; y++) + switch(dmflag[y]) + { case SOURCE: dmflag[y] = BX; dmwght[BX] += vwght[y]; break; + case SINK: dmflag[y] = BI; dmwght[BI] += vwght[y]; break; + default: dmflag[y] = BR; dmwght[BR] += vwght[y]; + } + + free(queue); +} + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/gbisect.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/gbisect.c new file mode 100644 index 000000000..dd98d5a26 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/gbisect.c @@ -0,0 +1,514 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: gbisect.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 00dec29 +/ +/ This file contains functions dealing with the graph bisection object +/ +****************************************************************************** + +Data type: struct gbisect + graph_t *G; pointer to graph that will be partitioned + int *color; color of node (GRAY, BLACK, or WHITE) + int cwght[3]; weights of GRAY, BLACK, WHITE partitions +Comments: + o Structure used to compute the bisection of a graph. Structure does not + own graph object => it will not be freed. +Methods in lib/gbisect.c: +- Gbisect = newGbisect(graph_t *G); + o Initial: cwght[GRAY] = cwght[BLACK] = cwght[WHITE] = 0 +- void freeGbisect(gbisect_t *Gbisect); +- void printGbisect(gbisect_t *Gbisect); +- void checkSeparator(gbisect_t *Gbisect); +- void constructSeparator(gbisect_t *Gbisect, options_t *options, + timings_t *cpus); + o constructs a vertex separator by applying the new multilevel approach; + it first constructs an initial domain decomposition for Gbisect->G + by calling constructDomainDecomposition; the dd is then coarsed by + several calls to shrinkDomainDecomposition; the last dd is colored + by a call to initialDDSep; this coloring is refined during the + uncoarsening phase by several calls to improveDDSep + o used options: + OPTION_MSGLVL, OPTION_NODE_SELECTION3 + returned timings: + TIME_INITDOMDEC, TIME_COARSEDOMDEC, TIME_INITSEP, TIME_REFINESEP +- int smoothBy2Layers(gbisect_t *Gbisect, int *bipartvertex, int *pnX, + int black, int white); + o on start, bipartvertex contains the nodes of the separator; the + separator is then paired with eiter the black or the white partition + so that the nodes in bipartvertex induce a bipartite graph; this + graph is constructed by setupBipartiteGraph; a Dulmage-Mendelsohn + decomposition is computed and the separator is smoothed; the + vertices of the smoothed separator are returned in bipartvertex +- void smoothSeparator(gbisect_t *Gbisect, options_t *options); + o smoothes a given separator by repeatedly calling smoothBy2Layers + o used options: OPTION_MSGLVL + +******************************************************************************/ + +#include +/* #define DEBUG */ +/* #define BE_CAUTIOUS */ + + +/***************************************************************************** +******************************************************************************/ +gbisect_t* +newGbisect(graph_t *G) +{ gbisect_t *Gbisect; + + mymalloc(Gbisect, 1, gbisect_t); + mymalloc(Gbisect->color, G->nvtx, int); + + Gbisect->G = G; + Gbisect->cwght[GRAY] = 0; + Gbisect->cwght[BLACK] = 0; + Gbisect->cwght[WHITE] = 0; + + return(Gbisect); +} + + +/***************************************************************************** +******************************************************************************/ +void +freeGbisect(gbisect_t *Gbisect) +{ + free(Gbisect->color); + free(Gbisect); +} + + +/***************************************************************************** +******************************************************************************/ +void +printGbisect(gbisect_t *Gbisect) +{ graph_t *G; + int count, u, v, i, istart, istop; + + G = Gbisect->G; + printf("\n#nodes %d, #edges %d, totvwght %d\n", G->nvtx, G->nedges >> 1, + G->totvwght); + printf("partition weights: S %d, B %d, W %d\n", Gbisect->cwght[GRAY], + Gbisect->cwght[BLACK], Gbisect->cwght[WHITE]); + for (u = 0; u < G->nvtx; u++) + { count = 0; + printf("--- adjacency list of node %d (weight %d, color %d)\n", u, + G->vwght[u], Gbisect->color[u]); + istart = G->xadj[u]; + istop = G->xadj[u+1]; + for (i = istart; i < istop; i++) + { v = G->adjncy[i]; + printf("%5d (color %2d)", v, Gbisect->color[v]); + if ((++count % 4) == 0) + printf("\n"); + } + if ((count % 4) != 0) + printf("\n"); + } +} + + +/***************************************************************************** +******************************************************************************/ +void +checkSeparator(gbisect_t *Gbisect) +{ int *xadj, *adjncy, *vwght, *color, *cwght; + int nvtx, err, checkS, checkB, checkW, a, b, u, v, i, istart, istop; + + nvtx = Gbisect->G->nvtx; + xadj = Gbisect->G->xadj; + adjncy = Gbisect->G->adjncy; + vwght = Gbisect->G->vwght; + color = Gbisect->color; + cwght = Gbisect->cwght; + + err = FALSE; + printf("checking separator of induced subgraph (S %d, B %d, W %d)\n", + cwght[GRAY], cwght[BLACK], cwght[WHITE]); + + checkS = checkB = checkW = 0; + for (u = 0; u < nvtx; u++) + { istart = xadj[u]; + istop = xadj[u+1]; + switch(color[u]) + { case GRAY: /* is it a minimal separator? */ + checkS += vwght[u]; + a = b = FALSE; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if (color[v] == WHITE) a = TRUE; + if (color[v] == BLACK) b = TRUE; + } + if (!((a) && (b))) + printf("WARNING: not a minimal separator (node %d)\n", u); + break; + case BLACK: /* is it realy a separator? */ + checkB += vwght[u]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if (color[v] == WHITE) + { printf("ERROR: white node %d adjacent to black node %d\n", u,v); + err = TRUE; + } + } + break; + case WHITE: + checkW += vwght[u]; + break; + default: + printf("ERROR: node %d has unrecognized color %d\n", u, color[u]); + err = TRUE; + } + } + + /* check cwght[GRAY], cwght[BLACK], cwght[WHITE] */ + if ((checkS != cwght[GRAY]) || (checkB != cwght[BLACK]) + || (checkW != cwght[WHITE])) + { printf("ERROR in partitioning: checkS %d (S %d), checkB %d (B %d), " + "checkW %d (W %d)\n", checkS, cwght[GRAY], checkB, cwght[BLACK], + checkW, cwght[WHITE]); + err = TRUE; + } + if (err) quit(); +} + + +/***************************************************************************** +******************************************************************************/ +void +constructSeparator(gbisect_t *Gbisect, options_t *options, timings_t *cpus) +{ domdec_t *dd, *dd2; + int *color, *cwght, *map, nvtx, u, i; + + nvtx = Gbisect->G->nvtx; + color = Gbisect->color; + cwght = Gbisect->cwght; + + /* -------------------------------------------------------------- + map vector identifies vertices of Gbisect->G in domain decomp. + -------------------------------------------------------------- */ + mymalloc(map, nvtx, int); + + /* -------------------------------------- + construct initial domain decomposition + -------------------------------------- */ + starttimer(cpus[TIME_INITDOMDEC]); + dd = constructDomainDecomposition(Gbisect->G, map); + +#ifdef BE_CAUTIOUS + checkDomainDecomposition(dd); +#endif + + if (options[OPTION_MSGLVL] > 2) + printf("\t 0. dom.dec.: #nodes %d (#domains %d, weight %d), #edges %d\n", + dd->G->nvtx, dd->ndom, dd->domwght, dd->G->nedges >> 1); + stoptimer(cpus[TIME_INITDOMDEC]); + + /* --------------------------------------------------- + construct sequence of coarser domain decompositions + --------------------------------------------------- */ + starttimer(cpus[TIME_COARSEDOMDEC]); + i = 0; + while ((dd->ndom > MIN_DOMAINS) && (i < MAX_COARSENING_STEPS) + && ((dd->G->nedges >> 1) > dd->G->nvtx)) + { shrinkDomainDecomposition(dd, options[OPTION_NODE_SELECTION3]); + dd = dd->next; i++; + +#ifdef BE_CAUTIOUS + checkDomainDecomposition(dd); +#endif + + if (options[OPTION_MSGLVL] > 2) + printf("\t %2d. dom.dec.: #nodes %d (#domains %d, weight %d), #edges %d" + "\n", i, dd->G->nvtx, dd->ndom, dd->domwght, dd->G->nedges >> 1); + } + stoptimer(cpus[TIME_COARSEDOMDEC]); + + /* ----------------------------------------------- + determine coloring of last domain decomposition + ------------------------------------------------ */ + starttimer(cpus[TIME_INITSEP]); + initialDDSep(dd); + if (dd->cwght[GRAY] > 0) + improveDDSep(dd); + +#ifdef BE_CAUTIOUS + checkDDSep(dd); +#endif + + if (options[OPTION_MSGLVL] > 2) + printf("\t %2d. dom.dec. sep.: S %d, B %d, W %d [cost %7.2f]\n", + i, dd->cwght[GRAY], dd->cwght[BLACK], dd->cwght[WHITE], + F(dd->cwght[GRAY], dd->cwght[BLACK], dd->cwght[WHITE])); + stoptimer(cpus[TIME_INITSEP]); + + /* -------------- + refine coloring + --------------- */ + + starttimer(cpus[TIME_REFINESEP]); + while (dd->prev != NULL) + { dd2 = dd->prev; + dd2->cwght[GRAY] = dd->cwght[GRAY]; + dd2->cwght[BLACK] = dd->cwght[BLACK]; + dd2->cwght[WHITE] = dd->cwght[WHITE]; + for (u = 0; u < dd2->G->nvtx; u++) + dd2->color[u] = dd->color[dd2->map[u]]; + freeDomainDecomposition(dd); + if (dd2->cwght[GRAY] > 0) + improveDDSep(dd2); + +#ifdef BE_CAUTIOUS + checkDDSep(dd2); +#endif + + dd = dd2; + i--; + if (options[OPTION_MSGLVL] > 2) + printf("\t %2d. dom.dec. sep.: S %d, B %d, W %d [cost %7.2f]\n", + i, dd->cwght[GRAY], dd->cwght[BLACK], dd->cwght[WHITE], + F(dd->cwght[GRAY], dd->cwght[BLACK], dd->cwght[WHITE])); + } + stoptimer(cpus[TIME_REFINESEP]); + + /* --------------------------------- + copy coloring to subgraph Gbisect + --------------------------------- */ + cwght[GRAY] = dd->cwght[GRAY]; + cwght[BLACK] = dd->cwght[BLACK]; + cwght[WHITE] = dd->cwght[WHITE]; + for (u = 0; u < nvtx; u++) + color[u] = dd->color[map[u]]; + freeDomainDecomposition(dd); + free(map); +} + + +/***************************************************************************** +******************************************************************************/ +int +smoothBy2Layers(gbisect_t *Gbisect, int *bipartvertex, int *pnX, + int black, int white) +{ gbipart_t *Gbipart; + int *xadj, *adjncy, *color, *cwght, *map; + int *flow, *rc, *matching, *dmflag, dmwght[6]; + int nvtx, smoothed, nX, nX2, nY, x, y, u, i, j, jstart, jstop; + + nvtx = Gbisect->G->nvtx; + xadj = Gbisect->G->xadj; + adjncy = Gbisect->G->adjncy; + color = Gbisect->color; + cwght = Gbisect->cwght; + nX = *pnX; + + /* ---------------------------------------------------- + map vector identifies vertices of Gbisect in Gbipart + ---------------------------------------------------- */ + mymalloc(map, nvtx, int); + + /* ---------------------------------- + construct set Y of bipartite graph + ---------------------------------- */ + nY = 0; + for (i = 0; i < nX; i++) + { x = bipartvertex[i]; + jstart = xadj[x]; + jstop = xadj[x+1]; + for (j = jstart; j < jstop; j++) + { y = adjncy[j]; + if (color[y] == black) + { bipartvertex[nX+nY++] = y; + color[y] = GRAY; + } + } + } + for (i = nX; i < nX+nY; i++) + { y = bipartvertex[i]; + color[y] = black; + } + + /* -------------------------------------------- + compute the Dulmage-Mendelsohn decomposition + -------------------------------------------- */ + Gbipart = setupBipartiteGraph(Gbisect->G, bipartvertex, nX, nY, map); + + mymalloc(dmflag, (nX+nY), int); + switch(Gbipart->G->type) + { case UNWEIGHTED: + mymalloc(matching, (nX+nY), int); + maximumMatching(Gbipart, matching); + DMviaMatching(Gbipart, matching, dmflag, dmwght); + free(matching); + break; + case WEIGHTED: + mymalloc(flow, Gbipart->G->nedges, int); + mymalloc(rc, (nX+nY), int); + maximumFlow(Gbipart, flow, rc); + DMviaFlow(Gbipart, flow, rc, dmflag, dmwght); + free(flow); + free(rc); + break; + default: + fprintf(stderr, "\nError in function smoothSeparator\n" + " unrecognized bipartite graph type %d\n", Gbipart->G->type); + quit(); + } + +#ifdef DEBUG + printf("Dulmage-Mendelsohn decomp. computed\n" + "SI %d, SX %d, SR %d, BI %d, BX %d, BR %d\n", dmwght[SI], dmwght[SX], + dmwght[SR], dmwght[BI], dmwght[BX], dmwght[BR]); +#endif + + /* ----------------------------------------------------------------------- + 1st TEST: try to exchange SI with BX, i.e. nodes in SI are moved from + the separator into white (white grows), and nodes in BX are moved from + black into the separator (black shrinks) + ----------------------------------------------------------------------- */ + smoothed = FALSE; + if (F(cwght[GRAY]-dmwght[SI]+dmwght[BX], cwght[black]-dmwght[BX], + cwght[white]+dmwght[SI]) + EPS < F(cwght[GRAY], cwght[black], + cwght[white])) + { smoothed = TRUE; + +#ifdef DEBUG + printf("exchange SI with BX\n"); +#endif + + cwght[white] += dmwght[SI]; cwght[GRAY] -= dmwght[SI]; + cwght[black] -= dmwght[BX]; cwght[GRAY] += dmwght[BX]; + for (i = 0; i < nX+nY; i++) + { u = bipartvertex[i]; + if (dmflag[map[u]] == SI) + color[u] = white; + if (dmflag[map[u]] == BX) + color[u] = GRAY; + } + } + + /* ----------------------------------------------------------------------- + 2nd TEST: try to exchange SR with BR, i.e. nodes in SR are moved from + the separator into white (white grows), and nodes in BR are moved from + black into the separator (black shrinks) + NOTE: SR is allowed to be exchanged with BR only if SI = BX = 0 or if + SI has been exchanged with BX (Adj(SR) is a subset of BX u BR) + ----------------------------------------------------------------------- */ + if ((F(cwght[GRAY]-dmwght[SR]+dmwght[BR], cwght[black]-dmwght[BR], + cwght[white]+dmwght[SR]) + EPS < F(cwght[GRAY], cwght[black], + cwght[white])) + && ((smoothed) || (dmwght[SI] == 0))) + { smoothed = TRUE; + +#ifdef DEBUG + printf("exchange SR with BR\n"); +#endif + + cwght[white] += dmwght[SR]; cwght[GRAY] -= dmwght[SR]; + cwght[black] -= dmwght[BR]; cwght[GRAY] += dmwght[BR]; + for (i = 0; i < nX+nY; i++) + { u = bipartvertex[i]; + if (dmflag[map[u]] == SR) + color[u] = white; + if (dmflag[map[u]] == BR) + color[u] = GRAY; + } + } + + /* ----------------------------------------------------- + fill bipartvertex with the nodes of the new separator + ----------------------------------------------------- */ + nX2 = 0; + for (i = 0; i < nX+nY; i++) + { u = bipartvertex[i]; + if (color[u] == GRAY) + bipartvertex[nX2++] = u; + } + *pnX = nX2; + + /* ------------------------------- + free working storage and return + ------------------------------- */ + free(map); free(dmflag); + freeBipartiteGraph(Gbipart); + return(smoothed); +} + + +/***************************************************************************** +******************************************************************************/ +void +smoothSeparator(gbisect_t *Gbisect, options_t *options) +{ int *xadj, *adjncy, *vwght, *color, *cwght, *bipartvertex; + int nvtx, nX, nX2, u, x, y, a, b, i, j, jstart, jstop; + + nvtx = Gbisect->G->nvtx; + xadj = Gbisect->G->xadj; + adjncy = Gbisect->G->adjncy; + vwght = Gbisect->G->vwght; + color = Gbisect->color; + cwght = Gbisect->cwght; + + mymalloc(bipartvertex, nvtx, int); + + /* ---------------------------------------------------------- + extract the separator (store its vertices in bipartvertex) + ---------------------------------------------------------- */ + nX = 0; + for (u = 0; u < nvtx; u++) + if (color[u] == GRAY) + bipartvertex[nX++] = u; + + do + { /* --------------------------------------------------------------- + minimize the separator (i.e. minimize set X of bipartite graph) + --------------------------------------------------------------- */ + cwght[GRAY] = nX2 = 0; + for (i = 0; i < nX; i++) + { x = bipartvertex[i]; + a = b = FALSE; + jstart = xadj[x]; + jstop = xadj[x+1]; + for (j = jstart; j < jstop; j++) + { y = adjncy[j]; + if (color[y] == WHITE) a = TRUE; + if (color[y] == BLACK) b = TRUE; + } + if ((a) && (!b)) + { color[x] = WHITE; cwght[WHITE] += vwght[x]; } + else if ((!a) && (b)) + { color[x] = BLACK; cwght[BLACK] += vwght[x]; } + else + { bipartvertex[nX2++] = x; cwght[GRAY] += vwght[x]; } + } + nX = nX2; + +#ifdef BE_CAUTIOUS + checkSeparator(Gbisect); +#endif + + /* ------------------------------------------------------------------ + smooth the unweighted/weighted separator + first pair it with the larger set; if unsuccessful try the smaller + ------------------------------------------------------------------ */ + if (cwght[BLACK] >= cwght[WHITE]) + { a = smoothBy2Layers(Gbisect, bipartvertex, &nX, BLACK, WHITE); + if (!a) + a = smoothBy2Layers(Gbisect, bipartvertex, &nX, WHITE, BLACK); + } + else + { a = smoothBy2Layers(Gbisect, bipartvertex, &nX, WHITE, BLACK); + if (!a) + a = smoothBy2Layers(Gbisect, bipartvertex, &nX, BLACK, WHITE); + } + if ((options[OPTION_MSGLVL] > 2) && (a)) + printf("\t separator smoothed: S %d, B %d, W %d [cost %7.2f]\n", + cwght[GRAY], cwght[BLACK], cwght[WHITE], + F(cwght[GRAY], cwght[BLACK], cwght[WHITE])); + } while (a); + + free(bipartvertex); +} + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/gelim.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/gelim.c new file mode 100644 index 000000000..3223c3307 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/gelim.c @@ -0,0 +1,1129 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: gelim.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 01jan10 +/ +/ This file contains functions dealing with the elimination graph object +/ +****************************************************************************** + +Data type: struct gelim + graph_t *G; pointer to graph object + int maxedges; max number of edges that can be stored + int *len; length of v's adjacency list + int *elen; number of elements adjacent to v + int *parent; parent in front tree / representative of v + int *degree; boundary size / (approximate) degree + int *score; holds the score of uneliminated vertex v +Comments: + o Structure used to hold the elimination graphs of a bottom-up ordering + o G->totvwght: total weight of all uneliminated vertices + o G->xadj[v] = -1 => there is no adjacency list for variable/element v + => variable v has degree 0 (in this case G->vwght[v] > 0) + => variable v istinguishable/removed by mass elimination + or element v has been absorbed (in this case G->vwght[v] = 0) + o G->vwght[v]: weight of the princial variable v; if v becomes an element, + weight[v] remains unchanged for the rest of the elim. process + = 0 => variable v is nonprincipal/removed by mass elimination + o len[v], elen[v]: the adjacency list of vertex/element v contains len[v] + entries; the first elen[v] entries are elements + (if v is an element, then elen[v] = 0 will hold) + o parent[v]: for an (absorbed) element, parent[v] points to the parent of + element v in the front tree; for an indistinguishable vertex, + parent[v] points to its representative vertex (which may have + also found to be indistinguishable to another one) + o degree[v]: for an uneliminated vertex, the (approximate) degree in Gelim; + for an element, the weight of its boundary (i.e. degree[v] + gives the exakt degree of v at the time of its elimination) + o score[v]: vertices are eliminated according to their score value >= 0; + additionally, the score vector is used to represent the status + of a node in the actual stage: + -1, iff variable v will be eliminated in an upcomming stage + -2, iff variable v is nonprincipal/removed by mass elim. + -3, iff variable v has been eliminated and now forms an element + -4, iff element v has been absorbed +Methods in lib/gelim.c +- Gelim = newElimGraph(int nvtx, int nedges); +- void freeElimGraph(gelim_t *Gelim); +- void printElimGraph(gelim_t *Gelim); +- Gelim = setupElimGraph(graph_t *G); + o allocates memory for the elimination graph by calling newElimGraph and + initializes the vectors, i.e. len[u] = xadj[u+1]-xadj[u]; elen[u] = 0; + parent[u] = -1; degree[u] = exact (external) degree of vertex u; + score[u] = -1; xadj[u] = -1, if len[u] = 0 +- int crunchElimGraph(gelim_t *Gelim); + o tries to compress the adjacency vector + on success the function return TRUE, otherwise FALSE +- void buildElement(gelim_t *Gelim, int me); + o turns variable me into an element; if me is an leaf, the element is + constructed in-place, otherwise its adjacency list is appended to G + o all relevant vectors are updated, i.e. + vwght[me] = 0, degree[me] = |Lme|, score[me] = -3 + for all neighboring elements: parent[e] = me, score[e] = -4 +- void updateAdjncy(gelim_t *Gelim, int *reachset, int nreach, int *tmp, + int *pflag); + o updates the adjacency structure of all vertices in reachset + IMPORTANT REQUIREMENTS: + (1) all values stored in tmp[u] are smaller than *pflag +- void findIndNodes(gelim_t *Gelim, int *reachset, int nreach, int *bin, + int *next, int *tmp, int *pflag); + o searches reachset for indistinguishable vertices + IMPORTANT REQUIREMENTS: + (1) the adjacency lists of all vertices in reachset have been updated + by a call to updateAdjncy + (2) bin[i] = -1 for all 0 <= i < G->nvtx + (3) all values stored in tmp[u] are smaller than *pflag + o on return bin[i] = -1 holds again +- void updateDegree(gelim_t *Gelim, int *reachset, int nreach, int *bin); + o computes new approximate degrees for all vertices in reachset + IMPORTANT REQUIREMENTS: + (1) the adjacency lists of all vertices in reachset have been updated + by a call to updateAdjncy + (2) the boundary size of each newly formed element has been computed + (3) bin[i] = -1 for all 0 <= i < G->nvtx + o on return bin[i] = -1 holds again +- void updateScore(gelim_t *Gelim, int *reachset, int nreach, int scoretype, + int *bin); + o updates the score of all vertices in reachset + IMPORTANT REQUIREMENTS: + (1) the approximate degrees are correctly computed (by updateDegree) + (2) bin[i] = -1 for all 0 <= i < G->nvtx + o on return bin[i] = -1 holds again +- T = extractElimTree(gelim_t *Gelim); + o uses the status of the nodes (stored in the score vector) and the + parent vector to set up the elimination tree T; vectors T->ncolfactor + and T->ncolupdate are initialized using vectors G->vwght and degree + +******************************************************************************/ + +#include +/* #define DEBUG */ + + +/***************************************************************************** +******************************************************************************/ +gelim_t* +newElimGraph(int nvtx, int nedges) +{ gelim_t *Gelim; + + mymalloc(Gelim, 1, gelim_t); + Gelim->G = newGraph(nvtx, nedges); + Gelim->maxedges = nedges; + + mymalloc(Gelim->len, nvtx, int); + mymalloc(Gelim->elen, nvtx, int); + mymalloc(Gelim->parent, nvtx, int); + mymalloc(Gelim->degree, nvtx, int); + mymalloc(Gelim->score, nvtx, int); + + return(Gelim); +} + + +/***************************************************************************** +******************************************************************************/ +void +freeElimGraph(gelim_t *Gelim) +{ + freeGraph(Gelim->G); + free(Gelim->len); + free(Gelim->elen); + free(Gelim->parent); + free(Gelim->degree); + free(Gelim->score); + free(Gelim); +} + + +/***************************************************************************** +******************************************************************************/ +void +printElimGraph(gelim_t *Gelim) +{ graph_t *G; + int count, u, v, i, istart; + + G = Gelim->G; + for (u = 0; u < G->nvtx; u++) + { istart = G->xadj[u]; + + /* --------------------------------------------------------------- + case 1: u is a principal variable + => vwght[u]: weight of all mapped indistinguishable variables + => degree[u]: approximate degree + ---------------------------------------------------------------- */ + if ((Gelim->score[u] == -1) || (Gelim->score[u] >= 0)) + { printf("--- adjacency list of variable %d (weight %d, degree %d, " + "score %d):\n", u, G->vwght[u], Gelim->degree[u], + Gelim->score[u]); + printf("elements:\n"); + count = 0; + for (i = istart; i < istart + Gelim->elen[u]; i++) + { printf("%5d", G->adjncy[i]); + if ((++count % 16) == 0) + printf("\n"); + } + if ((count % 16) != 0) + printf("\n"); + printf("variables:\n"); + count = 0; + for (i = istart + Gelim->elen[u]; i < istart + Gelim->len[u]; i++) + { printf("%5d", G->adjncy[i]); + if ((++count % 16) == 0) + printf("\n"); + } + if ((count % 16) != 0) + printf("\n"); + } + + /* --------------------------------------------------------------- + case 2: u is nonprincipal/removed by mass elimination + ---------------------------------------------------------------- */ + else if (Gelim->score[u] == -2) + printf("--- variable %d is nonprincipal/removed by mass elim. " + "(parent %d)\n", u, Gelim->parent[u]); + + /* ----------------------------------------------- + case 3: u is an element: + => degree[u]: weight of boundary + ----------------------------------------------- */ + else if (Gelim->score[u] == -3) + { printf("--- boundary of element %d (degree %d, score %d):" + "\n", u, Gelim->degree[u], Gelim->score[u]); + count = 0; + for (i = istart; i < istart + Gelim->len[u]; i++) + { v = G->adjncy[i]; + if (G->vwght[v] > 0) + { printf("%5d", G->adjncy[i]); + if ((++count % 16) == 0) + printf("\n"); + } + } + if ((count % 16) != 0) + printf("\n"); + } + + /* -------------------------------- + case 4: u is an absorbed element + -------------------------------- */ + else if (Gelim->score[u] == -4) + printf("--- element %d has been absorbed (parent %d)\n", u, + Gelim->parent[u]); + + /* ---------------------------------------- + none of the above cases is true => error + ---------------------------------------- */ + else + { fprintf(stderr, "\nError in function printElimGraph\n" + " node %d has invalid score %d\n", u, Gelim->score[u]); + quit(); + } + } +} + + +/***************************************************************************** +******************************************************************************/ +gelim_t* +setupElimGraph(graph_t *G) +{ gelim_t *Gelim; + int *xadj, *adjncy, *vwght, *xadjGelim, *adjncyGelim, *vwghtGelim; + int *len, *elen, *parent, *degree, *score; + int nvtx, nedges, deg, u, i, istart, istop; + + nvtx = G->nvtx; + nedges = G->nedges; + xadj = G->xadj; + adjncy = G->adjncy; + vwght = G->vwght; + + Gelim = newElimGraph(nvtx, nedges+nvtx); + xadjGelim = Gelim->G->xadj; + adjncyGelim = Gelim->G->adjncy; + vwghtGelim = Gelim->G->vwght; + len = Gelim->len; + elen = Gelim->elen; + parent = Gelim->parent; + degree = Gelim->degree; + score = Gelim->score; + + /* -------------- + copy the graph + -------------- */ + Gelim->G->type = G->type; + Gelim->G->totvwght = G->totvwght; + for (u = 0; u < nvtx; u++) + { xadjGelim[u] = xadj[u]; + vwghtGelim[u] = vwght[u]; + } + xadjGelim[nvtx] = xadj[nvtx]; + for (i = 0; i < nedges; i++) + adjncyGelim[i] = adjncy[i]; + Gelim->G->nedges = nedges; + + /* ---------------------- + initialize all vectors + ---------------------- */ + for (u = 0; u < nvtx; u++) + { istart = xadj[u]; + istop = xadj[u+1]; + len[u] = istop - istart; + elen[u] = 0; + parent[u] = -1; + deg = 0; + + switch(Gelim->G->type) /* compute the external degree of u */ + { case UNWEIGHTED: + deg = len[u]; + break; + case WEIGHTED: + for (i = istart; i < istop; i++) + deg += vwght[adjncy[i]]; + break; + default: + fprintf(stderr, "\nError in function setupElimGraph\n" + " unrecognized graph type %d\n", Gelim->G->type); + } + degree[u] = deg; + + if (len[u] == 0) /* len(u) = 0 => adjncy list of u not in use */ + xadjGelim[u] = -1; /* mark with -1, otherwise crunchElimGraph fails */ + score[u] = -1; + } + + return(Gelim); +} + + +/***************************************************************************** +******************************************************************************/ +int +crunchElimGraph(gelim_t *Gelim) +{ int *xadj, *adjncy, *len; + int nvtx, nedges, u, i, isrc, idest; + + nvtx = Gelim->G->nvtx; + nedges = Gelim->G->nedges; + xadj = Gelim->G->xadj; + adjncy = Gelim->G->adjncy; + len = Gelim->len; + + /* --------------------------------------------- + mark begining of u's adjacency list by -(u+1) + --------------------------------------------- */ + for (u = 0; u < nvtx; u++) + { i = xadj[u]; /* is adjacency list of u still in use? */ + if (i != -1) /* verify that list is non-empty */ + { if (len[u] == 0) + { fprintf(stderr, "\nError in function crunchElimGraph\n" + " adjacency list of node %d is empty\n", u); + quit(); + } + xadj[u] = adjncy[i]; /* if so, move first item to xadj[u] */ + adjncy[i] = -(u+1); /* u's adjacency list is headed by -(u+1) */ + if (len[u] == 0) + printf("error: u %d, len %d\n", u, len[u]); + } + } + + /* -------------------------- + crunch all adjacency lists + -------------------------- */ + idest = isrc = 0; + while (isrc < Gelim->G->nedges) + { u = adjncy[isrc++]; + if (u < 0) /* a new adjacency list starts here */ + { u = -u - 1; /* it's the adjacency list of u */ + adjncy[idest] = xadj[u]; /* first item was stored in xadj[u] */ + xadj[u] = idest++; + for (i = 1; i < len[u]; i++) + adjncy[idest++] = adjncy[isrc++]; + } + } + Gelim->G->nedges = idest; + + /* ------------------ + was it successful? + ------------------ */ + if (idest < nedges) return(TRUE); + else return (FALSE); +} + + +/***************************************************************************** +******************************************************************************/ +void +buildElement(gelim_t *Gelim, int me) +{ graph_t *G; + int *xadj, *adjncy, *vwght, *len, *elen, *parent, *degree, *score; + int degme, elenme, vlenme, mesrcptr, medeststart, medeststart2; + int medestptr, ln, p, i, j, v, e; + + G = Gelim->G; + xadj = G->xadj; + adjncy = G->adjncy; + vwght = G->vwght; + len = Gelim->len; + elen = Gelim->elen; + parent = Gelim->parent; + degree = Gelim->degree; + score = Gelim->score; + + /* --------------------------------- + construct boundary of element Lme + --------------------------------- */ + degme = 0; + G->totvwght -= vwght[me]; /* me eliminated => reduce weight of Gelim */ + vwght[me] = -vwght[me]; + score[me] = -3; /* variable me becomes an element */ + + elenme = elen[me]; + vlenme = len[me] - elenme; + mesrcptr = xadj[me]; + + /* ----------------------------------------------------------- + if me is a leaf => its boundary can be constructed in-place + ----------------------------------------------------------- */ + if (elenme == 0) + { medeststart = xadj[me]; /* Lme overwrites old variable */ + medestptr = medeststart; /* boundary of Lme starts here */ + for (i = 0; i < vlenme; i++) + { v = adjncy[mesrcptr++]; + if (vwght[v] > 0) /* v not yet placed in boundary */ + { degme += vwght[v]; /* increase size of Lme */ + vwght[v] = -vwght[v]; /* flag v as being in Lme */ + adjncy[medestptr++] = v; + } + } + } + + /* ------------------------------------------------------------------- + me is not a leaf => its boundary must be constructed in empty space + ------------------------------------------------------------------- */ + else + { medeststart = G->nedges; /* Lme appended to graph */ + medestptr = medeststart; /* boundary of Lme starts here */ + for (i = 0; i <= elenme; i++) + { if (i < elenme) /* working on elements */ + { len[me]--; + e = adjncy[mesrcptr++]; /* merge boundary of element e with Lme */ + p = xadj[e]; /* adjacency list of e starts here */ + ln = len[e]; + } + else + { e = me; /* merge uncovered variables with Lme */ + p = mesrcptr; /* variables start here */ + ln = vlenme; + } + for (j = 0; j < ln; j++) + { len[e]--; /* pick next variable, decrease length */ + v = adjncy[p++]; + if (vwght[v] > 0) + { degme += vwght[v]; /* increase size of Lme */ + vwght[v] = -vwght[v]; /* flag v as being in Lme */ + + /* ------------------------------------------ + add v to Lme, compress adjncy if necessary + ------------------------------------------ */ + if (medestptr == Gelim->maxedges) + { if (len[me] == 0) xadj[me] = -1; + else xadj[me] = mesrcptr; + if (len[e] == 0) xadj[e] = -1; + else xadj[e] = p; + + /* crunch adjacency list -- !!!we need more memory!!! */ + if (!crunchElimGraph(Gelim)) + { fprintf(stderr, "\nError in function buildElement\n" + " unable to construct element (not enough memory)\n"); + quit(); + } + + /* crunch partially constructed element me */ + medeststart2 = G->nedges; + for (p = medeststart; p < medestptr; p++) + adjncy[G->nedges++] = adjncy[p]; + medeststart = medeststart2; + medestptr = G->nedges; + + mesrcptr = xadj[me]; + p = xadj[e]; + } + adjncy[medestptr++] = v; + } + } + + /* ---------------------- + mark absorbed elements + ---------------------- */ + if (e != me) + { xadj[e] = -1; + parent[e] = me; + score[e] = -4; + } + } + + G->nedges = medestptr; /* new element Lme ends here */ + } + + /* ----------------------------------- + element me successfully constructed + ----------------------------------- */ + degree[me] = degme; + xadj[me] = medeststart; + vwght[me] = -vwght[me]; + elen[me] = 0; + len[me] = medestptr - medeststart; + if (len[me] == 0) + xadj[me] = -1; + + /* --------------------------- + unmark all variables in Lme + --------------------------- */ + mesrcptr = xadj[me]; + vlenme = len[me]; + for (i = 0; i < vlenme; i++) + { v = adjncy[mesrcptr++]; + vwght[v] = -vwght[v]; + } +} + + +/***************************************************************************** +******************************************************************************/ +void +updateAdjncy(gelim_t *Gelim, int *reachset, int nreach, int *tmp, int *pflag) +{ int *xadj, *adjncy, *vwght, *len, *elen, *parent, *score; + int u, v, e, me, i, j, jj, jdest, jfirstolde, jfirstv, jstart, jstop; + int covered, marku; + + xadj = Gelim->G->xadj; + adjncy = Gelim->G->adjncy; + vwght = Gelim->G->vwght; + len = Gelim->len; + elen = Gelim->elen; + parent = Gelim->parent; + score = Gelim->score; + + /* ----------------------------------------------------------------- + build the new element/variable list for each variable in reachset + ----------------------------------------------------------------- */ + for (i = 0; i < nreach; i++) + { u = reachset[i]; + vwght[u] = -vwght[u]; /* mark all variables in reachset */ + jstart = xadj[u]; + jstop = xadj[u] + len[u]; + jdest = jfirstolde = jstart; + +#ifdef DEBUG + printf("Updating adjacency list of node %d\n", u); +#endif + + /* -------------------------------------------------------- + scan the list of elements associated with variable u + place newly formed elements at the beginning of the list + -------------------------------------------------------- */ + for (j = jstart; j < jstart + elen[u]; j++) + { e = adjncy[j]; + +#ifdef DEBUG + printf(" >> element %d (score %d, parent %d)\n", e,score[e],parent[e]); +#endif + + if (score[e] == -4) /* e has been absorbed in this elim. step */ + { me = parent[e]; /* me is the newly formed element */ + if (tmp[me] < *pflag) + { adjncy[jdest++] = adjncy[jfirstolde]; /* move 1st old e to end */ + adjncy[jfirstolde++] = me; /* append me at the beg. */ + tmp[me] = *pflag; + } + } + else /* e has not been absorbed, i.e. it is */ + if (tmp[e] < *pflag) /* an old element */ + { adjncy[jdest++] = e; + tmp[e] = *pflag; + } + } + jfirstv = jdest; /* list of variables starts here */ + + /* ------------------------------------------------------- + scan the list of variables associated with variable u + place newly formed elements at the begining of the list + ------------------------------------------------------- */ + for (j = jstart + elen[u]; j < jstop; j++) + { v = adjncy[j]; + +#ifdef DEBUG + printf(" >> variable %d (score %d)\n", v, score[v]); +#endif + + if (score[v] == -3) /* v has been eliminated in this step */ + { if (tmp[v] < *pflag) /* and, thus, forms a newly created elem. */ + { adjncy[jdest++] = adjncy[jfirstv]; /* move 1st var. to end */ + adjncy[jfirstv++] = adjncy[jfirstolde]; /* move 1st old e to end */ + adjncy[jfirstolde++] = v; /* append v at the beg. */ + tmp[v] = *pflag; + } + } + else + adjncy[jdest++] = v; /* v is still a variable */ + } + elen[u] = jfirstv - jstart; + len[u] = jdest - jstart; + (*pflag)++; /* clear tmp for next round */ + +#ifdef DEBUG + printf(" node %d: neighboring elements:\n", u); + for (j = jstart; j < jstart + elen[u]; j++) + printf("%5d", adjncy[j]); + printf("\n node %d: neighboring variables:\n", u); + for (j = jstart + elen[u]; j < jstart + len[u]; j++) + printf("%5d", adjncy[j]); + printf("\n"); +#endif + } + + /* --------------------------------------------------------- + remove from each list all covered edges between variables + --------------------------------------------------------- */ + for (i = 0; i < nreach; i++) + { u = reachset[i]; + jstart = xadj[u]; + jstop = jstart + len[u]; + marku = FALSE; + + for (jdest = j = jstart + elen[u]; j < jstop; j++) + { v = adjncy[j]; + if (vwght[v] > 0) /* v does not belong to reachset */ + adjncy[jdest++] = v; /* edge (u,v) not covered */ + if (vwght[v] < 0) /* both vertices belong to reachset */ + { covered = FALSE; /* check for a common element */ + if (!marku) + { for (jj = jstart; jj < jstart + elen[u]; jj++) /* mark elem. */ + tmp[adjncy[jj]] = *pflag; /* of u */ + marku = TRUE; + } + for (jj = xadj[v]; jj < xadj[v] + elen[v]; jj++) /* check elem. */ + if (tmp[adjncy[jj]] == *pflag) /* of v */ + { covered = TRUE; + break; + } + if (!covered) + adjncy[jdest++] = v; + } + } + len[u] = jdest - jstart; + (*pflag)++; /* clear tmp for next round */ + +#ifdef DEBUG + printf(" node %d: neighboring uncovered variables:\n", u); + for (j = jstart + elen[u]; j < jstart + len[u]; j++) + printf("%5d", adjncy[j]); + printf("\n"); +#endif + } + + /* -------------------------------- + unmark all variables in reachset + -------------------------------- */ + for (i = 0; i < nreach; i++) + { u = reachset[i]; + vwght[u] = -vwght[u]; + } +} + + +/***************************************************************************** +******************************************************************************/ +void +findIndNodes(gelim_t *Gelim, int *reachset, int nreach, int *bin, int *next, + int *tmp, int *pflag) +{ int *xadj, *adjncy, *vwght, *len, *elen, *parent, *score; + int nvtx, chk, keepon, u, v, w, wlast, i, j, jstart, jstop, jstep, jj, jjstop; + nvtx = Gelim->G->nvtx; + xadj = Gelim->G->xadj; + adjncy = Gelim->G->adjncy; + vwght = Gelim->G->vwght; + len = Gelim->len; + elen = Gelim->elen; + parent = Gelim->parent; + score = Gelim->score; + +#ifdef DEBUG + printf("Checking reachset for indistinguishable variables\n"); +#endif + + /* ----------------------------------------------------------------------- + compute checksums for all principal variables on reachset and fill bins + NOTE: checksums are stored in parent vector + ----------------------------------------------------------------------- */ + for (i = 0; i < nreach; i++) + { u = reachset[i]; + chk = 0; + jstart = xadj[u]; + jstop = jstart + len[u]; + /* Modified by JYL: 16 march 2005: + * This code was failing in case of + * overflow. + for (j = jstart; j < jstop; j++) + chk += adjncy[j]; + chk = chk % nvtx; + */ + jstep=max(1000000000/nvtx,1); + for (j = jstart; j < jstop; j+=jstep) + { + jjstop = min(jstop, j+jstep); + for (jj = j; jj < jjstop; jj++) + chk += adjncy[jj]; + chk = chk % nvtx; + } + + parent[u] = chk; + /* JYL: temporary: + if (parent[u] < - 10) + printf("Probleme %d \n",chk);*/ + next[u] = bin[chk]; + bin[chk] = u; + } + + /* ----------------------- + supervariable detection + ----------------------- */ + for (i = 0; i < nreach; i++) + { u = reachset[i]; + if (vwght[u] > 0) /* u is a principal variable */ + { chk = parent[u]; /* search bin[chk] for ind. nodes */ + v = bin[chk]; /* okay, v is the first node in this bin */ + bin[chk] = -1; /* no further examinations of this bin */ + while (v != -1) + { jstart = xadj[v]; + jstop = xadj[v] + len[v]; + for (j = jstart; j < jstop; j++) + tmp[adjncy[j]] = *pflag; + w = next[v]; /* v is principal and w is a potential */ + wlast = v; /* nonprincipal variable */ + while (w != -1) + { keepon = TRUE; + if ((len[w] != len[v]) || (elen[w] != elen[v]) + || ((score[w] < 0) && (score[v] >= 0)) + || ((score[w] >= 0) && (score[v] < 0))) + keepon = FALSE; + if (keepon) + { for (jj = xadj[w]; jj < xadj[w] + len[w]; jj++) + if (tmp[adjncy[jj]] < *pflag) + { keepon = FALSE; + break; + } + } + if (keepon) /* found it! mark w as nonprincipal */ + { parent[w] = v; /* representative of w is v */ + /* Temporary JY + if (parent[w] < - 10) + printf("Probleme\n"); + */ +#ifdef DEBUG + printf(" non-principal variable %d (score %d) mapped onto " + "%d (score %d)\n", w, score[w], v, score[v]); +#endif + + vwght[v] += vwght[w]; /* add weight of w */ + vwght[w] = 0; + xadj[w] = -1; /* w's adjacency list can be over- */ + score[w] = -2; /* written during next crunch */ + w = next[w]; + next[wlast] = w; /* remove w from bin */ + } + else /* failed */ + { wlast = w; + w = next[w]; + } + } + v = next[v]; /* no more variables can be absorbed by v */ + (*pflag)++; /* clear tmp vector for next round */ + } + } + } + + /* ------------------------------------------------------- + re-initialize parent vector for all principal variables + ------------------------------------------------------- */ + for (i = 0; i < nreach; i++) + { u = reachset[i]; + if (vwght[u] > 0) + parent[u] = -1; + } +} + + +/***************************************************************************** +******************************************************************************/ +void +updateDegree(gelim_t *Gelim, int *reachset, int nreach, int *bin) +{ int *xadj, *adjncy, *vwght, *len, *elen, *degree; + int totvwght, deg, vwghtv, u, v, w, e, me, r, i, istart, istop; + int j, jstart, jstop; + + totvwght = Gelim->G->totvwght; + xadj = Gelim->G->xadj; + adjncy = Gelim->G->adjncy; + vwght = Gelim->G->vwght; + len = Gelim->len; + elen = Gelim->elen; + degree = Gelim->degree; + + /* ------------------------------------------------------------------- + degree update only for those vertices in reachset that are adjacent + to an element + ------------------------------------------------------------------- */ + for (r = 0; r < nreach; r++) + { u = reachset[r]; + if (elen[u] > 0) + bin[u] = 1; + } + + /* ----------------------------------------- + and now do the approximate degree updates + ----------------------------------------- */ + for (r = 0; r < nreach; r++) + { u = reachset[r]; + if (bin[u] == 1) /* me is the most recently formed element */ + { me = adjncy[xadj[u]]; /* in the neighborhood of u */ + +#ifdef DEBUG + printf("Updating degree of all variables in L(%d) (initiated by %d)\n", + me, u); +#endif + + /* ---------------------------------------------------------------- + compute in bin[e] the size of Le\Lme for all unabsorbed elements + ---------------------------------------------------------------- */ + istart = xadj[me]; + istop = istart + len[me]; /* compute in bin[e] the size */ + for (i = istart; i < istop; i++) /* of Le/Lme for all elements */ + { v = adjncy[i]; /* e != me that are adjacent */ + vwghtv = vwght[v]; /* to a principal var. e Lme */ + if (vwghtv > 0) + { jstart = xadj[v]; + jstop = jstart + elen[v]; + for (j = jstart; j < jstop; j++) + { e = adjncy[j]; + if (e != me) + { if (bin[e] > 0) bin[e] -= vwghtv; + else bin[e] = degree[e] - vwghtv; + } + } + } + } + +#ifdef DEBUG + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if (vwght[v] > 0) + for (j = xadj[v]; j < xadj[v] + elen[v]; j++) + { e = adjncy[j]; + if (e != me) + printf(" >> element %d: degree %d, outer degree %d\n", e, + degree[e], bin[e]); + } + } +#endif + + /* ------------------------------------------------------ + update approx. degree for all v in Lme with bin[v] = 1 + ------------------------------------------------------ */ + for (i = istart; i < istop; i++) + { v = adjncy[i]; /* update the upper bound deg. */ + vwghtv = vwght[v]; /* of all principal variables */ + deg = 0; /* in Lme that have not been */ + if (bin[v] == 1) /* updated yet */ + { jstart = xadj[v]; + jstop = jstart + len[v]; + + /* scan the element list associated with principal v */ + for (j = jstart; j < jstart + elen[v]; j++) + { e = adjncy[j]; + if (e != me) deg += bin[e]; + } + + /* scan the supervariables in the list associated with v */ + for (j = jstart + elen[v]; j < jstop; j++) + { w = adjncy[j]; + deg += vwght[w]; + } + + /* compute the external degree of v (add size of Lme) */ + deg = min(degree[v], deg); + degree[v] = max(1, min(deg+degree[me]-vwghtv, totvwght-vwghtv)); + bin[v] = -1; + +#ifdef DEBUG + printf(" >> variable %d (totvwght %d, vwght %d): deg %d, " + "degme %d, approx degree %d\n", v, totvwght, vwghtv, deg, + degree[me], degree[v]); +#endif + } + } + + /* ------------------------------------ + clear bin[e] of all elements e != me + ------------------------------------ */ + for (i = istart; i < istop; i++) + { v = adjncy[i]; + vwghtv = vwght[v]; + if (vwghtv > 0) + { jstart = xadj[v]; + jstop = jstart + elen[v]; + for (j = jstart; j < jstop; j++) + { e = adjncy[j]; + if (e != me) bin[e] = -1; + } + } + } + } + } +} + + +/***************************************************************************** +******************************************************************************/ +void +updateScore(gelim_t *Gelim, int *reachset, int nreach, int scoretype, int *bin) +{ int *xadj, *adjncy, *vwght, *len, *elen, *degree, *score; + int vwghtv, deg, degme, u, v, me, r, i, istart, istop; + /* Modified by JYL, 16 march 2005. + * scr could overflow for quasi dense rows. + * Use a double instead for large degrees + * aset it near to MAX_INT in case of problem. + */ + double scr_dbl; + int scr; + + xadj = Gelim->G->xadj; + adjncy = Gelim->G->adjncy; + vwght = Gelim->G->vwght; + len = Gelim->len; + elen = Gelim->elen; + degree = Gelim->degree; + score = Gelim->score; + + /* ------------------------------------------------------------------ + score update only for those vertices in reachset that are adjacent + to an element + ------------------------------------------------------------------ */ + for (r = 0; r < nreach; r++) + { u = reachset[r]; + if (elen[u] > 0) + bin[u] = 1; + } + + /* ---------------------------- + and now do the score updates + ---------------------------- */ + scoretype = scoretype % 10; + for (r = 0; r < nreach; r++) + { u = reachset[r]; + if (bin[u] == 1) /* me is the most recently formed element */ + { me = adjncy[xadj[u]]; /* in the neighborhood of u */ + +#ifdef DEBUG + printf("Updating score of all variables in L(%d) (initiated by %d)\n", + me, u); +#endif + + istart = xadj[me]; + istop = xadj[me] + len[me]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; /* update score of all principal */ + if (bin[v] == 1) /* variables in Lme that have not */ + { vwghtv = vwght[v]; /* been updated yet */ + deg = degree[v]; + degme = degree[me] - vwghtv; + if (deg > 40000 || degme > 40000) + { + switch(scoretype) + { case AMD: + scr_dbl = (double)deg; + break; + case AMF: + scr_dbl = (double)deg*(double)(deg-1)/2 - (double)degme*(double)(degme-1)/2; + break; + case AMMF: + scr_dbl = ((double)deg*(double)(deg-1)/2 - (double)degme*(double)(degme-1)/2) / (double)vwghtv; + break; + case AMIND: + scr_dbl = max(0, ((double)deg*(double)(deg-1)/2 - (double)degme*(double)(degme-1)/2) + - (double)deg*(double)vwghtv); + break; + default: + fprintf(stderr, "\nError in function updateScore\n" + " unrecognized selection strategy %d\n", scoretype); + quit(); + } + /* Some buckets have offset nvtx / 2. + * Using MAX_INT - nvtx should then be safe */ + score[v] = (int) (min(scr_dbl,MAX_INT-Gelim->G->nvtx)); + } + else + { + switch(scoretype) + { case AMD: + scr = deg; + break; + case AMF: + scr = deg*(deg-1)/2 - degme*(degme-1)/2; + break; + case AMMF: + scr = (deg*(deg-1)/2 - degme*(degme-1)/2) / vwghtv; + break; + case AMIND: + scr = max(0, (deg*(deg-1)/2 - degme*(degme-1)/2) + - deg*vwghtv); + break; + default: + fprintf(stderr, "\nError in function updateScore\n" + " unrecognized selection strategy %d\n", scoretype); + quit(); + } + score[v] = scr; + } + bin[v] = -1; + +#ifdef DEBUG + printf(" >> variable %d (me %d): weight %d, (ext)degme %d, " + "degree %d, score %d\n", u, me, vwghtv, degme, degree[v], + score[v]); +#endif + + if (score[v] < 0) + { fprintf(stderr, "\nError in function updateScore\n" + " score[%d] = %d is negative\n", v, score[v]); + quit(); + } + } + } + } + } +} + + +/*****************************************************************************) +******************************************************************************/ +elimtree_t* +extractElimTree(gelim_t *Gelim) +{ elimtree_t *T; + int *vwght, *par, *degree, *score, *sib, *fch; + int *ncolfactor, *ncolupdate, *parent, *vtx2front; + int nvtx, nfronts, root, u, v, front; + + nvtx = Gelim->G->nvtx; + vwght = Gelim->G->vwght; + par = Gelim->parent; + degree = Gelim->degree; + score = Gelim->score; + + /* ------------------------ + allocate working storage + ------------------------ */ + mymalloc(sib, nvtx, int); + mymalloc(fch, nvtx, int); + for (u = 0; u < nvtx; u++) + sib[u] = fch[u] = -1; + + /* -------------------------------------------------------------- + count fronts and create top-down view of the tree given by par + -------------------------------------------------------------- */ + nfronts = 0; + root = -1; + for (u = 0; u < nvtx; u++) + switch(score[u]) + { case -2: /* variable u is nonprincipal */ + break; + case -3: /* variable u has been elim. and now forms an elem. */ + sib[u] = root; + root = u; + nfronts++; + break; + case -4: /* element u has been absorbed by par[u] */ + v = par[u]; + sib[u] = fch[v]; + fch[v] = u; + nfronts++; + break; + default: + fprintf(stderr, "\nError in function extractElimTree\n" + " ordering not complete (score[%d] = %d)\n", u, score[u]); + quit(); + } + +#ifdef DEBUG + for (u = 0; u < nvtx; u++) + printf("node %d: score %d, par %d, fch %d, sib %d\n", u, score[u], + par[u], fch[u], sib[u]); +#endif + + /* -------------------------------------- + allocate space for the elimtree object + -------------------------------------- */ + T = newElimTree(nvtx, nfronts); + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + parent = T->parent; + vtx2front = T->vtx2front; + + /* ------------------------------------------------------------- + fill the vtx2front vector so that representative vertices are + mapped in a post-order traversal + ------------------------------------------------------------- */ + nfronts = 0; + u = root; + while (u != -1) + { while (fch[u] != -1) + u = fch[u]; + vtx2front[u] = nfronts++; + while ((sib[u] == -1) && (par[u] != -1)) + { u = par[u]; + vtx2front[u] = nfronts++; + } + u = sib[u]; + } + + /* --------------------------------------------------- + fill in the vtx2front map for nonprincipal vertices + --------------------------------------------------- */ + for (u = 0; u < nvtx; u++) + if (score[u] == -2) + { v = u; + while ((par[v] != -1) && (score[v] == -2)) + v = par[v]; + vtx2front[u] = vtx2front[v]; + } + + /* ------------------------------------------------------------- + set up the parent vector of T and fill ncolfactor, ncolupdate + ------------------------------------------------------------- */ + for (u = 0; u < nvtx; u++) + { front = vtx2front[u]; + if (score[u] == -3) + { parent[front] = -1; + ncolfactor[front] = vwght[u]; + ncolupdate[front] = degree[u]; + } + if (score[u] == -4) + { parent[front] = vtx2front[par[u]]; + ncolfactor[front] = vwght[u]; + ncolupdate[front] = degree[u]; + } + } + + /* ---------------------------- + set up all other arrays of T + ---------------------------- */ + initFchSilbRoot(T); + + /* ---------------------- + free memory and return + ---------------------- */ + free(sib); free(fch); + return(T); +} + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/graph.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/graph.c new file mode 100644 index 000000000..82db4a7bb --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/graph.c @@ -0,0 +1,541 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: graph.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 99sep14 +/ +/ This file contains functions dealing with the graph object. +/ +****************************************************************************** + +Data type: struct graph + int nvtx; number of vertices + int nedges; number of edges + int type; vertices can be UNWEIGTHED or WEIGTHED + int totvwght; total vertex weight + int *xadj; xadj[u] points to start of u's adjacency list + int *adjncy; holds the adjacency lists + int *vwght; holds the vertex weights +Comments: + o no edge weights are stored. In our application weighted graphs re- + present compressed unweighted graphs and, therefore, ewght[(u,v)] = + vwght[u] * vwght[v]. +Methods in lib/graph.c: +- G = newGraph(int nvtx, int nedges); + o Initial: we assume that G is unweighted, therefore: + type = UNWEIGTHED, totvwght = nvtx, and vwght[u] = 1 +- void freeGraph(graph_t *G); +- void printGraph(graph_t *G); +- void randomizeGraph(graph_t *G); +- Gsub = setupSubgraph(graph_t *G, int *intvertex, int nvint, int *vtxmap); + o extracts the subgraph induced by the vertices in array intvertex from G. + vtxmap maps the vertices in intvertex to the vertices of the subgraph. +- G = setupGraphFromMtx(inputMtx_t *A); +- G = setupGridGraph(int dimX, int dimY, int type); + o type e {GRID, MESH, TORUS} +- int connectedComponents(graph_t *G); +- cG = compressGraph(graph_t *G, int *vtxmap) + o cG = NULL, if there are not enough ind. vertices (see COMPRESS_FRACTION) + o for u in G vtxmap[u] points to representative of u in cG + +******************************************************************************/ + +#include + + +/***************************************************************************** +******************************************************************************/ +graph_t* +newGraph(int nvtx, int nedges) +{ graph_t *G; + int i; + + mymalloc(G, 1, graph_t); + mymalloc(G->xadj, (nvtx+1), int); + mymalloc(G->adjncy, nedges, int); + mymalloc(G->vwght, nvtx, int); + + G->nvtx = nvtx; + G->nedges = nedges; + G->type = UNWEIGHTED; + G->totvwght = nvtx; + for (i = 0; i < nvtx; i++) + G->vwght[i] = 1; + + return(G); +} + + +/***************************************************************************** +******************************************************************************/ +void +freeGraph(graph_t *G) +{ + free(G->xadj); + free(G->adjncy); + free(G->vwght); + free(G); +} + + +/***************************************************************************** +******************************************************************************/ +void +printGraph(graph_t *G) +{ int count, u, i, istart, istop; + + printf("\n#vertices %d, #edges %d, type %d, totvwght %d\n", G->nvtx, + G->nedges >> 1, G->type, G->totvwght); + for (u = 0; u < G->nvtx; u++) + { count = 0; + printf("--- adjacency list of vertex %d (weight %d):\n", u, G->vwght[u]); + istart = G->xadj[u]; + istop = G->xadj[u+1]; + for (i = istart; i < istop; i++) + { printf("%5d", G->adjncy[i]); + if ((++count % 16) == 0) + printf("\n"); + } + if ((count % 16) != 0) + printf("\n"); + } +} + + +/***************************************************************************** +******************************************************************************/ +void +randomizeGraph(graph_t *G) +{ int *xadj, *adjncy, nvtx, u, v, len, j, i, istart, istop; + + nvtx = G->nvtx; + xadj = G->xadj; + adjncy = G->adjncy; + + for (u = 0; u < nvtx; u++) + { istart = xadj[u]; + istop = xadj[u+1]; + if ((len = istop - istart) > 1) + for (i = istart; i < istop; i++) + { j = myrandom(len); + swap(adjncy[i], adjncy[i+j], v); + len--; + } + } +} + + +/***************************************************************************** +******************************************************************************/ +graph_t* +setupSubgraph(graph_t *G, int *intvertex, int nvint, int *vtxmap) +{ graph_t *Gsub; + int *xadj, *adjncy, *vwght, *xadjGsub, *adjncyGsub, *vwghtGsub; + int nvtx, nedgesGsub, totvwght, u, v, i, j, jstart, jstop, ptr; + + nvtx = G->nvtx; + xadj = G->xadj; + adjncy = G->adjncy; + vwght = G->vwght; + + /* ------------------------------------------------------------- + compute number of edges and local indices of vertices in Gsub + ------------------------------------------------------------- */ + nedgesGsub = 0; + for (i = 0; i < nvint; i++) + { u = intvertex[i]; + if ((u < 0) || (u >= nvtx)) + { fprintf(stderr, "\nError in function setupSubgraph\n" + " node %d does not belong to graph\n", u); + quit(); + } + jstart = xadj[u]; + jstop = xadj[u+1]; + for (j = jstart; j < jstop; j++) + vtxmap[adjncy[j]] = -1; + nedgesGsub += (jstop - jstart); + } + for (i = 0; i < nvint; i++) + { u = intvertex[i]; + vtxmap[u] = i; + } + + Gsub = newGraph(nvint, nedgesGsub); + xadjGsub = Gsub->xadj; + adjncyGsub = Gsub->adjncy; + vwghtGsub = Gsub->vwght; + + /* -------------------------- + build the induced subgraph + -------------------------- */ + totvwght = 0; ptr = 0; + for (i = 0; i < nvint; i++) + { u = intvertex[i]; + xadjGsub[i] = ptr; + vwghtGsub[i] = vwght[u]; + totvwght += vwght[u]; + jstart = xadj[u]; + jstop = xadj[u+1]; + for (j = jstart; j < jstop; j++) + { v = adjncy[j]; + if (vtxmap[v] >= 0) + adjncyGsub[ptr++] = vtxmap[v]; + } + } + xadjGsub[nvint] = ptr; + Gsub->type = G->type; + Gsub->totvwght = totvwght; + return(Gsub); +} + +/***************************************************************************** +******************************************************************************/ +graph_t* +setupGraphFromMtx(inputMtx_t *A) +{ graph_t *G; + int *xnza, *nzasub, *xadj, *adjncy; + int neqs, nelem, nvtx, k, h1, h2, j, i, istart, istop; + + neqs = A->neqs; + nelem = A->nelem; + xnza = A->xnza; + nzasub = A->nzasub; + + /* ------------------------------------ + allocate memory for unweighted graph + ------------------------------------ */ + G = newGraph(neqs, 2*nelem); + nvtx = G->nvtx; + xadj = G->xadj; + adjncy = G->adjncy; + + /* ----------------------------------------- + determine the size of each adjacency list + ----------------------------------------- */ + for (k = 0; k < neqs; k++) + xadj[k] = xnza[k+1] - xnza[k]; + for (k = 0; k < nelem; k++) + xadj[nzasub[k]]++; + + /* ------------------------------------------------------------- + determine for each vertex where its adjacency list will start + ------------------------------------------------------------- */ + h1 = xadj[0]; + xadj[0] = 0; + for (k = 1; k <= nvtx; k++) + { h2 = xadj[k]; + xadj[k] = xadj[k-1] + h1; + h1 = h2; + } + + /* ------------------------ + fill the adjacency lists + ------------------------ */ + for (k = 0; k < neqs; k++) + { istart = xnza[k]; + istop = xnza[k+1]; + for (i = istart; i < istop; i++) + { j = nzasub[i]; + adjncy[xadj[k]++] = j; /* store {k,j} in adjacency list of k */ + adjncy[xadj[j]++] = k; /* store {j,k} in adjacency list of j */ + } + } + + /* -------------------------------------------- + restore startpoint of each vertex and return + -------------------------------------------- */ + for (k = nvtx-1; k > 0; k--) + xadj[k] = xadj[k-1]; + xadj[0] = 0; + return(G); +} + + +/***************************************************************************** +******************************************************************************/ +graph_t* +setupGridGraph(int dimX, int dimY, int type) +{ graph_t *G; + int *xadj, *adjncy, nvtx, nedges, knz, k; + + /* --------------- + initializations + --------------- */ + G = NULL; + knz = 0; + nvtx = dimX * dimY; + + /* --------------------------------- + create unweighted grid/mesh graph + --------------------------------- */ + if ((type == GRID) || (type == MESH)) + { nedges = 8 /* for edge vertices */ + + 6 * (dimX-2 + dimY-2) /* for border vertices */ + + 4 * (dimX-2) * (dimY-2); /* for interior vertices */ + if (type == MESH) + nedges += 4 * (dimX-1) * (dimY-1); /* diagonals */ + + G = newGraph(nvtx, nedges); + xadj = G->xadj; + adjncy = G->adjncy; + + for (k = 0; k < nvtx; k++) + { xadj[k] = knz; + if ((k+1) % dimX > 0) /* / k+1-dimX (MESH) */ + { adjncy[knz++] = k+1; /* k - k+1 (GRID) */ + if (type == MESH) /* \ k+1+dimX (MESH) */ + { if (k+1+dimX < nvtx) + adjncy[knz++] = k+1+dimX; + if (k+1-dimX >= 0) + adjncy[knz++] = k+1-dimX; + } + } + if (k % dimX > 0) /* k-1-dimX \ (MESH) */ + { adjncy[knz++] = k-1; /* k-1 - k (GRID) */ + if (type == MESH) /* k-1+dimX / (MESH) */ + { if (k-1+dimX < nvtx) + adjncy[knz++] = k-1+dimX; + if (k-1-dimX >= 0) + adjncy[knz++] = k-1-dimX; + } + } + if (k+dimX < nvtx) /* k-dimX (GRID) */ + adjncy[knz++] = k+dimX; /* | */ + if (k-dimX >= 0) /* k */ + adjncy[knz++] = k-dimX; /* | */ + } /* k+dimX (GRID) */ + xadj[nvtx] = knz; + } + + /* ----------------------------- + create unweighted torus graph + ----------------------------- */ + if (type == TORUS) + { nedges = 4 * dimX * dimY; + + G = newGraph(nvtx, nedges); + xadj = G->xadj; + adjncy = G->adjncy; + + for (k = 0; k < nvtx; k++) + { xadj[k] = knz; + if (((k+1) % dimX) == 0) /* k -- k+1 */ + adjncy[knz++] = k+1-dimX; + else + adjncy[knz++] = k+1; + if ((k % dimX) == 0) /* k-1 -- k */ + adjncy[knz++] = k-1+dimX; + else + adjncy[knz++] = k-1; + adjncy[knz++] = (k+dimX) % nvtx; /* k-dimX */ + adjncy[knz++] = (k+dimX*(dimY-1)) % nvtx; /* | */ + } /* k */ + xadj[nvtx] = knz; /* | */ + } /* k+dimX */ + + return(G); +} + + +/***************************************************************************** +******************************************************************************/ +int +connectedComponents(graph_t *G) +{ int *xadj, *adjncy, *marker, *queue; + int nvtx, u, v, w, qhead, qtail, comp, i, istart, istop; + + nvtx = G->nvtx; + xadj = G->xadj; + adjncy = G->adjncy; + + /* ------------------------ + allocate working storage + ------------------------ */ + mymalloc(marker, nvtx, int); + mymalloc(queue, nvtx, int); + + /* --------------- + initializations + --------------- */ + comp = 0; + for (u = 0; u < nvtx; u++) + marker[u] = -1; + + /* -------------------------------------- + get the number of connected components + -------------------------------------- */ + for (u = 0; u < nvtx; u++) + if (marker[u] == -1) + { comp++; + qhead = 0; qtail = 1; + queue[0] = u; marker[u] = 0; + + while (qhead != qtail) /* breadth first search in each comp. */ + { v = queue[qhead++]; + istart = xadj[v]; + istop = xadj[v+1]; + for (i = istart; i < istop; i++) + { w = adjncy[i]; + if (marker[w] == -1) + { queue[qtail++] = w; + marker[w] = 0; + } + } + } + } + + /* ------------------------------- + free working storage and return + ------------------------------- */ + free(marker); free(queue); + return(comp); +} + + +/***************************************************************************** +private function of compressGraph +******************************************************************************/ +static int +indNodes(graph_t *G, int *vtxmap) +{ int *xadj, *adjncy, *deg, *checksum, *tmp; + int nvtx, cnvtx, u, v, i, istart, istop, j, jstart, jstop; + + nvtx = G->nvtx; + xadj = G->xadj; + adjncy = G->adjncy; + + /* ------------------------- + set up the working arrays + ------------------------- */ + mymalloc(deg, nvtx, int); + mymalloc(checksum, nvtx, int); + mymalloc(tmp, nvtx, int); + + /* ------------------------------------------------- + compute for each vertex u its degree and checksum + ------------------------------------------------- */ + for (u = 0; u < nvtx; u++) + { istart = xadj[u]; + istop = xadj[u+1]; + deg[u] = istop - istart; + checksum[u] = u; + tmp[u] = -1; + vtxmap[u] = u; + for (i = istart; i < istop; i++) + checksum[u] += adjncy[i]; + } + + /* ------------------------------------- + search for indistinguishable vertices + ------------------------------------- */ + cnvtx = nvtx; + for (u = 0; u < nvtx; u++) + if (vtxmap[u] == u) + { tmp[u] = u; + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + tmp[adjncy[i]] = u; + + /* scan adjacency list of vertex u for indistinguishable vertices */ + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if ((v > u) && (checksum[v] == checksum[u]) && (deg[v] == deg[u]) + && (vtxmap[v] == v)) + { jstart = xadj[v]; + jstop = xadj[v+1]; + for (j = jstart; j < jstop; j++) + if (tmp[adjncy[j]] != u) goto FAILURE; + + /* found it!!! map v onto u */ + vtxmap[v] = u; + cnvtx--; +FAILURE: ; + } + } + } + + /* ---------------------- + free memory and return + ---------------------- */ + free(deg); free(checksum); free(tmp); + return(cnvtx); +} + + +/***************************************************************************** +******************************************************************************/ +graph_t* +compressGraph(graph_t* G, int* vtxmap) +{ graph_t *Gc; + int *xadj, *adjncy, *vwght, *xadjGc, *adjncyGc, *vwghtGc, *perm; + int nvtx, nvtxGc, nedgesGc, u, v, i, istart, istop; + + nvtx = G->nvtx; + xadj = G->xadj; + adjncy = G->adjncy; + vwght = G->vwght; + + /* -------------------------------------------------------------- + compressed graph small enough? if so, allocate working storage + -------------------------------------------------------------- */ + /* avoid print statement + * printf("indNodes(G, vtxmap) = %d",indNodes(G, vtxmap)); */ + if ((nvtxGc = indNodes(G, vtxmap)) > COMPRESS_FRACTION * nvtx) + return(NULL); + mymalloc(perm, nvtx, int); + + /* ----------------------------------- + count edges of the compressed graph + ----------------------------------- */ + nedgesGc = 0; + for (u = 0; u < nvtx; u++) + if (vtxmap[u] == u) + { istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if (vtxmap[v] == v) nedgesGc++; + } + } + + /* --------------------------------------------------------- + allocate memory for the compressed graph and construct it + --------------------------------------------------------- */ + Gc = newGraph(nvtxGc, nedgesGc); + xadjGc = Gc->xadj; + adjncyGc = Gc->adjncy; + vwghtGc = Gc->vwght; + + nvtxGc = nedgesGc = 0; + for (u = 0; u < nvtx; u++) + if (vtxmap[u] == u) + { istart = xadj[u]; + istop = xadj[u+1]; + xadjGc[nvtxGc] = nedgesGc; + vwghtGc[nvtxGc] = 0; + perm[u] = nvtxGc++; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + if (vtxmap[v] == v) adjncyGc[nedgesGc++] = v; + } + } + xadjGc[nvtxGc] = nedgesGc; + + for (i = 0; i < nedgesGc; i++) + adjncyGc[i] = perm[adjncyGc[i]]; + for (u = 0; u < nvtx; u++) + { vtxmap[u] = perm[vtxmap[u]]; + vwghtGc[vtxmap[u]] += vwght[u]; + } + Gc->type = WEIGHTED; + Gc->totvwght = G->totvwght; + + /* ---------------------- + free memory and return + ---------------------- */ + free(perm); + return(Gc); +} + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/interface.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/interface.c new file mode 100644 index 000000000..a72eec73c --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/interface.c @@ -0,0 +1,762 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: interface.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 01jan26 +/ +/ This file contains some high level interface functions (only these +/ functions should be called by a user). +/ +******************************************************************************/ + + +#include + +/***************************************************************************** + o Input: + undirected graph G + options -- if NULL, default options are used + option[0] holds OPTION_ORDTYPE + option[1] holds OPTION_NODE_SELECTION1 + option[2] holds OPTION_NODE_SELECTION2 + option[3] holds OPTION_NODE_SELECTION3 + option[4] holds OPTION_DOMAIN_SIZE + option[5] holds OPTION_MSGLVL + o Output: + elimination/front tree T reflecting the ordering of G + cpus -- if NULL, no timing information is pulled back + cpus[0] holds TIME_COMPRESS + cpus[1] holds TIME_MS + cpus[2] holds TIME_MULTILEVEL + cpus[3] holds TIME_INITDOMDEC + cpus[4] holds TIME_COARSEDOMDEC + cpus[5] holds TIME_INITSEP + cpus[6] holds TIME_REFINESEP + cpus[7] holds TIME_SMOOTH + cpus[8] holds TIME_BOTTOMUP + cpus[9] holds TIME_UPDADJNCY + cpus[10] holds TIME_FINDINODES + cpus[11] holds TIME_UPDSCORE + o Comments: + this function computes an ordering for G; it returns an elimination + tree T; permutation vectors perm, invp can be extracted from T by + calling function permFromElimTree(T, perm, invp) +******************************************************************************/ +elimtree_t* +SPACE_ordering(graph_t *G, options_t *options, timings_t *cpus) +{ graph_t *Gc; + multisector_t *ms; + minprior_t *minprior; + elimtree_t *T, *T2; + timings_t cpusOrd[ORD_TIME_SLOTS]; + options_t default_options[] = { SPACE_ORDTYPE, SPACE_NODE_SELECTION1, + SPACE_NODE_SELECTION2, SPACE_NODE_SELECTION3, + SPACE_DOMAIN_SIZE, SPACE_MSGLVL }; + int *vtxmap, istage, totnstep, totnzf; + FLOAT totops; + + /* -------------------------------------------------- + set default options, if no other options specified + -------------------------------------------------- */ + if (options == NULL) + options = default_options; + + /* ---------------- + reset all timers + ---------------- */ + resettimer(cpusOrd[TIME_COMPRESS]); + resettimer(cpusOrd[TIME_MS]); + resettimer(cpusOrd[TIME_MULTILEVEL]); + resettimer(cpusOrd[TIME_INITDOMDEC]); + resettimer(cpusOrd[TIME_COARSEDOMDEC]); + resettimer(cpusOrd[TIME_INITSEP]); + resettimer(cpusOrd[TIME_REFINESEP]); + resettimer(cpusOrd[TIME_SMOOTH]); + resettimer(cpusOrd[TIME_BOTTOMUP]); + resettimer(cpusOrd[TIME_UPDADJNCY]); + resettimer(cpusOrd[TIME_FINDINODES]); + resettimer(cpusOrd[TIME_UPDSCORE]); + + /* ------------------ + compress the graph + ------------------ */ + starttimer(cpusOrd[TIME_COMPRESS]); + mymalloc(vtxmap, G->nvtx, int); + Gc = compressGraph(G, vtxmap); + stoptimer(cpusOrd[TIME_COMPRESS]); + + if (Gc != NULL) + { if (options[OPTION_MSGLVL] > 0) + printf("compressed graph constructed (#nodes %d, #edges %d)\n", + Gc->nvtx, Gc->nedges >> 1); + } + else + { Gc = G; + free(vtxmap); + if (options[OPTION_MSGLVL] > 0) + printf("no compressed graph constructed\n"); + } + + /* ------------------- + compute multisector + ------------------- */ + + + starttimer(cpusOrd[TIME_MS]); + ms = constructMultisector(Gc, options, cpusOrd); + stoptimer(cpusOrd[TIME_MS]); + + + if (options[OPTION_MSGLVL] > 0) + printf("quality of multisector: #stages %d, #nodes %d, weight %d\n", + ms->nstages, ms->nnodes, ms->totmswght); + + /* --------------------------------- + compute minimum priority ordering + --------------------------------- */ + starttimer(cpusOrd[TIME_BOTTOMUP]) + minprior = setupMinPriority(ms); + T = orderMinPriority(minprior, options, cpusOrd); + stoptimer(cpusOrd[TIME_BOTTOMUP]); + + if (options[OPTION_MSGLVL] > 0) + { totnstep = totnzf = 0; + totops = 0.0; + for (istage = 0; istage < ms->nstages; istage++) + { totnstep += minprior->stageinfo[istage].nstep; + totnzf += minprior->stageinfo[istage].nzf; + totops += minprior->stageinfo[istage].ops; + } + printf("quality of ordering: #steps %d, nzl %d, ops %e\n", totnstep, + totnzf, totops); + } + + /* ----------------------- + expand elimination tree + ----------------------- */ + if (Gc != G) + { T2 = expandElimTree(T, vtxmap, G->nvtx); + freeElimTree(T); + freeGraph(Gc); + free(vtxmap); + } + else T2 = T; + + /* -------------------------------------------------- + pull back timing results, if vector cpus available + -------------------------------------------------- */ + if (cpus != NULL) + { cpus[0] = cpusOrd[TIME_COMPRESS]; + cpus[1] = cpusOrd[TIME_MS]; + cpus[2] = cpusOrd[TIME_MULTILEVEL]; + cpus[3] = cpusOrd[TIME_INITDOMDEC]; + cpus[4] = cpusOrd[TIME_COARSEDOMDEC]; + cpus[5] = cpusOrd[TIME_INITSEP]; + cpus[6] = cpusOrd[TIME_REFINESEP]; + cpus[7] = cpusOrd[TIME_SMOOTH]; + cpus[8] = cpusOrd[TIME_BOTTOMUP]; + cpus[9] = cpusOrd[TIME_UPDADJNCY]; + cpus[10] = cpusOrd[TIME_FINDINODES]; + cpus[11] = cpusOrd[TIME_UPDSCORE]; + } + + /* ---------------------- + free memory and return + ---------------------- */ + freeMultisector(ms); + freeMinPriority(minprior); + return(T2); +} + + +#if defined(cleaned_version) +/***************************************************************************** + o Input: + elimination/front tree T + max. number of zeros that is allowed to be introduced in front + o Output: + transformed elimination/front tree T' + o Comments: + the goal is to make T (obtained by orderMinPriority or + setupElimTree) more appropiate for the multifrontal algorithm +******************************************************************************/ +elimtree_t* +SPACE_transformElimTree(elimtree_t *T, int maxzeros) +{ elimtree_t *T2, *T3; + + /* ----------------------------------------------------- + 1st: determine the fundamental fronts + this step significantly improves the cache reuse + ----------------------------------------------------- */ + T2 = fundamentalFronts(T); + + /* ----------------------------------------------------------------- + 2nd: group together small subtrees into one front + this step reduces the number of fronts and thus the overhead + associated with them; the expense is added storage for the + logically zero entries and the factor operations on them + ------------------------------------------------------------------ */ + T3 = mergeFronts(T2, maxzeros); + freeElimTree(T2); + + /* -------------------------------------------------------------- + 3rd: order the children of a front so that the working storage + in the multifrontal algorithm is minimized + -------------------------------------------------------------- */ + (void)justifyFronts(T3); + return(T3); +} + +/***************************************************************************** + o Input: + transformed elimination/front tree T, input matrix A + o Output: + initial factor matrix L of the permuted input matrix PAP + o Comments: L contains nonzeros of PAP; all other entries are set to 0.0 +******************************************************************************/ +factorMtx_t* +SPACE_symbFac(elimtree_t *T, inputMtx_t *A) +{ factorMtx_t *L; + frontsub_t *frontsub; + css_t *css; + inputMtx_t *PAP; + elimtree_t *PTP; + int *perm, neqs, nelem; + + /* ------------------------------------------------------ + extract permutation vectors from T and permute T and A + ------------------------------------------------------ */ + neqs = A->neqs; + mymalloc(perm, neqs, int); + permFromElimTree(T, perm); + PTP = permuteElimTree(T, perm); + PAP = permuteInputMtx(A, perm); + + /* ------------------------------------------------------------------- + create factor matrix L of PAP, i.e. + (1) create the subscript structure of the fronts, i.e. frontsub + (2) use frontsub to create the compressed subscript structure of L + (3) allocate memory for L and the nonzeros of L, i.e. L->nzl + (4) init. L with the nonzeros of PAP + ------------------------------------------------------------------- */ + frontsub = setupFrontSubscripts(PTP, PAP); + css = setupCSSFromFrontSubscripts(frontsub); + + nelem = css->xnzl[neqs]; + L = newFactorMtx(nelem); + L->perm = perm; + L->frontsub = frontsub; + L->css = css; + + initFactorMtx(L, PAP); + + /* ----------------------------------------------------- + free permuted input matrix and return + note: PTP and perm have been inherited by frontsub, L + ----------------------------------------------------- */ + freeInputMtx(PAP); + return(L); +} + + +/***************************************************************************** + o Input: + transformed elimination/front tree + initial factor matrix L of the permuted input matrix PAP + o Output: + factor matrix L of the permuted input matrix PAP + cpus -- if NULL no timing information is pulled back + cpus[0] holds TIME_INITFRONT + cpus[1] holds TIME_EXPAND + cpus[2] holds TIME_KERNEL + cpus[3] holds TIME_INITUPD + o Comments: + this function does the actual numerical factorization; to + improve register and cache reuse it uses a kernel of size 3x3 +******************************************************************************/ +void +SPACE_numFac(factorMtx_t *L, timings_t *cpus) +{ timings_t cpusFactor[NUMFAC_TIME_SLOTS]; + + /* ---------------- + reset all timers + ---------------- */ + resettimer(cpusFactor[TIME_INITFRONT]); + resettimer(cpusFactor[TIME_EXADD]); + resettimer(cpusFactor[TIME_KERNEL]); + resettimer(cpusFactor[TIME_INITUPD]); + + /* ------------------------- + compute Cholesky factor L + ------------------------- */ + numfac(L, cpusFactor); + + /* -------------------------------------------------- + pull back timing results, if vector cpus available + -------------------------------------------------- */ + if (cpus != NULL) + { cpus[0] = cpusFactor[TIME_INITFRONT]; + cpus[1] = cpusFactor[TIME_EXADD]; + cpus[2] = cpusFactor[TIME_KERNEL]; + cpus[3] = cpusFactor[TIME_INITUPD]; + } +} + + +/***************************************************************************** + o Input: + transformed elimination/front tree + factor matrix L of the permuted input matrix PAP + right hand side vector rhs of the original system Ax = b + o Output: + solution vector xvec of the original system Ax = b + o Comments: + this function solves the remaining triangular systems; +******************************************************************************/ +void +SPACE_solveTriangular(factorMtx_t *L, FLOAT *rhs, FLOAT *xvec) +{ FLOAT *yvec; + int *perm; + int neqs, k; + + perm = L->perm; + neqs = L->css->neqs; + + /* ------------------------------------------- + set up permuted right hand side vector yvec + ------------------------------------------- */ + mymalloc(yvec, neqs, FLOAT); + for (k = 0; k < neqs; k++) + yvec[perm[k]] = rhs[k]; + + /* ------------------------- + solve Ly = b and L^Tz = y + ------------------------- */ + forwardSubst1x1(L, yvec); + backwardSubst1x1(L, yvec); + + /* --------------------------------------------------------------- + extract from yvec the solution vector of the un-permuted system + --------------------------------------------------------------- */ + for (k = 0; k < neqs; k++) + xvec[k] = yvec[perm[k]]; + free(yvec); +} + + +/***************************************************************************** + o Input: + sparse matrix A, right hand side vector rhs + options -- if NULL, default options are used + option[0] holds OPTION_ORDTYPE + option[1] holds OPTION_NODE_SELECTION1 + option[2] holds OPTION_NODE_SELECTION2 + option[3] holds OPTION_NODE_SELECTION3 + option[4] holds OPTION_DOMAIN_SIZE + option[5] holds OPTION_MSGLVL + option[6] holds OPTION_ETREE_NONZ + o Output: + solution vector xvec of the original system Ax = b + cpus -- if NULL, no timing information is pulled back + cpus[0] holds time to construct the graph + cpus[1] holds time to compute the ordering + cpus[2] holds TIME_COMPRESS + cpus[3] holds TIME_MS + cpus[4] holds TIME_MULTILEVEL + cpus[5] holds TIME_INITDOMDEC + cpus[6] holds TIME_COARSEDOMDEC + cpus[7] holds TIME_INITSEP + cpus[8] holds TIME_REFINESEP + cpus[9] holds TIME_SMOOTH + cpus[10] holds TIME_BOTTOMUP + cpus[11] holds TIME_UPDADJNCY; + cpus[12] holds TIME_FINDINODES + cpus[13] holds TIME_UPDSCORE + cpus[14] holds time to transform the elimination tree + cpus[15] holds time to compute the symbolical factorization + cpus[16] holds time to compute the numerical factorization + cpus[17] holds TIME_INITFRONT + cpus[18] holds TIME_EXADD + cpus[19] holds TIME_KERNEL + cpus[20] holds TIME_INITUPD + cpus[21] holds time to solve the triangular systems + o Comments: + this is the final topmost function that can be used as a black + box in other algorithm; it provides a general purpose direct + solver for large sparse positive definite systems +******************************************************************************/ +void +SPACE_solve(inputMtx_t *A, FLOAT *rhs, FLOAT *xvec, options_t *options, + timings_t *cpus) +{ graph_t *G; + elimtree_t *T, *T2; + factorMtx_t *L; + timings_t cpusOrd[ORD_TIME_SLOTS], cpusFactor[NUMFAC_TIME_SLOTS]; + timings_t t_graph, t_ord, t_etree, t_symb, t_num, t_solvetri; + options_t default_options[] = { SPACE_ORDTYPE, SPACE_NODE_SELECTION1, + SPACE_NODE_SELECTION2, SPACE_NODE_SELECTION3, + SPACE_DOMAIN_SIZE, SPACE_MSGLVL, SPACE_ETREE_NONZ }; + + /* -------------------------------------------------- + set default options, if no other options specified + -------------------------------------------------- */ + if (options == NULL) + options = default_options; + + /* ---------------- + reset all timers + ---------------- */ + resettimer(t_graph); + resettimer(t_ord); + resettimer(t_etree); + resettimer(t_symb); + resettimer(t_num); + resettimer(t_solvetri); + + /* ----------------- + set up graph G(A) + ----------------- */ + starttimer(t_graph); + G = setupGraphFromMtx(A); + stoptimer(t_graph); + + if (options[OPTION_MSGLVL] > 0) + printf("\ninduced graph constructed: #vertices %d, #edges %d, #components " + "%d\n", G->nvtx, G->nedges >> 1, connectedComponents(G)); + + /* -------------------------------------------- + construct ordering/elimination tree for G(A) + -------------------------------------------- */ + starttimer(t_ord); + T = SPACE_ordering(G, options, cpusOrd); + stoptimer(t_ord); + freeGraph(G); + + if (options[OPTION_MSGLVL] > 0) + printf("quality of initial elim. tree: #fronts %d, #indices %d\n\t" + "nzl %d, ops %e, wspace %d\n", T->nfronts, nFactorIndices(T), + nFactorEntries(T), nFactorOps(T), nWorkspace(T)); + + /* ------------------------------- + elimination tree transformation + ------------------------------- */ + starttimer(t_etree); + T2 = SPACE_transformElimTree(T, options[OPTION_ETREE_NONZ]); + stoptimer(t_etree); + freeElimTree(T); + + if (options[OPTION_MSGLVL] > 0) + printf("quality of transformed elim. tree: #fronts %d, #indices %d\n\t" + "nzl %d, ops %e, wspace %d\n", T2->nfronts, nFactorIndices(T2), + nFactorEntries(T2), nFactorOps(T2), nWorkspace(T2)); + + /* ------------------------ + symbolical factorization + ------------------------ */ + starttimer(t_symb); + L = SPACE_symbFac(T2, A); + stoptimer(t_symb); + + if (options[OPTION_MSGLVL] > 0) + printf("quality of factor matrix:\n\tneqs %d, #indices %d, nzl %d\n", + L->css->neqs, L->css->nind, L->nelem); + + /* ----------------------- + numerical factorization + ----------------------- */ + starttimer(t_num); + SPACE_numFac(L, cpusFactor); + stoptimer(t_num); + + if (options[OPTION_MSGLVL] > 0) + printf("performance of numerical factorization: %6.2f mflops\n", + (double)nFactorOps(T2) / t_num / 1000000); + + /* ------------------------------ + solution of triangular systems + ------------------------------ */ + starttimer(t_solvetri); + SPACE_solveTriangular(L, rhs, xvec); + stoptimer(t_solvetri); + + if (options[OPTION_MSGLVL] > 0) + printf("performance of forward/backward solve: %6.2f mflops\n", + (double)nTriangularOps(T2) / t_solvetri / 1000000); + + freeElimTree(T2); + freeFactorMtx(L); + + /* -------------------------------------------------- + pull back timing results, if vector cpus available + -------------------------------------------------- */ + if (cpus != NULL) + { cpus[0] = t_graph; + cpus[1] = t_ord; + cpus[2] = cpusOrd[TIME_COMPRESS]; + cpus[3] = cpusOrd[TIME_MS]; + cpus[4] = cpusOrd[TIME_MULTILEVEL]; + cpus[5] = cpusOrd[TIME_INITDOMDEC]; + cpus[6] = cpusOrd[TIME_COARSEDOMDEC]; + cpus[7] = cpusOrd[TIME_INITSEP]; + cpus[8] = cpusOrd[TIME_REFINESEP]; + cpus[9] = cpusOrd[TIME_SMOOTH]; + cpus[10] = cpusOrd[TIME_BOTTOMUP]; + cpus[11] = cpusOrd[TIME_UPDADJNCY]; + cpus[12] = cpusOrd[TIME_FINDINODES]; + cpus[13] = cpusOrd[TIME_UPDSCORE]; + cpus[14] = t_etree; + cpus[15] = t_symb; + cpus[16] = t_num; + cpus[17] = cpusFactor[TIME_INITFRONT]; + cpus[18] = cpusFactor[TIME_EXADD]; + cpus[19] = cpusFactor[TIME_KERNEL]; + cpus[20] = cpusFactor[TIME_INITUPD]; + cpus[21] = t_solvetri; + } +} + + +/***************************************************************************** + o Input: + sparse matrix A with permutation vector perm + right hand side vector rhs + options -- if NULL, default options are used + option[0] holds OPTION_MSGLVL + option[1] holds OPTION_ETREE_NONZ + o Output: + solution vector xvec of the original system Ax = b + cpus -- if NULL, no timing information is pulled back + cpus[0] holds time to construct the graph + cpus[1] holds time to construct the elimination tree + cpus[2] holds time to transform the elimination tree + cpus[3] holds time to compute the symbolical factorization + cpus[4] holds time to compute the numerical factorization + cpus[5] holds TIME_INITFRONT + cpus[6] holds TIME_EXADD + cpus[7] holds TIME_KERNEL + cpus[8] holds TIME_INITUPD + cpus[9] holds time to solve the triangular systems + o Comments: + this function can be used to solve an equation system + using an externally computed permutation vector +******************************************************************************/ +void +SPACE_solveWithPerm(inputMtx_t *A, int *perm, FLOAT *rhs, FLOAT *xvec, + options_t *options, timings_t *cpus) +{ graph_t *G; + elimtree_t *T, *T2; + factorMtx_t *L; + timings_t cpusFactor[NUMFAC_TIME_SLOTS], t_graph, t_etree_construct; + timings_t t_etree_merge, t_symb, t_num, t_solvetri; + options_t default_options[] = { SPACE_MSGLVL, SPACE_ETREE_NONZ }; + int *invp, i, msglvl, maxzeros; + + /* -------------------------------------------------- + set default options, if no other options specified + -------------------------------------------------- */ + if (options == NULL) + options = default_options; + msglvl = options[0]; + maxzeros = options[1]; + + /* ---------------- + reset all timers + ---------------- */ + resettimer(t_graph); + resettimer(t_etree_construct); + resettimer(t_etree_merge); + resettimer(t_symb); + resettimer(t_num); + resettimer(t_solvetri); + + /* ----------------- + set up graph G(A) + ----------------- */ + starttimer(t_graph); + G = setupGraphFromMtx(A); + stoptimer(t_graph); + + if (msglvl > 0) + printf("\ninduced graph constructed: #vertices %d, #edges %d, #components " + "%d\n", G->nvtx, G->nedges >> 1, connectedComponents(G)); + + /* --------------------------------------------------- + construct inital elimination tree according to perm + --------------------------------------------------- */ + starttimer(t_etree_construct); + mymalloc(invp, G->nvtx, int); + for (i = 0; i < G->nvtx; i++) + invp[perm[i]] = i; + T = setupElimTree(G, perm, invp); + stoptimer(t_etree_construct); + freeGraph(G); + free(invp); + + if (msglvl > 0) + printf("quality of initial elim. tree: #fronts %d, #indices %d\n\t" + "nzl %d, ops %e, wspace %d\n", T->nfronts, nFactorIndices(T), + nFactorEntries(T), nFactorOps(T), nWorkspace(T)); + + /* ------------------------------- + elimination tree transformation + ------------------------------- */ + starttimer(t_etree_merge); + T2 = SPACE_transformElimTree(T, maxzeros); + stoptimer(t_etree_merge); + freeElimTree(T); + + if (msglvl > 0) + printf("quality of transformed elim. tree: #fronts %d, #indices %d\n\t" + "nzl %d, ops %e, wspace %d\n", T2->nfronts, nFactorIndices(T2), + nFactorEntries(T2), nFactorOps(T2), nWorkspace(T2)); + + /* ------------------------ + symbolical factorization + ------------------------ */ + starttimer(t_symb); + L = SPACE_symbFac(T2, A); + stoptimer(t_symb); + + if (msglvl > 0) + printf("quality of factor matrix:\n\tneqs %d, #indices %d, nzl %d\n", + L->css->neqs, L->css->nind, L->nelem); + + /* ----------------------- + numerical factorization + ----------------------- */ + starttimer(t_num); + SPACE_numFac(L, cpusFactor); + stoptimer(t_num); + + if (msglvl > 0) + printf("performance of numerical factorization: %6.2f mflops\n", + (double)nFactorOps(T2) / t_num / 1000000); + + /* ------------------------------ + solution of triangular systems + ------------------------------ */ + starttimer(t_solvetri); + SPACE_solveTriangular(L, rhs, xvec); + stoptimer(t_solvetri); + + if (msglvl > 0) + printf("performance of forward/backward solve: %6.2f mflops\n", + (double)nTriangularOps(T2) / t_solvetri / 1000000); + + freeElimTree(T2); + freeFactorMtx(L); + + /* -------------------------------------------------- + pull back timing results, if vector cpus available + -------------------------------------------------- */ + if (cpus != NULL) + { cpus[0] = t_graph; + cpus[1] = t_etree_construct; + cpus[2] = t_etree_merge; + cpus[3] = t_symb; + cpus[4] = t_num; + cpus[5] = cpusFactor[TIME_INITFRONT]; + cpus[6] = cpusFactor[TIME_EXADD]; + cpus[7] = cpusFactor[TIME_KERNEL]; + cpus[8] = cpusFactor[TIME_INITUPD]; + cpus[9] = t_solvetri; + } +} + + +/***************************************************************************** + o Input: + graph G with permutation vector perm + options -- if NULL, default options are used + option[0] holds OPTION_MSGLVL + option[1] holds OPTION_ETREE_NONZ + option[2] holds OPTION_ETREE_BAL + option[3] holds dimension of hypercube + o Output: + mapping object map + cpus -- if NULL, no timing information is pulled back + cpus[0] holds time to construct the elimination tree + cpus[1] holds time to transform the elimination tree + cpus[2] holds time to compute the mapping + o Comments: + this function can be used to obtain a mapping object for the + parallel factorization +******************************************************************************/ +mapping_t* +SPACE_mapping(graph_t *G, int *perm, options_t *options, timings_t *cpus) +{ mapping_t *map; + elimtree_t *T, *T2; + timings_t t_etree_construct, t_etree_merge, t_map; + options_t default_options[] = { SPACE_MSGLVL, SPACE_ETREE_NONZ, + SPACE_ETREE_BAL, 2 }; + int *invp, i, msglvl, maxzeros, bal, dimQ; + + /* -------------------------------------------------- + set default options, if no other options specified + -------------------------------------------------- */ + if (options == NULL) + options = default_options; + msglvl = options[0]; + maxzeros = options[1]; + bal = options[2]; + dimQ = options[3]; + + /* ---------------- + reset all timers + ---------------- */ + resettimer(t_etree_construct); + resettimer(t_etree_merge); + resettimer(t_map); + + /* --------------------------------------------------- + construct inital elimination tree according to perm + --------------------------------------------------- */ + starttimer(t_etree_construct); + mymalloc(invp, G->nvtx, int); + for (i = 0; i < G->nvtx; i++) + invp[perm[i]] = i; + T = setupElimTree(G, perm, invp); + stoptimer(t_etree_construct); + free(invp); + + if (msglvl > 0) + printf("quality of initial elim. tree: #fronts %d, #indices %d\n\t" + "nzl %d, ops %e, wspace %d\n", T->nfronts, nFactorIndices(T), + nFactorEntries(T), nFactorOps(T), nWorkspace(T)); + + /* ------------------------------- + elimination tree transformation + ------------------------------- */ + starttimer(t_etree_merge); + T2 = SPACE_transformElimTree(T, maxzeros); + stoptimer(t_etree_merge); + freeElimTree(T); + + if (msglvl > 0) + printf("quality of transformed elim. tree: #fronts %d, #indices %d\n\t" + "nzl %d, ops %e, wspace %d\n", T2->nfronts, nFactorIndices(T2), + nFactorEntries(T2), nFactorOps(T2), nWorkspace(T2)); + + /* ------------------- + compute the mapping + ------------------- */ + starttimer(t_map); + map = setupMapping(T2, dimQ, bal); + stoptimer(t_map); + + /* -------------------------------------------------- + pull back timing results, if vector cpus available + -------------------------------------------------- */ + if (cpus != NULL) + { cpus[0] = t_etree_construct; + cpus[1] = t_etree_merge; + cpus[2] = t_map; + } + + /* -------------------------------------------------------------- + return mapping object (don't free T2, since it belongs to map) + -------------------------------------------------------------- */ + return(map); +} +#endif diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/minpriority.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/minpriority.c new file mode 100644 index 000000000..e8faa210e --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/minpriority.c @@ -0,0 +1,470 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: minpriority.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 01jan15 +/ +/ This file contains functions dealing with the minimum priority object +/ +****************************************************************************** + +Data type: struct minprior + gelim_t *Gelim; the elimination graph of G + multisector_t *ms; the multisector for G + bucket_t *bucket; holds unelim. vert. of actual stage + stageinfo_t *stageinfo; contains statistics for each stage + int *reachset; holds boundary vert. in each step + int nreach; number of vertices in reachset + int *auxaux; general purpose auxiliary vector + int *auxbin; special auxiliary vector + int *auxtmp; special auxiliary vector + int flag; flag for vector auxtmp (see below) + struct stageinfo + int nstep; # of elim. steps in each stage + int welim; weight of elim. vert. in each stage + int nzf; # of factor entries in each stage + FLOAT ops; # of factor ops. in each stage +Comments: + o Structure used to compute a minimum priority ordering for a graph G + with multisector ms. The elimination process is organized in stages. + The stages are given by the multisector (i.e. ms->stage). The vertices + of a stage are eliminated in steps. In each elimination step a maximal + independent set of vertices with minimum priority is eliminated + o Structure does not own multisector object => it will not be freed + o Three auxiliary vectors can be used by functions working on minprior + IMPORTANT INVARIANTS for vectors auxbin, auxtmp + auxbin[i] = -1 holds at start and at end of each function + auxtmp[i] < flag holds at start and at end of each function +Methods in lib/minpriority.c: +- minprior = newMinPriority(int nvtx, int nstages); + o Initial: Gelim = ms = bucket = NULL, + nreach = 0, flag = 1; +- void freeMinPriority(minprior_t *minprior); +- minprior = setupMinPriority(multisector_t *ms); + o allocates memory for the minprior object by calling newMinPriority and + sets up the elimination graph by a call to setupElimGraph and the bucket + by a call to setupBucket; finally, it initializes the vectors, i.e. + auxbin[u] = -1, auxtmp[u] = 0 for all 0 <= u <= nvtx, and + nstep = welim = nzf = ops = 0 for all stages +- T = orderMinPriority(minprior_t *minprior options_t *options,timings_t *cpus); + o MASTER_FUNCTION: computes a bottom-up ordering according to the specified + ordtype e { MINIMUM_PRIORITY, INCOMPLETE_ND, MULTISECTION, + TRISTAGE_MULTISECTION } + o used options: + OPTION_ORDTYPE, OPTION_NODE_SELECTION1, OPTION_NODE_SELECTION2 + o returned timings: (see eliminateStage) + TIME_UPDSCORE, TIME_UPDADJNCY, TIME_FINDINODES +- void eliminateStage(minprior_t *minprior, int istage, int scoretype, + timings_t *cpus); + o eliminates all principal variables u with stage[u] <= istage using + the score function given by scoretype + o returned timings: + TIME_UPDSCORE, TIME_UPDADJNCY, TIME_FINDINODES +- int eliminateStep(minprior_t *minprior, int istage, int scoretype); + o the variables u with stage[u] <= istage are eliminated in steps; + in each step a maximal independet set of variables with minimum score + is eliminated + o the function returns the size of the independent set, i.e. the number + of variables that have been eliminated in the actual step + +******************************************************************************/ + +#include +/* #define DEBUG */ +/* #define BE_CAUTIOUS */ + + +/***************************************************************************** +******************************************************************************/ +minprior_t* +newMinPriority(int nvtx, int nstages) +{ minprior_t *minprior; + stageinfo_t *stageinfo; + + mymalloc(stageinfo, nstages, stageinfo_t); + mymalloc(minprior, 1, minprior_t); + minprior->Gelim = NULL; + minprior->ms = NULL; + minprior->bucket = NULL; + minprior->stageinfo = stageinfo; + + mymalloc(minprior->reachset, nvtx, int); + mymalloc(minprior->auxaux, nvtx, int); + mymalloc(minprior->auxbin, nvtx, int); + mymalloc(minprior->auxtmp, nvtx, int); + + minprior->nreach = 0; + minprior->flag = 1; + + return(minprior); +} + + +/***************************************************************************** +******************************************************************************/ +void +freeMinPriority(minprior_t *minprior) +{ + freeElimGraph(minprior->Gelim); + freeBucket(minprior->bucket); + free(minprior->stageinfo); + free(minprior->reachset); + free(minprior->auxaux); + free(minprior->auxbin); + free(minprior->auxtmp); + free(minprior); +} + + +/***************************************************************************** +******************************************************************************/ +minprior_t* +setupMinPriority(multisector_t *ms) +{ minprior_t *minprior; + stageinfo_t *stageinfo; + int *auxbin, *auxtmp; + int nvtx, nstages, istage, u; + + nvtx = ms->G->nvtx; + nstages = ms->nstages; + + minprior = newMinPriority(nvtx, nstages); + minprior->ms = ms; + minprior->Gelim = setupElimGraph(ms->G); + minprior->bucket = setupBucket(nvtx, nvtx, 0); + + auxbin = minprior->auxbin; + auxtmp = minprior->auxtmp; + for (u = 0; u < nvtx; u++) + { auxbin[u] = -1; + auxtmp[u] = 0; + } + + for (istage = 0; istage < nstages; istage++) + { stageinfo = minprior->stageinfo + istage; + stageinfo->nstep = 0; + stageinfo->welim = 0; + stageinfo->nzf = 0; + stageinfo->ops = 0.0; + } + + return(minprior); +} + + +/***************************************************************************** +******************************************************************************/ +elimtree_t* +orderMinPriority(minprior_t *minprior, options_t *options, timings_t *cpus) +{ elimtree_t *T; + int nvtx, nstages, istage, scoretype, ordtype; + + nvtx = minprior->Gelim->G->nvtx; + nstages = minprior->ms->nstages; + + ordtype = options[OPTION_ORDTYPE]; + scoretype = options[OPTION_NODE_SELECTION2]; + + /* ------------------------------ + check whether nstages is valid + ------------------------------ */ + if ((nstages < 1) || (nstages > nvtx)) + { fprintf(stderr, "\nError in function orderMinPriority\n" + " no valid number of stages in multisector (#stages = %d)\n", + nstages); + quit(); + } + + if ((nstages < 2) && (ordtype != MINIMUM_PRIORITY)) + { fprintf(stderr, "\nError in function orderMinPriority\n" + " not enough stages in multisector (#stages = %d)\n", nstages); + quit(); + } + + /* -------------------------------------------------------------- + first stage: eliminate all vertices in the remaining subgraphs + -------------------------------------------------------------- */ + scoretype = options[OPTION_NODE_SELECTION1]; + eliminateStage(minprior, 0, scoretype, cpus); + + /* ------------------------------------------------------- + other stages: eliminate all vertices in the multisector + ------------------------------------------------------- */ + switch(ordtype) + { case MINIMUM_PRIORITY: + break; + case INCOMPLETE_ND: + for (istage = 1; istage < nstages; istage++) + eliminateStage(minprior, istage, scoretype, cpus); + break; + case MULTISECTION: + eliminateStage(minprior, nstages-1, scoretype, cpus); + break; + default: + fprintf(stderr, "\nError in function orderMinPriority\n" + " unrecognized ordering type %d\n", ordtype); + quit(); + } + + /* ------------------------------------------- + print statistics for the elimination stages + ------------------------------------------- */ + if ((ordtype != MINIMUM_PRIORITY) && (options[OPTION_MSGLVL] > 1)) + for (istage = 0; istage < nstages; istage++) + printf("%4d. stage: #steps %6d, weight %6d, nzl %8d, ops %e\n", istage, + minprior->stageinfo[istage].nstep, + minprior->stageinfo[istage].welim, + minprior->stageinfo[istage].nzf, + minprior->stageinfo[istage].ops); + + /* ----------------------------------- + extract elimination tree and return + ----------------------------------- */ + T = extractElimTree(minprior->Gelim); + return(T); +} + + +/***************************************************************************** +******************************************************************************/ +void +eliminateStage(minprior_t *minprior, int istage, int scoretype, timings_t *cpus) +{ gelim_t *Gelim; + bucket_t *bucket; + stageinfo_t *stageinfo; + int *stage, *reachset, *auxbin, *auxtmp, *auxaux; + int *degree, *score; + int *pflag, nreach, nvtx, r, u, i; + + Gelim = minprior->Gelim; + bucket = minprior->bucket; + stage = minprior->ms->stage; + stageinfo = minprior->stageinfo + istage; + reachset = minprior->reachset; + auxaux = minprior->auxaux; + auxbin = minprior->auxbin; + auxtmp = minprior->auxtmp; + pflag = &(minprior->flag); + + nvtx = Gelim->G->nvtx; + degree = Gelim->degree; + score = Gelim->score; + +#ifdef DEBUG + printf("\nSTARTING NEW ELIMINATION STAGE (nedges %d, maxedges %d)\n\n", + Gelim->G->nedges, Gelim->maxedges); + if (istage> 0) printElimGraph(Gelim); + /* waitkey(); */ +#endif + + /* ------------------------------------------------------------- + load reachset with all principal variables in stage <= istage + ------------------------------------------------------------- */ + nreach = 0; + for (u = 0; u < nvtx; u++) + if ((score[u] == -1) && (stage[u] <= istage)) + { reachset[nreach++] = u; + score[u] = degree[u]; + /* score[u] = degree[u]*(degree[u]-1)/2; */ + } + + /* ---------------------------------------------------------------- + do an initial update of the vertices in reachset and fill bucket + ---------------------------------------------------------------- */ + starttimer(cpus[TIME_UPDSCORE]); + updateDegree(Gelim, reachset, nreach, auxbin); + updateScore(Gelim, reachset, nreach, scoretype, auxbin); + stoptimer(cpus[TIME_UPDSCORE]); + for (i = 0; i < nreach; i++) + { u = reachset[i]; + insertBucket(bucket, score[u], u); + } + + /* ------------------------------------- + and now start the elimination process + ------------------------------------- */ + while (TRUE) + { if (eliminateStep(minprior, istage, scoretype) == 0) + break; + nreach = minprior->nreach; + +#ifdef BE_CAUTIOUS + printf("checking arrays auxtmp and auxbin\n"); + for (u = 0; u < nvtx; u++) + if ((auxtmp[u] >= *pflag) || (auxbin[u] != -1)) + { printf("ERROR: flag = %d, auxtmp[%d] = %d, auxbin[%d] = %d\n", + *pflag, u, auxtmp[u], u, auxbin[u]); + quit(); + } +#endif + + /* ---------------------------------------------------------- + update the adjacency structure of all vertices in reachset + ---------------------------------------------------------- */ + starttimer(cpus[TIME_UPDADJNCY]); + updateAdjncy(Gelim, reachset, nreach, auxtmp, pflag); + stoptimer(cpus[TIME_UPDADJNCY]); + + /* ---------------------------------------- + find indistinguishable nodes in reachset + ---------------------------------------- */ + starttimer(cpus[TIME_FINDINODES]); + findIndNodes(Gelim, reachset, nreach, auxbin, auxaux, auxtmp, pflag); + stoptimer(cpus[TIME_FINDINODES]); + +#ifdef BE_CAUTIOUS + printf("checking arrays auxtmp and auxbin\n"); + for (u = 0; u < nvtx; u++) + if ((auxtmp[u] >= *pflag) || (auxbin[u] != -1)) + { printf("ERROR: flag = %d, auxtmp[%d] = %d, auxbin[%d] = %d\n", + *pflag, u, auxtmp[u], u, auxbin[u]); + quit(); + } +#endif + + /* ---------------------------------------------------------------- + clean reachset of nonprincipal nodes and nodes not in this stage + ---------------------------------------------------------------- */ + r = 0; + for (i = 0; i < nreach; i++) + { u = reachset[i]; + if (score[u] >= 0) + reachset[r++] = u; + } + nreach = r; + + /* --------------------------------------------------- + update the degree/score of all vertices in reachset + --------------------------------------------------- */ + starttimer(cpus[TIME_UPDSCORE]); + updateDegree(Gelim, reachset, nreach, auxbin); + updateScore(Gelim, reachset, nreach, scoretype, auxbin); + stoptimer(cpus[TIME_UPDSCORE]); + + /* ---------------------------- + re-insert vertices in bucket + ---------------------------- */ + for (i = 0; i < nreach; i++) + { u = reachset[i]; + insertBucket(bucket, score[u], u); + } + + stageinfo->nstep++; + } +} + + +/***************************************************************************** +******************************************************************************/ +int +eliminateStep(minprior_t *minprior, int istage, int scoretype) +{ gelim_t *Gelim; + bucket_t *bucket; + stageinfo_t *stageinfo; + int *stage, *reachset, *auxtmp; + int *xadj, *adjncy, *vwght, *len, *degree, *score; + int *pflag, *pnreach, nelim, minscr, vwghtu, u, v, i, istart, istop; + FLOAT tri, rec; + + Gelim = minprior->Gelim; + bucket = minprior->bucket; + stage = minprior->ms->stage; + stageinfo = minprior->stageinfo + istage; + reachset = minprior->reachset; + pnreach = &(minprior->nreach); + auxtmp = minprior->auxtmp; + pflag = &(minprior->flag); + + xadj = Gelim->G->xadj; + adjncy = Gelim->G->adjncy; + vwght = Gelim->G->vwght; + len = Gelim->len; + degree = Gelim->degree; + score = Gelim->score; + +#ifdef DEBUG + printf("\nStarting new elimination step (nedges %d, maxedges %d)\n", + Gelim->G->nedges, Gelim->maxedges); + /* waitkey(); */ +#endif + + /* ---------------------- + check for empty bucket + ---------------------- */ + if ((u = minBucket(bucket)) == -1) + return(0); + minscr = score[u]; + + /* ---------------------------------------- + loop while nodes of minimum score remain + ---------------------------------------- */ + nelim = 0; + *pnreach = 0; + while (TRUE) + { vwghtu = vwght[u]; + + /* -------------------------------------------------- + increment welim and nelim and remove u from bucket + -------------------------------------------------- */ + removeBucket(bucket, u); + stageinfo->welim += vwghtu; + nelim++; + + /* ----------------------------------------------------------------- + call buildElement to create element u and merge u's boundary with + the nodes in reachset; remove any vertex from bucket that belongs + to u's boundary and to the actual stage + ----------------------------------------------------------------- */ + buildElement(Gelim, u); + istart = xadj[u]; + istop = istart + len[u]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; /* v belongs to u's boundary */ + if (auxtmp[v] < *pflag) /* v not yet in reachset */ + { auxtmp[v] = *pflag; + if (stage[v] <= istage) /* v belongs to actual stage */ + removeBucket(bucket, v); + reachset[(*pnreach)++] = v; + } + } + +#ifdef DEBUG + printf("Node %d (weight %d, score %d) eliminated: (boundary weight %d)\n", + u, vwghtu, minscr, degree[u]); + for (i = istart; i < istop; i++) + printf("%4d (degree %2d)", adjncy[i], degree[adjncy[i]]); + printf("\n"); +#endif + + /* --------------------------------------------------------------- + increment the storage and operation counts for this elim. stage + --------------------------------------------------------------- */ + tri = vwghtu; + rec = degree[u]; + stageinfo->nzf += (int)((tri * (tri+1)) / 2); + stageinfo->nzf += (int)(tri * rec); + stageinfo->ops += (tri*tri*tri) / 3.0 + (tri*tri) / 2.0 - (5*tri) / 6.0; + stageinfo->ops += (tri*tri*rec) + (rec*(rec+1)*tri); + + /* --------------------------------------------------------------- + end this elim. step, if one of the following conditions is true + (1) no multiple elimination + (2) bucket empty + (3) no further variable with minimum score + ---------------------------------------------------------------- */ + if (scoretype / 10 == 0) + break; + if ((u = minBucket(bucket)) == -1) + break; + if (score[u] > minscr) + break; + } + + /* ----------------------- + clear auxtmp and return + ----------------------- */ + (*pflag)++; + return(nelim); +} + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/multisector.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/multisector.c new file mode 100644 index 000000000..f01b24890 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/multisector.c @@ -0,0 +1,306 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: ms.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 01jan04 +/ +/ This file contains functions dealing with the multisector object +/ +****************************************************************************** + +Data type: struct multisector + graph_t *G; pointer to original graph + int *stage; stage[u]=i => node u will be elim. in stage i + int nstages; number of stages + int nnodes; number of nodes in multisector + int totmswght; weigth of nodes in multisector +Comments: + o Structure does not own graph object G => it will not be freed + Note: G is the original graph +Methods in lib/multisector.c: +- ms = newMultisector(graph_t *G); + o Initial: nstages = nnodes = totmswght = 0; +- void freeMultisector(ms_t *ms); +- ms = trivialMultisector(graph_t *G); + o allocates memory for the multisector object by a call to newMultisector + and sets stage[u] = 0 for all vertices u and nstages = 1; the trivial + multisector can be used for pure bottom-up orderings +- ms = constructMultisector(graph_t *G, options_t* options, timings_t *cpus); + o MASTER_FUNCTION: computes a multisector for G according to the specified + ordtype e { MINIMUM_PRIORITY, INCOMPLETE_ND, MULTISECTION, + TRISTAGE_MULTISECTION } + MINIMUM_PRIORTY: + return the multisector obtained by a call to trivialMultisector + INCOMPLETE_ND, MULTISECTION, TRISTAGE_MULTISECTION: + build separator tree by calling buildNDtree and extract multisector + by calling extractMS2stage (MULTISECTION) or extractMSmultistage + (INCOMPLETE_ND, TRISTAGE_MULTISECTION) + o used options: (also see buildNDtree) + OPTION_ORDTYPE, OPTION_DOMAIN_SIZE, OPTION_MSGLVL, OPTION_NODE_SELECTION3 + o returned timings: (see buildNDtree) + TIME_INITDOMDEC, TIME_COARSEDOMDEC, TIME_INITSEP, TIME_REFINESEP + TIME_MULTILEVEL, TIME_SMOOTH +- ms = extractMS2stage(nestdiss_t *ndroot); + o extracts a 2-stage multisector from the nested dissection tree with root + ndroot: stage[u] = 0 => u belongs to a domain + stage[u] = 1 => u belongs to the multisector + and nstages = 2; the 2-stage multisector can be used for classical + multisection orderings +- ms = extractMSmultistage(nestdiss_t *ndroot); + o extracts a multi-stage multisector from the nested dissection tree at + ndroot: stage[u] = 0 => u belongs to a domain + stage[u] = i, i > 0 => u belongs to the multisector, i.e.: + stage[u] = 1 => u belongs to a leaf separator + : + stage[u] = nstages-1 => u belongs to the root separator + the multisector can be used for incomplete nested dissection orderings + or for three-stage multisection orderings + +******************************************************************************/ + +#include + + +/***************************************************************************** +******************************************************************************/ +multisector_t* +newMultisector(graph_t *G) +{ multisector_t *ms; + + mymalloc(ms, 1, multisector_t); + mymalloc(ms->stage, G->nvtx, int); + + ms->G = G; + ms->nstages = 0; + ms->nnodes = 0; + ms->totmswght = 0; + + return(ms); +} + + +/***************************************************************************** +******************************************************************************/ +void +freeMultisector(multisector_t *ms) +{ + free(ms->stage); + free(ms); +} + + +/***************************************************************************** +******************************************************************************/ +multisector_t* +trivialMultisector(graph_t *G) +{ multisector_t *ms; + int *stage, nvtx, u; + + /* ----------------------------------------------------------------- + allocate memory for the multisector object and init. stage vector + ----------------------------------------------------------------- */ + nvtx = G->nvtx; + ms = newMultisector(G); + stage = ms->stage; + + for (u = 0; u < nvtx; u++) + stage[u] = 0; /* no vertex belongs to a separator */ + + /* ------------------------------- + finalize the multisector object + ------------------------------- */ + ms->nstages = 1; + ms->nnodes = 0; + ms->totmswght = 0; + + return(ms); +} + + +/***************************************************************************** +******************************************************************************/ +multisector_t* +constructMultisector(graph_t *G, options_t* options, timings_t *cpus) +{ multisector_t *ms; + nestdiss_t *ndroot; + int *map, nvtx, ordtype; + + nvtx = G->nvtx; + + /* ------------------------------ + check number of nodes in graph + ------------------------------ */ + /* ----------------------------------- + JY: inserted the condition + "&& (options[OPTION_MSGLVL] > 0)" + below, to avoid systematic printing + ----------------------------------- */ + if ((nvtx <= MIN_NODES) && (options[OPTION_ORDTYPE] != MINIMUM_PRIORITY) + && (options[OPTION_MSGLVL] > 0)) + { printf("\nWarning in constructMultisector\n" + " graph has less than %d nodes, skipping separator construction\n\n", + MIN_NODES); + options[OPTION_ORDTYPE] = MINIMUM_PRIORITY; + } + /* -------------------------------------------------------- + determine the multisector according to the ordering type + -------------------------------------------------------- */ + ordtype = options[OPTION_ORDTYPE]; + switch(ordtype) + { case MINIMUM_PRIORITY: + ms = trivialMultisector(G); + break; + + case INCOMPLETE_ND: + case MULTISECTION: + case TRISTAGE_MULTISECTION: + mymalloc(map, nvtx, int); + ndroot = setupNDroot(G, map); + buildNDtree(ndroot, options, cpus); + if (ordtype == MULTISECTION) + ms = extractMS2stage(ndroot); + else + ms = extractMSmultistage(ndroot); + freeNDtree(ndroot); + freeNDnode(ndroot); + free(map); + break; + + default: + fprintf(stderr, "\nError in function constructMultisector\n" + " unrecognized ordering type %d\n", ordtype); + quit(); + } + return(ms); +} + + +/***************************************************************************** +******************************************************************************/ +multisector_t* +extractMS2stage(nestdiss_t *ndroot) +{ multisector_t *ms; + nestdiss_t *nd, *parent; + int *stage, *intvertex, *intcolor; + int nvint, nnodes, totmswght, i; + + /* ----------------------------------------------------------------- + allocate memory for the multisector object and init. stage vector + ----------------------------------------------------------------- */ + ms = trivialMultisector(ndroot->G); + stage = ms->stage; + + /* ------------------------------------------------------------ + extract the stages of the separator vertices: + stage[u] = 1, iff u belongs to a separator + ------------------------------------------------------------ */ + nnodes = totmswght = 0; + for (nd = ndroot; nd->childB != NULL; nd = nd->childB); + while (nd != ndroot) + { parent = nd->parent; + if ((parent == NULL) || (parent->childB == NULL) + || (parent->childW == NULL)) + { fprintf(stderr, "\nError in function extractMS2stage\n" + " nested dissection tree corrupted\n"); + quit(); + } + if (parent->childB == nd) /* left subtree of parent visited */ + for (nd = parent->childW; nd->childB != NULL; nd = nd->childB); + else /* right subtree of parent visited */ + { nd = parent; /* extract the separator of parent */ + totmswght += nd->cwght[GRAY]; + nvint = nd->nvint; + intvertex = nd->intvertex; + intcolor = nd->intcolor; + for (i = 0; i < nvint; i++) + if (intcolor[i] == GRAY) + { nnodes++; + stage[intvertex[i]] = 1; + } + } + } + + /* ------------------------------------------ + finalize the multisector object and return + ------------------------------------------ */ + ms->nstages = 2; + ms->nnodes = nnodes; + ms->totmswght = totmswght; + + return(ms); +} + + +/***************************************************************************** +******************************************************************************/ +multisector_t* +extractMSmultistage(nestdiss_t *ndroot) +{ multisector_t *ms; + nestdiss_t *nd, *parent; + int *stage, *intvertex, *intcolor; + int nvtx, nvint, maxstage, istage, nnodes, totmswght, i, u; + + /* ----------------------------------------------------------------- + allocate memory for the multisector object and init. stage vector + ----------------------------------------------------------------- */ + ms = trivialMultisector(ndroot->G); + stage = ms->stage; + + /* ------------------------------------------------------------ + extract the stages of the separator vertices: + stage[u] = i, i>0, iff u belongs to a separator in depth i-1 + ------------------------------------------------------------ */ + maxstage = nnodes = totmswght = 0; + for (nd = ndroot; nd->childB != NULL; nd = nd->childB); + while (nd != ndroot) + { parent = nd->parent; + if ((parent == NULL) || (parent->childB == NULL) + || (parent->childW == NULL)) + { fprintf(stderr, "\nError in function extractMSmultistage\n" + " nested dissection tree corrupted\n"); + quit(); + } + if (parent->childB == nd) /* left subtree of parent visited */ + for (nd = parent->childW; nd->childB != NULL; nd = nd->childB); + else /* right subtree of parent visited */ + { nd = parent; /* extract the separator of parent */ + istage = nd->depth + 1; /* sep. vertices belong to this stage */ + maxstage = max(maxstage, istage); + totmswght += nd->cwght[GRAY]; + nvint = nd->nvint; + intvertex = nd->intvertex; + intcolor = nd->intcolor; + for (i = 0; i < nvint; i++) + if (intcolor[i] == GRAY) + { nnodes++; + stage[intvertex[i]] = istage; + } + } + } + + /* -------------------------------------------------------------------- + we have: stage[u] = 0 => u belongs to a domain + stage[u] = 1 => u belongs to the root separator (depth = 0) + : + stage[u] = maxstage => u belongs to a leaf separator + but we must eliminate the separators in a bottom-up fashion; we like + to have: stage[u] = 0 => u belongs to a domain + stage[u] = 1 => u belongs to a leaf separator + : + stage[u] = maxstage => u belongs to the root separator + -------------------------------------------------------------------- */ + nvtx = ndroot->G->nvtx; + for (u = 0; u < nvtx; u++) + if (stage[u] > 0) + stage[u] = maxstage - stage[u] + 1; + + /* ------------------------------------------ + finalize the multisector object and return + ------------------------------------------ */ + ms->nstages = maxstage + 1; + ms->nnodes = nnodes; + ms->totmswght = totmswght; + + return(ms); +} diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/nestdiss.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/nestdiss.c new file mode 100644 index 000000000..1067213e9 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/nestdiss.c @@ -0,0 +1,285 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: nestdiss.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 00dec29 +/ +/ This file contains functions dealing with the rec. nested dissection object +/ +****************************************************************************** + +Data type: struct nestdiss + graph_t *G; pointer to original graph + int *map; maps nodes of G to constructed subgraph + int depth; depth in nested dissection tree + int nvint; number of vertices in subgraph + int *intvertex; internal vertices of subgraph + int *intcolor; color of vertices in intvertex + int cwght[3]; weights of bisection + struct nestdiss *parent; pointer to parent nd node + struct nestdiss *childB; pointer to black descendant nd node + struct nestdiss *childW; pointer to white descendand nd node +Comments: + o Structure used to build the nested dissection tree. Vector intvertex + holds the vertices of the subgraph to be partitioned. Once a separator + has been computed, the coloring of vertex u = intvertex[i] is stored in + vector intcolor[i] and the partition weights are stored in cwght[GRAY], + cwght[BLACK], and cwght[WHITE]. + o Structure does not own graph object G => it will not be freed + Note: G is the original graph + o Structure does not own map array => it will not be freed + Note: map is a "global" array that is used when constructing the subgraph + induced by the vertices in intvertex. The array maps the vertices + of the original graph G to the vertices of the subgraph. +Methods in lib/nestdiss.c: +- nd = newNDnode(graph_t *G, int *map, int nvint); + o Initial: depth = 0, cwght[GRAY] = cwght[BLACK] = cwght[WHITE] = 0, + and parent = childB = childW = NULL; +- void freeNDnode(nestdiss_t *nd); +- ndroot = setupNDroot(graph_t *G, int *map); + o sets up the root of the nested dissection tree; the function first + calls newNDnode to allocate memory for ndroot and, then, sets + intvertex[i] = i for all 0 <= i < G->nvtx +- void splitNDnode(nestdiss_t *nd, options_t *options, timings_t *cpus); + o constructs the subgraph induced by nd->intvertex and computes a + bisection for it by calling constructSeparator and smoothSeparator. + Then, the nd object is splitted in a black one that holds the black + partition and a white one that holds the white partition. + o used options: (see constructSeparator and smoothSeparator) + OPTION_MSGLVL, OPTION_NODE_SELECTION3 + o returned timings: (also see constructSeparator) + TIME_INITDOMDEC, TIME_COARSEDOMDEC, TIME_INITSEP, TIME_REFINESEP + TIME_MULTILEVEL, TIME_SMOOTH +- void buildNDtree(nestdiss_t *ndroot, options_t *options, timings_t *cpus); + o builds the nested dissection tree under root ndroot, i.e. it applies + the nested dissection process to the (sub)graph induced by + ndroot->intvertex by iteratively calling function splitNDnode. + o used options: (also see splitNDnode) + OPTION_DOMAIN_SIZE, OPTION_MSGLVL, OPTION_NODE_SELECTION3 + o returned timings: (see splitNDnode) + TIME_INITDOMDEC, TIME_COARSEDOMDEC, TIME_INITSEP, TIME_REFINESEP + TIME_MULTILEVEL, TIME_SMOOTH +- void freeNDtree(nestdiss_t *ndroot); + o removes the nested dissection tree under root ndroot + Note: ndroot is not freed + +******************************************************************************/ + +#include + + +/***************************************************************************** +******************************************************************************/ +nestdiss_t* +newNDnode(graph_t *G, int *map, int nvint) +{ nestdiss_t *nd; + + mymalloc(nd, 1, nestdiss_t); + mymalloc(nd->intvertex, nvint, int); + mymalloc(nd->intcolor, nvint, int); + + nd->G = G; + nd->map = map; + nd->depth = 0; + nd->nvint = nvint; + nd->cwght[GRAY] = nd->cwght[BLACK] = nd->cwght[WHITE] = 0; + nd->parent = nd->childB = nd->childW = NULL; + + return(nd); +} + + +/***************************************************************************** +******************************************************************************/ +void +freeNDnode(nestdiss_t *nd) +{ + free(nd->intvertex); + free(nd->intcolor); + free(nd); +} + + +/***************************************************************************** +******************************************************************************/ +nestdiss_t* +setupNDroot(graph_t *G, int *map) +{ nestdiss_t *ndroot; + int *intvertex, nvtx, i; + + nvtx = G->nvtx; + ndroot = newNDnode(G, map, nvtx); + intvertex = ndroot->intvertex; + + for (i = 0; i < nvtx; i++) + intvertex[i] = i; + + return(ndroot); +} + + +/***************************************************************************** +******************************************************************************/ +void +splitNDnode(nestdiss_t *nd, options_t *options, timings_t *cpus) +{ nestdiss_t *b_nd, *w_nd; + graph_t *Gsub; + gbisect_t *Gbisect; + int *map, *intvertex, *intcolor, *b_intvertex, *w_intvertex; + int nvint, b_nvint, w_nvint, u, i; + + map = nd->map; + nvint = nd->nvint; + intvertex = nd->intvertex; + intcolor = nd->intcolor; + + /* ------------------------------------------------------------- + extract the subgraph for which a bisection has to be computed + ------------------------------------------------------------- */ + if (nd->G->nvtx == nd->nvint) + { Gsub = nd->G; /* a hack to save time and space */ + for (u = 0; u < nd->nvint; u++) /* but do not forget the map vector */ + map[u] = u; + } + else + Gsub = setupSubgraph(nd->G, intvertex, nvint, map); + Gbisect = newGbisect(Gsub); + + /* --------------------------------- + compute the bisection for Gbisect + --------------------------------- */ + starttimer(cpus[TIME_MULTILEVEL]); + constructSeparator(Gbisect, options, cpus); + stoptimer(cpus[TIME_MULTILEVEL]); + + starttimer(cpus[TIME_SMOOTH]); + if (Gbisect->cwght[GRAY] > 0) + smoothSeparator(Gbisect, options); + stoptimer(cpus[TIME_SMOOTH]); + + /* ---------------------------------------- + copy the bisection back to the nd object + ---------------------------------------- */ + b_nvint = w_nvint = 0; + nd->cwght[GRAY] = Gbisect->cwght[GRAY]; + nd->cwght[BLACK] = Gbisect->cwght[BLACK]; + nd->cwght[WHITE] = Gbisect->cwght[WHITE]; + for (i = 0; i < nvint; i++) + { u = intvertex[i]; + intcolor[i] = Gbisect->color[map[u]]; + switch(intcolor[i]) + { case GRAY: break; + case BLACK: b_nvint++; break; + case WHITE: w_nvint++; break; + default: + fprintf(stderr, "\nError in function splitNDnode\n" + " node %d has unrecognized color %d\n", u, intcolor[i]); + quit(); + } + } + + /* ------------------------------------------------------ + and now split the nd object according to the bisection + ------------------------------------------------------ */ + b_nd = newNDnode(nd->G, map, b_nvint); + b_intvertex = b_nd->intvertex; + w_nd = newNDnode(nd->G, map, w_nvint); + w_intvertex = w_nd->intvertex; + + b_nvint = w_nvint = 0; + for (i = 0; i < nvint; i++) + { u = intvertex[i]; + if (intcolor[i] == BLACK) b_intvertex[b_nvint++] = u; + if (intcolor[i] == WHITE) w_intvertex[w_nvint++] = u; + } + nd->childB = b_nd; b_nd->parent = nd; + nd->childW = w_nd; w_nd->parent = nd; + b_nd->depth = nd->depth + 1; + w_nd->depth = nd->depth + 1; + + /* ----------------- + free the subgraph + ----------------- */ + if (Gsub != nd->G) + freeGraph(Gsub); + freeGbisect(Gbisect); +} + + +/***************************************************************************** +******************************************************************************/ +void +buildNDtree(nestdiss_t *ndroot, options_t *options, timings_t *cpus) +{ nestdiss_t *nd; + nestdiss_t *queue[2*MAX_SEPS+1]; + int maxseps, seps, domainsize, qhead, qtail; + + maxseps = MAX_SEPS; + domainsize = options[OPTION_DOMAIN_SIZE]; + if (domainsize == 1) maxseps = DEFAULT_SEPS; /* secret switch */ + + /* -------------------------------------------------- + build the nested dissection tree under root ndroot + -------------------------------------------------- */ + queue[0] = ndroot; + qhead = 0; qtail = 1; seps = 0; + while ((qhead != qtail) && (seps < maxseps)) + { seps++; + nd = queue[qhead++]; + + splitNDnode(nd, options, cpus); + if ((nd->childB == NULL) || (nd->childW == NULL)) + { fprintf(stderr, "\nError in function buildNDtree\n" + " recursive nested dissection process failed\n"); + quit(); + } + + if (options[OPTION_MSGLVL] > 1) + printf("%4d. S %6d, B %6d, W %6d [bal %4.2f, rel %6.4f, cost %7.2f]\n", + seps, nd->cwght[GRAY], nd->cwght[BLACK], nd->cwght[WHITE], + (FLOAT)min(nd->cwght[BLACK], nd->cwght[WHITE]) + / max(nd->cwght[BLACK], nd->cwght[WHITE]), + (FLOAT)nd->cwght[GRAY] + / (nd->cwght[GRAY] + nd->cwght[BLACK] + nd->cwght[WHITE]), + F(nd->cwght[GRAY], nd->cwght[BLACK], nd->cwght[WHITE])); + + if ((nd->childB->nvint > MIN_NODES) + && ((nd->cwght[BLACK] > domainsize) || (qtail < DEFAULT_SEPS))) + queue[qtail++] = nd->childB; + if ((nd->childW->nvint > MIN_NODES) + && ((nd->cwght[WHITE] > domainsize) || (qtail < DEFAULT_SEPS))) + queue[qtail++] = nd->childW; + } +} + + +/***************************************************************************** +******************************************************************************/ +void +freeNDtree(nestdiss_t *ndroot) +{ nestdiss_t *nd, *parent; + + /* ------------------------------------------------------ + to remove the nested dissection tree under root ndroot + visit the nodes in post-order + ------------------------------------------------------ */ + for (nd = ndroot; nd->childB != NULL; nd = nd->childB); + while (nd != ndroot) + { parent = nd->parent; + if ((parent == NULL) || (parent->childB == NULL) + || (parent->childW == NULL)) + { fprintf(stderr, "\nError in function removeNDtree\n" + " nested dissection tree corrupted\n"); + quit(); + } + if (parent->childB == nd) /* left subtree of parent visited */ + { freeNDnode(nd); /* free root of left subtree and goto right */ + for (nd = parent->childW; nd->childB != NULL; nd = nd->childB); + } + else /* right subtree of parent visited */ + { freeNDnode(nd); /* free root of right subtree and goto parent */ + nd = parent; + } + } +} diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/sort.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/sort.c new file mode 100644 index 000000000..45cf525c7 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/sort.c @@ -0,0 +1,231 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: sort.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 09/15/99 +/ +/ This file contains some sorting functions. the code is adopted from +/ the book "Algorithms in C" by R. Sedgewick. +/ +******************************************************************************/ + +#include +#define THRES 10 + + +/***************************************************************************** +/ insertion sort upwards (INTS, without keys) +******************************************************************************/ +void +insertUpInts(int n, int *array) +{ int i, j, v; + + for (i = 1; i < n; i++) + { v = array[i]; j = i; + while ((j > 0) && (array[j-1] > v)) + { array[j] = array[j-1]; + j--; + } + array[j] = v; + } +} + + +/***************************************************************************** +/ insertion sort upwards (INTS, with static INT keys) +******************************************************************************/ +void +insertUpIntsWithStaticIntKeys(int n, int *array, int *key) +{ int i, j, ke; + int e; + + for (i = 1; i < n; i++) + { e = array[i]; ke = key[e]; j = i; + while ((j > 0) && (key[array[j-1]] > ke)) + { array[j] = array[j-1]; + j--; + } + array[j] = e; + } +} + + +/***************************************************************************** +/ insertion sort downwards (INTS, with static INT keys) +******************************************************************************/ +void +insertDownIntsWithStaticFloatKeys(int n, int *array, FLOAT *key) +{ int i, j, e; + FLOAT ke; + + for (i = 1; i < n; i++) + { e = array[i]; ke = key[e]; j = i; + while ((j > 0) && (key[array[j-1]] < ke)) + { array[j] = array[j-1]; + j--; + } + array[j] = e; + } +} + + +/***************************************************************************** +/ insertion sort upwards (FLOATS, with INT keys) +******************************************************************************/ +void +insertUpFloatsWithIntKeys(int n, FLOAT *array, int *key) +{ int i, j, ke; + FLOAT e; + + for (i = 1; i < n; i++) + { e = array[i]; ke = key[i]; j = i; + while ((j > 0) && (key[j-1] > ke)) + { array[j] = array[j-1]; + key[j] = key[j-1]; + j--; + } + array[j] = e; + key[j] = ke; + } +} + + +/***************************************************************************** +/ median-of-three quicksort upwards (INTS, without keys) +******************************************************************************/ +void +qsortUpInts(int n, int *array, int *stack) +{ register int i, j; + int t, l, m, r, p; + + l = 0; r = n-1; p = 2; + while (p > 0) + if ((r-l) > THRES) + { m = l + ((r-l) >> 1); + if (array[l] > array[r]) swap(array[l], array[r], t); + if (array[l] > array[m]) swap(array[l], array[m], t); + if (array[r] > array[m]) swap(array[m], array[r], t); + m = array[r]; i = l-1; j = r; + for (;;) + { while (array[++i] < m); + while (array[--j] > m); + if (i >= j) break; + swap(array[i], array[j], t); + } + swap(array[i], array[r], t); + if ((i-l) > (r-i)) + { stack[p++] = l; + stack[p++] = i-1; + l = i+1; + } + else + { stack[p++] = i+1; + stack[p++] = r; + r = i-1; + } + } + else + { r = stack[--p]; + l = stack[--p]; + } + if (THRES > 0) insertUpInts(n, array); +} + + +/***************************************************************************** +/ median-of-three quicksort upwards (FLOATS, with INT keys) +******************************************************************************/ +void +qsortUpFloatsWithIntKeys(int n, FLOAT *array, int *key, int *stack) +{ register int i, j; + int t, l, m, r, p; + FLOAT e; + + l = 0; r = n-1; p = 2; + while (p > 0) + if ((r-l) > THRES) + { m = l + ((r-l) >> 1); + if (key[l] > key[r]) + { swap(array[l], array[r], e); swap(key[l], key[r], t); } + if (key[l] > key[m]) + { swap(array[l], array[m], e); swap(key[l], key[m], t); } + if (key[r] > key[m]) + { swap(array[m], array[r], e); swap(key[m], key[r], t); } + m = key[r]; i = l-1; j = r; + for (;;) + { while (key[++i] < m); + while (key[--j] > m); + if (i >= j) break; + swap(array[i], array[j], e); swap(key[i], key[j], t); + } + swap(array[i], array[r], e); swap(key[i], key[r], t); + if ((i-l) > (r-i)) + { stack[p++] = l; + stack[p++] = i-1; + l = i+1; + } + else + { stack[p++] = i+1; + stack[p++] = r; + r = i-1; + } + } + else + { r = stack[--p]; + l = stack[--p]; + } + if (THRES > 0) insertUpFloatsWithIntKeys(n, array, key); +} + + +/***************************************************************************** +/ distribution counting (INTS, with static INT keys) +******************************************************************************/ +void +distributionCounting(int n, int *node, int *key) +{ register int i; + int *tmp, *count, minkey, maxkey, l, u, vk; + + /* determine maximal and minimal key */ + minkey = MAX_INT; + maxkey = 0; + for (i = 0; i < n; i++) + { u = node[i]; + maxkey = max(key[u], maxkey); + minkey = min(key[u], minkey); + } + l = maxkey-minkey; + /* printf("minkey %d, maxkey %d, range %d\n", minkey, maxkey, l); */ + mymalloc(count, (l+1), int); + mymalloc(tmp, n, int); + for (i = 0; i <= l; i++) + count[i] = 0; + + /* scale down all key-values */ + for (i = 0; i < n; i++) + { u = node[i]; + vk = key[u]-minkey; + key[u] = vk; + count[vk]++; + } + + /* now do the sorting */ + for (i = 1; i <= l; i++) + count[i] += count[i-1]; + for (i = n-1; i >= 0; i--) + { u = node[i]; + tmp[--count[key[u]]] = u; + } + for (i = 0; i < n; i++) + node[i] = tmp[i]; +/* + for (i = 0; i < n; i++) + { u = node[i]; + printf(" node %d, key %d\n", u, key[u]); + } +*/ + free(count); + free(tmp); +} + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/symbfac.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/symbfac.c new file mode 100644 index 000000000..eaf083ce9 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/symbfac.c @@ -0,0 +1,638 @@ +/***************************************************************************** +/ +/ SPACE (SPArse Cholesky Elimination) Library: symbfac.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 09/15/99 +/ +/ This file contains code for the symbolical factorization. +/ +****************************************************************************** + +Data type: struct css + int neqs; number of equations + int nind; number of row subscripts in compressed format + int owned; does the object own vector nzlsub? + int *xnzl; start of column + int *nzlsub; row subscripts + int *xnzlsub; start of column's row subscripts + + struct frontsub + elimtree_t *PTP; permuted elimination tree + int nind number of indices + int *xnzf; start of front subscripts + int *nzfsub front subscripts for permuted elimtree PTP + + struct factorMtx + int nelem; number of nonzeros (incl. diagonal entries) + int *perm; permutation vector + FLOAT *nzl; vector of nonzeros (incl. diagonal entries) + css_t *css; compressed subscript structure of factorMtx + frontsub_t *frontsub; front subscripts +Comments: +Methods in lib/symbfac.c: +- css = newCSS(int neqs, int nind, int owned); +- void freeCSS(css_t *css); +- css = setupCSSFromGraph(graph_t *G, int *perm, int *invp); +- css = setupCSSFromFrontSubscripts(frontsub_t *frontsub); +- frontsub = newFrontSubscripts(elimtree_t *PTP); +- void freeFrontSubscripts(frontsub_t *frontsub); +- void printFrontSubscripts(frontsub_t *frontsub); +- frontsub = setupFrontSubscripts(elimtree_t *PTP, inputMtx_t *PAP); +- L = newFactorMtx(int nelem); +- void freeFactorMtx(factorMtx_t *L); +- void printFactorMtx(factorMtx_t *L); +- void initFactorMtx(factorMtx_t *L, inputMtx_t *PAP); +- void initFactorMtxNEW(factorMtx_t *L, inputMtx_t *PAP); + +******************************************************************************/ + +#include + + +/***************************************************************************** +******************************************************************************/ +css_t* +newCSS(int neqs, int nind, int owned) +{ css_t *css; + + mymalloc(css, 1, css_t); + mymalloc(css->xnzl, (neqs+1), int); + mymalloc(css->xnzlsub, neqs, int); + if (owned) + { mymalloc(css->nzlsub, nind, int); } + else + { css->nzlsub = NULL; } + css->neqs = neqs; + css->nind = nind; + css->owned = owned; + + return(css); +} + + +/***************************************************************************** +******************************************************************************/ +void +freeCSS(css_t *css) +{ + free(css->xnzl); + free(css->xnzlsub); + if (css->owned) + free(css->nzlsub); + free(css); +} + + +/***************************************************************************** +******************************************************************************/ +css_t* +setupCSSFromGraph(graph_t *G, int *perm, int *invp) +{ css_t *css; + int *marker, *mergelink, *indices, *tmp, *xnzl, *xnzlsub, *nzlsub; + int neqs, maxmem, u, v, col, mergecol, knz, mrk, beg, end; + int fast, len, k, p, e, i, istart, istop; + + neqs = G->nvtx; + maxmem = 2 * neqs; + + /* ------------------------- + set up the working arrays + ------------------------- */ + mymalloc(marker, neqs, int); + mymalloc(indices, neqs, int); + mymalloc(mergelink, neqs, int); + mymalloc(tmp, neqs, int); + for (k = 0; k < neqs; k++) + marker[k] = mergelink[k] = -1; + + /* ------------------------------------------------------- + allocate storage for the compressed subscript structure + ------------------------------------------------------- */ + css = newCSS(neqs, maxmem, TRUE); + + xnzl = css->xnzl; + nzlsub = css->nzlsub; + xnzlsub = css->xnzlsub; + + /* ------------------------------------------------------------ + main loop: determine the subdiag. row indices of each column + ------------------------------------------------------------ */ + xnzl[0] = 0; + beg = end = 0; + for (k = 0; k < neqs; k++) + { indices[0] = k; + knz = 1; + + if ((mergecol = mergelink[k]) != -1) /* is k a leaf ??? */ + { mrk = marker[mergecol]; + fast = TRUE; + } + else + { mrk = k; + fast = FALSE; + } + + /* -------------------------- + original columns (indices) + -------------------------- */ + u = invp[k]; + istart = G->xadj[u]; + istop = G->xadj[u+1]; + for (i = istart; i < istop; i++) + { v = G->adjncy[i]; + if ((col = perm[v]) > k) + { indices[knz++] = col; + if (marker[col] != mrk) fast = FALSE; + } + } + + /* -------------------------- + external columns (indices) + -------------------------- */ + if ((fast) && (mergelink[mergecol] == -1)) + { xnzlsub[k] = xnzlsub[mergecol] + 1; + knz = xnzl[mergecol+1] - xnzl[mergecol] - 1; + } + else + { for (i = 0; i < knz; i++) + marker[indices[i]] = k; + while (mergecol != -1) + { len = xnzl[mergecol+1] - xnzl[mergecol]; + istart = xnzlsub[mergecol]; + istop = istart + len; + for (i = istart; i < istop; i++) + { col = nzlsub[i]; + if ((col > k) && (marker[col] != k)) + { indices[knz++] = col; + marker[col] = k; + } + } + mergecol = mergelink[mergecol]; + } + qsortUpInts(knz, indices, tmp); + + /* --------------------------------------------------- + store indices in nzlsub; resize nzlsub if too small + --------------------------------------------------- */ + beg = end; + xnzlsub[k] = beg; + end = beg + knz; + if (end > maxmem) + { maxmem += neqs; + myrealloc(nzlsub, maxmem, int); + } + len = 0; + for (i = beg; i < end; i++) + nzlsub[i] = indices[len++]; + } + + /* ---------------------------- + append column k to mergelink + ---------------------------- */ + if (knz > 1) + { p = xnzlsub[k]+1; + e = nzlsub[p]; + mergelink[k] = mergelink[e]; + mergelink[e] = k; + } + xnzl[k+1] = xnzl[k] + knz; + } + + /* ----------------------------- + end of main loop: free memory + ----------------------------- */ + free(marker); free(indices); + free(tmp); free(mergelink); + + /* ------------------------------------------------------ + finalize the compressed subscript structure and return + ------------------------------------------------------ */ + css->nind = xnzlsub[neqs-1] + 1; + myrealloc(nzlsub, css->nind, int); + css->nzlsub = nzlsub; + return(css); +} + + +/***************************************************************************** +******************************************************************************/ +css_t* +setupCSSFromFrontSubscripts(frontsub_t *frontsub) +{ elimtree_t *PTP; + css_t *css; + int *xnzf, *nzfsub, *ncolfactor, *xnzl, *xnzlsub; + int nind, nvtx, K, beg, knz, firstcol, col; + + PTP = frontsub->PTP; + xnzf = frontsub->xnzf; + nzfsub = frontsub->nzfsub; + nind = frontsub->nind; + + nvtx = PTP->nvtx; + ncolfactor = PTP->ncolfactor; + + /* ------------------------------------------------------- + allocate storage for the compressed subscript structure + ------------------------------------------------------- */ + css = newCSS(nvtx, nind, FALSE); + css->nzlsub = nzfsub; + + xnzl = css->xnzl; + xnzlsub = css->xnzlsub; + + /* --------------------------------------- + fill the compressed subscript structure + --------------------------------------- */ + xnzl[0] = 0; + for (K = firstPostorder(PTP); K != -1; K = nextPostorder(PTP, K)) + { beg = xnzf[K]; + knz = xnzf[K+1] - beg; + firstcol = nzfsub[beg]; + for (col = firstcol; col < firstcol + ncolfactor[K]; col++) + { xnzlsub[col] = beg++; + xnzl[col+1] = xnzl[col] + knz--; + } + } + + return(css); +} + + +/***************************************************************************** +******************************************************************************/ +frontsub_t* +newFrontSubscripts(elimtree_t *PTP) +{ frontsub_t *frontsub; + int nfronts, nind; + + nfronts = PTP->nfronts; + nind = nFactorIndices(PTP); + + mymalloc(frontsub, 1, frontsub_t); + mymalloc(frontsub->xnzf, (nfronts+1), int); + mymalloc(frontsub->nzfsub, nind, int); + + frontsub->PTP = PTP; + frontsub->nind = nind; + + return(frontsub); +} + + +/***************************************************************************** +******************************************************************************/ +void +freeFrontSubscripts(frontsub_t *frontsub) +{ + freeElimTree(frontsub->PTP); + free(frontsub->xnzf); + free(frontsub->nzfsub); + free(frontsub); +} + + +/***************************************************************************** +******************************************************************************/ +void +printFrontSubscripts(frontsub_t *frontsub) +{ elimtree_t *PTP; + int *xnzf, *nzfsub, *ncolfactor, *ncolupdate, *parent; + int nfronts, root, K, count, i, istart, istop; + + PTP = frontsub->PTP; + xnzf = frontsub->xnzf; + nzfsub = frontsub->nzfsub; + + nfronts = PTP->nfronts; + root = PTP->root; + ncolfactor = PTP->ncolfactor; + ncolupdate = PTP->ncolupdate; + parent = PTP->parent; + + printf("#fronts %d, root %d\n", nfronts, root); + for (K = firstPostorder(PTP); K != -1; K = nextPostorder(PTP, K)) + { printf("--- front %d, ncolfactor %d, ncolupdate %d, parent %d\n", + K, ncolfactor[K], ncolupdate[K], parent[K]); + count = 0; + istart = xnzf[K]; + istop = xnzf[K+1]; + for (i = istart; i < istop; i++) + { printf("%5d", nzfsub[i]); + if ((++count % 16) == 0) + printf("\n"); + } + if ((count % 16) != 0) + printf("\n"); + } +} + + +/***************************************************************************** +******************************************************************************/ +frontsub_t* +setupFrontSubscripts(elimtree_t *PTP, inputMtx_t *PAP) +{ frontsub_t *frontsub; + int *ncolfactor, *ncolupdate, *firstchild, *silbings, *vtx2front; + int *xnza, *nzasub, *xnzf, *nzfsub; + int *marker, *tmp, *first, *indices; + int nvtx, nfronts, col, firstcol, knz; + int u, i, istart, istop, K, J; + + nvtx = PTP->nvtx; + nfronts = PTP->nfronts; + ncolfactor = PTP->ncolfactor; + ncolupdate = PTP->ncolupdate; + firstchild = PTP->firstchild; + silbings = PTP->silbings; + vtx2front = PTP->vtx2front; + + xnza = PAP->xnza; + nzasub = PAP->nzasub; + + /* ------------------------- + set up the working arrays + ------------------------- */ + mymalloc(marker, nvtx, int); + mymalloc(tmp, nvtx, int); + mymalloc(first, nfronts, int); + for (i = 0; i < nvtx; i++) + marker[i] = -1; + + /* -------------------------------- + find the first column of a front + -------------------------------- */ + for (u = nvtx-1; u >= 0; u--) + { K = vtx2front[u]; + first[K] = u; + } + + /* ----------------------------------------- + allocate storage for the front subscripts + ----------------------------------------- */ + frontsub = newFrontSubscripts(PTP); + xnzf = frontsub->xnzf; + nzfsub = frontsub->nzfsub; + + knz = 0; + for (K = 0; K < nfronts; K++) + { xnzf[K] = knz; + knz += (ncolfactor[K] + ncolupdate[K]); + } + xnzf[K] = knz; + + /* ------------------------------------------- + postorder traversal of the elimination tree + ------------------------------------------- */ + for (K = firstPostorder(PTP); K != -1; K = nextPostorder(PTP, K)) + { knz = 0; + indices = nzfsub + xnzf[K]; + firstcol = first[K]; + + /* ------------------------------------- + internal columns (indices) of front K + ------------------------------------- */ + for (col = firstcol; col < firstcol + ncolfactor[K]; col++) + { indices[knz++] = col; + marker[col] = K; + } + + /* ------------------------------------- + external columns (indices) of front K + ------------------------------------- */ + for (J = firstchild[K]; J != -1; J = silbings[J]) + { istart = xnzf[J]; + istop = xnzf[J+1]; + for (i = istart; i < istop; i++) + { col = nzfsub[i]; + if ((col > firstcol) && (marker[col] != K)) + { marker[col] = K; + indices[knz++] = col; + } + } + } + + /* ------------------------------------- + original columns (indices) of front K + ------------------------------------- */ + for (u = 0; u < ncolfactor[K]; u++) + { istart = xnza[firstcol + u]; + istop = xnza[firstcol + u + 1]; + for (i = istart; i < istop; i++) + { col = nzasub[i]; + if ((col > firstcol) && (marker[col] != K)) + { marker[col] = K; + indices[knz++] = col; + } + } + } + + /* ---------------- + sort the indices + ---------------- */ + qsortUpInts(knz, indices, tmp); + } + + /* ---------------------- + free memory and return + ---------------------- */ + free(marker); free(tmp); free(first); + return(frontsub); +} + + +/***************************************************************************** +******************************************************************************/ +factorMtx_t* +newFactorMtx(int nelem) +{ factorMtx_t *L; + + mymalloc(L, 1, factorMtx_t); + mymalloc(L->nzl, nelem, FLOAT); + + L->nelem = nelem; + L->css = NULL; + L->frontsub = NULL; + L->perm = NULL; + + return(L); +} + + +/***************************************************************************** +******************************************************************************/ +void +freeFactorMtx(factorMtx_t *L) +{ + freeCSS(L->css); + freeFrontSubscripts(L->frontsub); + free(L->nzl); + free(L->perm); + free(L); +} + + +/***************************************************************************** +******************************************************************************/ +void +printFactorMtx(factorMtx_t *L) +{ css_t *css; + FLOAT *nzl; + int *xnzl, *nzlsub, *xnzlsub; + int neqs, nelem, nind, k, ksub, i, istart, istop; + + nelem = L->nelem; + nzl = L->nzl; + css = L->css; + + neqs = css->neqs; + nind = css->nind; + xnzl = css->xnzl; + nzlsub = css->nzlsub; + xnzlsub = css->xnzlsub; + + printf("#equations %d, #elements (+diag.) %d, #indices (+diag.) %d\n", + neqs, nelem, nind); + for (k = 0; k < neqs; k++) + { printf("--- column %d\n", k); + ksub = xnzlsub[k]; + istart = xnzl[k]; + istop = xnzl[k+1]; + for (i = istart; i < istop; i++) + printf(" row %5d, entry %e\n", nzlsub[ksub++], nzl[i]); + } +} + + +/***************************************************************************** +******************************************************************************/ +void +initFactorMtx(factorMtx_t *L, inputMtx_t *PAP) +{ elimtree_t *PTP; + frontsub_t *frontsub; + css_t *css; + int *ncolfactor; + FLOAT *nzl, *nza, *diag; + int *xnzl, *nzlsub, *xnzlsub, *xnza, *nzasub, *xnzf, *nzfsub; + int nelem, K, k, kstart, h, hstart, dis, i, istart, istop; + int firstcol, lastcol; + + nelem = L->nelem; + nzl = L->nzl; + css = L->css; + xnzl = css->xnzl; + nzlsub = css->nzlsub; + xnzlsub = css->xnzlsub; + + frontsub = L->frontsub; + PTP = frontsub->PTP; + ncolfactor = PTP->ncolfactor; + xnzf = frontsub->xnzf; + nzfsub = frontsub->nzfsub; + + diag = PAP->diag; + nza = PAP->nza; + xnza = PAP->xnza; + nzasub = PAP->nzasub; + + /* ------------------------------------ + set all numerical values of L to 0.0 + ------------------------------------ */ + for (i = 0; i < nelem; i++) + nzl[i] = 0.0; + + /* -------------------------------------------- + init. factor matrix with the nonzeros of PAP + -------------------------------------------- */ + for (K = firstPostorder(PTP); K != -1; K = nextPostorder(PTP, K)) + { firstcol = nzfsub[xnzf[K]]; + lastcol = firstcol + ncolfactor[K]; + for (k = firstcol; k < lastcol; k++) + { istart = xnza[k]; + istop = xnza[k+1]; + kstart = xnzl[k]; + hstart = xnzlsub[k]; + h = hstart; + for (i = istart; i < istop; i++) + { for (; nzlsub[h] != nzasub[i]; h++); + dis = h - hstart; + nzl[kstart+dis] = nza[i]; + } + nzl[kstart] = diag[k]; + } + } +} + + +/***************************************************************************** +******************************************************************************/ +void +initFactorMtxNEW(factorMtx_t *L, inputMtx_t *PAP) +{ elimtree_t *PTP; + frontsub_t *frontsub; + css_t *css; + int *ncolfactor; + FLOAT *nzl, *nza, *diag, *entriesL; + int *xnzl, *xnza, *nzasub, *xnzf, *nzfsub; + int *tmp, neqs, nelem, K, k, len, row, i, istart, istop; + int firstcol, lastcol; + + nelem = L->nelem; + nzl = L->nzl; + css = L->css; + xnzl = css->xnzl; + + frontsub = L->frontsub; + PTP = frontsub->PTP; + ncolfactor = PTP->ncolfactor; + xnzf = frontsub->xnzf; + nzfsub = frontsub->nzfsub; + + neqs = PAP->neqs; + diag = PAP->diag; + nza = PAP->nza; + xnza = PAP->xnza; + nzasub = PAP->nzasub; + + /* ------------------------ + allocate working storage + ------------------------ */ + mymalloc(tmp, neqs, int); + + /* ------------------------------------ + set all numerical values of L to 0.0 + ------------------------------------ */ + for (i = 0; i < nelem; i++) + nzl[i] = 0.0; + + /* -------------------------------------------- + init. factor matrix with the nonzeros of PAP + -------------------------------------------- */ + for (K = firstPostorder(PTP); K != -1; K = nextPostorder(PTP, K)) + { len = 0; + istart = xnzf[K]; + istop = xnzf[K+1]; + for (i = istart; i < istop; i++) + tmp[nzfsub[i]] = len++; + + firstcol = nzfsub[istart]; + lastcol = firstcol + ncolfactor[K]; + entriesL = nzl + xnzl[firstcol]; + for (k = firstcol; k < lastcol; k++) + { istart = xnza[k]; + istop = xnza[k+1]; + for (i = istart; i < istop; i++) + { row = nzasub[i]; + entriesL[tmp[row]] = nza[i]; + } + entriesL[tmp[k]] = diag[k]; + entriesL += --len; + } + } + + /* -------------------- + free working storage + -------------------- */ + free(tmp); +} + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/tree.c b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/tree.c new file mode 100644 index 000000000..959353d23 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/PORD/lib/tree.c @@ -0,0 +1,974 @@ +/***************************************************************************** +/ +/ SPACE SPArse Cholesky Elimination) Library: tree.c +/ +/ author J"urgen Schulze, University of Paderborn +/ created 09/15/99 +/ +/ This file contains functions dealing with elimination/front tree object +/ +****************************************************************************** + +Data type: struct elimtree + int nvtx; number of vertices in the tree + int nfronts; number of fronts in the tree + int root; root of the tree + int *ncolfactor; number of factor columns in front + int *ncolupdate; number of update columns for front + int *parent; parent in front tree + int *firstchild; first child in front tree + int *silbings; silbings in front tree + int *vtx2front; maps vertices to fronts +Comments: + o Structure used to hold the elimination/front tree; the tree is used to + guide the symbolical and numerical factorization; a "node" in the tree + can be a single vertex (in the context of an elimination tree) or a group + of vertices (as for a front tree) + o NOTE: Also the ordering can be expressed in terms of front trees; the + permutation vector perm is then obtained by a post order traversal + of the tree (see method permFromElimTree below) +Methods in lib/tree.c: +- T = newElimTree(int nvtx, int nfronts); + o Initial: root = -1 +- void freeElimTree(elimtree_t *T); +- void printElimTree(elimtree_t *T); +- int firstPostorder(elimtree_t *T); + o returns the first front in a post order traversal of T +- int firstPostorder2(elimtree_t *T, int root); + o returns the first front in a post order traversal of T[root] +- int nextPostorder(elimtree_t *T, int J); + o returns the front that follows J in a post order traversal of T +- int firstPreorder(elimtree_t *T); + o returns the first front in a pre order traversal of T +- int nextPreorder(elimtree_t *T, int J); + o returns the front that follows J in a pre order traversal of T +- T = setupElimTree(graph_t *G, int *perm, int *invp); + o constructs an elimination tree for G with permutation vectors perm, + invp; a union-find algorithm is used to set up the parent vector of T; + T->root and vectors T->firstchild, T->silbings are initialized by + calling initFchSilbRoot; vector T->ncolupdate is filled by calling + function setupCSSFromGraph (see below) +- void initFchSilbRoot(elimtree_t *T); + o uses vector T->parent to initialize T->firstchild, T->silbings, T->root +- void permFromElimTree(elimtree_t *T, int *perm); + o fills vectors perm, invp according to a post order traversal of T +- T2 = expandElimTree(elimtree_t *T, int *vtxmap, int nvtxorg) + o creates and returns an elimtree object for the uncompressed graph; + the map from original vertices to compressed vertices is found in vector + vtxmap; the number of original vertices (i.e. the length of vector + vtxmap) is nvtxorg + o NOTE: the function only expands vector T->vtx2front and sets + T2->nvtx to nvtxorg; all other vectors are copied from T to T2, i.e. + the number of fronts and the tree structure are the same in T and T2 +- PTP = permuteElimTree(elimtree_t *T, int *perm); + o in T: vtx2front[u] points to front containing vertex u + in PTP: vtx2front[k] points to front containing column k = perm[u] + o NOTE: the function only permutes vector T->vtx2front; all other vectors + are copied from T to PTP, i.e. the number of fronts and the tree + structure are the same in T and PTP +- T2 = fundamentalFronts(elimtree_t *T); + o compresses chains of fronts to a single front; once a map from original + fronts to compressed fronts is known, the compressed elimtree object T2 + can be created by calling compressElimTree (see below) +- T2 = mergeFronts(elimtree_t *T, int maxzeros); + o merges small subtrees together in one front; it returns an elimtree + object T2 where a front has either been merged with none or all of its + children; the maximal number of zero entries that is allowed to be + introduced when merging the fronts together is given by maxzeros +- T2 = compressElimTree(elimtree_t *T, int *frontmap, int cnfronts); + o creates a new front tree using frontmap; vector frontmap maps the + original fronts of T to a smaller set of fronts; cnfronts is number of + new fronts (i.e. the maximal entry in frontmap) +- int justifyFronts(elimtree_t *T); + o orders the children of a front so that the working storage in the + multifrontal algorithm is minimized; the function returns the amount + of extra working storage for the justified tree +- int nWorkspace(elimtree_t *T); + o returns the size of the working storage in the multifrontal algorithm + (measured in terms of FLOATS, for BYTES multiply with sizeof(FLOAT)) +- int nFactorIndices(elimtree_t *T); + o returns the number of indices taken by the factor matrix represented by T +- int nFactorEntries(elimtree_t *T); + o returns the number of entries taken by the factor matrix represented by T +- FLOAT nFactorOps(elimtree_t *T); + o returns the number of operations required to compute the factor matrix + represented by T +- void subtreeFactorOps(elimtree *T, FLOAT *ops) + o returns in ops[K] the number of operations required to factor the fronts + in tree T(K) (this includes front K) +- FLOAT nTriangularOps(elimtree_t *T); + o returns the number of operations required to solve the triangular systems + +******************************************************************************/ + +#include + + +/***************************************************************************** +******************************************************************************/ +elimtree_t* +newElimTree(int nvtx, int nfronts) +{ elimtree_t *T; + + mymalloc(T, 1, elimtree_t); + mymalloc(T->ncolfactor, nfronts, int); + mymalloc(T->ncolupdate, nfronts, int); + mymalloc(T->parent, nfronts, int); + mymalloc(T->firstchild, nfronts, int); + mymalloc(T->silbings, nfronts, int); + mymalloc(T->vtx2front, nvtx, int); + + T->nvtx = nvtx; + T->nfronts = nfronts; + T->root = -1; + + return(T); +} + + +/***************************************************************************** +******************************************************************************/ +void +freeElimTree(elimtree_t *T) +{ + free(T->ncolfactor); + free(T->ncolupdate); + free(T->parent); + free(T->firstchild); + free(T->silbings); + free(T->vtx2front); + free(T); +} + + +/***************************************************************************** +******************************************************************************/ +void +printElimTree(elimtree_t *T) +{ int *ncolfactor, *ncolupdate, *parent, *firstchild, *silbings, *vtx2front; + int *first, *link, nvtx, nfronts, root, J, K, u, count, child; + + nvtx = T->nvtx; + nfronts = T->nfronts; + root = T->root; + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + parent = T->parent; + firstchild = T->firstchild; + silbings = T->silbings; + vtx2front = T->vtx2front; + + printf("#fronts %d, root %d\n", nfronts, root); + + /* ----------------------------------------------------------- + store the vertices/columns of a front in a bucket structure + ----------------------------------------------------------- */ + mymalloc(first, nfronts, int); + mymalloc(link, nvtx, int); + + for (J = 0; J < nfronts; J++) + first[J] = -1; + for (u = nvtx-1; u >= 0; u--) + { J = vtx2front[u]; + link[u] = first[J]; + first[J] = u; + } + + /* ----------------------------------------------------------- + print fronts according to a postorder traversal of the tree + ----------------------------------------------------------- */ + for (K = firstPostorder(T); K != -1; K = nextPostorder(T, K)) + { printf("--- front %d, ncolfactor %d, ncolupdate %d, parent %d\n", + K, ncolfactor[K], ncolupdate[K], parent[K]); + count = 0; + printf("children:\n"); + for (child = firstchild[K]; child != -1; child = silbings[child]) + { printf("%5d", child); + if ((++count % 16) == 0) + printf("\n"); + } + if ((count % 16) != 0) + printf("\n"); + count = 0; + printf("vertices mapped to front:\n"); + for (u = first[K]; u != -1; u = link[u]) + { printf("%5d", u); + if ((++count % 16) == 0) + printf("\n"); + } + if ((count % 16) != 0) + printf("\n"); + } + + /* ---------------------- + free memory and return + ---------------------- */ + free(first); free(link); +} + + +/***************************************************************************** +******************************************************************************/ +int +firstPostorder(elimtree_t *T) +{ int *firstchild, J; + + firstchild = T->firstchild; + + if ((J = T->root) != -1) + while (firstchild[J] != -1) + J = firstchild[J]; + return(J); +} + + +/***************************************************************************** +******************************************************************************/ +int +firstPostorder2(elimtree_t *T, int root) +{ int *firstchild, J; + + firstchild = T->firstchild; + + if ((J = root) != -1) + while (firstchild[J] != -1) + J = firstchild[J]; + return(J); +} + + +/***************************************************************************** +******************************************************************************/ +int +nextPostorder(elimtree_t *T, int J) +{ int *parent, *firstchild, *silbings; + + parent = T->parent; + firstchild = T->firstchild; + silbings = T->silbings; + + if (silbings[J] != -1) + { J = silbings[J]; + while (firstchild[J] != -1) + J = firstchild[J]; + } + else J = parent[J]; + return(J); +} + + +/***************************************************************************** +******************************************************************************/ +int +firstPreorder(elimtree_t *T) +{ + return(T->root); +} + + +/***************************************************************************** +******************************************************************************/ +int +nextPreorder(elimtree_t *T, int J) +{ int *parent, *firstchild, *silbings; + + parent = T->parent; + firstchild = T->firstchild; + silbings = T->silbings; + + if (firstchild[J] != -1) + J = firstchild[J]; + else + { while ((silbings[J] == -1) && (parent[J] != -1)) + J = parent[J]; + J = silbings[J]; + } + return(J); +} + + +/***************************************************************************** +******************************************************************************/ +elimtree_t* +setupElimTree(graph_t *G, int *perm, int *invp) +{ elimtree_t *T; + css_t *css; + int *xadj, *adjncy, *vwght, *ncolfactor, *ncolupdate, *parent; + int *vtx2front, *realroot, *uf_father, *uf_size; + int *xnzl, *nzlsub, *xnzlsub; + int nvtx, front, front2, froot, f, r, u, v, i, istart, istop; + int prevlen, len, h, hsub; + + nvtx = G->nvtx; + xadj = G->xadj; + adjncy = G->adjncy; + vwght = G->vwght; + + /* -------------------------- + set up the working storage + -------------------------- */ + mymalloc(realroot, nvtx, int); + mymalloc(uf_father, nvtx, int); + mymalloc(uf_size, nvtx, int); + + /* ------------------------------------------------ + allocate storage for the elimination tree object + ------------------------------------------------ */ + T = newElimTree(nvtx, nvtx); + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + parent = T->parent; + vtx2front = T->vtx2front; + + /* ----------------------------- + set up the parent vector of T + ----------------------------- */ + for (front = 0; front < nvtx; front++) + { parent[front] = -1; + u = invp[front]; /* only vertex u belongs to this front */ + uf_father[front] = front; /* front forms a set in union-find structure */ + uf_size[front] = 1; /* the set consists of a single front */ + realroot[front] = front; + froot = front; + + /* run through the adjacency list of u */ + istart = xadj[u]; + istop = xadj[u+1]; + for (i = istart; i < istop; i++) + { v = adjncy[i]; + front2 = perm[v]; + if (front2 < front) + { r = front2; + + while (uf_father[r] != r) /* find root of front2 in union-find */ + r = uf_father[r]; + while (front2 != r) /* path compression */ + { f = front2; + front2 = uf_father[front2]; + uf_father[f] = r; + } + + f = realroot[r]; /* merge union-find sets */ + if ((parent[f] == -1) && (f != front)) + { parent[f] = front; + if (uf_size[froot] < uf_size[r]) + { uf_father[froot] = r; + uf_size[r] += uf_size[froot]; + froot = r; + } + else + { uf_father[r] = froot; + uf_size[froot] += uf_size[r]; + } + realroot[froot] = front; + } + } + } + } + + /* --------------------------------------------- + set the vectors T->firstchild and T->silbings + --------------------------------------------- */ + initFchSilbRoot(T); + + /* ---------------------------------------------------------- + set the vectors T->vtx2front, T->ncolfactor, T->ncolupdate + ---------------------------------------------------------- */ + css = setupCSSFromGraph(G, perm, invp); + xnzl = css->xnzl; + nzlsub = css->nzlsub; + xnzlsub = css->xnzlsub; + + prevlen = 0; + for (front = 0; front < nvtx; front++) + { u = invp[front]; + ncolfactor[front] = vwght[u]; + ncolupdate[front] = 0; + vtx2front[u] = front; + len = xnzl[front+1] - xnzl[front]; + if (prevlen - 1 == len) + ncolupdate[front] = ncolupdate[front-1] - vwght[u]; + else + { h = xnzlsub[front] + 1; + for (i = 1; i < len; i++) + { hsub = nzlsub[h++]; + v = invp[hsub]; + ncolupdate[front] += vwght[v]; + } + } + prevlen = len; + } + + /* ---------------------- + free memory and return + ---------------------- */ + free(css); + free(realroot); free(uf_father); free(uf_size); + return(T); +} + + +/***************************************************************************** +******************************************************************************/ +void +initFchSilbRoot(elimtree_t *T) +{ int *parent, *firstchild, *silbings, nfronts, J, pJ; + + nfronts = T->nfronts; + parent = T->parent; + firstchild = T->firstchild; + silbings = T->silbings; + + for (J = 0; J < nfronts; J++) + silbings[J] = firstchild[J] = -1; + + for (J = nfronts-1; J >= 0; J--) + if ((pJ = parent[J]) != -1) + { silbings[J] = firstchild[pJ]; + firstchild[pJ] = J; + } + else + { silbings[J] = T->root; + T->root = J; + } +} + + +/***************************************************************************** +******************************************************************************/ +void +permFromElimTree(elimtree_t *T, int *perm) +{ int *vtx2front, *first, *link; + int nvtx, nfronts, K, u, count; + + nvtx = T->nvtx; + nfronts = T->nfronts; + vtx2front = T->vtx2front; + + /* ----------------------------------------------------------- + store the vertices/columns of a front in a bucket structure + ----------------------------------------------------------- */ + mymalloc(first, nfronts, int); + mymalloc(link, nvtx, int); + + for (K = 0; K < nfronts; K++) + first[K] = -1; + for (u = nvtx-1; u >= 0; u--) + { K = vtx2front[u]; + link[u] = first[K]; + first[K] = u; + } + + /* ----------------------------------------------------- + postorder traversal of the elimination tree to obtain + the permutation vectors perm, invp + ----------------------------------------------------- */ + count = 0; + for (K = firstPostorder(T); K != -1; K = nextPostorder(T, K)) + for (u = first[K]; u != -1; u = link[u]) + { perm[u] = count; + count++; + } + + /* ---------------------- + free memory and return + ---------------------- */ + free(first); free(link); +} + + +/***************************************************************************** +******************************************************************************/ +elimtree_t* +permuteElimTree(elimtree_t *T, int *perm) +{ elimtree_t *PTP; + int nvtx, nfronts, J, u; + + nvtx = T->nvtx; + nfronts = T->nfronts; + + /* -------------------------------------------------------------- + allocate space for the new elimtree object and copy front data + the permuted tree has the same number of fronts/tree structure + -------------------------------------------------------------- */ + PTP = newElimTree(nvtx, nfronts); + PTP->root = T->root; + for (J = 0; J < nfronts; J++) + { PTP->ncolfactor[J] = T->ncolfactor[J]; + PTP->ncolupdate[J] = T->ncolupdate[J]; + PTP->parent[J] = T->parent[J]; + PTP->firstchild[J] = T->firstchild[J]; + PTP->silbings[J] = T->silbings[J]; + } + + /* --------------------------------------------------------------------- + set up the new vtx2front vector; the trees only differ in this vector + --------------------------------------------------------------------- */ + for (u = 0; u < nvtx; u++) + PTP->vtx2front[perm[u]] = T->vtx2front[u]; + + return(PTP); +} + + +/***************************************************************************** +******************************************************************************/ +elimtree_t* +expandElimTree(elimtree_t *T, int *vtxmap, int nvtxorg) +{ elimtree_t *T2; + int *vtx2front, *vtx2front2; + int nfronts, J, u; + + nfronts = T->nfronts; + + /* -------------------------------------------------------------- + allocate space for the new elimtree object and copy front data + the expanded tree has the same number of fronts/tree structure + -------------------------------------------------------------- */ + T2 = newElimTree(nvtxorg, nfronts); + T2->root = T->root; + for (J = 0; J < nfronts; J++) + { T2->ncolfactor[J] = T->ncolfactor[J]; + T2->ncolupdate[J] = T->ncolupdate[J]; + T2->parent[J] = T->parent[J]; + T2->firstchild[J] = T->firstchild[J]; + T2->silbings[J] = T->silbings[J]; + } + + /* --------------------------------------------------------------------- + set up the new vtx2front vector; the trees only differ in this vector + --------------------------------------------------------------------- */ + vtx2front = T->vtx2front; + vtx2front2 = T2->vtx2front; + for (u = 0; u < nvtxorg; u++) + vtx2front2[u] = vtx2front[vtxmap[u]]; + + return(T2); +} + + +/***************************************************************************** +******************************************************************************/ +elimtree_t* +fundamentalFronts(elimtree_t *T) +{ elimtree_t *T2; + int *ncolfactor, *ncolupdate, *parent, *firstchild, *silbings; + int *frontmap, nfronts, cnfronts, J, child; + + nfronts = T->nfronts; + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + parent = T->parent; + firstchild = T->firstchild; + silbings = T->silbings; + + /* ------------------------- + set up the working arrays + ------------------------- */ + mymalloc(frontmap, nfronts, int); + + /* ----------------------------- + search the fundamental fronts + ----------------------------- */ + cnfronts = 0; + J = T->root; + while (J != -1) + { while (firstchild[J] != -1) + J = firstchild[J]; + frontmap[J] = cnfronts++; + while ((silbings[J] == -1) && (parent[J] != -1)) + { J = parent[J]; + child = firstchild[J]; + if ((silbings[child] != -1) + || (ncolupdate[child] != ncolfactor[J] + ncolupdate[J])) + frontmap[J] = cnfronts++; + else + frontmap[J] = frontmap[child]; + } + J = silbings[J]; + } + + /* ------------------------------ + construct new elimination tree + ------------------------------ */ + T2 = compressElimTree(T, frontmap, cnfronts); + + /* ---------------------- + free memory and return + ---------------------- */ + free(frontmap); + return(T2); +} + + +/***************************************************************************** +******************************************************************************/ +elimtree_t* +mergeFronts(elimtree_t *T, int maxzeros) +{ elimtree_t *T2; + int *ncolfactor, *ncolupdate, *firstchild, *silbings; + int *frontmap, *newncolfactor, *nzeros, *rep; + int nfronts, cnfronts, K, ncolfrontK, J, Jall, cost; + + nfronts = T->nfronts; + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + firstchild = T->firstchild; + silbings = T->silbings; + + /* ------------------------- + set up the working arrays + ------------------------- */ + mymalloc(frontmap, nfronts, int); + mymalloc(newncolfactor, nfronts, int); + mymalloc(nzeros, nfronts, int); + mymalloc(rep, nfronts, int); + for (K = 0; K < nfronts; K++) + { newncolfactor[K] = ncolfactor[K]; + nzeros[K] = 0; + rep[K] = K; + } + + /* ----------------------------------------------------- + perform a postorder traversal of the elimination tree + ----------------------------------------------------- */ + for (K = firstPostorder(T); K != -1; K = nextPostorder(T, K)) + if (firstchild[K] != -1) + { ncolfrontK = newncolfactor[K] + ncolupdate[K]; + Jall = 0; + cost = 0; + for (J = firstchild[K]; J != -1; J = silbings[J]) + { Jall += newncolfactor[J]; + cost -= newncolfactor[J] * newncolfactor[J]; + cost += 2*newncolfactor[J] * (ncolfrontK - ncolupdate[J]); + cost += 2*nzeros[J]; + } + cost += Jall * Jall; + cost = cost / 2; + if (cost < maxzeros) + { for (J = firstchild[K]; J != -1; J = silbings[J]) + { rep[J] = K; + newncolfactor[K] += newncolfactor[J]; + } + nzeros[K] = cost; + } + } + + /* ---------------------------------- + construct frontmap from vector rep + ---------------------------------- */ + cnfronts = 0; + for (K = 0; K < nfronts; K++) + if (rep[K] == K) + frontmap[K] = cnfronts++; + else + { for (J = K; rep[J] != J; J = rep[J]); + rep[K] = J; + } + for (K = 0; K < nfronts; K++) + if ((J = rep[K]) != K) + frontmap[K] = frontmap[J]; + + /* ------------------------------ + construct new elimination tree + ------------------------------ */ + T2 = compressElimTree(T, frontmap, cnfronts); + + /* ---------------------- + free memory and return + ---------------------- */ + free(frontmap); free(newncolfactor); + free(nzeros); free(rep); + return(T2); +} + + +/***************************************************************************** +******************************************************************************/ +elimtree_t* +compressElimTree(elimtree_t *T, int *frontmap, int cnfronts) +{ elimtree_t *T2; + int *ncolfactor, *ncolupdate, *parent, *vtx2front; + int nvtx, nfronts, u, K, pK, newfront, pnewfront; + + nvtx = T->nvtx; + nfronts = T->nfronts; + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + parent = T->parent; + vtx2front = T->vtx2front; + + /* -------------------------------------------- + allocate memory for the new elimtree T2 + and init. ncolfactor, ncolupdate, and parent + -------------------------------------------- */ + T2 = newElimTree(nvtx, cnfronts); + for (K = 0; K < cnfronts; K++) + { T2->ncolfactor[K] = T2->ncolupdate[K] = 0; + T2->parent[K] = -1; + } + + /* -------------------------------------------------------------- + set the new vectors T2->ncolfactor, T2->ncolupdate, T2->parent + -------------------------------------------------------------- */ + for (K = 0; K < nfronts; K++) + { newfront = frontmap[K]; + T2->ncolfactor[newfront] += ncolfactor[K]; + if (((pK = parent[K]) != -1) + && ((pnewfront = frontmap[pK]) != newfront)) + { T2->parent[newfront] = pnewfront; + T2->ncolupdate[newfront] = ncolupdate[K]; + } + } + + /* --------------------------------------------------- + set the new vectors T2->firstchild and T2->silbings + --------------------------------------------------- */ + initFchSilbRoot(T2); + + /* ------------------------------------ + set the the new vector T2->vtx2front + ------------------------------------ */ + for (u = 0; u < nvtx; u++) + T2->vtx2front[u] = frontmap[vtx2front[u]]; + return(T2); +} + + +/***************************************************************************** +******************************************************************************/ +int +justifyFronts(elimtree_t *T) +{ int *ncolfactor, *ncolupdate, *firstchild, *silbings, *minWspace, *list; + int nfronts, K, ncolfrontK, frontsizeK, wspace, child, nxtchild; + int count, m, s, i; + + nfronts = T->nfronts; + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + firstchild = T->firstchild; + silbings = T->silbings; + + /* ------------------------- + set up the working arrays + ------------------------- */ + mymalloc(minWspace, nfronts, int); + mymalloc(list, nfronts, int); + + /* --------------------------------------------------------- + postorder traversal of the elimination tree to obtain the + optimal justification of the children of each front + ---------------------------------------------------------- */ + wspace = 0; + for (K = firstPostorder(T); K != -1; K = nextPostorder(T, K)) + { ncolfrontK = ncolfactor[K] + ncolupdate[K]; + frontsizeK = (ncolfrontK * (ncolfrontK + 1)) >> 1; + + if ((child = firstchild[K]) == -1) + minWspace[K] = frontsizeK; + else + { count = 0; + + /* sort children according to their minWspace value */ + while (child != -1) + { list[count++] = child; + child = silbings[child]; + } + insertUpIntsWithStaticIntKeys(count, list, minWspace); + firstchild[K] = -1; + for (i = 0; i < count; i++) + { child = list[i]; + silbings[child] = firstchild[K]; + firstchild[K] = child; + } + + /* compute minWspace[K] */ + child = firstchild[K]; + nxtchild = silbings[child]; + m = s = minWspace[child]; + while (nxtchild != -1) + { s = s - minWspace[child] + + ((ncolupdate[child] * (ncolupdate[child] + 1)) >> 1) + + minWspace[nxtchild]; + m = max(m, s); + child = nxtchild; + nxtchild = silbings[nxtchild]; + } + s = s - minWspace[child] + + ((ncolupdate[child] * (ncolupdate[child] + 1)) >> 1) + + frontsizeK; + minWspace[K] = max(m, s); + } + + wspace = max(wspace, minWspace[K]); + } + + /* ---------------------- + free memory and return + ---------------------- */ + free(minWspace); free(list); + return(wspace); +} + + +/***************************************************************************** +******************************************************************************/ +int +nWorkspace(elimtree_t *T) +{ int *ncolfactor, *ncolupdate, *firstchild, *silbings, *minWspace; + int nfronts, K, ncolfrontK, frontsizeK, wspace, child, nxtchild, m, s; + + nfronts = T->nfronts; + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + firstchild = T->firstchild; + silbings = T->silbings; + + /* ------------------------- + set up the working arrays + ------------------------- */ + mymalloc(minWspace, nfronts, int); + + /* ------------------------------------------- + postorder traversal of the elimination tree + ------------------------------------------- */ + wspace = 0; + for (K = firstPostorder(T); K != -1; K = nextPostorder(T, K)) + { ncolfrontK = ncolfactor[K] + ncolupdate[K]; + frontsizeK = (ncolfrontK * (ncolfrontK + 1)) >> 1; + + if ((child = firstchild[K]) == -1) + minWspace[K] = frontsizeK; + else + { child = firstchild[K]; + nxtchild = silbings[child]; + m = s = minWspace[child]; + while (nxtchild != -1) + { s = s - minWspace[child] + + ((ncolupdate[child] * (ncolupdate[child] + 1)) >> 1) + + minWspace[nxtchild]; + m = max(m, s); + child = nxtchild; + nxtchild = silbings[nxtchild]; + } + s = s - minWspace[child] + + ((ncolupdate[child] * (ncolupdate[child] + 1)) >> 1) + + frontsizeK; + minWspace[K] = max(m, s); + } + + wspace = max(wspace, minWspace[K]); + } + + /* ---------------------- + free memory and return + ---------------------- */ + free(minWspace); + return(wspace); +} + + +/***************************************************************************** +******************************************************************************/ +int +nFactorIndices(elimtree_t *T) +{ int *ncolfactor, *ncolupdate; + int nfronts, ind, K; + + nfronts = T->nfronts; + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + + ind = 0; + for (K = 0; K < nfronts; K++) + ind += (ncolfactor[K] + ncolupdate[K]); + return(ind); +} + + +/***************************************************************************** +******************************************************************************/ +int +nFactorEntries(elimtree_t *T) +{ int *ncolfactor, *ncolupdate; + int ent, tri, rec, K; + + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + + ent = 0; + for (K = firstPostorder(T); K != -1; K = nextPostorder(T, K)) + { tri = ncolfactor[K]; + rec = ncolupdate[K]; + ent += (tri * (tri+1)) / 2; + ent += (tri * rec); + } + return(ent); +} + + +/***************************************************************************** +******************************************************************************/ +FLOAT +nFactorOps(elimtree_t *T) +{ int *ncolfactor, *ncolupdate; + FLOAT ops, tri, rec; + int K; + + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + + ops = 0.0; + for (K = firstPostorder(T); K != -1; K = nextPostorder(T, K)) + { tri = ncolfactor[K]; + rec = ncolupdate[K]; + ops += (tri*tri*tri) / 3.0 + (tri*tri) / 2.0 - (5*tri) / 6.0; + ops += (tri*tri*rec) + (rec*(rec+1)*tri); + } + return(ops); +} + + +/***************************************************************************** +******************************************************************************/ +void +subtreeFactorOps(elimtree_t *T, FLOAT *ops) +{ int *ncolfactor, *ncolupdate; + FLOAT tri, rec; + int J, K; + + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + + for (K = firstPostorder(T); K != -1; K = nextPostorder(T, K)) + { tri = ncolfactor[K]; + rec = ncolupdate[K]; + ops[K] = (tri*tri*tri) / 3.0 + (tri*tri) / 2.0 - (5*tri) / 6.0; + ops[K] += (tri*tri*rec) + (rec*(rec+1)*tri); + for (J = T->firstchild[K]; J != -1; J = T->silbings[J]) + ops[K] += ops[J]; + } +} + + +/***************************************************************************** +******************************************************************************/ +FLOAT +nTriangularOps(elimtree_t *T) +{ int *ncolfactor, *ncolupdate; + FLOAT ops, tri, rec; + int K; + + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + + ops = 0.0; + for (K = firstPostorder(T); K != -1; K = nextPostorder(T, K)) + { tri = ncolfactor[K]; + rec = ncolupdate[K]; + ops += (tri*tri) + 2.0*tri*rec; /* forward ops */ + ops += (tri*tri) + 2.0*tri*rec; /* backward ops */ + } + return(ops); +} + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/README b/Ipopt-3.13.4/ThirdParty/MUMPS/README new file mode 100644 index 000000000..ac6ef0d08 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/README @@ -0,0 +1,290 @@ +=========================================== +MUMPS version 4.10.0 +=========================================== + +(Quick note on upgrading from a previous version: please + check if Makefiles have changed (see old and new Makefiles + in Make.inc/ and be aware that all codes that use MUMPS + include files must be recompiled). + + +MUMPS 4.10.0 solves a sparse system of linear equations A x = b +using Gaussian elimination. Please read this README file and +the documentation (in ./doc/) for a complete list of +functionalities. Documentation and publications related to +MUMPS can also be found at http://mumps.enseeiht.fr/ +or at http://graal.ens-lyon.fr/MUMPS + +For installation problems, bug reports, and to report your +experience/feedback with the package, please subscribe the +MUMPS Users's mailing list. + + + This version of MUMPS is provided to you free of charge. It is public + domain, based on public domain software developed during the Esprit IV + European project PARASOL (1996-1999). Since this first public domain + version in 1999, research and developments have been supported by the + following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + INRIA, and University of Bordeaux. + + The MUMPS team at the moment of releasing this version includes + Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + Ucar and Clement Weisbecker. + + We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + have been contributing to this project. + + Up-to-date copies of the MUMPS package can be obtained + from the Web pages: + http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + + + THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + + + User documentation of any code that uses this software can + include this complete notice. You can acknowledge (using + references [1] and [2]) the contribution of this package + in any scientific publication dependent upon the use of the + package. You shall use reasonable endeavours to notify + the authors of the package of this publication. + + [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + A fully asynchronous multifrontal solver using distributed dynamic + scheduling, SIAM Journal of Matrix Analysis and Applications, + Vol 23, No 1, pp 15-41 (2001). + + [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + S. Pralet, Hybrid scheduling for the parallel solution of linear + systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + + + +Contents of the distribution : +---------------------------- + +ChangeLog LICENSE README VERSION Makefile Make.inc/ +doc/ src/ lib/ include/ libseq/ examples/ +PORD/ MATLAB/ SCILAB/ + +doc contains the users' guide in postscript and pdf formats. + +src contains the source files (for all arithmetics 's','d','c' or 'z') + necessary to generate the MUMPS library. + +lib is the place where the MUMPS libraries libxmumps.a + (x='s','d','c' or 'z') are generated. + +include contains xmumps_struc.h, xmumps_root.h and xmumps_c.h (where x is one + of 'd','c','s','z' depending on the arithmetic desired), + mumps_c_types.h and mumps_compat.h. The first two files must be + available at compile time in order to use MUMPS from external FORTRAN + programs. The three others for C programs. + +libseq contains a sequential MPI library used by the purely sequential + version of MUMPS. + +examples contains illustrative test programs showing how MUMPS can be used. + +PORD contains the PORD package (not part of MUMPS) from University + of Paderborn. See PORD/README for more info. + +MATLAB contains a MATLAB interface to the sequential version of MUMPS + +SCILAB contains a SCILAB interface to the sequential version of MUMPS + + +Pre-requisites +-------------- + +If you only want to use the sequential version, you need to install: +-> BLAS library + +If you want to use the parallel version, you need to install: +-> MPI +-> BLAS library +-> BLACS library +-> ScaLAPACK library + +For performance (time and memory issues) we also strongly recommend to install: +-> SCOTCH and/or METIS for the sequential version +-> PT-SCOTCH and/or ParMetis for the parallel version + + +Installation +------------ + +The following steps can be applied. + +% tar zxvf MUMPS_4.10.0.tar.gz +% cd MUMPS_4.10.0 + +You then need to build a file called Makefile.inc corresponding +to your achitecture. Various examples are available in the +directory Make.inc : + + Makefile.SGI.SEQ : default Makefile.inc for an Origin, sequential version. + Makefile.SGI.PAR : default Makefile.inc for an Origin, parallel version. + Makefile.SUN.SEQ : default Makefile.inc for a SUN, sequential version. + Makefile.SUN.PAR : default Makefile.inc for a SUN, parallel version. + Makefile.SP.SEQ : default for SP (32 bits), sequential version. + Makefile.SP.PAR : default for SP (32 bits), parallel version. + Makefile.SP64.SEQ : default for SP (64 bits), sequential version. + Makefile.SP64.PAR : default for SP (64 bits), parallel version. + Makefile.INTEL.SEQ : default for PC (linux, intel compiler, lam), sequential. + Makefile.INTEL.PAR : default for PC (linux, intel compiler, lam), parallel. + Makefile.ALPHA_linux.SEQ : default for ALPHA linux (compiler:fort), sequential. + Makefile.ALPHA_linux.PAR : default for ALPHA linux (compiler:fort), parallel. + Makefile.ALPHA_true64.SEQ : default for ALPHA true 64 (compiler:f90), sequential. + Makefile.ALPHA_true64.PAR : default for ALPHA true 64 (compiler:f90), parallel. + Makefile.WIN.MS-Intel.SEQ : default for Windows with Intel compiler, sequential, with GNU make. + Makefile.WIN.MS-G95.SEQ : default for Windows with g95 compiler, sequential, with GNU make. + + +For a parallel version of MUMPS on a 64-bit IBM SP machine, copy +Make.inc/Makefile.SP64.PAR into Makefile.inc + +% cp Make.inc/Makefile.SP64.PAR ./Makefile.inc + +In most cases, Makefile.inc should be adapted to fit with your +architecture, libraries and compiler (see comments in the +Makefile.inc.generic or Makefile.inc.generic.SEQ for details). The +variables LIBBLAS (BLAS library), SCALAP (ScaLAPACK library), INCPAR +(include files for MPI), LIBPAR (library files for MPI) are concerned. + +By default, only the double precision version of MUMPS will be +installed. make will build the version for a specific +arithmetic, where can be one of 'd','c','s','z'. +"make all" will compile versions of MUMPS for all 4 arithmetics. + +After issuing the command +% make +, ./lib will contain the mumps libraries libxmumps.a (with x = 'd', 'c', +'s' or 'z') and libmumps_common.a. Both must be included at link time in +an external program. + +A simple Fortran test driver in ./examples (see ./examples/README) will +also be compiled as well as an example of using MUMPS from a C main +program. + + +Preprocessing constants (Makefile.inc) +-------------------------------------- + +-DMAIN_COMP: +Note that some Fortran runtime libraries define the "main" symbol. +This can cause problems when using MUMPS from C if Fortran is used +for the link phase. One approach is to use a specific flag (such +as -nofor_main for Intel ifort compiler). Another approach is to +use the C linker (gcc, etc...) and add manually the Fortran runtime +libraries (that should not define the symbol "main"). Finally, if +the previous approaches do not work, compile the C example with +"-DMAIN_COMP". This might not work well with some MPI implementations +(see options in Makefiles and FAQ +at http://graal.ens-lyon.fr/MUMPS and +http://mumps.enseeiht.fr/). + +-DAdd_ , -DAdd__ and -DUPPER: +These options are used for defining the calling +convention from C to Fortran or Fortran to C. + +-DALLOW_NON_INIT: +This option can be used to speed up the code for +symmetric matrices by allowing non initialization of +data area that will modified but are not significant +for the computation. + +Some other preprocessing options correspond to default +architectures and are defined in specific Makefiles. + + +Sequential version +------------------ + +You can use the parallel MPI version of MUMPS on a single +processor. If you only plan to use MUMPS on a uniprocessor +machine, and do not want to install parallel libraries +such as MPI, ScaLAPACK, etc... then it might be more convenient +to use one of the Makefile..SEQ to build a sequential +version of MUMPS instead of a parallel one. + +For that, a dummy MPI library (available in ./libseq) defining +all symbols related to parallel libraries is used at the link +phase. + +Note that you should use 'make clean' before building the +MUMPS sequential library if you had previously built a parallel +version. And vice versa. + + +Compiling and linking your program with MUMPS +--------------------------------------------- + +Basically, ./lib/libxmumps.a and ./lib/libmumps_common.a constitute the +MUMPS library and ./include/*.h are the include files. Also, some BLAS, +ScaLAPACK, BLACS, and MPI are needed. (Except for the sequential version +where ./libseq/libmpiseq.a is used.) Please refer to the Makefile +available in the directory ./examples for an example of how to link your +program with MUMPS. We advise to use the same compiler alignment options +for compiling your program as were used for compiling MUMPS. Otherwise +some derived datatypes may not match. + + +Platform dependencies +--------------------- + +Versions of MUMPS have been tested on CRAY, IBM, SGI, COMPAQ, and Linux +systems. We could potentially generate versions for any other platform +with Fortran 90, MPI, BLACS, and ScaLAPACK installed, but the code has +only been tested on the above-mentionned platforms. + +* IBM SP + ------ +On SP machines, use of PESSL, BLACS, MPI and ESSL is made. + +Note that MUMPS requires PESSL release 2 or greater. The version +of MUMPS based on PESSL release 1.1 (that used descriptors of +size 8) is no longer available. If PESSL release 2 is not +available on your system, the public domain version of +ScaLAPACK should be used instead. PESSL usually does not +include single precision versions of the ScaLAPACK routines +required by MUMPS. If the single precision or single +complex versions of MUMPS are needed, then ScaLAPACK should +then be used in place of PESSL. + +* INTEL Compilers + --------------- +Some users have reported problems (wrong results) with +Intel compilers version 10.x when using default compiler +optimization (-O). + +* COMPAQ + ------ +The option -nopipeline is required, otherwise, the version of the +compiler we have used performs software pipeline over iterations of +loops with potential dependencies. Also the option -O3 should not be +used on xmumps_static_mapping.F as it seems to create erroneous code. + +* LAM + --- +lam version 6.5.6 or later is required for the double complex +version of MUMPS to work correctly. + +* MPICH + ----- +MUMPS has been tested and works correctly with various versions of MPICH. +The double complex version does not work correctly with MPICH2 v 1.0.3, +due to truncated messages when using double complex types. + +* CRAY + ---- +On the CRAY, we recommend to link with the standard BLACS +library from netlib, based on MPI. We observed problems +(deadlock) when using the CRAY BLACS in host-node mode or +when MUMPS is used on a subcommunicator of MPI_COMM_WORLD +of more than 1 processor. diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_dmumps.html b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_dmumps.html new file mode 100644 index 000000000..78554aef8 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_dmumps.html @@ -0,0 +1,269 @@ + + + + dmumps + + +
MUMPS interface function
+

+ dmumps - call to MUMPS

+

+ Calling Sequence +

+
+
+ [id]=dmumps (id [,mat]) +
+
+

+ Input Parameters +

+
    +
  • + + mat + +: sparse matrix which has to be provided as the second argument of + dmumps if id.JOB is strictly larger than 0. +
    • +
  • + + id.SYM + +: controls the matrix type (symmetric positive + definite, symmetric indefinite or unsymmetric) and it has do be + initialized by the user before the initialization phase of MUMPS + (see id.JOB). Its value is set to 0 after the call of initmumps. +
    • +
  • + + id.JOB + +: defines the action that will be realized by + MUMPS: initialize, analyze and/or factorize and/or solve and + release MUMPS internal C/Fortran data. It has to be set by the user before + any call to MUMPS (except after a call to initmumps, which sets + its value to -1). +
    • +
  • + + id.ICNTL and id.CNTL + +: define control parameters that can be + set after the initialization call (id.JOB = -1). See Section ``Control parameters'' +of the MUMPS user's guide + for more details. + If the user does not modify an entry in id.ICNTL then MUMPS + uses the default parameter. For example, if the user wants to + use the AMD ordering, he/she should set id.ICNTL(7) = 0. + Note that the following + parameters are inhibited because they are automatically set + within the interface: id.ICNTL(19) which controls the Schur + complement option and id.ICNTL(20) which controls the + format of the right-hand side. + Note that parameters id.ICNTL(1:4) may not work properly + depending on your compiler and your environment. In case of + problem, we recommand to swith printing off by setting + id.ICNL(1:4)=-1. +
    • +
  • + + id.PERM_IN + +: corresponds to the given ordering option + (see Section ``Input and output parameters'' +of the MUMPS user's guide +for more details). Note that this permutation is only accessed if +the parameter id.ICNTL(7) is set to 1. +
    • +
  • + + id.COLSCA and id.ROWSCA + +: are optional scaling arrays (see Section +``Input and output parameters'' +of the MUMPS user's guide +for more details) +
    • +
  • + + id.RHS + +: defines the right-hand side. The parameter id.ICNTL(20) related to its format (sparse or dense) is automatically set within the interface. Note that id.RHS is not modified (as in MUMPS), the solution is returned in id.SOL. +
    • +
  • + + id.VAR_SCHUR + +: corresponds to the list of variables + that appear in the Schur complement matrix (see Section +``Input and output parameters'' +of the MUMPS user's guide +for more details). +
    • +
  • + + id.REDRHS + +(input parameter only if id.VAR_SCHUR was provided during the factorization and +if ICNTL(26)=2 on entry to the solve phase): partial +solution on the variables corresponding to the Schur complement. It is provided +by the user and normally results from both the Schur complement and the reduced right-hand +side that were returned by MUMPS in a previous call. When ICNTL(26)=2, MUMPS uses this information +to build the solution id.SOL on the complete problem. +See Section ``Schur complement'' +of the MUMPS user's guide +for more details. +
    • +
+

+ Output Parameters +

+
    +
  • + + id.SCHUR + +: if id.VAR_SCHUR is provided of size SIZE_SCHUR, then +id.SCHUR corresponds to a dense array of size + (SIZE_SCHUR,SIZE_SCHUR) that holds the Schur + complement matrix (see Section +``Input and output parameters'' +of the MUMPS user's guide +for more details). The user does not have to initialize it. +
    • +
  • + + id.REDRHS + +(output parameter only if ICNTL(26)=1 and id.VAR_SCHUR was defined): Reduced right-hand side (or +condensed right-hand side on the variables associated to the Schur complement). It +is computed by MUMPS during the solve stage if ICNTL(26)=1. It can then be used +outside MUMPS, together with the Schur complement, to build a solution on the interface. +See Section ``Schur complement'' +of the MUMPS user's guide +for more details. +
    • +
  • + + id.INFOG and id.RINFOG + +: information parameters + (see Section ``Information parameters'' +of the MUMPS user's guide +). +
    • +
  • + + id.SYM_PERM + +: corresponds to a symmetric permutation + of the variables + (see discussion regarding ICNTL(7) in Section +``Control parameters'' +of the MUMPS user's guide +). This permutation is computed during the analysis and is +followed by the numerical factorization except when numerical +pivoting occurs. +
    • +
  • + + id.UNS_PERM + +: column permutation (if any) on exit from the analysis + phase of MUMPS + (see discussion regarding ICNTL(6) in Section +``Control parameters'' +of the MUMPS user's guide +). +
    • +
  • + + id.SOL + +: dense vector or matrix containing the solution after MUMPS + solution phase. +
    • +
+

+ Internal Parameters +

+
+
+
  • + + + + id.INST: (MUMPS reserved component) MUMPS internal parameter. +
    • +
  • + + + + id.TYPE: (MUMPS reserved component) defines the arithmetic + (complex or double precision). +
    • +
    +
    +

    + Description +

    +

    + The function dmumps solves systems of + linear equations of the form Ax = b where A is square sparse matrix and b + is a dense or sparse vector or matrix. The solver MUMPS is used and + we refer the user to the MUMPS User's Guide for full details. + Before the first call to dmumps, a call to initmumps must have been done: +

    + 
    +     [id]=initmumps();
+
    +

    + Examples +

    + 
    +// this is a small linear system
+// whose solution is [1;2;3;4;5]
+A = sparse( [ 2  3  4  0  0;
+              3  0  -3  0  6; 
+              0 -1 1  2  0; 
+              0  0  2  0  0; 
+              0  4  0  0  1] );
+b = [20 ; 24; 9; 6; 13];
+
+// initialization of the MUMPS structure (here job=-1) 
+id=initmumps();
+[id]=dmumps(id);
+id.RHS=b;
+
+// call to MUMPS for the resolution
+id.JOB=6;
+[id]=dmumps(id,A);
+x=id.SOL
+norm(A*x-b)
+
+// Destruction of the MUMPS instance
+id.JOB=-2;
+[id]=dmumps(id);
+
+   
+   See also the examples provided in the directory "examples" that
+   comes with the distribution of this interface.
+
    +

    + See Also +

    +

    initmumps,  zmumps,  

    +

    + References +

    +
    +

    + http://graal.ens-lyon.fr/MUMPS/ +

    +

    + http://www.enseeiht.fr/apo/MUMPS/ +

    +
    + + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_dmumps.xml b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_dmumps.xml new file mode 100644 index 000000000..08e803aef --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_dmumps.xml @@ -0,0 +1,255 @@ + + + + + eng + dmumps + MUMPS interface function + + call to MUMPS + + [id]=dmumps (id [,mat]) + + + + + mat + +: sparse matrix which has to be provided as the second argument of + dmumps if id.JOB is strictly larger than 0. + + + + id.SYM + +: controls the matrix type (symmetric positive + definite, symmetric indefinite or unsymmetric) and it has do be + initialized by the user before the initialization phase of MUMPS + (see id.JOB). Its value is set to 0 after the call of initmumps. + + + + id.JOB + +: defines the action that will be realized by + MUMPS: initialize, analyze and/or factorize and/or solve and + release MUMPS internal C/Fortran data. It has to be set by the user before + any call to MUMPS (except after a call to initmumps, which sets + its value to -1). + + + + id.ICNTL and id.CNTL + +: define control parameters that can be + set after the initialization call (id.JOB = -1). See Section ``Control parameters'' +of the MUMPS user's guide + for more details. + If the user does not modify an entry in id.ICNTL then MUMPS + uses the default parameter. For example, if the user wants to + use the AMD ordering, he/she should set id.ICNTL(7) = 0. + Note that the following + parameters are inhibited because they are automatically set + within the interface: id.ICNTL(19) which controls the Schur + complement option and id.ICNTL(20) which controls the + format of the right-hand side. + Note that parameters id.ICNTL(1:4) may not work properly + depending on your compiler and your environment. In case of + problem, we recommand to swith printing off by setting + id.ICNL(1:4)=-1. + + + + id.PERM_IN + +: corresponds to the given ordering option + (see Section ``Input and output parameters'' +of the MUMPS user's guide +for more details). Note that this permutation is only accessed if +the parameter id.ICNTL(7) is set to 1. + + + + id.COLSCA and id.ROWSCA + +: are optional scaling arrays (see Section +``Input and output parameters'' +of the MUMPS user's guide +for more details) + + + + id.RHS + +: defines the right-hand side. The parameter id.ICNTL(20) related to its format (sparse or dense) is automatically set within the interface. Note that id.RHS is not modified (as in MUMPS), the solution is returned in id.SOL. + + + + id.VAR_SCHUR + +: corresponds to the list of variables + that appear in the Schur complement matrix (see Section +``Input and output parameters'' +of the MUMPS user's guide +for more details). + + + + id.REDRHS + +(input parameter only if id.VAR_SCHUR was provided during the factorization and +if ICNTL(26)=2 on entry to the solve phase): partial +solution on the variables corresponding to the Schur complement. It is provided +by the user and normally results from both the Schur complement and the reduced right-hand +side that were returned by MUMPS in a previous call. When ICNTL(26)=2, MUMPS uses this information +to build the solution id.SOL on the complete problem. +See Section ``Schur complement'' +of the MUMPS user's guide +for more details. + + + + + + + + id.SCHUR + +: if id.VAR_SCHUR is provided of size SIZE_SCHUR, then +id.SCHUR corresponds to a dense array of size + (SIZE_SCHUR,SIZE_SCHUR) that holds the Schur + complement matrix (see Section +``Input and output parameters'' +of the MUMPS user's guide +for more details). The user does not have to initialize it. + + + + id.REDRHS + +(output parameter only if ICNTL(26)=1 and id.VAR_SCHUR was defined): Reduced right-hand side (or +condensed right-hand side on the variables associated to the Schur complement). It +is computed by MUMPS during the solve stage if ICNTL(26)=1. It can then be used +outside MUMPS, together with the Schur complement, to build a solution on the interface. +See Section ``Schur complement'' +of the MUMPS user's guide +for more details. + + + + id.INFOG and id.RINFOG + +: information parameters + (see Section ``Information parameters'' +of the MUMPS user's guide +). + + + + id.SYM_PERM + +: corresponds to a symmetric permutation + of the variables + (see discussion regarding ICNTL(7) in Section +``Control parameters'' +of the MUMPS user's guide +). This permutation is computed during the analysis and is +followed by the numerical factorization except when numerical +pivoting occurs. + + + + id.UNS_PERM + +: column permutation (if any) on exit from the analysis + phase of MUMPS + (see discussion regarding ICNTL(6) in Section +``Control parameters'' +of the MUMPS user's guide +). + + + + id.SOL + +: dense vector or matrix containing the solution after MUMPS + solution phase. + + + + + +
    + + + id.INST: (MUMPS reserved component) MUMPS internal parameter. + + + id.TYPE: (MUMPS reserved component) defines the arithmetic + (complex or double precision). + + +
    + + +

    + The function dmumps solves systems of + linear equations of the form Ax = b where A is square sparse matrix and b + is a dense or sparse vector or matrix. The solver MUMPS is used and + we refer the user to the MUMPS User's Guide for full details. + Before the first call to dmumps, a call to initmumps must have been done: +

    + +     + + See also the examples provided in the directory "examples" that + comes with the distribution of this interface. + + + + + initmumps + zmumps + + +
    +

    + http://graal.ens-lyon.fr/MUMPS/ +

    +

    + http://www.enseeiht.fr/apo/MUMPS/ +

    +
    + +     diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_initmumps.html b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_initmumps.html new file mode 100644 index 000000000..36ddd1aba --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_initmumps.html @@ -0,0 +1,49 @@ + + + + initmumps + + +
    Mumps interface's function
    +

    + initmumps - Initialisation of the mumps structure

    +

    + Calling Sequence +

    +
    +
    + [id]=initmumps() +
    +
    +

    + Parameters +

    +
      +
    • + + id + + : a structure (mlist) +
      • +
    +

    + Description +

    +

    + This function initializes a MUMPS structure to its default components, so that the structure can then be used in subsequent calls to dmumps or zmumps +

    +

    + See Also +

    +

    dmumps,  zmumps,  

    +

    + References +

    +
    +

    + http://graal.ens-lyon.fr/MUMPS/ + http://www.enseeiht.fr/apo/MUMPS/ +

    +
    + + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_initmumps.xml b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_initmumps.xml new file mode 100644 index 000000000..5f814521c --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_initmumps.xml @@ -0,0 +1,43 @@ + + + + eng + initmumps + Mumps interface's function + + Initialisation of the mumps structure + + + [id]=initmumps() + + + + + + id + + : a structure (mlist) + + + + + + +

    + This function initializes a MUMPS structure to its default components, so that the structure can then be used in subsequent calls to dmumps or zmumps +

    +     + + + dmumps + zmumps + + +
    +

    + http://graal.ens-lyon.fr/MUMPS/ + http://www.enseeiht.fr/apo/MUMPS/ +

    +
    + +     diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_zmumps.html b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_zmumps.html new file mode 100644 index 000000000..f7ead6f29 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_zmumps.html @@ -0,0 +1,269 @@ + + + + zmumps + + +
    MUMPS interface function
    +

    + zmumps - call to MUMPS

    +

    + Calling Sequence +

    +
    +
    + [id]=zmumps (id [,mat]) +
    +
    +

    + Input Parameters +

    +
      +
    • + + mat + +: sparse matrix which has to be provided as the second argument of + zmumps if id.JOB is strictly larger than 0. +
      • +
    • + + id.SYM + +: controls the matrix type (symmetric positive + definite, symmetric indefinite or unsymmetric) and it has do be + initialized by the user before the initialization phase of MUMPS + (see id.JOB). Its value is set to 0 after the call of initmumps. +
      • +
    • + + id.JOB + +: defines the action that will be realized by + MUMPS: initialize, analyze and/or factorize and/or solve and + release MUMPS internal C/Fortran data. It has to be set by the user before + any call to MUMPS (except after a call to initmumps, which sets + its value to -1). +
      • +
    • + + id.ICNTL and id.CNTL + +: define control parameters that can be + set after the initialization call (id.JOB = -1). See Section ``Control parameters'' +of the MUMPS user's guide + for more details. + If the user does not modify an entry in id.ICNTL then MUMPS + uses the default parameter. For example, if the user wants to + use the AMD ordering, he/she should set id.ICNTL(7) = 0. + Note that the following + parameters are inhibited because they are automatically set + within the interface: id.ICNTL(19) which controls the Schur + complement option and id.ICNTL(20) which controls the + format of the right-hand side. + Note that parameters id.ICNTL(1:4) may not work properly + depending on your compiler and your environment. In case of + problem, we recommand to swith printing off by setting + id.ICNL(1:4)=-1. +
      • +
    • + + id.PERM_IN + +: corresponds to the given ordering option + (see Section ``Input and output parameters'' +of the MUMPS user's guide +for more details). Note that this permutation is only accessed if +the parameter id.ICNTL(7) is set to 1. +
      • +
    • + + id.COLSCA and id.ROWSCA + +: are optional scaling arrays (see Section +``Input and output parameters'' +of the MUMPS user's guide +for more details) +
      • +
    • + + id.RHS + +: defines the right-hand side. The parameter id.ICNTL(20) related to its format (sparse or dense) is automatically set within the interface. Note that id.RHS is not modified (as in MUMPS), the solution is returned in id.SOL. +
      • +
    • + + id.VAR_SCHUR + +: corresponds to the list of variables + that appear in the Schur complement matrix (see Section +``Input and output parameters'' +of the MUMPS user's guide +for more details). +
      • +
    • + + id.REDRHS + +(input parameter only if id.VAR_SCHUR was provided during the factorization and +if ICNTL(26)=2 on entry to the solve phase): partial +solution on the variables corresponding to the Schur complement. It is provided +by the user and normally results from both the Schur complement and the reduced right-hand +side that were returned by MUMPS in a previous call. When ICNTL(26)=2, MUMPS uses this information +to build the solution id.SOL on the complete problem. +See Section ``Schur complement'' +of the MUMPS user's guide +for more details. +
      • +
    +

    + Output Parameters +

    +
      +
    • + + id.SCHUR + +: if id.VAR_SCHUR is provided of size SIZE_SCHUR, then +id.SCHUR corresponds to a dense array of size + (SIZE_SCHUR,SIZE_SCHUR) that holds the Schur + complement matrix (see Section +``Input and output parameters'' +of the MUMPS user's guide +for more details). The user does not have to initialize it. +
      • +
    • + + id.REDRHS + +(output parameter only if ICNTL(26)=1 and id.VAR_SCHUR was defined): Reduced right-hand side (or +condensed right-hand side on the variables associated to the Schur complement). It +is computed by MUMPS during the solve stage if ICNTL(26)=1. It can then be used +outside MUMPS, together with the Schur complement, to build a solution on the interface. +See Section ``Schur complement'' +of the MUMPS user's guide +for more details. +
      • +
    • + + id.INFOG and id.RINFOG + +: information parameters + (see Section ``Information parameters'' +of the MUMPS user's guide +). +
      • +
    • + + id.SYM_PERM + +: corresponds to a symmetric permutation + of the variables + (see discussion regarding ICNTL(7) in Section +``Control parameters'' +of the MUMPS user's guide +). This permutation is computed during the analysis and is +followed by the numerical factorization except when numerical +pivoting occurs. +
      • +
    • + + id.UNS_PERM + +: column permutation (if any) on exit from the analysis + phase of MUMPS + (see discussion regarding ICNTL(6) in Section +``Control parameters'' +of the MUMPS user's guide +). +
      • +
    • + + id.SOL + +: dense vector or matrix containing the solution after MUMPS + solution phase. +
      • +
    +

    + Internal Parameters +

    +
    +
    +
  • + + + + id.INST: (MUMPS reserved component) MUMPS internal parameter. +
    • +
  • + + + + id.TYPE: (MUMPS reserved component) defines the arithmetic + (complex or double precision). +
    • +
    +
    +

    + Description +

    +

    + The function zmumps solves systems of + linear equations of the form Ax = b where A is square sparse matrix and b + is a dense or sparse vector or matrix. The solver MUMPS is used and + we refer the user to the MUMPS User's Guide for full details. + Before the first call to zmumps, a call to initmumps must have been done: +

    + 
    +     [id]=initmumps();
+
    +

    + Examples +

    + 
    +// this is a small linear system
+// whose solution is [1;2;3;4;5]
+A = sparse( [ 2  3  4  0  0;
+              3  0  -3  0  6; 
+              0 -1 1  2  0; 
+              0  0  2  0  0; 
+              0  4  0  0  1] );
+b = [20 ; 24; 9; 6; 13];
+
+// initialization of the MUMPS structure (here job=-1) 
+id=initmumps();
+[id]=zmumps(id);
+id.RHS=b;
+
+// call to MUMPS for the resolution
+id.JOB=6;
+[id]=zmumps(id,A);
+x=id.SOL
+norm(A*x-b)
+
+// Destruction of the MUMPS instance
+id.JOB=-2;
+[id]=zmumps(id);
+
+   
+   See also the examples provided in the directory "examples" that
+   comes with the distribution of this interface.
+
    +

    + See Also +

    +

    initmumps,  dmumps,  

    +

    + References +

    +
    +

    + http://graal.ens-lyon.fr/MUMPS/ +

    +

    + http://www.enseeiht.fr/apo/MUMPS/ +

    +
    + + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_zmumps.xml b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_zmumps.xml new file mode 100644 index 000000000..95055a473 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/help_zmumps.xml @@ -0,0 +1,255 @@ + + + + + eng + zmumps + MUMPS interface function + + call to MUMPS + + [id]=zmumps (id [,mat]) + + + + + mat + +: sparse matrix which has to be provided as the second argument of + zmumps if id.JOB is strictly larger than 0. + + + + id.SYM + +: controls the matrix type (symmetric positive + definite, symmetric indefinite or unsymmetric) and it has do be + initialized by the user before the initialization phase of MUMPS + (see id.JOB). Its value is set to 0 after the call of initmumps. + + + + id.JOB + +: defines the action that will be realized by + MUMPS: initialize, analyze and/or factorize and/or solve and + release MUMPS internal C/Fortran data. It has to be set by the user before + any call to MUMPS (except after a call to initmumps, which sets + its value to -1). + + + + id.ICNTL and id.CNTL + +: define control parameters that can be + set after the initialization call (id.JOB = -1). See Section ``Control parameters'' +of the MUMPS user's guide + for more details. + If the user does not modify an entry in id.ICNTL then MUMPS + uses the default parameter. For example, if the user wants to + use the AMD ordering, he/she should set id.ICNTL(7) = 0. + Note that the following + parameters are inhibited because they are automatically set + within the interface: id.ICNTL(19) which controls the Schur + complement option and id.ICNTL(20) which controls the + format of the right-hand side. + Note that parameters id.ICNTL(1:4) may not work properly + depending on your compiler and your environment. In case of + problem, we recommand to swith printing off by setting + id.ICNL(1:4)=-1. + + + + id.PERM_IN + +: corresponds to the given ordering option + (see Section ``Input and output parameters'' +of the MUMPS user's guide +for more details). Note that this permutation is only accessed if +the parameter id.ICNTL(7) is set to 1. + + + + id.COLSCA and id.ROWSCA + +: are optional scaling arrays (see Section +``Input and output parameters'' +of the MUMPS user's guide +for more details) + + + + id.RHS + +: defines the right-hand side. The parameter id.ICNTL(20) related to its format (sparse or dense) is automatically set within the interface. Note that id.RHS is not modified (as in MUMPS), the solution is returned in id.SOL. + + + + id.VAR_SCHUR + +: corresponds to the list of variables + that appear in the Schur complement matrix (see Section +``Input and output parameters'' +of the MUMPS user's guide +for more details). + + + + id.REDRHS + +(input parameter only if id.VAR_SCHUR was provided during the factorization and +if ICNTL(26)=2 on entry to the solve phase): partial +solution on the variables corresponding to the Schur complement. It is provided +by the user and normally results from both the Schur complement and the reduced right-hand +side that were returned by MUMPS in a previous call. When ICNTL(26)=2, MUMPS uses this information +to build the solution id.SOL on the complete problem. +See Section ``Schur complement'' +of the MUMPS user's guide +for more details. + + + + + + + + id.SCHUR + +: if id.VAR_SCHUR is provided of size SIZE_SCHUR, then +id.SCHUR corresponds to a dense array of size + (SIZE_SCHUR,SIZE_SCHUR) that holds the Schur + complement matrix (see Section +``Input and output parameters'' +of the MUMPS user's guide +for more details). The user does not have to initialize it. + + + + id.REDRHS + +(output parameter only if ICNTL(26)=1 and id.VAR_SCHUR was defined): Reduced right-hand side (or +condensed right-hand side on the variables associated to the Schur complement). It +is computed by MUMPS during the solve stage if ICNTL(26)=1. It can then be used +outside MUMPS, together with the Schur complement, to build a solution on the interface. +See Section ``Schur complement'' +of the MUMPS user's guide +for more details. + + + + id.INFOG and id.RINFOG + +: information parameters + (see Section ``Information parameters'' +of the MUMPS user's guide +). + + + + id.SYM_PERM + +: corresponds to a symmetric permutation + of the variables + (see discussion regarding ICNTL(7) in Section +``Control parameters'' +of the MUMPS user's guide +). This permutation is computed during the analysis and is +followed by the numerical factorization except when numerical +pivoting occurs. + + + + id.UNS_PERM + +: column permutation (if any) on exit from the analysis + phase of MUMPS + (see discussion regarding ICNTL(6) in Section +``Control parameters'' +of the MUMPS user's guide +). + + + + id.SOL + +: dense vector or matrix containing the solution after MUMPS + solution phase. + + + + + +
    + + + id.INST: (MUMPS reserved component) MUMPS internal parameter. + + + id.TYPE: (MUMPS reserved component) defines the arithmetic + (complex or double precision). + + +
    + + +

    + The function zmumps solves systems of + linear equations of the form Ax = b where A is square sparse matrix and b + is a dense or sparse vector or matrix. The solver MUMPS is used and + we refer the user to the MUMPS User's Guide for full details. + Before the first call to zmumps, a call to initmumps must have been done: +

    + +     + + See also the examples provided in the directory "examples" that + comes with the distribution of this interface. + + + + + initmumps + dmumps + + +
    +

    + http://graal.ens-lyon.fr/MUMPS/ +

    +

    + http://www.enseeiht.fr/apo/MUMPS/ +

    +
    + +     diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/manrev.dtd b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/manrev.dtd new file mode 100644 index 000000000..4202804cc --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/manrev.dtd @@ -0,0 +1,94 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/whatis.htm b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/whatis.htm new file mode 100644 index 000000000..1120d8f49 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/Help/whatis.htm @@ -0,0 +1,11 @@ + + + + Interface to the MUMPS package + + +
    +
    dmumps - sparse direct solver (MUMPS), double precision artithmetic
    +
    zmumps - sparse direct solver (MUMPS), double complex artithmetic
    +
    initmumps - initialisation routine for MUMPS
    +
    diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/README b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/README new file mode 100644 index 000000000..e06c4b95d --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/README @@ -0,0 +1,93 @@ +README +************************************************************************ +* This SCILAB interface to MUMPS is provided to you free of charge. * +* It is part of the MUMPS package (see ../Conditions_of_use) and is * +* public domain. Up-to-date copies can be obtained from the Web * +* pages http://www.enseeiht.fr/apo/MUMPS/ or * +* http://graal.ens-lyon.fr/MUMPS * +* * +* THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY * +* EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. * +* * +* More info is available in the main MUMPS users' guide and in: * +* * +* [2006] Aurelia Fevre, Jean-Yves L'Excellent and Stephane Pralet * +* MATLAB and Scilab interfaces to MUMPS. LIP Report RR2006-06. * +* Also available as an INRIA and an ENSEEIHT-IRIT Technical Report. * +* * +************************************************************************ + +CONTENT OF THE DIRECTORY: + + README : this file + builder.sce : Scilab script to build the makefile, the loader_inc.sce + and to compile intdmumpsc.c and intzmumps.c + (to be executed once) + intdmumpsc.c : C interface file to double precision version of MUMPS + intzmumpsc.c : C interface file for double complex version of MUMPS + loader.sce : installation script (to be executed each time scilab is launched) + initmumps.sci : Scilab file for the initialisation of the mumps structure + dmumps.sci : Scilab file for double precision version + zmumps.sci : Scilab file for double complex version + + loader_inc.sce, Makefile, object files: Generated when executing the builder + + examples/ + double_example.sce : file containing an example of using MUMPS in Scilab + cmplx_example.sce : file containing an example of using MUMPS in Scilab, + with a complex matrix + schur_example.sce : file containing an example of using MUMPS in Scilab, + with the schur option + sparseRHS_example.sce : file containing an example of using MUMPS in Scilab, + with a sparse multiple right hand side + ex.sci : small sparse matrix used to run the examples + ex2.sci : small sparse matrix used to run the schur_example + ex_rhs.sci : small sparse right hand side used to run the examples + + +*************************************************************************************** + +INSTALLATION for Scilab: + +You need: + 1- scilab version 3.x or 4.x (not tested with scilab 5.x) + 2- to have compiled/linked a sequential version of MUMPS with both double precision + and double complex arithmetics ("make d" and "make z", or "make all") + 3- to modify the paths in the builder.sce. In particular you will need to give + the path to the runtime libraries of your FORTRAN 90 compiler. + 4- to execute builder.sce and loader.sce by using the "exec" + instruction within Scilab: + exec('builder.sce'); + exec('loader.sce'); + +SOME EXPLANATIONS: +- Modifications of builder.sce +In this file, you will find a variable part to customize. The following modifications +have to be done after the installation of MUMPS, i.e., after having a working MUMPS +library. + +o First, the paths until libmpiseq.a, libdmumpsc.a and libpord.a. If you have not +installed these libraries in specific places, and assuming that you are using MUMPS +version 4.5.5, the path should be: + xxxx/MUMPS_4.5.5/Include/ + xxxx/MUMPS_4.5.5/lib/ + xxxx/MUMPS_4.5.5/libseq/ +o Second, the C compiler with the flag for compilation only. For example: cc -c -O or +gcc -c -O. +o Finally, the harder part: you must define the libraries used by the Fortran +compiler that was used to compile MUMPS. + +- Modifications of loader.sce +The only thing to do in this file is to change the path DIR_SCIMUMPS; it has to be the +path to Scilab files + + +*************************************************************************************** + +LIMITATIONS: +The behaviour of the interface strongly depends on the Fortran compilers +and platform used. It has been tested on a limited set of these (for example, +the g95 compiler with Scilab 3.0 and 3.1 under a Linux PC). +This interface does not support MUMPS parallel versions, and has not +been tested under Windows environments). + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/builder.sce b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/builder.sce new file mode 100644 index 000000000..84c97a090 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/builder.sce @@ -0,0 +1,81 @@ +// $Id: builder_source.sce 7139 2011-03-22 22:50:47Z jylexcel $ + + +//******************* VARIABLE PART TO COSTUMIZE ***************************// + +// -- MUMPS: + +MUMPS_DIR = home + "/MUMPS_4.10.0"; +MUMPS_INC_DIR = MUMPS_DIR+"/include"; //path until dmumps_c.h and zmumps_c.h +MUMPS_LIB_DIR = MUMPS_DIR+"/lib"; //path until libdmumps.a, libzmumps.a and libpord.a +MUMPS_LIB = MUMPS_LIB_DIR+"/libmumps_common.a"; +DMUMPS_LIB = MUMPS_LIB_DIR+"/libdmumps.a"; +ZMUMPS_LIB = MUMPS_LIB_DIR+"/libzmumps.a"; +LIB_MPISEQ = MUMPS_DIR+"/libseq/libmpiseq.a"; + +// -- SCILAB: Path to scilab routines + +SCI_DIR_INC = "/usr/include/scilab/"; + +// -- BLAS library, if not already included in Scilab: + +BLAS_LIB = ""; + +// -- ORDERINGS (should correspond to the ones defined MUMPS's Makefile.inc): + +PORD_LIB = MUMPS_LIB_DIR+"libpord.a"; +METIS_LIB = HOME+"/metis-4.0/libmetis.a"; +ORDERINGS_LIB = PORD_LIB+" "+METIS_LIB; + +// -- PTHREAD lib required by MUMPS versions > 4.6 +PTHREAD_LIB="-lpthread"; + +// -- COMPILER FOR THE INTERFACE +COMPILER_= "gcc -c -O -fPIC"; + +// -- FORTRAN RUNTIME LIBRARIES + +// -- g95 +//FORT_LIB = "/usr/lib/libf95.a /usr/lib/libgcc.a"; + +// -- gfortran compiler +FORT_LIB="/usr/lib/libgfortran.a"; + +// -- ifort compiler +//FORT_LIB_DIR = "/opt/intel/fc/9.0/lib/"; +//FORT_LIB = FORT_LIB_DIR+"libifcore.a"+" "+FORT_LIB_DIR+"libimf.a"+" "+FORT_LIB_DIR+"libguide.a"+" "+FORT_LIB_DIR+"libirc.a"; + +//**************************************************************************// +//******************* DON't EDIT BELOW (Normally) **************************// + +//---- Build the Makefile +fd=mopen("Makefile","w"); +mfprintf(fd,"SCIDIRINC = %s\n",SCI_DIR_INC); +mfprintf(fd,"MUMPSINCDIR = %s\n",MUMPS_INC_DIR); +mfprintf(fd,"CC = %s\n", COMPILER_); +mfprintf(fd,"all: intdmumpsc.o intzmumpsc.o\n"); +mfprintf(fd,"intdmumpsc.o: intmumpsc.c\n"); +mfprintf(fd,"\t$(CC) -o $@ $? -DMUMPS_ARITH=MUMPS_ARITH_d -I${MUMPSINCDIR} -I${SCIDIRINC}\n"); +mfprintf(fd,"intzmumpsc.o: intmumpsc.c\n"); +mfprintf(fd,"\t$(CC) -o $@ $? -DMUMPS_ARITH=MUMPS_ARITH_z -I${MUMPSINCDIR} -I${SCIDIRINC}\n"); +mfprintf(fd,"clean:\n"); +mfprintf(fd,"\trm *.o loader_inc.sce\n"); +mclose(fd); + +//---- Compile +unix("make"); + +//---- Build the Loader_inc.sce +fd=mopen("loader_inc.sce","w"); +mfprintf(fd,"objects = [ path+\""intzmumpsc.o\"" ; \n") +mfprintf(fd," path+\""intdmumpsc.o\"" ; \n") +mfprintf(fd," \""%s\"" ; \n",DMUMPS_LIB) +mfprintf(fd," \""%s\"" ; \n",ZMUMPS_LIB) +mfprintf(fd," \""%s\"" ; \n",ORDERINGS_LIB) +mfprintf(fd," \""%s\"" ; \n",LIB_MPISEQ) +mfprintf(fd," \""%s\"" ; \n",PORD_LIB) +mfprintf(fd," \""%s\"" ; \n",METIS_LIB) +mfprintf(fd," \""%s\"" ; \n",BLAS_LIB) +mfprintf(fd," \""%s\"" ; \n",FORT_LIB) +mfprintf(fd," \""%s\"" ]; \n",PTHREAD_LIB) +mclose(fd); diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/dmumps.sci b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/dmumps.sci new file mode 100644 index 000000000..643e2b30d --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/dmumps.sci @@ -0,0 +1,90 @@ +function id=dmumps(id,mat) + +//************************************************************************************************************** +// [id] = dmumps(id,mat) +// id is a structure (see details in initmumps.m and MUMPS documentation) +// mat is an optional parameter if the job id.job = -1 or -2 +// mat is a square sparse matrix +// informations are return in id fields +// +// ************************************************************************************************************* + + +if (typeof(id) ~= "StructMumps") then + disp("Error. Please call initmumps first."); + return; +end +arithtype=1; + +if id.JOB == -2 then + if id.INST==-9999 then + disp('Error. Uninitialized instance. MUMPS should be called with JOB=-1 first.'); + return; + end + if id.TYPE ~= arithtype then + disp('Error. You are trying to call z/d version on a d/z instance'); + return; + end + // call the C routine dmumpsc + + dmumpsc(id.SYM,id.JOB,id.ICNTL,id.CNTL,id.PERM_IN,id.COLSCA,id.ROWSCA,id.RHS,id.VAR_SCHUR,id.INST,id.REDRHS); + id = []; + return; +end + + +if id.JOB == -1 then + if id.INST~=-9999 then + disp('Error. Already initialized instance.'); + return; + end + // call the C routine dmumpsc + [inform,rinform,sol,inst,schu,redrhs,pivnul_list,sym_perm,uns_perm,icntl,cntl] = dmumpsc(id.SYM,id.JOB,id.ICNTL,id.CNTL,id.PERM_IN,id.COLSCA,id.ROWSCA,id.RHS,id.VAR_SCHUR,id.INST,id.REDRHS); + id.INFOG = inform; + id.RINFOG = rinform; + id.SOL = sol; + id.INST = inst; + id.SCHUR = schu; + id.REDRHS = redrhs; + id.PIVNUL_LIST = pivnul_list; + id.SYM_PERM = sym_perm; + id.UNS_PERM = uns_perm; + id.TYPE=arithtype; + id.ICNTL=icntl; + id.CNTL=cntl; + clear inform rinform sol inst schu redrhs pivnul_list sym_perm uns_perm icntl cntl + return; + +end + +if id.INST ==-9999 then + disp('Uninitialized instance'); + return; +end +// call the C routine dmumpsc + +if id.TYPE ~= arithtype then + disp('You are trying to call z/d version on a d/z instance'); +end + +[inform,rinform,sol,inst,schu,redrhs,pivnul_list,sym_perm,uns_perm,icntl,cntl] = dmumpsc(id.SYM,id.JOB,id.ICNTL,id.CNTL,id.PERM_IN,id.COLSCA,id.ROWSCA,id.RHS,id.VAR_SCHUR,id.INST,id.REDRHS, mat); +id.INFOG = inform; +id.RINFOG = rinform; +id.SOL = sol; +id.INST = inst; +if (id.JOB == 2|id.JOB==4|id.JOB==6) then + if id.SYM == 0 then + id.SCHUR=schu'; + else + id.SCHUR=triu(schu)+tril(schu',-1); + end +end +id.REDRHS = redrhs; +id.PIVNUL_LIST = pivnul_list; +id.SYM_PERM(sym_perm) = [1:size(mat,1)]; +id.UNS_PERM = uns_perm; +id.ICNTL=icntl; +id.CNTL=cntl; +clear inform rinform sol inst schu redrhs pivnul_list sym_perm uns_perm icntl cntl + +endfunction diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/cmplx_example.sce b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/cmplx_example.sce new file mode 100644 index 000000000..896b6e93e --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/cmplx_example.sce @@ -0,0 +1,39 @@ +//A simple demo for the MUMPS interface +//to run it, You just have to execute the instruction within Scilab +// exec cmplx_example.sce; + + +//*********************** MATRIX INITIALISATION ***********************// +// This matrix has to be a SciSparse, otherwise it won't work. + exec('ex.sci'); + //voir pour les speyes + n=size(a,1); + mat=sparse(a)+%i*speye(n,n); + +// Right Hand side setting + RHS = ones(n,1); + +//****************** Initialisation of the Scilab MUMPS structure ******************// +timer(); +[id]=initmumps(); + +//Here Job=-1, the next call will only initialise the C and Fortran structure +[id]=zmumps(id); +id.RHS=RHS; + +//******************** CALL TO MUMPS FOR RESOLUTION ********************// +job=6; +id.JOB=job; + +[id]=zmumps(id,mat); + +// verification of the solution +solution=id.SOL; +norm_res=norm(mat*solution-RHS,'inf'); +write(%io(2),norm_res); + +//****************** DESTRUCTION OF THE MUMPS INSTANCE ******************// +job=-2; +id.JOB=job; +[id]=zmumps(id); +t=timer() diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/double_example.sce b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/double_example.sce new file mode 100644 index 000000000..946423e58 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/double_example.sce @@ -0,0 +1,37 @@ +//A simple demo for the MUMPS interface +//to run it, You just have to execute the instruction within Scilab +// exec double_example.sce; + + +//*********************** MATRIX INITIALISATION ***********************// +// This matrix has to be a SciSparse, otherwise it won't work. + exec('ex.sci'); + mat=sparse(a); + +// Right Hand side setting + RHS = ones(size(mat,1),1); + +//****************** Initialisation of the Scilab MUMPS structure ******************// +timer(); +[id]=initmumps(); + +//Here Job=-1, the next call will only initialise the C and Fortran structure +[id]=dmumps(id); +id.RHS=RHS; + +//******************** CALL TO MUMPS FOR RESOLUTION ********************// +job=6; +id.JOB=job; + +[id]=dmumps(id,mat); + +// verification of the solution +solution=id.SOL; +norm_res=norm(mat*solution-RHS,'inf'); +write(%io(2),norm_res); + +//****************** DESTRUCTION OF THE MUMPS INSTANCE ******************// +job=-2; +id.JOB=job; +[id]=dmumps(id); +t=timer() diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/ex.sci b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/ex.sci new file mode 100644 index 000000000..9380b5d3e --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/ex.sci @@ -0,0 +1,12 @@ +a(1,2)=3.0; +a(2,3)=-3.0; +a(4,3)=2.0; +a(5,5)=1.0; +a(2,1)=3.0; +a(1,1)=2.0; +a(5,2)=4.0; +a(3,4)=2.0; +a(2,5)=6.0; +a(3,2)=-1.0; +a(1,3)=4.0; +a(3,3)=1.0; diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/ex_rhs.sci b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/ex_rhs.sci new file mode 100644 index 000000000..7273956da --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/ex_rhs.sci @@ -0,0 +1,5 @@ +rhs(2,1)=3; +rhs(5,1)=1; +rhs(1,2)=8; +rhs(2,2)=2; +rhs(4,2)=3; \ No newline at end of file diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/schur_example.sce b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/schur_example.sce new file mode 100644 index 000000000..5c8c00173 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/schur_example.sce @@ -0,0 +1,68 @@ +//A simple demo for the MUMPS interface, with the return of the schur complement +//to run it, You just have to execute the instruction within Scilab +// exec sparse_example.sce; + + +//*********************** MATRIX INITIALISATION ***********************// + n=10; + mat=sprand(n,n,.5)+speye(n,n); + size_schur=3; + +// Right Hand side setting + RHS = ones(n,1); + + +//****************** Initialisation of the Scilab MUMPS structure ******************// +timer(); +[id]=initmumps(); + +//Here Job=-1, the next call will only initialise the C and Fortran structure +[id]=dmumps(id); + +id.RHS=RHS; +id.VAR_SCHUR = [n-size_schur+1:n]; + +//******************** CALL TO MUMPS FOR RESOLUTION ON INTERNAL PROBLEM ************// +job=6; +id.JOB=job; + +[id]=dmumps(id,mat); + +// verification of the solution +solution=id.SOL; +norm1=norm(mat(1:n-size_schur,1:n-size_schur)*solution(1:n-size_schur) - ones(n-size_schur,1),'inf'); +if norm1> 10^(-9) then + write(%io(2),'WARNING: solution on internal problem may not be OK'); +else + write(%io(2),'SOLUTION on internal problem ok'); +end + + +//******************* TRY REDUCED RHS FUNCTIONALITY **************// +id.JOB=3; +id.ICNTL(26)=1; + +// Forward +[id]=dmumps(id,mat); + +// Solve the problem on the Schur complement +id.REDRHS=id.SCHUR \ id.REDRHS; + +// and reinject it to MUMPS +id.ICNTL(26)=2; +[id]=dmumps(id,mat); +solution=id.SOL; +norm1=norm(mat*solution-RHS,'inf') +if norm1> 10^(-9) then + write(%io(2),'WARNING: solution on complete problem may not be OK'); +else + write(%io(2),'SOLUTION on complete problem ok'); +end + + + +//****************** DESTRUCTION OF THE MUMPS INSTANCE ******************// +job=-2; +id.JOB=job; +[id]=dmumps(id); +t=timer() diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/sparseRHS_example.sce b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/sparseRHS_example.sce new file mode 100644 index 000000000..ae831babb --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/examples/sparseRHS_example.sce @@ -0,0 +1,39 @@ +//A simple demo for the MUMPS interface, with the use of a sparse Right Hand Side +//to run it, You just have to execute the instruction within Scilab +// exec sparse_example.sce; + + +//*********************** MATRIX INITIALISATION ***********************// +// This matrix has to be a SciSparse, otherwise it won't work. + exec('ex.sci'); + //voir pour les speyes + mat=sparse(a); + +// Right Hand side setting + exec('ex_rhs.sci'); + RHS = sparse(rhs); + +//****************** Initialisation of the Scilab MUMPS structure ******************// +timer(); +[id]=initmumps(); + +//Here Job=-1, the next call will only initialise the C and Fortran structure +[id]=dmumps(id); +id.RHS=RHS; + +//******************** CALL TO MUMPS FOR RESOLUTION ********************// +job=6; +id.JOB=job; + +[id]=dmumps(id,mat); + +// verification of the solution +solution=id.SOL; +norm_res=norm(mat*solution-RHS,'inf'); +write(%io(2),norm_res); + +//****************** DESTRUCTION OF THE MUMPS INSTANCE ******************// +job=-2; +id.JOB=job; +[id]=dmumps(id); +t=timer() diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/initmumps.sci b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/initmumps.sci new file mode 100644 index 000000000..e3cf682ed --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/initmumps.sci @@ -0,0 +1,10 @@ +function id = initmumps() +// +// id = initmumps +// it returns a default Scilab MUMPS mlist (structure) +// + +id = mlist(["StructMumps";"SYM";"JOB";"ICNTL";"CNTL";"PERM_IN";"COLSCA";"ROWSCA";"RHS";"INFOG";"RINFOG";"VAR_SCHUR";"SCHUR";"INST";"SOL";"REDRHS";"PIVNUL_LIST";"SYM_PERM";"UNS_PERM";"TYPE"],0,-1,zeros(1,40)-9998,zeros(1,15)-9998,-9999,-9999,-9999,-9999,zeros(1,40)-9998,zeros(1,40)-9998,-9999,-9999,-9999,-9999,-9999,-9999,-9999,-9999,0); + +endfunction + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/intmumpsc.c b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/intmumpsc.c new file mode 100644 index 000000000..f5503450d --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/intmumpsc.c @@ -0,0 +1,622 @@ +#include "mex.h" +#include "stack-c.h" +#include "sci_gateway.h" +#include +#include +#include + +#define MUMPS_ARITH_d 2 +#define MUMPS_ARITH_z 8 + +#if MUMPS_ARITH == MUMPS_ARITH_z + +# include "zmumps_c.h" +# define dmumps_c zmumps_c +# define dmumps_par zmumps_par +# define DMUMPS_STRUC_C ZMUMPS_STRUC_C +# define DMUMPS_alloc ZMUMPS_alloc +# define DMUMPS_free ZMUMPS_free +# define double2 mumps_double_complex + +#elif MUMPS_ARITH == MUMPS_ARITH_d + +# include "dmumps_c.h" +# define double2 double +# define EXTRACT_CMPLX_FROM_C_TO_SCILAB EXTRACT_DOUBLE_FROM_C_TO_SCILAB +# define EXTRACT_CMPLX_FROM_SCILAB_TOPTR EXTRACT_FROM_SCILAB_TOPTR + +#else + +# error "Only d and z arithmetics are supported" + +#endif + + +#define nb_RHS 12 + +#define MYFREE(ptr)\ +if(ptr){ \ + free(ptr); \ + ptr=0;} \ + + +#define EXTRACT_FROM_SCILAB_TOPTR(it,ptr_scilab1,ptr_scilab2,mumpspointer,type,length)\ +if(ptr_scilab1[0] != -9999){ \ + free(mumpspointer); \ + mumpspointer = (type *) malloc(length*sizeof(type)); \ + for(i=0;iirn ); + MYFREE( (*dmumps_par)->jcn ); + MYFREE( (*dmumps_par)->a ); + MYFREE( (*dmumps_par)->irn_loc ); + MYFREE( (*dmumps_par)->jcn_loc ); + MYFREE( (*dmumps_par)->a_loc ); + MYFREE( (*dmumps_par)->eltptr ); + MYFREE( (*dmumps_par)->eltvar ); + MYFREE( (*dmumps_par)->a_elt ); + MYFREE( (*dmumps_par)->perm_in ); + MYFREE( (*dmumps_par)->colsca ); + MYFREE( (*dmumps_par)->rowsca ); + MYFREE( (*dmumps_par)->pivnul_list ); + MYFREE( (*dmumps_par)->listvar_schur ); + MYFREE( (*dmumps_par)->sym_perm ); + MYFREE( (*dmumps_par)->uns_perm ); + MYFREE( (*dmumps_par)->irhs_ptr); + MYFREE( (*dmumps_par)->irhs_sparse); + MYFREE( (*dmumps_par)->rhs_sparse); + MYFREE( (*dmumps_par)->rhs); + MYFREE( (*dmumps_par)->redrhs); + MYFREE(*dmumps_par); + } +} + +void DMUMPS_alloc(DMUMPS_STRUC_C **dmumps_par){ + + *dmumps_par = (DMUMPS_STRUC_C *) malloc(sizeof(DMUMPS_STRUC_C)); + (*dmumps_par)->irn = NULL; + (*dmumps_par)->jcn = NULL; + (*dmumps_par)->a = NULL; + (*dmumps_par)->irn_loc = NULL; + (*dmumps_par)->jcn_loc = NULL; + (*dmumps_par)->a_loc = NULL; + (*dmumps_par)->eltptr = NULL; + (*dmumps_par)->eltvar = NULL; + (*dmumps_par)->a_elt = NULL; + (*dmumps_par)->perm_in = NULL; + (*dmumps_par)->colsca = NULL; + (*dmumps_par)->rowsca = NULL; + (*dmumps_par)->rhs = NULL; + (*dmumps_par)->redrhs = NULL; + (*dmumps_par)->irhs_ptr = NULL; + (*dmumps_par)->irhs_sparse = NULL; + (*dmumps_par)->rhs_sparse = NULL; + (*dmumps_par)->pivnul_list = NULL; + (*dmumps_par)->listvar_schur = NULL; + (*dmumps_par)->schur = NULL; + (*dmumps_par)->sym_perm = NULL; + (*dmumps_par)->uns_perm = NULL; +} + + + + static int dmumpsc(char *fname){ + + + /* RhsVar parameters */ + int njob, mjob, ljob, mint, nint, lint, nsym, msym, lsym, nA, mA, nRHS, nREDRHS, mRHS,lRHS, liRHS; + int mREDRHS,lREDRHS,liREDRHS; + int nicntl, micntl, licntl, ncntl, mcntl, lcntl, nperm, mperm, lperm; + int ncols, mcols, lcols, licols, nrows, mrows, lrows, lirows, ns_schu , ms_schu, ls_schu; + int nv_schu, mv_schu, lv_schu, nschu, mschu, lschu; + int type_rhs, mtype_rhs, ntype_rhs, ltype_rhs; + + /* LhsVar parameters */ + int linfog, lrinfog, lrhsout,lrhsouti, linstout, lschurout, lschurouti, ldef; + int lpivnul_list, lmapp, lsymperm, lunsperm; + int one=1, temp1=40, temp2=40, temp3, temp4; + int it, itRHS, itREDRHS; /* parameter for real/complex types */ + + int i,j,k1,k2, nb_in_row,netrue; + int *ptr_int; + double *ptr_double; + double *ptr_scilab; +#if MUMPS_ARITH == MUMPS_ARITH_z + double * ptri_scilab; +#endif + + /* Temporary length variables */ + int len1, len2; + /* Temporary pointers in stack */ + int stkptr, stkptri; + + /* C pointer for input parameters */ + int inst_address; + int ne,inst; + int *irn_in,*jcn_in; + + /* Variable for multiple and sparse RHS*/ + int posrhs, posschur, nz_RHS,col_ind,k; + int *irhs_ptr; + int *irhs_sparse; + double *rhs_sparse; +#if MUMPS_ARITH == MUMPS_ARITH_z + double *im_rhs_sparse; + char * function_name="zmumpsc"; +#else + char * function_name="dmumpsc"; +#endif + + SciSparse A; + SciSparse RHS_SPARSE; + DMUMPS_STRUC_C *dmumps_par; + + int dosolve=0; + int donullspace=0; + int doanal = 0; + /* Check number of input parameters */ + CheckRhs(11,12); + + /* Get job value. njob/mjob are the dimensions of variable job. */ + GetRhsVar(2,"i",&mjob,&njob,&ljob); + dosolve = (*istk(ljob) == 3 || *istk(ljob) == 5 ||*istk(ljob) == 6); + doanal = (*istk(ljob) == 1 || *istk(ljob) == 4 || *istk(ljob) == 6); + if(*istk(ljob) == -1){ + + DMUMPS_alloc(&dmumps_par); + GetRhsVar(1,"i",&msym,&nsym,&lsym); + dmumps_par->sym=*istk(lsym); + dmumps_par->job = -1; + dmumps_par->par = 1; + dmumps_c(dmumps_par); + dmumps_par->nz = -1; + dmumps_par->nz_alloc=-1; + it=1; + }else{ + /* Obtain pointer on instance */ + GetRhsVar(10,"i",&mint,&nint,&lint); + inst_address=*istk(lint); /* EXTRACT_FROM_SCILAB_TOVAL(INST,inst_address); */ + ptr_int = (int *) inst_address; + + dmumps_par = (DMUMPS_STRUC_C *) ptr_int; + if(*istk(ljob) == -2){ + dmumps_par->job = -2; + dmumps_c(dmumps_par); + DMUMPS_free(&dmumps_par); + }else{ + /* Get the sparse matrix A */ + GetRhsVar(12,"s",&mA,&nA,&A); + + if (nA != mA || mA<1 ){ + Scierror(999,"%s: Bad dimensions for mat\n",function_name); + return 0; + } + + ne=A.nel; + dmumps_par->n = nA; + + if(dmumps_par->sym != 0){ + netrue = (nA+ne)/2; + }else{ + netrue = ne; + } + + if(dmumps_par->nz_alloc < netrue ||dmumps_par->nz_alloc >= 2*netrue){ + MYFREE(dmumps_par->jcn); + MYFREE(dmumps_par->irn); + MYFREE(dmumps_par->a); + + dmumps_par->jcn = (int*)malloc(netrue*sizeof(int)); + dmumps_par->irn = (int*)malloc(netrue*sizeof(int)); + dmumps_par->a = (double2 *) malloc(netrue*sizeof(double2)); + dmumps_par->nz_alloc = netrue; + } + /* Check for symmetry in order to initialize only + * lower triangle on entry to symmetric MUMPS code */ + if ((dmumps_par->sym)==0){ + /* + * Unsymmetric case: + * build irn from mnel for MUMPS format + * mA : number of rows + */ + + if(doanal){ + for(i=0;ijcn)[i]=(A.icol)[i];} + k1=0; + for (k2=1;k2irn[k1]=k2; /* matrix indices start at 1 */ + k1=k1+1; + nb_in_row=nb_in_row+1; + } + } + } + +#if MUMPS_ARITH == MUMPS_ARITH_z + for(i=0;ia)[i]).r = (A.R)[i];} + if(A.it == 1){ + for(i=0;ia)[i]).i = (A.I)[i];} + }else{ + for(i=0;ia)[i]).i = 0.0;} + } +#else + for(i=0;ia)[i]) = (A.R)[i];} +#endif + dmumps_par->nz = ne; + } + else{ + /* symmetric case */ + k1=0; + i=0; + for (k2=1;k2= (A.icol)[i]){ + if(k1>=netrue){ + Scierror(999,"%s: The matrix must be symmetric\n",function_name); + return 0; + } + (dmumps_par->jcn)[k1]=(A.icol)[i]; + (dmumps_par->irn)[k1]=k2; +#if MUMPS_ARITH == MUMPS_ARITH_z + (dmumps_par->a)[k1].r=(A.R)[i]; + if(A.it == 1){ + ((dmumps_par->a)[k1]).i = (A.I)[i];} + else{ + ((dmumps_par->a)[k1]).i = 0.0;} +#else + ((dmumps_par->a)[k1]) = (A.R)[i]; +#endif + k1=k1+1;} + + nb_in_row=nb_in_row+1; + i=i+1; + } + } + dmumps_par->nz = k1; + } + + GetRhsVar(2,"i",&mjob,&njob,&ljob); + dmumps_par->job=*istk(ljob); + + GetRhsVar(3,"i",&micntl,&nicntl,&licntl); + EXTRACT_FROM_SCILAB_TOARR(istk(licntl),dmumps_par->icntl,int,40); + + GetRhsVar(4,"d",&mcntl,&ncntl,&lcntl); + EXTRACT_FROM_SCILAB_TOARR(stk(lcntl),dmumps_par->cntl,double,15); + + GetRhsVar(5,"i",&mperm, &nperm, &lperm); + EXTRACT_FROM_SCILAB_TOPTR(IT_NOT_USED,istk(lperm),istk(lperm),(dmumps_par->perm_in),int,nA); + + GetRhsCVar(6,"d",&it,&mcols,&ncols,&lcols,&licols); + EXTRACT_FROM_SCILAB_TOPTR(it,stk(lcols),stk(licols),(dmumps_par->colsca),double2,nA); + + GetRhsCVar(7,"d",&it,&mrows,&nrows,&lrows,&lirows); + EXTRACT_FROM_SCILAB_TOPTR(it,stk(lrows),stk(lirows),(dmumps_par->rowsca),double2,nA); + + +/* + * To follow the "spirit" of the Matlab/Scilab interfaces, treat case of null + * space separately. In that case, we initialize lrhs and nrhs automatically, + * allocate the space needed, and do not rely on what is provided by the user + * in component RHS, that is not touched. + * Note that at the moment the user should not call the solution step combined + * with the factorization step when he/she sets icntl[25] to a non-zero value. + * Hence we suppose infog[28-1] is available and we can use it. + * + * For users of scilab/matlab, it would still be nice to be able to set ICNTL(25)=-1, + * and use JOB=6. If we want to make this functionality available, we should + * call separately job=2 and job=3 even if job=5 or 6 and set nrhs (and allocate + * space correctly) between job=2 and job=3 calls to MUMPS. + * + */ + if ( dmumps_par->icntl[25-1] == -1 && dmumps_par->infog[28-1] > 0) { + dmumps_par->nrhs=dmumps_par->infog[28-1]; + donullspace = dosolve; + } + else if ( dmumps_par->icntl[25-1] > 0 && dmumps_par->icntl[25-1] <= dmumps_par->infog[28-1] ) { + dmumps_par->nrhs=1; + donullspace = dosolve; + } + else { + donullspace=0; + } + if (donullspace) { + nRHS=dmumps_par->nrhs; + dmumps_par->lrhs=dmumps_par->n; + dmumps_par->rhs=(double2 *)malloc((dmumps_par->n)*(dmumps_par->nrhs)*sizeof(double2)); + dmumps_par->icntl[19]=0; + } + + else if(GetType(8)!=5){ +/* Dense RHS */ + GetRhsCVar(8,"d",&itRHS,&mRHS,&nRHS,&lRHS,&liRHS); + + if((!dosolve) || (stk(lRHS)[0]) == -9999){ + /* Could be dangerous ? See comment in Matlab interface */ + EXTRACT_CMPLX_FROM_SCILAB_TOPTR(itRHS,stk(lRHS),stk(liRHS),(dmumps_par->rhs),double2,one); + }else{ + + dmumps_par->nrhs = nRHS; + dmumps_par->lrhs = mRHS; + if(mRHS!=nA){ + Scierror(999,"%s: Incompatible number of rows in RHS\n",function_name); + } + dmumps_par->icntl[19]=0; + EXTRACT_CMPLX_FROM_SCILAB_TOPTR(itRHS,stk(lRHS),stk(liRHS),(dmumps_par->rhs),double2,(nRHS*mRHS)); + } + }else{ +/* Sparse RHS */ + GetRhsVar(8,"s",&mRHS,&nRHS,&RHS_SPARSE); + dmumps_par->icntl[19]=1; + dmumps_par->nrhs = nRHS; + dmumps_par->lrhs = mRHS; + nz_RHS=RHS_SPARSE.nel; + dmumps_par->nz_rhs=nz_RHS; + + irhs_ptr=(int*)malloc((nRHS+1)*sizeof(int)); + + dmumps_par->irhs_ptr=(int*)malloc((nRHS+1)*sizeof(int)); + dmumps_par->irhs_sparse=(int*)malloc(nz_RHS*sizeof(int)); + dmumps_par->rhs_sparse=(double2*)malloc(nz_RHS*sizeof(double2)); + dmumps_par->rhs=(double2*)malloc((nRHS*mRHS)*sizeof(double2)); + /* transform row-oriented sparse multiple rhs (scilab) + * into column-oriented sparse multiple rhs (mumps) */ + k=0; + for(i=0;iirhs_ptr[i]=0;} + for(i=1;iirhs_ptr)[col_ind])++; + } + } + (dmumps_par->irhs_ptr)[0]=1; + irhs_ptr[0]=(dmumps_par->irhs_ptr)[0]; + for(i=1;iirhs_ptr)[i]=(dmumps_par->irhs_ptr)[i]+(dmumps_par->irhs_ptr)[i-1]; + irhs_ptr[i]= (dmumps_par->irhs_ptr)[i]; + } + k=RHS_SPARSE.nel-1; + for(i=mRHS;i>=1;i--){ + + for(j=0;j<(RHS_SPARSE.mnel)[i-1];j++){ + col_ind=(RHS_SPARSE.icol)[k]; + (dmumps_par->irhs_sparse)[irhs_ptr[col_ind]-2]=i; +#if MUMPS_ARITH == MUMPS_ARITH_z + if(RHS_SPARSE.it==1){ + ((dmumps_par->rhs_sparse)[irhs_ptr[col_ind]-2]).r=RHS_SPARSE.R[k]; + ((dmumps_par->rhs_sparse)[irhs_ptr[col_ind]-2]).i=RHS_SPARSE.I[k]; + }else{ + ((dmumps_par->rhs_sparse)[irhs_ptr[col_ind]-2]).r=RHS_SPARSE.R[k]; + ((dmumps_par->rhs_sparse)[irhs_ptr[col_ind]-2]).i=0.0; + } +#else + (dmumps_par->rhs_sparse)[irhs_ptr[col_ind]-2]=RHS_SPARSE.R[k]; +#endif + k--; + irhs_ptr[col_ind]=irhs_ptr[col_ind]-1; + } + } + MYFREE(irhs_ptr); + } + + GetRhsVar(9,"i",&nv_schu,&mv_schu,&lv_schu); + dmumps_par-> size_schur=mv_schu; + EXTRACT_FROM_SCILAB_TOPTR(IT_NOT_USED,istk(lv_schu),istk(lv_schu),(dmumps_par->listvar_schur),int,dmumps_par->size_schur); + if(!dmumps_par->listvar_schur) dmumps_par->size_schur=0; + + if(dmumps_par->size_schur > 0){ + MYFREE(dmumps_par->schur); + if(!(dmumps_par->schur=(double2 *)malloc((dmumps_par->size_schur*dmumps_par->size_schur)*sizeof(double2)))){ + Scierror(999,"%s: malloc Schur failed in intmumpsc.c\n",function_name); + } + dmumps_par->icntl[18]=1; + }else{ + dmumps_par->icntl[18]=0; + } + + /* Reduced RHS */ + if ( dmumps_par->size_schur > 0 && dosolve ) { + + if ( dmumps_par->icntl[26-1] == 2 ) { + /* REDRHS is on input */ + GetRhsCVar(11,"d",&itREDRHS,&mREDRHS,&nREDRHS,&lREDRHS,&liREDRHS); + if (mREDRHS != dmumps_par->size_schur || nREDRHS != dmumps_par->nrhs ) { + Scierror(999,"%s: bad dimensions for REDRHS\n"); + } + /* Fill dmumps_par->redrhs */ + EXTRACT_CMPLX_FROM_SCILAB_TOPTR(itREDRHS,stk(lREDRHS),stk(liREDRHS),(dmumps_par->redrhs),double2,(nREDRHS*mREDRHS)); + dmumps_par->lrhs=mREDRHS; + } + + if ( dmumps_par->icntl[26-1] == 1 ) { + /* REDRHS on output. Must be allocated before the call */ + MYFREE(dmumps_par->redrhs); + if(!(dmumps_par->redrhs=(double2 *)malloc((dmumps_par->size_schur*dmumps_par->nrhs)*sizeof(double2)))){ + Scierror(999,"%s: malloc redrhs failed in intmumpsc.c\n",function_name); + } + } + } + + /* call C interface to MUMPS */ + dmumps_c(dmumps_par); + + } + } + + if(*istk(ljob)==-2){ + return 0; + }else{ + + CheckLhs(11,11); + + EXTRACT_INT_FROM_C_TO_SCILAB(1,linfog,(dmumps_par->infog),one,temp1,one); + + EXTRACT_DOUBLE_FROM_C_TO_SCILAB(2,it,lrinfog,lrinfog,(dmumps_par->rinfog),one,temp2,one); + + if(dmumps_par->rhs && dosolve){ /* Just to know if solution step was called */ + it =1; + EXTRACT_CMPLX_FROM_C_TO_SCILAB(3,it,lrhsout,lrhsouti,(dmumps_par->rhs),nA,nRHS,one); + + }else{ + it=1; + EXTRACT_CMPLX_FROM_C_TO_SCILAB(3,it,lrhsout,lrhsouti,(dmumps_par->rhs),one,one,one); + } + + ptr_int = (int *)dmumps_par; + inst_address = (int) ptr_int; + EXTRACT_INT_FROM_C_TO_SCILAB(4,linstout,&inst_address,one,one,one); + + + temp4=dmumps_par->size_schur; + if(temp4>0){ + it=1; + EXTRACT_CMPLX_FROM_C_TO_SCILAB(5,it,lschurout,lschurouti,(dmumps_par->schur),temp4,temp4,one); + }else{ + it=1; + EXTRACT_CMPLX_FROM_C_TO_SCILAB(5,it,lschurout,lschurouti,(dmumps_par->schur),one,one,one); + } + + /* REDRHS on output */ + it=1; + if ( dmumps_par->icntl[26-1]==1 && dmumps_par->size_schur > 0 && dosolve ) { + len1=dmumps_par->size_schur; + len2=dmumps_par->nrhs; + } + else { + len1=1; + len2=1; + } + it=1; + EXTRACT_CMPLX_FROM_C_TO_SCILAB(6,it,stkptr,stkptri,(dmumps_par->redrhs),len1,len2,one) + + + MYFREE(dmumps_par->redrhs); + MYFREE(dmumps_par->schur); + MYFREE(dmumps_par->irhs_ptr); + MYFREE(dmumps_par->irhs_sparse); + MYFREE(dmumps_par->rhs_sparse); + MYFREE(dmumps_par->rhs); + + /* temp3=dmumps_par->deficiency;*/ + temp3=dmumps_par->infog[27]; + EXTRACT_INT_FROM_C_TO_SCILAB(7,lpivnul_list,(dmumps_par->pivnul_list),one,temp3,one); + + EXTRACT_INT_FROM_C_TO_SCILAB(8,lsymperm,(dmumps_par->sym_perm),one,nA,one); + + EXTRACT_INT_FROM_C_TO_SCILAB(9,lunsperm,(dmumps_par->uns_perm),one,nA,one); + + nicntl=40; + EXTRACT_INT_FROM_C_TO_SCILAB(10,licntl,(dmumps_par->icntl),one,nicntl,one); + ncntl=15; + EXTRACT_DOUBLE_FROM_C_TO_SCILAB(11,it,lcntl,lcntl,(dmumps_par->cntl),one,ncntl,one); + return 0; + + } +} + + +static GenericTable Tab[]={ +#if MUMPS_ARITH == MUMPS_ARITH_z +{(Myinterfun) sci_gateway, dmumpsc,"zmumpsc"} +#else +{(Myinterfun) sci_gateway, dmumpsc,"dmumpsc"} +#endif +}; + +#if MUMPS_ARITH == MUMPS_ARITH_z +int C2F(scizmumps)() +#else +int C2F(scidmumps)() +#endif +{Rhs = Max(0, Rhs); +(*(Tab[Fin-1].f))(Tab[Fin-1].name,Tab[Fin-1].F); +return 0; +} diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/loader.sce b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/loader.sce new file mode 100644 index 000000000..8aec3971a --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/loader.sce @@ -0,0 +1,35 @@ +path= get_absolute_file_path('loader.sce'); +exec(path+"/loader_inc.sce"); + +functions1 = ["dmumpsc"]; +functions2 = ["zmumpsc"]; +entrypoint1 = "scidmumps"; +entrypoint2 = "scizmumps"; + +addinter(objects,entrypoint1,functions1) +num_interface = floor(funptr("dmumpsc")/100); +intppty(num_interface) + +addinter(objects,entrypoint2,functions2) + num_interface = floor(funptr("zmumpsc")/100); + intppty(num_interface) + +[units,typs,nams]=file(); +clear units typs +for k=size(nams,'*'):-1:1 + l=strindex(nams(k),'loader.sce'); + if l<>[] then + DIR_SCIMUMPS = part(nams(k),1:l($)-1); + break + end +end + +DIR_SCIMUMPS_DEM=DIR_SCIMUMPS+ "examples/"; + +getf(DIR_SCIMUMPS+"initmumps.sci") +getf(DIR_SCIMUMPS+"dmumps.sci") +getf(DIR_SCIMUMPS+"zmumps.sci") + +add_help_chapter("Interface to the MUMPS package",path+"Help"); + + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/zmumps.sci b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/zmumps.sci new file mode 100644 index 000000000..042ce49a2 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/SCILAB/zmumps.sci @@ -0,0 +1,90 @@ +function id=zmumps(id,mat) + +//************************************************************************************************************** +// [id] = zmumps(id,mat) +// id is a structure (see details in initmumps.m and MUMPS documentation) +// mat is an optional parameter if the job id.job = -1 or -2 +// mat is a square sparse matrix +// informations are return in id fields +// +// ************************************************************************************************************* + + +if (typeof(id) ~= "StructMumps") then + disp("Error. Please call initmumps first."); + return; +end +arithtype=1; + +if id.JOB == -2 then + if id.INST==-9999 then + disp('Error. Uninitialized instance. MUMPS should be called with JOB=-1 first.'); + return; + end + if id.TYPE ~= arithtype then + disp('Error. You are trying to call z/d version on a d/z instance'); + return; + end + // call the C routine zmumpsc + + zmumpsc(id.SYM,id.JOB,id.ICNTL,id.CNTL,id.PERM_IN,id.COLSCA,id.ROWSCA,id.RHS,id.VAR_SCHUR,id.INST,id.REDRHS); + id = []; + return; +end + + +if id.JOB == -1 then + if id.INST~=-9999 then + disp('Error. Already initialized instance.'); + return; + end + // call the C routine zmumpsc + [inform,rinform,sol,inst,schu,redrhs,pivnul_list,sym_perm,uns_perm,icntl,cntl] = zmumpsc(id.SYM,id.JOB,id.ICNTL,id.CNTL,id.PERM_IN,id.COLSCA,id.ROWSCA,id.RHS,id.VAR_SCHUR,id.INST,id.REDRHS); + id.INFOG = inform; + id.RINFOG = rinform; + id.SOL = sol; + id.INST = inst; + id.SCHUR = schu; + id.REDRHS = redrhs; + id.PIVNUL_LIST = pivnul_list; + id.SYM_PERM = sym_perm; + id.UNS_PERM = uns_perm; + id.TYPE=arithtype; + id.ICNTL=icntl; + id.CNTL=cntl; + clear inform rinform sol inst schu redrhs pivnul_list sym_perm uns_perm icntl cntl + return; + +end + +if id.INST ==-9999 then + disp('Uninitialized instance'); + return; +end +// call the C routine zmumpsc + +if id.TYPE ~= arithtype then + disp('You are trying to call z/d version on a d/z instance'); +end + +[inform,rinform,sol,inst,schu,redrhs,pivnul_list,sym_perm,uns_perm,icntl,cntl] = zmumpsc(id.SYM,id.JOB,id.ICNTL,id.CNTL,id.PERM_IN,id.COLSCA,id.ROWSCA,id.RHS,id.VAR_SCHUR,id.INST,id.REDRHS, mat); +id.INFOG = inform; +id.RINFOG = rinform; +id.SOL = sol; +id.INST = inst; +if (id.JOB == 2|id.JOB==4|id.JOB==6) then + if id.SYM == 0 then + id.SCHUR=schu'; + else + id.SCHUR=triu(schu)+tril(schu',-1); + end +end +id.REDRHS = redrhs; +id.PIVNUL_LIST = pivnul_list; +id.SYM_PERM(sym_perm) = [1:size(mat,1)]; +id.UNS_PERM = uns_perm; +id.ICNTL=icntl; +id.CNTL=cntl; +clear inform rinform sol inst schu redrhs pivnul_list sym_perm uns_perm icntl cntl + +endfunction diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/VERSION b/Ipopt-3.13.4/ThirdParty/MUMPS/VERSION new file mode 100644 index 000000000..f0da68f0d --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/VERSION @@ -0,0 +1,2 @@ +MUMPS 4.10.0 +Tue May 10 12:56:32 UTC 2011 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/doc/userguide_4.10.0.pdf b/Ipopt-3.13.4/ThirdParty/MUMPS/doc/userguide_4.10.0.pdf new file mode 100644 index 000000000..0b89a358d Binary files /dev/null and b/Ipopt-3.13.4/ThirdParty/MUMPS/doc/userguide_4.10.0.pdf differ diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/doc/userguide_4.10.0.ps b/Ipopt-3.13.4/ThirdParty/MUMPS/doc/userguide_4.10.0.ps new file mode 100644 index 000000000..f38a132ab Binary files /dev/null and b/Ipopt-3.13.4/ThirdParty/MUMPS/doc/userguide_4.10.0.ps differ diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/examples/Makefile b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/Makefile new file mode 100644 index 000000000..d3c3cc035 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/Makefile @@ -0,0 +1,81 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +topdir = .. +libdir = $(topdir)/lib + +default: d + +.PHONY: default all s d c z clean +.SECONDEXPANSION: + +all: s d c z + +s: ssimpletest +d: dsimpletest c_example +c: csimpletest +z: zsimpletest + + +include $(topdir)/Makefile.inc + +LIBMUMPS_COMMON = $(libdir)/libmumps_common$(PLAT)$(LIBEXT) + + +LIBSMUMPS = $(libdir)/libsmumps$(PLAT)$(LIBEXT) $(LIBMUMPS_COMMON) + +ssimpletest: $(LIBSMUMPS) $$@.o + $(FL) -o $@ $(OPTL) ssimpletest.o $(LIBSMUMPS) $(LORDERINGS) $(LIBS) $(LIBBLAS) $(LIBOTHERS) + + +LIBDMUMPS = $(libdir)/libdmumps$(PLAT)$(LIBEXT) $(LIBMUMPS_COMMON) + +dsimpletest: $(LIBDMUMPS) $$@.o + $(FL) -o $@ $(OPTL) dsimpletest.o $(LIBDMUMPS) $(LORDERINGS) $(LIBS) $(LIBBLAS) $(LIBOTHERS) + + +LIBCMUMPS = $(libdir)/libcmumps$(PLAT)$(LIBEXT) $(LIBMUMPS_COMMON) + +csimpletest: $(LIBCMUMPS) $$@.o + $(FL) -o $@ $(OPTL) csimpletest.o $(LIBCMUMPS) $(LORDERINGS) $(LIBS) $(LIBBLAS) $(LIBOTHERS) + + +LIBZMUMPS = $(libdir)/libzmumps$(PLAT)$(LIBEXT) $(LIBMUMPS_COMMON) + +zsimpletest: $(LIBZMUMPS) $$@.o + $(FL) -o $@ $(OPTL) zsimpletest.o $(LIBZMUMPS) $(LORDERINGS) $(LIBS) $(LIBBLAS) $(LIBOTHERS) + + +c_example: $(LIBDMUMPS) $$@.o + $(FL) -o $@ $(OPTL) $@.o $(LIBDMUMPS) $(LORDERINGS) $(LIBS) $(LIBBLAS) $(LIBOTHERS) + + +.SUFFIXES: .c .F .o +.F.o: + $(FC) $(OPTF) $(INCS) -I. -I$(topdir)/include -c $*.F $(OUTF)$*.o +.c.o: + $(CC) $(OPTC) $(INCS) -I. -I$(topdir)/include -c $*.c $(OUTC)$*.o + + +$(libdir)/libsmumps$(PLAT)$(LIBEXT): + @echo 'Error: you should build the library' $@ 'first' + exit -1 + +$(libdir)/libdmumps$(PLAT)$(LIBEXT): + @echo 'Error: you should build the library' $@ 'first' + exit -1 + +$(libdir)/libcmumps$(PLAT)$(LIBEXT): + @echo 'Error: you should build the library' $@ 'first' + exit -1 + +$(libdir)/libzmumps$(PLAT)$(LIBEXT): + @echo 'Error: you should build the library' $@ 'first' + exit -1 + +$(LIBMUMPS_COMMON): + @echo 'Error: you should build the library' $@ 'first' + exit -1 + +clean: + $(RM) *.o [sdcz]simpletest c_example diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/examples/README b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/README new file mode 100644 index 000000000..7c29c1f69 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/README @@ -0,0 +1,35 @@ + +* Supposing the MUMPS libraries with appropriate arithmetic have been +generated, you may compile the example drivers by typing either + + make (which defaults to make d) + make s + make d + make c + make z +or make all + + +* For the small Fortran driver, see comments in simpletest.F and try for example + "mpirun -np 2 ./ssimpletest < input_simpletest_real" + "mpirun -np 2 ./dsimpletest < input_simpletest_real" + "mpirun -np 2 ./csimpletest < input_simpletest_cmplx" + "mpirun -np 2 ./zsimpletest < input_simpletest_cmplx" + if you are using the parallel version of MUMPS, or + + "./ssimpletest < input_simpletest_real" + "./dsimpletest < input_simpletest_real" + "./csimpletest < input_simpletest_cmplx" + "./zsimpletest < input_simpletest_cmplx" + + if you are using the sequential version. + + The solution should be (1,2,3,4,5) + + +* For the small C driver, only an example using double arithmetic is available. + Try for example + "mpirun -np 3 ./c_example" (parallel version),or + "./c_example" (sequential version). + The solution should be (1,2) + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/examples/c_example.c b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/c_example.c new file mode 100644 index 000000000..7a350ad93 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/c_example.c @@ -0,0 +1,84 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + */ +/* Example program using the C interface to the + * double real arithmetic version of MUMPS, dmumps_c. + * We solve the system A x = RHS with + * A = diag(1 2) and RHS = [1 4]^T + * Solution is [1 2]^T */ +#include +#include +#ifdef MPI +#include "mpi.h" +#else +#include "mumps_mpi.h" +#endif +#include "dmumps_c.h" +#define JOB_INIT -1 +#define JOB_END -2 +#define USE_COMM_WORLD -987654 + +#if defined(MAIN_COMP) +/* + * Some Fortran compilers (COMPAQ fort) define main inside + * their runtime library while a Fortran program translates + * to MAIN_ or MAIN__ which is then called from "main". This + * is annoying because MAIN__ has no arguments and we must + * define argc/argv arbitrarily !! + */ +int MAIN__(); +int MAIN_() + { + return MAIN__(); + } + +int MAIN__() +{ + int argc=1; + char * name = "c_example"; + char ** argv ; +#else +int main(int argc, char ** argv) +{ +#endif + DMUMPS_STRUC_C id; + int n = 2; + int nz = 2; + int irn[] = {1,2}; + int jcn[] = {1,2}; + double a[2]; + double rhs[2]; + + int myid, ierr; +#if defined(MAIN_COMP) + argv = &name; +#endif + ierr = MPI_Init(&argc, &argv); + ierr = MPI_Comm_rank(MPI_COMM_WORLD, &myid); + /* Define A and rhs */ + rhs[0]=1.0;rhs[1]=4.0; + a[0]=1.0;a[1]=2.0; + + /* Initialize a MUMPS instance. Use MPI_COMM_WORLD */ + id.job=JOB_INIT; id.par=1; id.sym=0;id.comm_fortran=USE_COMM_WORLD; + dmumps_c(&id); + /* Define the problem on the host */ + if (myid == 0) { + id.n = n; id.nz =nz; id.irn=irn; id.jcn=jcn; + id.a = a; id.rhs = rhs; + } +#define ICNTL(I) icntl[(I)-1] /* macro s.t. indices match documentation */ +/* No outputs */ + id.ICNTL(1)=-1; id.ICNTL(2)=-1; id.ICNTL(3)=-1; id.ICNTL(4)=0; +/* Call the MUMPS package. */ + id.job=6; + dmumps_c(&id); + id.job=JOB_END; dmumps_c(&id); /* Terminate instance */ + if (myid == 0) { + printf("Solution is : (%8.2f %8.2f)\n", rhs[0],rhs[1]); + } + ierr = MPI_Finalize(); + return 0; +} diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/examples/csimpletest.F b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/csimpletest.F new file mode 100644 index 000000000..5746d7c2e --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/csimpletest.F @@ -0,0 +1,53 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C + PROGRAM MUMPS_TEST + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'cmumps_struc.h' + TYPE (CMUMPS_STRUC) mumps_par + INTEGER IERR, I + CALL MPI_INIT(IERR) +C Define a communicator for the package. + mumps_par%COMM = MPI_COMM_WORLD +C Initialize an instance of the package +C for L U factorization (sym = 0, with working host) + mumps_par%JOB = -1 + mumps_par%SYM = 0 + mumps_par%PAR = 1 + CALL CMUMPS(mumps_par) +C Define problem on the host (processor 0) + IF ( mumps_par%MYID .eq. 0 ) THEN + READ(5,*) mumps_par%N + READ(5,*) mumps_par%NZ + ALLOCATE( mumps_par%IRN ( mumps_par%NZ ) ) + ALLOCATE( mumps_par%JCN ( mumps_par%NZ ) ) + ALLOCATE( mumps_par%A( mumps_par%NZ ) ) + ALLOCATE( mumps_par%RHS ( mumps_par%N ) ) + DO I = 1, mumps_par%NZ + READ(5,*) mumps_par%IRN(I),mumps_par%JCN(I),mumps_par%A(I) + END DO + DO I = 1, mumps_par%N + READ(5,*) mumps_par%RHS(I) + END DO + END IF +C Call package for solution + mumps_par%JOB = 6 + CALL CMUMPS(mumps_par) +C Solution has been assembled on the host + IF ( mumps_par%MYID .eq. 0 ) THEN + WRITE( 6, * ) ' Solution is ',(mumps_par%RHS(I),I=1,mumps_par%N) + END IF +C Deallocate user data + IF ( mumps_par%MYID .eq. 0 )THEN + DEALLOCATE( mumps_par%IRN ) + DEALLOCATE( mumps_par%JCN ) + DEALLOCATE( mumps_par%A ) + DEALLOCATE( mumps_par%RHS ) + END IF +C Destroy the instance (deallocate internal data structures) + mumps_par%JOB = -2 + CALL CMUMPS(mumps_par) + CALL MPI_FINALIZE(IERR) + STOP + END diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/examples/dsimpletest.F b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/dsimpletest.F new file mode 100644 index 000000000..5baa5643d --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/dsimpletest.F @@ -0,0 +1,53 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C + PROGRAM MUMPS_TEST + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'dmumps_struc.h' + TYPE (DMUMPS_STRUC) mumps_par + INTEGER IERR, I + CALL MPI_INIT(IERR) +C Define a communicator for the package. + mumps_par%COMM = MPI_COMM_WORLD +C Initialize an instance of the package +C for L U factorization (sym = 0, with working host) + mumps_par%JOB = -1 + mumps_par%SYM = 0 + mumps_par%PAR = 1 + CALL DMUMPS(mumps_par) +C Define problem on the host (processor 0) + IF ( mumps_par%MYID .eq. 0 ) THEN + READ(5,*) mumps_par%N + READ(5,*) mumps_par%NZ + ALLOCATE( mumps_par%IRN ( mumps_par%NZ ) ) + ALLOCATE( mumps_par%JCN ( mumps_par%NZ ) ) + ALLOCATE( mumps_par%A( mumps_par%NZ ) ) + ALLOCATE( mumps_par%RHS ( mumps_par%N ) ) + DO I = 1, mumps_par%NZ + READ(5,*) mumps_par%IRN(I),mumps_par%JCN(I),mumps_par%A(I) + END DO + DO I = 1, mumps_par%N + READ(5,*) mumps_par%RHS(I) + END DO + END IF +C Call package for solution + mumps_par%JOB = 6 + CALL DMUMPS(mumps_par) +C Solution has been assembled on the host + IF ( mumps_par%MYID .eq. 0 ) THEN + WRITE( 6, * ) ' Solution is ',(mumps_par%RHS(I),I=1,mumps_par%N) + END IF +C Deallocate user data + IF ( mumps_par%MYID .eq. 0 )THEN + DEALLOCATE( mumps_par%IRN ) + DEALLOCATE( mumps_par%JCN ) + DEALLOCATE( mumps_par%A ) + DEALLOCATE( mumps_par%RHS ) + END IF +C Destroy the instance (deallocate internal data structures) + mumps_par%JOB = -2 + CALL DMUMPS(mumps_par) + CALL MPI_FINALIZE(IERR) + STOP + END diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/examples/input_simpletest_cmplx b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/input_simpletest_cmplx new file mode 100644 index 000000000..6ca70a693 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/input_simpletest_cmplx @@ -0,0 +1,20 @@ +5 : N +12 : NZ +1 2 (3.0,0.0) +2 3 (-3.0,0.0) +4 3 (2.0,0.0) +5 5 (1.0,0.0) +2 1 (3.0,0.0) +1 1 (2.0,0.0) +5 2 (4.0,0.0) +3 4 (2.0,0.0) +2 5 (6.0,0.0) +3 2 (-1.0,0.0) +1 3 (4.0,0.0) +3 3 (1.0,0.0) +(20.0,0.0) +(24.0,0.0) +(9.0,0.0) +(6.0,0.0) +(13.0,0.0) : RHS + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/examples/input_simpletest_real b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/input_simpletest_real new file mode 100644 index 000000000..9b6067b02 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/input_simpletest_real @@ -0,0 +1,20 @@ +5 :N +12 :NZ +1 2 3.0 +2 3 -3.0 +4 3 2.0 +5 5 1.0 +2 1 3.0 +1 1 2.0 +5 2 4.0 +3 4 2.0 +2 5 6.0 +3 2 -1.0 +1 3 4.0 +3 3 1.0 :values +20.0 +24.0 +9.0 +6.0 +13.0 :RHS + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/examples/ssimpletest.F b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/ssimpletest.F new file mode 100644 index 000000000..5b399aa85 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/ssimpletest.F @@ -0,0 +1,53 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C + PROGRAM MUMPS_TEST + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'smumps_struc.h' + TYPE (SMUMPS_STRUC) mumps_par + INTEGER IERR, I + CALL MPI_INIT(IERR) +C Define a communicator for the package. + mumps_par%COMM = MPI_COMM_WORLD +C Initialize an instance of the package +C for L U factorization (sym = 0, with working host) + mumps_par%JOB = -1 + mumps_par%SYM = 0 + mumps_par%PAR = 1 + CALL SMUMPS(mumps_par) +C Define problem on the host (processor 0) + IF ( mumps_par%MYID .eq. 0 ) THEN + READ(5,*) mumps_par%N + READ(5,*) mumps_par%NZ + ALLOCATE( mumps_par%IRN ( mumps_par%NZ ) ) + ALLOCATE( mumps_par%JCN ( mumps_par%NZ ) ) + ALLOCATE( mumps_par%A( mumps_par%NZ ) ) + ALLOCATE( mumps_par%RHS ( mumps_par%N ) ) + DO I = 1, mumps_par%NZ + READ(5,*) mumps_par%IRN(I),mumps_par%JCN(I),mumps_par%A(I) + END DO + DO I = 1, mumps_par%N + READ(5,*) mumps_par%RHS(I) + END DO + END IF +C Call package for solution + mumps_par%JOB = 6 + CALL SMUMPS(mumps_par) +C Solution has been assembled on the host + IF ( mumps_par%MYID .eq. 0 ) THEN + WRITE( 6, * ) ' Solution is ',(mumps_par%RHS(I),I=1,mumps_par%N) + END IF +C Deallocate user data + IF ( mumps_par%MYID .eq. 0 )THEN + DEALLOCATE( mumps_par%IRN ) + DEALLOCATE( mumps_par%JCN ) + DEALLOCATE( mumps_par%A ) + DEALLOCATE( mumps_par%RHS ) + END IF +C Destroy the instance (deallocate internal data structures) + mumps_par%JOB = -2 + CALL SMUMPS(mumps_par) + CALL MPI_FINALIZE(IERR) + STOP + END diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/examples/zsimpletest.F b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/zsimpletest.F new file mode 100644 index 000000000..77822b086 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/examples/zsimpletest.F @@ -0,0 +1,53 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C + PROGRAM MUMPS_TEST + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'zmumps_struc.h' + TYPE (ZMUMPS_STRUC) mumps_par + INTEGER IERR, I + CALL MPI_INIT(IERR) +C Define a communicator for the package. + mumps_par%COMM = MPI_COMM_WORLD +C Initialize an instance of the package +C for L U factorization (sym = 0, with working host) + mumps_par%JOB = -1 + mumps_par%SYM = 0 + mumps_par%PAR = 1 + CALL ZMUMPS(mumps_par) +C Define problem on the host (processor 0) + IF ( mumps_par%MYID .eq. 0 ) THEN + READ(5,*) mumps_par%N + READ(5,*) mumps_par%NZ + ALLOCATE( mumps_par%IRN ( mumps_par%NZ ) ) + ALLOCATE( mumps_par%JCN ( mumps_par%NZ ) ) + ALLOCATE( mumps_par%A( mumps_par%NZ ) ) + ALLOCATE( mumps_par%RHS ( mumps_par%N ) ) + DO I = 1, mumps_par%NZ + READ(5,*) mumps_par%IRN(I),mumps_par%JCN(I),mumps_par%A(I) + END DO + DO I = 1, mumps_par%N + READ(5,*) mumps_par%RHS(I) + END DO + END IF +C Call package for solution + mumps_par%JOB = 6 + CALL ZMUMPS(mumps_par) +C Solution has been assembled on the host + IF ( mumps_par%MYID .eq. 0 ) THEN + WRITE( 6, * ) ' Solution is ',(mumps_par%RHS(I),I=1,mumps_par%N) + END IF +C Deallocate user data + IF ( mumps_par%MYID .eq. 0 )THEN + DEALLOCATE( mumps_par%IRN ) + DEALLOCATE( mumps_par%JCN ) + DEALLOCATE( mumps_par%A ) + DEALLOCATE( mumps_par%RHS ) + END IF +C Destroy the instance (deallocate internal data structures) + mumps_par%JOB = -2 + CALL ZMUMPS(mumps_par) + CALL MPI_FINALIZE(IERR) + STOP + END diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/cmumps_c.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/cmumps_c.h new file mode 100644 index 000000000..db3d17e26 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/cmumps_c.h @@ -0,0 +1,159 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ + +/* Mostly written in march 2002 (JYL) */ + +#ifndef CMUMPS_C_H +#define CMUMPS_C_H + +#ifdef __cplusplus +extern "C" { +#endif + +#include "mumps_compat.h" +/* Next line defines MUMPS_INT, CMUMPS_COMPLEX and CMUMPS_REAL */ +#include "mumps_c_types.h" + +#ifndef MUMPS_VERSION +/* Protected in case headers of other arithmetics are included */ +#define MUMPS_VERSION "4.10.0" +#endif +#ifndef MUMPS_VERSION_MAX_LEN +#define MUMPS_VERSION_MAX_LEN 14 +#endif + +/* + * Definition of the (simplified) MUMPS C structure. + * NB: CMUMPS_COMPLEX are REAL types in s and d arithmetics. + */ +typedef struct { + + MUMPS_INT sym, par, job; + MUMPS_INT comm_fortran; /* Fortran communicator */ + MUMPS_INT icntl[40]; + CMUMPS_REAL cntl[15]; + MUMPS_INT n; + + MUMPS_INT nz_alloc; /* used in matlab interface to decide if we + free + malloc when we have large variation */ + + /* Assembled entry */ + MUMPS_INT nz; + MUMPS_INT *irn; + MUMPS_INT *jcn; + CMUMPS_COMPLEX *a; + + /* Distributed entry */ + MUMPS_INT nz_loc; + MUMPS_INT *irn_loc; + MUMPS_INT *jcn_loc; + CMUMPS_COMPLEX *a_loc; + + /* Element entry */ + MUMPS_INT nelt; + MUMPS_INT *eltptr; + MUMPS_INT *eltvar; + CMUMPS_COMPLEX *a_elt; + + /* Ordering, if given by user */ + MUMPS_INT *perm_in; + + /* Orderings returned to user */ + MUMPS_INT *sym_perm; /* symmetric permutation */ + MUMPS_INT *uns_perm; /* column permutation */ + + /* Scaling (input only in this version) */ + CMUMPS_REAL *colsca; + CMUMPS_REAL *rowsca; + + /* RHS, solution, ouptput data and statistics */ + CMUMPS_COMPLEX *rhs, *redrhs, *rhs_sparse, *sol_loc; + MUMPS_INT *irhs_sparse, *irhs_ptr, *isol_loc; + MUMPS_INT nrhs, lrhs, lredrhs, nz_rhs, lsol_loc; + MUMPS_INT schur_mloc, schur_nloc, schur_lld; + MUMPS_INT mblock, nblock, nprow, npcol; + MUMPS_INT info[40],infog[40]; + CMUMPS_REAL rinfo[40], rinfog[40]; + + /* Null space */ + MUMPS_INT deficiency; + MUMPS_INT *pivnul_list; + MUMPS_INT *mapping; + + /* Schur */ + MUMPS_INT size_schur; + MUMPS_INT *listvar_schur; + CMUMPS_COMPLEX *schur; + + /* Internal parameters */ + MUMPS_INT instance_number; + CMUMPS_COMPLEX *wk_user; + + /* Version number: length=14 in FORTRAN + 1 for final \0 + 1 for alignment */ + char version_number[MUMPS_VERSION_MAX_LEN + 1 + 1]; + /* For out-of-core */ + char ooc_tmpdir[256]; + char ooc_prefix[64]; + /* To save the matrix in matrix market format */ + char write_problem[256]; + MUMPS_INT lwk_user; + +} CMUMPS_STRUC_C; + + +void MUMPS_CALL +cmumps_c( CMUMPS_STRUC_C * cmumps_par ); + +#ifdef __cplusplus +} +#endif + +#endif /* CMUMPS_C_H */ + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/cmumps_root.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/cmumps_root.h new file mode 100644 index 000000000..a731dfb37 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/cmumps_root.h @@ -0,0 +1,75 @@ +! +! This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +! +! +! This version of MUMPS is provided to you free of charge. It is public +! domain, based on public domain software developed during the Esprit IV +! European project PARASOL (1996-1999). Since this first public domain +! version in 1999, research and developments have been supported by the +! following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +! INRIA, and University of Bordeaux. +! +! The MUMPS team at the moment of releasing this version includes +! Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +! Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +! Ucar and Clement Weisbecker. +! +! We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +! Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +! Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +! Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +! have been contributing to this project. +! +! Up-to-date copies of the MUMPS package can be obtained +! from the Web pages: +! http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +! +! +! THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +! EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +! +! +! User documentation of any code that uses this software can +! include this complete notice. You can acknowledge (using +! references [1] and [2]) the contribution of this package +! in any scientific publication dependent upon the use of the +! package. You shall use reasonable endeavours to notify +! the authors of the package of this publication. +! +! [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +! A fully asynchronous multifrontal solver using distributed dynamic +! scheduling, SIAM Journal of Matrix Analysis and Applications, +! Vol 23, No 1, pp 15-41 (2001). +! +! [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +! S. Pralet, Hybrid scheduling for the parallel solution of linear +! systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +! + TYPE CMUMPS_ROOT_STRUC + SEQUENCE + INTEGER :: MBLOCK, NBLOCK, NPROW, NPCOL + INTEGER :: MYROW, MYCOL + INTEGER :: SCHUR_MLOC, SCHUR_NLOC, SCHUR_LLD + INTEGER :: RHS_NLOC + INTEGER :: ROOT_SIZE, TOT_ROOT_SIZE +! descriptor for scalapack + INTEGER, DIMENSION( 9 ) :: DESCRIPTOR + INTEGER :: CNTXT_BLACS, LPIV, rootpad0 + INTEGER, DIMENSION(:), POINTER :: RG2L_ROW + INTEGER, DIMENSION(:), POINTER :: RG2L_COL + INTEGER , DIMENSION(:), POINTER :: IPIV, rootpad1 +! Centralized master of root + COMPLEX, DIMENSION(:), POINTER :: RHS_CNTR_MASTER_ROOT +! Used to access Schur easily from root structure + COMPLEX, DIMENSION(:), POINTER :: SCHUR_POINTER +! for try_null_space preprocessing constant only: + COMPLEX, DIMENSION(:), POINTER :: QR_TAU, rootpad2 +! Fwd in facto: +! case of scalapack root: to store RHS in 2D block cyclic +! format compatible with root distribution + COMPLEX, DIMENSION(:,:), POINTER :: RHS_ROOT, rootpad +! for try_nullspace preprocessing constant only: + REAL :: QR_RCOND, rootpad3 + LOGICAL yes, gridinit_done +! + END TYPE CMUMPS_ROOT_STRUC diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/cmumps_struc.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/cmumps_struc.h new file mode 100644 index 000000000..ff5a0347b --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/cmumps_struc.h @@ -0,0 +1,265 @@ +! +! This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +! +! +! This version of MUMPS is provided to you free of charge. It is public +! domain, based on public domain software developed during the Esprit IV +! European project PARASOL (1996-1999). Since this first public domain +! version in 1999, research and developments have been supported by the +! following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +! INRIA, and University of Bordeaux. +! +! The MUMPS team at the moment of releasing this version includes +! Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +! Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +! Ucar and Clement Weisbecker. +! +! We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +! Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +! Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +! Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +! have been contributing to this project. +! +! Up-to-date copies of the MUMPS package can be obtained +! from the Web pages: +! http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +! +! +! THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +! EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +! +! +! User documentation of any code that uses this software can +! include this complete notice. You can acknowledge (using +! references [1] and [2]) the contribution of this package +! in any scientific publication dependent upon the use of the +! package. You shall use reasonable endeavours to notify +! the authors of the package of this publication. +! +! [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +! A fully asynchronous multifrontal solver using distributed dynamic +! scheduling, SIAM Journal of Matrix Analysis and Applications, +! Vol 23, No 1, pp 15-41 (2001). +! +! [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +! S. Pralet, Hybrid scheduling for the parallel solution of linear +! systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +! + INCLUDE 'cmumps_root.h' + TYPE CMUMPS_STRUC + SEQUENCE +! +! This structure contains all parameters +! for the interface to the user, plus internal +! information from the solver +! +! ***************** +! INPUT PARAMETERS +! ***************** +! ----------------- +! MPI Communicator +! ----------------- + INTEGER COMM +! ------------------ +! Problem definition +! ------------------ +! Solver (SYM=0 unsymmetric,SYM=1 symmetric Positive Definite, +! SYM=2 general symmetric) +! Type of parallelism (PAR=1 host working, PAR=0 host not working) + INTEGER SYM, PAR + INTEGER JOB +! -------------------- +! Order of Input matrix +! -------------------- + INTEGER N +! +! ---------------------------------------- +! Assembled input matrix : User interface +! ---------------------------------------- + INTEGER NZ + COMPLEX, DIMENSION(:), POINTER :: A + INTEGER, DIMENSION(:), POINTER :: IRN, JCN + REAL, DIMENSION(:), POINTER :: COLSCA, ROWSCA, pad0 +! +! ------------------------------------ +! Case of distributed assembled matrix +! matrix on entry: +! ------------------------------------ + INTEGER NZ_loc, pad1 + INTEGER, DIMENSION(:), POINTER :: IRN_loc, JCN_loc + COMPLEX, DIMENSION(:), POINTER :: A_loc, pad2 +! +! ---------------------------------------- +! Unassembled input matrix: User interface +! ---------------------------------------- + INTEGER NELT, pad3 + INTEGER, DIMENSION(:), POINTER :: ELTPTR + INTEGER, DIMENSION(:), POINTER :: ELTVAR + COMPLEX, DIMENSION(:), POINTER :: A_ELT, pad4 +! +! --------------------------------------------- +! Symmetric permutation : +! PERM_IN if given by user (optional) +! --------------------------------------------- + INTEGER, DIMENSION(:), POINTER :: PERM_IN +! +! +! ****************** +! INPUT/OUTPUT data +! ****************** +! -------------------------------------------------------- +! RHS / SOL_loc +! ------------- +! right-hand side and solution +! ------------------------------------------------------- + COMPLEX, DIMENSION(:), POINTER :: RHS, REDRHS + COMPLEX, DIMENSION(:), POINTER :: RHS_SPARSE + COMPLEX, DIMENSION(:), POINTER :: SOL_loc + INTEGER, DIMENSION(:), POINTER :: IRHS_SPARSE + INTEGER, DIMENSION(:), POINTER :: IRHS_PTR + INTEGER, DIMENSION(:), POINTER :: ISOL_loc + INTEGER LRHS, NRHS, NZ_RHS, LSOL_loc, LREDRHS + INTEGER pad5 +! ---------------------------- +! Control parameters, +! statistics and output data +! --------------------------- + INTEGER ICNTL(40) + INTEGER INFO(40) + INTEGER INFOG(40) + REAL COST_SUBTREES + REAL CNTL(15) + REAL RINFO(40) + REAL RINFOG(40) +! --------------------------------------------------------- +! Permutations computed during analysis: +! SYM_PERM: Symmetric permutation +! UNS_PERM: Column permutations (optionnal) +! --------------------------------------------------------- + INTEGER, DIMENSION(:), POINTER :: SYM_PERM, UNS_PERM +! +! ----- +! Schur +! ----- + INTEGER NPROW, NPCOL, MBLOCK, NBLOCK + INTEGER SCHUR_MLOC, SCHUR_NLOC, SCHUR_LLD + INTEGER SIZE_SCHUR + COMPLEX, DIMENSION(:), POINTER :: SCHUR + COMPLEX, DIMENSION(:), POINTER :: SCHUR_CINTERFACE + INTEGER, DIMENSION(:), POINTER :: LISTVAR_SCHUR +! ------------------------------------- +! Case of distributed matrix on entry: +! CMUMPS potentially provides mapping +! ------------------------------------- + INTEGER, DIMENSION(:), POINTER :: MAPPING +! -------------- +! Version number +! -------------- + CHARACTER(LEN=14) VERSION_NUMBER +! ----------- +! Out-of-core +! ----------- + CHARACTER(LEN=255) :: OOC_TMPDIR + CHARACTER(LEN=63) :: OOC_PREFIX +! ------------------------------------------ +! To save the matrix in matrix market format +! ------------------------------------------ + CHARACTER(LEN=255) WRITE_PROBLEM + CHARACTER(LEN=5) :: pad8 +! +! +! ********************** +! INTERNAL Working data +! ********************* + INTEGER(8) :: KEEP8(150), MAX_SURF_MASTER + INTEGER INST_Number +! For MPI + INTEGER COMM_NODES, MYID_NODES, COMM_LOAD + INTEGER MYID, NPROCS, NSLAVES + INTEGER ASS_IRECV + INTEGER LBUFR + INTEGER LBUFR_BYTES + INTEGER, DIMENSION(:), POINTER :: POIDS + INTEGER, DIMENSION(:), POINTER :: BUFR +! IS is used for the factors + workspace for contrib. blocks + INTEGER, DIMENSION(:), POINTER :: IS +! IS1 (maxis1) contains working arrays computed +! and used only during analysis + INTEGER, DIMENSION(:), POINTER :: IS1 +! For analysis/facto/solve phases + INTEGER MAXIS1, Deficiency + INTEGER KEEP(500) +! The following data/arrays are computed during the analysis +! phase and used during the factorization and solve phases. + INTEGER LNA + INTEGER NBSA + INTEGER,POINTER,DIMENSION(:)::STEP, NE_STEPS, ND_STEPS +! Info for pruning tree + INTEGER,POINTER,DIMENSION(:)::Step2node +! --------------------- + INTEGER,POINTER,DIMENSION(:)::FRERE_STEPS, DAD_STEPS + INTEGER,POINTER,DIMENSION(:)::FILS, PTRAR, FRTPTR, FRTELT + INTEGER,POINTER,DIMENSION(:)::NA, PROCNODE_STEPS +! The two pointer arrays computed in facto and used by the solve +! (except the factors) are PTLUST_S and PTRFAC. + INTEGER, DIMENSION(:), POINTER :: PTLUST_S + INTEGER(8), DIMENSION(:), POINTER :: PTRFAC +! main real working arrays for factorization/solve phases + COMPLEX, DIMENSION(:), POINTER :: S +! Information on mapping + INTEGER, DIMENSION(:), POINTER :: PROCNODE +! Input matrix ready for numerical assembly +! -arrowhead format in case of assembled matrix +! -element format otherwise + INTEGER, DIMENSION(:), POINTER :: INTARR + COMPLEX, DIMENSION(:), POINTER :: DBLARR +! Element entry: internal data + INTEGER NELT_loc, LELTVAR, NA_ELT, pad11 + INTEGER, DIMENSION(:), POINTER :: ELTPROC +! Candidates and node partitionning + INTEGER, DIMENSION(:,:), POINTER :: CANDIDATES + INTEGER, DIMENSION(:), POINTER :: ISTEP_TO_INIV2 + INTEGER, DIMENSION(:), POINTER :: FUTURE_NIV2 + INTEGER, DIMENSION(:,:), POINTER :: TAB_POS_IN_PERE + LOGICAL, DIMENSION(:), POINTER :: I_AM_CAND +! For heterogeneous architecture + INTEGER, DIMENSION(:), POINTER :: MEM_DIST +! Compressed RHS + INTEGER, DIMENSION(:), POINTER :: POSINRHSCOMP + COMPLEX, DIMENSION(:), POINTER :: RHSCOMP +! Info on the subtrees to be used during factorization + DOUBLE PRECISION, DIMENSION(:), POINTER :: MEM_SUBTREE + DOUBLE PRECISION, DIMENSION(:), POINTER :: COST_TRAV + INTEGER, DIMENSION(:), POINTER :: MY_ROOT_SBTR + INTEGER, DIMENSION(:), POINTER :: MY_FIRST_LEAF + INTEGER, DIMENSION(:), POINTER :: MY_NB_LEAF + INTEGER, DIMENSION(:), POINTER :: DEPTH_FIRST + INTEGER, DIMENSION(:), POINTER :: DEPTH_FIRST_SEQ + INTEGER, DIMENSION(:), POINTER :: SBTR_ID + COMPLEX, DIMENSION(:), POINTER :: WK_USER + INTEGER :: NBSA_LOCAL + INTEGER :: LWK_USER +! Internal control array + REAL DKEEP(30) +! For simulating parallel out-of-core stack. + DOUBLE PRECISION, DIMENSION(:),POINTER ::CB_SON_SIZE, pad12 +! Instance number used/managed by the C/F77 interface + INTEGER INSTANCE_NUMBER +! OOC management data that must persist from factorization to solve. + INTEGER OOC_MAX_NB_NODES_FOR_ZONE + INTEGER, DIMENSION(:,:), POINTER :: OOC_INODE_SEQUENCE, pad13 + INTEGER(8),DIMENSION(:,:), POINTER :: OOC_SIZE_OF_BLOCK + INTEGER(8), DIMENSION(:,:), POINTER :: OOC_VADDR + INTEGER,DIMENSION(:), POINTER :: OOC_TOTAL_NB_NODES + INTEGER,DIMENSION(:), POINTER :: OOC_NB_FILES + CHARACTER,DIMENSION(:,:), POINTER :: OOC_FILE_NAMES + INTEGER,DIMENSION(:), POINTER :: OOC_FILE_NAME_LENGTH +! Indices of nul pivots + INTEGER,DIMENSION(:), POINTER :: PIVNUL_LIST +! Array needed to manage additionnal candidate processor + INTEGER, DIMENSION(:,:), POINTER :: SUP_PROC, pad14 +! ------------------------ +! Root structure(internal) +! ------------------------ + TYPE (CMUMPS_ROOT_STRUC) :: root + END TYPE CMUMPS_STRUC diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/dmumps_c.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/dmumps_c.h new file mode 100644 index 000000000..1d5c2c918 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/dmumps_c.h @@ -0,0 +1,159 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ + +/* Mostly written in march 2002 (JYL) */ + +#ifndef DMUMPS_C_H +#define DMUMPS_C_H + +#ifdef __cplusplus +extern "C" { +#endif + +#include "mumps_compat.h" +/* Next line defines MUMPS_INT, DMUMPS_COMPLEX and DMUMPS_REAL */ +#include "mumps_c_types.h" + +#ifndef MUMPS_VERSION +/* Protected in case headers of other arithmetics are included */ +#define MUMPS_VERSION "4.10.0" +#endif +#ifndef MUMPS_VERSION_MAX_LEN +#define MUMPS_VERSION_MAX_LEN 14 +#endif + +/* + * Definition of the (simplified) MUMPS C structure. + * NB: DMUMPS_COMPLEX are REAL types in s and d arithmetics. + */ +typedef struct { + + MUMPS_INT sym, par, job; + MUMPS_INT comm_fortran; /* Fortran communicator */ + MUMPS_INT icntl[40]; + DMUMPS_REAL cntl[15]; + MUMPS_INT n; + + MUMPS_INT nz_alloc; /* used in matlab interface to decide if we + free + malloc when we have large variation */ + + /* Assembled entry */ + MUMPS_INT nz; + MUMPS_INT *irn; + MUMPS_INT *jcn; + DMUMPS_COMPLEX *a; + + /* Distributed entry */ + MUMPS_INT nz_loc; + MUMPS_INT *irn_loc; + MUMPS_INT *jcn_loc; + DMUMPS_COMPLEX *a_loc; + + /* Element entry */ + MUMPS_INT nelt; + MUMPS_INT *eltptr; + MUMPS_INT *eltvar; + DMUMPS_COMPLEX *a_elt; + + /* Ordering, if given by user */ + MUMPS_INT *perm_in; + + /* Orderings returned to user */ + MUMPS_INT *sym_perm; /* symmetric permutation */ + MUMPS_INT *uns_perm; /* column permutation */ + + /* Scaling (input only in this version) */ + DMUMPS_REAL *colsca; + DMUMPS_REAL *rowsca; + + /* RHS, solution, ouptput data and statistics */ + DMUMPS_COMPLEX *rhs, *redrhs, *rhs_sparse, *sol_loc; + MUMPS_INT *irhs_sparse, *irhs_ptr, *isol_loc; + MUMPS_INT nrhs, lrhs, lredrhs, nz_rhs, lsol_loc; + MUMPS_INT schur_mloc, schur_nloc, schur_lld; + MUMPS_INT mblock, nblock, nprow, npcol; + MUMPS_INT info[40],infog[40]; + DMUMPS_REAL rinfo[40], rinfog[40]; + + /* Null space */ + MUMPS_INT deficiency; + MUMPS_INT *pivnul_list; + MUMPS_INT *mapping; + + /* Schur */ + MUMPS_INT size_schur; + MUMPS_INT *listvar_schur; + DMUMPS_COMPLEX *schur; + + /* Internal parameters */ + MUMPS_INT instance_number; + DMUMPS_COMPLEX *wk_user; + + /* Version number: length=14 in FORTRAN + 1 for final \0 + 1 for alignment */ + char version_number[MUMPS_VERSION_MAX_LEN + 1 + 1]; + /* For out-of-core */ + char ooc_tmpdir[256]; + char ooc_prefix[64]; + /* To save the matrix in matrix market format */ + char write_problem[256]; + MUMPS_INT lwk_user; + +} DMUMPS_STRUC_C; + + +void MUMPS_CALL +dmumps_c( DMUMPS_STRUC_C * dmumps_par ); + +#ifdef __cplusplus +} +#endif + +#endif /* DMUMPS_C_H */ + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/dmumps_root.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/dmumps_root.h new file mode 100644 index 000000000..667c9f581 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/dmumps_root.h @@ -0,0 +1,75 @@ +! +! This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +! +! +! This version of MUMPS is provided to you free of charge. It is public +! domain, based on public domain software developed during the Esprit IV +! European project PARASOL (1996-1999). Since this first public domain +! version in 1999, research and developments have been supported by the +! following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +! INRIA, and University of Bordeaux. +! +! The MUMPS team at the moment of releasing this version includes +! Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +! Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +! Ucar and Clement Weisbecker. +! +! We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +! Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +! Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +! Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +! have been contributing to this project. +! +! Up-to-date copies of the MUMPS package can be obtained +! from the Web pages: +! http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +! +! +! THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +! EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +! +! +! User documentation of any code that uses this software can +! include this complete notice. You can acknowledge (using +! references [1] and [2]) the contribution of this package +! in any scientific publication dependent upon the use of the +! package. You shall use reasonable endeavours to notify +! the authors of the package of this publication. +! +! [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +! A fully asynchronous multifrontal solver using distributed dynamic +! scheduling, SIAM Journal of Matrix Analysis and Applications, +! Vol 23, No 1, pp 15-41 (2001). +! +! [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +! S. Pralet, Hybrid scheduling for the parallel solution of linear +! systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +! + TYPE DMUMPS_ROOT_STRUC + SEQUENCE + INTEGER :: MBLOCK, NBLOCK, NPROW, NPCOL + INTEGER :: MYROW, MYCOL + INTEGER :: SCHUR_MLOC, SCHUR_NLOC, SCHUR_LLD + INTEGER :: RHS_NLOC + INTEGER :: ROOT_SIZE, TOT_ROOT_SIZE +! descriptor for scalapack + INTEGER, DIMENSION( 9 ) :: DESCRIPTOR + INTEGER :: CNTXT_BLACS, LPIV, rootpad0 + INTEGER, DIMENSION(:), POINTER :: RG2L_ROW + INTEGER, DIMENSION(:), POINTER :: RG2L_COL + INTEGER , DIMENSION(:), POINTER :: IPIV, rootpad1 +! Centralized master of root + DOUBLE PRECISION, DIMENSION(:), POINTER :: RHS_CNTR_MASTER_ROOT +! Used to access Schur easily from root structure + DOUBLE PRECISION, DIMENSION(:), POINTER :: SCHUR_POINTER +! for try_null_space preprocessing constant only: + DOUBLE PRECISION, DIMENSION(:), POINTER :: QR_TAU, rootpad2 +! Fwd in facto: +! case of scalapack root: to store RHS in 2D block cyclic +! format compatible with root distribution + DOUBLE PRECISION, DIMENSION(:,:), POINTER :: RHS_ROOT, rootpad +! for try_nullspace preprocessing constant only: + DOUBLE PRECISION :: QR_RCOND, rootpad3 + LOGICAL yes, gridinit_done +! + END TYPE DMUMPS_ROOT_STRUC diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/dmumps_struc.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/dmumps_struc.h new file mode 100644 index 000000000..8a3e5f037 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/dmumps_struc.h @@ -0,0 +1,265 @@ +! +! This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +! +! +! This version of MUMPS is provided to you free of charge. It is public +! domain, based on public domain software developed during the Esprit IV +! European project PARASOL (1996-1999). Since this first public domain +! version in 1999, research and developments have been supported by the +! following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +! INRIA, and University of Bordeaux. +! +! The MUMPS team at the moment of releasing this version includes +! Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +! Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +! Ucar and Clement Weisbecker. +! +! We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +! Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +! Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +! Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +! have been contributing to this project. +! +! Up-to-date copies of the MUMPS package can be obtained +! from the Web pages: +! http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +! +! +! THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +! EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +! +! +! User documentation of any code that uses this software can +! include this complete notice. You can acknowledge (using +! references [1] and [2]) the contribution of this package +! in any scientific publication dependent upon the use of the +! package. You shall use reasonable endeavours to notify +! the authors of the package of this publication. +! +! [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +! A fully asynchronous multifrontal solver using distributed dynamic +! scheduling, SIAM Journal of Matrix Analysis and Applications, +! Vol 23, No 1, pp 15-41 (2001). +! +! [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +! S. Pralet, Hybrid scheduling for the parallel solution of linear +! systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +! + INCLUDE 'dmumps_root.h' + TYPE DMUMPS_STRUC + SEQUENCE +! +! This structure contains all parameters +! for the interface to the user, plus internal +! information from the solver +! +! ***************** +! INPUT PARAMETERS +! ***************** +! ----------------- +! MPI Communicator +! ----------------- + INTEGER COMM +! ------------------ +! Problem definition +! ------------------ +! Solver (SYM=0 unsymmetric,SYM=1 symmetric Positive Definite, +! SYM=2 general symmetric) +! Type of parallelism (PAR=1 host working, PAR=0 host not working) + INTEGER SYM, PAR + INTEGER JOB +! -------------------- +! Order of Input matrix +! -------------------- + INTEGER N +! +! ---------------------------------------- +! Assembled input matrix : User interface +! ---------------------------------------- + INTEGER NZ + DOUBLE PRECISION, DIMENSION(:), POINTER :: A + INTEGER, DIMENSION(:), POINTER :: IRN, JCN + DOUBLE PRECISION, DIMENSION(:), POINTER :: COLSCA, ROWSCA, pad0 +! +! ------------------------------------ +! Case of distributed assembled matrix +! matrix on entry: +! ------------------------------------ + INTEGER NZ_loc, pad1 + INTEGER, DIMENSION(:), POINTER :: IRN_loc, JCN_loc + DOUBLE PRECISION, DIMENSION(:), POINTER :: A_loc, pad2 +! +! ---------------------------------------- +! Unassembled input matrix: User interface +! ---------------------------------------- + INTEGER NELT, pad3 + INTEGER, DIMENSION(:), POINTER :: ELTPTR + INTEGER, DIMENSION(:), POINTER :: ELTVAR + DOUBLE PRECISION, DIMENSION(:), POINTER :: A_ELT, pad4 +! +! --------------------------------------------- +! Symmetric permutation : +! PERM_IN if given by user (optional) +! --------------------------------------------- + INTEGER, DIMENSION(:), POINTER :: PERM_IN +! +! +! ****************** +! INPUT/OUTPUT data +! ****************** +! -------------------------------------------------------- +! RHS / SOL_loc +! ------------- +! right-hand side and solution +! ------------------------------------------------------- + DOUBLE PRECISION, DIMENSION(:), POINTER :: RHS, REDRHS + DOUBLE PRECISION, DIMENSION(:), POINTER :: RHS_SPARSE + DOUBLE PRECISION, DIMENSION(:), POINTER :: SOL_loc + INTEGER, DIMENSION(:), POINTER :: IRHS_SPARSE + INTEGER, DIMENSION(:), POINTER :: IRHS_PTR + INTEGER, DIMENSION(:), POINTER :: ISOL_loc + INTEGER LRHS, NRHS, NZ_RHS, LSOL_loc, LREDRHS + INTEGER pad5 +! ---------------------------- +! Control parameters, +! statistics and output data +! --------------------------- + INTEGER ICNTL(40) + INTEGER INFO(40) + INTEGER INFOG(40) + DOUBLE PRECISION COST_SUBTREES + DOUBLE PRECISION CNTL(15) + DOUBLE PRECISION RINFO(40) + DOUBLE PRECISION RINFOG(40) +! --------------------------------------------------------- +! Permutations computed during analysis: +! SYM_PERM: Symmetric permutation +! UNS_PERM: Column permutations (optionnal) +! --------------------------------------------------------- + INTEGER, DIMENSION(:), POINTER :: SYM_PERM, UNS_PERM +! +! ----- +! Schur +! ----- + INTEGER NPROW, NPCOL, MBLOCK, NBLOCK + INTEGER SCHUR_MLOC, SCHUR_NLOC, SCHUR_LLD + INTEGER SIZE_SCHUR + DOUBLE PRECISION, DIMENSION(:), POINTER :: SCHUR + DOUBLE PRECISION, DIMENSION(:), POINTER :: SCHUR_CINTERFACE + INTEGER, DIMENSION(:), POINTER :: LISTVAR_SCHUR +! ------------------------------------- +! Case of distributed matrix on entry: +! DMUMPS potentially provides mapping +! ------------------------------------- + INTEGER, DIMENSION(:), POINTER :: MAPPING +! -------------- +! Version number +! -------------- + CHARACTER(LEN=14) VERSION_NUMBER +! ----------- +! Out-of-core +! ----------- + CHARACTER(LEN=255) :: OOC_TMPDIR + CHARACTER(LEN=63) :: OOC_PREFIX +! ------------------------------------------ +! To save the matrix in matrix market format +! ------------------------------------------ + CHARACTER(LEN=255) WRITE_PROBLEM + CHARACTER(LEN=5) :: pad8 +! +! +! ********************** +! INTERNAL Working data +! ********************* + INTEGER(8) :: KEEP8(150), MAX_SURF_MASTER + INTEGER INST_Number +! For MPI + INTEGER COMM_NODES, MYID_NODES, COMM_LOAD + INTEGER MYID, NPROCS, NSLAVES + INTEGER ASS_IRECV + INTEGER LBUFR + INTEGER LBUFR_BYTES + INTEGER, DIMENSION(:), POINTER :: POIDS + INTEGER, DIMENSION(:), POINTER :: BUFR +! IS is used for the factors + workspace for contrib. blocks + INTEGER, DIMENSION(:), POINTER :: IS +! IS1 (maxis1) contains working arrays computed +! and used only during analysis + INTEGER, DIMENSION(:), POINTER :: IS1 +! For analysis/facto/solve phases + INTEGER MAXIS1, Deficiency + INTEGER KEEP(500) +! The following data/arrays are computed during the analysis +! phase and used during the factorization and solve phases. + INTEGER LNA + INTEGER NBSA + INTEGER,POINTER,DIMENSION(:)::STEP, NE_STEPS, ND_STEPS +! Info for pruning tree + INTEGER,POINTER,DIMENSION(:)::Step2node +! --------------------- + INTEGER,POINTER,DIMENSION(:)::FRERE_STEPS, DAD_STEPS + INTEGER,POINTER,DIMENSION(:)::FILS, PTRAR, FRTPTR, FRTELT + INTEGER,POINTER,DIMENSION(:)::NA, PROCNODE_STEPS +! The two pointer arrays computed in facto and used by the solve +! (except the factors) are PTLUST_S and PTRFAC. + INTEGER, DIMENSION(:), POINTER :: PTLUST_S + INTEGER(8), DIMENSION(:), POINTER :: PTRFAC +! main real working arrays for factorization/solve phases + DOUBLE PRECISION, DIMENSION(:), POINTER :: S +! Information on mapping + INTEGER, DIMENSION(:), POINTER :: PROCNODE +! Input matrix ready for numerical assembly +! -arrowhead format in case of assembled matrix +! -element format otherwise + INTEGER, DIMENSION(:), POINTER :: INTARR + DOUBLE PRECISION, DIMENSION(:), POINTER :: DBLARR +! Element entry: internal data + INTEGER NELT_loc, LELTVAR, NA_ELT, pad11 + INTEGER, DIMENSION(:), POINTER :: ELTPROC +! Candidates and node partitionning + INTEGER, DIMENSION(:,:), POINTER :: CANDIDATES + INTEGER, DIMENSION(:), POINTER :: ISTEP_TO_INIV2 + INTEGER, DIMENSION(:), POINTER :: FUTURE_NIV2 + INTEGER, DIMENSION(:,:), POINTER :: TAB_POS_IN_PERE + LOGICAL, DIMENSION(:), POINTER :: I_AM_CAND +! For heterogeneous architecture + INTEGER, DIMENSION(:), POINTER :: MEM_DIST +! Compressed RHS + INTEGER, DIMENSION(:), POINTER :: POSINRHSCOMP + DOUBLE PRECISION, DIMENSION(:), POINTER :: RHSCOMP +! Info on the subtrees to be used during factorization + DOUBLE PRECISION, DIMENSION(:), POINTER :: MEM_SUBTREE + DOUBLE PRECISION, DIMENSION(:), POINTER :: COST_TRAV + INTEGER, DIMENSION(:), POINTER :: MY_ROOT_SBTR + INTEGER, DIMENSION(:), POINTER :: MY_FIRST_LEAF + INTEGER, DIMENSION(:), POINTER :: MY_NB_LEAF + INTEGER, DIMENSION(:), POINTER :: DEPTH_FIRST + INTEGER, DIMENSION(:), POINTER :: DEPTH_FIRST_SEQ + INTEGER, DIMENSION(:), POINTER :: SBTR_ID + DOUBLE PRECISION, DIMENSION(:), POINTER :: WK_USER + INTEGER :: NBSA_LOCAL + INTEGER :: LWK_USER +! Internal control array + DOUBLE PRECISION DKEEP(30) +! For simulating parallel out-of-core stack. + DOUBLE PRECISION, DIMENSION(:),POINTER ::CB_SON_SIZE, pad12 +! Instance number used/managed by the C/F77 interface + INTEGER INSTANCE_NUMBER +! OOC management data that must persist from factorization to solve. + INTEGER OOC_MAX_NB_NODES_FOR_ZONE + INTEGER, DIMENSION(:,:), POINTER :: OOC_INODE_SEQUENCE, pad13 + INTEGER(8),DIMENSION(:,:), POINTER :: OOC_SIZE_OF_BLOCK + INTEGER(8), DIMENSION(:,:), POINTER :: OOC_VADDR + INTEGER,DIMENSION(:), POINTER :: OOC_TOTAL_NB_NODES + INTEGER,DIMENSION(:), POINTER :: OOC_NB_FILES + CHARACTER,DIMENSION(:,:), POINTER :: OOC_FILE_NAMES + INTEGER,DIMENSION(:), POINTER :: OOC_FILE_NAME_LENGTH +! Indices of nul pivots + INTEGER,DIMENSION(:), POINTER :: PIVNUL_LIST +! Array needed to manage additionnal candidate processor + INTEGER, DIMENSION(:,:), POINTER :: SUP_PROC, pad14 +! ------------------------ +! Root structure(internal) +! ------------------------ + TYPE (DMUMPS_ROOT_STRUC) :: root + END TYPE DMUMPS_STRUC diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/mumps_c_types.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/mumps_c_types.h new file mode 100644 index 000000000..aef621281 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/mumps_c_types.h @@ -0,0 +1,92 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ + + +#ifndef MUMPS_C_TYPES_H +#define MUMPS_C_TYPES_H + +#define MUMPS_INT int + +#define SMUMPS_COMPLEX float +#define SMUMPS_REAL float + +#define DMUMPS_COMPLEX double +#define DMUMPS_REAL double + +/* Complex datatypes */ +typedef struct {float r,i;} mumps_complex; +typedef struct {double r,i;} mumps_double_complex; + +#define CMUMPS_COMPLEX mumps_complex +#define CMUMPS_REAL float + +#define ZMUMPS_COMPLEX mumps_double_complex +#define ZMUMPS_REAL double + + +#ifndef mumps_ftnlen +/* When passing a string, what is the type of the extra argument + * passed by value ? */ +# define mumps_ftnlen int +#endif + + +#define MUMPS_ARITH_s 1 +#define MUMPS_ARITH_d 2 +#define MUMPS_ARITH_c 4 +#define MUMPS_ARITH_z 8 + +#define MUMPS_ARITH_REAL ( MUMPS_ARITH_s | MUMPS_ARITH_d ) +#define MUMPS_ARITH_CMPLX ( MUMPS_ARITH_c | MUMPS_ARITH_z ) +#define MUMPS_ARITH_SINGLE ( MUMPS_ARITH_s | MUMPS_ARITH_c ) +#define MUMPS_ARITH_DBL ( MUMPS_ARITH_d | MUMPS_ARITH_z ) + + +#endif /* MUMPS_C_TYPES_H */ diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/mumps_compat.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/mumps_compat.h new file mode 100644 index 000000000..d63120eb6 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/mumps_compat.h @@ -0,0 +1,78 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ + +/* Compatibility issues between various Windows versions */ +#ifndef MUMPS_COMPAT_H +#define MUMPS_COMPAT_H + + +#if defined(_WIN32) && ! defined(__MINGW32__) +# define MUMPS_WIN32 1 +#endif + +#ifndef MUMPS_CALL +# ifdef MUMPS_WIN32 +/* Modify/choose between next 2 lines depending + * on your Windows calling conventions */ +/* # define MUMPS_CALL __stdcall */ +# define MUMPS_CALL +# else +# define MUMPS_CALL +# endif +#endif + +#if (__STDC_VERSION__ >= 199901L) +# define MUMPS_INLINE static inline +#else +# define MUMPS_INLINE +#endif + + +#endif /* MUMPS_COMPAT_H */ diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/smumps_c.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/smumps_c.h new file mode 100644 index 000000000..cae2a7800 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/smumps_c.h @@ -0,0 +1,159 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ + +/* Mostly written in march 2002 (JYL) */ + +#ifndef SMUMPS_C_H +#define SMUMPS_C_H + +#ifdef __cplusplus +extern "C" { +#endif + +#include "mumps_compat.h" +/* Next line defines MUMPS_INT, SMUMPS_COMPLEX and SMUMPS_REAL */ +#include "mumps_c_types.h" + +#ifndef MUMPS_VERSION +/* Protected in case headers of other arithmetics are included */ +#define MUMPS_VERSION "4.10.0" +#endif +#ifndef MUMPS_VERSION_MAX_LEN +#define MUMPS_VERSION_MAX_LEN 14 +#endif + +/* + * Definition of the (simplified) MUMPS C structure. + * NB: SMUMPS_COMPLEX are REAL types in s and d arithmetics. + */ +typedef struct { + + MUMPS_INT sym, par, job; + MUMPS_INT comm_fortran; /* Fortran communicator */ + MUMPS_INT icntl[40]; + SMUMPS_REAL cntl[15]; + MUMPS_INT n; + + MUMPS_INT nz_alloc; /* used in matlab interface to decide if we + free + malloc when we have large variation */ + + /* Assembled entry */ + MUMPS_INT nz; + MUMPS_INT *irn; + MUMPS_INT *jcn; + SMUMPS_COMPLEX *a; + + /* Distributed entry */ + MUMPS_INT nz_loc; + MUMPS_INT *irn_loc; + MUMPS_INT *jcn_loc; + SMUMPS_COMPLEX *a_loc; + + /* Element entry */ + MUMPS_INT nelt; + MUMPS_INT *eltptr; + MUMPS_INT *eltvar; + SMUMPS_COMPLEX *a_elt; + + /* Ordering, if given by user */ + MUMPS_INT *perm_in; + + /* Orderings returned to user */ + MUMPS_INT *sym_perm; /* symmetric permutation */ + MUMPS_INT *uns_perm; /* column permutation */ + + /* Scaling (input only in this version) */ + SMUMPS_REAL *colsca; + SMUMPS_REAL *rowsca; + + /* RHS, solution, ouptput data and statistics */ + SMUMPS_COMPLEX *rhs, *redrhs, *rhs_sparse, *sol_loc; + MUMPS_INT *irhs_sparse, *irhs_ptr, *isol_loc; + MUMPS_INT nrhs, lrhs, lredrhs, nz_rhs, lsol_loc; + MUMPS_INT schur_mloc, schur_nloc, schur_lld; + MUMPS_INT mblock, nblock, nprow, npcol; + MUMPS_INT info[40],infog[40]; + SMUMPS_REAL rinfo[40], rinfog[40]; + + /* Null space */ + MUMPS_INT deficiency; + MUMPS_INT *pivnul_list; + MUMPS_INT *mapping; + + /* Schur */ + MUMPS_INT size_schur; + MUMPS_INT *listvar_schur; + SMUMPS_COMPLEX *schur; + + /* Internal parameters */ + MUMPS_INT instance_number; + SMUMPS_COMPLEX *wk_user; + + /* Version number: length=14 in FORTRAN + 1 for final \0 + 1 for alignment */ + char version_number[MUMPS_VERSION_MAX_LEN + 1 + 1]; + /* For out-of-core */ + char ooc_tmpdir[256]; + char ooc_prefix[64]; + /* To save the matrix in matrix market format */ + char write_problem[256]; + MUMPS_INT lwk_user; + +} SMUMPS_STRUC_C; + + +void MUMPS_CALL +smumps_c( SMUMPS_STRUC_C * smumps_par ); + +#ifdef __cplusplus +} +#endif + +#endif /* SMUMPS_C_H */ + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/smumps_root.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/smumps_root.h new file mode 100644 index 000000000..f4c7b21af --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/smumps_root.h @@ -0,0 +1,75 @@ +! +! This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +! +! +! This version of MUMPS is provided to you free of charge. It is public +! domain, based on public domain software developed during the Esprit IV +! European project PARASOL (1996-1999). Since this first public domain +! version in 1999, research and developments have been supported by the +! following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +! INRIA, and University of Bordeaux. +! +! The MUMPS team at the moment of releasing this version includes +! Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +! Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +! Ucar and Clement Weisbecker. +! +! We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +! Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +! Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +! Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +! have been contributing to this project. +! +! Up-to-date copies of the MUMPS package can be obtained +! from the Web pages: +! http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +! +! +! THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +! EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +! +! +! User documentation of any code that uses this software can +! include this complete notice. You can acknowledge (using +! references [1] and [2]) the contribution of this package +! in any scientific publication dependent upon the use of the +! package. You shall use reasonable endeavours to notify +! the authors of the package of this publication. +! +! [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +! A fully asynchronous multifrontal solver using distributed dynamic +! scheduling, SIAM Journal of Matrix Analysis and Applications, +! Vol 23, No 1, pp 15-41 (2001). +! +! [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +! S. Pralet, Hybrid scheduling for the parallel solution of linear +! systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +! + TYPE SMUMPS_ROOT_STRUC + SEQUENCE + INTEGER :: MBLOCK, NBLOCK, NPROW, NPCOL + INTEGER :: MYROW, MYCOL + INTEGER :: SCHUR_MLOC, SCHUR_NLOC, SCHUR_LLD + INTEGER :: RHS_NLOC + INTEGER :: ROOT_SIZE, TOT_ROOT_SIZE +! descriptor for scalapack + INTEGER, DIMENSION( 9 ) :: DESCRIPTOR + INTEGER :: CNTXT_BLACS, LPIV, rootpad0 + INTEGER, DIMENSION(:), POINTER :: RG2L_ROW + INTEGER, DIMENSION(:), POINTER :: RG2L_COL + INTEGER , DIMENSION(:), POINTER :: IPIV, rootpad1 +! Centralized master of root + REAL, DIMENSION(:), POINTER :: RHS_CNTR_MASTER_ROOT +! Used to access Schur easily from root structure + REAL, DIMENSION(:), POINTER :: SCHUR_POINTER +! for try_null_space preprocessing constant only: + REAL, DIMENSION(:), POINTER :: QR_TAU, rootpad2 +! Fwd in facto: +! case of scalapack root: to store RHS in 2D block cyclic +! format compatible with root distribution + REAL, DIMENSION(:,:), POINTER :: RHS_ROOT, rootpad +! for try_nullspace preprocessing constant only: + REAL :: QR_RCOND, rootpad3 + LOGICAL yes, gridinit_done +! + END TYPE SMUMPS_ROOT_STRUC diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/smumps_struc.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/smumps_struc.h new file mode 100644 index 000000000..698c42e06 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/smumps_struc.h @@ -0,0 +1,265 @@ +! +! This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +! +! +! This version of MUMPS is provided to you free of charge. It is public +! domain, based on public domain software developed during the Esprit IV +! European project PARASOL (1996-1999). Since this first public domain +! version in 1999, research and developments have been supported by the +! following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +! INRIA, and University of Bordeaux. +! +! The MUMPS team at the moment of releasing this version includes +! Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +! Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +! Ucar and Clement Weisbecker. +! +! We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +! Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +! Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +! Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +! have been contributing to this project. +! +! Up-to-date copies of the MUMPS package can be obtained +! from the Web pages: +! http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +! +! +! THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +! EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +! +! +! User documentation of any code that uses this software can +! include this complete notice. You can acknowledge (using +! references [1] and [2]) the contribution of this package +! in any scientific publication dependent upon the use of the +! package. You shall use reasonable endeavours to notify +! the authors of the package of this publication. +! +! [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +! A fully asynchronous multifrontal solver using distributed dynamic +! scheduling, SIAM Journal of Matrix Analysis and Applications, +! Vol 23, No 1, pp 15-41 (2001). +! +! [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +! S. Pralet, Hybrid scheduling for the parallel solution of linear +! systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +! + INCLUDE 'smumps_root.h' + TYPE SMUMPS_STRUC + SEQUENCE +! +! This structure contains all parameters +! for the interface to the user, plus internal +! information from the solver +! +! ***************** +! INPUT PARAMETERS +! ***************** +! ----------------- +! MPI Communicator +! ----------------- + INTEGER COMM +! ------------------ +! Problem definition +! ------------------ +! Solver (SYM=0 unsymmetric,SYM=1 symmetric Positive Definite, +! SYM=2 general symmetric) +! Type of parallelism (PAR=1 host working, PAR=0 host not working) + INTEGER SYM, PAR + INTEGER JOB +! -------------------- +! Order of Input matrix +! -------------------- + INTEGER N +! +! ---------------------------------------- +! Assembled input matrix : User interface +! ---------------------------------------- + INTEGER NZ + REAL, DIMENSION(:), POINTER :: A + INTEGER, DIMENSION(:), POINTER :: IRN, JCN + REAL, DIMENSION(:), POINTER :: COLSCA, ROWSCA, pad0 +! +! ------------------------------------ +! Case of distributed assembled matrix +! matrix on entry: +! ------------------------------------ + INTEGER NZ_loc, pad1 + INTEGER, DIMENSION(:), POINTER :: IRN_loc, JCN_loc + REAL, DIMENSION(:), POINTER :: A_loc, pad2 +! +! ---------------------------------------- +! Unassembled input matrix: User interface +! ---------------------------------------- + INTEGER NELT, pad3 + INTEGER, DIMENSION(:), POINTER :: ELTPTR + INTEGER, DIMENSION(:), POINTER :: ELTVAR + REAL, DIMENSION(:), POINTER :: A_ELT, pad4 +! +! --------------------------------------------- +! Symmetric permutation : +! PERM_IN if given by user (optional) +! --------------------------------------------- + INTEGER, DIMENSION(:), POINTER :: PERM_IN +! +! +! ****************** +! INPUT/OUTPUT data +! ****************** +! -------------------------------------------------------- +! RHS / SOL_loc +! ------------- +! right-hand side and solution +! ------------------------------------------------------- + REAL, DIMENSION(:), POINTER :: RHS, REDRHS + REAL, DIMENSION(:), POINTER :: RHS_SPARSE + REAL, DIMENSION(:), POINTER :: SOL_loc + INTEGER, DIMENSION(:), POINTER :: IRHS_SPARSE + INTEGER, DIMENSION(:), POINTER :: IRHS_PTR + INTEGER, DIMENSION(:), POINTER :: ISOL_loc + INTEGER LRHS, NRHS, NZ_RHS, LSOL_loc, LREDRHS + INTEGER pad5 +! ---------------------------- +! Control parameters, +! statistics and output data +! --------------------------- + INTEGER ICNTL(40) + INTEGER INFO(40) + INTEGER INFOG(40) + REAL COST_SUBTREES + REAL CNTL(15) + REAL RINFO(40) + REAL RINFOG(40) +! --------------------------------------------------------- +! Permutations computed during analysis: +! SYM_PERM: Symmetric permutation +! UNS_PERM: Column permutations (optionnal) +! --------------------------------------------------------- + INTEGER, DIMENSION(:), POINTER :: SYM_PERM, UNS_PERM +! +! ----- +! Schur +! ----- + INTEGER NPROW, NPCOL, MBLOCK, NBLOCK + INTEGER SCHUR_MLOC, SCHUR_NLOC, SCHUR_LLD + INTEGER SIZE_SCHUR + REAL, DIMENSION(:), POINTER :: SCHUR + REAL, DIMENSION(:), POINTER :: SCHUR_CINTERFACE + INTEGER, DIMENSION(:), POINTER :: LISTVAR_SCHUR +! ------------------------------------- +! Case of distributed matrix on entry: +! SMUMPS potentially provides mapping +! ------------------------------------- + INTEGER, DIMENSION(:), POINTER :: MAPPING +! -------------- +! Version number +! -------------- + CHARACTER(LEN=14) VERSION_NUMBER +! ----------- +! Out-of-core +! ----------- + CHARACTER(LEN=255) :: OOC_TMPDIR + CHARACTER(LEN=63) :: OOC_PREFIX +! ------------------------------------------ +! To save the matrix in matrix market format +! ------------------------------------------ + CHARACTER(LEN=255) WRITE_PROBLEM + CHARACTER(LEN=5) :: pad8 +! +! +! ********************** +! INTERNAL Working data +! ********************* + INTEGER(8) :: KEEP8(150), MAX_SURF_MASTER + INTEGER INST_Number +! For MPI + INTEGER COMM_NODES, MYID_NODES, COMM_LOAD + INTEGER MYID, NPROCS, NSLAVES + INTEGER ASS_IRECV + INTEGER LBUFR + INTEGER LBUFR_BYTES + INTEGER, DIMENSION(:), POINTER :: POIDS + INTEGER, DIMENSION(:), POINTER :: BUFR +! IS is used for the factors + workspace for contrib. blocks + INTEGER, DIMENSION(:), POINTER :: IS +! IS1 (maxis1) contains working arrays computed +! and used only during analysis + INTEGER, DIMENSION(:), POINTER :: IS1 +! For analysis/facto/solve phases + INTEGER MAXIS1, Deficiency + INTEGER KEEP(500) +! The following data/arrays are computed during the analysis +! phase and used during the factorization and solve phases. + INTEGER LNA + INTEGER NBSA + INTEGER,POINTER,DIMENSION(:)::STEP, NE_STEPS, ND_STEPS +! Info for pruning tree + INTEGER,POINTER,DIMENSION(:)::Step2node +! --------------------- + INTEGER,POINTER,DIMENSION(:)::FRERE_STEPS, DAD_STEPS + INTEGER,POINTER,DIMENSION(:)::FILS, PTRAR, FRTPTR, FRTELT + INTEGER,POINTER,DIMENSION(:)::NA, PROCNODE_STEPS +! The two pointer arrays computed in facto and used by the solve +! (except the factors) are PTLUST_S and PTRFAC. + INTEGER, DIMENSION(:), POINTER :: PTLUST_S + INTEGER(8), DIMENSION(:), POINTER :: PTRFAC +! main real working arrays for factorization/solve phases + REAL, DIMENSION(:), POINTER :: S +! Information on mapping + INTEGER, DIMENSION(:), POINTER :: PROCNODE +! Input matrix ready for numerical assembly +! -arrowhead format in case of assembled matrix +! -element format otherwise + INTEGER, DIMENSION(:), POINTER :: INTARR + REAL, DIMENSION(:), POINTER :: DBLARR +! Element entry: internal data + INTEGER NELT_loc, LELTVAR, NA_ELT, pad11 + INTEGER, DIMENSION(:), POINTER :: ELTPROC +! Candidates and node partitionning + INTEGER, DIMENSION(:,:), POINTER :: CANDIDATES + INTEGER, DIMENSION(:), POINTER :: ISTEP_TO_INIV2 + INTEGER, DIMENSION(:), POINTER :: FUTURE_NIV2 + INTEGER, DIMENSION(:,:), POINTER :: TAB_POS_IN_PERE + LOGICAL, DIMENSION(:), POINTER :: I_AM_CAND +! For heterogeneous architecture + INTEGER, DIMENSION(:), POINTER :: MEM_DIST +! Compressed RHS + INTEGER, DIMENSION(:), POINTER :: POSINRHSCOMP + REAL, DIMENSION(:), POINTER :: RHSCOMP +! Info on the subtrees to be used during factorization + DOUBLE PRECISION, DIMENSION(:), POINTER :: MEM_SUBTREE + DOUBLE PRECISION, DIMENSION(:), POINTER :: COST_TRAV + INTEGER, DIMENSION(:), POINTER :: MY_ROOT_SBTR + INTEGER, DIMENSION(:), POINTER :: MY_FIRST_LEAF + INTEGER, DIMENSION(:), POINTER :: MY_NB_LEAF + INTEGER, DIMENSION(:), POINTER :: DEPTH_FIRST + INTEGER, DIMENSION(:), POINTER :: DEPTH_FIRST_SEQ + INTEGER, DIMENSION(:), POINTER :: SBTR_ID + REAL, DIMENSION(:), POINTER :: WK_USER + INTEGER :: NBSA_LOCAL + INTEGER :: LWK_USER +! Internal control array + REAL DKEEP(30) +! For simulating parallel out-of-core stack. + DOUBLE PRECISION, DIMENSION(:),POINTER ::CB_SON_SIZE, pad12 +! Instance number used/managed by the C/F77 interface + INTEGER INSTANCE_NUMBER +! OOC management data that must persist from factorization to solve. + INTEGER OOC_MAX_NB_NODES_FOR_ZONE + INTEGER, DIMENSION(:,:), POINTER :: OOC_INODE_SEQUENCE, pad13 + INTEGER(8),DIMENSION(:,:), POINTER :: OOC_SIZE_OF_BLOCK + INTEGER(8), DIMENSION(:,:), POINTER :: OOC_VADDR + INTEGER,DIMENSION(:), POINTER :: OOC_TOTAL_NB_NODES + INTEGER,DIMENSION(:), POINTER :: OOC_NB_FILES + CHARACTER,DIMENSION(:,:), POINTER :: OOC_FILE_NAMES + INTEGER,DIMENSION(:), POINTER :: OOC_FILE_NAME_LENGTH +! Indices of nul pivots + INTEGER,DIMENSION(:), POINTER :: PIVNUL_LIST +! Array needed to manage additionnal candidate processor + INTEGER, DIMENSION(:,:), POINTER :: SUP_PROC, pad14 +! ------------------------ +! Root structure(internal) +! ------------------------ + TYPE (SMUMPS_ROOT_STRUC) :: root + END TYPE SMUMPS_STRUC diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/zmumps_c.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/zmumps_c.h new file mode 100644 index 000000000..cedf5f150 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/zmumps_c.h @@ -0,0 +1,159 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ + +/* Mostly written in march 2002 (JYL) */ + +#ifndef ZMUMPS_C_H +#define ZMUMPS_C_H + +#ifdef __cplusplus +extern "C" { +#endif + +#include "mumps_compat.h" +/* Next line defines MUMPS_INT, ZMUMPS_COMPLEX and ZMUMPS_REAL */ +#include "mumps_c_types.h" + +#ifndef MUMPS_VERSION +/* Protected in case headers of other arithmetics are included */ +#define MUMPS_VERSION "4.10.0" +#endif +#ifndef MUMPS_VERSION_MAX_LEN +#define MUMPS_VERSION_MAX_LEN 14 +#endif + +/* + * Definition of the (simplified) MUMPS C structure. + * NB: ZMUMPS_COMPLEX are REAL types in s and d arithmetics. + */ +typedef struct { + + MUMPS_INT sym, par, job; + MUMPS_INT comm_fortran; /* Fortran communicator */ + MUMPS_INT icntl[40]; + ZMUMPS_REAL cntl[15]; + MUMPS_INT n; + + MUMPS_INT nz_alloc; /* used in matlab interface to decide if we + free + malloc when we have large variation */ + + /* Assembled entry */ + MUMPS_INT nz; + MUMPS_INT *irn; + MUMPS_INT *jcn; + ZMUMPS_COMPLEX *a; + + /* Distributed entry */ + MUMPS_INT nz_loc; + MUMPS_INT *irn_loc; + MUMPS_INT *jcn_loc; + ZMUMPS_COMPLEX *a_loc; + + /* Element entry */ + MUMPS_INT nelt; + MUMPS_INT *eltptr; + MUMPS_INT *eltvar; + ZMUMPS_COMPLEX *a_elt; + + /* Ordering, if given by user */ + MUMPS_INT *perm_in; + + /* Orderings returned to user */ + MUMPS_INT *sym_perm; /* symmetric permutation */ + MUMPS_INT *uns_perm; /* column permutation */ + + /* Scaling (input only in this version) */ + ZMUMPS_REAL *colsca; + ZMUMPS_REAL *rowsca; + + /* RHS, solution, ouptput data and statistics */ + ZMUMPS_COMPLEX *rhs, *redrhs, *rhs_sparse, *sol_loc; + MUMPS_INT *irhs_sparse, *irhs_ptr, *isol_loc; + MUMPS_INT nrhs, lrhs, lredrhs, nz_rhs, lsol_loc; + MUMPS_INT schur_mloc, schur_nloc, schur_lld; + MUMPS_INT mblock, nblock, nprow, npcol; + MUMPS_INT info[40],infog[40]; + ZMUMPS_REAL rinfo[40], rinfog[40]; + + /* Null space */ + MUMPS_INT deficiency; + MUMPS_INT *pivnul_list; + MUMPS_INT *mapping; + + /* Schur */ + MUMPS_INT size_schur; + MUMPS_INT *listvar_schur; + ZMUMPS_COMPLEX *schur; + + /* Internal parameters */ + MUMPS_INT instance_number; + ZMUMPS_COMPLEX *wk_user; + + /* Version number: length=14 in FORTRAN + 1 for final \0 + 1 for alignment */ + char version_number[MUMPS_VERSION_MAX_LEN + 1 + 1]; + /* For out-of-core */ + char ooc_tmpdir[256]; + char ooc_prefix[64]; + /* To save the matrix in matrix market format */ + char write_problem[256]; + MUMPS_INT lwk_user; + +} ZMUMPS_STRUC_C; + + +void MUMPS_CALL +zmumps_c( ZMUMPS_STRUC_C * zmumps_par ); + +#ifdef __cplusplus +} +#endif + +#endif /* ZMUMPS_C_H */ + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/zmumps_root.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/zmumps_root.h new file mode 100644 index 000000000..64f910be8 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/zmumps_root.h @@ -0,0 +1,75 @@ +! +! This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +! +! +! This version of MUMPS is provided to you free of charge. It is public +! domain, based on public domain software developed during the Esprit IV +! European project PARASOL (1996-1999). Since this first public domain +! version in 1999, research and developments have been supported by the +! following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +! INRIA, and University of Bordeaux. +! +! The MUMPS team at the moment of releasing this version includes +! Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +! Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +! Ucar and Clement Weisbecker. +! +! We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +! Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +! Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +! Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +! have been contributing to this project. +! +! Up-to-date copies of the MUMPS package can be obtained +! from the Web pages: +! http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +! +! +! THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +! EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +! +! +! User documentation of any code that uses this software can +! include this complete notice. You can acknowledge (using +! references [1] and [2]) the contribution of this package +! in any scientific publication dependent upon the use of the +! package. You shall use reasonable endeavours to notify +! the authors of the package of this publication. +! +! [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +! A fully asynchronous multifrontal solver using distributed dynamic +! scheduling, SIAM Journal of Matrix Analysis and Applications, +! Vol 23, No 1, pp 15-41 (2001). +! +! [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +! S. Pralet, Hybrid scheduling for the parallel solution of linear +! systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +! + TYPE ZMUMPS_ROOT_STRUC + SEQUENCE + INTEGER :: MBLOCK, NBLOCK, NPROW, NPCOL + INTEGER :: MYROW, MYCOL + INTEGER :: SCHUR_MLOC, SCHUR_NLOC, SCHUR_LLD + INTEGER :: RHS_NLOC + INTEGER :: ROOT_SIZE, TOT_ROOT_SIZE +! descriptor for scalapack + INTEGER, DIMENSION( 9 ) :: DESCRIPTOR + INTEGER :: CNTXT_BLACS, LPIV, rootpad0 + INTEGER, DIMENSION(:), POINTER :: RG2L_ROW + INTEGER, DIMENSION(:), POINTER :: RG2L_COL + INTEGER , DIMENSION(:), POINTER :: IPIV, rootpad1 +! Centralized master of root + COMPLEX(kind=8), DIMENSION(:), POINTER :: RHS_CNTR_MASTER_ROOT +! Used to access Schur easily from root structure + COMPLEX(kind=8), DIMENSION(:), POINTER :: SCHUR_POINTER +! for try_null_space preprocessing constant only: + COMPLEX(kind=8), DIMENSION(:), POINTER :: QR_TAU, rootpad2 +! Fwd in facto: +! case of scalapack root: to store RHS in 2D block cyclic +! format compatible with root distribution + COMPLEX(kind=8), DIMENSION(:,:), POINTER :: RHS_ROOT, rootpad +! for try_nullspace preprocessing constant only: + DOUBLE PRECISION :: QR_RCOND, rootpad3 + LOGICAL yes, gridinit_done +! + END TYPE ZMUMPS_ROOT_STRUC diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/include/zmumps_struc.h b/Ipopt-3.13.4/ThirdParty/MUMPS/include/zmumps_struc.h new file mode 100644 index 000000000..5b9e76ff3 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/include/zmumps_struc.h @@ -0,0 +1,265 @@ +! +! This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +! +! +! This version of MUMPS is provided to you free of charge. It is public +! domain, based on public domain software developed during the Esprit IV +! European project PARASOL (1996-1999). Since this first public domain +! version in 1999, research and developments have been supported by the +! following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +! INRIA, and University of Bordeaux. +! +! The MUMPS team at the moment of releasing this version includes +! Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +! Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +! Ucar and Clement Weisbecker. +! +! We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +! Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +! Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +! Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +! have been contributing to this project. +! +! Up-to-date copies of the MUMPS package can be obtained +! from the Web pages: +! http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +! +! +! THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +! EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +! +! +! User documentation of any code that uses this software can +! include this complete notice. You can acknowledge (using +! references [1] and [2]) the contribution of this package +! in any scientific publication dependent upon the use of the +! package. You shall use reasonable endeavours to notify +! the authors of the package of this publication. +! +! [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +! A fully asynchronous multifrontal solver using distributed dynamic +! scheduling, SIAM Journal of Matrix Analysis and Applications, +! Vol 23, No 1, pp 15-41 (2001). +! +! [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +! S. Pralet, Hybrid scheduling for the parallel solution of linear +! systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +! + INCLUDE 'zmumps_root.h' + TYPE ZMUMPS_STRUC + SEQUENCE +! +! This structure contains all parameters +! for the interface to the user, plus internal +! information from the solver +! +! ***************** +! INPUT PARAMETERS +! ***************** +! ----------------- +! MPI Communicator +! ----------------- + INTEGER COMM +! ------------------ +! Problem definition +! ------------------ +! Solver (SYM=0 unsymmetric,SYM=1 symmetric Positive Definite, +! SYM=2 general symmetric) +! Type of parallelism (PAR=1 host working, PAR=0 host not working) + INTEGER SYM, PAR + INTEGER JOB +! -------------------- +! Order of Input matrix +! -------------------- + INTEGER N +! +! ---------------------------------------- +! Assembled input matrix : User interface +! ---------------------------------------- + INTEGER NZ + COMPLEX(kind=8), DIMENSION(:), POINTER :: A + INTEGER, DIMENSION(:), POINTER :: IRN, JCN + DOUBLE PRECISION, DIMENSION(:), POINTER :: COLSCA, ROWSCA, pad0 +! +! ------------------------------------ +! Case of distributed assembled matrix +! matrix on entry: +! ------------------------------------ + INTEGER NZ_loc, pad1 + INTEGER, DIMENSION(:), POINTER :: IRN_loc, JCN_loc + COMPLEX(kind=8), DIMENSION(:), POINTER :: A_loc, pad2 +! +! ---------------------------------------- +! Unassembled input matrix: User interface +! ---------------------------------------- + INTEGER NELT, pad3 + INTEGER, DIMENSION(:), POINTER :: ELTPTR + INTEGER, DIMENSION(:), POINTER :: ELTVAR + COMPLEX(kind=8), DIMENSION(:), POINTER :: A_ELT, pad4 +! +! --------------------------------------------- +! Symmetric permutation : +! PERM_IN if given by user (optional) +! --------------------------------------------- + INTEGER, DIMENSION(:), POINTER :: PERM_IN +! +! +! ****************** +! INPUT/OUTPUT data +! ****************** +! -------------------------------------------------------- +! RHS / SOL_loc +! ------------- +! right-hand side and solution +! ------------------------------------------------------- + COMPLEX(kind=8), DIMENSION(:), POINTER :: RHS, REDRHS + COMPLEX(kind=8), DIMENSION(:), POINTER :: RHS_SPARSE + COMPLEX(kind=8), DIMENSION(:), POINTER :: SOL_loc + INTEGER, DIMENSION(:), POINTER :: IRHS_SPARSE + INTEGER, DIMENSION(:), POINTER :: IRHS_PTR + INTEGER, DIMENSION(:), POINTER :: ISOL_loc + INTEGER LRHS, NRHS, NZ_RHS, LSOL_loc, LREDRHS + INTEGER pad5 +! ---------------------------- +! Control parameters, +! statistics and output data +! --------------------------- + INTEGER ICNTL(40) + INTEGER INFO(40) + INTEGER INFOG(40) + DOUBLE PRECISION COST_SUBTREES + DOUBLE PRECISION CNTL(15) + DOUBLE PRECISION RINFO(40) + DOUBLE PRECISION RINFOG(40) +! --------------------------------------------------------- +! Permutations computed during analysis: +! SYM_PERM: Symmetric permutation +! UNS_PERM: Column permutations (optionnal) +! --------------------------------------------------------- + INTEGER, DIMENSION(:), POINTER :: SYM_PERM, UNS_PERM +! +! ----- +! Schur +! ----- + INTEGER NPROW, NPCOL, MBLOCK, NBLOCK + INTEGER SCHUR_MLOC, SCHUR_NLOC, SCHUR_LLD + INTEGER SIZE_SCHUR + COMPLEX(kind=8), DIMENSION(:), POINTER :: SCHUR + COMPLEX(kind=8), DIMENSION(:), POINTER :: SCHUR_CINTERFACE + INTEGER, DIMENSION(:), POINTER :: LISTVAR_SCHUR +! ------------------------------------- +! Case of distributed matrix on entry: +! ZMUMPS potentially provides mapping +! ------------------------------------- + INTEGER, DIMENSION(:), POINTER :: MAPPING +! -------------- +! Version number +! -------------- + CHARACTER(LEN=14) VERSION_NUMBER +! ----------- +! Out-of-core +! ----------- + CHARACTER(LEN=255) :: OOC_TMPDIR + CHARACTER(LEN=63) :: OOC_PREFIX +! ------------------------------------------ +! To save the matrix in matrix market format +! ------------------------------------------ + CHARACTER(LEN=255) WRITE_PROBLEM + CHARACTER(LEN=5) :: pad8 +! +! +! ********************** +! INTERNAL Working data +! ********************* + INTEGER(8) :: KEEP8(150), MAX_SURF_MASTER + INTEGER INST_Number +! For MPI + INTEGER COMM_NODES, MYID_NODES, COMM_LOAD + INTEGER MYID, NPROCS, NSLAVES + INTEGER ASS_IRECV + INTEGER LBUFR + INTEGER LBUFR_BYTES + INTEGER, DIMENSION(:), POINTER :: POIDS + INTEGER, DIMENSION(:), POINTER :: BUFR +! IS is used for the factors + workspace for contrib. blocks + INTEGER, DIMENSION(:), POINTER :: IS +! IS1 (maxis1) contains working arrays computed +! and used only during analysis + INTEGER, DIMENSION(:), POINTER :: IS1 +! For analysis/facto/solve phases + INTEGER MAXIS1, Deficiency + INTEGER KEEP(500) +! The following data/arrays are computed during the analysis +! phase and used during the factorization and solve phases. + INTEGER LNA + INTEGER NBSA + INTEGER,POINTER,DIMENSION(:)::STEP, NE_STEPS, ND_STEPS +! Info for pruning tree + INTEGER,POINTER,DIMENSION(:)::Step2node +! --------------------- + INTEGER,POINTER,DIMENSION(:)::FRERE_STEPS, DAD_STEPS + INTEGER,POINTER,DIMENSION(:)::FILS, PTRAR, FRTPTR, FRTELT + INTEGER,POINTER,DIMENSION(:)::NA, PROCNODE_STEPS +! The two pointer arrays computed in facto and used by the solve +! (except the factors) are PTLUST_S and PTRFAC. + INTEGER, DIMENSION(:), POINTER :: PTLUST_S + INTEGER(8), DIMENSION(:), POINTER :: PTRFAC +! main real working arrays for factorization/solve phases + COMPLEX(kind=8), DIMENSION(:), POINTER :: S +! Information on mapping + INTEGER, DIMENSION(:), POINTER :: PROCNODE +! Input matrix ready for numerical assembly +! -arrowhead format in case of assembled matrix +! -element format otherwise + INTEGER, DIMENSION(:), POINTER :: INTARR + COMPLEX(kind=8), DIMENSION(:), POINTER :: DBLARR +! Element entry: internal data + INTEGER NELT_loc, LELTVAR, NA_ELT, pad11 + INTEGER, DIMENSION(:), POINTER :: ELTPROC +! Candidates and node partitionning + INTEGER, DIMENSION(:,:), POINTER :: CANDIDATES + INTEGER, DIMENSION(:), POINTER :: ISTEP_TO_INIV2 + INTEGER, DIMENSION(:), POINTER :: FUTURE_NIV2 + INTEGER, DIMENSION(:,:), POINTER :: TAB_POS_IN_PERE + LOGICAL, DIMENSION(:), POINTER :: I_AM_CAND +! For heterogeneous architecture + INTEGER, DIMENSION(:), POINTER :: MEM_DIST +! Compressed RHS + INTEGER, DIMENSION(:), POINTER :: POSINRHSCOMP + COMPLEX(kind=8), DIMENSION(:), POINTER :: RHSCOMP +! Info on the subtrees to be used during factorization + DOUBLE PRECISION, DIMENSION(:), POINTER :: MEM_SUBTREE + DOUBLE PRECISION, DIMENSION(:), POINTER :: COST_TRAV + INTEGER, DIMENSION(:), POINTER :: MY_ROOT_SBTR + INTEGER, DIMENSION(:), POINTER :: MY_FIRST_LEAF + INTEGER, DIMENSION(:), POINTER :: MY_NB_LEAF + INTEGER, DIMENSION(:), POINTER :: DEPTH_FIRST + INTEGER, DIMENSION(:), POINTER :: DEPTH_FIRST_SEQ + INTEGER, DIMENSION(:), POINTER :: SBTR_ID + COMPLEX(kind=8), DIMENSION(:), POINTER :: WK_USER + INTEGER :: NBSA_LOCAL + INTEGER :: LWK_USER +! Internal control array + DOUBLE PRECISION DKEEP(30) +! For simulating parallel out-of-core stack. + DOUBLE PRECISION, DIMENSION(:),POINTER ::CB_SON_SIZE, pad12 +! Instance number used/managed by the C/F77 interface + INTEGER INSTANCE_NUMBER +! OOC management data that must persist from factorization to solve. + INTEGER OOC_MAX_NB_NODES_FOR_ZONE + INTEGER, DIMENSION(:,:), POINTER :: OOC_INODE_SEQUENCE, pad13 + INTEGER(8),DIMENSION(:,:), POINTER :: OOC_SIZE_OF_BLOCK + INTEGER(8), DIMENSION(:,:), POINTER :: OOC_VADDR + INTEGER,DIMENSION(:), POINTER :: OOC_TOTAL_NB_NODES + INTEGER,DIMENSION(:), POINTER :: OOC_NB_FILES + CHARACTER,DIMENSION(:,:), POINTER :: OOC_FILE_NAMES + INTEGER,DIMENSION(:), POINTER :: OOC_FILE_NAME_LENGTH +! Indices of nul pivots + INTEGER,DIMENSION(:), POINTER :: PIVNUL_LIST +! Array needed to manage additionnal candidate processor + INTEGER, DIMENSION(:,:), POINTER :: SUP_PROC, pad14 +! ------------------------ +! Root structure(internal) +! ------------------------ + TYPE (ZMUMPS_ROOT_STRUC) :: root + END TYPE ZMUMPS_STRUC diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/Makefile b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/Makefile new file mode 100644 index 000000000..73701c2af --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/Makefile @@ -0,0 +1,21 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +all: libmpiseq + +.PHONY: all libmpiseq clean + +include ../Makefile.inc + +libmpiseq: libmpiseq$(PLAT)$(LIBEXT) + +libmpiseq$(PLAT)$(LIBEXT): mpi.o mpic.o elapse.o + $(AR)$@ mpi.o mpic.o elapse.o + $(RANLIB) $@ +.f.o: + $(FC) $(OPTF) -c $*.f $(OUTF)$*.o +.c.o: + $(CC) $(OPTC) $(CDEFS) -I. -c $*.c $(OUTC)$*.o + +clean: + $(RM) *.o *$(LIBEXT) diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/elapse.c b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/elapse.c new file mode 100644 index 000000000..7faaa0c6c --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/elapse.c @@ -0,0 +1,74 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +#if defined(_WIN32) +#include "elapse.h" +#include +#include +void MUMPS_CALL mumps_elapse(double *val) +{ + time_t ltime; + struct _timeb tstruct; + + time (<ime); + _ftime(&tstruct); + *val = (double) ltime + (double) tstruct.millitm*(0.001); +} + +#else + +#include "elapse.h" +#include +void mumps_elapse(double *val) + { + struct timeval time; + gettimeofday(&time,(struct timezone *)0); + *val=time.tv_sec+time.tv_usec*1.e-6; + } +#endif diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/elapse.h b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/elapse.h new file mode 100644 index 000000000..25357953e --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/elapse.h @@ -0,0 +1,70 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ + +#ifndef MUMPS_CALL +#if defined(_WIN32) +/* Modify/choose between next 2 lines depending + * * on your Windows calling conventions */ +/* #define MUMPS_CALL __stdcall */ +#define MUMPS_CALL +#else +#define MUMPS_CALL +#endif +#endif + +#if (defined(_WIN32) && ! defined(__MINGW32__)) || defined(UPPER) +#define mumps_elapse MUMPS_ELAPSE +#elif defined(Add__) +#define mumps_elapse mumps_elapse__ +#elif defined(Add_) +#define mumps_elapse mumps_elapse_ +#endif + +void MUMPS_CALL mumps_elapse(double *val); diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/mpi.f b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/mpi.f new file mode 100644 index 000000000..a1d7408e2 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/mpi.f @@ -0,0 +1,1584 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C +C****************************************************************** +C +C This file contains dummy MPI/BLACS/ScaLAPACK libraries to allow +C linking/running MUMPS on a platform where MPI is not installed. +C +C****************************************************************** +C +C MPI +C +C****************************************************************** + SUBROUTINE MPI_BSEND( BUF, COUNT, DATATYPE, DEST, TAG, COMM, + & IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COUNT, DATATYPE, DEST, TAG, COMM, IERR + INTEGER BUF(*) + WRITE(*,*) 'Error. MPI_BSEND should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_BSEND +C*********************************************************************** + SUBROUTINE MPI_BUFFER_ATTACH(BUF, COUNT, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COUNT, IERR + INTEGER BUF(*) + IERR = 0 + RETURN + END SUBROUTINE MPI_BUFFER_ATTACH +C*********************************************************************** + SUBROUTINE MPI_BUFFER_DETACH(BUF, COUNT, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COUNT, IERR + INTEGER BUF(*) + IERR = 0 + RETURN + END SUBROUTINE MPI_BUFFER_DETACH + SUBROUTINE MPI_GATHER( SENDBUF, COUNT, + & DATATYPE, RECVBUF, RECCOUNT, RECTYPE, + & ROOT, COMM, IERR ) + IMPLICIT NONE + INTEGER COUNT, DATATYPE, RECCOUNT, RECTYPE, ROOT, COMM, IERR + INTEGER SENDBUF(*), RECVBUF(*) + IF ( RECCOUNT .NE. COUNT ) THEN + WRITE(*,*) 'ERROR in MPI_GATHER, RECCOUNT != COUNT' + STOP + ELSE + CALL MUMPS_COPY( COUNT, SENDBUF, RECVBUF, DATATYPE, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) 'ERROR in MPI_GATHER, DATATYPE=',DATATYPE + STOP + END IF + END IF + IERR = 0 + RETURN + END SUBROUTINE MPI_GATHER +C*********************************************************************** + SUBROUTINE MPI_GATHERV( SENDBUF, COUNT, + & DATATYPE, RECVBUF, RECCOUNT, DISPLS, RECTYPE, + & ROOT, COMM, IERR ) + IMPLICIT NONE + INTEGER COUNT, DATATYPE, RECTYPE, ROOT, COMM, IERR + INTEGER RECCOUNT(1) + INTEGER SENDBUF(*), RECVBUF(*) + INTEGER DISPLS(*) +C +C Note that DISPLS is ignored in this version. One may +C want to copy in reception buffer with a shift DISPLS(1). +C This requires passing the offset DISPLS(1) to +C "MUMPS_COPY_DATATYPE" routines. +C + IF ( RECCOUNT(1) .NE. COUNT ) THEN + WRITE(*,*) 'ERROR in MPI_GATHERV, RECCOUNT(1) != COUNT' + STOP + ELSE + CALL MUMPS_COPY( COUNT, SENDBUF, RECVBUF, DATATYPE, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) 'ERROR in MPI_GATHERV, DATATYPE=',DATATYPE + STOP + END IF + END IF + IERR = 0 + RETURN + END SUBROUTINE MPI_GATHERV +C*********************************************************************** + SUBROUTINE MPI_ALLREDUCE( SENDBUF, RECVBUF, COUNT, DATATYPE, + & OPERATION, COMM, IERR ) + IMPLICIT NONE + INTEGER COUNT, DATATYPE, OPERATION, COMM, IERR + INTEGER SENDBUF(*), RECVBUF(*) + CALL MUMPS_COPY( COUNT, SENDBUF, RECVBUF, DATATYPE, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) 'ERROR in MPI_ALLREDUCE, DATATYPE=',DATATYPE + STOP + END IF + IERR = 0 + RETURN + END SUBROUTINE MPI_ALLREDUCE +C*********************************************************************** + SUBROUTINE MPI_REDUCE( SENDBUF, RECVBUF, COUNT, DATATYPE, OP, + & ROOT, COMM, IERR ) + IMPLICIT NONE + INTEGER COUNT, DATATYPE, OP, ROOT, COMM, IERR + INTEGER SENDBUF(*), RECVBUF(*) + CALL MUMPS_COPY( COUNT, SENDBUF, RECVBUF, DATATYPE, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) 'ERROR in MPI_REDUCE, DATATYPE=',DATATYPE + STOP + END IF + IERR = 0 + RETURN + END SUBROUTINE MPI_REDUCE +C*********************************************************************** + SUBROUTINE MPI_REDUCE_SCATTER( SENDBUF, RECVBUF, RCVCOUNT, + & DATATYPE, OP, COMM, IERR ) + IMPLICIT NONE + INTEGER RCVCOUNT, DATATYPE, OP, ROOT, COMM, IERR + INTEGER SENDBUF(*), RECVBUF(*) + CALL MUMPS_COPY( RCVCOUNT, SENDBUF, RECVBUF, DATATYPE, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) 'ERROR in MPI_REDUCE_SCATTER, DATATYPE=',DATATYPE + STOP + END IF + IERR = 0 + RETURN + END SUBROUTINE MPI_REDUCE_SCATTER +C*********************************************************************** + SUBROUTINE MPI_ABORT( COMM, IERRCODE, IERR ) + IMPLICIT NONE + INTEGER COMM, IERRCODE, IERR + WRITE(*,*) "** MPI_ABORT called" + STOP + END SUBROUTINE MPI_ABORT +C*********************************************************************** + SUBROUTINE MPI_ALLTOALL( SENDBUF, SENDCNT, SENDTYPE, + & RECVBUF, RECVCNT, RECVTYPE, COMM, IERR ) + IMPLICIT NONE + INTEGER SENDCNT, SENDTYPE, RECVCNT, RECVTYPE, COMM, IERR + INTEGER SENDBUF(*), RECVBUF(*) + IF ( RECVCNT .NE. SENDCNT ) THEN + WRITE(*,*) 'ERROR in MPI_ALLTOALL, RECVCOUNT != SENDCOUNT' + STOP + ELSE IF ( RECVTYPE .NE. SENDTYPE ) THEN + WRITE(*,*) 'ERROR in MPI_ALLTOALL, RECVTYPE != SENDTYPE' + STOP + ELSE + CALL MUMPS_COPY( SENDCNT, SENDBUF, RECVBUF, SENDTYPE, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) 'ERROR in MPI_ALLTOALL, SENDTYPE=',SENDTYPE + STOP + END IF + END IF + IERR = 0 + RETURN + END SUBROUTINE MPI_ALLTOALL +C*********************************************************************** + SUBROUTINE MPI_ATTR_PUT( COMM, KEY, VAL, IERR ) + IMPLICIT NONE + INTEGER COMM, KEY, VAL, IERR + RETURN + END SUBROUTINE MPI_ATTR_PUT +C*********************************************************************** + SUBROUTINE MPI_BARRIER( COMM, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COMM, IERR + IERR = 0 + RETURN + END SUBROUTINE MPI_BARRIER +C*********************************************************************** + SUBROUTINE MPI_GET_PROCESSOR_NAME( NAME, RESULTLEN, IERROR) + CHARACTER (LEN=*) NAME + INTEGER RESULTLEN,IERROR + RESULTLEN = 1 + IERROR = 0 + NAME = 'X' + RETURN + END SUBROUTINE MPI_GET_PROCESSOR_NAME +C*********************************************************************** + SUBROUTINE MPI_BCAST( BUFFER, COUNT, DATATYPE, ROOT, COMM, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COUNT, DATATYPE, ROOT, COMM, IERR + INTEGER BUFFER( * ) + IERR = 0 + RETURN + END SUBROUTINE MPI_BCAST +C*********************************************************************** + SUBROUTINE MPI_CANCEL( IREQ, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IREQ, IERR + IERR = 0 + RETURN + END SUBROUTINE MPI_CANCEL +C*********************************************************************** + SUBROUTINE MPI_COMM_CREATE( COMM, GROUP, COMM2, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COMM, GROUP, COMM2, IERR + IERR = 0 + RETURN + END SUBROUTINE MPI_COMM_CREATE +C*********************************************************************** + SUBROUTINE MPI_COMM_DUP( COMM, COMM2, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COMM, COMM2, IERR + IERR = 0 + RETURN + END SUBROUTINE MPI_COMM_DUP +C*********************************************************************** + SUBROUTINE MPI_COMM_FREE( COMM, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COMM, IERR + IERR = 0 + RETURN + END SUBROUTINE MPI_COMM_FREE +C*********************************************************************** + SUBROUTINE MPI_COMM_GROUP( COMM, GROUP, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COMM, GROUP, IERR + IERR = 0 + RETURN + END SUBROUTINE MPI_COMM_GROUP +C*********************************************************************** + SUBROUTINE MPI_COMM_RANK( COMM, RANK, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COMM, RANK, IERR + RANK = 0 + IERR = 0 + RETURN + END SUBROUTINE MPI_COMM_RANK +C*********************************************************************** + SUBROUTINE MPI_COMM_SIZE( COMM, SIZE, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COMM, SIZE, IERR + SIZE = 1 + IERR = 0 + RETURN + END SUBROUTINE MPI_COMM_SIZE +C*********************************************************************** + SUBROUTINE MPI_COMM_SPLIT( COMM, COLOR, KEY, COMM2, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COMM, COLOR, KEY, COMM2, IERR + IERR = 0 + RETURN + END SUBROUTINE MPI_COMM_SPLIT +C*********************************************************************** +c SUBROUTINE MPI_ERRHANDLER_SET( COMM, ERRHANDLER, IERR ) +c IMPLICIT NONE +c INCLUDE 'mpif.h' +c INTEGER COMM, ERRHANDLER, IERR +c IERR = 0 +c RETURN +c END SUBROUTINE MPI_ERRHANDLER_SET +C*********************************************************************** + SUBROUTINE MPI_FINALIZE( IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + IERR = 0 + RETURN + END SUBROUTINE MPI_FINALIZE +C*********************************************************************** + SUBROUTINE MPI_GET_COUNT( STATUS, DATATYPE, COUNT, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER DATATYPE, COUNT, IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + WRITE(*,*) 'Error. MPI_GET_COUNT should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_GET_COUNT +C*********************************************************************** + SUBROUTINE MPI_GROUP_FREE( GROUP, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER GROUP, IERR + IERR = 0 + RETURN + END SUBROUTINE MPI_GROUP_FREE +C*********************************************************************** + SUBROUTINE MPI_GROUP_RANGE_EXCL( GROUP, N, RANGES, GROUP2, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER GROUP, N, GROUP2, IERR + INTEGER RANGES(*) + IERR = 0 + RETURN + END SUBROUTINE MPI_GROUP_RANGE_EXCL +C*********************************************************************** + SUBROUTINE MPI_GROUP_SIZE( GROUP, SIZE, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER GROUP, SIZE, IERR + SIZE = 1 ! Or should it be zero ? + IERR = 0 + RETURN + END SUBROUTINE MPI_GROUP_SIZE +C*********************************************************************** + SUBROUTINE MPI_INIT(IERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + IERR = 0 + RETURN + END SUBROUTINE MPI_INIT +C*********************************************************************** + SUBROUTINE MPI_INITIALIZED( FLAG, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + LOGICAL FLAG + INTEGER IERR + FLAG = .TRUE. + IERR = 0 + RETURN + END SUBROUTINE MPI_INITIALIZED +C*********************************************************************** + SUBROUTINE MPI_IPROBE( SOURCE, TAG, COMM, FLAG, STATUS, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER SOURCE, TAG, COMM, IERR + INTEGER STATUS(MPI_STATUS_SIZE) + LOGICAL FLAG + FLAG = .FALSE. + IERR = 0 + RETURN + END SUBROUTINE MPI_IPROBE +C*********************************************************************** + SUBROUTINE MPI_IRECV( BUF, COUNT, DATATYPE, SOURCE, TAG, COMM, + & IREQ, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COUNT, DATATYPE, SOURCE, TAG, COMM, IREQ, IERR + INTEGER BUF(*) + IERR = 0 + RETURN + END SUBROUTINE MPI_IRECV +C*********************************************************************** + SUBROUTINE MPI_ISEND( BUF, COUNT, DATATYPE, DEST, TAG, COMM, + & IREQ, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COUNT, DATATYPE, DEST, TAG, COMM, IERR, IREQ + INTEGER BUF(*) + WRITE(*,*) 'Error. MPI_ISEND should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_ISEND +C*********************************************************************** + SUBROUTINE MPI_TYPE_COMMIT( NEWTYP, IERR_MPI ) + IMPLICIT NONE + INTEGER NEWTYP, IERR_MPI + RETURN + END SUBROUTINE MPI_TYPE_COMMIT +C*********************************************************************** + SUBROUTINE MPI_TYPE_FREE( NEWTYP, IERR_MPI ) + IMPLICIT NONE + INTEGER NEWTYP, IERR_MPI + RETURN + END SUBROUTINE MPI_TYPE_FREE +C*********************************************************************** + SUBROUTINE MPI_TYPE_CONTIGUOUS( LENGTH, DATATYPE, NEWTYPE, + & IERR_MPI ) + IMPLICIT NONE + INTEGER LENGTH, DATATYPE, NEWTYPE, IERR_MPI + RETURN + END SUBROUTINE MPI_TYPE_CONTIGUOUS +C*********************************************************************** + SUBROUTINE MPI_OP_CREATE( FUNC, COMMUTE, OP, IERR ) + IMPLICIT NONE + EXTERNAL FUNC + LOGICAL COMMUTE + INTEGER OP, IERR + OP = 0 + RETURN + END SUBROUTINE MPI_OP_CREATE +C*********************************************************************** + SUBROUTINE MPI_OP_FREE( OP, IERR ) + IMPLICIT NONE + INTEGER OP, IERR + RETURN + END SUBROUTINE MPI_OP_FREE +C*********************************************************************** + SUBROUTINE MPI_PACK( INBUF, INCOUNT, DATATYPE, OUTBUF, OUTCOUNT, + & POSITION, COMM, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER INCOUNT, DATATYPE, OUTCOUNT, POSITION, COMM, IERR + INTEGER INBUF(*), OUTBUF(*) + WRITE(*,*) 'Error. MPI_PACKED should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_PACK +C*********************************************************************** + SUBROUTINE MPI_PACK_SIZE( INCOUNT, DATATYPE, COMM, SIZE, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER INCOUNT, DATATYPE, COMM, SIZE, IERR + WRITE(*,*) 'Error. MPI_PACK_SIZE should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_PACK_SIZE +C*********************************************************************** + SUBROUTINE MPI_PROBE( SOURCE, TAG, COMM, STATUS, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER SOURCE, TAG, COMM, IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + WRITE(*,*) 'Error. MPI_PROBE should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_PROBE +C*********************************************************************** + SUBROUTINE MPI_RECV( BUF, COUNT, DATATYPE, SOURCE, TAG, COMM, + & STATUS, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COUNT, DATATYPE, SOURCE, TAG, COMM, IERR + INTEGER BUF(*), STATUS(MPI_STATUS_SIZE) + WRITE(*,*) 'Error. MPI_RECV should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_RECV +C*********************************************************************** + SUBROUTINE MPI_REQUEST_FREE( IREQ, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IREQ, IERR + IERR = 0 + RETURN + END SUBROUTINE MPI_REQUEST_FREE +C*********************************************************************** + SUBROUTINE MPI_SEND( BUF, COUNT, DATATYPE, DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COUNT, DATATYPE, DEST, TAG, COMM, IERR + INTEGER BUF(*) + WRITE(*,*) 'Error. MPI_SEND should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_SEND +C*********************************************************************** + SUBROUTINE MPI_SSEND( BUF, COUNT, DATATYPE, DEST, TAG, COMM, IERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COUNT, DATATYPE, DEST, TAG, COMM, IERR + INTEGER BUF(*) + WRITE(*,*) 'Error. MPI_SSEND should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_SSEND +C*********************************************************************** + SUBROUTINE MPI_TEST( IREQ, FLAG, STATUS, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IREQ, IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG + FLAG = .FALSE. + IERR = 0 + RETURN + END SUBROUTINE MPI_TEST +C*********************************************************************** + SUBROUTINE MPI_UNPACK( INBUF, INSIZE, POSITION, OUTBUF, OUTCOUNT, + & DATATYPE, COMM, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER INSIZE, POSITION, OUTCOUNT, DATATYPE, COMM, IERR + INTEGER INBUF(*), OUTBUF(*) + WRITE(*,*) 'Error. MPI_UNPACK should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_UNPACK +C*********************************************************************** + SUBROUTINE MPI_WAIT( IREQ, STATUS, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IREQ, IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + WRITE(*,*) 'Error. MPI_WAIT should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_WAIT +C*********************************************************************** + SUBROUTINE MPI_WAITALL( COUNT, ARRAY_OF_REQUESTS, STATUS, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COUNT, IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER ARRAY_OF_REQUESTS( COUNT ) + WRITE(*,*) 'Error. MPI_WAITALL should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_WAITALL +C*********************************************************************** + SUBROUTINE MPI_WAITANY( COUNT, ARRAY_OF_REQUESTS, INDEX, STATUS, + & IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COUNT, INDEX, IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER ARRAY_OF_REQUESTS( COUNT ) + WRITE(*,*) 'Error. MPI_WAITANY should not be called.' + STOP + IERR = 0 + RETURN + END SUBROUTINE MPI_WAITANY +C*********************************************************************** + DOUBLE PRECISION FUNCTION MPI_WTIME( ) +C elapsed time + DOUBLE PRECISION VAL +C write(*,*) 'Entering MPI_WTIME' + CALL MUMPS_ELAPSE( VAL ) + MPI_WTIME = VAL +C write(*,*) 'Exiting MPI_WTIME' + RETURN + END FUNCTION MPI_WTIME + + +C*********************************************************************** +C +C Utilities to copy data +C +C*********************************************************************** + + SUBROUTINE MUMPS_COPY( COUNT, SENDBUF, RECVBUF, DATATYPE, IERR ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COUNT, DATATYPE, IERR + INTEGER SENDBUF(*), RECVBUF(*) + IF ( DATATYPE .EQ. MPI_INTEGER ) THEN + CALL MUMPS_COPY_INTEGER( SENDBUF, RECVBUF, COUNT ) + ELSEIF ( DATATYPE .EQ. MPI_LOGICAL ) THEN + CALL MUMPS_COPY_LOGICAL( SENDBUF, RECVBUF, COUNT ) + ELSE IF ( DATATYPE .EQ. MPI_REAL ) THEN + CALL MUMPS_COPY_REAL( SENDBUF, RECVBUF, COUNT ) + ELSE IF ( DATATYPE .EQ. MPI_DOUBLE_PRECISION .OR. + & DATATYPE .EQ. MPI_REAL8 ) THEN + CALL MUMPS_COPY_DOUBLE_PRECISION( SENDBUF, RECVBUF, COUNT ) + ELSE IF ( DATATYPE .EQ. MPI_COMPLEX ) THEN + CALL MUMPS_COPY_COMPLEX( SENDBUF, RECVBUF, COUNT ) + ELSE IF ( DATATYPE .EQ. MPI_DOUBLE_COMPLEX ) THEN + CALL MUMPS_COPY_DOUBLE_COMPLEX( SENDBUF, RECVBUF, COUNT ) + ELSE IF ( DATATYPE .EQ. MPI_2DOUBLE_PRECISION) THEN + CALL MUMPS_COPY_2DOUBLE_PRECISION( SENDBUF, RECVBUF, COUNT ) + ELSE IF ( DATATYPE .EQ. MPI_2INTEGER) THEN + CALL MUMPS_COPY_2INTEGER( SENDBUF, RECVBUF, COUNT ) + ELSE + IERR=1 + RETURN + END IF + IERR=0 + RETURN + END SUBROUTINE MUMPS_COPY + + SUBROUTINE MUMPS_COPY_INTEGER( S, R, N ) + IMPLICIT NONE + INTEGER N + INTEGER S(N),R(N) + INTEGER I + DO I = 1, N + R(I) = S(I) + END DO + RETURN + END SUBROUTINE MUMPS_COPY_INTEGER + SUBROUTINE MUMPS_COPY_LOGICAL( S, R, N ) + IMPLICIT NONE + INTEGER N + LOGICAL S(N),R(N) + INTEGER I + DO I = 1, N + R(I) = S(I) + END DO + RETURN + END + SUBROUTINE MUMPS_COPY_2INTEGER( S, R, N ) + IMPLICIT NONE + INTEGER N + INTEGER S(N+N),R(N+N) + INTEGER I + DO I = 1, N+N + R(I) = S(I) + END DO + RETURN + END SUBROUTINE MUMPS_COPY_2INTEGER + SUBROUTINE MUMPS_COPY_REAL( S, R, N ) + IMPLICIT NONE + INTEGER N + REAL S(N),R(N) + INTEGER I + DO I = 1, N + R(I) = S(I) + END DO + RETURN + END + SUBROUTINE MUMPS_COPY_2DOUBLE_PRECISION( S, R, N ) + IMPLICIT NONE + INTEGER N + DOUBLE PRECISION S(N+N),R(N+N) + INTEGER I + DO I = 1, N+N + R(I) = S(I) + END DO + RETURN + END SUBROUTINE MUMPS_COPY_2DOUBLE_PRECISION + SUBROUTINE MUMPS_COPY_DOUBLE_PRECISION( S, R, N ) + IMPLICIT NONE + INTEGER N + DOUBLE PRECISION S(N),R(N) + INTEGER I + DO I = 1, N + R(I) = S(I) + END DO + RETURN + END + SUBROUTINE MUMPS_COPY_COMPLEX( S, R, N ) + IMPLICIT NONE + INTEGER N + COMPLEX S(N),R(N) + INTEGER I + DO I = 1, N + R(I) = S(I) + END DO + RETURN + END SUBROUTINE MUMPS_COPY_COMPLEX + SUBROUTINE MUMPS_COPY_DOUBLE_COMPLEX( S, R, N ) + IMPLICIT NONE + INTEGER N +C DOUBLE COMPLEX S(N),R(N) + COMPLEX(kind=kind(0.0D0)) :: S(N),R(N) + INTEGER I + DO I = 1, N + R(I) = S(I) + END DO + RETURN + END + + +C*********************************************************************** +C +C BLACS +C +C*********************************************************************** + SUBROUTINE blacs_gridinit( CNTXT, C, NPROW, NPCOL ) + IMPLICIT NONE + INTEGER CNTXT, NPROW, NPCOL + CHARACTER C + WRITE(*,*) 'Error. BLACS_GRIDINIT should not be called.' + STOP + RETURN + END SUBROUTINE blacs_gridinit +C*********************************************************************** + SUBROUTINE blacs_gridinfo( CNTXT, NPROW, NPCOL, MYROW, MYCOL ) + IMPLICIT NONE + INTEGER CNTXT, NPROW, NPCOL, MYROW, MYCOL + WRITE(*,*) 'Error. BLACS_GRIDINFO should not be called.' + STOP + RETURN + END SUBROUTINE blacs_gridinfo +C*********************************************************************** + SUBROUTINE blacs_gridexit( CNTXT ) + IMPLICIT NONE + INTEGER CNTXT + WRITE(*,*) 'Error. BLACS_GRIDEXIT should not be called.' + STOP + RETURN + END SUBROUTINE blacs_gridexit + + +C*********************************************************************** +C +C ScaLAPACK +C +C*********************************************************************** + SUBROUTINE DESCINIT( DESC, M, N, MB, NB, IRSRC, ICSRC, + & ICTXT, LLD, INFO ) + IMPLICIT NONE + INTEGER ICSRC, ICTXT, INFO, IRSRC, LLD, M, MB, N, NB + INTEGER DESC( * ) + WRITE(*,*) 'Error. DESCINIT should not be called.' + STOP + RETURN + END SUBROUTINE DESCINIT +C*********************************************************************** + INTEGER FUNCTION numroc( N, NB, IPROC, ISRCPROC, NPROCS ) + INTEGER N, NB, IPROC, ISRCPROC, NPROCS +C Can be called + IF ( NPROCS .ne. 1 ) THEN + WRITE(*,*) 'Error. Last parameter from NUMROC should be 1' + STOP + ENDIF + IF ( IPROC .ne. 0 ) THEN + WRITE(*,*) 'Error. IPROC should be 0 in NUMROC.' + STOP + ENDIF + NUMROC = N + RETURN + END FUNCTION numroc +C*********************************************************************** + SUBROUTINE pcpotrf( UPLO, N, A, IA, JA, DESCA, INFO ) + IMPLICIT NONE + CHARACTER UPLO + INTEGER IA, INFO, JA, N + INTEGER DESCA( * ) + COMPLEX A( * ) + WRITE(*,*) 'Error. PCPOTRF should not be called.' + STOP + RETURN + END SUBROUTINE pcpotrf +C*********************************************************************** + SUBROUTINE pcgetrf( M, N, A, IA, JA, DESCA, IPIV, INFO ) + IMPLICIT NONE + INTEGER IA, INFO, JA, M, N + INTEGER DESCA( * ), IPIV( * ) + COMPLEX A( * ) + WRITE(*,*) 'Error. PCGETRF should not be called.' + STOP + RETURN + END SUBROUTINE pcgetrf +C*********************************************************************** + SUBROUTINE pctrtrs( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, + & B, IB, JB, DESCB, INFO ) + IMPLICIT NONE + CHARACTER DIAG, TRANS, UPLO + INTEGER IA, IB, INFO, JA, JB, N, NRHS + INTEGER DESCA( * ), DESCB( * ) + COMPLEX A( * ), B( * ) + WRITE(*,*) 'Error. PCTRTRS should not be called.' + STOP + RETURN + END SUBROUTINE pctrtrs +C*********************************************************************** + SUBROUTINE pzpotrf( UPLO, N, A, IA, JA, DESCA, INFO ) + IMPLICIT NONE + CHARACTER UPLO + INTEGER IA, INFO, JA, N + INTEGER DESCA( * ) +C DOUBLE COMPLEX A( * ) + COMPLEX(kind=kind(0.0D0)) :: A( * ) + WRITE(*,*) 'Error. PZPOTRF should not be called.' + STOP + RETURN + END SUBROUTINE pzpotrf +C*********************************************************************** + SUBROUTINE pzgetrf( M, N, A, IA, JA, DESCA, IPIV, INFO ) + IMPLICIT NONE + INTEGER IA, INFO, JA, M, N + INTEGER DESCA( * ), IPIV( * ) +C DOUBLE COMPLEX A( * ) + COMPLEX(kind=kind(0.0D0)) :: A( * ) + WRITE(*,*) 'Error. PZGETRF should not be called.' + STOP + RETURN + END SUBROUTINE pzgetrf +C*********************************************************************** + SUBROUTINE pztrtrs( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, + & B, IB, JB, DESCB, INFO ) + IMPLICIT NONE + CHARACTER DIAG, TRANS, UPLO + INTEGER IA, IB, INFO, JA, JB, N, NRHS + INTEGER DESCA( * ), DESCB( * ) +C DOUBLE COMPLEX A( * ), B( * ) + COMPLEX(kind=kind(0.0D0)) :: A( * ), B( * ) + WRITE(*,*) 'Error. PZTRTRS should not be called.' + STOP + RETURN + END SUBROUTINE pztrtrs +C*********************************************************************** + SUBROUTINE pspotrf( UPLO, N, A, IA, JA, DESCA, INFO ) + IMPLICIT NONE + CHARACTER UPLO + INTEGER IA, INFO, JA, N + INTEGER DESCA( * ) + REAL A( * ) + WRITE(*,*) 'Error. PSPOTRF should not be called.' + STOP + RETURN + END SUBROUTINE pspotrf +C*********************************************************************** + SUBROUTINE psgetrf( M, N, A, IA, JA, DESCA, IPIV, INFO ) + IMPLICIT NONE + INTEGER IA, INFO, JA, M, N + INTEGER DESCA( * ), IPIV( * ) + REAL A( * ) + WRITE(*,*) 'Error. PSGETRF should not be called.' + STOP + RETURN + END SUBROUTINE psgetrf +C*********************************************************************** + SUBROUTINE pstrtrs( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, + & B, IB, JB, DESCB, INFO ) + IMPLICIT NONE + CHARACTER DIAG, TRANS, UPLO + INTEGER IA, IB, INFO, JA, JB, N, NRHS + INTEGER DESCA( * ), DESCB( * ) + REAL A( * ), B( * ) + WRITE(*,*) 'Error. PSTRTRS should not be called.' + STOP + RETURN + END SUBROUTINE pstrtrs +C*********************************************************************** + SUBROUTINE pdpotrf( UPLO, N, A, IA, JA, DESCA, INFO ) + IMPLICIT NONE + CHARACTER UPLO + INTEGER IA, INFO, JA, N + INTEGER DESCA( * ) + DOUBLE PRECISION A( * ) + WRITE(*,*) 'Error. PDPOTRF should not be called.' + STOP + RETURN + END SUBROUTINE pdpotrf +C*********************************************************************** + SUBROUTINE pdgetrf( M, N, A, IA, JA, DESCA, IPIV, INFO ) + IMPLICIT NONE + INTEGER IA, INFO, JA, M, N + INTEGER DESCA( * ), IPIV( * ) + DOUBLE PRECISION A( * ) + WRITE(*,*) 'Error. PDGETRF should not be called.' + STOP + RETURN + END SUBROUTINE pdgetrf +C*********************************************************************** + SUBROUTINE pdtrtrs( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, + & B, IB, JB, DESCB, INFO ) + IMPLICIT NONE + CHARACTER DIAG, TRANS, UPLO + INTEGER IA, IB, INFO, JA, JB, N, NRHS + INTEGER DESCA( * ), DESCB( * ) + DOUBLE PRECISION A( * ), B( * ) + WRITE(*,*) 'Error. PDTRTRS should not be called.' + STOP + RETURN + END SUBROUTINE pdtrtrs +C*********************************************************************** + SUBROUTINE INFOG2L( GRINDX, GCINDX, DESC, NPROW, NPCOL, MYROW, + & MYCOL, LRINDX, LCINDX, RSRC, CSRC ) + IMPLICIT NONE + INTEGER CSRC, GCINDX, GRINDX, LRINDX, LCINDX, MYCOL, + & MYROW, NPCOL, NPROW, RSRC + INTEGER DESC( * ) + WRITE(*,*) 'Error. INFOG2L should not be called.' + STOP + RETURN + END SUBROUTINE INFOG2L +C*********************************************************************** + INTEGER FUNCTION INDXG2P( INDXGLOB, NB, IPROC, ISRCPROC, NPROCS ) + INTEGER INDXGLOB, IPROC, ISRCPROC, NB, NPROCS + INDXG2P = 0 + WRITE(*,*) 'Error. INFOG2L should not be called.' + STOP + RETURN + END FUNCTION INDXG2P +C*********************************************************************** + SUBROUTINE pcscal(N, ALPHA, X, IX, JX, DESCX, INCX) + IMPLICIT NONE + INTEGER INCX, N, IX, JX + COMPLEX ALPHA + COMPLEX X( * ) + INTEGER DESCX( * ) + WRITE(*,*) 'Error. PCSCAL should not be called.' + STOP + RETURN + END SUBROUTINE pcscal +C*********************************************************************** + SUBROUTINE pzscal(N, ALPHA, X, IX, JX, DESCX, INCX) + IMPLICIT NONE + INTEGER INCX, N, IX, JX +C DOUBLE COMPLEX ALPHA +C DOUBLE COMPLEX X( * ) + COMPLEX(kind=kind(0.0D0)) :: ALPHA, X( * ) + INTEGER DESCX( * ) + WRITE(*,*) 'Error. PZSCAL should not be called.' + STOP + RETURN + END SUBROUTINE pzscal +C*********************************************************************** + SUBROUTINE pdscal(N, ALPHA, X, IX, JX, DESCX, INCX) + IMPLICIT NONE + INTEGER INCX, N, IX, JX + DOUBLE PRECISION ALPHA + DOUBLE PRECISION X( * ) + INTEGER DESCX( * ) + WRITE(*,*) 'Error. PDSCAL should not be called.' + STOP + RETURN + END SUBROUTINE pdscal +C*********************************************************************** + SUBROUTINE psscal(N, ALPHA, X, IX, JX, DESCX, INCX) + IMPLICIT NONE + INTEGER INCX, N, IX, JX + REAL ALPHA + REAL X( * ) + INTEGER DESCX( * ) + WRITE(*,*) 'Error. PSSCAL should not be called.' + STOP + RETURN + END SUBROUTINE psscal +C*********************************************************************** + SUBROUTINE pzdot + & ( N, DOT, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, INCY ) + IMPLICIT NONE + INTEGER N, IX, JX, IY, JY, INCX, INCY + INTEGER DESCX(*), DESCY(*) +C DOUBLE COMPLEX X(*), Y(*) + COMPLEX(kind=kind(0.0D0)) :: X(*), Y(*) + DOUBLE PRECISION DOT + DOT = 0.0d0 + WRITE(*,*) 'Error. PZDOT should not be called.' + STOP + RETURN + END SUBROUTINE pzdot +C*********************************************************************** + SUBROUTINE pcdot + & ( N, DOT, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, INCY ) + IMPLICIT NONE + INTEGER N, IX, JX, IY, JY, INCX, INCY + INTEGER DESCX(*), DESCY(*) + COMPLEX X(*), Y(*) + REAL DOT + DOT = 0.0e0 + WRITE(*,*) 'Error. PCDOT should not be called.' + STOP + RETURN + END SUBROUTINE pcdot +C*********************************************************************** + SUBROUTINE pddot + & ( N, DOT, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, INCY ) + IMPLICIT NONE + INTEGER N, IX, JX, IY, JY, INCX, INCY + INTEGER DESCX(*), DESCY(*) + DOUBLE PRECISION X(*), Y(*), DOT + DOT = 0.0d0 + WRITE(*,*) 'Error. PDDOT should not be called.' + STOP + RETURN + END SUBROUTINE pddot +C*********************************************************************** + SUBROUTINE psdot + & ( N, DOT, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, INCY ) + IMPLICIT NONE + INTEGER N, IX, JX, IY, JY, INCX, INCY + INTEGER DESCX(*), DESCY(*) + REAL X(*), Y(*), DOT + DOT = 0.0e0 + WRITE(*,*) 'Error. PSDOT should not be called.' + STOP + RETURN + END SUBROUTINE psdot +C*********************************************************************** + SUBROUTINE zgebs2d( CONTXT, SCOPE, TOP, M, N, A, LDA ) + IMPLICIT NONE + INTEGER CONTXT, M, N, LDA +C DOUBLE COMPLEX A(*) + COMPLEX(kind=kind(0.0D0)) :: A(*) + CHARACTER SCOPE, TOP + WRITE(*,*) 'Error. ZGEBS2D should not be called.' + STOP + RETURN + END SUBROUTINE zgebs2d +C*********************************************************************** + SUBROUTINE cgebs2d( CONTXT, SCOPE, TOP, M, N, A, LDA ) + IMPLICIT NONE + INTEGER CONTXT, M, N, LDA + COMPLEX A(*) + CHARACTER SCOPE, TOP + WRITE(*,*) 'Error. CGEBS2D should not be called.' + STOP + RETURN + END SUBROUTINE cgebs2d +C*********************************************************************** + SUBROUTINE sgebs2d( CONTXT, SCOPE, TOP, M, N, A, LDA ) + IMPLICIT NONE + INTEGER CONTXT, M, N, LDA + REAL A(*) + CHARACTER SCOPE, TOP + WRITE(*,*) 'Error. SGEBS2D should not be called.' + STOP + RETURN + END SUBROUTINE sgebs2d +C*********************************************************************** + SUBROUTINE dgebs2d( CONTXT, SCOPE, TOP, M, N, A, LDA ) + IMPLICIT NONE + INTEGER CONTXT, M, N, LDA + DOUBLE PRECISION A(*) + CHARACTER SCOPE, TOP + WRITE(*,*) 'Error. DGEBS2D should not be called.' + STOP + RETURN + END SUBROUTINE dgebs2d +C*********************************************************************** + SUBROUTINE zgebr2d( CONTXT, SCOPE, TOP, M, N, A, LDA ) + IMPLICIT NONE + INTEGER CONTXT, M, N, LDA +C DOUBLE COMPLEX A(*) + COMPLEX(kind=kind(0.0D0)) :: A(*) + CHARACTER SCOPE, TOP + WRITE(*,*) 'Error. ZGEBR2D should not be called.' + STOP + RETURN + END SUBROUTINE zgebr2d +C*********************************************************************** + SUBROUTINE cgebr2d( CONTXT, SCOPE, TOP, M, N, A, LDA ) + IMPLICIT NONE + INTEGER CONTXT, M, N, LDA + COMPLEX A(*) + CHARACTER SCOPE, TOP + WRITE(*,*) 'Error. CGEBR2D should not be called.' + STOP + RETURN + END SUBROUTINE cgebr2d +C*********************************************************************** + SUBROUTINE sgebr2d( CONTXT, SCOPE, TOP, M, N, A, LDA ) + IMPLICIT NONE + INTEGER CONTXT, M, N, LDA + REAL A(*) + CHARACTER SCOPE, TOP + WRITE(*,*) 'Error. SGEBR2D should not be called.' + STOP + RETURN + END SUBROUTINE sgebr2d +C*********************************************************************** + SUBROUTINE dgebr2d( CONTXT, SCOPE, TOP, M, N, A, LDA ) + IMPLICIT NONE + INTEGER CONTXT, M, N, LDA + DOUBLE PRECISION A(*) + CHARACTER SCOPE, TOP + WRITE(*,*) 'Error. DGEBR2D should not be called.' + STOP + RETURN + END SUBROUTINE dgebr2d +C*********************************************************************** + SUBROUTINE pcgetrs( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, + & IB, JB, DESCB, INFO ) + IMPLICIT NONE + CHARACTER TRANS + INTEGER IA, IB, INFO, JA, JB, N, NRHS + INTEGER DESCA( * ), DESCB( * ), IPIV( * ) + COMPLEX A( * ), B( * ) + WRITE(*,*) 'Error. PCGETRS should not be called.' + STOP + RETURN + END SUBROUTINE pcgetrs +C*********************************************************************** + SUBROUTINE pzgetrs( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, + & IB, JB, DESCB, INFO ) + IMPLICIT NONE + CHARACTER TRANS + INTEGER IA, IB, INFO, JA, JB, N, NRHS + INTEGER DESCA( * ), DESCB( * ), IPIV( * ) +c DOUBLE COMPLEX A( * ), B( * ) + COMPLEX(kind=kind(0.0D0)) :: A( * ), B( * ) + WRITE(*,*) 'Error. PZGETRS should not be called.' + STOP + RETURN + END SUBROUTINE pzgetrs +C*********************************************************************** + SUBROUTINE psgetrs( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, + & IB, JB, DESCB, INFO ) + IMPLICIT NONE + CHARACTER TRANS + INTEGER IA, IB, INFO, JA, JB, N, NRHS + INTEGER DESCA( * ), DESCB( * ), IPIV( * ) + REAL A( * ), B( * ) + WRITE(*,*) 'Error. PSGETRS should not be called.' + STOP + RETURN + END SUBROUTINE psgetrs +C*********************************************************************** + SUBROUTINE pdgetrs( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, + & IB, JB, DESCB, INFO ) + IMPLICIT NONE + CHARACTER TRANS + INTEGER IA, IB, INFO, JA, JB, N, NRHS + INTEGER DESCA( * ), DESCB( * ), IPIV( * ) + DOUBLE PRECISION A( * ), B( * ) + WRITE(*,*) 'Error. PDGETRS should not be called.' + STOP + RETURN + END SUBROUTINE pdgetrs +C*********************************************************************** + SUBROUTINE pcpotrs( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, + & DESCB, INFO ) + IMPLICIT NONE + CHARACTER UPLO + INTEGER IA, IB, INFO, JA, JB, N, NRHS + INTEGER DESCA( * ), DESCB( * ) + COMPLEX A( * ), B( * ) + WRITE(*,*) 'Error. PCPOTRS should not be called.' + STOP + RETURN + END SUBROUTINE pcpotrs +C*********************************************************************** + SUBROUTINE pzpotrs( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, + & DESCB, INFO ) + IMPLICIT NONE + CHARACTER UPLO + INTEGER IA, IB, INFO, JA, JB, N, NRHS + INTEGER DESCA( * ), DESCB( * ) +c DOUBLE COMPLEX A( * ), B( * ) + COMPLEX(kind=kind(0.0D0)) :: A( * ), B( * ) + WRITE(*,*) 'Error. PZPOTRS should not be called.' + STOP + RETURN + END SUBROUTINE pzpotrs +C*********************************************************************** + SUBROUTINE pspotrs( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, + & DESCB, INFO ) + IMPLICIT NONE + CHARACTER UPLO + INTEGER IA, IB, INFO, JA, JB, N, NRHS + INTEGER DESCA( * ), DESCB( * ) + REAL A( * ), B( * ) + WRITE(*,*) 'Error. PSPOTRS should not be called.' + STOP + RETURN + END SUBROUTINE pspotrs +C*********************************************************************** + SUBROUTINE pdpotrs( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, + & DESCB, INFO ) + IMPLICIT NONE + CHARACTER UPLO + INTEGER IA, IB, INFO, JA, JB, N, NRHS + INTEGER DESCA( * ), DESCB( * ) + DOUBLE PRECISION A( * ), B( * ) + WRITE(*,*) 'Error. PDPOTRS should not be called.' + STOP + RETURN + END SUBROUTINE pdpotrs +C*********************************************************************** + SUBROUTINE pscnrm2( N, NORM2, X, IX, JX, DESCX, INCX ) + IMPLICIT NONE + INTEGER N, IX, JX, INCX + INTEGER DESCX(*) + REAL NORM2 + COMPLEX X( * ) + WRITE(*,*) 'Error. PCNRM2 should not be called.' + STOP + RETURN + END SUBROUTINE pscnrm2 +C*********************************************************************** + SUBROUTINE pdznrm2( N, NORM2, X, IX, JX, DESCX, INCX ) + IMPLICIT NONE + INTEGER N, IX, JX, INCX + INTEGER DESCX(*) + DOUBLE PRECISION NORM2 +C DOUBLE COMPLEX X( * ) + COMPLEX(kind=kind(0.0D0)) :: X( * ) + WRITE(*,*) 'Error. PZNRM2 should not be called.' + STOP + RETURN + END SUBROUTINE pdznrm2 +C*********************************************************************** + SUBROUTINE psnrm2( N, NORM2, X, IX, JX, DESCX, INCX ) + IMPLICIT NONE + INTEGER N, IX, JX, INCX + INTEGER DESCX(*) + REAL NORM2, X( * ) + WRITE(*,*) 'Error. PSNRM2 should not be called.' + STOP + RETURN + END SUBROUTINE psnrm2 +C*********************************************************************** + SUBROUTINE pdnrm2( N, NORM2, X, IX, JX, DESCX, INCX ) + IMPLICIT NONE + INTEGER N, IX, JX, INCX + INTEGER DESCX(*) + DOUBLE PRECISION NORM2, X( * ) + WRITE(*,*) 'Error. PDNRM2 should not be called.' + STOP + RETURN + END SUBROUTINE pdnrm2 +C*********************************************************************** + REAL FUNCTION pclange( NORM, M, N, A, IA, JA, + & DESCA, WORK ) + CHARACTER NORM + INTEGER IA, JA, M, N + INTEGER DESCA( * ) + COMPLEX A( * ), WORK( * ) + PCLANGE = 0.0e0 + WRITE(*,*) 'Error. PCLANGE should not be called.' + STOP + RETURN + END FUNCTION pclange +C*********************************************************************** + DOUBLE PRECISION FUNCTION pzlange( NORM, M, N, A, IA, JA, + & DESCA, WORK ) + CHARACTER NORM + INTEGER IA, JA, M, N + INTEGER DESCA( * ) + REAL A( * ), WORK( * ) + PZLANGE = 0.0d0 + WRITE(*,*) 'Error. PZLANGE should not be called.' + STOP + RETURN + END FUNCTION pzlange +C*********************************************************************** + REAL FUNCTION pslange( NORM, M, N, A, IA, JA, + & DESCA, WORK ) + CHARACTER NORM + INTEGER IA, JA, M, N + INTEGER DESCA( * ) + REAL A( * ), WORK( * ) + PSLANGE = 0.0e0 + WRITE(*,*) 'Error. PSLANGE should not be called.' + STOP + RETURN + END FUNCTION pslange +C*********************************************************************** + DOUBLE PRECISION FUNCTION pdlange( NORM, M, N, A, IA, JA, + & DESCA, WORK ) + CHARACTER NORM + INTEGER IA, JA, M, N + INTEGER DESCA( * ) + DOUBLE PRECISION A( * ), WORK( * ) + PDLANGE = 0.0d0 + WRITE(*,*) 'Error. PDLANGE should not be called.' + STOP + RETURN + END FUNCTION pdlange +C*********************************************************************** + SUBROUTINE pcgecon( NORM, N, A, IA, JA, DESCA, ANORM, + & RCOND, WORK, LWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE + + CHARACTER NORM + INTEGER IA, INFO, JA, LIWORK, LWORK, N + REAL ANORM, RCOND + INTEGER DESCA( * ), IWORK( * ) + COMPLEX A( * ), WORK( * ) + WRITE(*,*) 'Error. PCGECON should not be called.' + STOP + RETURN + END SUBROUTINE pcgecon +C*********************************************************************** + SUBROUTINE pzgecon( NORM, N, A, IA, JA, DESCA, ANORM, + & RCOND, WORK, LWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE + + CHARACTER NORM + INTEGER IA, INFO, JA, LIWORK, LWORK, N + DOUBLE PRECISION ANORM, RCOND + INTEGER DESCA( * ), IWORK( * ) +C DOUBLE COMPLEX A( * ), WORK( * ) + COMPLEX(kind=kind(0.0D0)) :: A( * ), WORK( * ) + WRITE(*,*) 'Error. PZGECON should not be called.' + STOP + RETURN + END SUBROUTINE pzgecon +C*********************************************************************** + SUBROUTINE psgecon( NORM, N, A, IA, JA, DESCA, ANORM, + & RCOND, WORK, LWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE + + CHARACTER NORM + INTEGER IA, INFO, JA, LIWORK, LWORK, N + REAL ANORM, RCOND + INTEGER DESCA( * ), IWORK( * ) + REAL A( * ), WORK( * ) + WRITE(*,*) 'Error. PSGECON should not be called.' + STOP + RETURN + END SUBROUTINE psgecon +C*********************************************************************** + SUBROUTINE pdgecon( NORM, N, A, IA, JA, DESCA, ANORM, + & RCOND, WORK, LWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE + + CHARACTER NORM + INTEGER IA, INFO, JA, LIWORK, LWORK, N + DOUBLE PRECISION ANORM, RCOND + INTEGER DESCA( * ), IWORK( * ) + DOUBLE PRECISION A( * ), WORK( * ) + WRITE(*,*) 'Error. PDGECON should not be called.' + STOP + RETURN + END SUBROUTINE pdgecon +C*********************************************************************** + SUBROUTINE pcgeqpf( M, N, A, IA, JA, DESCA, IPIV, TAU, + & WORK, LWORK, INFO ) + IMPLICIT NONE + INTEGER IA, JA, INFO, LWORK, M, N + INTEGER DESCA( * ), IPIV( * ) + COMPLEX A( * ), TAU( * ), WORK( * ) + WRITE(*,*) 'Error. PCGEQPF should not be called.' + STOP + RETURN + END SUBROUTINE pcgeqpf +C*********************************************************************** + SUBROUTINE pzgeqpf( M, N, A, IA, JA, DESCA, IPIV, TAU, + & WORK, LWORK, INFO ) + IMPLICIT NONE + INTEGER IA, JA, INFO, LWORK, M, N + INTEGER DESCA( * ), IPIV( * ) +C DOUBLE COMPLEX A( * ), TAU( * ), WORK( * ) + COMPLEX(kind=kind(0.0D0)) :: A( * ), TAU( * ), WORK( * ) + WRITE(*,*) 'Error. PZGEQPF should not be called.' + STOP + RETURN + END SUBROUTINE pzgeqpf +C*********************************************************************** + SUBROUTINE psgeqpf( M, N, A, IA, JA, DESCA, IPIV, TAU, + & WORK, LWORK, INFO ) + IMPLICIT NONE + INTEGER IA, JA, INFO, LWORK, M, N + INTEGER DESCA( * ), IPIV( * ) + REAL A( * ), TAU( * ), WORK( * ) + WRITE(*,*) 'Error. PSGEQPF should not be called.' + STOP + RETURN + END SUBROUTINE psgeqpf +C*********************************************************************** + SUBROUTINE pdgeqpf( M, N, A, IA, JA, DESCA, IPIV, TAU, + & WORK, LWORK, INFO ) + IMPLICIT NONE + INTEGER IA, JA, INFO, LWORK, M, N + INTEGER DESCA( * ), IPIV( * ) + DOUBLE PRECISION A( * ), TAU( * ), WORK( * ) + WRITE(*,*) 'Error. PDGEQPF should not be called.' + STOP + RETURN + END SUBROUTINE pdgeqpf +C*********************************************************************** + SUBROUTINE pcaxpy(N, A, X, IX, JX, DESCX, INCX, Y, IY, JY, + & DESCY, INCY) + IMPLICIT NONE + INTEGER N, IX, IY, JX, JY, INCX, INCY + INTEGER DESCX(*), DESCY(*) + COMPLEX A(*),X(*),Y(*) + WRITE(*,*) 'Error. PCAXPY should not be called.' + STOP + RETURN + END SUBROUTINE pcaxpy +C*********************************************************************** + SUBROUTINE pzaxpy(N, A, X, IX, JX, DESCX, INCX, Y, IY, JY, + & DESCY, INCY) + IMPLICIT NONE + INTEGER N, IX, IY, JX, JY, INCX, INCY + INTEGER DESCX(*), DESCY(*) +C DOUBLE COMPLEX A(*),X(*),Y(*) + COMPLEX(kind=kind(0.0D0)) :: A(*),X(*),Y(*) + WRITE(*,*) 'Error. PZAXPY should not be called.' + STOP + RETURN + END SUBROUTINE pzaxpy +C*********************************************************************** + SUBROUTINE psaxpy(N, A, X, IX, JX, DESCX, INCX, Y, IY, JY, + & DESCY, INCY) + IMPLICIT NONE + INTEGER N, IX, IY, JX, JY, INCX, INCY + INTEGER DESCX(*), DESCY(*) + REAL A(*),X(*),Y(*) + WRITE(*,*) 'Error. PSAXPY should not be called.' + STOP + RETURN + END SUBROUTINE psaxpy +C*********************************************************************** + SUBROUTINE pdaxpy(N, A, X, IX, JX, DESCX, INCX, Y, IY, JY, + & DESCY, INCY) + IMPLICIT NONE + INTEGER N, IX, IY, JX, JY, INCX, INCY + INTEGER DESCX(*), DESCY(*) + DOUBLE PRECISION A(*),X(*),Y(*) + WRITE(*,*) 'Error. PDAXPY should not be called.' + STOP + RETURN + END SUBROUTINE pdaxpy +C*********************************************************************** + SUBROUTINE pctrsm ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, IA, + $ JA, DESCA, B, IB, JB, DESCB ) + IMPLICIT NONE + CHARACTER SIDE, UPLO, TRANSA, DIAG + INTEGER M, N, IA, JA, IB, JB + COMPLEX ALPHA + INTEGER DESCA( * ), DESCB( * ) + COMPLEX A( * ), B( * ) + WRITE(*,*) 'Error. PCTRSM should not be called.' + STOP + RETURN + END SUBROUTINE pctrsm +C*********************************************************************** + SUBROUTINE pztrsm ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, IA, + $ JA, DESCA, B, IB, JB, DESCB ) + IMPLICIT NONE + CHARACTER SIDE, UPLO, TRANSA, DIAG + INTEGER M, N, IA, JA, IB, JB +C DOUBLE COMPLEX ALPHA + COMPLEX(kind=kind(0.0D0)) :: ALPHA + INTEGER DESCA( * ), DESCB( * ) +C DOUBLE COMPLEX A( * ), B( * ) + COMPLEX(kind=kind(0.0D0)) :: A( * ), B( * ) + WRITE(*,*) 'Error. PZTRSM should not be called.' + STOP + RETURN + END SUBROUTINE pztrsm +C*********************************************************************** + SUBROUTINE pstrsm ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, IA, + $ JA, DESCA, B, IB, JB, DESCB ) + IMPLICIT NONE + CHARACTER SIDE, UPLO, TRANSA, DIAG + INTEGER M, N, IA, JA, IB, JB + REAL ALPHA + INTEGER DESCA( * ), DESCB( * ) + REAL A( * ), B( * ) + WRITE(*,*) 'Error. PSTRSM should not be called.' + STOP + RETURN + END SUBROUTINE pstrsm +C*********************************************************************** + SUBROUTINE pdtrsm ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, IA, + $ JA, DESCA, B, IB, JB, DESCB ) + IMPLICIT NONE + CHARACTER SIDE, UPLO, TRANSA, DIAG + INTEGER M, N, IA, JA, IB, JB + DOUBLE PRECISION ALPHA + INTEGER DESCA( * ), DESCB( * ) + DOUBLE PRECISION A( * ), B( * ) + WRITE(*,*) 'Error. PDTRSM should not be called.' + STOP + RETURN + END SUBROUTINE pdtrsm +C*********************************************************************** + SUBROUTINE pcunmqr( SIDE, TRANS, M, N, K, A, IA, JA, + & DESCA, TAU, C, IC, JC, DESCC, WORK, + & LWORK, INFO ) + IMPLICIT NONE + CHARACTER SIDE, TRANS + INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N + INTEGER DESCA( * ), DESCC( * ) + COMPLEX A( * ), C( * ), TAU( * ), WORK( * ) + WRITE(*,*) 'Error. PCUNMQR should not be called.' + STOP + RETURN + END SUBROUTINE pcunmqr +C*********************************************************************** + SUBROUTINE pzunmqr( SIDE, TRANS, M, N, K, A, IA, JA, + & DESCA, TAU, C, IC, JC, DESCC, WORK, + & LWORK, INFO ) + IMPLICIT NONE + CHARACTER SIDE, TRANS + INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N + INTEGER DESCA( * ), DESCC( * ) +C DOUBLE COMPLEX A( * ), C( * ), TAU( * ), WORK( * ) + COMPLEX(kind=kind(0.0D0)) :: A( * ), C( * ), TAU( * ), WORK( * ) + WRITE(*,*) 'Error. PZUNMQR should not be called.' + STOP + RETURN + END SUBROUTINE pzunmqr +C*********************************************************************** + SUBROUTINE psormqr( SIDE, TRANS, M, N, K, A, IA, JA, + & DESCA, TAU, C, IC, JC, DESCC, WORK, + & LWORK, INFO ) + IMPLICIT NONE + CHARACTER SIDE, TRANS + INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N + INTEGER DESCA( * ), DESCC( * ) + REAL A( * ), C( * ), TAU( * ), WORK( * ) + WRITE(*,*) 'Error. PSORMQR should not be called.' + STOP + RETURN + END SUBROUTINE psormqr +C*********************************************************************** + SUBROUTINE pdormqr( SIDE, TRANS, M, N, K, A, IA, JA, + & DESCA, TAU, C, IC, JC, DESCC, WORK, + & LWORK, INFO ) + IMPLICIT NONE + CHARACTER SIDE, TRANS + INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N + INTEGER DESCA( * ), DESCC( * ) + DOUBLE PRECISION A( * ), C( * ), TAU( * ), WORK( * ) + WRITE(*,*) 'Error. PDORMQR should not be called.' + STOP + RETURN + END SUBROUTINE pdormqr +C*********************************************************************** + SUBROUTINE chk1mat( MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, + & DESCAPOS0, INFO ) + IMPLICIT NONE + INTEGER DESCAPOS0, IA, INFO, JA, MA, MAPOS0, NA, NAPOS0 + INTEGER DESCA( * ) + WRITE(*,*) 'Error. CHK1MAT should not be called.' + STOP + RETURN + END SUBROUTINE chk1mat +C*********************************************************************** + SUBROUTINE pchk2mat( MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, + & DESCAPOS0, MB, MBPOS0, NB, NBPOS0, IB, JB, + & DESCB, DESCBPOS0, NEXTRA, EX, EXPOS, INFO ) + IMPLICIT NONE + INTEGER DESCAPOS0, DESCBPOS0, IA, IB, INFO, JA, JB, MA, + & MAPOS0, MB, MBPOS0, NA, NAPOS0, NB, NBPOS0, + & NEXTRA + INTEGER DESCA( * ), DESCB( * ), EX( NEXTRA ), + & EXPOS( NEXTRA ) + WRITE(*,*) 'Error. PCHK2MAT should not be called.' + STOP + RETURN + END SUBROUTINE pchk2mat +C*********************************************************************** + SUBROUTINE pxerbla( CONTXT, SRNAME, INFO ) + IMPLICIT NONE + INTEGER CONTXT, INFO + CHARACTER SRNAME + WRITE(*,*) 'Error. PXERBLA should not be called.' + STOP + RETURN + END SUBROUTINE pxerbla +C*********************************************************************** + SUBROUTINE descset( DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, + & LLD ) + IMPLICIT NONE + INTEGER ICSRC, ICTXT, IRSRC, LLD, M, MB, N, NB + INTEGER DESC( * ) + WRITE(*,*) 'Error. DESCSET should not be called.' + STOP + RETURN + END SUBROUTINE descset + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/mpic.c b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/mpic.c new file mode 100644 index 000000000..f09c98da6 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/mpic.c @@ -0,0 +1,65 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +#include "mumps_mpi.h" +int MPI_Init(int *pargc, char ***pargv) +{ + return 0; +} + +int MPI_Comm_rank( MPI_Comm comm, int *rank) +{ + *rank=0; + return 0; +} +int MPI_Finalize(void) +{ + return 0; +} + diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/mpif.h b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/mpif.h new file mode 100644 index 000000000..327136ec0 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/mpif.h @@ -0,0 +1,123 @@ +! +! This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +! +! +! This version of MUMPS is provided to you free of charge. It is public +! domain, based on public domain software developed during the Esprit IV +! European project PARASOL (1996-1999). Since this first public domain +! version in 1999, research and developments have been supported by the +! following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +! INRIA, and University of Bordeaux. +! +! The MUMPS team at the moment of releasing this version includes +! Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +! Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +! Ucar and Clement Weisbecker. +! +! We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +! Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +! Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +! Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +! have been contributing to this project. +! +! Up-to-date copies of the MUMPS package can be obtained +! from the Web pages: +! http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +! +! +! THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +! EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +! +! +! User documentation of any code that uses this software can +! include this complete notice. You can acknowledge (using +! references [1] and [2]) the contribution of this package +! in any scientific publication dependent upon the use of the +! package. You shall use reasonable endeavours to notify +! the authors of the package of this publication. +! +! [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +! A fully asynchronous multifrontal solver using distributed dynamic +! scheduling, SIAM Journal of Matrix Analysis and Applications, +! Vol 23, No 1, pp 15-41 (2001). +! +! [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +! S. Pralet, Hybrid scheduling for the parallel solution of linear +! systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +! +! +! Dummy mpif.h file including symbols used by MUMPS. +! + INTEGER MPI_2DOUBLE_PRECISION + INTEGER MPI_2INTEGER + INTEGER MPI_2REAL + INTEGER MPI_ANY_SOURCE + INTEGER MPI_ANY_TAG + INTEGER MPI_BYTE + INTEGER MPI_CHARACTER + INTEGER MPI_COMM_NULL + INTEGER MPI_COMM_WORLD + INTEGER MPI_COMPLEX + INTEGER MPI_DOUBLE_COMPLEX + INTEGER MPI_DOUBLE_PRECISION + INTEGER MPI_INTEGER + INTEGER MPI_LOGICAL + INTEGER MPI_MAX + INTEGER MPI_MAX_PROCESSOR_NAME + INTEGER MPI_MAXLOC + INTEGER MPI_MIN + INTEGER MPI_MINLOC + INTEGER MPI_PACKED + INTEGER MPI_PROD + INTEGER MPI_REAL + INTEGER MPI_REPLACE + INTEGER MPI_REQUEST_NULL + INTEGER MPI_SOURCE + INTEGER MPI_STATUS_SIZE + INTEGER MPI_SUM + INTEGER MPI_TAG + INTEGER MPI_UNDEFINED + INTEGER MPI_WTIME_IS_GLOBAL + INTEGER MPI_LOR + INTEGER MPI_LAND + INTEGER MPI_INTEGER8 + INTEGER MPI_REAL8 + INTEGER MPI_BSEND_OVERHEAD + PARAMETER (MPI_2DOUBLE_PRECISION=1) + PARAMETER (MPI_2INTEGER=2) + PARAMETER (MPI_2REAL=3) + PARAMETER (MPI_ANY_SOURCE=4) + PARAMETER (MPI_ANY_TAG=5) + PARAMETER (MPI_BYTE=6) + PARAMETER (MPI_CHARACTER=7) + PARAMETER (MPI_COMM_NULL=8) + PARAMETER (MPI_COMM_WORLD=9) + PARAMETER (MPI_COMPLEX=10) + PARAMETER (MPI_DOUBLE_COMPLEX=11) + PARAMETER (MPI_DOUBLE_PRECISION=12) + PARAMETER (MPI_INTEGER=13) + PARAMETER (MPI_LOGICAL=14) + PARAMETER (MPI_MAX=15) + PARAMETER (MPI_MAX_PROCESSOR_NAME=31) + PARAMETER (MPI_MAXLOC=16) + PARAMETER (MPI_MIN=17) + PARAMETER (MPI_MINLOC=18) + PARAMETER (MPI_PACKED=19) + PARAMETER (MPI_PROD=20) + PARAMETER (MPI_REAL=21) + PARAMETER (MPI_REPLACE=22) + PARAMETER (MPI_REQUEST_NULL=23) + PARAMETER (MPI_SOURCE=1) + PARAMETER (MPI_STATUS_SIZE=2) + PARAMETER (MPI_SUM=26) + PARAMETER (MPI_TAG=2) + PARAMETER (MPI_UNDEFINED=28) + PARAMETER (MPI_WTIME_IS_GLOBAL=30) + PARAMETER (MPI_LOR=31) + PARAMETER (MPI_LAND=32) + PARAMETER (MPI_INTEGER8=33) + PARAMETER (MPI_REAL8=34) + + PARAMETER (MPI_BSEND_OVERHEAD=0) + DOUBLE PRECISION MPI_WTIME + EXTERNAL MPI_WTIME diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/mumps_mpi.h b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/mumps_mpi.h new file mode 100644 index 000000000..7ab0c3738 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/libseq/mumps_mpi.h @@ -0,0 +1,77 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ + +#ifndef MUMPS_MPI_H +#define MUMPS_MPI_H + +/* We define all symbols as extern "C" for users who call MUMPS with its + libseq from a C++ driver. */ +#ifdef __cplusplus +extern "C" { +#endif + +/* This is the minimum to have the C interface of MUMPS work. + * Most of the time, users who need this file have no call to MPI functions in + * their own code. Hence it is not worth declaring all MPI functions here. + * However if some users come to request some more stub functions of the MPI + * standards, we may add them. But it is not worth doing it until then. */ + +typedef int MPI_Comm; /* Simple type for MPI communicator */ +static MPI_Comm MPI_COMM_WORLD=(MPI_Comm)0; + +int MPI_Init(int *pargc, char ***pargv); +int MPI_Comm_rank(int comm, int *rank); +int MPI_Finalize(void); + +#ifdef __cplusplus +} +#endif + +#endif /* MUMPS_MPI_H */ diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/Makefile b/Ipopt-3.13.4/ThirdParty/MUMPS/src/Makefile new file mode 100644 index 000000000..d42a915d0 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/Makefile @@ -0,0 +1,102 @@ +# +# This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +# +topdir = .. +libdir = $(topdir)/lib + +default: d + +.PHONY: default s d c z mumps_lib clean + +s: + $(MAKE) ARITH=s mumps_lib +d: + $(MAKE) ARITH=d mumps_lib +c: + $(MAKE) ARITH=c mumps_lib +z: + $(MAKE) ARITH=z mumps_lib + +include $(topdir)/Makefile.inc + +mumps_lib: $(libdir)/libmumps_common$(PLAT)$(LIBEXT) \ + $(libdir)/lib$(ARITH)mumps$(PLAT)$(LIBEXT) + +OBJS_COMMON = \ + mumps_part9.o\ + mumps_common.o\ + mumps_ooc_common.o\ + mumps_orderings.o\ + mumps_size.o\ + mumps_io.o\ + mumps_io_basic.o\ + mumps_io_thread.o\ + mumps_io_err.o\ + mumps_static_mapping.o\ + mumps_sol_es.o\ + tools_common_mod.o + +OBJS = $(ARITH)mumps_part1.o\ + $(ARITH)mumps_part2.o\ + $(ARITH)mumps_part3.o\ + $(ARITH)mumps_part4.o\ + $(ARITH)mumps_part5.o\ + $(ARITH)mumps_part6.o\ + $(ARITH)mumps_part7.o\ + $(ARITH)mumps_part8.o\ + $(ARITH)mumps_comm_buffer.o\ + $(ARITH)mumps_load.o\ + $(ARITH)mumps_c.o\ + $(ARITH)mumps_ooc_buffer.o\ + $(ARITH)mumps_ooc.o\ + $(ARITH)mumps_struc_def.o + + +$(libdir)/libmumps_common$(PLAT)$(LIBEXT): $(OBJS_COMMON) + $(AR)$@ $? + $(RANLIB) $@ + +$(libdir)/lib$(ARITH)mumps$(PLAT)$(LIBEXT): $(OBJS) + $(AR)$@ $? + $(RANLIB) $@ + +$(ARITH)mumps_load.o: $(ARITH)mumps_comm_buffer.o \ + $(ARITH)mumps_struc_def.o + +$(ARITH)mumps_ooc.o: $(ARITH)mumps_struc_def.o \ + $(ARITH)mumps_ooc_buffer.o \ + mumps_ooc_common.o + +$(ARITH)mumps_ooc_buffer.o: mumps_ooc_common.o + + +$(ARITH)mumps_part1.o \ +$(ARITH)mumps_part2.o \ +$(ARITH)mumps_part3.o \ +$(ARITH)mumps_part4.o \ +$(ARITH)mumps_part5.o \ +$(ARITH)mumps_part6.o \ +$(ARITH)mumps_part7.o \ +$(ARITH)mumps_part8.o: $(ARITH)mumps_comm_buffer.o \ + $(ARITH)mumps_load.o \ + $(ARITH)mumps_ooc.o + +$(ARITH)mumps_part5.o: mumps_static_mapping.o +$(ARITH)mumps_part5.o: $(ARITH)mumps_part2.o + +$(ARITH)mumps_part2.o : tools_common_mod.o +$(ARITH)mumps_part8.o : mumps_sol_es.o + +.SUFFIXES: .c .F .o +.F.o: + $(FC) $(OPTF) $(INCS) $(IORDERINGSF) $(ORDERINGSF) -I. -I../include -c $*.F $(OUTF)$*.o +.c.o: + $(CC) $(OPTC) $(INCS) -I../include $(CDEFS) $(IORDERINGSC) $(ORDERINGSC) -c $*.c $(OUTC)$*.o + +$(ARITH)mumps_c.o: mumps_c.c + $(CC) $(OPTC) $(INCS) $(CDEFS) -DMUMPS_ARITH=MUMPS_ARITH_$(ARITH) \ + $(IORDERINGSC) $(ORDERINGSC) -I../include -c $? $(OUTC)$@ + + +clean: + $(RM) *.o *.mod diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_comm_buffer.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_comm_buffer.F new file mode 100644 index 000000000..301b8d252 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_comm_buffer.F @@ -0,0 +1,2718 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE CMUMPS_COMM_BUFFER + PRIVATE + PUBLIC :: CMUMPS_61, CMUMPS_528, + & CMUMPS_53 , CMUMPS_57 , + & CMUMPS_55, CMUMPS_59, + & CMUMPS_54,CMUMPS_58, + & CMUMPS_66, CMUMPS_78, + & CMUMPS_62, CMUMPS_68, + & CMUMPS_71, CMUMPS_70, + & CMUMPS_67, + & CMUMPS_65, CMUMPS_64, + & CMUMPS_72, + & CMUMPS_648, CMUMPS_76, + & CMUMPS_73, CMUMPS_74, + & CMUMPS_63,CMUMPS_77, + & CMUMPS_60, + & CMUMPS_524, CMUMPS_469, + & CMUMPS_460, CMUMPS_502, + & CMUMPS_519 ,CMUMPS_620 + & ,CMUMPS_617 + INTEGER NEXT, REQ, CONTENT, OVHSIZE + PARAMETER( NEXT = 0, REQ = 1, CONTENT = 2, OVHSIZE = 2 ) + INTEGER, SAVE :: SIZEofINT, SIZEofREAL, BUF_MYID + TYPE CMUMPS_COMM_BUFFER_TYPE + INTEGER LBUF, HEAD, TAIL,LBUF_INT, ILASTMSG + INTEGER, DIMENSION(:),POINTER :: CONTENT + END TYPE CMUMPS_COMM_BUFFER_TYPE + TYPE ( CMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_CB + TYPE ( CMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_SMALL + TYPE ( CMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_LOAD + INTEGER, SAVE :: SIZE_RBUF_BYTES + INTEGER BUF_LMAX_ARRAY + REAL, DIMENSION(:), ALLOCATABLE :: BUF_MAX_ARRAY + PUBLIC :: BUF_LMAX_ARRAY, BUF_MAX_ARRAY + CONTAINS + SUBROUTINE CMUMPS_528( MYID ) + IMPLICIT NONE + INTEGER MYID + BUF_MYID = MYID + RETURN + END SUBROUTINE CMUMPS_528 + SUBROUTINE CMUMPS_61( IntSize, RealSize ) + IMPLICIT NONE + INTEGER IntSize, RealSize + SIZEofINT = IntSize + SIZEofREAL = RealSize + NULLIFY(BUF_CB %CONTENT) + NULLIFY(BUF_SMALL%CONTENT) + NULLIFY(BUF_LOAD%CONTENT) + BUF_CB%LBUF = 0 + BUF_CB%LBUF_INT = 0 + BUF_CB%HEAD = 1 + BUF_CB%TAIL = 1 + BUF_CB%ILASTMSG = 1 + BUF_SMALL%LBUF = 0 + BUF_SMALL%LBUF_INT = 0 + BUF_SMALL%HEAD = 1 + BUF_SMALL%TAIL = 1 + BUF_SMALL%ILASTMSG = 1 + BUF_LOAD%LBUF = 0 + BUF_LOAD%LBUF_INT = 0 + BUF_LOAD%HEAD = 1 + BUF_LOAD%TAIL = 1 + BUF_LOAD%ILASTMSG = 1 + RETURN + END SUBROUTINE CMUMPS_61 + SUBROUTINE CMUMPS_53( SIZE, IERR ) + IMPLICIT NONE + INTEGER SIZE, IERR + CALL CMUMPS_2( BUF_CB, SIZE, IERR ) + RETURN + END SUBROUTINE CMUMPS_53 + SUBROUTINE CMUMPS_55( SIZE, IERR ) + IMPLICIT NONE + INTEGER SIZE, IERR + CALL CMUMPS_2( BUF_SMALL, SIZE, IERR ) + RETURN + END SUBROUTINE CMUMPS_55 + SUBROUTINE CMUMPS_54( SIZE, IERR ) + IMPLICIT NONE + INTEGER SIZE, IERR + CALL CMUMPS_2( BUF_LOAD, SIZE, IERR ) + RETURN + END SUBROUTINE CMUMPS_54 + SUBROUTINE CMUMPS_58( IERR ) + IMPLICIT NONE + INTEGER IERR + CALL CMUMPS_3( BUF_LOAD, IERR ) + RETURN + END SUBROUTINE CMUMPS_58 + SUBROUTINE CMUMPS_620() + IMPLICIT NONE + IF (allocated( BUF_MAX_ARRAY)) DEALLOCATE( BUF_MAX_ARRAY ) + RETURN + END SUBROUTINE CMUMPS_620 + SUBROUTINE CMUMPS_617(NFS4FATHER,IERR) + IMPLICIT NONE + INTEGER IERR, NFS4FATHER + IERR = 0 + IF (allocated( BUF_MAX_ARRAY)) THEN + IF (BUF_LMAX_ARRAY .GE. NFS4FATHER) RETURN + DEALLOCATE( BUF_MAX_ARRAY ) + ENDIF + ALLOCATE(BUF_MAX_ARRAY(NFS4FATHER),stat=IERR) + BUF_LMAX_ARRAY=NFS4FATHER + RETURN + END SUBROUTINE CMUMPS_617 + SUBROUTINE CMUMPS_57( IERR ) + IMPLICIT NONE + INTEGER IERR + CALL CMUMPS_3( BUF_CB, IERR ) + RETURN + END SUBROUTINE CMUMPS_57 + SUBROUTINE CMUMPS_59( IERR ) + IMPLICIT NONE + INTEGER IERR + CALL CMUMPS_3( BUF_SMALL, IERR ) + RETURN + END SUBROUTINE CMUMPS_59 + SUBROUTINE CMUMPS_2( BUF, SIZE, IERR ) + IMPLICIT NONE + TYPE ( CMUMPS_COMM_BUFFER_TYPE ) :: BUF + INTEGER SIZE, IERR + IERR = 0 + BUF%LBUF = SIZE + BUF%LBUF_INT = ( SIZE + SIZEofINT - 1 ) / SIZEofINT + IF ( associated ( BUF%CONTENT ) ) DEALLOCATE( BUF%CONTENT ) + ALLOCATE( BUF%CONTENT( BUF%LBUF_INT ), stat = IERR ) + IF (IERR .NE. 0) THEN + NULLIFY( BUF%CONTENT ) + IERR = -1 + BUF%LBUF = 0 + BUF%LBUF_INT = 0 + END IF + BUF%HEAD = 1 + BUF%TAIL = 1 + BUF%ILASTMSG = 1 + RETURN + END SUBROUTINE CMUMPS_2 + SUBROUTINE CMUMPS_3( BUF, IERR ) + IMPLICIT NONE + TYPE ( CMUMPS_COMM_BUFFER_TYPE ) :: BUF + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG + IF ( .NOT. associated ( BUF%CONTENT ) ) THEN + BUF%HEAD = 1 + BUF%LBUF = 0 + BUF%LBUF_INT = 0 + BUF%TAIL = 1 + BUF%ILASTMSG = 1 + RETURN + END IF + DO WHILE ( BUF%HEAD.NE.0 .AND. BUF%HEAD .NE. BUF%TAIL ) + CALL MPI_TEST(BUF%CONTENT( BUF%HEAD + REQ ), FLAG, + & STATUS, IERR) + IF ( .not. FLAG ) THEN + WRITE(*,*) '** Warning: trying to cancel a request.' + WRITE(*,*) '** This might be problematic on SGI' + CALL MPI_CANCEL( BUF%CONTENT( BUF%HEAD + REQ ), IERR ) + CALL MPI_REQUEST_FREE( BUF%CONTENT( BUF%HEAD + REQ ), IERR ) + END IF + BUF%HEAD = BUF%CONTENT( BUF%HEAD + NEXT ) + END DO + DEALLOCATE( BUF%CONTENT ) + NULLIFY( BUF%CONTENT ) + BUF%LBUF = 0 + BUF%LBUF_INT = 0 + BUF%HEAD = 1 + BUF%TAIL = 1 + BUF%ILASTMSG = 1 + RETURN + END SUBROUTINE CMUMPS_3 + SUBROUTINE CMUMPS_66( NBROWS_ALREADY_SENT, + & INODE, FPERE, NFRONT, LCONT, + & NASS, NPIV, + & IWROW, IWCOL, A, COMPRESSCB, + & DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INTEGER DEST, TAG, COMM, IERR + INTEGER NBROWS_ALREADY_SENT + INTEGER INODE, FPERE, NFRONT, LCONT, NASS, NPIV + INTEGER IWROW( LCONT ), IWCOL( LCONT ) + COMPLEX A( * ) + LOGICAL COMPRESSCB + INCLUDE 'mpif.h' + INTEGER NBROWS_PACKET + INTEGER POSITION, IREQ, IPOS, I, J1 + INTEGER SIZE1, SIZE2, SIZE_PACK, SIZE_AV, SIZE_AV_REALS + INTEGER IZERO, IONE + INTEGER SIZECB + INTEGER LCONT_SENT + INTEGER DEST2(1) + PARAMETER( IZERO = 0, IONE = 1 ) + LOGICAL RECV_BUF_SMALLER_THAN_SEND + DOUBLE PRECISION TMP + DEST2(1) = DEST + IERR = 0 + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + CALL MPI_PACK_SIZE( 11 + LCONT + LCONT, MPI_INTEGER, + & COMM, SIZE1, IERR) + ELSE + CALL MPI_PACK_SIZE( 5, MPI_INTEGER, COMM, SIZE1, IERR) + ENDIF + CALL CMUMPS_79( BUF_CB, SIZE_AV ) + IF ( SIZE_AV .LT. SIZE_RBUF_BYTES ) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + SIZE_AV = SIZE_RBUF_BYTES + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + ENDIF + SIZE_AV_REALS = ( SIZE_AV - SIZE1 ) / SIZEofREAL + IF (SIZE_AV_REALS < 0 ) THEN + NBROWS_PACKET = 0 + ELSE + IF (COMPRESSCB) THEN + TMP=2.0D0*dble(NBROWS_ALREADY_SENT)+1.0D0 + NBROWS_PACKET = int( + & ( sqrt( TMP * TMP + & + 8.0D0 * dble(SIZE_AV_REALS)) - TMP ) + & / 2.0D0 ) + ELSE + NBROWS_PACKET = SIZE_AV_REALS / LCONT + ENDIF + ENDIF + 10 CONTINUE + NBROWS_PACKET = max(0, + & min(NBROWS_PACKET, LCONT - NBROWS_ALREADY_SENT)) + IF (NBROWS_PACKET .EQ. 0 .AND. LCONT .NE. 0) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + IF (COMPRESSCB) THEN + SIZECB = (NBROWS_ALREADY_SENT*NBROWS_PACKET)+(NBROWS_PACKET + & *(NBROWS_PACKET+1))/2 + ELSE + SIZECB = NBROWS_PACKET * LCONT + ENDIF + CALL MPI_PACK_SIZE( SIZECB, MPI_COMPLEX, + & COMM, SIZE2, IERR ) + SIZE_PACK = SIZE1 + SIZE2 + IF (SIZE_PACK .GT. SIZE_AV ) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF (NBROWS_PACKET > 0) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR=-3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF + IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.LCONT .AND. + & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 + & .AND. + & .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF + CALL CMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE , DEST2 + & ) + IF (IERR .EQ. -1 .OR. IERR .EQ. -2) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF ( NBROWS_PACKET > 0 ) GOTO 10 + ENDIF + IF ( IERR .LT. 0 ) GOTO 100 + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( FPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (COMPRESSCB) THEN + LCONT_SENT=-LCONT + ELSE + LCONT_SENT=LCONT + ENDIF + CALL MPI_PACK( LCONT_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (NBROWS_ALREADY_SENT == 0) THEN + CALL MPI_PACK( LCONT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NASS-NPIV, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( LCONT , 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IZERO, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IONE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IZERO, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IWROW, LCONT, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IWCOL, LCONT, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + IF ( LCONT .NE. 0 ) THEN + J1 = 1 + NBROWS_ALREADY_SENT * NFRONT + IF (COMPRESSCB) THEN + DO I = NBROWS_ALREADY_SENT+1, + & NBROWS_ALREADY_SENT+NBROWS_PACKET + CALL MPI_PACK( A( J1 ), I, MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + J1 = J1 + NFRONT + END DO + ELSE + DO I = NBROWS_ALREADY_SENT+1, + & NBROWS_ALREADY_SENT+NBROWS_PACKET + CALL MPI_PACK( A( J1 ), LCONT, MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + J1 = J1 + NFRONT + END DO + ENDIF + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK .LT. POSITION ) THEN + WRITE(*,*) 'Error Try_send_cb: SIZE, POSITION=',SIZE_PACK, + & POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE_PACK .NE. POSITION ) + & CALL CMUMPS_1( BUF_CB, POSITION ) + NBROWS_ALREADY_SENT = NBROWS_ALREADY_SENT + NBROWS_PACKET + IF (NBROWS_ALREADY_SENT .NE. LCONT ) THEN + IERR = -1 + RETURN + ENDIF + 100 CONTINUE + RETURN + END SUBROUTINE CMUMPS_66 + SUBROUTINE CMUMPS_72( NRHS, INODE, IFATH, + & EFF_CB_SIZE, LD_CB, LD_PIV, NPIV, CB, SOL, + & DEST, COMM, IERR ) + IMPLICIT NONE + INTEGER NRHS, INODE, IFATH, EFF_CB_SIZE, LD_CB, LD_PIV, NPIV + INTEGER DEST, COMM, IERR + COMPLEX CB( LD_CB*(NRHS-1)+EFF_CB_SIZE ) + COMPLEX SOL( max(1, LD_PIV*(NRHS-1)+NPIV) ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE, SIZE1, SIZE2, K + INTEGER POSITION, IREQ, IPOS + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1) = DEST + IERR = 0 + CALL MPI_PACK_SIZE( 4, MPI_INTEGER, COMM, SIZE1, IERR ) + CALL MPI_PACK_SIZE( NRHS * (EFF_CB_SIZE + NPIV), + & MPI_COMPLEX, COMM, + & SIZE2, IERR ) + SIZE = SIZE1 + SIZE2 + CALL CMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IFATH, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( EFF_CB_SIZE , 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NPIV , 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + DO K = 1, NRHS + CALL MPI_PACK( CB ( 1 + LD_CB * (K-1) ), + & EFF_CB_SIZE, MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + END DO + IF ( NPIV .GT. 0 ) THEN + DO K=1, NRHS + CALL MPI_PACK( SOL(1+LD_PIV*(K-1)), + & NPIV, MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + ENDDO + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, Master2Slave, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE .LT. POSITION ) THEN + WRITE(*,*) 'Try_send_master2slave: SIZE, POSITION = ', + & SIZE, POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE .NE. POSITION ) CALL CMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE CMUMPS_72 + SUBROUTINE CMUMPS_78( NRHS, NODE1, NODE2, NCB, LDW, + & LONG, + & IW, W, + & DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INTEGER LDW, DEST, TAG, COMM, IERR + INTEGER NRHS, NODE1, NODE2, NCB, LONG + INTEGER IW( max( 1, LONG ) ) + COMPLEX W( max( 1, LDW * NRHS ) ) + INCLUDE 'mpif.h' + INTEGER POSITION, IREQ, IPOS + INTEGER SIZE1, SIZE2, SIZE, K + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1)=DEST + IERR = 0 + IF ( NODE2 .EQ. 0 ) THEN + CALL MPI_PACK_SIZE( 2+LONG, MPI_INTEGER, COMM, SIZE1, IERR ) + ELSE + CALL MPI_PACK_SIZE( 4+LONG, MPI_INTEGER, COMM, SIZE1, IERR ) + END IF + SIZE2 = 0 + IF ( LONG .GT. 0 ) THEN + CALL MPI_PACK_SIZE( NRHS*LONG, MPI_COMPLEX, + & COMM, SIZE2, IERR ) + END IF + SIZE = SIZE1 + SIZE2 + CALL CMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + POSITION = 0 + CALL MPI_PACK( NODE1, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + IF ( NODE2 .NE. 0 ) THEN + CALL MPI_PACK( NODE2, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NCB, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + END IF + CALL MPI_PACK( LONG, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + IF ( LONG .GT. 0 ) THEN + CALL MPI_PACK( IW, LONG, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + DO K=1, NRHS + CALL MPI_PACK( W(1+(K-1)*LDW), LONG, MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + END DO + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE .NE. POSITION ) CALL CMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE CMUMPS_78 + SUBROUTINE CMUMPS_62( I, DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INTEGER I + INTEGER DEST, TAG, COMM, IERR + INCLUDE 'mpif.h' + INTEGER IPOS, IREQ, MSG_SIZE, POSITION + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1)=DEST + IERR = 0 + CALL MPI_PACK_SIZE( 1, MPI_INTEGER, + & COMM, MSG_SIZE, IERR ) + CALL CMUMPS_4( BUF_SMALL, IPOS, IREQ, MSG_SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + write(6,*) ' Internal error in CMUMPS_62', + & ' Buf size (bytes)= ',BUF_SMALL%LBUF + RETURN + ENDIF + POSITION=0 + CALL MPI_PACK( I, 1, + & MPI_INTEGER, BUF_SMALL%CONTENT( IPOS ), + & MSG_SIZE, + & POSITION, COMM, IERR ) + CALL MPI_ISEND( BUF_SMALL%CONTENT(IPOS), MSG_SIZE, + & MPI_PACKED, DEST, TAG, COMM, + & BUF_SMALL%CONTENT( IREQ ), IERR ) + RETURN + END SUBROUTINE CMUMPS_62 + SUBROUTINE CMUMPS_469(FLAG) + LOGICAL FLAG + LOGICAL FLAG1, FLAG2, FLAG3 + CALL CMUMPS_468( BUF_SMALL, FLAG1 ) + CALL CMUMPS_468( BUF_CB, FLAG2 ) + CALL CMUMPS_468( BUF_LOAD, FLAG3 ) + FLAG = FLAG1 .AND. FLAG2 .AND. FLAG3 + RETURN + END SUBROUTINE CMUMPS_469 + SUBROUTINE CMUMPS_468( B, FLAG ) + TYPE ( CMUMPS_COMM_BUFFER_TYPE ) :: B + LOGICAL :: FLAG + INTEGER SIZE_AVAIL + CALL CMUMPS_79(B, SIZE_AVAIL) + FLAG = ( B%HEAD == B%TAIL ) + RETURN + END SUBROUTINE CMUMPS_468 + SUBROUTINE CMUMPS_79( B, SIZE_AV ) + IMPLICIT NONE + TYPE ( CMUMPS_COMM_BUFFER_TYPE ) :: B + INTEGER SIZE_AV + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG + IF ( B%HEAD .NE. B%TAIL ) THEN + 10 CONTINUE + CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + B%HEAD = B%CONTENT( B%HEAD + NEXT ) + IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL + IF ( B%HEAD .NE. B%TAIL ) GOTO 10 + END IF + END IF + IF ( B%HEAD .EQ. B%TAIL ) THEN + B%HEAD = 1 + B%TAIL = 1 + B%ILASTMSG = 1 + END IF + IF ( B%HEAD .LE. B%TAIL ) THEN + SIZE_AV = max( B%LBUF_INT - B%TAIL, B%HEAD - 2 ) + ELSE + SIZE_AV = B%HEAD - B%TAIL - 1 + END IF + SIZE_AV = min(SIZE_AV - OVHSIZE, SIZE_AV) + SIZE_AV = SIZE_AV * SIZEofINT + RETURN + END SUBROUTINE CMUMPS_79 + SUBROUTINE CMUMPS_4( B, IPOS, IREQ, MSG_SIZE, IERR, + & NDEST , PDEST + & ) + IMPLICIT NONE + TYPE ( CMUMPS_COMM_BUFFER_TYPE ) :: B + INTEGER, INTENT(IN) :: MSG_SIZE + INTEGER, INTENT(OUT) :: IPOS, IREQ, IERR + INTEGER NDEST + INTEGER, INTENT(IN) :: PDEST(max(1,NDEST)) + INCLUDE 'mpif.h' + INTEGER MSG_SIZE_INT + INTEGER IBUF + LOGICAL FLAG + INTEGER STATUS( MPI_STATUS_SIZE ) + IERR = 0 + IF ( B%HEAD .NE. B%TAIL ) THEN + 10 CONTINUE + CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + B%HEAD = B%CONTENT( B%HEAD + NEXT ) + IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL + IF ( B%HEAD .NE. B%TAIL ) GOTO 10 + END IF + END IF + IF ( B%HEAD .EQ. B%TAIL ) THEN + B%HEAD = 1 + B%TAIL = 1 + B%ILASTMSG = 1 + END iF + MSG_SIZE_INT = ( MSG_SIZE + ( SIZEofINT - 1 ) ) / SIZEofINT + MSG_SIZE_INT = MSG_SIZE_INT + OVHSIZE + FLAG = ( ( B%HEAD .LE. B%TAIL ) + & .AND. ( + & ( MSG_SIZE_INT .LE. B%LBUF_INT - B%TAIL ) + & .OR. ( MSG_SIZE_INT .LE. B%HEAD - 2 ) ) ) + & .OR. + & ( ( B%HEAD .GT. B%TAIL ) + & .AND. ( MSG_SIZE_INT .LE. B%HEAD - B%TAIL - 1 ) ) + IF ( .NOT. FLAG + & ) THEN + IERR = -1 + IF ( MSG_SIZE_INT .GT. B%LBUF_INT - 1 ) then + IERR = -2 + ENDIF + IPOS = -1 + IREQ = -1 + RETURN + END IF + IF ( B%HEAD .LE. B%TAIL ) THEN + IF ( MSG_SIZE_INT .LE. B%LBUF_INT - B%TAIL + 1 ) THEN + IBUF = B%TAIL + ELSE IF ( MSG_SIZE_INT .LE. B%HEAD - 1 ) THEN + IBUF = 1 + END IF + ELSE + IBUF = B%TAIL + END IF + B%CONTENT( B%ILASTMSG + NEXT ) = IBUF + B%ILASTMSG = IBUF + B%TAIL = IBUF + MSG_SIZE_INT + B%CONTENT( IBUF + NEXT ) = 0 + IPOS = IBUF + CONTENT + IREQ = IBUF + REQ + RETURN + END SUBROUTINE CMUMPS_4 + SUBROUTINE CMUMPS_1( BUF, SIZE ) + IMPLICIT NONE + TYPE ( CMUMPS_COMM_BUFFER_TYPE ) :: BUF + INTEGER SIZE + INTEGER SIZE_INT + SIZE_INT = ( SIZE + SIZEofINT - 1 ) / SIZEofINT + SIZE_INT = SIZE_INT + OVHSIZE + BUF%TAIL = BUF%ILASTMSG + SIZE_INT + RETURN + END SUBROUTINE CMUMPS_1 + SUBROUTINE CMUMPS_68( + & INODE, NBPROCFILS, NLIG, ILIG, NCOL, ICOL, + & NASS, NSLAVES, LIST_SLAVES, + & DEST, NFRONT, COMM, IERR ) + IMPLICIT NONE + INTEGER COMM, IERR, NFRONT + INTEGER INODE + INTEGER NLIG, NCOL, NASS, NSLAVES + INTEGER NBPROCFILS, DEST + INTEGER ILIG( NLIG ) + INTEGER ICOL( NCOL ) + INTEGER LIST_SLAVES( NSLAVES ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE, POSITION, IPOS, IREQ + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1) = DEST + IERR = 0 + SIZE = ( 6 + NLIG + NCOL + NSLAVES + 1 ) * SIZEofINT + IF (SIZE.GT.SIZE_RBUF_BYTES ) THEN + IERR = -2 + RETURN + END IF + CALL CMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + POSITION = IPOS + BUF_CB%CONTENT( POSITION ) = INODE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NBPROCFILS + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NLIG + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NCOL + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NASS + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFRONT + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NSLAVES + POSITION = POSITION + 1 + IF (NSLAVES.GT.0) THEN + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) = + & LIST_SLAVES( 1: NSLAVES ) + POSITION = POSITION + NSLAVES + ENDIF + BUF_CB%CONTENT( POSITION:POSITION + NLIG - 1 ) = ILIG + POSITION = POSITION + NLIG + BUF_CB%CONTENT( POSITION:POSITION + NCOL - 1 ) = ICOL + POSITION = POSITION + NCOL + POSITION = POSITION - IPOS + IF ( POSITION * SIZEofINT .NE. SIZE ) THEN + WRITE(*,*) 'Error in CMUMPS_68 :', + & ' wrong estimated size' + CALL MUMPS_ABORT() + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, MPI_PACKED, + & DEST, MAITRE_DESC_BANDE, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + RETURN + END SUBROUTINE CMUMPS_68 + SUBROUTINE CMUMPS_70( NBROWS_ALREADY_SENT, + & IPERE, ISON, NROW, + & IROW, NCOL, ICOL, VAL, LDA, NELIM, TYPE_SON, + & NSLAVES, SLAVES, DEST, COMM, IERR, + & + & SLAVEF, KEEP,KEEP8, INIV2, TAB_POS_IN_PERE ) + IMPLICIT NONE + INTEGER NBROWS_ALREADY_SENT + INTEGER LDA, NELIM, TYPE_SON + INTEGER IPERE, ISON, NROW, NCOL, NSLAVES + INTEGER IROW( NROW ) + INTEGER ICOL( NCOL ) + INTEGER SLAVES( NSLAVES ) + COMPLEX VAL(LDA, *) + INTEGER IPOS, IREQ, DEST, COMM, IERR + INTEGER SLAVEF, KEEP(500), INIV2 + INTEGER(8) KEEP8(150) + INTEGER TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE1, SIZE2, SIZE3, SIZE_PACK, POSITION, I + INTEGER NBROWS_PACKET, NCOL_SEND + INTEGER SIZE_AV + LOGICAL RECV_BUF_SMALLER_THAN_SEND + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1) = DEST + IERR = 0 + IF ( NELIM .NE. NROW ) THEN + WRITE(*,*) 'Error in TRY_SEND_MAITRE2:',NELIM, NROW + CALL MUMPS_ABORT() + END IF + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + CALL MPI_PACK_SIZE( NROW+NCOL+7+NSLAVES, MPI_INTEGER, + & COMM, SIZE1, IERR ) + IF ( ( KEEP(48).NE. 0 ).AND.(TYPE_SON .eq. 2 )) THEN + CALL MPI_PACK_SIZE( NSLAVES+1, MPI_INTEGER, + & COMM, SIZE3, IERR ) + ELSE + SIZE3 = 0 + ENDIF + SIZE1=SIZE1+SIZE3 + ELSE + CALL MPI_PACK_SIZE(7, MPI_INTEGER,COMM,SIZE1,IERR) + ENDIF + IF ( KEEP(50).ne.0 .AND. TYPE_SON .eq. 2 ) THEN + NCOL_SEND = NROW + ELSE + NCOL_SEND = NCOL + ENDIF + CALL CMUMPS_79( BUF_CB, SIZE_AV ) + IF (SIZE_AV .LT. SIZE_RBUF_BYTES) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + SIZE_AV = SIZE_RBUF_BYTES + ENDIF + IF (NROW .GT. 0 ) THEN + NBROWS_PACKET = (SIZE_AV - SIZE1) / NCOL_SEND / SIZEofREAL + NBROWS_PACKET = min(NBROWS_PACKET, NROW - NBROWS_ALREADY_SENT) + NBROWS_PACKET = max(NBROWS_PACKET, 0) + ELSE + NBROWS_PACKET =0 + ENDIF + IF (NBROWS_PACKET .EQ. 0 .AND. NROW .NE. 0) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR=-3 + GOTO 100 + ELSE + IERR=-1 + GOTO 100 + ENDIF + ENDIF + 10 CONTINUE + CALL MPI_PACK_SIZE( NBROWS_PACKET * NCOL_SEND, + & MPI_COMPLEX, + & COMM, SIZE2, IERR ) + SIZE_PACK = SIZE1 + SIZE2 + IF (SIZE_PACK .GT. SIZE_AV) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF ( NBROWS_PACKET .GT. 0 ) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF + IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.NROW .AND. + & SIZE_PACK - SIZE1 .LT. ( SIZE_RBUF_BYTES - SIZE1 ) / 2 + & .AND. + & .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF + CALL CMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + GOTO 100 + ENDIF + POSITION = 0 + CALL MPI_PACK( IPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( ISON, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NSLAVES, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NCOL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + IF (NSLAVES.GT.0) THEN + CALL MPI_PACK( SLAVES, NSLAVES, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + CALL MPI_PACK( IROW, NROW, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( ICOL, NCOL, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF ( ( KEEP(48).NE. 0 ).AND.(TYPE_SON .eq. 2 ) ) THEN + CALL MPI_PACK( TAB_POS_IN_PERE(1,INIV2), NSLAVES+1, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + ENDIF + IF (NBROWS_PACKET.GE.1) THEN + DO I=NBROWS_ALREADY_SENT+1, + & NBROWS_ALREADY_SENT+NBROWS_PACKET + CALL MPI_PACK( VAL(1,I), NCOL_SEND, + & MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDDO + ENDIF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, MAITRE2, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK .LT. POSITION ) THEN + write(*,*) 'Try_send_maitre2, SIZE,POSITION=', + & SIZE_PACK,POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE_PACK .NE. POSITION ) + & CALL CMUMPS_1( BUF_CB, POSITION ) + NBROWS_ALREADY_SENT = NBROWS_ALREADY_SENT + NBROWS_PACKET + IF ( NBROWS_ALREADY_SENT .NE. NROW ) THEN + IERR = -1 + ENDIF + 100 CONTINUE + RETURN + END SUBROUTINE CMUMPS_70 + SUBROUTINE CMUMPS_67(NBROWS_ALREADY_SENT, + & DESC_IN_LU, + & IPERE, NFRONT_PERE, NASS_PERE, NFS4FATHER, + & NSLAVES_PERE, + & ISON, NBROW, LMAP, MAPROW, PERM, IW_CBSON, A_CBSON, + & ISLAVE, PDEST, PDEST_MASTER, COMM, IERR, + & + & KEEP,KEEP8, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & COMPRESSCB, KEEP253_LOC ) + IMPLICIT NONE + INTEGER NBROWS_ALREADY_SENT + INTEGER, INTENT (in) :: KEEP253_LOC + INTEGER IPERE, ISON, NBROW + INTEGER PDEST, ISLAVE, COMM, IERR + INTEGER PDEST_MASTER, NASS_PERE, NSLAVES_PERE, + & NFRONT_PERE, LMAP + INTEGER MAPROW( LMAP ), PERM( max(1, NBROW )) + INTEGER IW_CBSON( * ) + COMPLEX A_CBSON( * ) + LOGICAL DESC_IN_LU, COMPRESSCB + INTEGER KEEP(500), N , SLAVEF + INTEGER(8) KEEP8(150) + INTEGER STEP(N), + & ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NFS4FATHER,SIZE3,PS1,NCA,LROW1 + INTEGER(8) :: ASIZE + LOGICAL COMPUTE_MAX + INTEGER NBROWS_PACKET + INTEGER MAX_ROW_LENGTH + INTEGER LROW, NELIM + INTEGER(8) :: SIZFR, ITMP8 + INTEGER NPIV, NFRONT, HS + INTEGER SIZE_PACK, SIZE1, SIZE2, POSITION,I + INTEGER SIZE_INTEGERS, B, SIZE_REALS, TMPSIZE, ONEorTWO, SIZE_AV + INTEGER NBINT, L + INTEGER(8) :: APOS, SHIFTCB_SON, LDA_SON8 + INTEGER IPOS_IN_SLAVE + INTEGER STATE_SON + INTEGER INDICE_PERE, NROW, IPOS, IREQ, NOSLA + INTEGER IONE, J, THIS_ROW_LENGTH + INTEGER SIZE_DESC_BANDE, DESC_BANDE_BYTES + LOGICAL RECV_BUF_SMALLER_THAN_SEND + LOGICAL NOT_ENOUGH_SPACE + INTEGER PDEST2(1) + PARAMETER ( IONE=1 ) + INCLUDE 'mumps_headers.h' + REAL ZERO + PARAMETER (ZERO = 0.0E0) + COMPUTE_MAX = (KEEP(219) .NE. 0) .AND. + & (KEEP(50) .EQ. 2) .AND. + & (PDEST.EQ.PDEST_MASTER) + IF (NBROWS_ALREADY_SENT == 0) THEN + IF (COMPUTE_MAX) THEN + CALL CMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE. 0) THEN + IERR = -4 + RETURN + ENDIF + ENDIF + ENDIF + PDEST2(1) = PDEST + IERR = 0 + LROW = IW_CBSON( 1 + KEEP(IXSZ)) + NELIM = IW_CBSON( 2 + KEEP(IXSZ)) + NPIV = IW_CBSON( 4 + KEEP(IXSZ)) + IF ( NPIV .LT. 0 ) THEN + NPIV = 0 + END IF + NROW = IW_CBSON( 3 + KEEP(IXSZ)) + NFRONT = LROW + NPIV + HS = 6 + IW_CBSON( 6 + KEEP(IXSZ)) + KEEP(IXSZ) + CALL MUMPS_729( SIZFR, IW_CBSON( 1 + XXR ) ) + STATE_SON = IW_CBSON(1+XXS) + IF (STATE_SON .EQ. S_NOLCBCONTIG) THEN + LDA_SON8 = int(LROW,8) + SHIFTCB_SON = int(NPIV,8)*int(NROW,8) + ELSE IF (STATE_SON .EQ. S_NOLCLEANED) THEN + LDA_SON8 = int(LROW,8) + SHIFTCB_SON = 0_8 + ELSE + LDA_SON8 = int(NFRONT,8) + SHIFTCB_SON = int(NPIV,8) + ENDIF + CALL CMUMPS_79( BUF_CB, SIZE_AV ) + IF (PDEST .EQ. PDEST_MASTER) THEN + SIZE_DESC_BANDE=0 + ELSE + SIZE_DESC_BANDE=(7+SLAVEF+KEEP(127)*2) + SIZE_DESC_BANDE=SIZE_DESC_BANDE+int(real(KEEP(12))* + & real(SIZE_DESC_BANDE)/100.0E0) + SIZE_DESC_BANDE=max(SIZE_DESC_BANDE, + & 7+NSLAVES_PERE+NFRONT_PERE+NFRONT_PERE-NASS_PERE) + ENDIF + DESC_BANDE_BYTES=SIZE_DESC_BANDE*SIZEofINT + IF ( SIZE_AV .LT. SIZE_RBUF_BYTES-DESC_BANDE_BYTES ) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + SIZE_AV = SIZE_RBUF_BYTES-DESC_BANDE_BYTES + ENDIF + SIZE1=0 + IF (NBROWS_ALREADY_SENT==0) THEN + IF(COMPUTE_MAX) THEN + CALL MPI_PACK_SIZE(1, MPI_INTEGER, + & COMM, PS1, IERR ) + IF(NFS4FATHER .GT. 0) THEN + CALL MPI_PACK_SIZE( NFS4FATHER, MPI_REAL, + & COMM, SIZE1, IERR ) + ENDIF + SIZE1 = SIZE1+PS1 + ENDIF + ENDIF + IF (KEEP(50) .EQ. 0) THEN + ONEorTWO = 1 + ELSE + ONEorTWO = 2 + ENDIF + IF (PDEST .EQ.PDEST_MASTER) THEN + L = 0 + ELSE IF (KEEP(50) .EQ. 0) THEN + L = LROW + ELSE + L = LROW + PERM(1) - LMAP + NBROWS_ALREADY_SENT - 1 + ONEorTWO=ONEorTWO+1 + ENDIF + NBINT = 6 + L + CALL MPI_PACK_SIZE( NBINT, MPI_INTEGER, + & COMM, TMPSIZE, IERR ) + SIZE1 = SIZE1 + TMPSIZE + SIZE_AV = SIZE_AV - SIZE1 + NOT_ENOUGH_SPACE=.FALSE. + IF (SIZE_AV .LT.0 ) THEN + NBROWS_PACKET = 0 + NOT_ENOUGH_SPACE=.TRUE. + ELSE + IF ( KEEP(50) .EQ. 0 ) THEN + NBROWS_PACKET = + & SIZE_AV / ( ONEorTWO*SIZEofINT+LROW*SIZEofREAL) + ELSE + B = 2 * ONEorTWO + + & ( 1 + 2 * LROW + 2 * PERM(1) + 2 * NBROWS_ALREADY_SENT ) + & * SIZEofREAL / SIZEofINT + NBROWS_PACKET=int((dble(-B)+sqrt((dble(B)*dble(B))+ + & dble(4)*dble(2*SIZE_AV)/dble(SIZEofINT) * + & dble(SIZEofREAL/SIZEofINT)))* + & dble(SIZEofINT) / dble(2) / dble(SIZEofREAL)) + ENDIF + ENDIF + 10 CONTINUE + NBROWS_PACKET = max( 0, + & min( NBROWS_PACKET, NBROW - NBROWS_ALREADY_SENT)) + NOT_ENOUGH_SPACE = NOT_ENOUGH_SPACE .OR. + & (NBROWS_PACKET .EQ.0.AND. NBROW.NE.0) + IF (NOT_ENOUGH_SPACE) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + IF (KEEP(50).EQ.0) THEN + MAX_ROW_LENGTH = -99999 + SIZE_REALS = NBROWS_PACKET * LROW + ELSE + SIZE_REALS = ( LROW + PERM(1) + NBROWS_ALREADY_SENT ) * + & NBROWS_PACKET + ( NBROWS_PACKET * ( NBROWS_PACKET + 1) ) / 2 + MAX_ROW_LENGTH = LROW+PERM(1)-LMAP+NBROWS_ALREADY_SENT + & + NBROWS_PACKET-1 + ENDIF + SIZE_INTEGERS = ONEorTWO* NBROWS_PACKET + CALL MPI_PACK_SIZE( SIZE_REALS, MPI_COMPLEX, + & COMM, SIZE2, IERR) + CALL MPI_PACK_SIZE( SIZE_INTEGERS, MPI_INTEGER, + & COMM, SIZE3, IERR) + IF (SIZE2 + SIZE3 .GT. SIZE_AV ) THEN + NBROWS_PACKET = NBROWS_PACKET -1 + IF (NBROWS_PACKET .GT. 0 ) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF + SIZE_PACK = SIZE1 + SIZE2 + SIZE3 +#if ! defined(DBG_SMB3) + IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.NBROW .AND. + & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 .AND. + & .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF +#endif + CALL CMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE , PDEST2 + & ) + IF (IERR .EQ. -1 .OR. IERR.EQ. -2) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF (NBROWS_PACKET > 0 ) GOTO 10 + ENDIF + IF ( IERR .LT. 0 ) GOTO 100 + IF (SIZE_PACK.GT.SIZE_RBUF_BYTES ) THEN + IERR = -3 + GOTO 100 + ENDIF + POSITION = 0 + CALL MPI_PACK( IPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( ISON, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (KEEP(50)==0) THEN + CALL MPI_PACK( LROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ELSE + CALL MPI_PACK( MAX_ROW_LENGTH, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF ( PDEST .NE. PDEST_MASTER ) THEN + IF (KEEP(50)==0) THEN + CALL MPI_PACK( IW_CBSON( HS + NROW + NPIV + 1 ), LROW, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ELSE + IF (MAX_ROW_LENGTH > 0) THEN + CALL MPI_PACK( IW_CBSON( HS + NROW + NPIV + 1 ), + & MAX_ROW_LENGTH, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + ENDIF + END IF + DO J=NBROWS_ALREADY_SENT+1,NBROWS_ALREADY_SENT+NBROWS_PACKET + I = PERM(J) + INDICE_PERE=MAPROW(I) + CALL MUMPS_47( + & KEEP,KEEP8, IPERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + INDICE_PERE = IPOS_IN_SLAVE + CALL MPI_PACK( INDICE_PERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDDO + DO J=NBROWS_ALREADY_SENT+1,NBROWS_ALREADY_SENT+NBROWS_PACKET + I = PERM(J) + INDICE_PERE=MAPROW(I) + CALL MUMPS_47( + & KEEP,KEEP8, IPERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + IF (KEEP(50).ne.0) THEN + THIS_ROW_LENGTH = LROW + I - LMAP + CALL MPI_PACK( THIS_ROW_LENGTH, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ELSE + THIS_ROW_LENGTH = LROW + ENDIF + IF (DESC_IN_LU) THEN + IF ( COMPRESSCB ) THEN + IF (NELIM.EQ.0) THEN + ITMP8 = int(I,8) + ELSE + ITMP8 = int(NELIM+I,8) + ENDIF + APOS = ITMP8 * (ITMP8-1_8) / 2_8 + 1_8 + ELSE + APOS = int(I+NELIM-1, 8) * int(LROW,8) + 1_8 + ENDIF + ELSE + IF ( COMPRESSCB ) THEN + IF ( LROW .EQ. NROW ) THEN + ITMP8 = int(I,8) + APOS = ITMP8 * (ITMP8-1_8)/2_8 + 1_8 + ELSE + ITMP8 = int(I + LROW - NROW,8) + APOS = ITMP8 * (ITMP8-1_8)/2_8 + 1_8 - + & int(LROW - NROW, 8) * int(LROW-NROW+1,8) / 2_8 + ENDIF + ELSE + APOS = int( I - 1, 8 ) * LDA_SON8 + SHIFTCB_SON + 1_8 + ENDIF + ENDIF + CALL MPI_PACK( A_CBSON( APOS ), THIS_ROW_LENGTH, + & MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDDO + IF (NBROWS_ALREADY_SENT == 0) THEN + IF (COMPUTE_MAX) THEN + CALL MPI_PACK(NFS4FATHER,1, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF(NFS4FATHER .GT. 0) THEN + BUF_MAX_ARRAY(1:NFS4FATHER) = ZERO + IF(MAPROW(NROW) .GT. NASS_PERE) THEN + DO PS1=1,NROW + IF(MAPROW(PS1).GT.NASS_PERE) EXIT + ENDDO + IF (DESC_IN_LU) THEN + IF (COMPRESSCB) THEN + APOS = int(NELIM+PS1,8) * int(NELIM+PS1-1,8) / + & 2_8 + 1_8 + NCA = -44444 + ASIZE = int(NROW,8) * int(NROW+1,8)/2_8 - + & int(NELIM+PS1,8) * int(NELIM+PS1-1,8)/2_8 + LROW1 = PS1 + NELIM + ELSE + APOS = int(PS1+NELIM-1,8) * int(LROW,8) + 1_8 + NCA = LROW + ASIZE = int(NCA,8) * int(NROW-PS1+1,8) + LROW1 = LROW + ENDIF + ELSE + IF (COMPRESSCB) THEN + IF (NPIV.NE.0) THEN + WRITE(*,*) "Error in PARPIV/CMUMPS_67" + CALL MUMPS_ABORT() + ENDIF + LROW1=LROW-NROW+PS1 + ITMP8 = int(PS1 + LROW - NROW,8) + APOS = ITMP8 * (ITMP8 - 1_8) / 2_8 + 1_8 - + & int(LROW-NROW,8)*int(LROW-NROW+1,8)/2_8 + ASIZE = int(LROW,8)*int(LROW+1,8)/2_8 - + & ITMP8*(ITMP8-1_8)/2_8 + NCA = -555555 + ELSE + APOS = int(PS1-1,8) * LDA_SON8 + 1_8 + SHIFTCB_SON + NCA = int(LDA_SON8) + ASIZE = SIZFR - (SHIFTCB_SON - + & int(PS1-1,8) * LDA_SON8) + LROW1=-666666 + ENDIF + ENDIF + IF ( NROW-PS1+1-KEEP253_LOC .NE. 0 ) THEN + CALL CMUMPS_618( + & A_CBSON(APOS),ASIZE,NCA, + & NROW-PS1+1-KEEP253_LOC, + & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB,LROW1) + ENDIF + ENDIF + CALL MPI_PACK(BUF_MAX_ARRAY, NFS4FATHER, + & MPI_REAL, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + ENDIF + ENDIF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & PDEST, CONTRIB_TYPE2, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK.LT. POSITION ) THEN + WRITE(*,*) ' contniv2: SIZE, POSITION =',SIZE_PACK, POSITION + WRITE(*,*) ' NBROW, LROW = ', NBROW, LROW + CALL MUMPS_ABORT() + END IF + IF ( SIZE_PACK .NE. POSITION ) + & CALL CMUMPS_1( BUF_CB, POSITION ) + NBROWS_ALREADY_SENT=NBROWS_ALREADY_SENT + NBROWS_PACKET + IF (NBROWS_ALREADY_SENT .NE. NBROW ) THEN + IERR = -1 + ENDIF + 100 CONTINUE + RETURN + END SUBROUTINE CMUMPS_67 + SUBROUTINE CMUMPS_71( + & INODE, NFRONT, NASS1, NFS4FATHER, + & ISON, MYID, NSLAVES, SLAVES_PERE, + & TROW, NCBSON, + & COMM, IERR, + & DEST, NDEST, SLAVEF, + & + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & + & ) + IMPLICIT NONE + INTEGER INODE, NFRONT, NASS1, NCBSON, NSLAVES, + & NDEST + INTEGER SLAVEF, MYID, ISON + INTEGER TROW( NCBSON ) + INTEGER DEST( NDEST ) + INTEGER SLAVES_PERE( NSLAVES ) + INTEGER COMM, IERR + INTEGER KEEP(500), N + INTEGER(8) KEEP8(150) + INTEGER STEP(N), + & ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE_AV, IDEST, NSEND, SIZE, NFS4FATHER + INTEGER TROW_SIZE, POSITION, INDX, INIV2 + INTEGER IPOS, IREQ + INTEGER IONE + PARAMETER ( IONE=1 ) + INTEGER NASS_SON + NASS_SON = -99998 + IERR = 0 + IF ( NDEST .eq. 1 ) THEN + IF ( DEST(1).EQ.MYID ) GOTO 500 + SIZE = SIZEofINT * ( 7 + NSLAVES + NCBSON ) + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + SIZE = SIZE + SIZEofINT * ( NSLAVES + 1 ) + ENDIF + CALL CMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE, DEST + & ) + IF (IERR .LT. 0 ) THEN + RETURN + ENDIF + IF (SIZE.GT.SIZE_RBUF_BYTES ) THEN + IERR = -3 + RETURN + END IF + POSITION = IPOS + BUF_CB%CONTENT( POSITION ) = INODE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = ISON + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NSLAVES + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFRONT + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NASS1 + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NCBSON + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFS4FATHER + POSITION = POSITION + 1 + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES ) + & = TAB_POS_IN_PERE(1:NSLAVES+1,INIV2) + POSITION = POSITION + NSLAVES + 1 + ENDIF + IF ( NSLAVES .NE. 0 ) THEN + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) + & = SLAVES_PERE( 1: NSLAVES ) + POSITION = POSITION + NSLAVES + END IF + BUF_CB%CONTENT( POSITION:POSITION+NCBSON-1 ) = + & TROW( 1: NCBSON ) + POSITION = POSITION + NCBSON + POSITION = POSITION - IPOS + IF ( POSITION * SIZEofINT .NE. SIZE ) THEN + WRITE(*,*) 'Error in CMUMPS_71 :', + & ' wrong estimated size' + CALL MUMPS_ABORT() + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, + & MPI_PACKED, + & DEST( NDEST ), MAPLIG, COMM, + & BUF_CB%CONTENT( IREQ ), + & IERR ) + ELSE + NSEND = 0 + DO IDEST = 1, NDEST + IF ( DEST( IDEST ) .ne. MYID ) NSEND = NSEND + 1 + END DO + SIZE = SIZEofINT * + & ( ( OVHSIZE + 7 + NSLAVES )* NSEND + NCBSON ) + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + SIZE = SIZE + SIZEofINT * NSEND*( NSLAVES + 1 ) + ENDIF + CALL CMUMPS_79( BUF_CB, SIZE_AV ) + IF ( SIZE_AV .LT. SIZE ) THEN + IERR = -1 + RETURN + END IF + DO IDEST= 1, NDEST + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & IDEST, NCBSON, + & NDEST, + & TROW_SIZE, INDX ) + SIZE = SIZEofINT * ( NSLAVES + TROW_SIZE + 7 ) + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + SIZE = SIZE + SIZEofINT * ( NSLAVES + 1 ) + ENDIF + IF ( MYID .NE. DEST( IDEST ) ) THEN + CALL CMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE, DEST(IDEST) + & ) + IF ( IERR .LT. 0 ) THEN + WRITE(*,*) 'Problem in CMUMPS_4: IERR<0' + CALL MUMPS_ABORT() + END IF + IF (SIZE.GT.SIZE_RBUF_BYTES) THEN + IERR = -3 + RETURN + ENDIF + POSITION = IPOS + BUF_CB%CONTENT( POSITION ) = INODE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = ISON + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NSLAVES + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFRONT + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NASS1 + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = TROW_SIZE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFS4FATHER + POSITION = POSITION + 1 + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES ) + & = TAB_POS_IN_PERE(1:NSLAVES+1,INIV2) + POSITION = POSITION + NSLAVES + 1 + ENDIF + IF ( NSLAVES .NE. 0 ) THEN + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) + & = SLAVES_PERE( 1: NSLAVES ) + POSITION = POSITION + NSLAVES + END IF + BUF_CB%CONTENT( POSITION:POSITION+TROW_SIZE-1 ) = + & TROW( INDX: INDX + TROW_SIZE - 1 ) + POSITION = POSITION + TROW_SIZE + POSITION = POSITION - IPOS + IF ( POSITION * SIZEofINT .NE. SIZE ) THEN + WRITE(*,*) ' ERROR 1 in TRY_SEND_MAPLIG:', + & 'Wrong estimated size' + CALL MUMPS_ABORT() + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, + & MPI_PACKED, + & DEST( IDEST ), MAPLIG, COMM, + & BUF_CB%CONTENT( IREQ ), + & IERR ) + END IF + END DO + END IF + 500 CONTINUE + RETURN + END SUBROUTINE CMUMPS_71 + SUBROUTINE CMUMPS_65( INODE, NFRONT, + & NCOL, NPIV, FPERE, LASTBL, IPIV, VAL, + & PDEST, NDEST, KEEP50, NB_BLOC_FAC, COMM, IERR ) + IMPLICIT NONE + INTEGER INODE, NCOL, NPIV, FPERE, NFRONT, NDEST + INTEGER IPIV( NPIV ) + COMPLEX VAL( NFRONT, * ) + INTEGER PDEST( NDEST ) + INTEGER KEEP50, NB_BLOC_FAC, COMM, IERR + LOGICAL LASTBL + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE, + & IDEST, IPOSMSG, I + INTEGER NPIVSENT + INTEGER SSS, SS2 + IERR = 0 + IF ( LASTBL ) THEN + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 4 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + ELSE + CALL MPI_PACK_SIZE( 6 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + END IF + ELSE + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 3 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + ELSE + CALL MPI_PACK_SIZE( 4 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + END IF + END IF + SIZE2 = 0 + IF (NPIV.GT.0) + & CALL MPI_PACK_SIZE( NPIV*NCOL, MPI_COMPLEX, + & COMM, SIZE2, IERR ) + SIZE = SIZE1 + SIZE2 + CALL CMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & NDEST , PDEST + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + IF (SIZE.GT.SIZE_RBUF_BYTES) THEN + SSS = 0 + IF ( LASTBL ) THEN + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 4 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + ELSE + CALL MPI_PACK_SIZE( 6 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + END IF + ELSE + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 3 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + ELSE + CALL MPI_PACK_SIZE( 4 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + END IF + END IF + IF (NPIV.GT.0) + & CALL MPI_PACK_SIZE( NPIV*NCOL, MPI_COMPLEX, + & COMM, SS2, IERR ) + SSS = SSS + SS2 + IF (SSS.GT.SIZE_RBUF_BYTES) THEN + IERR = -2 + RETURN + ENDIF + ENDIF + BUF_CB%ILASTMSG = BUF_CB%ILASTMSG + ( NDEST - 1 ) * OVHSIZE + IPOS = IPOS - OVHSIZE + DO IDEST = 1, NDEST - 1 + BUF_CB%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = + & IPOS + IDEST * OVHSIZE + END DO + BUF_CB%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 + IPOSMSG = IPOS + OVHSIZE * NDEST + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + NPIVSENT = NPIV + IF (LASTBL) NPIVSENT = -NPIV + CALL MPI_PACK( NPIVSENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + IF ( LASTBL .or. KEEP50.ne.0 ) THEN + CALL MPI_PACK( FPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + END IF + IF ( LASTBL .AND. KEEP50 .NE. 0 ) THEN + CALL MPI_PACK( NDEST, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NB_BLOC_FAC, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + END IF + CALL MPI_PACK( NCOL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + IF ( NPIV.GT.0) THEN + CALL MPI_PACK( IPIV, NPIV, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + DO I = 1, NPIV + CALL MPI_PACK( VAL(1,I), NCOL, + & MPI_COMPLEX, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + END DO + ENDIF + DO IDEST = 1, NDEST + IF ( KEEP50.eq.0) THEN + CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, + & PDEST(IDEST), BLOC_FACTO, COMM, + & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), + & IERR ) + ELSE + CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, + & PDEST(IDEST), BLOC_FACTO_SYM, COMM, + & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), + & IERR ) + END IF + END DO + SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT + IF ( SIZE .LT. POSITION ) THEN + WRITE(*,*) ' Error sending blocfacto : size < position' + WRITE(*,*) ' Size,position=',SIZE,POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE .NE. POSITION ) CALL CMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE CMUMPS_65 + SUBROUTINE CMUMPS_64( INODE, + & NPIV, FPERE, IPOSK, JPOSK, UIP21K, NCOLU, + & NDEST, PDEST, COMM, IERR ) + IMPLICIT NONE + INTEGER INODE, NCOLU, IPOSK, JPOSK, NPIV, NDEST, FPERE + COMPLEX UIP21K( NPIV, NCOLU ) + INTEGER PDEST( NDEST ) + INTEGER COMM, IERR + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE, + & IDEST, IPOSMSG, SSS, SS2 + IERR = 0 + CALL MPI_PACK_SIZE( 6 + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + CALL MPI_PACK_SIZE( abs(NPIV)*NCOLU, MPI_COMPLEX, + & COMM, SIZE2, IERR ) + SIZE = SIZE1 + SIZE2 + IF (SIZE.GT.SIZE_RBUF_BYTES) THEN + CALL MPI_PACK_SIZE( 6 , + & MPI_INTEGER, COMM, SSS, IERR ) + CALL MPI_PACK_SIZE( abs(NPIV)*NCOLU, MPI_COMPLEX, + & COMM, SS2, IERR ) + SSS = SSS+SS2 + IF (SSS.GT.SIZE_RBUF_BYTES) THEN + IERR = -2 + RETURN + ENDIF + END IF + CALL CMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & NDEST, PDEST + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + BUF_CB%ILASTMSG = BUF_CB%ILASTMSG + ( NDEST - 1 ) * OVHSIZE + IPOS = IPOS - OVHSIZE + DO IDEST = 1, NDEST - 1 + BUF_CB%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = + & IPOS + IDEST * OVHSIZE + END DO + BUF_CB%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 + IPOSMSG = IPOS + OVHSIZE * NDEST + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IPOSK, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( JPOSK, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NPIV, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( FPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NCOLU, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( UIP21K, abs(NPIV) * NCOLU, + & MPI_COMPLEX, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + DO IDEST = 1, NDEST + CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, + & PDEST(IDEST), BLOC_FACTO_SYM_SLAVE, COMM, + & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), + & IERR ) + END DO + SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT + IF ( SIZE .LT. POSITION ) THEN + WRITE(*,*) ' Error sending blfac slave : size < position' + WRITE(*,*) ' Size,position=',SIZE,POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE .NE. POSITION ) CALL CMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE CMUMPS_64 + SUBROUTINE CMUMPS_648( N, ISON, + & NBCOL_SON, NBROW_SON, INDCOL_SON, INDROW_SON, + & LD_SON, VAL_SON, TAG, SUBSET_ROW, SUBSET_COL, + & NSUBSET_ROW, NSUBSET_COL, + & NSUPROW, NSUPCOL, + & NPROW, NPCOL, MBLOCK, RG2L_ROW, RG2L_COL, + & NBLOCK, PDEST, COMM, IERR , + & TAB, TABSIZE, TRANSP, SIZE_PACK, + & N_ALREADY_SENT, KEEP, BBPCBP ) + IMPLICIT NONE + INTEGER N, ISON, NBCOL_SON, NBROW_SON, NSUBSET_ROW, NSUBSET_COL + INTEGER NPROW, NPCOL, MBLOCK, NBLOCK, LD_SON + INTEGER BBPCBP + INTEGER PDEST, TAG, COMM, IERR + INTEGER INDCOL_SON( NBCOL_SON ), INDROW_SON( NBROW_SON ) + INTEGER SUBSET_ROW( NSUBSET_ROW ), SUBSET_COL( NSUBSET_COL ) + INTEGER, DIMENSION(:) :: RG2L_ROW + INTEGER, DIMENSION(:) :: RG2L_COL + INTEGER NSUPROW, NSUPCOL + INTEGER(8), INTENT(IN) :: TABSIZE + INTEGER SIZE_PACK + INTEGER KEEP(500) + COMPLEX VAL_SON( LD_SON, * ), TAB(*) + LOGICAL TRANSP + INTEGER N_ALREADY_SENT + INCLUDE 'mpif.h' + INTEGER SIZE1, SIZE2, SIZE_AV, POSITION + INTEGER SIZE_CBP, SIZE_TMP + INTEGER IREQ, IPOS, ITAB + INTEGER ISUB, JSUB, I, J + INTEGER ILOC_ROOT, JLOC_ROOT + INTEGER IPOS_ROOT, JPOS_ROOT + INTEGER IONE + LOGICAL RECV_BUF_SMALLER_THAN_SEND + INTEGER PDEST2(1) + PARAMETER ( IONE=1 ) + INTEGER N_PACKET + INTEGER NSUBSET_ROW_EFF, NSUBSET_COL_EFF, NSUPCOL_EFF + PDEST2(1) = PDEST + IERR = 0 + IF ( NSUBSET_ROW * NSUBSET_COL .NE. 0 ) THEN + CALL CMUMPS_79( BUF_CB, SIZE_AV ) + IF (SIZE_AV .LT. SIZE_RBUF_BYTES) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + SIZE_AV = SIZE_RBUF_BYTES + ENDIF + SIZE_AV = min(SIZE_AV, SIZE_RBUF_BYTES) + CALL MPI_PACK_SIZE(8 + NSUBSET_COL, + & MPI_INTEGER, COMM, SIZE1, IERR ) + SIZE_CBP = 0 + IF (N_ALREADY_SENT .EQ. 0 .AND. + & min(NSUPROW,NSUPCOL) .GT.0) THEN + CALL MPI_PACK_SIZE(NSUPROW, MPI_INTEGER, COMM, + & SIZE_CBP, IERR) + CALL MPI_PACK_SIZE(NSUPCOL, MPI_INTEGER, COMM, + & SIZE_TMP, IERR) + SIZE_CBP = SIZE_CBP + SIZE_TMP + CALL MPI_PACK_SIZE(NSUPROW*NSUPCOL, + & MPI_COMPLEX, COMM, + & SIZE_TMP, IERR) + SIZE_CBP = SIZE_CBP + SIZE_TMP + SIZE1 = SIZE1 + SIZE_CBP + ENDIF + IF (BBPCBP.EQ.1) THEN + NSUBSET_COL_EFF = NSUBSET_COL - NSUPCOL + NSUPCOL_EFF = 0 + ELSE + NSUBSET_COL_EFF = NSUBSET_COL + NSUPCOL_EFF = NSUPCOL + ENDIF + NSUBSET_ROW_EFF = NSUBSET_ROW - NSUPROW + N_PACKET = + & (SIZE_AV - SIZE1) / (SIZEofINT + NSUBSET_COL_EFF * SIZEofREAL) + 10 CONTINUE + N_PACKET = min( N_PACKET, + & NSUBSET_ROW_EFF-N_ALREADY_SENT ) + IF (N_PACKET .LE. 0 .AND. + & NSUBSET_ROW_EFF-N_ALREADY_SENT.GT.0) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR=-3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + CALL MPI_PACK_SIZE( 8 + NSUBSET_COL_EFF + N_PACKET, + & MPI_INTEGER, COMM, SIZE1, IERR ) + SIZE1 = SIZE1 + SIZE_CBP + CALL MPI_PACK_SIZE( N_PACKET * NSUBSET_COL_EFF, + & MPI_COMPLEX, + & COMM, SIZE2, IERR ) + SIZE_PACK = SIZE1 + SIZE2 + IF (SIZE_PACK .GT. SIZE_AV) THEN + N_PACKET = N_PACKET - 1 + IF ( N_PACKET > 0 ) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF +#if ! defined(DBG_SMB3) + IF (N_PACKET + N_ALREADY_SENT .NE. NSUBSET_ROW - NSUPROW + & .AND. + & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 + & .AND. .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF +#endif + ELSE + N_PACKET = 0 + CALL MPI_PACK_SIZE(8,MPI_INTEGER, COMM, SIZE_PACK, IERR ) + END IF + CALL CMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE, PDEST2 + & ) + IF ( IERR .LT. 0 ) GOTO 100 + IF ( SIZE_PACK.GT.SIZE_RBUF_BYTES ) THEN + IERR = -3 + GOTO 100 + ENDIF + POSITION = 0 + CALL MPI_PACK( ISON, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUBSET_ROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUPROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUBSET_COL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUPCOL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( N_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( N_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( BBPCBP, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + IF ( NSUBSET_ROW * NSUBSET_COL .NE. 0 ) THEN + IF (N_ALREADY_SENT .EQ. 0 .AND. + & min(NSUPROW, NSUPCOL) .GT. 0) THEN + DO ISUB = NSUBSET_ROW-NSUPROW+1, NSUBSET_ROW + I = SUBSET_ROW( ISUB ) + IPOS_ROOT = RG2L_ROW(INDCOL_SON( I )) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + DO ISUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL + J = SUBSET_COL( ISUB ) + JPOS_ROOT = INDROW_SON( J ) - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + IF ( TABSIZE.GE.int(NSUPROW,8)*int(NSUPCOL,8) ) THEN + ITAB = 1 + DO JSUB = NSUBSET_ROW - NSUPROW+1, NSUBSET_ROW + J = SUBSET_ROW(JSUB) + DO ISUB = NSUBSET_COL - NSUPCOL+1, NSUBSET_COL + I = SUBSET_COL(ISUB) + TAB(ITAB) = VAL_SON(J, I) + ITAB = ITAB + 1 + ENDDO + ENDDO + CALL MPI_PACK(TAB(1), NSUPROW*NSUPCOL, + & MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ELSE + DO JSUB = NSUBSET_ROW - NSUPROW+1, NSUBSET_ROW + J = SUBSET_ROW(JSUB) + DO ISUB = NSUBSET_COL - NSUPCOL+1, NSUBSET_COL + I = SUBSET_COL(ISUB) + CALL MPI_PACK(VAL_SON(J,I), 1, + & MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + ENDDO + ENDIF + ENDIF + IF ( .NOT. TRANSP ) THEN + DO ISUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + I = SUBSET_ROW( ISUB ) + IPOS_ROOT = RG2L_ROW( INDROW_SON( I ) ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO JSUB = 1, NSUBSET_COL_EFF - NSUPCOL_EFF + J = SUBSET_COL( JSUB ) + JPOS_ROOT = RG2L_COL( INDCOL_SON( J ) ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO JSUB = NSUBSET_COL_EFF-NSUPCOL_EFF+1, NSUBSET_COL_EFF + J = SUBSET_COL( JSUB ) + JPOS_ROOT = INDCOL_SON( J ) - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + ELSE + DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + J = SUBSET_ROW( JSUB ) + IPOS_ROOT = RG2L_ROW( INDCOL_SON( J ) ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO ISUB = 1, NSUBSET_COL_EFF - NSUPCOL_EFF + I = SUBSET_COL( ISUB ) + JPOS_ROOT = RG2L_COL( INDROW_SON( I ) ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO ISUB = NSUBSET_COL_EFF - NSUPCOL_EFF + 1, NSUBSET_COL_EFF + I = SUBSET_COL( ISUB ) + JPOS_ROOT = INDROW_SON(I) - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + END IF + IF ( TABSIZE.GE.int(N_PACKET,8)*int(NSUBSET_COL_EFF,8) ) THEN + IF ( .NOT. TRANSP ) THEN + ITAB = 1 + DO ISUB = N_ALREADY_SENT+1, + & N_ALREADY_SENT+N_PACKET + I = SUBSET_ROW( ISUB ) + DO JSUB = 1, NSUBSET_COL_EFF + J = SUBSET_COL( JSUB ) + TAB( ITAB ) = VAL_SON(J,I) + ITAB = ITAB + 1 + END DO + END DO + CALL MPI_PACK(TAB(1), NSUBSET_COL_EFF*N_PACKET, + & MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ELSE + ITAB = 1 + DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + J = SUBSET_ROW( JSUB ) + DO ISUB = 1, NSUBSET_COL_EFF + I = SUBSET_COL( ISUB ) + TAB( ITAB ) = VAL_SON( J, I ) + ITAB = ITAB + 1 + END DO + END DO + CALL MPI_PACK(TAB(1), NSUBSET_COL_EFF*N_PACKET, + & MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END IF + ELSE + IF ( .NOT. TRANSP ) THEN + DO ISUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + I = SUBSET_ROW( ISUB ) + DO JSUB = 1, NSUBSET_COL_EFF + J = SUBSET_COL( JSUB ) + CALL MPI_PACK( VAL_SON( J, I ), 1, + & MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + END DO + ELSE + DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + J = SUBSET_ROW( JSUB ) + DO ISUB = 1, NSUBSET_COL_EFF + I = SUBSET_COL( ISUB ) + CALL MPI_PACK( VAL_SON( J, I ), 1, + & MPI_COMPLEX, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + END DO + END IF + ENDIF + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & PDEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK .LT. POSITION ) THEN + WRITE(*,*) ' Error sending contribution to root:Sizeid%ISTEP_TO_INIV2 + CAND_LOAD=>id%CANDIDATES + ND_LOAD=>id%ND_STEPS + KEEP_LOAD=>id%KEEP + KEEP =>id%KEEP + KEEP8_LOAD=>id%KEEP8 + FILS_LOAD=>id%FILS + FRERE_LOAD=>id%FRERE_STEPS + DAD_LOAD=>id%DAD_STEPS + PROCNODE_LOAD=>id%PROCNODE_STEPS + STEP_LOAD=>id%STEP + NE_LOAD=>id%NE_STEPS + N_LOAD=id%N + ROOT_CURRENT_SUBTREE=-9999 + MEMORY_MD=MEMORY_MD_ARG + LA=MAXS + MAX_SURF_MASTER=id%MAX_SURF_MASTER+ + & (int(id%KEEP(12),8)*int(id%MAX_SURF_MASTER,8)/int(100,8)) + COMM_LD = id%COMM_LOAD + MAX_PEAK_STK = 0.0D0 + K69 = KEEP(69) + IF ( KEEP(47) .le. 0 .OR. KEEP(47) .gt. 4 ) THEN + write(*,*) "Internal error 1 in CMUMPS_185" + CALL MUMPS_ABORT() + END IF + CHK_LD=dble(0) + BDC_MEM = ( KEEP(47) >= 2 ) + BDC_POOL = ( KEEP(47) >= 3 ) + BDC_SBTR = ( KEEP(47) >= 4 ) + BDC_M2_MEM = ( ( KEEP(80) == 2 .OR. KEEP(80) == 3 ) + & .AND. KEEP(47) == 4 ) + BDC_M2_FLOPS = ( KEEP(80) == 1 + & .AND. KEEP(47) .GE. 1 ) + BDC_MD = (KEEP(86)==1) + SBTR_WHICH_M = KEEP(90) + REMOVE_NODE_FLAG=.FALSE. + REMOVE_NODE_FLAG_MEM=.FALSE. + REMOVE_NODE_COST_MEM=dble(0) + REMOVE_NODE_COST=dble(0) + IF (KEEP(80) .LT. 0 .OR. KEEP(80)>3) THEN + WRITE(*,*) "Unimplemented KEEP(80) Strategy" + CALL MUMPS_ABORT() + ENDIF + IF ((KEEP(80) == 2 .OR. KEEP(80)==3 ).AND. KEEP(47).NE.4) + & THEN + WRITE(*,*) "Internal error 3 in CMUMPS_185" + CALL MUMPS_ABORT() + END IF + IF (KEEP(81) == 1 .AND. KEEP(47) < 2) THEN + WRITE(*,*) "Internal error 2 in CMUMPS_185" + CALL MUMPS_ABORT() + ENDIF + BDC_POOL_MNG = ((KEEP(81) == 1).AND.(KEEP(47) >= 2)) + IF(KEEP(76).EQ.4)THEN + DEPTH_FIRST_LOAD=>id%DEPTH_FIRST + ENDIF + IF(KEEP(76).EQ.5)THEN + COST_TRAV=>id%COST_TRAV + ENDIF + IF(KEEP(76).EQ.6)THEN + DEPTH_FIRST_LOAD=>id%DEPTH_FIRST + DEPTH_FIRST_SEQ_LOAD=>id%DEPTH_FIRST_SEQ + SBTR_ID_LOAD=>id%SBTR_ID + ENDIF + IF (BDC_M2_MEM.OR.BDC_M2_FLOPS) THEN + ALLOCATE(NIV2(id%NSLAVES), NB_SON(KEEP(28)), + & POOL_NIV2(100),POOL_NIV2_COST(100), + & stat=allocok) + NB_SON=id%NE_STEPS + NIV2=dble(0) + IF (allocok > 0) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = id%NSLAVES + KEEP(28) + 200 + RETURN + ENDIF + ENDIF + K50 = id%KEEP(50) + CALL MPI_COMM_RANK( COMM_LD, MYID, IERR ) + NPROCS = id%NSLAVES + DM_SUMLU=ZERO + POOL_SIZE=0 + IF(BDC_MD)THEN + IF ( allocated(MD_MEM) ) DEALLOCATE(MD_MEM) + ALLOCATE( MD_MEM( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(TAB_MAXS) ) DEALLOCATE(TAB_MAXS) + ALLOCATE( TAB_MAXS( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + TAB_MAXS=0_8 + IF ( allocated(LU_USAGE) ) DEALLOCATE(LU_USAGE) + ALLOCATE( LU_USAGE( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + LU_USAGE=dble(0) + MD_MEM=int(0,8) + ENDIF + IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN + ALLOCATE(CB_COST_MEM(2*2000*id%NSLAVES), + & stat=allocok) + IF (allocok > 0) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = id%NSLAVES + RETURN + ENDIF + CB_COST_MEM=int(0,8) + ALLOCATE(CB_COST_ID(2000*3), + & stat=allocok) + IF (allocok > 0) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = id%NSLAVES + RETURN + ENDIF + CB_COST_ID=0 + POS_MEM=1 + POS_ID=1 + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + ALLOCATE(FUTURE_NIV2(NPROCS), stat=allocok) + IF (allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + ENDIF + DO i = 1, NPROCS + FUTURE_NIV2(i) = id%FUTURE_NIV2(i) + IF(BDC_MD)THEN + IF(FUTURE_NIV2(i).EQ.0)THEN + MD_MEM(i-1)=999999999_8 + ENDIF + ENDIF + ENDDO + DELTA_MEM=ZERO + DELTA_LOAD=ZERO +#endif + CHECK_MEM=0_8 +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + NB_LEVEL2=0 + AMI_CHOSEN=.FALSE. + IS_DISPLAYED=.FALSE. +#endif +#endif + IF(BDC_SBTR.OR.BDC_POOL_MNG)THEN + NB_SUBTREES=id%NBSA_LOCAL + IF (allocated(MEM_SUBTREE)) DEALLOCATE(MEM_SUBTREE) + ALLOCATE(MEM_SUBTREE(id%NBSA_LOCAL),stat=allocok) + DO i=1,id%NBSA_LOCAL + MEM_SUBTREE(i)=id%MEM_SUBTREE(i) + ENDDO + MY_FIRST_LEAF=>id%MY_FIRST_LEAF + MY_NB_LEAF=>id%MY_NB_LEAF + MY_ROOT_SBTR=>id%MY_ROOT_SBTR + IF (allocated(SBTR_FIRST_POS_IN_POOL)) + & DEALLOCATE(SBTR_FIRST_POS_IN_POOL) + ALLOCATE(SBTR_FIRST_POS_IN_POOL(id%NBSA_LOCAL),stat=allocok) + INSIDE_SUBTREE=0 + PEAK_SBTR_CUR_LOCAL = dble(0) + SBTR_CUR_LOCAL = dble(0) + IF (allocated(SBTR_PEAK_ARRAY)) DEALLOCATE(SBTR_PEAK_ARRAY) + ALLOCATE(SBTR_PEAK_ARRAY(id%NBSA_LOCAL),stat=allocok) + SBTR_PEAK_ARRAY=dble(0) + IF (allocated(SBTR_CUR_ARRAY)) DEALLOCATE(SBTR_CUR_ARRAY) + ALLOCATE(SBTR_CUR_ARRAY(id%NBSA_LOCAL),stat=allocok) + SBTR_CUR_ARRAY=dble(0) + INDICE_SBTR_ARRAY=1 + NIV1_FLAG=0 + INDICE_SBTR=1 + ENDIF + IF ( allocated(LOAD_FLOPS) ) DEALLOCATE( LOAD_FLOPS ) + ALLOCATE( LOAD_FLOPS( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(WLOAD) ) DEALLOCATE( WLOAD ) + ALLOCATE( WLOAD( NPROCS ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(IDWLOAD) ) DEALLOCATE( IDWLOAD ) + ALLOCATE( IDWLOAD( NPROCS ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( BDC_MEM ) THEN + IF ( allocated(DM_MEM) ) DEALLOCATE( DM_MEM ) + ALLOCATE( DM_MEM( 0:NPROCS-1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + END IF + IF ( BDC_POOL ) THEN + IF ( allocated(POOL_MEM) ) DEALLOCATE(POOL_MEM) + ALLOCATE( POOL_MEM(0: NPROCS -1), stat=allocok) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + POOL_MEM = dble(0) + POOL_LAST_COST_SENT = dble(0) + END IF + IF ( BDC_SBTR ) THEN + IF ( allocated(SBTR_MEM) ) DEALLOCATE(SBTR_MEM) + ALLOCATE( SBTR_MEM(0: NPROCS -1), stat=allocok) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(SBTR_CUR) ) DEALLOCATE(SBTR_CUR) + ALLOCATE( SBTR_CUR(0: NPROCS -1), stat=allocok) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + SBTR_CUR = dble(0) + SBTR_MEM = dble(0) + END IF + CALL MUMPS_546(K34_LOC,K35_LOC) + K35 = K35_LOC + BUF_LOAD_SIZE = K34_LOC * 2 * ( NPROCS - 1 ) + + & NPROCS * ( K35_LOC + K34_LOC ) + IF (BDC_MEM) THEN + BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35_LOC + END IF + IF (BDC_SBTR)THEN + BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35_LOC + ENDIF + LBUF_LOAD_RECV = (BUF_LOAD_SIZE+K34_LOC)/K34_LOC + LBUF_LOAD_RECV_BYTES = LBUF_LOAD_RECV * K34_LOC + IF ( allocated(BUF_LOAD_RECV) ) DEALLOCATE(BUF_LOAD_RECV) + ALLOCATE( BUF_LOAD_RECV( LBUF_LOAD_RECV), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = LBUF_LOAD_RECV + RETURN + ENDIF + BUF_LOAD_SIZE = BUF_LOAD_SIZE * 20 + CALL CMUMPS_54( BUF_LOAD_SIZE, IERR ) + IF ( IERR .LT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = BUF_LOAD_SIZE + RETURN + END IF + DO i = 0, NPROCS - 1 + LOAD_FLOPS( i ) = ZERO + END DO +#if defined(OLD_LOAD_MECHANISM) + LOAD_FLOPS( MYID ) = COST_SUBTREE + LAST_LOAD_SENT = ZERO +#endif + IF ( BDC_MEM ) THEN + DO i = 0, NPROCS - 1 + DM_MEM( i )=ZERO + END DO +#if defined(OLD_LOAD_MECHANISM) + DM_LAST_MEM_SENT=ZERO +#endif + ENDIF + CALL CMUMPS_425(KEEP(69)) + IF(BDC_MD)THEN + MAX_SBTR=0.0D0 + IF(BDC_SBTR)THEN + DO i=1,id%NBSA_LOCAL + MAX_SBTR=max(id%MEM_SUBTREE(i),MAX_SBTR) + ENDDO + ENDIF + MD_MEM(MYID)=MEMORY_MD + WHAT=8 + CALL CMUMPS_460( WHAT, + & COMM_LD, NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & dble(MEMORY_MD),dble(0) ,MYID, IERR ) + WHAT=9 + MEMORY_SENT = dble(LA-MAX_SURF_MASTER)-MAX_SBTR + & - max( dble(LA) * dble(3) / dble(100), + & dble(2) * dble(max(KEEP(5),KEEP(6))) * dble(KEEP(127))) + IF (KEEP(12) > 25) THEN + MEMORY_SENT = MEMORY_SENT - + & dble(KEEP(12))*0.2d0*dble(LA)/100.0d0 + ENDIF + TAB_MAXS(MYID)=int(MEMORY_SENT,8) + CALL CMUMPS_460( WHAT, + & COMM_LD, NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & MEMORY_SENT, + & dble(0),MYID, IERR ) + ENDIF + RETURN + END SUBROUTINE CMUMPS_185 + SUBROUTINE CMUMPS_190( CHECK_FLOPS,PROCESS_BANDE, + & INC_LOAD, KEEP,KEEP8 ) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + DOUBLE PRECISION INC_LOAD + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + LOGICAL PROCESS_BANDE + INTEGER CHECK_FLOPS + INTEGER IERR + DOUBLE PRECISION ZERO, SEND_MEM, SEND_LOAD,SBTR_TMP + PARAMETER( ZERO=0.0d0 ) + INTRINSIC max, abs + IF (INC_LOAD == 0.0D0) THEN + IF(REMOVE_NODE_FLAG)THEN + REMOVE_NODE_FLAG=.FALSE. + ENDIF + RETURN + ENDIF + IF((CHECK_FLOPS.NE.0).AND. + & (CHECK_FLOPS.NE.1).AND.(CHECK_FLOPS.NE.2))THEN + WRITE(*,*)MYID,': Bad value for CHECK_FLOPS' + CALL MUMPS_ABORT() + ENDIF + IF(CHECK_FLOPS.EQ.1)THEN + CHK_LD=CHK_LD+INC_LOAD + ELSE + IF(CHECK_FLOPS.EQ.2)THEN + RETURN + ENDIF + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF ( PROCESS_BANDE ) THEN + RETURN + ENDIF +#endif + LOAD_FLOPS( MYID ) = max( LOAD_FLOPS( MYID ) + INC_LOAD, ZERO) + IF(BDC_M2_FLOPS.AND.REMOVE_NODE_FLAG)THEN + IF(INC_LOAD.NE.REMOVE_NODE_COST)THEN + IF(INC_LOAD.GT.REMOVE_NODE_COST)THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = DELTA_LOAD + + & (INC_LOAD-REMOVE_NODE_COST) + GOTO 888 +#else + GOTO 888 +#endif + ELSE +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = DELTA_LOAD - + & (REMOVE_NODE_COST-INC_LOAD) + GOTO 888 +#else + GOTO 888 +#endif + ENDIF + ENDIF + GOTO 333 + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = DELTA_LOAD + INC_LOAD + 888 CONTINUE + IF ( DELTA_LOAD > MIN_DIFF .OR. DELTA_LOAD < -MIN_DIFF) THEN + SEND_LOAD = DELTA_LOAD + IF (BDC_MEM) THEN + SEND_MEM = DELTA_MEM + ELSE + SEND_MEM = ZERO + END IF +#else + 888 CONTINUE + IF ( abs( LOAD_FLOPS ( MYID ) - + & LAST_LOAD_SENT ).GT.MIN_DIFF)THEN + IERR = 0 + SEND_LOAD = LOAD_FLOPS( MYID ) + IF ( BDC_MEM ) THEN + SEND_MEM = DM_MEM(MYID) + ELSE + SEND_MEM = ZERO + END IF +#endif + IF(BDC_SBTR)THEN + SBTR_TMP=SBTR_CUR(MYID) + ELSE + SBTR_TMP=dble(0) + ENDIF + 111 CONTINUE + CALL CMUMPS_77( BDC_SBTR,BDC_MEM, + & BDC_MD,COMM_LD, NPROCS, + & SEND_LOAD, + & SEND_MEM,SBTR_TMP, + & DM_SUMLU, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & MYID, IERR ) + IF ( IERR == -1 )THEN + CALL CMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE.0 ) THEN + WRITE(*,*) "Internal Error in CMUMPS_190",IERR + CALL MUMPS_ABORT() + ENDIF + IF ( IERR .EQ. 0 ) THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = ZERO + IF (BDC_MEM) DELTA_MEM = ZERO +#else + LAST_LOAD_SENT = LOAD_FLOPS( MYID ) + IF ( BDC_MEM ) DM_LAST_MEM_SENT = DM_MEM( MYID ) +#endif + END IF + ENDIF + 333 CONTINUE + IF(REMOVE_NODE_FLAG)THEN + REMOVE_NODE_FLAG=.FALSE. + ENDIF + RETURN + END SUBROUTINE CMUMPS_190 + SUBROUTINE CMUMPS_471( SSARBR, + & PROCESS_BANDE_ARG, MEM_VALUE, NEW_LU, INC_MEM_ARG, + & KEEP,KEEP8,LRLU) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER(8), INTENT(IN) :: MEM_VALUE, INC_MEM_ARG, NEW_LU,LRLU + LOGICAL, INTENT(IN) :: PROCESS_BANDE_ARG, SSARBR + INTEGER IERR, KEEP(500) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION ZERO, SEND_MEM, SBTR_TMP + PARAMETER( ZERO=0.0d0 ) + INTRINSIC max, abs + INTEGER(8) :: INC_MEM + LOGICAL PROCESS_BANDE +#if defined(OLD_LOAD_MECHANISM) + DOUBLE PRECISION TMP_MEM +#endif + PROCESS_BANDE=PROCESS_BANDE_ARG + INC_MEM = INC_MEM_ARG +#if ! defined(OLD_LOAD_MECHANISM) + IF ( PROCESS_BANDE .AND. NEW_LU .NE. 0_8) THEN + WRITE(*,*) " Internal Error in CMUMPS_471." + WRITE(*,*) " NEW_LU must be zero if called from PROCESS_BANDE" + CALL MUMPS_ABORT() + ENDIF +#endif +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + IF(PROCESS_BANDE)THEN + PROCESS_BANDE=.FALSE. + NB_LEVEL2=NB_LEVEL2-1 + IF(NB_LEVEL2.LT.0)THEN + WRITE(*,*)MYID,': problem with NB_LEVEL2' + ELSEIF(NB_LEVEL2.EQ.0)THEN + IF(IS_DISPLAYED)THEN +#if defined(STATS_DYNAMIC_MEMORY) + WRITE(*,*)MYID,': end of Incoherent state at time=', + & MPI_WTIME()-TIME_REF +#endif + IS_DISPLAYED=.FALSE. + ENDIF + AMI_CHOSEN=.FALSE. + ENDIF + ENDIF + IF((KEEP(73).EQ.0).AND.(NB_LEVEL2.NE.0) + & .AND.(.NOT.IS_DISPLAYED))THEN + IS_DISPLAYED=.TRUE. +#if defined(STATS_DYNAMIC_MEMORY) + WRITE(*,*)MYID,': Begin of Incoherent state (1) at time=', + & MPI_WTIME()-TIME_REF +#endif + ENDIF +#endif +#endif + DM_SUMLU = DM_SUMLU + dble(NEW_LU) + IF(KEEP_LOAD(201).EQ.0)THEN + CHECK_MEM = CHECK_MEM + INC_MEM + ELSE + CHECK_MEM = CHECK_MEM + INC_MEM - NEW_LU + ENDIF + IF ( MEM_VALUE .NE. CHECK_MEM ) THEN + WRITE(*,*)MYID, + & ':Problem with increments in CMUMPS_471', + & CHECK_MEM, MEM_VALUE, INC_MEM,NEW_LU + CALL MUMPS_ABORT() + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (PROCESS_BANDE) THEN + RETURN + ENDIF +#endif + IF(BDC_POOL_MNG) THEN + IF(SBTR_WHICH_M.EQ.0)THEN + IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+ + & dble(INC_MEM-NEW_LU) + ELSE + IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+ + & dble(INC_MEM) + ENDIF + ENDIF + IF ( .NOT. BDC_MEM ) THEN + RETURN + ENDIF +#if defined(OLD_LOAD_MECHANISM) + IF(KEEP_LOAD(201).EQ.0)THEN + DM_MEM( MYID ) = dble(CHECK_MEM) - DM_SUMLU + ELSE + DM_MEM( MYID ) = dble(CHECK_MEM) + ENDIF + TMP_MEM = DM_MEM(MYID) +#endif + IF (BDC_SBTR .AND. SSARBR) THEN + IF((SBTR_WHICH_M.EQ.0).AND.(KEEP(201).NE.0))THEN + SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM-NEW_LU) + ELSE + SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM) + ENDIF + SBTR_TMP = SBTR_CUR(MYID) + ELSE + SBTR_TMP=dble(0) + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF ( NEW_LU > 0_8 ) THEN + INC_MEM = INC_MEM - NEW_LU + ENDIF + DM_MEM( MYID ) = DM_MEM(MYID) + dble(INC_MEM) + MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MYID)) + IF(BDC_M2_MEM.AND.REMOVE_NODE_FLAG_MEM)THEN + IF(dble(INC_MEM).NE.REMOVE_NODE_COST_MEM)THEN + IF(dble(INC_MEM).GT.REMOVE_NODE_COST_MEM)THEN + DELTA_MEM = DELTA_MEM + + & (dble(INC_MEM)-REMOVE_NODE_COST_MEM) + GOTO 888 + ELSE + DELTA_MEM = DELTA_MEM - + & (REMOVE_NODE_COST_MEM-dble(INC_MEM)) + GOTO 888 + ENDIF + ENDIF + GOTO 333 + ENDIF + DELTA_MEM = DELTA_MEM + dble(INC_MEM) + 888 CONTINUE + IF ((KEEP(48).NE.5).OR. + & ((KEEP(48).EQ.5).AND.(abs(DELTA_MEM) + & .GE.0.1d0*dble(LRLU))))THEN + IF ( abs(DELTA_MEM) > DM_THRES_MEM ) THEN + SEND_MEM = DELTA_MEM +#else + IF(BDC_M2_MEM.AND.REMOVE_NODE_FLAG_MEM)THEN + IF(INC_MEM.NE.REMOVE_NODE_COST_MEM)THEN + IF(INC_MEM.EQ.REMOVE_NODE_COST_MEM)THEN + GOTO 333 + ELSEIF(INC_MEM.LT.REMOVE_NODE_COST_MEM)THEN + GOTO 333 + ENDIF + ENDIF + ENDIF + IF ((KEEP(48).NE.5).OR. + & ((KEEP(48).EQ.5).AND. + & (abs(TMP_MEM-DM_LAST_MEM_SENT).GE. + & 0.1d0*dble(LRLU))))THEN + IF ( abs( TMP_MEM-DM_LAST_MEM_SENT) > + & DM_THRES_MEM ) THEN + IERR = 0 + SEND_MEM = TMP_MEM +#endif + 111 CONTINUE + CALL CMUMPS_77( + & BDC_SBTR, + & BDC_MEM,BDC_MD, COMM_LD, + & NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & DELTA_LOAD, +#else + & LOAD_FLOPS( MYID ), +#endif + & SEND_MEM,SBTR_TMP, + & DM_SUMLU, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & MYID,IERR ) + IF ( IERR == -1 )THEN + CALL CMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in CMUMPS_471",IERR + CALL MUMPS_ABORT() + ENDIF + IF ( IERR .EQ. 0 ) THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = ZERO + DELTA_MEM = ZERO +#else + LAST_LOAD_SENT = LOAD_FLOPS ( MYID ) + DM_LAST_MEM_SENT = TMP_MEM +#endif + END IF + ENDIF + ENDIF + 333 CONTINUE + IF(REMOVE_NODE_FLAG_MEM)THEN + REMOVE_NODE_FLAG_MEM=.FALSE. + ENDIF + END SUBROUTINE CMUMPS_471 + INTEGER FUNCTION CMUMPS_186( K69, MEM_DISTRIB,MSG_SIZE ) + IMPLICIT NONE + INTEGER i, NLESS, K69 + INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB + DOUBLE PRECISION LREF + DOUBLE PRECISION MSG_SIZE + NLESS = 0 + DO i=1,NPROCS + IDWLOAD(i) = i - 1 + ENDDO + WLOAD(1:NPROCS) = LOAD_FLOPS(0:NPROCS-1) + IF(BDC_M2_FLOPS)THEN + DO i=1,NPROCS + WLOAD(i)=WLOAD(i)+NIV2(i) + ENDDO + ENDIF + IF(K69 .gt. 1) THEN + CALL CMUMPS_426(MEM_DISTRIB,MSG_SIZE,IDWLOAD,NPROCS) + ENDIF + LREF = LOAD_FLOPS(MYID) + DO i=1, NPROCS + IF (WLOAD(i).LT.LREF) NLESS=NLESS+1 + ENDDO + CMUMPS_186 = NLESS + RETURN + END FUNCTION CMUMPS_186 + SUBROUTINE CMUMPS_189(MEM_DISTRIB,MSG_SIZE,DEST, + & NSLAVES) + IMPLICIT NONE + INTEGER NSLAVES + INTEGER DEST(NSLAVES) + INTEGER, DIMENSION(0:NPROCS - 1) :: MEM_DISTRIB + INTEGER i,J,NBDEST + DOUBLE PRECISION MSG_SIZE + IF ( NSLAVES.eq.NPROCS-1 ) THEN + J = MYID+1 + DO i=1,NSLAVES + J=J+1 + IF (J.GT.NPROCS) J=1 + DEST(i) = J - 1 + ENDDO + ELSE + DO i=1,NPROCS + IDWLOAD(i) = i - 1 + ENDDO + CALL MUMPS_558(NPROCS, WLOAD, IDWLOAD) + NBDEST = 0 + DO i=1, NSLAVES + J = IDWLOAD(i) + IF (J.NE.MYID) THEN + NBDEST = NBDEST+1 + DEST(NBDEST) = J + ENDIF + ENDDO + IF (NBDEST.NE.NSLAVES) THEN + DEST(NSLAVES) = IDWLOAD(NSLAVES+1) + ENDIF + IF(BDC_MD)THEN + J=NSLAVES+1 + do i=NSLAVES+1,NPROCS + IF(IDWLOAD(i).NE.MYID)THEN + DEST(J)= IDWLOAD(i) + J=J+1 + ENDIF + end do + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_189 + SUBROUTINE CMUMPS_183( INFO1, IERR ) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER, intent(in) :: INFO1 + INTEGER, intent(out) :: IERR + IERR=0 + DEALLOCATE( LOAD_FLOPS ) + DEALLOCATE( WLOAD ) + DEALLOCATE( IDWLOAD ) +#if ! defined(OLD_LOAD_MECHANISM) + DEALLOCATE(FUTURE_NIV2) +#endif + IF(BDC_MD)THEN + DEALLOCATE(MD_MEM) + DEALLOCATE(LU_USAGE) + DEALLOCATE(TAB_MAXS) + ENDIF + IF ( BDC_MEM ) DEALLOCATE( DM_MEM ) + IF ( BDC_POOL) DEALLOCATE( POOL_MEM ) + IF ( BDC_SBTR) THEN + DEALLOCATE( SBTR_MEM ) + DEALLOCATE( SBTR_CUR ) + DEALLOCATE(SBTR_FIRST_POS_IN_POOL) + NULLIFY(MY_FIRST_LEAF) + NULLIFY(MY_NB_LEAF) + NULLIFY(MY_ROOT_SBTR) + ENDIF + IF(KEEP_LOAD(76).EQ.4)THEN + NULLIFY(DEPTH_FIRST_LOAD) + ENDIF + IF(KEEP_LOAD(76).EQ.5)THEN + NULLIFY(COST_TRAV) + ENDIF + IF((KEEP_LOAD(76).EQ.4).OR.(KEEP_LOAD(76).EQ.6))THEN + NULLIFY(DEPTH_FIRST_LOAD) + NULLIFY(DEPTH_FIRST_SEQ_LOAD) + NULLIFY(SBTR_ID_LOAD) + ENDIF + IF (BDC_M2_MEM.OR.BDC_M2_FLOPS) THEN + DEALLOCATE(NB_SON,POOL_NIV2,POOL_NIV2_COST, NIV2) + END IF + IF((KEEP_LOAD(81).EQ.2).OR.(KEEP_LOAD(81).EQ.3))THEN + DEALLOCATE(CB_COST_MEM) + DEALLOCATE(CB_COST_ID) + ENDIF + NULLIFY(ND_LOAD) + NULLIFY(KEEP_LOAD) + NULLIFY(KEEP8_LOAD) + NULLIFY(FILS_LOAD) + NULLIFY(FRERE_LOAD) + NULLIFY(PROCNODE_LOAD) + NULLIFY(STEP_LOAD) + NULLIFY(NE_LOAD) + NULLIFY(CAND_LOAD) + NULLIFY(STEP_TO_NIV2_LOAD) + NULLIFY(DAD_LOAD) + IF (BDC_SBTR.OR.BDC_POOL_MNG) THEN + DEALLOCATE(MEM_SUBTREE) + DEALLOCATE(SBTR_PEAK_ARRAY) + DEALLOCATE(SBTR_CUR_ARRAY) + ENDIF + CALL CMUMPS_58( IERR ) + CALL CMUMPS_150( MYID, COMM_LD, + & BUF_LOAD_RECV, LBUF_LOAD_RECV, + & LBUF_LOAD_RECV_BYTES ) + DEALLOCATE(BUF_LOAD_RECV) + END SUBROUTINE CMUMPS_183 +#if defined (LAMPORT_) + RECURSIVE SUBROUTINE CMUMPS_467(COMM, KEEP) +#else + SUBROUTINE CMUMPS_467(COMM, KEEP) +#endif + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, MSGTAG, MSGLEN, MSGSOU,COMM + INTEGER KEEP(500) + INTEGER STATUS(MPI_STATUS_SIZE) + LOGICAL FLAG + 10 CONTINUE + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + IF (FLAG) THEN + KEEP(65)=KEEP(65)+1 + MSGTAG = STATUS( MPI_TAG ) + MSGSOU = STATUS( MPI_SOURCE ) + IF ( MSGTAG .NE. UPDATE_LOAD) THEN + write(*,*) "Internal error 1 in CMUMPS_467", + & MSGTAG + CALL MUMPS_ABORT() + ENDIF + CALL MPI_GET_COUNT(STATUS, MPI_PACKED, MSGLEN, IERR) + IF ( MSGLEN > LBUF_LOAD_RECV_BYTES ) THEN + write(*,*) "Internal error 2 in CMUMPS_467", + & MSGLEN, LBUF_LOAD_RECV_BYTES + CALL MUMPS_ABORT() + ENDIF + CALL MPI_RECV( BUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES, + & MPI_PACKED, MSGSOU, MSGTAG, COMM_LD, STATUS, IERR) + CALL CMUMPS_187( MSGSOU, BUF_LOAD_RECV, + & LBUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES ) + GOTO 10 + ENDIF + RETURN + END SUBROUTINE CMUMPS_467 + RECURSIVE SUBROUTINE CMUMPS_187 + & ( MSGSOU, BUFR, LBUFR, LBUFR_BYTES ) + IMPLICIT NONE + INTEGER MSGSOU, LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INCLUDE 'mpif.h' + INTEGER POSITION, IERR, WHAT, NSLAVES, i + DOUBLE PRECISION LOAD_RECEIVED + INTEGER INODE_RECEIVED,NCB_RECEIVED + DOUBLE PRECISION SURF + INTEGER, POINTER, DIMENSION (:) :: LIST_SLAVES + DOUBLE PRECISION, POINTER, DIMENSION (:) :: LOAD_INCR + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WHAT, 1, MPI_INTEGER, + & COMM_LD, IERR ) + IF ( WHAT == 0 ) THEN +#if ! defined(OLD_LOAD_MECHANISM) +#else +#endif + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) +#if ! defined(OLD_LOAD_MECHANISM) + LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED +#else + LOAD_FLOPS( MSGSOU ) = LOAD_RECEIVED +#endif + IF ( BDC_MEM ) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) +#if ! defined(OLD_LOAD_MECHANISM) + DM_MEM(MSGSOU) = DM_MEM(MSGSOU) + LOAD_RECEIVED +#else + DM_MEM(MSGSOU) = LOAD_RECEIVED +#endif + MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MSGSOU)) + END IF + IF(BDC_SBTR)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + SBTR_CUR(MSGSOU)=LOAD_RECEIVED + ENDIF + IF(BDC_MD)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(KEEP_LOAD(201).EQ.0)THEN + LU_USAGE(MSGSOU)=LOAD_RECEIVED + ENDIF + ENDIF + ELSEIF (( WHAT == 1).OR.(WHAT.EQ.19)) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSLAVES, 1, MPI_INTEGER, + & COMM_LD, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, MPI_INTEGER, + & COMM_LD, IERR ) + LIST_SLAVES => IDWLOAD + LOAD_INCR => WLOAD + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LIST_SLAVES(1), NSLAVES, MPI_INTEGER, + & COMM_LD, IERR) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + WRITE(*,*)MYID,':Receiving M2A from',MSGSOU + i=1 + DO WHILE ((i.LE.NSLAVES).AND.(LIST_SLAVES(i).NE.MYID)) + i=i+1 + ENDDO + IF(i.LT.(NSLAVES+1))THEN + NB_LEVEL2=NB_LEVEL2+1 + WRITE(*,*)MYID,':NB_LEVEL2=',NB_LEVEL2 + AMI_CHOSEN=.TRUE. + IF(KEEP_LOAD(73).EQ.1)THEN + IF(.NOT.IS_DISPLAYED)THEN + WRITE(*,*)MYID,': Begin of Incoherent state (2) at time=', + & MPI_WTIME()-TIME_REF + IS_DISPLAYED=.TRUE. + ENDIF + ENDIF + ENDIF + IF(KEEP_LOAD(73).EQ.1) GOTO 344 +#endif +#endif + DO i = 1, NSLAVES +#if defined(OLD_LOAD_MECHANISM) + IF ( LIST_SLAVES(i) /= MYID ) THEN +#endif + LOAD_FLOPS(LIST_SLAVES(i)) = + & LOAD_FLOPS(LIST_SLAVES(i)) + + & LOAD_INCR(i) +#if defined(OLD_LOAD_MECHANISM) + END IF +#endif + END DO + IF ( BDC_MEM ) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) + DO i = 1, NSLAVES +#if defined(OLD_LOAD_MECHANISM) + IF ( LIST_SLAVES(i) /= MYID ) THEN +#endif + DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i)) + + & LOAD_INCR(i) + MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(LIST_SLAVES(i))) +#if defined(OLD_LOAD_MECHANISM) + END IF +#endif + END DO + END IF + IF(WHAT.EQ.19)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) + CALL CMUMPS_819(INODE_RECEIVED) + CB_COST_ID(POS_ID)=INODE_RECEIVED + CB_COST_ID(POS_ID+1)=NSLAVES + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + DO i=1,NSLAVES + WRITE(*,*)MYID,':',LIST_SLAVES(i),'->',LOAD_INCR(i) + CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(LOAD_INCR(i),8) + POS_MEM=POS_MEM+1 + ENDDO + ENDIF +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + 344 CONTINUE +#endif +#endif + NULLIFY( LIST_SLAVES ) + NULLIFY( LOAD_INCR ) + ELSE IF (WHAT == 2 ) THEN + IF ( .not. BDC_POOL ) THEN + WRITE(*,*) "Internal error 2 in CMUMPS_187" + CALL MUMPS_ABORT() + END IF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + POOL_MEM(MSGSOU)=LOAD_RECEIVED + ELSE IF ( WHAT == 3 ) THEN + IF ( .NOT. BDC_SBTR) THEN + WRITE(*,*) "Internal error 3 in CMUMPS_187" + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + SBTR_MEM(MSGSOU)=SBTR_MEM(MSGSOU)+LOAD_RECEIVED +#if ! defined(OLD_LOAD_MECHANISM) + ELSE IF (WHAT == 4) THEN + FUTURE_NIV2(MSGSOU+1)=0 + IF(BDC_MD)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & SURF, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + MD_MEM(MSGSOU)=999999999_8 + TAB_MAXS(MSGSOU)=TAB_MAXS(MSGSOU)+int(SURF,8) + ENDIF +#endif + IF(BDC_M2_MEM.OR.BDC_M2_FLOPS)THEN + ENDIF + ELSE IF (WHAT == 5) THEN + IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN + WRITE(*,*) "Internal error 7 in CMUMPS_187" + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, + & MPI_INTEGER, + & COMM_LD, IERR ) + IF(BDC_M2_MEM) THEN + CALL CMUMPS_816(INODE_RECEIVED) + ELSEIF(BDC_M2_FLOPS) THEN + CALL CMUMPS_817(INODE_RECEIVED) + ENDIF + IF((KEEP_LOAD(81).EQ.2).OR.(KEEP_LOAD(81).EQ.3))THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, + & MPI_INTEGER, + & COMM_LD, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NCB_RECEIVED, 1, + & MPI_INTEGER, + & COMM_LD, IERR ) + IF( + & MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE_RECEIVED)), + & NPROCS).EQ.1 + & )THEN + CB_COST_ID(POS_ID)=INODE_RECEIVED + CB_COST_ID(POS_ID+1)=1 + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + CB_COST_MEM(POS_MEM)=int(MSGSOU,8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(NCB_RECEIVED,8)* + & int(NCB_RECEIVED,8) + POS_MEM=POS_MEM+1 + ENDIF + ENDIF + ELSE IF ( WHAT == 6 ) THEN + IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN + WRITE(*,*) "Internal error 8 in CMUMPS_187" + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(BDC_M2_MEM) THEN + NIV2(MSGSOU+1) = LOAD_RECEIVED + ELSEIF(BDC_M2_FLOPS) THEN + NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED + IF(NIV2(MSGSOU+1).LT.0.0D0)THEN + IF(abs(NIV2(MSGSOU+1)).LE. + & sqrt(epsilon(LOAD_RECEIVED)))THEN + NIV2(MSGSOU+1)=0.0D0 + ELSE + WRITE(*,*)'problem with NIV2_FLOPS message', + & NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + ELSEIF(WHAT == 17)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(BDC_M2_MEM) THEN + NIV2(MSGSOU+1) = LOAD_RECEIVED + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(BDC_MD)THEN +#if ! defined(OLD_LOAD_MECHANISM) + DM_MEM(MYID)=DM_MEM(MYID)+LOAD_RECEIVED +#else + DM_MEM(MYID)=LOAD_RECEIVED +#endif + ELSEIF(BDC_POOL)THEN + POOL_MEM(MSGSOU)=LOAD_RECEIVED + ENDIF + ELSEIF(BDC_M2_FLOPS) THEN + NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED + IF(NIV2(MSGSOU+1).LT.0.0D0)THEN + WRITE(*,*)'problem with NIV2_FLOPS message', + & NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) +#if ! defined(OLD_LOAD_MECHANISM) + LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED +#else + LOAD_FLOPS( MSGSOU ) = LOAD_RECEIVED +#endif + ENDIF + ELSEIF ( WHAT == 7 ) THEN + IF(.NOT.BDC_MD)THEN + WRITE(*,*)MYID,': Internal error 4 + &in CMUMPS_187' + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSLAVES, 1, MPI_INTEGER, + & COMM_LD, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, MPI_INTEGER, + & COMM_LD, IERR ) + LIST_SLAVES => IDWLOAD + LOAD_INCR => WLOAD + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LIST_SLAVES(1), NSLAVES, MPI_INTEGER, + & COMM_LD, IERR) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) + DO i = 1, NSLAVES +#if defined(OLD_LOAD_MECHANISM) + IF ( LIST_SLAVES(i) /= MYID ) THEN +#endif + MD_MEM(LIST_SLAVES(i)) = + & MD_MEM(LIST_SLAVES(i)) + + & int(LOAD_INCR(i),8) +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(LIST_SLAVES(i)+1).EQ.0)THEN + MD_MEM(LIST_SLAVES(i))=999999999_8 + ENDIF +#endif +#if defined(OLD_LOAD_MECHANISM) + END IF +#endif + END DO + ELSEIF ( WHAT == 8 ) THEN + IF(.NOT.BDC_MD)THEN + WRITE(*,*)MYID,': Internal error 5 + &in CMUMPS_187' + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + MD_MEM(MSGSOU)=MD_MEM(MSGSOU)+int(LOAD_RECEIVED,8) +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(MSGSOU+1).EQ.0)THEN + MD_MEM(MSGSOU)=999999999_8 + ENDIF +#endif + ELSEIF ( WHAT == 9 ) THEN + IF(.NOT.BDC_MD)THEN + WRITE(*,*)MYID,': Internal error 6 + &in CMUMPS_187' + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + TAB_MAXS(MSGSOU)=int(LOAD_RECEIVED,8) + ELSE + WRITE(*,*) "Internal error 1 in CMUMPS_187" + CALL MUMPS_ABORT() + END IF + RETURN + END SUBROUTINE CMUMPS_187 + integer function CMUMPS_409 + & (MEM_DISTRIB,CAND, + & K69, + & SLAVEF,MSG_SIZE, + & NMB_OF_CAND ) + implicit none + integer, intent(in) :: K69, SLAVEF + INTEGER, intent(in) :: CAND(SLAVEF+1) + INTEGER, DIMENSION(0:NPROCS - 1), intent(in) :: MEM_DISTRIB + INTEGER, intent(out) :: NMB_OF_CAND + integer i,nless + DOUBLE PRECISION lref + DOUBLE PRECISION MSG_SIZE + nless = 0 + NMB_OF_CAND=CAND(SLAVEF+1) + do i=1,NMB_OF_CAND + WLOAD(i)=LOAD_FLOPS(CAND(i)) + IF(BDC_M2_FLOPS)THEN + WLOAD(i)=WLOAD(i)+NIV2(CAND(i)+1) + ENDIF + end do + IF(K69 .gt. 1) THEN + CALL CMUMPS_426(MEM_DISTRIB,MSG_SIZE, + & CAND,NMB_OF_CAND) + ENDIF + lref = LOAD_FLOPS(MYID) + do i=1, NMB_OF_CAND + if (WLOAD(i).lt.lref) nless=nless+1 + end do + CMUMPS_409 = nless + return + end function CMUMPS_409 + subroutine CMUMPS_384 + & (MEM_DISTRIB,CAND, + & + & SLAVEF, + & nslaves_inode, DEST) + implicit none + integer, intent(in) :: nslaves_inode, SLAVEF + integer, intent(in) :: CAND(SLAVEF+1) + integer, dimension(0:NPROCS - 1), intent(in) :: MEM_DISTRIB + integer, intent(out) :: DEST(CAND(SLAVEF+1)) + integer i,j,NMB_OF_CAND + external MUMPS_558 + NMB_OF_CAND = CAND(SLAVEF+1) + if(nslaves_inode.ge.NPROCS .or. + & nslaves_inode.gt.NMB_OF_CAND) then + write(*,*)'Internal error in CMUMPS_384', + & nslaves_inode, NPROCS, NMB_OF_CAND + CALL MUMPS_ABORT() + end if + if (nslaves_inode.eq.NPROCS-1) then + j=MYID+1 + do i=1,nslaves_inode + if(j.ge.NPROCS) j=0 + DEST(i)=j + j=j+1 + end do + else + do i=1,NMB_OF_CAND + IDWLOAD(i)=i + end do + call MUMPS_558(NMB_OF_CAND, + & WLOAD(1),IDWLOAD(1) ) + do i=1,nslaves_inode + DEST(i)= CAND(IDWLOAD(i)) + end do + IF(BDC_MD)THEN + do i=nslaves_inode+1,NMB_OF_CAND + DEST(i)= CAND(IDWLOAD(i)) + end do + ENDIF + end if + return + end subroutine CMUMPS_384 + SUBROUTINE CMUMPS_425(K69) + IMPLICIT NONE + INTEGER K69 + IF (K69 .LE. 4) THEN + ALPHA = 0.0d0 + BETA = 0.0d0 + RETURN + ENDIF + IF (K69 .EQ. 5) THEN + ALPHA = 0.5d0 + BETA = 50000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 6) THEN + ALPHA = 0.5d0 + BETA = 100000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 7) THEN + ALPHA = 0.5d0 + BETA = 150000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 8) THEN + ALPHA = 1.0d0 + BETA = 50000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 9) THEN + ALPHA = 1.0d0 + BETA = 100000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 10) THEN + ALPHA = 1.0d0 + BETA = 150000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 11) THEN + ALPHA = 1.5d0 + BETA = 50000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 12) THEN + ALPHA = 1.5d0 + BETA = 100000.0d0 + RETURN + ENDIF + ALPHA = 1.5d0 + BETA = 150000.0d0 + RETURN + END SUBROUTINE CMUMPS_425 + SUBROUTINE CMUMPS_426(MEM_DISTRIB,MSG_SIZE,ARRAY_ADM,LEN) + IMPLICIT NONE + INTEGER i,LEN + INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB + DOUBLE PRECISION MSG_SIZE,FORBIGMSG + INTEGER ARRAY_ADM(LEN) + DOUBLE PRECISION MY_LOAD + FORBIGMSG = 1.0d0 + IF (K69 .lt.2) THEN + RETURN + ENDIF + IF(BDC_M2_FLOPS)THEN + MY_LOAD=LOAD_FLOPS(MYID)+NIV2(MYID+1) + ELSE + MY_LOAD=LOAD_FLOPS(MYID) + ENDIF + IF((MSG_SIZE * dble(K35) ) .gt. 3200000.0d0) THEN + FORBIGMSG = 2.0d0 + ENDIF + IF (K69 .le. 4) THEN + DO i = 1,LEN + IF ((MEM_DISTRIB(ARRAY_ADM(i)) .EQ. 1) .AND. + & WLOAD(i) .LT. MY_LOAD ) THEN + WLOAD(i) = WLOAD(i)/MY_LOAD + ELSE + IF ( MEM_DISTRIB(ARRAY_ADM(i)) .NE. 1 ) THEN + WLOAD(i) = WLOAD(i) * + & dble(MEM_DISTRIB(ARRAY_ADM(i))) + & * FORBIGMSG + & + dble(2) + ENDIF + ENDIF + ENDDO + RETURN + ENDIF + DO i = 1,LEN + IF ((MEM_DISTRIB(ARRAY_ADM(i)) .EQ. 1) .AND. + & WLOAD(i) .LT. MY_LOAD ) THEN + WLOAD(i) = WLOAD(i) / MY_LOAD + ELSE + IF(MEM_DISTRIB(ARRAY_ADM(i)) .NE. 1) THEN + WLOAD(i) = (WLOAD(i) + + & ALPHA * MSG_SIZE * dble(K35) + + & BETA) * FORBIGMSG + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_426 + SUBROUTINE CMUMPS_461(MYID, SLAVEF, COMM, + & TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, NSLAVES,INODE) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER, INTENT (IN) :: MYID, SLAVEF, COMM, NASS, NSLAVES + INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2) + INTEGER, INTENT (IN) :: LIST_SLAVES( NSLAVES ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NCB, NFRONT, NBROWS_SLAVE + INTEGER i, IERR,WHAT,INODE + DOUBLE PRECISION MEM_INCREMENT ( NSLAVES ) + DOUBLE PRECISION FLOPS_INCREMENT( NSLAVES ) + DOUBLE PRECISION CB_BAND( NSLAVES ) + IF((KEEP(81).NE.2).AND.(KEEP(81).NE.3))THEN + WHAT=1 + ELSE + WHAT=19 + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + FUTURE_NIV2(MYID+1) = FUTURE_NIV2(MYID+1) - 1 + IF ( FUTURE_NIV2(MYID+1) < 0 ) THEN + WRITE(*,*) "Internal error in CMUMPS_461" + CALL MUMPS_ABORT() + ENDIF + IF ( FUTURE_NIV2(MYID + 1) == 0 ) THEN + 112 CONTINUE + CALL CMUMPS_502(COMM,MYID,SLAVEF, + & dble(MAX_SURF_MASTER),IERR) + IF (IERR == -1 ) THEN + CALL CMUMPS_467(COMM_LD, KEEP) + GOTO 112 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in CMUMPS_461", + & IERR + CALL MUMPS_ABORT() + ENDIF + TAB_MAXS(MYID) = TAB_MAXS(MYID) + int(MAX_SURF_MASTER,8) + ENDIF +#endif + IF ( NSLAVES /= TAB_POS(SLAVEF + 2) ) THEN + write(*,*) "Error 1 in CMUMPS_461", + & NSLAVES, TAB_POS(SLAVEF+2) + CALL MUMPS_ABORT() + ENDIF + NCB = TAB_POS(NSLAVES+1) - 1 + NFRONT = NCB + NASS + DO i = 1, NSLAVES + NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i) + IF ( KEEP(50) == 0 ) THEN + FLOPS_INCREMENT( i ) = (dble(NBROWS_SLAVE)*dble( NASS ))+ + & dble(NBROWS_SLAVE) * dble(NASS) * + & dble(2*NFRONT-NASS-1) + ELSE + FLOPS_INCREMENT( i ) = dble(NBROWS_SLAVE) * dble(NASS ) * + & dble( 2 * ( NASS + TAB_POS(i+1) - 1 ) + & - NBROWS_SLAVE - NASS + 1 ) + ENDIF + IF ( BDC_MEM ) THEN + IF ( KEEP(50) == 0 ) THEN + MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) * + & dble(NFRONT) + ELSE + MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) * + & dble( NASS + TAB_POS(i+1) - 1 ) + END IF + ENDIF + IF((KEEP(81).NE.2).AND.(KEEP(81).NE.3))THEN + CB_BAND(i)=dble(-999999) + ELSE + IF ( KEEP(50) == 0 ) THEN + CB_BAND( i ) = dble(NBROWS_SLAVE) * + & dble(NFRONT-NASS) + ELSE + CB_BAND( i ) = dble(NBROWS_SLAVE) * + & dble(TAB_POS(i+1)-1) + END IF + ENDIF + END DO + IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN + CB_COST_ID(POS_ID)=INODE + CB_COST_ID(POS_ID+1)=NSLAVES + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + DO i=1,NSLAVES + CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(CB_BAND(i),8) + POS_MEM=POS_MEM+1 + ENDDO + ENDIF + 111 CONTINUE + CALL CMUMPS_524(BDC_MEM, COMM, MYID, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & NSLAVES, LIST_SLAVES,INODE, + & MEM_INCREMENT, + & FLOPS_INCREMENT,CB_BAND, WHAT,IERR) + IF ( IERR == -1 ) THEN + CALL CMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in CMUMPS_461", + & IERR + CALL MUMPS_ABORT() + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (FUTURE_NIV2(MYID+1) .NE. 0) THEN +#endif + DO i = 1, NSLAVES + LOAD_FLOPS(LIST_SLAVES(i)) = LOAD_FLOPS(LIST_SLAVES(i)) + & + FLOPS_INCREMENT(i) + IF ( BDC_MEM ) THEN + DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i)) + & + MEM_INCREMENT(i) + END IF + ENDDO +#if ! defined(OLD_LOAD_MECHANISM) + ENDIF +#endif + RETURN + END SUBROUTINE CMUMPS_461 + SUBROUTINE CMUMPS_500( + & POOL, LPOOL, + & PROCNODE, KEEP,KEEP8, SLAVEF, COMM, MYID, STEP, N, + & ND, FILS ) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER LPOOL, SLAVEF, COMM, MYID + INTEGER N, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER POOL( LPOOL ), PROCNODE( KEEP(28) ), STEP( N ) + INTEGER ND( KEEP(28) ), FILS( N ) + INTEGER i, INODE, NELIM, NFR, LEVEL, IERR, WHAT + DOUBLE PRECISION COST + INTEGER NBINSUBTREE,NBTOP,INSUBTREE + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + IF(BDC_MD)THEN + RETURN + ENDIF + IF((KEEP(76).EQ.0).OR.(KEEP(76).EQ.2))THEN + IF(NBTOP.NE.0)THEN + DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3) + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ELSE + DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1 + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ENDIF + ELSE + IF(KEEP(76).EQ.1)THEN + IF(INSUBTREE.EQ.1)THEN + DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1 + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ELSE + DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3) + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ENDIF + ELSE + WRITE(*,*) + & 'Internal error: Unknown pool management strategy' + CALL MUMPS_ABORT() + ENDIF + ENDIF + 20 CONTINUE + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS(i) + GOTO 10 + ENDIF + NFR = ND( STEP(INODE) ) + LEVEL = MUMPS_330( PROCNODE(STEP(INODE)), SLAVEF ) + IF (LEVEL .EQ. 1) THEN + COST = dble( NFR ) * dble( NFR ) + ELSE + IF ( KEEP(50) == 0 ) THEN + COST = dble( NFR ) * dble( NELIM ) + ELSE + COST = dble( NELIM ) * dble( NELIM ) + ENDIF + ENDIF + 30 CONTINUE + IF ( abs(POOL_LAST_COST_SENT-COST).GT.DM_THRES_MEM ) THEN + WHAT = 2 + 111 CONTINUE + CALL CMUMPS_460( WHAT, + & COMM, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & COST, dble(0),MYID, IERR ) + POOL_LAST_COST_SENT = COST + POOL_MEM(MYID)=COST + IF ( IERR == -1 )THEN + CALL CMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in CMUMPS_500", + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_500 + SUBROUTINE CMUMPS_501( + & OK,INODE,POOL,LPOOL,MYID,SLAVEF,COMM,KEEP,KEEP8) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER LPOOL,MYID,SLAVEF,COMM,INODE + INTEGER POOL(LPOOL),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER WHAT,IERR + LOGICAL OK + DOUBLE PRECISION COST + LOGICAL FLAG + EXTERNAL MUMPS_283,MUMPS_170 + LOGICAL MUMPS_283,MUMPS_170 + IF((INODE.LE.0).OR.(INODE.GT.N_LOAD)) THEN + RETURN + ENDIF + IF (.NOT.MUMPS_170( + & PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS) + & ) THEN + RETURN + ENDIF + IF(MUMPS_283(PROCNODE_LOAD(STEP_LOAD(INODE)),NPROCS))THEN + IF(NE_LOAD(STEP_LOAD(INODE)).EQ.0)THEN + RETURN + ENDIF + ENDIF + FLAG=.FALSE. + IF(INDICE_SBTR.LE.NB_SUBTREES)THEN + IF(INODE.EQ.MY_FIRST_LEAF(INDICE_SBTR))THEN + FLAG=.TRUE. + ENDIF + ENDIF + IF(FLAG)THEN + SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY)=MEM_SUBTREE(INDICE_SBTR) + SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY)=SBTR_CUR(MYID) + INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY+1 + WHAT = 3 + IF(dble(MEM_SUBTREE(INDICE_SBTR)).GE.DM_THRES_MEM)THEN + 111 CONTINUE + CALL CMUMPS_460( + & WHAT, COMM, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & dble(MEM_SUBTREE(INDICE_SBTR)), dble(0),MYID, IERR ) + IF ( IERR == -1 )THEN + CALL CMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) + & "Internal Error 1 in CMUMPS_501", + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + SBTR_MEM(MYID)=SBTR_MEM(MYID)+ + & dble(MEM_SUBTREE(INDICE_SBTR)) + INDICE_SBTR=INDICE_SBTR+1 + IF(INSIDE_SUBTREE.EQ.0)THEN + INSIDE_SUBTREE=1 + ENDIF + ELSE + IF(INODE.EQ.MY_ROOT_SBTR(INDICE_SBTR-1))THEN + WHAT = 3 + COST=-SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY-1) + IF(abs(COST).GE.DM_THRES_MEM)THEN + 112 CONTINUE + CALL CMUMPS_460( + & WHAT, COMM, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & COST, dble(0) ,MYID,IERR ) + IF ( IERR == -1 )THEN + CALL CMUMPS_467(COMM_LD, KEEP) + GOTO 112 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) + & "Internal Error 3 in CMUMPS_501", + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY-1 + SBTR_MEM(MYID)=SBTR_MEM(MYID)- + & SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY) + SBTR_CUR(MYID)=SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY) + IF(INDICE_SBTR_ARRAY.EQ.1)THEN + SBTR_CUR(MYID)=dble(0) + INSIDE_SUBTREE=0 + ENDIF + ENDIF + ENDIF + CONTINUE + END SUBROUTINE CMUMPS_501 + SUBROUTINE CMUMPS_504 + & (SLAVEF,KEEP,KEEP8,PROCS,MEM_DISTRIB,NCB,NFRONT, + & NSLAVES_NODE,TAB_POS, + & SLAVES_LIST,SIZE_SLAVES_LIST,MYID) + IMPLICIT NONE + INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST + INTEGER(8) KEEP8(150) + INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID + INTEGER, intent(in) :: PROCS(SLAVEF+1) + INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1) + INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST) + INTEGER, intent(out):: TAB_POS(SLAVEF+2) + INTEGER, intent(out):: NSLAVES_NODE + INTEGER NUMBER_OF_PROCS,K47, K48, K50 + INTEGER(8) :: K821 + DOUBLE PRECISION DK821 + INTEGER J + INTEGER KMIN, KMAX + INTEGER OTHERS,CHOSEN,SMALL_SET,ACC + DOUBLE PRECISION SOMME,TMP_SUM + INTEGER AFFECTED + INTEGER ADDITIONNAL_ROWS,i,X,REF,POS + INTEGER(8)::TOTAL_MEM + LOGICAL FORCE_CAND + DOUBLE PRECISION TEMP(SLAVEF),PEAK + INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF) + EXTERNAL MPI_WTIME + DOUBLE PRECISION MPI_WTIME + IF (KEEP8(21) .GT. 0_8) THEN + write(*,*)MYID, + & ": Internal Error 1 in CMUMPS_504" + CALL MUMPS_ABORT() + ENDIF + K821=abs(KEEP8(21)) + DK821=dble(K821) + K50=KEEP(50) + K48=KEEP(48) + K47=KEEP(47) + IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN + FORCE_CAND = .FALSE. + ELSE + FORCE_CAND = (mod(KEEP(24),2).eq.0) + END IF + IF(K48.NE.4)THEN + WRITE(*,*)'CMUMPS_COMPUTE_PARTI_ACTV_MEM_K821 + & should be called with KEEP(48) different from 4' + CALL MUMPS_ABORT() + ENDIF + KMIN=1 + KMAX=int(K821/int(NFRONT,8)) + IF(FORCE_CAND)THEN + DO i=1,PROCS(SLAVEF+1) + WLOAD(i)=DM_MEM(PROCS(i)) + IDWLOAD(i)=PROCS(i) + ENDDO + NUMBER_OF_PROCS=PROCS(SLAVEF+1) + OTHERS=NUMBER_OF_PROCS + ELSE + NUMBER_OF_PROCS=SLAVEF + WLOAD(1:SLAVEF) = DM_MEM(0:NUMBER_OF_PROCS-1) + DO i=1,NUMBER_OF_PROCS + IDWLOAD(i) = i - 1 + ENDDO + OTHERS=NUMBER_OF_PROCS-1 + ENDIF + NB_ROWS=0 + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, IDWLOAD) + TOTAL_MEM=int(NCB,8)*int(NFRONT,8) + SOMME=dble(0) + J=1 + PEAK=dble(0) + DO i=1,NUMBER_OF_PROCS + IF((IDWLOAD(i).NE.MYID))THEN + PEAK=max(PEAK,WLOAD(i)) + TEMP_ID(J)=IDWLOAD(i) + TEMP(J)=WLOAD(i) + IF(BDC_SBTR)THEN + TEMP(J)=TEMP(J)+SBTR_MEM(IDWLOAD(i))- + & SBTR_CUR(IDWLOAD(i)) + ENDIF + IF(BDC_POOL)THEN + TEMP(J)=TEMP(J)+POOL_MEM(TEMP_ID(J)) + ENDIF + IF(BDC_M2_MEM)THEN + TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1) + ENDIF + J=J+1 + ENDIF + ENDDO + NUMBER_OF_PROCS=J-1 + CALL MUMPS_558(NUMBER_OF_PROCS, TEMP, TEMP_ID) + IF(K50.EQ.0)THEN + PEAK=max(PEAK, + & DM_MEM(MYID)+dble(NFRONT)*dble(NFRONT-NCB)) + ELSE + PEAK=max(PEAK, + & DM_MEM(MYID)+dble(NFRONT-NCB)*dble(NFRONT-NCB)) + ENDIF + PEAK=max(PEAK,TEMP(OTHERS)) + SOMME=dble(0) + DO i=1,NUMBER_OF_PROCS + SOMME=SOMME+TEMP(OTHERS)-TEMP(i) + ENDDO + IF(SOMME.LE.dble(TOTAL_MEM)) THEN + GOTO 096 + ENDIF + 096 CONTINUE + SOMME=dble(0) + DO i=1,OTHERS + SOMME=SOMME+TEMP(OTHERS)-TEMP(i) + ENDDO + IF(dble(TOTAL_MEM).GE.SOMME) THEN +#if defined (OLD_PART) + 887 CONTINUE +#endif + AFFECTED=0 + CHOSEN=0 + ACC=0 + DO i=1,OTHERS + IF(K50.EQ.0)THEN + IF((TEMP(OTHERS)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(OTHERS)-TEMP(i) + ENDIF + X=int(TMP_SUM/dble(NFRONT)) + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + IF((TEMP(OTHERS)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(OTHERS)-TEMP(i) + ENDIF + X=int((-dble(NFRONT-NCB+ACC) + & +sqrt(((dble(NFRONT-NCB+ACC)* + & dble(NFRONT-NCB+ACC))+dble(4)* + & (TMP_SUM))))/ + & dble(2)) + IF((ACC+X).GT.NCB) X=NCB-ACC + IF(X.LE.0) THEN + WRITE(*,*)"Internal Error 2 in + & CMUMPS_504" + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_ROWS(i)=X + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB-ACC.LT.KMIN) GOTO 111 + IF(NCB.EQ.ACC) GOTO 111 + ENDDO + 111 CONTINUE + IF((ACC.GT.NCB))THEN + X=0 + DO i=1,OTHERS + X=X+NB_ROWS(i) + ENDDO + WRITE(*,*)'NCB=',NCB,',SOMME=',X + WRITE(*,*)MYID, + & ": Internal Error 3 in CMUMPS_504" + CALL MUMPS_ABORT() + ENDIF + IF((NCB.NE.ACC))THEN + IF(K50.NE.0)THEN + IF(CHOSEN.NE.0)THEN + ADDITIONNAL_ROWS=NCB-ACC + NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+ADDITIONNAL_ROWS + ELSE + TMP_SUM=dble(TOTAL_MEM)/dble(NUMBER_OF_PROCS) + CHOSEN=0 + ACC=0 + DO i=1,OTHERS + X=int((-dble(NFRONT-NCB+ACC) + & +sqrt(((dble(NFRONT-NCB+ACC)* + & dble(NFRONT-NCB+ACC))+dble(4)* + & (TMP_SUM))))/ + & dble(2)) + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB-ACC.LT.KMIN) GOTO 002 + IF(NCB.EQ.ACC) GOTO 002 + ENDDO + 002 CONTINUE + IF(ACC.LT.NCB)THEN + NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+(NCB-ACC) + ENDIF + ENDIF + GOTO 333 + ENDIF + ADDITIONNAL_ROWS=NCB-ACC + DO i=CHOSEN,1,-1 + IF(int(dble(ADDITIONNAL_ROWS)/ + & dble(i)).NE.0)THEN + GOTO 222 + ENDIF + ENDDO + 222 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(i)) + DO J=1,i + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDDO + IF(ADDITIONNAL_ROWS.NE.0) THEN + NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS + ENDIF + ENDIF + 333 CONTINUE + IF(NB_ROWS(CHOSEN).EQ.0) CHOSEN=CHOSEN-1 + GOTO 889 + ELSE + DO i=OTHERS,1,-1 + SOMME=dble(0) + DO J=1,i + SOMME=SOMME+TEMP(J) + ENDDO + SOMME=(dble(i)*TEMP(i))-SOMME + IF(dble(TOTAL_MEM).GE.SOMME) GOTO 444 + ENDDO + 444 CONTINUE + REF=i + DO J=1,i + IF(TEMP(J).EQ.TEMP(i)) THEN + SMALL_SET=J + GOTO 123 + ENDIF + ENDDO + 123 CONTINUE + IF(i.EQ.1)THEN + NB_ROWS(i)=NCB + CHOSEN=1 + GOTO 666 + ENDIF + 323 CONTINUE + AFFECTED=0 + CHOSEN=0 + ACC=0 + DO i=1,SMALL_SET + IF(K50.EQ.0)THEN + IF((TEMP(SMALL_SET)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(SMALL_SET)-TEMP(i) + ENDIF + X=int(TMP_SUM/dble(NFRONT)) + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + IF((TEMP(SMALL_SET)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(SMALL_SET)-TEMP(i) + ENDIF + X=int((-dble(NFRONT-NCB+ACC) + & +sqrt(((dble(NFRONT-NCB+ACC)* + & dble(NFRONT-NCB+ACC))+dble(4)* + & (TMP_SUM))))/ + & dble(2)) + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 4 in CMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + NB_ROWS(i)=X + ACC=ACC+X + CHOSEN=CHOSEN+1 + IF(NCB-ACC.LT.KMIN) GOTO 888 + IF(NCB.EQ.ACC) GOTO 888 + IF(ACC.GT.NCB) THEN + WRITE(*,*)MYID, + & ': Internal error 5 in CMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ENDDO + 888 CONTINUE + SOMME=dble(0) + X=NFRONT-NCB + IF((ACC.GT.NCB))THEN + WRITE(*,*)MYID, + & ':Internal error 6 in CMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF((ACC.LT.NCB))THEN + IF(K50.NE.0)THEN + IF(SMALL_SET.LT.OTHERS)THEN + SMALL_SET=REF+1 + REF=SMALL_SET + GOTO 323 + ELSE + NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+NCB-ACC + GOTO 666 + ENDIF + ENDIF + ADDITIONNAL_ROWS=NCB-ACC +#if ! defined (OLD_PART) + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + J=1 +#if ! defined (PART1_) + X=int(ADDITIONNAL_ROWS/(i-1)) + IF((X.EQ.0).AND.(ADDITIONNAL_ROWS.NE.0))THEN + DO WHILE ((J.LT.i).AND.(ADDITIONNAL_ROWS.GT.0)) + NB_ROWS(J)=NB_ROWS(J)+1 + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 + J=J+1 + ENDDO + IF(ADDITIONNAL_ROWS.NE.0)THEN + WRITE(*,*)MYID, + & ':Internal error 7 in CMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + GOTO 047 + ENDIF + IF((TEMP(1)+dble((NB_ROWS(1)+X)*NFRONT)).LE. + & TEMP(i))THEN + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + AFFECTED=X + IF((AFFECTED+NB_ROWS(J)).GT. + & KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & AFFECTED + J=J+1 + ENDDO + ELSE +#endif + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LE.i)) + AFFECTED=int((TEMP(i)-(TEMP(J)+ + & (dble(NB_ROWS(J))*dble(NFRONT)))) + & /dble(NFRONT)) + IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + ENDIF + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + J=J+1 + ENDDO +#if ! defined (PART1_) + ENDIF +#endif + i=i+1 + ENDDO + 047 CONTINUE + IF((ADDITIONNAL_ROWS.EQ.0).AND. + & (i.LT.NUMBER_OF_PROCS))THEN + CHOSEN=i-1 + ELSE + CHOSEN=i-2 + ENDIF +#if ! defined (PART1_) + IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. + & (ADDITIONNAL_ROWS.NE.0))THEN + DO i=1,CHOSEN + NB_ROWS(i)=NB_ROWS(i)+1 + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 048 + ENDDO + 048 CONTINUE + ENDIF +#endif + IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. + & (ADDITIONNAL_ROWS.NE.0))THEN + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LE.i)) + AFFECTED=int((TEMP(i)-(TEMP(J)+ + & (dble(NB_ROWS(J))* + & dble(NFRONT))))/dble(NFRONT)) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + J=J+1 + ENDDO + i=i+1 + ENDDO + CHOSEN=i-2 + ENDIF + CONTINUE +#else + DO i=CHOSEN,1,-1 + IF(int(dble(ADDITIONNAL_ROWS)/ + & dble(i)).NE.0)THEN + GOTO 555 + ENDIF + ENDDO + 555 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(i)) + DO J=1,i + IF(NB_ROWS(J)+X.GT.K821/NCB)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & ((K821/NCB)-NB_ROWS(J)) + NB_ROWS(J)=(K821/NFRONT) + ELSE IF ((TEMP(J)+dble((NB_ROWS(J)+X))* + & dble(NFRONT)).GT. + & PEAK)THEN + AFFECTED=int((PEAK-(TEMP(J)+dble(NB_ROWS(J))* + & dble(NFRONT))/dble(NFRONT)) + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ELSE + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDIF + IF(((TEMP(J)+dble(NB_ROWS(J))*dble(NFRONT)) + & .GT. PEAK) + & .AND.(SMALL_SET.LT.OTHERS))THEN + WRITE(*,*)MYID, + & ':Internal error 8 in CMUMPS_504' + SMALL_SET=SMALL_SET+1 + CALL MUMPS_ABORT() + ENDIF + ENDDO + SOMME=dble(0) + DO J=1,CHOSEN + SOMME=SOMME+NB_ROWS(J) + ENDDO + IF(ADDITIONNAL_ROWS.NE.0) THEN + DO J=1,CHOSEN + IF(NB_ROWS(J).LT.0)THEN + WRITE(*,*)MYID, + & ':Internal error 9 in CMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF ((TEMP(J)+dble(NB_ROWS(J)) + & *dble(NFRONT)).GT. + & PEAK)THEN + WRITE(*,*)MYID, + & ':Internal error 10 in CMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF ((TEMP(J)+dble(NB_ROWS(J)+ + & ADDITIONNAL_ROWS)*dble(NFRONT)).GE. + & PEAK)THEN + AFFECTED=int((PEAK-(TEMP(J)+ + & dble(NB_ROWS(J))* + & dble(NFRONT))/dble(NFRONT)) + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + IF((TEMP(J)+dble(NFRONT)* + & dble(NB_ROWS(J))).GT. + & PEAK)THEN + WRITE(*,*)MYID, + & ':Internal error 11 in CMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ELSE + NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 666 + ENDDO + IF(SMALL_SET.EQ.(NUMBER_OF_PROCS)) THEN + NB_ROWS=0 + GOTO 887 + ENDIF + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF(NB_ROWS(i)+ADDITIONNAL_ROWS.LT.K821/NFRONT) + & THEN + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-(K821/ + & NFRONT + & -NB_ROWS(i)) + NB_ROWS(i)=K821/NFRONT + ENDIF + i=i+1 + ENDDO + CHOSEN=i-1 + IF(ADDITIONNAL_ROWS.NE.0)THEN + DO i=CHOSEN,1,-1 + IF(int(dble(ADDITIONNAL_ROWS)/dble(i)) + & .NE.0)THEN + GOTO 372 + ENDIF + ENDDO + 372 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(i)) + DO J=1,i + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDDO + IF(ADDITIONNAL_ROWS.NE.0) THEN + NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS + ENDIF + ENDIF + ENDIF +#endif + ENDIF + 666 CONTINUE + SOMME=dble(0) + X=0 + POS=0 + DO i=1,CHOSEN + IF(K50.NE.0) THEN + IF((TEMP(i)+dble(NB_ROWS(i)) + & *dble(X+NB_ROWS(i)+NFRONT-NCB)) + & .GT.PEAK)THEN + SMALL_SET=SMALL_SET+1 + ENDIF + ENDIF + IF(K50.EQ.0) THEN + IF((TEMP(i)+dble(NB_ROWS(i))*dble(NFRONT)) + & .GT.PEAK)THEN + SMALL_SET=SMALL_SET+1 + ENDIF + ENDIF + X=X+NB_ROWS(i) + SOMME=SOMME+ dble(NB_ROWS(i)) + ENDDO + ENDIF + 889 CONTINUE + J=CHOSEN + X=0 + DO i=J,1,-1 + IF(NB_ROWS(i).EQ.0)THEN + IF(X.EQ.1)THEN + WRITE(*,*)MYID, + & ':Internal error 12 in CMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + CHOSEN=CHOSEN-1 + ELSE + IF(NB_ROWS(i).GT.0)THEN + X=1 + ELSE + WRITE(*,*) + & 'Internal error 13 in CMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDDO + NSLAVES_NODE=CHOSEN + TAB_POS(NSLAVES_NODE+1)= NCB+1 + TAB_POS(SLAVEF+2) = CHOSEN + POS=1 + DO i=1,CHOSEN + SLAVES_LIST(i)=TEMP_ID(i) + TAB_POS(i)=POS + POS=POS+NB_ROWS(i) + IF(NB_ROWS(i).LE.0)THEN + WRITE(*,*) + & 'Internal error 14 in CMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ENDDO + DO i=CHOSEN+1,NUMBER_OF_PROCS + SLAVES_LIST(i)=TEMP_ID(i) + ENDDO + IF(POS.NE.(NCB+1))THEN + WRITE(*,*) + & 'Internal error 15 in CMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + END SUBROUTINE CMUMPS_504 + SUBROUTINE CMUMPS_518 + & (NCBSON_MAX,SLAVEF,KEEP,KEEP8, + & PROCS,MEM_DISTRIB,NCB,NFRONT, + & NSLAVES_NODE,TAB_POS, + & SLAVES_LIST,SIZE_SLAVES_LIST,MYID,INODE,MP,LP) + IMPLICIT NONE + INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST + INTEGER(8) KEEP8(150) + INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID + INTEGER, intent(in) :: NCBSON_MAX + INTEGER, intent(in) :: PROCS(SLAVEF+1) + INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1),INODE + INTEGER, intent(in) :: MP,LP + INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST) + INTEGER, intent(out):: TAB_POS(SLAVEF+2) + INTEGER, intent(out):: NSLAVES_NODE + INTEGER NUMBER_OF_PROCS,K47,K48, K50,K83,K69 + INTEGER(8) :: K821 + INTEGER J + INTEGER KMIN, KMAX + INTEGER OTHERS,CHOSEN,SMALL_SET,ACC + DOUBLE PRECISION SOMME,TMP_SUM,DELTA,A,B,C,MASTER_WORK + INTEGER AFFECTED + INTEGER ADDITIONNAL_ROWS,i,X,REF,POS,NELIM + INTEGER(8) X8 + LOGICAL FORCE_CAND,SMP + DOUBLE PRECISION BANDE_K821 + INTEGER NB_SAT,NB_ZERO + DOUBLE PRECISION TEMP(SLAVEF),TOTAL_COST, MAX_MEM_ALLOW + INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF) + INTEGER NSLAVES_REF,NCB_FILS + EXTERNAL MPI_WTIME,MUMPS_442 + INTEGER MUMPS_442 + INTEGER POS_MIN_LOAD,SIZE_MY_SMP,WHAT,ADDITIONNAL_ROWS_SPECIAL + LOGICAL HAVE_TYPE1_SON + DOUBLE PRECISION MIN_LOAD,MAX_LOAD,TEMP_MAX_LOAD + DOUBLE PRECISION MPI_WTIME + DOUBLE PRECISION BUF_SIZE,NELIM_MEM_SIZE + DOUBLE PRECISION MEM_SIZE_STRONG(SLAVEF),MEM_SIZE_WEAK(SLAVEF) + K821=abs(KEEP8(21)) + TEMP_MAX_LOAD=dble(0) + K50=KEEP(50) + K48=KEEP(48) + K47=KEEP(47) + K83=KEEP(83) + K69=0 + NCB_FILS=NCBSON_MAX + IF(int(NCB_FILS,8)*int(min(NCB,NCB_FILS),8).GT.K821)THEN + HAVE_TYPE1_SON=.TRUE. + ELSE + HAVE_TYPE1_SON=.FALSE. + ENDIF + SMP=(K69.NE.0) + IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN + FORCE_CAND = .FALSE. + ELSE + FORCE_CAND = (mod(KEEP(24),2).eq.0) + END IF + NELIM=NFRONT-NCB + KMAX=int(K821/int(NCB,8)) + IF(FORCE_CAND)THEN + DO i=1,PROCS(SLAVEF+1) + WLOAD(i)=LOAD_FLOPS(PROCS(i)) + IDWLOAD(i)=PROCS(i) + IF (WLOAD(i) < -0.5d0 ) THEN + IF((MP.GT.0).AND.(LP.GE.2))THEN + WRITE(MP,*)MYID,': Warning: negative load ', + & WLOAD(i) + ENDIF + ENDIF + WLOAD(i)=max(WLOAD(i),0.0d0) + ENDDO + NUMBER_OF_PROCS=PROCS(SLAVEF+1) + OTHERS=NUMBER_OF_PROCS + ELSE + NUMBER_OF_PROCS=SLAVEF + WLOAD(1:SLAVEF) = LOAD_FLOPS(0:NUMBER_OF_PROCS-1) + DO i=1,NUMBER_OF_PROCS + IDWLOAD(i) = i - 1 + IF (WLOAD(i) < -0.5d0 ) THEN + IF((MP.GT.0).AND.(LP.GE.2))THEN + WRITE(MP,*)MYID,': Negative load ', + & WLOAD(i) + ENDIF + ENDIF + WLOAD(i)=max(WLOAD(i),0.0d0) + ENDDO + OTHERS=NUMBER_OF_PROCS-1 + ENDIF + KMAX=int(NCB/OTHERS) + KMIN=MUMPS_442(int(NCB,8)*int(KMAX,8),K50,KMAX,NCB) + NB_ROWS=0 + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, IDWLOAD) + IF(K50.EQ.0)THEN + TOTAL_COST=dble( NELIM ) * dble ( NCB ) + + & dble(NCB) * dble(NELIM)*dble(2*NFRONT-NELIM-1) + ELSE + TOTAL_COST=dble(NELIM) * dble ( NCB ) * + & dble(NFRONT+1) + ENDIF + CALL MUMPS_511(NFRONT,NELIM,NELIM,K50, + & 2,MASTER_WORK) + SOMME=dble(0) + J=1 + IF(FORCE_CAND.AND.(NUMBER_OF_PROCS.GT.K83))THEN + MASTER_WORK=dble(KEEP(88))*MASTER_WORK/dble(100) + ENDIF + IF(FORCE_CAND.AND.(NUMBER_OF_PROCS.LE.K83))THEN + MASTER_WORK=dble(KEEP(87))*MASTER_WORK/dble(100) + ENDIF + IF(MASTER_WORK.LT.dble(1))THEN + MASTER_WORK=dble(1) + ENDIF + NSLAVES_REF=int(TOTAL_COST/MASTER_WORK)+1 + IF(FORCE_CAND)THEN + NSLAVES_REF=min(NSLAVES_REF,NUMBER_OF_PROCS) + ELSE + NSLAVES_REF=min(NSLAVES_REF,NUMBER_OF_PROCS-1) + ENDIF + DO i=1,NUMBER_OF_PROCS + IF((IDWLOAD(i).NE.MYID))THEN + TEMP_ID(J)=IDWLOAD(i) + TEMP(J)=WLOAD(i) + IF(BDC_M2_FLOPS)THEN + TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1) + ENDIF + J=J+1 + ENDIF + ENDDO + NUMBER_OF_PROCS=J-1 + CALL MUMPS_558(NUMBER_OF_PROCS, TEMP, TEMP_ID) + SOMME=dble(0) + TMP_SUM=dble(0) + DO i=1,OTHERS + SOMME=SOMME+TEMP(OTHERS)-TEMP(i) + TMP_SUM=TMP_SUM+TEMP(i) + ENDDO + TMP_SUM=(TMP_SUM/dble(OTHERS))+ + & (TOTAL_COST/dble(OTHERS)) + SIZE_MY_SMP=OTHERS + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + IF(.NOT.SMP) MAX_LOAD=TEMP(OTHERS) + IF(SMP)THEN + J=1 + DO i=1,OTHERS + IF(MEM_DISTRIB(TEMP_ID(i)).EQ.1)THEN + IF(TEMP(i).LE.TMP_SUM)THEN + WLOAD(J)=TEMP(i) + IDWLOAD(J)=TEMP_ID(i) + J=J+1 + ELSE + ENDIF + ENDIF + ENDDO + MAX_LOAD=WLOAD(J-1) + SIZE_MY_SMP=J-1 + DO i=1,OTHERS + IF((MEM_DISTRIB(TEMP_ID(i)).NE.1).OR. + & ((MEM_DISTRIB(TEMP_ID(i)).EQ.1).AND. + & (TEMP(i).GE.TMP_SUM)))THEN + WLOAD(J)=TEMP(i) + IDWLOAD(J)=TEMP_ID(i) + J=J+1 + ENDIF + ENDDO + TEMP=WLOAD + TEMP_ID=IDWLOAD + ENDIF + IF(BDC_MD)THEN + BUF_SIZE=dble(K821) + IF (KEEP(201).EQ.2) THEN + A=dble(int((dble(KEEP(100))/dble(2))/dble(NELIM))) + IF(K50.EQ.0)THEN + BUF_SIZE=min(BUF_SIZE,A*dble(NCB)) + ELSE + BUF_SIZE=min(BUF_SIZE,A*A) + ENDIF + ENDIF + BUF_SIZE=dble(K821) + DO i=1,NUMBER_OF_PROCS + A=dble(MD_MEM(TEMP_ID(i)))/ + & dble(NELIM) + A=A*dble(NFRONT) + IF(K50.EQ.0)THEN + B=dble(int(dble(NCB)/dble(NUMBER_OF_PROCS))+1)* + & dble(NFRONT) + ELSE + WHAT = 5 +#if ! defined (OOC_PAR_MEM_SLAVE_SELECT) && ! defined (OOC_PAR_MEM2) + CALL MUMPS_503(WHAT, KEEP,KEEP8, NCB, + & NFRONT, min(NCB,OTHERS), J, X8) +#endif + B=dble(X8)+(dble(J)*dble(NELIM)) + ENDIF + NELIM_MEM_SIZE=A+B + MEM_SIZE_WEAK(i)=NELIM_MEM_SIZE + IF((SBTR_WHICH_M.EQ.0).OR.(.NOT.BDC_SBTR))THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i)) + ENDIF + ELSE + IF(BDC_SBTR)THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ENDIF + ENDIF + ENDIF + IF(min(MEM_SIZE_STRONG(i),MEM_SIZE_WEAK(i)).LT.dble(0))THEN + IF(MEM_SIZE_STRONG(i).LT.0.0d0)THEN + MEM_SIZE_STRONG(i)=dble(0) + ELSE + MEM_SIZE_WEAK(i)=dble(0) + ENDIF + ENDIF + ENDDO + ELSE + BUF_SIZE=dble(K821) + DO i=1,NUMBER_OF_PROCS + IF((SBTR_WHICH_M.EQ.0).OR.(.NOT.BDC_SBTR))THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i)) + ENDIF + ELSE + IF(BDC_SBTR)THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ENDIF + ENDIF + ENDIF + MEM_SIZE_STRONG(i)=max(dble(0),MEM_SIZE_STRONG(i)) + MEM_SIZE_WEAK(i)=huge(MEM_SIZE_WEAK(i)) + ENDDO + ENDIF + IF((((NUMBER_OF_PROCS.LE.K83).AND.FORCE_CAND).AND. + & (TOTAL_COST.GE.SOMME)).OR. + & (.NOT.FORCE_CAND).OR. + & (((NUMBER_OF_PROCS+1).GT.K83).AND.FORCE_CAND))THEN + REF=NSLAVES_REF + SMALL_SET=NSLAVES_REF + IF(.NOT.SMP)THEN + DO i=NSLAVES_REF,1,-1 + SOMME=dble(0) + DO J=1,i + SOMME=SOMME+TEMP(J) + ENDDO + SOMME=(dble(i)*TEMP(i))-SOMME + IF(TOTAL_COST.GE.SOMME) GOTO 444 + ENDDO + 444 CONTINUE + REF=i + SMALL_SET=REF + MAX_LOAD=TEMP(SMALL_SET) + ELSE + X=min(SIZE_MY_SMP,NSLAVES_REF) + 450 CONTINUE + SOMME=dble(0) + DO J=1,X + SOMME=SOMME+(TEMP(X)-TEMP(J)) + ENDDO + IF(SOMME.GT.TOTAL_COST)THEN + X=X-1 + GOTO 450 + ELSE + IF(X.LT.SIZE_MY_SMP) THEN + REF=X + SMALL_SET=REF + MAX_LOAD=TEMP(SMALL_SET) + ELSE + X=min(SIZE_MY_SMP,NSLAVES_REF) + J=X+1 + MAX_LOAD=TEMP(X) + TMP_SUM=MAX_LOAD + DO i=X+1,OTHERS + IF(TEMP(i).GT.MAX_LOAD)THEN + SOMME=SOMME+(dble(i-1)*(TEMP(i)-MAX_LOAD)) + TMP_SUM=MAX_LOAD + MAX_LOAD=TEMP(i) + ELSE + SOMME=SOMME+(MAX_LOAD-TEMP(i)) + ENDIF + IF(i.EQ.NSLAVES_REF)THEN + SMALL_SET=NSLAVES_REF + REF=SMALL_SET + GOTO 323 + ENDIF + IF(SOMME.GT.TOTAL_COST)THEN + REF=i-1 + SMALL_SET=i-1 + MAX_LOAD=TMP_SUM + GOTO 323 + ENDIF + ENDDO + ENDIF + ENDIF + ENDIF + 323 CONTINUE + MAX_LOAD=dble(0) + DO i=1,SMALL_SET + MAX_LOAD=max(MAX_LOAD,TEMP(i)) + ENDDO + TEMP_MAX_LOAD=MAX_LOAD + NB_ROWS=0 + TMP_SUM=dble(0) + CHOSEN=0 + ACC=0 + NB_SAT=0 + NB_ZERO=0 + DO i=1,SMALL_SET + IF(K50.EQ.0)THEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + IF(HAVE_TYPE1_SON)THEN + IF(K50.EQ.0)THEN + X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + IF(K50.EQ.0)THEN + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + X=int((MAX_LOAD-TEMP(i))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.KMIN)THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*(dble(NELIM)+dble(2*ACC+1)) + C=-(MAX_LOAD-TEMP(i)) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 1 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.KMIN)THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + NB_ROWS(i)=X + ACC=ACC+X + CHOSEN=CHOSEN+1 + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + TMP_SUM=MAX_LOAD + IF(K50.EQ.0)THEN + MAX_LOAD=max(MAX_LOAD, + & (TEMP(i)+(dble(NELIM) * + & dble(NB_ROWS(i)))+ + & (dble(NB_ROWS(i))*dble(NELIM)* + & dble(2*NFRONT-NELIM-1)))) + ELSE + MAX_LOAD=max(MAX_LOAD, + & TEMP(i)+(dble(NELIM) * dble(NB_ROWS(i)))* + & dble(2*(NELIM+ACC)-NB_ROWS(i) + & -NELIM+1)) + ENDIF + IF(TMP_SUM.LT.MAX_LOAD)THEN + ENDIF + IF(NCB-ACC.LT.KMIN) GOTO 888 + IF(NCB.EQ.ACC) GOTO 888 + IF(ACC.GT.NCB) THEN + WRITE(*,*)MYID, + & ': Internal error 2 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + ENDDO + 888 CONTINUE + SOMME=dble(0) + X=NFRONT-NCB + IF((ACC.GT.NCB))THEN + WRITE(*,*)MYID, + & ': Internal error 3 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF((ACC.LT.NCB))THEN + IF(K50.NE.0)THEN + IF(SMALL_SET.LE.OTHERS)THEN + IF((NB_SAT.EQ.SMALL_SET).AND.(SMALL_SET.LT. + & NSLAVES_REF))THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ADDITIONNAL_ROWS_SPECIAL=NCB-ACC + DO i=1,SMALL_SET + MAX_LOAD=TEMP_MAX_LOAD + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)* + & dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS-NELIM + & +1) + SOMME=SOMME/dble(SMALL_SET-NB_SAT) + NB_ROWS=0 + NB_ZERO=0 + ACC=0 + CHOSEN=0 + NB_SAT=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO J=1,SMALL_SET + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=(dble(NELIM)*dble(NELIM+2*ACC+1)) + C=-(MAX_LOAD-TEMP(J)+SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=X+1 + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 4 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + NB_ZERO=NB_ZERO+1 + X=0 + ENDIF + ELSE + IF(X.LT.min(KMIN,KMAX))THEN + NB_ZERO=NB_ZERO+1 + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(J)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(J))THEN + MIN_LOAD=TEMP(J) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + ACC=ACC+X + TMP_SUM=MAX_LOAD + TEMP_MAX_LOAD=max(TEMP_MAX_LOAD, + & TEMP(J)+(dble(NELIM) * + & dble(NB_ROWS(J)))* + & dble(2*(NELIM+ + & ACC)-NB_ROWS(J) + & -NELIM+1)) + IF(REF.LE.NUMBER_OF_PROCS-1)THEN + IF(TEMP_MAX_LOAD.GT.TEMP(REF+1))THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ENDIF + ENDIF + IF(NCB.EQ.ACC) GOTO 666 + ENDDO + IF(NB_SAT.EQ.SMALL_SET)THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + GOTO 434 + ENDIF + ENDIF + IF(NB_ZERO.EQ.SMALL_SET)THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + GOTO 434 + ENDIF + ENDIF + IF((NB_SAT+NB_ZERO).EQ.SMALL_SET)THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + GOTO 434 + ENDIF + ENDIF + ENDDO + 434 CONTINUE + ADDITIONNAL_ROWS=NCB-ACC + IF(ADDITIONNAL_ROWS.NE.0)THEN + IF(ADDITIONNAL_ROWS.LT.KMIN)THEN + i=CHOSEN + J=ACC + 436 CONTINUE + IF(NB_ROWS(i).NE.0)THEN + J=J-NB_ROWS(i) + A=dble(1) + B=dble(J+2) + C=-BUF_SIZE+dble(J+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-J) X=NCB-J + BANDE_K821=dble(X)*dble(NELIM+J+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(J+2+NELIM) + C=-BUF_SIZE+dble(J+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-J) X=NCB-J + BANDE_K821=dble(X)*dble(NELIM+J+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(J+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(NB_ROWS(i).NE.KMAX)THEN + IF(NCB-J.LE.KMAX)THEN + NB_ROWS(i)=+NCB-J + ADDITIONNAL_ROWS=0 + ENDIF + ENDIF + TEMP_MAX_LOAD=max(TEMP_MAX_LOAD, + & TEMP(i)+ + & (dble(NELIM) * dble(NB_ROWS(i)))* + & dble(2*(NELIM+ + & ACC)-NB_ROWS(i) + & -NELIM+1)) + IF(REF.LE.NUMBER_OF_PROCS-1)THEN + IF(TEMP_MAX_LOAD.GT.TEMP(REF+1))THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ENDIF + ENDIF + ELSE + i=i-1 + IF(i.NE.0)GOTO 436 + ENDIF + IF(ADDITIONNAL_ROWS.NE.0)THEN + i=CHOSEN + IF(i.NE.SMALL_SET)THEN + i=i+1 + IF(NB_ROWS(i).NE.0)THEN + WRITE(*,*)MYID, + & ': Internal error 5 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + CHOSEN=i + ENDIF + ENDIF + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF((TEMP(i).LE.MAX_LOAD))THEN + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(i)) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.KMIN)THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + ACC=ACC+X + ADDITIONNAL_ROWS=NCB-ACC + ELSE IF((TEMP(i).GT.MAX_LOAD))THEN + MAX_LOAD=TEMP(i) + NB_SAT=0 + ACC=0 + NB_ROWS=0 + DO J=1,i + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(J)) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 6 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.min(KMIN,KMAX))THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(J)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(J))THEN + MIN_LOAD=TEMP(J) + POS_MIN_LOAD=i + ENDIF + ENDIF + ACC=ACC+X + MAX_LOAD=max(MAX_LOAD, + & TEMP(J)+ + & (dble(NELIM)*dble(NB_ROWS(J)))* + & dble(2*(NELIM+ + & ACC)-NB_ROWS(J) + & -NELIM+1)) + IF(NCB.EQ.ACC) GOTO 741 + IF(NCB-ACC.LT.KMIN) GOTO 210 + ENDDO + 210 CONTINUE + ENDIF + 741 CONTINUE + i=i+1 + ADDITIONNAL_ROWS=NCB-ACC + ENDDO + CHOSEN=i-1 + IF(ADDITIONNAL_ROWS.NE.0)THEN + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)*dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS- + & NELIM+1) + SOMME=SOMME/dble(NUMBER_OF_PROCS) + NB_ROWS=0 + ACC=0 + CHOSEN=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(i)+SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 7 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.min(KMIN,KMAX))THEN + X=min(KMAX,KMIN) + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB.EQ.ACC) GOTO 666 + IF(NCB-ACC.LT.KMIN) GOTO 488 + ENDDO + 488 CONTINUE + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)* + & dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS- + & NELIM+1) + SOMME=SOMME/dble(NUMBER_OF_PROCS) + NB_ROWS=0 + ACC=0 + CHOSEN=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(i)+SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 8 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + X=KMAX + ELSE + IF(X.LT.KMIN)THEN + X=KMIN + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB.EQ.ACC) GOTO 666 + IF(NCB-ACC.LT.KMIN) GOTO 477 + ENDDO + 477 CONTINUE + IF(ACC.NE.NCB)THEN + NB_SAT=0 + ACC=0 + CHOSEN=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=KMAX-NB_ROWS(i) + IF((ACC+NB_ROWS(i)+X).GT.NCB) + & X=NCB-(ACC+NB_ROWS(i)) + NB_ROWS(i)=NB_ROWS(i)+X + IF((dble(NB_ROWS(i))* + & dble(NB_ROWS(i)+ACC)).EQ. + & BANDE_K821)THEN + NB_SAT=NB_SAT+1 + ENDIF + ACC=ACC+NB_ROWS(i) + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + IF(NCB.EQ.ACC) GOTO 666 + IF(NCB-ACC.LT.KMIN) GOTO 834 + ENDDO + 834 CONTINUE + ENDIF + IF(ACC.NE.NCB)THEN + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)* + & dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS- + & NELIM+1) + SOMME=SOMME/dble(NUMBER_OF_PROCS-NB_SAT) + ACC=0 + DO i=1,CHOSEN + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + IF((dble(NB_ROWS(i))* + & dble(NB_ROWS(i)+ACC)).EQ. + & BANDE_K821)THEN + GOTO 102 + ENDIF + A=dble(NELIM) + B=dble(NELIM)* + & dble(NELIM+2*(ACC+NB_ROWS(i))+1) + C=-(SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-BANDE_K821) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 9 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF((ACC+X+NB_ROWS(i)).GT.NCB)THEN + IF((NCB-ACC).GT.KMAX)THEN + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NCB-ACC + ENDIF + ELSE + IF((NB_ROWS(i)+X).GT.KMAX)THEN + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NB_ROWS(i)+X + ENDIF + ENDIF + 102 CONTINUE + ACC=ACC+NB_ROWS(i) + IF(NCB.EQ.ACC) THEN + CHOSEN=i + GOTO 666 + ENDIF + IF(NCB-ACC.LT.KMIN) THEN + CHOSEN=i + GOTO 007 + ENDIF + ENDDO + 007 CONTINUE + DO i=1,CHOSEN + NB_ROWS(i)=NB_ROWS(i)+1 + ACC=ACC+1 + IF(ACC.EQ.NCB)GOTO 666 + ENDDO + IF(ACC.LT.NCB)THEN + IF(SMP)THEN + NB_ROWS(1)=NB_ROWS(1)+NCB-ACC + ELSE + NB_ROWS(POS_MIN_LOAD)= + & NB_ROWS(POS_MIN_LOAD)+NCB-ACC + ENDIF + ENDIF + ENDIF + GOTO 666 + ENDIF + ENDIF + GOTO 666 + ENDIF + ADDITIONNAL_ROWS=NCB-ACC + i=CHOSEN+1 + IF(NB_SAT.EQ.SMALL_SET) GOTO 777 + DO i=1,SMALL_SET + IDWLOAD(i)=i + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & (dble(NFRONT+1))) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + WLOAD(i)=MAX_MEM_ALLOW + ENDDO + CALL MUMPS_558(SMALL_SET, WLOAD, IDWLOAD) + NB_ZERO=0 + IF((NB_SAT.EQ.SMALL_SET).AND. + & (SMALL_SET.LT.NSLAVES_REF))THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + IF((NB_SAT.EQ.SMALL_SET).AND. + & (SMALL_SET.LE.NUMBER_OF_PROCS))GOTO 777 + AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT)) + AFFECTED=max(AFFECTED,1) + DO i=1,SMALL_SET + KMAX=int(WLOAD(i)/dble(NFRONT)) + IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN + GOTO 912 + ENDIF + IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED, + & ADDITIONNAL_ROWS)).GT.KMAX)THEN + IF(NB_ROWS(IDWLOAD(i)).GT.KMAX)THEN + ENDIF + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(IDWLOAD(i))) + NB_ROWS(IDWLOAD(i))=KMAX + NB_SAT=NB_SAT+1 + IF(NB_SAT.EQ.SMALL_SET)THEN + IF(SMALL_SET.NE.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + MAX_LOAD=max(MAX_LOAD, + & (TEMP(IDWLOAD(i))+(dble(NELIM) * + & dble(NB_ROWS(IDWLOAD(i))))+ + & (dble(NB_ROWS(IDWLOAD(i)))* + & dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + GOTO 777 + ENDIF + ENDIF + AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT)) + AFFECTED=max(AFFECTED,1) + ELSE + IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED, + & ADDITIONNAL_ROWS)).GE.KMIN)THEN + X=min(AFFECTED,ADDITIONNAL_ROWS) + NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+ + & X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ELSE + X=int((MAX_LOAD-TEMP(IDWLOAD(i)))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X+AFFECTED.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ELSE + X=AFFECTED+X + ENDIF + IF(X.GE.KMIN)THEN + NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+ + & X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & X + ELSE + NB_ZERO=NB_ZERO+1 + ENDIF + ENDIF + ENDIF + 912 CONTINUE + MAX_LOAD=max(MAX_LOAD, + & (TEMP(IDWLOAD(i))+(dble(NELIM)* + & dble(NB_ROWS(IDWLOAD(i))))+ + & (dble(NB_ROWS(IDWLOAD(i)))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + IF(SMALL_SET.LT.NUMBER_OF_PROCS)THEN + IF(MAX_LOAD.GT.TEMP(SMALL_SET+1))THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ENDIF + ENDIF + IF(SMALL_SET.EQ.NB_SAT)GOTO 777 + IF(ADDITIONNAL_ROWS.EQ.0)THEN + CHOSEN=SMALL_SET + GOTO 049 + ENDIF + ENDDO + 777 CONTINUE + IF((NB_ZERO.NE.0).AND.(ADDITIONNAL_ROWS.GE.KMIN))THEN + J=NB_ZERO + 732 CONTINUE + X=int(ADDITIONNAL_ROWS/(J)) + IF(X.LT.KMIN)THEN + J=J-1 + GOTO 732 + ENDIF + IF(X*J.LT.ADDITIONNAL_ROWS)THEN + X=X+1 + ENDIF + DO i=1,SMALL_SET + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & dble(BANDE_K821)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(NB_ROWS(i).EQ.0)THEN + IF(X.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ENDIF + IF(X.GT.KMAX)THEN + X=KMAX + ENDIF + IF(X.GT.KMIN)THEN + NB_ROWS(i)=X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + MAX_LOAD=max(MAX_LOAD, + & (TEMP(i)+(dble(NELIM) * + & dble(NB_ROWS(i)))+ + & (dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + ENDIF + ENDIF + ENDDO + ENDIF + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF((TEMP(i).LE.MAX_LOAD))THEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + AFFECTED=int((MAX_LOAD-TEMP(i))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(i).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(i)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(i) + NB_SAT=NB_SAT+1 + ELSE + IF((AFFECTED+NB_ROWS(i)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(i)=NB_ROWS(i)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + ENDIF + ELSE IF((TEMP(i).GT.MAX_LOAD))THEN + IF(NB_SAT.EQ.i-1) GOTO 218 + X=(ADDITIONNAL_ROWS/(i-1-NB_SAT)) + ACC=1 + DO J=1,i-1 + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(J)+X)) + & +(dble(NB_ROWS(J)+X)*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + IF((TEMP(J)+TMP_SUM).GT.MAX_LOAD)THEN + ACC=0 + ENDIF + ENDDO + IF(ACC.EQ.1)THEN + MAX_LOAD=TEMP(i) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + AFFECTED=X + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(J).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + NB_SAT=NB_SAT+1 + ELSE + IF((AFFECTED+NB_ROWS(J)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & AFFECTED + ENDIF + J=J+1 + ENDDO + ELSE + MAX_LOAD=TEMP(i) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + TMP_SUM=((dble(NELIM)* dble(NB_ROWS(J))) + & +(dble(NB_ROWS(J))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((MAX_LOAD-(TEMP(J)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 10 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + AFFECTED=X + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(J).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + NB_SAT=NB_SAT+1 + ELSE + IF((AFFECTED+NB_ROWS(J)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & AFFECTED + ENDIF + J=J+1 + ENDDO + ENDIF + ENDIF + 218 CONTINUE + i=i+1 + ENDDO + CHOSEN=i-1 + IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. + & (ADDITIONNAL_ROWS.NE.0))THEN + DO i=1,CHOSEN + IF(NB_ROWS(i)+1.GE.KMIN)THEN + NB_ROWS(i)=NB_ROWS(i)+1 + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 + ENDIF + MAX_LOAD=max(MAX_LOAD, + & (TEMP(i)+(dble(NELIM) * + & dble(NB_ROWS(i)))+ + & (dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 048 + ENDDO + 048 CONTINUE + ENDIF + IF((ADDITIONNAL_ROWS.NE.0))THEN + IF(CHOSEN.LT.NUMBER_OF_PROCS)THEN + i=CHOSEN+1 + ELSE + IF(CHOSEN.NE.NUMBER_OF_PROCS)THEN + WRITE(*,*)MYID, + & ': Internal error 11 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + i=CHOSEN + ENDIF + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF(TEMP(i).LE.MAX_LOAD)THEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) + & +(dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((MAX_LOAD-(TEMP(i)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + AFFECTED=X + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 12 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(i).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(i)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(i) + ELSE + IF((AFFECTED+NB_ROWS(i)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(i)=NB_ROWS(i)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + ENDIF + IF(i.NE.NUMBER_OF_PROCS) GOTO 624 + ELSE IF((TEMP(i).GT.MAX_LOAD))THEN + X=int(ADDITIONNAL_ROWS/i-1) + X=max(X,1) + IF((MAX_LOAD+((dble(NELIM)* + & dble(X))+(dble( + & X)*dble(NELIM))*dble( + & (2*NFRONT-NELIM-1)))).LE.TEMP(i))THEN + AFFECTED=X + POS=1 + ELSE + POS=0 + ENDIF + MAX_LOAD=TEMP(i) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + MAX_MEM_ALLOW=BANDE_K821 + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(POS.EQ.0)THEN + TMP_SUM=((dble(NELIM) * + & dble(NB_ROWS(J))) + & +(dble(NB_ROWS(J))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((TEMP(i)-(TEMP(J)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT- + & NELIM))) + ELSE + X=int(TMP_SUM) + ENDIF + IF(X.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(J).LT.KMAX)THEN + IF((X+NB_ROWS(J)).GT.KMAX)THEN + X=KMAX-NB_ROWS(J) + ELSE + IF((NB_ROWS(J)+X).LT. + & KMIN)THEN + X=0 + ENDIF + ENDIF + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDIF + J=J+1 + ENDDO + ENDIF + 624 CONTINUE + i=i+1 + ENDDO + CHOSEN=i-1 + IF(ADDITIONNAL_ROWS.NE.0)THEN + ACC=0 + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) + & +(dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((MAX_LOAD- + & (TEMP(i)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 13 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(i).LT.KMAX)THEN + IF((X+NB_ROWS(i)).GE.KMAX)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + IF((X+NB_ROWS(i)).GE. + & KMIN)THEN + NB_ROWS(i)=NB_ROWS(i)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ACC=ACC+1 + ELSE + ACC=ACC+1 + ENDIF + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + IF(CHOSEN.LT.NUMBER_OF_PROCS)THEN + CHOSEN=CHOSEN+1 + ENDIF + IF(ACC.EQ.0)THEN + ACC=1 + ENDIF + X=int(ADDITIONNAL_ROWS/ACC) + X=max(X,1) + ACC=0 + DO i=1,CHOSEN + J=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(J)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + J=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(J)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) + & +(dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + J=int((MAX_LOAD- + & (TEMP(i)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(NB_ROWS(i).LT.KMAX)THEN + IF((min(X,J)+NB_ROWS(i)).GE.KMAX)THEN + IF((KMAX-NB_ROWS(i)).GT. + & ADDITIONNAL_ROWS)THEN + NB_ROWS(i)=NB_ROWS(i)+ + & ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ENDIF + ELSE + IF((min(X,J)+NB_ROWS(i)).GE. + & KMIN)THEN + NB_ROWS(i)=NB_ROWS(i)+min(X,J) + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & min(X,J) + ACC=ACC+1 + ENDIF + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + IF(ACC.GT.0)THEN + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(KMAX-NB_ROWS(i).LT. + & ADDITIONNAL_ROWS)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + IF(NB_ROWS(i).EQ.0)THEN + IF(min(KMIN,KMAX).LT. + & ADDITIONNAL_ROWS)THEN + NB_ROWS(i)=min(KMIN,KMAX) + ADDITIONNAL_ROWS= + & ADDITIONNAL_ROWS- + & min(KMIN,KMAX) + ENDIF + ELSE + NB_ROWS(i)=NB_ROWS(i)+ + & ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + ENDIF + DO i=1,CHOSEN + IDWLOAD(i)=i + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + WLOAD(i)=(BANDE_K821-dble(NB_ROWS(i)*NFRONT)) + ENDDO + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, + & IDWLOAD) + NB_SAT=0 + DO i=1,CHOSEN + X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT)) + X=max(X,1) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(NB_ROWS(IDWLOAD(i)).LT.KMAX)THEN + IF((NB_ROWS(IDWLOAD(i))+X).LT.KMAX)THEN + NB_ROWS(IDWLOAD(i))= + & NB_ROWS(IDWLOAD(i))+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(IDWLOAD(i))) + NB_ROWS(IDWLOAD(i))=KMAX + ENDIF + ENDIF + IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN + NB_SAT=NB_SAT+1 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 049 + ENDDO + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(KMAX-NB_ROWS(i).LT.ADDITIONNAL_ROWS)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + X=int(ADDITIONNAL_ROWS/CHOSEN) + X=max(X,1) + DO i=1,CHOSEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + NB_ROWS(i)=NB_ROWS(i)+X + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS + ENDIF + ENDIF + 049 CONTINUE + ENDIF + 666 CONTINUE + SOMME=dble(0) + X=0 + POS=0 + DO i=1,CHOSEN + X=X+NB_ROWS(i) + SOMME=SOMME+ dble(NB_ROWS(i)) + ENDDO + GOTO 890 + ELSE IF((KEEP(83).GE.NUMBER_OF_PROCS).AND.FORCE_CAND)THEN + MAX_LOAD=dble(0) + DO i=1,OTHERS + MAX_LOAD=max(MAX_LOAD,TEMP(i)) + ENDDO + ACC=0 + CHOSEN=0 + X=1 + DO i=1,OTHERS + ENDDO + DO i=2,OTHERS + IF(TEMP(i).EQ.TEMP(1))THEN + X=X+1 + ELSE + GOTO 329 + ENDIF + ENDDO + 329 CONTINUE + TMP_SUM=TOTAL_COST/dble(X) + TEMP_MAX_LOAD=dble(0) + DO i=1,OTHERS + IF(K50.EQ.0)THEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + IF(HAVE_TYPE1_SON)THEN + IF(K50.EQ.0)THEN + X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i))) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + IF(K50.EQ.0)THEN + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(TMP_SUM+TEMP(i).GT.MAX_LOAD)THEN + SOMME=MAX_LOAD-TEMP(i) + ELSE + SOMME=TMP_SUM + ENDIF + X=int(SOMME/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.GT.KMAX)THEN + X=KMAX + ELSE + IF(X.LT.KMIN)THEN + X=min(KMIN,KMAX) + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + IF(TMP_SUM+TEMP(i).GT.MAX_LOAD)THEN + C=-(MAX_LOAD-TEMP(i)) + ELSE + C=-TMP_SUM + ENDIF + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 14 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GT.KMIN)THEN + X=KMAX + ELSE + X=0 + ENDIF + ELSE + IF(X.LE.min(KMIN,KMAX))THEN + IF(KMAX.LT.KMIN)THEN + X=0 + ELSE + X=min(KMIN,KMAX) + ENDIF + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + TEMP_MAX_LOAD=max(TEMP_MAX_LOAD,TEMP(i)) + NB_ROWS(i)=X + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(ACC.EQ.NCB) GOTO 541 + ENDDO + 541 CONTINUE + IF(ACC.LT.NCB)THEN + IF(K50.EQ.0)THEN + ADDITIONNAL_ROWS=NCB-ACC + DO J=1,CHOSEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & dble(BANDE_K821)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF((NB_ROWS(J)).LT.KMAX)THEN + IF(ADDITIONNAL_ROWS.GT.(KMAX-NB_ROWS(J)))THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(J)) + NB_ROWS(J)=KMAX + ELSE + NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 + ENDDO + X=int(ADDITIONNAL_ROWS/CHOSEN) + X=max(X,1) + DO J=1,CHOSEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(J)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF((NB_ROWS(J)+X).GT.KMAX)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(J)) + NB_ROWS(J)=KMAX + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + NB_ROWS(J)=NB_ROWS(J)+X + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 + ENDDO + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(KMAX-NB_ROWS(i).LT.ADDITIONNAL_ROWS)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 + ENDDO + DO i=1,NUMBER_OF_PROCS + IDWLOAD(i)=i + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + WLOAD(i)=(BANDE_K821-(dble(NB_ROWS(i))* + & dble(NFRONT))) + ENDDO + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, + & IDWLOAD) + NB_SAT=0 + DO i=1,CHOSEN + X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT)) + X=max(X,1) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(NB_ROWS(IDWLOAD(i)).LT.KMAX)THEN + IF((NB_ROWS(IDWLOAD(i))+X).LT.KMAX)THEN + NB_ROWS(IDWLOAD(i))= + & NB_ROWS(IDWLOAD(i))+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(IDWLOAD(i))) + NB_ROWS(IDWLOAD(i))=KMAX + ENDIF + ENDIF + IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN + NB_SAT=NB_SAT+1 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 889 + ENDDO + GOTO 994 + ELSE + ACC=0 + CHOSEN=0 + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=KMAX-NB_ROWS(i) + IF((ACC+NB_ROWS(i)+X).GT.NCB) + & X=NCB-(ACC+NB_ROWS(i)) + NB_ROWS(i)=NB_ROWS(i)+X + ACC=ACC+NB_ROWS(i) + CHOSEN=CHOSEN+1 + IF(NCB.EQ.ACC) GOTO 889 + ENDDO + ADDITIONNAL_ROWS=NCB-ACC + ENDIF + ACC=0 + CHOSEN=0 + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=KMAX-NB_ROWS(i) + IF((ACC+NB_ROWS(i)+X).GT.NCB) + & X=NCB-(ACC+NB_ROWS(i)) + NB_ROWS(i)=NB_ROWS(i)+X + ACC=ACC+NB_ROWS(i) + CHOSEN=CHOSEN+1 + IF(NCB.EQ.ACC) GOTO 889 + ENDDO + ADDITIONNAL_ROWS=NCB-ACC + 994 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(OTHERS)) + IF((X*OTHERS).LT.ADDITIONNAL_ROWS)THEN + X=X+1 + ENDIF + DO i=1,OTHERS + NB_ROWS(i)=NB_ROWS(i)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + IF(ADDITIONNAL_ROWS.LT.X)X=ADDITIONNAL_ROWS + ENDDO + CHOSEN=OTHERS + ENDIF + ENDIF + 889 CONTINUE + MAX_LOAD=TEMP_MAX_LOAD + 890 CONTINUE + J=CHOSEN + X=0 + DO i=J,1,-1 + IF(NB_ROWS(i).EQ.0)THEN + CHOSEN=CHOSEN-1 + ELSE + IF(NB_ROWS(i).GT.0)THEN + X=1 + ELSE + WRITE(*,*)MYID, + & ': Internal error 15 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDDO + NSLAVES_NODE=CHOSEN + TAB_POS(NSLAVES_NODE+1)= NCB+1 + TAB_POS(SLAVEF+2) = CHOSEN + POS=1 + X=1 + DO i=1,J + IF(NB_ROWS(i).NE.0)THEN + SLAVES_LIST(X)=TEMP_ID(i) + TAB_POS(X)=POS + POS=POS+NB_ROWS(i) + IF(NB_ROWS(i).LE.0)THEN + WRITE(*,*)MYID, + & ': Internal error 16 in CMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + X=X+1 + ENDIF + ENDDO + DO i=CHOSEN+1,NUMBER_OF_PROCS + SLAVES_LIST(i)=TEMP_ID(i) + ENDDO + IF(POS.NE.(NCB+1))THEN + WRITE(*,*)MYID, + & ': Internal error 17 in CMUMPS_518', + & POS,NCB+1 + CALL MUMPS_ABORT() + ENDIF + END SUBROUTINE CMUMPS_518 + SUBROUTINE CMUMPS_520 + & (INODE,UPPER,SLAVEF,KEEP,KEEP8, + & STEP,POOL,LPOOL,PROCNODE,N) + IMPLICIT NONE + INTEGER INODE, LPOOL, SLAVEF, N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER STEP(KEEP(28)), POOL(LPOOL), PROCNODE(KEEP(28)) + LOGICAL UPPER + INTEGER J + DOUBLE PRECISION MEM_COST + INTEGER NBINSUBTREE,i,NBTOP + EXTERNAL CMUMPS_508, + & MUMPS_170 + LOGICAL CMUMPS_508, + & MUMPS_170 + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + IF(KEEP(47).LT.2)THEN + WRITE(*,*)'CMUMPS_520 must + & be called with K47>=2' + CALL MUMPS_ABORT() + ENDIF + IF((INODE.GT.0).AND.(INODE.LE.N))THEN + MEM_COST=CMUMPS_543(INODE) + IF((DM_MEM(MYID)+dble(MEM_COST)+ PEAK_SBTR_CUR_LOCAL- + & SBTR_CUR_LOCAL) + & .GT.MAX_PEAK_STK)THEN + DO i=NBTOP-1,1,-1 + INODE = POOL( LPOOL - 2 - i) + MEM_COST=CMUMPS_543(INODE) + IF((INODE.LT.0).OR.(INODE.GT.N)) THEN + DO J=i+1,NBTOP,-1 + POOL(J-1)=POOL(J) + ENDDO + UPPER=.TRUE. + RETURN + ENDIF + IF((DM_MEM(MYID)+dble(MEM_COST)+PEAK_SBTR_CUR_LOCAL- + & SBTR_CUR_LOCAL).LE. + & MAX_PEAK_STK) THEN + DO J=i+1,NBTOP,-1 + POOL(J-1)=POOL(J) + ENDDO + UPPER=.TRUE. + RETURN + ENDIF + ENDDO + IF(NBINSUBTREE.NE.0)THEN + INODE = POOL( NBINSUBTREE ) + IF(.NOT.MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + WRITE(*,*) + & 'Internal error 1 in CMUMPS_520' + CALL MUMPS_ABORT() + ENDIF + UPPER=.FALSE. + RETURN + ENDIF + INODE=POOL(LPOOL-2-NBTOP) + UPPER=.TRUE. + RETURN + ENDIF + ENDIF + UPPER=.TRUE. + END SUBROUTINE CMUMPS_520 + SUBROUTINE CMUMPS_513(WHAT) + IMPLICIT NONE + LOGICAL WHAT + IF(.NOT.BDC_POOL_MNG)THEN + WRITE(*,*)'CMUMPS_513 + & should be called when K81>0 and K47>2' + ENDIF + IF(WHAT)THEN + PEAK_SBTR_CUR_LOCAL=PEAK_SBTR_CUR_LOCAL+ + & dble(MEM_SUBTREE(INDICE_SBTR)) + IF(.NOT.BDC_SBTR) INDICE_SBTR=INDICE_SBTR+1 + ELSE + PEAK_SBTR_CUR_LOCAL=dble(0) + SBTR_CUR_LOCAL=dble(0) + ENDIF + END SUBROUTINE CMUMPS_513 + DOUBLE PRECISION FUNCTION CMUMPS_543( INODE ) + IMPLICIT NONE + INTEGER INODE,LEVEL,i,NELIM,NFR + DOUBLE PRECISION COST + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + NFR = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253) + LEVEL = MUMPS_330( PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS ) + IF (LEVEL .EQ. 1) THEN + COST = dble(NFR) * dble(NFR) + ELSE + IF ( K50 == 0 ) THEN + COST = dble(NFR) * dble(NELIM) + ELSE + COST = dble(NELIM) * dble(NELIM) + ENDIF + ENDIF + CMUMPS_543=COST + RETURN + END FUNCTION CMUMPS_543 + RECURSIVE SUBROUTINE CMUMPS_515(FLAG,COST,COMM) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER COMM,WHAT,IERR + LOGICAL FLAG + DOUBLE PRECISION COST + DOUBLE PRECISION TO_BE_SENT + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF(FLAG)THEN + WHAT=17 + IF(BDC_M2_FLOPS)THEN +#if ! defined(OLD_LOAD_MECHANISM) + TO_BE_SENT=DELTA_LOAD-COST + DELTA_LOAD=dble(0) +#else + TO_BE_SENT=LAST_LOAD_SENT-COST + LAST_LOAD_SENT=LAST_LOAD_SENT-COST +#endif + ELSE IF(BDC_M2_MEM)THEN + IF(BDC_POOL.AND.(.NOT.BDC_MD))THEN + TO_BE_SENT=max(TMP_M2,POOL_LAST_COST_SENT) + POOL_LAST_COST_SENT=TO_BE_SENT + ELSE IF(BDC_MD)THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_MEM=DELTA_MEM+TMP_M2 + TO_BE_SENT=DELTA_MEM +#else + TO_BE_SENT=DM_LAST_MEM_SENT+TMP_M2 + DM_LAST_MEM_SENT=DM_LAST_MEM_SENT+TMP_M2 +#endif + ELSE + TO_BE_SENT=dble(0) + ENDIF + ENDIF + ELSE + WHAT=6 + TO_BE_SENT=dble(0) + ENDIF + 111 CONTINUE + CALL CMUMPS_460( WHAT, + & COMM, NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & COST, + & TO_BE_SENT, + & MYID, IERR ) + IF ( IERR == -1 )THEN + CALL CMUMPS_467(COMM_LD, KEEP_LOAD) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in CMUMPS_500", + & IERR + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE CMUMPS_515 + SUBROUTINE CMUMPS_512(INODE,STEP,NSTEPS,PROCNODE,FRERE, + & NE,COMM,SLAVEF,MYID,KEEP,KEEP8,N) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER INODE,NSTEPS,MYID,SLAVEF,COMM,N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER FRERE(NSTEPS),NE(NSTEPS),STEP(N),PROCNODE(NSTEPS) + EXTERNAL MUMPS_170,MUMPS_275 + LOGICAL MUMPS_170 + INTEGER i,NCB,NELIM + INTEGER MUMPS_275 + INTEGER FATHER_NODE,FATHER,WHAT,IERR + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN + WRITE(*,*)MYID,': Problem in CMUMPS_512' + CALL MUMPS_ABORT() + ENDIF + IF((INODE.LT.0).OR.(INODE.GT.N)) THEN + RETURN + ENDIF + i=INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + NCB=ND_LOAD(STEP_LOAD(INODE))-NELIM + KEEP_LOAD(253) + WHAT=5 + FATHER_NODE=DAD_LOAD(STEP_LOAD(INODE)) + IF (FATHER_NODE.EQ.0) THEN + RETURN + ENDIF + IF((FRERE(STEP(FATHER_NODE)).EQ.0).AND. + & ((FATHER_NODE.EQ.KEEP(38)).OR. + & (FATHER_NODE.EQ.KEEP(20))))THEN + RETURN + ENDIF + IF(MUMPS_170(PROCNODE(STEP(FATHER_NODE)), + & SLAVEF)) THEN + RETURN + ENDIF + FATHER=MUMPS_275(PROCNODE(STEP(FATHER_NODE)),SLAVEF) + IF(FATHER.EQ.MYID)THEN + IF(BDC_M2_MEM)THEN + CALL CMUMPS_816(FATHER_NODE) + ELSEIF(BDC_M2_FLOPS)THEN + CALL CMUMPS_817(FATHER_NODE) + ENDIF + IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN + IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), + & NPROCS).EQ.1)THEN + CB_COST_ID(POS_ID)=INODE + CB_COST_ID(POS_ID+1)=1 + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + CB_COST_MEM(POS_MEM)=int(MYID,8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(NCB,8)*int(NCB,8) + POS_MEM=POS_MEM+1 + ENDIF + ENDIF + GOTO 666 + ENDIF + 111 CONTINUE + CALL CMUMPS_519(WHAT, COMM, NPROCS, + & FATHER_NODE,INODE,NCB, KEEP(81),MYID, + & FATHER, IERR) + IF (IERR == -1 ) THEN + CALL CMUMPS_467(COMM, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in CMUMPS_512", + & IERR + CALL MUMPS_ABORT() + ENDIF + 666 CONTINUE + END SUBROUTINE CMUMPS_512 + SUBROUTINE CMUMPS_514(INODE,NUM_CALL) + IMPLICIT NONE + DOUBLE PRECISION MAXI + INTEGER i,J,IND_MAXI + INTEGER INODE,NUM_CALL + IF(BDC_M2_MEM)THEN + IF(((NUM_CALL.EQ.1).AND.(BDC_MD)).OR. + & ((NUM_CALL.EQ.2).AND.(.NOT.BDC_MD)))THEN + RETURN + ENDIF + ENDIF + IF((FRERE_LOAD(STEP_LOAD(INODE)).EQ.0).AND. + & ((INODE.EQ.KEEP_LOAD(38)).OR. + & (INODE.EQ.KEEP_LOAD(20)))) THEN + RETURN + ENDIF + DO i=POOL_SIZE,1,-1 + IF(POOL_NIV2(i).EQ.INODE) GOTO 666 + ENDDO + NB_SON(STEP_LOAD(INODE))=-1 + RETURN + 666 CONTINUE + IF(BDC_M2_MEM)THEN + IF(POOL_NIV2_COST(i).EQ.MAX_M2)THEN + TMP_M2=MAX_M2 + MAXI=dble(0) + IND_MAXI=-9999 + DO J=POOL_SIZE,1,-1 + IF(J.NE.i) THEN + IF(POOL_NIV2_COST(J).GT.MAXI)THEN + MAXI=POOL_NIV2_COST(J) + IND_MAXI=J + ENDIF + ENDIF + ENDDO + MAX_M2=MAXI + J=IND_MAXI + REMOVE_NODE_FLAG_MEM=.TRUE. + REMOVE_NODE_COST_MEM=TMP_M2 + CALL CMUMPS_515(REMOVE_NODE_FLAG,MAX_M2,COMM_LD) + NIV2(MYID+1)=MAX_M2 + ENDIF + ELSEIF(BDC_M2_FLOPS)THEN + REMOVE_NODE_COST=POOL_NIV2_COST(i) + REMOVE_NODE_FLAG=.TRUE. + CALL CMUMPS_515(REMOVE_NODE_FLAG, + & -POOL_NIV2_COST(i),COMM_LD) + NIV2(MYID+1)=NIV2(MYID+1)-POOL_NIV2_COST(i) + ENDIF + DO J=i+1,POOL_SIZE + POOL_NIV2(J-1)=POOL_NIV2(J) + POOL_NIV2_COST(J-1)=POOL_NIV2_COST(J) + ENDDO + POOL_SIZE=POOL_SIZE-1 + END SUBROUTINE CMUMPS_514 + RECURSIVE SUBROUTINE CMUMPS_816(INODE) + IMPLICIT NONE + INTEGER INODE + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF((INODE.EQ.KEEP_LOAD(20)).OR. + & (INODE.EQ.KEEP_LOAD(38)))THEN + RETURN + ENDIF + IF(NB_SON(STEP_LOAD(INODE)).EQ.-1)THEN + RETURN + ELSE + IF(NB_SON(STEP_LOAD(INODE)).LT.0)THEN + WRITE(*,*) + & 'Internal error 1 in CMUMPS_816' + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_SON(STEP_LOAD(INODE))= + & NB_SON(STEP_LOAD(INODE))-1 + IF(NB_SON(STEP_LOAD(INODE)).EQ.0)THEN + POOL_NIV2(POOL_SIZE+1)=INODE + POOL_NIV2_COST(POOL_SIZE+1)= + & CMUMPS_543(INODE) + POOL_SIZE=POOL_SIZE+1 + IF(POOL_NIV2_COST(POOL_SIZE).GT.MAX_M2)THEN + MAX_M2=POOL_NIV2_COST(POOL_SIZE) + ID_MAX_M2=POOL_NIV2(POOL_SIZE) + CALL CMUMPS_515(REMOVE_NODE_FLAG_MEM,MAX_M2,COMM_LD) + NIV2(1+MYID)=MAX_M2 + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_816 + RECURSIVE SUBROUTINE CMUMPS_817(INODE) + IMPLICIT NONE + INTEGER INODE + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF((INODE.EQ.KEEP_LOAD(20)).OR. + & (INODE.EQ.KEEP_LOAD(38)))THEN + RETURN + ENDIF + IF(NB_SON(STEP_LOAD(INODE)).EQ.-1)THEN + RETURN + ELSE + IF(NB_SON(STEP_LOAD(INODE)).LT.0)THEN + WRITE(*,*) + & 'Internal error 1 in CMUMPS_817' + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_SON(STEP_LOAD(INODE))= + & NB_SON(STEP_LOAD(INODE))-1 + IF(NB_SON(STEP_LOAD(INODE)).EQ.0)THEN + POOL_NIV2(POOL_SIZE+1)=INODE + POOL_NIV2_COST(POOL_SIZE+1)= + & CMUMPS_542(INODE) + POOL_SIZE=POOL_SIZE+1 + MAX_M2=POOL_NIV2_COST(POOL_SIZE) + ID_MAX_M2=POOL_NIV2(POOL_SIZE) + CALL CMUMPS_515(REMOVE_NODE_FLAG, + & POOL_NIV2_COST(POOL_SIZE), + & COMM_LD) + NIV2(MYID+1)=POOL_NIV2_COST(POOL_SIZE)+NIV2(MYID+1) + ENDIF + RETURN + END SUBROUTINE CMUMPS_817 + DOUBLE PRECISION FUNCTION CMUMPS_542(INODE) + INTEGER INODE + INTEGER NFRONT,NELIM,i,LEVEL + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + DOUBLE PRECISION COST + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + NFRONT = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253) + LEVEL = MUMPS_330( PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS ) + COST=dble(0) + CALL MUMPS_511(NFRONT,NELIM,NELIM, + & KEEP_LOAD(50),LEVEL,COST) + CMUMPS_542=COST + RETURN + END FUNCTION CMUMPS_542 + INTEGER FUNCTION CMUMPS_541( INODE ) + IMPLICIT NONE + INTEGER INODE,NELIM,NFR,SON,IN,i + INTEGER COST_CB + COST_CB=0 + i = INODE + 10 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 10 + ENDIF + SON=-i + DO i=1, NE_LOAD(STEP_LOAD(INODE)) + NFR = ND_LOAD( STEP_LOAD(SON) ) + KEEP_LOAD(253) + IN=SON + NELIM = 0 + 20 CONTINUE + IF ( IN > 0 ) THEN + NELIM = NELIM + 1 + IN = FILS_LOAD(IN) + GOTO 20 + ENDIF + COST_CB=COST_CB+((NFR-NELIM)*(NFR-NELIM)) + SON=FRERE_LOAD(STEP_LOAD(SON)) + ENDDO + CMUMPS_541=COST_CB + RETURN + END FUNCTION CMUMPS_541 + SUBROUTINE CMUMPS_533(SLAVEF,NMB_OF_CAND, + & TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, + & NSLAVES,INODE) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER, INTENT (IN) :: SLAVEF, NASS, NSLAVES + INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2) + INTEGER, intent(in) :: NMB_OF_CAND + INTEGER, INTENT (IN) :: LIST_SLAVES( NMB_OF_CAND ) + INTEGER KEEP(500),INODE + INTEGER(8) KEEP8(150) + INTEGER allocok + DOUBLE PRECISION MEM_COST,FCT_COST + DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE ::EMPTY_ARRAY, + & DELTA_MD,EMPTY_ARRAY2 + INTEGER NBROWS_SLAVE,i,WHAT,IERR,NPROCS_LOC + LOGICAL FORCE_CAND + MEM_COST=dble(0) + FCT_COST=dble(0) + IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN + FORCE_CAND = .FALSE. + NPROCS_LOC=SLAVEF-1 + ELSE + FORCE_CAND = (mod(KEEP(24),2).eq.0) + NPROCS_LOC=NMB_OF_CAND + END IF + IF(FORCE_CAND)THEN + CALL CMUMPS_540(INODE,FCT_COST, + & MEM_COST,NPROCS_LOC,NASS) + ELSE + CALL CMUMPS_540(INODE,FCT_COST, + & MEM_COST,SLAVEF-1,NASS) + ENDIF + DO i=1,SLAVEF + IDWLOAD(i)=i-1 + ENDDO + ALLOCATE(EMPTY_ARRAY(NPROCS_LOC),DELTA_MD(NPROCS_LOC), + & EMPTY_ARRAY2(NPROCS_LOC), + & stat=allocok) + DO i = 1, NSLAVES + NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i) + DELTA_MD( i ) = FCT_COST - dble(NBROWS_SLAVE)* + & dble(NASS) + END DO + IF(FORCE_CAND)THEN + DO i=NSLAVES+1,NPROCS_LOC + DELTA_MD( i ) = FCT_COST + ENDDO + ELSE + DO i=NSLAVES+1,SLAVEF-1 + DELTA_MD( i ) = FCT_COST + ENDDO + ENDIF + WHAT=7 + 111 CONTINUE + CALL CMUMPS_524(.FALSE., COMM_LD, MYID, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & NPROCS_LOC, LIST_SLAVES,0, + & EMPTY_ARRAY, + & DELTA_MD,EMPTY_ARRAY2,WHAT, IERR) + IF ( IERR == -1 ) THEN + CALL CMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in CMUMPS_533", + & IERR + CALL MUMPS_ABORT() + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (FUTURE_NIV2(MYID+1) .NE. 0) THEN +#endif + DO i = 1, NSLAVES + MD_MEM(LIST_SLAVES(i))=MD_MEM(LIST_SLAVES(i))+ + & int(DELTA_MD( i ),8) +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(LIST_SLAVES(i)+1).EQ.0)THEN + MD_MEM(LIST_SLAVES(i))=999999999_8 + ENDIF +#endif + ENDDO +#if ! defined(OLD_LOAD_MECHANISM) + ENDIF +#endif + DEALLOCATE(EMPTY_ARRAY) + DEALLOCATE(DELTA_MD) + END SUBROUTINE CMUMPS_533 + SUBROUTINE CMUMPS_540(INODE,FCT_COST, + & MEM_COST,NSLAVES,NELIM) + IMPLICIT NONE + INTEGER INODE,NSLAVES,NFR,NELIM,IN + DOUBLE PRECISION MEM_COST,FCT_COST + NFR=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253) + IN = INODE + FCT_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)* + & dble(NELIM) + MEM_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)* + & dble(NFR) + END SUBROUTINE CMUMPS_540 + SUBROUTINE CMUMPS_819(INODE) + IMPLICIT NONE + INTEGER INODE + INTEGER i,J,SON,NSLAVES_TEMP,POS_TEMP,K + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + IF((INODE.LT.0).OR.(INODE.GT.N_LOAD))THEN + RETURN + ENDIF + IF(POS_ID.GT.1)THEN + i=INODE + 10 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 10 + ENDIF + SON=-i + IF(POS_ID.LT.NE_LOAD(STEP_LOAD(INODE))*3)THEN + i=1 + ENDIF + DO i=1, NE_LOAD(STEP_LOAD(INODE)) + J=1 + DO WHILE (J.LT.POS_ID) + IF(CB_COST_ID(J).EQ.SON)GOTO 295 + J=J+3 + ENDDO + 295 CONTINUE + IF(J.GE.POS_ID)THEN + IF(MUMPS_275( + & PROCNODE_LOAD(STEP_LOAD(INODE)),NPROCS).EQ.MYID)THEN + IF(INODE.EQ.KEEP_LOAD(38))THEN + GOTO 666 +#if ! defined(OLD_LOAD_MECHANISM) + ELSE + IF(FUTURE_NIV2(MYID+1).NE.0)THEN + WRITE(*,*)MYID,': i did not find ',SON + CALL MUMPS_ABORT() + ENDIF + GOTO 666 +#endif + ENDIF + ELSE + GOTO 666 + ENDIF + ENDIF + NSLAVES_TEMP=CB_COST_ID(J+1) + POS_TEMP=CB_COST_ID(J+2) + DO K=J,POS_ID-1 + CB_COST_ID(K)=CB_COST_ID(K+3) + ENDDO + K=POS_TEMP + DO WHILE (K.LE.POS_MEM-1) + CB_COST_MEM(K)=CB_COST_MEM(K+2*NSLAVES_TEMP) + K=K+1 + ENDDO + POS_MEM=POS_MEM-2*NSLAVES_TEMP + POS_ID=POS_ID-3 + IF((POS_MEM.LT.1).OR.(POS_ID.LT.1))THEN + WRITE(*,*)MYID,': negative pos_mem or pos_id' + CALL MUMPS_ABORT() + ENDIF + 666 CONTINUE + SON=FRERE_LOAD(STEP_LOAD(SON)) + ENDDO + ENDIF + END SUBROUTINE CMUMPS_819 + SUBROUTINE CMUMPS_820(FLAG) + IMPLICIT NONE + LOGICAL FLAG + INTEGER i + DOUBLE PRECISION MEM + FLAG=.FALSE. + DO i=0,NPROCS-1 + MEM=DM_MEM(i)+LU_USAGE(i) + IF(BDC_SBTR)THEN + MEM=MEM+SBTR_MEM(i)-SBTR_CUR(i) + ENDIF + IF((MEM/dble(TAB_MAXS(i))).GT.0.8d0)THEN + FLAG=.TRUE. + GOTO 666 + ENDIF + ENDDO + 666 CONTINUE + END SUBROUTINE CMUMPS_820 + SUBROUTINE CMUMPS_554(NBINSUBTREE,INSUBTREE,NBTOP, + & MIN_COST,SBTR) + IMPLICIT NONE + INTEGER NBINSUBTREE,INSUBTREE,NBTOP + DOUBLE PRECISION MIN_COST + LOGICAL SBTR + INTEGER i + DOUBLE PRECISION TMP_COST,TMP_MIN + TMP_MIN=huge(TMP_MIN) + DO i=0,NPROCS-1 + IF(i.NE.MYID)THEN + IF(BDC_SBTR)THEN + TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))-(DM_MEM(i)+ + & LU_USAGE(i))-(SBTR_MEM(i)-SBTR_CUR(i))) + ELSE + TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))- + & (DM_MEM(i)+LU_USAGE(i))) + ENDIF + ENDIF + ENDDO + IF(NBINSUBTREE.GT.0)THEN + IF(INSUBTREE.EQ.1)THEN + TMP_COST=dble(TAB_MAXS(MYID))-(DM_MEM(MYID)+ + & LU_USAGE(MYID)) + & -(SBTR_MEM(MYID)-SBTR_CUR(MYID)) + ELSE + SBTR=.FALSE. + GOTO 777 + ENDIF + ENDIF + TMP_MIN=min(TMP_COST,TMP_MIN) + IF(TMP_MIN.GT.MIN_COST) SBTR=.TRUE. + 777 CONTINUE + END SUBROUTINE CMUMPS_554 + SUBROUTINE CMUMPS_818(INODE,MAX_MEM,PROC) + IMPLICIT NONE + INTEGER INODE,PROC + INTEGER i,POS,NSLAVES,SLAVE,NCAND,J,NELIM,NCB,NFRONT,SON,K + INTEGER allocok + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + DOUBLE PRECISION MAX_MEM + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: MEM_ON_PROCS, + & RECV_BUF + LOGICAL, DIMENSION(:), ALLOCATABLE :: CONCERNED + DOUBLE PRECISION MAX_SENT_MSG +#if defined(NOT_ATM_POOL_SPECIAL) + DOUBLE PRECISION TMP +#endif + IF((FRERE_LOAD(STEP_LOAD(INODE)).EQ.0) + & .AND.(INODE.EQ.KEEP_LOAD(38)))THEN + RETURN + ENDIF +#if defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.LT.0).OR.(INODE.GT.N_LOAD))THEN + MAX_MEM=huge(MAX_MEM) + DO i=0,NPROCS-1 + TMP=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i)) + IF(BDC_SBTR)THEN + TMP=TMP-(SBTR_MEM(i)-SBTR_CUR(i)) + ENDIF + MAX_MEM=min(MAX_MEM,TMP) + ENDDO + RETURN + ENDIF +#endif + ALLOCATE( MEM_ON_PROCS(0:NPROCS-1), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_818' + CALL MUMPS_ABORT() + ENDIF + ALLOCATE( CONCERNED(0:NPROCS-1), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_818' + CALL MUMPS_ABORT() + ENDIF + ALLOCATE( RECV_BUF(0:NPROCS-1), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in CMUMPS_818' + CALL MUMPS_ABORT() + ENDIF + RECV_BUF=dble(0) + MAX_SENT_MSG=dble(0) + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + SON=-i + NFRONT=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253) + NCB=NFRONT-NELIM + IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), + & NPROCS).EQ.2)THEN + NCAND=CAND_LOAD(NPROCS+1, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE))) + ENDIF + DO i=0,NPROCS-1 + IF(i.EQ.MYID)THEN + MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+ + & LU_USAGE(i)+ + & CMUMPS_543(INODE)) + IF(BDC_SBTR)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i)) + ENDIF + CONCERNED(i)=.TRUE. + ELSE + MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i)) + IF(BDC_SBTR)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i)) + ENDIF + IF(BDC_M2_MEM)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-NIV2(i+1) + ENDIF + ENDIF + IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), + & NPROCS).EQ.2)THEN + IF(BDC_MD.AND.(KEEP_LOAD(48).EQ.5))THEN + DO J=1,NCAND + IF(CAND_LOAD(J, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE))) + & .EQ.i)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)- + & ((dble(NFRONT)*dble(NCB))/dble(NCAND)) + CONCERNED(i)=.TRUE. + GOTO 666 + ENDIF + ENDDO + ENDIF + ENDIF + 666 CONTINUE + ENDDO + DO K=1, NE_LOAD(STEP_LOAD(INODE)) + i=1 + DO WHILE (i.LE.POS_ID) + IF(CB_COST_ID(i).EQ.SON)GOTO 295 + i=i+3 + ENDDO + 295 CONTINUE + IF(i.GE.POS_ID)THEN +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(MYID+1).NE.0)THEN + WRITE(*,*)MYID,': ',SON,'has not been found + & in CMUMPS_818' + CALL MUMPS_ABORT() + ENDIF +#endif + GOTO 777 + ENDIF + NSLAVES=CB_COST_ID(i+1) + POS=CB_COST_ID(i+2) + DO i=1,NSLAVES + SLAVE=int(CB_COST_MEM(POS)) + IF(.NOT.CONCERNED(SLAVE))THEN + MEM_ON_PROCS(SLAVE)=MEM_ON_PROCS(SLAVE)+ + & dble(CB_COST_MEM(POS+1)) + ENDIF + DO J=0,NPROCS-1 + IF(CONCERNED(J))THEN + IF(SLAVE.NE.J)THEN + RECV_BUF(J)=max(RECV_BUF(J), + & dble(CB_COST_MEM(POS+1))) + ENDIF + ENDIF + ENDDO + POS=POS+2 + ENDDO + 777 CONTINUE + SON=FRERE_LOAD(STEP_LOAD(SON)) + ENDDO + MAX_MEM=huge(MAX_MEM) + WRITE(*,*)'NPROCS=',NPROCS,MAX_MEM + DO i=0,NPROCS-1 + IF(MAX_MEM.GT.MEM_ON_PROCS(i))THEN + PROC=i + ENDIF + MAX_MEM=min(MEM_ON_PROCS(i),MAX_MEM) + ENDDO + DEALLOCATE(MEM_ON_PROCS) + DEALLOCATE(CONCERNED) + DEALLOCATE(RECV_BUF) + END SUBROUTINE CMUMPS_818 + SUBROUTINE CMUMPS_553(MIN_PROC,POOL, + & LPOOL,INODE) + IMPLICIT NONE + INTEGER INODE,LPOOL,MIN_PROC + INTEGER POOL(LPOOL) + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + INTEGER i,NBTOP,INSUBTREE,NBINSUBTREE,NODE,FATHER,SON,J + INTEGER SBTR_NB_LEAF,POS,K,allocok,L + INTEGER, ALLOCATABLE, DIMENSION (:) :: TMP_SBTR + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + IF((KEEP_LOAD(47).EQ.4).AND. + & ((NBINSUBTREE.NE.0)))THEN + DO J=INDICE_SBTR,NB_SUBTREES + NODE=MY_ROOT_SBTR(J) + FATHER=DAD_LOAD(STEP_LOAD(NODE)) + i=FATHER + 110 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 110 + ENDIF + SON=-i + i=SON + 120 CONTINUE + IF ( i > 0 ) THEN + IF(MUMPS_275(PROCNODE_LOAD(STEP_LOAD(i)),NPROCS).EQ. + & MIN_PROC)THEN + SBTR_NB_LEAF=MY_NB_LEAF(J) + POS=SBTR_FIRST_POS_IN_POOL(J) + IF(POOL(POS+SBTR_NB_LEAF).NE.MY_FIRST_LEAF(J))THEN + WRITE(*,*)MYID,': The first leaf is not ok' + CALL MUMPS_ABORT() + ENDIF + ALLOCATE (TMP_SBTR(SBTR_NB_LEAF), stat=allocok) + IF (allocok > 0 ) THEN + WRITE(*,*)MYID,': Not enough space + & for allocation' + CALL MUMPS_ABORT() + ENDIF + POS=SBTR_FIRST_POS_IN_POOL(J) + DO K=1,SBTR_NB_LEAF + TMP_SBTR(K)=POOL(POS+K-1) + ENDDO + DO K=POS+1,NBINSUBTREE-SBTR_NB_LEAF + POOL(K)=POOL(K+SBTR_NB_LEAF) + ENDDO + POS=1 + DO K=NBINSUBTREE-SBTR_NB_LEAF+1,NBINSUBTREE + POOL(K)=TMP_SBTR(POS) + POS=POS+1 + ENDDO + DO K=INDICE_SBTR,J + SBTR_FIRST_POS_IN_POOL(K)=SBTR_FIRST_POS_IN_POOL(K) + & -SBTR_FIRST_POS_IN_POOL(J) + ENDDO + SBTR_FIRST_POS_IN_POOL(J)=NBINSUBTREE-SBTR_NB_LEAF + POS=MY_FIRST_LEAF(J) + L=MY_NB_LEAF(J) + DO K=INDICE_SBTR,J + MY_FIRST_LEAF(J)=MY_FIRST_LEAF(J+1) + MY_NB_LEAF(J)=MY_NB_LEAF(J+1) + ENDDO + MY_FIRST_LEAF(INDICE_SBTR)=POS + MY_NB_LEAF(INDICE_SBTR)=L + INODE=POOL(NBINSUBTREE) + DEALLOCATE(TMP_SBTR) + RETURN + ENDIF + i = FRERE_LOAD(STEP_LOAD(i)) + GOTO 120 + ENDIF + ENDDO + ENDIF + DO J=NBTOP,1,-1 +#if defined(NOT_ATM_POOL_SPECIAL) + IF ( POOL(LPOOL-2-J) < 0 ) THEN + NODE=-POOL(LPOOL-2-J) + ELSE IF ( POOL(LPOOL-2-J) > N_LOAD ) THEN + NODE = POOL(LPOOL-2-J) - N_LOAD + ELSE + NODE = POOL(LPOOL-2-J) + ENDIF +#else + NODE=POOL(LPOOL-2-J) +#endif + FATHER=DAD_LOAD(STEP_LOAD(NODE)) + i=FATHER + 11 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 11 + ENDIF + SON=-i + i=SON + 12 CONTINUE + IF ( i > 0 ) THEN + IF(MUMPS_275(PROCNODE_LOAD(STEP_LOAD(i)),NPROCS).EQ. + & MIN_PROC)THEN + INODE=NODE + RETURN + ENDIF + i = FRERE_LOAD(STEP_LOAD(i)) + GOTO 12 + ENDIF + ENDDO + END SUBROUTINE CMUMPS_553 + SUBROUTINE CMUMPS_555(POOL, LPOOL,KEEP,KEEP8) + IMPLICIT NONE + INTEGER LPOOL,POOL(LPOOL),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER i,POS + EXTERNAL MUMPS_283 + LOGICAL MUMPS_283 + IF(.NOT.BDC_SBTR) RETURN + POS=0 + DO i=NB_SUBTREES,1,-1 + DO WHILE(MUMPS_283( + & PROCNODE_LOAD(STEP_LOAD(POOL(POS+1))), + & NPROCS)) + POS=POS+1 + ENDDO + SBTR_FIRST_POS_IN_POOL(i)=POS+1 + POS=POS+MY_NB_LEAF(i) + ENDDO + END SUBROUTINE CMUMPS_555 + END MODULE CMUMPS_LOAD diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_ooc.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_ooc.F new file mode 100644 index 000000000..4ccf49016 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_ooc.F @@ -0,0 +1,3501 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE CMUMPS_OOC + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NOT_IN_MEM,BEING_READ,NOT_USED,PERMUTED,USED, + & USED_NOT_PERMUTED,ALREADY_USED + PARAMETER (NOT_IN_MEM=0,BEING_READ=-1,NOT_USED=-2, + & PERMUTED=-3,USED=-4,USED_NOT_PERMUTED=-5,ALREADY_USED=-6) + INTEGER OOC_NODE_NOT_IN_MEM,OOC_NODE_PERMUTED, + & OOC_NODE_NOT_PERMUTED + PARAMETER (OOC_NODE_NOT_IN_MEM=-20, + & OOC_NODE_PERMUTED=-21,OOC_NODE_NOT_PERMUTED=-22) + INTEGER(8), DIMENSION(:,:),POINTER :: SIZE_OF_BLOCK + INTEGER, DIMENSION(:),POINTER :: TOTAL_NB_OOC_NODES + INTEGER :: OOC_SOLVE_TYPE_FCT + INTEGER, DIMENSION(:),ALLOCATABLE :: IO_REQ + INTEGER(8), DIMENSION(:), ALLOCATABLE:: LRLUS_SOLVE + INTEGER(8), DIMENSION(:), ALLOCATABLE:: SIZE_SOLVE_Z, + & LRLU_SOLVE_T, POSFAC_SOLVE, IDEB_SOLVE_Z, LRLU_SOLVE_B + INTEGER, DIMENSION(:),ALLOCATABLE :: PDEB_SOLVE_Z + INTEGER (8),SAVE :: FACT_AREA_SIZE, + & SIZE_ZONE_SOLVE,SIZE_SOLVE_EMM,TMP_SIZE_FACT, + & MAX_SIZE_FACTOR_OOC + INTEGER(8), SAVE :: MIN_SIZE_READ + INTEGER, SAVE :: TMP_NB_NODES, MAX_NB_NODES_FOR_ZONE,MAX_NB_REQ, + & CURRENT_SOLVE_READ_ZONE, + & CUR_POS_SEQUENCE,NB_Z,SOLVE_STEP, + & NB_ZONE_REQ,MTYPE_OOC,NB_ACT +#if defined (NEW_PREF_SCHEME) + INTEGER,SAVE :: MAX_PREF_SIZE +#endif + & ,NB_CALLED,REQ_ACT,NB_CALL + INTEGER(8), SAVE :: OOC_VADDR_PTR + INTEGER(8), SAVE :: SIZE_ZONE_REQ + DOUBLE PRECISION,SAVE :: MAX_OOC_FILE_SIZE + INTEGER(8), DIMENSION(:), ALLOCATABLE :: SIZE_OF_READ, READ_DEST + INTEGER,DIMENSION(:),ALLOCATABLE :: FIRST_POS_IN_READ, + & READ_MNG,REQ_TO_ZONE,POS_HOLE_T, + & POS_HOLE_B,REQ_ID,OOC_STATE_NODE + INTEGER CMUMPS_ELEMENTARY_DATA_SIZE,N_OOC + INTEGER, DIMENSION(:), ALLOCATABLE :: POS_IN_MEM, INODE_TO_POS + INTEGER, DIMENSION(:), ALLOCATABLE :: CURRENT_POS_T,CURRENT_POS_B + LOGICAL IS_ROOT_SPECIAL + INTEGER SPECIAL_ROOT_NODE + PUBLIC :: CMUMPS_575,CMUMPS_576, + & CMUMPS_577, + & CMUMPS_578, + & CMUMPS_579, + & CMUMPS_582, + & CMUMPS_583,CMUMPS_584, + & CMUMPS_585,CMUMPS_586 + INTEGER, PARAMETER, PUBLIC :: TYPEF_BOTH_LU = -99976 + PUBLIC CMUMPS_688, + & CMUMPS_690 + PRIVATE CMUMPS_695, + & CMUMPS_697 + CONTAINS + SUBROUTINE CMUMPS_711( STRAT_IO_ARG, + & STRAT_IO_ASYNC_ARG, WITH_BUF_ARG, LOW_LEVEL_STRAT_IO_ARG ) + IMPLICIT NONE + INTEGER, intent(out) :: LOW_LEVEL_STRAT_IO_ARG + LOGICAL, intent(out) :: STRAT_IO_ASYNC_ARG, WITH_BUF_ARG + INTEGER, intent(in) :: STRAT_IO_ARG + INTEGER TMP + CALL MUMPS_OOC_IS_ASYNC_AVAIL(TMP) + STRAT_IO_ASYNC_ARG=.FALSE. + WITH_BUF_ARG=.FALSE. + IF(TMP.EQ.1)THEN + IF((STRAT_IO_ARG.EQ.1).OR.(STRAT_IO_ARG.EQ.2))THEN + STRAT_IO_ASYNC=.TRUE. + WITH_BUF=.FALSE. + ELSEIF((STRAT_IO_ARG.EQ.4).OR.(STRAT_IO_ARG.EQ.5))THEN + STRAT_IO_ASYNC_ARG=.TRUE. + WITH_BUF_ARG=.TRUE. + ELSEIF(STRAT_IO_ARG.EQ.3)THEN + STRAT_IO_ASYNC_ARG=.FALSE. + WITH_BUF_ARG=.TRUE. + ENDIF + LOW_LEVEL_STRAT_IO_ARG=mod(STRAT_IO_ARG,3) + ELSE + LOW_LEVEL_STRAT_IO_ARG=0 + IF(STRAT_IO_ARG.GE.3)THEN + WITH_BUF_ARG=.TRUE. + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_711 + FUNCTION CMUMPS_579(INODE,ZONE) + IMPLICIT NONE + INTEGER INODE,ZONE + LOGICAL CMUMPS_579 + CMUMPS_579=(LRLUS_SOLVE(ZONE).GE. + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) + RETURN + END FUNCTION CMUMPS_579 + SUBROUTINE CMUMPS_590(LA) + IMPLICIT NONE + INTEGER(8) :: LA + FACT_AREA_SIZE=LA + END SUBROUTINE CMUMPS_590 + SUBROUTINE CMUMPS_575(id, MAXS) + USE CMUMPS_STRUC_DEF + USE CMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER TMPDIR_MAX_LENGTH, PREFIX_MAX_LENGTH + PARAMETER (TMPDIR_MAX_LENGTH=255, PREFIX_MAX_LENGTH=63) + INTEGER(8), intent(in) :: MAXS + TYPE(CMUMPS_STRUC), TARGET :: id + INTEGER IERR + INTEGER allocok + INTEGER ASYNC + CHARACTER*1 TMP_DIR(TMPDIR_MAX_LENGTH), + & TMP_PREFIX(PREFIX_MAX_LENGTH) + INTEGER DIM_DIR,DIM_PREFIX + INTEGER, DIMENSION(:), ALLOCATABLE :: FILE_FLAG_TAB + INTEGER TMP + INTEGER K211_LOC + ICNTL1=id%ICNTL(1) + MAX_SIZE_FACTOR_OOC=0_8 + N_OOC=id%N + ASYNC=0 + SOLVE=.FALSE. + IERR=0 + IF(allocated(IO_REQ))THEN + DEALLOCATE(IO_REQ) + ENDIF + IF(associated(KEEP_OOC))THEN + NULLIFY(KEEP_OOC) + ENDIF + IF(associated(STEP_OOC))THEN + NULLIFY(STEP_OOC) + ENDIF + IF(associated(PROCNODE_OOC))THEN + NULLIFY(PROCNODE_OOC) + ENDIF + IF(associated(OOC_INODE_SEQUENCE))THEN + NULLIFY(OOC_INODE_SEQUENCE) + ENDIF + IF(associated(TOTAL_NB_OOC_NODES))THEN + NULLIFY(TOTAL_NB_OOC_NODES) + ENDIF + IF(associated(SIZE_OF_BLOCK))THEN + NULLIFY(SIZE_OF_BLOCK) + ENDIF + IF(associated(OOC_VADDR))THEN + NULLIFY(OOC_VADDR) + ENDIF + IF(allocated(I_CUR_HBUF_NEXTPOS))THEN + DEALLOCATE(I_CUR_HBUF_NEXTPOS) + ENDIF + CALL CMUMPS_588(id,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 > 0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1) = IERR + id%INFO(2) = 0 + RETURN + ENDIF + CALL MUMPS_796(TYPEF_L, TYPEF_U, TYPEF_CB, + & id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID ) + IF (id%KEEP(201).EQ.2) THEN + OOC_FCT_TYPE=1 + ENDIF + STEP_OOC=>id%STEP + PROCNODE_OOC=>id%PROCNODE_STEPS + MYID_OOC=id%MYID + SLAVEF_OOC=id%NSLAVES + KEEP_OOC => id%KEEP + SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK + OOC_VADDR=>id%OOC_VADDR + IF(id%KEEP(107).GT.0)THEN + SIZE_SOLVE_EMM=max(id%KEEP8(19),int(dble(MAXS)* + & 0.9d0*0.2d0,8)) + SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM, + & int((dble(MAXS)*0.9d0- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)) + IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN + SIZE_SOLVE_EMM=id%KEEP8(19) + SIZE_ZONE_SOLVE=int((dble(MAXS)*0.9d0- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8) + ENDIF + ELSE + SIZE_ZONE_SOLVE=int(dble(MAXS)*0.9d0,8) + SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE + ENDIF + CMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35) + SIZE_OF_BLOCK=0_8 + ALLOCATE(id%OOC_NB_FILES(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + id%OOC_NB_FILES=0 + OOC_VADDR_PTR=0_8 + CALL CMUMPS_711( id%KEEP(99), STRAT_IO_ASYNC, + & WITH_BUF, LOW_LEVEL_STRAT_IO ) + TMP_SIZE_FACT=0_8 + TMP_NB_NODES=0 + MAX_NB_NODES_FOR_ZONE=0 + OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE + ALLOCATE(I_CUR_HBUF_NEXTPOS(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + I_CUR_HBUF_NEXTPOS = 1 + IF(WITH_BUF)THEN + CALL CMUMPS_669(id%INFO(1),id%INFO(2),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + IF(STRAT_IO_ASYNC)THEN + ASYNC=1 + ENDIF + DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN + CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC) + DIM_DIR=len(trim(id%OOC_TMPDIR)) + DIM_PREFIX=len(trim(id%OOC_PREFIX)) + CALL CMUMPS_589(TMP_DIR(1), + & id%OOC_TMPDIR, TMPDIR_MAX_LENGTH, DIM_DIR ) + CALL CMUMPS_589(TMP_PREFIX(1), + & id%OOC_PREFIX, PREFIX_MAX_LENGTH, DIM_PREFIX) + CALL MUMPS_LOW_LEVEL_INIT_PREFIX(DIM_PREFIX, TMP_PREFIX) + CALL MUMPS_LOW_LEVEL_INIT_TMPDIR(DIM_DIR, TMP_DIR) + ALLOCATE(FILE_FLAG_TAB(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1 .GT. 0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + FILE_FLAG_TAB(1:OOC_NB_FILE_TYPE)=0 + IERR=0 + TMP=int(id%KEEP8(11)/1000000_8,kind=4)+1 + IF((id%KEEP(201).EQ.1).AND.(id%KEEP(50).EQ.0) + & ) THEN + TMP=max(1,TMP/2) + ENDIF + CALL MUMPS_LOW_LEVEL_INIT_OOC_C(MYID_OOC,TMP, + & id%KEEP(35),LOW_LEVEL_STRAT_IO,K211_LOC,OOC_NB_FILE_TYPE, + & FILE_FLAG_TAB,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0 ) THEN + WRITE(ICNTL1,*)MYID_OOC,': PB in MUMPS_LOW_LEVEL_INIT_OOC_C' + WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + ENDIF + id%INFO(1) = IERR + id%INFO(2) = 0 + RETURN + ENDIF + CALL MUMPS_GET_MAX_FILE_SIZE_C(MAX_OOC_FILE_SIZE) + DEALLOCATE(FILE_FLAG_TAB) + RETURN + END SUBROUTINE CMUMPS_575 + SUBROUTINE CMUMPS_576(INODE,PTRFAC,KEEP,KEEP8, + & A,LA,SIZE,IERR) + USE CMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER(8) :: LA + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)), SIZE + COMPLEX A(LA) + INTEGER IERR,NODE,ASYNC,REQUEST + LOGICAL IO_C + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER TYPE + INTEGER SIZE_INT1,SIZE_INT2 + TYPE=FCT + IF(STRAT_IO_ASYNC)THEN + ASYNC=1 + ELSE + ASYNC=0 + ENDIF + IERR=0 + IO_C=.TRUE. + SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)=SIZE + MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,SIZE) + OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)=OOC_VADDR_PTR + OOC_VADDR_PTR=OOC_VADDR_PTR+SIZE + TMP_SIZE_FACT=TMP_SIZE_FACT+SIZE + TMP_NB_NODES=TMP_NB_NODES+1 + IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN + MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE,TMP_NB_NODES) + TMP_SIZE_FACT=0_8 + TMP_NB_NODES=0 + ENDIF + IF (.NOT. WITH_BUF) THEN + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, + & A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN + WRITE(*,*)MYID_OOC,': Internal error (37) in OOC ' + CALL MUMPS_ABORT() + ENDIF + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), + & OOC_FCT_TYPE)=INODE + I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)= + & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1 + ELSE + IF(SIZE.LE.HBUF_SIZE)THEN + CALL CMUMPS_678 + & (A(PTRFAC(STEP_OOC(INODE))),SIZE,IERR) + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), + & OOC_FCT_TYPE) = INODE + I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) = + & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) + 1 +#if ! defined (OOC_DEBUG) + PTRFAC(STEP_OOC(INODE))=-777777_8 +#endif + RETURN + ELSE + CALL CMUMPS_707(OOC_FCT_TYPE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL CMUMPS_707(OOC_FCT_TYPE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, + & A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(*,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN + WRITE(*,*)MYID_OOC,': Internal error (38) in OOC ' + CALL MUMPS_ABORT() + ENDIF + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), + & OOC_FCT_TYPE)=INODE + I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)= + & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1 + CALL CMUMPS_689(OOC_FCT_TYPE) + ENDIF + END IF + NODE=-9999 +#if ! defined (OOC_DEBUG) + PTRFAC(STEP_OOC(INODE))=-777777_8 +#endif + IF(STRAT_IO_ASYNC)THEN + IERR=0 + CALL MUMPS_WAIT_REQUEST(REQUEST,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_576 + SUBROUTINE CMUMPS_577(DEST,INODE,IERR + & ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR,INODE + COMPLEX DEST + INTEGER ASYNC + LOGICAL IO_C +#if defined(OLD_READ) + INTEGER REQUEST +#endif + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER TYPE + INTEGER SIZE_INT1,SIZE_INT2 + TYPE=OOC_SOLVE_TYPE_FCT + IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + & .EQ.0_8)THEN + GOTO 555 + ENDIF + IF(STRAT_IO_ASYNC)THEN + ASYNC=1 + ELSE + ASYNC=0 + ENDIF + IERR=0 + IO_C=.TRUE. +#if ! defined(OLD_READ) + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_LOW_LEVEL_DIRECT_READ(DEST, + & SIZE_INT1,SIZE_INT2, + & TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) THEN + WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + WRITE(ICNTL1,*)MYID_OOC, + & ': Problem in MUMPS_LOW_LEVEL_DIRECT_READ' + ENDIF + RETURN + ENDIF +#else + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO, + & DEST,SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0 ) THEN + WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + WRITE(ICNTL1,*)MYID_OOC, + & ': Problem in MUMPS_LOW_LEVEL_READ_OOC' + ENDIF + RETURN + ENDIF + IF(STRAT_IO_ASYNC)THEN + IERR=0 + CALL MUMPS_WAIT_REQUEST(REQUEST,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0 ) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + ENDIF +#endif + 555 CONTINUE + IF(.NOT.CMUMPS_727())THEN + IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ. + & INODE)THEN + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ELSEIF(SOLVE_STEP.EQ.1)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + CALL CMUMPS_728() + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_577 + SUBROUTINE CMUMPS_591(IERR) + USE CMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, intent(out):: IERR + IERR=0 + IF (WITH_BUF) THEN + CALL CMUMPS_675(IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + END IF + RETURN + END SUBROUTINE CMUMPS_591 + SUBROUTINE CMUMPS_592(id,IERR) + USE CMUMPS_OOC_BUFFER + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(CMUMPS_STRUC), TARGET :: id + INTEGER, intent(out) :: IERR + INTEGER I,SOLVE_OR_FACTO + IERR=0 + IF(WITH_BUF)THEN + CALL CMUMPS_659() + ENDIF + IF(associated(KEEP_OOC))THEN + NULLIFY(KEEP_OOC) + ENDIF + IF(associated(STEP_OOC))THEN + NULLIFY(STEP_OOC) + ENDIF + IF(associated(PROCNODE_OOC))THEN + NULLIFY(PROCNODE_OOC) + ENDIF + IF(associated(OOC_INODE_SEQUENCE))THEN + NULLIFY(OOC_INODE_SEQUENCE) + ENDIF + IF(associated(TOTAL_NB_OOC_NODES))THEN + NULLIFY(TOTAL_NB_OOC_NODES) + ENDIF + IF(associated(SIZE_OF_BLOCK))THEN + NULLIFY(SIZE_OF_BLOCK) + ENDIF + IF(associated(OOC_VADDR))THEN + NULLIFY(OOC_VADDR) + ENDIF + CALL MUMPS_OOC_END_WRITE_C(IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + GOTO 500 + ENDIF + id%OOC_MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE, + & TMP_NB_NODES) + IF(allocated(I_CUR_HBUF_NEXTPOS))THEN + DO I=1,OOC_NB_FILE_TYPE + id%OOC_TOTAL_NB_NODES(I)=I_CUR_HBUF_NEXTPOS(I)-1 + ENDDO + DEALLOCATE(I_CUR_HBUF_NEXTPOS) + ENDIF + id%KEEP8(20)=MAX_SIZE_FACTOR_OOC + CALL CMUMPS_613(id,IERR) + IF(IERR.LT.0)THEN + GOTO 500 + ENDIF + 500 CONTINUE + SOLVE_OR_FACTO=0 + CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + RETURN + END SUBROUTINE CMUMPS_592 + SUBROUTINE CMUMPS_588(id,IERR) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + EXTERNAL MUMPS_OOC_REMOVE_FILE_C + TYPE(CMUMPS_STRUC), TARGET :: id + INTEGER IERR + INTEGER I,J,I1,K + CHARACTER*1 TMP_NAME(350) + IERR=0 + K=1 + IF(associated(id%OOC_FILE_NAMES).AND. + & associated(id%OOC_FILE_NAME_LENGTH))THEN + DO I1=1,OOC_NB_FILE_TYPE + DO I=1,id%OOC_NB_FILES(I1) + DO J=1,id%OOC_FILE_NAME_LENGTH(K) + TMP_NAME(J)=id%OOC_FILE_NAMES(K,J) + ENDDO + CALL MUMPS_OOC_REMOVE_FILE_C(IERR, TMP_NAME(1)) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0)THEN + WRITE(ICNTL1,*)MYID_OOC,': ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + ENDIF + K=K+1 + ENDDO + ENDDO + ENDIF + IF(associated(id%OOC_FILE_NAMES))THEN + DEALLOCATE(id%OOC_FILE_NAMES) + NULLIFY(id%OOC_FILE_NAMES) + ENDIF + IF(associated(id%OOC_FILE_NAME_LENGTH))THEN + DEALLOCATE(id%OOC_FILE_NAME_LENGTH) + NULLIFY(id%OOC_FILE_NAME_LENGTH) + ENDIF + IF(associated(id%OOC_NB_FILES))THEN + DEALLOCATE(id%OOC_NB_FILES) + NULLIFY(id%OOC_NB_FILES) + ENDIF + RETURN + END SUBROUTINE CMUMPS_588 + SUBROUTINE CMUMPS_587(id,IERR) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(CMUMPS_STRUC), TARGET :: id + INTEGER IERR + IERR=0 + CALL CMUMPS_588(id,IERR) + IF(associated(id%OOC_TOTAL_NB_NODES))THEN + DEALLOCATE(id%OOC_TOTAL_NB_NODES) + NULLIFY(id%OOC_TOTAL_NB_NODES) + ENDIF + IF(associated(id%OOC_INODE_SEQUENCE))THEN + DEALLOCATE(id%OOC_INODE_SEQUENCE) + NULLIFY(id%OOC_INODE_SEQUENCE) + ENDIF + IF(associated(id%OOC_SIZE_OF_BLOCK))THEN + DEALLOCATE(id%OOC_SIZE_OF_BLOCK) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + ENDIF + IF(associated(id%OOC_VADDR))THEN + DEALLOCATE(id%OOC_VADDR) + NULLIFY(id%OOC_VADDR) + ENDIF + RETURN + END SUBROUTINE CMUMPS_587 + SUBROUTINE CMUMPS_586(id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(CMUMPS_STRUC), TARGET :: id + INTEGER TMP,I,J + INTEGER(8) :: TMP_SIZE8 + INTEGER allocok,IERR + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + INTEGER MASTER_ROOT + IERR=0 + ICNTL1=id%ICNTL(1) + SOLVE=.TRUE. + N_OOC=id%N + IF(allocated(LRLUS_SOLVE))THEN + DEALLOCATE(LRLUS_SOLVE) + ENDIF + IF(allocated(LRLU_SOLVE_T))THEN + DEALLOCATE(LRLU_SOLVE_T) + ENDIF + IF(allocated(LRLU_SOLVE_B))THEN + DEALLOCATE(LRLU_SOLVE_B) + ENDIF + IF(allocated(POSFAC_SOLVE))THEN + DEALLOCATE(POSFAC_SOLVE) + ENDIF + IF(allocated(IDEB_SOLVE_Z))THEN + DEALLOCATE(IDEB_SOLVE_Z) + ENDIF + IF(allocated(PDEB_SOLVE_Z))THEN + DEALLOCATE(PDEB_SOLVE_Z) + ENDIF + IF(allocated(SIZE_SOLVE_Z))THEN + DEALLOCATE(SIZE_SOLVE_Z) + ENDIF + IF(allocated(CURRENT_POS_T))THEN + DEALLOCATE(CURRENT_POS_T) + ENDIF + IF(allocated(CURRENT_POS_B))THEN + DEALLOCATE(CURRENT_POS_B) + ENDIF + IF(allocated(POS_HOLE_T))THEN + DEALLOCATE(POS_HOLE_T) + ENDIF + IF(allocated(POS_HOLE_B))THEN + DEALLOCATE(POS_HOLE_B) + ENDIF + IF(allocated(OOC_STATE_NODE))THEN + DEALLOCATE(OOC_STATE_NODE) + ENDIF + IF(allocated(POS_IN_MEM))THEN + DEALLOCATE(POS_IN_MEM) + ENDIF + IF(allocated(INODE_TO_POS))THEN + DEALLOCATE(INODE_TO_POS) + ENDIF + IF(allocated(SIZE_OF_READ))THEN + DEALLOCATE(SIZE_OF_READ) + ENDIF + IF(allocated(FIRST_POS_IN_READ))THEN + DEALLOCATE(FIRST_POS_IN_READ) + ENDIF + IF(allocated(READ_DEST))THEN + DEALLOCATE(READ_DEST) + ENDIF + IF(allocated(READ_MNG))THEN + DEALLOCATE(READ_MNG) + ENDIF + IF(allocated(REQ_TO_ZONE))THEN + DEALLOCATE(REQ_TO_ZONE) + ENDIF + IF(allocated(REQ_ID))THEN + DEALLOCATE(REQ_ID) + ENDIF + IF(allocated(IO_REQ))THEN + DEALLOCATE(IO_REQ) + ENDIF + IF(associated(KEEP_OOC))THEN + NULLIFY(KEEP_OOC) + ENDIF + IF(associated(STEP_OOC))THEN + NULLIFY(STEP_OOC) + ENDIF + IF(associated(PROCNODE_OOC))THEN + NULLIFY(PROCNODE_OOC) + ENDIF + IF(associated(TOTAL_NB_OOC_NODES))THEN + NULLIFY(TOTAL_NB_OOC_NODES) + ENDIF + IF(associated(SIZE_OF_BLOCK))THEN + NULLIFY(SIZE_OF_BLOCK) + ENDIF + IF(associated(OOC_INODE_SEQUENCE))THEN + NULLIFY(OOC_VADDR) + ENDIF + CALL MUMPS_796(TYPEF_L, TYPEF_U, TYPEF_CB, + & id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID ) + DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN + CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC) + CALL CMUMPS_614(id) + IF(id%INFO(1).LT.0)THEN + RETURN + ENDIF + STEP_OOC=>id%STEP + PROCNODE_OOC=>id%PROCNODE_STEPS + SLAVEF_OOC=id%NSLAVES + MYID_OOC=id%MYID + KEEP_OOC => id%KEEP + SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK + OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE + OOC_VADDR=>id%OOC_VADDR + ALLOCATE(IO_REQ(id%KEEP(28)), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = id%KEEP(28) + RETURN + ENDIF + CMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35) + MAX_NB_NODES_FOR_ZONE=id%OOC_MAX_NB_NODES_FOR_ZONE + TOTAL_NB_OOC_NODES=>id%OOC_TOTAL_NB_NODES + CALL CMUMPS_711( id%KEEP(204), STRAT_IO_ASYNC, + & WITH_BUF, LOW_LEVEL_STRAT_IO) + IF(id%KEEP(107).GT.0)THEN + SIZE_SOLVE_EMM=max(id%KEEP8(20), + & FACT_AREA_SIZE / 5_8) + SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM, + & int((dble(FACT_AREA_SIZE)- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)) + SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8) + IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN + SIZE_SOLVE_EMM=id%KEEP8(20) + SIZE_ZONE_SOLVE=int((real(FACT_AREA_SIZE)- + & real(SIZE_SOLVE_EMM))/real(id%KEEP(107)),8) + SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8) + ENDIF + ELSE + SIZE_ZONE_SOLVE=FACT_AREA_SIZE + SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE + ENDIF + IF(SIZE_SOLVE_EMM.LT.id%KEEP8(20))THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': More space needed for + & solution step in CMUMPS_586' + id%INFO(1) = -11 + CALL MUMPS_731(id%KEEP8(20), id%INFO(2)) + ENDIF + TMP=MAX_NB_NODES_FOR_ZONE + CALL MPI_ALLREDUCE(TMP,MAX_NB_NODES_FOR_ZONE,1, + & MPI_INTEGER,MPI_MAX,id%COMM_NODES, IERR) + NB_Z=KEEP_OOC(107)+1 + ALLOCATE(POS_IN_MEM(MAX_NB_NODES_FOR_ZONE*NB_Z), + & INODE_TO_POS(KEEP_OOC(28)), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = id%KEEP(28)+(MAX_NB_NODES_FOR_ZONE*NB_Z) + RETURN + ENDIF + ALLOCATE(OOC_STATE_NODE(KEEP_OOC(28)),stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = id%KEEP(28) + RETURN + ENDIF + OOC_STATE_NODE(1:KEEP_OOC(28))=0 + INODE_TO_POS=0 + POS_IN_MEM=0 + ALLOCATE(LRLUS_SOLVE(NB_Z), LRLU_SOLVE_T(NB_Z),LRLU_SOLVE_B(NB_Z), + & POSFAC_SOLVE(NB_Z),IDEB_SOLVE_Z(NB_Z), + & PDEB_SOLVE_Z(NB_Z),SIZE_SOLVE_Z(NB_Z), + & CURRENT_POS_T(NB_Z),CURRENT_POS_B(NB_Z), + & POS_HOLE_T(NB_Z),POS_HOLE_B(NB_Z), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = 9*(NB_Z+1) + RETURN + ENDIF + IERR=0 + CALL MUMPS_GET_MAX_NB_REQ_C(MAX_NB_REQ,IERR) + ALLOCATE(SIZE_OF_READ(MAX_NB_REQ),FIRST_POS_IN_READ(MAX_NB_REQ), + & READ_DEST(MAX_NB_REQ),READ_MNG(MAX_NB_REQ), + & REQ_TO_ZONE(MAX_NB_REQ),REQ_ID(MAX_NB_REQ),stat=allocok) + SIZE_OF_READ=-9999_8 + FIRST_POS_IN_READ=-9999 + READ_DEST=-9999_8 + READ_MNG=-9999 + REQ_TO_ZONE=-9999 + REQ_ID=-9999 + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = 6*(NB_Z+1) + RETURN + ENDIF + MIN_SIZE_READ=min(max((1024_8*1024_8)/int(id%KEEP(35),8), + & SIZE_ZONE_SOLVE/3_8), + & SIZE_ZONE_SOLVE) + TMP_SIZE8=1_8 + J=1 + DO I=1,NB_Z-1 + IDEB_SOLVE_Z(I)=TMP_SIZE8 + POSFAC_SOLVE(I)=TMP_SIZE8 + LRLUS_SOLVE(I)=SIZE_ZONE_SOLVE + LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE + LRLU_SOLVE_B(I)=0_8 + SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE + CURRENT_POS_T(I)=J + CURRENT_POS_B(I)=J + PDEB_SOLVE_Z(I)=J + POS_HOLE_T(I)=J + POS_HOLE_B(I)=J + J=J+MAX_NB_NODES_FOR_ZONE + TMP_SIZE8=TMP_SIZE8+SIZE_ZONE_SOLVE + ENDDO + IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8 + PDEB_SOLVE_Z(NB_Z)=J + POSFAC_SOLVE(NB_Z)=TMP_SIZE8 + LRLUS_SOLVE(NB_Z)=SIZE_SOLVE_EMM + LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM + LRLU_SOLVE_B(NB_Z)=0_8 + SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM + CURRENT_POS_T(NB_Z)=J + CURRENT_POS_B(NB_Z)=J + POS_HOLE_T(NB_Z)=J + POS_HOLE_B(NB_Z)=J + IO_REQ=-77777 + REQ_ACT=0 + OOC_STATE_NODE(1:KEEP_OOC(28))=NOT_IN_MEM + IF(KEEP_OOC(38).NE.0)THEN + MASTER_ROOT=MUMPS_275( + & PROCNODE_OOC(STEP_OOC( KEEP_OOC(38))), + & SLAVEF_OOC ) + SPECIAL_ROOT_NODE=KEEP_OOC(38) + ELSEIF(KEEP_OOC(20).NE.0)THEN + MASTER_ROOT=MUMPS_275( + & PROCNODE_OOC(STEP_OOC( KEEP_OOC(20))), + & SLAVEF_OOC ) + SPECIAL_ROOT_NODE=KEEP_OOC(20) + ELSE + MASTER_ROOT=-111111 + SPECIAL_ROOT_NODE=-2222222 + ENDIF + IF ( KEEP_OOC(60).EQ.0 .AND. + & ( + & (KEEP_OOC(38).NE.0 .AND. id%root%yes) + & .OR. + & (KEEP_OOC(20).NE.0 .AND. MYID_OOC.EQ.MASTER_ROOT)) + & ) + & THEN + IS_ROOT_SPECIAL = .TRUE. + ELSE + IS_ROOT_SPECIAL = .FALSE. + ENDIF + NB_ZONE_REQ=0 + SIZE_ZONE_REQ=0_8 + CURRENT_SOLVE_READ_ZONE=0 + NB_CALLED=0 + NB_CALL=0 + SOLVE_STEP=-9999 +#if defined (NEW_PREF_SCHEME) + MAX_PREF_SIZE=(1024*1024*2)/8 +#endif + RETURN + END SUBROUTINE CMUMPS_586 + SUBROUTINE CMUMPS_585(A,LA,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER NSTEPS,IERR + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER I + IERR=0 + IF(NB_Z.GT.1)THEN + IF(STRAT_IO_ASYNC)THEN + DO I=1,NB_Z-1 + CALL CMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDDO + ELSE + CALL CMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_585 + SUBROUTINE CMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER NSTEPS,IERR + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER ZONE + CALL CMUMPS_603(ZONE) + IERR=0 + CALL CMUMPS_611(ZONE,A,LA,PTRFAC,NSTEPS,IERR) + RETURN + END SUBROUTINE CMUMPS_594 + SUBROUTINE CMUMPS_595(DEST,INDICE,SIZE, + & ZONE,PTRFAC,NSTEPS,POS_SEQ,NB_NODES,FLAG,IERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER ZONE,NSTEPS,FLAG,POS_SEQ,NB_NODES + COMPLEX DEST + INTEGER (8) :: INDICE, SIZE, PTRFAC(NSTEPS) + INTEGER REQUEST,INODE,IERR + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER TYPE + INTEGER SIZE_INT1,SIZE_INT2 + TYPE=OOC_SOLVE_TYPE_FCT + IERR=0 + INODE=OOC_INODE_SEQUENCE(POS_SEQ,OOC_FCT_TYPE) + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO, + & DEST,SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + IF(STRAT_IO_ASYNC)THEN + CALL CMUMPS_597(INODE,SIZE,INDICE,ZONE, + & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ELSE + CALL CMUMPS_597(INODE,SIZE,INDICE,ZONE, + & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL CMUMPS_596(IO_REQ(STEP_OOC(INODE)), + & PTRFAC,NSTEPS) + REQ_ACT=REQ_ACT-1 + ENDIF + END SUBROUTINE CMUMPS_595 + SUBROUTINE CMUMPS_596(REQUEST,PTRFAC, + & NSTEPS) + IMPLICIT NONE + INTEGER NSTEPS,REQUEST + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER (8) :: LAST, POS_IN_S, J + INTEGER ZONE + INTEGER POS_REQ,I,TMP_NODE,POS_IN_MANAGE + INTEGER (8) SIZE + LOGICAL DONT_USE + EXTERNAL MUMPS_330,MUMPS_275 + INTEGER MUMPS_330,MUMPS_275 + POS_REQ=mod(REQUEST,MAX_NB_REQ)+1 + SIZE=SIZE_OF_READ(POS_REQ) + I=FIRST_POS_IN_READ(POS_REQ) + POS_IN_S=READ_DEST(POS_REQ) + POS_IN_MANAGE=READ_MNG(POS_REQ) + ZONE=REQ_TO_ZONE(POS_REQ) + DONT_USE=.FALSE. + J=0_8 + DO WHILE((J.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))) + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + I=I+1 + CYCLE + ENDIF + IF((INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0).AND. + & (INODE_TO_POS(STEP_OOC(TMP_NODE)).LT. + & -((N_OOC+1)*NB_Z)))THEN + DONT_USE= + & (((MTYPE_OOC.EQ.1).AND.(KEEP_OOC(50).EQ.0).AND. + & (SOLVE_STEP.EQ.1).AND. + & ((MUMPS_330(PROCNODE_OOC(STEP_OOC(TMP_NODE)), + & SLAVEF_OOC).EQ.2).AND.(MUMPS_275( + & PROCNODE_OOC(STEP_OOC(TMP_NODE)),SLAVEF_OOC).NE. + & MYID_OOC))) + & .OR. + & ((MTYPE_OOC.NE.1).AND.(KEEP_OOC(50).EQ.0).AND. + & (SOLVE_STEP.EQ.0).AND. + & ((MUMPS_330(PROCNODE_OOC(STEP_OOC(TMP_NODE)), + & SLAVEF_OOC).EQ.2).AND.(MUMPS_275( + & PROCNODE_OOC(STEP_OOC(TMP_NODE)),SLAVEF_OOC).NE. + & MYID_OOC)))).OR. + & (OOC_STATE_NODE(STEP_OOC(TMP_NODE)).EQ.ALREADY_USED) + IF(DONT_USE)THEN + PTRFAC(STEP_OOC(TMP_NODE))=-POS_IN_S + ELSE + PTRFAC(STEP_OOC(TMP_NODE))=POS_IN_S + ENDIF + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).LT. + & IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Inernal error (42) in OOC ', + & PTRFAC(STEP_OOC(TMP_NODE)),IDEB_SOLVE_Z(ZONE) + CALL MUMPS_ABORT() + ENDIF + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).GT. + & (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN + WRITE(*,*)MYID_OOC,': Inernal error (43) in OOC ' + CALL MUMPS_ABORT() + ENDIF + IF(DONT_USE)THEN + POS_IN_MEM(POS_IN_MANAGE)=-TMP_NODE + INODE_TO_POS(STEP_OOC(TMP_NODE))=-POS_IN_MANAGE + IF(OOC_STATE_NODE(STEP_OOC(TMP_NODE)).NE. + & ALREADY_USED)THEN + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=USED_NOT_PERMUTED + ENDIF + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+LAST + ELSE + POS_IN_MEM(POS_IN_MANAGE)=TMP_NODE + INODE_TO_POS(STEP_OOC(TMP_NODE))=POS_IN_MANAGE + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + ENDIF + IO_REQ(STEP_OOC(TMP_NODE))=-7777 + ELSE + POS_IN_MEM(POS_IN_MANAGE)=0 + ENDIF + POS_IN_S=POS_IN_S+LAST + POS_IN_MANAGE=POS_IN_MANAGE+1 + J=J+LAST + I=I+1 + ENDDO + SIZE_OF_READ(POS_REQ)=-9999_8 + FIRST_POS_IN_READ(POS_REQ)=-9999 + READ_DEST(POS_REQ)=-9999_8 + READ_MNG(POS_REQ)=-9999 + REQ_TO_ZONE(POS_REQ)=-9999 + REQ_ID(POS_REQ)=-9999 + RETURN + END SUBROUTINE CMUMPS_596 + SUBROUTINE CMUMPS_597(INODE,SIZE,DEST,ZONE, + & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER INODE,ZONE,REQUEST,FLAG,POS_SEQ,NB_NODES,NSTEPS + INTEGER(8) :: SIZE + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER(8) :: DEST, LOCAL_DEST, J8 + INTEGER I,TMP_NODE,LOC_I,POS_REQ,NB + INTEGER(8)::LAST + INTEGER, intent(out) :: IERR + IERR=0 + IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + RETURN + ENDIF + NB=0 + LOCAL_DEST=DEST + I=POS_SEQ + POS_REQ=mod(REQUEST,MAX_NB_REQ)+1 + IF(REQ_ID(POS_REQ).NE.-9999)THEN + CALL MUMPS_WAIT_REQUEST(REQ_ID(POS_REQ),IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + CALL CMUMPS_596(REQUEST,PTRFAC,NSTEPS) + REQ_ACT=REQ_ACT-1 + ENDIF + SIZE_OF_READ(POS_REQ)=SIZE + FIRST_POS_IN_READ(POS_REQ)=I + READ_DEST(POS_REQ)=DEST + IF(FLAG.EQ.0)THEN + READ_MNG(POS_REQ)=CURRENT_POS_B(ZONE)-NB_NODES+1 + ELSEIF(FLAG.EQ.1)THEN + READ_MNG(POS_REQ)=CURRENT_POS_T(ZONE) + ENDIF + REQ_TO_ZONE(POS_REQ)=ZONE + REQ_ID(POS_REQ)=REQUEST + J8=0_8 + IF(FLAG.EQ.0)THEN + LOC_I=CURRENT_POS_B(ZONE)-NB_NODES+1 + ENDIF + DO WHILE((J8.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))) + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + INODE_TO_POS(STEP_OOC(TMP_NODE))=1 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + I=I+1 + CYCLE + ENDIF + IF((IO_REQ(STEP_OOC(TMP_NODE)).GE.0).OR. + & (INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0))THEN + IF(FLAG.EQ.1)THEN + POS_IN_MEM(CURRENT_POS_T(ZONE))=0 + ELSEIF(FLAG.EQ.0)THEN + POS_IN_MEM(CURRENT_POS_B(ZONE))=0 + ENDIF + ELSE + IO_REQ(STEP_OOC(TMP_NODE))=REQUEST + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-LAST + IF(FLAG.EQ.1)THEN + IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + CURRENT_POS_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+LAST + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)-LAST + POS_IN_MEM(CURRENT_POS_T(ZONE))=-TMP_NODE- + & ((N_OOC+1)*NB_Z) + INODE_TO_POS(STEP_OOC(TMP_NODE))=-CURRENT_POS_T(ZONE)- + & ((N_OOC+1)*NB_Z) + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ + PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST + LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(FLAG.EQ.0)THEN + LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)-LAST + POS_IN_MEM(LOC_I)=-TMP_NODE-((N_OOC+1)*NB_Z) + IF(LOC_I.EQ.POS_HOLE_T(ZONE))THEN + IF(POS_HOLE_T(ZONE).LT.CURRENT_POS_T(ZONE))THEN + POS_HOLE_T(ZONE)=POS_HOLE_T(ZONE)+1 + ENDIF + ENDIF + INODE_TO_POS(STEP_OOC(TMP_NODE))=-LOC_I-((N_OOC+1)*NB_Z) + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ + PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST + LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSE + WRITE(*,*)MYID_OOC,': Internal error (39) in OOC ', + & ' Invalid Flag Value in ', + & ' CMUMPS_597',FLAG + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).NE.0)THEN + IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).EQ. + & POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))THEN + IF(CURRENT_POS_T(ZONE).NE.PDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (40) in OOC ', + & CURRENT_POS_T(ZONE), + & PDEB_SOLVE_Z(ZONE), + & POS_IN_MEM(CURRENT_POS_T(ZONE)), + & POS_IN_MEM(PDEB_SOLVE_Z(ZONE)) + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + J8=J8+LAST + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (41) in OOC ', + & ' LRLUS_SOLVE must be (1) > 0', + & LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + I=I+1 + IF(FLAG.EQ.1)THEN + CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1 + IF(CURRENT_POS_T(ZONE).GT. + & MAX_NB_NODES_FOR_ZONE+PDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (1) in OOC ' + CALL MUMPS_ABORT() + ENDIF + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + ELSEIF(FLAG.EQ.0)THEN + IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (2) in OOC ', + & POS_HOLE_B(ZONE),LOC_I + CALL MUMPS_ABORT() + ENDIF + CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1 + POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE) + IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + ELSE + WRITE(*,*)MYID_OOC,': Internal error (3) in OOC ', + & ' Invalid Flag Value in ', + & ' CMUMPS_597',FLAG + CALL MUMPS_ABORT() + ENDIF + IF(FLAG.EQ.0)THEN + LOC_I=LOC_I+1 + ENDIF + NB=NB+1 + ENDDO + IF(NB.NE.NB_NODES)THEN + WRITE(*,*)MYID_OOC,': Internal error (4) in OOC ', + & ' CMUMPS_597 ',NB,NB_NODES + ENDIF + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=I + ELSE + CUR_POS_SEQUENCE=POS_SEQ-1 + ENDIF + RETURN + END SUBROUTINE CMUMPS_597 + SUBROUTINE CMUMPS_598(INODE,PTRFAC,NSTEPS,A, + & LA,FLAG,IERR) + IMPLICIT NONE + INTEGER(8) :: LA + INTEGER, intent(out):: IERR + COMPLEX A(LA) + INTEGER INODE,NSTEPS + INTEGER(8) :: PTRFAC(NSTEPS) + LOGICAL FLAG + INTEGER(8) FREE_SIZE + INTEGER TMP,TMP_NODE,I,ZONE,J, FREE_HOLE_FLAG + INTEGER WHICH + INTEGER(8) :: DUMMY_SIZE + DUMMY_SIZE=1_8 + IERR = 0 + WHICH=-1 + IF(INODE_TO_POS(STEP_OOC(INODE)).LE.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (5) in OOC ', + & ' Problem in CMUMPS_598', + & INODE, STEP_OOC(INODE), INODE_TO_POS(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE).EQ.0_8)THEN + INODE_TO_POS(STEP_OOC(INODE))=0 + OOC_STATE_NODE(STEP_OOC(INODE))=ALREADY_USED + RETURN + ENDIF + CALL CMUMPS_600(INODE,ZONE,PTRFAC,NSTEPS) + TMP=INODE_TO_POS(STEP_OOC(INODE)) + INODE_TO_POS(STEP_OOC(INODE))=-TMP + POS_IN_MEM(TMP)=-INODE + PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE)) + IF (KEEP_OOC(237).eq.0) THEN + IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.PERMUTED)THEN + WRITE(*,*)MYID_OOC,': INTERNAL ERROR (53) in OOC',INODE, + & OOC_STATE_NODE(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + ENDIF + OOC_STATE_NODE(STEP_OOC(INODE))=USED + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+ + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (6) in OOC ', + & ': LRLUS_SOLVE must be (2) > 0' + CALL MUMPS_ABORT() + ENDIF + IF(ZONE.EQ.NB_Z)THEN + IF(INODE.NE.SPECIAL_ROOT_NODE)THEN + CALL CMUMPS_608(A,FACT_AREA_SIZE, + & DUMMY_SIZE,PTRFAC,KEEP_OOC(28),ZONE,IERR) + ENDIF + ELSE + FREE_HOLE_FLAG=0 + IF(SOLVE_STEP.EQ.0)THEN + IF(TMP.GT.POS_HOLE_B(ZONE))THEN + WHICH=0 + ELSEIF(TMP.LT.POS_HOLE_T(ZONE))THEN + WHICH=1 + ENDIF + ELSEIF(SOLVE_STEP.EQ.1)THEN + IF(TMP.LT.POS_HOLE_T(ZONE))THEN + WHICH=1 + ELSEIF(TMP.GT.POS_HOLE_B(ZONE))THEN + WHICH=0 + ENDIF + ENDIF + IF(WHICH.EQ.1)THEN + J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + FREE_SIZE=0_8 + DO I=J,TMP,-1 + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + GOTO 666 + ENDIF + ENDDO + POS_HOLE_T(ZONE)=TMP + 666 CONTINUE + ELSEIF(WHICH.EQ.0)THEN + J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + FREE_SIZE=0_8 + DO I=J,TMP + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + IF(J.EQ.PDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + CURRENT_POS_B(ZONE)=-9999 + ENDIF + GOTO 777 + ENDIF + ENDDO + POS_HOLE_B(ZONE)=TMP + 777 CONTINUE + ENDIF + IERR=0 + ENDIF + IF((NB_Z.GT.1).AND.FLAG)THEN + CALL CMUMPS_601(ZONE) + IF((LRLUS_SOLVE(ZONE).GE.MIN_SIZE_READ).OR. + & (LRLUS_SOLVE(ZONE).GE. + & int(0.3E0*real(SIZE_SOLVE_Z(ZONE)),8)))THEN + CALL CMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ELSE + CALL CMUMPS_603(ZONE) + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_598 + FUNCTION CMUMPS_726(INODE,PTRFAC,NSTEPS,A,LA, + & IERR) + IMPLICIT NONE + INTEGER INODE,NSTEPS + INTEGER(8) :: LA + INTEGER, INTENT(out)::IERR + COMPLEX A(LA) + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER CMUMPS_726 + IERR=0 + IF(INODE_TO_POS(STEP_OOC(INODE)).GT.0)THEN + IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN + CMUMPS_726=OOC_NODE_PERMUTED + ELSE + CMUMPS_726=OOC_NODE_NOT_PERMUTED + ENDIF + IF(.NOT.CMUMPS_727())THEN + IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE) + & .EQ.INODE)THEN + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ELSEIF(SOLVE_STEP.EQ.1)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + CALL CMUMPS_728() + ENDIF + ENDIF + ELSEIF(INODE_TO_POS(STEP_OOC(INODE)).LT.0)THEN + IF(INODE_TO_POS(STEP_OOC(INODE)).LT.-((N_OOC+1)*NB_Z))THEN + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(INODE)),IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': Internal error (7) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + CALL CMUMPS_596(IO_REQ(STEP_OOC(INODE)), + & PTRFAC,NSTEPS) + REQ_ACT=REQ_ACT-1 + ELSE + CALL CMUMPS_599(INODE,PTRFAC,NSTEPS) + IF(.NOT.CMUMPS_727())THEN + IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ. + & INODE)THEN + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ELSEIF(SOLVE_STEP.EQ.1)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + CALL CMUMPS_728() + ENDIF + ENDIF + ENDIF + IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN + CMUMPS_726=OOC_NODE_PERMUTED + ELSE + CMUMPS_726=OOC_NODE_NOT_PERMUTED + ENDIF + ELSE + CMUMPS_726=OOC_NODE_NOT_IN_MEM + ENDIF + RETURN + END FUNCTION CMUMPS_726 + SUBROUTINE CMUMPS_682(INODE) + IMPLICIT NONE + INTEGER INODE + IF ( (KEEP_OOC(237).EQ.0) + & .AND. (KEEP_OOC(235).EQ.0) ) THEN + IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.NOT_USED)THEN + WRITE(*,*)MYID_OOC,': INTERNAL ERROR (51) in OOC',INODE, + & OOC_STATE_NODE(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + ENDIF + OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED + END SUBROUTINE CMUMPS_682 + SUBROUTINE CMUMPS_599(INODE,PTRFAC,NSTEPS) + IMPLICIT NONE + INTEGER INODE,NSTEPS + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER ZONE + INODE_TO_POS(STEP_OOC(INODE))=-INODE_TO_POS(STEP_OOC(INODE)) + POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE)))= + & -POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE))) + PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE)) + IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED_NOT_PERMUTED)THEN + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + ELSEIF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED)THEN + OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED + ELSE + WRITE(*,*)MYID_OOC,': Internal error (52) in OOC',INODE, + & OOC_STATE_NODE(STEP_OOC(INODE)), + & INODE_TO_POS(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + CALL CMUMPS_610(PTRFAC(STEP_OOC(INODE)),ZONE) + IF(INODE_TO_POS(STEP_OOC(INODE)).LE.POS_HOLE_B(ZONE))THEN + IF(INODE_TO_POS(STEP_OOC(INODE)).GT. + & PDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)= + & INODE_TO_POS(STEP_OOC(INODE))-1 + ELSE + CURRENT_POS_B(ZONE)=-9999 + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + ENDIF + IF(INODE_TO_POS(STEP_OOC(INODE)).GE.POS_HOLE_T(ZONE))THEN + IF(INODE_TO_POS(STEP_OOC(INODE)).LT. + & CURRENT_POS_T(ZONE)-1)THEN + POS_HOLE_T(ZONE)=INODE_TO_POS(STEP_OOC(INODE))+1 + ELSE + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + ENDIF + ENDIF + CALL CMUMPS_609(INODE,PTRFAC,NSTEPS,1) + END SUBROUTINE CMUMPS_599 + SUBROUTINE CMUMPS_600(INODE,ZONE,PTRFAC,NSTEPS) + IMPLICIT NONE + INTEGER INODE,ZONE,NSTEPS + INTEGER (8) :: PTRFAC(NSTEPS) + ZONE=1 + DO WHILE (ZONE.LE.NB_Z) + IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN + ZONE=ZONE-1 + EXIT + ENDIF + ZONE=ZONE+1 + ENDDO + IF(ZONE.EQ.NB_Z+1)THEN + ZONE=ZONE-1 + ENDIF + END SUBROUTINE CMUMPS_600 + SUBROUTINE CMUMPS_601(ZONE) + IMPLICIT NONE + INTEGER ZONE + ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1)+1 + END SUBROUTINE CMUMPS_601 + SUBROUTINE CMUMPS_603(ZONE) + IMPLICIT NONE + INTEGER ZONE + IF(NB_Z.GT.1)THEN + CURRENT_SOLVE_READ_ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1) + ZONE=CURRENT_SOLVE_READ_ZONE+1 + ELSE + ZONE=NB_Z + ENDIF + END SUBROUTINE CMUMPS_603 + SUBROUTINE CMUMPS_578(INODE,PTRFAC, + & KEEP,KEEP8, + & A,IERR) + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER, intent(out)::IERR + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)) + COMPLEX A(FACT_AREA_SIZE) + INTEGER(8) :: REQUESTED_SIZE + INTEGER ZONE,IFLAG + IERR=0 + IFLAG=0 + IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + & .EQ.0_8)THEN + INODE_TO_POS(STEP_OOC(INODE))=1 + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + PTRFAC(STEP_OOC(INODE))=1_8 + RETURN + ENDIF + REQUESTED_SIZE=SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + ZONE=NB_Z + IF(CURRENT_POS_T(ZONE).GT. + & (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1))THEN + CALL CMUMPS_608(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + IF((LRLU_SOLVE_T(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE), + & OOC_FCT_TYPE)).AND. + & (CURRENT_POS_T(ZONE).LE. + & (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN + CALL CMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSEIF(LRLU_SOLVE_B(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE), + & OOC_FCT_TYPE).AND. + & (CURRENT_POS_B(ZONE).GT.0))THEN + CALL CMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSE + IF(CMUMPS_579(INODE,ZONE))THEN + IF(SOLVE_STEP.EQ.0)THEN + CALL CMUMPS_604(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL CMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSEIF(IFLAG.EQ.0)THEN + CALL CMUMPS_605(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL CMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ENDIF + ENDIF + ELSE + CALL CMUMPS_605(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL CMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSEIF(IFLAG.EQ.0)THEN + CALL CMUMPS_604(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL CMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ENDIF + ENDIF + ENDIF + IF(IFLAG.EQ.0)THEN + CALL CMUMPS_608(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL CMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ENDIF + ELSE + WRITE(*,*)MYID_OOC,': Internal error (8) in OOC ', + & ' Not enough space for Solve',INODE, + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE), + & LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (9) in OOC ', + & ' LRLUS_SOLVE must be (3) > 0' + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE CMUMPS_578 + SUBROUTINE CMUMPS_604(A,LA,REQUESTED_SIZE,PTRFAC, + & NSTEPS,ZONE,FLAG,IERR) + IMPLICIT NONE + INTEGER NSTEPS,ZONE,FLAG + INTEGER(8) :: REQUESTED_SIZE, LA + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER(8) :: FREE_SIZE, FREE_HOLE, FREE_HOLE_POS + COMPLEX A(LA) + INTEGER I,TMP_NODE,FREE_HOLE_FLAG, J + INTEGER, intent(out)::IERR + IERR=0 + FLAG=0 + IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE).AND. + & (.NOT.(CURRENT_POS_T(ZONE) + & .GT.PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN + GOTO 50 + ENDIF + J=max(POS_HOLE_B(ZONE),PDEB_SOLVE_Z(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + DO I=POS_HOLE_T(ZONE)-1,J,-1 + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + EXIT + ENDIF + ENDDO + POS_HOLE_T(ZONE)=I+1 + IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR. + & (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR. + & (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN + CURRENT_POS_B(ZONE)=-9999 + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE) + ENDIF + FREE_HOLE=0_8 + FREE_SIZE=0_8 + FREE_HOLE_FLAG=0 + FREE_HOLE_POS=POSFAC_SOLVE(ZONE) + DO I=CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),-1 + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + FREE_HOLE_FLAG=0 + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE))) + PTRFAC(STEP_OOC(TMP_NODE))=-777777_8 + INODE_TO_POS(STEP_OOC(TMP_NODE))=0 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED + POS_IN_MEM(I)=0 + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).EQ.0)THEN + FREE_HOLE_FLAG=1 + ELSEIF(POS_IN_MEM(I).NE.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (10) in OOC ', + & ' CMUMPS_604', + & CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),I + CALL MUMPS_ABORT() + ENDIF + ENDDO + IF(POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE))THEN + IF(FREE_HOLE_FLAG.EQ.0)THEN + FREE_HOLE_FLAG=1 + ENDIF + ENDIF + IF(FREE_HOLE_FLAG.EQ.1)THEN + IF(POS_HOLE_T(ZONE)-1.GT.PDEB_SOLVE_Z(ZONE))THEN + I=POS_HOLE_T(ZONE)-1 + TMP_NODE=abs(POS_IN_MEM(I)) + IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN + TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (11) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + CALL MUMPS_ABORT() + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL CMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSEIF(TMP_NODE.EQ.0)THEN + DO J=I,PDEB_SOLVE_Z(ZONE),-1 + IF(POS_IN_MEM(J).NE.0) EXIT + ENDDO + IF(POS_IN_MEM(J).LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (12) in OOC ', + & ' CMUMPS_604' + CALL MUMPS_ABORT() + ENDIF + IF(J.GE.PDEB_SOLVE_Z(ZONE))THEN + TMP_NODE=POS_IN_MEM(J) + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSE + FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE) + ENDIF + ELSEIF(TMP_NODE.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (13) in OOC', + & ' CMUMPS_604' + CALL MUMPS_ABORT() + ELSE + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ENDIF + ELSE + FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE) + ENDIF + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + CURRENT_POS_T(ZONE)=POS_HOLE_T(ZONE) + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+FREE_SIZE + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-FREE_SIZE + 50 CONTINUE + IF(REQUESTED_SIZE.LE.LRLU_SOLVE_T(ZONE))THEN + FLAG=1 + ELSE + FLAG=0 + ENDIF + RETURN + END SUBROUTINE CMUMPS_604 + SUBROUTINE CMUMPS_605(A,LA,REQUESTED_SIZE, + & PTRFAC,NSTEPS,ZONE,FLAG,IERR) + IMPLICIT NONE + INTEGER NSTEPS,ZONE,FLAG + INTEGER (8) :: REQUESTED_SIZE + INTEGER (8) :: LA + INTEGER (8) :: PTRFAC(NSTEPS) + COMPLEX A(LA) + INTEGER(8) :: FREE_SIZE, FREE_HOLE_POS, FREE_HOLE + INTEGER I,J,TMP_NODE,FREE_HOLE_FLAG + INTEGER, intent(out) :: IERR + IERR=0 + FLAG=0 + IF(LRLU_SOLVE_B(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN + GOTO 50 + ENDIF + IF(POS_HOLE_B(ZONE).EQ.-9999)THEN + GOTO 50 + ENDIF + J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + DO I=POS_HOLE_B(ZONE)+1,J + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + EXIT + ENDIF + ENDDO + POS_HOLE_B(ZONE)=I-1 + IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR. + & (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR. + & (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN + CURRENT_POS_B(ZONE)=-9999 + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE) + ENDIF + FREE_HOLE=0_8 + FREE_SIZE=0_8 + FREE_HOLE_FLAG=0 + FREE_HOLE_POS=IDEB_SOLVE_Z(ZONE) + IF(POS_HOLE_B(ZONE).EQ.-9999)THEN + GOTO 50 + ENDIF + DO I=PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE) + IF((POS_IN_MEM(I).LE.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + IF(TMP_NODE.NE.0)THEN + IF(I.EQ.PDEB_SOLVE_Z(ZONE))THEN + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE. + & IDEB_SOLVE_Z(ZONE))THEN + FREE_SIZE=FREE_SIZE+abs(PTRFAC(STEP_OOC(TMP_NODE))) + & -IDEB_SOLVE_Z(ZONE) + ENDIF + ENDIF + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + FREE_HOLE_FLAG=0 + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(TMP_NODE))=-777777_8 + INODE_TO_POS(STEP_OOC(TMP_NODE))=0 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSE + FREE_HOLE_FLAG=1 + ENDIF + POS_IN_MEM(I)=0 + ELSEIF(POS_IN_MEM(I).NE.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (14) in OOC ', + & ' CMUMPS_605', + & CURRENT_POS_T(ZONE)-1,POS_HOLE_B(ZONE),I,POS_IN_MEM(I) + CALL MUMPS_ABORT() + ENDIF + ENDDO + IF(FREE_HOLE_FLAG.EQ.1)THEN + IF(POS_HOLE_B(ZONE)+1.LT.CURRENT_POS_T(ZONE)-1)THEN + I=POS_HOLE_B(ZONE)+1 + TMP_NODE=abs(POS_IN_MEM(I)) + IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN + TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (15) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + CALL MUMPS_ABORT() + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL CMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-FREE_HOLE_POS + ELSEIF(TMP_NODE.EQ.0)THEN + DO J=I,CURRENT_POS_T(ZONE)-1 + IF(POS_IN_MEM(J).NE.0) EXIT + ENDDO + IF(POS_IN_MEM(J).LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (16) in OOC ', + & ' CMUMPS_605' + CALL MUMPS_ABORT() + ENDIF + IF(J.LE.CURRENT_POS_T(ZONE)-1)THEN + TMP_NODE=POS_IN_MEM(J) + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + ELSE + FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS + ENDIF + ELSEIF(TMP_NODE.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (17) in OOC ', + & ' CMUMPS_605' + CALL MUMPS_ABORT() + ELSE + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + ENDIF + ELSE + FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS + ENDIF + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + LRLU_SOLVE_B(ZONE)=FREE_SIZE + IF(POS_HOLE_B(ZONE).LT.CURRENT_POS_T(ZONE)-1)THEN + TMP_NODE=POS_IN_MEM(POS_HOLE_B(ZONE)+1) + IF(TMP_NODE.LT.-(N_OOC+1)*NB_Z)THEN + TMP_NODE=abs(TMP_NODE)-(N_OOC+1)*NB_Z + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (18) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + CALL MUMPS_ABORT() + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL CMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + ENDIF + LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)+ + & (abs(PTRFAC(STEP_OOC(abs(TMP_NODE))))-IDEB_SOLVE_Z(ZONE)- + & LRLU_SOLVE_B(ZONE)) + ENDIF + CURRENT_POS_B(ZONE)=POS_HOLE_B(ZONE) + 50 CONTINUE + IF((POS_HOLE_B(ZONE).EQ.-9999).AND. + & (LRLU_SOLVE_B(ZONE).NE.0_8))THEN + WRITE(*,*)MYID_OOC,': Internal error (19) in OOC ', + & 'CMUMPS_605' + CALL MUMPS_ABORT() + ENDIF + IF((REQUESTED_SIZE.LE.LRLU_SOLVE_B(ZONE)).AND. + & (POS_HOLE_B(ZONE).NE.-9999))THEN + FLAG=1 + ELSE + FLAG=0 + ENDIF + END SUBROUTINE CMUMPS_605 + SUBROUTINE CMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8, A,ZONE) + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)) + COMPLEX A(FACT_AREA_SIZE) + INTEGER ZONE + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(INODE))=POSFAC_SOLVE(ZONE) + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + CURRENT_POS_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (20) in OOC ', + & ' Problem avec debut (2)',INODE, + & PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE),ZONE + CALL MUMPS_ABORT() + ENDIF + INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_T(ZONE) + POS_IN_MEM(CURRENT_POS_T(ZONE))=INODE + IF(CURRENT_POS_T(ZONE).GT.(PDEB_SOLVE_Z(ZONE)+ + & MAX_NB_NODES_FOR_ZONE-1))THEN + WRITE(*,*)MYID_OOC,': Internal error (21) in OOC ', + & ' Problem with CURRENT_POS_T', + & CURRENT_POS_T(ZONE),ZONE + CALL MUMPS_ABORT() + ENDIF + CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1 + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+ + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + END SUBROUTINE CMUMPS_606 + SUBROUTINE CMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8, + & A,ZONE) + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)) + COMPLEX A(FACT_AREA_SIZE) + INTEGER ZONE + IF(POS_HOLE_B(ZONE).EQ.-9999)THEN + WRITE(*,*)MYID_OOC,': Internal error (22) in OOC ', + & ' CMUMPS_607' + CALL MUMPS_ABORT() + ENDIF + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(INODE))=IDEB_SOLVE_Z(ZONE)+ + & LRLU_SOLVE_B(ZONE) + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (23) in OOC ', + & PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE) + CALL MUMPS_ABORT() + ENDIF + INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_B(ZONE) + IF(CURRENT_POS_B(ZONE).EQ.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (23b) in OOC ' + CALL MUMPS_ABORT() + ENDIF + POS_IN_MEM(CURRENT_POS_B(ZONE))=INODE + CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1 + POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE) + END SUBROUTINE CMUMPS_607 + SUBROUTINE CMUMPS_608(A,LA,REQUESTED_SIZE,PTRFAC, + & NSTEPS,ZONE,IERR) + IMPLICIT NONE + INTEGER(8) :: LA, REQUESTED_SIZE + INTEGER NSTEPS,ZONE + INTEGER, intent(out) :: IERR + INTEGER(8) :: PTRFAC(NSTEPS) + COMPLEX A(LA) + INTEGER (8) :: APOS_FIRST_FREE, + & SIZE_HOLE, + & FREE_HOLE, + & FREE_HOLE_POS + INTEGER J,I,TMP_NODE, NB_FREE, IPOS_FIRST_FREE + INTEGER(8) :: K8, AREA_POINTER + INTEGER FREE_HOLE_FLAG + IERR=0 + IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN + RETURN + ENDIF + AREA_POINTER=IDEB_SOLVE_Z(ZONE) + SIZE_HOLE=0_8 + DO I=PDEB_SOLVE_Z(ZONE),CURRENT_POS_T(ZONE)-1 + IF((POS_IN_MEM(I).LE.0).AND. + & (POS_IN_MEM(I).GT.-((N_OOC+1)*NB_Z))) GOTO 666 + TMP_NODE=abs(POS_IN_MEM(I)) + IF(TMP_NODE.GT.((N_OOC+1)*NB_Z))THEN + TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z) + ENDIF + AREA_POINTER=AREA_POINTER+ + & abs(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ENDDO + 666 CONTINUE + IF((I.EQ.CURRENT_POS_T(ZONE)-1).AND. + & (PDEB_SOLVE_Z(ZONE).NE.CURRENT_POS_T(ZONE)-1))THEN + IF((POS_IN_MEM(I).GT.0).OR. + & (POS_IN_MEM(I).LT.-((N_OOC+1)*NB_Z)))THEN + WRITE(*,*)MYID_OOC,': Internal error (25) in OOC ', + & ': There are no free blocks ', + & 'in CMUMPS_608',PDEB_SOLVE_Z(ZONE), + & CURRENT_POS_T(ZONE) + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF(POS_IN_MEM(I).EQ.0)THEN + APOS_FIRST_FREE=AREA_POINTER + FREE_HOLE_POS=AREA_POINTER + ELSE + TMP_NODE=abs(POS_IN_MEM(I)) + APOS_FIRST_FREE=abs(PTRFAC(STEP_OOC(TMP_NODE))) + ENDIF + IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).NE.0)THEN + IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).LT.-((N_OOC+1)*NB_Z))THEN + TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))- + & ((N_OOC+1)*NB_Z) + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL CMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + ELSE + TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE))) + ENDIF + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE.IDEB_SOLVE_Z(ZONE))THEN + IF((POS_IN_MEM(I).NE.0).OR.(I.EQ.CURRENT_POS_T(ZONE)))THEN + SIZE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & IDEB_SOLVE_Z(ZONE) + ENDIF + APOS_FIRST_FREE=IDEB_SOLVE_Z(ZONE) + IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).GT.0)THEN + DO J=PDEB_SOLVE_Z(ZONE),I-1 + TMP_NODE=POS_IN_MEM(J) + IF(TMP_NODE.LE.0)THEN + IF(TMP_NODE.LT.-((N_OOC+1)*NB_Z))THEN + TMP_NODE=abs(POS_IN_MEM(J))-((N_OOC+1)*NB_Z) + CALL MUMPS_WAIT_REQUEST( + & IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL CMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + TMP_NODE=POS_IN_MEM(J) + ELSE + WRITE(*,*)MYID_OOC,': Internal error (26) in OOC ', + & ' CMUMPS_608',TMP_NODE, + & J,I-1,(N_OOC+1)*NB_Z + CALL MUMPS_ABORT() + ENDIF + ENDIF + DO K8=1_8, + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + A(APOS_FIRST_FREE+K8-1_8)= + & A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8) + ENDDO + PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE + APOS_FIRST_FREE=APOS_FIRST_FREE+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + ENDDO + ENDIF + ENDIF + ENDIF + NB_FREE=0 + FREE_HOLE=0_8 + FREE_HOLE_FLAG=0 + DO J=I,CURRENT_POS_T(ZONE)-1 + TMP_NODE=abs(POS_IN_MEM(J)) + IF(POS_IN_MEM(J).LT.-((N_OOC+1)*NB_Z))THEN + TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z) + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL CMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + TMP_NODE=abs(POS_IN_MEM(J)) + ENDIF + IF(POS_IN_MEM(J).GT.0)THEN + DO K8=1_8,SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + A(APOS_FIRST_FREE+K8-1_8)= + & A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8) + ENDDO + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + FREE_HOLE_FLAG=0 + SIZE_HOLE=SIZE_HOLE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE + APOS_FIRST_FREE=APOS_FIRST_FREE+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(J).EQ.0)THEN + FREE_HOLE_FLAG=1 + NB_FREE=NB_FREE+1 + ELSE + NB_FREE=NB_FREE+1 + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + FREE_HOLE_FLAG=0 + SIZE_HOLE=SIZE_HOLE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + SIZE_HOLE=SIZE_HOLE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + PTRFAC(STEP_OOC(abs(POS_IN_MEM(J))))=-77777_8 + ENDIF + ENDDO + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS + FREE_HOLE_FLAG=0 + SIZE_HOLE=SIZE_HOLE+FREE_HOLE + ENDIF + IPOS_FIRST_FREE=I + DO J=I,CURRENT_POS_T(ZONE)-1 + IF(POS_IN_MEM(J).LT.0)THEN + TMP_NODE=abs(POS_IN_MEM(J)) + INODE_TO_POS(STEP_OOC(TMP_NODE))=0 + POS_IN_MEM(J)=0 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED + ELSEIF(POS_IN_MEM(J).GT.0)THEN + TMP_NODE=abs(POS_IN_MEM(J)) + POS_IN_MEM(IPOS_FIRST_FREE)=POS_IN_MEM(J) + INODE_TO_POS(STEP_OOC(TMP_NODE))=IPOS_FIRST_FREE + IPOS_FIRST_FREE=IPOS_FIRST_FREE+1 + ENDIF + ENDDO + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+SIZE_HOLE + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-SIZE_HOLE + CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)-NB_FREE + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + LRLU_SOLVE_B(ZONE)=0_8 + POS_HOLE_B(ZONE)=-9999 + CURRENT_POS_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + IF(LRLU_SOLVE_T(ZONE).NE.LRLUS_SOLVE(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (27) in OOC ', + & LRLU_SOLVE_T(ZONE), + & LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + LRLU_SOLVE_T(ZONE)=LRLUS_SOLVE(ZONE) + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (28) in OOC ', + & ' LRLUS_SOLVE must be (4) > 0' + CALL MUMPS_ABORT() + ENDIF + IF(POSFAC_SOLVE(ZONE).LT.IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (29) in OOC ', + & POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE) + CALL MUMPS_ABORT() + ENDIF + IF(POSFAC_SOLVE(ZONE).NE.(IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)- + & LRLUS_SOLVE(ZONE)))THEN + WRITE(*,*)MYID_OOC,': Internal error (30) in OOC ', + & ' Problem avec debut POSFAC_SOLVE', + & POSFAC_SOLVE(ZONE),(SIZE_SOLVE_Z(ZONE)- + & LRLUS_SOLVE(ZONE))+IDEB_SOLVE_Z(ZONE),LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + IF(POSFAC_SOLVE(ZONE).GT. + & (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN + WRITE(*,*)MYID_OOC,': Internal error (31) in OOC ', + & POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE)+ + & SIZE_SOLVE_Z(ZONE)-1_8 + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE CMUMPS_608 + SUBROUTINE CMUMPS_609(INODE,PTRFAC,NSTEPS,FLAG) + IMPLICIT NONE + INTEGER INODE,NSTEPS,FLAG + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER ZONE + IF((FLAG.LT.0).OR.(FLAG.GT.1))THEN + WRITE(*,*)MYID_OOC,': Internal error (32) in OOC ', + & ' CMUMPS_609' + CALL MUMPS_ABORT() + ENDIF + CALL CMUMPS_610(PTRFAC(STEP_OOC(INODE)),ZONE) + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (33) in OOC ', + & ' LRLUS_SOLVE must be (5) ++ > 0' + CALL MUMPS_ABORT() + ENDIF + IF(FLAG.EQ.0)THEN + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+ + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + ELSE + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + ENDIF + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (34) in OOC ', + & ' LRLUS_SOLVE must be (5) > 0' + CALL MUMPS_ABORT() + ENDIF + END SUBROUTINE CMUMPS_609 + SUBROUTINE CMUMPS_610(ADDR,ZONE) + IMPLICIT NONE + INTEGER (8) :: ADDR + INTEGER ZONE + INTEGER I + I=1 + DO WHILE (I.LE.NB_Z) + IF(ADDR.LT.IDEB_SOLVE_Z(I))THEN + EXIT + ENDIF + I=I+1 + ENDDO + ZONE=I-1 + END SUBROUTINE CMUMPS_610 + FUNCTION CMUMPS_727() + IMPLICIT NONE + LOGICAL CMUMPS_727 + CMUMPS_727=.FALSE. + IF(SOLVE_STEP.EQ.0)THEN + IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + CMUMPS_727=.TRUE. + ENDIF + ELSEIF(SOLVE_STEP.EQ.1)THEN + IF(CUR_POS_SEQUENCE.LT.1)THEN + CMUMPS_727=.TRUE. + ENDIF + ENDIF + RETURN + END FUNCTION CMUMPS_727 + SUBROUTINE CMUMPS_611(ZONE,A,LA,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER NSTEPS,ZONE + INTEGER(8), INTENT(IN) :: LA + INTEGER, intent(out) :: IERR + COMPLEX A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER(8) :: SIZE, DEST + INTEGER(8) :: NEEDED_SIZE + INTEGER FLAG,TMP_FLAG,POS_SEQ,TMP_NODE, + & NB_NODES + IERR=0 + TMP_FLAG=0 + FLAG=0 + IF(CMUMPS_727())THEN + RETURN + ENDIF + IF(SOLVE_STEP.EQ.0)THEN + IF(CUR_POS_SEQUENCE.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT. + & SIZE_SOLVE_Z(ZONE)) + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + IF(CMUMPS_727())THEN + RETURN + ENDIF + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + ENDDO + CALL CMUMPS_728() + NEEDED_SIZE=max(MIN_SIZE_READ, + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSE + NEEDED_SIZE=MIN_SIZE_READ + ENDIF + ELSEIF(SOLVE_STEP.EQ.1)THEN + IF(CUR_POS_SEQUENCE.GE.1)THEN + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT. + & SIZE_SOLVE_Z(ZONE)) + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + IF(CMUMPS_727())THEN + RETURN + ENDIF + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + ENDDO + CALL CMUMPS_728() + NEEDED_SIZE=max(MIN_SIZE_READ, + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSE + NEEDED_SIZE=MIN_SIZE_READ + ENDIF + ENDIF + IF(LRLUS_SOLVE(ZONE).LT.NEEDED_SIZE)THEN + RETURN + ELSEIF((LRLU_SOLVE_T(ZONE).LT.NEEDED_SIZE).AND. + & (LRLU_SOLVE_B(ZONE).LT.NEEDED_SIZE).AND. + & (dble(LRLUS_SOLVE(ZONE)).LT.0.3d0* + & dble(SIZE_SOLVE_Z(ZONE)))) THEN + RETURN + ENDIF + IF((LRLU_SOLVE_T(ZONE).GT.NEEDED_SIZE).AND.(SOLVE_STEP.EQ.0).AND. + & ((CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1).LT. + & MAX_NB_NODES_FOR_ZONE))THEN + FLAG=1 + ELSE + IF(SOLVE_STEP.EQ.0)THEN + CALL CMUMPS_604(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=1 + IF(TMP_FLAG.EQ.0)THEN + CALL CMUMPS_605(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=0 + ENDIF + ELSE + CALL CMUMPS_605(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=0 + IF(TMP_FLAG.EQ.0)THEN + CALL CMUMPS_604(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=1 + ENDIF + ENDIF + IF(TMP_FLAG.EQ.0)THEN + CALL CMUMPS_608(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=1 + ENDIF + ENDIF + CALL CMUMPS_602(ZONE,SIZE,DEST,POS_SEQ, + & NB_NODES,FLAG,PTRFAC,NSTEPS) + IF(SIZE.EQ.0_8)THEN + RETURN + ENDIF + NB_ZONE_REQ=NB_ZONE_REQ+1 + SIZE_ZONE_REQ=SIZE_ZONE_REQ+SIZE + REQ_ACT=REQ_ACT+1 + CALL CMUMPS_595(A(DEST),DEST,SIZE,ZONE,PTRFAC,NSTEPS, + & POS_SEQ,NB_NODES,FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + END SUBROUTINE CMUMPS_611 + SUBROUTINE CMUMPS_602(ZONE,SIZE,DEST,POS_SEQ, + & NB_NODES,FLAG,PTRFAC,NSTEPS) + IMPLICIT NONE + INTEGER(8) :: SIZE, DEST + INTEGER ZONE,FLAG,POS_SEQ,NSTEPS + INTEGER(8) :: PTRFAC(NSTEPS), MAX_SIZE, LAST, J8 + INTEGER I,START_NODE,K,MAX_NB, + & NB_NODES + INTEGER NB_NODES_LOC + LOGICAL ALREADY + IF(CMUMPS_727())THEN + SIZE=0_8 + RETURN + ENDIF + IF(FLAG.EQ.0)THEN + MAX_SIZE=LRLU_SOLVE_B(ZONE) + MAX_NB=max(0,CURRENT_POS_B(ZONE)-PDEB_SOLVE_Z(ZONE)+1) + ELSEIF(FLAG.EQ.1)THEN + MAX_SIZE=LRLU_SOLVE_T(ZONE) + MAX_NB=MAX_NB_NODES_FOR_ZONE + ELSE + WRITE(*,*)MYID_OOC,': Internal error (35) in OOC ', + & ' Unknown Flag value in ', + & ' CMUMPS_602',FLAG + CALL MUMPS_ABORT() + ENDIF + CALL CMUMPS_728() + I=CUR_POS_SEQUENCE + START_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + ALREADY=.FALSE. + NB_NODES=0 + NB_NODES_LOC=0 +#if defined (NEW_PREF_SCHEME) + IF(MAX_SIZE.GT.MAX_PREF_SIZE)THEN + MAX_SIZE=MIN(MAX(MAX_PREF_SIZE, + & SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE)), + & MAX_SIZE) + ENDIF +#endif + IF(ZONE.EQ.NB_Z)THEN + SIZE=SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE) + ELSE + J8=0_8 + IF(FLAG.EQ.0)THEN + K=0 + ELSEIF(FLAG.EQ.1)THEN + K=CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1 + ENDIF + IF(SOLVE_STEP.EQ.0)THEN + I=CUR_POS_SEQUENCE + DO WHILE(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) + IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + & .NE.0_8)THEN + EXIT + ENDIF + I=I+1 + ENDDO + CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) + I=CUR_POS_SEQUENCE + DO WHILE((J8.LE.MAX_SIZE).AND. + & (I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND. + & (K.LT.MAX_NB) ) + LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + IF(.NOT.ALREADY)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ENDIF + I=I+1 + NB_NODES_LOC=NB_NODES_LOC+1 + CYCLE + ENDIF + IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))) + & .NE.0).OR. + & (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))).GE. + & 0))THEN + IF(.NOT.ALREADY)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + I=I+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ALREADY=.TRUE. + J8=J8+LAST + I=I+1 + K=K+1 + NB_NODES_LOC=NB_NODES_LOC+1 + NB_NODES=NB_NODES+1 + ENDDO + IF(J8.GT.MAX_SIZE)THEN + SIZE=J8-LAST + NB_NODES=NB_NODES-1 + NB_NODES_LOC=NB_NODES_LOC-1 + ELSE + SIZE=J8 + ENDIF + DO WHILE (CUR_POS_SEQUENCE+NB_NODES_LOC-1.GE. + & CUR_POS_SEQUENCE) + IF(SIZE_OF_BLOCK(STEP_OOC( + & OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE+NB_NODES-1, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + & .NE.0_8)THEN + EXIT + ENDIF + NB_NODES_LOC=NB_NODES_LOC-1 + ENDDO + POS_SEQ=CUR_POS_SEQUENCE + ELSEIF(SOLVE_STEP.EQ.1)THEN + DO WHILE(I.GE.1) + IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + & .NE.0_8)THEN + EXIT + ENDIF + I=I-1 + ENDDO + CUR_POS_SEQUENCE=max(I,1) + I=CUR_POS_SEQUENCE + DO WHILE((J8.LE.MAX_SIZE).AND.(I.GE.1).AND. + & (K.LT.MAX_NB)) + LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + IF(.NOT.ALREADY)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + NB_NODES_LOC=NB_NODES_LOC+1 + I=I-1 + CYCLE + ENDIF + IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))) + & .NE.0).OR. + & (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))).GE. + & 0))THEN + IF(.NOT.ALREADY)THEN + I=I-1 + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ALREADY=.TRUE. + J8=J8+LAST + I=I-1 + K=K+1 + NB_NODES=NB_NODES+1 + NB_NODES_LOC=NB_NODES_LOC+1 + ENDDO + IF(J8.GT.MAX_SIZE)THEN + SIZE=J8-LAST + NB_NODES=NB_NODES-1 + NB_NODES_LOC=NB_NODES_LOC-1 + ELSE + SIZE=J8 + ENDIF + I=CUR_POS_SEQUENCE-NB_NODES_LOC+1 + DO WHILE (I.LE.CUR_POS_SEQUENCE) + IF(SIZE_OF_BLOCK(STEP_OOC( + & OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)), + & OOC_FCT_TYPE).NE.0_8)THEN + EXIT + ENDIF + I=I+1 + NB_NODES_LOC=NB_NODES_LOC-1 + ENDDO + POS_SEQ=CUR_POS_SEQUENCE-NB_NODES_LOC+1 + ENDIF + ENDIF + IF(FLAG.EQ.0)THEN + DEST=IDEB_SOLVE_Z(ZONE)+LRLU_SOLVE_B(ZONE)-SIZE + ELSE + DEST=POSFAC_SOLVE(ZONE) + ENDIF + END SUBROUTINE CMUMPS_602 + SUBROUTINE CMUMPS_582(IERR) + IMPLICIT NONE + INTEGER SOLVE_OR_FACTO + INTEGER, intent(out) :: IERR + IERR=0 + IF(allocated(LRLUS_SOLVE))THEN + DEALLOCATE(LRLUS_SOLVE) + ENDIF + IF(allocated(LRLU_SOLVE_T))THEN + DEALLOCATE(LRLU_SOLVE_T) + ENDIF + IF(allocated(LRLU_SOLVE_B))THEN + DEALLOCATE(LRLU_SOLVE_B) + ENDIF + IF(allocated(POSFAC_SOLVE))THEN + DEALLOCATE(POSFAC_SOLVE) + ENDIF + IF(allocated(IDEB_SOLVE_Z))THEN + DEALLOCATE(IDEB_SOLVE_Z) + ENDIF + IF(allocated(PDEB_SOLVE_Z))THEN + DEALLOCATE(PDEB_SOLVE_Z) + ENDIF + IF(allocated(SIZE_SOLVE_Z))THEN + DEALLOCATE(SIZE_SOLVE_Z) + ENDIF + IF(allocated(CURRENT_POS_T))THEN + DEALLOCATE(CURRENT_POS_T) + ENDIF + IF(allocated(CURRENT_POS_B))THEN + DEALLOCATE(CURRENT_POS_B) + ENDIF + IF(allocated(POS_HOLE_T))THEN + DEALLOCATE(POS_HOLE_T) + ENDIF + IF(allocated(POS_HOLE_B))THEN + DEALLOCATE(POS_HOLE_B) + ENDIF + IF(allocated(OOC_STATE_NODE))THEN + DEALLOCATE(OOC_STATE_NODE) + ENDIF + IF(allocated(POS_IN_MEM))THEN + DEALLOCATE(POS_IN_MEM) + ENDIF + IF(allocated(INODE_TO_POS))THEN + DEALLOCATE(INODE_TO_POS) + ENDIF + IF(allocated(IO_REQ))THEN + DEALLOCATE(IO_REQ) + ENDIF + IF(allocated(SIZE_OF_READ))THEN + DEALLOCATE(SIZE_OF_READ) + ENDIF + IF(allocated(FIRST_POS_IN_READ))THEN + DEALLOCATE(FIRST_POS_IN_READ) + ENDIF + IF(allocated(READ_DEST))THEN + DEALLOCATE(READ_DEST) + ENDIF + IF(allocated(READ_MNG))THEN + DEALLOCATE(READ_MNG) + ENDIF + IF(allocated(REQ_TO_ZONE))THEN + DEALLOCATE(REQ_TO_ZONE) + ENDIF + IF(allocated(REQ_ID))THEN + DEALLOCATE(REQ_ID) + ENDIF + SOLVE_OR_FACTO=1 + CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + END SUBROUTINE CMUMPS_582 + SUBROUTINE CMUMPS_612(PTRFAC,NSTEPS, + & A,LA) + IMPLICIT NONE + INTEGER, INTENT(in) :: NSTEPS + INTEGER(8), INTENT(INOUT) :: PTRFAC(NSTEPS) + INTEGER(8), INTENT(IN) :: LA + COMPLEX :: A(LA) + INTEGER :: I, TMP, ZONE, IPAS, IBEG, IEND + INTEGER(8) :: SAVE_PTR + LOGICAL :: COMPRESS_TO_BE_DONE, SET_POS_SEQUENCE + INTEGER :: J, IERR + INTEGER(8) :: DUMMY_SIZE + COMPRESS_TO_BE_DONE = .FALSE. + DUMMY_SIZE = 1_8 + IERR = 0 + SET_POS_SEQUENCE = .TRUE. + IF(SOLVE_STEP.EQ.0)THEN + IBEG = 1 + IEND = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + IPAS = 1 + ELSE + IBEG = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + IEND = 1 + IPAS = -1 + ENDIF + DO I=IBEG,IEND,IPAS + J = OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + TMP=INODE_TO_POS(STEP_OOC(J)) + IF(TMP.EQ.0)THEN + IF (SET_POS_SEQUENCE) THEN + SET_POS_SEQUENCE = .FALSE. + CUR_POS_SEQUENCE = I + ENDIF + IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN + OOC_STATE_NODE(STEP_OOC(J)) = NOT_IN_MEM + ENDIF + CYCLE + ELSE IF(TMP.LT.0)THEN + IF(TMP.GT.-(N_OOC+1)*NB_Z)THEN + SAVE_PTR=PTRFAC(STEP_OOC(J)) + PTRFAC(STEP_OOC(J)) = abs(SAVE_PTR) + CALL CMUMPS_600(J, + & ZONE,PTRFAC,NSTEPS) + PTRFAC(STEP_OOC(J)) = SAVE_PTR + IF(ZONE.EQ.NB_Z)THEN + IF(J.NE.SPECIAL_ROOT_NODE)THEN + WRITE(*,*)MYID_OOC,': Internal error 6 ', + & ' Node ', J, + & ' is in status USED in the + & emmergency buffer ' + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0) + & THEN + IF (OOC_STATE_NODE(STEP_OOC(J)).EQ.NOT_IN_MEM) THEN + OOC_STATE_NODE(STEP_OOC(J)) = USED + IF((SOLVE_STEP.NE.0).OR.(J.NE.SPECIAL_ROOT_NODE) + & .OR.(ZONE.NE.NB_Z))THEN + CALL CMUMPS_599(J,PTRFAC,NSTEPS) + ENDIF + CYCLE + ELSEIF(OOC_STATE_NODE(STEP_OOC(J)).EQ.ALREADY_USED) + & THEN + COMPRESS_TO_BE_DONE = .TRUE. + ELSE + WRITE(*,*)MYID_OOC,': Internal error Mila 4 ', + & ' wrong node status :', OOC_STATE_NODE(STEP_OOC(J)), + & ' on node ', J + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN + CALL CMUMPS_599(J,PTRFAC,NSTEPS) + ENDIF + ENDIF + ENDIF + ENDDO + IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0) + & THEN + IF (COMPRESS_TO_BE_DONE) THEN + DO ZONE=1,NB_Z-1 + CALL CMUMPS_608(A,LA, + & DUMMY_SIZE,PTRFAC, + & NSTEPS,ZONE,IERR) + IF (IERR .LT. 0) THEN + WRITE(*,*)MYID_OOC,': Internal error Mila 5 ', + & ' IERR on return to CMUMPS_608 =', + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_612 + SUBROUTINE CMUMPS_583(PTRFAC,NSTEPS,MTYPE, + & A,LA,DOPREFETCH,IERR) + IMPLICIT NONE + INTEGER NSTEPS,MTYPE + INTEGER, intent(out)::IERR + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + LOGICAL DOPREFETCH + INTEGER MUMPS_808 + EXTERNAL MUMPS_808 + IERR = 0 + OOC_FCT_TYPE=MUMPS_808("F",MTYPE,KEEP_OOC(201), + & KEEP_OOC(50)) + OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1 + IF (KEEP_OOC(201).NE.1) THEN + OOC_SOLVE_TYPE_FCT = FCT + ENDIF + SOLVE_STEP=0 + CUR_POS_SEQUENCE=1 + MTYPE_OOC=MTYPE + IF ( KEEP_OOC(201).NE.1 +#if ! defined(TEMP_VERSION_TO_FORCE_DATA_REINIT) + & .OR. KEEP_OOC(50).NE.0 +#endif + & ) THEN + CALL CMUMPS_612(PTRFAC,NSTEPS,A,LA) + ELSE + CALL CMUMPS_683(KEEP_OOC(28), + & KEEP_OOC(38), KEEP_OOC(20) ) + ENDIF + IF (DOPREFETCH) THEN + CALL CMUMPS_585(A,LA,PTRFAC, + & KEEP_OOC(28),IERR) + ELSE + CUR_POS_SEQUENCE = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + ENDIF + RETURN + END SUBROUTINE CMUMPS_583 + SUBROUTINE CMUMPS_584(PTRFAC,NSTEPS,MTYPE, + & I_WORKED_ON_ROOT,IROOT,A,LA,IERR) + IMPLICIT NONE + INTEGER NSTEPS + INTEGER(8) :: LA + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER MTYPE + INTEGER IROOT + LOGICAL I_WORKED_ON_ROOT + INTEGER, intent(out):: IERR + COMPLEX A(LA) + INTEGER(8) :: DUMMY_SIZE + INTEGER ZONE + INTEGER MUMPS_808 + EXTERNAL MUMPS_808 + IERR=0 + OOC_FCT_TYPE=MUMPS_808("B",MTYPE,KEEP_OOC(201), + & KEEP_OOC(50)) + OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1 + IF (KEEP_OOC(201).NE.1) OOC_SOLVE_TYPE_FCT=FCT + SOLVE_STEP=1 + CUR_POS_SEQUENCE=TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + MTYPE_OOC=MTYPE + IF ( KEEP_OOC(201).NE.1 +#if ! defined(TEMP_VERSION_TO_FORCE_DATA_REINIT) + & .OR. KEEP_OOC(50).NE.0 +#endif + & ) THEN + CALL CMUMPS_612(PTRFAC,NSTEPS,A,LA) + IF (I_WORKED_ON_ROOT) THEN + CALL CMUMPS_598 ( IROOT, + & PTRFAC, KEEP_OOC(28), A, LA,.FALSE.,IERR) + IF (IERR .LT. 0) RETURN + CALL CMUMPS_600(IROOT, + & ZONE,PTRFAC,NSTEPS) + IF(IROOT.EQ.NB_Z)THEN + DUMMY_SIZE=1_8 + CALL CMUMPS_608(A,LA, + & DUMMY_SIZE,PTRFAC, + & NSTEPS,NB_Z,IERR) + IF (IERR .LT. 0) THEN + WRITE(*,*)MYID_OOC,': Internal error in + & CMUMPS_608', + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + IF (NB_Z.GT.1) THEN + CALL CMUMPS_594(A,LA,PTRFAC, + & KEEP_OOC(28),IERR) + IF (IERR .LT. 0) RETURN + ENDIF + ELSE + CALL CMUMPS_683(KEEP_OOC(28), + & KEEP_OOC(38), KEEP_OOC(20) ) + CALL CMUMPS_585(A,LA,PTRFAC,KEEP_OOC(28),IERR) + IF (IERR .LT. 0 ) RETURN + ENDIF + RETURN + END SUBROUTINE CMUMPS_584 + SUBROUTINE CMUMPS_613(id,IERR) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(CMUMPS_STRUC), TARGET :: id + INTEGER, intent(out) :: IERR + INTEGER I,DIM,J,TMP,SIZE,K,I1 + CHARACTER*1 TMP_NAME(350) + EXTERNAL MUMPS_OOC_GET_NB_FILES_C, MUMPS_OOC_GET_FILE_NAME_C + IERR=0 + SIZE=0 + DO J=1,OOC_NB_FILE_TYPE + TMP=J-1 + CALL MUMPS_OOC_GET_NB_FILES_C(TMP,I) + id%OOC_NB_FILES(J)=I + SIZE=SIZE+I + ENDDO + IF(associated(id%OOC_FILE_NAMES))THEN + DEALLOCATE(id%OOC_FILE_NAMES) + NULLIFY(id%OOC_FILE_NAMES) + ENDIF + ALLOCATE(id%OOC_FILE_NAMES(SIZE,350),stat=IERR) + IF (IERR .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_613' + IERR=-1 + IF(id%INFO(1).GE.0)THEN + id%INFO(1) = -13 + id%INFO(2) = SIZE*350 + RETURN + ENDIF + ENDIF + IF(associated(id%OOC_FILE_NAME_LENGTH))THEN + DEALLOCATE(id%OOC_FILE_NAME_LENGTH) + NULLIFY(id%OOC_FILE_NAME_LENGTH) + ENDIF + ALLOCATE(id%OOC_FILE_NAME_LENGTH(SIZE),stat=IERR) + IF (IERR .GT. 0) THEN + IERR=-1 + IF(id%INFO(1).GE.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) + & 'PB allocation in CMUMPS_613' + id%INFO(1) = -13 + id%INFO(2) = SIZE + RETURN + ENDIF + ENDIF + K=1 + DO I1=1,OOC_NB_FILE_TYPE + TMP=I1-1 + DO I=1,id%OOC_NB_FILES(I1) + CALL MUMPS_OOC_GET_FILE_NAME_C(TMP,I,DIM,TMP_NAME(1)) + DO J=1,DIM+1 + id%OOC_FILE_NAMES(K,J)=TMP_NAME(J) + ENDDO + id%OOC_FILE_NAME_LENGTH(K)=DIM+1 + K=K+1 + ENDDO + ENDDO + END SUBROUTINE CMUMPS_613 + SUBROUTINE CMUMPS_614(id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(CMUMPS_STRUC), TARGET :: id + CHARACTER*1 TMP_NAME(350) + INTEGER I,I1,TMP,J,K,L,DIM,IERR + INTEGER, DIMENSION(:),ALLOCATABLE :: NB_FILES + INTEGER K211 + ALLOCATE(NB_FILES(OOC_NB_FILE_TYPE),stat=IERR) + IF (IERR .GT. 0) THEN + IERR=-1 + IF(id%INFO(1).GE.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) + & 'PB allocation in CMUMPS_614' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + ENDIF + IERR=0 + NB_FILES=id%OOC_NB_FILES + I=id%MYID + K=id%KEEP(35) + L=mod(id%KEEP(204),3) + K211=id%KEEP(211) + CALL MUMPS_OOC_ALLOC_POINTERS_C(OOC_NB_FILE_TYPE,NB_FILES,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + CALL MUMPS_OOC_INIT_VARS_C(I,K,L,K211,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + K=1 + DO I1=1,OOC_NB_FILE_TYPE + DO I=1,NB_FILES(I1) + DIM=id%OOC_FILE_NAME_LENGTH(K) + DO J=1,DIM + TMP_NAME(J)=id%OOC_FILE_NAMES(K,J) + ENDDO + TMP=I1-1 + CALL MUMPS_OOC_SET_FILE_NAME_C(TMP,I,DIM,IERR,TMP_NAME(1)) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + K=K+1 + ENDDO + ENDDO + CALL MUMPS_OOC_START_LOW_LEVEL(IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + DEALLOCATE(NB_FILES) + RETURN + END SUBROUTINE CMUMPS_614 + SUBROUTINE CMUMPS_589(DEST,SRC,NB,NB_EFF) + IMPLICIT NONE + INTEGER NB, NB_EFF + CHARACTER(LEN=NB) SRC + CHARACTER*1 DEST(NB) + INTEGER I + DO I=1,NB_EFF + DEST(I)=SRC(I:I) + ENDDO + END SUBROUTINE CMUMPS_589 + SUBROUTINE CMUMPS_580(IERR) + USE CMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, intent(out) :: IERR + IERR=0 + IF(.NOT.WITH_BUF)THEN + RETURN + ENDIF + CALL CMUMPS_707(OOC_FCT_TYPE,IERR) + IF (IERR < 0) THEN + RETURN + ENDIF + RETURN + END SUBROUTINE CMUMPS_580 + SUBROUTINE CMUMPS_681(IERR) + USE CMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, intent(out) :: IERR + INTEGER I + IERR=0 + IF(.NOT.WITH_BUF)THEN + RETURN + ENDIF + DO I=1,OOC_NB_FILE_TYPE + CALL CMUMPS_707(I,IERR) + IF (IERR < 0) RETURN + ENDDO + RETURN + END SUBROUTINE CMUMPS_681 + SUBROUTINE CMUMPS_683(NSTEPS, + & KEEP38, KEEP20) + IMPLICIT NONE + INTEGER NSTEPS + INTEGER I, J + INTEGER(8) :: TMP_SIZE8 + INTEGER KEEP38, KEEP20 + INODE_TO_POS = 0 + POS_IN_MEM = 0 + OOC_STATE_NODE(1:NSTEPS)=0 + TMP_SIZE8=1_8 + J=1 + DO I=1,NB_Z-1 + IDEB_SOLVE_Z(I)=TMP_SIZE8 + PDEB_SOLVE_Z(I)=J + POSFAC_SOLVE(I)=TMP_SIZE8 + LRLUS_SOLVE(I) =SIZE_ZONE_SOLVE + LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE + LRLU_SOLVE_B(I)=0_8 + SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE + CURRENT_POS_T(I)=J + CURRENT_POS_B(I)=J + POS_HOLE_T(I) =J + POS_HOLE_B(I) =J + J = J + MAX_NB_NODES_FOR_ZONE + TMP_SIZE8 = TMP_SIZE8 + SIZE_ZONE_SOLVE + ENDDO + IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8 + PDEB_SOLVE_Z(NB_Z)=J + POSFAC_SOLVE(NB_Z)=TMP_SIZE8 + LRLUS_SOLVE(NB_Z) =SIZE_SOLVE_EMM + LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM + LRLU_SOLVE_B(NB_Z)=0_8 + SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM + CURRENT_POS_T(NB_Z)=J + CURRENT_POS_B(NB_Z)=J + POS_HOLE_T(NB_Z) =J + POS_HOLE_B(NB_Z) =J + IO_REQ=-77777 + SIZE_OF_READ=-9999_8 + FIRST_POS_IN_READ=-9999 + READ_DEST=-9999_8 + READ_MNG=-9999 + REQ_TO_ZONE=-9999 + REQ_ID=-9999 + RETURN + END SUBROUTINE CMUMPS_683 + SUBROUTINE CMUMPS_688 + & ( STRAT, TYPEFile, + & AFAC, LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW, LIWFAC, + & MYID, FILESIZE, IERR , LAST_CALL) + IMPLICIT NONE + TYPE(IO_BLOCK), INTENT(INOUT):: MonBloc + INTEGER(8) :: LAFAC + INTEGER, INTENT(IN) :: STRAT, LIWFAC, + & MYID, TYPEFile + INTEGER, INTENT(INOUT) :: IW(0:LIWFAC-1) + COMPLEX, INTENT(IN) :: AFAC(LAFAC) + INTEGER, INTENT(INOUT) :: LNextPiv2beWritten, + & UNextPiv2beWritten + INTEGER(8), INTENT(INOUT) :: FILESIZE + INTEGER, INTENT(OUT) :: IERR + LOGICAL, INTENT(IN) :: LAST_CALL + INTEGER(8) :: TMPSIZE_OF_BLOCK + INTEGER :: TempFTYPE + LOGICAL WRITE_L, WRITE_U + LOGICAL DO_U_FIRST + INCLUDE 'mumps_headers.h' + IERR = 0 + IF (KEEP_OOC(50).EQ.0 + & .AND.KEEP_OOC(251).EQ.2) THEN + WRITE_L = .FALSE. + ELSE + WRITE_L = (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_L) + ENDIF + WRITE_U = (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_U) + DO_U_FIRST = .FALSE. + IF ( TYPEFile.EQ.TYPEF_BOTH_LU ) THEN + IF ( LNextPiv2beWritten .GT. UNextPiv2beWritten ) THEN + DO_U_FIRST = .TRUE. + END IF + END IF + IF (DO_U_FIRST) GOTO 200 + 100 IF (WRITE_L .AND. TYPEF_L > 0 ) THEN + TempFTYPE = TYPEF_L + IF ((MonBloc%Typenode.EQ.2).AND.(.NOT.MonBloc%MASTER)) + & THEN + TMPSIZE_OF_BLOCK = SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE), + & TempFTYPE) + IF (TMPSIZE_OF_BLOCK .LT. 0_8) THEN + TMPSIZE_OF_BLOCK = -TMPSIZE_OF_BLOCK - 1_8 + ENDIF + LNextPiv2beWritten = + & int( + & TMPSIZE_OF_BLOCK + & / int(MonBloc%NROW,8) + & ) + & + 1 + ENDIF + CALL CMUMPS_695( STRAT, + & TempFTYPE, AFAC, LAFAC, MonBloc, + & IERR, + & LNextPiv2beWritten, + & OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE), + & SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE), + & FILESIZE, LAST_CALL ) + IF (IERR .LT. 0) RETURN + IF (DO_U_FIRST) GOTO 300 + ENDIF + 200 IF (WRITE_U) THEN + TempFTYPE = TYPEF_U + CALL CMUMPS_695( STRAT, + & TempFTYPE, AFAC, LAFAC, MonBloc, + & IERR, + & UNextPiv2beWritten, + & OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE), + & SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE), + & FILESIZE, LAST_CALL) + IF (IERR .LT. 0) RETURN + IF (DO_U_FIRST) GOTO 100 + ENDIF + 300 CONTINUE + RETURN + END SUBROUTINE CMUMPS_688 + SUBROUTINE CMUMPS_695( STRAT, TYPEF, + & AFAC, LAFAC, MonBloc, + & IERR, + & LorU_NextPiv2beWritten, + & LorU_AddVirtNodeI8, LorUSIZE_OF_BLOCK, + & FILESIZE, LAST_CALL + & ) + USE CMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, INTENT(IN) :: STRAT + INTEGER, INTENT(IN) :: TYPEF + INTEGER(8), INTENT(INOUT) :: FILESIZE + INTEGER(8), INTENT(IN) :: LAFAC + COMPLEX, INTENT(IN) :: AFAC(LAFAC) + INTEGER, INTENT(INOUT) :: LorU_NextPiv2beWritten + INTEGER(8), INTENT(INOUT) :: LorU_AddVirtNodeI8 + INTEGER(8), INTENT(INOUT) :: LorUSIZE_OF_BLOCK + TYPE(IO_BLOCK), INTENT(INOUT) :: MonBloc + INTEGER, INTENT(OUT) :: IERR + LOGICAL, INTENT(IN) :: LAST_CALL + INTEGER NNMAX + INTEGER(8) :: TOTSIZE, EFFSIZE + INTEGER(8) :: TailleEcrite + INTEGER SIZE_PANEL + INTEGER(8) :: AddVirtCour + LOGICAL VIRT_ADD_RESERVED_BEF_CALL + LOGICAL VIRTUAL_ADDRESS_JUST_RESERVED + LOGICAL HOLE_PROCESSED_BEFORE_CALL + LOGICAL TMP_ESTIM + INTEGER ICUR, INODE_CUR, ILAST + INTEGER(8) :: ADDR_LAST + IERR = 0 + IF (TYPEF == TYPEF_L ) THEN + NNMAX = MonBloc%NROW + ELSE + NNMAX = MonBloc%NCOL + ENDIF + SIZE_PANEL = CMUMPS_690(NNMAX) + IF ( (.NOT.MonBloc%Last) .AND. + & (MonBloc%LastPiv-LorU_NextPiv2beWritten+1.LT.SIZE_PANEL)) + & THEN + RETURN + ENDIF + TMP_ESTIM = .TRUE. + TOTSIZE = CMUMPS_725 + & (MonBloc%NFS, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM) + IF (MonBloc%Last) THEN + TMP_ESTIM=.FALSE. + EFFSIZE = CMUMPS_725 + & (MonBloc%LastPiv, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM) + ELSE + EFFSIZE = -1034039740327_8 + ENDIF + IF (MonBloc%Typenode.EQ.3.AND. MonBloc%NFS.NE.MonBloc%NCOL) THEN + WRITE(*,*) 'Internal error in CMUMPS_695 for type3', + & MonBloc%NFS,MonBloc%NCOL + CALL MUMPS_ABORT() + ENDIF + IF (MonBloc%Typenode.EQ.3.AND. TYPEF.NE.TYPEF_L) THEN + WRITE(*,*) 'Internal error in CMUMPS_695,TYPEF=', + & TYPEF, 'for typenode=3' + CALL MUMPS_ABORT() + ENDIF + IF (MonBloc%Typenode.EQ.2.AND. + & TYPEF.EQ.TYPEF_U.AND. + & .NOT. MonBloc%MASTER ) THEN + WRITE(*,*) 'Internal error in CMUMPS_695', + & MonBloc%MASTER,MonBloc%Typenode, TYPEF + CALL MUMPS_ABORT() + ENDIF + HOLE_PROCESSED_BEFORE_CALL = (LorUSIZE_OF_BLOCK .LT. 0_8) + IF (HOLE_PROCESSED_BEFORE_CALL.AND.(.NOT.MonBloc%Last)) THEN + WRITE(6,*) ' Internal error in CMUMPS_695 ', + & ' last is false after earlier calls with last=true' + CALL MUMPS_ABORT() + ENDIF + IF (HOLE_PROCESSED_BEFORE_CALL) THEN + LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 + TOTSIZE = -99999999_8 + ENDIF + VIRTUAL_ADDRESS_JUST_RESERVED = .FALSE. + VIRT_ADD_RESERVED_BEF_CALL = + & ( LorUSIZE_OF_BLOCK .NE. 0_8 .OR. + & HOLE_PROCESSED_BEFORE_CALL ) + IF (MonBloc%Last .AND. .NOT. HOLE_PROCESSED_BEFORE_CALL) THEN + KEEP_OOC(228) = max(KEEP_OOC(228), + & (MonBloc%LastPiv+SIZE_PANEL-1) / SIZE_PANEL) + IF (VIRT_ADD_RESERVED_BEF_CALL) THEN + IF (AddVirtLibre(TYPEF).EQ. + & (LorU_AddVirtNodeI8+TOTSIZE) ) THEN + AddVirtLibre(TYPEF) = LorU_AddVirtNodeI8 + EFFSIZE + ENDIF + ELSE + VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE. + IF (EFFSIZE .EQ. 0_8) THEN + LorU_AddVirtNodeI8 = -9999_8 + ELSE + LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF) + ENDIF + AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + EFFSIZE + ENDIF + ELSE + IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL + & ) THEN + LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF) + AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + TOTSIZE + ENDIF + ENDIF + AddVirtCour = LorU_AddVirtNodeI8 + LorUSIZE_OF_BLOCK + CALL CMUMPS_697( STRAT, TYPEF, MonBloc, + & SIZE_PANEL, + & AFAC, LAFAC, + & LorU_NextPiv2beWritten, AddVirtCour, + & TailleEcrite, + & IERR ) + IF ( IERR .LT. 0 ) RETURN + LorUSIZE_OF_BLOCK = LorUSIZE_OF_BLOCK + TailleEcrite + IF (LorUSIZE_OF_BLOCK.EQ.0_8 ) THEN + IF ( .NOT. VIRT_ADD_RESERVED_BEF_CALL + & .AND. .NOT. VIRTUAL_ADDRESS_JUST_RESERVED ) + & THEN + AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) - TOTSIZE + LorU_AddVirtNodeI8 = 0_8 + ENDIF + ELSE IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL ) THEN + VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE. + ENDIF + IF ( VIRTUAL_ADDRESS_JUST_RESERVED) THEN + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(TYPEF), + & TYPEF) = MonBloc%INODE + I_CUR_HBUF_NEXTPOS(TYPEF) = I_CUR_HBUF_NEXTPOS(TYPEF) + 1 + IF (MonBloc%Last) THEN + MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,EFFSIZE) + TMP_SIZE_FACT=TMP_SIZE_FACT+EFFSIZE + ELSE + MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,TOTSIZE) + TMP_SIZE_FACT=TMP_SIZE_FACT+TOTSIZE + ENDIF + TMP_NB_NODES=TMP_NB_NODES+1 + IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN + MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE, + & TMP_NB_NODES) + TMP_SIZE_FACT=0_8 + TMP_NB_NODES=0 + ENDIF + ENDIF + IF (MonBloc%Last) THEN + LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 + ENDIF + IF (LAST_CALL) THEN + IF (.NOT.MonBloc%Last) THEN + WRITE(6,*) ' Internal error in CMUMPS_695 ', + & ' LAST and LAST_CALL are incompatible ' + CALL MUMPS_ABORT() + ENDIF + LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 + ICUR = I_CUR_HBUF_NEXTPOS(TYPEF) - 1 + INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF) + ADDR_LAST = AddVirtLibre(TYPEF) + IF (INODE_CUR .NE. MonBloc%INODE) THEN + 10 CONTINUE + ILAST = ICUR + IF ( OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF) .NE. -9999_8) THEN + ADDR_LAST = OOC_VADDR(STEP_OOC(INODE_CUR), TYPEF) + ENDIF + ICUR = ICUR - 1 + INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF) + IF (INODE_CUR .EQ. MonBloc%INODE) THEN + LorUSIZE_OF_BLOCK = ADDR_LAST - + & OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF) + ELSE + IF (ICUR .LE. 1) THEN + WRITE(*,*) "Internal error in CMUMPS_695" + WRITE(*,*) "Did not find current node in sequence" + CALL MUMPS_ABORT() + ENDIF + GOTO 10 + ENDIF + ENDIF + FILESIZE = FILESIZE + LorUSIZE_OF_BLOCK + ENDIF + RETURN + END SUBROUTINE CMUMPS_695 + SUBROUTINE CMUMPS_697( + & STRAT, TYPEF, MonBloc, + & SIZE_PANEL, + & AFAC, LAFAC, + & NextPiv2beWritten, AddVirtCour, + & TailleEcrite, IERR ) + USE CMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, INTENT(IN) :: STRAT, TYPEF, SIZE_PANEL + INTEGER(8) :: LAFAC + INTEGER(8), INTENT(IN) :: AddVirtCour + COMPLEX, INTENT(IN) :: AFAC(LAFAC) + INTEGER, INTENT(INOUT) :: NextPiv2beWritten + TYPE(IO_BLOCK),INTENT(INOUT) :: MonBloc + INTEGER(8), INTENT(OUT) :: TailleEcrite + INTEGER, INTENT(OUT) :: IERR + INTEGER :: I, NBeff, LPANELeff, IEND + INTEGER(8) :: AddVirtDeb + IERR = 0 + TailleEcrite = 0_8 + AddVirtDeb = AddVirtCour + I = NextPiv2beWritten + IF ( NextPiv2beWritten .GT. MonBloc%LastPiv ) THEN + RETURN + ENDIF + 10 CONTINUE + NBeff = min(SIZE_PANEL,MonBloc%LastPiv-I+1 ) + IF ((NBeff.NE.SIZE_PANEL) .AND. (.NOT.MonBloc%Last)) THEN + GOTO 20 + ENDIF + IF (TYPEF.EQ.TYPEF_L.AND.MonBloc%MASTER.AND. + & KEEP_OOC(50).EQ.2 .AND. MonBloc%Typenode.NE.3) THEN + IF (MonBloc%INDICES(NBeff+I-1) < 0) + & THEN + NBeff=NBeff+1 + ENDIF + ENDIF + IEND = I + NBeff -1 + CALL CMUMPS_653( STRAT, TYPEF, MonBloc, + & AFAC, LAFAC, + & AddVirtDeb, I, IEND, LPANELeff, + & IERR) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + IF ( IERR .EQ. 1 ) THEN + IERR=0 + GOTO 20 + ENDIF + IF (TYPEF .EQ. TYPEF_L) THEN + MonBloc%LastPanelWritten_L = MonBloc%LastPanelWritten_L+1 + ELSE + MonBloc%LastPanelWritten_U = MonBloc%LastPanelWritten_U+1 + ENDIF + AddVirtDeb = AddVirtDeb + int(LPANELeff,8) + TailleEcrite = TailleEcrite + int(LPANELeff,8) + I=I+NBeff + IF ( I .LE. MonBloc%LastPiv ) GOTO 10 + 20 CONTINUE + NextPiv2beWritten = I + RETURN + END SUBROUTINE CMUMPS_697 + INTEGER(8) FUNCTION CMUMPS_725 + & (NFSorNPIV, NNMAX, SIZE_PANEL, MonBloc, ESTIM) + IMPLICIT NONE + TYPE(IO_BLOCK), INTENT(IN):: MonBloc + INTEGER, INTENT(IN) :: NFSorNPIV, NNMAX, SIZE_PANEL + LOGICAL, INTENT(IN) :: ESTIM + INTEGER :: I, NBeff + INTEGER(8) :: TOTSIZE + TOTSIZE = 0_8 + IF (NFSorNPIV.EQ.0) GOTO 100 + IF (.NOT. MonBloc%MASTER .OR. MonBloc%Typenode.EQ.3) THEN + TOTSIZE = int(NFSorNPIV,8) * int(NNMAX,8) + ELSE + I = 1 + 10 CONTINUE + NBeff = min(SIZE_PANEL, NFSorNPIV-I+1) + IF (KEEP_OOC(50).EQ.2) THEN + IF (ESTIM) THEN + NBeff = NBeff + 1 + ELSE + IF (MonBloc%INDICES(I+NBeff-1) < 0) THEN + NBeff = NBeff + 1 + ENDIF + ENDIF + ENDIF + TOTSIZE = TOTSIZE + + & int(NNMAX-I+1,8) * int(NBeff,8) + I = I + NBeff + IF ( I .LE. NFSorNPIV ) GOTO 10 + ENDIF + 100 CONTINUE + CMUMPS_725 = TOTSIZE + RETURN + END FUNCTION CMUMPS_725 + INTEGER FUNCTION CMUMPS_690( NNMAX ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NNMAX + INTEGER CMUMPS_748 + CMUMPS_690=CMUMPS_748( + & HBUF_SIZE, NNMAX, KEEP_OOC(227),KEEP_OOC(50)) + RETURN + END FUNCTION CMUMPS_690 + SUBROUTINE CMUMPS_728() + IMPLICIT NONE + INTEGER I,TMP_NODE + IF(.NOT.CMUMPS_727())THEN + IF(SOLVE_STEP.EQ.0)THEN + I=CUR_POS_SEQUENCE + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE ((I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND. + & (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + & .EQ.0_8)) + INODE_TO_POS(STEP_OOC(TMP_NODE))=1 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + I=I+1 + IF(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + ENDIF + ENDDO + CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) + ELSE + I=CUR_POS_SEQUENCE + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE ((I.GE.1).AND. + & (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + & .EQ.0_8)) + INODE_TO_POS(STEP_OOC(TMP_NODE))=1 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + I=I-1 + IF(I.GE.1)THEN + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + ENDIF + ENDDO + CUR_POS_SEQUENCE=max(I,1) + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_728 + SUBROUTINE CMUMPS_809(N,KEEP201, + & Pruned_List,nb_prun_nodes,STEP) + IMPLICIT NONE + INTEGER, INTENT(IN) :: N, KEEP201, nb_prun_nodes + INTEGER, INTENT(IN) :: STEP(N), + & Pruned_List(nb_prun_nodes) + INTEGER I, ISTEP + IF (KEEP201 .GT. 0) THEN + OOC_STATE_NODE(:) = ALREADY_USED + DO I = 1, nb_prun_nodes + ISTEP = STEP(Pruned_List(I)) + OOC_STATE_NODE(ISTEP) = NOT_IN_MEM + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_809 + END MODULE CMUMPS_OOC diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_ooc_buffer.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_ooc_buffer.F new file mode 100644 index 000000000..fd13c1f81 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_ooc_buffer.F @@ -0,0 +1,570 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE CMUMPS_OOC_BUFFER + USE MUMPS_OOC_COMMON + IMPLICIT NONE + PUBLIC + INTEGER FIRST_HBUF,SECOND_HBUF + PARAMETER (FIRST_HBUF=0, SECOND_HBUF=1) + INTEGER,SAVE :: OOC_FCT_TYPE_LOC + INTEGER IO_STRAT + COMPLEX, DIMENSION(:),ALLOCATABLE :: BUF_IO + LOGICAL,SAVE :: PANEL_FLAG + INTEGER,SAVE :: EARLIEST_WRITE_MIN_SIZE + INTEGER(8),SAVE,DIMENSION(:), ALLOCATABLE :: + & I_SHIFT_FIRST_HBUF, I_SHIFT_SECOND_HBUF, + & I_SHIFT_CUR_HBUF, I_REL_POS_CUR_HBUF + INTEGER, SAVE, DIMENSION(:), ALLOCATABLE :: + & LAST_IOREQUEST, CUR_HBUF + INTEGER, DIMENSION(:),ALLOCATABLE :: I_CUR_HBUF_NEXTPOS + INTEGER,SAVE :: I_CUR_HBUF_FSTPOS, + & I_SUB_HBUF_FSTPOS + INTEGER(8) :: BufferEmpty + PARAMETER (BufferEmpty=-1_8) + INTEGER(8), DIMENSION(:),ALLOCATABLE :: NextAddVirtBuffer + INTEGER(8), DIMENSION(:),ALLOCATABLE :: FIRST_VADDR_IN_BUF + CONTAINS + SUBROUTINE CMUMPS_689(TYPEF_ARG) + IMPLICIT NONE + INTEGER TYPEF_ARG + SELECT CASE(CUR_HBUF(TYPEF_ARG)) + CASE (FIRST_HBUF) + CUR_HBUF(TYPEF_ARG) = SECOND_HBUF + I_SHIFT_CUR_HBUF(TYPEF_ARG) = + & I_SHIFT_SECOND_HBUF(TYPEF_ARG) + CASE (SECOND_HBUF) + CUR_HBUF(TYPEF_ARG) = FIRST_HBUF + I_SHIFT_CUR_HBUF(TYPEF_ARG) = + & I_SHIFT_FIRST_HBUF(TYPEF_ARG) + END SELECT + IF(.NOT.PANEL_FLAG)THEN + I_SUB_HBUF_FSTPOS =I_CUR_HBUF_FSTPOS + I_CUR_HBUF_FSTPOS =I_CUR_HBUF_NEXTPOS(TYPEF_ARG) + ENDIF + I_REL_POS_CUR_HBUF(TYPEF_ARG) = 1_8 + RETURN + END SUBROUTINE CMUMPS_689 + SUBROUTINE CMUMPS_707(TYPEF_ARG,IERR) + IMPLICIT NONE + INTEGER TYPEF_ARG + INTEGER NEW_IOREQUEST + INTEGER IERR + IERR=0 + CALL CMUMPS_696(TYPEF_ARG,NEW_IOREQUEST, + & IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IERR=0 + CALL MUMPS_WAIT_REQUEST(LAST_IOREQUEST(TYPEF_ARG),IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + LAST_IOREQUEST(TYPEF_ARG) = NEW_IOREQUEST + CALL CMUMPS_689(TYPEF_ARG) + IF(PANEL_FLAG)THEN + NextAddVirtBuffer(TYPEF_ARG)=BufferEmpty + ENDIF + RETURN + END SUBROUTINE CMUMPS_707 + SUBROUTINE CMUMPS_675(IERR) + IMPLICIT NONE + INTEGER, intent(out) :: IERR + INTEGER TYPEF_LAST + INTEGER TYPEF_LOC + IERR = 0 + TYPEF_LAST = OOC_NB_FILE_TYPE + DO TYPEF_LOC = 1, TYPEF_LAST + IERR=0 + CALL CMUMPS_707(TYPEF_LOC,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IERR=0 + CALL CMUMPS_707(TYPEF_LOC,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_675 + SUBROUTINE CMUMPS_696(TYPEF_ARG,IOREQUEST, + & IERR) + IMPLICIT NONE + INTEGER IOREQUEST,IERR + INTEGER TYPEF_ARG + INTEGER FIRST_INODE + INTEGER(8) :: FROM_BUFIO_POS, SIZE + INTEGER TYPE + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER(8) TMP_VADDR + INTEGER SIZE_INT1,SIZE_INT2 + IERR=0 + IF (I_REL_POS_CUR_HBUF(TYPEF_ARG) == 1_8) THEN + IOREQUEST=-1 + RETURN + END IF + IF(PANEL_FLAG)THEN + TYPE=TYPEF_ARG-1 + FIRST_INODE=-9999 + TMP_VADDR=FIRST_VADDR_IN_BUF(TYPEF_ARG) + ELSE + TYPE=FCT + FIRST_INODE = + & OOC_INODE_SEQUENCE(I_CUR_HBUF_FSTPOS,TYPEF_ARG) + TMP_VADDR=OOC_VADDR(STEP_OOC(FIRST_INODE),TYPEF_ARG) + ENDIF + FROM_BUFIO_POS=I_SHIFT_CUR_HBUF(TYPEF_ARG)+1_8 + SIZE = I_REL_POS_CUR_HBUF(TYPEF_ARG)-1_8 + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & TMP_VADDR) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, + & BUF_IO(FROM_BUFIO_POS),SIZE_INT1,SIZE_INT2, + & FIRST_INODE,IOREQUEST, + & TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + RETURN + END SUBROUTINE CMUMPS_696 + SUBROUTINE CMUMPS_669(I1,I2,IERR) + IMPLICIT NONE + INTEGER I1,I2,IERR + INTEGER allocok + IERR=0 + PANEL_FLAG=.FALSE. + IF(allocated(I_SHIFT_FIRST_HBUF))THEN + DEALLOCATE(I_SHIFT_FIRST_HBUF) + ENDIF + IF(allocated(I_SHIFT_SECOND_HBUF))THEN + DEALLOCATE(I_SHIFT_SECOND_HBUF) + ENDIF + IF(allocated(I_SHIFT_CUR_HBUF))THEN + DEALLOCATE(I_SHIFT_CUR_HBUF) + ENDIF + IF(allocated(I_REL_POS_CUR_HBUF))THEN + DEALLOCATE(I_REL_POS_CUR_HBUF) + ENDIF + IF(allocated(LAST_IOREQUEST))THEN + DEALLOCATE(LAST_IOREQUEST) + ENDIF + IF(allocated(CUR_HBUF))THEN + DEALLOCATE(CUR_HBUF) + ENDIF + DIM_BUF_IO = int(KEEP_OOC(100),8) + ALLOCATE(I_SHIFT_FIRST_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(I_SHIFT_SECOND_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(I_SHIFT_CUR_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(I_REL_POS_CUR_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(LAST_IOREQUEST(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(CUR_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + OOC_FCT_TYPE_LOC=OOC_NB_FILE_TYPE + ALLOCATE(BUF_IO(DIM_BUF_IO), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' + I1 = -13 + CALL MUMPS_731(DIM_BUF_IO, I2) + RETURN + ENDIF + PANEL_FLAG=(KEEP_OOC(201).EQ.1) + IF (PANEL_FLAG) THEN + IERR=0 + KEEP_OOC(228)=0 + IF(allocated(AddVirtLibre))THEN + DEALLOCATE(AddVirtLibre) + ENDIF + ALLOCATE(AddVirtLibre(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC_BUF_PANEL' + IERR=-1 + I1=-13 + I2=OOC_NB_FILE_TYPE + RETURN + ENDIF + AddVirtLibre(1:OOC_NB_FILE_TYPE)=0_8 + IF(allocated(NextAddVirtBuffer))THEN + DEALLOCATE(NextAddVirtBuffer) + ENDIF + ALLOCATE(NextAddVirtBuffer(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC_BUF_PANEL' + IERR=-1 + I1=-13 + I2=OOC_NB_FILE_TYPE + RETURN + ENDIF + NextAddVirtBuffer (1:OOC_NB_FILE_TYPE) = BufferEmpty + IF(allocated(FIRST_VADDR_IN_BUF))THEN + DEALLOCATE(FIRST_VADDR_IN_BUF) + ENDIF + ALLOCATE(FIRST_VADDR_IN_BUF(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC_BUF_PANEL' + IERR=-1 + I1=-13 + I2=OOC_NB_FILE_TYPE + RETURN + ENDIF + CALL CMUMPS_686() + ELSE + CALL CMUMPS_685() + ENDIF + RETURN + END SUBROUTINE CMUMPS_669 + SUBROUTINE CMUMPS_659() + IMPLICIT NONE + IF(allocated(BUF_IO))THEN + DEALLOCATE(BUF_IO) + ENDIF + IF(allocated(I_SHIFT_FIRST_HBUF))THEN + DEALLOCATE(I_SHIFT_FIRST_HBUF) + ENDIF + IF(allocated(I_SHIFT_SECOND_HBUF))THEN + DEALLOCATE(I_SHIFT_SECOND_HBUF) + ENDIF + IF(allocated(I_SHIFT_CUR_HBUF))THEN + DEALLOCATE(I_SHIFT_CUR_HBUF) + ENDIF + IF(allocated(I_REL_POS_CUR_HBUF))THEN + DEALLOCATE(I_REL_POS_CUR_HBUF) + ENDIF + IF(allocated(LAST_IOREQUEST))THEN + DEALLOCATE(LAST_IOREQUEST) + ENDIF + IF(allocated(CUR_HBUF))THEN + DEALLOCATE(CUR_HBUF) + ENDIF + IF(PANEL_FLAG)THEN + IF(allocated(NextAddVirtBuffer))THEN + DEALLOCATE(NextAddVirtBuffer) + ENDIF + IF(allocated(AddVirtLibre))THEN + DEALLOCATE(AddVirtLibre) + ENDIF + IF(allocated(FIRST_VADDR_IN_BUF))THEN + DEALLOCATE(FIRST_VADDR_IN_BUF) + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_659 + SUBROUTINE CMUMPS_685() + IMPLICIT NONE + OOC_FCT_TYPE_LOC=1 + HBUF_SIZE = DIM_BUF_IO / int(2,kind=kind(DIM_BUF_IO)) + EARLIEST_WRITE_MIN_SIZE = 0 + I_SHIFT_FIRST_HBUF(OOC_FCT_TYPE_LOC) = 0_8 + I_SHIFT_SECOND_HBUF(OOC_FCT_TYPE_LOC) = HBUF_SIZE + LAST_IOREQUEST(OOC_FCT_TYPE_LOC) = -1 + I_CUR_HBUF_NEXTPOS = 1 + I_CUR_HBUF_FSTPOS = 1 + I_SUB_HBUF_FSTPOS = 1 + CUR_HBUF(OOC_FCT_TYPE_LOC) = SECOND_HBUF + CALL CMUMPS_689(OOC_FCT_TYPE_LOC) + END SUBROUTINE CMUMPS_685 + SUBROUTINE CMUMPS_678(BLOCK,SIZE_OF_BLOCK, + & IERR) + IMPLICIT NONE + INTEGER(8) :: SIZE_OF_BLOCK + COMPLEX BLOCK(SIZE_OF_BLOCK) + INTEGER, intent(out) :: IERR + INTEGER(8) :: I + IERR=0 + IF (I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) + + & SIZE_OF_BLOCK <= HBUF_SIZE + 1_8) THEN + ELSE + CALL CMUMPS_707(OOC_FCT_TYPE_LOC,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + END IF + DO I = 1_8, SIZE_OF_BLOCK + BUF_IO(I_SHIFT_CUR_HBUF(OOC_FCT_TYPE_LOC) + + & I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) + I - 1_8) = + & BLOCK(I) + END DO + I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) = + & I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) + SIZE_OF_BLOCK + RETURN + END SUBROUTINE CMUMPS_678 + SUBROUTINE CMUMPS_686() + IMPLICIT NONE + INTEGER(8) :: DIM_BUF_IO_L_OR_U + INTEGER TYPEF, TYPEF_LAST + INTEGER NB_DOUBLE_BUFFERS + TYPEF_LAST = OOC_NB_FILE_TYPE + NB_DOUBLE_BUFFERS = OOC_NB_FILE_TYPE + DIM_BUF_IO_L_OR_U = DIM_BUF_IO / + & int(NB_DOUBLE_BUFFERS,kind=kind(DIM_BUF_IO_L_OR_U)) + IF(.NOT.STRAT_IO_ASYNC)THEN + HBUF_SIZE = DIM_BUF_IO_L_OR_U + ELSE + HBUF_SIZE = DIM_BUF_IO_L_OR_U / 2_8 + ENDIF + DO TYPEF = 1, TYPEF_LAST + LAST_IOREQUEST(TYPEF) = -1 + IF (TYPEF == 1 ) THEN + I_SHIFT_FIRST_HBUF(TYPEF) = 0_8 + ELSE + I_SHIFT_FIRST_HBUF(TYPEF) = DIM_BUF_IO_L_OR_U + ENDIF + IF(.NOT.STRAT_IO_ASYNC)THEN + I_SHIFT_SECOND_HBUF(TYPEF) = I_SHIFT_FIRST_HBUF(TYPEF) + ELSE + I_SHIFT_SECOND_HBUF(TYPEF) = I_SHIFT_FIRST_HBUF(TYPEF) + + & HBUF_SIZE + ENDIF + CUR_HBUF(TYPEF) = SECOND_HBUF + CALL CMUMPS_689(TYPEF) + ENDDO + I_CUR_HBUF_NEXTPOS = 1 + RETURN + END SUBROUTINE CMUMPS_686 + SUBROUTINE CMUMPS_706(TYPEF,IERR) + IMPLICIT NONE + INTEGER, INTENT(in) :: TYPEF + INTEGER, INTENT(out) :: IERR + INTEGER IFLAG + INTEGER NEW_IOREQUEST + IERR=0 + CALL MUMPS_TEST_REQUEST_C(LAST_IOREQUEST(TYPEF),IFLAG, + & IERR) + IF (IFLAG.EQ.1) THEN + IERR = 0 + CALL CMUMPS_696(TYPEF, + & NEW_IOREQUEST, + & IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + LAST_IOREQUEST(TYPEF) = NEW_IOREQUEST + CALL CMUMPS_689(TYPEF) + NextAddVirtBuffer(TYPEF)=BufferEmpty + RETURN + ELSE IF(IFLAG.LT.0)THEN + WRITE(*,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ELSE + IERR = 1 + RETURN + ENDIF + END SUBROUTINE CMUMPS_706 + SUBROUTINE CMUMPS_709 (TYPEF,VADDR) + IMPLICIT NONE + INTEGER(8), INTENT(in) :: VADDR + INTEGER, INTENT(in) :: TYPEF + IF(I_REL_POS_CUR_HBUF(TYPEF).EQ.1_8)THEN + FIRST_VADDR_IN_BUF(TYPEF)=VADDR + ENDIF + RETURN + END SUBROUTINE CMUMPS_709 + SUBROUTINE CMUMPS_653( STRAT, TYPEF, MonBloc, + & AFAC, LAFAC, + & AddVirtCour, IPIVBEG, IPIVEND, LPANELeff, + & IERR) + IMPLICIT NONE + INTEGER, INTENT(IN) :: TYPEF, IPIVBEG, IPIVEND, STRAT + INTEGER(8), INTENT(IN) :: LAFAC + COMPLEX, INTENT(IN) :: AFAC(LAFAC) + INTEGER(8), INTENT(IN) :: AddVirtCour + TYPE(IO_BLOCK), INTENT(IN) :: MonBloc + INTEGER, INTENT(OUT):: LPANELeff + INTEGER, INTENT(OUT):: IERR + INTEGER :: II, NBPIVeff + INTEGER(8) :: IPOS, IDIAG, IDEST + INTEGER(8) :: DeltaIPOS + INTEGER :: StrideIPOS + IERR=0 + IF (STRAT.NE.STRAT_WRITE_MAX.AND.STRAT.NE.STRAT_TRY_WRITE) THEN + write(6,*) ' CMUMPS_653: STRAT Not implemented ' + CALL MUMPS_ABORT() + ENDIF + NBPIVeff = IPIVEND - IPIVBEG + 1 + IF (MonBloc%MASTER .AND. MonBloc%Typenode .NE. 3) THEN + IF (TYPEF.EQ.TYPEF_L) THEN + LPANELeff = (MonBloc%NROW-IPIVBEG+1)*NBPIVeff + ELSE + LPANELeff = (MonBloc%NCOL-IPIVBEG+1)*NBPIVeff + ENDIF + ELSE + LPANELeff = MonBloc%NROW*NBPIVeff + ENDIF + IF ( ( I_REL_POS_CUR_HBUF(TYPEF) + int(LPANELeff - 1,8) + & > + & HBUF_SIZE ) + & .OR. + & ( (AddVirtCour.NE.NextAddVirtBuffer(TYPEF)) .AND. + & (NextAddVirtBuffer(TYPEF).NE.BufferEmpty) ) + & ) THEN + IF (STRAT.EQ.STRAT_WRITE_MAX) THEN + CALL CMUMPS_707(TYPEF,IERR) + ELSE IF (STRAT.EQ.STRAT_TRY_WRITE) THEN + CALL CMUMPS_706(TYPEF,IERR) + IF (IERR.EQ.1) RETURN + ELSE + write(6,*) 'CMUMPS_653: STRAT Not implemented' + ENDIF + ENDIF + IF (IERR < 0 ) THEN + RETURN + ENDIF + IF (NextAddVirtBuffer(TYPEF).EQ. BufferEmpty) THEN + CALL CMUMPS_709 (TYPEF,AddVirtCour) + NextAddVirtBuffer(TYPEF) = AddVirtCour + ENDIF + IF (MonBloc%MASTER .AND. MonBloc%Typenode .NE. 3) THEN + IDIAG = int(IPIVBEG-1,8)*int(MonBloc%NCOL,8) + int(IPIVBEG,8) + IPOS = IDIAG + IDEST = I_SHIFT_CUR_HBUF(TYPEF) + + & I_REL_POS_CUR_HBUF(TYPEF) + IF (TYPEF.EQ.TYPEF_L) THEN + DO II = IPIVBEG, IPIVEND + CALL ccopy(MonBloc%NROW-IPIVBEG+1, + & AFAC(IPOS), MonBloc%NCOL, + & BUF_IO(IDEST), 1) + IDEST = IDEST + int(MonBloc%NROW-IPIVBEG+1,8) + IPOS = IPOS + 1_8 + ENDDO + ELSE + DO II = IPIVBEG, IPIVEND + CALL ccopy(MonBloc%NCOL-IPIVBEG+1, + & AFAC(IPOS), 1, + & BUF_IO(IDEST), 1) + IDEST = IDEST + int(MonBloc%NCOL-IPIVBEG+1,8) + IPOS = IPOS + int(MonBloc%NCOL,8) + ENDDO + ENDIF + ELSE + IDEST = I_SHIFT_CUR_HBUF(TYPEF) + + & I_REL_POS_CUR_HBUF(TYPEF) + IF (MonBloc%Typenode.EQ.3) THEN + DeltaIPOS = int(MonBloc%NROW,8) + StrideIPOS = 1 + ELSE + DeltaIPOS = 1_8 + StrideIPOS = MonBloc%NCOL + ENDIF + IPOS = 1_8 + int(IPIVBEG - 1,8) * DeltaIPOS + DO II = IPIVBEG, IPIVEND + CALL ccopy(MonBloc%NROW, + & AFAC(IPOS), StrideIPOS, + & BUF_IO(IDEST), 1) + IDEST = IDEST+int(MonBloc%NROW,8) + IPOS = IPOS + DeltaIPOS + ENDDO + ENDIF + I_REL_POS_CUR_HBUF(TYPEF) = + & I_REL_POS_CUR_HBUF(TYPEF) + int(LPANELeff,8) + NextAddVirtBuffer(TYPEF) = NextAddVirtBuffer(TYPEF) + & + int(LPANELeff,8) + RETURN + END SUBROUTINE CMUMPS_653 + END MODULE CMUMPS_OOC_BUFFER diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part1.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part1.F new file mode 100644 index 000000000..7c1812407 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part1.F @@ -0,0 +1,6004 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE CMUMPS( id ) + USE CMUMPS_OOC + USE CMUMPS_STRUC_DEF + IMPLICIT NONE +C matrix in assembled format (ICNTL(5)=0, and ICNTL(18) $\neq$ 3), + INTERFACE + SUBROUTINE CMUMPS_758 + &(idRHS, idINFO, idN, idNRHS, idLRHS) + COMPLEX, DIMENSION(:), POINTER :: idRHS + INTEGER, intent(in) :: idN, idNRHS, idLRHS + INTEGER, intent(inout) :: idINFO(:) + END SUBROUTINE CMUMPS_758 + SUBROUTINE CMUMPS_26( id ) + USE CMUMPS_STRUC_DEF + TYPE (CMUMPS_STRUC), TARGET :: id + END SUBROUTINE CMUMPS_26 + SUBROUTINE CMUMPS_142( id ) + USE CMUMPS_STRUC_DEF + TYPE (CMUMPS_STRUC), TARGET :: id + END SUBROUTINE CMUMPS_142 + SUBROUTINE CMUMPS_301( id ) + USE CMUMPS_STRUC_DEF + TYPE (CMUMPS_STRUC), TARGET :: id + END SUBROUTINE CMUMPS_301 + SUBROUTINE CMUMPS_349(id, LP) + USE CMUMPS_STRUC_DEF + TYPE (CMUMPS_STRUC), TARGET, INTENT(IN) :: id + INTEGER :: LP + END SUBROUTINE CMUMPS_349 + END INTERFACE + INCLUDE 'mpif.h' + INTEGER MASTER, IERR + PARAMETER( MASTER = 0 ) + TYPE (CMUMPS_STRUC) :: id + INTEGER JOBMIN, JOBMAX, OLDJOB + INTEGER I, J, MP, LP, MPG, KEEP235SAVE, KEEP242SAVE, + & KEEP243SAVE + LOGICAL LANAL, LFACTO, LSOLVE, PROK, FLAG, PROKG + LOGICAL NOERRORBEFOREPERM + LOGICAL UNS_PERM_DONE + INTEGER COMM_SAVE + INTEGER JOB, N, NZ, NELT + INTEGER, PARAMETER :: ICNTL18DIST_MIN = 1 + INTEGER, PARAMETER :: ICNTL18DIST_MAX = 3 + INTEGER, DIMENSION(:), ALLOCATABLE :: UNS_PERM_INV + NOERRORBEFOREPERM = .FALSE. + UNS_PERM_DONE = .FALSE. + JOB = id%JOB + N = id%N + NZ = id%NZ + NELT = id%NELT + id%INFO(1) = 0 + id%INFO(2) = 0 + IF ( JOB .NE. -1 ) THEN + LP = id%ICNTL(1) + MP = id%ICNTL(2) + MPG = id%ICNTL(3) + PROK = ((MP.GT.0).AND.(id%ICNTL(4).GE.3)) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF (PROKG) THEN + IF (id%ICNTL(5) .NE. 1) THEN + WRITE(MPG,'(A,I4,I12,I15)') + & 'Entering CMUMPS driver with JOB, N, NZ =', JOB,N,NZ + ELSE + WRITE(MPG,'(A,I4,I12,I15)') + & 'Entering CMUMPS driver with JOB, N, NELT =', JOB,N + & ,NELT + ENDIF + ENDIF + ELSE + MPG = 0 + PROK = .FALSE. + PROKG = .FALSE. + LP = 6 + MP = 6 + END IF + CALL MPI_INITIALIZED( FLAG, IERR ) + IF ( .NOT. FLAG ) THEN + WRITE(LP,990) + 990 FORMAT(' Error in CMUMPS initialization: MPI is not running.') + id%INFO(1) = -23 + id%INFO(2) = 0 + GOTO 500 + END IF + COMM_SAVE = id%COMM + CALL MPI_COMM_DUP( COMM_SAVE, id%COMM, IERR ) + CALL MPI_ALLREDUCE(JOB,JOBMIN,1,MPI_INTEGER,MPI_MAX, + & id%COMM,IERR) + CALL MPI_ALLREDUCE(JOB,JOBMAX,1,MPI_INTEGER,MPI_MIN, + & id%COMM,IERR) + IF ( JOBMIN .NE. JOBMAX ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + IF ( JOB .EQ. -1 ) THEN + id%INFO(1)=0 + id%INFO(2)=0 + IF ( id%KEEP(40) .EQ. 1 - 456789 .OR. + & id%KEEP(40) .EQ. 2 - 456789 .OR. + & id%KEEP(40) .EQ. 3 -456789 ) THEN + IF ( id%N > 0 ) THEN + id%INFO(1)=-3 + id%INFO(2)=JOB + ENDIF + ENDIF + CALL MPI_COMM_RANK(id%COMM, id%MYID, IERR) + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) THEN + IF (id%KEEP(201).GT.0) THEN + CALL CMUMPS_587(id, IERR) + ENDIF + GOTO 499 + ENDIF + CALL CMUMPS_163( id ) + GOTO 500 + END IF + IF ( JOB .EQ. -2 ) THEN + id%KEEP(40)= -2 - 456789 + CALL CMUMPS_136( id ) + GOTO 500 + END IF + IF ((JOB.LT.1).OR.(JOB.GT.6)) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + IF (id%MYID.EQ.MASTER) THEN + IF ( id%ICNTL(18) .LT. ICNTL18DIST_MIN + & .OR. id%ICNTL(18) .GT. ICNTL18DIST_MAX ) THEN + IF ((N.LE.0).OR.((N+N+N)/3.NE.N)) THEN + id%INFO(1) = -16 + id%INFO(2) = N + END IF + IF (id%ICNTL(5).NE.1) THEN + IF (NZ.LE.0) THEN + id%INFO(1) = -2 + id%INFO(2) = NZ + END IF + ELSE + IF (NELT.LE.0) THEN + id%INFO(1) = -24 + id%INFO(2) = NELT + END IF + ENDIF + END IF + IF ( (id%KEEP(46).EQ.0).AND.(id%NPROCS.LE.1) ) + & THEN + id%INFO(1) = -21 + id%INFO(2) = id%NPROCS + ENDIF + END IF + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) GOTO 499 + LANAL = .FALSE. + LFACTO = .FALSE. + LSOLVE = .FALSE. + IF ((JOB.EQ.1).OR.(JOB.EQ.4).OR. + & (JOB.EQ.6)) LANAL = .TRUE. + IF ((JOB.EQ.2).OR.(JOB.EQ.4).OR. + & (JOB.EQ.5).OR.(JOB.EQ.6)) LFACTO = .TRUE. + IF ((JOB.EQ.3).OR.(JOB.EQ.5).OR. + & (JOB.EQ.6)) LSOLVE = .TRUE. + IF (MP.GT.0) CALL CMUMPS_349(id, MP) + OLDJOB = id%KEEP( 40 ) + 456789 + IF ( LANAL ) THEN + IF ( OLDJOB .EQ. 0 .OR. OLDJOB .GT. 3 .OR. OLDJOB .LT. -1 ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + IF ( OLDJOB .GE. 2 ) THEN + IF (associated(id%IS)) THEN + DEALLOCATE (id%IS) + NULLIFY (id%IS) + END IF + IF (associated(id%S)) THEN + DEALLOCATE (id%S) + NULLIFY (id%S) + END IF + END IF + END IF + IF ( LFACTO ) THEN + IF ( OLDJOB .LT. 1 .and. .NOT. LANAL ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + END IF + IF ( LSOLVE ) THEN + IF ( OLDJOB .LT. 2 .AND. .NOT. LFACTO ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + END IF +#if ! defined (LARGEMATRICES) + NOERRORBEFOREPERM =.TRUE. + UNS_PERM_DONE=.FALSE. + IF (id%MYID .eq. MASTER .AND. id%KEEP(23) .NE. 0) THEN + IF ( id%JOB .EQ. 2 .OR. id%JOB .EQ. 5 .OR. + & (id%JOB .EQ. 3 .AND. (id%ICNTL(10) .NE.0 .OR. + & id%ICNTL(11).NE. 0))) THEN + UNS_PERM_DONE = .TRUE. + ALLOCATE(UNS_PERM_INV(id%N),stat=IERR) + IF (IERR .GT. 0) THEN + id%INFO(1)=-13 + id%INFO(2)=id%N + IF (id%ICNTL(1) .GT. 0 .AND. id%ICNTL(4) .GE.1) THEN + WRITE(id%ICNTL(2),99993) + END IF + GOTO 510 + ENDIF + DO I = 1, id%N + UNS_PERM_INV(id%UNS_PERM(I))=I + END DO + DO I = 1, id%NZ + J = id%JCN(I) + IF (J.LE.0.OR.J.GT.id%N) CYCLE + id%JCN(I)=UNS_PERM_INV(J) + END DO + DEALLOCATE(UNS_PERM_INV) + END IF + END IF +#endif + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499 + IF (LANAL) THEN + id%KEEP(40)=-1 -456789 + IF (id%MYID.EQ.MASTER) THEN + id%INFOG(7) = -9999 + id%INFOG(23) = 0 + id%INFOG(24) = 1 + IF (associated(id%IS1)) DEALLOCATE(id%IS1) + IF ( id%ICNTL(5) .NE. 1 ) THEN + IF ( id%KEEP(50) .NE. 1 + & .AND. ( + & (id%ICNTL(6) .NE. 0 .AND. id%ICNTL(7) .NE.1) + & .OR. + & id%ICNTL(12) .NE. 1) ) THEN + id%MAXIS1 = 11 * N + ELSE + id%MAXIS1 = 10 * N + END IF + ELSE + id%MAXIS1 = 6 * N + 2 * NELT + 2 + ENDIF + ALLOCATE( id%IS1(id%MAXIS1), stat=IERR ) + IF (IERR.gt.0) THEN + id%INFO(1) = -7 + id%INFO(2) = id%MAXIS1 + IF ( LP .GT.0 ) + & WRITE(LP,*) 'Problem in allocating work array for analysis.' + GO TO 100 + END IF + IF ( associated( id%PROCNODE ) ) + & DEALLOCATE( id%PROCNODE ) + ALLOCATE( id%PROCNODE(id%N), stat=IERR ) + IF (IERR.gt.0) THEN + id%INFO(1) = -7 + id%INFO(2) = id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) 'Problem in allocating work array PROCNODE' + END IF + GOTO 100 + END IF + id%PROCNODE(1:id%N) = 0 + IF ( id%ICNTL(5) .EQ. 1 ) THEN + IF ( associated( id%ELTPROC ) ) + & DEALLOCATE( id%ELTPROC ) + ALLOCATE( id%ELTPROC(id%NELT), stat=IERR ) + IF (IERR.gt.0) THEN + id%INFO(1) = -7 + id%INFO(2) = id%NELT + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) 'Problem in allocating work array ELTPROC' + END IF + GOTO 100 + END IF + END IF + IF ( id%ICNTL(5) .NE. 1 ) THEN + id%NA_ELT=0 + IF ( id%ICNTL(18) .LT. ICNTL18DIST_MIN + & .OR. id%ICNTL(18) .GT. ICNTL18DIST_MAX ) THEN + IF ( .not. associated( id%IRN ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( size( id%IRN ) < id%NZ ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( .not. associated( id%JCN ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + ELSE IF ( size( id%JCN ) < id%NZ ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + END IF + END IF + IF ( id%INFO( 1 ) .eq. -22 ) THEN + IF (LP.GT.0) WRITE(LP,*) + & 'Error in analysis: IRN/JCN badly allocated.' + END IF + ELSE + IF ( .not. associated( id%ELTPTR ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( size( id%ELTPTR ) < id%NELT+1 ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( .not. associated( id%ELTVAR ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + ELSE + id%LELTVAR = id%ELTPTR( id%NELT+1 ) - 1 + IF ( size( id%ELTVAR ) < id%LELTVAR ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + ELSE + id%NA_ELT = 0 + IF ( id%KEEP(50) .EQ. 0 ) THEN + DO I = 1,NELT + J = id%ELTPTR(I+1) - id%ELTPTR(I) + J = (J * J) + id%NA_ELT = id%NA_ELT + J + ENDDO + ELSE + DO I = 1,NELT + J = id%ELTPTR(I+1) - id%ELTPTR(I) + J = (J * (J+1))/2 + id%NA_ELT = id%NA_ELT + J + ENDDO + ENDIF + ENDIF + END IF + IF ( id%INFO( 1 ) .eq. -22 ) THEN + IF (LP.GT.0) WRITE(LP,*) + & 'Error in analysis: ELTPTR/ELTVAR badly allocated.' + END IF + ENDIF + 100 CONTINUE + END IF + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499 + id%KEEP(52) = id%ICNTL(8) + IF ( id%KEEP(52) .GT. 8 .OR. id%KEEP(52).LT.-2) + & id%KEEP(52) = 77 + IF ((id%KEEP(52).EQ.77).AND.(id%KEEP(50).EQ.1)) THEN + id%KEEP(52) = 0 + ENDIF + IF ( id%KEEP(52).EQ.77 .OR. id%KEEP(52).LE.-2) THEN + IF (.not.associated(id%A)) id%KEEP(52) = 0 + ENDIF + IF(id%KEEP(52) .EQ. -1) id%KEEP(52) = 0 + CALL CMUMPS_26( id ) + IF (id%MYID .eq. MASTER) THEN + IF (id%KEEP(52) .NE. 0) THEN + id%INFOG(33)=id%KEEP(52) + ELSE + id%INFOG(33)=id%ICNTL(8) + ENDIF + ENDIF + IF (id%MYID .eq. MASTER) id%INFOG(24)=id%KEEP(95) + IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499 + id%KEEP(40) = 1 -456789 + END IF + IF (LFACTO) THEN + id%KEEP(40) = 1 - 456789 + IF ( id%MYID .EQ. MASTER ) THEN + IF (id%KEEP(60).EQ.1) THEN + IF ( associated( id%SCHUR_CINTERFACE)) THEN + id%SCHUR=>id%SCHUR_CINTERFACE + & (1:id%SIZE_SCHUR*id%SIZE_SCHUR) + ENDIF + IF ( .NOT. associated (id%SCHUR)) THEN + IF (LP.GT.0) + & write(LP,'(A)') + & ' SCHUR not associated' + id%INFO(1)=-22 + id%INFO(2)=9 + ELSE IF ( size(id%SCHUR) .LT. + & id%SIZE_SCHUR * id%SIZE_SCHUR ) THEN + IF (LP.GT.0) + & write(LP,'(A)') + & ' SCHUR allocated but too small' + id%INFO(1)=-22 + id%INFO(2)=9 + END IF + END IF + IF ( id%KEEP(55) .EQ. 0 ) THEN + IF ( id%KEEP(54).eq.0 ) THEN + IF ( .not. associated( id%A ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + ELSE IF ( size( id%A ) < id%NZ ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + END IF + END IF + ELSE + IF ( .not. associated( id%A_ELT ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + ELSE + IF ( size( id%A_ELT ) < id%NA_ELT ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + ENDIF + END IF + ENDIF + CALL MUMPS_633(id%KEEP(12),id%ICNTL(14), + & id%KEEP(50),id%KEEP(54),id%ICNTL(6),id%ICNTL(8)) + CALL CMUMPS_635(N,id%KEEP(1),id%ICNTL(1),MPG) + IF( id%KEEP(52) .EQ. -2 .AND. id%ICNTL(8) .NE. -2 .AND. + & id%ICNTL(8).NE. 77 ) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** WARNING : SCALING' + WRITE(MPG,'(A)') + & ' ** scaling already computed during analysis' + WRITE(MPG,'(A)') + & ' ** keeping the scaling from the analysis' + ENDIF + ENDIF + IF (id%KEEP(52) .NE. -2) THEN + id%KEEP(52)=id%ICNTL(8) + ENDIF + IF ( id%KEEP(52) .GT. 8 .OR. id%KEEP(52).LT.-2) + & id%KEEP(52) = 77 + IF (id%KEEP(52).EQ.77) THEN + IF (id%KEEP(50).EQ.1) THEN + id%KEEP(52) = 0 + ELSE + id%KEEP(52) = 7 + ENDIF + ENDIF + IF (id%KEEP(23) .NE. 0 .AND. id%ICNTL(8) .EQ. -1) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** WARNING : SCALING' + WRITE(MPG,'(A)') + & ' ** column permutation applied:' + WRITE(MPG,'(A)') + & ' ** column scaling has to be permuted' + ENDIF + ENDIF + IF ( id%KEEP( 19 ) .ne. 0 .and. id%KEEP( 52 ).ne. 0 ) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.' + WRITE(MPG,'(A)') ' ** (incompatibility with null space)' + END IF + id%KEEP(52) = 0 + END IF + IF ( id%KEEP(60) .ne. 0 .and. id%KEEP(52) .ne. 0 ) THEN + id%KEEP(52) = 0 + IF ( MPG .GT. 0 .AND. id%ICNTL(8) .NE. 0 ) THEN + WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.' + WRITE(MPG,'(A)') ' ** (incompatibility with Schur)' + END IF + END IF + IF (id%KEEP(54) .NE. 0 .AND. + & id%KEEP(52).NE.7 .AND. id%KEEP(52).NE.8 .AND. + & id%KEEP(52) .NE. 0 ) THEN + id%KEEP(52) = 0 + IF ( MPG .GT. 0 .and. id%ICNTL(8) .ne. 0 ) THEN + WRITE(MPG,'(A)') + & ' ** Warning: This scaling option not available' + WRITE(MPG,'(A)') ' ** for distributed matrix entry' + END IF + END IF + IF ( id%KEEP(50) .NE. 0 ) THEN + IF ( id%KEEP(52).ne. 1 .and. + & id%KEEP(52).ne. -1 .and. + & id%KEEP(52).ne. 0 .and. + & id%KEEP(52).ne. 7 .and. + & id%KEEP(52).ne. 8 .and. + & id%KEEP(52).ne. -2 .and. + & id%KEEP(52).ne. 77) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') + & ' ** Warning: Scaling option n.a. for symmetric matrix' + END IF + id%KEEP(52) = 0 + END IF + END IF + IF (id%KEEP(55) .NE. 0 .AND. + & ( id%KEEP(52) .gt. 0 ) ) THEN + id%KEEP(52) = 0 + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.' + WRITE(MPG,'(A)') + & ' ** (only user scaling av. for elt. entry)' + END IF + END IF + IF ( id%KEEP(52) .eq. -1 ) THEN + IF ( .not. associated( id%ROWSCA ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 5 + ELSE IF ( size( id%ROWSCA ) < id%N ) THEN + id%INFO(1) = -22 + id%INFO(2) = 5 + ELSE IF ( .not. associated( id%COLSCA ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 6 + ELSE IF ( size( id%COLSCA ) < id%N ) THEN + id%INFO(1) = -22 + id%INFO(2) = 6 + END IF + END IF + IF (id%KEEP(52).GT.0 .AND. + & id%KEEP(52) .LE.8) THEN + IF ( associated(id%COLSCA)) + & DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) + & DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=IERR) + IF (IERR .GT.0) id%INFO(1)=-13 + ALLOCATE( id%ROWSCA(N), stat=IERR) + IF (IERR .GT.0) id%INFO(1)=-13 + END IF + IF (.NOT. associated(id%COLSCA)) THEN + ALLOCATE( id%COLSCA(1), stat=IERR) + END IF + IF (IERR .GT.0) id%INFO(1)=-13 + IF (.NOT. associated(id%ROWSCA)) + & ALLOCATE( id%ROWSCA(1), stat=IERR) + IF (IERR .GT.0) id%INFO(1)=-13 + IF ( id%INFO(1) .eq. -13 ) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*) 'Problems in allocations before facto' + GOTO 200 + END IF + IF (id%KEEP(252) .EQ. 1) THEN + CALL CMUMPS_758 + & (id%RHS,id%INFO,id%N,id%NRHS,id%LRHS) + CALL CMUMPS_807(id) + CALL CMUMPS_769(id) + ENDIF + 200 CONTINUE + END IF + CALL MPI_BCAST( id%KEEP(221), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + IF (id%KEEP(60).EQ.2.OR.id%KEEP(60).EQ.3) THEN + IF ( id%root%yes ) THEN + IF ( associated( id%SCHUR_CINTERFACE )) THEN + id%SCHUR=>id%SCHUR_CINTERFACE + & (1:id%SCHUR_LLD*(id%root%SCHUR_NLOC-1)+ + & id%root%SCHUR_MLOC) + ENDIF + IF (id%SCHUR_LLD < id%root%SCHUR_MLOC) THEN + IF (LP.GT.0) write(LP,*) + & ' SCHUR leading dimension SCHUR_LLD ', + & id%SCHUR_LLD, 'too small with respect to', + & id%root%SCHUR_MLOC + id%INFO(1)=-30 + id%INFO(2)=id%SCHUR_LLD + ELSE IF ( .NOT. associated (id%SCHUR)) THEN + IF (LP.GT.0) write(LP,'(A)') + & ' SCHUR not associated' + id%INFO(1)=-22 + id%INFO(2)=9 + ELSE IF (size(id%SCHUR) < + & id%SCHUR_LLD*(id%root%SCHUR_NLOC-1)+ + & id%root%SCHUR_MLOC) THEN + IF (LP.GT.0) THEN + write(LP,'(A)') + & ' SCHUR allocated but too small' + write(LP,*) id%MYID, ' : Size Schur=', + & size(id%SCHUR), + & ' SCHUR_LLD= ', id%SCHUR_LLD, + & ' SCHUR_MLOC=', id%root%SCHUR_NLOC, + & ' SCHUR_NLOC=', id%root%SCHUR_NLOC + ENDIF + id%INFO(1)=-22 + id%INFO(2)= 9 + ELSE + id%root%SCHUR_LLD=id%SCHUR_LLD + IF (id%root%SCHUR_NLOC==0) THEN + ALLOCATE(id%root%SCHUR_POINTER(1)) + ELSE + id%root%SCHUR_POINTER=>id%SCHUR + ENDIF + ENDIF + ENDIF + ENDIF + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) GO TO 499 + CALL CMUMPS_142(id) + IF (id%MYID .eq. MASTER) id%INFOG(33)=id%KEEP(52) + IF (id%KEEP(60).EQ.2.OR.id%KEEP(60).EQ.3) THEN + IF (id%root%yes) THEN + IF (id%root%SCHUR_NLOC==0) THEN + DEALLOCATE(id%root%SCHUR_POINTER) + NULLIFY(id%root%SCHUR_POINTER) + ELSE + NULLIFY(id%root%SCHUR_POINTER) + ENDIF + ENDIF + ENDIF + IF ( id%INFO(1) .LT. 0 ) GO TO 499 + id%KEEP(40) = 2 - 456789 + END IF + IF (LSOLVE) THEN + id%KEEP(40) = 2 -456789 + IF (id%MYID .eq. MASTER) THEN + KEEP235SAVE = id%KEEP(235) + KEEP242SAVE = id%KEEP(242) + KEEP243SAVE = id%KEEP(243) + IF (id%KEEP(242).EQ.0) id%KEEP(243)=0 + ENDIF + CALL CMUMPS_301(id) + IF (id%MYID .eq. MASTER) THEN + id%KEEP(235) = KEEP235SAVE + id%KEEP(242) = KEEP242SAVE + id%KEEP(243) = KEEP243SAVE + ENDIF + IF (id%INFO(1).LT.0) GOTO 499 + id%KEEP(40) = 3 -456789 + ENDIF + IF (MP.GT.0) CALL CMUMPS_349(id, MP) + GOTO 500 + 499 PROK = ((id%ICNTL(1).GT.0).AND. + & (id%ICNTL(4).GE.1)) + IF (PROK) WRITE (id%ICNTL(1),99995) id%INFO(1) + IF (PROK) WRITE (id%ICNTL(1),99994) id%INFO(2) +500 CONTINUE +#if ! defined(LARGEMATRICES) + IF (id%MYID .eq. MASTER .AND. id%KEEP(23) .NE. 0 + & .AND. NOERRORBEFOREPERM) THEN + IF (id%JOB .NE. 3 .OR. UNS_PERM_DONE) THEN + DO I = 1, id%NZ + J=id%JCN(I) + IF (J.LE.0.OR.J.GT.id%N) CYCLE + id%JCN(I)=id%UNS_PERM(J) + END DO + END IF + END IF +#endif + 510 CONTINUE + CALL CMUMPS_300(id%INFO(1), id%INFOG(1), id%COMM, id%MYID) + CALL MPI_BCAST( id%RINFOG(1), 40, MPI_REAL, MASTER, + & id%COMM, IERR ) + IF (id%MYID.EQ.MASTER.and.MPG.GT.0.and. + & id%INFOG(1).lt.0) THEN + WRITE(MPG,'(A,I12)') ' On return from CMUMPS, INFOG(1)=', + & id%INFOG(1) + WRITE(MPG,'(A,I12)') ' On return from CMUMPS, INFOG(2)=', + & id%INFOG(2) + END IF + CALL MPI_COMM_FREE( id%COMM, IERR ) + id%COMM = COMM_SAVE + RETURN +99995 FORMAT (' ** ERROR RETURN ** FROM CMUMPS INFO(1)=', I3) +99994 FORMAT (' ** INFO(2)=', I10) +99993 FORMAT (' ** Allocation error: could not permute JCN.') + END SUBROUTINE CMUMPS + SUBROUTINE CMUMPS_300( INFO, INFOG, COMM, MYID ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER INFO(40), INFOG(40), COMM, MYID + INTEGER TMP1(2),TMP(2) + INTEGER ROOT, IERR + INTEGER MASTER + PARAMETER (MASTER=0) + IF ( INFO(1) .ge. 0 .and. INFO(2) .ge. 0 ) THEN + INFOG(1) = INFO(1) + INFOG(2) = INFO(2) + ELSE + INFOG(1) = INFO(1) + TMP1(1) = INFO(1) + TMP1(2) = MYID + CALL MPI_ALLREDUCE(TMP1,TMP,1,MPI_2INTEGER, + & MPI_MINLOC,COMM,IERR ) + INFOG(2) = INFO(2) + ROOT = TMP(2) + CALL MPI_BCAST( INFOG(1), 1, MPI_INTEGER, ROOT, COMM, IERR ) + CALL MPI_BCAST( INFOG(2), 1, MPI_INTEGER, ROOT, COMM, IERR ) + END IF + CALL MPI_BCAST(INFOG(3), 38, MPI_INTEGER, MASTER, COMM, IERR ) + RETURN + END SUBROUTINE CMUMPS_300 + SUBROUTINE CMUMPS_349(id, LP) + USE CMUMPS_STRUC_DEF + TYPE (CMUMPS_STRUC), TARGET, INTENT(IN) :: id + INTEGER :: LP + INTEGER, POINTER :: JOB + INTEGER,DIMENSION(:),POINTER::ICNTL + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (LP.LT.0) RETURN + JOB=>id%JOB + ICNTL=>id%ICNTL + IF (id%MYID.EQ.MASTER) THEN + SELECT CASE (JOB) + CASE(1); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) ICNTL(5),ICNTL(6),ICNTL(7),ICNTL(12), + & ICNTL(13),ICNTL(18),ICNTL(19),ICNTL(22) + IF ((ICNTL(6).EQ.5).OR.(ICNTL(6).EQ.6).OR. + & (ICNTL(12).NE.1) ) THEN + WRITE (LP,992) ICNTL(8) + ENDIF + IF (id%ICNTL(19).NE.0) + & WRITE(LP,998) id%SIZE_SCHUR + WRITE (LP,993) ICNTL(14) + CASE(2); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,992) ICNTL(8) + WRITE (LP,993) ICNTL(14) + CASE(3); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + CASE(4); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,992) ICNTL(8) + IF (id%ICNTL(19).NE.0) + & WRITE(LP,998) id%SIZE_SCHUR + WRITE (LP,993) ICNTL(14) + CASE(5); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) ICNTL(5),ICNTL(6),ICNTL(7),ICNTL(12), + & ICNTL(13),ICNTL(18),ICNTL(19),ICNTL(22) + WRITE (LP,992) ICNTL(8) + WRITE (LP,993) ICNTL(14) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + CASE(6); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) ICNTL(5),ICNTL(6),ICNTL(7),ICNTL(12), + & ICNTL(13),ICNTL(18),ICNTL(19),ICNTL(22) + IF (id%ICNTL(19).NE.0) + & WRITE(LP,998) id%SIZE_SCHUR + WRITE (LP,992) ICNTL(8) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + WRITE (LP,993) ICNTL(14) + END SELECT + ENDIF + 980 FORMAT (/'***********CONTROL PARAMETERS (ICNTL)**************'/) + 990 FORMAT ( + & 'ICNTL(1) Output stream for error messages =',I10/ + & 'ICNTL(2) Output stream for diagnostic messages =',I10/ + & 'ICNTL(3) Output stream for global information =',I10/ + & 'ICNTL(4) Level of printing =',I10) + 991 FORMAT ( + & 'ICNTL(5) Matrix format ( keep(55) ) =',I10/ + & 'ICNTL(6) Maximum transversal ( keep(23) ) =',I10/ + & 'ICNTL(7) Ordering =',I10/ + & 'ICNTL(12) LDLT ordering strat ( keep(95) ) =',I10/ + & 'ICNTL(13) Parallel root (0=on, 1=off) =',I10/ + & 'ICNTL(18) Distributed matrix ( keep(54) ) =',I10/ + & 'ICNTL(19) Schur option ( keep(60) 0=off,else=on ) =',I10/ + & 'ICNTL(22) Out-off-core option (0=Off, >0=ON) =',I10) + 992 FORMAT ( + & 'ICNTL(8) Scaling strategy =',I10) + 993 FORMAT ( + & 'ICNTL(14) Percent of memory increase =',I10) + 995 FORMAT ( + & 'ICNTL(9) Solve A x=b (1) or A''x = b (else) =',I10/ + & 'ICNTL(10) Max steps iterative refinement =',I10/ + & 'ICNTL(11) Error analysis ( 0= off, else=on) =',I10) + 998 FORMAT ( + & ' Size of SCHUR matrix (SIZE_SHUR) =',I10) + END SUBROUTINE CMUMPS_349 + SUBROUTINE CMUMPS_350(id, LP) + USE CMUMPS_STRUC_DEF + TYPE (CMUMPS_STRUC), TARGET, INTENT(IN) :: id + INTEGER ::LP + INTEGER, POINTER :: JOB + INTEGER,DIMENSION(:),POINTER::ICNTL, KEEP + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (LP.LT.0) RETURN + JOB=>id%JOB + ICNTL=>id%ICNTL + KEEP=>id%KEEP + IF (id%MYID.EQ.MASTER) THEN + SELECT CASE (JOB) + CASE(1); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + IF ((KEEP(23).EQ.5).OR.(KEEP(23).EQ.6))THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,993) KEEP(12) + CASE(2); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + IF (KEEP(23).EQ.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,993) KEEP(12) + CASE(3); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + CASE(4); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + IF (KEEP(23).NE.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + WRITE (LP,993) KEEP(12) + CASE(5); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + IF ((KEEP(23).EQ.5).OR.(KEEP(23).EQ.6) + & .OR. (KEEP(23).EQ.7)) THEN + WRITE (LP,992) KEEP(52) + ENDIF + IF (KEEP(23).EQ.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,993) KEEP(12) + CASE(6); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + IF ((KEEP(23).EQ.5).OR.(KEEP(23).EQ.6) + & .OR. (KEEP(23).EQ.7)) THEN + WRITE (LP,992) KEEP(52) + ENDIF + IF (KEEP(23).EQ.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),KEEP(248),ICNTL(21) + WRITE (LP,993) KEEP(12) + END SELECT + ENDIF + 980 FORMAT (/'******INTERNAL VALUE OF PARAMETERS (ICNTL/KEEP)****'/) + 990 FORMAT ( + & 'ICNTL(1) Output stream for error messages =',I10/ + & 'ICNTL(2) Output stream for diagnostic messages =',I10/ + & 'ICNTL(3) Output stream for global information =',I10/ + & 'ICNTL(4) Level of printing =',I10) + 991 FORMAT ( + & 'ICNTL(5) Matrix format ( keep(55) ) =',I10/ + & 'ICNTL(6) Maximum transversal ( keep(23) ) =',I10/ + & 'ICNTL(7) Ordering =',I10/ + & 'ICNTL(12) LDLT ordering strat ( keep(95) ) =',I10/ + & 'ICNTL(13) Parallel root (0=on, 1=off) =',I10/ + & 'ICNTL(18) Distributed matrix ( keep(54) ) =',I10/ + & 'ICNTL(19) Schur option ( keep(60) 0=off,else=on ) =',I10/ + & 'ICNTL(22) Out-off-core option (0=Off, >0=ON) =',I10) + 992 FORMAT ( + & 'ICNTL(8) Scaling strategy ( keep(52) ) =',I10) + 993 FORMAT ( + & 'ICNTL(14) Percent of memory increase ( keep(12) ) =',I10) + 995 FORMAT ( + & 'ICNTL(9) Solve A x=b (1) or A''x = b (else) =',I10/ + & 'ICNTL(10) Max steps iterative refinement =',I10/ + & 'ICNTL(11) Error analysis ( 0= off, else=on) =',I10/ + & 'ICNTL(20) Dense (0) or sparse (1) RHS =',I10/ + & 'ICNTL(21) Gathered (0) or distributed(1) solution =',I10) + END SUBROUTINE CMUMPS_350 + SUBROUTINE CMUMPS_758 + & (idRHS, idINFO, idN, idNRHS, idLRHS) + IMPLICIT NONE + COMPLEX, DIMENSION(:), POINTER :: idRHS + INTEGER, intent(in) :: idN, idNRHS, idLRHS + INTEGER, intent(inout) :: idINFO(:) + IF ( .not. associated( idRHS ) ) THEN + idINFO( 1 ) = -22 + idINFO( 2 ) = 7 + ELSE IF (idNRHS.EQ.1) THEN + IF ( size( idRHS ) < idN ) THEN + idINFO( 1 ) = -22 + idINFO( 2 ) = 7 + ENDIF + ELSE IF (idLRHS < idN) + & THEN + idINFO( 1 ) = -26 + idINFO( 2 ) = idLRHS + ELSE IF + & (size(idRHS)<(idNRHS*idLRHS-idLRHS+idN)) + & THEN + idINFO( 1 ) = -22 + idINFO( 2 ) = 7 + END IF + RETURN + END SUBROUTINE CMUMPS_758 + SUBROUTINE CMUMPS_807(id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (CMUMPS_STRUC) :: id + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (id%MYID.EQ.MASTER) THEN + id%KEEP(221)=id%ICNTL(26) + IF (id%KEEP(221).ne.0 .and. id%KEEP(221) .NE.1 + & .AND.id%KEEP(221).ne.2) id%KEEP(221)=0 + ENDIF + RETURN + END SUBROUTINE CMUMPS_807 + SUBROUTINE CMUMPS_769(id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (CMUMPS_STRUC) :: id + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (id%MYID .EQ. MASTER) THEN + IF ( id%KEEP(221) == 1 .or. id%KEEP(221) == 2 ) THEN + IF (id%KEEP(221) == 2 .and. id%JOB == 2) THEN + id%INFO(1)=-35 + id%INFO(2)=id%KEEP(221) + GOTO 333 + ENDIF + IF (id%KEEP(221) == 1 .and. id%KEEP(252) == 1 + & .and. id%JOB == 3) THEN + id%INFO(1)=-35 + id%INFO(2)=id%KEEP(221) + ENDIF + IF ( id%KEEP(60).eq. 0 .or. id%SIZE_SCHUR.EQ.0 ) THEN + id%INFO(1)=-33 + id%INFO(2)=id%KEEP(221) + GOTO 333 + ENDIF + IF ( .NOT. associated( id%REDRHS)) THEN + id%INFO(1)=-22 + id%INFO(2)=15 + GOTO 333 + ELSE IF (id%NRHS.EQ.1) THEN + IF (size(id%REDRHS) < id%SIZE_SCHUR ) THEN + id%INFO(1)=-22 + id%INFO(2)=15 + GOTO 333 + ENDIF + ELSE IF (id%LREDRHS < id%SIZE_SCHUR) THEN + id%INFO(1)=-34 + id%INFO(2)=id%LREDRHS + GOTO 333 + ELSE IF + & (size(id%REDRHS)< + & id%NRHS*id%LREDRHS-id%LREDRHS+id%SIZE_SCHUR) + & THEN + id%INFO(1)=-22 + id%INFO(2)=15 + GOTO 333 + ENDIF + ENDIF + ENDIF + 333 CONTINUE + RETURN + END SUBROUTINE CMUMPS_769 + SUBROUTINE CMUMPS_24( MYID, SLAVEF, N, + & PROCNODE, STEP, PTRAIW, PTRARW, ISTEP_TO_INIV2, + & I_AM_CAND, + & KEEP, KEEP8, ICNTL, id ) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (CMUMPS_STRUC) :: id + INTEGER MYID, N, SLAVEF + INTEGER KEEP( 500 ), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE( KEEP(28) ), STEP( N ), + & PTRAIW( N ), PTRARW( N ) + INTEGER ISTEP_TO_INIV2(KEEP(71)) + LOGICAL I_AM_CAND(max(1,KEEP(56))) + LOGICAL I_AM_SLAVE + LOGICAL I_AM_CAND_LOC + INTEGER MUMPS_330, MUMPS_275, MUMPS_810 + EXTERNAL MUMPS_330, MUMPS_275, MUMPS_810 + INTEGER ISTEP, I, IPTRI, IPTRR, NCOL, NROW, allocok + INTEGER TYPE_PARALL, ITYPE, IRANK, INIV2, TYPESPLIT + LOGICAL T4_MASTER_CONCERNED + TYPE_PARALL = KEEP(46) + I_AM_SLAVE = (KEEP(46).EQ.1 .OR. MYID.NE.0) + KEEP(14) = 0 + KEEP(13) = 0 + DO I = 1, N + ISTEP=abs(STEP(I)) + ITYPE = MUMPS_330( PROCNODE(ISTEP), SLAVEF ) + IRANK = MUMPS_275( PROCNODE(ISTEP), SLAVEF ) + TYPESPLIT = MUMPS_810 ( PROCNODE(ISTEP), SLAVEF ) + I_AM_CAND_LOC = .FALSE. + T4_MASTER_CONCERNED = .FALSE. + IF (ITYPE.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF (I_AM_SLAVE) THEN + I_AM_CAND_LOC = I_AM_CAND(INIV2) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + IF ( TYPE_PARALL .eq. 0 ) THEN + T4_MASTER_CONCERNED = + & ( id%CANDIDATES (id%CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + & .EQ.MYID-1 ) + ELSE + T4_MASTER_CONCERNED = + & ( id%CANDIDATES (id%CANDIDATES(SLAVEF+1, INIV2)+1,INIV2 ) + & .EQ.MYID ) + ENDIF + ENDIF + ENDIF + ENDIF + IF ( TYPE_PARALL .eq. 0 ) THEN + IRANK = IRANK + 1 + END IF + IF ( + & ( (ITYPE .EQ. 1.OR.ITYPE.EQ.2) .AND. + & IRANK .EQ. MYID ) + & .OR. + & ( T4_MASTER_CONCERNED ) + & ) THEN + KEEP( 14 ) = KEEP( 14 ) + 3 + PTRAIW( I ) + PTRARW( I ) + KEEP( 13 ) = KEEP( 13 ) + 1 + PTRAIW( I ) + PTRARW( I ) + ELSE IF ( ITYPE .EQ. 3 ) THEN + ELSE IF ( ITYPE .EQ. 2 .AND. I_AM_CAND_LOC ) THEN + PTRARW( I ) = 0 + KEEP(14) = KEEP(14) + 3 + PTRAIW( I ) + PTRARW( I ) + KEEP(13) = KEEP(13) + 1 + PTRAIW( I ) + PTRARW( I ) + END IF + END DO + IF ( associated( id%INTARR ) ) THEN + DEALLOCATE( id%INTARR ) + NULLIFY( id%INTARR ) + END IF + IF ( KEEP(14) > 0 ) THEN + ALLOCATE( id%INTARR( KEEP(14) ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = KEEP(14) + RETURN + END IF + ELSE + ALLOCATE( id%INTARR( 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = 1 + RETURN + END IF + END IF + IPTRI = 1 + IPTRR = 1 + DO I = 1, N + ISTEP = abs(STEP(I)) + ITYPE = MUMPS_330( PROCNODE(ISTEP), SLAVEF ) + IRANK = MUMPS_275( PROCNODE(ISTEP), SLAVEF ) + TYPESPLIT = MUMPS_810 ( PROCNODE(ISTEP), SLAVEF ) + I_AM_CAND_LOC = .FALSE. + T4_MASTER_CONCERNED = .FALSE. + IF (ITYPE.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF (I_AM_SLAVE) THEN + I_AM_CAND_LOC = I_AM_CAND(INIV2) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + IF ( TYPE_PARALL .eq. 0 ) THEN + T4_MASTER_CONCERNED = + & (id%CANDIDATES (id%CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + & .EQ.MYID-1 ) + ELSE + T4_MASTER_CONCERNED = + & (id%CANDIDATES (id%CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + & .EQ.MYID ) + ENDIF + ENDIF + ENDIF + ENDIF + IF ( TYPE_PARALL .eq. 0 ) THEN + IRANK =IRANK + 1 + END IF + IF ( + & ( ITYPE .eq. 2 .and. + & IRANK .eq. MYID ) + & .or. + & ( ITYPE .eq. 1 .and. + & IRANK .eq. MYID ) + & .or. + & ( T4_MASTER_CONCERNED ) + & ) THEN + NCOL = PTRAIW( I ) + NROW = PTRARW( I ) + id%INTARR( IPTRI ) = NCOL + id%INTARR( IPTRI + 1 ) = -NROW + id%INTARR( IPTRI + 2 ) = I + PTRAIW( I ) = IPTRI + PTRARW( I ) = IPTRR + IPTRI = IPTRI + NCOL + NROW + 3 + IPTRR = IPTRR + NCOL + NROW + 1 + ELSE IF ( ITYPE .eq. 2 .AND. I_AM_CAND_LOC ) THEN + NCOL = PTRAIW( I ) + NROW = 0 + id%INTARR( IPTRI ) = NCOL + id%INTARR( IPTRI + 1 ) = -NROW + id%INTARR( IPTRI + 2 ) = I + PTRAIW( I ) = IPTRI + PTRARW( I ) = IPTRR + IPTRI = IPTRI + NCOL + NROW + 3 + IPTRR = IPTRR + NCOL + NROW + 1 + ELSE + PTRAIW(I) = 0 + PTRARW(I) = 0 + END IF + END DO + IF ( IPTRI - 1 .NE. KEEP(14) ) THEN + WRITE(*,*) 'Error 1 in anal_arrowheads', + & ' IPTRI - 1, KEEP(14)=', IPTRI - 1, KEEP(14) + CALL MUMPS_ABORT() + END IF + IF ( IPTRR - 1 .NE. KEEP(13) ) THEN + WRITE(*,*) 'Error 2 in anal_arrowheads' + CALL MUMPS_ABORT() + END IF + RETURN + END SUBROUTINE CMUMPS_24 + SUBROUTINE CMUMPS_148(N, NZ, ASPK, + & IRN, ICN, PERM, + & LSCAL,COLSCA,ROWSCA, + & MYID, SLAVEF, PROCNODE_STEPS, NBRECORDS, + & LP, COMM, root, KEEP, KEEP8, FILS, RG2L, + & INTARR, DBLARR, PTRAIW, PTRARW, FRERE_STEPS, + & STEP, A, LA, ISTEP_TO_INIV2, I_AM_CAND, CANDIDATES ) + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INTEGER N,NZ, COMM, NBRECORDS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + COMPLEX ASPK(NZ) + REAL COLSCA(*), ROWSCA(*) + INTEGER IRN(NZ), ICN(NZ) + INTEGER PERM(N), PROCNODE_STEPS(KEEP(28)) + INTEGER RG2L( N ), FILS( N ) + INTEGER ISTEP_TO_INIV2(KEEP(71)) + LOGICAL I_AM_CAND(max(1,KEEP(56))) + INTEGER LP, SLAVEF, MYID + INTEGER CANDIDATES(SLAVEF+1, max(1,KEEP(56))) + LOGICAL LSCAL + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER(8) :: LA + INTEGER PTRAIW( N ), PTRARW( N ), FRERE_STEPS( KEEP(28) ) + INTEGER STEP(N) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX A( LA ), DBLARR(max(1,KEEP(13))) + INTEGER, DIMENSION(:,:), ALLOCATABLE :: BUFI + COMPLEX, DIMENSION(:,:), ALLOCATABLE :: BUFR + INTEGER MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + COMPLEX VAL + INTEGER IOLD,JOLD,INEW,JNEW,ISEND,JSEND,DEST,I,K,IARR + INTEGER IPOSROOT, JPOSROOT + INTEGER IROW_GRID, JCOL_GRID + INTEGER INODE, ISTEP + INTEGER NBUFS + INTEGER ARROW_ROOT, TAILLE + INTEGER LOCAL_M, LOCAL_N + INTEGER(8) :: PTR_ROOT + INTEGER TYPENODE_TMP, MASTER_NODE + LOGICAL I_AM_CAND_LOC, I_AM_SLAVE + INTEGER I1, IA, JARR, ILOCROOT, JLOCROOT + INTEGER IS1, ISHIFT, IIW, IS, IAS + INTEGER allocok, TYPESPLIT, T4MASTER, INIV2 + LOGICAL T4_MASTER_CONCERNED + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INTEGER, POINTER, DIMENSION(:,:) :: IW4 + ARROW_ROOT = 0 + I_AM_SLAVE=(MYID.NE.0.OR.KEEP(46).EQ.1) + IF ( KEEP(46) .eq. 0 ) THEN + NBUFS = SLAVEF + ELSE + NBUFS = SLAVEF - 1 + ALLOCATE( IW4( N, 2 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) 'Error allocating IW4' + CALL MUMPS_ABORT() + END IF + DO I = 1, N + I1 = PTRAIW( I ) + IA = PTRARW( I ) + IF ( IA .GT. 0 ) THEN + DBLARR( IA ) = ZERO + IW4( I, 1 ) = INTARR( I1 ) + IW4( I, 2 ) = -INTARR( I1 + 1 ) + INTARR( I1 + 2 ) = I + END IF + END DO + IF ( KEEP(38) .NE. 0 ) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I = 1, root%SCHUR_NLOC + root%SCHUR_POINTER(int(I-1,8)*int(root%SCHUR_LLD,8)+1_8: + & int(I-1,8)*int(root%SCHUR_LLD,8)+int(root%SCHUR_MLOC,8))= + & ZERO + ENDDO + ENDIF + END IF + END IF + IF (NBUFS.GT.0) THEN + ALLOCATE( BUFI(NBRECORDS*2+1,NBUFS),stat=allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) 'Error allocating BUFI' + CALL MUMPS_ABORT() + END IF + ALLOCATE( BUFR( NBRECORDS, NBUFS ), stat=allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) 'Error allocating BUFR' + CALL MUMPS_ABORT() + END IF + DO I = 1, NBUFS + BUFI( 1, I ) = 0 + ENDDO + ENDIF + INODE = KEEP(38) + I = 1 + DO WHILE ( INODE .GT. 0 ) + RG2L( INODE ) = I + INODE = FILS( INODE ) + I = I + 1 + END DO + DO 120 K=1,NZ + IOLD = IRN(K) + JOLD = ICN(K) + IF ( (IOLD.GT.N).OR.(JOLD.GT.N).OR.(IOLD.LT.1) + & .OR.(JOLD.LT.1) ) THEN + GOTO 120 + END IF + IF (LSCAL) THEN + VAL = ASPK(K)*ROWSCA(IOLD)*COLSCA(JOLD) + ELSE + VAL = ASPK(K) + ENDIF + IF (IOLD.EQ.JOLD) THEN + ISEND = IOLD + JSEND = JOLD + ELSE + INEW = PERM(IOLD) + JNEW = PERM(JOLD) + IF (INEW.LT.JNEW) THEN + ISEND = IOLD + IF ( KEEP(50) .NE. 0 ) ISEND = -IOLD + JSEND = JOLD + ELSE + ISEND = -JOLD + JSEND = IOLD + ENDIF + ENDIF + IARR = abs( ISEND ) + ISTEP = abs( STEP(IARR) ) + TYPENODE_TMP = MUMPS_330( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + MASTER_NODE = MUMPS_275( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + TYPESPLIT = MUMPS_810( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + I_AM_CAND_LOC = .FALSE. + T4_MASTER_CONCERNED = .FALSE. + T4MASTER = -9999 + IF (TYPENODE_TMP.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF (I_AM_SLAVE) I_AM_CAND_LOC = I_AM_CAND(INIV2) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + T4_MASTER_CONCERNED = .TRUE. + T4MASTER=CANDIDATES(CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + IF ( KEEP(46) .eq. 0 ) THEN + T4MASTER=T4MASTER+1 + ENDIF + ENDIF + ENDIF + IF ( TYPENODE_TMP .EQ. 1 ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + DEST = MASTER_NODE + 1 + ELSE + DEST = MASTER_NODE + END IF + ELSE IF ( TYPENODE_TMP .EQ. 2 ) THEN + IF ( ISEND .LT. 0 ) THEN + DEST = -1 + ELSE + IF ( KEEP( 46 ) .eq. 0 ) THEN + DEST = MASTER_NODE + 1 + ELSE + DEST = MASTER_NODE + END IF + END IF + ELSE + IF ( ISEND .LT. 0 ) THEN + IPOSROOT = RG2L(JSEND) + JPOSROOT = RG2L(IARR) + ELSE + IPOSROOT = RG2L( IARR ) + JPOSROOT = RG2L( JSEND ) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, root%NPCOL ) + IF ( KEEP( 46 ) .eq. 0 ) THEN + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + 1 + ELSE + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + END IF + END IF + IF ( DEST .eq. 0 .or. + & ( DEST .eq. -1 .and. KEEP( 46 ) .eq. 1 .AND. + & ( I_AM_CAND_LOC .OR. MASTER_NODE .EQ. 0 ) ) + & .or. + & ( T4MASTER.EQ.0 ) + & ) THEN + IARR = ISEND + JARR = JSEND + IF ( TYPENODE_TMP .eq. 3 ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + IF ( IROW_GRID .EQ. root%MYROW .AND. + & JCOL_GRID .EQ. root%MYCOL ) THEN + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & = A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + ELSE + WRITE(*,*) MYID,':INTERNAL Error: root arrowhead ' + WRITE(*,*) MYID,':is not belonging to me. IARR,JARR=' + & ,IARR,JARR + CALL MUMPS_ABORT() + END IF + ELSE IF ( IARR .GE. 0 ) THEN + IF ( IARR .eq. JARR ) THEN + IA = PTRARW( IARR ) + DBLARR( IA ) = DBLARR( IA ) + VAL + ELSE + IS1 = PTRAIW(IARR) + ISHIFT = INTARR(IS1) + IW4(IARR,2) + IW4(IARR,2) = IW4(IARR,2) - 1 + IIW = IS1 + ISHIFT + 2 + INTARR(IIW) = JARR + IS = PTRARW(IARR) + IAS = IS + ISHIFT + DBLARR(IAS) = VAL + END IF + ELSE + IARR = -IARR + ISHIFT = PTRAIW(IARR)+IW4(IARR,1)+2 + INTARR(ISHIFT) = JARR + IAS = PTRARW(IARR)+IW4(IARR,1) + IW4(IARR,1) = IW4(IARR,1) - 1 + DBLARR(IAS) = VAL + IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0 ) + & .AND. IW4(IARR,1) .EQ. 0 .AND. + & STEP( IARR) > 0 ) THEN + IF (MUMPS_275( PROCNODE_STEPS(abs(STEP(IARR))), + & SLAVEF ) == MYID) THEN + TAILLE = INTARR( PTRAIW(IARR) ) + CALL CMUMPS_310( N, PERM, + & INTARR( PTRAIW(IARR) + 3 ), + & DBLARR( PTRARW(IARR) + 1 ), + & TAILLE, 1, TAILLE ) + END IF + END IF + ENDIF + END IF + IF ( DEST.EQ. -1 ) THEN + DO I=1, CANDIDATES(SLAVEF+1,ISTEP_TO_INIV2(ISTEP)) + DEST=CANDIDATES(I,ISTEP_TO_INIV2(ISTEP)) + IF (KEEP(46).EQ.0) DEST=DEST+1 + IF (DEST.NE.0) + & CALL CMUMPS_34( ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDDO + DEST = MASTER_NODE + IF (KEEP(46).EQ.0) DEST=DEST+1 + IF ( DEST .NE. 0 ) THEN + CALL CMUMPS_34( ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDIF + IF ((T4_MASTER_CONCERNED).AND.(T4MASTER.GT.0)) THEN + CALL CMUMPS_34( ISEND, JSEND, VAL, + & T4MASTER, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDIF + ELSE IF ( DEST .GT. 0 ) THEN + CALL CMUMPS_34( ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + IF ( T4MASTER.GT.0 ) THEN + CALL CMUMPS_34( ISEND, JSEND, VAL, + & T4MASTER, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDIF + ELSE IF ( T4MASTER.GT.0 ) THEN + CALL CMUMPS_34( ISEND, JSEND, VAL, + & T4MASTER, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + END IF + 120 CONTINUE + KEEP(49) = ARROW_ROOT + IF (NBUFS.GT.0) THEN + CALL CMUMPS_18( + & BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP( 46 ) ) + ENDIF + IF ( KEEP( 46 ) .NE. 0 ) DEALLOCATE( IW4 ) + IF (NBUFS.GT.0) THEN + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + ENDIF + RETURN + END SUBROUTINE CMUMPS_148 + SUBROUTINE CMUMPS_34(ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, LP, COMM, + & TYPE_PARALL ) + IMPLICIT NONE + INTEGER ISEND, JSEND, DEST, NBUFS, NBRECORDS, TYPE_PARALL + INTEGER BUFI( NBRECORDS * 2 + 1, NBUFS ) + COMPLEX BUFR( NBRECORDS, NBUFS ) + INTEGER COMM + INTEGER LP + COMPLEX VAL + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + INTEGER TAILLE_SENDI, TAILLE_SENDR, IREQ + IF (BUFI(1,DEST)+1.GT.NBRECORDS) THEN + TAILLE_SENDI = BUFI(1,DEST) * 2 + 1 + TAILLE_SENDR = BUFI(1,DEST) + CALL MPI_SEND(BUFI(1,DEST),TAILLE_SENDI, + & MPI_INTEGER, + & DEST, ARROWHEAD, COMM, IERR ) + CALL MPI_SEND( BUFR(1,DEST), TAILLE_SENDR, + & MPI_COMPLEX, DEST, + & ARROWHEAD, COMM, IERR ) + BUFI(1,DEST) = 0 + ENDIF + IREQ = BUFI(1,DEST) + 1 + BUFI(1,DEST) = IREQ + BUFI( IREQ * 2, DEST ) = ISEND + BUFI( IREQ * 2 + 1, DEST ) = JSEND + BUFR( IREQ, DEST ) = VAL + RETURN + END SUBROUTINE CMUMPS_34 + SUBROUTINE CMUMPS_18( + & BUFI, BUFR, NBRECORDS, NBUFS, LP, COMM, + & TYPE_PARALL ) + IMPLICIT NONE + INTEGER NBUFS, NBRECORDS, TYPE_PARALL + INTEGER BUFI( NBRECORDS * 2 + 1, NBUFS ) + COMPLEX BUFR( NBRECORDS, NBUFS ) + INTEGER COMM + INTEGER LP + INTEGER ISLAVE, TAILLE_SENDI, TAILLE_SENDR, IERR + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + DO ISLAVE = 1,NBUFS + TAILLE_SENDI = BUFI(1,ISLAVE) * 2 + 1 + TAILLE_SENDR = BUFI(1,ISLAVE) + BUFI(1,ISLAVE) = - BUFI(1,ISLAVE) + CALL MPI_SEND(BUFI(1,ISLAVE),TAILLE_SENDI, + & MPI_INTEGER, + & ISLAVE, ARROWHEAD, COMM, IERR ) + IF ( TAILLE_SENDR .NE. 0 ) THEN + CALL MPI_SEND( BUFR(1,ISLAVE), TAILLE_SENDR, + & MPI_COMPLEX, ISLAVE, + & ARROWHEAD, COMM, IERR ) + END IF + ENDDO + RETURN + END SUBROUTINE CMUMPS_18 + RECURSIVE SUBROUTINE CMUMPS_310( N, PERM, + & INTLIST, DBLLIST, TAILLE, LO, HI ) + IMPLICIT NONE + INTEGER N, TAILLE + INTEGER PERM( N ) + INTEGER INTLIST( TAILLE ) + COMPLEX DBLLIST( TAILLE ) + INTEGER LO, HI + INTEGER I,J + INTEGER ISWAP, PIVOT + COMPLEX cswap + I = LO + J = HI + PIVOT = PERM(INTLIST((I+J)/2)) + 10 IF (PERM(INTLIST(I)) < PIVOT) THEN + I=I+1 + GOTO 10 + ENDIF + 20 IF (PERM(INTLIST(J)) > PIVOT) THEN + J=J-1 + GOTO 20 + ENDIF + IF (I < J) THEN + ISWAP = INTLIST(I) + INTLIST(I) = INTLIST(J) + INTLIST(J)=ISWAP + cswap = DBLLIST(I) + DBLLIST(I) = DBLLIST(J) + DBLLIST(J) = cswap + ENDIF + IF ( I <= J) THEN + I = I+1 + J = J-1 + ENDIF + IF ( I <= J ) GOTO 10 + IF ( LO < J ) CALL CMUMPS_310(N, PERM, + & INTLIST, DBLLIST, TAILLE, LO, J) + IF ( I < HI ) CALL CMUMPS_310(N, PERM, + & INTLIST, DBLLIST, TAILLE, I, HI) + RETURN + END SUBROUTINE CMUMPS_310 + SUBROUTINE CMUMPS_145( N, + & DBLARR, LDBLARR, INTARR, LINTARR, PTRAIW, PTRARW, + & KEEP, KEEP8, MYID, COMM, NBRECORDS, + & A, LA, root, + & PROCNODE_STEPS, + & SLAVEF, PERM, FRERE_STEPS, STEP, INFO1, INFO2 + & ) + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INTEGER N, MYID, LDBLARR, LINTARR, + & COMM + INTEGER INTARR(LINTARR) + INTEGER PTRAIW(N), PTRARW(N) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8), intent(IN) :: LA + INTEGER PROCNODE_STEPS( KEEP(28) ), PERM( N ) + INTEGER SLAVEF, NBRECORDS + COMPLEX A( LA ) + INTEGER INFO1, INFO2 + COMPLEX DBLARR(LDBLARR) + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER, POINTER, DIMENSION(:) :: BUFI + COMPLEX, POINTER, DIMENSION(:) :: BUFR + INTEGER, POINTER, DIMENSION(:,:) :: IW4 + LOGICAL FINI + INTEGER IREC, NB_REC, IARR, JARR, IA, I1, I, allocok + INTEGER IS, IS1, ISHIFT, IIW, IAS + INTEGER LOCAL_M, LOCAL_N, ILOCROOT, JLOCROOT, + & IPOSROOT, JPOSROOT, TAILLE, + & IPROC + INTEGER FRERE_STEPS( KEEP(28) ), STEP(N) + INTEGER(8) :: PTR_ROOT + INTEGER ARROW_ROOT, TYPE_PARALL + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + COMPLEX VAL + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER MASTER + PARAMETER(MASTER=0) + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER IERR + INTEGER numroc + EXTERNAL numroc + TYPE_PARALL = KEEP(46) + ARROW_ROOT=0 + ALLOCATE( BUFI( NBRECORDS * 2 + 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO1 = -13 + INFO2 = NBRECORDS * 2 + 1 + WRITE(*,*) MYID,': Could not allocate BUFI: goto 500' + GOTO 500 + END IF + ALLOCATE( BUFR( NBRECORDS ) , stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO1 = -13 + INFO2 = NBRECORDS + WRITE(*,*) MYID,': Could not allocate BUFR: goto 500' + GOTO 500 + END IF + ALLOCATE( IW4(N,2), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO1 = -13 + INFO2 = 2 * N + WRITE(*,*) MYID,': Could not allocate IW4: goto 500' + GOTO 500 + END IF + IF ( KEEP(38).NE.0) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I=1, root%SCHUR_NLOC + root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1: + & (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC)=ZERO + ENDDO + ENDIF + END IF + FINI = .FALSE. + DO I=1,N + I1 = PTRAIW(I) + IA = PTRARW(I) + IF (IA.GT.0) THEN + DBLARR(IA) = ZERO + IW4(I,1) = INTARR(I1) + IW4(I,2) = -INTARR(I1+1) + INTARR(I1+2)=I + ENDIF + ENDDO + DO WHILE (.NOT.FINI) + CALL MPI_RECV( BUFI(1), 2*NBRECORDS+1, + & MPI_INTEGER, MASTER, + & ARROWHEAD, + & COMM, STATUS, IERR ) + NB_REC = BUFI(1) + IF (NB_REC.LE.0) THEN + FINI = .TRUE. + NB_REC = -NB_REC + ENDIF + IF (NB_REC.EQ.0) EXIT + CALL MPI_RECV( BUFR(1), NBRECORDS, MPI_COMPLEX, + & MASTER, ARROWHEAD, + & COMM, STATUS, IERR ) + DO IREC=1, NB_REC + IARR = BUFI( IREC * 2 ) + JARR = BUFI( IREC * 2 + 1 ) + VAL = BUFR( IREC ) + IF ( MUMPS_330( PROCNODE_STEPS(abs(STEP(abs(IARR)))), + & SLAVEF ) .eq. 3 ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + IF ( IARR .GT. 0 ) THEN + IPOSROOT = root%RG2L_ROW( IARR ) + JPOSROOT = root%RG2L_COL( JARR ) + ELSE + IPOSROOT = root%RG2L_ROW( JARR ) + JPOSROOT = root%RG2L_COL( -IARR ) + END IF + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & = A( PTR_ROOT + int(JLOCROOT - 1,8) + & * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8)) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + ELSE IF (IARR.GE.0) THEN + IF (IARR.EQ.JARR) THEN + IA = PTRARW(IARR) + DBLARR(IA) = DBLARR(IA) + VAL + ELSE + IS1 = PTRAIW(IARR) + ISHIFT = INTARR(IS1) + IW4(IARR,2) + IW4(IARR,2) = IW4(IARR,2) - 1 + IIW = IS1 + ISHIFT + 2 + INTARR(IIW) = JARR + IS = PTRARW(IARR) + IAS = IS + ISHIFT + DBLARR(IAS) = VAL + ENDIF + ELSE + IARR = -IARR + ISHIFT = PTRAIW(IARR)+IW4(IARR,1)+2 + INTARR(ISHIFT) = JARR + IAS = PTRARW(IARR)+IW4(IARR,1) + IW4(IARR,1) = IW4(IARR,1) - 1 + DBLARR(IAS) = VAL + IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0) + & .AND. IW4(IARR,1) .EQ. 0 + & .AND. STEP(IARR) > 0 ) THEN + IPROC = MUMPS_275( PROCNODE_STEPS(abs(STEP(IARR))), + & SLAVEF ) + IF ( TYPE_PARALL .eq. 0 ) THEN + IPROC = IPROC + 1 + END IF + IF (IPROC .EQ. MYID) THEN + TAILLE = INTARR( PTRAIW(IARR) ) + CALL CMUMPS_310( N, PERM, + & INTARR( PTRAIW(IARR) + 3 ), + & DBLARR( PTRARW(IARR) + 1 ), + & TAILLE, 1, TAILLE ) + END IF + END IF + ENDIF + ENDDO + END DO + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + DEALLOCATE( IW4 ) + 500 CONTINUE + KEEP(49) = ARROW_ROOT + RETURN + END SUBROUTINE CMUMPS_145 + SUBROUTINE CMUMPS_266( MYID, BUFR, LBUFR, + & LBUFR_BYTES, + & IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, + & TNBPROCFILS, N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP, + & KEEP,KEEP8, ITLOC, RHS_MUMPS, + & IFLAG, IERROR ) + USE CMUMPS_LOAD + IMPLICIT NONE + INTEGER MYID + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB, N, LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER PTRIST(KEEP(28)), STEP(N), + & PIMASTER(KEEP(28)), + & TNBPROCFILS( KEEP(28) ), ITLOC( N + KEEP(253) ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER COMP, IFLAG, IERROR + INTEGER INODE, NBPROCFILS, NCOL, NROW, NASS, NSLAVES + INTEGER NSLAVES_RECU, NFRONT + INTEGER LREQ + INTEGER(8) :: LREQCB + DOUBLE PRECISION FLOP1 + INCLUDE 'mumps_headers.h' + INODE = BUFR( 1 ) + NBPROCFILS = BUFR( 2 ) + NROW = BUFR( 3 ) + NCOL = BUFR( 4 ) + NASS = BUFR( 5 ) + NFRONT = BUFR( 6 ) + NSLAVES_RECU = BUFR( 7 ) + IF ( KEEP(50) .eq. 0 ) THEN + FLOP1 = dble( NASS * NROW ) + + & dble(NROW*NASS)*dble(2*NCOL-NASS-1) + ELSE + FLOP1 = dble( NASS ) * dble( NROW ) + & * dble( 2 * NCOL - NROW - NASS + 1) + END IF + CALL CMUMPS_190(1,.TRUE.,FLOP1, KEEP,KEEP8) + IF ( KEEP(50) .eq. 0 ) THEN + NSLAVES = NSLAVES_RECU + XTRA_SLAVES_UNSYM + ELSE + NSLAVES = NSLAVES_RECU + XTRA_SLAVES_SYM + END IF + LREQ = NROW + NCOL + 6 + NSLAVES + KEEP(IXSZ) + LREQCB = int(NCOL,8) * int(NROW,8) + CALL CMUMPS_22(.FALSE., 0_8, .FALSE.,.TRUE., + & MYID,N, KEEP,KEEP8, IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST, STEP, PIMASTER,PAMASTER, + & LREQ, LREQCB, INODE, S_ACTIVE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + PTRIST(STEP(INODE)) = IWPOSCB + 1 + PTRAST(STEP(INODE)) = IPTRLU + 1_8 + IW( IWPOSCB + 1+KEEP(IXSZ) ) = NCOL + IW( IWPOSCB + 2+KEEP(IXSZ) ) = - NASS + IW( IWPOSCB + 3+KEEP(IXSZ) ) = NROW + IW( IWPOSCB + 4+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 5+KEEP(IXSZ) ) = NASS + IW( IWPOSCB + 6+KEEP(IXSZ) ) = NSLAVES + IW( IWPOSCB + 7+KEEP(IXSZ)+NSLAVES : + & IWPOSCB + 6+KEEP(IXSZ)+NSLAVES + NROW + NCOL ) + &= BUFR( 8 + NSLAVES_RECU : 7 + NSLAVES_RECU + NROW + NCOL ) + IF ( KEEP(50) .eq. 0 ) THEN + IW( IWPOSCB + 7+KEEP(IXSZ) ) = S_ROOTBAND_INIT + IF (NSLAVES_RECU.GT.0) + & IW( IWPOSCB + 7+XTRA_SLAVES_UNSYM+KEEP(IXSZ): + & IWPOSCB+6+KEEP(IXSZ)+NSLAVES_RECU ) = + & BUFR( 8: 7 + NSLAVES_RECU ) + ELSE + IW( IWPOSCB + 7+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 8+KEEP(IXSZ) ) = NFRONT + IW( IWPOSCB + 9+KEEP(IXSZ) ) = S_ROOTBAND_INIT + IW( IWPOSCB + 7+XTRA_SLAVES_SYM+KEEP(IXSZ): + & IWPOSCB + 6+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_RECU ) = + & BUFR( 8: 7 + NSLAVES_RECU ) + END IF + TNBPROCFILS(STEP( INODE )) = NBPROCFILS + RETURN + END SUBROUTINE CMUMPS_266 + SUBROUTINE CMUMPS_163( id ) + USE CMUMPS_STRUC_DEF + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE (CMUMPS_STRUC) id + INTEGER MASTER, IERR,PAR_loc,SYM_loc + PARAMETER( MASTER = 0 ) + INTEGER color + CALL MPI_COMM_SIZE(id%COMM, id%NPROCS, IERR ) + PAR_loc=id%PAR + SYM_loc=id%SYM + CALL MPI_BCAST(PAR_loc,1,MPI_INTEGER,MASTER,id%COMM,IERR) + CALL MPI_BCAST(SYM_loc,1,MPI_INTEGER,MASTER,id%COMM,IERR) + IF ( PAR_loc .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + color = MPI_UNDEFINED + ELSE + color = 0 + END IF + CALL MPI_COMM_SPLIT( id%COMM, color, 0, + & id%COMM_NODES, IERR ) + id%NSLAVES = id%NPROCS - 1 + ELSE + CALL MPI_COMM_DUP( id%COMM, id%COMM_NODES, IERR ) + id%NSLAVES = id%NPROCS + END IF + IF (PAR_loc .ne. 0 .or. id%MYID .NE. MASTER) THEN + CALL MPI_COMM_DUP( id%COMM_NODES, id%COMM_LOAD, IERR ) + ENDIF + CALL CMUMPS_20( id%NSLAVES, id%LWK_USER, + & id%CNTL(1), id%ICNTL(1), + & id%KEEP(1), id%KEEP8(1), id%INFO(1), id%INFOG(1), + & id%RINFO(1), id%RINFOG(1), + & SYM_loc, PAR_loc, id%DKEEP(1) ) + id%WRITE_PROBLEM="NAME_NOT_INITIALIZED" + CALL MUMPS_SET_VERSION( id%VERSION_NUMBER ) + id%OOC_TMPDIR="NAME_NOT_INITIALIZED" + id%OOC_PREFIX="NAME_NOT_INITIALIZED" + id%NRHS = 1 + id%LRHS = 0 + id%LREDRHS = 0 + CALL CMUMPS_61( id%KEEP( 34 ), id%KEEP(35) ) + NULLIFY(id%BUFR) + id%MAXIS1 = 0 + id%INST_Number = -1 + id%N = 0; id%NZ = 0 + NULLIFY(id%IRN) + NULLIFY(id%JCN) + NULLIFY(id%A) + id%NZ_loc = 0 + NULLIFY(id%IRN_loc) + NULLIFY(id%JCN_loc) + NULLIFY(id%A_loc) + NULLIFY(id%MAPPING) + NULLIFY(id%RHS) + NULLIFY(id%REDRHS) + id%NZ_RHS=0 + NULLIFY(id%RHS_SPARSE) + NULLIFY(id%IRHS_SPARSE) + NULLIFY(id%IRHS_PTR) + NULLIFY(id%ISOL_loc) + id%LSOL_loc=0 + NULLIFY(id%SOL_loc) + NULLIFY(id%COLSCA) + NULLIFY(id%ROWSCA) + NULLIFY(id%PERM_IN) + NULLIFY(id%IS) + NULLIFY(id%IS1) + NULLIFY(id%STEP) + NULLIFY(id%Step2node) + NULLIFY(id%DAD_STEPS) + NULLIFY(id%NE_STEPS) + NULLIFY(id%ND_STEPS) + NULLIFY(id%FRERE_STEPS) + NULLIFY(id%SYM_PERM) + NULLIFY(id%UNS_PERM) + NULLIFY(id%PIVNUL_LIST) + NULLIFY(id%FILS) + NULLIFY(id%PTRAR) + NULLIFY(id%FRTPTR) + NULLIFY(id%FRTELT) + NULLIFY(id%NA) + id%LNA=0 + NULLIFY(id%PROCNODE_STEPS) + NULLIFY(id%S) + NULLIFY(id%PROCNODE) + NULLIFY(id%POIDS) + NULLIFY(id%PTLUST_S) + NULLIFY(id%PTRFAC) + NULLIFY(id%INTARR) + NULLIFY(id%DBLARR) + NULLIFY(id%DEPTH_FIRST) + NULLIFY(id%DEPTH_FIRST_SEQ) + NULLIFY(id%SBTR_ID) + NULLIFY(id%MEM_SUBTREE) + NULLIFY(id%MEM_SUBTREE) + NULLIFY(id%MY_ROOT_SBTR) + NULLIFY(id%MY_FIRST_LEAF) + NULLIFY(id%MY_NB_LEAF) + NULLIFY(id%COST_TRAV) + NULLIFY(id%RHSCOMP) + NULLIFY(id%POSINRHSCOMP) + NULLIFY(id%OOC_INODE_SEQUENCE) + NULLIFY(id%OOC_TOTAL_NB_NODES) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + NULLIFY(id%OOC_FILE_NAME_LENGTH) + NULLIFY(id%OOC_FILE_NAMES) + NULLIFY(id%OOC_VADDR) + NULLIFY(id%OOC_NB_FILES) + NULLIFY(id%CB_SON_SIZE) + NULLIFY(id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY(id%root%RHS_ROOT) + NULLIFY(id%root%RG2L_ROW) + NULLIFY(id%root%RG2L_COL) + NULLIFY(id%root%IPIV) + NULLIFY(id%root%SCHUR_POINTER) + NULLIFY(id%SCHUR_CINTERFACE) + id%NELT=0 + NULLIFY(id%ELTPTR) + NULLIFY(id%ELTVAR) + NULLIFY(id%A_ELT) + NULLIFY(id%ELTPROC) + id%SIZE_SCHUR = 0 + NULLIFY( id%LISTVAR_SCHUR ) + NULLIFY( id%SCHUR ) + id%NPROW = 0 + id%NPCOL = 0 + id%MBLOCK = 0 + id%NBLOCK = 0 + id%SCHUR_MLOC = 0 + id%SCHUR_NLOC = 0 + id%SCHUR_LLD = 0 + NULLIFY(id%ISTEP_TO_INIV2) + NULLIFY(id%I_AM_CAND) + NULLIFY(id%FUTURE_NIV2) + NULLIFY(id%TAB_POS_IN_PERE) + NULLIFY(id%CANDIDATES) + CALL CMUMPS_637(id) + NULLIFY(id%MEM_DIST) + NULLIFY(id%SUP_PROC) + id%Deficiency = 0 + id%root%LPIV = -1 + id%root%yes = .FALSE. + id%root%gridinit_done = .FALSE. + IF ( id%KEEP( 46 ) .ne. 0 .OR. + & id%MYID .ne. MASTER ) THEN + CALL MPI_COMM_RANK + & (id%COMM_NODES, id%MYID_NODES, IERR ) + ELSE + id%MYID_NODES = -464646 + ENDIF + RETURN + END SUBROUTINE CMUMPS_163 + SUBROUTINE CMUMPS_252( COMM_LOAD, ASS_IRECV, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, + & FILS, FRERE, DAD, MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER,PTRARW, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & + & NSTK_S,NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, JOBASS, ETATASS + & ) + USE CMUMPS_COMM_BUFFER + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mpif.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER IZERO + PARAMETER (IZERO=0) + INTEGER N,LIW,NSTEPS + INTEGER(8) LA, LRLU, LRLUS, IPTRLU, POSFAC + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & IWPOS, IWPOSCB, COMP + INTEGER JOBASS,ETATASS + LOGICAL SON_LEVEL2 + COMPLEX A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER COMM, NBFIN, SLAVEF, MYID + INTEGER LPOOL, LEAF + INTEGER LBUFR, LBUFR_BYTES + INTEGER NBPROCFILS(KEEP(28)) + INTEGER NSTK_S(KEEP(28)),PROCNODE_STEPS(KEEP(28)) + INTEGER IPOOL( LPOOL ) + INTEGER BUFR( LBUFR ) + INTEGER IDUMMY(1) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(N), PTRAIW(N), ND(KEEP(28)), PERM(N), + & FILS(N), FRERE(KEEP(28)), DAD(KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)), + & PAMASTER(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX DBLARR(max(1,KEEP(13))) + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + INTEGER LP, HS, HF + INTEGER NBPANELS_L, NBPANELS_U + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + INTEGER NFS4FATHER + INTEGER(8) NFRONT8, LAELL8, LAELL_REQ8 + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER LREQ_OOC + INTEGER(8) :: SIZFR + INTEGER SIZFI, NCB + INTEGER J1,J2 + INTEGER NCOLS, NROWS, LDA_SON + INTEGER(8) :: JJ2, ICT13 +#if defined(ALLOW_NON_INIT) + INTEGER(8) :: NUMROWS, JJ3, JJ8, APOS_ini +#endif + INTEGER NELIM,JJ,JJ1,J3, + & IBROT,IORG + INTEGER JPOS,ICT11 + INTEGER JK,IJROW,NBCOL,NUMORG,IOLDPS,J4 + INTEGER(8) IACHK, POSELT, LAPOS2, IACHK_ini + INTEGER(8) APOS, APOS2, APOS3, POSEL1, ICT12 + INTEGER AINPUT + INTEGER NSLAVES, NSLSON, NPIVS,NPIV_ANA,NPIV + INTEGER PTRCOL, ISLAVE, PDEST,LEVEL + INTEGER ISON_IN_PLACE + INTEGER ISON_TOP + INTEGER(8) SIZE_ISON_TOP8 + LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS, + & RISK_OF_SAME_POS_THIS_LINE, OMP_PARALLEL_FLAG + LOGICAL LEVEL1, NIV1 + INTEGER TROW_SIZE + INTEGER INDX, FIRST_INDEX, SHIFT_INDEX + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INCLUDE 'mumps_headers.h' + INTEGER NCBSON + LOGICAL SAME_PROC + INTRINSIC real + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INTEGER NELT, LPTRAR + EXTERNAL MUMPS_167 + LOGICAL MUMPS_167 + LOGICAL SSARBR + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + DOUBLE PRECISION FLOP1,FLOP1_EFF + EXTERNAL MUMPS_170 + LOGICAL MUMPS_170 + COMPRESSCB =.FALSE. + NELT = 1 + LPTRAR = N + NFS4FATHER = -1 + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + LEVEL = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (LEVEL.NE.1) THEN + write(6,*) 'Error1 in mpi51f_niv1 ' + CALL MUMPS_ABORT() + ENDIF + NSLAVES = 0 + HF = 6 + NSLAVES + KEEP(IXSZ) + IF (JOBASS.EQ.0) THEN + ETATASS= 0 + ELSE + ETATASS= 2 + IOLDPS = PTLUST_S(STEP(INODE)) + NFRONT = IW(IOLDPS + KEEP(IXSZ)) + NASS1 = iabs(IW(IOLDPS + 2 + KEEP(IXSZ))) + ICT11 = IOLDPS + HF - 1 + NFRONT + SSARBR=MUMPS_167(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + ENDDO + NUMSTK = 0 + IFSON = -IN + ISON = IFSON + IF (ISON .NE. 0) THEN + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + ISON = FRERE(STEP(ISON)) + ENDDO + ENDIF + GOTO 123 + ENDIF + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + ENDDO + NPIV_ANA=NUMORG + NSTEPS = NSTEPS + 1 + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + IF (ISON .NE. 0) THEN + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + NASS = NASS + IW(PIMASTER(STEP(ISON))+1+KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + ENDDO + ENDIF + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + NASS1 = NASS + NUMORG + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL CMUMPS_684( KEEP(50), NFRONT, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL CMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + ENDIF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + ENDIF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + ISON_TOP = -9999 + ISON_IN_PLACE = -9999 + SIZE_ISON_TOP8 = 0_8 + IF (KEEP(234).NE.0) THEN + IF ( IWPOSCB .NE. LIW ) THEN + IF ( IWPOSCB+IW(IWPOSCB+1+XXI).NE.LIW) THEN + ISON = IW( IWPOSCB + 1 + XXN ) + IF ( DAD( STEP( ISON ) ) .EQ. INODE .AND. + & MUMPS_330(PROCNODE_STEPS(STEP(ISON)),SLAVEF) + & .EQ. 1 ) + & THEN + ISON_TOP = ISON + CALL MUMPS_729(SIZE_ISON_TOP8,IW(IWPOSCB + 1 + XXR)) + IF (LRLU .LT. int(NFRONT,8) * int(NFRONT,8)) THEN + ISON_IN_PLACE = ISON + ENDIF + END IF + END IF + END IF + END IF + NIV1 = .TRUE. + IF (KEEP(50).EQ.0 .AND. KEEP(234) .EQ. 0) THEN + CALL MUMPS_81(MYID, INODE, N, IOLDPS, HF, NFRONT, + & NFRONT_EFF, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP, KEEP8, IFLAG, + & PROCNODE_STEPS, SLAVEF ) + ELSE + CALL MUMPS_86( MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP, KEEP8, IFLAG, + & ISON_IN_PLACE, + & PROCNODE_STEPS, SLAVEF) + IF (IFLAG.LT.0) GOTO 300 + ENDIF + IF (NFRONT_EFF.NE.NFRONT) THEN + IF (NFRONT.GT.NFRONT_EFF) THEN + IF(MUMPS_170(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF))THEN + NPIV=NASS1-(NFRONT_EFF-ND(STEP(INODE))) + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1) + NPIV=NPIV_ANA + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1_EFF) + CALL CMUMPS_190(0,.FALSE.,FLOP1-FLOP1_EFF, + & KEEP,KEEP8) + ENDIF + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) ' ERROR 1 during ass_niv1', NFRONT, NFRONT_EFF + GOTO 270 + ENDIF + ENDIF + NFRONT8=int(NFRONT,8) + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL CMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + NCB = NFRONT - NASS1 + MAXFRW = max0(MAXFRW, NFRONT) + ICT11 = IOLDPS + HF - 1 + NFRONT + LAELL8 = NFRONT8 * NFRONT8 + LAELL_REQ8 = LAELL8 + IF ( ISON_IN_PLACE > 0 ) THEN + LAELL_REQ8 = LAELL8 - SIZE_ISON_TOP8 + ENDIF + IF (LRLU .LT. LAELL_REQ8) THEN + IF (LRLUS .LT. LAELL_REQ8) THEN + GOTO 280 + ELSE + CALL CMUMPS_94 + & (N, KEEP(28), IW, LIW, A, LA, LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, STEP, PIMASTER, + & PAMASTER,KEEP(216),LRLUS,KEEP(IXSZ)) + COMP = COMP + 1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + ENDIF + ENDIF + ENDIF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + SIZE_ISON_TOP8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + POSFAC = POSFAC + LAELL8 + SSARBR=MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + CALL CMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS, + & 0_8, + & LAELL8-SIZE_ISON_TOP8, + & KEEP,KEEP8, + & LRLU) +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = min(POSELT + LAELL8 - 1_8, IPTRLU) + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. NFRONT .LT. KEEP(63) ) THEN + LAPOS2 = min(POSELT + LAELL8 - 1_8, IPTRLU) + DO JJ8 = POSELT, LAPOS2 + A( JJ8 ) = ZERO + ENDDO + ELSE + IF (ETATASS.EQ.1) THEN + APOS_ini = POSELT + DO JJ8 = 0_8, NFRONT8 - 1_8 + JJ3 = min(JJ8,int(NASS1-1,8)) + APOS = APOS_ini + JJ8 * NFRONT8 + A(APOS:APOS+JJ3) = ZERO + END DO + ELSE + APOS_ini = POSELT + NUMROWS = min(NFRONT8, (IPTRLU-APOS_ini) / NFRONT8 ) + DO JJ8 = 0_8, NUMROWS - 1_8 + APOS = APOS_ini + JJ8 * NFRONT8 + A(APOS:APOS + JJ8) = ZERO + ENDDO + IF( NUMROWS .LT. NFRONT8 ) THEN + APOS = APOS_ini + NFRONT8*NUMROWS + A(APOS : min(IPTRLU,APOS+NUMROWS)) = ZERO + ENDIF + ENDIF + END IF +#endif + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + IW(IOLDPS + KEEP(IXSZ)) = NFRONT + IW(IOLDPS + KEEP(IXSZ) + 1) = 0 + IW(IOLDPS + KEEP(IXSZ) + 2) = -NASS1 + IW(IOLDPS + KEEP(IXSZ) + 3) = -NASS1 + IW(IOLDPS + KEEP(IXSZ) + 4) = STEP(INODE) + IW(IOLDPS + KEEP(IXSZ) + 5) = NSLAVES + 123 CONTINUE + IF (NUMSTK.NE.0) THEN + IF (ISON_TOP > 0) THEN + ISON = ISON_TOP + ELSE + ISON = IFSON + ENDIF + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NELIM = IW(ISTCHK + KEEP(IXSZ) + 1) + NPIVS = IW(ISTCHK + KEEP(IXSZ) + 3) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + HS = 6 + KEEP(IXSZ) + NSLSON + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + LEVEL1 = NSLSON.EQ.0 + IF (.NOT.SAME_PROC) THEN + NROWS = IW( ISTCHK + KEEP(IXSZ) + 2) + ELSE + NROWS = NCOLS + ENDIF + SIZFI = HS + NROWS + NCOLS + J1 = ISTCHK + HS + NROWS + NPIVS + IF ( .NOT. LEVEL1 .AND. NELIM.EQ.0 ) GOTO 205 + IF (LEVEL1) THEN + J2 = J1 + LSTK - 1 + SIZFR = int(LSTK,8)*int(LSTK,8) + IF (COMPRESSCB) SIZFR = (int(LSTK,8)*int(LSTK+1,8))/2_8 + ELSE + IF ( KEEP(50).eq.0 ) THEN + SIZFR = int(NELIM,8) * int(LSTK,8) + ELSE + SIZFR = int(NELIM,8) * int(NELIM,8) + END IF + J2 = J1 + NELIM - 1 + ENDIF + IF (JOBASS.EQ.0) OPASSW = OPASSW + dble(SIZFR) + IACHK = PAMASTER(STEP(ISON)) + IF ( KEEP(50) .eq. 0 ) THEN + POSEL1 = PTRAST(STEP(INODE)) - NFRONT8 + IF (NFRONT .EQ. LSTK.AND. ISON.EQ.ISON_IN_PLACE + & .AND.IACHK + SIZFR - 1_8 .EQ. POSFAC - 1_8 ) THEN + GOTO 205 + ENDIF + IF (J2.GE.J1) THEN + RESET_TO_ZERO = (IACHK .LT. POSFAC) + RISK_OF_SAME_POS = IACHK + SIZFR - 1_8 .EQ. POSFAC - 1_8 + RISK_OF_SAME_POS_THIS_LINE = .FALSE. + IACHK_ini = IACHK + OMP_PARALLEL_FLAG = (RESET_TO_ZERO.EQV..FALSE.).AND. + & ((J2-J1).GT.300) + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * int(NFRONT,8) + IACHK = IACHK_ini + int(JJ-J1,8)*int(LSTK,8) + IF (RISK_OF_SAME_POS) THEN + IF (JJ.EQ.J2) THEN + RISK_OF_SAME_POS_THIS_LINE = + & (ISON .EQ. ISON_IN_PLACE) + & .AND. ( APOS + int(IW(J1+LSTK-1)-1,8).EQ. + & IACHK+int(LSTK-1,8) ) + ENDIF + ENDIF + IF ((IACHK .GE. POSFAC).AND.(JJ>J1))THEN + RESET_TO_ZERO =.FALSE. + ENDIF + IF (RESET_TO_ZERO) THEN + IF (RISK_OF_SAME_POS_THIS_LINE) THEN + DO JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + IF ( IACHK+int(JJ1-1,8) .NE. JJ2 ) THEN + A(JJ2) = A(IACHK + int(JJ1 - 1,8)) + A(IACHK + int(JJ1 -1,8)) = ZERO + ENDIF + ENDDO + ELSE + DO JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1+JJ1-1),8) - 1_8 + A(JJ2) = A(IACHK + int(JJ1 - 1,8)) + A(IACHK + int(JJ1 -1,8)) = ZERO + ENDDO + ENDIF + ELSE + DO JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1+JJ1-1),8) - 1_8 + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8)) + ENDDO + ENDIF + 170 CONTINUE + END IF + ELSE + IF (LEVEL1) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = SIZFR + ELSE + LCB = int(LDA_SON,8)* int(J2-J1+1,8) + ENDIF + CALL CMUMPS_178(A, LA, + & PTRAST(STEP( INODE )), NFRONT, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), J2 - J1 + 1, NELIM, ETATASS, + & COMPRESSCB, (ISON.EQ.ISON_IN_PLACE) + & ) + ENDIF + 205 IF (LEVEL1) THEN + IF (SAME_PROC) ISTCHK = PTRIST(STEP(ISON)) + IF ((SAME_PROC).AND.ETATASS.NE.1) THEN + IF (KEEP(50).NE.0) THEN + J2 = J1 + LSTK - 1 + DO JJ = J1, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + ELSE + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM + DO JJ = J3, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + IF (NELIM .NE. 0) THEN + J3 = J3 - 1 + DO JJ = J1, J3 + JPOS = IW(JJ) + ICT11 + IW(JJ) = IW(JPOS) + ENDDO + ENDIF + ENDIF + ENDIF + IF (ETATASS.NE.1) THEN + IF ( SAME_PROC ) THEN + PTRIST(STEP(ISON)) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL CMUMPS_152(SSARBR, MYID, N, ISTCHK, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, + & (ISON .EQ. ISON_TOP) + & ) + ENDIF + ELSE + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP, KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL CMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, IDUMMY, + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, + & LEAF, NBFIN, ICNTL, KEEP, KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + ENDDO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL CMUMPS_71( + & INODE, NFRONT, NASS1, NFS4FATHER, + & ISON, MYID, + & IZERO, IDUMMY, IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, + & KEEP, KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( + & COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP, KEEP8, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + IF (ISON .LE. 0) THEN + ISON = IFSON + ENDIF + 220 CONTINUE + END IF + IF (ETATASS.EQ.2) GOTO 500 + POSELT = PTRAST(STEP(INODE)) + IBROT = INODE + DO 260 IORG = 1, NUMORG + JK = PTRAIW(IBROT) + AINPUT = PTRARW(IBROT) + JJ = JK + 1 + J1 = JJ + 1 + J2 = J1 + INTARR(JK) + J3 = J2 + 1 + J4 = J2 - INTARR(JJ) + IJROW = INTARR(J1) + ICT12 = POSELT + int(IJROW - NFRONT - 1,8) +Cduplicates --> CVD$ DEPCHK + DO 240 JJ = J1, J2 + APOS2 = ICT12 + int(INTARR(JJ),8) * NFRONT8 + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + 1 + 240 CONTINUE + IF (J3 .LE. J4) THEN + ICT13 = POSELT + int(IJROW - 1,8) * NFRONT8 + NBCOL = J4 - J3 + 1 +Cduplicates--> CVD$ DEPCHK +CduplicatesCVD$ NODEPCHK + DO 250 JJ = 1, NBCOL + APOS3 = ICT13 + int(INTARR(J3 + JJ - 1) - 1,8) + A(APOS3) = A(APOS3) + DBLARR(AINPUT + JJ - 1) + 250 CONTINUE + ENDIF + IF (KEEP(50).EQ.0) THEN + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(IJROW-1,8) * NFRONT8 + + & int(NFRONT-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ELSE + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(NFRONT-KEEP(253)+JJ-1,8) * NFRONT8 + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + 260 CONTINUE + GOTO 500 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER ALLOCATION DURING CMUMPS_252' + ENDIF + GOTO 490 + 280 CONTINUE + IFLAG = -9 + CALL MUMPS_731(LAELL_REQ8 - LRLUS, IERROR) + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, WORKSPACE TOO SMALL DURING CMUMPS_252' + ENDIF + GOTO 490 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, SEND BUFFER TOO SMALL DURING CMUMPS_252' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, SEND BUFFER TOO SMALL DURING CMUMPS_252' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING CMUMPS_252' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 1 + 490 CALL CMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE CMUMPS_252 + SUBROUTINE CMUMPS_253(COMM_LOAD, ASS_IRECV, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, FILS, FRERE, DAD, + & CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_S, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP, KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, LEAF, IPOOL, LPOOL, + & PERM , MEM_DISTRIB) + USE CMUMPS_COMM_BUFFER + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N,LIW,NSTEPS, NBFIN + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & LPOOL, LEAF, IWPOS, IWPOSCB, COMP + INTEGER(8) :: LRLUS, LRLU, IPTRLU, POSFAC + COMPLEX A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER COMM, SLAVEF, MYID, LBUFR, LBUFR_BYTES + INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB + INTEGER IPOOL(LPOOL) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(N), PTRAIW(N), ND(KEEP(28)), + & FILS(N), FRERE(KEEP(28)), DAD (KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), + & PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), PERM(N) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER CAND(SLAVEF+1, max(1,KEEP(56))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER NBPROCFILS(KEEP(28)), + & PROCNODE_STEPS(KEEP(28)), BUFR(LBUFR) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX DBLARR(max(1,KEEP(13))) + INTEGER LP, HS, HF, HF_OLD,NCBSON, NSLAVES_OLD, + & NBSPLIT + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + INTEGER NFS4FATHER,I + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER(8) :: LAELL8 + INTEGER LREQ_OOC + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + INTEGER NCB + INTEGER J1,J2,J3,MP + INTEGER(8) :: JJ8, LAPOS2, JJ2, JJ3 + INTEGER NELIM,JJ,JJ1,NPIVS,NCOLS,NROWS, + & IBROT,IORG + INTEGER LDAFS, LDA_SON + INTEGER JK,IJROW,NBCOL,NUMORG,IOLDPS,J4, NUMORG_SPLIT + INTEGER(8) :: ICT13 + INTEGER(8) :: IACHK, APOS, APOS2, POSELT, ICT12, POSEL1 + INTEGER AINPUT + INTEGER NSLAVES, NSLSON + INTEGER NBLIG, PTRCOL, PTRROW, ISLAVE, PDEST + INTEGER PDEST1(1) + INTEGER TYPESPLIT + INTEGER ISON_IN_PLACE + LOGICAL IS_ofType5or6 + LOGICAL SAME_PROC, NIV1, SON_LEVEL2 + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX + INTEGER IZERO + INTEGER IDUMMY(1) + PARAMETER( IZERO = 0 ) + INTEGER MUMPS_275, MUMPS_330, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, MUMPS_810 + COMPLEX ZERO + REAL RZERO + PARAMETER(RZERO = 0.0E0 ) + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INTEGER NELT, LPTRAR, NCBSON_MAX + logical :: force_cand + INTEGER ETATASS + INCLUDE 'mumps_headers.h' + INTEGER (8) :: APOSMAX + REAL MAXARR + INTEGER INIV2, SIZE_TMP_SLAVES_LIST, allocok, + & NCB_SPLIT, SIZE_LIST_SPLIT + INTEGER, ALLOCATABLE, DIMENSION(:) :: TMP_SLAVES_LIST, COPY_CAND + INTEGER NBPANELS_L, NBPANELS_U + MP = ICNTL(2) + IS_ofType5or6 = .FALSE. + COMPRESSCB = .FALSE. + ETATASS = 0 + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + NSTEPS = NSTEPS + 1 + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + ENDDO + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + NCBSON_MAX = 0 + NELT = 1 + LPTRAR = 1 + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + IF ( KEEP(48)==5 .AND. + & MUMPS_330(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) .EQ. 1) THEN + NCBSON_MAX = max + & ( + & IW(PIMASTER(STEP(ISON))+KEEP(IXSZ)), NCBSON_MAX + & ) + ENDIF + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + ENDDO + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + NASS1 = NASS + NUMORG + NCB = NFRONT - NASS1 + if((KEEP(24).eq.0).or.(KEEP(24).eq.1)) then + force_cand=.FALSE. + else + force_cand=(mod(KEEP(24),2).eq.0) + end if + IF (force_cand) THEN + INIV2 = ISTEP_TO_INIV2( STEP( INODE )) + SIZE_TMP_SLAVES_LIST = CAND( SLAVEF+1, INIV2 ) + ELSE + INIV2 = 1 + SIZE_TMP_SLAVES_LIST = SLAVEF - 1 + ENDIF + ALLOCATE(TMP_SLAVES_LIST(SIZE_TMP_SLAVES_LIST),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + TYPESPLIT = MUMPS_810 (PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IS_ofType5or6 = (TYPESPLIT.EQ.5 .OR. TYPESPLIT.EQ.6) + IF ( (TYPESPLIT.EQ.4) + & .OR.(TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) + & ) THEN + IF (TYPESPLIT.EQ.4) THEN + ALLOCATE(COPY_CAND(SLAVEF+1),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + CALL CMUMPS_791 ( + & INODE, STEP, N, SLAVEF, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & CAND(1,INIV2), ICNTL, COPY_CAND, + & NBSPLIT, NUMORG_SPLIT, TMP_SLAVES_LIST(1), + & SIZE_TMP_SLAVES_LIST + & ) + NCB_SPLIT = NCB-NUMORG_SPLIT + SIZE_LIST_SPLIT = SIZE_TMP_SLAVES_LIST - NBSPLIT + CALL CMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, COPY_CAND, + & MEM_DISTRIB(0), NCB_SPLIT, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST(NBSPLIT+1), + & SIZE_LIST_SPLIT,INODE ) + DEALLOCATE (COPY_CAND) + CALL CMUMPS_790 ( + & INODE, STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, + & TAB_POS_IN_PERE(1,INIV2), + & NSLAVES + & ) + ELSE + ISTCHK = PIMASTER(STEP(IFSON)) + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + TMP_SLAVES_LIST (1:SIZE_TMP_SLAVES_LIST) + & = CAND (1:SIZE_TMP_SLAVES_LIST, INIV2) + CALL CMUMPS_792 ( + & INODE, TYPESPLIT, IFSON, + & IW(PDEST), NSLSON, + & STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, ISTEP_TO_INIV2, INIV2, + & TAB_POS_IN_PERE, NSLAVES, + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST + & ) + ENDIF + ELSE + CALL CMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL CMUMPS_684(KEEP(50), NASS1, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL CMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, + & KEEP(216),LRLUS,KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + ENDIF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + ENDIF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + NIV1 = .FALSE. + IF (KEEP(50).EQ.0 .AND. KEEP(234).EQ.0) THEN + CALL MUMPS_81(MYID, INODE, N, IOLDPS, HF, NFRONT, + & NFRONT_EFF, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG, + & PROCNODE_STEPS, SLAVEF ) + ELSE + ISON_IN_PLACE = -9999 + CALL MUMPS_86( MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG, + & ISON_IN_PLACE, + & PROCNODE_STEPS, SLAVEF) + IF (IFLAG.LT.0) GOTO 250 + ENDIF + IF ( NFRONT .NE. NFRONT_EFF ) THEN + IF ( + & (TYPESPLIT.EQ.5) .OR. (TYPESPLIT.EQ.6) ) THEN + WRITE(6,*) ' Internal error 1 in fac_ass due to plitting ', + & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ENDIF + IF (NFRONT.GT.NFRONT_EFF) THEN + NCB = NFRONT_EFF - NASS1 + NSLAVES_OLD = NSLAVES + HF_OLD = HF + IF (TYPESPLIT.EQ.4) THEN + WRITE(6,*) ' Internal error 2 in fac_ass due', + & ' to splitting ', + & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ELSE + CALL CMUMPS_472( NCBSON_MAX, + & SLAVEF, KEEP,KEEP8, ICNTL, + & CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT_EFF, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) - + & (NSLAVES_OLD - NSLAVES) + IF (NSLAVES_OLD .NE. NSLAVES) THEN + IF (NSLAVES_OLD > NSLAVES) THEN + DO JJ=0,2*NFRONT_EFF-1 + IW(IOLDPS+HF+JJ)=IW(IOLDPS+HF_OLD+JJ) + ENDDO + ELSE + IF (IWPOS - 1 > IWPOSCB ) GOTO 270 + DO JJ=2*NFRONT_EFF-1, 0, -1 + IW(IOLDPS+HF+JJ) = IW(IOLDPS+HF_OLD+JJ) + ENDDO + END IF + END IF + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) MYID,': ERROR 2 during ass_niv2, INODE=', INODE, + & ' NFRONT, NFRONT_EFF=', NFRONT, NFRONT_EFF + GOTO 270 + ENDIF + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL CMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + MAXFRW = max0(MAXFRW, NFRONT) + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS + 1+KEEP(IXSZ)) = 0 + IW(IOLDPS + 2+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 3+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) + IW(IOLDPS+KEEP(IXSZ)) = NFRONT + IW(IOLDPS+5+KEEP(IXSZ)) = NSLAVES + IW(IOLDPS+6+KEEP(IXSZ):IOLDPS+5+KEEP(IXSZ)+NSLAVES)= + & TMP_SLAVES_LIST(1:NSLAVES) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + IF ( KEEP(73) .EQ. 0 ) THEN +#endif +#endif + CALL CMUMPS_461(MYID, SLAVEF, COMM_LOAD, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, IW(IOLDPS+6+KEEP(IXSZ)), NSLAVES,INODE) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + ENDIF +#endif +#endif + IF(KEEP(86).EQ.1)THEN + IF(mod(KEEP(24),2).eq.0)THEN + CALL CMUMPS_533(SLAVEF,CAND(SLAVEF+1,INIV2), + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE) + ELSEIF((KEEP(24).EQ.0).OR.(KEEP(24).EQ.1))THEN + CALL CMUMPS_533(SLAVEF,SLAVEF-1, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE) + ENDIF + ENDIF + DEALLOCATE(TMP_SLAVES_LIST) + IF (KEEP(50).EQ.0) THEN + LAELL8 = int(NASS1,8) * int(NFRONT,8) + LDAFS = NFRONT + ELSE + LAELL8 = int(NASS1,8)*int(NASS1,8) + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) + & LAELL8 = LAELL8+int(NASS1,8) + LDAFS = NASS1 + ENDIF + IF (LRLU .LT. LAELL8) THEN + IF (LRLUS .LT. LAELL8) THEN + GOTO 280 + ELSE + CALL CMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + ENDIF + ENDIF + ENDIF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + POSFAC = POSFAC + LAELL8 + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + CALL CMUMPS_471(.FALSE.,.FALSE.,LA-LRLUS,0_8,LAELL8, + & KEEP,KEEP8,LRLU) + POSEL1 = POSELT - int(LDAFS,8) +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. LDAFS .lt. KEEP(63) ) THEN + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO + ELSE + APOS = POSELT + DO JJ8 = 0_8, int(LDAFS-1,8) + A(APOS:APOS+JJ8) = ZERO + APOS = APOS + int(LDAFS,8) + END DO + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + A(APOS:APOS+int(LDAFS,8)-1_8)=ZERO + ENDIF + END IF +#endif + IF ((NUMSTK.NE.0).AND.(NASS.NE.0)) THEN + ISON = IFSON + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + IF (NELIM.EQ.0) GOTO 210 + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS=0 + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + 2+KEEP(IXSZ)) + ELSE + NROWS = NCOLS + ENDIF + OPASSW = OPASSW + dble(NELIM*LSTK) + J1 = ISTCHK + HS + NROWS + NPIVS + J2 = J1 + NELIM - 1 + IACHK = PAMASTER(STEP(ISON)) + IF (KEEP(50).eq.0) THEN + IF (IS_ofType5or6) THEN + APOS = POSELT + DO JJ8 = 1_8, int(NELIM,8)*int(LSTK,8) + A(APOS+JJ8-1_8) = A(APOS+JJ8-1_8) + A(IACHK+JJ8-1_8) + ENDDO + ELSE + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * int(LDAFS,8) + DO 160 JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1),8) - 1_8 + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8)) + 160 CONTINUE + IACHK = IACHK + int(LSTK,8) + 170 CONTINUE + ENDIF + ELSE + IF (NSLSON.EQ.0) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = (int(NELIM,8)*int(NELIM+1,8))/2_8 + ELSE + LCB = int(LDA_SON,8)*int(NELIM,8) + ENDIF + CALL CMUMPS_178( A, LA, + & POSELT, LDAFS, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), NELIM, NELIM, ETATASS, + & COMPRESSCB, + & .FALSE. + & ) + ENDIF + 210 ISON = FRERE(STEP(ISON)) + 220 CONTINUE + ENDIF + IBROT = INODE + APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8) + DO 260 IORG = 1, NUMORG + JK = PTRAIW(IBROT) + AINPUT = PTRARW(IBROT) + JJ = JK + 1 + J1 = JJ + 1 + J2 = J1 + INTARR(JK) + J3 = J2 + 1 + J4 = J2 - INTARR(JJ) + IJROW = INTARR(J1) + ICT12 = POSELT + int(IJROW - 1 - LDAFS, 8) + MAXARR = RZERO +CduplicatesCVD$ NODEPCHK + DO 240 JJ = J1, J2 + IF (KEEP(219).NE.0) THEN + IF (INTARR(JJ).LE.NASS1) THEN + APOS2 = ICT12 + int(INTARR(JJ),8) * int(LDAFS,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + ELSEIF (KEEP(50).EQ.2) THEN + MAXARR = max(MAXARR,abs(DBLARR(AINPUT))) + ENDIF + ELSE + IF (INTARR(JJ).LE.NASS1) THEN + APOS2 = ICT12 + int(INTARR(JJ),8) * int(LDAFS,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + ENDIF + ENDIF + AINPUT = AINPUT + 1 + 240 CONTINUE + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN + A(APOSMAX+int(IJROW-1,8)) = cmplx(MAXARR,kind=kind(A)) + ENDIF + IF (J3 .GT. J4) GOTO 255 + ICT13 = POSELT + int(IJROW - 1,8) * int(LDAFS,8) + NBCOL = J4 - J3 + 1 +CduplicatesCVD$ NODEPCHK +CduplicatesCVD$ NODEPCHK + DO JJ = 1, NBCOL + JJ3 = ICT13 + int(INTARR(J3 + JJ - 1),8) - 1_8 + A(JJ3) = A(JJ3) + DBLARR(AINPUT + JJ - 1) + ENDDO + 255 CONTINUE + IF (KEEP(50).EQ.0) THEN + DO JJ = 1, KEEP(253) + APOS = POSELT + + & int(IJROW-1,8) * int(LDAFS,8) + + & int(LDAFS-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + 260 CONTINUE + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + PDEST = IOLDPS + 6 + KEEP(IXSZ) + DO ISLAVE = 1, NSLAVES + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB, + & NSLAVES, + & NBLIG, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + IERR = -1 + DO WHILE (IERR .EQ.-1) + IF ( KEEP(50) .eq. 0 ) THEN + NBCOL = NFRONT + CALL CMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & IZERO, IDUMMY, + & IW(PDEST), NFRONT, COMM, IERR) + ELSE + NBCOL = NASS1+SHIFT_INDEX+NBLIG + CALL CMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & NSLAVES-ISLAVE, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE), + & IW(PDEST), NFRONT, COMM, IERR) + ENDIF + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + IF (MESSAGE_RECEIVED) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + SHIFT_INDEX + ENDIF + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 300 + IF (IERR .EQ. -3) GOTO 305 + PTRROW = PTRROW + NBLIG + PDEST = PDEST + 1 + ENDDO + IF (NUMSTK.EQ.0) GOTO 500 + ISON = IFSON + DO IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + 2+KEEP(IXSZ)) + ELSE + NROWS = NCOLS + ENDIF + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + IF (KEEP(219).NE.0) THEN + IF(KEEP(50) .EQ. 2) THEN + NFS4FATHER = NCBSON + DO I=0,NCBSON-1 + IF(IW(PTRCOL+I) .GT. NASS1) THEN + NFS4FATHER = I + EXIT + ENDIF + ENDDO + NFS4FATHER = NFS4FATHER+NELIM + ELSE + NFS4FATHER = 0 + ENDIF + ELSE + NFS4FATHER = 0 + ENDIF + IF (NSLSON.EQ.0) THEN + NSLSON = 1 + PDEST1(1) = MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) + IF (PDEST1(1).EQ.MYID) THEN + CALL CMUMPS_211( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)), + & NFRONT, NASS1, NFS4FATHER, NCBSON, + & IW( PTRCOL ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, IW, IW, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ELSE + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON))+HS+NROWS+NPIVS+NELIM + CALL CMUMPS_71( + & INODE, NFRONT,NASS1,NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ) ), + & IW(PTRCOL), NCBSON, + & COMM, IERR, PDEST1, NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ELSE + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL CMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, LPTRAR, NELT, IW, + & IW, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + ENDDO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL CMUMPS_71( + & INODE, NFRONT,NASS1, NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW(PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + ENDDO + GOTO 500 + 250 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING + & CMUMPS_253' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 1 + GOTO 490 + 265 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE ALLOCATING TMP_SLAVES_LIST', + & ' DURING CMUMPS_253' + ENDIF + IFLAG = -13 + IERROR = SIZE_TMP_SLAVES_LIST + GOTO 490 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER ALLOCATION DURING CMUMPS_253' + ENDIF + GOTO 490 + 280 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, WORKSPACE TOO SMALL DURING CMUMPS_253' + ENDIF + IFLAG = -9 + CALL MUMPS_731(LAELL8-LRLUS, IERROR) + GOTO 490 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SEND BUFFER TOO SMALL (1) DURING CMUMPS_253' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECV BUFFER TOO SMALL (1) DURING CMUMPS_253' + ENDIF + IFLAG = -20 + LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SEND BUFFER TOO SMALL (2) DURING CMUMPS_253' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 305 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECV BUFFER TOO SMALL (2) DURING CMUMPS_253' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + 490 CALL CMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE CMUMPS_253 + SUBROUTINE CMUMPS_39(N, INODE, IW, LIW, A, LA, + & ISON, NBROWS, NBCOLS, ROWLIST, + & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER, + & OPASSW, IWPOSCB, MYID, KEEP,KEEP8, IS_ofType5or6, + & LDA_VALSON ) + USE CMUMPS_LOAD + IMPLICIT NONE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA + INTEGER N,LIW,MYID + INTEGER INODE,ISON, IWPOSCB + INTEGER NBROWS, NBCOLS, LDA_VALSON + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER IW(LIW), STEP(N), PIMASTER(KEEP(28)), + & PTLUST_S(KEEP(28)), ROWLIST(NBROWS) + COMPLEX A(LA), VALSON(LDA_VALSON,NBROWS) + DOUBLE PRECISION OPASSW + LOGICAL, INTENT(IN) :: IS_ofType5or6 + INTEGER(8) :: POSELT, POSEL1, APOS, JJ2 + INTEGER HF,HS, NSLAVES, NFRONT, NASS1, + & IOLDPS, ISTCHK, LSTK, NSLSON,NELIM, + & NPIVS,NCOLS,J1,JJ,JJ1,NROWS, + & LDAFS_PERE, IBEG, DIAG + INCLUDE 'mumps_headers.h' + LOGICAL SAME_PROC + INTRINSIC real + IOLDPS = PTLUST_S(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS1 = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + IF (KEEP(50).EQ.0) THEN + LDAFS_PERE = NFRONT + ELSE + IF ( NSLAVES .eq. 0 ) THEN + LDAFS_PERE = NFRONT + ELSE + LDAFS_PERE = NASS1 + ENDIF + ENDIF + HF = 6 + NSLAVES + KEEP(IXSZ) + POSEL1 = POSELT - int(LDAFS_PERE,8) + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + OPASSW = OPASSW + dble(NBROWS*NBCOLS) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LT.IWPOSCB) + IF (SAME_PROC) THEN + NROWS = NCOLS + ELSE + NROWS = IW(ISTCHK+2+KEEP(IXSZ)) + ENDIF + J1 = ISTCHK + NROWS + HS + NPIVS + IF (KEEP(50).EQ.0) THEN + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(LDAFS_PERE,8) + DO JJ = 1, NBROWS + DO JJ1 = 1, NBCOLS + JJ2 = APOS + int(JJ1-1,8) + A(JJ2)=A(JJ2)+VALSON(JJ1,JJ) + ENDDO + APOS = APOS + int(LDAFS_PERE,8) + ENDDO + ELSE + DO 170 JJ = 1, NBROWS + APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8) + DO 160 JJ1 = 1, NBCOLS + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + 160 CONTINUE + 170 CONTINUE + ENDIF + ELSE + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(LDAFS_PERE,8) + DIAG = ROWLIST(1) + DO JJ = 1, NBROWS + DO JJ1 = 1, DIAG + JJ2 = APOS+int(JJ1-1,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + ENDDO + DIAG = DIAG+1 + APOS = APOS + int(LDAFS_PERE,8) + ENDDO + ELSE + DO JJ = 1, NBROWS + IF (ROWLIST(JJ).LE.NASS1.and..NOT.IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(JJ) - 1,8) + DO JJ1 = 1, NELIM + JJ2 = APOS + int(IW(J1+JJ1-1),8)*int(LDAFS_PERE,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + ENDDO + IBEG = NELIM+1 + ELSE + IBEG = 1 + ENDIF + APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8) + DO JJ1 = IBEG, NBCOLS + IF (ROWLIST(JJ).LT.IW(J1 + JJ1 - 1)) EXIT + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + ENDDO + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_39 + SUBROUTINE CMUMPS_539 + & (N, INODE, IW, LIW, A, LA, + & NBROWS, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, + & RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, MYID) + IMPLICIT NONE + INTEGER N,LIW + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER INODE, MYID + INTEGER NBROWS, NBCOLS + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), + & PTRIST(KEEP(28)), FILS(N), PTRARW(N), PTRAIW(N) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX A(LA), + & DBLARR(max(1,KEEP(13))) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER(8) :: POSELT, ICT12, APOS + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & K1,K2,K,J,JPOS,NASS,JJ, + & IN,AINPUT,JK,J1,J2,IJROW, ILOC + INTEGER :: K1RHS, K2RHS, JFirstRHS + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INCLUDE 'mumps_headers.h' + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NASS = IW(IOLDPS+1+KEEP(IXSZ)) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES + KEEP(IXSZ) + IF (NASS.LT.0) THEN + NASS = -NASS + IW(IOLDPS+1+KEEP(IXSZ)) = NASS + A(POSELT:POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8) = + & ZERO + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NASS - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -JPOS + JPOS = JPOS + 1 + ENDDO + K1 = IOLDPS + HF + K2 = K1 + NBROWF - 1 + JPOS = 1 + IF ((KEEP(253).GT.0).AND.(KEEP(50).NE.0)) THEN + K1RHS = 0 + K2RHS = -1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + IF ((K1RHS.EQ.0).AND.(J.GT.N)) THEN + K1RHS = K + JFirstRHS=J-N + ENDIF + JPOS = JPOS + 1 + ENDDO + IF (K1RHS.GT.0) K2RHS=K2 + IF ( K2RHS.GE.K1RHS ) THEN + IN = INODE + DO WHILE (IN.GT.0) + IJROW = -ITLOC(IN) + DO K = K1RHS, K2RHS + J = IW(K) + ILOC = ITLOC(J) + APOS = POSELT+int(ILOC-1,8)*int(NBCOLF,8) + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( + & (JFirstRHS+(K-K1RHS)-1)*KEEP(254)+IN) + ENDDO + IN = FILS(IN) + ENDDO + ENDIF + ELSE + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + JPOS = JPOS + 1 + ENDDO + ENDIF + IN = INODE + DO WHILE (IN.GT.0) + AINPUT = PTRARW(IN) + JK = PTRAIW(IN) + JJ = JK + 1 + J1 = JJ + 1 + J2 = J1 + INTARR(JK) + IJROW = -ITLOC(INTARR(J1)) + ICT12 = POSELT +int(- NBCOLF + IJROW - 1,8) + DO JJ= J1,J2 + ILOC = ITLOC(INTARR(JJ)) + IF (ILOC.GT.0) THEN + APOS = ICT12 + int(ILOC,8)*int(NBCOLF,8) + A(APOS) = A(APOS) + DBLARR(AINPUT) + ENDIF + AINPUT = AINPUT + 1 + ENDDO + IN = FILS(IN) + ENDDO + K1 = IOLDPS + HF + K2 = K1 + NBROWF + NASS - 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = 0 + ENDDO + ENDIF + IF (NBROWS.GT.0) THEN + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + JPOS = JPOS + 1 + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_539 + SUBROUTINE CMUMPS_531 + & (N, INODE, IW, LIW, NBROWS, STEP, PTRIST, + & ITLOC, RHS_MUMPS, KEEP,KEEP8) + IMPLICIT NONE + INTEGER N, LIW + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER INODE + INTEGER NBROWS + INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), + & PTRIST(KEEP(28)) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INCLUDE 'mumps_headers.h' + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & K1,K2,K,J + IOLDPS = PTRIST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + IF (NBROWS.GT.0) THEN + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = 0 + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_531 + SUBROUTINE CMUMPS_40(N, INODE, IW, LIW, A, LA, + & NBROWS, NBCOLS, ROWLIST, COLLIST, VALSON, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, + & RHS_MUMPS, FILS, + & ICNTL, KEEP,KEEP8, MYID, IS_ofType5or6, LDA_VALSON) + IMPLICIT NONE + INTEGER N,LIW + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER INODE, MYID + LOGICAL, intent(in) :: IS_ofType5or6 + INTEGER NBROWS, NBCOLS, LDA_VALSON + INTEGER ROWLIST(NBROWS), COLLIST(NBCOLS) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), + & PTRIST(KEEP(28)), FILS(N) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRAST(KEEP(28)) + COMPLEX A(LA), VALSON(LDA_VALSON,NBROWS) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER(8) :: POSEL1, POSELT, APOS, K8 + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & I,J,NASS,IDIAG + INCLUDE 'mumps_headers.h' + INTRINSIC real + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NASS = IW(IOLDPS+1+KEEP(IXSZ)) + IF ( NBROWS .GT. NBROWF ) THEN + WRITE(*,*) ' ERR: ERROR : NBROWS > NBROWF' + WRITE(*,*) ' ERR: INODE =', INODE + WRITE(*,*) ' ERR: NBROW=',NBROWS,'NBROWF=',NBROWF + WRITE(*,*) ' ERR: ROW_LIST=', ROWLIST + CALL MUMPS_ABORT() + END IF + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + IF (NBROWS.GT.0) THEN + POSEL1 = POSELT - int(NBCOLF,8) + IF (KEEP(50).EQ.0) THEN + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8) + DO I=1, NBROWS + DO J = 1, NBCOLS + A(APOS+int(J-1,8)) = A( APOS+int(J-1,8)) + VALSON(J,I) + ENDDO + APOS = APOS + int(NBCOLF,8) + END DO + ELSE + DO I=1,NBROWS + APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8) + DO J=1,NBCOLS + K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8 + A(K8) = A(K8) + VALSON(J,I) + ENDDO + ENDDO + ENDIF + ELSE + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8) + & + int((NBROWS-1),8)*int(NBCOLF,8) + IDIAG = 0 + DO I=NBROWS,1,-1 + A(APOS:APOS+int(NBCOLS-IDIAG-1,8))= + & A(APOS:APOS+int(NBCOLS-IDIAG-1,8)) + + & VALSON(1:NBCOLS-IDIAG,I) + APOS = APOS - int(NBCOLF,8) + IDIAG = IDIAG + 1 + ENDDO + ELSE + DO I=1,NBROWS + APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8) + DO J=1,NBCOLS + IF (ITLOC(COLLIST(J)) .EQ. 0) THEN + write(6,*) ' .. exit for col =', J + EXIT + ENDIF + K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8 + A(K8) = A(K8) + VALSON(J,I) + ENDDO + ENDDO + ENDIF + ENDIF + OPASSW = OPASSW + dble(NBROWS*NBCOLS) + ENDIF + RETURN + END SUBROUTINE CMUMPS_40 + SUBROUTINE CMUMPS_178( A, LA, + & IAFATH, NFRONT, NASS1, + & IACB, NCOLS, LCB, + & IW, NROWS, NELIM, ETATASS, + & CB_IS_COMPRESSED, IS_INPLACE + & ) + IMPLICIT NONE + INTEGER NFRONT, NASS1 + INTEGER(8) :: LA + INTEGER NCOLS, NROWS, NELIM + INTEGER(8) :: LCB + COMPLEX A( LA ) + INTEGER(8) :: IAFATH, IACB + INTEGER IW( NCOLS ) + INTEGER ETATASS + LOGICAL CB_IS_COMPRESSED, IS_INPLACE + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS, + & RISK_OF_SAME_POS_THIS_LINE, OMP_FLAG + INTEGER I, J + INTEGER(8) :: APOS, POSELT + INTEGER(8) :: IPOSCB, IBEGCBROW, IENDFRONT + IENDFRONT = IAFATH+int(NFRONT,8)*int(NFRONT,8)-1_8 + IF ( IS_INPLACE ) THEN + IPOSCB=1_8 + RESET_TO_ZERO = IACB .LT. IENDFRONT + 1_8 + RISK_OF_SAME_POS = IACB + LCB .EQ. IENDFRONT + 1_8 + RISK_OF_SAME_POS_THIS_LINE = .FALSE. + DO I=1, NROWS + POSELT = int(IW(I)-1,8) * int(NFRONT,8) + IF (.NOT. CB_IS_COMPRESSED ) THEN + IPOSCB = 1_8 + int(I - 1,8) * int(NCOLS,8) + IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN + RESET_TO_ZERO = .FALSE. + ENDIF + ENDIF + IF ( RISK_OF_SAME_POS ) THEN + IF (I.EQ.NROWS .OR. .NOT. CB_IS_COMPRESSED) THEN + IF ( IAFATH + POSELT + int(IW(I)-1,8) .EQ. + & IACB+IPOSCB+int(I-1-1,8)) THEN + RISK_OF_SAME_POS_THIS_LINE = .TRUE. + ENDIF + ENDIF + ENDIF + IF (RESET_TO_ZERO) THEN + IF ( RISK_OF_SAME_POS_THIS_LINE ) THEN + DO J=1, I + APOS = POSELT + int(IW( J ),8) + IF (IAFATH + APOS - 1_8.NE. IACB+IPOSCB-1_8) THEN + A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) + A(IACB+IPOSCB-1_8) = ZERO + ENDIF + IPOSCB = IPOSCB + 1_8 + ENDDO + ELSE + DO J=1, I + APOS = POSELT + int(IW( J ),8) + A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) + A(IACB+IPOSCB-1_8) = ZERO + IPOSCB = IPOSCB + 1_8 + ENDDO + ENDIF + ELSE + DO J=1, I + APOS = POSELT + int(IW( J ),8) + A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + ENDDO + ENDIF + IF (.NOT. CB_IS_COMPRESSED ) THEN + IBEGCBROW = IACB+IPOSCB-1_8 + IF ( IBEGCBROW .LE. IENDFRONT ) THEN + A(IBEGCBROW:IBEGCBROW+int(NCOLS-I,8)-1_8)=ZERO + ENDIF + ENDIF + IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN + RESET_TO_ZERO = .FALSE. + ENDIF + ENDDO + RETURN + ENDIF + IF ((ETATASS.EQ.0) .OR. (ETATASS.EQ.1)) THEN + IPOSCB = 1_8 + DO I = 1, NELIM + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + IF (.NOT. CB_IS_COMPRESSED) THEN + IPOSCB = 1_8 + int( I - 1, 8 ) * int(NCOLS,8) + ENDIF + DO J = 1, I + APOS = POSELT + int(IW( J ),8) + A(IAFATH+ APOS -1_8) = A(IAFATH+ APOS -1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + END DO + ENDIF + IF ((ETATASS.EQ.0).OR.(ETATASS.EQ.1)) THEN + OMP_FLAG = (NROWS-NELIM).GE.300 + DO I = NELIM + 1, NROWS + IF (CB_IS_COMPRESSED) THEN + IPOSCB = (int(I,8) * int(I-1,8)) / 2_8 + 1_8 + ELSE + IPOSCB = int(I-1,8) * int(NCOLS,8) + 1_8 + ENDIF + POSELT = int(IW( I ),8) + IF (POSELT.LE. int(NASS1,8) .AND. .NOT. IS_INPLACE) THEN + DO J = 1, NELIM + APOS = POSELT + int( IW( J ) - 1, 8 ) * int(NFRONT,8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + + & A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + ELSE + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J = 1, NELIM + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + ENDIF + IF (ETATASS.EQ.1) THEN + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J = NELIM + 1, I + IF (IW(J).GT.NASS1) EXIT + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB +1_8 + END DO + ELSE + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J = NELIM + 1, I + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + ENDIF + END DO + ELSE + DO I= NROWS, NELIM+1, -1 + IF (CB_IS_COMPRESSED) THEN + IPOSCB = (int(I,8)*int(I+1,8))/2_8 + ELSE + IPOSCB = int(I-1,8) * int(NCOLS,8) + int(I,8) + ENDIF + POSELT = int(IW( I ),8) + IF (POSELT.LE.int(NASS1,8)) EXIT + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J=I,NELIM+1, -1 + IF (IW(J).LE.NASS1) EXIT + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB - 1_8 + ENDDO + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_178 + SUBROUTINE CMUMPS_530(N, ISON, INODE, IWPOSCB, + & PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8) + IMPLICIT NONE + INTEGER N, ISON, INODE, IWPOSCB + INTEGER KEEP(500), STEP(N) + INTEGER(8) KEEP8(150) + INTEGER PIMASTER(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER LIW + INTEGER IW(LIW) + INTEGER ISTCHK, LSTK, NSLSON, HS, NROWS, NCOLS, NPIVS, NELIM + INTEGER IOLDPS, NFRONT, NSLAVES, ICT11, HF + INTEGER J1, J2, J3, JJ, JPOS + LOGICAL SAME_PROC + INCLUDE 'mumps_headers.h' + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + NCOLS = NPIVS + LSTK + IF ( NPIVS < 0 ) NPIVS = 0 + SAME_PROC = ISTCHK < IWPOSCB + IF (SAME_PROC) THEN + NROWS = NCOLS + ELSE + NROWS = IW(ISTCHK+2+KEEP(IXSZ)) + ENDIF + J1 = ISTCHK + NROWS + HS + NPIVS + IF (KEEP(50).NE.0) THEN + J2 = J1 + LSTK - 1 + DO JJ = J1, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + ELSE + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM + DO JJ = J3, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + IF (NELIM .NE. 0) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + ICT11 = IOLDPS + HF - 1 + NFRONT + J3 = J3 - 1 + DO 190 JJ = J1, J3 + JPOS = IW(JJ) + ICT11 + IW(JJ) = IW(JPOS) + 190 CONTINUE + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_530 + SUBROUTINE CMUMPS_619( + & N, INODE, IW, LIW, A, LA, + & ISON, NBCOLS, + & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER, + & OPASSW, IWPOSCB,MYID, KEEP,KEEP8 ) + USE CMUMPS_LOAD + IMPLICIT NONE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA + INTEGER N,LIW,MYID + INTEGER INODE,ISON,IWPOSCB + INTEGER NBCOLS + INTEGER IW(LIW), STEP(N), + & PIMASTER(KEEP(28)), + & PTLUST_S(KEEP(28)) + INTEGER(8) PTRAST(KEEP(28)) + COMPLEX A(LA) + REAL VALSON(NBCOLS) + DOUBLE PRECISION OPASSW + INTEGER HF,HS, NSLAVES, NASS1, + & IOLDPS, ISTCHK, + & LSTK, NSLSON,NELIM,NPIVS,NCOLS, J1, + & JJ1,NROWS + INTEGER(8) POSELT, APOS, JJ2 + INCLUDE 'mumps_headers.h' + LOGICAL SAME_PROC + INTRINSIC real + IOLDPS = PTLUST_S(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NASS1 = iabs(IW(IOLDPS + 2 + KEEP(IXSZ))) + NSLAVES= IW(IOLDPS+5 + KEEP(IXSZ)) + HF = 6 + NSLAVES + KEEP(IXSZ) + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NELIM = IW(ISTCHK + 1 + KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LT.IWPOSCB) + IF (SAME_PROC) THEN + NROWS = NCOLS + ELSE + NROWS = IW(ISTCHK+2 + KEEP(IXSZ)) + ENDIF + J1 = ISTCHK + NROWS + HS + NPIVS + APOS = POSELT + int(NASS1,8)*int(NASS1,8) - 1_8 + DO JJ1 = 1, NBCOLS + JJ2 = APOS+int(IW(J1 + JJ1 - 1),8) + IF(abs(A(JJ2)) .LT. VALSON(JJ1)) + & A(JJ2) = cmplx(VALSON(JJ1),kind=kind(A)) + ENDDO + RETURN + END SUBROUTINE CMUMPS_619 + RECURSIVE SUBROUTINE CMUMPS_264( + & COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE CMUMPS_OOC + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mumps_headers.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER(8) :: POSFAC + INTEGER COMP + INTEGER IFLAG, IERROR, NBFIN, MSGSOU + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER NBPROCFILS( KEEP(28) ), STEP(N), + & PIMASTER(KEEP(28)) + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER COMM, MYID + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER PTLUST_S(KEEP(28)), + & ITLOC(N+KEEP(253)), FILS(N), ND(KEEP(28)) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER FRERE_STEPS(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION FLOP1 + COMPLEX DBLARR(max(1,KEEP(13))) + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER INODE, POSITION, NPIV, IERR, LP + INTEGER NCOL + INTEGER(8) :: POSBLOCFACTO + INTEGER(8) :: LAELL + INTEGER(8) :: POSELT + INTEGER IOLDPS, LCONT1, NASS1, NROW1, NCOL1, NPIV1 + INTEGER NSLAV1, HS, ISW + INTEGER (8) :: LPOS, LPOS1, LPOS2, IPOS, KPOS + INTEGER ICT11 + INTEGER I, IPIV, FPERE + LOGICAL LASTBL + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + COMPLEX ONE,ALPHA + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, NextPivDummy + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + FPERE = -1 + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, + & MPI_INTEGER, COMM, IERR ) + LASTBL = (NPIV.LE.0) + IF (LASTBL) THEN + NPIV = -NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, + & MPI_INTEGER, COMM, IERR ) + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOL, 1, + & MPI_INTEGER, COMM, IERR ) + LAELL = int(NPIV,8) * int(NCOL,8) + IF ( LRLU .LT. LAELL .OR. IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LAELL ) THEN + IFLAG = -9 + CALL MUMPS_731(LAELL - LRLUS, IERROR) + IF (ICNTL(1).GT.0 .AND. ICNTL(4).GE.1) THEN + LP=ICNTL(1) + WRITE(LP,*) + &" FAILURE, WORKSPACE TOO SMALL DURING CMUMPS_264" + ENDIF + GOTO 700 + END IF + CALL CMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS=' + & ,LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731( LAELL-LRLUS, IERROR ) + GOTO 700 + END IF + IF ( IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF (ICNTL(1).GT.0 .AND. ICNTL(4).GE.1) THEN + LP=ICNTL(1) + WRITE(LP,*) + &" FAILURE IN INTEGER ALLOCATION DURING CMUMPS_264" + ENDIF + IFLAG = -8 + IERROR = IWPOS + NPIV - 1 - IWPOSCB + GOTO 700 + END IF + END IF + LRLU = LRLU - LAELL + LRLUS = LRLUS - LAELL + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSBLOCFACTO = POSFAC + POSFAC = POSFAC + LAELL + CALL CMUMPS_471(.FALSE., .FALSE., + & LA-LRLUS,0_8,LAELL,KEEP,KEEP8,LRLU) + IPIV = IWPOS + IWPOS = IWPOS + NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IPIV ), NPIV, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSBLOCFACTO), NPIV*NCOL, + & MPI_COMPLEX, + & COMM, IERR ) + IF (PTRIST(STEP( INODE )) .EQ. 0) THEN + DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 ) + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. + & ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + ENDIF + DO WHILE ( NBPROCFILS( STEP(INODE)) .NE. 0 ) + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, CONTRIB_TYPE2, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .TRUE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + LCONT1 = IW( IOLDPS +KEEP(IXSZ)) + NASS1 = IW( IOLDPS + 1 +KEEP(IXSZ)) + NROW1 = IW( IOLDPS + 2 +KEEP(IXSZ)) + NPIV1 = IW( IOLDPS + 3 +KEEP(IXSZ)) + NSLAV1 = IW( IOLDPS + 5 +KEEP(IXSZ)) + HS = 6 + NSLAV1 + KEEP(IXSZ) + NCOL1 = LCONT1 + NPIV1 + IF (NPIV.GT.0) THEN + ICT11 = IOLDPS+HS+NROW1+NPIV1 - 1 + DO I = 1, NPIV + IF (IW(IPIV+I-1).EQ.I) CYCLE + ISW = IW(ICT11+I) + IW(ICT11+I) = IW(ICT11+IW(IPIV+I-1)) + IW(ICT11+IW(IPIV+I-1)) = ISW + IPOS = POSELT + int(NPIV1 + I - 1,8) + KPOS = POSELT + int(NPIV1 + IW(IPIV+I-1) - 1,8) + CALL cswap(NROW1, A(IPOS), NCOL1, A(KPOS), NCOL1) + ENDDO + LPOS2 = POSELT + int(NPIV1,8) + CALL ctrsm('L','L','N','N',NPIV, NROW1, ONE, + & A(POSBLOCFACTO), NCOL, A(LPOS2), NCOL1) + LPOS1 = POSBLOCFACTO+int(NPIV,8) + LPOS = LPOS2 + int(NPIV,8) + ENDIF + IF (KEEP(201).eq.1) THEN + MonBloc%INODE = INODE + MonBloc%MASTER = .FALSE. + MonBloc%Typenode = 2 + MonBloc%NROW = NROW1 + MonBloc%NCOL = NCOL1 + MonBloc%NFS = NASS1 + MonBloc%LastPiv = NPIV1 + NPIV + NULLIFY(MonBloc%INDICES) + MonBloc%Last = LASTBL + STRAT = STRAT_TRY_WRITE + NextPivDummy = -8888 + LIWFAC = IW(IOLDPS+XXI) + CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR)) + LAST_CALL = .FALSE. + CALL CMUMPS_688( STRAT, TYPEF_L, A(POSELT), + & LAFAC, MonBloc, NextPivDummy, NextPivDummy, + & IW(IOLDPS), LIWFAC, MYID, KEEP8(31), IFLAG,LAST_CALL) + ENDIF + IF ( NPIV .GT. 0 ) THEN + CALL cgemm('N','N', NCOL-NPIV,NROW1,NPIV, + & ALPHA,A(LPOS1),NCOL, + & A(LPOS2),NCOL1,ONE, A(LPOS),NCOL1) + ENDIF + IW(IOLDPS+KEEP(IXSZ) ) = IW(IOLDPS+KEEP(IXSZ) ) - NPIV + IW(IOLDPS + 3+KEEP(IXSZ) ) = IW(IOLDPS+3+KEEP(IXSZ) ) + NPIV + IF (LASTBL) IW(IOLDPS+1+KEEP(IXSZ) ) = IW(IOLDPS + 3+KEEP(IXSZ) ) + IF ( .not. LASTBL .AND. + & (IW(IOLDPS+1+KEEP(IXSZ)) .EQ. IW(IOLDPS + 3+KEEP(IXSZ))) ) THEN + write(*,*) ' ERROR 1 **** IN BLACFACTO ' + CALL MUMPS_ABORT() + ENDIF + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + IWPOS = IWPOS - NPIV + FLOP1 = dble( NPIV1*NROW1 ) + + & dble(NROW1*NPIV1)*dble(2*NCOL1-NPIV1-1) + & - + & dble((NPIV1+NPIV)*NROW1 ) - + & dble(NROW1*(NPIV1+NPIV))*dble(2*NCOL1-NPIV1-NPIV-1) + CALL CMUMPS_190( 1, .FALSE., FLOP1, KEEP,KEEP8 ) + IF (LASTBL) THEN + CALL CMUMPS_759( + & COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ENDIF + 600 CONTINUE + RETURN + 700 CONTINUE + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE CMUMPS_264 + SUBROUTINE CMUMPS_699( COMM_LOAD, ASS_IRECV, + & MSGLEN, BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC, + & N, IW, LIW, A, LA, PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, NBPROCFILS, + & COMP, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, NSTK_S, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, NBFIN, + & MYID, COMM, ICNTL, KEEP,KEEP8, IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, LPTRAR, NELT, + & FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE CMUMPS_LOAD + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV, MSGLEN + INTEGER BUFR( LBUFR ) + INTEGER(8) :: LRLU, IPTRLU, LRLUS, LA, POSFAC + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER NBFIN + INTEGER COMP + INTEGER NELT, LPTRAR + INTEGER PROCNODE_STEPS( KEEP(28) ), PTRIST(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER PTLUST_S( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER ITLOC( N + KEEP(253)), NSTK_S( KEEP(28) ), FILS( N ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER ND(KEEP(28)), FRERE_STEPS( KEEP(28) ) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX DBLARR( max( 1,KEEP(13)) ) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER COMM, MYID, IFLAG, IERROR + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER FRTPTR(N+1), FRTELT( NELT ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER NFS4FATHER + INCLUDE 'mumps_headers.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER MUMPS_275, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_810 + INTEGER IERR + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INTEGER I, INODE, ISON, POSITION, NBROW, LROW, IROW, INDCOL + INTEGER LREQI + INTEGER(8) :: LREQA, POSCONTRIB + INTEGER ROW_LENGTH + INTEGER MASTER + INTEGER ISTCHK + LOGICAL SAME_PROC + LOGICAL SLAVE_NODE + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED, IS_ofType5or6 + INTEGER ISHIFT_BUFR, LBUFR_LOC, LBUFR_BYTES_LOC + INTEGER TYPESPLIT + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, ISON, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NBROW, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, LROW, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, + & MPI_INTEGER, COMM, IERR ) + MASTER = MUMPS_275(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + SLAVE_NODE = MASTER .NE. MYID + TYPESPLIT = MUMPS_810(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IS_ofType5or6 = ((TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) + IF (SLAVE_NODE .AND. PTRIST(STEP(INODE)) ==0) THEN + ISHIFT_BUFR = ( MSGLEN + KEEP(34) ) / KEEP(34) + LBUFR_LOC = LBUFR - ISHIFT_BUFR + 1 + LBUFR_BYTES_LOC = LBUFR_LOC * KEEP(34) + DO WHILE ( PTRIST( STEP(INODE) ) .EQ. 0 ) + MASTER = MUMPS_275(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MASTER, MAITRE_DESC_BANDE, + & STATUS, + & BUFR(ISHIFT_BUFR), LBUFR_LOC, LBUFR_BYTES_LOC, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF (IFLAG.LT.0) RETURN + END DO + ENDIF + IF ( SLAVE_NODE ) THEN + LREQI = LROW + NBROWS_PACKET + ELSE + LREQI = NBROWS_PACKET + END IF + LREQA = int(LROW,8) + IF ( LRLU .LT. LREQA .OR. IWPOS + LREQI + & - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LREQA ) THEN + IFLAG = -9 + CALL MUMPS_731( LREQA - LRLUS, IERROR ) + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END IF + CALL CMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..process_contrib' + WRITE(*,*) 'LRLU,LRLUS=',LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731( LREQA - LRLUS, IERROR ) + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END IF + IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END IF + END IF + LRLU = LRLU - LREQA + LRLUS = LRLUS - LREQA + POSCONTRIB = POSFAC + POSFAC = POSFAC + LREQA + KEEP8(67) = min(LRLUS, KEEP8(67)) + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU) + IF ( SLAVE_NODE ) THEN + IROW = IWPOS + INDCOL = IWPOS + NBROWS_PACKET + ELSE + IROW = IWPOS + INDCOL = -1 + END IF + IWPOS = IWPOS + LREQI + IF ( SLAVE_NODE ) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( INDCOL ), LROW, MPI_INTEGER, + & COMM, IERR ) + END IF + DO I = 1, NBROWS_PACKET + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IROW + I - 1 ), 1, MPI_INTEGER, + & COMM, IERR ) + END DO + IF ( SLAVE_NODE ) THEN + IF ( NBROWS_ALREADY_SENT + NBROWS_PACKET == NBROW ) THEN + NBPROCFILS(STEP(INODE))=NBPROCFILS(STEP(INODE))-1 + ENDIF + IF ( KEEP(55) .eq. 0 ) THEN + CALL CMUMPS_539 + & (N, INODE, IW, LIW, A, LA, + & NBROW, LROW, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, MYID ) + ELSE + CALL CMUMPS_123( + & NELT, FRTPTR, FRTELT, + & N, INODE, IW, LIW, A, LA, + & NBROW, LROW, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, MYID ) + ENDIF + DO I=1,NBROWS_PACKET + IF(KEEP(50).NE.0)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & ROW_LENGTH, + & 1, + & MPI_INTEGER, + & COMM, IERR ) + ELSE + ROW_LENGTH=LROW + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSCONTRIB), + & ROW_LENGTH, + & MPI_COMPLEX, + & COMM, IERR ) + CALL CMUMPS_40(N, INODE, IW, LIW, A, LA, + & 1, ROW_LENGTH, IW( IROW+I-1 ),IW(INDCOL), + & A(POSCONTRIB), + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, ICNTL, KEEP,KEEP8, MYID, IS_ofType5or6, + & ROW_LENGTH ) + ENDDO + CALL CMUMPS_531 + & (N, INODE, IW, LIW, + & NBROWS_PACKET, STEP, PTRIST, + & ITLOC, RHS_MUMPS,KEEP,KEEP8) + ELSE + DO I=1,NBROWS_PACKET + IF(KEEP(50).NE.0)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & ROW_LENGTH, + & 1, + & MPI_INTEGER, + & COMM, IERR ) + ELSE + ROW_LENGTH=LROW + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSCONTRIB), + & ROW_LENGTH, + & MPI_COMPLEX, + & COMM, IERR ) + CALL CMUMPS_39(N, INODE, IW, LIW, A, LA, + & ISON, 1, ROW_LENGTH, IW( IROW +I-1 ), + & A(POSCONTRIB), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, ROW_LENGTH + &) + ENDDO + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + IF (KEEP(219).NE.0) THEN + IF(KEEP(50) .EQ. 2) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NFS4FATHER, + & 1, + & MPI_INTEGER, + & COMM, IERR ) + IF(NFS4FATHER .GT. 0) THEN + CALL CMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE. 0) THEN + IERROR = BUF_LMAX_ARRAY + IFLAG = -13 + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & BUF_MAX_ARRAY, + & NFS4FATHER, + & MPI_REAL, + & COMM, IERR ) + CALL CMUMPS_619(N, INODE, IW, LIW, A, LA, + & ISON, NFS4FATHER, + & BUF_MAX_ARRAY, PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8) + ENDIF + ENDIF + ENDIF + ENDIF + IF (NBROWS_ALREADY_SENT + NBROWS_PACKET == NBROW ) THEN + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE)) - 1 + NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - 1 + IF ( NBPROCFILS(STEP(ISON)) .EQ. 0) THEN + ISTCHK = PIMASTER(STEP(ISON)) + SAME_PROC= ISTCHK .LT. IWPOSCB + IF (SAME_PROC) THEN + CALL CMUMPS_530(N, ISON, INODE, IWPOSCB, + & PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8) + ENDIF + IF (SAME_PROC) THEN + ISTCHK = PTRIST(STEP(ISON)) + PTRIST(STEP( ISON) ) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL CMUMPS_152(.FALSE., MYID, N, ISTCHK, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, IWPOSCB, + & LA, KEEP,KEEP8, .FALSE. + & ) + ENDIF + IF ( NBPROCFILS(STEP(INODE)) .EQ. 0 ) THEN + CALL CMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), + & KEEP(47), STEP, INODE+N ) + IF (KEEP(47) .GE. 3) THEN + CALL CMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + ENDIF + ENDIF + END IF + IWPOS = IWPOS - LREQI + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + POSFAC = POSFAC - LREQA + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU) + RETURN + END SUBROUTINE CMUMPS_699 + SUBROUTINE CMUMPS_143( N, INODE, IW, LIW, A, LA, + & IOLDPS, POSELT, IFLAG, UU, NOFFW, + & NPVW, + & KEEP,KEEP8, STEP, + & PROCNODE_STEPS, MYID, SLAVEF, SEUIL, + & AVOID_DELAYED, ETATASS, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & IWPOS ) + USE CMUMPS_OOC + IMPLICIT NONE + INTEGER(8) :: LA, POSELT + INTEGER N, INODE, LIW, IFLAG, NOFFW, NPVW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER MYID, SLAVEF, IOLDPS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS( KEEP(28) ), STEP(N) + REAL UU, SEUIL + LOGICAL AVOID_DELAYED + INTEGER ETATASS, IWPOS + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER INOPV, IFINB, NFRONT, NPIV, IBEG_BLOCK + INTEGER NASS, NEL1, NPIVB, NPIVE, NBOLKJ, NBTLKJ + REAL UUTEMP + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, LNextPiv2beWritten, + & UNextPiv2beWritten, IFLAG_OOC, + & PP_FIRST2SWAP_L, PP_FIRST2SWAP_U, + & PP_LastPIVRPTRFilled_L, + & PP_LastPIVRPTRFilled_U + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INCLUDE 'mumps_headers.h' + EXTERNAL MUMPS_330, CMUMPS_221, CMUMPS_233, + & CMUMPS_229, + & CMUMPS_225, CMUMPS_232, CMUMPS_231, + & CMUMPS_220, + & CMUMPS_228, CMUMPS_236 + INTEGER MUMPS_330 + LOGICAL STATICMODE + REAL SEUIL_LOC + INOPV = 0 + SEUIL_LOC = SEUIL + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + UUTEMP=UU + ENDIF + IBEG_BLOCK=1 + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5), NASS ) + ENDIF + NBTLKJ = NBOLKJ + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_BOTH_LU + LNextPiv2beWritten = 1 + UNextPiv2beWritten = 1 + PP_FIRST2SWAP_L = LNextPiv2beWritten + PP_FIRST2SWAP_U = UNextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + MonBloc%LastPanelWritten_U = 0 + PP_LastPIVRPTRFilled_L = 0 + PP_LastPIVRPTRFilled_U = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 1 + MonBloc%NROW = NFRONT + MonBloc%NCOL = NFRONT + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -88877 + NULLIFY(MonBloc%INDICES) + ENDIF + 50 CONTINUE + CALL CMUMPS_221(NFRONT,NASS,N,INODE,IW,LIW,A,LA,INOPV,NOFFW, + & IFLAG,IOLDPS,POSELT,UU,SEUIL_LOC,KEEP,KEEP8, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U, + & PP_LastPIVRPTRFilled_U) + IF (IFLAG.LT.0) GOTO 500 + IF (INOPV.EQ.1) THEN + IF(STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + GOTO 80 + ENDIF + IF (INOPV.EQ.2) THEN + CALL CMUMPS_233(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,NBOLKJ, NBTLKJ,KEEP(4),KEEP(IXSZ)) + GOTO 50 + ENDIF + NPVW = NPVW + 1 + IF (NASS.LE.1) THEN + CALL CMUMPS_229(NFRONT,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,KEEP(IXSZ)) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + GO TO 500 + ENDIF + CALL CMUMPS_225(IBEG_BLOCK,NFRONT, NASS, N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB, + & NBTLKJ,KEEP(4),KEEP(IXSZ)) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + IF (IFINB.EQ.0) GOTO 50 + IF (KEEP(201).EQ.1) THEN + MonBloc%LastPiv= IW(IOLDPS+1+KEEP(IXSZ)) + STRAT = STRAT_TRY_WRITE + TYPEFile = TYPEF_U + LAST_CALL = .FALSE. + CALL CMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + ENDIF + IF (IFINB.EQ.(-1)) GOTO 80 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NEL1 = NASS - NPIV + CALL CMUMPS_232(A,LA, + & NFRONT,NPIV,NASS,POSELT,NBTLKJ) + GO TO 50 + 80 CONTINUE + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + IF (NPIV.LE.0) GO TO 110 + NEL1 = NFRONT - NASS + IF (NEL1.LE.0) GO TO 110 + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_TRY_WRITE + TYPEFile = TYPEF_BOTH_LU + MonBloc%LastPiv= NPIV + CALL CMUMPS_642(A(POSELT), LAFAC, NFRONT, + & NPIV, NASS, IW(IOLDPS), LIWFAC, + & MonBloc, TYPEFile, MYID, KEEP8, + & STRAT, IFLAG_OOC, + & LNextPiv2beWritten, UNextPiv2beWritten) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + ELSE + CALL CMUMPS_231(A,LA,NFRONT, NPIV,NASS,POSELT) + ENDIF + 110 CONTINUE + IF (MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + & .EQ.1) THEN + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + IBEG_BLOCK = NPIV + IF (NASS.EQ.NPIV) GOTO 500 + 120 CALL CMUMPS_220(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IOLDPS,POSELT,UU,SEUIL, + & KEEP, DKEEP, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U, + & PP_LastPIVRPTRFilled_U) + IF (INOPV.NE.1) THEN + NPVW = NPVW + 1 + CALL CMUMPS_228(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB,KEEP(IXSZ)) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + IF (IFINB.EQ.0) GOTO 120 + ENDIF + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NPIVB = IBEG_BLOCK + NPIVE = NPIV - NPIVB + NEL1 = NFRONT - NASS + IF ((NPIVE.LE.0).OR.(NEL1.EQ.0)) GO TO 500 + CALL CMUMPS_236(A,LA,NPIVB, + & NFRONT,NPIV,NASS,POSELT) + ENDIF + 500 CONTINUE + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + TYPEFile = TYPEF_BOTH_LU + LAST_CALL = .TRUE. + CALL CMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC, LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + CALL CMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + RETURN + END SUBROUTINE CMUMPS_143 + RECURSIVE SUBROUTINE CMUMPS_322( + & COMM_LOAD, ASS_IRECV, + & MSGSOU, MSGTAG, MSGLEN, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mumps_headers.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER MSGSOU, MSGTAG, MSGLEN + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER KEEP(500), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX DBLARR( max(1,KEEP(13)) ) + INTEGER INIV2, ISHIFT, IBEG + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + LOGICAL FLAG + INTEGER MP, LP + INTEGER TMP( 2 ) + INTEGER NBRECU, POSITION, INODE, ISON, IROOT + INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE, + & LMAP, FPERE, NELIM, + & HDMAPLIG,NFS4FATHER, + & TOT_ROOT_SIZE, TOT_CONT_TO_RECV + DOUBLE PRECISION FLOP1 + INCLUDE 'mumps_tags.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + CHARACTER(LEN=35)::SUBNAME + MP = ICNTL(2) + LP = ICNTL(1) + SUBNAME="??????" + CALL CMUMPS_467(COMM_LOAD, KEEP) + IF ( MSGTAG .EQ. RACINE ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NBRECU, + & 1, MPI_INTEGER, COMM, IERR) + NBRECU = BUFR( 1 ) + NBFIN = NBFIN - NBRECU + ELSEIF ( MSGTAG .EQ. NOEUD ) THEN + CALL CMUMPS_269( MYID,KEEP,KEEP8, + & BUFR, LBUFR, LBUFR_BYTES, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, FPERE, FLAG, IFLAG, IERROR, COMM, + & ITLOC, RHS_MUMPS ) + SUBNAME="CMUMPS_269" + IF ( IFLAG .LT. 0 ) GO TO 500 + IF ( FLAG ) THEN + CALL CMUMPS_507(N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), STEP, FPERE ) + IF (KEEP(47) .GE. 3) THEN + CALL CMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + CALL MUMPS_137( FPERE, N, + & PROCNODE_STEPS,SLAVEF, + & ND, FILS, FRERE, STEP, PIMASTER, + & KEEP(28), KEEP(50), KEEP(253), FLOP1, + & IW, LIW, KEEP(IXSZ) ) + IF (FPERE.NE.KEEP(20)) + & CALL CMUMPS_190(1,.FALSE.,FLOP1,KEEP,KEEP8) + ENDIF + ELSEIF ( MSGTAG .EQ. END_NIV2_LDLT ) THEN + INODE = BUFR( 1 ) + CALL CMUMPS_507(N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), + & STEP, -INODE ) + IF (KEEP(47) .GE. 3) THEN + CALL CMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + ELSEIF ( MSGTAG .EQ. TERREUR ) THEN + IFLAG = -001 + IERROR = MSGSOU + GOTO 100 + ELSEIF ( MSGTAG .EQ. MAITRE_DESC_BANDE ) THEN + CALL CMUMPS_266( MYID,BUFR, LBUFR, + & LBUFR_BYTES, IWPOS, + & IWPOSCB, + & IPTRLU, LRLU, LRLUS, NBPROCFILS, + & N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP, + & KEEP,KEEP8, ITLOC, RHS_MUMPS, + & IFLAG, IERROR ) + SUBNAME="CMUMPS_266" + IF ( IFLAG .LT. 0 ) GO to 500 + ELSEIF ( MSGTAG .EQ. MAITRE2 ) THEN + CALL CMUMPS_268(MYID,BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, SLAVEF, IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & KEEP,KEEP8, ND, FILS, FRERE, ITLOC, RHS_MUMPS, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + SUBNAME="CMUMPS_268" + IF ( IFLAG .LT. 0 ) GO to 500 + ELSEIF ( MSGTAG .EQ. BLOC_FACTO ) THEN + CALL CMUMPS_264( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM , IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSEIF ( MSGTAG .EQ. BLOC_FACTO_SYM_SLAVE ) THEN + CALL CMUMPS_263( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSEIF ( MSGTAG .EQ. BLOC_FACTO_SYM ) THEN + CALL CMUMPS_274( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSEIF ( MSGTAG .EQ. CONTRIB_TYPE2 ) THEN + CALL CMUMPS_699( COMM_LOAD, ASS_IRECV, + & MSGLEN, BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC, + & N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, NBPROCFILS, COMP, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, NSTK_S, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, NBFIN, MYID, COMM, + & ICNTL, KEEP,KEEP8, IFLAG, IERROR, IPOOL, LPOOL, LEAF, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GO TO 100 + ELSEIF ( MSGTAG .EQ. MAPLIG ) THEN + HDMAPLIG = 7 + INODE = BUFR( 1 ) + ISON = BUFR( 2 ) + NSLAVES_PERE = BUFR( 3 ) + NFRONT_PERE = BUFR( 4 ) + NASS_PERE = BUFR( 5 ) + LMAP = BUFR( 6 ) + NFS4FATHER = BUFR(7) + IF ( (NSLAVES_PERE.NE.0).AND.(KEEP(48).NE.0) ) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + ISHIFT = NSLAVES_PERE+1 + TAB_POS_IN_PERE(1:NSLAVES_PERE+1, INIV2) = + & BUFR(HDMAPLIG+1:HDMAPLIG+1+NSLAVES_PERE) + TAB_POS_IN_PERE(SLAVEF+2, INIV2) = NSLAVES_PERE + ELSE + ISHIFT = 0 + ENDIF + IBEG = HDMAPLIG+1+ISHIFT + CALL CMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES_PERE, + & BUFR(IBEG), + & NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP, + & BUFR(IBEG+NSLAVES_PERE), + & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GO TO 100 + ELSE IF ( MSGTAG .EQ. ROOT_CONT_STATIC ) THEN + CALL CMUMPS_700( + & BUFR, LBUFR, LBUFR_BYTES, + & root, N, IW, LIW, A, LA, NBPROCFILS, + & LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, + & COMP, LRLUS, IPOOL, LPOOL, LEAF, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, + & ITLOC, RHS_MUMPS, + & ND, PROCNODE_STEPS, SLAVEF) + SUBNAME="CMUMPS_700" + IF ( IFLAG .LT. 0 ) GO TO 500 + ELSE IF ( MSGTAG .EQ. ROOT_NON_ELIM_CB ) THEN + IROOT = KEEP( 38 ) + MSGSOU = MUMPS_275( PROCNODE_STEPS(STEP(IROOT)), + & SLAVEF ) + IF ( PTLUST_S( STEP(IROOT)) .EQ. 0 ) THEN + CALL MPI_RECV( TMP, 2 * KEEP(34), MPI_PACKED, + & MSGSOU, ROOT_2SLAVE, + & COMM, STATUS, IERR ) + CALL CMUMPS_270( TMP( 1 ), TMP( 2 ), + & root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND ) + SUBNAME="CMUMPS_270" + IF ( IFLAG .LT. 0 ) GOTO 500 + END IF + CALL CMUMPS_700( + & BUFR, LBUFR, LBUFR_BYTES, + & root, N, IW, LIW, A, LA, NBPROCFILS, + & LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, + & COMP, LRLUS, IPOOL, LPOOL, LEAF, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, + & ITLOC, RHS_MUMPS, + & ND, PROCNODE_STEPS, SLAVEF ) + SUBNAME="CMUMPS_700" + IF ( IFLAG .LT. 0 ) GO TO 500 + ELSE IF ( MSGTAG .EQ. ROOT_2SON ) THEN + ISON = BUFR( 1 ) + NELIM = BUFR( 2 ) + CALL CMUMPS_271( COMM_LOAD, ASS_IRECV, + & ISON, NELIM, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GO TO 100 + IF (MYID.NE.MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF)) THEN + IF (KEEP(50).EQ.0) THEN + IF (IW(PTRIST(STEP(ISON))+6+KEEP(IXSZ)).EQ. + & S_REC_CONTSTATIC) THEN + IW(PTRIST(STEP(ISON))+6+KEEP(IXSZ)) = S_ROOT2SON_CALLED + ELSE + CALL CMUMPS_626( N, ISON, PTRIST, PTRAST, + & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + ENDIF + ELSE + IF (IW(PTRIST(STEP(ISON))+8+KEEP(IXSZ)).EQ. + & S_REC_CONTSTATIC) THEN + IW(PTRIST(STEP(ISON))+8+KEEP(IXSZ)) = S_ROOT2SON_CALLED + ELSE + CALL CMUMPS_626( N, ISON, PTRIST, PTRAST, + & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + ENDIF + ENDIF + ENDIF + ELSE IF ( MSGTAG .EQ. ROOT_2SLAVE ) THEN + TOT_ROOT_SIZE = BUFR( 1 ) + TOT_CONT_TO_RECV = BUFR( 2 ) + CALL CMUMPS_270( TOT_ROOT_SIZE, + & TOT_CONT_TO_RECV, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND ) + IF ( IFLAG .LT. 0 ) GO TO 100 + ELSE IF ( MSGTAG .EQ. ROOT_NELIM_INDICES ) THEN + ISON = BUFR( 1 ) + NELIM = BUFR( 2 ) + NSLAVES_PERE = BUFR( 3 ) + CALL CMUMPS_273( root, + & ISON, NELIM, NSLAVES_PERE, BUFR(4), BUFR(4+BUFR(2)), + & BUFR(4+2*BUFR(2)), + & + & PROCNODE_STEPS, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & ITLOC, RHS_MUMPS, COMP, + & IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8, + & COMM, COMM_LOAD, FILS, ND) + SUBNAME="CMUMPS_273" + IF ( IFLAG .LT. 0 ) GO TO 500 + ELSE IF ( MSGTAG .EQ. UPDATE_LOAD ) THEN + WRITE(*,*) "Internal error 3 in CMUMPS_322" + CALL MUMPS_ABORT() + ELSE IF ( MSGTAG .EQ. TAG_DUMMY ) THEN + ELSE + IF ( LP > 0 ) + & WRITE(LP,*) MYID, + &': Internal error, routine CMUMPS_322.',MSGTAG + IFLAG = -100 + IERROR= MSGTAG + GOTO 500 + ENDIF + 100 CONTINUE + RETURN + 500 CONTINUE + IF ( ICNTL(1) .GT. 0 .AND. ICNTL(4).GE.1 ) THEN + LP=ICNTL(1) + IF (IFLAG.EQ.-9) THEN + WRITE(LP,*) 'FAILURE, WORKSPACE TOO SMALL DURING ',SUBNAME + ENDIF + IF (IFLAG.EQ.-8) THEN + WRITE(LP,*) 'FAILURE IN INTEGER ALLOCATION DURING ',SUBNAME + ENDIF + IF (IFLAG.EQ.-13) THEN + WRITE(LP,*) 'FAILURE IN DYNAMIC ALLOCATION DURING ',SUBNAME + ENDIF + ENDIF + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE CMUMPS_322 + RECURSIVE SUBROUTINE CMUMPS_280( + & COMM_LOAD, ASS_IRECV, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT , + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC, LA, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ), + & PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX DBLARR( max(1,KEEP(13)) ) + INTEGER MSGSOU, MSGTAG, MSGLEN, IERR + MSGSOU = STATUS( MPI_SOURCE ) + MSGTAG = STATUS( MPI_TAG ) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) + IF ( MSGLEN .GT. LBUFR_BYTES ) THEN + IFLAG = -20 + IERROR = MSGLEN + WRITE(*,*) ' RECEPTION BUF TOO SMALL, Msgtag/len=', + & MSGTAG,MSGLEN + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + CALL MPI_RECV( BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU, + & MSGTAG, + & COMM, STATUS, IERR ) + CALL CMUMPS_322( + & COMM_LOAD, ASS_IRECV, + & MSGSOU, MSGTAG, MSGLEN, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + RETURN + END SUBROUTINE CMUMPS_280 + RECURSIVE SUBROUTINE CMUMPS_329( + & COMM_LOAD, ASS_IRECV, BLOCKING, SET_IRECV, + & MESSAGE_RECEIVED, MSGSOU, MSGTAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & STACK_RIGHT_AUTHORIZED ) + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL, INTENT (IN) :: BLOCKING + LOGICAL, INTENT (IN) :: SET_IRECV + LOGICAL, INTENT (INOUT) :: MESSAGE_RECEIVED + INTEGER, INTENT (IN) :: MSGSOU, MSGTAG + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ), + & PTLUST_S(KEEP(28)) + INTEGER STEP(N), + & PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX DBLARR( max(1,KEEP(13)) ) + LOGICAL, intent(in) :: STACK_RIGHT_AUTHORIZED + LOGICAL FLAG, RIGHT_MESS, FLAGbis + INTEGER LP, MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC + INTEGER IERR + INTEGER STATUS_BIS( MPI_STATUS_SIZE ) + INTEGER, SAVE :: RECURS = 0 + CALL CMUMPS_467(COMM_LOAD, KEEP) + IF ( .NOT. STACK_RIGHT_AUTHORIZED ) THEN + RETURN + ENDIF + RECURS = RECURS + 1 + LP = ICNTL(1) + IF (ICNTL(4).LT.1) LP=-1 + IF ( MESSAGE_RECEIVED ) THEN + MSGSOU_LOC = MPI_ANY_SOURCE + MSGTAG_LOC = MPI_ANY_TAG + GOTO 250 + ENDIF + IF ( ASS_IRECV .NE. MPI_REQUEST_NULL) THEN + RIGHT_MESS = .TRUE. + IF (BLOCKING) THEN + CALL MPI_WAIT(ASS_IRECV, + & STATUS, IERR) + FLAG = .TRUE. + IF ( ( (MSGSOU.NE.MPI_ANY_SOURCE) .OR. + & (MSGTAG.NE.MPI_ANY_TAG) ) ) THEN + IF ( MSGSOU.NE.MPI_ANY_SOURCE) THEN + RIGHT_MESS = MSGSOU.EQ.STATUS(MPI_SOURCE) + ENDIF + IF ( MSGTAG.NE.MPI_ANY_TAG) THEN + RIGHT_MESS = + & ( (MSGTAG.EQ.STATUS(MPI_TAG)).AND.RIGHT_MESS ) + ENDIF + IF (.NOT.RIGHT_MESS) THEN + CALL MPI_PROBE(MSGSOU,MSGTAG, + & COMM, STATUS_BIS, IERR) + ENDIF + ENDIF + ELSE + CALL MPI_TEST(ASS_IRECV, + & FLAG, STATUS, IERR) + ENDIF + IF (IERR.LT.0) THEN + IFLAG = -20 + IF (LP.GT.0) + & write(LP,*) ' Error return from MPI_TEST ', + & IFLAG, ' in CMUMPS_329' + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + IF ( FLAG ) THEN + MESSAGE_RECEIVED = .TRUE. + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN_LOC, IERR ) + IF (.NOT.RIGHT_MESS) RECURS = RECURS + 10 + CALL CMUMPS_322( COMM_LOAD, ASS_IRECV, + & MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (.NOT.RIGHT_MESS) RECURS = RECURS - 10 + IF ( IFLAG .LT. 0 ) RETURN + IF (.NOT.RIGHT_MESS) THEN + IF (ASS_IRECV .NE. MPI_REQUEST_NULL) THEN + CALL MUMPS_ABORT() + ENDIF + CALL MPI_IPROBE(MSGSOU,MSGTAG, + & COMM, FLAGbis, STATUS, IERR) + IF (FLAGbis) THEN + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + CALL CMUMPS_280( COMM_LOAD, ASS_IRECV, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + ENDIF + ELSE + IF (BLOCKING) THEN + CALL MPI_PROBE(MSGSOU,MSGTAG, + & COMM, STATUS, IERR) + FLAG = .TRUE. + ELSE + CALL MPI_IPROBE(MPI_ANY_SOURCE,MPI_ANY_TAG, + & COMM, FLAG, STATUS, IERR) + ENDIF + IF (FLAG) THEN + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + MESSAGE_RECEIVED = .TRUE. + CALL CMUMPS_280( COMM_LOAD, ASS_IRECV, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + 250 CONTINUE + RECURS = RECURS - 1 + IF ( NBFIN .EQ. 0 ) RETURN + IF ( RECURS .GT. 3 ) RETURN + IF ( KEEP(36).EQ.1 .AND. SET_IRECV .AND. + & (ASS_IRECV.EQ.MPI_REQUEST_NULL) .AND. + & MESSAGE_RECEIVED ) THEN + CALL MPI_IRECV ( BUFR(1), + & LBUFR_BYTES, MPI_PACKED, MPI_ANY_SOURCE, + & MPI_ANY_TAG, COMM, + & ASS_IRECV, IERR ) + ENDIF + RETURN + END SUBROUTINE CMUMPS_329 + SUBROUTINE CMUMPS_255( INFO1, + & ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & COMM, + & MYID, SLAVEF) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER LBUFR, LBUFR_BYTES + INTEGER ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER COMM + INTEGER MYID, SLAVEF, INFO1, DEST + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL NO_ACTIVE_IRECV + INTEGER MSGSOU_LOC, MSGTAG_LOC + INTEGER IERR, DUMMY + INTRINSIC mod + IF (SLAVEF .EQ. 1) RETURN + IF (ASS_IRECV.EQ.MPI_REQUEST_NULL) THEN + NO_ACTIVE_IRECV=.TRUE. + ELSE + CALL MPI_TEST(ASS_IRECV, NO_ACTIVE_IRECV, + & STATUS, IERR) + ENDIF + CALL MPI_BARRIER(COMM,IERR) + DUMMY = 1 + DEST = mod(MYID+1, SLAVEF) + CALL CMUMPS_62 + & (DUMMY, DEST, TAG_DUMMY, COMM, IERR) + IF (NO_ACTIVE_IRECV) THEN + CALL MPI_RECV( BUFR, LBUFR, + & MPI_INTEGER, MPI_ANY_SOURCE, + & TAG_DUMMY, COMM, STATUS, IERR ) + ELSE + CALL MPI_WAIT(ASS_IRECV, + & STATUS, IERR) + ENDIF + RETURN + END SUBROUTINE CMUMPS_255 + SUBROUTINE CMUMPS_180( + & INFO1, BUFR, LBUFR, LBUFR_BYTES, + & COMM_NODES, COMM_LOAD, SLAVEF, MP ) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER COMM_NODES, COMM_LOAD, SLAVEF, INFO1, MP + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG, BUFFERS_EMPTY, BUFFERS_EMPTY_ON_ALL_PROCS + INTEGER MSGSOU_LOC, MSGTAG_LOC, COMM_EFF + INTEGER IERR + INTEGER IBUF_EMPTY, IBUF_EMPTY_ON_ALL_PROCS + IF (SLAVEF.EQ.1) RETURN + BUFFERS_EMPTY_ON_ALL_PROCS = .FALSE. + 10 CONTINUE + FLAG = .TRUE. + DO WHILE ( FLAG ) + COMM_EFF = COMM_NODES + CALL MPI_IPROBE(MPI_ANY_SOURCE,MPI_ANY_TAG, + & COMM_NODES, FLAG, STATUS, IERR) + IF ( .NOT. FLAG ) THEN + COMM_EFF = COMM_LOAD + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, + & COMM_LOAD, FLAG, STATUS, IERR) + END IF + IF (FLAG) THEN + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + CALL MPI_RECV( BUFR, LBUFR_BYTES, + & MPI_PACKED, MSGSOU_LOC, + & MSGTAG_LOC, COMM_EFF, STATUS, IERR ) + ENDIF + END DO + IF (BUFFERS_EMPTY_ON_ALL_PROCS) THEN + RETURN + ENDIF + CALL CMUMPS_469(BUFFERS_EMPTY) + IF ( BUFFERS_EMPTY ) THEN + IBUF_EMPTY = 0 + ELSE + IBUF_EMPTY = 1 + ENDIF + CALL MPI_ALLREDUCE(IBUF_EMPTY, + & IBUF_EMPTY_ON_ALL_PROCS, + & 1, MPI_INTEGER, MPI_MAX, + & COMM_NODES, IERR) + IF ( IBUF_EMPTY_ON_ALL_PROCS == 0) THEN + BUFFERS_EMPTY_ON_ALL_PROCS = .TRUE. + ELSE + BUFFERS_EMPTY_ON_ALL_PROCS = .FALSE. + ENDIF + GOTO 10 + END SUBROUTINE CMUMPS_180 + INTEGER FUNCTION CMUMPS_748 + & ( HBUF_SIZE, NNMAX, K227, K50 ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NNMAX, K227, K50 + INTEGER(8), INTENT(IN) :: HBUF_SIZE + INTEGER K227_LOC + INTEGER NBCOL_MAX + INTEGER EFFECTIVE_SIZE + NBCOL_MAX=int(HBUF_SIZE / int(NNMAX,8)) + K227_LOC = abs(K227) + IF (K50.EQ.2) THEN + K227_LOC=max(K227_LOC,2) + EFFECTIVE_SIZE = min(NBCOL_MAX-1, K227_LOC-1) + ELSE + EFFECTIVE_SIZE = min(NBCOL_MAX, K227_LOC) + ENDIF + IF (EFFECTIVE_SIZE.LE.0) THEN + write(6,*) 'Internal buffers too small to store ', + & ' ONE col/row of size', NNMAX + CALL MUMPS_ABORT() + ENDIF + CMUMPS_748 = EFFECTIVE_SIZE + RETURN + END FUNCTION CMUMPS_748 + SUBROUTINE CMUMPS_698( IPIV, LPIV, ISHIFT, + & THE_PANEL, NBROW, NBCOL, KbeforePanel ) + IMPLICIT NONE + INTEGER LPIV, ISHIFT, NBROW, NBCOL, KbeforePanel + INTEGER IPIV(LPIV) + COMPLEX THE_PANEL(NBROW, NBCOL) + INTEGER I, IPERM + DO I = 1, LPIV + IPERM=IPIV(I) + IF ( I+ISHIFT.NE.IPERM) THEN + CALL cswap(NBCOL, + & THE_PANEL(I+ISHIFT-KbeforePanel,1), NBROW, + & THE_PANEL(IPERM-KbeforePanel,1), NBROW) + ENDIF + END DO + RETURN + END SUBROUTINE CMUMPS_698 + SUBROUTINE CMUMPS_667(TYPEF, + & NBPANELS, + & I_PIVPTR, I_PIV, IPOS, IW, LIW) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER, intent(out) :: NBPANELS, I_PIVPTR, I_PIV + INTEGER, intent(in) :: TYPEF + INTEGER, intent(in) :: LIW, IPOS + INTEGER IW(LIW) + INTEGER I_NBPANELS, I_NASS + I_NASS = IPOS + I_NBPANELS = I_NASS + 1 + NBPANELS = IW(I_NBPANELS) + I_PIVPTR = I_NBPANELS + 1 + I_PIV = I_PIVPTR + NBPANELS + IF (TYPEF==TYPEF_U) THEN + I_NBPANELS = I_PIV+IW(I_NASS) + NBPANELS = IW(I_NBPANELS) + I_PIVPTR = I_NBPANELS + 1 + I_PIV = I_PIVPTR + NBPANELS + ENDIF + RETURN + END SUBROUTINE CMUMPS_667 + SUBROUTINE CMUMPS_691(K50,NBPANELS_L,NBPANELS_U, + & NASS, IPOS, IW, LIW ) + IMPLICIT NONE + INTEGER K50 + INTEGER IPOS, NASS, NBPANELS_L, NBPANELS_U, LIW + INTEGER IW(LIW) + INTEGER IPOS_U + IF (K50.EQ.1) THEN + WRITE(*,*) "Internal error: CMUMPS_691 called" + ENDIF + IW(IPOS)=NASS + IW(IPOS+1)=NBPANELS_L + IW(IPOS+2:IPOS+1+NBPANELS_L)=NASS+1 + IF (K50 == 0) THEN + IPOS_U=IPOS+2+NASS+NBPANELS_L + IW(IPOS_U)=NBPANELS_U + IW(IPOS_U+1:IPOS_U+NBPANELS_U)=NASS+1 + ENDIF + RETURN + END SUBROUTINE CMUMPS_691 + SUBROUTINE CMUMPS_644 ( + & IWPOS, IOLDPS, IW, LIW, MonBloc, NFRONT, KEEP + & ) + USE CMUMPS_OOC + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER, INTENT(IN) :: IOLDPS, LIW, NFRONT, + & KEEP(500) + INTEGER, INTENT(INOUT) :: IWPOS, IW(LIW) + TYPE(IO_BLOCK), INTENT(IN):: MonBloc + INTEGER :: NBPANELS_L,I_PIVRPTR_L, I_PIVR_L, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, XSIZE, IBEGOOC + LOGICAL FREESPACE + IF (KEEP(50).EQ.1) RETURN + IF ((IOLDPS+IW(IOLDPS+XXI)).NE.IWPOS) RETURN + XSIZE = KEEP(IXSZ) + IBEGOOC = IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE + CALL CMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IBEGOOC, IW, LIW) + FREESPACE = + & (MonBloc%LastPiv.EQ.(IW(I_PIVRPTR_L)-1)) + IF (KEEP(50).EQ.0) THEN + CALL CMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IBEGOOC, IW, LIW) + FREESPACE = FREESPACE .AND. + & (MonBloc%LastPiv.EQ.(IW(I_PIVRPTR_U)-1)) + ENDIF + IF (FREESPACE) THEN + IW(IBEGOOC) = -7777 + IW(IOLDPS+XXI) = IBEGOOC - IOLDPS + 1 + IWPOS = IBEGOOC+1 + ENDIF + RETURN + END SUBROUTINE CMUMPS_644 + SUBROUTINE CMUMPS_684(K50, NBROW_L, NBCOL_U, NASS, + & NBPANELS_L, NBPANELS_U, LREQ) + USE CMUMPS_OOC + IMPLICIT NONE + INTEGER, intent(IN) :: K50, NBROW_L, NBCOL_U, NASS + INTEGER, intent(OUT) :: NBPANELS_L, NBPANELS_U, LREQ + NBPANELS_L=-99999 + NBPANELS_U=-99999 + IF (K50.EQ.1) THEN + LREQ = 0 + RETURN + ENDIF + NBPANELS_L = (NASS / CMUMPS_690(NBROW_L))+1 + LREQ = 1 + & + 1 + & + NASS + & + NBPANELS_L + IF (K50.eq.0) THEN + NBPANELS_U = (NASS / CMUMPS_690(NBCOL_U) ) +1 + LREQ = LREQ + 1 + & + NASS + & + NBPANELS_U + ENDIF + RETURN + END SUBROUTINE CMUMPS_684 + SUBROUTINE CMUMPS_755 + & (IW_LOCATION, MUST_BE_PERMUTED) + IMPLICIT NONE + INTEGER, INTENT(IN) :: IW_LOCATION + LOGICAL, INTENT(INOUT) :: MUST_BE_PERMUTED + IF (IW_LOCATION .EQ. -7777) THEN + MUST_BE_PERMUTED = .FALSE. + ENDIF + RETURN + END SUBROUTINE CMUMPS_755 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part2.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part2.F new file mode 100644 index 000000000..3f4564484 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part2.F @@ -0,0 +1,7687 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE CMUMPS_152(SSARBR, MYID, N, IPOSBLOCK, + & RPOSBLOCK, + & IW, LIW, + & LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP, KEEP8, IN_PLACE_STATS + & ) + USE CMUMPS_LOAD + IMPLICIT NONE + INTEGER(8) :: RPOSBLOCK + INTEGER IPOSBLOCK, + & LIW, IWPOSCB, N + INTEGER(8) :: LA, LRLU, LRLUS, IPTRLU + LOGICAL IN_PLACE_STATS + INTEGER IW( LIW ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER MYID + LOGICAL SSARBR + INTEGER SIZFI_BLOCK, SIZFI + INTEGER IPOSSHIFT + INTEGER(8) :: SIZFR, SIZFR_BLOCK, SIZFR_BLOCK_EFF, + & SIZEHOLE, MEM_INC + INCLUDE 'mumps_headers.h' + IPOSSHIFT = IPOSBLOCK + KEEP(IXSZ) + SIZFI_BLOCK=IW(IPOSBLOCK+XXI) + CALL MUMPS_729( SIZFR_BLOCK,IW(IPOSBLOCK+XXR) ) + IF (KEEP(216).eq.3) THEN + SIZFR_BLOCK_EFF=SIZFR_BLOCK + ELSE + CALL CMUMPS_628( IW(IPOSBLOCK), + & LIW-IPOSBLOCK+1, + & SIZEHOLE, KEEP(IXSZ)) + SIZFR_BLOCK_EFF=SIZFR_BLOCK-SIZEHOLE + ENDIF + IF ( IPOSBLOCK .eq. IWPOSCB + 1 ) THEN + IPTRLU = IPTRLU + SIZFR_BLOCK + IWPOSCB = IWPOSCB + SIZFI_BLOCK + LRLU = LRLU + SIZFR_BLOCK + IF (.NOT. IN_PLACE_STATS) THEN + LRLUS = LRLUS + SIZFR_BLOCK_EFF + ENDIF + MEM_INC = -SIZFR_BLOCK_EFF + IF (IN_PLACE_STATS) THEN + MEM_INC= 0_8 + ENDIF + CALL CMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,0_8,MEM_INC,KEEP,KEEP8,LRLU) + 90 IF ( IWPOSCB .eq. LIW ) GO TO 100 + IPOSSHIFT = IWPOSCB + KEEP(IXSZ) + SIZFI = IW( IWPOSCB+1+XXI ) + CALL MUMPS_729( SIZFR,IW(IWPOSCB+1+XXR) ) + IF ( IW( IWPOSCB+1+XXS ) .EQ. S_FREE ) THEN + IPTRLU = IPTRLU + SIZFR + LRLU = LRLU + SIZFR + IWPOSCB = IWPOSCB + SIZFI + GO TO 90 + ENDIF + 100 CONTINUE + IW( IWPOSCB+1+XXP)=TOP_OF_STACK + ELSE + IW( IPOSBLOCK +XXS)=S_FREE + IF (.NOT. IN_PLACE_STATS) LRLUS = LRLUS + SIZFR_BLOCK_EFF + CALL CMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,0_8,-SIZFR_BLOCK_EFF,KEEP,KEEP8,LRLU) + END IF + RETURN + END SUBROUTINE CMUMPS_152 + SUBROUTINE CMUMPS_144( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, PIMASTER, + & PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP,PIVNUL_LIST,LPN_LIST) + USE CMUMPS_OOC + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, INODE, FPERE, LIW, NOFFW, NPVW + INTEGER(8) :: LA + INTEGER IW( LIW ) + COMPLEX A( LA ) + REAL UU, SEUIL + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER COMM, MYID, LBUFR, LBUFR_BYTES + INTEGER LPTRAR, NELT + INTEGER ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NBFIN, SLAVEF, + & IFLAG, IERROR, LEAF, LPOOL + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB, COMP + INTEGER FRTPTR( N + 1 ), FRTELT( NELT ) + INTEGER BUFR( LBUFR ), IPOOL(LPOOL), + & ITLOC(N+KEEP(253)), FILS(N), + & PTRARW(LPTRAR), PTRAIW(LPTRAR), + & ND( KEEP(28) ), FRERE( KEEP(28) ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), NBPROCFILS(KEEP(28)), + & PROCNODE_STEPS(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + COMPLEX DBLARR(max(1,KEEP(13))) + LOGICAL AVOID_DELAYED + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER INOPV, IFINB, NFRONT, NPIV, IBEGKJI, NBOLKJ, + & NBTLKJ, IBEG_BLOCK + INTEGER(8) :: POSELT + INTEGER NASS, NEL1, IEND, IOLDPS, dummy, allocok + LOGICAL LASTBL + REAL UUTEMP + INTEGER , ALLOCATABLE, DIMENSION ( : ) :: IPIV + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, LNextPiv2beWritten, + & UNextPiv2beWritten, IFLAG_OOC, + & PP_FIRST2SWAP_L, PP_FIRST2SWAP_U, + & PP_LastPIVRPTRFilled_L, PP_LastPIVRPTRFilled_U + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INCLUDE 'mumps_headers.h' + EXTERNAL CMUMPS_224, CMUMPS_233, + & CMUMPS_225, CMUMPS_232, + & CMUMPS_294, + & CMUMPS_44 + LOGICAL STATICMODE + REAL SEUIL_LOC + INOPV = 0 + SEUIL_LOC = SEUIL + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + UUTEMP=UU + ENDIF + IBEG_BLOCK=1 + dummy = 0 + IOLDPS = PTLUST_S(STEP( INODE )) + POSELT = PTRAST(STEP( INODE )) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5),NASS ) + ENDIF + NBTLKJ = NBOLKJ + ALLOCATE( IPIV( NASS ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) MYID,' : FACTO_NIV2 :failed to allocate ',NASS, + & ' integers' + IFLAG = -13 + IERROR =NASS + GO TO 490 + END IF + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_U + LNextPiv2beWritten = 1 + UNextPiv2beWritten = 1 + PP_FIRST2SWAP_L = LNextPiv2beWritten + PP_FIRST2SWAP_U = UNextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + MonBloc%LastPanelWritten_U = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 2 + MonBloc%NROW = NASS + MonBloc%NCOL = NFRONT + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -68877 + NULLIFY(MonBloc%INDICES) + ENDIF + 50 CONTINUE + IBEGKJI = IBEG_BLOCK + CALL CMUMPS_224(NFRONT,NASS,IBEGKJI, NASS, IPIV, + & N,INODE,IW,LIW,A,LA,INOPV,NOFFW, + & IFLAG,IOLDPS,POSELT,UU,SEUIL_LOC,KEEP,KEEP8, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U, + & PP_LastPIVRPTRFilled_U) + IF (IFLAG.LT.0) GOTO 490 + IF (INOPV.EQ.1) THEN + IF(STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + ENDIF + IF (INOPV.GE.1) THEN + LASTBL = (INOPV.EQ.1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL CMUMPS_294( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, NFRONT, + & IBEGKJI, IEND, IPIV, NASS,LASTBL, dummy, + & + & COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (INOPV.EQ.1) GO TO 500 + IF (INOPV.EQ.2) THEN + CALL CMUMPS_233(IBEG_BLOCK,NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,NBOLKJ,NBTLKJ,KEEP(4),KEEP(IXSZ)) + GOTO 50 + ENDIF + NPVW = NPVW + 1 + IF (NASS.LE.1) THEN + IFINB = -1 + ELSE + CALL CMUMPS_225(IBEG_BLOCK, + & NFRONT, NASS, N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB, + & NBTLKJ,KEEP(4),KEEP(IXSZ)) + ENDIF + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + IF (IFINB.EQ.0) GOTO 50 + IF ((IFINB.EQ.1).OR.(IFINB.EQ.-1)) THEN + LASTBL = (IFINB.EQ.-1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL CMUMPS_294(COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, NFRONT, + & IBEGKJI, IEND, IPIV, NASS, LASTBL, dummy, + & + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (IFINB.EQ.(-1)) GOTO 500 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NEL1 = NASS - NPIV + CALL CMUMPS_232(A,LA, + & NFRONT,NPIV,NASS,POSELT,NBTLKJ) + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_TRY_WRITE + MonBloc%LastPiv = NPIV + TYPEFile = TYPEF_BOTH_LU + LAST_CALL= .FALSE. + CALL CMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG<0) RETURN + ENDIF + GO TO 50 + 490 CONTINUE + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + DEALLOCATE( IPIV ) + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + TYPEFile = TYPEF_BOTH_LU + LAST_CALL = .TRUE. + CALL CMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG<0) RETURN + CALL CMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + RETURN + END SUBROUTINE CMUMPS_144 + SUBROUTINE CMUMPS_176( COMM_LOAD, ASS_IRECV, + & root, FRERE, IROOT, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER IROOT + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC,IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER(8) :: LA + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND(KEEP(28)), FRERE(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX DBLARR( max(1,KEEP(13)) ) + INTEGER I, NELIM, NB_CONTRI_GLOBAL, NUMORG, + & NFRONT, IROW, JCOL, PDEST, HF, IOLDPS, + & IN, DEB_ROW, ILOC_ROW, IFSON, ILOC_COL, + & IPOS_SON, NELIM_SON, NSLAVES_SON, HS, + & IROW_SON, ICOL_SON, ISLAVE, IERR, + & NELIM_SENT, IPOS_STATREC + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INCLUDE 'mumps_headers.h' + INCLUDE 'mumps_tags.h' + NB_CONTRI_GLOBAL = KEEP(41) + NUMORG = root%ROOT_SIZE + NELIM = KEEP(42) + NFRONT = NUMORG + KEEP(42) + DO IROW = 0, root%NPROW - 1 + DO JCOL = 0, root%NPCOL - 1 + PDEST = IROW * root%NPCOL + JCOL + IF ( PDEST .NE. MYID ) THEN + CALL CMUMPS_73(NFRONT, + & NB_CONTRI_GLOBAL, PDEST, COMM, IERR) + if (IERR.lt.0) then + write(6,*) ' error detected by ', + & 'CMUMPS_73' + CALL MUMPS_ABORT() + endif + ENDIF + END DO + END DO + CALL CMUMPS_270( NFRONT, + & NB_CONTRI_GLOBAL, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND ) + IF (IFLAG < 0 ) RETURN + HF = 6 + KEEP(IXSZ) + IOLDPS = PTLUST_S(STEP(IROOT)) + IN = IROOT + DEB_ROW = IOLDPS + HF + ILOC_ROW = DEB_ROW + DO WHILE (IN.GT.0) + IW(ILOC_ROW) = IN + IW(ILOC_ROW+NFRONT) = IN + ILOC_ROW = ILOC_ROW + 1 + IN = FILS(IN) + END DO + IFSON = -IN + ILOC_ROW = IOLDPS + HF + NUMORG + ILOC_COL = ILOC_ROW + NFRONT + IF ( NELIM.GT.0 ) THEN + IN = IFSON + DO WHILE (IN.GT.0) + IPOS_SON = PIMASTER(STEP(IN)) + IF (IPOS_SON .EQ. 0) GOTO 100 + NELIM_SON = IW(IPOS_SON+1+KEEP(IXSZ)) + if (NELIM_SON.eq.0) then + write(6,*) ' error 1 in process_last_rtnelind' + CALL MUMPS_ABORT() + endif + NSLAVES_SON = IW(IPOS_SON+5+KEEP(IXSZ)) + HS = 6 + NSLAVES_SON + KEEP(IXSZ) + IROW_SON = IPOS_SON + HS + ICOL_SON = IROW_SON + NELIM_SON + DO I = 1, NELIM_SON + IW( ILOC_ROW+I-1 ) = IW( IROW_SON+I-1 ) + ENDDO + DO I = 1, NELIM_SON + IW( ILOC_COL+I-1 ) = IW( ICOL_SON+I-1 ) + ENDDO + NELIM_SENT = ILOC_ROW - IOLDPS - HF + 1 + DO ISLAVE = 0,NSLAVES_SON + IF (ISLAVE.EQ.0) THEN + PDEST= MUMPS_275(PROCNODE_STEPS(STEP(IN)),SLAVEF) + ELSE + PDEST = IW(IPOS_SON + 5 + ISLAVE+KEEP(IXSZ)) + ENDIF + IF (PDEST.NE.MYID) THEN + CALL CMUMPS_74(IN, NELIM_SENT, + & PDEST, COMM, IERR ) + if (IERR.lt.0) then + write(6,*) ' error detected by ', + & 'CMUMPS_73' + CALL MUMPS_ABORT() + endif + ELSE + CALL CMUMPS_271( COMM_LOAD, ASS_IRECV, + & IN, NELIM_SENT, root, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( ISLAVE .NE. 0 ) THEN + IF (KEEP(50) .EQ. 0) THEN + IPOS_STATREC = PTRIST(STEP(IN))+6+KEEP(IXSZ) + ELSE + IPOS_STATREC = PTRIST(STEP(IN))+8+KEEP(IXSZ) + ENDIF + IF (IW(IPOS_STATREC).EQ. S_REC_CONTSTATIC) THEN + IW(IPOS_STATREC) = S_ROOT2SON_CALLED + ELSE + CALL CMUMPS_626( N, IN, PTRIST, PTRAST, + & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + ENDIF + ENDIF + IPOS_SON = PIMASTER(STEP(IN)) + ENDIF + END DO + CALL CMUMPS_152( .FALSE.,MYID,N, IPOS_SON, + & PTRAST(STEP(IN)), + & IW, LIW, + & LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + ILOC_ROW = ILOC_ROW + NELIM_SON + ILOC_COL = ILOC_COL + NELIM_SON + 100 CONTINUE + IN = FRERE(STEP(IN)) + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_176 + SUBROUTINE CMUMPS_268(MYID,BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, SLAVEF, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, + & N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, NBPROCFILS, + & IPOOL, LPOOL, LEAF, KEEP,KEEP8, ND, FILS, FRERE, + & ITLOC, RHS_MUMPS, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER MYID + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER SLAVEF + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), STEP(N), PIMASTER(KEEP(28)) + INTEGER PROCNODE_STEPS( KEEP(28) ), ITLOC( N +KEEP(253) ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM, COMM_LOAD + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER ND(KEEP(28)), FILS( N ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER POSITION, IFATH, ISON, NROW, NCOL, NELIM, + & NSLAVES + INTEGER(8) :: NOREAL + INTEGER NOINT, INIV2, NCOL_EFF + DOUBLE PRECISION FLOP1 + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INTEGER NOREAL_PACKET + LOGICAL PERETYPE2 + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + POSITION = 0 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IFATH, 1, MPI_INTEGER + & , COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & ISON , 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NSLAVES, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NROW , 1, MPI_INTEGER + & , COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NCOL , 1, MPI_INTEGER + & , COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, + & MPI_INTEGER, COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, + & MPI_INTEGER, COMM, IERR) + IF ( NSLAVES .NE. 0 .and. KEEP(50).ne.0 ) THEN + NCOL_EFF = NROW + ELSE + NCOL_EFF = NCOL + ENDIF + NOREAL_PACKET = NBROWS_PACKET * NCOL_EFF + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + NOINT = 6 + NROW + NCOL + NSLAVES + KEEP(IXSZ) + NOREAL= int(NROW,8) * int(NCOL_EFF,8) + CALL CMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A,LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, + & NOINT, NOREAL, ISON, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) THEN + RETURN + ENDIF + PIMASTER(STEP( ISON )) = IWPOSCB + 1 + PAMASTER(STEP( ISON )) = IPTRLU + 1_8 + IW( IWPOSCB + 1 + KEEP(IXSZ) ) = NCOL + NELIM = NROW + IW( IWPOSCB + 2 + KEEP(IXSZ) ) = NELIM + IW( IWPOSCB + 3 + KEEP(IXSZ) ) = NROW + IF ( NSLAVES .NE. 0 .and. KEEP(50).ne.0 ) THEN + IW( IWPOSCB + 4 + KEEP(IXSZ) ) = NROW - NCOL + IF ( NROW - NCOL .GE. 0 ) THEN + WRITE(*,*) 'Error in PROCESS_MAITRE2:',NROW,NCOL + CALL MUMPS_ABORT() + END IF + ELSE + IW( IWPOSCB + 4 + KEEP(IXSZ) ) = 0 + END IF + IW( IWPOSCB + 5 + KEEP(IXSZ) ) = 1 + IW( IWPOSCB + 6 + KEEP(IXSZ) ) = NSLAVES + IF (NSLAVES.GT.0) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IWPOSCB + 7 + KEEP(IXSZ) ), + & NSLAVES, MPI_INTEGER, COMM, IERR ) + ENDIF + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IW(IWPOSCB + 7 + KEEP(IXSZ) + NSLAVES), + & NROW, MPI_INTEGER, COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IW(IWPOSCB + 7 + KEEP(IXSZ) + NROW + NSLAVES), + & NCOL, MPI_INTEGER, COMM, IERR) + IF ( ( KEEP(48).NE. 0 ).AND.(NSLAVES .GT. 0 )) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(ISON) ) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & TAB_POS_IN_PERE(1,INIV2), + & NSLAVES+1, MPI_INTEGER, COMM, IERR) + TAB_POS_IN_PERE(SLAVEF+2,INIV2) = NSLAVES + ENDIF + ENDIF + IF (NOREAL_PACKET.GT.0) THEN + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & A(PAMASTER(STEP(ISON)) + + & int(NBROWS_ALREADY_SENT,8) * int(NCOL_EFF,8)), + & NOREAL_PACKET, MPI_COMPLEX, COMM, IERR) + ENDIF + IF ( NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. NROW ) THEN + PERETYPE2 = ( MUMPS_330(PROCNODE_STEPS(STEP(IFATH)), + & SLAVEF) .EQ. 2 ) + NSTK_S( STEP(IFATH )) = NSTK_S( STEP(IFATH) ) - 1 + IF ( NSTK_S( STEP(IFATH)) .EQ. 0 ) THEN + CALL CMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IFATH ) + IF (KEEP(47) .GE. 3) THEN + CALL CMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + CALL MUMPS_137( IFATH, N, PROCNODE_STEPS, + & SLAVEF, ND, + & FILS,FRERE, STEP, PIMASTER, + & KEEP(28), KEEP(50), KEEP(253), + & FLOP1,IW, LIW, KEEP(IXSZ) ) + IF (IFATH.NE.KEEP(20)) + & CALL CMUMPS_190(1, .FALSE., FLOP1, KEEP,KEEP8) + END IF + ENDIF + RETURN + END SUBROUTINE CMUMPS_268 + SUBROUTINE CMUMPS_242(DATA, LDATA, MPITYPE, ROOT, COMMW, TAG, + &SLAVEF) + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER LDATA, ROOT, COMMW, TAG, MPITYPE, SLAVEF + INTEGER DEST + INTEGER DATA(LDATA) + DO 10 DEST = 0, SLAVEF - 1 + IF (DEST .NE. ROOT) THEN + IF ( LDATA .EQ. 1 .and. MPITYPE .EQ. MPI_INTEGER ) THEN + CALL CMUMPS_62( DATA(1), DEST, TAG, + & COMMW, IERR ) + ELSE + WRITE(*,*) 'Error : bad argument to CMUMPS_242' + CALL MUMPS_ABORT() + END IF + ENDIF + 10 CONTINUE + RETURN + END SUBROUTINE CMUMPS_242 + SUBROUTINE CMUMPS_44( MYID, SLAVEF, COMM ) + INTEGER MYID, SLAVEF, COMM + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER DUMMY (1) + CALL CMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, + & COMM, TERREUR, SLAVEF ) + RETURN + END SUBROUTINE CMUMPS_44 + SUBROUTINE CMUMPS_464( K34, K35, K16, K10 ) + IMPLICIT NONE + INTEGER, INTENT(OUT) :: K34, K35, K10, K16 + INTEGER SIZE_INT, SIZE_REAL_OR_DOUBLE + INTEGER I(2) + REAL R(2) + CALL MUMPS_SIZE_C(I(1),I(2),SIZE_INT) + CALL MUMPS_SIZE_C(R(1),R(2),SIZE_REAL_OR_DOUBLE) + K34 = int(SIZE_INT) + K10 = 8 / K34 + K16 = int(SIZE_REAL_OR_DOUBLE) + K35 = K16 + K35 = K35 * 2 + RETURN + END SUBROUTINE CMUMPS_464 + SUBROUTINE CMUMPS_20( NSLAVES, LWK_USER, CNTL, ICNTL, + & KEEP,KEEP8, + & INFO, INFOG, RINFO, RINFOG, SYM, PAR, + & DKEEP) + IMPLICIT NONE + REAL DKEEP(30) + REAL CNTL(15), RINFO(40), RINFOG(40) + INTEGER ICNTL(40), KEEP(500), SYM, PAR, NSLAVES + INTEGER INFO(40), INFOG(40) + INTEGER(8) KEEP8(150) + INTEGER LWK_USER +C Let $A_{preproc}$ be the preprocessed matrix to be factored (see + LWK_USER = 0 + KEEP(1:500) = 0 + KEEP8(1:150)= 0_8 + INFO(1:40) = 0 + INFOG(1:40) = 0 + ICNTL(1:40) = 0 + RINFO(1:40) = 0.0E0 + RINFOG(1:40)= 0.0E0 + CNTL(1:15) = 0.0E0 + DKEEP(1:30) = 0.0E0 + KEEP( 50 ) = SYM + IF (SYM.EQ.1) THEN + KEEP(50) = 2 + ENDIF + IF ( KEEP(50).NE.1 .and. KEEP(50).NE.2 ) KEEP( 50 ) = 0 + IF ( KEEP(50) .NE. 1 ) THEN + CNTL(1) = 0.01E0 + ELSE + CNTL(1) = 0.0E0 + END IF + CNTL(2) = sqrt(epsilon(0.0E0)) + CNTL(3) = 0.0E0 + CNTL(4) = -1.0E0 + CNTL(5) = 0.0E0 + CNTL(6) = -1.0E0 + KEEP(46) = PAR + IF ( KEEP(46) .NE. 0 .AND. + & KEEP(46) .NE. 1 ) THEN + KEEP(46) = 1 + END IF + ICNTL(1) = 6 + ICNTL(2) = 0 + ICNTL(3) = 6 + ICNTL(4) = 2 + ICNTL(5) = 0 + IF (SYM.NE.1) THEN + ICNTL(6) = 7 + ELSE + ICNTL(6) = 0 + ENDIF + ICNTL(7) = 7 + ICNTL(8) = 77 + ICNTL(9) = 1 + ICNTL(10) = 0 + ICNTL(11) = 0 + IF(SYM .EQ. 2) THEN + ICNTL(12) = 0 + ELSE + ICNTL(12) = 1 + ENDIF + ICNTL(13) = 0 + IF (SYM.eq.1.AND.NSLAVES.EQ.1) THEN + ICNTL(14) = 5 + ELSE IF (NSLAVES .GT. 4) THEN + ICNTL(14) = 30 + ELSE + ICNTL(14) = 20 + END IF + ICNTL(15) = 0 + ICNTL(16) = 0 + ICNTL(17) = 0 + ICNTL(18) = 0 + ICNTL(19) = 0 + ICNTL(20) = 0 + ICNTL(21) = 0 + ICNTL(22) = 0 + ICNTL(23) = 0 + ICNTL(24) = 0 + ICNTL(27) = -8 + ICNTL(28) = 1 + ICNTL(29) = 0 + ICNTL(39) = 1 + ICNTL(40) = 0 + KEEP(12) = 0 + KEEP(11) = 2147483646 + KEEP(24) = 18 + KEEP(68) = 0 + KEEP(36) = 1 + KEEP(1) = 8 + KEEP(7) = 150 + KEEP(8) = 120 + KEEP(57) = 500 + KEEP(58) = 250 + IF ( SYM .eq. 0 ) THEN + KEEP(4) = 32 + KEEP(3) = 96 + KEEP(5) = 16 + KEEP(6) = 32 + KEEP(9) = 700 + KEEP(85) = 300 + KEEP(62) = 50 + IF (NSLAVES.GE.128) KEEP(62)=200 + IF (NSLAVES.GE.128) KEEP(9)=800 + IF (NSLAVES.GE.256) KEEP(9)=900 + ELSE + KEEP(4) = 24 + KEEP(3) = 96 + KEEP(5) = 16 + KEEP(6) = 48 + KEEP(9) = 400 + KEEP(85) = 100 + KEEP(62) = 100 + IF (NSLAVES.GE.128) KEEP(62)=150 + IF (NSLAVES.GE.64) KEEP(9)=800 + IF (NSLAVES.GE.128) KEEP(9)=900 + END IF + KEEP(63) = 60 + KEEP(48) = 5 + KEEP(17) = 0 + CALL CMUMPS_464( KEEP(34), KEEP(35), + & KEEP(16), KEEP(10) ) +#if defined(SP_) + KEEP( 51 ) = 70 +#else + KEEP( 51 ) = 48 +#endif + KEEP(37) = max(800, int(sqrt(real(NSLAVES+1))*real(KEEP(51)))) + IF ( NSLAVES > 256 ) THEN + KEEP(39) = 10000 + ELSEIF ( NSLAVES > 128 ) THEN + KEEP(39) = 20000 + ELSEIF ( NSLAVES > 64 ) THEN + KEEP(39) = 40000 + ELSEIF ( NSLAVES > 16 ) THEN + KEEP(39) = 80000 + ELSE + KEEP(39) = 160000 + END IF + KEEP(40) = -1 - 456789 + KEEP(45) = 0 + KEEP(47) = 2 + KEEP(64) = 10 + KEEP(69) = 4 + KEEP(75) = 1 + KEEP(76) = 2 + KEEP(77) = 30 + KEEP(79) = 0 + IF (NSLAVES.GT.4) THEN + KEEP(78)=max( + & int(log(real(NSLAVES))/log(real(2))) - 2 + & , 0 ) + ENDIF + KEEP(210) = 2 + KEEP8(79) = -10_8 + KEEP(80) = 1 + KEEP(81) = 0 + KEEP(82) = 5 + KEEP(83) = min(8,NSLAVES/4) + KEEP(83) = max(min(4,NSLAVES),max(KEEP(83),1)) + KEEP(86)=1 + KEEP(87)=0 + KEEP(88)=0 + KEEP(90)=1 + KEEP(91)=min(8, NSLAVES) + KEEP(91) = max(min(4,NSLAVES),min(KEEP(83),KEEP(91))) + IF(NSLAVES.LT.48)THEN + KEEP(102)=150 + ELSEIF(NSLAVES.LT.128)THEN + KEEP(102)=150 + ELSEIF(NSLAVES.LT.256)THEN + KEEP(102)=200 + ELSEIF(NSLAVES.LT.512)THEN + KEEP(102)=300 + ELSEIF(NSLAVES.GE.512)THEN + KEEP(102)=400 + ENDIF +#if defined(OLD_OOC_NOPANEL) + KEEP(99)=0 +#else + KEEP(99)=4 +#endif + KEEP(100)=0 + KEEP(204)=0 + KEEP(205)=0 + KEEP(209)=-1 + KEEP(104) = 16 + KEEP(107)=0 + KEEP(211)=2 + IF (NSLAVES .EQ. 2) THEN + KEEP(213) = 101 + ELSE + KEEP(213) = 201 + ENDIF + KEEP(217)=0 + KEEP(215)=0 + KEEP(216)=1 + KEEP(218)=50 + KEEP(219)=1 + IF (KEEP(50).EQ.2) THEN + KEEP(227)= max(2,32) + ELSE + KEEP(227)= max(1,32) + ENDIF + KEEP(231) = 1 + KEEP(232) = 3 + KEEP(233) = 0 + KEEP(239) = 1 + KEEP(240) = 10 + DKEEP(4) = -1.0E0 + DKEEP(5) = -1.0E0 + IF(NSLAVES.LE.8)THEN + KEEP(238)=12 + ELSE + KEEP(238)=7 + ENDIF + KEEP(234)= 1 + DKEEP(3)=-5.0E0 + KEEP(242) = 1 + KEEP(250) = 1 + RETURN + END SUBROUTINE CMUMPS_20 + SUBROUTINE CMUMPS_786(id, LP) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (CMUMPS_STRUC) :: id + INTEGER LP + IF (id%KEEP(72)==1) THEN + IF (LP.GT.0) + & write(LP,*) 'Warning KEEP(72) = 1 !!!!!!!!!! ' + id%KEEP(37) = 2*id%NSLAVES + id%KEEP(3)=3 + id%KEEP(4)=2 + id%KEEP(5)=1 + id%KEEP(6)=2 + id%KEEP(9)=3 + id%KEEP(39)=300 + id%CNTL(1)=0.1E0 + id%KEEP(213) = 101 + id%KEEP(85)=2 + id%KEEP(85)=-4 + id%KEEP(62) = 2 + id%KEEP(1) = 1 + id%KEEP(51) = 2 + ELSE IF (id%KEEP(72)==2) THEN + IF (LP.GT.0) + & write(LP,*)' OOC setting to reduce stack memory', + & ' KEEP(72)=', id%KEEP(72) + id%KEEP(85)=2 + id%KEEP(85)=-10000 + id%KEEP(62) = 10 + id%KEEP(210) = 1 + id%KEEP8(79) = 160000_8 + id%KEEP(1) = 2 + id%KEEP(102) = 110 + id%KEEP(213) = 121 + END IF + RETURN + END SUBROUTINE CMUMPS_786 + SUBROUTINE CMUMPS_195(N, NZ, IRN, ICN, LIW, IKEEP, PTRAR, + & IORD, NFSIZ, FILS, FRERE, LISTVAR_SCHUR, SIZE_SCHUR, + & ICNTL, INFO, KEEP,KEEP8, NSLAVES, PIV, id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N,NZ,LIW,IORD,SIZE_SCHUR, NSLAVES + INTEGER PTRAR(N,4), NFSIZ(N), FILS(N), FRERE(N) + INTEGER IKEEP(N,3) + INTEGER LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER INFO(40), ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + TYPE (CMUMPS_STRUC) :: id + INTEGER IRN(NZ), ICN(NZ) + INTEGER, DIMENSION(:), ALLOCATABLE :: IW + INTEGER IERR + INTEGER K,I,L1,L2,IWFR,NCMPA,LLIW, IN, IFSON + INTEGER NEMIN, LP, MP, LDIAG, ITEMP, symmetry + INTEGER MedDens, NBQD, AvgDens + LOGICAL PROK, COMPRESS_SCHUR + INTEGER NBBUCK + INTEGER, DIMENSION(:), ALLOCATABLE :: HEAD + INTEGER NUMFLAG + INTEGER OPT_METIS_SIZE + INTEGER, DIMENSION(:), ALLOCATABLE :: OPTIONS_METIS + REAL, DIMENSION(:), ALLOCATABLE :: COLSCA_TEMP + INTEGER THRESH, IVersion + LOGICAL AGG6 + INTEGER MINSYM + PARAMETER (MINSYM=50) + INTEGER(8) :: K79REF + PARAMETER(K79REF=12000000_8) + INTEGER PIV(N) + INTEGER MTRANS, COMPRESS,NCMP,IERROR,J,JPERM,NCST + INTEGER TOTEL + LOGICAL IDENT,SPLITROOT + EXTERNAL MUMPS_197, CMUMPS_198, + & CMUMPS_199, CMUMPS_351, + & CMUMPS_557, CMUMPS_201 +#if defined(OLDDFS) + EXTERNAL CMUMPS_200 +#endif + EXTERNAL CMUMPS_623 + EXTERNAL CMUMPS_547, CMUMPS_550, + & CMUMPS_556 + ALLOCATE( IW ( LIW ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = LIW + RETURN + ENDIF + LLIW = LIW - 2*N - 1 + L1 = LLIW + 1 + L2 = L1 + N + LP = ICNTL(1) + MP = ICNTL(3) + PROK = (MP.GT.0) + LDIAG = ICNTL(4) + COMPRESS_SCHUR = .FALSE. + IF (KEEP(1).LT.0) KEEP(1) = 0 + NEMIN = KEEP(1) + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + WRITE (MP,99999) N, NZ, LIW, INFO(1) + K = min0(10,NZ) + IF (LDIAG.EQ.4) K = NZ + IF (K.GT.0) WRITE (MP,99998) (IRN(I),ICN(I),I=1,K) + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (IORD.EQ.1 .AND. K.GT.0) THEN + WRITE (MP,99997) (IKEEP(I,1),I=1,K) + ENDIF + ENDIF + NCMP = N + IF (KEEP(60).NE.0) THEN + IF ((SIZE_SCHUR.LE.0 ).OR. + & (SIZE_SCHUR.GE.N) ) GOTO 90 + ENDIF +#if defined(metis) || defined(parmetis) + IF ( ( KEEP(60).NE.0).AND.(SIZE_SCHUR.GT.0) + & .AND. + & ((IORD.EQ.7).OR.(IORD.EQ.5)) + & )THEN + COMPRESS_SCHUR=.TRUE. + NCMP = N-SIZE_SCHUR + CALL CMUMPS_623(N,NCMP,NZ,IRN, ICN, IW(1), LLIW, + & IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, + & KEEP(50), MedDens, NBQD, AvgDens, + & LISTVAR_SCHUR, SIZE_SCHUR, + & FRERE,FILS) + IORD = 5 + KEEP(95) = 1 + NBQD = 0 + ELSE +#endif + CALL CMUMPS_351(N,NZ,IRN, ICN, IW(1), LLIW, + & IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, + & KEEP(50), MedDens, NBQD, AvgDens) +#if defined(metis) || defined(parmetis) + ENDIF +#endif + INFO(8) = symmetry + IF(NBQD .GT. 0) THEN + IF( KEEP(50) .EQ. 2 .AND. ICNTL(12) .LE. 1 ) THEN + IF(KEEP(95) .NE. 1) THEN + IF ( PROK ) + & WRITE( MP,*) + & 'Compressed/constrained ordering set OFF' + KEEP(95) = 1 + ENDIF + ENDIF + ENDIF + IF ( (KEEP(60).NE.0) .AND. (IORD.GT.1) .AND. + & .NOT. COMPRESS_SCHUR ) THEN + IORD = 0 + ENDIF + IF ( (KEEP(50).EQ.2) + & .AND. (KEEP(95) .EQ. 3) + & .AND. (IORD .EQ. 7) ) THEN + IORD = 2 + ENDIF + CALL CMUMPS_701( N, KEEP(50), NSLAVES, IORD, + & symmetry, MedDens, NBQD, AvgDens, + & PROK, MP ) + IF(KEEP(50) .EQ. 2) THEN + IF(KEEP(95) .EQ. 3 .AND. IORD .NE. 2) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: CMUMPS_195 constrained ordering not '// + & ' available with selected ordering. Move to' // + & ' compressed ordering.' + KEEP(95) = 2 + ENDIF + IF(KEEP(95) .EQ. 2 .AND. IORD .EQ. 0) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: CMUMPS_195 AMD not available with ', + & ' compressed ordering -> move to QAMD' + IORD = 6 + ENDIF + ELSE + KEEP(95) = 1 + ENDIF + MTRANS = KEEP(23) + COMPRESS = KEEP(95) - 1 + IF(COMPRESS .GT. 0 .AND. KEEP(52) .EQ. -2) THEN + IF(id%CNTL(4) .GE. 0.0E0) THEN + IF (KEEP(1).LE.8) THEN + NEMIN = 16 + ELSE + NEMIN = 2*KEEP(1) + ENDIF + IF (PROK) + & WRITE(MP,*) 'Setting static pivoting ON, COMPRESS =', + & COMPRESS + ENDIF + ENDIF + IF(MTRANS .GT. 0 .AND. KEEP(50) .EQ. 2) THEN + KEEP(23) = 0 + ENDIF + IF(COMPRESS .EQ. 2) THEN + IF (IORD.NE.2) THEN + WRITE(*,*) "IORD not compatible with COMPRESS:", + & IORD, COMPRESS + CALL MUMPS_ABORT() + ENDIF + CALL CMUMPS_556( + & N,PIV,FRERE,FILS,NFSIZ,IKEEP, + & NCST,KEEP,KEEP8,id) + ENDIF + IF ( IORD .NE. 1 ) THEN + IF(COMPRESS .GE. 1) THEN + CALL CMUMPS_547( + & N,NZ, IRN, ICN, PIV, + & NCMP, IW(1), LLIW, IW(L2),PTRAR(1,2),PTRAR, + & IW(L1), FILS, IWFR, + & IERROR, KEEP,KEEP8, ICNTL) + symmetry = 100 + ENDIF + IF ( (symmetry.LT.MINSYM).AND.(KEEP(50).EQ.0) ) THEN + IF(KEEP(23) .EQ. 7 ) THEN + KEEP(23) = -5 + DEALLOCATE (IW) + RETURN + ELSE IF(KEEP(23) .EQ. -9876543) THEN + IDENT = .TRUE. + KEEP(23) = 5 + IF (PROK) WRITE(MP,'(A)') + & ' ... Apply column permutation (already computed)' + DO J=1,N + JPERM = PIV(J) + FILS(JPERM) = J + IF (JPERM.NE.J) IDENT = .FALSE. + ENDDO + IF (.NOT.IDENT) THEN + DO K=1,NZ + J = ICN(K) + IF ((J.LE.0).OR.(J.GT.N)) CYCLE + ICN(K) = FILS(J) + ENDDO + ALLOCATE(COLSCA_TEMP(N), stat=IERR) + IF ( IERR > 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = N + RETURN + ENDIF + DO J = 1, N + COLSCA_TEMP(J)=id%COLSCA(J) + ENDDO + DO J=1, N + id%COLSCA(FILS(J))=COLSCA_TEMP(J) + ENDDO + DEALLOCATE(COLSCA_TEMP) + IF (MP.GT.0 .AND. ICNTL(4).GE.2) + & WRITE(MP,'(/A)') + & ' WARNING input matrix data modified' + CALL CMUMPS_351 + & (N,NZ,IRN, ICN, IW(1), LLIW, IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, KEEP(50), + & MedDens, NBQD, AvgDens) + INFO(8) = symmetry + NCMP = N + ELSE + KEEP(23) = 0 + ENDIF + ENDIF + ELSE IF (KEEP(23) .EQ. 7 .OR. KEEP(23) .EQ. -9876543 ) THEN + IF (PROK) WRITE(MP,'(A)') + & ' ... No column permutation' + KEEP(23) = 0 + ENDIF + ENDIF + IF (IORD.NE.1 .AND. IORD.NE.5) THEN + IF (PROK) THEN + IF (IORD.EQ.2) THEN + WRITE(MP,'(A)') ' Ordering based on AMF ' +#if defined(scotch) || defined(ptscotch) + ELSE IF (IORD.EQ.3) THEN + WRITE(MP,'(A)') ' Ordering based on SCOTCH ' +#endif +#if defined(pord) + ELSE IF (IORD.EQ.4) THEN + WRITE(MP,'(A)') ' Ordering based on PORD ' +#endif + ELSE IF (IORD.EQ.6) THEN + WRITE(MP,'(A)') ' Ordering based on QAMD ' + ELSE + WRITE(MP,'(A)') ' Ordering based on AMD ' + ENDIF + ENDIF + IF ( KEEP(60) .NE. 0 ) THEN + CALL MUMPS_162(N, LLIW, IW(L2), IWFR, PTRAR(1,2), IW(1), + & IW(L1), IKEEP, + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), PTRAR, PTRAR(1,3), + & LISTVAR_SCHUR, SIZE_SCHUR) + IF (KEEP(60)==1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSE + KEEP(38) = LISTVAR_SCHUR(1) + ENDIF + ELSE + IF ( .FALSE. ) THEN +#if defined(pord) + ELSEIF (IORD .EQ. 4) THEN + IF(COMPRESS .EQ. 1) THEN + DO I=L1,L1-1+KEEP(93)/2 + IW(I) = 2 + ENDDO + DO I=L1+KEEP(93)/2,L1+NCMP-1 + IW(I) = 1 + ENDDO + CALL MUMPS_PORDF_WND(NCMP, IWFR-1, IW(L2), IW, + & IW(L1), NCMPA, N) + CALL CMUMPS_548(NCMP,IW(L2),IW(L1),FILS) + CALL CMUMPS_549(NCMP,IW(L2),IKEEP(1,1), + & FRERE,PTRAR(1,1)) + DO I=1,NCMP + IKEEP(IKEEP(I,1),2)=I + ENDDO + ELSE + CALL MUMPS_PORDF(NCMP, IWFR-1, IW(L2), IW(1), + & IW(L1), NCMPA) + ENDIF + IF ( NCMPA .NE. 0 ) THEN + write(6,*) ' Out PORD, NCMPA=', NCMPA + INFO( 1 ) = -9999 + INFO( 2 ) = 4 + RETURN + ENDIF +#endif +#if defined(scotch) || defined(ptscotch) + ELSEIF (IORD .EQ. 3) THEN + CALL MUMPS_SCOTCH(NCMP, LLIW, IW(L2), IWFR, + & PTRAR(1,2), IW(1), IW(L1), IKEEP, + & IKEEP(1,2), NCMPA) + IF ( NCMPA .NE. 0 ) THEN + write(6,*) ' Out SCTOCH, NCMPA=', NCMPA + INFO( 1 ) = -9999 + INFO( 2 ) = 3 + RETURN + ENDIF + IF (COMPRESS .EQ. 1) THEN + CALL CMUMPS_548(NCMP,IW(L2),IW(L1),FILS) + CALL CMUMPS_549(NCMP,IW(L2),IKEEP(1,1), + & FRERE,PTRAR(1,1)) + DO I=1,NCMP + IKEEP(IKEEP(I,1),2)=I + ENDDO + ENDIF +#endif + ELSEIF (IORD .EQ. 2) THEN + NBBUCK = 2*N + ALLOCATE( HEAD ( 0: NBBUCK + 1), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = NBBUCK+2 + RETURN + ENDIF + IF(COMPRESS .GE. 1) THEN + DO I=L1,L1-1+KEEP(93)/2 + IW(I) = 2 + ENDDO + DO I=L1+KEEP(93)/2,L1+NCMP-1 + IW(I) = 1 + ENDDO + ELSE + IW(L1) = -1 + ENDIF + IF(COMPRESS .LE. 1) THEN + CALL MUMPS_337(NCMP, NBBUCK, LLIW, IW(L2), + & IWFR, PTRAR(1,2), + & IW(1), IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3), HEAD) + ELSE + IF(PROK) WRITE(MP,'(A)') + & ' Constrained Ordering based on AMF' + CALL MUMPS_560(NCMP, NBBUCK, LLIW, IW(L2), + & IWFR, PTRAR(1,2), + & IW(1), IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3), HEAD, + & NFSIZ, FRERE) + ENDIF + DEALLOCATE(HEAD) + ELSEIF (IORD .EQ. 6) THEN + ALLOCATE( HEAD ( N ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = N + RETURN + ENDIF + THRESH = 1 + IVersion = 2 + IF(COMPRESS .EQ. 1) THEN + DO I=L1,L1-1+KEEP(93)/2 + IW(I) = 2 + ENDDO + DO I=L1+KEEP(93)/2,L1+NCMP-1 + IW(I) = 1 + ENDDO + TOTEL = KEEP(93)+KEEP(94) + ELSE + IW(L1) = -1 + TOTEL = N + ENDIF + CALL MUMPS_421(TOTEL,IVersion, THRESH, HEAD, + & NCMP, LLIW, IW(L2), IWFR, PTRAR(1,2), IW(1), + & IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3)) + DEALLOCATE(HEAD) + ELSE + CALL MUMPS_197(NCMP, LLIW, IW(L2), IWFR, PTRAR(1,2), + & IW(1), IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3)) + ENDIF + ENDIF + IF(COMPRESS .GE. 1) THEN + CALL CMUMPS_550(N,NCMP,KEEP(94),KEEP(93), + & PIV,IKEEP(1,1),IKEEP(1,2)) + COMPRESS = -1 + ENDIF + ENDIF +#if defined(metis) || defined(parmetis) + IF (IORD.EQ.5) THEN + IF (PROK) THEN + WRITE(MP,'(A)') ' Ordering based on METIS ' + ENDIF + NUMFLAG = 1 + OPT_METIS_SIZE = 8 + ALLOCATE( OPTIONS_METIS (OPT_METIS_SIZE ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = OPT_METIS_SIZE + RETURN + ENDIF + OPTIONS_METIS(1) = 0 + IF (COMPRESS .EQ. 1) THEN + DO I=1,KEEP(93)/2 + FILS(I) = 2 + ENDDO + DO I=KEEP(93)/2+1,NCMP + FILS(I) = 1 + ENDDO + CALL METIS_NODEWND(NCMP, IW(L2), IW(1),FILS, + & NUMFLAG, OPTIONS_METIS, + & IKEEP(1,2), IKEEP(1,1) ) + ELSE + CALL METIS_NODEND(NCMP, IW(L2), IW(1), NUMFLAG, + & OPTIONS_METIS, + & IKEEP(1,2), IKEEP(1,1) ) + ENDIF + DEALLOCATE (OPTIONS_METIS) + IF ( COMPRESS_SCHUR ) THEN + CALL CMUMPS_622( + & N, NCMP, IKEEP(1,1),IKEEP(1,2), + & LISTVAR_SCHUR, SIZE_SCHUR, FILS) + COMPRESS = -1 + ENDIF + IF (COMPRESS .EQ. 1) THEN + CALL CMUMPS_550(N,NCMP,KEEP(94), + & KEEP(93),PIV,IKEEP(1,1),IKEEP(1,2)) + COMPRESS = -1 + ENDIF + ENDIF +#endif + IF (PROK) THEN + IF (IORD.EQ.1) THEN + WRITE(MP,'(A)') ' Ordering given is used' + ENDIF + ENDIF + IF ((IORD.EQ.1) + & ) THEN + DO K=1,N + PTRAR(K,1) = 0 + ENDDO + DO K=1,N + IF ((IKEEP(K,1).LE.0).OR.(IKEEP(K,1).GT.N)) + & GO TO 40 + IF (PTRAR(IKEEP(K,1),1).EQ.1) THEN + GOTO 40 + ELSE + PTRAR(IKEEP(K,1),1) = 1 + ENDIF + ENDDO + ENDIF + IF (IORD.EQ.1 .OR. IORD.EQ.5 .OR. COMPRESS.EQ.-1) THEN + IF (KEEP(106)==1) THEN + IF ( COMPRESS .EQ. -1 ) THEN + CALL CMUMPS_351(N,NZ,IRN, ICN, IW(1), LLIW, + & IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, KEEP(50), + & MedDens, NBQD, AvgDens) + INFO(8) = symmetry + ENDIF + COMPRESS = 0 + ALLOCATE( HEAD ( 2*N ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = 2*N + RETURN + ENDIF + THRESH = -1 + IF (KEEP(60) == 0) THEN + ITEMP = 0 + ELSE + ITEMP = SIZE_SCHUR + IF (KEEP(60)==1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSE + KEEP(38) = LISTVAR_SCHUR(1) + ENDIF + ENDIF + AGG6 =.TRUE. + CALL MUMPS_422(THRESH, HEAD, + & N, LLIW, IW(L2), IWFR, PTRAR(1,2), IW, + & IW(L1), HEAD(N+1), + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), PTRAR, PTRAR(1,3), + & IKEEP(1,1), LISTVAR_SCHUR, ITEMP, AGG6) + DEALLOCATE(HEAD) + ELSE + CALL CMUMPS_198(N, NZ, IRN, ICN, IKEEP, IW(1), + & LLIW, IW(L2), + & PTRAR(1,2), IW(L1), IWFR, + & INFO(1),INFO(2), KEEP(11), MP) + IF (KEEP(60) .EQ. 0) THEN + ITEMP = 0 + CALL CMUMPS_199(N, IW(L2), IW, LLIW, IWFR, IKEEP, + & IKEEP(1,2), IW(L1), + & PTRAR, NCMPA, ITEMP) + ELSE + CALL CMUMPS_199(N, IW(L2), IW, LLIW, IWFR, IKEEP, + & IKEEP(1,2), IW(L1), + & PTRAR, NCMPA, SIZE_SCHUR) + IF (KEEP(60) .EQ. 1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSE + KEEP(38) = LISTVAR_SCHUR(1) + ENDIF + ENDIF + ENDIF + ENDIF +#if defined(OLDDFS) + CALL CMUMPS_200 + & (N, IW(L2), IW(L1), IKEEP(1,1), IKEEP(1,2), IKEEP(1,3), + & NFSIZ, INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, KEEP(60)) +#else + CALL CMUMPS_557 + & (N, IW(L2), IW(L1), IKEEP(1,1), IKEEP(1,2), IKEEP(1,3), + & NFSIZ, PTRAR, INFO(6), FILS, FRERE, + & PTRAR(1,3), NEMIN, PTRAR(1,4), KEEP(60), + & KEEP(20),KEEP(38),PTRAR(1,2),KEEP(104),IW(1),KEEP(50), + & ICNTL(13), KEEP(37), NSLAVES, KEEP(250).EQ.1) +#endif + IF (KEEP(60).NE.0) THEN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO WHILE (IN.GT.0) + IN = FILS (IN) + END DO + IFSON = -IN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO I=2,SIZE_SCHUR + FILS(IN) = LISTVAR_SCHUR (I) + IN = FILS(IN) + FRERE (IN) = N+1 + ENDDO + FILS(IN) = -IFSON + ENDIF + CALL CMUMPS_201(IKEEP(1,2), + & PTRAR(1,3), INFO(6), + & INFO(5), KEEP(2), KEEP(50), + & KEEP(101),KEEP(108),KEEP(5), + & KEEP(6), KEEP(226), KEEP(253)) + IF ( KEEP(53) .NE. 0 ) THEN + CALL MUMPS_209( N, FRERE, FILS, NFSIZ, KEEP(20) ) + END IF + IF ( (KEEP(48) == 4 .AND. KEEP8(21).GT.0_8) + & .OR. + & (KEEP (48)==5 .AND. KEEP8(21) .GT. 0_8 ) + & .OR. + & (KEEP(24).NE.0.AND.KEEP8(21).GT.0_8) ) THEN + CALL CMUMPS_510(KEEP8(21), KEEP(2), + & KEEP(48), KEEP(50), NSLAVES) + END IF + IF (KEEP(210).LT.0.OR.KEEP(210).GT.2) KEEP(210)=0 + IF (KEEP(210).EQ.0.AND.KEEP(201).GT.0) KEEP(210)=1 + IF (KEEP(210).EQ.0.AND.KEEP(201).EQ.0) KEEP(210)=2 + IF (KEEP(210).EQ.2) KEEP8(79)=huge(KEEP8(79)) + IF (KEEP(210).EQ.1.AND.KEEP8(79).LE.0_8) THEN + IF ( huge(KEEP8(79)) / K79REF + 1_8 .GE. int(NSLAVES,8) ) THEN + KEEP8(79)=huge(KEEP8(79)) + ELSE + KEEP8(79)=K79REF * int(NSLAVES,8) + ENDIF + ENDIF + IF ( (KEEP(79).EQ.0).OR.(KEEP(79).EQ.2).OR. + & (KEEP(79).EQ.3).OR.(KEEP(79).EQ.5).OR. + & (KEEP(79).EQ.6) + & ) THEN + IF (KEEP(210).EQ.1) THEN + SPLITROOT = .FALSE. + IF ( KEEP(62).GE.1) THEN + CALL CMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG,INFO(1),INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + ENDIF + ENDIF + SPLITROOT = ((ICNTL(13).GT.0 .AND. NSLAVES.GT.ICNTL(13)) .OR. + & ICNTL(13).EQ.-1 ) + & .AND. (KEEP(60).EQ.0) + IF (SPLITROOT) THEN + CALL CMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG,INFO(1),INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (K.GT.0) WRITE (MP,99997) (IKEEP(I,1),I=1,K) + IF (K.GT.0) WRITE (MP,99991) (IKEEP(I,2),I=1,K) + IF (K.GT.0) WRITE (MP,99990) (IKEEP(I,3),I=1,K) + IF (K.GT.0) WRITE (MP,99986) (PTRAR(I,1),I=1,K) + IF (K.GT.0) WRITE (MP,99985) (PTRAR(I,2),I=1,K) + IF (K.GT.0) WRITE (MP,99984) (PTRAR(I,3),I=1,K) + IF (K.GT.0) WRITE (MP,99987) (NFSIZ(I),I=1,K) + IF (K.GT.0) WRITE (MP,99989) (FILS(I),I=1,K) + IF (K.GT.0) WRITE (MP,99988) (FRERE(I),I=1,K) + ENDIF + GO TO 90 + 40 INFO(1) = -4 + INFO(2) = K + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99996) INFO(1) + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99982) INFO(2) + GOTO 90 + 90 CONTINUE + DEALLOCATE(IW) + RETURN +99999 FORMAT (/'Entering analysis phase with ...'/ + & ' N NZ LIW INFO(1)'/, + & 9X, I8, I11, I12, I14) +99998 FORMAT ('Matrix entries: IRN() ICN()'/ + & (I12, I7, I12, I7, I12, I7)) +99997 FORMAT ('IKEEP(.,1)=', 10I6/(12X, 10I6)) +99996 FORMAT (/'** Error return ** from Analysis * INFO(1)=', I3) +99991 FORMAT ('IKEEP(.,2)=', 10I6/(12X, 10I6)) +99990 FORMAT ('IKEEP(.,3)=', 10I6/(12X, 10I6)) +99989 FORMAT ('FILS (.) =', 10I6/(12X, 10I6)) +99988 FORMAT ('FRERE(.) =', 10I6/(12X, 10I6)) +99987 FORMAT ('NFSIZ(.) =', 10I6/(12X, 10I6)) +99986 FORMAT ('PTRAR(.,1)=', 10I6/(12X, 10I6)) +99985 FORMAT ('PTRAR(.,2)=', 10I6/(12X, 10I6)) +99984 FORMAT ('PTRAR(.,3)=', 10I6/(12X, 10I6)) +99982 FORMAT ('Error in permutation array KEEP INFO(2)=', I3) + END SUBROUTINE CMUMPS_195 + SUBROUTINE CMUMPS_199(N,IPE,IW, LW, IWFR, IPS, IPV, NV, FLAG, + & NCMPA, SIZE_SCHUR) + INTEGER N,LW,IWFR,NCMPA,SIZE_SCHUR + INTEGER FLAG(N) + INTEGER IPS(N), IPV(N) + INTEGER IW(LW), NV(N), IPE(N) + INTEGER I,J,ML,MS,ME,IP,MINJS,IE,KDUMMY,JP + INTEGER LN,JP1,JS,LWFR,JP2,JE + DO 10 I=1,N + FLAG(I) = 0 + NV(I) = 0 + J = IPS(I) + IPV(J) = I + 10 CONTINUE + NCMPA = 0 + DO 100 ML=1,N-SIZE_SCHUR + MS = IPV(ML) + ME = MS + FLAG(MS) = ME + IP = IWFR + MINJS = N + IE = ME + DO 70 KDUMMY=1,N + JP = IPE(IE) + LN = 0 + IF (JP.LE.0) GO TO 60 + LN = IW(JP) + DO 50 JP1=1,LN + JP = JP + 1 + JS = IW(JP) + IF (FLAG(JS).EQ.ME) GO TO 50 + FLAG(JS) = ME + IF (IWFR.LT.LW) GO TO 40 + IPE(IE) = JP + IW(JP) = LN - JP1 + CALL CMUMPS_194(N, IPE, IW, IP-1, LWFR,NCMPA) + JP2 = IWFR - 1 + IWFR = LWFR + IF (IP.GT.JP2) GO TO 30 + DO 20 JP=IP,JP2 + IW(IWFR) = IW(JP) + IWFR = IWFR + 1 + 20 CONTINUE + 30 IP = LWFR + JP = IPE(IE) + 40 IW(IWFR) = JS + MINJS = min0(MINJS,IPS(JS)+0) + IWFR = IWFR + 1 + 50 CONTINUE + 60 IPE(IE) = -ME + JE = NV(IE) + NV(IE) = LN + 1 + IE = JE + IF (IE.EQ.0) GO TO 80 + 70 CONTINUE + 80 IF (IWFR.GT.IP) GO TO 90 + IPE(ME) = 0 + NV(ME) = 1 + GO TO 100 + 90 MINJS = IPV(MINJS) + NV(ME) = NV(MINJS) + NV(MINJS) = ME + IW(IWFR) = IW(IP) + IW(IP) = IWFR - IP + IPE(ME) = IP + IWFR = IWFR + 1 + 100 CONTINUE + IF (SIZE_SCHUR == 0) RETURN + DO ML = N-SIZE_SCHUR+1,N + ME = IPV(ML) + IE = ME + DO KDUMMY=1,N + JP = IPE(IE) + LN = 0 + IF (JP.LE.0) GO TO 160 + LN = IW(JP) + 160 IPE(IE) = -IPV(N-SIZE_SCHUR+1) + JE = NV(IE) + NV(IE) = LN + 1 + IE = JE + IF (IE.EQ.0) GO TO 190 + ENDDO + 190 NV(ME) = 0 + IPE(ME) = -IPV(N-SIZE_SCHUR+1) + ENDDO + ME = IPV(N-SIZE_SCHUR+1) + IPE(ME) = 0 + NV(ME) = SIZE_SCHUR + RETURN + END SUBROUTINE CMUMPS_199 + SUBROUTINE CMUMPS_198(N, NZ, IRN, ICN, PERM, + & IW, LW, IPE, IQ, FLAG, + & IWFR, IFLAG, IERROR, IOVFLO, MP) + INTEGER N,NZ,LW,IWFR,IFLAG,IERROR + INTEGER PERM(N) + INTEGER IQ(N) + INTEGER IRN(NZ), ICN(NZ) + INTEGER IPE(N), IW(LW), FLAG(N) + INTEGER MP + INTEGER IOVFLO + INTEGER I,J,K,LBIG,L,ID,IN,LEN,JDUMMY,K1,K2 + IERROR = 0 + DO 10 I=1,N + IQ(I) = 0 + 10 CONTINUE + DO 80 K=1,NZ + I = IRN(K) + J = ICN(K) + IW(K) = -I + IF (I.EQ.J) GOTO 40 + IF (I.GT.J) GOTO 30 + IF (I.GE.1 .AND. J.LE.N) GO TO 60 + GO TO 50 + 30 IF (J.GE.1 .AND. I.LE.N) GO TO 60 + GO TO 50 + 40 IW(K) = 0 + IF (I.GE.1 .AND. I.LE.N) GO TO 80 + 50 IERROR = IERROR + 1 + IW(K) = 0 + IF (IERROR.LE.1 .AND. MP.GT.0) WRITE (MP,99999) + IF (IERROR.LE.10 .AND. MP.GT.0) WRITE (MP,99998) K, I, J + GO TO 80 + 60 IF (PERM(J).GT.PERM(I)) GO TO 70 + IQ(J) = IQ(J) + 1 + GO TO 80 + 70 IQ(I) = IQ(I) + 1 + 80 CONTINUE + IF (IERROR.GE.1) THEN + IF (mod(IFLAG,2) .EQ. 0) IFLAG = IFLAG+1 + ENDIF + IWFR = 1 + LBIG = 0 + DO 100 I=1,N + L = IQ(I) + LBIG = max0(L,LBIG) + IWFR = IWFR + L + IPE(I) = IWFR - 1 + 100 CONTINUE + DO 140 K=1,NZ + I = -IW(K) + IF (I.LE.0) GO TO 140 + L = K + IW(K) = 0 + DO 130 ID=1,NZ + J = ICN(L) + IF (PERM(I).LT.PERM(J)) GO TO 110 + L = IPE(J) + IPE(J) = L - 1 + IN = IW(L) + IW(L) = I + GO TO 120 + 110 L = IPE(I) + IPE(I) = L - 1 + IN = IW(L) + IW(L) = J + 120 I = -IN + IF (I.LE.0) GO TO 140 + 130 CONTINUE + 140 CONTINUE + K = IWFR - 1 + L = K + N + IWFR = L + 1 + DO 170 I=1,N + FLAG(I) = 0 + J = N + 1 - I + LEN = IQ(J) + IF (LEN.LE.0) GO TO 160 + DO 150 JDUMMY=1,LEN + IW(L) = IW(K) + K = K - 1 + L = L - 1 + 150 CONTINUE + 160 IPE(J) = L + L = L - 1 + 170 CONTINUE + IF (LBIG.GE.IOVFLO) GO TO 190 + DO 180 I=1,N + K = IPE(I) + IW(K) = IQ(I) + IF (IQ(I).EQ.0) IPE(I) = 0 + 180 CONTINUE + GO TO 230 + 190 IWFR = 1 + DO 220 I=1,N + K1 = IPE(I) + 1 + K2 = IPE(I) + IQ(I) + IF (K1.LE.K2) GO TO 200 + IPE(I) = 0 + GO TO 220 + 200 IPE(I) = IWFR + IWFR = IWFR + 1 + DO 210 K=K1,K2 + J = IW(K) + IF (FLAG(J).EQ.I) GO TO 210 + IW(IWFR) = J + IWFR = IWFR + 1 + FLAG(J) = I + 210 CONTINUE + K = IPE(I) + IW(K) = IWFR - K - 1 + 220 CONTINUE + 230 RETURN +99999 FORMAT (' *** WARNING MESSAGE FROM CMUMPS_198 ***' ) +99998 FORMAT (I6, ' NON-ZERO (IN ROW, I6, 11H AND COLUMN ', I6, + & ') IGNORED') + END SUBROUTINE CMUMPS_198 + SUBROUTINE CMUMPS_194(N, IPE, IW, LW, IWFR,NCMPA) + INTEGER N,LW,IWFR,NCMPA + INTEGER IPE(N) + INTEGER IW(LW) + INTEGER I,K1,LWFR,IR,K,K2 + NCMPA = NCMPA + 1 + DO 10 I=1,N + K1 = IPE(I) + IF (K1.LE.0) GO TO 10 + IPE(I) = IW(K1) + IW(K1) = -I + 10 CONTINUE + IWFR = 1 + LWFR = IWFR + DO 60 IR=1,N + IF (LWFR.GT.LW) GO TO 70 + DO 20 K=LWFR,LW + IF (IW(K).LT.0) GO TO 30 + 20 CONTINUE + GO TO 70 + 30 I = -IW(K) + IW(IWFR) = IPE(I) + IPE(I) = IWFR + K1 = K + 1 + K2 = K + IW(IWFR) + IWFR = IWFR + 1 + IF (K1.GT.K2) GO TO 50 + DO 40 K=K1,K2 + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + 40 CONTINUE + 50 LWFR = K2 + 1 + 60 CONTINUE + 70 RETURN + END SUBROUTINE CMUMPS_194 +#if defined(OLDDFS) + SUBROUTINE CMUMPS_200(N, IPE, NV, IPS, NE, NA, NFSIZ, + & NSTEPS, + & FILS, FRERE,NDD,NEMIN, KEEP60) + INTEGER N,NSTEPS + INTEGER NDD(N) + INTEGER FILS(N), FRERE(N) + INTEGER IPS(N), NE(N), NA(N), NFSIZ(N) + INTEGER IPE(N), NV(N) + INTEGER NEMIN, KEEP60 + INTEGER I,IF,IS,NR,NR1,INS,INL,INB,INF,INFS,INSW + INTEGER K,L,ISON,IN,INP,IFSON,INC,INO + INTEGER INOS,IB,IL + DO 10 I=1,N + IPS(I) = 0 + NE(I) = 0 + 10 CONTINUE + DO 20 I=1,N + IF (NV(I).GT.0) GO TO 20 + IF = -IPE(I) + IS = -IPS(IF) + IF (IS.GT.0) IPE(I) = IS + IPS(IF) = -I + 20 CONTINUE + NR = N + 1 + DO 50 I=1,N + IF (NV(I).LE.0) GO TO 50 + IF = -IPE(I) + IF (IF.NE.0) THEN + IS = -IPS(IF) + IF (IS.GT.0) IPE(I) = IS + IPS(IF) = -I + ELSE + NR = NR - 1 + NE(NR) = I + ENDIF + 50 CONTINUE + DO 999 I=1,N + FILS(I) = IPS(I) + 999 CONTINUE + NR1 = NR + INS = 0 + 1000 IF (NR1.GT.N) GO TO 1151 + INS = NE(NR1) + NR1 = NR1 + 1 + 1070 INL = FILS(INS) + IF (INL.LT.0) THEN + INS = -INL + GO TO 1070 + ENDIF + 1080 IF (IPE(INS).LT.0) THEN + INS = -IPE(INS) + FILS(INS) = 0 + GO TO 1080 + ENDIF + IF (IPE(INS).EQ.0) THEN + INS = 0 + GO TO 1000 + ENDIF + INB = IPE(INS) + IF (NV(INB).EQ.0) THEN + INS = INB + GO TO 1070 + ENDIF + IF (NV(INB).GE.NV(INS)) THEN + INS = INB + GO TO 1070 + ENDIF + INF = INB + 1090 INF = IPE(INF) + IF (INF.GT.0) GO TO 1090 + INF = -INF + INFS = -FILS(INF) + IF (INFS.EQ.INS) THEN + FILS(INF) = -INB + IPS(INF) = -INB + IPE(INS) = IPE(INB) + IPE(INB) = INS + INS = INB + GO TO 1070 + ENDIF + INSW = INFS + 1100 INFS = IPE(INSW) + IF (INFS.NE.INS) THEN + INSW = INFS + GO TO 1100 + ENDIF + IPE(INS) = IPE(INB) + IPE(INB) = INS + IPE(INSW)= INB + INS =INB + GO TO 1070 + 1151 CONTINUE + DO 51 I=1,N + FRERE(I) = IPE(I) + FILS(I) = IPS(I) + 51 CONTINUE + IS = 1 + I = 0 + IL = 0 + DO 160 K=1,N + IF (I.GT.0) GO TO 60 + I = NE(NR) + NE(NR) = 0 + NR = NR + 1 + IL = N + NA(N) = 0 + 60 DO 70 L=1,N + IF (IPS(I).GE.0) GO TO 80 + ISON = -IPS(I) + IPS(I) = 0 + I = ISON + IL = IL - 1 + NA(IL) = 0 + 70 CONTINUE + 80 IPS(I) = K + NE(IS) = NE(IS) + 1 + IF (NV(I).GT.0) GO TO 89 + IN = I + 81 IN = FRERE(IN) + IF (IN.GT.0) GO TO 81 + IF = -IN + IN = IF + 82 INL = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 82 + IFSON = -IN + FILS(INL) = I + IN = I + 83 INP = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 83 + IF (IFSON .EQ. I) GO TO 86 + FILS(INP) = -IFSON + IN = IFSON + 84 INC =IN + IN = FRERE(IN) + IF (IN.NE.I) GO TO 84 + FRERE(INC) = FRERE(I) + GO TO 120 + 86 IF (FRERE(I).LT.0) FILS(INP) = 0 + IF (FRERE(I).GT.0) FILS(INP) = -FRERE(I) + GO TO 120 + 89 IF (IL.LT.N) NA(IL+1) = NA(IL+1) + 1 + NA(IS) = NA(IL) + NDD(IS) = NV(I) + NFSIZ(I) = NV(I) + IF (NA(IS).LT.1) GO TO 110 + IF ( (KEEP60.NE.0).AND. + & (NE(IS).EQ.NDD(IS)) ) GOTO 110 + IF (NDD(IS-1)-NE(IS-1).EQ.NDD(IS)) GO TO 100 + IF ((NE(IS-1).GE.NEMIN).AND. + & (NE(IS).GE.NEMIN) ) GO TO 110 + IF (2*NE(IS-1)*(NDD(IS)-NDD(IS-1)+NE(IS-1)).GE. + & ((NDD(IS)+NE(IS-1))* + & (NDD(IS)+NE(IS-1))*NEMIN/100)) GO TO 110 + 100 NA(IS-1) = NA(IS-1) + NA(IS) - 1 + NDD(IS-1) = NDD(IS) + NE(IS-1) + NE(IS-1) = NE(IS) + NE(IS-1) + NE(IS) = 0 + IN=I + 101 INL = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 101 + IFSON = -IN + IN = IFSON + 102 INO = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 102 + FILS(INL) = INO + NFSIZ(I) = NDD(IS-1) + IN = INO + 103 INP = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 103 + INOS = -IN + IF (IFSON.EQ.INO) GO TO 107 + IN = IFSON + FILS(INP) = -IFSON + 105 INS = IN + IN = FRERE(IN) + IF (IN.NE.INO) GO TO 105 + IF (INOS.EQ.0) FRERE(INS) = -I + IF (INOS.NE.0) FRERE(INS) = INOS + IF (INOS.EQ.0) GO TO 109 + 107 IN = INOS + IF (IN.EQ.0) GO TO 109 + 108 INT = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 108 + FRERE(INT) = -I + 109 CONTINUE + GO TO 120 + 110 IS = IS + 1 + 120 IB = IPE(I) + IF (IB.LT.0) GOTO 150 + IF (IB.EQ.0) GOTO 140 + NA(IL) = 0 + 140 I = IB + GO TO 160 + 150 I = -IB + IL = IL + 1 + 160 CONTINUE + NSTEPS = IS - 1 + DO 170 I=1,N + K = FILS(I) + IF (K.GT.0) THEN + FRERE(K) = N + 1 + NFSIZ(K) = 0 + ENDIF + 170 CONTINUE + RETURN + END SUBROUTINE CMUMPS_200 +#else + SUBROUTINE CMUMPS_557(N, IPE, NV, IPS, NE, NA, NFSIZ, + & NODE, NSTEPS, + & FILS, FRERE, ND, NEMIN, SUBORD, KEEP60, + & KEEP20, KEEP38, NAMALG,NAMALGMAX, + & CUMUL,KEEP50, ICNTL13, KEEP37, NSLAVES, + & ALLOW_AMALG_TINY_NODES) + IMPLICIT NONE + INTEGER N, NSTEPS, KEEP60, KEEP20, KEEP38, KEEP50 + INTEGER ND(N), NFSIZ(N) + INTEGER IPE(N), FILS(N), FRERE(N), SUBORD(N) + INTEGER NV(N), IPS(N), NE(N), NA(N), NODE(N) + INTEGER NEMIN,AMALG_COUNT + INTEGER NAMALG(N),NAMALGMAX, CUMUL(N) + DOUBLE PRECISION ACCU, FLOPS_FATHER, FLOPS_SON, + & FLOPS_AVANT, FLOPS_APRES + INTEGER ICNTL13, KEEP37, NSLAVES + LOGICAL ALLOW_AMALG_TINY_NODES +#if defined(NOAMALGTOFATHER) +#else +#endif + INTEGER I,IF,IS,NR,INS + INTEGER K,L,ISON,IN,IFSON,INO + INTEGER INOS,IB,IL + INTEGER IPERM +#if defined(NOAMALGTOFATHER) + INTEGER INB,INF,INFS,INL,INSW,INT,NR1 +#else + INTEGER DADI + LOGICAL AMALG_TO_father_OK +#endif + AMALG_COUNT = 0 + DO 10 I=1,N + CUMUL(I)= 0 + IPS(I) = 0 + NE(I) = 0 + NODE(I) = 1 + SUBORD(I) = 0 + NAMALG(I) = 0 + 10 CONTINUE + FRERE(1:N) = IPE(1:N) + NR = N + 1 + DO 50 I=1,N + IF = -FRERE(I) + IF (NV(I).EQ.0) THEN + IF (SUBORD(IF).NE.0) SUBORD(I) = SUBORD(IF) + SUBORD(IF) = I + NODE(IF) = NODE(IF)+1 + ELSE + IF (IF.NE.0) THEN + IS = -IPS(IF) + IF (IS.GT.0) FRERE(I) = IS + IPS(IF) = -I + ELSE + NR = NR - 1 + NE(NR) = I + ENDIF + ENDIF + 50 CONTINUE +#if defined(NOAMALGTOFATHER) + DO 999 I=1,N + FILS(I) = IPS(I) + 999 CONTINUE + NR1 = NR + INS = 0 + 1000 IF (NR1.GT.N) GO TO 1151 + INS = NE(NR1) + NR1 = NR1 + 1 + 1070 INL = FILS(INS) + IF (INL.LT.0) THEN + INS = -INL + GO TO 1070 + ENDIF + 1080 IF (FRERE(INS).LT.0) THEN + INS = -FRERE(INS) + FILS(INS) = 0 + GO TO 1080 + ENDIF + IF (FRERE(INS).EQ.0) THEN + INS = 0 + GO TO 1000 + ENDIF + INB = FRERE(INS) + IF (NV(INB).GE.NV(INS)) THEN + INS = INB + GO TO 1070 + ENDIF + INF = INB + 1090 INF = FRERE(INF) + IF (INF.GT.0) GO TO 1090 + INF = -INF + INFS = -FILS(INF) + IF (INFS.EQ.INS) THEN + FILS(INF) = -INB + IPS(INF) = -INB + FRERE(INS) = FRERE(INB) + FRERE(INB) = INS + ELSE + INSW = INFS + 1100 INFS = FRERE(INSW) + IF (INFS.NE.INS) THEN + INSW = INFS + GO TO 1100 + ENDIF + FRERE(INS) = FRERE(INB) + FRERE(INB) = INS + FRERE(INSW)= INB + ENDIF + INS = INB + GO TO 1070 +#endif + DO 51 I=1,N + FILS(I) = IPS(I) + 51 CONTINUE + IS = 1 + I = 0 + IPERM = 1 + DO 160 K=1,N + AMALG_TO_father_OK=.FALSE. + IF (I.LE.0) THEN + IF (NR.GT.N) EXIT + I = NE(NR) + NE(NR) = 0 + NR = NR + 1 + IL = N + NA(N) = 0 + ENDIF + DO 70 L=1,N + IF (IPS(I).GE.0) EXIT + ISON = -IPS(I) + IPS(I) = 0 + I = ISON + IL = IL - 1 + NA(IL) = 0 + 70 CONTINUE +#if ! defined(NOAMALGTOFATHER) + DADI = -IPE(I) + IF ( (DADI.NE.0) .AND. + & ( + & (KEEP60.EQ.0).OR. + & ( (KEEP20.NE.DADI).AND.(KEEP38.NE.DADI) ) + & ) + & ) THEN + ACCU = + & ( dble(20000)* + & dble(NODE(I))*dble(NV(DADI)-NV(I)+NODE(I)) + & ) + & / + & ( dble(NV(DADI)+NODE(I))* + & dble(NV(DADI)+NODE(I)) ) + ACCU = ACCU + dble(CUMUL(I) ) + AMALG_TO_father_OK = ( (NODE(I).LE.NEMIN).OR. + & (NODE(DADI).LE.NEMIN) ) + AMALG_TO_father_OK = ( AMALG_TO_father_OK .AND. + & ( + & ( dble(2*(NODE(I)))* + & dble((NV(DADI)-NV(I)+NODE(I))) + & ) .LT. + & ( dble(NV(DADI)+NODE(I))* + & dble(NV(DADI)+NODE(I))*dble(NEMIN)/dble(100) + & ) + & ) ) + AMALG_TO_father_OK = ( AMALG_TO_father_OK .AND. + & ( ACCU .LE. dble(NEMIN)*dble(100) ) + & ) + IF (AMALG_TO_father_OK) THEN + CALL MUMPS_511(NV(I),NODE(I),NODE(I), + & KEEP50,1,FLOPS_SON) + CALL MUMPS_511(NV(DADI),NODE(DADI), + & NODE(DADI), + & KEEP50,1,FLOPS_FATHER) + FLOPS_AVANT = FLOPS_FATHER+FLOPS_SON + & + max(dble(200.0) * dble(NV(I)-NODE(I)) + & * dble(NV(I)-NODE(I)), + & dble(10000.0)) + CALL MUMPS_511(NV(DADI)+NODE(I), + & NODE(DADI)+NODE(I), + & NODE(DADI)+NODE(I), + & KEEP50,1,FLOPS_APRES) + IF(FLOPS_APRES .GT. FLOPS_AVANT) THEN + AMALG_TO_father_OK = .FALSE. + ENDIF + ENDIF + IF ( (NV(I).GT. 50*NV(DADI)).AND. (NSLAVES.GT.1) + & .AND. (ICNTL13.LE.0) + & .AND. (NV(I).GT. KEEP37) ) THEN + AMALG_TO_father_OK = .TRUE. + ENDIF + IF ( ALLOW_AMALG_TINY_NODES .AND. + & NODE(I) * 900 .LE. NV(DADI) - NAMALG(DADI)) THEN + IF ( NAMALG(DADI) < (NV(DADI)-NAMALG(DADI))/50 ) THEN + AMALG_TO_father_OK = .TRUE. + NAMALG(DADI) = NAMALG(DADI) + NODE(I) + ENDIF + ENDIF + AMALG_TO_father_OK = ( AMALG_TO_father_OK .OR. + & ( NV(I)-NODE(I).EQ.NV(DADI)) ) + IF (AMALG_TO_father_OK) THEN + CUMUL(DADI)=CUMUL(DADI)+nint(ACCU) + NAMALG(DADI) = NAMALG(DADI) + NAMALG(I) + AMALG_COUNT = AMALG_COUNT+1 + IN = DADI + 75 IF (SUBORD(IN).EQ.0) GOTO 76 + IN = SUBORD(IN) + GOTO 75 + 76 CONTINUE + SUBORD(IN) = I + NV(I) = 0 + IFSON = -FILS(DADI) + IF (IFSON.EQ.I) THEN + IF (FILS(I).LT.0) THEN + FILS(DADI) = FILS(I) + GOTO 78 + ELSE + IF (FRERE(I).GT.0) THEN + FILS(DADI) = -FRERE(I) + ELSE + FILS(DADI) = 0 + ENDIF + GOTO 90 + ENDIF + ENDIF + IN = IFSON + 77 INS = IN + IN = FRERE(IN) + IF (IN.NE.I) GOTO 77 + IF (FILS(I) .LT.0) THEN + FRERE(INS) = -FILS(I) + ELSE + FRERE(INS) = FRERE(I) + GOTO 90 + ENDIF + 78 CONTINUE + IN = -FILS(I) + 79 INO = IN + IN = FRERE(IN) + IF (IN.GT.0) GOTO 79 + FRERE(INO) = FRERE(I) + 90 CONTINUE + NODE(DADI) = NODE(DADI)+ NODE(I) + NV(DADI) = NV(DADI) + NODE(I) + NA(IL+1) = NA(IL+1) + NA(IL) + GOTO 120 + ENDIF + ENDIF +#endif + NE(IS) = NE(IS) + NODE(I) + IF (IL.LT.N) NA(IL+1) = NA(IL+1) + 1 + NA(IS) = NA(IL) + ND(IS) = NV(I) + NODE(I) = IS + IPS(I) = IPERM + IPERM = IPERM + 1 + IN = I + 777 IF (SUBORD(IN).EQ.0) GO TO 778 + IN = SUBORD(IN) + NODE(IN) = IS + IPS(IN) = IPERM + IPERM = IPERM + 1 + GO TO 777 + 778 IF (NA(IS).LE.0) GO TO 110 +#if defined(NOAMALGTOFATHER) + IF ( (KEEP60.NE.0).AND. + & (NE(IS).EQ.ND(IS)) ) GOTO 110 + IF (ND(IS-1)-NE(IS-1).EQ.ND(IS)) THEN + GO TO 100 + ENDIF + IF(NAMALG(IS-1) .GE. NAMALGMAX) THEN + GOTO 110 + ENDIF + IF ((NE(IS-1).GE.NEMIN).AND. + & (NE(IS).GE.NEMIN) ) GO TO 110 + IF (2*NE(IS-1)*(ND(IS)-ND(IS-1)+NE(IS-1)).GE. + & ((ND(IS)+NE(IS-1))* + & (ND(IS)+NE(IS-1))*NEMIN/100)) GO TO 110 + NAMALG(IS-1) = NAMALG(IS-1)+1 + 100 NA(IS-1) = NA(IS-1) + NA(IS) - 1 + ND(IS-1) = ND(IS) + NE(IS-1) + NE(IS-1) = NE(IS) + NE(IS-1) + NE(IS) = 0 + NODE(I) = IS-1 + IFSON = -FILS(I) + IN = IFSON + 102 INO = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 102 + NV(INO) = 0 + IN = I + 888 IF (SUBORD(IN).EQ.0) GO TO 889 + IN = SUBORD(IN) + GO TO 888 + 889 SUBORD(IN) = INO + INOS = -FILS(INO) + IF (IFSON.EQ.INO) THEN + FILS(I) = -INOS + GO TO 107 + ENDIF + IN = IFSON + 105 INS = IN + IN = FRERE(IN) + IF (IN.NE.INO) GO TO 105 + IF (INOS.EQ.0) THEN + FRERE(INS) = -I + GO TO 120 + ELSE + FRERE(INS) = INOS + ENDIF + 107 IN = INOS + IF (IN.EQ.0) GO TO 120 + 108 INT = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 108 + FRERE(INT) = -I + GO TO 120 +#endif + 110 IS = IS + 1 + 120 IB = FRERE(I) + IF (IB.GE.0) THEN + IF (IB.GT.0) NA(IL) = 0 + I = IB + ELSE + I = -IB + IL = IL + 1 + ENDIF + 160 CONTINUE + NSTEPS = IS - 1 + DO I=1, N + IF (NV(I).EQ.0) THEN + FRERE(I) = N+1 + NFSIZ(I) = 0 + ELSE + NFSIZ(I) = ND(NODE(I)) + IF (SUBORD(I) .NE.0) THEN + INOS = -FILS(I) + INO = I + DO WHILE (SUBORD(INO).NE.0) + IS = SUBORD(INO) + FILS(INO) = IS + INO = IS + END DO + FILS(INO) = -INOS + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_557 +#endif + SUBROUTINE CMUMPS_201(NE, ND, NSTEPS, + & MAXFR, MAXELIM, K50, MAXFAC, MAXNPIV, + & K5,K6,PANEL_SIZE,K253) + IMPLICIT NONE + INTEGER NSTEPS,MAXNPIV + INTEGER MAXFR, MAXELIM, K50, MAXFAC + INTEGER K5,K6,PANEL_SIZE,K253 + INTEGER NE(NSTEPS), ND(NSTEPS) + INTEGER ITREE, NFR, NELIM + INTEGER LKJIB + LKJIB = max(K5,K6) + MAXFR = 0 + MAXFAC = 0 + MAXELIM = 0 + MAXNPIV = 0 + PANEL_SIZE = 0 + DO ITREE=1,NSTEPS + NELIM = NE(ITREE) + NFR = ND(ITREE) + K253 + IF (NFR.GT.MAXFR) MAXFR = NFR + IF (NFR-NELIM.GT.MAXELIM) MAXELIM = NFR - NELIM + IF (NELIM .GT. MAXNPIV) THEN + IF(NFR .NE. NELIM) MAXNPIV = NELIM + ENDIF + IF (K50.EQ.0) THEN + MAXFAC = max(MAXFAC, (2*NFR - NELIM)*NELIM ) + PANEL_SIZE = max(PANEL_SIZE, NFR*(LKJIB+1)) + ELSE + MAXFAC = max(MAXFAC, NFR * NELIM) + PANEL_SIZE = max(PANEL_SIZE, NELIM*(LKJIB+1)) + PANEL_SIZE = max(PANEL_SIZE, (NFR-NELIM)*(LKJIB+1)) + ENDIF + END DO + RETURN + END SUBROUTINE CMUMPS_201 + SUBROUTINE CMUMPS_348( N, FILS, FRERE, + & NSTK, NA ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: N + INTEGER, INTENT(IN) :: FILS(N), FRERE(N) + INTEGER, INTENT(INOUT) :: NSTK(N), NA(N) + INTEGER NBROOT, NBLEAF, ILEAF, I, IN, ISON + NA = 0 + NSTK = 0 + NBROOT = 0 + ILEAF = 1 + DO 11 I=1,N + IF (FRERE(I).EQ. N+1) CYCLE + IF (FRERE(I).EQ.0) NBROOT = NBROOT + 1 + IN = I + 12 IN = FILS(IN) + IF (IN.GT.0) GO TO 12 + IF (IN.EQ.0) THEN + NA(ILEAF) = I + ILEAF = ILEAF + 1 + CYCLE + ENDIF + ISON = -IN + 13 NSTK(I) = NSTK(I) + 1 + ISON = FRERE(ISON) + IF (ISON.GT.0) GO TO 13 + 11 CONTINUE + NBLEAF = ILEAF-1 + IF (N.GT.1) THEN + IF (NBLEAF.GT.N-2) THEN + IF (NBLEAF.EQ.N-1) THEN + NA(N-1) = -NA(N-1)-1 + NA(N) = NBROOT + ELSE + NA(N) = -NA(N)-1 + ENDIF + ELSE + NA(N-1) = NBLEAF + NA(N) = NBROOT + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_348 + SUBROUTINE CMUMPS_203( N, NZ, MTRANS, PERM, + & id, ICNTL, INFO) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (CMUMPS_STRUC) :: id + INTEGER N, NZ, LIWG + INTEGER PERM(N) + INTEGER MTRANS + INTEGER ICNTL(40), INFO(40) + INTEGER allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: IW + REAL, ALLOCATABLE, DIMENSION(:) :: S2 + TARGET :: S2 + INTEGER LS2,LSC + INTEGER ICNTL64(10), INFO64(10) + INTEGER ICNTL_SYM_MWM(10),INFO_SYM_MWM(10) + REAL CNTL64(10) + INTEGER LDW, LDWMIN + INTEGER MPRINT,LP, MP, IPIW, LIW, LIWMIN + INTEGER JPERM + INTEGER NUMNZ, I, J, JPOS, K, NZREAL + INTEGER PLENR, IP, IRNW,RSPOS,CSPOS + LOGICAL PROK, IDENT, DUPPLI + INTEGER NZTOT, K50, KER_SIZE, NZER_DIAG, MTRANSLOC,RZ_DIAG + LOGICAL SCALINGLOC + INTEGER,POINTER,DIMENSION(:) :: ZERODIAG + INTEGER,POINTER,DIMENSION(:) :: STR_KER + INTEGER,POINTER,DIMENSION(:) :: MARKED + INTEGER,POINTER,DIMENSION(:) :: FLAG + INTEGER,POINTER,DIMENSION(:) :: PIV_OUT + REAL THEMIN, THEMAX, COLNORM,MAXDBL + REAL ZERO,TWO,ONE + PARAMETER(ZERO = 0.0E0,TWO = 2.0E0,ONE = 1.0E0) + MPRINT = ICNTL(3) + LP = ICNTL(1) + MP = ICNTL(2) + PROK = (MPRINT.GT.0) + IF (PROK) WRITE(MPRINT,101) + 101 FORMAT(/'****** Preprocessing of original matrix '/) + K50 = id%KEEP(50) + SCALINGLOC = .FALSE. + IF(id%KEEP(52) .EQ. -2) THEN + IF(.not.associated(id%A)) THEN + INFO(1) = -22 + INFO(2) = 4 + GOTO 500 + ELSE + SCALINGLOC = .TRUE. + ENDIF + ELSE IF(id%KEEP(52) .EQ. 77) THEN + SCALINGLOC = .TRUE. + IF(K50 .NE. 2) THEN + IF( MTRANS .NE. 5 .AND. MTRANS .NE. 6 + & .AND. MTRANS .NE. 7) THEN + SCALINGLOC = .FALSE. + IF (PROK) + & WRITE(MPRINT,*) 'Analysis: auto scaling set OFF' + ENDIF + ENDIF + IF(.not.associated(id%A)) THEN + SCALINGLOC = .FALSE. + IF (PROK) + & WRITE(MPRINT,*) 'Analysis: auto scaling set OFF' + ENDIF + ENDIF + IF(SCALINGLOC) THEN + IF (PROK) WRITE(MPRINT,*) + & 'Scaling will be computed during analysis' + ENDIF + MTRANSLOC = MTRANS + IF (MTRANS.LT.0 .OR. MTRANS.GT.7) GO TO 500 + IF (K50 .EQ. 0) THEN + IF(.NOT. SCALINGLOC .AND. MTRANS .EQ. 7) THEN + GO TO 500 + ENDIF + IF(SCALINGLOC) THEN + MTRANSLOC = 5 + ENDIF + ELSE + IF (MTRANS .EQ. 7) MTRANSLOC = 5 + ENDIF + IF(SCALINGLOC .AND. MTRANSLOC .NE. 5 .AND. + & MTRANSLOC .NE. 6 ) THEN + IF (PROK) WRITE(MPRINT,*) + & 'WARNING scaling required: set MTRANS option to 5' + MTRANSLOC = 5 + ENDIF + IF (N.EQ.1) THEN + MTRANS=0 + GO TO 500 + ENDIF + IF(K50 .EQ. 2) THEN + NZTOT = 2*NZ+N + ELSE + NZTOT = NZ + ENDIF + ZERODIAG => id%IS1(N+1:2*N) + STR_KER => id%IS1(2*N+1:3*N) + CALL CMUMPS_448(ICNTL64,CNTL64) + ICNTL64(1) = ICNTL(1) + ICNTL64(2) = ICNTL(2) + ICNTL64(3) = ICNTL(2) + ICNTL64(4) = -1 + IF (ICNTL(4).EQ.3) ICNTL64(4) = 0 + IF (ICNTL(4).EQ.4) ICNTL64(4) = 1 + ICNTL64(5) = -1 + IF (PROK) THEN + WRITE(MPRINT,'(A,I3)') + & 'Compute maximum matching (Maximum Transversal):', + & MTRANSLOC + IF (MTRANSLOC.EQ.1) + & WRITE(MPRINT,'(A,I3)')' ... JOB =',MTRANSLOC + IF (MTRANSLOC.EQ.2) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC,': BOTTLENECK THESIS' + IF (MTRANSLOC.EQ.3) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC,': BOTTLENECK SIMAX' + IF (MTRANSLOC.EQ.4) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC,': MAXIMIZE SUM DIAGIONAL' + IF (MTRANSLOC.EQ.5 .OR. MTRANSLOC.EQ.6) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC, + & ': MAXIMIZE PRODUCT DIAGONAL AND SCALE' + ENDIF + id%INFOG(23) = MTRANSLOC + CNTL64(2) = huge(CNTL64(2)) + IRNW = 1 + IP = IRNW + NZTOT + PLENR = IP + N + 1 + IPIW = PLENR + IF (MTRANSLOC.EQ.1) LIWMIN = 5*N + IF (MTRANSLOC.EQ.2) LIWMIN = 4*N + IF (MTRANSLOC.EQ.3) LIWMIN = 10*N + NZTOT + IF (MTRANSLOC.EQ.4) LIWMIN = 5*N + IF (MTRANSLOC.EQ.5) LIWMIN = 5*N + IF (MTRANSLOC.EQ.6) LIWMIN = 5*N + NZTOT + LIW = LIWMIN + LIWG = LIW + (NZTOT + N + 1) + ALLOCATE(IW(LIWG), stat=allocok) + IF (allocok .GT. 0 ) GOTO 410 + IF (MTRANSLOC.EQ.1) THEN + LDWMIN = N+3 + ENDIF + IF (MTRANSLOC.EQ.2) LDWMIN = max(N+NZTOT,N+3) + IF (MTRANSLOC.EQ.3) LDWMIN = max(NZTOT+1,N+3) + IF (MTRANSLOC.EQ.4) LDWMIN = 2*N + max(NZTOT,N+3) + IF (MTRANSLOC.EQ.5) LDWMIN = 3*N + NZTOT + IF (MTRANSLOC.EQ.6) LDWMIN = 4*N + NZTOT + LDW = LDWMIN + ALLOCATE(S2(LDW), stat=allocok) + IF(MTRANSLOC .NE. 1) LDW = LDW-NZTOT + RSPOS = NZTOT + CSPOS = RSPOS+N + IF (allocok .GT. 0 ) GOTO 430 + NZREAL = 0 + DO 5 J=1,N + IW(PLENR+J-1) = 0 + 5 CONTINUE + IF(K50 .EQ. 0) THEN + DO 10 K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1).AND. + & (I.LE.N).AND.(I.GE.1) ) THEN + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + NZREAL = NZREAL + 1 + ENDIF + 10 CONTINUE + ELSE + ZERODIAG = 0 + NZER_DIAG = N + RZ_DIAG = 0 + DO K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1).AND. + & (I.LE.N).AND.(I.GE.1) ) THEN + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + NZREAL = NZREAL + 1 + IF(I .NE. J) THEN + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + NZREAL = NZREAL + 1 + ELSE + IF(ZERODIAG(I) .EQ. 0) THEN + ZERODIAG(I) = K + IF(associated(id%A)) THEN + IF(abs(id%A(K)) .EQ. real(0.0E0)) THEN + RZ_DIAG = RZ_DIAG + 1 + ENDIF + ENDIF + NZER_DIAG = NZER_DIAG - 1 + ENDIF + ENDIF + ENDIF + ENDDO + IF(MTRANSLOC .GE. 4) THEN + DO I =1, N + IF(ZERODIAG(I) .EQ. 0) THEN + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + NZREAL = NZREAL + 1 + ENDIF + ENDDO + ENDIF + ENDIF + IW(IP) = 1 + DO 20 J=1,N + IW(IP+J) = IW(IP+J-1)+IW(PLENR+J-1) + 20 CONTINUE + DO 25 J=1, N + IW(PLENR+J-1 ) = IW(IP+J-1 ) + 25 CONTINUE + IF(K50 .EQ. 0) THEN + IF (MTRANSLOC.EQ.1) THEN + DO 30 K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + ENDIF + 30 CONTINUE + ELSE + IF ( .not.associated(id%A)) THEN + INFO(1) = -22 + INFO(2) = 4 + GOTO 500 + ENDIF + DO 35 K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + S2(JPOS) = abs(id%A(K)) + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + ENDIF + 35 CONTINUE + ENDIF + ELSE + IF (MTRANSLOC.EQ.1) THEN + DO K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + IF(I.NE.J) THEN + JPOS = IW(PLENR+I-1) + IW(IRNW+JPOS-1) = J + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + ENDIF + ENDIF + ENDDO + ELSE + IF ( .not.associated(id%A)) THEN + INFO(1) = -22 + INFO(2) = 4 + GOTO 500 + ENDIF + K = 1 + THEMIN = ZERO + DO + IF(THEMIN .NE. ZERO) EXIT + THEMIN = abs(id%A(K)) + K = K+1 + ENDDO + THEMAX = THEMIN + DO K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + S2(JPOS) = abs(id%A(K)) + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + IF(abs(id%A(K)) .GT. THEMAX) THEN + THEMAX = abs(id%A(K)) + ELSE IF(abs(id%A(K)) .LT. THEMIN + & .AND. abs(id%A(K)).GT. ZERO) THEN + THEMIN = abs(id%A(K)) + ENDIF + IF(I.NE.J) THEN + JPOS = IW(PLENR+I-1) + IW(IRNW+JPOS-1) = J + S2(JPOS) = abs(id%A(K)) + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + ENDIF + ENDIF + ENDDO + DO I =1, N + IF(ZERODIAG(I) .EQ. 0) THEN + JPOS = IW(PLENR+I-1) + IW(IRNW+JPOS-1) = I + S2(JPOS) = ZERO + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + ENDIF + ENDDO + CNTL64(2) = (log(THEMAX/THEMIN))*(real(N)) + & - log(THEMIN) + ONE + ENDIF + ENDIF + DUPPLI = .FALSE. + I = NZREAL + FLAG => id%IS1(3*N+1:4*N) + IF(MTRANSLOC.NE.1) THEN + CALL CMUMPS_563(N,NZREAL,IW(IP),IW(IRNW),S2, + & PERM,FLAG(1)) + ELSE + CALL CMUMPS_562(N,NZREAL,IW(IP),IW(IRNW), + & PERM,FLAG(1)) + ENDIF + IF(NZREAL .NE. I) DUPPLI = .TRUE. + LS2 = NZTOT + IF ( MTRANSLOC .EQ. 1 ) THEN + LS2 = 1 + LDW = 1 + ENDIF + CALL CMUMPS_559(MTRANSLOC ,N, N, NZREAL, + & IW(IP), IW(IRNW), S2(1), LS2, + & NUMNZ, PERM, LIW, IW(IPIW), LDW, S2(LS2+1), + & ICNTL64, CNTL64, INFO64) + IF (INFO64(1).LT.0) THEN + IF (LP.GT.0 .AND. ICNTL(4).GE.1) + & WRITE(LP,'(A,I5)') + & ' INTERNAL ERROR in MAXTRANS INFO(1)=',INFO64(1) + INFO(1) = -9964 + INFO(2) = INFO64(1) + GO TO 500 + ENDIF + IF (INFO64(1).GT.0) THEN + IF (MP.GT.0 .AND. ICNTL(4).GE.2) + & WRITE(MP,'(A,I5)') + & ' WARNING in MAXTRANS INFO(1)=',INFO64(1) + ENDIF + KER_SIZE = 0 + IF(K50 .EQ. 2) THEN + DO I=1,N + IF(ZERODIAG(I) .EQ. 0) THEN + IF(PERM(I) .EQ. I) THEN + KER_SIZE = KER_SIZE + 1 + PERM(I) = -I + STR_KER(KER_SIZE) = I + ENDIF + ENDIF + ENDDO + ENDIF + IF (NUMNZ.LT.N) GO TO 400 + IF(K50 .EQ. 0) THEN + IDENT = .TRUE. + IF (MTRANS .EQ. 0 ) GOTO 102 + DO 80 J=1,N + JPERM = PERM(J) + IW(PLENR+JPERM-1) = J + IF (JPERM.NE.J) IDENT = .FALSE. + 80 CONTINUE + IF(IDENT) THEN + MTRANS = 0 + ELSE + IF(MTRANS .EQ. 7) THEN + MTRANS = -9876543 + GOTO 102 + ENDIF + IF (PROK) WRITE(MPRINT,'(A)') + & ' ... Apply column permutation' + DO 100 K=1,NZ + J = id%JCN(K) + IF ((J.LE.0).OR.(J.GT.N)) GO TO 100 + id%JCN(K) = IW(PLENR+J-1) + 100 CONTINUE + IF (MP.GT.0 .AND. ICNTL(4).GE.2) + & WRITE(MP,'(/A)') + & ' WARNING input matrix data modified' + ENDIF + 102 CONTINUE + IF (SCALINGLOC) THEN + IF ( associated(id%COLSCA)) + & DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) + & DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in CMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of COLSCA' + GOTO 500 + ENDIF + ENDIF + ALLOCATE( id%ROWSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in CMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of ROWSCA' + GOTO 500 + ENDIF + ENDIF + id%KEEP(52) = -2 + id%KEEP(74) = 1 + MAXDBL = log(huge(MAXDBL)) + DO J=1,N + IF(S2(RSPOS+J) .GT. MAXDBL) THEN + S2(RSPOS+J) = ZERO + ENDIF + IF(S2(CSPOS+J) .GT. MAXDBL) THEN + S2(CSPOS+J)= ZERO + ENDIF + ENDDO + DO 105 J=1,N + id%ROWSCA(J) = exp(S2(RSPOS+J)) + IF(id%ROWSCA(J) .EQ. ZERO) THEN + id%ROWSCA(J) = ONE + ENDIF + IF ( MTRANS .EQ. -9876543 .OR. MTRANS.EQ. 0 ) THEN + id%COLSCA(J)= exp(S2(CSPOS+J)) + IF(id%COLSCA(J) .EQ. ZERO) THEN + id%COLSCA(J) = ONE + ENDIF + ELSE + id%COLSCA(IW(PLENR+J-1))= exp(S2(CSPOS+J)) + IF(id%COLSCA(IW(PLENR+J-1)) .EQ. ZERO) THEN + id%COLSCA(IW(PLENR+J-1)) = ONE + ENDIF + ENDIF + 105 CONTINUE + ENDIF + ELSE + IDENT = .FALSE. + IF(SCALINGLOC) THEN + IF ( associated(id%COLSCA)) DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in CMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of COLSCA' + GOTO 500 + ENDIF + ENDIF + ALLOCATE( id%ROWSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in CMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of ROWSCA' + GOTO 500 + ENDIF + ENDIF + id%KEEP(52) = -2 + id%KEEP(74) = 1 + MAXDBL = log(huge(MAXDBL)) + DO J=1,N + IF(S2(RSPOS+J)+S2(CSPOS+J) .GT. MAXDBL) THEN + S2(RSPOS+J) = ZERO + S2(CSPOS+J)= ZERO + ENDIF + ENDDO + DO J=1,N + IF(PERM(J) .GT. 0) THEN + id%ROWSCA(J) = + & exp((S2(RSPOS+J)+S2(CSPOS+J))/TWO) + IF(id%ROWSCA(J) .EQ. ZERO) THEN + id%ROWSCA(J) = ONE + ENDIF + id%COLSCA(J)= id%ROWSCA(J) + ENDIF + ENDDO + DO JPOS=1,KER_SIZE + I = STR_KER(JPOS) + COLNORM = ZERO + DO J = IW(IP+I-1),IW(IP+I) - 1 + IF ( PERM( IW( IRNW+J-1) ) > 0 ) THEN + COLNORM = max(COLNORM,S2(J)) + ENDIF + ENDDO + COLNORM = exp(COLNORM) + id%ROWSCA(I) = ONE / COLNORM + id%COLSCA(I) = id%ROWSCA(I) + ENDDO + ENDIF + IF(MTRANS .EQ. 7 .OR. id%KEEP(95) .EQ. 0) THEN + IF( (NZER_DIAG+RZ_DIAG) .LT. (N/10) + & .AND. id%KEEP(95) .EQ. 0) THEN + MTRANS = 0 + id%KEEP(95) = 1 + GOTO 390 + ELSE + IF(id%KEEP(95) .EQ. 0) THEN + IF(SCALINGLOC) THEN + id%KEEP(95) = 3 + ELSE + id%KEEP(95) = 2 + ENDIF + ENDIF + IF(MTRANS .EQ. 7) MTRANS = 5 + ENDIF + ENDIF + IF(MTRANS .EQ. 0) GOTO 390 + ICNTL_SYM_MWM = 0 + INFO_SYM_MWM = 0 + IF(MTRANS .EQ. 5 .OR. MTRANS .EQ. 6 .OR. + & MTRANS .EQ. 7) THEN + ICNTL_SYM_MWM(1) = 0 + ICNTL_SYM_MWM(2) = 1 + ELSE IF(MTRANS .EQ. 4) THEN + ICNTL_SYM_MWM(1) = 2 + ICNTL_SYM_MWM(2) = 1 + ELSE + ICNTL_SYM_MWM(1) = 0 + ICNTL_SYM_MWM(2) = 1 + ENDIF + MARKED => id%IS1(2*N+1:3*N) + FLAG => id%IS1(3*N+1:4*N) + PIV_OUT => id%IS1(4*N+1:5*N) + IF(MTRANSLOC .LT. 4) THEN + LSC = 1 + ELSE + LSC = 2*N + ENDIF + CALL CMUMPS_551( + & N, NZREAL, IW(IP), IW(IRNW), S2(1),LSC, PERM, + & ZERODIAG(1), + & ICNTL_SYM_MWM, S2(LSC+1),MARKED(1),FLAG(1), + & PIV_OUT(1), INFO_SYM_MWM) + IF(INFO_SYM_MWM(1) .NE. 0) THEN + WRITE(*,*) '** Error in CMUMPS_203' + RETURN + ENDIF + IF(INFO_SYM_MWM(3) .EQ. N) THEN + IDENT = .TRUE. + ELSEIF( (N-INFO_SYM_MWM(4)-INFO_SYM_MWM(3)) .GT. N/10 + & ) THEN + IDENT = .TRUE. + id%KEEP(95) = 1 + ELSE + DO I=1,N + PERM(I) = PIV_OUT(I) + ENDDO + ENDIF + id%KEEP(93) = INFO_SYM_MWM(4) + id%KEEP(94) = INFO_SYM_MWM(3) + IF (IDENT) MTRANS=0 + ENDIF + 390 IF(MTRANS .EQ. 0) THEN + id%KEEP(95) = 1 + IF (PROK) THEN + WRITE (MPRINT,'(A)') + & ' ... Column permutation not used' + ENDIF + ENDIF + GO TO 500 + 400 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) + & WRITE (LP,'(/A)') '** Error: Matrix is structurally singular' + INFO(1) = -6 + INFO(2) = NUMNZ + GOTO 500 + 410 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in CMUMPS_203' + WRITE (LP,'(A,I9)') + & '** Failure during allocation of INTEGER array of size ', + & LIWG + ENDIF + INFO(1) = -5 + INFO(2) = LIWG + GOTO 500 + 430 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in CMUMPS_203' + WRITE (LP,'(A)') '** Failure during allocation of S2' + ENDIF + INFO(1) = -5 + INFO(2) = LDW + 500 CONTINUE + IF (allocated(IW)) DEALLOCATE(IW) + IF (allocated(S2)) DEALLOCATE(S2) + RETURN + END SUBROUTINE CMUMPS_203 + SUBROUTINE CMUMPS_100 + &( MYID, COMM, KEEP,KEEP8, INFO, INFOG, RINFO, RINFOG, ICNTL ) + IMPLICIT NONE + INTEGER COMM, MYID, KEEP(500), INFO(40), ICNTL(40), INFOG(40) + INTEGER(8) KEEP8(150) + REAL RINFO(40), RINFOG(40) + INCLUDE 'mpif.h' + INTEGER MASTER, MPG + PARAMETER( MASTER = 0 ) + MPG = ICNTL(3) + IF ( MYID.eq.MASTER.and.MPG.GT.0) THEN + WRITE(MPG, 99992) INFO(1), INFO(2), + & KEEP8(109), KEEP8(111), INFOG(4), + & INFOG(5), KEEP(28), INFOG(32), INFOG(7), KEEP(23), ICNTL(7), + & KEEP(12), KEEP(56), KEEP(61), RINFOG(1) + IF (KEEP(95).GT.1) + & WRITE(MPG, 99993) KEEP(95) + IF (KEEP(54).GT.0) WRITE(MPG, 99994) KEEP(54) + IF (KEEP(60).GT.0) WRITE(MPG, 99995) KEEP(60) + IF (KEEP(253).GT.0) WRITE(MPG, 99996) KEEP(253) + ENDIF + RETURN +99992 FORMAT(/'Leaving analysis phase with ...'/ + & 'INFOG(1) =',I16/ + & 'INFOG(2) =',I16/ + & ' -- (20) Number of entries in factors (estim.) =',I16/ + & ' -- (3) Storage of factors (REAL, estimated) =',I16/ + & ' -- (4) Storage of factors (INT , estimated) =',I16/ + & ' -- (5) Maximum frontal size (estimated) =',I16/ + & ' -- (6) Number of nodes in the tree =',I16/ + & ' -- (32) Type of analysis effectively used =',I16/ + & ' -- (7) Ordering option effectively used =',I16/ + & 'ICNTL(6) Maximum transversal option =',I16/ + & 'ICNTL(7) Pivot order option =',I16/ + & 'Percentage of memory relaxation (effective) =',I16/ + & 'Number of level 2 nodes =',I16/ + & 'Number of split nodes =',I16/ + & 'RINFOG(1) Operations during elimination (estim)= ',1PD10.3) +99993 FORMAT('Ordering compressed/constrained (ICNTL(12)) =',I16) +99994 FORMAT('Distributed matrix entry format (ICNTL(18)) =',I16) +99995 FORMAT('Effective Schur option (ICNTL(19)) =',I16) +99996 FORMAT('Forward solution during factorization, NRHS =',I16) + END SUBROUTINE CMUMPS_100 + SUBROUTINE CMUMPS_97 + & ( N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, + & KEEP, KEEP8, SPLITROOT, MP, LDIAG, INFO1, INFO2 ) + IMPLICIT NONE + INTEGER N, NSTEPS, NSLAVES, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER FRERE( N ), FILS( N ), NFSIZ( N ) + LOGICAL SPLITROOT + INTEGER MP, LDIAG + INTEGER INFO1, INFO2 + INTEGER, DIMENSION(:), ALLOCATABLE :: IPOOL + INTEGER INODE, DEPTH, I, IBEG, IEND, IIPOOL, NROOT + INTEGER MAX_DEPTH, ISON, TOT_CUT, MAX_CUT, STRAT + INTEGER(8) :: K79 + INTEGER NFRONT, K82, allocok + K79 = KEEP8(79) + K82 = abs(KEEP(82)) + STRAT=KEEP(62) + IF (KEEP(210).EQ.1) THEN + MAX_DEPTH = 2*NSLAVES*K82 + STRAT = STRAT/4 + ELSE + IF (( NSLAVES .eq. 1 ).AND. (.NOT. SPLITROOT) ) RETURN + IF (NSLAVES.EQ.1) THEN + MAX_DEPTH = 1 + ELSE + MAX_DEPTH = int( log( real( NSLAVES - 1 ) ) + & / log(2.0E0) ) + ENDIF + ENDIF + ALLOCATE(IPOOL(NSTEPS+1), stat=allocok) + IF (allocok.GT.0) THEN + INFO1= -7 + INFO2= NSTEPS+1 + RETURN + ENDIF + NROOT = 0 + DO INODE = 1, N + IF ( FRERE(INODE) .eq. 0 ) THEN + NROOT = NROOT + 1 + IPOOL( NROOT ) = INODE + END IF + END DO + IBEG = 1 + IEND = NROOT + IIPOOL = NROOT + 1 + IF (SPLITROOT) MAX_DEPTH=1 + DO DEPTH = 1, MAX_DEPTH + DO I = IBEG, IEND + INODE = IPOOL( I ) + ISON = INODE + DO WHILE ( ISON .GT. 0 ) + ISON = FILS( ISON ) + END DO + ISON = - ISON + DO WHILE ( ISON .GT. 0 ) + IPOOL( IIPOOL ) = ISON + IIPOOL = IIPOOL + 1 + ISON = FRERE( ISON ) + END DO + END DO + IPOOL( IBEG ) = -IPOOL( IBEG ) + IBEG = IEND + 1 + IEND = IIPOOL - 1 + END DO + IPOOL( IBEG ) = -IPOOL( IBEG ) + TOT_CUT = 0 + IF (SPLITROOT) THEN + MAX_CUT = NROOT*max(K82,2) + INODE = abs(IPOOL(1)) + NFRONT = NFSIZ( INODE ) + K79 = max( + & int(NFRONT,8)*int(NFRONT,8)/(int(K82+1,8)*int(K82+1,8)), + & 1_8) + ELSE + MAX_CUT = 2 * NSLAVES + IF (KEEP(210).EQ.1) THEN + MAX_CUT = 4 * (MAX_CUT + 4) + ENDIF + ENDIF + DEPTH = -1 + DO I = 1, IIPOOL - 1 + INODE = IPOOL( I ) + IF ( INODE .LT. 0 ) THEN + INODE = -INODE + DEPTH = DEPTH + 1 + END IF + CALL CMUMPS_313 + & ( INODE, N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, + & KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, + & K79, SPLITROOT, MP, LDIAG ) + IF ( TOT_CUT > MAX_CUT ) EXIT + END DO + KEEP(61) = TOT_CUT + DEALLOCATE(IPOOL) + RETURN + END SUBROUTINE CMUMPS_97 + RECURSIVE SUBROUTINE CMUMPS_313 + & ( INODE, N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, KEEP,KEEP8, + & TOT_CUT, STRAT, DEPTH, K79, SPLITROOT, MP, LDIAG ) + IMPLICIT NONE + INTEGER(8) :: K79 + INTEGER INODE, N, NSTEPS, NSLAVES, KEEP(500), STRAT, + & DEPTH, TOT_CUT, MP, LDIAG + INTEGER(8) KEEP8(150) + INTEGER FRERE( N ), FILS( N ), NFSIZ( N ) + LOGICAL SPLITROOT + INTEGER I, IN, NPIV, NFRONT, NSLAVES_ESTIM + REAL WK_SLAVE, WK_MASTER + INTEGER INODE_SON, INODE_FATH, IN_SON, IN_FATH, IN_GRANDFATH + INTEGER NPIV_SON, NPIV_FATH + INTEGER NCB, NSLAVESMIN, NSLAVESMAX + INTEGER MUMPS_50, + & MUMPS_52 + EXTERNAL MUMPS_50, + & MUMPS_52 + IF ( (KEEP(210).EQ.1.AND.KEEP(60).EQ.0) .OR. + & (SPLITROOT) ) THEN + IF ( FRERE ( INODE ) .eq. 0 ) THEN + NFRONT = NFSIZ( INODE ) + NPIV = NFRONT + NCB = 0 + IF (int(NFRONT,8)*int(NFRONT,8).GT.K79) THEN + GOTO 333 + ENDIF + ENDIF + ENDIF + IF ( FRERE ( INODE ) .eq. 0 ) RETURN + NFRONT = NFSIZ( INODE ) + IN = INODE + NPIV = 0 + DO WHILE( IN > 0 ) + IN = FILS( IN ) + NPIV = NPIV + 1 + END DO + NCB = NFRONT - NPIV + IF ( (NFRONT - (NPIV/2)) .LE. KEEP(9)) RETURN + IF ((KEEP(50) == 0.and.int(NFRONT,8) * int(NPIV,8) > K79 ) .OR. + &(KEEP(50) .NE.0.and.int(NPIV,8) * int(NPIV,8) > K79 )) GOTO 333 + IF (KEEP(210).EQ.1) THEN + NSLAVESMIN = 1 + NSLAVESMAX = 64 + NSLAVES_ESTIM = 32+NSLAVES + ELSE + NSLAVESMIN = MUMPS_50 + & ( NSLAVES, KEEP(48), KEEP8(21), KEEP(50), + & NFRONT, NCB) + NSLAVESMAX = MUMPS_52 + & ( NSLAVES, KEEP(48), KEEP8(21), KEEP(50), + & NFRONT, NCB) + NSLAVES_ESTIM = max (1, + & nint( real(NSLAVESMAX-NSLAVESMIN)/real(3) ) + & ) + NSLAVES_ESTIM = min (NSLAVES_ESTIM, NSLAVES-1) + ENDIF + IF ( KEEP(50) .eq. 0 ) THEN + WK_MASTER = 0.6667E0 * + & real(NPIV)*real(NPIV)*real(NPIV) + + & real(NPIV)*real(NPIV)*real(NCB) + WK_SLAVE = real( NPIV ) * real( NCB ) * + & ( 2.0E0 * real(NFRONT) - real(NPIV) ) + & / real(NSLAVES_ESTIM) + ELSE + WK_MASTER = real(NPIV)*real(NPIV)*real(NPIV) / real(3) + WK_SLAVE = + & (real(NPIV)*real(NCB)*real(NFRONT)) + & / real(NSLAVES_ESTIM) + ENDIF + IF (KEEP(210).EQ.1) THEN + IF ( real( 100 + STRAT ) + & * WK_SLAVE / real(100) .GE. WK_MASTER ) RETURN + ELSE + IF ( real( 100 + STRAT * max( DEPTH-1, 1 ) ) + & * WK_SLAVE / real(100) .GE. WK_MASTER ) RETURN + ENDIF + 333 CONTINUE + IF (NPIV .LE. 1 ) RETURN + NSTEPS = NSTEPS + 1 + TOT_CUT = TOT_CUT + 1 + NPIV_SON = max(NPIV/2,1) + NPIV_FATH = NPIV - NPIV_SON + INODE_SON = INODE + IN_SON = INODE + DO I = 1, NPIV_SON - 1 + IN_SON = FILS( IN_SON ) + END DO + INODE_FATH = FILS( IN_SON ) + IF ( INODE_FATH .LT. 0 ) THEN + write(*,*) 'Error: INODE_FATH < 0 ', INODE_FATH + END IF + IN_FATH = INODE_FATH + DO WHILE ( FILS( IN_FATH ) > 0 ) + IN_FATH = FILS( IN_FATH ) + END DO + FRERE( INODE_FATH ) = FRERE( INODE_SON ) + FRERE( INODE_SON ) = - INODE_FATH + FILS ( IN_SON ) = FILS( IN_FATH ) + FILS ( IN_FATH ) = - INODE_SON + IN = FRERE( INODE_FATH ) + DO WHILE ( IN > 0 ) + IN = FRERE( IN ) + END DO + IF ( IN .eq. 0 ) GO TO 10 + IN = -IN + DO WHILE ( FILS( IN ) > 0 ) + IN = FILS( IN ) + END DO + IN_GRANDFATH = IN + IF ( FILS( IN_GRANDFATH ) .eq. - INODE_SON ) THEN + FILS( IN_GRANDFATH ) = -INODE_FATH + ELSE + IN = IN_GRANDFATH + IN = - FILS ( IN ) + DO WHILE ( FRERE( IN ) > 0 ) + IF ( FRERE( IN ) .eq. INODE_SON ) THEN + FRERE( IN ) = INODE_FATH + GOTO 10 + END IF + IN = FRERE( IN ) + END DO + WRITE(*,*) 'ERROR 2 in SPLIT NODE', + & IN_GRANDFATH, IN, FRERE(IN) + END IF + 10 CONTINUE + NFSIZ(INODE_SON) = NFRONT + NFSIZ(INODE_FATH) = NFRONT - NPIV_SON + KEEP(2) = max( KEEP(2), NFRONT - NPIV_SON ) + CALL CMUMPS_313 + & ( INODE_FATH, N, FRERE, FILS, NFSIZ, NSTEPS, + & NSLAVES, KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, + & K79, SPLITROOT, MP, LDIAG ) + IF (.NOT. SPLITROOT) THEN + CALL CMUMPS_313 + & ( INODE_SON, N, FRERE, FILS, NFSIZ, NSTEPS, + & NSLAVES, KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, + & K79, SPLITROOT, MP, LDIAG ) + ENDIF + RETURN + END SUBROUTINE CMUMPS_313 + SUBROUTINE CMUMPS_351 + & (N,NZ, IRN, ICN, IW, LW, IPE, LEN, + & IQ, FLAG, IWFR, + & NRORM, NIORM, IFLAG,IERROR, ICNTL, + & symmetry, SYM, MedDens, NBQD, AvgDens) + INTEGER N,NZ,LW,IFLAG,IERROR,NRORM,NIORM,IWFR + INTEGER symmetry, SYM + INTEGER MedDens, NBQD, AvgDens + INTEGER ICNTL(40) + INTEGER IRN(NZ), ICN(NZ) + INTEGER LEN(N) + INTEGER IPE(N+1) + INTEGER FLAG(N), IW(LW) + INTEGER IQ(N) + INTEGER MP, MPG + INTEGER I,K,J,N1,LAST,NDUP,K1,K2,L + INTEGER NBERR, THRESH + INTEGER NZOFFA, NDIAGA + REAL RSYM + INTRINSIC nint + MP = ICNTL(2) + MPG= ICNTL(3) + NIORM = 3*N + NDIAGA = 0 + IERROR = 0 + DO 10 I=1,N + IPE(I) = 0 + 10 CONTINUE + DO 50 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + IERROR = IERROR + 1 + ELSE + IF (I.NE.J) THEN + IPE(I) = IPE(I) + 1 + IPE(J) = IPE(J) + 1 + NIORM = NIORM + 1 + ELSE + NDIAGA = NDIAGA + 1 + ENDIF + ENDIF + 50 CONTINUE + NZOFFA = NIORM - 3*N + IF (IERROR.GE.1) THEN + NBERR = 0 + IF (mod(IFLAG,2) .EQ. 0) IFLAG = IFLAG+1 + IF ((MP.GT.0).AND.(ICNTL(4).GE.2)) THEN + WRITE (MP,99999) + DO 70 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + NBERR = NBERR + 1 + IF (NBERR.LE.10) THEN + IF (mod(K,10).GT.3 .OR. mod(K,10).EQ.0 .OR. + & (10.LE.K .AND. K.LE.20)) THEN + WRITE (MP,'(I8,A,I8,A,I8,A)') + & K,'th entry (in row',I,' and column',J,') ignored' + ELSE + IF (mod(K,10).EQ.1) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'st entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.2) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'nd entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.3) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'rd entry (in row',I,' and column',J,') ignored' + ENDIF + ELSE + GO TO 100 + ENDIF + ENDIF + 70 CONTINUE + ENDIF + ENDIF + 100 NRORM = NIORM - 2*N + IQ(1) = 1 + N1 = N - 1 + IF (N1.GT.0) THEN + DO 110 I=1,N1 + IQ(I+1) = IPE(I) + IQ(I) + 110 CONTINUE + ENDIF + LAST = max(IPE(N)+IQ(N)-1,IQ(N)) + FLAG(1:N) = 0 + IPE(1:N) = IQ(1:N) + IW(1:LAST) = 0 + IWFR = LAST + 1 + DO 200 K=1,NZ + I = IRN(K) + J = ICN(K) + IF (I.NE.J) THEN + IF (I.LT.J) THEN + IF ((I.GE.1).AND.(J.LE.N)) THEN + IW(IQ(I)) = -J + IQ(I) = IQ(I) + 1 + ENDIF + ELSE + IF ((J.GE.1).AND.(I.LE.N)) THEN + IW(IQ(J)) = -I + IQ(J) = IQ(J) + 1 + ENDIF + ENDIF + ENDIF + 200 CONTINUE + NDUP = 0 + DO 260 I=1,N + K1 = IPE(I) + K2 = IQ(I) -1 + IF (K1.GT.K2) THEN + LEN(I) = 0 + IQ(I) = 0 + ELSE + DO 240 K=K1,K2 + J = -IW(K) + IF (J.LE.0) GO TO 250 + L = IQ(J) + IQ(J) = L + 1 + IF (FLAG(J).EQ.I) THEN + NDUP = NDUP + 1 + IW(L) = 0 + IW(K) = 0 + ELSE + IW(L) = I + IW(K) = J + FLAG(J) = I + ENDIF + 240 CONTINUE + 250 IQ(I) = IQ(I) - IPE(I) + IF (NDUP.EQ.0) LEN(I) = IQ(I) + ENDIF + 260 CONTINUE + IF (NDUP.NE.0) THEN + IWFR = 1 + DO 280 I=1,N + IF (IQ(I).EQ.0) THEN + LEN(I) = 0 + IPE(I) = IWFR + GOTO 280 + ENDIF + K1 = IPE(I) + K2 = K1 + IQ(I) - 1 + L = IWFR + IPE(I) = IWFR + DO 270 K=K1,K2 + IF (IW(K).NE.0) THEN + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + ENDIF + 270 CONTINUE + LEN(I) = IWFR - L + 280 CONTINUE + ENDIF + IPE(N+1) = IPE(N) + LEN(N) + IWFR = IPE(N+1) + IF (SYM.EQ.0) THEN + RSYM = real(NDIAGA+2*NZOFFA - (IWFR-1))/ + & real(NZOFFA+NDIAGA) + symmetry = nint (100.0E0*RSYM) + IF (MPG .GT. 0) + & write(MPG,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + ELSE + symmetry = 100 + ENDIF + AvgDens = nint(real(IWFR-1)/real(N)) + THRESH = AvgDens*50 - AvgDens/10 + 1 + NBQD = 0 + IF (N.GT.2) THEN + IQ(1:N) = 0 + DO I= 1, N + K = max(LEN(I),1) + IQ(K) = IQ(K) + 1 + IF (K.GT.THRESH) NBQD = NBQD+1 + ENDDO + K = 0 + MedDens = 0 + DO WHILE (K .LT. (N/2)) + MedDens = MedDens + 1 + K = K+IQ(MedDens) + ENDDO + ELSE + MedDens = AvgDens + ENDIF + IF (MPG .GT. 0) + & write(MPG,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + RETURN +99999 FORMAT (/'*** Warning message from analysis routine ***') + END SUBROUTINE CMUMPS_351 + SUBROUTINE CMUMPS_701(N, SYM, NPROCS, IORD, + & symmetry,MedDens, NBQD, AvgDens, + & PROK, MP) + IMPLICIT NONE + INTEGER, intent(in) :: N, NPROCS, SYM + INTEGER, intent(in) :: symmetry,MedDens, NBQD, AvgDens, MP + LOGICAL, intent(in) :: PROK + INTEGER, intent(inout) :: IORD + INTEGER MAXQD + PARAMETER (MAXQD=2) + INTEGER SMALLSYM, SMALLUNS + PARAMETER (SMALLUNS=5000, SMALLSYM=10000) +#if ! defined(metis) && ! defined(parmetis) + IF ( IORD .EQ. 5 ) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: METIS not available. Ordering set to default.' + IORD = 7 + END IF +#endif +#if ! defined(pord) + IF ( IORD .EQ. 4 ) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: PORD not available. Ordering set to default.' + IORD = 7 + END IF +#endif +#if ! defined(scotch) && ! defined(ptscotch) + IF ( IORD .EQ. 3 ) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: SCOTCH not available. Ordering set to default.' + IORD = 7 + END IF +#endif + IF (IORD.EQ.7) THEN + IF (SYM.NE.0) THEN + IF ( N.LE.SMALLSYM ) THEN + IF (NBQD.GE.MAXQD) THEN + IORD = 6 + ELSE + IORD = 2 + ENDIF + ELSE + IF (NBQD.GE.MedDens*NPROCS) THEN + IORD = 6 + RETURN + ENDIF +#if defined(metis) || defined(parmetis) + IORD = 5 +#else +# if defined(scotch) || defined(ptscotch) + IORD = 3 +# else +# if defined(pord) + IORD = 4 +# else + IORD = 6 +# endif +# endif +#endif + ENDIF + ELSE + IF ( N.LE.SMALLUNS ) THEN + IF (NBQD.GE.MAXQD) THEN + IORD = 6 + ELSE + IORD = 2 + ENDIF + ELSE + IF (NBQD.GE.MedDens*NPROCS) THEN + IORD = 6 + RETURN + ENDIF +#if defined(metis) || defined(parmetis) + IORD = 5 +#else +# if defined(scotch) || defined(ptscotch) + IORD = 3 +# else +# if defined(pord) + IORD = 4 +# else + IORD = 6 +# endif +# endif +#endif + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_701 + SUBROUTINE CMUMPS_510 + & (KEEP821, KEEP2, KEEP48 ,KEEP50, NSLAVES) + IMPLICIT NONE + INTEGER NSLAVES, KEEP2, KEEP48, KEEP50 + INTEGER (8) :: KEEP821 + INTEGER(8) KEEP2_SQUARE, NSLAVES8 + NSLAVES8= int(NSLAVES,8) + KEEP2_SQUARE = int(KEEP2,8) * int(KEEP2,8) + KEEP821 = max(KEEP821*int(KEEP2,8),1_8) +#if defined(t3e) + KEEP821 = min(1500000_8, KEEP821) +#elif defined(SP_) + KEEP821 = min(3000000_8, KEEP821) +#else + KEEP821 = min(2000000_8, KEEP821) +#endif +#if defined(t3e) + IF (NSLAVES .GT. 64) THEN + KEEP821 = + & min(8_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ELSE + KEEP821 = + & min(4_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ENDIF +#else + IF (NSLAVES.GT.64) THEN + KEEP821 = + & min(6_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ELSE + KEEP821 = + & min(4_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ENDIF +#endif + IF (KEEP50 .EQ. 0 ) THEN + KEEP821 = max(KEEP821,(7_8*KEEP2_SQUARE / + & 4_8 / int(max(NSLAVES-1,1),8)) + int(KEEP2,8)) + ELSE + KEEP821 = max(KEEP821,(7_8*KEEP2_SQUARE / + & 4_8 / int(max(NSLAVES-1,1),8)) + int(KEEP2,8)) + ENDIF + IF (KEEP50 .EQ. 0 ) THEN +#if defined(t3e) + KEEP821 = max(KEEP821,200000_8) +#else + KEEP821 = max(KEEP821,300000_8) +#endif + ELSE +#if defined(t3e) + KEEP821 = max(KEEP821,40000_8) +#else + KEEP821 = max(KEEP821,80000_8) +#endif + ENDIF + KEEP821 = -KEEP821 + RETURN + END SUBROUTINE CMUMPS_510 + SUBROUTINE CMUMPS_559(JOB,M,N,NE, + & IP,IRN,A,LA,NUM,PERM,LIW,IW,LDW,DW, + & ICNTL,CNTL,INFO) + IMPLICIT NONE + INTEGER NICNTL, NCNTL, NINFO + PARAMETER (NICNTL=10, NCNTL=10, NINFO=10) + INTEGER JOB,M,N,NE,NUM,LIW,LDW + INTEGER IP(N+1),IRN(NE),PERM(M),IW(LIW) + INTEGER ICNTL(NICNTL),INFO(NINFO) + INTEGER LA + REAL A(LA) + REAL DW(LDW),CNTL(NCNTL) + INTEGER I,J,K,WARN1,WARN2,WARN4 + REAL FACT,ZERO,ONE,RINF,RINF2,RINF3 + PARAMETER (ZERO=0.0E+00,ONE=1.0E+0) + EXTERNAL CMUMPS_457,CMUMPS_444,CMUMPS_451, + & CMUMPS_452,CMUMPS_454 + INTRINSIC abs,log + RINF = CNTL(2) + RINF2 = huge(RINF2)/real(2*N) + RINF3 = 0.0E0 + WARN1 = 0 + WARN2 = 0 + WARN4 = 0 + IF (JOB.LT.1 .OR. JOB.GT.6) THEN + INFO(1) = -1 + INFO(2) = JOB + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'JOB',JOB + GO TO 99 + ENDIF + IF (M.LT.1 .OR. M.LT.N) THEN + INFO(1) = -2 + INFO(2) = M + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'M',M + GO TO 99 + ENDIF + IF (N.LT.1) THEN + INFO(1) = -2 + INFO(2) = N + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'N',N + GO TO 99 + ENDIF + IF (NE.LT.1) THEN + INFO(1) = -3 + INFO(2) = NE + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'NE',NE + GO TO 99 + ENDIF + IF (JOB.EQ.1) K = 4*N + M + IF (JOB.EQ.2) K = 2*N + 2*M + IF (JOB.EQ.3) K = 8*N + 2*M + NE + IF (JOB.EQ.4) K = 3*N + 2*M + IF (JOB.EQ.5) K = 3*N + 2*M + IF (JOB.EQ.6) K = 3*N + 2*M + NE + IF (LIW.LT.K) THEN + INFO(1) = -4 + INFO(2) = K + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9004) INFO(1),K + GO TO 99 + ENDIF + IF (JOB.GT.1) THEN + IF (JOB.EQ.2) K = M + IF (JOB.EQ.3) K = 1 + IF (JOB.EQ.4) K = 2*M + IF (JOB.EQ.5) K = N + 2*M + IF (JOB.EQ.6) K = N + 3*M + IF (LDW.LT.K) THEN + INFO(1) = -5 + INFO(2) = K + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9005) INFO(1),K + GO TO 99 + ENDIF + ENDIF + IF (ICNTL(5).EQ.0) THEN + DO 3 I = 1,M + IW(I) = 0 + 3 CONTINUE + DO 6 J = 1,N + DO 4 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (I.LT.1 .OR. I.GT.M) THEN + INFO(1) = -6 + INFO(2) = J + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9006) INFO(1),J,I + GO TO 99 + ENDIF + IF (IW(I).EQ.J) THEN + INFO(1) = -7 + INFO(2) = J + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9007) INFO(1),J,I + GO TO 99 + ELSE + IW(I) = J + ENDIF + 4 CONTINUE + 6 CONTINUE + ENDIF + IF (ICNTL(3).GE.0) THEN + IF (ICNTL(4).EQ.0 .OR. ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9020) JOB,M,N,NE + IF (ICNTL(4).EQ.0) THEN + WRITE(ICNTL(3),9021) (IP(J),J=1,min(10,N+1)) + WRITE(ICNTL(3),9022) (IRN(J),J=1,min(10,NE)) + IF (JOB.GT.1) WRITE(ICNTL(3),9023) (A(J),J=1,min(10,NE)) + ELSEIF (ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9021) (IP(J),J=1,N+1) + WRITE(ICNTL(3),9022) (IRN(J),J=1,NE) + IF (JOB.GT.1) WRITE(ICNTL(3),9023) (A(J),J=1,NE) + ENDIF + WRITE(ICNTL(3),9024) (ICNTL(J),J=1,NICNTL) + WRITE(ICNTL(3),9025) (CNTL(J),J=1,NCNTL) + ENDIF + ENDIF + DO 8 I=1,NINFO + INFO(I) = 0 + 8 CONTINUE + IF (JOB.EQ.1) THEN + DO 10 J = 1,N + IW(J) = IP(J+1) - IP(J) + 10 CONTINUE + CALL CMUMPS_457(M,N,IRN,NE,IP,IW(1),PERM,NUM, + & IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1)) + GO TO 90 + ENDIF + IF (JOB.EQ.2) THEN + DW(1) = max(ZERO,CNTL(1)) + CALL CMUMPS_444(M,N,NE,IP,IRN,A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(2*N+M+1),DW,RINF2) + GO TO 90 + ENDIF + IF (JOB.EQ.3) THEN + DO 20 K = 1,NE + IW(K) = IRN(K) + 20 CONTINUE + CALL CMUMPS_451(N,NE,IP,IW,A) + FACT = max(ZERO,CNTL(1)) + CALL CMUMPS_452(M,N,NE,IP,IW(1),A,PERM,NUM,IW(NE+1), + & IW(NE+N+1),IW(NE+2*N+1),IW(NE+3*N+1),IW(NE+4*N+1), + & IW(NE+5*N+1),IW(NE+5*N+M+1),FACT,RINF2) + GO TO 90 + ENDIF + IF (JOB.EQ.4) THEN + DO 50 J = 1,N + FACT = ZERO + DO 30 K = IP(J),IP(J+1)-1 + IF (abs(A(K)).GT.FACT) FACT = abs(A(K)) + 30 CONTINUE + IF(FACT .GT. RINF3) RINF3 = FACT + DO 40 K = IP(J),IP(J+1)-1 + A(K) = FACT - abs(A(K)) + 40 CONTINUE + 50 CONTINUE + DW(1) = max(ZERO,CNTL(1)) + DW(2) = RINF3 + IW(1) = JOB + CALL CMUMPS_454(M,N,NE,IP,IRN,A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1), + & DW(1),DW(M+1),RINF2) + GO TO 90 + ENDIF + IF (JOB.EQ.5 .or. JOB.EQ.6) THEN + RINF3=ONE + IF (JOB.EQ.5) THEN + DO 75 J = 1,N + FACT = ZERO + DO 60 K = IP(J),IP(J+1)-1 + IF (A(K).GT.FACT) FACT = A(K) + 60 CONTINUE + DW(2*M+J) = FACT + IF (FACT.NE.ZERO) THEN + FACT = log(FACT) + IF(FACT .GT. RINF3) RINF3=FACT + DO 70 K = IP(J),IP(J+1)-1 + IF (A(K).NE.ZERO) THEN + A(K) = FACT - log(A(K)) + IF(A(K) .GT. RINF3) RINF3=A(K) + ELSE + A(K) = FACT + RINF + ENDIF + 70 CONTINUE + ELSE + DO 71 K = IP(J),IP(J+1)-1 + A(K) = ONE + 71 CONTINUE + ENDIF + 75 CONTINUE + ENDIF + IF (JOB.EQ.6) THEN + DO 175 K = 1,NE + IW(3*N+2*M+K) = IRN(K) + 175 CONTINUE + DO 61 I = 1,M + DW(2*M+N+I) = ZERO + 61 CONTINUE + DO 63 J = 1,N + DO 62 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (A(K).GT.DW(2*M+N+I)) THEN + DW(2*M+N+I) = A(K) + ENDIF + 62 CONTINUE + 63 CONTINUE + DO 64 I = 1,M + IF (DW(2*M+N+I).NE.ZERO) THEN + DW(2*M+N+I) = 1.0E0/DW(2*M+N+I) + ENDIF + 64 CONTINUE + DO 66 J = 1,N + DO 65 K = IP(J),IP(J+1)-1 + I = IRN(K) + A(K) = DW(2*M+N+I) * A(K) + 65 CONTINUE + 66 CONTINUE + CALL CMUMPS_451(N,NE,IP,IW(3*N+2*M+1),A) + DO 176 J = 1,N + IF (IP(J).NE.IP(J+1)) THEN + FACT = A(IP(J)) + ELSE + FACT = ZERO + ENDIF + DW(2*M+J) = FACT + IF (FACT.NE.ZERO) THEN + FACT = log(FACT) + DO 170 K = IP(J),IP(J+1)-1 + IF (A(K).NE.ZERO) THEN + A(K) = FACT - log(A(K)) + IF(A(K) .GT. RINF3) RINF3=A(K) + ELSE + A(K) = FACT + RINF + ENDIF + 170 CONTINUE + ELSE + DO 171 K = IP(J),IP(J+1)-1 + A(K) = ONE + 171 CONTINUE + ENDIF + 176 CONTINUE + ENDIF + DW(1) = max(ZERO,CNTL(1)) + RINF3 = RINF3+ONE + DW(2) = RINF3 + IW(1) = JOB + IF (JOB.EQ.5) THEN + CALL CMUMPS_454(M,N,NE,IP,IRN,A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1), + & DW(1),DW(M+1),RINF2) + ENDIF + IF (JOB.EQ.6) THEN + CALL CMUMPS_454(M,N,NE,IP,IW(3*N+2*M+1),A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1), + & DW(1),DW(M+1),RINF2) + ENDIF + IF (JOB.EQ.6) THEN + DO 79 I = 1,M + IF (DW(2*M+N+I).NE.0.0E0) THEN + DW(I) = DW(I) + log(DW(2*M+N+I)) + ENDIF + 79 CONTINUE + ENDIF + IF (NUM.EQ.N) THEN + DO 80 J = 1,N + IF (DW(2*M+J).NE.ZERO) THEN + DW(M+J) = DW(M+J) - log(DW(2*M+J)) + ELSE + DW(M+J) = ZERO + ENDIF + 80 CONTINUE + ENDIF + FACT = 0.5E0*log(RINF2) + DO 86 I = 1,M + IF (DW(I).LT.FACT) GO TO 86 + WARN2 = 2 + GO TO 90 + 86 CONTINUE + DO 87 J = 1,N + IF (DW(M+J).LT.FACT) GO TO 87 + WARN2 = 2 + GO TO 90 + 87 CONTINUE + ENDIF + 90 IF (NUM.LT.N) WARN1 = 1 + IF (JOB.EQ.4 .OR. JOB.EQ.5 .OR. JOB.EQ.6) THEN + IF (CNTL(1).LT.ZERO) WARN4 = 4 + ENDIF + IF (INFO(1).EQ.0) THEN + INFO(1) = WARN1 + WARN2 + WARN4 + IF (INFO(1).GT.0 .AND. ICNTL(2).GT.0) THEN + WRITE(ICNTL(2),9010) INFO(1) + IF (WARN1.EQ.1) WRITE(ICNTL(2),9011) + IF (WARN2.EQ.2) WRITE(ICNTL(2),9012) + IF (WARN4.EQ.4) WRITE(ICNTL(2),9014) + ENDIF + ENDIF + IF (ICNTL(3).GE.0) THEN + IF (ICNTL(4).EQ.0 .OR. ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9030) (INFO(J),J=1,2) + WRITE(ICNTL(3),9031) NUM + IF (ICNTL(4).EQ.0) THEN + WRITE(ICNTL(3),9032) (PERM(J),J=1,min(10,M)) + IF (JOB.EQ.5 .OR. JOB.EQ.6) THEN + WRITE(ICNTL(3),9033) (DW(J),J=1,min(10,M)) + WRITE(ICNTL(3),9034) (DW(M+J),J=1,min(10,N)) + ENDIF + ELSEIF (ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9032) (PERM(J),J=1,M) + IF (JOB.EQ.5 .OR. JOB.EQ.6) THEN + WRITE(ICNTL(3),9033) (DW(J),J=1,M) + WRITE(ICNTL(3),9034) (DW(M+J),J=1,N) + ENDIF + ENDIF + ENDIF + ENDIF + 99 RETURN + 9001 FORMAT (' ****** Error in CMUMPS_443. INFO(1) = ',I2, + & ' because ',(A),' = ',I10) + 9004 FORMAT (' ****** Error in CMUMPS_443. INFO(1) = ',I2/ + & ' LIW too small, must be at least ',I8) + 9005 FORMAT (' ****** Error in CMUMPS_443. INFO(1) = ',I2/ + & ' LDW too small, must be at least ',I8) + 9006 FORMAT (' ****** Error in CMUMPS_443. INFO(1) = ',I2/ + & ' Column ',I8, + & ' contains an entry with invalid row index ',I8) + 9007 FORMAT (' ****** Error in CMUMPS_443. INFO(1) = ',I2/ + & ' Column ',I8, + & ' contains two or more entries with row index ',I8) + 9010 FORMAT (' ****** Warning from CMUMPS_443. INFO(1) = ',I2) + 9011 FORMAT (' - The matrix is structurally singular.') + 9012 FORMAT (' - Some scaling factors may be too large.') + 9014 FORMAT (' - CNTL(1) is negative and was treated as zero.') + 9020 FORMAT (' ****** Input parameters for CMUMPS_443:'/ + & ' JOB =',I10/' M =',I10/' N =',I10/' NE =',I10) + 9021 FORMAT (' IP(1:N+1) = ',8I8/(15X,8I8)) + 9022 FORMAT (' IRN(1:NE) = ',8I8/(15X,8I8)) + 9023 FORMAT (' A(1:NE) = ',4(1PD14.4)/(15X,4(1PD14.4))) + 9024 FORMAT (' ICNTL(1:10) = ',8I8/(15X,2I8)) + 9025 FORMAT (' CNTL(1:10) = ',4(1PD14.4)/(15X,4(1PD14.4))) + 9030 FORMAT (' ****** Output parameters for CMUMPS_443:'/ + & ' INFO(1:2) = ',2I8) + 9031 FORMAT (' NUM = ',I8) + 9032 FORMAT (' PERM(1:M) = ',8I8/(15X,8I8)) + 9033 FORMAT (' DW(1:M) = ',5(F11.3)/(15X,5(F11.3))) + 9034 FORMAT (' DW(M+1:M+N) = ',5(F11.3)/(15X,5(F11.3))) + END SUBROUTINE CMUMPS_559 + SUBROUTINE CMUMPS_563(N,NZ,IP,IRN,A,FLAG,POSI) + IMPLICIT NONE + INTEGER N,NZ + INTEGER IP(N+1),IRN(NZ) + REAL A(NZ) + INTEGER WR_POS,BEG_COL,ROW,COL,K,SV_POS + INTEGER FLAG(N), POSI(N) + FLAG = 0 + WR_POS = 1 + DO COL=1,N + BEG_COL = WR_POS + DO K=IP(COL),IP(COL+1)-1 + ROW = IRN(K) + IF(FLAG(ROW) .NE. COL) THEN + IRN(WR_POS) = ROW + A(WR_POS) = A(K) + FLAG(ROW) = COL + POSI(ROW) = WR_POS + WR_POS = WR_POS+1 + ELSE + SV_POS = POSI(ROW) + A(SV_POS) = A(SV_POS) + A(K) + ENDIF + ENDDO + IP(COL) = BEG_COL + ENDDO + IP(N+1) = WR_POS + NZ = WR_POS-1 + RETURN + END SUBROUTINE CMUMPS_563 + SUBROUTINE CMUMPS_562(N,NZ,IP,IRN,FLAG,POSI) + IMPLICIT NONE + INTEGER N,NZ + INTEGER IP(N+1),IRN(NZ) + INTEGER WR_POS,BEG_COL,ROW,COL,K + INTEGER FLAG(N), POSI(N) + FLAG = 0 + WR_POS = 1 + DO COL=1,N + BEG_COL = WR_POS + DO K=IP(COL),IP(COL+1)-1 + ROW = IRN(K) + IF(FLAG(ROW) .NE. COL) THEN + IRN(WR_POS) = ROW + FLAG(ROW) = COL + POSI(ROW) = WR_POS + WR_POS = WR_POS+1 + ENDIF + ENDDO + IP(COL) = BEG_COL + ENDDO + IP(N+1) = WR_POS + NZ = WR_POS-1 + RETURN + END SUBROUTINE CMUMPS_562 + SUBROUTINE CMUMPS_181( N, NA, LNA, NE_STEPS, + & PERM, FILS, + & DAD_STEPS, STEP, NSTEPS, INFO) + IMPLICIT NONE + INTEGER, INTENT(IN) :: N, NSTEPS, LNA + INTEGER, INTENT(IN) :: FILS( N ), STEP(N), NA(LNA) + INTEGER, INTENT(IN) :: DAD_STEPS ( NSTEPS ), NE_STEPS (NSTEPS) + INTEGER, INTENT(INOUT) :: INFO(40) + INTEGER, INTENT(OUT) :: PERM( N ) + INTEGER :: IPERM, INODE, IN + INTEGER :: INBLEAF, INBROOT, allocok + INTEGER, ALLOCATABLE, DIMENSION (:) :: POOL, NSTK + INBLEAF = NA(1) + INBROOT = NA(2) + ALLOCATE(POOL(INBLEAF), NSTK(NSTEPS), stat=allocok) + IF (allocok > 0 ) THEN + INFO(1) = -7 + INFO(2) = INBLEAF + NSTEPS + RETURN + ENDIF + POOL(1:INBLEAF) = NA(3:2+INBLEAF) + NSTK(1:NSTEPS) = NE_STEPS(1:NSTEPS) + IPERM = 1 + DO WHILE ( INBLEAF .NE. 0 ) + INODE = POOL( INBLEAF ) + INBLEAF = INBLEAF - 1 + IN = INODE + DO WHILE ( IN .GT. 0 ) + PERM ( IN ) = IPERM + IPERM = IPERM + 1 + IN = FILS( IN ) + END DO + IN = DAD_STEPS(STEP( INODE )) + IF ( IN .eq. 0 ) THEN + INBROOT = INBROOT - 1 + ELSE + NSTK( STEP(IN) ) = NSTK( STEP(IN) ) - 1 + IF ( NSTK( STEP(IN) ) .eq. 0 ) THEN + INBLEAF = INBLEAF + 1 + POOL( INBLEAF ) = IN + END IF + END IF + END DO + DEALLOCATE(POOL, NSTK) + RETURN + END SUBROUTINE CMUMPS_181 + SUBROUTINE CMUMPS_746( ID, PTRAR ) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + include 'mpif.h' + TYPE(CMUMPS_STRUC), INTENT(IN), TARGET :: ID + INTEGER, TARGET :: PTRAR(ID%N,2) + INTEGER :: IERR + INTEGER :: IOLD, K, JOLD, INEW, JNEW, INZ + INTEGER, POINTER :: IIRN(:), IJCN(:), IWORK1(:), IWORK2(:) + LOGICAL :: IDO, PARANAL + PARANAL = .TRUE. + IF (PARANAL) THEN + IF(ID%KEEP(54) .EQ. 3) THEN + IIRN => ID%IRN_loc + IJCN => ID%JCN_loc + INZ = ID%NZ_loc + IWORK1 => PTRAR(1:ID%N,2) + allocate(IWORK2(ID%N)) + IDO = .TRUE. + ELSE + IIRN => ID%IRN + IJCN => ID%JCN + INZ = ID%NZ + IWORK1 => PTRAR(1:ID%N,1) + IWORK2 => PTRAR(1:ID%N,2) + IDO = ID%MYID .EQ. 0 + END IF + ELSE + IIRN => ID%IRN + IJCN => ID%JCN + INZ = ID%NZ + IWORK1 => PTRAR(1:ID%N,1) + IWORK2 => PTRAR(1:ID%N,2) + IDO = ID%MYID .EQ. 0 + END IF + DO 50 IOLD=1,ID%N + IWORK1(IOLD) = 0 + IWORK2(IOLD) = 0 + 50 CONTINUE + IF(IDO) THEN + DO 70 K=1,INZ + IOLD = IIRN(K) + JOLD = IJCN(K) + IF ( (IOLD.GT.ID%N).OR.(JOLD.GT.ID%N).OR.(IOLD.LT.1) + & .OR.(JOLD.LT.1) ) GOTO 70 + IF (IOLD.NE.JOLD) THEN + INEW = ID%SYM_PERM(IOLD) + JNEW = ID%SYM_PERM(JOLD) + IF ( ID%KEEP( 50 ) .EQ. 0 ) THEN + IF (INEW.LT.JNEW) THEN + IWORK2(IOLD) = IWORK2(IOLD) + 1 + ELSE + IWORK1(JOLD) = IWORK1(JOLD) + 1 + ENDIF + ELSE + IF ( INEW .LT. JNEW ) THEN + IWORK1( IOLD ) = IWORK1( IOLD ) + 1 + ELSE + IWORK1( JOLD ) = IWORK1( JOLD ) + 1 + END IF + ENDIF + ENDIF + 70 CONTINUE + END IF + IF(PARANAL .AND. (ID%KEEP(54) .EQ. 3) ) THEN + CALL MPI_ALLREDUCE(IWORK1(1), PTRAR(1,1), ID%N, MPI_INTEGER, + & MPI_SUM, ID%COMM, IERR ) + CALL MPI_ALLREDUCE(IWORK2(1), PTRAR(1,2), ID%N, MPI_INTEGER, + & MPI_SUM, ID%COMM, IERR ) + deallocate(IWORK2) + ELSE + CALL MPI_BCAST( PTRAR, 2*ID%N, MPI_INTEGER, + & 0, ID%COMM, IERR ) + END IF + RETURN + END SUBROUTINE CMUMPS_746 + MODULE CMUMPS_PARALLEL_ANALYSIS + USE CMUMPS_STRUC_DEF + USE TOOLS_COMMON + INCLUDE 'mpif.h' + PUBLIC CMUMPS_715 + INTERFACE CMUMPS_715 + MODULE PROCEDURE CMUMPS_715 + END INTERFACE + PRIVATE + TYPE ORD_TYPE + INTEGER :: CBLKNBR, N + INTEGER, POINTER :: PERMTAB(:) => null() + INTEGER, POINTER :: PERITAB(:) => null() + INTEGER, POINTER :: RANGTAB(:) => null() + INTEGER, POINTER :: TREETAB(:) => null() + INTEGER, POINTER :: BROTHER(:) => null() + INTEGER, POINTER :: SON(:) => null() + INTEGER, POINTER :: NW(:) => null() + INTEGER, POINTER :: FIRST(:) => null() + INTEGER, POINTER :: LAST(:) => null() + INTEGER, POINTER :: TOPNODES(:) => null() + INTEGER :: COMM, COMM_NODES, NPROCS, NSLAVES, MYID + INTEGER :: TOPSTRAT, SUBSTRAT, ORDTOOL, TOPVARS + LOGICAL :: IDO + END TYPE ORD_TYPE + TYPE GRAPH_TYPE + INTEGER :: NZ_LOC, N, COMM + INTEGER, POINTER :: IRN_LOC(:) => null() + INTEGER, POINTER :: JCN_LOC(:) => null() + END TYPE GRAPH_TYPE + TYPE ARRPNT + INTEGER, POINTER :: BUF(:) => null() + END TYPE ARRPNT + INTEGER :: MEMCNT, MAXMEM, MP, MPG, LP, NRL, TOPROWS + LOGICAL :: PROK, PROKG + CONTAINS + SUBROUTINE CMUMPS_715(id, WORK1, WORK2, NFSIZ, FILS, + & FRERE) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(CMUMPS_STRUC) :: id + INTEGER, POINTER :: WORK1(:), WORK2(:), + & NFSIZ(:), FILS(:), FRERE(:) + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: IPE(:), NV(:), + & NE(:), NA(:), NODE(:), + & ND(:), SUBORD(:), NAMALG(:), + & IPS(:), CUMUL(:), + & SAVEIRN(:), SAVEJCN(:) + INTEGER :: MYID, NPROCS, IERR, NEMIN, LDIAG + LOGICAL :: SPLITROOT + INTEGER(8), PARAMETER :: K79REF=12000000_8 + nullify(IPE, NV, NE, NA, NODE, ND, SUBORD, NAMALG, IPS, + & CUMUL, SAVEIRN, SAVEJCN) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + LP = id%ICNTL(1) + MP = id%ICNTL(2) + MPG = id%ICNTL(3) + PROK = (MP.GT.0) + PROKG = (MPG.GT.0) .AND. (MYID .EQ. 0) + LDIAG = id%ICNTL(4) + ord%PERMTAB => WORK1(1 : id%N) + ord%PERITAB => WORK1(id%N+1 : 2*id%N) + ord%TREETAB => WORK1(2*id%N+1 : 3*id%N) + IF(id%KEEP(54) .NE. 3) THEN + IF(MYID.EQ.0) THEN + SAVEIRN => id%IRN_loc + SAVEJCN => id%JCN_loc + id%IRN_loc => id%IRN + id%JCN_loc => id%JCN + id%NZ_loc = id%NZ + ELSE + id%NZ_loc = 0 + END IF + END IF + MAXMEM=0 + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + MEMCNT = size(work1)+ size(work2) + + & size(nfsiz) + size(fils) + size(frere) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT entry:',MEMCNT,MAXMEM +#endif + CALL CMUMPS_716(id, ord) + id%INFOG(7) = id%KEEP(245) + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + CALL CMUMPS_717(id, ord, WORK2) + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + IF(id%MYID .EQ. 0) THEN + CALL MUMPS_733(IPE, id%N, id%INFO, LP, FORCE=.FALSE., + & COPY=.FALSE., STRING='', + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NV, id%N, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT ipe nv:',MEMCNT,MAXMEM +#endif + END IF + ord%SUBSTRAT = 0 + ord%TOPSTRAT = 0 + CALL CMUMPS_720(id, ord, IPE, NV, WORK2) + IF(id%KEEP(54) .NE. 3) THEN + IF(MYID.EQ.0) THEN + id%IRN_loc => SAVEIRN + id%JCN_loc => SAVEJCN + END IF + END IF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + NULLIFY(ord%PERMTAB) + NULLIFY(ord%PERITAB) + NULLIFY(ord%TREETAB) + CALL MUMPS_734(ord%FIRST, ord%LAST, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT firstlast:',MEMCNT,MAXMEM +#endif + IF (MYID .EQ. 0) THEN + IPS => WORK1(1:id%N) + NE => WORK1(id%N+1 : 2*id%N) + NA => WORK1(2*id%N+1 : 3*id%N) + NODE => WORK2(1 : id%N ) + ND => WORK2(id%N+1 : 2*id%N) + SUBORD => WORK2(2*id%N+1 : 3*id%N) + NAMALG => WORK2(3*id%N+1 : 4*id%N) + CALL MUMPS_733(CUMUL, id%N, id%INFO, LP, + & STRING='CUMUL', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT cumul:',MEMCNT,MAXMEM +#endif + NEMIN = id%KEEP(1) + CALL CMUMPS_557(id%N, IPE(1), NV(1), IPS(1), NE(1), + & NA(1), NFSIZ(1), NODE(1), id%INFOG(6), FILS(1), FRERE(1), + & ND(1), NEMIN, SUBORD(1), id%KEEP(60), id%KEEP(20), + & id%KEEP(38), NAMALG(1), id%KEEP(104), CUMUL(1), + & id%KEEP(50), id%ICNTL(13), id%KEEP(37), id%NSLAVES, + & id%KEEP(250).EQ.1) + CALL MUMPS_734(CUMUL, NV, IPE, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall cumul:',MEMCNT,MAXMEM +#endif + CALL CMUMPS_201(NE(1), ND(1), id%INFOG(6), id%INFOG(5), + & id%KEEP(2), id%KEEP(50), id%KEEP(101), id%KEEP(108), + & id%KEEP(5), id%KEEP(6), id%KEEP(226), id%KEEP(253)) + IF ( id%KEEP(53) .NE. 0 ) THEN + CALL MUMPS_209(id%N, FRERE(1), FILS(1), NFSIZ(1), + & id%KEEP(20)) + END IF + IF ( (id%KEEP(48) == 4 .AND. id%KEEP8(21).GT.0_8) + & .OR. + & (id%KEEP (48)==5 .AND. id%KEEP8(21) .GT. 0_8 ) + & .OR. + & (id%KEEP(24).NE.0.AND.id%KEEP8(21).GT.0_8) ) THEN + CALL CMUMPS_510(id%KEEP8(21), id%KEEP(2), + & id%KEEP(48), id%KEEP(50), id%NSLAVES) + END IF + IF ((id%KEEP(210).LT.0) .OR. (id%KEEP(210).GT.2)) + & id%KEEP(210)=0 + IF ((id%KEEP(210).EQ.0) .AND. (id%KEEP(201).GT.0)) + & id%KEEP(210)=1 + IF ((id%KEEP(210).EQ.0) .AND. (id%KEEP(201).EQ.0)) + & id%KEEP(210)=2 + IF (id%KEEP(210).EQ.2) id%KEEP8(79)=huge(id%KEEP8(79)) + IF ((id%KEEP(210).EQ.1) .AND. (id%KEEP8(79).LE.0_8)) THEN + IF ( huge(id%KEEP8(79)) / K79REF + 1_8 .GE. + & int(id%NSLAVES,8) ) THEN + id%KEEP8(79)=huge(id%KEEP8(79)) + ELSE + id%KEEP8(79)=K79REF * int(id%NSLAVES,8) + ENDIF + ENDIF + IF ( (id%KEEP(79).EQ.0).OR.(id%KEEP(79).EQ.2).OR. + & (id%KEEP(79).EQ.3).OR.(id%KEEP(79).EQ.5).OR. + & (id%KEEP(79).EQ.6) + & ) THEN + IF (id%KEEP(210).EQ.1) THEN + SPLITROOT = .FALSE. + IF ( id%KEEP(62).GE.1) THEN + CALL CMUMPS_97(id%N, FRERE(1), FILS(1), + & NFSIZ(1), id%INFOG(6), + & id%NSLAVES, id%KEEP(1), id%KEEP8(1), SPLITROOT, + & MP, LDIAG, id%INFOG(1), id%INFOG(2)) + IF (id%INFOG(1).LT.0) RETURN + ENDIF + ENDIF + ENDIF + SPLITROOT = (((id%ICNTL(13).GT.0) .AND. + & (id%NSLAVES.GT.id%ICNTL(13))) .OR. + & (id%ICNTL(13).EQ.-1)) .AND. (id%KEEP(60).EQ.0) + IF (SPLITROOT) THEN + CALL CMUMPS_97(id%N, FRERE(1), FILS(1), NFSIZ(1), + & id%INFOG(6), id%NSLAVES, id%KEEP(1), id%KEEP8(1), + & SPLITROOT, MP, LDIAG, id%INFOG(1), id%INFOG(2)) + IF (id%INFOG(1).LT.0) RETURN + ENDIF + END IF +#if defined (memprof) + write(mp,'(i2,a30,3(i8,5x))')myid,'MEMCNT exit:',MEMCNT,MAXMEM, + & estimem(myid, id%n, 2*id%nz/id%n) +#endif + RETURN + END SUBROUTINE CMUMPS_715 + SUBROUTINE CMUMPS_716(id, ord) + TYPE(CMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER :: IERR +#if defined(parmetis) + INTEGER :: I, COLOR, BASE + LOGICAL :: IDO +#endif + IF(id%MYID .EQ. 0) id%KEEP(245) = id%ICNTL(29) + CALL MPI_BCAST( id%KEEP(245), 1, + & MPI_INTEGER, 0, id%COMM, IERR ) + IF ((id%KEEP(245) .LT. 0) .OR. (id%KEEP(245) .GT. 2)) THEN + id%KEEP(245) = 0 + END IF + IF (id%KEEP(245) .EQ. 0) THEN +#if defined(ptscotch) + IF(id%NSLAVES .LT. 2) THEN + IF(PROKG) WRITE(MPG,'("Warning: older versions + &of PT-SCOTCH require at least 2 processors.")') + END IF + ord%ORDTOOL = 1 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%COMM = id%COMM + ord%COMM_NODES = id%COMM_NODES + ord%NPROCS = id%NPROCS + ord%NSLAVES = id%NSLAVES + ord%MYID = id%MYID + ord%IDO = (id%MYID .GE. 1) .OR. (id%KEEP(46) .EQ. 1) + IF(PROKG) WRITE(MPG, + & '("Parallel ordering tool set to PT-SCOTCH.")') + RETURN +#endif +#if defined(parmetis) + I=1 + DO + IF (I .GT. id%NSLAVES) EXIT + ord%NSLAVES = I + I = I*2 + END DO + BASE = id%NPROCS-id%NSLAVES + ord%NPROCS = ord%NSLAVES + BASE + IDO = (id%MYID .GE. BASE) .AND. + & (id%MYID .LE. BASE+ord%NSLAVES-1) + ord%IDO = IDO + IF ( IDO ) THEN + COLOR = 1 + ELSE + COLOR = MPI_UNDEFINED + END IF + CALL MPI_COMM_SPLIT( id%COMM, COLOR, 0, + & ord%COMM_NODES, IERR ) + ord%ORDTOOL = 2 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%MYID = id%MYID + IF(PROKG) WRITE(MPG, + & '("Parallel ordering tool set to ParMETIS.")') + RETURN +#endif + id%INFO(1) = -38 + id%INFOG(1) = -38 + IF(id%MYID .EQ.0 ) THEN + WRITE(LP, + & '("No parallel ordering tools available.")') + WRITE(LP, + & '("Please install PT-SCOTCH or ParMETIS.")') + END IF + RETURN + ELSE IF (id%KEEP(245) .EQ. 1) THEN +#if defined(ptscotch) + IF(id%NSLAVES .LT. 2) THEN + IF(PROKG) WRITE(MPG,'("Warning: older versions + &of PT-SCOTCH require at least 2 processors.")') + END IF + ord%ORDTOOL = 1 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%COMM = id%COMM + ord%COMM_NODES = id%COMM_NODES + ord%NPROCS = id%NPROCS + ord%NSLAVES = id%NSLAVES + ord%MYID = id%MYID + ord%IDO = (id%MYID .GE. 1) .OR. (id%KEEP(46) .EQ. 1) + IF(PROKG) WRITE(MPG, + & '("Using PT-SCOTCH for parallel ordering.")') + RETURN +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) WRITE(LP, + & '("PT-SCOTCH not available.")') + RETURN +#endif + ELSE IF (id%KEEP(245) .EQ. 2) THEN +#if defined(parmetis) + I=1 + DO + IF (I .GT. id%NSLAVES) EXIT + ord%NSLAVES = I + I = I*2 + END DO + BASE = id%NPROCS-id%NSLAVES + ord%NPROCS = ord%NSLAVES + BASE + IDO = (id%MYID .GE. BASE) .AND. + & (id%MYID .LE. BASE+ord%NSLAVES-1) + ord%IDO = IDO + IF ( IDO ) THEN + COLOR = 1 + ELSE + COLOR = MPI_UNDEFINED + END IF + CALL MPI_COMM_SPLIT( id%COMM, COLOR, 0, ord%COMM_NODES, + & IERR ) + ord%ORDTOOL = 2 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%MYID = id%MYID + IF(PROKG) WRITE(MPG, + & '("Using ParMETIS for parallel ordering.")') + RETURN +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) WRITE(LP, + & '("ParMETIS not available.")') + RETURN +#endif + END IF + END SUBROUTINE CMUMPS_716 + SUBROUTINE CMUMPS_717(id, ord, WORK) + IMPLICIT NONE + TYPE(CMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: WORK(:) +#ifdef parmetis + INTEGER :: IERR +#endif + IF (ord%ORDTOOL .EQ. 1) THEN +#ifdef ptscotch + CALL CMUMPS_719(id, ord, WORK) +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + WRITE(LP,*)'PT-SCOTCH not available. Aborting...' + CALL MUMPS_ABORT() +#endif + ELSE IF (ord%ORDTOOL .EQ. 2) THEN +#ifdef parmetis + CALL CMUMPS_718(id, ord, WORK) + if(ord%IDO) CALL MPI_COMM_FREE(ord%COMM_NODES, IERR) +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + WRITE(LP,*)'ParMETIS not available. Aborting...' + CALL MUMPS_ABORT() +#endif + END IF + RETURN + END SUBROUTINE CMUMPS_717 +#if defined(parmetis) + SUBROUTINE CMUMPS_718(id, ord, WORK) + IMPLICIT NONE + TYPE(CMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: WORK(:) + INTEGER :: I, MYID, NPROCS, IERR, BASE + INTEGER, POINTER :: FIRST(:), + & LAST(:), SWORK(:) + INTEGER :: BASEVAL, VERTLOCNBR, + & EDGELOCNBR, OPTIONS(10), NROWS_LOC + INTEGER, POINTER :: VERTLOCTAB(:), + & EDGELOCTAB(:), RCVCNTS(:) + INTEGER, POINTER :: SIZES(:), ORDER(:) + nullify(FIRST, LAST, SWORK, VERTLOCTAB, EDGELOCTAB, RCVCNTS, + & SIZES, ORDER) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. ID%N*3) THEN + WRITE(LP, + & '("Insufficient workspace inside CMUMPS_718")') + CALL MUMPS_ABORT() + END IF + CALL MUMPS_733(ord%PERMTAB, id%N, id%INFO, LP, + & STRING='PERMTAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%PERITAB, id%N, id%INFO, LP, + & STRING='PERITAB', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT perm peri:', + & MEMCNT,MAXMEM +#endif + BASEVAL = 1 + BASE = id%NPROCS-id%NSLAVES + VERTLOCTAB => ord%PERMTAB + CALL MUMPS_733(FIRST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT first last:',MEMCNT, + & MAXMEM +#endif + DO I=0, BASE-1 + FIRST(I+1) = 0 + LAST(I+1) = -1 + END DO + DO I=BASE, BASE+ord%NSLAVES-2 + FIRST(I+1) = (id%N/ord%NSLAVES)*(I-BASE)+1 + LAST(I+1) = (id%N/ord%NSLAVES)*(I+1-BASE) + END DO + FIRST(BASE+ord%NSLAVES) = (id%N/ord%NSLAVES)* + & (BASE+ord%NSLAVES-1-BASE)+1 + LAST(BASE+ord%NSLAVES) = id%N + DO I=BASE+ord%NSLAVES, NPROCS + FIRST(I+1) = id%N+1 + LAST(I+1) = id%N + END DO + VERTLOCNBR = LAST(MYID+1)-FIRST(MYID+1) + 1 + SWORK => WORK(id%N+1:3*id%N) + CALL CMUMPS_776(id, FIRST, LAST, VERTLOCTAB, + & EDGELOCTAB, SWORK) + EDGELOCNBR = VERTLOCTAB(VERTLOCNBR+1)-1 + OPTIONS(:) = 0 + NROWS_LOC = LAST(MYID+1)-FIRST(MYID+1)+1 + ORDER => WORK(1:id%N) + CALL MUMPS_733(SIZES, 2*ord%NSLAVES, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT sizes:',MEMCNT,MAXMEM +#endif + IF(ord%IDO) THEN + CALL MUMPS_PARMETIS(FIRST(1+BASE), VERTLOCTAB, + & EDGELOCTAB, BASEVAL, OPTIONS, ORDER, + & SIZES, ord%COMM_NODES) + END IF + CALL MUMPS_734(EDGELOCTAB, MEMCNT=MEMCNT) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall elt:',MEMCNT,MAXMEM +#endif + NULLIFY(VERTLOCTAB) + CALL MPI_BCAST(SIZES, 2*ord%NSLAVES, MPI_INTEGER, + & BASE, id%COMM, IERR) + ord%CBLKNBR = 2*ord%NSLAVES-1 + CALL MUMPS_733(RCVCNTS, id%NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rcvcnts:',MEMCNT,MAXMEM +#endif + DO I=1, id%NPROCS + RCVCNTS(I) = max(LAST(I)-FIRST(I)+1,0) + END DO + FIRST = FIRST-1 + IF(FIRST(1) .LT. 0) THEN + FIRST(1) = 0 + END IF + CALL MPI_ALLGATHERV ( ORDER, NROWS_LOC, MPI_INTEGER, ord%PERMTAB, + & RCVCNTS, FIRST, MPI_INTEGER, id%COMM, IERR ) + DO I=1, id%N + ord%PERITAB(ord%PERMTAB(I)) = I + END DO + CALL MUMPS_733(ord%RANGTAB, 2*ord%NSLAVES, id%INFO, + & LP, STRING='RANGTAB', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rangtab:',MEMCNT,MAXMEM +#endif + CALL MUMPS_733(ord%TREETAB, ord%CBLKNBR, id%INFO, + & LP, STRING='TREETAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL CMUMPS_778(ord%TREETAB, ord%RANGTAB, + & SIZES, ord%CBLKNBR) + CALL MUMPS_734(SIZES, FIRST, LAST, + & RCVCNTS, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall sizes:',MEMCNT,MAXMEM +#endif + CALL MUMPS_733(ord%SON, ord%CBLKNBR, id%INFO, + & LP, STRING='SON', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%BROTHER, ord%CBLKNBR, id%INFO, + & LP, STRING='BROTHER', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%NW, ord%CBLKNBR, id%INFO, + & LP, STRING='NW', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT son:',MEMCNT,MAXMEM +#endif + CALL CMUMPS_777(ord) + ord%N = id%N + ord%COMM = id%COMM + RETURN + END SUBROUTINE CMUMPS_718 +#endif +#if defined(ptscotch) + SUBROUTINE CMUMPS_719(id, ord, WORK) + IMPLICIT NONE + INCLUDE 'ptscotchf.h' + TYPE(CMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: WORK(:) + INTEGER :: I, MYID, NPROCS, IERR + INTEGER, POINTER :: FIRST(:), + & LAST(:), SWORK(:) + INTEGER :: BASEVAL, VERTLOCNBR, + & EDGELOCNBR, MYWORKID, + & BASE + INTEGER, POINTER :: VERTLOCTAB(:), + & EDGELOCTAB(:) + DOUBLE PRECISION :: GRAPHDAT(SCOTCH_DGRAPHDIM), + & ORDEDAT(SCOTCH_DORDERDIM), STRADAT(SCOTCH_STRATDIM), + & CORDEDAT(SCOTCH_ORDERDIM) + CHARACTER STRSTRING*1024 + nullify(FIRST, LAST, SWORK, VERTLOCTAB, EDGELOCTAB) + IF(MUMPS_795(WORK) .LT. ID%N*3) THEN + WRITE(LP, + & '("Insufficient workspace inside CMUMPS_719")') + CALL MUMPS_ABORT() + END IF + IF(ord%SUBSTRAT .EQ. 0) THEN + STRSTRING='n{sep=m{asc=b{width=3,strat=q{strat=f}},'// + & 'low=q{strat=h},vert=1000,dvert=100,dlevl=0,proc=1,'// + & 'seq=q{strat=m{type=h,vert=100,low=h{pass=10},'// + & 'asc=b{width=3,bnd=f{bal=0.2},org=h{pass=10}'// + & 'f{bal=0.2}}}}},ole=s,ose=s,osq=n{sep=/(vert>120)?'// + & 'm{type=h,vert=100,low=h{pass=10},asc=b{width=3,'// + & 'bnd=f{bal=0.2},org=h{pass=10}f{bal=0.2}}};,'// + & 'ole=f{cmin=15,cmax=100000,frat=0.0},ose=g}}' + ELSE + STRSTRING='n{sep=m{asc=b{width=3,strat=q{strat=f}},'// + & 'low=q{strat=h},vert=1000,dvert=100,dlevl=0,'// + & 'proc=1,seq=q{strat=m{type=h,vert=100,'// + & 'low=h{pass=10},asc=b{width=3,bnd=f{bal=0.2},'// + & 'org=h{pass=10}f{bal=0.2}}}}},ole=s,ose=s,osq=s}' + END IF + CALL MPI_BARRIER(id%COMM, IERR) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + BASE = id%NPROCS-id%NSLAVES + BASEVAL = 1 + CALL MUMPS_733(FIRST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT first last:',MEMCNT, + & MAXMEM +#endif + DO I=0, BASE-1 + FIRST(I+1) = 0 + LAST(I+1) = -1 + END DO + DO I=BASE, BASE+ord%NSLAVES-2 + FIRST(I+1) = (id%N/ord%NSLAVES)*(I-BASE)+1 + LAST(I+1) = (id%N/ord%NSLAVES)*(I+1-BASE) + END DO + FIRST(BASE+ord%NSLAVES) = (id%N/ord%NSLAVES)* + & (BASE+ord%NSLAVES-1-BASE)+1 + LAST(BASE+ord%NSLAVES) = id%N + DO I=BASE+ord%NSLAVES, NPROCS-1 + FIRST(I+1) = id%N+1 + LAST(I+1) = id%N + END DO + VERTLOCNBR = LAST(MYID+1)-FIRST(MYID+1) + 1 + VERTLOCTAB => WORK(1:id%N) + SWORK => WORK(id%N+1:3*id%N) + CALL CMUMPS_776(id, FIRST, LAST, VERTLOCTAB, + & EDGELOCTAB, SWORK) + EDGELOCNBR = VERTLOCTAB(VERTLOCNBR+1)-1 + CALL MUMPS_733(ord%PERMTAB, id%N, id%INFO, + & LP, STRING='PERMTAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%PERITAB, id%N, id%INFO, + & LP, STRING='PERITAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%RANGTAB, id%N+1, id%INFO, + & LP, STRING='RANGTAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%TREETAB, id%N, id%INFO, + & LP, STRING='TREETAB', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT permtab:',MEMCNT,MAXMEM +#endif + IF(ord%IDO) THEN + CALL MPI_COMM_RANK (ord%COMM_NODES, MYWORKID, IERR) + ELSE + MYWORKID = -1 + END IF + IF(ord%IDO) THEN + CALL MUMPS_DGRAPHINIT(GRAPHDAT, ord%COMM_NODES, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in dgraph init")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFDGRAPHBUILD(GRAPHDAT, BASEVAL, VERTLOCNBR, + & VERTLOCNBR, VERTLOCTAB(1), VERTLOCTAB(2), VERTLOCTAB(1), + & VERTLOCTAB(1), EDGELOCNBR, EDGELOCNBR, EDGELOCTAB(1), + & EDGELOCTAB(1), EDGELOCTAB(1), IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in dgraph build")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFSTRATINIT(STRADAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in strat init")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFSTRATDGRAPHORDER(STRADAT, STRSTRING, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in strat build")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFDGRAPHORDERINIT(GRAPHDAT, ORDEDAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order init")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFDGRAPHORDERCOMPUTE(GRAPHDAT, ORDEDAT, STRADAT, + & IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order compute")') + CALL MUMPS_ABORT() + END IF + IF(MYWORKID .EQ. 0) THEN + CALL SCOTCHFDGRAPHCORDERINIT(GRAPHDAT, CORDEDAT, + & ord%PERMTAB, ord%PERITAB, ord%CBLKNBR, ord%RANGTAB, + & ord%TREETAB, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in Corder init")') + CALL MUMPS_ABORT() + END IF + END IF + IF(MYWORKID .EQ. 0) THEN + CALL SCOTCHFDGRAPHORDERGATHER(GRAPHDAT, ORDEDAT, + & CORDEDAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order gather")') + CALL MUMPS_ABORT() + END IF + ELSE + CALL SCOTCHFDGRAPHORDERGATHER(GRAPHDAT, ORDEDAT, + & ORDEDAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order gather")') + CALL MUMPS_ABORT() + END IF + END IF + END IF + IF(MYWORKID .EQ. 0) + & CALL SCOTCHFDGRAPHCORDEREXIT(GRAPHDAT, CORDEDAT) + CALL SCOTCHFDGRAPHORDEREXIT(GRAPHDAT, ORDEDAT) + CALL SCOTCHFSTRATEXIT(STRADAT) + CALL SCOTCHFDGRAPHEXIT(GRAPHDAT) + CALL MPI_BCAST (ord%CBLKNBR, 1, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%PERMTAB, id%N, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%PERITAB, id%N, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%RANGTAB, id%N+1, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%TREETAB, id%N, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MUMPS_733(ord%SON, ord%CBLKNBR, id%INFO, + & LP, STRING='SON', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%BROTHER, ord%CBLKNBR, id%INFO, + & LP, STRING='BROTHER', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%NW, ord%CBLKNBR, id%INFO, + & LP, STRING='NW', MEMCNT=MEMCNT, ERRCODE=-7) + CALL CMUMPS_777(ord) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT son:',MEMCNT,MAXMEM +#endif + ord%N = id%N + ord%COMM = id%COMM + CALL MUMPS_734(EDGELOCTAB, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall elt:',MEMCNT,MAXMEM +#endif + RETURN + END SUBROUTINE CMUMPS_719 +#endif + FUNCTION CMUMPS_793(id, ord, NACTIVE, ANODE, RPROC, + & ALIST, LIST, PEAKMEM, NNODES, CHECKMEM) + IMPLICIT NONE + LOGICAL :: CMUMPS_793 + INTEGER :: NACTIVE, RPROC, ANODE, PEAKMEM, NNODES + INTEGER :: ALIST(NNODES), LIST(NNODES) + TYPE(ORD_TYPE) :: ord + TYPE(CMUMPS_STRUC) :: id + LOGICAL, OPTIONAL :: CHECKMEM + INTEGER :: IPEAKMEM, BIG, MAX_NROWS, MIN_NROWS + INTEGER :: TOPROWS, NRL, HOSTMEM, SUBMEM + INTEGER :: I, NZ_ROW, WEIGHT + LOGICAL :: ICHECKMEM + IF(present(CHECKMEM)) THEN + ICHECKMEM = CHECKMEM + ELSE + ICHECKMEM = .FALSE. + END IF + CMUMPS_793 = .FALSE. + IF(NACTIVE .GE. RPROC) THEN + CMUMPS_793 = .TRUE. + RETURN + END IF + IF(NACTIVE .EQ. 0) THEN + CMUMPS_793 = .TRUE. + RETURN + END IF + IF(.NOT. ICHECKMEM) RETURN + BIG = ALIST(NACTIVE) + IF(NACTIVE .GT. 1) THEN + MAX_NROWS = ord%NW(ALIST(NACTIVE-1)) + MIN_NROWS = ord%NW(ALIST(1)) + ELSE + MAX_NROWS = 0 + MIN_NROWS = id%N + END IF + DO I=1, ANODE + WEIGHT = ord%NW(LIST(I)) + IF(WEIGHT .GT. MAX_NROWS) MAX_NROWS = WEIGHT + IF(WEIGHT .LT. MIN_NROWS) MIN_NROWS = WEIGHT + END DO + I = ord%SON(BIG) + DO + WEIGHT = ord%NW(I) + IF(WEIGHT .GT. MAX_NROWS) MAX_NROWS = WEIGHT + IF(WEIGHT .LT. MIN_NROWS) MIN_NROWS = WEIGHT + IF(ord%BROTHER(I) .EQ. -1) EXIT + I = ord%BROTHER(I) + END DO + TOPROWS = ord%TOPNODES(2)+ord%RANGTAB(BIG+1)-ord%RANGTAB(BIG) + SUBMEM = 7 *id%N + HOSTMEM = 12*id%N + NZ_ROW = 2*(id%NZ/id%N) + IF(id%KEEP(46) .EQ. 0) THEN + NRL = 0 + ELSE + NRL = MIN_NROWS + END IF + HOSTMEM = HOSTMEM + 2*TOPROWS*NZ_ROW + HOSTMEM = HOSTMEM +NRL + HOSTMEM = HOSTMEM + max(NRL,TOPROWS)*(NZ_ROW+2) + HOSTMEM = HOSTMEM + 6*max(NRL,TOPROWS) + HOSTMEM = HOSTMEM + 3*TOPROWS + NRL = MAX_NROWS + SUBMEM = SUBMEM +NRL + SUBMEM = SUBMEM + NRL*(NZ_ROW+2) + SUBMEM = SUBMEM + 6*NRL + IPEAKMEM = max(HOSTMEM, SUBMEM) + IF((IPEAKMEM .GT. PEAKMEM) .AND. + & (PEAKMEM .NE. 0)) THEN + CMUMPS_793 = .TRUE. + RETURN + ELSE + CMUMPS_793 = .FALSE. + PEAKMEM = IPEAKMEM + RETURN + END IF + END FUNCTION CMUMPS_793 + FUNCTION CMUMPS_779(NODE, ord) + IMPLICIT NONE + INTEGER :: CMUMPS_779 + INTEGER :: NODE + TYPE(ORD_TYPE) :: ord + INTEGER :: CURR + CMUMPS_779 = 0 + IF(ord%SON(NODE) .EQ. -1) THEN + RETURN + ELSE + CMUMPS_779 = 1 + CURR = ord%SON(NODE) + DO + IF(ord%BROTHER(CURR) .NE. -1) THEN + CMUMPS_779 = CMUMPS_779+1 + CURR = ord%BROTHER(CURR) + ELSE + EXIT + END IF + END DO + END IF + RETURN + END FUNCTION CMUMPS_779 + SUBROUTINE CMUMPS_781(ord, id) + USE TOOLS_COMMON + IMPLICIT NONE + TYPE(ORD_TYPE) :: ord + TYPE(CMUMPS_STRUC) :: id + INTEGER, ALLOCATABLE :: ALIST(:), AWEIGHTS(:), LIST(:), WORK(:) + INTEGER :: NNODES, BIG, CURR, ND, NACTIVE, RPROC, ANODE, BASE, I, + & NK, PEAKMEM + LOGICAL :: SD + NNODES = ord%NSLAVES + ALLOCATE(ALIST(NNODES), AWEIGHTS(NNODES), LIST(NNODES), + & WORK(0:NNODES+1)) + ALIST(1) = ord%CBLKNBR + AWEIGHTS(1) = ord%NW(ord%CBLKNBR) + NACTIVE = 1 + RPROC = NNODES + ANODE = 0 + PEAKMEM = 0 + CALL MUMPS_733(ord%TOPNODES, 2*max(NNODES,2), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%FIRST, id%NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%LAST, id%NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')ord%myid,'MEMCNT topnodes:',MEMCNT, + & MAXMEM +#endif + ord%TOPNODES = 0 + IF((ord%CBLKNBR .EQ. 1) .OR. + & ( RPROC .LT. CMUMPS_779(ord%CBLKNBR, ord) )) THEN + ord%TOPNODES(1) = 1 + ord%TOPNODES(2) = ord%RANGTAB(ord%CBLKNBR+1) - ord%RANGTAB(1) + ord%TOPNODES(3) = ord%RANGTAB(1) + ord%TOPNODES(4) = ord%RANGTAB(ord%CBLKNBR+1)-1 + ord%FIRST = 0 + ord%LAST = -1 + RETURN + END IF + DO + IF(NACTIVE .EQ. 0) EXIT + BIG = ALIST(NACTIVE) + NK = CMUMPS_779(BIG, ord) + IF((NK .GT. (RPROC-NACTIVE+1)) .OR. (NK .EQ. 0)) THEN + ANODE = ANODE+1 + LIST(ANODE) = BIG + NACTIVE = NACTIVE-1 + RPROC = RPROC-1 + CYCLE + END IF + SD = CMUMPS_793(id, ord, NACTIVE, ANODE, + & RPROC, ALIST, LIST, PEAKMEM, NNODES, CHECKMEM=.TRUE.) + IF ( SD ) + & THEN + IF(NACTIVE.GT.0) THEN + LIST(ANODE+1:ANODE+NACTIVE) = ALIST(1:NACTIVE) + ANODE = ANODE+NACTIVE + END IF + EXIT + END IF + ord%TOPNODES(1) = ord%TOPNODES(1)+1 + ord%TOPNODES(2) = ord%TOPNODES(2) + + & ord%RANGTAB(BIG+1) - ord%RANGTAB(BIG) + ord%TOPNODES(2+2*(ord%TOPNODES(1)-1)+1) = ord%RANGTAB(BIG) + ord%TOPNODES(2+2*(ord%TOPNODES(1)-1)+2) = + & ord%RANGTAB(BIG+1)-1 + CURR = ord%SON(BIG) + ALIST(NACTIVE) = CURR + AWEIGHTS(NACTIVE) = ord%NW(CURR) + DO + IF(ord%BROTHER(CURR) .EQ. -1) EXIT + NACTIVE = NACTIVE+1 + CURR = ord%BROTHER(CURR) + ALIST(NACTIVE) = CURR + AWEIGHTS(NACTIVE) = ord%NW(CURR) + END DO + CALL CMUMPS_783(NACTIVE, AWEIGHTS(1:NACTIVE), + & WORK(0:NACTIVE+1)) + CALL CMUMPS_784(NACTIVE, WORK(0:NACTIVE+1), + & AWEIGHTS(1:NACTIVE), + & ALIST(1:NACTIVE)) + END DO + DO I=1, ANODE + AWEIGHTS(I) = ord%NW(LIST(I)) + END DO + CALL CMUMPS_783(ANODE, AWEIGHTS(1:ANODE), WORK(0:ANODE+1)) + CALL CMUMPS_784(ANODE, WORK(0:ANODE+1), AWEIGHTS(1:ANODE), + & ALIST(1:ANODE)) + IF (id%KEEP(46) .EQ. 1) THEN + BASE = 0 + ELSE + ord%FIRST(1) = 0 + ord%LAST(1) = -1 + BASE = 1 + END IF + DO I=1, ANODE + CURR = LIST(I) + ND = CURR + IF(ord%SON(ND) .NE. -1) THEN + ND = ord%SON(ND) + DO + IF((ord%SON(ND) .EQ. -1) .AND. + & (ord%BROTHER(ND).EQ.-1)) THEN + EXIT + ELSE IF(ord%BROTHER(ND) .EQ. -1) THEN + ND = ord%SON(ND) + ELSE + ND = ord%BROTHER(ND) + END IF + END DO + END IF + ord%FIRST(BASE+I) = ord%RANGTAB(ND) + ord%LAST(BASE+I) = ord%RANGTAB(CURR+1)-1 + END DO + DO I=ANODE+1, id%NSLAVES + ord%FIRST(BASE+I) = id%N+1 + ord%LAST(BASE+I) = id%N + END DO + DEALLOCATE(LIST, ALIST, AWEIGHTS, WORK) + RETURN + END SUBROUTINE CMUMPS_781 + SUBROUTINE CMUMPS_720(id, ord, GPE, GNV, WORK) + IMPLICIT NONE + TYPE(CMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: GPE(:), GNV(:) + INTEGER, POINTER :: WORK(:) + TYPE(GRAPH_TYPE) :: top_graph + INTEGER, POINTER :: PE(:), IPE(:), + & LENG(:), I_HALO_MAP(:) + INTEGER, POINTER :: NDENSE(:), LAST(:), + & DEGREE(:), W(:), PERM(:), + & LISTVAR_SCHUR(:), NEXT(:), + & HEAD(:), NV(:), ELEN(:), + & RCVCNT(:), LSTVAR(:) + INTEGER, POINTER :: NROOTS(:), MYLIST(:), + & MYNVAR(:), LVARPT(:), + & DISPLS(:), LPERM(:), + & LIPERM(:), + & IPET(:), NVT(:), BUF_PE1(:), + & BUF_PE2(:), BUF_NV1(:), + & BUF_NV2(:), ROOTPERM(:), + & TMP1(:), TMP2(:), BWORK(:) + INTEGER :: HIDX, NCMPA, I, J, SIZE_SCHUR, MYID, + & NPROCS, IERR, NROWS_LOC, GLOB_IDX, MYNROOTS, PNT, TMP, + & NCLIQUES, NTVAR, PFREES, PFREET, TGSIZE, MAXS, RHANDPE, + & RHANDNV, STATUSPE(MPI_STATUS_SIZE), + & STATUSNV(MPI_STATUS_SIZE), RIDX, PROC, NBBUCK, + & PFS_SAVE, PFT_SAVE + LOGICAL :: AGG6 + INTEGER :: THRESH + nullify(PE, IPE, LENG, I_HALO_MAP) + nullify(NDENSE, LAST, DEGREE, W, PERM, LISTVAR_SCHUR, + & NEXT, HEAD, NV, ELEN, RCVCNT, LSTVAR) + nullify(NROOTS, MYLIST, MYNVAR, LVARPT, DISPLS, + & LPERM, LIPERM, IPET, NVT, BUF_PE1, BUF_PE2, + & BUF_NV1, BUF_NV2, ROOTPERM, TMP1, TMP2, BWORK) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. 4*id%N) THEN + WRITE(LP,*)'Insufficient workspace in CMUMPS_720' + CALL MUMPS_ABORT() + ELSE + HEAD => WORK( 1 : id%N) + ELEN => WORK( id%N+1 : 2*id%N) + LENG => WORK(2*id%N+1 : 3*id%N) + PERM => WORK(3*id%N+1 : 4*id%N) + END IF + CALL CMUMPS_781(ord, id) + CALL MUMPS_734(ord%SON, ord%BROTHER, ord%NW, + & ord%RANGTAB, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))') myid,'deall son:',MEMCNT,MAXMEM +#endif + NROWS_LOC = ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1 + NRL = NROWS_LOC + TOPROWS = ord%TOPNODES(2) + BWORK => WORK(1 : 2*id%N) + CALL CMUMPS_775(id, ord, HIDX, IPE, PE, LENG, + & I_HALO_MAP, top_graph, BWORK) + TMP = id%N + DO I=1, NPROCS + TMP = TMP-(ord%LAST(I)-ord%FIRST(I)+1) + END DO + TMP = ceiling(real(TMP)*1.10E0) + IF(MYID .EQ. 0) THEN + TMP = max(max(TMP, HIDX),1) + ELSE + TMP = max(HIDX,1) + END IF + SIZE_SCHUR = HIDX - NROWS_LOC + CALL MUMPS_733(NDENSE, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NEXT, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(DEGREE, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(W, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NV, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LISTVAR_SCHUR, max(SIZE_SCHUR,1), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT allsub:',MEMCNT,MAXMEM +#endif + DO I=1, SIZE_SCHUR + LISTVAR_SCHUR(I) = NROWS_LOC+I + END DO + THRESH = -1 + AGG6 = .TRUE. + PFREES = IPE(NROWS_LOC+1) + PFS_SAVE = PFREES + IF (ord%SUBSTRAT .EQ. 0) THEN + DO I=1, HIDX + PERM(I) = I + END DO + CALL MUMPS_420(1, THRESH, NDENSE(1), HIDX, + & MUMPS_795(PE), IPE(1), PFREES, LENG(1), PE(1), NV(1), + & ELEN(1), LAST(1), NCMPA, DEGREE(1), HEAD(1), NEXT(1), + & W(1), PERM(1), LISTVAR_SCHUR(1), SIZE_SCHUR, AGG6) + ELSE + NBBUCK = 2*TMP + CALL MUMPS_419 (ord%SUBSTRAT, 1, .FALSE., HIDX, NBBUCK, + & MUMPS_795(PE), IPE(1), PFREES, LENG(1), PE(1), NV(1), + & ELEN(1), LAST(1), NCMPA, DEGREE(1), PERM(1), NEXT(1), + & W(1), HEAD(1), AGG6, SIZE_SCHUR, LISTVAR_SCHUR(1) ) + DO I=1, HIDX + PERM(I) = I + END DO + END IF + CALL MUMPS_733(W, 2*NPROCS, id%INFO, + & LP, STRING='W', MEMCNT=MEMCNT, ERRCODE=-7) + if(MEMCNT .gt. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT w:',MEMCNT,MAXMEM +#endif + NROOTS => W + DISPLS => W(NPROCS+1:2*NPROCS) + MYNVAR => DEGREE + MYLIST => NDENSE + LVARPT => NEXT + RCVCNT => HEAD + LSTVAR => LAST + NULLIFY(W, DEGREE, NDENSE, NEXT, HEAD, LAST) + MYNROOTS = 0 + PNT = 0 + DO I=1, HIDX + IF(IPE(I) .GT. 0) THEN + PNT = PNT+LENG(I) + MYNROOTS = MYNROOTS+1 + END IF + END DO + CALL MUMPS_733(MYLIST, PNT, id%INFO, + & LP, STRING='MYLIST', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT mylist:',MEMCNT,MAXMEM +#endif + MYNROOTS = 0 + PNT = 0 + DO I=1, HIDX + IF(IPE(I) .GT. 0) THEN + MYNROOTS = MYNROOTS+1 + MYNVAR(MYNROOTS) = LENG(I) + DO J=1, LENG(I) + MYLIST(PNT+J) = I_HALO_MAP(PE(IPE(I)+J-1)-NROWS_LOC) + END DO + PNT = PNT+LENG(I) + END IF + END DO + CALL MPI_BARRIER(id%COMM, IERR) + CALL MPI_GATHER(MYNROOTS, 1, MPI_INTEGER, NROOTS(1), 1, + & MPI_INTEGER, 0, id%COMM, IERR) + IF(MYID .EQ.0) THEN + DISPLS(1) = 0 + DO I=2, NPROCS + DISPLS(I) = DISPLS(I-1)+NROOTS(I-1) + END DO + NCLIQUES = sum(NROOTS(1:NPROCS)) + CALL MUMPS_733(LVARPT, NCLIQUES+1, id%INFO, + & LP, STRING='LVARPT', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT + ELSE + CALL MUMPS_733(LVARPT, 2, id%INFO, + & LP, STRING='LVARPT', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT + END IF +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT lvarpt:',MEMCNT,MAXMEM +#endif + CALL MPI_GATHERV(MYNVAR(1), MYNROOTS, MPI_INTEGER, LVARPT(2), + & NROOTS(1), DISPLS(1), MPI_INTEGER, 0, id%COMM, IERR) + IF(MYID .EQ. 0) THEN + DO I=1, NPROCS + RCVCNT(I) = sum(LVARPT(2+DISPLS(I):2+DISPLS(I)+NROOTS(I)-1)) + IF(I .EQ. 1) THEN + DISPLS(I) = 0 + ELSE + DISPLS(I) = DISPLS(I-1)+RCVCNT(I-1) + END IF + END DO + CALL MUMPS_733(LSTVAR, sum(RCVCNT(1:NPROCS)), id%INFO, + & LP, STRING='LSTVAR', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT lstvar:',MEMCNT,MAXMEM +#endif + END IF + CALL MPI_GATHERV(MYLIST(1), PNT, MPI_INTEGER, LSTVAR(1), + & RCVCNT(1), DISPLS(1), MPI_INTEGER, 0, id%COMM, IERR) + NULLIFY(DISPLS) + IF(MYID .EQ. 0) THEN + LVARPT(1) = 1 + DO I=2, NCLIQUES+1 + LVARPT(I) = LVARPT(I-1) + LVARPT(I) + END DO + LPERM => WORK(3*id%N+1 : 4*id%N) + NTVAR = ord%TOPNODES(2) + CALL CMUMPS_782(id, ord%TOPNODES, LPERM, LIPERM, ord) + CALL CMUMPS_774(id, ord%TOPNODES(2), LPERM, + & top_graph, NCLIQUES, LSTVAR, LVARPT, IPET, PE, LENG, ELEN) + TGSIZE = ord%TOPNODES(2)+NCLIQUES + PFREET = IPET(TGSIZE+1) + PFT_SAVE = PFREET + nullify(LPERM) + CALL MUMPS_734(top_graph%IRN_LOC, + & top_graph%JCN_LOC, ord%TOPNODES, MEMCNT=MEMCNT) + W => NROOTS + DEGREE => MYNVAR + NDENSE => MYLIST + NEXT => LVARPT + HEAD => RCVCNT + LAST => LSTVAR + NULLIFY(NROOTS, MYNVAR, MYLIST, LVARPT, RCVCNT, LSTVAR) + CALL MUMPS_733(PE, max(PFREET+TGSIZE,1), id%INFO, LP, + & COPY=.TRUE., STRING='J2:PE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NDENSE, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:NDENSE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NVT, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:NVT', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:LAST', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(DEGREE, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:DEGREE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NEXT, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:NEXT', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(W, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:W', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LISTVAR_SCHUR, max(NCLIQUES,1), id%INFO, LP, + & STRING='J2:LVSCH', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT pe:',MEMCNT,MAXMEM +#endif + DO I=1, NCLIQUES + LISTVAR_SCHUR(I) = NTVAR+I + END DO + THRESH = -1 + IF(ord%TOPSTRAT .EQ. 0) THEN + CALL MUMPS_733(HEAD, max(TGSIZE,1), id%INFO, + & LP, STRING='J2:HEAD', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(PERM, max(TGSIZE,1), id%INFO, + & LP, COPY=.TRUE., STRING='J2:PERM', + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rehead:',MEMCNT,MAXMEM +#endif + DO I=1, TGSIZE + PERM(I) = I + END DO + CALL MUMPS_420(2, -1, NDENSE(1), TGSIZE, + & MUMPS_795(PE), IPET(1), PFREET, LENG(1), PE(1), + & NVT(1), ELEN(1), LAST(1), NCMPA, DEGREE(1), HEAD(1), + & NEXT(1), W(1), PERM(1), LISTVAR_SCHUR(1), NCLIQUES, + & AGG6) + ELSE + NBBUCK = 2*TGSIZE + CALL MUMPS_733(HEAD, NBBUCK+2, id%INFO, + & LP, STRING='J2:HEAD', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(PERM, TGSIZE, id%INFO, + & LP, STRING='J2:PERM', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rehead:',MEMCNT,MAXMEM +#endif + CALL MUMPS_419 (ord%TOPSTRAT, 2, .FALSE., TGSIZE, + & NBBUCK, MUMPS_795(PE), IPET(1), PFREET, LENG(1), + & PE(1), NVT(1), ELEN(1), LAST(1), NCMPA, DEGREE(1), + & PERM(1), NEXT(1), W(1), HEAD(1), AGG6, NCLIQUES, + & LISTVAR_SCHUR(1) ) + END IF + END IF + CALL MPI_BARRIER(id%COMM, IERR) + CALL MUMPS_734(LISTVAR_SCHUR, PE, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall lvs:',MEMCNT,MAXMEM +#endif + IF(MYID .EQ. 0) THEN + BUF_PE1 => WORK( 1 : id%N) + BUF_PE2 => WORK( id%N+1 : 2*id%N) + BUF_NV1 => WORK(2*id%N+1 : 3*id%N) + BUF_NV2 => WORK(3*id%N+1 : 4*id%N) + MAXS = NROWS_LOC + DO I=2, NPROCS + IF((ord%LAST(I)-ord%FIRST(I)+1) .GT. MAXS) + & MAXS = (ord%LAST(I)-ord%FIRST(I)+1) + END DO + CALL MUMPS_733(BUF_PE1, MAXS, id%INFO, + & LP, STRING='BUF_PE1', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(BUF_PE2, MAXS, id%INFO, + & LP, STRING='BUF_PE2', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(BUF_NV1, MAXS, id%INFO, + & LP, STRING='BUF_NV1', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(BUF_NV2, MAXS, id%INFO, + & LP, STRING='BUF_NV2', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(GPE, id%N, id%INFO, + & LP, STRING='GPE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(GNV, id%N, id%INFO, + & LP, STRING='GNV', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ROOTPERM, NCLIQUES, id%INFO, + & LP, STRING='ROOTPERM', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT buf_pe1:',MEMCNT, + & MAXMEM +#endif + RIDX = 0 + TMP1 => BUF_PE1 + TMP2 => BUF_NV1 + NULLIFY(BUF_PE1, BUF_NV1) + BUF_PE1 => IPE + BUF_NV1 => NV + DO PROC=0, NPROCS-2 + CALL MPI_IRECV(BUF_PE2(1), ord%LAST(PROC+2)- + & ord%FIRST(PROC+2)+1, MPI_INTEGER, PROC+1, PROC+1, + & id%COMM, RHANDPE, IERR) + CALL MPI_IRECV(BUF_NV2(1), ord%LAST(PROC+2)- + & ord%FIRST(PROC+2)+1, MPI_INTEGER, PROC+1, PROC+1, + & id%COMM, RHANDNV, IERR) + DO I=1, ord%LAST(PROC+1)-ord%FIRST(PROC+1)+1 + GLOB_IDX = ord%PERITAB(I+ord%FIRST(PROC+1)-1) + IF(BUF_PE1(I) .GT. 0) THEN + RIDX=RIDX+1 + ROOTPERM(RIDX) = GLOB_IDX + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE IF (BUF_PE1(I) .EQ. 0) THEN + GPE(GLOB_IDX) = 0 + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE + GPE(GLOB_IDX) = -ord%PERITAB(-BUF_PE1(I)+ + & ord%FIRST(PROC+1)-1) + GNV(GLOB_IDX) = BUF_NV1(I) + END IF + END DO + CALL MPI_WAIT(RHANDPE, STATUSPE, IERR) + CALL MPI_WAIT(RHANDNV, STATUSNV, IERR) + IF(PROC .NE. 0) THEN + TMP1 => BUF_PE1 + TMP2 => BUF_NV1 + END IF + BUF_PE1 => BUF_PE2 + BUF_NV1 => BUF_NV2 + NULLIFY(BUF_PE2, BUF_NV2) + BUF_PE2 => TMP1 + BUF_NV2 => TMP2 + NULLIFY(TMP1, TMP2) + END DO + DO I=1, ord%LAST(PROC+1)-ord%FIRST(PROC+1)+1 + GLOB_IDX = ord%PERITAB(I+ord%FIRST(PROC+1)-1) + IF(BUF_PE1(I) .GT. 0) THEN + RIDX=RIDX+1 + ROOTPERM(RIDX) = GLOB_IDX + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE IF (BUF_PE1(I) .EQ. 0) THEN + GPE(GLOB_IDX) = 0 + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE + GPE(GLOB_IDX) = -ord%PERITAB(-BUF_PE1(I)+ + & ord%FIRST(PROC+1)-1) + GNV(GLOB_IDX) = BUF_NV1(I) + END IF + END DO + DO I=1, NTVAR + GLOB_IDX = LIPERM(I) + IF(IPET(I) .EQ. 0) THEN + GPE(GLOB_IDX) = 0 + GNV(GLOB_IDX) = NVT(I) + ELSE + GPE(GLOB_IDX) = -LIPERM(-IPET(I)) + GNV(GLOB_IDX) = NVT(I) + END IF + END DO + DO I=1, NCLIQUES + GLOB_IDX = ROOTPERM(I) + GPE(GLOB_IDX) = -LIPERM(-IPET(NTVAR+I)) + END DO + ELSE + CALL MPI_SEND(IPE(1), ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1, + & MPI_INTEGER, 0, MYID, id%COMM, IERR) + CALL MPI_SEND(NV(1), ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1, + & MPI_INTEGER, 0, MYID, id%COMM, IERR) + END IF + CALL MUMPS_734(PE, IPE, I_HALO_MAP, NDENSE, + & LAST, DEGREE, MEMCNT=MEMCNT) + CALL MUMPS_734(W, LISTVAR_SCHUR, NEXT, + & NV, MEMCNT=MEMCNT) + CALL MUMPS_734(LSTVAR, NROOTS, MYLIST, MYNVAR, + & LVARPT, MEMCNT=MEMCNT) + CALL MUMPS_734(LPERM, LIPERM, IPET, NVT, + & MEMCNT=MEMCNT) + CALL MUMPS_734(ROOTPERM, TMP1, TMP2, MEMCNT=MEMCNT) + NULLIFY(HEAD, ELEN, LENG, PERM, RCVCNT) + RETURN + END SUBROUTINE CMUMPS_720 + SUBROUTINE CMUMPS_782(id, TOPNODES, LPERM, LIPERM, ord) + IMPLICIT NONE + TYPE(CMUMPS_STRUC) :: id + INTEGER, POINTER :: TOPNODES(:), LPERM(:), LIPERM(:) + TYPE(ORD_TYPE) :: ord + INTEGER :: I, J, K, GIDX + CALL MUMPS_733(LPERM , ord%N, id%INFO, + & LP, STRING='LIDX:LPERM', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LIPERM, TOPNODES(2), id%INFO, + & LP, STRING='LIDX:LIPERM', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')id%myid,'MEMCNT lperm:',MEMCNT, + & MAXMEM +#endif + LPERM = 0 + K = 1 + DO I=1, TOPNODES(1) + DO J=TOPNODES(2*I+1), TOPNODES(2*I+2) + GIDX = ord%PERITAB(J) + LPERM(GIDX) = K + LIPERM(K) = GIDX + K = K+1 + END DO + END DO + RETURN + END SUBROUTINE CMUMPS_782 + SUBROUTINE CMUMPS_774(id, NLOCVARS, LPERM, + & top_graph, NCLIQUES, LSTVAR, LVARPT, IPE, PE, LENG, ELEN) + IMPLICIT NONE + TYPE(CMUMPS_STRUC) :: id + TYPE(GRAPH_TYPE) :: top_graph + INTEGER, POINTER :: LPERM(:), LSTVAR(:), LVARPT(:), + & IPE(:), PE(:), LENG(:), ELEN(:) + INTEGER :: NCLIQUES + INTEGER :: I, J, IDX, NLOCVARS, PNT, SAVEPNT + CALL MUMPS_733(LENG, max(NLOCVARS+NCLIQUES,1) , id%INFO, + & LP, STRING='ATG:LENG', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ELEN, max(NLOCVARS+NCLIQUES,1) , id%INFO, + & LP, STRING='ATG:ELEN', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(IPE , NLOCVARS+NCLIQUES+1, id%INFO, + & LP, STRING='ATG:IPE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')id%myid,'MEMCNT leng:',MEMCNT, + & MAXMEM +#endif + LENG = 0 + ELEN = 0 + DO I=1, top_graph%NZ_LOC + IF((LPERM(top_graph%JCN_LOC(I)) .NE. 0) .AND. + & (top_graph%JCN_LOC(I) .NE. top_graph%IRN_LOC(I))) THEN + LENG(LPERM(top_graph%IRN_LOC(I))) = + & LENG(LPERM(top_graph%IRN_LOC(I))) + 1 + END IF + END DO + DO I=1, NCLIQUES + DO J=LVARPT(I), LVARPT(I+1)-1 + ELEN(LPERM(LSTVAR(J))) = ELEN(LPERM(LSTVAR(J)))+1 + LENG(NLOCVARS+I) = LENG(NLOCVARS+I)+1 + END DO + END DO + IPE(1) = 1 + DO I=1, NLOCVARS+NCLIQUES + IPE(I+1) = IPE(I)+LENG(I)+ELEN(I) + END DO + CALL MUMPS_733(PE, IPE(NLOCVARS+NCLIQUES+1)+NLOCVARS+NCLIQUES, + & id%INFO, LP, STRING='ATG:PE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')id%myid,'MEMCNT repe:',MEMCNT, + & MAXMEM +#endif + LENG = 0 + ELEN = 0 + DO I=1, NCLIQUES + DO J=LVARPT(I), LVARPT(I+1)-1 + IDX = LPERM(LSTVAR(J)) + PE(IPE(IDX)+ELEN(IDX)) = NLOCVARS+I + PE(IPE(NLOCVARS+I)+LENG(NLOCVARS+I)) = IDX + ELEN(LPERM(LSTVAR(J))) = ELEN(LPERM(LSTVAR(J)))+1 + LENG(NLOCVARS+I) = LENG(NLOCVARS+I)+1 + end do + end do + DO I=1, top_graph%NZ_LOC + IF((LPERM(top_graph%JCN_LOC(I)) .NE. 0) .AND. + & (top_graph%JCN_LOC(I) .NE. top_graph%IRN_LOC(I))) THEN + PE(IPE(LPERM(top_graph%IRN_LOC(I)))+ + & ELEN(LPERM(top_graph%IRN_LOC(I))) + + & LENG(LPERM(top_graph%IRN_LOC(I)))) = + & LPERM(top_graph%JCN_LOC(I)) + LENG(LPERM(top_graph%IRN_LOC(I))) = + & LENG(LPERM(top_graph%IRN_LOC(I))) + 1 + END IF + END DO + DO I=1, NLOCVARS+NCLIQUES + LENG(I) = LENG(I)+ELEN(I) + END DO + SAVEPNT = 1 + PNT = 0 + LPERM(1:NLOCVARS+NCLIQUES) = 0 + DO I=1, NLOCVARS+NCLIQUES + DO J=IPE(I), IPE(I+1)-1 + IF(LPERM(PE(J)) .EQ. I) THEN + LENG(I) = LENG(I)-1 + ELSE + LPERM(PE(J)) = I + PNT = PNT+1 + PE(PNT) = PE(J) + END IF + END DO + IPE(I) = SAVEPNT + SAVEPNT = PNT+1 + END DO + IPE(NLOCVARS+NCLIQUES+1) = SAVEPNT + RETURN + END SUBROUTINE CMUMPS_774 + SUBROUTINE CMUMPS_778(TREETAB, RANGTAB, SIZES, CBLKNBR) + INTEGER, POINTER :: TREETAB(:), RANGTAB(:), SIZES(:) + INTEGER :: CBLKNBR + INTEGER :: LCHILD, RCHILD, K, I + INTEGER, POINTER :: PERM(:) + ALLOCATE(PERM(CBLKNBR)) + TREETAB(CBLKNBR) = -1 + IF(CBLKNBR .EQ. 1) THEN + DEALLOCATE(PERM) + TREETAB(1) = -1 + RANGTAB(1:2) = (/1, SIZES(1)+1/) + RETURN + END IF + LCHILD = CBLKNBR - (CBLKNBR+1)/2 + RCHILD = CBLKNBR-1 + K = 1 + PERM(CBLKNBR) = CBLKNBR + PERM(LCHILD) = CBLKNBR+1 - (2*K+1) + PERM(RCHILD) = CBLKNBR+1 - (2*K) + TREETAB(RCHILD) = CBLKNBR + TREETAB(LCHILD) = CBLKNBR + IF(CBLKNBR .GT. 3) THEN + CALL REC_TREETAB(TREETAB, PERM, (CBLKNBR-1)/2, + & LCHILD, CBLKNBR, 2*K+1) + CALL REC_TREETAB(TREETAB, PERM, (CBLKNBR-1)/2, + & RCHILD, CBLKNBR, 2*K) + END IF + RANGTAB(1)=1 + DO I=1, CBLKNBR + RANGTAB(I+1) = RANGTAB(I)+SIZES(PERM(I)) + END DO + DEALLOCATE(PERM) + RETURN + CONTAINS + RECURSIVE SUBROUTINE REC_TREETAB(TREETAB, PERM, SUBNODES, + & ROOTN, CBLKNBR, K) + INTEGER, POINTER :: TREETAB(:), PERM(:) + INTEGER :: SUBNODES, ROOTN, K, CBLKNBR + INTEGER :: LCHILD, RCHILD + LCHILD = ROOTN - (SUBNODES+1)/2 + RCHILD = ROOTN-1 + PERM(LCHILD) = CBLKNBR+1 - (2*K+1) + PERM(RCHILD) = CBLKNBR+1 - (2*K) + TREETAB(RCHILD) = ROOTN + TREETAB(LCHILD) = ROOTN + IF(SUBNODES .GT. 3) THEN + CALL REC_TREETAB(TREETAB, PERM, (SUBNODES-1)/2, LCHILD, + & CBLKNBR, 2*K+1) + CALL REC_TREETAB(TREETAB, PERM, (SUBNODES-1)/2, RCHILD, + & CBLKNBR, 2*K) + END IF + END SUBROUTINE REC_TREETAB + END SUBROUTINE CMUMPS_778 + SUBROUTINE CMUMPS_776(id, FIRST, LAST, IPE, + & PE, WORK) + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(CMUMPS_STRUC) :: id + INTEGER, POINTER :: FIRST(:), LAST(:), IPE(:), PE(:), + & WORK(:) + INTEGER :: IERR, MYID, NPROCS + INTEGER :: I, PROC, LOCNNZ, + & NEW_LOCNNZ, J, LOC_ROW + INTEGER :: TOP_CNT, TIDX, + & NROWS_LOC, DUPS, TOTDUPS, OFFDIAG + INTEGER :: STATUS(MPI_STATUS_SIZE) + INTEGER, POINTER :: MAPTAB(:), + & SNDCNT(:), RCVCNT(:), SDISPL(:) + INTEGER, POINTER :: RDISPL(:), + & MSGCNT(:), SIPES(:,:), LENG(:) + INTEGER, POINTER :: PCNT(:), TSENDI(:), + & TSENDJ(:), RCVBUF(:) + TYPE(ARRPNT), POINTER :: APNT(:) + INTEGER :: BUFSIZE, SOURCE, RCVPNT, MAXS, PNT, + & SAVEPNT + INTEGER, PARAMETER :: ITAG=30 + LOGICAL :: FLAG + DOUBLE PRECISION :: SYMMETRY + nullify(MAPTAB, SNDCNT, RCVCNT, SDISPL) + nullify(RDISPL, MSGCNT, SIPES, LENG) + nullify(PCNT, TSENDI, TSENDJ, RCVBUF, APNT) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. id%N*2) THEN + WRITE(LP, + & '("Insufficient workspace inside BUILD_SCOTCH_GRAPH")') + CALL MUMPS_ABORT() + END IF + CALL MUMPS_733(SNDCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(RCVCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(MSGCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT sndcnt:',MEMCNT,MAXMEM +#endif + ALLOCATE(APNT(NPROCS)) + SNDCNT = 0 + TOP_CNT = 0 + BUFSIZE = 1000 + LOCNNZ = id%NZ_loc + NROWS_LOC = LAST(MYID+1)-FIRST(MYID+1)+1 + MAPTAB => WORK( 1 : id%N) + LENG => WORK(id%N+1 : 2*id%N) + MAXS = 0 + DO I=1, NPROCS + IF((LAST(I)-FIRST(I)+1) .GT. MAXS) THEN + MAXS = LAST(I)-FIRST(I)+1 + END IF + DO J=FIRST(I), LAST(I) + MAPTAB(J) = I + END DO + END DO + ALLOCATE(SIPES(max(1,MAXS), NPROCS)) + OFFDIAG=0 + SIPES=0 + DO I=1, id%NZ_loc + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + OFFDIAG = OFFDIAG+1 + PROC = MAPTAB(id%IRN_loc(I)) + LOC_ROW = id%IRN_loc(I)-FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + PROC = MAPTAB(id%JCN_loc(I)) + LOC_ROW = id%JCN_loc(I)-FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + END IF + END DO + CALL MPI_ALLREDUCE (OFFDIAG, id%KEEP(114), 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR) + id%KEEP(114) = id%KEEP(114)+3*id%N + id%KEEP(113) = id%KEEP(114)-2*id%N + CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, id%COMM, IERR) + SNDCNT(:) = MAXS + CALL MPI_REDUCE_SCATTER ( SIPES(1,1), LENG(1), SNDCNT(1), + & MPI_INTEGER, MPI_SUM, id%COMM, IERR ) + DEALLOCATE(SIPES) + CALL MUMPS_733(IPE, NROWS_LOC+1, id%INFO, + & LP, STRING='IPE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT ripe:',MEMCNT,MAXMEM +#endif + IPE(1) = 1 + DO I=1, NROWS_LOC + IPE(I+1) = IPE(I) + LENG(I) + END DO + CALL MUMPS_733(PE, max(IPE(NROWS_LOC+1)-1,1), id%INFO, + & LP, STRING='PE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rrpe:',MEMCNT,MAXMEM +#endif + LENG(:) = 0 + CALL CMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, LENG, + & RCVBUF, MSGCNT, SNDCNT, id%COMM) + NEW_LOCNNZ = sum(RCVCNT) + DO I=1, NPROCS + MSGCNT(I) = RCVCNT(I)/BUFSIZE + END DO + RCVPNT = 1 + SNDCNT = 0 + TIDX = 0 + DO I=1, id%NZ_loc + IF(mod(I,BUFSIZE/10) .EQ. 0) THEN + CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, MPI_COMM_WORLD, + & FLAG, STATUS, IERR ) + IF(FLAG) THEN + SOURCE = STATUS(MPI_SOURCE) + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, SOURCE, + & ITAG, MPI_COMM_WORLD, STATUS, IERR) + CALL CMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + RCVPNT = RCVPNT + BUFSIZE + END IF + END IF + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + PROC = MAPTAB(id%IRN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) = id%IRN_loc(I)- + & FIRST(PROC)+1 + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = id%JCN_loc(I) + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL CMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, + & PE, LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + PROC = MAPTAB(id%JCN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) = id%JCN_loc(I)- + & FIRST(PROC)+1 + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = id%IRN_loc(I) + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL CMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, + & PE, LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + END IF + END DO + CALL CMUMPS_785(APNT, -1, NPROCS, BUFSIZE, IPE, PE, LENG, + & RCVBUF, MSGCNT, SNDCNT, id%COMM) + DUPS = 0 + PNT = 0 + SAVEPNT = 1 + MAPTAB = 0 + DO I=1, NROWS_LOC + DO J=IPE(I),IPE(I+1)-1 + IF(MAPTAB(PE(J)) .EQ. I) THEN + DUPS = DUPS+1 + ELSE + MAPTAB(PE(J)) = I + PNT = PNT+1 + PE(PNT) = PE(J) + END IF + END DO + IPE(I) = SAVEPNT + SAVEPNT = PNT+1 + END DO + CALL MPI_REDUCE( DUPS, TOTDUPS, 1, MPI_INTEGER, MPI_SUM, + & 0, id%COMM, IERR ) + SYMMETRY = dble(TOTDUPS)/(dble(id%NZ)-dble(id%N)) + IF(MYID .EQ. 0) THEN + IF(id%KEEP(50) .GE. 1) SYMMETRY = 1.d0 + IF(PROKG) WRITE(MPG,'("Structual symmetry is:",i3,"%")') + & ceiling(SYMMETRY*100.d0) + id%INFOG(8) = ceiling(SYMMETRY*100.0d0) + END IF + IPE(NROWS_LOC+1) = SAVEPNT + CALL MUMPS_734(SNDCNT, RCVCNT, MSGCNT, MEMCNT=MEMCNT) + DEALLOCATE(APNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall sndcnt:',MEMCNT,MAXMEM +#endif + RETURN + END SUBROUTINE CMUMPS_776 + SUBROUTINE CMUMPS_775(id, ord, GSIZE, IPE, PE, LENG, + & I_HALO_MAP, top_graph, WORK) + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(CMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + TYPE(GRAPH_TYPE) :: top_graph + INTEGER, POINTER :: IPE(:), PE(:), LENG(:), + & I_HALO_MAP(:), WORK(:) + INTEGER :: GSIZE + INTEGER :: IERR, MYID, NPROCS + INTEGER :: I, PROC, LOCNNZ, + & NEW_LOCNNZ, J, LOC_ROW + INTEGER :: TOP_CNT,IIDX,JJDX + INTEGER :: HALO_SIZE, TIDX, NROWS_LOC, DUPS + INTEGER :: STATUS(MPI_STATUS_SIZE) + INTEGER, POINTER :: MAPTAB(:), + & SNDCNT(:), RCVCNT(:), + & SDISPL(:), HALO_MAP(:) + INTEGER, POINTER :: RDISPL(:), + & MSGCNT(:), SIPES(:,:) + INTEGER, POINTER :: PCNT(:), TSENDI(:), + & TSENDJ(:), RCVBUF(:) + TYPE(ARRPNT), POINTER :: APNT(:) + INTEGER :: BUFSIZE, SOURCE, RCVPNT, MAXS, PNT, + & SAVEPNT + INTEGER, PARAMETER :: ITAG=30 + LOGICAL :: FLAG + nullify(MAPTAB, SNDCNT, RCVCNT, SDISPL, HALO_MAP) + nullify(RDISPL, MSGCNT, SIPES) + nullify(PCNT, TSENDI, TSENDJ, RCVBUF, APNT) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. id%N*2) THEN + WRITE(LP, + & '("Insufficient workspace inside BUILD_LOC_GRAPH")') + CALL MUMPS_ABORT() + END IF + MAPTAB => WORK( 1 : id%N) + HALO_MAP => WORK(id%N+1 : 2*id%N) + CALL MUMPS_733(SNDCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(RCVCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(MSGCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rrsndcnt:',MEMCNT,MAXMEM +#endif + ALLOCATE(APNT(NPROCS)) + SNDCNT = 0 + TOP_CNT = 0 + BUFSIZE = 10000 + LOCNNZ = id%NZ_loc + NROWS_LOC = ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1 + MAPTAB = 0 + MAXS = 0 + DO I=1, NPROCS + IF((ord%LAST(I)-ord%FIRST(I)+1) .GT. MAXS) THEN + MAXS = ord%LAST(I)-ord%FIRST(I)+1 + END IF + DO J=ord%FIRST(I), ord%LAST(I) + MAPTAB(ord%PERITAB(J)) = I + END DO + END DO + ALLOCATE(SIPES(max(1,MAXS), NPROCS)) + SIPES(:,:) = 0 + TOP_CNT = 0 + DO I=1, id%NZ_loc + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + PROC = MAPTAB(id%IRN_loc(I)) + IF(PROC .EQ. 0) THEN + TOP_CNT = TOP_CNT+1 + ELSE + IIDX = ord%PERMTAB(id%IRN_loc(I)) + LOC_ROW = IIDX-ord%FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + END IF + PROC = MAPTAB(id%JCN_loc(I)) + IF(PROC .EQ. 0) THEN + TOP_CNT = TOP_CNT+1 + ELSE + IIDX = ord%PERMTAB(id%JCN_loc(I)) + LOC_ROW = IIDX-ord%FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + END IF + END IF + END DO + CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, id%COMM, IERR) + I = ceiling(real(MAXS)*1.20E0) + CALL MUMPS_733(LENG, max(I,1), id%INFO, + & LP, STRING='B_L_G:LENG', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rrleng2:',MEMCNT, + & MAXMEM +#endif + SNDCNT(:) = MAXS + CALL MPI_REDUCE_SCATTER ( SIPES(1,1), LENG(1), SNDCNT(1), + & MPI_INTEGER, MPI_SUM, id%COMM, IERR ) + DEALLOCATE(SIPES) + I = ceiling(real(NROWS_LOC+1)*1.20E0) + CALL MUMPS_733(IPE, max(I,1), id%INFO, + & LP, STRING='B_L_G:IPE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rripe:',MEMCNT,MAXMEM +#endif + IPE(1) = 1 + DO I=1, NROWS_LOC + IPE(I+1) = IPE(I) + LENG(I) + END DO + CALL MUMPS_733(TSENDI, max(TOP_CNT,1), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(TSENDJ, max(TOP_CNT,1), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT tsendi:',MEMCNT,MAXMEM +#endif + LENG(:) = 0 + CALL CMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, + & LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + NEW_LOCNNZ = sum(RCVCNT) + DO I=1, NPROCS + MSGCNT(I) = RCVCNT(I)/BUFSIZE + END DO + CALL MUMPS_733(PE, max(NEW_LOCNNZ+2*NROWS_LOC,1), id%INFO, + & LP, STRING='B_L_G:PE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rrpe2:',MEMCNT,MAXMEM +#endif + RCVPNT = 1 + SNDCNT = 0 + TIDX = 0 + DO I=1, id%NZ_loc + IF(mod(I,BUFSIZE/10) .EQ. 0) THEN + CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, MPI_COMM_WORLD, + & FLAG, STATUS, IERR ) + IF(FLAG) THEN + SOURCE = STATUS(MPI_SOURCE) + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, SOURCE, + & ITAG, MPI_COMM_WORLD, STATUS, IERR) + CALL CMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + RCVPNT = RCVPNT + BUFSIZE + END IF + END IF + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + PROC = MAPTAB(id%IRN_loc(I)) + IF(PROC .EQ. 0) THEN + TIDX = TIDX+1 + TSENDI(TIDX) = id%IRN_loc(I) + TSENDJ(TIDX) = id%JCN_loc(I) + ELSE + IIDX = ord%PERMTAB(id%IRN_loc(I)) + JJDX = ord%PERMTAB(id%JCN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) =IIDX-ord%FIRST(PROC)+1 + IF( (JJDX .GE. ord%FIRST(PROC)) .AND. + & (JJDX .LE. ord%LAST(PROC)) ) THEN + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = JJDX-ord%FIRST(PROC)+1 + ELSE + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = -id%JCN_loc(I) + END IF + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL CMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, + & PE, LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + END IF + PROC = MAPTAB(id%JCN_loc(I)) + IF(PROC .EQ. 0) THEN + TIDX = TIDX+1 + TSENDI(TIDX) = id%JCN_loc(I) + TSENDJ(TIDX) = id%IRN_loc(I) + ELSE + IIDX = ord%PERMTAB(id%JCN_loc(I)) + JJDX = ord%PERMTAB(id%IRN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) = IIDX-ord%FIRST(PROC)+1 + IF( (JJDX .GE. ord%FIRST(PROC)) .AND. + & (JJDX .LE. ord%LAST(PROC)) ) THEN + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = JJDX-ord%FIRST(PROC)+1 + ELSE + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = -id%IRN_loc(I) + END IF + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL CMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, + & LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + END IF + END IF + END DO + CALL CMUMPS_785(APNT, -1, NPROCS, BUFSIZE, IPE, PE, LENG, + & RCVBUF, MSGCNT, SNDCNT, id%COMM) + DUPS = 0 + PNT = 0 + SAVEPNT = 1 + MAPTAB(:) = 0 + HALO_MAP(:) = 0 + HALO_SIZE = 0 + DO I=1, NROWS_LOC + DO J=IPE(I),IPE(I+1)-1 + IF(PE(J) .LT. 0) THEN + IF(HALO_MAP(-PE(J)) .EQ. 0) THEN + HALO_SIZE = HALO_SIZE+1 + HALO_MAP(-PE(J)) = NROWS_LOC+HALO_SIZE + END IF + PE(J) = HALO_MAP(-PE(J)) + END IF + IF(MAPTAB(PE(J)) .EQ. I) THEN + DUPS = DUPS+1 + LENG(I) = LENG(I)-1 + ELSE + MAPTAB(PE(J)) = I + PNT = PNT+1 + PE(PNT) = PE(J) + END IF + END DO + IPE(I) = SAVEPNT + SAVEPNT = PNT+1 + END DO + IPE(NROWS_LOC+1) = SAVEPNT + CALL MUMPS_733(I_HALO_MAP, HALO_SIZE, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT i_halo:',MEMCNT,MAXMEM +#endif + J=0 + DO I=1, id%N + IF(HALO_MAP(I) .GT. 0) THEN + J = J+1 + I_HALO_MAP(HALO_MAP(I)-NROWS_LOC) = I + END IF + IF(J .EQ. HALO_SIZE) EXIT + END DO + CALL MUMPS_733(LENG, max(NROWS_LOC+HALO_SIZE,1), id%INFO, + & LP, COPY=.TRUE., + & STRING='lcgrph:leng', MEMCNT=MEMCNT, ERRCODE=-7) + LENG(NROWS_LOC+1:NROWS_LOC+HALO_SIZE) = 0 + CALL MUMPS_733(IPE, NROWS_LOC+HALO_SIZE+1, id%INFO, + & LP, COPY=.TRUE., + & STRING='lcgrph:ipe', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT lengipe:',MEMCNT, + & MAXMEM +#endif + IPE(NROWS_LOC+2:NROWS_LOC+HALO_SIZE+1) = IPE(NROWS_LOC+1) + GSIZE = NROWS_LOC + HALO_SIZE + CALL MPI_GATHER(TOP_CNT, 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, 0, id%COMM, IERR) + RDISPL => MSGCNT + NULLIFY(MSGCNT) + IF(MYID.EQ.0) THEN + NEW_LOCNNZ = sum(RCVCNT) + RDISPL(1) = 0 + DO I=2, NPROCS + RDISPL(I) = RDISPL(I-1)+RCVCNT(I-1) + END DO + top_graph%NZ_LOC = NEW_LOCNNZ + top_graph%COMM = id%COMM + CALL MUMPS_733(top_graph%IRN_LOC, NEW_LOCNNZ, id%INFO, + & LP, MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(top_graph%JCN_LOC, NEW_LOCNNZ, id%INFO, + & LP, MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT top_graph:',MEMCNT, + & MAXMEM +#endif + ELSE + ALLOCATE(top_graph%IRN_LOC(1), top_graph%JCN_LOC(1)) + END IF + CALL MPI_GATHERV(TSENDI(1), TOP_CNT, MPI_INTEGER, + & top_graph%IRN_LOC(1), RCVCNT(1), RDISPL(1), MPI_INTEGER, + & 0, id%COMM, IERR) + CALL MPI_GATHERV(TSENDJ(1), TOP_CNT, MPI_INTEGER, + & top_graph%JCN_LOC(1), RCVCNT(1), RDISPL(1), MPI_INTEGER, + & 0, id%COMM, IERR) + CALL MUMPS_734(SNDCNT, RCVCNT, RDISPL, + & TSENDI, TSENDJ, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall sndcnt:',MEMCNT,MAXMEM +#endif + DEALLOCATE(APNT) + RETURN + END SUBROUTINE CMUMPS_775 + SUBROUTINE CMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, + & LENG, RCVBUF, MSGCNT, SNDCNT, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER :: NPROCS, PROC, COMM + TYPE(ARRPNT) :: APNT(:) + INTEGER :: BUFSIZE + INTEGER, POINTER :: RCVBUF(:), LENG(:), PE(:), IPE(:) + INTEGER :: MSGCNT(:), SNDCNT(:) + LOGICAL, SAVE :: INIT = .TRUE. + INTEGER, POINTER, SAVE :: SPACE(:,:,:) + LOGICAL, POINTER, SAVE :: PENDING(:) + INTEGER, POINTER, SAVE :: REQ(:), CPNT(:) + INTEGER :: IERR, MYID, I, SOURCE, TOTMSG + LOGICAL :: FLAG, TFLAG + INTEGER :: STATUS(MPI_STATUS_SIZE), + & TSTATUS(MPI_STATUS_SIZE) + INTEGER, PARAMETER :: ITAG=30, FTAG=31 + INTEGER, POINTER :: TMPI(:), RCVCNT(:) + CALL MPI_COMM_RANK (COMM, MYID, IERR) + CALL MPI_COMM_SIZE (COMM, NPROCS, IERR) + IF(INIT) THEN + ALLOCATE(SPACE(2*BUFSIZE, 2, NPROCS)) + ALLOCATE(RCVBUF(2*BUFSIZE)) + ALLOCATE(PENDING(NPROCS), CPNT(NPROCS)) + ALLOCATE(REQ(NPROCS)) + PENDING = .FALSE. + DO I=1, NPROCS + APNT(I)%BUF => SPACE(:,1,I) + CPNT(I) = 1 + END DO + INIT = .FALSE. + RETURN + END IF + IF(PROC .EQ. -1) THEN + TOTMSG = sum(MSGCNT) + DO + IF(TOTMSG .EQ. 0) EXIT + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, + & MPI_ANY_SOURCE, ITAG, COMM, STATUS, IERR) + CALL CMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) + SOURCE = STATUS(MPI_SOURCE) + TOTMSG = TOTMSG-1 + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + END DO + DO I=1, NPROCS + IF(PENDING(I)) THEN + CALL MPI_WAIT(REQ(I), TSTATUS, IERR) + END IF + END DO + ALLOCATE(RCVCNT(NPROCS)) + CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, COMM, IERR) + DO I=1, NPROCS + IF(SNDCNT(I) .GT. 0) THEN + TMPI => APNT(I)%BUF(:) + CALL MPI_ISEND(TMPI(1), 2*SNDCNT(I), MPI_INTEGER, I-1, + & FTAG, COMM, REQ(I), IERR) + END IF + END DO + DO I=1, NPROCS + IF(RCVCNT(I) .GT. 0) THEN + CALL MPI_RECV(RCVBUF(1), 2*RCVCNT(I), MPI_INTEGER, I-1, + & FTAG, COMM, STATUS, IERR) + CALL CMUMPS_773(RCVCNT(I), RCVBUF, + & IPE, PE, LENG) + END IF + END DO + DO I=1, NPROCS + IF(SNDCNT(I) .GT. 0) THEN + CALL MPI_WAIT(REQ(I), TSTATUS, IERR) + END IF + END DO + DEALLOCATE(SPACE) + DEALLOCATE(PENDING, CPNT) + DEALLOCATE(REQ) + DEALLOCATE(RCVBUF, RCVCNT) + nullify(SPACE, PENDING, CPNT, REQ, RCVBUF, RCVCNT) + INIT = .TRUE. + RETURN + END IF + IF(PENDING(PROC)) THEN + DO + CALL MPI_TEST(REQ(PROC), TFLAG, TSTATUS, IERR) + IF(TFLAG) THEN + PENDING(PROC) = .FALSE. + EXIT + ELSE + CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, COMM, + & FLAG, STATUS, IERR ) + IF(FLAG) THEN + SOURCE = STATUS(MPI_SOURCE) + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, + & SOURCE, ITAG, COMM, STATUS, IERR) + CALL CMUMPS_773(BUFSIZE, RCVBUF, IPE, + & PE, LENG) + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + END IF + END IF + END DO + END IF + TMPI => APNT(PROC)%BUF(:) + CALL MPI_ISEND(TMPI(1), 2*BUFSIZE, MPI_INTEGER, PROC-1, + & ITAG, COMM, REQ(PROC), IERR) + PENDING(PROC) = .TRUE. + CPNT(PROC) = mod(CPNT(PROC),2)+1 + APNT(PROC)%BUF => SPACE(:,CPNT(PROC),PROC) + SNDCNT(PROC) = 0 + RETURN + END SUBROUTINE CMUMPS_785 + SUBROUTINE CMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) +#ifdef MPELOG + USE MPEMOD + INCLUDE 'mpif.h' +#endif + IMPLICIT NONE + INTEGER :: BUFSIZE + INTEGER, POINTER :: RCVBUF(:), IPE(:), PE(:), LENG(:) + INTEGER :: I, ROW, COL +#ifdef MPELOG + INTEGER ::IERR + IERR = MPE_LOG_EVENT( MPE_ASM_BUF1, 0, '' ) +#endif + DO I=1, 2*BUFSIZE, 2 + ROW = RCVBUF(I) + COL = RCVBUF(I+1) + PE(IPE(ROW)+LENG(ROW)) = COL + LENG(ROW) = LENG(ROW) + 1 + END DO +#ifdef MPELOG + IERR = MPE_LOG_EVENT( MPE_ASM_BUF2, 0, '' ) +#endif + RETURN + END SUBROUTINE CMUMPS_773 + SUBROUTINE CMUMPS_777(ord) + TYPE(ORD_TYPE) :: ord + INTEGER :: I + ord%SON = -1 + ord%BROTHER = -1 + ord%NW = 0 + DO I=1, ord%CBLKNBR + ord%NW(I) = ord%NW(I)+ord%RANGTAB(I+1) - ord%RANGTAB(I) + IF (ord%TREETAB(I) .NE. -1) THEN + IF (ord%SON(ord%TREETAB(I)) .EQ. -1) THEN + ord%SON(ord%TREETAB(I)) = I + ELSE + ord%BROTHER(I) = ord%SON(ord%TREETAB(I)) + ord%SON(ord%TREETAB(I)) = I + END IF + ord%NW(ord%TREETAB(I)) = ord%NW(ord%TREETAB(I))+ ord%NW(I) + END IF + END DO + RETURN + END SUBROUTINE CMUMPS_777 + SUBROUTINE CMUMPS_784(N, L, A1, A2) + INTEGER :: I, LP, ISWAP, N + INTEGER :: L(0:), A1(:), A2(:) + LP = L(0) + I = 1 + DO + IF ((LP==0).OR.(I>N)) EXIT + DO + IF (LP >= I) EXIT + LP = L(LP) + END DO + ISWAP = A1(LP) + A1(LP) = A1(I) + A1(I) = ISWAP + ISWAP = A2(LP) + A2(LP) = A2(I) + A2(I) = ISWAP + ISWAP = L(LP) + L(LP) = L(I) + L(I) = LP + LP = ISWAP + I = I + 1 + ENDDO + END SUBROUTINE CMUMPS_784 + SUBROUTINE CMUMPS_783(N, K, L) + INTEGER :: N + INTEGER :: K(:), L(0:) + INTEGER :: P, Q, S, T + CONTINUE + L(0) = 1 + T = N + 1 + DO P = 1,N - 1 + IF (K(P) <= K(P+1)) THEN + L(P) = P + 1 + ELSE + L(T) = - (P+1) + T = P + END IF + END DO + L(T) = 0 + L(N) = 0 + IF (L(N+1) == 0) THEN + RETURN + ELSE + L(N+1) = iabs(L(N+1)) + END IF + 200 CONTINUE + S = 0 + T = N+1 + P = L(S) + Q = L(T) + IF(Q .EQ. 0) RETURN + 300 CONTINUE + IF(K(P) .GT. K(Q)) GOTO 600 + CONTINUE + L(S) = sign(P,L(S)) + S = P + P = L(P) + IF (P .GT. 0) GOTO 300 + CONTINUE + L(S) = Q + S = T + DO + T = Q + Q = L(Q) + IF (Q .LE. 0) EXIT + END DO + GOTO 800 + 600 CONTINUE + L(S) = sign(Q, L(S)) + S = Q + Q = L(Q) + IF (Q .GT. 0) GOTO 300 + CONTINUE + L(S) = P + S = T + DO + T = P + P = L(P) + IF (P .LE. 0) EXIT + END DO + 800 CONTINUE + P = -P + Q = -Q + IF(Q.EQ.0) THEN + L(S) = sign(P, L(S)) + L(T) = 0 + GOTO 200 + END IF + GOTO 300 + END SUBROUTINE CMUMPS_783 + FUNCTION MUMPS_795(A) + INTEGER, POINTER :: A(:) + INTEGER :: MUMPS_795 + IF(associated(A)) THEN + MUMPS_795 = size(A) + ELSE + MUMPS_795 = 0 + END IF + RETURN + END FUNCTION MUMPS_795 + SUBROUTINE MUMPS_734(A1, A2, A3, A4, A5, A6, A7, MEMCNT) + INTEGER, POINTER :: A1(:) + INTEGER, POINTER, OPTIONAL :: A2(:), A3(:), A4(:), A5(:), + & A6(:), A7(:) + INTEGER, OPTIONAL :: MEMCNT + INTEGER :: IMEMCNT + IMEMCNT = 0 + IF(associated(A1)) THEN + IMEMCNT = IMEMCNT+size(A1) + DEALLOCATE(A1) + END IF + IF(present(A2)) THEN + IF(associated(A2)) THEN + IMEMCNT = IMEMCNT+size(A2) + DEALLOCATE(A2) + END IF + END IF + IF(present(A3)) THEN + IF(associated(A3)) THEN + IMEMCNT = IMEMCNT+size(A3) + DEALLOCATE(A3) + END IF + END IF + IF(present(A4)) THEN + IF(associated(A4)) THEN + IMEMCNT = IMEMCNT+size(A4) + DEALLOCATE(A4) + END IF + END IF + IF(present(A5)) THEN + IF(associated(A5)) THEN + IMEMCNT = IMEMCNT+size(A5) + DEALLOCATE(A5) + END IF + END IF + IF(present(A6)) THEN + IF(associated(A6)) THEN + IMEMCNT = IMEMCNT+size(A6) + DEALLOCATE(A6) + END IF + END IF + IF(present(A7)) THEN + IF(associated(A7)) THEN + IMEMCNT = IMEMCNT+size(A7) + DEALLOCATE(A7) + END IF + END IF + IF(present(MEMCNT)) MEMCNT = MEMCNT-IMEMCNT + RETURN + END SUBROUTINE MUMPS_734 +#if defined(memprof) + FUNCTION ESTIMEM(MYID, N, NZR) + INTEGER :: ESTIMEM, MYID, NZR, N + IF(MYID.EQ.0) THEN + ESTIMEM = 12*N + ELSE + ESTIMEM = 7*N + END IF + IF(MYID.NE.0) TOPROWS=0 + IF(MYID .EQ. 0) ESTIMEM = ESTIMEM+2*TOPROWS*NZR + ESTIMEM = ESTIMEM+NRL + ESTIMEM = ESTIMEM+max(NRL,TOPROWS)*(NZR+2) + ESTIMEM = ESTIMEM+6*max(NRL,TOPROWS) + IF(MYID.EQ.0) ESTIMEM=ESTIMEM+3*TOPROWS + RETURN + END FUNCTION ESTIMEM +#endif + END MODULE + SUBROUTINE CMUMPS_448(ICNTL,CNTL) + IMPLICIT NONE + INTEGER NICNTL, NCNTL + PARAMETER (NICNTL=10, NCNTL=10) + INTEGER ICNTL(NICNTL) + REAL CNTL(NCNTL) + INTEGER I + ICNTL(1) = 6 + ICNTL(2) = 6 + ICNTL(3) = -1 + ICNTL(4) = -1 + ICNTL(5) = 0 + DO 10 I = 6,NICNTL + ICNTL(I) = 0 + 10 CONTINUE + CNTL(1) = 0.0E0 + CNTL(2) = 0.0E0 + DO 20 I = 3,NCNTL + CNTL(I) = 0.0E0 + 20 CONTINUE + RETURN + END SUBROUTINE CMUMPS_448 + SUBROUTINE CMUMPS_444 + & (M,N,NE,IP,IRN,A,IPERM,NUM,JPERM,PR,Q,L,D,RINF) + IMPLICIT NONE + INTEGER M,N,NE,NUM + INTEGER IP(N+1),IRN(NE),IPERM(M),JPERM(N),PR(N),Q(M),L(M) + REAL A(NE) + REAL D(M), RINF + INTEGER I,II,J,JJ,JORD,Q0,QLEN,IDUM,JDUM,ISP,JSP, + & K,KK,KK1,KK2,I0,UP,LOW + REAL CSP,DI,DNEW,DQ0,AI,A0,BV,TBV,RLX + REAL ZERO,MINONE,ONE + PARAMETER (ZERO=0.0E0,MINONE=-1.0E0,ONE=1.0E0) + INTRINSIC abs,min + EXTERNAL CMUMPS_445, CMUMPS_446, CMUMPS_447, CMUMPS_455 + RLX = D(1) + NUM = 0 + BV = RINF + DO 10 K = 1,N + JPERM(K) = 0 + PR(K) = IP(K) + 10 CONTINUE + DO 12 K = 1,M + IPERM(K) = 0 + D(K) = ZERO + 12 CONTINUE + DO 30 J = 1,N + A0 = MINONE + DO 20 K = IP(J),IP(J+1)-1 + I = IRN(K) + AI = abs(A(K)) + IF (AI.GT.D(I)) D(I) = AI + IF (JPERM(J).NE.0) GO TO 20 + IF (AI.GE.BV) THEN + A0 = BV + IF (IPERM(I).NE.0) GO TO 20 + JPERM(J) = I + IPERM(I) = J + NUM = NUM + 1 + ELSE + IF (AI.LE.A0) GO TO 20 + A0 = AI + I0 = I + ENDIF + 20 CONTINUE + IF (A0.NE.MINONE .AND. A0.LT.BV) THEN + BV = A0 + IF (IPERM(I0).NE.0) GO TO 30 + IPERM(I0) = J + JPERM(J) = I0 + NUM = NUM + 1 + ENDIF + 30 CONTINUE + IF (M.EQ.N) THEN + DO 35 I = 1,M + BV = min(BV,D(I)) + 35 CONTINUE + ENDIF + IF (NUM.EQ.N) GO TO 1000 + DO 95 J = 1,N + IF (JPERM(J).NE.0) GO TO 95 + DO 50 K = IP(J),IP(J+1)-1 + I = IRN(K) + AI = abs(A(K)) + IF (AI.LT.BV) GO TO 50 + IF (IPERM(I).EQ.0) GO TO 90 + JJ = IPERM(I) + KK1 = PR(JJ) + KK2 = IP(JJ+1) - 1 + IF (KK1.GT.KK2) GO TO 50 + DO 70 KK = KK1,KK2 + II = IRN(KK) + IF (IPERM(II).NE.0) GO TO 70 + IF (abs(A(KK)).GE.BV) GO TO 80 + 70 CONTINUE + PR(JJ) = KK2 + 1 + 50 CONTINUE + GO TO 95 + 80 JPERM(JJ) = II + IPERM(II) = JJ + PR(JJ) = KK + 1 + 90 NUM = NUM + 1 + JPERM(J) = I + IPERM(I) = J + PR(J) = K + 1 + 95 CONTINUE + IF (NUM.EQ.N) GO TO 1000 + DO 99 I = 1,M + D(I) = MINONE + L(I) = 0 + 99 CONTINUE + TBV = BV * (ONE-RLX) + DO 100 JORD = 1,N + IF (JPERM(JORD).NE.0) GO TO 100 + QLEN = 0 + LOW = M + 1 + UP = M + 1 + CSP = MINONE + J = JORD + PR(J) = -1 + DO 115 K = IP(J),IP(J+1)-1 + I = IRN(K) + DNEW = abs(A(K)) + IF (CSP.GE.DNEW) GO TO 115 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = I + JSP = J + IF (CSP.GE.TBV) GO TO 160 + ELSE + D(I) = DNEW + IF (DNEW.GE.TBV) THEN + LOW = LOW - 1 + Q(LOW) = I + ELSE + QLEN = QLEN + 1 + L(I) = QLEN + CALL CMUMPS_445(I,M,Q,D,L,1) + ENDIF + JJ = IPERM(I) + PR(JJ) = J + ENDIF + 115 CONTINUE + DO 150 JDUM = 1,NUM + IF (LOW.EQ.UP) THEN + IF (QLEN.EQ.0) GO TO 160 + I = Q(1) + IF (CSP.GE.D(I)) GO TO 160 + BV = D(I) + TBV = BV * (ONE-RLX) + DO 152 IDUM = 1,M + CALL CMUMPS_446(QLEN,M,Q,D,L,1) + L(I) = 0 + LOW = LOW - 1 + Q(LOW) = I + IF (QLEN.EQ.0) GO TO 153 + I = Q(1) + IF (D(I).LT.TBV) GO TO 153 + 152 CONTINUE + ENDIF + 153 UP = UP - 1 + Q0 = Q(UP) + DQ0 = D(Q0) + L(Q0) = UP + J = IPERM(Q0) + DO 155 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (L(I).GE.UP) GO TO 155 + DNEW = min(DQ0,abs(A(K))) + IF (CSP.GE.DNEW) GO TO 155 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = I + JSP = J + IF (CSP.GE.TBV) GO TO 160 + ELSE + DI = D(I) + IF (DI.GE.TBV .OR. DI.GE.DNEW) GO TO 155 + D(I) = DNEW + IF (DNEW.GE.TBV) THEN + IF (DI.NE.MINONE) THEN + CALL CMUMPS_447(L(I),QLEN,M,Q,D,L,1) + ENDIF + L(I) = 0 + LOW = LOW - 1 + Q(LOW) = I + ELSE + IF (DI.EQ.MINONE) THEN + QLEN = QLEN + 1 + L(I) = QLEN + ENDIF + CALL CMUMPS_445(I,M,Q,D,L,1) + ENDIF + JJ = IPERM(I) + PR(JJ) = J + ENDIF + 155 CONTINUE + 150 CONTINUE + 160 IF (CSP.EQ.MINONE) GO TO 190 + BV = min(BV,CSP) + TBV = BV * (ONE-RLX) + NUM = NUM + 1 + I = ISP + J = JSP + DO 170 JDUM = 1,NUM+1 + I0 = JPERM(J) + JPERM(J) = I + IPERM(I) = J + J = PR(J) + IF (J.EQ.-1) GO TO 190 + I = I0 + 170 CONTINUE + 190 DO 191 KK = UP,M + I = Q(KK) + D(I) = MINONE + L(I) = 0 + 191 CONTINUE + DO 192 KK = LOW,UP-1 + I = Q(KK) + D(I) = MINONE + 192 CONTINUE + DO 193 KK = 1,QLEN + I = Q(KK) + D(I) = MINONE + L(I) = 0 + 193 CONTINUE + 100 CONTINUE + 1000 IF (M.EQ.N .and. NUM.EQ.N) GO TO 2000 + CALL CMUMPS_455(M,N,IPERM,L,JPERM) + 2000 RETURN + END SUBROUTINE CMUMPS_444 + SUBROUTINE CMUMPS_445(I,N,Q,D,L,IWAY) + IMPLICIT NONE + INTEGER I,N,IWAY + INTEGER Q(N),L(N) + REAL D(N) + INTEGER IDUM,K,POS,POSK,QK + PARAMETER (K=2) + REAL DI + POS = L(I) + IF (POS.LE.1) GO TO 20 + DI = D(I) + IF (IWAY.EQ.1) THEN + DO 10 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.LE.D(QK)) GO TO 20 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 20 + 10 CONTINUE + ELSE + DO 15 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.GE.D(QK)) GO TO 20 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 20 + 15 CONTINUE + ENDIF + 20 Q(POS) = I + L(I) = POS + RETURN + END SUBROUTINE CMUMPS_445 + SUBROUTINE CMUMPS_446(QLEN,N,Q,D,L,IWAY) + IMPLICIT NONE + INTEGER QLEN,N,IWAY + INTEGER Q(N),L(N) + REAL D(N) + INTEGER I,IDUM,K,POS,POSK + PARAMETER (K=2) + REAL DK,DR,DI + I = Q(QLEN) + DI = D(I) + QLEN = QLEN - 1 + POS = 1 + IF (IWAY.EQ.1) THEN + DO 10 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 20 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.LT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.GE.DK) GO TO 20 + Q(POS) = Q(POSK) + L(Q(POS)) = POS + POS = POSK + 10 CONTINUE + ELSE + DO 15 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 20 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.GT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.LE.DK) GO TO 20 + Q(POS) = Q(POSK) + L(Q(POS)) = POS + POS = POSK + 15 CONTINUE + ENDIF + 20 Q(POS) = I + L(I) = POS + RETURN + END SUBROUTINE CMUMPS_446 + SUBROUTINE CMUMPS_447(POS0,QLEN,N,Q,D,L,IWAY) + IMPLICIT NONE + INTEGER POS0,QLEN,N,IWAY + INTEGER Q(N),L(N) + REAL D(N) + INTEGER I,IDUM,K,POS,POSK,QK + PARAMETER (K=2) + REAL DK,DR,DI + IF (QLEN.EQ.POS0) THEN + QLEN = QLEN - 1 + RETURN + ENDIF + I = Q(QLEN) + DI = D(I) + QLEN = QLEN - 1 + POS = POS0 + IF (IWAY.EQ.1) THEN + IF (POS.LE.1) GO TO 20 + DO 10 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.LE.D(QK)) GO TO 20 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 20 + 10 CONTINUE + 20 Q(POS) = I + L(I) = POS + IF (POS.NE.POS0) RETURN + DO 30 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 40 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.LT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.GE.DK) GO TO 40 + QK = Q(POSK) + Q(POS) = QK + L(QK) = POS + POS = POSK + 30 CONTINUE + ELSE + IF (POS.LE.1) GO TO 34 + DO 32 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.GE.D(QK)) GO TO 34 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 34 + 32 CONTINUE + 34 Q(POS) = I + L(I) = POS + IF (POS.NE.POS0) RETURN + DO 36 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 40 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.GT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.LE.DK) GO TO 40 + QK = Q(POSK) + Q(POS) = QK + L(QK) = POS + POS = POSK + 36 CONTINUE + ENDIF + 40 Q(POS) = I + L(I) = POS + RETURN + END SUBROUTINE CMUMPS_447 + SUBROUTINE CMUMPS_450(IP,LENL,LENH,W,WLEN,A,NVAL,VAL) + IMPLICIT NONE + INTEGER WLEN,NVAL + INTEGER IP(*),LENL(*),LENH(*),W(*) + REAL A(*),VAL + INTEGER XX,J,K,II,S,POS + PARAMETER (XX=10) + REAL SPLIT(XX),HA + NVAL = 0 + DO 10 K = 1,WLEN + J = W(K) + DO 15 II = IP(J)+LENL(J),IP(J)+LENH(J)-1 + HA = A(II) + IF (NVAL.EQ.0) THEN + SPLIT(1) = HA + NVAL = 1 + ELSE + DO 20 S = NVAL,1,-1 + IF (SPLIT(S).EQ.HA) GO TO 15 + IF (SPLIT(S).GT.HA) THEN + POS = S + 1 + GO TO 21 + ENDIF + 20 CONTINUE + POS = 1 + 21 DO 22 S = NVAL,POS,-1 + SPLIT(S+1) = SPLIT(S) + 22 CONTINUE + SPLIT(POS) = HA + NVAL = NVAL + 1 + ENDIF + IF (NVAL.EQ.XX) GO TO 11 + 15 CONTINUE + 10 CONTINUE + 11 IF (NVAL.GT.0) VAL = SPLIT((NVAL+1)/2) + RETURN + END SUBROUTINE CMUMPS_450 + SUBROUTINE CMUMPS_451(N,NE,IP,IRN,A) + IMPLICIT NONE + INTEGER N,NE + INTEGER IP(N+1),IRN(NE) + REAL A(NE) + INTEGER THRESH,TDLEN + PARAMETER (THRESH=15,TDLEN=50) + INTEGER J,IPJ,K,LEN,R,S,HI,FIRST,MID,LAST,TD + REAL HA,KEY + INTEGER TODO(TDLEN) + DO 100 J = 1,N + LEN = IP(J+1) - IP(J) + IF (LEN.LE.1) GO TO 100 + IPJ = IP(J) + IF (LEN.LT.THRESH) GO TO 400 + TODO(1) = IPJ + TODO(2) = IPJ + LEN + TD = 2 + 500 CONTINUE + FIRST = TODO(TD-1) + LAST = TODO(TD) + KEY = A((FIRST+LAST)/2) + DO 475 K = FIRST,LAST-1 + HA = A(K) + IF (HA.EQ.KEY) GO TO 475 + IF (HA.GT.KEY) GO TO 470 + KEY = HA + GO TO 470 + 475 CONTINUE + TD = TD - 2 + GO TO 425 + 470 MID = FIRST + DO 450 K = FIRST,LAST-1 + IF (A(K).LE.KEY) GO TO 450 + HA = A(MID) + A(MID) = A(K) + A(K) = HA + HI = IRN(MID) + IRN(MID) = IRN(K) + IRN(K) = HI + MID = MID + 1 + 450 CONTINUE + IF (MID-FIRST.GE.LAST-MID) THEN + TODO(TD+2) = LAST + TODO(TD+1) = MID + TODO(TD) = MID + ELSE + TODO(TD+2) = MID + TODO(TD+1) = FIRST + TODO(TD) = LAST + TODO(TD-1) = MID + ENDIF + TD = TD + 2 + 425 CONTINUE + IF (TD.EQ.0) GO TO 400 + IF (TODO(TD)-TODO(TD-1).GE.THRESH) GO TO 500 + TD = TD - 2 + GO TO 425 + 400 DO 200 R = IPJ+1,IPJ+LEN-1 + IF (A(R-1) .LT. A(R)) THEN + HA = A(R) + HI = IRN(R) + A(R) = A(R-1) + IRN(R) = IRN(R-1) + DO 300 S = R-1,IPJ+1,-1 + IF (A(S-1) .LT. HA) THEN + A(S) = A(S-1) + IRN(S) = IRN(S-1) + ELSE + A(S) = HA + IRN(S) = HI + GO TO 200 + END IF + 300 CONTINUE + A(IPJ) = HA + IRN(IPJ) = HI + END IF + 200 CONTINUE + 100 CONTINUE + RETURN + END SUBROUTINE CMUMPS_451 + SUBROUTINE CMUMPS_452(M,N,NE,IP,IRN,A,IPERM,NUMX, + & W,LEN,LENL,LENH,FC,IW,IW4,RLX,RINF) + IMPLICIT NONE + INTEGER M,N,NE,NUMX + INTEGER IP(N+1),IRN(NE),IPERM(N), + & W(N),LEN(N),LENL(N),LENH(N),FC(N),IW(M),IW4(3*N+M) + REAL A(NE),RLX,RINF + INTEGER NUM,NVAL,WLEN,II,I,J,K,L,CNT,MOD,IDUM1,IDUM2,IDUM3 + REAL BVAL,BMIN,BMAX + EXTERNAL CMUMPS_450,CMUMPS_453,CMUMPS_455 + DO 20 J = 1,N + FC(J) = J + LEN(J) = IP(J+1) - IP(J) + 20 CONTINUE + DO 21 I = 1,M + IW(I) = 0 + 21 CONTINUE + CNT = 1 + MOD = 1 + NUMX = 0 + CALL CMUMPS_453(CNT,MOD,M,N,IRN,NE,IP,LEN,FC,IW,NUMX,N, + & IW4(1),IW4(N+1),IW4(2*N+1),IW4(2*N+M+1)) + NUM = NUMX + IF (NUM.NE.N) THEN + BMAX = RINF + ELSE + BMAX = RINF + DO 30 J = 1,N + BVAL = 0.0E0 + DO 25 K = IP(J),IP(J+1)-1 + IF (A(K).GT.BVAL) BVAL = A(K) + 25 CONTINUE + IF (BVAL.LT.BMAX) BMAX = BVAL + 30 CONTINUE + BMAX = 1.001E0 * BMAX + ENDIF + BVAL = 0.0E0 + BMIN = 0.0E0 + WLEN = 0 + DO 48 J = 1,N + L = IP(J+1) - IP(J) + LENH(J) = L + LEN(J) = L + DO 45 K = IP(J),IP(J+1)-1 + IF (A(K).LT.BMAX) GO TO 46 + 45 CONTINUE + K = IP(J+1) + 46 LENL(J) = K - IP(J) + IF (LENL(J).EQ.L) GO TO 48 + WLEN = WLEN + 1 + W(WLEN) = J + 48 CONTINUE + DO 90 IDUM1 = 1,NE + IF (NUM.EQ.NUMX) THEN + DO 50 I = 1,M + IPERM(I) = IW(I) + 50 CONTINUE + DO 80 IDUM2 = 1,NE + BMIN = BVAL + IF (BMAX-BMIN .LE. RLX) GO TO 1000 + CALL CMUMPS_450(IP,LENL,LEN,W,WLEN,A,NVAL,BVAL) + IF (NVAL.LE.1) GO TO 1000 + K = 1 + DO 70 IDUM3 = 1,N + IF (K.GT.WLEN) GO TO 71 + J = W(K) + DO 55 II = IP(J)+LEN(J)-1,IP(J)+LENL(J),-1 + IF (A(II).GE.BVAL) GO TO 60 + I = IRN(II) + IF (IW(I).NE.J) GO TO 55 + IW(I) = 0 + NUM = NUM - 1 + FC(N-NUM) = J + 55 CONTINUE + 60 LENH(J) = LEN(J) + LEN(J) = II - IP(J) + 1 + IF (LENL(J).EQ.LENH(J)) THEN + W(K) = W(WLEN) + WLEN = WLEN - 1 + ELSE + K = K + 1 + ENDIF + 70 CONTINUE + 71 IF (NUM.LT.NUMX) GO TO 81 + 80 CONTINUE + 81 MOD = 1 + ELSE + BMAX = BVAL + IF (BMAX-BMIN .LE. RLX) GO TO 1000 + CALL CMUMPS_450(IP,LEN,LENH,W,WLEN,A,NVAL,BVAL) + IF (NVAL.EQ.0. OR. BVAL.EQ.BMIN) GO TO 1000 + K = 1 + DO 87 IDUM3 = 1,N + IF (K.GT.WLEN) GO TO 88 + J = W(K) + DO 85 II = IP(J)+LEN(J),IP(J)+LENH(J)-1 + IF (A(II).LT.BVAL) GO TO 86 + 85 CONTINUE + 86 LENL(J) = LEN(J) + LEN(J) = II - IP(J) + IF (LENL(J).EQ.LENH(J)) THEN + W(K) = W(WLEN) + WLEN = WLEN - 1 + ELSE + K = K + 1 + ENDIF + 87 CONTINUE + 88 MOD = 0 + ENDIF + CNT = CNT + 1 + CALL CMUMPS_453(CNT,MOD,M,N,IRN,NE,IP,LEN,FC,IW,NUM,NUMX, + & IW4(1),IW4(N+1),IW4(2*N+1),IW4(2*N+M+1)) + 90 CONTINUE + 1000 IF (M.EQ.N .and. NUMX.EQ.N) GO TO 2000 + CALL CMUMPS_455(M,N,IPERM,IW,W) + 2000 RETURN + END SUBROUTINE CMUMPS_452 + SUBROUTINE CMUMPS_453 + & (ID,MOD,M,N,IRN,LIRN,IP,LENC,FC,IPERM,NUM,NUMX, + & PR,ARP,CV,OUT) + IMPLICIT NONE + INTEGER ID,MOD,M,N,LIRN,NUM,NUMX + INTEGER ARP(N),CV(M),IRN(LIRN),IP(N), + & FC(N),IPERM(M),LENC(N),OUT(N),PR(N) + INTEGER I,II,IN1,IN2,J,J1,JORD,K,KK,LAST,NFC, + & NUM0,NUM1,NUM2,ID0,ID1 + IF (ID.EQ.1) THEN + DO 5 I = 1,M + CV(I) = 0 + 5 CONTINUE + DO 6 J = 1,N + ARP(J) = 0 + 6 CONTINUE + NUM1 = N + NUM2 = N + ELSE + IF (MOD.EQ.1) THEN + DO 8 J = 1,N + ARP(J) = 0 + 8 CONTINUE + ENDIF + NUM1 = NUMX + NUM2 = N - NUMX + ENDIF + NUM0 = NUM + NFC = 0 + ID0 = (ID-1)*N + DO 100 JORD = NUM0+1,N + ID1 = ID0 + JORD + J = FC(JORD-NUM0) + PR(J) = -1 + DO 70 K = 1,JORD + IF (ARP(J).GE.LENC(J)) GO TO 30 + IN1 = IP(J) + ARP(J) + IN2 = IP(J) + LENC(J) - 1 + DO 20 II = IN1,IN2 + I = IRN(II) + IF (IPERM(I).EQ.0) GO TO 80 + 20 CONTINUE + ARP(J) = LENC(J) + 30 OUT(J) = LENC(J) - 1 + DO 60 KK = 1,JORD + IN1 = OUT(J) + IF (IN1.LT.0) GO TO 50 + IN2 = IP(J) + LENC(J) - 1 + IN1 = IN2 - IN1 + DO 40 II = IN1,IN2 + I = IRN(II) + IF (CV(I).EQ.ID1) GO TO 40 + J1 = J + J = IPERM(I) + CV(I) = ID1 + PR(J) = J1 + OUT(J1) = IN2 - II - 1 + GO TO 70 + 40 CONTINUE + 50 J1 = PR(J) + IF (J1.EQ.-1) THEN + NFC = NFC + 1 + FC(NFC) = J + IF (NFC.GT.NUM2) THEN + LAST = JORD + GO TO 101 + ENDIF + GO TO 100 + ENDIF + J = J1 + 60 CONTINUE + 70 CONTINUE + 80 IPERM(I) = J + ARP(J) = II - IP(J) + 1 + NUM = NUM + 1 + DO 90 K = 1,JORD + J = PR(J) + IF (J.EQ.-1) GO TO 95 + II = IP(J) + LENC(J) - OUT(J) - 2 + I = IRN(II) + IPERM(I) = J + 90 CONTINUE + 95 IF (NUM.EQ.NUM1) THEN + LAST = JORD + GO TO 101 + ENDIF + 100 CONTINUE + LAST = N + 101 DO 110 JORD = LAST+1,N + NFC = NFC + 1 + FC(NFC) = FC(JORD-NUM0) + 110 CONTINUE + RETURN + END SUBROUTINE CMUMPS_453 + SUBROUTINE CMUMPS_454(M,N,NE,IP,IRN,A,IPERM,NUM, + & JPERM,OUT,PR,Q,L,U,D,RINF) + IMPLICIT NONE + INTEGER M,N,NE,NUM + INTEGER IP(N+1),IRN(NE),IPERM(M),JPERM(N),OUT(N),PR(N),Q(M),L(M) + REAL A(NE),U(M),D(M),RINF,RINF3 + INTEGER I,I0,II,J,JJ,JORD,Q0,QLEN,JDUM,ISP,JSP, + & K,K0,K1,K2,KK,KK1,KK2,UP,LOW + REAL CSP,DI,DMIN,DNEW,DQ0,VJ,RLX + LOGICAL LORD + REAL ZERO, ONE + PARAMETER (ZERO=0.0E0,ONE=1.0E0) + EXTERNAL CMUMPS_445, CMUMPS_446, CMUMPS_447, CMUMPS_455 + RLX = U(1) + RINF3 = U(2) + LORD = (JPERM(1).EQ.6) + NUM = 0 + DO 10 K = 1,N + JPERM(K) = 0 + PR(K) = IP(K) + D(K) = RINF + 10 CONTINUE + DO 15 K = 1,M + U(K) = RINF3 + IPERM(K) = 0 + L(K) = 0 + 15 CONTINUE + DO 30 J = 1,N + IF (IP(J+1)-IP(J) .GT. N/10 .AND. N.GT.50) GO TO 30 + DO 20 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (A(K).GT.U(I)) GO TO 20 + U(I) = A(K) + IPERM(I) = J + L(I) = K + 20 CONTINUE + 30 CONTINUE + DO 40 I = 1,M + J = IPERM(I) + IF (J.EQ.0) GO TO 40 + IF (JPERM(J).EQ.0) THEN + JPERM(J) = L(I) + D(J) = U(I) + NUM = NUM + 1 + ELSEIF (D(J).GT.U(I)) THEN + K = JPERM(J) + II = IRN(K) + IPERM(II) = 0 + JPERM(J) = L(I) + D(J) = U(I) + ELSE + IPERM(I) = 0 + ENDIF + 40 CONTINUE + IF (NUM.EQ.N) GO TO 1000 + DO 45 K = 1,M + D(K) = ZERO + 45 CONTINUE + DO 95 J = 1,N + IF (JPERM(J).NE.0) GO TO 95 + K1 = IP(J) + K2 = IP(J+1) - 1 + IF (K1.GT.K2) GO TO 95 + VJ = RINF + DO 50 K = K1,K2 + I = IRN(K) + DI = A(K) - U(I) + IF (DI.GT.VJ) GO TO 50 + IF (DI.LT.VJ .OR. DI.EQ.RINF) GO TO 55 + IF (IPERM(I).NE.0 .OR. IPERM(I0).EQ.0) GO TO 50 + 55 VJ = DI + I0 = I + K0 = K + 50 CONTINUE + D(J) = VJ + K = K0 + I = I0 + IF (IPERM(I).EQ.0) GO TO 90 + DO 60 K = K0,K2 + I = IRN(K) + IF (A(K)-U(I).GT.VJ) GO TO 60 + JJ = IPERM(I) + KK1 = PR(JJ) + KK2 = IP(JJ+1) - 1 + IF (KK1.GT.KK2) GO TO 60 + DO 70 KK = KK1,KK2 + II = IRN(KK) + IF (IPERM(II).GT.0) GO TO 70 + IF (A(KK)-U(II).LE.D(JJ)) GO TO 80 + 70 CONTINUE + PR(JJ) = KK2 + 1 + 60 CONTINUE + GO TO 95 + 80 JPERM(JJ) = KK + IPERM(II) = JJ + PR(JJ) = KK + 1 + 90 NUM = NUM + 1 + JPERM(J) = K + IPERM(I) = J + PR(J) = K + 1 + 95 CONTINUE + IF (NUM.EQ.N) GO TO 1000 + DO 99 I = 1,M + D(I) = RINF + L(I) = 0 + 99 CONTINUE + DO 100 JORD = 1,N + IF (JPERM(JORD).NE.0) GO TO 100 + DMIN = RINF + QLEN = 0 + LOW = M + 1 + UP = M + 1 + CSP = RINF + J = JORD + PR(J) = -1 + DO 115 K = IP(J),IP(J+1)-1 + I = IRN(K) + DNEW = A(K) - U(I) + IF (DNEW.GE.CSP) GO TO 115 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = K + JSP = J + ELSE + IF (DNEW.LT.DMIN) DMIN = DNEW + D(I) = DNEW + QLEN = QLEN + 1 + Q(QLEN) = K + ENDIF + 115 CONTINUE + Q0 = QLEN + QLEN = 0 + DO 120 KK = 1,Q0 + K = Q(KK) + I = IRN(K) + IF (CSP.LE.D(I)) THEN + D(I) = RINF + GO TO 120 + ENDIF + IF (D(I).LE.DMIN) THEN + LOW = LOW - 1 + Q(LOW) = I + L(I) = LOW + ELSE + QLEN = QLEN + 1 + L(I) = QLEN + CALL CMUMPS_445(I,M,Q,D,L,2) + ENDIF + JJ = IPERM(I) + OUT(JJ) = K + PR(JJ) = J + 120 CONTINUE + DO 150 JDUM = 1,NUM + IF (LOW.EQ.UP) THEN + IF (QLEN.EQ.0) GO TO 160 + I = Q(1) + IF (D(I).LT.RINF) DMIN = D(I)*(ONE+RLX) + IF (DMIN.GE.CSP) GO TO 160 + 152 CALL CMUMPS_446(QLEN,M,Q,D,L,2) + LOW = LOW - 1 + Q(LOW) = I + L(I) = LOW + IF (QLEN.EQ.0) GO TO 153 + I = Q(1) + IF (D(I).GT.DMIN) GO TO 153 + GO TO 152 + ENDIF + 153 Q0 = Q(UP-1) + DQ0 = D(Q0) + IF (DQ0.GE.CSP) GO TO 160 + IF (DMIN.GE.CSP) GO TO 160 + UP = UP - 1 + J = IPERM(Q0) + VJ = DQ0 - A(JPERM(J)) + U(Q0) + K1 = IP(J+1)-1 + IF (LORD) THEN + IF (CSP.NE.RINF) THEN + DI = CSP - VJ + IF (A(K1).GE.DI) THEN + K0 = JPERM(J) + IF (K0.GE.K1-6) GO TO 178 + 177 CONTINUE + K = (K0+K1)/2 + IF (A(K).GE.DI) THEN + K1 = K + ELSE + K0 = K + ENDIF + IF (K0.GE.K1-6) GO TO 178 + GO TO 177 + 178 DO 179 K = K0+1,K1 + IF (A(K).LT.DI) GO TO 179 + K1 = K - 1 + GO TO 181 + 179 CONTINUE + ENDIF + ENDIF + 181 IF (K1.EQ.JPERM(J)) K1 = K1 - 1 + ENDIF + K0 = IP(J) + DI = CSP - VJ + DO 155 K = K0,K1 + I = IRN(K) + IF (L(I).GE.LOW) GO TO 155 + DNEW = A(K) - U(I) + IF (DNEW.GE.DI) GO TO 155 + DNEW = DNEW + VJ + IF (DNEW.GT.D(I)) GO TO 155 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = K + JSP = J + DI = CSP - VJ + ELSE + IF (DNEW.GE.D(I)) GO TO 155 + D(I) = DNEW + IF (DNEW.LE.DMIN) THEN + IF (L(I).NE.0) THEN + CALL CMUMPS_447(L(I),QLEN,M,Q,D,L,2) + ENDIF + LOW = LOW - 1 + Q(LOW) = I + L(I) = LOW + ELSE + IF (L(I).EQ.0) THEN + QLEN = QLEN + 1 + L(I) = QLEN + ENDIF + CALL CMUMPS_445(I,M,Q,D,L,2) + ENDIF + JJ = IPERM(I) + OUT(JJ) = K + PR(JJ) = J + ENDIF + 155 CONTINUE + 150 CONTINUE + 160 IF (CSP.EQ.RINF) GO TO 190 + NUM = NUM + 1 + I = IRN(ISP) + J = JSP + IPERM(I) = J + JPERM(J) = ISP + DO 170 JDUM = 1,NUM + JJ = PR(J) + IF (JJ.EQ.-1) GO TO 180 + K = OUT(J) + I = IRN(K) + IPERM(I) = JJ + JPERM(JJ) = K + J = JJ + 170 CONTINUE + 180 DO 182 KK = UP,M + I = Q(KK) + U(I) = U(I) + D(I) - CSP + 182 CONTINUE + 190 DO 191 KK = UP,M + I = Q(KK) + D(I) = RINF + L(I) = 0 + 191 CONTINUE + DO 192 KK = LOW,UP-1 + I = Q(KK) + D(I) = RINF + L(I) = 0 + 192 CONTINUE + DO 193 KK = 1,QLEN + I = Q(KK) + D(I) = RINF + L(I) = 0 + 193 CONTINUE + 100 CONTINUE + 1000 CONTINUE + DO 1200 J = 1,N + K = JPERM(J) + IF (K.NE.0) THEN + D(J) = A(K) - U(IRN(K)) + ELSE + D(J) = ZERO + ENDIF + 1200 CONTINUE + DO 1201 I = 1,M + IF (IPERM(I).EQ.0) U(I) = ZERO + 1201 CONTINUE + IF (M.EQ.N .and. NUM.EQ.N) GO TO 2000 + CALL CMUMPS_455(M,N,IPERM,L,JPERM) + 2000 RETURN + END SUBROUTINE CMUMPS_454 + SUBROUTINE CMUMPS_457 + & (M,N,IRN,LIRN,IP,LENC,IPERM,NUM,PR,ARP,CV,OUT) + IMPLICIT NONE + INTEGER LIRN,M,N,NUM + INTEGER ARP(N),CV(M),IRN(LIRN),IP(N),IPERM(M),LENC(N),OUT(N),PR(N) + INTEGER I,II,IN1,IN2,J,J1,JORD,K,KK + EXTERNAL CMUMPS_455 + DO 10 I = 1,M + CV(I) = 0 + IPERM(I) = 0 + 10 CONTINUE + DO 12 J = 1,N + ARP(J) = LENC(J) - 1 + 12 CONTINUE + NUM = 0 + DO 1000 JORD = 1,N + J = JORD + PR(J) = -1 + DO 70 K = 1,JORD + IN1 = ARP(J) + IF (IN1.LT.0) GO TO 30 + IN2 = IP(J) + LENC(J) - 1 + IN1 = IN2 - IN1 + DO 20 II = IN1,IN2 + I = IRN(II) + IF (IPERM(I).EQ.0) GO TO 80 + 20 CONTINUE + ARP(J) = -1 + 30 CONTINUE + OUT(J) = LENC(J) - 1 + DO 60 KK = 1,JORD + IN1 = OUT(J) + IF (IN1.LT.0) GO TO 50 + IN2 = IP(J) + LENC(J) - 1 + IN1 = IN2 - IN1 + DO 40 II = IN1,IN2 + I = IRN(II) + IF (CV(I).EQ.JORD) GO TO 40 + J1 = J + J = IPERM(I) + CV(I) = JORD + PR(J) = J1 + OUT(J1) = IN2 - II - 1 + GO TO 70 + 40 CONTINUE + 50 CONTINUE + J = PR(J) + IF (J.EQ.-1) GO TO 1000 + 60 CONTINUE + 70 CONTINUE + 80 CONTINUE + IPERM(I) = J + ARP(J) = IN2 - II - 1 + NUM = NUM + 1 + DO 90 K = 1,JORD + J = PR(J) + IF (J.EQ.-1) GO TO 1000 + II = IP(J) + LENC(J) - OUT(J) - 2 + I = IRN(II) + IPERM(I) = J + 90 CONTINUE + 1000 CONTINUE + IF (M.EQ.N .and. NUM.EQ.N) GO TO 2000 + CALL CMUMPS_455(M,N,IPERM,CV,ARP) + 2000 RETURN + END SUBROUTINE CMUMPS_457 + SUBROUTINE CMUMPS_455(M,N,IPERM,RW,CW) + IMPLICIT NONE + INTEGER M,N + INTEGER RW(M),CW(N),IPERM(M) + INTEGER I,J,K + DO 10 J = 1,N + CW(J) = 0 + 10 CONTINUE + K = 0 + DO 20 I = 1,M + IF (IPERM(I).EQ.0) THEN + K = K + 1 + RW(K) = I + ELSE + J = IPERM(I) + CW(J) = I + ENDIF + 20 CONTINUE + K = 0 + DO 30 J = 1,N + IF (CW(J).NE.0) GO TO 30 + K = K + 1 + I = RW(K) + IPERM(I) = -J + 30 CONTINUE + DO 40 J = N+1,M + K = K + 1 + I = RW(K) + IPERM(I) = -J + 40 CONTINUE + RETURN + END SUBROUTINE CMUMPS_455 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part3.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part3.F new file mode 100644 index 000000000..28bd124f5 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part3.F @@ -0,0 +1,6719 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + RECURSIVE SUBROUTINE CMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & + & INODE_PERE, ISON, NSLAVES_PERE, LIST_SLAVES_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP, TROW, + & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, + & root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE CMUMPS_COMM_BUFFER + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC ) :: root + INTEGER LBUFR, LBUFR_BYTES + INTEGER ICNTL( 40 ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER SLAVEF, NBFIN + INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS, POSFAC + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), + & PIMASTER(KEEP(28)) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER COMP + INTEGER NSTK( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM, MYID + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER INODE_PERE, ISON + INTEGER NFS4FATHER + INTEGER NBROWS_ALREADY_SENT + INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE + INTEGER LIST_SLAVES_PERE( * ) + INTEGER LMAP + INTEGER TROW( LMAP ) + DOUBLE PRECISION OPASSW, OPELIW + COMPLEX DBLARR(max(1,KEEP(13))) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER NOSLA, I, ISTCHK, ISTCHK_LOC + INTEGER INDICE_PERE + INTEGER INDICE_PERE_ARRAY_ARG(1) + INTEGER PDEST, PDEST_MASTER + INTEGER NFRONT + INTEGER(8) :: SIZFR + INTEGER LDA_SON + INTEGER NSLSON, NBCOLS, NROW, NROWS_TO_SEND, IROW_SON, + & NPIV, NROWS_TO_STACK, II, COLLIST + INTEGER(8) :: POSROW, SHIFTCB_SON + INTEGER NBCOLS_EFF + INTEGER PDEST_MASTER_ISON, IPOS_IN_SLAVE + LOGICAL DESCLU, SLAVE_ISON + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER MSGSOU, MSGTAG + INTEGER LP + INTEGER ITMP + LOGICAL SAME_PROC, COMPRESSCB + LOGICAL IS_ERROR_BROADCASTED, IS_ofType5or6 + INTEGER ITYPE, TYPESPLIT + INTEGER KEEP253_LOC + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275, MUMPS_330, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, MUMPS_810 + INTEGER LMAP_LOC, allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: NBROW + INTEGER, ALLOCATABLE, DIMENSION(:) :: SLAVES_PERE + INTEGER, ALLOCATABLE, DIMENSION(:) :: MAP, PERM + IS_ERROR_BROADCASTED = .FALSE. + TYPESPLIT = MUMPS_810(PROCNODE_STEPS(STEP(INODE_PERE)), + & SLAVEF) + IS_ofType5or6 = ((TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + ALLOCATE(SLAVES_PERE(0:NSLAVES_PERE), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP > 0) write(LP,*) MYID, + & ' : PB allocation SLAVES_PERE in CMUMPS_210' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 700 + endif + IF (NSLAVES_PERE.GT.0) + &SLAVES_PERE(1:NSLAVES_PERE) = LIST_SLAVES_PERE(1:NSLAVES_PERE) + SLAVES_PERE(0) = MUMPS_275( PROCNODE_STEPS(STEP(INODE_PERE)), + & SLAVEF ) + ALLOCATE(NBROW(0:NSLAVES_PERE), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP>0) write(LP,*) MYID, + & ' : PB allocation NBROW in CMUMPS_210' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 670 + endif + LMAP_LOC = LMAP + ALLOCATE(MAP(LMAP_LOC), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP>0) THEN + write(LP,*) MYID, ' : PB allocation LMAP in CMUMPS_210' + ENDIF + IFLAG =-13 + IERROR = LMAP + GOTO 680 + endif + MAP( 1 : LMAP ) = TROW( 1 : LMAP ) + PDEST_MASTER_ISON = MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) + SLAVE_ISON = PDEST_MASTER_ISON .NE. MYID + IF (SLAVE_ISON) THEN + DO WHILE ( PTRIST(STEP( ISON )) .EQ. 0 ) + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & PDEST_MASTER_ISON, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. + & ) + IF ( IFLAG .LT. 0 ) THEN + IS_ERROR_BROADCASTED = .TRUE. + GOTO 670 + ENDIF + END DO + DO WHILE ( + & ( IW( PTRIST(STEP(ISON)) + 1 + KEEP(IXSZ) ) .NE. + & IW( PTRIST(STEP(ISON)) + 3 + KEEP(IXSZ) ) ) .OR. + & ( KEEP(50) .NE. 0 .AND. + & IW( PTRIST(STEP(ISON)) + 6 + KEEP(IXSZ) ) .NE. 0 ) ) + IF ( KEEP(50).eq.0) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO + ELSE + IF ( IW( PTRIST(STEP(ISON)) + 1 + KEEP(IXSZ) ) .NE. + & IW( PTRIST(STEP(ISON)) + 3 + KEEP(IXSZ) ) ) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO_SYM + ELSE + MSGSOU = MPI_ANY_SOURCE + MSGTAG = BLOC_FACTO_SYM_SLAVE + END IF + END IF + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MSGTAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) THEN + IS_ERROR_BROADCASTED = .TRUE. + GOTO 670 + ENDIF + END DO + ENDIF + IF ( NSLAVES_PERE .EQ. 0 ) THEN + NBROW( 0 ) = LMAP + ELSE + DO I = 0, NSLAVES_PERE + NBROW( I ) = 0 + END DO + DO I = 1, LMAP_LOC + INDICE_PERE = MAP( I ) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + NBROW( NOSLA ) = NBROW( NOSLA ) + 1 + END DO + DO I = 1, NSLAVES_PERE + NBROW(I)=NBROW(I)+NBROW(I-1) + ENDDO + ENDIF + ALLOCATE(PERM(LMAP_LOC), stat=allocok) + IF (allocok .GT. 0) THEN + IF (LP.GT.0) THEN + write(LP,*) MYID,': PB allocation PERM in CMUMPS_210' + ENDIF + IFLAG =-13 + IERROR = LMAP_LOC + GOTO 670 + ENDIF + ISTCHK = PTRIST(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + KEEP253_LOC = 0 + DO I = LMAP_LOC, 1, -1 + INDICE_PERE = MAP( I ) + IF (INDICE_PERE > NFRONT_PERE - KEEP(253)) THEN + KEEP253_LOC = KEEP253_LOC + 1 + ENDIF + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + PERM( NBROW( NOSLA ) ) = I + NBROW( NOSLA ) = NBROW( NOSLA ) - 1 + ENDDO + DO I = 0, NSLAVES_PERE + NBROW(I)=NBROW(I)+1 + END DO + PDEST_MASTER = SLAVES_PERE(0) + DO I = 0, NSLAVES_PERE + PDEST = SLAVES_PERE( I ) + IF ( PDEST .EQ. MYID ) THEN + NBPROCFILS(STEP(INODE_PERE)) = + & NBPROCFILS(STEP(INODE_PERE)) - 1 + IF ( PDEST .EQ. PDEST_MASTER ) THEN + NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - 1 + ENDIF + ISTCHK = PTRIST(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + NROW = IW(ISTCHK+2+KEEP(IXSZ)) + NPIV = IW(ISTCHK+3+KEEP(IXSZ)) + NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) + NFRONT = NPIV + NBCOLS + COMPRESSCB = (IW(ISTCHK+XXS).EQ.S_CB1COMP) + CALL MUMPS_729(SIZFR, IW(ISTCHK+XXR)) + IF (IW(ISTCHK+XXS).EQ.S_NOLCBCONTIG) THEN + LDA_SON = NBCOLS + SHIFTCB_SON = int(NPIV,8)*int(NROW,8) + ELSE IF (IW(ISTCHK+XXS).EQ.S_NOLCLEANED) THEN + LDA_SON = NBCOLS + SHIFTCB_SON = 0_8 + ELSE + LDA_SON = NFRONT + SHIFTCB_SON = int(NPIV,8) + ENDIF + IF (I == NSLAVES_PERE) THEN + NROWS_TO_STACK=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_STACK=NBROW(I+1)-NBROW(I) + ENDIF + IF (PDEST .NE. PDEST_MASTER) THEN + IF ( KEEP(55) .eq. 0 ) THEN + CALL CMUMPS_539 + & (N, INODE_PERE, IW, LIW, + & A, LA, NROWS_TO_STACK, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, MYID ) + ELSE + CALL CMUMPS_123(NELT, FRTPTR, FRTELT, + & N, INODE_PERE, IW, LIW, + & A, LA, NROWS_TO_STACK, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP, KEEP8, MYID ) + ENDIF + ENDIF + DO II = 1,NROWS_TO_STACK + IROW_SON = PERM(NBROW(I)+II-1) + INDICE_PERE=MAP(IROW_SON) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + INDICE_PERE = IPOS_IN_SLAVE + IF ( COMPRESSCB ) THEN + IF (NBCOLS - NROW .EQ. 0 ) THEN + ITMP = IROW_SON + POSROW = PTRAST(STEP(ISON))+ + & int(ITMP,8) * int(ITMP-1,8) / 2_8 + ELSE + ITMP = IROW_SON + NBCOLS - NROW + POSROW = PTRAST(STEP(ISON)) + & + int(ITMP,8) * int(ITMP-1,8) / 2_8 + & - int(NBCOLS-NROW,8) * int(NBCOLS-NROW+1,8)/2_8 + ENDIF + ELSE + POSROW = PTRAST(STEP(ISON)) + SHIFTCB_SON + & +int(IROW_SON-1,8)*int(LDA_SON,8) + ENDIF + IF (PDEST == PDEST_MASTER) THEN + IF (KEEP(50).NE.0) THEN + NBCOLS_EFF = IROW_SON + NBCOLS - NROW + ELSE + NBCOLS_EFF = NBCOLS + ENDIF + INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE + IF ((IS_ofType5or6).AND.(KEEP(50).EQ.0)) THEN + CALL CMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NROWS_TO_STACK, NBCOLS_EFF, + & INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, LDA_SON + & ) + EXIT + ELSE IF ( (KEEP(50).NE.0) .AND. + & (.NOT.COMPRESSCB).AND.(IS_ofType5or6) ) THEN + CALL CMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NROWS_TO_STACK, + & NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, LDA_SON + &) + EXIT + ELSE + CALL CMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, LDA_SON + &) + ENDIF + ELSE + ISTCHK = PTRIST(STEP(ISON)) + COLLIST = ISTCHK + 6 + KEEP(IXSZ) + & + IW( ISTCHK + 5 +KEEP(IXSZ)) + NROW + NPIV + IF (KEEP(50).NE.0) THEN + NBCOLS_EFF = IROW_SON + NBCOLS - NROW + ELSE + NBCOLS_EFF = NBCOLS + ENDIF + INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE + IF ( (IS_ofType5or6) .AND. + & ( + & ( KEEP(50).EQ.0) + & .OR. + & ( (KEEP(50).NE.0).and. (.NOT.COMPRESSCB) ) + & ) + & ) THEN + CALL CMUMPS_40(N, INODE_PERE, + & IW, LIW, + & A, LA, NROWS_TO_STACK, NBCOLS, + & INDICE_PERE_ARRAY_ARG, + & IW( COLLIST ), A(POSROW), + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, ICNTL, KEEP,KEEP8, + & MYID, IS_ofType5or6, LDA_SON) + EXIT + ELSE + CALL CMUMPS_40(N, INODE_PERE, + & IW, LIW, + & A, LA, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & IW( COLLIST ), A(POSROW), + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, ICNTL, KEEP,KEEP8, + & MYID, IS_ofType5or6, LDA_SON) + ENDIF + ENDIF + ENDDO + IF (PDEST.EQ.PDEST_MASTER) THEN + IF (KEEP(219).NE.0) THEN + IF(NSLAVES_PERE.GT.0 .AND. KEEP(50).EQ.2) THEN + IF (COMPRESSCB) THEN + WRITE(*,*) "Error 1 in PARPIV/CMUMPS_210" + CALL MUMPS_ABORT() + ELSE + POSROW = PTRAST(STEP(ISON))+SHIFTCB_SON+ + & int(NBROW(1)-1,8)*int(LDA_SON,8) + ENDIF + CALL CMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE.0) THEN + IF (LP .GT. 0) THEN + WRITE(LP, *) "MAX_ARRAY allocation failed" + ENDIF + IFLAG=-13 + IERROR=NFS4FATHER + GOTO 600 + ENDIF + ITMP=-9999 + IF ( LMAP_LOC-NBROW(1)+1-KEEP253_LOC .NE. 0 ) THEN + CALL CMUMPS_618( + & A(POSROW), + & SIZFR-SHIFTCB_SON-int(NBROW(1)-1,8)*int(LDA_SON,8), + & LDA_SON, LMAP_LOC-NBROW(1)+1-KEEP253_LOC, + & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB,ITMP) + ELSE + CALL CMUMPS_757( + & BUF_MAX_ARRAY, NFS4FATHER) + ENDIF + CALL CMUMPS_619(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NFS4FATHER, + & BUF_MAX_ARRAY, PTLUST_S, PTRAST, + & STEP, PIMASTER, + & OPASSW,IWPOSCB,MYID, KEEP,KEEP8) + ENDIF + ENDIF + IF ( NBPROCFILS(STEP(ISON)) .EQ. 0) THEN + ISTCHK_LOC = PIMASTER(STEP(ISON)) + SAME_PROC= ISTCHK_LOC .LT. IWPOSCB + IF (SAME_PROC) THEN + CALL CMUMPS_530(N, ISON, INODE_PERE, + & IWPOSCB, PIMASTER, PTLUST_S, IW, LIW, STEP, + & KEEP,KEEP8) + ENDIF + IF (SAME_PROC) THEN + ISTCHK_LOC = PTRIST(STEP(ISON)) + PTRIST(STEP( ISON) ) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL CMUMPS_152(.FALSE., MYID, N, + & ISTCHK_LOC, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, IWPOSCB, + & LA, KEEP,KEEP8, .FALSE. + & ) + ENDIF + IF ( NBPROCFILS(STEP(INODE_PERE)) .EQ. 0 ) THEN + CALL CMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), + & KEEP(47), STEP, INODE_PERE+N ) + IF (KEEP(47) .GE. 3) THEN + CALL CMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + ELSE + CALL CMUMPS_531 + & (N, INODE_PERE, IW, LIW, + & NBROW(I), STEP, PTRIST, ITLOC, RHS_MUMPS, + & KEEP,KEEP8) + END IF + END IF + END DO + DO I = NSLAVES_PERE, 0, -1 + PDEST = SLAVES_PERE( I ) + IF ( PDEST .NE. MYID ) THEN + DESCLU = .FALSE. + NBROWS_ALREADY_SENT = 0 + IF (I == NSLAVES_PERE) THEN + NROWS_TO_SEND=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_SEND=NBROW(I+1)-NBROW(I) + ENDIF + COMPRESSCB=(IW(PTRIST(STEP(ISON))+XXS).EQ.S_CB1COMP) + 95 CONTINUE + IF ( PTRIST(STEP(ISON)) .lt.0 .or. + & IW ( PTRIST(STEP(ISON) )+KEEP(IXSZ) ) .GT. N ) THEN + WRITE(*,*) MYID,': Internal error in Maplig' + WRITE(*,*) MYID,': PTRIST(STEP(ISON))/N=', + & PTRIST(STEP(ISON)), N + WRITE(*,*) MYID,': I, NBROW(I)=',I, NBROW(I) + WRITE(*,*) MYID,': NSLAVES_PERE=',NSLAVES_PERE + WRITE(*,*) MYID,': ISON, INODE_PERE=',ISON,INODE_PERE + WRITE(*,*) MYID,': Son header=', + & IW(PTRIST(STEP(ISON)): PTRIST(STEP(ISON))+5+KEEP(IXSZ)) + CALL MUMPS_ABORT() + END IF + CALL CMUMPS_67( NBROWS_ALREADY_SENT, + & DESCLU, INODE_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER, + & NSLAVES_PERE, ISON, + & NROWS_TO_SEND, LMAP_LOC, MAP, + & PERM(min(LMAP_LOC,NBROW(I))), + & IW( PTRIST(STEP(ISON))), + & A(PTRAST(STEP(ISON))), I, PDEST, PDEST_MASTER, + & COMM, IERR, + & + & KEEP,KEEP8, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, COMPRESSCB, + & KEEP253_LOC ) + IF ( IERR .EQ. -2 ) THEN + IFLAG = -17 + IF (LP .GT. 0) THEN + WRITE(LP,*) + & "FAILURE: SEND BUFFER TOO SMALL IN CMUMPS_210" + ENDIF + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * IW(PTRIST(STEP(ISON))+KEEP(IXSZ)) + & * KEEP( 35 ) + GO TO 600 + END IF + IF ( IERR .EQ. -3 ) THEN + IF (LP .GT. 0) THEN + WRITE(LP,*) + & "FAILURE: RECV BUFFER TOO SMALL IN CMUMPS_210" + ENDIF + IFLAG = -20 + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * IW(PTRIST(STEP(ISON))+KEEP(IXSZ)) + & * KEEP( 35 ) + GOTO 600 + ENDIF + IF (KEEP(219).NE.0) THEN + IF ( IERR .EQ. -4 ) THEN + IFLAG = -13 + IERROR = NFS4FATHER + IF (LP .GT. 0) THEN + WRITE(LP, *) + & "FAILURE: MAX_ARRAY allocation failed IN CMUMPS_210" + ENDIF + GO TO 600 + END IF + END IF + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) THEN + IS_ERROR_BROADCASTED=.TRUE. + GOTO 600 + ENDIF + GO TO 95 + END IF + END IF + END DO + ITYPE = MUMPS_330(PROCNODE_STEPS(STEP(ISON)), SLAVEF) + IF (KEEP(214) .EQ. 2) THEN + CALL CMUMPS_314( N, ISON, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE + & ) + IF (IFLAG .LT. 0) THEN + IS_ERROR_BROADCASTED = .TRUE. + GOTO 600 + ENDIF + ENDIF + CALL CMUMPS_626( N, ISON, PTRIST, PTRAST, IW, LIW, + & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, + & STEP, MYID, KEEP + &) + 600 CONTINUE + DEALLOCATE(PERM) + 670 CONTINUE + DEALLOCATE(MAP) + 680 CONTINUE + DEALLOCATE(NBROW) + DEALLOCATE(SLAVES_PERE) + 700 CONTINUE + IF (IFLAG .LT. 0 .AND. .NOT. IS_ERROR_BROADCASTED) THEN + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + ENDIF + RETURN + END SUBROUTINE CMUMPS_210 + SUBROUTINE CMUMPS_211( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & + & INODE_PERE, ISON, NSLAVES_PERE, LIST_SLAVES_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER, LMAP, TROW, + & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE CMUMPS_COMM_BUFFER + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER ICNTL( 40 ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER SLAVEF, NBFIN + INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS, POSFAC + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + COMPLEX A( LA ) + INTEGER COMP + INTEGER IFLAG, IERROR, COMM, MYID + INTEGER LPOOL, LEAF + INTEGER INODE_PERE, ISON + INTEGER NFS4FATHER + INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE + INTEGER LIST_SLAVES_PERE(NSLAVES_PERE) + INTEGER NELIM, LMAP, TROW( LMAP ) + DOUBLE PRECISION OPASSW, OPELIW + COMPLEX DBLARR(max(1,KEEP(13))) + INTEGER LPTRAR, NELT + INTEGER IW( LIW ) + INTEGER BUFR( LBUFR ) + INTEGER IPOOL( LPOOL ) + INTEGER NSTK( KEEP(28) ), ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER LP + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER NOSLA, I, ISTCHK, ISTCHK_LOC + INTEGER NBROWS_ALREADY_SENT + INTEGER INDICE_PERE + INTEGER INDICE_PERE_ARRAY_ARG(1) + INTEGER PDEST, PDEST_MASTER, NFRONT + LOGICAL SAME_PROC, DESCLU + INTEGER(8) :: APOS, POSROW, ASIZE + INTEGER NSLSON, NBCOLS, NROW, NROWS_TO_SEND, + & NPIV, NROWS_TO_STACK, II, IROW_SON, + & IPOS_IN_SLAVE + INTEGER NBCOLS_EFF + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + LOGICAL COMPRESSCB + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER LMAP_LOC, allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: NBROW + INTEGER, ALLOCATABLE, DIMENSION(:) :: SLAVES_PERE + INTEGER, ALLOCATABLE, DIMENSION(:) :: MAP, PERM + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + if (NSLAVES_PERE.le.0) then + write(6,*) ' error 2 in maplig_fils_niv1 ', NSLAVES_PERE + CALL MUMPS_ABORT() + endif + ALLOCATE(NBROW(0:NSLAVES_PERE), stat=allocok) + IF (allocok .GT. 0) THEN + IF (LP > 0) + & write(LP,*) MYID, + & ' : PB allocation NBROW in CMUMPS_211' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 700 + ENDIF + ALLOCATE(SLAVES_PERE(0:NSLAVES_PERE), stat =allocok) + IF ( allocok .GT. 0 ) THEN + IF (LP > 0) write(LP,*) MYID, + & ' : PB allocation SLAVES_PERE in CMUMPS_211' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 700 + ENDIF + SLAVES_PERE(1:NSLAVES_PERE) = LIST_SLAVES_PERE(1:NSLAVES_PERE) + SLAVES_PERE(0) = MUMPS_275( + & PROCNODE_STEPS(STEP(INODE_PERE)), + & SLAVEF ) + LMAP_LOC = LMAP + ALLOCATE(MAP(LMAP_LOC), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP > 0) write(LP,*) MYID, + & ' : PB allocation LMAP in CMUMPS_211' + IFLAG =-13 + IERROR = LMAP_LOC + GOTO 700 + endif + MAP( 1 : LMAP_LOC ) = TROW( 1 : LMAP_LOC ) + DO I = 0, NSLAVES_PERE + NBROW( I ) = 0 + END DO + IF (NSLAVES_PERE == 0) THEN + NBROW(0) = LMAP_LOC + ELSE + DO I = 1, LMAP_LOC + INDICE_PERE = MAP( I ) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + NBROW( NOSLA ) = NBROW( NOSLA ) + 1 + END DO + DO I = 1, NSLAVES_PERE + NBROW(I)=NBROW(I)+NBROW(I-1) + ENDDO + ENDIF + ALLOCATE(PERM(LMAP_LOC), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP > 0) write(LP,*) MYID, + & ': PB allocation PERM in CMUMPS_211' + IFLAG =-13 + IERROR = LMAP_LOC + GOTO 700 + endif + ISTCHK = PIMASTER(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + DO I = LMAP_LOC, 1, -1 + INDICE_PERE = MAP( I ) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + PERM( NBROW( NOSLA ) ) = I + NBROW( NOSLA ) = NBROW( NOSLA ) - 1 + ENDDO + DO I = 0, NSLAVES_PERE + NBROW(I)=NBROW(I)+1 + END DO + PDEST_MASTER = MYID + IF ( SLAVES_PERE(0) .NE. MYID ) THEN + WRITE(*,*) 'Error 1 in MAPLIG_FILS_NIV1:',MYID, SLAVES_PERE + CALL MUMPS_ABORT() + END IF + PDEST = PDEST_MASTER + I = 0 + NBPROCFILS(STEP(INODE_PERE))=NBPROCFILS(STEP(INODE_PERE))-1 + NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - 1 + ISTCHK = PIMASTER(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + NELIM = IW(ISTCHK+1+KEEP(IXSZ)) + NROW = IW(ISTCHK+2+KEEP(IXSZ)) + NPIV = IW(ISTCHK+3+KEEP(IXSZ)) + IF (NPIV.LT.0) THEN + write(6,*) ' Error 2 in CMUMPS_211 ', NPIV + CALL MUMPS_ABORT() + ENDIF + NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) + NFRONT = NPIV + NBCOLS + COMPRESSCB=(IW(PTRIST(STEP(ISON))+XXS) .eq. S_CB1COMP) + IF (I == NSLAVES_PERE) THEN + NROWS_TO_STACK=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_STACK=NBROW(I+1)-NBROW(I) + ENDIF + DO II = 1,NROWS_TO_STACK + IROW_SON=PERM(NBROW(I)+II-1) + INDICE_PERE = MAP(IROW_SON) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + INDICE_PERE = IPOS_IN_SLAVE + IF (COMPRESSCB) THEN + IF (NELIM.EQ.0) THEN + POSROW = PAMASTER(STEP(ISON)) + + & int(IROW_SON,8)*int(IROW_SON-1,8)/2_8 + ELSE + POSROW = PAMASTER(STEP(ISON)) + + & int(NELIM+IROW_SON,8)*int(NELIM+IROW_SON-1,8)/2_8 + ENDIF + ELSE + POSROW = PAMASTER(STEP(ISON)) + + & int(NELIM+IROW_SON-1,8)*int(NBCOLS,8) + ENDIF + IF (KEEP(50).NE.0) THEN + NBCOLS_EFF = NELIM + IROW_SON + ELSE + NBCOLS_EFF = NBCOLS + ENDIF + INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE + CALL CMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, IWPOSCB, + & MYID, KEEP,KEEP8,.FALSE.,NBCOLS_EFF) + ENDDO + IF (KEEP(219).NE.0) THEN + IF(NSLAVES_PERE.GT.0 .AND. KEEP(50).EQ.2) THEN + IF (COMPRESSCB) THEN + POSROW = PAMASTER(STEP(ISON)) + & + int(NELIM+NBROW(1),8)*int(NELIM+NBROW(1)-1,8)/2_8 + ASIZE = int(LMAP_LOC+NELIM,8)*int(NELIM+LMAP_LOC+1,8)/2_8 + & - int(NELIM+NBROW(1),8)*int(NELIM+NBROW(1)-1,8)/2_8 + ELSE + POSROW = PAMASTER(STEP(ISON)) + + & int(NELIM+NBROW(1)-1,8)*int(NBCOLS,8) + ASIZE = int(LMAP_LOC-NBROW(1)+1,8) * int(NBCOLS,8) + ENDIF + CALL CMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE.0) THEN + IF (LP > 0) WRITE(LP,*) MYID, + & ": PB allocation MAX_ARRAY during CMUMPS_211" + IFLAG=-13 + IERROR=NFS4FATHER + GOTO 700 + ENDIF + IF ( LMAP_LOC-NBROW(1)+1-KEEP(253).GT. 0 ) THEN + CALL CMUMPS_618( + & A(POSROW),ASIZE,NBCOLS, + & LMAP_LOC-NBROW(1)+1-KEEP(253), + & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB, + & NELIM+NBROW(1)) + ELSE + CALL CMUMPS_757(BUF_MAX_ARRAY, + & NFS4FATHER) + ENDIF + CALL CMUMPS_619(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NFS4FATHER, + & BUF_MAX_ARRAY, PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB,MYID, KEEP,KEEP8) + ENDIF + ENDIF + IF ( NBPROCFILS(STEP(ISON)) .EQ. 0) THEN + ISTCHK_LOC = PIMASTER(STEP(ISON)) + SAME_PROC= ISTCHK_LOC .LT. IWPOSCB + IF (SAME_PROC) THEN + CALL CMUMPS_530(N, ISON, INODE_PERE, + & IWPOSCB, PIMASTER, PTLUST_S, IW, LIW, STEP, + & KEEP,KEEP8) + ENDIF + ENDIF + IF ( NBPROCFILS(STEP(INODE_PERE)) .EQ. 0 ) THEN + CALL CMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), + & KEEP(47), STEP, INODE_PERE+N ) + IF (KEEP(47) .GE. 3) THEN + CALL CMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + DO I = 0, NSLAVES_PERE + PDEST = SLAVES_PERE( I ) + IF ( PDEST .NE. MYID ) THEN + NBROWS_ALREADY_SENT = 0 + 95 CONTINUE + NFRONT = IW(PIMASTER(STEP(ISON))+KEEP(IXSZ)) + NELIM = IW(PIMASTER(STEP(ISON))+1+KEEP(IXSZ)) + APOS = PAMASTER(STEP(ISON)) + DESCLU = .TRUE. + IF (I == NSLAVES_PERE) THEN + NROWS_TO_SEND=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_SEND=NBROW(I+1)-NBROW(I) + ENDIF + CALL CMUMPS_67(NBROWS_ALREADY_SENT, + & DESCLU, INODE_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER, + & NSLAVES_PERE, + & ISON, NROWS_TO_SEND, LMAP_LOC, + & MAP, PERM(min(LMAP_LOC,NBROW(I))), + & IW(PIMASTER(STEP(ISON))), + & A(APOS), I, PDEST, PDEST_MASTER, COMM, IERR, + & + & KEEP,KEEP8, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & COMPRESSCB, KEEP(253)) + IF ( IERR .EQ. -2 ) THEN + IF (LP > 0) WRITE(LP,*) MYID, + &": FAILURE, SEND BUFFER TOO SMALL DURING CMUMPS_211" + IFLAG = -17 + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * KEEP( 35 ) + GO TO 700 + END IF + IF ( IERR .EQ. -3 ) THEN + IF (LP > 0) WRITE(LP,*) MYID, + &": FAILURE, RECV BUFFER TOO SMALL DURING CMUMPS_211" + IFLAG = -20 + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * KEEP( 35 ) + GO TO 700 + ENDIF + IF (KEEP(219).NE.0) THEN + IF ( IERR .EQ. -4 ) THEN + IFLAG = -13 + IERROR = BUF_LMAX_ARRAY + IF (LP > 0) WRITE(LP,*) MYID, + &": FAILURE, MAX_ARRAY ALLOC FAILED DURING CMUMPS_211" + GO TO 700 + ENDIF + ENDIF + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + GO TO 95 + END IF + END IF + END DO + ISTCHK = PTRIST(STEP(ISON)) + PTRIST(STEP( ISON )) = -77777777 + IF ( IW(ISTCHK+KEEP(IXSZ)) .GE. 0 ) THEN + WRITE(*,*) 'error 3 in CMUMPS_211' + CALL MUMPS_ABORT() + ENDIF + CALL CMUMPS_152(.FALSE., MYID, N, ISTCHK, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + 600 CONTINUE + DEALLOCATE(NBROW) + DEALLOCATE(MAP) + DEALLOCATE(PERM) + DEALLOCATE(SLAVES_PERE) + RETURN + 700 CONTINUE + CALL CMUMPS_44(MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE CMUMPS_211 + SUBROUTINE CMUMPS_93(SIZE_INPLACE, + &MYID,N,IOLDPS,TYPE,IW, LIW, A, LA, + &POSFAC, LRLU, LRLUS, IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8, + &SSARBR,INODE,IERR) + USE CMUMPS_LOAD + USE CMUMPS_OOC + IMPLICIT NONE + INTEGER MYID + INTEGER IOLDPS, TYPE, LIW, N, KEEP(500) + INTEGER(8) :: SIZE_INPLACE, LA, POSFAC, LRLU, LRLUS + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) KEEP8(150) + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER IWPOS, LDLT + INTEGER STEP( N ) + INTEGER (8) :: PTRFAC(KEEP(28)) + LOGICAL SSARBR + INTEGER IOLDSHIFT, IPSSHIFT + INCLUDE 'mumps_headers.h' + INTEGER LCONT, NELIM, NROW, NPIV, INTSIZ + INTEGER NFRONT, NSLAVES + INTEGER IPS, IPSIZE + INTEGER(8) :: SIZELU, SIZECB, IAPOS, I + LOGICAL MOVEPTRAST + INTEGER INODE + INTEGER IERR + IERR=0 + LDLT = KEEP(50) + IOLDSHIFT = IOLDPS + KEEP(IXSZ) + IF ( IW( IOLDSHIFT ) < 0 ) THEN + write(*,*) ' ERROR 1 compressLU:Should not point to a band.' + CALL MUMPS_ABORT() + ELSE IF ( IW( IOLDSHIFT + 2 ) < 0 ) THEN + write(*,*) ' ERROR 2 compressLU:Stack not performed yet', + & IW(IOLDSHIFT + 2) + CALL MUMPS_ABORT() + ENDIF + LCONT = IW( IOLDSHIFT ) + NELIM = IW( IOLDSHIFT + 1 ) + NROW = IW( IOLDSHIFT + 2 ) + NPIV = IW( IOLDSHIFT + 3 ) + IAPOS = PTRFAC(IW( IOLDSHIFT + 4 )) + NSLAVES= IW( IOLDSHIFT + 5 ) + NFRONT = LCONT + NPIV + INTSIZ = IW(IOLDPS+XXI) + IF ( (NSLAVES > 0 .AND. TYPE .NE. 2) .OR. + & (NSLAVES .eq. 0 .AND. TYPE .EQ. 2 ) ) THEN + WRITE(*,*) ' ERROR 3 compressLU: problem with level of inode' + CALL MUMPS_ABORT() + END IF + IF (LDLT.EQ.0) THEN + SIZELU = int(LCONT + NROW, 8) * int(NPIV,8) + ELSE + SIZELU = int(NROW,8) * int(NPIV,8) + ENDIF + IF ( TYPE .EQ. 2 ) THEN + IF (LDLT.EQ.0) THEN + SIZECB = int(NELIM,8) * int(LCONT,8) + ELSE + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + SIZECB = int(NELIM+1,8) * int(NELIM + NPIV,8) + ELSE + SIZECB = int(NELIM,8) * int(NELIM + NPIV,8) + ENDIF + ENDIF + ELSE + IF (LDLT.EQ.0) THEN + SIZECB = int(LCONT,8) * int(LCONT,8) + ELSE + SIZECB = int(NROW,8) * int(LCONT,8) + ENDIF + END IF + CALL MUMPS_724( IW(IOLDPS+XXR), SIZECB ) + IF ((SIZECB.EQ.0_8).AND.(KEEP(201).EQ.0)) THEN + GOTO 500 + ENDIF + IF (KEEP(201).EQ.2) THEN + KEEP8(31)=KEEP8(31)+SIZELU + CALL CMUMPS_576(INODE,PTRFAC,KEEP,KEEP8, + & A,LA,SIZELU, IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID,': Internal error in CMUMPS_576' + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF ( IOLDPS + INTSIZ .NE. IWPOS ) THEN + IPS = IOLDPS + INTSIZ + MOVEPTRAST = .FALSE. + DO WHILE ( IPS .NE. IWPOS ) + IPSIZE = IW(IPS+XXI) + IPSSHIFT = IPS + KEEP(IXSZ) + IF ( IW( IPSSHIFT + 2 ) < 0 ) THEN + NFRONT = IW( IPSSHIFT ) + IF(KEEP(201).EQ.0)THEN + PTRFAC(IW( IPSSHIFT + 4 )) = + & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB + ELSE + PTRFAC(IW(IPSSHIFT+4))=PTRFAC(IW(IPSSHIFT+4)) - + & SIZECB - SIZELU + ENDIF + MOVEPTRAST = .TRUE. + IF(KEEP(201).EQ.0)THEN + PTRAST(IW(IPSSHIFT+4))=PTRAST(IW(IPSSHIFT+4))-SIZECB + ELSE + PTRAST(IW(IPSSHIFT+4))=PTRAST(IW(IPSSHIFT+4))-SIZECB + & - SIZELU + ENDIF + ELSE IF ( IW( IPSSHIFT ) < 0 ) THEN + IF(KEEP(201).EQ.0)THEN + PTRFAC(IW(IPSSHIFT+3)) = PTRFAC(IW(IPSSHIFT+3))-SIZECB + ELSE + PTRFAC(IW(IPSSHIFT+3)) = PTRFAC(IW(IPSSHIFT+3)) + & -SIZECB-SIZELU + ENDIF + ELSE + NFRONT = IW( IPSSHIFT ) + IW( IPSSHIFT + 3 ) + IF(KEEP(201).EQ.0)THEN + PTRFAC(IW( IPSSHIFT + 4 )) = + & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB + ELSE + PTRFAC(IW( IPSSHIFT + 4 )) = + & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB + & - SIZELU + ENDIF + END IF + IPS = IPS + IPSIZE + END DO + IF ((SIZECB .NE. 0_8).OR.(KEEP(201).NE.0)) THEN + IF (KEEP(201).NE.0) THEN + DO I=IAPOS, POSFAC - SIZECB - SIZELU - 1_8 + A( I ) = A( I + SIZECB + SIZELU) + END DO + ELSE + DO I=IAPOS + SIZELU, POSFAC - SIZECB - 1_8 + A( I ) = A( I + SIZECB ) + END DO + ENDIF + END IF + ENDIF + IF (KEEP(201).NE.0) THEN + POSFAC = POSFAC - (SIZECB+SIZELU) + LRLU = LRLU + (SIZECB+SIZELU) + LRLUS = LRLUS + (SIZECB+SIZELU) - SIZE_INPLACE + ELSE + POSFAC = POSFAC - SIZECB + LRLU = LRLU + SIZECB + LRLUS = LRLUS + SIZECB - SIZE_INPLACE + ENDIF + 500 CONTINUE + CALL CMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,SIZELU,-SIZECB+SIZE_INPLACE,KEEP,KEEP8,LRLU) + RETURN + END SUBROUTINE CMUMPS_93 + SUBROUTINE CMUMPS_314( N, ISON, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, TYPE_SON + & ) + USE CMUMPS_OOC + USE CMUMPS_LOAD + IMPLICIT NONE + INTEGER(8) :: LA, LRLU, LRLUS, POSFAC, IPTRLU + INTEGER N, ISON, LIW, IWPOS, IWPOSCB, + & COMP, IFLAG, IERROR, SLAVEF, MYID, COMM, + & TYPE_SON + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), STEP(N), + & PIMASTER(KEEP(28)), IW(LIW) + INTEGER PTLUST_S(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + DOUBLE PRECISION OPELIW + DOUBLE PRECISION FLOP1, FLOP1_EFFECTIVE + COMPLEX A( LA ) + INTEGER(8) :: LREQA, POSA, POSALOC, OLDPOS, JJ + INTEGER NFRONT, NCOL_L, NROW_L, LREQI, NSLAVES_L, + & POSI, I, IROW_L, ICOL_L, LDA_BAND, NASS + LOGICAL NONEED_TO_COPY_FACTORS + INTEGER(8) :: LAFAC, LREQA_HEADER + INTEGER LIWFAC, STRAT, TYPEFile, NextPivDummy, + & IOLDPS_CB + LOGICAL LAST_CALL + TYPE(IO_BLOCK) :: MonBloc + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0d0) + FLOP1 = ZERO + NCOL_L = IW( PTRIST(STEP( ISON )) + 3 + KEEP(IXSZ) ) + NROW_L = IW( PTRIST(STEP( ISON )) + 2 + KEEP(IXSZ) ) + NSLAVES_L = IW( PTRIST(STEP( ISON )) + 5 + KEEP(IXSZ) ) + LDA_BAND = NCOL_L + IW( PTRIST(STEP( ISON )) + KEEP(IXSZ) ) + IF ( KEEP(50) .eq. 0 ) THEN + NFRONT = LDA_BAND + ELSE + NFRONT = IW( PTRIST(STEP( ISON )) + 7 + KEEP(IXSZ) ) + END IF + IF (KEEP(201).EQ.1) THEN + IOLDPS_CB = PTRIST(STEP( ISON )) + CALL MUMPS_729(LAFAC, IW(IOLDPS_CB+XXR)) + LIWFAC = IW(IOLDPS_CB+XXI) + TYPEFile = TYPEF_L + NextPivDummy = -8888 + MonBloc%INODE = ISON + MonBloc%MASTER = .FALSE. + MonBloc%Typenode = 2 + MonBloc%NROW = NROW_L + MonBloc%NCOL = LDA_BAND + MonBloc%NFS = IW(IOLDPS_CB+1+KEEP(IXSZ)) + MonBloc%LastPiv = NCOL_L + NULLIFY(MonBloc%INDICES) + STRAT = STRAT_WRITE_MAX + LAST_CALL = .TRUE. + MonBloc%Last = .TRUE. + CALL CMUMPS_688 + & ( STRAT, TYPEFile, + & A(PTRAST(STEP(ISON))), LAFAC, MonBloc, + & NextPivDummy, NextPivDummy, + & IW(IOLDPS_CB), LIWFAC, + & MYID, KEEP8(31), IFLAG,LAST_CALL ) + IF ((NCOL_L.EQ.0).OR.(NROW_L.EQ.0)) THEN + ENDIF + ENDIF + NONEED_TO_COPY_FACTORS = (KEEP(201).EQ.1) .OR. (KEEP(201).EQ.-1) + IF ((NCOL_L.EQ.0).OR.(NROW_L.EQ.0)) THEN + GOTO 80 + ENDIF + LREQI = 4 + NCOL_L + NROW_L + KEEP(IXSZ) + LREQA_HEADER = int(NCOL_L,8) * int(NROW_L,8) + IF (NONEED_TO_COPY_FACTORS) THEN + LREQA = 0_8 + ELSE + LREQA = LREQA_HEADER + ENDIF + IF ( LRLU .LT. LREQA .OR. + & IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LREQA ) THEN + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GO TO 700 + END IF + CALL CMUMPS_94( N,KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS,IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress Stack_band:LRLU,LRLUS=', + & LRLU, LRLUS + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GOTO 700 + END IF + IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + GOTO 700 + END IF + END IF + IF (.NOT. NONEED_TO_COPY_FACTORS) THEN + POSA = POSFAC + POSFAC = POSFAC + LREQA + LRLU = LRLU - LREQA + LRLUS = LRLUS - LREQA + KEEP8(67) = min(LRLUS, KEEP8(67)) + IF(KEEP(201).NE.2)THEN + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,LREQA,LREQA,KEEP,KEEP8,LRLU) + ELSE + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU) + ENDIF + ENDIF + POSI = IWPOS + IWPOS = IWPOS + LREQI + PTLUST_S(STEP( ISON )) = POSI + IW(POSI+XXI)=LREQI + CALL MUMPS_730(LREQA, IW(POSI+XXR)) + CALL MUMPS_730(LREQA_HEADER, IW(POSI+XXR)) + IW(POSI+XXS)=-9999 + POSI=POSI+KEEP(IXSZ) + IW( POSI ) = - NCOL_L + IW( POSI + 1 ) = NROW_L + IW( POSI + 2 ) = NFRONT - NCOL_L + IW( POSI + 3 ) = STEP(ISON) + IF (.NOT. NONEED_TO_COPY_FACTORS) THEN + PTRFAC(STEP(ISON)) = POSA + ELSE + PTRFAC(STEP(ISON)) = -77777_8 + ENDIF + IROW_L = PTRIST(STEP(ISON)) + 6 + NSLAVES_L + KEEP(IXSZ) + ICOL_L = PTRIST(STEP(ISON)) + 6 + NROW_L + NSLAVES_L + KEEP(IXSZ) + DO I = 1, NROW_L + IW( POSI+3+I ) = IW( IROW_L+I-1 ) + ENDDO + DO I = 1, NCOL_L + IW( POSI+NROW_L+3+I) = IW( ICOL_L+I-1 ) + ENDDO + IF (.NOT.NONEED_TO_COPY_FACTORS) THEN + POSALOC = POSA + DO I = 1, NROW_L + OLDPOS = PTRAST( STEP(ISON)) + int(I-1,8)*int(LDA_BAND,8) + DO JJ = 0_8, int(NCOL_L-1,8) + A( POSALOC+JJ ) = A( OLDPOS+JJ ) + ENDDO + POSALOC = POSALOC + int(NCOL_L,8) + END DO + ENDIF + IF (KEEP(201).EQ.2) THEN + KEEP8(31)=KEEP8(31)+LREQA + ENDIF + KEEP8(10) = KEEP8(10) + int(NCOL_L,8) * int(NROW_L,8) + IF (KEEP(201).EQ.2) THEN + CALL CMUMPS_576(ISON,PTRFAC,KEEP,KEEP8,A,LA,LREQA,IFLAG) + IF(IFLAG.LT.0)THEN + WRITE(*,*)MYID,': Internal error in CMUMPS_576' + IERROR=0 + GOTO 700 + ENDIF + ENDIF + IF (KEEP(201).EQ.2) THEN + POSFAC = POSFAC - LREQA + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,LREQA,0_8,KEEP,KEEP8,LRLU) + ENDIF + 80 CONTINUE + IF (TYPE_SON == 1) THEN + GOTO 90 + ENDIF + IF ( KEEP(50) .eq. 0 ) THEN + FLOP1 = dble( NCOL_L * NROW_L) + + & dble(NROW_L*NCOL_L)*dble(2*NFRONT-NCOL_L-1) + ELSE + FLOP1 = dble( NCOL_L ) * dble( NROW_L ) + & * dble( 2 * LDA_BAND - NROW_L - NCOL_L + 1) + END IF + OPELIW = OPELIW + FLOP1 + FLOP1_EFFECTIVE = FLOP1 + NASS = IW( PTRIST(STEP( ISON )) + 4 + KEEP(IXSZ) ) + IF ( NCOL_L .NE. NASS ) THEN + IF ( KEEP(50).eq.0 ) THEN + FLOP1 = dble( NASS * NROW_L) + + & dble(NROW_L*NASS)*dble(2*NFRONT-NASS-1) + ELSE + FLOP1 = dble( NASS ) * dble( NROW_L ) * + & dble( 2 * LDA_BAND - NROW_L - NASS + 1) + END IF + END IF + CALL CMUMPS_190(1,.FALSE.,FLOP1_EFFECTIVE-FLOP1, + & KEEP,KEEP8) + CALL CMUMPS_190(2,.FALSE.,-FLOP1,KEEP,KEEP8) + 90 CONTINUE + RETURN + 700 CONTINUE + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE CMUMPS_314 + SUBROUTINE CMUMPS_626( N, ISON, + & PTRIST, PTRAST, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + IMPLICIT NONE + include 'mumps_headers.h' + INTEGER(8) :: LRLU, LRLUS, IPTRLU, LA + INTEGER ISON, MYID, N, IWPOSCB + INTEGER KEEP(500), STEP(N) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER PTRIST(KEEP(28)) + INTEGER LIW + INTEGER IW(LIW) + COMPLEX A(LA) + INTEGER ISTCHK + ISTCHK = PTRIST(STEP(ISON)) + CALL CMUMPS_152(.FALSE.,MYID, N, ISTCHK, + & PTRAST(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + PTRIST(STEP( ISON )) = -9999888 + PTRAST(STEP( ISON )) = -9999888_8 + RETURN + END SUBROUTINE CMUMPS_626 + SUBROUTINE CMUMPS_214( KEEP,KEEP8, + & MYID, N, NELT, LNA, NZ, NA_ELT, NSLAVES, + & MEMORY_MBYTES, EFF, OOC_STRAT, PERLU_ON, + & MEMORY_BYTES ) + IMPLICIT NONE + LOGICAL, INTENT(IN) :: EFF, PERLU_ON + INTEGER, INTENT(IN) :: OOC_STRAT + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER MYID, N, NELT, NSLAVES, LNA, NZ, NA_ELT + INTEGER(8), INTENT(OUT) :: MEMORY_BYTES + INTEGER, INTENT(OUT) :: MEMORY_MBYTES + LOGICAL :: I_AM_SLAVE, I_AM_MASTER + INTEGER :: PERLU, NBRECORDS + INTEGER(8) :: NB_REAL, MAXS_MIN + INTEGER(8) :: TEMP, NB_BYTES, NB_INT + INTEGER :: CMUMPS_LBUF_INT, CMUMPS_LBUFR_BYTES, CMUMPS_LBUF + INTEGER :: NBUFS + INTEGER(8) :: TEMPI + INTEGER(8) :: TEMPR + INTEGER :: MIN_PERLU + INTEGER(8) :: BUF_OOC, BUF_OOC_PANEL, BUF_OOC_NOPANEL + INTEGER(8) :: OOC_NB_FILE_TYPE + INTEGER(8) :: NSTEPS8, N8, NELT8 + INTEGER(8) :: I8OVERI + I8OVERI = int(KEEP(10),8) + PERLU = KEEP(12) + NSTEPS8 = int(KEEP(28),8) + N8 = int(N,8) + NELT8 = int(NELT,8) + IF (.NOT.PERLU_ON) PERLU = 0 + I_AM_MASTER = ( MYID .eq. 0 ) + I_AM_SLAVE = ( KEEP(46).eq. 1 .or. MYID .ne. 0 ) + TEMP = 0_8 + NB_REAL = 0_8 + NB_BYTES = 0_8 + NB_INT = 0_8 + NB_INT = NB_INT + 5_8 * NSTEPS8 + NB_INT = NB_INT + NSTEPS8 + int(KEEP(56),8)*int(NSLAVES+2,8) + NB_INT = NB_INT + 3_8 * N8 + IF (KEEP(23).ne.0 .and. I_AM_MASTER) NB_INT=NB_INT + N8 + IF (KEEP(55).eq.0) THEN + NB_INT = NB_INT + 2_8 * N8 + ELSE + NB_INT = NB_INT + 2_8 * ( NELT8 + 1_8 ) + ENDIF + IF (KEEP(55) .ne. 0 ) THEN + NB_INT = NB_INT + N8 + 1_8 + NELT8 + END IF + NB_INT = NB_INT + int(LNA,8) + IF ( OOC_STRAT .GT. 0 .OR. OOC_STRAT .EQ. -1 ) THEN + MAXS_MIN = KEEP8(14) + ELSE + MAXS_MIN = KEEP8(12) + ENDIF + IF ( .NOT. EFF ) THEN + IF ( KEEP8(24).EQ.0_8 ) THEN + NB_REAL = NB_REAL + MAXS_MIN + + & int(PERLU,8)*(MAXS_MIN / 100_8 + 1_8 ) + ENDIF + ELSE + NB_REAL = NB_REAL + KEEP8(67) + ENDIF + IF ( OOC_STRAT .GT. 0 .AND. I_AM_SLAVE ) THEN + BUF_OOC_NOPANEL = 2_8 * KEEP8(119) + IF (KEEP(50).EQ.0)THEN + BUF_OOC_PANEL = 8_8 * int(KEEP(226),8) + ELSE + BUF_OOC_PANEL = 4_8 * int(KEEP(226),8) + ENDIF + IF (OOC_STRAT .EQ. 2) THEN + BUF_OOC = BUF_OOC_NOPANEL + ELSE + BUF_OOC = BUF_OOC_PANEL + ENDIF + NB_REAL = NB_REAL + min(BUF_OOC + int(max(PERLU,0),8) * + & (BUF_OOC/100_8+1_8),12000000_8) + IF (OOC_STRAT .EQ. 2) THEN + OOC_NB_FILE_TYPE = 1_8 + ELSE + IF (KEEP(50).EQ.0) THEN + OOC_NB_FILE_TYPE = 2_8 + ELSE + OOC_NB_FILE_TYPE = 1_8 + ENDIF + ENDIF + NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 * I8OVERI + NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 * I8OVERI + NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 + ENDIF + NB_REAL = NB_REAL + int(KEEP(13),8) + IF (KEEP(252).EQ.1 .AND. .NOT. I_AM_MASTER) THEN + NB_REAL = NB_REAL + N8 + ENDIF + IF ( .not. ( I_AM_SLAVE .and. I_AM_MASTER .and. KEEP(52) .eq. 0 + & .and. KEEP(55) .ne. 0 ) ) THEN + NB_INT = NB_INT + int(KEEP(14),8) + END IF + IF ( I_AM_SLAVE .and. KEEP(38) .ne. 0 ) THEN + NB_INT = NB_INT + 2_8 * N8 + END IF + TEMPI= 0_8 + TEMPR = 0_8 + NBRECORDS = KEEP(39) + IF (KEEP(55).eq.0) THEN + NBRECORDS = min(KEEP(39), NZ) + ELSE + NBRECORDS = min(KEEP(39), NA_ELT) + ENDIF + IF ( KEEP(54) .eq. 0 ) THEN + IF ( I_AM_MASTER ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + NBUFS = NSLAVES + ELSE + NBUFS = NSLAVES - 1 + IF (KEEP(55) .eq. 0 ) + & TEMPI = TEMPI + 2_8 * N8 + END IF + TEMPI = TEMPI + 2_8 * int(NBRECORDS,8) * int(NBUFS,8) + TEMPR = TEMPR + int(NBRECORDS,8) * int(NBUFS,8) + ELSE + IF ( KEEP(55) .eq. 0 )THEN + TEMPI = TEMPI + 2_8 * int(NBRECORDS,8) + TEMPR = TEMPR + int(NBRECORDS,8) + END IF + END IF + ELSE + IF ( I_AM_SLAVE ) THEN + TEMPI = TEMPI + int(1+4*NSLAVES,8) * int(NBRECORDS,8) + TEMPR = TEMPR + int(1+2*NSLAVES,8) * int(NBRECORDS,8) + END IF + END IF + TEMP = max( NB_BYTES + (NB_INT + TEMPI) * int(KEEP(34),8) + & + (NB_REAL+TEMPR) * int(KEEP(35),8) + & , TEMP ) + IF ( I_AM_SLAVE ) THEN + CMUMPS_LBUFR_BYTES = KEEP( 44 ) * KEEP( 35 ) + CMUMPS_LBUFR_BYTES = max( CMUMPS_LBUFR_BYTES, + & 100000 ) + IF (KEEP(48).EQ.5) THEN + MIN_PERLU=2 + ELSE + MIN_PERLU=0 + ENDIF + CMUMPS_LBUFR_BYTES = CMUMPS_LBUFR_BYTES + & + int( 2.0E0 * real(max(PERLU,MIN_PERLU))* + & real(CMUMPS_LBUFR_BYTES)/100E0) + NB_BYTES = NB_BYTES + int(CMUMPS_LBUFR_BYTES,8) + CMUMPS_LBUF = int( real(KEEP(213)) / 100.0E0 + & * real(KEEP( 43 ) * KEEP( 35 )) ) + CMUMPS_LBUF = max( CMUMPS_LBUF, 100000 ) + CMUMPS_LBUF = CMUMPS_LBUF + & + int( 2.0E0 * real(max(PERLU,0))* + & real(CMUMPS_LBUF)/100E0) + CMUMPS_LBUF = max(CMUMPS_LBUF, CMUMPS_LBUFR_BYTES) + NB_BYTES = NB_BYTES + int(CMUMPS_LBUF,8) + CMUMPS_LBUF_INT = ( KEEP(56) + + & NSLAVES * NSLAVES ) * 5 + & * KEEP(34) + NB_BYTES = NB_BYTES + int(CMUMPS_LBUF_INT,8) + IF ( EFF ) THEN + IF (OOC_STRAT .GT. 0) THEN + NB_INT = NB_INT + int(KEEP(225),8) + ELSE + NB_INT = NB_INT + int(KEEP(15),8) + ENDIF + ELSE + IF (OOC_STRAT .GT. 0) THEN + NB_INT = NB_INT + int( + & KEEP(225) + 2 * max(PERLU,10) * + & ( KEEP(225) / 100 + 1 ) + & ,8) + ELSE + NB_INT = NB_INT + int( + & KEEP(15) + 2 * max(PERLU,10) * + & ( KEEP(15) / 100 + 1 ) + & ,8) + ENDIF + ENDIF + NB_INT = NB_INT + NSTEPS8 + NB_INT = NB_INT + NSTEPS8 * I8OVERI + NB_INT = NB_INT + N8 + 5_8 * NSTEPS8 + 3_8 + NB_INT = NB_INT + 2_8 * NSTEPS8 * I8OVERI + END IF + MEMORY_BYTES = NB_BYTES + NB_INT * int(KEEP(34),8) + + & NB_REAL * int(KEEP(35),8) + MEMORY_BYTES = max( MEMORY_BYTES, TEMP ) + MEMORY_MBYTES = int( MEMORY_BYTES / 1000000_8 ) + 1 + RETURN + END SUBROUTINE CMUMPS_214 + SUBROUTINE CMUMPS_757(M_ARRAY, M_SIZE) + IMPLICIT NONE + INTEGER M_SIZE + REAL M_ARRAY(M_SIZE) + REAL ZERO + PARAMETER (ZERO=0.0E0) + M_ARRAY=ZERO + RETURN + END SUBROUTINE CMUMPS_757 + SUBROUTINE CMUMPS_618( + & A,ASIZE,NCOL,NROW, + & M_ARRAY,NMAX,COMPRESSCB,LROW1) + IMPLICIT NONE + INTEGER(8) :: ASIZE + INTEGER NROW,NCOL,NMAX,LROW1 + LOGICAL COMPRESSCB + COMPLEX A(ASIZE) + REAL M_ARRAY(NMAX) + INTEGER I + INTEGER(8):: APOS, J, LROW + REAL ZERO,TMP + PARAMETER (ZERO=0.0E0) + M_ARRAY(1:NMAX) = ZERO + APOS = 0_8 + IF (COMPRESSCB) THEN + LROW=int(LROW1,8) + ELSE + LROW=int(NCOL,8) + ENDIF + DO I=1,NROW + DO J=1_8,int(NMAX,8) + TMP = abs(A(APOS+J)) + IF(TMP.GT.M_ARRAY(J)) M_ARRAY(J) = TMP + ENDDO + APOS = APOS + LROW + IF (COMPRESSCB) LROW=LROW+1_8 + ENDDO + RETURN + END SUBROUTINE CMUMPS_618 + SUBROUTINE CMUMPS_710 (id, NB_INT,NB_CMPLX ) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(CMUMPS_STRUC) :: id + INTEGER(8) NB_INT, NB_CMPLX + INTEGER(8) NB_REAL + NB_INT = 0_8 + NB_CMPLX = 0_8 + NB_REAL = 0_8 + IF (associated(id%IS)) NB_INT=NB_INT+size(id%IS) + IF (associated(id%IS1)) NB_INT=NB_INT+size(id%IS1) + NB_INT=NB_INT+size(id%KEEP) + NB_INT=NB_INT+size(id%ICNTL) + NB_INT=NB_INT+size(id%INFO) + NB_INT=NB_INT+size(id%INFOG) + IF (associated(id%MAPPING)) NB_INT=NB_INT+size(id%MAPPING) + IF (associated(id%POIDS)) NB_INT=NB_INT+size(id%POIDS) + IF (associated(id%BUFR)) NB_INT=NB_INT+size(id%BUFR) + IF (associated(id%STEP)) NB_INT=NB_INT+size(id%STEP) + IF (associated(id%NE_STEPS )) NB_INT=NB_INT+size(id%NE_STEPS ) + IF (associated(id%ND_STEPS)) NB_INT=NB_INT+size(id%ND_STEPS) + IF (associated(id%Step2node)) NB_INT=NB_INT+size(id%Step2node) + IF (associated(id%FRERE_STEPS)) NB_INT=NB_INT+size(id%FRERE_STEPS) + IF (associated(id%DAD_STEPS)) NB_INT=NB_INT+size(id%DAD_STEPS) + IF (associated(id%FILS)) NB_INT=NB_INT+size(id%FILS) + IF (associated(id%PTRAR)) NB_INT=NB_INT+size(id%PTRAR) + IF (associated(id%FRTPTR)) NB_INT=NB_INT+size(id%FRTPTR) + NB_INT=NB_INT+size(id%KEEP8) * id%KEEP(10) + IF (associated(id%PTRFAC)) NB_INT=NB_INT+size(id%PTRFAC) * + & id%KEEP(10) + IF (associated(id%FRTELT)) NB_INT=NB_INT+size(id%FRTELT) + IF (associated(id%NA)) NB_INT=NB_INT+size(id%NA) + IF (associated(id%PROCNODE_STEPS)) + & NB_INT=NB_INT+size(id%PROCNODE_STEPS) + IF (associated(id%PTLUST_S)) NB_INT=NB_INT+size(id%PTLUST_S) + IF (associated(id%PROCNODE)) NB_INT=NB_INT+size(id%PROCNODE) + IF (associated(id%INTARR)) NB_INT=NB_INT+size(id%INTARR) + IF (associated(id%ELTPROC)) NB_INT=NB_INT+size(id%ELTPROC) + IF (associated(id%CANDIDATES)) + & NB_INT=NB_INT+size(id%CANDIDATES) + IF (associated(id%ISTEP_TO_INIV2)) + & NB_INT=NB_INT+size(id%ISTEP_TO_INIV2) + IF (associated(id%FUTURE_NIV2)) + & NB_INT=NB_INT+size(id%FUTURE_NIV2) + IF (associated(id%TAB_POS_IN_PERE)) + & NB_INT=NB_INT+size(id%TAB_POS_IN_PERE) + IF (associated(id%I_AM_CAND)) + & NB_INT=NB_INT+size(id%I_AM_CAND) + IF (associated(id%MEM_DIST)) + & NB_INT=NB_INT+size(id%MEM_DIST) + IF (associated(id%POSINRHSCOMP)) + & NB_INT=NB_INT+size(id%POSINRHSCOMP) + IF (associated(id%MEM_SUBTREE)) + & NB_INT=NB_INT+size(id%MEM_SUBTREE) + IF (associated(id%MY_ROOT_SBTR)) + & NB_INT=NB_INT+size(id%MY_ROOT_SBTR) + IF (associated(id%MY_FIRST_LEAF)) + & NB_INT=NB_INT+size(id%MY_FIRST_LEAF) + IF (associated(id%MY_NB_LEAF)) NB_INT=NB_INT+size(id%MY_NB_LEAF) + IF (associated(id%DEPTH_FIRST)) NB_INT=NB_INT+size(id%DEPTH_FIRST) + IF (associated(id%COST_TRAV)) NB_INT=NB_INT+size(id%COST_TRAV) + IF (associated(id%CB_SON_SIZE)) NB_INT=NB_INT+size(id%CB_SON_SIZE) + IF (associated(id%OOC_INODE_SEQUENCE)) + & NB_INT=NB_INT+size(id%OOC_INODE_SEQUENCE) + IF (associated(id%OOC_SIZE_OF_BLOCK)) + & NB_INT=NB_INT+size(id%OOC_SIZE_OF_BLOCK) + IF (associated(id%OOC_VADDR)) + & NB_INT=NB_INT+size(id%OOC_VADDR) + IF (associated(id%OOC_TOTAL_NB_NODES)) + & NB_INT=NB_INT+size(id%OOC_TOTAL_NB_NODES) + IF (associated(id%OOC_NB_FILES)) + & NB_INT=NB_INT+size(id%OOC_NB_FILES) + IF (associated(id%OOC_FILE_NAME_LENGTH)) + & NB_INT=NB_INT+size(id%OOC_FILE_NAME_LENGTH) + IF (associated(id%PIVNUL_LIST)) NB_INT=NB_INT+size(id%PIVNUL_LIST) + IF (associated(id%SUP_PROC)) NB_INT=NB_INT+size(id%SUP_PROC) + IF (associated(id%DBLARR)) NB_CMPLX=NB_CMPLX+size(id%DBLARR) + IF (associated(id%RHSCOMP)) NB_CMPLX=NB_CMPLX+size(id%RHSCOMP) + IF (associated(id%S)) NB_CMPLX=NB_CMPLX+id%KEEP8(23) + IF (associated(id%COLSCA)) NB_REAL=NB_REAL+size(id%COLSCA) + IF (associated(id%ROWSCA)) NB_REAL=NB_REAL+size(id%ROWSCA) + NB_REAL=NB_REAL+size(id%CNTL) + NB_REAL=NB_REAL+size(id%RINFO) + NB_REAL=NB_REAL+size(id%RINFOG) + NB_REAL=NB_REAL+size(id%DKEEP) + NB_CMPLX = NB_CMPLX + NB_REAL/2_8 + RETURN + END SUBROUTINE CMUMPS_710 + SUBROUTINE CMUMPS_756(N8,SRC,DEST) + IMPLICIT NONE + INTEGER(8) :: N8 + COMPLEX, intent(in) :: SRC(N8) + COMPLEX, intent(out) :: DEST(N8) + INTEGER(8) :: SHIFT8, HUG8 + INTEGER :: I, I4SIZE + HUG8=int(huge(I4SIZE),8) + DO I = 1, int(( N8 + HUG8 - 1_8 ) / HUG8) + SHIFT8 = 1_8 + int(I-1,8) * HUG8 + I4SIZE = int(min(HUG8, N8-SHIFT8+1_8)) + CALL ccopy(I4SIZE, SRC(SHIFT8), 1, DEST(SHIFT8), 1) + ENDDO + RETURN + END SUBROUTINE CMUMPS_756 + SUBROUTINE CMUMPS_22( INPLACE, MIN_SPACE_IN_PLACE, + & SSARBR, PROCESS_BANDE, + & MYID,N, KEEP,KEEP8, + & IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP,PIMASTER,PAMASTER, + & LREQ, LREQCB, NODE_ARG, STATE_ARG, SET_HEADER, + & COMP, LRLUS, IFLAG, IERROR ) + USE CMUMPS_LOAD + IMPLICIT NONE + INTEGER N,LIW, KEEP(500) + INTEGER(8) LA, LRLU, IPTRLU, LRLUS, LREQCB + INTEGER(8) PAMASTER(KEEP(28)), PTRAST(KEEP(28)) + INTEGER IWPOS,IWPOSCB + INTEGER(8) :: MIN_SPACE_IN_PLACE + INTEGER NODE_ARG, STATE_ARG + INTEGER(8) KEEP8(150) + INTEGER IW(LIW),PTRIST(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER MYID, IXXP + COMPLEX A(LA) + LOGICAL INPLACE, PROCESS_BANDE, SSARBR, SET_HEADER + INTEGER COMP, LREQ, IFLAG, IERROR + INCLUDE 'mumps_headers.h' + INTEGER INODE_LOC,NPIV,NASS,NROW,NCB + INTEGER ISIZEHOLE + INTEGER(8) :: MEM_GAIN, RSIZEHOLE, LREQCB_EFF, LREQCB_WISHED + LOGICAL DONE + IF ( INPLACE ) THEN + LREQCB_EFF = MIN_SPACE_IN_PLACE + IF ( MIN_SPACE_IN_PLACE > 0_8 ) THEN + LREQCB_WISHED = LREQCB + ELSE + LREQCB_WISHED = 0_8 + ENDIF + ELSE + LREQCB_EFF = LREQCB + LREQCB_WISHED = LREQCB + ENDIF + IF (IWPOSCB.EQ.LIW) THEN + IF (LREQ.NE.KEEP(IXSZ).OR.LREQCB.NE.0_8 + & .OR. .NOT. SET_HEADER) THEN + WRITE(*,*) "Internal error in CMUMPS_22", + & SET_HEADER, LREQ, LREQCB + CALL MUMPS_ABORT() + ENDIF + IF (IWPOSCB-IWPOS+1 .LT. KEEP(IXSZ)) THEN + WRITE(*,*) "Problem with integer stack size",IWPOSCB, + & IWPOS, KEEP(IXSZ) + IFLAG = -8 + IERROR = LREQ + RETURN + ENDIF + IWPOSCB=IWPOSCB-KEEP(IXSZ) + IW(IWPOSCB+1+XXI)=KEEP(IXSZ) + CALL MUMPS_730(0_8,IW(IWPOSCB+1+XXR)) + IW(IWPOSCB+1+XXN)=-919191 + IW(IWPOSCB+1+XXS)=S_NOTFREE + IW(IWPOSCB+1+XXP)=TOP_OF_STACK + RETURN + ENDIF + IF (KEEP(214).EQ.1.AND. + & KEEP(216).EQ.1.AND. + & IWPOSCB.NE.LIW) THEN + IF (IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG.OR. + & IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG38) THEN + NCB = IW( IWPOSCB+1 + KEEP(IXSZ) ) + NROW = IW( IWPOSCB+1 + KEEP(IXSZ) + 2) + NPIV = IW( IWPOSCB+1 + KEEP(IXSZ) + 3) + INODE_LOC= IW( IWPOSCB+1 + XXN) + CALL CMUMPS_632(IWPOSCB+1,IW,LIW, + & ISIZEHOLE,RSIZEHOLE) + IF (IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG) THEN + CALL CMUMPS_627(A,LA,IPTRLU+1_8, + & NROW,NCB,NPIV+NCB,0, + & IW(IWPOSCB+1 + XXS),RSIZEHOLE) + IW(IWPOSCB+1 + XXS) =S_NOLCLEANED + MEM_GAIN = int(NROW,8)*int(NPIV,8) + ENDIF + IF (IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG38) THEN + NASS = IW( IWPOSCB+1 + KEEP(IXSZ) + 4) + CALL CMUMPS_627(A,LA,IPTRLU+1_8, + & NROW,NCB,NPIV+NCB,NASS-NPIV, + & IW(IWPOSCB+1 + XXS),RSIZEHOLE) + IW(IWPOSCB+1 + XXS) =S_NOLCLEANED38 + MEM_GAIN = int(NROW,8)*int(NPIV+NCB-(NASS-NPIV),8) + ENDIF + IF (ISIZEHOLE.NE.0) THEN + CALL CMUMPS_630( IW,LIW,IWPOSCB+1, + & IWPOSCB+IW(IWPOSCB+1+XXI), + & ISIZEHOLE ) + IWPOSCB=IWPOSCB+ISIZEHOLE + IW(IWPOSCB+1+XXP+IW(IWPOSCB+1+XXI))=IWPOSCB+1 + PTRIST(STEP(INODE_LOC))=PTRIST(STEP(INODE_LOC))+ + & ISIZEHOLE + ENDIF + CALL MUMPS_724(IW(IWPOSCB+1+XXR), MEM_GAIN) + IPTRLU = IPTRLU+MEM_GAIN+RSIZEHOLE + LRLU = LRLU+MEM_GAIN+RSIZEHOLE + PTRAST(STEP(INODE_LOC))= + & PTRAST(STEP(INODE_LOC))+MEM_GAIN+RSIZEHOLE + ENDIF + ENDIF + DONE =.FALSE. + IF ((IPTRLU.LT.LREQCB_WISHED).OR.(LRLU.LT.LREQCB_WISHED)) THEN + IF (LRLUS.LT.LREQCB_EFF) THEN + GOTO 620 + ELSE + CALL CMUMPS_94(N,KEEP(28),IW,LIW,A,LA, + & LRLU,IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST, + & STEP, PIMASTER,PAMASTER,KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress... alloc_cb', + & 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 620 + END IF + DONE = .TRUE. + COMP = COMP + 1 + ENDIF + ENDIF + IF (IWPOSCB-IWPOS+1 .LT. LREQ) THEN + IF (DONE) GOTO 600 + CALL CMUMPS_94(N,KEEP(28),IW,LIW,A,LA, + & LRLU,IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST, + & STEP, PIMASTER,PAMASTER,KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress... alloc_cb', + & 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 620 + END IF + COMP = COMP + 1 + IF (IWPOSCB-IWPOS+1 .LT. LREQ) GOTO 600 + ENDIF + IXXP=IWPOSCB+XXP+1 + IF (IXXP.GT.LIW) THEN + WRITE(*,*) "Internal error 3 in CMUMPS_22",IXXP + ENDIF + IF (IW(IXXP).GT.0) THEN + WRITE(*,*) "Internal error 2 in CMUMPS_22",IW(IXXP),IXXP + ENDIF + IWPOSCB = IWPOSCB - LREQ + IF (SET_HEADER) THEN + IW(IXXP)= IWPOSCB + 1 + IW(IWPOSCB+1+XXI)=LREQ + CALL MUMPS_730(LREQCB, IW(IWPOSCB+1+XXR)) + IW(IWPOSCB+1+XXS)=STATE_ARG + IW(IWPOSCB+1+XXN)=NODE_ARG + IW(IWPOSCB+1+XXP)=TOP_OF_STACK + ENDIF + IPTRLU = IPTRLU - LREQCB + LRLU = LRLU - LREQCB + LRLUS = LRLUS - LREQCB_EFF + KEEP8(67) = min(LRLUS, KEEP8(67)) +#if ! defined(OLD_LOAD_MECHANISM) + CALL CMUMPS_471(SSARBR,PROCESS_BANDE, + & LA-LRLUS,0_8,LREQCB_EFF,KEEP,KEEP8,LRLU) +#else +#if defined (CHECK_COHERENCE) + CALL CMUMPS_471(SSARBR,PROCESS_BANDE, + & LA-LRLUS,0_8,LREQCB_EFF,KEEP,KEEP8,LRLU) +#else + CALL CMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,0_8,LREQCB_EFF,KEEP,KEEP8,LRLU) +#endif +#endif + RETURN + 600 IFLAG = -8 + IERROR = LREQ + RETURN + 620 IFLAG = -9 + CALL MUMPS_731(LREQCB_EFF - LRLUS, IERROR) + RETURN + END SUBROUTINE CMUMPS_22 + SUBROUTINE CMUMPS_244(N, NSTEPS, + & A, LA, IW, LIW, SYM_PERM, NA, LNA, + & NE_STEPS, NFSIZ, FILS, + & STEP, FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & PTRAR, LDPTRAR, + & PTRIST, PTLUST_S, PTRFAC, IW1, IW2, ITLOC, RHS_MUMPS, + & POOL, LPOOL, + & CNTL1, ICNTL, INFO, RINFO, KEEP,KEEP8,PROCNODE_STEPS, + & SLAVEF, + & COMM_NODES, MYID, MYID_NODES, + & BUFR,LBUFR,LBUFR_BYTES,INTARR,DBLARR, + & root, NELT, FRTPTR, FRTELT, COMM_LOAD, + & ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, + & MEM_DISTRIB, + & DKEEP,PIVNUL_LIST,LPN_LIST) + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER(8) :: LA + INTEGER N,NSTEPS,LIW,LPOOL,SLAVEF,COMM_NODES + INTEGER MYID, MYID_NODES,LNA + COMPLEX A(LA) + REAL RINFO(40) + INTEGER LBUFR, LBUFR_BYTES + INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB + INTEGER BUFR( LBUFR ) + INTEGER NELT, LDPTRAR + INTEGER FRTPTR(*), FRTELT(*) + REAL CNTL1 + INTEGER ICNTL(40) + INTEGER INFO(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IW(LIW), SYM_PERM(N), NA(LNA), + & NE_STEPS(KEEP(28)), FILS(N), + & FRERE(KEEP(28)), NFSIZ(KEEP(28)), + & DAD(KEEP(28)) + INTEGER CAND(SLAVEF+1, max(1,KEEP(56))) + INTEGER STEP(N) + INTEGER PTRAR(LDPTRAR,2) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER IW1(3*KEEP(28)), ITLOC(N+KEEP(253)), POOL(LPOOL) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: IW2(2*KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX DBLARR(max(1,KEEP(13))) + REAL SEUIL, SEUIL_LDLT_NIV2 + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + REAL UULOC + INTEGER LP, MPRINT + INTEGER NSTK,PTRAST, NBPROCFILS + INTEGER PIMASTER, PAMASTER + LOGICAL PROK + REAL ZERO, ONE + DATA ZERO /0.0E0/ + DATA ONE /1.0E0/ + INTRINSIC int,real,log + INTEGER IERR + INTEGER NTOTPV, NTOTPVTOT, NMAXNPIV + INTEGER(8) :: POSFAC, LRLU, IPTRLU, LRLUS + INTEGER IWPOS, LEAF, NBROOT, NROOT + KEEP(41)=0 + KEEP(42)=0 + NSTEPS = 0 + LP = ICNTL(1) + MPRINT = ICNTL(2) + PROK = (MPRINT.GT.0) + UULOC = CNTL1 + IF (UULOC.GT.ONE) UULOC=ONE + IF (UULOC.LT.ZERO) UULOC=ZERO + IF (KEEP(50).NE.0.AND.UULOC.GT.0.5E0) THEN + UULOC = 0.5E0 + ENDIF + PIMASTER = 1 + NSTK = PIMASTER + KEEP(28) + NBPROCFILS = NSTK + KEEP(28) + PTRAST = 1 + PAMASTER = 1 + KEEP(28) + IF (KEEP(4).LE.0) KEEP(4)=32 + IF (KEEP(5).LE.0) KEEP(5)=16 + IF (KEEP(5).GT.KEEP(4)) KEEP(5) = KEEP(4) + IF (KEEP(6).LE.0) KEEP(6)=24 + IF (KEEP(3).LE.KEEP(4)) KEEP(3)=KEEP(4)*2 + IF (KEEP(6).GT.KEEP(3)) KEEP(6) = KEEP(3) + POSFAC = 1_8 + IWPOS = 1 + LRLU = LA + LRLUS = LRLU + KEEP8(67) = LRLUS + IPTRLU = LRLU + NTOTPV = 0 + NMAXNPIV = 0 + IW1(NSTK:NSTK+KEEP(28)-1) = NE_STEPS(1:KEEP(28)) + CALL MUMPS_362(N, LEAF, NBROOT, NROOT, + & MYID_NODES, + & SLAVEF, NA, LNA, + & KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & POOL, LPOOL) + CALL CMUMPS_506(POOL, LPOOL, LEAF) + CALL CMUMPS_555(POOL, LPOOL,KEEP,KEEP8) + IF ( KEEP( 38 ) .NE. 0 ) THEN + NBROOT = NBROOT + root%NPROW * root%NPCOL - 1 + END IF + IF ( root%yes ) THEN + IF ( MUMPS_275( PROCNODE_STEPS(STEP(KEEP(38))), SLAVEF ) + & .NE. MYID_NODES ) THEN + NROOT = NROOT + 1 + END IF + END IF + CALL CMUMPS_251(N,IW,LIW,A,LA,IW1(NSTK),IW1(NBPROCFILS), + & INFO(1),NFSIZ,FILS,STEP,FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & INFO(11), NTOTPV, NMAXNPIV, PTRIST,IW2(PTRAST), + & IW1(PIMASTER), IW2(PAMASTER), PTRAR(1,2), + & PTRAR(1,1), + & ITLOC, RHS_MUMPS, INFO(2), POOL, LPOOL, + & RINFO, POSFAC,IWPOS,LRLU,IPTRLU, + & LRLUS, LEAF, NROOT, NBROOT, + & UULOC,ICNTL,PTLUST_S,PTRFAC,NSTEPS,INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS,SLAVEF,MYID,COMM_NODES, + & MYID_NODES, BUFR,LBUFR, LBUFR_BYTES, + & INTARR, DBLARR, root, SYM_PERM, + & NELT, FRTPTR, FRTELT, LDPTRAR, + & COMM_LOAD, ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, + & MEM_DISTRIB,NE_STEPS, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST) + POSFAC = POSFAC -1_8 + IWPOS = IWPOS -1 + IF (KEEP(201).LE.0) THEN + KEEP8(31) = POSFAC + ENDIF + KEEP(32) = IWPOS + CALL MUMPS_735(KEEP8(31), INFO(9)) + INFO(10) = KEEP(32) + KEEP8(67) = LA - KEEP8(67) + KEEP(89) = NTOTPV + KEEP(246) = NMAXNPIV + INFO(23) = KEEP(89) + CALL MPI_ALLREDUCE(NTOTPV, NTOTPVTOT, 1, MPI_INTEGER, MPI_SUM, + & COMM_NODES, IERR) + IF ( ( (INFO(1).EQ.-10 .OR. INFO(1).EQ.-40) + & .AND. (NTOTPVTOT.EQ.N) ) + & .OR. ( NTOTPVTOT.GT.N ) ) THEN + write(*,*) ' Error 1 in mc51d NTOTPVTOT=', NTOTPVTOT + CALL MUMPS_ABORT() + ENDIF + IF ( (KEEP(19).NE.0 ) .AND. (NTOTPVTOT.NE.N) .AND. + & (INFO(1).GE.0) ) THEN + write(*,*) ' Error 2 in mc51d NTOTPVTOT=', NTOTPVTOT + CALL MUMPS_ABORT() + ENDIF + IF ( (INFO(1) .GE. 0 ) + & .AND. (NTOTPVTOT.NE.N) ) THEN + INFO(1) = -10 + INFO(2) = NTOTPVTOT + ENDIF + IF (PROK) THEN + WRITE (MPRINT,99980) INFO(1), INFO(2), + & KEEP(28), KEEP8(31), INFO(10), INFO(11), INFO(12), + & INFO(13), INFO(14), INFO(25), RINFO(2), RINFO(3) + ENDIF + RETURN +99980 FORMAT (/' LEAVING FACTORIZATION PHASE WITH ...'/ + & ' INFO (1) =',I15/ + & ' --- (2) =',I15/ + & ' NUMBER OF NODES IN THE TREE =',I15/ + & ' INFO (9) REAL SPACE FOR FACTORS =',I15/ + & ' --- (10) INTEGER SPACE FOR FACTORS =',I15/ + & ' --- (11) MAXIMUM SIZE OF FRONTAL MATRICES =',I15/ + & ' --- (12) NUMBER OF OFF DIAGONAL PIVOTS =',I15/ + & ' --- (13) NUMBER OF DELAYED PIVOTS =',I15/ + & ' --- (14) NUMBER OF MEMORY COMPRESSES =',I15/ + & ' --- (25) NUMBER OF ENTRIES IN FACTORS =',I15/ + & ' RINFO(2) OPERATIONS DURING NODE ASSEMBLY =',1PD10.3/ + & ' -----(3) OPERATIONS DURING NODE ELIMINATION =',1PD10.3) +99990 FORMAT(/ ' NUMBER OF MSGS RECVD FOR DYNAMIC LOAD =',I15) + END SUBROUTINE CMUMPS_244 + SUBROUTINE CMUMPS_269( MYID,KEEP,KEEP8, + & BUFR, LBUFR, LBUFR_BYTES, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, + & N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, + & FPERE, FLAG, IFLAG, IERROR, COMM, + & ITLOC, RHS_MUMPS ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER MYID + INTEGER LBUFR, LBUFR_BYTES + INTEGER KEEP(500), BUFR( LBUFR ) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER(8) :: PTRAST (KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP, FPERE + LOGICAL FLAG + INTEGER NSTK_S( KEEP(28) ), ITLOC( N + KEEP(253) ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER IFLAG, IERROR, COMM + INTEGER POSITION, FINODE, FLCONT, LREQ + INTEGER(8) :: LREQCB + INTEGER(8) :: IPOS_NODE, ISHIFT_PACKET + INTEGER SIZE_PACKET + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INCLUDE 'mumps_headers.h' + LOGICAL COMPRESSCB + FLAG = .FALSE. + POSITION = 0 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & FINODE, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & FPERE, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & FLCONT, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, MPI_INTEGER, + & COMM, IERR) + COMPRESSCB = (FLCONT.LT.0) + IF (COMPRESSCB) THEN + FLCONT = -FLCONT + LREQCB = (int(FLCONT,8) * int(FLCONT+1,8)) / 2_8 + ELSE + LREQCB = int(FLCONT,8) * int(FLCONT,8) + ENDIF + IF (NBROWS_ALREADY_SENT == 0) THEN + LREQ = 2 * FLCONT + 6 + KEEP(IXSZ) + IF (IPTRLU.LT.0_8) WRITE(*,*) 'before alloc_cb:IPTRLU = ',IPTRLU + CALL CMUMPS_22( .FALSE., 0_8, .FALSE.,.FALSE., + & MYID,N, KEEP,KEEP8, IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, + & LREQ, LREQCB, FINODE, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF (IPTRLU.LT.0_8) WRITE(*,*) 'after alloc_cb:IPTRLU = ',IPTRLU + IF ( IFLAG .LT. 0 ) RETURN + PIMASTER(STEP( FINODE )) = IWPOSCB + 1 + PAMASTER(STEP( FINODE )) = IPTRLU + 1_8 + IF (COMPRESSCB) IW(IWPOSCB + 1 + XXS ) = S_CB1COMP + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IW(IWPOSCB + 1+KEEP(IXSZ)), LREQ-KEEP(IXSZ), + & MPI_INTEGER, COMM, IERR) + ENDIF + IF (COMPRESSCB) THEN + ISHIFT_PACKET = int(NBROWS_ALREADY_SENT,8) * + & int(NBROWS_ALREADY_SENT+1,8) / 2_8 + SIZE_PACKET = (NBROWS_PACKET * (NBROWS_PACKET+1))/2 + + & NBROWS_ALREADY_SENT * NBROWS_PACKET + ELSE + ISHIFT_PACKET = int(NBROWS_ALREADY_SENT,8) * int(FLCONT,8) + SIZE_PACKET = NBROWS_PACKET * FLCONT + ENDIF + IF (NBROWS_PACKET.NE.0) THEN + IF ( LREQCB .ne. 0_8 ) THEN + IPOS_NODE = PAMASTER(STEP(FINODE))-1_8 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & A(IPOS_NODE + 1_8 + ISHIFT_PACKET), + & SIZE_PACKET, MPI_COMPLEX, COMM, IERR) + END IF + ENDIF + IF (NBROWS_ALREADY_SENT+NBROWS_PACKET == FLCONT) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF ( NSTK_S(STEP(FPERE)).EQ.0 ) THEN + FLAG = . TRUE. + END IF + ENDIF + RETURN + END SUBROUTINE CMUMPS_269 + SUBROUTINE CMUMPS_270( TOT_ROOT_SIZE, + & TOT_CONT_TO_RECV, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND) + USE CMUMPS_LOAD + USE CMUMPS_OOC + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER TOT_ROOT_SIZE, TOT_CONT_TO_RECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA, POSFAC + INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ), ND( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM, COMM_LOAD + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC(N+KEEP(253)), FILS(N), PTRARW(N), PTRAIW(N) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX DBLARR(max(1,KEEP(13))) + INTEGER :: allocok + COMPLEX, DIMENSION(:,:), POINTER :: TMP + INTEGER NEW_LOCAL_M, NEW_LOCAL_N + INTEGER OLD_LOCAL_M, OLD_LOCAL_N + INTEGER I, J + INTEGER LREQI, IROOT + INTEGER(8) :: LREQA + INTEGER POSHEAD, IPOS_SON,IERR + LOGICAL MASTER_OF_ROOT + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INCLUDE 'mumps_headers.h' + INTEGER numroc, MUMPS_275 + EXTERNAL numroc, MUMPS_275 + IROOT = KEEP( 38 ) + root%TOT_ROOT_SIZE = TOT_ROOT_SIZE + MASTER_OF_ROOT = ( MYID .EQ. + & MUMPS_275( PROCNODE_STEPS(STEP(IROOT)), + & SLAVEF ) ) + NEW_LOCAL_M = numroc( TOT_ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + NEW_LOCAL_M = max( 1, NEW_LOCAL_M ) + NEW_LOCAL_N = numroc( TOT_ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + IF ( PTRIST(STEP( IROOT )).GT.0) THEN + OLD_LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) ) + OLD_LOCAL_M = IW( PTRIST(STEP( IROOT )) + 1 + KEEP(IXSZ)) + ELSE + OLD_LOCAL_N = 0 + OLD_LOCAL_M = NEW_LOCAL_M + ENDIF + IF (KEEP(60) .NE. 0) THEN + IF (root%yes) THEN + IF ( NEW_LOCAL_M .NE. root%SCHUR_MLOC .OR. + & NEW_LOCAL_N .NE. root%SCHUR_NLOC ) THEN + WRITE(*,*) "Internal error 1 in CMUMPS_270" + CALL MUMPS_ABORT() + ENDIF + ENDIF + PTLUST_S(STEP(IROOT)) = -4444 + PTRFAC(STEP(IROOT)) = -4445_8 + PTRIST(STEP(IROOT)) = 0 + IF ( MASTER_OF_ROOT ) THEN + LREQI=6+2*TOT_ROOT_SIZE+KEEP(IXSZ) + LREQA=0_8 + IF ( IWPOS + LREQI - 1. GT. IWPOSCB ) THEN + CALL CMUMPS_94( N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB1 compress root2slave:LRLU,LRLUS=', + & LRLU, LRLUS + IFLAG = -9 + CALL MUMPS_731(LREQA-LRLUS, IERROR) + GOTO 700 + END IF + ENDIF + IF ( IWPOS + LREQI - 1. GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + GOTO 700 + ENDIF + PTLUST_S(STEP(IROOT))= IWPOS + IWPOS = IWPOS + LREQI + POSHEAD = PTLUST_S( STEP(IROOT)) + IW( POSHEAD + XXI )=LREQI + CALL MUMPS_730( LREQA, IW(POSHEAD + XXR)) + IW( POSHEAD + XXS )=-9999 + IW( POSHEAD +KEEP(IXSZ)) = 0 + IW( POSHEAD + 1 +KEEP(IXSZ)) = -1 + IW( POSHEAD + 2 +KEEP(IXSZ)) = -1 + IW( POSHEAD + 4 +KEEP(IXSZ)) = STEP(IROOT) + IW( POSHEAD + 5 +KEEP(IXSZ)) = 0 + IW( POSHEAD + 3 +KEEP(IXSZ)) = TOT_ROOT_SIZE + ENDIF + GOTO 100 + ENDIF + IF ( MASTER_OF_ROOT ) THEN + LREQI = 6 + 2 * TOT_ROOT_SIZE+KEEP(IXSZ) + ELSE + LREQI = 6+KEEP(IXSZ) + END IF + LREQA = int(NEW_LOCAL_M, 8) * int(NEW_LOCAL_N, 8) + IF ( LRLU . LT. LREQA .OR. + & IWPOS + LREQI - 1. GT. IWPOSCB )THEN + IF ( LRLUS .LT. LREQA ) THEN + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GOTO 700 + END IF + CALL CMUMPS_94( N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB2 compress root2slave:LRLU,LRLUS=', + & LRLU, LRLUS + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GOTO 700 + END IF + IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + GOTO 700 + END IF + END IF + PTLUST_S(STEP( IROOT )) = IWPOS + IWPOS = IWPOS + LREQI + IF (LREQA.EQ.0_8) THEN + PTRAST (STEP(IROOT)) = max(POSFAC-1_8,1_8) + PTRFAC (STEP(IROOT)) = max(POSFAC-1_8,1_8) + ELSE + PTRAST (STEP(IROOT)) = POSFAC + PTRFAC (STEP(IROOT)) = POSFAC + ENDIF + POSFAC = POSFAC + LREQA + LRLU = LRLU - LREQA + LRLUS = LRLUS - LREQA + KEEP8(67) = min(KEEP8(67), LRLUS) + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU) + POSHEAD = PTLUST_S( STEP(IROOT)) + IW( POSHEAD + XXI ) = LREQI + CALL MUMPS_730( LREQA, IW(POSHEAD + XXR)) + IW( POSHEAD + XXS ) = S_NOTFREE + IW( POSHEAD + KEEP(IXSZ) ) = 0 + IW( POSHEAD + 1 + KEEP(IXSZ) ) = NEW_LOCAL_N + IW( POSHEAD + 2 + KEEP(IXSZ) ) = NEW_LOCAL_M + IW( POSHEAD + 4 + KEEP(IXSZ) ) = STEP(IROOT) + IW( POSHEAD + 5 + KEEP(IXSZ) ) = 0 + IF ( MASTER_OF_ROOT ) THEN + IW( POSHEAD + 3 + KEEP(IXSZ) ) = TOT_ROOT_SIZE + ELSE + IW( POSHEAD + 3 + KEEP(IXSZ) ) = 0 + ENDIF + IF ( KEEP( 50 ) .eq. 0 .OR. KEEP(50) .eq. 2 ) THEN + OPELIW = OPELIW + ( dble(2*TOT_ROOT_SIZE) * + & dble(TOT_ROOT_SIZE) * dble(TOT_ROOT_SIZE ) / dble(3) + & - 0.5d0 * dble( TOT_ROOT_SIZE ) * dble( TOT_ROOT_SIZE ) + & - dble( TOT_ROOT_SIZE ) / dble( 6 ) ) + & / dble( root%NPROW * root%NPCOL ) + ELSE + OPELIW = OPELIW + ( dble(TOT_ROOT_SIZE) * + & dble( TOT_ROOT_SIZE) * + & dble( TOT_ROOT_SIZE + 1 ) ) + & / dble( 3 * root%NPROW * root%NPCOL ) + END IF + IF ( PTRIST(STEP( IROOT )) .LE. 0 ) THEN + PTRIST(STEP( IROOT )) = 0 + PAMASTER(STEP( IROOT )) = 0_8 + IF (LREQA.GT.0_8) A(PTRAST(STEP(IROOT)): + & PTRAST(STEP(IROOT))+LREQA-1_8) = ZERO + ELSE + OLD_LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) ) + OLD_LOCAL_M = IW( PTRIST(STEP( IROOT )) + 1 + KEEP(IXSZ)) + IF ( TOT_ROOT_SIZE .eq. root%ROOT_SIZE ) THEN + IF ( LREQA .NE. int(OLD_LOCAL_M,8) * int(OLD_LOCAL_N,8) ) + & THEN + write(*,*) 'error 1 in PROCESS_ROOT2SLAVE', + & OLD_LOCAL_M, OLD_LOCAL_N + CALL MUMPS_ABORT() + END IF + CALL CMUMPS_756(LREQA, + & A( PAMASTER(STEP(IROOT)) ), + & A( PTRAST (STEP(IROOT)) ) ) + ELSE + CALL CMUMPS_96( A( PTRAST(STEP(IROOT))), + & NEW_LOCAL_M, + & NEW_LOCAL_N, A( PAMASTER( STEP(IROOT)) ), OLD_LOCAL_M, + & OLD_LOCAL_N ) + END IF + IF ( PTRIST( STEP( IROOT ) ) .GT. 0 ) THEN + IPOS_SON= PTRIST( STEP(IROOT)) + CALL CMUMPS_152(.FALSE., MYID, N, IPOS_SON, + & PAMASTER(STEP(IROOT)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + PTRIST(STEP( IROOT )) = 0 + PAMASTER(STEP( IROOT )) = 0_8 + END IF + END IF + IF (NEW_LOCAL_M.GT.OLD_LOCAL_M) THEN + TMP => root%RHS_ROOT + NULLIFY(root%RHS_ROOT) + ALLOCATE (root%RHS_ROOT(NEW_LOCAL_M, root%RHS_NLOC), + & stat=allocok) + IF ( allocok.GT.0) THEN + IFLAG=-13 + IERROR = NEW_LOCAL_M*root%RHS_NLOC + GOTO 700 + ENDIF + DO J = 1, root%RHS_NLOC + DO I = 1, OLD_LOCAL_M + root%RHS_ROOT(I,J)=TMP(I,J) + ENDDO + DO I = OLD_LOCAL_M+1, NEW_LOCAL_M + root%RHS_ROOT(I,J) = ZERO + ENDDO + ENDDO + DEALLOCATE(TMP) + NULLIFY(TMP) + ENDIF + 100 CONTINUE + NBPROCFILS(STEP(IROOT))=NBPROCFILS(STEP(IROOT)) + TOT_CONT_TO_RECV + IF ( NBPROCFILS(STEP(IROOT)) .eq. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + CALL CMUMPS_681(IERR) + ELSE IF (KEEP(201).EQ.2) THEN + CALL CMUMPS_580(IERR) + ENDIF + CALL CMUMPS_507( N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IROOT + N ) + IF (KEEP(47) .GE. 3) THEN + CALL CMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + RETURN + 700 CONTINUE + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE CMUMPS_270 + SUBROUTINE CMUMPS_96 + &( NEW, M_NEW, N_NEW,OLD, M_OLD, N_OLD ) + INTEGER M_NEW, N_NEW, M_OLD, N_OLD + COMPLEX NEW( M_NEW, N_NEW ), OLD( M_OLD, N_OLD ) + INTEGER J + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + DO J = 1, N_OLD + NEW( 1: M_OLD, J ) = OLD( 1: M_OLD, J ) + NEW( M_OLD + 1: M_NEW, J ) = ZERO + END DO + NEW( 1: M_NEW,N_OLD + 1: N_NEW ) = ZERO + RETURN + END SUBROUTINE CMUMPS_96 + INTEGER FUNCTION CMUMPS_505(KEEP,KEEP8) + IMPLICIT NONE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + CMUMPS_505 = KEEP(28) + 1 + 3 + RETURN + END FUNCTION CMUMPS_505 + SUBROUTINE CMUMPS_506(IPOOL, LPOOL, LEAF) + USE CMUMPS_LOAD + IMPLICIT NONE + INTEGER LPOOL, LEAF + INTEGER IPOOL(LPOOL) + IPOOL(LPOOL-2) = 0 + IPOOL(LPOOL-1) = 0 + IPOOL(LPOOL) = LEAF-1 + RETURN + END SUBROUTINE CMUMPS_506 + SUBROUTINE CMUMPS_507 + & (N, POOL, LPOOL, PROCNODE, SLAVEF, + & K28, K76, K80, K47, STEP, INODE) + USE CMUMPS_LOAD + IMPLICIT NONE + INTEGER N, INODE, LPOOL, K28, SLAVEF, K76, K80, K47 + INTEGER STEP(N), POOL(LPOOL), PROCNODE(K28) + EXTERNAL MUMPS_170 + LOGICAL MUMPS_170, ATM_CURRENT_NODE + INTEGER NBINSUBTREE, NBTOP, INODE_EFF,POS_TO_INSERT + INTEGER IPOS1, IPOS2, ISWAP + INTEGER NODE,J,I + ATM_CURRENT_NODE = ( K76 == 2 .OR. K76 ==3 .OR. + & K76==4 .OR. K76==5) + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + IF (INODE > N ) THEN + INODE_EFF = INODE - N + ELSE IF (INODE < 0) THEN + INODE_EFF = - INODE + ELSE + INODE_EFF = INODE + ENDIF + IF(((INODE.GT.0).AND.(INODE.LE.N)).AND.(.NOT. + & MUMPS_170(PROCNODE(STEP(INODE_EFF)), + & SLAVEF)) + & ) THEN + IF ((K80 == 1 .AND. K47 .GE. 1) .OR. + & (( K80 == 2 .OR. K80==3 ) .AND. + & ( K47 == 4 ))) THEN + CALL CMUMPS_514(INODE,1) + ENDIF + ENDIF + IF ( MUMPS_170(PROCNODE(STEP(INODE_EFF)), + & SLAVEF) ) THEN + POOL(NBINSUBTREE + 1 ) = INODE + NBINSUBTREE = NBINSUBTREE + 1 + ELSE + POS_TO_INSERT=NBTOP+1 + IF((K76.EQ.4).OR.(K76.EQ.5))THEN +#if defined(NOT_ATM_POOL_SPECIAL) + J=NBTOP +#else + IF((INODE.GT.N).OR.(INODE.LE.0))THEN + DO J=NBTOP,1,-1 + IF((POOL(LPOOL-2-J).GT.0) + & .AND.(POOL(LPOOL-2-J).LE.N))THEN + GOTO 333 + ENDIF + IF ( POOL(LPOOL-2-J) < 0 ) THEN + NODE=-POOL(LPOOL-2-J) + ELSE IF ( POOL(LPOOL-2-J) > N ) THEN + NODE = POOL(LPOOL-2-J) - N + ELSE + NODE = POOL(LPOOL-2-J) + ENDIF + IF(K76.EQ.4)THEN + IF(DEPTH_FIRST_LOAD(STEP(NODE)).GE. + & DEPTH_FIRST_LOAD(STEP(INODE_EFF)))THEN + GOTO 333 + ENDIF + ENDIF + IF(K76.EQ.5)THEN + IF(COST_TRAV(STEP(NODE)).LE. + & COST_TRAV(STEP(INODE_EFF)))THEN + GOTO 333 + ENDIF + ENDIF + POS_TO_INSERT=POS_TO_INSERT-1 + ENDDO + IF(J.EQ.0) J=1 + 333 CONTINUE + DO I=NBTOP,POS_TO_INSERT,-1 + POOL(LPOOL-2-I-1)=POOL(LPOOL-2-I) + ENDDO + POOL(LPOOL-2-POS_TO_INSERT)=INODE + NBTOP = NBTOP + 1 + GOTO 20 + ENDIF + DO J=NBTOP,1,-1 + IF((POOL(LPOOL-2-J).GT.0).AND.(POOL(LPOOL-2-J).LE.N))THEN + GOTO 888 + ENDIF + POS_TO_INSERT=POS_TO_INSERT-1 + ENDDO + 888 CONTINUE +#endif + DO I=J,1,-1 +#if defined(NOT_ATM_POOL_SPECIAL) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE = POOL(LPOOL-2-I) - N + ELSE + NODE = POOL(LPOOL-2-I) + ENDIF +#else + NODE=POOL(LPOOL-2-I) +#endif + IF(K76.EQ.4)THEN + IF(DEPTH_FIRST_LOAD(STEP(NODE)).GE. + & DEPTH_FIRST_LOAD(STEP(INODE_EFF)))THEN + GOTO 999 + ENDIF + ENDIF + IF(K76.EQ.5)THEN + IF(COST_TRAV(STEP(NODE)).LE. + & COST_TRAV(STEP(INODE_EFF)))THEN + GOTO 999 + ENDIF + ENDIF + POS_TO_INSERT=POS_TO_INSERT-1 + ENDDO + IF(I.EQ.0) I=1 + 999 CONTINUE + DO J=NBTOP,POS_TO_INSERT,-1 + POOL(LPOOL-2-J-1)=POOL(LPOOL-2-J) + ENDDO + POOL(LPOOL-2-POS_TO_INSERT)=INODE + NBTOP = NBTOP + 1 + GOTO 20 + ENDIF + POOL( LPOOL - 2 - ( NBTOP + 1 ) ) = INODE + NBTOP = NBTOP + 1 + IPOS1 = LPOOL - 2 - NBTOP + IPOS2 = LPOOL - 2 - NBTOP + 1 + 10 CONTINUE + IF ( IPOS2 == LPOOL - 2 ) GOTO 20 + IF ( POOL(IPOS1) < 0 ) GOTO 20 + IF ( POOL(IPOS2) < 0 ) GOTO 30 + IF ( ATM_CURRENT_NODE ) THEN + IF ( POOL(IPOS1) > N ) GOTO 20 + IF ( POOL(IPOS2) > N ) GOTO 30 + END IF + GOTO 20 + 30 CONTINUE + ISWAP = POOL(IPOS1) + POOL(IPOS1) = POOL(IPOS2) + POOL(IPOS2) = ISWAP + IPOS1 = IPOS1 + 1 + IPOS2 = IPOS2 + 1 + GOTO 10 + 20 CONTINUE + ENDIF + POOL(LPOOL) = NBINSUBTREE + POOL(LPOOL - 1) = NBTOP + RETURN + END SUBROUTINE CMUMPS_507 + LOGICAL FUNCTION CMUMPS_508(POOL, LPOOL) + IMPLICIT NONE + INTEGER LPOOL + INTEGER POOL(LPOOL) + INTEGER NBINSUBTREE, NBTOP + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + CMUMPS_508 = (NBINSUBTREE + NBTOP == 0) + RETURN + END FUNCTION CMUMPS_508 + SUBROUTINE CMUMPS_509( N, POOL, LPOOL, PROCNODE, SLAVEF, + & STEP, INODE, KEEP,KEEP8, MYID, ND, + & FORCE_EXTRACT_TOP_SBTR ) + USE CMUMPS_LOAD + IMPLICIT NONE + INTEGER INODE, LPOOL, SLAVEF, N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER STEP(N), POOL(LPOOL), PROCNODE(KEEP(28)), + & ND(KEEP(28)) + EXTERNAL MUMPS_167, MUMPS_283, CMUMPS_508 + LOGICAL MUMPS_167, MUMPS_283, CMUMPS_508 + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + INTEGER NBINSUBTREE, NBTOP, INSUBTREE, INODE_EFF, MYID + LOGICAL LEFT, ATOMIC_SUBTREE,UPPER,FLAG_MEM,SBTR_FLAG,PROC_FLAG + LOGICAL FORCE_EXTRACT_TOP_SBTR + INTEGER NODE_TO_EXTRACT,I,J,MIN_PROC +#if defined(POOL_EXTRACT_MNG) + INTEGER POS_TO_EXTRACT +#endif + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + IF ( KEEP(76) > 6 .OR. KEEP(76) < 0 ) THEN + WRITE(*,*) "Error 2 in CMUMPS_509: unknown strategy" + CALL MUMPS_ABORT() + ENDIF + ATOMIC_SUBTREE = ( KEEP(76) == 1 .OR. KEEP(76) == 3) + IF ( CMUMPS_508(POOL, LPOOL) ) THEN + WRITE(*,*) "Error 1 in CMUMPS_509" + CALL MUMPS_ABORT() + ENDIF + IF ( .NOT. ATOMIC_SUBTREE ) THEN + LEFT = (NBTOP == 0) + IF(.NOT.LEFT)THEN + IF((KEEP(76).EQ.4).OR.(KEEP(76).EQ.5))THEN + IF(NBINSUBTREE.EQ.0)THEN + LEFT=.FALSE. + ELSE + IF ( POOL(NBINSUBTREE) < 0 ) THEN + I = -POOL(NBINSUBTREE) + ELSE IF ( POOL(NBINSUBTREE) > N ) THEN + I = POOL(NBINSUBTREE) - N + ELSE + I = POOL(NBINSUBTREE) + ENDIF + IF ( POOL(LPOOL-2-NBTOP) < 0 ) THEN + J = -POOL(LPOOL-2-NBTOP) + ELSE IF ( POOL(LPOOL-2-NBTOP) > N ) THEN + J = POOL(LPOOL-2-NBTOP) - N + ELSE + J = POOL(LPOOL-2-NBTOP) + ENDIF + IF(KEEP(76).EQ.4)THEN + IF(DEPTH_FIRST_LOAD(STEP(J)).GE. + & DEPTH_FIRST_LOAD(STEP(I)))THEN + LEFT=.TRUE. + ELSE + LEFT=.FALSE. + ENDIF + ENDIF + IF(KEEP(76).EQ.5)THEN + IF(COST_TRAV(STEP(J)).LE. + & COST_TRAV(STEP(I)))THEN + LEFT=.TRUE. + ELSE + LEFT=.FALSE. + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + IF ( INSUBTREE == 1 ) THEN + IF (NBINSUBTREE == 0) THEN + WRITE(*,*) "Error 3 in CMUMPS_509" + CALL MUMPS_ABORT() + ENDIF + LEFT = .TRUE. + ELSE + LEFT = ( NBTOP == 0) + ENDIF + ENDIF + 222 CONTINUE + IF ( LEFT ) THEN + INODE = POOL( NBINSUBTREE ) + IF(KEEP(81).EQ.2)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + CALL CMUMPS_561(INODE,POOL,LPOOL,N, + & STEP,KEEP,KEEP8,PROCNODE,SLAVEF,MYID,SBTR_FLAG, + & PROC_FLAG,MIN_PROC) + IF(.NOT.SBTR_FLAG)THEN + WRITE(*,*)MYID,': ca a change pour moi' + LEFT=.FALSE. + GOTO 222 + ENDIF +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ELSEIF(KEEP(81).EQ.3)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + NODE_TO_EXTRACT=INODE + FLAG_MEM=.FALSE. + CALL CMUMPS_820(FLAG_MEM) + IF(FLAG_MEM)THEN + CALL CMUMPS_561(INODE,POOL,LPOOL,N, + & STEP,KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG, + & PROC_FLAG,MIN_PROC) + IF(.NOT.SBTR_FLAG)THEN + LEFT=.FALSE. + WRITE(*,*)MYID,': ca a change pour moi (2)' + GOTO 222 + ENDIF + ENDIF +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF + NBINSUBTREE = NBINSUBTREE - 1 + IF ( INODE < 0 ) THEN + INODE_EFF = -INODE + ELSE IF ( INODE > N ) THEN + INODE_EFF = INODE - N + ELSE + INODE_EFF = INODE + ENDIF + IF ( MUMPS_167( PROCNODE(STEP(INODE_EFF)), SLAVEF) ) THEN + IF((KEEP(47).GE.2.AND.KEEP(81).EQ.1).AND. + & (INSUBTREE.EQ.0))THEN + CALL CMUMPS_513(.TRUE.) + ENDIF + INSUBTREE = 1 + ELSE IF ( MUMPS_283( PROCNODE(STEP(INODE_EFF)), + & SLAVEF)) THEN + IF((KEEP(47).GE.2.AND.KEEP(81).EQ.1).AND. + & (INSUBTREE.EQ.1))THEN + CALL CMUMPS_513(.FALSE.) + ENDIF + INSUBTREE = 0 + END IF + ELSE + IF (NBTOP < 1 ) THEN + WRITE(*,*) "Error 5 in CMUMPS_509", NBTOP + CALL MUMPS_ABORT() + ENDIF + INODE = POOL( LPOOL - 2 - NBTOP ) + IF(KEEP(81).EQ.1)THEN + CALL CMUMPS_520 + & (INODE,UPPER,SLAVEF,KEEP,KEEP8, + & STEP,POOL,LPOOL,PROCNODE,N) + IF(UPPER)THEN + GOTO 666 + ELSE + NBINSUBTREE=NBINSUBTREE-1 + IF ( MUMPS_167( PROCNODE(STEP(INODE)), + & SLAVEF) ) THEN + INSUBTREE = 1 + ELSE IF ( MUMPS_283( PROCNODE(STEP(INODE)), + & SLAVEF)) THEN + INSUBTREE = 0 + ENDIF + GOTO 777 + ENDIF + ENDIF + IF(KEEP(81).EQ.2)THEN + CALL CMUMPS_561(INODE,POOL,LPOOL,N,STEP, + & KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) + IF(SBTR_FLAG)THEN + LEFT=.TRUE. + WRITE(*,*)MYID,': ca a change pour moi (3)' + GOTO 222 + ENDIF + ELSE +#if defined(POOL_EXTRACT_MNG) + IF(KEEP(76).EQ.4)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + POS_TO_EXTRACT=-1 + NODE_TO_EXTRACT=-1 + DO I=NBTOP,1,-1 + IF(NODE_TO_EXTRACT.LT.0)THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ELSE + IF(DEPTH_FIRST_LOAD(STEP(POOL(LPOOL-2-I))).LT. + & DEPTH_FIRST_LOAD(STEP(NODE_TO_EXTRACT))) + & THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ENDIF + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + INODE = NODE_TO_EXTRACT +#else + INODE = INODE_EFF +#endif + DO I=POS_TO_EXTRACT,NBTOP + IF(I.NE.NBTOP)THEN + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF + IF(KEEP(76).EQ.5)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + POS_TO_EXTRACT=-1 + NODE_TO_EXTRACT=-1 + DO I=NBTOP,1,-1 + IF(NODE_TO_EXTRACT.LT.0)THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ELSE + IF(COST_TRAV(STEP(POOL(LPOOL-2-I))).GT. + & COST_TRAV(STEP(NODE_TO_EXTRACT)))THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ENDIF + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + INODE = NODE_TO_EXTRACT +#else + INODE = INODE_EFF +#endif + DO I=POS_TO_EXTRACT,NBTOP + IF(I.NE.NBTOP)THEN + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF +#endif + IF(KEEP(81).EQ.3)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + NODE_TO_EXTRACT=INODE + FLAG_MEM=.FALSE. + CALL CMUMPS_820(FLAG_MEM) + IF(FLAG_MEM)THEN + CALL CMUMPS_561(INODE,POOL,LPOOL,N, + & STEP,KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG, + & PROC_FLAG,MIN_PROC) + IF(SBTR_FLAG)THEN + LEFT=.TRUE. + WRITE(*,*)MYID,': ca a change pour moi (4)' + GOTO 222 + ENDIF + ELSE + CALL CMUMPS_819(INODE) + ENDIF +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF + ENDIF + 666 CONTINUE + NBTOP = NBTOP - 1 + IF((INODE.GT.0).AND.(INODE.LE.N))THEN + IF ((( KEEP(80) == 2 .OR. KEEP(80)==3 ) .AND. + & ( KEEP(47) == 4 ))) THEN + CALL CMUMPS_514(INODE,2) + ENDIF + ENDIF + IF ( INODE < 0 ) THEN + INODE_EFF = -INODE + ELSE IF ( INODE > N ) THEN + INODE_EFF = INODE - N + ELSE + INODE_EFF = INODE + ENDIF + END IF + 777 CONTINUE + POOL(LPOOL) = NBINSUBTREE + POOL(LPOOL - 1) = NBTOP + POOL(LPOOL - 2) = INSUBTREE + RETURN + END SUBROUTINE CMUMPS_509 + SUBROUTINE CMUMPS_552(INODE,POOL,LPOOL,N,STEP, + & KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR,FLAG_SAME_PROC,MIN_PROC) + USE CMUMPS_LOAD + IMPLICIT NONE + INTEGER INODE,LPOOL,N,MYID,SLAVEF,PROC,MIN_PROC + INTEGER POOL(LPOOL),KEEP(500),STEP(N),PROCNODE(KEEP(28)) + INTEGER(8) KEEP8(150) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + LOGICAL SBTR,FLAG_SAME_PROC + INTEGER POS_TO_EXTRACT,NODE_TO_EXTRACT,NBTOP,I,INSUBTREE, + & NBINSUBTREE + DOUBLE PRECISION MIN_COST, TMP_COST + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + MIN_COST=huge(MIN_COST) + TMP_COST=huge(TMP_COST) + FLAG_SAME_PROC=.FALSE. + SBTR=.FALSE. + MIN_PROC=-9999 +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GT.0).AND.(INODE.LE.N))THEN +#endif + POS_TO_EXTRACT=-1 + NODE_TO_EXTRACT=-1 + DO I=NBTOP,1,-1 + IF(NODE_TO_EXTRACT.LT.0)THEN + POS_TO_EXTRACT=I + NODE_TO_EXTRACT=POOL(LPOOL-2-I) + CALL CMUMPS_818(NODE_TO_EXTRACT, + & TMP_COST,PROC) + MIN_COST=TMP_COST + MIN_PROC=PROC + ELSE + CALL CMUMPS_818(POOL(LPOOL-2-I), + & TMP_COST,PROC) + IF((PROC.NE.MIN_PROC).OR.(TMP_COST.NE.MIN_COST))THEN + FLAG_SAME_PROC=.TRUE. + ENDIF + IF(TMP_COST.GT.MIN_COST)THEN + POS_TO_EXTRACT=I + NODE_TO_EXTRACT=POOL(LPOOL-2-I) + MIN_COST=TMP_COST + MIN_PROC=PROC + ENDIF + ENDIF + ENDDO + IF((KEEP(47).EQ.4).AND.(NBINSUBTREE.NE.0))THEN + CALL CMUMPS_554(NBINSUBTREE,INSUBTREE,NBTOP, + & MIN_COST,SBTR) + IF(SBTR)THEN + WRITE(*,*)MYID,': selecting from subtree' + RETURN + ENDIF + ENDIF + IF((.NOT.SBTR).AND.(.NOT.FLAG_SAME_PROC))THEN + WRITE(*,*)MYID,': I must search for a task + & to save My friend' + RETURN + ENDIF + INODE = NODE_TO_EXTRACT + DO I=POS_TO_EXTRACT,NBTOP + IF(I.NE.NBTOP)THEN + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDIF + ENDDO + POOL(LPOOL-2-NBTOP)=INODE + CALL CMUMPS_819(INODE) +#if ! defined(NOT_ATM_POOL_SPECIAL) + ELSE + ENDIF +#endif + END SUBROUTINE CMUMPS_552 + SUBROUTINE CMUMPS_561(INODE,POOL,LPOOL,N,STEP, + & KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) + USE CMUMPS_LOAD + IMPLICIT NONE + INTEGER INODE,LPOOL,N,SLAVEF,MYID,MIN_PROC + INTEGER POOL(LPOOL),KEEP(500),PROCNODE(KEEP(28)),STEP(N) + INTEGER(8) KEEP8(150) + LOGICAL SBTR_FLAG,PROC_FLAG + EXTERNAL MUMPS_167 + LOGICAL MUMPS_167 + INTEGER NODE_TO_EXTRACT,I,POS_TO_EXTRACT,NBTOP,NBINSUBTREE + NBTOP= POOL(LPOOL - 1) + NBINSUBTREE = POOL(LPOOL) + IF(NBTOP.GT.0)THEN + WRITE(*,*)MYID,': NBTOP=',NBTOP + ENDIF + SBTR_FLAG=.FALSE. + PROC_FLAG=.FALSE. + CALL CMUMPS_552(INODE,POOL,LPOOL,N,STEP,KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) + IF(SBTR_FLAG)THEN + RETURN + ENDIF + IF(MIN_PROC.EQ.-9999)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GT.0).AND.(INODE.LT.N))THEN +#endif + SBTR_FLAG=(NBINSUBTREE.NE.0) +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + RETURN + ENDIF + IF(.NOT.PROC_FLAG)THEN + NODE_TO_EXTRACT=INODE + IF((INODE.GE.0).AND.(INODE.LE.N))THEN + CALL CMUMPS_553(MIN_PROC,POOL, + & LPOOL,INODE) + IF(MUMPS_167(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + WRITE(*,*)MYID,': Extracting from a subtree + & for helping',MIN_PROC + SBTR_FLAG=.TRUE. + RETURN + ELSE + IF(NODE_TO_EXTRACT.NE.INODE)THEN + WRITE(*,*)MYID,': Extracting from top + & inode=',INODE,'for helping',MIN_PROC + ENDIF + CALL CMUMPS_819(INODE) + ENDIF + ENDIF + DO I=1,NBTOP + IF (POOL(LPOOL-2-I).EQ.INODE)THEN + GOTO 452 + ENDIF + ENDDO + 452 CONTINUE + POS_TO_EXTRACT=I + DO I=POS_TO_EXTRACT,NBTOP-1 + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDDO + POOL(LPOOL-2-NBTOP)=INODE + ENDIF + END SUBROUTINE CMUMPS_561 + SUBROUTINE CMUMPS_574 + & ( IPOOL, LPOOL, III, LEAF, + & INODE, STRATEGIE ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: STRATEGIE, LPOOL + INTEGER IPOOL (LPOOL) + INTEGER III,LEAF + INTEGER, INTENT(OUT) :: INODE + LEAF = LEAF - 1 + INODE = IPOOL( LEAF ) + RETURN + END SUBROUTINE CMUMPS_574 + SUBROUTINE CMUMPS_128(N, NELT, ELTPTR, ELTVAR, LIW, + & IKEEP, PTRAR, + & IORD, NFSIZ, FILS, FRERE, + & LISTVAR_SCHUR, SIZE_SCHUR, + & ICNTL, INFO, KEEP,KEEP8, + & ELTNOD, NSLAVES, + & XNODEL, NODEL) + IMPLICIT NONE + INTEGER N,NELT,LIW,IORD, SIZE_SCHUR, NSLAVES + INTEGER PTRAR(N,3), NFSIZ(N), FILS(N), FRERE(N) + INTEGER ELTPTR(NELT+1) + INTEGER XNODEL(N+1), NODEL(ELTPTR(NELT+1)-1) + INTEGER ELTVAR(ELTPTR(NELT+1)-1) + INTEGER IKEEP(N,3) + INTEGER LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER INFO(40), ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER ELTNOD(NELT) + INTEGER K,I,L1,L2,IWFR,NCMPA,LLIW,IFSON,IN + INTEGER NEMIN, MPRINT, LP, MP, LDIAG + INTEGER NZ, allocok, ITEMP + LOGICAL PROK, NOSUPERVAR + INTEGER(8) :: K79REF + PARAMETER(K79REF=12000000_8) + LOGICAL SPLITROOT + INTEGER, DIMENSION(:), ALLOCATABLE :: IW + INTEGER, DIMENSION(:), ALLOCATABLE :: IW2 + INTEGER OPT_METIS_SIZE, NUMFLAG + PARAMETER(OPT_METIS_SIZE = 8, NUMFLAG = 1) + INTEGER OPTIONS_METIS(OPT_METIS_SIZE) + INTEGER IDUM + EXTERNAL MUMPS_197, CMUMPS_130, CMUMPS_131, + & CMUMPS_129, CMUMPS_132, + & CMUMPS_133, CMUMPS_134, + & CMUMPS_199, + & CMUMPS_557, CMUMPS_201 +#if defined(OLDDFS) + EXTERNAL CMUMPS_200 +#endif + ALLOCATE( IW ( LIW ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = LIW + RETURN + ENDIF + MPRINT= ICNTL(3) + PROK = (MPRINT.GT.0) + LP = ICNTL(1) + MP = ICNTL(3) + LDIAG = ICNTL(4) + IF (KEEP(60).NE.0) THEN + NOSUPERVAR=.TRUE. + IF (IORD.GT.1) IORD = 0 + ELSE + NOSUPERVAR=.FALSE. + ENDIF + IF (IORD == 7) THEN + IF ( N < 10000 ) THEN + IORD = 0 + ELSE +#if defined(metis) || defined(parmetis) + IORD = 5 +#else + IORD = 0 +#endif + ENDIF + END IF +#if ! defined(metis) && ! defined(parmetis) + IF (IORD == 5) IORD = 0 +#endif + IF (KEEP(1).LT.1) KEEP(1) = 1 + NEMIN = KEEP(1) + IF (LDIAG.LE.2 .OR. MP.LE.0) GO TO 10 + WRITE (MP,99999) N, NELT, LIW, INFO(1) + K = min0(10,NELT+1) + IF (LDIAG.EQ.4) K = NELT+1 + IF (K.GT.0) WRITE (MP,99998) (ELTPTR(I),I=1,K) + K = min0(10,ELTPTR(NELT+1)-1) + IF (LDIAG.EQ.4) K = ELTPTR(NELT+1)-1 + IF (K.GT.0) WRITE (MP,99995) (ELTVAR(I),I=1,K) + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (IORD.EQ.1 .AND. K.GT.0) THEN + WRITE (MP,99997) (IKEEP(I,1),I=1,K) + ENDIF + 10 L1 = 1 + L2 = L1 + N + IF (LIW .LT. 3*N) THEN + INFO(1)= -2002 + INFO(2) = LIW + ENDIF +#if defined(metis) || defined(parmetis) + IF ( IORD == 5 ) THEN + IF (LIW .LT. N+N+1) THEN + INFO(1)= -2002 + INFO(2) = LIW + RETURN + ENDIF + ELSE +#endif + IF (NOSUPERVAR) THEN + IF ( LIW .LT. 2*N ) THEN + INFO(1)= -2002 + INFO(2) = LIW + RETURN + END IF + ELSE + IF ( LIW .LT. 4*N+4 ) THEN + INFO(1)= -2002 + INFO(2) = LIW + RETURN + END IF + ENDIF +#if defined(metis) || defined(parmetis) + ENDIF +#endif + IDUM=0 + CALL CMUMPS_258(NELT, N, ELTPTR(NELT+1)-1, ELTPTR, ELTVAR, + & XNODEL, NODEL, IW(L1), IDUM, ICNTL) + IF (IORD.NE.1 .AND. IORD .NE. 5) THEN + IORD = 0 + IF (NOSUPERVAR) THEN + CALL CMUMPS_129(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & PTRAR(1,2), IW(L1)) + ELSE + CALL CMUMPS_130(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & PTRAR(1,2), 4*N+4, IW(L1)) + ENDIF + LLIW = max(NZ,N) + ALLOCATE( IW2(LLIW), stat = allocok ) + IF (allocok.GT.0) THEN + INFO(1) = -7 + INFO(2) = LLIW + RETURN + ENDIF + IF (NOSUPERVAR) THEN + CALL CMUMPS_132(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IW2, LLIW, PTRAR, PTRAR(1,2), + & IW(L1), IWFR) + ELSE + CALL CMUMPS_131(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IW2, LLIW, PTRAR, PTRAR(1,2), + & IW(L1), IWFR) + ENDIF + IF (NOSUPERVAR) THEN + CALL MUMPS_162(N, LLIW, PTRAR, IWFR, PTRAR(1,2), IW2, + & IW(L1), IKEEP, + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), IW(L2), PTRAR(1,3), + & LISTVAR_SCHUR, SIZE_SCHUR) + IF (KEEP(60) == 1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSEIF (KEEP(60) == 2 .OR. KEEP(60) == 3 ) THEN + KEEP(38) = LISTVAR_SCHUR(1) + ELSE + WRITE(*,*) "Internal error in CMUMPS_128",KEEP(60) + CALL MUMPS_ABORT() + ENDIF + ELSE + CALL MUMPS_23(N, LLIW, PTRAR, IWFR, PTRAR(1,2), IW2, + & IW(L1), IKEEP, + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), IW(L2), PTRAR(1,3)) + ENDIF + ELSE +#if defined(metis) || defined(parmetis) + IF (IORD.EQ.5) THEN + IF (PROK) THEN + WRITE(MPRINT,'(A)') ' Ordering based on METIS ' + ENDIF + CALL CMUMPS_129(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & PTRAR(1,2), IW(L1)) + LLIW = max(NZ,N) + ALLOCATE( IW2(LLIW), stat = allocok ) + IF (allocok.GT.0) THEN + INFO(1) = -7 + INFO(2) = LLIW + RETURN + ENDIF + CALL CMUMPS_538(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IW2, LLIW, IW(L2), PTRAR(1,2), + & IW(L1), IWFR) + OPTIONS_METIS(1) = 0 + CALL METIS_NODEND(N, IW(L2), IW2(1), NUMFLAG, OPTIONS_METIS, + & IKEEP(1,2), IKEEP(1,1) ) + DEALLOCATE(IW2) + ELSE IF (IORD.NE.1) THEN + WRITE(*,*) IORD + WRITE(*,*) 'bad option for ordering' + CALL MUMPS_ABORT() + ENDIF +#endif + DO K=1,N + IW(L1+K) = 0 + ENDDO + DO K=1,N + IF ((IKEEP(K,1).LE.0).OR.(IKEEP(K,1).GT.N)) + & GO TO 40 + IF (IW(L1+IKEEP(K,1)).EQ.1) THEN + GOTO 40 + ELSE + IW(L1+IKEEP(K,1)) = 1 + ENDIF + ENDDO + CALL CMUMPS_133(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IKEEP, PTRAR(1,2), IW(L1)) + LLIW = NZ+N + ALLOCATE( IW2(LLIW), stat = allocok ) + IF (allocok.GT.0) THEN + INFO(1) = -7 + INFO(2) = LLIW + RETURN + ENDIF + CALL CMUMPS_134(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IKEEP, IW2, LLIW, PTRAR, PTRAR(1,2), + & IW(L1), IWFR) + IF (KEEP(60) == 0) THEN + ITEMP = 0 + ELSE + ITEMP = SIZE_SCHUR + IF (KEEP(60) == 1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSEIF (KEEP(60) == 2 .OR. KEEP(60) == 3 ) THEN + KEEP(38) = LISTVAR_SCHUR(1) + ELSE + WRITE(*,*) "Internal error in CMUMPS_128",KEEP(60) + CALL MUMPS_ABORT() + ENDIF + ENDIF + CALL CMUMPS_199(N, PTRAR, IW2, LLIW, IWFR, IKEEP, + & IKEEP(1,2), IW(L1), + & IW(L2), NCMPA, ITEMP) + ENDIF +#if defined(OLDDFS) + CALL CMUMPS_200(N, PTRAR, IW(L1), IKEEP, IKEEP(1,2), + & IKEEP(1,3), + & NFSIZ, INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, KEEP(60)) +#else + CALL CMUMPS_557(N, PTRAR, IW(L1), IKEEP, IKEEP(1,2), + & IKEEP(1,3), + & NFSIZ, PTRAR(1,2), + & INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, + & IW(L2), KEEP(60), KEEP(20), KEEP(38), + & IW2,KEEP(104),IW(L2+N),KEEP(50), + & ICNTL(13), KEEP(37), NSLAVES, KEEP(250).EQ.1) +#endif + DEALLOCATE(IW2) + IF (KEEP(60).NE.0) THEN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO WHILE (IN.GT.0) + IN = FILS (IN) + END DO + IFSON = -IN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO I=2,SIZE_SCHUR + FILS(IN) = LISTVAR_SCHUR (I) + IN = FILS(IN) + FRERE (IN) = N+1 + ENDDO + FILS(IN) = -IFSON + ENDIF + CALL CMUMPS_201(IKEEP(1,2), + & PTRAR(1,3), INFO(6), + & INFO(5), KEEP(2),KEEP(50), + & KEEP(101), KEEP(108),KEEP(5), + & KEEP(6), KEEP(226), KEEP(253)) + IF ( KEEP(53) .NE. 0 ) THEN + CALL MUMPS_209( N, FRERE, FILS, NFSIZ, KEEP(20) ) + END IF + IF ( KEEP(48) == 4 .OR. + & ( (KEEP(24).NE.0).AND.(KEEP8(21).GT.0_8) ) ) THEN + CALL CMUMPS_510(KEEP8(21), KEEP(2), + & KEEP(48), KEEP(50), NSLAVES) + END IF + IF (KEEP(210).LT.0.OR.KEEP(210).GT.2) KEEP(210)=0 + IF (KEEP(210).EQ.0.AND.KEEP(201).GT.0) KEEP(210)=1 + IF (KEEP(210).EQ.0.AND.KEEP(201).EQ.0) KEEP(210)=2 + IF (KEEP(210).EQ.2) KEEP8(79)=huge(KEEP8(79)) + IF (KEEP(210).EQ.1.AND.KEEP8(79).LE.0_8) THEN + IF ( huge(KEEP8(79)) / K79REF + 1_8 .GE. int(NSLAVES,8) ) THEN + KEEP8(79)=huge(KEEP8(79)) + ELSE + KEEP8(79)=K79REF * int(NSLAVES,8) + ENDIF + ENDIF + IF (KEEP(79).EQ.0) THEN + IF (KEEP(210).EQ.1) THEN + SPLITROOT = .FALSE. + IF ( KEEP(62).GE.1) THEN + CALL CMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG, INFO(1), INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + ENDIF + ENDIF + SPLITROOT = ((ICNTL(13).GT.0) .AND. (NSLAVES.GE.ICNTL(13))) + IF (SPLITROOT) THEN + CALL CMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG, INFO(1), INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (K.GT.0) WRITE (MP,99997) (IKEEP(I,1),I=1,K) + IF (K.GT.0) WRITE (MP,99991) (IKEEP(I,2),I=1,K) + IF (K.GT.0) WRITE (MP,99990) (IKEEP(I,3),I=1,K) + IF (K.GT.0) WRITE (MP,99987) (NFSIZ(I),I=1,K) + IF (K.GT.0) WRITE (MP,99989) (FILS(I),I=1,K) + IF (K.GT.0) WRITE (MP,99988) (FRERE(I),I=1,K) + ENDIF + GO TO 90 + 40 INFO(1) = -4 + INFO(2) = K + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99996) INFO(1) + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99982) INFO(2) + 90 CONTINUE + DEALLOCATE(IW) + RETURN +99999 FORMAT (/'Entering analysis phase with ...'/ + & ' N NELT LIW INFO(1)'/, + & 9X, I8, I11, I12, I14) +99998 FORMAT ('Element pointers: ELTPTR() '/(9X, 7I10)) +99995 FORMAT ('Element variables: ELTVAR() '/(9X, 7I10)) +99997 FORMAT ('IKEEP(.,1)=', 10I6/(12X, 10I6)) +99996 FORMAT (/'** Error return ** from Analysis * INFO(1)=', I3) +99991 FORMAT ('IKEEP(.,2)=', 10I6/(12X, 10I6)) +99990 FORMAT ('IKEEP(.,3)=', 10I6/(12X, 10I6)) +99989 FORMAT ('FILS (.) =', 10I6/(12X, 10I6)) +99988 FORMAT ('FRERE(.) =', 10I6/(12X, 10I6)) +99987 FORMAT ('NFSIZ(.) =', 10I6/(12X, 10I6)) +99982 FORMAT ('Error in permutation array KEEP INFO(2)=', I3) + END SUBROUTINE CMUMPS_128 + SUBROUTINE CMUMPS_258( NELT, N, NELNOD, XELNOD, ELNOD, + & XNODEL, NODEL, FLAG, IERROR, ICNTL ) + IMPLICIT NONE + INTEGER NELT, N, NELNOD, IERROR, ICNTL(40) + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & FLAG(N) + INTEGER I, J, K, MP, NBERR + MP = ICNTL(2) + FLAG(1:N) = 0 + XNODEL(1:N) = 0 + IERROR = 0 + DO I = 1, NELT + DO K = XELNOD(I), XELNOD(I+1)-1 + J = ELNOD(K) + IF ( J.LT.1 .OR. J.GT.N ) THEN + IERROR = IERROR + 1 + ELSE + IF ( FLAG(J).NE.I ) THEN + XNODEL(J) = XNODEL(J) + 1 + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + IF ( IERROR.GT.0 .AND. MP.GT.0 .AND. ICNTL(4).GE.2 ) THEN + NBERR = 0 + WRITE(MP,99999) + DO I = 1, NELT + DO K = XELNOD(I), XELNOD(I+1)-1 + J = ELNOD(K) + IF ( J.LT.1 .OR. J.GT.N ) THEN + NBERR = NBERR + 1 + IF (NBERR.LE.10) THEN + WRITE(MP,'(A,I8,A,I8,A)') + & 'Element ',I,' variable ',J,' ignored.' + ELSE + GO TO 100 + ENDIF + ENDIF + ENDDO + ENDDO + ENDIF + 100 CONTINUE + K = 1 + DO I = 1, N + K = K + XNODEL(I) + XNODEL(I) = K + ENDDO + XNODEL(N+1) = XNODEL(N) + FLAG(1:N) = 0 + DO I = 1, NELT + DO K = XELNOD(I), XELNOD(I+1)-1 + J = ELNOD(K) + IF (FLAG(J).NE.I) THEN + XNODEL(J) = XNODEL(J) - 1 + NODEL(XNODEL(J)) = I + FLAG(J) = I + ENDIF + ENDDO + ENDDO + RETURN +99999 FORMAT (/'*** Warning message from subroutine CMUMPS_258 ***') + END SUBROUTINE CMUMPS_258 + SUBROUTINE CMUMPS_129(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & LEN, FLAG) + IMPLICIT NONE + INTEGER N, NELT, NELNOD, NZ + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & FLAG(N) + INTEGER I,J,K1,K2,K3 + FLAG(1:N) = 0 + LEN(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.LT.J) .AND. (FLAG(J).NE.I)) THEN + LEN(I) = LEN(I) + 1 + LEN(J) = LEN(J) + 1 + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + NZ = 0 + DO I = 1,N + NZ = NZ + LEN(I) + ENDDO + RETURN + END SUBROUTINE CMUMPS_129 + SUBROUTINE CMUMPS_538(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER LEN(N) + INTEGER IPE(N+1) + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW), FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 1 + DO I = 1,N + IWFR = IWFR + LEN(I) + IPE(I) = IWFR + ENDDO + IPE(N+1)=IPE(N) + FLAG(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.LT.J) .AND. (FLAG(J).NE.I)) THEN + IPE(I) = IPE(I) - 1 + IW(IPE(I)) = J + IPE(J) = IPE(J) - 1 + IW(IPE(J)) = I + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE CMUMPS_538 + SUBROUTINE CMUMPS_132(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER LEN(N) + INTEGER IPE(N) + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW), FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 1 + DO I = 1,N + IWFR = IWFR + LEN(I) + IF (LEN(I).GT.0) THEN + IPE(I) = IWFR + ELSE + IPE(I) = 0 + ENDIF + ENDDO + FLAG(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.LT.J) .AND. (FLAG(J).NE.I)) THEN + IPE(I) = IPE(I) - 1 + IW(IPE(I)) = J + IPE(J) = IPE(J) - 1 + IW(IPE(J)) = I + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE CMUMPS_132 + SUBROUTINE CMUMPS_133(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & PERM, LEN, FLAG) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER PERM(N) + INTEGER LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), FLAG(N) + INTEGER I,J,K1,K2,K3 + FLAG(1:N) = 0 + LEN(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I),XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2),XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.NE.J) .AND. (FLAG(J).NE.I)) THEN + IF (PERM(J).GT.PERM(I)) THEN + LEN(I) = LEN(I) + 1 + FLAG(J) = I + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + NZ = 0 + DO I = 1,N + NZ = NZ + LEN(I) + ENDDO + RETURN + END SUBROUTINE CMUMPS_133 + SUBROUTINE CMUMPS_134(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & PERM, IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER PERM(N) + INTEGER IPE(N), LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), IW(LW), + & FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 0 + DO I = 1,N + IWFR = IWFR + LEN(I) + 1 + IPE(I) = IWFR + ENDDO + IWFR = IWFR + 1 + FLAG(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I),XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2),XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.NE.J) .AND. (FLAG(J).NE.I)) THEN + IF (PERM(J).GT.PERM(I)) THEN + IW(IPE(I)) = J + IPE(I) = IPE(I) - 1 + FLAG(J) = I + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + DO I = 1,N + J = IPE(I) + IW(J) = LEN(I) + IF (LEN(I).EQ.0) IPE(I) = 0 + ENDDO + RETURN + END SUBROUTINE CMUMPS_134 + SUBROUTINE CMUMPS_25( MYID, SLAVEF, N, + & PROCNODE, STEP, PTRAIW, PTRARW, + & NELT, FRTPTR, FRTELT, + & KEEP,KEEP8, ICNTL, SYM ) + IMPLICIT NONE + INTEGER MYID, SLAVEF, N, NELT, SYM + INTEGER KEEP( 500 ), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER PTRAIW( NELT+1 ), PTRARW( NELT+1 ) + INTEGER STEP( N ) + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER PROCNODE( KEEP(28) ) + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER ELT, I, K, IPTRI, IPTRR, NVAR + INTEGER TYPE_PARALL, ITYPE, IRANK + TYPE_PARALL = KEEP(46) + PTRAIW( 1:NELT ) = 0 + DO I = 1, N + IF (STEP(I).LT.0) CYCLE + ITYPE = MUMPS_330( PROCNODE(abs(STEP(I))), SLAVEF ) + IRANK = MUMPS_275( PROCNODE(abs(STEP(I))), SLAVEF ) + IF ( TYPE_PARALL .eq. 0 ) THEN + IRANK = IRANK + 1 + END IF + IF ( (ITYPE .EQ. 2) .OR. + & (ITYPE .EQ. 1 .AND. IRANK .EQ. MYID) ) THEN + DO K = FRTPTR(I),FRTPTR(I+1)-1 + ELT = FRTELT(K) + PTRAIW( ELT ) = PTRARW(ELT+1) - PTRARW(ELT) + ENDDO + ELSE + END IF + END DO + IPTRI = 1 + DO ELT = 1,NELT + NVAR = PTRAIW( ELT ) + PTRAIW( ELT ) = IPTRI + IPTRI = IPTRI + NVAR + ENDDO + PTRAIW( NELT+1 ) = IPTRI + KEEP( 14 ) = IPTRI - 1 + IF ( .TRUE. ) THEN + IF (SYM .EQ. 0) THEN + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRAIW( ELT+1 ) - PTRAIW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + NVAR*NVAR + ENDDO + PTRARW( NELT+1 ) = IPTRR + ELSE + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRAIW( ELT+1 ) - PTRAIW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + (NVAR*(NVAR+1))/2 + ENDDO + PTRARW( NELT+1 ) = IPTRR + ENDIF + ELSE + IF (SYM .EQ. 0) THEN + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRARW( ELT+1 ) - PTRARW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + NVAR*NVAR + ENDDO + PTRARW( NELT+1 ) = IPTRR + ELSE + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRARW( ELT+1 ) - PTRARW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + (NVAR*(NVAR+1))/2 + ENDDO + PTRARW( NELT+1 ) = IPTRR + ENDIF + ENDIF + KEEP( 13 ) = IPTRR - 1 + RETURN + END SUBROUTINE CMUMPS_25 + SUBROUTINE CMUMPS_120( N, NELT, ELTPROC, SLAVEF, PROCNODE ) + IMPLICIT NONE + INTEGER N, NELT, SLAVEF + INTEGER PROCNODE( N ), ELTPROC( NELT ) + INTEGER ELT, I, ITYPE, MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + DO ELT = 1, NELT + I = ELTPROC(ELT) + IF ( I .NE. 0) THEN + ITYPE = MUMPS_330(PROCNODE(I),SLAVEF) + IF (ITYPE.EQ.1) THEN + ELTPROC(ELT) = MUMPS_275(PROCNODE(I),SLAVEF) + ELSE IF (ITYPE.EQ.2) THEN + ELTPROC(ELT) = -1 + ELSE + ELTPROC(ELT) = -2 + ENDIF + ELSE + ELTPROC(ELT) = -3 + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_120 + SUBROUTINE CMUMPS_153(N, NELT, NELNOD, FRERE, FILS, NA, NE, + & XNODEL, NODEL, FRTPTR, FRTELT, ELTNOD) + IMPLICIT NONE + INTEGER N, NELT, NELNOD + INTEGER FRERE(N), FILS(N), NA(N), NE(N) + INTEGER FRTPTR(N+1), FRTELT(NELT), ELTNOD(NELT) + INTEGER XNODEL(N+1), NODEL(NELNOD) + INTEGER TNSTK( N ), IPOOL( N ) + INTEGER I, K, IFATH + INTEGER INODE, LEAF, NBLEAF, NBROOT, III, IN + TNSTK = NE + LEAF = 1 + IF (N.EQ.1) THEN + NBROOT = 1 + NBLEAF = 1 + IPOOL(1) = 1 + LEAF = LEAF + 1 + ELSEIF (NA(N).LT.0) THEN + NBLEAF = N + NBROOT = N + DO 20 I=1,NBLEAF-1 + INODE = NA(I) + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + 20 CONTINUE + INODE = -NA(N)-1 + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + ELSEIF (NA(N-1).LT.0) THEN + NBLEAF = N-1 + NBROOT = NA(N) + IF (NBLEAF-1.GT.0) THEN + DO 30 I=1,NBLEAF-1 + INODE = NA(I) + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + 30 CONTINUE + ENDIF + INODE = -NA(N-1)-1 + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + ELSE + NBLEAF = NA(N-1) + NBROOT = NA(N) + DO 40 I = 1,NBLEAF + INODE = NA(I) + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + 40 CONTINUE + ENDIF + ELTNOD(1:NELT) = 0 + III = 1 + 90 CONTINUE + IF (III.NE.LEAF) THEN + INODE=IPOOL(III) + III = III + 1 + ELSE + WRITE(6,*) ' ERROR 1 in file CMUMPS_153 ' + CALL MUMPS_ABORT() + ENDIF + 95 CONTINUE + IN = INODE + 100 CONTINUE + DO K = XNODEL(IN),XNODEL(IN+1)-1 + I = NODEL(K) + IF (ELTNOD(I).EQ.0) ELTNOD(I) = INODE + ENDDO + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 100 + IN = INODE + 110 IN = FRERE(IN) + IF (IN.GT.0) GO TO 110 + IF (IN.EQ.0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 115 + GOTO 90 + ELSE + IFATH = -IN + ENDIF + TNSTK(IFATH) = TNSTK(IFATH) - 1 + IF ( TNSTK(IFATH) .EQ. 0 ) THEN + INODE = IFATH + GOTO 95 + ELSE + GOTO 90 + ENDIF + 115 CONTINUE + FRTPTR(1:N) = 0 + DO I = 1,NELT + IF (ELTNOD(I) .NE. 0) THEN + FRTPTR(ELTNOD(I)) = FRTPTR(ELTNOD(I)) + 1 + ENDIF + ENDDO + K = 1 + DO I = 1,N + K = K + FRTPTR(I) + FRTPTR(I) = K + ENDDO + FRTPTR(N+1) = FRTPTR(N) + DO K = 1,NELT + INODE = ELTNOD(K) + IF (INODE .NE. 0) THEN + FRTPTR(INODE) = FRTPTR(INODE) - 1 + FRTELT(FRTPTR(INODE)) = K + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_153 + SUBROUTINE CMUMPS_130(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & LEN, LW, IW) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW) + INTEGER I,J,K1,K2,K3,LP,NSUP,SUPVAR + INTEGER INFO44(6) + EXTERNAL CMUMPS_315 + LP = 6 + CALL CMUMPS_315(N,NELT,XELNOD(NELT+1)-1,ELNOD,XELNOD, + & NSUP,IW(3*N+3+1),3*N+3,IW,LP,INFO44) + IF (INFO44(1) .LT. 0) THEN + IF (LP.GE.0) WRITE(LP,*) + & 'Error return from CMUMPS_315. INFO(1) = ',INFO44(1) + ENDIF + IW(1:NSUP) = 0 + LEN(1:N) = 0 + DO I = 1,N + SUPVAR = IW(3*N+3+1+I) + IF (SUPVAR .EQ. 0) CYCLE + IF (IW(SUPVAR).NE.0) THEN + LEN(I) = -IW(SUPVAR) + ELSE + IW(SUPVAR) = I + ENDIF + ENDDO + IW(N+1:2*N) = 0 + NZ = 0 + DO SUPVAR = 1,NSUP + I = IW(SUPVAR) + DO K1 = XNODEL(I),XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2),XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF (LEN(J).GE.0) THEN + IF ((I.NE.J) .AND. (IW(N+J).NE.I)) THEN + IW(N+J) = I + LEN(I) = LEN(I) + 1 + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + NZ = NZ + LEN(I) + ENDDO + RETURN + END SUBROUTINE CMUMPS_130 + SUBROUTINE CMUMPS_131(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER LEN(N) + INTEGER IPE(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW), FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 1 + DO I = 1,N + IF (LEN(I).GT.0) THEN + IWFR = IWFR + LEN(I) + IPE(I) = IWFR + ELSE + IPE(I) = 0 + ENDIF + ENDDO + FLAG(1:N) = 0 + DO I = 1,N + IF (LEN(I).LE.0) CYCLE + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF (LEN(J) .GT. 0) THEN + IF ((I.NE.J) .AND. (FLAG(J).NE.I)) THEN + IPE(I) = IPE(I) - 1 + IW(IPE(I)) = J + FLAG(J) = I + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE CMUMPS_131 + SUBROUTINE CMUMPS_315(N,NELT,NZ,ELTVAR,ELTPTR,NSUP,SVAR, + & LIW,IW,LP,INFO) + INTEGER LIW,LP,N,NELT,NSUP,NZ + INTEGER INFO(6) + INTEGER ELTPTR(NELT+1),ELTVAR(NZ) + INTEGER IW(LIW),SVAR(0:N) + INTEGER FLAG,NEW,VARS + EXTERNAL CMUMPS_316 + INFO(1) = 0 + INFO(2) = 0 + INFO(3) = 0 + INFO(4) = 0 + IF (N.LT.1) GO TO 10 + IF (NELT.LT.1) GO TO 20 + IF (NZ.LT.ELTPTR(NELT+1)-1) GO TO 30 + IF (LIW.LT.6) THEN + INFO(4) = 3*N + 3 + GO TO 40 + END IF + NEW = 1 + VARS = NEW + LIW/3 + FLAG = VARS + LIW/3 + CALL CMUMPS_316(N,NELT,ELTPTR,NZ,ELTVAR,SVAR,NSUP,LIW/3-1, + & IW(NEW),IW(VARS),IW(FLAG),INFO) + IF (INFO(1).EQ.-4) THEN + INFO(4) = 3*N + 3 + GO TO 40 + ELSE + INFO(4) = 3*NSUP + 3 + END IF + GO TO 50 + 10 INFO(1) = -1 + IF (LP.GT.0) WRITE (LP,FMT=9000) INFO(1) + GO TO 50 + 20 INFO(1) = -2 + IF (LP.GT.0) WRITE (LP,FMT=9000) INFO(1) + GO TO 50 + 30 INFO(1) = -3 + IF (LP.GT.0) WRITE (LP,FMT=9000) INFO(1) + GO TO 50 + 40 INFO(1) = -4 + IF (LP.GT.0) THEN + WRITE (LP,FMT=9000) INFO(1) + WRITE (LP,FMT=9010) INFO(4) + END IF + 50 RETURN + 9000 FORMAT (/3X,'Error message from CMUMPS_315: INFO(1) = ',I2) + 9010 FORMAT (3X,'LIW is insufficient. Upper bound on required work', + & 'space is ',I8) + END SUBROUTINE CMUMPS_315 + SUBROUTINE CMUMPS_316( N, NELT, ELTPTR, NZ, ELTVAR, + & SVAR, NSUP, MAXSUP, NEW, VARS, FLAG, INFO ) + INTEGER MAXSUP,N,NELT,NSUP,NZ + INTEGER ELTPTR(NELT+1),ELTVAR(NZ) + INTEGER INFO(6) + INTEGER FLAG(0:MAXSUP), NEW(0:MAXSUP),SVAR(0:N), + & VARS(0:MAXSUP) + INTEGER I,IS,J,JS,K,K1,K2 + DO 10 I = 0,N + SVAR(I) = 0 + 10 CONTINUE + VARS(0) = N + 1 + NEW(0) = -1 + FLAG(0) = 0 + NSUP = 0 + DO 40 J = 1,NELT + K1 = ELTPTR(J) + K2 = ELTPTR(J+1) - 1 + DO 20 K = K1,K2 + I = ELTVAR(K) + IF (I.LT.1 .OR. I.GT.N) THEN + INFO(2) = INFO(2) + 1 + GO TO 20 + END IF + IS = SVAR(I) + IF (IS.LT.0) THEN + ELTVAR(K) = 0 + INFO(3) = INFO(3) + 1 + GO TO 20 + END IF + SVAR(I) = SVAR(I) - N - 2 + VARS(IS) = VARS(IS) - 1 + 20 CONTINUE + DO 30 K = K1,K2 + I = ELTVAR(K) + IF (I.LT.1 .OR. I.GT.N) GO TO 30 + IS = SVAR(I) + N + 2 + IF (FLAG(IS).LT.J) THEN + FLAG(IS) = J + IF (VARS(IS).GT.0) THEN + NSUP = NSUP + 1 + IF (NSUP.GT.MAXSUP) THEN + INFO(1) = -4 + RETURN + END IF + VARS(NSUP) = 1 + FLAG(NSUP) = J + NEW(IS) = NSUP + SVAR(I) = NSUP + ELSE + VARS(IS) = 1 + NEW(IS) = IS + SVAR(I) = IS + END IF + ELSE + JS = NEW(IS) + VARS(JS) = VARS(JS) + 1 + SVAR(I) = JS + END IF + 30 CONTINUE + 40 CONTINUE + RETURN + END SUBROUTINE CMUMPS_316 + SUBROUTINE CMUMPS_36( COMM_LOAD, ASS_IRECV, + & NELT, FRT_PTR, FRT_ELT, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, + & FILS, FRERE, DAD, MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER,PTRARW, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & + & NSTK_S,NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE CMUMPS_COMM_BUFFER + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mpif.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER IZERO + PARAMETER (IZERO=0) + INTEGER NELT,N,LIW,NSTEPS + INTEGER(8) LA, LRLU, LRLUS, IPTRLU, POSFAC + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & IWPOS, IWPOSCB, COMP + INTEGER IDUMMY(1) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(NELT+1), PTRAIW(NELT+1), ND(KEEP(28)), PERM(N), + & FILS(N), FRERE(KEEP(28)), DAD(KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)), + & PAMASTER(KEEP(28)) + INTEGER COMM, NBFIN, SLAVEF, MYID + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + LOGICAL SON_LEVEL2 + COMPLEX A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER FRT_PTR(N+1), FRT_ELT(NELT) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX DBLARR(max(1,KEEP(13))) + INTEGER LPOOL, LEAF + INTEGER LBUFR, LBUFR_BYTES + INTEGER IPOOL( LPOOL ) + INTEGER NBPROCFILS(KEEP(28)), NSTK_S(KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER BUFR( LBUFR ) + INTEGER ETATASS + INCLUDE 'mumps_headers.h' + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + INTEGER LP, HS, HF + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + INTEGER NFS4FATHER + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER(8) NFRONT8 + INTEGER(8) LAELL8, APOS, APOS2, LAPOS2 + INTEGER(8) POSELT, POSEL1, ICT12, ICT21 + INTEGER(8) IACHK + INTEGER(8) JJ2 + INTEGER(8) LSTK8, SIZFR8 +#if defined(ALLOW_NON_INIT) + INTEGER(8) :: JJ8 +#endif + INTEGER NBPANELS_L, NBPANELS_U, LREQ_OOC + INTEGER SIZFI, NCB + INTEGER JJ,J1,J2 + INTEGER NCOLS, NROWS, LDA_SON + INTEGER NELIM,JJ1,J3, + & IORG, IBROT + INTEGER JPOS,ICT11, IJROW + INTEGER Pos_First_NUMORG,NUMORG,IOLDPS, + & NUMELT, ELBEG + INTEGER AINPUT, + & AII, J + INTEGER NSLAVES, NSLSON, NPIVS, NPIV_ANA, NPIV + INTEGER PTRCOL, ISLAVE, PDEST,LEVEL + LOGICAL LEVEL1, NIV1 + INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX + INTEGER ELTI, SIZE_ELTI + INTEGER II, I + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER NCBSON + LOGICAL SAME_PROC + INTRINSIC real + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + LOGICAL MUMPS_167, SSARBR + EXTERNAL MUMPS_167 + DOUBLE PRECISION FLOP1,FLOP1_EFF + EXTERNAL MUMPS_170 + LOGICAL MUMPS_170 + NFS4FATHER = -1 + ETATASS = 0 + COMPRESSCB=.FALSE. + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + LEVEL = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (LEVEL.NE.1) THEN + write(6,*) 'Error1 in mpi51f_niv1 ' + CALL MUMPS_ABORT() + END IF + NSLAVES = 0 + HF = 6 + NSLAVES + KEEP(IXSZ) + NUMELT = FRT_PTR(INODE+1) - FRT_PTR(INODE) + IF ( NUMELT .ne. 0 ) THEN + ELBEG = FRT_PTR(INODE) + ELSE + ELBEG = 1 + END IF + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + END DO + NPIV_ANA=NUMORG + NSTEPS = NSTEPS + 1 + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + END DO + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + NASS1 = NASS + NUMORG + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL CMUMPS_684(KEEP(50), NFRONT, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL CMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + END IF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + END IF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + NIV1 = .TRUE. + IF (KEEP(50).EQ.0) THEN + CALL MUMPS_124( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, NFRONT, NFRONT_EFF, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, + & SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG ) + ELSE + CALL MUMPS_125( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, + & SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + IF (IFLAG.LT.0) GOTO 300 + END IF + IF (NFRONT_EFF.NE.NFRONT) THEN + IF (NFRONT.GT.NFRONT_EFF) THEN + IF(MUMPS_170(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF))THEN + NPIV=NASS1-(NFRONT_EFF-ND(STEP(INODE))) + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1) + NPIV=NPIV_ANA + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1_EFF) + CALL CMUMPS_190(0,.FALSE.,FLOP1-FLOP1_EFF, + & KEEP,KEEP8) + ENDIF + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) ' ERROR 1 during ass_niv1_ELT' + GOTO 270 + ENDIF + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL CMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + NCB = NFRONT - NASS1 + MAXFRW = max0(MAXFRW, NFRONT) + ICT11 = IOLDPS + HF - 1 + NFRONT + NFRONT8=int(NFRONT,8) + LAELL8 = NFRONT8*NFRONT8 + IF (LRLU .LT. LAELL8) THEN + IF (LRLUS .LT. LAELL8) THEN + GOTO 280 + ELSE + CALL CMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + END IF + END IF + END IF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + POSFAC = POSFAC + LAELL8 + SSARBR=MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + CALL CMUMPS_471(SSARBR,.FALSE.,LA-LRLUS,0_8,LAELL8, + & KEEP,KEEP8, + & LRLU) +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. NFRONT .LT. KEEP(63) ) THEN + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO + ELSE + APOS = POSELT + DO JJ8 = 0_8, int(NFRONT -1,8) + A(APOS:APOS+JJ8) = ZERO + APOS = APOS + NFRONT8 + END DO + END IF +#endif + NASS = NASS1 + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + IW(IOLDPS+KEEP(IXSZ)) = NFRONT + IW(IOLDPS+KEEP(IXSZ)+ 1) = 0 + IW(IOLDPS+KEEP(IXSZ) + 2) = -NASS1 + IW(IOLDPS+KEEP(IXSZ) + 3) = -NASS1 + IW(IOLDPS+KEEP(IXSZ) + 4) = STEP(INODE) + IW(IOLDPS+KEEP(IXSZ)+5) = NSLAVES + IF (NUMSTK.NE.0) THEN + ISON = IFSON + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + LSTK8 = int(LSTK,8) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB = + & ( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB = ( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + LEVEL1 = NSLSON.EQ.0 + IF (.NOT.SAME_PROC) THEN + NROWS = IW( ISTCHK + 2+KEEP(IXSZ)) + ELSE + NROWS = NCOLS + ENDIF + SIZFI = HS + NROWS + NCOLS + J1 = ISTCHK + HS + NROWS + NPIVS + IF ( .NOT. LEVEL1 .AND. NELIM.EQ.0 ) GOTO 205 + IF (LEVEL1) THEN + J2 = J1 + LSTK - 1 + IF (COMPRESSCB) THEN + SIZFR8 = (LSTK8*(LSTK8+1_8)/2_8) + ELSE + SIZFR8 = LSTK8*LSTK8 + ENDIF + ELSE + IF ( KEEP(50).eq.0 ) THEN + SIZFR8 = int(NELIM,8) * LSTK8 + ELSE + SIZFR8 = int(NELIM,8) * int(NELIM,8) + END IF + J2 = J1 + NELIM - 1 + ENDIF + OPASSW = OPASSW + dble(SIZFR8) + IACHK = PAMASTER(STEP(ISON)) + IF ( KEEP(50) .eq. 0 ) THEN + POSEL1 = PTRAST(STEP(INODE)) - NFRONT8 + IF (J2.GE.J1) THEN + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * NFRONT8 + DO 160 JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8)) + 160 CONTINUE + IACHK = IACHK + LSTK8 + 170 CONTINUE + END IF + ELSE + IF (LEVEL1) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = SIZFR8 + ELSE + LCB = int(LDA_SON,8)*int(J2 - J1 + 1,8) + ENDIF + CALL CMUMPS_178(A, LA, + & PTRAST(STEP( INODE )), NFRONT, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), J2 - J1 + 1, NELIM, ETATASS, + & COMPRESSCB, + & .FALSE. + & ) + ENDIF + 205 IF (LEVEL1) THEN + IF (SAME_PROC) ISTCHK = PTRIST(STEP(ISON)) + IF (SAME_PROC) THEN + IF (KEEP(50).NE.0) THEN + J2 = J1 + LSTK - 1 + DO JJ = J1, J2 + IW(JJ) = IW(JJ - NROWS) + END DO + ELSE + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM + DO JJ = J3, J2 + IW(JJ) = IW(JJ - NROWS) + END DO + IF (NELIM .NE. 0) THEN + J3 = J3 - 1 + DO JJ = J1, J3 + JPOS = IW(JJ) + ICT11 + IW(JJ) = IW(JPOS) + END DO + ENDIF + ENDIF + ENDIF + IF ( SAME_PROC ) THEN + PTRIST(STEP( ISON )) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL CMUMPS_152(SSARBR, MYID, N, ISTCHK, + & IACHK, + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + ELSE + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL CMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, IDUMMY, + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, + & LEAF, NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + END DO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL CMUMPS_71( INODE, NFRONT, + & NASS1, NFS4FATHER,ISON, MYID, + & IZERO, IDUMMY, IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, + & SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + 220 CONTINUE + END IF + DO IELL=ELBEG,ELBEG+NUMELT-1 + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + AII = PTRARW(ELTI) + SIZE_ELTI = J2 - J1 + 1 + DO II=J1,J2 + I = INTARR(II) + IF (KEEP(50).EQ.0) THEN + AINPUT = AII + II - J1 + ICT12 = POSELT + int(I-1,8) * NFRONT8 + DO JJ=J1,J2 + APOS2 = ICT12 + int(INTARR(JJ) - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + SIZE_ELTI + END DO + ELSE + ICT12 = POSELT + int(- NFRONT + I - 1,8) + ICT21 = POSELT + int(I-1,8)*NFRONT8 - 1_8 + DO JJ=II,J2 + J = INTARR(JJ) + IF (I.LT.J) THEN + APOS2 = ICT12 + int(J,8)*NFRONT8 + ELSE + APOS2 = ICT21 + int(J,8) + ENDIF + A(APOS2) = A(APOS2) + DBLARR(AII) + AII = AII + 1 + END DO + END IF + END DO + END DO + IF (KEEP(253).GT.0) THEN + POSELT = PTRAST(STEP(INODE)) + IBROT = INODE + IJROW = Pos_First_NUMORG + DO IORG = 1, NUMORG + IF (KEEP(50).EQ.0) THEN + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(IJROW-1,8) * NFRONT8 + + & int(NFRONT-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ELSE + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(NFRONT-KEEP(253)+JJ-1,8) * NFRONT8 + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + IJROW = IJROW+1 + ENDDO + ENDIF + GOTO 500 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER ALLOCATION DURING CMUMPS_36' + ENDIF + GOTO 490 + 280 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, WORKSPACE TOO SMALL DURING CMUMPS_36' + ENDIF + IFLAG = -9 + CALL MUMPS_731(LAELL8-LRLUS, IERROR) + GOTO 500 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, SEND BUFFER TOO SMALL DURING CMUMPS_36' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, RECV BUFFER TOO SMALL DURING CMUMPS_36' + ENDIF + IFLAG = -20 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE IN INTEGER', + & ' DYNAMIC ALLOCATION DURING CMUMPS_36' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 490 CALL CMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE CMUMPS_36 + SUBROUTINE CMUMPS_37( COMM_LOAD, ASS_IRECV, + & NELT, FRT_PTR, FRT_ELT, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, FILS, FRERE, DAD, + & CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_S, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, LEAF, IPOOL, LPOOL, + & PERM, + & MEM_DISTRIB) + USE CMUMPS_COMM_BUFFER + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER NELT, N,LIW,NSTEPS, NBFIN + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER(8) LRLU, IPTRLU, LRLUS, POSFAC, LA + INTEGER(8) LAELL8 + INTEGER JJ + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & LPOOL, LEAF, + & IWPOS, + & IWPOSCB, COMP, SLAVEF + INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB + INTEGER IPOOL(LPOOL) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(NELT+1), PTRAIW(NELT+1), ND(KEEP(28)), + & FILS(N), FRERE(KEEP(28)), STEP(N), DAD (KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), PERM(N) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRFAC(KEEP(28)), PAMASTER(KEEP(28)), + & PTRAST(KEEP(28)) + INTEGER CAND(SLAVEF+1,max(1,KEEP(56))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + COMPLEX A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER FRT_PTR(N+1), FRT_ELT(NELT) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX DBLARR(max(1,KEEP(13))) + INTEGER MYID, COMM + INTEGER LBUFR, LBUFR_BYTES + INTEGER NBPROCFILS(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER BUFR( LBUFR ) + INCLUDE 'mumps_headers.h' + INTEGER LP, HS, HF, HF_OLD, NSLAVES_OLD,NCBSON + INTEGER NCBSON_MAX + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + INTEGER NFS4FATHER + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER LREQ_OOC, NBPANELS_L, NBPANELS_U + INTEGER NCB + INTEGER J1,J2 + INTEGER(8) NFRONT8, LAPOS2, POSELT, POSEL1, LDAFS8, + & JJ2, IACHK, ICT12, ICT21 +#if defined(ALLOW_NON_INIT) + INTEGER(8) :: JJ8 +#endif + INTEGER(8) APOS, APOS2 + INTEGER NELIM,LDAFS,JJ1,NPIVS,NCOLS,NROWS, + & IORG + INTEGER LDA_SON, IJROW, IBROT + INTEGER Pos_First_NUMORG,NBCOL,NUMORG,IOLDPS + INTEGER AINPUT + INTEGER NSLAVES, NSLSON + INTEGER NBLIG, PTRCOL, PTRROW, ISLAVE, PDEST + INTEGER ELTI, SIZE_ELTI + INTEGER II, ELBEG, NUMELT, I, J, AII + LOGICAL SAME_PROC, NIV1, SON_LEVEL2 + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX + logical :: force_cand + INTEGER(8) APOSMAX + REAL MAXARR + INTEGER INIV2, SIZE_TMP_SLAVES_LIST, allocok + INTEGER NUMORG_SPLIT, TYPESPLIT, + & NCB_SPLIT, SIZE_LIST_SPLIT, NBSPLIT + INTEGER, ALLOCATABLE, DIMENSION(:) :: TMP_SLAVES_LIST, COPY_CAND + INTEGER IZERO + INTEGER IDUMMY(1) + INTEGER PDEST1(1) + INTEGER ETATASS + PARAMETER( IZERO = 0 ) + INTEGER MUMPS_275, MUMPS_330, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, MUMPS_810 + INTRINSIC real + COMPLEX ZERO + REAL RZERO + PARAMETER( RZERO = 0.0E0 ) + PARAMETER( ZERO = (0.0E0,0.0E0) ) + COMPRESSCB=.FALSE. + ETATASS = 0 + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + NSTEPS = NSTEPS + 1 + NUMELT = FRT_PTR(INODE+1) - FRT_PTR(INODE) + IF ( NUMELT .NE. 0 ) THEN + ELBEG = FRT_PTR(INODE) + ELSE + ELBEG = 1 + END IF + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + END DO + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + NCBSON_MAX = 0 + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + IF ( KEEP(48)==5 .AND. + & MUMPS_330(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) .EQ. 1) THEN + NCBSON_MAX = + & max(NCBSON_MAX,IW(PIMASTER(STEP(ISON))+KEEP(IXSZ))) + END IF + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + END DO + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + MAXFRW = max0(MAXFRW, NFRONT) + NASS1 = NASS + NUMORG + NCB = NFRONT - NASS1 + IF((KEEP(24).eq.0).or.(KEEP(24).eq.1)) then + force_cand=.FALSE. + ELSE + force_cand=(mod(KEEP(24),2).eq.0) + end if + IF (force_cand) THEN + INIV2 = ISTEP_TO_INIV2( STEP( INODE )) + SIZE_TMP_SLAVES_LIST = CAND( SLAVEF+1, INIV2 ) + ELSE + INIV2 = 1 + SIZE_TMP_SLAVES_LIST = SLAVEF - 1 + ENDIF + ALLOCATE(TMP_SLAVES_LIST(SIZE_TMP_SLAVES_LIST),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + TYPESPLIT = MUMPS_810 (PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IF ( (TYPESPLIT.EQ.4) + & .OR.(TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) + & ) THEN + IF (TYPESPLIT.EQ.4) THEN + ALLOCATE(COPY_CAND(SLAVEF+1),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + CALL CMUMPS_791 ( + & INODE, STEP, N, SLAVEF, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & CAND(1,INIV2), ICNTL, COPY_CAND, + & NBSPLIT, NUMORG_SPLIT, TMP_SLAVES_LIST(1), + & SIZE_TMP_SLAVES_LIST + & ) + NCB_SPLIT = NCB-NUMORG_SPLIT + SIZE_LIST_SPLIT = SIZE_TMP_SLAVES_LIST - NBSPLIT + CALL CMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, COPY_CAND, + & MEM_DISTRIB(0), NCB_SPLIT, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST(NBSPLIT+1), + & SIZE_LIST_SPLIT,INODE ) + DEALLOCATE (COPY_CAND) + CALL CMUMPS_790 ( + & INODE, STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, + & TAB_POS_IN_PERE(1,INIV2), + & NSLAVES + & ) + ELSE + ISTCHK = PIMASTER(STEP(IFSON)) + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + TMP_SLAVES_LIST (1:SIZE_TMP_SLAVES_LIST) + & = CAND (1:SIZE_TMP_SLAVES_LIST, INIV2) + CALL CMUMPS_792 ( + & INODE, TYPESPLIT, IFSON, + & IW(PDEST), NSLSON, + & STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, ISTEP_TO_INIV2, INIV2, + & TAB_POS_IN_PERE, NSLAVES, + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST + & ) + ENDIF + ELSE + CALL CMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL CMUMPS_684(KEEP(50), NASS1, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL CMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + ENDIF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + ENDIF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + NIV1 = .FALSE. + IF (KEEP(50).EQ.0) THEN + CALL MUMPS_124( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, NFRONT,NFRONT_EFF, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + ELSE + CALL MUMPS_125( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + IF (IFLAG.LT.0) GOTO 250 + ENDIF + IF ( NFRONT .NE. NFRONT_EFF ) THEN + IF ( + & (TYPESPLIT.EQ.5) .OR. (TYPESPLIT.EQ.6)) THEN + WRITE(6,*) ' SPLITTING NOT YET READY FOR THAT' + CALL MUMPS_ABORT() + ENDIF + IF (NFRONT.GT.NFRONT_EFF) THEN + NCB = NFRONT_EFF - NASS1 + NSLAVES_OLD = NSLAVES + HF_OLD = HF + IF (TYPESPLIT.EQ.4) THEN + WRITE(6,*) ' Internal error 2 in fac_ass_elt due', + & ' to plitting ', + & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ELSE + CALL CMUMPS_472( NCBSON_MAX, + & SLAVEF, KEEP,KEEP8,ICNTL, + & CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT_EFF, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) - + & (NSLAVES_OLD - NSLAVES) + IF (NSLAVES_OLD .NE. NSLAVES) THEN + IF (NSLAVES_OLD > NSLAVES) THEN + DO JJ=0,2*NFRONT_EFF-1 + IW(IOLDPS+HF+JJ)=IW(IOLDPS+HF_OLD+JJ) + ENDDO + ELSE + IF (IWPOS - 1 > IWPOSCB ) GOTO 270 + DO JJ=2*NFRONT_EFF-1, 0, -1 + IW(IOLDPS+HF+JJ) = IW(IOLDPS+HF_OLD+JJ) + ENDDO + END IF + END IF + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) ' ERROR 2 during ass_niv2' + GOTO 270 + ENDIF + ENDIF + NFRONT8=int(NFRONT,8) + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL CMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + MAXFRW = max0(MAXFRW, NFRONT) + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS + 1+KEEP(IXSZ)) = 0 + IW(IOLDPS + 2+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 3+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) + IW(IOLDPS+KEEP(IXSZ)) = NFRONT + IW(IOLDPS+5+KEEP(IXSZ)) = NSLAVES + IW(IOLDPS+6+KEEP(IXSZ):IOLDPS+5+NSLAVES+KEEP(IXSZ))= + & TMP_SLAVES_LIST(1:NSLAVES) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + IF (KEEP(73) .EQ. 0) THEN +#endif +#endif + CALL CMUMPS_461(MYID, SLAVEF, COMM_LOAD, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP, KEEP8, IW(IOLDPS+6+KEEP(IXSZ)), NSLAVES,INODE) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + ENDIF +#endif +#endif + IF(KEEP(86).EQ.1)THEN + IF(mod(KEEP(24),2).eq.0)THEN + CALL CMUMPS_533(SLAVEF,CAND(SLAVEF+1,INIV2), + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE) + ELSEIF((KEEP(24).EQ.0).OR.(KEEP(24).EQ.1))THEN + CALL CMUMPS_533(SLAVEF,SLAVEF-1, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8,TMP_SLAVES_LIST, NSLAVES,INODE) + ENDIF + ENDIF + DEALLOCATE(TMP_SLAVES_LIST) + IF (KEEP(50).EQ.0) THEN + LAELL8 = int(NASS1,8) * NFRONT8 + LDAFS = NFRONT + LDAFS8 = NFRONT8 + ELSE + LAELL8 = int(NASS1,8)*int(NASS1,8) + IF (KEEP(219).NE.0) THEN + IF(KEEP(50) .EQ. 2) LAELL8 = LAELL8+int(NASS1,8) + ENDIF + LDAFS = NASS1 + LDAFS8 = int(NASS1,8) + ENDIF + IF (LRLU .LT. LAELL8) THEN + IF (LRLUS .LT. LAELL8) THEN + GOTO 280 + ELSE + CALL CMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + ENDIF + ENDIF + ENDIF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + POSFAC = POSFAC + LAELL8 + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + CALL CMUMPS_471(.FALSE.,.FALSE.,LA-LRLUS,0_8,LAELL8, + & KEEP,KEEP8, + &LRLU) + POSEL1 = POSELT - LDAFS8 +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. LDAFS .lt. KEEP(63) ) THEN + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO + ELSE + APOS = POSELT + DO JJ8 = 0_8, LDAFS8 - 1_8 + A(APOS:APOS+JJ8) = ZERO + APOS = APOS + LDAFS8 + END DO + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + A(APOS:APOS+LDAFS8-1_8)=ZERO + ENDIF + END IF +#endif + IF ((NUMSTK.NE.0).AND.(NASS.NE.0)) THEN + ISON = IFSON + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + KEEP(IXSZ) + 1) + IF (NELIM.EQ.0) GOTO 210 + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NPIVS = IW(ISTCHK + KEEP(IXSZ) + 3) + IF (NPIVS.LT.0) NPIVS=0 + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + HS = 6 + KEEP(IXSZ) + NSLSON + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + KEEP(IXSZ) + 2) + ELSE + NROWS = NCOLS + ENDIF + OPASSW = OPASSW + dble(NELIM*LSTK) + J1 = ISTCHK + HS + NROWS + NPIVS + J2 = J1 + NELIM - 1 + IACHK = PAMASTER(STEP(ISON)) + IF (KEEP(50).eq.0) THEN + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * LDAFS8 + DO 160 JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1),8) - 1_8 + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1,8) - 1_8) + 160 CONTINUE + IACHK = IACHK + int(LSTK,8) + 170 CONTINUE + ELSE + IF (NSLSON.EQ.0) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = (int(NELIM,8)*int(NELIM+1,8))/2_8 + ELSE + LCB = int(LDA_SON,8)*int(NELIM,8) + ENDIF + CALL CMUMPS_178(A, LA, + & POSELT, LDAFS, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), NELIM, NELIM, ETATASS, + & COMPRESSCB, + & .FALSE. + & ) + ENDIF + 210 ISON = FRERE(STEP(ISON)) + 220 CONTINUE + ENDIF + APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8) + IF (KEEP(219).NE.0) THEN + IF (KEEP(50).EQ.2) THEN + A( APOSMAX: APOSMAX+int(NASS1-1,8))=ZERO + ENDIF + ENDIF + DO IELL=ELBEG,ELBEG+NUMELT-1 + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + AII = PTRARW(ELTI) + SIZE_ELTI = J2 - J1 + 1 + DO II=J1,J2 + I = INTARR(II) + IF (KEEP(50).EQ.0) THEN + IF (I.LE.NASS1) THEN + AINPUT = AII + II - J1 + ICT12 = POSELT + int(I-1,8) * LDAFS8 + DO JJ=J1,J2 + APOS2 = ICT12 + int(INTARR(JJ) - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + SIZE_ELTI + END DO + ENDIF + ELSE + ICT12 = POSELT - LDAFS8 + int(I,8) - 1_8 + ICT21 = POSELT + int(I-1,8)*LDAFS8 - 1_8 + IF ( I .GT. NASS1 ) THEN + IF (KEEP(219).NE.0) THEN + IF (KEEP(50).EQ.2) THEN + AINPUT=AII + DO JJ=II,J2 + J=INTARR(JJ) + IF (J.LE.NASS1) THEN + A(APOSMAX+int(J-1,8))=cmplx( + & max(real(A(APOSMAX+int(J-1,8))), + & abs(DBLARR(AINPUT))), + & kind=kind(A) + & ) + ENDIF + AINPUT=AINPUT+1 + ENDDO + ELSE + AII = AII + J2 - II + 1 + CYCLE + ENDIF + ELSE + AII = AII + J2 - II + 1 + CYCLE + ENDIF + ELSE + IF (KEEP(219).NE.0) THEN + MAXARR = RZERO + ENDIF + DO JJ=II,J2 + J = INTARR(JJ) + IF ( J .LE. NASS1) THEN + IF (I.LT.J) THEN + APOS2 = ICT12 + int(J,8)*LDAFS8 + ELSE + APOS2 = ICT21 + int(J,8) + ENDIF + A(APOS2) = A(APOS2) + DBLARR(AII) + ELSE IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + MAXARR = max(MAXARR,abs(DBLARR(AII))) + ENDIF + AII = AII + 1 + END DO + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN + A(APOSMAX+int(I-1,8)) = cmplx( + & max( MAXARR, real(A(APOSMAX+int(I-1,8)))), + & kind=kind(A) + & ) + ENDIF + ENDIF + END IF + END DO + END DO + IF (KEEP(253).GT.0) THEN + POSELT = PTRAST(STEP(INODE)) + IBROT = INODE + IJROW = Pos_First_NUMORG + DO IORG = 1, NUMORG + IF (KEEP(50).EQ.0) THEN + DO JJ = 1, KEEP(253) + APOS = POSELT + + & int(IJROW-1,8) * int(LDAFS,8) + + & int(LDAFS-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + IJROW = IJROW+1 + ENDDO + ENDIF + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + PDEST = IOLDPS + 6 + KEEP(IXSZ) + DO ISLAVE = 1, NSLAVES + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB, + & NSLAVES, + & NBLIG, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + IERR = -1 + DO WHILE (IERR .EQ.-1) + IF ( KEEP(50) .eq. 0 ) THEN + NBCOL = NFRONT + CALL CMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & IZERO, IDUMMY, + & IW(PDEST), NFRONT, COMM, IERR) + ELSE + NBCOL = NASS1+SHIFT_INDEX+NBLIG + CALL CMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & NSLAVES-ISLAVE, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE), + & IW(PDEST), NFRONT, COMM, IERR) + ENDIF + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.) + IF ( IFLAG .LT. 0 ) GOTO 500 + IF (MESSAGE_RECEIVED) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + SHIFT_INDEX + ENDIF + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 300 + IF (IERR .EQ. -3) GOTO 305 + PTRROW = PTRROW + NBLIG + PDEST = PDEST + 1 + END DO + IF (NUMSTK.EQ.0) GOTO 500 + ISON = IFSON + DO IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + 1 + KEEP(IXSZ)) + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + 2 + KEEP(IXSZ) ) + ELSE + NROWS = NCOLS + ENDIF + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + NFS4FATHER = NCBSON + DO I=0,NCBSON-1 + IF(IW(PTRCOL+I) .GT. NASS1) THEN + NFS4FATHER = I + EXIT + ENDIF + ENDDO + NFS4FATHER=NFS4FATHER + NELIM + ELSE + NFS4FATHER = 0 + ENDIF + IF (NSLSON.EQ.0) THEN + NSLSON = 1 + PDEST1(1) = MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) + IF (PDEST1(1).EQ.MYID) THEN + CALL CMUMPS_211( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)), + & NFRONT, NASS1, NFS4FATHER,NCBSON, IW( PTRCOL ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, NELT+1, NELT, + & FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ELSE + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + CALL CMUMPS_71( + & INODE, NFRONT,NASS1,NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)), + & IW(PTRCOL), NCBSON, + & COMM, IERR, PDEST1, NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ELSE + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL CMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + END DO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL CMUMPS_71( + & INODE, NFRONT, NASS1, NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW(PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + END DO + GOTO 500 + 250 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE IN INTEGER', + & ' DYNAMIC ALLOCATION during assembly' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 1 + GOTO 490 + 265 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE ALLOCATING TMP_SLAVES_LIST', + & ' DYNAMIC ALLOCATION during assembly' + ENDIF + IFLAG = -13 + IERROR = SIZE_TMP_SLAVES_LIST + GOTO 490 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE IN INTEGER ALLOCATION DURING CMUMPS_37' + ENDIF + GOTO 490 + 280 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, WORKSPACE TOO SMALL DURING CMUMPS_37' + ENDIF + IFLAG = -9 + CALL MUMPS_731(LAELL8 - LRLUS, IERROR) + GOTO 490 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SEND BUFFER TOO SMALL (1) DURING CMUMPS_37' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECV BUFFER TOO SMALL (1) DURING CMUMPS_37' + ENDIF + IFLAG = -20 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SENDBUFFER TOO SMALL (2) DURING CMUMPS_37' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 305 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECVBUFFER TOO SMALL (2) DURING CMUMPS_37' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 490 CALL CMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE CMUMPS_37 + SUBROUTINE CMUMPS_123( + & NELT, FRT_PTR, FRT_ELT, + & N, INODE, IW, LIW, A, LA, + & NBROWS, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, + & RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP, KEEP8, MYID) + IMPLICIT NONE + INTEGER NELT, N,LIW + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER INODE, MYID + INTEGER NBROWS, NBCOLS + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER IW(LIW), ITLOC(N + KEEP(253)), STEP(N), + & PTRIST(KEEP(28)), + & FILS(N), PTRARW(NELT+1), + & PTRAIW(NELT+1) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER FRT_PTR(N+1), FRT_ELT(NELT) + COMPLEX A(LA), + & DBLARR(max(1,KEEP(13))) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER(8) :: POSELT, APOS2, ICT12, APOS + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & K1,K2,K,I,J,JPOS,NASS,JJ, + & IN,AINPUT,J1,J2,IJROW,ILOC, + & ELBEG, NUMELT, ELTI, SIZE_ELTI, IPOS, + & IPOS1, IPOS2, AII, II, IELL + INTEGER :: K1RHS, K2RHS, JFirstRHS + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INCLUDE 'mumps_headers.h' + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NASS = IW(IOLDPS+1+KEEP(IXSZ)) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + IF (NASS.LT.0) THEN + NASS = -NASS + IW(IOLDPS+1+KEEP(IXSZ)) = NASS + A(POSELT:POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8) = + & ZERO + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -JPOS + JPOS = JPOS + 1 + END DO + K1 = IOLDPS + HF + K2 = K1 + NBROWF - 1 + JPOS = 1 + IF ((KEEP(253).GT.0).AND.(KEEP(50).NE.0)) THEN + K1RHS = 0 + K2RHS = -1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -ITLOC(J)*NBCOLF + JPOS + IF ((K1RHS.EQ.0).AND.(J.GT.N)) THEN + K1RHS = K + JFirstRHS=J-N + ENDIF + JPOS = JPOS + 1 + ENDDO + IF (K1RHS.GT.0) K2RHS=K2 + IF ( K2RHS.GE.K1RHS ) THEN + IN = INODE + DO WHILE (IN.GT.0) + IJROW = -ITLOC(IN) + DO K = K1RHS, K2RHS + J = IW(K) + I = ITLOC(J) + ILOC = mod(I,NBCOLF) + APOS = POSELT+int(ILOC-1,8)*int(NBCOLF,8) + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( + & (JFirstRHS+(K-K1RHS)-1)*KEEP(254)+ IN) + ENDDO + IN = FILS(IN) + ENDDO + ENDIF + ELSE + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -ITLOC(J)*NBCOLF + JPOS + JPOS = JPOS + 1 + END DO + ENDIF + ELBEG = FRT_PTR(INODE) + NUMELT = FRT_PTR(INODE+1) - ELBEG + DO IELL=ELBEG,ELBEG+NUMELT-1 + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + AII = PTRARW(ELTI) + SIZE_ELTI = J2 - J1 + 1 + DO II=J1,J2 + I = ITLOC(INTARR(II)) + IF (KEEP(50).EQ.0) THEN + IF (I.LE.0) CYCLE + AINPUT = AII + II - J1 + IPOS = mod(I,NBCOLF) + ICT12 = POSELT + int(IPOS-1,8) * int(NBCOLF,8) + DO JJ = J1, J2 + JPOS = ITLOC(INTARR(JJ)) + IF (JPOS.LE.0) THEN + JPOS = -JPOS + ELSE + JPOS = JPOS/NBCOLF + END IF + APOS2 = ICT12 + int(JPOS - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + SIZE_ELTI + END DO + ELSE + IF ( I .EQ. 0 ) THEN + AII = AII + J2 - II + 1 + CYCLE + ENDIF + IF ( I .LE. 0 ) THEN + IPOS1 = -I + IPOS2 = 0 + ELSE + IPOS1 = I/NBCOLF + IPOS2 = mod(I,NBCOLF) + END IF + ICT12 = POSELT + int(IPOS2-1,8)*int(NBCOLF,8) + DO JJ=II,J2 + AII = AII + 1 + J = ITLOC(INTARR(JJ)) + IF ( J .EQ. 0 ) CYCLE + IF ( IPOS2.EQ.0 .AND. J.LE.0) CYCLE + IF ( J .LE. 0 ) THEN + JPOS = -J + ELSE + JPOS = J/NBCOLF + END IF + IF ( (IPOS1.GE.JPOS) .AND. (IPOS2.GT.0) ) THEN + APOS2 = ICT12 + int(JPOS - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AII-1) + END IF + IF ( (IPOS1.LT.JPOS) .AND. (J.GT.0) ) THEN + IPOS = mod(J,NBCOLF) + JPOS = IPOS1 + APOS2 = POSELT + int(IPOS-1,8)*int(NBCOLF,8) + & + int(JPOS - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AII-1) + END IF + END DO + END IF + END DO + END DO + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = 0 + END DO + END IF + IF (NBROWS.GT.0) THEN + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + JPOS = JPOS + 1 + END DO + END IF + RETURN + END SUBROUTINE CMUMPS_123 + SUBROUTINE CMUMPS_126( + & N, NELT, NA_ELT, + & COMM, MYID, SLAVEF, + & IELPTR_LOC, RELPTR_LOC, + & ELTVAR_LOC, ELTVAL_LOC, + & KEEP,KEEP8, MAXELT_SIZE, + & FRTPTR, FRTELT, A, LA, FILS, + & id, root ) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N, NELT, NA_ELT + INTEGER COMM, MYID, SLAVEF, MAXELT_SIZE, MSGLEN + INTEGER(8), intent(IN) :: LA + INTEGER FRTPTR( N+1 ) + INTEGER FRTELT( NELT ), FILS ( N ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IELPTR_LOC( NELT + 1 ), RELPTR_LOC( NELT + 1 ) + INTEGER ELTVAR_LOC( max(1,KEEP(14)) ) + COMPLEX ELTVAL_LOC( max(1,KEEP(13)) ) + COMPLEX A( LA ) + TYPE(CMUMPS_STRUC) :: id + TYPE(CMUMPS_ROOT_STRUC) :: root + INTEGER numroc + EXTERNAL numroc + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR_MPI + INTEGER MSGTAG + INTEGER allocok + INTEGER I, DEST, MAXELT_REAL_SIZE, MPG, IEL, SIZEI, SIZER + INTEGER NBRECORDS, NBUF + INTEGER RECV_IELTPTR, RECV_RELTPTR + INTEGER IELTPTR, RELTPTR, INODE + LOGICAL FINI, PROKG, I_AM_SLAVE + INTEGER(8) :: PTR_ROOT + INTEGER LOCAL_M, LOCAL_N, LP, IBEG, IGLOB, JGLOB + INTEGER ARROW_ROOT + INTEGER IELT, J, K, NB_REC, IREC + INTEGER ILOCROOT, JLOCROOT, IPOSROOT, JPOSROOT, IPTR + INTEGER JCOL_GRID, IROW_GRID + INTEGER IVALPTR + INTEGER NBELROOT + INTEGER MASTER + PARAMETER( MASTER = 0 ) + COMPLEX VAL + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INTEGER, DIMENSION( :, : ), ALLOCATABLE :: BUFI + COMPLEX, DIMENSION( :, : ), ALLOCATABLE :: BUFR + COMPLEX, DIMENSION( : ), ALLOCATABLE :: TEMP_ELT_R + INTEGER, DIMENSION( : ), ALLOCATABLE :: TEMP_ELT_I + INTEGER, DIMENSION( : ), ALLOCATABLE :: ELROOTPOS + INTEGER, DIMENSION( : ), ALLOCATABLE, TARGET :: RG2LALLOC + INTEGER, DIMENSION( : ), POINTER :: RG2L + MPG = id%ICNTL(3) + LP = id%ICNTL(1) + I_AM_SLAVE = ( KEEP(46) .eq. 1 .or. MYID .ne.MASTER ) + PROKG = ( MPG > 0 .and. MYID .eq. MASTER ) + KEEP(49) = 0 + ARROW_ROOT = 0 + IF ( MYID .eq. MASTER ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + NBUF = SLAVEF + ELSE + NBUF = SLAVEF - 1 + END IF + NBRECORDS = min(KEEP(39),NA_ELT) + IF ( KEEP(50) .eq. 0 ) THEN + MAXELT_REAL_SIZE = MAXELT_SIZE * MAXELT_SIZE + ELSE + MAXELT_REAL_SIZE = MAXELT_SIZE * (MAXELT_SIZE+1)/2 + END IF + IF ( MAXELT_REAL_SIZE .GT. KEEP(39) ) THEN + NBRECORDS = MAXELT_REAL_SIZE + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,*) + & ' ** Warning : For element distrib NBRECORDS set to ', + & MAXELT_REAL_SIZE,' because one element is large' + END IF + END IF + ALLOCATE( BUFI( 2*NBRECORDS+1, NBUF ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 2*NBRECORDS + 1 + GOTO 100 + END IF + ALLOCATE( BUFR( NBRECORDS+1, NBUF ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBRECORDS + 1 + GOTO 100 + END IF + IF ( KEEP(52) .ne. 0 ) THEN + ALLOCATE( TEMP_ELT_R( MAXELT_REAL_SIZE ), stat =allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = MAXELT_REAL_SIZE + GOTO 100 + END IF + END IF + ALLOCATE( TEMP_ELT_I( MAXELT_SIZE ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = MAXELT_SIZE + GOTO 100 + END IF + IF ( KEEP(38) .ne. 0 ) THEN + NBELROOT = FRTPTR(KEEP(38)+1)-FRTPTR(KEEP(38)) + ALLOCATE( ELROOTPOS( max(NBELROOT,1) ), + & stat = allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBELROOT + GOTO 100 + END IF + IF (KEEP(46) .eq. 0 ) THEN + ALLOCATE( RG2LALLOC( N ), stat = allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = N + GOTO 100 + END IF + INODE = KEEP(38) + I = 1 + DO WHILE ( INODE .GT. 0 ) + RG2LALLOC( INODE ) = I + INODE = FILS( INODE ) + I = I + 1 + END DO + RG2L => RG2LALLOC + ELSE + RG2L => root%RG2L_ROW + END IF + END IF + DO I = 1, NBUF + BUFI( 1, I ) = 0 + BUFR( 1, I ) = ZERO + END DO + END IF + 100 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), COMM, MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + CALL MPI_BCAST( NBRECORDS, 1, MPI_INTEGER, MASTER, + & COMM, IERR_MPI ) + RECV_IELTPTR = 1 + RECV_RELTPTR = 1 + IF ( MYID .eq. MASTER ) THEN + NBELROOT = 0 + RELTPTR = 1 + RELPTR_LOC(1) = 1 + DO IEL = 1, NELT + IELTPTR = id%ELTPTR( IEL ) + SIZEI = id%ELTPTR( IEL + 1 ) - IELTPTR + IF ( KEEP( 50 ) .eq. 0 ) THEN + SIZER = SIZEI * SIZEI + ELSE + SIZER = SIZEI * ( SIZEI + 1 ) / 2 + END IF + DEST = id%ELTPROC( IEL ) + IF ( DEST .eq. -2 ) THEN + NBELROOT = NBELROOT + 1 + FRTELT( FRTPTR(KEEP(38)) + NBELROOT - 1 ) = IEL + ELROOTPOS( NBELROOT ) = RELTPTR + GOTO 200 + END IF + IF ( DEST .ge. 0 .and. KEEP(46) .eq. 0 ) DEST = DEST + 1 + IF ( KEEP(52) .ne. 0 ) THEN + CALL CMUMPS_288( N, SIZEI, SIZER, + & id%ELTVAR( IELTPTR ), id%A_ELT( RELTPTR ), + & TEMP_ELT_R(1), MAXELT_REAL_SIZE, + & id%ROWSCA(1), id%COLSCA(1), KEEP(50) ) + END IF + IF ( DEST .eq. 0 .or. ( DEST .eq. -1 .and. KEEP(46) .ne. 0 ) ) + & THEN + ELTVAR_LOC( RECV_IELTPTR: RECV_IELTPTR + SIZEI - 1 ) + & = id%ELTVAR( IELTPTR: IELTPTR + SIZEI - 1 ) + RECV_IELTPTR = RECV_IELTPTR + SIZEI + IF ( KEEP(52) .ne. 0 ) THEN + ELTVAL_LOC( RECV_RELTPTR: RECV_RELTPTR + SIZER - 1) + & = TEMP_ELT_R( 1: SIZER ) + RECV_RELTPTR = RECV_RELTPTR + SIZER + END IF + END IF + IF ( DEST .NE. 0 .AND. DEST. NE. -3 ) THEN + IF ( KEEP(52) .eq. 0 ) THEN + CALL CMUMPS_127( + & id%ELTVAR(IELTPTR), + & id%A_ELT (RELTPTR), + & SIZEI, SIZER, + & + & DEST, NBUF, NBRECORDS, + & BUFI, BUFR, COMM ) + ELSE + CALL CMUMPS_127( + & id%ELTVAR(IELTPTR), + & TEMP_ELT_R( 1 ), + & SIZEI, SIZER, + & + & DEST, NBUF, NBRECORDS, + & BUFI, BUFR, COMM ) + END IF + END IF + 200 CONTINUE + RELTPTR = RELTPTR + SIZER + IF ( KEEP(46) .eq. 0 .OR. KEEP(52) .eq. 0 ) THEN + RELPTR_LOC( IEL + 1 ) = RELTPTR + ELSE + RELPTR_LOC( IEL + 1 ) = RECV_RELTPTR + ENDIF + END DO + IF ( KEEP(46) .eq. 0 .OR. KEEP(52) .eq. 0 ) THEN + KEEP(13) = RELTPTR - 1 + ELSE + KEEP(13) = RECV_RELTPTR - 1 + ENDIF + IF ( RELTPTR - 1 .ne. id%NA_ELT ) THEN + WRITE(*,*) ' ** ERROR ELT DIST: RELPTR - 1 / id%NA_ELT=', + & RELTPTR - 1,id%NA_ELT + CALL MUMPS_ABORT() + END IF + DEST = -2 + IELTPTR = 1 + RELTPTR = 1 + SIZEI = 1 + SIZER = 1 + CALL CMUMPS_127( + & id%ELTVAR(IELTPTR), + & id%A_ELT (RELTPTR), + & SIZEI, SIZER, + & + & DEST, NBUF, NBRECORDS, + & BUFI, BUFR, COMM ) + IF ( KEEP(52) .NE. 0 ) DEALLOCATE( TEMP_ELT_R ) + ELSE + FINI = ( RECV_IELTPTR .eq. IELPTR_LOC( NELT+1 ) + & .and. RECV_RELTPTR .eq. RELPTR_LOC( NELT+1 ) ) + DO WHILE ( .not. FINI ) + CALL MPI_PROBE( MASTER, MPI_ANY_TAG, + & COMM, STATUS, IERR_MPI ) + MSGTAG = STATUS( MPI_TAG ) + SELECT CASE ( MSGTAG ) + CASE( ELT_INT ) + CALL MPI_GET_COUNT( STATUS, MPI_INTEGER, + & MSGLEN, IERR_MPI ) + CALL MPI_RECV( ELTVAR_LOC( RECV_IELTPTR ), MSGLEN, + & MPI_INTEGER, MASTER, ELT_INT, + & COMM, STATUS, IERR_MPI ) + RECV_IELTPTR = RECV_IELTPTR + MSGLEN + CASE( ELT_REAL ) + CALL MPI_GET_COUNT( STATUS, MPI_COMPLEX, + & MSGLEN, IERR_MPI ) + CALL MPI_RECV( ELTVAL_LOC( RECV_RELTPTR ), MSGLEN, + & MPI_COMPLEX, MASTER, ELT_REAL, + & COMM, STATUS, IERR_MPI ) + RECV_RELTPTR = RECV_RELTPTR + MSGLEN + END SELECT + FINI = ( RECV_IELTPTR .eq. IELPTR_LOC( NELT+1 ) + & .and. RECV_RELTPTR .eq. RELPTR_LOC( NELT+1 ) ) + END DO + END IF + IF ( KEEP(38) .NE. 0 ) THEN + IF ( I_AM_SLAVE .and. root%yes ) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I = 1, root%SCHUR_NLOC + root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1: + & (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC)=ZERO + ENDDO + ENDIF + END IF + IF ( MYID .NE. MASTER ) THEN + ALLOCATE( BUFI( NBRECORDS * 2 + 1, 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBRECORDS * 2 + 1 + GOTO 250 + END IF + ALLOCATE( BUFR( NBRECORDS, 1 ) , stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBRECORDS + END IF + END IF + 250 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), COMM, MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + IF ( MYID .eq. MASTER ) THEN + DO IPTR = FRTPTR(KEEP(38)), FRTPTR(KEEP(38)+1) - 1 + IELT = FRTELT( IPTR ) + SIZEI = id%ELTPTR( IELT + 1 ) - id%ELTPTR( IELT ) + DO I = 1, SIZEI + TEMP_ELT_I( I ) = RG2L + & ( id%ELTVAR( id%ELTPTR(IELT) + I - 1 ) ) + END DO + IVALPTR = ELROOTPOS( IPTR - FRTPTR(KEEP(38)) + 1 ) - 1 + K = 1 + DO J = 1, SIZEI + JGLOB = id%ELTVAR( id%ELTPTR( IELT ) + J - 1 ) + IF ( KEEP(50).eq. 0 ) THEN + IBEG = 1 + ELSE + IBEG = J + END IF + DO I = IBEG, SIZEI + IGLOB = id%ELTVAR( id%ELTPTR( IELT ) + I - 1 ) + IF ( KEEP(52) .eq. 0 ) THEN + VAL = id%A_ELT( IVALPTR + K ) + ELSE + VAL = id%A_ELT( IVALPTR + K ) * + & id%ROWSCA( IGLOB ) * id%COLSCA( JGLOB ) + END IF + IF ( KEEP(50).eq.0 ) THEN + IPOSROOT = TEMP_ELT_I( I ) + JPOSROOT = TEMP_ELT_I( J ) + ELSE + IF ( TEMP_ELT_I(I) .GT. TEMP_ELT_I(J) ) THEN + IPOSROOT = TEMP_ELT_I(I) + JPOSROOT = TEMP_ELT_I(J) + ELSE + IPOSROOT = TEMP_ELT_I(J) + JPOSROOT = TEMP_ELT_I(I) + END IF + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, + & root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, + & root%NPCOL ) + IF ( KEEP(46) .eq. 0 ) THEN + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + 1 + ELSE + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + END IF + IF ( DEST .eq. MASTER ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & = A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & + VAL + ENDIF + ELSE + CALL CMUMPS_34( + & IPOSROOT, JPOSROOT, VAL, DEST, BUFI, BUFR, NBRECORDS, + & NBUF, LP, COMM, KEEP(46) ) + END IF + K = K + 1 + END DO + END DO + END DO + CALL CMUMPS_18( + & BUFI, BUFR, NBRECORDS, + & NBUF, LP, COMM, KEEP(46) ) + ELSE + FINI = .FALSE. + DO WHILE ( .not. FINI ) + CALL MPI_RECV( BUFI(1,1), 2*NBRECORDS+1, + & MPI_INTEGER, MASTER, + & ARROWHEAD, + & COMM, STATUS, IERR_MPI ) + NB_REC = BUFI(1,1) + IF (NB_REC.LE.0) THEN + FINI = .TRUE. + NB_REC = -NB_REC + ENDIF + IF (NB_REC.EQ.0) EXIT + CALL MPI_RECV( BUFR(1,1), NBRECORDS, MPI_COMPLEX, + & MASTER, ARROWHEAD, + & COMM, STATUS, IERR_MPI ) + ARROW_ROOT = ARROW_ROOT + NB_REC + DO IREC = 1, NB_REC + IPOSROOT = BUFI( IREC * 2, 1 ) + JPOSROOT = BUFI( IREC * 2 + 1, 1 ) + VAL = BUFR( IREC, 1 ) + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60).eq.0) THEN + A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8) + & + int(ILOCROOT-1,8)) + & = A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8) + & + int(ILOCROOT-1,8)) + & + VAL + ELSE + root%SCHUR_POINTER(int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + END DO + END DO + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + END IF + END IF + IF ( MYID .eq. MASTER ) THEN + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + IF (KEEP(38).ne.0) THEN + DEALLOCATE(ELROOTPOS) + IF (KEEP(46) .eq. 0 ) THEN + DEALLOCATE(RG2LALLOC) + ENDIF + ENDIF + DEALLOCATE( TEMP_ELT_I ) + END IF + KEEP(49) = ARROW_ROOT + RETURN + END SUBROUTINE CMUMPS_126 + SUBROUTINE CMUMPS_127( + & ELNODES, ELVAL, SIZEI, SIZER, + & DEST, NBUF, NBRECORDS, BUFI, BUFR, COMM ) + IMPLICIT NONE + INTEGER SIZEI, SIZER, DEST, NBUF, NBRECORDS, COMM + INTEGER ELNODES( SIZEI ), BUFI( 2*NBRECORDS + 1, NBUF ) + COMPLEX ELVAL( SIZER ), BUFR( NBRECORDS + 1, NBUF ) + INCLUDE 'mumps_tags.h' + INCLUDE 'mpif.h' + INTEGER I, IBEG, IEND, IERR_MPI, NBRECR + INTEGER NBRECI + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + IF ( DEST .lt. 0 ) THEN + IBEG = 1 + IEND = NBUF + ELSE + IBEG = DEST + IEND = DEST + END IF + DO I = IBEG, IEND + NBRECI = BUFI(1,I) + IF ( NBRECI .ne.0 .and. + & ( DEST.eq.-2 .or. + & NBRECI + SIZEI .GT. 2*NBRECORDS ) ) THEN + CALL MPI_SEND( BUFI(2, I), NBRECI, MPI_INTEGER, + & I, ELT_INT, COMM, IERR_MPI ) + BUFI(1,I) = 0 + NBRECI = 0 + END IF + NBRECR = int(real(BUFR(1,I))+0.5E0) + IF ( NBRECR .ne.0 .and. + & ( DEST.eq.-2 .or. + & NBRECR + SIZER .GT. NBRECORDS ) ) THEN + CALL MPI_SEND( BUFR(2, I), NBRECR, MPI_COMPLEX, + & I, ELT_REAL, COMM, IERR_MPI ) + BUFR(1,I) = ZERO + NBRECR = 0 + END IF + IF ( DEST .ne. -2 ) THEN + BUFI( 2 + NBRECI : 2 + NBRECI + SIZEI - 1, I ) = + & ELNODES( 1: SIZEI ) + BUFR( 2 + NBRECR : 2 + NBRECR + SIZER - 1, I ) = + & ELVAL( 1: SIZER ) + BUFI(1,I) = NBRECI + SIZEI + BUFR(1,I) = cmplx( NBRECR + SIZER, kind=kind(BUFR) ) + END IF + END DO + RETURN + END SUBROUTINE CMUMPS_127 + SUBROUTINE CMUMPS_213( ELTPTR, NELT, MAXELT_SIZE ) + INTEGER NELT, MAXELT_SIZE + INTEGER ELTPTR( NELT + 1 ) + INTEGER I, S + MAXELT_SIZE = 0 + DO I = 1, NELT + S = ELTPTR( I + 1 ) - ELTPTR( I ) + MAXELT_SIZE = max( S, MAXELT_SIZE ) + END DO + RETURN + END SUBROUTINE CMUMPS_213 + SUBROUTINE CMUMPS_288( N, SIZEI, SIZER, + & ELTVAR, ELTVAL, + & SELTVAL, LSELTVAL, + & ROWSCA, COLSCA, K50 ) + INTEGER N, SIZEI, SIZER, LSELTVAL, K50 + INTEGER ELTVAR( SIZEI ) + COMPLEX ELTVAL( SIZER ) + COMPLEX SELTVAL( LSELTVAL ) + REAL ROWSCA( N ), COLSCA( N ) + INTEGER I, J, K + K = 1 + IF ( K50 .eq. 0 ) THEN + DO J = 1, SIZEI + DO I = 1, SIZEI + SELTVAL(K) = ELTVAL(K) * + & ROWSCA(ELTVAR(I)) * + & COLSCA(ELTVAR(J)) + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + DO I = J, SIZEI + SELTVAL(K) = ELTVAL(K) * + & ROWSCA(ELTVAR(I)) * + & COLSCA(ELTVAR(J)) + K = K + 1 + END DO + END DO + END IF + RETURN + END SUBROUTINE CMUMPS_288 + SUBROUTINE CMUMPS_F77( JOB, SYM, PAR, COMM_F77, N, ICNTL, CNTL, + & NZ, IRN, IRNhere, JCN, JCNhere, A, Ahere, + & NZ_loc, IRN_loc, IRN_lochere, + & JCN_loc, JCN_lochere, + & A_loc, A_lochere, + & NELT, ELTPTR, ELTPTRhere, ELTVAR, + & ELTVARhere, A_ELT, A_ELThere, + & PERM_IN, PERM_INhere, + & RHS, RHShere, REDRHS, REDRHShere, + & INFO, RINFO, INFOG, RINFOG, + & DEFICIENCY, LWK_USER, + & SIZE_SCHUR, LISTVAR_SCHUR, + & LISTVAR_SCHURhere, SCHUR, SCHURhere, + & WK_USER, WK_USERhere, + & COLSCA, COLSCAhere, ROWSCA, ROWSCAhere, + & INSTANCE_NUMBER, NRHS, LRHS, LREDRHS, + & + & RHS_SPARSE, RHS_SPARSEhere, + & SOL_loc, SOL_lochere, + & IRHS_SPARSE, IRHS_SPARSEhere, + & IRHS_PTR, IRHS_PTRhere, + & ISOL_loc, ISOL_lochere, + & NZ_RHS, LSOL_loc + & , + & SCHUR_MLOC, + & SCHUR_NLOC, + & SCHUR_LLD, + & MBLOCK, + & NBLOCK, + & NPROW, + & NPCOL, + & + & OOC_TMPDIR, + & OOC_PREFIX, + & WRITE_PROBLEM, + & TMPDIRLEN, + & PREFIXLEN, + & WRITE_PROBLEMLEN + & + & ) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER OOC_PREFIX_MAX_LENGTH, OOC_TMPDIR_MAX_LENGTH + INTEGER PB_MAX_LENGTH + PARAMETER(OOC_PREFIX_MAX_LENGTH=63, OOC_TMPDIR_MAX_LENGTH=255) + PARAMETER(PB_MAX_LENGTH=255) + INTEGER JOB, SYM, PAR, COMM_F77, N, NZ, NZ_loc, NELT, + & DEFICIENCY, LWK_USER, SIZE_SCHUR, INSTANCE_NUMBER, + & NRHS, LRHS, + & NZ_RHS, LSOL_loc, LREDRHS + INTEGER ICNTL(40), INFO(40), INFOG(40) + INTEGER SCHUR_MLOC, SCHUR_NLOC, SCHUR_LLD + INTEGER MBLOCK, NBLOCK, NPROW, NPCOL + INTEGER TMPDIRLEN, PREFIXLEN, WRITE_PROBLEMLEN + REAL CNTL(15), RINFO(40), RINFOG(40) + INTEGER, TARGET :: IRN(*), JCN(*), ELTPTR(*), ELTVAR(*) + INTEGER, TARGET :: PERM_IN(*), IRN_loc(*), JCN_loc(*) + INTEGER, TARGET :: LISTVAR_SCHUR(*) + INTEGER, TARGET :: IRHS_PTR(*), IRHS_SPARSE(*), ISOL_loc(*) + COMPLEX, TARGET :: A(*), A_ELT(*), A_loc(*), RHS(*) + COMPLEX, TARGET :: WK_USER(*) + COMPLEX, TARGET :: REDRHS(*) + REAL, TARGET :: ROWSCA(*), COLSCA(*) + COMPLEX, TARGET :: SCHUR(*) + COMPLEX, TARGET :: RHS_SPARSE(*), SOL_loc(*) + INTEGER, INTENT(in) :: OOC_TMPDIR(OOC_TMPDIR_MAX_LENGTH) + INTEGER, INTENT(in) :: OOC_PREFIX(OOC_PREFIX_MAX_LENGTH) + INTEGER, INTENT(in) :: WRITE_PROBLEM(PB_MAX_LENGTH) + INTEGER IRNhere, JCNhere, Ahere, ELTPTRhere, ELTVARhere, + & A_ELThere, PERM_INhere, WK_USERhere, + & RHShere, REDRHShere, IRN_lochere, + & JCN_lochere, A_lochere, LISTVAR_SCHURhere, + & SCHURhere, COLSCAhere, ROWSCAhere, RHS_SPARSEhere, + & SOL_lochere, IRHS_PTRhere, IRHS_SPARSEhere, ISOL_lochere + INCLUDE 'mpif.h' + TYPE CMUMPS_STRUC_PTR + TYPE (CMUMPS_STRUC), POINTER :: PTR + END TYPE CMUMPS_STRUC_PTR + TYPE (CMUMPS_STRUC), POINTER :: mumps_par + TYPE (CMUMPS_STRUC_PTR), DIMENSION (:), POINTER, SAVE :: + & mumps_par_array + TYPE (CMUMPS_STRUC_PTR), DIMENSION (:), POINTER :: + & mumps_par_array_bis + INTEGER, SAVE :: CMUMPS_STRUC_ARRAY_SIZE = 0 + INTEGER, SAVE :: N_INSTANCES = 0 + INTEGER A_ELT_SIZE, I, Np, IERR + INTEGER CMUMPS_STRUC_ARRAY_SIZE_INIT + PARAMETER (CMUMPS_STRUC_ARRAY_SIZE_INIT=10) + EXTERNAL MUMPS_AFFECT_MAPPING, + & MUMPS_AFFECT_PIVNUL_LIST, + & MUMPS_AFFECT_SYM_PERM, + & MUMPS_AFFECT_UNS_PERM + IF (JOB == -1) THEN + DO I = 1, CMUMPS_STRUC_ARRAY_SIZE + IF ( .NOT. associated(mumps_par_array(I)%PTR) ) GOTO 10 + END DO + ALLOCATE( mumps_par_array_bis(CMUMPS_STRUC_ARRAY_SIZE + + & CMUMPS_STRUC_ARRAY_SIZE_INIT), stat=IERR) + IF (IERR /= 0) THEN + WRITE(*,*) ' ** Allocation Error 1 in CMUMPS_F77.' + CALL MUMPS_ABORT() + END IF + DO I = 1, CMUMPS_STRUC_ARRAY_SIZE + mumps_par_array_bis(I)%PTR=>mumps_par_array(I)%PTR + ENDDO + IF (associated(mumps_par_array)) DEALLOCATE(mumps_par_array) + mumps_par_array=>mumps_par_array_bis + NULLIFY(mumps_par_array_bis) + DO I = CMUMPS_STRUC_ARRAY_SIZE+1, CMUMPS_STRUC_ARRAY_SIZE + + & CMUMPS_STRUC_ARRAY_SIZE_INIT + NULLIFY(mumps_par_array(I)%PTR) + ENDDO + I = CMUMPS_STRUC_ARRAY_SIZE+1 + CMUMPS_STRUC_ARRAY_SIZE = CMUMPS_STRUC_ARRAY_SIZE + + & CMUMPS_STRUC_ARRAY_SIZE_INIT + 10 CONTINUE + INSTANCE_NUMBER = I + N_INSTANCES = N_INSTANCES+1 + ALLOCATE( mumps_par_array(INSTANCE_NUMBER)%PTR,stat=IERR ) + IF (IERR /= 0) THEN + WRITE(*,*) '** Allocation Error 2 in CMUMPS_F77.' + CALL MUMPS_ABORT() + ENDIF + mumps_par_array(INSTANCE_NUMBER)%PTR%KEEP(40) = 0 + mumps_par_array(INSTANCE_NUMBER)%PTR%INSTANCE_NUMBER = + & INSTANCE_NUMBER + END IF + IF ( INSTANCE_NUMBER .LE. 0 .OR. INSTANCE_NUMBER .GT. + & CMUMPS_STRUC_ARRAY_SIZE ) THEN + WRITE(*,*) ' ** Instance Error 1 in CMUMPS_F77', + & INSTANCE_NUMBER + CALL MUMPS_ABORT() + END IF + IF ( .NOT. associated ( mumps_par_array(INSTANCE_NUMBER)%PTR ) ) + & THEN + WRITE(*,*) ' Instance Error 2 in CMUMPS_F77', + & INSTANCE_NUMBER + CALL MUMPS_ABORT() + END IF + mumps_par => mumps_par_array(INSTANCE_NUMBER)%PTR + mumps_par%SYM = SYM + mumps_par%PAR = PAR + mumps_par%JOB = JOB + mumps_par%N = N + mumps_par%NZ = NZ + mumps_par%NZ_loc = NZ_loc + mumps_par%LWK_USER = LWK_USER + mumps_par%SIZE_SCHUR = SIZE_SCHUR + mumps_par%NELT= NELT + mumps_par%ICNTL(1:40)=ICNTL(1:40) + mumps_par%CNTL(1:15)=CNTL(1:15) + mumps_par%NRHS = NRHS + mumps_par%LRHS = LRHS + mumps_par%LREDRHS = LREDRHS + mumps_par%NZ_RHS = NZ_RHS + mumps_par%LSOL_loc = LSOL_loc + mumps_par%SCHUR_MLOC = SCHUR_MLOC + mumps_par%SCHUR_NLOC = SCHUR_NLOC + mumps_par%SCHUR_LLD = SCHUR_LLD + mumps_par%MBLOCK = MBLOCK + mumps_par%NBLOCK = NBLOCK + mumps_par%NPROW = NPROW + mumps_par%NPCOL = NPCOL + IF ( COMM_F77 .NE. -987654 ) THEN + mumps_par%COMM = COMM_F77 + ELSE + mumps_par%COMM = MPI_COMM_WORLD + ENDIF + CALL MPI_BCAST(NRHS,1,MPI_INTEGER,0,mumps_par%COMM,IERR) + IF ( IRNhere /= 0 ) mumps_par%IRN => IRN(1:NZ) + IF ( JCNhere /= 0 ) mumps_par%JCN => JCN(1:NZ) + IF ( Ahere /= 0 ) mumps_par%A => A(1:NZ) + IF ( IRN_lochere /= 0 ) mumps_par%IRN_loc => IRN_loc(1:NZ_loc) + IF ( JCN_lochere /= 0 ) mumps_par%JCN_loc => JCN_loc(1:NZ_loc) + IF ( A_lochere /= 0 ) mumps_par%A_loc => A_loc(1:NZ_loc) + IF ( ELTPTRhere /= 0 ) mumps_par%ELTPTR => ELTPTR(1:NELT+1) + IF ( ELTVARhere /= 0 ) mumps_par%ELTVAR => + & ELTVAR(1:ELTPTR(NELT+1)-1) + IF ( A_ELThere /= 0 ) THEN + A_ELT_SIZE = 0 + DO I = 1, NELT + Np = ELTPTR(I+1) -ELTPTR(I) + IF (SYM == 0) THEN + A_ELT_SIZE = A_ELT_SIZE + Np * Np + ELSE + A_ELT_SIZE = A_ELT_SIZE + Np * ( Np + 1 ) / 2 + END IF + END DO + mumps_par%A_ELT => A_ELT(1:A_ELT_SIZE) + END IF + IF ( PERM_INhere /= 0) mumps_par%PERM_IN => PERM_IN(1:N) + IF ( LISTVAR_SCHURhere /= 0) + & mumps_par%LISTVAR_SCHUR =>LISTVAR_SCHUR(1:SIZE_SCHUR) + IF ( SCHURhere /= 0 ) THEN + mumps_par%SCHUR_CINTERFACE=>SCHUR(1:1) + ENDIF + IF (NRHS .NE. 1) THEN + IF ( RHShere /= 0 ) mumps_par%RHS => RHS(1:NRHS*LRHS) + IF (REDRHShere /= 0)mumps_par%REDRHS=>REDRHS(1:NRHS*LREDRHS) + ELSE + IF ( RHShere /= 0 ) mumps_par%RHS => RHS(1:N) + IF (REDRHShere /= 0)mumps_par%REDRHS=>REDRHS(1:SIZE_SCHUR) + ENDIF + IF ( WK_USERhere /=0 ) THEN + IF (LWK_USER > 0 ) THEN + mumps_par%WK_USER => WK_USER(1:LWK_USER) + ELSE + mumps_par%WK_USER => WK_USER(1_8:-int(LWK_USER,8)*1000000_8) + ENDIF + ENDIF + IF ( COLSCAhere /= 0) mumps_par%COLSCA => COLSCA(1:N) + IF ( ROWSCAhere /= 0) mumps_par%ROWSCA => ROWSCA(1:N) + IF ( RHS_SPARSEhere /=0 ) mumps_par%RHS_SPARSE=> + & RHS_SPARSE(1:NZ_RHS) + IF ( IRHS_SPARSEhere /=0 ) mumps_par%IRHS_SPARSE=> + & IRHS_SPARSE(1:NZ_RHS) + IF ( SOL_lochere /=0 ) mumps_par%SOL_loc=> + & SOL_loc(1:LSOL_loc*NRHS) + IF ( ISOL_lochere /=0 ) mumps_par%ISOL_loc=> + & ISOL_loc(1:LSOL_loc) + IF ( IRHS_PTRhere /=0 ) mumps_par%IRHS_PTR=> + & IRHS_PTR(1:NRHS+1) + DO I=1,TMPDIRLEN + mumps_par%OOC_TMPDIR(I:I)=char(OOC_TMPDIR(I)) + ENDDO + DO I=TMPDIRLEN+1,OOC_TMPDIR_MAX_LENGTH + mumps_par%OOC_TMPDIR(I:I)=' ' + ENDDO + DO I=1,PREFIXLEN + mumps_par%OOC_PREFIX(I:I)=char(OOC_PREFIX(I)) + ENDDO + DO I=PREFIXLEN+1,OOC_PREFIX_MAX_LENGTH + mumps_par%OOC_PREFIX(I:I)=' ' + ENDDO + DO I=1,WRITE_PROBLEMLEN + mumps_par%WRITE_PROBLEM(I:I)=char(WRITE_PROBLEM(I)) + ENDDO + DO I=WRITE_PROBLEMLEN+1,PB_MAX_LENGTH + mumps_par%WRITE_PROBLEM(I:I)=' ' + ENDDO + CALL CMUMPS( mumps_par ) + INFO(1:40)=mumps_par%INFO(1:40) + INFOG(1:40)=mumps_par%INFOG(1:40) + RINFO(1:40)=mumps_par%RINFO(1:40) + RINFOG(1:40)=mumps_par%RINFOG(1:40) + ICNTL(1:40) = mumps_par%ICNTL(1:40) + CNTL(1:15) = mumps_par%CNTL(1:15) + SYM = mumps_par%SYM + PAR = mumps_par%PAR + JOB = mumps_par%JOB + N = mumps_par%N + NZ = mumps_par%NZ + NRHS = mumps_par%NRHS + LRHS = mumps_par%LRHS + LREDRHS = mumps_par%LREDRHS + NZ_loc = mumps_par%NZ_loc + NZ_RHS = mumps_par%NZ_RHS + LSOL_loc= mumps_par%LSOL_loc + SIZE_SCHUR = mumps_par%SIZE_SCHUR + LWK_USER = mumps_par%LWK_USER + NELT= mumps_par%NELT + DEFICIENCY = mumps_par%Deficiency + SCHUR_MLOC = mumps_par%SCHUR_MLOC + SCHUR_NLOC = mumps_par%SCHUR_NLOC + SCHUR_LLD = mumps_par%SCHUR_LLD + MBLOCK = mumps_par%MBLOCK + NBLOCK = mumps_par%NBLOCK + NPROW = mumps_par%NPROW + NPCOL = mumps_par%NPCOL + IF ( associated (mumps_par%MAPPING) ) THEN + CALL MUMPS_AFFECT_MAPPING(mumps_par%MAPPING(1)) + ELSE + CALL MUMPS_NULLIFY_C_MAPPING() + ENDIF + IF ( associated (mumps_par%PIVNUL_LIST) ) THEN + CALL MUMPS_AFFECT_PIVNUL_LIST(mumps_par%PIVNUL_LIST(1)) + ELSE + CALL MUMPS_NULLIFY_C_PIVNUL_LIST() + ENDIF + IF ( associated (mumps_par%SYM_PERM) ) THEN + CALL MUMPS_AFFECT_SYM_PERM(mumps_par%SYM_PERM(1)) + ELSE + CALL MUMPS_NULLIFY_C_SYM_PERM() + ENDIF + IF ( associated (mumps_par%UNS_PERM) ) THEN + CALL MUMPS_AFFECT_UNS_PERM(mumps_par%UNS_PERM(1)) + ELSE + CALL MUMPS_NULLIFY_C_UNS_PERM() + ENDIF + IF ( JOB == -2 ) THEN + IF (associated(mumps_par_array(INSTANCE_NUMBER)%PTR))THEN + DEALLOCATE(mumps_par_array(INSTANCE_NUMBER)%PTR) + NULLIFY (mumps_par_array(INSTANCE_NUMBER)%PTR) + N_INSTANCES = N_INSTANCES - 1 + IF ( N_INSTANCES == 0 ) THEN + DEALLOCATE(mumps_par_array) + CMUMPS_STRUC_ARRAY_SIZE = 0 + END IF + ELSE + WRITE(*,*) "** Warning: instance already freed" + WRITE(*,*) " this should normally not happen." + ENDIF + END IF + RETURN + END SUBROUTINE CMUMPS_F77 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part4.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part4.F new file mode 100644 index 000000000..4b250d9fc --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part4.F @@ -0,0 +1,6853 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE CMUMPS_246(MYID, N, STEP, FRERE, FILS, + & NA, LNA, NE, DAD, ND, PROCNODE, SLAVEF, + & NRLADU, NIRADU, NIRNEC, NRLNEC, + & NRLNEC_ACTIVE, + & NIRADU_OOC, NIRNEC_OOC, + & MAXFR, OPSA, + & KEEP,KEEP8, LOCAL_M, LOCAL_N, SBUF_RECOLD, + & SBUF_SEND, SBUF_REC, OPS_SUBTREE, NSTEPS, + & I_AM_CAND,NMB_PAR2, ISTEP_TO_INIV2, CANDIDATES, + & IFLAG, IERROR + & ,MAX_FRONT_SURFACE_LOCAL + & ,MAX_SIZE_FACTOR, ENTRIES_IN_FACTORS_LOC + & ,ENTRIES_IN_FACTORS_LOC_MASTERS + & ) + IMPLICIT NONE + INTEGER MYID, N, LNA, IFLAG, IERROR + INTEGER NIRADU, NIRNEC + INTEGER(8) NRLADU, NRLNEC, NRLNEC_ACTIVE + INTEGER(8) NRLADU_CURRENT, NRLADU_ROOT_3 + INTEGER NIRADU_OOC, NIRNEC_OOC + INTEGER MAXFR, NSTEPS + INTEGER(8) MAX_FRONT_SURFACE_LOCAL + INTEGER STEP(N) + INTEGER FRERE(NSTEPS), FILS(N), NA(LNA), NE(NSTEPS), + & ND(NSTEPS), PROCNODE(NSTEPS), DAD(NSTEPS) + INTEGER SLAVEF, KEEP(500), LOCAL_M, LOCAL_N + INTEGER(8) KEEP8(150) + INTEGER(8) ENTRIES_IN_FACTORS_LOC, + & ENTRIES_IN_FACTORS_LOC_MASTERS + INTEGER SBUF_SEND, SBUF_REC + INTEGER(8) SBUF_RECOLD + INTEGER NMB_PAR2 + INTEGER ISTEP_TO_INIV2( KEEP(71) ) + LOGICAL I_AM_CAND(NMB_PAR2) + INTEGER CANDIDATES( SLAVEF+1, NMB_PAR2 ) + REAL OPSA + DOUBLE PRECISION OPSA_LOC + INTEGER(8) MAX_SIZE_FACTOR + REAL OPS_SUBTREE + DOUBLE PRECISION OPS_SBTR_LOC + INTEGER, ALLOCATABLE, DIMENSION(:) :: TNSTK, IPOOL, LSTKI + INTEGER(8), ALLOCATABLE, DIMENSION(:) :: LSTKR + INTEGER(8) SBUFS_CB, SBUFR_CB + INTEGER SBUFR, SBUFS + INTEGER BLOCKING_RHS + INTEGER ITOP,NELIM,NFR + INTEGER(8) ISTKR, LSTK + INTEGER ISTKI, STKI, ISTKI_OOC + INTEGER K,NSTK, IFATH + INTEGER INODE, LEAF, NBROOT, IN + INTEGER LEVEL, MAXITEMPCB + INTEGER(8) CURRENT_ACTIVE_MEM, MAXTEMPCB + LOGICAL UPDATE, UPDATEF, MASTER, MASTERF, INSSARBR + INTEGER LEVELF, NCB, SIZECBI + INTEGER(8) NCB8 + INTEGER(8) NFR8, NELIM8 + INTEGER(8) SIZECB, SIZECBINFR, SIZECB_SLAVE + INTEGER SIZEHEADER, SIZEHEADER_OOC, XSIZE_OOC + INTEGER EXTRA_PERM_INFO_OOC + INTEGER NBROWMAX, NSLAVES_LOC, NSLAVES_PASSED, + & NELIMF, NFRF, NCBF, + & NBROWMAXF, LKJIB, + & LKJIBT, NBR, NBCOLFAC + INTEGER(8) LEV3MAXREC, CBMAXR, CBMAXS + INTEGER ALLOCOK + INTEGER PANEL_SIZE + LOGICAL COMPRESSCB + DOUBLE PRECISION OPS_NODE, OPS_NODE_MASTER, OPS_NODE_SLAVE + INTEGER(8) ENTRIES_NODE_UPPER_PART, ENTRIES_NODE_LOWER_PART + INCLUDE 'mumps_headers.h' + INTEGER WHAT + INTEGER(8) IDUMMY8 + INTRINSIC min, int, real + INTEGER CMUMPS_748 + EXTERNAL CMUMPS_748 + INTEGER MUMPS_275, MUMPS_330 + LOGICAL MUMPS_170 + INTEGER MUMPS_52 + EXTERNAL MUMPS_503, MUMPS_52 + EXTERNAL MUMPS_275, MUMPS_330, + & MUMPS_170 + logical :: FORCE_CAND, CONCERNED, UPDATES, STACKCB, MASTERSON + integer :: IFSON, LEVELSON + IF (KEEP(50).eq.2) THEN + EXTRA_PERM_INFO_OOC = 1 + ELSE IF (KEEP(50).eq.0) THEN + EXTRA_PERM_INFO_OOC = 2 + ELSE + EXTRA_PERM_INFO_OOC = 0 + ENDIF + COMPRESSCB=( KEEP(215).EQ.0 .AND. KEEP(50).NE.0 ) + MAX_FRONT_SURFACE_LOCAL=0_8 + MAX_SIZE_FACTOR=0_8 + ALLOCATE( LSTKR(NSTEPS), TNSTK(NSTEPS), IPOOL(NSTEPS), + & LSTKI(NSTEPS) , stat=ALLOCOK) + if (ALLOCOK .GT. 0) THEN + IFLAG =-7 + IERROR = 4*NSTEPS + RETURN + endif + LKJIB = max(KEEP(5),KEEP(6)) + TNSTK = NE + LEAF = NA(1)+1 + IPOOL(1:LEAF-1) = NA(3:3+LEAF-2) + NBROOT = NA(2) +#if defined(OLD_OOC_NOPANEL) + XSIZE_OOC=XSIZE_OOC_NOPANEL +#else + IF (KEEP(50).EQ.0) THEN + XSIZE_OOC=XSIZE_OOC_UNSYM + ELSE + XSIZE_OOC=XSIZE_OOC_SYM + ENDIF +#endif + SIZEHEADER_OOC = XSIZE_OOC+6 + SIZEHEADER = XSIZE_IC + 6 + ISTKR = 0_8 + ISTKI = 0 + ISTKI_OOC = 0 + OPSA_LOC = dble(0.0E0) + ENTRIES_IN_FACTORS_LOC = 0_8 + ENTRIES_IN_FACTORS_LOC_MASTERS = 0_8 + OPS_SBTR_LOC = dble(0.0E0) + NRLADU = 0_8 + NIRADU = 0 + NIRADU_OOC = 0 + NRLADU_CURRENT = 0_8 + NRLADU_ROOT_3 = 0_8 + NRLNEC_ACTIVE = 0_8 + NRLNEC = 0_8 + NIRNEC = 0 + NIRNEC_OOC = 0 + MAXFR = 0 + ITOP = 0 + MAXTEMPCB = 0_8 + MAXITEMPCB = 0 + SBUFS_CB = 1_8 + SBUFS = 1 + SBUFR_CB = 1_8 + SBUFR = 1 + IF (KEEP(38) .NE. 0 .AND. KEEP(60).EQ.0) THEN + INODE = KEEP(38) + NRLADU_ROOT_3 = int(LOCAL_M,8)*int(LOCAL_N,8) + NRLADU = NRLADU_ROOT_3 + NRLNEC_ACTIVE = NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_ROOT_3) + NRLNEC = NRLADU + IF (MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + & .EQ. MYID) THEN + NIRADU = SIZEHEADER+2*(ND(STEP(INODE))+KEEP(253)) + NIRADU_OOC = SIZEHEADER_OOC+2*(ND(STEP(INODE))+KEEP(253)) + ELSE + NIRADU = SIZEHEADER + NIRADU_OOC = SIZEHEADER_OOC + ENDIF + NIRNEC = NIRADU + NIRNEC_OOC = NIRADU_OOC + ENDIF + IF((KEEP(24).eq.0).OR.(KEEP(24).eq.1)) THEN + FORCE_CAND=.FALSE. + ELSE + FORCE_CAND=(mod(KEEP(24),2).eq.0) + END IF + 90 CONTINUE + IF (LEAF.NE.1) THEN + LEAF = LEAF - 1 + INODE = IPOOL(LEAF) + ELSE + WRITE(MYID+6,*) ' ERROR 1 in CMUMPS_246 ' + CALL MUMPS_ABORT() + ENDIF + 95 CONTINUE + NFR = ND(STEP(INODE))+KEEP(253) + NFR8 = int(NFR,8) + NSTK = NE(STEP(INODE)) + NELIM = 0 + IN = INODE + 100 NELIM = NELIM + 1 + NELIM8=int(NELIM,8) + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 100 + IFSON = -IN + IFATH = DAD(STEP(INODE)) + MASTER = MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + & .EQ. MYID + LEVEL = MUMPS_330(PROCNODE(STEP(INODE)),SLAVEF) + INSSARBR = MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF) + UPDATE=.FALSE. + if(.NOT.FORCE_CAND) then + UPDATE = ( (MASTER.AND.(LEVEL.NE.3) ).OR. LEVEL.EQ.2 ) + else + if(MASTER.and.(LEVEL.ne.3)) then + UPDATE = .TRUE. + else if(LEVEL.eq.2) then + if ( I_AM_CAND(ISTEP_TO_INIV2(STEP(INODE)))) THEN + UPDATE = .TRUE. + end if + end if + end if + NCB = NFR-NELIM + NCB8 = int(NCB,8) + SIZECBINFR = NCB8*NCB8 + IF (KEEP(50).EQ.0) THEN + SIZECB = SIZECBINFR + ELSE + IFATH = DAD(STEP(INODE)) + IF ( IFATH.NE.KEEP(38) .AND. COMPRESSCB ) THEN + SIZECB = (NCB8*(NCB8+1_8))/2_8 + ELSE + SIZECB = SIZECBINFR + ENDIF + ENDIF + SIZECBI = 2* NCB + SIZEHEADER + IF (LEVEL.NE.2) THEN + NSLAVES_LOC = -99999999 + SIZECB_SLAVE = -99999997_8 + NBROWMAX = NCB + ELSE + IF (KEEP(48) .EQ. 5) THEN + WHAT = 5 + IF (FORCE_CAND) THEN + NSLAVES_LOC=CANDIDATES(SLAVEF+1, + & ISTEP_TO_INIV2(STEP(INODE))) + ELSE + NSLAVES_LOC=SLAVEF-1 + ENDIF + NSLAVES_PASSED=NSLAVES_LOC + ELSE + WHAT = 2 + NSLAVES_PASSED=SLAVEF + NSLAVES_LOC =SLAVEF-1 + ENDIF + CALL MUMPS_503(WHAT, KEEP,KEEP8, + & NCB, NFR, NSLAVES_PASSED, NBROWMAX, SIZECB_SLAVE + & ) + ENDIF + IF (KEEP(60).GT.1) THEN + IF (MASTER .AND. INODE.EQ.KEEP(38)) THEN + NIRADU = NIRADU+SIZEHEADER+2*(ND(STEP(INODE))+KEEP(253)) + NIRADU_OOC = NIRADU_OOC+SIZEHEADER_OOC+ + & 2*(ND(STEP(INODE))+KEEP(253)) + ENDIF + ENDIF + IF (LEVEL.EQ.3) THEN + IF ( + & KEEP(60).LE.1 + & ) THEN + NRLNEC = max(NRLNEC,NRLADU+ISTKR+ + & int(LOCAL_M,8)*int(LOCAL_N,8)) + NRLADU_CURRENT = int(LOCAL_M,8)*int(LOCAL_N,8) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_ROOT_3 + + & NRLADU_CURRENT+ISTKR) + ENDIF + IF (MASTER) THEN + IF (NFR.GT.MAXFR) MAXFR = NFR + ENDIF + ENDIF + IF(KEEP(86).EQ.1)THEN + IF(MASTER.AND.(.NOT.MUMPS_170( + & PROCNODE(STEP(INODE)), SLAVEF)) + & )THEN + IF(LEVEL.EQ.1)THEN + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NFR8*NFR8) + ELSEIF(LEVEL.EQ.2)THEN + IF(KEEP(50).EQ.0)THEN + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NFR8*NELIM8) + ELSE + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NELIM8*NELIM8) + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NELIM8*(NELIM8+1_8)) + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + IF (LEVEL.EQ.2) THEN + IF (MASTER) THEN + IF (KEEP(50).EQ.0) THEN + SBUFS = max(SBUFS, NFR*LKJIB+LKJIB+4) + ELSE + SBUFS = max(SBUFS, NELIM*LKJIB+NELIM+6) + ENDIF + ELSEIF (UPDATE) THEN + if (KEEP(50).EQ.0) THEN + SBUFR = max(SBUFR, NFR*LKJIB+LKJIB+4) + else + SBUFR = max( SBUFR, NELIM*LKJIB+NELIM+6 ) + IF (KEEP(50).EQ.1) THEN + LKJIBT = LKJIB + ELSE + LKJIBT = min( NELIM, LKJIB * 2 ) + ENDIF + SBUFS = max(SBUFS, + & LKJIBT*NBROWMAX+6) + SBUFR = max( SBUFR, NBROWMAX*LKJIBT+6 ) + endif + ENDIF + ENDIF + IF ( UPDATE ) THEN + IF ( (MASTER) .AND. (LEVEL.EQ.1) ) THEN + NIRADU = NIRADU + 2*NFR + SIZEHEADER + NIRADU_OOC = NIRADU_OOC + 2*NFR + SIZEHEADER_OOC + PANEL_SIZE = CMUMPS_748( + & 2_8*int(KEEP(226),8), NFR, KEEP(227), KEEP(50)) + NIRADU_OOC = NIRADU_OOC + + & EXTRA_PERM_INFO_OOC*(2+NELIM + NELIM/PANEL_SIZE+1) + IF (KEEP(50).EQ.0) THEN + NRLADU_CURRENT = int(NELIM,8)*int(2*NFR-NELIM,8) + NRLADU = NRLADU + NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + ELSE + NRLADU_CURRENT = int(NELIM,8)*int(NFR,8) + NRLADU = NRLADU + NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + ENDIF + SIZECBI = 2* NCB + 6 + 3 + ELSEIF (LEVEL.EQ.2) THEN + IF (MASTER) THEN + NIRADU = NIRADU+SIZEHEADER +SLAVEF-1+2*NFR + NIRADU_OOC = NIRADU_OOC+SIZEHEADER_OOC +SLAVEF-1+2*NFR + IF (KEEP(50).EQ.0) THEN + NBCOLFAC=NFR + ELSE + NBCOLFAC=NELIM + ENDIF + PANEL_SIZE = CMUMPS_748( + & 2_8*int(KEEP(226),8), NBCOLFAC, KEEP(227), KEEP(50)) + NIRADU_OOC = NIRADU_OOC + + & EXTRA_PERM_INFO_OOC*(2+NELIM + NELIM/PANEL_SIZE+1) + NRLADU_CURRENT = int(NBCOLFAC,8)*int(NELIM,8) + NRLADU = NRLADU + NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + SIZECB = 0_8 + SIZECBINFR = 0_8 + SIZECBI = NCB + 5 + SLAVEF - 1 + ELSE + SIZECB=SIZECB_SLAVE + SIZECBINFR = SIZECB + NIRADU = NIRADU+4+NELIM+NBROWMAX + NIRADU_OOC = NIRADU_OOC+4+NELIM+NBROWMAX + IF (KEEP(50).EQ.0) THEN + NRLADU = NRLADU + int(NELIM,8)*int(NBROWMAX,8) + ELSE + NRLADU = NRLADU + int(NELIM,8)*int(NCB/NSLAVES_LOC,8) + ENDIF + NRLADU_CURRENT = int(NELIM,8)*int(NBROWMAX,8) + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + SIZECBI = 4 + NBROWMAX + NCB + IF (KEEP(50).NE.0) THEN + SIZECBI=SIZECBI+NSLAVES_LOC+ + & XTRA_SLAVES_SYM + ELSE + SIZECBI=SIZECBI+NSLAVES_LOC+ + & XTRA_SLAVES_UNSYM + ENDIF + ENDIF + ENDIF + NIRNEC = max0(NIRNEC, + & NIRADU+ISTKI+SIZECBI+MAXITEMPCB) + NIRNEC_OOC = max0(NIRNEC_OOC, + & NIRADU_OOC+ISTKI_OOC+SIZECBI+MAXITEMPCB + + & (XSIZE_OOC-XSIZE_IC) ) + CURRENT_ACTIVE_MEM = ISTKR+SIZECBINFR + IF (NSTK .NE. 0 .AND. INSSARBR .AND. + & KEEP(234).NE.0 .AND. KEEP(55).EQ.0) THEN + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM - LSTKR(ITOP) + ENDIF + IF (KEEP(50).NE.0.AND.UPDATE.AND.LEVEL.EQ.1) THEN + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM + + & int(NELIM,8)*int(NCB,8) + ENDIF + IF (MASTER .AND. KEEP(219).NE.0.AND. + & KEEP(50).EQ.2.AND.LEVEL.EQ.2) THEN + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM + int(NELIM,8) + ENDIF + IF (SLAVEF.EQ.1) THEN + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM) + ELSE + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+MAXTEMPCB) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM+MAXTEMPCB) + ENDIF + IF (NFR.GT.MAXFR) MAXFR = NFR + IF (NSTK.GT.0) THEN + DO 70 K=1,NSTK + LSTK = LSTKR(ITOP) + ISTKR = ISTKR - LSTK + IF (K==1 .AND. INSSARBR.AND.KEEP(234).NE.0 + & .AND.KEEP(55).EQ.0) THEN + ELSE + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM - LSTK + ENDIF + STKI = LSTKI( ITOP ) + ISTKI = ISTKI - STKI + ISTKI_OOC = ISTKI_OOC - STKI - (XSIZE_OOC-XSIZE_IC) + ITOP = ITOP - 1 + IF (ITOP.LT.0) THEN + write(*,*) MYID, + & ': ERROR 2 in CMUMPS_246. ITOP = ',ITOP + CALL MUMPS_ABORT() + ENDIF + 70 CONTINUE + ENDIF + ELSE IF (LEVEL.NE.3) THEN + DO WHILE (IFSON.GT.0) + UPDATES=.FALSE. + MASTERSON = MUMPS_275(PROCNODE(STEP(IFSON)),SLAVEF) + & .EQ.MYID + LEVELSON = MUMPS_330(PROCNODE(STEP(IFSON)),SLAVEF) + if(.NOT.FORCE_CAND) then + UPDATES =((MASTERSON.AND.(LEVELSON.NE.3)).OR. + & LEVELSON.EQ.2) + else + if(MASTERSON.and.(LEVELSON.ne.3)) then + UPDATES = .TRUE. + else if(LEVELSON.eq.2) then + if ( I_AM_CAND(ISTEP_TO_INIV2(STEP(IFSON)))) then + UPDATES = .TRUE. + end if + end if + end if + IF (UPDATES) THEN + LSTK = LSTKR(ITOP) + ISTKR = ISTKR - LSTK + STKI = LSTKI( ITOP ) + ISTKI = ISTKI - STKI + ISTKI_OOC = ISTKI_OOC - STKI - (XSIZE_OOC-XSIZE_IC) + ITOP = ITOP - 1 + IF (ITOP.LT.0) THEN + write(*,*) MYID, + & ': ERROR 2 in CMUMPS_246. ITOP = ',ITOP + CALL MUMPS_ABORT() + ENDIF + ENDIF + IFSON = FRERE(STEP(IFSON)) + END DO + ENDIF + IF ( + & ( (INODE.NE.KEEP(20)).OR.(KEEP(60).EQ.0) ) + & .AND. + & ( (INODE.NE.KEEP(38)).OR.(KEEP(60).LE.1) ) + & ) + &THEN + ENTRIES_NODE_LOWER_PART = int(NFR-NELIM,8) * int(NELIM,8) + IF ( KEEP(50).EQ.0 ) THEN + ENTRIES_NODE_UPPER_PART = int(NFR,8) * int(NELIM,8) + ELSE + ENTRIES_NODE_UPPER_PART = + & (int(NELIM,8)*int(NELIM+1,8))/2_8 + ENDIF + IF (KEEP(50).EQ.2 .AND. LEVEL.EQ.3) THEN + CALL MUMPS_511(NFR, + & NELIM, NELIM,0, + & 1,OPS_NODE) + ELSE + CALL MUMPS_511(NFR, + & NELIM, NELIM,KEEP(50), + & 1,OPS_NODE) + ENDIF + IF (LEVEL.EQ.2) THEN + CALL MUMPS_511(NFR, + & NELIM, NELIM,KEEP(50), + & 2,OPS_NODE_MASTER) + OPS_NODE_SLAVE=OPS_NODE-OPS_NODE_MASTER + ENDIF + ELSE + OPS_NODE = 0.0D0 + ENTRIES_NODE_UPPER_PART = 0_8 + ENTRIES_NODE_LOWER_PART = 0_8 + ENDIF + IF ( MASTER ) + & ENTRIES_IN_FACTORS_LOC_MASTERS = + & ENTRIES_IN_FACTORS_LOC_MASTERS + + & ENTRIES_NODE_UPPER_PART + + & ENTRIES_NODE_LOWER_PART + IF (UPDATE.OR.LEVEL.EQ.3) THEN + IF ( LEVEL .EQ. 3 ) THEN + OPSA_LOC = OPSA_LOC + OPS_NODE / dble( SLAVEF ) + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & ENTRIES_NODE_UPPER_PART / + & int(SLAVEF,8) + IF (MASTER) + & ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & mod(ENTRIES_NODE_UPPER_PART, + & int(SLAVEF,8)) + ELSE IF (MASTER .AND. LEVEL.EQ.2) THEN + OPSA_LOC = OPSA_LOC + OPS_NODE_MASTER + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & ENTRIES_NODE_UPPER_PART + + & mod(ENTRIES_NODE_LOWER_PART, + & int(NSLAVES_LOC,8)) + ELSE IF (MASTER .AND. LEVEL.EQ.1) THEN + OPSA_LOC = OPSA_LOC + dble(OPS_NODE) + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & ENTRIES_NODE_UPPER_PART + + & ENTRIES_NODE_LOWER_PART + ELSE IF (UPDATE) THEN + OPSA_LOC = OPSA_LOC + + & dble(OPS_NODE_SLAVE)/dble(NSLAVES_LOC) + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + & + ENTRIES_NODE_LOWER_PART / + & int(NSLAVES_LOC,8) + ENDIF + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF) .OR. NE(STEP(INODE))==0) THEN + IF (LEVEL == 1) THEN + OPS_SBTR_LOC = OPS_SBTR_LOC + OPS_NODE + ELSE + CALL MUMPS_511(NFR, + & NELIM, NELIM,KEEP(50), + & 1,OPS_NODE) + OPS_SBTR_LOC = OPS_SBTR_LOC + OPS_NODE + ENDIF + ENDIF + ENDIF + IF (IFATH .EQ. 0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 115 + GOTO 90 + ELSE + NFRF = ND(STEP(IFATH))+KEEP(253) + IF (DAD(STEP(IFATH)).EQ.0) THEN + NELIMF = NFRF + ELSE + NELIMF = 0 + IN = IFATH + DO WHILE (IN.GT.0) + IN = FILS(IN) + NELIMF = NELIMF+1 + ENDDO + ENDIF + NCBF = NFRF - NELIMF + LEVELF = MUMPS_330(PROCNODE(STEP(IFATH)),SLAVEF) + MASTERF= MUMPS_275(PROCNODE(STEP(IFATH)),SLAVEF).EQ.MYID + UPDATEF= .FALSE. + if(.NOT.FORCE_CAND) then + UPDATEF= ((MASTERF.AND.(LEVELF.NE.3)).OR.LEVELF.EQ.2) + else + if(MASTERF.and.(LEVELF.ne.3)) then + UPDATEF = .TRUE. + else if (LEVELF.eq.2) then + if ( I_AM_CAND(ISTEP_TO_INIV2(STEP(IFATH)))) THEN + UPDATEF = .TRUE. + end if + end if + end if + CONCERNED = UPDATEF .OR. UPDATE + IF (LEVELF .NE. 2) THEN + NBROWMAXF = -999999 + ELSE + IF (KEEP(48) .EQ. 5) THEN + WHAT = 4 + IF (FORCE_CAND) THEN + NSLAVES_LOC=CANDIDATES(SLAVEF+1, + & ISTEP_TO_INIV2(STEP(IFATH))) + ELSE + NSLAVES_LOC=SLAVEF-1 + ENDIF + ELSE + WHAT = 1 + NSLAVES_LOC=SLAVEF + ENDIF + CALL MUMPS_503( WHAT, KEEP, KEEP8, + & NCBF, NFRF, NSLAVES_LOC, NBROWMAXF, IDUMMY8 + & ) + ENDIF + IF(LEVEL.EQ.1.AND.UPDATE.AND. + & (UPDATEF.OR.LEVELF.EQ.2) + & .AND.LEVELF.NE.3) THEN + IF ( INSSARBR .AND. KEEP(234).NE.0) THEN + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM) + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM) + ELSE + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM+SIZECB) + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+SIZECB) + ENDIF + ENDIF + IF (UPDATE .AND. LEVEL.EQ.2 .AND. .NOT. MASTER) THEN + NRLNEC = + & max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+NRLADU_CURRENT) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,2_8*NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM) + ENDIF + IF (LEVELF.EQ.3) THEN + IF (LEVEL.EQ.1) THEN + LEV3MAXREC = int(min(NCB,LOCAL_M),8) * + & int(min(NCB,LOCAL_N),8) + ELSE + LEV3MAXREC = min(SIZECB, + & int(min(NBROWMAX,LOCAL_M),8) + & *int(min(NCB,LOCAL_N),8)) + ENDIF + MAXTEMPCB = max(MAXTEMPCB, LEV3MAXREC) + MAXITEMPCB = max(MAXITEMPCB,SIZECBI+SIZEHEADER) + SBUFR_CB = max(SBUFR_CB, LEV3MAXREC+int(SIZECBI,8)) + NIRNEC = max(NIRNEC,NIRADU+ISTKI+ + & min(NCB,LOCAL_M)+ min(NCB,LOCAL_N)+SIZEHEADER) + NIRNEC_OOC = max(NIRNEC_OOC,NIRADU_OOC+ISTKI_OOC+ + & min(NCB,LOCAL_M)+ min(NCB,LOCAL_N)+SIZEHEADER) + ENDIF + IF (CONCERNED) THEN + IF (LEVELF.EQ.2) THEN + IF (UPDATE.AND.(LEVEL.NE.2.OR..NOT.MASTER)) THEN + IF(MASTERF)THEN + NBR = min(NBROWMAXF,NBROWMAX) + ELSE + NBR = min(max(NELIMF,NBROWMAXF),NBROWMAX) + ENDIF + IF (KEEP(50).EQ.0) THEN + CBMAXS = int(NBR,8)*int(NCB,8) + ELSE + CBMAXS = int(NBR,8)*int(NCB,8) - + & (int(NBR,8)*int(NBR-1,8))/2_8 + ENDIF + ELSE + CBMAXS = 0_8 + END IF + IF (MASTERF) THEN + IF (LEVEL.EQ.1) THEN + IF (.NOT.UPDATE) THEN + NBR = min(NELIMF, NCB) + ELSE + NBR = 0 + ENDIF + ELSE + NBR = min(NELIMF, NBROWMAX) + ENDIF + IF (KEEP(50).EQ.0) THEN + CBMAXR = int(NBR,8)*NCB8 + ELSE + CBMAXR = int(NBR,8)*int(min(NCB,NELIMF),8)- + & (int(NBR,8)*int(NBR-1,8))/2_8 + CBMAXR = min(CBMAXR, int(NELIMF,8)*int(NELIMF+1,8)/2_8) + CBMAXR = min(CBMAXR, SIZECB) + IF ((LEVEL.EQ.1).AND.(.NOT. COMPRESSCB)) THEN + CBMAXR = min(CBMAXR,(NCB8*(NCB8+1_8))/2_8) + ENDIF + ENDIF + ELSE IF (UPDATEF) THEN + NBR = min(NBROWMAXF,NBROWMAX) + CBMAXR = int(NBR,8) * NCB8 + IF (KEEP(50).NE.0) THEN + CBMAXR = CBMAXR - (int(NBR,8)*(int(NBR-1,8)))/2_8 + ENDIF + ELSE + CBMAXR = 0_8 + ENDIF + ELSEIF (LEVELF.EQ.3) THEN + CBMAXR = LEV3MAXREC + IF (UPDATE.AND. .NOT. (MASTER.AND.LEVEL.EQ.2)) THEN + CBMAXS = LEV3MAXREC + ELSE + CBMAXS = 0_8 + ENDIF + ELSE + IF (MASTERF) THEN + CBMAXS = 0_8 + NBR = min(NFRF,NBROWMAX) + IF ((LEVEL.EQ.1).AND.UPDATE) THEN + NBR = 0 + ENDIF + CBMAXR = int(NBR,8)*int(min(NFRF,NCB),8) + IF (LEVEL.EQ.2) + & CBMAXR = min(CBMAXR, SIZECB_SLAVE) + IF ( KEEP(50).NE.0 ) THEN + CBMAXR = min(CBMAXR,(int(NFRF,8)*int(NFRF+1,8))/2_8) + ELSE + CBMAXR = min(CBMAXR,int(NFRF,8)*int(NFRF,8)) + ENDIF + ELSE + CBMAXR = 0_8 + CBMAXS = SIZECB + ENDIF + ENDIF + IF (UPDATE) THEN + CBMAXS = min(CBMAXS, SIZECB) + IF ( .not. ( LEVELF .eq. 1 .AND. UPDATEF ) )THEN + SBUFS_CB = max(SBUFS_CB, CBMAXS+int(SIZECBI,8)) + ENDIF + ENDIF + STACKCB = .FALSE. + IF (UPDATEF) THEN + STACKCB = .TRUE. + SIZECBI = 2 * NFR + SIZEHEADER + IF (LEVEL.EQ.1) THEN + IF (KEEP(50).NE.0.AND.LEVELF.NE.3 + & .AND.COMPRESSCB) THEN + SIZECB = (NCB8*(NCB8+1_8))/2_8 + ELSE + SIZECB = NCB8*NCB8 + ENDIF + IF (MASTER) THEN + SIZECBI = 2+ XSIZE_IC + ELSE IF (LEVELF.EQ.1) THEN + SIZECB = min(CBMAXR,SIZECB) + SIZECBI = 2 * NCB + 9 + SBUFR_CB = max(SBUFR_CB, int(SIZECBI,8)+SIZECB) + SIZECBI = 2 * NCB + SIZEHEADER + ELSE + SIZECBI = 2 * NCB + 9 + SBUFR_CB = max(SBUFR_CB, + & min(SIZECB,CBMAXR) + int(SIZECBI,8)) + MAXTEMPCB = max(MAXTEMPCB, min(SIZECB,CBMAXR)) + SIZECBI = 2 * NCB + SIZEHEADER + MAXITEMPCB = max(MAXITEMPCB, SIZECBI) + SIZECBI = 0 + SIZECB = 0_8 + ENDIF + ELSE + SIZECB = SIZECB_SLAVE + MAXTEMPCB = max(MAXTEMPCB, min(CBMAXR,SIZECB) ) + MAXITEMPCB = max(MAXITEMPCB,NBROWMAX+NCB+SIZEHEADER) + IF (.NOT. + & (UPDATE.AND.(.NOT.MASTER).AND.(NSLAVES_LOC.EQ.1)) + & ) + & SBUFR_CB = max(SBUFR_CB, + & min(CBMAXR,SIZECB) + int(NBROWMAX + NCB + 6,8)) + IF (MASTER) THEN + SIZECBI = NCB + 5 + SLAVEF - 1 + XSIZE_IC + SIZECB = 0_8 + ELSE IF (UPDATE) THEN + SIZECBI = NFR + 6 + SLAVEF - 1 + XSIZE_IC + IF (KEEP(50).EQ.0) THEN + SIZECBI = SIZECBI + NBROWMAX + NFR + + & SIZEHEADER + ELSE + SIZECBI = SIZECBI + NBROWMAX + NFR + + & SIZEHEADER+ NSLAVES_LOC + ENDIF + ELSE + SIZECB = 0_8 + SIZECBI = 0 + ENDIF + ENDIF + ELSE + IF (LEVELF.NE.3) THEN + STACKCB = .TRUE. + SIZECB = 0_8 + SIZECBI = 0 + IF ( (LEVEL.EQ.1) .AND. (LEVELF.NE.1) ) THEN + IF (COMPRESSCB) THEN + SIZECB = (NCB8*(NCB8+1_8))/2_8 + ELSE + SIZECB = NCB8*NCB8 + ENDIF + SIZECBI = 2 * NCB + SIZEHEADER + ELSE IF (LEVEL.EQ.2) THEN + IF (MASTER) THEN + SIZECBI = NCB + 5 + SLAVEF - 1 + XSIZE_IC + ELSE + SIZECB = SIZECB_SLAVE + SIZECBI = SIZECBI + NBROWMAX + NFR + SIZEHEADER + ENDIF + ENDIF + ENDIF + ENDIF + IF (STACKCB) THEN + IF (FRERE(STEP(INODE)).EQ.0) THEN + write(*,*) ' ERROR 3 in CMUMPS_246' + CALL MUMPS_ABORT() + ENDIF + ITOP = ITOP + 1 + IF ( ITOP .GT. NSTEPS ) THEN + WRITE(*,*) 'ERROR 4 in CMUMPS_246 ' + ENDIF + LSTKI(ITOP) = SIZECBI + ISTKI=ISTKI + SIZECBI + ISTKI_OOC = ISTKI_OOC + SIZECBI + (XSIZE_OOC-XSIZE_IC) + LSTKR(ITOP) = SIZECB + ISTKR = ISTKR + LSTKR(ITOP) + NRLNEC = max(NRLNEC,NRLADU+ISTKR+MAXTEMPCB) + NIRNEC = max0(NIRNEC,NIRADU+ISTKI+MAXITEMPCB) + NIRNEC_OOC = max0(NIRNEC_OOC,NIRADU_OOC+ISTKI_OOC+ + & MAXITEMPCB + + & (XSIZE_OOC-XSIZE_IC) ) + ENDIF + ENDIF + TNSTK(STEP(IFATH)) = TNSTK(STEP(IFATH)) - 1 + IF ( TNSTK(STEP(IFATH)) .EQ. 0 ) THEN + INODE = IFATH + GOTO 95 + ELSE + GOTO 90 + ENDIF + ENDIF + 115 CONTINUE + BLOCKING_RHS = KEEP(84) + IF (KEEP(84).EQ.0) BLOCKING_RHS=1 + NRLNEC = max(NRLNEC, + & NRLADU+int(4*KEEP(127)*abs(BLOCKING_RHS),8)) + IF (BLOCKING_RHS .LT. 0) THEN + BLOCKING_RHS = - 2 * BLOCKING_RHS + ENDIF + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE, MAX_SIZE_FACTOR+ + & int(4*KEEP(127)*BLOCKING_RHS,8)) + SBUF_RECOLD = max(int(SBUFR,8),SBUFR_CB) + SBUF_RECOLD = max(SBUF_RECOLD, + & MAXTEMPCB+int(MAXITEMPCB,8)) + 10_8 + SBUF_REC = max(SBUFR, int(min(100000_8,SBUFR_CB))) + SBUF_REC = SBUF_REC + 17 + SBUF_REC = SBUF_REC + 2 * KEEP(127) + SLAVEF - 1 + 7 + SBUF_SEND = max(SBUFS, int(min(100000_8,SBUFR_CB))) + SBUF_SEND = SBUF_SEND + 17 + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN + SBUF_RECOLD = SBUF_RECOLD+int(KEEP(108)+1,8) + SBUF_REC = SBUF_REC+KEEP(108)+1 + SBUF_SEND = SBUF_SEND+KEEP(108)+1 + ENDIF + IF (SLAVEF.EQ.1) THEN + SBUF_RECOLD = 1_8 + SBUF_REC = 1 + SBUF_SEND= 1 + ENDIF + DEALLOCATE( LSTKR, TNSTK, IPOOL, + & LSTKI ) + OPS_SUBTREE = real(OPS_SBTR_LOC) + OPSA = real(OPSA_LOC) + KEEP(66) = int(OPSA_LOC/1000000.d0) + RETURN + END SUBROUTINE CMUMPS_246 + RECURSIVE SUBROUTINE + & CMUMPS_271( COMM_LOAD, ASS_IRECV, + & INODE, NELIM_ROOT, root, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mpif.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER KEEP(500), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER INODE, NELIM_ROOT + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS(KEEP(28)) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX DBLARR(max(1,KEEP(13))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mumps_tags.h' + INTEGER I, LCONT, NCOL_TO_SEND, LDA + INTEGER(8) :: SHIFT_VAL_SON, POSELT + INTEGER FPERE, IOLDPS, NFRONT, NPIV, NASS, NSLAVES, + & H_INODE, NELIM, NBCOL, LIST_NELIM_ROW, + & LIST_NELIM_COL, NELIM_LOCAL, TYPE_SON, + & NROW, NCOL, NBROW, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON, LDAFS, IERR, + & STATUS( MPI_STATUS_SIZE ), ISON, PDEST_MASTER_ISON + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER MSGSOU, MSGTAG + LOGICAL INVERT + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275, MUMPS_330 + EXTERNAL MUMPS_275, MUMPS_330 + FPERE = KEEP(38) + TYPE_SON = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF ( MUMPS_275( PROCNODE_STEPS(STEP(INODE)), + & SLAVEF ).EQ.MYID) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + H_INODE = 6 + NSLAVES + KEEP(IXSZ) + NELIM = NASS - NPIV + NBCOL = NFRONT - NPIV + LIST_NELIM_ROW = IOLDPS + H_INODE + NPIV + LIST_NELIM_COL = LIST_NELIM_ROW + NFRONT + IF (NELIM.LE.0) THEN + write(6,*) ' ERROR 1 in CMUMPS_271 ', NELIM + write(6,*) MYID,':Process root2son: INODE=',INODE, + & 'Header=',IW(PTLUST_S(STEP(INODE)):PTLUST_S(STEP(INODE)) + & +5+KEEP(IXSZ)) + CALL MUMPS_ABORT() + ENDIF + NELIM_LOCAL = NELIM_ROOT + DO I=1, NELIM + root%RG2L_ROW(IW(LIST_NELIM_ROW)) = NELIM_LOCAL + root%RG2L_COL(IW(LIST_NELIM_COL)) = NELIM_LOCAL + NELIM_LOCAL = NELIM_LOCAL + 1 + LIST_NELIM_ROW = LIST_NELIM_ROW + 1 + LIST_NELIM_COL = LIST_NELIM_COL + 1 + ENDDO + NBROW = NFRONT - NPIV + NROW = NELIM + IF ( KEEP( 50 ) .eq. 0 ) THEN + NCOL = NFRONT - NPIV + ELSE + NCOL = NELIM + END IF + SHIFT_LIST_ROW_SON = H_INODE + NPIV + SHIFT_LIST_COL_SON = H_INODE + NFRONT + NPIV + IF ( KEEP(50).eq.0 .OR. TYPE_SON .eq. 1 ) THEN + LDAFS = NFRONT + ELSE + LDAFS = NASS + END IF + SHIFT_VAL_SON = int(NPIV,8) * int(LDAFS,8) + int(NPIV,8) + CALL CMUMPS_80( COMM_LOAD, + & ASS_IRECV, + & N, INODE, FPERE, + & PTLUST_S(1), PTRAST(1), + & root, NROW, NCOL, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDAFS, + & ROOT_NON_ELIM_CB, MYID, COMM, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S(1), PTRFAC(1), PTRAST(1), + & STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0 ) RETURN + IF (TYPE_SON.EQ.1) THEN + NROW = NFRONT - NASS + NCOL = NELIM + SHIFT_LIST_ROW_SON = H_INODE + NASS + SHIFT_LIST_COL_SON = H_INODE + NFRONT + NPIV + SHIFT_VAL_SON = int(NASS,8) * int(NFRONT,8) + int(NPIV,8) + IF ( KEEP( 50 ) .eq. 0 ) THEN + INVERT = .FALSE. + ELSE + INVERT = .TRUE. + END IF + CALL CMUMPS_80( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTLUST_S, PTRAST, + & root, NROW, NCOL, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT, + & ROOT_NON_ELIM_CB, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0 ) RETURN + ENDIF + IOLDPS = PTLUST_S(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) + PTRFAC(STEP(INODE))=POSELT + IF ( TYPE_SON .eq. 1 ) THEN + NBROW = NFRONT - NPIV + ELSE + NBROW = NELIM + END IF + IF ( TYPE_SON .eq. 1 .OR. KEEP(50).EQ.0) THEN + LDA = NFRONT + ELSE + LDA = NPIV+NBROW + ENDIF + CALL CMUMPS_324(A(POSELT), LDA, + & NPIV, NBROW, KEEP(50)) + IW(IOLDPS + KEEP(IXSZ)) = NBCOL + IW(IOLDPS + 1 +KEEP(IXSZ)) = NASS - NPIV + IF (TYPE_SON.EQ.2) THEN + IW(IOLDPS + 2 +KEEP(IXSZ)) = NASS + ELSE + IW(IOLDPS + 2 +KEEP(IXSZ)) = NFRONT + ENDIF + IW(IOLDPS + 3 +KEEP(IXSZ)) = NPIV + CALL CMUMPS_93(0_8,MYID,N,IOLDPS,TYPE_SON,IW,LIW, + & A, LA, POSFAC, LRLU, LRLUS, + & IWPOS, PTRAST,PTRFAC,STEP, KEEP,KEEP8, .FALSE.,INODE,IERR) + IF(IERR.LT.0)THEN + IFLAG=IERR + IERROR=0 + RETURN + ENDIF + ELSE + ISON = INODE + PDEST_MASTER_ISON = + & MUMPS_275(PROCNODE_STEPS(STEP(ISON)), SLAVEF) + DO WHILE ( PTRIST(STEP(ISON)) .EQ. 0) + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & PDEST_MASTER_ISON, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) RETURN + ENDDO + DO WHILE ( + & ( IW( PTRIST(STEP(ISON)) + 1 +KEEP(IXSZ)) .NE. + & IW( PTRIST(STEP(ISON)) + 3 +KEEP(IXSZ)) ) .OR. + & ( KEEP(50) .NE. 0 .AND. + & IW( PTRIST(STEP(ISON)) + 6 +KEEP(IXSZ)) .NE. 0 ) ) + IF ( KEEP(50).eq.0) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO + ELSE + IF ( IW( PTRIST(STEP(ISON)) + 1 +KEEP(IXSZ)) .NE. + & IW( PTRIST(STEP(ISON)) + 3 +KEEP(IXSZ)) ) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO_SYM + ELSE + MSGSOU = MPI_ANY_SOURCE + MSGTAG = BLOC_FACTO_SYM_SLAVE + END IF + END IF + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MSGTAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) RETURN + END DO + IOLDPS = PTRIST(STEP(INODE)) + LCONT = IW(IOLDPS+KEEP(IXSZ)) + NROW = IW(IOLDPS+2+KEEP(IXSZ)) + NPIV = IW(IOLDPS+3+KEEP(IXSZ)) + NASS = IW(IOLDPS+4+KEEP(IXSZ)) + NELIM = NASS-NPIV + IF (NELIM.LE.0) THEN + write(6,*) MYID,': INODE,LCONT, NROW, NPIV, NASS, NELIM=', + & INODE,LCONT, NROW, NPIV, NASS, NELIM + write(6,*) MYID,': IOLDPS=',IOLDPS + write(6,*) MYID,': ERROR 2 in CMUMPS_271 ' + CALL MUMPS_ABORT() + ENDIF + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + H_INODE = 6 + NSLAVES + KEEP(IXSZ) + LIST_NELIM_COL = IOLDPS + H_INODE + NROW + NPIV + NELIM_LOCAL = NELIM_ROOT + DO I = 1, NELIM + root%RG2L_COL(IW(LIST_NELIM_COL)) = NELIM_LOCAL + root%RG2L_ROW(IW(LIST_NELIM_COL)) = NELIM_LOCAL + NELIM_LOCAL = NELIM_LOCAL + 1 + LIST_NELIM_COL = LIST_NELIM_COL + 1 + ENDDO + SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NPIV + NCOL_TO_SEND = NELIM + IF (IW(IOLDPS+XXS).EQ.S_NOLCBNOCONTIG38.OR. + & IW(IOLDPS+XXS).EQ.S_ALL) THEN + SHIFT_VAL_SON = int(NPIV,8) + LDA = LCONT + NPIV + ELSE IF (IW(IOLDPS+XXS).EQ.S_NOLCBCONTIG38) THEN + SHIFT_VAL_SON = int(NROW,8)*int(LCONT+NPIV-NELIM,8) + LDA = NELIM + ELSE IF (IW(IOLDPS+XXS).EQ.S_NOLCLEANED38) THEN + SHIFT_VAL_SON=0_8 + LDA = NELIM + ELSE + write(*,*) MYID,": internal error in CMUMPS_271", + & IW(IOLDPS+XXS), "INODE=",INODE + CALL MUMPS_ABORT() + ENDIF + IF ( KEEP( 50 ) .eq. 0 ) THEN + INVERT = .FALSE. + ELSE + INVERT = .TRUE. + END IF + CALL CMUMPS_80( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTRIST, PTRAST, + & root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA, + & ROOT_NON_ELIM_CB, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0 ) RETURN + IF (KEEP(214).EQ.2) THEN + CALL CMUMPS_314( N, INODE, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, TYPE_SON + & ) + ENDIF + IF (IFLAG.LT.0) THEN + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_271 + SUBROUTINE CMUMPS_221(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IFLAG,IOLDPS,POSELT,UU, SEUIL,KEEP,KEEP8, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & + & PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV,NOFFW + INTEGER(8) :: LA + COMPLEX A(LA) + REAL UU, SEUIL + INTEGER IW(LIW) + INTEGER(8) :: POSELT + INTEGER IOLDPS + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U + INCLUDE 'mumps_headers.h' + COMPLEX SWOP + INTEGER XSIZE + INTEGER(8) :: APOS, IDIAG + INTEGER(8) :: J1, J2, J3, JJ + INTEGER(8) :: NFRONT8 + REAL AMROW + REAL RMAX + REAL PIVNUL + COMPLEX FIXA, CSEUIL + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,JMAX,J,ISW,ISWPS1 + INTEGER ISWPS2,KSW + INTEGER CMUMPS_IXAMAX + INTRINSIC max + REAL, PARAMETER :: RZERO = 0.0E0 + COMPLEX, PARAMETER :: ZERO = (0.0E0, 0.0E0) + INTEGER I_PIVRPTR_L, I_PIVR_L, NBPANELS_L + INTEGER I_PIVRPTR_U, I_PIVR_U, NBPANELS_U + PIVNUL = DKEEP(1) + FIXA = cmplx( DKEEP(2), kind=kind(FIXA)) + CSEUIL = cmplx( SEUIL, kind=kind(CSEUIL)) + XSIZE = KEEP(IXSZ) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NFRONT8 = int(NFRONT,8) + IF (KEEP(201).EQ.1) THEN + CALL CMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + CALL CMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + ENDIF + NASSW = iabs(IW(IOLDPS+3+XSIZE)) + IF(INOPV .EQ. -1) THEN + APOS = POSELT + NFRONT8*int(NPIVP1-1,8) + int(NPIV,8) + IDIAG = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF(real(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + KEEP(98) = KEEP(98)+1 + ELSE IF (KEEP(258) .NE. 0) THEN + CALL CMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL CMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL CMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + NFRONT8*int(IPIV-1,8) + int(NPIV,8) + JMAX = 1 + IF (UU.GT.RZERO) GO TO 340 + IF (abs(A(APOS)).EQ.RZERO) GO TO 630 + GO TO 380 + 340 AMROW = RZERO + J1 = APOS + J2 = APOS + int(- NPIV + NASS - 1,8) + J = NASS -NPIV + JMAX = CMUMPS_IXAMAX(J,A(J1),1) + JJ = J1 + int(JMAX - 1,8) + AMROW = abs(A(JJ)) + RMAX = AMROW + J1 = J2 + 1_8 + J2 = APOS +int(- NPIV + NFRONT - 1 - KEEP(253),8) + IF (J2.LT.J1) GO TO 370 + DO 360 JJ=J1,J2 + RMAX = max(abs(A(JJ)),RMAX) + 360 CONTINUE + 370 IDIAG = APOS + int(IPIV - NPIVP1,8) + IF ( RMAX .LE. PIVNUL ) THEN + KEEP(109) = KEEP(109)+1 + ISW = IOLDPS+IW(IOLDPS+1+XSIZE)+6+XSIZE+ + & IW(IOLDPS+5+XSIZE)+IPIV-NPIVP1 + PIVNUL_LIST(KEEP(109)) = IW(ISW) + IF(real(FIXA).GT.RZERO) THEN + IF(real(A(IDIAG)) .GE. RZERO) THEN + A(IDIAG) = FIXA + ELSE + A(IDIAG) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = APOS + int(- NPIV + NFRONT - 1 - KEEP(253),8) + DO JJ=J1,J2 + A(JJ) = ZERO + ENDDO + A(IDIAG) = -FIXA + ENDIF + JMAX = IPIV - NPIV + GOTO 385 + ENDIF + IF (abs(A(IDIAG)).GT. max(UU*RMAX,SEUIL)) THEN + JMAX = IPIV - NPIV + GO TO 380 + ENDIF + IF (AMROW.LE. max(UU*RMAX,SEUIL)) GO TO 460 + NOFFW = NOFFW + 1 + 380 CONTINUE + IF (KEEP(258) .NE. 0) THEN + CALL CMUMPS_762( + & A( APOS+int(JMAX-1,8) ), + & DKEEP(6), + & KEEP(259) ) + ENDIF + 385 CONTINUE + IF (IPIV.EQ.NPIVP1) GO TO 400 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8)*NFRONT8 + J2 = J1 + NFRONT8 - 1_8 + J3 = POSELT + int(IPIV-1,8)*NFRONT8 + DO 390 JJ=J1,J2 + SWOP = A(JJ) + A(JJ) = A(J3) + A(J3) = SWOP + J3 = J3 + 1_8 + 390 CONTINUE + ISWPS1 = IOLDPS + 5 + NPIVP1 + XSIZE + ISWPS2 = IOLDPS + 5 + IPIV + XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + 400 IF (JMAX.EQ.1) GO TO 420 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8) + J2 = POSELT + int(NPIV + JMAX - 1,8) + DO 410 KSW=1,NFRONT + SWOP = A(J1) + A(J1) = A(J2) + A(J2) = SWOP + J1 = J1 + NFRONT8 + J2 = J2 + NFRONT8 + 410 CONTINUE + ISWPS1 = IOLDPS + 5 + NFRONT + NPIV + 1 +XSIZE + ISWPS2 = IOLDPS + 5 + NFRONT + NPIV + JMAX +XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + GO TO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 430 + 630 CONTINUE + IFLAG = -10 + WRITE(*,*) 'Detected a null pivot, INODE/NPIV=',INODE,NPIV + GOTO 430 + 420 CONTINUE + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL CMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, IPIV, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL CMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIV+JMAX, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + 430 CONTINUE + RETURN + END SUBROUTINE CMUMPS_221 + SUBROUTINE CMUMPS_220(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IOLDPS,POSELT,UU,SEUIL,KEEP, DKEEP, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,INOPV + INTEGER(8) :: LA + INTEGER KEEP(500) + REAL DKEEP(30) + REAL UU, SEUIL + COMPLEX A(LA) + INTEGER IW(LIW) + REAL AMROW + REAL RMAX + COMPLEX SWOP + INTEGER(8) :: APOS, POSELT + INTEGER(8) :: J1, J2, J3_8, JJ, IDIAG + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS + INTEGER NOFFW,NPIV,IPIV + INTEGER J, J3 + INTEGER NPIVP1,JMAX,ISW,ISWPS1 + INTEGER ISWPS2,KSW,XSIZE + INTEGER I_PIVRPTR_L, I_PIVR_L, NBPANELS_L + INTEGER I_PIVRPTR_U, I_PIVR_U, NBPANELS_U + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U + INTEGER CMUMPS_IXAMAX + INCLUDE 'mumps_headers.h' + INTRINSIC max + REAL, PARAMETER :: RZERO = 0.0E0 + NFRONT8 = int(NFRONT,8) + INOPV = 0 + XSIZE = KEEP(IXSZ) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL CMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE) + & +KEEP(IXSZ), + & IW, LIW) + CALL CMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + ENDIF + DO 460 IPIV=NPIVP1,NASS + APOS = POSELT + NFRONT8*int(NPIV,8) + int(IPIV-1,8) + JMAX = 1 + AMROW = RZERO + J1 = APOS + J3 = NASS -NPIV + JMAX = CMUMPS_IXAMAX(J3,A(J1),NFRONT) + JJ = J1 + int(JMAX-1,8)*NFRONT8 + AMROW = abs(A(JJ)) + RMAX = AMROW + J1 = APOS + int(NASS-NPIV,8) * NFRONT8 + J3 = NFRONT - NASS - KEEP(253) + IF (J3.EQ.0) GOTO 370 + DO 360 J=1,J3 + RMAX = max(abs(A(J1)),RMAX) + J1 = J1 + NFRONT8 + 360 CONTINUE + 370 IF (RMAX.EQ.RZERO) GO TO 460 + IDIAG = APOS + int(IPIV - NPIVP1,8)*NFRONT8 + IF (abs(A(IDIAG)).GE.max(UU*RMAX,SEUIL)) THEN + JMAX = IPIV - NPIV + GO TO 380 + ENDIF + IF (AMROW.LT.max(UU*RMAX,SEUIL)) GO TO 460 + NOFFW = NOFFW + 1 + 380 CONTINUE + IF (KEEP(258) .NE. 0) THEN + CALL CMUMPS_762( + & A(APOS + int(JMAX - 1,8) * NFRONT8 ), + & DKEEP(6), + & KEEP(259) ) + ENDIF + IF (IPIV.EQ.NPIVP1) GO TO 400 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8) + J3_8 = POSELT + int(IPIV-1,8) + DO 390 J= 1,NFRONT + SWOP = A(J1) + A(J1) = A(J3_8) + A(J3_8) = SWOP + J1 = J1 + NFRONT8 + J3_8 = J3_8 + NFRONT8 + 390 CONTINUE + ISWPS1 = IOLDPS + 5 + NPIVP1 + NFRONT + XSIZE + ISWPS2 = IOLDPS + 5 + IPIV + NFRONT + XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + 400 IF (JMAX.EQ.1) GO TO 420 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8) * NFRONT8 + J2 = POSELT + int(NPIV + JMAX - 1,8) * NFRONT8 + DO 410 KSW=1,NFRONT + SWOP = A(J1) + A(J1) = A(J2) + A(J2) = SWOP + J1 = J1 + 1_8 + J2 = J2 + 1_8 + 410 CONTINUE + ISWPS1 = IOLDPS + 5 + NPIV + 1 + XSIZE + ISWPS2 = IOLDPS + 5 + NPIV + JMAX + XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + GO TO 420 + 460 CONTINUE + INOPV = 1 + GOTO 430 + 420 CONTINUE + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL CMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, NPIV+JMAX, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL CMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, IPIV, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + 430 CONTINUE + RETURN + END SUBROUTINE CMUMPS_220 + SUBROUTINE CMUMPS_225(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB,LKJIB,LKJIT,XSIZE) + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFINB,LKJIB,IBEG_BLOCK + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER IW(LIW) + COMPLEX VALPIV + INTEGER(8) :: APOS, POSELT, UUPOS, LPOS + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS + INTEGER LKJIT, XSIZE + COMPLEX ONE, ALPHA + INTEGER NPIV,JROW2 + INTEGER NEL2,NPIVP1,KROW,NEL + INCLUDE 'mumps_headers.h' + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + NFRONT8= int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NEL = NFRONT - NPIVP1 + IFINB = 0 + IF (IW(IOLDPS+3+XSIZE).LE.0) THEN + IF (NASS.LT.LKJIT) THEN + IW(IOLDPS+3+XSIZE) = NASS + ELSE + IW(IOLDPS+3+XSIZE) = min0(NASS,LKJIB) + ENDIF + ENDIF + JROW2 = IW(IOLDPS+3+XSIZE) + NEL2 = JROW2 - NPIVP1 + IF (NEL2.EQ.0) THEN + IF (JROW2.EQ.NASS) THEN + IFINB = -1 + ELSE + IFINB = 1 + IW(IOLDPS+3+XSIZE) = min0(JROW2+LKJIB,NASS) + IBEG_BLOCK = NPIVP1+1 + ENDIF + ELSE + APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + VALPIV = ONE/A(APOS) + LPOS = APOS + NFRONT8 + DO 541 KROW = 1,NEL2 + A(LPOS) = A(LPOS)*VALPIV + LPOS = LPOS + NFRONT8 + 541 CONTINUE + LPOS = APOS + NFRONT8 + UUPOS = APOS + 1_8 + CALL cgeru(NEL,NEL2,ALPHA,A(UUPOS),1,A(LPOS),NFRONT, + & A(LPOS+1_8),NFRONT) + ENDIF + RETURN + END SUBROUTINE CMUMPS_225 + SUBROUTINE CMUMPS_229(NFRONT,N,INODE,IW,LIW,A,LA,IOLDPS, + & POSELT,XSIZE) + IMPLICIT NONE + INTEGER NFRONT,N,INODE,LIW,XSIZE + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER IW(LIW) + COMPLEX ALPHA,VALPIV + INTEGER(8) :: APOS, POSELT, UUPOS + INTEGER(8) :: NFRONT8, LPOS, IRWPOS + INTEGER IOLDPS,NPIV,NEL + INTEGER JROW + INCLUDE 'mumps_headers.h' + COMPLEX, PARAMETER :: ONE=(1.0E0,0.0E0) + NFRONT8= int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NEL = NFRONT - NPIV - 1 + APOS = POSELT + int(NPIV,8) * NFRONT8 + int(NPIV,8) + IF (NEL.EQ.0) GO TO 650 + VALPIV = ONE/A(APOS) + LPOS = APOS + NFRONT8 + DO 340 JROW = 1,NEL + A(LPOS) = VALPIV*A(LPOS) + LPOS = LPOS + NFRONT8 + 340 CONTINUE + LPOS = APOS + NFRONT8 + UUPOS = APOS+1_8 + DO 440 JROW = 1,NEL + IRWPOS = LPOS + 1_8 + ALPHA = -A(LPOS) + CALL caxpy(NEL,ALPHA,A(UUPOS),1,A(IRWPOS),1) + LPOS = LPOS + NFRONT8 + 440 CONTINUE + 650 RETURN + END SUBROUTINE CMUMPS_229 + SUBROUTINE CMUMPS_228(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB,XSIZE) + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER NFRONT,NASS,N,LIW,INODE,IFINB + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER IW(LIW) + COMPLEX ALPHA,VALPIV + INTEGER(8) :: APOS, POSELT, UUPOS, LPOS, IRWPOS + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS,NPIV,KROW, XSIZE + INTEGER NEL,ICOL,NEL2 + INTEGER NPIVP1 + COMPLEX, PARAMETER :: ONE=(1.0E0,0.0E0) + NFRONT8=int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NEL = NFRONT - NPIVP1 + NEL2 = NASS - NPIVP1 + IFINB = 0 + IF (NPIVP1.EQ.NASS) IFINB = 1 + APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + VALPIV = ONE/A(APOS) + LPOS = APOS + NFRONT8 + DO 541 KROW = 1,NEL + A(LPOS) = A(LPOS)*VALPIV + LPOS = LPOS + NFRONT8 + 541 CONTINUE + LPOS = APOS + NFRONT8 + UUPOS = APOS + 1_8 + DO 440 ICOL = 1,NEL + IRWPOS = LPOS + 1_8 + ALPHA = -A(LPOS) + CALL caxpy(NEL2,ALPHA,A(UUPOS),1,A(IRWPOS),1) + LPOS = LPOS + NFRONT8 + 440 CONTINUE + RETURN + END SUBROUTINE CMUMPS_228 + SUBROUTINE CMUMPS_231(A,LA,NFRONT, + & NPIV,NASS,POSELT) + IMPLICIT NONE + INTEGER(8) :: LA,POSELT + COMPLEX A(LA) + INTEGER NFRONT, NPIV, NASS + INTEGER(8) :: LPOS, LPOS1, LPOS2 + INTEGER NEL1,NEL11 + COMPLEX ALPHA, ONE + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + NEL1 = NFRONT - NASS + NEL11 = NFRONT - NPIV + LPOS2 = POSELT + int(NASS,8)*int(NFRONT,8) + CALL ctrsm('L','L','N','N',NPIV,NEL1,ONE,A(POSELT),NFRONT, + & A(LPOS2),NFRONT) + LPOS = LPOS2 + int(NPIV,8) + LPOS1 = POSELT + int(NPIV,8) + CALL cgemm('N','N',NEL11,NEL1,NPIV,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE CMUMPS_231 + SUBROUTINE CMUMPS_642(A,LAFAC,NFRONT, + & NPIV,NASS, IW, LIWFAC, + & MonBloc, TYPEFile, MYID, KEEP8, + & STRAT, IFLAG_OOC, + & LNextPiv2beWritten, UNextPiv2beWritten) + USE CMUMPS_OOC + IMPLICIT NONE + INTEGER NFRONT, NPIV, NASS + INTEGER(8) :: LAFAC + INTEGER LIWFAC, TYPEFile, MYID, IFLAG_OOC, + & LNextPiv2beWritten, UNextPiv2beWritten, STRAT + COMPLEX A(LAFAC) + INTEGER IW(LIWFAC) + INTEGER(8) KEEP8(150) + TYPE(IO_BLOCK) :: MonBloc + INTEGER(8) :: LPOS2,LPOS1,LPOS + INTEGER NEL1,NEL11 + COMPLEX ALPHA, ONE + LOGICAL LAST_CALL + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + NEL1 = NFRONT - NASS + NEL11 = NFRONT - NPIV + LPOS2 = 1_8 + int(NASS,8) * int(NFRONT,8) + CALL ctrsm('L','L','N','N',NPIV,NEL1,ONE,A(1),NFRONT, + & A(LPOS2),NFRONT) + LAST_CALL=.FALSE. + CALL CMUMPS_688 + & ( STRAT, TYPEFile, + & A, LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW, LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + LPOS = LPOS2 + int(NPIV,8) + LPOS1 = int(1 + NPIV,8) + CALL cgemm('N','N',NEL11,NEL1,NPIV,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE CMUMPS_642 + SUBROUTINE CMUMPS_232(A,LA,NFRONT,NPIV,NASS,POSELT,LKJIB) + INTEGER NFRONT, NPIV, NASS, LKJIB + INTEGER (8) :: POSELT, LA + COMPLEX A(LA) + INTEGER(8) :: POSELT_LOCAL, LPOS, LPOS1, LPOS2 + INTEGER NEL1, NEL11, NPBEG + COMPLEX ALPHA, ONE + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + POSELT_LOCAL = POSELT + NEL1 = NASS - NPIV + NPBEG = NPIV - LKJIB + 1 + NEL11 = NFRONT - NPIV + LPOS2 = POSELT_LOCAL + int(NPIV,8)*int(NFRONT,8) + & + int(NPBEG - 1,8) + POSELT_LOCAL = POSELT_LOCAL + int(NPBEG-1,8)*int(NFRONT,8) + & + int(NPBEG-1,8) + CALL ctrsm('L','L','N','N',LKJIB,NEL1,ONE,A(POSELT_LOCAL), + & NFRONT,A(LPOS2),NFRONT) + LPOS = LPOS2 + int(LKJIB,8) + LPOS1 = POSELT_LOCAL + int(LKJIB,8) + CALL cgemm('N','N',NEL11,NEL1,LKJIB,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE CMUMPS_232 + SUBROUTINE CMUMPS_233(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,LKJIB_ORIG,LKJIB,LKJIT,XSIZE ) + IMPLICIT NONE + INTEGER NFRONT, NASS,N,LIW + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER IW(LIW) + INTEGER LKJIB_ORIG,LKJIB, INODE, IBEG_BLOCK + INTEGER(8) :: POSELT, LPOS, LPOS1, LPOS2, POSLOCAL + INTEGER(8) :: IPOS, KPOS + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS, NPIV, JROW2, NPBEG + INTEGER NONEL, LKJIW, NEL1, NEL11 + INTEGER LBP, HF + INTEGER LBPT,I1,K1,II,ISWOP,LBP1 + INTEGER LKJIT, XSIZE + INCLUDE 'mumps_headers.h' + COMPLEX ALPHA, ONE + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + NFRONT8=int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + JROW2 = iabs(IW(IOLDPS+3+XSIZE)) + NPBEG = IBEG_BLOCK + HF = 6 + IW(IOLDPS+5+XSIZE) +XSIZE + NONEL = JROW2 - NPIV + 1 + IF ((NASS-NPIV).GE.LKJIT) THEN + LKJIB = LKJIB_ORIG + NONEL + IW(IOLDPS+3+XSIZE)= min0(NPIV+LKJIB,NASS) + ELSE + IW(IOLDPS+3+XSIZE) = NASS + ENDIF + IBEG_BLOCK = NPIV + 1 + NEL1 = NASS - JROW2 + LKJIW = NPIV - NPBEG + 1 + NEL11 = NFRONT - NPIV + IF ((NEL1.NE.0).AND.(LKJIW.NE.0)) THEN + LPOS2 = POSELT + int(JROW2,8)*NFRONT8 + + & int(NPBEG - 1,8) + POSLOCAL = POSELT + int(NPBEG-1,8)*NFRONT8 + int(NPBEG - 1,8) + CALL ctrsm('L','L','N','N',LKJIW,NEL1,ONE, + & A(POSLOCAL),NFRONT, + & A(LPOS2),NFRONT) + LPOS = LPOS2 + int(LKJIW,8) + LPOS1 = POSLOCAL + int(LKJIW,8) + CALL cgemm('N','N',NEL11,NEL1,LKJIW,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + ENDIF + RETURN + END SUBROUTINE CMUMPS_233 + SUBROUTINE CMUMPS_236(A,LA,NPIVB,NFRONT, + & NPIV,NASS,POSELT) + IMPLICIT NONE + INTEGER NPIVB,NASS + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER(8) :: APOS, POSELT + INTEGER NFRONT, NPIV, NASSL + INTEGER(8) :: LPOS, LPOS1, LPOS2 + INTEGER NEL1, NEL11, NPIVE + COMPLEX ALPHA, ONE + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + NEL1 = NFRONT - NASS + NEL11 = NFRONT - NPIV + NPIVE = NPIV - NPIVB + NASSL = NASS - NPIVB + APOS = POSELT + int(NPIVB,8)*int(NFRONT,8) + & + int(NPIVB,8) + LPOS2 = APOS + int(NASSL,8) + CALL ctrsm('R','U','N','U',NEL1,NPIVE,ONE,A(APOS),NFRONT, + & A(LPOS2),NFRONT) + LPOS = LPOS2 + int(NFRONT,8)*int(NPIVE,8) + LPOS1 = APOS + int(NFRONT,8)*int(NPIVE,8) + CALL cgemm('N','N',NEL1,NEL11,NPIVE,ALPHA,A(LPOS2), + & NFRONT,A(LPOS1),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE CMUMPS_236 + SUBROUTINE CMUMPS_217(N, NZ, NSCA, + & ASPK, IRN, ICN, COLSCA, ROWSCA, WK, LWK, WK_REAL, + & LWK_REAL, ICNTL, INFO) + IMPLICIT NONE + INTEGER N, NZ, NSCA + INTEGER IRN(NZ), ICN(NZ) + INTEGER ICNTL(40), INFO(40) + COMPLEX ASPK(NZ) + REAL COLSCA(*), ROWSCA(*) + INTEGER LWK, LWK_REAL + COMPLEX WK(LWK) + REAL WK_REAL(LWK_REAL) + INTEGER MPG,LP + INTEGER IWNOR + INTEGER I, K + LOGICAL PROK + REAL ONE + PARAMETER( ONE = 1.0E0 ) + LP = ICNTL(1) + MPG = ICNTL(2) + MPG = ICNTL(3) + PROK = (MPG.GT.0) + IF (PROK) WRITE(MPG,101) + 101 FORMAT(/' ****** SCALING OF ORIGINAL MATRIX '/) + IF (NSCA.EQ.1) THEN + IF (PROK) + & WRITE (MPG,*) ' DIAGONAL SCALING ' + ELSEIF (NSCA.EQ.2) THEN + IF (PROK) + & WRITE (MPG,*) ' SCALING BASED ON (MC29)' + ELSEIF (NSCA.EQ.3) THEN + IF (PROK) + & WRITE (MPG,*) ' COLUMN SCALING' + ELSEIF (NSCA.EQ.4) THEN + IF (PROK) + & WRITE (MPG,*) ' ROW AND COLUMN SCALING (1 Pass)' + ELSEIF (NSCA.EQ.5) THEN + IF (PROK) + & WRITE (MPG,*) ' MC29 FOLLOWED BY ROW &COL SCALING' + ELSEIF (NSCA.EQ.6) THEN + IF (PROK) + & WRITE (MPG,*) ' MC29 FOLLOWED BY COLUMN SCALING' + ENDIF + DO 10 I=1,N + COLSCA(I) = ONE + ROWSCA(I) = ONE + 10 CONTINUE + IF ((NSCA.EQ.5).OR. + & (NSCA.EQ.6)) THEN + IF (NZ.GT.LWK) GOTO 400 + DO 15 K=1,NZ + WK(K) = ASPK(K) + 15 CONTINUE + ENDIF + IF (5*N.GT.LWK_REAL) GOTO 410 + IWNOR = 1 + IF (NSCA.EQ.1) THEN + CALL CMUMPS_238(N,NZ,ASPK,IRN,ICN, + & COLSCA,ROWSCA,MPG) + ELSEIF (NSCA.EQ.2) THEN + CALL CMUMPS_239(N,NZ,ASPK,IRN,ICN, + & ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA) + ELSEIF (NSCA.EQ.3) THEN + CALL CMUMPS_241(N,NZ,ASPK,IRN,ICN,WK_REAL(IWNOR), + & COLSCA, MPG) + ELSEIF (NSCA.EQ.4) THEN + CALL CMUMPS_287(N,NZ,IRN,ICN,ASPK, + & WK_REAL(IWNOR),WK_REAL(IWNOR+N),COLSCA,ROWSCA,MPG) + ELSEIF (NSCA.EQ.5) THEN + CALL CMUMPS_239(N,NZ,WK,IRN,ICN, + & ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA) + CALL CMUMPS_241(N,NZ,WK,IRN,ICN,WK_REAL(IWNOR), + & COLSCA, MPG) + ELSEIF (NSCA.EQ.6) THEN + CALL CMUMPS_239(N,NZ,WK,IRN,ICN, + & ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA) + CALL CMUMPS_240(NSCA,N,NZ,IRN,ICN,WK, + & WK_REAL(IWNOR+N),ROWSCA,MPG) + CALL CMUMPS_241(N,NZ,WK,IRN,ICN, + & WK_REAL(IWNOR), COLSCA, MPG) + ENDIF + GOTO 500 + 400 INFO(1) = -5 + INFO(2) = NZ-LWK + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) + & WRITE(LP,*) '*** ERROR: Not enough space to scale matrix' + GOTO 500 + 410 INFO(1) = -5 + INFO(2) = 5*N-LWK_REAL + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) + & WRITE(LP,*) '*** ERROR: Not enough space to scale matrix' + GOTO 500 + 500 CONTINUE + RETURN + END SUBROUTINE CMUMPS_217 + SUBROUTINE CMUMPS_287(N,NZ,IRN,ICN,VAL, + & RNOR,CNOR,COLSCA,ROWSCA,MPRINT) + INTEGER N, NZ + COMPLEX VAL(NZ) + REAL RNOR(N),CNOR(N) + REAL COLSCA(N),ROWSCA(N) + REAL CMIN,CMAX,RMIN,ARNOR,ACNOR + INTEGER IRN(NZ), ICN(NZ) + REAL VDIAG + INTEGER MPRINT + INTEGER I,J,K + REAL ZERO, ONE + PARAMETER(ZERO=0.0E0, ONE=1.0E0) + DO 50 J=1,N + CNOR(J) = ZERO + RNOR(J) = ZERO + 50 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.LE.0).OR.(I.GT.N).OR. + & (J.LE.0).OR.(J.GT.N)) GOTO 100 + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.CNOR(J)) THEN + CNOR(J) = VDIAG + ENDIF + IF (VDIAG.GT.RNOR(I)) THEN + RNOR(I) = VDIAG + ENDIF + 100 CONTINUE + IF (MPRINT.GT.0) THEN + CMIN = CNOR(1) + CMAX = CNOR(1) + RMIN = RNOR(1) + DO 111 I=1,N + ARNOR = RNOR(I) + ACNOR = CNOR(I) + IF (ACNOR.GT.CMAX) CMAX=ACNOR + IF (ACNOR.LT.CMIN) CMIN=ACNOR + IF (ARNOR.LT.RMIN) RMIN=ARNOR + 111 CONTINUE + WRITE(MPRINT,*) '**** STAT. OF MATRIX PRIOR ROW&COL SCALING' + WRITE(MPRINT,*) ' MAXIMUM NORM-MAX OF COLUMNS:',CMAX + WRITE(MPRINT,*) ' MINIMUM NORM-MAX OF COLUMNS:',CMIN + WRITE(MPRINT,*) ' MINIMUM NORM-MAX OF ROWS :',RMIN + ENDIF + DO 120 J=1,N + IF (CNOR(J).LE.ZERO) THEN + CNOR(J) = ONE + ELSE + CNOR(J) = ONE / CNOR(J) + ENDIF + 120 CONTINUE + DO 130 J=1,N + IF (RNOR(J).LE.ZERO) THEN + RNOR(J) = ONE + ELSE + RNOR(J) = ONE / RNOR(J) + ENDIF + 130 CONTINUE + DO 110 I=1,N + ROWSCA(I) = ROWSCA(I) * RNOR(I) + COLSCA(I) = COLSCA(I) * CNOR(I) + 110 CONTINUE + IF (MPRINT.GT.0) + & WRITE(MPRINT,*) ' END OF SCALING BY MAX IN ROW AND COL' + RETURN + END SUBROUTINE CMUMPS_287 + SUBROUTINE CMUMPS_239(N,NZ,VAL,ROWIND,COLIND, + & RNOR,CNOR,WNOR,MPRINT,MP, + & NSCA) + INTEGER N, NZ + COMPLEX VAL(NZ) + REAL WNOR(5*N) + REAL RNOR(N), CNOR(N) + INTEGER COLIND(NZ),ROWIND(NZ) + INTEGER J,I,K + INTEGER MPRINT,MP,NSCA + INTEGER IFAIL9 + REAL ZERO + PARAMETER( ZERO = 0.0E0) + DO 15 I=1,N + RNOR(I) = ZERO + CNOR(I) = ZERO + 15 CONTINUE + CALL CMUMPS_216(N,N,NZ,VAL,ROWIND,COLIND, + & RNOR,CNOR,WNOR, MP,IFAIL9) +*CVD$ NODEPCHK +*CVD$ VECTOR +*CVD$ CONCUR + DO 30 I=1,N + CNOR(I) = exp(CNOR(I)) + RNOR(I) = exp(RNOR(I)) + 30 CONTINUE + IF ((NSCA.EQ.5).OR.(NSCA.EQ.6)) THEN + DO 100 K=1,NZ + I = ROWIND(K) + J = COLIND(K) + IF (min(I,J).LT.1 .OR. I.GT.N .OR. J.GT.N) GOTO 100 + VAL(K) = VAL(K) * CNOR(J) * RNOR(I) + 100 CONTINUE + ENDIF + IF (MPRINT.GT.0) + & WRITE(MPRINT,*) ' END OF SCALING USING MC29' + RETURN + END SUBROUTINE CMUMPS_239 + SUBROUTINE CMUMPS_241(N,NZ,VAL,IRN,ICN, + & CNOR,COLSCA,MPRINT) + INTEGER N,NZ + COMPLEX VAL(NZ) + REAL CNOR(N) + REAL COLSCA(N) + INTEGER IRN(NZ), ICN(NZ) + REAL VDIAG + INTEGER MPRINT + INTEGER I,J,K + REAL ZERO, ONE + PARAMETER (ZERO=0.0E0,ONE=1.0E0) + DO 10 J=1,N + CNOR(J) = ZERO + 10 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.LE.0).OR.(I.GT.N).OR. + & (J.LE.0).OR.(J.GT.N)) GOTO 100 + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.CNOR(J)) THEN + CNOR(J) = VDIAG + ENDIF + 100 CONTINUE + DO 110 J=1,N + IF (CNOR(J).LE.ZERO) THEN + CNOR(J) = ONE + ELSE + CNOR(J) = ONE/CNOR(J) + ENDIF + 110 CONTINUE + DO 215 I=1,N + COLSCA(I) = COLSCA(I) * CNOR(I) + 215 CONTINUE + IF (MPRINT.GT.0) WRITE(MPRINT,*) ' END OF COLUMN SCALING' + RETURN + END SUBROUTINE CMUMPS_241 + SUBROUTINE CMUMPS_238(N,NZ,VAL,IRN,ICN, + & COLSCA,ROWSCA,MPRINT) + INTEGER N, NZ + COMPLEX VAL(NZ) + REAL ROWSCA(N),COLSCA(N) + INTEGER IRN(NZ),ICN(NZ) + REAL VDIAG + INTEGER MPRINT,I,J,K + INTRINSIC sqrt + REAL ZERO, ONE + PARAMETER(ZERO=0.0E0, ONE=1.0E0) + DO 10 I=1,N + ROWSCA(I) = ONE + 10 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + IF ((I.GT.N).OR.(I.LE.0)) GOTO 100 + J = ICN(K) + IF (I.EQ.J) THEN + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.ZERO) THEN + ROWSCA(J) = ONE/(sqrt(VDIAG)) + ENDIF + ENDIF + 100 CONTINUE + DO 110 I=1,N + COLSCA(I) = ROWSCA(I) + 110 CONTINUE + IF (MPRINT.GT.0) WRITE(MPRINT,*) ' END OF DIAGONAL SCALING' + RETURN + END SUBROUTINE CMUMPS_238 + SUBROUTINE CMUMPS_240(NSCA,N,NZ,IRN,ICN,VAL, + & RNOR,ROWSCA,MPRINT) + INTEGER N, NZ, NSCA + INTEGER IRN(NZ), ICN(NZ) + COMPLEX VAL(NZ) + REAL RNOR(N) + REAL ROWSCA(N) + REAL VDIAG + INTEGER MPRINT + INTEGER I,J,K + REAL ZERO,ONE + PARAMETER (ZERO=0.0E0, ONE=1.0E0) + DO 50 J=1,N + RNOR(J) = ZERO + 50 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.LE.0).OR.(I.GT.N).OR. + & (J.LE.0).OR.(J.GT.N)) GOTO 100 + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.RNOR(I)) THEN + RNOR(I) = VDIAG + ENDIF + 100 CONTINUE + DO 130 J=1,N + IF (RNOR(J).LE.ZERO) THEN + RNOR(J) = ONE + ELSE + RNOR(J) = ONE/RNOR(J) + ENDIF + 130 CONTINUE + DO 110 I=1,N + ROWSCA(I) = ROWSCA(I)* RNOR(I) + 110 CONTINUE + IF ( (NSCA.EQ.4) .OR. (NSCA.EQ.6) ) THEN + DO 150 K=1,NZ + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.N .OR. J.GT.N) GOTO 150 + VAL(K) = VAL(K) * RNOR(I) + 150 CONTINUE + ENDIF + IF (MPRINT.GT.0) + & WRITE(MPRINT,'(A)') ' END OF ROW SCALING' + RETURN + END SUBROUTINE CMUMPS_240 + SUBROUTINE CMUMPS_216(M,N,NE,A,IRN,ICN,R,C,W,LP,IFAIL) + INTEGER M,N,NE + COMPLEX A(NE) + INTEGER IRN(NE),ICN(NE) + REAL R(M),C(N) + REAL W(M*2+N*3) + INTEGER LP,IFAIL + INTRINSIC log,abs,min + INTEGER MAXIT + PARAMETER (MAXIT=100) + REAL ONE + REAL SMIN,ZERO + PARAMETER (ONE=1.0E0,SMIN=0.1E0,ZERO=0.0E0) + INTEGER I,I1,I2,I3,I4,I5,ITER,J,K + REAL E,E1,EM,Q,Q1,QM,S,S1,SM,U,V + IFAIL = 0 + IF (M.LT.1 .OR. N.LT.1) THEN + IFAIL = -1 + GO TO 220 + ELSE IF (NE.LE.0) THEN + IFAIL = -2 + GO TO 220 + END IF + I1 = 0 + I2 = M + I3 = M + N + I4 = M + N*2 + I5 = M + N*3 + DO 10 I = 1,M + R(I) = ZERO + W(I1+I) = ZERO + 10 CONTINUE + DO 20 J = 1,N + C(J) = ZERO + W(I2+J) = ZERO + W(I3+J) = ZERO + W(I4+J) = ZERO + 20 CONTINUE + DO 30 K = 1,NE + U = abs(A(K)) + IF (U.EQ.ZERO) GO TO 30 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 30 + U = log(U) + W(I1+I) = W(I1+I) + ONE + W(I2+J) = W(I2+J) + ONE + R(I) = R(I) + U + W(I3+J) = W(I3+J) + U + 30 CONTINUE + DO 40 I = 1,M + IF (W(I1+I).EQ.ZERO) W(I1+I) = ONE + R(I) = R(I)/W(I1+I) + W(I5+I) = R(I) + 40 CONTINUE + DO 50 J = 1,N + IF (W(I2+J).EQ.ZERO) W(I2+J) = ONE + W(I3+J) = W(I3+J)/W(I2+J) + 50 CONTINUE + SM = SMIN*real(NE) + DO 60 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 60 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 60 + R(I) = R(I) - W(I3+J)/W(I1+I) + 60 CONTINUE + E = ZERO + Q = ONE + S = ZERO + DO 70 I = 1,M + S = S + W(I1+I)*R(I)**2 + 70 CONTINUE + IF (abs(S).LE.abs(SM)) GO TO 160 + DO 150 ITER = 1,MAXIT + DO 80 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 80 + J = ICN(K) + I = IRN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 80 + C(J) = C(J) + R(I) + 80 CONTINUE + S1 = S + S = ZERO + DO 90 J = 1,N + V = -C(J)/Q + C(J) = V/W(I2+J) + S = S + V*C(J) + 90 CONTINUE + E1 = E + E = Q*S/S1 + Q = ONE - E + IF (abs(S).LE.abs(SM)) E = ZERO + DO 100 I = 1,M + R(I) = R(I)*E*W(I1+I) + 100 CONTINUE + IF (abs(S).LE.abs(SM)) GO TO 180 + EM = E*E1 + DO 110 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 110 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 110 + R(I) = R(I) + C(J) + 110 CONTINUE + S1 = S + S = ZERO + DO 120 I = 1,M + V = -R(I)/Q + R(I) = V/W(I1+I) + S = S + V*R(I) + 120 CONTINUE + E1 = E + E = Q*S/S1 + Q1 = Q + Q = ONE - E + IF (abs(S).LE.abs(SM)) Q = ONE + QM = Q*Q1 + DO 130 J = 1,N + W(I4+J) = (EM*W(I4+J)+C(J))/QM + W(I3+J) = W(I3+J) + W(I4+J) + 130 CONTINUE + IF (abs(S).LE.abs(SM)) GO TO 160 + DO 140 J = 1,N + C(J) = C(J)*E*W(I2+J) + 140 CONTINUE + 150 CONTINUE + 160 DO 170 I = 1,M + R(I) = R(I)*W(I1+I) + 170 CONTINUE + 180 DO 190 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 190 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 190 + R(I) = R(I) + W(I3+J) + 190 CONTINUE + DO 200 I = 1,M + R(I) = R(I)/W(I1+I) - W(I5+I) + 200 CONTINUE + DO 210 J = 1,N + C(J) = -W(I3+J) + 210 CONTINUE + RETURN + 220 IF (LP.GT.0) WRITE (LP,'(/A/A,I3)') + & ' **** Error return from CMUMPS_216 ****',' IFAIL =',IFAIL + END SUBROUTINE CMUMPS_216 + SUBROUTINE CMUMPS_27( id, ANORMINF, LSCAL ) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MASTER, IERR + PARAMETER( MASTER = 0 ) + TYPE(CMUMPS_STRUC), TARGET :: id + REAL, INTENT(OUT) :: ANORMINF + LOGICAL :: LSCAL + INTEGER, DIMENSION (:), POINTER :: KEEP,INFO + INTEGER(8), DIMENSION (:), POINTER :: KEEP8 + LOGICAL :: I_AM_SLAVE + COMPLEX DUMMY(1) + REAL ZERO + PARAMETER( ZERO = 0.0E0) + REAL, ALLOCATABLE :: SUMR(:), SUMR_LOC(:) + INTEGER :: allocok, MTYPE, I + INFO =>id%INFO + KEEP =>id%KEEP + KEEP8 =>id%KEEP8 + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & KEEP(46) .eq. 1 ) ) + IF (id%MYID .EQ. MASTER) THEN + ALLOCATE( SUMR( id%N ), stat =allocok ) + IF (allocok .GT.0 ) THEN + id%INFO(1)=-13 + id%INFO(2)=id%N + RETURN + ENDIF + ENDIF + IF ( KEEP(54) .eq. 0 ) THEN + IF (id%MYID .EQ. MASTER) THEN + IF (KEEP(55).EQ.0) THEN + IF (.NOT.LSCAL) THEN + CALL CMUMPS_207(id%A(1), + & id%NZ, id%N, + & id%IRN(1), id%JCN(1), + & SUMR, KEEP(1),KEEP8(1) ) + ELSE + CALL CMUMPS_289(id%A(1), + & id%NZ, id%N, + & id%IRN(1), id%JCN(1), + & SUMR, KEEP(1), KEEP8(1), + & id%COLSCA(1)) + ENDIF + ELSE + MTYPE = 1 + IF (.NOT.LSCAL) THEN + CALL CMUMPS_119(MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & SUMR, KEEP(1),KEEP8(1) ) + ELSE + CALL CMUMPS_135(MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & SUMR, KEEP(1),KEEP8(1), id%COLSCA(1)) + ENDIF + ENDIF + ENDIF + ELSE + ALLOCATE( SUMR_LOC( id%N ), stat =allocok ) + IF (allocok .GT.0 ) THEN + id%INFO(1)=-13 + id%INFO(2)=id%N + RETURN + ENDIF + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + IF (.NOT.LSCAL) THEN + CALL CMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & SUMR_LOC, id%KEEP(1),id%KEEP8(1) ) + ELSE + CALL CMUMPS_289(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & SUMR_LOC, id%KEEP(1),id%KEEP8(1), + & id%COLSCA(1)) + ENDIF + ELSE + SUMR_LOC = ZERO + ENDIF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( SUMR_LOC, SUMR, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( SUMR_LOC, DUMMY, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + DEALLOCATE (SUMR_LOC) + ENDIF + IF ( id%MYID .eq. MASTER ) THEN + ANORMINF = real(ZERO) + IF (LSCAL) THEN + DO I = 1, id%N + ANORMINF = max(abs(id%ROWSCA(I) * SUMR(I)), + & ANORMINF) + ENDDO + ELSE + DO I = 1, id%N + ANORMINF = max(abs(SUMR(I)), + & ANORMINF) + ENDDO + ENDIF + ENDIF + CALL MPI_BCAST(ANORMINF, 1, + & MPI_REAL, MASTER, + & id%COMM, IERR ) + IF (id%MYID .eq. MASTER) DEALLOCATE (SUMR) + RETURN + END SUBROUTINE CMUMPS_27 + SUBROUTINE CMUMPS_693(IRN_loc, JCN_loc, A_loc, NZ_loc, + & M, N, NUMPROCS, MYID, COMM, + & RPARTVEC, CPARTVEC, + & RSNDRCVSZ, CSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, COLSCA, WRKRC, ISZWRKRC, + & SYM, NB1, NB2, NB3, EPS, + & ONENORMERR,INFNORMERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER NZ_loc, M, N, IWRKSZ, OP + INTEGER NUMPROCS, MYID, COMM + INTEGER INTSZ, RESZ + INTEGER IRN_loc(NZ_loc) + INTEGER JCN_loc(NZ_loc) + COMPLEX A_loc(NZ_loc) + INTEGER RPARTVEC(M), RSNDRCVSZ(2*NUMPROCS) + INTEGER CPARTVEC(N), CSNDRCVSZ(2*NUMPROCS) + INTEGER IWRK(IWRKSZ) + INTEGER REGISTRE(12) + REAL ROWSCA(M) + REAL COLSCA(N) + INTEGER ISZWRKRC + REAL WRKRC(ISZWRKRC) + REAL ONENORMERR,INFNORMERR + INTEGER SYM, NB1, NB2, NB3 + REAL EPS + EXTERNAL CMUMPS_694,CMUMPS_687, + & CMUMPS_670 + INTEGER I + IF(SYM.EQ.0) THEN + CALL CMUMPS_694(IRN_loc, JCN_loc, A_loc, NZ_loc, + & M, N, NUMPROCS, MYID, COMM, + & RPARTVEC, CPARTVEC, + & RSNDRCVSZ, CSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, COLSCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + ELSE + CALL CMUMPS_687(IRN_loc, JCN_loc, A_loc, NZ_loc, + & N, NUMPROCS, MYID, COMM, + & RPARTVEC, + & RSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + DO I=1,N + COLSCA(I) = ROWSCA(I) + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_693 + SUBROUTINE CMUMPS_694(IRN_loc, JCN_loc, A_loc, NZ_loc, + & M, N, NUMPROCS, MYID, COMM, + & RPARTVEC, CPARTVEC, + & RSNDRCVSZ, CSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, COLSCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER NZ_loc, M, N, IWRKSZ, OP + INTEGER NUMPROCS, MYID, COMM + INTEGER INTSZ, RESZ + INTEGER IRN_loc(NZ_loc) + INTEGER JCN_loc(NZ_loc) + COMPLEX A_loc(NZ_loc) + INTEGER RPARTVEC(M), RSNDRCVSZ(2*NUMPROCS) + INTEGER CPARTVEC(N), CSNDRCVSZ(2*NUMPROCS) + INTEGER IWRK(IWRKSZ) + INTEGER REGISTRE(12) + REAL ROWSCA(M) + REAL COLSCA(N) + INTEGER ISZWRKRC + REAL WRKRC(ISZWRKRC) + REAL ONENORMERR,INFNORMERR + INTEGER IRSNDRCVNUM, ORSNDRCVNUM + INTEGER IRSNDRCVVOL, ORSNDRCVVOL + INTEGER ICSNDRCVNUM, OCSNDRCVNUM + INTEGER ICSNDRCVVOL, OCSNDRCVVOL + INTEGER INUMMYR, INUMMYC + INTEGER IMYRPTR,IMYCPTR + INTEGER IRNGHBPRCS, IRSNDRCVIA,IRSNDRCVJA + INTEGER ORNGHBPRCS, ORSNDRCVIA,ORSNDRCVJA + INTEGER ICNGHBPRCS, ICSNDRCVIA,ICSNDRCVJA + INTEGER OCNGHBPRCS, OCSNDRCVIA,OCSNDRCVJA + INTEGER ISTATUS, REQUESTS, TMPWORK + INTEGER ITDRPTR, ITDCPTR, ISRRPTR + INTEGER OSRRPTR, ISRCPTR, OSRCPTR + INTEGER NB1, NB2, NB3 + REAL EPS + INTEGER ITER, NZIND, IR, IC + REAL ELM + INTEGER TAG_COMM_COL + PARAMETER(TAG_COMM_COL=100) + INTEGER TAG_COMM_ROW + PARAMETER(TAG_COMM_ROW=101) + INTEGER TAG_ITERS + PARAMETER(TAG_ITERS=102) + EXTERNAL CMUMPS_654, + & CMUMPS_672, + & CMUMPS_674, + & CMUMPS_662, + & CMUMPS_743, + & CMUMPS_745, + & CMUMPS_660, + & CMUMPS_670, + & CMUMPS_671, + & CMUMPS_657, + & CMUMPS_656 + INTEGER CMUMPS_743 + INTEGER CMUMPS_745 + REAL CMUMPS_737 + REAL CMUMPS_738 + INTRINSIC abs + REAL RONE, RZERO + PARAMETER(RONE=1.0E0,RZERO=0.0E0) + INTEGER RESZR, RESZC + INTEGER INTSZR, INTSZC + INTEGER MAXMN + INTEGER I, IERROR + REAL ONEERRROW, ONEERRCOL, ONEERRL, ONEERRG + REAL INFERRROW, INFERRCOL, INFERRL, INFERRG + INTEGER OORANGEIND + INFERRG = -RONE + ONEERRG = -RONE + OORANGEIND = 0 + MAXMN = M + IF(MAXMN < N) MAXMN = N + IF(OP == 1) THEN + IF(NUMPROCS > 1) THEN + CALL CMUMPS_654(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & RPARTVEC, M, N, + & IWRK, IWRKSZ) + CALL CMUMPS_654(MYID, NUMPROCS, COMM, + & JCN_loc, IRN_loc, NZ_loc, + & CPARTVEC, N, M, + & IWRK, IWRKSZ) + CALL CMUMPS_672(MYID, NUMPROCS, M, RPARTVEC, + & NZ_loc, IRN_loc, N, JCN_loc, + & IRSNDRCVNUM,IRSNDRCVVOL, + & ORSNDRCVNUM,ORSNDRCVVOL, + & IWRK,IWRKSZ, + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), COMM) + CALL CMUMPS_672(MYID, NUMPROCS, N, CPARTVEC, + & NZ_loc, JCN_loc, M, IRN_loc, + & ICSNDRCVNUM,ICSNDRCVVOL, + & OCSNDRCVNUM,OCSNDRCVVOL, + & IWRK,IWRKSZ, + & CSNDRCVSZ(1), CSNDRCVSZ(1+NUMPROCS), COMM) + CALL CMUMPS_662(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & RPARTVEC, CPARTVEC, M, N, + & INUMMYR, + & INUMMYC, + & IWRK, IWRKSZ) + INTSZR = IRSNDRCVNUM + ORSNDRCVNUM + + & IRSNDRCVVOL + ORSNDRCVVOL + + & 2*(NUMPROCS+1) + INUMMYR + INTSZC = ICSNDRCVNUM + OCSNDRCVNUM + + & ICSNDRCVVOL + OCSNDRCVVOL + + & 2*(NUMPROCS+1) + INUMMYC + INTSZ = INTSZR + INTSZC + MAXMN + + & (MPI_STATUS_SIZE +1) * NUMPROCS + ELSE + IRSNDRCVNUM = 0 + ORSNDRCVNUM = 0 + IRSNDRCVVOL = 0 + ORSNDRCVVOL = 0 + INUMMYR = 0 + ICSNDRCVNUM = 0 + OCSNDRCVNUM = 0 + ICSNDRCVVOL = 0 + OCSNDRCVVOL = 0 + INUMMYC = 0 + INTSZ = 0 + ENDIF + RESZR = M + IRSNDRCVVOL + ORSNDRCVVOL + RESZC = N + ICSNDRCVVOL + OCSNDRCVVOL + RESZ = RESZR + RESZC + REGISTRE(1) = IRSNDRCVNUM + REGISTRE(2) = ORSNDRCVNUM + REGISTRE(3) = IRSNDRCVVOL + REGISTRE(4) = ORSNDRCVVOL + REGISTRE(5) = ICSNDRCVNUM + REGISTRE(6) = OCSNDRCVNUM + REGISTRE(7) = ICSNDRCVVOL + REGISTRE(8) = OCSNDRCVVOL + REGISTRE(9) = INUMMYR + REGISTRE(10) = INUMMYC + REGISTRE(11) = INTSZ + REGISTRE(12) = RESZ + ELSE + IRSNDRCVNUM = REGISTRE(1) + ORSNDRCVNUM = REGISTRE(2) + IRSNDRCVVOL = REGISTRE(3) + ORSNDRCVVOL = REGISTRE(4) + ICSNDRCVNUM = REGISTRE(5) + OCSNDRCVNUM = REGISTRE(6) + ICSNDRCVVOL = REGISTRE(7) + OCSNDRCVVOL = REGISTRE(8) + INUMMYR = REGISTRE(9) + INUMMYC = REGISTRE(10) + IF(NUMPROCS > 1) THEN + CALL CMUMPS_660(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & RPARTVEC, CPARTVEC, M, N, + & IWRK(1), INUMMYR, + & IWRK(1+INUMMYR), INUMMYC, + & IWRK(1+INUMMYR+INUMMYC), IWRKSZ-INUMMYR-INUMMYC ) + IMYRPTR = 1 + IMYCPTR = IMYRPTR + INUMMYR + IRNGHBPRCS = IMYCPTR+ INUMMYC + IRSNDRCVIA = IRNGHBPRCS+IRSNDRCVNUM + IRSNDRCVJA = IRSNDRCVIA + NUMPROCS+1 + ORNGHBPRCS = IRSNDRCVJA + IRSNDRCVVOL + ORSNDRCVIA = ORNGHBPRCS + ORSNDRCVNUM + ORSNDRCVJA = ORSNDRCVIA + NUMPROCS + 1 + ICNGHBPRCS = ORSNDRCVJA + ORSNDRCVVOL + ICSNDRCVIA = ICNGHBPRCS + ICSNDRCVNUM + ICSNDRCVJA = ICSNDRCVIA + NUMPROCS+1 + OCNGHBPRCS = ICSNDRCVJA + ICSNDRCVVOL + OCSNDRCVIA = OCNGHBPRCS + OCSNDRCVNUM + OCSNDRCVJA = OCSNDRCVIA + NUMPROCS + 1 + REQUESTS = OCSNDRCVJA + OCSNDRCVVOL + ISTATUS = REQUESTS + NUMPROCS + TMPWORK = ISTATUS + MPI_STATUS_SIZE * NUMPROCS + CALL CMUMPS_674(MYID, NUMPROCS, M, RPARTVEC, + & NZ_loc, IRN_loc,N, JCN_loc, + & IRSNDRCVNUM, IRSNDRCVVOL, + & IWRK(IRNGHBPRCS),IWRK(IRSNDRCVIA),IWRK(IRSNDRCVJA), + & ORSNDRCVNUM, ORSNDRCVVOL, + & IWRK(ORNGHBPRCS),IWRK(ORSNDRCVIA),IWRK(ORSNDRCVJA), + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), + & IWRK(TMPWORK), + & IWRK(ISTATUS), IWRK(REQUESTS), + & TAG_COMM_ROW, COMM) + CALL CMUMPS_674(MYID, NUMPROCS, N, CPARTVEC, + & NZ_loc, JCN_loc, M, IRN_loc, + & ICSNDRCVNUM, ICSNDRCVVOL, + & IWRK(ICNGHBPRCS), + & IWRK(ICSNDRCVIA), + & IWRK(ICSNDRCVJA), + & OCSNDRCVNUM, OCSNDRCVVOL, + & IWRK(OCNGHBPRCS),IWRK(OCSNDRCVIA),IWRK(OCSNDRCVJA), + & CSNDRCVSZ(1), CSNDRCVSZ(1+NUMPROCS), + & IWRK(TMPWORK), + & IWRK(ISTATUS), IWRK(REQUESTS), + & TAG_COMM_COL, COMM) + CALL CMUMPS_670(ROWSCA, M, RZERO) + CALL CMUMPS_670(COLSCA, N, RZERO) + CALL CMUMPS_671(ROWSCA, M, + & IWRK(IMYRPTR),INUMMYR, RONE) + CALL CMUMPS_671(COLSCA, N, + & IWRK(IMYCPTR),INUMMYC, RONE) + ELSE + CALL CMUMPS_670(ROWSCA, M, RONE) + CALL CMUMPS_670(COLSCA, N, RONE) + ENDIF + ITDRPTR = 1 + ITDCPTR = ITDRPTR + M + ISRRPTR = ITDCPTR + N + OSRRPTR = ISRRPTR + IRSNDRCVVOL + ISRCPTR = OSRRPTR + ORSNDRCVVOL + OSRCPTR = ISRCPTR + ICSNDRCVVOL + IF(NUMPROCS == 1)THEN + OSRCPTR = OSRCPTR - 1 + ISRCPTR = ISRCPTR - 1 + OSRRPTR = OSRRPTR - 1 + ISRRPTR = ISRRPTR - 1 + ELSE + IF(IRSNDRCVVOL == 0) ISRRPTR = ISRRPTR - 1 + IF(ORSNDRCVVOL == 0) OSRRPTR = OSRRPTR - 1 + IF(ICSNDRCVVOL == 0) ISRCPTR = ISRCPTR - 1 + IF(OCSNDRCVVOL == 0) OSRCPTR = OSRCPTR - 1 + ENDIF + ITER = 1 + DO WHILE (ITER.LE.NB1+NB2+NB3) + IF(NUMPROCS > 1) THEN + CALL CMUMPS_650(WRKRC(ITDRPTR),M, + & IWRK(IMYRPTR),INUMMYR) + CALL CMUMPS_650(WRKRC(ITDCPTR),N, + & IWRK(IMYCPTR),INUMMYC) + ELSE + CALL CMUMPS_670(WRKRC(ITDRPTR),M, RZERO) + CALL CMUMPS_670(WRKRC(ITDCPTR),N, RZERO) + ENDIF + IF((ITER.LE.NB1).OR.(ITER > NB1+NB2)) THEN + IF((ITER.EQ.1).OR.(OORANGEIND.EQ.1)) THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*ROWSCA(IR)*COLSCA(IC) + IF(WRKRC(ITDRPTR-1+IR) 1) THEN + CALL CMUMPS_657(MYID, NUMPROCS, + & WRKRC(ITDCPTR), N, TAG_ITERS+ITER, + & ICSNDRCVNUM,IWRK(ICNGHBPRCS), + & ICSNDRCVVOL,IWRK(ICSNDRCVIA), IWRK(ICSNDRCVJA), + & WRKRC(ISRCPTR), + & OCSNDRCVNUM,IWRK(OCNGHBPRCS), + & OCSNDRCVVOL,IWRK(OCSNDRCVIA), IWRK(OCSNDRCVJA), + & WRKRC( OSRCPTR), + & IWRK(ISTATUS),IWRK(REQUESTS), + & COMM) + CALL CMUMPS_657(MYID, NUMPROCS, + & WRKRC(ITDRPTR), M, TAG_ITERS+2+ITER, + & IRSNDRCVNUM,IWRK(IRNGHBPRCS), + & IRSNDRCVVOL,IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM,IWRK(ORNGHBPRCS), + & ORSNDRCVVOL,IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS),IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRROW = CMUMPS_737(ROWSCA, + & WRKRC(ITDRPTR), M, + & IWRK(IMYRPTR),INUMMYR) + INFERRCOL = CMUMPS_737(COLSCA, + & WRKRC(ITDCPTR), N, + & IWRK(IMYCPTR),INUMMYC) + INFERRL = INFERRCOL + IF(INFERRROW > INFERRL ) THEN + INFERRL = INFERRROW + ENDIF + CALL MPI_ALLREDUCE(INFERRL, INFERRG, + & 1, MPI_REAL, + & MPI_MAX, COMM, IERROR) + IF(INFERRG.LE.EPS) THEN + CALL CMUMPS_665(COLSCA, WRKRC(ITDCPTR), + & N, + & IWRK(IMYCPTR),INUMMYC) + CALL CMUMPS_665(ROWSCA, WRKRC(ITDRPTR), + & M, + & IWRK(IMYRPTR),INUMMYR) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRROW = CMUMPS_738(ROWSCA, + & WRKRC(ITDRPTR), M) + INFERRCOL = CMUMPS_738(COLSCA, + & WRKRC(ITDCPTR), N) + INFERRL = INFERRCOL + IF(INFERRROW > INFERRL) THEN + INFERRL = INFERRROW + ENDIF + INFERRG = INFERRL + IF(INFERRG.LE.EPS) THEN + CALL CMUMPS_666(COLSCA, WRKRC(ITDCPTR), N) + CALL CMUMPS_666(ROWSCA, WRKRC(ITDRPTR), M) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + IF((ITER .EQ.1).OR.(OORANGEIND.EQ.1))THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*ROWSCA(IR)*COLSCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + WRKRC(ITDCPTR-1+IC) = WRKRC(ITDCPTR-1+IC) + ELM + ELSE + OORANGEIND = 1 + ENDIF + ENDDO + ELSEIF(OORANGEIND.EQ.0) THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + ELM = abs(A_loc(NZIND))*ROWSCA(IR)*COLSCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + WRKRC(ITDCPTR-1+IC) = WRKRC(ITDCPTR-1+IC) + ELM + ENDDO + ENDIF + IF(NUMPROCS > 1) THEN + CALL CMUMPS_656(MYID, NUMPROCS, + & WRKRC(ITDCPTR), N, TAG_ITERS+ITER, + & ICSNDRCVNUM, IWRK(ICNGHBPRCS), + & ICSNDRCVVOL, IWRK(ICSNDRCVIA), IWRK(ICSNDRCVJA), + & WRKRC(ISRCPTR), + & OCSNDRCVNUM, IWRK(OCNGHBPRCS), + & OCSNDRCVVOL, IWRK(OCSNDRCVIA), IWRK(OCSNDRCVJA), + & WRKRC( OSRCPTR), + & IWRK(ISTATUS), IWRK(REQUESTS), + & COMM) + CALL CMUMPS_656(MYID, NUMPROCS, + & WRKRC(ITDRPTR), M, TAG_ITERS+2+ITER, + & IRSNDRCVNUM, IWRK(IRNGHBPRCS), + & IRSNDRCVVOL, IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM, IWRK(ORNGHBPRCS), + & ORSNDRCVVOL, IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS), IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRROW = CMUMPS_737(ROWSCA, + & WRKRC(ITDRPTR), M, + & IWRK(IMYRPTR),INUMMYR) + ONEERRCOL = CMUMPS_737(COLSCA, + & WRKRC(ITDCPTR), N, + & IWRK(IMYCPTR),INUMMYC) + ONEERRL = ONEERRCOL + IF(ONEERRROW > ONEERRL ) THEN + ONEERRL = ONEERRROW + ENDIF + CALL MPI_ALLREDUCE(ONEERRL, ONEERRG, + & 1, MPI_REAL, + & MPI_MAX, COMM, IERROR) + IF(ONEERRG.LE.EPS) THEN + CALL CMUMPS_665(COLSCA, WRKRC(ITDCPTR), + & N, + & IWRK(IMYCPTR),INUMMYC) + CALL CMUMPS_665(ROWSCA, WRKRC(ITDRPTR), + & M, + & IWRK(IMYRPTR),INUMMYR) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRROW = CMUMPS_738(ROWSCA, + & WRKRC(ITDRPTR), M) + ONEERRCOL = CMUMPS_738(COLSCA, + & WRKRC(ITDCPTR), N) + ONEERRL = ONEERRCOL + IF(ONEERRROW > ONEERRL) THEN + ONEERRL = ONEERRROW + ENDIF + ONEERRG = ONEERRL + IF(ONEERRG.LE.EPS) THEN + CALL CMUMPS_666(COLSCA, WRKRC(ITDCPTR), N) + CALL CMUMPS_666(ROWSCA, WRKRC(ITDRPTR), M) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ENDIF + ENDIF + IF(NUMPROCS > 1) THEN + CALL CMUMPS_665(COLSCA, WRKRC(ITDCPTR), N, + & IWRK(IMYCPTR),INUMMYC) + CALL CMUMPS_665(ROWSCA, WRKRC(ITDRPTR), M, + & IWRK(IMYRPTR),INUMMYR) + ELSE + CALL CMUMPS_666(COLSCA, WRKRC(ITDCPTR), N) + CALL CMUMPS_666(ROWSCA, WRKRC(ITDRPTR), M) + ENDIF + ITER = ITER + 1 + ENDDO + ONENORMERR = ONEERRG + INFNORMERR = INFERRG + IF(NUMPROCS > 1) THEN + CALL MPI_REDUCE(ROWSCA, WRKRC(1), M, MPI_REAL, + & MPI_MAX, 0, + & COMM, IERROR) + IF(MYID.EQ.0) THEN + DO I=1, M + ROWSCA(I) = WRKRC(I) + ENDDO + ENDIF + CALL MPI_REDUCE(COLSCA, WRKRC(1+M), N, MPI_REAL, + & MPI_MAX, 0, + & COMM, IERROR) + If(MYID.EQ.0) THEN + DO I=1, N + COLSCA(I) = WRKRC(I+M) + ENDDO + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_694 + SUBROUTINE CMUMPS_687(IRN_loc, JCN_loc, A_loc, NZ_loc, + & N, NUMPROCS, MYID, COMM, + & PARTVEC, + & RSNDRCVSZ, + & REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & SCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER NZ_loc, N, IWRKSZ, OP + INTEGER NUMPROCS, MYID, COMM + INTEGER INTSZ, RESZ + INTEGER IRN_loc(NZ_loc) + INTEGER JCN_loc(NZ_loc) + COMPLEX A_loc(NZ_loc) + INTEGER PARTVEC(N), RSNDRCVSZ(2*NUMPROCS) + INTEGER IWRK(IWRKSZ) + INTEGER REGISTRE(12) + REAL SCA(N) + INTEGER ISZWRKRC + REAL WRKRC(ISZWRKRC) + INTEGER IRSNDRCVNUM, ORSNDRCVNUM + INTEGER IRSNDRCVVOL, ORSNDRCVVOL + INTEGER INUMMYR + INTEGER IMYRPTR,IMYCPTR + INTEGER IRNGHBPRCS, IRSNDRCVIA,IRSNDRCVJA + INTEGER ORNGHBPRCS, ORSNDRCVIA,ORSNDRCVJA + INTEGER ISTATUS, REQUESTS, TMPWORK + INTEGER ITDRPTR, ISRRPTR, OSRRPTR + REAL ONENORMERR,INFNORMERR + INTEGER NB1, NB2, NB3 + REAL EPS + INTEGER ITER, NZIND, IR, IC + REAL ELM + INTEGER TAG_COMM_ROW + PARAMETER(TAG_COMM_ROW=101) + INTEGER TAG_ITERS + PARAMETER(TAG_ITERS=102) + EXTERNAL CMUMPS_655, + & CMUMPS_673, + & CMUMPS_692, + & CMUMPS_663, + & CMUMPS_742, + & CMUMPS_745, + & CMUMPS_661, + & CMUMPS_657, + & CMUMPS_656, + & CMUMPS_670, + & CMUMPS_671 + INTEGER CMUMPS_742 + INTEGER CMUMPS_745 + REAL CMUMPS_737 + REAL CMUMPS_738 + INTRINSIC abs + REAL RONE, RZERO + PARAMETER(RONE=1.0E0,RZERO=0.0E0) + INTEGER INTSZR + INTEGER MAXMN + INTEGER I, IERROR + REAL ONEERRL, ONEERRG + REAL INFERRL, INFERRG + INTEGER OORANGEIND + OORANGEIND = 0 + INFERRG = -RONE + ONEERRG = -RONE + MAXMN = N + IF(OP == 1) THEN + IF(NUMPROCS > 1) THEN + CALL CMUMPS_655(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & IWRK, IWRKSZ) + CALL CMUMPS_673(MYID, NUMPROCS, N, PARTVEC, + & NZ_loc, IRN_loc,JCN_loc, IRSNDRCVNUM,IRSNDRCVVOL, + & ORSNDRCVNUM, ORSNDRCVVOL, + & IWRK,IWRKSZ, + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), COMM) + CALL CMUMPS_663(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & INUMMYR, + & IWRK, IWRKSZ) + INTSZR = IRSNDRCVNUM + ORSNDRCVNUM + + & IRSNDRCVVOL + ORSNDRCVVOL + + & 2*(NUMPROCS+1) + INUMMYR + INTSZ = INTSZR + N + + & (MPI_STATUS_SIZE +1) * NUMPROCS + ELSE + IRSNDRCVNUM = 0 + ORSNDRCVNUM = 0 + IRSNDRCVVOL = 0 + ORSNDRCVVOL = 0 + INUMMYR = 0 + INTSZ = 0 + ENDIF + RESZ = N + IRSNDRCVVOL + ORSNDRCVVOL + REGISTRE(1) = IRSNDRCVNUM + REGISTRE(2) = ORSNDRCVNUM + REGISTRE(3) = IRSNDRCVVOL + REGISTRE(4) = ORSNDRCVVOL + REGISTRE(9) = INUMMYR + REGISTRE(11) = INTSZ + REGISTRE(12) = RESZ + ELSE + IRSNDRCVNUM = REGISTRE(1) + ORSNDRCVNUM = REGISTRE(2) + IRSNDRCVVOL = REGISTRE(3) + ORSNDRCVVOL = REGISTRE(4) + INUMMYR = REGISTRE(9) + IF(NUMPROCS > 1) THEN + CALL CMUMPS_661(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & IWRK(1), INUMMYR, + & IWRK(1+INUMMYR), IWRKSZ-INUMMYR) + IMYRPTR = 1 + IMYCPTR = IMYRPTR + INUMMYR + IRNGHBPRCS = IMYCPTR + IRSNDRCVIA = IRNGHBPRCS+IRSNDRCVNUM + IRSNDRCVJA = IRSNDRCVIA + NUMPROCS+1 + ORNGHBPRCS = IRSNDRCVJA + IRSNDRCVVOL + ORSNDRCVIA = ORNGHBPRCS + ORSNDRCVNUM + ORSNDRCVJA = ORSNDRCVIA + NUMPROCS + 1 + REQUESTS = ORSNDRCVJA + ORSNDRCVVOL + ISTATUS = REQUESTS + NUMPROCS + TMPWORK = ISTATUS + MPI_STATUS_SIZE * NUMPROCS + CALL CMUMPS_692(MYID, NUMPROCS, N, PARTVEC, + & NZ_loc, IRN_loc, JCN_loc, + & IRSNDRCVNUM, IRSNDRCVVOL, + & IWRK(IRNGHBPRCS),IWRK(IRSNDRCVIA),IWRK(IRSNDRCVJA), + & ORSNDRCVNUM, ORSNDRCVVOL, + & IWRK(ORNGHBPRCS),IWRK(ORSNDRCVIA),IWRK(ORSNDRCVJA), + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), + & IWRK(TMPWORK), + & IWRK(ISTATUS), IWRK(REQUESTS), + & TAG_COMM_ROW, COMM) + CALL CMUMPS_670(SCA, N, RZERO) + CALL CMUMPS_671(SCA, N, + & IWRK(IMYRPTR),INUMMYR, RONE) + ELSE + CALL CMUMPS_670(SCA, N, RONE) + ENDIF + ITDRPTR = 1 + ISRRPTR = ITDRPTR + N + OSRRPTR = ISRRPTR + IRSNDRCVVOL + IF(NUMPROCS == 1)THEN + OSRRPTR = OSRRPTR - 1 + ISRRPTR = ISRRPTR - 1 + ELSE + IF(IRSNDRCVVOL == 0) ISRRPTR = ISRRPTR - 1 + IF(ORSNDRCVVOL == 0) OSRRPTR = OSRRPTR - 1 + ENDIF + ITER = 1 + DO WHILE(ITER.LE.NB1+NB2+NB3) + IF(NUMPROCS > 1) THEN + CALL CMUMPS_650(WRKRC(ITDRPTR),N, + & IWRK(IMYRPTR),INUMMYR) + ELSE + CALL CMUMPS_670(WRKRC(ITDRPTR),N, RZERO) + ENDIF + IF((ITER.LE.NB1).OR.(ITER > NB1+NB2)) THEN + IF((ITER.EQ.1).OR.(OORANGEIND.EQ.1)) THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*SCA(IR)*SCA(IC) + IF(WRKRC(ITDRPTR-1+IR) 1) THEN + CALL CMUMPS_657(MYID, NUMPROCS, + & WRKRC(ITDRPTR), N, TAG_ITERS+2+ITER, + & IRSNDRCVNUM,IWRK(IRNGHBPRCS), + & IRSNDRCVVOL,IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM,IWRK(ORNGHBPRCS), + & ORSNDRCVVOL,IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS),IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRL = CMUMPS_737(SCA, + & WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + CALL MPI_ALLREDUCE(INFERRL, INFERRG, + & 1, MPI_REAL, + & MPI_MAX, COMM, IERROR) + IF(INFERRG.LE.EPS) THEN + CALL CMUMPS_665(SCA, WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRL = CMUMPS_738(SCA, + & WRKRC(ITDRPTR), N) + INFERRG = INFERRL + IF(INFERRG.LE.EPS) THEN + CALL CMUMPS_666(SCA, WRKRC(ITDRPTR), N) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + IF((ITER.EQ.1).OR.(OORANGEIND.EQ.1))THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*SCA(IR)*SCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + IF(IR.NE.IC) THEN + WRKRC(ITDRPTR-1+IC) = + & WRKRC(ITDRPTR-1+IC) + ELM + ENDIF + ELSE + OORANGEIND = 1 + ENDIF + ENDDO + ELSEIF(OORANGEIND.EQ.0)THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + ELM = abs(A_loc(NZIND))*SCA(IR)*SCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + IF(IR.NE.IC) THEN + WRKRC(ITDRPTR-1+IC) = WRKRC(ITDRPTR-1+IC) + ELM + ENDIF + ENDDO + ENDIF + IF(NUMPROCS > 1) THEN + CALL CMUMPS_656(MYID, NUMPROCS, + & WRKRC(ITDRPTR), N, TAG_ITERS+2+ITER, + & IRSNDRCVNUM, IWRK(IRNGHBPRCS), + & IRSNDRCVVOL, IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM, IWRK(ORNGHBPRCS), + & ORSNDRCVVOL, IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS), IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRL = CMUMPS_737(SCA, + & WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + CALL MPI_ALLREDUCE(ONEERRL, ONEERRG, + & 1, MPI_REAL, + & MPI_MAX, COMM, IERROR) + IF(ONEERRG.LE.EPS) THEN + CALL CMUMPS_665(SCA, WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRL = CMUMPS_738(SCA, + & WRKRC(ITDRPTR), N) + ONEERRG = ONEERRL + IF(ONEERRG.LE.EPS) THEN + CALL CMUMPS_666(SCA, WRKRC(ITDRPTR), N) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ENDIF + ENDIF + IF(NUMPROCS > 1) THEN + CALL CMUMPS_665(SCA, WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + ELSE + CALL CMUMPS_666(SCA, WRKRC(ITDRPTR), N) + ENDIF + ITER = ITER + 1 + ENDDO + ONENORMERR = ONEERRG + INFNORMERR = INFERRG + IF(NUMPROCS > 1) THEN + CALL MPI_REDUCE(SCA, WRKRC(1), N, MPI_REAL, + & MPI_MAX, 0, + & COMM, IERROR) + IF(MYID.EQ.0) THEN + DO I=1, N + SCA(I) = WRKRC(I) + ENDDO + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_687 + SUBROUTINE CMUMPS_654(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & IPARTVEC, ISZ, OSZ, + & IWRK, IWSZ) + IMPLICIT NONE + EXTERNAL CMUMPS_703 + INTEGER MYID, NUMPROCS, COMM + INTEGER NZ_loc, ISZ, IWSZ, OSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWSZ) + INCLUDE 'mpif.h' + INTEGER I + INTEGER OP, IERROR + INTEGER IR, IC + IF(NUMPROCS.NE.1) THEN + CALL MPI_OP_CREATE(CMUMPS_703, .TRUE., OP, IERROR) + CALL CMUMPS_668(IWRK, 4*ISZ, ISZ) + DO I=1,ISZ + IWRK(2*I-1) = 0 + IWRK(2*I) = MYID + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.ISZ).AND. + & (IC.GE.1).AND.(IC.LE.OSZ)) THEN + IWRK(2*IR-1) = IWRK(2*IR-1) + 1 + ENDIF + ENDDO + CALL MPI_ALLREDUCE(IWRK(1), IWRK(1+2*ISZ), ISZ, + & MPI_2INTEGER, OP, COMM, IERROR) + DO I=1,ISZ + IPARTVEC(I) = IWRK(2*I+2*ISZ) + ENDDO + CALL MPI_OP_FREE(OP, IERROR) + ELSE + DO I=1,ISZ + IPARTVEC(I) = 0 + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_654 + SUBROUTINE CMUMPS_662(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & ROWPARTVEC, COLPARTVEC, M, N, + & INUMMYR, + & INUMMYC, + & IWRK, IWSZ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, M, N + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER ROWPARTVEC(M) + INTEGER COLPARTVEC(N) + INTEGER INUMMYR, INUMMYC + INTEGER IWSZ + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC + INUMMYR = 0 + INUMMYC = 0 + DO I=1,M + IWRK(I) = 0 + IF(ROWPARTVEC(I).EQ.MYID) THEN + IWRK(I)=1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IR) .EQ. 0) THEN + IWRK(IR)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + ENDDO + DO I=1,N + IWRK(I) = 0 + IF(COLPARTVEC(I).EQ.MYID) THEN + IWRK(I)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IC = JCN_loc(I) + IR = IRN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IC) .EQ. 0) THEN + IWRK(IC)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_662 + SUBROUTINE CMUMPS_660(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & ROWPARTVEC, COLPARTVEC, M, N, + & MYROWINDICES, INUMMYR, + & MYCOLINDICES, INUMMYC, + & IWRK, IWSZ ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, M, N + INTEGER INUMMYR, INUMMYC, IWSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER ROWPARTVEC(M) + INTEGER COLPARTVEC(N) + INTEGER MYROWINDICES(INUMMYR) + INTEGER MYCOLINDICES(INUMMYC) + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC, ITMP, MAXMN + MAXMN = M + IF(N > MAXMN) MAXMN = N + DO I=1,M + IWRK(I) = 0 + IF(ROWPARTVEC(I).EQ.MYID) IWRK(I)=1 + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IR) .EQ. 0) IWRK(IR)= 1 + ENDIF + ENDDO + ITMP = 1 + DO I=1,M + IF(IWRK(I).EQ.1) THEN + MYROWINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + DO I=1,N + IWRK(I) = 0 + IF(COLPARTVEC(I).EQ.MYID) IWRK(I)= 1 + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IC) .EQ. 0) IWRK(IC)= 1 + ENDIF + ENDDO + ITMP = 1 + DO I=1,N + IF(IWRK(I).EQ.1) THEN + MYCOLINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_660 + INTEGER FUNCTION CMUMPS_744(D, DSZ, INDX, INDXSZ, EPS) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + REAL D(DSZ) + INTEGER INDX(INDXSZ) + REAL EPS + INTEGER I, IID + REAL RONE + PARAMETER(RONE=1.0E0) + CMUMPS_744 = 1 + DO I=1, INDXSZ + IID = INDX(I) + IF (.NOT.( (D(IID).LE.(RONE+EPS)).AND. + & ((RONE-EPS).LE.D(IID)) )) THEN + CMUMPS_744 = 0 + ENDIF + ENDDO + RETURN + END FUNCTION CMUMPS_744 + INTEGER FUNCTION CMUMPS_745(D, DSZ, EPS) + IMPLICIT NONE + INTEGER DSZ + REAL D(DSZ) + REAL EPS + INTEGER I + REAL RONE + PARAMETER(RONE=1.0E0) + CMUMPS_745 = 1 + DO I=1, DSZ + IF (.NOT.( (D(I).LE.(RONE+EPS)).AND. + & ((RONE-EPS).LE.D(I)) )) THEN + CMUMPS_745 = 0 + ENDIF + ENDDO + RETURN + END FUNCTION CMUMPS_745 + INTEGER FUNCTION CMUMPS_743(DR, M, INDXR, INDXRSZ, + & DC, N, INDXC, INDXCSZ, EPS, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER M, N, INDXRSZ, INDXCSZ + REAL DR(M), DC(N) + INTEGER INDXR(INDXRSZ), INDXC(INDXCSZ) + REAL EPS + INTEGER COMM + EXTERNAL CMUMPS_744 + INTEGER CMUMPS_744 + INTEGER GLORES, MYRESR, MYRESC, MYRES + INTEGER IERR + MYRESR = CMUMPS_744(DR, M, INDXR, INDXRSZ, EPS) + MYRESC = CMUMPS_744(DC, N, INDXC, INDXCSZ, EPS) + MYRES = MYRESR + MYRESC + CALL MPI_ALLREDUCE(MYRES, GLORES, 1, MPI_INTEGER, + & MPI_SUM, COMM, IERR) + CMUMPS_743 = GLORES + RETURN + END FUNCTION CMUMPS_743 + REAL FUNCTION CMUMPS_737(D, TMPD, DSZ, + & INDX, INDXSZ) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + REAL D(DSZ) + REAL TMPD(DSZ) + INTEGER INDX(INDXSZ) + REAL RONE + PARAMETER(RONE=1.0E0) + INTEGER I, IIND + REAL ERRMAX + INTRINSIC abs + ERRMAX = -RONE + DO I=1,INDXSZ + IIND = INDX(I) + IF(abs(RONE-TMPD(IIND)).GT.ERRMAX) THEN + ERRMAX = abs(RONE-TMPD(IIND)) + ENDIF + ENDDO + CMUMPS_737 = ERRMAX + RETURN + END FUNCTION CMUMPS_737 + REAL FUNCTION CMUMPS_738(D, TMPD, DSZ) + IMPLICIT NONE + INTEGER DSZ + REAL D(DSZ) + REAL TMPD(DSZ) + REAL RONE + PARAMETER(RONE=1.0E0) + INTEGER I + REAL ERRMAX1 + INTRINSIC abs + ERRMAX1 = -RONE + DO I=1,DSZ + IF(abs(RONE-TMPD(I)).GT.ERRMAX1) THEN + ERRMAX1 = abs(RONE-TMPD(I)) + ENDIF + ENDDO + CMUMPS_738 = ERRMAX1 + RETURN + END FUNCTION CMUMPS_738 + SUBROUTINE CMUMPS_665(D, TMPD, DSZ, + & INDX, INDXSZ) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + REAL D(DSZ) + REAL TMPD(DSZ) + INTEGER INDX(INDXSZ) + INTRINSIC sqrt + INTEGER I, IIND + REAL RZERO + PARAMETER(RZERO=0.0E0) + DO I=1,INDXSZ + IIND = INDX(I) + IF (TMPD(IIND).NE.RZERO) D(IIND) = D(IIND)/sqrt(TMPD(IIND)) + ENDDO + RETURN + END SUBROUTINE CMUMPS_665 + SUBROUTINE CMUMPS_666(D, TMPD, DSZ) + IMPLICIT NONE + INTEGER DSZ + REAL D(DSZ) + REAL TMPD(DSZ) + INTRINSIC sqrt + INTEGER I + REAL RZERO + PARAMETER(RZERO=0.0E0) + DO I=1,DSZ + IF (TMPD(I) .NE. RZERO) D(I) = D(I)/sqrt(TMPD(I)) + ENDDO + RETURN + END SUBROUTINE CMUMPS_666 + SUBROUTINE CMUMPS_671(D, DSZ, INDX, INDXSZ, VAL) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + REAL D(DSZ) + INTEGER INDX(INDXSZ) + REAL VAL + INTEGER I, IIND + DO I=1,INDXSZ + IIND = INDX(I) + D(IIND) = VAL + ENDDO + RETURN + END SUBROUTINE CMUMPS_671 + SUBROUTINE CMUMPS_702(D, DSZ, INDX, INDXSZ) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + REAL D(DSZ) + INTEGER INDX(INDXSZ) + INTEGER I, IIND + DO I=1,INDXSZ + IIND = INDX(I) + D(IIND) = 1.0E0/D(IIND) + ENDDO + RETURN + END SUBROUTINE CMUMPS_702 + SUBROUTINE CMUMPS_670(D, DSZ, VAL) + IMPLICIT NONE + INTEGER DSZ + REAL D(DSZ) + REAL VAL + INTEGER I + DO I=1,DSZ + D(I) = VAL + ENDDO + RETURN + END SUBROUTINE CMUMPS_670 + SUBROUTINE CMUMPS_650(TMPD, TMPSZ, INDX, INDXSZ) + IMPLICIT NONE + INTEGER TMPSZ,INDXSZ + REAL TMPD(TMPSZ) + INTEGER INDX(INDXSZ) + INTEGER I + REAL DZERO + PARAMETER(DZERO=0.0E0) + DO I=1,INDXSZ + TMPD(INDX(I)) = DZERO + ENDDO + RETURN + END SUBROUTINE CMUMPS_650 + SUBROUTINE CMUMPS_703(INV, INOUTV, LEN, DTYPE) + IMPLICIT NONE + INTEGER LEN + INTEGER INV(2*LEN) + INTEGER INOUTV(2*LEN) + INTEGER DTYPE + INTEGER I + INTEGER DIN, DINOUT, PIN, PINOUT + DO I=1,2*LEN-1,2 + DIN = INV(I) + PIN = INV(I+1) + DINOUT = INOUTV(I) + PINOUT = INOUTV(I+1) + IF (DINOUT < DIN) THEN + INOUTV(I) = DIN + INOUTV(I+1) = PIN + ELSE IF (DINOUT == DIN) THEN + IF ((mod(DINOUT,2).EQ.0).AND.(PINPINOUT)) THEN + INOUTV(I+1) = PIN + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_703 + SUBROUTINE CMUMPS_668(IW, IWSZ, IVAL) + IMPLICIT NONE + INTEGER IWSZ + INTEGER IW(IWSZ) + INTEGER IVAL + INTEGER I + DO I=1,IWSZ + IW(I)=IVAL + ENDDO + RETURN + END SUBROUTINE CMUMPS_668 + SUBROUTINE CMUMPS_704(MYID, NUMPROCS, + & IRN_loc, JCN_loc, NZ_loc, + & ROWPARTVEC, COLPARTVEC, M, N, + & MYROWINDICES, INUMMYR, + & MYCOLINDICES, INUMMYC, + & IWRKROW, IWRKCOL, IWSZR, IWSZC, COMM ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, M, N + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER ROWPARTVEC(M) + INTEGER COLPARTVEC(N) + INTEGER MYROWINDICES(M) + INTEGER MYCOLINDICES(N) + INTEGER INUMMYR, INUMMYC + INTEGER IWSZR, IWSZC + INTEGER IWRKROW(IWSZR) + INTEGER IWRKCOL(IWSZC) + INTEGER COMM + INTEGER I, IR, IC, ITMP + INUMMYR = 0 + INUMMYC = 0 + DO I=1,M + IWRKROW(I) = 0 + IF(ROWPARTVEC(I).EQ.MYID) THEN + IWRKROW(I)=1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRKROW(IR) .EQ. 0) THEN + IWRKROW(IR)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + ENDDO + ITMP = 1 + DO I=1,M + IF(IWRKROW(I).EQ.1) THEN + MYROWINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + DO I=1,N + IWRKCOL(I) = 0 + IF(COLPARTVEC(I).EQ.MYID) THEN + IWRKCOL(I)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRKCOL(IC) .EQ. 0) THEN + IWRKCOL(IC)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDIF + ENDDO + ITMP = 1 + DO I=1,N + IF(IWRKCOL(I).EQ.1) THEN + MYCOLINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_704 + SUBROUTINE CMUMPS_672(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX, OSZ, OINDX,ISNDRCVNUM,ISNDRCVVOL, + & OSNDRCVNUM,OSNDRCVVOL, + & IWRK,IWRKSZ, SNDSZ, RCVSZ, COMM) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, IWRKSZ, OSZ + INTEGER ISNDRCVNUM, ISNDRCVVOL + INTEGER OSNDRCVNUM, OSNDRCVVOL + INTEGER COMM + INTEGER INDX(NZ_loc) + INTEGER OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWRKSZ) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INCLUDE 'mpif.h' + INTEGER I + INTEGER IIND, IIND2, PIND + INTEGER IERROR + DO I=1,NUMPROCS + SNDSZ(I) = 0 + RCVSZ(I) = 0 + ENDDO + DO I=1,IWRKSZ + IWRK(I) = 0 + ENDDO + DO I=1,NZ_loc + IIND = INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND. + & (IIND2.GE.1).AND.(IIND2.LE.OSZ))THEN + PIND = IPARTVEC(IIND) + IF(PIND .NE. MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWRK(IIND) = 1 + SNDSZ(PIND+1) = SNDSZ(PIND+1)+1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_ALLTOALL(SNDSZ, 1, MPI_INTEGER, + & RCVSZ, 1, MPI_INTEGER, COMM, IERROR) + ISNDRCVNUM = 0 + ISNDRCVVOL = 0 + OSNDRCVNUM = 0 + OSNDRCVVOL = 0 + DO I=1, NUMPROCS + IF(SNDSZ(I) > 0) OSNDRCVNUM = OSNDRCVNUM + 1 + OSNDRCVVOL = OSNDRCVVOL + SNDSZ(I) + IF(RCVSZ(I) > 0) ISNDRCVNUM = ISNDRCVNUM + 1 + ISNDRCVVOL = ISNDRCVVOL + RCVSZ(I) + ENDDO + RETURN + END SUBROUTINE CMUMPS_672 + SUBROUTINE CMUMPS_674(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX, OSZ, OINDX, + & ISNDRCVNUM, ISNDVOL, INGHBPRCS, ISNDRCVIA, ISNDRCVJA, + & OSNDRCVNUM, OSNDVOL, ONGHBPRCS, OSNDRCVIA, OSNDRCVJA, + & SNDSZ, RCVSZ, IWRK, + & ISTATUS, REQUESTS, + & ITAGCOMM, COMM ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, ISNDVOL, OSNDVOL, OSZ + INTEGER INDX(NZ_loc) + INTEGER OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER ISNDRCVNUM, INGHBPRCS(ISNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1) + INTEGER ISNDRCVJA(ISNDVOL) + INTEGER OSNDRCVNUM, ONGHBPRCS(OSNDRCVNUM) + INTEGER OSNDRCVIA(NUMPROCS+1) + INTEGER OSNDRCVJA(OSNDVOL) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INTEGER IWRK(ISZ) + INTEGER ISTATUS(MPI_STATUS_SIZE, ISNDRCVNUM) + INTEGER REQUESTS(ISNDRCVNUM) + INTEGER ITAGCOMM, COMM + INTEGER I, IIND, IIND2, IPID, OFFS + INTEGER IWHERETO, POFFS, ITMP, IERROR + DO I=1,ISZ + IWRK(I) = 0 + ENDDO + OFFS = 1 + POFFS = 1 + DO I=1,NUMPROCS + OSNDRCVIA(I) = OFFS + SNDSZ(I) + IF(SNDSZ(I) > 0) THEN + ONGHBPRCS(POFFS)=I + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + SNDSZ(I) + ENDDO + OSNDRCVIA(NUMPROCS+1) = OFFS + DO I=1,NZ_loc + IIND=INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND. + & (IIND2.GE.1).AND.(IIND2.LE.OSZ) ) THEN + IPID=IPARTVEC(IIND) + IF(IPID.NE.MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWHERETO = OSNDRCVIA(IPID+1)-1 + OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1 + OSNDRCVJA(IWHERETO) = IIND + IWRK(IIND) = 1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + OFFS = 1 + POFFS = 1 + ISNDRCVIA(1) = 1 + DO I=2,NUMPROCS+1 + ISNDRCVIA(I) = OFFS + RCVSZ(I-1) + IF(RCVSZ(I-1) > 0) THEN + INGHBPRCS(POFFS)=I-1 + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + RCVSZ(I-1) + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + DO I=1, ISNDRCVNUM + IPID = INGHBPRCS(I) + OFFS = ISNDRCVIA(IPID) + ITMP = ISNDRCVIA(IPID+1) - ISNDRCVIA(IPID) + CALL MPI_IRECV(ISNDRCVJA(OFFS), ITMP, MPI_INTEGER,IPID-1, + & ITAGCOMM, COMM, REQUESTS(I),IERROR) + ENDDO + DO I=1,OSNDRCVNUM + IPID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(IPID) + ITMP = OSNDRCVIA(IPID+1)-OSNDRCVIA(IPID) + CALL MPI_SEND(OSNDRCVJA(OFFS), ITMP, MPI_INTEGER, IPID-1, + & ITAGCOMM, COMM,IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + CALL MPI_BARRIER(COMM,IERROR) + RETURN + END SUBROUTINE CMUMPS_674 + SUBROUTINE CMUMPS_657(MYID, NUMPROCS,TMPD, IDSZ, ITAGCOMM, + & ISNDRCVNUM, INGHBPRCS, + & ISNDRCVVOL, ISNDRCVIA, ISNDRCVJA, ISNDRCVA, + & OSNDRCVNUM, ONGHBPRCS, + & OSNDRCVVOL, OSNDRCVIA, OSNDRCVJA, OSNDRCVA, + & ISTATUS, REQUESTS, + & COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, IDSZ, ITAGCOMM + INTEGER ISNDRCVNUM,OSNDRCVNUM, ISNDRCVVOL, OSNDRCVVOL + REAL TMPD(IDSZ) + INTEGER INGHBPRCS(ISNDRCVNUM), ONGHBPRCS(OSNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1), ISNDRCVJA(ISNDRCVVOL) + REAL ISNDRCVA(ISNDRCVVOL) + INTEGER OSNDRCVIA(NUMPROCS+1), OSNDRCVJA(OSNDRCVVOL) + REAL OSNDRCVA(OSNDRCVVOL) + INTEGER ISTATUS(MPI_STATUS_SIZE, max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER REQUESTS(max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER COMM, IERROR + INTEGER I, PID, OFFS, SZ, J, JS, JE, IID + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1) - ISNDRCVIA(PID) + CALL MPI_IRECV(ISNDRCVA(OFFS), SZ, + & MPI_REAL, PID-1, + & ITAGCOMM,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS, JE + IID = OSNDRCVJA(J) + OSNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(OSNDRCVA(OFFS), SZ, MPI_REAL, PID-1, + & ITAGCOMM, COMM, IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1)-1 + DO J=JS,JE + IID = ISNDRCVJA(J) + IF(TMPD(IID) < ISNDRCVA(J)) TMPD(IID)= ISNDRCVA(J) + ENDDO + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + CALL MPI_IRECV(OSNDRCVA(OFFS), SZ, + & MPI_REAL, PID-1, + & ITAGCOMM+1,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1)-ISNDRCVIA(PID) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1) -1 + DO J=JS, JE + IID = ISNDRCVJA(J) + ISNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(ISNDRCVA(OFFS), SZ, MPI_REAL, PID-1, + & ITAGCOMM+1, COMM, IERROR) + ENDDO + IF(OSNDRCVNUM > 0) THEN + CALL MPI_WAITALL(OSNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS,JE + IID = OSNDRCVJA(J) + TMPD(IID)=OSNDRCVA(J) + ENDDO + ENDDO + RETURN + END SUBROUTINE CMUMPS_657 + SUBROUTINE CMUMPS_656(MYID, NUMPROCS,TMPD, IDSZ, ITAGCOMM, + & ISNDRCVNUM, INGHBPRCS, + & ISNDRCVVOL, ISNDRCVIA, ISNDRCVJA, ISNDRCVA, + & OSNDRCVNUM, ONGHBPRCS, + & OSNDRCVVOL, OSNDRCVIA, OSNDRCVJA, OSNDRCVA, + & ISTATUS, REQUESTS, + & COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, IDSZ, ITAGCOMM + INTEGER ISNDRCVNUM,OSNDRCVNUM, ISNDRCVVOL, OSNDRCVVOL + REAL TMPD(IDSZ) + INTEGER INGHBPRCS(ISNDRCVNUM), ONGHBPRCS(OSNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1), ISNDRCVJA(ISNDRCVVOL) + REAL ISNDRCVA(ISNDRCVVOL) + INTEGER OSNDRCVIA(NUMPROCS+1), OSNDRCVJA(OSNDRCVVOL) + REAL OSNDRCVA(OSNDRCVVOL) + INTEGER ISTATUS(MPI_STATUS_SIZE, max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER REQUESTS(max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER COMM, IERROR + INTEGER I, PID, OFFS, SZ, J, JS, JE, IID + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1) - ISNDRCVIA(PID) + CALL MPI_IRECV(ISNDRCVA(OFFS), SZ, + & MPI_REAL, PID-1, + & ITAGCOMM,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS, JE + IID = OSNDRCVJA(J) + OSNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(OSNDRCVA(OFFS), SZ, MPI_REAL, PID-1, + & ITAGCOMM, COMM, IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1)-1 + DO J=JS,JE + IID = ISNDRCVJA(J) + TMPD(IID) = TMPD(IID)+ ISNDRCVA(J) + ENDDO + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + CALL MPI_IRECV(OSNDRCVA(OFFS), SZ, + & MPI_REAL, PID-1, + & ITAGCOMM+1,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1)-ISNDRCVIA(PID) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1) -1 + DO J=JS, JE + IID = ISNDRCVJA(J) + ISNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(ISNDRCVA(OFFS), SZ, MPI_REAL, PID-1, + & ITAGCOMM+1, COMM, IERROR) + ENDDO + IF(OSNDRCVNUM > 0) THEN + CALL MPI_WAITALL(OSNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS,JE + IID = OSNDRCVJA(J) + TMPD(IID)=OSNDRCVA(J) + ENDDO + ENDDO + RETURN + END SUBROUTINE CMUMPS_656 + SUBROUTINE CMUMPS_655(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & IPARTVEC, ISZ, + & IWRK, IWSZ) + IMPLICIT NONE + EXTERNAL CMUMPS_703 + INTEGER MYID, NUMPROCS, COMM + INTEGER NZ_loc, ISZ, IWSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWSZ) + INCLUDE 'mpif.h' + INTEGER I + INTEGER OP, IERROR + INTEGER IR, IC + IF(NUMPROCS.NE.1) THEN + CALL MPI_OP_CREATE(CMUMPS_703, .TRUE., OP, IERROR) + CALL CMUMPS_668(IWRK, 4*ISZ, ISZ) + DO I=1,ISZ + IWRK(2*I-1) = 0 + IWRK(2*I) = MYID + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.ISZ).AND. + & (IC.GE.1).AND.(IC.LE.ISZ)) THEN + IWRK(2*IR-1) = IWRK(2*IR-1) + 1 + IWRK(2*IC-1) = IWRK(2*IC-1) + 1 + ENDIF + ENDDO + CALL MPI_ALLREDUCE(IWRK(1), IWRK(1+2*ISZ), ISZ, + & MPI_2INTEGER, OP, COMM, IERROR) + DO I=1,ISZ + IPARTVEC(I) = IWRK(2*I+2*ISZ) + ENDDO + CALL MPI_OP_FREE(OP, IERROR) + ELSE + DO I=1,ISZ + IPARTVEC(I) = 0 + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_655 + SUBROUTINE CMUMPS_673(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX,OINDX,ISNDRCVNUM,ISNDRCVVOL,OSNDRCVNUM,OSNDRCVVOL, + & IWRK,IWRKSZ, SNDSZ, RCVSZ, COMM) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, IWRKSZ + INTEGER ISNDRCVNUM, ISNDRCVVOL + INTEGER OSNDRCVNUM, OSNDRCVVOL + INTEGER COMM + INTEGER INDX(NZ_loc), OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWRKSZ) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INCLUDE 'mpif.h' + INTEGER I + INTEGER IIND, IIND2, PIND + INTEGER IERROR + DO I=1,NUMPROCS + SNDSZ(I) = 0 + RCVSZ(I) = 0 + ENDDO + DO I=1,IWRKSZ + IWRK(I) = 0 + ENDDO + DO I=1,NZ_loc + IIND = INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND.(IIND2.GE.1) + & .AND.(IIND2.LE.ISZ)) THEN + PIND = IPARTVEC(IIND) + IF(PIND .NE. MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWRK(IIND) = 1 + SNDSZ(PIND+1) = SNDSZ(PIND+1)+1 + ENDIF + ENDIF + IIND = OINDX(I) + PIND = IPARTVEC(IIND) + IF(PIND .NE. MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWRK(IIND) = 1 + SNDSZ(PIND+1) = SNDSZ(PIND+1)+1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_ALLTOALL(SNDSZ, 1, MPI_INTEGER, + & RCVSZ, 1, MPI_INTEGER, COMM, IERROR) + ISNDRCVNUM = 0 + ISNDRCVVOL = 0 + OSNDRCVNUM = 0 + OSNDRCVVOL = 0 + DO I=1, NUMPROCS + IF(SNDSZ(I) > 0) OSNDRCVNUM = OSNDRCVNUM + 1 + OSNDRCVVOL = OSNDRCVVOL + SNDSZ(I) + IF(RCVSZ(I) > 0) ISNDRCVNUM = ISNDRCVNUM + 1 + ISNDRCVVOL = ISNDRCVVOL + RCVSZ(I) + ENDDO + RETURN + END SUBROUTINE CMUMPS_673 + SUBROUTINE CMUMPS_663(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & INUMMYR, + & IWRK, IWSZ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, N + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER PARTVEC(N) + INTEGER INUMMYR + INTEGER IWSZ + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC + INUMMYR = 0 + DO I=1,N + IWRK(I) = 0 + IF(PARTVEC(I).EQ.MYID) THEN + IWRK(I)=1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IR) .EQ. 0) THEN + IWRK(IR)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IC).EQ.0) THEN + IWRK(IC)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_663 + INTEGER FUNCTION CMUMPS_742(D, N, INDXR, INDXRSZ, + & EPS, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER N, INDXRSZ + REAL D(N) + INTEGER INDXR(INDXRSZ) + REAL EPS + INTEGER COMM + EXTERNAL CMUMPS_744 + INTEGER CMUMPS_744 + INTEGER GLORES, MYRESR, MYRES + INTEGER IERR + MYRESR = CMUMPS_744(D, N, INDXR, INDXRSZ, EPS) + MYRES = 2*MYRESR + CALL MPI_ALLREDUCE(MYRES, GLORES, 1, MPI_INTEGER, + & MPI_SUM, COMM, IERR) + CMUMPS_742 = GLORES + RETURN + END FUNCTION CMUMPS_742 + SUBROUTINE CMUMPS_661(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & MYROWINDICES, INUMMYR, + & IWRK, IWSZ ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, N + INTEGER INUMMYR, IWSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER PARTVEC(N) + INTEGER MYROWINDICES(INUMMYR) + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC, ITMP, MAXMN + MAXMN = N + DO I=1,N + IWRK(I) = 0 + IF(PARTVEC(I).EQ.MYID) IWRK(I)=1 + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IR) .EQ. 0) IWRK(IR)= 1 + ENDIF + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IC) .EQ.0) IWRK(IC)=1 + ENDIF + ENDDO + ITMP = 1 + DO I=1,N + IF(IWRK(I).EQ.1) THEN + MYROWINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_661 + SUBROUTINE CMUMPS_692(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX, OINDX, + & ISNDRCVNUM, ISNDVOL, INGHBPRCS, ISNDRCVIA, ISNDRCVJA, + & OSNDRCVNUM, OSNDVOL, ONGHBPRCS, OSNDRCVIA, OSNDRCVJA, + & SNDSZ, RCVSZ, IWRK, + & ISTATUS, REQUESTS, + & ITAGCOMM, COMM ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, ISNDVOL, OSNDVOL + INTEGER INDX(NZ_loc), OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER ISNDRCVNUM, INGHBPRCS(ISNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1) + INTEGER ISNDRCVJA(ISNDVOL) + INTEGER OSNDRCVNUM, ONGHBPRCS(OSNDRCVNUM) + INTEGER OSNDRCVIA(NUMPROCS+1) + INTEGER OSNDRCVJA(OSNDVOL) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INTEGER IWRK(ISZ) + INTEGER ISTATUS(MPI_STATUS_SIZE, ISNDRCVNUM) + INTEGER REQUESTS(ISNDRCVNUM) + INTEGER ITAGCOMM, COMM + INTEGER I, IIND,IIND2,IPID,OFFS,IWHERETO,POFFS, ITMP, IERROR + DO I=1,ISZ + IWRK(I) = 0 + ENDDO + OFFS = 1 + POFFS = 1 + DO I=1,NUMPROCS + OSNDRCVIA(I) = OFFS + SNDSZ(I) + IF(SNDSZ(I) > 0) THEN + ONGHBPRCS(POFFS)=I + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + SNDSZ(I) + ENDDO + OSNDRCVIA(NUMPROCS+1) = OFFS + DO I=1,NZ_loc + IIND=INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND.(IIND2.GE.1) + & .AND.(IIND2.LE.ISZ)) THEN + IPID=IPARTVEC(IIND) + IF(IPID.NE.MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWHERETO = OSNDRCVIA(IPID+1)-1 + OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1 + OSNDRCVJA(IWHERETO) = IIND + IWRK(IIND) = 1 + ENDIF + ENDIF + IIND = OINDX(I) + IPID=IPARTVEC(IIND) + IF(IPID.NE.MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWHERETO = OSNDRCVIA(IPID+1)-1 + OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1 + OSNDRCVJA(IWHERETO) = IIND + IWRK(IIND) = 1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + OFFS = 1 + POFFS = 1 + ISNDRCVIA(1) = 1 + DO I=2,NUMPROCS+1 + ISNDRCVIA(I) = OFFS + RCVSZ(I-1) + IF(RCVSZ(I-1) > 0) THEN + INGHBPRCS(POFFS)=I-1 + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + RCVSZ(I-1) + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + DO I=1, ISNDRCVNUM + IPID = INGHBPRCS(I) + OFFS = ISNDRCVIA(IPID) + ITMP = ISNDRCVIA(IPID+1) - ISNDRCVIA(IPID) + CALL MPI_IRECV(ISNDRCVJA(OFFS), ITMP, MPI_INTEGER,IPID-1, + & ITAGCOMM, COMM, REQUESTS(I),IERROR) + ENDDO + DO I=1,OSNDRCVNUM + IPID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(IPID) + ITMP = OSNDRCVIA(IPID+1)-OSNDRCVIA(IPID) + CALL MPI_SEND(OSNDRCVJA(OFFS), ITMP, MPI_INTEGER, IPID-1, + & ITAGCOMM, COMM,IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + CALL MPI_BARRIER(COMM,IERROR) + RETURN + END SUBROUTINE CMUMPS_692 + SUBROUTINE CMUMPS_628(IW,LREC,SIZE_FREE,XSIZE) + INTEGER, intent(in) :: LREC, XSIZE + INTEGER, intent(in) :: IW(LREC) + INTEGER(8), intent(out):: SIZE_FREE + INCLUDE 'mumps_headers.h' + IF (IW(1+XXS).EQ.S_NOLCBCONTIG .OR. + & IW(1+XXS).EQ.S_NOLCBNOCONTIG) THEN + SIZE_FREE=int(IW(1+XSIZE+2),8)*int(IW(1+XSIZE+3),8) + ELSE IF (IW(1+XXS).EQ.S_NOLCBCONTIG38 .OR. + & IW(1+XXS).EQ.S_NOLCBNOCONTIG38) THEN + SIZE_FREE=int(IW(1+XSIZE+2),8)*int(IW(1+XSIZE)+ + & IW(1+XSIZE + 3) - + & ( IW(1+XSIZE + 4) + & - IW(1+XSIZE + 3) ), 8) + ELSE + SIZE_FREE=0_8 + ENDIF + RETURN + END SUBROUTINE CMUMPS_628 + SUBROUTINE CMUMPS_629 + &(IW,LIW,IXXP,ICURRENT,NEXT, RCURRENT,ISIZE2SHIFT) + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER(8) :: RCURRENT + INTEGER LIW,IXXP,ICURRENT,NEXT,ISIZE2SHIFT + INTEGER IW(LIW) + INTEGER(8) :: RSIZE + ICURRENT=NEXT + CALL MUMPS_729( RSIZE, IW(ICURRENT + XXR) ) + RCURRENT = RCURRENT - RSIZE + NEXT=IW(ICURRENT+XXP) + IW(IXXP)=ICURRENT+ISIZE2SHIFT + IXXP=ICURRENT+XXP + RETURN + END SUBROUTINE CMUMPS_629 + SUBROUTINE CMUMPS_630(IW,LIW,BEG2SHIFT,END2SHIFT,ISIZE2SHIFT) + IMPLICIT NONE + INTEGER LIW, BEG2SHIFT, END2SHIFT, ISIZE2SHIFT + INTEGER IW(LIW) + INTEGER I + IF (ISIZE2SHIFT.GT.0) THEN + DO I=END2SHIFT,BEG2SHIFT,-1 + IW(I+ISIZE2SHIFT)=IW(I) + ENDDO + ELSE IF (ISIZE2SHIFT.LT.0) THEN + DO I=BEG2SHIFT,END2SHIFT + IW(I+ISIZE2SHIFT)=IW(I) + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_630 + SUBROUTINE CMUMPS_631(A, LA, BEG2SHIFT, END2SHIFT, RSIZE2SHIFT) + IMPLICIT NONE + INTEGER(8) :: LA, BEG2SHIFT, END2SHIFT, RSIZE2SHIFT + COMPLEX A(LA) + INTEGER(8) :: I + IF (RSIZE2SHIFT.GT.0_8) THEN + DO I=END2SHIFT,BEG2SHIFT,-1_8 + A(I+RSIZE2SHIFT)=A(I) + ENDDO + ELSE IF (RSIZE2SHIFT.LT.0_8) THEN + DO I=BEG2SHIFT,END2SHIFT + A(I+RSIZE2SHIFT)=A(I) + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_631 + SUBROUTINE CMUMPS_94(N,KEEP28,IW,LIW,A,LA, + & LRLU,IPTRLU,IWPOS, + & IWPOSCB,PTRIST,PTRAST,STEP,PIMASTER,PAMASTER, + & KEEP216,LRLUS,XSIZE) + IMPLICIT NONE + INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS + INTEGER N,LIW,KEEP28, + & IWPOS,IWPOSCB,KEEP216,XSIZE + INTEGER(8) :: PTRAST(KEEP28), PAMASTER(KEEP28) + INTEGER IW(LIW),PTRIST(KEEP28), + & STEP(N), PIMASTER(KEEP28) + COMPLEX A(LA) + INCLUDE 'mumps_headers.h' + INTEGER ICURRENT, NEXT, STATE_NEXT + INTEGER(8) :: RCURRENT + INTEGER ISIZE2SHIFT + INTEGER(8) :: RSIZE2SHIFT + INTEGER IBEGCONTIG + INTEGER(8) :: RBEGCONTIG + INTEGER(8) :: RBEG2SHIFT, REND2SHIFT + INTEGER INODE + INTEGER(8) :: FREE_IN_REC + INTEGER(8) :: RCURRENT_SIZE + INTEGER IXXP + ISIZE2SHIFT=0 + RSIZE2SHIFT=0_8 + ICURRENT = LIW-XSIZE+1 + RCURRENT = LA+1_8 + IBEGCONTIG = -999999 + RBEGCONTIG = -999999_8 + NEXT = IW(ICURRENT+XXP) + IF (NEXT.EQ.TOP_OF_STACK) RETURN + STATE_NEXT = IW(NEXT+XXS) + IXXP = ICURRENT+XXP + 10 CONTINUE + IF ( STATE_NEXT .NE. S_FREE .AND. + & (KEEP216.EQ.3.OR. + & (STATE_NEXT .NE. S_NOLCBNOCONTIG .AND. + & STATE_NEXT .NE. S_NOLCBCONTIG .AND. + & STATE_NEXT .NE. S_NOLCBNOCONTIG38 .AND. + & STATE_NEXT .NE. S_NOLCBCONTIG38))) THEN + CALL CMUMPS_629(IW,LIW, + & IXXP, ICURRENT, NEXT, RCURRENT, ISIZE2SHIFT) + CALL MUMPS_729(RCURRENT_SIZE, IW(ICURRENT+XXR)) + IF (IBEGCONTIG < 0) THEN + IBEGCONTIG=ICURRENT+IW(ICURRENT+XXI)-1 + ENDIF + IF (RBEGCONTIG < 0_8) THEN + RBEGCONTIG=RCURRENT+RCURRENT_SIZE-1_8 + ENDIF + INODE=IW(ICURRENT+XXN) + IF (RSIZE2SHIFT .NE. 0_8) THEN + IF (PTRAST(STEP(INODE)).EQ.RCURRENT) + & PTRAST(STEP(INODE))= + & PTRAST(STEP(INODE))+RSIZE2SHIFT + IF (PAMASTER(STEP(INODE)).EQ.RCURRENT) + & PAMASTER(STEP(INODE))= + & PAMASTER(STEP(INODE))+RSIZE2SHIFT + ENDIF + IF (ISIZE2SHIFT .NE. 0) THEN + IF (PTRIST(STEP(INODE)).EQ.ICURRENT) + & PTRIST(STEP(INODE))= + & PTRIST(STEP(INODE))+ISIZE2SHIFT + IF (PIMASTER(STEP(INODE)).EQ.ICURRENT) + & PIMASTER(STEP(INODE))= + & PIMASTER(STEP(INODE))+ISIZE2SHIFT + ENDIF + IF (NEXT .NE. TOP_OF_STACK) THEN + STATE_NEXT=IW(NEXT+XXS) + GOTO 10 + ENDIF + ENDIF + 20 CONTINUE + IF (IBEGCONTIG.NE.0 .AND. ISIZE2SHIFT .NE. 0) THEN + CALL CMUMPS_630(IW,LIW,ICURRENT,IBEGCONTIG,ISIZE2SHIFT) + IF (IXXP .LE.IBEGCONTIG) THEN + IXXP=IXXP+ISIZE2SHIFT + ENDIF + ENDIF + IBEGCONTIG=-9999 + 25 CONTINUE + IF (RBEGCONTIG .GT.0_8 .AND. RSIZE2SHIFT .NE. 0_8) THEN + CALL CMUMPS_631(A,LA,RCURRENT,RBEGCONTIG,RSIZE2SHIFT) + ENDIF + RBEGCONTIG=-99999_8 + 30 CONTINUE + IF (NEXT.EQ. TOP_OF_STACK) GOTO 100 + IF (STATE_NEXT .EQ. S_NOLCBCONTIG .OR. + & STATE_NEXT .EQ. S_NOLCBNOCONTIG .OR. + & STATE_NEXT .EQ. S_NOLCBCONTIG38 .OR. + & STATE_NEXT .EQ. S_NOLCBNOCONTIG38) THEN + IF ( KEEP216.eq.3) THEN + WRITE(*,*) "Internal error 2 in CMUMPS_94" + ENDIF + IF (RBEGCONTIG > 0_8) GOTO 25 + CALL CMUMPS_629 + & (IW,LIW,IXXP,ICURRENT,NEXT, RCURRENT,ISIZE2SHIFT) + IF (IBEGCONTIG < 0 ) THEN + IBEGCONTIG=ICURRENT+IW(ICURRENT+XXI)-1 + ENDIF + CALL CMUMPS_628(IW(ICURRENT), + & LIW-ICURRENT+1, + & FREE_IN_REC, + & XSIZE) + IF (STATE_NEXT .EQ. S_NOLCBNOCONTIG) THEN + CALL CMUMPS_627(A,LA,RCURRENT, + & IW(ICURRENT+XSIZE+2), + & IW(ICURRENT+XSIZE), + & IW(ICURRENT+XSIZE)+IW(ICURRENT+XSIZE+3), 0, + & IW(ICURRENT+XXS),RSIZE2SHIFT) + ELSE IF (STATE_NEXT .EQ. S_NOLCBNOCONTIG38) THEN + CALL CMUMPS_627(A,LA,RCURRENT, + & IW(ICURRENT+XSIZE+2), + & IW(ICURRENT+XSIZE), + & IW(ICURRENT+XSIZE)+IW(ICURRENT+XSIZE+3), + & IW(ICURRENT+XSIZE+4)-IW(ICURRENT+XSIZE+3), + & IW(ICURRENT+XXS),RSIZE2SHIFT) + ELSE IF (RSIZE2SHIFT .GT.0_8) THEN + RBEG2SHIFT = RCURRENT + FREE_IN_REC + CALL MUMPS_729(RCURRENT_SIZE, IW(ICURRENT+XXR)) + REND2SHIFT = RCURRENT + RCURRENT_SIZE - 1_8 + CALL CMUMPS_631(A, LA, + & RBEG2SHIFT, REND2SHIFT, + & RSIZE2SHIFT) + ENDIF + INODE=IW(ICURRENT+XXN) + IF (ISIZE2SHIFT.NE.0) THEN + PTRIST(STEP(INODE))=PTRIST(STEP(INODE))+ISIZE2SHIFT + ENDIF + PTRAST(STEP(INODE))=PTRAST(STEP(INODE))+RSIZE2SHIFT+ + & FREE_IN_REC + CALL MUMPS_724(IW(ICURRENT+XXR),FREE_IN_REC) + IF (STATE_NEXT.EQ.S_NOLCBCONTIG.OR. + & STATE_NEXT.EQ.S_NOLCBNOCONTIG) THEN + IW(ICURRENT+XXS)=S_NOLCLEANED + ELSE + IW(ICURRENT+XXS)=S_NOLCLEANED38 + ENDIF + RSIZE2SHIFT=RSIZE2SHIFT+FREE_IN_REC + RBEGCONTIG=-9999_8 + IF (NEXT.EQ.TOP_OF_STACK) THEN + GOTO 20 + ELSE + STATE_NEXT=IW(NEXT+XXS) + ENDIF + GOTO 30 + ENDIF + IF (IBEGCONTIG.GT.0) THEN + GOTO 20 + ENDIF + 40 CONTINUE + IF (STATE_NEXT == S_FREE) THEN + ICURRENT = NEXT + CALL MUMPS_729( RCURRENT_SIZE, IW(ICURRENT + XXR) ) + ISIZE2SHIFT = ISIZE2SHIFT + IW(ICURRENT+XXI) + RSIZE2SHIFT = RSIZE2SHIFT + RCURRENT_SIZE + RCURRENT = RCURRENT - RCURRENT_SIZE + NEXT=IW(ICURRENT+XXP) + IF (NEXT.EQ.TOP_OF_STACK) THEN + WRITE(*,*) "Internal error 1 in CMUMPS_94" + CALL MUMPS_ABORT() + ENDIF + STATE_NEXT = IW(NEXT+XXS) + GOTO 40 + ENDIF + GOTO 10 + 100 CONTINUE + IWPOSCB = IWPOSCB + ISIZE2SHIFT + LRLU = LRLU + RSIZE2SHIFT + IPTRLU = IPTRLU + RSIZE2SHIFT + RETURN + END SUBROUTINE CMUMPS_94 + SUBROUTINE CMUMPS_632(IREC, IW, LIW, + & ISIZEHOLE, RSIZEHOLE) + IMPLICIT NONE + INTEGER, intent(in) :: IREC, LIW + INTEGER, intent(in) :: IW(LIW) + INTEGER, intent(out):: ISIZEHOLE + INTEGER(8), intent(out) :: RSIZEHOLE + INTEGER IRECLOC + INTEGER(8) :: RECLOC_SIZE + INCLUDE 'mumps_headers.h' + ISIZEHOLE=0 + RSIZEHOLE=0_8 + IRECLOC = IREC + IW( IREC+XXI ) + 10 CONTINUE + CALL MUMPS_729(RECLOC_SIZE, IW(IRECLOC+XXR)) + IF (IW(IRECLOC+XXS).EQ.S_FREE) THEN + ISIZEHOLE=ISIZEHOLE+IW(IRECLOC+XXI) + RSIZEHOLE=RSIZEHOLE+RECLOC_SIZE + IRECLOC=IRECLOC+IW(IRECLOC+XXI) + GOTO 10 + ENDIF + RETURN + END SUBROUTINE CMUMPS_632 + SUBROUTINE CMUMPS_627(A, LA, RCURRENT, + & NROW, NCB, LD, NELIM, NODESTATE, ISHIFT) + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER LD, NROW, NCB, NELIM, NODESTATE + INTEGER(8) :: ISHIFT + INTEGER(8) :: LA, RCURRENT + COMPLEX A(LA) + INTEGER I,J + INTEGER(8) :: IOLD,INEW + LOGICAL NELIM_ROOT + NELIM_ROOT=.TRUE. + IF (NODESTATE.EQ. S_NOLCBNOCONTIG) THEN + NELIM_ROOT=.FALSE. + IF (NELIM.NE.0) THEN + WRITE(*,*) "Internal error 1 IN CMUMPS_627" + CALL MUMPS_ABORT() + ENDIF + ELSE IF (NODESTATE .NE. S_NOLCBNOCONTIG38) THEN + WRITE(*,*) "Internal error 2 in CMUMPS_627" + & ,NODESTATE + CALL MUMPS_ABORT() + ENDIF + IF (ISHIFT .LT.0_8) THEN + WRITE(*,*) "Internal error 3 in CMUMPS_627",ISHIFT + CALL MUMPS_ABORT() + ENDIF + IF (NELIM_ROOT) THEN + IOLD=RCURRENT+int(LD,8)*int(NROW,8)+int(NELIM-1-NCB,8) + ELSE + IOLD = RCURRENT+int(LD,8)*int(NROW,8)-1_8 + ENDIF + INEW = RCURRENT+int(LD,8)*int(NROW,8)+ISHIFT-1_8 + DO I = NROW, 1, -1 + IF (I.EQ.NROW .AND. ISHIFT.EQ.0_8.AND. + & .NOT. NELIM_ROOT) THEN + IOLD=IOLD-int(LD,8) + INEW=INEW-int(NCB,8) + CYCLE + ENDIF + IF (NELIM_ROOT) THEN + DO J=1,NELIM + A( INEW ) = A( IOLD + int(- J + 1,8)) + INEW = INEW - 1_8 + ENDDO + ELSE + DO J=1, NCB + A( INEW ) = A( IOLD + int(- J + 1, 8)) + INEW = INEW - 1_8 + ENDDO + ENDIF + IOLD = IOLD - int(LD,8) + ENDDO + IF (NELIM_ROOT) THEN + NODESTATE=S_NOLCBCONTIG38 + ELSE + NODESTATE=S_NOLCBCONTIG + ENDIF + RETURN + END SUBROUTINE CMUMPS_627 + SUBROUTINE CMUMPS_700(BUFR,LBUFR, + & LBUFR_BYTES, + & root, N, IW, LIW, A, LA, + & NBPROCFILS, LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, + & COMP, LRLUS, IPOOL, LPOOL, LEAF, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, + & ITLOC, RHS_MUMPS, + & ND,PROCNODE_STEPS,SLAVEF ) + USE CMUMPS_LOAD + USE CMUMPS_OOC + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC ) :: root + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER LBUFR, LBUFR_BYTES, N, LIW, + & IWPOS, IWPOSCB, COMP, COMM, COMM_LOAD, IFLAG, + & IERROR + INTEGER LPOOL, LEAF + INTEGER IPOOL( LEAF ) + INTEGER PTRIST(KEEP(28)) + INTEGER PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)), ITLOC( N+KEEP(253) ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER BUFR( LBUFR_BYTES ), NBPROCFILS( KEEP(28) ) + INTEGER IW( LIW ) + INTEGER ND(KEEP(28)), PROCNODE_STEPS(KEEP(28)),SLAVEF + COMPLEX A( LA ) + INTEGER MYID + INTEGER FILS( N ), PTRAIW(N), PTRARW( N ) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX DBLARR(max(1,KEEP(13))) + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER POSITION, LOCAL_M, LOCAL_N, LREQI + INTEGER(8) :: LREQA, POS_ROOT + INTEGER NSUBSET_ROW, NSUBSET_COL, IROOT, ISON, NSUBSET_COL_EFF + INTEGER NSUPCOL_EFF + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INTEGER NSUPROW, NSUPCOL, BBPCBP + INCLUDE 'mumps_headers.h' + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & ISON, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUBSET_ROW, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUPROW, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUBSET_COL, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUPCOL, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, MPI_INTEGER, + & COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & BBPCBP, 1, MPI_INTEGER, + & COMM, IERR ) + IF (BBPCBP .EQ. 1) THEN + NSUBSET_COL_EFF = NSUBSET_COL - NSUPCOL + NSUPCOL_EFF = 0 + ELSE + NSUBSET_COL_EFF = NSUBSET_COL + NSUPCOL_EFF = NSUPCOL + ENDIF + IROOT = KEEP( 38 ) + IF ( PTRIST( STEP(IROOT) ) .NE. 0 .OR. + & PTLUST_S( STEP(IROOT)) .NE. 0 ) THEN + IF (NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. NSUBSET_ROW + & - NSUPROW .OR. NSUBSET_ROW - NSUPROW.EQ.0 .OR. + & NSUBSET_COL_EFF .EQ. 0)THEN + NBPROCFILS(STEP(IROOT)) = NBPROCFILS(STEP(IROOT))-1 + IF ( NBPROCFILS( STEP(IROOT) ) .eq. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + CALL CMUMPS_681(IERR) + ELSEIF (KEEP(201).EQ.2) THEN + CALL CMUMPS_580(IERR) + ENDIF + CALL CMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), + & STEP, IROOT + N) + IF (KEEP(47) .GE. 3) THEN + CALL CMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + ENDIF + ENDIF + ELSE + IF (NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. + & NSUBSET_ROW - NSUPROW .OR. + & NSUBSET_ROW - NSUPROW.EQ.0 .OR. + & NSUBSET_COL_EFF .EQ. 0)THEN + NBPROCFILS(STEP( IROOT ) ) = -1 + ENDIF + IF (KEEP(60) == 0) THEN + CALL CMUMPS_284( root, IROOT, N, + & IW, LIW, A, LA, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + IF ( IFLAG .LT. 0 ) RETURN + ELSE + PTRIST(STEP(IROOT)) = -55555 + ENDIF + END IF + IF (KEEP(60) .EQ.0) THEN + IF ( PTRIST(STEP(IROOT)) .GE. 0 ) THEN + IF ( PTRIST(STEP(IROOT)) .NE. 0 ) THEN + LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) ) + LOCAL_M = IW( PTRIST(STEP( IROOT )) + 1 + KEEP(IXSZ)) + POS_ROOT = PAMASTER(STEP( IROOT )) + ELSE + LOCAL_N = IW( PTLUST_S(STEP( IROOT ) ) + 1 + KEEP(IXSZ)) + LOCAL_M = IW( PTLUST_S(STEP( IROOT ) ) + 2 + KEEP(IXSZ)) + POS_ROOT = PTRFAC(IW(PTLUST_S(STEP(IROOT))+4+ + & KEEP(IXSZ))) + END IF + ENDIF + ELSE + LOCAL_M = root%SCHUR_LLD + LOCAL_N = root%SCHUR_NLOC + ENDIF + IF ( (BBPCBP.EQ.1).AND. (NBROWS_ALREADY_SENT.EQ.0).AND. + & (min(NSUPROW, NSUPCOL) .GT. 0) + & ) THEN + LREQI = NSUPROW+NSUPCOL + LREQA = int(NSUPROW,8) * int(NSUPCOL,8) + IF ( (LREQA.NE.0_8) .AND. + & (PTRIST(STEP(IROOT)).LT.0).AND. + & KEEP(60)==0) THEN + WRITE(*,*) ' Error in CMUMPS_700' + CALL MUMPS_ABORT() + ENDIF + CALL CMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A, LA, + & LRLU, IPTRLU, IWPOS, IWPOSCB, PTRIST, + & PTRAST, STEP, PIMASTER, PAMASTER, + & LREQI, LREQA, -1234, S_NOTFREE, .FALSE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IWPOSCB + 1 ), LREQI, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A( IPTRLU + 1_8 ), int(LREQA), + & MPI_COMPLEX, COMM, IERR ) + CALL CMUMPS_38( NSUPROW, NSUPCOL, + & IW( IWPOSCB + 1 ), + & IW( IWPOSCB + NSUPROW + 1 ), NSUPCOL, + & A( IPTRLU + 1_8 ), + & A( 1 ), + & LOCAL_M, LOCAL_N, + & root%RHS_ROOT(1,1), root%RHS_NLOC, + & 1) + IWPOSCB = IWPOSCB + LREQI + IPTRLU = IPTRLU + LREQA + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU) + ENDIF + LREQI = NBROWS_PACKET + NSUBSET_COL_EFF + LREQA = int(NBROWS_PACKET,8) * int(NSUBSET_COL_EFF,8) + IF ( (LREQA.NE.0_8) .AND. + & (PTRIST(STEP(IROOT)).LT.0).AND. + & KEEP(60)==0) THEN + WRITE(*,*) ' Error in CMUMPS_700' + CALL MUMPS_ABORT() + ENDIF + IF (LREQA.NE.0_8) THEN + CALL CMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A, LA, + & LRLU, IPTRLU, IWPOS, IWPOSCB, PTRIST, + & PTRAST, STEP, PIMASTER, PAMASTER, + & LREQI, LREQA, -1234, S_NOTFREE, .FALSE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IWPOSCB + 1 ), LREQI, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A( IPTRLU + 1_8 ), int(LREQA), + & MPI_COMPLEX, COMM, IERR ) + IF (KEEP(60).EQ.0) THEN + CALL CMUMPS_38( NBROWS_PACKET, NSUBSET_COL_EFF, + & IW( IWPOSCB + 1 ), + & IW( IWPOSCB + NBROWS_PACKET + 1 ), + & NSUPCOL_EFF, + & A( IPTRLU + 1_8 ), + & A( POS_ROOT ), LOCAL_M, LOCAL_N, + & root%RHS_ROOT(1,1), root%RHS_NLOC, + & 0) + ELSE + CALL CMUMPS_38( NBROWS_PACKET, NSUBSET_COL_EFF, + & IW( IWPOSCB + 1 ), + & IW( IWPOSCB + NBROWS_PACKET + 1 ), + & NSUPCOL_EFF, + & A( IPTRLU + 1_8 ), + & root%SCHUR_POINTER(1), + & root%SCHUR_LLD , root%SCHUR_NLOC, + & root%RHS_ROOT(1,1), root%RHS_NLOC, + & 0) + ENDIF + IWPOSCB = IWPOSCB + LREQI + IPTRLU = IPTRLU + LREQA + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU) + ENDIF + RETURN + END SUBROUTINE CMUMPS_700 + SUBROUTINE CMUMPS_762(PIV, DETER, NEXP) + IMPLICIT NONE + COMPLEX, intent(in) :: PIV + COMPLEX, intent(inout) :: DETER + INTEGER, intent(inout) :: NEXP + REAL R_PART, C_PART + INTEGER NEXP_LOC + DETER=DETER*PIV + R_PART=real(DETER) + C_PART=aimag(DETER) + NEXP_LOC = exponent(abs(R_PART)+abs(C_PART)) + NEXP = NEXP + NEXP_LOC + R_PART=scale(R_PART, -NEXP_LOC) + C_PART=scale(C_PART, -NEXP_LOC) + DETER=cmplx(R_PART,C_PART,kind=kind(DETER)) + RETURN + END SUBROUTINE CMUMPS_762 + SUBROUTINE CMUMPS_761(PIV, DETER, NEXP) + IMPLICIT NONE + REAL, intent(in) :: PIV + REAL, intent(inout) :: DETER + INTEGER, intent(inout) :: NEXP + DETER=DETER*fraction(PIV) + NEXP=NEXP+exponent(PIV)+exponent(DETER) + DETER=fraction(DETER) + RETURN + END SUBROUTINE CMUMPS_761 + SUBROUTINE CMUMPS_763(BLOCK_SIZE,IPIV, + & MYROW, MYCOL, NPROW, NPCOL, + & A, LOCAL_M, LOCAL_N, N, MYID, + & DETER,NEXP,SYM) + IMPLICIT NONE + INTEGER, intent (in) :: SYM + INTEGER, intent (inout) :: NEXP + COMPLEX, intent (inout) :: DETER + INTEGER, intent (in) :: BLOCK_SIZE, NPROW, NPCOL, + & LOCAL_M, LOCAL_N, N + INTEGER, intent (in) :: MYROW, MYCOL, MYID, IPIV(LOCAL_M) + COMPLEX, intent(in) :: A(*) + INTEGER I,IMX,DI,NBLOCK,IBLOCK,ILOC,JLOC, + & ROW_PROC,COL_PROC, K + DI = LOCAL_M + 1 + NBLOCK = ( N - 1 ) / BLOCK_SIZE + DO IBLOCK = 0, NBLOCK + ROW_PROC = mod( IBLOCK, NPROW ) + IF ( MYROW.EQ.ROW_PROC ) THEN + COL_PROC = mod( IBLOCK, NPCOL ) + IF ( MYCOL.EQ.COL_PROC ) THEN + ILOC = ( IBLOCK / NPROW ) * BLOCK_SIZE + JLOC = ( IBLOCK / NPCOL ) * BLOCK_SIZE + I = ILOC + JLOC * LOCAL_M + 1 + IMX = min(ILOC+BLOCK_SIZE,LOCAL_M) + & + (min(JLOC+BLOCK_SIZE,LOCAL_N)-1)*LOCAL_M + & + 1 + K=1 + DO WHILE ( I .LT. IMX ) + CALL CMUMPS_762(A(I),DETER,NEXP) + IF (SYM.NE.1) THEN + IF (IPIV(ILOC+K) .NE. IBLOCK*BLOCK_SIZE+K) THEN + DETER = -DETER + ENDIF + ENDIF + K = K + 1 + I = I + DI + END DO + END IF + END IF + END DO + RETURN + END SUBROUTINE CMUMPS_763 + SUBROUTINE CMUMPS_764( + & COMM, DETER_IN, NEXP_IN, + & DETER_OUT, NEXP_OUT, NPROCS) + IMPLICIT NONE + INTEGER, intent(in) :: COMM, NPROCS + COMPLEX, intent(in) :: DETER_IN + INTEGER,intent(in) :: NEXP_IN + COMPLEX,intent(out):: DETER_OUT + INTEGER,intent(out):: NEXP_OUT + INTEGER :: IERR_MPI + EXTERNAL CMUMPS_771 + INTEGER TWO_SCALARS_TYPE, DETERREDUCE_OP + COMPLEX :: INV(2) + COMPLEX :: OUTV(2) + INCLUDE 'mpif.h' + IF (NPROCS .EQ. 1) THEN + DETER_OUT = DETER_IN + NEXP_OUT = NEXP_IN + RETURN + ENDIF + CALL MPI_TYPE_CONTIGUOUS(2, MPI_COMPLEX, + & TWO_SCALARS_TYPE, + & IERR_MPI) + CALL MPI_TYPE_COMMIT(TWO_SCALARS_TYPE, IERR_MPI) + CALL MPI_OP_CREATE(CMUMPS_771, + & .TRUE., + & DETERREDUCE_OP, + & IERR_MPI) + INV(1)=DETER_IN + INV(2)=cmplx(NEXP_IN,kind=kind(INV)) + CALL MPI_ALLREDUCE( INV, OUTV, 1, TWO_SCALARS_TYPE, + & DETERREDUCE_OP, COMM, IERR_MPI) + CALL MPI_OP_FREE(DETERREDUCE_OP, IERR_MPI) + CALL MPI_TYPE_FREE(TWO_SCALARS_TYPE, IERR_MPI) + DETER_OUT = OUTV(1) + NEXP_OUT = int(OUTV(2)) + RETURN + END SUBROUTINE CMUMPS_764 + SUBROUTINE CMUMPS_771(INV, INOUTV, NEL, DATATYPE) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NEL, DATATYPE + COMPLEX, INTENT(IN) :: INV ( 2 * NEL ) + COMPLEX, INTENT(INOUT) :: INOUTV ( 2 * NEL ) + INTEGER I, TMPEXPIN, TMPEXPINOUT + DO I = 1, NEL + TMPEXPIN = int(INV (I*2)) + TMPEXPINOUT = int(INOUTV(I*2)) + CALL CMUMPS_762(INV(I*2-1), + & INOUTV(I*2-1), + & TMPEXPINOUT) + TMPEXPINOUT = TMPEXPINOUT + TMPEXPIN + INOUTV(I*2) = cmplx(TMPEXPINOUT,kind=kind(INOUTV)) + ENDDO + RETURN + END SUBROUTINE CMUMPS_771 + SUBROUTINE CMUMPS_765(DETER, NEXP) + IMPLICIT NONE + INTEGER, intent (inout) :: NEXP + COMPLEX, intent (inout) :: DETER + DETER=DETER*DETER + NEXP=NEXP+NEXP + RETURN + END SUBROUTINE CMUMPS_765 + SUBROUTINE CMUMPS_766(DETER, NEXP) + IMPLICIT NONE + INTEGER, intent (inout) :: NEXP + REAL, intent (inout) :: DETER + DETER=1.0E0/DETER + NEXP=-NEXP + RETURN + END SUBROUTINE CMUMPS_766 + SUBROUTINE CMUMPS_767(DETER, N, VISITED, PERM) + IMPLICIT NONE + COMPLEX, intent(inout) :: DETER + INTEGER, intent(in) :: N + INTEGER, intent(inout) :: VISITED(N) + INTEGER, intent(in) :: PERM(N) + INTEGER I, J, K + K = 0 + DO I = 1, N + IF (VISITED(I) .GT. N) THEN + VISITED(I)=VISITED(I)-N-N-1 + CYCLE + ENDIF + J = PERM(I) + DO WHILE (J.NE.I) + VISITED(J) = VISITED(J) + N + N + 1 + K = K + 1 + J = PERM(J) + ENDDO + ENDDO + IF (mod(K,2).EQ.1) THEN + DETER = -DETER + ENDIF + RETURN + END SUBROUTINE CMUMPS_767 + SUBROUTINE CMUMPS_224(NFRONT,NASS,IBEGKJI, LPIV, TIPIV, + & N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IFLAG,IOLDPS,POSELT,UU,SEUIL,KEEP,KEEP8, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER IBEGKJI, LPIV + INTEGER TIPIV(LPIV) + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV,NOFFW + REAL UU, SEUIL + INTEGER IW(LIW) + INTEGER IOLDPS + INTEGER(8) :: POSELT + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U + COMPLEX SWOP + INTEGER(8) :: APOS, IDIAG + INTEGER(8) :: J1, J2, JJ, J3_8 + INTEGER(8) :: NFRONT8 + INTEGER ILOC + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + REAL RZERO, RMAX, AMROW, ONE + REAL PIVNUL + COMPLEX FIXA, CSEUIL + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,JMAX,J3,ISW,ISWPS1 + INTEGER ISWPS2,KSW, HF + INCLUDE 'mumps_headers.h' + INTEGER CMUMPS_IXAMAX + INTRINSIC max + DATA RZERO /0.0E0/ + DATA ONE /1.0E0/ + INTEGER I_PIVRPTR_L, I_PIVR_L, NBPANELS_L + INTEGER I_PIVRPTR_U, I_PIVR_U, NBPANELS_U + INTEGER XSIZE + PIVNUL = DKEEP(1) + FIXA = cmplx(DKEEP(2),kind=kind(FIXA)) + CSEUIL = cmplx(SEUIL,kind=kind(CSEUIL)) + NFRONT8=int(NFRONT,8) + XSIZE = KEEP(IXSZ) + NPIV = IW(IOLDPS+1+XSIZE) + HF = 6 + IW(IOLDPS+5+XSIZE)+XSIZE + NPIVP1 = NPIV + 1 + IF (KEEP(201).EQ.1) THEN + CALL CMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + CALL CMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + ENDIF + ILOC = NPIVP1 - IBEGKJI + 1 + TIPIV(ILOC) = ILOC + NASSW = iabs(IW(IOLDPS+3+XSIZE)) + IF(INOPV .EQ. -1) THEN + APOS = POSELT + NFRONT8*int(NPIVP1-1,8) + int(NPIV,8) + IDIAG = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF (real(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + KEEP(98) = KEEP(98)+1 + ELSE IF (KEEP(258) .NE. 0) THEN + CALL CMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL CMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL CMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + NFRONT8*int(IPIV-1,8) + int(NPIV,8) + JMAX = 1 + IF (UU.GT.RZERO) GO TO 340 + IF (A(APOS).EQ.ZERO) GO TO 630 + GO TO 380 + 340 AMROW = RZERO + J1 = APOS + J2 = APOS +int(- NPIV + NASS - 1,8) + J3 = NASS -NPIV + JMAX = CMUMPS_IXAMAX(J3,A(J1),1) + JJ = int(JMAX,8) + J1 - 1_8 + AMROW = abs(A(JJ)) + RMAX = AMROW + J1 = J2 + 1_8 + J2 = APOS +int(- NPIV + NFRONT - KEEP(253)- 1,8) + IF (J2.LT.J1) GO TO 370 + DO 360 JJ=J1,J2 + RMAX = max(abs(A(JJ)),RMAX) + 360 CONTINUE + 370 IDIAG = APOS + int(IPIV - NPIVP1,8) + IF (RMAX.LE.PIVNUL) THEN + KEEP(109) = KEEP(109)+1 + ISW = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6+KEEP(IXSZ)+ + & IW(IOLDPS+5+KEEP(IXSZ))+IPIV-NPIVP1 + PIVNUL_LIST(KEEP(109)) = IW(ISW) + IF(real(FIXA).GT.RZERO) THEN + IF(real(A(IDIAG)) .GE. RZERO) THEN + A(IDIAG) = FIXA + ELSE + A(IDIAG) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = APOS +int(- NPIV + NFRONT - KEEP(253) - 1,8) + DO JJ=J1,J2 + A(JJ)= ZERO + ENDDO + A(IDIAG) = -FIXA + ENDIF + JMAX = IPIV - NPIV + GOTO 385 + ENDIF + IF (abs(A(IDIAG)).GT.max(UU*RMAX,SEUIL)) THEN + JMAX = IPIV - NPIV + GO TO 380 + ENDIF + IF (AMROW.LE.max(UU*RMAX,SEUIL)) GO TO 460 + NOFFW = NOFFW + 1 + 380 CONTINUE + IF (KEEP(258).NE.0) THEN + CALL CMUMPS_762( A(APOS+int(JMAX-1,8)), + & DKEEP(6), + & KEEP(259)) + ENDIF + 385 CONTINUE + IF (IPIV.EQ.NPIVP1) GO TO 400 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8)*NFRONT8 + J2 = J1 + NFRONT8 - 1_8 + J3_8 = POSELT + int(IPIV-1,8)*NFRONT8 + DO 390 JJ=J1,J2 + SWOP = A(JJ) + A(JJ) = A(J3_8) + A(J3_8) = SWOP + J3_8 = J3_8 + 1_8 + 390 CONTINUE + ISWPS1 = IOLDPS + HF - 1 + NPIVP1 + ISWPS2 = IOLDPS + HF - 1 + IPIV + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + 400 IF (JMAX.EQ.1) GO TO 420 + KEEP(260)=-KEEP(260) + TIPIV(ILOC) = ILOC + JMAX - 1 + J1 = POSELT + int(NPIV,8) + J2 = POSELT + int(NPIV + JMAX - 1,8) + DO 410 KSW=1,NASS + SWOP = A(J1) + A(J1) = A(J2) + A(J2) = SWOP + J1 = J1 + NFRONT8 + J2 = J2 + NFRONT8 + 410 CONTINUE + ISWPS1 = IOLDPS + HF - 1 + NFRONT + NPIV + 1 + ISWPS2 = IOLDPS + HF - 1 + NFRONT + NPIV + JMAX + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + GO TO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 430 + 630 CONTINUE + IFLAG = -10 + WRITE(*,*) 'NIV2:Detected 0 pivot, INODE,NPIV=',INODE,NPIV + GOTO 430 + 420 CONTINUE + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL CMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, IPIV, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL CMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIV+JMAX, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + 430 CONTINUE + RETURN + END SUBROUTINE CMUMPS_224 + SUBROUTINE CMUMPS_294( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & IW, LIW, + & IOLDPS, POSELT, A, LA, LDA_FS, + & IBEGKJI, IEND, TIPIV, LPIV, LASTBL, NB_BLOC_FAC, + & + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE CMUMPS_COMM_BUFFER + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mpif.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, INODE, FPERE, LIW, IBEGKJI, IEND, LPIV, + & IOLDPS, LDA_FS, NB_BLOC_FAC + INTEGER(8) :: POSELT, LA + INTEGER IW(LIW), TIPIV(LPIV) + LOGICAL LASTBL + COMPLEX A(LA) + INTEGER COMM, MYID, LBUFR, LBUFR_BYTES + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NBFIN, IFLAG, IERROR, LEAF, LPOOL, + & SLAVEF, ICNTL(40) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB, COMP + INTEGER BUFR( LBUFR ), IPOOL(LPOOL), + & ITLOC(N+KEEP(253)), FILS(N), + & PTRARW(LPTRAR), PTRAIW(LPTRAR), + & ND( KEEP(28) ), FRERE( KEEP(28) ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER(8) :: PTRAST (KEEP(28)) + INTEGER(8) :: PTRFAC (KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), + & NBPROCFILS(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + COMPLEX DBLARR(max(1,KEEP(13))) + EXTERNAL CMUMPS_329 + INCLUDE 'mumps_headers.h' + INTEGER(8) :: APOS, LREQA + INTEGER NPIV, NCOL, PDEST, NSLAVES + INTEGER IERR, LREQI + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + DOUBLE PRECISION FLOP1,FLOP2 + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + IF (NSLAVES.EQ.0) THEN + WRITE(6,*) ' ERROR 1 in CMUMPS_294 ' + CALL MUMPS_ABORT() + ENDIF + NPIV = IEND - IBEGKJI + 1 + NCOL = LDA_FS - IBEGKJI + 1 + APOS = POSELT + int(LDA_FS,8)*int(IBEGKJI-1,8) + + & int(IBEGKJI - 1,8) + IF (IBEGKJI > 0) THEN + CALL MUMPS_511( LDA_FS, IBEGKJI-1, LPIV, + & KEEP(50),2,FLOP1) + ELSE + FLOP1=0.0D0 + ENDIF + CALL MUMPS_511( LDA_FS, IEND, LPIV, + & KEEP(50),2,FLOP2) + FLOP2 = FLOP1 - FLOP2 + CALL CMUMPS_190(1, .FALSE., FLOP2, KEEP,KEEP8) + IF ((NPIV.GT.0) .OR. + & ((NPIV.EQ.0).AND.(LASTBL)) ) THEN + PDEST = IOLDPS + 6 + KEEP(IXSZ) + IERR = -1 + IF ( NPIV .NE. 0 ) THEN + NB_BLOC_FAC = NB_BLOC_FAC + 1 + END IF + DO WHILE (IERR .EQ.-1) + CALL CMUMPS_65( INODE, LDA_FS, NCOL, + & NPIV, FPERE, LASTBL, TIPIV, A(APOS), + & IW(PDEST), NSLAVES, KEEP(50), NB_BLOC_FAC, + & COMM, IERR ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF (MESSAGE_RECEIVED) POSELT = PTRAST(STEP(INODE)) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2 .OR. IERR.EQ.-3 ) THEN + IF (IERR.EQ.-2) IFLAG = -17 + IF (IERR.EQ.-3) IFLAG = -20 + LREQA = int(NCOL,8)*int(NPIV,8) + LREQI = NPIV + 6 + 2*NSLAVES + CALL MUMPS_731( + & int(LREQI,8) * int(KEEP(34),8) + LREQA * int(KEEP(35),8), + & IERROR) + GOTO 300 + ENDIF + ENDIF + GOTO 500 + 300 CONTINUE + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + 500 RETURN + END SUBROUTINE CMUMPS_294 + SUBROUTINE CMUMPS_273( ROOT, + & INODE, NELIM, NSLAVES, ROW_LIST, + & COL_LIST, SLAVE_LIST, + & + & PROCNODE_STEPS, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & ITLOC, RHS_MUMPS, COMP, + & IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8, + & COMM,COMM_LOAD,FILS,ND ) + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC) :: ROOT + INTEGER INODE, NELIM, NSLAVES + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER ROW_LIST(*), COL_LIST(*), + & SLAVE_LIST(*) + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER PTRIST( KEEP(28) ), PTLUST_S(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), ITLOC( N + KEEP(253) ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER IFLAG, IERROR + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF + INTEGER COMM,COMM_LOAD,ND(KEEP(28)),FILS(N) + INTEGER IROOT, TYPE_INODE, DEB_ROW, DEB_COL, + & NOINT + INTEGER(8) :: NOREAL + INCLUDE 'mumps_headers.h' + INCLUDE 'mumps_tags.h' + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + IROOT = KEEP(38) + NSTK_S(STEP(IROOT))= NSTK_S(STEP(IROOT)) - 1 + KEEP(42) = KEEP(42) + NELIM + TYPE_INODE= MUMPS_330(PROCNODE_STEPS(STEP(INODE)), SLAVEF) + IF (TYPE_INODE.EQ.1) THEN + IF (NELIM.EQ.0) THEN + KEEP(41) = KEEP(41) + 1 + ELSE + KEEP(41) = KEEP(41) + 3 + ENDIF + ELSE + IF (NELIM.EQ.0) THEN + KEEP(41) = KEEP(41) + NSLAVES + ELSE + KEEP(41) = KEEP(41) + 2*NSLAVES + 1 + ENDIF + ENDIF + IF (NELIM.EQ.0) THEN + PIMASTER(STEP(INODE)) = 0 + ELSE + NOINT = 6 + NSLAVES + NELIM + NELIM + KEEP(IXSZ) + NOREAL= 0_8 + CALL CMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, + & NOINT, NOREAL, INODE, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) THEN + WRITE(*,*) ' Failure in int space allocation in CB area ', + & ' during assembly of root : CMUMPS_273', + & ' size required was :', NOINT, + & 'INODE=',INODE,' NELIM=',NELIM, ' NSLAVES=', NSLAVES + RETURN + ENDIF + PIMASTER(STEP( INODE )) = IWPOSCB + 1 + PAMASTER(STEP( INODE )) = IPTRLU + 1_8 + IW( IWPOSCB + 1+KEEP(IXSZ) ) = 2*NELIM + IW( IWPOSCB + 2+KEEP(IXSZ) ) = NELIM + IW( IWPOSCB + 3+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 4+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 5+KEEP(IXSZ) ) = 1 + IW( IWPOSCB + 6+KEEP(IXSZ) ) = NSLAVES + IF (NSLAVES.GT.0) THEN + IW( IWPOSCB+7+KEEP(IXSZ):IWPOSCB+7+KEEP(IXSZ)+NSLAVES-1) = + & SLAVE_LIST(1:NSLAVES) + ENDIF + DEB_ROW = IWPOSCB+7+NSLAVES+KEEP(IXSZ) + IW(DEB_ROW : DEB_ROW+NELIM -1) = ROW_LIST(1:NELIM) + DEB_COL = DEB_ROW + NELIM + IW(DEB_COL : DEB_COL+NELIM -1) = COL_LIST(1:NELIM) + ENDIF + IF (NSTK_S(STEP(IROOT)) .EQ. 0 ) THEN + CALL CMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IROOT ) + IF (KEEP(47) .GE. 3) THEN + CALL CMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + RETURN + END SUBROUTINE CMUMPS_273 + SUBROUTINE CMUMPS_363(N,FRERE, STEP, FILS, + & NA,LNA,NE,ND, DAD, LDAD, USE_DAD, + & NSTEPS,PERM,SYM,INFO,LP,K215,K234,K55, + & PROCNODE,SLAVEF, PEAK,SBTR_WHICH_M + & ) + IMPLICIT NONE + INTEGER N,PERM,SYM, NSTEPS, LNA, LP,LDAD + INTEGER FRERE(NSTEPS), FILS(N), STEP(N) + INTEGER NA(LNA), NE(NSTEPS), ND(NSTEPS) + INTEGER K215,K234,K55 + INTEGER DAD(LDAD) + LOGICAL USE_DAD + INTEGER INFO(40) + INTEGER SLAVEF,PROCNODE(NSTEPS) + INTEGER :: SBTR_WHICH_M + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + REAL PEAK + REAL, DIMENSION(:), ALLOCATABLE :: COST_TRAV + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH + INTEGER IFATH,IN,NSTK,INODE,I,allocok,LOCAL_PERM + INTEGER(8) NCB + INTEGER(8) NELIM,NFR + INTEGER NFR4,NELIM4 + INTEGER LEAF,NBLEAF,NBROOT, SIZE_TAB + INTEGER, DIMENSION (:), ALLOCATABLE :: IPOOL,TNSTK + INTEGER, DIMENSION (:), ALLOCATABLE,TARGET :: SON,TEMP + INTEGER(8), DIMENSION (:), ALLOCATABLE :: M,M_TOTAL, fact + INTEGER(8), DIMENSION (:), ALLOCATABLE :: TAB1,TAB2 + INTEGER, DIMENSION (:), POINTER :: TAB + INTEGER dernier,fin + INTEGER cour,II + INTEGER CB_current,CB_MAX,ROOT_OF_CUR_SBTR + INTEGER(8), DIMENSION (:), ALLOCATABLE :: T1,T2 + INTEGER, DIMENSION (:), ALLOCATABLE :: RESULT + INTEGER(8) MEM_SIZE,FACT_SIZE,SUM,MEM_SEC_PERM,FACT_SIZE_T, + & MEM_SIZE_T,TOTAL_MEM_SIZE,TMP_TOTAL_MEM_SIZE,TMP_SUM, + & SIZECB, SIZECB_LASTSON + INTEGER(8) TMP8 + LOGICAL SBTR_M + INTEGER FIRST_LEAF,SIZE_SBTR + EXTERNAL MUMPS_170,MUMPS_167 + LOGICAL MUMPS_170,MUMPS_167 + DOUBLE PRECISION COST_NODE + INCLUDE 'mumps_headers.h' + TOTAL_MEM_SIZE=0_8 + ROOT_OF_CUR_SBTR=0 + IF((PERM.EQ.0).OR.(PERM.EQ.1).OR. + & (PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4).OR. + & (PERM.EQ.5).OR.(PERM.EQ.6))THEN + LOCAL_PERM=0 + ENDIF + SBTR_M=.FALSE. + MEM_SIZE=0_8 + FACT_SIZE=0_8 + IF ((PERM.LT.0 .OR. PERM.GT.7)) THEN + WRITE(*,*) "Internal Error in CMUMPS_363",PERM + CALL MUMPS_ABORT() + END IF + NBLEAF = NA(1) + NBROOT = NA(2) + IF((PERM.EQ.0).AND.(NBROOT.EQ.NBLEAF)) RETURN + IF ((PERM.NE.7).AND.(SBTR_M.OR.(PERM.EQ.2))) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + ALLOCATE(M_TOTAL(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & CMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ENDIF + ENDIF + IF(PERM.NE.7)THEN + ALLOCATE(M(NSTEPS),stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error + &in CMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ENDIF + ALLOCATE( IPOOL(NBLEAF), fact(NSTEPS),TNSTK(NSTEPS), + & stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in CMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + II=0 + DO I=1,NSTEPS + TNSTK(I) = NE(I) + IF(NE(I).GE.II) II=NE(I) + ENDDO + SIZE_TAB=max(II,NBROOT) + ALLOCATE(SON(II), TEMP(II), + & TAB1(SIZE_TAB), TAB2(SIZE_TAB), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in CMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ALLOCATE(T1(SIZE_TAB),T2(SIZE_TAB), + & RESULT(SIZE_TAB),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in CMUMPS_363' + INFO(1)=-7 + INFO(2)=SIZE_TAB + RETURN + ENDIF + IF(PERM.EQ.7) THEN + GOTO 001 + ENDIF + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + ALLOCATE(COST_TRAV(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error + & in CMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + COST_TRAV=0.0E0 + COST_NODE=0.0d0 + ENDIF + IF(NBROOT.EQ.NBLEAF)THEN + IF((PERM.NE.1).OR.(PERM.EQ.4).OR.(PERM.EQ.6))THEN + WRITE(*,*)'Internal Error in reordertree:' + WRITE(*,*)' problem with perm parameter in reordertree' + CALL MUMPS_ABORT() + ENDIF + DO I=1,NBROOT + TAB1(I)=int(ND(STEP(NA(I+2+NBLEAF))),8) + IPOOL(I)=NA(I+2+NBLEAF) + M(STEP(IPOOL(I)))=TAB1(I)*TAB1(I) + ENDDO + CALL CMUMPS_462(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4, + & RESULT,T1,T2) + GOTO 789 + ENDIF + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + ALLOCATE(DEPTH(NSTEPS),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & CMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + DEPTH=0 + NBROOT = NA(2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + fin=NBROOT + LEAF=NA(1) + 499 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IN=INODE + 4602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + GOTO 4602 + ENDIF + IN=-IN + DO I=1,NE(STEP(INODE)) + SON(I)=IN + IN=FRERE(STEP(IN)) + ENDDO + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=SON(I) + DEPTH(STEP(SON(I)))=DEPTH(STEP(INODE))+1 + SON(I)=0 + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 499 + ENDIF + fin=fin-1 + IF(fin.EQ.0) GOTO 489 + GOTO 499 + 489 CONTINUE + ENDIF + DO I=1,NSTEPS + M(I)=0_8 + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + M_TOTAL(I)=0_8 + ENDIF + ENDIF + ENDDO + DO I=1,NSTEPS + fact(I)=0_8 + ENDDO + IPOOL(1:NBLEAF)=NA(3:2+NBLEAF) + LEAF = NBLEAF + 1 + 91 CONTINUE + IF (LEAF.NE.1) THEN + LEAF = LEAF -1 + INODE = IPOOL(LEAF) + ENDIF + 96 CONTINUE + NFR = int(ND(STEP(INODE)),8) + NSTK = NE(STEP(INODE)) + NELIM4 = 0 + IN = INODE + 101 NELIM4 = NELIM4 + 1 + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 101 + NELIM=int(NELIM4,8) + IF(NE(STEP(INODE)).EQ.0) THEN + M(STEP(INODE))=NFR*NFR + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + M_TOTAL(STEP(INODE))=NFR*NFR + ENDIF + ENDIF + IF((PERM.EQ.4).OR.(PERM.EQ.3))THEN + IF(MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + DEPTH(STEP(INODE))=0 + ENDIF + ENDIF + IF ( SYM .eq. 0 ) THEN + fact(STEP(INODE))=fact(STEP(INODE))+ + & (2_8*NFR*NELIM)-(NELIM*NELIM) + ELSE + fact(STEP(INODE))=fact(STEP(INODE))+NFR*NELIM + ENDIF + IF (USE_DAD) THEN + IFATH = DAD( STEP(INODE) ) + ELSE + IN = INODE + 113 IN = FRERE(IN) + IF (IN.GT.0) GO TO 113 + IFATH = -IN + ENDIF + IF (IFATH.EQ.0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 116 + GOTO 91 + ELSE + fact(STEP(IFATH))=fact(STEP(IFATH))+fact(STEP(INODE)) + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + DEPTH(STEP(IFATH))=max(DEPTH(STEP(INODE)), + & DEPTH(STEP(IFATH))) + ENDIF + ENDIF + TNSTK(STEP(IFATH)) = TNSTK(STEP(IFATH)) - 1 + IF ( TNSTK(STEP(IFATH)) .EQ. 0 ) THEN + INODE = IFATH + IN=INODE + dernier=IN + I=1 + 5700 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + dernier=IN + I=I+1 + GOTO 5700 + ENDIF + NCB=int(ND(STEP(INODE))-I,8) + IN=-IN + IF(PERM.NE.7)THEN + DO I=1,NE(STEP(INODE)) + SON(I)=IN + TEMP(I)=IN + IF(IN.GT.0) IN=FRERE(STEP(IN)) + ENDDO + ELSE + DO I=NE(STEP(INODE)),1,-1 + SON(I)=IN + TEMP(I)=IN + IF(IN.GT.0) IN=FRERE(STEP(IN)) + ENDDO + ENDIF + NFR = int(ND(STEP(INODE)),8) + DO II=1,NE(STEP(INODE)) + TAB1(II)=0_8 + TAB2(II)=0_8 + cour=SON(II) + NELIM4=1 + 151 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 151 + ENDIF + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0)) THEN + SIZECB=(int(ND(STEP(SON(II))),8)-NELIM) + & *(int(ND(STEP(SON(II))),8)-NELIM) + ELSE + SIZECB=(int(ND(STEP(SON(II))),8)-NELIM) + & *(int(ND(STEP(SON(II))),8)- + & NELIM+1_8)/2_8 + ENDIF + IF((PERM.EQ.0).OR.(PERM.EQ.5))THEN + IF (K234 .NE. 0 .AND. K55.EQ.0 ) THEN + TMP8=NFR + TMP8=TMP8*TMP8 + TAB1(II)=max(TMP8, M(STEP(SON(II)))) - SIZECB + TAB2(II)=SIZECB + ELSE + TAB1(II)=M(STEP(SON(II)))- SIZECB + TAB2(II)=SIZECB + ENDIF + ENDIF + IF((PERM.EQ.1).OR.(PERM.EQ.6)) THEN + TAB1(II)=M(STEP(SON(II)))-SIZECB + TAB1(II)=TAB1(II)-fact(STEP(SON(II))) + TAB2(II)=SIZECB+fact(STEP(SON(II))) + ENDIF + IF(PERM.EQ.2)THEN + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + TAB1(II)=M_TOTAL(STEP(SON(II)))-SIZECB + & -fact(STEP(SON(II))) + TAB2(II)=SIZECB + ELSE + TAB1(II)=M(STEP(SON(II)))-SIZECB + TAB2(II)=SIZECB + ENDIF + ENDIF + IF(PERM.EQ.3)THEN + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + TAB1(II)=M(STEP(SON(II)))-SIZECB + TAB2(II)=SIZECB + ELSE + TAB1(II)=int(DEPTH(STEP(SON(II))),8) + TAB2(II)=M(STEP(SON(II))) + ENDIF + ENDIF + IF(PERM.EQ.4)THEN + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + TAB1(II)=M(STEP(SON(II)))- + & SIZECB-fact(STEP(SON(II))) + TAB2(II)=SIZECB + ELSE + TAB1(II)=int(DEPTH(STEP(SON(II))),8) + TAB2(II)=M(STEP(SON(II))) + ENDIF + ENDIF + ENDDO + CALL CMUMPS_462(SON,NE(STEP(INODE)),TAB1,TAB2, + & LOCAL_PERM + & ,RESULT,T1,T2) + IF(PERM.EQ.0) THEN + DO II=1,NE(STEP(INODE)) + cour=TEMP(II) + NELIM4=1 + 153 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 153 + ENDIF + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM) + ELSE + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM+1_8)/2_8 + ENDIF + TAB1(II)=SIZECB + ENDDO + CALL CMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2,3, + & RESULT,T1,T2) + ENDIF + IF(PERM.EQ.1) THEN + DO II=1,NE(STEP(INODE)) + cour=TEMP(II) + NELIM4=1 + 187 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 187 + ENDIF + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM) + ELSE + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM+1_8)/2_8 + ENDIF + TAB1(II)=SIZECB+fact(STEP(TEMP(II))) + ENDDO + CALL CMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2,3, + & RESULT,T1,T2) + ENDIF + CONTINUE + IFATH=INODE + DO II=1,2 + SUM=0_8 + FACT_SIZE=0_8 + FACT_SIZE_T=0_8 + MEM_SIZE=0_8 + MEM_SIZE_T=0_8 + CB_MAX=0 + CB_current=0 + TMP_SUM=0_8 + IF(II.EQ.1) TAB=>SON + IF(II.EQ.2) TAB=>TEMP + DO I=1,NE(STEP(INODE)) + cour=TAB(I) + NELIM4=1 + 149 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 149 + ENDIF + NELIM=int(NELIM4, 8) + NFR=int(ND(STEP(TAB(I))),8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(NFR-NELIM)*(NFR-NELIM) + ELSE + SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8 + ENDIF + MEM_SIZE=max(MEM_SIZE,(M(STEP(TAB(I)))+SUM+FACT_SIZE)) + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + MEM_SIZE_T=max(MEM_SIZE_T,(M_TOTAL(STEP(TAB(I)))+ + & SUM+ + & FACT_SIZE_T)) + FACT_SIZE_T=FACT_SIZE_T+fact(STEP(TAB(I))) + ENDIF + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & (M(STEP(TAB(I)))+SUM+FACT_SIZE)) + TMP_SUM=TMP_SUM+fact(STEP(TAB(I))) + SUM=SUM+SIZECB + SIZECB_LASTSON = SIZECB + IF((PERM.EQ.1).OR.(PERM.EQ.4))THEN + FACT_SIZE=FACT_SIZE+fact(STEP(TAB(I))) + ENDIF + ENDDO + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=NCB*NCB + ELSE + SIZECB=(NCB*(NCB+1_8))/2_8 + ENDIF + IF (K234.NE.0 .AND. K55.EQ.0) THEN + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & ( ( int(ND(STEP(IFATH)),8) + & * int(ND(STEP(IFATH)),8) ) + & + SUM-SIZECB_LASTSON+TMP_SUM ) + & ) + ELSE IF (K234.NE.0 .AND. K55.NE.0) THEN + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & ( ( int(ND(STEP(IFATH)),8) + & * int(ND(STEP(IFATH)),8) ) + & + SUM + TMP_SUM ) + & ) + ELSE + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & ( ( int(ND(STEP(IFATH)),8) + & * int(ND(STEP(IFATH)),8)) + & + max(SUM,SIZECB) + TMP_SUM ) + & ) + ENDIF + IF(II.EQ.1)THEN + TMP_TOTAL_MEM_SIZE=TOTAL_MEM_SIZE + ENDIF + IF(II.EQ.1)THEN + IF (K234.NE.0 .AND. K55.EQ.0) THEN + M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+SUM-SIZECB_LASTSON+ + & FACT_SIZE)) + ELSE IF (K234.NE.0 .AND. K55.NE.0) THEN + M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+SUM+FACT_SIZE)) + ELSE + M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+FACT_SIZE)) + ENDIF + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + M_TOTAL(STEP(IFATH))=max(MEM_SIZE_T, + & ((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+ + & FACT_SIZE_T)) + ENDIF + ENDIF + IF((II.EQ.2).AND.(PERM.EQ.1).OR.(PERM.EQ.0).OR. + & (PERM.EQ.5).OR.(PERM.EQ.6).OR. + & (.NOT.SBTR_M.OR.(SBTR_WHICH_M.NE.1)))THEN + MEM_SEC_PERM=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+FACT_SIZE)) + ENDIF + IF((PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4))THEN + MEM_SEC_PERM=huge(MEM_SEC_PERM) + ENDIF + ENDDO + IF(MEM_SEC_PERM.EQ.M(STEP(IFATH))) THEN + TAB=>TEMP + ELSE IF (MEM_SEC_PERM.LT.M(STEP(IFATH))) THEN + WRITE(*,*)'Probleme dans reorder!!!!' + CALL MUMPS_ABORT() + ELSE + TOTAL_MEM_SIZE=TMP_TOTAL_MEM_SIZE + TAB=>SON + ENDIF + DO I=NE(STEP(INODE)),1,-1 + IF(I.EQ.NE(STEP(INODE))) THEN + FILS(dernier)=-TAB(I) + dernier=TAB(I) + GOTO 222 + ENDIF + IF(I.EQ.1) THEN + FRERE(STEP(dernier))=TAB(I) + FRERE(STEP(TAB(I)))=-INODE + GOTO 222 + ENDIF + IF(I.GT.1) THEN + FRERE(STEP(dernier))=TAB(I) + dernier=TAB(I) + GOTO 222 + ENDIF + 222 CONTINUE + ENDDO + GOTO 96 + ELSE + GOTO 91 + ENDIF + 116 CONTINUE + NBROOT = NA(2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + IF (PERM.eq.1) THEN + DO I=1,NBROOT + TAB1(I)=M(STEP(NA(I+2+NBLEAF)))-fact(STEP(NA(I+2+NBLEAF))) + TAB1(I)=-TAB1(I) + ENDDO + CALL CMUMPS_462(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4, + & RESULT,T1,T2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + ENDIF + 001 CONTINUE + fin=NBROOT + LEAF=NA(1) + FIRST_LEAF=-9999 + SIZE_SBTR=0 + 999 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IN=INODE + 5602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + dernier=IN + GOTO 5602 + ENDIF + IN=-IN + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + IF(SLAVEF.NE.1)THEN + IF (USE_DAD) THEN + IFATH=DAD(INODE) + ELSE + IN = INODE + 395 IN = FRERE(IN) + IF (IN.GT.0) GO TO 395 + IFATH = -IN + ENDIF + NFR4 = ND(STEP(INODE)) + NFR = int(NFR4,8) + NELIM4 = 0 + IN = INODE + 396 NELIM4 = NELIM4 + 1 + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 396 + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(NFR-NELIM)*(NFR-NELIM) + ELSE + SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8 + ENDIF + CALL MUMPS_511(NFR4,NELIM4,NELIM4, + & SYM,1,COST_NODE) + IF(IFATH.NE.0)THEN + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + COST_TRAV(STEP(INODE))=COST_TRAV(STEP( + & ROOT_OF_CUR_SBTR)) + ELSE + COST_TRAV(STEP(INODE))=real(COST_NODE)+ + & COST_TRAV(STEP(IFATH))+ + & real(SIZECB*18_8) + ENDIF + ELSE + COST_TRAV(STEP(INODE))=real(COST_NODE) + ENDIF + ENDIF + ENDIF + DO I=1,NE(STEP(INODE)) + TEMP(I)=IN + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + IF((SLAVEF.NE.1).AND.(.NOT.MUMPS_170( + & PROCNODE(STEP(INODE)),SLAVEF)))THEN + NFR4 = ND(STEP(INODE)) + NFR = int(NFR4,8) + NELIM4 = 0 + II = TEMP(I) + 845 NELIM4 = NELIM4 + 1 + II = FILS(II) + IF (II .GT. 0 ) GOTO 845 + NELIM=int(NELIM4,8) + CALL MUMPS_511(NFR4,NELIM4,NELIM4, + & SYM,1,COST_NODE) + TAB1(I)=int(real(COST_NODE)+ + & COST_TRAV(STEP(INODE)),8) + TAB2(I)=0_8 + ELSE + SON(I)=IN + ENDIF + ELSE + SON(I)=IN + ENDIF + IN=FRERE(STEP(IN)) + ENDDO + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + IF((SLAVEF.NE.1).AND.(.NOT.MUMPS_170( + & PROCNODE(STEP(INODE)),SLAVEF)))THEN + CALL CMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2, + & LOCAL_PERM + & ,RESULT,T1,T2) + TAB=>TEMP + DO I=NE(STEP(INODE)),1,-1 + IF(I.EQ.NE(STEP(INODE))) THEN + FILS(dernier)=-TAB(I) + dernier=TAB(I) + GOTO 221 + ENDIF + IF(I.EQ.1) THEN + FRERE(STEP(dernier))=TAB(I) + FRERE(STEP(TAB(I)))=-INODE + GOTO 221 + ENDIF + IF(I.GT.1) THEN + FRERE(STEP(dernier))=TAB(I) + dernier=TAB(I) + GOTO 221 + ENDIF + 221 CONTINUE + SON(NE(STEP(INODE))-I+1)=TAB(I) + ENDDO + ENDIF + ENDIF + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=SON(I) + SON(I)=0 + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + IF(PERM.NE.7)THEN + NA(LEAF+2)=INODE + ENDIF + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 999 + ENDIF + fin=fin-1 + IF(fin.EQ.0) THEN + GOTO 789 + ENDIF + GOTO 999 + 789 CONTINUE + IF(PERM.EQ.7) GOTO 5483 + NBROOT=NA(2) + NBLEAF=NA(1) + PEAK=0.0E0 + FACT_SIZE=0_8 + DO I=1,NBROOT + PEAK=max(PEAK,real(M(STEP(NA(2+NBLEAF+I))))) + FACT_SIZE=FACT_SIZE+fact(STEP(NA(2+NBLEAF+I))) + ENDDO + 5483 CONTINUE + DEALLOCATE(IPOOL) + DEALLOCATE(fact) + DEALLOCATE(TNSTK) + DEALLOCATE(SON) + DEALLOCATE(TAB2) + DEALLOCATE(TAB1) + DEALLOCATE(T1) + DEALLOCATE(T2) + DEALLOCATE(RESULT) + DEALLOCATE(TEMP) + IF(PERM.NE.7)THEN + DEALLOCATE(M) + ENDIF + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + DEALLOCATE(DEPTH) + ENDIF + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + DEALLOCATE(COST_TRAV) + ENDIF + IF ((PERM.NE.7).AND.(SBTR_M.OR.(PERM.EQ.2))) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1).OR.(PERM.EQ.2))THEN + DEALLOCATE(M_TOTAL) + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_363 + SUBROUTINE CMUMPS_364(N,FRERE, STEP, FILS, + & NA,LNA,NE,ND, DAD, LDAD, USE_DAD, + & NSTEPS,PERM,SYM,INFO,LP,K47,K81,K76,K215,K234,K55, + & PROCNODE,MEM_SUBTREE,SLAVEF, SIZE_MEM_SBTR, PEAK + & ,SBTR_WHICH_M,SIZE_DEPTH_FIRST,SIZE_COST_TRAV, + & DEPTH_FIRST_TRAV,DEPTH_FIRST_SEQ,COST_TRAV,MY_FIRST_LEAF, + & MY_NB_LEAF,MY_ROOT_SBTR,SBTR_ID + & ) + IMPLICIT NONE + INTEGER N,PERM,SYM, NSTEPS, LNA, LP, SIZE_MEM_SBTR,LDAD + INTEGER FRERE(NSTEPS), FILS(N), STEP(N) + INTEGER NA(LNA), NE(NSTEPS), ND(NSTEPS) + INTEGER K47,K81,K76,K215,K234,K55 + INTEGER DAD(LDAD) + LOGICAL USE_DAD + INTEGER INFO(40) + INTEGER SLAVEF,PROCNODE(NSTEPS) + DOUBLE PRECISION, intent(out) :: MEM_SUBTREE(SIZE_MEM_SBTR,SLAVEF) + INTEGER :: SBTR_WHICH_M + INTEGER MY_FIRST_LEAF(SIZE_MEM_SBTR,SLAVEF), + & MY_ROOT_SBTR(SIZE_MEM_SBTR,SLAVEF), + & MY_NB_LEAF(SIZE_MEM_SBTR,SLAVEF) + EXTERNAL MUMPS_283,MUMPS_275 + LOGICAL MUMPS_283 + INTEGER MUMPS_275 + REAL PEAK + INTEGER SIZE_DEPTH_FIRST,DEPTH_FIRST_TRAV(SIZE_DEPTH_FIRST), + & DEPTH_FIRST_SEQ(SIZE_DEPTH_FIRST) + INTEGER SIZE_COST_TRAV + INTEGER SBTR_ID(SIZE_DEPTH_FIRST),OOC_CUR_SBTR + REAL COST_TRAV(SIZE_COST_TRAV) + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH + INTEGER IFATH,IN,INODE,I,allocok,LOCAL_PERM + INTEGER(8) NELIM,NFR + INTEGER NFR4,NELIM4 + INTEGER LEAF,NBLEAF,NBROOT, SIZE_TAB + INTEGER, DIMENSION (:), ALLOCATABLE :: IPOOL,TNSTK + INTEGER, DIMENSION (:), ALLOCATABLE,TARGET :: SON,TEMP + INTEGER(8), DIMENSION (:), ALLOCATABLE :: M,M_TOTAL, fact + INTEGER(8), DIMENSION (:), ALLOCATABLE :: TAB1,TAB2 + INTEGER x,dernier,fin,RANK_TRAV + INTEGER II + INTEGER ROOT_OF_CUR_SBTR + INTEGER(8), DIMENSION (:), ALLOCATABLE :: T1,T2 + INTEGER, DIMENSION (:), ALLOCATABLE :: RESULT + INTEGER(8) MEM_SIZE,FACT_SIZE, + & TOTAL_MEM_SIZE, + & SIZECB + LOGICAL SBTR_M + INTEGER INDICE(SLAVEF),ID,FIRST_LEAF,SIZE_SBTR + EXTERNAL MUMPS_170,MUMPS_167 + LOGICAL MUMPS_170,MUMPS_167 + DOUBLE PRECISION COST_NODE + INTEGER CUR_DEPTH_FIRST_RANK + INCLUDE 'mumps_headers.h' + TOTAL_MEM_SIZE=0_8 + ROOT_OF_CUR_SBTR=0 + IF((PERM.EQ.0).OR.(PERM.EQ.1).OR. + & (PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4).OR. + & (PERM.EQ.5).OR.(PERM.EQ.6))THEN + LOCAL_PERM=0 + ENDIF + IF (K47 == 4 .OR. ((K47.GE.2).AND.(K81.GE. 1))) THEN + DO I=1,SLAVEF + INDICE(I)=1 + ENDDO + DO I=1,SLAVEF + DO x=1,SIZE_MEM_SBTR + MEM_SUBTREE(x,I)=-1.0D0 + ENDDO + ENDDO + ENDIF + SBTR_M=((K47 == 4 .OR. ((K47.GE.2).AND.(K81 .GE. 1)))) + MEM_SIZE=0_8 + FACT_SIZE=0_8 + IF ((PERM.GT.7).AND. + & (.NOT.(K47 == 4 .OR. ((K47.GE.2).AND.(K81 .GE. 1))))) THEN + WRITE(*,*) "Internal Error in CMUMPS_363",PERM + CALL MUMPS_ABORT() + END IF + NBLEAF = NA(1) + NBROOT = NA(2) + CUR_DEPTH_FIRST_RANK=1 + IF((PERM.EQ.0).AND.(NBROOT.EQ.NBLEAF)) RETURN + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + ALLOCATE(M_TOTAL(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & CMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ENDIF + ENDIF + ALLOCATE( IPOOL(NBLEAF), M(NSTEPS), fact(NSTEPS), + & TNSTK(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in CMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + II=0 + DO I=1,NSTEPS + TNSTK(I) = NE(I) + IF(NE(I).GE.II) II=NE(I) + ENDDO + SIZE_TAB=max(II,NBROOT) + ALLOCATE(SON(II), TEMP(II), + & TAB1(SIZE_TAB), TAB2(SIZE_TAB), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in CMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ALLOCATE(T1(SIZE_TAB),T2(SIZE_TAB), + & RESULT(SIZE_TAB),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in CMUMPS_363' + INFO(1)=-7 + INFO(2)=SIZE_TAB + RETURN + ENDIF + IF(NBROOT.EQ.NBLEAF)THEN + IF((PERM.NE.1).OR.(PERM.EQ.4).OR.(PERM.EQ.6))THEN + WRITE(*,*)'Internal Error in reordertree:' + WRITE(*,*)' problem with perm parameter in reordertree' + CALL MUMPS_ABORT() + ENDIF + DO I=1,NBROOT + TAB1(I)=int(ND(STEP(NA(I+2+NBLEAF))),8) + IPOOL(I)=NA(I+2+NBLEAF) + M(STEP(IPOOL(I)))=TAB1(I)*TAB1(I) + ENDDO + CALL CMUMPS_462(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4, + & RESULT,T1,T2) + GOTO 789 + ENDIF + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + ALLOCATE(DEPTH(NSTEPS),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & CMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + DEPTH=0 + NBROOT = NA(2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + fin=NBROOT + LEAF=NA(1) + 499 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IN=INODE + 4602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + GOTO 4602 + ENDIF + IN=-IN + DO I=1,NE(STEP(INODE)) + SON(I)=IN + IN=FRERE(STEP(IN)) + ENDDO + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=SON(I) + DEPTH(STEP(SON(I)))=DEPTH(STEP(INODE))+1 + SON(I)=0 + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 499 + ENDIF + fin=fin-1 + IF(fin.EQ.0) GOTO 489 + GOTO 499 + 489 CONTINUE + ENDIF + IF(K76.EQ.4.OR.(K76.EQ.6))THEN + RANK_TRAV=NSTEPS + DEPTH_FIRST_TRAV=0 + DEPTH_FIRST_SEQ=0 + ENDIF + IF((K76.EQ.5).OR.(PERM.EQ.5).OR.(PERM.EQ.6))THEN + COST_TRAV=0.0E0 + COST_NODE=0.0d0 + ENDIF + DO I=1,NSTEPS + M(I)=0_8 + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + M_TOTAL(I)=0_8 + ENDIF + ENDIF + ENDDO + DO I=1,NSTEPS + fact(I)=0_8 + ENDDO + NBROOT = NA(2) + NBLEAF = NA(1) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + CONTINUE + fin=NBROOT + LEAF=NA(1) + FIRST_LEAF=-9999 + SIZE_SBTR=0 + 999 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IF(SIZE_SBTR.NE.0)THEN + IF(.NOT.MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF((SLAVEF.NE.1))THEN + MY_FIRST_LEAF(INDICE(ID+1)-1,ID+1)=FIRST_LEAF + MY_NB_LEAF(INDICE(ID+1)-1,ID+1)=SIZE_SBTR + FIRST_LEAF=-9999 + SIZE_SBTR=0 + ENDIF + ENDIF + ENDIF + ENDIF + IF(MUMPS_283(PROCNODE(STEP(INODE)),SLAVEF))THEN + ROOT_OF_CUR_SBTR=INODE + ENDIF + IF (K76.EQ.4)THEN + IF(SLAVEF.NE.1)THEN + WRITE(*,*)'INODE=',INODE,'RANK',RANK_TRAV + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + DEPTH_FIRST_TRAV(STEP(INODE))=DEPTH_FIRST_TRAV(STEP( + & ROOT_OF_CUR_SBTR)) + ELSE + DEPTH_FIRST_TRAV(STEP(INODE))=RANK_TRAV + ENDIF + RANK_TRAV=RANK_TRAV-1 + ENDIF + ENDIF + IF (K76.EQ.5)THEN + IF(SLAVEF.NE.1)THEN + IF (USE_DAD) THEN + IFATH=DAD(INODE) + ELSE + IN = INODE + 395 IN = FRERE(IN) + IF (IN.GT.0) GO TO 395 + IFATH = -IN + ENDIF + NFR4 = ND(STEP(INODE)) + NFR = int(NFR4,8) + NELIM4 = 0 + IN = INODE + 396 NELIM4 = NELIM4 + 1 + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 396 + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(NFR-NELIM)*(NFR-NELIM) + ELSE + SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8 + ENDIF + CALL MUMPS_511(NFR4,NELIM4,NELIM4, + & SYM,1,COST_NODE) + IF(IFATH.NE.0)THEN + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + COST_TRAV(STEP(INODE))=COST_TRAV(STEP( + & ROOT_OF_CUR_SBTR)) + ELSE + COST_TRAV(STEP(INODE))=real(COST_NODE)+ + & COST_TRAV(STEP(IFATH))+ + & real(SIZECB*18_8) + ENDIF + ELSE + COST_TRAV(STEP(INODE))=real(COST_NODE) + ENDIF + IF(K76.EQ.5)THEN + WRITE(*,*)'INODE=',INODE,'COST=',COST_TRAV(STEP(INODE)) + ENDIF + ENDIF + ENDIF + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF((SLAVEF.NE.1).AND. + & MUMPS_283(PROCNODE(STEP(INODE)),SLAVEF))THEN + IF (NE(STEP(INODE)).NE.0) THEN + ID=MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M_TOTAL(STEP(INODE))) + ELSE + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M(STEP(INODE))) + ENDIF + MY_ROOT_SBTR(INDICE(ID+1),ID+1)=INODE + INDICE(ID+1)=INDICE(ID+1)+1 + ENDIF + ENDIF + IF((SLAVEF.EQ.1).AND.FRERE(STEP(INODE)).EQ.0)THEN + ID=MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M_TOTAL(STEP(INODE))) + ELSE + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M(STEP(INODE))) + ENDIF + INDICE(ID+1)=INDICE(ID+1)+1 + ENDIF + ENDIF + IN=INODE + 5602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + dernier=IN + GOTO 5602 + ENDIF + IN=-IN + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=IN + IF(IN.GT.0) IN=FRERE(STEP(IN)) + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF(SLAVEF.NE.1)THEN + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + IF(FIRST_LEAF.EQ.-9999)THEN + FIRST_LEAF=INODE + ENDIF + SIZE_SBTR=SIZE_SBTR+1 + ENDIF + ENDIF + ENDIF + IF(PERM.NE.7)THEN + NA(LEAF+2)=INODE + ENDIF + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 999 + ENDIF + fin=fin-1 + IF(fin.EQ.0) THEN + IF(SIZE_SBTR.NE.0)THEN + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF((SLAVEF.NE.1))THEN + MY_FIRST_LEAF(INDICE(ID+1)-1,ID+1)=FIRST_LEAF + MY_NB_LEAF(INDICE(ID+1)-1,ID+1)=SIZE_SBTR + FIRST_LEAF=-9999 + SIZE_SBTR=0 + ENDIF + ENDIF + ENDIF + GOTO 789 + ENDIF + GOTO 999 + 789 CONTINUE + IF(K76.EQ.6)THEN + OOC_CUR_SBTR=1 + DO I=1,NSTEPS + TNSTK(I) = NE(I) + ENDDO + NBROOT=NA(2) + NBLEAF=NA(1) + IPOOL(1:NBLEAF)=NA(3:2+NBLEAF) + LEAF = NBLEAF + 1 + 9100 CONTINUE + IF (LEAF.NE.1) THEN + LEAF = LEAF -1 + INODE = IPOOL(LEAF) + ENDIF + 9600 CONTINUE + IF(SLAVEF.NE.1)THEN + ID=MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + DEPTH_FIRST_TRAV(STEP(INODE))=CUR_DEPTH_FIRST_RANK + DEPTH_FIRST_SEQ(CUR_DEPTH_FIRST_RANK)=INODE + WRITE(*,*)ID,': INODE -> ',INODE,'DF =', + & CUR_DEPTH_FIRST_RANK + CUR_DEPTH_FIRST_RANK=CUR_DEPTH_FIRST_RANK+1 + IF(MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + SBTR_ID(STEP(INODE))=OOC_CUR_SBTR + ELSE + SBTR_ID(STEP(INODE))=-9999 + ENDIF + IF(MUMPS_283(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + OOC_CUR_SBTR=OOC_CUR_SBTR+1 + ENDIF + ENDIF + IF (USE_DAD) THEN + IFATH = DAD( STEP(INODE) ) + ELSE + IN = INODE + 1133 IN = FRERE(IN) + IF (IN.GT.0) GO TO 1133 + IFATH = -IN + ENDIF + IF (IFATH.EQ.0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 1163 + GOTO 9100 + ENDIF + TNSTK(STEP(IFATH))=TNSTK(STEP(IFATH))-1 + IF(TNSTK(STEP(IFATH)).EQ.0) THEN + INODE=IFATH + GOTO 9600 + ELSE + GOTO 9100 + ENDIF + 1163 CONTINUE + ENDIF + PEAK=0.0E0 + FACT_SIZE=0_8 + DO I=1,NBROOT + PEAK=max(PEAK,real(M(STEP(NA(2+NBLEAF+I))))) + FACT_SIZE=FACT_SIZE+fact(STEP(NA(2+NBLEAF+I))) + ENDDO + CONTINUE + DEALLOCATE(IPOOL) + DEALLOCATE(M) + DEALLOCATE(fact) + DEALLOCATE(TNSTK) + DEALLOCATE(SON) + DEALLOCATE(TAB2) + DEALLOCATE(TAB1) + DEALLOCATE(T1) + DEALLOCATE(T2) + DEALLOCATE(RESULT) + DEALLOCATE(TEMP) + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + DEALLOCATE(DEPTH) + ENDIF + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1).OR.(PERM.EQ.2))THEN + DEALLOCATE(M_TOTAL) + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_364 + RECURSIVE SUBROUTINE CMUMPS_462(TAB,DIM,TAB1,TAB2,PERM, + & RESULT,TEMP1,TEMP2) + IMPLICIT NONE + INTEGER DIM + INTEGER(8) TAB1(DIM),TAB2(DIM) + INTEGER(8) TEMP1(DIM),TEMP2(DIM) + INTEGER TAB(DIM), PERM,RESULT(DIM) + INTEGER I,J,I1,I2 + IF(DIM.EQ.1) THEN + RESULT(1)=TAB(1) + TEMP1(1)=TAB1(1) + TEMP2(1)=TAB2(1) + RETURN + ENDIF + I=DIM/2 + CALL CMUMPS_462(TAB(1),I,TAB1(1),TAB2(1),PERM, + & RESULT(1),TEMP1(1),TEMP2(1)) + CALL CMUMPS_462(TAB(I+1),DIM-I,TAB1(I+1),TAB2(I+1), + & PERM,RESULT(I+1),TEMP1(I+1),TEMP2(I+1)) + I1=1 + I2=I+1 + J=1 + DO WHILE ((I1.LE.I).AND.(I2.LE.DIM)) + IF((PERM.EQ.3))THEN + IF(TEMP1(I1).LE.TEMP1(I2))THEN + TAB(J)=RESULT(I1) + TAB1(J)=TEMP1(I1) + J=J+1 + I1=I1+1 + ELSE + TAB(J)=RESULT(I2) + TAB1(J)=TEMP1(I2) + J=J+1 + I2=I2+1 + ENDIF + GOTO 3 + ENDIF + IF((PERM.EQ.4).OR.(PERM.EQ.5))THEN + IF (TEMP1(I1).GE.TEMP1(I2))THEN + TAB(J)=RESULT(I1) + TAB1(J)=TEMP1(I1) + J=J+1 + I1=I1+1 + ELSE + TAB(J)=RESULT(I2) + TAB1(J)=TEMP1(I2) + J=J+1 + I2=I2+1 + ENDIF + GOTO 3 + ENDIF + IF((PERM.EQ.0).OR.(PERM.EQ.1).OR.(PERM.EQ.2)) THEN + IF(TEMP1(I1).GT.TEMP1(I2))THEN + TAB1(J)=TEMP1(I1) + TAB2(J)=TEMP2(I1) + TAB(J)=RESULT(I1) + J=J+1 + I1=I1+1 + GOTO 3 + ENDIF + IF(TEMP1(I1).LT.TEMP1(I2))THEN + TAB1(J)=TEMP1(I2) + TAB2(J)=TEMP2(I2) + TAB(J)=RESULT(I2) + J=J+1 + I2=I2+1 + GOTO 3 + ENDIF + IF((TEMP1(I1).EQ.TEMP1(I2)))THEN + IF(TEMP2(I1).LE.TEMP2(I2))THEN + TAB1(J)=TEMP1(I1) + TAB2(J)=TEMP2(I1) + TAB(J)=RESULT(I1) + J=J+1 + I1=I1+1 + ELSE + TAB1(J)=TEMP1(I2) + TAB2(J)=TEMP2(I2) + TAB(J)=RESULT(I2) + J=J+1 + I2=I2+1 + ENDIF + ENDIF + ENDIF + 3 CONTINUE + ENDDO + IF(I1.GT.I)THEN + DO WHILE(I2.LE.DIM) + TAB(J)=RESULT(I2) + TAB1(J)=TEMP1(I2) + TAB2(J)=TEMP2(I2) + J=J+1 + I2=I2+1 + ENDDO + ELSE + IF(I2.GT.DIM)THEN + DO WHILE(I1.LE.I) + TAB1(J)=TEMP1(I1) + TAB2(J)=TEMP2(I1) + TAB(J)=RESULT(I1) + J=J+1 + I1=I1+1 + ENDDO + ENDIF + ENDIF + DO I=1,DIM + TEMP1(I)=TAB1(I) + TEMP2(I)=TAB2(I) + RESULT(I)=TAB(I) + ENDDO + RETURN + END SUBROUTINE CMUMPS_462 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part5.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part5.F new file mode 100644 index 000000000..01bf2efd1 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part5.F @@ -0,0 +1,7690 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE CMUMPS_26(id) + USE CMUMPS_LOAD + USE MUMPS_STATIC_MAPPING + USE CMUMPS_STRUC_DEF + USE TOOLS_COMMON + USE CMUMPS_PARALLEL_ANALYSIS + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, MASTER + PARAMETER( MASTER = 0 ) + TYPE(CMUMPS_STRUC), TARGET :: id + INTEGER LIW, IKEEP, FILS, FRERE, PTRAR, NFSIZ + INTEGER NE, NA + INTEGER I, allocok + INTEGER MAXIS1_CHECK + INTEGER NB_NIV2, IDEST + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER LOCAL_M, LOCAL_N + INTEGER numroc + EXTERNAL numroc + INTEGER IRANK + INTEGER MP, LP, MPG + LOGICAL PROK, PROKG, LISTVAR_SCHUR_2BE_FREED + INTEGER SIZE_SCHUR_PASSED + INTEGER SBUF_SEND, SBUF_REC, TOTAL_MBYTES + INTEGER(8) SBUF_RECOLD8, MIN_BUF_SIZE8 + INTEGER MIN_BUF_SIZE + INTEGER(8) MAX_SIZE_FACTOR_TMP + INTEGER LEAF, INODE, ISTEP, INN, LPTRAR + INTEGER NBLEAF, NBROOT, MYROW_CHECK, INIV2 + INTEGER(8) K13TMP8, K14TMP8 + REAL PEAK + INTEGER, ALLOCATABLE, DIMENSION(:) :: PAR2_NODES + INTEGER, DIMENSION(:), ALLOCATABLE :: IWtemp + INTEGER, DIMENSION(:), ALLOCATABLE :: XNODEL, NODEL + INTEGER, DIMENSION(:), POINTER :: SSARBR + INTEGER, POINTER :: NELT, LELTVAR + INTEGER, DIMENSION(:), POINTER :: KEEP,INFO, INFOG + INTEGER(8), DIMENSION(:), POINTER :: KEEP8 + INTEGER(8) :: ENTRIES_IN_FACTORS_LOC_MASTERS + REAL, DIMENSION(:), POINTER :: RINFO + REAL, DIMENSION(:), POINTER :: RINFOG + INTEGER, DIMENSION(:), POINTER :: ICNTL + LOGICAL I_AM_SLAVE, PERLU_ON, COND + INTEGER :: OOC_STAT + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER K,J, IFS + INTEGER SIZE_TEMP_MEM,SIZE_DEPTH_FIRST,SIZE_COST_TRAV + LOGICAL IS_BUILD_LOAD_MEM_CALLED + DOUBLE PRECISION, DIMENSION (:,:), ALLOCATABLE :: TEMP_MEM + INTEGER, DIMENSION (:,:), ALLOCATABLE :: TEMP_ROOT + INTEGER, DIMENSION (:,:), ALLOCATABLE :: TEMP_LEAF + INTEGER, DIMENSION (:,:), ALLOCATABLE :: TEMP_SIZE + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH_FIRST + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH_FIRST_SEQ + INTEGER, DIMENSION (:), ALLOCATABLE :: SBTR_ID + REAL, DIMENSION (:), ALLOCATABLE :: COST_TRAV_TMP + INTEGER(8) :: TOTAL_BYTES + INTEGER, POINTER, DIMENSION(:) :: WORK1PTR, WORK2PTR, + & NFSIZPTR, + & FILSPTR, + & FREREPTR + IS_BUILD_LOAD_MEM_CALLED=.FALSE. + KEEP => id%KEEP + KEEP8 => id%KEEP8 + INFO => id%INFO + RINFO => id%RINFO + INFOG => id%INFOG + RINFOG => id%RINFOG + ICNTL => id%ICNTL + NELT => id%NELT + LELTVAR => id%LELTVAR + KEEP8(24) = 0_8 + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & id%KEEP(46) .eq. 1 ) ) + LP = ICNTL( 1 ) + MP = ICNTL( 2 ) + MPG = ICNTL( 3 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF (PROK) WRITE( MP, 220 ) + IF (PROKG.AND.(MPG .NE. MP)) WRITE( MPG, 220 ) id%VERSION_NUMBER + 220 FORMAT( /' CMUMPS ',A ) + IF ( PROK ) THEN + IF ( KEEP(50) .eq. 0 ) THEN + WRITE(MP, '(A)') 'L U Solver for unsymmetric matrices' + ELSE IF ( KEEP(50) .eq. 1 ) THEN + WRITE(MP, '(A)') + & 'L D L^T Solver for symmetric positive definite matrices' + ELSE + WRITE(MP, '(A)') + & 'L D L^T Solver for general symmetric matrices' + END IF + IF ( KEEP(46) .eq. 1 ) THEN + WRITE(MP, '(A)') 'Type of parallelism: Working host' + ELSE + WRITE(MP, '(A)') 'Type of parallelism: Host not working' + END IF + END IF + IF ( PROKG .AND. (MP.NE.MPG)) THEN + IF ( KEEP(50) .eq. 0 ) THEN + WRITE(MPG, '(A)') 'L U Solver for unsymmetric matrices' + ELSE IF ( KEEP(50) .eq. 1 ) THEN + WRITE(MPG, '(A)') + & 'L D L^T Solver for symmetric positive definite matrices' + ELSE + WRITE(MPG, '(A)') + & 'L D L^T Solver for general symmetric matrices' + END IF + IF ( KEEP(46) .eq. 1 ) THEN + WRITE(MPG, '(A)') 'Type of parallelism: Working host' + ELSE + WRITE(MPG, '(A)') 'Type of parallelism: Host not working' + END IF + END IF + IF (PROK) WRITE( MP, 110 ) + IF (PROKG .AND. (MPG.NE.MP)) WRITE( MPG, 110 ) + CALL CMUMPS_647(id) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + CALL MPI_BCAST( KEEP(60), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + IF (id%KEEP(60) .EQ. 2 .or. id%KEEP(60). EQ. 3) THEN + CALL MPI_BCAST( id%NPROW, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%NPCOL, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%MBLOCK, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%NBLOCK, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + CALL MPI_BCAST( KEEP(54), 2, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(69), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(201), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(244), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(251), 3, MPI_INTEGER,MASTER,id%COMM,IERR) + CALL MPI_BCAST( id%N, 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + IF ( KEEP(55) .EQ. 0) THEN + IF ( KEEP(54) .eq. 3 ) THEN + CALL MPI_ALLREDUCE( id%NZ_loc, id%NZ, 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR ) + ELSE + CALL MPI_BCAST( id%NZ, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + END IF + ELSE + CALL MPI_BCAST( id%NA_ELT, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + ENDIF + IF ( associated(id%MEM_DIST) ) deallocate( id%MEM_DIST ) + allocate( id%MEM_DIST( 0:id%NSLAVES-1 ), STAT=IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -7 + INFO(2) = id%NSLAVES + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'MEM_DIST' + END IF + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + id%MEM_DIST(0:id%NSLAVES-1) = 0 + CALL MUMPS_427( + & id%COMM,id%COMM_NODES,KEEP(69),KEEP(46), + & id%NSLAVES,id%MEM_DIST,INFO) + CALL CMUMPS_658(id) + IF (KEEP(244) .EQ. 1) THEN + IF ( KEEP(54) .eq. 3 ) THEN + CALL CMUMPS_664(id) + END IF + IF ( id%MYID .eq. MASTER ) THEN + 1234 CONTINUE + IF ( ( (KEEP(23) .NE. 0) .AND. + & ( (KEEP(23).NE.7) .OR. KEEP(50).EQ. 2 ) ) + & .OR. + & ( associated(id%A) .AND. KEEP(52) .EQ. 77 .AND. + & (KEEP(50).EQ.2)) + & .OR. + & KEEP(52) .EQ. -2 ) THEN + IF (.not.associated(id%A)) THEN + IF (KEEP(23).GT.2) KEEP(23) = 1 + ENDIF + CALL CMUMPS_203(id%N, id%NZ, KEEP(23), id%IS1(1), id, + & ICNTL(1), INFO(1)) + IF (INFO(1) .LT. 0) THEN + KEEP(23) = 0 + GOTO 10 + END IF + END IF + IF (KEEP(55) .EQ. 0) THEN + IF ( KEEP(256) .EQ. 1 ) THEN + LIW = 2 * id%NZ + 3 * id%N + 2 + ELSE + LIW = 2 * id%NZ + 3 * id%N + 2 + ENDIF + IF (LIW.LT.3*id%N) LIW = 3*id%N + ELSE +#if defined(metis) || defined(parmetis) + COND = (KEEP(60) .NE. 0) .OR. (KEEP(256) .EQ. 5) +#else + COND = (KEEP(60) .NE. 0) +#endif + IF( COND ) THEN + LIW = id%N + id%N + 1 + ELSE + LIW = id%N + id%N + id%N+3 + id%N+1 + ENDIF + ENDIF + IF (LIW.LT.3*id%N) LIW = 3*id%N + IF (KEEP(23) .NE. 0) THEN + IKEEP = id%N + 1 + ELSE + IKEEP = 1 + END IF + NA = IKEEP + id%N + NE = IKEEP + 2 * id%N + FILS = IKEEP + 3 * id%N + FRERE = FILS + id%N + PTRAR = FRERE + id%N + IF (KEEP(55) .EQ. 0) THEN + NFSIZ = PTRAR + 4 * id%N + MAXIS1_CHECK = NFSIZ + id%N - 1 + ELSE + NFSIZ = PTRAR + 2 * (NELT + 1) + MAXIS1_CHECK = NFSIZ + id%N -1 + ENDIF + IF ( id%MAXIS1 .LT. MAXIS1_CHECK ) THEN + IF (LP.GE.0) THEN + WRITE(LP,*) '***********************************' + WRITE(LP,*) 'MAXIS1 and MAXIS1_CHECK are different !!' + WRITE(LP,*) 'MAXIS1, MAXIS1_CHECK=',id%MAXIS1, + & MAXIS1_CHECK + WRITE(LP,*) 'This might cause problems ...' + WRITE(LP,*) '***********************************' + ENDIF + END IF + IF ( KEEP(256) .EQ. 1 ) THEN + DO I = 1, id%N + id%IS1( IKEEP + I - 1 ) = id%PERM_IN( I ) + END DO + END IF + INFOG(1) = 0 + INFOG(2) = 0 + INFOG(8) = -1 + IF ( .NOT. associated( id%LISTVAR_SCHUR ) ) THEN + SIZE_SCHUR_PASSED = 1 + LISTVAR_SCHUR_2BE_FREED=.TRUE. + allocate( id%LISTVAR_SCHUR( 1 ), STAT=allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) + & 'PB allocating an array of size 1 in Schur ' + CALL MUMPS_ABORT() + END IF + ELSE + SIZE_SCHUR_PASSED=id%SIZE_SCHUR + LISTVAR_SCHUR_2BE_FREED = .FALSE. + END IF + IF (KEEP(55) .EQ. 0) THEN + CALL CMUMPS_195(id%N, id%NZ, id%IRN(1), id%JCN(1), + & LIW, id%IS1(IKEEP), + & id%IS1(PTRAR), KEEP(256), id%IS1(NFSIZ), + & id%IS1(FILS), id%IS1(FRERE), + & id%LISTVAR_SCHUR(1), SIZE_SCHUR_PASSED, + & ICNTL(1), INFOG(1), KEEP(1),KEEP8(1),id%NSLAVES, + & id%IS1(1),id) + IF ( (KEEP(23).LE.-1).AND.(KEEP(23).GE.-6) ) THEN + KEEP(23) = -KEEP(23) + IF (.NOT. associated(id%A)) KEEP(23) = 1 + GOTO 1234 + ENDIF + INFOG(7) = KEEP(256) + ELSE + allocate( IWtemp ( 3*id%N ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = 3*id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'IWtemp' + END IF + GOTO 10 + ENDIF + allocate( XNODEL ( id%N+1 ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = id%N + 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'XNODEL' + END IF + GOTO 10 + ENDIF + IF (LELTVAR.ne.id%ELTPTR(NELT+1)-1) THEN + INFO(1) = -2002 + INFO(2) = id%ELTPTR(NELT+1)-1 + GOTO 10 + ENDIF + allocate( NODEL ( LELTVAR ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = LELTVAR + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'NODEL' + END IF + GOTO 10 + ENDIF + CALL CMUMPS_128(id%N, NELT, + & id%ELTPTR(1), id%ELTVAR(1), LIW, + & id%IS1(IKEEP), + & IWtemp(1), KEEP(256), id%IS1(NFSIZ), id%IS1(FILS), + & id%IS1(FRERE), id%LISTVAR_SCHUR(1), + & SIZE_SCHUR_PASSED, + & ICNTL(1), INFOG(1), KEEP(1),KEEP8(1), + & id%ELTPROC(1), id%NSLAVES, + & XNODEL(1), NODEL(1)) + DEALLOCATE(IWtemp) + INFOG(7)=KEEP(256) + ENDIF + IF ( LISTVAR_SCHUR_2BE_FREED ) THEN + deallocate( id%LISTVAR_SCHUR ) + NULLIFY ( id%LISTVAR_SCHUR ) + ENDIF + INFO(1)=INFOG(1) + INFO(2)=INFOG(2) + KEEP(28) = INFOG(6) + IF ( INFO(1) .LT. 0 ) THEN + GO TO 10 + ENDIF + ENDIF + ELSE + IKEEP = 1 + NA = IKEEP + id%N + NE = IKEEP + 2 * id%N + FILS = IKEEP + 3 * id%N + FRERE = FILS + id%N + PTRAR = FRERE + id%N + NFSIZ = PTRAR + 4 * id%N + IF(id%MYID .EQ. MASTER) THEN + WORK1PTR => id%IS1(IKEEP : IKEEP + 3*id%N-1) + WORK2PTR => id%IS1(PTRAR : PTRAR + 4*id%N-1) + NFSIZPTR => id%IS1(NFSIZ : NFSIZ + id%N-1) + FILSPTR => id%IS1(FILS : FILS + id%N-1) + FREREPTR => id%IS1(FRERE : FRERE + id%N-1) + ELSE + ALLOCATE(WORK1PTR(3*id%N)) + ALLOCATE(WORK2PTR(4*id%N)) + END IF + CALL CMUMPS_715(id, + & WORK1PTR, + & WORK2PTR, + & NFSIZPTR, + & FILSPTR, + & FREREPTR) + IF(id%MYID .EQ. 0) THEN + NULLIFY(WORK1PTR, WORK2PTR, NFSIZPTR) + NULLIFY(FILSPTR, FREREPTR) + ELSE + DEALLOCATE(WORK1PTR, WORK2PTR) + END IF + KEEP(28) = INFOG(6) + END IF + 10 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + IF(id%MYID .EQ. MASTER) THEN + CALL MUMPS_633(KEEP(12),ICNTL(14), + & KEEP(50),KEEP(54),ICNTL(6),KEEP(52)) + CALL CMUMPS_348(id%N, id%IS1(FILS), id%IS1(FRERE), + & id%IS1(IKEEP+2*id%N), id%IS1(IKEEP+id%N)) + IF (id%NSLAVES .EQ. 1) THEN + id%NBSA = 0 + IF ( (id%KEEP(60).EQ.0). + & AND.(id%KEEP(53).EQ.0)) THEN + id%KEEP(20)=0 + id%KEEP(38)=0 + ENDIF + id%KEEP(56)=0 + id%PROCNODE = 0 + IF (id%KEEP(60) .EQ. 2 .OR. id%KEEP(60).EQ.3) THEN + CALL CMUMPS_564(id%KEEP(38), id%PROCNODE(1), + & 1+2*id%NSLAVES, id%IS1(FILS),id%N) + ENDIF + ELSE + PEAK = real(id%INFOG(5))*real(id%INFOG(5)) + + & real(id%KEEP(2))*real(id%KEEP(2)) + SSARBR => id%IS1(IKEEP:IKEEP+id%N-1) + CALL CMUMPS_537(id%N,id%NSLAVES,ICNTL(1), + & INFOG(1), + & id%IS1(NE), + & id%IS1(NFSIZ), + & id%IS1(FRERE), + & id%IS1(FILS), + & KEEP(1),KEEP8(1),id%PROCNODE(1), + & SSARBR(1),id%NBSA,PEAK,IERR + & ) + NULLIFY(SSARBR) + if(IERR.eq.-999) then + write(6,*) ' Internal error in MUMPS_369' + INFO(1) = IERR + GOTO 11 + ENDIF + IF(IERR.NE.0) THEN + INFO(1) = -135 + INFO(2) = IERR + GOTO 11 + ENDIF + CALL CMUMPS_348(id%N, id%IS1(FILS), + & id%IS1(FRERE), id%IS1(IKEEP+2*id%N), + & id%IS1(IKEEP+id%N)) + ENDIF + 11 CONTINUE + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + CALL MPI_BCAST( id%NELT, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + IF (KEEP(55) .EQ. 0) THEN + if (associated(id%FRTPTR)) DEALLOCATE(id%FRTPTR) + if (associated(id%FRTELT)) DEALLOCATE(id%FRTELT) + allocate( id%FRTPTR(1), id%FRTELT(1) ) + ELSE + LPTRAR = id%NELT+id%NELT+2 + CALL MUMPS_733(id%PTRAR, LPTRAR, id%INFO, LP, + & FORCE=.TRUE., STRING='id%PTRAR (Analysis)', ERRCODE=-7) + CALL MUMPS_733(id%FRTPTR, id%N+1, id%INFO, LP, + & FORCE=.TRUE., STRING='id%FRTPTR (Analysis)', ERRCODE=-7) + CALL MUMPS_733(id%FRTELT, id%NELT, id%INFO, LP, + & FORCE=.TRUE., STRING='id%FRTELT (Analysis)', ERRCODE=-7) + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + IF(id%MYID .EQ. MASTER) THEN + CALL CMUMPS_153( + & id%N, NELT, id%ELTPTR(NELT+1)-1, id%IS1(FRERE), + & id%IS1(FILS), + & id%IS1(IKEEP+id%N), id%IS1(IKEEP+2*id%N), XNODEL, + & NODEL, id%FRTPTR(1), id%FRTELT(1), id%ELTPROC(1)) + DO I=1, id%NELT+1 + id%PTRAR(id%NELT+I+1)=id%ELTPTR(I) + ENDDO + deallocate(XNODEL) + deallocate(NODEL) + END IF + CALL MPI_BCAST( id%PTRAR(id%NELT+2), id%NELT+1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%FRTPTR(1), id%N+1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%FRTELT(1), id%NELT, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + ENDIF + IF(id%MYID .EQ. MASTER) THEN + IF ( INFO( 1 ) .LT. 0 ) GOTO 12 + IF ( KEEP(55) .ne. 0 ) THEN + CALL CMUMPS_120(id%N, NELT, id%ELTPROC(1),id%NSLAVES, + & id%PROCNODE(1)) + END IF + NB_NIV2 = KEEP(56) + IF ( NB_NIV2.GT.0 ) THEN + allocate(PAR2_NODES(NB_NIV2), + & STAT=allocok) + IF (allocok .GT.0) then + INFO(1)= -7 + INFO(2)= NB_NIV2 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'PAR2_NODES' + END IF + GOTO 12 + END IF + ENDIF + IF ((NB_NIV2.GT.0) .AND. (KEEP(24).EQ.0)) THEN + INIV2 = 0 + DO 777 INODE = 1, id%N + IF ( ( id%IS1(FRERE+INODE-1) .NE. id%N+1 ) .AND. + & ( MUMPS_330(id%PROCNODE(INODE),id%NSLAVES) + & .eq. 2) ) THEN + INIV2 = INIV2 + 1 + PAR2_NODES(INIV2) = INODE + END IF + 777 CONTINUE + IF ( INIV2 .NE. NB_NIV2 ) THEN + WRITE(*,*) "Internal Error 2 in CMUMPS_26", + & INIV2, NB_NIV2 + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF ( (KEEP(24) .NE. 0) .AND. (NB_NIV2.GT.0) ) THEN + IF ( associated(id%CANDIDATES)) deallocate(id%CANDIDATES) + allocate( id%CANDIDATES(id%NSLAVES+1,NB_NIV2), + & stat=allocok) + if (allocok .gt.0) then + INFO(1)= -7 + INFO(2)= NB_NIV2*(id%NSLAVES+1) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'CANDIDATES' + END IF + GOTO 12 + END IF + CALL MUMPS_393 + & (PAR2_NODES,id%CANDIDATES,IERR) + IF(IERR.NE.0) THEN + INFO(1) = -2002 + GOTO 12 + ENDIF + CALL MUMPS_494() + IF(IERR.NE.0) THEN + INFO(1) = -2002 + GOTO 12 + ENDIF + ELSE + IF (associated(id%CANDIDATES)) DEALLOCATE(id%CANDIDATES) + allocate(id%CANDIDATES(1,1), stat=allocok) + IF (allocok .NE. 0) THEN + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'CANDIDATES' + END IF + GOTO 12 + ENDIF + ENDIF + 12 CONTINUE + KEEP(84) = ICNTL(27) + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + CALL MPI_BCAST( id%KEEP(1), 110, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MUMPS_749( id%KEEP8(21), MASTER, + & id%MYID, id%COMM, IERR) + CALL MPI_BCAST( id%KEEP(205), 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MPI_BCAST( id%NBSA, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + IF (id%MYID==MASTER) KEEP(127)=INFOG(5) + CALL MPI_BCAST( id%KEEP(127), 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MPI_BCAST( id%KEEP(226), 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MUMPS_733(id%STEP, id%N, id%INFO, LP, FORCE=.TRUE., + & STRING='id%STEP (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%PROCNODE_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%PROCNODE_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%NE_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%NE_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%ND_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%ND_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%FRERE_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%FRERE_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%DAD_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%DAD_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%FILS, id%N, id%INFO, LP, FORCE=.TRUE., + & STRING='id%FILS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%SYM_PERM, id%N, id%INFO, LP, FORCE=.TRUE., + & STRING='id%SYM_PERM (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + IF (KEEP(55) .EQ. 0) THEN + LPTRAR = id%N+id%N + CALL MUMPS_733(id%PTRAR, LPTRAR, id%INFO, LP, FORCE=.TRUE., + & STRING='id%PTRAR (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + ENDIF + IF ( associated( id%UNS_PERM ) ) deallocate(id%UNS_PERM) + IF ( id%MYID == MASTER .AND. id%KEEP(23) .NE. 0 ) THEN + allocate(id%UNS_PERM(id%N),stat=allocok) + IF ( allocok .ne. 0) THEN + INFO(1) = -7 + INFO(2) = id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%UNS_PERM' + END IF + GOTO 94 + ENDIF + DO I=1,id%N + id%UNS_PERM(I) = id%IS1(I) + END DO + ENDIF + 94 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( id%MYID .EQ. MASTER ) THEN + DO I=1,id%N + id%FILS(I) = id%IS1(FILS+I-1) + ENDDO + END IF + IF (id%MYID .EQ. MASTER ) THEN + IF (id%N.eq.1) THEN + NBROOT = 1 + NBLEAF = 1 + ELSE IF (id%IS1(NA+id%N-1) .LT.0) THEN + NBLEAF = id%N + NBROOT = id%N + ELSE IF (id%IS1(NA+id%N-2) .LT.0) THEN + NBLEAF = id%N-1 + NBROOT = id%IS1(NA+id%N-1) + ELSE + NBLEAF = id%IS1(NA+id%N-2) + NBROOT = id%IS1(NA+id%N-1) + ENDIF + id%LNA = 2+NBLEAF+NBROOT + ENDIF + CALL MPI_BCAST( id%LNA, 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MUMPS_733(id%NA, id%LNA, id%INFO, LP, FORCE=.TRUE., + & STRING='id%NA (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 96 + IF (id%MYID .EQ.MASTER ) THEN + id%NA(1) = NBLEAF + id%NA(2) = NBROOT + LEAF = 3 + IF ( id%N == 1 ) THEN + id%NA(LEAF) = 1 + LEAF = LEAF + 1 + ELSE IF (id%IS1(NA+id%N-1) < 0) THEN + id%NA(LEAF) = - id%IS1(NA+id%N-1)-1 + LEAF = LEAF + 1 + DO I = 1, NBLEAF - 1 + id%NA(LEAF) = id%IS1(NA+I-1) + LEAF = LEAF + 1 + ENDDO + ELSE IF (id%IS1(NA+id%N-2) < 0 ) THEN + INODE = - id%IS1(NA+id%N-2) - 1 + id%NA(LEAF) = INODE + LEAF =LEAF + 1 + IF ( NBLEAF > 1 ) THEN + DO I = 1, NBLEAF - 1 + id%NA(LEAF) = id%IS1(NA+I-1) + LEAF = LEAF + 1 + ENDDO + ENDIF + ELSE + DO I = 1, NBLEAF + id%NA(LEAF) = id%IS1(NA+I-1) + LEAF = LEAF + 1 + ENDDO + END IF + END IF + 96 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF (associated(id%Step2node)) THEN + DEALLOCATE(id%Step2node) + NULLIFY(id%Step2node) + ENDIF + IF ( id%MYID .EQ. MASTER ) THEN + ISTEP = 0 + DO I = 1, id%N + IF ( id%IS1(FRERE+I-1) .ne. id%N + 1 ) THEN + ISTEP = ISTEP + 1 + id%STEP(I)=ISTEP + INN = id%IS1(FILS+I-1) + DO WHILE ( INN .GT. 0 ) + id%STEP(INN) = - ISTEP + INN = id%IS1(FILS + INN -1) + END DO + IF (id%IS1(FRERE+I-1) .eq. 0) THEN + id%NA(LEAF) = I + LEAF = LEAF + 1 + ENDIF + ENDIF + END DO + IF ( LEAF - 1 .NE. 2+NBROOT + NBLEAF ) THEN + WRITE(*,*) 'Internal error 2 in CMUMPS_26' + CALL MUMPS_ABORT() + ENDIF + IF ( ISTEP .NE. id%KEEP(28) ) THEN + write(*,*) 'Internal error 3 in CMUMPS_26' + CALL MUMPS_ABORT() + ENDIF + DO I = 1, id%N + IF (id%IS1(FRERE+I-1) .NE. id%N+1) THEN + id%PROCNODE_STEPS(id%STEP(I)) = id%PROCNODE( I ) + id%FRERE_STEPS(id%STEP(I)) = id%IS1(FRERE+I-1) + id%NE_STEPS(id%STEP(I)) = id%IS1(NE+I-1) + id%ND_STEPS(id%STEP(I)) = id%IS1(NFSIZ+I-1) + ENDIF + ENDDO + DO I = 1, id%N + IF ( id%STEP(I) .LE. 0) CYCLE + IF (id%IS1(FRERE+I-1) .eq. 0) THEN + id%DAD_STEPS(id%STEP(I)) = 0 + ENDIF + IFS = id%IS1(FILS+I-1) + DO WHILE ( IFS .GT. 0 ) + IFS= id%IS1(FILS + IFS -1) + END DO + IFS = -IFS + DO WHILE (IFS.GT.0) + id%DAD_STEPS(id%STEP(IFS)) = I + IFS = id%IS1(FRERE+IFS-1) + ENDDO + END DO + deallocate(id%PROCNODE) + NULLIFY(id%PROCNODE) + deallocate(id%IS1) + NULLIFY(id%IS1) + CALL CMUMPS_363(id%N, id%FRERE_STEPS(1), + & id%STEP(1),id%FILS(1), id%NA(1), id%LNA, + & id%NE_STEPS(1), id%ND_STEPS(1), id%DAD_STEPS(1), + & id%KEEP(28), .TRUE., id%KEEP(28), id%KEEP(70), + & id%KEEP(50), id%INFO(1), id%ICNTL(1),id%KEEP(215), + & id%KEEP(234), id%KEEP(55), + & id%PROCNODE_STEPS(1),id%NSLAVES,PEAK,id%KEEP(90) + & ) + IF ((id%KEEP(76).GE.4).OR.(id%KEEP(76).GE.6).OR. + & (id%KEEP(47).EQ.4).OR.((id%KEEP(81).GT.0) + & .AND.(id%KEEP(47).GE.2)))THEN + IS_BUILD_LOAD_MEM_CALLED=.TRUE. + IF ((id%KEEP(47) .EQ. 4).OR. + & (( id%KEEP(81) .GT. 0).AND.(id%KEEP(47).GE.2))) THEN + IF(id%NSLAVES.GT.1) THEN + SIZE_TEMP_MEM = id%NBSA + ELSE + SIZE_TEMP_MEM = id%NA(2) + ENDIF + ELSE + SIZE_TEMP_MEM = 1 + ENDIF + IF((id%KEEP(76).EQ.4).OR.(id%KEEP(76).EQ.6))THEN + SIZE_DEPTH_FIRST=id%KEEP(28) + ELSE + SIZE_DEPTH_FIRST=1 + ENDIF + allocate(TEMP_MEM(SIZE_TEMP_MEM,id%NSLAVES),STAT=allocok) + IF (allocok .NE.0) THEN + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_MEM' + END IF + GOTO 80 + END IF + allocate(TEMP_LEAF(SIZE_TEMP_MEM,id%NSLAVES), + & stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_LEAF' + END IF + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + GOTO 80 + end if + allocate(TEMP_SIZE(SIZE_TEMP_MEM,id%NSLAVES), + & stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_SIZE' + END IF + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + GOTO 80 + end if + allocate(TEMP_ROOT(SIZE_TEMP_MEM,id%NSLAVES), + & stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_ROOT' + END IF + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + GOTO 80 + end if + allocate(DEPTH_FIRST(SIZE_DEPTH_FIRST),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'DEPTH_FIRST' + END IF + INFO(1)= -7 + INFO(2)= SIZE_DEPTH_FIRST + GOTO 80 + end if + ALLOCATE(DEPTH_FIRST_SEQ(SIZE_DEPTH_FIRST),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'DEPTH_FIRST_SEQ' + END IF + INFO(1)= -7 + INFO(2)= SIZE_DEPTH_FIRST + GOTO 80 + end if + ALLOCATE(SBTR_ID(SIZE_DEPTH_FIRST),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'SBTR_ID' + END IF + INFO(1)= -7 + INFO(2)= SIZE_DEPTH_FIRST + GOTO 80 + end if + IF(id%KEEP(76).EQ.5)THEN + SIZE_COST_TRAV=id%KEEP(28) + ELSE + SIZE_COST_TRAV=1 + ENDIF + allocate(COST_TRAV_TMP(SIZE_COST_TRAV),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'COST_TRAV_TMP' + END IF + INFO(1)= -7 + INFO(2)= SIZE_COST_TRAV + GOTO 80 + END IF + IF(id%KEEP(76).EQ.5)THEN + IF(id%KEEP(70).EQ.0)THEN + id%KEEP(70)=5 + ENDIF + IF(id%KEEP(70).EQ.1)THEN + id%KEEP(70)=6 + ENDIF + ENDIF + IF(id%KEEP(76).EQ.4)THEN + IF(id%KEEP(70).EQ.0)THEN + id%KEEP(70)=3 + ENDIF + IF(id%KEEP(70).EQ.1)THEN + id%KEEP(70)=4 + ENDIF + ENDIF + CALL CMUMPS_364(id%N, id%FRERE_STEPS(1), + & id%STEP(1),id%FILS(1), id%NA(1), id%LNA, + & id%NE_STEPS(1), id%ND_STEPS(1), id%DAD_STEPS(1), + & id%KEEP(28), .TRUE., id%KEEP(28), id%KEEP(70), + & id%KEEP(50), id%INFO(1), id%ICNTL(1),id%KEEP(47), + & id%KEEP(81),id%KEEP(76),id%KEEP(215), + & id%KEEP(234), id%KEEP(55), + & id%PROCNODE_STEPS(1),TEMP_MEM,id%NSLAVES, + & SIZE_TEMP_MEM, PEAK,id%KEEP(90),SIZE_DEPTH_FIRST, + & SIZE_COST_TRAV,DEPTH_FIRST(1),DEPTH_FIRST_SEQ(1), + & COST_TRAV_TMP(1), + & TEMP_LEAF,TEMP_SIZE,TEMP_ROOT,SBTR_ID(1) + & ) + END IF + CALL CMUMPS_181(id%N, id%NA(1), id%LNA, + & id%NE_STEPS(1), id%SYM_PERM(1), + & id%FILS(1), id%DAD_STEPS(1), + & id%STEP(1), id%KEEP(28), id%INFO(1) ) + ENDIF + 80 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + CALL MPI_BCAST( id%FILS(1), id%N, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%NA(1), id%LNA, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%STEP(1), id%N, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%PROCNODE_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%DAD_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%FRERE_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR) + CALL MPI_BCAST( id%NE_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%ND_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%SYM_PERM(1), id%N, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (KEEP(55) .EQ. 0) THEN + CALL CMUMPS_746(id, id%PTRAR(1)) + IF(id%MYID .EQ. MASTER) THEN + IF ( (KEEP(244) .EQ. 1) .AND. (KEEP(54) .EQ. 3) ) THEN + DEALLOCATE( id%IRN ) + DEALLOCATE( id%JCN ) + END IF + END IF + ENDIF + IF((id%KEEP(76).EQ.4).OR.(id%KEEP(76).EQ.6))THEN + IF(associated(id%DEPTH_FIRST)) + & deallocate(id%DEPTH_FIRST) + allocate(id%DEPTH_FIRST(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= id%KEEP(28) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST' + END IF + GOTO 87 + END IF + IF(associated(id%DEPTH_FIRST_SEQ)) + * DEALLOCATE(id%DEPTH_FIRST_SEQ) + ALLOCATE(id%DEPTH_FIRST_SEQ(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= id%KEEP(28) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + IF(associated(id%SBTR_ID)) + * DEALLOCATE(id%SBTR_ID) + ALLOCATE(id%SBTR_ID(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= id%KEEP(28) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + IF(id%MYID.EQ.MASTER)THEN + id%DEPTH_FIRST(1:id%KEEP(28))=DEPTH_FIRST(1:id%KEEP(28)) + id%DEPTH_FIRST_SEQ(1:id%KEEP(28))= + & DEPTH_FIRST_SEQ(1:id%KEEP(28)) + id%SBTR_ID(1:KEEP(28))=SBTR_ID(1:KEEP(28)) + ENDIF + CALL MPI_BCAST( id%DEPTH_FIRST(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%DEPTH_FIRST_SEQ(1), id%KEEP(28), + & MPI_INTEGER,MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%SBTR_ID(1), id%KEEP(28), + & MPI_INTEGER,MASTER, id%COMM, IERR ) + ELSE + IF(associated(id%DEPTH_FIRST)) + & deallocate(id%DEPTH_FIRST) + allocate(id%DEPTH_FIRST(1),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST' + END IF + GOTO 87 + END IF + IF(associated(id%DEPTH_FIRST_SEQ)) + * DEALLOCATE(id%DEPTH_FIRST_SEQ) + ALLOCATE(id%DEPTH_FIRST_SEQ(1),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + IF(associated(id%SBTR_ID)) + * DEALLOCATE(id%SBTR_ID) + ALLOCATE(id%SBTR_ID(1),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + id%SBTR_ID(1)=0 + id%DEPTH_FIRST(1)=0 + id%DEPTH_FIRST_SEQ(1)=0 + ENDIF + IF(id%KEEP(76).EQ.5)THEN + IF(associated(id%COST_TRAV)) + & deallocate(id%COST_TRAV) + allocate(id%COST_TRAV(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%COST_TRAV' + END IF + INFO(1)= -7 + INFO(2)= id%KEEP(28) + GOTO 87 + END IF + IF(id%MYID.EQ.MASTER)THEN + id%COST_TRAV(1:id%KEEP(28))= + & dble(COST_TRAV_TMP(1:id%KEEP(28))) + ENDIF + CALL MPI_BCAST( id%COST_TRAV(1), id%KEEP(28), + & MPI_DOUBLE_PRECISION,MASTER, id%COMM, IERR ) + ELSE + IF(associated(id%COST_TRAV)) + & deallocate(id%COST_TRAV) + allocate(id%COST_TRAV(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%COST_TRAV(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + id%COST_TRAV(1)=0.0d0 + ENDIF + IF (id%KEEP(47) .EQ. 4 .OR. + & ((id%KEEP(81) .GT. 0).AND.(id%KEEP(47).GE.2))) THEN + IF(id%MYID .EQ. MASTER)THEN + DO K=1,id%NSLAVES + DO J=1,SIZE_TEMP_MEM + IF(TEMP_MEM(J,K) < 0.0D0) GOTO 666 + ENDDO + 666 CONTINUE + J=J-1 + IF (id%KEEP(46) == 1) THEN + IDEST = K - 1 + ELSE + IDEST = K + ENDIF + IF (IDEST .NE. MASTER) THEN + CALL MPI_SEND(J,1,MPI_INTEGER,IDEST,0, + & id%COMM,IERR) + CALL MPI_SEND(TEMP_MEM(1,K),J,MPI_DOUBLE_PRECISION, + & IDEST, 0, id%COMM,IERR) + CALL MPI_SEND(TEMP_LEAF(1,K),J,MPI_INTEGER, + & IDEST, 0, id%COMM,IERR) + CALL MPI_SEND(TEMP_SIZE(1,K),J,MPI_INTEGER, + & IDEST, 0, id%COMM,IERR) + CALL MPI_SEND(TEMP_ROOT(1,K),J,MPI_INTEGER, + & IDEST, 0, id%COMM,IERR) + ELSE + IF(associated(id%MEM_SUBTREE)) + & deallocate(id%MEM_SUBTREE) + allocate(id%MEM_SUBTREE(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MEM_SUBTREE' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%NBSA_LOCAL = J + id%MEM_SUBTREE(1:J)=TEMP_MEM(1:J,1) + IF(associated(id%MY_ROOT_SBTR)) + & deallocate(id%MY_ROOT_SBTR) + allocate(id%MY_ROOT_SBTR(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_ROOT_SBTR' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%MY_ROOT_SBTR(1:J)=TEMP_ROOT(1:J,1) + IF(associated(id%MY_FIRST_LEAF)) + & deallocate(id%MY_FIRST_LEAF) + allocate(id%MY_FIRST_LEAF(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_FIRST_LEAF' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%MY_FIRST_LEAF(1:J)=TEMP_LEAF(1:J,1) + IF(associated(id%MY_NB_LEAF)) + & deallocate(id%MY_NB_LEAF) + allocate(id%MY_NB_LEAF(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_NB_LEAF' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%MY_NB_LEAF(1:J)=TEMP_SIZE(1:J,1) + ENDIF + ENDDO + ELSE + CALL MPI_RECV(id%NBSA_LOCAL,1,MPI_INTEGER, + & MASTER,0,id%COMM,STATUS, IERR) + IF(associated(id%MEM_SUBTREE)) + & deallocate(id%MEM_SUBTREE) + allocate(id%MEM_SUBTREE(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MEM_SUBTREE' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + IF(associated(id%MY_ROOT_SBTR)) + & deallocate(id%MY_ROOT_SBTR) + allocate(id%MY_ROOT_SBTR(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_ROOT_SBTR' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + IF(associated(id%MY_FIRST_LEAF)) + & deallocate(id%MY_FIRST_LEAF) + allocate(id%MY_FIRST_LEAF(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'MY_FIRST_LEAF' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + IF(associated(id%MY_NB_LEAF)) + & deallocate(id%MY_NB_LEAF) + allocate(id%MY_NB_LEAF(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'MY_NB_LEAF' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + CALL MPI_RECV(id%MEM_SUBTREE(1),id%NBSA_LOCAL, + & MPI_DOUBLE_PRECISION,MASTER,0, + & id%COMM,STATUS,IERR) + CALL MPI_RECV(id%MY_FIRST_LEAF(1),id%NBSA_LOCAL, + & MPI_INTEGER,MASTER,0, + & id%COMM,STATUS,IERR) + CALL MPI_RECV(id%MY_NB_LEAF(1),id%NBSA_LOCAL, + & MPI_INTEGER,MASTER,0, + & id%COMM,STATUS,IERR) + CALL MPI_RECV(id%MY_ROOT_SBTR(1),id%NBSA_LOCAL, + & MPI_INTEGER,MASTER,0, + & id%COMM,STATUS,IERR) + ENDIF + ELSE + id%NBSA_LOCAL = -999999 + IF(associated(id%MEM_SUBTREE)) + & deallocate(id%MEM_SUBTREE) + allocate(id%MEM_SUBTREE(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MEM_SUBTREE(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + IF(associated(id%MY_ROOT_SBTR)) + & deallocate(id%MY_ROOT_SBTR) + allocate(id%MY_ROOT_SBTR(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_ROOT_SBTR(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + IF(associated(id%MY_FIRST_LEAF)) + & deallocate(id%MY_FIRST_LEAF) + allocate(id%MY_FIRST_LEAF(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_FIRST_LEAF(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + IF(associated(id%MY_NB_LEAF)) + & deallocate(id%MY_NB_LEAF) + allocate(id%MY_NB_LEAF(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_NB_LEAF(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + ENDIF + IF(id%MYID.EQ.MASTER)THEN + IF(IS_BUILD_LOAD_MEM_CALLED)THEN + deallocate(TEMP_MEM) + deallocate(TEMP_SIZE) + deallocate(TEMP_ROOT) + deallocate(TEMP_LEAF) + deallocate(COST_TRAV_TMP) + deallocate(DEPTH_FIRST) + deallocate(DEPTH_FIRST_SEQ) + deallocate(SBTR_ID) + ENDIF + ENDIF + 87 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + NB_NIV2 = KEEP(56) + IF ( NB_NIV2.GT.0 ) THEN + if (id%MYID.ne.MASTER) then + IF (associated(id%CANDIDATES)) deallocate(id%CANDIDATES) + allocate(PAR2_NODES(NB_NIV2), + & id%CANDIDATES(id%NSLAVES+1,NB_NIV2), + & STAT=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= NB_NIV2*(id%NSLAVES+1) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'PAR2_NODES/id%CANDIDATES' + END IF + end if + end if + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + CALL MPI_BCAST(PAR2_NODES(1),NB_NIV2, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + IF (KEEP(24) .NE.0 ) THEN + CALL MPI_BCAST(id%CANDIDATES(1,1), + & (NB_NIV2*(id%NSLAVES+1)), + & MPI_INTEGER, MASTER, id%COMM, IERR ) + ENDIF + ENDIF + IF ( associated(id%ISTEP_TO_INIV2)) THEN + deallocate(id%ISTEP_TO_INIV2) + NULLIFY(id%ISTEP_TO_INIV2) + ENDIF + IF ( associated(id%I_AM_CAND)) THEN + deallocate(id%I_AM_CAND) + NULLIFY(id%I_AM_CAND) + ENDIF + IF (NB_NIV2.EQ.0) THEN + id%KEEP(71) = 1 + ELSE + id%KEEP(71) = id%KEEP(28) + ENDIF + allocate(id%ISTEP_TO_INIV2(id%KEEP(71)), + & id%I_AM_CAND(max(NB_NIV2,1)), + & stat=allocok) + IF (allocok .gt.0) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%ISTEP_TO_INIV2' + WRITE(LP, 150) 'id%TAB_POS_IN_PERE' + END IF + INFO(1)= -7 + IF (NB_NIV2.EQ.0) THEN + INFO(2)= 2 + ELSE + INFO(2)= id%KEEP(28)+NB_NIV2*(id%NSLAVES+2) + END IF + GOTO 321 + ENDIF + IF ( NB_NIV2 .GT.0 ) THEN + DO INIV2 = 1, NB_NIV2 + INN = PAR2_NODES(INIV2) + id%ISTEP_TO_INIV2(id%STEP(INN)) = INIV2 + END DO + CALL CMUMPS_649( id%NSLAVES, + & NB_NIV2, id%MYID_NODES, + & id%CANDIDATES(1,1), id%I_AM_CAND(1) ) + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (associated(id%FUTURE_NIV2)) THEN + deallocate(id%FUTURE_NIV2) + NULLIFY(id%FUTURE_NIV2) + ENDIF + allocate(id%FUTURE_NIV2(id%NSLAVES), stat=allocok) + IF (allocok .gt.0) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'FUTURE_NIV2' + END IF + INFO(1)= -7 + INFO(2)= id%NSLAVES + GOTO 321 + ENDIF + id%FUTURE_NIV2=0 + DO INIV2 = 1, NB_NIV2 + IDEST = MUMPS_275( + & id%PROCNODE_STEPS(id%STEP(PAR2_NODES(INIV2))), + & id%NSLAVES) + id%FUTURE_NIV2(IDEST+1)=id%FUTURE_NIV2(IDEST+1)+1 + ENDDO +#endif + IF ( I_AM_SLAVE ) THEN + IF ( associated(id%TAB_POS_IN_PERE)) THEN + deallocate(id%TAB_POS_IN_PERE) + NULLIFY(id%TAB_POS_IN_PERE) + ENDIF + allocate(id%TAB_POS_IN_PERE(id%NSLAVES+2,max(NB_NIV2,1)), + & stat=allocok) + IF (allocok .gt.0) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%ISTEP_TO_INIV2' + WRITE(LP, 150) 'id%TAB_POS_IN_PERE' + END IF + INFO(1)= -7 + IF (NB_NIV2.EQ.0) THEN + INFO(2)= 2 + ELSE + INFO(2)= id%KEEP(28)+NB_NIV2*(id%NSLAVES+2) + END IF + GOTO 321 + ENDIF + END IF + IF (NB_NIV2.GT.0) deallocate (PAR2_NODES) + 321 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF ( KEEP(23).NE.0 .and. id%MYID .EQ. MASTER ) THEN + IKEEP = id%N + 1 + ELSE + IKEEP = 1 + END IF + FILS = IKEEP + 3 * id%N + NE = IKEEP + 2 * id%N + NA = IKEEP + id%N + FRERE = FILS + id%N + PTRAR = FRERE + id%N + IF (KEEP(55) .EQ. 0) THEN + IF ( id%MYID.EQ.MASTER ) THEN + NFSIZ = PTRAR + 4 * id%N + ELSE + NFSIZ = PTRAR + 2 * id%N + ENDIF + ELSE + NFSIZ = PTRAR + 2 * (NELT + 1) + END IF + IF ( KEEP(38) .NE. 0 ) THEN + CALL CMUMPS_164( id%MYID, + & id%NSLAVES, id%N, id%root, + & id%COMM_NODES, KEEP( 38 ), id%FILS(1), + & id%KEEP(50), id%KEEP(46), + & id%KEEP(51) + & , id%KEEP(60), id%NPROW, id%NPCOL, id%MBLOCK, id%NBLOCK + & ) + ELSE + id%root%yes = .FALSE. + END IF + IF ( KEEP(38) .NE. 0 .and. I_AM_SLAVE ) THEN + CALL MPI_ALLREDUCE(id%root%MYROW, MYROW_CHECK, 1, + & MPI_INTEGER, MPI_MAX, id%COMM_NODES, IERR) + IF ( MYROW_CHECK .eq. -1) THEN + INFO(1) = -25 + INFO(2) = 0 + END IF + IF ( id%root%MYROW .LT. -1 .OR. + & id%root%MYCOL .LT. -1 ) THEN + INFO(1) = -25 + INFO(2) = 0 + END IF + IF ( LP > 0 .AND. INFO(1) == -25 ) THEN + WRITE(LP, '(A)') + & 'Problem with your version of the BLACS.' + WRITE(LP, '(A)') 'Try using a BLACS version from netlib.' + ENDIF + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF ( I_AM_SLAVE ) THEN + IF (KEEP(55) .EQ. 0) THEN + CALL CMUMPS_24( id%MYID, + & id%NSLAVES, id%N, id%PROCNODE_STEPS(1), + & id%STEP(1), id%PTRAR(1), + & id%PTRAR(id%N +1), + & id%ISTEP_TO_INIV2(1), id%I_AM_CAND(1), + & KEEP(1),KEEP8(1), ICNTL(1), id ) + ELSE + CALL CMUMPS_25( id%MYID, + & id%NSLAVES, id%N, id%PROCNODE_STEPS(1), + & id%STEP(1), + & id%PTRAR(1), + & id%PTRAR(id%NELT+2 ), + & id%NELT, + & id%FRTPTR(1), id%FRTELT(1), + & KEEP(1), KEEP8(1), ICNTL(1), id%KEEP(50) ) + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + IF ( id%root%yes ) THEN + LOCAL_M = numroc( id%ND_STEPS(id%STEP(KEEP(38))), + & id%root%MBLOCK, id%root%MYROW, 0, + & id%root%NPROW ) + LOCAL_M = max(1, LOCAL_M) + LOCAL_N = numroc( id%ND_STEPS(id%STEP(KEEP(38))), + & id%root%NBLOCK, id%root%MYCOL, 0, + & id%root%NPCOL ) + ELSE + LOCAL_M = 0 + LOCAL_N = 0 + END IF + IF ( KEEP(60) .EQ. 2 .OR. KEEP(60) .EQ. 3 ) THEN + id%SCHUR_MLOC=LOCAL_M + id%SCHUR_NLOC=LOCAL_N + id%root%SCHUR_MLOC=LOCAL_M + id%root%SCHUR_NLOC=LOCAL_N + ENDIF + IF ( .NOT. associated(id%CANDIDATES)) THEN + ALLOCATE(id%CANDIDATES(id%NSLAVES+1,1)) + ENDIF + CALL CMUMPS_246( id%MYID_NODES, id%N, + & id%STEP(1), id%FRERE_STEPS(1), id%FILS(1), + & id%NA(1), id%LNA, id%NE_STEPS(1), id%DAD_STEPS(1), + & id%ND_STEPS(1), id%PROCNODE_STEPS(1), + & id%NSLAVES, + & KEEP8(11), KEEP(26), KEEP(15), + & KEEP8(12), + & KEEP8(14), + & KEEP(224), KEEP(225), + & KEEP(27), RINFO(1), + & KEEP(1), KEEP8(1), LOCAL_M, LOCAL_N, SBUF_RECOLD8, + & SBUF_SEND, SBUF_REC, id%COST_SUBTREES, KEEP(28), + & id%I_AM_CAND(1), max(KEEP(56),1), + & id%ISTEP_TO_INIV2(1), id%CANDIDATES(1,1), + & INFO(1), INFO(2) + & ,KEEP8(15) + & ,MAX_SIZE_FACTOR_TMP, KEEP8(9) + & ,ENTRIES_IN_FACTORS_LOC_MASTERS + & ) + id%MAX_SURF_MASTER = KEEP8(15) + KEEP8(19)=MAX_SIZE_FACTOR_TMP + KEEP( 29 ) = KEEP(15) + 2* max(KEEP(12),10) + & * ( KEEP(15) / 100 + 1) + INFO( 19 ) = KEEP(225) + 2* max(KEEP(12),10) + & * ( KEEP(225) / 100 + 1) + KEEP8(13) = KEEP8(12) + int(KEEP(12),8) * + & ( KEEP8(12) / 100_8 + 1_8 ) + KEEP8(17) = KEEP8(14) + int(KEEP(12),8) * + & ( KEEP8(14) /100_8 +1_8) + CALL MUMPS_736 ( SBUF_RECOLD8, KEEP8(22), MPI_MAX, + & id%COMM_NODES ) + SBUF_SEND = max(SBUF_SEND,KEEP(27)) + SBUF_REC = max(SBUF_REC ,KEEP(27)) + CALL MPI_ALLREDUCE (SBUF_REC, KEEP(44), 1, + & MPI_INTEGER, MPI_MAX, + & id%COMM_NODES, IERR) + IF (KEEP(48)==5) THEN + KEEP(43)=KEEP(44) + ELSE + KEEP(43)=SBUF_SEND + ENDIF + MIN_BUF_SIZE8 = KEEP8(22) / int(KEEP(238),8) + MIN_BUF_SIZE8 = min( MIN_BUF_SIZE8, int(huge (KEEP(43)),8)) + MIN_BUF_SIZE = int( MIN_BUF_SIZE8 ) + KEEP(44) = max(KEEP(44), MIN_BUF_SIZE) + KEEP(43) = max(KEEP(43), MIN_BUF_SIZE) + IF ( MP .GT. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' Estimated INTEGER space for factors :', + & KEEP(26) + WRITE(MP,'(A,I10) ') + & ' INFO(3), est. complex space to store factors:', + & KEEP8(11) + WRITE(MP,'(A,I10) ') + & ' Estimated number of entries in factors :', + & KEEP8(9) + WRITE(MP,'(A,I10) ') + & ' Current value of space relaxation parameter :', + & KEEP(12) + WRITE(MP,'(A,I10) ') + & ' Estimated size of IS (In Core factorization):', + & KEEP(29) + WRITE(MP,'(A,I10) ') + & ' Estimated size of S (In Core factorization):', + & KEEP8(13) + WRITE(MP,'(A,I10) ') + & ' Estimated size of S (OOC factorization) :', + & KEEP8(17) + END IF + ELSE + ENTRIES_IN_FACTORS_LOC_MASTERS = 0_8 + KEEP8(13) = 0_8 + KEEP(29) = 0 + KEEP8(17)= 0_8 + INFO(19) = 0 + KEEP8(11) = 0_8 + KEEP(26) = 0 + KEEP(27) = 0 + RINFO(1) = 0.0E0 + END IF + CALL MUMPS_736( ENTRIES_IN_FACTORS_LOC_MASTERS, + & KEEP8(109), MPI_SUM, id%COMM) + CALL MUMPS_736( KEEP8(19), KEEP8(119), + & MPI_MAX, id%COMM) + CALL MPI_ALLREDUCE( KEEP(27), KEEP(127), 1, + & MPI_INTEGER, MPI_MAX, + & id%COMM, IERR) + CALL MPI_ALLREDUCE( KEEP(26), KEEP(126), 1, + & MPI_INTEGER, MPI_SUM, + & id%COMM, IERR) + CALL MUMPS_646( KEEP8(11), KEEP8(111), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735( KEEP8(111), INFOG(3) ) + CALL MPI_ALLREDUCE( RINFO(1), RINFOG(1), 1, + & MPI_REAL, MPI_SUM, + & id%COMM, IERR) + CALL MUMPS_735( KEEP8(11), INFO(3) ) + INFO ( 4 ) = KEEP( 26 ) + INFO ( 5 ) = KEEP( 27 ) + INFO ( 7 ) = KEEP( 29 ) + CALL MUMPS_735( KEEP8(13), INFO(8) ) + CALL MUMPS_735( KEEP8(17), INFO(20) ) + CALL MUMPS_735( KEEP8(9), INFO(24) ) + INFOG( 4 ) = KEEP( 126 ) + INFOG( 5 ) = KEEP( 127 ) + CALL MUMPS_735( KEEP8(109), INFOG(20) ) + CALL CMUMPS_100(id%MYID, id%COMM, KEEP(1), KEEP8(1), + & INFO(1), INFOG(1), RINFO(1), RINFOG(1), ICNTL(1)) + OOC_STAT = KEEP(201) + IF (KEEP(201) .NE. -1) OOC_STAT=0 + PERLU_ON = .FALSE. + CALL CMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + KEEP8(2) = TOTAL_BYTES + PERLU_ON = .TRUE. + CALL CMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + IF ( MP .gt. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' Estimated space in MBYTES for IC factorization :', + & TOTAL_MBYTES + END IF + id%INFO(15) = TOTAL_MBYTES + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(15), id%INFOG(16), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Rank of proc needing largest memory in IC facto :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Estimated corresponding MBYTES for IC facto :', + & id%INFOG(16) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (IC) :' + & ,(id%INFOG(17)-id%INFO(15))/id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (IC) :' + & ,id%INFOG(17)/id%NSLAVES + END IF + WRITE(MPG,'(A,I10) ') + & ' ** TOTAL space in MBYTES for IC factorization :' + & ,id%INFOG(17) + END IF + OOC_STAT = KEEP(201) +#if defined(OLD_OOC_NOPANEL) + IF (OOC_STAT .NE. -1) OOC_STAT=2 +#else + IF (OOC_STAT .NE. -1) OOC_STAT=1 +#endif + PERLU_ON = .FALSE. + CALL CMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + KEEP8(3) = TOTAL_BYTES + PERLU_ON = .TRUE. + CALL CMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + id%INFO(17) = TOTAL_MBYTES + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(17), id%INFOG(26), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Rank of proc needing largest memory for OOC facto :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Estimated corresponding MBYTES for OOC facto :', + & id%INFOG(26) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (OOC) :' + & ,(id%INFOG(27)-id%INFO(15))/id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (OOC) :' + & ,id%INFOG(27)/id%NSLAVES + END IF + WRITE(MPG,'(A,I10) ') + & ' ** TOTAL space in MBYTES for OOC factorization :' + & ,id%INFOG(27) + END IF + IF ( id%MYID. eq. MASTER .AND. KEEP(54) .eq. 1 ) THEN + IF (associated( id%MAPPING)) + & deallocate( id%MAPPING) + allocate( id%MAPPING(id%NZ), stat=allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1) = -7 + INFO(2) = id%NZ + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MAPPING' + END IF + GOTO 92 + END IF + allocate(IWtemp( id%N ), stat=allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-7 + INFO(2)=id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'IWtemp(N)' + END IF + GOTO 92 + END IF + CALL CMUMPS_83( + & id%N, id%MAPPING(1), + & id%NZ, id%IRN(1),id%JCN(1), id%PROCNODE_STEPS(1), + & id%STEP(1), + & id%NSLAVES, id%SYM_PERM(1), + & id%FILS(1), IWtemp, id%KEEP(1),id%KEEP8(1), + & id%root%MBLOCK, id%root%NBLOCK, + & id%root%NPROW, id%root%NPCOL ) + deallocate( IWtemp ) + 92 CONTINUE + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + RETURN + 110 FORMAT(/' ****** ANALYSIS STEP ********'/) + 150 FORMAT( + & /' ** FAILURE DURING CMUMPS_26, DYNAMIC ALLOCATION OF', + & A30) + END SUBROUTINE CMUMPS_26 + SUBROUTINE CMUMPS_537(N,NSLAVES, + & ICNTL,INFOG, NE, NFSIZ, + & FRERE, FILS, + & KEEP,KEEP8,PROCNODE, + & SSARBR,NBSA,PEAK,IERR + & ) + USE MUMPS_STATIC_MAPPING + IMPLICIT NONE + INTEGER N, NSLAVES, NBSA, IERR + INTEGER ICNTL(40),INFOG(40),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NE(N),NFSIZ(N),FRERE(N),FILS(N),PROCNODE(N) + INTEGER SSARBR(N) + REAL PEAK + CALL MUMPS_369(N,NSLAVES, + & ICNTL,INFOG, NE, NFSIZ, + & FRERE, FILS, + & KEEP,KEEP8,PROCNODE, + & SSARBR,NBSA,dble(PEAK),IERR + & ) + RETURN + END SUBROUTINE CMUMPS_537 + SUBROUTINE CMUMPS_564(INODE, PROCNODE, VALUE, FILS, N) + INTEGER, intent(in) :: INODE, N, VALUE + INTEGER, intent(in) :: FILS(N) + INTEGER, intent(inout) :: PROCNODE(N) + INTEGER IN + IN=INODE + DO WHILE ( IN > 0 ) + PROCNODE( IN ) = VALUE + IN=FILS( IN ) + ENDDO + RETURN + END SUBROUTINE CMUMPS_564 + SUBROUTINE CMUMPS_647(id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(CMUMPS_STRUC) :: id + INTEGER :: LP, MP, MPG, I + INTEGER :: MASTER + LOGICAL :: PROK, PROKG + PARAMETER( MASTER = 0 ) + LP = id%ICNTL( 1 ) + MP = id%ICNTL( 2 ) + MPG = id%ICNTL( 3 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF (id%MYID.eq.MASTER) THEN + id%KEEP(256) = id%ICNTL(7) + id%KEEP(252) = id%ICNTL(32) + IF (id%KEEP(252) < 0 .OR. id%KEEP(252) > 1 ) THEN + id%KEEP(252) = 0 + ENDIF + id%KEEP(251) = id%ICNTL(31) + IF (id%KEEP(251) < 0 .OR. id%KEEP(251) > 2 ) THEN + id%KEEP(251)=0 + ENDIF + IF (id%KEEP(50) .EQ. 0 .AND. id%KEEP(252).EQ.1) THEN + IF (id%KEEP(251) .NE. 1) id%KEEP(251) = 2 + ENDIF + IF (id%KEEP(50) .NE.0 .AND. id%KEEP(251) .EQ. 2) THEN + id%KEEP(251) = 0 + ENDIF + IF (id%KEEP(251) .EQ. 1) THEN + id%KEEP(201) = -1 + ENDIF + IF (id%KEEP(252).EQ.1) THEN + id%KEEP(253) = id%NRHS + IF (id%KEEP(253) .LE. 0) THEN + id%INFO(1)=-42 + id%INFO(2)=id%NRHS + RETURN + ENDIF + ELSE + id%KEEP(253) = 0 + ENDIF + ENDIF + IF ( (id%KEEP(24).NE.0) .AND. + & id%NSLAVES.eq.1 ) THEN + id%KEEP(24) = 0 + IF ( PROKG ) THEN + WRITE(MPG, '(A)') + & ' Resetting candidate strategy to 0 because NSLAVES=1' + WRITE(MPG, '(A)') ' ' + END IF + END IF + IF ( (id%KEEP(24).EQ.0) .AND. + & id%NSLAVES.GT.1 ) THEN + id%KEEP(24) = 8 + ENDIF + IF ( (id%KEEP(24).NE.0) .AND. (id%KEEP(24).NE.1) .AND. + & (id%KEEP(24).NE.8) .AND. (id%KEEP(24).NE.10) .AND. + & (id%KEEP(24).NE.12) .AND. (id%KEEP(24).NE.14) .AND. + & (id%KEEP(24).NE.16) .AND. (id%KEEP(24).NE.18)) THEN + id%KEEP(24) = 8 + IF ( PROKG ) THEN + WRITE(MPG, '(A)') + & ' Resetting candidate strategy to 8 ' + WRITE(MPG, '(A)') ' ' + END IF + END IF + id%KEEP8(21) = int(id%KEEP(85),8) + IF ( id%MYID .EQ. MASTER ) THEN + IF (id%KEEP(201).NE.-1) THEN + id%KEEP(201)=id%ICNTL(22) + IF (id%KEEP(201) .GT. 0) THEN +#if defined(OLD_OOC_NOPANEL) + id%KEEP(201)=2 +#else + id%KEEP(201)=1 +#endif + ENDIF + ENDIF + id%KEEP(54) = id%ICNTL(18) + IF ( id%KEEP(54) .LT. 0 .or. id%KEEP(54).GT.3 ) THEN + IF ( PROKG ) THEN + WRITE(MPG, *) ' Out-of-range value for id%ICNTL(18).' + WRITE(MPG, *) ' Used 0 ie matrix not distributed' + END IF + id%KEEP(54) = 0 + END IF + id%KEEP(55) = id%ICNTL(5) + IF ( id%KEEP(55) .LT. 0 .OR. id%KEEP(55) .GT. 1 ) THEN + IF ( PROKG ) THEN + WRITE(MPG, *) ' Out-of-range value for id%ICNTL(5).' + WRITE(MPG, *) ' Used 0 ie matrix is assembled' + END IF + id%KEEP(55) = 0 + END IF + id%KEEP(60) = id%ICNTL(19) + IF ( id%KEEP( 60 ) .LE. 0 ) id%KEEP( 60 ) = 0 + IF ( id%KEEP( 60 ) .GT. 3 ) id%KEEP( 60 ) = 0 + IF (id%KEEP(60) .NE. 0 .AND. id%SIZE_SCHUR == 0 ) THEN + WRITE(MPG,'(A)') + & ' ** Schur option ignored because SIZE_SCHUR=0' + id%KEEP(60)=0 + END IF + IF ( id%KEEP(60) .NE.0 ) THEN + id%KEEP(116) = id%SIZE_SCHUR + IF (id%SIZE_SCHUR .LT. 0 .OR. id%SIZE_SCHUR .GE. id%N) THEN + id%INFO(1)=-49 + id%INFO(2)=id%SIZE_SCHUR + RETURN + ENDIF + IF ( .NOT. associated( id%LISTVAR_SCHUR ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 8 + RETURN + ELSE IF (size(id%LISTVAR_SCHUR) 0 .AND. id%NBLOCK > 0 .AND. + & id%NPROW > 0 .AND. id%NPCOL > 0 ) THEN + IF (id%NPROW *id%NPCOL .LE. id%NSLAVES) THEN + IF (id%MBLOCK .NE. id%NBLOCK ) THEN + id%INFO(1)=-31 + id%INFO(2)=id%MBLOCK - id%NBLOCK + RETURN + ENDIF + ENDIF + ENDIF + ENDIF + id%KEEP(244) = id%ICNTL(28) + id%KEEP(245) = id%ICNTL(29) +#if ! defined(parmetis) + IF ((id%KEEP(244) .EQ. 2) .AND. (id%KEEP(245) .EQ. 2)) THEN + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) THEN + WRITE(LP,'("ParMETIS not available.")') + WRITE(LP,'("Aborting.")') + RETURN + END IF + END IF +#endif +#if ! defined(ptscotch) + IF ((id%KEEP(244) .EQ. 2) .AND. (id%KEEP(245) .EQ. 1)) THEN + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) THEN + WRITE(LP,'("PT-SCOTCH not available.")') + WRITE(LP,'("Aborting.")') + RETURN + END IF + END IF +#endif + IF((id%KEEP(244) .GT. 2) .OR. + & (id%KEEP(244) .LT. 0)) id%KEEP(244)=0 + IF(id%KEEP(244) .EQ. 0) THEN + id%KEEP(244) = 1 + ELSE IF (id%KEEP(244) .EQ. 2) THEN + IF(id%KEEP(55) .NE. 0) THEN + id%INFO(1) = -39 + WRITE(LP, + & '("Incompatible values for ICNTL(5), ICNTL(28)")') + WRITE(LP, + & '("Parallel analysis is not possible if the")') + WRITE(LP, + & '("matrix is not assembled")') + RETURN + ELSE IF(id%KEEP(60) .NE. 0) THEN + id%INFO(1) = -39 + WRITE(LP, + & '("Incompatible values for ICNTL(19), ICNTL(28)")') + WRITE(LP, + & '("Parallel analysis is not possible if SCHUR")') + WRITE(LP, + & '("complement must be returned")') + RETURN + END IF + IF(id%NSLAVES .LT. 2) THEN + id%KEEP(244) = 1 + IF(PROKG) WRITE(MPG, + & '("Too few processes. + & Reverting to sequential analysis")',advance='no') + IF(id%KEEP(245) .EQ. 1) THEN + IF(PROKG) WRITE(MPG, '(" with SCOTCH")') + id%KEEP(256) = 3 + ELSE IF(id%KEEP(245) .EQ. 2) THEN + IF(PROKG) WRITE(MPG, '(" with Metis")') + id%KEEP(256) = 5 + ELSE + IF(PROKG) WRITE(MPG, '(".")') + id%KEEP(256) = 0 + END IF + END IF + END IF + id%INFOG(32) = id%KEEP(244) + IF ( (id%KEEP(244) .EQ. 1) .AND. + & (id%KEEP(256) .EQ. 1) ) THEN + IF ( .NOT. associated( id%PERM_IN ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 3 + RETURN + ELSE IF ( size( id%PERM_IN ) < id%N ) THEN + id%INFO(1) = -22 + id%INFO(2) = 3 + RETURN + END IF + ENDIF + IF (id%KEEP(9) .LE. 1 ) id%KEEP(9) = 500 + IF ( id%KEEP8(21) .GT. 0_8 ) THEN + IF ((id%KEEP8(21).LE.1_8) .OR. + & (id%KEEP8(21).GT.int(id%KEEP(9),8))) + & id%KEEP8(21) = int(min(id%KEEP(9),100),8) + ENDIF + IF (id%KEEP(48). EQ. 1 ) id%KEEP(48) = -12345 + IF ( (id%KEEP(48).LT.0) .OR. (id%KEEP(48).GT.5) ) THEN + id%KEEP(48)=5 + ENDIF + IF ( (id%KEEP(60) .NE. 0) .AND. (id%KEEP(256) .EQ. 1) ) THEN + DO I = 1, id%SIZE_SCHUR + IF (id%PERM_IN(id%LISTVAR_SCHUR(I)) + & .EQ. id%N-id%SIZE_SCHUR+I) + & CYCLE + id%INFO(1) = -22 + id%INFO(2) = 8 + RETURN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Ignoring user-ordering, because incompatible with Schur.' + WRITE(MPG,'(A)') ' ** id%ICNTL(7) treated as 0.' + END IF + EXIT + ENDDO + END IF + id%KEEP(95) = id%ICNTL(12) + IF (id%KEEP(50).NE.2) id%KEEP(95) = 1 + IF ((id%KEEP(95).GT.3).OR.(id%KEEP(95).LT.0)) id%KEEP(95) = 0 + id%KEEP(23) = id%ICNTL(6) + IF (id%KEEP(23).LT.0.OR.id%KEEP(23).GT.7) id%KEEP(23) = 7 + IF ( id%KEEP(50) .EQ. 1 ) THEN + IF (id%KEEP(23) .NE. 0) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not compatible with LLT factorization' + END IF + id%KEEP(23) = 0 + ENDIF + IF (id%KEEP(95) .GT. 1) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) ignored: not compatible with LLT factorization' + END IF + ENDIF + id%KEEP(95) = 1 + END IF + IF (id%KEEP(60) .GT. 0) THEN + IF (id%KEEP(23) .NE. 0) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed because of Schur' + END IF + id%KEEP(23) = 0 + ENDIF + IF (id%KEEP(52).NE.0) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Scaling during analysis not allowed because of Schur' + ENDIF + id%KEEP(52) = 0 + ENDIF + IF (id%KEEP(95) .GT. 1) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) option not allowed because of Schur' + END IF + ENDIF + id%KEEP(95) = 1 + END IF + IF ( (id%KEEP(23) .NE. 0) .AND. (id%KEEP(256).EQ.1)) THEN + id%KEEP(23) = 0 + id%KEEP(95) = 1 + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed because ordering is given' + END IF + END IF + IF ( id%KEEP(256) .EQ. 1 ) THEN + IF (id%KEEP(95) > 1 .AND. MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) option incompatible with given ordering' + END IF + id%KEEP(95) = 1 + END IF + IF (id%KEEP(54) .NE. 0) THEN + IF( id%KEEP(23) .NE. 0 ) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed because matrix is distributed' + END IF + id%KEEP(23) = 0 + ENDIF + IF (id%KEEP(52).EQ.-2) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Scaling during analysis not allowed (matrix is distributed)' + ENDIF + ENDIF + id%KEEP(52) = 0 + IF (id%KEEP(95) .GT. 1 .AND. MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) option not allowed because matrix is + &distributed' + ENDIF + id%KEEP(95) = 1 + END IF + IF ( id%KEEP(55) .NE. 0 ) THEN + IF( id%KEEP(23) .NE. 0 ) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed for element matrix' + END IF + id%KEEP(23) = 0 + ENDIF + IF (MPG.GT.0 .AND. id%KEEP(52).EQ.-2) THEN + WRITE(MPG,'(A)') + & ' ** Scaling not allowed at analysis for element matrix' + ENDIF + id%KEEP(52) = 0 + id%KEEP(95) = 1 + ENDIF + IF(id%KEEP(244) .EQ. 2) THEN + IF(id%KEEP(23) .EQ. 7) THEN + id%KEEP(23) = 0 + ELSE IF (id%KEEP(23) .GT. 0) THEN + id%INFO(1) = -39 + id%KEEP(23) = 0 + WRITE(LP, + & '("Incompatible values for ICNTL(6), ICNTL(28)")') + WRITE(LP, + & '("Maximum transversal not allowed + & in parallel analysis")') + RETURN + END IF + END IF + IF ( id%KEEP(54) .NE. 0 .AND. id%KEEP(55) .NE. 0 ) THEN + id%KEEP(54) = 0 + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Distributed entry not available for element matrix' + END IF + ENDIF + IF (id%ICNTL(39).NE.1 .and. id%ICNTL(39).NE.2) THEN + id%KEEP(106)=1 + ELSE + id%KEEP(106)=id%ICNTL(39) + ENDIF + IF(id%KEEP(50) .EQ. 2) THEN + IF( .NOT. associated(id%A) ) THEN + IF(id%KEEP(95) .EQ. 3) THEN + id%KEEP(95) = 2 + ENDIF + ENDIF + IF(id%KEEP(95) .EQ. 3 .AND. id%KEEP(256) .NE. 2) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: CMUMPS_203 constrained ordering not ', + & 'available with selected ordering' + id%KEEP(95) = 2 + ENDIF + IF(id%KEEP(95) .EQ. 3) THEN + id%KEEP(23) = 5 + id%KEEP(52) = -2 + ELSE IF(id%KEEP(95) .EQ. 2 .AND. + & (id%KEEP(23) .EQ. 0 .OR. id%KEEP(23) .EQ. 7) ) THEN + IF( associated(id%A) ) THEN + id%KEEP(23) = 5 + ELSE + id%KEEP(23) = 1 + ENDIF + ELSE IF(id%KEEP(95) .EQ. 1) THEN + id%KEEP(23) = 0 + ELSE IF(id%KEEP(95) .EQ. 0 .AND. id%KEEP(23) .EQ. 0) THEN + id%KEEP(95) = 1 + ENDIF + ELSE + id%KEEP(95) = 1 + ENDIF + id%KEEP(53)=0 + IF(id%KEEP(86).EQ.1)THEN + IF(id%KEEP(47).LT.2) id%KEEP(47)=2 + ENDIF + IF(id%KEEP(48).EQ.5)THEN + IF(id%KEEP(50).EQ.0)THEN + id%KEEP(87)=50 + id%KEEP(88)=50 + ELSE + id%KEEP(87)=70 + id%KEEP(88)=70 + ENDIF + ENDIF + IF((id%NSLAVES.EQ.1).AND.(id%KEEP(76).GT.3))THEN + id%KEEP(76)=2 + ENDIF + IF(id%KEEP(81).GT.0)THEN + IF(id%KEEP(47).LT.2) id%KEEP(47)=2 + ENDIF + END IF + RETURN + END SUBROUTINE CMUMPS_647 + SUBROUTINE CMUMPS_664(id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + TYPE(CMUMPS_STRUC) :: id + INTEGER, ALLOCATABLE :: REQPTR(:,:) + INTEGER :: MASTER, IERR, INDX, NRECV + INTEGER :: STATUS( MPI_STATUS_SIZE ) + INTEGER :: LP, MP, MPG, I + LOGICAL :: PROK, PROKG + PARAMETER( MASTER = 0 ) + LP = id%ICNTL( 1 ) + MP = id%ICNTL( 2 ) + MPG = id%ICNTL( 3 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF ( id%KEEP(46) .EQ. 0 .AND. id%MYID .EQ. MASTER ) THEN + id%NZ_loc = 0 + END IF + IF ( id%MYID .eq. MASTER ) THEN + allocate( REQPTR( id%NPROCS, 3 ), STAT = IERR ) + IF ( IERR .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = 3 * id%NPROCS + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'REQPTR' + END IF + GOTO 13 + END IF + allocate( id%IRN( id%NZ ), STAT = IERR ) + IF ( IERR .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = id%NZ + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'IRN' + END IF + GOTO 13 + END IF + allocate( id%JCN( id%NZ ), STAT = IERR ) + IF ( IERR .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = id%NZ + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'JCN' + END IF + GOTO 13 + END IF + END IF + 13 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) < 0 ) RETURN + IF ( id%MYID .EQ. MASTER ) THEN + DO I = 1, id%NPROCS - 1 + CALL MPI_RECV( REQPTR( I+1, 1 ), 1, + & MPI_INTEGER, I, + & COLLECT_NZ, id%COMM, STATUS, IERR ) + END DO + IF ( id%KEEP(46) .eq. 0 ) THEN + REQPTR( 1, 1 ) = 1 + ELSE + REQPTR( 1, 1 ) = id%NZ_loc + 1 + END IF + DO I = 2, id%NPROCS + REQPTR( I, 1 ) = REQPTR( I, 1 ) + REQPTR( I-1, 1 ) + END DO + ELSE + CALL MPI_SEND( id%NZ_loc, 1, MPI_INTEGER, MASTER, + & COLLECT_NZ, id%COMM, IERR ) + END IF + IF ( id%MYID .eq. MASTER ) THEN + NRECV = 0 + DO I = 1, id%NPROCS - 1 + IF ( REQPTR( I + 1, 1 ) - REQPTR( I, 1 ) .NE. 0 ) THEN + NRECV = NRECV + 2 + CALL MPI_IRECV( id%IRN( REQPTR( I, 1 ) ), + & REQPTR( I + 1, 1 ) - REQPTR( I, 1 ), + & MPI_INTEGER, + & I, COLLECT_IRN, id%COMM, REQPTR(I, 2), IERR ) + CALL MPI_IRECV( id%JCN( REQPTR( I, 1 ) ), + & REQPTR( I + 1, 1 ) - REQPTR( I, 1 ), + & MPI_INTEGER, + & I, COLLECT_JCN, id%COMM, REQPTR(I, 3), IERR ) + ELSE + REQPTR(I, 2) = MPI_REQUEST_NULL + REQPTR(I, 3) = MPI_REQUEST_NULL + END IF + END DO + ELSE + IF ( id%NZ_loc .NE. 0 ) THEN + CALL MPI_SEND( id%IRN_loc(1), id%NZ_loc, + & MPI_INTEGER, MASTER, + & COLLECT_IRN, id%COMM, IERR ) + CALL MPI_SEND( id%JCN_loc(1), id%NZ_loc, + & MPI_INTEGER, MASTER, + & COLLECT_JCN, id%COMM, IERR ) + END IF + END IF + IF ( id%MYID .eq. MASTER ) THEN + IF ( id%NZ_loc .NE. 0 ) THEN + DO I=1,id%NZ_loc + id%IRN(I) = id%IRN_loc(I) + id%JCN(I) = id%JCN_loc(I) + ENDDO + END IF + REQPTR( id%NPROCS, 2 ) = MPI_REQUEST_NULL + REQPTR( id%NPROCS, 3 ) = MPI_REQUEST_NULL + DO I = 1, NRECV + CALL MPI_WAITANY + & ( 2 * id%NPROCS, REQPTR( 1, 2 ), INDX, STATUS, IERR ) + END DO + deallocate( REQPTR ) + END IF + RETURN + 150 FORMAT( + &/' ** FAILURE DURING CMUMPS_664, DYNAMIC ALLOCATION OF', + & A30) + END SUBROUTINE CMUMPS_664 + SUBROUTINE CMUMPS_658(id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(CMUMPS_STRUC) :: id + INTEGER :: MASTER, IERR + INTEGER :: IUNIT + LOGICAL :: IS_ELEMENTAL + LOGICAL :: IS_DISTRIBUTED + INTEGER :: MM_WRITE + INTEGER :: MM_WRITE_CHECK + CHARACTER(LEN=20) :: MM_IDSTR + LOGICAL :: I_AM_SLAVE, I_AM_MASTER + PARAMETER( MASTER = 0 ) + IUNIT = 69 + I_AM_SLAVE = ( id%MYID .NE. MASTER .OR. + & ( id%MYID .EQ. MASTER .AND. + & id%KEEP(46) .EQ. 1 ) ) + I_AM_MASTER = (id%MYID.EQ.MASTER) + IS_DISTRIBUTED = (id%KEEP(54) .EQ. 3) + IS_ELEMENTAL = (id%KEEP(55) .NE. 0) + IF (id%MYID.EQ.MASTER .AND. .NOT. IS_DISTRIBUTED) THEN + IF (id%WRITE_PROBLEM(1:20) .NE. "NAME_NOT_INITIALIZED")THEN + OPEN(IUNIT,FILE=trim(id%WRITE_PROBLEM)) + CALL CMUMPS_166( id, IUNIT, I_AM_SLAVE, I_AM_MASTER, + & IS_DISTRIBUTED, + & IS_ELEMENTAL ) + CLOSE(IUNIT) + ENDIF + ELSE IF (id%KEEP(54).EQ.3) THEN + IF (id%WRITE_PROBLEM(1:20) .EQ. "NAME_NOT_INITIALIZED" + & .OR. .NOT. I_AM_SLAVE )THEN + MM_WRITE = 0 + ELSE + MM_WRITE = 1 + ENDIF + CALL MPI_ALLREDUCE(MM_WRITE, MM_WRITE_CHECK, 1, + & MPI_INTEGER, MPI_SUM, id%COMM, IERR) + IF (MM_WRITE_CHECK.EQ.id%NSLAVES .AND. I_AM_SLAVE) THEN + WRITE(MM_IDSTR,'(I7)') id%MYID_NODES + OPEN(IUNIT, + & FILE=trim(id%WRITE_PROBLEM)//trim(adjustl(MM_IDSTR))) + CALL CMUMPS_166(id, IUNIT, I_AM_SLAVE, I_AM_MASTER, + & IS_DISTRIBUTED, + & IS_ELEMENTAL ) + CLOSE(IUNIT) + ENDIF + ENDIF + IF ( id%MYID.EQ.MASTER .AND. + & associated(id%RHS) .AND. + & id%WRITE_PROBLEM(1:20) + & .NE. "NAME_NOT_INITIALIZED")THEN + OPEN(IUNIT,FILE=trim(id%WRITE_PROBLEM) //".rhs") + CALL CMUMPS_179(IUNIT, id) + CLOSE(IUNIT) + ENDIF + RETURN + END SUBROUTINE CMUMPS_658 + SUBROUTINE CMUMPS_166 + & (id, IUNIT, I_AM_SLAVE, I_AM_MASTER, + & IS_DISTRIBUTED, IS_ELEMENTAL ) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + LOGICAL, intent(in) :: I_AM_SLAVE, + & I_AM_MASTER, + & IS_DISTRIBUTED, + & IS_ELEMENTAL + INTEGER, intent(in) :: IUNIT + TYPE(CMUMPS_STRUC), intent(in) :: id + CHARACTER (LEN=10) :: SYMM + CHARACTER (LEN=8) :: ARITH + INTEGER :: I + IF (IS_ELEMENTAL) THEN + RETURN + ENDIF + IF (I_AM_MASTER .AND. .NOT. IS_DISTRIBUTED) THEN + IF (associated(id%A)) THEN + ARITH='complex' + ELSE + ARITH='pattern ' + ENDIF + IF (id%KEEP(50) .eq. 0) THEN + SYMM="general" + ELSE + SYMM="symmetric" + END IF + WRITE(IUNIT,FMT=*)'%%MatrixMarket matrix coordinate ', + & trim(ARITH)," ",trim(SYMM) + WRITE(IUNIT,*) id%N, id%N, id%NZ + IF (associated(id%A)) THEN + DO I=1,id%NZ + IF (id%KEEP(50).NE.0 .AND. id%IRN(I).LT.id%JCN(I)) THEN + WRITE(IUNIT,*) id%JCN(I), id%IRN(I), + & real(id%A(I)), aimag(id%A(I)) + ELSE + WRITE(IUNIT,*) id%IRN(I), id%JCN(I), + & real(id%A(I)), aimag(id%A(I)) + ENDIF + ENDDO + ELSE + DO I=1,id%NZ + IF (id%KEEP(50).NE.0 .AND. id%IRN(I).LT.id%JCN(I)) THEN + WRITE(IUNIT,*) id%JCN(I), id%IRN(I) + ELSE + WRITE(IUNIT,*) id%IRN(I), id%JCN(I) + ENDIF + ENDDO + ENDIF + ELSE IF ( IS_DISTRIBUTED .AND. I_AM_SLAVE ) THEN + IF (associated(id%A_loc)) THEN + ARITH='complex' + ELSE + ARITH='pattern ' + ENDIF + IF (id%KEEP(50) .eq. 0) THEN + SYMM="general" + ELSE + SYMM="symmetric" + END IF + WRITE(IUNIT,FMT=*)'%%MatrixMarket matrix coordinate ', + & trim(ARITH)," ",trim(SYMM) + WRITE(IUNIT,*) id%N, id%N, id%NZ_loc + IF (associated(id%A_loc)) THEN + DO I=1,id%NZ_loc + IF (id%KEEP(50).NE.0 .AND. + & id%IRN_loc(I).LT.id%JCN_loc(I)) THEN + WRITE(IUNIT,*) id%JCN_loc(I), id%IRN_loc(I), + & real(id%A_loc(I)), aimag(id%A_loc(I)) + ELSE + WRITE(IUNIT,*) id%IRN_loc(I), id%JCN_loc(I), + & real(id%A_loc(I)), aimag(id%A_loc(I)) + ENDIF + ENDDO + ELSE + DO I=1,id%NZ_loc + IF (id%KEEP(50).NE.0 .AND. + & id%IRN_loc(I).LT.id%JCN_loc(I)) THEN + WRITE(IUNIT,*) id%JCN_loc(I), id%IRN_loc(I) + ELSE + WRITE(IUNIT,*) id%IRN_loc(I), id%JCN_loc(I) + ENDIF + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_166 + SUBROUTINE CMUMPS_179(IUNIT, id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(CMUMPS_STRUC), intent(in) :: id + INTEGER, intent(in) :: IUNIT + CHARACTER (LEN=8) :: ARITH + INTEGER :: I, J, K, LD_RHS + IF (associated(id%RHS)) THEN + ARITH='complex' + WRITE(IUNIT,FMT=*)'%%MatrixMarket matrix array ', + & trim(ARITH), + & ' general' + WRITE(IUNIT,*) id%N, id%NRHS + IF ( id%NRHS .EQ. 1 ) THEN + LD_RHS = id%N + ELSE + LD_RHS = id%LRHS + ENDIF + DO J = 1, id%NRHS + DO I = 1, id%N + K=(J-1)*LD_RHS+I + WRITE(IUNIT,*) real(id%RHS(K)), aimag(id%RHS(K)) + ENDDO + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_179 + SUBROUTINE CMUMPS_649( NSLAVES, NB_NIV2, MYID_NODES, + & CANDIDATES, I_AM_CAND ) + IMPLICIT NONE + INTEGER, intent(in) :: NSLAVES, NB_NIV2, MYID_NODES + INTEGER, intent(in) :: CANDIDATES( NSLAVES+1, NB_NIV2 ) + LOGICAL, intent(out):: I_AM_CAND( NB_NIV2 ) + INTEGER I, INIV2, NCAND + DO INIV2=1, NB_NIV2 + I_AM_CAND(INIV2)=.FALSE. + NCAND = CANDIDATES(NSLAVES+1,INIV2) + DO I=1, NCAND + IF (CANDIDATES(I,INIV2).EQ.MYID_NODES) THEN + I_AM_CAND(INIV2)=.TRUE. + EXIT + ENDIF + ENDDO + END DO + RETURN + END SUBROUTINE CMUMPS_649 + SUBROUTINE CMUMPS_251(N,IW,LIW,A,LA, + & NSTK_STEPS, NBPROCFILS,IFLAG,ND,FILS,STEP, + & FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRT, NTOTPV, NMAXNPIV, PTRIST, PTRAST, + & PIMASTER, PAMASTER, PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, IERROR,IPOOL, LPOOL, + & RINFO, POSFAC ,IWPOS, LRLU, IPTRLU, + & LRLUS, LEAF, NBROOT, NBRTOT, + & UU, ICNTL, PTLUST_S, PTRFAC, NSTEPS, INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS,SLAVEF,MYID, COMM_NODES, + & MYID_NODES, + & BUFR,LBUFR,LBUFR_BYTES,INTARR,DBLARR,root, + & PERM, NELT, FRTPTR, FRTELT, LPTRAR, + & COMM_LOAD, ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, + & MEM_DISTRIB, NE, + & DKEEP,PIVNUL_LIST,LPN_LIST) + USE CMUMPS_LOAD + USE CMUMPS_OOC + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER N,IFLAG,NTOTPV,MAXFRT,LIW, LPTRAR, NMAXNPIV, + & IERROR, NSTEPS, INFO(40) + INTEGER(8) :: LA + COMPLEX, TARGET :: A(LA) + INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES + INTEGER, DIMENSION(0: SLAVEF - 1) :: MEM_DISTRIB + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER LPOOL + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER ITLOC(N+KEEP(253)) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER IW(LIW), NSTK_STEPS(KEEP(28)), NBPROCFILS(KEEP(28)) + INTEGER PTRARW(LPTRAR), PTRAIW(LPTRAR), ND(KEEP(28)) + INTEGER FILS(N),PTRIST(KEEP(28)) + INTEGER STEP(N), FRERE(KEEP(28)), DAD(KEEP(28)) + INTEGER PIMASTER(KEEP(28)) + INTEGER PTLUST_S(KEEP(28)), PERM(N) + INTEGER CAND(SLAVEF+1,max(1,KEEP(56))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER IPOOL(LPOOL) + INTEGER NE(KEEP(28)) + REAL RINFO(40) + INTEGER(8) :: PAMASTER(KEEP(28)), PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: POSFAC, LRLU, LRLUS, IPTRLU + INTEGER IWPOS, LEAF, NBROOT + INTEGER COMM_LOAD, ASS_IRECV + REAL UU, SEUIL, SEUIL_LDLT_NIV2 + INTEGER NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX DBLARR( max(1,KEEP(13)) ) + LOGICAL IS_ISOLATED_NODE + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + DOUBLE PRECISION, PARAMETER :: DZERO = 0.0D0, DONE = 1.0D0 + INTEGER INODE + INTEGER IWPOSCB + INTEGER FPERE, TYPEF + INTEGER MP, LP, DUMMY(1) + INTEGER NBFIN, NBRTOT, NBROOT_TRAITEES + INTEGER NFRONT, IOLDPS + INTEGER(8) NFRONT8 + INTEGER(8) :: POSELT + INTEGER IPOSROOT, IPOSROOTROWINDICES + INTEGER GLOBK109 + INTEGER(8) :: LBUFRX + COMPLEX, POINTER, DIMENSION(:) :: BUFRX + LOGICAL :: IS_BUFRX_ALLOCATED + DOUBLE PRECISION FLOP1 + INTEGER TYPE + LOGICAL SON_LEVEL2, SET_IRECV, BLOCKING, + & MESSAGE_RECEIVED + LOGICAL AVOID_DELAYED + LOGICAL LAST_CALL + INTEGER MASTER_ROOT + INTEGER LOCAL_M, LOCAL_N + INTEGER LRHS_CNTR_MASTER_ROOT, FWD_LOCAL_N_RHS + LOGICAL ROOT_OWNER + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER MUMPS_330, MUMPS_275 + LOGICAL MUMPS_167,MUMPS_283 + EXTERNAL MUMPS_167,MUMPS_283 + LOGICAL CMUMPS_508 + EXTERNAL CMUMPS_508, CMUMPS_509 + LOGICAL STACK_RIGHT_AUTHORIZED + INTEGER numroc + EXTERNAL numroc + INTEGER MAXFRW, NPVW, NOFFW, NELVAW, COMP, + & JOBASS, ETATASS + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten, + & IDUMMY + INTEGER(8) :: ITMP8 + TYPE(IO_BLOCK) :: MonBloc + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION OPASSW, OPELIW + ASS_IRECV = MPI_REQUEST_NULL + ITLOC(1:N+KEEP(253)) =0 + PTRIST (1:KEEP(28))=0 + PTLUST_S(1:KEEP(28))=0 + PTRAST(1:KEEP(28))=0_8 + PTRFAC(1:KEEP(28))=-99999_8 + MP = ICNTL(2) + LP = ICNTL(1) + MAXFRW = 0 + NPVW = 0 + NOFFW = 0 + NELVAW = 0 + COMP = 0 + OPASSW = DZERO + OPELIW = DZERO + IWPOSCB = LIW + STACK_RIGHT_AUTHORIZED = .TRUE. + CALL CMUMPS_22( .FALSE., 0_8, + & .FALSE., .FALSE., MYID_NODES, N, KEEP, KEEP8, + & IW, LIW, A, LA, LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTRAST, STEP, PIMASTER, + & PAMASTER, KEEP(IXSZ), 0_8, -444, -444, .true., + & COMP, LRLUS, + & IFLAG, IERROR + & ) + JOBASS = 0 + ETATASS = 0 + NBFIN = NBRTOT + NBROOT_TRAITEES = 0 + NBPROCFILS(1:KEEP(28)) = 0 + IF ( KEEP(38).NE.0 ) THEN + IF (root%yes) THEN + CALL CMUMPS_284( + & root, KEEP(38), N, IW, LIW, + & A, LA, + & FILS, MYID_NODES, PTRAIW, PTRARW, + & INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + ENDIF + IF ( IFLAG .LT. 0 ) GOTO 635 + END IF + 20 CONTINUE + NIV1_FLAG=0 + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( + & COMM_LOAD, ASS_IRECV, BLOCKING, SET_IRECV, + & MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_STEPS, + & COMP, IFLAG, + & IERROR, COMM_NODES, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID_NODES, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & STACK_RIGHT_AUTHORIZED ) + CALL CMUMPS_467(COMM_LOAD, KEEP) + IF (MESSAGE_RECEIVED) THEN + IF ( IFLAG .LT. 0 ) GO TO 640 + IF ( NBFIN .eq. 0 ) GOTO 640 + ELSE + IF ( .NOT. CMUMPS_508( IPOOL, LPOOL) )THEN + CALL CMUMPS_509( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, STEP, INODE, KEEP,KEEP8, MYID_NODES, ND, + & (.NOT. STACK_RIGHT_AUTHORIZED) ) + STACK_RIGHT_AUTHORIZED = .TRUE. + IF (KEEP(47) .GE. 3) THEN + CALL CMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID_NODES, STEP, N, ND, FILS ) + ENDIF + IF (KEEP(47).EQ.4) THEN + IF(INODE.GT.0.AND.INODE.LE.N)THEN + IF((NE(STEP(INODE)).EQ.0).AND. + & (FRERE(STEP(INODE)).EQ.0))THEN + IS_ISOLATED_NODE=.TRUE. + ELSE + IS_ISOLATED_NODE=.FALSE. + ENDIF + ENDIF + CALL CMUMPS_501( + & IS_ISOLATED_NODE,INODE,IPOOL,LPOOL, + & MYID_NODES,SLAVEF,COMM_LOAD,KEEP,KEEP8) + ENDIF + IF ((( KEEP(80) == 2 .OR. KEEP(80)==3 ) .AND. + & ( KEEP(47) == 4 )).OR. + & (KEEP(80) == 1 .AND. KEEP(47) .GE. 1)) THEN + CALL CMUMPS_512(INODE,STEP,KEEP(28), + & PROCNODE_STEPS,FRERE,ND,COMM_LOAD,SLAVEF, + & MYID_NODES,KEEP,KEEP8,N) + END IF + GOTO 30 + ENDIF + ENDIF + GO TO 20 + 30 CONTINUE + IF ( INODE .LT. 0 ) THEN + INODE = -INODE + FPERE = DAD(STEP(INODE)) + GOTO 130 + ELSE IF (INODE.GT.N) THEN + INODE = INODE - N + IF (INODE.EQ.KEEP(38)) THEN + NBROOT_TRAITEES = NBROOT_TRAITEES + 1 + IF ( NBROOT_TRAITEES .EQ. NBROOT ) THEN + NBFIN = NBFIN - NBROOT + IF (SLAVEF.GT.1) THEN + DUMMY(1) = NBROOT + CALL CMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID_NODES, + & COMM_NODES, RACINE, SLAVEF) + END IF + ENDIF + IF (NBFIN.EQ.0) GOTO 640 + GOTO 20 + ENDIF + TYPE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (TYPE.EQ.1) GOTO 100 + FPERE = DAD(STEP(INODE)) + AVOID_DELAYED = ( (FPERE .eq. KEEP(20) .OR. FPERE .eq. KEEP(38)) + & .AND. KEEP(60).ne.0 ) + IF ( KEEP(50) .eq. 0 ) THEN + CALL CMUMPS_144( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM_NODES, MYID_NODES, BUFR, LBUFR,LBUFR_BYTES, + & NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_STEPS,NBPROCFILS,PROCNODE_STEPS, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST) + IF ( IFLAG .LT. 0 ) GOTO 640 + ELSE + CALL CMUMPS_141( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM_NODES, MYID_NODES, BUFR, LBUFR,LBUFR_BYTES, + & NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_STEPS,NBPROCFILS,PROCNODE_STEPS, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL_LDLT_NIV2, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST) + IF ( IFLAG .LT. 0 ) GOTO 640 + IF ( IW( PTLUST_S(STEP(INODE)) + KEEP(IXSZ) + 5 ) .GT. 1 ) THEN + GOTO 20 + END IF + END IF + GOTO 130 + ENDIF + IF (INODE.EQ.KEEP(38)) THEN + CALL CMUMPS_176( COMM_LOAD, ASS_IRECV, + & root, FRERE, + & INODE, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_STEPS, COMP, + & IFLAG, IERROR, COMM_NODES, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID_NODES, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 640 + GOTO 20 + ENDIF + TYPE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (TYPE.EQ.1) THEN + IF (KEEP(55).NE.0) THEN + CALL CMUMPS_36( COMM_LOAD, ASS_IRECV, + & NELT, FRTPTR, FRTELT, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP, PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSE + JOBASS = 0 + CALL CMUMPS_252(COMM_LOAD, ASS_IRECV, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP, PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & JOBASS,ETATASS ) + ENDIF + IF ( IFLAG .LT. 0 ) GOTO 640 + IF ((NBPROCFILS(STEP(INODE)).GT.0).OR.(SON_LEVEL2)) GOTO 20 + ELSE + IF ( KEEP(55) .eq. 0 ) THEN + CALL CMUMPS_253(COMM_LOAD, ASS_IRECV, + & N, INODE, IW, LIW, A, LA, + & IFLAG, IERROR, + & ND, FILS, FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, + & root, OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_STEPS, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM_NODES, + & MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & NBFIN, LEAF, IPOOL, LPOOL, PERM, + & MEM_DISTRIB(0) + & ) + ELSE + CALL CMUMPS_37( COMM_LOAD, ASS_IRECV, + & NELT, FRTPTR, FRTELT, + & N, INODE, IW, LIW, A, LA, IFLAG, IERROR, + & ND, FILS, FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, + & root, OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_STEPS, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM_NODES, + & MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & NBFIN, LEAF, IPOOL, LPOOL, PERM, + & MEM_DISTRIB(0)) + END IF + IF (IFLAG.LT.0) GOTO 640 + GOTO 20 + ENDIF + 100 CONTINUE + FPERE = DAD(STEP(INODE)) + IF ( INODE .eq. KEEP(20) ) THEN + POSELT = PTRAST(STEP(INODE)) + IF (PTRFAC(STEP(INODE)).NE.POSELT) THEN + WRITE(*,*) "ERROR 2 in CMUMPS_251", POSELT + CALL MUMPS_ABORT() + ENDIF + CALL CMUMPS_87 + & ( IW(PTLUST_S(STEP(INODE))+KEEP(IXSZ)), KEEP(253) ) + GOTO 200 + END IF + POSELT = PTRAST(STEP(INODE)) + IOLDPS = PTLUST_S(STEP(INODE)) + AVOID_DELAYED = ( (FPERE .eq. KEEP(20) .OR. FPERE .eq. KEEP(38)) + & .AND. KEEP(60).ne.0 ) + IF (KEEP(50).EQ.0) THEN + CALL CMUMPS_143( N, INODE, IW, LIW, A, LA, + & IOLDPS, POSELT, + & IFLAG, UU, NOFFW, NPVW, + & KEEP,KEEP8, + & STEP, PROCNODE_STEPS, MYID_NODES, SLAVEF, + & SEUIL, AVOID_DELAYED, ETATASS, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, IWPOS) + JOBASS = ETATASS + IF (JOBASS.EQ.1) THEN + CALL CMUMPS_252(COMM_LOAD, ASS_IRECV, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP,PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & JOBASS,ETATASS ) + ENDIF + ELSE + IW( IOLDPS+4+KEEP(IXSZ) ) = 1 + CALL CMUMPS_140( N, INODE, + & IW, LIW, A, LA, + & IOLDPS, POSELT, + & IFLAG, UU, NOFFW, NPVW, + & KEEP,KEEP8, MYID_NODES, SEUIL, AVOID_DELAYED, + & ETATASS, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, IWPOS) + IW( IOLDPS+4+KEEP(IXSZ) ) = STEP(INODE) + JOBASS = ETATASS + IF (JOBASS.EQ.1) THEN + CALL CMUMPS_252(COMM_LOAD, ASS_IRECV, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP,PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & JOBASS,ETATASS ) + ENDIF + ENDIF + IF (IFLAG.LT.0) GOTO 635 + 130 CONTINUE + TYPE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF ( FPERE .NE. 0 ) THEN + TYPEF = MUMPS_330(PROCNODE_STEPS(STEP(FPERE)),SLAVEF) + ELSE + TYPEF = -9999 + END IF + CALL CMUMPS_254( COMM_LOAD, ASS_IRECV, + & N,INODE,TYPE,TYPEF,LA,IW,LIW,A, + & IFLAG,IERROR,OPELIW,NELVAW,NMAXNPIV, + & PTRIST,PTLUST_S,PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NE, POSFAC,LRLU, + & LRLUS,IPTRLU,ICNTL,KEEP,KEEP8,COMP,IWPOS,IWPOSCB, + & PROCNODE_STEPS,SLAVEF,FPERE,COMM_NODES,MYID_NODES, + & IPOOL, LPOOL, LEAF, + & NSTK_STEPS, NBPROCFILS, BUFR, LBUFR, LBUFR_BYTES, NBFIN, + & root, OPASSW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0) GOTO 640 + 200 CONTINUE + IF ( INODE .eq. KEEP(38) ) THEN + WRITE(*,*) 'Error .. in CMUMPS_251: ', + & ' INODE == KEEP(38)' + Stop + END IF + IF ( FPERE.EQ.0 ) THEN + NBROOT_TRAITEES = NBROOT_TRAITEES + 1 + IF ( NBROOT_TRAITEES .EQ. NBROOT ) THEN + IF (KEEP(201).EQ.1) THEN + CALL CMUMPS_681(IERR) + ELSE IF ( KEEP(201).EQ.2) THEN + CALL CMUMPS_580(IERR) + ENDIF + NBFIN = NBFIN - NBROOT + IF ( NBFIN .LT. 0 ) THEN + WRITE(*,*) ' ERROR 1 in CMUMPS_251: ', + & ' NBFIN=', NBFIN + CALL MUMPS_ABORT() + END IF + IF ( NBROOT .LT. 0 ) THEN + WRITE(*,*) ' ERROR 1 in CMUMPS_251: ', + & ' NBROOT=', NBROOT + CALL MUMPS_ABORT() + END IF + IF (SLAVEF.GT.1) THEN + DUMMY(1) = NBROOT + CALL CMUMPS_242( DUMMY(1), 1, MPI_INTEGER, + & MYID_NODES, COMM_NODES, RACINE, SLAVEF) + END IF + ENDIF + IF (NBFIN.EQ.0)THEN + GOTO 640 + ENDIF + ELSEIF ( FPERE.NE.KEEP(38) .AND. + & MUMPS_275(PROCNODE_STEPS(STEP(FPERE)),SLAVEF).EQ. + & MYID_NODES ) THEN + NSTK_STEPS(STEP(FPERE)) = NSTK_STEPS(STEP(FPERE))-1 + IF ( NSTK_STEPS( STEP( FPERE )).EQ.0) THEN + IF (KEEP(234).NE.0 .AND. + & MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF)) + & THEN + STACK_RIGHT_AUTHORIZED = .FALSE. + ENDIF + CALL CMUMPS_507(N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), STEP, FPERE ) + IF (KEEP(47) .GE. 3) THEN + CALL CMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID_NODES, STEP, N, ND, FILS ) + ENDIF + CALL MUMPS_137( FPERE, N, PROCNODE_STEPS,SLAVEF, + & ND, FILS, FRERE, STEP, PIMASTER, KEEP(28), + & KEEP(50), KEEP(253), FLOP1, + & IW, LIW, KEEP(IXSZ) ) + IF (FPERE.NE.KEEP(20)) + & CALL CMUMPS_190(1,.FALSE.,FLOP1,KEEP,KEEP8) + ENDIF + ENDIF + GO TO 20 + 635 CONTINUE + CALL CMUMPS_44( MYID_NODES, SLAVEF, COMM_NODES ) + 640 CONTINUE + CALL CMUMPS_255( INFO(1), + & ASS_IRECV, BUFR, LBUFR, + & LBUFR_BYTES, + & COMM_NODES, + & MYID_NODES, SLAVEF) + CALL CMUMPS_180( INFO(1), + & BUFR, LBUFR, + & LBUFR_BYTES, + & COMM_NODES, COMM_LOAD, SLAVEF, MP) + CALL MPI_BARRIER( COMM_NODES, IERR ) + IF ( INFO(1) .GE. 0 ) THEN + IF( KEEP(38) .NE. 0 .OR. KEEP(20).NE.0) THEN + MASTER_ROOT = MUMPS_275( + & PROCNODE_STEPS(STEP(max(KEEP(38),KEEP(20)))), + & SLAVEF) + ROOT_OWNER = (MASTER_ROOT .EQ. MYID_NODES) + IF ( KEEP(38) .NE. 0 )THEN + IF (KEEP(60).EQ.0) THEN + IOLDPS = PTLUST_S(STEP(KEEP(38))) + LOCAL_M = IW(IOLDPS+2+KEEP(IXSZ)) + LOCAL_N = IW(IOLDPS+1+KEEP(IXSZ)) + ELSE + IOLDPS = -999 + LOCAL_M = root%SCHUR_MLOC + LOCAL_N = root%SCHUR_NLOC + ENDIF + ITMP8 = int(LOCAL_M,8)*int(LOCAL_N,8) + LBUFRX = min(int(root%MBLOCK,8)*int(root%NBLOCK,8), + & int(root%TOT_ROOT_SIZE,8)*int(root%TOT_ROOT_SIZE,8) ) + IF ( LRLU .GT. LBUFRX ) THEN + BUFRX => A(POSFAC:POSFAC+LRLU-1_8) + LBUFRX=LRLU + IS_BUFRX_ALLOCATED = .FALSE. + ELSE + ALLOCATE( BUFRX( LBUFRX ), stat = IERR ) + IF (IERR.gt.0) THEN + INFO(1) = -9 + CALL MUMPS_731(LBUFRX, INFO(2) ) + IF (LP > 0 ) + & write(LP,*) ' Error allocating, real array ', + & 'of size before CMUMPS_146', LBUFRX + CALL MUMPS_ABORT() + ENDIF + IS_BUFRX_ALLOCATED = .FALSE. + ENDIF + CALL CMUMPS_146( MYID_NODES, + & root, N, KEEP(38), + & COMM_NODES, IW, LIW, IWPOS + 1, + & A, LA, PTRAST, PTLUST_S, PTRFAC, STEP, + & INFO(1), KEEP(50), KEEP(19), + & BUFRX(1), LBUFRX, KEEP,KEEP8, DKEEP ) + IF (IS_BUFRX_ALLOCATED) DEALLOCATE ( BUFRX ) + NULLIFY(BUFRX) + IF ( MYID_NODES .eq. + & MUMPS_275(PROCNODE_STEPS(STEP(KEEP(38))), + & SLAVEF) + & ) THEN + IF ( INFO(1) .EQ. -10 .OR. INFO(1) .EQ. -40 ) THEN + NPVW = NPVW + INFO(2) + ELSE + NPVW = NPVW + root%TOT_ROOT_SIZE + NMAXNPIV = max(NMAXNPIV,root%TOT_ROOT_SIZE) + END IF + END IF + IF (root%yes.AND.KEEP(60).EQ.0) THEN + IF (KEEP(252).EQ.0) THEN + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_L + NextPiv2beWritten = 1 + MonBloc%INODE = KEEP(38) + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 3 + MonBloc%NROW = LOCAL_M + MonBloc%NCOL = LOCAL_N + MonBloc%NFS = MonBloc%NCOL + MonBloc%Last = .TRUE. + MonBloc%LastPiv = MonBloc%NCOL + NULLIFY(MonBloc%INDICES) + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + LAST_CALL = .TRUE. + CALL CMUMPS_688 + & ( STRAT, TYPEFile, + & A(PTRFAC(STEP(KEEP(38)))), + & LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IERR,LAST_CALL) + ELSE IF (KEEP(201).EQ.2) THEN + KEEP8(31)=KEEP8(31)+ ITMP8 + CALL CMUMPS_576(KEEP(38),PTRFAC, + & KEEP,KEEP8,A,LA, ITMP8, IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error in CMUMPS_576' + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + IF (KEEP(201).NE.0 .OR. KEEP(252).NE.0) THEN + LRLUS = LRLUS + ITMP8 + IF (KEEP(252).NE.0) THEN + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS + & ,0_8,-ITMP8, + & KEEP,KEEP8,LRLU) + ELSE + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS + & ,ITMP8, + & 0_8, + & KEEP,KEEP8,LRLU) + ENDIF + IF (PTRFAC(STEP(KEEP(38))).EQ.POSFAC-ITMP8) THEN + POSFAC = POSFAC - ITMP8 + LRLU = LRLU + ITMP8 + ENDIF + ELSE + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS + & ,ITMP8, + & 0_8, + & KEEP,KEEP8,LRLU) + ENDIF + ENDIF + IF (root%yes. AND. KEEP(252) .NE. 0 .AND. + & (KEEP(60).EQ.0 .OR. KEEP(221).EQ.1)) THEN + IF (MYID_NODES .EQ. MASTER_ROOT) THEN + LRHS_CNTR_MASTER_ROOT = root%TOT_ROOT_SIZE*KEEP(253) + ELSE + LRHS_CNTR_MASTER_ROOT = 1 + ENDIF + ALLOCATE(root%RHS_CNTR_MASTER_ROOT( + & LRHS_CNTR_MASTER_ROOT), stat=IERR ) + IF (IERR.gt.0) THEN + INFO(1) = -13 + CALL MUMPS_731(LRHS_CNTR_MASTER_ROOT,INFO(2)) + IF (LP > 0 ) + & write(LP,*) ' Error allocating, real array ', + & 'of size before CMUMPS_146', + & LRHS_CNTR_MASTER_ROOT + CALL MUMPS_ABORT() + ENDIF + FWD_LOCAL_N_RHS = numroc(KEEP(253), root%NBLOCK, + & root%MYCOL, 0, root%NPCOL) + FWD_LOCAL_N_RHS = max(1,FWD_LOCAL_N_RHS) + CALL CMUMPS_156( MYID_NODES, + & root%TOT_ROOT_SIZE, KEEP(253), + & root%RHS_CNTR_MASTER_ROOT(1), LOCAL_M, + & FWD_LOCAL_N_RHS, root%MBLOCK, root%NBLOCK, + & root%RHS_ROOT(1,1), MASTER_ROOT, + & root%NPROW, root%NPCOL, COMM_NODES ) + & + ENDIF + ELSE + IF (KEEP(19).NE.0) THEN + CALL MPI_REDUCE(KEEP(109), GLOBK109, 1, + & MPI_INTEGER, MPI_SUM, + & MASTER_ROOT, + & COMM_NODES, IERR) + ENDIF + IF (ROOT_OWNER) THEN + IPOSROOT = PTLUST_S(STEP(KEEP(20))) + NFRONT = IW(IPOSROOT+KEEP(IXSZ)+3) + NFRONT8 = int(NFRONT,8) + IPOSROOTROWINDICES=IPOSROOT+6+KEEP(IXSZ)+ + & IW(IPOSROOT+5+KEEP(IXSZ)) + NPVW = NPVW + NFRONT + NMAXNPIV = max(NMAXNPIV,NFRONT) + END IF + IF (ROOT_OWNER.AND.KEEP(60).NE.0) THEN + IF ( PTRFAC(STEP(KEEP(20))) .EQ. POSFAC - + & NFRONT8*NFRONT8 ) THEN + POSFAC = POSFAC - NFRONT8*NFRONT8 + LRLUS = LRLUS + NFRONT8*NFRONT8 + LRLU = LRLUS + NFRONT8*NFRONT8 + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-NFRONT8*NFRONT8,KEEP,KEEP8,LRLU) + ENDIF + ENDIF + END IF + END IF + END IF + IF ( KEEP(38) .NE. 0 ) THEN + IF (MYID_NODES.EQ. + & MUMPS_275(PROCNODE_STEPS(STEP(KEEP(38))),SLAVEF) + & ) THEN + MAXFRW = max ( MAXFRW, root%TOT_ROOT_SIZE) + END IF + END IF + MAXFRT = MAXFRW + NTOTPV = NPVW + INFO(12) = NOFFW + RINFO(2) = real(OPASSW) + RINFO(3) = real(OPELIW) + INFO(13) = NELVAW + INFO(14) = COMP + RETURN + END SUBROUTINE CMUMPS_251 + SUBROUTINE CMUMPS_87( HEADER, KEEP253 ) + INTEGER HEADER( 6 ), KEEP253 + INTEGER NFRONT, NASS + NFRONT = HEADER(1) + IF ( HEADER(2) .ne. 0 ) THEN + WRITE(*,*) ' *** CHG_HEADER ERROR 1 :',HEADER(2) + CALL MUMPS_ABORT() + END IF + NASS = abs( HEADER( 3 ) ) + IF ( NASS .NE. abs( HEADER( 4 ) ) ) THEN + WRITE(*,*) ' *** CHG_HEADER ERROR 2 :',HEADER(3:4) + CALL MUMPS_ABORT() + END IF + IF ( NASS+KEEP253 .NE. NFRONT ) THEN + WRITE(*,*) ' *** CHG_HEADER ERROR 3 : not root' + CALL MUMPS_ABORT() + END IF + HEADER( 1 ) = KEEP253 + HEADER( 2 ) = 0 + HEADER( 3 ) = NFRONT + HEADER( 4 ) = NFRONT-KEEP253 + RETURN + END SUBROUTINE CMUMPS_87 + SUBROUTINE CMUMPS_136( id ) + USE CMUMPS_OOC + USE CMUMPS_STRUC_DEF + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + include 'mpif.h' + TYPE( CMUMPS_STRUC ) :: id + LOGICAL I_AM_SLAVE + INTEGER IERR, MASTER + PARAMETER ( MASTER = 0 ) + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. id%KEEP(46) .NE. 0 ) + IF (id%KEEP(201).GT.0 .AND. I_AM_SLAVE) THEN + CALL CMUMPS_587(id,IERR) + IF (IERR < 0) THEN + id%INFO(1) = -90 + id%INFO(2) = 0 + ENDIF + END IF + CALL MUMPS_276(id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID) + IF (id%root%gridinit_done) THEN + IF ( id%KEEP(38).NE.0 .and. id%root%yes ) THEN + CALL blacs_gridexit( id%root%CNTXT_BLACS ) + id%root%gridinit_done = .FALSE. + END IF + END IF + IF ( id%MYID .NE. MASTER .OR. id%KEEP(46) .ne. 0 ) THEN + CALL MPI_COMM_FREE( id%COMM_NODES, IERR ) + CALL MPI_COMM_FREE( id%COMM_LOAD, IERR ) + END IF + IF (associated(id%MEM_DIST)) THEN + DEALLOCATE(id%MEM_DIST) + NULLIFY(id%MEM_DIST) + ENDIF + IF (associated(id%MAPPING)) THEN + DEALLOCATE(id%MAPPING) + NULLIFY(id%MAPPING) + END IF + NULLIFY(id%SCHUR_CINTERFACE) + IF ( id%KEEP(52) .NE. -1 .or. id%MYID .ne. MASTER ) THEN + IF (associated(id%COLSCA)) THEN + DEALLOCATE(id%COLSCA) + NULLIFY(id%COLSCA) + ENDIF + IF (associated(id%ROWSCA)) THEN + DEALLOCATE(id%ROWSCA) + NULLIFY(id%ROWSCA) + ENDIF + END IF + IF (associated(id%PTLUST_S)) THEN + DEALLOCATE(id%PTLUST_S) + NULLIFY(id%PTLUST_S) + END IF + IF (associated(id%PTRFAC)) THEN + DEALLOCATE(id%PTRFAC) + NULLIFY(id%PTRFAC) + END IF + IF (associated(id%POIDS)) THEN + DEALLOCATE(id%POIDS) + NULLIFY(id%POIDS) + ENDIF + IF (associated(id%IS)) THEN + DEALLOCATE(id%IS) + NULLIFY(id%IS) + ENDIF + IF (associated(id%IS1)) THEN + DEALLOCATE(id%IS1) + NULLIFY(id%IS1) + ENDIF + IF (associated(id%STEP)) THEN + DEALLOCATE(id%STEP) + NULLIFY(id%STEP) + ENDIF + IF (associated(id%Step2node)) THEN + DEALLOCATE(id%Step2node) + NULLIFY(id%Step2node) + ENDIF + IF (associated(id%NE_STEPS)) THEN + DEALLOCATE(id%NE_STEPS) + NULLIFY(id%NE_STEPS) + ENDIF + IF (associated(id%ND_STEPS)) THEN + DEALLOCATE(id%ND_STEPS) + NULLIFY(id%ND_STEPS) + ENDIF + IF (associated(id%FRERE_STEPS)) THEN + DEALLOCATE(id%FRERE_STEPS) + NULLIFY(id%FRERE_STEPS) + ENDIF + IF (associated(id%DAD_STEPS)) THEN + DEALLOCATE(id%DAD_STEPS) + NULLIFY(id%DAD_STEPS) + ENDIF + IF (associated(id%SYM_PERM)) THEN + DEALLOCATE(id%SYM_PERM) + NULLIFY(id%SYM_PERM) + ENDIF + IF (associated(id%UNS_PERM)) THEN + DEALLOCATE(id%UNS_PERM) + NULLIFY(id%UNS_PERM) + ENDIF + IF (associated(id%PIVNUL_LIST)) THEN + DEALLOCATE(id%PIVNUL_LIST) + NULLIFY(id%PIVNUL_LIST) + ENDIF + IF (associated(id%FILS)) THEN + DEALLOCATE(id%FILS) + NULLIFY(id%FILS) + ENDIF + IF (associated(id%PTRAR)) THEN + DEALLOCATE(id%PTRAR) + NULLIFY(id%PTRAR) + ENDIF + IF (associated(id%FRTPTR)) THEN + DEALLOCATE(id%FRTPTR) + NULLIFY(id%FRTPTR) + ENDIF + IF (associated(id%FRTELT)) THEN + DEALLOCATE(id%FRTELT) + NULLIFY(id%FRTELT) + ENDIF + IF (associated(id%NA)) THEN + DEALLOCATE(id%NA) + NULLIFY(id%NA) + ENDIF + IF (associated(id%PROCNODE_STEPS)) THEN + DEALLOCATE(id%PROCNODE_STEPS) + NULLIFY(id%PROCNODE_STEPS) + ENDIF + IF (associated(id%PROCNODE)) THEN + DEALLOCATE(id%PROCNODE) + NULLIFY(id%PROCNODE) + ENDIF + IF (associated(id%RHSCOMP)) THEN + DEALLOCATE(id%RHSCOMP) + NULLIFY(id%RHSCOMP) + ENDIF + IF (associated(id%POSINRHSCOMP)) THEN + DEALLOCATE(id%POSINRHSCOMP) + NULLIFY(id%POSINRHSCOMP) + ENDIF + IF (id%KEEP(46).eq.1 .and. + & id%KEEP(55).ne.0 .and. + & id%MYID .eq. MASTER .and. + & id%KEEP(52) .eq. 0 ) THEN + NULLIFY(id%DBLARR) + ELSE + IF (associated(id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + END IF + IF (associated(id%INTARR)) THEN + DEALLOCATE(id%INTARR) + NULLIFY(id%INTARR) + ENDIF + IF (associated(id%root%RG2L_ROW))THEN + DEALLOCATE(id%root%RG2L_ROW) + NULLIFY(id%root%RG2L_ROW) + ENDIF + IF (associated(id%root%RG2L_COL))THEN + DEALLOCATE(id%root%RG2L_COL) + NULLIFY(id%root%RG2L_COL) + ENDIF + IF (associated(id%root%IPIV)) THEN + DEALLOCATE(id%root%IPIV) + NULLIFY(id%root%IPIV) + ENDIF + IF (associated(id%root%RHS_CNTR_MASTER_ROOT)) THEN + DEALLOCATE(id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY(id%root%RHS_CNTR_MASTER_ROOT) + ENDIF + IF (associated(id%root%RHS_ROOT))THEN + DEALLOCATE(id%root%RHS_ROOT) + NULLIFY(id%root%RHS_ROOT) + ENDIF + CALL CMUMPS_636(id) + IF (associated(id%ELTPROC)) THEN + DEALLOCATE(id%ELTPROC) + NULLIFY(id%ELTPROC) + ENDIF + IF (associated(id%CANDIDATES)) THEN + DEALLOCATE(id%CANDIDATES) + NULLIFY(id%CANDIDATES) + ENDIF + IF (associated(id%I_AM_CAND)) THEN + DEALLOCATE(id%I_AM_CAND) + NULLIFY(id%I_AM_CAND) + ENDIF + IF (associated(id%ISTEP_TO_INIV2)) THEN + DEALLOCATE(id%ISTEP_TO_INIV2) + NULLIFY(id%ISTEP_TO_INIV2) + ENDIF + IF (I_AM_SLAVE) THEN + IF (associated(id%TAB_POS_IN_PERE)) THEN + DEALLOCATE(id%TAB_POS_IN_PERE) + NULLIFY(id%TAB_POS_IN_PERE) + ENDIF + IF (associated(id%FUTURE_NIV2)) THEN + DEALLOCATE(id%FUTURE_NIV2) + NULLIFY(id%FUTURE_NIV2) + ENDIF + ENDIF + IF(associated(id%DEPTH_FIRST))THEN + DEALLOCATE(id%DEPTH_FIRST) + NULLIFY(id%DEPTH_FIRST) + ENDIF + IF(associated(id%DEPTH_FIRST_SEQ))THEN + DEALLOCATE(id%DEPTH_FIRST_SEQ) + NULLIFY(id%DEPTH_FIRST_SEQ) + ENDIF + IF(associated(id%SBTR_ID))THEN + DEALLOCATE(id%SBTR_ID) + NULLIFY(id%SBTR_ID) + ENDIF + IF (associated(id%MEM_SUBTREE)) THEN + DEALLOCATE(id%MEM_SUBTREE) + NULLIFY(id%MEM_SUBTREE) + ENDIF + IF (associated(id%MY_ROOT_SBTR)) THEN + DEALLOCATE(id%MY_ROOT_SBTR) + NULLIFY(id%MY_ROOT_SBTR) + ENDIF + IF (associated(id%MY_FIRST_LEAF)) THEN + DEALLOCATE(id%MY_FIRST_LEAF) + NULLIFY(id%MY_FIRST_LEAF) + ENDIF + IF (associated(id%MY_NB_LEAF)) THEN + DEALLOCATE(id%MY_NB_LEAF) + NULLIFY(id%MY_NB_LEAF) + ENDIF + IF (associated(id%COST_TRAV)) THEN + DEALLOCATE(id%COST_TRAV) + NULLIFY(id%COST_TRAV) + ENDIF + IF(associated (id%OOC_INODE_SEQUENCE))THEN + DEALLOCATE(id%OOC_INODE_SEQUENCE) + NULLIFY(id%OOC_INODE_SEQUENCE) + ENDIF + IF(associated (id%OOC_TOTAL_NB_NODES))THEN + DEALLOCATE(id%OOC_TOTAL_NB_NODES) + NULLIFY(id%OOC_TOTAL_NB_NODES) + ENDIF + IF(associated (id%OOC_SIZE_OF_BLOCK))THEN + DEALLOCATE(id%OOC_SIZE_OF_BLOCK) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + ENDIF + IF(associated (id%OOC_VADDR))THEN + DEALLOCATE(id%OOC_VADDR) + NULLIFY(id%OOC_VADDR) + ENDIF + IF(associated (id%OOC_NB_FILES))THEN + DEALLOCATE(id%OOC_NB_FILES) + NULLIFY(id%OOC_NB_FILES) + ENDIF + IF (id%KEEP8(24).EQ.0_8) THEN + IF (associated(id%S)) DEALLOCATE(id%S) + ELSE + ENDIF + NULLIFY(id%S) + IF (I_AM_SLAVE) THEN + CALL CMUMPS_57( IERR ) + CALL CMUMPS_59( IERR ) + END IF + IF ( associated( id%BUFR ) ) DEALLOCATE( id%BUFR ) + NULLIFY( id%BUFR ) + RETURN + END SUBROUTINE CMUMPS_136 + SUBROUTINE CMUMPS_150(MYID,COMM,S,MAXS,MAXS_BYTES) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + INTEGER COMM, MYID, MAXS, MAXS_BYTES + INTEGER S( MAXS ) + INTEGER MSGTAG, MSGSOU, MSGLEN + LOGICAL FLAG + FLAG = .TRUE. + DO WHILE ( FLAG ) + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + IF (FLAG) THEN + MSGTAG=STATUS(MPI_TAG) + MSGSOU=STATUS(MPI_SOURCE) + CALL MPI_GET_COUNT(STATUS,MPI_PACKED,MSGLEN,IERR) + IF (MSGLEN <= MAXS_BYTES) THEN + CALL MPI_RECV(S(1),MAXS_BYTES,MPI_PACKED, + & MSGSOU, MSGTAG, COMM, STATUS, IERR) + ELSE + EXIT + ENDIF + END IF + END DO + CALL MPI_BARRIER( COMM, IERR ) + RETURN + END SUBROUTINE CMUMPS_150 + SUBROUTINE CMUMPS_254(COMM_LOAD, ASS_IRECV, + & N, INODE, TYPE, TYPEF, + & LA, IW, LIW, A, + & IFLAG, IERROR, OPELIW, NELVAW, NMAXNPIV, + & PTRIST, PTLUST_S, + & PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, NE, + & POSFAC, LRLU, LRLUS, IPTRLU, ICNTL, KEEP,KEEP8, + & COMP, IWPOS, IWPOSCB, PROCNODE_STEPS, SLAVEF, + & FPERE, COMM, MYID, + & IPOOL, LPOOL, LEAF, NSTK_S, + & NBPROCFILS, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, root, + & OPASSW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE CMUMPS_COMM_BUFFER + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER COMM, MYID, TYPE, TYPEF + INTEGER N, LIW, INODE,IFLAG,IERROR + INTEGER ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA, POSFAC, LRLU, LRLUS, IPTRLU + INTEGER IWPOSCB, IWPOS, + & FPERE, SLAVEF, NELVAW, NMAXNPIV + INTEGER IW(LIW),PROCNODE_STEPS(KEEP(28)) + INTEGER(8) :: PTRAST (KEEP(28)) + INTEGER(8) :: PTRFAC (KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)), NE(KEEP(28)) + COMPLEX A(LA) + DOUBLE PRECISION OPASSW, OPELIW + COMPLEX DBLARR(max(1,KEEP(13))) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER ITLOC( N + KEEP(253) ), FILS( N ), + & ND( KEEP(28) ), FRERE( KEEP(28) ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER LPOOL, LEAF, COMP + INTEGER IPOOL( LPOOL ) + INTEGER NSTK_S( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER NBFIN + INTEGER NFRONT_ESTIM,NELIM_ESTIM + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER LP + INTEGER NBROWS_ALREADY_SENT + INTEGER(8) :: POSELT, OPSFAC + INTEGER(8) :: IOLD, INEW, FACTOR_POS + INTEGER NSLAVES, NCB, + & H_INODE, IERR, NBCOL, NBROW, NBROW_SEND, + & NBROW_STACK, NBCOL_STACK, NELIM + INTEGER NCBROW_ALREADY_MOVED, NCBROW_PREVIOUSLY_MOVED, + &NCBROW_NEWLY_MOVED + INTEGER(8) :: LAST_ALLOWED_POS + INTEGER(8) :: LREQCB, MIN_SPACE_IN_PLACE + INTEGER(8) :: SHIFT_VAL_SON + INTEGER SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON, + & LIST_ROW_SON, LIST_COL_SON, LIST_SLAVES + INTEGER IOLDPS,NFRONT,NPIV,NASS,IOLDP1,PTROWEND, + & LREQI, LCONT + INTEGER I,LDA, INIV2 + INTEGER MSGDEST, MSGTAG, CHK_LOAD + INCLUDE 'mumps_headers.h' + LOGICAL COMPRESSCB, MUST_COMPACT_FACTORS + LOGICAL INPLACE + INTEGER(8) :: SIZE_INPLACE + INTEGER INTSIZ + DOUBLE PRECISION FLOP1, FLOP1_EFFECTIVE + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + LOGICAL SSARBR, SSARBR_ROOT, MUMPS_167, + &MUMPS_170 + EXTERNAL MUMPS_167, MUMPS_170 + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + INPLACE = .FALSE. + MIN_SPACE_IN_PLACE = 0_8 + IOLDPS = PTLUST_S(STEP(INODE)) + INTSIZ = IW(IOLDPS+XXI) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NPIV = IW(IOLDPS + 1+KEEP(IXSZ)) + NMAXNPIV = max(NPIV, NMAXNPIV) + NASS = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + H_INODE= 6 + NSLAVES + KEEP(IXSZ) + LCONT = NFRONT - NPIV + NBCOL = LCONT + SSARBR = MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + SSARBR_ROOT = MUMPS_170 + & (PROCNODE_STEPS(STEP(INODE)),SLAVEF) + LREQCB = 0_8 + INPLACE = .FALSE. + COMPRESSCB= ((KEEP(215).EQ.0) + & .AND.(KEEP(50).NE.0) + & .AND.(TYPEF.EQ.1 + & .OR.TYPEF.EQ.2 + & ) + & .AND.(TYPE.EQ.1)) + MUST_COMPACT_FACTORS = .TRUE. + IF (KEEP(201).EQ.1 .OR. KEEP(201).EQ.-1) THEN + MUST_COMPACT_FACTORS = .FALSE. + ENDIF + IF ((FPERE.EQ.0).AND.(NASS.NE.NPIV)) THEN + IFLAG = -10 + GOTO 600 + ENDIF + NBROW = LCONT + IF (TYPE.EQ.2) NBROW = NASS - NPIV + IF ((KEEP(50).NE.0).AND.(TYPE.EQ.2)) THEN + LDA = NASS + ELSE + LDA = NFRONT + ENDIF + NBROW_SEND = NBROW + NELIM = NASS-NPIV + IF (TYPEF.EQ.2) NBROW_SEND = NELIM + POSELT = PTRAST(STEP(INODE)) + IF (POSELT .ne. PTRFAC(STEP(INODE))) THEN + WRITE(*,*) "Error 1 in G" + CALL MUMPS_ABORT() + END IF + NELVAW = NELVAW + NASS - NPIV + IF (KEEP(50) .eq. 0) THEN + KEEP8(10) = KEEP8(10) + int(NPIV,8) * int(NFRONT,8) + ELSE + KEEP8(10) = KEEP8(10) + ( int(NPIV,8)*int(NPIV+1,8) )/ 2_8 + ENDIF + KEEP8(10) = KEEP8(10) + int(NBROW,8) * int(NPIV,8) + CALL MUMPS_511( NFRONT, NPIV, NASS, + & KEEP(50), TYPE,FLOP1 ) + IF ( (.NOT. SSARBR_ROOT) .and. TYPE == 1) THEN + IF (NE(STEP(INODE))==0) THEN + CHK_LOAD=0 + ELSE + CHK_LOAD=1 + ENDIF + CALL CMUMPS_190(CHK_LOAD, .FALSE., -FLOP1, + & KEEP,KEEP8) + ENDIF + FLOP1_EFFECTIVE = FLOP1 + OPELIW = OPELIW + FLOP1 + IF ( NPIV .NE. NASS ) THEN + CALL MUMPS_511( NFRONT, NASS, NASS, + & KEEP(50), TYPE,FLOP1 ) + IF (.NOT. SSARBR_ROOT ) THEN + IF (NE(STEP(INODE))==0) THEN + CHK_LOAD=0 + ELSE + CHK_LOAD=1 + ENDIF + CALL CMUMPS_190(CHK_LOAD, .FALSE., + & FLOP1_EFFECTIVE-FLOP1, + & KEEP,KEEP8) + ENDIF + END IF + IF ( SSARBR_ROOT ) THEN + NFRONT_ESTIM=ND(STEP(INODE)) + KEEP(253) + NELIM_ESTIM=NASS-(NFRONT-NFRONT_ESTIM) + CALL MUMPS_511(NFRONT_ESTIM,NELIM_ESTIM,NELIM_ESTIM, + & KEEP(50),1,FLOP1) + END IF + FLOP1=-FLOP1 + IF (SSARBR_ROOT) THEN + CALL CMUMPS_190(0,.FALSE.,FLOP1,KEEP,KEEP8) + ELSE + CALL CMUMPS_190(2,.FALSE.,FLOP1,KEEP,KEEP8) + ENDIF + IF ( FPERE .EQ. 0 ) THEN + IF ( KEEP(253) .NE. 0 .AND. KEEP(201).NE.-1 + & .AND. KEEP(201).NE.1 ) THEN + MUST_COMPACT_FACTORS = .TRUE. + GOTO 190 + ELSE + MUST_COMPACT_FACTORS = .FALSE. + GOTO 190 + ENDIF + ENDIF + IF ( FPERE.EQ.KEEP(38) ) THEN + NCB = NFRONT - NASS + SHIFT_LIST_ROW_SON = H_INODE + NASS + SHIFT_LIST_COL_SON = H_INODE + NFRONT + NASS + SHIFT_VAL_SON = int(NASS,8)*int(NFRONT+1,8) + IF (TYPE.EQ.1) THEN + CALL CMUMPS_80( + & COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTLUST_S, PTRAST, + & root, NCB, NCB, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT, + & ROOT_CONT_STATIC, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG < 0 ) GOTO 500 + ENDIF + MSGDEST= MUMPS_275(PROCNODE_STEPS(STEP(FPERE)),SLAVEF) + IOLDPS = PTLUST_S(STEP(INODE)) + LIST_ROW_SON = IOLDPS + H_INODE + NPIV + LIST_COL_SON = IOLDPS + H_INODE + NFRONT + NPIV + LIST_SLAVES = IOLDPS + 6 + KEEP(IXSZ) + IF (MSGDEST.EQ.MYID) THEN + CALL CMUMPS_273( root, + & INODE, NELIM, NSLAVES, IW(LIST_ROW_SON), + & IW(LIST_COL_SON), IW(LIST_SLAVES), + & + & PROCNODE_STEPS, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & ITLOC, RHS_MUMPS, COMP, + & IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8, + & COMM, COMM_LOAD, FILS, ND) + IF (IFLAG.LT.0) GOTO 600 + ELSE + IERR = -1 + DO WHILE (IERR.EQ.-1) + CALL CMUMPS_76( INODE, NELIM, + & IW(LIST_ROW_SON), IW(LIST_COL_SON), NSLAVES, + & IW(LIST_SLAVES), MSGDEST, COMM, IERR) + IF ( IERR .EQ. -1 ) THEN + BLOCKING =.FALSE. + SET_IRECV =.TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, + & ND, FRERE, LPTRAR, NELT, + & FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & .TRUE.) + IF ( IFLAG .LT. 0 ) GOTO 500 + IOLDPS = PTLUST_S(STEP(INODE)) + LIST_ROW_SON = IOLDPS + H_INODE + NPIV + LIST_COL_SON = IOLDPS + H_INODE + NFRONT + NPIV + LIST_SLAVES = IOLDPS + 6 + KEEP(IXSZ) + ENDIF + ENDDO + IF ( IERR .EQ. -2 ) THEN + IERROR = ( 3 + NSLAVES + 2 * NELIM ) * KEEP( 34 ) + IFLAG = - 17 + GOTO 600 + ELSE IF ( IERR .EQ. -3 ) THEN + IERROR = ( 3 + NSLAVES + 2 * NELIM ) * KEEP( 34 ) + IFLAG = -20 + GOTO 600 + ENDIF + ENDIF + IF (NELIM.EQ.0) THEN + POSELT = PTRAST(STEP(INODE)) + OPSFAC = POSELT + int(NPIV,8) * int(NFRONT,8) + int(NPIV,8) + GOTO 190 + ELSE + GOTO 500 + ENDIF + ENDIF + OPSFAC = POSELT + int(NPIV,8) * int(LDA,8) + int(NPIV,8) + IF ( MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .NE. MYID ) THEN + MSGTAG =NOEUD + MSGDEST=MUMPS_275( PROCNODE_STEPS(STEP(FPERE)), SLAVEF ) + IERR = -1 + NBROWS_ALREADY_SENT = 0 + DO WHILE (IERR.EQ.-1) + IF ( (TYPE.EQ.1) .AND. (TYPEF.EQ.1) ) THEN + CALL CMUMPS_66( NBROWS_ALREADY_SENT, + & INODE, FPERE, NFRONT, + & LCONT, NASS, NPIV, IW( IOLDPS + H_INODE + NPIV ), + & IW( IOLDPS + H_INODE + NPIV + NFRONT ), + & A( OPSFAC ), COMPRESSCB, + & MSGDEST, MSGTAG, COMM, IERR ) + ELSE + IF ( (TYPE.EQ.2).AND.(KEEP(48).NE.0)) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + ELSE + INIV2 = -9999 + ENDIF + CALL CMUMPS_70( NBROWS_ALREADY_SENT, + & FPERE, INODE, + & NBROW_SEND, IW(IOLDPS + H_INODE + NPIV ), + & NBCOL, IW(IOLDPS + H_INODE + NPIV + NFRONT ), + & A(OPSFAC), LDA, NELIM, TYPE, + & NSLAVES, IW(IOLDPS+6+KEEP(IXSZ)), MSGDEST, + & COMM, IERR, + & + & SLAVEF, KEEP,KEEP8, INIV2, TAB_POS_IN_PERE ) + END IF + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IOLDPS = PTLUST_S(STEP( INODE )) + OPSFAC = POSELT + int(NPIV,8) * int(LDA,8) + int(NPIV,8) + END DO + IF ( IERR .EQ. -2 .OR. IERR .EQ. -3 ) THEN + IF ( (TYPE.EQ.1) .AND. (TYPEF.EQ.1) ) THEN + IERROR = ( 2*LCONT + 9 ) * KEEP( 34 ) + + & LCONT*LCONT * KEEP( 35 ) + ELSE IF (KEEP(50).ne.0 .AND. TYPE .eq. 2 ) THEN + IERROR = ( NBROW_SEND + NBCOL+ 5 + NSLAVES) + & * KEEP( 34 ) + + & NBROW_SEND*NBROW_SEND*KEEP( 35 ) + ELSE + IERROR = ( NBROW_SEND + NBCOL+ 5 + NSLAVES) * KEEP( 34 ) + + & NBROW_SEND*NBCOL*KEEP( 35 ) + ENDIF + IF (IERR .EQ. -2) THEN + IFLAG = -17 + IF ( LP > 0 ) THEN + WRITE(LP, *) MYID, + & ": FAILURE, SEND BUFFER TOO SMALL DURING + & CMUMPS_254", TYPE, TYPEF + ENDIF + ENDIF + IF (IERR .EQ. -3) THEN + IFLAG = -20 + IF ( LP > 0 ) THEN + WRITE(LP, *) MYID, + & ": FAILURE, RECV BUFFER TOO SMALL DURING + & CMUMPS_254", TYPE, TYPEF + ENDIF + ENDIF + GOTO 600 + ENDIF + ENDIF + IF ( MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .EQ. MYID ) THEN + LREQI = 2 + KEEP(IXSZ) + NBROW_STACK = NBROW + NBROW_SEND = 0 + IF ((KEEP(50).NE.0).AND.(TYPE.EQ.2)) THEN + NBCOL_STACK = NBROW + ELSE + NBCOL_STACK = NBCOL + ENDIF + ELSE + NBROW_STACK = NBROW-NBROW_SEND + NBCOL_STACK = NBCOL + LREQI = 6 + NBROW_STACK + NBCOL + KEEP(IXSZ) + IF (.NOT. (TYPE.EQ.1 .AND. TYPEF.EQ.2 ) ) GOTO 190 + IF (FPERE.EQ.0) GOTO 190 + ENDIF + IF (COMPRESSCB) THEN + LREQCB = ( int(NBCOL_STACK,8) * int( NBCOL_STACK + 1, 8) ) / 2_8 + & - ( int(NBROW_SEND ,8) * int( NBROW_SEND + 1, 8) ) / 2_8 + ELSE + LREQCB = int(NBROW_STACK,8) * int(NBCOL_STACK,8) + ENDIF + INPLACE = ( KEEP(234).NE.0 ) + IF (KEEP(50).NE.0 .AND. TYPE .EQ. 2) INPLACE = .FALSE. + INPLACE = INPLACE .OR. .NOT. MUST_COMPACT_FACTORS + INPLACE = INPLACE .AND. + & ( PTLUST_S(STEP(INODE)) + INTSIZ .EQ. IWPOS ) + MIN_SPACE_IN_PLACE = 0_8 + IF ( INPLACE .AND. KEEP(50).eq. 0 .AND. + & MUST_COMPACT_FACTORS) THEN + MIN_SPACE_IN_PLACE = int(NBCOL_STACK,8) + ENDIF + IF ( MIN_SPACE_IN_PLACE .GT. LREQCB ) THEN + INPLACE = .FALSE. + ENDIF + CALL CMUMPS_22( INPLACE, MIN_SPACE_IN_PLACE, + & SSARBR, .FALSE., + & MYID,N,KEEP,KEEP8,IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER,PAMASTER, + & LREQI, LREQCB, INODE, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR ) + IF (IFLAG.LT.0) GOTO 600 + PTRIST(STEP(INODE)) = IWPOSCB+1 + IF ( MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .EQ. MYID ) THEN + PIMASTER (STEP(INODE)) = PTLUST_S(STEP(INODE)) + PAMASTER(STEP(INODE)) = IPTRLU + 1_8 + PTRAST(STEP(INODE)) = -99999999_8 + IW(IWPOSCB+1+KEEP(IXSZ)) = min(-NBCOL_STACK,-1) + IW(IWPOSCB+2+KEEP(IXSZ)) = NBROW_STACK + IF (COMPRESSCB) IW(IWPOSCB+1+XXS) = S_CB1COMP + ELSE + PTRAST(STEP(INODE)) = IPTRLU+1_8 + IF (COMPRESSCB) IW(IWPOSCB+1+XXS)=S_CB1COMP + IW(IWPOSCB+1+KEEP(IXSZ)) = NBCOL + IW(IWPOSCB+2+KEEP(IXSZ)) = 0 + IW(IWPOSCB+3+KEEP(IXSZ)) = NBROW_STACK + IW(IWPOSCB+4+KEEP(IXSZ)) = 0 + IW(IWPOSCB+5+KEEP(IXSZ)) = 1 + IW(IWPOSCB+6+KEEP(IXSZ)) = 0 + IOLDP1 = PTLUST_S(STEP(INODE))+H_INODE + PTROWEND = IWPOSCB+6+NBROW_STACK+KEEP(IXSZ) + DO I = 1, NBROW_STACK + IW(IWPOSCB+7+KEEP(IXSZ)+I-1) = + & IW(IOLDP1+NFRONT-NBROW_STACK+I-1) + ENDDO + DO I = 1, NBCOL + IW(PTROWEND+I)=IW(IOLDP1+NFRONT+NPIV+I-1) + ENDDO + END IF + IF ( KEEP(50).NE.0 .AND. TYPE .EQ. 1 + & .AND. MUST_COMPACT_FACTORS ) THEN + POSELT = PTRFAC(STEP(INODE)) + CALL CMUMPS_324(A(POSELT), LDA, + & NPIV, NBROW, KEEP(50)) + MUST_COMPACT_FACTORS = .FALSE. + ENDIF + IF ( KEEP(50).EQ.0 .AND. MUST_COMPACT_FACTORS ) + & THEN + LAST_ALLOWED_POS = POSELT + int(LDA,8)*int(NPIV+NBROW-1,8) + & + int(NPIV,8) + ELSE + LAST_ALLOWED_POS = -1_8 + ENDIF + NCBROW_ALREADY_MOVED = 0 + 10 CONTINUE + NCBROW_PREVIOUSLY_MOVED = NCBROW_ALREADY_MOVED + IF (IPTRLU .LT. POSFAC ) THEN + CALL CMUMPS_652( A, LA, LDA, + & POSELT, IPTRLU, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, LREQCB, KEEP, COMPRESSCB, + & LAST_ALLOWED_POS, NCBROW_ALREADY_MOVED ) + ELSE + CALL CMUMPS_705( A, LA, LDA, + & POSELT, IPTRLU, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, LREQCB, KEEP, COMPRESSCB ) + NCBROW_ALREADY_MOVED = NBROW_STACK + ENDIF + IF (LAST_ALLOWED_POS .NE. -1_8) THEN + MUST_COMPACT_FACTORS =.FALSE. + IF ( NCBROW_ALREADY_MOVED .EQ. NBROW_STACK ) THEN + NCBROW_ALREADY_MOVED = NCBROW_ALREADY_MOVED + NBROW_SEND + ENDIF + NCBROW_NEWLY_MOVED = NCBROW_ALREADY_MOVED + & - NCBROW_PREVIOUSLY_MOVED + FACTOR_POS = POSELT + + & int(LDA,8)*int(NPIV+NBROW-NCBROW_ALREADY_MOVED,8) + CALL CMUMPS_651( A(FACTOR_POS), LDA, NPIV, + & NCBROW_NEWLY_MOVED ) + INEW = FACTOR_POS + int(NPIV,8) * int(NCBROW_NEWLY_MOVED,8) + IOLD = INEW + int(NCBROW_NEWLY_MOVED,8) * int(NBCOL_STACK,8) + DO I = 1, NCBROW_PREVIOUSLY_MOVED*NPIV + A(INEW) = A(IOLD) + IOLD = IOLD + 1_8 + INEW = INEW + 1_8 + ENDDO + KEEP8(8)=KEEP8(8) + int(NCBROW_PREVIOUSLY_MOVED,8) + & * int(NPIV,8) + LAST_ALLOWED_POS = INEW + IF (NCBROW_ALREADY_MOVED.LT.NBROW_STACK) THEN + GOTO 10 + ENDIF + ENDIF + 190 CONTINUE + IF (MUST_COMPACT_FACTORS) THEN + POSELT = PTRFAC(STEP(INODE)) + CALL CMUMPS_324(A(POSELT), LDA, + & NPIV, NBROW, KEEP(50)) + MUST_COMPACT_FACTORS = .FALSE. + ENDIF + IOLDPS = PTLUST_S(STEP(INODE)) + IW(IOLDPS+KEEP(IXSZ)) = NBCOL + IW(IOLDPS + 1+KEEP(IXSZ)) = NASS - NPIV + IF (TYPE.EQ.2) THEN + IW(IOLDPS + 2+KEEP(IXSZ)) = NASS + ELSE + IW(IOLDPS + 2+KEEP(IXSZ)) = NFRONT + ENDIF + IW(IOLDPS + 3+KEEP(IXSZ)) = NPIV + IF (INPLACE) THEN + SIZE_INPLACE = LREQCB - MIN_SPACE_IN_PLACE + ELSE + SIZE_INPLACE = 0_8 + ENDIF + CALL CMUMPS_93(SIZE_INPLACE,MYID,N,IOLDPS,TYPE, IW, LIW, + & A, LA, POSFAC, LRLU, LRLUS, + & IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8, SSARBR,INODE,IERR) + IF(IERR.LT.0)THEN + IFLAG=IERR + IERROR=0 + GOTO 600 + ENDIF + 500 CONTINUE + RETURN + 600 CONTINUE + IF (IFLAG .NE. -1) CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE CMUMPS_254 + SUBROUTINE CMUMPS_142( id) + USE CMUMPS_COMM_BUFFER + USE CMUMPS_LOAD + USE CMUMPS_OOC + USE CMUMPS_STRUC_DEF + IMPLICIT NONE +#ifndef SUN_ + INTERFACE + SUBROUTINE CMUMPS_27(id, ANORMINF, LSCAL) + USE CMUMPS_STRUC_DEF + TYPE (CMUMPS_STRUC), TARGET :: id + REAL, INTENT(OUT) :: ANORMINF + LOGICAL :: LSCAL + END SUBROUTINE CMUMPS_27 + END INTERFACE +#endif + TYPE(CMUMPS_STRUC), TARGET :: id + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER IERR, MASTER + PARAMETER( MASTER = 0 ) + INCLUDE 'mumps_headers.h' + INTEGER NSEND, NSEND_TOT, LDPTRAR, NELT + INTEGER NLOCAL, NLOCAL_TOT, KEEP13_SAVE, ITMP + INTEGER(8) K67 + INTEGER(8) ITMP8 + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER MP, LP, MPG, allocok + LOGICAL PROK, PROKG, LSCAL + INTEGER CMUMPS_LBUF, CMUMPS_LBUFR_BYTES, CMUMPS_LBUF_INT + INTEGER PTRIST, PTRWB, MAXELT_SIZE, + & ITLOC, IPOOL, NSTEPS, K28, LPOOL, LIW + INTEGER IRANK, ID_ROOT + INTEGER KKKK, NZ_locMAX + INTEGER(8) MEMORY_MD_ARG + INTEGER(8) MAXS_BASE8, MAXS_BASE_RELAXED8 + REAL CNTL4 + INTEGER MIN_PERLU, MAXIS_ESTIM + INTEGER MAXIS + INTEGER(8) :: MAXS + DOUBLE PRECISION TIME + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INTEGER PERLU, TOTAL_MBYTES, K231, K232, K233 + INTEGER COLOUR, COMM_FOR_SCALING + INTEGER LIWK, LWK, LWK_REAL + LOGICAL I_AM_SLAVE, PERLU_ON, WK_USER_PROVIDED + REAL :: ANORMINF, SEUIL, SEUIL_LDLT_NIV2 + REAL :: CNTL1, CNTL3, CNTL5, CNTL6, EPS + INTEGER N, LPN_LIST,POSBUF + INTEGER, DIMENSION (:), ALLOCATABLE :: ITMP2 + INTEGER I,K + INTEGER, DIMENSION(:), ALLOCATABLE :: IWK + COMPLEX, DIMENSION(:), ALLOCATABLE :: WK + REAL, DIMENSION(:), ALLOCATABLE :: WK_REAL + INTEGER(8), DIMENSION(:), ALLOCATABLE :: IWK8 + INTEGER, DIMENSION(:), ALLOCATABLE :: BURP + INTEGER, DIMENSION(:), ALLOCATABLE :: BUCP + INTEGER, DIMENSION(:), ALLOCATABLE :: BURS + INTEGER, DIMENSION(:), ALLOCATABLE :: BUCS + INTEGER BUREGISTRE(12) + INTEGER BUINTSZ, BURESZ, BUJOB + INTEGER BUMAXMN, M, SCMYID, SCNPROCS + REAL SCONEERR, SCINFERR + INTEGER, POINTER :: JOB, NZ + REAL,DIMENSION(:),POINTER::RINFO, RINFOG + REAL,DIMENSION(:),POINTER:: CNTL + INTEGER,DIMENSION(:),POINTER::INFO, INFOG, KEEP + INTEGER, DIMENSION(:), POINTER :: MYIRN_loc, MYJCN_loc + COMPLEX, DIMENSION(:), POINTER :: MYA_loc + INTEGER, TARGET :: DUMMYIRN_loc(1), DUMMYJCN_loc(1) + COMPLEX, TARGET :: DUMMYA_loc(1) + INTEGER(8),DIMENSION(:),POINTER::KEEP8 + INTEGER,DIMENSION(:),POINTER::ICNTL + EXTERNAL CMUMPS_505 + INTEGER CMUMPS_505 + INTEGER(8) TOTAL_BYTES + INTEGER(8) :: I8TMP + INTEGER numroc + EXTERNAL numroc + COMPLEX, DIMENSION(:), POINTER :: RHS_MUMPS + LOGICAL :: RHS_MUMPS_ALLOCATED + JOB=>id%JOB + NZ=>id%NZ + RINFO=>id%RINFO + RINFOG=>id%RINFOG + CNTL=>id%CNTL + INFO=>id%INFO + INFOG=>id%INFOG + KEEP=>id%KEEP + KEEP8=>id%KEEP8 + ICNTL=>id%ICNTL + IF (id%NZ_loc .NE. 0) THEN + MYIRN_loc=>id%IRN_loc + MYJCN_loc=>id%JCN_loc + MYA_loc=>id%A_loc + ELSE + MYIRN_loc=>DUMMYIRN_loc + MYJCN_loc=>DUMMYJCN_loc + MYA_loc=>DUMMYA_loc + ENDIF + N = id%N + EPS = epsilon ( ZERO ) + NULLIFY(RHS_MUMPS) + RHS_MUMPS_ALLOCATED = .FALSE. + IF (KEEP8(24).GT.0_8) THEN + NULLIFY(id%S) + ENDIF + WK_USER_PROVIDED = (id%LWK_USER.NE.0) + IF (WK_USER_PROVIDED) THEN + IF (id%LWK_USER.GT.0) THEN + KEEP8(24) = int(id%LWK_USER,8) + ELSE + KEEP8(24) = -int(id%LWK_USER,8)* 1000000_8 + ENDIF + ELSE + KEEP8(24) = 0_8 + ENDIF + KEEP13_SAVE = KEEP(13) + id%DKEEP(4)=-1.0E0 + id%DKEEP(5)=-1.0E0 + MP = ICNTL( 2 ) + MPG = ICNTL( 3 ) + LP = ICNTL( 1 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF ( PROK ) WRITE( MP, 130 ) + IF ( PROKG ) WRITE( MPG, 130 ) + IF ( PROKG .and. KEEP(53).GT.0 ) THEN + WRITE(MPG,'(/A,I3)') ' Null space option :', KEEP(19) + IF ( KEEP(21) .ne. 0 ) THEN + WRITE( MPG, '(A,I10)') ' Max deficiency : ', KEEP(21) + END IF + IF ( KEEP(22) .ne. 0 ) THEN + WRITE( MPG, '(A,I10)') ' Min deficiency : ', KEEP(22) + END IF + END IF + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & KEEP(46) .eq. 1 ) ) + IF (id%MYID .EQ. MASTER .AND. KEEP(201) .NE. -1) THEN + KEEP(201)=id%ICNTL(22) + IF (KEEP(201) .NE. 0) THEN +# if defined(OLD_OOC_NOPANEL) + KEEP(201)=2 +# else + KEEP(201)=1 +# endif + ENDIF + ENDIF + CALL MPI_BCAST( KEEP(12), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(19), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(21), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(201), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (id%MYID.EQ.MASTER) THEN + IF (KEEP(217).GT.2.OR.KEEP(217).LT.0) THEN + KEEP(217)=0 + ENDIF + KEEP(214)=KEEP(217) + IF (KEEP(214).EQ.0) THEN + IF (KEEP(201).NE.0) THEN + KEEP(214)=1 + ELSE + KEEP(214)=2 + ENDIF + ENDIF + ENDIF + CALL MPI_BCAST( KEEP(214), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (KEEP(201).NE.0) THEN + CALL MPI_BCAST( KEEP(99), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(205), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(211), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + ENDIF + IF ( KEEP(50) .eq. 1 ) THEN + IF (id%CNTL(1) .ne. ZERO ) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') + &' ** Warning : SPD solver called, resetting CNTL(1) to 0.0E0' + END IF + END IF + id%CNTL(1) = ZERO + END IF + IF (KEEP(219).NE.0) THEN + CALL CMUMPS_617(max(KEEP(108),1),IERR) + IF (IERR .NE. 0) THEN + INFO(1) = -13 + INFO(2) = max(KEEP(108),1) + END IF + ENDIF + IF (id%KEEP(252).EQ.1 .AND. id%MYID.EQ.MASTER) THEN + IF (id%ICNTL(20).EQ.1) THEN + id%INFO(1)=-43 + id%INFO(2)=20 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Sparse RHS is incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ELSE IF (id%ICNTL(30).NE.0) THEN + id%INFO(1)=-43 + id%INFO(2)=30 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ELSE IF (id%ICNTL(9) .NE. 1) THEN + id%INFO(1)=-43 + id%INFO(2)=9 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: sparse RHS incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ENDIF + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 530 + IF ( PROKG ) THEN + WRITE( MPG, 172 ) id%NSLAVES, id%ICNTL(22), + & KEEP8(111), KEEP(126), KEEP(127), KEEP(28) + IF (KEEP(252).GT.0) + & WRITE(MPG,173) KEEP(253) + ENDIF + IF (KEEP(201).LE.0) THEN + KEEP(IXSZ)=XSIZE_IC + ELSE IF (KEEP(201).EQ.2) THEN + KEEP(IXSZ)=XSIZE_OOC_NOPANEL + ELSE IF (KEEP(201).EQ.1) THEN + IF (KEEP(50).EQ.0) THEN + KEEP(IXSZ)=XSIZE_OOC_UNSYM + ELSE + KEEP(IXSZ)=XSIZE_OOC_SYM + ENDIF + ENDIF + IF (id%MYID.EQ.MASTER) KEEP(258)=ICNTL(33) + CALL MPI_BCAST(KEEP(258), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + IF (KEEP(258) .NE. 0) THEN + KEEP(259) = 0 + KEEP(260) = 1 + id%DKEEP(6) = 1.0E0 + id%DKEEP(7) = 0.0E0 + ENDIF + CALL MPI_BCAST(KEEP(52), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + LSCAL = ((KEEP(52) .GT. 0) .AND. (KEEP(52) .LE. 8)) + IF (LSCAL) THEN + IF ( id%MYID.EQ.MASTER ) THEN + ENDIF + IF (KEEP(52) .EQ. 7) THEN + K231= KEEP(231) + K232= KEEP(232) + K233= KEEP(233) + ELSEIF (KEEP(52) .EQ. 8) THEN + K231= KEEP(239) + K232= KEEP(240) + K233= KEEP(241) + ENDIF + CALL MPI_BCAST(id%DKEEP(3),1,MPI_REAL,MASTER, + & id%COMM,IERR) + IF ( ((KEEP(52).EQ.7).OR.(KEEP(52).EQ.8)) .AND. + & KEEP(54).NE.0 ) THEN + IF ( id%MYID .NE. MASTER ) THEN + IF ( associated(id%COLSCA)) + & DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) + & DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=IERR) + IF (IERR .GT.0) THEN + id%INFO(1)=-13 + id%INFO(2)=N + ENDIF + ALLOCATE( id%ROWSCA(N), stat=IERR) + IF (IERR .GT.0) THEN + id%INFO(1)=-13 + id%INFO(2)=N + ENDIF + ENDIF + M = N + BUMAXMN=M + IF(N > BUMAXMN) BUMAXMN = N + LIWK = 4*BUMAXMN + ALLOCATE (IWK(LIWK),BURP(M),BUCP(N), + & BURS(2* (id%NPROCS)),BUCS(2* (id%NPROCS)), + & stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=LIWK+M+N+4* (id%NPROCS) + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 530 + BUJOB = 1 + LWK_REAL = 1 + ALLOCATE(WK_REAL(LWK_REAL)) + CALL CMUMPS_693( + & MYIRN_loc(1), MYJCN_loc(1), MYA_loc(1), + & id%NZ_loc, + & M, N, id%NPROCS, id%MYID, id%COMM, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + IF(LIWK < BUINTSZ) THEN + DEALLOCATE(IWK) + LIWK = BUINTSZ + ALLOCATE(IWK(LIWK), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=LIWK + ENDIF + ENDIF + LWK_REAL = BURESZ + DEALLOCATE(WK_REAL) + ALLOCATE (WK_REAL(LWK_REAL), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=LWK_REAL + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 530 + BUJOB = 2 + CALL CMUMPS_693( + & MYIRN_loc(1), MYJCN_loc(1), MYA_loc(1), + & id%NZ_loc, + & M, N, id%NPROCS, id%MYID, id%COMM, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + id%DKEEP(4) = SCONEERR + id%DKEEP(5) = SCINFERR + DEALLOCATE(IWK, WK_REAL,BURP,BUCP,BURS, BUCS) + ELSE IF ( KEEP(54) .EQ. 0 ) THEN + IF ((KEEP(52).EQ.7).OR.(KEEP(52).EQ.8)) THEN + IF (id%MYID.EQ.MASTER) THEN + COLOUR = 0 + ELSE + COLOUR = MPI_UNDEFINED + ENDIF + CALL MPI_COMM_SPLIT( id%COMM, COLOUR, 0, + & COMM_FOR_SCALING, IERR ) + IF (id%MYID.EQ.MASTER) THEN + M = N + BUMAXMN=N + IF(N > BUMAXMN) BUMAXMN = N + LIWK = 1 + ALLOCATE (IWK(LIWK),BURP(1),BUCP(1), + & BURS(1),BUCS(1), + & stat=allocok) + LWK_REAL = M + N + ALLOCATE (WK_REAL(LWK_REAL), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=1 + ENDIF + IF (INFO(1) .LT. 0) GOTO 400 + CALL MPI_COMM_RANK(COMM_FOR_SCALING, SCMYID, IERR) + CALL MPI_COMM_SIZE(COMM_FOR_SCALING, SCNPROCS, IERR) + BUJOB = 1 + CALL CMUMPS_693( + & id%IRN(1), id%JCN(1), id%A(1), + & id%NZ, + & M, N, SCNPROCS, SCMYID, COMM_FOR_SCALING, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + IF(LWK_REAL < BURESZ) THEN + INFO(1) = -136 + GOTO 400 + ENDIF + BUJOB = 2 + CALL CMUMPS_693(id%IRN(1), + & id%JCN(1), id%A(1), + & id%NZ, + & M, N, SCNPROCS, SCMYID, COMM_FOR_SCALING, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + id%DKEEP(4) = SCONEERR + id%DKEEP(5) = SCINFERR + DEALLOCATE(WK_REAL) + DEALLOCATE (IWK,BURP,BUCP, + & BURS,BUCS) + ENDIF + CALL MPI_BCAST( id%DKEEP(4),2,MPI_REAL, + & MASTER, id%COMM, IERR ) + 400 CONTINUE + IF (id%MYID.EQ.MASTER) THEN + CALL MPI_COMM_FREE(COMM_FOR_SCALING, IERR) + ENDIF + CALL MUMPS_276(ICNTL(1), INFO(1), id%COMM, id%MYID) + IF (INFO(1).LT.0) GOTO 530 + ELSE IF (id%MYID.EQ.MASTER) THEN + IF (KEEP(52).GT.0 .AND. KEEP(52).LE.6) THEN + IF ( KEEP(52) .eq. 5 .or. + & KEEP(52) .eq. 6 ) THEN + LWK = NZ + ELSE + LWK = 1 + END IF + LWK_REAL = 5 * N + ALLOCATE( WK_REAL( LWK_REAL ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LWK_REAL + GOTO 137 + END IF + ALLOCATE( WK( LWK ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LWK + GOTO 137 + END IF + CALL CMUMPS_217(N, NZ, KEEP(52), id%A(1), + & id%IRN(1), id%JCN(1), + & id%COLSCA(1), id%ROWSCA(1), + & WK, LWK, WK_REAL, LWK_REAL, ICNTL(1), INFO(1) ) + DEALLOCATE( WK_REAL ) + DEALLOCATE( WK ) + ENDIF + ENDIF + ENDIF + IF (id%MYID.EQ.MASTER) THEN + IF (PROKG.AND.(KEEP(52).EQ.7.OR.KEEP(52).EQ.8) + & .AND. (K233+K231+K232).GT.0) THEN + IF (K232.GT.0) WRITE(MPG, 166) id%DKEEP(4) + ENDIF + ENDIF + ENDIF + LSCAL = (LSCAL .OR. (KEEP(52) .EQ. -1) .OR. KEEP(52) .EQ. -2) + IF (LSCAL .AND. KEEP(258).NE.0 .AND. id%MYID .EQ. MASTER) THEN + DO I = 1, id%N + CALL CMUMPS_761(id%ROWSCA(I), + & id%DKEEP(6), + & KEEP(259)) + ENDDO + IF (KEEP(50) .EQ. 0) THEN + DO I = 1, id%N + CALL CMUMPS_761(id%COLSCA(I), + & id%DKEEP(6), + & KEEP(259)) + ENDDO + ELSE + CALL CMUMPS_765(id%DKEEP(6), KEEP(259)) + ENDIF + CALL CMUMPS_766(id%DKEEP(6), KEEP(259)) + ENDIF + 137 CONTINUE + IF (associated(id%root%RHS_CNTR_MASTER_ROOT)) THEN + DEALLOCATE (id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY (id%root%RHS_CNTR_MASTER_ROOT) + ENDIF + IF ( id%MYID.EQ.MASTER.AND. KEEP(252).EQ.1 .AND. + & id%NRHS .NE. id%KEEP(253) ) THEN + id%INFO(1)=-42 + id%INFO(2)=id%KEEP(253) + ENDIF + IF (id%KEEP(252) .EQ. 1) THEN + IF ( id%MYID.NE.MASTER ) THEN + id%KEEP(254) = N + id%KEEP(255) = N*id%KEEP(253) + ALLOCATE(RHS_MUMPS(id%KEEP(255)),stat=IERR) + IF (IERR > 0) THEN + INFO(1)=-13 + INFO(2)=id%KEEP(255) + IF (LP > 0) + & WRITE(LP,*) 'ERREUR while allocating RHS on a slave' + NULLIFY(RHS_MUMPS) + ENDIF + RHS_MUMPS_ALLOCATED = .TRUE. + ELSE + id%KEEP(254)=id%LRHS + id%KEEP(255)=id%LRHS*(id%KEEP(253)-1)+id%N + RHS_MUMPS=>id%RHS + RHS_MUMPS_ALLOCATED = .FALSE. + IF (LSCAL) THEN + DO K=1, id%KEEP(253) + DO I=1, N + RHS_MUMPS( id%KEEP(254) * (K-1) + I ) + & = RHS_MUMPS( id%KEEP(254) * (K-1) + I ) + & * id%ROWSCA(I) + ENDDO + ENDDO + ENDIF + ENDIF + DO I= 1, id%KEEP(253) + CALL MPI_BCAST(RHS_MUMPS((I-1)*id%KEEP(254)+1), N, + & MPI_COMPLEX, MASTER,id%COMM,IERR) + END DO + ELSE + id%KEEP(255)=1 + ALLOCATE(RHS_MUMPS(1)) + RHS_MUMPS_ALLOCATED = .TRUE. + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).lt.0 ) GOTO 530 + KEEP(110)=ICNTL(24) + CALL MPI_BCAST(KEEP(110), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + IF (KEEP(110).NE.1) KEEP(110)=0 + IF (id%MYID .EQ. MASTER) CNTL3 = id%CNTL(3) + CALL MPI_BCAST(CNTL3, 1, MPI_REAL, + & MASTER, id%COMM, IERR) + IF (id%MYID .EQ. MASTER) CNTL5 = id%CNTL(5) + CALL MPI_BCAST(CNTL5, 1, MPI_REAL, + & MASTER, id%COMM, IERR) + IF (id%MYID .EQ. MASTER) CNTL6 = id%CNTL(6) + CALL MPI_BCAST(CNTL6, 1, MPI_REAL, + & MASTER, id%COMM, IERR) + IF (id%MYID .EQ. MASTER) CNTL1 = id%CNTL(1) + CALL MPI_BCAST(CNTL1, 1, MPI_REAL, + & MASTER, id%COMM, IERR) + ANORMINF = ZERO + IF (KEEP(19).EQ.0) THEN + SEUIL = ZERO + ELSE + CALL CMUMPS_27( id , ANORMINF, LSCAL ) + IF (CNTL6 .LT. ZERO) THEN + SEUIL = EPS*ANORMINF + ELSE + SEUIL = CNTL6*ANORMINF + ENDIF + IF (PROKG) WRITE(MPG,*) + & ' ABSOLUTE PIVOT THRESHOLD for rank revealing =',SEUIL + ENDIF + SEUIL_LDLT_NIV2 = SEUIL + IF (KEEP(110).EQ.0) THEN + id%DKEEP(1) = -1.0E0 + id%DKEEP(2) = ZERO + ELSE + IF (ANORMINF.EQ.ZERO) + & CALL CMUMPS_27( id , ANORMINF, LSCAL ) + IF (CNTL3 .LT. ZERO) THEN + id%DKEEP(1) = abs(CNTL(3)) + ELSE IF (CNTL3 .GT. ZERO) THEN + id%DKEEP(1) = CNTL3*ANORMINF + ELSE + id%DKEEP(1) = 1.0E-5*EPS*ANORMINF + ENDIF + IF (PROKG) WRITE(MPG,*) + & ' ZERO PIVOT DETECTION ON, THRESHOLD =',id%DKEEP(1) + IF (CNTL5.GT.ZERO) THEN + id%DKEEP(2) = CNTL5 * ANORMINF + IF (PROKG) WRITE(MPG,*) + & ' FIXATION FOR NULL PIVOTS =',id%DKEEP(2) + ELSE + IF (PROKG) WRITE(MPG,*) 'INFINITE FIXATION ' + IF (id%KEEP(50).EQ.0) THEN + id%DKEEP(2) = -max(1.0E10*ANORMINF, + & sqrt(huge(ANORMINF))/1.0E8) + ELSE + id%DKEEP(2) = ZERO + ENDIF + ENDIF + ENDIF + IF (KEEP(53).NE.0) THEN + ID_ROOT =MUMPS_275(id%PROCNODE_STEPS(id%STEP(KEEP(20))), + & id%NSLAVES) + IF ( KEEP( 46 ) .NE. 1 ) THEN + ID_ROOT = ID_ROOT + 1 + END IF + ENDIF + IF ( associated( id%PIVNUL_LIST) ) DEALLOCATE(id%PIVNUL_LIST) + IF(KEEP(110) .EQ. 1) THEN + LPN_LIST = N + ELSE + LPN_LIST = 1 + ENDIF + IF (KEEP(19).NE.0 .AND. + & (ID_ROOT.EQ.id%MYID .OR. id%MYID.EQ.MASTER)) THEN + LPN_LIST = N + ENDIF + ALLOCATE( id%PIVNUL_LIST(LPN_LIST),stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=LPN_LIST + END IF + id%PIVNUL_LIST(1:LPN_LIST) = 0 + KEEP(109) = 0 + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).lt.0 ) GOTO 530 + IF ((KEEP(19).EQ.0).AND.(KEEP(110).EQ.0)) THEN + IF (id%MYID .EQ. MASTER) CNTL4 = id%CNTL(4) + CALL MPI_BCAST( CNTL4, 1, MPI_REAL, + & MASTER, id%COMM, IERR ) + IF ( CNTL4 .GE. ZERO ) THEN + KEEP(97) = 1 + IF ( CNTL4 .EQ. ZERO ) THEN + IF(ANORMINF .EQ. ZERO) THEN + CALL CMUMPS_27( id , ANORMINF, LSCAL ) + ENDIF + SEUIL = sqrt(EPS) * ANORMINF + ELSE + SEUIL = CNTL4 + ENDIF + SEUIL_LDLT_NIV2 = SEUIL + ELSE + SEUIL = ZERO + ENDIF + ENDIF + KEEP(98) = 0 + KEEP(103) = 0 + KEEP(105) = 0 + MAXS = 1_8 + IF ( id%MYID.EQ.MASTER ) THEN + ITMP = ICNTL(23) + END IF + CALL MPI_BCAST( ITMP, 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (WK_USER_PROVIDED) ITMP = 0 + ITMP8 = int(ITMP, 8) + KEEP8(4) = ITMP8 * 1000000_8 + PERLU = KEEP(12) + IF (KEEP(201) .EQ. 0) THEN + MAXS_BASE8=KEEP8(12) + ELSE + MAXS_BASE8=KEEP8(14) + ENDIF + IF (WK_USER_PROVIDED) THEN + MAXS = KEEP8(24) + ELSE + IF ( MAXS_BASE8 .GT. 0_8 ) THEN + MAXS_BASE_RELAXED8 = + & MAXS_BASE8 + int(PERLU,8) * ( MAXS_BASE8 / 100_8 + 1_8) + IF (MAXS_BASE_RELAXED8 > huge(MAXS)) THEN + WRITE(*,*) "Internal error: I8 overflow" + CALL MUMPS_ABORT() + ENDIF + MAXS_BASE_RELAXED8 = max(MAXS_BASE_RELAXED8, 1_8) + MAXS = MAXS_BASE_RELAXED8 + ELSE + MAXS = 1_8 + MAXS_BASE_RELAXED8 = 1_8 + END IF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1) .LT. 0) THEN + GOTO 530 + ENDIF + IF ((.NOT.WK_USER_PROVIDED).AND.(I_AM_SLAVE)) THEN + IF (KEEP(96).GT.0) THEN + MAXS=int(KEEP(96),8) + ELSE + IF (KEEP8(4) .NE. 0_8) THEN + PERLU_ON = .TRUE. + CALL CMUMPS_214( id%KEEP(1), id%KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., KEEP(201), + & PERLU_ON, TOTAL_BYTES) + MAXS_BASE_RELAXED8=MAXS_BASE_RELAXED8 + + & (KEEP8(4)-TOTAL_BYTES)/int(KEEP(35),8) + IF (MAXS_BASE_RELAXED8 > int(huge(MAXS),8)) THEN + WRITE(*,*) "Internal error: I8 overflow" + CALL MUMPS_ABORT() + ELSE IF (MAXS_BASE_RELAXED8 .LE. 0_8) THEN + id%INFO(1)=-9 + IF ( -MAXS_BASE_RELAXED8 .GT. + & int(huge(id%INFO(1)),8) ) THEN + WRITE(*,*) "I8: OVERFLOW" + CALL MUMPS_ABORT() + ENDIF + id%INFO(2)=-int(MAXS_BASE_RELAXED8,4) + ELSE + MAXS=MAXS_BASE_RELAXED8 + ENDIF + ENDIF + ENDIF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1) .LT. 0) THEN + GOTO 530 + ENDIF + CALL CMUMPS_713(PROKG, MPG, MAXS, id%NSLAVES, + & id%COMM, "effective relaxed size of S =") + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (id%INFO(1) .LT. 0) THEN + GOTO 530 + ENDIF + IF ( I_AM_SLAVE ) THEN + CALL CMUMPS_188( dble(id%COST_SUBTREES), + & KEEP(64), KEEP(66),MAXS ) + K28=KEEP(28) + MEMORY_MD_ARG = min(int(PERLU,8) * ( MAXS_BASE8 / 100_8 + 1_8 ), + & max(0_8, MAXS-MAXS_BASE8)) + CALL CMUMPS_185( id, MEMORY_MD_ARG, MAXS ) + CALL CMUMPS_587(id, IERR) + IF (IERR < 0) THEN + INFO(1) = -90 + INFO(2) = 0 + GOTO 112 + ENDIF + IF (KEEP(201) .GT. 0) THEN + IF (KEEP(201).EQ.1 + & .AND.KEEP(50).EQ.0 + & .AND.KEEP(251).NE.2 + & ) THEN + OOC_NB_FILE_TYPE=2 + ELSE + OOC_NB_FILE_TYPE=1 + ENDIF + IF (KEEP(205) .GT. 0) THEN + KEEP(100) = KEEP(205) + ELSE + IF (KEEP(201).EQ.1) THEN + I8TMP = int(OOC_NB_FILE_TYPE,8) * 2_8 * int(KEEP(226),8) + ELSE + I8TMP = 2_8 * KEEP8(119) + ENDIF + I8TMP = I8TMP + int(max(KEEP(12),0),8) * + & (I8TMP/100_8+1_8) + I8TMP = min(I8TMP, 12000000_8) + KEEP(100)=int(I8TMP) + ENDIF + IF (KEEP(201).EQ.1) THEN + IF ( KEEP(99) < 3 ) THEN + KEEP(99) = KEEP(99) + 3 + ENDIF + IF (id%MYID_NODES .eq. MASTER) THEN + write(6,*) ' PANEL: INIT and force STRAT_IO= ', + & id%KEEP(99) + ENDIF + ENDIF + IF (KEEP(99) .LT.3) KEEP(100)=0 + IF((dble(KEEP(100))*dble(KEEP(35))/dble(2)).GT. + & (dble(1999999999)))THEN + IF (PROKG) THEN + WRITE(MPG,*)id%MYID,': Warning: DIM_BUF_IO might be + & too big for Filesystem' + ENDIF + ENDIF + ALLOCATE (id%OOC_INODE_SEQUENCE(KEEP(28), + & OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE*KEEP(28) + NULLIFY(id%OOC_INODE_SEQUENCE) + GOTO 112 + ENDIF + ALLOCATE (id%OOC_TOTAL_NB_NODES(OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE + NULLIFY(id%OOC_TOTAL_NB_NODES) + GOTO 112 + ENDIF + ALLOCATE (id%OOC_SIZE_OF_BLOCK(KEEP(28), + & OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE*KEEP(28) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + GOTO 112 + ENDIF + ALLOCATE (id%OOC_VADDR(KEEP(28),OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE*KEEP(28) + NULLIFY(id%OOC_VADDR) + GOTO 112 + ENDIF + ENDIF + ENDIF + 112 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1) < 0) THEN + GOTO 513 + ENDIF + IF (I_AM_SLAVE) THEN + IF (KEEP(201) .GT. 0) THEN + IF ((KEEP(201).EQ.1).OR.(KEEP(201).EQ.2)) THEN + CALL CMUMPS_575(id,MAXS) + ELSE + WRITE(*,*) "Internal error in CMUMPS_142" + CALL MUMPS_ABORT() + ENDIF + IF(INFO(1).LT.0)THEN + GOTO 111 + ENDIF + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + CALL CMUMPS_190(0,.FALSE.,dble(id%COST_SUBTREES), + & id%KEEP(1),id%KEEP8(1)) +#endif + IF (INFO(1).LT.0) GOTO 111 +#if defined(stephinfo) + write(*,*) 'proc ',id%MYID,' array of dist : ', + & id%MEM_DIST(0:id%NSLAVES - 1) +#endif + END IF + IF ( associated (id%S) ) THEN + DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF +#if defined (LARGEMATRICES) + IF ( id%MYID .ne. MASTER ) THEN +#endif + IF (.NOT.WK_USER_PROVIDED) THEN + ALLOCATE (id%S(MAXS),stat=IERR) + KEEP8(23) = MAXS + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + CALL MUMPS_735(MAXS, INFO(2)) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + ELSE + id%S => id%WK_USER(1:KEEP8(24)) + ENDIF +#if defined (LARGEMATRICES) + END IF +#endif + 111 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( KEEP(55) .eq. 0 ) THEN + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + IF ( I_AM_SLAVE .and. KEEP(13) .ne. 0 ) THEN + ALLOCATE( id%DBLARR( KEEP(13) ), stat = IERR ) + ELSE + ALLOCATE( id%DBLARR( 1 ), stat =IERR ) + END IF + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID, + & ':Error allocating DBLARR : IERR = ', IERR + INFO(1)=-13 + INFO(2)=KEEP(13) + NULLIFY(id%DBLARR) + GOTO 100 + END IF + ELSE + IF ( associated( id%INTARR ) ) THEN + DEALLOCATE( id%INTARR ) + NULLIFY( id%INTARR ) + END IF + IF ( I_AM_SLAVE .and. KEEP(14) .ne. 0 ) THEN + ALLOCATE( id%INTARR( KEEP(14) ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = KEEP(14) + NULLIFY(id%INTARR) + GOTO 100 + END IF + ELSE + ALLOCATE( id%INTARR(1),stat=allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 1 + NULLIFY(id%INTARR) + GOTO 100 + END IF + END IF + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + IF ( I_AM_SLAVE ) THEN + IF ( id%MYID_NODES .eq. MASTER + & .AND. KEEP(46) .eq. 1 + & .AND. KEEP(52) .eq. 0 ) THEN + id%DBLARR => id%A_ELT + ELSE + IF ( KEEP(13) .ne. 0 ) THEN + ALLOCATE( id%DBLARR( KEEP(13) ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = KEEP(13) + NULLIFY(id%DBLARR) + GOTO 100 + END IF + ELSE + ALLOCATE( id%DBLARR(1), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 1 + NULLIFY(id%DBLARR) + GOTO 100 + END IF + END IF + END IF + ELSE + ALLOCATE( id%DBLARR(1), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 1 + NULLIFY(id%DBLARR) + GOTO 100 + END IF + END IF + END IF + IF ( KEEP(38).NE.0 .AND. I_AM_SLAVE ) THEN + CALL CMUMPS_165( id%N, + & id%root, id%FILS(1), KEEP(38), id%KEEP(1), id%INFO(1) ) + END IF + 100 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( KEEP( 55 ) .eq. 0 ) THEN + IF (KEEP(38).NE.0 .AND. I_AM_SLAVE) THEN + LWK = numroc( id%root%ROOT_SIZE, id%root%MBLOCK, + & id%root%MYROW, 0, id%root%NPROW ) + LWK = max( 1, LWK ) + LWK = LWK* + & numroc( id%root%ROOT_SIZE, id%root%NBLOCK, + & id%root%MYCOL, 0, id%root%NPCOL ) + LWK = max( 1, LWK ) + ELSE + LWK = 1 + ENDIF + IF (MAXS .LT. int(LWK,8)) THEN + INFO(1) = -9 + INFO(2) = LWK + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( KEEP(54) .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + ALLOCATE(IWK(id%N), stat=allocok) + IF ( allocok .NE. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + END IF +#if defined(LARGEMATRICES) + IF ( associated (id%S) ) THEN + DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + ALLOCATE (WK(LWK),stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LWK + write(6,*) ' PB1 ALLOC LARGEMAT' + ENDIF +#endif + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( id%MYID .eq. MASTER ) THEN + IF (PROKG ) THEN + CALL MUMPS_291(TIME) + END IF + IF ( .not. associated( id%INTARR ) ) THEN + ALLOCATE( id%INTARR( 1 ) ) + ENDIF +#if defined(LARGEMATRICES) + CALL CMUMPS_148(id%N, NZ, id%A(1), + & id%IRN(1), id%JCN(1), id%SYM_PERM(1), + & LSCAL, id%COLSCA(1), id%ROWSCA(1), + & id%MYID, id%NSLAVES, id%PROCNODE_STEPS(1), + & min(KEEP(39),id%NZ), + & LP, id%COMM, id%root, KEEP,KEEP8, + & id%FILS(1), IWK(1), + & + & id%INTARR(1), id%DBLARR(1), + & id%PTRAR(1), id%PTRAR(id%N+1), + & id%FRERE_STEPS(1), id%STEP(1), WK(1), int(LWK,8), + & id%ISTEP_TO_INIV2, id%I_AM_CAND, + & id%CANDIDATES) + write(6,*) '!!! A,IRN,JCN are freed during facto ' + DEALLOCATE (id%A) + NULLIFY(id%A) + DEALLOCATE (id%IRN) + NULLIFY (id%IRN) + DEALLOCATE (id%JCN) + NULLIFY (id%JCN) + IF (.NOT.WK_USER_PROVIDED) THEN + ALLOCATE (id%S(MAXS),stat=IERR) + KEEP8(23) = MAXS + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = MAXS + NULLIFY(id%S) + KEEP8(23)=0_8 + write(6,*) ' PB2 ALLOC LARGEMAT',MAXS + CALL MUMPS_ABORT() + ENDIF + ELSE + id%S => id%WK_USER(1:KEEP8(24)) + ENDIF + id%S(MAXS-LWK+1:MAXS) = WK(1:LWK) + DEALLOCATE (WK) +#else + CALL CMUMPS_148(id%N, NZ, id%A(1), + & id%IRN(1), id%JCN(1), id%SYM_PERM(1), + & LSCAL, id%COLSCA(1), id%ROWSCA(1), + & id%MYID, id%NSLAVES, id%PROCNODE_STEPS(1), + & min(KEEP(39),id%NZ), + & LP, id%COMM, id%root, KEEP(1),KEEP8(1), + & id%FILS(1), IWK(1), + & + & id%INTARR(1), id%DBLARR(1), + & id%PTRAR(1), id%PTRAR(id%N+1), + & id%FRERE_STEPS(1), id%STEP(1), id%S(1), MAXS, + & id%ISTEP_TO_INIV2(1), id%I_AM_CAND(1), + & id%CANDIDATES(1,1) ) +#endif + DEALLOCATE(IWK) + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,160) TIME + CALL MUMPS_291(TIME) + END IF + ELSE + CALL CMUMPS_145( id%N, + & id%DBLARR( 1 ), max(1,KEEP( 13 )), + & id%INTARR( 1 ), max(1,KEEP( 14 )), + & id%PTRAR( 1 ), + & id%PTRAR(id%N+1), + & KEEP( 1 ), KEEP8(1), id%MYID, id%COMM, + & min(id%KEEP(39),id%NZ), + & + & id%S(1), MAXS, + & id%root, + & id%PROCNODE_STEPS(1), id%NSLAVES, + & id%SYM_PERM(1), id%FRERE_STEPS(1), id%STEP(1), + & id%INFO(1), id%INFO(2) ) + ENDIF + ELSE + IF (PROKG ) THEN + CALL MUMPS_291(TIME) + END IF + IF ( I_AM_SLAVE ) THEN + NZ_locMAX = 0 + CALL MPI_ALLREDUCE(id%NZ_loc, NZ_locMAX, 1, MPI_INTEGER, + & MPI_MAX, id%COMM_NODES, IERR) + CALL CMUMPS_282( id%N, + & id%NZ_loc, + & id, + & id%DBLARR(1), KEEP(13), id%INTARR(1), + & KEEP(14), id%PTRAR(1), id%PTRAR(id%N+1), + & KEEP(1), KEEP8(1), id%MYID_NODES, + & id%COMM_NODES, min(id%KEEP(39),NZ_locMAX), + & id%S(1), MAXS, id%root, id%PROCNODE_STEPS(1), + & id%NSLAVES, id%SYM_PERM(1), id%STEP(1), + & id%ICNTL(1), id%INFO(1), NSEND, NLOCAL, + & id%ISTEP_TO_INIV2(1), + & id%CANDIDATES(1,1) ) + IF ( ( KEEP(52).EQ.7 ).OR. (KEEP(52).EQ.8) ) THEN + IF ( id%MYID > 0 ) THEN + IF (associated(id%ROWSCA)) THEN + DEALLOCATE(id%ROWSCA) + NULLIFY(id%ROWSCA) + ENDIF + IF (associated(id%COLSCA)) THEN + DEALLOCATE(id%COLSCA) + NULLIFY(id%COLSCA) + ENDIF + ENDIF + ENDIF +#if defined(LARGEMATRICES) + IF (associated(id%IRN_loc)) THEN + DEALLOCATE(id%IRN_loc) + NULLIFY(id%IRN_loc) + ENDIF + IF (associated(id%JCN_loc)) THEN + DEALLOCATE(id%JCN_loc) + NULLIFY(id%JCN_loc) + ENDIF + IF (associated(id%A_loc)) THEN + DEALLOCATE(id%A_loc) + NULLIFY(id%A_loc) + ENDIF + write(6,*) ' Warning :', + & ' id%A_loc, IRN_loc, JCN_loc deallocated !!! ' +#endif + IF (PROK) THEN + WRITE(MP,120) NLOCAL, NSEND + END IF + END IF + IF ( KEEP(46) .eq. 0 .AND. id%MYID.eq.MASTER ) THEN + NSEND = 0 + NLOCAL = 0 + END IF + CALL MPI_REDUCE( NSEND, NSEND_TOT, 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR ) + CALL MPI_REDUCE( NLOCAL, NLOCAL_TOT, 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR ) + IF ( PROKG ) THEN + WRITE(MPG,125) NLOCAL_TOT, NSEND_TOT + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 500 + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,160) TIME + CALL MUMPS_291(TIME) + END IF + END IF + ELSE + IF (PROKG ) THEN + CALL MUMPS_291(TIME) + END IF + IF ( id%MYID.eq.MASTER) + &CALL CMUMPS_213( id%ELTPTR(1), + & id%NELT, + & MAXELT_SIZE ) + CALL CMUMPS_126( id%N, id%NELT, id%NA_ELT, + & id%COMM, id%MYID, + & id%NSLAVES, id%PTRAR(1), + & id%PTRAR(id%NELT+2), + & id%INTARR(1), id%DBLARR(1), + & id%KEEP(1), id%KEEP8(1), MAXELT_SIZE, + & id%FRTPTR(1), id%FRTELT(1), + & id%S(1), MAXS, id%FILS(1), + & id, id%root ) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 500 + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,160) TIME + CALL MUMPS_291(TIME) + END IF + END IF + IF ( I_AM_SLAVE ) THEN + CALL CMUMPS_528(id%MYID_NODES) + CMUMPS_LBUFR_BYTES = KEEP( 44 ) * KEEP( 35 ) + CMUMPS_LBUFR_BYTES = max( CMUMPS_LBUFR_BYTES, + & 100000 ) + PERLU = KEEP( 12 ) + IF (KEEP(48).EQ.5) THEN + MIN_PERLU=2 + ELSE + MIN_PERLU=0 + ENDIF + CMUMPS_LBUFR_BYTES = CMUMPS_LBUFR_BYTES + & + int( 2.0E0 * real(max(PERLU,MIN_PERLU))* + & real(CMUMPS_LBUFR_BYTES)/100E0) + IF (KEEP(48)==5) THEN + KEEP8(21) = KEEP8(22) + int( real(max(PERLU,MIN_PERLU))* + & real(KEEP8(22))/100E0,8) + ENDIF + CMUMPS_LBUF = int( real(KEEP(213)) / 100.0E0 * + & real(KEEP(43)) * real(KEEP(35)) ) + CMUMPS_LBUF = max( CMUMPS_LBUF, 100000 ) + CMUMPS_LBUF = CMUMPS_LBUF + & + int( 2.0E0 * real(max(PERLU,MIN_PERLU))* + & real(CMUMPS_LBUF)/100E0) + CMUMPS_LBUF = max(CMUMPS_LBUF, CMUMPS_LBUFR_BYTES+3*KEEP(34)) + IF(id%KEEP(48).EQ.4)THEN + CMUMPS_LBUFR_BYTES=CMUMPS_LBUFR_BYTES*5 + CMUMPS_LBUF=CMUMPS_LBUF*5 + ENDIF + CMUMPS_LBUF_INT = ( KEEP(56) + id%NSLAVES * id%NSLAVES ) * 5 + & * KEEP(34) + IF ( KEEP( 38 ) .NE. 0 ) THEN + KKKK = MUMPS_275( id%PROCNODE_STEPS(id%STEP(KEEP(38))), + & id%NSLAVES ) + IF ( KKKK .EQ. id%MYID_NODES ) THEN + CMUMPS_LBUF_INT = CMUMPS_LBUF_INT + + & 10 * + & 2 * ( id%NE_STEPS(id%STEP(KEEP(38))) + 1 ) * id%NSLAVES + & * KEEP(34) + END IF + END IF + IF ( MP .GT. 0 ) THEN + WRITE( MP, 9999 ) CMUMPS_LBUFR_BYTES, + & CMUMPS_LBUF, CMUMPS_LBUF_INT + END IF + 9999 FORMAT( /,' Allocated buffers',/,' ------------------',/, + & ' Size of reception buffer in bytes ...... = ', I10, + & /, + & ' Size of async. emission buffer (bytes).. = ', I10,/, + & ' Small emission buffer (bytes) .......... = ', I10) + CALL CMUMPS_55( CMUMPS_LBUF_INT, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID, + & ':Error allocating small Send buffer:IERR=' + & ,IERR + INFO(1)= -13 + INFO(2)= (CMUMPS_LBUF_INT+KEEP(34)-1)/KEEP(34) + GO TO 110 + END IF + CALL CMUMPS_53( CMUMPS_LBUF, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating Send buffer:IERR=' + & ,IERR + INFO(1)= -13 + INFO(2)= (CMUMPS_LBUF+KEEP(34)-1)/KEEP(34) + GO TO 110 + END IF + id%LBUFR_BYTES = CMUMPS_LBUFR_BYTES + id%LBUFR = (CMUMPS_LBUFR_BYTES+KEEP(34)-1)/KEEP(34) + IF (associated(id%BUFR)) DEALLOCATE(id%BUFR) + ALLOCATE( id%BUFR( id%LBUFR ),stat=IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating BUFR:IERR=' + & ,IERR + INFO(1)=-13 + INFO(2)=id%LBUFR + NULLIFY(id%BUFR) + GO TO 110 + END IF + PERLU = KEEP( 12 ) + IF (KEEP(201).GT.0) THEN + MAXIS_ESTIM = KEEP(225) + ELSE + MAXIS_ESTIM = KEEP(15) + ENDIF + MAXIS = max( 1, + & MAXIS_ESTIM + 2 * max(PERLU,10) * + & ( MAXIS_ESTIM / 100 + 1 ) + & ) + IF (associated(id%IS)) DEALLOCATE( id%IS ) + ALLOCATE( id%IS( MAXIS ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating IS:IERR=',IERR + INFO(1)=-13 + INFO(2)=MAXIS + NULLIFY(id%IS) + GO TO 110 + END IF + LIW = MAXIS + IF (associated( id%PTLUST_S )) DEALLOCATE(id%PTLUST_S) + ALLOCATE( id%PTLUST_S( id%KEEP(28) ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocatingPTLUST:IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=id%KEEP(28) + NULLIFY(id%PTLUST_S) + GOTO 100 + END IF + IF (associated( id%PTRFAC )) DEALLOCATE(id%PTRFAC) + ALLOCATE( id%PTRFAC( id%KEEP(28) ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocatingPTRFAC:IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=id%KEEP(28) + NULLIFY(id%PTRFAC) + GOTO 100 + END IF + PTRIST = 1 + PTRWB = PTRIST + id%KEEP(28) + ITLOC = PTRWB + 3 * id%KEEP(28) + IPOOL = ITLOC + id%N + id%KEEP(253) + LPOOL = CMUMPS_505(id%KEEP(1),id%KEEP8(1)) + ALLOCATE( IWK( IPOOL + LPOOL - 1 ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating IWK : IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=IPOOL + LPOOL - 1 + GOTO 110 + END IF + ALLOCATE(IWK8( 2 * id%KEEP(28)), stat = IERR) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating IWK : IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=2 * id%KEEP(28) + GOTO 110 + END IF + ENDIF + 110 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 500 + IF ( I_AM_SLAVE ) THEN + CALL CMUMPS_60( id%LBUFR_BYTES ) + IF (MP .GT. 0) THEN + WRITE( MP, 170 ) MAXS, MAXIS, KEEP8(12), KEEP(15), KEEP(13), + & KEEP(14), KEEP8(11), KEEP(26), KEEP(27) + ENDIF + END IF + PERLU_ON = .TRUE. + CALL CMUMPS_214( id%KEEP(1), id%KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., id%KEEP(201), + & PERLU_ON, TOTAL_BYTES) + id%INFO(16) = TOTAL_MBYTES + IF ( MP .gt. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' ** Space in MBYTES used during factorization :', + & id%INFO(16) + END IF + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(16), id%INFOG(18), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Memory relaxation parameter ( ICNTL(14) ) :', + & KEEP(12) + WRITE( MPG,'(A,I10) ') + & ' ** Rank of processor needing largest memory in facto :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Space in MBYTES used by this processor for facto :', + & id%INFOG(18) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during facto :', + & ( id%INFOG(19)-id%INFO(16) ) / id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during facto :', + & id%INFOG(19) / id%NSLAVES + END IF + END IF + KEEP8(31)= 0_8 + KEEP8(10) = 0_8 + KEEP8(8)=0_8 + INFO(9:14)=0 + RINFO(2:3)=ZERO + IF ( I_AM_SLAVE ) THEN + IF ( KEEP(55) .eq. 0 ) THEN + LDPTRAR = id%N + ELSE + LDPTRAR = id%NELT + 1 + END IF + IF ( id%KEEP(55) .NE. 0 ) THEN + NELT = id%NELT + ELSE + NELT = 1 + END IF + CALL CMUMPS_244( id%N, NSTEPS, id%S(1), + & MAXS, id%IS( 1 ), LIW, + & id%SYM_PERM(1), id%NA(1), id%LNA, id%NE_STEPS(1), + & id%ND_STEPS(1), id%FILS(1), id%STEP(1), + & id%FRERE_STEPS(1), id%DAD_STEPS(1), id%CANDIDATES(1,1), + & id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & id%PTRAR(1), LDPTRAR, IWK( PTRIST ), + & id%PTLUST_S(1), id%PTRFAC(1), IWK( PTRWB ), + & IWK8, + & IWK( ITLOC ), RHS_MUMPS(1), IWK( IPOOL ), LPOOL, + & CNTL1, ICNTL(1), INFO(1), RINFO(1), KEEP(1),KEEP8(1), + & id%PROCNODE_STEPS(1), + & id%NSLAVES, id%COMM_NODES, + & id%MYID, id%MYID_NODES, + & id%BUFR(1),id%LBUFR,id%LBUFR_BYTES, + & id%INTARR(1), id%DBLARR(1), id%root, + & NELT, id%FRTPTR(1), + & id%FRTELT(1), id%COMM_LOAD, id%ASS_IRECV, SEUIL, + & SEUIL_LDLT_NIV2, id%MEM_DIST(0), + & id%DKEEP(1),id%PIVNUL_LIST(1),LPN_LIST) + IF ( MP . GT. 0 .and. KEEP(38) .ne. 0 ) THEN + WRITE( MP, 175 ) KEEP(49) + END IF + DEALLOCATE( IWK ) + DEALLOCATE( IWK8 ) + ENDIF + IF ( KEEP(55) .eq. 0 ) THEN + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + ELSE + DEALLOCATE( id%INTARR) + NULLIFY( id%INTARR ) + IF ( id%MYID_NODES .eq. MASTER + & .AND. KEEP(46) .eq. 1 + & .AND. KEEP(52) .eq. 0 ) THEN + NULLIFY( id%DBLARR ) + ELSE + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + END IF + END IF + IF ( KEEP(19) .NE. 0 ) THEN + IF ( KEEP(46) .NE. 1 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_RECV( KEEP(17), 1, MPI_INTEGER, 1, DEFIC_TAG, + & id%COMM, STATUS, IERR ) + ELSE IF ( id%MYID .EQ. 1 ) THEN + CALL MPI_SEND( KEEP(17), 1, MPI_INTEGER, 0, DEFIC_TAG, + & id%COMM, IERR ) + END IF + END IF + END IF + IF (associated(id%BUFR)) THEN + DEALLOCATE(id%BUFR) + NULLIFY(id%BUFR) + END IF + CALL CMUMPS_57( IERR ) + CALL CMUMPS_59( IERR ) + IF (KEEP(219).NE.0) THEN + CALL CMUMPS_620() + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + CALL CMUMPS_770(id) + IF (KEEP(201) .GT. 0) THEN + IF ((KEEP(201).EQ.1) .OR. (KEEP(201).EQ.2)) THEN + IF ( I_AM_SLAVE ) THEN + CALL CMUMPS_591(IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + ENDIF + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + END IF + END IF + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,180) TIME + END IF + PERLU_ON = .TRUE. + CALL CMUMPS_214( id%KEEP(1),id%KEEP8(1), + & id%MYID, N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .TRUE., id%KEEP(201), + & PERLU_ON, TOTAL_BYTES) + KEEP8(7) = TOTAL_BYTES + id%INFO(22) = TOTAL_MBYTES + IF ( MP .gt. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' ** Effective minimum Space in MBYTES for facto :', + & TOTAL_MBYTES + ENDIF + IF (I_AM_SLAVE) THEN + K67 = KEEP8(67) + ELSE + K67 = 0_8 + ENDIF + CALL MUMPS_735(K67,id%INFO(21)) + CALL CMUMPS_713(PROKG, MPG, K67, id%NSLAVES, + & id%COMM, "effective space used in S (KEEP8(67) =") + CALL MUMPS_243( id%MYID, id%COMM, + & TOTAL_MBYTES, id%INFOG(21), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Rank of processor needing largest memory :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Space in MBYTES used by this processor :', + & id%INFOG(21) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Avg. Space in MBYTES per working proc :', + & ( id%INFOG(22)-TOTAL_MBYTES ) / id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Avg. Space in MBYTES per working proc :', + & id%INFOG(22) / id%NSLAVES + END IF + END IF + KEEP(33) = INFO(11) + CALL MPI_REDUCE( RINFO(2), RINFOG(2), 2, + & MPI_REAL, + & MPI_SUM, MASTER, id%COMM, IERR) + KEEP(247) = 0 + CALL MPI_REDUCE( KEEP(246), KEEP(247), 1, MPI_INTEGER, + & MPI_MAX, MASTER, id%COMM, IERR) + CALL MPI_REDUCE( RINFO(2), RINFOG(2), 2, + & MPI_REAL, + & MPI_SUM, MASTER, id%COMM, IERR) + CALL MUMPS_646( KEEP8(31),KEEP8(6), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735(KEEP8(6), INFOG(9)) + CALL MPI_REDUCE( INFO(10), INFOG(10), 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + CALL MPI_ALLREDUCE( INFO(11), INFOG(11), 1, MPI_INTEGER, + & MPI_MAX, id%COMM, IERR) + KEEP(133) = INFOG(11) + CALL MPI_REDUCE( INFO(12), INFOG(12), 3, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + CALL MPI_REDUCE( KEEP(103), INFOG(25), 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + KEEP(229) = INFOG(25) + CALL MPI_REDUCE( KEEP(105), INFOG(25), 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + KEEP(230) = INFOG(25) + INFO(25) = KEEP(98) + CALL MPI_ALLREDUCE( INFO(25), INFOG(25), 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR) + CALL MUMPS_646( KEEP8(8), KEEP8(108), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735(KEEP8(10), INFO(27)) + CALL MUMPS_646( KEEP8(10),KEEP8(110), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735(KEEP8(110), INFOG(29)) + IF (KEEP(258).NE.0) THEN + IF (KEEP(260).EQ.-1) THEN + id%DKEEP(6)=-id%DKEEP(6) + id%DKEEP(7)=-id%DKEEP(7) + ENDIF + CALL CMUMPS_764( + & id%COMM, id%DKEEP(6), KEEP(259), + & RINFOG(12), INFOG(34), id%NPROCS) + IF (id%KEEP(50).EQ.0 .AND. id%MYID.EQ. MASTER) THEN + IF (id%KEEP(23).NE.0) THEN + CALL CMUMPS_767( + & RINFOG(12), id%N, + & id%STEP(1), + & id%UNS_PERM(1) ) + ENDIF + ENDIF + ENDIF + IF(KEEP(110) .EQ. 1) THEN + INFO(18) = KEEP(109) + CALL MPI_ALLREDUCE( KEEP(109), KEEP(112), 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR) + ELSE + INFO(18) = 0 + KEEP(109) = 0 + KEEP(112) = 0 + ENDIF + INFOG(28)=KEEP(112)+KEEP(17) + IF (KEEP(17) .NE. 0) THEN + IF (id%MYID .EQ. ID_ROOT) THEN + INFO(18)=INFO(18)+KEEP(17) + ENDIF + IF (ID_ROOT .EQ. MASTER) THEN + IF (id%MYID.EQ.MASTER) THEN + DO I=1, KEEP(17) + id%PIVNUL_LIST(KEEP(112)+I)=id%PIVNUL_LIST(KEEP(109)+I) + ENDDO + ENDIF + ELSE + IF (id%MYID .EQ. ID_ROOT) THEN + CALL MPI_SEND(id%PIVNUL_LIST(KEEP(109)+1), KEEP(17), + & MPI_INTEGER, MASTER, ZERO_PIV, + & id%COMM, IERR) + ELSE IF (id%MYID .EQ. MASTER) THEN + CALL MPI_RECV(id%PIVNUL_LIST(KEEP(112)+1), KEEP(17), + & MPI_INTEGER, ID_ROOT, ZERO_PIV, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + ENDIF + IF(KEEP(110) .EQ. 1) THEN + ALLOCATE(ITMP2(id%NPROCS),stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%NPROCS + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 490 + CALL MPI_GATHER ( KEEP(109),1, MPI_INTEGER, + & ITMP2(1), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + IF(id%MYID .EQ. MASTER) THEN + POSBUF = ITMP2(1)+1 + KEEP(220)=1 + DO I = 1,id%NPROCS-1 + CALL MPI_RECV(id%PIVNUL_LIST(POSBUF), ITMP2(I+1), + & MPI_INTEGER,I, + & ZERO_PIV, id%COMM, STATUS, IERR) + CALL MPI_SEND(POSBUF, 1, MPI_INTEGER, I, ZERO_PIV, + & id%COMM, IERR) + POSBUF = POSBUF + ITMP2(I+1) + ENDDO + ELSE + CALL MPI_SEND( id%PIVNUL_LIST(1), KEEP(109), MPI_INTEGER, + & MASTER,ZERO_PIV, id%COMM, IERR) + CALL MPI_RECV( KEEP(220), 1, MPI_INTEGER, MASTER, ZERO_PIV, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + 490 IF (allocated(ITMP2)) DEALLOCATE(ITMP2) + IF ( PROKG ) THEN + WRITE(MPG,99984) RINFOG(2),RINFOG(3),KEEP8(6),INFOG(10), + & INFOG(11), KEEP8(110) + IF (id%KEEP(50) == 0) THEN + WRITE(MPG, 99985) INFOG(12) + END IF + IF (id%KEEP(50) .NE. 1) THEN + WRITE(MPG, 99982) INFOG(13) + END IF + IF (KEEP(97) .NE. 0) THEN + WRITE(MPG, 99986) KEEP(98) + ENDIF + IF (id%KEEP(50) == 2) THEN + WRITE(MPG, 99988) KEEP(229) + WRITE(MPG, 99989) KEEP(230) + ENDIF + IF (KEEP(110) .NE.0) THEN + WRITE(MPG, 99991) KEEP(112) + ENDIF + IF ( KEEP(17) .ne. 0 ) + & WRITE(MPG, 99983) KEEP(17) + IF (KEEP(110).NE.0.OR.KEEP(17).NE.0) + & WRITE(MPG, 99992) KEEP(17)+KEEP(112) + WRITE(MPG, 99981) INFOG(14) + IF ((KEEP(201).EQ.0.OR.KEEP(201).EQ.2).AND. + & KEEP(50).EQ.0) THEN + WRITE(MPG, 99980) KEEP8(108) + ENDIF + IF ((KEEP(60).NE.0) .AND. INFOG(25).GT.0) THEN + WRITE(MPG, '(A)') + & " ** Warning Static pivoting was necessary" + WRITE(MPG, '(A)') + & " ** to factor interior variables with Schur ON" + ENDIF + IF (KEEP(258).NE.0) THEN + WRITE(MPG,99978) RINFOG(12) + WRITE(MPG,99979) RINFOG(13) + WRITE(MPG,99977) INFOG(34) + ENDIF + END IF + 500 CONTINUE + IF ( I_AM_SLAVE ) THEN + IF ((KEEP(201).EQ.1).OR.(KEEP(201).EQ.2)) THEN + CALL CMUMPS_592(id,IERR) + IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR + ENDIF + IF (WK_USER_PROVIDED) THEN + NULLIFY(id%S) + ELSE IF (KEEP(201).NE.0) THEN + IF (associated(id%S)) DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + ELSE + IF (WK_USER_PROVIDED) THEN + NULLIFY(id%S) + ELSE + IF (associated(id%S)) DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + END IF + END IF + 513 CONTINUE + IF ( I_AM_SLAVE ) THEN + CALL CMUMPS_183( INFO(1), IERR ) + IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + 530 CONTINUE + IF (RHS_MUMPS_ALLOCATED) DEALLOCATE(RHS_MUMPS) + NULLIFY(RHS_MUMPS) + id%KEEP(13) = KEEP13_SAVE + RETURN + 120 FORMAT(/' LOCAL REDISTRIB: DATA LOCAL/SENT =',I12,I12) + 125 FORMAT(/' REDISTRIB: TOTAL DATA LOCAL/SENT =',I12,I12) + 130 FORMAT(/' ****** FACTORIZATION STEP ********'/) + 160 FORMAT(' GLOBAL TIME FOR MATRIX DISTRIBUTION =',F12.4) + 165 FORMAT(' Convergence error after scaling for INF-NORM', + & ' (option 7/8) =',D9.2) + 166 FORMAT(' Convergence error after scaling for ONE-NORM', + & ' (option 7/8) =',D9.2) + 170 FORMAT(/' STATISTICS PRIOR NUMERICAL FACTORIZATION ...'/ + & ' Size of internal working array S =',I12/ + & ' Size of internal working array IS =',I12/ + & ' MINIMUM (ICNTL(14)=0) size of S =',I12/ + & ' MINIMUM (ICNTL(14)=0) size of IS =',I12/ + & ' REAL SPACE FOR ORIGINAL MATRIX =',I12/ + & ' INTEGER SPACE FOR ORIGINAL MATRIX =',I12/ + & ' REAL SPACE FOR FACTORS =',I12/ + & ' INTEGER SPACE FOR FACTORS =',I12/ + & ' MAXIMUM FRONTAL SIZE (ESTIMATED) =',I12) + 172 FORMAT(/' GLOBAL STATISTICS PRIOR NUMERICAL FACTORIZATION ...'/ + & ' NUMBER OF WORKING PROCESSES =',I12/ + & ' OUT-OF-CORE OPTION (ICNTL(22)) =',I12/ + & ' REAL SPACE FOR FACTORS =',I12/ + & ' INTEGER SPACE FOR FACTORS =',I12/ + & ' MAXIMUM FRONTAL SIZE (ESTIMATED) =',I12/ + & ' NUMBER OF NODES IN THE TREE =',I12) + 173 FORMAT( ' PERFORM FORWARD DURING FACTO, NRHS =',I12) + 175 FORMAT(/' NUMBER OF ENTRIES FOR // ROOT =',I12) + 180 FORMAT(/' ELAPSED TIME FOR FACTORIZATION =',F12.4) +99977 FORMAT( ' INFOG(34) DETERMINANT (base 2 exponent) =',I12) +99978 FORMAT( ' RINFOG(12) DETERMINANT (real part) =',F12.4) +99979 FORMAT( ' RINFOG(12) DETERMINANT (imaginary part) =',F12.4) +99980 FORMAT( ' KEEP8(108) Extra copies IP stacking =',I12) +99981 FORMAT( ' INFOG(14) NUMBER OF MEMORY COMPRESS =',I12) +99982 FORMAT( ' INFOG(13) NUMBER OF DELAYED PIVOTS =',I12) +99983 FORMAT( ' NB OF NULL PIVOTS DETECTED BY ICNTL(16) =',I12) +99991 FORMAT( ' NB OF NULL PIVOTS DETECTED BY ICNTL(24) =',I12) +99992 FORMAT( ' INFOG(28) ESTIMATED DEFICIENCY =',I12) +99984 FORMAT(/' GLOBAL STATISTICS '/ + & ' RINFOG(2) OPERATIONS IN NODE ASSEMBLY =',1PD10.3/ + & ' ------(3) OPERATIONS IN NODE ELIMINATION=',1PD10.3/ + & ' INFOG (9) REAL SPACE FOR FACTORS =',I12/ + & ' INFOG(10) INTEGER SPACE FOR FACTORS =',I12/ + & ' INFOG(11) MAXIMUM FRONT SIZE =',I12/ + & ' INFOG(29) NUMBER OF ENTRIES IN FACTORS =',I12) +99985 FORMAT( ' INFOG(12) NB OF OFF DIAGONAL PIVOTS =',I12) +99986 FORMAT( ' INFOG(25) NB TINY PIVOTS/STATIC PIVOTING =',I12) +99988 FORMAT( ' NUMBER OF 2x2 PIVOTS in type 1 nodes =',I12) +99989 FORMAT( ' NUMBER OF 2x2 PIVOTS in type 2 nodes =',I12) + END SUBROUTINE CMUMPS_142 + SUBROUTINE CMUMPS_713(PROKG, MPG, VAL, NSLAVES, + & COMM, MSG) + IMPLICIT NONE + INCLUDE 'mpif.h' + LOGICAL PROKG + INTEGER MPG + INTEGER(8) VAL + INTEGER NSLAVES + INTEGER COMM + CHARACTER*42 MSG + INTEGER(8) MAX_VAL + INTEGER IERR, MASTER + REAL LOC_VAL, AVG_VAL + PARAMETER(MASTER=0) + CALL MUMPS_646( VAL, MAX_VAL, MPI_MAX, MASTER, COMM) + LOC_VAL = real(VAL)/real(NSLAVES) + CALL MPI_REDUCE( LOC_VAL, AVG_VAL, 1, MPI_REAL, + & MPI_SUM, MASTER, COMM, IERR ) + IF (PROKG) THEN + WRITE(MPG,100) " Maximum ", MSG, MAX_VAL + WRITE(MPG,100) " Average ", MSG, int(AVG_VAL,8) + ENDIF + RETURN + 100 FORMAT(A9,A42,I12) + END SUBROUTINE CMUMPS_713 + SUBROUTINE CMUMPS_770(id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(CMUMPS_STRUC) :: id + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INCLUDE 'mumps_headers.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER IERR, MASTER + PARAMETER( MASTER = 0 ) + INTEGER :: ID_SCHUR, SIZE_SCHUR, LD_SCHUR, IB, BL4 + INTEGER :: ROW_LENGTH, I + INTEGER(8) :: SURFSCHUR8, BL8, SHIFT8 + INTEGER(8) :: ISCHUR_SRC, ISCHUR_DEST, ISCHUR_SYM, ISCHUR_UNS + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + IF (id%INFO(1) .LT. 0) RETURN + IF (id%KEEP(60) .EQ. 0) RETURN + ID_SCHUR =MUMPS_275( + & id%PROCNODE_STEPS(id%STEP(max(id%KEEP(20),id%KEEP(38)))), + & id%NSLAVES) + IF ( id%KEEP( 46 ) .NE. 1 ) THEN + ID_SCHUR = ID_SCHUR + 1 + END IF + IF (id%MYID.EQ.ID_SCHUR) THEN + IF (id%KEEP(60).EQ.1) THEN + LD_SCHUR = + & id%IS(id%PTLUST_S(id%STEP(id%KEEP(20)))+2+id%KEEP(IXSZ)) + SIZE_SCHUR = LD_SCHUR - id%KEEP(253) + ELSE + LD_SCHUR = -999999 + SIZE_SCHUR = id%root%TOT_ROOT_SIZE + ENDIF + ELSE IF (id%MYID .EQ. MASTER) THEN + SIZE_SCHUR = id%KEEP(116) + LD_SCHUR = -44444 + ELSE + RETURN + ENDIF + SURFSCHUR8 = int(SIZE_SCHUR,8)*int(SIZE_SCHUR,8) + IF (id%KEEP(60) .GT. 1) THEN + IF (id%KEEP(221).EQ.1) THEN + DO I = 1, id%KEEP(253) + IF (ID_SCHUR.EQ.MASTER) THEN + CALL ccopy(SIZE_SCHUR, + & id%root%RHS_CNTR_MASTER_ROOT((I-1)*SIZE_SCHUR+1), 1, + & id%REDRHS((I-1)*id%LREDRHS+1), 1) + ELSE + IF (id%MYID.EQ.ID_SCHUR) THEN + CALL MPI_SEND( + & id%root%RHS_CNTR_MASTER_ROOT((I-1)*SIZE_SCHUR+1), + & SIZE_SCHUR, + & MPI_COMPLEX, + & MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE + CALL MPI_RECV( id%REDRHS((I-1)*id%LREDRHS+1), + & SIZE_SCHUR, + & MPI_COMPLEX, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + ENDDO + IF (id%MYID.EQ.ID_SCHUR) THEN + DEALLOCATE(id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY (id%root%RHS_CNTR_MASTER_ROOT) + ENDIF + ENDIF + RETURN + ENDIF + IF (id%KEEP(252).EQ.0) THEN + IF ( ID_SCHUR .EQ. MASTER ) THEN + CALL CMUMPS_756( SURFSCHUR8, + & id%S(id%PTRFAC(id%STEP(id%KEEP(20)))), + & id%SCHUR(1) ) + ELSE + BL8=int(huge(BL4)/id%KEEP(35)/10,8) + DO IB=1, int((SURFSCHUR8+BL8-1_8) / BL8) + SHIFT8 = int(IB-1,8) * BL8 + BL4 = int(min(BL8,SURFSCHUR8-SHIFT8)) + IF ( id%MYID .eq. ID_SCHUR ) THEN + CALL MPI_SEND( id%S( SHIFT8 + + & id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ)))), + & BL4, + & MPI_COMPLEX, + & MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_RECV( id%SCHUR(1_8 + SHIFT8), + & BL4, + & MPI_COMPLEX, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + END IF + ENDDO + END IF + ELSE + ISCHUR_SRC = id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ))) + ISCHUR_DEST= 1_8 + DO I=1, SIZE_SCHUR + ROW_LENGTH = SIZE_SCHUR + IF (ID_SCHUR.EQ.MASTER) THEN + CALL ccopy(ROW_LENGTH, id%S(ISCHUR_SRC), 1, + & id%SCHUR(ISCHUR_DEST),1) + ELSE + IF (id%MYID.EQ.ID_SCHUR) THEN + CALL MPI_SEND( id%S(ISCHUR_SRC), ROW_LENGTH, + & MPI_COMPLEX, + & MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE + CALL MPI_RECV( id%SCHUR(ISCHUR_DEST), + & ROW_LENGTH, + & MPI_COMPLEX, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + ISCHUR_SRC = ISCHUR_SRC+int(LD_SCHUR,8) + ISCHUR_DEST= ISCHUR_DEST+int(SIZE_SCHUR,8) + ENDDO + IF (id%KEEP(221).EQ.1) THEN + ISCHUR_SYM = id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ))) + int(SIZE_SCHUR,8) * + & int(LD_SCHUR,8) + ISCHUR_UNS = + & id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ))) + int(SIZE_SCHUR,8) + ISCHUR_DEST = 1_8 + DO I = 1, id%KEEP(253) + IF (ID_SCHUR .EQ. MASTER) THEN + IF (id%KEEP(50) .EQ. 0) THEN + CALL ccopy(SIZE_SCHUR, id%S(ISCHUR_UNS), LD_SCHUR, + & id%REDRHS(ISCHUR_DEST), 1) + ELSE + CALL ccopy(SIZE_SCHUR, id%S(ISCHUR_SYM), 1, + & id%REDRHS(ISCHUR_DEST), 1) + ENDIF + ELSE + IF (id%MYID .NE. MASTER) THEN + IF (id%KEEP(50) .EQ. 0) THEN + CALL ccopy(SIZE_SCHUR, id%S(ISCHUR_UNS), LD_SCHUR, + & id%S(ISCHUR_SYM), 1) + ENDIF + CALL MPI_SEND(id%S(ISCHUR_SYM), SIZE_SCHUR, + & MPI_COMPLEX, MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE + CALL MPI_RECV(id%REDRHS(ISCHUR_DEST), + & SIZE_SCHUR, MPI_COMPLEX, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + IF (id%KEEP(50).EQ.0) THEN + ISCHUR_UNS = ISCHUR_UNS + int(LD_SCHUR,8) + ELSE + ISCHUR_SYM = ISCHUR_SYM + int(LD_SCHUR,8) + ENDIF + ISCHUR_DEST = ISCHUR_DEST + int(id%LREDRHS,8) + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_770 + SUBROUTINE CMUMPS_83 + & ( N, MAPPING, NZ, IRN, JCN, PROCNODE, STEP, + & SLAVEF, PERM, FILS, + & RG2L, KEEP,KEEP8, MBLOCK, NBLOCK, NPROW, NPCOL ) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N, NZ, SLAVEF, MBLOCK, NBLOCK, NPROW, NPCOL + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IRN( NZ ), JCN( NZ ) + INTEGER MAPPING( NZ ), STEP( N ) + INTEGER PROCNODE( KEEP(28) ), PERM( N ), FILS( N ), RG2L( N ) + INTEGER MUMPS_275, MUMPS_330 + EXTERNAL MUMPS_275, MUMPS_330 + INTEGER K, IOLD, JOLD, INEW, JNEW, ISEND, JSEND, IARR, INODE + INTEGER TYPE_NODE, DEST + INTEGER IPOSROOT, JPOSROOT, IROW_GRID, JCOL_GRID + INODE = KEEP(38) + K = 1 + DO WHILE ( INODE .GT. 0 ) + RG2L( INODE ) = K + INODE = FILS( INODE ) + K = K + 1 + END DO + DO K = 1, NZ + IOLD = IRN( K ) + JOLD = JCN( K ) + IF ( IOLD .GT. N .OR. IOLD .LT. 1 .OR. + & JOLD .GT. N .OR. JOLD .LT. 1 ) THEN + MAPPING( K ) = -1 + CYCLE + END IF + IF ( IOLD .eq. JOLD ) THEN + ISEND = IOLD + JSEND = JOLD + ELSE + INEW = PERM( IOLD ) + JNEW = PERM( JOLD ) + IF ( INEW .LT. JNEW ) THEN + ISEND = IOLD + IF ( KEEP(50) .ne. 0 ) ISEND = -IOLD + JSEND = JOLD + ELSE + ISEND = -JOLD + JSEND = IOLD + END IF + END IF + IARR = abs( ISEND ) + TYPE_NODE = MUMPS_330( PROCNODE(abs(STEP(IARR))), + & SLAVEF ) + IF ( TYPE_NODE .eq. 1 .or. TYPE_NODE .eq. 2 ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + DEST = MUMPS_275( PROCNODE(abs(STEP(IARR))), + & SLAVEF ) + 1 + ELSE + DEST = MUMPS_275( PROCNODE(abs(STEP(IARR))), + & SLAVEF ) + END IF + ELSE + IF ( ISEND .LT. 0 ) THEN + IPOSROOT = RG2L( JSEND ) + JPOSROOT = RG2L( IARR ) + ELSE + IPOSROOT = RG2L( IARR ) + JPOSROOT = RG2L( JSEND ) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/MBLOCK, NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/NBLOCK, NPCOL ) + IF ( KEEP( 46 ) .eq. 0 ) THEN + DEST = IROW_GRID * NPCOL + JCOL_GRID + 1 + ELSE + DEST = IROW_GRID * NPCOL + JCOL_GRID + END IF + END IF + MAPPING( K ) = DEST + END DO + RETURN + END SUBROUTINE CMUMPS_83 + SUBROUTINE CMUMPS_282( + & N, NZ_loc, id, + & DBLARR, LDBLARR, INTARR, LINTARR, + & PTRAIW, PTRARW, KEEP,KEEP8, MYID, COMM, NBRECORDS, + & + & A, LA, root, PROCNODE_STEPS, SLAVEF, PERM, STEP, + & ICNTL, INFO, NSEND, NLOCAL, + & ISTEP_TO_INIV2, CANDIDATES + & ) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N, NZ_loc + TYPE (CMUMPS_STRUC) :: id + INTEGER LDBLARR, LINTARR + COMPLEX DBLARR( LDBLARR ) + INTEGER INTARR( LINTARR ) + INTEGER PTRAIW( N ), PTRARW( N ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER MYID, COMM, NBRECORDS + INTEGER(8) :: LA + INTEGER SLAVEF + INTEGER ISTEP_TO_INIV2(KEEP(71)) + INTEGER CANDIDATES(SLAVEF+1, max(1,KEEP(56))) + COMPLEX A( LA ) + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER PROCNODE_STEPS(KEEP(28)), PERM( N ), STEP( N ) + INTEGER INFO( 40 ), ICNTL(40) + INTEGER MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + INCLUDE 'mumps_tags.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ), MSGSOU + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IW4 + INTEGER END_MSG_2_RECV + INTEGER I, K, I1, IA + INTEGER TYPE_NODE, DEST + INTEGER IOLD, JOLD, IARR, ISEND, JSEND, INEW, JNEW + INTEGER allocok, TYPESPLIT, T4MASTER, INIV2 + LOGICAL T4_MASTER_CONCERNED + COMPLEX VAL + INTEGER(8) :: PTR_ROOT + INTEGER LOCAL_M, LOCAL_N, ARROW_ROOT + INTEGER IROW_GRID, JCOL_GRID, IPOSROOT, JPOSROOT + INTEGER MP,LP + INTEGER KPROBE, FREQPROBE + INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: BUFI + COMPLEX, ALLOCATABLE, DIMENSION(:,:,:) :: BUFR + INTEGER, ALLOCATABLE, DIMENSION(:) :: BUFRECI + COMPLEX, ALLOCATABLE, DIMENSION(:) :: BUFRECR + INTEGER IACT( SLAVEF ), IREQI( SLAVEF ), IREQR( SLAVEF ) + LOGICAL SEND_ACTIVE( SLAVEF ) + LOGICAL FLAG + INTEGER NSEND, NLOCAL + INTEGER MASTER_NODE, ISTEP + NSEND = 0 + NLOCAL = 0 + LP = ICNTL(1) + MP = ICNTL(2) + END_MSG_2_RECV = SLAVEF + ALLOCATE( BUFI( NBRECORDS * 2 + 1, 2, SLAVEF ), stat=allocok) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating int buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = ( NBRECORDS * 2 + 1 ) * SLAVEF * 2 + END IF + ALLOCATE( BUFR( NBRECORDS, 2, SLAVEF), stat = allocok) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating real buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = NBRECORDS * SLAVEF * 2 + GOTO 20 + END IF + ALLOCATE( BUFRECI( NBRECORDS * 2 + 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating int recv buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = NBRECORDS * 2 + 1 + GOTO 20 + END IF + ALLOCATE( BUFRECR( NBRECORDS ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating int recv buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = NBRECORDS + GOTO 20 + END IF + ALLOCATE( IW4( N, 2 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(LP,*) '** Error allocating IW4 for matrix distribution' + INFO(1) = -13 + INFO(2) = N * 2 + END IF + 20 CONTINUE + CALL MUMPS_276( ICNTL, INFO, COMM, MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + ARROW_ROOT = 0 + DO I = 1, N + I1 = PTRAIW( I ) + IA = PTRARW( I ) + IF ( IA .GT. 0 ) THEN + DBLARR( IA ) = ZERO + IW4( I, 1 ) = INTARR( I1 ) + IW4( I, 2 ) = -INTARR( I1 + 1 ) + INTARR( I1 + 2 ) = I + END IF + END DO + IF ( KEEP(38) .NE. 0 ) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I = 1, root%SCHUR_NLOC + root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1: + & (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC) = ZERO + ENDDO + ENDIF + END IF + DO I = 1, SLAVEF + BUFI( 1, 1, I ) = 0 + END DO + DO I = 1, SLAVEF + BUFI( 1, 2, I ) = 0 + END DO + DO I = 1, SLAVEF + SEND_ACTIVE( I ) = .FALSE. + IACT( I ) = 1 + END DO + KPROBE = 0 + FREQPROBE = max(1,NBRECORDS/10) + DO K = 1, NZ_loc + KPROBE = KPROBE + 1 + IF ( KPROBE .eq. FREQPROBE ) THEN + KPROBE = 0 + CALL MPI_IPROBE( MPI_ANY_SOURCE, ARR_INT, COMM, + & FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + MSGSOU = STATUS( MPI_SOURCE ) + CALL MPI_RECV( BUFRECI(1), NBRECORDS * 2 + 1, + & MPI_INTEGER, + & MSGSOU, ARR_INT, COMM, STATUS, IERR ) + CALL MPI_RECV( BUFRECR(1), NBRECORDS, MPI_COMPLEX, + & MSGSOU, ARR_REAL, COMM, STATUS, IERR ) + CALL CMUMPS_102( + & BUFRECI, BUFRECR, NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END IF + END IF + IOLD = id%IRN_loc(K) + JOLD = id%JCN_loc(K) + IF ( (IOLD.GT.N).OR.(JOLD.GT.N).OR.(IOLD.LT.1) + & .OR.(JOLD.LT.1) ) CYCLE + VAL = id%A_loc(K) + IF ((KEEP(52).EQ.7).OR.(KEEP(52).EQ.8)) THEN + VAL = VAL * id%ROWSCA(IOLD)*id%COLSCA(JOLD) + ENDIF + IF (IOLD.EQ.JOLD) THEN + ISEND = IOLD + JSEND = JOLD + ELSE + INEW = PERM(IOLD) + JNEW = PERM(JOLD) + IF (INEW.LT.JNEW) THEN + ISEND = IOLD + IF ( KEEP(50) .NE. 0 ) ISEND = -IOLD + JSEND = JOLD + ELSE + ISEND = -JOLD + JSEND = IOLD + ENDIF + ENDIF + IARR = abs( ISEND ) + ISTEP = abs(STEP(IARR)) + TYPE_NODE = MUMPS_330( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + MASTER_NODE= MUMPS_275( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + TYPESPLIT = MUMPS_810( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + T4_MASTER_CONCERNED = .FALSE. + T4MASTER = -9999 + IF (TYPE_NODE.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + T4_MASTER_CONCERNED = .TRUE. + T4MASTER=CANDIDATES(CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + ENDIF + ENDIF + IF ( TYPE_NODE .eq. 1 ) THEN + DEST = MASTER_NODE + ELSE IF ( TYPE_NODE .eq. 2 ) THEN + IF ( ISEND .LT. 0 ) THEN + DEST = -1 + ELSE + DEST = MASTER_NODE + END IF + ELSE + IF ( ISEND < 0 ) THEN + IPOSROOT = root%RG2L_ROW(JSEND) + JPOSROOT = root%RG2L_ROW(IARR ) + ELSE + IPOSROOT = root%RG2L_ROW(IARR ) + JPOSROOT = root%RG2L_ROW(JSEND) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, root%NPCOL ) + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + END IF + if (DEST .eq. -1) then + NLOCAL = NLOCAL + 1 + NSEND = NSEND + SLAVEF -1 + else + if (DEST .eq.MYID ) then + NLOCAL = NLOCAL + 1 + else + NSEND = NSEND + 1 + endif + end if + IF ( DEST.EQ.-1) THEN + DO I=1, CANDIDATES(SLAVEF+1,ISTEP_TO_INIV2(ISTEP)) + DEST=CANDIDATES(I,ISTEP_TO_INIV2(ISTEP)) + CALL CMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + ENDDO + DEST=MASTER_NODE + CALL CMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + IF (T4_MASTER_CONCERNED) THEN + DEST = T4MASTER + CALL CMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + ENDIF + ELSE + CALL CMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + IF (T4_MASTER_CONCERNED) THEN + DEST = T4MASTER + CALL CMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + ENDIF + ENDIF + END DO + DEST = -2 + CALL CMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, + & IW4(1,1), root, KEEP,KEEP8 ) + DO WHILE ( END_MSG_2_RECV .NE. 0 ) + CALL MPI_RECV( BUFRECI(1), NBRECORDS * 2 + 1, MPI_INTEGER, + & MPI_ANY_SOURCE, ARR_INT, COMM, STATUS, IERR ) + MSGSOU = STATUS( MPI_SOURCE ) + CALL MPI_RECV( BUFRECR(1), NBRECORDS, MPI_COMPLEX, + & MSGSOU, ARR_REAL, COMM, STATUS, IERR ) + CALL CMUMPS_102( + & BUFRECI, BUFRECR, NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END DO + DO I = 1, SLAVEF + IF ( SEND_ACTIVE( I ) ) THEN + CALL MPI_WAIT( IREQI( I ), STATUS, IERR ) + CALL MPI_WAIT( IREQR( I ), STATUS, IERR ) + END IF + END DO + KEEP(49) = ARROW_ROOT + DEALLOCATE( IW4 ) + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + DEALLOCATE( BUFRECI ) + DEALLOCATE( BUFRECR ) + RETURN + END SUBROUTINE CMUMPS_282 + SUBROUTINE CMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, N, + & PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4, root, + & KEEP,KEEP8 ) + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER ISEND, JSEND, DEST, NBRECORDS, SLAVEF, COMM, MYID, N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER ARROW_ROOT, END_MSG_2_RECV, LOCAL_M, LOCAL_N + INTEGER LINTARR, LDBLARR + INTEGER(8) :: LA, PTR_ROOT + INTEGER BUFI( NBRECORDS * 2 + 1, 2, SLAVEF ) + INTEGER BUFRECI( NBRECORDS * 2 + 1 ) + INTEGER IREQI(SLAVEF), IREQR(SLAVEF), IACT(SLAVEF) + INTEGER IW4( N, 2 ) + INTEGER PTRAIW( N ), PTRARW( N ), PERM( N ), STEP( N ) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER INTARR( LINTARR ) + COMPLEX DBLARR( LDBLARR ), A( LA ) + LOGICAL SEND_ACTIVE(SLAVEF) + COMPLEX BUFR( NBRECORDS, 2, SLAVEF ) + COMPLEX BUFRECR( NBRECORDS ) + COMPLEX VAL + INTEGER ISLAVE, IBEG, IEND, NBREC, IREQ + INTEGER TAILLE_SEND_I, TAILLE_SEND_R, MSGSOU + LOGICAL FLAG, SEND_LOCAL + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, STATUS(MPI_STATUS_SIZE) + IF ( DEST .eq. -2 ) THEN + IBEG = 1 + IEND = SLAVEF + ELSE + IBEG = DEST + 1 + IEND = DEST + 1 + END IF + SEND_LOCAL = .FALSE. + DO ISLAVE = IBEG, IEND + NBREC = BUFI(1,IACT(ISLAVE),ISLAVE) + IF ( DEST .eq. -2 ) THEN + BUFI(1,IACT(ISLAVE),ISLAVE) = - NBREC + END IF + IF ( DEST .eq. -2 .or. NBREC + 1 > NBRECORDS ) THEN + DO WHILE ( SEND_ACTIVE( ISLAVE ) ) + CALL MPI_TEST( IREQR( ISLAVE ), FLAG, STATUS, IERR ) + IF ( .NOT. FLAG ) THEN + CALL MPI_IPROBE( MPI_ANY_SOURCE, ARR_INT, COMM, + & FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + MSGSOU = STATUS(MPI_SOURCE) + CALL MPI_RECV( BUFRECI(1), 2*NBRECORDS+1, + & MPI_INTEGER, MSGSOU, ARR_INT, COMM, + & STATUS, IERR ) + CALL MPI_RECV( BUFRECR(1), NBRECORDS, + & MPI_COMPLEX, MSGSOU, + & ARR_REAL, COMM, STATUS, IERR ) + CALL CMUMPS_102( + & BUFRECI, BUFRECR, NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END IF + ELSE + CALL MPI_WAIT( IREQI( ISLAVE ), STATUS, IERR ) + SEND_ACTIVE( ISLAVE ) = .FALSE. + END IF + END DO + IF ( ISLAVE - 1 .ne. MYID ) THEN + TAILLE_SEND_I = NBREC * 2 + 1 + TAILLE_SEND_R = NBREC + CALL MPI_ISEND( BUFI(1, IACT(ISLAVE), ISLAVE ), + & TAILLE_SEND_I, + & MPI_INTEGER, ISLAVE - 1, ARR_INT, COMM, + & IREQI( ISLAVE ), IERR ) + CALL MPI_ISEND( BUFR(1, IACT(ISLAVE), ISLAVE ), + & TAILLE_SEND_R, + & MPI_COMPLEX, ISLAVE - 1, ARR_REAL, COMM, + & IREQR( ISLAVE ), IERR ) + SEND_ACTIVE( ISLAVE ) = .TRUE. + ELSE + SEND_LOCAL = .TRUE. + END IF + IACT( ISLAVE ) = 3 - IACT( ISLAVE ) + BUFI( 1, IACT( ISLAVE ), ISLAVE ) = 0 + END IF + IF ( DEST .ne. -2 ) THEN + IREQ = BUFI(1,IACT(ISLAVE),ISLAVE) + 1 + BUFI(1,IACT(ISLAVE),ISLAVE) = IREQ + BUFI(IREQ*2,IACT(ISLAVE),ISLAVE) = ISEND + BUFI(IREQ*2+1,IACT(ISLAVE),ISLAVE) = JSEND + BUFR(IREQ,IACT(ISLAVE),ISLAVE ) = VAL + END IF + END DO + IF ( SEND_LOCAL ) THEN + ISLAVE = MYID + 1 + CALL CMUMPS_102( + & BUFI(1,3-IACT(ISLAVE),ISLAVE), + & BUFR(1,3-IACT(ISLAVE),ISLAVE), + & NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END IF + RETURN + END SUBROUTINE CMUMPS_101 + SUBROUTINE CMUMPS_102 + & ( BUFI, BUFR, NBRECORDS, N, IW4, + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, + & SLAVEF, ARROW_ROOT, + & PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR ) + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER NBRECORDS, N, ARROW_ROOT, MYID, SLAVEF + INTEGER BUFI( NBRECORDS * 2 + 1 ) + COMPLEX BUFR( NBRECORDS ) + INTEGER IW4( N, 2 ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER END_MSG_2_RECV + INTEGER PTRAIW( N ), PTRARW( N ), PERM( N ), STEP( N ) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER LINTARR, LDBLARR + INTEGER INTARR( LINTARR ) + INTEGER LOCAL_M, LOCAL_N + INTEGER(8) :: PTR_ROOT, LA + COMPLEX A( LA ), DBLARR( LDBLARR ) + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER IREC, NB_REC, NODE_TYPE, IPROC + INTEGER IPOSROOT, JPOSROOT, IROW_GRID, JCOL_GRID, + & ILOCROOT, JLOCROOT + INTEGER IA, IS1, ISHIFT, IIW, IS, IAS, IARR, JARR + INTEGER TAILLE + COMPLEX VAL + NB_REC = BUFI( 1 ) + IF ( NB_REC .LE. 0 ) THEN + END_MSG_2_RECV = END_MSG_2_RECV - 1 + NB_REC = - NB_REC + END IF + IF ( NB_REC .eq. 0 ) GOTO 100 + DO IREC = 1, NB_REC + IARR = BUFI( IREC * 2 ) + JARR = BUFI( IREC * 2 + 1 ) + VAL = BUFR( IREC ) + NODE_TYPE = MUMPS_330( + & PROCNODE_STEPS(abs(STEP(abs( IARR )))), + & SLAVEF ) + IF ( NODE_TYPE .eq. 3 ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + IF ( IARR .GT. 0 ) THEN + IPOSROOT = root%RG2L_ROW( IARR ) + JPOSROOT = root%RG2L_COL( JARR ) + ELSE + IPOSROOT = root%RG2L_ROW( JARR ) + JPOSROOT = root%RG2L_COL( -IARR ) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, root%NPCOL ) + IF ( IROW_GRID .NE. root%MYROW .OR. + & JCOL_GRID .NE. root%MYCOL ) THEN + WRITE(*,*) MYID,':INTERNAL Error: recvd root arrowhead ' + WRITE(*,*) MYID,':not belonging to me. IARR,JARR=',IARR,JARR + WRITE(*,*) MYID,':IROW_GRID,JCOL_GRID=',IROW_GRID,JCOL_GRID + WRITE(*,*) MYID,':MYROW, MYCOL=', root%MYROW, root%MYCOL + WRITE(*,*) MYID,':IPOSROOT,JPOSROOT=', IPOSROOT, JPOSROOT + CALL MUMPS_ABORT() + END IF + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8) + & + int(ILOCROOT-1,8)) = A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + ELSE IF (IARR.GE.0) THEN + IF (IARR.EQ.JARR) THEN + IA = PTRARW(IARR) + DBLARR(IA) = DBLARR(IA) + VAL + ELSE + IS1 = PTRAIW(IARR) + ISHIFT = INTARR(IS1) + IW4(IARR,2) + IW4(IARR,2) = IW4(IARR,2) - 1 + IIW = IS1 + ISHIFT + 2 + INTARR(IIW) = JARR + IS = PTRARW(IARR) + IAS = IS + ISHIFT + DBLARR(IAS) = VAL + ENDIF + ELSE + IARR = -IARR + ISHIFT = PTRAIW(IARR)+IW4(IARR,1)+2 + INTARR(ISHIFT) = JARR + IAS = PTRARW(IARR)+IW4(IARR,1) + IW4(IARR,1) = IW4(IARR,1) - 1 + DBLARR(IAS) = VAL + IPROC = MUMPS_275( PROCNODE_STEPS(abs(STEP(IARR))), + & SLAVEF ) + IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0) + & .AND. + & IW4(IARR,1) .EQ. 0 .AND. + & IPROC .EQ. MYID + & .AND. STEP(IARR) > 0 ) THEN + TAILLE = INTARR( PTRAIW(IARR) ) + CALL CMUMPS_310( N, PERM, + & INTARR( PTRAIW(IARR) + 3 ), + & DBLARR( PTRARW(IARR) + 1 ), + & TAILLE, 1, TAILLE ) + END IF + ENDIF + ENDDO + 100 CONTINUE + RETURN + END SUBROUTINE CMUMPS_102 + SUBROUTINE CMUMPS_151( NRHS, N, KEEP28, IWCB, LIWW, + & W, LWC, + & POSWCB,IWPOSCB,PTRICB,PTRACB) + IMPLICIT NONE + INTEGER NRHS, N,LIWW,LWC,POSWCB,IWPOSCB, KEEP28 + INTEGER IWCB(LIWW),PTRICB(KEEP28),PTRACB(KEEP28) + COMPLEX W(LWC) + INTEGER SIZFI, SIZFR + IF ( IWPOSCB .eq. LIWW ) RETURN + DO WHILE ( IWCB( IWPOSCB + 2 ) .eq. 0 ) + SIZFR = IWCB( IWPOSCB + 1 ) + SIZFI = 2 + SIZFR = SIZFR * NRHS + IWPOSCB = IWPOSCB + SIZFI + POSWCB = POSWCB + SIZFR + IF ( IWPOSCB .eq. LIWW ) RETURN + END DO + RETURN + END SUBROUTINE CMUMPS_151 + SUBROUTINE CMUMPS_95(NRHS,N,KEEP28,IWCB,LIWW,W,LWC, + & POSWCB,IWPOSCB,PTRICB,PTRACB) + IMPLICIT NONE + INTEGER NRHS,N,LIWW,LWC,POSWCB,IWPOSCB,KEEP28 + INTEGER IWCB(LIWW),PTRICB(KEEP28),PTRACB(KEEP28) + COMPLEX W(LWC) + INTEGER IPTIW,IPTA,SIZFI,SIZFR,LONGI,LONGR + INTEGER I + IPTIW = IWPOSCB + IPTA = POSWCB + LONGI = 0 + LONGR = 0 + IF ( IPTIW .EQ. LIWW ) RETURN +10 CONTINUE + IF (IWCB(IPTIW+2).EQ.0) THEN + SIZFR = IWCB(IPTIW+1) + SIZFI = 2 + SIZFR = SIZFR * NRHS + IF (LONGI.NE.0) THEN + DO 20 I=0,LONGI-1 + IWCB(IPTIW + SIZFI - I) = IWCB (IPTIW - I ) + 20 CONTINUE + DO 30 I=0,LONGR-1 + W(IPTA + SIZFR - I) = W(IPTA - I ) + 30 CONTINUE + ENDIF + DO 40 I=1,KEEP28 + IF ((PTRICB(I).LE.(IPTIW+1)).AND. + & (PTRICB(I).GT.IWPOSCB) ) THEN + PTRICB(I) = PTRICB(I) + SIZFI + PTRACB(I) = PTRACB(I) + SIZFR + ENDIF +40 CONTINUE + IWPOSCB = IWPOSCB + SIZFI + IPTIW = IPTIW + SIZFI + POSWCB = POSWCB + SIZFR + IPTA = IPTA + SIZFR + ELSE + SIZFR = IWCB(IPTIW+1) + SIZFI = 2 + SIZFR = SIZFR * NRHS + IPTIW = IPTIW + SIZFI + LONGI = LONGI + SIZFI + IPTA = IPTA + SIZFR + LONGR = LONGR + SIZFR + ENDIF + IF (IPTIW.NE.LIWW) GOTO 10 + RETURN + END SUBROUTINE CMUMPS_95 + SUBROUTINE CMUMPS_205(MTYPE, IFLAG, N, NZ, + & LHS, WRHS, W, RHS, GIVSOL, SOL, ANORM, XNORM, SCLNRM, + & MPRINT, ICNTL, KEEP,KEEP8) + INTEGER MTYPE,N,NZ,IFLAG,ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + COMPLEX RHS(N),LHS(N) + COMPLEX WRHS(N),SOL(*) + REAL W(N) + REAL RESMAX,RESL2,XNORM, ERMAX,MAXSOL, + & COMAX, SCLNRM, ERL2, ERREL + REAL ANORM,DZERO,EPSI + LOGICAL GIVSOL,PROK + INTEGER MPRINT, MP + INTEGER K + INTRINSIC abs, max, sqrt + MP = ICNTL(2) + PROK = (MPRINT .GT. 0) + DZERO = 0.0E0 + EPSI = 0.1E-9 + ANORM = DZERO + RESMAX = DZERO + RESL2 = DZERO + DO 40 K = 1, N + RESMAX = max(RESMAX, abs(RHS(K))) + RESL2 = RESL2 + abs(RHS(K)) * abs(RHS(K)) + ANORM = max(ANORM, W(K)) + 40 CONTINUE + XNORM = DZERO + DO 50 K = 1, N + XNORM = max(XNORM, abs(LHS(K))) + 50 CONTINUE + IF (XNORM .GT. EPSI) THEN + SCLNRM = RESMAX / (ANORM * XNORM) + ELSE + IFLAG = IFLAG + 2 + IF ((MP .GT. 0) .AND. (ICNTL(4) .GE. 2)) WRITE( MP, * ) + &' max-NORM of computed solut. is zero' + SCLNRM = RESMAX / ANORM + ENDIF + RESL2 = sqrt(RESL2) + ERMAX = DZERO + COMAX = DZERO + ERL2 = DZERO + IF (.NOT.GIVSOL) THEN + IF (PROK) WRITE( MPRINT, 90 ) RESMAX, RESL2, ANORM, XNORM, + & SCLNRM + ELSE + MAXSOL = DZERO + DO 60 K = 1, N + MAXSOL = max(MAXSOL, abs(SOL(K))) + 60 CONTINUE + DO 70 K = 1, N + ERL2 = abs(LHS(K) - SOL(K)) ** 2 + ERL2 + ERMAX = max(ERMAX, abs(LHS(K) - SOL(K))) + 70 CONTINUE + DO 80 K = 1, N + IF (abs(SOL(K)) .GT. EPSI) THEN + COMAX = max(COMAX, (abs(LHS(K) - SOL(K)) / abs(SOL(K)))) + ENDIF + 80 CONTINUE + ERL2 = sqrt(ERL2) + IF (MAXSOL .GT. EPSI) THEN + ERREL = ERMAX / MAXSOL + ELSE + IFLAG = IFLAG + 2 + IF ((MP .GT. 0) .AND. (ICNTL(4) .GE. 2)) WRITE( MP, * ) + &' MAX-NORM of exact solution is zero' + ERREL = ERMAX + ENDIF + IF (PROK) WRITE( MPRINT, 100 ) ERMAX, ERL2, ERREL, COMAX, RESMAX + & , RESL2, ANORM, XNORM, SCLNRM + ENDIF + 90 FORMAT (/' RESIDUAL IS ............ (MAX-NORM) =',1PD9.2/ + & ' .. (2-NORM) =',1PD9.2/ + & ' RINFOG(4):NORM OF input Matrix (MAX-NORM)=',1PD9.2/ + & ' RINFOG(5):NORM OF Computed SOLUT (MAX-NORM)=',1PD9.2/ + & ' RINFOG(6):SCALED RESIDUAL ...... (MAX-NORM)=',1PD9.2) + RETURN + 100 FORMAT (/' ERROR IS ............ (MAX-NORM) =',1PD9.2/ + & ' ............ (2-NORM) =',1PD9.2/ + & ' RELATIVE ERROR........... (MAX-NORM) =',1PD9.2/ + & ' Comp. Wise ERROR......... (MAX-NORM) =',1PD9.2/ + & ' AND RESIDUAL IS ......... (MAX-NORM) =',1PD9.2/ + & ' .. (2-NORM) =',1PD9.2/ + & ' NORM OF input MATRIX ... (MAX-NORM) =',1PD9.2/ + & ' NORM of computed SOLUT... (MAX-NORM) =',1PD9.2/ + & ' SCALED RESIDUAL ......... (MAX-NORM) =',1PD9.2) + END SUBROUTINE CMUMPS_205 + SUBROUTINE CMUMPS_206(NZ, N, RHS, + & X, Y, D, R_W, C_W, IW, KASE, + & OMEGA, ERX, JOB, COND, MAXIT, NOITER, LP, KEEP,KEEP8, + & ARRET ) + IMPLICIT NONE + INTEGER NZ, N, KASE, KEEP(500), JOB + INTEGER(8) KEEP8(150) + INTEGER IW(N,2) + COMPLEX RHS(N) + COMPLEX X(N), Y(N) + REAL D(N) + REAL R_W(N,2) + COMPLEX C_W(N) + INTEGER LP, MAXIT, NOITER + REAL COND(2),OMEGA(2) + REAL ARRET + REAL CGCE, CTAU + DATA CTAU /1.0E3/, CGCE /0.2E0/ + LOGICAL LCOND1, LCOND2 + INTEGER IFLAG, JUMP, I, IMAX + REAL ERX, DXMAX + REAL CONVER, OM1, OM2, DXIMAX + REAL ZERO, ONE,TAU, DD + REAL OLDOMG(2) + INTEGER CMUMPS_IXAMAX + INTRINSIC abs, max + SAVE LCOND1, LCOND2, JUMP, DXIMAX, DXMAX, CONVER, + & OM1, OLDOMG, IFLAG + DATA ZERO /0.0E0/, ONE /1.0E0/ + IF (KASE .EQ. 0) THEN + LCOND1 = .FALSE. + LCOND2 = .FALSE. + COND(1) = ONE + COND(2) = ONE + ERX = ZERO + OM1 = ZERO + IFLAG = 0 + NOITER = 0 + JUMP = 1 + ENDIF + SELECT CASE (JUMP) + CASE (1) + GOTO 30 + CASE(2) + GOTO 10 + CASE(3) + GOTO 110 + CASE(4) + GOTO 150 + CASE(5) + GOTO 35 + CASE DEFAULT + END SELECT + 10 CONTINUE + DO 20 I = 1, N + X(I) = X(I) + Y(I) + 20 CONTINUE + IF (NOITER .GT. MAXIT) THEN + IFLAG = IFLAG + 8 + GOTO 70 + ENDIF + 30 CONTINUE + KASE = 14 + JUMP = 5 + RETURN + 35 CONTINUE + IMAX = CMUMPS_IXAMAX(N, X, 1) + DXMAX = abs(X(IMAX)) + OMEGA(1) = ZERO + OMEGA(2) = ZERO + DO 40 I = 1, N + TAU = (R_W(I, 2) * DXMAX + abs(RHS(I))) * real(N) * CTAU + DD = R_W(I, 1) + abs(RHS(I)) + IF ((DD + TAU) .GT. TAU) THEN + OMEGA(1) = max(OMEGA(1), abs(Y(I)) / DD) + IW(I, 1) = 1 + ELSE + IF (TAU .GT. ZERO) THEN + OMEGA(2) = max(OMEGA(2), + & abs(Y(I)) / (DD + R_W(I, 2) * DXMAX)) + ENDIF + IW(I, 1) = 2 + ENDIF + 40 CONTINUE + OM2 = OMEGA(1) + OMEGA(2) + IF (OM2 .LT. ARRET ) GOTO 70 + IF (MAXIT .EQ. 0) GOTO 70 + IF (NOITER .GT. 1 .AND. OM2 .GT. OM1 * CGCE) THEN + CONVER = OM2 / OM1 + IF (OM2 .GT. OM1) THEN + OMEGA(1) = OLDOMG(1) + OMEGA(2) = OLDOMG(2) + DO 50 I = 1, N + X(I) = C_W(I) + 50 CONTINUE + ENDIF + GOTO 70 + ENDIF + DO 60 I = 1, N + C_W(I) = X(I) + 60 CONTINUE + OLDOMG(1) = OMEGA(1) + OLDOMG(2) = OMEGA(2) + OM1 = OM2 + NOITER = NOITER + 1 + KASE = 2 + JUMP = 2 + RETURN + 70 KASE = 0 + IF (JOB .LE. 0) GOTO 170 + DO 80 I = 1, N + IF (IW(I, 1) .EQ. 1) THEN + R_W(I, 1) = R_W(I, 1) + abs(RHS(I)) + R_W(I, 2) = ZERO + LCOND1 = .TRUE. + ELSE + R_W(I, 2) = R_W(I, 2) * DXMAX + R_W(I, 1) + R_W(I, 1) = ZERO + LCOND2 = .TRUE. + ENDIF + 80 CONTINUE + DO 90 I = 1, N + C_W(I) = X(I) * D(I) + 90 CONTINUE + IMAX = CMUMPS_IXAMAX(N, C_W(1), 1) + DXIMAX = abs(C_W(IMAX)) + IF (.NOT.LCOND1) GOTO 130 + 100 CALL CMUMPS_218(N, KASE, Y, COND(1), C_W, IW(1, 2)) + IF (KASE .EQ. 0) GOTO 120 + IF (KASE .EQ. 1) CALL CMUMPS_204(N, Y, D) + IF (KASE .EQ. 2) CALL CMUMPS_204(N, Y, R_W) + JUMP = 3 + RETURN + 110 CONTINUE + IF (KASE .EQ. 1) CALL CMUMPS_204(N, Y, R_W) + IF (KASE .EQ. 2) CALL CMUMPS_204(N, Y, D) + GOTO 100 + 120 IF (DXIMAX .GT. ZERO) COND(1) = COND(1) / DXIMAX + ERX = OMEGA(1) * COND(1) + 130 IF (.NOT.LCOND2) GOTO 170 + KASE = 0 + 140 CALL CMUMPS_218(N, KASE, Y, COND(2), C_W, IW(1, 2)) + IF (KASE .EQ. 0) GOTO 160 + IF (KASE .EQ. 1) CALL CMUMPS_204(N, Y, D) + IF (KASE .EQ. 2) CALL CMUMPS_204(N, Y, R_W(1, 2)) + JUMP = 4 + RETURN + 150 CONTINUE + IF (KASE .EQ. 1) CALL CMUMPS_204(N, Y, R_W(1, 2)) + IF (KASE .EQ. 2) CALL CMUMPS_204(N, Y, D) + GOTO 140 + 160 IF (DXIMAX .GT. ZERO) THEN + COND(2) = COND(2) / DXIMAX + ENDIF + ERX = ERX + OMEGA(2) * COND(2) + 170 KASE = -IFLAG + RETURN + END SUBROUTINE CMUMPS_206 + SUBROUTINE CMUMPS_207(A, NZ, N, IRN, ICN, Z, KEEP,KEEP8) + INTEGER NZ, N, I, J, K, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IRN(NZ), ICN(NZ) + COMPLEX A(NZ) + REAL Z(N) + REAL ZERO + INTRINSIC abs + DATA ZERO /0.0E0/ + DO 10 I = 1, N + Z(I) = ZERO + 10 CONTINUE + IF (KEEP(50) .EQ.0) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)) + IF (J.NE.I) THEN + Z(J) = Z(J) + abs(A(K)) + ENDIF + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_207 + SUBROUTINE CMUMPS_289(A, NZ, N, IRN, ICN, Z, + & KEEP, KEEP8, COLSCA) + INTEGER, intent(in) :: NZ, N, KEEP(500) + INTEGER(8), intent(in) :: KEEP8(150) + INTEGER, intent(in) :: IRN(NZ), ICN(NZ) + COMPLEX, intent(in) :: A(NZ) + REAL, intent(in) :: COLSCA(N) + REAL, intent(out) :: Z(N) + REAL ZERO + DATA ZERO /0.0E0/ + INTEGER I, J, K + DO 10 I = 1, N + Z(I) = ZERO + 10 CONTINUE + IF (KEEP(50) .EQ.0) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)*COLSCA(J)) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)*COLSCA(J)) + IF (J.NE.I) THEN + Z(J) = Z(J) + abs(A(K)*COLSCA(I)) + ENDIF + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_289 + SUBROUTINE CMUMPS_208(A, NZ, N, IRN, ICN, RHS, X, R, W, + & KEEP,KEEP8) + IMPLICIT NONE + INTEGER, intent(in) :: NZ, N, KEEP(500) + INTEGER(8), intent(in) :: KEEP8(150) + INTEGER, intent(in) :: IRN(NZ), ICN(NZ) + COMPLEX, intent(in) :: A(NZ), RHS(N), X(N) + REAL, intent(out) :: W(N) + COMPLEX, intent(out) :: R(N) + INTEGER I, K, J + REAL ZERO + DATA ZERO /0.0E0/ + COMPLEX D + DO I = 1, N + R(I) = RHS(I) + W(I) = ZERO + ENDDO + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .GT. N) .OR. (J .GT. N) .OR. (I .LT. 1) .OR. (J .LT. 1)) + & CYCLE + D = A(K) * X(J) + R(I) = R(I) - D + W(I) = W(I) + abs(D) + IF ((I.NE.J) .AND. (KEEP(50).NE.0) ) THEN + D = A(K) * X(I) + R(J) = R(J) - D + W(J) = W(J) + abs(D) + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_208 + SUBROUTINE CMUMPS_204(N, R, W) + INTEGER, intent(in) :: N + REAL, intent(in) :: W(N) + COMPLEX, intent(inout) :: R(N) + INTEGER I + DO 10 I = 1, N + R(I) = R(I) * W(I) + 10 CONTINUE + RETURN + END SUBROUTINE CMUMPS_204 + SUBROUTINE CMUMPS_218(N, KASE, X, EST, W, IW) + INTEGER, intent(in) :: N + INTEGER, intent(inout) :: KASE + INTEGER IW(N) + COMPLEX W(N), X(N) + REAL EST + INTRINSIC abs, nint, real, sign + INTEGER CMUMPS_IXAMAX + EXTERNAL CMUMPS_IXAMAX + INTEGER ITMAX + PARAMETER (ITMAX = 5) + INTEGER I, ITER, J, JLAST, JUMP + REAL ALTSGN + REAL TEMP + SAVE ITER, J, JLAST, JUMP + COMPLEX ZERO, ONE + PARAMETER( ZERO = (0.0E0,0.0E0) ) + PARAMETER( ONE = (1.0E0,0.0E0) ) + REAL, PARAMETER :: RZERO = 0.0E0 + REAL, PARAMETER :: RONE = 1.0E0 + IF (KASE .EQ. 0) THEN + DO 10 I = 1, N + X(I) = ONE / real(N) + 10 CONTINUE + KASE = 1 + JUMP = 1 + RETURN + ENDIF + SELECT CASE (JUMP) + CASE (1) + GOTO 20 + CASE(2) + GOTO 40 + CASE(3) + GOTO 70 + CASE(4) + GOTO 120 + CASE(5) + GOTO 160 + CASE DEFAULT + END SELECT + 20 CONTINUE + IF (N .EQ. 1) THEN + W(1) = X(1) + EST = abs(W(1)) + GOTO 190 + ENDIF + DO 30 I = 1, N + X(I) = cmplx( sign(RONE,real(X(I))), kind=kind(X)) + IW(I) = nint(real(X(I))) + 30 CONTINUE + KASE = 2 + JUMP = 2 + RETURN + 40 CONTINUE + J = CMUMPS_IXAMAX(N, X, 1) + ITER = 2 + 50 CONTINUE + DO 60 I = 1, N + X(I) = ZERO + 60 CONTINUE + X(J) = ONE + KASE = 1 + JUMP = 3 + RETURN + 70 CONTINUE + DO 80 I = 1, N + W(I) = X(I) + 80 CONTINUE + DO 90 I = 1, N + IF (nint(sign(RONE, real(X(I)))) .NE. IW(I)) GOTO 100 + 90 CONTINUE + GOTO 130 + 100 CONTINUE + DO 110 I = 1, N + X(I) = cmplx( sign(RONE, real(X(I))), kind=kind(X) ) + IW(I) = nint(real(X(I))) + 110 CONTINUE + KASE = 2 + JUMP = 4 + RETURN + 120 CONTINUE + JLAST = J + J = CMUMPS_IXAMAX(N, X, 1) + IF ((abs(X(JLAST)) .NE. abs(X(J))) .AND. (ITER .LT. ITMAX)) THEN + ITER = ITER + 1 + GOTO 50 + ENDIF + 130 CONTINUE + EST = RZERO + DO 140 I = 1, N + EST = EST + abs(W(I)) + 140 CONTINUE + ALTSGN = RONE + DO 150 I = 1, N + X(I) = cmplx(ALTSGN * (RONE + real(I - 1) / real(N - 1)), + & kind=kind(X)) + ALTSGN = -ALTSGN + 150 CONTINUE + KASE = 1 + JUMP = 5 + RETURN + 160 CONTINUE + TEMP = RZERO + DO 170 I = 1, N + TEMP = TEMP + abs(X(I)) + 170 CONTINUE + TEMP = 2.0E0 * TEMP / real(3 * N) + IF (TEMP .GT. EST) THEN + DO 180 I = 1, N + W(I) = X(I) + 180 CONTINUE + EST = TEMP + ENDIF + 190 KASE = 0 + RETURN + END SUBROUTINE CMUMPS_218 + SUBROUTINE CMUMPS_278( MTYPE, N, NZ, ASPK, IRN, ICN, + & LHS, WRHS, W, RHS, KEEP,KEEP8) + IMPLICIT NONE + INTEGER MTYPE, N, NZ + INTEGER IRN( NZ ), ICN( NZ ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + COMPLEX, intent(in) :: ASPK( NZ ) + COMPLEX, intent(in) :: LHS( N ), WRHS( N ) + COMPLEX, intent(out):: RHS( N ) + REAL, intent(out):: W( N ) + INTEGER K, I, J + REAL DZERO + PARAMETER(DZERO = 0.0E0) + DO 10 K = 1, N + W(K) = DZERO + RHS(K) = WRHS(K) + 10 CONTINUE + IF ( KEEP(50) .EQ. 0 ) THEN + IF (MTYPE .EQ. 1) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + RHS(I) = RHS(I) - ASPK(K) * LHS(J) + W(I) = W(I) + abs(ASPK(K)) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + RHS(J) = RHS(J) - ASPK(K) * LHS(I) + W(J) = W(J) + abs(ASPK(K)) + ENDDO + ENDIF + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + RHS(I) = RHS(I) - ASPK(K) * LHS(J) + W(I) = W(I) + abs(ASPK(K)) + IF (J.NE.I) THEN + RHS(J) = RHS(J) - ASPK(K) * LHS(I) + W(J) = W(J) + abs(ASPK(K)) + ENDIF + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_278 + SUBROUTINE CMUMPS_121( MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & LHS, WRHS, W, RHS, KEEP,KEEP8) + IMPLICIT NONE + INTEGER MTYPE, N, NELT, LELTVAR, NA_ELT + INTEGER ELTPTR(NELT+1), ELTVAR(LELTVAR) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + COMPLEX A_ELT(NA_ELT) + COMPLEX LHS( N ), WRHS( N ), RHS( N ) + REAL W(N) + CALL CMUMPS_257(N, NELT, ELTPTR, ELTVAR, A_ELT, + & LHS, RHS, KEEP(50), MTYPE ) + RHS = WRHS - RHS + CALL CMUMPS_119( MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & W, KEEP,KEEP8 ) + RETURN + END SUBROUTINE CMUMPS_121 + SUBROUTINE CMUMPS_119( MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & W, KEEP,KEEP8 ) + IMPLICIT NONE + INTEGER MTYPE, N, NELT, LELTVAR, NA_ELT + INTEGER ELTPTR(NELT+1), ELTVAR(LELTVAR) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + COMPLEX A_ELT(NA_ELT) + REAL TEMP + REAL W(N) + INTEGER K, I, J, IEL, SIZEI, IELPTR + REAL DZERO + PARAMETER(DZERO = 0.0E0) + W = DZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( KEEP(50).EQ.0 ) THEN + IF (MTYPE.EQ.1) THEN + DO J = 1, SIZEI + DO I = 1, SIZEI + W( ELTVAR( IELPTR + I) ) = + & W( ELTVAR( IELPTR + I) ) + & + abs(A_ELT( K )) + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = W( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + TEMP = TEMP + abs( A_ELT(K)) + K = K + 1 + END DO + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + TEMP + END DO + ENDIF + ELSE + DO J = 1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + abs(A_ELT( K )) + K = K + 1 + DO I = J+1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + abs(A_ELT( K )) + W(ELTVAR( IELPTR + I ) ) = + & W(ELTVAR( IELPTR + I )) + abs(A_ELT( K )) + K = K + 1 + END DO + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_119 + SUBROUTINE CMUMPS_135(MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & W, KEEP,KEEP8, COLSCA ) + IMPLICIT NONE + INTEGER MTYPE, N, NELT, LELTVAR, NA_ELT + INTEGER ELTPTR(NELT+1), ELTVAR(LELTVAR) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + REAL COLSCA(N) + COMPLEX A_ELT(NA_ELT) + REAL W(N) + REAL TEMP, TEMP2 + INTEGER K, I, J, IEL, SIZEI, IELPTR + REAL DZERO + PARAMETER(DZERO = 0.0E0) + W = DZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( KEEP(50).EQ.0 ) THEN + IF (MTYPE.EQ.1) THEN + DO J = 1, SIZEI + TEMP2 = abs(COLSCA(ELTVAR( IELPTR + J) )) + DO I = 1, SIZEI + W( ELTVAR( IELPTR + I) ) = + & W( ELTVAR( IELPTR + I) ) + & + abs(A_ELT( K )) * TEMP2 + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = W( ELTVAR( IELPTR + J ) ) + TEMP2= abs(COLSCA(ELTVAR( IELPTR + J) )) + DO I = 1, SIZEI + TEMP = TEMP + abs(A_ELT( K )) * TEMP2 + K = K + 1 + END DO + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + TEMP + END DO + ENDIF + ELSE + DO J = 1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + + & abs( A_ELT( K )*COLSCA(ELTVAR( IELPTR + J)) ) + K = K + 1 + DO I = J+1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + + & abs(A_ELT( K )*COLSCA(ELTVAR( IELPTR + J))) + W(ELTVAR( IELPTR + I ) ) = + & W(ELTVAR( IELPTR + I )) + + & abs(A_ELT( K )*COLSCA(ELTVAR( IELPTR + I))) + K = K + 1 + END DO + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_135 + SUBROUTINE CMUMPS_122( MTYPE, N, NELT, ELTPTR, + & LELTVAR, ELTVAR, NA_ELT, A_ELT, + & SAVERHS, X, Y, W, K50 ) + IMPLICIT NONE + INTEGER N, NELT, K50, MTYPE, LELTVAR, NA_ELT + INTEGER ELTPTR( NELT + 1 ), ELTVAR( LELTVAR ) + COMPLEX A_ELT( NA_ELT ), X( N ), Y( N ), + & SAVERHS(N) + REAL W(N) + INTEGER IEL, I , J, K, SIZEI, IELPTR + REAL ZERO + COMPLEX TEMP + REAL TEMP2 + PARAMETER( ZERO = 0.0E0 ) + Y = SAVERHS + W = ZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( K50 .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO J = 1, SIZEI + TEMP = X( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) - + & A_ELT( K ) * TEMP + W( ELTVAR( IELPTR + I ) ) = + & W( ELTVAR( IELPTR + I ) ) + + & abs( A_ELT( K ) * TEMP ) + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = Y( ELTVAR( IELPTR + J ) ) + TEMP2 = W( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + TEMP = TEMP - + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + TEMP2 = TEMP2 + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) ) + K = K + 1 + END DO + Y( ELTVAR( IELPTR + J ) ) = TEMP + W( ELTVAR( IELPTR + J ) ) = TEMP2 + END DO + END IF + ELSE + DO J = 1, SIZEI + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) - + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + W( ELTVAR( IELPTR + J ) ) = + & W( ELTVAR( IELPTR + J ) ) + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) ) + K = K + 1 + DO I = J+1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) - + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) - + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + W( ELTVAR( IELPTR + I ) ) = + & W( ELTVAR( IELPTR + I ) ) + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) ) + W( ELTVAR( IELPTR + J ) ) = + & W( ELTVAR( IELPTR + J ) ) + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) ) + K = K + 1 + END DO + END DO + END IF + END DO + RETURN + END SUBROUTINE CMUMPS_122 + SUBROUTINE CMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + USE CMUMPS_OOC + IMPLICIT NONE + INTEGER INODE,KEEP(500),N + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N) + INTEGER IERR + COMPLEX A(LA) + INTEGER RETURN_VALUE + LOGICAL MUST_BE_PERMUTED + RETURN_VALUE=CMUMPS_726(INODE,PTRFAC, + & KEEP(28),A,LA,IERR) + IF(RETURN_VALUE.EQ.OOC_NODE_NOT_IN_MEM)THEN + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL CMUMPS_578(INODE,PTRFAC, + & KEEP,KEEP8,A,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL CMUMPS_577( + & A(PTRFAC(STEP(INODE))), + & INODE,IERR + & ) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ELSE + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + IF(RETURN_VALUE.NE.OOC_NODE_PERMUTED)THEN + MUST_BE_PERMUTED=.TRUE. + CALL CMUMPS_682(INODE) + ELSE + MUST_BE_PERMUTED=.FALSE. + ENDIF + RETURN + END SUBROUTINE CMUMPS_643 + SUBROUTINE CMUMPS_257( N, NELT, ELTPTR, ELTVAR, A_ELT, + & X, Y, K50, MTYPE ) + IMPLICIT NONE + INTEGER N, NELT, K50, MTYPE + INTEGER ELTPTR( NELT + 1 ), ELTVAR( * ) + COMPLEX A_ELT( * ), X( N ), Y( N ) + INTEGER IEL, I , J, K, SIZEI, IELPTR + COMPLEX TEMP + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + Y = ZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( K50 .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO J = 1, SIZEI + TEMP = X( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) + + & A_ELT( K ) * TEMP + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = Y( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + TEMP = TEMP + + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + K = K + 1 + END DO + Y( ELTVAR( IELPTR + J ) ) = TEMP + END DO + END IF + ELSE + DO J = 1, SIZEI + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) + + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + K = K + 1 + DO I = J+1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) + + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) + + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + K = K + 1 + END DO + END DO + END IF + END DO + RETURN + END SUBROUTINE CMUMPS_257 + SUBROUTINE CMUMPS_192 + &( N, NZ_loc, IRN_loc, JCN_loc, A_loc, X, Y_loc, + & LDLT, MTYPE) + IMPLICIT NONE + INTEGER N, NZ_loc + INTEGER IRN_loc( NZ_loc ), JCN_loc( NZ_loc ) + COMPLEX A_loc( NZ_loc ), X( N ), Y_loc( N ) + INTEGER LDLT, MTYPE + INTEGER I, J, K + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + Y_loc = ZERO + IF ( LDLT .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + A_loc(K) * X(J) + ENDDO + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) + & .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(J) = Y_loc(J) + A_loc(K) * X(I) + ENDDO + END IF + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + A_loc(K) * X(J) + IF (J.NE.I) THEN + Y_loc(J) = Y_loc(J) + A_loc(K) * X(I) + ENDIF + ENDDO + END IF + RETURN + END SUBROUTINE CMUMPS_192 + SUBROUTINE CMUMPS_256( N, NZ, IRN, ICN, ASPK, X, Y, + & LDLT, MTYPE, MAXTRANS, PERM ) + INTEGER N, NZ, LDLT, MTYPE, MAXTRANS + INTEGER IRN( NZ ), ICN( NZ ) + INTEGER PERM( N ) + COMPLEX ASPK( NZ ), X( N ), Y( N ) + INTEGER K, I, J + COMPLEX PX( N ) + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + Y = ZERO + IF ( MAXTRANS .eq. 1 .and. MTYPE .eq. 1) THEN + DO I = 1, N + PX(I) = X( PERM( I ) ) + END DO + ELSE + PX = X + END IF + IF ( LDLT .eq. 0 ) THEN + IF (MTYPE .EQ. 1) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y(I) = Y(I) + ASPK(K) * PX(J) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y(J) = Y(J) + ASPK(K) * PX(I) + ENDDO + ENDIF + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y(I) = Y(I) + ASPK(K) * PX(J) + IF (J.NE.I) THEN + Y(J) = Y(J) + ASPK(K) * PX(I) + ENDIF + ENDDO + END IF + IF ( MAXTRANS .EQ. 1 .AND. MTYPE .eq. 0 ) THEN + PX = Y + DO I = 1, N + Y( PERM( I ) ) = PX( I ) + END DO + END IF + RETURN + END SUBROUTINE CMUMPS_256 + SUBROUTINE CMUMPS_193 + &( N, NZ_loc, IRN_loc, JCN_loc, A_loc, X, Y_loc, + & LDLT, MTYPE) + IMPLICIT NONE + INTEGER N, NZ_loc + INTEGER IRN_loc( NZ_loc ), JCN_loc( NZ_loc ) + COMPLEX A_loc( NZ_loc ), X( N ) + REAL Y_loc( N ) + INTEGER LDLT, MTYPE + INTEGER I, J, K + REAL RZERO + PARAMETER( RZERO = 0.0E0 ) + Y_loc = RZERO + IF ( LDLT .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + abs( A_loc(K) * X(J) ) + ENDDO + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) + & .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(J) = Y_loc(J) + abs( A_loc(K) * X(I) ) + ENDDO + END IF + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + abs( A_loc(K) * X(J) ) + IF (J.NE.I) THEN + Y_loc(J) = Y_loc(J) + abs( A_loc(K) * X(I) ) + ENDIF + ENDDO + END IF + RETURN + END SUBROUTINE CMUMPS_193 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part6.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part6.F new file mode 100644 index 000000000..42e519427 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part6.F @@ -0,0 +1,4378 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE CMUMPS_324(A, LDA, NPIV, NBROW, K50 ) + IMPLICIT NONE + INTEGER LDA, NPIV, NBROW, K50 + COMPLEX A(int(LDA,8)*int(NBROW+NPIV,8)) + INTEGER(8) :: IOLD, INEW, J8 + INTEGER I , ILAST + INTEGER NBROW_L_RECTANGLE_TO_MOVE + IF ((NPIV.EQ.0).OR.(LDA.EQ.NPIV)) GOTO 500 + IF ( K50.NE.0 ) THEN + IOLD = int(LDA + 1,8) + INEW = int(NPIV + 1,8) + IF (IOLD .EQ. INEW ) THEN + INEW = INEW + int(NPIV,8) * int(NPIV - 1,8) + IOLD = IOLD + int(LDA,8) * int(NPIV - 1,8) + ELSE + DO I = 1, NPIV - 1 + IF ( I .LE. NPIV-2 ) THEN + ILAST = I+1 + ELSE + ILAST = I + ENDIF + DO J8 = 0_8, int(ILAST,8) + A( INEW + J8 ) = A( IOLD + J8 ) + END DO + INEW = INEW + int(NPIV,8) + IOLD = IOLD + int(LDA,8) + END DO + ENDIF + NBROW_L_RECTANGLE_TO_MOVE = NBROW + ELSE + INEW = 1_8 + int(NPIV,8) * int(LDA + 1,8) + IOLD = 1_8 + int(LDA,8) * int(NPIV +1,8) + NBROW_L_RECTANGLE_TO_MOVE = NBROW - 1 + ENDIF + DO I = 1, NBROW_L_RECTANGLE_TO_MOVE + DO J8 = 0_8, int(NPIV - 1,8) + A( INEW + J8 ) = A( IOLD + J8 ) + END DO + INEW = INEW + int(NPIV,8) + IOLD = IOLD + int(LDA,8) + ENDDO + 500 RETURN + END SUBROUTINE CMUMPS_324 + SUBROUTINE CMUMPS_651(A, LDA, NPIV, NCONTIG ) + IMPLICIT NONE + INTEGER NCONTIG, NPIV, LDA + COMPLEX A(NCONTIG*LDA) + INTEGER I, J + INTEGER(8) :: INEW, IOLD + INEW = int(NPIV+1,8) + IOLD = int(LDA+1,8) + DO I = 2, NCONTIG + DO J = 1, NPIV + A(INEW)=A(IOLD) + INEW = INEW + 1_8 + IOLD = IOLD + 1_8 + ENDDO + IOLD = IOLD + int(LDA - NPIV,8) + ENDDO + RETURN + END SUBROUTINE CMUMPS_651 + SUBROUTINE CMUMPS_652( A, LA, LDA, POSELT, + & IPTRLU, NPIV, + & NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, SIZECB, KEEP, COMPRESSCB, + & LAST_ALLOWED, NBROW_ALREADY_STACKED ) + IMPLICIT NONE + INTEGER(8), intent (in) :: POSELT, IPTRLU, LA, SIZECB + LOGICAL, intent (in) :: COMPRESSCB + COMPLEX A(LA) + INTEGER, intent(in):: LDA, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND + INTEGER, intent(inout) :: NBROW_ALREADY_STACKED + INTEGER(8), intent(in) :: LAST_ALLOWED + INTEGER(8) :: APOS, NPOS + INTEGER NBROW + INTEGER(8) :: J + INTEGER I, KEEP(500) +#if ! defined(ALLOW_NON_INIT) + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) +#endif + NBROW = NBROW_STACK + NBROW_SEND + IF (NBROW_STACK .NE. 0 ) THEN + NPOS = IPTRLU + SIZECB + APOS = POSELT + int(NPIV+NBROW,8) * int(LDA,8) - 1_8 + IF ( KEEP(50) .EQ. 0 .OR. .NOT. COMPRESSCB ) THEN + APOS = APOS - int(LDA,8) * int(NBROW_ALREADY_STACKED,8) + NPOS = NPOS + & - int(NBCOL_STACK,8) * int(NBROW_ALREADY_STACKED,8) + ELSE + APOS = APOS - int(LDA - 1,8) * int(NBROW_ALREADY_STACKED,8) + NPOS = NPOS - ( int(NBROW_ALREADY_STACKED,8) * + & int(NBROW_ALREADY_STACKED+1,8) ) / 2_8 + ENDIF + DO I = NBROW - NBROW_ALREADY_STACKED, NBROW_SEND+1, -1 + IF (KEEP(50).EQ.0) THEN + IF ( NPOS - int(NBCOL_STACK,8) + 1_8 .LT. + & LAST_ALLOWED ) THEN + EXIT + ENDIF + DO J= 1_8,int(NBCOL_STACK,8) + A(NPOS-J+1_8) = A(APOS-J+1_8) + ENDDO + NPOS = NPOS - int(NBCOL_STACK,8) + ELSE + IF (.NOT. COMPRESSCB) THEN + IF ( NPOS - int(NBCOL_STACK,8) + 1_8 .LT. + & LAST_ALLOWED ) THEN + EXIT + ENDIF +#if ! defined(ALLOW_NON_INIT) + DO J = 1_8, int(NBCOL_STACK - I,8) + A(NPOS - J + 1_8) = ZERO + END DO +#endif + NPOS = NPOS + int(- NBCOL_STACK + I,8) + ENDIF + IF ( NPOS - int(I,8) + 1_8 .LT. LAST_ALLOWED ) THEN + EXIT + ENDIF + DO J =1_8, int(I,8) + A(NPOS-J+1_8) = A(APOS-J+1_8) + ENDDO + NPOS = NPOS - int(I,8) + ENDIF + IF (KEEP(50).EQ.0) THEN + APOS = APOS - int(LDA,8) + ELSE + APOS = APOS - int(LDA + 1,8) + ENDIF + NBROW_ALREADY_STACKED = NBROW_ALREADY_STACKED + 1 + ENDDO + END IF + RETURN + END SUBROUTINE CMUMPS_652 + SUBROUTINE CMUMPS_705( A, LA, LDA, POSELT, + & IPTRLU, NPIV, + & NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, SIZECB, KEEP, COMPRESSCB) + IMPLICIT NONE + INTEGER(8), intent (in) :: POSELT, IPTRLU, LA, SIZECB + LOGICAL, intent (in) :: COMPRESSCB + COMPLEX A(LA) + INTEGER, intent(in):: LDA, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND + INTEGER(8) :: APOS, NPOS, APOS_ini, NPOS_ini + INTEGER I, KEEP(500) + INTEGER(8) :: J, LDA8 +#if ! defined(ALLOW_NON_INIT) + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) +#endif + LDA8 = int(LDA,8) + NPOS_ini = IPTRLU + 1_8 + APOS_ini = POSELT + int(NPIV+NBROW_SEND,8)* LDA8 + int(NPIV,8) + DO I = 1, NBROW_STACK + IF (COMPRESSCB) THEN + NPOS = NPOS_ini + int(I-1,8) * int(I,8)/2_8 + + & int(I-1,8) * int(NBROW_SEND,8) + ELSE + NPOS = NPOS_ini + int(I-1,8) * int(NBCOL_STACK,8) + ENDIF + APOS = APOS_ini + int(I-1,8) * LDA8 + IF (KEEP(50).EQ.0) THEN + DO J = 1_8, int(NBCOL_STACK,8) + A(NPOS+J-1_8) = A(APOS+J-1_8) + ENDDO + ELSE + DO J = 1_8, int(I + NBROW_SEND,8) + A(NPOS+J-1_8)=A(APOS+J-1_8) + ENDDO +#if ! defined(ALLOW_NON_INIT) + IF (.NOT. COMPRESSCB) THEN + A(NPOS+int(I+NBROW_SEND,8): + & NPOS+int(NBCOL_STACK-1,8))=ZERO + ENDIF +#endif + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_705 + SUBROUTINE CMUMPS_140( N, INODE, IW, LIW, A, LA, + & IOLDPS, POSELT, IFLAG, + & UU, NNEG, NPVW, + & KEEP,KEEP8, + & MYID, SEUIL, AVOID_DELAYED, ETATASS, + & DKEEP,PIVNUL_LIST,LPN_LIST, IWPOS ) + USE CMUMPS_OOC + IMPLICIT NONE + INTEGER(8) :: LA, POSELT + INTEGER N, INODE, LIW, IFLAG, NNEG, NPVW + INTEGER MYID, IOLDPS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + REAL UU, SEUIL + COMPLEX A( LA ) + INTEGER, TARGET :: IW( LIW ) + LOGICAL AVOID_DELAYED + INTEGER ETATASS, IWPOS + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER INOPV, IFINB, NFRONT, NPIV, NBOLKJ, + & NBTLKJ,IBEG_BLOCK + INTEGER NASS, NEL1, IFLAG_OOC + INTEGER :: LDA + REAL UUTEMP + INCLUDE 'mumps_headers.h' + EXTERNAL CMUMPS_222, CMUMPS_234, + & CMUMPS_230, CMUMPS_226, + & CMUMPS_237 + LOGICAL STATICMODE + REAL SEUIL_LOC + INTEGER PIVSIZ,IWPOSP2 + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten, + & IDUMMY + LOGICAL POSTPONE_COL_UPDATE, IS_MAXFROMM_AVAIL + REAL MAXFROMM + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INTEGER PP_FIRST2SWAP_L + INTEGER PP_LastPIVRPTRFilled + IS_MAXFROMM_AVAIL = .FALSE. + INOPV = 0 + SEUIL_LOC = SEUIL + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + UUTEMP=UU + ENDIF + POSTPONE_COL_UPDATE = (UUTEMP == 0.0E0 .AND. KEEP(201).NE.1) + IBEG_BLOCK = 1 + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + LDA = NFRONT + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5), NASS ) + ENDIF + NBTLKJ = NBOLKJ + IF (KEEP(201).EQ.1) THEN + IDUMMY = -8765 + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_L + NextPiv2beWritten = 1 + PP_FIRST2SWAP_L = NextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + PP_LastPIVRPTRFilled = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 1 + MonBloc%NROW = NFRONT + MonBloc%NCOL = NFRONT + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -77777 + MonBloc%INDICES => + & IW(IOLDPS+6+NFRONT+KEEP(IXSZ): + & IOLDPS+5+NFRONT+KEEP(IXSZ)+NFRONT) + ENDIF + IW(IOLDPS+3+KEEP(IXSZ)) = min0(NASS,NBTLKJ) + UUTEMP = UU + 50 CONTINUE + CALL CMUMPS_222(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV, NNEG, IFLAG,IOLDPS,POSELT,UUTEMP, + & SEUIL_LOC,KEEP,KEEP8,PIVSIZ, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, KEEP(IXSZ), + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled, MAXFROMM, IS_MAXFROMM_AVAIL) + IF (IFLAG.LT.0) GOTO 500 + IF(KEEP(109).GT. 0) THEN + IF(PIVNUL_LIST(KEEP(109)).EQ.-1) THEN + IWPOSP2 = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6+KEEP(IXSZ) + & +IW(IOLDPS+5+KEEP(IXSZ)) + PIVNUL_LIST(KEEP(109)) = IW(IWPOSP2) + ENDIF + ENDIF + IF (INOPV.EQ.1) THEN + IF(STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + CALL CMUMPS_237(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, KEEP,KEEP8, POSTPONE_COL_UPDATE, + & ETATASS, + & TYPEFile, LAFAC, MonBloc, NextPiv2beWritten, + & LIWFAC, MYID, IFLAG) + GOTO 500 + END IF + IF (INOPV.EQ.2) THEN + CALL CMUMPS_234(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, NBOLKJ, NBTLKJ,KEEP(4), + & POSTPONE_COL_UPDATE, + & KEEP,KEEP8) + GOTO 50 + ENDIF + NPVW = NPVW + PIVSIZ + IF (NASS.LE.1) THEN + CALL CMUMPS_230(NFRONT,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + GO TO 500 + ENDIF + CALL CMUMPS_226(IBEG_BLOCK, + & NFRONT, NASS, N,INODE,IW,LIW,A,LA, + & LDA, POSTPONE_COL_UPDATE, IOLDPS, + & POSELT,IFINB, + & NBTLKJ,PIVSIZ, KEEP(IXSZ),MAXFROMM, + & IS_MAXFROMM_AVAIL, (UUTEMP.NE.0.0E0), + & KEEP(253) ) + IF(PIVSIZ .EQ. 2) THEN + IWPOSP2 = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6 + IW(IWPOSP2+NFRONT+KEEP(IXSZ)) = -IW(IWPOSP2+NFRONT+KEEP(IXSZ)) + ENDIF + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + PIVSIZ + IF (IFINB.EQ.0) GOTO 50 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NEL1 = NASS - NPIV + IF (KEEP(201).EQ.1) THEN + IF (IFINB.EQ.-1) THEN + MonBloc%Last = .TRUE. + ELSE + MonBloc%Last = .FALSE. + ENDIF + MonBloc%LastPiv= NPIV + LAST_CALL=.FALSE. + CALL CMUMPS_688( + & STRAT_TRY_WRITE, + & TYPEFile, A(POSELT), + & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS), + & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + ENDIF + CALL CMUMPS_234(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, NBOLKJ, NBTLKJ,KEEP(4), + & POSTPONE_COL_UPDATE, + & KEEP,KEEP8) + IF (IFINB.EQ.-1) THEN + CALL CMUMPS_237(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, KEEP,KEEP8, + & POSTPONE_COL_UPDATE, ETATASS, + & TYPEFile, LAFAC, MonBloc, NextPiv2beWritten, + & LIWFAC, MYID, IFLAG) + & + GOTO 500 + ENDIF + GO TO 50 + 500 CONTINUE + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + LAST_CALL=.TRUE. + CALL CMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG < 0 ) RETURN + CALL CMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + RETURN + END SUBROUTINE CMUMPS_140 + SUBROUTINE CMUMPS_222 + & (NFRONT,NASS,N,INODE,IW,LIW, + & A,LA, INOPV, + & NNEG, + & IFLAG,IOLDPS,POSELT,UU, SEUIL,KEEP,KEEP8,PIVSIZ, + & DKEEP,PIVNUL_LIST,LPN_LIST, XSIZE, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled,MAXFROMM,IS_MAXFROMM_AVAIL) +#if defined (PROFILE_BLAS_ASS_G) + USE CMUMPS_LOAD +#endif + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER(8) :: POSELT, LA + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV, + & IOLDPS, NNEG + INTEGER PIVSIZ,LPIV, XSIZE + COMPLEX A(LA) + REAL UU, UULOC, SEUIL + INTEGER IW(LIW) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk + INTEGER PP_LastPIVRPTRIndexFilled + REAL, intent(in) :: MAXFROMM + LOGICAL, intent(inout) :: IS_MAXFROMM_AVAIL + include 'mpif.h' + INTEGER (8) :: POSPV1,POSPV2,OFFDAG,APOSJ + INTEGER JMAX + REAL RMAX,AMAX,TMAX,TOL + REAL MAXPIV + REAL PIVNUL + COMPLEX FIXA, CSEUIL + COMPLEX PIVOT,DETPIV + PARAMETER(TOL = 1.0E-20) + INCLUDE 'mumps_headers.h' + INTEGER :: J + INTEGER(8) :: APOS, J1, J2, JJ, NFRONT8, KK, J1_ini, JJ_ini + INTEGER :: LDA + INTEGER(8) :: LDA8 + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,K + INTRINSIC max + COMPLEX ZERO, ONE + PARAMETER( ZERO = (0.0E0,0.0E0) ) + PARAMETER( ONE = (1.0E0,1.0E0) ) + REAL RZERO,RONE + PARAMETER(RZERO=0.0E0, RONE=1.0E0) + LOGICAL OMP_FLAG + INTEGER I_PIVRPTR, I_PIVR, NBPANELS_L + PIVNUL = DKEEP(1) + FIXA = cmplx(DKEEP(2),kind=kind(FIXA)) + CSEUIL = cmplx(SEUIL,kind=kind(CSEUIL)) + LDA = NFRONT + LDA8 = int(LDA,8) + NFRONT8 = int(NFRONT,8) + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL CMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR, I_PIVR, IOLDPS+2*NFRONT+6+KEEP(IXSZ), + & IW, LIW) + ENDIF + UULOC = UU + PIVSIZ = 1 + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NASSW = iabs(IW(IOLDPS+3+XSIZE)) + IF(INOPV .EQ. -1) THEN + APOS = POSELT + (LDA8+1_8) * int(NPIV,8) + POSPV1 = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF(real(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + KEEP(98) = KEEP(98)+1 + ELSE IF (KEEP(258) .NE. 0) THEN + CALL CMUMPS_762( A(APOS), DKEEP(6), KEEP(259) ) + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL CMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + LDA8*int(IPIV-1,8) + int(NPIV,8) + POSPV1 = APOS + int(IPIV - NPIVP1,8) + PIVOT = A(POSPV1) + IF (UULOC.EQ.RZERO) THEN + IF (abs(A(APOS)).EQ.RZERO) GO TO 630 + IF (KEEP(258) .NE. 0) THEN + CALL CMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + GO TO 420 + ENDIF + AMAX = RZERO + JMAX = 0 + IF ( IS_MAXFROMM_AVAIL ) THEN + IF ( MAXFROMM > PIVNUL .AND. abs(PIVOT) > TOL) THEN + IF ( abs(PIVOT) .GT. max(UULOC*MAXFROMM,SEUIL) ) THEN + IF (KEEP(258) .NE. 0) THEN + CALL CMUMPS_762(PIVOT, DKEEP(6), KEEP(259)) + ENDIF + GOTO 415 + ENDIF + ENDIF + IS_MAXFROMM_AVAIL = .FALSE. + ENDIF + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(abs(A(JJ)) .GT. AMAX) THEN + AMAX = abs(A(JJ)) + JMAX = IPIV - int(POSPV1-JJ) + ENDIF + ENDDO + J1 = POSPV1 + LDA8 + DO J=1, NASSW - IPIV + IF(abs(A(J1)) .GT. AMAX) THEN + AMAX = abs(A(J1)) + JMAX = IPIV + J + ENDIF + J1 = J1 + LDA8 + ENDDO + RMAX = RZERO + J1_ini = J1 + IF ( (NFRONT - KEEP(253) - NASSW).GE.300 ) THEN + OMP_FLAG = .TRUE. + ELSE + OMP_FLAG = .FALSE. + ENDIF + DO J=1, NFRONT - KEEP(253) - NASSW + J1 = J1_ini + int(J-1,8) * LDA8 + RMAX = max(abs(A(J1)),RMAX) + ENDDO + IF (max(AMAX,RMAX,abs(PIVOT)).LE.PIVNUL) THEN + KEEP(109) = KEEP(109)+1 + PIVNUL_LIST(KEEP(109)) = -1 + IF(real(FIXA).GT.RZERO) THEN + IF(real(PIVOT) .GE. RZERO) THEN + A(POSPV1) = FIXA + ELSE + A(POSPV1) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + A(JJ) = ZERO + ENDDO + J1 = POSPV1 + LDA8 + DO J=1, NASSW - IPIV + A(J1) = ZERO + J1 = J1 + LDA8 + ENDDO + DO J=1,NFRONT - NASSW + A(J1) = ZERO + J1 = J1 + LDA8 + ENDDO + A(POSPV1) = ONE + ENDIF + PIVOT = A(POSPV1) + GO TO 415 + ENDIF + IF ((KEEP(19).EQ.0).AND.(KEEP(110).EQ.0)) THEN + IF (max(AMAX,RMAX,abs(PIVOT)).LE.TOL) THEN + IF(SEUIL .GT. epsilon(SEUIL)) THEN + IF(real(PIVOT) .GE. RZERO) THEN + A(POSPV1) = CSEUIL + ELSE + A(POSPV1) = -CSEUIL + ENDIF + PIVOT = A(POSPV1) + KEEP(98) = KEEP(98)+1 + GO TO 415 + ENDIF + ENDIF + ENDIF + IF (max(AMAX,abs(PIVOT)).LE.TOL) GO TO 460 + IF (abs(PIVOT).GT.max(UULOC*max(RMAX,AMAX),SEUIL)) THEN + IF (KEEP(258) .NE.0 ) THEN + CALL CMUMPS_762(PIVOT, DKEEP(6), KEEP(259)) + ENDIF + GO TO 415 + END IF + IF (AMAX.LE.TOL) GO TO 460 + IF (RMAX.LT.AMAX) THEN + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(int(POSPV1-JJ) .NE. IPIV-JMAX) THEN + RMAX = max(RMAX,abs(A(JJ))) + ENDIF + ENDDO + J1 = POSPV1 + LDA8 + DO J=1,NASS-IPIV + IF(IPIV+J .NE. JMAX) THEN + RMAX = max(abs(A(J1)),RMAX) + ENDIF + J1 = J1 + LDA8 + ENDDO + ENDIF + APOSJ = POSELT + int(JMAX-1,8)*LDA8 + int(NPIV,8) + POSPV2 = APOSJ + int(JMAX - NPIVP1,8) + IF (IPIV.LT.JMAX) THEN + OFFDAG = APOSJ + int(IPIV - NPIVP1,8) + ELSE + OFFDAG = APOS + int(JMAX - NPIVP1,8) + END IF + TMAX = RZERO + IF(JMAX .LT. IPIV) THEN + JJ_ini = POSPV2 + OMP_FLAG = (NFRONT-JMAX-KEEP(253). GE. 300) + DO K = 1, NFRONT - JMAX - KEEP(253) + JJ = JJ_ini+ int(K,8)*NFRONT8 + IF (JMAX+K.NE.IPIV) THEN + TMAX=max(TMAX,abs(A(JJ))) + ENDIF + ENDDO + DO KK = APOSJ, POSPV2-1_8 + TMAX = max(TMAX,abs(A(KK))) + ENDDO + ELSE + JJ_ini = POSPV2 + OMP_FLAG = (NFRONT-JMAX-KEEP(253). GE. 300) + DO K = 1, NFRONT-JMAX-KEEP(253) + JJ = JJ_ini + int(K,8)*NFRONT8 + TMAX=max(TMAX,abs(A(JJ))) + ENDDO + DO KK = APOSJ, POSPV2 - 1_8 + IF (KK.NE.OFFDAG) THEN + TMAX = max(TMAX,abs(A(KK))) + ENDIF + ENDDO + ENDIF + DETPIV = A(POSPV1)*A(POSPV2) - A(OFFDAG)**2 + IF (SEUIL.GT.RZERO) THEN + IF (sqrt(abs(DETPIV)) .LE. SEUIL ) GOTO 460 + ENDIF + MAXPIV = max(abs(A(POSPV1)),abs(A(POSPV2))) + IF (MAXPIV.EQ.RZERO) MAXPIV = RONE + IF (abs(DETPIV)/MAXPIV.LE.TOL) GO TO 460 + IF ((abs(A(POSPV2))*RMAX+AMAX*TMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF ((abs(A(POSPV1))*TMAX+AMAX*RMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF (KEEP(258) .NE.0 ) THEN + CALL CMUMPS_762(DETPIV, DKEEP(6), KEEP(259)) + ENDIF + PIVSIZ = 2 + KEEP(103) = KEEP(103)+1 + 415 CONTINUE + DO K=1,PIVSIZ + IF (PIVSIZ .EQ. 2) THEN + IF (K==1) THEN + LPIV = min(IPIV,JMAX) + ELSE + LPIV = max(IPIV,JMAX) + ENDIF + ELSE + LPIV = IPIV + ENDIF + IF (LPIV.EQ.NPIVP1) THEN + GOTO 416 + ENDIF + CALL CMUMPS_319( A, LA, IW, LIW, + & IOLDPS, NPIVP1, LPIV, POSELT, NASS, + & LDA, NFRONT, 1, KEEP(219), KEEP(50), + & KEEP(IXSZ)) + 416 CONTINUE + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL CMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, LPIV, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + NPIVP1 = NPIVP1 + 1 + ENDDO + IF(PIVSIZ .EQ. 2) THEN + A(POSELT+(LDA8+1_8)*int(NPIV,8)+1_8) = DETPIV + ENDIF + GOTO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 420 + 630 CONTINUE + PIVSIZ = 0 + IFLAG = -10 + 420 CONTINUE + IS_MAXFROMM_AVAIL = .FALSE. + RETURN + END SUBROUTINE CMUMPS_222 + SUBROUTINE CMUMPS_680( PIVRPTR, NBPANELS, PIVR, NASS, + & K, P, LastPanelonDisk, + & LastPIVRPTRIndexFilled) + IMPLICIT NONE + INTEGER, intent(in) :: NBPANELS, NASS, K, P + INTEGER, intent(inout) :: PIVRPTR(NBPANELS), PIVR(NASS) + INTEGER LastPanelonDisk, LastPIVRPTRIndexFilled + INTEGER I + IF ( LastPanelonDisk+1 > NBPANELS ) THEN + WRITE(*,*) "INTERNAL ERROR IN CMUMPS_680!" + WRITE(*,*) "NASS=",NASS,"PIVRPTR=",PIVRPTR(1:NBPANELS) + WRITE(*,*) "K=",K, "P=",P, "LastPanelonDisk=",LastPanelonDisk + WRITE(*,*) "LastPIVRPTRIndexFilled=", LastPIVRPTRIndexFilled + CALL MUMPS_ABORT() + ENDIF + PIVRPTR(LastPanelonDisk+1) = K + 1 + IF (LastPanelonDisk.NE.0) THEN + PIVR(K - PIVRPTR(1) + 1) = P + DO I = LastPIVRPTRIndexFilled + 1, LastPanelonDisk + PIVRPTR(I)=PIVRPTR(LastPIVRPTRIndexFilled) + ENDDO + ENDIF + LastPIVRPTRIndexFilled = LastPanelonDisk + 1 + RETURN + END SUBROUTINE CMUMPS_680 + SUBROUTINE CMUMPS_226(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW, + & A,LA,LDA, POSTPONE_COL_UPDATE, + & IOLDPS,POSELT,IFINB,LKJIB,PIVSIZ,XSIZE, + & MAXFROMM, IS_MAXFROMM_AVAIL, IS_MAX_USEFUL, + & KEEP253) + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFINB,LKJIB, + & NPBEG, IBEG_BLOCK + INTEGER LDA + INTEGER(8) :: LA + INTEGER(8) :: NFRONT8 + COMPLEX A(LA) + LOGICAL POSTPONE_COL_UPDATE + INTEGER IW(LIW) + COMPLEX VALPIV + INTEGER(8) :: POSELT + REAL, intent(out) :: MAXFROMM + LOGICAL, intent(out) :: IS_MAXFROMM_AVAIL + LOGICAL, intent(in) :: IS_MAX_USEFUL + INTEGER, INTENT(in) :: KEEP253 + REAL :: MAXFROMMTMP + INTEGER IOLDPS, NCB1 + INTEGER(8) :: LDA8 + INTEGER(8) :: K1POS + INTEGER NPIV,JROW2 + INTEGER NEL2,NEL + INTEGER XSIZE + COMPLEX ONE, ZERO + INTEGER(8) :: APOS, LPOS, LPOS1, LPOS2 + INTEGER(8) :: POSPV1, POSPV2 + INTEGER PIVSIZ,NPIV_NEW,J2,I + INTEGER(8) :: OFFDAG, OFFDAG_OLD, IBEG, IEND + INTEGER(8) :: JJ, K1, K2, IROW + COMPLEX SWOP,DETPIV,MULT1,MULT2 + INCLUDE 'mumps_headers.h' + PARAMETER(ONE = (1.0E0,0.0E0), + & ZERO = (0.0E0,0.0E0)) + LDA8 = int(LDA,8) + NFRONT8= int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIV_NEW = NPIV + PIVSIZ + NEL = NFRONT - NPIV_NEW + IFINB = 0 + IS_MAXFROMM_AVAIL = .FALSE. + JROW2 = IW(IOLDPS+3+XSIZE) + NPBEG = IBEG_BLOCK + NEL2 = JROW2 - NPIV_NEW + IF (NEL2.EQ.0) THEN + IF (JROW2.EQ.NASS) THEN + IFINB = -1 + ELSE + IFINB = 1 + ENDIF + ENDIF + IF(PIVSIZ .EQ. 1) THEN + APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + VALPIV = ONE/A(APOS) + A(APOS) = VALPIV + LPOS = APOS + LDA8 + MAXFROMM = 0.0E00 + IF (NEL2 > 0) THEN + IF (.NOT. IS_MAX_USEFUL) THEN + DO I=1, NEL2 + K1POS = LPOS + int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + DO JJ=1_8, int(I,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + ELSE + IS_MAXFROMM_AVAIL = .TRUE. + DO I=1, NEL2 + K1POS = LPOS + int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + A(K1POS+1_8)=A(K1POS+1_8) - A(K1POS) * A(APOS+1_8) + MAXFROMM=max( MAXFROMM,abs(A(K1POS+1_8)) ) + DO JJ = 2_8, int(I,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + ENDIF + ENDIF + IF (POSTPONE_COL_UPDATE) THEN + NCB1 = NASS - JROW2 + ELSE + NCB1 = NFRONT - JROW2 + ENDIF + IF (.NOT. IS_MAX_USEFUL) THEN + DO I=NEL2+1, NEL2 + NCB1 + K1POS = LPOS+ int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + DO JJ = 1_8, int(NEL2,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + ELSE + MAXFROMMTMP=0.0E0 + DO I=NEL2+1, NEL2 + NCB1 - KEEP253 + K1POS = LPOS+ int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + IF (NEL2 > 0) THEN + A(K1POS+1_8) = A(K1POS+1_8) - A(K1POS) * A(APOS+1_8) + MAXFROMMTMP=max(MAXFROMMTMP, abs(A(K1POS+1_8))) + DO JJ = 2_8, int(NEL2,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDIF + ENDDO + DO I = NEL2 + NCB1 - KEEP253 + 1, NEL2 + NCB1 + K1POS = LPOS+ int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + DO JJ = 1_8, int(NEL2,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + MAXFROMM=max(MAXFROMM, MAXFROMMTMP) + ENDIF + ELSE + POSPV1 = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + POSPV2 = POSPV1 + NFRONT8 + 1_8 + OFFDAG_OLD = POSPV2 - 1_8 + OFFDAG = POSPV1 + 1_8 + SWOP = A(POSPV2) + DETPIV = A(OFFDAG) + A(POSPV2) = A(POSPV1)/DETPIV + A(POSPV1) = SWOP/DETPIV + A(OFFDAG) = -A(OFFDAG_OLD)/DETPIV + A(OFFDAG_OLD) = ZERO + LPOS1 = POSPV2 + LDA8 - 1_8 + LPOS2 = LPOS1 + 1_8 + CALL ccopy(NFRONT-NPIV_NEW, A(LPOS1), LDA, A(POSPV1+2_8), 1) + CALL ccopy(NFRONT-NPIV_NEW, A(LPOS2), LDA, A(POSPV2+1_8), 1) + JJ = POSPV2 + NFRONT8-1_8 + IBEG = JJ + 2_8 + IEND = IBEG + DO J2 = 1,NEL2 + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(OFFDAG)*A(K2)) + MULT2 = - (A(OFFDAG)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1 + 2_8 + K2 = POSPV2 + 1_8 + DO IROW = IBEG, IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A( JJ ) = -MULT1 + A( JJ + 1_8 ) = -MULT2 + IBEG = IBEG + NFRONT8 + IEND = IEND + NFRONT8 + 1_8 + JJ = JJ+NFRONT8 + ENDDO + IEND = IEND-1_8 + DO J2 = JROW2+1,NFRONT + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(OFFDAG)*A(K2)) + MULT2 = - (A(OFFDAG)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1 + 2_8 + K2 = POSPV2 + 1_8 + DO IROW = IBEG, IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A( JJ ) = -MULT1 + A( JJ + 1_8 ) = -MULT2 + IBEG = IBEG + NFRONT8 + IEND = IEND + NFRONT8 + JJ = JJ + NFRONT8 + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_226 + SUBROUTINE CMUMPS_230(NFRONT,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT) + IMPLICIT NONE + INTEGER NFRONT,N,INODE,LIW + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER IW(LIW) + COMPLEX VALPIV + INTEGER (8) :: APOS, POSELT, LPOS, NFRONT8 + INTEGER IOLDPS,NEL + INTEGER JROW + COMPLEX, PARAMETER :: ONE = (1.0E0,0.0E0) + APOS = POSELT + VALPIV = ONE/A(APOS) + A(APOS) = VALPIV + NEL = NFRONT - 1 + IF (NEL.EQ.0) GO TO 500 + NFRONT8 = int(NFRONT,8) + LPOS = APOS + NFRONT8 + CALL CMUMPS_XSYR('U',NEL, -VALPIV, + & A(LPOS), NFRONT, A(LPOS+1_8), NFRONT) + DO JROW = 1,NEL + A(LPOS) = VALPIV*A(LPOS) + LPOS = LPOS + NFRONT8 + END DO + 500 CONTINUE + RETURN + END SUBROUTINE CMUMPS_230 + SUBROUTINE CMUMPS_234(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, + & IOLDPS,POSELT,LKJIB_ORIG,LKJIB,LKJIT, + & POSTPONE_COL_UPDATE, + & KEEP,KEEP8 ) + IMPLICIT NONE + INTEGER NFRONT, NASS,N,LIW, IBEG_BLOCK + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER IW(LIW) + INTEGER LKJIB_ORIG, LKJIB, INODE, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: POSELT + INTEGER LDA + INTEGER(8) :: LDA8 + INTEGER IOLDPS, NPIV, JROW2, NPBEG + INTEGER NONEL, LKJIW, NEL1, NEL11 + INTEGER LBP, HF + INTEGER(8) :: LPOS,UPOS,APOS + INTEGER LKJIT + INTEGER LKJIBOLD, IROW + INTEGER I, Block + INTEGER BLSIZE + LOGICAL POSTPONE_COL_UPDATE + COMPLEX ONE, ALPHA + INCLUDE 'mumps_headers.h' + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + LDA8 = int(LDA,8) + LKJIBOLD = LKJIB + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + JROW2 = iabs(IW(IOLDPS+3+KEEP(IXSZ))) + NPBEG = IBEG_BLOCK + HF = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + NEL1 = NASS - JROW2 + LKJIW = NPIV - NPBEG + 1 + NEL11 = NFRONT - NPIV + IF ( LKJIW .NE. LKJIB ) THEN + NONEL = JROW2 - NPIV + 1 + IF ((NASS-NPIV).GE.LKJIT) THEN + LKJIB = LKJIB_ORIG + NONEL + IW(IOLDPS+3+KEEP(IXSZ))= min0(NPIV+LKJIB,NASS) + LKJIB = min0(LKJIB, NASS - NPIV) + ELSE + LKJIB = NASS - NPIV + IW(IOLDPS+3+KEEP(IXSZ)) = NASS + ENDIF + IBEG_BLOCK = NPIV + 1 + ELSEIF (JROW2.LT.NASS) THEN + IBEG_BLOCK = NPIV + 1 + IW(IOLDPS+3+KEEP(IXSZ)) = min0(JROW2+LKJIB,NASS) + LKJIB = min0(LKJIB,NASS-NPIV) + ENDIF + IF (LKJIW.EQ.0) GO TO 500 + IF (NEL1.NE.0) THEN + IF ( NASS - JROW2 > KEEP(7) ) THEN + BLSIZE = KEEP(8) + ELSE + BLSIZE = NASS - JROW2 + END IF + IF ( NASS - JROW2 .GT. 0 ) THEN +#if defined(SAK_BYROW) + DO IROW = JROW2+1, NASS, BLSIZE + Block = min( BLSIZE, NASS - IROW + 1 ) + LPOS = POSELT + int(IROW - 1,8) * LDA8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG - 1,8) * LDA8 + int(IROW - 1,8) + APOS = POSELT + int(IROW - 1,8) * LDA8 + int(JROW2,8) + CALL cgemm( 'N','N', IROW + Block - JROW2 - 1, Block, LKJIW, + & ALPHA, A( UPOS ), LDA, + & A( LPOS ), LDA, ONE, A( APOS ), LDA ) + ENDDO +#else + DO IROW = JROW2+1, NASS, BLSIZE + Block = min( BLSIZE, NASS - IROW + 1 ) + LPOS = POSELT + int( IROW - 1,8) * LDA8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG - 1,8) * LDA8 + int( IROW - 1,8) + APOS = POSELT + int( IROW - 1,8) * LDA8 + int( IROW - 1,8) + CALL cgemm( 'N','N', Block, NASS - IROW + 1, LKJIW, + & ALPHA, A( UPOS ), LDA, + & A( LPOS ), LDA, ONE, A( APOS ), LDA ) + END DO +#endif + END IF + LPOS = POSELT + int(NASS,8)*LDA8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG-1,8) * LDA8 + int(JROW2,8) + APOS = POSELT + int(NASS,8)*LDA8 + int(JROW2,8) + IF ( .NOT. POSTPONE_COL_UPDATE ) THEN + CALL cgemm('N', 'N', NEL1, NFRONT-NASS, LKJIW, ALPHA, + & A(UPOS), LDA, A(LPOS), LDA, ONE, + & A(APOS), LDA) + END IF + ENDIF + 500 CONTINUE + RETURN + END SUBROUTINE CMUMPS_234 + SUBROUTINE CMUMPS_319( A, LA, IW, LIW, + & IOLDPS, NPIVP1, IPIV, POSELT, NASS, + & LDA, NFRONT, LEVEL, K219, K50, XSIZE ) + IMPLICIT NONE + INTEGER(8) :: POSELT, LA + INTEGER LIW, IOLDPS, NPIVP1, IPIV + INTEGER LDA, NFRONT, NASS, LEVEL, K219, K50, XSIZE + COMPLEX A( LA ) + INTEGER IW( LIW ) + INCLUDE 'mumps_headers.h' + INTEGER ISW, ISWPS1, ISWPS2, HF + INTEGER(8) :: IDIAG, APOS + INTEGER(8) :: LDA8 + COMPLEX SWOP + LDA8 = int(LDA,8) + APOS = POSELT + LDA8*int(IPIV-1,8) + int(NPIVP1-1,8) + IDIAG = APOS + int(IPIV - NPIVP1,8) + HF = 6 + IW( IOLDPS + 5 + XSIZE) + XSIZE + ISWPS1 = IOLDPS + HF + NPIVP1 - 1 + ISWPS2 = IOLDPS + HF + IPIV - 1 + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + ISW = IW(ISWPS1+NFRONT) + IW(ISWPS1+NFRONT) = IW(ISWPS2+NFRONT) + IW(ISWPS2+NFRONT) = ISW + IF ( LEVEL .eq. 2 ) THEN + CALL cswap( NPIVP1 - 1, + & A( POSELT + int(NPIVP1-1,8) ), LDA, + & A( POSELT + int(IPIV-1,8) ), LDA ) + END IF + CALL cswap( NPIVP1-1, + & A( POSELT+int(NPIVP1-1,8) * LDA8 ), 1, + & A( POSELT + int(IPIV-1,8) * LDA8 ), 1 ) + CALL cswap( IPIV - NPIVP1 - 1, + & A( POSELT+int(NPIVP1,8) * LDA8 + int(NPIVP1-1,8) ), + & LDA, A( APOS + 1_8 ), 1 ) + SWOP = A(IDIAG) + A(IDIAG) = A( POSELT+int(NPIVP1-1,8)*LDA8+int(NPIVP1-1,8) ) + A( POSELT + int(NPIVP1-1,8)*LDA8 + int(NPIVP1-1,8) ) = SWOP + CALL cswap( NASS - IPIV, A( APOS + LDA8 ), LDA, + & A( IDIAG + LDA8 ), LDA ) + IF ( LEVEL .eq. 1 ) THEN + CALL cswap( NFRONT - NASS, + & A( APOS + int(NASS-IPIV+1,8) * LDA8 ), LDA, + & A( IDIAG + int(NASS-IPIV+1,8) * LDA8 ), LDA ) + END IF + IF (K219.NE.0 .AND.K50.EQ.2) THEN + IF ( LEVEL .eq. 2) THEN + APOS = POSELT+LDA8*LDA8-1_8 + SWOP = A(APOS+int(NPIVP1,8)) + A(APOS+int(NPIVP1,8))= A(APOS+int(IPIV,8)) + A(APOS+int(IPIV,8)) = SWOP + ENDIF + ENDIF + RETURN + END SUBROUTINE CMUMPS_319 + SUBROUTINE CMUMPS_237(NFRONT,NASS,N,INODE, + & IW,LIW,A,LA, + & LDA, + & IOLDPS,POSELT,KEEP,KEEP8, + & POSTPONE_COL_UPDATE, ETATASS, + & TYPEFile, LAFAC, MonBloc, NextPiv2beWritten, + & LIWFAC, MYID, IFLAG + & ) + USE CMUMPS_OOC + IMPLICIT NONE + INTEGER NFRONT, NASS,N,INODE,LIW + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER IW(LIW) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: POSELT + INTEGER LDA + INTEGER IOLDPS, ETATASS + LOGICAL POSTPONE_COL_UPDATE + INTEGER(8) :: LAFAC + INTEGER TYPEFile, NextPiv2beWritten + INTEGER LIWFAC, MYID, IFLAG + TYPE(IO_BLOCK):: MonBloc + INTEGER IDUMMY + LOGICAL LAST_CALL + INCLUDE 'mumps_headers.h' + INTEGER(8) :: UPOS, APOS, LPOS + INTEGER(8) :: LDA8 + INTEGER BLSIZE, BLSIZE2, Block, IROW, NPIV, I, IROWEND + INTEGER I2, I2END, Block2 + COMPLEX ONE, ALPHA, BETA, ZERO + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + PARAMETER (ZERO=(0.0E0,0.0E0)) + LDA8 = int(LDA,8) + IF (ETATASS.EQ.1) THEN + BETA = ZERO + ELSE + BETA = ONE + ENDIF + IF ( NFRONT - NASS > KEEP(57) ) THEN + BLSIZE = KEEP(58) + ELSE + BLSIZE = NFRONT - NASS + END IF + BLSIZE2 = KEEP(218) + NPIV = IW( IOLDPS + 1 + KEEP(IXSZ)) + IF ( NFRONT - NASS .GT. 0 ) THEN + IF ( POSTPONE_COL_UPDATE ) THEN + CALL ctrsm( 'L', 'U', 'T', 'U', + & NPIV, NFRONT-NPIV, ONE, + & A( POSELT ), LDA, + & A( POSELT + LDA8 * int(NPIV,8) ), LDA ) + ENDIF + DO IROWEND = NFRONT - NASS, 1, -BLSIZE + Block = min( BLSIZE, IROWEND ) + IROW = IROWEND - Block + 1 + LPOS = POSELT + int(NASS,8)*LDA8 + int(IROW-1,8) * LDA8 + APOS = POSELT + int(NASS,8)*LDA8 + int(IROW-1,8) * LDA8 + + & int(NASS + IROW - 1,8) + UPOS = POSELT + int(NASS,8) + IF (.NOT. POSTPONE_COL_UPDATE) THEN + UPOS = POSELT + int(NASS + IROW - 1,8) + ENDIF + IF (POSTPONE_COL_UPDATE) THEN + DO I = 1, NPIV + CALL ccopy( Block, A( LPOS+int(I-1,8) ), LDA, + & A( UPOS+int(I-1,8)*LDA8 ), 1 ) + CALL cscal( Block, A(POSELT+(LDA8+1_8)*int(I-1,8)), + & A( LPOS + int(I - 1,8) ), LDA ) + ENDDO + ENDIF + DO I2END = Block, 1, -BLSIZE2 + Block2 = min(BLSIZE2, I2END) + I2 = I2END - Block2+1 + CALL cgemm('N', 'N', Block2, Block-I2+1, NPIV, ALPHA, + & A(UPOS+int(I2-1,8)), LDA, + & A(LPOS+int(I2-1,8)*LDA8), LDA, + & BETA, + & A(APOS + int(I2-1,8) + int(I2-1,8)*LDA8), LDA) + IF (KEEP(201).EQ.1) THEN + IF (NextPiv2beWritten.LE.NPIV) THEN + LAST_CALL=.FALSE. + CALL CMUMPS_688( + & STRAT_TRY_WRITE, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, MYID, + & KEEP8(31), + & IFLAG,LAST_CALL ) + IF (IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + ENDDO + IF ( NFRONT - NASS - IROW + 1 - Block > 0 ) THEN + CALL cgemm( 'N', 'N', Block, NFRONT-NASS-Block-IROW+1, NPIV, + & ALPHA, A( UPOS ), LDA, + & A( LPOS + LDA8 * int(Block,8) ), LDA, + & BETA, + & A( APOS + LDA8 * int(Block,8) ), LDA ) + ENDIF + END DO + END IF + RETURN + END SUBROUTINE CMUMPS_237 + SUBROUTINE CMUMPS_320( BUF, BLOCK_SIZE, + & MYROW, MYCOL, NPROW, NPCOL, + & A, LOCAL_M, LOCAL_N, N, MYID, COMM ) + IMPLICIT NONE + INTEGER BLOCK_SIZE, NPROW, NPCOL, LOCAL_M, LOCAL_N, N, COMM + INTEGER MYROW, MYCOL, MYID + COMPLEX BUF( BLOCK_SIZE * BLOCK_SIZE ) + COMPLEX A( LOCAL_M, LOCAL_N ) + INTEGER NBLOCK, IBLOCK, JBLOCK, IBLOCK_SIZE, JBLOCK_SIZE + INTEGER ROW_SOURCE, ROW_DEST, COL_SOURCE, COL_DEST + INTEGER IGLOB, JGLOB + INTEGER IROW_LOC_SOURCE, JCOL_LOC_SOURCE + INTEGER IROW_LOC_DEST, JCOL_LOC_DEST + INTEGER PROC_SOURCE, PROC_DEST + NBLOCK = ( N - 1 ) / BLOCK_SIZE + 1 + DO IBLOCK = 1, NBLOCK + IF ( IBLOCK .NE. NBLOCK + & ) THEN + IBLOCK_SIZE = BLOCK_SIZE + ELSE + IBLOCK_SIZE = N - ( NBLOCK - 1 ) * BLOCK_SIZE + END IF + ROW_SOURCE = mod( IBLOCK - 1, NPROW ) + COL_DEST = mod( IBLOCK - 1, NPCOL ) + IGLOB = ( IBLOCK - 1 ) * BLOCK_SIZE + 1 + IROW_LOC_SOURCE = BLOCK_SIZE * + & ( ( IGLOB - 1 ) / (BLOCK_SIZE*NPROW) ) + & + mod( IGLOB - 1, BLOCK_SIZE ) + 1 + JCOL_LOC_DEST = BLOCK_SIZE * + & ( ( IGLOB - 1 ) / (BLOCK_SIZE*NPCOL) ) + & + mod( IGLOB - 1, BLOCK_SIZE ) + 1 + DO JBLOCK = 1, IBLOCK + IF ( JBLOCK .NE. NBLOCK + & ) THEN + JBLOCK_SIZE = BLOCK_SIZE + ELSE + JBLOCK_SIZE = N - ( NBLOCK - 1 ) * BLOCK_SIZE + END IF + COL_SOURCE = mod( JBLOCK - 1, NPCOL ) + ROW_DEST = mod( JBLOCK - 1, NPROW ) + PROC_SOURCE = ROW_SOURCE * NPCOL + COL_SOURCE + PROC_DEST = ROW_DEST * NPCOL + COL_DEST + IF ( PROC_SOURCE .eq. PROC_DEST ) THEN + IF ( MYID .eq. PROC_DEST ) THEN + JGLOB = ( JBLOCK - 1 ) * BLOCK_SIZE + 1 + JCOL_LOC_SOURCE = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPCOL) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + IROW_LOC_DEST = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPROW) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + IF ( IBLOCK .eq. JBLOCK ) THEN + IF ( IBLOCK_SIZE .ne. JBLOCK_SIZE ) THEN + WRITE(*,*) MYID,': Error in calling transdiag:unsym' + CALL MUMPS_ABORT() + END IF + CALL CMUMPS_327( A( IROW_LOC_SOURCE, + & JCOL_LOC_SOURCE), + & IBLOCK_SIZE, LOCAL_M ) + ELSE + CALL CMUMPS_326( + & A( IROW_LOC_SOURCE, JCOL_LOC_SOURCE ), + & A( IROW_LOC_DEST, JCOL_LOC_DEST ), + & IBLOCK_SIZE, JBLOCK_SIZE, LOCAL_M ) + END IF + END IF + ELSE IF ( MYROW .eq. ROW_SOURCE + & .AND. MYCOL .eq. COL_SOURCE ) THEN + JGLOB = ( JBLOCK - 1 ) * BLOCK_SIZE + 1 + JCOL_LOC_SOURCE = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPCOL) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + CALL CMUMPS_293( BUF, + & A( IROW_LOC_SOURCE, JCOL_LOC_SOURCE ), LOCAL_M, + & IBLOCK_SIZE, JBLOCK_SIZE, COMM, PROC_DEST ) + ELSE IF ( MYROW .eq. ROW_DEST + & .AND. MYCOL .eq. COL_DEST ) THEN + JGLOB = ( JBLOCK - 1 ) * BLOCK_SIZE + 1 + IROW_LOC_DEST = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPROW) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + CALL CMUMPS_281( BUF, + & A( IROW_LOC_DEST, JCOL_LOC_DEST ), LOCAL_M, + & JBLOCK_SIZE, IBLOCK_SIZE, COMM, PROC_SOURCE ) + END IF + END DO + END DO + RETURN + END SUBROUTINE CMUMPS_320 + SUBROUTINE CMUMPS_293( BUF, A, LDA, M, N, COMM, DEST ) + IMPLICIT NONE + INTEGER M, N, LDA, DEST, COMM + COMPLEX BUF(*), A(LDA,*) + INTEGER I, IBUF, IERR + INTEGER J + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + IBUF = 1 + DO J = 1, N + BUF( IBUF: IBUF + M - 1 ) = A( 1 : M, J ) + DO I = 1, M + END DO + IBUF = IBUF + M + END DO + CALL MPI_SEND( BUF, M * N, MPI_COMPLEX, + & DEST, SYMMETRIZE, COMM, IERR ) + RETURN + END SUBROUTINE CMUMPS_293 + SUBROUTINE CMUMPS_281( BUF, A, LDA, M, N, COMM, SOURCE ) + IMPLICIT NONE + INTEGER LDA, M, N, COMM, SOURCE + COMPLEX BUF(*), A( LDA, *) + INTEGER I, IBUF, IERR + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + CALL MPI_RECV( BUF(1), M * N, MPI_COMPLEX, SOURCE, + & SYMMETRIZE, COMM, STATUS, IERR ) + IBUF = 1 + DO I = 1, M + CALL ccopy( N, BUF(IBUF), 1, A(I,1), LDA ) + IBUF = IBUF + N + END DO + RETURN + END SUBROUTINE CMUMPS_281 + SUBROUTINE CMUMPS_327( A, N, LDA ) + IMPLICIT NONE + INTEGER N,LDA + COMPLEX A( LDA, * ) + INTEGER I, J + DO I = 2, N + DO J = 1, I - 1 + A( J, I ) = A( I, J ) + END DO + END DO + RETURN + END SUBROUTINE CMUMPS_327 + SUBROUTINE CMUMPS_326( A1, A2, M, N, LD ) + IMPLICIT NONE + INTEGER M,N,LD + COMPLEX A1( LD,* ), A2( LD, * ) + INTEGER I, J + DO J = 1, N + DO I = 1, M + A2( J, I ) = A1( I, J ) + END DO + END DO + RETURN + END SUBROUTINE CMUMPS_326 + RECURSIVE SUBROUTINE CMUMPS_274( + & COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE CMUMPS_COMM_BUFFER + USE CMUMPS_LOAD + USE CMUMPS_OOC + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mumps_headers.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER(8) IPTRLU, LRLU, LRLUS, LA, POSFAC + INTEGER COMP + INTEGER IFLAG, IERROR, NBFIN, MSGSOU + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)) + INTEGER(8) PTRAST(KEEP(28)), PTRFAC(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER NBPROCFILS( KEEP(28) ), STEP(N), + & PIMASTER(KEEP(28)) + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER COMM, MYID + INTEGER PTLUST_S(KEEP(28)), + & ITLOC(N+KEEP(253)), FILS(N), ND(KEEP(28)) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER FRERE_STEPS(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION FLOP1 + COMPLEX DBLARR( max(1,KEEP(13)) ) + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER PIVI + INTEGER (8) POSPV1,POSPV2,OFFDAG,LPOS1 + INTEGER J2 + COMPLEX MULT1,MULT2 + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER LP + INTEGER INODE, POSITION, NPIV, IERR + INTEGER NCOL + INTEGER(8) LAELL, POSBLOCFACTO + INTEGER(8) POSELT + INTEGER IOLDPS, LCONT1, NASS1, NROW1, NCOL1, NPIV1 + INTEGER NSLAV1, HS, ISW, DEST + INTEGER ICT11 + INTEGER(8) LPOS, LPOS2, DPOS, UPOS + INTEGER (8) IPOS, KPOS + INTEGER I, IPIV, FPERE, NSLAVES_TOT, + & NSLAVES_FOLLOW, NB_BLOC_FAC + INTEGER IPOSK, JPOSK, NPIVSENT, Block, IROW, BLSIZE + INTEGER allocok, TO_UPDATE_CPT_END + COMPLEX, DIMENSION(:),ALLOCATABLE :: UIP21K + INTEGER, DIMENSION(:), ALLOCATABLE :: LIST_SLAVES_FOLLOW + LOGICAL LASTBL + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + COMPLEX ONE,ALPHA + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, NextPivDummy + LOGICAL LAST_CALL + TYPE(IO_BLOCK) :: MonBloc + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + FPERE = -1 + POSITION = 0 + TO_UPDATE_CPT_END = -654321 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, + & MPI_INTEGER, COMM, IERR ) + LASTBL = (NPIV.LE.0) + IF (LASTBL) THEN + NPIV = -NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NSLAVES_TOT, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NB_BLOC_FAC, 1, + & MPI_INTEGER, COMM, IERR ) + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOL, 1, + & MPI_INTEGER, COMM, IERR ) + LAELL = int(NPIV,8) * int(NCOL,8) + IF ( NPIV.GT.0 ) THEN + IF ( LRLU .LT. LAELL .OR. IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LAELL ) THEN + IFLAG = -9 + CALL MUMPS_731(LAELL-LRLUS, IERROR) + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE IN CMUMPS_274, + & REAL WORKSPACE TOO SMALL" + GOTO 700 + END IF + CALL CMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS=' + & ,LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731(LAELL-LRLUS,IERROR) + GOTO 700 + END IF + IF ( IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE IN CMUMPS_274, + & INTEGER WORKSPACE TOO SMALL" + IFLAG = -8 + IERROR = IWPOS + NPIV - 1 - IWPOSCB + GOTO 700 + END IF + END IF + LRLU = LRLU - LAELL + LRLUS = LRLUS - LAELL + ENDIF + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSBLOCFACTO = POSFAC + POSFAC = POSFAC + LAELL + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LAELL,KEEP,KEEP8,LRLU) + IF ( NPIV.GT.0 ) THEN + IPIV = IWPOS + IWPOS = IWPOS + NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IPIV ), NPIV, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSBLOCFACTO), NPIV*NCOL, MPI_COMPLEX, + & COMM, IERR ) + ENDIF + IF (PTRIST(STEP( INODE )) .EQ. 0) THEN + DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 ) + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + ENDIF + DO WHILE ( NBPROCFILS(STEP(INODE)) .NE. 0 ) + BLOCKING = .TRUE. + SET_IRECV=.FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, CONTRIB_TYPE2, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .TRUE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + LCONT1 = IW( IOLDPS + KEEP(IXSZ)) + NASS1 = IW( IOLDPS + 1 + KEEP(IXSZ)) + NROW1 = IW( IOLDPS + 2 + KEEP(IXSZ)) + NPIV1 = IW( IOLDPS + 3 + KEEP(IXSZ)) + NSLAV1 = IW( IOLDPS + 5 + KEEP(IXSZ)) + NSLAVES_FOLLOW = NSLAV1 - XTRA_SLAVES_SYM + HS = 6 + NSLAV1 + KEEP(IXSZ) + NCOL1 = LCONT1 + NPIV1 + IF ( LASTBL ) THEN + TO_UPDATE_CPT_END = ( NSLAVES_TOT - NSLAVES_FOLLOW - 1 ) * + & NB_BLOC_FAC + END IF + IF (NPIV.GT.0) THEN + IF ( NPIV1 + NCOL .NE. NASS1 ) THEN + WRITE(*,*) 'SymBLFC Error: NPIV1 + NCOL .NE. NASS1 :', + & NPIV1,NCOL,NASS1 + CALL MUMPS_ABORT() + END IF + ICT11 = IOLDPS+HS+NROW1+NPIV1 - 1 + DO I = 1, NPIV + PIVI = abs(IW(IPIV+I-1)) + IF (PIVI.EQ.I) CYCLE + ISW = IW(ICT11+I) + IW(ICT11+I) = IW(ICT11+PIVI) + IW(ICT11+PIVI) = ISW + IPOS = POSELT + int(NPIV1 + I - 1,8) + KPOS = POSELT + int(NPIV1 + PIVI - 1,8) + CALL cswap(NROW1, A(IPOS), NCOL1, A(KPOS), NCOL1) + ENDDO + ALLOCATE( UIP21K( NPIV * NROW1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": ALLOCATION FAILURE FOR UIP21K IN CMUMPS_274" + IFLAG = -13 + IERROR = NPIV * NROW1 + GOTO 700 + END IF + IF ( NSLAVES_FOLLOW .NE. 0 .and. NPIV .NE. 0 ) THEN + ALLOCATE( LIST_SLAVES_FOLLOW ( NSLAVES_FOLLOW ), + & stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": ALLOCATION FAILURE FOR LIST_SLAVES_FOLLOW + & IN CMUMPS_274" + IFLAG = -13 + IERROR = NSLAVES_FOLLOW + GOTO 700 + END IF + LIST_SLAVES_FOLLOW(1:NSLAVES_FOLLOW)= + & IW(IOLDPS+6+XTRA_SLAVES_SYM+KEEP(IXSZ): + & IOLDPS+5+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_FOLLOW) + END IF + CALL ctrsm( 'L', 'U', 'T', 'U', NPIV, NROW1, ONE, + & A( POSBLOCFACTO ), NCOL, + & A(POSELT+int(NPIV1,8)), NCOL1 ) + LPOS = POSELT + int(NPIV1,8) + UPOS = 1_8 + DO I = 1, NROW1 + UIP21K( UPOS: UPOS + int(NPIV-1,8) ) = + & A(LPOS: LPOS+int(NPIV-1,8)) + LPOS = LPOS + int(NCOL1,8) + UPOS = UPOS + int(NPIV,8) + END DO + LPOS = POSELT + int(NPIV1,8) + DPOS = POSBLOCFACTO + I = 1 + DO + IF(I .GT. NPIV) EXIT + IF(IW(IPIV+I-1) .GT. 0) THEN + CALL cscal( NROW1, A(DPOS), A(LPOS), NCOL1 ) + LPOS = LPOS + 1_8 + DPOS = DPOS + int(NCOL + 1,8) + I = I+1 + ELSE + POSPV1 = DPOS + POSPV2 = DPOS+ int(NCOL + 1,8) + OFFDAG = POSPV1+1_8 + LPOS1 = LPOS + DO J2 = 1,NROW1 + MULT1 = A(POSPV1)*A(LPOS1)+A(OFFDAG)*A(LPOS1+1_8) + MULT2 = A(OFFDAG)*A(LPOS1)+A(POSPV2)*A(LPOS1+1_8) + A(LPOS1) = MULT1 + A(LPOS1+1_8) = MULT2 + LPOS1 = LPOS1 + int(NCOL1,8) + ENDDO + LPOS = LPOS + 2_8 + DPOS = POSPV2 + int(NCOL + 1,8) + I = I+2 + ENDIF + ENDDO + ENDIF + IF (KEEP(201).eq.1) THEN + MonBloc%INODE = INODE + MonBloc%MASTER = .FALSE. + MonBloc%Typenode = 2 + MonBloc%NROW = NROW1 + MonBloc%NCOL = NCOL1 + MonBloc%NFS = NASS1 + MonBloc%LastPiv = NPIV1 + NPIV + NULLIFY(MonBloc%INDICES) + MonBloc%Last = LASTBL + STRAT = STRAT_TRY_WRITE + NextPivDummy = -8888 + LIWFAC = IW(IOLDPS+XXI) + CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR)) + LAST_CALL=.FALSE. + CALL CMUMPS_688( STRAT, TYPEF_L, A(POSELT), + & LAFAC, MonBloc, NextPivDummy, NextPivDummy, + & IW(IOLDPS), LIWFAC, MYID, KEEP8(31), IFLAG,LAST_CALL) + ENDIF + IF (NPIV.GT.0) THEN + LPOS2 = POSELT + int(NPIV1,8) + UPOS = POSBLOCFACTO+int(NPIV,8) + LPOS = LPOS2 + int(NPIV,8) + CALL cgemm('N','N', NCOL-NPIV,NROW1,NPIV,ALPHA,A(UPOS),NCOL, + & A(LPOS2),NCOL1,ONE, A(LPOS),NCOL1) + DPOS = POSELT + int(NCOL1 - NROW1,8) + IF ( NROW1 .GT. KEEP(7) ) THEN + BLSIZE = KEEP(8) + ELSE + BLSIZE = NROW1 + ENDIF + IF ( NROW1 .GT. 0 ) THEN + DO IROW = 1, NROW1, BLSIZE + Block = min( BLSIZE, NROW1 - IROW + 1 ) + DPOS = POSELT + int(NCOL1 - NROW1,8) + & + int( IROW - 1, 8 ) * int( NCOL1 + 1, 8 ) + LPOS2 = POSELT + int(NPIV1,8) + & + int( IROW - 1, 8 ) * int( NCOL1, 8 ) + UPOS = int( IROW - 1, 8 ) * int(NPIV, 8) + 1_8 + DO I = 1, Block + CALL cgemv( 'T', NPIV, Block-I+1, ALPHA, + & A( LPOS2 + int(I - 1,8) * int(NCOL1,8) ), NCOL1, + & UIP21K( UPOS + int(NPIV,8) * int( I - 1, 8 ) ), + & 1, ONE, A(DPOS+int(NCOL1+1,8)*int(I-1,8)),NCOL1 ) + END DO + IF ( NROW1-IROW+1-Block .ne. 0 ) + & CALL cgemm( 'T', 'N', Block, NROW1-IROW+1-Block, NPIV, ALPHA, + & UIP21K( UPOS ), NPIV, + & A( LPOS2 + int(Block,8) * int(NCOL1,8) ), NCOL1, ONE, + & A( DPOS + int(Block,8) * int(NCOL1,8) ), NCOL1 ) + ENDDO + ENDIF + FLOP1 = dble(NROW1) * dble(NPIV) * + & dble( 2 * NCOL - NPIV + NROW1 +1 ) + FLOP1 = -FLOP1 + CALL CMUMPS_190( 1, .FALSE., FLOP1, KEEP,KEEP8 ) + ENDIF + IW(IOLDPS+KEEP(IXSZ)) = IW(IOLDPS+KEEP(IXSZ)) - NPIV + IW(IOLDPS + 3+KEEP(IXSZ)) = IW(IOLDPS+3+KEEP(IXSZ)) + NPIV + IF (LASTBL) IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS + 3+KEEP(IXSZ)) + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + IWPOS = IWPOS - NPIV + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + IF ( NSLAVES_FOLLOW .NE. 0 .and. NPIV .NE. 0 ) THEN + IPOSK = NPIV1 + 1 + JPOSK = NCOL1 - NROW1 + 1 + NPIVSENT = NPIV + IERR = -1 + DO WHILE ( IERR .eq. -1 ) + CALL CMUMPS_64( + & INODE, NPIVSENT, FPERE, + & IPOSK, JPOSK, + & UIP21K, NROW1, + & NSLAVES_FOLLOW, + & LIST_SLAVES_FOLLOW(1), + & COMM, IERR ) + IF (IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END IF + END DO + IF ( IERR .eq. -2 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE, SEND BUFFER TOO SMALL DURING + & CMUMPS_274" + WRITE(LP,*) "NPIV=", NPIV, "NROW1=",NROW1 + IFLAG = -17 + IERROR = 5 * KEEP(34) + NPIV * NROW1 * KEEP(35) + GOTO 700 + END IF + IF ( IERR .eq. -3 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE, RECV BUFFER TOO SMALL DURING + & CMUMPS_274" + IFLAG = -20 + IERROR = 5 * KEEP(34) + NPIV * NROW1 * KEEP(35) + GOTO 700 + END IF + DEALLOCATE(LIST_SLAVES_FOLLOW) + END IF + IF ( NPIV .NE. 0 ) DEALLOCATE( UIP21K ) + IOLDPS = PTRIST(STEP(INODE)) + IF (LASTBL) THEN + IW(IOLDPS+6+KEEP(IXSZ)) = IW(IOLDPS+6+KEEP(IXSZ)) - + & TO_UPDATE_CPT_END + IF ( IW(IOLDPS+6+KEEP(IXSZ) ) .eq. 0 + & .and. KEEP(50) .ne. 0 .and. NSLAVES_FOLLOW .eq. 0 + & .and. NSLAVES_TOT.NE.1)THEN + DEST = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + CALL CMUMPS_62( INODE, DEST, END_NIV2_LDLT, + & COMM, IERR ) + IF ( IERR .LT. 0 ) THEN + write(*,*) ' Internal error in PROCESS_SYM_BLOCFACTO.' + IFLAG = -99 + GOTO 700 + END IF + ENDIF + END IF + IF (LASTBL) THEN + IF (IW(IOLDPS+6+KEEP(IXSZ)) .eq. 0 ) THEN + CALL CMUMPS_759( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ENDIF + ENDIF + 600 CONTINUE + RETURN + 700 CONTINUE + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE CMUMPS_274 + RECURSIVE SUBROUTINE CMUMPS_759( + & COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mumps_headers.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER INODE, FPERE + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER COMM, MYID + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER IWPOS, IWPOSCB + INTEGER LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP, IFLAG, IERROR + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER NBFIN, SLAVEF + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER ND( KEEP(28) ) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER FRERE_STEPS(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX DBLARR( max(1,KEEP(13)) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER ITYPE2 + INTEGER IHDR_REC + PARAMETER (ITYPE2=2) + INTEGER IOLDPS, NROW, LDA + INTEGER NPIV, LCONT, NELIM, NASS, NCOL_TO_SEND, + & SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON + INTEGER(8) :: SHIFT_VAL_SON + INTEGER(8) MEM_GAIN + IF (KEEP(50).EQ.0) THEN + IHDR_REC=6 + ELSE + IHDR_REC=8 + ENDIF + IOLDPS = PTRIST(STEP(INODE)) + IW(IOLDPS+XXS)=S_ALL + IF (KEEP(214).EQ.1) THEN + CALL CMUMPS_314( N, INODE, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE2 + & ) + IOLDPS = PTRIST(STEP(INODE)) + IF (KEEP(38).NE.FPERE) THEN + IW(IOLDPS+XXS)=S_NOLCBNOCONTIG + IF (KEEP(216).NE.3) THEN + MEM_GAIN=int(IW( IOLDPS + 2 + KEEP(IXSZ) ),8)* + & int(IW( IOLDPS + 3 + KEEP(IXSZ) ),8) + LRLUS = LRLUS+MEM_GAIN + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLU) + ENDIF + ENDIF + IF (KEEP(216).EQ.2) THEN + IF (FPERE.NE.KEEP(38)) THEN + CALL CMUMPS_627(A,LA,PTRAST(STEP(INODE)), + & IW( IOLDPS + 2 + KEEP(IXSZ) ), + & IW( IOLDPS + KEEP(IXSZ) ), + & IW( IOLDPS + 3 + KEEP(IXSZ) )+ + & IW( IOLDPS + KEEP(IXSZ) ), 0, + & IW( IOLDPS + XXS ), 0_8 ) + IW(IOLDPS+XXS)=S_NOLCBCONTIG + IW(IOLDPS+XXS)=S_NOLCBCONTIG + ENDIF + ENDIF + ENDIF + IF ( KEEP(38).EQ.FPERE) THEN + LCONT = IW(IOLDPS+KEEP(IXSZ)) + NROW = IW(IOLDPS+2+KEEP(IXSZ)) + NPIV = IW(IOLDPS+3+KEEP(IXSZ)) + NASS = IW(IOLDPS+4+KEEP(IXSZ)) + NELIM = NASS-NPIV + NCOL_TO_SEND = LCONT-NELIM + SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NASS + SHIFT_VAL_SON = int(NASS,8) + LDA = LCONT + NPIV + IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOTBAND_INIT) THEN + IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_REC_CONTSTATIC + ELSE + ENDIF + CALL CMUMPS_80( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTRIST, PTRAST, + & root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA, + & ROOT_CONT_STATIC, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG < 0 ) GOTO 600 + IF (NELIM.EQ.0) THEN + IF (KEEP(214).EQ.2) THEN + CALL CMUMPS_314( N, INODE, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE2 + & ) + ENDIF + CALL CMUMPS_626( N, INODE, PTRIST, PTRAST, IW, LIW, + & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP, + & MYID, KEEP + & ) + ELSE + IOLDPS = PTRIST(STEP(INODE)) + IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOT2SON_CALLED) THEN + CALL CMUMPS_626( N, INODE, PTRIST, PTRAST, IW, LIW, + & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP, + & MYID, KEEP + & ) + ELSE + IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_ROOTBAND_INIT + IF (KEEP(214).EQ.1.AND.KEEP(216).NE.3) THEN + IW(IOLDPS+XXS)=S_NOLCBNOCONTIG38 + CALL CMUMPS_628( IW(IOLDPS), + & LIW-IOLDPS+1, + & MEM_GAIN, KEEP(IXSZ) ) + LRLUS = LRLUS + MEM_GAIN + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLU) + IF (KEEP(216).EQ.2) THEN + CALL CMUMPS_627(A,LA,PTRAST(STEP(INODE)), + & IW( IOLDPS + 2 + KEEP(IXSZ) ), + & IW( IOLDPS + KEEP(IXSZ) ), + & IW( IOLDPS + 3 + KEEP(IXSZ) )+ + & IW( IOLDPS + KEEP(IXSZ) ), + & IW( IOLDPS + 4 + KEEP(IXSZ) ) - + & IW( IOLDPS + 3 + KEEP(IXSZ) ), + & IW( IOLDPS + XXS ),0_8) + IW(IOLDPS+XXS)=S_NOLCBCONTIG38 + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + 600 CONTINUE + RETURN + END SUBROUTINE CMUMPS_759 + SUBROUTINE CMUMPS_141( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP,PIVNUL_LIST,LPN_LIST ) + USE CMUMPS_OOC + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, INODE, FPERE, LIW, NOFFW, NPVW + INTEGER(8) :: LA + COMPLEX A( LA ) + REAL UU, SEUIL + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER COMM, MYID, LBUFR, LBUFR_BYTES + INTEGER LPTRAR, NELT + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS + INTEGER NBFIN, IFLAG, IERROR, LEAF, LPOOL, SLAVEF, + & IWPOS, IWPOSCB, COMP + INTEGER NB_BLOC_FAC + INTEGER ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER, TARGET :: IW( LIW ) + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER BUFR( LBUFR ), IPOOL(LPOOL), ITLOC(N+KEEP(253)) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW(LPTRAR), PTRAIW(LPTRAR), ND( KEEP(28) ) + INTEGER FRERE(KEEP(28)), FILS(N) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), + & PTLUST_S(KEEP(28)), + & + & PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), NBPROCFILS(KEEP(28)), + & PROCNODE_STEPS(KEEP(28)), STEP(N) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + COMPLEX DBLARR(max(1,KEEP(13))) + LOGICAL AVOID_DELAYED + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER(8) :: POSELT + INTEGER INOPV, IFINB, NFRONT, NPIV, IBEGKJI, NBOLKJ, NBTLKJ + INTEGER NASS, IEND, IOLDPS, LDAFS,allocok, IBEG_BLOCK + LOGICAL LASTBL + LOGICAL RESET_TO_ONE, TO_UPDATE + INTEGER K109_ON_ENTRY + INTEGER I,J,JJ,K,IDEB + REAL UUTEMP + INCLUDE 'mumps_headers.h' + INTEGER , ALLOCATABLE, DIMENSION ( : ) :: IPIV + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten, + & IDUMMY + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INTEGER PP_FIRST2SWAP_L, IFLAG_OOC + INTEGER PP_LastPIVRPTRFilled + EXTERNAL CMUMPS_223, CMUMPS_235, + & CMUMPS_227, CMUMPS_294, + & CMUMPS_44 + LOGICAL STATICMODE + REAL SEUIL_LOC + INTEGER PIVSIZ,IWPOSPIV + COMPLEX ONE + PARAMETER (ONE=(1.0E0,0.0E0)) + INOPV = 0 + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + SEUIL_LOC=SEUIL + UUTEMP=UU + ENDIF + RESET_TO_ONE = ((KEEP(110).GT.0).AND.(DKEEP(2).LE.0.0E0)) + IF (RESET_TO_ONE) THEN + K109_ON_ENTRY = KEEP(109) + ENDIF + IBEG_BLOCK=1 + NB_BLOC_FAC = 0 + IOLDPS = PTLUST_S(STEP( INODE )) + POSELT = PTRAST( STEP( INODE )) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + LDAFS = NASS + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5), NASS ) + ENDIF + NBTLKJ = NBOLKJ + IW(IOLDPS+3+KEEP(IXSZ)) = min0(NASS,NBTLKJ) + IF (KEEP(201).EQ.1) THEN + IDUMMY = -9876 + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_L + NextPiv2beWritten = 1 + PP_FIRST2SWAP_L = NextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 2 + MonBloc%NROW = NASS + MonBloc%NCOL = NASS + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -66666 + MonBloc%INDICES => + & IW(IOLDPS+6+NFRONT+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ)) + & :IOLDPS+5+2*NFRONT+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))) + ENDIF + ALLOCATE( IPIV( NASS ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) MYID,' : FACTO_NIV2 :failed to allocate ',NASS, + & ' integers' + IFLAG=-13 + IERROR=NASS + GO TO 490 + END IF + 50 CONTINUE + IBEGKJI = IBEG_BLOCK + CALL CMUMPS_223( + & NFRONT,NASS,IBEGKJI, NASS, IPIV, + & N,INODE,IW,LIW,A,LA,NOFFW,INOPV, + & IFLAG,IOLDPS,POSELT,UU, SEUIL_LOC, + & KEEP,KEEP8,PIVSIZ, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled) + IF (IFLAG.LT.0) GOTO 490 + IF(KEEP(109).GT. 0) THEN + IF(PIVNUL_LIST(KEEP(109)).EQ.-1) THEN + IWPOSPIV = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6 + & +IW(IOLDPS+5+KEEP(IXSZ)) + PIVNUL_LIST(KEEP(109)) = IW(IWPOSPIV+KEEP(IXSZ)) + ENDIF + ENDIF + IF(INOPV.EQ. 1 .AND. STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + IF (INOPV.GE.1) THEN + LASTBL = (INOPV.EQ.1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL CMUMPS_294( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, LDAFS, + & IBEGKJI, IEND, IPIV, NASS,LASTBL, NB_BLOC_FAC, + & + & COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (INOPV.EQ.1) GO TO 500 + IF (INOPV.EQ.2) THEN + CALL CMUMPS_235(IBEG_BLOCK, + & NASS,N,INODE,IW,LIW,A,LA, + & LDAFS, + & IOLDPS,POSELT,NBOLKJ, NBTLKJ,KEEP(4),KEEP,KEEP8) + GOTO 50 + ENDIF + NPVW = NPVW + PIVSIZ + IF (NASS.LE.1) THEN + IFINB = -1 + IF (NASS == 1) A(POSELT)=ONE/A(POSELT) + ELSE + CALL CMUMPS_227(IBEG_BLOCK, + & NASS, N,INODE,IW,LIW,A,LA, + & LDAFS, IOLDPS,POSELT,IFINB, + & NBTLKJ,KEEP(4),PIVSIZ,KEEP(IXSZ)) + IF(PIVSIZ .EQ. 2) THEN + IWPOSPIV = IOLDPS+KEEP(IXSZ)+IW(IOLDPS+1+KEEP(IXSZ))+6+ + & IW(IOLDPS+5+KEEP(IXSZ)) + IW(IWPOSPIV+NFRONT) = -IW(IWPOSPIV+NFRONT) + ENDIF + ENDIF + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + PIVSIZ + IF (IFINB.EQ.0) GOTO 50 + IF ((IFINB.EQ.1).OR.(IFINB.EQ.-1)) THEN + LASTBL = (IFINB.EQ.-1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL CMUMPS_294(COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, LDAFS, + & IBEGKJI, IEND, IPIV, NASS, LASTBL,NB_BLOC_FAC, + & + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (IFINB.EQ.(-1)) GOTO 500 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + IF (KEEP(201).EQ.1) THEN + IF (.NOT.RESET_TO_ONE.OR.K109_ON_ENTRY.EQ.KEEP(109)) THEN + MonBloc%Last = .FALSE. + MonBloc%LastPiv= NPIV + LAST_CALL=.FALSE. + CALL CMUMPS_688( + & STRAT_TRY_WRITE, + & TYPEFile, A(POSELT), + & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS), + & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC .LT. 0 ) IFLAG = IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + CALL CMUMPS_235(IBEG_BLOCK, + & NASS,N,INODE,IW,LIW,A,LA, + & LDAFS, + & IOLDPS,POSELT,NBOLKJ,NBTLKJ,KEEP(4),KEEP,KEEP8) + IF (KEEP(201).EQ.1) THEN + IF (RESET_TO_ONE.AND.K109_ON_ENTRY.LT.KEEP(109)) THEN + IDEB = IOLDPS+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))+6 + JJ= IDEB + TO_UPDATE=.FALSE. + DO K = K109_ON_ENTRY+1, KEEP(109) + I = PIVNUL_LIST(K) + DO J=JJ,JJ+NASS + IF (IW(J).EQ.I) THEN + TO_UPDATE=.TRUE. + EXIT + ENDIF + ENDDO + IF (TO_UPDATE) THEN + JJ= J + J = J-IDEB+1 + A(POSELT+int(J-1,8)+int(LDAFS,8)*int(J-1,8))= ONE + TO_UPDATE=.FALSE. + ELSE + IF (ICNTL(1).GT.0) THEN + write(ICNTL(1),*) ' Internal error related ', + & 'to null pivot row detection' + ENDIF + EXIT + ENDIF + ENDDO + ENDIF + K109_ON_ENTRY = KEEP(109) + MonBloc%Last = .FALSE. + MonBloc%LastPiv= NPIV + LAST_CALL=.FALSE. + CALL CMUMPS_688( + & STRAT_TRY_WRITE, + & TYPEFile, A(POSELT), + & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS), + & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC .LT. 0 ) IFLAG = IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + ENDIF + GO TO 50 + 490 CONTINUE + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + IF (RESET_TO_ONE.AND.K109_ON_ENTRY.LT.KEEP(109)) THEN + IDEB = IOLDPS+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))+6 + JJ= IDEB + TO_UPDATE=.FALSE. + DO K = K109_ON_ENTRY+1, KEEP(109) + I = PIVNUL_LIST(K) + DO J=JJ,JJ+NASS + IF (IW(J).EQ.I) THEN + TO_UPDATE=.TRUE. + EXIT + ENDIF + ENDDO + IF (TO_UPDATE) THEN + JJ= J + J = J-IDEB+1 + A(POSELT+int(J-1,8)+int(LDAFS,8)*int(J-1,8))= ONE + TO_UPDATE=.FALSE. + ELSE + IF (ICNTL(1).GT.0) THEN + write(ICNTL(1),*) ' Internal error related ', + & 'to null pivot row detection' + ENDIF + EXIT + ENDIF + ENDDO + ENDIF + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + LAST_CALL = .TRUE. + CALL CMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC, LAST_CALL ) + IF (IFLAG_OOC .LT. 0 ) IFLAG = IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + CALL CMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + DEALLOCATE( IPIV ) + RETURN + END SUBROUTINE CMUMPS_141 + SUBROUTINE CMUMPS_223( NFRONT, NASS, + & IBEGKJI, NASS2, TIPIV, + & N, INODE, IW, LIW, + & A, LA, NNEG, + & INOPV, IFLAG, + & IOLDPS, POSELT, UU, + & SEUIL,KEEP,KEEP8,PIVSIZ, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV + INTEGER NASS2, IBEGKJI, NNEG + INTEGER TIPIV( NASS2 ) + INTEGER PIVSIZ,LPIV + INTEGER(8) :: LA + COMPLEX A(LA) + REAL UU, UULOC, SEUIL + COMPLEX CSEUIL + INTEGER IW(LIW) + INTEGER IOLDPS + INTEGER(8) :: POSELT + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk + INTEGER PP_LastPIVRPTRIndexFilled + include 'mpif.h' + INTEGER(8) :: POSPV1,POSPV2,OFFDAG,APOSJ + INTEGER JMAX + REAL RMAX,AMAX,TMAX,TOL + REAL MAXPIV + COMPLEX PIVOT,DETPIV + PARAMETER(TOL = 1.0E-20) + INCLUDE 'mumps_headers.h' + INTEGER(8) :: APOSMAX + INTEGER(8) :: APOS + INTEGER(8) :: J1, J2, JJ, KK + INTEGER :: LDAFS + INTEGER(8) :: LDAFS8 + REAL, PARAMETER :: RZERO = 0.0E0 + REAL, PARAMETER :: RONE = 1.0E0 + COMPLEX ZERO, ONE + PARAMETER( ZERO = (0.0E0,0.0E0) ) + PARAMETER( ONE = (1.0E0,0.0E0) ) + REAL PIVNUL, VALTMP + COMPLEX FIXA + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,ILOC,K,J + INTRINSIC max + INTEGER I_PIVRPTR, I_PIVR, NBPANELS_L + PIVNUL = DKEEP(1) + FIXA = cmplx(DKEEP(2),kind=kind(FIXA)) + CSEUIL = cmplx(SEUIL,kind=kind(CSEUIL)) + LDAFS = NASS + LDAFS8 = int(LDAFS,8) + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL CMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR, I_PIVR, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+KEEP(IXSZ)) + & +KEEP(IXSZ), + & IW, LIW) + ENDIF + UULOC = UU + PIVSIZ = 1 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NPIVP1 = NPIV + 1 + ILOC = NPIVP1 - IBEGKJI + 1 + TIPIV( ILOC ) = ILOC + NASSW = iabs(IW(IOLDPS+3+KEEP(IXSZ))) + APOSMAX = POSELT+LDAFS8*LDAFS8-1_8 + IF(INOPV .EQ. -1) THEN + APOS = POSELT + LDAFS8*int(NPIVP1-1,8) + int(NPIV,8) + POSPV1 = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF(real(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + ELSE IF (KEEP(258) .NE.0 ) THEN + CALL CMUMPS_762( A(APOS), DKEEP(6), KEEP(259) ) + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL CMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + LDAFS8*int(IPIV-1,8) + int(NPIV,8) + POSPV1 = APOS + int(IPIV - NPIVP1,8) + PIVOT = A(POSPV1) + IF (UULOC.EQ.RZERO) THEN + IF (abs(A(APOS)).EQ.RZERO) GO TO 630 + IF (KEEP(258) .NE. 0) THEN + CALL CMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + GO TO 420 + ENDIF + AMAX = RZERO + JMAX = 0 + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(abs(A(JJ)) .GT. AMAX) THEN + AMAX = abs(A(JJ)) + JMAX = IPIV - int(POSPV1-JJ) + ENDIF + ENDDO + J1 = POSPV1 + LDAFS8 + DO J=1, NASSW - IPIV + IF(abs(A(J1)) .GT. AMAX) THEN + AMAX = max(abs(A(J1)),AMAX) + JMAX = IPIV + J + ENDIF + J1 = J1 + LDAFS8 + ENDDO + IF (KEEP(219).NE.0) THEN + RMAX = real(A(APOSMAX+int(IPIV,8))) + ELSE + RMAX = RZERO + ENDIF + DO J=1,NASS - NASSW + RMAX = max(abs(A(J1)),RMAX) + J1 = J1 + LDAFS8 + ENDDO + IF (max(AMAX,RMAX,abs(PIVOT)).LE.PIVNUL) THEN + KEEP(109) = KEEP(109)+1 + PIVNUL_LIST(KEEP(109)) = -1 + IF (real(FIXA).GT.RZERO) THEN + IF(real(PIVOT) .GE. RZERO) THEN + A(POSPV1) = FIXA + ELSE + A(POSPV1) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + A(JJ) = ZERO + ENDDO + J1 = POSPV1 + LDAFS8 + DO J=1, NASSW - IPIV + A(J1) = ZERO + J1 = J1 + LDAFS8 + ENDDO + DO J=1,NASS - NASSW + A(J1) = ZERO + J1 = J1 + LDAFS8 + ENDDO + VALTMP = max(1.0E10*RMAX, sqrt(huge(RMAX))/1.0E8) + A(POSPV1) = cmplx(VALTMP,kind=kind(A)) + ENDIF + PIVOT = A(POSPV1) + GO TO 415 + ENDIF + IF ((KEEP(19).EQ.0).AND.(KEEP(110).EQ.0)) THEN + IF (max(AMAX,RMAX,abs(PIVOT)).LE.TOL) THEN + IF(SEUIL .GT. epsilon(SEUIL)) THEN + IF(real(PIVOT) .GE. RZERO) THEN + A(POSPV1) = CSEUIL + ELSE + A(POSPV1) = -CSEUIL + ENDIF + PIVOT = A(POSPV1) + WRITE(*,*) 'WARNING matrix may be singular' + KEEP(98) = KEEP(98)+1 + GO TO 415 + ENDIF + ENDIF + ENDIF + IF (max(AMAX,abs(PIVOT)) .LE. TOL) GOTO 460 + IF (abs(PIVOT).GT.max(UULOC*max(RMAX,AMAX),SEUIL)) THEN + IF (KEEP(258) .NE.0 ) THEN + CALL CMUMPS_762(PIVOT, DKEEP(6), KEEP(259)) + ENDIF + GO TO 415 + END IF + IF (AMAX.LE.TOL) GO TO 460 + IF (RMAX.LT.AMAX) THEN + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(int(POSPV1-JJ) .NE. IPIV-JMAX) THEN + RMAX = max(RMAX,abs(A(JJ))) + ENDIF + ENDDO + J1 = POSPV1 + LDAFS8 + DO J=1,NASS-IPIV + IF(IPIV+J .NE. JMAX) THEN + RMAX = max(abs(A(J1)),RMAX) + ENDIF + J1 = J1 + LDAFS8 + ENDDO + ENDIF + APOSJ = POSELT + int(JMAX-1,8)*LDAFS8 + int(NPIV,8) + POSPV2 = APOSJ + int(JMAX - NPIVP1,8) + IF (IPIV.LT.JMAX) THEN + OFFDAG = APOSJ + int(IPIV - NPIVP1,8) + ELSE + OFFDAG = APOS + int(JMAX - NPIVP1,8) + END IF + IF (KEEP(219).NE.0) THEN + TMAX = max(SEUIL/UULOC,real(A(APOSMAX+int(JMAX,8)))) + ELSE + TMAX = SEUIL/UULOC + ENDIF + IF(JMAX .LT. IPIV) THEN + JJ = POSPV2 + DO K = 1, NASS-JMAX + JJ = JJ+int(NASS,8) + IF (JMAX+K.NE.IPIV) THEN + TMAX=max(TMAX,abs(A(JJ))) + ENDIF + ENDDO + DO KK = APOSJ, POSPV2-1_8 + TMAX = max(TMAX,abs(A(KK))) + ENDDO + ELSE + JJ = POSPV2 + DO K = 1, NASS-JMAX + JJ = JJ+int(NASS,8) + TMAX=max(TMAX,abs(A(JJ))) + ENDDO + DO KK = APOSJ, POSPV2 - 1_8 + IF (KK.NE.OFFDAG) THEN + TMAX = max(TMAX,abs(A(KK))) + ENDIF + ENDDO + ENDIF + DETPIV = A(POSPV1)*A(POSPV2) - A(OFFDAG)**2 + IF (SEUIL.GT.RZERO) THEN + IF (sqrt(abs(DETPIV)) .LE. SEUIL ) GOTO 460 + ENDIF + MAXPIV = max(abs(A(POSPV1)),abs(A(POSPV2))) + IF (MAXPIV.EQ.RZERO) MAXPIV = RONE + IF (abs(DETPIV)/MAXPIV.LE.TOL) GO TO 460 + IF ((abs(A(POSPV2))*RMAX+AMAX*TMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF ((abs(A(POSPV1))*TMAX+AMAX*RMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF (KEEP(258).NE.0) THEN + CALL CMUMPS_762(DETPIV, DKEEP(6), KEEP(259)) + ENDIF + PIVSIZ = 2 + KEEP(105) = KEEP(105)+1 + 415 CONTINUE + DO K=1,PIVSIZ + IF (PIVSIZ .EQ. 2 ) THEN + IF (K==1) THEN + LPIV = min(IPIV, JMAX) + TIPIV(ILOC) = -(LPIV - IBEGKJI + 1) + ELSE + LPIV = max(IPIV, JMAX) + TIPIV(ILOC+1) = -(LPIV - IBEGKJI + 1) + ENDIF + ELSE + LPIV = IPIV + TIPIV(ILOC) = IPIV - IBEGKJI + 1 + ENDIF + IF (LPIV.EQ.NPIVP1) THEN + GOTO 416 + ENDIF + CALL CMUMPS_319( A, LA, IW, LIW, + & IOLDPS, NPIVP1, LPIV, POSELT, NASS, + & LDAFS, NFRONT, 2, KEEP(219), KEEP(50), + & KEEP(IXSZ)) + 416 CONTINUE + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL CMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, LPIV, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + NPIVP1 = NPIVP1+1 + ENDDO + IF(PIVSIZ .EQ. 2) THEN + A(POSELT+LDAFS8*int(NPIV,8)+int(NPIV+1,8)) = DETPIV + ENDIF + GOTO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 420 + 630 CONTINUE + IFLAG = -10 + 420 CONTINUE + RETURN + END SUBROUTINE CMUMPS_223 + SUBROUTINE CMUMPS_235( + & IBEG_BLOCK, + & NASS, N, INODE, + & IW, LIW, A, LA, + & LDAFS, + & IOLDPS, POSELT, + & LKJIB_ORIG, LKJIB, LKJIT, KEEP,KEEP8 ) + IMPLICIT NONE + INTEGER NASS,N,LIW + INTEGER(8) :: LA + COMPLEX A(LA) + INTEGER IW(LIW) + INTEGER LKJIB_ORIG, LKJIB, INODE, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER (8) :: POSELT + INTEGER (8) :: LDAFS8 + INTEGER LDAFS, IBEG_BLOCK + INTEGER IOLDPS, NPIV, JROW2, NPBEG + INTEGER NONEL, LKJIW, NEL1 + INTEGER HF + INTEGER(8) :: LPOS,UPOS,APOS + INTEGER LKJIT + INTEGER LKJIBOLD, IROW + INTEGER J, Block + INTEGER BLSIZE + COMPLEX ONE, ALPHA + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + INCLUDE 'mumps_headers.h' + LDAFS8 = int(LDAFS,8) + LKJIBOLD = LKJIB + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + JROW2 = iabs(IW(IOLDPS+3+KEEP(IXSZ))) + NPBEG = IBEG_BLOCK + HF = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + NEL1 = NASS - JROW2 + LKJIW = NPIV - NPBEG + 1 + IF ( LKJIW .NE. LKJIB ) THEN + NONEL = JROW2 - NPIV + 1 + IF ((NASS-NPIV).GE.LKJIT) THEN + LKJIB = LKJIB_ORIG + NONEL + IW(IOLDPS+3+KEEP(IXSZ))= min0(NPIV+LKJIB,NASS) + LKJIB = min0(LKJIB, NASS - NPIV) + ELSE + LKJIB = NASS - NPIV + IW(IOLDPS+3+KEEP(IXSZ)) = NASS + ENDIF + ELSEIF (JROW2.LT.NASS) THEN + IW(IOLDPS+3+KEEP(IXSZ)) = min0(JROW2+LKJIB,NASS) + ENDIF + IBEG_BLOCK = NPIV + 1 + IF (LKJIW.EQ.0) GO TO 500 + IF (NEL1.NE.0) THEN + IF ( NASS - JROW2 > KEEP(7) ) THEN + BLSIZE = KEEP(8) + ELSE + BLSIZE = NASS - JROW2 + END IF + IF ( NASS - JROW2 .GT. 0 ) THEN + DO IROW = JROW2+1, NASS, BLSIZE + Block = min( BLSIZE, NASS - IROW + 1 ) + LPOS = POSELT + int(IROW - 1,8) * LDAFS8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG - 1,8) * LDAFS8 + int(IROW - 1,8) + APOS = POSELT + int(IROW-1,8) * LDAFS8 + int(IROW - 1,8) + DO J=1, Block + CALL cgemv( 'T', LKJIW, Block - J + 1, ALPHA, + & A( LPOS ), LDAFS, A( UPOS ), LDAFS, + & ONE, A( APOS ), LDAFS ) + LPOS = LPOS + LDAFS8 + APOS = APOS + LDAFS8 + 1_8 + UPOS = UPOS + 1_8 + END DO + LPOS = POSELT + int(IROW-1+Block,8) * LDAFS8 + & + int(NPBEG-1,8) + UPOS = POSELT + int(NPBEG-1,8) * LDAFS8 + int(IROW-1,8) + APOS = POSELT + int( IROW - 1 + Block,8 ) * LDAFS8 + & + int(IROW - 1,8) + CALL cgemm( 'N','N', Block, NASS - IROW + 1 - Block, LKJIW, + & ALPHA, A( UPOS ), LDAFS, + & A( LPOS ), LDAFS, ONE, A( APOS ), LDAFS ) + END DO + END IF + END IF + 500 CONTINUE + RETURN + END SUBROUTINE CMUMPS_235 + SUBROUTINE CMUMPS_227 + & ( IBEG_BLOCK, NASS, N, INODE, IW, LIW, + & A, LA, LDAFS, + & IOLDPS,POSELT,IFINB,LKJIB,LKJIT,PIVSIZ, + & XSIZE) + IMPLICIT NONE + INTEGER(8) :: LA, POSELT + INTEGER :: LIW + COMPLEX A(LA) + INTEGER IW(LIW) + COMPLEX VALPIV + INTEGER IOLDPS, NCB1 + INTEGER LKJIT, IBEG_BLOCK + INTEGER NPIV,JROW2 + INTEGER(8) :: APOS + INTEGER(8) :: LPOS, LPOS1, LPOS2, K1POS + INTEGER(8) :: JJ, K1, K2 + INTEGER(8) :: POSPV1, POSPV2, OFFDAG, OFFDAG_OLD + INTEGER(8) :: LDAFS8 + INTEGER NASS,N,INODE,IFINB,LKJIB,LDAFS, + & NPBEG + INTEGER NEL2 + INTEGER XSIZE + COMPLEX ONE, ALPHA + COMPLEX ZERO + INTEGER PIVSIZ,NPIV_NEW + INTEGER(8) :: IBEG, IEND, IROW + INTEGER :: J2 + COMPLEX SWOP,DETPIV,MULT1,MULT2 + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + PARAMETER (ZERO=(0.0E0,0.0E0)) + INCLUDE 'mumps_headers.h' + LDAFS8 = int(LDAFS,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIV_NEW = NPIV + PIVSIZ + IFINB = 0 + IF (IW(IOLDPS+3+XSIZE).LE.0) THEN + IW(IOLDPS+3+XSIZE) = min0(NASS,LKJIB) + ENDIF + JROW2 = IW(IOLDPS+3+XSIZE) + NPBEG = IBEG_BLOCK + NEL2 = JROW2 - NPIV_NEW + IF (NEL2.EQ.0) THEN + IF (JROW2.EQ.NASS) THEN + IFINB = -1 + ELSE + IFINB = 1 + ENDIF + ENDIF + IF(PIVSIZ .EQ. 1) THEN + APOS = POSELT + int(NPIV,8)*(LDAFS8 + 1_8) + VALPIV = ONE/A(APOS) + A(APOS) = VALPIV + LPOS = APOS + LDAFS8 + CALL ccopy(NASS-NPIV_NEW, A(LPOS), LDAFS, A(APOS+1_8), 1) + CALL CMUMPS_XSYR('U', NEL2, -VALPIV, A(LPOS), LDAFS, + & A(LPOS+1_8), LDAFS) + CALL cscal(NASS-NPIV_NEW, VALPIV, A(LPOS), LDAFS) + IF (NEL2.GT.0) THEN + K1POS = LPOS + int(NEL2,8)*LDAFS8 + NCB1 = NASS - JROW2 + CALL cgeru(NEL2, NCB1 , ALPHA, A(APOS+1_8), 1, + & A(K1POS), LDAFS, A(K1POS+1_8), LDAFS) + ENDIF + ELSE + POSPV1 = POSELT + int(NPIV,8)*(LDAFS8 + 1_8) + POSPV2 = POSPV1+LDAFS8+1_8 + OFFDAG_OLD = POSPV2 - 1_8 + OFFDAG = POSPV1+1_8 + SWOP = A(POSPV2) + DETPIV = A(OFFDAG) + A(POSPV2) = A(POSPV1)/DETPIV + A(POSPV1) = SWOP/DETPIV + A(OFFDAG) = -A(OFFDAG_OLD)/DETPIV + A(OFFDAG_OLD) = ZERO + LPOS1 = POSPV2 + LDAFS8 - 1_8 + LPOS2 = LPOS1 + 1_8 + CALL ccopy(NASS-NPIV_NEW, A(LPOS1), LDAFS, A(POSPV1+2_8), 1) + CALL ccopy(NASS-NPIV_NEW, A(LPOS2), LDAFS, A(POSPV2+1_8), 1) + JJ = POSPV2 + int(NASS-1,8) + IBEG = JJ + 2_8 + IEND = IBEG + DO J2 = 1,NEL2 + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(OFFDAG)*A(K2)) + MULT2 = - (A(OFFDAG)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1+2_8 + K2 = POSPV2+1_8 + DO IROW = IBEG,IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A(JJ) = -MULT1 + A(JJ+1_8) = -MULT2 + IBEG = IBEG + int(NASS,8) + IEND = IEND + int(NASS + 1,8) + JJ = JJ+int(NASS,8) + ENDDO + IEND = IEND-1_8 + DO J2 = JROW2+1,NASS + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(POSPV1+1_8)*A(K2)) + MULT2 = - (A(POSPV1+1_8)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1+2_8 + K2 = POSPV2+1_8 + DO IROW = IBEG,IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A(JJ) = -MULT1 + A(JJ+1_8) = -MULT2 + IBEG = IBEG + int(NASS,8) + IEND = IEND + int(NASS,8) + JJ = JJ+int(NASS,8) + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_227 + RECURSIVE SUBROUTINE CMUMPS_263( + & COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE CMUMPS_COMM_BUFFER + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER COMP + INTEGER IFLAG, IERROR, NBFIN, MSGSOU + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)) + INTEGER NBPROCFILS(KEEP(28)), STEP(N), PIMASTER(KEEP(28)) + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N + 1 ), FRTELT( NELT ) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER COMM, MYID + INTEGER PTLUST_S(KEEP(28)) + INTEGER ITLOC( N + KEEP(253)), FILS( N ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER ND( KEEP(28) ), FRERE_STEPS( KEEP(28) ) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION FLOP1 + COMPLEX DBLARR( max(1,KEEP(13)) ) + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INCLUDE 'mumps_headers.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER INODE, IPOSK, JPOSK, NCOLU, NPIV, POSITION, IERR + INTEGER(8) POSELT, POSBLOCFACTO + INTEGER(8) LAELL + INTEGER IOLDPS, LCONT1, NROW1, NCOL1, NPIV1 + INTEGER NSLAVES_TOT, HS, DEST, NSLAVES_FOLLOW + INTEGER FPERE + INTEGER(8) CPOS, LPOS + LOGICAL DYNAMIC + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER allocok + COMPLEX, ALLOCATABLE, DIMENSION(:) :: UDYNAMIC + COMPLEX ONE,ALPHA + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + DYNAMIC = .FALSE. + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, IPOSK, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, JPOSK, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, + & MPI_INTEGER, COMM, IERR ) + IF ( NPIV .LE. 0 ) THEN + NPIV = - NPIV + WRITE(*,*) MYID,':error, received negative NPIV in BLFAC' + CALL MUMPS_ABORT() + END IF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOLU, 1, + & MPI_INTEGER, COMM, IERR ) + LAELL = int(NPIV,8) * int(NCOLU,8) + IF ( LRLU .LT. LAELL ) THEN + IF ( LRLUS .LT. LAELL ) THEN + IFLAG = -9 + CALL MUMPS_731(LAELL - LRLUS, IERROR) + GOTO 700 + END IF + CALL CMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS=' + & ,LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731(LAELL - LRLU, IERROR) + GOTO 700 + END IF + END IF + LRLU = LRLU - LAELL + LRLUS = LRLUS - LAELL + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSBLOCFACTO = POSFAC + POSFAC = POSFAC + LAELL + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8, LAELL,KEEP,KEEP8,LRLU) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSBLOCFACTO), NPIV*NCOLU, + & MPI_COMPLEX, + & COMM, IERR ) + IF (PTRIST(STEP( INODE )) .EQ. 0) DYNAMIC = .TRUE. + IF ( (PTRIST(STEP( INODE )).NE.0) .AND. + & (IPOSK + NPIV -1 .GT. + & IW(PTRIST(STEP(INODE))+3+KEEP(IXSZ))) )THEN + DYNAMIC = .TRUE. + ENDIF + IF (DYNAMIC) THEN + ALLOCATE(UDYNAMIC(LAELL), stat=allocok) + if (allocok .GT. 0) THEN + write(*,*) MYID, ' : PB allocation U in blfac_slave ' + & , LAELL + IFLAG = -13 + CALL MUMPS_731(LAELL,IERROR) + GOTO 700 + endif + UDYNAMIC(1_8:LAELL) = A(POSBLOCFACTO:POSBLOCFACTO+LAELL-1_8) + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + ENDIF + DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 ) + MSGSOU = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), + & SLAVEF ) + SET_IRECV = .FALSE. + BLOCKING = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + ENDDO + DO WHILE ( IPOSK + NPIV -1 .GT. + & IW( PTRIST(STEP( INODE )) + 3 +KEEP(IXSZ)) ) + MSGSOU = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + SET_IRECV = .FALSE. + BLOCKING = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, BLOC_FACTO_SYM, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .TRUE. + CALL CMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IOLDPS = PTRIST(STEP( INODE )) + POSELT = PTRAST(STEP( INODE )) + LCONT1 = IW( IOLDPS + KEEP(IXSZ) ) + NROW1 = IW( IOLDPS + 2 + KEEP(IXSZ)) + NPIV1 = IW( IOLDPS + 3 + KEEP(IXSZ)) + NSLAVES_TOT = IW( IOLDPS + 5 + KEEP(IXSZ)) + HS = 6 + NSLAVES_TOT + KEEP(IXSZ) + NCOL1 = LCONT1 + NPIV1 + CPOS = POSELT + int(JPOSK - 1,8) + LPOS = POSELT + int(IPOSK - 1,8) + IF ( NPIV .GT. 0 ) THEN + IF (DYNAMIC) THEN + CALL cgemm( 'T', 'N', NCOLU, NROW1, NPIV, ALPHA, + & UDYNAMIC(1), NPIV, + & A( LPOS ), NCOL1, ONE, + & A( CPOS ), NCOL1 ) + ELSE + CALL cgemm( 'T', 'N', NCOLU, NROW1, NPIV, ALPHA, + & A( POSBLOCFACTO ), NPIV, + & A( LPOS ), NCOL1, ONE, + & A( CPOS ), NCOL1 ) + ENDIF + FLOP1 = dble(NCOLU*NPIV)*dble(2*NROW1) + FLOP1 = -FLOP1 + CALL CMUMPS_190(1, .FALSE., FLOP1, KEEP,KEEP8 ) + ENDIF + IW( IOLDPS + 6 + KEEP(IXSZ) ) = IW( IOLDPS + 6+ KEEP(IXSZ) ) + 1 + IF (DYNAMIC) THEN + DEALLOCATE(UDYNAMIC) + ELSE + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + CALL CMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + ENDIF + NSLAVES_FOLLOW = IW( IOLDPS + 5 +KEEP(IXSZ) ) - XTRA_SLAVES_SYM + IF ( IW( IOLDPS + 6 +KEEP(IXSZ)) .eq. 0 .and. + & KEEP(50) .ne. 0 .and. NSLAVES_FOLLOW .eq. 0 ) + & THEN + DEST = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + CALL CMUMPS_62( INODE, DEST, END_NIV2_LDLT, + & COMM, IERR ) + IF ( IERR .LT. 0 ) THEN + write(*,*) ' Internal error in PROCESS_BLFAC_SLAVE.' + IFLAG = -99 + GOTO 700 + END IF + END IF + IF (IW(PTRIST(STEP(INODE)) + 6+KEEP(IXSZ) ) .eq. 0) THEN + CALL CMUMPS_759( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ENDIF + 600 CONTINUE + RETURN + 700 CONTINUE + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE CMUMPS_263 + SUBROUTINE CMUMPS_38( NROW_SON, NCOL_SON, INDROW_SON, + & INDCOL_SON, NSUPCOL, VAL_SON, VAL_ROOT, + & LOCAL_M, LOCAL_N, + & RHS_ROOT, NLOC_ROOT, CBP ) + IMPLICIT NONE + INTEGER NCOL_SON, NROW_SON, NSUPCOL + INTEGER, intent(in) :: CBP + INTEGER INDROW_SON( NROW_SON ), INDCOL_SON( NCOL_SON ) + INTEGER LOCAL_M, LOCAL_N + COMPLEX VAL_SON( NCOL_SON, NROW_SON ) + COMPLEX VAL_ROOT( LOCAL_M, LOCAL_N ) + INTEGER NLOC_ROOT + COMPLEX RHS_ROOT( LOCAL_M, NLOC_ROOT ) + INTEGER I, J + IF (CBP .EQ. 0) THEN + DO I = 1, NROW_SON + DO J = 1, NCOL_SON-NSUPCOL + VAL_ROOT( INDROW_SON( I ), INDCOL_SON( J ) ) = + & VAL_ROOT( INDROW_SON( I ), INDCOL_SON( J ) ) + VAL_SON(J,I) + END DO + DO J = NCOL_SON-NSUPCOL+1, NCOL_SON + RHS_ROOT( INDROW_SON( I ), INDCOL_SON(J)) = + & RHS_ROOT(INDROW_SON(I),INDCOL_SON(J)) + VAL_SON(J,I) + ENDDO + END DO + ELSE + DO I=1, NROW_SON + DO J = 1, NCOL_SON + RHS_ROOT( INDROW_SON( I ), INDCOL_SON(J)) = + & RHS_ROOT(INDROW_SON(I),INDCOL_SON(J)) + VAL_SON(J,I) + ENDDO + ENDDO + ENDIF + RETURN + END SUBROUTINE CMUMPS_38 + RECURSIVE SUBROUTINE CMUMPS_80 + & ( COMM_LOAD, ASS_IRECV, N, ISON, IROOT, + & PTRI, PTRR, + & root, + & NBROW, NBCOL, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON, + & SHIFT_VAL_SON, LDA, TAG, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE CMUMPS_OOC + USE CMUMPS_COMM_BUFFER + USE CMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + TYPE (CMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, ISON, IROOT, TAG + INTEGER PTRI( KEEP(28) ) + INTEGER(8) :: PTRR( KEEP(28) ) + INTEGER NBROW, NBCOL, LDA + INTEGER(8) :: SHIFT_VAL_SON + INTEGER SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON + INTEGER MYID, COMM + LOGICAL INVERT + INCLUDE 'mpif.h' + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER LIW + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)), NSTK( N ) + INTEGER COMP, IFLAG, IERROR + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER NBFIN, SLAVEF + DOUBLE PRECISION OPASSW, OPELIW + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX DBLARR( max(1,KEEP(13)) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: PTRROW, PTRCOL + INTEGER, ALLOCATABLE, DIMENSION(:) :: NSUPROW, NSUPCOL + INTEGER, ALLOCATABLE, DIMENSION(:) :: ROW_INDEX_LIST + INTEGER, ALLOCATABLE, DIMENSION(:) :: COL_INDEX_LIST + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER I, POS_IN_ROOT, IROW, JCOL, IGLOB, JGLOB + INTEGER PDEST, IERR + INTEGER LOCAL_M, LOCAL_N + INTEGER(8) :: POSROOT + INTEGER NSUBSET_ROW, NSUBSET_COL + INTEGER NRLOCAL, NCLOCAL + LOGICAL SET_IRECV, BLOCKING, MESSAGE_RECEIVED + INTEGER NBROWS_ALREADY_SENT + INTEGER SIZE_MSG + INTEGER LP + INCLUDE 'mumps_headers.h' + LOGICAL SKIPLAST_RHS_ROWS, BCP_SYM_NONEMPTY + INTEGER BBPCBP + BBPCBP = 0 + LP = ICNTL(1) + IF ( ICNTL(4) .LE. 0 ) LP = -1 + ALLOCATE(PTRROW(root%NPROW + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPROW + 1 + endif + ALLOCATE(PTRCOL(root%NPCOL + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPCOL + 1 + endif + ALLOCATE(NSUPROW(root%NPROW + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPROW + 1 + endif + ALLOCATE(NSUPCOL(root%NPCOL + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPCOL + 1 + endif + IF (IFLAG.LT.0) THEN + IF (LP > 0) write(6,*) MYID, ' : MEMORY ALLOCATION ', + & 'FAILURE in CMUMPS_80' + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + SKIPLAST_RHS_ROWS = ((KEEP(253).GT.0).AND.(KEEP(50).EQ.0)) + BCP_SYM_NONEMPTY = .FALSE. + PTRROW = 0 + PTRCOL = 0 + NSUPROW = 0 + NSUPCOL = 0 + DO I = 1, NBROW + IGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_ROW_SON + I - 1 ) + IF (SKIPLAST_RHS_ROWS.AND.(IGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF (IGLOB.GT.N) THEN + BCP_SYM_NONEMPTY = .TRUE. + POS_IN_ROOT = IGLOB - N + JCOL = mod((POS_IN_ROOT-1)/root%NBLOCK,root%NPCOL) + NSUPCOL(JCOL+1) = NSUPCOL(JCOL+1) + 1 + PTRCOL( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + ELSE + POS_IN_ROOT = root%RG2L_ROW( IGLOB ) + IROW = mod((POS_IN_ROOT-1)/root%MBLOCK,root%NPROW) + PTRROW ( IROW + 2 ) = PTRROW( IROW + 2 ) + 1 + ENDIF + ELSE + IF (IGLOB .GT. N) THEN + POS_IN_ROOT = IGLOB - N + ELSE + POS_IN_ROOT = root%RG2L_COL( IGLOB ) + ENDIF + JCOL = mod( ( POS_IN_ROOT - 1 ) / root%NBLOCK, root%NPCOL ) + IF (IGLOB.GT.N) + & NSUPCOL(JCOL+1) = NSUPCOL(JCOL+1) + 1 + PTRCOL( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + END IF + END DO + IF ((KEEP(50).NE.0).AND.(.NOT.INVERT).AND.BCP_SYM_NONEMPTY) + & BBPCBP = 1 + DO I = 1, NBCOL + JGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_COL_SON + I - 1 ) + IF ((KEEP(50).GT.0) .AND. (JGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF (KEEP(50).EQ.0) THEN + IF (JGLOB.LE.N) THEN + POS_IN_ROOT = root%RG2L_COL(JGLOB) + ELSE + POS_IN_ROOT = JGLOB-N + ENDIF + JCOL = mod((POS_IN_ROOT-1) / root%NBLOCK, root%NPCOL ) + IF (JGLOB.GT.N) THEN + NSUPCOL(JCOL+1) = NSUPCOL(JCOL+1) + 1 + ENDIF + PTRCOL ( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + ELSE + POS_IN_ROOT = root%RG2L_COL(JGLOB) + JCOL = mod((POS_IN_ROOT-1) / root%NBLOCK, root%NPCOL ) + PTRCOL ( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + IF (BCP_SYM_NONEMPTY) THEN + POS_IN_ROOT = root%RG2L_ROW(JGLOB) + IROW = mod((POS_IN_ROOT-1)/root%MBLOCK,root%NPROW) + NSUPROW(IROW+1) = NSUPROW(IROW+1)+1 + PTRROW( IROW + 2 ) = PTRROW( IROW + 2 ) + 1 + ENDIF + ENDIF + ELSE + IF (JGLOB.LE.N) THEN + POS_IN_ROOT = root%RG2L_ROW( JGLOB ) + ELSE + POS_IN_ROOT = JGLOB-N + ENDIF + IROW = mod( ( POS_IN_ROOT - 1 ) / + & root%MBLOCK, root%NPROW ) + PTRROW ( IROW + 2 ) = PTRROW( IROW + 2 ) + 1 + END IF + END DO + PTRROW( 1 ) = 1 + DO IROW = 2, root%NPROW + 1 + PTRROW( IROW ) = PTRROW( IROW ) + PTRROW( IROW - 1 ) + END DO + PTRCOL( 1 ) = 1 + DO JCOL = 2, root%NPCOL + 1 + PTRCOL( JCOL ) = PTRCOL( JCOL ) + PTRCOL( JCOL - 1 ) + END DO + ALLOCATE(ROW_INDEX_LIST(PTRROW(root%NPROW+1)-1+1), + & stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = PTRROW(root%NPROW+1)-1+1 + endif + ALLOCATE(COL_INDEX_LIST(PTRCOL(root%NPCOL+1)-1+1), + & stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = PTRCOL(root%NPCOL+1)-1+1 + endif + DO I = 1, NBROW + IGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_ROW_SON + I - 1 ) + IF (SKIPLAST_RHS_ROWS.AND.(IGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF (IGLOB.GT.N) CYCLE + POS_IN_ROOT = root%RG2L_ROW( IGLOB ) + IROW = mod( ( POS_IN_ROOT - 1 ) / root%MBLOCK, + & root%NPROW ) + ROW_INDEX_LIST( PTRROW( IROW + 1 ) ) = I + PTRROW ( IROW + 1 ) = PTRROW( IROW + 1 ) + 1 + ELSE + IF (IGLOB.LE.N) THEN + POS_IN_ROOT = root%RG2L_COL( IGLOB ) + ELSE + POS_IN_ROOT = IGLOB - N + ENDIF + JCOL = mod( ( POS_IN_ROOT - 1 ) / root%NBLOCK, + & root%NPCOL ) + COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ) = I + PTRCOL ( JCOL + 1 ) = PTRCOL( JCOL + 1 ) + 1 + END IF + END DO + DO I = 1, NBCOL + JGLOB = IW( PTRI(STEP(ISON))+SHIFT_LIST_COL_SON+I - 1 ) + IF ((KEEP(50).GT.0) .AND. (JGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF ( JGLOB.LE.N ) THEN + POS_IN_ROOT = root%RG2L_COL( JGLOB ) + ELSE + POS_IN_ROOT = JGLOB - N + ENDIF + JCOL = mod( ( POS_IN_ROOT - 1 ) / + & root%NBLOCK, root%NPCOL ) + COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ) = I + PTRCOL ( JCOL + 1 ) = PTRCOL( JCOL + 1 ) + 1 + ELSE + IF ( JGLOB.LE.N ) THEN + POS_IN_ROOT = root%RG2L_ROW( JGLOB ) + ELSE + POS_IN_ROOT = JGLOB - N + ENDIF + IROW = mod( ( POS_IN_ROOT - 1 ) / + & root%MBLOCK, root%NPROW ) + ROW_INDEX_LIST( PTRROW( IROW + 1 ) ) = I + PTRROW( IROW + 1 ) = PTRROW( IROW + 1 ) + 1 + END IF + END DO + IF (BCP_SYM_NONEMPTY) THEN + DO I = 1, NBROW + IGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_ROW_SON + I - 1 ) + IF (IGLOB.LE.N) CYCLE + POS_IN_ROOT = IGLOB - N + JCOL = mod((POS_IN_ROOT-1)/root%NBLOCK,root%NPCOL) + COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ) = I + PTRCOL ( JCOL + 1 ) = PTRCOL( JCOL + 1 ) + 1 + ENDDO + DO I=1, NBCOL + JGLOB = IW( PTRI(STEP(ISON))+SHIFT_LIST_COL_SON+I - 1 ) + IF (JGLOB.GT.N) THEN + EXIT + ELSE + POS_IN_ROOT = root%RG2L_ROW(JGLOB) + ENDIF + IROW = mod((POS_IN_ROOT-1)/root%MBLOCK,root%NPROW) + ROW_INDEX_LIST( PTRROW( IROW + 1 ) ) = I + PTRROW( IROW + 1 ) = PTRROW( IROW + 1 ) + 1 + ENDDO + ENDIF + DO IROW = root%NPROW, 2, -1 + PTRROW( IROW ) = PTRROW( IROW - 1 ) + END DO + PTRROW( 1 ) = 1 + DO JCOL = root%NPCOL, 2, -1 + PTRCOL( JCOL ) = PTRCOL( JCOL - 1 ) + END DO + PTRCOL( 1 ) = 1 + JCOL = root%MYCOL + IROW = root%MYROW + IF ( root%yes ) THEN + if (IROW .ne. root%MYROW .or. JCOL.ne.root%MYCOL) then + write(*,*) ' error in grid position buildandsendcbroot' + CALL MUMPS_ABORT() + end if + IF ( PTRIST(STEP(IROOT)).EQ.0.AND. + & PTLUST_S(STEP(IROOT)).EQ.0) THEN + NBPROCFILS( STEP(IROOT) ) = -1 + CALL CMUMPS_284(root, IROOT, N, IW, LIW, + & A, LA, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + IF (IFLAG.LT.0) THEN + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + ELSE + NBPROCFILS(STEP(IROOT)) = NBPROCFILS(STEP(IROOT)) - 1 + IF ( NBPROCFILS( STEP(IROOT) ) .eq. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + CALL CMUMPS_681(IERR) + ELSE IF (KEEP(201).EQ.2) THEN + CALL CMUMPS_580(IERR) + ENDIF + CALL CMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IROOT+N ) + IF (KEEP(47) .GE. 3) THEN + CALL CMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + END IF + IF (KEEP(60) .NE. 0 ) THEN + LOCAL_M = root%SCHUR_LLD + LOCAL_N = root%SCHUR_NLOC + NRLOCAL = PTRROW( IROW + 2 ) - PTRROW( IROW + 1 ) + NCLOCAL = PTRCOL( JCOL + 2 ) - PTRCOL( JCOL + 1 ) + CALL CMUMPS_285( N, + & root%SCHUR_POINTER(1), + & LOCAL_M, LOCAL_N, + & root%NPCOL, root%NPROW, root%MBLOCK, root%NBLOCK, + & NBCOL, NBROW, + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_COL_SON ), + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_ROW_SON ), + & LDA, A( PTRR( STEP(ISON)) + SHIFT_VAL_SON ), + & ROW_INDEX_LIST( PTRROW( IROW + 1 ) ), + & COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ), + & NRLOCAL, + & NCLOCAL, + & NSUPROW(IROW+1), NSUPCOL(JCOL+1), + & root%RG2L_ROW(1), root%RG2L_COL(1), INVERT, + & KEEP, + & root%RHS_ROOT(1,1), root%RHS_NLOC ) + ELSE + IF ( PTRIST(STEP( IROOT )) .GE. 0 ) THEN + IF ( PTRIST(STEP( IROOT )) .EQ. 0 ) THEN + LOCAL_N = IW( PTLUST_S(STEP(IROOT)) + 1 + KEEP(IXSZ)) + LOCAL_M = IW( PTLUST_S(STEP(IROOT)) + 2 + KEEP(IXSZ)) + POSROOT = PTRFAC(IW( PTLUST_S(STEP(IROOT)) +4+KEEP(IXSZ) )) + ELSE + LOCAL_N = - IW( PTRIST(STEP(IROOT)) +KEEP(IXSZ)) + LOCAL_M = IW( PTRIST(STEP(IROOT)) + 1 +KEEP(IXSZ)) + POSROOT = PAMASTER(STEP( IROOT )) + ENDIF + NCLOCAL = PTRCOL( JCOL + 2 ) - PTRCOL( JCOL + 1 ) + NRLOCAL = PTRROW( IROW + 2 ) - PTRROW( IROW + 1 ) + CALL CMUMPS_285( N, A( POSROOT ), + & LOCAL_M, LOCAL_N, + & root%NPCOL, root%NPROW, root%MBLOCK, root%NBLOCK, + & NBCOL, NBROW, + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_COL_SON ), + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_ROW_SON ), + & LDA, A( PTRR( STEP(ISON)) + SHIFT_VAL_SON ), + & ROW_INDEX_LIST( PTRROW( IROW + 1 ) ), + & COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ), + & NRLOCAL, + & NCLOCAL, + & NSUPROW(IROW+1), NSUPCOL(JCOL+1), + & root%RG2L_ROW(1), root%RG2L_COL(1), INVERT, + & KEEP, + & root%RHS_ROOT(1,1), root%RHS_NLOC ) + END IF + ENDIF + END IF + DO IROW = 0, root%NPROW - 1 + DO JCOL = 0, root%NPCOL - 1 + PDEST = IROW * root%NPCOL + JCOL + IF ( (root%MYROW.eq.IROW.and.root%MYCOL.eq.JCOL) .and. + & MYID.ne.PDEST) THEN + write(*,*) 'error: myrow,mycol=',root%MYROW,root%MYCOL + write(*,*) ' MYID,PDEST=',MYID,PDEST + CALL MUMPS_ABORT() + END IF + IF ( root%MYROW .NE. IROW .OR. root%MYCOL .NE. JCOL) THEN + NBROWS_ALREADY_SENT = 0 + IERR = -1 + DO WHILE ( IERR .EQ. -1 ) + NSUBSET_ROW = PTRROW( IROW + 2 ) - PTRROW( IROW + 1 ) + NSUBSET_COL = PTRCOL( JCOL + 2 ) - PTRCOL( JCOL + 1 ) + IF ( LRLU .LT. int(NSUBSET_ROW,8) * int(NSUBSET_COL,8) + & .AND. LRLUS .GT. int(NSUBSET_ROW,8) * int(NSUBSET_COL,8) ) + & THEN + CALL CMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) MYID,': Error in b&scbroot: pb compress' + WRITE(*,*) MYID,': LRLU, LRLUS=',LRLU,LRLUS + CALL MUMPS_ABORT() + END IF + END IF + CALL CMUMPS_648( N, ISON, + & NBCOL, NBROW, + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_COL_SON ), + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_ROW_SON ), + & LDA, A( PTRR(STEP(ISON)) + SHIFT_VAL_SON ), + & TAG, + & ROW_INDEX_LIST( PTRROW( IROW + 1 ) ), + & COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ), + & NSUBSET_ROW, NSUBSET_COL, + & NSUPROW(IROW+1), NSUPCOL(JCOL+1), + & root%NPROW, root%NPCOL, root%MBLOCK, + & root%RG2L_ROW, root%RG2L_COL, + & root%NBLOCK, PDEST, + & COMM, IERR, A( POSFAC ), LRLU, INVERT, + & SIZE_MSG, NBROWS_ALREADY_SENT, KEEP, BBPCBP ) + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL CMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK, + & COMP, IFLAG, IERROR, COMM, NBPROCFILS, IPOOL, LPOOL, + & LEAF, NBFIN, MYID, SLAVEF, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, KEEP,KEEP8, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + END IF + END DO + IF ( IERR == -2 ) THEN + IFLAG = -17 + IERROR = SIZE_MSG + IF (LP > 0) WRITE(LP, *) "FAILURE, SEND BUFFER TOO + & SMALL DURING CMUMPS_80" + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + GOTO 500 + ENDIF + IF ( IERR == -3 ) THEN + IF (LP > 0) WRITE(LP, *) "FAILURE, RECV BUFFER TOO + & SMALL DURING CMUMPS_80" + IFLAG = -20 + IERROR = SIZE_MSG + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + GOTO 500 + ENDIF + END IF + END DO + END DO + 500 CONTINUE + DEALLOCATE(PTRROW) + DEALLOCATE(PTRCOL) + DEALLOCATE(ROW_INDEX_LIST) + DEALLOCATE(COL_INDEX_LIST) + RETURN + END SUBROUTINE CMUMPS_80 + SUBROUTINE CMUMPS_285( N, VAL_ROOT, + & LOCAL_M, LOCAL_N, + & NPCOL, NPROW, MBLOCK, NBLOCK, NBCOL_SON, NBROW_SON, INDCOL_SON, + & INDROW_SON, LD_SON, VAL_SON, SUBSET_ROW, SUBSET_COL, + & NSUBSET_ROW, NSUBSET_COL, NSUPROW, NSUPCOL, + & RG2L_ROW, RG2L_COL, INVERT, + & KEEP, RHS_ROOT, NLOC ) + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INTEGER N, LOCAL_M, LOCAL_N + COMPLEX VAL_ROOT( LOCAL_M, LOCAL_N ) + INTEGER NPCOL, NPROW, MBLOCK, NBLOCK + INTEGER NBCOL_SON, NBROW_SON + INTEGER INDCOL_SON( NBCOL_SON ), INDROW_SON( NBROW_SON ) + INTEGER LD_SON + INTEGER NSUPROW, NSUPCOL + COMPLEX VAL_SON( LD_SON, NBROW_SON ) + INTEGER KEEP(500) + INTEGER NSUBSET_ROW, NSUBSET_COL + INTEGER SUBSET_ROW( NSUBSET_ROW ), SUBSET_COL( NSUBSET_COL ) + INTEGER RG2L_ROW( N ), RG2L_COL( N ) + LOGICAL INVERT + INTEGER NLOC + COMPLEX RHS_ROOT( LOCAL_M, NLOC) + INTEGER ISUB, JSUB, I, J, IPOS_ROOT, JPOS_ROOT + INTEGER ILOC_ROOT, JLOC_ROOT, IGLOB, JGLOB + IF (KEEP(50).EQ.0) THEN + DO ISUB = 1, NSUBSET_ROW + I = SUBSET_ROW( ISUB ) + IGLOB = INDROW_SON( I ) + IPOS_ROOT = RG2L_ROW( IGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + DO JSUB = 1, NSUBSET_COL-NSUPCOL + J = SUBSET_COL( JSUB ) + JGLOB = INDCOL_SON( J ) + JPOS_ROOT = RG2L_COL( JGLOB ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + DO JSUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL + J = SUBSET_COL( JSUB ) + JGLOB = INDCOL_SON( J ) + JPOS_ROOT = JGLOB - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + RHS_ROOT(ILOC_ROOT, JLOC_ROOT) = + & RHS_ROOT(ILOC_ROOT, JLOC_ROOT) + VAL_SON( J, I ) + ENDDO + END DO + ELSE + IF ( .NOT. INVERT ) THEN + DO ISUB = 1, NSUBSET_ROW - NSUPROW + I = SUBSET_ROW( ISUB ) + IGLOB = INDROW_SON( I ) + IPOS_ROOT = RG2L_ROW( IGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + DO JSUB = 1, NSUBSET_COL -NSUPCOL + J = SUBSET_COL( JSUB ) + JGLOB = INDCOL_SON( J ) + JPOS_ROOT = RG2L_COL( JGLOB ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + END DO + DO JSUB = NSUBSET_COL -NSUPCOL+1, NSUBSET_COL + J = SUBSET_COL( JSUB ) + JGLOB = INDROW_SON( J ) + JPOS_ROOT = JGLOB - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + DO ISUB = NSUBSET_ROW - NSUPROW +1, NSUBSET_ROW + I = SUBSET_ROW( ISUB ) + IGLOB = INDCOL_SON( I ) + IPOS_ROOT = RG2L_ROW(IGLOB) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + RHS_ROOT(ILOC_ROOT, JLOC_ROOT) = + & RHS_ROOT(ILOC_ROOT, JLOC_ROOT) + VAL_SON( I, J ) + END DO + END DO + ELSE + DO ISUB = 1, NSUBSET_COL-NSUPCOL + I = SUBSET_COL( ISUB ) + IGLOB = INDROW_SON( I ) + JPOS_ROOT = RG2L_COL( IGLOB ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + DO JSUB = 1, NSUBSET_ROW + J = SUBSET_ROW( JSUB ) + JGLOB = INDCOL_SON( J ) + IPOS_ROOT = RG2L_ROW( JGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + ENDDO + DO ISUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL + I = SUBSET_COL( ISUB ) + IGLOB = INDROW_SON( I ) + JPOS_ROOT = IGLOB - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + DO JSUB = 1, NSUBSET_ROW + J = SUBSET_ROW( JSUB ) + JGLOB = INDCOL_SON( J ) + IPOS_ROOT = RG2L_ROW( JGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + RHS_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & RHS_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + ENDDO + END IF + END IF + RETURN + END SUBROUTINE CMUMPS_285 + SUBROUTINE CMUMPS_164 + &( MYID, NPROCS, N, root, COMM_ROOT, IROOT, FILS, + & K50, K46, K51 + & , K60, IDNPROW, IDNPCOL, IDMBLOCK, IDNBLOCK + & ) + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INTEGER MYID, MYID_ROOT + TYPE (CMUMPS_ROOT_STRUC)::root + INTEGER COMM_ROOT + INTEGER N, IROOT, NPROCS, K50, K46, K51 + INTEGER FILS( N ) + INTEGER K60, IDNPROW, IDNPCOL, IDMBLOCK, IDNBLOCK + INTEGER INODE, NPROWtemp, NPCOLtemp + LOGICAL SLAVE + root%ROOT_SIZE = 0 + root%TOT_ROOT_SIZE = 0 + SLAVE = ( MYID .ne. 0 .or. + & ( MYID .eq. 0 .and. K46 .eq. 1 ) ) + INODE = IROOT + DO WHILE ( INODE .GT. 0 ) + INODE = FILS( INODE ) + root%ROOT_SIZE = root%ROOT_SIZE + 1 + END DO + IF ( ( K60 .NE. 2 .AND. K60 .NE. 3 ) .OR. + & IDNPROW .LE. 0 .OR. IDNPCOL .LE. 0 + & .OR. IDMBLOCK .LE.0 .OR. IDNBLOCK.LE.0 + & .OR. IDNPROW * IDNPCOL .GT. NPROCS ) THEN + root%MBLOCK = K51 + root%NBLOCK = K51 + CALL CMUMPS_99( NPROCS, root%NPROW, root%NPCOL, + & root%ROOT_SIZE, K50 ) + IF ( K60 .EQ. 2 .OR. K60 .EQ. 3 ) THEN + IDNPROW = root%NPROW + IDNPCOL = root%NPCOL + IDMBLOCK = root%MBLOCK + IDNBLOCK = root%NBLOCK + ENDIF + ELSE IF ( K60 .EQ. 2 .OR. K60 .EQ. 3 ) THEN + root%NPROW = IDNPROW + root%NPCOL = IDNPCOL + root%MBLOCK = IDMBLOCK + root%NBLOCK = IDNBLOCK + ENDIF + IF ( K60 .EQ. 2 .OR. K60 .EQ. 3 ) THEN + IF (SLAVE) THEN + root%LPIV = 0 + IF (K46.EQ.0) THEN + MYID_ROOT=MYID-1 + ELSE + MYID_ROOT=MYID + ENDIF + IF (MYID_ROOT < root%NPROW*root%NPCOL) THEN + root%MYROW = MYID_ROOT / root%NPCOL + root%MYCOL = mod(MYID_ROOT, root%NPCOL) + root%yes = .true. + ELSE + root%MYROW = -1 + root%MYCOL = -1 + root%yes = .FALSE. + ENDIF + ELSE + root%yes = .FALSE. + ENDIF + ELSE IF ( SLAVE ) THEN + IF ( root%gridinit_done) THEN + CALL blacs_gridexit( root%CNTXT_BLACS ) + root%gridinit_done = .FALSE. + END IF + root%CNTXT_BLACS = COMM_ROOT + CALL blacs_gridinit( root%CNTXT_BLACS, 'R', + & root%NPROW, root%NPCOL ) + root%gridinit_done = .TRUE. + CALL blacs_gridinfo( root%CNTXT_BLACS, + & NPROWtemp, NPCOLtemp, + & root%MYROW, root%MYCOL ) + IF ( root%MYROW .NE. -1 ) THEN + root%yes = .true. + ELSE + root%yes = .false. + END IF + root%LPIV = 0 + ELSE + root%yes = .FALSE. + ENDIF + RETURN + END SUBROUTINE CMUMPS_164 + SUBROUTINE CMUMPS_165( N, root, FILS, IROOT, + & KEEP, INFO ) + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + TYPE ( CMUMPS_ROOT_STRUC ):: root + INTEGER N, IROOT, INFO(40), KEEP(500) + INTEGER FILS( N ) + INTEGER INODE, I, allocok + IF ( associated( root%RG2L_ROW ) ) DEALLOCATE( root%RG2L_ROW ) + IF ( associated( root%RG2L_COL ) ) DEALLOCATE( root%RG2L_COL ) + ALLOCATE( root%RG2L_ROW( N ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=N + RETURN + ENDIF + ALLOCATE( root%RG2L_COL( N ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=N + RETURN + ENDIF + INODE = IROOT + I = 1 + DO WHILE ( INODE .GT. 0 ) + root%RG2L_ROW( INODE ) = I + root%RG2L_COL( INODE ) = I + I = I + 1 + INODE = FILS( INODE ) + END DO + RETURN + END SUBROUTINE CMUMPS_165 + SUBROUTINE CMUMPS_99( NPROCS, NPROW, NPCOL, SIZE, K50 ) + IMPLICIT NONE + INTEGER NPROCS, NPROW, NPCOL, SIZE, K50 + INTEGER NPROWtemp, NPCOLtemp, NPROCSused, FLATNESS + LOGICAL KEEPIT + IF ( K50 .EQ. 1 ) THEN + FLATNESS = 2 + ELSE + FLATNESS = 3 + ENDIF + NPROW = int(sqrt(real(NPROCS))) + NPROWtemp = NPROW + NPCOL = int(NPROCS / NPROW) + NPCOLtemp = NPCOL + NPROCSused = NPROWtemp * NPCOLtemp + 10 CONTINUE + IF ( NPROWtemp >= NPCOLtemp/FLATNESS .AND. NPROWtemp > 1) THEN + NPROWtemp = NPROWtemp - 1 + NPCOLtemp = int(NPROCS / NPROWtemp) + KEEPIT=.FALSE. + IF ( NPROWtemp * NPCOLtemp .GE. NPROCSused ) THEN + IF ( ( K50 .NE. 1 .AND. NPROWtemp >= NPCOLtemp/FLATNESS) + & .OR. NPROWtemp * NPCOLtemp .GT. NPROCSused ) + & KEEPIT=.TRUE. + END IF + IF ( KEEPIT ) THEN + NPROW = NPROWtemp + NPCOL = NPCOLtemp + NPROCSused = NPROW * NPCOL + END IF + GO TO 10 + END IF + RETURN + END SUBROUTINE CMUMPS_99 + SUBROUTINE CMUMPS_290(MYID, M, N, ASEQ, + & LOCAL_M, LOCAL_N, + & MBLOCK, NBLOCK, + & APAR, + & MASTER_ROOT, + & NPROW, NPCOL, + & COMM) + IMPLICIT NONE + INTEGER MYID, MASTER_ROOT, COMM + INTEGER M, N + INTEGER NPROW, NPCOL + INTEGER LOCAL_M, LOCAL_N + INTEGER MBLOCK, NBLOCK + COMPLEX APAR( LOCAL_M, LOCAL_N ) + COMPLEX ASEQ( M, N ) + INCLUDE 'mpif.h' + INTEGER I, J, SIZE_IBLOCK, SIZE_JBLOCK, IDEST, IROW, ICOL + INTEGER IBLOCK, JBLOCK, II, JJ, KK + INTEGER IAPAR, JAPAR, IERR + INTEGER STATUS(MPI_STATUS_SIZE) + COMPLEX WK( MBLOCK * NBLOCK ) + LOGICAL JUPDATE + IAPAR = 1 + JAPAR = 1 + DO J = 1, N, NBLOCK + SIZE_JBLOCK = NBLOCK + IF ( J + NBLOCK > N ) THEN + SIZE_JBLOCK = N - J + 1 + END IF + JUPDATE = .FALSE. + DO I = 1, M, MBLOCK + SIZE_IBLOCK = MBLOCK + IF ( I + MBLOCK > M ) THEN + SIZE_IBLOCK = M - I + 1 + END IF + IBLOCK = I / MBLOCK + JBLOCK = J / NBLOCK + IROW = mod ( IBLOCK, NPROW ) + ICOL = mod ( JBLOCK, NPCOL ) + IDEST = IROW * NPCOL + ICOL + IF ( IDEST .NE. MASTER_ROOT ) THEN + IF ( MYID .EQ. MASTER_ROOT ) THEN + KK=1 + DO JJ=J,J+SIZE_JBLOCK-1 + DO II=I,I+SIZE_IBLOCK-1 + WK(KK)=ASEQ(II,JJ) + KK=KK+1 + END DO + END DO + CALL MPI_SSEND( WK, SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_COMPLEX, + & IDEST, 128, COMM, IERR ) + ELSE IF ( MYID .EQ. IDEST ) THEN + CALL MPI_RECV( WK(1), + & SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_COMPLEX, + & MASTER_ROOT,128,COMM,STATUS,IERR) + KK=1 + DO JJ=JAPAR,JAPAR+SIZE_JBLOCK-1 + DO II=IAPAR,IAPAR+SIZE_IBLOCK-1 + APAR(II,JJ)=WK(KK) + KK=KK+1 + END DO + END DO + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + ELSE IF ( MYID.EQ. MASTER_ROOT ) THEN + APAR( IAPAR:IAPAR+SIZE_IBLOCK-1, + & JAPAR:JAPAR+SIZE_JBLOCK-1 ) + & = ASEQ(I:I+SIZE_IBLOCK-1,J:J+SIZE_JBLOCK-1) + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + END DO + IF ( JUPDATE ) THEN + IAPAR = 1 + JAPAR = JAPAR + SIZE_JBLOCK + END IF + END DO + RETURN + END SUBROUTINE CMUMPS_290 + SUBROUTINE CMUMPS_156(MYID, M, N, ASEQ, + & LOCAL_M, LOCAL_N, + & MBLOCK, NBLOCK, + & APAR, + & MASTER_ROOT, + & NPROW, NPCOL, + & COMM) + IMPLICIT NONE + INTEGER MYID, MASTER_ROOT, COMM + INTEGER M, N + INTEGER NPROW, NPCOL + INTEGER LOCAL_M, LOCAL_N + INTEGER MBLOCK, NBLOCK + COMPLEX APAR( LOCAL_M, LOCAL_N ) + COMPLEX ASEQ( M, N ) + INCLUDE 'mpif.h' + INTEGER I, J, SIZE_IBLOCK, SIZE_JBLOCK, ISOUR, IROW, ICOL + INTEGER IBLOCK, JBLOCK, II, JJ, KK + INTEGER IAPAR, JAPAR, IERR + INTEGER STATUS(MPI_STATUS_SIZE) + COMPLEX WK( MBLOCK * NBLOCK ) + LOGICAL JUPDATE + IAPAR = 1 + JAPAR = 1 + DO J = 1, N, NBLOCK + SIZE_JBLOCK = NBLOCK + IF ( J + NBLOCK > N ) THEN + SIZE_JBLOCK = N - J + 1 + END IF + JUPDATE = .FALSE. + DO I = 1, M, MBLOCK + SIZE_IBLOCK = MBLOCK + IF ( I + MBLOCK > M ) THEN + SIZE_IBLOCK = M - I + 1 + END IF + IBLOCK = I / MBLOCK + JBLOCK = J / NBLOCK + IROW = mod ( IBLOCK, NPROW ) + ICOL = mod ( JBLOCK, NPCOL ) + ISOUR = IROW * NPCOL + ICOL + IF ( ISOUR .NE. MASTER_ROOT ) THEN + IF ( MYID .EQ. MASTER_ROOT ) THEN + CALL MPI_RECV( WK(1), SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_COMPLEX, + & ISOUR, 128, COMM, STATUS, IERR ) + KK=1 + DO JJ=J,J+SIZE_JBLOCK-1 + DO II=I,I+SIZE_IBLOCK-1 + ASEQ(II,JJ)=WK(KK) + KK=KK+1 + END DO + END DO + ELSE IF ( MYID .EQ. ISOUR ) THEN + KK=1 + DO JJ=JAPAR,JAPAR+SIZE_JBLOCK-1 + DO II=IAPAR,IAPAR+SIZE_IBLOCK-1 + WK(KK)=APAR(II,JJ) + KK=KK+1 + END DO + END DO + CALL MPI_SSEND( WK( 1 ), + & SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_COMPLEX, + & MASTER_ROOT,128,COMM,IERR) + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + ELSE IF ( MYID.EQ. MASTER_ROOT ) THEN + ASEQ(I:I+SIZE_IBLOCK-1,J:J+SIZE_JBLOCK-1) + & = APAR( IAPAR:IAPAR+SIZE_IBLOCK-1, + & JAPAR:JAPAR+SIZE_JBLOCK-1 ) + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + END DO + IF ( JUPDATE ) THEN + IAPAR = 1 + JAPAR = JAPAR + SIZE_JBLOCK + END IF + END DO + RETURN + END SUBROUTINE CMUMPS_156 + SUBROUTINE CMUMPS_284(root, IROOT, N, + & IW, LIW, A, LA, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INTEGER MYID + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + TYPE (CMUMPS_ROOT_STRUC ) :: root + INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS + INTEGER IROOT, LIW, N, IWPOS, IWPOSCB + INTEGER IW( LIW ) + COMPLEX A( LA ) + INTEGER PTRIST(KEEP(28)), STEP(N) + INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER PIMASTER(KEEP(28)) + INTEGER ITLOC( N + KEEP(253) ) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER COMP, IFLAG, IERROR + INCLUDE 'mumps_headers.h' + INTEGER FILS( N ), PTRAIW(N), PTRARW( N ) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX DBLARR(max(1,KEEP(13))) + INTEGER numroc + EXTERNAL numroc + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INTEGER(8) :: LREQA_ROOT + INTEGER LREQI_ROOT, LOCAL_M, LOCAL_N, allocok + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + IF (KEEP(253).GT.0) THEN + root%RHS_NLOC = numroc( KEEP(253), root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + root%RHS_NLOC = max(1, root%RHS_NLOC) + ELSE + root%RHS_NLOC = 1 + ENDIF + IF (associated( root%RHS_ROOT) ) + & DEALLOCATE (root%RHS_ROOT) + ALLOCATE(root%RHS_ROOT(LOCAL_M,root%RHS_NLOC), + & stat=allocok) + IF ( allocok.GT.0) THEN + IFLAG=-13 + IERROR = LOCAL_M*root%RHS_NLOC + RETURN + ENDIF + IF (KEEP(253).NE.0) THEN + root%RHS_ROOT = ZERO + CALL CMUMPS_760 ( N, FILS, + & root, KEEP, RHS_MUMPS, + & IFLAG, IERROR ) + IF ( IFLAG .LT. 0 ) RETURN + ENDIF + IF (KEEP(60) .NE. 0) THEN + PTRIST(STEP(IROOT)) = -6666666 + RETURN + ENDIF + LREQI_ROOT = 2 + KEEP(IXSZ) + LREQA_ROOT = int(LOCAL_M,8) * int(LOCAL_N,8) + IF (LREQA_ROOT.EQ.0_8) THEN + PTRIST(STEP(IROOT)) = -9999999 + RETURN + ENDIF + CALL CMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A,LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, LREQI_ROOT, + & LREQA_ROOT, IROOT, S_NOTFREE, .TRUE., COMP, + & LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + PTRIST ( STEP(IROOT) ) = IWPOSCB + 1 + PAMASTER( STEP(IROOT) ) = IPTRLU + 1_8 + IW( IWPOSCB + 1 + KEEP(IXSZ)) = - LOCAL_N + IW( IWPOSCB + 2 + KEEP(IXSZ)) = LOCAL_M + RETURN + END SUBROUTINE CMUMPS_284 + SUBROUTINE CMUMPS_760 + & ( N, FILS, root, KEEP, RHS_MUMPS, + & IFLAG, IERROR ) + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INTEGER N, KEEP(500), IFLAG, IERROR + INTEGER FILS(N) + TYPE (CMUMPS_ROOT_STRUC ) :: root + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER JCOL, IPOS_ROOT, JPOS_ROOT, + & IROW_GRID, JCOL_GRID, ILOCRHS, JLOCRHS, + & INODE + INODE = KEEP(38) + DO WHILE (INODE.GT.0) + IPOS_ROOT = root%RG2L_ROW( INODE ) + IROW_GRID = mod( ( IPOS_ROOT - 1 ) / root%MBLOCK, root%NPROW ) + IF ( IROW_GRID .NE. root%MYROW ) GOTO 100 + ILOCRHS = root%MBLOCK * ( ( IPOS_ROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOS_ROOT - 1, root%MBLOCK ) + 1 + DO JCOL = 1, KEEP(253) + JPOS_ROOT = JCOL + JCOL_GRID = mod((JPOS_ROOT-1)/root%NBLOCK, root%NPCOL) + IF (JCOL_GRID.NE.root%MYCOL ) CYCLE + JLOCRHS = root%NBLOCK * ( ( JPOS_ROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOS_ROOT - 1, root%NBLOCK ) + 1 + root%RHS_ROOT(ILOCRHS, JLOCRHS) = + & RHS_MUMPS(INODE+(JCOL-1)*KEEP(254)) + ENDDO + 100 CONTINUE + INODE=FILS(INODE) + ENDDO + RETURN + END SUBROUTINE CMUMPS_760 + INTEGER FUNCTION CMUMPS_IXAMAX(n,x,incx) + complex x(*) + real smax + integer i,ix + integer incx,n + CMUMPS_IXAMAX = 0 + if( n.lt.1 ) return + CMUMPS_IXAMAX = 1 + if( n.eq.1 .or. incx.le.0 )return + if(incx.eq.1)go to 20 + ix = 1 + smax = abs(x(1)) + ix = ix + incx + do 10 i = 2,n + if(abs(x(ix)).le.smax) go to 5 + CMUMPS_IXAMAX = i + smax = abs(x(ix)) + 5 ix = ix + incx + 10 continue + return + 20 smax = abs(x(1)) + do 30 i = 2,n + if(abs(x(i)).le.smax) go to 30 + CMUMPS_IXAMAX = i + smax = abs(x(i)) + 30 continue + return + END FUNCTION CMUMPS_IXAMAX + SUBROUTINE CMUMPS_XSYR( UPLO, N, ALPHA, X, INCX, A, LDA ) + CHARACTER UPLO + INTEGER INCX, LDA, N + COMPLEX ALPHA + COMPLEX A( LDA, * ), X( * ) + COMPLEX ZERO + PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) ) + INTEGER I, INFO, IX, J, JX, KX + COMPLEX TEMP + INTRINSIC max + INFO = 0 + IF( UPLO.NE.'U' .AND. UPLO.NE.'L' ) THEN + INFO = 1 + ELSE IF( N.LT.0 ) THEN + INFO = 2 + ELSE IF( INCX.EQ.0 ) THEN + INFO = 5 + ELSE IF( LDA.LT.max( 1, N ) ) THEN + INFO = 7 + END IF + IF( INFO.NE.0 ) THEN + WRITE(*,*) "Internal error in CMUMPS_XSYR" + CALL MUMPS_ABORT() + RETURN + END IF + IF( ( N.EQ.0 ) .OR. ( ALPHA.EQ.ZERO ) ) + & RETURN + IF( INCX.LE.0 ) THEN + KX = 1 - ( N-1 )*INCX + ELSE IF( INCX.NE.1 ) THEN + KX = 1 + END IF + IF( UPLO.EQ.'U' ) THEN + IF( INCX.EQ.1 ) THEN + DO 20 J = 1, N + IF( X( J ).NE.ZERO ) THEN + TEMP = ALPHA*X( J ) + DO 10 I = 1, J + A( I, J ) = A( I, J ) + X( I )*TEMP + 10 CONTINUE + END IF + 20 CONTINUE + ELSE + JX = KX + DO 40 J = 1, N + IF( X( JX ).NE.ZERO ) THEN + TEMP = ALPHA*X( JX ) + IX = KX + DO 30 I = 1, J + A( I, J ) = A( I, J ) + X( IX )*TEMP + IX = IX + INCX + 30 CONTINUE + END IF + JX = JX + INCX + 40 CONTINUE + END IF + ELSE + IF( INCX.EQ.1 ) THEN + DO 60 J = 1, N + IF( X( J ).NE.ZERO ) THEN + TEMP = ALPHA*X( J ) + DO 50 I = J, N + A( I, J ) = A( I, J ) + X( I )*TEMP + 50 CONTINUE + END IF + 60 CONTINUE + ELSE + JX = KX + DO 80 J = 1, N + IF( X( JX ).NE.ZERO ) THEN + TEMP = ALPHA*X( JX ) + IX = JX + DO 70 I = J, N + A( I, J ) = A( I, J ) + X( IX )*TEMP + IX = IX + INCX + 70 CONTINUE + END IF + JX = JX + INCX + 80 CONTINUE + END IF + END IF + RETURN + END SUBROUTINE CMUMPS_XSYR diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part7.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part7.F new file mode 100644 index 000000000..b29934dcb --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part7.F @@ -0,0 +1,1037 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE CMUMPS_635(N,KEEP,ICNTL,MPG) + IMPLICIT NONE + INTEGER N, KEEP(500), ICNTL(40), MPG + KEEP(19)=0 + RETURN + END SUBROUTINE CMUMPS_635 + SUBROUTINE CMUMPS_634(ICNTL,KEEP,MPG,INFO) + IMPLICIT NONE + INTEGER KEEP(500), MPG, INFO(40), ICNTL(40) + IF (KEEP(19).EQ.0.AND.KEEP(110).EQ.0) THEN + IF (KEEP(111).NE.0) THEN + INFO(1) = -37 + INFO(2) = 16 + IF (KEEP(110).EQ.0) INFO(2) = 24 + IF(MPG.GT.0) THEN + WRITE( MPG,'(A)') + &'** ERROR : Null space computation requirement' + WRITE( MPG,'(A)') + &'** not consistent with factorization options' + ENDIF + GOTO 333 + ENDIF + ENDIF + IF (ICNTL(9).NE.1) THEN + IF (KEEP(111).NE.0) THEN + INFO(1) = -37 + INFO(2) = 9 + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + &'** ERROR ICNTL(25) incompatible with ' + WRITE( MPG,'(A)') + &'** option transposed system (ICNLT(9)=1) ' + ENDIF + ENDIF + GOTO 333 + ENDIF + 333 CONTINUE + RETURN + END SUBROUTINE CMUMPS_634 + SUBROUTINE CMUMPS_637(id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (CMUMPS_STRUC) id + NULLIFY(id%root%QR_TAU) + RETURN + END SUBROUTINE CMUMPS_637 + SUBROUTINE CMUMPS_636(id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (CMUMPS_STRUC) id + IF (associated(id%root%QR_TAU)) THEN + DEALLOCATE(id%root%QR_TAU) + NULLIFY(id%root%QR_TAU) + ENDIF + RETURN + END SUBROUTINE CMUMPS_636 + SUBROUTINE CMUMPS_146( MYID, root, N, IROOT, + & COMM, IW, LIW, IFREE, + & A, LA, PTRAST, PTLUST_S, PTRFAC, + & STEP, INFO, LDLT, QR, + & WK, LWK, KEEP,KEEP8,DKEEP) + IMPLICIT NONE + INCLUDE 'cmumps_root.h' + INCLUDE 'mpif.h' + TYPE ( CMUMPS_ROOT_STRUC ) :: root + INTEGER N, IROOT, COMM, LIW, MYID, IFREE + INTEGER(8) :: LA + INTEGER(8) :: LWK + COMPLEX WK( LWK ) + INTEGER KEEP(500) + REAL DKEEP(30) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PTLUST_S(KEEP(28)), STEP(N), IW( LIW ) + INTEGER INFO( 2 ), LDLT, QR + COMPLEX A( LA ) + INTEGER IOLDPS + INTEGER(8) :: IAPOS + INTEGER LOCAL_M, LOCAL_N, LPIV, IERR, allocok + INTEGER FWD_LOCAL_N_RHS, FWD_MTYPE + INCLUDE 'mumps_headers.h' + EXTERNAL numroc + INTEGER numroc + IF ( .NOT. root%yes ) RETURN + IF ( KEEP(60) .NE. 0 ) THEN + IF ((LDLT == 1 .OR. LDLT == 2) .AND. KEEP(60) == 3 ) THEN + CALL CMUMPS_320( WK, root%MBLOCK, + & root%MYROW, root%MYCOL, root%NPROW, root%NPCOL, + & root%SCHUR_POINTER(1), + & root%SCHUR_LLD, root%SCHUR_NLOC, + & root%TOT_ROOT_SIZE, MYID, COMM ) + ENDIF + RETURN + ENDIF + IOLDPS = PTLUST_S(STEP(IROOT))+KEEP(IXSZ) + IAPOS = PTRAST(STEP(IROOT)) + LOCAL_M = IW( IOLDPS + 2 ) + LOCAL_N = IW( IOLDPS + 1 ) + IAPOS = PTRFAC(IW ( IOLDPS + 4 )) + IF ( LDLT.EQ.0 .OR. LDLT.EQ.2 .OR. QR.ne.0 ) THEN + LPIV = LOCAL_M + root%MBLOCK + ELSE + LPIV = 1 + END IF + IF (associated( root%IPIV )) DEALLOCATE(root%IPIV) + root%LPIV = LPIV + ALLOCATE( root%IPIV( LPIV ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LPIV + WRITE(*,*) MYID,': problem allocating IPIV(',LPIV,') in root' + CALL MUMPS_ABORT() + END IF + CALL DESCINIT( root%DESCRIPTOR(1), root%TOT_ROOT_SIZE, + & root%TOT_ROOT_SIZE, root%MBLOCK, root%NBLOCK, + & 0, 0, root%CNTXT_BLACS, LOCAL_M, IERR ) + IF ( LDLT.EQ.2 ) THEN + IF(root%MBLOCK.NE.root%NBLOCK) THEN + WRITE(*,*) ' Error: symmetrization only works for' + WRITE(*,*) ' square block sizes, MBLOCK/NBLOCK=', + & root%MBLOCK, root%NBLOCK + CALL MUMPS_ABORT() + END IF + IF ( LWK .LT. min( + & int(root%MBLOCK,8) * int(root%NBLOCK,8), + & int(root%TOT_ROOT_SIZE,8)* int(root%TOT_ROOT_SIZE,8 ) + & )) THEN + WRITE(*,*) 'Not enough workspace for symmetrization.' + CALL MUMPS_ABORT() + END IF + CALL CMUMPS_320( WK, root%MBLOCK, + & root%MYROW, root%MYCOL, root%NPROW, root%NPCOL, + & A( IAPOS ), LOCAL_M, LOCAL_N, + & root%TOT_ROOT_SIZE, MYID, COMM ) + END IF + IF (LDLT.EQ.0.OR.LDLT.EQ.2) THEN + CALL pcgetrf( root%TOT_ROOT_SIZE, root%TOT_ROOT_SIZE, + & A( IAPOS ), + & 1, 1, root%DESCRIPTOR(1), root%IPIV(1), IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-10 + INFO(2)=IERR-1 + END IF + ELSE + CALL pcpotrf('L',root%TOT_ROOT_SIZE,A(IAPOS), + & 1,1,root%DESCRIPTOR(1),IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-40 + INFO(2)=IERR-1 + END IF + END IF + IF (KEEP(258).NE.0) THEN + IF (root%MBLOCK.NE.root%NBLOCK) THEN + write(*,*) "Internal error in CMUMPS_146:", + & "Block size different for rows and columns", + & root%MBLOCK, root%NBLOCK + CALL MUMPS_ABORT() + ENDIF + CALL CMUMPS_763(root%MBLOCK, root%IPIV(1),root%MYROW, + & root%MYCOL, root%NPROW, root%NPCOL, A(IAPOS), LOCAL_M, + & LOCAL_N, root%TOT_ROOT_SIZE, MYID, DKEEP(6), KEEP(259), + & LDLT) + ENDIF + IF (KEEP(252) .NE. 0) THEN + FWD_LOCAL_N_RHS = numroc(KEEP(253), root%NBLOCK, + & root%MYCOL, 0, root%NPCOL) + FWD_LOCAL_N_RHS = max(1,FWD_LOCAL_N_RHS) + FWD_MTYPE = 1 + CALL CMUMPS_768( + & root%TOT_ROOT_SIZE, + & KEEP(253), + & FWD_MTYPE, + & A(IAPOS), + & root%DESCRIPTOR(1), + & LOCAL_M, LOCAL_N, FWD_LOCAL_N_RHS, + & root%IPIV(1), LPIV, + & root%RHS_ROOT(1,1), LDLT, + & root%MBLOCK, root%NBLOCK, + & root%CNTXT_BLACS, IERR) + ENDIF + RETURN + END SUBROUTINE CMUMPS_146 + SUBROUTINE CMUMPS_556( + & N,PIV,FRERE,FILS,NFSIZ,IKEEP, + & NCST,KEEP,KEEP8,id) + USE CMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (CMUMPS_STRUC) :: id + INTEGER N,NCST + INTEGER PIV(N),FRERE(N),FILS(N),NFSIZ(N),IKEEP(N,3) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER I,P11,P1,P2,K1,K2,NLOCKED + LOGICAL V1,V2 + NCST = 0 + NLOCKED = 0 + P11 = KEEP(93) + DO I=KEEP(93)-1,1,-2 + P1 = PIV(I) + P2 = PIV(I+1) + K1 = IKEEP(P1,1) + IF(K1 .GT. 0) THEN + V1 = (abs(id%A(K1))*(id%ROWSCA(P1)**2).GE.1.0E-1) + ELSE + V1 = .FALSE. + ENDIF + K2 = IKEEP(P2,1) + IF(K2 .GT. 0) THEN + V2 = (abs(id%A(K2))*(id%ROWSCA(P2)**2).GE.1.0E-1) + ELSE + V2 = .FALSE. + ENDIF + IF(V1 .AND. V2) THEN + PIV(P11) = P1 + P11 = P11 - 1 + PIV(P11) = P2 + P11 = P11 - 1 + ELSE IF(V1) THEN + NCST = NCST+1 + FRERE(NCST) = P1 + NCST = NCST+1 + FRERE(NCST) = P2 + ELSE IF(V2) THEN + NCST = NCST+1 + FRERE(NCST) = P2 + NCST = NCST+1 + FRERE(NCST) = P1 + ELSE + NLOCKED = NLOCKED + 1 + FILS(NLOCKED) = P1 + NLOCKED = NLOCKED + 1 + FILS(NLOCKED) = P2 + ENDIF + ENDDO + DO I=1,NLOCKED + PIV(I) = FILS(I) + ENDDO + KEEP(94) = KEEP(94) + KEEP(93) - NLOCKED + KEEP(93) = NLOCKED + DO I=1,NCST + NLOCKED = NLOCKED + 1 + PIV(NLOCKED) = FRERE(I) + ENDDO + DO I=1,KEEP(93)/2 + NFSIZ(I) = 0 + ENDDO + DO I=(KEEP(93)/2)+1,(KEEP(93)/2)+NCST,2 + NFSIZ(I) = I+1 + NFSIZ(I+1) = -1 + ENDDO + DO I=(KEEP(93)/2)+NCST+1,(KEEP(93)/2)+KEEP(94) + NFSIZ(I) = 0 + ENDDO + END SUBROUTINE CMUMPS_556 + SUBROUTINE CMUMPS_550(N,NCMP,N11,N22,PIV, + & INVPERM,PERM) + IMPLICIT NONE + INTEGER N11,N22,N,NCMP + INTEGER, intent(in) :: PIV(N),PERM(N) + INTEGER, intent (out):: INVPERM(N) + INTEGER CMP_POS,EXP_POS,I,J,N2,K + N2 = N22/2 + EXP_POS = 1 + DO CMP_POS=1,NCMP + J = PERM(CMP_POS) + IF(J .LE. N2) THEN + K = 2*J-1 + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + K = K+1 + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + ELSE + K = N2 + J + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + ENDIF + ENDDO + DO K=N22+N11+1,N + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + ENDDO + RETURN + END SUBROUTINE CMUMPS_550 + SUBROUTINE CMUMPS_547( + & N,NZ, IRN, ICN, PIV, + & NCMP, IW, LW, IPE, LEN, IQ, + & FLAG, ICMP, IWFR, + & IERROR, KEEP,KEEP8, ICNTL) + IMPLICIT NONE + INTEGER N,NZ,NCMP,LW,IWFR,IERROR + INTEGER ICNTL(40),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IRN(NZ),ICN(NZ),IW(LW),PIV(N),IPE(N+1) + INTEGER LEN(N),IQ(N),FLAG(N),ICMP(N) + INTEGER MP,N11,N22,NDUP + INTEGER I,K,J,N1,LAST,K1,K2,L + MP = ICNTL(2) + IERROR = 0 + N22 = KEEP(93) + N11 = KEEP(94) + NCMP = N22/2 + N11 + DO I=1,NCMP + IPE(I) = 0 + ENDDO + K = 1 + DO I=1,N22/2 + J = PIV(K) + ICMP(J) = I + K = K + 1 + J = PIV(K) + ICMP(J) = I + K = K + 1 + ENDDO + K = N22/2 + 1 + DO I=N22+1,N22+N11 + J = PIV(I) + ICMP(J) = K + K = K + 1 + ENDDO + DO I=N11+N22+1,N + J = PIV(I) + ICMP(J) = 0 + ENDDO + DO K=1,NZ + I = IRN(K) + J = ICN(K) + I = ICMP(I) + J = ICMP(J) + IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + IERROR = IERROR + 1 + ELSE + IF (I.NE.J) THEN + IPE(I) = IPE(I) + 1 + IPE(J) = IPE(J) + 1 + ENDIF + ENDIF + ENDDO + IQ(1) = 1 + N1 = NCMP - 1 + IF (N1.GT.0) THEN + DO I=1,N1 + IQ(I+1) = IPE(I) + IQ(I) + ENDDO + ENDIF + LAST = max(IPE(NCMP)+IQ(NCMP)-1,IQ(NCMP)) + DO I = 1,NCMP + FLAG(I) = 0 + IPE(I) = IQ(I) + ENDDO + DO K=1,LAST + IW(K) = 0 + ENDDO + IWFR = LAST + 1 + DO K=1,NZ + I = IRN(K) + J = ICN(K) + I = ICMP(I) + J = ICMP(J) + IF (I.NE.J) THEN + IF (I.LT.J) THEN + IF ((I.GE.1).AND.(J.LE.N)) THEN + IW(IQ(I)) = -J + IQ(I) = IQ(I) + 1 + ENDIF + ELSE + IF ((J.GE.1).AND.(I.LE.N)) THEN + IW(IQ(J)) = -I + IQ(J) = IQ(J) + 1 + ENDIF + ENDIF + ENDIF + ENDDO + NDUP = 0 + DO I=1,NCMP + K1 = IPE(I) + K2 = IQ(I) -1 + IF (K1.GT.K2) THEN + LEN(I) = 0 + IQ(I) = 0 + ELSE + DO K=K1,K2 + J = -IW(K) + IF (J.LE.0) GO TO 250 + L = IQ(J) + IQ(J) = L + 1 + IF (FLAG(J).EQ.I) THEN + NDUP = NDUP + 1 + IW(L) = 0 + IW(K) = 0 + ELSE + IW(L) = I + IW(K) = J + FLAG(J) = I + ENDIF + ENDDO + 250 IQ(I) = IQ(I) - IPE(I) + IF (NDUP.EQ.0) LEN(I) = IQ(I) + ENDIF + ENDDO + IF (NDUP.NE.0) THEN + IWFR = 1 + DO I=1,NCMP + K1 = IPE(I) + IF (IQ(I).EQ.0) THEN + LEN(I) = 0 + IPE(I) = IWFR + CYCLE + ENDIF + K2 = K1 + IQ(I) - 1 + L = IWFR + IPE(I) = IWFR + DO K=K1,K2 + IF (IW(K).NE.0) THEN + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + ENDIF + ENDDO + LEN(I) = IWFR - L + ENDDO + ENDIF + IPE(NCMP+1) = IPE(NCMP) + LEN(NCMP) + IWFR = IPE(NCMP+1) + RETURN + END SUBROUTINE CMUMPS_547 + SUBROUTINE CMUMPS_551( + & N, NE, IP, IRN, SCALING,LSC,CPERM, DIAG, + & ICNTL, WEIGHT,MARKED,FLAG, + & PIV_OUT, INFO) + IMPLICIT NONE + INTEGER N, NE, ICNTL(10), INFO(10),LSC + INTEGER CPERM(N),PIV_OUT(N),IP(N+1),IRN(NE), DIAG(N) + REAL SCALING(LSC),WEIGHT(N+2) + INTEGER MARKED(N),FLAG(N) + INTEGER NUM1,NUM2,NUMTOT,PATH_LENGTH,NLAST + INTEGER I,CUR_EL,CUR_EL_PATH,CUR_EL_PATH_NEXT,BEST_BEG + INTEGER L1,L2,PTR_SET1,PTR_SET2,TUP,T22 + REAL BEST_SCORE,CUR_VAL,TMP,VAL + REAL INITSCORE, CMUMPS_739, + & CMUMPS_740, CMUMPS_741 + LOGICAL VRAI,FAUX,MAX_CARD_DIAG,USE_SCALING + INTEGER SUM + REAL ZERO,ONE + PARAMETER (SUM = 1, VRAI = .TRUE., FAUX = .FALSE.) + PARAMETER(ZERO = 0.0E0, ONE = 1.0E0) + MAX_CARD_DIAG = .TRUE. + NUM1 = 0 + NUM2 = 0 + NUMTOT = 0 + NLAST = N + INFO = 0 + MARKED = 1 + FLAG = 0 + VAL = ONE + IF(LSC .GT. 1) THEN + USE_SCALING = .TRUE. + ELSE + USE_SCALING = .FALSE. + ENDIF + TUP = ICNTL(2) + IF(TUP .EQ. SUM) THEN + INITSCORE = ZERO + ELSE + INITSCORE = ONE + ENDIF + IF(ICNTL(2) .GT. 2 .OR. ICNTL(2) .LE. 0) THEN + WRITE(*,*) + & 'ERROR: WRONG VALUE FOR ICNTL(2) = ',ICNTL(2) + INFO(1) = -1 + RETURN + ENDIF + T22 = ICNTL(1) + IF(ICNTL(1) .LT. 0 .OR. ICNTL(1) .GT. 2) THEN + WRITE(*,*) + & 'ERROR: WRONG VALUE FOR ICNTL(1) = ',ICNTL(1) + INFO(1) = -1 + RETURN + ENDIF + DO CUR_EL=1,N + IF(MARKED(CUR_EL) .LE. 0) THEN + CYCLE + ENDIF + IF(CPERM(CUR_EL) .LT. 0) THEN + MARKED(CUR_EL) = -1 + CYCLE + ENDIF + PATH_LENGTH = 2 + CUR_EL_PATH = CPERM(CUR_EL) + IF(CUR_EL_PATH .EQ. CUR_EL) THEN + MARKED(CUR_EL) = -1 + CYCLE + ENDIF + MARKED(CUR_EL) = 0 + WEIGHT(1) = INITSCORE + WEIGHT(2) = INITSCORE + L1 = IP(CUR_EL+1)-IP(CUR_EL) + L2 = IP(CUR_EL_PATH+1)-IP(CUR_EL_PATH) + PTR_SET1 = IP(CUR_EL) + PTR_SET2 = IP(CUR_EL_PATH) + IF(USE_SCALING) THEN + VAL = -SCALING(CUR_EL_PATH) - SCALING(CUR_EL+N) + ENDIF + CUR_VAL = CMUMPS_741( + & CUR_EL,CUR_EL_PATH, + & IRN(PTR_SET1),IRN(PTR_SET2), + & L1,L2, + & VAL,DIAG,N,FLAG,FAUX,T22) + WEIGHT(PATH_LENGTH+1) = + & CMUMPS_739(WEIGHT(1),CUR_VAL,TUP) + DO + IF(CUR_EL_PATH .EQ. CUR_EL) EXIT + PATH_LENGTH = PATH_LENGTH+1 + MARKED(CUR_EL_PATH) = 0 + CUR_EL_PATH_NEXT = CPERM(CUR_EL_PATH) + L1 = IP(CUR_EL_PATH+1)-IP(CUR_EL_PATH) + L2 = IP(CUR_EL_PATH_NEXT+1)-IP(CUR_EL_PATH_NEXT) + PTR_SET1 = IP(CUR_EL_PATH) + PTR_SET2 = IP(CUR_EL_PATH_NEXT) + IF(USE_SCALING) THEN + VAL = -SCALING(CUR_EL_PATH_NEXT) + & - SCALING(CUR_EL_PATH+N) + ENDIF + CUR_VAL = CMUMPS_741( + & CUR_EL_PATH,CUR_EL_PATH_NEXT, + & IRN(PTR_SET1),IRN(PTR_SET2), + & L1,L2, + & VAL,DIAG,N,FLAG,VRAI,T22) + WEIGHT(PATH_LENGTH+1) = + & CMUMPS_739(WEIGHT(PATH_LENGTH-1),CUR_VAL,TUP) + CUR_EL_PATH = CUR_EL_PATH_NEXT + ENDDO + IF(mod(PATH_LENGTH,2) .EQ. 1) THEN + IF(WEIGHT(PATH_LENGTH+1) .GE. WEIGHT(PATH_LENGTH)) THEN + CUR_EL_PATH = CPERM(CUR_EL) + ELSE + CUR_EL_PATH = CUR_EL + ENDIF + DO I=1,(PATH_LENGTH-1)/2 + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + ENDDO + NUMTOT = NUMTOT + PATH_LENGTH - 1 + ELSE + IF(MAX_CARD_DIAG) THEN + CUR_EL_PATH = CPERM(CUR_EL) + IF(DIAG(CUR_EL) .NE. 0) THEN + BEST_BEG = CUR_EL_PATH + GOTO 1000 + ENDIF + DO I=1,(PATH_LENGTH/2) + CUR_EL_PATH_NEXT = CPERM(CUR_EL_PATH) + IF(DIAG(CUR_EL_PATH) .NE. 0) THEN + BEST_BEG = CUR_EL_PATH_NEXT + GOTO 1000 + ENDIF + ENDDO + ENDIF + BEST_BEG = CUR_EL + BEST_SCORE = WEIGHT(PATH_LENGTH-1) + CUR_EL_PATH = CPERM(CUR_EL) + DO I=1,(PATH_LENGTH/2)-1 + TMP = CMUMPS_739(WEIGHT(PATH_LENGTH), + & WEIGHT(2*I-1),TUP) + TMP = CMUMPS_740(TMP,WEIGHT(2*I),TUP) + IF(TMP .GT. BEST_SCORE) THEN + BEST_SCORE = TMP + BEST_BEG = CUR_EL_PATH + ENDIF + CUR_EL_PATH = CPERM(CUR_EL_PATH) + TMP = CMUMPS_739(WEIGHT(PATH_LENGTH+1), + & WEIGHT(2*I),TUP) + TMP = CMUMPS_740(TMP,WEIGHT(2*I+1),TUP) + IF(TMP .GT. BEST_SCORE) THEN + BEST_SCORE = TMP + BEST_BEG = CUR_EL_PATH + ENDIF + CUR_EL_PATH = CPERM(CUR_EL_PATH) + ENDDO + 1000 CUR_EL_PATH = BEST_BEG + DO I=1,(PATH_LENGTH/2)-1 + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + ENDDO + NUMTOT = NUMTOT + PATH_LENGTH - 2 + MARKED(CUR_EL_PATH) = -1 + ENDIF + ENDDO + DO I=1,N + IF(MARKED(I) .LT. 0) THEN + IF(DIAG(I) .EQ. 0) THEN + PIV_OUT(NLAST) = I + NLAST = NLAST - 1 + ELSE + NUM1 = NUM1 + 1 + PIV_OUT(NUM2+NUM1) = I + NUMTOT = NUMTOT + 1 + ENDIF + ENDIF + ENDDO + INFO(2) = NUMTOT + INFO(3) = NUM1 + INFO(4) = NUM2 + RETURN + END SUBROUTINE CMUMPS_551 + FUNCTION CMUMPS_739(A,B,T) + IMPLICIT NONE + REAL CMUMPS_739 + REAL A,B + INTEGER T + INTEGER SUM + PARAMETER(SUM = 1) + IF(T .EQ. SUM) THEN + CMUMPS_739 = A+B + ELSE + CMUMPS_739 = A*B + ENDIF + END FUNCTION CMUMPS_739 + FUNCTION CMUMPS_740(A,B,T) + IMPLICIT NONE + REAL CMUMPS_740 + REAL A,B + INTEGER T + INTEGER SUM + PARAMETER(SUM = 1) + IF(T .EQ. SUM) THEN + CMUMPS_740 = A-B + ELSE + CMUMPS_740 = A/B + ENDIF + END FUNCTION CMUMPS_740 + FUNCTION CMUMPS_741(CUR_EL,CUR_EL_PATH, + & SET1,SET2,L1,L2,VAL,DIAG,N,FLAG,FLAGON,T) + IMPLICIT NONE + REAL CMUMPS_741 + INTEGER CUR_EL,CUR_EL_PATH,L1,L2,N + INTEGER SET1(L1),SET2(L2),DIAG(N),FLAG(N) + REAL VAL + LOGICAL FLAGON + INTEGER T + INTEGER I,INTER,MERGE + INTEGER STRUCT,MA47 + PARAMETER(STRUCT=0,MA47=1) + IF(T .EQ. STRUCT) THEN + IF(.NOT. FLAGON) THEN + DO I=1,L1 + FLAG(SET1(I)) = CUR_EL + ENDDO + ENDIF + INTER = 0 + DO I=1,L2 + IF(FLAG(SET2(I)) .EQ. CUR_EL) THEN + INTER = INTER + 1 + FLAG(SET2(I)) = CUR_EL_PATH + ENDIF + ENDDO + MERGE = L1 + L2 - INTER + CMUMPS_741 = real(INTER) / real(MERGE) + ELSE IF (T .EQ. MA47) THEN + MERGE = 3 + IF(DIAG(CUR_EL) .NE. 0) MERGE = 2 + IF(DIAG(CUR_EL_PATH) .NE. 0) MERGE = MERGE - 2 + IF(MERGE .EQ. 0) THEN + CMUMPS_741 = real(L1+L2-2) + CMUMPS_741 = -(CMUMPS_741**2)/2.0E0 + ELSE IF(MERGE .EQ. 1) THEN + CMUMPS_741 = - real(L1+L2-4) * real(L1-2) + ELSE IF(MERGE .EQ. 2) THEN + CMUMPS_741 = - real(L1+L2-4) * real(L2-2) + ELSE + CMUMPS_741 = - real(L1-2) * real(L2-2) + ENDIF + ELSE + CMUMPS_741 = VAL + ENDIF + RETURN + END FUNCTION + SUBROUTINE CMUMPS_622(NA, NCMP, + & INVPERM,PERM, + & LISTVAR_SCHUR, SIZE_SCHUR, AOTOA) + IMPLICIT NONE + INTEGER, INTENT(IN):: SIZE_SCHUR, LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER, INTENT(IN):: NA, NCMP + INTEGER, INTENT(IN):: AOTOA(NCMP), PERM(NCMP) + INTEGER, INTENT(OUT):: INVPERM(NA) + INTEGER CMP_POS, IO, I, K, IPOS + DO CMP_POS=1, NCMP + IO = PERM(CMP_POS) + INVPERM(AOTOA(IO)) = CMP_POS + ENDDO + IPOS = NCMP + DO K =1, SIZE_SCHUR + I = LISTVAR_SCHUR(K) + IPOS = IPOS+1 + INVPERM(I) = IPOS + ENDDO + RETURN + END SUBROUTINE CMUMPS_622 + SUBROUTINE CMUMPS_623 + & (NA,N,NZ, IRN, ICN, IW, LW, IPE, LEN, + & IQ, FLAG, IWFR, + & NRORM, NIORM, IFLAG,IERROR, ICNTL, + & symmetry, SYM, MedDens, NBQD, AvgDens, + & LISTVAR_SCHUR, SIZE_SCHUR, ATOAO, AOTOA) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NA,N,NZ,LW + INTEGER, INTENT(IN) :: SIZE_SCHUR, LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER, INTENT(IN) :: IRN(NZ), ICN(NZ) + INTEGER, INTENT(IN) :: ICNTL(40), SYM + INTEGER, INTENT(INOUT) :: IFLAG + INTEGER, INTENT(OUT) :: IERROR,NRORM,NIORM,IWFR + INTEGER, INTENT(OUT) :: AOTOA(N) + INTEGER, INTENT(OUT) :: ATOAO(NA) + INTEGER, INTENT(OUT) :: LEN(N), IPE(N+1) + INTEGER, INTENT(OUT) :: symmetry, + & MedDens, NBQD, AvgDens + INTEGER, INTENT(OUT) :: FLAG(N), IW(LW), IQ(N) + INTEGER MP, MPG + INTEGER I,K,J,N1,LAST,NDUP,K1,K2,L + INTEGER NBERR, THRESH, IAO + INTEGER NZOFFA, NDIAGA + REAL RSYM + INTRINSIC nint + ATOAO(1:NA) = 0 + DO I = 1, SIZE_SCHUR + ATOAO(LISTVAR_SCHUR(I)) = -1 + ENDDO + IAO = 0 + DO I= 1, NA + IF (ATOAO(I).LT.0) CYCLE + IAO = IAO +1 + ATOAO(I) = IAO + AOTOA(IAO) = I + ENDDO + MP = ICNTL(2) + MPG= ICNTL(3) + NIORM = 3*N + NDIAGA = 0 + IERROR = 0 + IPE(1:N+1) = 0 + DO K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.NA).OR.(J.GT.NA).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + IERROR = IERROR + 1 + ELSE + I = ATOAO(I) + J = ATOAO(J) + IF ((I.LT.0).OR.(J.LT.0)) CYCLE + IF (I.NE.J) THEN + IPE(I) = IPE(I) + 1 + IPE(J) = IPE(J) + 1 + NIORM = NIORM + 1 + ELSE + NDIAGA = NDIAGA + 1 + ENDIF + ENDIF + ENDDO + NZOFFA = NIORM - 3*N + IF (IERROR.GE.1) THEN + NBERR = 0 + IF (mod(IFLAG,2).EQ.0) IFLAG = IFLAG+1 + IF ((MP.GT.0).AND.(ICNTL(4).GE.2)) THEN + WRITE (MP,99999) + DO 70 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.NA).OR.(J.GT.NA).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + NBERR = NBERR + 1 + IF (NBERR.LE.10) THEN + IF (mod(K,10).GT.3 .OR. mod(K,10).EQ.0 .OR. + & (10.LE.K .AND. K.LE.20)) THEN + WRITE (MP,'(I8,A,I8,A,I8,A)') + & K,'th entry (in row',I,' and column',J,') ignored' + ELSE + IF (mod(K,10).EQ.1) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'st entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.2) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'nd entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.3) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'rd entry (in row',I,' and column',J,') ignored' + ENDIF + ELSE + GO TO 100 + ENDIF + ENDIF + 70 CONTINUE + ENDIF + ENDIF + 100 NRORM = NIORM - 2*N + IQ(1) = 1 + N1 = N - 1 + IF (N1.GT.0) THEN + DO 110 I=1,N1 + IQ(I+1) = IPE(I) + IQ(I) + 110 CONTINUE + ENDIF + LAST = max(IPE(N)+IQ(N)-1,IQ(N)) + FLAG(1:N) = 0 + IPE(1:N) = IQ(1:N) + IW(1:LAST) = 0 + IWFR = LAST + 1 + DO 200 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.NA).OR.(J.GT.NA).OR.(I.LT.1) + & .OR.(J.LT.1)) CYCLE + I = ATOAO(I) + J = ATOAO(J) + IF ((I.LT.0).OR.(J.LT.0)) CYCLE + IF (I.NE.J) THEN + IF (I.LT.J) THEN + IW(IQ(I)) = -J + IQ(I) = IQ(I) + 1 + ELSE + IW(IQ(J)) = -I + IQ(J) = IQ(J) + 1 + ENDIF + ENDIF + 200 CONTINUE + NDUP = 0 + DO 260 I=1,N + K1 = IPE(I) + K2 = IQ(I) -1 + IF (K1.GT.K2) THEN + LEN(I) = 0 + IQ(I) = 0 + ELSE + DO 240 K=K1,K2 + J = -IW(K) + IF (J.LE.0) GO TO 250 + L = IQ(J) + IQ(J) = L + 1 + IF (FLAG(J).EQ.I) THEN + NDUP = NDUP + 1 + IW(L) = 0 + IW(K) = 0 + ELSE + IW(L) = I + IW(K) = J + FLAG(J) = I + ENDIF + 240 CONTINUE + 250 IQ(I) = IQ(I) - IPE(I) + IF (NDUP.EQ.0) LEN(I) = IQ(I) + ENDIF + 260 CONTINUE + IF (NDUP.NE.0) THEN + IWFR = 1 + DO 280 I=1,N + IF (IQ(I).EQ.0) THEN + LEN(I) = 0 + IPE(I) = IWFR + GOTO 280 + ENDIF + K1 = IPE(I) + K2 = K1 + IQ(I) - 1 + L = IWFR + IPE(I) = IWFR + DO 270 K=K1,K2 + IF (IW(K).NE.0) THEN + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + ENDIF + 270 CONTINUE + LEN(I) = IWFR - L + 280 CONTINUE + ENDIF + IPE(N+1) = IPE(N) + LEN(N) + IWFR = IPE(N+1) + IF (SYM.EQ.0) THEN + RSYM = real(NDIAGA+2*NZOFFA - (IWFR-1))/ + & real(NZOFFA+NDIAGA) + symmetry = nint (100.0E0*RSYM) + IF (MPG .GT. 0) + & write(MPG,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + ELSE + symmetry = 100 + ENDIF + AvgDens = nint(real(IWFR-1)/real(N)) + THRESH = AvgDens*50 - AvgDens/10 + 1 + NBQD = 0 + IF (N.GT.2) THEN + IQ(1:N) = 0 + DO I= 1, N + K = max(LEN(I),1) + IQ(K) = IQ(K) + 1 + IF (K.GT.THRESH) NBQD = NBQD+1 + ENDDO + K = 0 + MedDens = 0 + DO WHILE (K .LT. (N/2)) + MedDens = MedDens + 1 + K = K+IQ(MedDens) + ENDDO + ELSE + MedDens = AvgDens + ENDIF + IF (MPG .GT. 0) + & write(MPG,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + RETURN +99999 FORMAT (/'*** Warning message from analysis routine ***') + END SUBROUTINE CMUMPS_623 + SUBROUTINE CMUMPS_549(N,PE,INVPERM,NFILS,WORK) + IMPLICIT NONE + INTEGER N + INTEGER PE(N),INVPERM(N),NFILS(N),WORK(N) + INTEGER I,FATHER,STKLEN,STKPOS,PERMPOS,CURVAR + NFILS = 0 + DO I=1,N + FATHER = -PE(I) + IF(FATHER .NE. 0) NFILS(FATHER) = NFILS(FATHER) + 1 + ENDDO + STKLEN = 0 + PERMPOS = 1 + DO I=1,N + IF(NFILS(I) .EQ. 0) THEN + STKLEN = STKLEN + 1 + WORK(STKLEN) = I + INVPERM(I) = PERMPOS + PERMPOS = PERMPOS + 1 + ENDIF + ENDDO + DO STKPOS = 1,STKLEN + CURVAR = WORK(STKPOS) + FATHER = -PE(CURVAR) + DO + IF(FATHER .EQ. 0) EXIT + IF(NFILS(FATHER) .EQ. 1) THEN + INVPERM(FATHER) = PERMPOS + FATHER = -PE(FATHER) + PERMPOS = PERMPOS + 1 + ELSE + NFILS(FATHER) = NFILS(FATHER) - 1 + EXIT + ENDIF + ENDDO + ENDDO + RETURN + END SUBROUTINE CMUMPS_549 + SUBROUTINE CMUMPS_548(N,PE,NV,WORK) + IMPLICIT NONE + INTEGER N + INTEGER PE(N),NV(N),WORK(N) + INTEGER I,FATHER,LEN,NEWSON,NEWFATHER + DO I=1,N + IF(NV(I) .GT. 0) CYCLE + LEN = 1 + WORK(LEN) = I + FATHER = -PE(I) + DO + IF(NV(FATHER) .GT. 0) THEN + NEWSON = FATHER + EXIT + ENDIF + LEN = LEN + 1 + WORK(LEN) = FATHER + NV(FATHER) = 1 + FATHER = -PE(FATHER) + ENDDO + NEWFATHER = -PE(FATHER) + PE(WORK(LEN)) = -NEWFATHER + PE(NEWSON) = -WORK(1) + ENDDO + END SUBROUTINE CMUMPS_548 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part8.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part8.F new file mode 100644 index 000000000..24043ec13 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_part8.F @@ -0,0 +1,7522 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE CMUMPS_301( id) + USE CMUMPS_STRUC_DEF + USE MUMPS_SOL_ES + USE CMUMPS_COMM_BUFFER + USE CMUMPS_OOC + USE TOOLS_COMMON + IMPLICIT NONE + INTERFACE + SUBROUTINE CMUMPS_710( id, NB_INT,NB_CMPLX ) + USE CMUMPS_STRUC_DEF + TYPE (CMUMPS_STRUC) :: id + INTEGER(8) :: NB_INT,NB_CMPLX + END SUBROUTINE CMUMPS_710 + SUBROUTINE CMUMPS_758 + &(idRHS, idINFO, idN, idNRHS, idLRHS) + COMPLEX, DIMENSION(:), POINTER :: idRHS + INTEGER, intent(in) :: idN, idNRHS, idLRHS + INTEGER, intent(inout) :: idINFO(:) + END SUBROUTINE CMUMPS_758 + END INTERFACE + INCLUDE 'mpif.h' + INCLUDE 'mumps_headers.h' +#if defined(V_T) + INCLUDE 'VT.inc' +#endif + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER MASTER, IERR + PARAMETER( MASTER = 0 ) + TYPE (CMUMPS_STRUC), TARGET :: id + INTEGER MP,LP, MPG + LOGICAL PROK, PROKG + INTEGER MTYPE, ICNTL21 + LOGICAL LSCAL, ERANAL, GIVSOL + INTEGER ICNTL10, ICNTL11 + INTEGER I,K,JPERM, J, II, IZ2 + INTEGER IZ, NZ_THIS_BLOCK + INTEGER LIW + INTEGER(8) :: LA, LA_PASSED + INTEGER LIW_PASSED + INTEGER LWCB_MIN, LWCB, LWCB_SOL_C + INTEGER(8) :: TMP_LWCB8 + INTEGER CMUMPS_LBUF, CMUMPS_LBUF_INT + INTEGER MSG_MAX_BYTES_SOLVE, MSG_MAX_BYTES_GTHRSOL + INTEGER IBEG_ROOT_DEF, IEND_ROOT_DEF, + & IBEG_GLOB_DEF, IEND_GLOB_DEF, + & IROOT_DEF_RHS_COL1 + INTEGER NITREF, NOITER, SOLVET, KASE, JOBIREF + COMPLEX RSOL(1) + LOGICAL INTERLEAVE_PAR, DO_PERMUTE_RHS + INTEGER :: NRHS_NONEMPTY + INTEGER :: STRAT_PERMAM1 + INTEGER :: K220(0:id%NSLAVES) + LOGICAL :: DO_NULL_PIV + INTEGER, DIMENSION(:), POINTER :: IRHS_PTR_COPY + INTEGER, DIMENSION(:), POINTER :: IRHS_SPARSE_COPY + COMPLEX, DIMENSION(:), POINTER :: RHS_SPARSE_COPY + LOGICAL IRHS_SPARSE_COPY_ALLOCATED, IRHS_PTR_COPY_ALLOCATED, + & RHS_SPARSE_COPY_ALLOCATED + INTEGER :: NBCOL, COLSIZE, JBEG_RHS, JEND_RHS, JBEG_NEW, + & NBCOL_INBLOC, IPOS, NBT + INTEGER :: PERM_PIV_LIST(max(id%KEEP(112),1)) + INTEGER :: MAP_PIVNUL_LIST(max(id%KEEP(112),1)) + INTEGER, DIMENSION(:), ALLOCATABLE :: PERM_RHS + COMPLEX ONE + COMPLEX ZERO + PARAMETER( ONE = (1.0E0,0.0E0) ) + PARAMETER( ZERO = (0.0E0,0.0E0) ) + REAL RZERO, RONE + PARAMETER( RZERO = 0.0E0, RONE = 1.0E0 ) + COMPLEX, DIMENSION(:), POINTER :: RHS_MUMPS + COMPLEX, DIMENSION(:), POINTER :: WORK_WCB + COMPLEX, DIMENSION(:), POINTER :: PTR_RHS_ROOT + INTEGER :: LPTR_RHS_ROOT + COMPLEX, ALLOCATABLE :: SAVERHS(:), C_RW1(:), + & C_RW2(:), + & SRW3(:), C_Y(:), + & C_W(:) + COMPLEX, ALLOCATABLE :: CWORK(:) + REAL, ALLOCATABLE :: R_RW1(:), R_Y(:), D(:) + REAL, ALLOCATABLE :: R_W(:) + REAL, ALLOCATABLE, DIMENSION(:) :: R_LOCWK54 + COMPLEX, ALLOCATABLE, DIMENSION(:) :: C_LOCWK54 + INTEGER, DIMENSION(:), ALLOCATABLE :: UNS_PERM_INV, + & POSINRHSCOMP_N + INTEGER LIWK_SOLVE, LIWCB + INTEGER, ALLOCATABLE :: IW1(:), IWK_SOLVE(:), IWCB(:) + INTEGER(8) :: MAXS + REAL, DIMENSION(:), POINTER :: CNTL + INTEGER, DIMENSION (:), POINTER :: KEEP,ICNTL,INFO + INTEGER(8), DIMENSION (:), POINTER :: KEEP8 + INTEGER, DIMENSION (:), POINTER :: IS + REAL, DIMENSION(:),POINTER:: RINFOG + type scaling_data_t + SEQUENCE + REAL, dimension(:), pointer :: SCALING + REAL, dimension(:), pointer :: SCALING_LOC + end type scaling_data_t + type (scaling_data_t) :: scaling_data + REAL, DIMENSION(:), POINTER :: PT_SCALING + REAL, TARGET :: Dummy_SCAL(1) + REAL ARRET + COMPLEX C_DUMMY(1) + REAL R_DUMMY(1) + INTEGER IDUMMY(1), JDUMMY(1), KDUMMY(1), LDUMMY(1), MDUMMY(1) + INTEGER, TARGET :: IDUMMY_TARGET(1) + COMPLEX, TARGET :: CDUMMY_TARGET(1) + INTEGER JJ, WHAT + INTEGER allocok + INTEGER NBRHS, NBRHS_EFF, BEG_RHS, NB_RHSSKIPPED, + & IBEG, LD_RHS, KDEC, + & MASTER_ROOT, MASTER_ROOT_IN_COMM + INTEGER IPT_RHS_ROOT, SIZE_ROOT, LD_REDRHS + INTEGER IBEG_REDRHS, IBEG_RHSCOMP, LD_RHSCOMP, LENRHSCOMP + INTEGER NB_K133, IRANK, TSIZE + INTEGER KMAX_246_247 + LOGICAL WORKSPACE_MINIMAL_PREFERRED, WK_USER_PROVIDED + INTEGER(8) NB_BYTES + INTEGER(8) NB_BYTES_MAX + INTEGER(8) NB_BYTES_EXTRA + INTEGER(8) NB_INT, NB_CMPLX, K34_8, K35_8, NB_BYTES_ON_ENTRY + INTEGER(8) K16_8, ITMP8 +#if defined(V_T) + INTEGER soln_drive_class, glob_comm_ini, perm_scal_ini, soln_dist, + & soln_assem, perm_scal_post +#endif + LOGICAL I_AM_SLAVE, BUILD_POSINRHSCOMP + LOGICAL WORK_WCB_ALLOCATED, IS_INIT_OOC_DONE + LOGICAL STOP_AT_NEXT_EMPTY_COL + INTEGER MTYPE_LOC + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 +#if defined(V_T) + CALL VTCLASSDEF( 'Soln driver',soln_drive_class,IERR) + CALL VTFUNCDEF( 'glob_comm_ini',soln_drive_class, + & glob_comm_ini,IERR) + CALL VTFUNCDEF( 'perm_scal_ini',soln_drive_class, + & perm_scal_ini,IERR) + CALL VTFUNCDEF( 'soln_dist',soln_drive_class,soln_dist,IERR) + CALL VTFUNCDEF( 'soln_assem',soln_drive_class,soln_assem,IERR) + CALL VTFUNCDEF( 'perm_scal_post',soln_drive_class, + & perm_scal_post,IERR) +#endif + IRHS_PTR_COPY => IDUMMY_TARGET + IRHS_PTR_COPY_ALLOCATED = .FALSE. + IRHS_SPARSE_COPY => IDUMMY_TARGET + IRHS_SPARSE_COPY_ALLOCATED=.FALSE. + RHS_SPARSE_COPY => CDUMMY_TARGET + RHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(RHS_MUMPS) + NULLIFY(WORK_WCB) + IS_INIT_OOC_DONE = .FALSE. + WK_USER_PROVIDED = .FALSE. + WORK_WCB_ALLOCATED = .FALSE. + CNTL =>id%CNTL + KEEP =>id%KEEP + KEEP8=>id%KEEP8 + IS =>id%IS + ICNTL=>id%ICNTL + INFO =>id%INFO + RINFOG =>id%RINFOG + MP = ICNTL( 2 ) + MPG = ICNTL( 3 ) + LP = id%ICNTL( 1 ) + PROK = (MP.GT.0) + PROKG = (MPG.GT.0 .and. id%MYID.eq.MASTER) + IF ( PROK ) WRITE(MP,100) + IF ( PROKG ) WRITE(MPG,100) + NB_BYTES = 0_8 + NB_BYTES_MAX = 0_8 + NB_BYTES_EXTRA = 0_8 + K34_8 = int(KEEP(34), 8) + K35_8 = int(KEEP(35), 8) + K16_8 = int(KEEP(16), 8) + NB_RHSSKIPPED = 0 + LSCAL = .FALSE. + WORK_WCB_ALLOCATED = .FALSE. + ICNTL21 = -99998 + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & KEEP(46) .eq. 1 ) ) + CALL CMUMPS_710 (id, NB_INT,NB_CMPLX ) + NB_BYTES = NB_BYTES + NB_INT * K34_8 + NB_CMPLX * K35_8 + NB_BYTES_ON_ENTRY = NB_BYTES + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID .EQ. MASTER) THEN + CALL CMUMPS_807(id) + id%KEEP(111) = id%ICNTL(25) + id%KEEP(248) = id%ICNTL(20) + ICNTL21 = id%ICNTL(21) + IF (ICNTL21 .ne.0.and.ICNTL21.ne.1) ICNTL21=0 + IF ( id%ICNTL(30) .NE.0 ) THEN + id%KEEP(237) = 1 + ELSE + id%KEEP(237) = 0 + ENDIF + IF (id%KEEP(248) .eq.0.and. id%KEEP(237).ne.0) THEN + id%KEEP(248)=1 + ENDIF + IF (id%KEEP(248) .ne.0.and.id%KEEP(248).ne.1) id%KEEP(248)=0 + IF ((id%KEEP(221).EQ.2 ).AND.(id%KEEP(248).NE.0) ) THEN + id%KEEP(248) = 0 + ENDIF + IF ((id%KEEP(221).EQ.2 ).AND.(id%KEEP(235).NE.0) ) THEN + id%KEEP(235) = 0 + ENDIF + IF ( (id%KEEP(248).EQ.0).AND.(id%KEEP(111).EQ.0) ) THEN + id%KEEP(235) = 0 + ENDIF + MTYPE = ICNTL( 9 ) + IF (id%KEEP(237).NE.0) MTYPE = 1 + ENDIF + CALL MPI_BCAST(MTYPE,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST( id%KEEP(111), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( id%KEEP(248), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( ICNTL21, 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%KEEP(235), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( id%KEEP(221), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( id%NRHS,1, MPI_INTEGER, MASTER, id%COMM,IERR) + CALL MPI_BCAST( id%KEEP(237), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + IF ( id%MYID .EQ. MASTER ) THEN + IF (KEEP(201) .EQ. -1) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Solve impossible because factors not kept' + id%INFO(1)=-44 + id%INFO(2)=KEEP(251) + GOTO 333 + ELSE IF (KEEP(221).EQ.0 .AND. KEEP(251) .EQ. 2 + & .AND. KEEP(252).EQ.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Solve impossible because factors not kept' + id%INFO(1)=-44 + id%INFO(2)=KEEP(251) + GOTO 333 + ENDIF + IF (KEEP(252).NE.0 .AND. id%NRHS .NE. id%KEEP(253)) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: id%NRHS not allowed to change when ICNTL(32)=1' + id%INFO(1)=-42 + id%INFO(2)=id%KEEP(253) + GOTO 333 + ENDIF + IF (KEEP(252).NE.0 .AND. ICNTL(9).NE.1) THEN + INFO(1) = -43 + INFO(2) = 9 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Transpose system (ICNTL(9).NE.0) not ', + & ' compatible with forward performed during', + & ' factorization (ICNTL(32)=1)' + GOTO 333 + ENDIF + IF (KEEP(248) .NE. 0.AND.KEEP(252).NE.0) THEN + INFO(1) = -43 + IF (KEEP(237).NE.0) THEN + INFO(2) = 30 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ELSE + INFO(2) = 20 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: sparse RHS incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ENDIF + GOTO 333 + ENDIF + IF (KEEP(237) .NE. 0 .AND. ICNTL21.NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality is incompatible', + & ' with distributed solution.' + INFO(1)=-48 + INFO(2)=21 + GOTO 333 + ENDIF + IF (KEEP(237) .NE. 0 .AND. KEEP(60) .NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality is incompatible', + & ' with Schur.' + INFO(1)=-48 + INFO(2)=19 + GOTO 333 + ENDIF + IF (KEEP(237) .NE. 0 .AND. KEEP(111) .NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality is incompatible', + & ' with null space.' + INFO(1)=-48 + INFO(2)=25 + GOTO 333 + ENDIF + IF (id%NRHS .LE. 0) THEN + id%INFO(1)=-45 + id%INFO(2)=id%NRHS + GOTO 333 + ENDIF + IF ( (id%KEEP(237).EQ.0) ) THEN + IF ((id%KEEP(248) == 0 .AND.KEEP(221).NE.2) + & .OR. ICNTL21==0) THEN + CALL CMUMPS_758 + & (id%RHS,id%INFO,id%N,id%NRHS,id%LRHS) + IF (id%INFO(1) .LT. 0) GOTO 333 + ENDIF + ELSE + IF (id%NRHS .NE. id%N) THEN + id%INFO(1)=-47 + id%INFO(2)=id%NRHS + GOTO 333 + ENDIF + ENDIF + IF (id%KEEP(248) == 1) THEN + IF ((id%NZ_RHS.LE.0).AND.(KEEP(237).NE.0)) THEN + id%INFO(1)=-46 + id%INFO(2)=id%NZ_RHS + GOTO 333 + ENDIF + IF (( id%NZ_RHS .LE.0 ).AND.(KEEP(221).EQ.1)) THEN + id%INFO(1)=-46 + id%INFO(2)=id%NZ_RHS + GOTO 333 + ENDIF + IF ( .not. associated(id%RHS_SPARSE) )THEN + id%INFO(1)=-22 + id%INFO(2)=10 + GOTO 333 + ENDIF + IF ( .not. associated(id%IRHS_SPARSE) )THEN + id%INFO(1)=-22 + id%INFO(2)=11 + GOTO 333 + ENDIF + IF ( .not. associated(id%IRHS_PTR) )THEN + id%INFO(1)=-22 + id%INFO(2)=12 + GOTO 333 + ENDIF + IF (size(id%IRHS_PTR) < id%NRHS + 1) THEN + id%INFO(1)=-22 + id%INFO(2)=12 + GOTO 333 + END IF + IF (id%IRHS_PTR(id%NRHS + 1).ne.id%NZ_RHS+1) THEN + id%INFO(1)=-27 + id%INFO(2)=id%IRHS_PTR(id%NRHS+1) + GOTO 333 + END IF + IF (dble(id%N)*dble(id%NRHS).LT.dble(id%NZ_RHS)) THEN + IF (PROKG) THEN + write(MPG,*)id%MYID, + & " Incompatible values for sparse RHS ", + & " id%NZ_RHS,id%N,id%NRHS =", + & id%NZ_RHS,id%N,id%NRHS + ENDIF + id%INFO(1)=-22 + id%INFO(2)=11 + GOTO 333 + END IF + IF (id%IRHS_PTR(1).ne.1) THEN + id%INFO(1)=-28 + id%INFO(2)=id%IRHS_PTR(1) + GOTO 333 + END IF + IF (size(id%IRHS_SPARSE) < id%NZ_RHS) THEN + id%INFO(1)=-22 + id%INFO(2)=11 + GOTO 333 + END IF + IF (size(id%RHS_SPARSE) < id%NZ_RHS) THEN + id%INFO(1)=-22 + id%INFO(2)=10 + GOTO 333 + END IF + ENDIF + CALL CMUMPS_634(ICNTL(1),KEEP(1),MPG,INFO(1)) + IF (INFO(1) .LT. 0) GOTO 333 + IF (KEEP(111).eq.-1.AND.id%NRHS.NE.KEEP(112)+KEEP(17))THEN + INFO(1)=-32 + INFO(2)=id%NRHS + GOTO 333 + ENDIF + IF (KEEP(111).gt.0 .AND. id%NRHS .NE. 1) THEN + INFO(1)=-32 + INFO(2)=id%NRHS + GOTO 333 + ENDIF + IF (KEEP(111) .NE. 0 .AND. id%KEEP(50) .EQ. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: null space not available for unsymmetric matrices' + INFO(1) = -37 + INFO(2) = 0 + GOTO 333 + ENDIF + IF (KEEP(248) .NE.0.AND.KEEP(111).NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: ICNTL(20) and ICNTL(30) functionalities ', + & ' incompatible with null space' + INFO(1) = -37 + IF (KEEP(237).NE.0) THEN + INFO(2) = 30 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: ICNTL(30) functionality ', + & ' incompatible with null space' + ELSE + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: ICNTL(20) functionality ', + & ' incompatible with null space' + INFO(2) = 20 + ENDIF + GOTO 333 + ENDIF + IF (( KEEP(111) .LT. -1 ) .OR. + & (KEEP(111).GT.KEEP(112)+KEEP(17)) .OR. + & (KEEP(111) .EQ.-1 .AND. KEEP(112)+KEEP(17).EQ.0)) + & THEN + INFO(1)=-36 + INFO(2)=KEEP(111) + GOTO 333 + ENDIF + END IF + IF (ICNTL21==1) THEN + IF ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & id%KEEP(46) .eq. 1 ) ) THEN + IF ( id%LSOL_loc < id%KEEP(89) ) THEN + id%INFO(1)= -29 + id%INFO(2)= id%LSOL_loc + GOTO 333 + ENDIF + IF (id%KEEP(89) .NE. 0) THEN + IF ( .not. associated(id%ISOL_loc) )THEN + id%INFO(1)=-22 + id%INFO(2)=13 + GOTO 333 + ENDIF + IF ( .not. associated(id%SOL_loc) )THEN + id%INFO(1)=-22 + id%INFO(2)=14 + GOTO 333 + ENDIF + IF (size(id%ISOL_loc) < id%KEEP(89) ) THEN + id%INFO(1)=-22 + id%INFO(2)=13 + GOTO 333 + END IF + IF (size(id%SOL_loc) < + & (id%NRHS-1)*id%LSOL_loc+id%KEEP(89)) THEN + id%INFO(1)=-22 + id%INFO(2)=14 + GOTO 333 + END IF + ENDIF + ENDIF + ENDIF + IF (id%MYID .NE. MASTER) THEN + IF (id%KEEP(248) == 1) THEN + IF ( associated( id%RHS ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 7 + GOTO 333 + END IF + IF ( associated( id%RHS_SPARSE ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 10 + GOTO 333 + END IF + IF ( associated( id%IRHS_SPARSE ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 11 + GOTO 333 + END IF + IF ( associated( id%IRHS_PTR ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 12 + GOTO 333 + END IF + END IF + ENDIF + IF (id%MYID.EQ.MASTER) THEN + CALL CMUMPS_769(id) + END IF + IF (id%INFO(1) .LT. 0) GOTO 333 + 333 CONTINUE + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) GO TO 90 + IF ((id%KEEP(248).EQ.1).AND.(id%KEEP(237).EQ.0)) THEN + CALL MPI_BCAST(id%NZ_RHS,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + IF (id%NZ_RHS.EQ.0) THEN + IF ((ICNTL21.EQ.1).AND.(I_AM_SLAVE)) THEN + LIW_PASSED=max(1,KEEP(32)) + IF (KEEP(89) .GT. 0) THEN + CALL CMUMPS_535( MTYPE, id%ISOL_loc(1), + & id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%IS(1), LIW_PASSED,id%MYID_NODES, + & id%N, id%STEP(1), id%PROCNODE_STEPS(1), + & id%NSLAVES, scaling_data, LSCAL ) + DO J=1, id%NRHS + DO I=1, KEEP(89) + id%SOL_loc((J-1)*id%LSOL_loc + I) =ZERO + ENDDO + ENDDO + ENDIF + ENDIF + IF (ICNTL21.NE.1) THEN + IF (id%MYID.EQ.MASTER) THEN + DO J=1, id%NRHS + DO I=1, id%N + id%RHS((J-1)*id%LRHS + I) =ZERO + ENDDO + ENDDO + ENDIF + ENDIF + IF ( PROKG ) THEN + WRITE( MPG, 150 ) + & id%NRHS, ICNTL(27), ICNTL(9), ICNTL(10), ICNTL(11), + & ICNTL(20), ICNTL(21), ICNTL(30) + IF (KEEP(221).NE.0) THEN + WRITE (MPG, 152) KEEP(221) + ENDIF + IF (KEEP(252).GT.0) THEN + WRITE (MPG, 153) KEEP(252) + ENDIF + ENDIF + GOTO 90 + ENDIF + ENDIF + IF (id%MYID.EQ.MASTER) THEN + IF ((KEEP(111).NE.0)) THEN + KEEP(242) = 0 + ENDIF + ENDIF + INTERLEAVE_PAR =.FALSE. + DO_PERMUTE_RHS =.FALSE. + IF ((id%KEEP(235).NE.0).or.(id%KEEP(237).NE.0)) THEN + IF (id%KEEP(237).NE.0.AND. + & id%KEEP(248).EQ.0) THEN + IF (LP.GT.0) THEN + WRITE(LP,'(A,I4,I4)') + & ' Internal Error in solution driver (A-1) ', + & id%KEEP(237), id%KEEP(248) + ENDIF + CALL MUMPS_ABORT() + ENDIF + NBT = 0 + CALL MUMPS_733(id%Step2node, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%Step2node (Solve)', MEMCNT=NBT, ERRCODE=-13) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF (NBT.NE.0) THEN + DO I=1, id%N + IF (id%STEP(I).LE.0) CYCLE + id%Step2node(id%STEP(I)) = I + ENDDO + ENDIF + NB_BYTES = NB_BYTES + int(NBT,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + NB_BYTES_EXTRA = NB_BYTES_EXTRA + int(NBT,8) * K34_8 + ENDIF + IF ( I_AM_SLAVE ) + & CALL MUMPS_804(id%OOC_SIZE_OF_BLOCK, id%KEEP(201)) + DO_NULL_PIV = .TRUE. + NBCOL_INBLOC = -9998 + NZ_THIS_BLOCK= -9998 + JBEG_RHS = -9998 + IF (id%MYID.EQ.MASTER) THEN + IF( KEEP(111)==0 .AND. KEEP(248)==1 ) THEN + NRHS_NONEMPTY = 0 + DO I=1, id%NRHS + IF (id%IRHS_PTR(I).LT.id%IRHS_PTR(I+1)) + & NRHS_NONEMPTY = NRHS_NONEMPTY+1 + ENDDO + IF (NRHS_NONEMPTY.LE.0) THEN + IF (LP.GT.0) + & WRITE(LP,*) 'Internal error : NRHS_NONEMPTY=', + & NRHS_NONEMPTY + CALL MUMPS_ABORT() + ENDIF + ELSE + NRHS_NONEMPTY = id%NRHS + ENDIF + ENDIF + BUILD_POSINRHSCOMP = .TRUE. + IF (KEEP(221).EQ.2 .AND. KEEP(252).EQ.0) THEN + BUILD_POSINRHSCOMP = .FALSE. + ENDIF + SIZE_ROOT = -33333 + IF ( KEEP( 38 ) .ne. 0 ) THEN + MASTER_ROOT = MUMPS_275( + & id%PROCNODE_STEPS(id%STEP( KEEP(38))), + & id%NSLAVES ) + IF (id%MYID_NODES .eq. MASTER_ROOT) THEN + SIZE_ROOT = id%root%TOT_ROOT_SIZE + ELSE IF ((id%MYID.EQ.MASTER).AND.KEEP(60).NE.0) THEN + SIZE_ROOT=id%KEEP(116) + ENDIF + ELSE IF (KEEP( 20 ) .ne. 0 ) THEN + MASTER_ROOT = MUMPS_275( + & id%PROCNODE_STEPS(id%STEP(KEEP(20))), + & id%NSLAVES ) + IF (id%MYID_NODES .eq. MASTER_ROOT) THEN + SIZE_ROOT = id%IS( + & id%PTLUST_S(id%STEP(KEEP(20)))+KEEP(IXSZ) + 3) + ELSE IF ((id%MYID.EQ.MASTER).AND.KEEP(60).NE.0) THEN + SIZE_ROOT=id%KEEP(116) + ENDIF + ELSE + MASTER_ROOT = -44444 + END IF + IF (id%MYID .eq. MASTER) THEN + KEEP(84) = ICNTL(27) + IF (KEEP(252).NE.0) THEN + NBRHS = KEEP(253) + ELSE + IF (KEEP(201) .EQ. 0 .OR. KEEP(84) .GT. 0) THEN + NBRHS = abs(KEEP(84)) + ELSE + NBRHS = -2*KEEP(84) + END IF + IF (NBRHS .GT. NRHS_NONEMPTY ) NBRHS = NRHS_NONEMPTY + ENDIF + ENDIF +#if defined(V_T) + CALL VTBEGIN(glob_comm_ini,IERR) +#endif + CALL MPI_BCAST(NRHS_NONEMPTY,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(NBRHS,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + IF (KEEP(201).GT.0) THEN + IF (I_AM_SLAVE) THEN + IF (KEEP(201).EQ.1 + & .AND.KEEP(50).EQ.0 + & .AND.KEEP(251).NE.2 + & ) THEN + OOC_NB_FILE_TYPE=2 + ELSE + OOC_NB_FILE_TYPE=1 + ENDIF + ENDIF + WORKSPACE_MINIMAL_PREFERRED = .FALSE. + IF (id%MYID .eq. MASTER) THEN + KEEP(107) = max(0,KEEP(107)) + IF ((KEEP(107).EQ.0).AND. + & (KEEP(204).EQ.0).AND.(KEEP(211).NE.1) ) THEN + WORKSPACE_MINIMAL_PREFERRED=.TRUE. + ENDIF + ENDIF + CALL MPI_BCAST( KEEP(107), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(204), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(208), 2, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( WORKSPACE_MINIMAL_PREFERRED, 1, + & MPI_LOGICAL, + & MASTER, id%COMM, IERR ) + ENDIF + IF ( I_AM_SLAVE ) THEN + NB_K133 = 3 + IF ( KEEP( 38 ) .NE. 0 .OR. KEEP( 20 ) .NE. 0 ) THEN + IF ( MASTER_ROOT .eq. id%MYID_NODES ) THEN + IF ( + & .NOT. associated(id%root%RHS_CNTR_MASTER_ROOT) + & ) THEN + NB_K133 = NB_K133 + 1 + ENDIF + END IF + ENDIF + LWCB_MIN = NB_K133*KEEP(133)*NBRHS + WK_USER_PROVIDED = (id%LWK_USER.NE.0) + IF (id%LWK_USER.EQ.0) THEN + ITMP8 = 0_8 + ELSE IF (id%LWK_USER.GT.0) THEN + ITMP8= int(id%LWK_USER,8) + ELSE + ITMP8 = -int(id%LWK_USER,8)* 1000000_8 + ENDIF + IF (KEEP(201).EQ.0) THEN + IF (ITMP8.NE.KEEP8(24)) THEN + INFO(1) = -41 + INFO(2) = id%LWK_USER + GOTO 99 + ENDIF + ELSE + KEEP8(24)=ITMP8 + ENDIF + MAXS = 0_8 + IF (WK_USER_PROVIDED) THEN + MAXS = KEEP8(24) + IF (MAXS.LT. KEEP8(20)) THEN + INFO(1)= -11 + ITMP8 = KEEP8(20)+1_8-MAXS + CALL MUMPS_731(ITMP8, INFO(2)) + ENDIF + IF (INFO(1) .GE. 0 ) id%S => id%WK_USER(1:KEEP8(24)) + ELSE IF (associated(id%S)) THEN + MAXS = KEEP8(23) + ELSE + IF (KEEP(201).EQ.0) THEN + WRITE(*,*) ' Working array S not allocated ', + & ' on entry to solve phase (in core) ' + CALL MUMPS_ABORT() + ELSE + IF ( KEEP(209).EQ.-1 .AND. WORKSPACE_MINIMAL_PREFERRED) + & THEN + MAXS = KEEP8(20) + 1_8 + ELSE IF ( KEEP(209) .GE.0 ) THEN + MAXS = max(int(KEEP(209),8), KEEP8(20) + 1_8) + ELSE + MAXS = id%KEEP8(14) + ENDIF + ALLOCATE (id%S(MAXS), stat = allocok) + KEEP8(23)=MAXS + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) ' Problem allocation of S at solve' + INFO(1) = -13 + CALL MUMPS_731(MAXS, INFO(2)) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + NB_BYTES = NB_BYTES + KEEP8(23) * K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + ENDIF + IF(KEEP(201).EQ.0)THEN + LA = KEEP8(31) + ELSE + LA = MAXS + IF(MAXS.GT.KEEP8(31)+KEEP8(20)*int(KEEP(107)+1,8))THEN + LA=KEEP8(31)+KEEP8(20)*int(KEEP(107)+1,8) + ENDIF + ENDIF + IF ( MAXS-LA .GT. int(LWCB_MIN,8) ) THEN + TMP_LWCB8 = min( MAXS - LA, int(huge(LWCB),8) ) + LWCB = int( TMP_LWCB8, kind(LWCB) ) + WORK_WCB => id%S(LA+1_8:LA+TMP_LWCB8) + WORK_WCB_ALLOCATED=.FALSE. + ELSE + LWCB = LWCB_MIN + ALLOCATE(WORK_WCB(LWCB_MIN), stat = allocok) + IF (allocok < 0 ) THEN + INFO(1)=-13 + INFO(2)=LWCB_MIN + ENDIF + WORK_WCB_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(size(WORK_WCB),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + ENDIF + 99 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) < 0) GOTO 90 + IF ( I_AM_SLAVE ) THEN + IF (KEEP(201).GT.0) THEN + CALL CMUMPS_590(LA) + CALL CMUMPS_586(id) + IS_INIT_OOC_DONE = .TRUE. + ENDIF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) < 0) GOTO 90 + IF (id%MYID .eq. MASTER) THEN + IF ( (KEEP(242).NE.0) .or. (KEEP(243).NE.0) ) THEN + IF ( (KEEP(237) .EQ.0) .and. (KEEP(111).EQ.0) ) THEN + KEEP(242) = 0 + KEEP(243) = 0 + ENDIF + ENDIF + IF ( PROKG ) THEN + WRITE( MPG, 150 ) + & id%NRHS, NBRHS, ICNTL(9), ICNTL(10), ICNTL(11), + & ICNTL(20), ICNTL(21), ICNTL(30) + IF (KEEP(111).NE.0) THEN + WRITE (MPG, 151) KEEP(111) + ENDIF + IF (KEEP(221).NE.0) THEN + WRITE (MPG, 152) KEEP(221) + ENDIF + IF (KEEP(252).GT.0) THEN + WRITE (MPG, 153) KEEP(252) + ENDIF + ENDIF + LSCAL = (((KEEP(52) .GT. 0) .AND. (KEEP(52) .LE. 8)) .OR. ( + & KEEP(52) .EQ. -1) .OR. KEEP(52) .EQ. -2) + ERANAL = ((ICNTL(11) .GT. 0) .OR. (ICNTL(10) .GT. 0)) + IF ( (KEEP(55).eq.0) .AND. KEEP(54).eq.0 .AND. + & .NOT.associated(id%A) ) THEN + ICNTL10 = 0 + ICNTL11 = 0 + ERANAL = .FALSE. + ELSE + ICNTL10 = ICNTL(10) + ICNTL11 = ICNTL(11) + ENDIF + IF ((KEEP(111).NE.0).OR.(KEEP(237).NE.0).OR. + & (KEEP(252).NE.0) ) THEN + IF (ICNTL10 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(10) treated as if set to 0 ' + ENDIF + IF (ICNTL11 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(11) treated as if set to 0 ' + ENDIF + ICNTL10 = 0 + ICNTL11 = 0 + ERANAL = .FALSE. + END IF + IF (KEEP(221).NE.0) THEN + IF (ICNTL10 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(10) treated as if set to 0 (reduced RHS))' + ENDIF + IF (ICNTL11 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(11) treated as if set to 0 (reduced RHS)' + ENDIF + ICNTL10 = 0 + ICNTL11 = 0 + ERANAL = .FALSE. + END IF + IF ((ERANAL .AND. NBRHS > 1) .OR. ICNTL(21) > 0) THEN + IF (ICNTL11 > 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(11) treated as if set to zero' + ICNTL11=0 + ENDIF + IF (ICNTL10 > 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(10) treated as if set to zero' + ICNTL10=0 + ENDIF + ERANAL = .FALSE. + ENDIF + IF (ERANAL) THEN + ALLOCATE(SAVERHS(id%N*NBRHS),stat = allocok) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) ' Problem in solve: error allocating SAVERHS' + INFO(1) = -13 + INFO(2) = id%N*NBRHS + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(size(SAVERHS),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + IF (KEEP(237).NE.0 .AND.KEEP(111).NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: KEEP(237) treated as if set to 0 (null space)' + KEEP(237)=0 + ENDIF + IF (KEEP(242).EQ.0) KEEP(243)=0 + END IF + CALL MPI_BCAST(ICNTL10,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(ICNTL11,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(ICNTL21,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(ERANAL,1,MPI_LOGICAL,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(LSCAL,1,MPI_LOGICAL,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(KEEP(111),1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(KEEP(242),1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(KEEP(243),1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + DO_PERMUTE_RHS = (KEEP(242).NE.0) + IF ( KEEP(242).NE.0) THEN + IF ((KEEP(237).EQ.0).AND.(KEEP(111).EQ.0)) THEN + IF (MP.GT.0) THEN + write(MP,*) ' Warning incompatible options ', + & ' permute RHS reset to false ' + ENDIF + DO_PERMUTE_RHS = .FALSE. + ENDIF + ENDIF + IF ( (id%NSLAVES.GT.1) .AND. (KEEP(243).NE.0) + & ) THEN + IF ((KEEP(237).NE.0).or.(KEEP(111).GT.0)) THEN + INTERLEAVE_PAR= .TRUE. + ELSE + IF (PROKG) THEN + write(MPG,*) ' Warning incompatible options ', + & ' interleave RHS reset to false ' + ENDIF + ENDIF + ENDIF +#if defined(check) + IF ( id%MYID_NODES .EQ. MASTER ) THEN + WRITE(*,*) " ES A-1 DO_Perm Interleave =" + WRITE(*,144) id%KEEP(235), id%KEEP(237), + & id%KEEP(242),id%KEEP(243) + ENDIF +#endif + MSG_MAX_BYTES_SOLVE = ( 4 + KEEP(133) ) * KEEP(34) + + & KEEP(133) * NBRHS * KEEP(35) + & + 16 * KEEP(34) + IF (KEEP(237).EQ.0) THEN + KMAX_246_247 = max(KEEP(246),KEEP(247)) + MSG_MAX_BYTES_GTHRSOL = ( ( 2 + KMAX_246_247 ) * KEEP(34) + + & KMAX_246_247 * NBRHS * KEEP(35) ) + ELSE + MSG_MAX_BYTES_GTHRSOL = ( 3 * KEEP(34) + KEEP(35) ) + ENDIF + id%LBUFR_BYTES = max(MSG_MAX_BYTES_SOLVE, MSG_MAX_BYTES_GTHRSOL) + TSIZE = int(min(100_8*int(MSG_MAX_BYTES_GTHRSOL,8), + & 10000000_8)) + id%LBUFR_BYTES = max(id%LBUFR_BYTES,TSIZE) + id%LBUFR = ( id%LBUFR_BYTES + KEEP(34) - 1 ) / KEEP(34) + IF ( associated (id%BUFR) ) THEN + NB_BYTES = NB_BYTES - int(size(id%BUFR),8)*K34_8 + DEALLOCATE(id%BUFR) + NULLIFY(id%BUFR) + ENDIF + ALLOCATE (id%BUFR(id%LBUFR),stat=allocok) + IF ( allocok .GT. 0 ) THEN + IF (LP.GT.0) + & WRITE(LP,*) id%MYID, + & ' Problem in solve: error allocating BUFR' + INFO(1) = -13 + INFO(2) = id%LBUFR + GOTO 111 + ENDIF + NB_BYTES = NB_BYTES + int(size(id%BUFR),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( I_AM_SLAVE ) THEN + CMUMPS_LBUF_INT = ( 20 + id%NSLAVES * id%NSLAVES * 4 ) + & * KEEP(34) + CALL CMUMPS_55( CMUMPS_LBUF_INT, IERR ) + IF ( IERR .NE. 0 ) THEN + INFO(1) = -13 + INFO(2) = CMUMPS_LBUF_INT + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) id%MYID, + & ':Error allocating small Send buffer:IERR=',IERR + END IF + GOTO 111 + END IF + CMUMPS_LBUF = (MSG_MAX_BYTES_SOLVE + 2*KEEP(34) )*id%NSLAVES + CMUMPS_LBUF = min(CMUMPS_LBUF, 100 000 000) + CMUMPS_LBUF = max(CMUMPS_LBUF, + & (MSG_MAX_BYTES_SOLVE+2*KEEP(34)) * min(id%NSLAVES,3)) + CMUMPS_LBUF = CMUMPS_LBUF + KEEP(34) + CALL CMUMPS_53( CMUMPS_LBUF, IERR ) + IF ( IERR .NE. 0 ) THEN + INFO(1) = -13 + INFO(2) = CMUMPS_LBUF/KEEP(34) + 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) id%MYID, + & ':Error allocating Send buffer:IERR=', IERR + END IF + GOTO 111 + END IF + ENDIF + IF ( + & ( id%MYID .NE. MASTER ) + & .or. + & ( I_AM_SLAVE .AND. id%MYID .EQ. MASTER .AND. + & ICNTL21 .NE.0 .AND. + & ( KEEP(248).ne.0 .OR. KEEP(221).EQ.2 + & .OR. KEEP(111).NE.0 ) + & ) + & .or. + & ( id%MYID .EQ. MASTER .AND. (KEEP(237).NE.0) ) + & ) THEN + ALLOCATE(RHS_MUMPS(id%N*NBRHS),stat=IERR) + NB_BYTES = NB_BYTES + int(size(RHS_MUMPS),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N*NBRHS + IF (LP > 0) + & WRITE(LP,*) 'ERROR while allocating RHS on a slave' + GOTO 111 + END IF + ELSE + RHS_MUMPS=>id%RHS + ENDIF + IF ( I_AM_SLAVE ) THEN + LD_RHSCOMP = max(KEEP(89),1) + IF (id%MYID.EQ.MASTER) THEN + LD_RHSCOMP = max(LD_RHSCOMP, KEEP(247)) + ENDIF + IF (KEEP(221).EQ.2 .AND. KEEP(252).EQ.0) THEN + IF (.NOT.associated(id%RHSCOMP)) THEN + INFO(1) = -35 + INFO(2) = 1 + GOTO 111 + ENDIF + IF (.NOT.associated(id%POSINRHSCOMP)) THEN + INFO(1) = -35 + INFO(2) = 2 + GOTO 111 + ENDIF + LENRHSCOMP = size(id%RHSCOMP) + LD_RHSCOMP = LENRHSCOMP/id%NRHS + ELSE IF (KEEP(221).EQ.1) THEN + IF (associated(id%RHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8 + DEALLOCATE(id%RHSCOMP) + ENDIF + LENRHSCOMP = LD_RHSCOMP*id%NRHS + ALLOCATE (id%RHSCOMP(LENRHSCOMP)) + NB_BYTES = NB_BYTES + int(size(id%RHSCOMP),8)*K35_8 + IF (associated(id%POSINRHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%POSINRHSCOMP),8)*K34_8 + DEALLOCATE(id%POSINRHSCOMP) + ENDIF + ALLOCATE (id%POSINRHSCOMP(KEEP(28)) ) + NB_BYTES = NB_BYTES + int(size(id%POSINRHSCOMP),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ELSE + LENRHSCOMP = LD_RHSCOMP*NBRHS + IF (associated(id%RHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8 + DEALLOCATE(id%RHSCOMP) + NULLIFY(id%RHSCOMP) + ENDIF + ALLOCATE (id%RHSCOMP(LENRHSCOMP)) + NB_BYTES = NB_BYTES + int(size(id%RHSCOMP),8)*K35_8 + IF (associated(id%POSINRHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%POSINRHSCOMP),8)*K34_8 + DEALLOCATE(id%POSINRHSCOMP) + ENDIF + ALLOCATE (id%POSINRHSCOMP(KEEP(28)) ) + NB_BYTES = NB_BYTES + int(size(id%POSINRHSCOMP),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + LIWK_SOLVE = 4 * KEEP(28) + 1 + IF (KEEP(201).EQ.1) THEN + LIWK_SOLVE = LIWK_SOLVE + KEEP(228) + 1 + ELSE + LIWK_SOLVE = LIWK_SOLVE + 1 + ENDIF + ALLOCATE ( IWK_SOLVE( LIWK_SOLVE), stat = allocok ) + IF (allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=LIWK_SOLVE + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(LIWK_SOLVE,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + LIWCB = 20*NB_K133*2 + KEEP(133) + ALLOCATE ( IWCB( LIWCB), stat = allocok ) + IF (allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=LIWCB + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(LIWCB,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + LIW = KEEP(32) + ALLOCATE(SRW3(KEEP(133)), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=KEEP(133) + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(size(SRW3),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( (KEEP(111).NE.0) .OR. (KEEP(248).NE.0) ) THEN + ALLOCATE(POSINRHSCOMP_N(id%N), stat=allocok) + IF ( allocok .GT. 0 ) THEN + IF (LP.GT.0) WRITE(LP,*) + & ' ERROR in CMUMPS_301: allocating POSINRHSCOMP_N' + INFO(1) = -13 + INFO(2) = id%N + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(size(POSINRHSCOMP_N),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + END IF + ELSE + LIW=0 + END IF + IF (allocated(UNS_PERM_INV)) DEALLOCATE(UNS_PERM_INV) + IF ( ( id%MYID .eq. MASTER.AND.(KEEP(23).GT.0) .AND. + & (MTYPE .NE. 1).AND.(KEEP(248).NE.0) + & ) + & .OR. ( ( KEEP(237).NE.0 ) .AND. (KEEP(23).NE.0) ) + & ) THEN + ALLOCATE(UNS_PERM_INV(id%N),stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 111 + endif + NB_BYTES = NB_BYTES + int(id%N,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID.EQ.MASTER) THEN + DO I = 1, id%N + UNS_PERM_INV(id%UNS_PERM(I))=I + ENDDO + ENDIF + ELSE + ALLOCATE(UNS_PERM_INV(1), stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=1 + GOTO 111 + endif + NB_BYTES = NB_BYTES + 1_8*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + 111 CONTINUE +#if defined(V_T) + CALL VTEND(glob_comm_ini,IERR) +#endif + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF ( ( KEEP(237).NE.0 ) .AND. (KEEP(23).NE.0) ) THEN + CALL MPI_BCAST(UNS_PERM_INV,id%N,MPI_INTEGER,MASTER, + & id%COMM,IERR) + ENDIF + IF ( ICNTL21==1 ) THEN + IF (LSCAL) THEN + IF (id%MYID.NE.MASTER) THEN + IF (MTYPE == 1) THEN + ALLOCATE(id%COLSCA(id%N),stat=allocok) + ELSE + ALLOCATE(id%ROWSCA(id%N),stat=allocok) + ENDIF + IF (allocok > 0) THEN + IF (LP > 0) THEN + WRITE(LP,*) 'Error allocating temporary scaling array' + ENDIF + INFO(1)=-13 + INFO(2)=id%N + GOTO 40 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + IF (MTYPE == 1) THEN + CALL MPI_BCAST(id%COLSCA(1),id%N, + & MPI_REAL,MASTER, + & id%COMM,IERR) + scaling_data%SCALING=>id%COLSCA + ELSE + CALL MPI_BCAST(id%ROWSCA(1),id%N, + & MPI_REAL,MASTER, + & id%COMM,IERR) + scaling_data%SCALING=>id%ROWSCA + ENDIF + IF (I_AM_SLAVE) THEN + ALLOCATE(scaling_data%SCALING_LOC(id%KEEP(89)), + & stat=allocok) + IF (allocok > 0) THEN + IF (LP > 0) THEN + WRITE(LP,*) 'Error allocating local scaling array' + ENDIF + INFO(1)=-13 + INFO(2)=id%KEEP(89) + GOTO 40 + ENDIF + NB_BYTES = NB_BYTES + int(id%KEEP(89),8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + LIW_PASSED=max(1,LIW) + IF (KEEP(89) .GT. 0) THEN + CALL CMUMPS_535( MTYPE, id%ISOL_loc(1), + & id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%IS(1), LIW_PASSED,id%MYID_NODES, + & id%N, id%STEP(1), id%PROCNODE_STEPS(1), + & id%NSLAVES, scaling_data, LSCAL ) + ENDIF + IF (id%MYID.NE.MASTER .AND. LSCAL) THEN + IF (MTYPE == 1) THEN + DEALLOCATE(id%COLSCA) + NULLIFY(id%COLSCA) + ELSE + DEALLOCATE(id%ROWSCA) + NULLIFY(id%ROWSCA) + ENDIF + NB_BYTES = NB_BYTES - int(id%N,8)*K16_8 + ENDIF + ENDIF + IF (KEEP(23) .NE. 0 .AND. MTYPE==1) THEN + IF (id%MYID.NE.MASTER) THEN + ALLOCATE(id%UNS_PERM(id%N),stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 40 + ENDIF + ENDIF + ENDIF + 40 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF (KEEP(23) .NE. 0 .AND. MTYPE==1) THEN + CALL MPI_BCAST(id%UNS_PERM(1),id%N,MPI_INTEGER,MASTER, + & id%COMM,IERR) + IF (I_AM_SLAVE) THEN + DO I=1, KEEP(89) + id%ISOL_loc(I) = id%UNS_PERM(id%ISOL_loc(I)) + ENDDO + ENDIF + IF (id%MYID.NE.MASTER) THEN + DEALLOCATE(id%UNS_PERM) + NULLIFY(id%UNS_PERM) + ENDIF + ENDIF + ENDIF + IF ( ( KEEP(221) .EQ. 1 ) .OR. + & ( KEEP(221) .EQ. 2 ) + & ) THEN + IF (KEEP(46).EQ.1) THEN + MASTER_ROOT_IN_COMM=MASTER_ROOT + ELSE + MASTER_ROOT_IN_COMM =MASTER_ROOT+1 + ENDIF + IF ( id%MYID .EQ. MASTER ) THEN + IF (id%NRHS.EQ.1) THEN + LD_REDRHS = id%KEEP(116) + ELSE + LD_REDRHS = id%LREDRHS + ENDIF + ENDIF + IF (MASTER.NE.MASTER_ROOT_IN_COMM) THEN + IF ( id%MYID .EQ. MASTER ) THEN + CALL MPI_SEND(LD_REDRHS,1,MPI_INTEGER, + & MASTER_ROOT_IN_COMM, 0, id%COMM,IERR) + ELSEIF ( id%MYID.EQ.MASTER_ROOT_IN_COMM) THEN + CALL MPI_RECV(LD_REDRHS,1,MPI_INTEGER, + & MASTER, 0, id%COMM,STATUS,IERR) + ENDIF + ENDIF + ENDIF + IF ( KEEP(248)==1 ) THEN + JEND_RHS = 0 + IF (DO_PERMUTE_RHS) THEN + ALLOCATE(PERM_RHS(id%NRHS),stat=allocok) + IF (allocok > 0) THEN + INFO(1) = -13 + INFO(2) = id%NRHS + GOTO 109 + ENDIF + NB_BYTES = NB_BYTES + int(id%NRHS,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID.EQ.MASTER) THEN + STRAT_PERMAM1 = KEEP(242) + CALL MUMPS_780 + & (STRAT_PERMAM1, id%SYM_PERM(1), + & id%IRHS_PTR(1), id%NRHS+1, + & PERM_RHS, id%NRHS, + & IERR + & ) + ENDIF + ENDIF + ENDIF +109 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF (id%NSLAVES .EQ. 1) THEN + IF (DO_PERMUTE_RHS .AND. KEEP(111).NE.0 ) THEN + WRITE(*,*) id%MYID, ':INTERNAL ERROR 1 : ', + & ' PERMUTE RHS during null space computation ', + & ' not available yet ' + CALL MUMPS_ABORT() + ENDIF + ELSE + IF (DO_PERMUTE_RHS .AND. KEEP(111).NE.0 ) THEN + WRITE(*,*) id%MYID, ':INTERNAL ERROR 2 : ', + & ' PERMUTE RHS during null space computation ', + & ' not available yet ' + CALL MUMPS_ABORT() + ENDIF + IF (INTERLEAVE_PAR) THEN + IF ( KEEP(111).NE.0 ) THEN + WRITE(*,*) id%MYID, ':INTERNAL ERROR 3 : ', + & ' INTERLEAVE RHS during null space computation ', + & ' not available yet ' + CALL MUMPS_ABORT() + ELSE + IF (id%MYID.EQ.MASTER) THEN + CALL MUMPS_772 + & (PERM_RHS, id%NRHS, id%N, id%KEEP(28), + & id%PROCNODE_STEPS(1), id%STEP(1), id%NSLAVES, + & id%Step2node(1), + & IERR) + ENDIF + ENDIF + ENDIF + ENDIF + IF (DO_PERMUTE_RHS.AND.(KEEP(111).EQ.0)) THEN + CALL MPI_BCAST(PERM_RHS(1), + & id%NRHS, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + ENDIF + BEG_RHS=1 + DO WHILE (BEG_RHS.LE.NRHS_NONEMPTY) + NBRHS_EFF = min(NRHS_NONEMPTY-BEG_RHS+1, NBRHS) + IF (IRHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_SPARSE_COPY),8)*K34_8 + DEALLOCATE(IRHS_SPARSE_COPY) + IRHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_SPARSE_COPY) + ENDIF + IF (IRHS_PTR_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_PTR_COPY),8)*K34_8 + DEALLOCATE(IRHS_PTR_COPY) + IRHS_PTR_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_PTR_COPY) + ENDIF + IF (RHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(RHS_SPARSE_COPY),8)*K35_8 + DEALLOCATE(RHS_SPARSE_COPY) + RHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(RHS_SPARSE_COPY) + ENDIF + IF ( + & ( id%MYID .NE. MASTER ) + & .or. + & ( I_AM_SLAVE .AND. id%MYID .EQ. MASTER .AND. + & ICNTL21 .NE.0 .AND. + & ( KEEP(248).ne.0 .OR. KEEP(221).EQ.2 + & .OR. KEEP(111).NE.0 ) + & ) + & .or. + & ( id%MYID .EQ. MASTER .AND. (KEEP(237).NE.0) ) + & ) THEN + LD_RHS = id%N + IBEG = 1 + ELSE + IF ( associated(id%RHS) ) THEN + LD_RHS = max(id%LRHS, id%N) + ELSE + LD_RHS = id%N + ENDIF + IBEG = (BEG_RHS-1) * LD_RHS + 1 + ENDIF + JBEG_RHS = BEG_RHS + IF ( (id%MYID.EQ.MASTER) .AND. + & KEEP(248)==1 ) THEN + JBEG_RHS = JEND_RHS + 1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + DO WHILE ( id%IRHS_PTR(PERM_RHS(JBEG_RHS)) .EQ. + & id%IRHS_PTR(PERM_RHS(JBEG_RHS)+1) ) + IF ((KEEP(237).EQ.0).AND.(ICNTL21.EQ.0).AND. + & (KEEP(221).NE.1) ) THEN + DO I=1, id%N + RHS_MUMPS((PERM_RHS(JBEG_RHS) -1)*LD_RHS+I) + & = ZERO + ENDDO + ENDIF + JBEG_RHS = JBEG_RHS +1 + CYCLE + ENDDO + ELSE + DO WHILE( id%IRHS_PTR(JBEG_RHS) .EQ. + & id%IRHS_PTR(JBEG_RHS+1) ) + IF ((KEEP(237).EQ.0).AND.(ICNTL21.EQ.0).AND. + & (KEEP(221).NE.1)) THEN + DO I=1, id%N + RHS_MUMPS((JBEG_RHS -1)*LD_RHS + I) = ZERO + ENDDO + ENDIF + IF (KEEP(221).EQ.1) THEN + DO I = 1, id%SIZE_SCHUR + id%REDRHS((JBEG_RHS-1)*LD_REDRHS + I) = ZERO + ENDDO + ENDIF + JBEG_RHS = JBEG_RHS +1 + ENDDO + ENDIF + NB_RHSSKIPPED = JBEG_RHS - (JEND_RHS + 1) + IF ((KEEP(248).EQ.1).AND.(KEEP(237).EQ.0) + & .AND. (ICNTL21.EQ.0)) + & THEN + IBEG = (JBEG_RHS-1) * LD_RHS + 1 + ENDIF + ENDIF + CALL MPI_BCAST( JBEG_RHS,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + IF (id%MYID.EQ.MASTER .AND. KEEP(221).NE.0) THEN + IBEG_REDRHS= (JBEG_RHS-1)*LD_REDRHS + 1 + ELSE + IBEG_REDRHS=-142424 + ENDIF + IF ( I_AM_SLAVE ) THEN + IF ( KEEP(221).EQ.0 ) THEN + IBEG_RHSCOMP= 1 + ELSE + IBEG_RHSCOMP= (JBEG_RHS-1)*LD_RHSCOMP + 1 + ENDIF + ELSE + IBEG_RHSCOMP=-152525 + ENDIF +#if defined(V_T) + CALL VTBEGIN(perm_scal_ini,IERR) +#endif + IF (id%MYID .eq. MASTER) THEN + IF (KEEP(248)==1) THEN + NBCOL = 0 + NBCOL_INBLOC = 0 + NZ_THIS_BLOCK = 0 + STOP_AT_NEXT_EMPTY_COL = .FALSE. + DO I=JBEG_RHS, id%NRHS + NBCOL_INBLOC = NBCOL_INBLOC +1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + ELSE + COLSIZE = id%IRHS_PTR(I+1) - id%IRHS_PTR(I) + ENDIF + IF ((.NOT.STOP_AT_NEXT_EMPTY_COL).AND.(COLSIZE.GT.0).AND. + & (KEEP(237).EQ.0)) + & STOP_AT_NEXT_EMPTY_COL =.TRUE. + IF (COLSIZE.GT.0) THEN + NBCOL = NBCOL+1 + NZ_THIS_BLOCK = NZ_THIS_BLOCK + COLSIZE + ELSE IF (STOP_AT_NEXT_EMPTY_COL) THEN + NBCOL_INBLOC = NBCOL_INBLOC -1 + NBRHS_EFF = NBCOL + EXIT + ENDIF + IF (NBCOL.EQ.NBRHS_EFF) EXIT + ENDDO + IF (NBCOL.NE.NBRHS_EFF) THEN + WRITE(6,*) 'INTERNAL ERROR 1 in CMUMPS_301 ', + & NBCOL, NBRHS_EFF + call MUMPS_ABORT() + ENDIF + ALLOCATE(IRHS_PTR_COPY(NBCOL_INBLOC+1),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NBCOL_INBLOC+1 + GOTO 30 + endif + IRHS_PTR_COPY_ALLOCATED = .TRUE. + NB_BYTES = NB_BYTES + int(NBCOL_INBLOC+1,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + JEND_RHS =JBEG_RHS + NBCOL_INBLOC - 1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + IPOS = 1 + J = 0 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + J = J+1 + IRHS_PTR_COPY(J) = IPOS + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + IPOS = IPOS + COLSIZE + ENDDO + ELSE + IPOS = 1 + J = 0 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + J = J+1 + IRHS_PTR_COPY(J) = IPOS + COLSIZE = id%IRHS_PTR(I+1) + & - id%IRHS_PTR(I) + IPOS = IPOS + COLSIZE + ENDDO + ENDIF + IRHS_PTR_COPY(NBCOL_INBLOC+1)= IPOS + IF ( IPOS-1 .NE. NZ_THIS_BLOCK ) THEN + WRITE(*,*) "Error in compressed copy of IRHS_PTR" + IERR = 99 + call MUMPS_ABORT() + ENDIF + IF (KEEP(23) .NE. 0 .and. MTYPE .NE. 1) THEN + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 30 + endif + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ELSE + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (KEEP(237).NE.0)) THEN + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK), stat=allocok) + IF (allocok .GT.0 ) THEN + IERR = 99 + GOTO 30 + ENDIF + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( DO_PERMUTE_RHS.OR.INTERLEAVE_PAR ) THEN + IPOS = 1 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + IRHS_SPARSE_COPY(IPOS:IPOS+COLSIZE-1) = + & id%IRHS_SPARSE(id%IRHS_PTR(PERM_RHS(I)): + & id%IRHS_PTR(PERM_RHS(I)+1) -1) + IPOS = IPOS + COLSIZE + ENDDO + ELSE + IRHS_SPARSE_COPY = id%IRHS_SPARSE(id%IRHS_PTR(JBEG_RHS): + & id%IRHS_PTR(JBEG_RHS)+NZ_THIS_BLOCK-1) + ENDIF + ELSE + IRHS_SPARSE_COPY + & => + & id%IRHS_SPARSE(id%IRHS_PTR(JBEG_RHS): + & id%IRHS_PTR(JBEG_RHS)+NZ_THIS_BLOCK-1) + ENDIF + ENDIF + IF (LSCAL.OR.DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (KEEP(237).NE.0)) THEN + ALLOCATE(RHS_SPARSE_COPY(NZ_THIS_BLOCK), stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 30 + endif + RHS_SPARSE_COPY_ALLOCATED = .TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ELSE + IF ( KEEP(248)==1 ) THEN + RHS_SPARSE_COPY + & => id%RHS_SPARSE(id%IRHS_PTR(JBEG_RHS): + & id%IRHS_PTR(JBEG_RHS)+NZ_THIS_BLOCK-1) + ELSE + RHS_SPARSE_COPY + & => id%RHS_SPARSE(id%IRHS_PTR(BEG_RHS): + & id%IRHS_PTR(BEG_RHS)+NZ_THIS_BLOCK-1) + ENDIF + ENDIF + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (id%KEEP(237).NE.0)) THEN + IF (id%KEEP(237).NE.0) THEN + RHS_SPARSE_COPY = ONE + ELSE IF (.NOT. LSCAL) THEN + IPOS = 1 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + IF (COLSIZE .EQ. 0) CYCLE + RHS_SPARSE_COPY(IPOS:IPOS+COLSIZE-1) = + & id%RHS_SPARSE(id%IRHS_PTR(PERM_RHS(I)): + & id%IRHS_PTR(PERM_RHS(I)+1) -1) + IPOS = IPOS + COLSIZE + ENDDO + ENDIF + ENDIF + ENDIF + IF (KEEP(23) .NE. 0) THEN + IF (MTYPE .NE. 1) THEN + IF (KEEP(248)==0) THEN + ALLOCATE( C_RW2( id%N ),stat =allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) id%MYID, + & ':Error allocating C_RW2 in CMUMPS_SOLVE_DRIVE' + END IF + GOTO 30 + END IF + DO K = 1, NBRHS_EFF + KDEC = IBEG+(K-1)*LD_RHS + DO I = 1, id%N + C_RW2(I)=RHS_MUMPS(I-1+KDEC) + END DO + DO I = 1, id%N + JPERM = id%UNS_PERM(I) + RHS_MUMPS(I-1+KDEC) = C_RW2(JPERM) + END DO + END DO + DEALLOCATE(C_RW2) + ELSE + IPOS = 1 + DO I=1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(I+1) - IRHS_PTR_COPY(I) + DO K = 1, COLSIZE + JPERM = UNS_PERM_INV(IRHS_SPARSE_COPY(IPOS+K-1)) + IRHS_SPARSE_COPY(IPOS+K-1) = JPERM + ENDDO + IPOS = IPOS + COLSIZE + ENDDO + ENDIF + ENDIF + ENDIF + IF (ERANAL) THEN + IF ( KEEP(248) == 0 ) THEN + DO K = 1, NBRHS_EFF + KDEC = IBEG+(K-1)*LD_RHS + DO I = 1, id%N + SAVERHS(I+(K-1)*id%N) = RHS_MUMPS(KDEC+I-1) + END DO + ENDDO + ENDIF + ENDIF + IF (LSCAL) THEN + IF (KEEP(248)==0) THEN + IF (MTYPE .EQ. 1) THEN + DO K =1, NBRHS_EFF + KDEC = (K-1) * LD_RHS + IBEG - 1 + DO I = 1, id%N + RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) * + & id%ROWSCA(I) + END DO + ENDDO + ELSE + DO K =1, NBRHS_EFF + KDEC = (K-1) * LD_RHS + IBEG - 1 + DO I = 1, id%N + RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) * + & id%COLSCA(I) + END DO + ENDDO + ENDIF + ELSE + KDEC=id%IRHS_PTR(JBEG_RHS) + IF ((KEEP(248)==1) .AND. + & (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (id%KEEP(237).NE.0)) + & ) THEN + IPOS = 1 + J = 0 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + J = J+1 + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE .EQ. 0) CYCLE + IF (id%KEEP(237).NE.0) THEN + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + RHS_SPARSE_COPY(IPOS) = id%ROWSCA(PERM_RHS(I)) * + & ONE + ELSE + RHS_SPARSE_COPY(IPOS) = id%ROWSCA(I) * ONE + ENDIF + ELSE + DO K = 1, COLSIZE + II = id%IRHS_SPARSE(id%IRHS_PTR(PERM_RHS(I))+K-1) + IF (MTYPE.EQ.1) THEN + RHS_SPARSE_COPY(IPOS+K-1) = + & id%RHS_SPARSE(id%IRHS_PTR(PERM_RHS(I))+K-1)* + & id%ROWSCA(II) + ELSE + RHS_SPARSE_COPY(IPOS+K-1) = + & id%RHS_SPARSE(id%IRHS_PTR(PERM_RHS(I))+K-1)* + & id%COLSCA(II) + ENDIF + ENDDO + ENDIF + IPOS = IPOS + COLSIZE + ENDDO + ELSE + IF (MTYPE .eq. 1) THEN + DO IZ=1,NZ_THIS_BLOCK + I=IRHS_SPARSE_COPY(IZ) + RHS_SPARSE_COPY(IZ)=id%RHS_SPARSE(KDEC+IZ-1)* + & id%ROWSCA(I) + ENDDO + ELSE + DO IZ=1,NZ_THIS_BLOCK + I=IRHS_SPARSE_COPY(IZ) + RHS_SPARSE_COPY(IZ)=id%RHS_SPARSE(KDEC+IZ-1)* + & id%COLSCA(I) + ENDDO + ENDIF + ENDIF + ENDIF + END IF + ENDIF +#if defined(V_T) + CALL VTEND(perm_scal_ini,IERR) +#endif + 30 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF ( I_AM_SLAVE ) THEN + IF ( (KEEP(111).NE.0) .OR. (KEEP(248).NE.0) .OR. + & (KEEP(252).NE.0) ) THEN + IF (BUILD_POSINRHSCOMP) THEN + IF (KEEP(111).NE.0) THEN + WHAT = 2 + MTYPE_LOC = 1 + ELSE IF (KEEP(252).NE.0) THEN + WHAT = 0 + MTYPE_LOC = 1 + ELSE + WHAT = 1 + MTYPE_LOC = MTYPE + ENDIF + LIW_PASSED=max(1,LIW) + IF (WHAT.EQ.0) THEN + CALL CMUMPS_639(id%NSLAVES,id%N, + & id%MYID_NODES, id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%PROCNODE_STEPS(1), id%IS(1), LIW_PASSED, + & id%STEP(1), + & id%POSINRHSCOMP(1), IDUMMY, 1, MTYPE_LOC, + & WHAT ) + ELSE + CALL CMUMPS_639(id%NSLAVES,id%N, + & id%MYID_NODES, id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%PROCNODE_STEPS(1), id%IS(1), LIW_PASSED, + & id%STEP(1), + & id%POSINRHSCOMP(1), POSINRHSCOMP_N(1), + & id%N, MTYPE_LOC, + & WHAT ) + ENDIF + BUILD_POSINRHSCOMP = .FALSE. + ENDIF + ENDIF + ENDIF + IF (KEEP(248)==1) THEN + CALL MPI_BCAST( NBCOL_INBLOC,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + ELSE + NBCOL_INBLOC = NBRHS_EFF + ENDIF + JEND_RHS =JBEG_RHS + NBCOL_INBLOC - 1 + IF ((KEEP(248).EQ.1).AND.(KEEP(237).EQ.0)) THEN + CALL MPI_BCAST( NBRHS_EFF,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(NB_RHSSKIPPED,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + ENDIF +#if defined(V_T) + CALL VTBEGIN(soln_dist,IERR) +#endif + IF ((KEEP(111).eq.0).AND.(KEEP(252).EQ.0)) THEN + IF (KEEP(248) == 0) THEN + IF ( .NOT.I_AM_SLAVE ) THEN + CALL CMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & JDUMMY, id%KEEP(1), id%KEEP8(1), id%PROCNODE_STEPS(1), + & IDUMMY, 1, + & id%STEP(1), KDUMMY, 1, BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + BUILD_POSINRHSCOMP=.FALSE. + ELSE + LIW_PASSED = max( LIW, 1 ) + CALL CMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), + & IS(1), LIW_PASSED, + & id%STEP(1), id%POSINRHSCOMP(1), KEEP(28), + & BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + BUILD_POSINRHSCOMP=.FALSE. + ENDIF + IF (INFO(1).LT.0) GOTO 90 + ELSE + CALL MPI_BCAST( NZ_THIS_BLOCK,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + IF (id%MYID.NE.MASTER) THEN + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 45 + endif + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + ALLOCATE(RHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 45 + endif + RHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*(K34_8+K35_8) + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ALLOCATE(IRHS_PTR_COPY(NBCOL_INBLOC+1),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NBCOL_INBLOC+1 + GOTO 45 + endif + IRHS_PTR_COPY_ALLOCATED = .TRUE. + NB_BYTES = NB_BYTES + int(NBCOL_INBLOC+1,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + 45 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + CALL MPI_BCAST(IRHS_SPARSE_COPY(1), + & NZ_THIS_BLOCK, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(RHS_SPARSE_COPY(1), + & NZ_THIS_BLOCK, + & MPI_COMPLEX, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(IRHS_PTR_COPY(1), + & NBCOL_INBLOC+1, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + IF (IERR.GT.0) THEN + WRITE (*,*)'NOT OK FOR ALLOC PTR ON SLAVES' + call MUMPS_ABORT() + ENDIF + IF ( I_AM_SLAVE ) THEN + IF (KEEP(237).NE.0) THEN + K=1 + RHS_MUMPS(1:NBRHS_EFF*LD_RHS) = ZERO + IPOS = 1 + DO I = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(I+1) - IRHS_PTR_COPY(I) + IF (COLSIZE.GT.0) THEN + J = I - 1 + JBEG_RHS + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + J = PERM_RHS(J) + ENDIF + IF (POSINRHSCOMP_N(J).NE.0) THEN + RHS_MUMPS((K-1) * LD_RHS + J) = + & RHS_SPARSE_COPY(IPOS) + ENDIF + K = K + 1 + IPOS = IPOS + COLSIZE + ENDIF + ENDDO + IF (K.NE.NBRHS_EFF+1) THEN + WRITE(6,*) 'INTERNAL ERROR 2 in CMUMPS_301 ', + & K, NBRHS_EFF + call MUMPS_ABORT() + ENDIF + ELSE + IF ((KEEP(221).EQ.1).AND.(NB_RHSSKIPPED.GT.0)) THEN + DO K = JBEG_RHS-NB_RHSSKIPPED, JBEG_RHS-1 + DO I = 1, LD_RHSCOMP + id%RHSCOMP((K-1)*LD_RHSCOMP + I) = ZERO + ENDDO + ENDDO + ENDIF + DO K = 1, NBCOL_INBLOC + KDEC = (K-1) * LD_RHS + IBEG - 1 + RHS_MUMPS(KDEC+1:KDEC+id%N) = ZERO + DO IZ=IRHS_PTR_COPY(K), IRHS_PTR_COPY(K+1)-1 + I=IRHS_SPARSE_COPY(IZ) + IF (POSINRHSCOMP_N(I).NE.0) THEN + RHS_MUMPS(KDEC+I)= RHS_SPARSE_COPY(IZ) + ENDIF + ENDDO + ENDDO + END IF + ENDIF + ENDIF + ELSE IF (I_AM_SLAVE) THEN + IF (KEEP(111).NE.0) THEN + IF (KEEP(111).GT.0) THEN + IBEG_GLOB_DEF = KEEP(111) + IEND_GLOB_DEF = KEEP(111) + ELSE + IBEG_GLOB_DEF = BEG_RHS + IEND_GLOB_DEF = BEG_RHS+NBRHS_EFF-1 + ENDIF + IF ( id%KEEP(112) .GT. 0 .AND. DO_NULL_PIV) THEN + IF (IBEG_GLOB_DEF .GT.id%KEEP(112)) THEN + id%KEEP(235) = 0 + DO_NULL_PIV = .FALSE. + ENDIF + IF (IBEG_GLOB_DEF .LT.id%KEEP(112) + & .AND. IEND_GLOB_DEF .GT.id%KEEP(112) + & .AND. DO_NULL_PIV ) THEN + IEND_GLOB_DEF = id%KEEP(112) + id%KEEP(235) = 1 + DO_NULL_PIV = .FALSE. + ENDIF + ENDIF + IF (id%KEEP(235).NE.0) THEN + NZ_THIS_BLOCK=IEND_GLOB_DEF-IBEG_GLOB_DEF+1 + ALLOCATE(IRHS_PTR_COPY(NZ_THIS_BLOCK+1),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 50 + endif + IRHS_PTR_COPY_ALLOCATED = .TRUE. + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 50 + endif + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*(K34_8+K35_8) + & + K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID.eq.MASTER) THEN + II = 1 + DO I = IBEG_GLOB_DEF, IEND_GLOB_DEF + IRHS_PTR_COPY(I-IBEG_GLOB_DEF+1) = I + IF (INTERLEAVE_PAR .AND.(id%NSLAVES .GT. 1) )THEN + IRHS_SPARSE_COPY(II) = PERM_PIV_LIST(I) + ELSE + IRHS_SPARSE_COPY(II) = id%PIVNUL_LIST(I) + ENDIF + II = II +1 + ENDDO + IRHS_PTR_COPY(NZ_THIS_BLOCK+1) = NZ_THIS_BLOCK+1 + ENDIF + 50 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + CALL MPI_BCAST(IRHS_SPARSE_COPY(1), + & NZ_THIS_BLOCK, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(IRHS_PTR_COPY(1), + & NZ_THIS_BLOCK+1, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + RHS_MUMPS( IBEG : + & (IBEG + (NBRHS_EFF)*LD_RHS -1) ) = ZERO + ENDIF + DO K=1, NBRHS_EFF + KDEC = (K-1) *LD_RHSCOMP + id%RHSCOMP(KDEC+1:KDEC+LD_RHSCOMP)=ZERO + END DO + IF ((KEEP(235).NE.0).AND. INTERLEAVE_PAR) THEN + DO I=IBEG_GLOB_DEF,IEND_GLOB_DEF + IF (id%MYID_NODES .EQ. MAP_PIVNUL_LIST(I) ) THEN + JJ= POSINRHSCOMP_N(PERM_PIV_LIST(I)) + IF (JJ.GT.LD_RHSCOMP) THEN + WRITE(6,*) ' Internal ERROR JJ, LD_RHSCOMP=', + & JJ, LD_RHSCOMP + ENDIF + IF (JJ.GT.0) THEN + IF (KEEP(50).EQ.0) THEN + id%RHSCOMP(IBEG_RHSCOMP -1+ + & (I-IBEG_GLOB_DEF)*LD_RHSCOMP + JJ) = + & cmplx(abs(id%DKEEP(2)),kind=kind(id%RHSCOMP)) + ELSE + id%RHSCOMP(IBEG_RHSCOMP -1+ + & (I-IBEG_GLOB_DEF)*LD_RHSCOMP + JJ) = ONE + ENDIF + ENDIF + ENDIF + ENDDO + ELSE + DO I=max(IBEG_GLOB_DEF,KEEP(220)), + & min(IEND_GLOB_DEF,KEEP(220)+KEEP(109)-1) + JJ= POSINRHSCOMP_N(id%PIVNUL_LIST(I-KEEP(220)+1)) + IF (JJ.GT.0) THEN + IF (KEEP(50).EQ.0) THEN + id%RHSCOMP(IBEG_RHSCOMP-1+(I-IBEG_GLOB_DEF)*LD_RHSCOMP + & + JJ) = cmplx(id%DKEEP(2),kind=kind(id%RHSCOMP)) + ELSE + id%RHSCOMP(IBEG_RHSCOMP-1+(I-IBEG_GLOB_DEF)*LD_RHSCOMP + & + JJ) = ONE + ENDIF + ENDIF + ENDDO + ENDIF + IF ( KEEP(17).NE.0 .and. id%MYID_NODES.EQ.MASTER_ROOT) THEN + IBEG_ROOT_DEF = max(IBEG_GLOB_DEF,KEEP(112)+1) + IEND_ROOT_DEF = min(IEND_GLOB_DEF,KEEP(112)+KEEP(17)) + IROOT_DEF_RHS_COL1 = IBEG_ROOT_DEF-IBEG_GLOB_DEF + 1 + IBEG_ROOT_DEF = IBEG_ROOT_DEF-KEEP(112) + IEND_ROOT_DEF = IEND_ROOT_DEF-KEEP(112) + ELSE + IBEG_ROOT_DEF = -90999 + IEND_ROOT_DEF = -90999 + ENDIF + ELSE + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + LWCB_SOL_C = LWCB + IF ( id%MYID_NODES .EQ. MASTER_ROOT ) THEN + IF ( associated(id%root%RHS_CNTR_MASTER_ROOT) ) THEN + PTR_RHS_ROOT => id%root%RHS_CNTR_MASTER_ROOT + LPTR_RHS_ROOT = size(id%root%RHS_CNTR_MASTER_ROOT) + ELSE + LPTR_RHS_ROOT = NBRHS_EFF * SIZE_ROOT + IPT_RHS_ROOT = LWCB - LPTR_RHS_ROOT + 1 + PTR_RHS_ROOT => WORK_WCB(IPT_RHS_ROOT:LWCB) + LWCB_SOL_C = LWCB_SOL_C - LPTR_RHS_ROOT + ENDIF + ELSE + LPTR_RHS_ROOT = 1 + IPT_RHS_ROOT = LWCB + PTR_RHS_ROOT => WORK_WCB(IPT_RHS_ROOT:LWCB) + LWCB_SOL_C = LWCB_SOL_C - LPTR_RHS_ROOT + ENDIF + ENDIF + IF (KEEP(221) .EQ. 2 ) THEN + IF ( ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) .AND. + & ( id%MYID .EQ. MASTER ) ) THEN + II = 0 + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS -1 + DO I = 1, SIZE_ROOT + PTR_RHS_ROOT(II+I) = id%REDRHS(KDEC+I) + ENDDO + II = II+SIZE_ROOT + ENDDO + ELSE + IF ( id%MYID .EQ. MASTER) THEN + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + KDEC = IBEG_REDRHS + CALL MPI_SEND(id%REDRHS(KDEC), + & SIZE_ROOT*NBRHS_EFF, + & MPI_COMPLEX, + & MASTER_ROOT_IN_COMM, 0, id%COMM,IERR) + ELSE + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS + CALL MPI_SEND(id%REDRHS(KDEC),SIZE_ROOT, + & MPI_COMPLEX, + & MASTER_ROOT_IN_COMM, 0, id%COMM,IERR) + ENDDO + ENDIF + ELSE IF ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) THEN + II = 1 + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + CALL MPI_RECV(PTR_RHS_ROOT(II), + & SIZE_ROOT*NBRHS_EFF, + & MPI_COMPLEX, + & MASTER, 0, id%COMM,STATUS,IERR) + ELSE + DO K=1, NBRHS_EFF + CALL MPI_RECV(PTR_RHS_ROOT(II),SIZE_ROOT, + & MPI_COMPLEX, + & MASTER, 0, id%COMM,STATUS,IERR) + II = II + SIZE_ROOT + ENDDO + ENDIF + ENDIF + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + LIW_PASSED = max( LIW, 1 ) + LA_PASSED = max( LA, 1_8 ) + IF ((id%KEEP(235).EQ.0).and.(id%KEEP(237).EQ.0) ) THEN + PRUNED_SIZE_LOADED = 0_8 + CALL CMUMPS_245(id%root, id%N, id%S(1), LA_PASSED, + & IS(1), LIW_PASSED, WORK_WCB(1), LWCB_SOL_C, + & IWCB, LIWCB, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%NA(1),id%LNA,id%NE_STEPS(1), SRW3, MTYPE, + & ICNTL(1), id%STEP(1), id%FRERE_STEPS(1), + & id%DAD_STEPS(1), id%FILS(1), id%PTLUST_S(1), id%PTRFAC(1), + & IWK_SOLVE, LIWK_SOLVE, id%PROCNODE_STEPS(1), + & id%NSLAVES, INFO(1), KEEP(1), KEEP8(1), + & id%COMM_NODES, id%MYID, id%MYID_NODES, + & id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & IBEG_ROOT_DEF, IEND_ROOT_DEF, + & IROOT_DEF_RHS_COL1, + & PTR_RHS_ROOT(1), LPTR_RHS_ROOT, SIZE_ROOT, MASTER_ROOT, + & id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP, + & id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP + & , 1 , 1 , 1 + & , 1 + & , IDUMMY, 1, JDUMMY, KDUMMY, 1, LDUMMY, 1, MDUMMY + & ) + ELSE + IF ((KEEP(235).NE.0).AND.KEEP(221).NE.2.AND. + & KEEP(111).EQ.0) THEN + DO K=1, NBRHS_EFF + DO I=1, LD_RHSCOMP + id%RHSCOMP(IBEG_RHSCOMP+(K-1)*LD_RHSCOMP+I-1)= ZERO + ENDDO + ENDDO + ELSEIF (KEEP(237).NE.0) THEN + DO K=1, NBRHS_EFF + DO I=1, LD_RHSCOMP + id%RHSCOMP(IBEG_RHSCOMP+(K-1)*LD_RHSCOMP+I-1)= ZERO + ENDDO + ENDDO + ENDIF + IF (.NOT. allocated(PERM_RHS)) THEN + ALLOCATE(PERM_RHS(1),stat=allocok) + NB_BYTES = NB_BYTES + int(size(PERM_RHS),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + CALL CMUMPS_245(id%root, id%N, id%S(1), LA_PASSED, + & IS(1), LIW_PASSED, WORK_WCB(1), LWCB_SOL_C, IWCB, LIWCB, + & RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, id%NA(1),id%LNA, + & id%NE_STEPS(1), SRW3, MTYPE, ICNTL(1), id%STEP(1), + & id%FRERE_STEPS(1), id%DAD_STEPS(1), id%FILS(1), + & id%PTLUST_S(1), id%PTRFAC(1), IWK_SOLVE, LIWK_SOLVE, + & id%PROCNODE_STEPS(1), id%NSLAVES, INFO(1),KEEP(1),KEEP8(1), + & id%COMM_NODES, id%MYID, id%MYID_NODES, + & id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1, + & PTR_RHS_ROOT(1), LPTR_RHS_ROOT, SIZE_ROOT, MASTER_ROOT, + & id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP, + & id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP, + & NZ_THIS_BLOCK, NBCOL_INBLOC, id%NRHS, + & JBEG_RHS , id%Step2node(1), id%KEEP(28), IRHS_SPARSE_COPY(1), + & IRHS_PTR_COPY(1), + & size(PERM_RHS), PERM_RHS, size(UNS_PERM_INV), UNS_PERM_INV + & ) + ENDIF + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1).eq.-2) then + INFO(1)=-11 + IF (LP.GT.0) + & write(LP,*) + & ' WARNING : -11 error code obtained in solve' + END IF + IF (INFO(1).eq.-3) then + INFO(1)=-14 + IF (LP.GT.0) + & write(LP,*) + & ' WARNING : -14 error code obtained in solve' + END IF + IF (INFO(1).LT.0) GO TO 90 + IF ( KEEP(221) .EQ. 1 ) THEN + IF ( ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) .AND. + & ( id%MYID .EQ. MASTER ) ) THEN + II = 0 + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS -1 + DO I = 1, SIZE_ROOT + id%REDRHS(KDEC+I) = PTR_RHS_ROOT(II+I) + ENDDO + II = II+SIZE_ROOT + ENDDO + ELSE + IF ( id%MYID .EQ. MASTER ) THEN + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + KDEC = IBEG_REDRHS + CALL MPI_RECV(id%REDRHS(KDEC), + & SIZE_ROOT*NBRHS_EFF, + & MPI_COMPLEX, + & MASTER_ROOT_IN_COMM, 0, id%COMM, + & STATUS,IERR) + ELSE + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS + CALL MPI_RECV(id%REDRHS(KDEC),SIZE_ROOT, + & MPI_COMPLEX, + & MASTER_ROOT_IN_COMM, 0, id%COMM, + & STATUS,IERR) + ENDDO + ENDIF + ELSE IF ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) THEN + II = 1 + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + CALL MPI_SEND(PTR_RHS_ROOT(II), + & SIZE_ROOT*NBRHS_EFF, + & MPI_COMPLEX, + & MASTER, 0, id%COMM,IERR) + ELSE + DO K=1, NBRHS_EFF + CALL MPI_SEND(PTR_RHS_ROOT(II),SIZE_ROOT, + & MPI_COMPLEX, + & MASTER, 0, id%COMM,IERR) + II = II + SIZE_ROOT + ENDDO + ENDIF + ENDIF + ENDIF + ENDIF + IF ( KEEP(221) .NE. 1 ) THEN + IF (ICNTL21 == 0) THEN + IF ((.NOT. I_AM_SLAVE).AND.KEEP(237).EQ.0) THEN + ALLOCATE( CWORK(KEEP(247)*NBRHS_EFF), stat=allocok) + IF (allocok > 0) THEN + ALLOCATE( CWORK(KEEP(247)), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=KEEP(247) + ENDIF + ENDIF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1).LT.0) GO TO 90 + IF ((id%MYID.NE.MASTER).OR. .NOT.LSCAL) THEN + PT_SCALING => Dummy_SCAL + ELSE + IF (MTYPE.EQ.1) THEN + PT_SCALING => id%COLSCA + ELSE + PT_SCALING => id%ROWSCA + ENDIF + ENDIF + LIW_PASSED = max( LIW, 1 ) + IF ( .NOT.I_AM_SLAVE ) THEN + IF (KEEP(237).EQ.0) THEN + CALL CMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & JDUMMY, id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), IDUMMY, 1, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & CWORK(1), size(CWORK), + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & ) + DEALLOCATE( CWORK ) + ELSE + CALL CMUMPS_812(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%KEEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & ,IRHS_PTR_COPY(1), size(IRHS_PTR_COPY), + & IRHS_SPARSE_COPY(1), size(IRHS_SPARSE_COPY), + & RHS_SPARSE_COPY(1), size(RHS_SPARSE_COPY), + & UNS_PERM_INV, size(UNS_PERM_INV), IDUMMY, 1 + & ) + ENDIF + ELSE + IF (KEEP(237).EQ.0) THEN + CALL CMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), IS(1), LIW_PASSED, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%RHSCOMP(1), LENRHSCOMP, + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & ) + ELSE + CALL CMUMPS_812(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%KEEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & , IRHS_PTR_COPY(1), size(IRHS_PTR_COPY), + & IRHS_SPARSE_COPY(1), size(IRHS_SPARSE_COPY), + & RHS_SPARSE_COPY(1), size(RHS_SPARSE_COPY), + & UNS_PERM_INV, size(UNS_PERM_INV), POSINRHSCOMP_N, + & id%N + & ) + ENDIF + ENDIF + IF ( (id%MYID.EQ.MASTER).AND. (KEEP(237).NE.0) + & ) THEN + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + DO J = JBEG_RHS, JBEG_RHS+NBCOL_INBLOC-1 + COLSIZE = id%IRHS_PTR(PERM_RHS(J)+1) - + & id%IRHS_PTR(PERM_RHS(J)) + IF (COLSIZE.EQ.0) CYCLE + JJ = J-JBEG_RHS+1 + DO IZ= id%IRHS_PTR(PERM_RHS(J)), + & id%IRHS_PTR(PERM_RHS(J)+1)-1 + I = id%IRHS_SPARSE (IZ) + DO IZ2 = IRHS_PTR_COPY(JJ),IRHS_PTR_COPY(JJ+1)-1 + IF (IRHS_SPARSE_COPY(IZ2).EQ.I) EXIT + IF (IZ2.EQ.IRHS_PTR_COPY(JJ+1)-1) THEN + WRITE(6,*) " INTERNAL ERROR 1 gather sol_driver" + CALL MUMPS_ABORT() + ENDIF + ENDDO + id%RHS_SPARSE(IZ) = RHS_SPARSE_COPY(IZ2) + ENDDO + ENDDO + ELSE + DO J = JBEG_RHS, JBEG_RHS+NBCOL_INBLOC-1 + COLSIZE = id%IRHS_PTR(J+1) - id%IRHS_PTR(J) + IF (COLSIZE.EQ.0) CYCLE + JJ = J-JBEG_RHS+1 + DO IZ= id%IRHS_PTR(J), id%IRHS_PTR(J+1) - 1 + I = id%IRHS_SPARSE (IZ) + DO IZ2 = IRHS_PTR_COPY(JJ),IRHS_PTR_COPY(JJ+1)-1 + IF (IRHS_SPARSE_COPY(IZ2).EQ.I) EXIT + IF (IZ2.EQ.IRHS_PTR_COPY(JJ+1)-1) THEN + WRITE(6,*) " INTERNAL ERROR 2 gather sol_driver" + CALL MUMPS_ABORT() + ENDIF + ENDDO + id%RHS_SPARSE(IZ) = RHS_SPARSE_COPY(IZ2) + ENDDO + ENDDO + ENDIF + ENDIF + ELSE + IF ( I_AM_SLAVE ) THEN + LIW_PASSED = max( LIW, 1 ) + IF ( KEEP(89) .GT. 0 ) THEN + CALL CMUMPS_532(id%NSLAVES, + & id%N, id%MYID_NODES, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%ISOL_loc(1), + & id%SOL_loc(1), JBEG_RHS-NB_RHSSKIPPED, id%LSOL_loc, + & id%PTLUST_S(1), id%PROCNODE_STEPS(1), + & id%KEEP(1),id%KEEP8(1), + & IS(1), LIW_PASSED, + & id%STEP(1), scaling_data, LSCAL, NB_RHSSKIPPED ) + ENDIF + ENDIF + ENDIF + ENDIF + IF ( ICNTL10 > 0 .AND. NBRHS_EFF > 1 ) THEN + DO I = 1, ICNTL10 + write(*,*) 'FIXME: to be implemented' + END DO + END IF + IF (ERANAL) THEN + IF ((ICNTL10 .GT. 0) .AND. (ICNTL11 .GT. 0)) THEN + IF (id%MYID .EQ. MASTER) THEN + GIVSOL = .FALSE. + IF (MP .GT. 0) WRITE( MP, 170 ) + ALLOCATE(R_RW1(id%N),stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 776 + ENDIF + ALLOCATE(C_RW2(id%N),stat=allocok) + IF (allocok .GT.0) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 776 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + int(id%N,8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + END IF + 776 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + IF ( KEEP(54) .eq. 0 ) THEN + IF (id%MYID .EQ. MASTER) THEN + IF (KEEP(55).EQ.0) THEN + CALL CMUMPS_278( ICNTL(9), id%N, id%NZ, id%A(1), + & id%IRN(1), id%JCN(1), + & RHS_MUMPS(IBEG), SAVERHS, R_RW1, C_RW2, + & KEEP(1),KEEP8(1) ) + ELSE + CALL CMUMPS_121( ICNTL(9), id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & RHS_MUMPS(IBEG), SAVERHS, R_RW1, C_RW2, + & KEEP(1),KEEP8(1) ) + ENDIF + END IF + ELSE + CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N, + & MPI_COMPLEX, MASTER, + & id%COMM, IERR ) + ALLOCATE( C_LOCWK54( id%N ), stat =allocok ) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + endif + CALL MUMPS_276(ICNTL(1), INFO(1), id%COMM, id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL CMUMPS_192( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE ) + ELSE + C_LOCWK54 = ZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( C_LOCWK54, C_RW2, + & id%N, MPI_COMPLEX, + & MPI_SUM,MASTER,id%COMM, IERR) + C_RW2 = SAVERHS - C_RW2 + ELSE + CALL MPI_REDUCE( C_LOCWK54, C_DUMMY, + & id%N, MPI_COMPLEX, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + NB_BYTES = NB_BYTES - int(size(C_LOCWK54),8)*K35_8 + DEALLOCATE( C_LOCWK54 ) + ALLOCATE( R_LOCWK54( id%N ), stat =allocok ) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + endif + CALL MUMPS_276(ICNTL(1), INFO(1), id%COMM, id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( I_AM_SLAVE .AND. id%NZ_loc .NE. 0 ) THEN + CALL CMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1)) + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_RW1, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + NB_BYTES = NB_BYTES - int(size(R_LOCWK54),8)*K16_8 + DEALLOCATE( R_LOCWK54 ) + END IF + IF ( id%MYID .EQ. MASTER ) THEN + CALL CMUMPS_205(ICNTL(9),INFO(1),id%N,id%NZ, + & RHS_MUMPS(IBEG), SAVERHS,R_RW1,C_RW2,GIVSOL, + & RSOL,RINFOG(4),RINFOG(5),RINFOG(6),MP,ICNTL(1), + & KEEP(1),KEEP8(1)) + NB_BYTES = NB_BYTES - int(size(R_RW1),8)*K16_8 + & - int(size(C_RW2),8)*K35_8 + DEALLOCATE(R_RW1) + DEALLOCATE(C_RW2) + END IF + END IF + IF ( PROK .AND. ICNTL10 .GT. 0 ) WRITE( MP, 270 ) + IF ( PROKG .AND. ICNTL10 .GT. 0 ) WRITE( MPG, 270 ) + ALLOCATE(R_Y(id%N), stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + ALLOCATE(C_Y(id%N), stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + IF ( id%MYID .EQ. MASTER ) THEN + ALLOCATE( IW1( 2 * id%N ),stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=2 * id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(2*id%N,8)*K34_8 + ALLOCATE( D(id%N),stat =allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + ALLOCATE( C_W(id%N), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + ALLOCATE( R_W(2*id%N), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(2*id%N,8)*K16_8 + NITREF = ICNTL10 + JOBIREF= ICNTL11 + IF ( PROKG .AND. ICNTL10 .GT. 0 ) + & WRITE( MPG, 240) 'MAXIMUM NUMBER OF STEPS =', NITREF + DO I = 1, id%N + D( I ) = RONE + END DO + END IF + ALLOCATE(C_LOCWK54(id%N),stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + ALLOCATE(R_LOCWK54(id%N),stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + KASE = 0 + 777 CONTINUE + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + 22 CONTINUE + IF ( KEEP(54) .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + IF ( KASE .eq. 0 ) THEN + IF (KEEP(55).NE.0) THEN + CALL CMUMPS_119(MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & R_W(id%N+1), KEEP(1),KEEP8(1) ) + ELSE + IF ( MTYPE .eq. 1 ) THEN + CALL CMUMPS_207 + & ( id%A(1), id%NZ, id%N, id%IRN(1), id%JCN(1), + & R_W(id%N+1), KEEP(1),KEEP8(1)) + ELSE + CALL CMUMPS_207 + & ( id%A(1), id%NZ, id%N, id%JCN(1), id%IRN(1), + & R_W(id%N+1), KEEP(1),KEEP8(1)) + END IF + ENDIF + ENDIF + END IF + ELSE + IF ( KASE .eq. 0 ) THEN + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + CALL CMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1) ) + ELSE + CALL CMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%JCN_loc(1), id%IRN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1) ) + END IF + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_W( id%N + 1 ), + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + END IF + END IF + IF ( id%MYID .eq. MASTER ) THEN + ARRET = CNTL(2) + IF (ARRET .LT. 0.0E0) THEN + ARRET = sqrt(epsilon(0.0E0)) + END IF + CALL CMUMPS_206(id%NZ,id%N,SAVERHS,RHS_MUMPS(IBEG), + & C_Y, D, R_W, C_W, + & IW1, KASE,RINFOG(7), + & RINFOG(9), JOBIREF, RINFOG(10), NITREF, NOITER, MP, + & KEEP(1),KEEP8(1), ARRET ) + END IF + IF ( KEEP(54) .ne. 0 ) THEN + CALL MPI_BCAST( KASE, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + END IF + IF ( KEEP(54) .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + IF ( KASE .eq. 14 ) THEN + IF (KEEP(55).NE.0) THEN + CALL CMUMPS_122( MTYPE, id%N, + & id%NELT, id%ELTPTR(1), id%LELTVAR, + & id%ELTVAR(1), id%NA_ELT, id%A_ELT(1), + & SAVERHS, RHS_MUMPS(IBEG), + & C_Y, R_W, KEEP(50)) + ELSE + IF ( MTYPE .eq. 1 ) THEN + CALL CMUMPS_208 + & (id%A(1), id%NZ, id%N, id%IRN(1), id%JCN(1), SAVERHS, + & RHS_MUMPS(IBEG), C_Y, R_W, KEEP(1),KEEP8(1)) + ELSE + CALL CMUMPS_208 + & (id%A(1), id%NZ, id%N, id%JCN(1), id%IRN(1), SAVERHS, + & RHS_MUMPS(IBEG), C_Y, R_W, KEEP(1),KEEP8(1)) + END IF + ENDIF + GOTO 22 + END IF + END IF + ELSE + IF ( KASE.eq.14 ) THEN + CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N, + & MPI_COMPLEX, MASTER, + & id%COMM, IERR ) + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL CMUMPS_192( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE ) + ELSE + C_LOCWK54 = ZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( C_LOCWK54, C_Y, + & id%N, MPI_COMPLEX, + & MPI_SUM,MASTER,id%COMM, IERR) + C_Y = SAVERHS - C_Y + ELSE + CALL MPI_REDUCE( C_LOCWK54, C_DUMMY, + & id%N, MPI_COMPLEX, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + IF ( I_AM_SLAVE .and. id%NZ_loc .NE. 0 ) THEN + CALL CMUMPS_193( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), R_LOCWK54, KEEP(50), MTYPE ) + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_W, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_REAL, + & MPI_SUM, MASTER, id%COMM, IERR) + END IF + GOTO 22 + END IF + END IF + IF ( id%MYID .eq. MASTER ) THEN + IF ( KASE .GT. 0 ) THEN + IF ( MTYPE .EQ. 1 ) THEN + SOLVET = KASE - 1 + ELSE + SOLVET = KASE + END IF + IF ( LSCAL ) THEN + IF ( SOLVET .EQ. 1 ) THEN + DO K = 1, id%N + C_Y( K ) = C_Y( K ) * id%ROWSCA( K ) + END DO + ELSE + DO K = 1, id%N + C_Y( K ) = C_Y( K ) * id%COLSCA( K ) + END DO + END IF + END IF + END IF + END IF + CALL MPI_BCAST( KASE , 1, MPI_INTEGER, MASTER, + & id%COMM, IERR) + CALL MPI_BCAST( SOLVET, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR) + IF ( KASE .GT. 0 ) THEN + BUILD_POSINRHSCOMP=.FALSE. + IF ( .NOT.I_AM_SLAVE ) THEN + CALL CMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, C_Y(1), id%N, 1, + & JDUMMY, id%KEEP(1), id%KEEP8(1), id%PROCNODE_STEPS(1), + & IDUMMY, 1, + & id%STEP(1), KDUMMY, 1, BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + ELSE + LIW_PASSED = max( LIW, 1 ) + CALL CMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, C_Y(1), id%N, 1, + & id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), + & IS(1), LIW_PASSED, + & id%STEP(1), id%POSINRHSCOMP(1), KEEP(28), + & BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + ENDIF + IF (INFO(1).LT.0) GOTO 89 + IF ( I_AM_SLAVE ) THEN + LIW_PASSED = max( LIW, 1 ) + LA_PASSED = max( LA, 1_8 ) + CALL CMUMPS_245( id%root, id%N, id%S(1), LA_PASSED, + & id%IS(1), LIW_PASSED, WORK_WCB(1), LWCB_SOL_C, IWCB, LIWCB, C_Y, + & id%N, NBRHS_EFF, id%NA(1), id%LNA, id%NE_STEPS(1), SRW3, SOLVET, + & ICNTL(1), id%STEP(1), id%FRERE_STEPS(1), id%DAD_STEPS(1), id% + & FILS(1), id%PTLUST_S(1), id%PTRFAC(1), IWK_SOLVE(1), LIWK_SOLVE, + & id%PROCNODE_STEPS(1), id%NSLAVES, INFO(1), KEEP(1), KEEP8(1), + & id%COMM_NODES, id%MYID, id%MYID_NODES, id%BUFR(1), id%LBUFR, + & id%LBUFR_BYTES, id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1, + & PTR_RHS_ROOT(1), LPTR_RHS_ROOT, SIZE_ROOT, MASTER_ROOT, + & id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP, + & id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP + & , 1 , 1 , 1 + & , 1 + & , IDUMMY, 1, JDUMMY, KDUMMY, 1, LDUMMY, 1, MDUMMY + & ) + END IF + IF (INFO(1).eq.-2) INFO(1)=-12 + IF (INFO(1).eq.-3) INFO(1)=-15 + IF ( .NOT. I_AM_SLAVE .AND. INFO(1) .GE. 0) THEN + ALLOCATE( CWORK(KEEP(247)*NBRHS_EFF), stat=allocok) + IF (allocok > 0) THEN + ALLOCATE( CWORK(KEEP(247)), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=KEEP(247) + ENDIF + ENDIF + ENDIF + 89 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1).LT.0) GO TO 90 + IF ((id%MYID.NE.MASTER).OR. .NOT.LSCAL) THEN + PT_SCALING => Dummy_SCAL + ELSE + IF (SOLVET.EQ.1) THEN + PT_SCALING => id%COLSCA + ELSE + PT_SCALING => id%ROWSCA + ENDIF + ENDIF + LIW_PASSED = max( LIW, 1 ) + IF ( .NOT. I_AM_SLAVE ) THEN + CALL CMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & SOLVET, C_Y, id%N, NBRHS_EFF, + & JDUMMY, id%KEEP(1),id%KEEP8(1), id%PROCNODE_STEPS(1), + & IDUMMY, 1, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & CWORK, size(CWORK), + & LSCAL, PT_SCALING(1), size(PT_SCALING)) + DEALLOCATE( CWORK ) + ELSE + CALL CMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & SOLVET, C_Y, id%N, NBRHS_EFF, + & id%PTLUST_S(1), id%KEEP(1),id%KEEP8(1), + & id%PROCNODE_STEPS(1), + & IS(1), LIW_PASSED, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%RHSCOMP(1), LENRHSCOMP, + & LSCAL, PT_SCALING(1), size(PT_SCALING)) + ENDIF + GO TO 22 + ELSEIF ( KASE .LT. 0 ) THEN + INFO( 1 ) = INFO( 1 ) + 8 + END IF + IF ( id%MYID .eq. MASTER ) THEN + NB_BYTES = NB_BYTES - int(size(R_W),8)*K16_8 + & - int(size(D ),8)*K16_8 + & - int(size(IW1),8)*K34_8 + DEALLOCATE(R_W,D) + DEALLOCATE(IW1) + ENDIF + IF ( PROKG ) THEN + IF (NITREF.GT.0) THEN + WRITE( MPG, 81 ) + WRITE( MPG, 141 ) 'NUMBER OF STEPS OF ITERATIVE REFINEMENTS + &=', NOITER + ENDIF + ENDIF + IF ( id%MYID .EQ. MASTER ) THEN + IF ( NITREF .GT. 0 ) THEN + id%INFOG(15) = NOITER + END IF + END IF + IF ( PROK .AND. ICNTL10 .GT.0 ) WRITE( MP, 131 ) + IF (ICNTL11 .GT. 0) THEN + IF ( KEEP(54) .eq. 0 ) THEN + IF (id%MYID .EQ. MASTER) THEN + IF (KEEP(55).EQ.0) THEN + CALL CMUMPS_278( MTYPE, id%N, id%NZ, id%A(1), + & id%IRN(1), id%JCN(1), + & RHS_MUMPS(IBEG), SAVERHS, R_Y, C_W, KEEP(1),KEEP8(1)) + ELSE + CALL CMUMPS_121( MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & RHS_MUMPS(IBEG), SAVERHS, R_Y, C_W, KEEP(1),KEEP8(1)) + ENDIF + END IF + ELSE + CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N, + & MPI_COMPLEX, MASTER, + & id%COMM, IERR ) + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL CMUMPS_192( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE ) + ELSE + C_LOCWK54 = ZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( C_LOCWK54, C_W, + & id%N, MPI_COMPLEX, + & MPI_SUM,MASTER,id%COMM, IERR) + C_W = SAVERHS - C_W + ELSE + CALL MPI_REDUCE( C_LOCWK54, C_DUMMY, + & id%N, MPI_COMPLEX, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL CMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1) ) + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_Y, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + END IF + IF (id%MYID .EQ. MASTER) THEN + IF ((MPG .GT. 0) .AND. (NITREF .GT. 0)) WRITE( MPG, 65 ) + IF ((MPG .GT. 0) .AND. (NITREF .LE. 0)) WRITE( MPG, 170 ) + GIVSOL = .FALSE. + CALL CMUMPS_205(MTYPE,INFO(1),id%N,id%NZ,RHS_MUMPS(IBEG), + & SAVERHS,R_Y,C_W,GIVSOL, + & RSOL,RINFOG(4),RINFOG(5),RINFOG(6),MPG,ICNTL(1), + & KEEP(1),KEEP8(1)) + IF ( MPG .GT. 0 ) THEN + WRITE( MPG, 115 ) + &'RINFOG(7):COMPONENTWISE SCALED RESIDUAL(W1)=', RINFOG(7) + WRITE( MPG, 115 ) + &'------(8):---------------------------- (W2)=', RINFOG(8) + WRITE( MPG, 115 ) + &'------(9):Upper bound ERROR ...............=', RINFOG(9) + WRITE( MPG, 115 ) + &'-----(10):CONDITION NUMBER (1) ............=', RINFOG(10) + WRITE( MPG, 115 ) + &'-----(11):CONDITION NUMBER (2) ............=', RINFOG(11) + END IF + END IF + END IF + IF (id%MYID == MASTER) THEN + NB_BYTES = NB_BYTES - int(size(C_W),8)*K35_8 + DEALLOCATE(C_W) + ENDIF + NB_BYTES = NB_BYTES - + & (int(size(R_Y),8)+int(size(R_LOCWK54),8))*K16_8 + NB_BYTES = NB_BYTES - + & (int(size(C_Y),8)+int(size(C_LOCWK54),8))*K35_8 + DEALLOCATE(R_Y) + DEALLOCATE(C_Y) + DEALLOCATE(R_LOCWK54) + DEALLOCATE(C_LOCWK54) + END IF + IF ( id%MYID .EQ. MASTER .AND. ICNTL21==0 + & .AND. KEEP(23) .NE. 0 .AND. KEEP(237).EQ.0 ) THEN + IF ((KEEP(221).NE.1 .AND. ICNTL(9) .EQ. 1) + & .OR. KEEP(111) .NE.0 .OR. KEEP(252).NE.0 ) THEN + ALLOCATE( C_RW1( id%N ),stat =allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + WRITE(*,*) 'could not allocate ', id%N, 'integers.' + CALL MUMPS_ABORT() + END IF + DO K = 1, NBRHS_EFF + KDEC = (K-1)*LD_RHS+IBEG-1 + DO 70 I = 1, id%N + C_RW1(I) = RHS_MUMPS(KDEC+I) + 70 CONTINUE + DO 80 I = 1, id%N + JPERM = id%UNS_PERM(I) + RHS_MUMPS( KDEC+JPERM ) = C_RW1( I ) + 80 CONTINUE + END DO + DEALLOCATE( C_RW1 ) + END IF + END IF + IF (id%MYID.EQ.MASTER .and.ICNTL21==0.and.KEEP(221).NE.1 + & .and. KEEP(237).EQ.0 ) THEN + IF ( INFO(1) .GE. 0 .AND. ICNTL(4).GE.3 .AND. ICNTL(3).GT.0) + & THEN + K = min0(10, id%N) + IF (ICNTL(4) .eq. 4 ) K = id%N + J = min0(10,NBRHS_EFF) + IF (ICNTL(4) .eq. 4 ) J = NBRHS_EFF + DO II=1, J + WRITE(ICNTL(3),110) BEG_RHS+II-1 + WRITE(ICNTL(3),160) + & (RHS_MUMPS(IBEG+(II-1)*LD_RHS+I-1),I=1,K) + ENDDO + END IF + END IF + IF ((KEEP(248).EQ.1).AND.(KEEP(237).EQ.0)) THEN + BEG_RHS = BEG_RHS + NBRHS_EFF + ELSE + BEG_RHS = BEG_RHS + NBRHS + ENDIF + ENDDO + IF ( (id%MYID.EQ.MASTER) + & .AND. ( KEEP(248).NE.0 ) + & .AND. ( KEEP(237).EQ.0 ) + & .AND. ( ICNTL21.EQ.0 ) + & .AND. ( KEEP(221) .NE.1 ) + & .AND. ( JEND_RHS .LT. id%NRHS ) + & ) + & THEN + JBEG_NEW = JEND_RHS + 1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, id%N + RHS_MUMPS((PERM_RHS(JBEG_NEW) -1)*LD_RHS+I) + & = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + CYCLE + ENDDO + ELSE + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, id%N + RHS_MUMPS((JBEG_NEW -1)*LD_RHS + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + ENDIF + IF ( I_AM_SLAVE .AND. (ICNTL21.NE.0) .AND. + & ( JEND_RHS .LT. id%NRHS ) .AND. KEEP(221).NE.1 ) THEN + JBEG_NEW = JEND_RHS + 1 + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, KEEP(89) + id%SOL_loc((JBEG_NEW -1)*id%LSOL_loc + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + IF ((KEEP(221).EQ.1) .AND. + & ( JEND_RHS .LT. id%NRHS ) ) THEN + IF (id%MYID .EQ. MASTER) THEN + JBEG_NEW = JEND_RHS + 1 + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, id%SIZE_SCHUR + id%REDRHS((JBEG_NEW -1)*LD_REDRHS + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + IF (I_AM_SLAVE) THEN + JBEG_NEW = JEND_RHS + 1 + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1,LD_RHSCOMP + id%RHSCOMP((JBEG_NEW -1)*LD_RHSCOMP + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + ENDIF + id%INFO(26) = int(NB_BYTES_MAX / 1000000_8, 4) + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(26), id%INFOG(30), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Rank of processor needing largest memory in solve :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Space in MBYTES used by this processor for solve :', + & id%INFOG(30) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during solve :', + & ( id%INFOG(31)-id%INFO(26) ) / id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during solve :', + & id%INFOG(31) / id%NSLAVES + END IF + END IF + 90 CONTINUE + IF (INFO(1) .LT.0 ) THEN + ENDIF + IF (KEEP(201).GT.0)THEN + IF (IS_INIT_OOC_DONE) THEN + CALL CMUMPS_582(IERR) + IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + ENDIF + IF (IRHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_SPARSE_COPY),8)*K34_8 + DEALLOCATE(IRHS_SPARSE_COPY) + IRHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_SPARSE_COPY) + ENDIF + IF (IRHS_PTR_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_PTR_COPY),8)*K34_8 + DEALLOCATE(IRHS_PTR_COPY) + IRHS_PTR_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_PTR_COPY) + ENDIF + IF (RHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(RHS_SPARSE_COPY),8)*K35_8 + DEALLOCATE(RHS_SPARSE_COPY) + RHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(RHS_SPARSE_COPY) + ENDIF + IF (allocated(PERM_RHS)) THEN + NB_BYTES = NB_BYTES - int(size(PERM_RHS),8)*K34_8 + DEALLOCATE(PERM_RHS) + ENDIF + IF (allocated(UNS_PERM_INV)) THEN + NB_BYTES = NB_BYTES - int(size(UNS_PERM_INV),8)*K34_8 + DEALLOCATE(UNS_PERM_INV) + ENDIF + IF (associated(id%BUFR)) THEN + NB_BYTES = NB_BYTES - int(size(id%BUFR),8)*K34_8 + DEALLOCATE(id%BUFR) + NULLIFY(id%BUFR) + ENDIF + IF ( I_AM_SLAVE ) THEN + IF (allocated(IWK_SOLVE)) THEN + NB_BYTES = NB_BYTES - int(size(IWK_SOLVE),8)*K34_8 + DEALLOCATE( IWK_SOLVE ) + ENDIF + IF (allocated(IWCB)) THEN + NB_BYTES = NB_BYTES - int(size(IWCB),8)*K34_8 + DEALLOCATE( IWCB ) + ENDIF + CALL CMUMPS_57( IERR ) + CALL CMUMPS_59( IERR ) + END IF + IF ( id%MYID .eq. MASTER ) THEN + IF (allocated(SAVERHS)) THEN + NB_BYTES = NB_BYTES - int(size(SAVERHS),8)*K35_8 + DEALLOCATE( SAVERHS) + ENDIF + IF ( + & ( + & ( KEEP(248).ne.0 .OR. KEEP(221).EQ.2 + & .OR. KEEP(111).NE.0 ) + & .and. ICNTL21.ne.0 ) + & .or. + & ( KEEP(237).NE.0 ) + & ) + & THEN + IF ( I_AM_SLAVE ) THEN + IF (associated(RHS_MUMPS) ) THEN + NB_BYTES = NB_BYTES - int(size(RHS_MUMPS),8)*K35_8 + DEALLOCATE(RHS_MUMPS) + ENDIF + ENDIF + ENDIF + NULLIFY(RHS_MUMPS) + ELSE + IF (associated(RHS_MUMPS)) THEN + NB_BYTES = NB_BYTES - int(size(RHS_MUMPS),8)*K35_8 + DEALLOCATE(RHS_MUMPS) + NULLIFY(RHS_MUMPS) + END IF + END IF + IF (I_AM_SLAVE) THEN + IF (allocated(SRW3)) THEN + NB_BYTES = NB_BYTES - int(size(SRW3),8)*K35_8 + DEALLOCATE(SRW3) + ENDIF + IF (allocated(POSINRHSCOMP_N)) THEN + NB_BYTES = NB_BYTES - int(size(POSINRHSCOMP_N),8)*K34_8 + DEALLOCATE(POSINRHSCOMP_N) + ENDIF + IF (LSCAL .AND. ICNTL21==1) THEN + NB_BYTES = NB_BYTES - + & int(size(scaling_data%SCALING_LOC),8)*K16_8 + DEALLOCATE(scaling_data%SCALING_LOC) + NULLIFY(scaling_data%SCALING_LOC) + ENDIF + IF (WK_USER_PROVIDED) THEN + NULLIFY(id%S) + ELSE IF (associated(id%S).AND.KEEP(201).GT.0) THEN + NB_BYTES = NB_BYTES - KEEP8(23)*K35_8 + id%KEEP8(23)=0_8 + DEALLOCATE(id%S) + NULLIFY(id%S) + ENDIF + IF (KEEP(221).NE.1) THEN + IF (associated(id%RHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8 + DEALLOCATE(id%RHSCOMP) + NULLIFY(id%RHSCOMP) + ENDIF + IF (associated(id%POSINRHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%POSINRHSCOMP),8)*K34_8 + DEALLOCATE(id%POSINRHSCOMP) + NULLIFY(id%POSINRHSCOMP) + ENDIF + ENDIF + IF ( WORK_WCB_ALLOCATED ) THEN + NB_BYTES = NB_BYTES - int(size(WORK_WCB),8)*K35_8 + DEALLOCATE( WORK_WCB ) + ENDIF + NULLIFY( WORK_WCB ) + ENDIF + RETURN + 65 FORMAT (//' ERROR ANALYSIS AFTER ITERATIVE REFINEMENT') + 100 FORMAT(//' ****** SOLVE & CHECK STEP ********'/) + 110 FORMAT (//' VECTOR SOLUTION FOR COLUMN ',I12) + 115 FORMAT(1X, A44,1P,D9.2) + 150 FORMAT (/' STATISTICS PRIOR SOLVE PHASE ...........'/ + & ' NUMBER OF RIGHT-HAND-SIDES =',I12/ + & ' BLOCKING FACTOR FOR MULTIPLE RHS =',I12/ + & ' ICNTL (9) =',I12/ + & ' --- (10) =',I12/ + & ' --- (11) =',I12/ + & ' --- (20) =',I12/ + & ' --- (21) =',I12/ + & ' --- (30) =',I12) + 151 FORMAT (' --- (25) =',I12) + 152 FORMAT (' --- (26) =',I12) + 153 FORMAT (' --- (32) =',I12) + 160 FORMAT (' RHS'/(1X,1P,5E14.6)) + 170 FORMAT (//' ERROR ANALYSIS' ) + 240 FORMAT (1X, A42,I4) + 270 FORMAT (//' BEGIN ITERATIVE REFINEMENT' ) + 81 FORMAT (/' STATISTICS AFTER ITERATIVE REFINEMENT ') + 131 FORMAT (/' END ITERATIVE REFINEMENT ') + 141 FORMAT(1X, A42,I4) + END SUBROUTINE CMUMPS_301 + SUBROUTINE CMUMPS_245(root, N, A, LA, IW, LIW, W, LWC, + & IWCB,LIWW,RHS,LRHS,NRHS,NA,LNA,NE_STEPS, W2, + & MTYPE, ICNTL, + & STEP, FRERE, DAD, FILS, PTRIST, PTRFAC, IW1,LIW1, + & PROCNODE_STEPS, SLAVEF, + & INFO, KEEP,KEEP8, COMM_NODES, MYID, + & MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & IBEG_ROOT_DEF, IEND_ROOT_DEF, + & IROOT_DEF_RHS_COL1, PTR_RHS_ROOT, LPTR_RHS_ROOT, + & SIZE_ROOT, MASTER_ROOT, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, BUILD_POSINRHSCOMP + & , NZ_RHS, NBCOL_INBLOC, NRHS_ORIG + & , JBEG_RHS + & , Step2node, LStep2node + & , IRHS_SPARSE + & , IRHS_PTR + & , SIZE_PERM_RHS, PERM_RHS + & , SIZE_UNS_PERM_INV, UNS_PERM_INV + & ) + USE CMUMPS_OOC + USE MUMPS_SOL_ES + IMPLICIT NONE + INCLUDE 'cmumps_root.h' +#if defined(V_T) + INCLUDE 'VT.inc' +#endif + TYPE ( CMUMPS_ROOT_STRUC ) :: root + INTEGER(8) :: LA + INTEGER LWC,N,LIW,MTYPE,LIW1,LIWW,LNA + INTEGER ICNTL(40),INFO(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IW(LIW),IW1(LIW1),NA(LNA),NE_STEPS(KEEP(28)),IWCB(LIWW) + INTEGER STEP(N), FRERE(KEEP(28)), FILS(N), PTRIST(KEEP(28)), + & DAD(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER LRHS, NRHS, LRHSCOMP + COMPLEX A(LA), W(LWC), RHS(LRHS,NRHS), + & W2(KEEP(133)), + & RHSCOMP(LRHSCOMP,NRHS) + INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES + INTEGER PROCNODE_STEPS(KEEP(28)), POSINRHSCOMP(KEEP(28)) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR(LBUFR) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1 + INTEGER SIZE_ROOT, MASTER_ROOT + INTEGER LPTR_RHS_ROOT + COMPLEX PTR_RHS_ROOT(LPTR_RHS_ROOT) + LOGICAL BUILD_POSINRHSCOMP + INTEGER MP, LP, LDIAG + INTEGER K,I,II + INTEGER allocok + INTEGER LPOOL,MYLEAF,LPANEL_POS + INTEGER NSTK_S,IPOOL,IPANEL_POS,PTRICB,PTRACB + INTEGER MTYPE_LOC + INTEGER IERR + INTEGER(8) :: IAPOS + INTEGER IOLDPS, + & LOCAL_M, + & LOCAL_N +#if defined(V_T) + INTEGER soln_c_class, forw_soln, back_soln, root_soln +#endif + INTEGER IZERO + LOGICAL DOFORWARD, DOROOT, DOBACKWARD + LOGICAL I_WORKED_ON_ROOT, SPECIAL_ROOT_REACHED + INTEGER IROOT + LOGICAL DOROOT_FWD_OOC, DOROOT_BWD_PANEL + LOGICAL SWITCH_OFF_ES + LOGICAL DUMMY_BOOL + PARAMETER (IZERO = 0 ) + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INCLUDE 'mumps_headers.h' + EXTERNAL CMUMPS_248, CMUMPS_249 + INTEGER, intent(in) :: NZ_RHS, NBCOL_INBLOC, NRHS_ORIG + INTEGER, intent(in) :: SIZE_UNS_PERM_INV + INTEGER, intent(in) :: SIZE_PERM_RHS + INTEGER, intent(in) :: JBEG_RHS + INTEGER, intent(in) :: IRHS_SPARSE(NZ_RHS) + INTEGER, intent(in) :: IRHS_PTR(NBCOL_INBLOC+1) + INTEGER, intent(in) :: PERM_RHS(SIZE_PERM_RHS) + INTEGER, intent(in) :: UNS_PERM_INV(SIZE_UNS_PERM_INV) + INTEGER, intent(in) :: LStep2node + INTEGER, intent(in) :: Step2node(LStep2node) + INTEGER, DIMENSION(:), ALLOCATABLE :: nodes_RHS + INTEGER nb_nodes_RHS + INTEGER nb_prun_leaves + INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_Leaves + INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_List + INTEGER nb_prun_nodes + INTEGER nb_prun_roots, JAM1 + INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_SONS, Pruned_Roots + INTEGER, DIMENSION(:), ALLOCATABLE :: prun_NA + INTEGER :: SIZE_TO_PROCESS + LOGICAL, DIMENSION(:), ALLOCATABLE :: TO_PROCESS + INTEGER ISTEP, INODE_PRINC + LOGICAL AM1, DO_PRUN + LOGICAL Exploit_Sparsity + INTEGER :: OOC_FCT_TYPE_TMP + INTEGER :: MUMPS_808 + EXTERNAL :: MUMPS_808 + MYLEAF = -1 + LP = ICNTL(1) + MP = ICNTL(2) + LDIAG = ICNTL(4) +#if defined(V_T) + CALL VTCLASSDEF( 'Soln_c',soln_c_class,ierr) + CALL VTFUNCDEF( 'forw_soln',soln_c_class,forw_soln,ierr) + CALL VTFUNCDEF( 'back_soln',soln_c_class,back_soln,ierr) + CALL VTFUNCDEF( 'root_soln',soln_c_class,root_soln,ierr) +#endif + NSTK_S = 1 + PTRICB = NSTK_S + KEEP(28) + PTRACB = PTRICB + KEEP(28) + IPOOL = PTRACB + KEEP(28) + LPOOL = KEEP(28)+1 + IPANEL_POS = IPOOL + LPOOL + IF (KEEP(201).EQ.1) THEN + LPANEL_POS = KEEP(228)+1 + ELSE + LPANEL_POS = 1 + ENDIF + IF (IPANEL_POS + LPANEL_POS -1 .ne. LIW1 ) THEN + WRITE(*,*) MYID, ": Internal Error in CMUMPS_245", + & IPANEL_POS, LPANEL_POS, LIW1 + CALL MUMPS_ABORT() + ENDIF + DOFORWARD = .TRUE. + DOBACKWARD= .TRUE. + SPECIAL_ROOT_REACHED = .TRUE. + SWITCH_OFF_ES = .FALSE. + IF ( KEEP(111).NE.0 .OR. KEEP(252).NE.0 ) THEN + DOFORWARD = .FALSE. + ENDIF + IF (KEEP(221).eq.1) DOBACKWARD = .FALSE. + IF (KEEP(221).eq.2) DOFORWARD = .FALSE. + IF ( KEEP(60).EQ.0 .AND. + & ( + & (KEEP(38).NE.0 .AND. root%yes) + & .OR. + & (KEEP(20).NE.0 .AND. MYID_NODES.EQ.MASTER_ROOT) + & ) + & .AND. KEEP(252).EQ.0 + & ) + &THEN + DOROOT = .TRUE. + ELSE + DOROOT = .FALSE. + ENDIF + DOROOT_BWD_PANEL = DOROOT .AND. MTYPE.NE.1 .AND. KEEP(50).EQ.0 + & .AND. KEEP(201).EQ.1 + DOROOT_FWD_OOC = DOROOT .AND. .NOT.DOROOT_BWD_PANEL + AM1 = (KEEP(237) .NE. 0) + Exploit_Sparsity = (KEEP(235) .NE. 0) .AND. (.NOT. AM1) + DO_PRUN = (Exploit_Sparsity.OR.AM1) + IF ( DO_PRUN ) THEN + IF (.not. allocated(Pruned_SONS)) THEN + ALLOCATE (Pruned_SONS(KEEP(28)), stat=I) + IF(I.GT.0) THEN + INFO(1)=-13 + INFO(2)=KEEP(28) + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + END IF + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + IF (.not. allocated(TO_PROCESS)) THEN + SIZE_TO_PROCESS = KEEP(28) + ALLOCATE (TO_PROCESS(SIZE_TO_PROCESS), stat=I) + IF(I.GT.0) THEN + INFO(1)=-13 + INFO(2)=KEEP(28) + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + END IF + TO_PROCESS(:) = .TRUE. + ENDIF + IF ( DOFORWARD .AND. DO_PRUN ) THEN + nb_prun_nodes = 0 + nb_prun_roots = 0 + Pruned_SONS(:) = -1 + IF ( Exploit_Sparsity ) THEN + nb_nodes_RHS = 0 + DO I = 1, NZ_RHS + ISTEP = abs( STEP(IRHS_SPARSE(I)) ) + INODE_PRINC = Step2node( ISTEP ) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_nodes_RHS + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + nb_nodes_RHS = 0 + Pruned_SONS = -1 + DO I = 1, NZ_RHS + ISTEP = abs( STEP(IRHS_SPARSE(I)) ) + INODE_PRINC = Step2node( ISTEP ) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + nodes_RHS(nb_nodes_RHS) = INODE_PRINC + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ELSE IF ( AM1 ) THEN +#if defined(NOT_USED) + IF ( KEEP(201).GT.0) THEN + CALL CMUMPS_789(KEEP(28), + & KEEP(38), KEEP(20) ) + ENDIF +#endif + nb_nodes_RHS = 0 +#if defined(check) + WRITE(*,*) "NBCOL_INBLOC=",NBCOL_INBLOC + WRITE(*,*) "JBEG SIZE=",JBEG_RHS, SIZE(IRHS_PTR) +#endif + DO I = 1, NBCOL_INBLOC + IF ( (IRHS_PTR(I+1)-IRHS_PTR(I)).EQ.0) CYCLE + IF ( (KEEP(242) .NE. 0 ).OR. (KEEP(243).NE.0) ) THEN + JAM1 = PERM_RHS(JBEG_RHS+I-1) + ELSE + JAM1 = JBEG_RHS+I-1 + ENDIF + ISTEP = abs(STEP(JAM1)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_nodes_RHS + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + nb_nodes_RHS = 0 + Pruned_SONS = -1 + DO I = 1, NBCOL_INBLOC + IF ( (IRHS_PTR(I+1)-IRHS_PTR(I)).EQ.0) CYCLE + IF ( (KEEP(242) .NE. 0 ).OR. (KEEP(243).NE.0) ) THEN + JAM1 = PERM_RHS(JBEG_RHS+I-1) + ELSE + JAM1 = JBEG_RHS+I-1 + ENDIF + ISTEP = abs(STEP(JAM1)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + nodes_RHS(nb_nodes_RHS) = INODE_PRINC + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ENDIF + CALL MUMPS_797( + & .FALSE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves ) + ALLOCATE(Pruned_List(nb_prun_nodes), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_nodes + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Roots(nb_prun_roots), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_roots + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Leaves(nb_prun_leaves), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + CALL MUMPS_797( + & .TRUE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves ) + IF(allocated(nodes_RHS)) DEALLOCATE(nodes_RHS) + CALL CMUMPS_809(N, + & KEEP(201), Pruned_List, nb_prun_nodes, + & STEP) + IF ( KEEP(201) .GT. 0) THEN + OOC_FCT_TYPE_TMP=MUMPS_808 + & ('F',MTYPE,KEEP(201),KEEP(50)) + ELSE + OOC_FCT_TYPE_TMP = -5959 + ENDIF + CALL MUMPS_802( + & MYID_NODES, N, KEEP(28), KEEP(201), KEEP8(31), + & STEP, Pruned_List, nb_prun_nodes, OOC_FCT_TYPE_TMP + & ) + SPECIAL_ROOT_REACHED = .FALSE. + DO I= 1, nb_prun_roots + IF ( (Pruned_Roots(I).EQ.KEEP(38)).OR. + & (Pruned_Roots(I).EQ.KEEP(20)) ) THEN + SPECIAL_ROOT_REACHED = .TRUE. + EXIT + ENDIF + ENDDO + ENDIF + IF (KEEP(201).GT.0) THEN + IF (DOFORWARD .OR. DOROOT_FWD_OOC) THEN + CALL CMUMPS_583(PTRFAC,KEEP(28),MTYPE, + & A,LA,DOFORWARD,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + IF (DOFORWARD) THEN + IF ( KEEP( 50 ) .eq. 0 ) THEN + MTYPE_LOC = MTYPE + ELSE + MTYPE_LOC = 1 + ENDIF +#if defined(V_T) + CALL VTBEGIN(forw_soln,ierr) +#endif + IF (.NOT.DO_PRUN) THEN + CALL CMUMPS_248(N, A(1), LA, IW(1), LIW, W(1), + & LWC, RHS, LRHS, NRHS, + & IW1(PTRICB), IWCB, LIWW, + & RHSCOMP,LRHSCOMP,POSINRHSCOMP,BUILD_POSINRHSCOMP, + & NE_STEPS, NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(NSTK_S),IW1(IPOOL),LPOOL,PTRIST,PTRFAC, + & MYLEAF,INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS, SLAVEF, COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, MTYPE_LOC, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + ELSE + ALLOCATE(prun_NA(nb_prun_leaves+nb_prun_roots+2), + & STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves+nb_prun_roots+2 + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(I.LT.0) GOTO 500 + prun_NA(1) = nb_prun_leaves + prun_NA(2) = nb_prun_roots + DO I = 1, nb_prun_leaves + prun_NA(I+2) = Pruned_Leaves(I) + ENDDO + DO I = 1, nb_prun_roots + prun_NA(I+2+nb_prun_leaves) = Pruned_Roots(I) + ENDDO + DEALLOCATE(Pruned_List) + DEALLOCATE(Pruned_Leaves) + IF (AM1) THEN + DEALLOCATE(Pruned_Roots) + END IF + IF ((Exploit_Sparsity).AND.(nb_prun_roots.EQ.NA(2))) THEN + DEALLOCATE(Pruned_Roots) + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + SWITCH_OFF_ES = .TRUE. + ENDIF + CALL CMUMPS_248(N, A(1), LA, IW(1), LIW, W(1), + & LWC, RHS, LRHS, NRHS, + & IW1(PTRICB), IWCB, LIWW, + & RHSCOMP,LRHSCOMP,POSINRHSCOMP,BUILD_POSINRHSCOMP, + & Pruned_SONS, prun_NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(NSTK_S),IW1(IPOOL),LPOOL,PTRIST,PTRFAC, + & MYLEAF,INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS, SLAVEF, COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, MTYPE_LOC, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + DEALLOCATE(prun_NA) + ENDIF + BUILD_POSINRHSCOMP = .FALSE. +#if defined(V_T) + CALL VTEND(forw_soln,ierr) +#endif + ENDIF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF ( INFO(1) .LT. 0 ) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) MYID, + & ': ** ERROR RETURN FROM CMUMPS_248,INFO(1:2)=', + & INFO(1:2) + END IF + GOTO 500 + END IF + CALL MPI_BARRIER( COMM_NODES, IERR ) + IF (DO_PRUN.AND.SWITCH_OFF_ES) THEN + DO_PRUN = .FALSE. + Exploit_Sparsity = .FALSE. + ENDIF + IF ( DOBACKWARD .AND. DO_PRUN ) THEN + nb_prun_leaves = 0 + IF ( Exploit_Sparsity .AND. (KEEP(111).EQ.0) ) THEN + nb_nodes_RHS = nb_prun_roots + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + WRITE(*,*)'Problem with allocation of nodes_RHS' + INFO(1) = -13 + INFO(2) = nb_nodes_RHS + CALL MUMPS_ABORT() + END IF + nodes_RHS(1:nb_prun_roots)=Pruned_Roots(1:nb_prun_roots) + DEALLOCATE(Pruned_Roots) + ELSE + nb_nodes_RHS = 0 + Pruned_SONS(:) = -1 + DO II = 1, NZ_RHS + I = IRHS_SPARSE(II) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + ISTEP = abs(STEP(I)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + WRITE(*,*)'Problem with allocation of nodes_RHS' + INFO(1) = -13 + INFO(2) = nb_nodes_RHS + CALL MUMPS_ABORT() + END IF + nb_nodes_RHS = 0 + Pruned_SONS(:) = -1 + DO II = 1, NZ_RHS + I = IRHS_SPARSE(II) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + ISTEP = abs(STEP(I)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + nodes_RHS(nb_nodes_RHS) = INODE_PRINC + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ENDIF + IF ( Exploit_Sparsity ) THEN + CALL MUMPS_798( + & .FALSE., + & DAD, NE_STEPS, FRERE, KEEP(28), + & FILS, STEP, N, + & nodes_RHS, nb_nodes_RHS, + & TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves + & ) + ALLOCATE(Pruned_List(nb_prun_nodes), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_nodes + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Roots(nb_prun_roots), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_roots + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Leaves(nb_prun_leaves), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + CALL MUMPS_798( + & .TRUE., + & DAD, NE_STEPS, FRERE, KEEP(28), + & FILS, STEP, N, + & nodes_RHS, nb_nodes_RHS, + & TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves + & ) + CALL CMUMPS_809(N, + & KEEP(201), Pruned_List, nb_prun_nodes, + & STEP) + IF(allocated(nodes_RHS)) DEALLOCATE(nodes_RHS) + IF (KEEP(201).GT.0) THEN + OOC_FCT_TYPE_TMP=MUMPS_808 + & ('B',MTYPE,KEEP(201),KEEP(50)) + ELSE + OOC_FCT_TYPE_TMP = -5959 + ENDIF + CALL MUMPS_803( + & MYID_NODES, N, KEEP(28), KEEP(201), + & KEEP8(31), STEP, + & Pruned_List, + & nb_prun_nodes, OOC_FCT_TYPE_TMP) + ENDIF + ENDIF + IF(KEEP(201).EQ.1.AND.DOROOT_BWD_PANEL) THEN + I_WORKED_ON_ROOT = .FALSE. + CALL CMUMPS_584(PTRFAC,KEEP(28),MTYPE, + & I_WORKED_ON_ROOT, IROOT, A, LA, IERR) + IF (IERR .LT. 0) THEN + INFO(1) = -90 + INFO(2) = IERR + ENDIF + ENDIF + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF ( INFO(1) .LT. 0 ) GOTO 500 + ENDIF + IF (KEEP(60).NE.0 .AND. KEEP(221).EQ.0 + & .AND. MYID_NODES .EQ. MASTER_ROOT) THEN + PTR_RHS_ROOT(1:NRHS*SIZE_ROOT) = ZERO + ENDIF + IF ( ( KEEP( 38 ) .NE. 0 ).AND. SPECIAL_ROOT_REACHED ) THEN + IF ( KEEP(60) .EQ. 0 .AND. KEEP(252) .EQ. 0 ) THEN + IF ( root%yes ) THEN + IF (KEEP(201).GT.0) THEN + IF ( (Exploit_Sparsity.AND.(KEEP(111).NE.0)) .and. + & (OOC_STATE_NODE(STEP(KEEP(38))).eq.-6) ) THEN + write(6,*) " CPA to be double checked " + GOTO 1010 + ENDIF + ENDIF + IOLDPS = PTRIST(STEP(KEEP(38))) + LOCAL_M = IW( IOLDPS + 2 + KEEP(IXSZ)) + LOCAL_N = IW( IOLDPS + 1 + KEEP(IXSZ)) + IF (KEEP(201).GT.0) THEN + CALL CMUMPS_643( + & KEEP(38),PTRFAC,KEEP,A,LA, + & STEP,KEEP8,N,DUMMY_BOOL,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + WRITE(*,*) '** ERROR after CMUMPS_643', + & INFO(1) + call MUMPS_ABORT() + ENDIF + ENDIF + IAPOS = PTRFAC(IW( IOLDPS + 4 + KEEP(IXSZ))) +#if defined(V_T) + CALL VTBEGIN(root_soln,ierr) +#endif + CALL CMUMPS_286( NRHS, root%DESCRIPTOR(1), + & root%CNTXT_BLACS, LOCAL_M, LOCAL_N, + & root%MBLOCK, root%NBLOCK, + & root%IPIV(1), root%LPIV, MASTER_ROOT, MYID_NODES, + & COMM_NODES, + & PTR_RHS_ROOT(1), + & root%TOT_ROOT_SIZE, A( IAPOS ), + & INFO(1), MTYPE, KEEP(50)) + IF(KEEP(201).GT.0)THEN + CALL CMUMPS_598(KEEP(38), + & PTRFAC,KEEP(28),A,LA,.FALSE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + WRITE(*,*) + & '** ERROR after CMUMPS_598 ', + & INFO(1) + call MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + ENDIF + ELSE IF ( ( KEEP(20) .NE. 0) .AND. SPECIAL_ROOT_REACHED ) THEN + IF ( MYID_NODES .eq. MASTER_ROOT ) THEN + END IF + END IF +#if defined(V_T) + CALL VTEND(root_soln,ierr) +#endif + 1010 CONTINUE + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + IF (DOBACKWARD) THEN + IF ( KEEP(201).GT.0 .AND. .NOT. DOROOT_BWD_PANEL ) + & THEN + I_WORKED_ON_ROOT = DOROOT + IF (KEEP(111).NE.0) + & I_WORKED_ON_ROOT = .FALSE. + IF (KEEP(38).gt.0 ) THEN + IF ( ( Exploit_Sparsity.AND.(KEEP(111).EQ.0) ) + & .OR. AM1 ) THEN + IF (OOC_STATE_NODE(STEP(KEEP(38))).eq.-6) THEN + OOC_STATE_NODE(STEP(KEEP(38)))=-4 + ENDIF + ENDIF + IF (Exploit_Sparsity.AND.(KEEP(111).NE.0)) THEN + IF (OOC_STATE_NODE(STEP(KEEP(38))).eq.-6) THEN + I_WORKED_ON_ROOT = .FALSE. + ENDIF + ENDIF + ENDIF + ENDIF + IF ( AM1 ) THEN + CALL MUMPS_797( + & .FALSE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves) + ALLOCATE(Pruned_List(nb_prun_nodes), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_nodes + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Roots(nb_prun_roots), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_roots + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Leaves(nb_prun_leaves), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + CALL MUMPS_797( + & .TRUE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves ) + CALL CMUMPS_809(N, + & KEEP(201), Pruned_List, nb_prun_nodes, + & STEP) + IF (KEEP(201).GT.0) THEN + OOC_FCT_TYPE_TMP=MUMPS_808 + & ('B',MTYPE,KEEP(201),KEEP(50)) + ELSE + OOC_FCT_TYPE_TMP = -5959 + ENDIF + CALL MUMPS_802( + & MYID_NODES, N, KEEP(28), KEEP(201), KEEP8(31), + & STEP, Pruned_List, nb_prun_nodes, OOC_FCT_TYPE_TMP + & ) + ENDIF + IF ( KEEP(201).GT.0 ) THEN + IROOT = max(KEEP(20),KEEP(38)) + CALL CMUMPS_584(PTRFAC,KEEP(28),MTYPE, + & I_WORKED_ON_ROOT, IROOT, A, LA, IERR) + ENDIF + IF ( KEEP( 50 ) .eq. 0 ) THEN + MTYPE_LOC = MTYPE + ELSE + MTYPE_LOC = IZERO + ENDIF +#if defined(V_T) + CALL VTBEGIN(back_soln,ierr) +#endif + IF ( .NOT.SPECIAL_ROOT_REACHED ) THEN + PTR_RHS_ROOT(1:NRHS*SIZE_ROOT) = ZERO + ENDIF + IF ( .NOT. DO_PRUN ) THEN + SIZE_TO_PROCESS = 1 + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + ALLOCATE (TO_PROCESS(SIZE_TO_PROCESS), stat=I) + TO_PROCESS(:) = .TRUE. + CALL CMUMPS_249( N, A, LA, IW, LIW, W(1), LWC, + & RHS, LRHS, NRHS, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & IW1(PTRICB),IW1(PTRACB),IWCB,LIWW, + & W2, NE_STEPS, NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(IPOOL),LPOOL,PTRIST,PTRFAC,MYLEAF,INFO, + & PROCNODE_STEPS, SLAVEF, COMM_NODES,MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, KEEP,KEEP8, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, + & MTYPE_LOC, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, IW1(IPANEL_POS), + & LPANEL_POS, TO_PROCESS, SIZE_TO_PROCESS) + ELSE + ALLOCATE(prun_NA(nb_prun_leaves+nb_prun_roots+2), + & STAT=allocok) + IF(allocok.GT.0) THEN + WRITE(*,*)'Problem with allocation of prun_na' + CALL MUMPS_ABORT() + END IF + prun_NA(1) = nb_prun_leaves + prun_NA(2) = nb_prun_roots + DO I = 1, nb_prun_leaves + prun_NA(I+2) = Pruned_Leaves(I) + ENDDO + DO I = 1, nb_prun_roots + prun_NA(I+2+nb_prun_leaves) = Pruned_Roots(I) + ENDDO + CALL CMUMPS_249( N, A, LA, IW, LIW, W(1), LWC, + & RHS, LRHS, NRHS, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & IW1(PTRICB),IW1(PTRACB),IWCB,LIWW, + & W2, NE_STEPS, prun_NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(IPOOL),LPOOL,PTRIST,PTRFAC,MYLEAF,INFO, + & PROCNODE_STEPS, SLAVEF, COMM_NODES,MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, KEEP,KEEP8, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, + & MTYPE_LOC, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, IW1(IPANEL_POS), + & LPANEL_POS, TO_PROCESS, SIZE_TO_PROCESS) + ENDIF +#if defined(V_T) + CALL VTEND(back_soln,ierr) +#endif + ENDIF + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + IF (DOFORWARD) THEN + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + WRITE (MP,99992) + IF (N.GT.0) WRITE (MP,99993) (RHS(I,1),I=1,K) + IF (N.GT.0.and.NRHS>1) + & WRITE (MP,99994) (RHS(I,2),I=1,K) + ENDIF + ENDIF +500 CONTINUE + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + IF (Exploit_Sparsity.OR.AM1.OR.SWITCH_OFF_ES) THEN + IF ( allocated(nodes_RHS)) DEALLOCATE (nodes_RHS) + IF ( allocated(Pruned_SONS)) DEALLOCATE (Pruned_SONS) + IF ( allocated(Pruned_Roots)) DEALLOCATE (Pruned_Roots) + IF ( allocated(prun_NA)) DEALLOCATE (prun_NA) + IF ( allocated(Pruned_List)) DEALLOCATE (Pruned_List) + IF ( allocated(Pruned_Leaves)) DEALLOCATE (Pruned_Leaves) + ENDIF + RETURN +99993 FORMAT (' RHS (first column)'/(1X,1P,5E14.6)) +99994 FORMAT (' RHS (2 nd column)'/(1X,1P,5E14.6)) +99992 FORMAT (//' LEAVING SOLVE (MPI41C) WITH') + END SUBROUTINE CMUMPS_245 + SUBROUTINE CMUMPS_521(NSLAVES, N, MYID, COMM, + & MTYPE, RHS, LRHS, NRHS, PTRIST, + & KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, BUFFER, + & SIZE_BUF, SIZE_BUF_BYTES, CWORK, LCWORK, + & LSCAL, SCALING, LSCALING) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID, COMM, LIW, MTYPE + INTEGER NRHS, LRHS, LCWORK + COMPLEX RHS (LRHS, NRHS) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + COMPLEX :: CWORK(LCWORK) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N) + INTEGER SIZE_BUF, SIZE_BUF_BYTES + INTEGER BUFFER(SIZE_BUF) + LOGICAL, intent(in) :: LSCAL + INTEGER, intent(in) :: LSCALING + REAL, intent(in) :: SCALING(LSCALING) + INTEGER I, II, J, J1, ISTEP, MASTER, + & MYID_NODES, TYPE_PARAL, N2RECV + INTEGER LIELL, IPOS, NPIV, MAXNPIV_estim, MAXSurf + INTEGER STATUS(MPI_STATUS_SIZE), IERR + PARAMETER(MASTER=0) + LOGICAL I_AM_SLAVE + INTEGER RECORD_SIZE_P_1, SIZE1, SIZE2 + INTEGER POS_BUF, N2SEND + INTEGER SK38, SK20 + INTEGER, PARAMETER :: FIN = -1 + INTEGER, PARAMETER :: yes = 1 + INTEGER, PARAMETER :: no = 0 + INTEGER, ALLOCATABLE, DIMENSION(:) :: IROWlist(:) + INTEGER :: ONE_PACK + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + TYPE_PARAL = KEEP(46) + I_AM_SLAVE = MYID .ne. MASTER .OR. TYPE_PARAL .eq. 1 + IF ( TYPE_PARAL == 1 ) THEN + MYID_NODES = MYID + ELSE + MYID_NODES = MYID-1 + ENDIF + IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.1) THEN + IF (LSCAL) THEN + DO J=1, NRHS + DO I=1,N + RHS(I,J) = RHS(I,J)*SCALING(I) + ENDDO + ENDDO + ENDIF + RETURN + ENDIF + IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.0) THEN + DO J=1, NRHS + IF ( I_AM_SLAVE ) THEN + CALL MPI_SEND(RHS(1, J), N, MPI_COMPLEX, MASTER, + & GatherSol, COMM, IERR) + & + ELSE + CALL MPI_RECV(RHS(1, J), N, MPI_COMPLEX, + & 1, + & GatherSol, COMM, STATUS, IERR ) + IF (LSCAL) THEN + DO I=1,N + RHS(I,J) = RHS(I,J)*SCALING(I) + ENDDO + ENDIF + ENDIF + ENDDO + RETURN + ENDIF + MAXNPIV_estim = max(KEEP(246), KEEP(247)) + MAXSurf = MAXNPIV_estim*NRHS + IF (LCWORK .GE. MAXSurf) THEN + ONE_PACK = yes + ELSE IF (LCWORK .GE. MAXNPIV_estim) THEN + ONE_PACK = no + ELSE + WRITE(*,*) + & "Internal error 2 in CMUMPS_521:", + & TYPE_PARAL, LCWORK, KEEP(247), NRHS + CALL MUMPS_ABORT() + ENDIF + IF (ONE_PACK .EQ. no .AND. I_AM_SLAVE) THEN + WRITE(*,*) + & "Internal error 1 in CMUMPS_521:", + & TYPE_PARAL, LCWORK, KEEP(246),KEEP(247), NRHS + CALL MUMPS_ABORT() + ENDIF + IF (TYPE_PARAL .EQ. 0) + &CALL MPI_BCAST(ONE_PACK, 1, MPI_INTEGER, + & MASTER, COMM, IERR) + IF (MYID.EQ.MASTER) THEN + ALLOCATE(IROWlist(KEEP(247))) + ENDIF + IF (NSLAVES .EQ. 1 .AND. TYPE_PARAL .EQ. 1) THEN + CALL MUMPS_ABORT() + ENDIF + SIZE1=0 + CALL MPI_PACK_SIZE(MAXNPIV_estim+2,MPI_INTEGER, COMM, + & SIZE1, IERR) + SIZE2=0 + CALL MPI_PACK_SIZE(MAXSurf,MPI_COMPLEX, COMM, + & SIZE2, IERR) + RECORD_SIZE_P_1= SIZE1+SIZE2 + IF (RECORD_SIZE_P_1.GT.SIZE_BUF_BYTES) THEN + write(6,*) MYID, + & ' Internal error 3 in CMUMPS_521 ' + write(6,*) MYID, ' RECORD_SIZE_P_1, SIZE_BUF_BYTES=', + & RECORD_SIZE_P_1, SIZE_BUF_BYTES + CALL MUMPS_ABORT() + ENDIF + N2SEND =0 + N2RECV =N + POS_BUF =0 + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + IF (I_AM_SLAVE) THEN + POS_BUF = 0 + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & NSLAVES)) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP)+KEEP(IXSZ) + NPIV = IW(IPOS+3) + LIELL = IW(IPOS) + NPIV + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2+ KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .AND. KEEP(50).EQ.0) THEN + J1=IPOS+1+LIELL + ELSE + J1=IPOS+1 + END IF + IF (MYID .EQ. MASTER) THEN + N2RECV=N2RECV-NPIV + IF (NPIV.GT.0.AND.LSCAL) + & CALL CMUMPS_522 ( ONE_PACK, .TRUE. ) + ELSE + IF (NPIV.GT.0) + & CALL CMUMPS_522 ( ONE_PACK, .FALSE.) + ENDIF + ENDIF + ENDDO + CALL CMUMPS_523() + ENDIF + IF ( MYID .EQ. MASTER ) THEN + DO WHILE (N2RECV .NE. 0) + CALL MPI_RECV( BUFFER, SIZE_BUF_BYTES, MPI_PACKED, + & MPI_ANY_SOURCE, + & GatherSol, COMM, STATUS, IERR ) + POS_BUF = 0 + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & NPIV, 1, MPI_INTEGER, COMM, IERR) + DO WHILE (NPIV.NE.FIN) + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & IROWlist, NPIV, MPI_INTEGER, COMM, IERR) + IF (ONE_PACK.EQ.yes) THEN + CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF, + & CWORK, NPIV*NRHS, MPI_COMPLEX, + & COMM, IERR) + IF (LSCAL) THEN + DO J=1, NRHS + DO I=1,NPIV + RHS(IROWlist(I),J)= + & CWORK(I+(J-1)*NPIV)*SCALING(IROWlist(I)) + ENDDO + END DO + ELSE + DO J=1, NRHS + DO I=1,NPIV + RHS(IROWlist(I),J)= CWORK(I+(J-1)*NPIV) + ENDDO + END DO + ENDIF + ELSE + DO J=1,NRHS + CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF, + & CWORK, NPIV, MPI_COMPLEX, + & COMM, IERR) + IF (LSCAL) THEN + DO I=1,NPIV + RHS(IROWlist(I),J)=CWORK(I)*SCALING(IROWlist(I)) + ENDDO + ELSE + DO I=1,NPIV + RHS(IROWlist(I),J)=CWORK(I) + ENDDO + ENDIF + ENDDO + ENDIF + N2RECV=N2RECV-NPIV + CALL MPI_UNPACK( BUFFER, SIZE_BUF_BYTES, POS_BUF, + & NPIV, 1, MPI_INTEGER, COMM, IERR) + ENDDO + ENDDO + DEALLOCATE(IROWlist) + ENDIF + RETURN + CONTAINS + SUBROUTINE CMUMPS_522 ( ONE_PACK, SCALE_ONLY ) + INTEGER, intent(in) :: ONE_PACK + LOGICAL, intent(in) :: SCALE_ONLY + INTEGER III + IF (SCALE_ONLY) THEN + DO II=1,NPIV + I=IW(J1+II-1) + DO J=1, NRHS + RHS(I,J) = RHS(I,J)*SCALING(I) + ENDDO + ENDDO + RETURN + ENDIF + DO II=1,NPIV + I=IW(J1+II-1) + DO J=1, NRHS + CWORK(II+(J-1)*NPIV) = RHS(I,J) + ENDDO + ENDDO + CALL MPI_PACK(NPIV, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_PACK(IW(J1), NPIV, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + IF (ONE_PACK.EQ.yes) THEN + CALL MPI_PACK(CWORK(1), NPIV*NRHS, MPI_COMPLEX, + & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM, + & IERR) + ELSE + III = 1 + DO J=1,NRHS + CALL MPI_PACK(CWORK(III), NPIV, MPI_COMPLEX, + & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM, + & IERR) + III =III+NPIV + ENDDO + ENDIF + N2SEND=N2SEND+NPIV + IF ( POS_BUF + RECORD_SIZE_P_1 > SIZE_BUF_BYTES ) THEN + CALL CMUMPS_523() + END IF + RETURN + END SUBROUTINE CMUMPS_522 + SUBROUTINE CMUMPS_523() + IF (N2SEND .NE. 0) THEN + CALL MPI_PACK(FIN, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_SEND(BUFFER, POS_BUF, MPI_PACKED, MASTER, + & GatherSol, COMM, IERR) + ENDIF + POS_BUF=0 + N2SEND=0 + RETURN + END SUBROUTINE CMUMPS_523 + END SUBROUTINE CMUMPS_521 + SUBROUTINE CMUMPS_812(NSLAVES, N, MYID, COMM, + & RHS, LRHS, NRHS, KEEP, BUFFER, + & SIZE_BUF, SIZE_BUF_BYTES, + & LSCAL, SCALING, LSCALING, + & IRHS_PTR_COPY, LIRHS_PTR_COPY, + & IRHS_SPARSE_COPY, LIRHS_SPARSE_COPY, + & RHS_SPARSE_COPY, LRHS_SPARSE_COPY, + & UNS_PERM_INV, LUNS_PERM_INV, + & POSINRHSCOMP_N, LPOS_N ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID, COMM + INTEGER NRHS, LRHS, LPOS_N + COMPLEX RHS (LRHS, NRHS) + INTEGER KEEP(500) + INTEGER SIZE_BUF, SIZE_BUF_BYTES + INTEGER BUFFER(SIZE_BUF) + INTEGER, intent(in) :: LIRHS_PTR_COPY, LIRHS_SPARSE_COPY, + & LRHS_SPARSE_COPY, LUNS_PERM_INV + INTEGER :: IRHS_SPARSE_COPY(LIRHS_SPARSE_COPY), + & IRHS_PTR_COPY(LIRHS_PTR_COPY), + & UNS_PERM_INV(LUNS_PERM_INV), + & POSINRHSCOMP_N(LPOS_N) + COMPLEX :: RHS_SPARSE_COPY(LRHS_SPARSE_COPY) + LOGICAL, intent(in) :: LSCAL + INTEGER, intent(in) :: LSCALING + REAL, intent(in) :: SCALING(LSCALING) + INTEGER COLSIZE, K, IZ, IPREV, NBCOL_INBLOC + INTEGER I, II, J, MASTER, + & TYPE_PARAL, N2RECV + INTEGER STATUS(MPI_STATUS_SIZE), IERR + PARAMETER(MASTER=0) + LOGICAL I_AM_SLAVE + INTEGER RECORD_SIZE_P_1, SIZE1, SIZE2 + INTEGER POS_BUF, N2SEND + INTEGER, PARAMETER :: FIN = -1 + INCLUDE 'mumps_headers.h' + TYPE_PARAL = KEEP(46) + I_AM_SLAVE = MYID .ne. MASTER .OR. TYPE_PARAL .eq. 1 + NBCOL_INBLOC = size(IRHS_PTR_COPY)-1 + IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.1) THEN + K=1 + DO J = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE.EQ.0) CYCLE + DO IZ=IRHS_PTR_COPY(J), IRHS_PTR_COPY(J+1)-1 + I = IRHS_SPARSE_COPY(IZ) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + IF (POSINRHSCOMP_N(I).NE.0) THEN + IF (LSCAL) THEN + RHS_SPARSE_COPY(IZ)=RHS(I,K)*SCALING(I) + ELSE + RHS_SPARSE_COPY(IZ)=RHS(I,K) + ENDIF + ENDIF + ENDDO + K = K + 1 + ENDDO + RETURN + ENDIF + IF (I_AM_SLAVE) THEN + K=1 + DO J = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE.EQ.0) CYCLE + DO IZ=IRHS_PTR_COPY(J), IRHS_PTR_COPY(J+1)-1 + I = IRHS_SPARSE_COPY(IZ) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + IF (POSINRHSCOMP_N(I).NE.0) THEN + RHS_SPARSE_COPY(IZ)=RHS(I,K) + ENDIF + ENDDO + K = K + 1 + ENDDO + ENDIF + SIZE1=0 + CALL MPI_PACK_SIZE(3,MPI_INTEGER, COMM, + & SIZE1, IERR) + SIZE2=0 + CALL MPI_PACK_SIZE(1,MPI_COMPLEX, COMM, + & SIZE2, IERR) + RECORD_SIZE_P_1= SIZE1+SIZE2 + IF (RECORD_SIZE_P_1.GT.SIZE_BUF_BYTES) THEN + write(6,*) MYID, + & ' Internal error 3 in CMUMPS_812 ' + write(6,*) MYID, ' RECORD_SIZE_P_1, SIZE_BUF_BYTES=', + & RECORD_SIZE_P_1, SIZE_BUF_BYTES + CALL MUMPS_ABORT() + ENDIF + N2SEND =0 + N2RECV =size(IRHS_SPARSE_COPY) + POS_BUF =0 + IF (I_AM_SLAVE) THEN + DO J = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE.LE.0) CYCLE + K = 0 + DO IZ=IRHS_PTR_COPY(J), IRHS_PTR_COPY(J+1)-1 + I = IRHS_SPARSE_COPY(IZ) + II = I + IF (KEEP(23).NE.0) II = UNS_PERM_INV(I) + IF (POSINRHSCOMP_N(II).NE.0) THEN + IF (MYID .EQ. MASTER) THEN + N2RECV=N2RECV-1 + IF (LSCAL) + & CALL CMUMPS_813 ( .TRUE. ) + IRHS_SPARSE_COPY( IRHS_PTR_COPY(J) + K) = + & I + RHS_SPARSE_COPY( IRHS_PTR_COPY(J) + K) = + & RHS_SPARSE_COPY(IZ) + K = K+1 + ELSE + CALL CMUMPS_813 ( .FALSE. ) + ENDIF + ENDIF + ENDDO + IF (MYID.EQ.MASTER) + & IRHS_PTR_COPY(J) = IRHS_PTR_COPY(J) + K + ENDDO + CALL CMUMPS_814() + ENDIF + IF ( MYID .EQ. MASTER ) THEN + DO WHILE (N2RECV .NE. 0) + CALL MPI_RECV( BUFFER, SIZE_BUF_BYTES, MPI_PACKED, + & MPI_ANY_SOURCE, + & GatherSol, COMM, STATUS, IERR ) + POS_BUF = 0 + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & J, 1, MPI_INTEGER, COMM, IERR) + DO WHILE (J.NE.FIN) + IZ = IRHS_PTR_COPY(J) + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & I, 1, MPI_INTEGER, COMM, IERR) + IRHS_SPARSE_COPY(IZ) = I + CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF, + & RHS_SPARSE_COPY(IZ), 1, MPI_COMPLEX, + & COMM, IERR) + IF (LSCAL) THEN + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + RHS_SPARSE_COPY(IZ) = RHS_SPARSE_COPY(IZ)*SCALING(I) + ENDIF + N2RECV=N2RECV-1 + IRHS_PTR_COPY(J) = IRHS_PTR_COPY(J) + 1 + CALL MPI_UNPACK( BUFFER, SIZE_BUF_BYTES, POS_BUF, + & J, 1, MPI_INTEGER, COMM, IERR) + ENDDO + ENDDO + IPREV = 1 + DO J=1, size(IRHS_PTR_COPY)-1 + I= IRHS_PTR_COPY(J) + IRHS_PTR_COPY(J) = IPREV + IPREV = I + ENDDO + ENDIF + RETURN + CONTAINS + SUBROUTINE CMUMPS_813 ( SCALE_ONLY ) + LOGICAL, intent(in) :: SCALE_ONLY + INTEGER III + IF (SCALE_ONLY) THEN + III = I + IF (KEEP(23).NE.0) III = UNS_PERM_INV(I) + IF (LSCAL) THEN + RHS_SPARSE_COPY(IZ)=RHS_SPARSE_COPY(IZ)*SCALING(III) + ENDIF + RETURN + ENDIF + CALL MPI_PACK(J, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_PACK(I, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_PACK(RHS_SPARSE_COPY(IZ), 1, MPI_COMPLEX, + & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM, + & IERR) + N2SEND=N2SEND+1 + IF ( POS_BUF + RECORD_SIZE_P_1 > SIZE_BUF_BYTES ) THEN + CALL CMUMPS_814() + END IF + RETURN + END SUBROUTINE CMUMPS_813 + SUBROUTINE CMUMPS_814() + IF (N2SEND .NE. 0) THEN + CALL MPI_PACK(FIN, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_SEND(BUFFER, POS_BUF, MPI_PACKED, MASTER, + & GatherSol, COMM, IERR) + ENDIF + POS_BUF=0 + N2SEND=0 + RETURN + END SUBROUTINE CMUMPS_814 + END SUBROUTINE CMUMPS_812 + SUBROUTINE CMUMPS_535(MTYPE, ISOL_LOC, + & PTRIST, KEEP,KEEP8, + & IW, LIW_PASSED, MYID_NODES, N, STEP, + & PROCNODE, NSLAVES, scaling_data, LSCAL) + IMPLICIT NONE + INTEGER MTYPE, MYID_NODES, N, NSLAVES + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE(KEEP(28)) + INTEGER ISOL_LOC(KEEP(89)) + INTEGER LIW_PASSED + INTEGER IW(LIW_PASSED) + INTEGER STEP(N) + LOGICAL LSCAL + type scaling_data_t + SEQUENCE + REAL, dimension(:), pointer :: SCALING + REAL, dimension(:), pointer :: SCALING_LOC + end type scaling_data_t + type (scaling_data_t) :: scaling_data + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER ISTEP, K + INTEGER J1, IPOS, LIELL, NPIV, JJ + INTEGER SK38,SK20 + INCLUDE 'mumps_headers.h' + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + K=0 + DO ISTEP=1, KEEP(28) + IF ( MYID_NODES == MUMPS_275( PROCNODE(ISTEP), + & NSLAVES)) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP)+KEEP(IXSZ) + LIELL = IW(IPOS+3) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 + KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .AND. KEEP(50).EQ.0) THEN + J1=IPOS+1+LIELL + ELSE + J1=IPOS+1 + END IF + DO JJ=J1,J1+NPIV-1 + K=K+1 + ISOL_LOC(K)=IW(JJ) + IF (LSCAL) THEN + scaling_data%SCALING_LOC(K)= + & scaling_data%SCALING(IW(JJ)) + ENDIF + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_535 + SUBROUTINE CMUMPS_532( + & SLAVEF, N, MYID_NODES, + & MTYPE, RHS, LD_RHS, NRHS, + & ISOL_LOC, SOL_LOC, BEG_RHS, LSOL_LOC, + & PTRIST, + & PROCNODE_STEPS, KEEP,KEEP8, IW, LIW, STEP, + & scaling_data, LSCAL, NB_RHSSKIPPED) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + type scaling_data_t + SEQUENCE + REAL, dimension(:), pointer :: SCALING + REAL, dimension(:), pointer :: SCALING_LOC + end type scaling_data_t + TYPE (scaling_data_t) :: scaling_data + LOGICAL LSCAL + INTEGER SLAVEF, N, MYID_NODES, LIW, MTYPE, NRHS, LD_RHS + INTEGER LSOL_LOC, BEG_RHS, NB_RHSSKIPPED + INTEGER ISOL_LOC(LSOL_LOC) + COMPLEX SOL_LOC( LSOL_LOC, BEG_RHS+NRHS+NB_RHSSKIPPED-1) + COMPLEX RHS( LD_RHS , NRHS) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N) + INTEGER JJ, J1, ISTEP, K, JEMPTY, JEND + INTEGER IPOS, LIELL, NPIV + LOGICAL ROOT + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + K=0 + JEMPTY = BEG_RHS+NB_RHSSKIPPED-1 + JEND = BEG_RHS+NB_RHSSKIPPED+NRHS-1 + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & SLAVEF)) THEN + ROOT=.false. + IF (KEEP(38).ne.0) ROOT = STEP(KEEP(38))==ISTEP + IF (KEEP(20).ne.0) ROOT = STEP(KEEP(20))==ISTEP + IF ( ROOT ) THEN + IPOS = PTRIST(ISTEP) + KEEP(IXSZ) + LIELL = IW(IPOS+3) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2 +KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .AND. KEEP(50).EQ.0) THEN + J1=IPOS+1+LIELL + ELSE + J1=IPOS+1 + END IF + DO JJ=J1,J1+NPIV-1 + K=K+1 + IF (NB_RHSSKIPPED.GT.0) + & SOL_LOC(K, BEG_RHS:JEMPTY) = ZERO + IF (LSCAL) THEN + SOL_LOC(K,JEMPTY+1:JEND) = + & scaling_data%SCALING_LOC(K)*RHS(IW(JJ),1:NRHS) + ELSE + SOL_LOC(K,JEMPTY+1:JEND) = + & RHS(IW(JJ),1:NRHS) + ENDIF + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_532 + SUBROUTINE CMUMPS_638 + & (NSLAVES, N, MYID, COMM, + & MTYPE, RHS, LRHS, NRHS, PTRIST, + & KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, + & POSINRHSCOMP, LENPOSINRHSCOMP, + & BUILD_POSINRHSCOMP, ICNTL, INFO) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID, COMM, LIW, MTYPE + INTEGER NRHS, LRHS, LENPOSINRHSCOMP + INTEGER ICNTL(40), INFO(40) + COMPLEX RHS (LRHS, NRHS) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N), POSINRHSCOMP(LENPOSINRHSCOMP) + LOGICAL BUILD_POSINRHSCOMP + INTEGER BUF_MAXSIZE, BUF_MAXREF + PARAMETER (BUF_MAXREF=200000) + INTEGER, ALLOCATABLE, DIMENSION(:) :: BUF_INDX + COMPLEX, ALLOCATABLE, DIMENSION(:,:) :: BUF_RHS + INTEGER ENTRIES_2_PROCESS, PROC_WHO_ASKS, BUF_EFFSIZE + INTEGER INDX + INTEGER allocok + COMPLEX ZERO + PARAMETER( ZERO = (0.0E0,0.0E0) ) + INTEGER I, K, JJ, J1, ISTEP, MASTER, + & MYID_NODES, TYPE_PARAL + INTEGER LIELL, IPOS, NPIV + INTEGER STATUS(MPI_STATUS_SIZE), IERR + PARAMETER(MASTER=0) + LOGICAL I_AM_SLAVE + INTEGER SK38, SK20, IPOSINRHSCOMP + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + TYPE_PARAL = KEEP(46) + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + I_AM_SLAVE = MYID .ne. 0 .OR. TYPE_PARAL .eq. 1 + IF ( TYPE_PARAL == 1 ) THEN + MYID_NODES = MYID + ELSE + MYID_NODES = MYID-1 + ENDIF + BUF_EFFSIZE = 0 + BUF_MAXSIZE = max(min(BUF_MAXREF,int(2000000/NRHS)),2000) + ALLOCATE (BUF_INDX(BUF_MAXSIZE), + & BUF_RHS(NRHS,BUF_MAXSIZE), + & stat=allocok) + IF (allocok .GT. 0) THEN + INFO(1)=-13 + INFO(2)=BUF_MAXSIZE*(NRHS+1) + ENDIF + CALL MUMPS_276(ICNTL, INFO, COMM, MYID ) + IF (INFO(1).LT.0) RETURN + IF (MYID.EQ.MASTER) THEN + ENTRIES_2_PROCESS = N - KEEP(89) + DO WHILE ( ENTRIES_2_PROCESS .NE. 0) + CALL MPI_RECV( BUF_INDX, BUF_MAXSIZE, MPI_INTEGER, + & MPI_ANY_SOURCE, + & ScatterRhsI, COMM, STATUS, IERR ) + CALL MPI_GET_COUNT( STATUS, MPI_INTEGER, BUF_EFFSIZE, IERR ) + PROC_WHO_ASKS = STATUS(MPI_SOURCE) + DO I = 1, BUF_EFFSIZE + INDX = BUF_INDX( I ) + DO K = 1, NRHS + BUF_RHS( K, I ) = RHS( INDX, K ) + RHS( BUF_INDX(I), K ) = ZERO + ENDDO + ENDDO + CALL MPI_SEND( BUF_RHS, NRHS*BUF_EFFSIZE, + & MPI_COMPLEX, PROC_WHO_ASKS, + & ScatterRhsR, COMM, IERR) + ENTRIES_2_PROCESS = ENTRIES_2_PROCESS - BUF_EFFSIZE + ENDDO + BUF_EFFSIZE= 0 + ENDIF + IF (I_AM_SLAVE) THEN + IF (BUILD_POSINRHSCOMP) THEN + IPOSINRHSCOMP = 1 + POSINRHSCOMP = -9678 + ENDIF + IF (MYID.NE.MASTER) RHS = ZERO + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & NSLAVES)) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP) + LIELL = IW(IPOS+3+KEEP(IXSZ)) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2+ KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .OR. KEEP(50).NE.0) THEN + J1=IPOS+1 + ELSE + J1=IPOS+1+LIELL + END IF + IF (BUILD_POSINRHSCOMP) THEN + POSINRHSCOMP(ISTEP) = IPOSINRHSCOMP + IPOSINRHSCOMP = IPOSINRHSCOMP + NPIV + ENDIF + IF (MYID.NE.MASTER) THEN + DO JJ=J1,J1+NPIV-1 + BUF_EFFSIZE = BUF_EFFSIZE + 1 + BUF_INDX(BUF_EFFSIZE) = IW(JJ) + IF (BUF_EFFSIZE + 1 .GT. BUF_MAXSIZE) THEN + CALL CMUMPS_640() + ENDIF + ENDDO + ENDIF + ENDIF + ENDDO + IF ( BUF_EFFSIZE .NE. 0 .AND. MYID.NE.MASTER ) + & CALL CMUMPS_640() + ENDIF + DEALLOCATE (BUF_INDX, BUF_RHS) + RETURN + CONTAINS + SUBROUTINE CMUMPS_640() + CALL MPI_SEND(BUF_INDX, BUF_EFFSIZE, MPI_INTEGER, + & MASTER, ScatterRhsI, COMM, IERR ) + CALL MPI_RECV(BUF_RHS, BUF_EFFSIZE*NRHS, + & MPI_COMPLEX, + & MASTER, + & ScatterRhsR, COMM, STATUS, IERR ) + DO I = 1, BUF_EFFSIZE + INDX = BUF_INDX(I) + DO K = 1, NRHS + RHS( INDX, K ) = BUF_RHS( K, I ) + ENDDO + ENDDO + BUF_EFFSIZE = 0 + RETURN + END SUBROUTINE CMUMPS_640 + END SUBROUTINE CMUMPS_638 + SUBROUTINE CMUMPS_639 + & (NSLAVES, N, MYID_NODES, + & PTRIST, + & KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, + & POSINRHSCOMP, POSINRHSCOMP_N, LPIRC_N, MTYPE, + & WHAT ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID_NODES, LIW + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N), POSINRHSCOMP(KEEP(28)) + INTEGER LPIRC_N, WHAT, MTYPE + INTEGER POSINRHSCOMP_N(LPIRC_N) + INTEGER ISTEP + INTEGER NPIV + INTEGER SK38, SK20, IPOS, LIELL + INTEGER JJ, J1 + INTEGER IPOSINRHSCOMP + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + IF (WHAT .NE. 0.AND. WHAT.NE.1.AND.WHAT.NE.2) THEN + WRITE(*,*) "Internal error in CMUMPS_639" + CALL MUMPS_ABORT() + ENDIF + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + IPOSINRHSCOMP = 1 + POSINRHSCOMP = -9678 + IF (WHAT .NE. 0) THEN + POSINRHSCOMP_N = 0 + ENDIF + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & NSLAVES)) THEN + IPOS = PTRIST(ISTEP) + NPIV = IW(IPOS+3+KEEP(IXSZ)) + POSINRHSCOMP(ISTEP) = IPOSINRHSCOMP + IF (WHAT .NE. 0) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP) + LIELL = IW(IPOS+3+KEEP(IXSZ)) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2+ KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + ENDIF + IF (MTYPE.eq.1 .OR. KEEP(50).NE.0) THEN + J1=IPOS+1 + ELSE + J1=IPOS+1+LIELL + END IF + DO JJ = J1, J1+NPIV-1 + POSINRHSCOMP_N(IW(JJ)) = IPOSINRHSCOMP+JJ-J1 + END DO + ENDIF + IPOSINRHSCOMP = IPOSINRHSCOMP + NPIV + ENDIF + ENDDO + RETURN + END SUBROUTINE CMUMPS_639 + SUBROUTINE CMUMPS_248(N, A, LA, IW, LIW, WCB, LWCB, + & RHS, LRHS, NRHS, + & PTRICB, IWCB, LIWCB, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, BUILD_POSINRHSCOMP, + & NE_STEPS, NA, LNA, STEP, + & FRERE, DAD, FILS, + & NSTK_S, IPOOL, LPOOL, PTRIST, PTRFAC, MYLEAF, INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS, + & SLAVEF, COMM, MYID, BUFR, LBUFR, LBUFR_BYTES, + & RHS_ROOT, LRHS_ROOT, MTYPE, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE CMUMPS_OOC + IMPLICIT NONE + INTEGER MTYPE + INTEGER(8) :: LA + INTEGER N, LIW, LWCB, LPOOL, LIWCB, LNA + INTEGER SLAVEF, MYLEAF, COMM, MYID + INTEGER INFO( 40 ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER LRHS, NRHS + COMPLEX A( LA ), RHS( LRHS, NRHS ), WCB( LWCB ) + INTEGER LRHS_ROOT + COMPLEX RHS_ROOT( LRHS_ROOT ) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER NA( LNA ), NE_STEPS( KEEP(28) ) + INTEGER STEP( N ), FRERE( KEEP(28) ), FILS( N ), + & DAD( KEEP(28) ) + INTEGER NSTK_S(KEEP(28)), IPOOL( LPOOL ) + INTEGER PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PTRICB( KEEP(28) ) + INTEGER IW( LIW ), IWCB( LIWCB ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER POSINRHSCOMP(KEEP(28)), LRHSCOMP + LOGICAL BUILD_POSINRHSCOMP + COMPLEX RHSCOMP( LRHSCOMP, NRHS ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER MSGTAG, MSGSOU, DUMMY(1) + LOGICAL FLAG + INTEGER NBFIN, MYROOT + INTEGER POSIWCB,POSWCB,PLEFTWCB + INTEGER INODE + INTEGER RHSCOMPFREEPOS + INTEGER I + INTEGER III, NBROOT,LEAF + LOGICAL BLOQ + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + POSIWCB = LIWCB + POSWCB = LWCB + PLEFTWCB= 1 + IF (BUILD_POSINRHSCOMP) RHSCOMPFREEPOS= 1 + DO I = 1, KEEP(28) + NSTK_S(I) = NE_STEPS(I) + ENDDO + PTRICB = 0 + CALL MUMPS_362(N, LEAF, NBROOT, MYROOT, MYID, + & SLAVEF, NA, LNA, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, IPOOL, LPOOL) + NBFIN = SLAVEF + IF ( MYROOT .EQ. 0 ) THEN + NBFIN = NBFIN - 1 + DUMMY(1) = 1 + CALL CMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, + & RACINE_SOLVE, SLAVEF) + END IF + MYLEAF = LEAF - 1 + III = 1 + 50 CONTINUE + IF (SLAVEF .EQ. 1) THEN + CALL CMUMPS_574 + & ( IPOOL(1), LPOOL, III, LEAF, INODE, + & KEEP(208) ) + GOTO 60 + ENDIF + BLOQ = ( ( III .EQ. LEAF ) + & ) + CALL CMUMPS_303( BLOQ, FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 .OR. NBFIN .EQ. 0 ) GOTO 260 + IF (.not. FLAG) THEN + IF (III .NE. LEAF) THEN + CALL CMUMPS_574 + & (IPOOL(1), LPOOL, III, LEAF, INODE, + & KEEP(208) ) + GOTO 60 + ENDIF + ENDIF + GOTO 50 + 60 CONTINUE + CALL CMUMPS_302( INODE, BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, N, + & IPOOL, LPOOL, III, LEAF, NBFIN, NSTK_S, + & IWCB, LIWCB, WCB, LWCB, A, LA, + & IW, LIW, RHS, LRHS, NRHS, + & POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS, + & FILS, STEP, FRERE, DAD, + & MYROOT, INFO, KEEP,KEEP8, RHS_ROOT, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & RHSCOMPFREEPOS, BUILD_POSINRHSCOMP, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( INFO( 1 ) .LT. 0 .OR. NBFIN .EQ. 0 ) GOTO 260 + GOTO 50 + 260 CONTINUE + CALL CMUMPS_150( MYID,COMM,BUFR, + & LBUFR,LBUFR_BYTES ) + RETURN + END SUBROUTINE CMUMPS_248 + RECURSIVE SUBROUTINE CMUMPS_323 + & ( BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, + & PTRFAC, IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, + & INFO, KEEP,KEEP8, STEP, PROCNODE_STEPS, + & RHS, LRHS + & ) + USE CMUMPS_OOC + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER LBUFR, LBUFR_BYTES + INTEGER MSGTAG, MSGSOU, MYID, SLAVEF, COMM + INTEGER LIW + INTEGER(8) :: LA + INTEGER N, NRHS, LPOOL, III, LEAF, NBFIN + INTEGER LIWCB, LWCB, POSWCB, PLEFTWCB, POSIWCB + INTEGER INFO( 40 ), KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER BUFR( LBUFR ) + INTEGER IPOOL( LPOOL ), NSTK_S( N ) + INTEGER IWCB( LIWCB ) + INTEGER IW( LIW ) + INTEGER PTRICB(KEEP(28)),PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N) + INTEGER PROCNODE_STEPS(KEEP(28)) + COMPLEX WCB( LWCB ), A( LA ) + INTEGER LRHS + COMPLEX RHS(LRHS, NRHS) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, K, JJ + INTEGER FINODE, FPERE, LONG, NCB, POSITION, NCV, NPIV + INTEGER PTRX, PTRY, PDEST, I + INTEGER(8) :: APOS + LOGICAL DUMMY + LOGICAL FLAG + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + COMPLEX ALPHA, ONE + PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0)) + INCLUDE 'mumps_headers.h' + IF ( MSGTAG .EQ. RACINE_SOLVE ) THEN + NBFIN = NBFIN - 1 + IF ( NBFIN .eq. 0 ) GOTO 270 + ELSE IF (MSGTAG .EQ. ContVec ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FINODE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FPERE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NCB, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LONG, 1, MPI_INTEGER, COMM, IERR ) + IF ( NCB .eq. 0 ) THEN + PTRICB(STEP(FINODE)) = -1 + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF ( NSTK_S(STEP(FPERE)) .EQ. 0 ) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + IF ( LEAF > LPOOL ) THEN + WRITE(*,*) 'Internal error 41r2 : Pool is too small.' + CALL MUMPS_ABORT() + END IF + END IF + ELSE + IF ( PTRICB(STEP(FINODE)) .EQ. 0 ) THEN + PTRICB(STEP(FINODE)) = NCB + 1 + END IF + IF ( ( POSIWCB - LONG ) .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = LONG + GOTO 260 + END IF + IF ( POSWCB - PLEFTWCB + 1 .LT. LONG * NRHS) THEN + INFO( 1 ) = -11 + INFO( 2 ) = PLEFTWCB - POSWCB - 1 + LONG * NRHS + GOTO 260 + END IF + IF (LONG .GT. 0) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IWCB( 1 ), + & LONG, MPI_INTEGER, COMM, IERR ) + DO K = 1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WCB( PLEFTWCB ), + & LONG, MPI_COMPLEX, COMM, IERR ) + DO I = 1, LONG + RHS(IWCB(I),K) = RHS(IWCB(I),K) +WCB(PLEFTWCB+I-1) + ENDDO + END DO + PTRICB(STEP(FINODE)) = PTRICB(STEP(FINODE)) - LONG + ENDIF + IF ( PTRICB(STEP(FINODE)) == 1 ) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + END IF + IF ( NSTK_S(STEP(FPERE)) .EQ. 0 ) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + IF ( LEAF > LPOOL ) THEN + WRITE(*,*) 'Internal error 41r2 : Pool is too small.' + CALL MUMPS_ABORT() + END IF + ENDIF + END IF + ELSEIF ( MSGTAG .EQ. Master2Slave ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FINODE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FPERE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NCV, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NPIV, 1, MPI_INTEGER, COMM, IERR ) + PTRY = PLEFTWCB + PTRX = PLEFTWCB + NCV * NRHS + PLEFTWCB = PLEFTWCB + (NPIV + NCV) * NRHS + IF ( POSWCB - PLEFTWCB + 1 .LT. 0 ) THEN + INFO(1) = -11 + INFO(2) = -POSWCB + PLEFTWCB -1 + GO TO 260 + END IF + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WCB( PTRY + (K-1) * NCV ), NCV, + & MPI_COMPLEX, COMM, IERR ) + ENDDO + IF ( NPIV .GT. 0 ) THEN + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WCB( PTRX + (K-1)*NPIV ), NPIV, + & MPI_COMPLEX, COMM, IERR ) + END DO + END IF + IF (KEEP(201).GT.0) THEN + CALL CMUMPS_643( + & FINODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,DUMMY,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + APOS = PTRFAC(STEP(FINODE)) + IF (KEEP(201).EQ.1) THEN + IF ( NRHS == 1 ) THEN + CALL cgemv( 'N', NCV, NPIV, ALPHA, A(APOS), NCV, + & WCB( PTRX ), 1, ONE, + & WCB( PTRY ), 1 ) + ELSE + CALL cgemm( 'N', 'N', NCV, NRHS, NPIV, ALPHA, + & A(APOS), NCV, + & WCB( PTRX), NPIV, ONE, + & WCB( PTRY), NCV ) + ENDIF + ELSE + IF ( NRHS == 1 ) THEN + CALL cgemv( 'T', NPIV, NCV, ALPHA, A(APOS), NPIV, + & WCB( PTRX ), 1, ONE, + & WCB( PTRY ), 1 ) + ELSE + CALL cgemm( 'T', 'N', NCV, NRHS, NPIV, ALPHA, + & A(APOS), NPIV, + & WCB( PTRX), NPIV, ONE, + & WCB( PTRY), NCV ) + ENDIF + ENDIF + IF (KEEP(201).GT.0) THEN + CALL CMUMPS_598(FINODE,PTRFAC, + & KEEP(28),A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + PLEFTWCB = PLEFTWCB - NPIV * NRHS + PDEST = MUMPS_275( PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF ) + IF ( PDEST .EQ. MYID ) THEN + IF ( PTRICB(STEP(FINODE)) .EQ. 0 ) THEN + NCB = IW( PTRIST(STEP(FINODE)) + 2 + KEEP(IXSZ) ) + PTRICB(STEP(FINODE)) = NCB + 1 + END IF + DO I = 1, NCV + JJ=IW(PTRIST(STEP(FINODE))+3+I+ KEEP(IXSZ) ) + DO K=1, NRHS + RHS(JJ,K)= RHS(JJ,K) + WCB(PTRY+I-1+(K-1)*NCV) + ENDDO + END DO + PTRICB(STEP(FINODE)) = + & PTRICB(STEP(FINODE)) - NCV + IF ( PTRICB( STEP( FINODE ) ) == 1 ) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + END IF + IF ( NSTK_S(STEP(FPERE)) .EQ. 0 ) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + IF ( LEAF > LPOOL ) THEN + WRITE(*,*) 'INTERNAL Error 41r: Pool is too small.' + CALL MUMPS_ABORT() + END IF + ENDIF + ELSE + 210 CONTINUE + CALL CMUMPS_78( NRHS, FINODE, FPERE, + & IW(PTRIST(STEP( FINODE )) + 2 + KEEP(IXSZ) ), NCV,NCV, + & IW(PTRIST(STEP(FINODE))+4+ KEEP(IXSZ) ), + & WCB( PTRY ), PDEST, ContVec, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL CMUMPS_303( .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 210 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = ( NCV + 4 ) * KEEP( 34 ) + + & NCV * KEEP( 35 ) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = ( NCV + 4 ) * KEEP( 34 ) + + & NCV * KEEP( 35 ) + END IF + END IF + PLEFTWCB = PLEFTWCB - NCV * NRHS + ELSEIF ( MSGTAG .EQ. TERREUR ) THEN + INFO(1) = -001 + INFO(2) = MSGSOU + GOTO 270 + ELSE IF ( (MSGTAG.EQ.UPDATE_LOAD).OR. + & (MSGTAG.EQ.TAG_DUMMY) ) THEN + GO TO 270 + ELSE + INFO(1)=-100 + INFO(2)=MSGTAG + GO TO 260 + ENDIF + GO TO 270 + 260 CONTINUE + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + 270 CONTINUE + RETURN + END SUBROUTINE CMUMPS_323 + SUBROUTINE CMUMPS_302( INODE, + & BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, + & N, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, + & IWCB, LIWCB, + & WCB, LWCB, A, LA, IW, LIW, + & RHS, LRHS, NRHS, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS, + & FILS, STEP, FRERE, DAD, + & MYROOT, + & INFO, KEEP,KEEP8, RHS_ROOT, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & RHSCOMPFREEPOS, BUILD_POSINRHSCOMP, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & + & ) + USE CMUMPS_OOC + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER MTYPE + INTEGER INODE, LBUFR, LBUFR_BYTES + INTEGER MSGTAG, MSGSOU, MYID, SLAVEF, COMM + INTEGER LIWCB, LWCB, LIW, POSWCB, PLEFTWCB, POSIWCB + INTEGER(8) :: LA + INTEGER N, LPOOL, III, LEAF, NBFIN + INTEGER MYROOT + INTEGER INFO( 40 ), KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER BUFR( LBUFR ) + INTEGER IPOOL( LPOOL ), NSTK_S(KEEP(28)) + INTEGER IWCB( LIWCB ), IW( LIW ) + INTEGER LRHS, NRHS + COMPLEX WCB( LWCB ), A( LA ) + COMPLEX RHS(LRHS, NRHS ), RHS_ROOT( * ) + INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER FILS( N ), STEP( N ), FRERE(KEEP(28)), DAD(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER POSINRHSCOMP(KEEP(28)), LRHSCOMP, RHSCOMPFREEPOS + COMPLEX RHSCOMP(LRHSCOMP, NRHS) + LOGICAL BUILD_POSINRHSCOMP + EXTERNAL cgemv, ctrsv, cgemm, ctrsm, MUMPS_275 + INTEGER MUMPS_275 + COMPLEX ALPHA,ONE,ZERO + PARAMETER (ZERO=(0.0E0,0.0E0), + & ONE=(1.0E0,0.0E0), + & ALPHA=(-1.0E0,0.0E0)) + INTEGER(8) :: APOS, APOS1, APOS2, APOSOFF + INTEGER I, J, K, IPOS, NSLAVES, J1, J2, J3, FPERE, NPIV, NCB, + & IERR, IFR_ini, + & IFR, LIELL, JJ, + & NELIM, PLEFT, PCB_COURANT, PPIV_COURANT + INTEGER IPOSINRHSCOMP + INTEGER Effective_CB_Size, NUPDATE, ISLAVE, PDEST, FirstIndex + LOGICAL FLAG, OMP_FLAG + INCLUDE 'mumps_headers.h' + INTEGER POSWCB1,POSWCB2 + INTEGER(8) :: APOSDEB + INTEGER TempNROW, TempNCOL, PANEL_SIZE, LIWFAC, + & JFIN, NBJ, NUPDATE_PANEL, + & PPIV_PANEL, PCB_PANEL, NBK, TYPEF + INTEGER LD_WCBPIV + INTEGER LD_WCBCB + INTEGER LDAJ, LDAJ_FIRST_PANEL + INTEGER TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPANEL + LOGICAL MUST_BE_PERMUTED + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER DUMMY( 1 ) + IF ( INODE .eq. KEEP( 38 ) .OR. INODE .eq.KEEP( 20 ) ) THEN + LIELL = IW( PTRIST( STEP(INODE)) + 3 + KEEP(IXSZ)) + NPIV = LIELL + NELIM = 0 + NSLAVES = 0 + IPOS = PTRIST( STEP(INODE)) + 5 + KEEP(IXSZ) + ELSE + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + NELIM = IW(IPOS-1) + NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) ) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + IPOS = IPOS + 1 + IF (KEEP(201).GT.0) THEN + CALL CMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL CMUMPS_755( + & IW(IPOS+1+2*LIELL+1+NSLAVES), + & MUST_BE_PERMUTED ) + ENDIF + ENDIF + NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ)) + IPOS = IPOS + 1 + NSLAVES + END IF + IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN + J1 = IPOS + 1 + J2 = IPOS + LIELL + J3 = IPOS + NPIV + ELSE + J1 = IPOS + LIELL + 1 + J2 = IPOS + 2 * LIELL + J3 = IPOS + LIELL + NPIV + END IF + NCB = LIELL-NPIV + IF ( INODE .eq. KEEP( 38 ) .OR. INODE .eq. KEEP(20) ) THEN + IFR = 0 + DO JJ = J1, J3 + J = IW( JJ ) + IFR = IFR + 1 + DO K=1,NRHS + RHS_ROOT(IFR+NPIV*(K-1)) = RHS(J,K) + END DO + END DO + IF ( NPIV .LT. LIELL ) THEN + WRITE(*,*) ' Internal error in SOLVE_NODE for Root node' + CALL MUMPS_ABORT() + END IF + MYROOT = MYROOT - 1 + IF ( MYROOT .EQ. 0 ) THEN + NBFIN = NBFIN - 1 + IF (SLAVEF .GT. 1) THEN + DUMMY (1) = 1 + CALL CMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, + & COMM, RACINE_SOLVE, SLAVEF) + ENDIF + END IF + GO TO 270 + END IF + APOS = PTRFAC(STEP(INODE)) + IF (KEEP(201).EQ.1) THEN + IF (MTYPE.EQ.1) THEN + IF ((MTYPE.EQ.1).AND.NSLAVES.NE.0) THEN + TempNROW= NPIV+NELIM + TempNCOL= NPIV + LDAJ_FIRST_PANEL=TempNROW + ELSE + TempNROW= LIELL + TempNCOL= NPIV + LDAJ_FIRST_PANEL=TempNROW + ENDIF + TYPEF=TYPEF_L + ELSE + TempNCOL= LIELL + TempNROW= NPIV + LDAJ_FIRST_PANEL=TempNCOL + TYPEF= TYPEF_U + ENDIF + LIWFAC = IW(PTRIST(STEP(INODE))+XXI) + PANEL_SIZE = CMUMPS_690( LDAJ_FIRST_PANEL ) + ENDIF + PLEFT = PLEFTWCB + PPIV_COURANT = PLEFTWCB + PLEFTWCB = PLEFTWCB + LIELL * NRHS + IF ( POSWCB - PLEFTWCB + 1 .LT. 0 ) THEN + INFO(1) = -11 + INFO(2) = PLEFTWCB - POSWCB - 1 + GO TO 260 + END IF + IF (KEEP(201).EQ.1) THEN + LD_WCBPIV = LIELL + LD_WCBCB = LIELL + PCB_COURANT = PPIV_COURANT + NPIV + DO K=1, NRHS + IFR = PPIV_COURANT + (K-1)*LIELL - 1 + DO JJ = J1, J3 + J = IW(JJ) + IFR = IFR + 1 + WCB(IFR) = RHS(J,K) + ENDDO + IF (NCB.GT.0) THEN + DO JJ = J3+1, J2 + J = IW(JJ) + IFR = IFR + 1 + WCB(IFR) = RHS(J,K) + RHS (J,K) = ZERO + ENDDO + ENDIF + END DO + ELSE + LD_WCBPIV = NPIV + LD_WCBCB = NCB + PCB_COURANT = PPIV_COURANT + NPIV*NRHS + IFR = PPIV_COURANT - 1 + OMP_FLAG = NRHS.GT.4 + IFR_ini = IFR + DO 130 JJ = J1, J3 + J = IW(JJ) + IFR = IFR_ini + (JJ-J1) + 1 + DO K=1, NRHS + WCB(IFR+(K-1)*NPIV) = RHS(J,K) + END DO + 130 CONTINUE + IFR = PCB_COURANT - 1 + IF (NPIV .LT. LIELL) THEN + IFR_ini = IFR + DO 140 JJ = J3 + 1, J2 + J = IW(JJ) + IFR = IFR_ini + (JJ-J3) + DO K=1, NRHS + WCB(IFR+(K-1)*NCB) = RHS(J,K) + RHS(J,K)=ZERO + ENDDO + 140 CONTINUE + ENDIF + ENDIF + IF ( NPIV .NE. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + APOSDEB = APOS + J = 1 + IPANEL = 0 + 10 CONTINUE + IPANEL = IPANEL + 1 + JFIN = min(J+PANEL_SIZE-1, NPIV) + IF (IW(IPOS+ LIELL + JFIN) < 0) THEN + JFIN=JFIN+1 + ENDIF + NBJ = JFIN-J+1 + LDAJ = LDAJ_FIRST_PANEL-J+1 + IF ( (KEEP(50).NE.1).AND. MUST_BE_PERMUTED ) THEN + CALL CMUMPS_667(TYPEF, TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPOS+1+2*LIELL, IW, LIW) + IF (NPIV.EQ.(IW(I_PIVRPTR+IPANEL-1)-1)) THEN + MUST_BE_PERMUTED=.FALSE. + ELSE + CALL CMUMPS_698( + & IW( I_PIVR+ IW(I_PIVRPTR+IPANEL-1)- + & IW(I_PIVRPTR)), + & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, + & IW(I_PIVRPTR+IPANEL-1)-1, + & + & A(APOSDEB), + & LDAJ, NBJ, J-1 ) + ENDIF + ENDIF + NUPDATE_PANEL = LDAJ - NBJ + PPIV_PANEL = PPIV_COURANT+J-1 + PCB_PANEL = PPIV_PANEL+NBJ + APOS1 = APOSDEB+int(NBJ,8) + IF (MTYPE.EQ.1) THEN + IF ( NRHS == 1 ) THEN + CALL ctrsv( 'L', 'N', 'U', NBJ, A(APOSDEB), LDAJ, + & WCB(PPIV_PANEL), 1 ) + IF (NUPDATE_PANEL.GT.0) THEN + CALL cgemv('N', NUPDATE_PANEL,NBJ,ALPHA, A(APOS1), + & LDAJ, WCB(PPIV_PANEL), 1, ONE, + & WCB(PCB_PANEL), 1) + ENDIF + ELSE + CALL ctrsm( 'L','L','N','U', NBJ, NRHS, ONE, + & A(APOSDEB), LDAJ, WCB(PPIV_PANEL), + & LIELL ) + IF (NUPDATE_PANEL.GT.0) THEN + CALL cgemm('N', 'N', NUPDATE_PANEL, NRHS, NBJ, + & ALPHA, + & A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE, + & WCB(PCB_PANEL), LIELL) + ENDIF + ENDIF + ELSE + IF (NRHS == 1) THEN + CALL ctrsv( 'L', 'N', 'N', NBJ, A(APOSDEB), LDAJ, + & WCB(PPIV_PANEL), 1 ) + IF (NUPDATE_PANEL.GT.0) THEN + CALL cgemv('N',NUPDATE_PANEL, NBJ, ALPHA, A(APOS1), + & LDAJ, WCB(PPIV_PANEL), 1, + & ONE, WCB(PCB_PANEL), 1 ) + ENDIF + ELSE + CALL ctrsm('L','L','N','N',NBJ, NRHS, ONE, + & A(APOSDEB), LDAJ, WCB(PPIV_PANEL), + & LIELL) + IF (NUPDATE_PANEL.GT.0) THEN + CALL cgemm('N', 'N', NUPDATE_PANEL, NRHS, NBJ, + & ALPHA, + & A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE, + & WCB(PCB_PANEL), LIELL) + ENDIF + ENDIF + ENDIF + APOSDEB = APOSDEB+int(LDAJ,8)*int(NBJ,8) + J=JFIN+1 + IF ( J .LE. NPIV ) GOTO 10 + ELSE + IF (KEEP(50).NE.0) THEN + IF ( NRHS == 1 ) THEN + CALL ctrsv( 'U', 'T', 'U', NPIV, A(APOS), NPIV, + & WCB(PPIV_COURANT), 1 ) + ELSE + CALL ctrsm( 'L','U','T','U', NPIV, NRHS, ONE, + & A(APOS), NPIV, WCB(PPIV_COURANT), + & NPIV ) + ENDIF + ELSE + IF ( MTYPE .eq. 1 ) THEN + IF ( NRHS == 1) THEN + CALL ctrsv( 'U', 'T', 'U', NPIV, A(APOS), LIELL, + & WCB(PPIV_COURANT), 1 ) + ELSE + CALL ctrsm( 'L','U','T','U', NPIV, NRHS, ONE, + & A(APOS), LIELL, WCB(PPIV_COURANT), + & NPIV ) + ENDIF + ELSE + IF (NRHS == 1) THEN + CALL ctrsv( 'L', 'N', 'N', NPIV, A(APOS), LIELL, + & WCB(PPIV_COURANT), 1 ) + ELSE + CALL ctrsm('L','L','N','N',NPIV, NRHS, ONE, + & A(APOS), LIELL, WCB(PPIV_COURANT), + & NPIV) + ENDIF + END IF + END IF + END IF + END IF + NCB = LIELL - NPIV + IF ( MTYPE .EQ. 1 ) THEN + IF ( KEEP(50) .eq. 0 ) THEN + APOS1 = APOS + int(NPIV,8) * int(LIELL,8) + ELSE + APOS1 = APOS + int(NPIV,8) * int(NPIV,8) + END IF + IF ( NSLAVES .EQ. 0 .OR. NPIV .eq. 0 ) THEN + NUPDATE = NCB + ELSE + NUPDATE = NELIM + END IF + ELSE + APOS1 = APOS + int(NPIV,8) + NUPDATE = NCB + END IF + IF (KEEP(201).NE.1) THEN + IF ( NPIV .NE. 0 .AND. NUPDATE.NE.0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + IF ( NRHS == 1 ) THEN + CALL cgemv('T', NPIV, NUPDATE, ALPHA, A(APOS1), + & NPIV, WCB(PPIV_COURANT), 1, ONE, + & WCB(PCB_COURANT), 1) + ELSE + CALL cgemm('T', 'N', NUPDATE, NRHS, NPIV, ALPHA, + & A(APOS1), NPIV, WCB(PPIV_COURANT), NPIV, ONE, + & WCB(PCB_COURANT), NCB) + END IF + ELSE + IF ( NRHS == 1 ) THEN + CALL cgemv('N',NUPDATE, NPIV, ALPHA, A(APOS1), + & LIELL, WCB(PPIV_COURANT), 1, + & ONE, WCB(PCB_COURANT), 1 ) + ELSE + CALL cgemm('N', 'N', NUPDATE, NRHS, NPIV, ALPHA, + & A(APOS1), LIELL, WCB(PPIV_COURANT), NPIV, ONE, + & WCB(PCB_COURANT), NCB) + END IF + END IF + END IF + END IF + IF (BUILD_POSINRHSCOMP) THEN + POSINRHSCOMP(STEP(INODE)) = RHSCOMPFREEPOS + RHSCOMPFREEPOS = RHSCOMPFREEPOS + NPIV + ENDIF + IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + IF ( KEEP(50) .eq. 0 ) THEN + DO K=1,NRHS + IFR = PPIV_COURANT + (K-1)*LD_WCBPIV + RHSCOMP(IPOSINRHSCOMP:IPOSINRHSCOMP+NPIV-1, K) = + & WCB(IFR:IFR+NPIV-1) + ENDDO + ELSE + IFR = PPIV_COURANT - 1 + IF (KEEP(201).EQ.1) THEN + LDAJ = TempNROW + ELSE + LDAJ = NPIV + ENDIF + APOS1 = APOS + JJ = J1 + IF (KEEP(201).EQ.1) THEN + NBK = 0 + ENDIF + DO + IF(JJ .GT. J3) EXIT + IFR = IFR + 1 + IF(IW(JJ+LIELL) .GT. 0) THEN + DO K=1, NRHS + RHSCOMP(IPOSINRHSCOMP+JJ-J1 , K ) = + & WCB( IFR+(K-1)*LD_WCBPIV ) * A( APOS1 ) + END DO + IF (KEEP(201).EQ.1) THEN + NBK = NBK+1 + IF (NBK.EQ.PANEL_SIZE) THEN + NBK = 0 + LDAJ = LDAJ - PANEL_SIZE + ENDIF + ENDIF + APOS1 = APOS1 + int(LDAJ + 1,8) + JJ = JJ+1 + ELSE + IF (KEEP(201).EQ.1) THEN + NBK = NBK+1 + ENDIF + APOS2 = APOS1+int(LDAJ+1,8) + IF (KEEP(201).EQ.1) THEN + APOSOFF = APOS1+int(LDAJ,8) + ELSE + APOSOFF=APOS1+1_8 + ENDIF + DO K=1, NRHS + POSWCB1 = IFR+(K-1)*LD_WCBPIV + POSWCB2 = POSWCB1+1 + RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = WCB(POSWCB1)*A(APOS1) + & + WCB(POSWCB2)*A(APOSOFF) + RHSCOMP(IPOSINRHSCOMP+JJ-J1+1,K) = + & WCB(POSWCB1)*A(APOSOFF) + & + WCB(POSWCB2)*A(APOS2) + END DO + IF (KEEP(201).EQ.1) THEN + NBK = NBK+1 + IF (NBK.GE.PANEL_SIZE) THEN + LDAJ = LDAJ - NBK + NBK = 0 + ENDIF + ENDIF + APOS1 = APOS2 + int(LDAJ + 1,8) + JJ = JJ+2 + IFR = IFR+1 + ENDIF + ENDDO + END IF + IF (KEEP(201).GT.0) THEN + CALL CMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + END IF + FPERE = DAD(STEP(INODE)) + IF ( FPERE .EQ. 0 ) THEN + MYROOT = MYROOT - 1 + PLEFTWCB = PLEFTWCB - LIELL *NRHS + IF ( MYROOT .EQ. 0 ) THEN + NBFIN = NBFIN - 1 + IF (SLAVEF .GT. 1) THEN + DUMMY (1) = 1 + CALL CMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, + & COMM, RACINE_SOLVE, SLAVEF) + ENDIF + END IF + GO TO 270 + ENDIF + IF ( NUPDATE .NE. 0 .OR. NCB.eq.0 ) THEN + IF (MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .EQ. MYID) THEN + IF ( NCB .ne. 0 ) THEN + PTRICB(STEP(INODE)) = NCB + 1 + DO 190 I = 1, NUPDATE + DO K=1, NRHS + RHS( IW(J3 + I), K ) = RHS( IW(J3 + I), K ) + & + WCB(PCB_COURANT + I-1 +(K-1)*LD_WCBCB) + ENDDO + 190 CONTINUE + PTRICB(STEP( INODE )) = PTRICB(STEP( INODE )) - NUPDATE + IF ( PTRICB(STEP(INODE)) == 1 ) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF (NSTK_S(STEP(FPERE)) .EQ. 0) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + ENDIF + END IF + ELSE + PTRICB(STEP( INODE )) = -1 + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF (NSTK_S(STEP(FPERE)) .EQ. 0) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + ENDIF + ENDIF + ELSE + 210 CONTINUE + CALL CMUMPS_78( NRHS, INODE, FPERE, NCB, LD_WCBCB, + & NUPDATE, + & IW( J3 + 1 ), WCB( PCB_COURANT ), + & MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), SLAVEF), + & ContVec, + & COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL CMUMPS_303( .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 210 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = NUPDATE * KEEP( 35 ) + + & ( NUPDATE + 3 ) * KEEP( 34 ) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = NUPDATE * KEEP( 35 ) + + & ( NUPDATE + 3 ) * KEEP( 34 ) + GOTO 260 + END IF + ENDIF + END IF + IF ( NSLAVES .NE. 0 .AND. MTYPE .eq. 1 + & .and. NPIV .NE. 0 ) THEN + DO ISLAVE = 1, NSLAVES + PDEST = IW( PTRIST(STEP(INODE)) + 5 + ISLAVE +KEEP(IXSZ)) + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB - NELIM, + & NSLAVES, + & Effective_CB_Size, FirstIndex ) + 222 CALL CMUMPS_72( NRHS, + & INODE, FPERE, + & Effective_CB_Size, LD_WCBCB, LD_WCBPIV, NPIV, + & WCB( PCB_COURANT + NELIM + FirstIndex - 1 ), + & WCB( PPIV_COURANT ), + & PDEST, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL CMUMPS_303( .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 222 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = (NPIV+Effective_CB_Size)*NRHS*KEEP(35) + + & ( Effective_CB_Size + 4 ) * KEEP( 34 ) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = (NPIV+Effective_CB_Size)*NRHS*KEEP(35) + + & ( Effective_CB_Size + 4 ) * KEEP( 34 ) + GOTO 260 + END IF + END DO + END IF + PLEFTWCB = PLEFTWCB - LIELL*NRHS + 270 CONTINUE + RETURN + 260 CONTINUE + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE CMUMPS_302 + RECURSIVE SUBROUTINE CMUMPS_303( BLOQ, FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, PROCNODE_STEPS, + & RHS, LRHS + & ) + IMPLICIT NONE + LOGICAL BLOQ + INTEGER LBUFR, LBUFR_BYTES + INTEGER MYID, SLAVEF, COMM + INTEGER N, NRHS, LPOOL, III, LEAF, NBFIN + INTEGER LIWCB, LWCB, POSWCB, PLEFTWCB, POSIWCB + INTEGER LIW + INTEGER(8) :: LA + INTEGER INFO( 40 ), KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER BUFR( LBUFR ), IPOOL(LPOOL) + INTEGER NSTK_S( KEEP(28) ) + INTEGER IWCB( LIWCB ) + INTEGER IW( LIW ) + COMPLEX WCB( LWCB ), A( LA ) + INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER LRHS + COMPLEX RHS(LRHS, NRHS) + LOGICAL FLAG + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + INTEGER MSGSOU, MSGTAG, MSGLEN + FLAG = .FALSE. + IF ( BLOQ ) THEN + CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, + & COMM, STATUS, IERR ) + FLAG = .TRUE. + ELSE + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + END IF + IF ( FLAG ) THEN + MSGSOU = STATUS( MPI_SOURCE ) + MSGTAG = STATUS( MPI_TAG ) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) + IF ( MSGLEN .GT. LBUFR_BYTES ) THEN + INFO(1) = -20 + INFO(2) = MSGLEN + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + ELSE + CALL MPI_RECV( BUFR, LBUFR_BYTES, MPI_PACKED, + & MSGSOU, MSGTAG, COMM, STATUS, IERR ) + CALL CMUMPS_323( BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + END IF + END IF + RETURN + END SUBROUTINE CMUMPS_303 + SUBROUTINE CMUMPS_249(N, A, LA, IW, LIW, W, LWC, + & RHS, LRHS, NRHS, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & PTRICB, PTRACB, IWCB, LIWW, W2, + & NE_STEPS, NA, LNA, STEP, + & FRERE, DAD, FILS, IPOOL, LPOOL, PTRIST, PTRFAC, + & MYLEAF, INFO, + & PROCNODE_STEPS, + & SLAVEF, COMM,MYID, BUFR, LBUFR, LBUFR_BYTES, + & KEEP,KEEP8, RHS_ROOT, LRHS_ROOT, MTYPE, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, PANEL_POS, LPANEL_POS + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + USE CMUMPS_OOC + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER MTYPE + INTEGER(8) :: LA + INTEGER N,LIW,LIWW,LWC,LPOOL,LNA + INTEGER SLAVEF,MYLEAF,COMM,MYID + INTEGER LPANEL_POS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER NA(LNA),NE_STEPS(KEEP(28)) + INTEGER IPOOL(LPOOL) + INTEGER PANEL_POS(LPANEL_POS) + INTEGER INFO(40) + INTEGER PTRIST(KEEP(28)), + & PTRICB(KEEP(28)),PTRACB(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER LRHS, NRHS + COMPLEX A(LA), RHS(LRHS,NRHS), W(LWC) + COMPLEX W2(KEEP(133)) + INTEGER IW(LIW),IWCB(LIWW) + INTEGER STEP(N), FRERE(KEEP(28)),DAD(KEEP(28)),FILS(N) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR(LBUFR) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28)) + COMPLEX RHSCOMP(LRHSCOMP,NRHS) + INTEGER LRHS_ROOT + COMPLEX RHS_ROOT( LRHS_ROOT ) + INTEGER, intent(in) :: SIZE_TO_PROCESS + LOGICAL, intent(in) :: TO_PROCESS(SIZE_TO_PROCESS) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + LOGICAL FLAG + INTEGER POSIWCB,POSWCB,K + INTEGER(8) :: APOS, IST + INTEGER NPIV + INTEGER IPOS,LIELL,NELIM,IFR,JJ,I + INTEGER J1,J2,J,NCB,NBFINF + INTEGER NBLEAF,INODE,NBROOT,NROOT,NBFILS + INTEGER IN,IF,LONG,POOL_FIRST_POS,TMP + INTEGER III,IIPOOL,MYLEAFE + INTEGER NSLAVES + COMPLEX ALPHA,ONE,ZERO + PARAMETER (ZERO=(0.0E0,0.0E0), + & ONE=(1.0E0,0.0E0), + & ALPHA=(-1.0E0,0.0E0)) + LOGICAL BLOQ,DEBUT + INTEGER PROCDEST, DEST + INTEGER POSINDICES, IPOSINRHSCOMP + INTEGER DUMMY(1) + INTEGER PLEFTW, PTWCB + INTEGER Offset, EffectiveSize, ISLAVE, FirstIndex + LOGICAL LTLEVEL2, IN_SUBTREE + INTEGER TYPENODE + INCLUDE 'mumps_headers.h' + LOGICAL BLOCK_SEQUENCE + INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR + LOGICAL MUST_BE_PERMUTED + LOGICAL NO_CHILDREN + LOGICAL Exploit_Sparsity, AM1 + LOGICAL DEJA_SEND( 0:SLAVEF-1 ) + INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS + INTEGER LDAJ, NBJ, LIWFAC, + & NBJLAST, NPIV_LAST, PANEL_SIZE, + & PTWCB_PANEL, NCB_PANEL, TYPEF + INTEGER BEG_PANEL + LOGICAL TWOBYTWO + INTEGER NPANELS, IPANEL + LOGICAL MUMPS_170 + INTEGER MUMPS_330 + EXTERNAL cgemv, ctrsv, ctrsm, cgemm, + & MUMPS_330, + & MUMPS_170 + PLEFTW = 1 + POSIWCB = LIWW + POSWCB = LWC + NROOT = 0 + NBLEAF = NA(1) + NBROOT = NA(2) + DO I = NBROOT, 1, -1 + INODE = NA(NBLEAF+I+2) + IF (MUMPS_275(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) .EQ. MYID) THEN + NROOT = NROOT + 1 + IPOOL(NROOT) = INODE + ENDIF + END DO + III = 1 + IIPOOL = NROOT + 1 + BLOCK_SEQUENCE = .FALSE. + Exploit_Sparsity = .FALSE. + AM1 = .FALSE. + IF (KEEP(235).NE.0) Exploit_Sparsity = .TRUE. + IF (KEEP(237).NE.0) AM1 = .TRUE. + NO_CHILDREN = .FALSE. + IF (Exploit_Sparsity .OR. AM1) MYLEAF = -1 + IF (MYLEAF .EQ. -1) THEN + MYLEAF = 0 + DO I=1, NBLEAF + INODE=NA(I+2) + IF (MUMPS_275(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) .EQ. MYID) THEN + MYLEAF = MYLEAF + 1 + ENDIF + ENDDO + ENDIF + MYLEAFE=MYLEAF + NBFINF = SLAVEF + IF (MYLEAFE .EQ. 0) THEN + CALL CMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, FEUILLE, + & SLAVEF) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) THEN + GOTO 340 + ENDIF + ENDIF + 50 CONTINUE + BLOQ = ( ( III .EQ. IIPOOL ) + & ) + CALL CMUMPS_41( BLOQ, FLAG, BUFR, LBUFR, + & LBUFR_BYTES, MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO(1) .LT. 0 ) GOTO 340 + IF ( .NOT. FLAG ) THEN + IF (III .NE. IIPOOL) THEN + INODE = IPOOL(IIPOOL-1) + IIPOOL = IIPOOL - 1 + GO TO 60 + ENDIF + END IF + IF ( NBFINF .eq. 0 ) GOTO 340 + GOTO 50 + 60 CONTINUE + IF ( INODE .EQ. KEEP( 38 ) .OR. INODE .EQ. KEEP( 20 ) ) THEN + IPOS = PTRIST(STEP(INODE))+KEEP(IXSZ) + NPIV = IW(IPOS+3) + LIELL = IW(IPOS) + NPIV + IPOS = PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) + IF ( MTYPE .EQ. 1 .AND. KEEP(50) .EQ. 0) THEN + J1 = IPOS + LIELL + 1 + J2 = IPOS + LIELL + NPIV + ELSE + J1 = IPOS + 1 + J2 = IPOS + NPIV + END IF + IFR = 0 + DO JJ = J1, J2 + J = IW( JJ ) + IFR = IFR + 1 + DO K=1,NRHS + RHS(J,K) = RHS_ROOT(IFR+NPIV*(K-1)) + END DO + END DO + IN = INODE + 270 IN = FILS(IN) + IF (IN .GT. 0) GOTO 270 + IF (IN .EQ. 0) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL CMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + ENDIF + GOTO 50 + ENDIF + IF = -IN + LONG = NPIV + NBFILS = NE_STEPS(STEP(INODE)) + IF ( AM1 ) THEN + I = NBFILS + NBFILS = 0 + DO WHILE (I.GT.0) + IF ( TO_PROCESS(STEP(IF)) ) NBFILS = NBFILS+1 + IF = FRERE(STEP(IF)) + I = I -1 + ENDDO + IF (NBFILS.EQ.0) THEN + NO_CHILDREN = .TRUE. + ELSE + NO_CHILDREN = .FALSE. + ENDIF + IF = -IN + ENDIF + DEBUT = .TRUE. + DO I = 0, SLAVEF - 1 + DEJA_SEND( I ) = .FALSE. + END DO + POOL_FIRST_POS=IIPOOL + DO I = 1, NBFILS + IF ( AM1 ) THEN + 1030 IF ( .NOT.TO_PROCESS(STEP(IF)) ) THEN + IF = FRERE(STEP(IF)) + GOTO 1030 + ENDIF + NO_CHILDREN = .FALSE. + ENDIF + IF (MUMPS_275(PROCNODE_STEPS(STEP(IF)),SLAVEF) + & .EQ. MYID) THEN + IPOOL(IIPOOL) = IF + IIPOOL = IIPOOL + 1 + ELSE + PROCDEST = MUMPS_275(PROCNODE_STEPS(STEP(IF)), + & SLAVEF) + IF (.NOT. DEJA_SEND( PROCDEST )) THEN + 600 CALL CMUMPS_78( NRHS, IF, 0, 0, + & LONG, LONG, IW( J1 ), + & RHS_ROOT( 1 ), PROCDEST, + & NOEUD, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL CMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 340 + GOTO 600 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = LONG * KEEP(35) + + & ( LONG + 2 ) * KEEP(34) + GOTO 330 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = LONG * KEEP(35) + + & ( LONG + 2 ) * KEEP(34) + GOTO 330 + END IF + DEJA_SEND( PROCDEST ) = .TRUE. + END IF + IF ( IERR .NE. 0 ) CALL MUMPS_ABORT() + ENDIF + IF = FRERE(STEP(IF)) + ENDDO + IF (AM1 .AND.NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL CMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + GOTO 50 + ENDIF + ENDIF + IF (IIPOOL.NE.POOL_FIRST_POS) THEN + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + ENDIF + GOTO 50 + END IF + IN_SUBTREE = MUMPS_170( + & PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + TYPENODE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + LTLEVEL2= ( + & (TYPENODE .eq.2 ) .AND. + & (MTYPE.NE.1) ) + NPIV = IW(PTRIST(STEP(INODE))+2+KEEP(IXSZ)+1) + IF ((NPIV.NE.0).AND.(LTLEVEL2)) THEN + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + NELIM = IW(IPOS-1) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + NCB = LIELL - NPIV - NELIM + IPOS = IPOS + 2 + NSLAVES = IW( IPOS ) + Offset = 0 + IPOS = IPOS + NSLAVES + IW(PTRIST(STEP(INODE))+XXS)= C_FINI+NSLAVES + IF ( POSIWCB - 2 .LT. 0 .or. + & POSWCB - NCB*NRHS .LT. PLEFTW - 1 ) THEN + CALL CMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - NCB*NRHS .LT. PLEFTW - 1 ) THEN + INFO( 1 ) = -11 + INFO( 2 ) = NCB * NRHS - POSWCB - PLEFTW + 1 + GOTO 330 + END IF + IF ( POSIWCB - 2 .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = 2 - POSIWCB + GO TO 330 + END IF + END IF + POSIWCB = POSIWCB - 2 + POSWCB = POSWCB - NCB*NRHS + PTRICB(STEP( INODE )) = POSIWCB + 1 + PTRACB(STEP( INODE )) = POSWCB + 1 + IWCB( PTRICB(STEP( INODE )) ) = NCB + IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 + IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN + POSINDICES = IPOS + LIELL + 1 + ELSE + POSINDICES = IPOS + 1 + END IF + IF ( NCB.EQ.0 ) THEN + write(6,*) ' Internal Error type 2 node with no CB ' + CALL MUMPS_ABORT() + ENDIF + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN + J1 = IPOS + LIELL + NPIV + NELIM +1 + J2 = IPOS + 2 * LIELL + ELSE + J1 = IPOS + NPIV + NELIM +1 + J2 = IPOS + LIELL + END IF + IFR = PTRACB(STEP( INODE )) - 1 + DO JJ = J1, J2 - KEEP(253) + J = IW(JJ) + IFR = IFR + 1 + DO K=1, NRHS + W(IFR+(K-1)*NCB) = RHS(J,K) + ENDDO + ENDDO + IF (KEEP(252).NE.0) THEN + DO JJ = J2-KEEP(253)+1, J2 + IFR = IFR + 1 + DO K=1, NRHS + IF (K.EQ.JJ-J2+KEEP(253)) THEN + W(IFR+(K-1)*NCB) = ALPHA + ELSE + W(IFR+(K-1)*NCB) = ZERO + ENDIF + ENDDO + ENDDO + ENDIF + DO ISLAVE = 1, NSLAVES + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB, + & NSLAVES, + & EffectiveSize, + & FirstIndex ) + 500 DEST = IW( PTRIST(STEP(INODE))+5+ISLAVE+KEEP(IXSZ)) + CALL CMUMPS_63(NRHS, INODE, + & W(Offset+PTRACB(STEP(INODE))), EffectiveSize, + & NCB, DEST, + & BACKSLV_MASTER2SLAVE, + & COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL CMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, + & PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 340 + GOTO 500 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = EffectiveSize * KEEP(35) + + & 2 * KEEP(34) + GOTO 330 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = EffectiveSize * KEEP(35) + + & 2 * KEEP(34) + GOTO 330 + END IF + Offset = Offset + EffectiveSize + END DO + IWCB( PTRICB(STEP( INODE )) + 1 ) = 0 + CALL CMUMPS_151(NRHS,N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB,POSIWCB,PTRICB,PTRACB) + GOTO 50 + ENDIF + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + NELIM = IW(IPOS-1) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + IPOS = IPOS + 1 + IF (KEEP(201).GT.0) THEN + CALL CMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 330 + ENDIF + ENDIF + APOS = PTRFAC(IW(IPOS)) + NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) ) + IPOS = IPOS + 1 + NSLAVES + IF (KEEP(201).EQ.1) THEN + LIWFAC = IW(PTRIST(STEP(INODE))+XXI) + IF (MTYPE.NE.1) THEN + TYPEF = TYPEF_L + ELSE + TYPEF = TYPEF_U + ENDIF + PANEL_SIZE = CMUMPS_690( LIELL ) + IF (KEEP(50).NE.1) THEN + CALL CMUMPS_755( + & IW(IPOS+1+2*LIELL), + & MUST_BE_PERMUTED ) + ENDIF + ENDIF + LONG = 0 + IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN + J1 = IPOS + 1 + J2 = IPOS + NPIV + ELSE + J1 = IPOS + LIELL + 1 + J2 = IPOS + NPIV + LIELL + END IF + IF (IN_SUBTREE) THEN + PTWCB = PLEFTW + IF ( POSWCB .LT. LIELL*NRHS ) THEN + CALL CMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB .LT. LIELL*NRHS ) THEN + INFO(1) = -11 + INFO(2) = LIELL*NRHS - POSWCB + GOTO 330 + END IF + END IF + ELSE + IF ( POSIWCB - 2 .LT. 0 .or. + & POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + CALL CMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + INFO( 1 ) = -11 + INFO( 2 ) = LIELL * NRHS - POSWCB - PLEFTW + 1 + GOTO 330 + END IF + IF ( POSIWCB - 2 .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = 2 - POSIWCB + GO TO 330 + END IF + END IF + POSIWCB = POSIWCB - 2 + POSWCB = POSWCB - LIELL*NRHS + PTRICB(STEP( INODE )) = POSIWCB + 1 + PTRACB(STEP( INODE )) = POSWCB + 1 + IWCB( PTRICB(STEP( INODE )) ) = LIELL + IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 + IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN + POSINDICES = IPOS + LIELL + 1 + ELSE + POSINDICES = IPOS + 1 + END IF + PTWCB = PTRACB(STEP( INODE )) + ENDIF + IF (KEEP(252).EQ.0) IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + DO K=1, NRHS + IF (KEEP(252).NE.0) THEN + DO JJ = J1, J2 + W(PTWCB+JJ-J1+(K-1)*LIELL) = ZERO + ENDDO + ELSE + DO JJ = J1, J2 + W(PTWCB+JJ-J1+(K-1)*LIELL) = RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + ENDDO + ENDIF + END DO + IFR = PTWCB + NPIV - 1 + IF ( LIELL .GT. NPIV ) THEN + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN + J1 = IPOS + LIELL + NPIV + 1 + J2 = IPOS + 2 * LIELL + ELSE + J1 = IPOS + NPIV + 1 + J2 = IPOS + LIELL + END IF + DO JJ = J1, J2-KEEP(253) + J = IW(JJ) + IFR = IFR + 1 + DO K=1, NRHS + W(IFR+(K-1)*LIELL) = RHS(J,K) + ENDDO + ENDDO + IF (KEEP(252).NE.0) THEN + DO JJ = J2-KEEP(253)+1, J2 + IFR = IFR + 1 + DO K=1, NRHS + IF (K.EQ.JJ-J2+KEEP(253)) THEN + W(IFR+(K-1)*LIELL) = ALPHA + ELSE + W(IFR+(K-1)*LIELL) = ZERO + ENDIF + ENDDO + ENDDO + ENDIF + NCB = LIELL - NPIV + IF (NPIV .EQ. 0) GOTO 160 + ENDIF + IF (KEEP(201).EQ.1) THEN + J = NPIV / PANEL_SIZE + TWOBYTWO = KEEP(50).EQ.2 .AND. + & ((TYPENODE.EQ.1.AND.KEEP(103).GT.0) .OR. + & (TYPENODE.EQ.2.AND.KEEP(105).GT.0)) + IF (TWOBYTWO) THEN + CALL CMUMPS_641(PANEL_SIZE, PANEL_POS, LPANEL_POS, + & IW(IPOS+1+LIELL), NPIV, NPANELS, LIELL, + & NBENTRIES_ALLPANELS) + ELSE + IF (NPIV.EQ.J*PANEL_SIZE) THEN + NPIV_LAST = NPIV + NBJLAST = PANEL_SIZE + NPANELS = J + ELSE + NPIV_LAST = (J+1)* PANEL_SIZE + NBJLAST = NPIV-J*PANEL_SIZE + NPANELS = J+1 + ENDIF + NBENTRIES_ALLPANELS = + & int(LIELL,8) * int(NPIV,8) + & - int( ( J * ( J - 1 ) ) / 2,8 ) + & * int(PANEL_SIZE,8) * int(PANEL_SIZE,8) + & - int(J,8) + & * int(mod(NPIV, PANEL_SIZE),8) + & * int(PANEL_SIZE,8) + JJ=NPIV_LAST + ENDIF + APOSDEB = APOS + NBENTRIES_ALLPANELS + DO IPANEL = NPANELS, 1, -1 + IF (TWOBYTWO) THEN + NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL) + BEG_PANEL = PANEL_POS(IPANEL) + ELSE + IF (JJ.EQ.NPIV_LAST) THEN + NBJ = NBJLAST + ELSE + NBJ = PANEL_SIZE + ENDIF + BEG_PANEL = JJ- PANEL_SIZE+1 + ENDIF + LDAJ = LIELL-BEG_PANEL+1 + APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8) + PTWCB_PANEL = PTWCB + BEG_PANEL - 1 + NCB_PANEL = LDAJ - NBJ + IF (KEEP(50).NE.1 .AND. MUST_BE_PERMUTED) THEN + CALL CMUMPS_667(TYPEF, TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW) + IF (NPIV.EQ.(IW(I_PIVRPTR)-1)) THEN + MUST_BE_PERMUTED=.FALSE. + ELSE + CALL CMUMPS_698( + & IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)), + & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, + & IW(I_PIVRPTR+IPANEL-1)-1, + & A(APOSDEB), + & LDAJ, NBJ, BEG_PANEL-1) + ENDIF + ENDIF + IF ( NRHS == 1 ) THEN + IF (NCB_PANEL.NE.0) THEN + CALL cgemv( 'T', NCB_PANEL, NBJ, ALPHA, + & A( APOSDEB + int(NBJ,8) ), LDAJ, + & W( NBJ + PTWCB_PANEL ), + & 1, ONE, + & W(PTWCB_PANEL), 1 ) + ENDIF + IF (MTYPE.NE.1) THEN + CALL ctrsv('L','T','U', NBJ, A(APOSDEB), LDAJ, + & W(PTWCB_PANEL), 1) + ELSE + CALL ctrsv('L','T','N', NBJ, A(APOSDEB), LDAJ, + & W(PTWCB_PANEL), 1) + ENDIF + ELSE + IF (NCB_PANEL.NE.0) THEN + CALL cgemm( 'T', 'N', NBJ, NRHS, NCB_PANEL, ALPHA, + & A(APOSDEB +int(NBJ,8)), LDAJ, + & W(NBJ+PTWCB_PANEL),LIELL, + & ONE, W(PTWCB_PANEL),LIELL) + ENDIF + IF (MTYPE.NE.1) THEN + CALL ctrsm('L','L','T','U',NBJ, NRHS, ONE, + & A(APOSDEB), + & LDAJ, W(PTWCB_PANEL), LIELL) + ELSE + CALL ctrsm('L','L','T','N',NBJ, NRHS, ONE, + & A(APOSDEB), + & LDAJ, W(PTWCB_PANEL), LIELL) + ENDIF + ENDIF + IF (.NOT. TWOBYTWO) JJ=BEG_PANEL-1 + ENDDO + ENDIF + IF (KEEP(201).EQ.0.OR.KEEP(201).EQ.2)THEN + IF ( LIELL .GT. NPIV ) THEN + IF ( MTYPE .eq. 1 ) THEN + IST = APOS + int(NPIV,8) + IF (NRHS == 1) THEN + CALL cgemv( 'T', NCB, NPIV, ALPHA, A(IST), LIELL, + & W(NPIV + PTWCB), 1, + & ONE, + & W(PTWCB), 1 ) + ELSE + CALL cgemm('T','N', NPIV, NRHS, NCB, ALPHA, A(IST), LIELL, + & W(NPIV+PTWCB), LIELL, ONE, + & W(PTWCB), LIELL) + ENDIF + ELSE + IF ( KEEP(50) .eq. 0 ) THEN + IST = APOS + int(NPIV,8) * int(LIELL,8) + ELSE + IST = APOS + int(NPIV,8) * int(NPIV,8) + END IF + IF ( NRHS == 1 ) THEN + CALL cgemv( 'N', NPIV, NCB, ALPHA, A( IST ), NPIV, + & W( NPIV + PTWCB ), + & 1, ONE, + & W(PTWCB), 1 ) + ELSE + CALL cgemm( 'N', 'N', NPIV, NRHS, NCB, ALPHA, + & A(IST), NPIV, W(NPIV+PTWCB),LIELL, + & ONE, W(PTWCB),LIELL) + END IF + END IF + ENDIF + IF ( MTYPE .eq. 1 ) THEN + IF ( NRHS == 1 ) THEN + CALL ctrsv('L', 'T', 'N', NPIV, A(APOS), LIELL, + & W(PTWCB), 1) + ELSE + CALL ctrsm('L','L','T','N', NPIV, NRHS, ONE, A(APOS), + & LIELL, W(PTWCB), LIELL) + ENDIF + ELSE + IF ( KEEP(50) .EQ. 0 ) THEN + IF ( NRHS == 1 ) THEN + CALL ctrsv('U','N','U', NPIV, A(APOS), LIELL, + & W(PTWCB), 1) + ELSE + CALL ctrsm('L','U','N','U', NPIV, NRHS, ONE, A(APOS), + & LIELL,W(PTWCB),LIELL) + END IF + ELSE + IF ( NRHS == 1 ) THEN + CALL ctrsv('U','N','U', NPIV, A(APOS), NPIV, + & W(PTWCB), 1) + ELSE + CALL ctrsm('L','U','N','U',NPIV, NRHS, ONE, A(APOS), + & NPIV, W(PTWCB), LIELL) + END IF + END IF + END IF + ENDIF + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0) THEN + J1 = IPOS + LIELL + 1 + ELSE + J1 = IPOS + 1 + END IF + DO 150 I = 1, NPIV + JJ = IW(J1 + I - 1) + DO K=1, NRHS + RHS(JJ, K) = W(PTWCB+I-1+(K-1)*LIELL) + ENDDO + 150 CONTINUE + 160 CONTINUE + IF (KEEP(201).GT.0) THEN + CALL CMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 330 + ENDIF + ENDIF + IN = INODE + 170 IN = FILS(IN) + IF (IN .GT. 0) GOTO 170 + IF (IN .EQ. 0) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL CMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + ENDIF + GOTO 50 + ENDIF + IF = -IN + NBFILS = NE_STEPS(STEP(INODE)) + IF (AM1) THEN + I = NBFILS + NBFILS = 0 + DO WHILE (I.GT.0) + IF ( TO_PROCESS(STEP(IF)) ) NBFILS = NBFILS+1 + IF = FRERE(STEP(IF)) + I = I -1 + ENDDO + IF (NBFILS.EQ.0) THEN + NO_CHILDREN = .TRUE. + ELSE + NO_CHILDREN = .FALSE. + ENDIF + IF = -IN + ENDIF + IF (IN_SUBTREE) THEN + DO I = 1, NBFILS + IF ( AM1 ) THEN + 1010 IF ( .NOT.TO_PROCESS(STEP(IF)) ) THEN + IF = FRERE(STEP(IF)) + GOTO 1010 + ENDIF + NO_CHILDREN = .FALSE. + ENDIF + IPOOL((IIPOOL-I+1)+NBFILS-I) = IF + IIPOOL = IIPOOL + 1 + IF = FRERE(STEP(IF)) + ENDDO + IF (AM1 .AND. NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL CMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + GOTO 50 + ENDIF + ENDIF + ELSE + DEBUT = .TRUE. + DO I = 0, SLAVEF - 1 + DEJA_SEND( I ) = .FALSE. + END DO + POOL_FIRST_POS=IIPOOL + DO 190 I = 1, NBFILS + IF ( AM1 ) THEN +1020 IF ( .NOT.TO_PROCESS(STEP(IF)) ) THEN + IF = FRERE(STEP(IF)) + GOTO 1020 + ENDIF + NO_CHILDREN = .FALSE. + ENDIF + IF (MUMPS_275(PROCNODE_STEPS(STEP(IF)), + & SLAVEF) .EQ. MYID) THEN + IPOOL(IIPOOL) = IF + IIPOOL = IIPOOL + 1 + IF = FRERE(STEP(IF)) + ELSE + PROCDEST = MUMPS_275(PROCNODE_STEPS(STEP(IF)),SLAVEF) + IF (.not. DEJA_SEND( PROCDEST )) THEN + 400 CONTINUE + CALL CMUMPS_78( NRHS, IF, 0, 0, LIELL, + & LIELL - KEEP(253), + & IW( POSINDICES ), + & W ( PTRACB(STEP( INODE ))), PROCDEST, + & NOEUD, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL CMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 340 + GOTO 400 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 330 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 330 + END IF + DEJA_SEND( PROCDEST ) = .TRUE. + END IF + IF = FRERE(STEP(IF)) + ENDIF + 190 CONTINUE + IF (AM1 .AND. NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL CMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + GOTO 50 + ENDIF + ENDIF + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + IWCB(PTRICB(STEP(INODE))+1) = IWCB(PTRICB(STEP(INODE))+1)-1 + CALL CMUMPS_151(NRHS,N, KEEP(28), IWCB, LIWW, + & W, LWC, + & POSWCB,POSIWCB,PTRICB,PTRACB) + ENDIF + GOTO 50 + 330 CONTINUE + CALL CMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, TERREUR, + & SLAVEF) + 340 CONTINUE + CALL CMUMPS_150( MYID,COMM,BUFR, + & LBUFR,LBUFR_BYTES ) + RETURN + END SUBROUTINE CMUMPS_249 + RECURSIVE SUBROUTINE CMUMPS_41( + & BLOQ, FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, RHS, + & LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IMPLICIT NONE + LOGICAL BLOQ, FLAG + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER MYID, SLAVEF, COMM + INTEGER N, LIWW + INTEGER IWCB( LIWW ) + INTEGER LWC + COMPLEX W( LWC ) + INTEGER POSIWCB, POSWCB + INTEGER IIPOOL, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER LPANEL_POS + INTEGER PANEL_POS( LPANEL_POS ) + INTEGER NBFINF, INFO(40) + INTEGER PLEFTW, KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER PTRICB(KEEP(28)), PTRACB(KEEP(28)), STEP( N ), FILS( N ) + INTEGER LIW + INTEGER(8) :: LA + INTEGER PTRIST(KEEP(28)), IW( LIW ) + INTEGER (8) :: PTRFAC(KEEP(28)) + COMPLEX A( LA ), W2( KEEP(133) ) + INTEGER LRHS, NRHS + COMPLEX RHS(LRHS, NRHS) + INTEGER MYLEAFE, MTYPE + INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28)) + COMPLEX RHSCOMP(LRHSCOMP,NRHS) + INTEGER SIZE_TO_PROCESS + LOGICAL TO_PROCESS(SIZE_TO_PROCESS) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER MSGSOU, MSGTAG, MSGLEN + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + FLAG = .FALSE. + IF ( BLOQ ) THEN + CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, + & COMM, STATUS, IERR ) + FLAG = .TRUE. + ELSE + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + END IF + IF (FLAG) THEN + MSGSOU=STATUS(MPI_SOURCE) + MSGTAG=STATUS(MPI_TAG) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) + IF ( MSGLEN .GT. LBUFR_BYTES ) THEN + INFO(1) = -20 + INFO(2) = MSGLEN + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + ELSE + CALL MPI_RECV(BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU, + & MSGTAG, COMM, STATUS, IERR) + CALL CMUMPS_42( MSGTAG, MSGSOU, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, + & KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + END IF + END IF + RETURN + END SUBROUTINE CMUMPS_41 + RECURSIVE SUBROUTINE CMUMPS_42( + & MSGTAG, MSGSOU, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + USE CMUMPS_OOC + USE CMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER MSGTAG, MSGSOU + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER MYID, SLAVEF, COMM + INTEGER N, LIWW + INTEGER IWCB( LIWW ) + INTEGER LWC + COMPLEX W( LWC ) + INTEGER POSIWCB, POSWCB + INTEGER IIPOOL, LPOOL, LPANEL_POS + INTEGER IPOOL( LPOOL ) + INTEGER PANEL_POS( LPANEL_POS ) + INTEGER NBFINF, INFO(40) + INTEGER PLEFTW, KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER PTRICB(KEEP(28)), PTRACB(KEEP(28)), STEP( N ), FILS( N ) + INTEGER FRERE(KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER LIW + INTEGER(8) :: LA + INTEGER IW( LIW ), PTRIST( KEEP(28) ) + INTEGER(8) :: PTRFAC(KEEP(28)) + COMPLEX A( LA ), W2( KEEP(133) ) + INTEGER LRHS, NRHS + COMPLEX RHS(LRHS, NRHS) + INTEGER MYLEAFE, MTYPE + INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28)) + COMPLEX RHSCOMP(LRHSCOMP,NRHS) + INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR + LOGICAL MUST_BE_PERMUTED + INTEGER SIZE_TO_PROCESS + LOGICAL TO_PROCESS(SIZE_TO_PROCESS), NO_CHILDREN + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER POSITION, IF, INODE, IERR, LONG, DUMMY(1) + INTEGER P_UPDATE, P_SOL_MAS, LIELL, K + INTEGER(8) :: APOS, IST + INTEGER NPIV, NROW_L, IPOS, NROW_RECU + INTEGER I, JJ, IN, PROCDEST, J1, J2, IFR, LDA + INTEGER NSLAVES, NELIM, J, POSINDICES, INODEPOS, + & IPOSINRHSCOMP + LOGICAL FLAG + COMPLEX ZERO, ALPHA, ONE + PARAMETER (ZERO=(0.0E0,0.0E0), + & ONE=(1.0E0,0.0E0), + & ALPHA=(-1.0E0,0.0E0)) + INCLUDE 'mumps_headers.h' + INTEGER POOL_FIRST_POS, TMP + LOGICAL DEJA_SEND( 0:SLAVEF-1 ) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275, ctrsv, ctrsm, cgemv, cgemm + INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS + INTEGER LDAJ, NBJ, LIWFAC, + & NBJLAST, NPIV_LAST, PANEL_SIZE, + & PTWCB_PANEL, NCB_PANEL, TYPEF + LOGICAL TWOBYTWO + INTEGER BEG_PANEL + INTEGER IPANEL, NPANELS + IF (MSGTAG .EQ. FEUILLE) THEN + NBFINF = NBFINF - 1 + ELSE IF (MSGTAG .EQ. NOEUD) THEN + POSITION = 0 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & INODE, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & LONG, 1, MPI_INTEGER, + & COMM, IERR) + IF ( POSIWCB - LONG - 2 .LT. 0 + & .OR. POSWCB - PLEFTW + 1 .LT. LONG ) THEN + CALL CMUMPS_95(NRHS, N, KEEP(28), IWCB, + & LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ((POSIWCB - LONG - 2 ) .LT. 0) THEN + INFO(1)=-14 + INFO(2)=-POSIWCB + LONG + 2 + WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' + GOTO 260 + END IF + IF ( POSWCB - PLEFTW + 1 .LT. LONG ) THEN + INFO(1) = -11 + INFO(2) = LONG + PLEFTW - POSWCB - 1 + WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' + GOTO 260 + END IF + ENDIF + POSIWCB = POSIWCB - LONG + POSWCB = POSWCB - LONG + IF (LONG .GT. 0) THEN + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IWCB(POSIWCB + 1), + & LONG, MPI_INTEGER, COMM, IERR) + DO K=1,NRHS + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & W(POSWCB + 1), LONG, + & MPI_COMPLEX, COMM, IERR) + DO JJ=0, LONG-1 + RHS(IWCB(POSIWCB+1+JJ),K) = W(POSWCB+1+JJ) + ENDDO + ENDDO + POSIWCB = POSIWCB + LONG + POSWCB = POSWCB + LONG + ENDIF + POOL_FIRST_POS = IIPOOL + IF ( KEEP(237).GT. 0 ) THEN + IF (.NOT.TO_PROCESS(STEP(INODE))) + & GOTO 1010 + ENDIF + IPOOL( IIPOOL ) = INODE + IIPOOL = IIPOOL + 1 + 1010 CONTINUE + IF = FRERE( STEP(INODE) ) + DO WHILE ( IF .GT. 0 ) + IF ( MUMPS_275(PROCNODE_STEPS(STEP(IF)), + & SLAVEF) .eq. MYID ) THEN + IF ( KEEP(237).GT. 0 ) THEN + IF (.NOT.TO_PROCESS(STEP(IF))) THEN + IF = FRERE(STEP(IF)) + CYCLE + ENDIF + ENDIF + IPOOL( IIPOOL ) = IF + IIPOOL = IIPOOL + 1 + END IF + IF = FRERE( STEP( IF ) ) + END DO + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + ELSE IF ( MSGTAG .EQ. BACKSLV_MASTER2SLAVE ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NROW_RECU, 1, MPI_INTEGER, COMM, IERR ) + IPOS = PTRIST( STEP(INODE) ) + KEEP(IXSZ) + NPIV = - IW( IPOS ) + NROW_L = IW( IPOS + 1 ) + IF (KEEP(201).GT.0) THEN + CALL CMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + APOS = PTRFAC(IW( IPOS + 3 )) + IF ( NROW_L .NE. NROW_RECU ) THEN + WRITE(*,*) 'Error1 in 41S : NROW L/RECU=',NROW_L, NROW_RECU + CALL MUMPS_ABORT() + END IF + LONG = NROW_L + NPIV + IF ( POSWCB - LONG*NRHS .LT. PLEFTW - 1 ) THEN + CALL CMUMPS_95(NRHS, N, KEEP(28), IWCB, + & LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - LONG*NRHS .LT. PLEFTW - 1 ) THEN + INFO(1) = -11 + INFO(2) = LONG * NRHS- POSWCB + WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' + GOTO 260 + END IF + END IF + P_UPDATE = PLEFTW + P_SOL_MAS = PLEFTW + NPIV * NRHS + PLEFTW = P_SOL_MAS + NROW_L * NRHS + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & W( P_SOL_MAS+(K-1)*NROW_L),NROW_L, + & MPI_COMPLEX, + & COMM, IERR ) + ENDDO + IF (KEEP(201).EQ.1) THEN + IF ( NRHS == 1 ) THEN + CALL cgemv( 'T', NROW_L, NPIV, ALPHA, A( APOS ), NROW_L, + & W( P_SOL_MAS ), 1, ZERO, + & W( P_UPDATE ), 1 ) + ELSE + CALL cgemm( 'T', 'N', NPIV, NRHS, NROW_L, ALPHA, A(APOS), + & NROW_L, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ), + & NPIV ) + ENDIF + ELSE + IF ( NRHS == 1 ) THEN + CALL cgemv( 'N', NPIV, NROW_L, ALPHA, A( APOS ), NPIV, + & W( P_SOL_MAS ), 1, ZERO, + & W( P_UPDATE ), 1 ) + ELSE + CALL cgemm( 'N', 'N', NPIV, NRHS, NROW_L, ALPHA, A(APOS), + & NPIV, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ), + & NPIV ) + END IF + ENDIF + IF (KEEP(201).GT.0) THEN + CALL CMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + PLEFTW = PLEFTW - NROW_L * NRHS + 100 CONTINUE + CALL CMUMPS_63( NRHS, INODE, W(P_UPDATE), + & NPIV, NPIV, + & MSGSOU, + & BACKSLV_UPDATERHS, + & COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL CMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 100 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 260 + END IF + PLEFTW = PLEFTW - NPIV * NRHS + ELSE IF ( MSGTAG .EQ. BACKSLV_UPDATERHS ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE, 1, MPI_INTEGER, COMM, IERR ) + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NPIV, 1, MPI_INTEGER, COMM, IERR ) + NELIM = IW(IPOS-1) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + IPOS = IPOS + 1 + NSLAVES = IW( IPOS + 1 ) + IPOS = IPOS + 1 + NSLAVES + INODEPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 4 + IF ( KEEP(50) .eq. 0 ) THEN + LDA = LIELL + ELSE + LDA = NPIV + ENDIF + IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN + J1 = IPOS + 1 + J2 = IPOS + NPIV + ELSE + J1 = IPOS + LIELL + 1 + J2 = IPOS + NPIV + LIELL + END IF + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & W2, NPIV, MPI_COMPLEX, + & COMM, IERR ) + IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + I = 1 + IF ( (KEEP(253).NE.0) .AND. + & (IW(PTRIST(STEP(INODE))+XXS).EQ.C_FINI+NSLAVES) + & ) THEN + DO JJ = J1,J2 + RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = W2(I) + I = I+1 + ENDDO + ELSE + DO JJ = J1,J2 + RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = + & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + W2(I) + I = I+1 + ENDDO + ENDIF + ENDDO + IW(PTRIST(STEP(INODE))+XXS) = + & IW(PTRIST(STEP(INODE))+XXS) - 1 + IF ( IW(PTRIST(STEP(INODE))+XXS).EQ.C_FINI ) THEN + IF (KEEP(201).GT.0) THEN + CALL CMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL CMUMPS_755( + & IW(IPOS+1+2*LIELL), + & MUST_BE_PERMUTED ) + ENDIF + ENDIF + APOS = PTRFAC(IW(INODEPOS)) + IF (KEEP(201).EQ.1) THEN + LIWFAC = IW(PTRIST(STEP(INODE))+XXI) + TYPEF = TYPEF_L + NROW_L = NPIV+NELIM + PANEL_SIZE = CMUMPS_690(NROW_L) + IF (PANEL_SIZE.LT.0) THEN + WRITE(6,*) ' Internal error in bwd solve PANEL_SIZE=', + & PANEL_SIZE + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF ( POSIWCB - 2 .LT. 0 .or. + & POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + CALL CMUMPS_95( NRHS, N, KEEP(28), IWCB, + & LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + INFO( 1 ) = -11 + INFO( 2 ) = LIELL * NRHS - POSWCB - PLEFTW + 1 + GOTO 260 + END IF + IF ( POSIWCB - 2 .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = 2 - POSIWCB + GO TO 260 + END IF + END IF + POSIWCB = POSIWCB - 2 + POSWCB = POSWCB - LIELL*NRHS + PTRICB(STEP( INODE )) = POSIWCB + 1 + PTRACB(STEP( INODE )) = POSWCB + 1 + IWCB( PTRICB(STEP( INODE )) ) = LIELL + IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 + IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 5 + NSLAVES + IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN + POSINDICES = IPOS + LIELL + 1 + ELSE + POSINDICES = IPOS + 1 + END IF + IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + IFR = PTRACB(STEP( INODE )) + DO K=1, NRHS + DO JJ = J1, J2 + W(IFR+JJ-J1+(K-1)*LIELL) = + & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + ENDDO + END DO + IFR = PTRACB(STEP(INODE))-1+NPIV + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN + J1 = IPOS + LIELL + NPIV + 1 + J2 = IPOS + 2 * LIELL + ELSE + J1 = IPOS + NPIV + 1 + J2 = IPOS + LIELL + END IF + DO JJ = J1, J2-KEEP(253) + J = IW(JJ) + IFR = IFR + 1 + DO K=1, NRHS + W(IFR+(K-1)*LIELL) = RHS(J,K) + ENDDO + ENDDO + IF ( KEEP(201).EQ.1 .AND. + & (( NELIM .GT. 0 ).OR. (MTYPE.NE.1 ))) THEN + J = NPIV / PANEL_SIZE + TWOBYTWO = KEEP(50).EQ.2 .AND. KEEP(105).GT.0 + IF (TWOBYTWO) THEN + CALL CMUMPS_641(PANEL_SIZE, PANEL_POS, + & LPANEL_POS, IW(IPOS+1+LIELL), NPIV, NPANELS, + & NROW_L, NBENTRIES_ALLPANELS) + ELSE + IF (NPIV.EQ.J*PANEL_SIZE) THEN + NPIV_LAST = NPIV + NBJLAST = PANEL_SIZE + NPANELS = J + ELSE + NPIV_LAST = (J+1)* PANEL_SIZE + NBJLAST = NPIV-J*PANEL_SIZE + NPANELS = J+1 + ENDIF + NBENTRIES_ALLPANELS = + & int(NROW_L,8) * int(NPIV,8) + & - int( ( J * ( J - 1 ) ) / 2,8 ) + & * int(PANEL_SIZE,8) * int(PANEL_SIZE,8) + & - int(J,8) + & * int(mod(NPIV, PANEL_SIZE),8) + & * int(PANEL_SIZE,8) + JJ=NPIV_LAST + ENDIF + APOSDEB = APOS + NBENTRIES_ALLPANELS + DO IPANEL=NPANELS,1,-1 + IF (TWOBYTWO) THEN + NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL) + BEG_PANEL = PANEL_POS(IPANEL) + ELSE + IF (JJ.EQ.NPIV_LAST) THEN + NBJ = NBJLAST + ELSE + NBJ = PANEL_SIZE + ENDIF + BEG_PANEL = JJ- PANEL_SIZE+1 + ENDIF + LDAJ = NROW_L-BEG_PANEL+1 + APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8) + PTWCB_PANEL = PTRACB(STEP(INODE)) + BEG_PANEL - 1 + NCB_PANEL = LDAJ - NBJ + IF (KEEP(50).NE.1 .AND.MUST_BE_PERMUTED) THEN + CALL CMUMPS_667(TYPEF, TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW) + CALL CMUMPS_698( + & IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)), + & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, + & IW(I_PIVRPTR+IPANEL-1)-1, + & A(APOSDEB), + & LDAJ, NBJ, BEG_PANEL-1) + ENDIF + IF ( NRHS == 1 ) THEN + IF (NCB_PANEL.NE.0) THEN + CALL cgemv( 'T', NCB_PANEL, NBJ, ALPHA, + & A( APOSDEB + int(NBJ,8) ), LDAJ, + & W( NBJ + PTWCB_PANEL ), + & 1, ONE, + & W(PTWCB_PANEL), 1 ) + ENDIF + CALL ctrsv('L','T','U', NBJ, A(APOSDEB), LDAJ, + & W(PTWCB_PANEL), 1) + ELSE + IF (NCB_PANEL.NE.0) THEN + CALL cgemm( 'T', 'N', NBJ, NRHS, NCB_PANEL, ALPHA, + & A(APOSDEB + int(NBJ,8)), LDAJ, + & W(NBJ+PTWCB_PANEL),LIELL, + & ONE, W(PTWCB_PANEL),LIELL) + ENDIF + CALL ctrsm('L','L','T','U',NBJ, NRHS, ONE, + & A(APOSDEB), + & LDAJ, W(PTWCB_PANEL), LIELL) + ENDIF + IF (.NOT. TWOBYTWO) JJ=BEG_PANEL-1 + ENDDO + GOTO 1234 + ENDIF + IF (NELIM .GT.0) THEN + IF ( KEEP(50) .eq. 0 ) THEN + IST = APOS + int(NPIV,8) * int(LIELL,8) + ELSE + IST = APOS + int(NPIV,8) * int(NPIV,8) + END IF + IF ( NRHS == 1 ) THEN + CALL cgemv( 'N', NPIV, NELIM, ALPHA, + & A( IST ), NPIV, + & W( NPIV + PTRACB(STEP(INODE)) ), + & 1, ONE, + & W(PTRACB(STEP(INODE))), 1 ) + ELSE + CALL cgemm( 'N', 'N', NPIV, NRHS, NELIM, ALPHA, + & A(IST), NPIV, W(NPIV+PTRACB(STEP(INODE))),LIELL, + & ONE, W(PTRACB(STEP(INODE))),LIELL) + END IF + ENDIF + IF ( NRHS == 1 ) THEN + CALL ctrsv( 'U', 'N', 'U', NPIV, A(APOS), LDA, + & W(PTRACB(STEP(INODE))),1) + ELSE + CALL ctrsm( 'L','U', 'N', 'U', NPIV, NRHS, ONE, + & A(APOS), LDA, + & W(PTRACB(STEP(INODE))),LIELL) + END IF + 1234 CONTINUE + IF (KEEP(201).GT.0) THEN + CALL CMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 6 + NSLAVES + DO I = 1, NPIV + JJ = IW( IPOS + I - 1 ) + DO K=1,NRHS + RHS( JJ, K ) = W( PTRACB(STEP(INODE))+I-1 + & + (K-1)*LIELL ) + ENDDO + END DO + IN = INODE + 200 IN = FILS(IN) + IF (IN .GT. 0) GOTO 200 + IF (IN .EQ. 0) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL CMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + ENDIF + IWCB( PTRICB(STEP(INODE)) + 1 ) = 0 + CALL CMUMPS_151(NRHS, N, KEEP(28), + & IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + GOTO 270 + ENDIF + DO I = 0, SLAVEF - 1 + DEJA_SEND( I ) = .FALSE. + END DO + IN = -IN + IF ( KEEP(237).GT.0 ) THEN + NO_CHILDREN = .TRUE. + ELSE + NO_CHILDREN = .FALSE. + ENDIF + DO WHILE (IN.GT.0) + IF ( KEEP(237).GT.0 ) THEN + IF (.NOT.TO_PROCESS(STEP(IN))) THEN + IN = FRERE(STEP(IN)) + CYCLE + ELSE + NO_CHILDREN = .FALSE. + ENDIF + ENDIF + POOL_FIRST_POS = IIPOOL + IF (MUMPS_275(PROCNODE_STEPS(STEP(IN)), + & SLAVEF) .EQ. MYID) THEN + IPOOL(IIPOOL ) = IN + IIPOOL = IIPOOL + 1 + ELSE + PROCDEST = MUMPS_275( PROCNODE_STEPS(STEP(IN)), + & SLAVEF ) + IF ( .NOT. DEJA_SEND( PROCDEST ) ) THEN + 110 CALL CMUMPS_78( NRHS, IN, 0, 0, + & LIELL, LIELL-KEEP(253), + & IW( POSINDICES ) , + & W( PTRACB(STEP(INODE))), + & PROCDEST, NOEUD, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL CMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 110 + ELSE IF ( IERR .eq. -2 ) THEN + INFO(1) = -17 + INFO(2) = LIELL * NRHS * KEEP(35) + + & ( LIELL + 2 ) * KEEP(34) + GOTO 260 + ELSE IF ( IERR .eq. -3 ) THEN + INFO(1) = -20 + INFO(2) = LIELL * NRHS * KEEP(35) + + & ( LIELL + 2 ) * KEEP(34) + GOTO 260 + END IF + DEJA_SEND( PROCDEST ) = .TRUE. + END IF + END IF + IN = FRERE( STEP( IN ) ) + END DO + IF (NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL CMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, + & COMM, FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + ENDIF + IWCB( PTRICB(STEP(INODE)) + 1 ) = 0 + CALL CMUMPS_151(NRHS, N, KEEP(28), + & IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + GOTO 270 + ENDIF + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + IWCB( PTRICB(STEP( INODE )) + 1 ) = 0 + CALL CMUMPS_151(NRHS, N, KEEP(28), + & IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + END IF + ELSE IF (MSGTAG.EQ.TERREUR) THEN + INFO(1) = -001 + INFO(2) = MSGSOU + GO TO 270 + ELSE IF ( (MSGTAG.EQ.UPDATE_LOAD).OR. + & (MSGTAG.EQ.TAG_DUMMY) ) THEN + GO TO 270 + ELSE + INFO(1) = -100 + INFO(2) = MSGTAG + GOTO 260 + ENDIF + GO TO 270 + 260 CONTINUE + CALL CMUMPS_44( MYID, SLAVEF, COMM ) + 270 CONTINUE + RETURN + END SUBROUTINE CMUMPS_42 + SUBROUTINE CMUMPS_641(PANEL_SIZE, PANEL_POS, + & LEN_PANEL_POS, INDICES, NPIV, + & NPANELS, NFRONT_OR_NASS, + & NBENTRIES_ALLPANELS) + IMPLICIT NONE + INTEGER, intent (in) :: PANEL_SIZE, NPIV + INTEGER, intent (in) :: INDICES(NPIV) + INTEGER, intent (in) :: LEN_PANEL_POS + INTEGER, intent (out) :: NPANELS + INTEGER, intent (out) :: PANEL_POS(LEN_PANEL_POS) + INTEGER, intent (in) :: NFRONT_OR_NASS + INTEGER(8), intent(out):: NBENTRIES_ALLPANELS + INTEGER NPANELS_MAX, I, NBeff + INTEGER(8) :: NBENTRIES_THISPANEL + NBENTRIES_ALLPANELS = 0_8 + NPANELS_MAX = (NPIV+PANEL_SIZE-1)/PANEL_SIZE + IF (LEN_PANEL_POS .LT. NPANELS_MAX + 1) THEN + WRITE(*,*) "Error 1 in CMUMPS_641", + & LEN_PANEL_POS,NPANELS_MAX + CALL MUMPS_ABORT() + ENDIF + I = 1 + NPANELS = 0 + IF (I .GT. NPIV) RETURN + 10 CONTINUE + NPANELS = NPANELS + 1 + PANEL_POS(NPANELS) = I + NBeff = min(PANEL_SIZE, NPIV-I+1) + IF ( INDICES(I+NBeff-1) < 0) THEN + NBeff=NBeff+1 + ENDIF + NBENTRIES_THISPANEL = int(NFRONT_OR_NASS-I+1,8) * int(NBeff,8) + NBENTRIES_ALLPANELS = NBENTRIES_ALLPANELS + NBENTRIES_THISPANEL + I=I+NBeff + IF ( I .LE. NPIV ) GOTO 10 + PANEL_POS(NPANELS+1)=NPIV+1 + RETURN + END SUBROUTINE CMUMPS_641 + SUBROUTINE CMUMPS_286( NRHS, DESCA_PAR, + & CNTXT_PAR,LOCAL_M,LOCAL_N,MBLOCK,NBLOCK, + & IPIV,LPIV,MASTER_ROOT,MYID,COMM, + & RHS_SEQ,SIZE_ROOT,A,INFO,MTYPE,LDLT ) + IMPLICIT NONE + INTEGER NRHS, MTYPE + INTEGER DESCA_PAR( 9 ) + INTEGER LOCAL_M, LOCAL_N, MBLOCK, NBLOCK + INTEGER CNTXT_PAR, MASTER_ROOT, SIZE_ROOT + INTEGER MYID, COMM + INTEGER LPIV, IPIV( LPIV ) + INTEGER INFO(40), LDLT + COMPLEX RHS_SEQ( SIZE_ROOT *NRHS) + COMPLEX A( LOCAL_M, LOCAL_N ) + INTEGER IERR, NPROW, NPCOL, MYROW, MYCOL + INTEGER LOCAL_N_RHS + COMPLEX, ALLOCATABLE, DIMENSION( :,: ) ::RHS_PAR + EXTERNAL numroc + INTEGER numroc + INTEGER allocok + CALL blacs_gridinfo( CNTXT_PAR, NPROW, NPCOL, MYROW, MYCOL ) + LOCAL_N_RHS = numroc(NRHS, NBLOCK, MYCOL, 0, NPCOL) + LOCAL_N_RHS = max(1,LOCAL_N_RHS) + ALLOCATE(RHS_PAR(LOCAL_M, LOCAL_N_RHS),stat=allocok) + IF (allocok > 0 ) THEN + WRITE(*,*) ' Problem during solve of the root.' + WRITE(*,*) ' Reduce number of right hand sides.' + CALL MUMPS_ABORT() + ENDIF + CALL CMUMPS_290( MYID, SIZE_ROOT, NRHS, RHS_SEQ, + & LOCAL_M, LOCAL_N_RHS, + & MBLOCK, NBLOCK, RHS_PAR, MASTER_ROOT, + & NPROW, NPCOL, COMM ) + CALL CMUMPS_768 (SIZE_ROOT, NRHS, MTYPE, + & A, DESCA_PAR, LOCAL_M, LOCAL_N, LOCAL_N_RHS, + & IPIV, LPIV, RHS_PAR, LDLT, + & MBLOCK, NBLOCK, CNTXT_PAR, + & IERR) + CALL CMUMPS_156( MYID, SIZE_ROOT, NRHS, + & RHS_SEQ, LOCAL_M, LOCAL_N_RHS, + & MBLOCK, NBLOCK, RHS_PAR, MASTER_ROOT, + & NPROW, NPCOL, COMM ) + DEALLOCATE(RHS_PAR) + RETURN + END SUBROUTINE CMUMPS_286 + SUBROUTINE CMUMPS_768 (SIZE_ROOT, NRHS, MTYPE, + & A, DESCA_PAR, LOCAL_M, LOCAL_N, LOCAL_N_RHS, + & IPIV, LPIV, RHS_PAR, LDLT, + & MBLOCK, NBLOCK, CNTXT_PAR, + & IERR) + IMPLICIT NONE + INTEGER, intent (in) :: SIZE_ROOT, NRHS, LDLT, LOCAL_M, + & LOCAL_N, LOCAL_N_RHS, + & MBLOCK, NBLOCK, CNTXT_PAR, MTYPE + INTEGER, intent (in) :: DESCA_PAR( 9 ) + INTEGER, intent (in) :: LPIV, IPIV( LPIV ) + COMPLEX, intent (in) :: A( LOCAL_M, LOCAL_N ) + COMPLEX, intent (inout) :: RHS_PAR(LOCAL_M, LOCAL_N_RHS) + INTEGER, intent (out) :: IERR + INTEGER :: DESCB_PAR( 9 ) + IERR = 0 + CALL DESCINIT( DESCB_PAR, SIZE_ROOT, + & NRHS, MBLOCK, NBLOCK, 0, 0, + & CNTXT_PAR, LOCAL_M, IERR ) + IF (IERR.NE.0) THEN + WRITE(*,*) 'After DESCINIT, IERR = ', IERR + CALL MUMPS_ABORT() + END IF + IF ( LDLT .eq. 0 .OR. LDLT .eq. 2 ) THEN + IF ( MTYPE .eq. 1 ) THEN + CALL pcgetrs('N',SIZE_ROOT,NRHS,A,1,1,DESCA_PAR,IPIV, + & RHS_PAR,1,1,DESCB_PAR,IERR) + ELSE + CALL pcgetrs('T',SIZE_ROOT,NRHS,A,1,1,DESCA_PAR,IPIV, + & RHS_PAR, 1, 1, DESCB_PAR,IERR) + END IF + ELSE + CALL pcpotrs( 'L', SIZE_ROOT, NRHS, A, 1, 1, DESCA_PAR, + & RHS_PAR, 1, 1, DESCB_PAR, IERR ) + END IF + IF ( IERR .LT. 0 ) THEN + WRITE(*,*) ' Problem during solve of the root' + CALL MUMPS_ABORT() + END IF + RETURN + END SUBROUTINE CMUMPS_768 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_struc_def.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_struc_def.F new file mode 100644 index 000000000..096ded99d --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/cmumps_struc_def.F @@ -0,0 +1,50 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE CMUMPS_STRUC_DEF + INCLUDE 'cmumps_struc.h' + END MODULE CMUMPS_STRUC_DEF diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_comm_buffer.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_comm_buffer.F new file mode 100644 index 000000000..70feae914 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_comm_buffer.F @@ -0,0 +1,2718 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE DMUMPS_COMM_BUFFER + PRIVATE + PUBLIC :: DMUMPS_61, DMUMPS_528, + & DMUMPS_53 , DMUMPS_57 , + & DMUMPS_55, DMUMPS_59, + & DMUMPS_54,DMUMPS_58, + & DMUMPS_66, DMUMPS_78, + & DMUMPS_62, DMUMPS_68, + & DMUMPS_71, DMUMPS_70, + & DMUMPS_67, + & DMUMPS_65, DMUMPS_64, + & DMUMPS_72, + & DMUMPS_648, DMUMPS_76, + & DMUMPS_73, DMUMPS_74, + & DMUMPS_63,DMUMPS_77, + & DMUMPS_60, + & DMUMPS_524, DMUMPS_469, + & DMUMPS_460, DMUMPS_502, + & DMUMPS_519 ,DMUMPS_620 + & ,DMUMPS_617 + INTEGER NEXT, REQ, CONTENT, OVHSIZE + PARAMETER( NEXT = 0, REQ = 1, CONTENT = 2, OVHSIZE = 2 ) + INTEGER, SAVE :: SIZEofINT, SIZEofREAL, BUF_MYID + TYPE DMUMPS_COMM_BUFFER_TYPE + INTEGER LBUF, HEAD, TAIL,LBUF_INT, ILASTMSG + INTEGER, DIMENSION(:),POINTER :: CONTENT + END TYPE DMUMPS_COMM_BUFFER_TYPE + TYPE ( DMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_CB + TYPE ( DMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_SMALL + TYPE ( DMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_LOAD + INTEGER, SAVE :: SIZE_RBUF_BYTES + INTEGER BUF_LMAX_ARRAY + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: BUF_MAX_ARRAY + PUBLIC :: BUF_LMAX_ARRAY, BUF_MAX_ARRAY + CONTAINS + SUBROUTINE DMUMPS_528( MYID ) + IMPLICIT NONE + INTEGER MYID + BUF_MYID = MYID + RETURN + END SUBROUTINE DMUMPS_528 + SUBROUTINE DMUMPS_61( IntSize, RealSize ) + IMPLICIT NONE + INTEGER IntSize, RealSize + SIZEofINT = IntSize + SIZEofREAL = RealSize + NULLIFY(BUF_CB %CONTENT) + NULLIFY(BUF_SMALL%CONTENT) + NULLIFY(BUF_LOAD%CONTENT) + BUF_CB%LBUF = 0 + BUF_CB%LBUF_INT = 0 + BUF_CB%HEAD = 1 + BUF_CB%TAIL = 1 + BUF_CB%ILASTMSG = 1 + BUF_SMALL%LBUF = 0 + BUF_SMALL%LBUF_INT = 0 + BUF_SMALL%HEAD = 1 + BUF_SMALL%TAIL = 1 + BUF_SMALL%ILASTMSG = 1 + BUF_LOAD%LBUF = 0 + BUF_LOAD%LBUF_INT = 0 + BUF_LOAD%HEAD = 1 + BUF_LOAD%TAIL = 1 + BUF_LOAD%ILASTMSG = 1 + RETURN + END SUBROUTINE DMUMPS_61 + SUBROUTINE DMUMPS_53( SIZE, IERR ) + IMPLICIT NONE + INTEGER SIZE, IERR + CALL DMUMPS_2( BUF_CB, SIZE, IERR ) + RETURN + END SUBROUTINE DMUMPS_53 + SUBROUTINE DMUMPS_55( SIZE, IERR ) + IMPLICIT NONE + INTEGER SIZE, IERR + CALL DMUMPS_2( BUF_SMALL, SIZE, IERR ) + RETURN + END SUBROUTINE DMUMPS_55 + SUBROUTINE DMUMPS_54( SIZE, IERR ) + IMPLICIT NONE + INTEGER SIZE, IERR + CALL DMUMPS_2( BUF_LOAD, SIZE, IERR ) + RETURN + END SUBROUTINE DMUMPS_54 + SUBROUTINE DMUMPS_58( IERR ) + IMPLICIT NONE + INTEGER IERR + CALL DMUMPS_3( BUF_LOAD, IERR ) + RETURN + END SUBROUTINE DMUMPS_58 + SUBROUTINE DMUMPS_620() + IMPLICIT NONE + IF (allocated( BUF_MAX_ARRAY)) DEALLOCATE( BUF_MAX_ARRAY ) + RETURN + END SUBROUTINE DMUMPS_620 + SUBROUTINE DMUMPS_617(NFS4FATHER,IERR) + IMPLICIT NONE + INTEGER IERR, NFS4FATHER + IERR = 0 + IF (allocated( BUF_MAX_ARRAY)) THEN + IF (BUF_LMAX_ARRAY .GE. NFS4FATHER) RETURN + DEALLOCATE( BUF_MAX_ARRAY ) + ENDIF + ALLOCATE(BUF_MAX_ARRAY(NFS4FATHER),stat=IERR) + BUF_LMAX_ARRAY=NFS4FATHER + RETURN + END SUBROUTINE DMUMPS_617 + SUBROUTINE DMUMPS_57( IERR ) + IMPLICIT NONE + INTEGER IERR + CALL DMUMPS_3( BUF_CB, IERR ) + RETURN + END SUBROUTINE DMUMPS_57 + SUBROUTINE DMUMPS_59( IERR ) + IMPLICIT NONE + INTEGER IERR + CALL DMUMPS_3( BUF_SMALL, IERR ) + RETURN + END SUBROUTINE DMUMPS_59 + SUBROUTINE DMUMPS_2( BUF, SIZE, IERR ) + IMPLICIT NONE + TYPE ( DMUMPS_COMM_BUFFER_TYPE ) :: BUF + INTEGER SIZE, IERR + IERR = 0 + BUF%LBUF = SIZE + BUF%LBUF_INT = ( SIZE + SIZEofINT - 1 ) / SIZEofINT + IF ( associated ( BUF%CONTENT ) ) DEALLOCATE( BUF%CONTENT ) + ALLOCATE( BUF%CONTENT( BUF%LBUF_INT ), stat = IERR ) + IF (IERR .NE. 0) THEN + NULLIFY( BUF%CONTENT ) + IERR = -1 + BUF%LBUF = 0 + BUF%LBUF_INT = 0 + END IF + BUF%HEAD = 1 + BUF%TAIL = 1 + BUF%ILASTMSG = 1 + RETURN + END SUBROUTINE DMUMPS_2 + SUBROUTINE DMUMPS_3( BUF, IERR ) + IMPLICIT NONE + TYPE ( DMUMPS_COMM_BUFFER_TYPE ) :: BUF + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG + IF ( .NOT. associated ( BUF%CONTENT ) ) THEN + BUF%HEAD = 1 + BUF%LBUF = 0 + BUF%LBUF_INT = 0 + BUF%TAIL = 1 + BUF%ILASTMSG = 1 + RETURN + END IF + DO WHILE ( BUF%HEAD.NE.0 .AND. BUF%HEAD .NE. BUF%TAIL ) + CALL MPI_TEST(BUF%CONTENT( BUF%HEAD + REQ ), FLAG, + & STATUS, IERR) + IF ( .not. FLAG ) THEN + WRITE(*,*) '** Warning: trying to cancel a request.' + WRITE(*,*) '** This might be problematic on SGI' + CALL MPI_CANCEL( BUF%CONTENT( BUF%HEAD + REQ ), IERR ) + CALL MPI_REQUEST_FREE( BUF%CONTENT( BUF%HEAD + REQ ), IERR ) + END IF + BUF%HEAD = BUF%CONTENT( BUF%HEAD + NEXT ) + END DO + DEALLOCATE( BUF%CONTENT ) + NULLIFY( BUF%CONTENT ) + BUF%LBUF = 0 + BUF%LBUF_INT = 0 + BUF%HEAD = 1 + BUF%TAIL = 1 + BUF%ILASTMSG = 1 + RETURN + END SUBROUTINE DMUMPS_3 + SUBROUTINE DMUMPS_66( NBROWS_ALREADY_SENT, + & INODE, FPERE, NFRONT, LCONT, + & NASS, NPIV, + & IWROW, IWCOL, A, COMPRESSCB, + & DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INTEGER DEST, TAG, COMM, IERR + INTEGER NBROWS_ALREADY_SENT + INTEGER INODE, FPERE, NFRONT, LCONT, NASS, NPIV + INTEGER IWROW( LCONT ), IWCOL( LCONT ) + DOUBLE PRECISION A( * ) + LOGICAL COMPRESSCB + INCLUDE 'mpif.h' + INTEGER NBROWS_PACKET + INTEGER POSITION, IREQ, IPOS, I, J1 + INTEGER SIZE1, SIZE2, SIZE_PACK, SIZE_AV, SIZE_AV_REALS + INTEGER IZERO, IONE + INTEGER SIZECB + INTEGER LCONT_SENT + INTEGER DEST2(1) + PARAMETER( IZERO = 0, IONE = 1 ) + LOGICAL RECV_BUF_SMALLER_THAN_SEND + DOUBLE PRECISION TMP + DEST2(1) = DEST + IERR = 0 + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + CALL MPI_PACK_SIZE( 11 + LCONT + LCONT, MPI_INTEGER, + & COMM, SIZE1, IERR) + ELSE + CALL MPI_PACK_SIZE( 5, MPI_INTEGER, COMM, SIZE1, IERR) + ENDIF + CALL DMUMPS_79( BUF_CB, SIZE_AV ) + IF ( SIZE_AV .LT. SIZE_RBUF_BYTES ) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + SIZE_AV = SIZE_RBUF_BYTES + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + ENDIF + SIZE_AV_REALS = ( SIZE_AV - SIZE1 ) / SIZEofREAL + IF (SIZE_AV_REALS < 0 ) THEN + NBROWS_PACKET = 0 + ELSE + IF (COMPRESSCB) THEN + TMP=2.0D0*dble(NBROWS_ALREADY_SENT)+1.0D0 + NBROWS_PACKET = int( + & ( sqrt( TMP * TMP + & + 8.0D0 * dble(SIZE_AV_REALS)) - TMP ) + & / 2.0D0 ) + ELSE + NBROWS_PACKET = SIZE_AV_REALS / LCONT + ENDIF + ENDIF + 10 CONTINUE + NBROWS_PACKET = max(0, + & min(NBROWS_PACKET, LCONT - NBROWS_ALREADY_SENT)) + IF (NBROWS_PACKET .EQ. 0 .AND. LCONT .NE. 0) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + IF (COMPRESSCB) THEN + SIZECB = (NBROWS_ALREADY_SENT*NBROWS_PACKET)+(NBROWS_PACKET + & *(NBROWS_PACKET+1))/2 + ELSE + SIZECB = NBROWS_PACKET * LCONT + ENDIF + CALL MPI_PACK_SIZE( SIZECB, MPI_DOUBLE_PRECISION, + & COMM, SIZE2, IERR ) + SIZE_PACK = SIZE1 + SIZE2 + IF (SIZE_PACK .GT. SIZE_AV ) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF (NBROWS_PACKET > 0) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR=-3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF + IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.LCONT .AND. + & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 + & .AND. + & .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF + CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE , DEST2 + & ) + IF (IERR .EQ. -1 .OR. IERR .EQ. -2) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF ( NBROWS_PACKET > 0 ) GOTO 10 + ENDIF + IF ( IERR .LT. 0 ) GOTO 100 + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( FPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (COMPRESSCB) THEN + LCONT_SENT=-LCONT + ELSE + LCONT_SENT=LCONT + ENDIF + CALL MPI_PACK( LCONT_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (NBROWS_ALREADY_SENT == 0) THEN + CALL MPI_PACK( LCONT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NASS-NPIV, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( LCONT , 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IZERO, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IONE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IZERO, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IWROW, LCONT, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IWCOL, LCONT, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + IF ( LCONT .NE. 0 ) THEN + J1 = 1 + NBROWS_ALREADY_SENT * NFRONT + IF (COMPRESSCB) THEN + DO I = NBROWS_ALREADY_SENT+1, + & NBROWS_ALREADY_SENT+NBROWS_PACKET + CALL MPI_PACK( A( J1 ), I, MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + J1 = J1 + NFRONT + END DO + ELSE + DO I = NBROWS_ALREADY_SENT+1, + & NBROWS_ALREADY_SENT+NBROWS_PACKET + CALL MPI_PACK( A( J1 ), LCONT, MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + J1 = J1 + NFRONT + END DO + ENDIF + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK .LT. POSITION ) THEN + WRITE(*,*) 'Error Try_send_cb: SIZE, POSITION=',SIZE_PACK, + & POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE_PACK .NE. POSITION ) + & CALL DMUMPS_1( BUF_CB, POSITION ) + NBROWS_ALREADY_SENT = NBROWS_ALREADY_SENT + NBROWS_PACKET + IF (NBROWS_ALREADY_SENT .NE. LCONT ) THEN + IERR = -1 + RETURN + ENDIF + 100 CONTINUE + RETURN + END SUBROUTINE DMUMPS_66 + SUBROUTINE DMUMPS_72( NRHS, INODE, IFATH, + & EFF_CB_SIZE, LD_CB, LD_PIV, NPIV, CB, SOL, + & DEST, COMM, IERR ) + IMPLICIT NONE + INTEGER NRHS, INODE, IFATH, EFF_CB_SIZE, LD_CB, LD_PIV, NPIV + INTEGER DEST, COMM, IERR + DOUBLE PRECISION CB( LD_CB*(NRHS-1)+EFF_CB_SIZE ) + DOUBLE PRECISION SOL( max(1, LD_PIV*(NRHS-1)+NPIV) ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE, SIZE1, SIZE2, K + INTEGER POSITION, IREQ, IPOS + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1) = DEST + IERR = 0 + CALL MPI_PACK_SIZE( 4, MPI_INTEGER, COMM, SIZE1, IERR ) + CALL MPI_PACK_SIZE( NRHS * (EFF_CB_SIZE + NPIV), + & MPI_DOUBLE_PRECISION, COMM, + & SIZE2, IERR ) + SIZE = SIZE1 + SIZE2 + CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IFATH, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( EFF_CB_SIZE , 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NPIV , 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + DO K = 1, NRHS + CALL MPI_PACK( CB ( 1 + LD_CB * (K-1) ), + & EFF_CB_SIZE, MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + END DO + IF ( NPIV .GT. 0 ) THEN + DO K=1, NRHS + CALL MPI_PACK( SOL(1+LD_PIV*(K-1)), + & NPIV, MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + ENDDO + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, Master2Slave, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE .LT. POSITION ) THEN + WRITE(*,*) 'Try_send_master2slave: SIZE, POSITION = ', + & SIZE, POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE .NE. POSITION ) CALL DMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE DMUMPS_72 + SUBROUTINE DMUMPS_78( NRHS, NODE1, NODE2, NCB, LDW, + & LONG, + & IW, W, + & DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INTEGER LDW, DEST, TAG, COMM, IERR + INTEGER NRHS, NODE1, NODE2, NCB, LONG + INTEGER IW( max( 1, LONG ) ) + DOUBLE PRECISION W( max( 1, LDW * NRHS ) ) + INCLUDE 'mpif.h' + INTEGER POSITION, IREQ, IPOS + INTEGER SIZE1, SIZE2, SIZE, K + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1)=DEST + IERR = 0 + IF ( NODE2 .EQ. 0 ) THEN + CALL MPI_PACK_SIZE( 2+LONG, MPI_INTEGER, COMM, SIZE1, IERR ) + ELSE + CALL MPI_PACK_SIZE( 4+LONG, MPI_INTEGER, COMM, SIZE1, IERR ) + END IF + SIZE2 = 0 + IF ( LONG .GT. 0 ) THEN + CALL MPI_PACK_SIZE( NRHS*LONG, MPI_DOUBLE_PRECISION, + & COMM, SIZE2, IERR ) + END IF + SIZE = SIZE1 + SIZE2 + CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + POSITION = 0 + CALL MPI_PACK( NODE1, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + IF ( NODE2 .NE. 0 ) THEN + CALL MPI_PACK( NODE2, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NCB, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + END IF + CALL MPI_PACK( LONG, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + IF ( LONG .GT. 0 ) THEN + CALL MPI_PACK( IW, LONG, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + DO K=1, NRHS + CALL MPI_PACK( W(1+(K-1)*LDW), LONG, MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + END DO + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE .NE. POSITION ) CALL DMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE DMUMPS_78 + SUBROUTINE DMUMPS_62( I, DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INTEGER I + INTEGER DEST, TAG, COMM, IERR + INCLUDE 'mpif.h' + INTEGER IPOS, IREQ, MSG_SIZE, POSITION + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1)=DEST + IERR = 0 + CALL MPI_PACK_SIZE( 1, MPI_INTEGER, + & COMM, MSG_SIZE, IERR ) + CALL DMUMPS_4( BUF_SMALL, IPOS, IREQ, MSG_SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + write(6,*) ' Internal error in DMUMPS_62', + & ' Buf size (bytes)= ',BUF_SMALL%LBUF + RETURN + ENDIF + POSITION=0 + CALL MPI_PACK( I, 1, + & MPI_INTEGER, BUF_SMALL%CONTENT( IPOS ), + & MSG_SIZE, + & POSITION, COMM, IERR ) + CALL MPI_ISEND( BUF_SMALL%CONTENT(IPOS), MSG_SIZE, + & MPI_PACKED, DEST, TAG, COMM, + & BUF_SMALL%CONTENT( IREQ ), IERR ) + RETURN + END SUBROUTINE DMUMPS_62 + SUBROUTINE DMUMPS_469(FLAG) + LOGICAL FLAG + LOGICAL FLAG1, FLAG2, FLAG3 + CALL DMUMPS_468( BUF_SMALL, FLAG1 ) + CALL DMUMPS_468( BUF_CB, FLAG2 ) + CALL DMUMPS_468( BUF_LOAD, FLAG3 ) + FLAG = FLAG1 .AND. FLAG2 .AND. FLAG3 + RETURN + END SUBROUTINE DMUMPS_469 + SUBROUTINE DMUMPS_468( B, FLAG ) + TYPE ( DMUMPS_COMM_BUFFER_TYPE ) :: B + LOGICAL :: FLAG + INTEGER SIZE_AVAIL + CALL DMUMPS_79(B, SIZE_AVAIL) + FLAG = ( B%HEAD == B%TAIL ) + RETURN + END SUBROUTINE DMUMPS_468 + SUBROUTINE DMUMPS_79( B, SIZE_AV ) + IMPLICIT NONE + TYPE ( DMUMPS_COMM_BUFFER_TYPE ) :: B + INTEGER SIZE_AV + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG + IF ( B%HEAD .NE. B%TAIL ) THEN + 10 CONTINUE + CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + B%HEAD = B%CONTENT( B%HEAD + NEXT ) + IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL + IF ( B%HEAD .NE. B%TAIL ) GOTO 10 + END IF + END IF + IF ( B%HEAD .EQ. B%TAIL ) THEN + B%HEAD = 1 + B%TAIL = 1 + B%ILASTMSG = 1 + END IF + IF ( B%HEAD .LE. B%TAIL ) THEN + SIZE_AV = max( B%LBUF_INT - B%TAIL, B%HEAD - 2 ) + ELSE + SIZE_AV = B%HEAD - B%TAIL - 1 + END IF + SIZE_AV = min(SIZE_AV - OVHSIZE, SIZE_AV) + SIZE_AV = SIZE_AV * SIZEofINT + RETURN + END SUBROUTINE DMUMPS_79 + SUBROUTINE DMUMPS_4( B, IPOS, IREQ, MSG_SIZE, IERR, + & NDEST , PDEST + & ) + IMPLICIT NONE + TYPE ( DMUMPS_COMM_BUFFER_TYPE ) :: B + INTEGER, INTENT(IN) :: MSG_SIZE + INTEGER, INTENT(OUT) :: IPOS, IREQ, IERR + INTEGER NDEST + INTEGER, INTENT(IN) :: PDEST(max(1,NDEST)) + INCLUDE 'mpif.h' + INTEGER MSG_SIZE_INT + INTEGER IBUF + LOGICAL FLAG + INTEGER STATUS( MPI_STATUS_SIZE ) + IERR = 0 + IF ( B%HEAD .NE. B%TAIL ) THEN + 10 CONTINUE + CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + B%HEAD = B%CONTENT( B%HEAD + NEXT ) + IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL + IF ( B%HEAD .NE. B%TAIL ) GOTO 10 + END IF + END IF + IF ( B%HEAD .EQ. B%TAIL ) THEN + B%HEAD = 1 + B%TAIL = 1 + B%ILASTMSG = 1 + END iF + MSG_SIZE_INT = ( MSG_SIZE + ( SIZEofINT - 1 ) ) / SIZEofINT + MSG_SIZE_INT = MSG_SIZE_INT + OVHSIZE + FLAG = ( ( B%HEAD .LE. B%TAIL ) + & .AND. ( + & ( MSG_SIZE_INT .LE. B%LBUF_INT - B%TAIL ) + & .OR. ( MSG_SIZE_INT .LE. B%HEAD - 2 ) ) ) + & .OR. + & ( ( B%HEAD .GT. B%TAIL ) + & .AND. ( MSG_SIZE_INT .LE. B%HEAD - B%TAIL - 1 ) ) + IF ( .NOT. FLAG + & ) THEN + IERR = -1 + IF ( MSG_SIZE_INT .GT. B%LBUF_INT - 1 ) then + IERR = -2 + ENDIF + IPOS = -1 + IREQ = -1 + RETURN + END IF + IF ( B%HEAD .LE. B%TAIL ) THEN + IF ( MSG_SIZE_INT .LE. B%LBUF_INT - B%TAIL + 1 ) THEN + IBUF = B%TAIL + ELSE IF ( MSG_SIZE_INT .LE. B%HEAD - 1 ) THEN + IBUF = 1 + END IF + ELSE + IBUF = B%TAIL + END IF + B%CONTENT( B%ILASTMSG + NEXT ) = IBUF + B%ILASTMSG = IBUF + B%TAIL = IBUF + MSG_SIZE_INT + B%CONTENT( IBUF + NEXT ) = 0 + IPOS = IBUF + CONTENT + IREQ = IBUF + REQ + RETURN + END SUBROUTINE DMUMPS_4 + SUBROUTINE DMUMPS_1( BUF, SIZE ) + IMPLICIT NONE + TYPE ( DMUMPS_COMM_BUFFER_TYPE ) :: BUF + INTEGER SIZE + INTEGER SIZE_INT + SIZE_INT = ( SIZE + SIZEofINT - 1 ) / SIZEofINT + SIZE_INT = SIZE_INT + OVHSIZE + BUF%TAIL = BUF%ILASTMSG + SIZE_INT + RETURN + END SUBROUTINE DMUMPS_1 + SUBROUTINE DMUMPS_68( + & INODE, NBPROCFILS, NLIG, ILIG, NCOL, ICOL, + & NASS, NSLAVES, LIST_SLAVES, + & DEST, NFRONT, COMM, IERR ) + IMPLICIT NONE + INTEGER COMM, IERR, NFRONT + INTEGER INODE + INTEGER NLIG, NCOL, NASS, NSLAVES + INTEGER NBPROCFILS, DEST + INTEGER ILIG( NLIG ) + INTEGER ICOL( NCOL ) + INTEGER LIST_SLAVES( NSLAVES ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE, POSITION, IPOS, IREQ + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1) = DEST + IERR = 0 + SIZE = ( 6 + NLIG + NCOL + NSLAVES + 1 ) * SIZEofINT + IF (SIZE.GT.SIZE_RBUF_BYTES ) THEN + IERR = -2 + RETURN + END IF + CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + POSITION = IPOS + BUF_CB%CONTENT( POSITION ) = INODE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NBPROCFILS + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NLIG + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NCOL + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NASS + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFRONT + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NSLAVES + POSITION = POSITION + 1 + IF (NSLAVES.GT.0) THEN + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) = + & LIST_SLAVES( 1: NSLAVES ) + POSITION = POSITION + NSLAVES + ENDIF + BUF_CB%CONTENT( POSITION:POSITION + NLIG - 1 ) = ILIG + POSITION = POSITION + NLIG + BUF_CB%CONTENT( POSITION:POSITION + NCOL - 1 ) = ICOL + POSITION = POSITION + NCOL + POSITION = POSITION - IPOS + IF ( POSITION * SIZEofINT .NE. SIZE ) THEN + WRITE(*,*) 'Error in DMUMPS_68 :', + & ' wrong estimated size' + CALL MUMPS_ABORT() + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, MPI_PACKED, + & DEST, MAITRE_DESC_BANDE, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + RETURN + END SUBROUTINE DMUMPS_68 + SUBROUTINE DMUMPS_70( NBROWS_ALREADY_SENT, + & IPERE, ISON, NROW, + & IROW, NCOL, ICOL, VAL, LDA, NELIM, TYPE_SON, + & NSLAVES, SLAVES, DEST, COMM, IERR, + & + & SLAVEF, KEEP,KEEP8, INIV2, TAB_POS_IN_PERE ) + IMPLICIT NONE + INTEGER NBROWS_ALREADY_SENT + INTEGER LDA, NELIM, TYPE_SON + INTEGER IPERE, ISON, NROW, NCOL, NSLAVES + INTEGER IROW( NROW ) + INTEGER ICOL( NCOL ) + INTEGER SLAVES( NSLAVES ) + DOUBLE PRECISION VAL(LDA, *) + INTEGER IPOS, IREQ, DEST, COMM, IERR + INTEGER SLAVEF, KEEP(500), INIV2 + INTEGER(8) KEEP8(150) + INTEGER TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE1, SIZE2, SIZE3, SIZE_PACK, POSITION, I + INTEGER NBROWS_PACKET, NCOL_SEND + INTEGER SIZE_AV + LOGICAL RECV_BUF_SMALLER_THAN_SEND + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1) = DEST + IERR = 0 + IF ( NELIM .NE. NROW ) THEN + WRITE(*,*) 'Error in TRY_SEND_MAITRE2:',NELIM, NROW + CALL MUMPS_ABORT() + END IF + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + CALL MPI_PACK_SIZE( NROW+NCOL+7+NSLAVES, MPI_INTEGER, + & COMM, SIZE1, IERR ) + IF ( ( KEEP(48).NE. 0 ).AND.(TYPE_SON .eq. 2 )) THEN + CALL MPI_PACK_SIZE( NSLAVES+1, MPI_INTEGER, + & COMM, SIZE3, IERR ) + ELSE + SIZE3 = 0 + ENDIF + SIZE1=SIZE1+SIZE3 + ELSE + CALL MPI_PACK_SIZE(7, MPI_INTEGER,COMM,SIZE1,IERR) + ENDIF + IF ( KEEP(50).ne.0 .AND. TYPE_SON .eq. 2 ) THEN + NCOL_SEND = NROW + ELSE + NCOL_SEND = NCOL + ENDIF + CALL DMUMPS_79( BUF_CB, SIZE_AV ) + IF (SIZE_AV .LT. SIZE_RBUF_BYTES) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + SIZE_AV = SIZE_RBUF_BYTES + ENDIF + IF (NROW .GT. 0 ) THEN + NBROWS_PACKET = (SIZE_AV - SIZE1) / NCOL_SEND / SIZEofREAL + NBROWS_PACKET = min(NBROWS_PACKET, NROW - NBROWS_ALREADY_SENT) + NBROWS_PACKET = max(NBROWS_PACKET, 0) + ELSE + NBROWS_PACKET =0 + ENDIF + IF (NBROWS_PACKET .EQ. 0 .AND. NROW .NE. 0) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR=-3 + GOTO 100 + ELSE + IERR=-1 + GOTO 100 + ENDIF + ENDIF + 10 CONTINUE + CALL MPI_PACK_SIZE( NBROWS_PACKET * NCOL_SEND, + & MPI_DOUBLE_PRECISION, + & COMM, SIZE2, IERR ) + SIZE_PACK = SIZE1 + SIZE2 + IF (SIZE_PACK .GT. SIZE_AV) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF ( NBROWS_PACKET .GT. 0 ) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF + IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.NROW .AND. + & SIZE_PACK - SIZE1 .LT. ( SIZE_RBUF_BYTES - SIZE1 ) / 2 + & .AND. + & .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF + CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + GOTO 100 + ENDIF + POSITION = 0 + CALL MPI_PACK( IPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( ISON, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NSLAVES, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NCOL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + IF (NSLAVES.GT.0) THEN + CALL MPI_PACK( SLAVES, NSLAVES, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + CALL MPI_PACK( IROW, NROW, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( ICOL, NCOL, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF ( ( KEEP(48).NE. 0 ).AND.(TYPE_SON .eq. 2 ) ) THEN + CALL MPI_PACK( TAB_POS_IN_PERE(1,INIV2), NSLAVES+1, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + ENDIF + IF (NBROWS_PACKET.GE.1) THEN + DO I=NBROWS_ALREADY_SENT+1, + & NBROWS_ALREADY_SENT+NBROWS_PACKET + CALL MPI_PACK( VAL(1,I), NCOL_SEND, + & MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDDO + ENDIF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, MAITRE2, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK .LT. POSITION ) THEN + write(*,*) 'Try_send_maitre2, SIZE,POSITION=', + & SIZE_PACK,POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE_PACK .NE. POSITION ) + & CALL DMUMPS_1( BUF_CB, POSITION ) + NBROWS_ALREADY_SENT = NBROWS_ALREADY_SENT + NBROWS_PACKET + IF ( NBROWS_ALREADY_SENT .NE. NROW ) THEN + IERR = -1 + ENDIF + 100 CONTINUE + RETURN + END SUBROUTINE DMUMPS_70 + SUBROUTINE DMUMPS_67(NBROWS_ALREADY_SENT, + & DESC_IN_LU, + & IPERE, NFRONT_PERE, NASS_PERE, NFS4FATHER, + & NSLAVES_PERE, + & ISON, NBROW, LMAP, MAPROW, PERM, IW_CBSON, A_CBSON, + & ISLAVE, PDEST, PDEST_MASTER, COMM, IERR, + & + & KEEP,KEEP8, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & COMPRESSCB, KEEP253_LOC ) + IMPLICIT NONE + INTEGER NBROWS_ALREADY_SENT + INTEGER, INTENT (in) :: KEEP253_LOC + INTEGER IPERE, ISON, NBROW + INTEGER PDEST, ISLAVE, COMM, IERR + INTEGER PDEST_MASTER, NASS_PERE, NSLAVES_PERE, + & NFRONT_PERE, LMAP + INTEGER MAPROW( LMAP ), PERM( max(1, NBROW )) + INTEGER IW_CBSON( * ) + DOUBLE PRECISION A_CBSON( * ) + LOGICAL DESC_IN_LU, COMPRESSCB + INTEGER KEEP(500), N , SLAVEF + INTEGER(8) KEEP8(150) + INTEGER STEP(N), + & ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NFS4FATHER,SIZE3,PS1,NCA,LROW1 + INTEGER(8) :: ASIZE + LOGICAL COMPUTE_MAX + INTEGER NBROWS_PACKET + INTEGER MAX_ROW_LENGTH + INTEGER LROW, NELIM + INTEGER(8) :: SIZFR, ITMP8 + INTEGER NPIV, NFRONT, HS + INTEGER SIZE_PACK, SIZE1, SIZE2, POSITION,I + INTEGER SIZE_INTEGERS, B, SIZE_REALS, TMPSIZE, ONEorTWO, SIZE_AV + INTEGER NBINT, L + INTEGER(8) :: APOS, SHIFTCB_SON, LDA_SON8 + INTEGER IPOS_IN_SLAVE + INTEGER STATE_SON + INTEGER INDICE_PERE, NROW, IPOS, IREQ, NOSLA + INTEGER IONE, J, THIS_ROW_LENGTH + INTEGER SIZE_DESC_BANDE, DESC_BANDE_BYTES + LOGICAL RECV_BUF_SMALLER_THAN_SEND + LOGICAL NOT_ENOUGH_SPACE + INTEGER PDEST2(1) + PARAMETER ( IONE=1 ) + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION ZERO + PARAMETER (ZERO = 0.0D0) + COMPUTE_MAX = (KEEP(219) .NE. 0) .AND. + & (KEEP(50) .EQ. 2) .AND. + & (PDEST.EQ.PDEST_MASTER) + IF (NBROWS_ALREADY_SENT == 0) THEN + IF (COMPUTE_MAX) THEN + CALL DMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE. 0) THEN + IERR = -4 + RETURN + ENDIF + ENDIF + ENDIF + PDEST2(1) = PDEST + IERR = 0 + LROW = IW_CBSON( 1 + KEEP(IXSZ)) + NELIM = IW_CBSON( 2 + KEEP(IXSZ)) + NPIV = IW_CBSON( 4 + KEEP(IXSZ)) + IF ( NPIV .LT. 0 ) THEN + NPIV = 0 + END IF + NROW = IW_CBSON( 3 + KEEP(IXSZ)) + NFRONT = LROW + NPIV + HS = 6 + IW_CBSON( 6 + KEEP(IXSZ)) + KEEP(IXSZ) + CALL MUMPS_729( SIZFR, IW_CBSON( 1 + XXR ) ) + STATE_SON = IW_CBSON(1+XXS) + IF (STATE_SON .EQ. S_NOLCBCONTIG) THEN + LDA_SON8 = int(LROW,8) + SHIFTCB_SON = int(NPIV,8)*int(NROW,8) + ELSE IF (STATE_SON .EQ. S_NOLCLEANED) THEN + LDA_SON8 = int(LROW,8) + SHIFTCB_SON = 0_8 + ELSE + LDA_SON8 = int(NFRONT,8) + SHIFTCB_SON = int(NPIV,8) + ENDIF + CALL DMUMPS_79( BUF_CB, SIZE_AV ) + IF (PDEST .EQ. PDEST_MASTER) THEN + SIZE_DESC_BANDE=0 + ELSE + SIZE_DESC_BANDE=(7+SLAVEF+KEEP(127)*2) + SIZE_DESC_BANDE=SIZE_DESC_BANDE+int(dble(KEEP(12))* + & dble(SIZE_DESC_BANDE)/100.0D0) + SIZE_DESC_BANDE=max(SIZE_DESC_BANDE, + & 7+NSLAVES_PERE+NFRONT_PERE+NFRONT_PERE-NASS_PERE) + ENDIF + DESC_BANDE_BYTES=SIZE_DESC_BANDE*SIZEofINT + IF ( SIZE_AV .LT. SIZE_RBUF_BYTES-DESC_BANDE_BYTES ) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + SIZE_AV = SIZE_RBUF_BYTES-DESC_BANDE_BYTES + ENDIF + SIZE1=0 + IF (NBROWS_ALREADY_SENT==0) THEN + IF(COMPUTE_MAX) THEN + CALL MPI_PACK_SIZE(1, MPI_INTEGER, + & COMM, PS1, IERR ) + IF(NFS4FATHER .GT. 0) THEN + CALL MPI_PACK_SIZE( NFS4FATHER, MPI_DOUBLE_PRECISION, + & COMM, SIZE1, IERR ) + ENDIF + SIZE1 = SIZE1+PS1 + ENDIF + ENDIF + IF (KEEP(50) .EQ. 0) THEN + ONEorTWO = 1 + ELSE + ONEorTWO = 2 + ENDIF + IF (PDEST .EQ.PDEST_MASTER) THEN + L = 0 + ELSE IF (KEEP(50) .EQ. 0) THEN + L = LROW + ELSE + L = LROW + PERM(1) - LMAP + NBROWS_ALREADY_SENT - 1 + ONEorTWO=ONEorTWO+1 + ENDIF + NBINT = 6 + L + CALL MPI_PACK_SIZE( NBINT, MPI_INTEGER, + & COMM, TMPSIZE, IERR ) + SIZE1 = SIZE1 + TMPSIZE + SIZE_AV = SIZE_AV - SIZE1 + NOT_ENOUGH_SPACE=.FALSE. + IF (SIZE_AV .LT.0 ) THEN + NBROWS_PACKET = 0 + NOT_ENOUGH_SPACE=.TRUE. + ELSE + IF ( KEEP(50) .EQ. 0 ) THEN + NBROWS_PACKET = + & SIZE_AV / ( ONEorTWO*SIZEofINT+LROW*SIZEofREAL) + ELSE + B = 2 * ONEorTWO + + & ( 1 + 2 * LROW + 2 * PERM(1) + 2 * NBROWS_ALREADY_SENT ) + & * SIZEofREAL / SIZEofINT + NBROWS_PACKET=int((dble(-B)+sqrt((dble(B)*dble(B))+ + & dble(4)*dble(2*SIZE_AV)/dble(SIZEofINT) * + & dble(SIZEofREAL/SIZEofINT)))* + & dble(SIZEofINT) / dble(2) / dble(SIZEofREAL)) + ENDIF + ENDIF + 10 CONTINUE + NBROWS_PACKET = max( 0, + & min( NBROWS_PACKET, NBROW - NBROWS_ALREADY_SENT)) + NOT_ENOUGH_SPACE = NOT_ENOUGH_SPACE .OR. + & (NBROWS_PACKET .EQ.0.AND. NBROW.NE.0) + IF (NOT_ENOUGH_SPACE) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + IF (KEEP(50).EQ.0) THEN + MAX_ROW_LENGTH = -99999 + SIZE_REALS = NBROWS_PACKET * LROW + ELSE + SIZE_REALS = ( LROW + PERM(1) + NBROWS_ALREADY_SENT ) * + & NBROWS_PACKET + ( NBROWS_PACKET * ( NBROWS_PACKET + 1) ) / 2 + MAX_ROW_LENGTH = LROW+PERM(1)-LMAP+NBROWS_ALREADY_SENT + & + NBROWS_PACKET-1 + ENDIF + SIZE_INTEGERS = ONEorTWO* NBROWS_PACKET + CALL MPI_PACK_SIZE( SIZE_REALS, MPI_DOUBLE_PRECISION, + & COMM, SIZE2, IERR) + CALL MPI_PACK_SIZE( SIZE_INTEGERS, MPI_INTEGER, + & COMM, SIZE3, IERR) + IF (SIZE2 + SIZE3 .GT. SIZE_AV ) THEN + NBROWS_PACKET = NBROWS_PACKET -1 + IF (NBROWS_PACKET .GT. 0 ) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF + SIZE_PACK = SIZE1 + SIZE2 + SIZE3 +#if ! defined(DBG_SMB3) + IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.NBROW .AND. + & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 .AND. + & .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF +#endif + CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE , PDEST2 + & ) + IF (IERR .EQ. -1 .OR. IERR.EQ. -2) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF (NBROWS_PACKET > 0 ) GOTO 10 + ENDIF + IF ( IERR .LT. 0 ) GOTO 100 + IF (SIZE_PACK.GT.SIZE_RBUF_BYTES ) THEN + IERR = -3 + GOTO 100 + ENDIF + POSITION = 0 + CALL MPI_PACK( IPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( ISON, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (KEEP(50)==0) THEN + CALL MPI_PACK( LROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ELSE + CALL MPI_PACK( MAX_ROW_LENGTH, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF ( PDEST .NE. PDEST_MASTER ) THEN + IF (KEEP(50)==0) THEN + CALL MPI_PACK( IW_CBSON( HS + NROW + NPIV + 1 ), LROW, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ELSE + IF (MAX_ROW_LENGTH > 0) THEN + CALL MPI_PACK( IW_CBSON( HS + NROW + NPIV + 1 ), + & MAX_ROW_LENGTH, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + ENDIF + END IF + DO J=NBROWS_ALREADY_SENT+1,NBROWS_ALREADY_SENT+NBROWS_PACKET + I = PERM(J) + INDICE_PERE=MAPROW(I) + CALL MUMPS_47( + & KEEP,KEEP8, IPERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + INDICE_PERE = IPOS_IN_SLAVE + CALL MPI_PACK( INDICE_PERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDDO + DO J=NBROWS_ALREADY_SENT+1,NBROWS_ALREADY_SENT+NBROWS_PACKET + I = PERM(J) + INDICE_PERE=MAPROW(I) + CALL MUMPS_47( + & KEEP,KEEP8, IPERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + IF (KEEP(50).ne.0) THEN + THIS_ROW_LENGTH = LROW + I - LMAP + CALL MPI_PACK( THIS_ROW_LENGTH, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ELSE + THIS_ROW_LENGTH = LROW + ENDIF + IF (DESC_IN_LU) THEN + IF ( COMPRESSCB ) THEN + IF (NELIM.EQ.0) THEN + ITMP8 = int(I,8) + ELSE + ITMP8 = int(NELIM+I,8) + ENDIF + APOS = ITMP8 * (ITMP8-1_8) / 2_8 + 1_8 + ELSE + APOS = int(I+NELIM-1, 8) * int(LROW,8) + 1_8 + ENDIF + ELSE + IF ( COMPRESSCB ) THEN + IF ( LROW .EQ. NROW ) THEN + ITMP8 = int(I,8) + APOS = ITMP8 * (ITMP8-1_8)/2_8 + 1_8 + ELSE + ITMP8 = int(I + LROW - NROW,8) + APOS = ITMP8 * (ITMP8-1_8)/2_8 + 1_8 - + & int(LROW - NROW, 8) * int(LROW-NROW+1,8) / 2_8 + ENDIF + ELSE + APOS = int( I - 1, 8 ) * LDA_SON8 + SHIFTCB_SON + 1_8 + ENDIF + ENDIF + CALL MPI_PACK( A_CBSON( APOS ), THIS_ROW_LENGTH, + & MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDDO + IF (NBROWS_ALREADY_SENT == 0) THEN + IF (COMPUTE_MAX) THEN + CALL MPI_PACK(NFS4FATHER,1, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF(NFS4FATHER .GT. 0) THEN + BUF_MAX_ARRAY(1:NFS4FATHER) = ZERO + IF(MAPROW(NROW) .GT. NASS_PERE) THEN + DO PS1=1,NROW + IF(MAPROW(PS1).GT.NASS_PERE) EXIT + ENDDO + IF (DESC_IN_LU) THEN + IF (COMPRESSCB) THEN + APOS = int(NELIM+PS1,8) * int(NELIM+PS1-1,8) / + & 2_8 + 1_8 + NCA = -44444 + ASIZE = int(NROW,8) * int(NROW+1,8)/2_8 - + & int(NELIM+PS1,8) * int(NELIM+PS1-1,8)/2_8 + LROW1 = PS1 + NELIM + ELSE + APOS = int(PS1+NELIM-1,8) * int(LROW,8) + 1_8 + NCA = LROW + ASIZE = int(NCA,8) * int(NROW-PS1+1,8) + LROW1 = LROW + ENDIF + ELSE + IF (COMPRESSCB) THEN + IF (NPIV.NE.0) THEN + WRITE(*,*) "Error in PARPIV/DMUMPS_67" + CALL MUMPS_ABORT() + ENDIF + LROW1=LROW-NROW+PS1 + ITMP8 = int(PS1 + LROW - NROW,8) + APOS = ITMP8 * (ITMP8 - 1_8) / 2_8 + 1_8 - + & int(LROW-NROW,8)*int(LROW-NROW+1,8)/2_8 + ASIZE = int(LROW,8)*int(LROW+1,8)/2_8 - + & ITMP8*(ITMP8-1_8)/2_8 + NCA = -555555 + ELSE + APOS = int(PS1-1,8) * LDA_SON8 + 1_8 + SHIFTCB_SON + NCA = int(LDA_SON8) + ASIZE = SIZFR - (SHIFTCB_SON - + & int(PS1-1,8) * LDA_SON8) + LROW1=-666666 + ENDIF + ENDIF + IF ( NROW-PS1+1-KEEP253_LOC .NE. 0 ) THEN + CALL DMUMPS_618( + & A_CBSON(APOS),ASIZE,NCA, + & NROW-PS1+1-KEEP253_LOC, + & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB,LROW1) + ENDIF + ENDIF + CALL MPI_PACK(BUF_MAX_ARRAY, NFS4FATHER, + & MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + ENDIF + ENDIF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & PDEST, CONTRIB_TYPE2, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK.LT. POSITION ) THEN + WRITE(*,*) ' contniv2: SIZE, POSITION =',SIZE_PACK, POSITION + WRITE(*,*) ' NBROW, LROW = ', NBROW, LROW + CALL MUMPS_ABORT() + END IF + IF ( SIZE_PACK .NE. POSITION ) + & CALL DMUMPS_1( BUF_CB, POSITION ) + NBROWS_ALREADY_SENT=NBROWS_ALREADY_SENT + NBROWS_PACKET + IF (NBROWS_ALREADY_SENT .NE. NBROW ) THEN + IERR = -1 + ENDIF + 100 CONTINUE + RETURN + END SUBROUTINE DMUMPS_67 + SUBROUTINE DMUMPS_71( + & INODE, NFRONT, NASS1, NFS4FATHER, + & ISON, MYID, NSLAVES, SLAVES_PERE, + & TROW, NCBSON, + & COMM, IERR, + & DEST, NDEST, SLAVEF, + & + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & + & ) + IMPLICIT NONE + INTEGER INODE, NFRONT, NASS1, NCBSON, NSLAVES, + & NDEST + INTEGER SLAVEF, MYID, ISON + INTEGER TROW( NCBSON ) + INTEGER DEST( NDEST ) + INTEGER SLAVES_PERE( NSLAVES ) + INTEGER COMM, IERR + INTEGER KEEP(500), N + INTEGER(8) KEEP8(150) + INTEGER STEP(N), + & ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE_AV, IDEST, NSEND, SIZE, NFS4FATHER + INTEGER TROW_SIZE, POSITION, INDX, INIV2 + INTEGER IPOS, IREQ + INTEGER IONE + PARAMETER ( IONE=1 ) + INTEGER NASS_SON + NASS_SON = -99998 + IERR = 0 + IF ( NDEST .eq. 1 ) THEN + IF ( DEST(1).EQ.MYID ) GOTO 500 + SIZE = SIZEofINT * ( 7 + NSLAVES + NCBSON ) + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + SIZE = SIZE + SIZEofINT * ( NSLAVES + 1 ) + ENDIF + CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE, DEST + & ) + IF (IERR .LT. 0 ) THEN + RETURN + ENDIF + IF (SIZE.GT.SIZE_RBUF_BYTES ) THEN + IERR = -3 + RETURN + END IF + POSITION = IPOS + BUF_CB%CONTENT( POSITION ) = INODE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = ISON + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NSLAVES + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFRONT + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NASS1 + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NCBSON + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFS4FATHER + POSITION = POSITION + 1 + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES ) + & = TAB_POS_IN_PERE(1:NSLAVES+1,INIV2) + POSITION = POSITION + NSLAVES + 1 + ENDIF + IF ( NSLAVES .NE. 0 ) THEN + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) + & = SLAVES_PERE( 1: NSLAVES ) + POSITION = POSITION + NSLAVES + END IF + BUF_CB%CONTENT( POSITION:POSITION+NCBSON-1 ) = + & TROW( 1: NCBSON ) + POSITION = POSITION + NCBSON + POSITION = POSITION - IPOS + IF ( POSITION * SIZEofINT .NE. SIZE ) THEN + WRITE(*,*) 'Error in DMUMPS_71 :', + & ' wrong estimated size' + CALL MUMPS_ABORT() + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, + & MPI_PACKED, + & DEST( NDEST ), MAPLIG, COMM, + & BUF_CB%CONTENT( IREQ ), + & IERR ) + ELSE + NSEND = 0 + DO IDEST = 1, NDEST + IF ( DEST( IDEST ) .ne. MYID ) NSEND = NSEND + 1 + END DO + SIZE = SIZEofINT * + & ( ( OVHSIZE + 7 + NSLAVES )* NSEND + NCBSON ) + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + SIZE = SIZE + SIZEofINT * NSEND*( NSLAVES + 1 ) + ENDIF + CALL DMUMPS_79( BUF_CB, SIZE_AV ) + IF ( SIZE_AV .LT. SIZE ) THEN + IERR = -1 + RETURN + END IF + DO IDEST= 1, NDEST + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & IDEST, NCBSON, + & NDEST, + & TROW_SIZE, INDX ) + SIZE = SIZEofINT * ( NSLAVES + TROW_SIZE + 7 ) + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + SIZE = SIZE + SIZEofINT * ( NSLAVES + 1 ) + ENDIF + IF ( MYID .NE. DEST( IDEST ) ) THEN + CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE, DEST(IDEST) + & ) + IF ( IERR .LT. 0 ) THEN + WRITE(*,*) 'Problem in DMUMPS_4: IERR<0' + CALL MUMPS_ABORT() + END IF + IF (SIZE.GT.SIZE_RBUF_BYTES) THEN + IERR = -3 + RETURN + ENDIF + POSITION = IPOS + BUF_CB%CONTENT( POSITION ) = INODE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = ISON + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NSLAVES + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFRONT + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NASS1 + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = TROW_SIZE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFS4FATHER + POSITION = POSITION + 1 + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES ) + & = TAB_POS_IN_PERE(1:NSLAVES+1,INIV2) + POSITION = POSITION + NSLAVES + 1 + ENDIF + IF ( NSLAVES .NE. 0 ) THEN + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) + & = SLAVES_PERE( 1: NSLAVES ) + POSITION = POSITION + NSLAVES + END IF + BUF_CB%CONTENT( POSITION:POSITION+TROW_SIZE-1 ) = + & TROW( INDX: INDX + TROW_SIZE - 1 ) + POSITION = POSITION + TROW_SIZE + POSITION = POSITION - IPOS + IF ( POSITION * SIZEofINT .NE. SIZE ) THEN + WRITE(*,*) ' ERROR 1 in TRY_SEND_MAPLIG:', + & 'Wrong estimated size' + CALL MUMPS_ABORT() + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, + & MPI_PACKED, + & DEST( IDEST ), MAPLIG, COMM, + & BUF_CB%CONTENT( IREQ ), + & IERR ) + END IF + END DO + END IF + 500 CONTINUE + RETURN + END SUBROUTINE DMUMPS_71 + SUBROUTINE DMUMPS_65( INODE, NFRONT, + & NCOL, NPIV, FPERE, LASTBL, IPIV, VAL, + & PDEST, NDEST, KEEP50, NB_BLOC_FAC, COMM, IERR ) + IMPLICIT NONE + INTEGER INODE, NCOL, NPIV, FPERE, NFRONT, NDEST + INTEGER IPIV( NPIV ) + DOUBLE PRECISION VAL( NFRONT, * ) + INTEGER PDEST( NDEST ) + INTEGER KEEP50, NB_BLOC_FAC, COMM, IERR + LOGICAL LASTBL + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE, + & IDEST, IPOSMSG, I + INTEGER NPIVSENT + INTEGER SSS, SS2 + IERR = 0 + IF ( LASTBL ) THEN + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 4 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + ELSE + CALL MPI_PACK_SIZE( 6 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + END IF + ELSE + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 3 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + ELSE + CALL MPI_PACK_SIZE( 4 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + END IF + END IF + SIZE2 = 0 + IF (NPIV.GT.0) + & CALL MPI_PACK_SIZE( NPIV*NCOL, MPI_DOUBLE_PRECISION, + & COMM, SIZE2, IERR ) + SIZE = SIZE1 + SIZE2 + CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & NDEST , PDEST + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + IF (SIZE.GT.SIZE_RBUF_BYTES) THEN + SSS = 0 + IF ( LASTBL ) THEN + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 4 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + ELSE + CALL MPI_PACK_SIZE( 6 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + END IF + ELSE + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 3 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + ELSE + CALL MPI_PACK_SIZE( 4 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + END IF + END IF + IF (NPIV.GT.0) + & CALL MPI_PACK_SIZE( NPIV*NCOL, MPI_DOUBLE_PRECISION, + & COMM, SS2, IERR ) + SSS = SSS + SS2 + IF (SSS.GT.SIZE_RBUF_BYTES) THEN + IERR = -2 + RETURN + ENDIF + ENDIF + BUF_CB%ILASTMSG = BUF_CB%ILASTMSG + ( NDEST - 1 ) * OVHSIZE + IPOS = IPOS - OVHSIZE + DO IDEST = 1, NDEST - 1 + BUF_CB%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = + & IPOS + IDEST * OVHSIZE + END DO + BUF_CB%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 + IPOSMSG = IPOS + OVHSIZE * NDEST + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + NPIVSENT = NPIV + IF (LASTBL) NPIVSENT = -NPIV + CALL MPI_PACK( NPIVSENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + IF ( LASTBL .or. KEEP50.ne.0 ) THEN + CALL MPI_PACK( FPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + END IF + IF ( LASTBL .AND. KEEP50 .NE. 0 ) THEN + CALL MPI_PACK( NDEST, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NB_BLOC_FAC, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + END IF + CALL MPI_PACK( NCOL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + IF ( NPIV.GT.0) THEN + CALL MPI_PACK( IPIV, NPIV, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + DO I = 1, NPIV + CALL MPI_PACK( VAL(1,I), NCOL, + & MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + END DO + ENDIF + DO IDEST = 1, NDEST + IF ( KEEP50.eq.0) THEN + CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, + & PDEST(IDEST), BLOC_FACTO, COMM, + & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), + & IERR ) + ELSE + CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, + & PDEST(IDEST), BLOC_FACTO_SYM, COMM, + & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), + & IERR ) + END IF + END DO + SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT + IF ( SIZE .LT. POSITION ) THEN + WRITE(*,*) ' Error sending blocfacto : size < position' + WRITE(*,*) ' Size,position=',SIZE,POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE .NE. POSITION ) CALL DMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE DMUMPS_65 + SUBROUTINE DMUMPS_64( INODE, + & NPIV, FPERE, IPOSK, JPOSK, UIP21K, NCOLU, + & NDEST, PDEST, COMM, IERR ) + IMPLICIT NONE + INTEGER INODE, NCOLU, IPOSK, JPOSK, NPIV, NDEST, FPERE + DOUBLE PRECISION UIP21K( NPIV, NCOLU ) + INTEGER PDEST( NDEST ) + INTEGER COMM, IERR + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE, + & IDEST, IPOSMSG, SSS, SS2 + IERR = 0 + CALL MPI_PACK_SIZE( 6 + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + CALL MPI_PACK_SIZE( abs(NPIV)*NCOLU, MPI_DOUBLE_PRECISION, + & COMM, SIZE2, IERR ) + SIZE = SIZE1 + SIZE2 + IF (SIZE.GT.SIZE_RBUF_BYTES) THEN + CALL MPI_PACK_SIZE( 6 , + & MPI_INTEGER, COMM, SSS, IERR ) + CALL MPI_PACK_SIZE( abs(NPIV)*NCOLU, MPI_DOUBLE_PRECISION, + & COMM, SS2, IERR ) + SSS = SSS+SS2 + IF (SSS.GT.SIZE_RBUF_BYTES) THEN + IERR = -2 + RETURN + ENDIF + END IF + CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & NDEST, PDEST + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + BUF_CB%ILASTMSG = BUF_CB%ILASTMSG + ( NDEST - 1 ) * OVHSIZE + IPOS = IPOS - OVHSIZE + DO IDEST = 1, NDEST - 1 + BUF_CB%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = + & IPOS + IDEST * OVHSIZE + END DO + BUF_CB%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 + IPOSMSG = IPOS + OVHSIZE * NDEST + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IPOSK, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( JPOSK, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NPIV, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( FPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NCOLU, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( UIP21K, abs(NPIV) * NCOLU, + & MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + DO IDEST = 1, NDEST + CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, + & PDEST(IDEST), BLOC_FACTO_SYM_SLAVE, COMM, + & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), + & IERR ) + END DO + SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT + IF ( SIZE .LT. POSITION ) THEN + WRITE(*,*) ' Error sending blfac slave : size < position' + WRITE(*,*) ' Size,position=',SIZE,POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE .NE. POSITION ) CALL DMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE DMUMPS_64 + SUBROUTINE DMUMPS_648( N, ISON, + & NBCOL_SON, NBROW_SON, INDCOL_SON, INDROW_SON, + & LD_SON, VAL_SON, TAG, SUBSET_ROW, SUBSET_COL, + & NSUBSET_ROW, NSUBSET_COL, + & NSUPROW, NSUPCOL, + & NPROW, NPCOL, MBLOCK, RG2L_ROW, RG2L_COL, + & NBLOCK, PDEST, COMM, IERR , + & TAB, TABSIZE, TRANSP, SIZE_PACK, + & N_ALREADY_SENT, KEEP, BBPCBP ) + IMPLICIT NONE + INTEGER N, ISON, NBCOL_SON, NBROW_SON, NSUBSET_ROW, NSUBSET_COL + INTEGER NPROW, NPCOL, MBLOCK, NBLOCK, LD_SON + INTEGER BBPCBP + INTEGER PDEST, TAG, COMM, IERR + INTEGER INDCOL_SON( NBCOL_SON ), INDROW_SON( NBROW_SON ) + INTEGER SUBSET_ROW( NSUBSET_ROW ), SUBSET_COL( NSUBSET_COL ) + INTEGER, DIMENSION(:) :: RG2L_ROW + INTEGER, DIMENSION(:) :: RG2L_COL + INTEGER NSUPROW, NSUPCOL + INTEGER(8), INTENT(IN) :: TABSIZE + INTEGER SIZE_PACK + INTEGER KEEP(500) + DOUBLE PRECISION VAL_SON( LD_SON, * ), TAB(*) + LOGICAL TRANSP + INTEGER N_ALREADY_SENT + INCLUDE 'mpif.h' + INTEGER SIZE1, SIZE2, SIZE_AV, POSITION + INTEGER SIZE_CBP, SIZE_TMP + INTEGER IREQ, IPOS, ITAB + INTEGER ISUB, JSUB, I, J + INTEGER ILOC_ROOT, JLOC_ROOT + INTEGER IPOS_ROOT, JPOS_ROOT + INTEGER IONE + LOGICAL RECV_BUF_SMALLER_THAN_SEND + INTEGER PDEST2(1) + PARAMETER ( IONE=1 ) + INTEGER N_PACKET + INTEGER NSUBSET_ROW_EFF, NSUBSET_COL_EFF, NSUPCOL_EFF + PDEST2(1) = PDEST + IERR = 0 + IF ( NSUBSET_ROW * NSUBSET_COL .NE. 0 ) THEN + CALL DMUMPS_79( BUF_CB, SIZE_AV ) + IF (SIZE_AV .LT. SIZE_RBUF_BYTES) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + SIZE_AV = SIZE_RBUF_BYTES + ENDIF + SIZE_AV = min(SIZE_AV, SIZE_RBUF_BYTES) + CALL MPI_PACK_SIZE(8 + NSUBSET_COL, + & MPI_INTEGER, COMM, SIZE1, IERR ) + SIZE_CBP = 0 + IF (N_ALREADY_SENT .EQ. 0 .AND. + & min(NSUPROW,NSUPCOL) .GT.0) THEN + CALL MPI_PACK_SIZE(NSUPROW, MPI_INTEGER, COMM, + & SIZE_CBP, IERR) + CALL MPI_PACK_SIZE(NSUPCOL, MPI_INTEGER, COMM, + & SIZE_TMP, IERR) + SIZE_CBP = SIZE_CBP + SIZE_TMP + CALL MPI_PACK_SIZE(NSUPROW*NSUPCOL, + & MPI_DOUBLE_PRECISION, COMM, + & SIZE_TMP, IERR) + SIZE_CBP = SIZE_CBP + SIZE_TMP + SIZE1 = SIZE1 + SIZE_CBP + ENDIF + IF (BBPCBP.EQ.1) THEN + NSUBSET_COL_EFF = NSUBSET_COL - NSUPCOL + NSUPCOL_EFF = 0 + ELSE + NSUBSET_COL_EFF = NSUBSET_COL + NSUPCOL_EFF = NSUPCOL + ENDIF + NSUBSET_ROW_EFF = NSUBSET_ROW - NSUPROW + N_PACKET = + & (SIZE_AV - SIZE1) / (SIZEofINT + NSUBSET_COL_EFF * SIZEofREAL) + 10 CONTINUE + N_PACKET = min( N_PACKET, + & NSUBSET_ROW_EFF-N_ALREADY_SENT ) + IF (N_PACKET .LE. 0 .AND. + & NSUBSET_ROW_EFF-N_ALREADY_SENT.GT.0) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR=-3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + CALL MPI_PACK_SIZE( 8 + NSUBSET_COL_EFF + N_PACKET, + & MPI_INTEGER, COMM, SIZE1, IERR ) + SIZE1 = SIZE1 + SIZE_CBP + CALL MPI_PACK_SIZE( N_PACKET * NSUBSET_COL_EFF, + & MPI_DOUBLE_PRECISION, + & COMM, SIZE2, IERR ) + SIZE_PACK = SIZE1 + SIZE2 + IF (SIZE_PACK .GT. SIZE_AV) THEN + N_PACKET = N_PACKET - 1 + IF ( N_PACKET > 0 ) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF +#if ! defined(DBG_SMB3) + IF (N_PACKET + N_ALREADY_SENT .NE. NSUBSET_ROW - NSUPROW + & .AND. + & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 + & .AND. .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF +#endif + ELSE + N_PACKET = 0 + CALL MPI_PACK_SIZE(8,MPI_INTEGER, COMM, SIZE_PACK, IERR ) + END IF + CALL DMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE, PDEST2 + & ) + IF ( IERR .LT. 0 ) GOTO 100 + IF ( SIZE_PACK.GT.SIZE_RBUF_BYTES ) THEN + IERR = -3 + GOTO 100 + ENDIF + POSITION = 0 + CALL MPI_PACK( ISON, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUBSET_ROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUPROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUBSET_COL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUPCOL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( N_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( N_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( BBPCBP, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + IF ( NSUBSET_ROW * NSUBSET_COL .NE. 0 ) THEN + IF (N_ALREADY_SENT .EQ. 0 .AND. + & min(NSUPROW, NSUPCOL) .GT. 0) THEN + DO ISUB = NSUBSET_ROW-NSUPROW+1, NSUBSET_ROW + I = SUBSET_ROW( ISUB ) + IPOS_ROOT = RG2L_ROW(INDCOL_SON( I )) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + DO ISUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL + J = SUBSET_COL( ISUB ) + JPOS_ROOT = INDROW_SON( J ) - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + IF ( TABSIZE.GE.int(NSUPROW,8)*int(NSUPCOL,8) ) THEN + ITAB = 1 + DO JSUB = NSUBSET_ROW - NSUPROW+1, NSUBSET_ROW + J = SUBSET_ROW(JSUB) + DO ISUB = NSUBSET_COL - NSUPCOL+1, NSUBSET_COL + I = SUBSET_COL(ISUB) + TAB(ITAB) = VAL_SON(J, I) + ITAB = ITAB + 1 + ENDDO + ENDDO + CALL MPI_PACK(TAB(1), NSUPROW*NSUPCOL, + & MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ELSE + DO JSUB = NSUBSET_ROW - NSUPROW+1, NSUBSET_ROW + J = SUBSET_ROW(JSUB) + DO ISUB = NSUBSET_COL - NSUPCOL+1, NSUBSET_COL + I = SUBSET_COL(ISUB) + CALL MPI_PACK(VAL_SON(J,I), 1, + & MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + ENDDO + ENDIF + ENDIF + IF ( .NOT. TRANSP ) THEN + DO ISUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + I = SUBSET_ROW( ISUB ) + IPOS_ROOT = RG2L_ROW( INDROW_SON( I ) ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO JSUB = 1, NSUBSET_COL_EFF - NSUPCOL_EFF + J = SUBSET_COL( JSUB ) + JPOS_ROOT = RG2L_COL( INDCOL_SON( J ) ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO JSUB = NSUBSET_COL_EFF-NSUPCOL_EFF+1, NSUBSET_COL_EFF + J = SUBSET_COL( JSUB ) + JPOS_ROOT = INDCOL_SON( J ) - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + ELSE + DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + J = SUBSET_ROW( JSUB ) + IPOS_ROOT = RG2L_ROW( INDCOL_SON( J ) ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO ISUB = 1, NSUBSET_COL_EFF - NSUPCOL_EFF + I = SUBSET_COL( ISUB ) + JPOS_ROOT = RG2L_COL( INDROW_SON( I ) ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO ISUB = NSUBSET_COL_EFF - NSUPCOL_EFF + 1, NSUBSET_COL_EFF + I = SUBSET_COL( ISUB ) + JPOS_ROOT = INDROW_SON(I) - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + END IF + IF ( TABSIZE.GE.int(N_PACKET,8)*int(NSUBSET_COL_EFF,8) ) THEN + IF ( .NOT. TRANSP ) THEN + ITAB = 1 + DO ISUB = N_ALREADY_SENT+1, + & N_ALREADY_SENT+N_PACKET + I = SUBSET_ROW( ISUB ) + DO JSUB = 1, NSUBSET_COL_EFF + J = SUBSET_COL( JSUB ) + TAB( ITAB ) = VAL_SON(J,I) + ITAB = ITAB + 1 + END DO + END DO + CALL MPI_PACK(TAB(1), NSUBSET_COL_EFF*N_PACKET, + & MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ELSE + ITAB = 1 + DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + J = SUBSET_ROW( JSUB ) + DO ISUB = 1, NSUBSET_COL_EFF + I = SUBSET_COL( ISUB ) + TAB( ITAB ) = VAL_SON( J, I ) + ITAB = ITAB + 1 + END DO + END DO + CALL MPI_PACK(TAB(1), NSUBSET_COL_EFF*N_PACKET, + & MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END IF + ELSE + IF ( .NOT. TRANSP ) THEN + DO ISUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + I = SUBSET_ROW( ISUB ) + DO JSUB = 1, NSUBSET_COL_EFF + J = SUBSET_COL( JSUB ) + CALL MPI_PACK( VAL_SON( J, I ), 1, + & MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + END DO + ELSE + DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + J = SUBSET_ROW( JSUB ) + DO ISUB = 1, NSUBSET_COL_EFF + I = SUBSET_COL( ISUB ) + CALL MPI_PACK( VAL_SON( J, I ), 1, + & MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + END DO + END IF + ENDIF + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & PDEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK .LT. POSITION ) THEN + WRITE(*,*) ' Error sending contribution to root:Sizeid%ISTEP_TO_INIV2 + CAND_LOAD=>id%CANDIDATES + ND_LOAD=>id%ND_STEPS + KEEP_LOAD=>id%KEEP + KEEP =>id%KEEP + KEEP8_LOAD=>id%KEEP8 + FILS_LOAD=>id%FILS + FRERE_LOAD=>id%FRERE_STEPS + DAD_LOAD=>id%DAD_STEPS + PROCNODE_LOAD=>id%PROCNODE_STEPS + STEP_LOAD=>id%STEP + NE_LOAD=>id%NE_STEPS + N_LOAD=id%N + ROOT_CURRENT_SUBTREE=-9999 + MEMORY_MD=MEMORY_MD_ARG + LA=MAXS + MAX_SURF_MASTER=id%MAX_SURF_MASTER+ + & (int(id%KEEP(12),8)*int(id%MAX_SURF_MASTER,8)/int(100,8)) + COMM_LD = id%COMM_LOAD + MAX_PEAK_STK = 0.0D0 + K69 = KEEP(69) + IF ( KEEP(47) .le. 0 .OR. KEEP(47) .gt. 4 ) THEN + write(*,*) "Internal error 1 in DMUMPS_185" + CALL MUMPS_ABORT() + END IF + CHK_LD=dble(0) + BDC_MEM = ( KEEP(47) >= 2 ) + BDC_POOL = ( KEEP(47) >= 3 ) + BDC_SBTR = ( KEEP(47) >= 4 ) + BDC_M2_MEM = ( ( KEEP(80) == 2 .OR. KEEP(80) == 3 ) + & .AND. KEEP(47) == 4 ) + BDC_M2_FLOPS = ( KEEP(80) == 1 + & .AND. KEEP(47) .GE. 1 ) + BDC_MD = (KEEP(86)==1) + SBTR_WHICH_M = KEEP(90) + REMOVE_NODE_FLAG=.FALSE. + REMOVE_NODE_FLAG_MEM=.FALSE. + REMOVE_NODE_COST_MEM=dble(0) + REMOVE_NODE_COST=dble(0) + IF (KEEP(80) .LT. 0 .OR. KEEP(80)>3) THEN + WRITE(*,*) "Unimplemented KEEP(80) Strategy" + CALL MUMPS_ABORT() + ENDIF + IF ((KEEP(80) == 2 .OR. KEEP(80)==3 ).AND. KEEP(47).NE.4) + & THEN + WRITE(*,*) "Internal error 3 in DMUMPS_185" + CALL MUMPS_ABORT() + END IF + IF (KEEP(81) == 1 .AND. KEEP(47) < 2) THEN + WRITE(*,*) "Internal error 2 in DMUMPS_185" + CALL MUMPS_ABORT() + ENDIF + BDC_POOL_MNG = ((KEEP(81) == 1).AND.(KEEP(47) >= 2)) + IF(KEEP(76).EQ.4)THEN + DEPTH_FIRST_LOAD=>id%DEPTH_FIRST + ENDIF + IF(KEEP(76).EQ.5)THEN + COST_TRAV=>id%COST_TRAV + ENDIF + IF(KEEP(76).EQ.6)THEN + DEPTH_FIRST_LOAD=>id%DEPTH_FIRST + DEPTH_FIRST_SEQ_LOAD=>id%DEPTH_FIRST_SEQ + SBTR_ID_LOAD=>id%SBTR_ID + ENDIF + IF (BDC_M2_MEM.OR.BDC_M2_FLOPS) THEN + ALLOCATE(NIV2(id%NSLAVES), NB_SON(KEEP(28)), + & POOL_NIV2(100),POOL_NIV2_COST(100), + & stat=allocok) + NB_SON=id%NE_STEPS + NIV2=dble(0) + IF (allocok > 0) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = id%NSLAVES + KEEP(28) + 200 + RETURN + ENDIF + ENDIF + K50 = id%KEEP(50) + CALL MPI_COMM_RANK( COMM_LD, MYID, IERR ) + NPROCS = id%NSLAVES + DM_SUMLU=ZERO + POOL_SIZE=0 + IF(BDC_MD)THEN + IF ( allocated(MD_MEM) ) DEALLOCATE(MD_MEM) + ALLOCATE( MD_MEM( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(TAB_MAXS) ) DEALLOCATE(TAB_MAXS) + ALLOCATE( TAB_MAXS( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + TAB_MAXS=0_8 + IF ( allocated(LU_USAGE) ) DEALLOCATE(LU_USAGE) + ALLOCATE( LU_USAGE( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + LU_USAGE=dble(0) + MD_MEM=int(0,8) + ENDIF + IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN + ALLOCATE(CB_COST_MEM(2*2000*id%NSLAVES), + & stat=allocok) + IF (allocok > 0) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = id%NSLAVES + RETURN + ENDIF + CB_COST_MEM=int(0,8) + ALLOCATE(CB_COST_ID(2000*3), + & stat=allocok) + IF (allocok > 0) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = id%NSLAVES + RETURN + ENDIF + CB_COST_ID=0 + POS_MEM=1 + POS_ID=1 + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + ALLOCATE(FUTURE_NIV2(NPROCS), stat=allocok) + IF (allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + ENDIF + DO i = 1, NPROCS + FUTURE_NIV2(i) = id%FUTURE_NIV2(i) + IF(BDC_MD)THEN + IF(FUTURE_NIV2(i).EQ.0)THEN + MD_MEM(i-1)=999999999_8 + ENDIF + ENDIF + ENDDO + DELTA_MEM=ZERO + DELTA_LOAD=ZERO +#endif + CHECK_MEM=0_8 +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + NB_LEVEL2=0 + AMI_CHOSEN=.FALSE. + IS_DISPLAYED=.FALSE. +#endif +#endif + IF(BDC_SBTR.OR.BDC_POOL_MNG)THEN + NB_SUBTREES=id%NBSA_LOCAL + IF (allocated(MEM_SUBTREE)) DEALLOCATE(MEM_SUBTREE) + ALLOCATE(MEM_SUBTREE(id%NBSA_LOCAL),stat=allocok) + DO i=1,id%NBSA_LOCAL + MEM_SUBTREE(i)=id%MEM_SUBTREE(i) + ENDDO + MY_FIRST_LEAF=>id%MY_FIRST_LEAF + MY_NB_LEAF=>id%MY_NB_LEAF + MY_ROOT_SBTR=>id%MY_ROOT_SBTR + IF (allocated(SBTR_FIRST_POS_IN_POOL)) + & DEALLOCATE(SBTR_FIRST_POS_IN_POOL) + ALLOCATE(SBTR_FIRST_POS_IN_POOL(id%NBSA_LOCAL),stat=allocok) + INSIDE_SUBTREE=0 + PEAK_SBTR_CUR_LOCAL = dble(0) + SBTR_CUR_LOCAL = dble(0) + IF (allocated(SBTR_PEAK_ARRAY)) DEALLOCATE(SBTR_PEAK_ARRAY) + ALLOCATE(SBTR_PEAK_ARRAY(id%NBSA_LOCAL),stat=allocok) + SBTR_PEAK_ARRAY=dble(0) + IF (allocated(SBTR_CUR_ARRAY)) DEALLOCATE(SBTR_CUR_ARRAY) + ALLOCATE(SBTR_CUR_ARRAY(id%NBSA_LOCAL),stat=allocok) + SBTR_CUR_ARRAY=dble(0) + INDICE_SBTR_ARRAY=1 + NIV1_FLAG=0 + INDICE_SBTR=1 + ENDIF + IF ( allocated(LOAD_FLOPS) ) DEALLOCATE( LOAD_FLOPS ) + ALLOCATE( LOAD_FLOPS( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(WLOAD) ) DEALLOCATE( WLOAD ) + ALLOCATE( WLOAD( NPROCS ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(IDWLOAD) ) DEALLOCATE( IDWLOAD ) + ALLOCATE( IDWLOAD( NPROCS ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( BDC_MEM ) THEN + IF ( allocated(DM_MEM) ) DEALLOCATE( DM_MEM ) + ALLOCATE( DM_MEM( 0:NPROCS-1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + END IF + IF ( BDC_POOL ) THEN + IF ( allocated(POOL_MEM) ) DEALLOCATE(POOL_MEM) + ALLOCATE( POOL_MEM(0: NPROCS -1), stat=allocok) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + POOL_MEM = dble(0) + POOL_LAST_COST_SENT = dble(0) + END IF + IF ( BDC_SBTR ) THEN + IF ( allocated(SBTR_MEM) ) DEALLOCATE(SBTR_MEM) + ALLOCATE( SBTR_MEM(0: NPROCS -1), stat=allocok) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(SBTR_CUR) ) DEALLOCATE(SBTR_CUR) + ALLOCATE( SBTR_CUR(0: NPROCS -1), stat=allocok) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + SBTR_CUR = dble(0) + SBTR_MEM = dble(0) + END IF + CALL MUMPS_546(K34_LOC,K35_LOC) + K35 = K35_LOC + BUF_LOAD_SIZE = K34_LOC * 2 * ( NPROCS - 1 ) + + & NPROCS * ( K35_LOC + K34_LOC ) + IF (BDC_MEM) THEN + BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35_LOC + END IF + IF (BDC_SBTR)THEN + BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35_LOC + ENDIF + LBUF_LOAD_RECV = (BUF_LOAD_SIZE+K34_LOC)/K34_LOC + LBUF_LOAD_RECV_BYTES = LBUF_LOAD_RECV * K34_LOC + IF ( allocated(BUF_LOAD_RECV) ) DEALLOCATE(BUF_LOAD_RECV) + ALLOCATE( BUF_LOAD_RECV( LBUF_LOAD_RECV), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = LBUF_LOAD_RECV + RETURN + ENDIF + BUF_LOAD_SIZE = BUF_LOAD_SIZE * 20 + CALL DMUMPS_54( BUF_LOAD_SIZE, IERR ) + IF ( IERR .LT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = BUF_LOAD_SIZE + RETURN + END IF + DO i = 0, NPROCS - 1 + LOAD_FLOPS( i ) = ZERO + END DO +#if defined(OLD_LOAD_MECHANISM) + LOAD_FLOPS( MYID ) = COST_SUBTREE + LAST_LOAD_SENT = ZERO +#endif + IF ( BDC_MEM ) THEN + DO i = 0, NPROCS - 1 + DM_MEM( i )=ZERO + END DO +#if defined(OLD_LOAD_MECHANISM) + DM_LAST_MEM_SENT=ZERO +#endif + ENDIF + CALL DMUMPS_425(KEEP(69)) + IF(BDC_MD)THEN + MAX_SBTR=0.0D0 + IF(BDC_SBTR)THEN + DO i=1,id%NBSA_LOCAL + MAX_SBTR=max(id%MEM_SUBTREE(i),MAX_SBTR) + ENDDO + ENDIF + MD_MEM(MYID)=MEMORY_MD + WHAT=8 + CALL DMUMPS_460( WHAT, + & COMM_LD, NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & dble(MEMORY_MD),dble(0) ,MYID, IERR ) + WHAT=9 + MEMORY_SENT = dble(LA-MAX_SURF_MASTER)-MAX_SBTR + & - max( dble(LA) * dble(3) / dble(100), + & dble(2) * dble(max(KEEP(5),KEEP(6))) * dble(KEEP(127))) + IF (KEEP(12) > 25) THEN + MEMORY_SENT = MEMORY_SENT - + & dble(KEEP(12))*0.2d0*dble(LA)/100.0d0 + ENDIF + TAB_MAXS(MYID)=int(MEMORY_SENT,8) + CALL DMUMPS_460( WHAT, + & COMM_LD, NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & MEMORY_SENT, + & dble(0),MYID, IERR ) + ENDIF + RETURN + END SUBROUTINE DMUMPS_185 + SUBROUTINE DMUMPS_190( CHECK_FLOPS,PROCESS_BANDE, + & INC_LOAD, KEEP,KEEP8 ) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + DOUBLE PRECISION INC_LOAD + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + LOGICAL PROCESS_BANDE + INTEGER CHECK_FLOPS + INTEGER IERR + DOUBLE PRECISION ZERO, SEND_MEM, SEND_LOAD,SBTR_TMP + PARAMETER( ZERO=0.0d0 ) + INTRINSIC max, abs + IF (INC_LOAD == 0.0D0) THEN + IF(REMOVE_NODE_FLAG)THEN + REMOVE_NODE_FLAG=.FALSE. + ENDIF + RETURN + ENDIF + IF((CHECK_FLOPS.NE.0).AND. + & (CHECK_FLOPS.NE.1).AND.(CHECK_FLOPS.NE.2))THEN + WRITE(*,*)MYID,': Bad value for CHECK_FLOPS' + CALL MUMPS_ABORT() + ENDIF + IF(CHECK_FLOPS.EQ.1)THEN + CHK_LD=CHK_LD+INC_LOAD + ELSE + IF(CHECK_FLOPS.EQ.2)THEN + RETURN + ENDIF + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF ( PROCESS_BANDE ) THEN + RETURN + ENDIF +#endif + LOAD_FLOPS( MYID ) = max( LOAD_FLOPS( MYID ) + INC_LOAD, ZERO) + IF(BDC_M2_FLOPS.AND.REMOVE_NODE_FLAG)THEN + IF(INC_LOAD.NE.REMOVE_NODE_COST)THEN + IF(INC_LOAD.GT.REMOVE_NODE_COST)THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = DELTA_LOAD + + & (INC_LOAD-REMOVE_NODE_COST) + GOTO 888 +#else + GOTO 888 +#endif + ELSE +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = DELTA_LOAD - + & (REMOVE_NODE_COST-INC_LOAD) + GOTO 888 +#else + GOTO 888 +#endif + ENDIF + ENDIF + GOTO 333 + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = DELTA_LOAD + INC_LOAD + 888 CONTINUE + IF ( DELTA_LOAD > MIN_DIFF .OR. DELTA_LOAD < -MIN_DIFF) THEN + SEND_LOAD = DELTA_LOAD + IF (BDC_MEM) THEN + SEND_MEM = DELTA_MEM + ELSE + SEND_MEM = ZERO + END IF +#else + 888 CONTINUE + IF ( abs( LOAD_FLOPS ( MYID ) - + & LAST_LOAD_SENT ).GT.MIN_DIFF)THEN + IERR = 0 + SEND_LOAD = LOAD_FLOPS( MYID ) + IF ( BDC_MEM ) THEN + SEND_MEM = DM_MEM(MYID) + ELSE + SEND_MEM = ZERO + END IF +#endif + IF(BDC_SBTR)THEN + SBTR_TMP=SBTR_CUR(MYID) + ELSE + SBTR_TMP=dble(0) + ENDIF + 111 CONTINUE + CALL DMUMPS_77( BDC_SBTR,BDC_MEM, + & BDC_MD,COMM_LD, NPROCS, + & SEND_LOAD, + & SEND_MEM,SBTR_TMP, + & DM_SUMLU, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & MYID, IERR ) + IF ( IERR == -1 )THEN + CALL DMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE.0 ) THEN + WRITE(*,*) "Internal Error in DMUMPS_190",IERR + CALL MUMPS_ABORT() + ENDIF + IF ( IERR .EQ. 0 ) THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = ZERO + IF (BDC_MEM) DELTA_MEM = ZERO +#else + LAST_LOAD_SENT = LOAD_FLOPS( MYID ) + IF ( BDC_MEM ) DM_LAST_MEM_SENT = DM_MEM( MYID ) +#endif + END IF + ENDIF + 333 CONTINUE + IF(REMOVE_NODE_FLAG)THEN + REMOVE_NODE_FLAG=.FALSE. + ENDIF + RETURN + END SUBROUTINE DMUMPS_190 + SUBROUTINE DMUMPS_471( SSARBR, + & PROCESS_BANDE_ARG, MEM_VALUE, NEW_LU, INC_MEM_ARG, + & KEEP,KEEP8,LRLU) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER(8), INTENT(IN) :: MEM_VALUE, INC_MEM_ARG, NEW_LU,LRLU + LOGICAL, INTENT(IN) :: PROCESS_BANDE_ARG, SSARBR + INTEGER IERR, KEEP(500) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION ZERO, SEND_MEM, SBTR_TMP + PARAMETER( ZERO=0.0d0 ) + INTRINSIC max, abs + INTEGER(8) :: INC_MEM + LOGICAL PROCESS_BANDE +#if defined(OLD_LOAD_MECHANISM) + DOUBLE PRECISION TMP_MEM +#endif + PROCESS_BANDE=PROCESS_BANDE_ARG + INC_MEM = INC_MEM_ARG +#if ! defined(OLD_LOAD_MECHANISM) + IF ( PROCESS_BANDE .AND. NEW_LU .NE. 0_8) THEN + WRITE(*,*) " Internal Error in DMUMPS_471." + WRITE(*,*) " NEW_LU must be zero if called from PROCESS_BANDE" + CALL MUMPS_ABORT() + ENDIF +#endif +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + IF(PROCESS_BANDE)THEN + PROCESS_BANDE=.FALSE. + NB_LEVEL2=NB_LEVEL2-1 + IF(NB_LEVEL2.LT.0)THEN + WRITE(*,*)MYID,': problem with NB_LEVEL2' + ELSEIF(NB_LEVEL2.EQ.0)THEN + IF(IS_DISPLAYED)THEN +#if defined(STATS_DYNAMIC_MEMORY) + WRITE(*,*)MYID,': end of Incoherent state at time=', + & MPI_WTIME()-TIME_REF +#endif + IS_DISPLAYED=.FALSE. + ENDIF + AMI_CHOSEN=.FALSE. + ENDIF + ENDIF + IF((KEEP(73).EQ.0).AND.(NB_LEVEL2.NE.0) + & .AND.(.NOT.IS_DISPLAYED))THEN + IS_DISPLAYED=.TRUE. +#if defined(STATS_DYNAMIC_MEMORY) + WRITE(*,*)MYID,': Begin of Incoherent state (1) at time=', + & MPI_WTIME()-TIME_REF +#endif + ENDIF +#endif +#endif + DM_SUMLU = DM_SUMLU + dble(NEW_LU) + IF(KEEP_LOAD(201).EQ.0)THEN + CHECK_MEM = CHECK_MEM + INC_MEM + ELSE + CHECK_MEM = CHECK_MEM + INC_MEM - NEW_LU + ENDIF + IF ( MEM_VALUE .NE. CHECK_MEM ) THEN + WRITE(*,*)MYID, + & ':Problem with increments in DMUMPS_471', + & CHECK_MEM, MEM_VALUE, INC_MEM,NEW_LU + CALL MUMPS_ABORT() + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (PROCESS_BANDE) THEN + RETURN + ENDIF +#endif + IF(BDC_POOL_MNG) THEN + IF(SBTR_WHICH_M.EQ.0)THEN + IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+ + & dble(INC_MEM-NEW_LU) + ELSE + IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+ + & dble(INC_MEM) + ENDIF + ENDIF + IF ( .NOT. BDC_MEM ) THEN + RETURN + ENDIF +#if defined(OLD_LOAD_MECHANISM) + IF(KEEP_LOAD(201).EQ.0)THEN + DM_MEM( MYID ) = dble(CHECK_MEM) - DM_SUMLU + ELSE + DM_MEM( MYID ) = dble(CHECK_MEM) + ENDIF + TMP_MEM = DM_MEM(MYID) +#endif + IF (BDC_SBTR .AND. SSARBR) THEN + IF((SBTR_WHICH_M.EQ.0).AND.(KEEP(201).NE.0))THEN + SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM-NEW_LU) + ELSE + SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM) + ENDIF + SBTR_TMP = SBTR_CUR(MYID) + ELSE + SBTR_TMP=dble(0) + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF ( NEW_LU > 0_8 ) THEN + INC_MEM = INC_MEM - NEW_LU + ENDIF + DM_MEM( MYID ) = DM_MEM(MYID) + dble(INC_MEM) + MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MYID)) + IF(BDC_M2_MEM.AND.REMOVE_NODE_FLAG_MEM)THEN + IF(dble(INC_MEM).NE.REMOVE_NODE_COST_MEM)THEN + IF(dble(INC_MEM).GT.REMOVE_NODE_COST_MEM)THEN + DELTA_MEM = DELTA_MEM + + & (dble(INC_MEM)-REMOVE_NODE_COST_MEM) + GOTO 888 + ELSE + DELTA_MEM = DELTA_MEM - + & (REMOVE_NODE_COST_MEM-dble(INC_MEM)) + GOTO 888 + ENDIF + ENDIF + GOTO 333 + ENDIF + DELTA_MEM = DELTA_MEM + dble(INC_MEM) + 888 CONTINUE + IF ((KEEP(48).NE.5).OR. + & ((KEEP(48).EQ.5).AND.(abs(DELTA_MEM) + & .GE.0.1d0*dble(LRLU))))THEN + IF ( abs(DELTA_MEM) > DM_THRES_MEM ) THEN + SEND_MEM = DELTA_MEM +#else + IF(BDC_M2_MEM.AND.REMOVE_NODE_FLAG_MEM)THEN + IF(INC_MEM.NE.REMOVE_NODE_COST_MEM)THEN + IF(INC_MEM.EQ.REMOVE_NODE_COST_MEM)THEN + GOTO 333 + ELSEIF(INC_MEM.LT.REMOVE_NODE_COST_MEM)THEN + GOTO 333 + ENDIF + ENDIF + ENDIF + IF ((KEEP(48).NE.5).OR. + & ((KEEP(48).EQ.5).AND. + & (abs(TMP_MEM-DM_LAST_MEM_SENT).GE. + & 0.1d0*dble(LRLU))))THEN + IF ( abs( TMP_MEM-DM_LAST_MEM_SENT) > + & DM_THRES_MEM ) THEN + IERR = 0 + SEND_MEM = TMP_MEM +#endif + 111 CONTINUE + CALL DMUMPS_77( + & BDC_SBTR, + & BDC_MEM,BDC_MD, COMM_LD, + & NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & DELTA_LOAD, +#else + & LOAD_FLOPS( MYID ), +#endif + & SEND_MEM,SBTR_TMP, + & DM_SUMLU, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & MYID,IERR ) + IF ( IERR == -1 )THEN + CALL DMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in DMUMPS_471",IERR + CALL MUMPS_ABORT() + ENDIF + IF ( IERR .EQ. 0 ) THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = ZERO + DELTA_MEM = ZERO +#else + LAST_LOAD_SENT = LOAD_FLOPS ( MYID ) + DM_LAST_MEM_SENT = TMP_MEM +#endif + END IF + ENDIF + ENDIF + 333 CONTINUE + IF(REMOVE_NODE_FLAG_MEM)THEN + REMOVE_NODE_FLAG_MEM=.FALSE. + ENDIF + END SUBROUTINE DMUMPS_471 + INTEGER FUNCTION DMUMPS_186( K69, MEM_DISTRIB,MSG_SIZE ) + IMPLICIT NONE + INTEGER i, NLESS, K69 + INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB + DOUBLE PRECISION LREF + DOUBLE PRECISION MSG_SIZE + NLESS = 0 + DO i=1,NPROCS + IDWLOAD(i) = i - 1 + ENDDO + WLOAD(1:NPROCS) = LOAD_FLOPS(0:NPROCS-1) + IF(BDC_M2_FLOPS)THEN + DO i=1,NPROCS + WLOAD(i)=WLOAD(i)+NIV2(i) + ENDDO + ENDIF + IF(K69 .gt. 1) THEN + CALL DMUMPS_426(MEM_DISTRIB,MSG_SIZE,IDWLOAD,NPROCS) + ENDIF + LREF = LOAD_FLOPS(MYID) + DO i=1, NPROCS + IF (WLOAD(i).LT.LREF) NLESS=NLESS+1 + ENDDO + DMUMPS_186 = NLESS + RETURN + END FUNCTION DMUMPS_186 + SUBROUTINE DMUMPS_189(MEM_DISTRIB,MSG_SIZE,DEST, + & NSLAVES) + IMPLICIT NONE + INTEGER NSLAVES + INTEGER DEST(NSLAVES) + INTEGER, DIMENSION(0:NPROCS - 1) :: MEM_DISTRIB + INTEGER i,J,NBDEST + DOUBLE PRECISION MSG_SIZE + IF ( NSLAVES.eq.NPROCS-1 ) THEN + J = MYID+1 + DO i=1,NSLAVES + J=J+1 + IF (J.GT.NPROCS) J=1 + DEST(i) = J - 1 + ENDDO + ELSE + DO i=1,NPROCS + IDWLOAD(i) = i - 1 + ENDDO + CALL MUMPS_558(NPROCS, WLOAD, IDWLOAD) + NBDEST = 0 + DO i=1, NSLAVES + J = IDWLOAD(i) + IF (J.NE.MYID) THEN + NBDEST = NBDEST+1 + DEST(NBDEST) = J + ENDIF + ENDDO + IF (NBDEST.NE.NSLAVES) THEN + DEST(NSLAVES) = IDWLOAD(NSLAVES+1) + ENDIF + IF(BDC_MD)THEN + J=NSLAVES+1 + do i=NSLAVES+1,NPROCS + IF(IDWLOAD(i).NE.MYID)THEN + DEST(J)= IDWLOAD(i) + J=J+1 + ENDIF + end do + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_189 + SUBROUTINE DMUMPS_183( INFO1, IERR ) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER, intent(in) :: INFO1 + INTEGER, intent(out) :: IERR + IERR=0 + DEALLOCATE( LOAD_FLOPS ) + DEALLOCATE( WLOAD ) + DEALLOCATE( IDWLOAD ) +#if ! defined(OLD_LOAD_MECHANISM) + DEALLOCATE(FUTURE_NIV2) +#endif + IF(BDC_MD)THEN + DEALLOCATE(MD_MEM) + DEALLOCATE(LU_USAGE) + DEALLOCATE(TAB_MAXS) + ENDIF + IF ( BDC_MEM ) DEALLOCATE( DM_MEM ) + IF ( BDC_POOL) DEALLOCATE( POOL_MEM ) + IF ( BDC_SBTR) THEN + DEALLOCATE( SBTR_MEM ) + DEALLOCATE( SBTR_CUR ) + DEALLOCATE(SBTR_FIRST_POS_IN_POOL) + NULLIFY(MY_FIRST_LEAF) + NULLIFY(MY_NB_LEAF) + NULLIFY(MY_ROOT_SBTR) + ENDIF + IF(KEEP_LOAD(76).EQ.4)THEN + NULLIFY(DEPTH_FIRST_LOAD) + ENDIF + IF(KEEP_LOAD(76).EQ.5)THEN + NULLIFY(COST_TRAV) + ENDIF + IF((KEEP_LOAD(76).EQ.4).OR.(KEEP_LOAD(76).EQ.6))THEN + NULLIFY(DEPTH_FIRST_LOAD) + NULLIFY(DEPTH_FIRST_SEQ_LOAD) + NULLIFY(SBTR_ID_LOAD) + ENDIF + IF (BDC_M2_MEM.OR.BDC_M2_FLOPS) THEN + DEALLOCATE(NB_SON,POOL_NIV2,POOL_NIV2_COST, NIV2) + END IF + IF((KEEP_LOAD(81).EQ.2).OR.(KEEP_LOAD(81).EQ.3))THEN + DEALLOCATE(CB_COST_MEM) + DEALLOCATE(CB_COST_ID) + ENDIF + NULLIFY(ND_LOAD) + NULLIFY(KEEP_LOAD) + NULLIFY(KEEP8_LOAD) + NULLIFY(FILS_LOAD) + NULLIFY(FRERE_LOAD) + NULLIFY(PROCNODE_LOAD) + NULLIFY(STEP_LOAD) + NULLIFY(NE_LOAD) + NULLIFY(CAND_LOAD) + NULLIFY(STEP_TO_NIV2_LOAD) + NULLIFY(DAD_LOAD) + IF (BDC_SBTR.OR.BDC_POOL_MNG) THEN + DEALLOCATE(MEM_SUBTREE) + DEALLOCATE(SBTR_PEAK_ARRAY) + DEALLOCATE(SBTR_CUR_ARRAY) + ENDIF + CALL DMUMPS_58( IERR ) + CALL DMUMPS_150( MYID, COMM_LD, + & BUF_LOAD_RECV, LBUF_LOAD_RECV, + & LBUF_LOAD_RECV_BYTES ) + DEALLOCATE(BUF_LOAD_RECV) + END SUBROUTINE DMUMPS_183 +#if defined (LAMPORT_) + RECURSIVE SUBROUTINE DMUMPS_467(COMM, KEEP) +#else + SUBROUTINE DMUMPS_467(COMM, KEEP) +#endif + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, MSGTAG, MSGLEN, MSGSOU,COMM + INTEGER KEEP(500) + INTEGER STATUS(MPI_STATUS_SIZE) + LOGICAL FLAG + 10 CONTINUE + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + IF (FLAG) THEN + KEEP(65)=KEEP(65)+1 + MSGTAG = STATUS( MPI_TAG ) + MSGSOU = STATUS( MPI_SOURCE ) + IF ( MSGTAG .NE. UPDATE_LOAD) THEN + write(*,*) "Internal error 1 in DMUMPS_467", + & MSGTAG + CALL MUMPS_ABORT() + ENDIF + CALL MPI_GET_COUNT(STATUS, MPI_PACKED, MSGLEN, IERR) + IF ( MSGLEN > LBUF_LOAD_RECV_BYTES ) THEN + write(*,*) "Internal error 2 in DMUMPS_467", + & MSGLEN, LBUF_LOAD_RECV_BYTES + CALL MUMPS_ABORT() + ENDIF + CALL MPI_RECV( BUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES, + & MPI_PACKED, MSGSOU, MSGTAG, COMM_LD, STATUS, IERR) + CALL DMUMPS_187( MSGSOU, BUF_LOAD_RECV, + & LBUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES ) + GOTO 10 + ENDIF + RETURN + END SUBROUTINE DMUMPS_467 + RECURSIVE SUBROUTINE DMUMPS_187 + & ( MSGSOU, BUFR, LBUFR, LBUFR_BYTES ) + IMPLICIT NONE + INTEGER MSGSOU, LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INCLUDE 'mpif.h' + INTEGER POSITION, IERR, WHAT, NSLAVES, i + DOUBLE PRECISION LOAD_RECEIVED + INTEGER INODE_RECEIVED,NCB_RECEIVED + DOUBLE PRECISION SURF + INTEGER, POINTER, DIMENSION (:) :: LIST_SLAVES + DOUBLE PRECISION, POINTER, DIMENSION (:) :: LOAD_INCR + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WHAT, 1, MPI_INTEGER, + & COMM_LD, IERR ) + IF ( WHAT == 0 ) THEN +#if ! defined(OLD_LOAD_MECHANISM) +#else +#endif + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) +#if ! defined(OLD_LOAD_MECHANISM) + LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED +#else + LOAD_FLOPS( MSGSOU ) = LOAD_RECEIVED +#endif + IF ( BDC_MEM ) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) +#if ! defined(OLD_LOAD_MECHANISM) + DM_MEM(MSGSOU) = DM_MEM(MSGSOU) + LOAD_RECEIVED +#else + DM_MEM(MSGSOU) = LOAD_RECEIVED +#endif + MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MSGSOU)) + END IF + IF(BDC_SBTR)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + SBTR_CUR(MSGSOU)=LOAD_RECEIVED + ENDIF + IF(BDC_MD)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(KEEP_LOAD(201).EQ.0)THEN + LU_USAGE(MSGSOU)=LOAD_RECEIVED + ENDIF + ENDIF + ELSEIF (( WHAT == 1).OR.(WHAT.EQ.19)) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSLAVES, 1, MPI_INTEGER, + & COMM_LD, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, MPI_INTEGER, + & COMM_LD, IERR ) + LIST_SLAVES => IDWLOAD + LOAD_INCR => WLOAD + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LIST_SLAVES(1), NSLAVES, MPI_INTEGER, + & COMM_LD, IERR) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + WRITE(*,*)MYID,':Receiving M2A from',MSGSOU + i=1 + DO WHILE ((i.LE.NSLAVES).AND.(LIST_SLAVES(i).NE.MYID)) + i=i+1 + ENDDO + IF(i.LT.(NSLAVES+1))THEN + NB_LEVEL2=NB_LEVEL2+1 + WRITE(*,*)MYID,':NB_LEVEL2=',NB_LEVEL2 + AMI_CHOSEN=.TRUE. + IF(KEEP_LOAD(73).EQ.1)THEN + IF(.NOT.IS_DISPLAYED)THEN + WRITE(*,*)MYID,': Begin of Incoherent state (2) at time=', + & MPI_WTIME()-TIME_REF + IS_DISPLAYED=.TRUE. + ENDIF + ENDIF + ENDIF + IF(KEEP_LOAD(73).EQ.1) GOTO 344 +#endif +#endif + DO i = 1, NSLAVES +#if defined(OLD_LOAD_MECHANISM) + IF ( LIST_SLAVES(i) /= MYID ) THEN +#endif + LOAD_FLOPS(LIST_SLAVES(i)) = + & LOAD_FLOPS(LIST_SLAVES(i)) + + & LOAD_INCR(i) +#if defined(OLD_LOAD_MECHANISM) + END IF +#endif + END DO + IF ( BDC_MEM ) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) + DO i = 1, NSLAVES +#if defined(OLD_LOAD_MECHANISM) + IF ( LIST_SLAVES(i) /= MYID ) THEN +#endif + DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i)) + + & LOAD_INCR(i) + MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(LIST_SLAVES(i))) +#if defined(OLD_LOAD_MECHANISM) + END IF +#endif + END DO + END IF + IF(WHAT.EQ.19)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) + CALL DMUMPS_819(INODE_RECEIVED) + CB_COST_ID(POS_ID)=INODE_RECEIVED + CB_COST_ID(POS_ID+1)=NSLAVES + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + DO i=1,NSLAVES + WRITE(*,*)MYID,':',LIST_SLAVES(i),'->',LOAD_INCR(i) + CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(LOAD_INCR(i),8) + POS_MEM=POS_MEM+1 + ENDDO + ENDIF +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + 344 CONTINUE +#endif +#endif + NULLIFY( LIST_SLAVES ) + NULLIFY( LOAD_INCR ) + ELSE IF (WHAT == 2 ) THEN + IF ( .not. BDC_POOL ) THEN + WRITE(*,*) "Internal error 2 in DMUMPS_187" + CALL MUMPS_ABORT() + END IF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + POOL_MEM(MSGSOU)=LOAD_RECEIVED + ELSE IF ( WHAT == 3 ) THEN + IF ( .NOT. BDC_SBTR) THEN + WRITE(*,*) "Internal error 3 in DMUMPS_187" + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + SBTR_MEM(MSGSOU)=SBTR_MEM(MSGSOU)+LOAD_RECEIVED +#if ! defined(OLD_LOAD_MECHANISM) + ELSE IF (WHAT == 4) THEN + FUTURE_NIV2(MSGSOU+1)=0 + IF(BDC_MD)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & SURF, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + MD_MEM(MSGSOU)=999999999_8 + TAB_MAXS(MSGSOU)=TAB_MAXS(MSGSOU)+int(SURF,8) + ENDIF +#endif + IF(BDC_M2_MEM.OR.BDC_M2_FLOPS)THEN + ENDIF + ELSE IF (WHAT == 5) THEN + IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN + WRITE(*,*) "Internal error 7 in DMUMPS_187" + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, + & MPI_INTEGER, + & COMM_LD, IERR ) + IF(BDC_M2_MEM) THEN + CALL DMUMPS_816(INODE_RECEIVED) + ELSEIF(BDC_M2_FLOPS) THEN + CALL DMUMPS_817(INODE_RECEIVED) + ENDIF + IF((KEEP_LOAD(81).EQ.2).OR.(KEEP_LOAD(81).EQ.3))THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, + & MPI_INTEGER, + & COMM_LD, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NCB_RECEIVED, 1, + & MPI_INTEGER, + & COMM_LD, IERR ) + IF( + & MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE_RECEIVED)), + & NPROCS).EQ.1 + & )THEN + CB_COST_ID(POS_ID)=INODE_RECEIVED + CB_COST_ID(POS_ID+1)=1 + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + CB_COST_MEM(POS_MEM)=int(MSGSOU,8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(NCB_RECEIVED,8)* + & int(NCB_RECEIVED,8) + POS_MEM=POS_MEM+1 + ENDIF + ENDIF + ELSE IF ( WHAT == 6 ) THEN + IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN + WRITE(*,*) "Internal error 8 in DMUMPS_187" + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(BDC_M2_MEM) THEN + NIV2(MSGSOU+1) = LOAD_RECEIVED + ELSEIF(BDC_M2_FLOPS) THEN + NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED + IF(NIV2(MSGSOU+1).LT.0.0D0)THEN + IF(abs(NIV2(MSGSOU+1)).LE. + & sqrt(epsilon(LOAD_RECEIVED)))THEN + NIV2(MSGSOU+1)=0.0D0 + ELSE + WRITE(*,*)'problem with NIV2_FLOPS message', + & NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + ELSEIF(WHAT == 17)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(BDC_M2_MEM) THEN + NIV2(MSGSOU+1) = LOAD_RECEIVED + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(BDC_MD)THEN +#if ! defined(OLD_LOAD_MECHANISM) + DM_MEM(MYID)=DM_MEM(MYID)+LOAD_RECEIVED +#else + DM_MEM(MYID)=LOAD_RECEIVED +#endif + ELSEIF(BDC_POOL)THEN + POOL_MEM(MSGSOU)=LOAD_RECEIVED + ENDIF + ELSEIF(BDC_M2_FLOPS) THEN + NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED + IF(NIV2(MSGSOU+1).LT.0.0D0)THEN + WRITE(*,*)'problem with NIV2_FLOPS message', + & NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) +#if ! defined(OLD_LOAD_MECHANISM) + LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED +#else + LOAD_FLOPS( MSGSOU ) = LOAD_RECEIVED +#endif + ENDIF + ELSEIF ( WHAT == 7 ) THEN + IF(.NOT.BDC_MD)THEN + WRITE(*,*)MYID,': Internal error 4 + &in DMUMPS_187' + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSLAVES, 1, MPI_INTEGER, + & COMM_LD, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, MPI_INTEGER, + & COMM_LD, IERR ) + LIST_SLAVES => IDWLOAD + LOAD_INCR => WLOAD + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LIST_SLAVES(1), NSLAVES, MPI_INTEGER, + & COMM_LD, IERR) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) + DO i = 1, NSLAVES +#if defined(OLD_LOAD_MECHANISM) + IF ( LIST_SLAVES(i) /= MYID ) THEN +#endif + MD_MEM(LIST_SLAVES(i)) = + & MD_MEM(LIST_SLAVES(i)) + + & int(LOAD_INCR(i),8) +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(LIST_SLAVES(i)+1).EQ.0)THEN + MD_MEM(LIST_SLAVES(i))=999999999_8 + ENDIF +#endif +#if defined(OLD_LOAD_MECHANISM) + END IF +#endif + END DO + ELSEIF ( WHAT == 8 ) THEN + IF(.NOT.BDC_MD)THEN + WRITE(*,*)MYID,': Internal error 5 + &in DMUMPS_187' + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + MD_MEM(MSGSOU)=MD_MEM(MSGSOU)+int(LOAD_RECEIVED,8) +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(MSGSOU+1).EQ.0)THEN + MD_MEM(MSGSOU)=999999999_8 + ENDIF +#endif + ELSEIF ( WHAT == 9 ) THEN + IF(.NOT.BDC_MD)THEN + WRITE(*,*)MYID,': Internal error 6 + &in DMUMPS_187' + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + TAB_MAXS(MSGSOU)=int(LOAD_RECEIVED,8) + ELSE + WRITE(*,*) "Internal error 1 in DMUMPS_187" + CALL MUMPS_ABORT() + END IF + RETURN + END SUBROUTINE DMUMPS_187 + integer function DMUMPS_409 + & (MEM_DISTRIB,CAND, + & K69, + & SLAVEF,MSG_SIZE, + & NMB_OF_CAND ) + implicit none + integer, intent(in) :: K69, SLAVEF + INTEGER, intent(in) :: CAND(SLAVEF+1) + INTEGER, DIMENSION(0:NPROCS - 1), intent(in) :: MEM_DISTRIB + INTEGER, intent(out) :: NMB_OF_CAND + integer i,nless + DOUBLE PRECISION lref + DOUBLE PRECISION MSG_SIZE + nless = 0 + NMB_OF_CAND=CAND(SLAVEF+1) + do i=1,NMB_OF_CAND + WLOAD(i)=LOAD_FLOPS(CAND(i)) + IF(BDC_M2_FLOPS)THEN + WLOAD(i)=WLOAD(i)+NIV2(CAND(i)+1) + ENDIF + end do + IF(K69 .gt. 1) THEN + CALL DMUMPS_426(MEM_DISTRIB,MSG_SIZE, + & CAND,NMB_OF_CAND) + ENDIF + lref = LOAD_FLOPS(MYID) + do i=1, NMB_OF_CAND + if (WLOAD(i).lt.lref) nless=nless+1 + end do + DMUMPS_409 = nless + return + end function DMUMPS_409 + subroutine DMUMPS_384 + & (MEM_DISTRIB,CAND, + & + & SLAVEF, + & nslaves_inode, DEST) + implicit none + integer, intent(in) :: nslaves_inode, SLAVEF + integer, intent(in) :: CAND(SLAVEF+1) + integer, dimension(0:NPROCS - 1), intent(in) :: MEM_DISTRIB + integer, intent(out) :: DEST(CAND(SLAVEF+1)) + integer i,j,NMB_OF_CAND + external MUMPS_558 + NMB_OF_CAND = CAND(SLAVEF+1) + if(nslaves_inode.ge.NPROCS .or. + & nslaves_inode.gt.NMB_OF_CAND) then + write(*,*)'Internal error in DMUMPS_384', + & nslaves_inode, NPROCS, NMB_OF_CAND + CALL MUMPS_ABORT() + end if + if (nslaves_inode.eq.NPROCS-1) then + j=MYID+1 + do i=1,nslaves_inode + if(j.ge.NPROCS) j=0 + DEST(i)=j + j=j+1 + end do + else + do i=1,NMB_OF_CAND + IDWLOAD(i)=i + end do + call MUMPS_558(NMB_OF_CAND, + & WLOAD(1),IDWLOAD(1) ) + do i=1,nslaves_inode + DEST(i)= CAND(IDWLOAD(i)) + end do + IF(BDC_MD)THEN + do i=nslaves_inode+1,NMB_OF_CAND + DEST(i)= CAND(IDWLOAD(i)) + end do + ENDIF + end if + return + end subroutine DMUMPS_384 + SUBROUTINE DMUMPS_425(K69) + IMPLICIT NONE + INTEGER K69 + IF (K69 .LE. 4) THEN + ALPHA = 0.0d0 + BETA = 0.0d0 + RETURN + ENDIF + IF (K69 .EQ. 5) THEN + ALPHA = 0.5d0 + BETA = 50000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 6) THEN + ALPHA = 0.5d0 + BETA = 100000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 7) THEN + ALPHA = 0.5d0 + BETA = 150000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 8) THEN + ALPHA = 1.0d0 + BETA = 50000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 9) THEN + ALPHA = 1.0d0 + BETA = 100000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 10) THEN + ALPHA = 1.0d0 + BETA = 150000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 11) THEN + ALPHA = 1.5d0 + BETA = 50000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 12) THEN + ALPHA = 1.5d0 + BETA = 100000.0d0 + RETURN + ENDIF + ALPHA = 1.5d0 + BETA = 150000.0d0 + RETURN + END SUBROUTINE DMUMPS_425 + SUBROUTINE DMUMPS_426(MEM_DISTRIB,MSG_SIZE,ARRAY_ADM,LEN) + IMPLICIT NONE + INTEGER i,LEN + INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB + DOUBLE PRECISION MSG_SIZE,FORBIGMSG + INTEGER ARRAY_ADM(LEN) + DOUBLE PRECISION MY_LOAD + FORBIGMSG = 1.0d0 + IF (K69 .lt.2) THEN + RETURN + ENDIF + IF(BDC_M2_FLOPS)THEN + MY_LOAD=LOAD_FLOPS(MYID)+NIV2(MYID+1) + ELSE + MY_LOAD=LOAD_FLOPS(MYID) + ENDIF + IF((MSG_SIZE * dble(K35) ) .gt. 3200000.0d0) THEN + FORBIGMSG = 2.0d0 + ENDIF + IF (K69 .le. 4) THEN + DO i = 1,LEN + IF ((MEM_DISTRIB(ARRAY_ADM(i)) .EQ. 1) .AND. + & WLOAD(i) .LT. MY_LOAD ) THEN + WLOAD(i) = WLOAD(i)/MY_LOAD + ELSE + IF ( MEM_DISTRIB(ARRAY_ADM(i)) .NE. 1 ) THEN + WLOAD(i) = WLOAD(i) * + & dble(MEM_DISTRIB(ARRAY_ADM(i))) + & * FORBIGMSG + & + dble(2) + ENDIF + ENDIF + ENDDO + RETURN + ENDIF + DO i = 1,LEN + IF ((MEM_DISTRIB(ARRAY_ADM(i)) .EQ. 1) .AND. + & WLOAD(i) .LT. MY_LOAD ) THEN + WLOAD(i) = WLOAD(i) / MY_LOAD + ELSE + IF(MEM_DISTRIB(ARRAY_ADM(i)) .NE. 1) THEN + WLOAD(i) = (WLOAD(i) + + & ALPHA * MSG_SIZE * dble(K35) + + & BETA) * FORBIGMSG + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_426 + SUBROUTINE DMUMPS_461(MYID, SLAVEF, COMM, + & TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, NSLAVES,INODE) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER, INTENT (IN) :: MYID, SLAVEF, COMM, NASS, NSLAVES + INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2) + INTEGER, INTENT (IN) :: LIST_SLAVES( NSLAVES ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NCB, NFRONT, NBROWS_SLAVE + INTEGER i, IERR,WHAT,INODE + DOUBLE PRECISION MEM_INCREMENT ( NSLAVES ) + DOUBLE PRECISION FLOPS_INCREMENT( NSLAVES ) + DOUBLE PRECISION CB_BAND( NSLAVES ) + IF((KEEP(81).NE.2).AND.(KEEP(81).NE.3))THEN + WHAT=1 + ELSE + WHAT=19 + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + FUTURE_NIV2(MYID+1) = FUTURE_NIV2(MYID+1) - 1 + IF ( FUTURE_NIV2(MYID+1) < 0 ) THEN + WRITE(*,*) "Internal error in DMUMPS_461" + CALL MUMPS_ABORT() + ENDIF + IF ( FUTURE_NIV2(MYID + 1) == 0 ) THEN + 112 CONTINUE + CALL DMUMPS_502(COMM,MYID,SLAVEF, + & dble(MAX_SURF_MASTER),IERR) + IF (IERR == -1 ) THEN + CALL DMUMPS_467(COMM_LD, KEEP) + GOTO 112 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in DMUMPS_461", + & IERR + CALL MUMPS_ABORT() + ENDIF + TAB_MAXS(MYID) = TAB_MAXS(MYID) + int(MAX_SURF_MASTER,8) + ENDIF +#endif + IF ( NSLAVES /= TAB_POS(SLAVEF + 2) ) THEN + write(*,*) "Error 1 in DMUMPS_461", + & NSLAVES, TAB_POS(SLAVEF+2) + CALL MUMPS_ABORT() + ENDIF + NCB = TAB_POS(NSLAVES+1) - 1 + NFRONT = NCB + NASS + DO i = 1, NSLAVES + NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i) + IF ( KEEP(50) == 0 ) THEN + FLOPS_INCREMENT( i ) = (dble(NBROWS_SLAVE)*dble( NASS ))+ + & dble(NBROWS_SLAVE) * dble(NASS) * + & dble(2*NFRONT-NASS-1) + ELSE + FLOPS_INCREMENT( i ) = dble(NBROWS_SLAVE) * dble(NASS ) * + & dble( 2 * ( NASS + TAB_POS(i+1) - 1 ) + & - NBROWS_SLAVE - NASS + 1 ) + ENDIF + IF ( BDC_MEM ) THEN + IF ( KEEP(50) == 0 ) THEN + MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) * + & dble(NFRONT) + ELSE + MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) * + & dble( NASS + TAB_POS(i+1) - 1 ) + END IF + ENDIF + IF((KEEP(81).NE.2).AND.(KEEP(81).NE.3))THEN + CB_BAND(i)=dble(-999999) + ELSE + IF ( KEEP(50) == 0 ) THEN + CB_BAND( i ) = dble(NBROWS_SLAVE) * + & dble(NFRONT-NASS) + ELSE + CB_BAND( i ) = dble(NBROWS_SLAVE) * + & dble(TAB_POS(i+1)-1) + END IF + ENDIF + END DO + IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN + CB_COST_ID(POS_ID)=INODE + CB_COST_ID(POS_ID+1)=NSLAVES + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + DO i=1,NSLAVES + CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(CB_BAND(i),8) + POS_MEM=POS_MEM+1 + ENDDO + ENDIF + 111 CONTINUE + CALL DMUMPS_524(BDC_MEM, COMM, MYID, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & NSLAVES, LIST_SLAVES,INODE, + & MEM_INCREMENT, + & FLOPS_INCREMENT,CB_BAND, WHAT,IERR) + IF ( IERR == -1 ) THEN + CALL DMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in DMUMPS_461", + & IERR + CALL MUMPS_ABORT() + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (FUTURE_NIV2(MYID+1) .NE. 0) THEN +#endif + DO i = 1, NSLAVES + LOAD_FLOPS(LIST_SLAVES(i)) = LOAD_FLOPS(LIST_SLAVES(i)) + & + FLOPS_INCREMENT(i) + IF ( BDC_MEM ) THEN + DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i)) + & + MEM_INCREMENT(i) + END IF + ENDDO +#if ! defined(OLD_LOAD_MECHANISM) + ENDIF +#endif + RETURN + END SUBROUTINE DMUMPS_461 + SUBROUTINE DMUMPS_500( + & POOL, LPOOL, + & PROCNODE, KEEP,KEEP8, SLAVEF, COMM, MYID, STEP, N, + & ND, FILS ) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER LPOOL, SLAVEF, COMM, MYID + INTEGER N, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER POOL( LPOOL ), PROCNODE( KEEP(28) ), STEP( N ) + INTEGER ND( KEEP(28) ), FILS( N ) + INTEGER i, INODE, NELIM, NFR, LEVEL, IERR, WHAT + DOUBLE PRECISION COST + INTEGER NBINSUBTREE,NBTOP,INSUBTREE + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + IF(BDC_MD)THEN + RETURN + ENDIF + IF((KEEP(76).EQ.0).OR.(KEEP(76).EQ.2))THEN + IF(NBTOP.NE.0)THEN + DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3) + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ELSE + DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1 + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ENDIF + ELSE + IF(KEEP(76).EQ.1)THEN + IF(INSUBTREE.EQ.1)THEN + DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1 + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ELSE + DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3) + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ENDIF + ELSE + WRITE(*,*) + & 'Internal error: Unknown pool management strategy' + CALL MUMPS_ABORT() + ENDIF + ENDIF + 20 CONTINUE + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS(i) + GOTO 10 + ENDIF + NFR = ND( STEP(INODE) ) + LEVEL = MUMPS_330( PROCNODE(STEP(INODE)), SLAVEF ) + IF (LEVEL .EQ. 1) THEN + COST = dble( NFR ) * dble( NFR ) + ELSE + IF ( KEEP(50) == 0 ) THEN + COST = dble( NFR ) * dble( NELIM ) + ELSE + COST = dble( NELIM ) * dble( NELIM ) + ENDIF + ENDIF + 30 CONTINUE + IF ( abs(POOL_LAST_COST_SENT-COST).GT.DM_THRES_MEM ) THEN + WHAT = 2 + 111 CONTINUE + CALL DMUMPS_460( WHAT, + & COMM, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & COST, dble(0),MYID, IERR ) + POOL_LAST_COST_SENT = COST + POOL_MEM(MYID)=COST + IF ( IERR == -1 )THEN + CALL DMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in DMUMPS_500", + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_500 + SUBROUTINE DMUMPS_501( + & OK,INODE,POOL,LPOOL,MYID,SLAVEF,COMM,KEEP,KEEP8) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER LPOOL,MYID,SLAVEF,COMM,INODE + INTEGER POOL(LPOOL),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER WHAT,IERR + LOGICAL OK + DOUBLE PRECISION COST + LOGICAL FLAG + EXTERNAL MUMPS_283,MUMPS_170 + LOGICAL MUMPS_283,MUMPS_170 + IF((INODE.LE.0).OR.(INODE.GT.N_LOAD)) THEN + RETURN + ENDIF + IF (.NOT.MUMPS_170( + & PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS) + & ) THEN + RETURN + ENDIF + IF(MUMPS_283(PROCNODE_LOAD(STEP_LOAD(INODE)),NPROCS))THEN + IF(NE_LOAD(STEP_LOAD(INODE)).EQ.0)THEN + RETURN + ENDIF + ENDIF + FLAG=.FALSE. + IF(INDICE_SBTR.LE.NB_SUBTREES)THEN + IF(INODE.EQ.MY_FIRST_LEAF(INDICE_SBTR))THEN + FLAG=.TRUE. + ENDIF + ENDIF + IF(FLAG)THEN + SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY)=MEM_SUBTREE(INDICE_SBTR) + SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY)=SBTR_CUR(MYID) + INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY+1 + WHAT = 3 + IF(dble(MEM_SUBTREE(INDICE_SBTR)).GE.DM_THRES_MEM)THEN + 111 CONTINUE + CALL DMUMPS_460( + & WHAT, COMM, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & dble(MEM_SUBTREE(INDICE_SBTR)), dble(0),MYID, IERR ) + IF ( IERR == -1 )THEN + CALL DMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) + & "Internal Error 1 in DMUMPS_501", + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + SBTR_MEM(MYID)=SBTR_MEM(MYID)+ + & dble(MEM_SUBTREE(INDICE_SBTR)) + INDICE_SBTR=INDICE_SBTR+1 + IF(INSIDE_SUBTREE.EQ.0)THEN + INSIDE_SUBTREE=1 + ENDIF + ELSE + IF(INODE.EQ.MY_ROOT_SBTR(INDICE_SBTR-1))THEN + WHAT = 3 + COST=-SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY-1) + IF(abs(COST).GE.DM_THRES_MEM)THEN + 112 CONTINUE + CALL DMUMPS_460( + & WHAT, COMM, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & COST, dble(0) ,MYID,IERR ) + IF ( IERR == -1 )THEN + CALL DMUMPS_467(COMM_LD, KEEP) + GOTO 112 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) + & "Internal Error 3 in DMUMPS_501", + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY-1 + SBTR_MEM(MYID)=SBTR_MEM(MYID)- + & SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY) + SBTR_CUR(MYID)=SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY) + IF(INDICE_SBTR_ARRAY.EQ.1)THEN + SBTR_CUR(MYID)=dble(0) + INSIDE_SUBTREE=0 + ENDIF + ENDIF + ENDIF + CONTINUE + END SUBROUTINE DMUMPS_501 + SUBROUTINE DMUMPS_504 + & (SLAVEF,KEEP,KEEP8,PROCS,MEM_DISTRIB,NCB,NFRONT, + & NSLAVES_NODE,TAB_POS, + & SLAVES_LIST,SIZE_SLAVES_LIST,MYID) + IMPLICIT NONE + INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST + INTEGER(8) KEEP8(150) + INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID + INTEGER, intent(in) :: PROCS(SLAVEF+1) + INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1) + INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST) + INTEGER, intent(out):: TAB_POS(SLAVEF+2) + INTEGER, intent(out):: NSLAVES_NODE + INTEGER NUMBER_OF_PROCS,K47, K48, K50 + INTEGER(8) :: K821 + DOUBLE PRECISION DK821 + INTEGER J + INTEGER KMIN, KMAX + INTEGER OTHERS,CHOSEN,SMALL_SET,ACC + DOUBLE PRECISION SOMME,TMP_SUM + INTEGER AFFECTED + INTEGER ADDITIONNAL_ROWS,i,X,REF,POS + INTEGER(8)::TOTAL_MEM + LOGICAL FORCE_CAND + DOUBLE PRECISION TEMP(SLAVEF),PEAK + INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF) + EXTERNAL MPI_WTIME + DOUBLE PRECISION MPI_WTIME + IF (KEEP8(21) .GT. 0_8) THEN + write(*,*)MYID, + & ": Internal Error 1 in DMUMPS_504" + CALL MUMPS_ABORT() + ENDIF + K821=abs(KEEP8(21)) + DK821=dble(K821) + K50=KEEP(50) + K48=KEEP(48) + K47=KEEP(47) + IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN + FORCE_CAND = .FALSE. + ELSE + FORCE_CAND = (mod(KEEP(24),2).eq.0) + END IF + IF(K48.NE.4)THEN + WRITE(*,*)'DMUMPS_COMPUTE_PARTI_ACTV_MEM_K821 + & should be called with KEEP(48) different from 4' + CALL MUMPS_ABORT() + ENDIF + KMIN=1 + KMAX=int(K821/int(NFRONT,8)) + IF(FORCE_CAND)THEN + DO i=1,PROCS(SLAVEF+1) + WLOAD(i)=DM_MEM(PROCS(i)) + IDWLOAD(i)=PROCS(i) + ENDDO + NUMBER_OF_PROCS=PROCS(SLAVEF+1) + OTHERS=NUMBER_OF_PROCS + ELSE + NUMBER_OF_PROCS=SLAVEF + WLOAD(1:SLAVEF) = DM_MEM(0:NUMBER_OF_PROCS-1) + DO i=1,NUMBER_OF_PROCS + IDWLOAD(i) = i - 1 + ENDDO + OTHERS=NUMBER_OF_PROCS-1 + ENDIF + NB_ROWS=0 + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, IDWLOAD) + TOTAL_MEM=int(NCB,8)*int(NFRONT,8) + SOMME=dble(0) + J=1 + PEAK=dble(0) + DO i=1,NUMBER_OF_PROCS + IF((IDWLOAD(i).NE.MYID))THEN + PEAK=max(PEAK,WLOAD(i)) + TEMP_ID(J)=IDWLOAD(i) + TEMP(J)=WLOAD(i) + IF(BDC_SBTR)THEN + TEMP(J)=TEMP(J)+SBTR_MEM(IDWLOAD(i))- + & SBTR_CUR(IDWLOAD(i)) + ENDIF + IF(BDC_POOL)THEN + TEMP(J)=TEMP(J)+POOL_MEM(TEMP_ID(J)) + ENDIF + IF(BDC_M2_MEM)THEN + TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1) + ENDIF + J=J+1 + ENDIF + ENDDO + NUMBER_OF_PROCS=J-1 + CALL MUMPS_558(NUMBER_OF_PROCS, TEMP, TEMP_ID) + IF(K50.EQ.0)THEN + PEAK=max(PEAK, + & DM_MEM(MYID)+dble(NFRONT)*dble(NFRONT-NCB)) + ELSE + PEAK=max(PEAK, + & DM_MEM(MYID)+dble(NFRONT-NCB)*dble(NFRONT-NCB)) + ENDIF + PEAK=max(PEAK,TEMP(OTHERS)) + SOMME=dble(0) + DO i=1,NUMBER_OF_PROCS + SOMME=SOMME+TEMP(OTHERS)-TEMP(i) + ENDDO + IF(SOMME.LE.dble(TOTAL_MEM)) THEN + GOTO 096 + ENDIF + 096 CONTINUE + SOMME=dble(0) + DO i=1,OTHERS + SOMME=SOMME+TEMP(OTHERS)-TEMP(i) + ENDDO + IF(dble(TOTAL_MEM).GE.SOMME) THEN +#if defined (OLD_PART) + 887 CONTINUE +#endif + AFFECTED=0 + CHOSEN=0 + ACC=0 + DO i=1,OTHERS + IF(K50.EQ.0)THEN + IF((TEMP(OTHERS)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(OTHERS)-TEMP(i) + ENDIF + X=int(TMP_SUM/dble(NFRONT)) + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + IF((TEMP(OTHERS)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(OTHERS)-TEMP(i) + ENDIF + X=int((-dble(NFRONT-NCB+ACC) + & +sqrt(((dble(NFRONT-NCB+ACC)* + & dble(NFRONT-NCB+ACC))+dble(4)* + & (TMP_SUM))))/ + & dble(2)) + IF((ACC+X).GT.NCB) X=NCB-ACC + IF(X.LE.0) THEN + WRITE(*,*)"Internal Error 2 in + & DMUMPS_504" + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_ROWS(i)=X + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB-ACC.LT.KMIN) GOTO 111 + IF(NCB.EQ.ACC) GOTO 111 + ENDDO + 111 CONTINUE + IF((ACC.GT.NCB))THEN + X=0 + DO i=1,OTHERS + X=X+NB_ROWS(i) + ENDDO + WRITE(*,*)'NCB=',NCB,',SOMME=',X + WRITE(*,*)MYID, + & ": Internal Error 3 in DMUMPS_504" + CALL MUMPS_ABORT() + ENDIF + IF((NCB.NE.ACC))THEN + IF(K50.NE.0)THEN + IF(CHOSEN.NE.0)THEN + ADDITIONNAL_ROWS=NCB-ACC + NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+ADDITIONNAL_ROWS + ELSE + TMP_SUM=dble(TOTAL_MEM)/dble(NUMBER_OF_PROCS) + CHOSEN=0 + ACC=0 + DO i=1,OTHERS + X=int((-dble(NFRONT-NCB+ACC) + & +sqrt(((dble(NFRONT-NCB+ACC)* + & dble(NFRONT-NCB+ACC))+dble(4)* + & (TMP_SUM))))/ + & dble(2)) + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB-ACC.LT.KMIN) GOTO 002 + IF(NCB.EQ.ACC) GOTO 002 + ENDDO + 002 CONTINUE + IF(ACC.LT.NCB)THEN + NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+(NCB-ACC) + ENDIF + ENDIF + GOTO 333 + ENDIF + ADDITIONNAL_ROWS=NCB-ACC + DO i=CHOSEN,1,-1 + IF(int(dble(ADDITIONNAL_ROWS)/ + & dble(i)).NE.0)THEN + GOTO 222 + ENDIF + ENDDO + 222 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(i)) + DO J=1,i + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDDO + IF(ADDITIONNAL_ROWS.NE.0) THEN + NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS + ENDIF + ENDIF + 333 CONTINUE + IF(NB_ROWS(CHOSEN).EQ.0) CHOSEN=CHOSEN-1 + GOTO 889 + ELSE + DO i=OTHERS,1,-1 + SOMME=dble(0) + DO J=1,i + SOMME=SOMME+TEMP(J) + ENDDO + SOMME=(dble(i)*TEMP(i))-SOMME + IF(dble(TOTAL_MEM).GE.SOMME) GOTO 444 + ENDDO + 444 CONTINUE + REF=i + DO J=1,i + IF(TEMP(J).EQ.TEMP(i)) THEN + SMALL_SET=J + GOTO 123 + ENDIF + ENDDO + 123 CONTINUE + IF(i.EQ.1)THEN + NB_ROWS(i)=NCB + CHOSEN=1 + GOTO 666 + ENDIF + 323 CONTINUE + AFFECTED=0 + CHOSEN=0 + ACC=0 + DO i=1,SMALL_SET + IF(K50.EQ.0)THEN + IF((TEMP(SMALL_SET)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(SMALL_SET)-TEMP(i) + ENDIF + X=int(TMP_SUM/dble(NFRONT)) + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + IF((TEMP(SMALL_SET)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(SMALL_SET)-TEMP(i) + ENDIF + X=int((-dble(NFRONT-NCB+ACC) + & +sqrt(((dble(NFRONT-NCB+ACC)* + & dble(NFRONT-NCB+ACC))+dble(4)* + & (TMP_SUM))))/ + & dble(2)) + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 4 in DMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + NB_ROWS(i)=X + ACC=ACC+X + CHOSEN=CHOSEN+1 + IF(NCB-ACC.LT.KMIN) GOTO 888 + IF(NCB.EQ.ACC) GOTO 888 + IF(ACC.GT.NCB) THEN + WRITE(*,*)MYID, + & ': Internal error 5 in DMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ENDDO + 888 CONTINUE + SOMME=dble(0) + X=NFRONT-NCB + IF((ACC.GT.NCB))THEN + WRITE(*,*)MYID, + & ':Internal error 6 in DMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF((ACC.LT.NCB))THEN + IF(K50.NE.0)THEN + IF(SMALL_SET.LT.OTHERS)THEN + SMALL_SET=REF+1 + REF=SMALL_SET + GOTO 323 + ELSE + NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+NCB-ACC + GOTO 666 + ENDIF + ENDIF + ADDITIONNAL_ROWS=NCB-ACC +#if ! defined (OLD_PART) + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + J=1 +#if ! defined (PART1_) + X=int(ADDITIONNAL_ROWS/(i-1)) + IF((X.EQ.0).AND.(ADDITIONNAL_ROWS.NE.0))THEN + DO WHILE ((J.LT.i).AND.(ADDITIONNAL_ROWS.GT.0)) + NB_ROWS(J)=NB_ROWS(J)+1 + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 + J=J+1 + ENDDO + IF(ADDITIONNAL_ROWS.NE.0)THEN + WRITE(*,*)MYID, + & ':Internal error 7 in DMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + GOTO 047 + ENDIF + IF((TEMP(1)+dble((NB_ROWS(1)+X)*NFRONT)).LE. + & TEMP(i))THEN + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + AFFECTED=X + IF((AFFECTED+NB_ROWS(J)).GT. + & KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & AFFECTED + J=J+1 + ENDDO + ELSE +#endif + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LE.i)) + AFFECTED=int((TEMP(i)-(TEMP(J)+ + & (dble(NB_ROWS(J))*dble(NFRONT)))) + & /dble(NFRONT)) + IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + ENDIF + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + J=J+1 + ENDDO +#if ! defined (PART1_) + ENDIF +#endif + i=i+1 + ENDDO + 047 CONTINUE + IF((ADDITIONNAL_ROWS.EQ.0).AND. + & (i.LT.NUMBER_OF_PROCS))THEN + CHOSEN=i-1 + ELSE + CHOSEN=i-2 + ENDIF +#if ! defined (PART1_) + IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. + & (ADDITIONNAL_ROWS.NE.0))THEN + DO i=1,CHOSEN + NB_ROWS(i)=NB_ROWS(i)+1 + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 048 + ENDDO + 048 CONTINUE + ENDIF +#endif + IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. + & (ADDITIONNAL_ROWS.NE.0))THEN + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LE.i)) + AFFECTED=int((TEMP(i)-(TEMP(J)+ + & (dble(NB_ROWS(J))* + & dble(NFRONT))))/dble(NFRONT)) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + J=J+1 + ENDDO + i=i+1 + ENDDO + CHOSEN=i-2 + ENDIF + CONTINUE +#else + DO i=CHOSEN,1,-1 + IF(int(dble(ADDITIONNAL_ROWS)/ + & dble(i)).NE.0)THEN + GOTO 555 + ENDIF + ENDDO + 555 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(i)) + DO J=1,i + IF(NB_ROWS(J)+X.GT.K821/NCB)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & ((K821/NCB)-NB_ROWS(J)) + NB_ROWS(J)=(K821/NFRONT) + ELSE IF ((TEMP(J)+dble((NB_ROWS(J)+X))* + & dble(NFRONT)).GT. + & PEAK)THEN + AFFECTED=int((PEAK-(TEMP(J)+dble(NB_ROWS(J))* + & dble(NFRONT))/dble(NFRONT)) + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ELSE + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDIF + IF(((TEMP(J)+dble(NB_ROWS(J))*dble(NFRONT)) + & .GT. PEAK) + & .AND.(SMALL_SET.LT.OTHERS))THEN + WRITE(*,*)MYID, + & ':Internal error 8 in DMUMPS_504' + SMALL_SET=SMALL_SET+1 + CALL MUMPS_ABORT() + ENDIF + ENDDO + SOMME=dble(0) + DO J=1,CHOSEN + SOMME=SOMME+NB_ROWS(J) + ENDDO + IF(ADDITIONNAL_ROWS.NE.0) THEN + DO J=1,CHOSEN + IF(NB_ROWS(J).LT.0)THEN + WRITE(*,*)MYID, + & ':Internal error 9 in DMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF ((TEMP(J)+dble(NB_ROWS(J)) + & *dble(NFRONT)).GT. + & PEAK)THEN + WRITE(*,*)MYID, + & ':Internal error 10 in DMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF ((TEMP(J)+dble(NB_ROWS(J)+ + & ADDITIONNAL_ROWS)*dble(NFRONT)).GE. + & PEAK)THEN + AFFECTED=int((PEAK-(TEMP(J)+ + & dble(NB_ROWS(J))* + & dble(NFRONT))/dble(NFRONT)) + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + IF((TEMP(J)+dble(NFRONT)* + & dble(NB_ROWS(J))).GT. + & PEAK)THEN + WRITE(*,*)MYID, + & ':Internal error 11 in DMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ELSE + NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 666 + ENDDO + IF(SMALL_SET.EQ.(NUMBER_OF_PROCS)) THEN + NB_ROWS=0 + GOTO 887 + ENDIF + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF(NB_ROWS(i)+ADDITIONNAL_ROWS.LT.K821/NFRONT) + & THEN + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-(K821/ + & NFRONT + & -NB_ROWS(i)) + NB_ROWS(i)=K821/NFRONT + ENDIF + i=i+1 + ENDDO + CHOSEN=i-1 + IF(ADDITIONNAL_ROWS.NE.0)THEN + DO i=CHOSEN,1,-1 + IF(int(dble(ADDITIONNAL_ROWS)/dble(i)) + & .NE.0)THEN + GOTO 372 + ENDIF + ENDDO + 372 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(i)) + DO J=1,i + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDDO + IF(ADDITIONNAL_ROWS.NE.0) THEN + NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS + ENDIF + ENDIF + ENDIF +#endif + ENDIF + 666 CONTINUE + SOMME=dble(0) + X=0 + POS=0 + DO i=1,CHOSEN + IF(K50.NE.0) THEN + IF((TEMP(i)+dble(NB_ROWS(i)) + & *dble(X+NB_ROWS(i)+NFRONT-NCB)) + & .GT.PEAK)THEN + SMALL_SET=SMALL_SET+1 + ENDIF + ENDIF + IF(K50.EQ.0) THEN + IF((TEMP(i)+dble(NB_ROWS(i))*dble(NFRONT)) + & .GT.PEAK)THEN + SMALL_SET=SMALL_SET+1 + ENDIF + ENDIF + X=X+NB_ROWS(i) + SOMME=SOMME+ dble(NB_ROWS(i)) + ENDDO + ENDIF + 889 CONTINUE + J=CHOSEN + X=0 + DO i=J,1,-1 + IF(NB_ROWS(i).EQ.0)THEN + IF(X.EQ.1)THEN + WRITE(*,*)MYID, + & ':Internal error 12 in DMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + CHOSEN=CHOSEN-1 + ELSE + IF(NB_ROWS(i).GT.0)THEN + X=1 + ELSE + WRITE(*,*) + & 'Internal error 13 in DMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDDO + NSLAVES_NODE=CHOSEN + TAB_POS(NSLAVES_NODE+1)= NCB+1 + TAB_POS(SLAVEF+2) = CHOSEN + POS=1 + DO i=1,CHOSEN + SLAVES_LIST(i)=TEMP_ID(i) + TAB_POS(i)=POS + POS=POS+NB_ROWS(i) + IF(NB_ROWS(i).LE.0)THEN + WRITE(*,*) + & 'Internal error 14 in DMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ENDDO + DO i=CHOSEN+1,NUMBER_OF_PROCS + SLAVES_LIST(i)=TEMP_ID(i) + ENDDO + IF(POS.NE.(NCB+1))THEN + WRITE(*,*) + & 'Internal error 15 in DMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + END SUBROUTINE DMUMPS_504 + SUBROUTINE DMUMPS_518 + & (NCBSON_MAX,SLAVEF,KEEP,KEEP8, + & PROCS,MEM_DISTRIB,NCB,NFRONT, + & NSLAVES_NODE,TAB_POS, + & SLAVES_LIST,SIZE_SLAVES_LIST,MYID,INODE,MP,LP) + IMPLICIT NONE + INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST + INTEGER(8) KEEP8(150) + INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID + INTEGER, intent(in) :: NCBSON_MAX + INTEGER, intent(in) :: PROCS(SLAVEF+1) + INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1),INODE + INTEGER, intent(in) :: MP,LP + INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST) + INTEGER, intent(out):: TAB_POS(SLAVEF+2) + INTEGER, intent(out):: NSLAVES_NODE + INTEGER NUMBER_OF_PROCS,K47,K48, K50,K83,K69 + INTEGER(8) :: K821 + INTEGER J + INTEGER KMIN, KMAX + INTEGER OTHERS,CHOSEN,SMALL_SET,ACC + DOUBLE PRECISION SOMME,TMP_SUM,DELTA,A,B,C,MASTER_WORK + INTEGER AFFECTED + INTEGER ADDITIONNAL_ROWS,i,X,REF,POS,NELIM + INTEGER(8) X8 + LOGICAL FORCE_CAND,SMP + DOUBLE PRECISION BANDE_K821 + INTEGER NB_SAT,NB_ZERO + DOUBLE PRECISION TEMP(SLAVEF),TOTAL_COST, MAX_MEM_ALLOW + INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF) + INTEGER NSLAVES_REF,NCB_FILS + EXTERNAL MPI_WTIME,MUMPS_442 + INTEGER MUMPS_442 + INTEGER POS_MIN_LOAD,SIZE_MY_SMP,WHAT,ADDITIONNAL_ROWS_SPECIAL + LOGICAL HAVE_TYPE1_SON + DOUBLE PRECISION MIN_LOAD,MAX_LOAD,TEMP_MAX_LOAD + DOUBLE PRECISION MPI_WTIME + DOUBLE PRECISION BUF_SIZE,NELIM_MEM_SIZE + DOUBLE PRECISION MEM_SIZE_STRONG(SLAVEF),MEM_SIZE_WEAK(SLAVEF) + K821=abs(KEEP8(21)) + TEMP_MAX_LOAD=dble(0) + K50=KEEP(50) + K48=KEEP(48) + K47=KEEP(47) + K83=KEEP(83) + K69=0 + NCB_FILS=NCBSON_MAX + IF(int(NCB_FILS,8)*int(min(NCB,NCB_FILS),8).GT.K821)THEN + HAVE_TYPE1_SON=.TRUE. + ELSE + HAVE_TYPE1_SON=.FALSE. + ENDIF + SMP=(K69.NE.0) + IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN + FORCE_CAND = .FALSE. + ELSE + FORCE_CAND = (mod(KEEP(24),2).eq.0) + END IF + NELIM=NFRONT-NCB + KMAX=int(K821/int(NCB,8)) + IF(FORCE_CAND)THEN + DO i=1,PROCS(SLAVEF+1) + WLOAD(i)=LOAD_FLOPS(PROCS(i)) + IDWLOAD(i)=PROCS(i) + IF (WLOAD(i) < -0.5d0 ) THEN + IF((MP.GT.0).AND.(LP.GE.2))THEN + WRITE(MP,*)MYID,': Warning: negative load ', + & WLOAD(i) + ENDIF + ENDIF + WLOAD(i)=max(WLOAD(i),0.0d0) + ENDDO + NUMBER_OF_PROCS=PROCS(SLAVEF+1) + OTHERS=NUMBER_OF_PROCS + ELSE + NUMBER_OF_PROCS=SLAVEF + WLOAD(1:SLAVEF) = LOAD_FLOPS(0:NUMBER_OF_PROCS-1) + DO i=1,NUMBER_OF_PROCS + IDWLOAD(i) = i - 1 + IF (WLOAD(i) < -0.5d0 ) THEN + IF((MP.GT.0).AND.(LP.GE.2))THEN + WRITE(MP,*)MYID,': Negative load ', + & WLOAD(i) + ENDIF + ENDIF + WLOAD(i)=max(WLOAD(i),0.0d0) + ENDDO + OTHERS=NUMBER_OF_PROCS-1 + ENDIF + KMAX=int(NCB/OTHERS) + KMIN=MUMPS_442(int(NCB,8)*int(KMAX,8),K50,KMAX,NCB) + NB_ROWS=0 + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, IDWLOAD) + IF(K50.EQ.0)THEN + TOTAL_COST=dble( NELIM ) * dble ( NCB ) + + & dble(NCB) * dble(NELIM)*dble(2*NFRONT-NELIM-1) + ELSE + TOTAL_COST=dble(NELIM) * dble ( NCB ) * + & dble(NFRONT+1) + ENDIF + CALL MUMPS_511(NFRONT,NELIM,NELIM,K50, + & 2,MASTER_WORK) + SOMME=dble(0) + J=1 + IF(FORCE_CAND.AND.(NUMBER_OF_PROCS.GT.K83))THEN + MASTER_WORK=dble(KEEP(88))*MASTER_WORK/dble(100) + ENDIF + IF(FORCE_CAND.AND.(NUMBER_OF_PROCS.LE.K83))THEN + MASTER_WORK=dble(KEEP(87))*MASTER_WORK/dble(100) + ENDIF + IF(MASTER_WORK.LT.dble(1))THEN + MASTER_WORK=dble(1) + ENDIF + NSLAVES_REF=int(TOTAL_COST/MASTER_WORK)+1 + IF(FORCE_CAND)THEN + NSLAVES_REF=min(NSLAVES_REF,NUMBER_OF_PROCS) + ELSE + NSLAVES_REF=min(NSLAVES_REF,NUMBER_OF_PROCS-1) + ENDIF + DO i=1,NUMBER_OF_PROCS + IF((IDWLOAD(i).NE.MYID))THEN + TEMP_ID(J)=IDWLOAD(i) + TEMP(J)=WLOAD(i) + IF(BDC_M2_FLOPS)THEN + TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1) + ENDIF + J=J+1 + ENDIF + ENDDO + NUMBER_OF_PROCS=J-1 + CALL MUMPS_558(NUMBER_OF_PROCS, TEMP, TEMP_ID) + SOMME=dble(0) + TMP_SUM=dble(0) + DO i=1,OTHERS + SOMME=SOMME+TEMP(OTHERS)-TEMP(i) + TMP_SUM=TMP_SUM+TEMP(i) + ENDDO + TMP_SUM=(TMP_SUM/dble(OTHERS))+ + & (TOTAL_COST/dble(OTHERS)) + SIZE_MY_SMP=OTHERS + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + IF(.NOT.SMP) MAX_LOAD=TEMP(OTHERS) + IF(SMP)THEN + J=1 + DO i=1,OTHERS + IF(MEM_DISTRIB(TEMP_ID(i)).EQ.1)THEN + IF(TEMP(i).LE.TMP_SUM)THEN + WLOAD(J)=TEMP(i) + IDWLOAD(J)=TEMP_ID(i) + J=J+1 + ELSE + ENDIF + ENDIF + ENDDO + MAX_LOAD=WLOAD(J-1) + SIZE_MY_SMP=J-1 + DO i=1,OTHERS + IF((MEM_DISTRIB(TEMP_ID(i)).NE.1).OR. + & ((MEM_DISTRIB(TEMP_ID(i)).EQ.1).AND. + & (TEMP(i).GE.TMP_SUM)))THEN + WLOAD(J)=TEMP(i) + IDWLOAD(J)=TEMP_ID(i) + J=J+1 + ENDIF + ENDDO + TEMP=WLOAD + TEMP_ID=IDWLOAD + ENDIF + IF(BDC_MD)THEN + BUF_SIZE=dble(K821) + IF (KEEP(201).EQ.2) THEN + A=dble(int((dble(KEEP(100))/dble(2))/dble(NELIM))) + IF(K50.EQ.0)THEN + BUF_SIZE=min(BUF_SIZE,A*dble(NCB)) + ELSE + BUF_SIZE=min(BUF_SIZE,A*A) + ENDIF + ENDIF + BUF_SIZE=dble(K821) + DO i=1,NUMBER_OF_PROCS + A=dble(MD_MEM(TEMP_ID(i)))/ + & dble(NELIM) + A=A*dble(NFRONT) + IF(K50.EQ.0)THEN + B=dble(int(dble(NCB)/dble(NUMBER_OF_PROCS))+1)* + & dble(NFRONT) + ELSE + WHAT = 5 +#if ! defined (OOC_PAR_MEM_SLAVE_SELECT) && ! defined (OOC_PAR_MEM2) + CALL MUMPS_503(WHAT, KEEP,KEEP8, NCB, + & NFRONT, min(NCB,OTHERS), J, X8) +#endif + B=dble(X8)+(dble(J)*dble(NELIM)) + ENDIF + NELIM_MEM_SIZE=A+B + MEM_SIZE_WEAK(i)=NELIM_MEM_SIZE + IF((SBTR_WHICH_M.EQ.0).OR.(.NOT.BDC_SBTR))THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i)) + ENDIF + ELSE + IF(BDC_SBTR)THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ENDIF + ENDIF + ENDIF + IF(min(MEM_SIZE_STRONG(i),MEM_SIZE_WEAK(i)).LT.dble(0))THEN + IF(MEM_SIZE_STRONG(i).LT.0.0d0)THEN + MEM_SIZE_STRONG(i)=dble(0) + ELSE + MEM_SIZE_WEAK(i)=dble(0) + ENDIF + ENDIF + ENDDO + ELSE + BUF_SIZE=dble(K821) + DO i=1,NUMBER_OF_PROCS + IF((SBTR_WHICH_M.EQ.0).OR.(.NOT.BDC_SBTR))THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i)) + ENDIF + ELSE + IF(BDC_SBTR)THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ENDIF + ENDIF + ENDIF + MEM_SIZE_STRONG(i)=max(dble(0),MEM_SIZE_STRONG(i)) + MEM_SIZE_WEAK(i)=huge(MEM_SIZE_WEAK(i)) + ENDDO + ENDIF + IF((((NUMBER_OF_PROCS.LE.K83).AND.FORCE_CAND).AND. + & (TOTAL_COST.GE.SOMME)).OR. + & (.NOT.FORCE_CAND).OR. + & (((NUMBER_OF_PROCS+1).GT.K83).AND.FORCE_CAND))THEN + REF=NSLAVES_REF + SMALL_SET=NSLAVES_REF + IF(.NOT.SMP)THEN + DO i=NSLAVES_REF,1,-1 + SOMME=dble(0) + DO J=1,i + SOMME=SOMME+TEMP(J) + ENDDO + SOMME=(dble(i)*TEMP(i))-SOMME + IF(TOTAL_COST.GE.SOMME) GOTO 444 + ENDDO + 444 CONTINUE + REF=i + SMALL_SET=REF + MAX_LOAD=TEMP(SMALL_SET) + ELSE + X=min(SIZE_MY_SMP,NSLAVES_REF) + 450 CONTINUE + SOMME=dble(0) + DO J=1,X + SOMME=SOMME+(TEMP(X)-TEMP(J)) + ENDDO + IF(SOMME.GT.TOTAL_COST)THEN + X=X-1 + GOTO 450 + ELSE + IF(X.LT.SIZE_MY_SMP) THEN + REF=X + SMALL_SET=REF + MAX_LOAD=TEMP(SMALL_SET) + ELSE + X=min(SIZE_MY_SMP,NSLAVES_REF) + J=X+1 + MAX_LOAD=TEMP(X) + TMP_SUM=MAX_LOAD + DO i=X+1,OTHERS + IF(TEMP(i).GT.MAX_LOAD)THEN + SOMME=SOMME+(dble(i-1)*(TEMP(i)-MAX_LOAD)) + TMP_SUM=MAX_LOAD + MAX_LOAD=TEMP(i) + ELSE + SOMME=SOMME+(MAX_LOAD-TEMP(i)) + ENDIF + IF(i.EQ.NSLAVES_REF)THEN + SMALL_SET=NSLAVES_REF + REF=SMALL_SET + GOTO 323 + ENDIF + IF(SOMME.GT.TOTAL_COST)THEN + REF=i-1 + SMALL_SET=i-1 + MAX_LOAD=TMP_SUM + GOTO 323 + ENDIF + ENDDO + ENDIF + ENDIF + ENDIF + 323 CONTINUE + MAX_LOAD=dble(0) + DO i=1,SMALL_SET + MAX_LOAD=max(MAX_LOAD,TEMP(i)) + ENDDO + TEMP_MAX_LOAD=MAX_LOAD + NB_ROWS=0 + TMP_SUM=dble(0) + CHOSEN=0 + ACC=0 + NB_SAT=0 + NB_ZERO=0 + DO i=1,SMALL_SET + IF(K50.EQ.0)THEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + IF(HAVE_TYPE1_SON)THEN + IF(K50.EQ.0)THEN + X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + IF(K50.EQ.0)THEN + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + X=int((MAX_LOAD-TEMP(i))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.KMIN)THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*(dble(NELIM)+dble(2*ACC+1)) + C=-(MAX_LOAD-TEMP(i)) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 1 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.KMIN)THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + NB_ROWS(i)=X + ACC=ACC+X + CHOSEN=CHOSEN+1 + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + TMP_SUM=MAX_LOAD + IF(K50.EQ.0)THEN + MAX_LOAD=max(MAX_LOAD, + & (TEMP(i)+(dble(NELIM) * + & dble(NB_ROWS(i)))+ + & (dble(NB_ROWS(i))*dble(NELIM)* + & dble(2*NFRONT-NELIM-1)))) + ELSE + MAX_LOAD=max(MAX_LOAD, + & TEMP(i)+(dble(NELIM) * dble(NB_ROWS(i)))* + & dble(2*(NELIM+ACC)-NB_ROWS(i) + & -NELIM+1)) + ENDIF + IF(TMP_SUM.LT.MAX_LOAD)THEN + ENDIF + IF(NCB-ACC.LT.KMIN) GOTO 888 + IF(NCB.EQ.ACC) GOTO 888 + IF(ACC.GT.NCB) THEN + WRITE(*,*)MYID, + & ': Internal error 2 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + ENDDO + 888 CONTINUE + SOMME=dble(0) + X=NFRONT-NCB + IF((ACC.GT.NCB))THEN + WRITE(*,*)MYID, + & ': Internal error 3 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF((ACC.LT.NCB))THEN + IF(K50.NE.0)THEN + IF(SMALL_SET.LE.OTHERS)THEN + IF((NB_SAT.EQ.SMALL_SET).AND.(SMALL_SET.LT. + & NSLAVES_REF))THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ADDITIONNAL_ROWS_SPECIAL=NCB-ACC + DO i=1,SMALL_SET + MAX_LOAD=TEMP_MAX_LOAD + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)* + & dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS-NELIM + & +1) + SOMME=SOMME/dble(SMALL_SET-NB_SAT) + NB_ROWS=0 + NB_ZERO=0 + ACC=0 + CHOSEN=0 + NB_SAT=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO J=1,SMALL_SET + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=(dble(NELIM)*dble(NELIM+2*ACC+1)) + C=-(MAX_LOAD-TEMP(J)+SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=X+1 + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 4 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + NB_ZERO=NB_ZERO+1 + X=0 + ENDIF + ELSE + IF(X.LT.min(KMIN,KMAX))THEN + NB_ZERO=NB_ZERO+1 + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(J)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(J))THEN + MIN_LOAD=TEMP(J) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + ACC=ACC+X + TMP_SUM=MAX_LOAD + TEMP_MAX_LOAD=max(TEMP_MAX_LOAD, + & TEMP(J)+(dble(NELIM) * + & dble(NB_ROWS(J)))* + & dble(2*(NELIM+ + & ACC)-NB_ROWS(J) + & -NELIM+1)) + IF(REF.LE.NUMBER_OF_PROCS-1)THEN + IF(TEMP_MAX_LOAD.GT.TEMP(REF+1))THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ENDIF + ENDIF + IF(NCB.EQ.ACC) GOTO 666 + ENDDO + IF(NB_SAT.EQ.SMALL_SET)THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + GOTO 434 + ENDIF + ENDIF + IF(NB_ZERO.EQ.SMALL_SET)THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + GOTO 434 + ENDIF + ENDIF + IF((NB_SAT+NB_ZERO).EQ.SMALL_SET)THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + GOTO 434 + ENDIF + ENDIF + ENDDO + 434 CONTINUE + ADDITIONNAL_ROWS=NCB-ACC + IF(ADDITIONNAL_ROWS.NE.0)THEN + IF(ADDITIONNAL_ROWS.LT.KMIN)THEN + i=CHOSEN + J=ACC + 436 CONTINUE + IF(NB_ROWS(i).NE.0)THEN + J=J-NB_ROWS(i) + A=dble(1) + B=dble(J+2) + C=-BUF_SIZE+dble(J+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-J) X=NCB-J + BANDE_K821=dble(X)*dble(NELIM+J+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(J+2+NELIM) + C=-BUF_SIZE+dble(J+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-J) X=NCB-J + BANDE_K821=dble(X)*dble(NELIM+J+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(J+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(NB_ROWS(i).NE.KMAX)THEN + IF(NCB-J.LE.KMAX)THEN + NB_ROWS(i)=+NCB-J + ADDITIONNAL_ROWS=0 + ENDIF + ENDIF + TEMP_MAX_LOAD=max(TEMP_MAX_LOAD, + & TEMP(i)+ + & (dble(NELIM) * dble(NB_ROWS(i)))* + & dble(2*(NELIM+ + & ACC)-NB_ROWS(i) + & -NELIM+1)) + IF(REF.LE.NUMBER_OF_PROCS-1)THEN + IF(TEMP_MAX_LOAD.GT.TEMP(REF+1))THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ENDIF + ENDIF + ELSE + i=i-1 + IF(i.NE.0)GOTO 436 + ENDIF + IF(ADDITIONNAL_ROWS.NE.0)THEN + i=CHOSEN + IF(i.NE.SMALL_SET)THEN + i=i+1 + IF(NB_ROWS(i).NE.0)THEN + WRITE(*,*)MYID, + & ': Internal error 5 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + CHOSEN=i + ENDIF + ENDIF + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF((TEMP(i).LE.MAX_LOAD))THEN + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(i)) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.KMIN)THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + ACC=ACC+X + ADDITIONNAL_ROWS=NCB-ACC + ELSE IF((TEMP(i).GT.MAX_LOAD))THEN + MAX_LOAD=TEMP(i) + NB_SAT=0 + ACC=0 + NB_ROWS=0 + DO J=1,i + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(J)) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 6 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.min(KMIN,KMAX))THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(J)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(J))THEN + MIN_LOAD=TEMP(J) + POS_MIN_LOAD=i + ENDIF + ENDIF + ACC=ACC+X + MAX_LOAD=max(MAX_LOAD, + & TEMP(J)+ + & (dble(NELIM)*dble(NB_ROWS(J)))* + & dble(2*(NELIM+ + & ACC)-NB_ROWS(J) + & -NELIM+1)) + IF(NCB.EQ.ACC) GOTO 741 + IF(NCB-ACC.LT.KMIN) GOTO 210 + ENDDO + 210 CONTINUE + ENDIF + 741 CONTINUE + i=i+1 + ADDITIONNAL_ROWS=NCB-ACC + ENDDO + CHOSEN=i-1 + IF(ADDITIONNAL_ROWS.NE.0)THEN + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)*dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS- + & NELIM+1) + SOMME=SOMME/dble(NUMBER_OF_PROCS) + NB_ROWS=0 + ACC=0 + CHOSEN=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(i)+SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 7 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.min(KMIN,KMAX))THEN + X=min(KMAX,KMIN) + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB.EQ.ACC) GOTO 666 + IF(NCB-ACC.LT.KMIN) GOTO 488 + ENDDO + 488 CONTINUE + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)* + & dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS- + & NELIM+1) + SOMME=SOMME/dble(NUMBER_OF_PROCS) + NB_ROWS=0 + ACC=0 + CHOSEN=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(i)+SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 8 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + X=KMAX + ELSE + IF(X.LT.KMIN)THEN + X=KMIN + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB.EQ.ACC) GOTO 666 + IF(NCB-ACC.LT.KMIN) GOTO 477 + ENDDO + 477 CONTINUE + IF(ACC.NE.NCB)THEN + NB_SAT=0 + ACC=0 + CHOSEN=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=KMAX-NB_ROWS(i) + IF((ACC+NB_ROWS(i)+X).GT.NCB) + & X=NCB-(ACC+NB_ROWS(i)) + NB_ROWS(i)=NB_ROWS(i)+X + IF((dble(NB_ROWS(i))* + & dble(NB_ROWS(i)+ACC)).EQ. + & BANDE_K821)THEN + NB_SAT=NB_SAT+1 + ENDIF + ACC=ACC+NB_ROWS(i) + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + IF(NCB.EQ.ACC) GOTO 666 + IF(NCB-ACC.LT.KMIN) GOTO 834 + ENDDO + 834 CONTINUE + ENDIF + IF(ACC.NE.NCB)THEN + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)* + & dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS- + & NELIM+1) + SOMME=SOMME/dble(NUMBER_OF_PROCS-NB_SAT) + ACC=0 + DO i=1,CHOSEN + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + IF((dble(NB_ROWS(i))* + & dble(NB_ROWS(i)+ACC)).EQ. + & BANDE_K821)THEN + GOTO 102 + ENDIF + A=dble(NELIM) + B=dble(NELIM)* + & dble(NELIM+2*(ACC+NB_ROWS(i))+1) + C=-(SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-BANDE_K821) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 9 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF((ACC+X+NB_ROWS(i)).GT.NCB)THEN + IF((NCB-ACC).GT.KMAX)THEN + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NCB-ACC + ENDIF + ELSE + IF((NB_ROWS(i)+X).GT.KMAX)THEN + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NB_ROWS(i)+X + ENDIF + ENDIF + 102 CONTINUE + ACC=ACC+NB_ROWS(i) + IF(NCB.EQ.ACC) THEN + CHOSEN=i + GOTO 666 + ENDIF + IF(NCB-ACC.LT.KMIN) THEN + CHOSEN=i + GOTO 007 + ENDIF + ENDDO + 007 CONTINUE + DO i=1,CHOSEN + NB_ROWS(i)=NB_ROWS(i)+1 + ACC=ACC+1 + IF(ACC.EQ.NCB)GOTO 666 + ENDDO + IF(ACC.LT.NCB)THEN + IF(SMP)THEN + NB_ROWS(1)=NB_ROWS(1)+NCB-ACC + ELSE + NB_ROWS(POS_MIN_LOAD)= + & NB_ROWS(POS_MIN_LOAD)+NCB-ACC + ENDIF + ENDIF + ENDIF + GOTO 666 + ENDIF + ENDIF + GOTO 666 + ENDIF + ADDITIONNAL_ROWS=NCB-ACC + i=CHOSEN+1 + IF(NB_SAT.EQ.SMALL_SET) GOTO 777 + DO i=1,SMALL_SET + IDWLOAD(i)=i + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & (dble(NFRONT+1))) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + WLOAD(i)=MAX_MEM_ALLOW + ENDDO + CALL MUMPS_558(SMALL_SET, WLOAD, IDWLOAD) + NB_ZERO=0 + IF((NB_SAT.EQ.SMALL_SET).AND. + & (SMALL_SET.LT.NSLAVES_REF))THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + IF((NB_SAT.EQ.SMALL_SET).AND. + & (SMALL_SET.LE.NUMBER_OF_PROCS))GOTO 777 + AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT)) + AFFECTED=max(AFFECTED,1) + DO i=1,SMALL_SET + KMAX=int(WLOAD(i)/dble(NFRONT)) + IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN + GOTO 912 + ENDIF + IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED, + & ADDITIONNAL_ROWS)).GT.KMAX)THEN + IF(NB_ROWS(IDWLOAD(i)).GT.KMAX)THEN + ENDIF + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(IDWLOAD(i))) + NB_ROWS(IDWLOAD(i))=KMAX + NB_SAT=NB_SAT+1 + IF(NB_SAT.EQ.SMALL_SET)THEN + IF(SMALL_SET.NE.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + MAX_LOAD=max(MAX_LOAD, + & (TEMP(IDWLOAD(i))+(dble(NELIM) * + & dble(NB_ROWS(IDWLOAD(i))))+ + & (dble(NB_ROWS(IDWLOAD(i)))* + & dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + GOTO 777 + ENDIF + ENDIF + AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT)) + AFFECTED=max(AFFECTED,1) + ELSE + IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED, + & ADDITIONNAL_ROWS)).GE.KMIN)THEN + X=min(AFFECTED,ADDITIONNAL_ROWS) + NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+ + & X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ELSE + X=int((MAX_LOAD-TEMP(IDWLOAD(i)))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X+AFFECTED.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ELSE + X=AFFECTED+X + ENDIF + IF(X.GE.KMIN)THEN + NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+ + & X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & X + ELSE + NB_ZERO=NB_ZERO+1 + ENDIF + ENDIF + ENDIF + 912 CONTINUE + MAX_LOAD=max(MAX_LOAD, + & (TEMP(IDWLOAD(i))+(dble(NELIM)* + & dble(NB_ROWS(IDWLOAD(i))))+ + & (dble(NB_ROWS(IDWLOAD(i)))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + IF(SMALL_SET.LT.NUMBER_OF_PROCS)THEN + IF(MAX_LOAD.GT.TEMP(SMALL_SET+1))THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ENDIF + ENDIF + IF(SMALL_SET.EQ.NB_SAT)GOTO 777 + IF(ADDITIONNAL_ROWS.EQ.0)THEN + CHOSEN=SMALL_SET + GOTO 049 + ENDIF + ENDDO + 777 CONTINUE + IF((NB_ZERO.NE.0).AND.(ADDITIONNAL_ROWS.GE.KMIN))THEN + J=NB_ZERO + 732 CONTINUE + X=int(ADDITIONNAL_ROWS/(J)) + IF(X.LT.KMIN)THEN + J=J-1 + GOTO 732 + ENDIF + IF(X*J.LT.ADDITIONNAL_ROWS)THEN + X=X+1 + ENDIF + DO i=1,SMALL_SET + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & dble(BANDE_K821)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(NB_ROWS(i).EQ.0)THEN + IF(X.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ENDIF + IF(X.GT.KMAX)THEN + X=KMAX + ENDIF + IF(X.GT.KMIN)THEN + NB_ROWS(i)=X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + MAX_LOAD=max(MAX_LOAD, + & (TEMP(i)+(dble(NELIM) * + & dble(NB_ROWS(i)))+ + & (dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + ENDIF + ENDIF + ENDDO + ENDIF + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF((TEMP(i).LE.MAX_LOAD))THEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + AFFECTED=int((MAX_LOAD-TEMP(i))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(i).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(i)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(i) + NB_SAT=NB_SAT+1 + ELSE + IF((AFFECTED+NB_ROWS(i)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(i)=NB_ROWS(i)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + ENDIF + ELSE IF((TEMP(i).GT.MAX_LOAD))THEN + IF(NB_SAT.EQ.i-1) GOTO 218 + X=(ADDITIONNAL_ROWS/(i-1-NB_SAT)) + ACC=1 + DO J=1,i-1 + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(J)+X)) + & +(dble(NB_ROWS(J)+X)*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + IF((TEMP(J)+TMP_SUM).GT.MAX_LOAD)THEN + ACC=0 + ENDIF + ENDDO + IF(ACC.EQ.1)THEN + MAX_LOAD=TEMP(i) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + AFFECTED=X + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(J).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + NB_SAT=NB_SAT+1 + ELSE + IF((AFFECTED+NB_ROWS(J)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & AFFECTED + ENDIF + J=J+1 + ENDDO + ELSE + MAX_LOAD=TEMP(i) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + TMP_SUM=((dble(NELIM)* dble(NB_ROWS(J))) + & +(dble(NB_ROWS(J))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((MAX_LOAD-(TEMP(J)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 10 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + AFFECTED=X + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(J).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + NB_SAT=NB_SAT+1 + ELSE + IF((AFFECTED+NB_ROWS(J)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & AFFECTED + ENDIF + J=J+1 + ENDDO + ENDIF + ENDIF + 218 CONTINUE + i=i+1 + ENDDO + CHOSEN=i-1 + IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. + & (ADDITIONNAL_ROWS.NE.0))THEN + DO i=1,CHOSEN + IF(NB_ROWS(i)+1.GE.KMIN)THEN + NB_ROWS(i)=NB_ROWS(i)+1 + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 + ENDIF + MAX_LOAD=max(MAX_LOAD, + & (TEMP(i)+(dble(NELIM) * + & dble(NB_ROWS(i)))+ + & (dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 048 + ENDDO + 048 CONTINUE + ENDIF + IF((ADDITIONNAL_ROWS.NE.0))THEN + IF(CHOSEN.LT.NUMBER_OF_PROCS)THEN + i=CHOSEN+1 + ELSE + IF(CHOSEN.NE.NUMBER_OF_PROCS)THEN + WRITE(*,*)MYID, + & ': Internal error 11 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + i=CHOSEN + ENDIF + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF(TEMP(i).LE.MAX_LOAD)THEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) + & +(dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((MAX_LOAD-(TEMP(i)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + AFFECTED=X + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 12 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(i).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(i)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(i) + ELSE + IF((AFFECTED+NB_ROWS(i)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(i)=NB_ROWS(i)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + ENDIF + IF(i.NE.NUMBER_OF_PROCS) GOTO 624 + ELSE IF((TEMP(i).GT.MAX_LOAD))THEN + X=int(ADDITIONNAL_ROWS/i-1) + X=max(X,1) + IF((MAX_LOAD+((dble(NELIM)* + & dble(X))+(dble( + & X)*dble(NELIM))*dble( + & (2*NFRONT-NELIM-1)))).LE.TEMP(i))THEN + AFFECTED=X + POS=1 + ELSE + POS=0 + ENDIF + MAX_LOAD=TEMP(i) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + MAX_MEM_ALLOW=BANDE_K821 + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(POS.EQ.0)THEN + TMP_SUM=((dble(NELIM) * + & dble(NB_ROWS(J))) + & +(dble(NB_ROWS(J))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((TEMP(i)-(TEMP(J)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT- + & NELIM))) + ELSE + X=int(TMP_SUM) + ENDIF + IF(X.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(J).LT.KMAX)THEN + IF((X+NB_ROWS(J)).GT.KMAX)THEN + X=KMAX-NB_ROWS(J) + ELSE + IF((NB_ROWS(J)+X).LT. + & KMIN)THEN + X=0 + ENDIF + ENDIF + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDIF + J=J+1 + ENDDO + ENDIF + 624 CONTINUE + i=i+1 + ENDDO + CHOSEN=i-1 + IF(ADDITIONNAL_ROWS.NE.0)THEN + ACC=0 + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) + & +(dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((MAX_LOAD- + & (TEMP(i)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 13 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(i).LT.KMAX)THEN + IF((X+NB_ROWS(i)).GE.KMAX)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + IF((X+NB_ROWS(i)).GE. + & KMIN)THEN + NB_ROWS(i)=NB_ROWS(i)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ACC=ACC+1 + ELSE + ACC=ACC+1 + ENDIF + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + IF(CHOSEN.LT.NUMBER_OF_PROCS)THEN + CHOSEN=CHOSEN+1 + ENDIF + IF(ACC.EQ.0)THEN + ACC=1 + ENDIF + X=int(ADDITIONNAL_ROWS/ACC) + X=max(X,1) + ACC=0 + DO i=1,CHOSEN + J=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(J)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + J=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(J)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) + & +(dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + J=int((MAX_LOAD- + & (TEMP(i)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(NB_ROWS(i).LT.KMAX)THEN + IF((min(X,J)+NB_ROWS(i)).GE.KMAX)THEN + IF((KMAX-NB_ROWS(i)).GT. + & ADDITIONNAL_ROWS)THEN + NB_ROWS(i)=NB_ROWS(i)+ + & ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ENDIF + ELSE + IF((min(X,J)+NB_ROWS(i)).GE. + & KMIN)THEN + NB_ROWS(i)=NB_ROWS(i)+min(X,J) + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & min(X,J) + ACC=ACC+1 + ENDIF + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + IF(ACC.GT.0)THEN + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(KMAX-NB_ROWS(i).LT. + & ADDITIONNAL_ROWS)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + IF(NB_ROWS(i).EQ.0)THEN + IF(min(KMIN,KMAX).LT. + & ADDITIONNAL_ROWS)THEN + NB_ROWS(i)=min(KMIN,KMAX) + ADDITIONNAL_ROWS= + & ADDITIONNAL_ROWS- + & min(KMIN,KMAX) + ENDIF + ELSE + NB_ROWS(i)=NB_ROWS(i)+ + & ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + ENDIF + DO i=1,CHOSEN + IDWLOAD(i)=i + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + WLOAD(i)=(BANDE_K821-dble(NB_ROWS(i)*NFRONT)) + ENDDO + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, + & IDWLOAD) + NB_SAT=0 + DO i=1,CHOSEN + X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT)) + X=max(X,1) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(NB_ROWS(IDWLOAD(i)).LT.KMAX)THEN + IF((NB_ROWS(IDWLOAD(i))+X).LT.KMAX)THEN + NB_ROWS(IDWLOAD(i))= + & NB_ROWS(IDWLOAD(i))+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(IDWLOAD(i))) + NB_ROWS(IDWLOAD(i))=KMAX + ENDIF + ENDIF + IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN + NB_SAT=NB_SAT+1 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 049 + ENDDO + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(KMAX-NB_ROWS(i).LT.ADDITIONNAL_ROWS)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + X=int(ADDITIONNAL_ROWS/CHOSEN) + X=max(X,1) + DO i=1,CHOSEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + NB_ROWS(i)=NB_ROWS(i)+X + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS + ENDIF + ENDIF + 049 CONTINUE + ENDIF + 666 CONTINUE + SOMME=dble(0) + X=0 + POS=0 + DO i=1,CHOSEN + X=X+NB_ROWS(i) + SOMME=SOMME+ dble(NB_ROWS(i)) + ENDDO + GOTO 890 + ELSE IF((KEEP(83).GE.NUMBER_OF_PROCS).AND.FORCE_CAND)THEN + MAX_LOAD=dble(0) + DO i=1,OTHERS + MAX_LOAD=max(MAX_LOAD,TEMP(i)) + ENDDO + ACC=0 + CHOSEN=0 + X=1 + DO i=1,OTHERS + ENDDO + DO i=2,OTHERS + IF(TEMP(i).EQ.TEMP(1))THEN + X=X+1 + ELSE + GOTO 329 + ENDIF + ENDDO + 329 CONTINUE + TMP_SUM=TOTAL_COST/dble(X) + TEMP_MAX_LOAD=dble(0) + DO i=1,OTHERS + IF(K50.EQ.0)THEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + IF(HAVE_TYPE1_SON)THEN + IF(K50.EQ.0)THEN + X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i))) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + IF(K50.EQ.0)THEN + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(TMP_SUM+TEMP(i).GT.MAX_LOAD)THEN + SOMME=MAX_LOAD-TEMP(i) + ELSE + SOMME=TMP_SUM + ENDIF + X=int(SOMME/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.GT.KMAX)THEN + X=KMAX + ELSE + IF(X.LT.KMIN)THEN + X=min(KMIN,KMAX) + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + IF(TMP_SUM+TEMP(i).GT.MAX_LOAD)THEN + C=-(MAX_LOAD-TEMP(i)) + ELSE + C=-TMP_SUM + ENDIF + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 14 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GT.KMIN)THEN + X=KMAX + ELSE + X=0 + ENDIF + ELSE + IF(X.LE.min(KMIN,KMAX))THEN + IF(KMAX.LT.KMIN)THEN + X=0 + ELSE + X=min(KMIN,KMAX) + ENDIF + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + TEMP_MAX_LOAD=max(TEMP_MAX_LOAD,TEMP(i)) + NB_ROWS(i)=X + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(ACC.EQ.NCB) GOTO 541 + ENDDO + 541 CONTINUE + IF(ACC.LT.NCB)THEN + IF(K50.EQ.0)THEN + ADDITIONNAL_ROWS=NCB-ACC + DO J=1,CHOSEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & dble(BANDE_K821)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF((NB_ROWS(J)).LT.KMAX)THEN + IF(ADDITIONNAL_ROWS.GT.(KMAX-NB_ROWS(J)))THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(J)) + NB_ROWS(J)=KMAX + ELSE + NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 + ENDDO + X=int(ADDITIONNAL_ROWS/CHOSEN) + X=max(X,1) + DO J=1,CHOSEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(J)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF((NB_ROWS(J)+X).GT.KMAX)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(J)) + NB_ROWS(J)=KMAX + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + NB_ROWS(J)=NB_ROWS(J)+X + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 + ENDDO + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(KMAX-NB_ROWS(i).LT.ADDITIONNAL_ROWS)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 + ENDDO + DO i=1,NUMBER_OF_PROCS + IDWLOAD(i)=i + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + WLOAD(i)=(BANDE_K821-(dble(NB_ROWS(i))* + & dble(NFRONT))) + ENDDO + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, + & IDWLOAD) + NB_SAT=0 + DO i=1,CHOSEN + X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT)) + X=max(X,1) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(NB_ROWS(IDWLOAD(i)).LT.KMAX)THEN + IF((NB_ROWS(IDWLOAD(i))+X).LT.KMAX)THEN + NB_ROWS(IDWLOAD(i))= + & NB_ROWS(IDWLOAD(i))+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(IDWLOAD(i))) + NB_ROWS(IDWLOAD(i))=KMAX + ENDIF + ENDIF + IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN + NB_SAT=NB_SAT+1 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 889 + ENDDO + GOTO 994 + ELSE + ACC=0 + CHOSEN=0 + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=KMAX-NB_ROWS(i) + IF((ACC+NB_ROWS(i)+X).GT.NCB) + & X=NCB-(ACC+NB_ROWS(i)) + NB_ROWS(i)=NB_ROWS(i)+X + ACC=ACC+NB_ROWS(i) + CHOSEN=CHOSEN+1 + IF(NCB.EQ.ACC) GOTO 889 + ENDDO + ADDITIONNAL_ROWS=NCB-ACC + ENDIF + ACC=0 + CHOSEN=0 + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=KMAX-NB_ROWS(i) + IF((ACC+NB_ROWS(i)+X).GT.NCB) + & X=NCB-(ACC+NB_ROWS(i)) + NB_ROWS(i)=NB_ROWS(i)+X + ACC=ACC+NB_ROWS(i) + CHOSEN=CHOSEN+1 + IF(NCB.EQ.ACC) GOTO 889 + ENDDO + ADDITIONNAL_ROWS=NCB-ACC + 994 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(OTHERS)) + IF((X*OTHERS).LT.ADDITIONNAL_ROWS)THEN + X=X+1 + ENDIF + DO i=1,OTHERS + NB_ROWS(i)=NB_ROWS(i)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + IF(ADDITIONNAL_ROWS.LT.X)X=ADDITIONNAL_ROWS + ENDDO + CHOSEN=OTHERS + ENDIF + ENDIF + 889 CONTINUE + MAX_LOAD=TEMP_MAX_LOAD + 890 CONTINUE + J=CHOSEN + X=0 + DO i=J,1,-1 + IF(NB_ROWS(i).EQ.0)THEN + CHOSEN=CHOSEN-1 + ELSE + IF(NB_ROWS(i).GT.0)THEN + X=1 + ELSE + WRITE(*,*)MYID, + & ': Internal error 15 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDDO + NSLAVES_NODE=CHOSEN + TAB_POS(NSLAVES_NODE+1)= NCB+1 + TAB_POS(SLAVEF+2) = CHOSEN + POS=1 + X=1 + DO i=1,J + IF(NB_ROWS(i).NE.0)THEN + SLAVES_LIST(X)=TEMP_ID(i) + TAB_POS(X)=POS + POS=POS+NB_ROWS(i) + IF(NB_ROWS(i).LE.0)THEN + WRITE(*,*)MYID, + & ': Internal error 16 in DMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + X=X+1 + ENDIF + ENDDO + DO i=CHOSEN+1,NUMBER_OF_PROCS + SLAVES_LIST(i)=TEMP_ID(i) + ENDDO + IF(POS.NE.(NCB+1))THEN + WRITE(*,*)MYID, + & ': Internal error 17 in DMUMPS_518', + & POS,NCB+1 + CALL MUMPS_ABORT() + ENDIF + END SUBROUTINE DMUMPS_518 + SUBROUTINE DMUMPS_520 + & (INODE,UPPER,SLAVEF,KEEP,KEEP8, + & STEP,POOL,LPOOL,PROCNODE,N) + IMPLICIT NONE + INTEGER INODE, LPOOL, SLAVEF, N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER STEP(KEEP(28)), POOL(LPOOL), PROCNODE(KEEP(28)) + LOGICAL UPPER + INTEGER J + DOUBLE PRECISION MEM_COST + INTEGER NBINSUBTREE,i,NBTOP + EXTERNAL DMUMPS_508, + & MUMPS_170 + LOGICAL DMUMPS_508, + & MUMPS_170 + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + IF(KEEP(47).LT.2)THEN + WRITE(*,*)'DMUMPS_520 must + & be called with K47>=2' + CALL MUMPS_ABORT() + ENDIF + IF((INODE.GT.0).AND.(INODE.LE.N))THEN + MEM_COST=DMUMPS_543(INODE) + IF((DM_MEM(MYID)+dble(MEM_COST)+ PEAK_SBTR_CUR_LOCAL- + & SBTR_CUR_LOCAL) + & .GT.MAX_PEAK_STK)THEN + DO i=NBTOP-1,1,-1 + INODE = POOL( LPOOL - 2 - i) + MEM_COST=DMUMPS_543(INODE) + IF((INODE.LT.0).OR.(INODE.GT.N)) THEN + DO J=i+1,NBTOP,-1 + POOL(J-1)=POOL(J) + ENDDO + UPPER=.TRUE. + RETURN + ENDIF + IF((DM_MEM(MYID)+dble(MEM_COST)+PEAK_SBTR_CUR_LOCAL- + & SBTR_CUR_LOCAL).LE. + & MAX_PEAK_STK) THEN + DO J=i+1,NBTOP,-1 + POOL(J-1)=POOL(J) + ENDDO + UPPER=.TRUE. + RETURN + ENDIF + ENDDO + IF(NBINSUBTREE.NE.0)THEN + INODE = POOL( NBINSUBTREE ) + IF(.NOT.MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + WRITE(*,*) + & 'Internal error 1 in DMUMPS_520' + CALL MUMPS_ABORT() + ENDIF + UPPER=.FALSE. + RETURN + ENDIF + INODE=POOL(LPOOL-2-NBTOP) + UPPER=.TRUE. + RETURN + ENDIF + ENDIF + UPPER=.TRUE. + END SUBROUTINE DMUMPS_520 + SUBROUTINE DMUMPS_513(WHAT) + IMPLICIT NONE + LOGICAL WHAT + IF(.NOT.BDC_POOL_MNG)THEN + WRITE(*,*)'DMUMPS_513 + & should be called when K81>0 and K47>2' + ENDIF + IF(WHAT)THEN + PEAK_SBTR_CUR_LOCAL=PEAK_SBTR_CUR_LOCAL+ + & dble(MEM_SUBTREE(INDICE_SBTR)) + IF(.NOT.BDC_SBTR) INDICE_SBTR=INDICE_SBTR+1 + ELSE + PEAK_SBTR_CUR_LOCAL=dble(0) + SBTR_CUR_LOCAL=dble(0) + ENDIF + END SUBROUTINE DMUMPS_513 + DOUBLE PRECISION FUNCTION DMUMPS_543( INODE ) + IMPLICIT NONE + INTEGER INODE,LEVEL,i,NELIM,NFR + DOUBLE PRECISION COST + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + NFR = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253) + LEVEL = MUMPS_330( PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS ) + IF (LEVEL .EQ. 1) THEN + COST = dble(NFR) * dble(NFR) + ELSE + IF ( K50 == 0 ) THEN + COST = dble(NFR) * dble(NELIM) + ELSE + COST = dble(NELIM) * dble(NELIM) + ENDIF + ENDIF + DMUMPS_543=COST + RETURN + END FUNCTION DMUMPS_543 + RECURSIVE SUBROUTINE DMUMPS_515(FLAG,COST,COMM) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER COMM,WHAT,IERR + LOGICAL FLAG + DOUBLE PRECISION COST + DOUBLE PRECISION TO_BE_SENT + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF(FLAG)THEN + WHAT=17 + IF(BDC_M2_FLOPS)THEN +#if ! defined(OLD_LOAD_MECHANISM) + TO_BE_SENT=DELTA_LOAD-COST + DELTA_LOAD=dble(0) +#else + TO_BE_SENT=LAST_LOAD_SENT-COST + LAST_LOAD_SENT=LAST_LOAD_SENT-COST +#endif + ELSE IF(BDC_M2_MEM)THEN + IF(BDC_POOL.AND.(.NOT.BDC_MD))THEN + TO_BE_SENT=max(TMP_M2,POOL_LAST_COST_SENT) + POOL_LAST_COST_SENT=TO_BE_SENT + ELSE IF(BDC_MD)THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_MEM=DELTA_MEM+TMP_M2 + TO_BE_SENT=DELTA_MEM +#else + TO_BE_SENT=DM_LAST_MEM_SENT+TMP_M2 + DM_LAST_MEM_SENT=DM_LAST_MEM_SENT+TMP_M2 +#endif + ELSE + TO_BE_SENT=dble(0) + ENDIF + ENDIF + ELSE + WHAT=6 + TO_BE_SENT=dble(0) + ENDIF + 111 CONTINUE + CALL DMUMPS_460( WHAT, + & COMM, NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & COST, + & TO_BE_SENT, + & MYID, IERR ) + IF ( IERR == -1 )THEN + CALL DMUMPS_467(COMM_LD, KEEP_LOAD) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in DMUMPS_500", + & IERR + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE DMUMPS_515 + SUBROUTINE DMUMPS_512(INODE,STEP,NSTEPS,PROCNODE,FRERE, + & NE,COMM,SLAVEF,MYID,KEEP,KEEP8,N) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER INODE,NSTEPS,MYID,SLAVEF,COMM,N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER FRERE(NSTEPS),NE(NSTEPS),STEP(N),PROCNODE(NSTEPS) + EXTERNAL MUMPS_170,MUMPS_275 + LOGICAL MUMPS_170 + INTEGER i,NCB,NELIM + INTEGER MUMPS_275 + INTEGER FATHER_NODE,FATHER,WHAT,IERR + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN + WRITE(*,*)MYID,': Problem in DMUMPS_512' + CALL MUMPS_ABORT() + ENDIF + IF((INODE.LT.0).OR.(INODE.GT.N)) THEN + RETURN + ENDIF + i=INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + NCB=ND_LOAD(STEP_LOAD(INODE))-NELIM + KEEP_LOAD(253) + WHAT=5 + FATHER_NODE=DAD_LOAD(STEP_LOAD(INODE)) + IF (FATHER_NODE.EQ.0) THEN + RETURN + ENDIF + IF((FRERE(STEP(FATHER_NODE)).EQ.0).AND. + & ((FATHER_NODE.EQ.KEEP(38)).OR. + & (FATHER_NODE.EQ.KEEP(20))))THEN + RETURN + ENDIF + IF(MUMPS_170(PROCNODE(STEP(FATHER_NODE)), + & SLAVEF)) THEN + RETURN + ENDIF + FATHER=MUMPS_275(PROCNODE(STEP(FATHER_NODE)),SLAVEF) + IF(FATHER.EQ.MYID)THEN + IF(BDC_M2_MEM)THEN + CALL DMUMPS_816(FATHER_NODE) + ELSEIF(BDC_M2_FLOPS)THEN + CALL DMUMPS_817(FATHER_NODE) + ENDIF + IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN + IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), + & NPROCS).EQ.1)THEN + CB_COST_ID(POS_ID)=INODE + CB_COST_ID(POS_ID+1)=1 + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + CB_COST_MEM(POS_MEM)=int(MYID,8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(NCB,8)*int(NCB,8) + POS_MEM=POS_MEM+1 + ENDIF + ENDIF + GOTO 666 + ENDIF + 111 CONTINUE + CALL DMUMPS_519(WHAT, COMM, NPROCS, + & FATHER_NODE,INODE,NCB, KEEP(81),MYID, + & FATHER, IERR) + IF (IERR == -1 ) THEN + CALL DMUMPS_467(COMM, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in DMUMPS_512", + & IERR + CALL MUMPS_ABORT() + ENDIF + 666 CONTINUE + END SUBROUTINE DMUMPS_512 + SUBROUTINE DMUMPS_514(INODE,NUM_CALL) + IMPLICIT NONE + DOUBLE PRECISION MAXI + INTEGER i,J,IND_MAXI + INTEGER INODE,NUM_CALL + IF(BDC_M2_MEM)THEN + IF(((NUM_CALL.EQ.1).AND.(BDC_MD)).OR. + & ((NUM_CALL.EQ.2).AND.(.NOT.BDC_MD)))THEN + RETURN + ENDIF + ENDIF + IF((FRERE_LOAD(STEP_LOAD(INODE)).EQ.0).AND. + & ((INODE.EQ.KEEP_LOAD(38)).OR. + & (INODE.EQ.KEEP_LOAD(20)))) THEN + RETURN + ENDIF + DO i=POOL_SIZE,1,-1 + IF(POOL_NIV2(i).EQ.INODE) GOTO 666 + ENDDO + NB_SON(STEP_LOAD(INODE))=-1 + RETURN + 666 CONTINUE + IF(BDC_M2_MEM)THEN + IF(POOL_NIV2_COST(i).EQ.MAX_M2)THEN + TMP_M2=MAX_M2 + MAXI=dble(0) + IND_MAXI=-9999 + DO J=POOL_SIZE,1,-1 + IF(J.NE.i) THEN + IF(POOL_NIV2_COST(J).GT.MAXI)THEN + MAXI=POOL_NIV2_COST(J) + IND_MAXI=J + ENDIF + ENDIF + ENDDO + MAX_M2=MAXI + J=IND_MAXI + REMOVE_NODE_FLAG_MEM=.TRUE. + REMOVE_NODE_COST_MEM=TMP_M2 + CALL DMUMPS_515(REMOVE_NODE_FLAG,MAX_M2,COMM_LD) + NIV2(MYID+1)=MAX_M2 + ENDIF + ELSEIF(BDC_M2_FLOPS)THEN + REMOVE_NODE_COST=POOL_NIV2_COST(i) + REMOVE_NODE_FLAG=.TRUE. + CALL DMUMPS_515(REMOVE_NODE_FLAG, + & -POOL_NIV2_COST(i),COMM_LD) + NIV2(MYID+1)=NIV2(MYID+1)-POOL_NIV2_COST(i) + ENDIF + DO J=i+1,POOL_SIZE + POOL_NIV2(J-1)=POOL_NIV2(J) + POOL_NIV2_COST(J-1)=POOL_NIV2_COST(J) + ENDDO + POOL_SIZE=POOL_SIZE-1 + END SUBROUTINE DMUMPS_514 + RECURSIVE SUBROUTINE DMUMPS_816(INODE) + IMPLICIT NONE + INTEGER INODE + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF((INODE.EQ.KEEP_LOAD(20)).OR. + & (INODE.EQ.KEEP_LOAD(38)))THEN + RETURN + ENDIF + IF(NB_SON(STEP_LOAD(INODE)).EQ.-1)THEN + RETURN + ELSE + IF(NB_SON(STEP_LOAD(INODE)).LT.0)THEN + WRITE(*,*) + & 'Internal error 1 in DMUMPS_816' + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_SON(STEP_LOAD(INODE))= + & NB_SON(STEP_LOAD(INODE))-1 + IF(NB_SON(STEP_LOAD(INODE)).EQ.0)THEN + POOL_NIV2(POOL_SIZE+1)=INODE + POOL_NIV2_COST(POOL_SIZE+1)= + & DMUMPS_543(INODE) + POOL_SIZE=POOL_SIZE+1 + IF(POOL_NIV2_COST(POOL_SIZE).GT.MAX_M2)THEN + MAX_M2=POOL_NIV2_COST(POOL_SIZE) + ID_MAX_M2=POOL_NIV2(POOL_SIZE) + CALL DMUMPS_515(REMOVE_NODE_FLAG_MEM,MAX_M2,COMM_LD) + NIV2(1+MYID)=MAX_M2 + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_816 + RECURSIVE SUBROUTINE DMUMPS_817(INODE) + IMPLICIT NONE + INTEGER INODE + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF((INODE.EQ.KEEP_LOAD(20)).OR. + & (INODE.EQ.KEEP_LOAD(38)))THEN + RETURN + ENDIF + IF(NB_SON(STEP_LOAD(INODE)).EQ.-1)THEN + RETURN + ELSE + IF(NB_SON(STEP_LOAD(INODE)).LT.0)THEN + WRITE(*,*) + & 'Internal error 1 in DMUMPS_817' + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_SON(STEP_LOAD(INODE))= + & NB_SON(STEP_LOAD(INODE))-1 + IF(NB_SON(STEP_LOAD(INODE)).EQ.0)THEN + POOL_NIV2(POOL_SIZE+1)=INODE + POOL_NIV2_COST(POOL_SIZE+1)= + & DMUMPS_542(INODE) + POOL_SIZE=POOL_SIZE+1 + MAX_M2=POOL_NIV2_COST(POOL_SIZE) + ID_MAX_M2=POOL_NIV2(POOL_SIZE) + CALL DMUMPS_515(REMOVE_NODE_FLAG, + & POOL_NIV2_COST(POOL_SIZE), + & COMM_LD) + NIV2(MYID+1)=POOL_NIV2_COST(POOL_SIZE)+NIV2(MYID+1) + ENDIF + RETURN + END SUBROUTINE DMUMPS_817 + DOUBLE PRECISION FUNCTION DMUMPS_542(INODE) + INTEGER INODE + INTEGER NFRONT,NELIM,i,LEVEL + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + DOUBLE PRECISION COST + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + NFRONT = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253) + LEVEL = MUMPS_330( PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS ) + COST=dble(0) + CALL MUMPS_511(NFRONT,NELIM,NELIM, + & KEEP_LOAD(50),LEVEL,COST) + DMUMPS_542=COST + RETURN + END FUNCTION DMUMPS_542 + INTEGER FUNCTION DMUMPS_541( INODE ) + IMPLICIT NONE + INTEGER INODE,NELIM,NFR,SON,IN,i + INTEGER COST_CB + COST_CB=0 + i = INODE + 10 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 10 + ENDIF + SON=-i + DO i=1, NE_LOAD(STEP_LOAD(INODE)) + NFR = ND_LOAD( STEP_LOAD(SON) ) + KEEP_LOAD(253) + IN=SON + NELIM = 0 + 20 CONTINUE + IF ( IN > 0 ) THEN + NELIM = NELIM + 1 + IN = FILS_LOAD(IN) + GOTO 20 + ENDIF + COST_CB=COST_CB+((NFR-NELIM)*(NFR-NELIM)) + SON=FRERE_LOAD(STEP_LOAD(SON)) + ENDDO + DMUMPS_541=COST_CB + RETURN + END FUNCTION DMUMPS_541 + SUBROUTINE DMUMPS_533(SLAVEF,NMB_OF_CAND, + & TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, + & NSLAVES,INODE) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER, INTENT (IN) :: SLAVEF, NASS, NSLAVES + INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2) + INTEGER, intent(in) :: NMB_OF_CAND + INTEGER, INTENT (IN) :: LIST_SLAVES( NMB_OF_CAND ) + INTEGER KEEP(500),INODE + INTEGER(8) KEEP8(150) + INTEGER allocok + DOUBLE PRECISION MEM_COST,FCT_COST + DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE ::EMPTY_ARRAY, + & DELTA_MD,EMPTY_ARRAY2 + INTEGER NBROWS_SLAVE,i,WHAT,IERR,NPROCS_LOC + LOGICAL FORCE_CAND + MEM_COST=dble(0) + FCT_COST=dble(0) + IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN + FORCE_CAND = .FALSE. + NPROCS_LOC=SLAVEF-1 + ELSE + FORCE_CAND = (mod(KEEP(24),2).eq.0) + NPROCS_LOC=NMB_OF_CAND + END IF + IF(FORCE_CAND)THEN + CALL DMUMPS_540(INODE,FCT_COST, + & MEM_COST,NPROCS_LOC,NASS) + ELSE + CALL DMUMPS_540(INODE,FCT_COST, + & MEM_COST,SLAVEF-1,NASS) + ENDIF + DO i=1,SLAVEF + IDWLOAD(i)=i-1 + ENDDO + ALLOCATE(EMPTY_ARRAY(NPROCS_LOC),DELTA_MD(NPROCS_LOC), + & EMPTY_ARRAY2(NPROCS_LOC), + & stat=allocok) + DO i = 1, NSLAVES + NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i) + DELTA_MD( i ) = FCT_COST - dble(NBROWS_SLAVE)* + & dble(NASS) + END DO + IF(FORCE_CAND)THEN + DO i=NSLAVES+1,NPROCS_LOC + DELTA_MD( i ) = FCT_COST + ENDDO + ELSE + DO i=NSLAVES+1,SLAVEF-1 + DELTA_MD( i ) = FCT_COST + ENDDO + ENDIF + WHAT=7 + 111 CONTINUE + CALL DMUMPS_524(.FALSE., COMM_LD, MYID, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & NPROCS_LOC, LIST_SLAVES,0, + & EMPTY_ARRAY, + & DELTA_MD,EMPTY_ARRAY2,WHAT, IERR) + IF ( IERR == -1 ) THEN + CALL DMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in DMUMPS_533", + & IERR + CALL MUMPS_ABORT() + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (FUTURE_NIV2(MYID+1) .NE. 0) THEN +#endif + DO i = 1, NSLAVES + MD_MEM(LIST_SLAVES(i))=MD_MEM(LIST_SLAVES(i))+ + & int(DELTA_MD( i ),8) +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(LIST_SLAVES(i)+1).EQ.0)THEN + MD_MEM(LIST_SLAVES(i))=999999999_8 + ENDIF +#endif + ENDDO +#if ! defined(OLD_LOAD_MECHANISM) + ENDIF +#endif + DEALLOCATE(EMPTY_ARRAY) + DEALLOCATE(DELTA_MD) + END SUBROUTINE DMUMPS_533 + SUBROUTINE DMUMPS_540(INODE,FCT_COST, + & MEM_COST,NSLAVES,NELIM) + IMPLICIT NONE + INTEGER INODE,NSLAVES,NFR,NELIM,IN + DOUBLE PRECISION MEM_COST,FCT_COST + NFR=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253) + IN = INODE + FCT_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)* + & dble(NELIM) + MEM_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)* + & dble(NFR) + END SUBROUTINE DMUMPS_540 + SUBROUTINE DMUMPS_819(INODE) + IMPLICIT NONE + INTEGER INODE + INTEGER i,J,SON,NSLAVES_TEMP,POS_TEMP,K + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + IF((INODE.LT.0).OR.(INODE.GT.N_LOAD))THEN + RETURN + ENDIF + IF(POS_ID.GT.1)THEN + i=INODE + 10 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 10 + ENDIF + SON=-i + IF(POS_ID.LT.NE_LOAD(STEP_LOAD(INODE))*3)THEN + i=1 + ENDIF + DO i=1, NE_LOAD(STEP_LOAD(INODE)) + J=1 + DO WHILE (J.LT.POS_ID) + IF(CB_COST_ID(J).EQ.SON)GOTO 295 + J=J+3 + ENDDO + 295 CONTINUE + IF(J.GE.POS_ID)THEN + IF(MUMPS_275( + & PROCNODE_LOAD(STEP_LOAD(INODE)),NPROCS).EQ.MYID)THEN + IF(INODE.EQ.KEEP_LOAD(38))THEN + GOTO 666 +#if ! defined(OLD_LOAD_MECHANISM) + ELSE + IF(FUTURE_NIV2(MYID+1).NE.0)THEN + WRITE(*,*)MYID,': i did not find ',SON + CALL MUMPS_ABORT() + ENDIF + GOTO 666 +#endif + ENDIF + ELSE + GOTO 666 + ENDIF + ENDIF + NSLAVES_TEMP=CB_COST_ID(J+1) + POS_TEMP=CB_COST_ID(J+2) + DO K=J,POS_ID-1 + CB_COST_ID(K)=CB_COST_ID(K+3) + ENDDO + K=POS_TEMP + DO WHILE (K.LE.POS_MEM-1) + CB_COST_MEM(K)=CB_COST_MEM(K+2*NSLAVES_TEMP) + K=K+1 + ENDDO + POS_MEM=POS_MEM-2*NSLAVES_TEMP + POS_ID=POS_ID-3 + IF((POS_MEM.LT.1).OR.(POS_ID.LT.1))THEN + WRITE(*,*)MYID,': negative pos_mem or pos_id' + CALL MUMPS_ABORT() + ENDIF + 666 CONTINUE + SON=FRERE_LOAD(STEP_LOAD(SON)) + ENDDO + ENDIF + END SUBROUTINE DMUMPS_819 + SUBROUTINE DMUMPS_820(FLAG) + IMPLICIT NONE + LOGICAL FLAG + INTEGER i + DOUBLE PRECISION MEM + FLAG=.FALSE. + DO i=0,NPROCS-1 + MEM=DM_MEM(i)+LU_USAGE(i) + IF(BDC_SBTR)THEN + MEM=MEM+SBTR_MEM(i)-SBTR_CUR(i) + ENDIF + IF((MEM/dble(TAB_MAXS(i))).GT.0.8d0)THEN + FLAG=.TRUE. + GOTO 666 + ENDIF + ENDDO + 666 CONTINUE + END SUBROUTINE DMUMPS_820 + SUBROUTINE DMUMPS_554(NBINSUBTREE,INSUBTREE,NBTOP, + & MIN_COST,SBTR) + IMPLICIT NONE + INTEGER NBINSUBTREE,INSUBTREE,NBTOP + DOUBLE PRECISION MIN_COST + LOGICAL SBTR + INTEGER i + DOUBLE PRECISION TMP_COST,TMP_MIN + TMP_MIN=huge(TMP_MIN) + DO i=0,NPROCS-1 + IF(i.NE.MYID)THEN + IF(BDC_SBTR)THEN + TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))-(DM_MEM(i)+ + & LU_USAGE(i))-(SBTR_MEM(i)-SBTR_CUR(i))) + ELSE + TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))- + & (DM_MEM(i)+LU_USAGE(i))) + ENDIF + ENDIF + ENDDO + IF(NBINSUBTREE.GT.0)THEN + IF(INSUBTREE.EQ.1)THEN + TMP_COST=dble(TAB_MAXS(MYID))-(DM_MEM(MYID)+ + & LU_USAGE(MYID)) + & -(SBTR_MEM(MYID)-SBTR_CUR(MYID)) + ELSE + SBTR=.FALSE. + GOTO 777 + ENDIF + ENDIF + TMP_MIN=min(TMP_COST,TMP_MIN) + IF(TMP_MIN.GT.MIN_COST) SBTR=.TRUE. + 777 CONTINUE + END SUBROUTINE DMUMPS_554 + SUBROUTINE DMUMPS_818(INODE,MAX_MEM,PROC) + IMPLICIT NONE + INTEGER INODE,PROC + INTEGER i,POS,NSLAVES,SLAVE,NCAND,J,NELIM,NCB,NFRONT,SON,K + INTEGER allocok + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + DOUBLE PRECISION MAX_MEM + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: MEM_ON_PROCS, + & RECV_BUF + LOGICAL, DIMENSION(:), ALLOCATABLE :: CONCERNED + DOUBLE PRECISION MAX_SENT_MSG +#if defined(NOT_ATM_POOL_SPECIAL) + DOUBLE PRECISION TMP +#endif + IF((FRERE_LOAD(STEP_LOAD(INODE)).EQ.0) + & .AND.(INODE.EQ.KEEP_LOAD(38)))THEN + RETURN + ENDIF +#if defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.LT.0).OR.(INODE.GT.N_LOAD))THEN + MAX_MEM=huge(MAX_MEM) + DO i=0,NPROCS-1 + TMP=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i)) + IF(BDC_SBTR)THEN + TMP=TMP-(SBTR_MEM(i)-SBTR_CUR(i)) + ENDIF + MAX_MEM=min(MAX_MEM,TMP) + ENDDO + RETURN + ENDIF +#endif + ALLOCATE( MEM_ON_PROCS(0:NPROCS-1), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_818' + CALL MUMPS_ABORT() + ENDIF + ALLOCATE( CONCERNED(0:NPROCS-1), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_818' + CALL MUMPS_ABORT() + ENDIF + ALLOCATE( RECV_BUF(0:NPROCS-1), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in DMUMPS_818' + CALL MUMPS_ABORT() + ENDIF + RECV_BUF=dble(0) + MAX_SENT_MSG=dble(0) + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + SON=-i + NFRONT=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253) + NCB=NFRONT-NELIM + IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), + & NPROCS).EQ.2)THEN + NCAND=CAND_LOAD(NPROCS+1, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE))) + ENDIF + DO i=0,NPROCS-1 + IF(i.EQ.MYID)THEN + MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+ + & LU_USAGE(i)+ + & DMUMPS_543(INODE)) + IF(BDC_SBTR)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i)) + ENDIF + CONCERNED(i)=.TRUE. + ELSE + MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i)) + IF(BDC_SBTR)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i)) + ENDIF + IF(BDC_M2_MEM)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-NIV2(i+1) + ENDIF + ENDIF + IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), + & NPROCS).EQ.2)THEN + IF(BDC_MD.AND.(KEEP_LOAD(48).EQ.5))THEN + DO J=1,NCAND + IF(CAND_LOAD(J, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE))) + & .EQ.i)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)- + & ((dble(NFRONT)*dble(NCB))/dble(NCAND)) + CONCERNED(i)=.TRUE. + GOTO 666 + ENDIF + ENDDO + ENDIF + ENDIF + 666 CONTINUE + ENDDO + DO K=1, NE_LOAD(STEP_LOAD(INODE)) + i=1 + DO WHILE (i.LE.POS_ID) + IF(CB_COST_ID(i).EQ.SON)GOTO 295 + i=i+3 + ENDDO + 295 CONTINUE + IF(i.GE.POS_ID)THEN +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(MYID+1).NE.0)THEN + WRITE(*,*)MYID,': ',SON,'has not been found + & in DMUMPS_818' + CALL MUMPS_ABORT() + ENDIF +#endif + GOTO 777 + ENDIF + NSLAVES=CB_COST_ID(i+1) + POS=CB_COST_ID(i+2) + DO i=1,NSLAVES + SLAVE=int(CB_COST_MEM(POS)) + IF(.NOT.CONCERNED(SLAVE))THEN + MEM_ON_PROCS(SLAVE)=MEM_ON_PROCS(SLAVE)+ + & dble(CB_COST_MEM(POS+1)) + ENDIF + DO J=0,NPROCS-1 + IF(CONCERNED(J))THEN + IF(SLAVE.NE.J)THEN + RECV_BUF(J)=max(RECV_BUF(J), + & dble(CB_COST_MEM(POS+1))) + ENDIF + ENDIF + ENDDO + POS=POS+2 + ENDDO + 777 CONTINUE + SON=FRERE_LOAD(STEP_LOAD(SON)) + ENDDO + MAX_MEM=huge(MAX_MEM) + WRITE(*,*)'NPROCS=',NPROCS,MAX_MEM + DO i=0,NPROCS-1 + IF(MAX_MEM.GT.MEM_ON_PROCS(i))THEN + PROC=i + ENDIF + MAX_MEM=min(MEM_ON_PROCS(i),MAX_MEM) + ENDDO + DEALLOCATE(MEM_ON_PROCS) + DEALLOCATE(CONCERNED) + DEALLOCATE(RECV_BUF) + END SUBROUTINE DMUMPS_818 + SUBROUTINE DMUMPS_553(MIN_PROC,POOL, + & LPOOL,INODE) + IMPLICIT NONE + INTEGER INODE,LPOOL,MIN_PROC + INTEGER POOL(LPOOL) + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + INTEGER i,NBTOP,INSUBTREE,NBINSUBTREE,NODE,FATHER,SON,J + INTEGER SBTR_NB_LEAF,POS,K,allocok,L + INTEGER, ALLOCATABLE, DIMENSION (:) :: TMP_SBTR + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + IF((KEEP_LOAD(47).EQ.4).AND. + & ((NBINSUBTREE.NE.0)))THEN + DO J=INDICE_SBTR,NB_SUBTREES + NODE=MY_ROOT_SBTR(J) + FATHER=DAD_LOAD(STEP_LOAD(NODE)) + i=FATHER + 110 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 110 + ENDIF + SON=-i + i=SON + 120 CONTINUE + IF ( i > 0 ) THEN + IF(MUMPS_275(PROCNODE_LOAD(STEP_LOAD(i)),NPROCS).EQ. + & MIN_PROC)THEN + SBTR_NB_LEAF=MY_NB_LEAF(J) + POS=SBTR_FIRST_POS_IN_POOL(J) + IF(POOL(POS+SBTR_NB_LEAF).NE.MY_FIRST_LEAF(J))THEN + WRITE(*,*)MYID,': The first leaf is not ok' + CALL MUMPS_ABORT() + ENDIF + ALLOCATE (TMP_SBTR(SBTR_NB_LEAF), stat=allocok) + IF (allocok > 0 ) THEN + WRITE(*,*)MYID,': Not enough space + & for allocation' + CALL MUMPS_ABORT() + ENDIF + POS=SBTR_FIRST_POS_IN_POOL(J) + DO K=1,SBTR_NB_LEAF + TMP_SBTR(K)=POOL(POS+K-1) + ENDDO + DO K=POS+1,NBINSUBTREE-SBTR_NB_LEAF + POOL(K)=POOL(K+SBTR_NB_LEAF) + ENDDO + POS=1 + DO K=NBINSUBTREE-SBTR_NB_LEAF+1,NBINSUBTREE + POOL(K)=TMP_SBTR(POS) + POS=POS+1 + ENDDO + DO K=INDICE_SBTR,J + SBTR_FIRST_POS_IN_POOL(K)=SBTR_FIRST_POS_IN_POOL(K) + & -SBTR_FIRST_POS_IN_POOL(J) + ENDDO + SBTR_FIRST_POS_IN_POOL(J)=NBINSUBTREE-SBTR_NB_LEAF + POS=MY_FIRST_LEAF(J) + L=MY_NB_LEAF(J) + DO K=INDICE_SBTR,J + MY_FIRST_LEAF(J)=MY_FIRST_LEAF(J+1) + MY_NB_LEAF(J)=MY_NB_LEAF(J+1) + ENDDO + MY_FIRST_LEAF(INDICE_SBTR)=POS + MY_NB_LEAF(INDICE_SBTR)=L + INODE=POOL(NBINSUBTREE) + DEALLOCATE(TMP_SBTR) + RETURN + ENDIF + i = FRERE_LOAD(STEP_LOAD(i)) + GOTO 120 + ENDIF + ENDDO + ENDIF + DO J=NBTOP,1,-1 +#if defined(NOT_ATM_POOL_SPECIAL) + IF ( POOL(LPOOL-2-J) < 0 ) THEN + NODE=-POOL(LPOOL-2-J) + ELSE IF ( POOL(LPOOL-2-J) > N_LOAD ) THEN + NODE = POOL(LPOOL-2-J) - N_LOAD + ELSE + NODE = POOL(LPOOL-2-J) + ENDIF +#else + NODE=POOL(LPOOL-2-J) +#endif + FATHER=DAD_LOAD(STEP_LOAD(NODE)) + i=FATHER + 11 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 11 + ENDIF + SON=-i + i=SON + 12 CONTINUE + IF ( i > 0 ) THEN + IF(MUMPS_275(PROCNODE_LOAD(STEP_LOAD(i)),NPROCS).EQ. + & MIN_PROC)THEN + INODE=NODE + RETURN + ENDIF + i = FRERE_LOAD(STEP_LOAD(i)) + GOTO 12 + ENDIF + ENDDO + END SUBROUTINE DMUMPS_553 + SUBROUTINE DMUMPS_555(POOL, LPOOL,KEEP,KEEP8) + IMPLICIT NONE + INTEGER LPOOL,POOL(LPOOL),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER i,POS + EXTERNAL MUMPS_283 + LOGICAL MUMPS_283 + IF(.NOT.BDC_SBTR) RETURN + POS=0 + DO i=NB_SUBTREES,1,-1 + DO WHILE(MUMPS_283( + & PROCNODE_LOAD(STEP_LOAD(POOL(POS+1))), + & NPROCS)) + POS=POS+1 + ENDDO + SBTR_FIRST_POS_IN_POOL(i)=POS+1 + POS=POS+MY_NB_LEAF(i) + ENDDO + END SUBROUTINE DMUMPS_555 + END MODULE DMUMPS_LOAD diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_ooc.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_ooc.F new file mode 100644 index 000000000..436f5b89c --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_ooc.F @@ -0,0 +1,3501 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE DMUMPS_OOC + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NOT_IN_MEM,BEING_READ,NOT_USED,PERMUTED,USED, + & USED_NOT_PERMUTED,ALREADY_USED + PARAMETER (NOT_IN_MEM=0,BEING_READ=-1,NOT_USED=-2, + & PERMUTED=-3,USED=-4,USED_NOT_PERMUTED=-5,ALREADY_USED=-6) + INTEGER OOC_NODE_NOT_IN_MEM,OOC_NODE_PERMUTED, + & OOC_NODE_NOT_PERMUTED + PARAMETER (OOC_NODE_NOT_IN_MEM=-20, + & OOC_NODE_PERMUTED=-21,OOC_NODE_NOT_PERMUTED=-22) + INTEGER(8), DIMENSION(:,:),POINTER :: SIZE_OF_BLOCK + INTEGER, DIMENSION(:),POINTER :: TOTAL_NB_OOC_NODES + INTEGER :: OOC_SOLVE_TYPE_FCT + INTEGER, DIMENSION(:),ALLOCATABLE :: IO_REQ + INTEGER(8), DIMENSION(:), ALLOCATABLE:: LRLUS_SOLVE + INTEGER(8), DIMENSION(:), ALLOCATABLE:: SIZE_SOLVE_Z, + & LRLU_SOLVE_T, POSFAC_SOLVE, IDEB_SOLVE_Z, LRLU_SOLVE_B + INTEGER, DIMENSION(:),ALLOCATABLE :: PDEB_SOLVE_Z + INTEGER (8),SAVE :: FACT_AREA_SIZE, + & SIZE_ZONE_SOLVE,SIZE_SOLVE_EMM,TMP_SIZE_FACT, + & MAX_SIZE_FACTOR_OOC + INTEGER(8), SAVE :: MIN_SIZE_READ + INTEGER, SAVE :: TMP_NB_NODES, MAX_NB_NODES_FOR_ZONE,MAX_NB_REQ, + & CURRENT_SOLVE_READ_ZONE, + & CUR_POS_SEQUENCE,NB_Z,SOLVE_STEP, + & NB_ZONE_REQ,MTYPE_OOC,NB_ACT +#if defined (NEW_PREF_SCHEME) + INTEGER,SAVE :: MAX_PREF_SIZE +#endif + & ,NB_CALLED,REQ_ACT,NB_CALL + INTEGER(8), SAVE :: OOC_VADDR_PTR + INTEGER(8), SAVE :: SIZE_ZONE_REQ + DOUBLE PRECISION,SAVE :: MAX_OOC_FILE_SIZE + INTEGER(8), DIMENSION(:), ALLOCATABLE :: SIZE_OF_READ, READ_DEST + INTEGER,DIMENSION(:),ALLOCATABLE :: FIRST_POS_IN_READ, + & READ_MNG,REQ_TO_ZONE,POS_HOLE_T, + & POS_HOLE_B,REQ_ID,OOC_STATE_NODE + INTEGER DMUMPS_ELEMENTARY_DATA_SIZE,N_OOC + INTEGER, DIMENSION(:), ALLOCATABLE :: POS_IN_MEM, INODE_TO_POS + INTEGER, DIMENSION(:), ALLOCATABLE :: CURRENT_POS_T,CURRENT_POS_B + LOGICAL IS_ROOT_SPECIAL + INTEGER SPECIAL_ROOT_NODE + PUBLIC :: DMUMPS_575,DMUMPS_576, + & DMUMPS_577, + & DMUMPS_578, + & DMUMPS_579, + & DMUMPS_582, + & DMUMPS_583,DMUMPS_584, + & DMUMPS_585,DMUMPS_586 + INTEGER, PARAMETER, PUBLIC :: TYPEF_BOTH_LU = -99976 + PUBLIC DMUMPS_688, + & DMUMPS_690 + PRIVATE DMUMPS_695, + & DMUMPS_697 + CONTAINS + SUBROUTINE DMUMPS_711( STRAT_IO_ARG, + & STRAT_IO_ASYNC_ARG, WITH_BUF_ARG, LOW_LEVEL_STRAT_IO_ARG ) + IMPLICIT NONE + INTEGER, intent(out) :: LOW_LEVEL_STRAT_IO_ARG + LOGICAL, intent(out) :: STRAT_IO_ASYNC_ARG, WITH_BUF_ARG + INTEGER, intent(in) :: STRAT_IO_ARG + INTEGER TMP + CALL MUMPS_OOC_IS_ASYNC_AVAIL(TMP) + STRAT_IO_ASYNC_ARG=.FALSE. + WITH_BUF_ARG=.FALSE. + IF(TMP.EQ.1)THEN + IF((STRAT_IO_ARG.EQ.1).OR.(STRAT_IO_ARG.EQ.2))THEN + STRAT_IO_ASYNC=.TRUE. + WITH_BUF=.FALSE. + ELSEIF((STRAT_IO_ARG.EQ.4).OR.(STRAT_IO_ARG.EQ.5))THEN + STRAT_IO_ASYNC_ARG=.TRUE. + WITH_BUF_ARG=.TRUE. + ELSEIF(STRAT_IO_ARG.EQ.3)THEN + STRAT_IO_ASYNC_ARG=.FALSE. + WITH_BUF_ARG=.TRUE. + ENDIF + LOW_LEVEL_STRAT_IO_ARG=mod(STRAT_IO_ARG,3) + ELSE + LOW_LEVEL_STRAT_IO_ARG=0 + IF(STRAT_IO_ARG.GE.3)THEN + WITH_BUF_ARG=.TRUE. + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_711 + FUNCTION DMUMPS_579(INODE,ZONE) + IMPLICIT NONE + INTEGER INODE,ZONE + LOGICAL DMUMPS_579 + DMUMPS_579=(LRLUS_SOLVE(ZONE).GE. + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) + RETURN + END FUNCTION DMUMPS_579 + SUBROUTINE DMUMPS_590(LA) + IMPLICIT NONE + INTEGER(8) :: LA + FACT_AREA_SIZE=LA + END SUBROUTINE DMUMPS_590 + SUBROUTINE DMUMPS_575(id, MAXS) + USE DMUMPS_STRUC_DEF + USE DMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER TMPDIR_MAX_LENGTH, PREFIX_MAX_LENGTH + PARAMETER (TMPDIR_MAX_LENGTH=255, PREFIX_MAX_LENGTH=63) + INTEGER(8), intent(in) :: MAXS + TYPE(DMUMPS_STRUC), TARGET :: id + INTEGER IERR + INTEGER allocok + INTEGER ASYNC + CHARACTER*1 TMP_DIR(TMPDIR_MAX_LENGTH), + & TMP_PREFIX(PREFIX_MAX_LENGTH) + INTEGER DIM_DIR,DIM_PREFIX + INTEGER, DIMENSION(:), ALLOCATABLE :: FILE_FLAG_TAB + INTEGER TMP + INTEGER K211_LOC + ICNTL1=id%ICNTL(1) + MAX_SIZE_FACTOR_OOC=0_8 + N_OOC=id%N + ASYNC=0 + SOLVE=.FALSE. + IERR=0 + IF(allocated(IO_REQ))THEN + DEALLOCATE(IO_REQ) + ENDIF + IF(associated(KEEP_OOC))THEN + NULLIFY(KEEP_OOC) + ENDIF + IF(associated(STEP_OOC))THEN + NULLIFY(STEP_OOC) + ENDIF + IF(associated(PROCNODE_OOC))THEN + NULLIFY(PROCNODE_OOC) + ENDIF + IF(associated(OOC_INODE_SEQUENCE))THEN + NULLIFY(OOC_INODE_SEQUENCE) + ENDIF + IF(associated(TOTAL_NB_OOC_NODES))THEN + NULLIFY(TOTAL_NB_OOC_NODES) + ENDIF + IF(associated(SIZE_OF_BLOCK))THEN + NULLIFY(SIZE_OF_BLOCK) + ENDIF + IF(associated(OOC_VADDR))THEN + NULLIFY(OOC_VADDR) + ENDIF + IF(allocated(I_CUR_HBUF_NEXTPOS))THEN + DEALLOCATE(I_CUR_HBUF_NEXTPOS) + ENDIF + CALL DMUMPS_588(id,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 > 0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1) = IERR + id%INFO(2) = 0 + RETURN + ENDIF + CALL MUMPS_796(TYPEF_L, TYPEF_U, TYPEF_CB, + & id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID ) + IF (id%KEEP(201).EQ.2) THEN + OOC_FCT_TYPE=1 + ENDIF + STEP_OOC=>id%STEP + PROCNODE_OOC=>id%PROCNODE_STEPS + MYID_OOC=id%MYID + SLAVEF_OOC=id%NSLAVES + KEEP_OOC => id%KEEP + SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK + OOC_VADDR=>id%OOC_VADDR + IF(id%KEEP(107).GT.0)THEN + SIZE_SOLVE_EMM=max(id%KEEP8(19),int(dble(MAXS)* + & 0.9d0*0.2d0,8)) + SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM, + & int((dble(MAXS)*0.9d0- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)) + IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN + SIZE_SOLVE_EMM=id%KEEP8(19) + SIZE_ZONE_SOLVE=int((dble(MAXS)*0.9d0- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8) + ENDIF + ELSE + SIZE_ZONE_SOLVE=int(dble(MAXS)*0.9d0,8) + SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE + ENDIF + DMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35) + SIZE_OF_BLOCK=0_8 + ALLOCATE(id%OOC_NB_FILES(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + id%OOC_NB_FILES=0 + OOC_VADDR_PTR=0_8 + CALL DMUMPS_711( id%KEEP(99), STRAT_IO_ASYNC, + & WITH_BUF, LOW_LEVEL_STRAT_IO ) + TMP_SIZE_FACT=0_8 + TMP_NB_NODES=0 + MAX_NB_NODES_FOR_ZONE=0 + OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE + ALLOCATE(I_CUR_HBUF_NEXTPOS(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + I_CUR_HBUF_NEXTPOS = 1 + IF(WITH_BUF)THEN + CALL DMUMPS_669(id%INFO(1),id%INFO(2),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + IF(STRAT_IO_ASYNC)THEN + ASYNC=1 + ENDIF + DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN + CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC) + DIM_DIR=len(trim(id%OOC_TMPDIR)) + DIM_PREFIX=len(trim(id%OOC_PREFIX)) + CALL DMUMPS_589(TMP_DIR(1), + & id%OOC_TMPDIR, TMPDIR_MAX_LENGTH, DIM_DIR ) + CALL DMUMPS_589(TMP_PREFIX(1), + & id%OOC_PREFIX, PREFIX_MAX_LENGTH, DIM_PREFIX) + CALL MUMPS_LOW_LEVEL_INIT_PREFIX(DIM_PREFIX, TMP_PREFIX) + CALL MUMPS_LOW_LEVEL_INIT_TMPDIR(DIM_DIR, TMP_DIR) + ALLOCATE(FILE_FLAG_TAB(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1 .GT. 0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + FILE_FLAG_TAB(1:OOC_NB_FILE_TYPE)=0 + IERR=0 + TMP=int(id%KEEP8(11)/1000000_8,kind=4)+1 + IF((id%KEEP(201).EQ.1).AND.(id%KEEP(50).EQ.0) + & ) THEN + TMP=max(1,TMP/2) + ENDIF + CALL MUMPS_LOW_LEVEL_INIT_OOC_C(MYID_OOC,TMP, + & id%KEEP(35),LOW_LEVEL_STRAT_IO,K211_LOC,OOC_NB_FILE_TYPE, + & FILE_FLAG_TAB,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0 ) THEN + WRITE(ICNTL1,*)MYID_OOC,': PB in MUMPS_LOW_LEVEL_INIT_OOC_C' + WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + ENDIF + id%INFO(1) = IERR + id%INFO(2) = 0 + RETURN + ENDIF + CALL MUMPS_GET_MAX_FILE_SIZE_C(MAX_OOC_FILE_SIZE) + DEALLOCATE(FILE_FLAG_TAB) + RETURN + END SUBROUTINE DMUMPS_575 + SUBROUTINE DMUMPS_576(INODE,PTRFAC,KEEP,KEEP8, + & A,LA,SIZE,IERR) + USE DMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER(8) :: LA + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)), SIZE + DOUBLE PRECISION A(LA) + INTEGER IERR,NODE,ASYNC,REQUEST + LOGICAL IO_C + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER TYPE + INTEGER SIZE_INT1,SIZE_INT2 + TYPE=FCT + IF(STRAT_IO_ASYNC)THEN + ASYNC=1 + ELSE + ASYNC=0 + ENDIF + IERR=0 + IO_C=.TRUE. + SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)=SIZE + MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,SIZE) + OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)=OOC_VADDR_PTR + OOC_VADDR_PTR=OOC_VADDR_PTR+SIZE + TMP_SIZE_FACT=TMP_SIZE_FACT+SIZE + TMP_NB_NODES=TMP_NB_NODES+1 + IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN + MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE,TMP_NB_NODES) + TMP_SIZE_FACT=0_8 + TMP_NB_NODES=0 + ENDIF + IF (.NOT. WITH_BUF) THEN + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, + & A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN + WRITE(*,*)MYID_OOC,': Internal error (37) in OOC ' + CALL MUMPS_ABORT() + ENDIF + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), + & OOC_FCT_TYPE)=INODE + I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)= + & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1 + ELSE + IF(SIZE.LE.HBUF_SIZE)THEN + CALL DMUMPS_678 + & (A(PTRFAC(STEP_OOC(INODE))),SIZE,IERR) + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), + & OOC_FCT_TYPE) = INODE + I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) = + & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) + 1 +#if ! defined (OOC_DEBUG) + PTRFAC(STEP_OOC(INODE))=-777777_8 +#endif + RETURN + ELSE + CALL DMUMPS_707(OOC_FCT_TYPE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL DMUMPS_707(OOC_FCT_TYPE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, + & A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(*,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN + WRITE(*,*)MYID_OOC,': Internal error (38) in OOC ' + CALL MUMPS_ABORT() + ENDIF + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), + & OOC_FCT_TYPE)=INODE + I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)= + & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1 + CALL DMUMPS_689(OOC_FCT_TYPE) + ENDIF + END IF + NODE=-9999 +#if ! defined (OOC_DEBUG) + PTRFAC(STEP_OOC(INODE))=-777777_8 +#endif + IF(STRAT_IO_ASYNC)THEN + IERR=0 + CALL MUMPS_WAIT_REQUEST(REQUEST,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_576 + SUBROUTINE DMUMPS_577(DEST,INODE,IERR + & ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR,INODE + DOUBLE PRECISION DEST + INTEGER ASYNC + LOGICAL IO_C +#if defined(OLD_READ) + INTEGER REQUEST +#endif + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER TYPE + INTEGER SIZE_INT1,SIZE_INT2 + TYPE=OOC_SOLVE_TYPE_FCT + IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + & .EQ.0_8)THEN + GOTO 555 + ENDIF + IF(STRAT_IO_ASYNC)THEN + ASYNC=1 + ELSE + ASYNC=0 + ENDIF + IERR=0 + IO_C=.TRUE. +#if ! defined(OLD_READ) + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_LOW_LEVEL_DIRECT_READ(DEST, + & SIZE_INT1,SIZE_INT2, + & TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) THEN + WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + WRITE(ICNTL1,*)MYID_OOC, + & ': Problem in MUMPS_LOW_LEVEL_DIRECT_READ' + ENDIF + RETURN + ENDIF +#else + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO, + & DEST,SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0 ) THEN + WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + WRITE(ICNTL1,*)MYID_OOC, + & ': Problem in MUMPS_LOW_LEVEL_READ_OOC' + ENDIF + RETURN + ENDIF + IF(STRAT_IO_ASYNC)THEN + IERR=0 + CALL MUMPS_WAIT_REQUEST(REQUEST,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0 ) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + ENDIF +#endif + 555 CONTINUE + IF(.NOT.DMUMPS_727())THEN + IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ. + & INODE)THEN + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ELSEIF(SOLVE_STEP.EQ.1)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + CALL DMUMPS_728() + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_577 + SUBROUTINE DMUMPS_591(IERR) + USE DMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, intent(out):: IERR + IERR=0 + IF (WITH_BUF) THEN + CALL DMUMPS_675(IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + END IF + RETURN + END SUBROUTINE DMUMPS_591 + SUBROUTINE DMUMPS_592(id,IERR) + USE DMUMPS_OOC_BUFFER + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(DMUMPS_STRUC), TARGET :: id + INTEGER, intent(out) :: IERR + INTEGER I,SOLVE_OR_FACTO + IERR=0 + IF(WITH_BUF)THEN + CALL DMUMPS_659() + ENDIF + IF(associated(KEEP_OOC))THEN + NULLIFY(KEEP_OOC) + ENDIF + IF(associated(STEP_OOC))THEN + NULLIFY(STEP_OOC) + ENDIF + IF(associated(PROCNODE_OOC))THEN + NULLIFY(PROCNODE_OOC) + ENDIF + IF(associated(OOC_INODE_SEQUENCE))THEN + NULLIFY(OOC_INODE_SEQUENCE) + ENDIF + IF(associated(TOTAL_NB_OOC_NODES))THEN + NULLIFY(TOTAL_NB_OOC_NODES) + ENDIF + IF(associated(SIZE_OF_BLOCK))THEN + NULLIFY(SIZE_OF_BLOCK) + ENDIF + IF(associated(OOC_VADDR))THEN + NULLIFY(OOC_VADDR) + ENDIF + CALL MUMPS_OOC_END_WRITE_C(IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + GOTO 500 + ENDIF + id%OOC_MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE, + & TMP_NB_NODES) + IF(allocated(I_CUR_HBUF_NEXTPOS))THEN + DO I=1,OOC_NB_FILE_TYPE + id%OOC_TOTAL_NB_NODES(I)=I_CUR_HBUF_NEXTPOS(I)-1 + ENDDO + DEALLOCATE(I_CUR_HBUF_NEXTPOS) + ENDIF + id%KEEP8(20)=MAX_SIZE_FACTOR_OOC + CALL DMUMPS_613(id,IERR) + IF(IERR.LT.0)THEN + GOTO 500 + ENDIF + 500 CONTINUE + SOLVE_OR_FACTO=0 + CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + RETURN + END SUBROUTINE DMUMPS_592 + SUBROUTINE DMUMPS_588(id,IERR) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + EXTERNAL MUMPS_OOC_REMOVE_FILE_C + TYPE(DMUMPS_STRUC), TARGET :: id + INTEGER IERR + INTEGER I,J,I1,K + CHARACTER*1 TMP_NAME(350) + IERR=0 + K=1 + IF(associated(id%OOC_FILE_NAMES).AND. + & associated(id%OOC_FILE_NAME_LENGTH))THEN + DO I1=1,OOC_NB_FILE_TYPE + DO I=1,id%OOC_NB_FILES(I1) + DO J=1,id%OOC_FILE_NAME_LENGTH(K) + TMP_NAME(J)=id%OOC_FILE_NAMES(K,J) + ENDDO + CALL MUMPS_OOC_REMOVE_FILE_C(IERR, TMP_NAME(1)) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0)THEN + WRITE(ICNTL1,*)MYID_OOC,': ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + ENDIF + K=K+1 + ENDDO + ENDDO + ENDIF + IF(associated(id%OOC_FILE_NAMES))THEN + DEALLOCATE(id%OOC_FILE_NAMES) + NULLIFY(id%OOC_FILE_NAMES) + ENDIF + IF(associated(id%OOC_FILE_NAME_LENGTH))THEN + DEALLOCATE(id%OOC_FILE_NAME_LENGTH) + NULLIFY(id%OOC_FILE_NAME_LENGTH) + ENDIF + IF(associated(id%OOC_NB_FILES))THEN + DEALLOCATE(id%OOC_NB_FILES) + NULLIFY(id%OOC_NB_FILES) + ENDIF + RETURN + END SUBROUTINE DMUMPS_588 + SUBROUTINE DMUMPS_587(id,IERR) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(DMUMPS_STRUC), TARGET :: id + INTEGER IERR + IERR=0 + CALL DMUMPS_588(id,IERR) + IF(associated(id%OOC_TOTAL_NB_NODES))THEN + DEALLOCATE(id%OOC_TOTAL_NB_NODES) + NULLIFY(id%OOC_TOTAL_NB_NODES) + ENDIF + IF(associated(id%OOC_INODE_SEQUENCE))THEN + DEALLOCATE(id%OOC_INODE_SEQUENCE) + NULLIFY(id%OOC_INODE_SEQUENCE) + ENDIF + IF(associated(id%OOC_SIZE_OF_BLOCK))THEN + DEALLOCATE(id%OOC_SIZE_OF_BLOCK) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + ENDIF + IF(associated(id%OOC_VADDR))THEN + DEALLOCATE(id%OOC_VADDR) + NULLIFY(id%OOC_VADDR) + ENDIF + RETURN + END SUBROUTINE DMUMPS_587 + SUBROUTINE DMUMPS_586(id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(DMUMPS_STRUC), TARGET :: id + INTEGER TMP,I,J + INTEGER(8) :: TMP_SIZE8 + INTEGER allocok,IERR + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + INTEGER MASTER_ROOT + IERR=0 + ICNTL1=id%ICNTL(1) + SOLVE=.TRUE. + N_OOC=id%N + IF(allocated(LRLUS_SOLVE))THEN + DEALLOCATE(LRLUS_SOLVE) + ENDIF + IF(allocated(LRLU_SOLVE_T))THEN + DEALLOCATE(LRLU_SOLVE_T) + ENDIF + IF(allocated(LRLU_SOLVE_B))THEN + DEALLOCATE(LRLU_SOLVE_B) + ENDIF + IF(allocated(POSFAC_SOLVE))THEN + DEALLOCATE(POSFAC_SOLVE) + ENDIF + IF(allocated(IDEB_SOLVE_Z))THEN + DEALLOCATE(IDEB_SOLVE_Z) + ENDIF + IF(allocated(PDEB_SOLVE_Z))THEN + DEALLOCATE(PDEB_SOLVE_Z) + ENDIF + IF(allocated(SIZE_SOLVE_Z))THEN + DEALLOCATE(SIZE_SOLVE_Z) + ENDIF + IF(allocated(CURRENT_POS_T))THEN + DEALLOCATE(CURRENT_POS_T) + ENDIF + IF(allocated(CURRENT_POS_B))THEN + DEALLOCATE(CURRENT_POS_B) + ENDIF + IF(allocated(POS_HOLE_T))THEN + DEALLOCATE(POS_HOLE_T) + ENDIF + IF(allocated(POS_HOLE_B))THEN + DEALLOCATE(POS_HOLE_B) + ENDIF + IF(allocated(OOC_STATE_NODE))THEN + DEALLOCATE(OOC_STATE_NODE) + ENDIF + IF(allocated(POS_IN_MEM))THEN + DEALLOCATE(POS_IN_MEM) + ENDIF + IF(allocated(INODE_TO_POS))THEN + DEALLOCATE(INODE_TO_POS) + ENDIF + IF(allocated(SIZE_OF_READ))THEN + DEALLOCATE(SIZE_OF_READ) + ENDIF + IF(allocated(FIRST_POS_IN_READ))THEN + DEALLOCATE(FIRST_POS_IN_READ) + ENDIF + IF(allocated(READ_DEST))THEN + DEALLOCATE(READ_DEST) + ENDIF + IF(allocated(READ_MNG))THEN + DEALLOCATE(READ_MNG) + ENDIF + IF(allocated(REQ_TO_ZONE))THEN + DEALLOCATE(REQ_TO_ZONE) + ENDIF + IF(allocated(REQ_ID))THEN + DEALLOCATE(REQ_ID) + ENDIF + IF(allocated(IO_REQ))THEN + DEALLOCATE(IO_REQ) + ENDIF + IF(associated(KEEP_OOC))THEN + NULLIFY(KEEP_OOC) + ENDIF + IF(associated(STEP_OOC))THEN + NULLIFY(STEP_OOC) + ENDIF + IF(associated(PROCNODE_OOC))THEN + NULLIFY(PROCNODE_OOC) + ENDIF + IF(associated(TOTAL_NB_OOC_NODES))THEN + NULLIFY(TOTAL_NB_OOC_NODES) + ENDIF + IF(associated(SIZE_OF_BLOCK))THEN + NULLIFY(SIZE_OF_BLOCK) + ENDIF + IF(associated(OOC_INODE_SEQUENCE))THEN + NULLIFY(OOC_VADDR) + ENDIF + CALL MUMPS_796(TYPEF_L, TYPEF_U, TYPEF_CB, + & id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID ) + DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN + CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC) + CALL DMUMPS_614(id) + IF(id%INFO(1).LT.0)THEN + RETURN + ENDIF + STEP_OOC=>id%STEP + PROCNODE_OOC=>id%PROCNODE_STEPS + SLAVEF_OOC=id%NSLAVES + MYID_OOC=id%MYID + KEEP_OOC => id%KEEP + SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK + OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE + OOC_VADDR=>id%OOC_VADDR + ALLOCATE(IO_REQ(id%KEEP(28)), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = id%KEEP(28) + RETURN + ENDIF + DMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35) + MAX_NB_NODES_FOR_ZONE=id%OOC_MAX_NB_NODES_FOR_ZONE + TOTAL_NB_OOC_NODES=>id%OOC_TOTAL_NB_NODES + CALL DMUMPS_711( id%KEEP(204), STRAT_IO_ASYNC, + & WITH_BUF, LOW_LEVEL_STRAT_IO) + IF(id%KEEP(107).GT.0)THEN + SIZE_SOLVE_EMM=max(id%KEEP8(20), + & FACT_AREA_SIZE / 5_8) + SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM, + & int((dble(FACT_AREA_SIZE)- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)) + SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8) + IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN + SIZE_SOLVE_EMM=id%KEEP8(20) + SIZE_ZONE_SOLVE=int((dble(FACT_AREA_SIZE)- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8) + SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8) + ENDIF + ELSE + SIZE_ZONE_SOLVE=FACT_AREA_SIZE + SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE + ENDIF + IF(SIZE_SOLVE_EMM.LT.id%KEEP8(20))THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': More space needed for + & solution step in DMUMPS_586' + id%INFO(1) = -11 + CALL MUMPS_731(id%KEEP8(20), id%INFO(2)) + ENDIF + TMP=MAX_NB_NODES_FOR_ZONE + CALL MPI_ALLREDUCE(TMP,MAX_NB_NODES_FOR_ZONE,1, + & MPI_INTEGER,MPI_MAX,id%COMM_NODES, IERR) + NB_Z=KEEP_OOC(107)+1 + ALLOCATE(POS_IN_MEM(MAX_NB_NODES_FOR_ZONE*NB_Z), + & INODE_TO_POS(KEEP_OOC(28)), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = id%KEEP(28)+(MAX_NB_NODES_FOR_ZONE*NB_Z) + RETURN + ENDIF + ALLOCATE(OOC_STATE_NODE(KEEP_OOC(28)),stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = id%KEEP(28) + RETURN + ENDIF + OOC_STATE_NODE(1:KEEP_OOC(28))=0 + INODE_TO_POS=0 + POS_IN_MEM=0 + ALLOCATE(LRLUS_SOLVE(NB_Z), LRLU_SOLVE_T(NB_Z),LRLU_SOLVE_B(NB_Z), + & POSFAC_SOLVE(NB_Z),IDEB_SOLVE_Z(NB_Z), + & PDEB_SOLVE_Z(NB_Z),SIZE_SOLVE_Z(NB_Z), + & CURRENT_POS_T(NB_Z),CURRENT_POS_B(NB_Z), + & POS_HOLE_T(NB_Z),POS_HOLE_B(NB_Z), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = 9*(NB_Z+1) + RETURN + ENDIF + IERR=0 + CALL MUMPS_GET_MAX_NB_REQ_C(MAX_NB_REQ,IERR) + ALLOCATE(SIZE_OF_READ(MAX_NB_REQ),FIRST_POS_IN_READ(MAX_NB_REQ), + & READ_DEST(MAX_NB_REQ),READ_MNG(MAX_NB_REQ), + & REQ_TO_ZONE(MAX_NB_REQ),REQ_ID(MAX_NB_REQ),stat=allocok) + SIZE_OF_READ=-9999_8 + FIRST_POS_IN_READ=-9999 + READ_DEST=-9999_8 + READ_MNG=-9999 + REQ_TO_ZONE=-9999 + REQ_ID=-9999 + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = 6*(NB_Z+1) + RETURN + ENDIF + MIN_SIZE_READ=min(max((1024_8*1024_8)/int(id%KEEP(35),8), + & SIZE_ZONE_SOLVE/3_8), + & SIZE_ZONE_SOLVE) + TMP_SIZE8=1_8 + J=1 + DO I=1,NB_Z-1 + IDEB_SOLVE_Z(I)=TMP_SIZE8 + POSFAC_SOLVE(I)=TMP_SIZE8 + LRLUS_SOLVE(I)=SIZE_ZONE_SOLVE + LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE + LRLU_SOLVE_B(I)=0_8 + SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE + CURRENT_POS_T(I)=J + CURRENT_POS_B(I)=J + PDEB_SOLVE_Z(I)=J + POS_HOLE_T(I)=J + POS_HOLE_B(I)=J + J=J+MAX_NB_NODES_FOR_ZONE + TMP_SIZE8=TMP_SIZE8+SIZE_ZONE_SOLVE + ENDDO + IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8 + PDEB_SOLVE_Z(NB_Z)=J + POSFAC_SOLVE(NB_Z)=TMP_SIZE8 + LRLUS_SOLVE(NB_Z)=SIZE_SOLVE_EMM + LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM + LRLU_SOLVE_B(NB_Z)=0_8 + SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM + CURRENT_POS_T(NB_Z)=J + CURRENT_POS_B(NB_Z)=J + POS_HOLE_T(NB_Z)=J + POS_HOLE_B(NB_Z)=J + IO_REQ=-77777 + REQ_ACT=0 + OOC_STATE_NODE(1:KEEP_OOC(28))=NOT_IN_MEM + IF(KEEP_OOC(38).NE.0)THEN + MASTER_ROOT=MUMPS_275( + & PROCNODE_OOC(STEP_OOC( KEEP_OOC(38))), + & SLAVEF_OOC ) + SPECIAL_ROOT_NODE=KEEP_OOC(38) + ELSEIF(KEEP_OOC(20).NE.0)THEN + MASTER_ROOT=MUMPS_275( + & PROCNODE_OOC(STEP_OOC( KEEP_OOC(20))), + & SLAVEF_OOC ) + SPECIAL_ROOT_NODE=KEEP_OOC(20) + ELSE + MASTER_ROOT=-111111 + SPECIAL_ROOT_NODE=-2222222 + ENDIF + IF ( KEEP_OOC(60).EQ.0 .AND. + & ( + & (KEEP_OOC(38).NE.0 .AND. id%root%yes) + & .OR. + & (KEEP_OOC(20).NE.0 .AND. MYID_OOC.EQ.MASTER_ROOT)) + & ) + & THEN + IS_ROOT_SPECIAL = .TRUE. + ELSE + IS_ROOT_SPECIAL = .FALSE. + ENDIF + NB_ZONE_REQ=0 + SIZE_ZONE_REQ=0_8 + CURRENT_SOLVE_READ_ZONE=0 + NB_CALLED=0 + NB_CALL=0 + SOLVE_STEP=-9999 +#if defined (NEW_PREF_SCHEME) + MAX_PREF_SIZE=(1024*1024*2)/8 +#endif + RETURN + END SUBROUTINE DMUMPS_586 + SUBROUTINE DMUMPS_585(A,LA,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER NSTEPS,IERR + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER I + IERR=0 + IF(NB_Z.GT.1)THEN + IF(STRAT_IO_ASYNC)THEN + DO I=1,NB_Z-1 + CALL DMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDDO + ELSE + CALL DMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_585 + SUBROUTINE DMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER NSTEPS,IERR + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER ZONE + CALL DMUMPS_603(ZONE) + IERR=0 + CALL DMUMPS_611(ZONE,A,LA,PTRFAC,NSTEPS,IERR) + RETURN + END SUBROUTINE DMUMPS_594 + SUBROUTINE DMUMPS_595(DEST,INDICE,SIZE, + & ZONE,PTRFAC,NSTEPS,POS_SEQ,NB_NODES,FLAG,IERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER ZONE,NSTEPS,FLAG,POS_SEQ,NB_NODES + DOUBLE PRECISION DEST + INTEGER (8) :: INDICE, SIZE, PTRFAC(NSTEPS) + INTEGER REQUEST,INODE,IERR + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER TYPE + INTEGER SIZE_INT1,SIZE_INT2 + TYPE=OOC_SOLVE_TYPE_FCT + IERR=0 + INODE=OOC_INODE_SEQUENCE(POS_SEQ,OOC_FCT_TYPE) + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO, + & DEST,SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + IF(STRAT_IO_ASYNC)THEN + CALL DMUMPS_597(INODE,SIZE,INDICE,ZONE, + & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ELSE + CALL DMUMPS_597(INODE,SIZE,INDICE,ZONE, + & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL DMUMPS_596(IO_REQ(STEP_OOC(INODE)), + & PTRFAC,NSTEPS) + REQ_ACT=REQ_ACT-1 + ENDIF + END SUBROUTINE DMUMPS_595 + SUBROUTINE DMUMPS_596(REQUEST,PTRFAC, + & NSTEPS) + IMPLICIT NONE + INTEGER NSTEPS,REQUEST + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER (8) :: LAST, POS_IN_S, J + INTEGER ZONE + INTEGER POS_REQ,I,TMP_NODE,POS_IN_MANAGE + INTEGER (8) SIZE + LOGICAL DONT_USE + EXTERNAL MUMPS_330,MUMPS_275 + INTEGER MUMPS_330,MUMPS_275 + POS_REQ=mod(REQUEST,MAX_NB_REQ)+1 + SIZE=SIZE_OF_READ(POS_REQ) + I=FIRST_POS_IN_READ(POS_REQ) + POS_IN_S=READ_DEST(POS_REQ) + POS_IN_MANAGE=READ_MNG(POS_REQ) + ZONE=REQ_TO_ZONE(POS_REQ) + DONT_USE=.FALSE. + J=0_8 + DO WHILE((J.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))) + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + I=I+1 + CYCLE + ENDIF + IF((INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0).AND. + & (INODE_TO_POS(STEP_OOC(TMP_NODE)).LT. + & -((N_OOC+1)*NB_Z)))THEN + DONT_USE= + & (((MTYPE_OOC.EQ.1).AND.(KEEP_OOC(50).EQ.0).AND. + & (SOLVE_STEP.EQ.1).AND. + & ((MUMPS_330(PROCNODE_OOC(STEP_OOC(TMP_NODE)), + & SLAVEF_OOC).EQ.2).AND.(MUMPS_275( + & PROCNODE_OOC(STEP_OOC(TMP_NODE)),SLAVEF_OOC).NE. + & MYID_OOC))) + & .OR. + & ((MTYPE_OOC.NE.1).AND.(KEEP_OOC(50).EQ.0).AND. + & (SOLVE_STEP.EQ.0).AND. + & ((MUMPS_330(PROCNODE_OOC(STEP_OOC(TMP_NODE)), + & SLAVEF_OOC).EQ.2).AND.(MUMPS_275( + & PROCNODE_OOC(STEP_OOC(TMP_NODE)),SLAVEF_OOC).NE. + & MYID_OOC)))).OR. + & (OOC_STATE_NODE(STEP_OOC(TMP_NODE)).EQ.ALREADY_USED) + IF(DONT_USE)THEN + PTRFAC(STEP_OOC(TMP_NODE))=-POS_IN_S + ELSE + PTRFAC(STEP_OOC(TMP_NODE))=POS_IN_S + ENDIF + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).LT. + & IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Inernal error (42) in OOC ', + & PTRFAC(STEP_OOC(TMP_NODE)),IDEB_SOLVE_Z(ZONE) + CALL MUMPS_ABORT() + ENDIF + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).GT. + & (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN + WRITE(*,*)MYID_OOC,': Inernal error (43) in OOC ' + CALL MUMPS_ABORT() + ENDIF + IF(DONT_USE)THEN + POS_IN_MEM(POS_IN_MANAGE)=-TMP_NODE + INODE_TO_POS(STEP_OOC(TMP_NODE))=-POS_IN_MANAGE + IF(OOC_STATE_NODE(STEP_OOC(TMP_NODE)).NE. + & ALREADY_USED)THEN + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=USED_NOT_PERMUTED + ENDIF + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+LAST + ELSE + POS_IN_MEM(POS_IN_MANAGE)=TMP_NODE + INODE_TO_POS(STEP_OOC(TMP_NODE))=POS_IN_MANAGE + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + ENDIF + IO_REQ(STEP_OOC(TMP_NODE))=-7777 + ELSE + POS_IN_MEM(POS_IN_MANAGE)=0 + ENDIF + POS_IN_S=POS_IN_S+LAST + POS_IN_MANAGE=POS_IN_MANAGE+1 + J=J+LAST + I=I+1 + ENDDO + SIZE_OF_READ(POS_REQ)=-9999_8 + FIRST_POS_IN_READ(POS_REQ)=-9999 + READ_DEST(POS_REQ)=-9999_8 + READ_MNG(POS_REQ)=-9999 + REQ_TO_ZONE(POS_REQ)=-9999 + REQ_ID(POS_REQ)=-9999 + RETURN + END SUBROUTINE DMUMPS_596 + SUBROUTINE DMUMPS_597(INODE,SIZE,DEST,ZONE, + & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER INODE,ZONE,REQUEST,FLAG,POS_SEQ,NB_NODES,NSTEPS + INTEGER(8) :: SIZE + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER(8) :: DEST, LOCAL_DEST, J8 + INTEGER I,TMP_NODE,LOC_I,POS_REQ,NB + INTEGER(8)::LAST + INTEGER, intent(out) :: IERR + IERR=0 + IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + RETURN + ENDIF + NB=0 + LOCAL_DEST=DEST + I=POS_SEQ + POS_REQ=mod(REQUEST,MAX_NB_REQ)+1 + IF(REQ_ID(POS_REQ).NE.-9999)THEN + CALL MUMPS_WAIT_REQUEST(REQ_ID(POS_REQ),IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + CALL DMUMPS_596(REQUEST,PTRFAC,NSTEPS) + REQ_ACT=REQ_ACT-1 + ENDIF + SIZE_OF_READ(POS_REQ)=SIZE + FIRST_POS_IN_READ(POS_REQ)=I + READ_DEST(POS_REQ)=DEST + IF(FLAG.EQ.0)THEN + READ_MNG(POS_REQ)=CURRENT_POS_B(ZONE)-NB_NODES+1 + ELSEIF(FLAG.EQ.1)THEN + READ_MNG(POS_REQ)=CURRENT_POS_T(ZONE) + ENDIF + REQ_TO_ZONE(POS_REQ)=ZONE + REQ_ID(POS_REQ)=REQUEST + J8=0_8 + IF(FLAG.EQ.0)THEN + LOC_I=CURRENT_POS_B(ZONE)-NB_NODES+1 + ENDIF + DO WHILE((J8.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))) + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + INODE_TO_POS(STEP_OOC(TMP_NODE))=1 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + I=I+1 + CYCLE + ENDIF + IF((IO_REQ(STEP_OOC(TMP_NODE)).GE.0).OR. + & (INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0))THEN + IF(FLAG.EQ.1)THEN + POS_IN_MEM(CURRENT_POS_T(ZONE))=0 + ELSEIF(FLAG.EQ.0)THEN + POS_IN_MEM(CURRENT_POS_B(ZONE))=0 + ENDIF + ELSE + IO_REQ(STEP_OOC(TMP_NODE))=REQUEST + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-LAST + IF(FLAG.EQ.1)THEN + IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + CURRENT_POS_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+LAST + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)-LAST + POS_IN_MEM(CURRENT_POS_T(ZONE))=-TMP_NODE- + & ((N_OOC+1)*NB_Z) + INODE_TO_POS(STEP_OOC(TMP_NODE))=-CURRENT_POS_T(ZONE)- + & ((N_OOC+1)*NB_Z) + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ + PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST + LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(FLAG.EQ.0)THEN + LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)-LAST + POS_IN_MEM(LOC_I)=-TMP_NODE-((N_OOC+1)*NB_Z) + IF(LOC_I.EQ.POS_HOLE_T(ZONE))THEN + IF(POS_HOLE_T(ZONE).LT.CURRENT_POS_T(ZONE))THEN + POS_HOLE_T(ZONE)=POS_HOLE_T(ZONE)+1 + ENDIF + ENDIF + INODE_TO_POS(STEP_OOC(TMP_NODE))=-LOC_I-((N_OOC+1)*NB_Z) + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ + PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST + LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSE + WRITE(*,*)MYID_OOC,': Internal error (39) in OOC ', + & ' Invalid Flag Value in ', + & ' DMUMPS_597',FLAG + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).NE.0)THEN + IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).EQ. + & POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))THEN + IF(CURRENT_POS_T(ZONE).NE.PDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (40) in OOC ', + & CURRENT_POS_T(ZONE), + & PDEB_SOLVE_Z(ZONE), + & POS_IN_MEM(CURRENT_POS_T(ZONE)), + & POS_IN_MEM(PDEB_SOLVE_Z(ZONE)) + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + J8=J8+LAST + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (41) in OOC ', + & ' LRLUS_SOLVE must be (1) > 0', + & LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + I=I+1 + IF(FLAG.EQ.1)THEN + CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1 + IF(CURRENT_POS_T(ZONE).GT. + & MAX_NB_NODES_FOR_ZONE+PDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (1) in OOC ' + CALL MUMPS_ABORT() + ENDIF + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + ELSEIF(FLAG.EQ.0)THEN + IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (2) in OOC ', + & POS_HOLE_B(ZONE),LOC_I + CALL MUMPS_ABORT() + ENDIF + CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1 + POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE) + IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + ELSE + WRITE(*,*)MYID_OOC,': Internal error (3) in OOC ', + & ' Invalid Flag Value in ', + & ' DMUMPS_597',FLAG + CALL MUMPS_ABORT() + ENDIF + IF(FLAG.EQ.0)THEN + LOC_I=LOC_I+1 + ENDIF + NB=NB+1 + ENDDO + IF(NB.NE.NB_NODES)THEN + WRITE(*,*)MYID_OOC,': Internal error (4) in OOC ', + & ' DMUMPS_597 ',NB,NB_NODES + ENDIF + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=I + ELSE + CUR_POS_SEQUENCE=POS_SEQ-1 + ENDIF + RETURN + END SUBROUTINE DMUMPS_597 + SUBROUTINE DMUMPS_598(INODE,PTRFAC,NSTEPS,A, + & LA,FLAG,IERR) + IMPLICIT NONE + INTEGER(8) :: LA + INTEGER, intent(out):: IERR + DOUBLE PRECISION A(LA) + INTEGER INODE,NSTEPS + INTEGER(8) :: PTRFAC(NSTEPS) + LOGICAL FLAG + INTEGER(8) FREE_SIZE + INTEGER TMP,TMP_NODE,I,ZONE,J, FREE_HOLE_FLAG + INTEGER WHICH + INTEGER(8) :: DUMMY_SIZE + DUMMY_SIZE=1_8 + IERR = 0 + WHICH=-1 + IF(INODE_TO_POS(STEP_OOC(INODE)).LE.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (5) in OOC ', + & ' Problem in DMUMPS_598', + & INODE, STEP_OOC(INODE), INODE_TO_POS(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE).EQ.0_8)THEN + INODE_TO_POS(STEP_OOC(INODE))=0 + OOC_STATE_NODE(STEP_OOC(INODE))=ALREADY_USED + RETURN + ENDIF + CALL DMUMPS_600(INODE,ZONE,PTRFAC,NSTEPS) + TMP=INODE_TO_POS(STEP_OOC(INODE)) + INODE_TO_POS(STEP_OOC(INODE))=-TMP + POS_IN_MEM(TMP)=-INODE + PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE)) + IF (KEEP_OOC(237).eq.0) THEN + IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.PERMUTED)THEN + WRITE(*,*)MYID_OOC,': INTERNAL ERROR (53) in OOC',INODE, + & OOC_STATE_NODE(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + ENDIF + OOC_STATE_NODE(STEP_OOC(INODE))=USED + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+ + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (6) in OOC ', + & ': LRLUS_SOLVE must be (2) > 0' + CALL MUMPS_ABORT() + ENDIF + IF(ZONE.EQ.NB_Z)THEN + IF(INODE.NE.SPECIAL_ROOT_NODE)THEN + CALL DMUMPS_608(A,FACT_AREA_SIZE, + & DUMMY_SIZE,PTRFAC,KEEP_OOC(28),ZONE,IERR) + ENDIF + ELSE + FREE_HOLE_FLAG=0 + IF(SOLVE_STEP.EQ.0)THEN + IF(TMP.GT.POS_HOLE_B(ZONE))THEN + WHICH=0 + ELSEIF(TMP.LT.POS_HOLE_T(ZONE))THEN + WHICH=1 + ENDIF + ELSEIF(SOLVE_STEP.EQ.1)THEN + IF(TMP.LT.POS_HOLE_T(ZONE))THEN + WHICH=1 + ELSEIF(TMP.GT.POS_HOLE_B(ZONE))THEN + WHICH=0 + ENDIF + ENDIF + IF(WHICH.EQ.1)THEN + J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + FREE_SIZE=0_8 + DO I=J,TMP,-1 + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + GOTO 666 + ENDIF + ENDDO + POS_HOLE_T(ZONE)=TMP + 666 CONTINUE + ELSEIF(WHICH.EQ.0)THEN + J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + FREE_SIZE=0_8 + DO I=J,TMP + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + IF(J.EQ.PDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + CURRENT_POS_B(ZONE)=-9999 + ENDIF + GOTO 777 + ENDIF + ENDDO + POS_HOLE_B(ZONE)=TMP + 777 CONTINUE + ENDIF + IERR=0 + ENDIF + IF((NB_Z.GT.1).AND.FLAG)THEN + CALL DMUMPS_601(ZONE) + IF((LRLUS_SOLVE(ZONE).GE.MIN_SIZE_READ).OR. + & (LRLUS_SOLVE(ZONE).GE. + & int(0.3D0*dble(SIZE_SOLVE_Z(ZONE)),8)))THEN + CALL DMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ELSE + CALL DMUMPS_603(ZONE) + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_598 + FUNCTION DMUMPS_726(INODE,PTRFAC,NSTEPS,A,LA, + & IERR) + IMPLICIT NONE + INTEGER INODE,NSTEPS + INTEGER(8) :: LA + INTEGER, INTENT(out)::IERR + DOUBLE PRECISION A(LA) + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER DMUMPS_726 + IERR=0 + IF(INODE_TO_POS(STEP_OOC(INODE)).GT.0)THEN + IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN + DMUMPS_726=OOC_NODE_PERMUTED + ELSE + DMUMPS_726=OOC_NODE_NOT_PERMUTED + ENDIF + IF(.NOT.DMUMPS_727())THEN + IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE) + & .EQ.INODE)THEN + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ELSEIF(SOLVE_STEP.EQ.1)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + CALL DMUMPS_728() + ENDIF + ENDIF + ELSEIF(INODE_TO_POS(STEP_OOC(INODE)).LT.0)THEN + IF(INODE_TO_POS(STEP_OOC(INODE)).LT.-((N_OOC+1)*NB_Z))THEN + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(INODE)),IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': Internal error (7) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + CALL DMUMPS_596(IO_REQ(STEP_OOC(INODE)), + & PTRFAC,NSTEPS) + REQ_ACT=REQ_ACT-1 + ELSE + CALL DMUMPS_599(INODE,PTRFAC,NSTEPS) + IF(.NOT.DMUMPS_727())THEN + IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ. + & INODE)THEN + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ELSEIF(SOLVE_STEP.EQ.1)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + CALL DMUMPS_728() + ENDIF + ENDIF + ENDIF + IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN + DMUMPS_726=OOC_NODE_PERMUTED + ELSE + DMUMPS_726=OOC_NODE_NOT_PERMUTED + ENDIF + ELSE + DMUMPS_726=OOC_NODE_NOT_IN_MEM + ENDIF + RETURN + END FUNCTION DMUMPS_726 + SUBROUTINE DMUMPS_682(INODE) + IMPLICIT NONE + INTEGER INODE + IF ( (KEEP_OOC(237).EQ.0) + & .AND. (KEEP_OOC(235).EQ.0) ) THEN + IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.NOT_USED)THEN + WRITE(*,*)MYID_OOC,': INTERNAL ERROR (51) in OOC',INODE, + & OOC_STATE_NODE(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + ENDIF + OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED + END SUBROUTINE DMUMPS_682 + SUBROUTINE DMUMPS_599(INODE,PTRFAC,NSTEPS) + IMPLICIT NONE + INTEGER INODE,NSTEPS + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER ZONE + INODE_TO_POS(STEP_OOC(INODE))=-INODE_TO_POS(STEP_OOC(INODE)) + POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE)))= + & -POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE))) + PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE)) + IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED_NOT_PERMUTED)THEN + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + ELSEIF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED)THEN + OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED + ELSE + WRITE(*,*)MYID_OOC,': Internal error (52) in OOC',INODE, + & OOC_STATE_NODE(STEP_OOC(INODE)), + & INODE_TO_POS(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + CALL DMUMPS_610(PTRFAC(STEP_OOC(INODE)),ZONE) + IF(INODE_TO_POS(STEP_OOC(INODE)).LE.POS_HOLE_B(ZONE))THEN + IF(INODE_TO_POS(STEP_OOC(INODE)).GT. + & PDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)= + & INODE_TO_POS(STEP_OOC(INODE))-1 + ELSE + CURRENT_POS_B(ZONE)=-9999 + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + ENDIF + IF(INODE_TO_POS(STEP_OOC(INODE)).GE.POS_HOLE_T(ZONE))THEN + IF(INODE_TO_POS(STEP_OOC(INODE)).LT. + & CURRENT_POS_T(ZONE)-1)THEN + POS_HOLE_T(ZONE)=INODE_TO_POS(STEP_OOC(INODE))+1 + ELSE + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + ENDIF + ENDIF + CALL DMUMPS_609(INODE,PTRFAC,NSTEPS,1) + END SUBROUTINE DMUMPS_599 + SUBROUTINE DMUMPS_600(INODE,ZONE,PTRFAC,NSTEPS) + IMPLICIT NONE + INTEGER INODE,ZONE,NSTEPS + INTEGER (8) :: PTRFAC(NSTEPS) + ZONE=1 + DO WHILE (ZONE.LE.NB_Z) + IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN + ZONE=ZONE-1 + EXIT + ENDIF + ZONE=ZONE+1 + ENDDO + IF(ZONE.EQ.NB_Z+1)THEN + ZONE=ZONE-1 + ENDIF + END SUBROUTINE DMUMPS_600 + SUBROUTINE DMUMPS_601(ZONE) + IMPLICIT NONE + INTEGER ZONE + ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1)+1 + END SUBROUTINE DMUMPS_601 + SUBROUTINE DMUMPS_603(ZONE) + IMPLICIT NONE + INTEGER ZONE + IF(NB_Z.GT.1)THEN + CURRENT_SOLVE_READ_ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1) + ZONE=CURRENT_SOLVE_READ_ZONE+1 + ELSE + ZONE=NB_Z + ENDIF + END SUBROUTINE DMUMPS_603 + SUBROUTINE DMUMPS_578(INODE,PTRFAC, + & KEEP,KEEP8, + & A,IERR) + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER, intent(out)::IERR + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)) + DOUBLE PRECISION A(FACT_AREA_SIZE) + INTEGER(8) :: REQUESTED_SIZE + INTEGER ZONE,IFLAG + IERR=0 + IFLAG=0 + IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + & .EQ.0_8)THEN + INODE_TO_POS(STEP_OOC(INODE))=1 + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + PTRFAC(STEP_OOC(INODE))=1_8 + RETURN + ENDIF + REQUESTED_SIZE=SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + ZONE=NB_Z + IF(CURRENT_POS_T(ZONE).GT. + & (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1))THEN + CALL DMUMPS_608(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + IF((LRLU_SOLVE_T(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE), + & OOC_FCT_TYPE)).AND. + & (CURRENT_POS_T(ZONE).LE. + & (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN + CALL DMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSEIF(LRLU_SOLVE_B(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE), + & OOC_FCT_TYPE).AND. + & (CURRENT_POS_B(ZONE).GT.0))THEN + CALL DMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSE + IF(DMUMPS_579(INODE,ZONE))THEN + IF(SOLVE_STEP.EQ.0)THEN + CALL DMUMPS_604(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL DMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSEIF(IFLAG.EQ.0)THEN + CALL DMUMPS_605(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL DMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ENDIF + ENDIF + ELSE + CALL DMUMPS_605(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL DMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSEIF(IFLAG.EQ.0)THEN + CALL DMUMPS_604(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL DMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ENDIF + ENDIF + ENDIF + IF(IFLAG.EQ.0)THEN + CALL DMUMPS_608(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL DMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ENDIF + ELSE + WRITE(*,*)MYID_OOC,': Internal error (8) in OOC ', + & ' Not enough space for Solve',INODE, + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE), + & LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (9) in OOC ', + & ' LRLUS_SOLVE must be (3) > 0' + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE DMUMPS_578 + SUBROUTINE DMUMPS_604(A,LA,REQUESTED_SIZE,PTRFAC, + & NSTEPS,ZONE,FLAG,IERR) + IMPLICIT NONE + INTEGER NSTEPS,ZONE,FLAG + INTEGER(8) :: REQUESTED_SIZE, LA + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER(8) :: FREE_SIZE, FREE_HOLE, FREE_HOLE_POS + DOUBLE PRECISION A(LA) + INTEGER I,TMP_NODE,FREE_HOLE_FLAG, J + INTEGER, intent(out)::IERR + IERR=0 + FLAG=0 + IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE).AND. + & (.NOT.(CURRENT_POS_T(ZONE) + & .GT.PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN + GOTO 50 + ENDIF + J=max(POS_HOLE_B(ZONE),PDEB_SOLVE_Z(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + DO I=POS_HOLE_T(ZONE)-1,J,-1 + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + EXIT + ENDIF + ENDDO + POS_HOLE_T(ZONE)=I+1 + IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR. + & (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR. + & (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN + CURRENT_POS_B(ZONE)=-9999 + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE) + ENDIF + FREE_HOLE=0_8 + FREE_SIZE=0_8 + FREE_HOLE_FLAG=0 + FREE_HOLE_POS=POSFAC_SOLVE(ZONE) + DO I=CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),-1 + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + FREE_HOLE_FLAG=0 + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE))) + PTRFAC(STEP_OOC(TMP_NODE))=-777777_8 + INODE_TO_POS(STEP_OOC(TMP_NODE))=0 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED + POS_IN_MEM(I)=0 + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).EQ.0)THEN + FREE_HOLE_FLAG=1 + ELSEIF(POS_IN_MEM(I).NE.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (10) in OOC ', + & ' DMUMPS_604', + & CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),I + CALL MUMPS_ABORT() + ENDIF + ENDDO + IF(POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE))THEN + IF(FREE_HOLE_FLAG.EQ.0)THEN + FREE_HOLE_FLAG=1 + ENDIF + ENDIF + IF(FREE_HOLE_FLAG.EQ.1)THEN + IF(POS_HOLE_T(ZONE)-1.GT.PDEB_SOLVE_Z(ZONE))THEN + I=POS_HOLE_T(ZONE)-1 + TMP_NODE=abs(POS_IN_MEM(I)) + IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN + TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (11) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + CALL MUMPS_ABORT() + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL DMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSEIF(TMP_NODE.EQ.0)THEN + DO J=I,PDEB_SOLVE_Z(ZONE),-1 + IF(POS_IN_MEM(J).NE.0) EXIT + ENDDO + IF(POS_IN_MEM(J).LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (12) in OOC ', + & ' DMUMPS_604' + CALL MUMPS_ABORT() + ENDIF + IF(J.GE.PDEB_SOLVE_Z(ZONE))THEN + TMP_NODE=POS_IN_MEM(J) + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSE + FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE) + ENDIF + ELSEIF(TMP_NODE.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (13) in OOC', + & ' DMUMPS_604' + CALL MUMPS_ABORT() + ELSE + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ENDIF + ELSE + FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE) + ENDIF + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + CURRENT_POS_T(ZONE)=POS_HOLE_T(ZONE) + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+FREE_SIZE + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-FREE_SIZE + 50 CONTINUE + IF(REQUESTED_SIZE.LE.LRLU_SOLVE_T(ZONE))THEN + FLAG=1 + ELSE + FLAG=0 + ENDIF + RETURN + END SUBROUTINE DMUMPS_604 + SUBROUTINE DMUMPS_605(A,LA,REQUESTED_SIZE, + & PTRFAC,NSTEPS,ZONE,FLAG,IERR) + IMPLICIT NONE + INTEGER NSTEPS,ZONE,FLAG + INTEGER (8) :: REQUESTED_SIZE + INTEGER (8) :: LA + INTEGER (8) :: PTRFAC(NSTEPS) + DOUBLE PRECISION A(LA) + INTEGER(8) :: FREE_SIZE, FREE_HOLE_POS, FREE_HOLE + INTEGER I,J,TMP_NODE,FREE_HOLE_FLAG + INTEGER, intent(out) :: IERR + IERR=0 + FLAG=0 + IF(LRLU_SOLVE_B(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN + GOTO 50 + ENDIF + IF(POS_HOLE_B(ZONE).EQ.-9999)THEN + GOTO 50 + ENDIF + J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + DO I=POS_HOLE_B(ZONE)+1,J + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + EXIT + ENDIF + ENDDO + POS_HOLE_B(ZONE)=I-1 + IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR. + & (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR. + & (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN + CURRENT_POS_B(ZONE)=-9999 + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE) + ENDIF + FREE_HOLE=0_8 + FREE_SIZE=0_8 + FREE_HOLE_FLAG=0 + FREE_HOLE_POS=IDEB_SOLVE_Z(ZONE) + IF(POS_HOLE_B(ZONE).EQ.-9999)THEN + GOTO 50 + ENDIF + DO I=PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE) + IF((POS_IN_MEM(I).LE.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + IF(TMP_NODE.NE.0)THEN + IF(I.EQ.PDEB_SOLVE_Z(ZONE))THEN + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE. + & IDEB_SOLVE_Z(ZONE))THEN + FREE_SIZE=FREE_SIZE+abs(PTRFAC(STEP_OOC(TMP_NODE))) + & -IDEB_SOLVE_Z(ZONE) + ENDIF + ENDIF + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + FREE_HOLE_FLAG=0 + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(TMP_NODE))=-777777_8 + INODE_TO_POS(STEP_OOC(TMP_NODE))=0 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSE + FREE_HOLE_FLAG=1 + ENDIF + POS_IN_MEM(I)=0 + ELSEIF(POS_IN_MEM(I).NE.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (14) in OOC ', + & ' DMUMPS_605', + & CURRENT_POS_T(ZONE)-1,POS_HOLE_B(ZONE),I,POS_IN_MEM(I) + CALL MUMPS_ABORT() + ENDIF + ENDDO + IF(FREE_HOLE_FLAG.EQ.1)THEN + IF(POS_HOLE_B(ZONE)+1.LT.CURRENT_POS_T(ZONE)-1)THEN + I=POS_HOLE_B(ZONE)+1 + TMP_NODE=abs(POS_IN_MEM(I)) + IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN + TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (15) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + CALL MUMPS_ABORT() + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL DMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-FREE_HOLE_POS + ELSEIF(TMP_NODE.EQ.0)THEN + DO J=I,CURRENT_POS_T(ZONE)-1 + IF(POS_IN_MEM(J).NE.0) EXIT + ENDDO + IF(POS_IN_MEM(J).LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (16) in OOC ', + & ' DMUMPS_605' + CALL MUMPS_ABORT() + ENDIF + IF(J.LE.CURRENT_POS_T(ZONE)-1)THEN + TMP_NODE=POS_IN_MEM(J) + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + ELSE + FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS + ENDIF + ELSEIF(TMP_NODE.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (17) in OOC ', + & ' DMUMPS_605' + CALL MUMPS_ABORT() + ELSE + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + ENDIF + ELSE + FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS + ENDIF + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + LRLU_SOLVE_B(ZONE)=FREE_SIZE + IF(POS_HOLE_B(ZONE).LT.CURRENT_POS_T(ZONE)-1)THEN + TMP_NODE=POS_IN_MEM(POS_HOLE_B(ZONE)+1) + IF(TMP_NODE.LT.-(N_OOC+1)*NB_Z)THEN + TMP_NODE=abs(TMP_NODE)-(N_OOC+1)*NB_Z + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (18) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + CALL MUMPS_ABORT() + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL DMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + ENDIF + LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)+ + & (abs(PTRFAC(STEP_OOC(abs(TMP_NODE))))-IDEB_SOLVE_Z(ZONE)- + & LRLU_SOLVE_B(ZONE)) + ENDIF + CURRENT_POS_B(ZONE)=POS_HOLE_B(ZONE) + 50 CONTINUE + IF((POS_HOLE_B(ZONE).EQ.-9999).AND. + & (LRLU_SOLVE_B(ZONE).NE.0_8))THEN + WRITE(*,*)MYID_OOC,': Internal error (19) in OOC ', + & 'DMUMPS_605' + CALL MUMPS_ABORT() + ENDIF + IF((REQUESTED_SIZE.LE.LRLU_SOLVE_B(ZONE)).AND. + & (POS_HOLE_B(ZONE).NE.-9999))THEN + FLAG=1 + ELSE + FLAG=0 + ENDIF + END SUBROUTINE DMUMPS_605 + SUBROUTINE DMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8, A,ZONE) + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)) + DOUBLE PRECISION A(FACT_AREA_SIZE) + INTEGER ZONE + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(INODE))=POSFAC_SOLVE(ZONE) + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + CURRENT_POS_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (20) in OOC ', + & ' Problem avec debut (2)',INODE, + & PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE),ZONE + CALL MUMPS_ABORT() + ENDIF + INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_T(ZONE) + POS_IN_MEM(CURRENT_POS_T(ZONE))=INODE + IF(CURRENT_POS_T(ZONE).GT.(PDEB_SOLVE_Z(ZONE)+ + & MAX_NB_NODES_FOR_ZONE-1))THEN + WRITE(*,*)MYID_OOC,': Internal error (21) in OOC ', + & ' Problem with CURRENT_POS_T', + & CURRENT_POS_T(ZONE),ZONE + CALL MUMPS_ABORT() + ENDIF + CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1 + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+ + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + END SUBROUTINE DMUMPS_606 + SUBROUTINE DMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8, + & A,ZONE) + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)) + DOUBLE PRECISION A(FACT_AREA_SIZE) + INTEGER ZONE + IF(POS_HOLE_B(ZONE).EQ.-9999)THEN + WRITE(*,*)MYID_OOC,': Internal error (22) in OOC ', + & ' DMUMPS_607' + CALL MUMPS_ABORT() + ENDIF + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(INODE))=IDEB_SOLVE_Z(ZONE)+ + & LRLU_SOLVE_B(ZONE) + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (23) in OOC ', + & PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE) + CALL MUMPS_ABORT() + ENDIF + INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_B(ZONE) + IF(CURRENT_POS_B(ZONE).EQ.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (23b) in OOC ' + CALL MUMPS_ABORT() + ENDIF + POS_IN_MEM(CURRENT_POS_B(ZONE))=INODE + CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1 + POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE) + END SUBROUTINE DMUMPS_607 + SUBROUTINE DMUMPS_608(A,LA,REQUESTED_SIZE,PTRFAC, + & NSTEPS,ZONE,IERR) + IMPLICIT NONE + INTEGER(8) :: LA, REQUESTED_SIZE + INTEGER NSTEPS,ZONE + INTEGER, intent(out) :: IERR + INTEGER(8) :: PTRFAC(NSTEPS) + DOUBLE PRECISION A(LA) + INTEGER (8) :: APOS_FIRST_FREE, + & SIZE_HOLE, + & FREE_HOLE, + & FREE_HOLE_POS + INTEGER J,I,TMP_NODE, NB_FREE, IPOS_FIRST_FREE + INTEGER(8) :: K8, AREA_POINTER + INTEGER FREE_HOLE_FLAG + IERR=0 + IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN + RETURN + ENDIF + AREA_POINTER=IDEB_SOLVE_Z(ZONE) + SIZE_HOLE=0_8 + DO I=PDEB_SOLVE_Z(ZONE),CURRENT_POS_T(ZONE)-1 + IF((POS_IN_MEM(I).LE.0).AND. + & (POS_IN_MEM(I).GT.-((N_OOC+1)*NB_Z))) GOTO 666 + TMP_NODE=abs(POS_IN_MEM(I)) + IF(TMP_NODE.GT.((N_OOC+1)*NB_Z))THEN + TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z) + ENDIF + AREA_POINTER=AREA_POINTER+ + & abs(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ENDDO + 666 CONTINUE + IF((I.EQ.CURRENT_POS_T(ZONE)-1).AND. + & (PDEB_SOLVE_Z(ZONE).NE.CURRENT_POS_T(ZONE)-1))THEN + IF((POS_IN_MEM(I).GT.0).OR. + & (POS_IN_MEM(I).LT.-((N_OOC+1)*NB_Z)))THEN + WRITE(*,*)MYID_OOC,': Internal error (25) in OOC ', + & ': There are no free blocks ', + & 'in DMUMPS_608',PDEB_SOLVE_Z(ZONE), + & CURRENT_POS_T(ZONE) + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF(POS_IN_MEM(I).EQ.0)THEN + APOS_FIRST_FREE=AREA_POINTER + FREE_HOLE_POS=AREA_POINTER + ELSE + TMP_NODE=abs(POS_IN_MEM(I)) + APOS_FIRST_FREE=abs(PTRFAC(STEP_OOC(TMP_NODE))) + ENDIF + IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).NE.0)THEN + IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).LT.-((N_OOC+1)*NB_Z))THEN + TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))- + & ((N_OOC+1)*NB_Z) + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL DMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + ELSE + TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE))) + ENDIF + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE.IDEB_SOLVE_Z(ZONE))THEN + IF((POS_IN_MEM(I).NE.0).OR.(I.EQ.CURRENT_POS_T(ZONE)))THEN + SIZE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & IDEB_SOLVE_Z(ZONE) + ENDIF + APOS_FIRST_FREE=IDEB_SOLVE_Z(ZONE) + IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).GT.0)THEN + DO J=PDEB_SOLVE_Z(ZONE),I-1 + TMP_NODE=POS_IN_MEM(J) + IF(TMP_NODE.LE.0)THEN + IF(TMP_NODE.LT.-((N_OOC+1)*NB_Z))THEN + TMP_NODE=abs(POS_IN_MEM(J))-((N_OOC+1)*NB_Z) + CALL MUMPS_WAIT_REQUEST( + & IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL DMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + TMP_NODE=POS_IN_MEM(J) + ELSE + WRITE(*,*)MYID_OOC,': Internal error (26) in OOC ', + & ' DMUMPS_608',TMP_NODE, + & J,I-1,(N_OOC+1)*NB_Z + CALL MUMPS_ABORT() + ENDIF + ENDIF + DO K8=1_8, + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + A(APOS_FIRST_FREE+K8-1_8)= + & A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8) + ENDDO + PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE + APOS_FIRST_FREE=APOS_FIRST_FREE+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + ENDDO + ENDIF + ENDIF + ENDIF + NB_FREE=0 + FREE_HOLE=0_8 + FREE_HOLE_FLAG=0 + DO J=I,CURRENT_POS_T(ZONE)-1 + TMP_NODE=abs(POS_IN_MEM(J)) + IF(POS_IN_MEM(J).LT.-((N_OOC+1)*NB_Z))THEN + TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z) + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL DMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + TMP_NODE=abs(POS_IN_MEM(J)) + ENDIF + IF(POS_IN_MEM(J).GT.0)THEN + DO K8=1_8,SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + A(APOS_FIRST_FREE+K8-1_8)= + & A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8) + ENDDO + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + FREE_HOLE_FLAG=0 + SIZE_HOLE=SIZE_HOLE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE + APOS_FIRST_FREE=APOS_FIRST_FREE+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(J).EQ.0)THEN + FREE_HOLE_FLAG=1 + NB_FREE=NB_FREE+1 + ELSE + NB_FREE=NB_FREE+1 + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + FREE_HOLE_FLAG=0 + SIZE_HOLE=SIZE_HOLE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + SIZE_HOLE=SIZE_HOLE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + PTRFAC(STEP_OOC(abs(POS_IN_MEM(J))))=-77777_8 + ENDIF + ENDDO + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS + FREE_HOLE_FLAG=0 + SIZE_HOLE=SIZE_HOLE+FREE_HOLE + ENDIF + IPOS_FIRST_FREE=I + DO J=I,CURRENT_POS_T(ZONE)-1 + IF(POS_IN_MEM(J).LT.0)THEN + TMP_NODE=abs(POS_IN_MEM(J)) + INODE_TO_POS(STEP_OOC(TMP_NODE))=0 + POS_IN_MEM(J)=0 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED + ELSEIF(POS_IN_MEM(J).GT.0)THEN + TMP_NODE=abs(POS_IN_MEM(J)) + POS_IN_MEM(IPOS_FIRST_FREE)=POS_IN_MEM(J) + INODE_TO_POS(STEP_OOC(TMP_NODE))=IPOS_FIRST_FREE + IPOS_FIRST_FREE=IPOS_FIRST_FREE+1 + ENDIF + ENDDO + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+SIZE_HOLE + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-SIZE_HOLE + CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)-NB_FREE + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + LRLU_SOLVE_B(ZONE)=0_8 + POS_HOLE_B(ZONE)=-9999 + CURRENT_POS_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + IF(LRLU_SOLVE_T(ZONE).NE.LRLUS_SOLVE(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (27) in OOC ', + & LRLU_SOLVE_T(ZONE), + & LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + LRLU_SOLVE_T(ZONE)=LRLUS_SOLVE(ZONE) + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (28) in OOC ', + & ' LRLUS_SOLVE must be (4) > 0' + CALL MUMPS_ABORT() + ENDIF + IF(POSFAC_SOLVE(ZONE).LT.IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (29) in OOC ', + & POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE) + CALL MUMPS_ABORT() + ENDIF + IF(POSFAC_SOLVE(ZONE).NE.(IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)- + & LRLUS_SOLVE(ZONE)))THEN + WRITE(*,*)MYID_OOC,': Internal error (30) in OOC ', + & ' Problem avec debut POSFAC_SOLVE', + & POSFAC_SOLVE(ZONE),(SIZE_SOLVE_Z(ZONE)- + & LRLUS_SOLVE(ZONE))+IDEB_SOLVE_Z(ZONE),LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + IF(POSFAC_SOLVE(ZONE).GT. + & (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN + WRITE(*,*)MYID_OOC,': Internal error (31) in OOC ', + & POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE)+ + & SIZE_SOLVE_Z(ZONE)-1_8 + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE DMUMPS_608 + SUBROUTINE DMUMPS_609(INODE,PTRFAC,NSTEPS,FLAG) + IMPLICIT NONE + INTEGER INODE,NSTEPS,FLAG + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER ZONE + IF((FLAG.LT.0).OR.(FLAG.GT.1))THEN + WRITE(*,*)MYID_OOC,': Internal error (32) in OOC ', + & ' DMUMPS_609' + CALL MUMPS_ABORT() + ENDIF + CALL DMUMPS_610(PTRFAC(STEP_OOC(INODE)),ZONE) + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (33) in OOC ', + & ' LRLUS_SOLVE must be (5) ++ > 0' + CALL MUMPS_ABORT() + ENDIF + IF(FLAG.EQ.0)THEN + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+ + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + ELSE + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + ENDIF + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (34) in OOC ', + & ' LRLUS_SOLVE must be (5) > 0' + CALL MUMPS_ABORT() + ENDIF + END SUBROUTINE DMUMPS_609 + SUBROUTINE DMUMPS_610(ADDR,ZONE) + IMPLICIT NONE + INTEGER (8) :: ADDR + INTEGER ZONE + INTEGER I + I=1 + DO WHILE (I.LE.NB_Z) + IF(ADDR.LT.IDEB_SOLVE_Z(I))THEN + EXIT + ENDIF + I=I+1 + ENDDO + ZONE=I-1 + END SUBROUTINE DMUMPS_610 + FUNCTION DMUMPS_727() + IMPLICIT NONE + LOGICAL DMUMPS_727 + DMUMPS_727=.FALSE. + IF(SOLVE_STEP.EQ.0)THEN + IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + DMUMPS_727=.TRUE. + ENDIF + ELSEIF(SOLVE_STEP.EQ.1)THEN + IF(CUR_POS_SEQUENCE.LT.1)THEN + DMUMPS_727=.TRUE. + ENDIF + ENDIF + RETURN + END FUNCTION DMUMPS_727 + SUBROUTINE DMUMPS_611(ZONE,A,LA,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER NSTEPS,ZONE + INTEGER(8), INTENT(IN) :: LA + INTEGER, intent(out) :: IERR + DOUBLE PRECISION A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER(8) :: SIZE, DEST + INTEGER(8) :: NEEDED_SIZE + INTEGER FLAG,TMP_FLAG,POS_SEQ,TMP_NODE, + & NB_NODES + IERR=0 + TMP_FLAG=0 + FLAG=0 + IF(DMUMPS_727())THEN + RETURN + ENDIF + IF(SOLVE_STEP.EQ.0)THEN + IF(CUR_POS_SEQUENCE.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT. + & SIZE_SOLVE_Z(ZONE)) + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + IF(DMUMPS_727())THEN + RETURN + ENDIF + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + ENDDO + CALL DMUMPS_728() + NEEDED_SIZE=max(MIN_SIZE_READ, + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSE + NEEDED_SIZE=MIN_SIZE_READ + ENDIF + ELSEIF(SOLVE_STEP.EQ.1)THEN + IF(CUR_POS_SEQUENCE.GE.1)THEN + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT. + & SIZE_SOLVE_Z(ZONE)) + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + IF(DMUMPS_727())THEN + RETURN + ENDIF + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + ENDDO + CALL DMUMPS_728() + NEEDED_SIZE=max(MIN_SIZE_READ, + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSE + NEEDED_SIZE=MIN_SIZE_READ + ENDIF + ENDIF + IF(LRLUS_SOLVE(ZONE).LT.NEEDED_SIZE)THEN + RETURN + ELSEIF((LRLU_SOLVE_T(ZONE).LT.NEEDED_SIZE).AND. + & (LRLU_SOLVE_B(ZONE).LT.NEEDED_SIZE).AND. + & (dble(LRLUS_SOLVE(ZONE)).LT.0.3d0* + & dble(SIZE_SOLVE_Z(ZONE)))) THEN + RETURN + ENDIF + IF((LRLU_SOLVE_T(ZONE).GT.NEEDED_SIZE).AND.(SOLVE_STEP.EQ.0).AND. + & ((CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1).LT. + & MAX_NB_NODES_FOR_ZONE))THEN + FLAG=1 + ELSE + IF(SOLVE_STEP.EQ.0)THEN + CALL DMUMPS_604(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=1 + IF(TMP_FLAG.EQ.0)THEN + CALL DMUMPS_605(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=0 + ENDIF + ELSE + CALL DMUMPS_605(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=0 + IF(TMP_FLAG.EQ.0)THEN + CALL DMUMPS_604(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=1 + ENDIF + ENDIF + IF(TMP_FLAG.EQ.0)THEN + CALL DMUMPS_608(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=1 + ENDIF + ENDIF + CALL DMUMPS_602(ZONE,SIZE,DEST,POS_SEQ, + & NB_NODES,FLAG,PTRFAC,NSTEPS) + IF(SIZE.EQ.0_8)THEN + RETURN + ENDIF + NB_ZONE_REQ=NB_ZONE_REQ+1 + SIZE_ZONE_REQ=SIZE_ZONE_REQ+SIZE + REQ_ACT=REQ_ACT+1 + CALL DMUMPS_595(A(DEST),DEST,SIZE,ZONE,PTRFAC,NSTEPS, + & POS_SEQ,NB_NODES,FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + END SUBROUTINE DMUMPS_611 + SUBROUTINE DMUMPS_602(ZONE,SIZE,DEST,POS_SEQ, + & NB_NODES,FLAG,PTRFAC,NSTEPS) + IMPLICIT NONE + INTEGER(8) :: SIZE, DEST + INTEGER ZONE,FLAG,POS_SEQ,NSTEPS + INTEGER(8) :: PTRFAC(NSTEPS), MAX_SIZE, LAST, J8 + INTEGER I,START_NODE,K,MAX_NB, + & NB_NODES + INTEGER NB_NODES_LOC + LOGICAL ALREADY + IF(DMUMPS_727())THEN + SIZE=0_8 + RETURN + ENDIF + IF(FLAG.EQ.0)THEN + MAX_SIZE=LRLU_SOLVE_B(ZONE) + MAX_NB=max(0,CURRENT_POS_B(ZONE)-PDEB_SOLVE_Z(ZONE)+1) + ELSEIF(FLAG.EQ.1)THEN + MAX_SIZE=LRLU_SOLVE_T(ZONE) + MAX_NB=MAX_NB_NODES_FOR_ZONE + ELSE + WRITE(*,*)MYID_OOC,': Internal error (35) in OOC ', + & ' Unknown Flag value in ', + & ' DMUMPS_602',FLAG + CALL MUMPS_ABORT() + ENDIF + CALL DMUMPS_728() + I=CUR_POS_SEQUENCE + START_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + ALREADY=.FALSE. + NB_NODES=0 + NB_NODES_LOC=0 +#if defined (NEW_PREF_SCHEME) + IF(MAX_SIZE.GT.MAX_PREF_SIZE)THEN + MAX_SIZE=MIN(MAX(MAX_PREF_SIZE, + & SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE)), + & MAX_SIZE) + ENDIF +#endif + IF(ZONE.EQ.NB_Z)THEN + SIZE=SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE) + ELSE + J8=0_8 + IF(FLAG.EQ.0)THEN + K=0 + ELSEIF(FLAG.EQ.1)THEN + K=CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1 + ENDIF + IF(SOLVE_STEP.EQ.0)THEN + I=CUR_POS_SEQUENCE + DO WHILE(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) + IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + & .NE.0_8)THEN + EXIT + ENDIF + I=I+1 + ENDDO + CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) + I=CUR_POS_SEQUENCE + DO WHILE((J8.LE.MAX_SIZE).AND. + & (I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND. + & (K.LT.MAX_NB) ) + LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + IF(.NOT.ALREADY)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ENDIF + I=I+1 + NB_NODES_LOC=NB_NODES_LOC+1 + CYCLE + ENDIF + IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))) + & .NE.0).OR. + & (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))).GE. + & 0))THEN + IF(.NOT.ALREADY)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + I=I+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ALREADY=.TRUE. + J8=J8+LAST + I=I+1 + K=K+1 + NB_NODES_LOC=NB_NODES_LOC+1 + NB_NODES=NB_NODES+1 + ENDDO + IF(J8.GT.MAX_SIZE)THEN + SIZE=J8-LAST + NB_NODES=NB_NODES-1 + NB_NODES_LOC=NB_NODES_LOC-1 + ELSE + SIZE=J8 + ENDIF + DO WHILE (CUR_POS_SEQUENCE+NB_NODES_LOC-1.GE. + & CUR_POS_SEQUENCE) + IF(SIZE_OF_BLOCK(STEP_OOC( + & OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE+NB_NODES-1, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + & .NE.0_8)THEN + EXIT + ENDIF + NB_NODES_LOC=NB_NODES_LOC-1 + ENDDO + POS_SEQ=CUR_POS_SEQUENCE + ELSEIF(SOLVE_STEP.EQ.1)THEN + DO WHILE(I.GE.1) + IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + & .NE.0_8)THEN + EXIT + ENDIF + I=I-1 + ENDDO + CUR_POS_SEQUENCE=max(I,1) + I=CUR_POS_SEQUENCE + DO WHILE((J8.LE.MAX_SIZE).AND.(I.GE.1).AND. + & (K.LT.MAX_NB)) + LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + IF(.NOT.ALREADY)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + NB_NODES_LOC=NB_NODES_LOC+1 + I=I-1 + CYCLE + ENDIF + IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))) + & .NE.0).OR. + & (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))).GE. + & 0))THEN + IF(.NOT.ALREADY)THEN + I=I-1 + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ALREADY=.TRUE. + J8=J8+LAST + I=I-1 + K=K+1 + NB_NODES=NB_NODES+1 + NB_NODES_LOC=NB_NODES_LOC+1 + ENDDO + IF(J8.GT.MAX_SIZE)THEN + SIZE=J8-LAST + NB_NODES=NB_NODES-1 + NB_NODES_LOC=NB_NODES_LOC-1 + ELSE + SIZE=J8 + ENDIF + I=CUR_POS_SEQUENCE-NB_NODES_LOC+1 + DO WHILE (I.LE.CUR_POS_SEQUENCE) + IF(SIZE_OF_BLOCK(STEP_OOC( + & OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)), + & OOC_FCT_TYPE).NE.0_8)THEN + EXIT + ENDIF + I=I+1 + NB_NODES_LOC=NB_NODES_LOC-1 + ENDDO + POS_SEQ=CUR_POS_SEQUENCE-NB_NODES_LOC+1 + ENDIF + ENDIF + IF(FLAG.EQ.0)THEN + DEST=IDEB_SOLVE_Z(ZONE)+LRLU_SOLVE_B(ZONE)-SIZE + ELSE + DEST=POSFAC_SOLVE(ZONE) + ENDIF + END SUBROUTINE DMUMPS_602 + SUBROUTINE DMUMPS_582(IERR) + IMPLICIT NONE + INTEGER SOLVE_OR_FACTO + INTEGER, intent(out) :: IERR + IERR=0 + IF(allocated(LRLUS_SOLVE))THEN + DEALLOCATE(LRLUS_SOLVE) + ENDIF + IF(allocated(LRLU_SOLVE_T))THEN + DEALLOCATE(LRLU_SOLVE_T) + ENDIF + IF(allocated(LRLU_SOLVE_B))THEN + DEALLOCATE(LRLU_SOLVE_B) + ENDIF + IF(allocated(POSFAC_SOLVE))THEN + DEALLOCATE(POSFAC_SOLVE) + ENDIF + IF(allocated(IDEB_SOLVE_Z))THEN + DEALLOCATE(IDEB_SOLVE_Z) + ENDIF + IF(allocated(PDEB_SOLVE_Z))THEN + DEALLOCATE(PDEB_SOLVE_Z) + ENDIF + IF(allocated(SIZE_SOLVE_Z))THEN + DEALLOCATE(SIZE_SOLVE_Z) + ENDIF + IF(allocated(CURRENT_POS_T))THEN + DEALLOCATE(CURRENT_POS_T) + ENDIF + IF(allocated(CURRENT_POS_B))THEN + DEALLOCATE(CURRENT_POS_B) + ENDIF + IF(allocated(POS_HOLE_T))THEN + DEALLOCATE(POS_HOLE_T) + ENDIF + IF(allocated(POS_HOLE_B))THEN + DEALLOCATE(POS_HOLE_B) + ENDIF + IF(allocated(OOC_STATE_NODE))THEN + DEALLOCATE(OOC_STATE_NODE) + ENDIF + IF(allocated(POS_IN_MEM))THEN + DEALLOCATE(POS_IN_MEM) + ENDIF + IF(allocated(INODE_TO_POS))THEN + DEALLOCATE(INODE_TO_POS) + ENDIF + IF(allocated(IO_REQ))THEN + DEALLOCATE(IO_REQ) + ENDIF + IF(allocated(SIZE_OF_READ))THEN + DEALLOCATE(SIZE_OF_READ) + ENDIF + IF(allocated(FIRST_POS_IN_READ))THEN + DEALLOCATE(FIRST_POS_IN_READ) + ENDIF + IF(allocated(READ_DEST))THEN + DEALLOCATE(READ_DEST) + ENDIF + IF(allocated(READ_MNG))THEN + DEALLOCATE(READ_MNG) + ENDIF + IF(allocated(REQ_TO_ZONE))THEN + DEALLOCATE(REQ_TO_ZONE) + ENDIF + IF(allocated(REQ_ID))THEN + DEALLOCATE(REQ_ID) + ENDIF + SOLVE_OR_FACTO=1 + CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + END SUBROUTINE DMUMPS_582 + SUBROUTINE DMUMPS_612(PTRFAC,NSTEPS, + & A,LA) + IMPLICIT NONE + INTEGER, INTENT(in) :: NSTEPS + INTEGER(8), INTENT(INOUT) :: PTRFAC(NSTEPS) + INTEGER(8), INTENT(IN) :: LA + DOUBLE PRECISION :: A(LA) + INTEGER :: I, TMP, ZONE, IPAS, IBEG, IEND + INTEGER(8) :: SAVE_PTR + LOGICAL :: COMPRESS_TO_BE_DONE, SET_POS_SEQUENCE + INTEGER :: J, IERR + INTEGER(8) :: DUMMY_SIZE + COMPRESS_TO_BE_DONE = .FALSE. + DUMMY_SIZE = 1_8 + IERR = 0 + SET_POS_SEQUENCE = .TRUE. + IF(SOLVE_STEP.EQ.0)THEN + IBEG = 1 + IEND = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + IPAS = 1 + ELSE + IBEG = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + IEND = 1 + IPAS = -1 + ENDIF + DO I=IBEG,IEND,IPAS + J = OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + TMP=INODE_TO_POS(STEP_OOC(J)) + IF(TMP.EQ.0)THEN + IF (SET_POS_SEQUENCE) THEN + SET_POS_SEQUENCE = .FALSE. + CUR_POS_SEQUENCE = I + ENDIF + IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN + OOC_STATE_NODE(STEP_OOC(J)) = NOT_IN_MEM + ENDIF + CYCLE + ELSE IF(TMP.LT.0)THEN + IF(TMP.GT.-(N_OOC+1)*NB_Z)THEN + SAVE_PTR=PTRFAC(STEP_OOC(J)) + PTRFAC(STEP_OOC(J)) = abs(SAVE_PTR) + CALL DMUMPS_600(J, + & ZONE,PTRFAC,NSTEPS) + PTRFAC(STEP_OOC(J)) = SAVE_PTR + IF(ZONE.EQ.NB_Z)THEN + IF(J.NE.SPECIAL_ROOT_NODE)THEN + WRITE(*,*)MYID_OOC,': Internal error 6 ', + & ' Node ', J, + & ' is in status USED in the + & emmergency buffer ' + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0) + & THEN + IF (OOC_STATE_NODE(STEP_OOC(J)).EQ.NOT_IN_MEM) THEN + OOC_STATE_NODE(STEP_OOC(J)) = USED + IF((SOLVE_STEP.NE.0).OR.(J.NE.SPECIAL_ROOT_NODE) + & .OR.(ZONE.NE.NB_Z))THEN + CALL DMUMPS_599(J,PTRFAC,NSTEPS) + ENDIF + CYCLE + ELSEIF(OOC_STATE_NODE(STEP_OOC(J)).EQ.ALREADY_USED) + & THEN + COMPRESS_TO_BE_DONE = .TRUE. + ELSE + WRITE(*,*)MYID_OOC,': Internal error Mila 4 ', + & ' wrong node status :', OOC_STATE_NODE(STEP_OOC(J)), + & ' on node ', J + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN + CALL DMUMPS_599(J,PTRFAC,NSTEPS) + ENDIF + ENDIF + ENDIF + ENDDO + IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0) + & THEN + IF (COMPRESS_TO_BE_DONE) THEN + DO ZONE=1,NB_Z-1 + CALL DMUMPS_608(A,LA, + & DUMMY_SIZE,PTRFAC, + & NSTEPS,ZONE,IERR) + IF (IERR .LT. 0) THEN + WRITE(*,*)MYID_OOC,': Internal error Mila 5 ', + & ' IERR on return to DMUMPS_608 =', + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_612 + SUBROUTINE DMUMPS_583(PTRFAC,NSTEPS,MTYPE, + & A,LA,DOPREFETCH,IERR) + IMPLICIT NONE + INTEGER NSTEPS,MTYPE + INTEGER, intent(out)::IERR + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + LOGICAL DOPREFETCH + INTEGER MUMPS_808 + EXTERNAL MUMPS_808 + IERR = 0 + OOC_FCT_TYPE=MUMPS_808("F",MTYPE,KEEP_OOC(201), + & KEEP_OOC(50)) + OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1 + IF (KEEP_OOC(201).NE.1) THEN + OOC_SOLVE_TYPE_FCT = FCT + ENDIF + SOLVE_STEP=0 + CUR_POS_SEQUENCE=1 + MTYPE_OOC=MTYPE + IF ( KEEP_OOC(201).NE.1 +#if ! defined(TEMP_VERSION_TO_FORCE_DATA_REINIT) + & .OR. KEEP_OOC(50).NE.0 +#endif + & ) THEN + CALL DMUMPS_612(PTRFAC,NSTEPS,A,LA) + ELSE + CALL DMUMPS_683(KEEP_OOC(28), + & KEEP_OOC(38), KEEP_OOC(20) ) + ENDIF + IF (DOPREFETCH) THEN + CALL DMUMPS_585(A,LA,PTRFAC, + & KEEP_OOC(28),IERR) + ELSE + CUR_POS_SEQUENCE = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + ENDIF + RETURN + END SUBROUTINE DMUMPS_583 + SUBROUTINE DMUMPS_584(PTRFAC,NSTEPS,MTYPE, + & I_WORKED_ON_ROOT,IROOT,A,LA,IERR) + IMPLICIT NONE + INTEGER NSTEPS + INTEGER(8) :: LA + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER MTYPE + INTEGER IROOT + LOGICAL I_WORKED_ON_ROOT + INTEGER, intent(out):: IERR + DOUBLE PRECISION A(LA) + INTEGER(8) :: DUMMY_SIZE + INTEGER ZONE + INTEGER MUMPS_808 + EXTERNAL MUMPS_808 + IERR=0 + OOC_FCT_TYPE=MUMPS_808("B",MTYPE,KEEP_OOC(201), + & KEEP_OOC(50)) + OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1 + IF (KEEP_OOC(201).NE.1) OOC_SOLVE_TYPE_FCT=FCT + SOLVE_STEP=1 + CUR_POS_SEQUENCE=TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + MTYPE_OOC=MTYPE + IF ( KEEP_OOC(201).NE.1 +#if ! defined(TEMP_VERSION_TO_FORCE_DATA_REINIT) + & .OR. KEEP_OOC(50).NE.0 +#endif + & ) THEN + CALL DMUMPS_612(PTRFAC,NSTEPS,A,LA) + IF (I_WORKED_ON_ROOT) THEN + CALL DMUMPS_598 ( IROOT, + & PTRFAC, KEEP_OOC(28), A, LA,.FALSE.,IERR) + IF (IERR .LT. 0) RETURN + CALL DMUMPS_600(IROOT, + & ZONE,PTRFAC,NSTEPS) + IF(IROOT.EQ.NB_Z)THEN + DUMMY_SIZE=1_8 + CALL DMUMPS_608(A,LA, + & DUMMY_SIZE,PTRFAC, + & NSTEPS,NB_Z,IERR) + IF (IERR .LT. 0) THEN + WRITE(*,*)MYID_OOC,': Internal error in + & DMUMPS_608', + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + IF (NB_Z.GT.1) THEN + CALL DMUMPS_594(A,LA,PTRFAC, + & KEEP_OOC(28),IERR) + IF (IERR .LT. 0) RETURN + ENDIF + ELSE + CALL DMUMPS_683(KEEP_OOC(28), + & KEEP_OOC(38), KEEP_OOC(20) ) + CALL DMUMPS_585(A,LA,PTRFAC,KEEP_OOC(28),IERR) + IF (IERR .LT. 0 ) RETURN + ENDIF + RETURN + END SUBROUTINE DMUMPS_584 + SUBROUTINE DMUMPS_613(id,IERR) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(DMUMPS_STRUC), TARGET :: id + INTEGER, intent(out) :: IERR + INTEGER I,DIM,J,TMP,SIZE,K,I1 + CHARACTER*1 TMP_NAME(350) + EXTERNAL MUMPS_OOC_GET_NB_FILES_C, MUMPS_OOC_GET_FILE_NAME_C + IERR=0 + SIZE=0 + DO J=1,OOC_NB_FILE_TYPE + TMP=J-1 + CALL MUMPS_OOC_GET_NB_FILES_C(TMP,I) + id%OOC_NB_FILES(J)=I + SIZE=SIZE+I + ENDDO + IF(associated(id%OOC_FILE_NAMES))THEN + DEALLOCATE(id%OOC_FILE_NAMES) + NULLIFY(id%OOC_FILE_NAMES) + ENDIF + ALLOCATE(id%OOC_FILE_NAMES(SIZE,350),stat=IERR) + IF (IERR .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_613' + IERR=-1 + IF(id%INFO(1).GE.0)THEN + id%INFO(1) = -13 + id%INFO(2) = SIZE*350 + RETURN + ENDIF + ENDIF + IF(associated(id%OOC_FILE_NAME_LENGTH))THEN + DEALLOCATE(id%OOC_FILE_NAME_LENGTH) + NULLIFY(id%OOC_FILE_NAME_LENGTH) + ENDIF + ALLOCATE(id%OOC_FILE_NAME_LENGTH(SIZE),stat=IERR) + IF (IERR .GT. 0) THEN + IERR=-1 + IF(id%INFO(1).GE.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) + & 'PB allocation in DMUMPS_613' + id%INFO(1) = -13 + id%INFO(2) = SIZE + RETURN + ENDIF + ENDIF + K=1 + DO I1=1,OOC_NB_FILE_TYPE + TMP=I1-1 + DO I=1,id%OOC_NB_FILES(I1) + CALL MUMPS_OOC_GET_FILE_NAME_C(TMP,I,DIM,TMP_NAME(1)) + DO J=1,DIM+1 + id%OOC_FILE_NAMES(K,J)=TMP_NAME(J) + ENDDO + id%OOC_FILE_NAME_LENGTH(K)=DIM+1 + K=K+1 + ENDDO + ENDDO + END SUBROUTINE DMUMPS_613 + SUBROUTINE DMUMPS_614(id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(DMUMPS_STRUC), TARGET :: id + CHARACTER*1 TMP_NAME(350) + INTEGER I,I1,TMP,J,K,L,DIM,IERR + INTEGER, DIMENSION(:),ALLOCATABLE :: NB_FILES + INTEGER K211 + ALLOCATE(NB_FILES(OOC_NB_FILE_TYPE),stat=IERR) + IF (IERR .GT. 0) THEN + IERR=-1 + IF(id%INFO(1).GE.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) + & 'PB allocation in DMUMPS_614' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + ENDIF + IERR=0 + NB_FILES=id%OOC_NB_FILES + I=id%MYID + K=id%KEEP(35) + L=mod(id%KEEP(204),3) + K211=id%KEEP(211) + CALL MUMPS_OOC_ALLOC_POINTERS_C(OOC_NB_FILE_TYPE,NB_FILES,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + CALL MUMPS_OOC_INIT_VARS_C(I,K,L,K211,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + K=1 + DO I1=1,OOC_NB_FILE_TYPE + DO I=1,NB_FILES(I1) + DIM=id%OOC_FILE_NAME_LENGTH(K) + DO J=1,DIM + TMP_NAME(J)=id%OOC_FILE_NAMES(K,J) + ENDDO + TMP=I1-1 + CALL MUMPS_OOC_SET_FILE_NAME_C(TMP,I,DIM,IERR,TMP_NAME(1)) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + K=K+1 + ENDDO + ENDDO + CALL MUMPS_OOC_START_LOW_LEVEL(IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + DEALLOCATE(NB_FILES) + RETURN + END SUBROUTINE DMUMPS_614 + SUBROUTINE DMUMPS_589(DEST,SRC,NB,NB_EFF) + IMPLICIT NONE + INTEGER NB, NB_EFF + CHARACTER(LEN=NB) SRC + CHARACTER*1 DEST(NB) + INTEGER I + DO I=1,NB_EFF + DEST(I)=SRC(I:I) + ENDDO + END SUBROUTINE DMUMPS_589 + SUBROUTINE DMUMPS_580(IERR) + USE DMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, intent(out) :: IERR + IERR=0 + IF(.NOT.WITH_BUF)THEN + RETURN + ENDIF + CALL DMUMPS_707(OOC_FCT_TYPE,IERR) + IF (IERR < 0) THEN + RETURN + ENDIF + RETURN + END SUBROUTINE DMUMPS_580 + SUBROUTINE DMUMPS_681(IERR) + USE DMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, intent(out) :: IERR + INTEGER I + IERR=0 + IF(.NOT.WITH_BUF)THEN + RETURN + ENDIF + DO I=1,OOC_NB_FILE_TYPE + CALL DMUMPS_707(I,IERR) + IF (IERR < 0) RETURN + ENDDO + RETURN + END SUBROUTINE DMUMPS_681 + SUBROUTINE DMUMPS_683(NSTEPS, + & KEEP38, KEEP20) + IMPLICIT NONE + INTEGER NSTEPS + INTEGER I, J + INTEGER(8) :: TMP_SIZE8 + INTEGER KEEP38, KEEP20 + INODE_TO_POS = 0 + POS_IN_MEM = 0 + OOC_STATE_NODE(1:NSTEPS)=0 + TMP_SIZE8=1_8 + J=1 + DO I=1,NB_Z-1 + IDEB_SOLVE_Z(I)=TMP_SIZE8 + PDEB_SOLVE_Z(I)=J + POSFAC_SOLVE(I)=TMP_SIZE8 + LRLUS_SOLVE(I) =SIZE_ZONE_SOLVE + LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE + LRLU_SOLVE_B(I)=0_8 + SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE + CURRENT_POS_T(I)=J + CURRENT_POS_B(I)=J + POS_HOLE_T(I) =J + POS_HOLE_B(I) =J + J = J + MAX_NB_NODES_FOR_ZONE + TMP_SIZE8 = TMP_SIZE8 + SIZE_ZONE_SOLVE + ENDDO + IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8 + PDEB_SOLVE_Z(NB_Z)=J + POSFAC_SOLVE(NB_Z)=TMP_SIZE8 + LRLUS_SOLVE(NB_Z) =SIZE_SOLVE_EMM + LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM + LRLU_SOLVE_B(NB_Z)=0_8 + SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM + CURRENT_POS_T(NB_Z)=J + CURRENT_POS_B(NB_Z)=J + POS_HOLE_T(NB_Z) =J + POS_HOLE_B(NB_Z) =J + IO_REQ=-77777 + SIZE_OF_READ=-9999_8 + FIRST_POS_IN_READ=-9999 + READ_DEST=-9999_8 + READ_MNG=-9999 + REQ_TO_ZONE=-9999 + REQ_ID=-9999 + RETURN + END SUBROUTINE DMUMPS_683 + SUBROUTINE DMUMPS_688 + & ( STRAT, TYPEFile, + & AFAC, LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW, LIWFAC, + & MYID, FILESIZE, IERR , LAST_CALL) + IMPLICIT NONE + TYPE(IO_BLOCK), INTENT(INOUT):: MonBloc + INTEGER(8) :: LAFAC + INTEGER, INTENT(IN) :: STRAT, LIWFAC, + & MYID, TYPEFile + INTEGER, INTENT(INOUT) :: IW(0:LIWFAC-1) + DOUBLE PRECISION, INTENT(IN) :: AFAC(LAFAC) + INTEGER, INTENT(INOUT) :: LNextPiv2beWritten, + & UNextPiv2beWritten + INTEGER(8), INTENT(INOUT) :: FILESIZE + INTEGER, INTENT(OUT) :: IERR + LOGICAL, INTENT(IN) :: LAST_CALL + INTEGER(8) :: TMPSIZE_OF_BLOCK + INTEGER :: TempFTYPE + LOGICAL WRITE_L, WRITE_U + LOGICAL DO_U_FIRST + INCLUDE 'mumps_headers.h' + IERR = 0 + IF (KEEP_OOC(50).EQ.0 + & .AND.KEEP_OOC(251).EQ.2) THEN + WRITE_L = .FALSE. + ELSE + WRITE_L = (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_L) + ENDIF + WRITE_U = (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_U) + DO_U_FIRST = .FALSE. + IF ( TYPEFile.EQ.TYPEF_BOTH_LU ) THEN + IF ( LNextPiv2beWritten .GT. UNextPiv2beWritten ) THEN + DO_U_FIRST = .TRUE. + END IF + END IF + IF (DO_U_FIRST) GOTO 200 + 100 IF (WRITE_L .AND. TYPEF_L > 0 ) THEN + TempFTYPE = TYPEF_L + IF ((MonBloc%Typenode.EQ.2).AND.(.NOT.MonBloc%MASTER)) + & THEN + TMPSIZE_OF_BLOCK = SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE), + & TempFTYPE) + IF (TMPSIZE_OF_BLOCK .LT. 0_8) THEN + TMPSIZE_OF_BLOCK = -TMPSIZE_OF_BLOCK - 1_8 + ENDIF + LNextPiv2beWritten = + & int( + & TMPSIZE_OF_BLOCK + & / int(MonBloc%NROW,8) + & ) + & + 1 + ENDIF + CALL DMUMPS_695( STRAT, + & TempFTYPE, AFAC, LAFAC, MonBloc, + & IERR, + & LNextPiv2beWritten, + & OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE), + & SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE), + & FILESIZE, LAST_CALL ) + IF (IERR .LT. 0) RETURN + IF (DO_U_FIRST) GOTO 300 + ENDIF + 200 IF (WRITE_U) THEN + TempFTYPE = TYPEF_U + CALL DMUMPS_695( STRAT, + & TempFTYPE, AFAC, LAFAC, MonBloc, + & IERR, + & UNextPiv2beWritten, + & OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE), + & SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE), + & FILESIZE, LAST_CALL) + IF (IERR .LT. 0) RETURN + IF (DO_U_FIRST) GOTO 100 + ENDIF + 300 CONTINUE + RETURN + END SUBROUTINE DMUMPS_688 + SUBROUTINE DMUMPS_695( STRAT, TYPEF, + & AFAC, LAFAC, MonBloc, + & IERR, + & LorU_NextPiv2beWritten, + & LorU_AddVirtNodeI8, LorUSIZE_OF_BLOCK, + & FILESIZE, LAST_CALL + & ) + USE DMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, INTENT(IN) :: STRAT + INTEGER, INTENT(IN) :: TYPEF + INTEGER(8), INTENT(INOUT) :: FILESIZE + INTEGER(8), INTENT(IN) :: LAFAC + DOUBLE PRECISION, INTENT(IN) :: AFAC(LAFAC) + INTEGER, INTENT(INOUT) :: LorU_NextPiv2beWritten + INTEGER(8), INTENT(INOUT) :: LorU_AddVirtNodeI8 + INTEGER(8), INTENT(INOUT) :: LorUSIZE_OF_BLOCK + TYPE(IO_BLOCK), INTENT(INOUT) :: MonBloc + INTEGER, INTENT(OUT) :: IERR + LOGICAL, INTENT(IN) :: LAST_CALL + INTEGER NNMAX + INTEGER(8) :: TOTSIZE, EFFSIZE + INTEGER(8) :: TailleEcrite + INTEGER SIZE_PANEL + INTEGER(8) :: AddVirtCour + LOGICAL VIRT_ADD_RESERVED_BEF_CALL + LOGICAL VIRTUAL_ADDRESS_JUST_RESERVED + LOGICAL HOLE_PROCESSED_BEFORE_CALL + LOGICAL TMP_ESTIM + INTEGER ICUR, INODE_CUR, ILAST + INTEGER(8) :: ADDR_LAST + IERR = 0 + IF (TYPEF == TYPEF_L ) THEN + NNMAX = MonBloc%NROW + ELSE + NNMAX = MonBloc%NCOL + ENDIF + SIZE_PANEL = DMUMPS_690(NNMAX) + IF ( (.NOT.MonBloc%Last) .AND. + & (MonBloc%LastPiv-LorU_NextPiv2beWritten+1.LT.SIZE_PANEL)) + & THEN + RETURN + ENDIF + TMP_ESTIM = .TRUE. + TOTSIZE = DMUMPS_725 + & (MonBloc%NFS, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM) + IF (MonBloc%Last) THEN + TMP_ESTIM=.FALSE. + EFFSIZE = DMUMPS_725 + & (MonBloc%LastPiv, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM) + ELSE + EFFSIZE = -1034039740327_8 + ENDIF + IF (MonBloc%Typenode.EQ.3.AND. MonBloc%NFS.NE.MonBloc%NCOL) THEN + WRITE(*,*) 'Internal error in DMUMPS_695 for type3', + & MonBloc%NFS,MonBloc%NCOL + CALL MUMPS_ABORT() + ENDIF + IF (MonBloc%Typenode.EQ.3.AND. TYPEF.NE.TYPEF_L) THEN + WRITE(*,*) 'Internal error in DMUMPS_695,TYPEF=', + & TYPEF, 'for typenode=3' + CALL MUMPS_ABORT() + ENDIF + IF (MonBloc%Typenode.EQ.2.AND. + & TYPEF.EQ.TYPEF_U.AND. + & .NOT. MonBloc%MASTER ) THEN + WRITE(*,*) 'Internal error in DMUMPS_695', + & MonBloc%MASTER,MonBloc%Typenode, TYPEF + CALL MUMPS_ABORT() + ENDIF + HOLE_PROCESSED_BEFORE_CALL = (LorUSIZE_OF_BLOCK .LT. 0_8) + IF (HOLE_PROCESSED_BEFORE_CALL.AND.(.NOT.MonBloc%Last)) THEN + WRITE(6,*) ' Internal error in DMUMPS_695 ', + & ' last is false after earlier calls with last=true' + CALL MUMPS_ABORT() + ENDIF + IF (HOLE_PROCESSED_BEFORE_CALL) THEN + LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 + TOTSIZE = -99999999_8 + ENDIF + VIRTUAL_ADDRESS_JUST_RESERVED = .FALSE. + VIRT_ADD_RESERVED_BEF_CALL = + & ( LorUSIZE_OF_BLOCK .NE. 0_8 .OR. + & HOLE_PROCESSED_BEFORE_CALL ) + IF (MonBloc%Last .AND. .NOT. HOLE_PROCESSED_BEFORE_CALL) THEN + KEEP_OOC(228) = max(KEEP_OOC(228), + & (MonBloc%LastPiv+SIZE_PANEL-1) / SIZE_PANEL) + IF (VIRT_ADD_RESERVED_BEF_CALL) THEN + IF (AddVirtLibre(TYPEF).EQ. + & (LorU_AddVirtNodeI8+TOTSIZE) ) THEN + AddVirtLibre(TYPEF) = LorU_AddVirtNodeI8 + EFFSIZE + ENDIF + ELSE + VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE. + IF (EFFSIZE .EQ. 0_8) THEN + LorU_AddVirtNodeI8 = -9999_8 + ELSE + LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF) + ENDIF + AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + EFFSIZE + ENDIF + ELSE + IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL + & ) THEN + LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF) + AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + TOTSIZE + ENDIF + ENDIF + AddVirtCour = LorU_AddVirtNodeI8 + LorUSIZE_OF_BLOCK + CALL DMUMPS_697( STRAT, TYPEF, MonBloc, + & SIZE_PANEL, + & AFAC, LAFAC, + & LorU_NextPiv2beWritten, AddVirtCour, + & TailleEcrite, + & IERR ) + IF ( IERR .LT. 0 ) RETURN + LorUSIZE_OF_BLOCK = LorUSIZE_OF_BLOCK + TailleEcrite + IF (LorUSIZE_OF_BLOCK.EQ.0_8 ) THEN + IF ( .NOT. VIRT_ADD_RESERVED_BEF_CALL + & .AND. .NOT. VIRTUAL_ADDRESS_JUST_RESERVED ) + & THEN + AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) - TOTSIZE + LorU_AddVirtNodeI8 = 0_8 + ENDIF + ELSE IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL ) THEN + VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE. + ENDIF + IF ( VIRTUAL_ADDRESS_JUST_RESERVED) THEN + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(TYPEF), + & TYPEF) = MonBloc%INODE + I_CUR_HBUF_NEXTPOS(TYPEF) = I_CUR_HBUF_NEXTPOS(TYPEF) + 1 + IF (MonBloc%Last) THEN + MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,EFFSIZE) + TMP_SIZE_FACT=TMP_SIZE_FACT+EFFSIZE + ELSE + MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,TOTSIZE) + TMP_SIZE_FACT=TMP_SIZE_FACT+TOTSIZE + ENDIF + TMP_NB_NODES=TMP_NB_NODES+1 + IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN + MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE, + & TMP_NB_NODES) + TMP_SIZE_FACT=0_8 + TMP_NB_NODES=0 + ENDIF + ENDIF + IF (MonBloc%Last) THEN + LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 + ENDIF + IF (LAST_CALL) THEN + IF (.NOT.MonBloc%Last) THEN + WRITE(6,*) ' Internal error in DMUMPS_695 ', + & ' LAST and LAST_CALL are incompatible ' + CALL MUMPS_ABORT() + ENDIF + LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 + ICUR = I_CUR_HBUF_NEXTPOS(TYPEF) - 1 + INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF) + ADDR_LAST = AddVirtLibre(TYPEF) + IF (INODE_CUR .NE. MonBloc%INODE) THEN + 10 CONTINUE + ILAST = ICUR + IF ( OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF) .NE. -9999_8) THEN + ADDR_LAST = OOC_VADDR(STEP_OOC(INODE_CUR), TYPEF) + ENDIF + ICUR = ICUR - 1 + INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF) + IF (INODE_CUR .EQ. MonBloc%INODE) THEN + LorUSIZE_OF_BLOCK = ADDR_LAST - + & OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF) + ELSE + IF (ICUR .LE. 1) THEN + WRITE(*,*) "Internal error in DMUMPS_695" + WRITE(*,*) "Did not find current node in sequence" + CALL MUMPS_ABORT() + ENDIF + GOTO 10 + ENDIF + ENDIF + FILESIZE = FILESIZE + LorUSIZE_OF_BLOCK + ENDIF + RETURN + END SUBROUTINE DMUMPS_695 + SUBROUTINE DMUMPS_697( + & STRAT, TYPEF, MonBloc, + & SIZE_PANEL, + & AFAC, LAFAC, + & NextPiv2beWritten, AddVirtCour, + & TailleEcrite, IERR ) + USE DMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, INTENT(IN) :: STRAT, TYPEF, SIZE_PANEL + INTEGER(8) :: LAFAC + INTEGER(8), INTENT(IN) :: AddVirtCour + DOUBLE PRECISION, INTENT(IN) :: AFAC(LAFAC) + INTEGER, INTENT(INOUT) :: NextPiv2beWritten + TYPE(IO_BLOCK),INTENT(INOUT) :: MonBloc + INTEGER(8), INTENT(OUT) :: TailleEcrite + INTEGER, INTENT(OUT) :: IERR + INTEGER :: I, NBeff, LPANELeff, IEND + INTEGER(8) :: AddVirtDeb + IERR = 0 + TailleEcrite = 0_8 + AddVirtDeb = AddVirtCour + I = NextPiv2beWritten + IF ( NextPiv2beWritten .GT. MonBloc%LastPiv ) THEN + RETURN + ENDIF + 10 CONTINUE + NBeff = min(SIZE_PANEL,MonBloc%LastPiv-I+1 ) + IF ((NBeff.NE.SIZE_PANEL) .AND. (.NOT.MonBloc%Last)) THEN + GOTO 20 + ENDIF + IF (TYPEF.EQ.TYPEF_L.AND.MonBloc%MASTER.AND. + & KEEP_OOC(50).EQ.2 .AND. MonBloc%Typenode.NE.3) THEN + IF (MonBloc%INDICES(NBeff+I-1) < 0) + & THEN + NBeff=NBeff+1 + ENDIF + ENDIF + IEND = I + NBeff -1 + CALL DMUMPS_653( STRAT, TYPEF, MonBloc, + & AFAC, LAFAC, + & AddVirtDeb, I, IEND, LPANELeff, + & IERR) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + IF ( IERR .EQ. 1 ) THEN + IERR=0 + GOTO 20 + ENDIF + IF (TYPEF .EQ. TYPEF_L) THEN + MonBloc%LastPanelWritten_L = MonBloc%LastPanelWritten_L+1 + ELSE + MonBloc%LastPanelWritten_U = MonBloc%LastPanelWritten_U+1 + ENDIF + AddVirtDeb = AddVirtDeb + int(LPANELeff,8) + TailleEcrite = TailleEcrite + int(LPANELeff,8) + I=I+NBeff + IF ( I .LE. MonBloc%LastPiv ) GOTO 10 + 20 CONTINUE + NextPiv2beWritten = I + RETURN + END SUBROUTINE DMUMPS_697 + INTEGER(8) FUNCTION DMUMPS_725 + & (NFSorNPIV, NNMAX, SIZE_PANEL, MonBloc, ESTIM) + IMPLICIT NONE + TYPE(IO_BLOCK), INTENT(IN):: MonBloc + INTEGER, INTENT(IN) :: NFSorNPIV, NNMAX, SIZE_PANEL + LOGICAL, INTENT(IN) :: ESTIM + INTEGER :: I, NBeff + INTEGER(8) :: TOTSIZE + TOTSIZE = 0_8 + IF (NFSorNPIV.EQ.0) GOTO 100 + IF (.NOT. MonBloc%MASTER .OR. MonBloc%Typenode.EQ.3) THEN + TOTSIZE = int(NFSorNPIV,8) * int(NNMAX,8) + ELSE + I = 1 + 10 CONTINUE + NBeff = min(SIZE_PANEL, NFSorNPIV-I+1) + IF (KEEP_OOC(50).EQ.2) THEN + IF (ESTIM) THEN + NBeff = NBeff + 1 + ELSE + IF (MonBloc%INDICES(I+NBeff-1) < 0) THEN + NBeff = NBeff + 1 + ENDIF + ENDIF + ENDIF + TOTSIZE = TOTSIZE + + & int(NNMAX-I+1,8) * int(NBeff,8) + I = I + NBeff + IF ( I .LE. NFSorNPIV ) GOTO 10 + ENDIF + 100 CONTINUE + DMUMPS_725 = TOTSIZE + RETURN + END FUNCTION DMUMPS_725 + INTEGER FUNCTION DMUMPS_690( NNMAX ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NNMAX + INTEGER DMUMPS_748 + DMUMPS_690=DMUMPS_748( + & HBUF_SIZE, NNMAX, KEEP_OOC(227),KEEP_OOC(50)) + RETURN + END FUNCTION DMUMPS_690 + SUBROUTINE DMUMPS_728() + IMPLICIT NONE + INTEGER I,TMP_NODE + IF(.NOT.DMUMPS_727())THEN + IF(SOLVE_STEP.EQ.0)THEN + I=CUR_POS_SEQUENCE + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE ((I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND. + & (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + & .EQ.0_8)) + INODE_TO_POS(STEP_OOC(TMP_NODE))=1 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + I=I+1 + IF(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + ENDIF + ENDDO + CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) + ELSE + I=CUR_POS_SEQUENCE + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE ((I.GE.1).AND. + & (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + & .EQ.0_8)) + INODE_TO_POS(STEP_OOC(TMP_NODE))=1 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + I=I-1 + IF(I.GE.1)THEN + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + ENDIF + ENDDO + CUR_POS_SEQUENCE=max(I,1) + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_728 + SUBROUTINE DMUMPS_809(N,KEEP201, + & Pruned_List,nb_prun_nodes,STEP) + IMPLICIT NONE + INTEGER, INTENT(IN) :: N, KEEP201, nb_prun_nodes + INTEGER, INTENT(IN) :: STEP(N), + & Pruned_List(nb_prun_nodes) + INTEGER I, ISTEP + IF (KEEP201 .GT. 0) THEN + OOC_STATE_NODE(:) = ALREADY_USED + DO I = 1, nb_prun_nodes + ISTEP = STEP(Pruned_List(I)) + OOC_STATE_NODE(ISTEP) = NOT_IN_MEM + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_809 + END MODULE DMUMPS_OOC diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_ooc_buffer.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_ooc_buffer.F new file mode 100644 index 000000000..06940eb75 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_ooc_buffer.F @@ -0,0 +1,570 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE DMUMPS_OOC_BUFFER + USE MUMPS_OOC_COMMON + IMPLICIT NONE + PUBLIC + INTEGER FIRST_HBUF,SECOND_HBUF + PARAMETER (FIRST_HBUF=0, SECOND_HBUF=1) + INTEGER,SAVE :: OOC_FCT_TYPE_LOC + INTEGER IO_STRAT + DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE :: BUF_IO + LOGICAL,SAVE :: PANEL_FLAG + INTEGER,SAVE :: EARLIEST_WRITE_MIN_SIZE + INTEGER(8),SAVE,DIMENSION(:), ALLOCATABLE :: + & I_SHIFT_FIRST_HBUF, I_SHIFT_SECOND_HBUF, + & I_SHIFT_CUR_HBUF, I_REL_POS_CUR_HBUF + INTEGER, SAVE, DIMENSION(:), ALLOCATABLE :: + & LAST_IOREQUEST, CUR_HBUF + INTEGER, DIMENSION(:),ALLOCATABLE :: I_CUR_HBUF_NEXTPOS + INTEGER,SAVE :: I_CUR_HBUF_FSTPOS, + & I_SUB_HBUF_FSTPOS + INTEGER(8) :: BufferEmpty + PARAMETER (BufferEmpty=-1_8) + INTEGER(8), DIMENSION(:),ALLOCATABLE :: NextAddVirtBuffer + INTEGER(8), DIMENSION(:),ALLOCATABLE :: FIRST_VADDR_IN_BUF + CONTAINS + SUBROUTINE DMUMPS_689(TYPEF_ARG) + IMPLICIT NONE + INTEGER TYPEF_ARG + SELECT CASE(CUR_HBUF(TYPEF_ARG)) + CASE (FIRST_HBUF) + CUR_HBUF(TYPEF_ARG) = SECOND_HBUF + I_SHIFT_CUR_HBUF(TYPEF_ARG) = + & I_SHIFT_SECOND_HBUF(TYPEF_ARG) + CASE (SECOND_HBUF) + CUR_HBUF(TYPEF_ARG) = FIRST_HBUF + I_SHIFT_CUR_HBUF(TYPEF_ARG) = + & I_SHIFT_FIRST_HBUF(TYPEF_ARG) + END SELECT + IF(.NOT.PANEL_FLAG)THEN + I_SUB_HBUF_FSTPOS =I_CUR_HBUF_FSTPOS + I_CUR_HBUF_FSTPOS =I_CUR_HBUF_NEXTPOS(TYPEF_ARG) + ENDIF + I_REL_POS_CUR_HBUF(TYPEF_ARG) = 1_8 + RETURN + END SUBROUTINE DMUMPS_689 + SUBROUTINE DMUMPS_707(TYPEF_ARG,IERR) + IMPLICIT NONE + INTEGER TYPEF_ARG + INTEGER NEW_IOREQUEST + INTEGER IERR + IERR=0 + CALL DMUMPS_696(TYPEF_ARG,NEW_IOREQUEST, + & IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IERR=0 + CALL MUMPS_WAIT_REQUEST(LAST_IOREQUEST(TYPEF_ARG),IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + LAST_IOREQUEST(TYPEF_ARG) = NEW_IOREQUEST + CALL DMUMPS_689(TYPEF_ARG) + IF(PANEL_FLAG)THEN + NextAddVirtBuffer(TYPEF_ARG)=BufferEmpty + ENDIF + RETURN + END SUBROUTINE DMUMPS_707 + SUBROUTINE DMUMPS_675(IERR) + IMPLICIT NONE + INTEGER, intent(out) :: IERR + INTEGER TYPEF_LAST + INTEGER TYPEF_LOC + IERR = 0 + TYPEF_LAST = OOC_NB_FILE_TYPE + DO TYPEF_LOC = 1, TYPEF_LAST + IERR=0 + CALL DMUMPS_707(TYPEF_LOC,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IERR=0 + CALL DMUMPS_707(TYPEF_LOC,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_675 + SUBROUTINE DMUMPS_696(TYPEF_ARG,IOREQUEST, + & IERR) + IMPLICIT NONE + INTEGER IOREQUEST,IERR + INTEGER TYPEF_ARG + INTEGER FIRST_INODE + INTEGER(8) :: FROM_BUFIO_POS, SIZE + INTEGER TYPE + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER(8) TMP_VADDR + INTEGER SIZE_INT1,SIZE_INT2 + IERR=0 + IF (I_REL_POS_CUR_HBUF(TYPEF_ARG) == 1_8) THEN + IOREQUEST=-1 + RETURN + END IF + IF(PANEL_FLAG)THEN + TYPE=TYPEF_ARG-1 + FIRST_INODE=-9999 + TMP_VADDR=FIRST_VADDR_IN_BUF(TYPEF_ARG) + ELSE + TYPE=FCT + FIRST_INODE = + & OOC_INODE_SEQUENCE(I_CUR_HBUF_FSTPOS,TYPEF_ARG) + TMP_VADDR=OOC_VADDR(STEP_OOC(FIRST_INODE),TYPEF_ARG) + ENDIF + FROM_BUFIO_POS=I_SHIFT_CUR_HBUF(TYPEF_ARG)+1_8 + SIZE = I_REL_POS_CUR_HBUF(TYPEF_ARG)-1_8 + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & TMP_VADDR) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, + & BUF_IO(FROM_BUFIO_POS),SIZE_INT1,SIZE_INT2, + & FIRST_INODE,IOREQUEST, + & TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + RETURN + END SUBROUTINE DMUMPS_696 + SUBROUTINE DMUMPS_669(I1,I2,IERR) + IMPLICIT NONE + INTEGER I1,I2,IERR + INTEGER allocok + IERR=0 + PANEL_FLAG=.FALSE. + IF(allocated(I_SHIFT_FIRST_HBUF))THEN + DEALLOCATE(I_SHIFT_FIRST_HBUF) + ENDIF + IF(allocated(I_SHIFT_SECOND_HBUF))THEN + DEALLOCATE(I_SHIFT_SECOND_HBUF) + ENDIF + IF(allocated(I_SHIFT_CUR_HBUF))THEN + DEALLOCATE(I_SHIFT_CUR_HBUF) + ENDIF + IF(allocated(I_REL_POS_CUR_HBUF))THEN + DEALLOCATE(I_REL_POS_CUR_HBUF) + ENDIF + IF(allocated(LAST_IOREQUEST))THEN + DEALLOCATE(LAST_IOREQUEST) + ENDIF + IF(allocated(CUR_HBUF))THEN + DEALLOCATE(CUR_HBUF) + ENDIF + DIM_BUF_IO = int(KEEP_OOC(100),8) + ALLOCATE(I_SHIFT_FIRST_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(I_SHIFT_SECOND_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(I_SHIFT_CUR_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(I_REL_POS_CUR_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(LAST_IOREQUEST(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(CUR_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + OOC_FCT_TYPE_LOC=OOC_NB_FILE_TYPE + ALLOCATE(BUF_IO(DIM_BUF_IO), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC' + I1 = -13 + CALL MUMPS_731(DIM_BUF_IO, I2) + RETURN + ENDIF + PANEL_FLAG=(KEEP_OOC(201).EQ.1) + IF (PANEL_FLAG) THEN + IERR=0 + KEEP_OOC(228)=0 + IF(allocated(AddVirtLibre))THEN + DEALLOCATE(AddVirtLibre) + ENDIF + ALLOCATE(AddVirtLibre(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC_BUF_PANEL' + IERR=-1 + I1=-13 + I2=OOC_NB_FILE_TYPE + RETURN + ENDIF + AddVirtLibre(1:OOC_NB_FILE_TYPE)=0_8 + IF(allocated(NextAddVirtBuffer))THEN + DEALLOCATE(NextAddVirtBuffer) + ENDIF + ALLOCATE(NextAddVirtBuffer(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC_BUF_PANEL' + IERR=-1 + I1=-13 + I2=OOC_NB_FILE_TYPE + RETURN + ENDIF + NextAddVirtBuffer (1:OOC_NB_FILE_TYPE) = BufferEmpty + IF(allocated(FIRST_VADDR_IN_BUF))THEN + DEALLOCATE(FIRST_VADDR_IN_BUF) + ENDIF + ALLOCATE(FIRST_VADDR_IN_BUF(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in DMUMPS_INIT_OOC_BUF_PANEL' + IERR=-1 + I1=-13 + I2=OOC_NB_FILE_TYPE + RETURN + ENDIF + CALL DMUMPS_686() + ELSE + CALL DMUMPS_685() + ENDIF + RETURN + END SUBROUTINE DMUMPS_669 + SUBROUTINE DMUMPS_659() + IMPLICIT NONE + IF(allocated(BUF_IO))THEN + DEALLOCATE(BUF_IO) + ENDIF + IF(allocated(I_SHIFT_FIRST_HBUF))THEN + DEALLOCATE(I_SHIFT_FIRST_HBUF) + ENDIF + IF(allocated(I_SHIFT_SECOND_HBUF))THEN + DEALLOCATE(I_SHIFT_SECOND_HBUF) + ENDIF + IF(allocated(I_SHIFT_CUR_HBUF))THEN + DEALLOCATE(I_SHIFT_CUR_HBUF) + ENDIF + IF(allocated(I_REL_POS_CUR_HBUF))THEN + DEALLOCATE(I_REL_POS_CUR_HBUF) + ENDIF + IF(allocated(LAST_IOREQUEST))THEN + DEALLOCATE(LAST_IOREQUEST) + ENDIF + IF(allocated(CUR_HBUF))THEN + DEALLOCATE(CUR_HBUF) + ENDIF + IF(PANEL_FLAG)THEN + IF(allocated(NextAddVirtBuffer))THEN + DEALLOCATE(NextAddVirtBuffer) + ENDIF + IF(allocated(AddVirtLibre))THEN + DEALLOCATE(AddVirtLibre) + ENDIF + IF(allocated(FIRST_VADDR_IN_BUF))THEN + DEALLOCATE(FIRST_VADDR_IN_BUF) + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_659 + SUBROUTINE DMUMPS_685() + IMPLICIT NONE + OOC_FCT_TYPE_LOC=1 + HBUF_SIZE = DIM_BUF_IO / int(2,kind=kind(DIM_BUF_IO)) + EARLIEST_WRITE_MIN_SIZE = 0 + I_SHIFT_FIRST_HBUF(OOC_FCT_TYPE_LOC) = 0_8 + I_SHIFT_SECOND_HBUF(OOC_FCT_TYPE_LOC) = HBUF_SIZE + LAST_IOREQUEST(OOC_FCT_TYPE_LOC) = -1 + I_CUR_HBUF_NEXTPOS = 1 + I_CUR_HBUF_FSTPOS = 1 + I_SUB_HBUF_FSTPOS = 1 + CUR_HBUF(OOC_FCT_TYPE_LOC) = SECOND_HBUF + CALL DMUMPS_689(OOC_FCT_TYPE_LOC) + END SUBROUTINE DMUMPS_685 + SUBROUTINE DMUMPS_678(BLOCK,SIZE_OF_BLOCK, + & IERR) + IMPLICIT NONE + INTEGER(8) :: SIZE_OF_BLOCK + DOUBLE PRECISION BLOCK(SIZE_OF_BLOCK) + INTEGER, intent(out) :: IERR + INTEGER(8) :: I + IERR=0 + IF (I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) + + & SIZE_OF_BLOCK <= HBUF_SIZE + 1_8) THEN + ELSE + CALL DMUMPS_707(OOC_FCT_TYPE_LOC,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + END IF + DO I = 1_8, SIZE_OF_BLOCK + BUF_IO(I_SHIFT_CUR_HBUF(OOC_FCT_TYPE_LOC) + + & I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) + I - 1_8) = + & BLOCK(I) + END DO + I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) = + & I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) + SIZE_OF_BLOCK + RETURN + END SUBROUTINE DMUMPS_678 + SUBROUTINE DMUMPS_686() + IMPLICIT NONE + INTEGER(8) :: DIM_BUF_IO_L_OR_U + INTEGER TYPEF, TYPEF_LAST + INTEGER NB_DOUBLE_BUFFERS + TYPEF_LAST = OOC_NB_FILE_TYPE + NB_DOUBLE_BUFFERS = OOC_NB_FILE_TYPE + DIM_BUF_IO_L_OR_U = DIM_BUF_IO / + & int(NB_DOUBLE_BUFFERS,kind=kind(DIM_BUF_IO_L_OR_U)) + IF(.NOT.STRAT_IO_ASYNC)THEN + HBUF_SIZE = DIM_BUF_IO_L_OR_U + ELSE + HBUF_SIZE = DIM_BUF_IO_L_OR_U / 2_8 + ENDIF + DO TYPEF = 1, TYPEF_LAST + LAST_IOREQUEST(TYPEF) = -1 + IF (TYPEF == 1 ) THEN + I_SHIFT_FIRST_HBUF(TYPEF) = 0_8 + ELSE + I_SHIFT_FIRST_HBUF(TYPEF) = DIM_BUF_IO_L_OR_U + ENDIF + IF(.NOT.STRAT_IO_ASYNC)THEN + I_SHIFT_SECOND_HBUF(TYPEF) = I_SHIFT_FIRST_HBUF(TYPEF) + ELSE + I_SHIFT_SECOND_HBUF(TYPEF) = I_SHIFT_FIRST_HBUF(TYPEF) + + & HBUF_SIZE + ENDIF + CUR_HBUF(TYPEF) = SECOND_HBUF + CALL DMUMPS_689(TYPEF) + ENDDO + I_CUR_HBUF_NEXTPOS = 1 + RETURN + END SUBROUTINE DMUMPS_686 + SUBROUTINE DMUMPS_706(TYPEF,IERR) + IMPLICIT NONE + INTEGER, INTENT(in) :: TYPEF + INTEGER, INTENT(out) :: IERR + INTEGER IFLAG + INTEGER NEW_IOREQUEST + IERR=0 + CALL MUMPS_TEST_REQUEST_C(LAST_IOREQUEST(TYPEF),IFLAG, + & IERR) + IF (IFLAG.EQ.1) THEN + IERR = 0 + CALL DMUMPS_696(TYPEF, + & NEW_IOREQUEST, + & IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + LAST_IOREQUEST(TYPEF) = NEW_IOREQUEST + CALL DMUMPS_689(TYPEF) + NextAddVirtBuffer(TYPEF)=BufferEmpty + RETURN + ELSE IF(IFLAG.LT.0)THEN + WRITE(*,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ELSE + IERR = 1 + RETURN + ENDIF + END SUBROUTINE DMUMPS_706 + SUBROUTINE DMUMPS_709 (TYPEF,VADDR) + IMPLICIT NONE + INTEGER(8), INTENT(in) :: VADDR + INTEGER, INTENT(in) :: TYPEF + IF(I_REL_POS_CUR_HBUF(TYPEF).EQ.1_8)THEN + FIRST_VADDR_IN_BUF(TYPEF)=VADDR + ENDIF + RETURN + END SUBROUTINE DMUMPS_709 + SUBROUTINE DMUMPS_653( STRAT, TYPEF, MonBloc, + & AFAC, LAFAC, + & AddVirtCour, IPIVBEG, IPIVEND, LPANELeff, + & IERR) + IMPLICIT NONE + INTEGER, INTENT(IN) :: TYPEF, IPIVBEG, IPIVEND, STRAT + INTEGER(8), INTENT(IN) :: LAFAC + DOUBLE PRECISION, INTENT(IN) :: AFAC(LAFAC) + INTEGER(8), INTENT(IN) :: AddVirtCour + TYPE(IO_BLOCK), INTENT(IN) :: MonBloc + INTEGER, INTENT(OUT):: LPANELeff + INTEGER, INTENT(OUT):: IERR + INTEGER :: II, NBPIVeff + INTEGER(8) :: IPOS, IDIAG, IDEST + INTEGER(8) :: DeltaIPOS + INTEGER :: StrideIPOS + IERR=0 + IF (STRAT.NE.STRAT_WRITE_MAX.AND.STRAT.NE.STRAT_TRY_WRITE) THEN + write(6,*) ' DMUMPS_653: STRAT Not implemented ' + CALL MUMPS_ABORT() + ENDIF + NBPIVeff = IPIVEND - IPIVBEG + 1 + IF (MonBloc%MASTER .AND. MonBloc%Typenode .NE. 3) THEN + IF (TYPEF.EQ.TYPEF_L) THEN + LPANELeff = (MonBloc%NROW-IPIVBEG+1)*NBPIVeff + ELSE + LPANELeff = (MonBloc%NCOL-IPIVBEG+1)*NBPIVeff + ENDIF + ELSE + LPANELeff = MonBloc%NROW*NBPIVeff + ENDIF + IF ( ( I_REL_POS_CUR_HBUF(TYPEF) + int(LPANELeff - 1,8) + & > + & HBUF_SIZE ) + & .OR. + & ( (AddVirtCour.NE.NextAddVirtBuffer(TYPEF)) .AND. + & (NextAddVirtBuffer(TYPEF).NE.BufferEmpty) ) + & ) THEN + IF (STRAT.EQ.STRAT_WRITE_MAX) THEN + CALL DMUMPS_707(TYPEF,IERR) + ELSE IF (STRAT.EQ.STRAT_TRY_WRITE) THEN + CALL DMUMPS_706(TYPEF,IERR) + IF (IERR.EQ.1) RETURN + ELSE + write(6,*) 'DMUMPS_653: STRAT Not implemented' + ENDIF + ENDIF + IF (IERR < 0 ) THEN + RETURN + ENDIF + IF (NextAddVirtBuffer(TYPEF).EQ. BufferEmpty) THEN + CALL DMUMPS_709 (TYPEF,AddVirtCour) + NextAddVirtBuffer(TYPEF) = AddVirtCour + ENDIF + IF (MonBloc%MASTER .AND. MonBloc%Typenode .NE. 3) THEN + IDIAG = int(IPIVBEG-1,8)*int(MonBloc%NCOL,8) + int(IPIVBEG,8) + IPOS = IDIAG + IDEST = I_SHIFT_CUR_HBUF(TYPEF) + + & I_REL_POS_CUR_HBUF(TYPEF) + IF (TYPEF.EQ.TYPEF_L) THEN + DO II = IPIVBEG, IPIVEND + CALL dcopy(MonBloc%NROW-IPIVBEG+1, + & AFAC(IPOS), MonBloc%NCOL, + & BUF_IO(IDEST), 1) + IDEST = IDEST + int(MonBloc%NROW-IPIVBEG+1,8) + IPOS = IPOS + 1_8 + ENDDO + ELSE + DO II = IPIVBEG, IPIVEND + CALL dcopy(MonBloc%NCOL-IPIVBEG+1, + & AFAC(IPOS), 1, + & BUF_IO(IDEST), 1) + IDEST = IDEST + int(MonBloc%NCOL-IPIVBEG+1,8) + IPOS = IPOS + int(MonBloc%NCOL,8) + ENDDO + ENDIF + ELSE + IDEST = I_SHIFT_CUR_HBUF(TYPEF) + + & I_REL_POS_CUR_HBUF(TYPEF) + IF (MonBloc%Typenode.EQ.3) THEN + DeltaIPOS = int(MonBloc%NROW,8) + StrideIPOS = 1 + ELSE + DeltaIPOS = 1_8 + StrideIPOS = MonBloc%NCOL + ENDIF + IPOS = 1_8 + int(IPIVBEG - 1,8) * DeltaIPOS + DO II = IPIVBEG, IPIVEND + CALL dcopy(MonBloc%NROW, + & AFAC(IPOS), StrideIPOS, + & BUF_IO(IDEST), 1) + IDEST = IDEST+int(MonBloc%NROW,8) + IPOS = IPOS + DeltaIPOS + ENDDO + ENDIF + I_REL_POS_CUR_HBUF(TYPEF) = + & I_REL_POS_CUR_HBUF(TYPEF) + int(LPANELeff,8) + NextAddVirtBuffer(TYPEF) = NextAddVirtBuffer(TYPEF) + & + int(LPANELeff,8) + RETURN + END SUBROUTINE DMUMPS_653 + END MODULE DMUMPS_OOC_BUFFER diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part1.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part1.F new file mode 100644 index 000000000..af0b62a6e --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part1.F @@ -0,0 +1,6004 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE DMUMPS( id ) + USE DMUMPS_OOC + USE DMUMPS_STRUC_DEF + IMPLICIT NONE +C matrix in assembled format (ICNTL(5)=0, and ICNTL(18) $\neq$ 3), + INTERFACE + SUBROUTINE DMUMPS_758 + &(idRHS, idINFO, idN, idNRHS, idLRHS) + DOUBLE PRECISION, DIMENSION(:), POINTER :: idRHS + INTEGER, intent(in) :: idN, idNRHS, idLRHS + INTEGER, intent(inout) :: idINFO(:) + END SUBROUTINE DMUMPS_758 + SUBROUTINE DMUMPS_26( id ) + USE DMUMPS_STRUC_DEF + TYPE (DMUMPS_STRUC), TARGET :: id + END SUBROUTINE DMUMPS_26 + SUBROUTINE DMUMPS_142( id ) + USE DMUMPS_STRUC_DEF + TYPE (DMUMPS_STRUC), TARGET :: id + END SUBROUTINE DMUMPS_142 + SUBROUTINE DMUMPS_301( id ) + USE DMUMPS_STRUC_DEF + TYPE (DMUMPS_STRUC), TARGET :: id + END SUBROUTINE DMUMPS_301 + SUBROUTINE DMUMPS_349(id, LP) + USE DMUMPS_STRUC_DEF + TYPE (DMUMPS_STRUC), TARGET, INTENT(IN) :: id + INTEGER :: LP + END SUBROUTINE DMUMPS_349 + END INTERFACE + INCLUDE 'mpif.h' + INTEGER MASTER, IERR + PARAMETER( MASTER = 0 ) + TYPE (DMUMPS_STRUC) :: id + INTEGER JOBMIN, JOBMAX, OLDJOB + INTEGER I, J, MP, LP, MPG, KEEP235SAVE, KEEP242SAVE, + & KEEP243SAVE + LOGICAL LANAL, LFACTO, LSOLVE, PROK, FLAG, PROKG + LOGICAL NOERRORBEFOREPERM + LOGICAL UNS_PERM_DONE + INTEGER COMM_SAVE + INTEGER JOB, N, NZ, NELT + INTEGER, PARAMETER :: ICNTL18DIST_MIN = 1 + INTEGER, PARAMETER :: ICNTL18DIST_MAX = 3 + INTEGER, DIMENSION(:), ALLOCATABLE :: UNS_PERM_INV + NOERRORBEFOREPERM = .FALSE. + UNS_PERM_DONE = .FALSE. + JOB = id%JOB + N = id%N + NZ = id%NZ + NELT = id%NELT + id%INFO(1) = 0 + id%INFO(2) = 0 + IF ( JOB .NE. -1 ) THEN + LP = id%ICNTL(1) + MP = id%ICNTL(2) + MPG = id%ICNTL(3) + PROK = ((MP.GT.0).AND.(id%ICNTL(4).GE.3)) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF (PROKG) THEN + IF (id%ICNTL(5) .NE. 1) THEN + WRITE(MPG,'(A,I4,I12,I15)') + & 'Entering DMUMPS driver with JOB, N, NZ =', JOB,N,NZ + ELSE + WRITE(MPG,'(A,I4,I12,I15)') + & 'Entering DMUMPS driver with JOB, N, NELT =', JOB,N + & ,NELT + ENDIF + ENDIF + ELSE + MPG = 0 + PROK = .FALSE. + PROKG = .FALSE. + LP = 6 + MP = 6 + END IF + CALL MPI_INITIALIZED( FLAG, IERR ) + IF ( .NOT. FLAG ) THEN + WRITE(LP,990) + 990 FORMAT(' Error in DMUMPS initialization: MPI is not running.') + id%INFO(1) = -23 + id%INFO(2) = 0 + GOTO 500 + END IF + COMM_SAVE = id%COMM + CALL MPI_COMM_DUP( COMM_SAVE, id%COMM, IERR ) + CALL MPI_ALLREDUCE(JOB,JOBMIN,1,MPI_INTEGER,MPI_MAX, + & id%COMM,IERR) + CALL MPI_ALLREDUCE(JOB,JOBMAX,1,MPI_INTEGER,MPI_MIN, + & id%COMM,IERR) + IF ( JOBMIN .NE. JOBMAX ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + IF ( JOB .EQ. -1 ) THEN + id%INFO(1)=0 + id%INFO(2)=0 + IF ( id%KEEP(40) .EQ. 1 - 456789 .OR. + & id%KEEP(40) .EQ. 2 - 456789 .OR. + & id%KEEP(40) .EQ. 3 -456789 ) THEN + IF ( id%N > 0 ) THEN + id%INFO(1)=-3 + id%INFO(2)=JOB + ENDIF + ENDIF + CALL MPI_COMM_RANK(id%COMM, id%MYID, IERR) + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) THEN + IF (id%KEEP(201).GT.0) THEN + CALL DMUMPS_587(id, IERR) + ENDIF + GOTO 499 + ENDIF + CALL DMUMPS_163( id ) + GOTO 500 + END IF + IF ( JOB .EQ. -2 ) THEN + id%KEEP(40)= -2 - 456789 + CALL DMUMPS_136( id ) + GOTO 500 + END IF + IF ((JOB.LT.1).OR.(JOB.GT.6)) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + IF (id%MYID.EQ.MASTER) THEN + IF ( id%ICNTL(18) .LT. ICNTL18DIST_MIN + & .OR. id%ICNTL(18) .GT. ICNTL18DIST_MAX ) THEN + IF ((N.LE.0).OR.((N+N+N)/3.NE.N)) THEN + id%INFO(1) = -16 + id%INFO(2) = N + END IF + IF (id%ICNTL(5).NE.1) THEN + IF (NZ.LE.0) THEN + id%INFO(1) = -2 + id%INFO(2) = NZ + END IF + ELSE + IF (NELT.LE.0) THEN + id%INFO(1) = -24 + id%INFO(2) = NELT + END IF + ENDIF + END IF + IF ( (id%KEEP(46).EQ.0).AND.(id%NPROCS.LE.1) ) + & THEN + id%INFO(1) = -21 + id%INFO(2) = id%NPROCS + ENDIF + END IF + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) GOTO 499 + LANAL = .FALSE. + LFACTO = .FALSE. + LSOLVE = .FALSE. + IF ((JOB.EQ.1).OR.(JOB.EQ.4).OR. + & (JOB.EQ.6)) LANAL = .TRUE. + IF ((JOB.EQ.2).OR.(JOB.EQ.4).OR. + & (JOB.EQ.5).OR.(JOB.EQ.6)) LFACTO = .TRUE. + IF ((JOB.EQ.3).OR.(JOB.EQ.5).OR. + & (JOB.EQ.6)) LSOLVE = .TRUE. + IF (MP.GT.0) CALL DMUMPS_349(id, MP) + OLDJOB = id%KEEP( 40 ) + 456789 + IF ( LANAL ) THEN + IF ( OLDJOB .EQ. 0 .OR. OLDJOB .GT. 3 .OR. OLDJOB .LT. -1 ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + IF ( OLDJOB .GE. 2 ) THEN + IF (associated(id%IS)) THEN + DEALLOCATE (id%IS) + NULLIFY (id%IS) + END IF + IF (associated(id%S)) THEN + DEALLOCATE (id%S) + NULLIFY (id%S) + END IF + END IF + END IF + IF ( LFACTO ) THEN + IF ( OLDJOB .LT. 1 .and. .NOT. LANAL ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + END IF + IF ( LSOLVE ) THEN + IF ( OLDJOB .LT. 2 .AND. .NOT. LFACTO ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + END IF +#if ! defined (LARGEMATRICES) + NOERRORBEFOREPERM =.TRUE. + UNS_PERM_DONE=.FALSE. + IF (id%MYID .eq. MASTER .AND. id%KEEP(23) .NE. 0) THEN + IF ( id%JOB .EQ. 2 .OR. id%JOB .EQ. 5 .OR. + & (id%JOB .EQ. 3 .AND. (id%ICNTL(10) .NE.0 .OR. + & id%ICNTL(11).NE. 0))) THEN + UNS_PERM_DONE = .TRUE. + ALLOCATE(UNS_PERM_INV(id%N),stat=IERR) + IF (IERR .GT. 0) THEN + id%INFO(1)=-13 + id%INFO(2)=id%N + IF (id%ICNTL(1) .GT. 0 .AND. id%ICNTL(4) .GE.1) THEN + WRITE(id%ICNTL(2),99993) + END IF + GOTO 510 + ENDIF + DO I = 1, id%N + UNS_PERM_INV(id%UNS_PERM(I))=I + END DO + DO I = 1, id%NZ + J = id%JCN(I) + IF (J.LE.0.OR.J.GT.id%N) CYCLE + id%JCN(I)=UNS_PERM_INV(J) + END DO + DEALLOCATE(UNS_PERM_INV) + END IF + END IF +#endif + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499 + IF (LANAL) THEN + id%KEEP(40)=-1 -456789 + IF (id%MYID.EQ.MASTER) THEN + id%INFOG(7) = -9999 + id%INFOG(23) = 0 + id%INFOG(24) = 1 + IF (associated(id%IS1)) DEALLOCATE(id%IS1) + IF ( id%ICNTL(5) .NE. 1 ) THEN + IF ( id%KEEP(50) .NE. 1 + & .AND. ( + & (id%ICNTL(6) .NE. 0 .AND. id%ICNTL(7) .NE.1) + & .OR. + & id%ICNTL(12) .NE. 1) ) THEN + id%MAXIS1 = 11 * N + ELSE + id%MAXIS1 = 10 * N + END IF + ELSE + id%MAXIS1 = 6 * N + 2 * NELT + 2 + ENDIF + ALLOCATE( id%IS1(id%MAXIS1), stat=IERR ) + IF (IERR.gt.0) THEN + id%INFO(1) = -7 + id%INFO(2) = id%MAXIS1 + IF ( LP .GT.0 ) + & WRITE(LP,*) 'Problem in allocating work array for analysis.' + GO TO 100 + END IF + IF ( associated( id%PROCNODE ) ) + & DEALLOCATE( id%PROCNODE ) + ALLOCATE( id%PROCNODE(id%N), stat=IERR ) + IF (IERR.gt.0) THEN + id%INFO(1) = -7 + id%INFO(2) = id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) 'Problem in allocating work array PROCNODE' + END IF + GOTO 100 + END IF + id%PROCNODE(1:id%N) = 0 + IF ( id%ICNTL(5) .EQ. 1 ) THEN + IF ( associated( id%ELTPROC ) ) + & DEALLOCATE( id%ELTPROC ) + ALLOCATE( id%ELTPROC(id%NELT), stat=IERR ) + IF (IERR.gt.0) THEN + id%INFO(1) = -7 + id%INFO(2) = id%NELT + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) 'Problem in allocating work array ELTPROC' + END IF + GOTO 100 + END IF + END IF + IF ( id%ICNTL(5) .NE. 1 ) THEN + id%NA_ELT=0 + IF ( id%ICNTL(18) .LT. ICNTL18DIST_MIN + & .OR. id%ICNTL(18) .GT. ICNTL18DIST_MAX ) THEN + IF ( .not. associated( id%IRN ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( size( id%IRN ) < id%NZ ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( .not. associated( id%JCN ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + ELSE IF ( size( id%JCN ) < id%NZ ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + END IF + END IF + IF ( id%INFO( 1 ) .eq. -22 ) THEN + IF (LP.GT.0) WRITE(LP,*) + & 'Error in analysis: IRN/JCN badly allocated.' + END IF + ELSE + IF ( .not. associated( id%ELTPTR ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( size( id%ELTPTR ) < id%NELT+1 ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( .not. associated( id%ELTVAR ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + ELSE + id%LELTVAR = id%ELTPTR( id%NELT+1 ) - 1 + IF ( size( id%ELTVAR ) < id%LELTVAR ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + ELSE + id%NA_ELT = 0 + IF ( id%KEEP(50) .EQ. 0 ) THEN + DO I = 1,NELT + J = id%ELTPTR(I+1) - id%ELTPTR(I) + J = (J * J) + id%NA_ELT = id%NA_ELT + J + ENDDO + ELSE + DO I = 1,NELT + J = id%ELTPTR(I+1) - id%ELTPTR(I) + J = (J * (J+1))/2 + id%NA_ELT = id%NA_ELT + J + ENDDO + ENDIF + ENDIF + END IF + IF ( id%INFO( 1 ) .eq. -22 ) THEN + IF (LP.GT.0) WRITE(LP,*) + & 'Error in analysis: ELTPTR/ELTVAR badly allocated.' + END IF + ENDIF + 100 CONTINUE + END IF + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499 + id%KEEP(52) = id%ICNTL(8) + IF ( id%KEEP(52) .GT. 8 .OR. id%KEEP(52).LT.-2) + & id%KEEP(52) = 77 + IF ((id%KEEP(52).EQ.77).AND.(id%KEEP(50).EQ.1)) THEN + id%KEEP(52) = 0 + ENDIF + IF ( id%KEEP(52).EQ.77 .OR. id%KEEP(52).LE.-2) THEN + IF (.not.associated(id%A)) id%KEEP(52) = 0 + ENDIF + IF(id%KEEP(52) .EQ. -1) id%KEEP(52) = 0 + CALL DMUMPS_26( id ) + IF (id%MYID .eq. MASTER) THEN + IF (id%KEEP(52) .NE. 0) THEN + id%INFOG(33)=id%KEEP(52) + ELSE + id%INFOG(33)=id%ICNTL(8) + ENDIF + ENDIF + IF (id%MYID .eq. MASTER) id%INFOG(24)=id%KEEP(95) + IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499 + id%KEEP(40) = 1 -456789 + END IF + IF (LFACTO) THEN + id%KEEP(40) = 1 - 456789 + IF ( id%MYID .EQ. MASTER ) THEN + IF (id%KEEP(60).EQ.1) THEN + IF ( associated( id%SCHUR_CINTERFACE)) THEN + id%SCHUR=>id%SCHUR_CINTERFACE + & (1:id%SIZE_SCHUR*id%SIZE_SCHUR) + ENDIF + IF ( .NOT. associated (id%SCHUR)) THEN + IF (LP.GT.0) + & write(LP,'(A)') + & ' SCHUR not associated' + id%INFO(1)=-22 + id%INFO(2)=9 + ELSE IF ( size(id%SCHUR) .LT. + & id%SIZE_SCHUR * id%SIZE_SCHUR ) THEN + IF (LP.GT.0) + & write(LP,'(A)') + & ' SCHUR allocated but too small' + id%INFO(1)=-22 + id%INFO(2)=9 + END IF + END IF + IF ( id%KEEP(55) .EQ. 0 ) THEN + IF ( id%KEEP(54).eq.0 ) THEN + IF ( .not. associated( id%A ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + ELSE IF ( size( id%A ) < id%NZ ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + END IF + END IF + ELSE + IF ( .not. associated( id%A_ELT ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + ELSE + IF ( size( id%A_ELT ) < id%NA_ELT ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + ENDIF + END IF + ENDIF + CALL MUMPS_633(id%KEEP(12),id%ICNTL(14), + & id%KEEP(50),id%KEEP(54),id%ICNTL(6),id%ICNTL(8)) + CALL DMUMPS_635(N,id%KEEP(1),id%ICNTL(1),MPG) + IF( id%KEEP(52) .EQ. -2 .AND. id%ICNTL(8) .NE. -2 .AND. + & id%ICNTL(8).NE. 77 ) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** WARNING : SCALING' + WRITE(MPG,'(A)') + & ' ** scaling already computed during analysis' + WRITE(MPG,'(A)') + & ' ** keeping the scaling from the analysis' + ENDIF + ENDIF + IF (id%KEEP(52) .NE. -2) THEN + id%KEEP(52)=id%ICNTL(8) + ENDIF + IF ( id%KEEP(52) .GT. 8 .OR. id%KEEP(52).LT.-2) + & id%KEEP(52) = 77 + IF (id%KEEP(52).EQ.77) THEN + IF (id%KEEP(50).EQ.1) THEN + id%KEEP(52) = 0 + ELSE + id%KEEP(52) = 7 + ENDIF + ENDIF + IF (id%KEEP(23) .NE. 0 .AND. id%ICNTL(8) .EQ. -1) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** WARNING : SCALING' + WRITE(MPG,'(A)') + & ' ** column permutation applied:' + WRITE(MPG,'(A)') + & ' ** column scaling has to be permuted' + ENDIF + ENDIF + IF ( id%KEEP( 19 ) .ne. 0 .and. id%KEEP( 52 ).ne. 0 ) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.' + WRITE(MPG,'(A)') ' ** (incompatibility with null space)' + END IF + id%KEEP(52) = 0 + END IF + IF ( id%KEEP(60) .ne. 0 .and. id%KEEP(52) .ne. 0 ) THEN + id%KEEP(52) = 0 + IF ( MPG .GT. 0 .AND. id%ICNTL(8) .NE. 0 ) THEN + WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.' + WRITE(MPG,'(A)') ' ** (incompatibility with Schur)' + END IF + END IF + IF (id%KEEP(54) .NE. 0 .AND. + & id%KEEP(52).NE.7 .AND. id%KEEP(52).NE.8 .AND. + & id%KEEP(52) .NE. 0 ) THEN + id%KEEP(52) = 0 + IF ( MPG .GT. 0 .and. id%ICNTL(8) .ne. 0 ) THEN + WRITE(MPG,'(A)') + & ' ** Warning: This scaling option not available' + WRITE(MPG,'(A)') ' ** for distributed matrix entry' + END IF + END IF + IF ( id%KEEP(50) .NE. 0 ) THEN + IF ( id%KEEP(52).ne. 1 .and. + & id%KEEP(52).ne. -1 .and. + & id%KEEP(52).ne. 0 .and. + & id%KEEP(52).ne. 7 .and. + & id%KEEP(52).ne. 8 .and. + & id%KEEP(52).ne. -2 .and. + & id%KEEP(52).ne. 77) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') + & ' ** Warning: Scaling option n.a. for symmetric matrix' + END IF + id%KEEP(52) = 0 + END IF + END IF + IF (id%KEEP(55) .NE. 0 .AND. + & ( id%KEEP(52) .gt. 0 ) ) THEN + id%KEEP(52) = 0 + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.' + WRITE(MPG,'(A)') + & ' ** (only user scaling av. for elt. entry)' + END IF + END IF + IF ( id%KEEP(52) .eq. -1 ) THEN + IF ( .not. associated( id%ROWSCA ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 5 + ELSE IF ( size( id%ROWSCA ) < id%N ) THEN + id%INFO(1) = -22 + id%INFO(2) = 5 + ELSE IF ( .not. associated( id%COLSCA ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 6 + ELSE IF ( size( id%COLSCA ) < id%N ) THEN + id%INFO(1) = -22 + id%INFO(2) = 6 + END IF + END IF + IF (id%KEEP(52).GT.0 .AND. + & id%KEEP(52) .LE.8) THEN + IF ( associated(id%COLSCA)) + & DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) + & DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=IERR) + IF (IERR .GT.0) id%INFO(1)=-13 + ALLOCATE( id%ROWSCA(N), stat=IERR) + IF (IERR .GT.0) id%INFO(1)=-13 + END IF + IF (.NOT. associated(id%COLSCA)) THEN + ALLOCATE( id%COLSCA(1), stat=IERR) + END IF + IF (IERR .GT.0) id%INFO(1)=-13 + IF (.NOT. associated(id%ROWSCA)) + & ALLOCATE( id%ROWSCA(1), stat=IERR) + IF (IERR .GT.0) id%INFO(1)=-13 + IF ( id%INFO(1) .eq. -13 ) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*) 'Problems in allocations before facto' + GOTO 200 + END IF + IF (id%KEEP(252) .EQ. 1) THEN + CALL DMUMPS_758 + & (id%RHS,id%INFO,id%N,id%NRHS,id%LRHS) + CALL DMUMPS_807(id) + CALL DMUMPS_769(id) + ENDIF + 200 CONTINUE + END IF + CALL MPI_BCAST( id%KEEP(221), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + IF (id%KEEP(60).EQ.2.OR.id%KEEP(60).EQ.3) THEN + IF ( id%root%yes ) THEN + IF ( associated( id%SCHUR_CINTERFACE )) THEN + id%SCHUR=>id%SCHUR_CINTERFACE + & (1:id%SCHUR_LLD*(id%root%SCHUR_NLOC-1)+ + & id%root%SCHUR_MLOC) + ENDIF + IF (id%SCHUR_LLD < id%root%SCHUR_MLOC) THEN + IF (LP.GT.0) write(LP,*) + & ' SCHUR leading dimension SCHUR_LLD ', + & id%SCHUR_LLD, 'too small with respect to', + & id%root%SCHUR_MLOC + id%INFO(1)=-30 + id%INFO(2)=id%SCHUR_LLD + ELSE IF ( .NOT. associated (id%SCHUR)) THEN + IF (LP.GT.0) write(LP,'(A)') + & ' SCHUR not associated' + id%INFO(1)=-22 + id%INFO(2)=9 + ELSE IF (size(id%SCHUR) < + & id%SCHUR_LLD*(id%root%SCHUR_NLOC-1)+ + & id%root%SCHUR_MLOC) THEN + IF (LP.GT.0) THEN + write(LP,'(A)') + & ' SCHUR allocated but too small' + write(LP,*) id%MYID, ' : Size Schur=', + & size(id%SCHUR), + & ' SCHUR_LLD= ', id%SCHUR_LLD, + & ' SCHUR_MLOC=', id%root%SCHUR_NLOC, + & ' SCHUR_NLOC=', id%root%SCHUR_NLOC + ENDIF + id%INFO(1)=-22 + id%INFO(2)= 9 + ELSE + id%root%SCHUR_LLD=id%SCHUR_LLD + IF (id%root%SCHUR_NLOC==0) THEN + ALLOCATE(id%root%SCHUR_POINTER(1)) + ELSE + id%root%SCHUR_POINTER=>id%SCHUR + ENDIF + ENDIF + ENDIF + ENDIF + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) GO TO 499 + CALL DMUMPS_142(id) + IF (id%MYID .eq. MASTER) id%INFOG(33)=id%KEEP(52) + IF (id%KEEP(60).EQ.2.OR.id%KEEP(60).EQ.3) THEN + IF (id%root%yes) THEN + IF (id%root%SCHUR_NLOC==0) THEN + DEALLOCATE(id%root%SCHUR_POINTER) + NULLIFY(id%root%SCHUR_POINTER) + ELSE + NULLIFY(id%root%SCHUR_POINTER) + ENDIF + ENDIF + ENDIF + IF ( id%INFO(1) .LT. 0 ) GO TO 499 + id%KEEP(40) = 2 - 456789 + END IF + IF (LSOLVE) THEN + id%KEEP(40) = 2 -456789 + IF (id%MYID .eq. MASTER) THEN + KEEP235SAVE = id%KEEP(235) + KEEP242SAVE = id%KEEP(242) + KEEP243SAVE = id%KEEP(243) + IF (id%KEEP(242).EQ.0) id%KEEP(243)=0 + ENDIF + CALL DMUMPS_301(id) + IF (id%MYID .eq. MASTER) THEN + id%KEEP(235) = KEEP235SAVE + id%KEEP(242) = KEEP242SAVE + id%KEEP(243) = KEEP243SAVE + ENDIF + IF (id%INFO(1).LT.0) GOTO 499 + id%KEEP(40) = 3 -456789 + ENDIF + IF (MP.GT.0) CALL DMUMPS_349(id, MP) + GOTO 500 + 499 PROK = ((id%ICNTL(1).GT.0).AND. + & (id%ICNTL(4).GE.1)) + IF (PROK) WRITE (id%ICNTL(1),99995) id%INFO(1) + IF (PROK) WRITE (id%ICNTL(1),99994) id%INFO(2) +500 CONTINUE +#if ! defined(LARGEMATRICES) + IF (id%MYID .eq. MASTER .AND. id%KEEP(23) .NE. 0 + & .AND. NOERRORBEFOREPERM) THEN + IF (id%JOB .NE. 3 .OR. UNS_PERM_DONE) THEN + DO I = 1, id%NZ + J=id%JCN(I) + IF (J.LE.0.OR.J.GT.id%N) CYCLE + id%JCN(I)=id%UNS_PERM(J) + END DO + END IF + END IF +#endif + 510 CONTINUE + CALL DMUMPS_300(id%INFO(1), id%INFOG(1), id%COMM, id%MYID) + CALL MPI_BCAST( id%RINFOG(1), 40, MPI_DOUBLE_PRECISION, MASTER, + & id%COMM, IERR ) + IF (id%MYID.EQ.MASTER.and.MPG.GT.0.and. + & id%INFOG(1).lt.0) THEN + WRITE(MPG,'(A,I12)') ' On return from DMUMPS, INFOG(1)=', + & id%INFOG(1) + WRITE(MPG,'(A,I12)') ' On return from DMUMPS, INFOG(2)=', + & id%INFOG(2) + END IF + CALL MPI_COMM_FREE( id%COMM, IERR ) + id%COMM = COMM_SAVE + RETURN +99995 FORMAT (' ** ERROR RETURN ** FROM DMUMPS INFO(1)=', I3) +99994 FORMAT (' ** INFO(2)=', I10) +99993 FORMAT (' ** Allocation error: could not permute JCN.') + END SUBROUTINE DMUMPS + SUBROUTINE DMUMPS_300( INFO, INFOG, COMM, MYID ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER INFO(40), INFOG(40), COMM, MYID + INTEGER TMP1(2),TMP(2) + INTEGER ROOT, IERR + INTEGER MASTER + PARAMETER (MASTER=0) + IF ( INFO(1) .ge. 0 .and. INFO(2) .ge. 0 ) THEN + INFOG(1) = INFO(1) + INFOG(2) = INFO(2) + ELSE + INFOG(1) = INFO(1) + TMP1(1) = INFO(1) + TMP1(2) = MYID + CALL MPI_ALLREDUCE(TMP1,TMP,1,MPI_2INTEGER, + & MPI_MINLOC,COMM,IERR ) + INFOG(2) = INFO(2) + ROOT = TMP(2) + CALL MPI_BCAST( INFOG(1), 1, MPI_INTEGER, ROOT, COMM, IERR ) + CALL MPI_BCAST( INFOG(2), 1, MPI_INTEGER, ROOT, COMM, IERR ) + END IF + CALL MPI_BCAST(INFOG(3), 38, MPI_INTEGER, MASTER, COMM, IERR ) + RETURN + END SUBROUTINE DMUMPS_300 + SUBROUTINE DMUMPS_349(id, LP) + USE DMUMPS_STRUC_DEF + TYPE (DMUMPS_STRUC), TARGET, INTENT(IN) :: id + INTEGER :: LP + INTEGER, POINTER :: JOB + INTEGER,DIMENSION(:),POINTER::ICNTL + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (LP.LT.0) RETURN + JOB=>id%JOB + ICNTL=>id%ICNTL + IF (id%MYID.EQ.MASTER) THEN + SELECT CASE (JOB) + CASE(1); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) ICNTL(5),ICNTL(6),ICNTL(7),ICNTL(12), + & ICNTL(13),ICNTL(18),ICNTL(19),ICNTL(22) + IF ((ICNTL(6).EQ.5).OR.(ICNTL(6).EQ.6).OR. + & (ICNTL(12).NE.1) ) THEN + WRITE (LP,992) ICNTL(8) + ENDIF + IF (id%ICNTL(19).NE.0) + & WRITE(LP,998) id%SIZE_SCHUR + WRITE (LP,993) ICNTL(14) + CASE(2); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,992) ICNTL(8) + WRITE (LP,993) ICNTL(14) + CASE(3); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + CASE(4); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,992) ICNTL(8) + IF (id%ICNTL(19).NE.0) + & WRITE(LP,998) id%SIZE_SCHUR + WRITE (LP,993) ICNTL(14) + CASE(5); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) ICNTL(5),ICNTL(6),ICNTL(7),ICNTL(12), + & ICNTL(13),ICNTL(18),ICNTL(19),ICNTL(22) + WRITE (LP,992) ICNTL(8) + WRITE (LP,993) ICNTL(14) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + CASE(6); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) ICNTL(5),ICNTL(6),ICNTL(7),ICNTL(12), + & ICNTL(13),ICNTL(18),ICNTL(19),ICNTL(22) + IF (id%ICNTL(19).NE.0) + & WRITE(LP,998) id%SIZE_SCHUR + WRITE (LP,992) ICNTL(8) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + WRITE (LP,993) ICNTL(14) + END SELECT + ENDIF + 980 FORMAT (/'***********CONTROL PARAMETERS (ICNTL)**************'/) + 990 FORMAT ( + & 'ICNTL(1) Output stream for error messages =',I10/ + & 'ICNTL(2) Output stream for diagnostic messages =',I10/ + & 'ICNTL(3) Output stream for global information =',I10/ + & 'ICNTL(4) Level of printing =',I10) + 991 FORMAT ( + & 'ICNTL(5) Matrix format ( keep(55) ) =',I10/ + & 'ICNTL(6) Maximum transversal ( keep(23) ) =',I10/ + & 'ICNTL(7) Ordering =',I10/ + & 'ICNTL(12) LDLT ordering strat ( keep(95) ) =',I10/ + & 'ICNTL(13) Parallel root (0=on, 1=off) =',I10/ + & 'ICNTL(18) Distributed matrix ( keep(54) ) =',I10/ + & 'ICNTL(19) Schur option ( keep(60) 0=off,else=on ) =',I10/ + & 'ICNTL(22) Out-off-core option (0=Off, >0=ON) =',I10) + 992 FORMAT ( + & 'ICNTL(8) Scaling strategy =',I10) + 993 FORMAT ( + & 'ICNTL(14) Percent of memory increase =',I10) + 995 FORMAT ( + & 'ICNTL(9) Solve A x=b (1) or A''x = b (else) =',I10/ + & 'ICNTL(10) Max steps iterative refinement =',I10/ + & 'ICNTL(11) Error analysis ( 0= off, else=on) =',I10) + 998 FORMAT ( + & ' Size of SCHUR matrix (SIZE_SHUR) =',I10) + END SUBROUTINE DMUMPS_349 + SUBROUTINE DMUMPS_350(id, LP) + USE DMUMPS_STRUC_DEF + TYPE (DMUMPS_STRUC), TARGET, INTENT(IN) :: id + INTEGER ::LP + INTEGER, POINTER :: JOB + INTEGER,DIMENSION(:),POINTER::ICNTL, KEEP + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (LP.LT.0) RETURN + JOB=>id%JOB + ICNTL=>id%ICNTL + KEEP=>id%KEEP + IF (id%MYID.EQ.MASTER) THEN + SELECT CASE (JOB) + CASE(1); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + IF ((KEEP(23).EQ.5).OR.(KEEP(23).EQ.6))THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,993) KEEP(12) + CASE(2); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + IF (KEEP(23).EQ.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,993) KEEP(12) + CASE(3); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + CASE(4); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + IF (KEEP(23).NE.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + WRITE (LP,993) KEEP(12) + CASE(5); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + IF ((KEEP(23).EQ.5).OR.(KEEP(23).EQ.6) + & .OR. (KEEP(23).EQ.7)) THEN + WRITE (LP,992) KEEP(52) + ENDIF + IF (KEEP(23).EQ.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,993) KEEP(12) + CASE(6); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + IF ((KEEP(23).EQ.5).OR.(KEEP(23).EQ.6) + & .OR. (KEEP(23).EQ.7)) THEN + WRITE (LP,992) KEEP(52) + ENDIF + IF (KEEP(23).EQ.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),KEEP(248),ICNTL(21) + WRITE (LP,993) KEEP(12) + END SELECT + ENDIF + 980 FORMAT (/'******INTERNAL VALUE OF PARAMETERS (ICNTL/KEEP)****'/) + 990 FORMAT ( + & 'ICNTL(1) Output stream for error messages =',I10/ + & 'ICNTL(2) Output stream for diagnostic messages =',I10/ + & 'ICNTL(3) Output stream for global information =',I10/ + & 'ICNTL(4) Level of printing =',I10) + 991 FORMAT ( + & 'ICNTL(5) Matrix format ( keep(55) ) =',I10/ + & 'ICNTL(6) Maximum transversal ( keep(23) ) =',I10/ + & 'ICNTL(7) Ordering =',I10/ + & 'ICNTL(12) LDLT ordering strat ( keep(95) ) =',I10/ + & 'ICNTL(13) Parallel root (0=on, 1=off) =',I10/ + & 'ICNTL(18) Distributed matrix ( keep(54) ) =',I10/ + & 'ICNTL(19) Schur option ( keep(60) 0=off,else=on ) =',I10/ + & 'ICNTL(22) Out-off-core option (0=Off, >0=ON) =',I10) + 992 FORMAT ( + & 'ICNTL(8) Scaling strategy ( keep(52) ) =',I10) + 993 FORMAT ( + & 'ICNTL(14) Percent of memory increase ( keep(12) ) =',I10) + 995 FORMAT ( + & 'ICNTL(9) Solve A x=b (1) or A''x = b (else) =',I10/ + & 'ICNTL(10) Max steps iterative refinement =',I10/ + & 'ICNTL(11) Error analysis ( 0= off, else=on) =',I10/ + & 'ICNTL(20) Dense (0) or sparse (1) RHS =',I10/ + & 'ICNTL(21) Gathered (0) or distributed(1) solution =',I10) + END SUBROUTINE DMUMPS_350 + SUBROUTINE DMUMPS_758 + & (idRHS, idINFO, idN, idNRHS, idLRHS) + IMPLICIT NONE + DOUBLE PRECISION, DIMENSION(:), POINTER :: idRHS + INTEGER, intent(in) :: idN, idNRHS, idLRHS + INTEGER, intent(inout) :: idINFO(:) + IF ( .not. associated( idRHS ) ) THEN + idINFO( 1 ) = -22 + idINFO( 2 ) = 7 + ELSE IF (idNRHS.EQ.1) THEN + IF ( size( idRHS ) < idN ) THEN + idINFO( 1 ) = -22 + idINFO( 2 ) = 7 + ENDIF + ELSE IF (idLRHS < idN) + & THEN + idINFO( 1 ) = -26 + idINFO( 2 ) = idLRHS + ELSE IF + & (size(idRHS)<(idNRHS*idLRHS-idLRHS+idN)) + & THEN + idINFO( 1 ) = -22 + idINFO( 2 ) = 7 + END IF + RETURN + END SUBROUTINE DMUMPS_758 + SUBROUTINE DMUMPS_807(id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (DMUMPS_STRUC) :: id + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (id%MYID.EQ.MASTER) THEN + id%KEEP(221)=id%ICNTL(26) + IF (id%KEEP(221).ne.0 .and. id%KEEP(221) .NE.1 + & .AND.id%KEEP(221).ne.2) id%KEEP(221)=0 + ENDIF + RETURN + END SUBROUTINE DMUMPS_807 + SUBROUTINE DMUMPS_769(id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (DMUMPS_STRUC) :: id + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (id%MYID .EQ. MASTER) THEN + IF ( id%KEEP(221) == 1 .or. id%KEEP(221) == 2 ) THEN + IF (id%KEEP(221) == 2 .and. id%JOB == 2) THEN + id%INFO(1)=-35 + id%INFO(2)=id%KEEP(221) + GOTO 333 + ENDIF + IF (id%KEEP(221) == 1 .and. id%KEEP(252) == 1 + & .and. id%JOB == 3) THEN + id%INFO(1)=-35 + id%INFO(2)=id%KEEP(221) + ENDIF + IF ( id%KEEP(60).eq. 0 .or. id%SIZE_SCHUR.EQ.0 ) THEN + id%INFO(1)=-33 + id%INFO(2)=id%KEEP(221) + GOTO 333 + ENDIF + IF ( .NOT. associated( id%REDRHS)) THEN + id%INFO(1)=-22 + id%INFO(2)=15 + GOTO 333 + ELSE IF (id%NRHS.EQ.1) THEN + IF (size(id%REDRHS) < id%SIZE_SCHUR ) THEN + id%INFO(1)=-22 + id%INFO(2)=15 + GOTO 333 + ENDIF + ELSE IF (id%LREDRHS < id%SIZE_SCHUR) THEN + id%INFO(1)=-34 + id%INFO(2)=id%LREDRHS + GOTO 333 + ELSE IF + & (size(id%REDRHS)< + & id%NRHS*id%LREDRHS-id%LREDRHS+id%SIZE_SCHUR) + & THEN + id%INFO(1)=-22 + id%INFO(2)=15 + GOTO 333 + ENDIF + ENDIF + ENDIF + 333 CONTINUE + RETURN + END SUBROUTINE DMUMPS_769 + SUBROUTINE DMUMPS_24( MYID, SLAVEF, N, + & PROCNODE, STEP, PTRAIW, PTRARW, ISTEP_TO_INIV2, + & I_AM_CAND, + & KEEP, KEEP8, ICNTL, id ) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (DMUMPS_STRUC) :: id + INTEGER MYID, N, SLAVEF + INTEGER KEEP( 500 ), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE( KEEP(28) ), STEP( N ), + & PTRAIW( N ), PTRARW( N ) + INTEGER ISTEP_TO_INIV2(KEEP(71)) + LOGICAL I_AM_CAND(max(1,KEEP(56))) + LOGICAL I_AM_SLAVE + LOGICAL I_AM_CAND_LOC + INTEGER MUMPS_330, MUMPS_275, MUMPS_810 + EXTERNAL MUMPS_330, MUMPS_275, MUMPS_810 + INTEGER ISTEP, I, IPTRI, IPTRR, NCOL, NROW, allocok + INTEGER TYPE_PARALL, ITYPE, IRANK, INIV2, TYPESPLIT + LOGICAL T4_MASTER_CONCERNED + TYPE_PARALL = KEEP(46) + I_AM_SLAVE = (KEEP(46).EQ.1 .OR. MYID.NE.0) + KEEP(14) = 0 + KEEP(13) = 0 + DO I = 1, N + ISTEP=abs(STEP(I)) + ITYPE = MUMPS_330( PROCNODE(ISTEP), SLAVEF ) + IRANK = MUMPS_275( PROCNODE(ISTEP), SLAVEF ) + TYPESPLIT = MUMPS_810 ( PROCNODE(ISTEP), SLAVEF ) + I_AM_CAND_LOC = .FALSE. + T4_MASTER_CONCERNED = .FALSE. + IF (ITYPE.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF (I_AM_SLAVE) THEN + I_AM_CAND_LOC = I_AM_CAND(INIV2) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + IF ( TYPE_PARALL .eq. 0 ) THEN + T4_MASTER_CONCERNED = + & ( id%CANDIDATES (id%CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + & .EQ.MYID-1 ) + ELSE + T4_MASTER_CONCERNED = + & ( id%CANDIDATES (id%CANDIDATES(SLAVEF+1, INIV2)+1,INIV2 ) + & .EQ.MYID ) + ENDIF + ENDIF + ENDIF + ENDIF + IF ( TYPE_PARALL .eq. 0 ) THEN + IRANK = IRANK + 1 + END IF + IF ( + & ( (ITYPE .EQ. 1.OR.ITYPE.EQ.2) .AND. + & IRANK .EQ. MYID ) + & .OR. + & ( T4_MASTER_CONCERNED ) + & ) THEN + KEEP( 14 ) = KEEP( 14 ) + 3 + PTRAIW( I ) + PTRARW( I ) + KEEP( 13 ) = KEEP( 13 ) + 1 + PTRAIW( I ) + PTRARW( I ) + ELSE IF ( ITYPE .EQ. 3 ) THEN + ELSE IF ( ITYPE .EQ. 2 .AND. I_AM_CAND_LOC ) THEN + PTRARW( I ) = 0 + KEEP(14) = KEEP(14) + 3 + PTRAIW( I ) + PTRARW( I ) + KEEP(13) = KEEP(13) + 1 + PTRAIW( I ) + PTRARW( I ) + END IF + END DO + IF ( associated( id%INTARR ) ) THEN + DEALLOCATE( id%INTARR ) + NULLIFY( id%INTARR ) + END IF + IF ( KEEP(14) > 0 ) THEN + ALLOCATE( id%INTARR( KEEP(14) ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = KEEP(14) + RETURN + END IF + ELSE + ALLOCATE( id%INTARR( 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = 1 + RETURN + END IF + END IF + IPTRI = 1 + IPTRR = 1 + DO I = 1, N + ISTEP = abs(STEP(I)) + ITYPE = MUMPS_330( PROCNODE(ISTEP), SLAVEF ) + IRANK = MUMPS_275( PROCNODE(ISTEP), SLAVEF ) + TYPESPLIT = MUMPS_810 ( PROCNODE(ISTEP), SLAVEF ) + I_AM_CAND_LOC = .FALSE. + T4_MASTER_CONCERNED = .FALSE. + IF (ITYPE.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF (I_AM_SLAVE) THEN + I_AM_CAND_LOC = I_AM_CAND(INIV2) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + IF ( TYPE_PARALL .eq. 0 ) THEN + T4_MASTER_CONCERNED = + & (id%CANDIDATES (id%CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + & .EQ.MYID-1 ) + ELSE + T4_MASTER_CONCERNED = + & (id%CANDIDATES (id%CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + & .EQ.MYID ) + ENDIF + ENDIF + ENDIF + ENDIF + IF ( TYPE_PARALL .eq. 0 ) THEN + IRANK =IRANK + 1 + END IF + IF ( + & ( ITYPE .eq. 2 .and. + & IRANK .eq. MYID ) + & .or. + & ( ITYPE .eq. 1 .and. + & IRANK .eq. MYID ) + & .or. + & ( T4_MASTER_CONCERNED ) + & ) THEN + NCOL = PTRAIW( I ) + NROW = PTRARW( I ) + id%INTARR( IPTRI ) = NCOL + id%INTARR( IPTRI + 1 ) = -NROW + id%INTARR( IPTRI + 2 ) = I + PTRAIW( I ) = IPTRI + PTRARW( I ) = IPTRR + IPTRI = IPTRI + NCOL + NROW + 3 + IPTRR = IPTRR + NCOL + NROW + 1 + ELSE IF ( ITYPE .eq. 2 .AND. I_AM_CAND_LOC ) THEN + NCOL = PTRAIW( I ) + NROW = 0 + id%INTARR( IPTRI ) = NCOL + id%INTARR( IPTRI + 1 ) = -NROW + id%INTARR( IPTRI + 2 ) = I + PTRAIW( I ) = IPTRI + PTRARW( I ) = IPTRR + IPTRI = IPTRI + NCOL + NROW + 3 + IPTRR = IPTRR + NCOL + NROW + 1 + ELSE + PTRAIW(I) = 0 + PTRARW(I) = 0 + END IF + END DO + IF ( IPTRI - 1 .NE. KEEP(14) ) THEN + WRITE(*,*) 'Error 1 in anal_arrowheads', + & ' IPTRI - 1, KEEP(14)=', IPTRI - 1, KEEP(14) + CALL MUMPS_ABORT() + END IF + IF ( IPTRR - 1 .NE. KEEP(13) ) THEN + WRITE(*,*) 'Error 2 in anal_arrowheads' + CALL MUMPS_ABORT() + END IF + RETURN + END SUBROUTINE DMUMPS_24 + SUBROUTINE DMUMPS_148(N, NZ, ASPK, + & IRN, ICN, PERM, + & LSCAL,COLSCA,ROWSCA, + & MYID, SLAVEF, PROCNODE_STEPS, NBRECORDS, + & LP, COMM, root, KEEP, KEEP8, FILS, RG2L, + & INTARR, DBLARR, PTRAIW, PTRARW, FRERE_STEPS, + & STEP, A, LA, ISTEP_TO_INIV2, I_AM_CAND, CANDIDATES ) + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INTEGER N,NZ, COMM, NBRECORDS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION ASPK(NZ) + DOUBLE PRECISION COLSCA(*), ROWSCA(*) + INTEGER IRN(NZ), ICN(NZ) + INTEGER PERM(N), PROCNODE_STEPS(KEEP(28)) + INTEGER RG2L( N ), FILS( N ) + INTEGER ISTEP_TO_INIV2(KEEP(71)) + LOGICAL I_AM_CAND(max(1,KEEP(56))) + INTEGER LP, SLAVEF, MYID + INTEGER CANDIDATES(SLAVEF+1, max(1,KEEP(56))) + LOGICAL LSCAL + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER(8) :: LA + INTEGER PTRAIW( N ), PTRARW( N ), FRERE_STEPS( KEEP(28) ) + INTEGER STEP(N) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION A( LA ), DBLARR(max(1,KEEP(13))) + INTEGER, DIMENSION(:,:), ALLOCATABLE :: BUFI + DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: BUFR + INTEGER MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + DOUBLE PRECISION VAL + INTEGER IOLD,JOLD,INEW,JNEW,ISEND,JSEND,DEST,I,K,IARR + INTEGER IPOSROOT, JPOSROOT + INTEGER IROW_GRID, JCOL_GRID + INTEGER INODE, ISTEP + INTEGER NBUFS + INTEGER ARROW_ROOT, TAILLE + INTEGER LOCAL_M, LOCAL_N + INTEGER(8) :: PTR_ROOT + INTEGER TYPENODE_TMP, MASTER_NODE + LOGICAL I_AM_CAND_LOC, I_AM_SLAVE + INTEGER I1, IA, JARR, ILOCROOT, JLOCROOT + INTEGER IS1, ISHIFT, IIW, IS, IAS + INTEGER allocok, TYPESPLIT, T4MASTER, INIV2 + LOGICAL T4_MASTER_CONCERNED + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INTEGER, POINTER, DIMENSION(:,:) :: IW4 + ARROW_ROOT = 0 + I_AM_SLAVE=(MYID.NE.0.OR.KEEP(46).EQ.1) + IF ( KEEP(46) .eq. 0 ) THEN + NBUFS = SLAVEF + ELSE + NBUFS = SLAVEF - 1 + ALLOCATE( IW4( N, 2 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) 'Error allocating IW4' + CALL MUMPS_ABORT() + END IF + DO I = 1, N + I1 = PTRAIW( I ) + IA = PTRARW( I ) + IF ( IA .GT. 0 ) THEN + DBLARR( IA ) = ZERO + IW4( I, 1 ) = INTARR( I1 ) + IW4( I, 2 ) = -INTARR( I1 + 1 ) + INTARR( I1 + 2 ) = I + END IF + END DO + IF ( KEEP(38) .NE. 0 ) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I = 1, root%SCHUR_NLOC + root%SCHUR_POINTER(int(I-1,8)*int(root%SCHUR_LLD,8)+1_8: + & int(I-1,8)*int(root%SCHUR_LLD,8)+int(root%SCHUR_MLOC,8))= + & ZERO + ENDDO + ENDIF + END IF + END IF + IF (NBUFS.GT.0) THEN + ALLOCATE( BUFI(NBRECORDS*2+1,NBUFS),stat=allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) 'Error allocating BUFI' + CALL MUMPS_ABORT() + END IF + ALLOCATE( BUFR( NBRECORDS, NBUFS ), stat=allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) 'Error allocating BUFR' + CALL MUMPS_ABORT() + END IF + DO I = 1, NBUFS + BUFI( 1, I ) = 0 + ENDDO + ENDIF + INODE = KEEP(38) + I = 1 + DO WHILE ( INODE .GT. 0 ) + RG2L( INODE ) = I + INODE = FILS( INODE ) + I = I + 1 + END DO + DO 120 K=1,NZ + IOLD = IRN(K) + JOLD = ICN(K) + IF ( (IOLD.GT.N).OR.(JOLD.GT.N).OR.(IOLD.LT.1) + & .OR.(JOLD.LT.1) ) THEN + GOTO 120 + END IF + IF (LSCAL) THEN + VAL = ASPK(K)*ROWSCA(IOLD)*COLSCA(JOLD) + ELSE + VAL = ASPK(K) + ENDIF + IF (IOLD.EQ.JOLD) THEN + ISEND = IOLD + JSEND = JOLD + ELSE + INEW = PERM(IOLD) + JNEW = PERM(JOLD) + IF (INEW.LT.JNEW) THEN + ISEND = IOLD + IF ( KEEP(50) .NE. 0 ) ISEND = -IOLD + JSEND = JOLD + ELSE + ISEND = -JOLD + JSEND = IOLD + ENDIF + ENDIF + IARR = abs( ISEND ) + ISTEP = abs( STEP(IARR) ) + TYPENODE_TMP = MUMPS_330( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + MASTER_NODE = MUMPS_275( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + TYPESPLIT = MUMPS_810( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + I_AM_CAND_LOC = .FALSE. + T4_MASTER_CONCERNED = .FALSE. + T4MASTER = -9999 + IF (TYPENODE_TMP.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF (I_AM_SLAVE) I_AM_CAND_LOC = I_AM_CAND(INIV2) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + T4_MASTER_CONCERNED = .TRUE. + T4MASTER=CANDIDATES(CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + IF ( KEEP(46) .eq. 0 ) THEN + T4MASTER=T4MASTER+1 + ENDIF + ENDIF + ENDIF + IF ( TYPENODE_TMP .EQ. 1 ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + DEST = MASTER_NODE + 1 + ELSE + DEST = MASTER_NODE + END IF + ELSE IF ( TYPENODE_TMP .EQ. 2 ) THEN + IF ( ISEND .LT. 0 ) THEN + DEST = -1 + ELSE + IF ( KEEP( 46 ) .eq. 0 ) THEN + DEST = MASTER_NODE + 1 + ELSE + DEST = MASTER_NODE + END IF + END IF + ELSE + IF ( ISEND .LT. 0 ) THEN + IPOSROOT = RG2L(JSEND) + JPOSROOT = RG2L(IARR) + ELSE + IPOSROOT = RG2L( IARR ) + JPOSROOT = RG2L( JSEND ) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, root%NPCOL ) + IF ( KEEP( 46 ) .eq. 0 ) THEN + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + 1 + ELSE + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + END IF + END IF + IF ( DEST .eq. 0 .or. + & ( DEST .eq. -1 .and. KEEP( 46 ) .eq. 1 .AND. + & ( I_AM_CAND_LOC .OR. MASTER_NODE .EQ. 0 ) ) + & .or. + & ( T4MASTER.EQ.0 ) + & ) THEN + IARR = ISEND + JARR = JSEND + IF ( TYPENODE_TMP .eq. 3 ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + IF ( IROW_GRID .EQ. root%MYROW .AND. + & JCOL_GRID .EQ. root%MYCOL ) THEN + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & = A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + ELSE + WRITE(*,*) MYID,':INTERNAL Error: root arrowhead ' + WRITE(*,*) MYID,':is not belonging to me. IARR,JARR=' + & ,IARR,JARR + CALL MUMPS_ABORT() + END IF + ELSE IF ( IARR .GE. 0 ) THEN + IF ( IARR .eq. JARR ) THEN + IA = PTRARW( IARR ) + DBLARR( IA ) = DBLARR( IA ) + VAL + ELSE + IS1 = PTRAIW(IARR) + ISHIFT = INTARR(IS1) + IW4(IARR,2) + IW4(IARR,2) = IW4(IARR,2) - 1 + IIW = IS1 + ISHIFT + 2 + INTARR(IIW) = JARR + IS = PTRARW(IARR) + IAS = IS + ISHIFT + DBLARR(IAS) = VAL + END IF + ELSE + IARR = -IARR + ISHIFT = PTRAIW(IARR)+IW4(IARR,1)+2 + INTARR(ISHIFT) = JARR + IAS = PTRARW(IARR)+IW4(IARR,1) + IW4(IARR,1) = IW4(IARR,1) - 1 + DBLARR(IAS) = VAL + IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0 ) + & .AND. IW4(IARR,1) .EQ. 0 .AND. + & STEP( IARR) > 0 ) THEN + IF (MUMPS_275( PROCNODE_STEPS(abs(STEP(IARR))), + & SLAVEF ) == MYID) THEN + TAILLE = INTARR( PTRAIW(IARR) ) + CALL DMUMPS_310( N, PERM, + & INTARR( PTRAIW(IARR) + 3 ), + & DBLARR( PTRARW(IARR) + 1 ), + & TAILLE, 1, TAILLE ) + END IF + END IF + ENDIF + END IF + IF ( DEST.EQ. -1 ) THEN + DO I=1, CANDIDATES(SLAVEF+1,ISTEP_TO_INIV2(ISTEP)) + DEST=CANDIDATES(I,ISTEP_TO_INIV2(ISTEP)) + IF (KEEP(46).EQ.0) DEST=DEST+1 + IF (DEST.NE.0) + & CALL DMUMPS_34( ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDDO + DEST = MASTER_NODE + IF (KEEP(46).EQ.0) DEST=DEST+1 + IF ( DEST .NE. 0 ) THEN + CALL DMUMPS_34( ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDIF + IF ((T4_MASTER_CONCERNED).AND.(T4MASTER.GT.0)) THEN + CALL DMUMPS_34( ISEND, JSEND, VAL, + & T4MASTER, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDIF + ELSE IF ( DEST .GT. 0 ) THEN + CALL DMUMPS_34( ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + IF ( T4MASTER.GT.0 ) THEN + CALL DMUMPS_34( ISEND, JSEND, VAL, + & T4MASTER, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDIF + ELSE IF ( T4MASTER.GT.0 ) THEN + CALL DMUMPS_34( ISEND, JSEND, VAL, + & T4MASTER, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + END IF + 120 CONTINUE + KEEP(49) = ARROW_ROOT + IF (NBUFS.GT.0) THEN + CALL DMUMPS_18( + & BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP( 46 ) ) + ENDIF + IF ( KEEP( 46 ) .NE. 0 ) DEALLOCATE( IW4 ) + IF (NBUFS.GT.0) THEN + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + ENDIF + RETURN + END SUBROUTINE DMUMPS_148 + SUBROUTINE DMUMPS_34(ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, LP, COMM, + & TYPE_PARALL ) + IMPLICIT NONE + INTEGER ISEND, JSEND, DEST, NBUFS, NBRECORDS, TYPE_PARALL + INTEGER BUFI( NBRECORDS * 2 + 1, NBUFS ) + DOUBLE PRECISION BUFR( NBRECORDS, NBUFS ) + INTEGER COMM + INTEGER LP + DOUBLE PRECISION VAL + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + INTEGER TAILLE_SENDI, TAILLE_SENDR, IREQ + IF (BUFI(1,DEST)+1.GT.NBRECORDS) THEN + TAILLE_SENDI = BUFI(1,DEST) * 2 + 1 + TAILLE_SENDR = BUFI(1,DEST) + CALL MPI_SEND(BUFI(1,DEST),TAILLE_SENDI, + & MPI_INTEGER, + & DEST, ARROWHEAD, COMM, IERR ) + CALL MPI_SEND( BUFR(1,DEST), TAILLE_SENDR, + & MPI_DOUBLE_PRECISION, DEST, + & ARROWHEAD, COMM, IERR ) + BUFI(1,DEST) = 0 + ENDIF + IREQ = BUFI(1,DEST) + 1 + BUFI(1,DEST) = IREQ + BUFI( IREQ * 2, DEST ) = ISEND + BUFI( IREQ * 2 + 1, DEST ) = JSEND + BUFR( IREQ, DEST ) = VAL + RETURN + END SUBROUTINE DMUMPS_34 + SUBROUTINE DMUMPS_18( + & BUFI, BUFR, NBRECORDS, NBUFS, LP, COMM, + & TYPE_PARALL ) + IMPLICIT NONE + INTEGER NBUFS, NBRECORDS, TYPE_PARALL + INTEGER BUFI( NBRECORDS * 2 + 1, NBUFS ) + DOUBLE PRECISION BUFR( NBRECORDS, NBUFS ) + INTEGER COMM + INTEGER LP + INTEGER ISLAVE, TAILLE_SENDI, TAILLE_SENDR, IERR + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + DO ISLAVE = 1,NBUFS + TAILLE_SENDI = BUFI(1,ISLAVE) * 2 + 1 + TAILLE_SENDR = BUFI(1,ISLAVE) + BUFI(1,ISLAVE) = - BUFI(1,ISLAVE) + CALL MPI_SEND(BUFI(1,ISLAVE),TAILLE_SENDI, + & MPI_INTEGER, + & ISLAVE, ARROWHEAD, COMM, IERR ) + IF ( TAILLE_SENDR .NE. 0 ) THEN + CALL MPI_SEND( BUFR(1,ISLAVE), TAILLE_SENDR, + & MPI_DOUBLE_PRECISION, ISLAVE, + & ARROWHEAD, COMM, IERR ) + END IF + ENDDO + RETURN + END SUBROUTINE DMUMPS_18 + RECURSIVE SUBROUTINE DMUMPS_310( N, PERM, + & INTLIST, DBLLIST, TAILLE, LO, HI ) + IMPLICIT NONE + INTEGER N, TAILLE + INTEGER PERM( N ) + INTEGER INTLIST( TAILLE ) + DOUBLE PRECISION DBLLIST( TAILLE ) + INTEGER LO, HI + INTEGER I,J + INTEGER ISWAP, PIVOT + DOUBLE PRECISION dswap + I = LO + J = HI + PIVOT = PERM(INTLIST((I+J)/2)) + 10 IF (PERM(INTLIST(I)) < PIVOT) THEN + I=I+1 + GOTO 10 + ENDIF + 20 IF (PERM(INTLIST(J)) > PIVOT) THEN + J=J-1 + GOTO 20 + ENDIF + IF (I < J) THEN + ISWAP = INTLIST(I) + INTLIST(I) = INTLIST(J) + INTLIST(J)=ISWAP + dswap = DBLLIST(I) + DBLLIST(I) = DBLLIST(J) + DBLLIST(J) = dswap + ENDIF + IF ( I <= J) THEN + I = I+1 + J = J-1 + ENDIF + IF ( I <= J ) GOTO 10 + IF ( LO < J ) CALL DMUMPS_310(N, PERM, + & INTLIST, DBLLIST, TAILLE, LO, J) + IF ( I < HI ) CALL DMUMPS_310(N, PERM, + & INTLIST, DBLLIST, TAILLE, I, HI) + RETURN + END SUBROUTINE DMUMPS_310 + SUBROUTINE DMUMPS_145( N, + & DBLARR, LDBLARR, INTARR, LINTARR, PTRAIW, PTRARW, + & KEEP, KEEP8, MYID, COMM, NBRECORDS, + & A, LA, root, + & PROCNODE_STEPS, + & SLAVEF, PERM, FRERE_STEPS, STEP, INFO1, INFO2 + & ) + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INTEGER N, MYID, LDBLARR, LINTARR, + & COMM + INTEGER INTARR(LINTARR) + INTEGER PTRAIW(N), PTRARW(N) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8), intent(IN) :: LA + INTEGER PROCNODE_STEPS( KEEP(28) ), PERM( N ) + INTEGER SLAVEF, NBRECORDS + DOUBLE PRECISION A( LA ) + INTEGER INFO1, INFO2 + DOUBLE PRECISION DBLARR(LDBLARR) + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER, POINTER, DIMENSION(:) :: BUFI + DOUBLE PRECISION, POINTER, DIMENSION(:) :: BUFR + INTEGER, POINTER, DIMENSION(:,:) :: IW4 + LOGICAL FINI + INTEGER IREC, NB_REC, IARR, JARR, IA, I1, I, allocok + INTEGER IS, IS1, ISHIFT, IIW, IAS + INTEGER LOCAL_M, LOCAL_N, ILOCROOT, JLOCROOT, + & IPOSROOT, JPOSROOT, TAILLE, + & IPROC + INTEGER FRERE_STEPS( KEEP(28) ), STEP(N) + INTEGER(8) :: PTR_ROOT + INTEGER ARROW_ROOT, TYPE_PARALL + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + DOUBLE PRECISION VAL + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER MASTER + PARAMETER(MASTER=0) + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER IERR + INTEGER numroc + EXTERNAL numroc + TYPE_PARALL = KEEP(46) + ARROW_ROOT=0 + ALLOCATE( BUFI( NBRECORDS * 2 + 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO1 = -13 + INFO2 = NBRECORDS * 2 + 1 + WRITE(*,*) MYID,': Could not allocate BUFI: goto 500' + GOTO 500 + END IF + ALLOCATE( BUFR( NBRECORDS ) , stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO1 = -13 + INFO2 = NBRECORDS + WRITE(*,*) MYID,': Could not allocate BUFR: goto 500' + GOTO 500 + END IF + ALLOCATE( IW4(N,2), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO1 = -13 + INFO2 = 2 * N + WRITE(*,*) MYID,': Could not allocate IW4: goto 500' + GOTO 500 + END IF + IF ( KEEP(38).NE.0) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I=1, root%SCHUR_NLOC + root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1: + & (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC)=ZERO + ENDDO + ENDIF + END IF + FINI = .FALSE. + DO I=1,N + I1 = PTRAIW(I) + IA = PTRARW(I) + IF (IA.GT.0) THEN + DBLARR(IA) = ZERO + IW4(I,1) = INTARR(I1) + IW4(I,2) = -INTARR(I1+1) + INTARR(I1+2)=I + ENDIF + ENDDO + DO WHILE (.NOT.FINI) + CALL MPI_RECV( BUFI(1), 2*NBRECORDS+1, + & MPI_INTEGER, MASTER, + & ARROWHEAD, + & COMM, STATUS, IERR ) + NB_REC = BUFI(1) + IF (NB_REC.LE.0) THEN + FINI = .TRUE. + NB_REC = -NB_REC + ENDIF + IF (NB_REC.EQ.0) EXIT + CALL MPI_RECV( BUFR(1), NBRECORDS, MPI_DOUBLE_PRECISION, + & MASTER, ARROWHEAD, + & COMM, STATUS, IERR ) + DO IREC=1, NB_REC + IARR = BUFI( IREC * 2 ) + JARR = BUFI( IREC * 2 + 1 ) + VAL = BUFR( IREC ) + IF ( MUMPS_330( PROCNODE_STEPS(abs(STEP(abs(IARR)))), + & SLAVEF ) .eq. 3 ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + IF ( IARR .GT. 0 ) THEN + IPOSROOT = root%RG2L_ROW( IARR ) + JPOSROOT = root%RG2L_COL( JARR ) + ELSE + IPOSROOT = root%RG2L_ROW( JARR ) + JPOSROOT = root%RG2L_COL( -IARR ) + END IF + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & = A( PTR_ROOT + int(JLOCROOT - 1,8) + & * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8)) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + ELSE IF (IARR.GE.0) THEN + IF (IARR.EQ.JARR) THEN + IA = PTRARW(IARR) + DBLARR(IA) = DBLARR(IA) + VAL + ELSE + IS1 = PTRAIW(IARR) + ISHIFT = INTARR(IS1) + IW4(IARR,2) + IW4(IARR,2) = IW4(IARR,2) - 1 + IIW = IS1 + ISHIFT + 2 + INTARR(IIW) = JARR + IS = PTRARW(IARR) + IAS = IS + ISHIFT + DBLARR(IAS) = VAL + ENDIF + ELSE + IARR = -IARR + ISHIFT = PTRAIW(IARR)+IW4(IARR,1)+2 + INTARR(ISHIFT) = JARR + IAS = PTRARW(IARR)+IW4(IARR,1) + IW4(IARR,1) = IW4(IARR,1) - 1 + DBLARR(IAS) = VAL + IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0) + & .AND. IW4(IARR,1) .EQ. 0 + & .AND. STEP(IARR) > 0 ) THEN + IPROC = MUMPS_275( PROCNODE_STEPS(abs(STEP(IARR))), + & SLAVEF ) + IF ( TYPE_PARALL .eq. 0 ) THEN + IPROC = IPROC + 1 + END IF + IF (IPROC .EQ. MYID) THEN + TAILLE = INTARR( PTRAIW(IARR) ) + CALL DMUMPS_310( N, PERM, + & INTARR( PTRAIW(IARR) + 3 ), + & DBLARR( PTRARW(IARR) + 1 ), + & TAILLE, 1, TAILLE ) + END IF + END IF + ENDIF + ENDDO + END DO + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + DEALLOCATE( IW4 ) + 500 CONTINUE + KEEP(49) = ARROW_ROOT + RETURN + END SUBROUTINE DMUMPS_145 + SUBROUTINE DMUMPS_266( MYID, BUFR, LBUFR, + & LBUFR_BYTES, + & IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, + & TNBPROCFILS, N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP, + & KEEP,KEEP8, ITLOC, RHS_MUMPS, + & IFLAG, IERROR ) + USE DMUMPS_LOAD + IMPLICIT NONE + INTEGER MYID + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB, N, LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER PTRIST(KEEP(28)), STEP(N), + & PIMASTER(KEEP(28)), + & TNBPROCFILS( KEEP(28) ), ITLOC( N + KEEP(253) ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER COMP, IFLAG, IERROR + INTEGER INODE, NBPROCFILS, NCOL, NROW, NASS, NSLAVES + INTEGER NSLAVES_RECU, NFRONT + INTEGER LREQ + INTEGER(8) :: LREQCB + DOUBLE PRECISION FLOP1 + INCLUDE 'mumps_headers.h' + INODE = BUFR( 1 ) + NBPROCFILS = BUFR( 2 ) + NROW = BUFR( 3 ) + NCOL = BUFR( 4 ) + NASS = BUFR( 5 ) + NFRONT = BUFR( 6 ) + NSLAVES_RECU = BUFR( 7 ) + IF ( KEEP(50) .eq. 0 ) THEN + FLOP1 = dble( NASS * NROW ) + + & dble(NROW*NASS)*dble(2*NCOL-NASS-1) + ELSE + FLOP1 = dble( NASS ) * dble( NROW ) + & * dble( 2 * NCOL - NROW - NASS + 1) + END IF + CALL DMUMPS_190(1,.TRUE.,FLOP1, KEEP,KEEP8) + IF ( KEEP(50) .eq. 0 ) THEN + NSLAVES = NSLAVES_RECU + XTRA_SLAVES_UNSYM + ELSE + NSLAVES = NSLAVES_RECU + XTRA_SLAVES_SYM + END IF + LREQ = NROW + NCOL + 6 + NSLAVES + KEEP(IXSZ) + LREQCB = int(NCOL,8) * int(NROW,8) + CALL DMUMPS_22(.FALSE., 0_8, .FALSE.,.TRUE., + & MYID,N, KEEP,KEEP8, IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST, STEP, PIMASTER,PAMASTER, + & LREQ, LREQCB, INODE, S_ACTIVE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + PTRIST(STEP(INODE)) = IWPOSCB + 1 + PTRAST(STEP(INODE)) = IPTRLU + 1_8 + IW( IWPOSCB + 1+KEEP(IXSZ) ) = NCOL + IW( IWPOSCB + 2+KEEP(IXSZ) ) = - NASS + IW( IWPOSCB + 3+KEEP(IXSZ) ) = NROW + IW( IWPOSCB + 4+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 5+KEEP(IXSZ) ) = NASS + IW( IWPOSCB + 6+KEEP(IXSZ) ) = NSLAVES + IW( IWPOSCB + 7+KEEP(IXSZ)+NSLAVES : + & IWPOSCB + 6+KEEP(IXSZ)+NSLAVES + NROW + NCOL ) + &= BUFR( 8 + NSLAVES_RECU : 7 + NSLAVES_RECU + NROW + NCOL ) + IF ( KEEP(50) .eq. 0 ) THEN + IW( IWPOSCB + 7+KEEP(IXSZ) ) = S_ROOTBAND_INIT + IF (NSLAVES_RECU.GT.0) + & IW( IWPOSCB + 7+XTRA_SLAVES_UNSYM+KEEP(IXSZ): + & IWPOSCB+6+KEEP(IXSZ)+NSLAVES_RECU ) = + & BUFR( 8: 7 + NSLAVES_RECU ) + ELSE + IW( IWPOSCB + 7+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 8+KEEP(IXSZ) ) = NFRONT + IW( IWPOSCB + 9+KEEP(IXSZ) ) = S_ROOTBAND_INIT + IW( IWPOSCB + 7+XTRA_SLAVES_SYM+KEEP(IXSZ): + & IWPOSCB + 6+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_RECU ) = + & BUFR( 8: 7 + NSLAVES_RECU ) + END IF + TNBPROCFILS(STEP( INODE )) = NBPROCFILS + RETURN + END SUBROUTINE DMUMPS_266 + SUBROUTINE DMUMPS_163( id ) + USE DMUMPS_STRUC_DEF + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE (DMUMPS_STRUC) id + INTEGER MASTER, IERR,PAR_loc,SYM_loc + PARAMETER( MASTER = 0 ) + INTEGER color + CALL MPI_COMM_SIZE(id%COMM, id%NPROCS, IERR ) + PAR_loc=id%PAR + SYM_loc=id%SYM + CALL MPI_BCAST(PAR_loc,1,MPI_INTEGER,MASTER,id%COMM,IERR) + CALL MPI_BCAST(SYM_loc,1,MPI_INTEGER,MASTER,id%COMM,IERR) + IF ( PAR_loc .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + color = MPI_UNDEFINED + ELSE + color = 0 + END IF + CALL MPI_COMM_SPLIT( id%COMM, color, 0, + & id%COMM_NODES, IERR ) + id%NSLAVES = id%NPROCS - 1 + ELSE + CALL MPI_COMM_DUP( id%COMM, id%COMM_NODES, IERR ) + id%NSLAVES = id%NPROCS + END IF + IF (PAR_loc .ne. 0 .or. id%MYID .NE. MASTER) THEN + CALL MPI_COMM_DUP( id%COMM_NODES, id%COMM_LOAD, IERR ) + ENDIF + CALL DMUMPS_20( id%NSLAVES, id%LWK_USER, + & id%CNTL(1), id%ICNTL(1), + & id%KEEP(1), id%KEEP8(1), id%INFO(1), id%INFOG(1), + & id%RINFO(1), id%RINFOG(1), + & SYM_loc, PAR_loc, id%DKEEP(1) ) + id%WRITE_PROBLEM="NAME_NOT_INITIALIZED" + CALL MUMPS_SET_VERSION( id%VERSION_NUMBER ) + id%OOC_TMPDIR="NAME_NOT_INITIALIZED" + id%OOC_PREFIX="NAME_NOT_INITIALIZED" + id%NRHS = 1 + id%LRHS = 0 + id%LREDRHS = 0 + CALL DMUMPS_61( id%KEEP( 34 ), id%KEEP(35) ) + NULLIFY(id%BUFR) + id%MAXIS1 = 0 + id%INST_Number = -1 + id%N = 0; id%NZ = 0 + NULLIFY(id%IRN) + NULLIFY(id%JCN) + NULLIFY(id%A) + id%NZ_loc = 0 + NULLIFY(id%IRN_loc) + NULLIFY(id%JCN_loc) + NULLIFY(id%A_loc) + NULLIFY(id%MAPPING) + NULLIFY(id%RHS) + NULLIFY(id%REDRHS) + id%NZ_RHS=0 + NULLIFY(id%RHS_SPARSE) + NULLIFY(id%IRHS_SPARSE) + NULLIFY(id%IRHS_PTR) + NULLIFY(id%ISOL_loc) + id%LSOL_loc=0 + NULLIFY(id%SOL_loc) + NULLIFY(id%COLSCA) + NULLIFY(id%ROWSCA) + NULLIFY(id%PERM_IN) + NULLIFY(id%IS) + NULLIFY(id%IS1) + NULLIFY(id%STEP) + NULLIFY(id%Step2node) + NULLIFY(id%DAD_STEPS) + NULLIFY(id%NE_STEPS) + NULLIFY(id%ND_STEPS) + NULLIFY(id%FRERE_STEPS) + NULLIFY(id%SYM_PERM) + NULLIFY(id%UNS_PERM) + NULLIFY(id%PIVNUL_LIST) + NULLIFY(id%FILS) + NULLIFY(id%PTRAR) + NULLIFY(id%FRTPTR) + NULLIFY(id%FRTELT) + NULLIFY(id%NA) + id%LNA=0 + NULLIFY(id%PROCNODE_STEPS) + NULLIFY(id%S) + NULLIFY(id%PROCNODE) + NULLIFY(id%POIDS) + NULLIFY(id%PTLUST_S) + NULLIFY(id%PTRFAC) + NULLIFY(id%INTARR) + NULLIFY(id%DBLARR) + NULLIFY(id%DEPTH_FIRST) + NULLIFY(id%DEPTH_FIRST_SEQ) + NULLIFY(id%SBTR_ID) + NULLIFY(id%MEM_SUBTREE) + NULLIFY(id%MEM_SUBTREE) + NULLIFY(id%MY_ROOT_SBTR) + NULLIFY(id%MY_FIRST_LEAF) + NULLIFY(id%MY_NB_LEAF) + NULLIFY(id%COST_TRAV) + NULLIFY(id%RHSCOMP) + NULLIFY(id%POSINRHSCOMP) + NULLIFY(id%OOC_INODE_SEQUENCE) + NULLIFY(id%OOC_TOTAL_NB_NODES) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + NULLIFY(id%OOC_FILE_NAME_LENGTH) + NULLIFY(id%OOC_FILE_NAMES) + NULLIFY(id%OOC_VADDR) + NULLIFY(id%OOC_NB_FILES) + NULLIFY(id%CB_SON_SIZE) + NULLIFY(id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY(id%root%RHS_ROOT) + NULLIFY(id%root%RG2L_ROW) + NULLIFY(id%root%RG2L_COL) + NULLIFY(id%root%IPIV) + NULLIFY(id%root%SCHUR_POINTER) + NULLIFY(id%SCHUR_CINTERFACE) + id%NELT=0 + NULLIFY(id%ELTPTR) + NULLIFY(id%ELTVAR) + NULLIFY(id%A_ELT) + NULLIFY(id%ELTPROC) + id%SIZE_SCHUR = 0 + NULLIFY( id%LISTVAR_SCHUR ) + NULLIFY( id%SCHUR ) + id%NPROW = 0 + id%NPCOL = 0 + id%MBLOCK = 0 + id%NBLOCK = 0 + id%SCHUR_MLOC = 0 + id%SCHUR_NLOC = 0 + id%SCHUR_LLD = 0 + NULLIFY(id%ISTEP_TO_INIV2) + NULLIFY(id%I_AM_CAND) + NULLIFY(id%FUTURE_NIV2) + NULLIFY(id%TAB_POS_IN_PERE) + NULLIFY(id%CANDIDATES) + CALL DMUMPS_637(id) + NULLIFY(id%MEM_DIST) + NULLIFY(id%SUP_PROC) + id%Deficiency = 0 + id%root%LPIV = -1 + id%root%yes = .FALSE. + id%root%gridinit_done = .FALSE. + IF ( id%KEEP( 46 ) .ne. 0 .OR. + & id%MYID .ne. MASTER ) THEN + CALL MPI_COMM_RANK + & (id%COMM_NODES, id%MYID_NODES, IERR ) + ELSE + id%MYID_NODES = -464646 + ENDIF + RETURN + END SUBROUTINE DMUMPS_163 + SUBROUTINE DMUMPS_252( COMM_LOAD, ASS_IRECV, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, + & FILS, FRERE, DAD, MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER,PTRARW, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & + & NSTK_S,NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, JOBASS, ETATASS + & ) + USE DMUMPS_COMM_BUFFER + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mpif.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER IZERO + PARAMETER (IZERO=0) + INTEGER N,LIW,NSTEPS + INTEGER(8) LA, LRLU, LRLUS, IPTRLU, POSFAC + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & IWPOS, IWPOSCB, COMP + INTEGER JOBASS,ETATASS + LOGICAL SON_LEVEL2 + DOUBLE PRECISION A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER COMM, NBFIN, SLAVEF, MYID + INTEGER LPOOL, LEAF + INTEGER LBUFR, LBUFR_BYTES + INTEGER NBPROCFILS(KEEP(28)) + INTEGER NSTK_S(KEEP(28)),PROCNODE_STEPS(KEEP(28)) + INTEGER IPOOL( LPOOL ) + INTEGER BUFR( LBUFR ) + INTEGER IDUMMY(1) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(N), PTRAIW(N), ND(KEEP(28)), PERM(N), + & FILS(N), FRERE(KEEP(28)), DAD(KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)), + & PAMASTER(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR(max(1,KEEP(14))) + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + INTEGER LP, HS, HF + INTEGER NBPANELS_L, NBPANELS_U + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + INTEGER NFS4FATHER + INTEGER(8) NFRONT8, LAELL8, LAELL_REQ8 + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER LREQ_OOC + INTEGER(8) :: SIZFR + INTEGER SIZFI, NCB + INTEGER J1,J2 + INTEGER NCOLS, NROWS, LDA_SON + INTEGER(8) :: JJ2, ICT13 +#if defined(ALLOW_NON_INIT) + INTEGER(8) :: NUMROWS, JJ3, JJ8, APOS_ini +#endif + INTEGER NELIM,JJ,JJ1,J3, + & IBROT,IORG + INTEGER JPOS,ICT11 + INTEGER JK,IJROW,NBCOL,NUMORG,IOLDPS,J4 + INTEGER(8) IACHK, POSELT, LAPOS2, IACHK_ini + INTEGER(8) APOS, APOS2, APOS3, POSEL1, ICT12 + INTEGER AINPUT + INTEGER NSLAVES, NSLSON, NPIVS,NPIV_ANA,NPIV + INTEGER PTRCOL, ISLAVE, PDEST,LEVEL + INTEGER ISON_IN_PLACE + INTEGER ISON_TOP + INTEGER(8) SIZE_ISON_TOP8 + LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS, + & RISK_OF_SAME_POS_THIS_LINE, OMP_PARALLEL_FLAG + LOGICAL LEVEL1, NIV1 + INTEGER TROW_SIZE + INTEGER INDX, FIRST_INDEX, SHIFT_INDEX + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INCLUDE 'mumps_headers.h' + INTEGER NCBSON + LOGICAL SAME_PROC + INTRINSIC real + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INTEGER NELT, LPTRAR + EXTERNAL MUMPS_167 + LOGICAL MUMPS_167 + LOGICAL SSARBR + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + DOUBLE PRECISION FLOP1,FLOP1_EFF + EXTERNAL MUMPS_170 + LOGICAL MUMPS_170 + COMPRESSCB =.FALSE. + NELT = 1 + LPTRAR = N + NFS4FATHER = -1 + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + LEVEL = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (LEVEL.NE.1) THEN + write(6,*) 'Error1 in mpi51f_niv1 ' + CALL MUMPS_ABORT() + ENDIF + NSLAVES = 0 + HF = 6 + NSLAVES + KEEP(IXSZ) + IF (JOBASS.EQ.0) THEN + ETATASS= 0 + ELSE + ETATASS= 2 + IOLDPS = PTLUST_S(STEP(INODE)) + NFRONT = IW(IOLDPS + KEEP(IXSZ)) + NASS1 = iabs(IW(IOLDPS + 2 + KEEP(IXSZ))) + ICT11 = IOLDPS + HF - 1 + NFRONT + SSARBR=MUMPS_167(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + ENDDO + NUMSTK = 0 + IFSON = -IN + ISON = IFSON + IF (ISON .NE. 0) THEN + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + ISON = FRERE(STEP(ISON)) + ENDDO + ENDIF + GOTO 123 + ENDIF + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + ENDDO + NPIV_ANA=NUMORG + NSTEPS = NSTEPS + 1 + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + IF (ISON .NE. 0) THEN + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + NASS = NASS + IW(PIMASTER(STEP(ISON))+1+KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + ENDDO + ENDIF + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + NASS1 = NASS + NUMORG + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL DMUMPS_684( KEEP(50), NFRONT, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL DMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + ENDIF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + ENDIF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + ISON_TOP = -9999 + ISON_IN_PLACE = -9999 + SIZE_ISON_TOP8 = 0_8 + IF (KEEP(234).NE.0) THEN + IF ( IWPOSCB .NE. LIW ) THEN + IF ( IWPOSCB+IW(IWPOSCB+1+XXI).NE.LIW) THEN + ISON = IW( IWPOSCB + 1 + XXN ) + IF ( DAD( STEP( ISON ) ) .EQ. INODE .AND. + & MUMPS_330(PROCNODE_STEPS(STEP(ISON)),SLAVEF) + & .EQ. 1 ) + & THEN + ISON_TOP = ISON + CALL MUMPS_729(SIZE_ISON_TOP8,IW(IWPOSCB + 1 + XXR)) + IF (LRLU .LT. int(NFRONT,8) * int(NFRONT,8)) THEN + ISON_IN_PLACE = ISON + ENDIF + END IF + END IF + END IF + END IF + NIV1 = .TRUE. + IF (KEEP(50).EQ.0 .AND. KEEP(234) .EQ. 0) THEN + CALL MUMPS_81(MYID, INODE, N, IOLDPS, HF, NFRONT, + & NFRONT_EFF, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP, KEEP8, IFLAG, + & PROCNODE_STEPS, SLAVEF ) + ELSE + CALL MUMPS_86( MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP, KEEP8, IFLAG, + & ISON_IN_PLACE, + & PROCNODE_STEPS, SLAVEF) + IF (IFLAG.LT.0) GOTO 300 + ENDIF + IF (NFRONT_EFF.NE.NFRONT) THEN + IF (NFRONT.GT.NFRONT_EFF) THEN + IF(MUMPS_170(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF))THEN + NPIV=NASS1-(NFRONT_EFF-ND(STEP(INODE))) + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1) + NPIV=NPIV_ANA + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1_EFF) + CALL DMUMPS_190(0,.FALSE.,FLOP1-FLOP1_EFF, + & KEEP,KEEP8) + ENDIF + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) ' ERROR 1 during ass_niv1', NFRONT, NFRONT_EFF + GOTO 270 + ENDIF + ENDIF + NFRONT8=int(NFRONT,8) + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL DMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + NCB = NFRONT - NASS1 + MAXFRW = max0(MAXFRW, NFRONT) + ICT11 = IOLDPS + HF - 1 + NFRONT + LAELL8 = NFRONT8 * NFRONT8 + LAELL_REQ8 = LAELL8 + IF ( ISON_IN_PLACE > 0 ) THEN + LAELL_REQ8 = LAELL8 - SIZE_ISON_TOP8 + ENDIF + IF (LRLU .LT. LAELL_REQ8) THEN + IF (LRLUS .LT. LAELL_REQ8) THEN + GOTO 280 + ELSE + CALL DMUMPS_94 + & (N, KEEP(28), IW, LIW, A, LA, LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, STEP, PIMASTER, + & PAMASTER,KEEP(216),LRLUS,KEEP(IXSZ)) + COMP = COMP + 1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + ENDIF + ENDIF + ENDIF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + SIZE_ISON_TOP8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + POSFAC = POSFAC + LAELL8 + SSARBR=MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + CALL DMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS, + & 0_8, + & LAELL8-SIZE_ISON_TOP8, + & KEEP,KEEP8, + & LRLU) +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = min(POSELT + LAELL8 - 1_8, IPTRLU) + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. NFRONT .LT. KEEP(63) ) THEN + LAPOS2 = min(POSELT + LAELL8 - 1_8, IPTRLU) + DO JJ8 = POSELT, LAPOS2 + A( JJ8 ) = ZERO + ENDDO + ELSE + IF (ETATASS.EQ.1) THEN + APOS_ini = POSELT + DO JJ8 = 0_8, NFRONT8 - 1_8 + JJ3 = min(JJ8,int(NASS1-1,8)) + APOS = APOS_ini + JJ8 * NFRONT8 + A(APOS:APOS+JJ3) = ZERO + END DO + ELSE + APOS_ini = POSELT + NUMROWS = min(NFRONT8, (IPTRLU-APOS_ini) / NFRONT8 ) + DO JJ8 = 0_8, NUMROWS - 1_8 + APOS = APOS_ini + JJ8 * NFRONT8 + A(APOS:APOS + JJ8) = ZERO + ENDDO + IF( NUMROWS .LT. NFRONT8 ) THEN + APOS = APOS_ini + NFRONT8*NUMROWS + A(APOS : min(IPTRLU,APOS+NUMROWS)) = ZERO + ENDIF + ENDIF + END IF +#endif + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + IW(IOLDPS + KEEP(IXSZ)) = NFRONT + IW(IOLDPS + KEEP(IXSZ) + 1) = 0 + IW(IOLDPS + KEEP(IXSZ) + 2) = -NASS1 + IW(IOLDPS + KEEP(IXSZ) + 3) = -NASS1 + IW(IOLDPS + KEEP(IXSZ) + 4) = STEP(INODE) + IW(IOLDPS + KEEP(IXSZ) + 5) = NSLAVES + 123 CONTINUE + IF (NUMSTK.NE.0) THEN + IF (ISON_TOP > 0) THEN + ISON = ISON_TOP + ELSE + ISON = IFSON + ENDIF + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NELIM = IW(ISTCHK + KEEP(IXSZ) + 1) + NPIVS = IW(ISTCHK + KEEP(IXSZ) + 3) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + HS = 6 + KEEP(IXSZ) + NSLSON + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + LEVEL1 = NSLSON.EQ.0 + IF (.NOT.SAME_PROC) THEN + NROWS = IW( ISTCHK + KEEP(IXSZ) + 2) + ELSE + NROWS = NCOLS + ENDIF + SIZFI = HS + NROWS + NCOLS + J1 = ISTCHK + HS + NROWS + NPIVS + IF ( .NOT. LEVEL1 .AND. NELIM.EQ.0 ) GOTO 205 + IF (LEVEL1) THEN + J2 = J1 + LSTK - 1 + SIZFR = int(LSTK,8)*int(LSTK,8) + IF (COMPRESSCB) SIZFR = (int(LSTK,8)*int(LSTK+1,8))/2_8 + ELSE + IF ( KEEP(50).eq.0 ) THEN + SIZFR = int(NELIM,8) * int(LSTK,8) + ELSE + SIZFR = int(NELIM,8) * int(NELIM,8) + END IF + J2 = J1 + NELIM - 1 + ENDIF + IF (JOBASS.EQ.0) OPASSW = OPASSW + dble(SIZFR) + IACHK = PAMASTER(STEP(ISON)) + IF ( KEEP(50) .eq. 0 ) THEN + POSEL1 = PTRAST(STEP(INODE)) - NFRONT8 + IF (NFRONT .EQ. LSTK.AND. ISON.EQ.ISON_IN_PLACE + & .AND.IACHK + SIZFR - 1_8 .EQ. POSFAC - 1_8 ) THEN + GOTO 205 + ENDIF + IF (J2.GE.J1) THEN + RESET_TO_ZERO = (IACHK .LT. POSFAC) + RISK_OF_SAME_POS = IACHK + SIZFR - 1_8 .EQ. POSFAC - 1_8 + RISK_OF_SAME_POS_THIS_LINE = .FALSE. + IACHK_ini = IACHK + OMP_PARALLEL_FLAG = (RESET_TO_ZERO.EQV..FALSE.).AND. + & ((J2-J1).GT.300) + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * int(NFRONT,8) + IACHK = IACHK_ini + int(JJ-J1,8)*int(LSTK,8) + IF (RISK_OF_SAME_POS) THEN + IF (JJ.EQ.J2) THEN + RISK_OF_SAME_POS_THIS_LINE = + & (ISON .EQ. ISON_IN_PLACE) + & .AND. ( APOS + int(IW(J1+LSTK-1)-1,8).EQ. + & IACHK+int(LSTK-1,8) ) + ENDIF + ENDIF + IF ((IACHK .GE. POSFAC).AND.(JJ>J1))THEN + RESET_TO_ZERO =.FALSE. + ENDIF + IF (RESET_TO_ZERO) THEN + IF (RISK_OF_SAME_POS_THIS_LINE) THEN + DO JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + IF ( IACHK+int(JJ1-1,8) .NE. JJ2 ) THEN + A(JJ2) = A(IACHK + int(JJ1 - 1,8)) + A(IACHK + int(JJ1 -1,8)) = ZERO + ENDIF + ENDDO + ELSE + DO JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1+JJ1-1),8) - 1_8 + A(JJ2) = A(IACHK + int(JJ1 - 1,8)) + A(IACHK + int(JJ1 -1,8)) = ZERO + ENDDO + ENDIF + ELSE + DO JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1+JJ1-1),8) - 1_8 + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8)) + ENDDO + ENDIF + 170 CONTINUE + END IF + ELSE + IF (LEVEL1) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = SIZFR + ELSE + LCB = int(LDA_SON,8)* int(J2-J1+1,8) + ENDIF + CALL DMUMPS_178(A, LA, + & PTRAST(STEP( INODE )), NFRONT, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), J2 - J1 + 1, NELIM, ETATASS, + & COMPRESSCB, (ISON.EQ.ISON_IN_PLACE) + & ) + ENDIF + 205 IF (LEVEL1) THEN + IF (SAME_PROC) ISTCHK = PTRIST(STEP(ISON)) + IF ((SAME_PROC).AND.ETATASS.NE.1) THEN + IF (KEEP(50).NE.0) THEN + J2 = J1 + LSTK - 1 + DO JJ = J1, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + ELSE + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM + DO JJ = J3, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + IF (NELIM .NE. 0) THEN + J3 = J3 - 1 + DO JJ = J1, J3 + JPOS = IW(JJ) + ICT11 + IW(JJ) = IW(JPOS) + ENDDO + ENDIF + ENDIF + ENDIF + IF (ETATASS.NE.1) THEN + IF ( SAME_PROC ) THEN + PTRIST(STEP(ISON)) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL DMUMPS_152(SSARBR, MYID, N, ISTCHK, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, + & (ISON .EQ. ISON_TOP) + & ) + ENDIF + ELSE + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP, KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL DMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, IDUMMY, + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, + & LEAF, NBFIN, ICNTL, KEEP, KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + ENDDO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL DMUMPS_71( + & INODE, NFRONT, NASS1, NFS4FATHER, + & ISON, MYID, + & IZERO, IDUMMY, IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, + & KEEP, KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( + & COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP, KEEP8, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + IF (ISON .LE. 0) THEN + ISON = IFSON + ENDIF + 220 CONTINUE + END IF + IF (ETATASS.EQ.2) GOTO 500 + POSELT = PTRAST(STEP(INODE)) + IBROT = INODE + DO 260 IORG = 1, NUMORG + JK = PTRAIW(IBROT) + AINPUT = PTRARW(IBROT) + JJ = JK + 1 + J1 = JJ + 1 + J2 = J1 + INTARR(JK) + J3 = J2 + 1 + J4 = J2 - INTARR(JJ) + IJROW = INTARR(J1) + ICT12 = POSELT + int(IJROW - NFRONT - 1,8) +Cduplicates --> CVD$ DEPCHK + DO 240 JJ = J1, J2 + APOS2 = ICT12 + int(INTARR(JJ),8) * NFRONT8 + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + 1 + 240 CONTINUE + IF (J3 .LE. J4) THEN + ICT13 = POSELT + int(IJROW - 1,8) * NFRONT8 + NBCOL = J4 - J3 + 1 +Cduplicates--> CVD$ DEPCHK +CduplicatesCVD$ NODEPCHK + DO 250 JJ = 1, NBCOL + APOS3 = ICT13 + int(INTARR(J3 + JJ - 1) - 1,8) + A(APOS3) = A(APOS3) + DBLARR(AINPUT + JJ - 1) + 250 CONTINUE + ENDIF + IF (KEEP(50).EQ.0) THEN + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(IJROW-1,8) * NFRONT8 + + & int(NFRONT-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ELSE + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(NFRONT-KEEP(253)+JJ-1,8) * NFRONT8 + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + 260 CONTINUE + GOTO 500 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER ALLOCATION DURING DMUMPS_252' + ENDIF + GOTO 490 + 280 CONTINUE + IFLAG = -9 + CALL MUMPS_731(LAELL_REQ8 - LRLUS, IERROR) + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, WORKSPACE TOO SMALL DURING DMUMPS_252' + ENDIF + GOTO 490 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, SEND BUFFER TOO SMALL DURING DMUMPS_252' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, SEND BUFFER TOO SMALL DURING DMUMPS_252' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING DMUMPS_252' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 1 + 490 CALL DMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE DMUMPS_252 + SUBROUTINE DMUMPS_253(COMM_LOAD, ASS_IRECV, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, FILS, FRERE, DAD, + & CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_S, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP, KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, LEAF, IPOOL, LPOOL, + & PERM , MEM_DISTRIB) + USE DMUMPS_COMM_BUFFER + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N,LIW,NSTEPS, NBFIN + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & LPOOL, LEAF, IWPOS, IWPOSCB, COMP + INTEGER(8) :: LRLUS, LRLU, IPTRLU, POSFAC + DOUBLE PRECISION A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER COMM, SLAVEF, MYID, LBUFR, LBUFR_BYTES + INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB + INTEGER IPOOL(LPOOL) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(N), PTRAIW(N), ND(KEEP(28)), + & FILS(N), FRERE(KEEP(28)), DAD (KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), + & PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), PERM(N) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER CAND(SLAVEF+1, max(1,KEEP(56))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER NBPROCFILS(KEEP(28)), + & PROCNODE_STEPS(KEEP(28)), BUFR(LBUFR) + INTEGER INTARR(max(1,KEEP(14))) + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + INTEGER LP, HS, HF, HF_OLD,NCBSON, NSLAVES_OLD, + & NBSPLIT + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + INTEGER NFS4FATHER,I + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER(8) :: LAELL8 + INTEGER LREQ_OOC + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + INTEGER NCB + INTEGER J1,J2,J3,MP + INTEGER(8) :: JJ8, LAPOS2, JJ2, JJ3 + INTEGER NELIM,JJ,JJ1,NPIVS,NCOLS,NROWS, + & IBROT,IORG + INTEGER LDAFS, LDA_SON + INTEGER JK,IJROW,NBCOL,NUMORG,IOLDPS,J4, NUMORG_SPLIT + INTEGER(8) :: ICT13 + INTEGER(8) :: IACHK, APOS, APOS2, POSELT, ICT12, POSEL1 + INTEGER AINPUT + INTEGER NSLAVES, NSLSON + INTEGER NBLIG, PTRCOL, PTRROW, ISLAVE, PDEST + INTEGER PDEST1(1) + INTEGER TYPESPLIT + INTEGER ISON_IN_PLACE + LOGICAL IS_ofType5or6 + LOGICAL SAME_PROC, NIV1, SON_LEVEL2 + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX + INTEGER IZERO + INTEGER IDUMMY(1) + PARAMETER( IZERO = 0 ) + INTEGER MUMPS_275, MUMPS_330, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, MUMPS_810 + DOUBLE PRECISION ZERO + DOUBLE PRECISION RZERO + PARAMETER(RZERO = 0.0D0 ) + PARAMETER( ZERO = 0.0D0 ) + INTEGER NELT, LPTRAR, NCBSON_MAX + logical :: force_cand + INTEGER ETATASS + INCLUDE 'mumps_headers.h' + INTEGER (8) :: APOSMAX + DOUBLE PRECISION MAXARR + INTEGER INIV2, SIZE_TMP_SLAVES_LIST, allocok, + & NCB_SPLIT, SIZE_LIST_SPLIT + INTEGER, ALLOCATABLE, DIMENSION(:) :: TMP_SLAVES_LIST, COPY_CAND + INTEGER NBPANELS_L, NBPANELS_U + MP = ICNTL(2) + IS_ofType5or6 = .FALSE. + COMPRESSCB = .FALSE. + ETATASS = 0 + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + NSTEPS = NSTEPS + 1 + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + ENDDO + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + NCBSON_MAX = 0 + NELT = 1 + LPTRAR = 1 + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + IF ( KEEP(48)==5 .AND. + & MUMPS_330(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) .EQ. 1) THEN + NCBSON_MAX = max + & ( + & IW(PIMASTER(STEP(ISON))+KEEP(IXSZ)), NCBSON_MAX + & ) + ENDIF + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + ENDDO + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + NASS1 = NASS + NUMORG + NCB = NFRONT - NASS1 + if((KEEP(24).eq.0).or.(KEEP(24).eq.1)) then + force_cand=.FALSE. + else + force_cand=(mod(KEEP(24),2).eq.0) + end if + IF (force_cand) THEN + INIV2 = ISTEP_TO_INIV2( STEP( INODE )) + SIZE_TMP_SLAVES_LIST = CAND( SLAVEF+1, INIV2 ) + ELSE + INIV2 = 1 + SIZE_TMP_SLAVES_LIST = SLAVEF - 1 + ENDIF + ALLOCATE(TMP_SLAVES_LIST(SIZE_TMP_SLAVES_LIST),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + TYPESPLIT = MUMPS_810 (PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IS_ofType5or6 = (TYPESPLIT.EQ.5 .OR. TYPESPLIT.EQ.6) + IF ( (TYPESPLIT.EQ.4) + & .OR.(TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) + & ) THEN + IF (TYPESPLIT.EQ.4) THEN + ALLOCATE(COPY_CAND(SLAVEF+1),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + CALL DMUMPS_791 ( + & INODE, STEP, N, SLAVEF, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & CAND(1,INIV2), ICNTL, COPY_CAND, + & NBSPLIT, NUMORG_SPLIT, TMP_SLAVES_LIST(1), + & SIZE_TMP_SLAVES_LIST + & ) + NCB_SPLIT = NCB-NUMORG_SPLIT + SIZE_LIST_SPLIT = SIZE_TMP_SLAVES_LIST - NBSPLIT + CALL DMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, COPY_CAND, + & MEM_DISTRIB(0), NCB_SPLIT, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST(NBSPLIT+1), + & SIZE_LIST_SPLIT,INODE ) + DEALLOCATE (COPY_CAND) + CALL DMUMPS_790 ( + & INODE, STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, + & TAB_POS_IN_PERE(1,INIV2), + & NSLAVES + & ) + ELSE + ISTCHK = PIMASTER(STEP(IFSON)) + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + TMP_SLAVES_LIST (1:SIZE_TMP_SLAVES_LIST) + & = CAND (1:SIZE_TMP_SLAVES_LIST, INIV2) + CALL DMUMPS_792 ( + & INODE, TYPESPLIT, IFSON, + & IW(PDEST), NSLSON, + & STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, ISTEP_TO_INIV2, INIV2, + & TAB_POS_IN_PERE, NSLAVES, + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST + & ) + ENDIF + ELSE + CALL DMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL DMUMPS_684(KEEP(50), NASS1, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL DMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, + & KEEP(216),LRLUS,KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + ENDIF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + ENDIF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + NIV1 = .FALSE. + IF (KEEP(50).EQ.0 .AND. KEEP(234).EQ.0) THEN + CALL MUMPS_81(MYID, INODE, N, IOLDPS, HF, NFRONT, + & NFRONT_EFF, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG, + & PROCNODE_STEPS, SLAVEF ) + ELSE + ISON_IN_PLACE = -9999 + CALL MUMPS_86( MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG, + & ISON_IN_PLACE, + & PROCNODE_STEPS, SLAVEF) + IF (IFLAG.LT.0) GOTO 250 + ENDIF + IF ( NFRONT .NE. NFRONT_EFF ) THEN + IF ( + & (TYPESPLIT.EQ.5) .OR. (TYPESPLIT.EQ.6) ) THEN + WRITE(6,*) ' Internal error 1 in fac_ass due to plitting ', + & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ENDIF + IF (NFRONT.GT.NFRONT_EFF) THEN + NCB = NFRONT_EFF - NASS1 + NSLAVES_OLD = NSLAVES + HF_OLD = HF + IF (TYPESPLIT.EQ.4) THEN + WRITE(6,*) ' Internal error 2 in fac_ass due', + & ' to splitting ', + & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ELSE + CALL DMUMPS_472( NCBSON_MAX, + & SLAVEF, KEEP,KEEP8, ICNTL, + & CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT_EFF, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) - + & (NSLAVES_OLD - NSLAVES) + IF (NSLAVES_OLD .NE. NSLAVES) THEN + IF (NSLAVES_OLD > NSLAVES) THEN + DO JJ=0,2*NFRONT_EFF-1 + IW(IOLDPS+HF+JJ)=IW(IOLDPS+HF_OLD+JJ) + ENDDO + ELSE + IF (IWPOS - 1 > IWPOSCB ) GOTO 270 + DO JJ=2*NFRONT_EFF-1, 0, -1 + IW(IOLDPS+HF+JJ) = IW(IOLDPS+HF_OLD+JJ) + ENDDO + END IF + END IF + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) MYID,': ERROR 2 during ass_niv2, INODE=', INODE, + & ' NFRONT, NFRONT_EFF=', NFRONT, NFRONT_EFF + GOTO 270 + ENDIF + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL DMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + MAXFRW = max0(MAXFRW, NFRONT) + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS + 1+KEEP(IXSZ)) = 0 + IW(IOLDPS + 2+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 3+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) + IW(IOLDPS+KEEP(IXSZ)) = NFRONT + IW(IOLDPS+5+KEEP(IXSZ)) = NSLAVES + IW(IOLDPS+6+KEEP(IXSZ):IOLDPS+5+KEEP(IXSZ)+NSLAVES)= + & TMP_SLAVES_LIST(1:NSLAVES) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + IF ( KEEP(73) .EQ. 0 ) THEN +#endif +#endif + CALL DMUMPS_461(MYID, SLAVEF, COMM_LOAD, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, IW(IOLDPS+6+KEEP(IXSZ)), NSLAVES,INODE) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + ENDIF +#endif +#endif + IF(KEEP(86).EQ.1)THEN + IF(mod(KEEP(24),2).eq.0)THEN + CALL DMUMPS_533(SLAVEF,CAND(SLAVEF+1,INIV2), + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE) + ELSEIF((KEEP(24).EQ.0).OR.(KEEP(24).EQ.1))THEN + CALL DMUMPS_533(SLAVEF,SLAVEF-1, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE) + ENDIF + ENDIF + DEALLOCATE(TMP_SLAVES_LIST) + IF (KEEP(50).EQ.0) THEN + LAELL8 = int(NASS1,8) * int(NFRONT,8) + LDAFS = NFRONT + ELSE + LAELL8 = int(NASS1,8)*int(NASS1,8) + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) + & LAELL8 = LAELL8+int(NASS1,8) + LDAFS = NASS1 + ENDIF + IF (LRLU .LT. LAELL8) THEN + IF (LRLUS .LT. LAELL8) THEN + GOTO 280 + ELSE + CALL DMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + ENDIF + ENDIF + ENDIF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + POSFAC = POSFAC + LAELL8 + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + CALL DMUMPS_471(.FALSE.,.FALSE.,LA-LRLUS,0_8,LAELL8, + & KEEP,KEEP8,LRLU) + POSEL1 = POSELT - int(LDAFS,8) +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. LDAFS .lt. KEEP(63) ) THEN + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO + ELSE + APOS = POSELT + DO JJ8 = 0_8, int(LDAFS-1,8) + A(APOS:APOS+JJ8) = ZERO + APOS = APOS + int(LDAFS,8) + END DO + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + A(APOS:APOS+int(LDAFS,8)-1_8)=ZERO + ENDIF + END IF +#endif + IF ((NUMSTK.NE.0).AND.(NASS.NE.0)) THEN + ISON = IFSON + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + IF (NELIM.EQ.0) GOTO 210 + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS=0 + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + 2+KEEP(IXSZ)) + ELSE + NROWS = NCOLS + ENDIF + OPASSW = OPASSW + dble(NELIM*LSTK) + J1 = ISTCHK + HS + NROWS + NPIVS + J2 = J1 + NELIM - 1 + IACHK = PAMASTER(STEP(ISON)) + IF (KEEP(50).eq.0) THEN + IF (IS_ofType5or6) THEN + APOS = POSELT + DO JJ8 = 1_8, int(NELIM,8)*int(LSTK,8) + A(APOS+JJ8-1_8) = A(APOS+JJ8-1_8) + A(IACHK+JJ8-1_8) + ENDDO + ELSE + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * int(LDAFS,8) + DO 160 JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1),8) - 1_8 + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8)) + 160 CONTINUE + IACHK = IACHK + int(LSTK,8) + 170 CONTINUE + ENDIF + ELSE + IF (NSLSON.EQ.0) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = (int(NELIM,8)*int(NELIM+1,8))/2_8 + ELSE + LCB = int(LDA_SON,8)*int(NELIM,8) + ENDIF + CALL DMUMPS_178( A, LA, + & POSELT, LDAFS, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), NELIM, NELIM, ETATASS, + & COMPRESSCB, + & .FALSE. + & ) + ENDIF + 210 ISON = FRERE(STEP(ISON)) + 220 CONTINUE + ENDIF + IBROT = INODE + APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8) + DO 260 IORG = 1, NUMORG + JK = PTRAIW(IBROT) + AINPUT = PTRARW(IBROT) + JJ = JK + 1 + J1 = JJ + 1 + J2 = J1 + INTARR(JK) + J3 = J2 + 1 + J4 = J2 - INTARR(JJ) + IJROW = INTARR(J1) + ICT12 = POSELT + int(IJROW - 1 - LDAFS, 8) + MAXARR = RZERO +CduplicatesCVD$ NODEPCHK + DO 240 JJ = J1, J2 + IF (KEEP(219).NE.0) THEN + IF (INTARR(JJ).LE.NASS1) THEN + APOS2 = ICT12 + int(INTARR(JJ),8) * int(LDAFS,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + ELSEIF (KEEP(50).EQ.2) THEN + MAXARR = max(MAXARR,abs(DBLARR(AINPUT))) + ENDIF + ELSE + IF (INTARR(JJ).LE.NASS1) THEN + APOS2 = ICT12 + int(INTARR(JJ),8) * int(LDAFS,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + ENDIF + ENDIF + AINPUT = AINPUT + 1 + 240 CONTINUE + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN + A(APOSMAX+int(IJROW-1,8)) = MAXARR + ENDIF + IF (J3 .GT. J4) GOTO 255 + ICT13 = POSELT + int(IJROW - 1,8) * int(LDAFS,8) + NBCOL = J4 - J3 + 1 +CduplicatesCVD$ NODEPCHK +CduplicatesCVD$ NODEPCHK + DO JJ = 1, NBCOL + JJ3 = ICT13 + int(INTARR(J3 + JJ - 1),8) - 1_8 + A(JJ3) = A(JJ3) + DBLARR(AINPUT + JJ - 1) + ENDDO + 255 CONTINUE + IF (KEEP(50).EQ.0) THEN + DO JJ = 1, KEEP(253) + APOS = POSELT + + & int(IJROW-1,8) * int(LDAFS,8) + + & int(LDAFS-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + 260 CONTINUE + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + PDEST = IOLDPS + 6 + KEEP(IXSZ) + DO ISLAVE = 1, NSLAVES + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB, + & NSLAVES, + & NBLIG, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + IERR = -1 + DO WHILE (IERR .EQ.-1) + IF ( KEEP(50) .eq. 0 ) THEN + NBCOL = NFRONT + CALL DMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & IZERO, IDUMMY, + & IW(PDEST), NFRONT, COMM, IERR) + ELSE + NBCOL = NASS1+SHIFT_INDEX+NBLIG + CALL DMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & NSLAVES-ISLAVE, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE), + & IW(PDEST), NFRONT, COMM, IERR) + ENDIF + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + IF (MESSAGE_RECEIVED) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + SHIFT_INDEX + ENDIF + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 300 + IF (IERR .EQ. -3) GOTO 305 + PTRROW = PTRROW + NBLIG + PDEST = PDEST + 1 + ENDDO + IF (NUMSTK.EQ.0) GOTO 500 + ISON = IFSON + DO IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + 2+KEEP(IXSZ)) + ELSE + NROWS = NCOLS + ENDIF + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + IF (KEEP(219).NE.0) THEN + IF(KEEP(50) .EQ. 2) THEN + NFS4FATHER = NCBSON + DO I=0,NCBSON-1 + IF(IW(PTRCOL+I) .GT. NASS1) THEN + NFS4FATHER = I + EXIT + ENDIF + ENDDO + NFS4FATHER = NFS4FATHER+NELIM + ELSE + NFS4FATHER = 0 + ENDIF + ELSE + NFS4FATHER = 0 + ENDIF + IF (NSLSON.EQ.0) THEN + NSLSON = 1 + PDEST1(1) = MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) + IF (PDEST1(1).EQ.MYID) THEN + CALL DMUMPS_211( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)), + & NFRONT, NASS1, NFS4FATHER, NCBSON, + & IW( PTRCOL ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, IW, IW, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ELSE + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON))+HS+NROWS+NPIVS+NELIM + CALL DMUMPS_71( + & INODE, NFRONT,NASS1,NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ) ), + & IW(PTRCOL), NCBSON, + & COMM, IERR, PDEST1, NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ELSE + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL DMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, LPTRAR, NELT, IW, + & IW, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + ENDDO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL DMUMPS_71( + & INODE, NFRONT,NASS1, NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW(PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + ENDDO + GOTO 500 + 250 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING + & DMUMPS_253' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 1 + GOTO 490 + 265 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE ALLOCATING TMP_SLAVES_LIST', + & ' DURING DMUMPS_253' + ENDIF + IFLAG = -13 + IERROR = SIZE_TMP_SLAVES_LIST + GOTO 490 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER ALLOCATION DURING DMUMPS_253' + ENDIF + GOTO 490 + 280 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, WORKSPACE TOO SMALL DURING DMUMPS_253' + ENDIF + IFLAG = -9 + CALL MUMPS_731(LAELL8-LRLUS, IERROR) + GOTO 490 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SEND BUFFER TOO SMALL (1) DURING DMUMPS_253' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECV BUFFER TOO SMALL (1) DURING DMUMPS_253' + ENDIF + IFLAG = -20 + LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SEND BUFFER TOO SMALL (2) DURING DMUMPS_253' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 305 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECV BUFFER TOO SMALL (2) DURING DMUMPS_253' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + 490 CALL DMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE DMUMPS_253 + SUBROUTINE DMUMPS_39(N, INODE, IW, LIW, A, LA, + & ISON, NBROWS, NBCOLS, ROWLIST, + & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER, + & OPASSW, IWPOSCB, MYID, KEEP,KEEP8, IS_ofType5or6, + & LDA_VALSON ) + USE DMUMPS_LOAD + IMPLICIT NONE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA + INTEGER N,LIW,MYID + INTEGER INODE,ISON, IWPOSCB + INTEGER NBROWS, NBCOLS, LDA_VALSON + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER IW(LIW), STEP(N), PIMASTER(KEEP(28)), + & PTLUST_S(KEEP(28)), ROWLIST(NBROWS) + DOUBLE PRECISION A(LA), VALSON(LDA_VALSON,NBROWS) + DOUBLE PRECISION OPASSW + LOGICAL, INTENT(IN) :: IS_ofType5or6 + INTEGER(8) :: POSELT, POSEL1, APOS, JJ2 + INTEGER HF,HS, NSLAVES, NFRONT, NASS1, + & IOLDPS, ISTCHK, LSTK, NSLSON,NELIM, + & NPIVS,NCOLS,J1,JJ,JJ1,NROWS, + & LDAFS_PERE, IBEG, DIAG + INCLUDE 'mumps_headers.h' + LOGICAL SAME_PROC + INTRINSIC real + IOLDPS = PTLUST_S(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS1 = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + IF (KEEP(50).EQ.0) THEN + LDAFS_PERE = NFRONT + ELSE + IF ( NSLAVES .eq. 0 ) THEN + LDAFS_PERE = NFRONT + ELSE + LDAFS_PERE = NASS1 + ENDIF + ENDIF + HF = 6 + NSLAVES + KEEP(IXSZ) + POSEL1 = POSELT - int(LDAFS_PERE,8) + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + OPASSW = OPASSW + dble(NBROWS*NBCOLS) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LT.IWPOSCB) + IF (SAME_PROC) THEN + NROWS = NCOLS + ELSE + NROWS = IW(ISTCHK+2+KEEP(IXSZ)) + ENDIF + J1 = ISTCHK + NROWS + HS + NPIVS + IF (KEEP(50).EQ.0) THEN + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(LDAFS_PERE,8) + DO JJ = 1, NBROWS + DO JJ1 = 1, NBCOLS + JJ2 = APOS + int(JJ1-1,8) + A(JJ2)=A(JJ2)+VALSON(JJ1,JJ) + ENDDO + APOS = APOS + int(LDAFS_PERE,8) + ENDDO + ELSE + DO 170 JJ = 1, NBROWS + APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8) + DO 160 JJ1 = 1, NBCOLS + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + 160 CONTINUE + 170 CONTINUE + ENDIF + ELSE + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(LDAFS_PERE,8) + DIAG = ROWLIST(1) + DO JJ = 1, NBROWS + DO JJ1 = 1, DIAG + JJ2 = APOS+int(JJ1-1,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + ENDDO + DIAG = DIAG+1 + APOS = APOS + int(LDAFS_PERE,8) + ENDDO + ELSE + DO JJ = 1, NBROWS + IF (ROWLIST(JJ).LE.NASS1.and..NOT.IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(JJ) - 1,8) + DO JJ1 = 1, NELIM + JJ2 = APOS + int(IW(J1+JJ1-1),8)*int(LDAFS_PERE,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + ENDDO + IBEG = NELIM+1 + ELSE + IBEG = 1 + ENDIF + APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8) + DO JJ1 = IBEG, NBCOLS + IF (ROWLIST(JJ).LT.IW(J1 + JJ1 - 1)) EXIT + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + ENDDO + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_39 + SUBROUTINE DMUMPS_539 + & (N, INODE, IW, LIW, A, LA, + & NBROWS, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, + & RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, MYID) + IMPLICIT NONE + INTEGER N,LIW + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER INODE, MYID + INTEGER NBROWS, NBCOLS + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), + & PTRIST(KEEP(28)), FILS(N), PTRARW(N), PTRAIW(N) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + DOUBLE PRECISION A(LA), + & DBLARR(max(1,KEEP(13))) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER(8) :: POSELT, ICT12, APOS + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & K1,K2,K,J,JPOS,NASS,JJ, + & IN,AINPUT,JK,J1,J2,IJROW, ILOC + INTEGER :: K1RHS, K2RHS, JFirstRHS + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INCLUDE 'mumps_headers.h' + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NASS = IW(IOLDPS+1+KEEP(IXSZ)) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES + KEEP(IXSZ) + IF (NASS.LT.0) THEN + NASS = -NASS + IW(IOLDPS+1+KEEP(IXSZ)) = NASS + A(POSELT:POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8) = + & ZERO + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NASS - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -JPOS + JPOS = JPOS + 1 + ENDDO + K1 = IOLDPS + HF + K2 = K1 + NBROWF - 1 + JPOS = 1 + IF ((KEEP(253).GT.0).AND.(KEEP(50).NE.0)) THEN + K1RHS = 0 + K2RHS = -1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + IF ((K1RHS.EQ.0).AND.(J.GT.N)) THEN + K1RHS = K + JFirstRHS=J-N + ENDIF + JPOS = JPOS + 1 + ENDDO + IF (K1RHS.GT.0) K2RHS=K2 + IF ( K2RHS.GE.K1RHS ) THEN + IN = INODE + DO WHILE (IN.GT.0) + IJROW = -ITLOC(IN) + DO K = K1RHS, K2RHS + J = IW(K) + ILOC = ITLOC(J) + APOS = POSELT+int(ILOC-1,8)*int(NBCOLF,8) + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( + & (JFirstRHS+(K-K1RHS)-1)*KEEP(254)+IN) + ENDDO + IN = FILS(IN) + ENDDO + ENDIF + ELSE + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + JPOS = JPOS + 1 + ENDDO + ENDIF + IN = INODE + DO WHILE (IN.GT.0) + AINPUT = PTRARW(IN) + JK = PTRAIW(IN) + JJ = JK + 1 + J1 = JJ + 1 + J2 = J1 + INTARR(JK) + IJROW = -ITLOC(INTARR(J1)) + ICT12 = POSELT +int(- NBCOLF + IJROW - 1,8) + DO JJ= J1,J2 + ILOC = ITLOC(INTARR(JJ)) + IF (ILOC.GT.0) THEN + APOS = ICT12 + int(ILOC,8)*int(NBCOLF,8) + A(APOS) = A(APOS) + DBLARR(AINPUT) + ENDIF + AINPUT = AINPUT + 1 + ENDDO + IN = FILS(IN) + ENDDO + K1 = IOLDPS + HF + K2 = K1 + NBROWF + NASS - 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = 0 + ENDDO + ENDIF + IF (NBROWS.GT.0) THEN + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + JPOS = JPOS + 1 + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_539 + SUBROUTINE DMUMPS_531 + & (N, INODE, IW, LIW, NBROWS, STEP, PTRIST, + & ITLOC, RHS_MUMPS, KEEP,KEEP8) + IMPLICIT NONE + INTEGER N, LIW + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER INODE + INTEGER NBROWS + INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), + & PTRIST(KEEP(28)) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INCLUDE 'mumps_headers.h' + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & K1,K2,K,J + IOLDPS = PTRIST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + IF (NBROWS.GT.0) THEN + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = 0 + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_531 + SUBROUTINE DMUMPS_40(N, INODE, IW, LIW, A, LA, + & NBROWS, NBCOLS, ROWLIST, COLLIST, VALSON, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, + & RHS_MUMPS, FILS, + & ICNTL, KEEP,KEEP8, MYID, IS_ofType5or6, LDA_VALSON) + IMPLICIT NONE + INTEGER N,LIW + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER INODE, MYID + LOGICAL, intent(in) :: IS_ofType5or6 + INTEGER NBROWS, NBCOLS, LDA_VALSON + INTEGER ROWLIST(NBROWS), COLLIST(NBCOLS) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), + & PTRIST(KEEP(28)), FILS(N) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRAST(KEEP(28)) + DOUBLE PRECISION A(LA), VALSON(LDA_VALSON,NBROWS) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER(8) :: POSEL1, POSELT, APOS, K8 + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & I,J,NASS,IDIAG + INCLUDE 'mumps_headers.h' + INTRINSIC real + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NASS = IW(IOLDPS+1+KEEP(IXSZ)) + IF ( NBROWS .GT. NBROWF ) THEN + WRITE(*,*) ' ERR: ERROR : NBROWS > NBROWF' + WRITE(*,*) ' ERR: INODE =', INODE + WRITE(*,*) ' ERR: NBROW=',NBROWS,'NBROWF=',NBROWF + WRITE(*,*) ' ERR: ROW_LIST=', ROWLIST + CALL MUMPS_ABORT() + END IF + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + IF (NBROWS.GT.0) THEN + POSEL1 = POSELT - int(NBCOLF,8) + IF (KEEP(50).EQ.0) THEN + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8) + DO I=1, NBROWS + DO J = 1, NBCOLS + A(APOS+int(J-1,8)) = A( APOS+int(J-1,8)) + VALSON(J,I) + ENDDO + APOS = APOS + int(NBCOLF,8) + END DO + ELSE + DO I=1,NBROWS + APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8) + DO J=1,NBCOLS + K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8 + A(K8) = A(K8) + VALSON(J,I) + ENDDO + ENDDO + ENDIF + ELSE + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8) + & + int((NBROWS-1),8)*int(NBCOLF,8) + IDIAG = 0 + DO I=NBROWS,1,-1 + A(APOS:APOS+int(NBCOLS-IDIAG-1,8))= + & A(APOS:APOS+int(NBCOLS-IDIAG-1,8)) + + & VALSON(1:NBCOLS-IDIAG,I) + APOS = APOS - int(NBCOLF,8) + IDIAG = IDIAG + 1 + ENDDO + ELSE + DO I=1,NBROWS + APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8) + DO J=1,NBCOLS + IF (ITLOC(COLLIST(J)) .EQ. 0) THEN + write(6,*) ' .. exit for col =', J + EXIT + ENDIF + K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8 + A(K8) = A(K8) + VALSON(J,I) + ENDDO + ENDDO + ENDIF + ENDIF + OPASSW = OPASSW + dble(NBROWS*NBCOLS) + ENDIF + RETURN + END SUBROUTINE DMUMPS_40 + SUBROUTINE DMUMPS_178( A, LA, + & IAFATH, NFRONT, NASS1, + & IACB, NCOLS, LCB, + & IW, NROWS, NELIM, ETATASS, + & CB_IS_COMPRESSED, IS_INPLACE + & ) + IMPLICIT NONE + INTEGER NFRONT, NASS1 + INTEGER(8) :: LA + INTEGER NCOLS, NROWS, NELIM + INTEGER(8) :: LCB + DOUBLE PRECISION A( LA ) + INTEGER(8) :: IAFATH, IACB + INTEGER IW( NCOLS ) + INTEGER ETATASS + LOGICAL CB_IS_COMPRESSED, IS_INPLACE + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS, + & RISK_OF_SAME_POS_THIS_LINE, OMP_FLAG + INTEGER I, J + INTEGER(8) :: APOS, POSELT + INTEGER(8) :: IPOSCB, IBEGCBROW, IENDFRONT + IENDFRONT = IAFATH+int(NFRONT,8)*int(NFRONT,8)-1_8 + IF ( IS_INPLACE ) THEN + IPOSCB=1_8 + RESET_TO_ZERO = IACB .LT. IENDFRONT + 1_8 + RISK_OF_SAME_POS = IACB + LCB .EQ. IENDFRONT + 1_8 + RISK_OF_SAME_POS_THIS_LINE = .FALSE. + DO I=1, NROWS + POSELT = int(IW(I)-1,8) * int(NFRONT,8) + IF (.NOT. CB_IS_COMPRESSED ) THEN + IPOSCB = 1_8 + int(I - 1,8) * int(NCOLS,8) + IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN + RESET_TO_ZERO = .FALSE. + ENDIF + ENDIF + IF ( RISK_OF_SAME_POS ) THEN + IF (I.EQ.NROWS .OR. .NOT. CB_IS_COMPRESSED) THEN + IF ( IAFATH + POSELT + int(IW(I)-1,8) .EQ. + & IACB+IPOSCB+int(I-1-1,8)) THEN + RISK_OF_SAME_POS_THIS_LINE = .TRUE. + ENDIF + ENDIF + ENDIF + IF (RESET_TO_ZERO) THEN + IF ( RISK_OF_SAME_POS_THIS_LINE ) THEN + DO J=1, I + APOS = POSELT + int(IW( J ),8) + IF (IAFATH + APOS - 1_8.NE. IACB+IPOSCB-1_8) THEN + A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) + A(IACB+IPOSCB-1_8) = ZERO + ENDIF + IPOSCB = IPOSCB + 1_8 + ENDDO + ELSE + DO J=1, I + APOS = POSELT + int(IW( J ),8) + A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) + A(IACB+IPOSCB-1_8) = ZERO + IPOSCB = IPOSCB + 1_8 + ENDDO + ENDIF + ELSE + DO J=1, I + APOS = POSELT + int(IW( J ),8) + A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + ENDDO + ENDIF + IF (.NOT. CB_IS_COMPRESSED ) THEN + IBEGCBROW = IACB+IPOSCB-1_8 + IF ( IBEGCBROW .LE. IENDFRONT ) THEN + A(IBEGCBROW:IBEGCBROW+int(NCOLS-I,8)-1_8)=ZERO + ENDIF + ENDIF + IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN + RESET_TO_ZERO = .FALSE. + ENDIF + ENDDO + RETURN + ENDIF + IF ((ETATASS.EQ.0) .OR. (ETATASS.EQ.1)) THEN + IPOSCB = 1_8 + DO I = 1, NELIM + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + IF (.NOT. CB_IS_COMPRESSED) THEN + IPOSCB = 1_8 + int( I - 1, 8 ) * int(NCOLS,8) + ENDIF + DO J = 1, I + APOS = POSELT + int(IW( J ),8) + A(IAFATH+ APOS -1_8) = A(IAFATH+ APOS -1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + END DO + ENDIF + IF ((ETATASS.EQ.0).OR.(ETATASS.EQ.1)) THEN + OMP_FLAG = (NROWS-NELIM).GE.300 + DO I = NELIM + 1, NROWS + IF (CB_IS_COMPRESSED) THEN + IPOSCB = (int(I,8) * int(I-1,8)) / 2_8 + 1_8 + ELSE + IPOSCB = int(I-1,8) * int(NCOLS,8) + 1_8 + ENDIF + POSELT = int(IW( I ),8) + IF (POSELT.LE. int(NASS1,8) .AND. .NOT. IS_INPLACE) THEN + DO J = 1, NELIM + APOS = POSELT + int( IW( J ) - 1, 8 ) * int(NFRONT,8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + + & A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + ELSE + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J = 1, NELIM + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + ENDIF + IF (ETATASS.EQ.1) THEN + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J = NELIM + 1, I + IF (IW(J).GT.NASS1) EXIT + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB +1_8 + END DO + ELSE + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J = NELIM + 1, I + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + ENDIF + END DO + ELSE + DO I= NROWS, NELIM+1, -1 + IF (CB_IS_COMPRESSED) THEN + IPOSCB = (int(I,8)*int(I+1,8))/2_8 + ELSE + IPOSCB = int(I-1,8) * int(NCOLS,8) + int(I,8) + ENDIF + POSELT = int(IW( I ),8) + IF (POSELT.LE.int(NASS1,8)) EXIT + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J=I,NELIM+1, -1 + IF (IW(J).LE.NASS1) EXIT + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB - 1_8 + ENDDO + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_178 + SUBROUTINE DMUMPS_530(N, ISON, INODE, IWPOSCB, + & PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8) + IMPLICIT NONE + INTEGER N, ISON, INODE, IWPOSCB + INTEGER KEEP(500), STEP(N) + INTEGER(8) KEEP8(150) + INTEGER PIMASTER(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER LIW + INTEGER IW(LIW) + INTEGER ISTCHK, LSTK, NSLSON, HS, NROWS, NCOLS, NPIVS, NELIM + INTEGER IOLDPS, NFRONT, NSLAVES, ICT11, HF + INTEGER J1, J2, J3, JJ, JPOS + LOGICAL SAME_PROC + INCLUDE 'mumps_headers.h' + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + NCOLS = NPIVS + LSTK + IF ( NPIVS < 0 ) NPIVS = 0 + SAME_PROC = ISTCHK < IWPOSCB + IF (SAME_PROC) THEN + NROWS = NCOLS + ELSE + NROWS = IW(ISTCHK+2+KEEP(IXSZ)) + ENDIF + J1 = ISTCHK + NROWS + HS + NPIVS + IF (KEEP(50).NE.0) THEN + J2 = J1 + LSTK - 1 + DO JJ = J1, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + ELSE + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM + DO JJ = J3, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + IF (NELIM .NE. 0) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + ICT11 = IOLDPS + HF - 1 + NFRONT + J3 = J3 - 1 + DO 190 JJ = J1, J3 + JPOS = IW(JJ) + ICT11 + IW(JJ) = IW(JPOS) + 190 CONTINUE + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_530 + SUBROUTINE DMUMPS_619( + & N, INODE, IW, LIW, A, LA, + & ISON, NBCOLS, + & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER, + & OPASSW, IWPOSCB,MYID, KEEP,KEEP8 ) + USE DMUMPS_LOAD + IMPLICIT NONE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA + INTEGER N,LIW,MYID + INTEGER INODE,ISON,IWPOSCB + INTEGER NBCOLS + INTEGER IW(LIW), STEP(N), + & PIMASTER(KEEP(28)), + & PTLUST_S(KEEP(28)) + INTEGER(8) PTRAST(KEEP(28)) + DOUBLE PRECISION A(LA) + DOUBLE PRECISION VALSON(NBCOLS) + DOUBLE PRECISION OPASSW + INTEGER HF,HS, NSLAVES, NASS1, + & IOLDPS, ISTCHK, + & LSTK, NSLSON,NELIM,NPIVS,NCOLS, J1, + & JJ1,NROWS + INTEGER(8) POSELT, APOS, JJ2 + INCLUDE 'mumps_headers.h' + LOGICAL SAME_PROC + INTRINSIC real + IOLDPS = PTLUST_S(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NASS1 = iabs(IW(IOLDPS + 2 + KEEP(IXSZ))) + NSLAVES= IW(IOLDPS+5 + KEEP(IXSZ)) + HF = 6 + NSLAVES + KEEP(IXSZ) + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NELIM = IW(ISTCHK + 1 + KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LT.IWPOSCB) + IF (SAME_PROC) THEN + NROWS = NCOLS + ELSE + NROWS = IW(ISTCHK+2 + KEEP(IXSZ)) + ENDIF + J1 = ISTCHK + NROWS + HS + NPIVS + APOS = POSELT + int(NASS1,8)*int(NASS1,8) - 1_8 + DO JJ1 = 1, NBCOLS + JJ2 = APOS+int(IW(J1 + JJ1 - 1),8) + IF(abs(A(JJ2)) .LT. VALSON(JJ1)) + & A(JJ2) = VALSON(JJ1) + ENDDO + RETURN + END SUBROUTINE DMUMPS_619 + RECURSIVE SUBROUTINE DMUMPS_264( + & COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE DMUMPS_OOC + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mumps_headers.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER(8) :: POSFAC + INTEGER COMP + INTEGER IFLAG, IERROR, NBFIN, MSGSOU + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER NBPROCFILS( KEEP(28) ), STEP(N), + & PIMASTER(KEEP(28)) + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER COMM, MYID + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER PTLUST_S(KEEP(28)), + & ITLOC(N+KEEP(253)), FILS(N), ND(KEEP(28)) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER FRERE_STEPS(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION FLOP1 + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER INODE, POSITION, NPIV, IERR, LP + INTEGER NCOL + INTEGER(8) :: POSBLOCFACTO + INTEGER(8) :: LAELL + INTEGER(8) :: POSELT + INTEGER IOLDPS, LCONT1, NASS1, NROW1, NCOL1, NPIV1 + INTEGER NSLAV1, HS, ISW + INTEGER (8) :: LPOS, LPOS1, LPOS2, IPOS, KPOS + INTEGER ICT11 + INTEGER I, IPIV, FPERE + LOGICAL LASTBL + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + DOUBLE PRECISION ONE,ALPHA + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, NextPivDummy + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + FPERE = -1 + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, + & MPI_INTEGER, COMM, IERR ) + LASTBL = (NPIV.LE.0) + IF (LASTBL) THEN + NPIV = -NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, + & MPI_INTEGER, COMM, IERR ) + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOL, 1, + & MPI_INTEGER, COMM, IERR ) + LAELL = int(NPIV,8) * int(NCOL,8) + IF ( LRLU .LT. LAELL .OR. IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LAELL ) THEN + IFLAG = -9 + CALL MUMPS_731(LAELL - LRLUS, IERROR) + IF (ICNTL(1).GT.0 .AND. ICNTL(4).GE.1) THEN + LP=ICNTL(1) + WRITE(LP,*) + &" FAILURE, WORKSPACE TOO SMALL DURING DMUMPS_264" + ENDIF + GOTO 700 + END IF + CALL DMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS=' + & ,LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731( LAELL-LRLUS, IERROR ) + GOTO 700 + END IF + IF ( IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF (ICNTL(1).GT.0 .AND. ICNTL(4).GE.1) THEN + LP=ICNTL(1) + WRITE(LP,*) + &" FAILURE IN INTEGER ALLOCATION DURING DMUMPS_264" + ENDIF + IFLAG = -8 + IERROR = IWPOS + NPIV - 1 - IWPOSCB + GOTO 700 + END IF + END IF + LRLU = LRLU - LAELL + LRLUS = LRLUS - LAELL + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSBLOCFACTO = POSFAC + POSFAC = POSFAC + LAELL + CALL DMUMPS_471(.FALSE., .FALSE., + & LA-LRLUS,0_8,LAELL,KEEP,KEEP8,LRLU) + IPIV = IWPOS + IWPOS = IWPOS + NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IPIV ), NPIV, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSBLOCFACTO), NPIV*NCOL, + & MPI_DOUBLE_PRECISION, + & COMM, IERR ) + IF (PTRIST(STEP( INODE )) .EQ. 0) THEN + DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 ) + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. + & ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + ENDIF + DO WHILE ( NBPROCFILS( STEP(INODE)) .NE. 0 ) + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, CONTRIB_TYPE2, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .TRUE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + LCONT1 = IW( IOLDPS +KEEP(IXSZ)) + NASS1 = IW( IOLDPS + 1 +KEEP(IXSZ)) + NROW1 = IW( IOLDPS + 2 +KEEP(IXSZ)) + NPIV1 = IW( IOLDPS + 3 +KEEP(IXSZ)) + NSLAV1 = IW( IOLDPS + 5 +KEEP(IXSZ)) + HS = 6 + NSLAV1 + KEEP(IXSZ) + NCOL1 = LCONT1 + NPIV1 + IF (NPIV.GT.0) THEN + ICT11 = IOLDPS+HS+NROW1+NPIV1 - 1 + DO I = 1, NPIV + IF (IW(IPIV+I-1).EQ.I) CYCLE + ISW = IW(ICT11+I) + IW(ICT11+I) = IW(ICT11+IW(IPIV+I-1)) + IW(ICT11+IW(IPIV+I-1)) = ISW + IPOS = POSELT + int(NPIV1 + I - 1,8) + KPOS = POSELT + int(NPIV1 + IW(IPIV+I-1) - 1,8) + CALL dswap(NROW1, A(IPOS), NCOL1, A(KPOS), NCOL1) + ENDDO + LPOS2 = POSELT + int(NPIV1,8) + CALL dtrsm('L','L','N','N',NPIV, NROW1, ONE, + & A(POSBLOCFACTO), NCOL, A(LPOS2), NCOL1) + LPOS1 = POSBLOCFACTO+int(NPIV,8) + LPOS = LPOS2 + int(NPIV,8) + ENDIF + IF (KEEP(201).eq.1) THEN + MonBloc%INODE = INODE + MonBloc%MASTER = .FALSE. + MonBloc%Typenode = 2 + MonBloc%NROW = NROW1 + MonBloc%NCOL = NCOL1 + MonBloc%NFS = NASS1 + MonBloc%LastPiv = NPIV1 + NPIV + NULLIFY(MonBloc%INDICES) + MonBloc%Last = LASTBL + STRAT = STRAT_TRY_WRITE + NextPivDummy = -8888 + LIWFAC = IW(IOLDPS+XXI) + CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR)) + LAST_CALL = .FALSE. + CALL DMUMPS_688( STRAT, TYPEF_L, A(POSELT), + & LAFAC, MonBloc, NextPivDummy, NextPivDummy, + & IW(IOLDPS), LIWFAC, MYID, KEEP8(31), IFLAG,LAST_CALL) + ENDIF + IF ( NPIV .GT. 0 ) THEN + CALL dgemm('N','N', NCOL-NPIV,NROW1,NPIV, + & ALPHA,A(LPOS1),NCOL, + & A(LPOS2),NCOL1,ONE, A(LPOS),NCOL1) + ENDIF + IW(IOLDPS+KEEP(IXSZ) ) = IW(IOLDPS+KEEP(IXSZ) ) - NPIV + IW(IOLDPS + 3+KEEP(IXSZ) ) = IW(IOLDPS+3+KEEP(IXSZ) ) + NPIV + IF (LASTBL) IW(IOLDPS+1+KEEP(IXSZ) ) = IW(IOLDPS + 3+KEEP(IXSZ) ) + IF ( .not. LASTBL .AND. + & (IW(IOLDPS+1+KEEP(IXSZ)) .EQ. IW(IOLDPS + 3+KEEP(IXSZ))) ) THEN + write(*,*) ' ERROR 1 **** IN BLACFACTO ' + CALL MUMPS_ABORT() + ENDIF + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + IWPOS = IWPOS - NPIV + FLOP1 = dble( NPIV1*NROW1 ) + + & dble(NROW1*NPIV1)*dble(2*NCOL1-NPIV1-1) + & - + & dble((NPIV1+NPIV)*NROW1 ) - + & dble(NROW1*(NPIV1+NPIV))*dble(2*NCOL1-NPIV1-NPIV-1) + CALL DMUMPS_190( 1, .FALSE., FLOP1, KEEP,KEEP8 ) + IF (LASTBL) THEN + CALL DMUMPS_759( + & COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ENDIF + 600 CONTINUE + RETURN + 700 CONTINUE + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE DMUMPS_264 + SUBROUTINE DMUMPS_699( COMM_LOAD, ASS_IRECV, + & MSGLEN, BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC, + & N, IW, LIW, A, LA, PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, NBPROCFILS, + & COMP, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, NSTK_S, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, NBFIN, + & MYID, COMM, ICNTL, KEEP,KEEP8, IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, LPTRAR, NELT, + & FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE DMUMPS_LOAD + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV, MSGLEN + INTEGER BUFR( LBUFR ) + INTEGER(8) :: LRLU, IPTRLU, LRLUS, LA, POSFAC + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER NBFIN + INTEGER COMP + INTEGER NELT, LPTRAR + INTEGER PROCNODE_STEPS( KEEP(28) ), PTRIST(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER PTLUST_S( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER ITLOC( N + KEEP(253)), NSTK_S( KEEP(28) ), FILS( N ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER ND(KEEP(28)), FRERE_STEPS( KEEP(28) ) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION DBLARR( max( 1,KEEP(13)) ) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER COMM, MYID, IFLAG, IERROR + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER FRTPTR(N+1), FRTELT( NELT ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER NFS4FATHER + INCLUDE 'mumps_headers.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER MUMPS_275, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_810 + INTEGER IERR + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INTEGER I, INODE, ISON, POSITION, NBROW, LROW, IROW, INDCOL + INTEGER LREQI + INTEGER(8) :: LREQA, POSCONTRIB + INTEGER ROW_LENGTH + INTEGER MASTER + INTEGER ISTCHK + LOGICAL SAME_PROC + LOGICAL SLAVE_NODE + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED, IS_ofType5or6 + INTEGER ISHIFT_BUFR, LBUFR_LOC, LBUFR_BYTES_LOC + INTEGER TYPESPLIT + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, ISON, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NBROW, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, LROW, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, + & MPI_INTEGER, COMM, IERR ) + MASTER = MUMPS_275(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + SLAVE_NODE = MASTER .NE. MYID + TYPESPLIT = MUMPS_810(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IS_ofType5or6 = ((TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) + IF (SLAVE_NODE .AND. PTRIST(STEP(INODE)) ==0) THEN + ISHIFT_BUFR = ( MSGLEN + KEEP(34) ) / KEEP(34) + LBUFR_LOC = LBUFR - ISHIFT_BUFR + 1 + LBUFR_BYTES_LOC = LBUFR_LOC * KEEP(34) + DO WHILE ( PTRIST( STEP(INODE) ) .EQ. 0 ) + MASTER = MUMPS_275(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MASTER, MAITRE_DESC_BANDE, + & STATUS, + & BUFR(ISHIFT_BUFR), LBUFR_LOC, LBUFR_BYTES_LOC, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF (IFLAG.LT.0) RETURN + END DO + ENDIF + IF ( SLAVE_NODE ) THEN + LREQI = LROW + NBROWS_PACKET + ELSE + LREQI = NBROWS_PACKET + END IF + LREQA = int(LROW,8) + IF ( LRLU .LT. LREQA .OR. IWPOS + LREQI + & - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LREQA ) THEN + IFLAG = -9 + CALL MUMPS_731( LREQA - LRLUS, IERROR ) + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END IF + CALL DMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..process_contrib' + WRITE(*,*) 'LRLU,LRLUS=',LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731( LREQA - LRLUS, IERROR ) + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END IF + IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END IF + END IF + LRLU = LRLU - LREQA + LRLUS = LRLUS - LREQA + POSCONTRIB = POSFAC + POSFAC = POSFAC + LREQA + KEEP8(67) = min(LRLUS, KEEP8(67)) + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU) + IF ( SLAVE_NODE ) THEN + IROW = IWPOS + INDCOL = IWPOS + NBROWS_PACKET + ELSE + IROW = IWPOS + INDCOL = -1 + END IF + IWPOS = IWPOS + LREQI + IF ( SLAVE_NODE ) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( INDCOL ), LROW, MPI_INTEGER, + & COMM, IERR ) + END IF + DO I = 1, NBROWS_PACKET + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IROW + I - 1 ), 1, MPI_INTEGER, + & COMM, IERR ) + END DO + IF ( SLAVE_NODE ) THEN + IF ( NBROWS_ALREADY_SENT + NBROWS_PACKET == NBROW ) THEN + NBPROCFILS(STEP(INODE))=NBPROCFILS(STEP(INODE))-1 + ENDIF + IF ( KEEP(55) .eq. 0 ) THEN + CALL DMUMPS_539 + & (N, INODE, IW, LIW, A, LA, + & NBROW, LROW, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, MYID ) + ELSE + CALL DMUMPS_123( + & NELT, FRTPTR, FRTELT, + & N, INODE, IW, LIW, A, LA, + & NBROW, LROW, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, MYID ) + ENDIF + DO I=1,NBROWS_PACKET + IF(KEEP(50).NE.0)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & ROW_LENGTH, + & 1, + & MPI_INTEGER, + & COMM, IERR ) + ELSE + ROW_LENGTH=LROW + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSCONTRIB), + & ROW_LENGTH, + & MPI_DOUBLE_PRECISION, + & COMM, IERR ) + CALL DMUMPS_40(N, INODE, IW, LIW, A, LA, + & 1, ROW_LENGTH, IW( IROW+I-1 ),IW(INDCOL), + & A(POSCONTRIB), + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, ICNTL, KEEP,KEEP8, MYID, IS_ofType5or6, + & ROW_LENGTH ) + ENDDO + CALL DMUMPS_531 + & (N, INODE, IW, LIW, + & NBROWS_PACKET, STEP, PTRIST, + & ITLOC, RHS_MUMPS,KEEP,KEEP8) + ELSE + DO I=1,NBROWS_PACKET + IF(KEEP(50).NE.0)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & ROW_LENGTH, + & 1, + & MPI_INTEGER, + & COMM, IERR ) + ELSE + ROW_LENGTH=LROW + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSCONTRIB), + & ROW_LENGTH, + & MPI_DOUBLE_PRECISION, + & COMM, IERR ) + CALL DMUMPS_39(N, INODE, IW, LIW, A, LA, + & ISON, 1, ROW_LENGTH, IW( IROW +I-1 ), + & A(POSCONTRIB), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, ROW_LENGTH + &) + ENDDO + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + IF (KEEP(219).NE.0) THEN + IF(KEEP(50) .EQ. 2) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NFS4FATHER, + & 1, + & MPI_INTEGER, + & COMM, IERR ) + IF(NFS4FATHER .GT. 0) THEN + CALL DMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE. 0) THEN + IERROR = BUF_LMAX_ARRAY + IFLAG = -13 + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & BUF_MAX_ARRAY, + & NFS4FATHER, + & MPI_DOUBLE_PRECISION, + & COMM, IERR ) + CALL DMUMPS_619(N, INODE, IW, LIW, A, LA, + & ISON, NFS4FATHER, + & BUF_MAX_ARRAY, PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8) + ENDIF + ENDIF + ENDIF + ENDIF + IF (NBROWS_ALREADY_SENT + NBROWS_PACKET == NBROW ) THEN + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE)) - 1 + NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - 1 + IF ( NBPROCFILS(STEP(ISON)) .EQ. 0) THEN + ISTCHK = PIMASTER(STEP(ISON)) + SAME_PROC= ISTCHK .LT. IWPOSCB + IF (SAME_PROC) THEN + CALL DMUMPS_530(N, ISON, INODE, IWPOSCB, + & PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8) + ENDIF + IF (SAME_PROC) THEN + ISTCHK = PTRIST(STEP(ISON)) + PTRIST(STEP( ISON) ) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL DMUMPS_152(.FALSE., MYID, N, ISTCHK, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, IWPOSCB, + & LA, KEEP,KEEP8, .FALSE. + & ) + ENDIF + IF ( NBPROCFILS(STEP(INODE)) .EQ. 0 ) THEN + CALL DMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), + & KEEP(47), STEP, INODE+N ) + IF (KEEP(47) .GE. 3) THEN + CALL DMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + ENDIF + ENDIF + END IF + IWPOS = IWPOS - LREQI + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + POSFAC = POSFAC - LREQA + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU) + RETURN + END SUBROUTINE DMUMPS_699 + SUBROUTINE DMUMPS_143( N, INODE, IW, LIW, A, LA, + & IOLDPS, POSELT, IFLAG, UU, NOFFW, + & NPVW, + & KEEP,KEEP8, STEP, + & PROCNODE_STEPS, MYID, SLAVEF, SEUIL, + & AVOID_DELAYED, ETATASS, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & IWPOS ) + USE DMUMPS_OOC + IMPLICIT NONE + INTEGER(8) :: LA, POSELT + INTEGER N, INODE, LIW, IFLAG, NOFFW, NPVW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER MYID, SLAVEF, IOLDPS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS( KEEP(28) ), STEP(N) + DOUBLE PRECISION UU, SEUIL + LOGICAL AVOID_DELAYED + INTEGER ETATASS, IWPOS + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER INOPV, IFINB, NFRONT, NPIV, IBEG_BLOCK + INTEGER NASS, NEL1, NPIVB, NPIVE, NBOLKJ, NBTLKJ + DOUBLE PRECISION UUTEMP + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, LNextPiv2beWritten, + & UNextPiv2beWritten, IFLAG_OOC, + & PP_FIRST2SWAP_L, PP_FIRST2SWAP_U, + & PP_LastPIVRPTRFilled_L, + & PP_LastPIVRPTRFilled_U + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INCLUDE 'mumps_headers.h' + EXTERNAL MUMPS_330, DMUMPS_221, DMUMPS_233, + & DMUMPS_229, + & DMUMPS_225, DMUMPS_232, DMUMPS_231, + & DMUMPS_220, + & DMUMPS_228, DMUMPS_236 + INTEGER MUMPS_330 + LOGICAL STATICMODE + DOUBLE PRECISION SEUIL_LOC + INOPV = 0 + SEUIL_LOC = SEUIL + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + UUTEMP=UU + ENDIF + IBEG_BLOCK=1 + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5), NASS ) + ENDIF + NBTLKJ = NBOLKJ + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_BOTH_LU + LNextPiv2beWritten = 1 + UNextPiv2beWritten = 1 + PP_FIRST2SWAP_L = LNextPiv2beWritten + PP_FIRST2SWAP_U = UNextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + MonBloc%LastPanelWritten_U = 0 + PP_LastPIVRPTRFilled_L = 0 + PP_LastPIVRPTRFilled_U = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 1 + MonBloc%NROW = NFRONT + MonBloc%NCOL = NFRONT + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -88877 + NULLIFY(MonBloc%INDICES) + ENDIF + 50 CONTINUE + CALL DMUMPS_221(NFRONT,NASS,N,INODE,IW,LIW,A,LA,INOPV,NOFFW, + & IFLAG,IOLDPS,POSELT,UU,SEUIL_LOC,KEEP,KEEP8, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U, + & PP_LastPIVRPTRFilled_U) + IF (IFLAG.LT.0) GOTO 500 + IF (INOPV.EQ.1) THEN + IF(STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + GOTO 80 + ENDIF + IF (INOPV.EQ.2) THEN + CALL DMUMPS_233(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,NBOLKJ, NBTLKJ,KEEP(4),KEEP(IXSZ)) + GOTO 50 + ENDIF + NPVW = NPVW + 1 + IF (NASS.LE.1) THEN + CALL DMUMPS_229(NFRONT,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,KEEP(IXSZ)) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + GO TO 500 + ENDIF + CALL DMUMPS_225(IBEG_BLOCK,NFRONT, NASS, N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB, + & NBTLKJ,KEEP(4),KEEP(IXSZ)) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + IF (IFINB.EQ.0) GOTO 50 + IF (KEEP(201).EQ.1) THEN + MonBloc%LastPiv= IW(IOLDPS+1+KEEP(IXSZ)) + STRAT = STRAT_TRY_WRITE + TYPEFile = TYPEF_U + LAST_CALL = .FALSE. + CALL DMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + ENDIF + IF (IFINB.EQ.(-1)) GOTO 80 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NEL1 = NASS - NPIV + CALL DMUMPS_232(A,LA, + & NFRONT,NPIV,NASS,POSELT,NBTLKJ) + GO TO 50 + 80 CONTINUE + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + IF (NPIV.LE.0) GO TO 110 + NEL1 = NFRONT - NASS + IF (NEL1.LE.0) GO TO 110 + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_TRY_WRITE + TYPEFile = TYPEF_BOTH_LU + MonBloc%LastPiv= NPIV + CALL DMUMPS_642(A(POSELT), LAFAC, NFRONT, + & NPIV, NASS, IW(IOLDPS), LIWFAC, + & MonBloc, TYPEFile, MYID, KEEP8, + & STRAT, IFLAG_OOC, + & LNextPiv2beWritten, UNextPiv2beWritten) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + ELSE + CALL DMUMPS_231(A,LA,NFRONT, NPIV,NASS,POSELT) + ENDIF + 110 CONTINUE + IF (MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + & .EQ.1) THEN + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + IBEG_BLOCK = NPIV + IF (NASS.EQ.NPIV) GOTO 500 + 120 CALL DMUMPS_220(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IOLDPS,POSELT,UU,SEUIL, + & KEEP, DKEEP, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U, + & PP_LastPIVRPTRFilled_U) + IF (INOPV.NE.1) THEN + NPVW = NPVW + 1 + CALL DMUMPS_228(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB,KEEP(IXSZ)) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + IF (IFINB.EQ.0) GOTO 120 + ENDIF + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NPIVB = IBEG_BLOCK + NPIVE = NPIV - NPIVB + NEL1 = NFRONT - NASS + IF ((NPIVE.LE.0).OR.(NEL1.EQ.0)) GO TO 500 + CALL DMUMPS_236(A,LA,NPIVB, + & NFRONT,NPIV,NASS,POSELT) + ENDIF + 500 CONTINUE + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + TYPEFile = TYPEF_BOTH_LU + LAST_CALL = .TRUE. + CALL DMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC, LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + CALL DMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + RETURN + END SUBROUTINE DMUMPS_143 + RECURSIVE SUBROUTINE DMUMPS_322( + & COMM_LOAD, ASS_IRECV, + & MSGSOU, MSGTAG, MSGLEN, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mumps_headers.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER MSGSOU, MSGTAG, MSGLEN + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER KEEP(500), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION DBLARR( max(1,KEEP(13)) ) + INTEGER INIV2, ISHIFT, IBEG + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + LOGICAL FLAG + INTEGER MP, LP + INTEGER TMP( 2 ) + INTEGER NBRECU, POSITION, INODE, ISON, IROOT + INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE, + & LMAP, FPERE, NELIM, + & HDMAPLIG,NFS4FATHER, + & TOT_ROOT_SIZE, TOT_CONT_TO_RECV + DOUBLE PRECISION FLOP1 + INCLUDE 'mumps_tags.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + CHARACTER(LEN=35)::SUBNAME + MP = ICNTL(2) + LP = ICNTL(1) + SUBNAME="??????" + CALL DMUMPS_467(COMM_LOAD, KEEP) + IF ( MSGTAG .EQ. RACINE ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NBRECU, + & 1, MPI_INTEGER, COMM, IERR) + NBRECU = BUFR( 1 ) + NBFIN = NBFIN - NBRECU + ELSEIF ( MSGTAG .EQ. NOEUD ) THEN + CALL DMUMPS_269( MYID,KEEP,KEEP8, + & BUFR, LBUFR, LBUFR_BYTES, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, FPERE, FLAG, IFLAG, IERROR, COMM, + & ITLOC, RHS_MUMPS ) + SUBNAME="DMUMPS_269" + IF ( IFLAG .LT. 0 ) GO TO 500 + IF ( FLAG ) THEN + CALL DMUMPS_507(N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), STEP, FPERE ) + IF (KEEP(47) .GE. 3) THEN + CALL DMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + CALL MUMPS_137( FPERE, N, + & PROCNODE_STEPS,SLAVEF, + & ND, FILS, FRERE, STEP, PIMASTER, + & KEEP(28), KEEP(50), KEEP(253), FLOP1, + & IW, LIW, KEEP(IXSZ) ) + IF (FPERE.NE.KEEP(20)) + & CALL DMUMPS_190(1,.FALSE.,FLOP1,KEEP,KEEP8) + ENDIF + ELSEIF ( MSGTAG .EQ. END_NIV2_LDLT ) THEN + INODE = BUFR( 1 ) + CALL DMUMPS_507(N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), + & STEP, -INODE ) + IF (KEEP(47) .GE. 3) THEN + CALL DMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + ELSEIF ( MSGTAG .EQ. TERREUR ) THEN + IFLAG = -001 + IERROR = MSGSOU + GOTO 100 + ELSEIF ( MSGTAG .EQ. MAITRE_DESC_BANDE ) THEN + CALL DMUMPS_266( MYID,BUFR, LBUFR, + & LBUFR_BYTES, IWPOS, + & IWPOSCB, + & IPTRLU, LRLU, LRLUS, NBPROCFILS, + & N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP, + & KEEP,KEEP8, ITLOC, RHS_MUMPS, + & IFLAG, IERROR ) + SUBNAME="DMUMPS_266" + IF ( IFLAG .LT. 0 ) GO to 500 + ELSEIF ( MSGTAG .EQ. MAITRE2 ) THEN + CALL DMUMPS_268(MYID,BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, SLAVEF, IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & KEEP,KEEP8, ND, FILS, FRERE, ITLOC, RHS_MUMPS, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + SUBNAME="DMUMPS_268" + IF ( IFLAG .LT. 0 ) GO to 500 + ELSEIF ( MSGTAG .EQ. BLOC_FACTO ) THEN + CALL DMUMPS_264( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM , IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSEIF ( MSGTAG .EQ. BLOC_FACTO_SYM_SLAVE ) THEN + CALL DMUMPS_263( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSEIF ( MSGTAG .EQ. BLOC_FACTO_SYM ) THEN + CALL DMUMPS_274( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSEIF ( MSGTAG .EQ. CONTRIB_TYPE2 ) THEN + CALL DMUMPS_699( COMM_LOAD, ASS_IRECV, + & MSGLEN, BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC, + & N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, NBPROCFILS, COMP, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, NSTK_S, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, NBFIN, MYID, COMM, + & ICNTL, KEEP,KEEP8, IFLAG, IERROR, IPOOL, LPOOL, LEAF, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GO TO 100 + ELSEIF ( MSGTAG .EQ. MAPLIG ) THEN + HDMAPLIG = 7 + INODE = BUFR( 1 ) + ISON = BUFR( 2 ) + NSLAVES_PERE = BUFR( 3 ) + NFRONT_PERE = BUFR( 4 ) + NASS_PERE = BUFR( 5 ) + LMAP = BUFR( 6 ) + NFS4FATHER = BUFR(7) + IF ( (NSLAVES_PERE.NE.0).AND.(KEEP(48).NE.0) ) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + ISHIFT = NSLAVES_PERE+1 + TAB_POS_IN_PERE(1:NSLAVES_PERE+1, INIV2) = + & BUFR(HDMAPLIG+1:HDMAPLIG+1+NSLAVES_PERE) + TAB_POS_IN_PERE(SLAVEF+2, INIV2) = NSLAVES_PERE + ELSE + ISHIFT = 0 + ENDIF + IBEG = HDMAPLIG+1+ISHIFT + CALL DMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES_PERE, + & BUFR(IBEG), + & NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP, + & BUFR(IBEG+NSLAVES_PERE), + & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GO TO 100 + ELSE IF ( MSGTAG .EQ. ROOT_CONT_STATIC ) THEN + CALL DMUMPS_700( + & BUFR, LBUFR, LBUFR_BYTES, + & root, N, IW, LIW, A, LA, NBPROCFILS, + & LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, + & COMP, LRLUS, IPOOL, LPOOL, LEAF, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, + & ITLOC, RHS_MUMPS, + & ND, PROCNODE_STEPS, SLAVEF) + SUBNAME="DMUMPS_700" + IF ( IFLAG .LT. 0 ) GO TO 500 + ELSE IF ( MSGTAG .EQ. ROOT_NON_ELIM_CB ) THEN + IROOT = KEEP( 38 ) + MSGSOU = MUMPS_275( PROCNODE_STEPS(STEP(IROOT)), + & SLAVEF ) + IF ( PTLUST_S( STEP(IROOT)) .EQ. 0 ) THEN + CALL MPI_RECV( TMP, 2 * KEEP(34), MPI_PACKED, + & MSGSOU, ROOT_2SLAVE, + & COMM, STATUS, IERR ) + CALL DMUMPS_270( TMP( 1 ), TMP( 2 ), + & root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND ) + SUBNAME="DMUMPS_270" + IF ( IFLAG .LT. 0 ) GOTO 500 + END IF + CALL DMUMPS_700( + & BUFR, LBUFR, LBUFR_BYTES, + & root, N, IW, LIW, A, LA, NBPROCFILS, + & LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, + & COMP, LRLUS, IPOOL, LPOOL, LEAF, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, + & ITLOC, RHS_MUMPS, + & ND, PROCNODE_STEPS, SLAVEF ) + SUBNAME="DMUMPS_700" + IF ( IFLAG .LT. 0 ) GO TO 500 + ELSE IF ( MSGTAG .EQ. ROOT_2SON ) THEN + ISON = BUFR( 1 ) + NELIM = BUFR( 2 ) + CALL DMUMPS_271( COMM_LOAD, ASS_IRECV, + & ISON, NELIM, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GO TO 100 + IF (MYID.NE.MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF)) THEN + IF (KEEP(50).EQ.0) THEN + IF (IW(PTRIST(STEP(ISON))+6+KEEP(IXSZ)).EQ. + & S_REC_CONTSTATIC) THEN + IW(PTRIST(STEP(ISON))+6+KEEP(IXSZ)) = S_ROOT2SON_CALLED + ELSE + CALL DMUMPS_626( N, ISON, PTRIST, PTRAST, + & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + ENDIF + ELSE + IF (IW(PTRIST(STEP(ISON))+8+KEEP(IXSZ)).EQ. + & S_REC_CONTSTATIC) THEN + IW(PTRIST(STEP(ISON))+8+KEEP(IXSZ)) = S_ROOT2SON_CALLED + ELSE + CALL DMUMPS_626( N, ISON, PTRIST, PTRAST, + & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + ENDIF + ENDIF + ENDIF + ELSE IF ( MSGTAG .EQ. ROOT_2SLAVE ) THEN + TOT_ROOT_SIZE = BUFR( 1 ) + TOT_CONT_TO_RECV = BUFR( 2 ) + CALL DMUMPS_270( TOT_ROOT_SIZE, + & TOT_CONT_TO_RECV, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND ) + IF ( IFLAG .LT. 0 ) GO TO 100 + ELSE IF ( MSGTAG .EQ. ROOT_NELIM_INDICES ) THEN + ISON = BUFR( 1 ) + NELIM = BUFR( 2 ) + NSLAVES_PERE = BUFR( 3 ) + CALL DMUMPS_273( root, + & ISON, NELIM, NSLAVES_PERE, BUFR(4), BUFR(4+BUFR(2)), + & BUFR(4+2*BUFR(2)), + & + & PROCNODE_STEPS, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & ITLOC, RHS_MUMPS, COMP, + & IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8, + & COMM, COMM_LOAD, FILS, ND) + SUBNAME="DMUMPS_273" + IF ( IFLAG .LT. 0 ) GO TO 500 + ELSE IF ( MSGTAG .EQ. UPDATE_LOAD ) THEN + WRITE(*,*) "Internal error 3 in DMUMPS_322" + CALL MUMPS_ABORT() + ELSE IF ( MSGTAG .EQ. TAG_DUMMY ) THEN + ELSE + IF ( LP > 0 ) + & WRITE(LP,*) MYID, + &': Internal error, routine DMUMPS_322.',MSGTAG + IFLAG = -100 + IERROR= MSGTAG + GOTO 500 + ENDIF + 100 CONTINUE + RETURN + 500 CONTINUE + IF ( ICNTL(1) .GT. 0 .AND. ICNTL(4).GE.1 ) THEN + LP=ICNTL(1) + IF (IFLAG.EQ.-9) THEN + WRITE(LP,*) 'FAILURE, WORKSPACE TOO SMALL DURING ',SUBNAME + ENDIF + IF (IFLAG.EQ.-8) THEN + WRITE(LP,*) 'FAILURE IN INTEGER ALLOCATION DURING ',SUBNAME + ENDIF + IF (IFLAG.EQ.-13) THEN + WRITE(LP,*) 'FAILURE IN DYNAMIC ALLOCATION DURING ',SUBNAME + ENDIF + ENDIF + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE DMUMPS_322 + RECURSIVE SUBROUTINE DMUMPS_280( + & COMM_LOAD, ASS_IRECV, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT , + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC, LA, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ), + & PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION DBLARR( max(1,KEEP(13)) ) + INTEGER MSGSOU, MSGTAG, MSGLEN, IERR + MSGSOU = STATUS( MPI_SOURCE ) + MSGTAG = STATUS( MPI_TAG ) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) + IF ( MSGLEN .GT. LBUFR_BYTES ) THEN + IFLAG = -20 + IERROR = MSGLEN + WRITE(*,*) ' RECEPTION BUF TOO SMALL, Msgtag/len=', + & MSGTAG,MSGLEN + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + CALL MPI_RECV( BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU, + & MSGTAG, + & COMM, STATUS, IERR ) + CALL DMUMPS_322( + & COMM_LOAD, ASS_IRECV, + & MSGSOU, MSGTAG, MSGLEN, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + RETURN + END SUBROUTINE DMUMPS_280 + RECURSIVE SUBROUTINE DMUMPS_329( + & COMM_LOAD, ASS_IRECV, BLOCKING, SET_IRECV, + & MESSAGE_RECEIVED, MSGSOU, MSGTAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & STACK_RIGHT_AUTHORIZED ) + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL, INTENT (IN) :: BLOCKING + LOGICAL, INTENT (IN) :: SET_IRECV + LOGICAL, INTENT (INOUT) :: MESSAGE_RECEIVED + INTEGER, INTENT (IN) :: MSGSOU, MSGTAG + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ), + & PTLUST_S(KEEP(28)) + INTEGER STEP(N), + & PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION DBLARR( max(1,KEEP(13)) ) + LOGICAL, intent(in) :: STACK_RIGHT_AUTHORIZED + LOGICAL FLAG, RIGHT_MESS, FLAGbis + INTEGER LP, MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC + INTEGER IERR + INTEGER STATUS_BIS( MPI_STATUS_SIZE ) + INTEGER, SAVE :: RECURS = 0 + CALL DMUMPS_467(COMM_LOAD, KEEP) + IF ( .NOT. STACK_RIGHT_AUTHORIZED ) THEN + RETURN + ENDIF + RECURS = RECURS + 1 + LP = ICNTL(1) + IF (ICNTL(4).LT.1) LP=-1 + IF ( MESSAGE_RECEIVED ) THEN + MSGSOU_LOC = MPI_ANY_SOURCE + MSGTAG_LOC = MPI_ANY_TAG + GOTO 250 + ENDIF + IF ( ASS_IRECV .NE. MPI_REQUEST_NULL) THEN + RIGHT_MESS = .TRUE. + IF (BLOCKING) THEN + CALL MPI_WAIT(ASS_IRECV, + & STATUS, IERR) + FLAG = .TRUE. + IF ( ( (MSGSOU.NE.MPI_ANY_SOURCE) .OR. + & (MSGTAG.NE.MPI_ANY_TAG) ) ) THEN + IF ( MSGSOU.NE.MPI_ANY_SOURCE) THEN + RIGHT_MESS = MSGSOU.EQ.STATUS(MPI_SOURCE) + ENDIF + IF ( MSGTAG.NE.MPI_ANY_TAG) THEN + RIGHT_MESS = + & ( (MSGTAG.EQ.STATUS(MPI_TAG)).AND.RIGHT_MESS ) + ENDIF + IF (.NOT.RIGHT_MESS) THEN + CALL MPI_PROBE(MSGSOU,MSGTAG, + & COMM, STATUS_BIS, IERR) + ENDIF + ENDIF + ELSE + CALL MPI_TEST(ASS_IRECV, + & FLAG, STATUS, IERR) + ENDIF + IF (IERR.LT.0) THEN + IFLAG = -20 + IF (LP.GT.0) + & write(LP,*) ' Error return from MPI_TEST ', + & IFLAG, ' in DMUMPS_329' + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + IF ( FLAG ) THEN + MESSAGE_RECEIVED = .TRUE. + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN_LOC, IERR ) + IF (.NOT.RIGHT_MESS) RECURS = RECURS + 10 + CALL DMUMPS_322( COMM_LOAD, ASS_IRECV, + & MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (.NOT.RIGHT_MESS) RECURS = RECURS - 10 + IF ( IFLAG .LT. 0 ) RETURN + IF (.NOT.RIGHT_MESS) THEN + IF (ASS_IRECV .NE. MPI_REQUEST_NULL) THEN + CALL MUMPS_ABORT() + ENDIF + CALL MPI_IPROBE(MSGSOU,MSGTAG, + & COMM, FLAGbis, STATUS, IERR) + IF (FLAGbis) THEN + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + CALL DMUMPS_280( COMM_LOAD, ASS_IRECV, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + ENDIF + ELSE + IF (BLOCKING) THEN + CALL MPI_PROBE(MSGSOU,MSGTAG, + & COMM, STATUS, IERR) + FLAG = .TRUE. + ELSE + CALL MPI_IPROBE(MPI_ANY_SOURCE,MPI_ANY_TAG, + & COMM, FLAG, STATUS, IERR) + ENDIF + IF (FLAG) THEN + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + MESSAGE_RECEIVED = .TRUE. + CALL DMUMPS_280( COMM_LOAD, ASS_IRECV, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + 250 CONTINUE + RECURS = RECURS - 1 + IF ( NBFIN .EQ. 0 ) RETURN + IF ( RECURS .GT. 3 ) RETURN + IF ( KEEP(36).EQ.1 .AND. SET_IRECV .AND. + & (ASS_IRECV.EQ.MPI_REQUEST_NULL) .AND. + & MESSAGE_RECEIVED ) THEN + CALL MPI_IRECV ( BUFR(1), + & LBUFR_BYTES, MPI_PACKED, MPI_ANY_SOURCE, + & MPI_ANY_TAG, COMM, + & ASS_IRECV, IERR ) + ENDIF + RETURN + END SUBROUTINE DMUMPS_329 + SUBROUTINE DMUMPS_255( INFO1, + & ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & COMM, + & MYID, SLAVEF) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER LBUFR, LBUFR_BYTES + INTEGER ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER COMM + INTEGER MYID, SLAVEF, INFO1, DEST + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL NO_ACTIVE_IRECV + INTEGER MSGSOU_LOC, MSGTAG_LOC + INTEGER IERR, DUMMY + INTRINSIC mod + IF (SLAVEF .EQ. 1) RETURN + IF (ASS_IRECV.EQ.MPI_REQUEST_NULL) THEN + NO_ACTIVE_IRECV=.TRUE. + ELSE + CALL MPI_TEST(ASS_IRECV, NO_ACTIVE_IRECV, + & STATUS, IERR) + ENDIF + CALL MPI_BARRIER(COMM,IERR) + DUMMY = 1 + DEST = mod(MYID+1, SLAVEF) + CALL DMUMPS_62 + & (DUMMY, DEST, TAG_DUMMY, COMM, IERR) + IF (NO_ACTIVE_IRECV) THEN + CALL MPI_RECV( BUFR, LBUFR, + & MPI_INTEGER, MPI_ANY_SOURCE, + & TAG_DUMMY, COMM, STATUS, IERR ) + ELSE + CALL MPI_WAIT(ASS_IRECV, + & STATUS, IERR) + ENDIF + RETURN + END SUBROUTINE DMUMPS_255 + SUBROUTINE DMUMPS_180( + & INFO1, BUFR, LBUFR, LBUFR_BYTES, + & COMM_NODES, COMM_LOAD, SLAVEF, MP ) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER COMM_NODES, COMM_LOAD, SLAVEF, INFO1, MP + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG, BUFFERS_EMPTY, BUFFERS_EMPTY_ON_ALL_PROCS + INTEGER MSGSOU_LOC, MSGTAG_LOC, COMM_EFF + INTEGER IERR + INTEGER IBUF_EMPTY, IBUF_EMPTY_ON_ALL_PROCS + IF (SLAVEF.EQ.1) RETURN + BUFFERS_EMPTY_ON_ALL_PROCS = .FALSE. + 10 CONTINUE + FLAG = .TRUE. + DO WHILE ( FLAG ) + COMM_EFF = COMM_NODES + CALL MPI_IPROBE(MPI_ANY_SOURCE,MPI_ANY_TAG, + & COMM_NODES, FLAG, STATUS, IERR) + IF ( .NOT. FLAG ) THEN + COMM_EFF = COMM_LOAD + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, + & COMM_LOAD, FLAG, STATUS, IERR) + END IF + IF (FLAG) THEN + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + CALL MPI_RECV( BUFR, LBUFR_BYTES, + & MPI_PACKED, MSGSOU_LOC, + & MSGTAG_LOC, COMM_EFF, STATUS, IERR ) + ENDIF + END DO + IF (BUFFERS_EMPTY_ON_ALL_PROCS) THEN + RETURN + ENDIF + CALL DMUMPS_469(BUFFERS_EMPTY) + IF ( BUFFERS_EMPTY ) THEN + IBUF_EMPTY = 0 + ELSE + IBUF_EMPTY = 1 + ENDIF + CALL MPI_ALLREDUCE(IBUF_EMPTY, + & IBUF_EMPTY_ON_ALL_PROCS, + & 1, MPI_INTEGER, MPI_MAX, + & COMM_NODES, IERR) + IF ( IBUF_EMPTY_ON_ALL_PROCS == 0) THEN + BUFFERS_EMPTY_ON_ALL_PROCS = .TRUE. + ELSE + BUFFERS_EMPTY_ON_ALL_PROCS = .FALSE. + ENDIF + GOTO 10 + END SUBROUTINE DMUMPS_180 + INTEGER FUNCTION DMUMPS_748 + & ( HBUF_SIZE, NNMAX, K227, K50 ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NNMAX, K227, K50 + INTEGER(8), INTENT(IN) :: HBUF_SIZE + INTEGER K227_LOC + INTEGER NBCOL_MAX + INTEGER EFFECTIVE_SIZE + NBCOL_MAX=int(HBUF_SIZE / int(NNMAX,8)) + K227_LOC = abs(K227) + IF (K50.EQ.2) THEN + K227_LOC=max(K227_LOC,2) + EFFECTIVE_SIZE = min(NBCOL_MAX-1, K227_LOC-1) + ELSE + EFFECTIVE_SIZE = min(NBCOL_MAX, K227_LOC) + ENDIF + IF (EFFECTIVE_SIZE.LE.0) THEN + write(6,*) 'Internal buffers too small to store ', + & ' ONE col/row of size', NNMAX + CALL MUMPS_ABORT() + ENDIF + DMUMPS_748 = EFFECTIVE_SIZE + RETURN + END FUNCTION DMUMPS_748 + SUBROUTINE DMUMPS_698( IPIV, LPIV, ISHIFT, + & THE_PANEL, NBROW, NBCOL, KbeforePanel ) + IMPLICIT NONE + INTEGER LPIV, ISHIFT, NBROW, NBCOL, KbeforePanel + INTEGER IPIV(LPIV) + DOUBLE PRECISION THE_PANEL(NBROW, NBCOL) + INTEGER I, IPERM + DO I = 1, LPIV + IPERM=IPIV(I) + IF ( I+ISHIFT.NE.IPERM) THEN + CALL dswap(NBCOL, + & THE_PANEL(I+ISHIFT-KbeforePanel,1), NBROW, + & THE_PANEL(IPERM-KbeforePanel,1), NBROW) + ENDIF + END DO + RETURN + END SUBROUTINE DMUMPS_698 + SUBROUTINE DMUMPS_667(TYPEF, + & NBPANELS, + & I_PIVPTR, I_PIV, IPOS, IW, LIW) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER, intent(out) :: NBPANELS, I_PIVPTR, I_PIV + INTEGER, intent(in) :: TYPEF + INTEGER, intent(in) :: LIW, IPOS + INTEGER IW(LIW) + INTEGER I_NBPANELS, I_NASS + I_NASS = IPOS + I_NBPANELS = I_NASS + 1 + NBPANELS = IW(I_NBPANELS) + I_PIVPTR = I_NBPANELS + 1 + I_PIV = I_PIVPTR + NBPANELS + IF (TYPEF==TYPEF_U) THEN + I_NBPANELS = I_PIV+IW(I_NASS) + NBPANELS = IW(I_NBPANELS) + I_PIVPTR = I_NBPANELS + 1 + I_PIV = I_PIVPTR + NBPANELS + ENDIF + RETURN + END SUBROUTINE DMUMPS_667 + SUBROUTINE DMUMPS_691(K50,NBPANELS_L,NBPANELS_U, + & NASS, IPOS, IW, LIW ) + IMPLICIT NONE + INTEGER K50 + INTEGER IPOS, NASS, NBPANELS_L, NBPANELS_U, LIW + INTEGER IW(LIW) + INTEGER IPOS_U + IF (K50.EQ.1) THEN + WRITE(*,*) "Internal error: DMUMPS_691 called" + ENDIF + IW(IPOS)=NASS + IW(IPOS+1)=NBPANELS_L + IW(IPOS+2:IPOS+1+NBPANELS_L)=NASS+1 + IF (K50 == 0) THEN + IPOS_U=IPOS+2+NASS+NBPANELS_L + IW(IPOS_U)=NBPANELS_U + IW(IPOS_U+1:IPOS_U+NBPANELS_U)=NASS+1 + ENDIF + RETURN + END SUBROUTINE DMUMPS_691 + SUBROUTINE DMUMPS_644 ( + & IWPOS, IOLDPS, IW, LIW, MonBloc, NFRONT, KEEP + & ) + USE DMUMPS_OOC + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER, INTENT(IN) :: IOLDPS, LIW, NFRONT, + & KEEP(500) + INTEGER, INTENT(INOUT) :: IWPOS, IW(LIW) + TYPE(IO_BLOCK), INTENT(IN):: MonBloc + INTEGER :: NBPANELS_L,I_PIVRPTR_L, I_PIVR_L, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, XSIZE, IBEGOOC + LOGICAL FREESPACE + IF (KEEP(50).EQ.1) RETURN + IF ((IOLDPS+IW(IOLDPS+XXI)).NE.IWPOS) RETURN + XSIZE = KEEP(IXSZ) + IBEGOOC = IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE + CALL DMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IBEGOOC, IW, LIW) + FREESPACE = + & (MonBloc%LastPiv.EQ.(IW(I_PIVRPTR_L)-1)) + IF (KEEP(50).EQ.0) THEN + CALL DMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IBEGOOC, IW, LIW) + FREESPACE = FREESPACE .AND. + & (MonBloc%LastPiv.EQ.(IW(I_PIVRPTR_U)-1)) + ENDIF + IF (FREESPACE) THEN + IW(IBEGOOC) = -7777 + IW(IOLDPS+XXI) = IBEGOOC - IOLDPS + 1 + IWPOS = IBEGOOC+1 + ENDIF + RETURN + END SUBROUTINE DMUMPS_644 + SUBROUTINE DMUMPS_684(K50, NBROW_L, NBCOL_U, NASS, + & NBPANELS_L, NBPANELS_U, LREQ) + USE DMUMPS_OOC + IMPLICIT NONE + INTEGER, intent(IN) :: K50, NBROW_L, NBCOL_U, NASS + INTEGER, intent(OUT) :: NBPANELS_L, NBPANELS_U, LREQ + NBPANELS_L=-99999 + NBPANELS_U=-99999 + IF (K50.EQ.1) THEN + LREQ = 0 + RETURN + ENDIF + NBPANELS_L = (NASS / DMUMPS_690(NBROW_L))+1 + LREQ = 1 + & + 1 + & + NASS + & + NBPANELS_L + IF (K50.eq.0) THEN + NBPANELS_U = (NASS / DMUMPS_690(NBCOL_U) ) +1 + LREQ = LREQ + 1 + & + NASS + & + NBPANELS_U + ENDIF + RETURN + END SUBROUTINE DMUMPS_684 + SUBROUTINE DMUMPS_755 + & (IW_LOCATION, MUST_BE_PERMUTED) + IMPLICIT NONE + INTEGER, INTENT(IN) :: IW_LOCATION + LOGICAL, INTENT(INOUT) :: MUST_BE_PERMUTED + IF (IW_LOCATION .EQ. -7777) THEN + MUST_BE_PERMUTED = .FALSE. + ENDIF + RETURN + END SUBROUTINE DMUMPS_755 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part2.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part2.F new file mode 100644 index 000000000..eba3f4216 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part2.F @@ -0,0 +1,7688 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE DMUMPS_152(SSARBR, MYID, N, IPOSBLOCK, + & RPOSBLOCK, + & IW, LIW, + & LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP, KEEP8, IN_PLACE_STATS + & ) + USE DMUMPS_LOAD + IMPLICIT NONE + INTEGER(8) :: RPOSBLOCK + INTEGER IPOSBLOCK, + & LIW, IWPOSCB, N + INTEGER(8) :: LA, LRLU, LRLUS, IPTRLU + LOGICAL IN_PLACE_STATS + INTEGER IW( LIW ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER MYID + LOGICAL SSARBR + INTEGER SIZFI_BLOCK, SIZFI + INTEGER IPOSSHIFT + INTEGER(8) :: SIZFR, SIZFR_BLOCK, SIZFR_BLOCK_EFF, + & SIZEHOLE, MEM_INC + INCLUDE 'mumps_headers.h' + IPOSSHIFT = IPOSBLOCK + KEEP(IXSZ) + SIZFI_BLOCK=IW(IPOSBLOCK+XXI) + CALL MUMPS_729( SIZFR_BLOCK,IW(IPOSBLOCK+XXR) ) + IF (KEEP(216).eq.3) THEN + SIZFR_BLOCK_EFF=SIZFR_BLOCK + ELSE + CALL DMUMPS_628( IW(IPOSBLOCK), + & LIW-IPOSBLOCK+1, + & SIZEHOLE, KEEP(IXSZ)) + SIZFR_BLOCK_EFF=SIZFR_BLOCK-SIZEHOLE + ENDIF + IF ( IPOSBLOCK .eq. IWPOSCB + 1 ) THEN + IPTRLU = IPTRLU + SIZFR_BLOCK + IWPOSCB = IWPOSCB + SIZFI_BLOCK + LRLU = LRLU + SIZFR_BLOCK + IF (.NOT. IN_PLACE_STATS) THEN + LRLUS = LRLUS + SIZFR_BLOCK_EFF + ENDIF + MEM_INC = -SIZFR_BLOCK_EFF + IF (IN_PLACE_STATS) THEN + MEM_INC= 0_8 + ENDIF + CALL DMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,0_8,MEM_INC,KEEP,KEEP8,LRLU) + 90 IF ( IWPOSCB .eq. LIW ) GO TO 100 + IPOSSHIFT = IWPOSCB + KEEP(IXSZ) + SIZFI = IW( IWPOSCB+1+XXI ) + CALL MUMPS_729( SIZFR,IW(IWPOSCB+1+XXR) ) + IF ( IW( IWPOSCB+1+XXS ) .EQ. S_FREE ) THEN + IPTRLU = IPTRLU + SIZFR + LRLU = LRLU + SIZFR + IWPOSCB = IWPOSCB + SIZFI + GO TO 90 + ENDIF + 100 CONTINUE + IW( IWPOSCB+1+XXP)=TOP_OF_STACK + ELSE + IW( IPOSBLOCK +XXS)=S_FREE + IF (.NOT. IN_PLACE_STATS) LRLUS = LRLUS + SIZFR_BLOCK_EFF + CALL DMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,0_8,-SIZFR_BLOCK_EFF,KEEP,KEEP8,LRLU) + END IF + RETURN + END SUBROUTINE DMUMPS_152 + SUBROUTINE DMUMPS_144( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, PIMASTER, + & PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP,PIVNUL_LIST,LPN_LIST) + USE DMUMPS_OOC + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, INODE, FPERE, LIW, NOFFW, NPVW + INTEGER(8) :: LA + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + DOUBLE PRECISION UU, SEUIL + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER COMM, MYID, LBUFR, LBUFR_BYTES + INTEGER LPTRAR, NELT + INTEGER ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NBFIN, SLAVEF, + & IFLAG, IERROR, LEAF, LPOOL + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB, COMP + INTEGER FRTPTR( N + 1 ), FRTELT( NELT ) + INTEGER BUFR( LBUFR ), IPOOL(LPOOL), + & ITLOC(N+KEEP(253)), FILS(N), + & PTRARW(LPTRAR), PTRAIW(LPTRAR), + & ND( KEEP(28) ), FRERE( KEEP(28) ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), NBPROCFILS(KEEP(28)), + & PROCNODE_STEPS(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + LOGICAL AVOID_DELAYED + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER INOPV, IFINB, NFRONT, NPIV, IBEGKJI, NBOLKJ, + & NBTLKJ, IBEG_BLOCK + INTEGER(8) :: POSELT + INTEGER NASS, NEL1, IEND, IOLDPS, dummy, allocok + LOGICAL LASTBL + DOUBLE PRECISION UUTEMP + INTEGER , ALLOCATABLE, DIMENSION ( : ) :: IPIV + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, LNextPiv2beWritten, + & UNextPiv2beWritten, IFLAG_OOC, + & PP_FIRST2SWAP_L, PP_FIRST2SWAP_U, + & PP_LastPIVRPTRFilled_L, PP_LastPIVRPTRFilled_U + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INCLUDE 'mumps_headers.h' + EXTERNAL DMUMPS_224, DMUMPS_233, + & DMUMPS_225, DMUMPS_232, + & DMUMPS_294, + & DMUMPS_44 + LOGICAL STATICMODE + DOUBLE PRECISION SEUIL_LOC + INOPV = 0 + SEUIL_LOC = SEUIL + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + UUTEMP=UU + ENDIF + IBEG_BLOCK=1 + dummy = 0 + IOLDPS = PTLUST_S(STEP( INODE )) + POSELT = PTRAST(STEP( INODE )) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5),NASS ) + ENDIF + NBTLKJ = NBOLKJ + ALLOCATE( IPIV( NASS ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) MYID,' : FACTO_NIV2 :failed to allocate ',NASS, + & ' integers' + IFLAG = -13 + IERROR =NASS + GO TO 490 + END IF + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_U + LNextPiv2beWritten = 1 + UNextPiv2beWritten = 1 + PP_FIRST2SWAP_L = LNextPiv2beWritten + PP_FIRST2SWAP_U = UNextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + MonBloc%LastPanelWritten_U = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 2 + MonBloc%NROW = NASS + MonBloc%NCOL = NFRONT + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -68877 + NULLIFY(MonBloc%INDICES) + ENDIF + 50 CONTINUE + IBEGKJI = IBEG_BLOCK + CALL DMUMPS_224(NFRONT,NASS,IBEGKJI, NASS, IPIV, + & N,INODE,IW,LIW,A,LA,INOPV,NOFFW, + & IFLAG,IOLDPS,POSELT,UU,SEUIL_LOC,KEEP,KEEP8, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U, + & PP_LastPIVRPTRFilled_U) + IF (IFLAG.LT.0) GOTO 490 + IF (INOPV.EQ.1) THEN + IF(STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + ENDIF + IF (INOPV.GE.1) THEN + LASTBL = (INOPV.EQ.1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL DMUMPS_294( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, NFRONT, + & IBEGKJI, IEND, IPIV, NASS,LASTBL, dummy, + & + & COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (INOPV.EQ.1) GO TO 500 + IF (INOPV.EQ.2) THEN + CALL DMUMPS_233(IBEG_BLOCK,NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,NBOLKJ,NBTLKJ,KEEP(4),KEEP(IXSZ)) + GOTO 50 + ENDIF + NPVW = NPVW + 1 + IF (NASS.LE.1) THEN + IFINB = -1 + ELSE + CALL DMUMPS_225(IBEG_BLOCK, + & NFRONT, NASS, N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB, + & NBTLKJ,KEEP(4),KEEP(IXSZ)) + ENDIF + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + IF (IFINB.EQ.0) GOTO 50 + IF ((IFINB.EQ.1).OR.(IFINB.EQ.-1)) THEN + LASTBL = (IFINB.EQ.-1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL DMUMPS_294(COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, NFRONT, + & IBEGKJI, IEND, IPIV, NASS, LASTBL, dummy, + & + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (IFINB.EQ.(-1)) GOTO 500 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NEL1 = NASS - NPIV + CALL DMUMPS_232(A,LA, + & NFRONT,NPIV,NASS,POSELT,NBTLKJ) + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_TRY_WRITE + MonBloc%LastPiv = NPIV + TYPEFile = TYPEF_BOTH_LU + LAST_CALL= .FALSE. + CALL DMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG<0) RETURN + ENDIF + GO TO 50 + 490 CONTINUE + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + DEALLOCATE( IPIV ) + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + TYPEFile = TYPEF_BOTH_LU + LAST_CALL = .TRUE. + CALL DMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG<0) RETURN + CALL DMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + RETURN + END SUBROUTINE DMUMPS_144 + SUBROUTINE DMUMPS_176( COMM_LOAD, ASS_IRECV, + & root, FRERE, IROOT, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER IROOT + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC,IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER(8) :: LA + INTEGER N, LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND(KEEP(28)), FRERE(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION DBLARR( max(1,KEEP(13)) ) + INTEGER I, NELIM, NB_CONTRI_GLOBAL, NUMORG, + & NFRONT, IROW, JCOL, PDEST, HF, IOLDPS, + & IN, DEB_ROW, ILOC_ROW, IFSON, ILOC_COL, + & IPOS_SON, NELIM_SON, NSLAVES_SON, HS, + & IROW_SON, ICOL_SON, ISLAVE, IERR, + & NELIM_SENT, IPOS_STATREC + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INCLUDE 'mumps_headers.h' + INCLUDE 'mumps_tags.h' + NB_CONTRI_GLOBAL = KEEP(41) + NUMORG = root%ROOT_SIZE + NELIM = KEEP(42) + NFRONT = NUMORG + KEEP(42) + DO IROW = 0, root%NPROW - 1 + DO JCOL = 0, root%NPCOL - 1 + PDEST = IROW * root%NPCOL + JCOL + IF ( PDEST .NE. MYID ) THEN + CALL DMUMPS_73(NFRONT, + & NB_CONTRI_GLOBAL, PDEST, COMM, IERR) + if (IERR.lt.0) then + write(6,*) ' error detected by ', + & 'DMUMPS_73' + CALL MUMPS_ABORT() + endif + ENDIF + END DO + END DO + CALL DMUMPS_270( NFRONT, + & NB_CONTRI_GLOBAL, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND ) + IF (IFLAG < 0 ) RETURN + HF = 6 + KEEP(IXSZ) + IOLDPS = PTLUST_S(STEP(IROOT)) + IN = IROOT + DEB_ROW = IOLDPS + HF + ILOC_ROW = DEB_ROW + DO WHILE (IN.GT.0) + IW(ILOC_ROW) = IN + IW(ILOC_ROW+NFRONT) = IN + ILOC_ROW = ILOC_ROW + 1 + IN = FILS(IN) + END DO + IFSON = -IN + ILOC_ROW = IOLDPS + HF + NUMORG + ILOC_COL = ILOC_ROW + NFRONT + IF ( NELIM.GT.0 ) THEN + IN = IFSON + DO WHILE (IN.GT.0) + IPOS_SON = PIMASTER(STEP(IN)) + IF (IPOS_SON .EQ. 0) GOTO 100 + NELIM_SON = IW(IPOS_SON+1+KEEP(IXSZ)) + if (NELIM_SON.eq.0) then + write(6,*) ' error 1 in process_last_rtnelind' + CALL MUMPS_ABORT() + endif + NSLAVES_SON = IW(IPOS_SON+5+KEEP(IXSZ)) + HS = 6 + NSLAVES_SON + KEEP(IXSZ) + IROW_SON = IPOS_SON + HS + ICOL_SON = IROW_SON + NELIM_SON + DO I = 1, NELIM_SON + IW( ILOC_ROW+I-1 ) = IW( IROW_SON+I-1 ) + ENDDO + DO I = 1, NELIM_SON + IW( ILOC_COL+I-1 ) = IW( ICOL_SON+I-1 ) + ENDDO + NELIM_SENT = ILOC_ROW - IOLDPS - HF + 1 + DO ISLAVE = 0,NSLAVES_SON + IF (ISLAVE.EQ.0) THEN + PDEST= MUMPS_275(PROCNODE_STEPS(STEP(IN)),SLAVEF) + ELSE + PDEST = IW(IPOS_SON + 5 + ISLAVE+KEEP(IXSZ)) + ENDIF + IF (PDEST.NE.MYID) THEN + CALL DMUMPS_74(IN, NELIM_SENT, + & PDEST, COMM, IERR ) + if (IERR.lt.0) then + write(6,*) ' error detected by ', + & 'DMUMPS_73' + CALL MUMPS_ABORT() + endif + ELSE + CALL DMUMPS_271( COMM_LOAD, ASS_IRECV, + & IN, NELIM_SENT, root, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( ISLAVE .NE. 0 ) THEN + IF (KEEP(50) .EQ. 0) THEN + IPOS_STATREC = PTRIST(STEP(IN))+6+KEEP(IXSZ) + ELSE + IPOS_STATREC = PTRIST(STEP(IN))+8+KEEP(IXSZ) + ENDIF + IF (IW(IPOS_STATREC).EQ. S_REC_CONTSTATIC) THEN + IW(IPOS_STATREC) = S_ROOT2SON_CALLED + ELSE + CALL DMUMPS_626( N, IN, PTRIST, PTRAST, + & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + ENDIF + ENDIF + IPOS_SON = PIMASTER(STEP(IN)) + ENDIF + END DO + CALL DMUMPS_152( .FALSE.,MYID,N, IPOS_SON, + & PTRAST(STEP(IN)), + & IW, LIW, + & LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + ILOC_ROW = ILOC_ROW + NELIM_SON + ILOC_COL = ILOC_COL + NELIM_SON + 100 CONTINUE + IN = FRERE(STEP(IN)) + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_176 + SUBROUTINE DMUMPS_268(MYID,BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, SLAVEF, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, + & N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, NBPROCFILS, + & IPOOL, LPOOL, LEAF, KEEP,KEEP8, ND, FILS, FRERE, + & ITLOC, RHS_MUMPS, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER MYID + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER SLAVEF + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), STEP(N), PIMASTER(KEEP(28)) + INTEGER PROCNODE_STEPS( KEEP(28) ), ITLOC( N +KEEP(253) ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM, COMM_LOAD + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER ND(KEEP(28)), FILS( N ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER POSITION, IFATH, ISON, NROW, NCOL, NELIM, + & NSLAVES + INTEGER(8) :: NOREAL + INTEGER NOINT, INIV2, NCOL_EFF + DOUBLE PRECISION FLOP1 + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INTEGER NOREAL_PACKET + LOGICAL PERETYPE2 + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + POSITION = 0 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IFATH, 1, MPI_INTEGER + & , COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & ISON , 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NSLAVES, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NROW , 1, MPI_INTEGER + & , COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NCOL , 1, MPI_INTEGER + & , COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, + & MPI_INTEGER, COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, + & MPI_INTEGER, COMM, IERR) + IF ( NSLAVES .NE. 0 .and. KEEP(50).ne.0 ) THEN + NCOL_EFF = NROW + ELSE + NCOL_EFF = NCOL + ENDIF + NOREAL_PACKET = NBROWS_PACKET * NCOL_EFF + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + NOINT = 6 + NROW + NCOL + NSLAVES + KEEP(IXSZ) + NOREAL= int(NROW,8) * int(NCOL_EFF,8) + CALL DMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A,LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, + & NOINT, NOREAL, ISON, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) THEN + RETURN + ENDIF + PIMASTER(STEP( ISON )) = IWPOSCB + 1 + PAMASTER(STEP( ISON )) = IPTRLU + 1_8 + IW( IWPOSCB + 1 + KEEP(IXSZ) ) = NCOL + NELIM = NROW + IW( IWPOSCB + 2 + KEEP(IXSZ) ) = NELIM + IW( IWPOSCB + 3 + KEEP(IXSZ) ) = NROW + IF ( NSLAVES .NE. 0 .and. KEEP(50).ne.0 ) THEN + IW( IWPOSCB + 4 + KEEP(IXSZ) ) = NROW - NCOL + IF ( NROW - NCOL .GE. 0 ) THEN + WRITE(*,*) 'Error in PROCESS_MAITRE2:',NROW,NCOL + CALL MUMPS_ABORT() + END IF + ELSE + IW( IWPOSCB + 4 + KEEP(IXSZ) ) = 0 + END IF + IW( IWPOSCB + 5 + KEEP(IXSZ) ) = 1 + IW( IWPOSCB + 6 + KEEP(IXSZ) ) = NSLAVES + IF (NSLAVES.GT.0) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IWPOSCB + 7 + KEEP(IXSZ) ), + & NSLAVES, MPI_INTEGER, COMM, IERR ) + ENDIF + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IW(IWPOSCB + 7 + KEEP(IXSZ) + NSLAVES), + & NROW, MPI_INTEGER, COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IW(IWPOSCB + 7 + KEEP(IXSZ) + NROW + NSLAVES), + & NCOL, MPI_INTEGER, COMM, IERR) + IF ( ( KEEP(48).NE. 0 ).AND.(NSLAVES .GT. 0 )) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(ISON) ) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & TAB_POS_IN_PERE(1,INIV2), + & NSLAVES+1, MPI_INTEGER, COMM, IERR) + TAB_POS_IN_PERE(SLAVEF+2,INIV2) = NSLAVES + ENDIF + ENDIF + IF (NOREAL_PACKET.GT.0) THEN + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & A(PAMASTER(STEP(ISON)) + + & int(NBROWS_ALREADY_SENT,8) * int(NCOL_EFF,8)), + & NOREAL_PACKET, MPI_DOUBLE_PRECISION, COMM, IERR) + ENDIF + IF ( NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. NROW ) THEN + PERETYPE2 = ( MUMPS_330(PROCNODE_STEPS(STEP(IFATH)), + & SLAVEF) .EQ. 2 ) + NSTK_S( STEP(IFATH )) = NSTK_S( STEP(IFATH) ) - 1 + IF ( NSTK_S( STEP(IFATH)) .EQ. 0 ) THEN + CALL DMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IFATH ) + IF (KEEP(47) .GE. 3) THEN + CALL DMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + CALL MUMPS_137( IFATH, N, PROCNODE_STEPS, + & SLAVEF, ND, + & FILS,FRERE, STEP, PIMASTER, + & KEEP(28), KEEP(50), KEEP(253), + & FLOP1,IW, LIW, KEEP(IXSZ) ) + IF (IFATH.NE.KEEP(20)) + & CALL DMUMPS_190(1, .FALSE., FLOP1, KEEP,KEEP8) + END IF + ENDIF + RETURN + END SUBROUTINE DMUMPS_268 + SUBROUTINE DMUMPS_242(DATA, LDATA, MPITYPE, ROOT, COMMW, TAG, + &SLAVEF) + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER LDATA, ROOT, COMMW, TAG, MPITYPE, SLAVEF + INTEGER DEST + INTEGER DATA(LDATA) + DO 10 DEST = 0, SLAVEF - 1 + IF (DEST .NE. ROOT) THEN + IF ( LDATA .EQ. 1 .and. MPITYPE .EQ. MPI_INTEGER ) THEN + CALL DMUMPS_62( DATA(1), DEST, TAG, + & COMMW, IERR ) + ELSE + WRITE(*,*) 'Error : bad argument to DMUMPS_242' + CALL MUMPS_ABORT() + END IF + ENDIF + 10 CONTINUE + RETURN + END SUBROUTINE DMUMPS_242 + SUBROUTINE DMUMPS_44( MYID, SLAVEF, COMM ) + INTEGER MYID, SLAVEF, COMM + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER DUMMY (1) + CALL DMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, + & COMM, TERREUR, SLAVEF ) + RETURN + END SUBROUTINE DMUMPS_44 + SUBROUTINE DMUMPS_464( K34, K35, K16, K10 ) + IMPLICIT NONE + INTEGER, INTENT(OUT) :: K34, K35, K10, K16 + INTEGER SIZE_INT, SIZE_REAL_OR_DOUBLE + INTEGER I(2) + DOUBLE PRECISION R(2) + CALL MUMPS_SIZE_C(I(1),I(2),SIZE_INT) + CALL MUMPS_SIZE_C(R(1),R(2),SIZE_REAL_OR_DOUBLE) + K34 = int(SIZE_INT) + K10 = 8 / K34 + K16 = int(SIZE_REAL_OR_DOUBLE) + K35 = K16 + RETURN + END SUBROUTINE DMUMPS_464 + SUBROUTINE DMUMPS_20( NSLAVES, LWK_USER, CNTL, ICNTL, + & KEEP,KEEP8, + & INFO, INFOG, RINFO, RINFOG, SYM, PAR, + & DKEEP) + IMPLICIT NONE + DOUBLE PRECISION DKEEP(30) + DOUBLE PRECISION CNTL(15), RINFO(40), RINFOG(40) + INTEGER ICNTL(40), KEEP(500), SYM, PAR, NSLAVES + INTEGER INFO(40), INFOG(40) + INTEGER(8) KEEP8(150) + INTEGER LWK_USER +C Let $A_{preproc}$ be the preprocessed matrix to be factored (see + LWK_USER = 0 + KEEP(1:500) = 0 + KEEP8(1:150)= 0_8 + INFO(1:40) = 0 + INFOG(1:40) = 0 + ICNTL(1:40) = 0 + RINFO(1:40) = 0.0D0 + RINFOG(1:40)= 0.0D0 + CNTL(1:15) = 0.0D0 + DKEEP(1:30) = 0.0D0 + KEEP( 50 ) = SYM + IF ( KEEP(50).NE.1 .and. KEEP(50).NE.2 ) KEEP( 50 ) = 0 + IF ( KEEP(50) .NE. 1 ) THEN + CNTL(1) = 0.01D0 + ELSE + CNTL(1) = 0.0D0 + END IF + CNTL(2) = sqrt(epsilon(0.0D0)) + CNTL(3) = 0.0D0 + CNTL(4) = -1.0D0 + CNTL(5) = 0.0D0 + CNTL(6) = -1.0D0 + KEEP(46) = PAR + IF ( KEEP(46) .NE. 0 .AND. + & KEEP(46) .NE. 1 ) THEN + KEEP(46) = 1 + END IF + ICNTL(1) = 6 + ICNTL(2) = 0 + ICNTL(3) = 6 + ICNTL(4) = 2 + ICNTL(5) = 0 + IF (SYM.NE.1) THEN + ICNTL(6) = 7 + ELSE + ICNTL(6) = 0 + ENDIF + ICNTL(7) = 7 + ICNTL(8) = 77 + ICNTL(9) = 1 + ICNTL(10) = 0 + ICNTL(11) = 0 + IF(SYM .EQ. 2) THEN + ICNTL(12) = 0 + ELSE + ICNTL(12) = 1 + ENDIF + ICNTL(13) = 0 + IF (SYM.eq.1.AND.NSLAVES.EQ.1) THEN + ICNTL(14) = 5 + ELSE IF (NSLAVES .GT. 4) THEN + ICNTL(14) = 30 + ELSE + ICNTL(14) = 20 + END IF + ICNTL(15) = 0 + ICNTL(16) = 0 + ICNTL(17) = 0 + ICNTL(18) = 0 + ICNTL(19) = 0 + ICNTL(20) = 0 + ICNTL(21) = 0 + ICNTL(22) = 0 + ICNTL(23) = 0 + ICNTL(24) = 0 + ICNTL(27) = -8 + ICNTL(28) = 1 + ICNTL(29) = 0 + ICNTL(39) = 1 + ICNTL(40) = 0 + KEEP(12) = 0 + KEEP(11) = 2147483646 + KEEP(24) = 18 + KEEP(68) = 0 + KEEP(36) = 1 + KEEP(1) = 8 + KEEP(7) = 150 + KEEP(8) = 120 + KEEP(57) = 500 + KEEP(58) = 250 + IF ( SYM .eq. 0 ) THEN + KEEP(4) = 32 + KEEP(3) = 96 + KEEP(5) = 16 + KEEP(6) = 32 + KEEP(9) = 700 + KEEP(85) = 300 + KEEP(62) = 50 + IF (NSLAVES.GE.128) KEEP(62)=200 + IF (NSLAVES.GE.128) KEEP(9)=800 + IF (NSLAVES.GE.256) KEEP(9)=900 + ELSE + KEEP(4) = 24 + KEEP(3) = 96 + KEEP(5) = 16 + KEEP(6) = 48 + KEEP(9) = 400 + KEEP(85) = 100 + KEEP(62) = 100 + IF (NSLAVES.GE.128) KEEP(62)=150 + IF (NSLAVES.GE.64) KEEP(9)=800 + IF (NSLAVES.GE.128) KEEP(9)=900 + END IF + KEEP(63) = 60 + KEEP(48) = 5 + KEEP(17) = 0 + CALL DMUMPS_464( KEEP(34), KEEP(35), + & KEEP(16), KEEP(10) ) +#if defined(SP_) + KEEP( 51 ) = 70 +#else + KEEP( 51 ) = 48 +#endif + KEEP(37) = max(800, int(sqrt(dble(NSLAVES+1))*dble(KEEP(51)))) + IF ( NSLAVES > 256 ) THEN + KEEP(39) = 10000 + ELSEIF ( NSLAVES > 128 ) THEN + KEEP(39) = 20000 + ELSEIF ( NSLAVES > 64 ) THEN + KEEP(39) = 40000 + ELSEIF ( NSLAVES > 16 ) THEN + KEEP(39) = 80000 + ELSE + KEEP(39) = 160000 + END IF + KEEP(40) = -1 - 456789 + KEEP(45) = 0 + KEEP(47) = 2 + KEEP(64) = 10 + KEEP(69) = 4 + KEEP(75) = 1 + KEEP(76) = 2 + KEEP(77) = 30 + KEEP(79) = 0 + IF (NSLAVES.GT.4) THEN + KEEP(78)=max( + & int(log(dble(NSLAVES))/log(dble(2))) - 2 + & , 0 ) + ENDIF + KEEP(210) = 2 + KEEP8(79) = -10_8 + KEEP(80) = 1 + KEEP(81) = 0 + KEEP(82) = 5 + KEEP(83) = min(8,NSLAVES/4) + KEEP(83) = max(min(4,NSLAVES),max(KEEP(83),1)) + KEEP(86)=1 + KEEP(87)=0 + KEEP(88)=0 + KEEP(90)=1 + KEEP(91)=min(8, NSLAVES) + KEEP(91) = max(min(4,NSLAVES),min(KEEP(83),KEEP(91))) + IF(NSLAVES.LT.48)THEN + KEEP(102)=150 + ELSEIF(NSLAVES.LT.128)THEN + KEEP(102)=150 + ELSEIF(NSLAVES.LT.256)THEN + KEEP(102)=200 + ELSEIF(NSLAVES.LT.512)THEN + KEEP(102)=300 + ELSEIF(NSLAVES.GE.512)THEN + KEEP(102)=400 + ENDIF +#if defined(OLD_OOC_NOPANEL) + KEEP(99)=0 +#else + KEEP(99)=4 +#endif + KEEP(100)=0 + KEEP(204)=0 + KEEP(205)=0 + KEEP(209)=-1 + KEEP(104) = 16 + KEEP(107)=0 + KEEP(211)=2 + IF (NSLAVES .EQ. 2) THEN + KEEP(213) = 101 + ELSE + KEEP(213) = 201 + ENDIF + KEEP(217)=0 + KEEP(215)=0 + KEEP(216)=1 + KEEP(218)=50 + KEEP(219)=1 + IF (KEEP(50).EQ.2) THEN + KEEP(227)= max(2,32) + ELSE + KEEP(227)= max(1,32) + ENDIF + KEEP(231) = 1 + KEEP(232) = 3 + KEEP(233) = 0 + KEEP(239) = 1 + KEEP(240) = 10 + DKEEP(4) = -1.0D0 + DKEEP(5) = -1.0D0 + IF(NSLAVES.LE.8)THEN + KEEP(238)=12 + ELSE + KEEP(238)=7 + ENDIF + KEEP(234)= 1 + DKEEP(3)=-5.0D0 + KEEP(242) = 1 + KEEP(250) = 1 + RETURN + END SUBROUTINE DMUMPS_20 + SUBROUTINE DMUMPS_786(id, LP) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (DMUMPS_STRUC) :: id + INTEGER LP + IF (id%KEEP(72)==1) THEN + IF (LP.GT.0) + & write(LP,*) 'Warning KEEP(72) = 1 !!!!!!!!!! ' + id%KEEP(37) = 2*id%NSLAVES + id%KEEP(3)=3 + id%KEEP(4)=2 + id%KEEP(5)=1 + id%KEEP(6)=2 + id%KEEP(9)=3 + id%KEEP(39)=300 + id%CNTL(1)=0.1D0 + id%KEEP(213) = 101 + id%KEEP(85)=2 + id%KEEP(85)=-4 + id%KEEP(62) = 2 + id%KEEP(1) = 1 + id%KEEP(51) = 2 + ELSE IF (id%KEEP(72)==2) THEN + IF (LP.GT.0) + & write(LP,*)' OOC setting to reduce stack memory', + & ' KEEP(72)=', id%KEEP(72) + id%KEEP(85)=2 + id%KEEP(85)=-10000 + id%KEEP(62) = 10 + id%KEEP(210) = 1 + id%KEEP8(79) = 160000_8 + id%KEEP(1) = 2 + id%KEEP(102) = 110 + id%KEEP(213) = 121 + END IF + RETURN + END SUBROUTINE DMUMPS_786 + SUBROUTINE DMUMPS_195(N, NZ, IRN, ICN, LIW, IKEEP, PTRAR, + & IORD, NFSIZ, FILS, FRERE, LISTVAR_SCHUR, SIZE_SCHUR, + & ICNTL, INFO, KEEP,KEEP8, NSLAVES, PIV, id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N,NZ,LIW,IORD,SIZE_SCHUR, NSLAVES + INTEGER PTRAR(N,4), NFSIZ(N), FILS(N), FRERE(N) + INTEGER IKEEP(N,3) + INTEGER LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER INFO(40), ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + TYPE (DMUMPS_STRUC) :: id + INTEGER IRN(NZ), ICN(NZ) + INTEGER, DIMENSION(:), ALLOCATABLE :: IW + INTEGER IERR + INTEGER K,I,L1,L2,IWFR,NCMPA,LLIW, IN, IFSON + INTEGER NEMIN, LP, MP, LDIAG, ITEMP, symmetry + INTEGER MedDens, NBQD, AvgDens + LOGICAL PROK, COMPRESS_SCHUR + INTEGER NBBUCK + INTEGER, DIMENSION(:), ALLOCATABLE :: HEAD + INTEGER NUMFLAG + INTEGER OPT_METIS_SIZE + INTEGER, DIMENSION(:), ALLOCATABLE :: OPTIONS_METIS + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: COLSCA_TEMP + INTEGER THRESH, IVersion + LOGICAL AGG6 + INTEGER MINSYM + PARAMETER (MINSYM=50) + INTEGER(8) :: K79REF + PARAMETER(K79REF=12000000_8) + INTEGER PIV(N) + INTEGER MTRANS, COMPRESS,NCMP,IERROR,J,JPERM,NCST + INTEGER TOTEL + LOGICAL IDENT,SPLITROOT + EXTERNAL MUMPS_197, DMUMPS_198, + & DMUMPS_199, DMUMPS_351, + & DMUMPS_557, DMUMPS_201 +#if defined(OLDDFS) + EXTERNAL DMUMPS_200 +#endif + EXTERNAL DMUMPS_623 + EXTERNAL DMUMPS_547, DMUMPS_550, + & DMUMPS_556 + ALLOCATE( IW ( LIW ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = LIW + RETURN + ENDIF + LLIW = LIW - 2*N - 1 + L1 = LLIW + 1 + L2 = L1 + N + LP = ICNTL(1) + MP = ICNTL(3) + PROK = (MP.GT.0) + LDIAG = ICNTL(4) + COMPRESS_SCHUR = .FALSE. + IF (KEEP(1).LT.0) KEEP(1) = 0 + NEMIN = KEEP(1) + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + WRITE (MP,99999) N, NZ, LIW, INFO(1) + K = min0(10,NZ) + IF (LDIAG.EQ.4) K = NZ + IF (K.GT.0) WRITE (MP,99998) (IRN(I),ICN(I),I=1,K) + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (IORD.EQ.1 .AND. K.GT.0) THEN + WRITE (MP,99997) (IKEEP(I,1),I=1,K) + ENDIF + ENDIF + NCMP = N + IF (KEEP(60).NE.0) THEN + IF ((SIZE_SCHUR.LE.0 ).OR. + & (SIZE_SCHUR.GE.N) ) GOTO 90 + ENDIF +#if defined(metis) || defined(parmetis) + IF ( ( KEEP(60).NE.0).AND.(SIZE_SCHUR.GT.0) + & .AND. + & ((IORD.EQ.7).OR.(IORD.EQ.5)) + & )THEN + COMPRESS_SCHUR=.TRUE. + NCMP = N-SIZE_SCHUR + CALL DMUMPS_623(N,NCMP,NZ,IRN, ICN, IW(1), LLIW, + & IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, + & KEEP(50), MedDens, NBQD, AvgDens, + & LISTVAR_SCHUR, SIZE_SCHUR, + & FRERE,FILS) + IORD = 5 + KEEP(95) = 1 + NBQD = 0 + ELSE +#endif + CALL DMUMPS_351(N,NZ,IRN, ICN, IW(1), LLIW, + & IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, + & KEEP(50), MedDens, NBQD, AvgDens) +#if defined(metis) || defined(parmetis) + ENDIF +#endif + INFO(8) = symmetry + IF(NBQD .GT. 0) THEN + IF( KEEP(50) .EQ. 2 .AND. ICNTL(12) .LE. 1 ) THEN + IF(KEEP(95) .NE. 1) THEN + IF ( PROK ) + & WRITE( MP,*) + & 'Compressed/constrained ordering set OFF' + KEEP(95) = 1 + ENDIF + ENDIF + ENDIF + IF ( (KEEP(60).NE.0) .AND. (IORD.GT.1) .AND. + & .NOT. COMPRESS_SCHUR ) THEN + IORD = 0 + ENDIF + IF ( (KEEP(50).EQ.2) + & .AND. (KEEP(95) .EQ. 3) + & .AND. (IORD .EQ. 7) ) THEN + IORD = 0 + ENDIF + CALL DMUMPS_701( N, KEEP(50), NSLAVES, IORD, + & symmetry, MedDens, NBQD, AvgDens, + & PROK, MP ) + IF(KEEP(50) .EQ. 2) THEN + IF(KEEP(95) .EQ. 3 .AND. IORD .NE. 2) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: DMUMPS_195 constrained ordering not '// + & ' available with selected ordering. Move to' // + & ' compressed ordering.' + KEEP(95) = 2 + ENDIF + IF(KEEP(95) .EQ. 2 .AND. IORD .EQ. 0) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: DMUMPS_195 AMD not available with ', +#if defined(metis) || defined(parmetis) + & 'compressed ordering -> move to METIS' + IORD = 5 +#else + & 'compressed ordering -> move to AMF' + IORD = 2 +#endif + ENDIF + ELSE + KEEP(95) = 1 + ENDIF + MTRANS = KEEP(23) + COMPRESS = KEEP(95) - 1 + IF(COMPRESS .GT. 0 .AND. KEEP(52) .EQ. -2) THEN + IF(id%CNTL(4) .GE. 0.0D0) THEN + IF (KEEP(1).LE.8) THEN + NEMIN = 16 + ELSE + NEMIN = 2*KEEP(1) + ENDIF + IF (PROK) + & WRITE(MP,*) 'Setting static pivoting ON, COMPRESS =', + & COMPRESS + ENDIF + ENDIF + IF(MTRANS .GT. 0 .AND. KEEP(50) .EQ. 2) THEN + KEEP(23) = 0 + ENDIF + IF(COMPRESS .EQ. 2) THEN + IF (IORD.NE.2) THEN + WRITE(*,*) "IORD not compatible with COMPRESS:", + & IORD, COMPRESS + CALL MUMPS_ABORT() + ENDIF + CALL DMUMPS_556( + & N,PIV,FRERE,FILS,NFSIZ,IKEEP, + & NCST,KEEP,KEEP8,id) + ENDIF + IF ( IORD .NE. 1 ) THEN + IF(COMPRESS .GE. 1) THEN + CALL DMUMPS_547( + & N,NZ, IRN, ICN, PIV, + & NCMP, IW(1), LLIW, IW(L2),PTRAR(1,2),PTRAR, + & IW(L1), FILS, IWFR, + & IERROR, KEEP,KEEP8, ICNTL) + symmetry = 100 + ENDIF + IF ( (symmetry.LT.MINSYM).AND.(KEEP(50).EQ.0) ) THEN + IF(KEEP(23) .EQ. 7 ) THEN + KEEP(23) = -5 + DEALLOCATE (IW) + RETURN + ELSE IF(KEEP(23) .EQ. -9876543) THEN + IDENT = .TRUE. + KEEP(23) = 5 + IF (PROK) WRITE(MP,'(A)') + & ' ... Apply column permutation (already computed)' + DO J=1,N + JPERM = PIV(J) + FILS(JPERM) = J + IF (JPERM.NE.J) IDENT = .FALSE. + ENDDO + IF (.NOT.IDENT) THEN + DO K=1,NZ + J = ICN(K) + IF ((J.LE.0).OR.(J.GT.N)) CYCLE + ICN(K) = FILS(J) + ENDDO + ALLOCATE(COLSCA_TEMP(N), stat=IERR) + IF ( IERR > 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = N + RETURN + ENDIF + DO J = 1, N + COLSCA_TEMP(J)=id%COLSCA(J) + ENDDO + DO J=1, N + id%COLSCA(FILS(J))=COLSCA_TEMP(J) + ENDDO + DEALLOCATE(COLSCA_TEMP) + IF (MP.GT.0 .AND. ICNTL(4).GE.2) + & WRITE(MP,'(/A)') + & ' WARNING input matrix data modified' + CALL DMUMPS_351 + & (N,NZ,IRN, ICN, IW(1), LLIW, IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, KEEP(50), + & MedDens, NBQD, AvgDens) + INFO(8) = symmetry + NCMP = N + ELSE + KEEP(23) = 0 + ENDIF + ENDIF + ELSE IF (KEEP(23) .EQ. 7 .OR. KEEP(23) .EQ. -9876543 ) THEN + IF (PROK) WRITE(MP,'(A)') + & ' ... No column permutation' + KEEP(23) = 0 + ENDIF + ENDIF + IF (IORD.NE.1 .AND. IORD.NE.5) THEN + IF (PROK) THEN + IF (IORD.EQ.2) THEN + WRITE(MP,'(A)') ' Ordering based on AMF ' +#if defined(scotch) || defined(ptscotch) + ELSE IF (IORD.EQ.3) THEN + WRITE(MP,'(A)') ' Ordering based on SCOTCH ' +#endif +#if defined(pord) + ELSE IF (IORD.EQ.4) THEN + WRITE(MP,'(A)') ' Ordering based on PORD ' +#endif + ELSE IF (IORD.EQ.6) THEN + WRITE(MP,'(A)') ' Ordering based on QAMD ' + ELSE + WRITE(MP,'(A)') ' Ordering based on AMD ' + ENDIF + ENDIF + IF ( KEEP(60) .NE. 0 ) THEN + CALL MUMPS_162(N, LLIW, IW(L2), IWFR, PTRAR(1,2), IW(1), + & IW(L1), IKEEP, + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), PTRAR, PTRAR(1,3), + & LISTVAR_SCHUR, SIZE_SCHUR) + IF (KEEP(60)==1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSE + KEEP(38) = LISTVAR_SCHUR(1) + ENDIF + ELSE + IF ( .FALSE. ) THEN +#if defined(pord) + ELSEIF (IORD .EQ. 4) THEN + IF(COMPRESS .EQ. 1) THEN + DO I=L1,L1-1+KEEP(93)/2 + IW(I) = 2 + ENDDO + DO I=L1+KEEP(93)/2,L1+NCMP-1 + IW(I) = 1 + ENDDO + CALL MUMPS_PORDF_WND(NCMP, IWFR-1, IW(L2), IW, + & IW(L1), NCMPA, N) + CALL DMUMPS_548(NCMP,IW(L2),IW(L1),FILS) + CALL DMUMPS_549(NCMP,IW(L2),IKEEP(1,1), + & FRERE,PTRAR(1,1)) + DO I=1,NCMP + IKEEP(IKEEP(I,1),2)=I + ENDDO + ELSE + CALL MUMPS_PORDF(NCMP, IWFR-1, IW(L2), IW(1), + & IW(L1), NCMPA) + ENDIF + IF ( NCMPA .NE. 0 ) THEN + write(6,*) ' Out PORD, NCMPA=', NCMPA + INFO( 1 ) = -9999 + INFO( 2 ) = 4 + RETURN + ENDIF +#endif +#if defined(scotch) || defined(ptscotch) + ELSEIF (IORD .EQ. 3) THEN + CALL MUMPS_SCOTCH(NCMP, LLIW, IW(L2), IWFR, + & PTRAR(1,2), IW(1), IW(L1), IKEEP, + & IKEEP(1,2), NCMPA) + IF ( NCMPA .NE. 0 ) THEN + write(6,*) ' Out SCTOCH, NCMPA=', NCMPA + INFO( 1 ) = -9999 + INFO( 2 ) = 3 + RETURN + ENDIF + IF (COMPRESS .EQ. 1) THEN + CALL DMUMPS_548(NCMP,IW(L2),IW(L1),FILS) + CALL DMUMPS_549(NCMP,IW(L2),IKEEP(1,1), + & FRERE,PTRAR(1,1)) + DO I=1,NCMP + IKEEP(IKEEP(I,1),2)=I + ENDDO + ENDIF +#endif + ELSEIF (IORD .EQ. 2) THEN + NBBUCK = 2*N + ALLOCATE( HEAD ( 0: NBBUCK + 1), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = NBBUCK+2 + RETURN + ENDIF + IF(COMPRESS .GE. 1) THEN + DO I=L1,L1-1+KEEP(93)/2 + IW(I) = 2 + ENDDO + DO I=L1+KEEP(93)/2,L1+NCMP-1 + IW(I) = 1 + ENDDO + ELSE + IW(L1) = -1 + ENDIF + IF(COMPRESS .LE. 1) THEN + CALL MUMPS_337(NCMP, NBBUCK, LLIW, IW(L2), + & IWFR, PTRAR(1,2), + & IW(1), IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3), HEAD) + ELSE + IF(PROK) WRITE(MP,'(A)') + & ' Constrained Ordering based on AMF' + CALL MUMPS_560(NCMP, NBBUCK, LLIW, IW(L2), + & IWFR, PTRAR(1,2), + & IW(1), IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3), HEAD, + & NFSIZ, FRERE) + ENDIF + DEALLOCATE(HEAD) + ELSEIF (IORD .EQ. 6) THEN + ALLOCATE( HEAD ( N ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = N + RETURN + ENDIF + THRESH = 1 + IVersion = 2 + IF(COMPRESS .EQ. 1) THEN + DO I=L1,L1-1+KEEP(93)/2 + IW(I) = 2 + ENDDO + DO I=L1+KEEP(93)/2,L1+NCMP-1 + IW(I) = 1 + ENDDO + TOTEL = KEEP(93)+KEEP(94) + ELSE + IW(L1) = -1 + TOTEL = N + ENDIF + CALL MUMPS_421(TOTEL,IVersion, THRESH, HEAD, + & NCMP, LLIW, IW(L2), IWFR, PTRAR(1,2), IW(1), + & IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3)) + DEALLOCATE(HEAD) + ELSE + CALL MUMPS_197(NCMP, LLIW, IW(L2), IWFR, PTRAR(1,2), + & IW(1), IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3)) + ENDIF + ENDIF + IF(COMPRESS .GE. 1) THEN + CALL DMUMPS_550(N,NCMP,KEEP(94),KEEP(93), + & PIV,IKEEP(1,1),IKEEP(1,2)) + COMPRESS = -1 + ENDIF + ENDIF +#if defined(metis) || defined(parmetis) + IF (IORD.EQ.5) THEN + IF (PROK) THEN + WRITE(MP,'(A)') ' Ordering based on METIS ' + ENDIF + NUMFLAG = 1 + OPT_METIS_SIZE = 8 + ALLOCATE( OPTIONS_METIS (OPT_METIS_SIZE ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = OPT_METIS_SIZE + RETURN + ENDIF + OPTIONS_METIS(1) = 0 + IF (COMPRESS .EQ. 1) THEN + DO I=1,KEEP(93)/2 + FILS(I) = 2 + ENDDO + DO I=KEEP(93)/2+1,NCMP + FILS(I) = 1 + ENDDO + CALL METIS_NODEWND(NCMP, IW(L2), IW(1),FILS, + & NUMFLAG, OPTIONS_METIS, + & IKEEP(1,2), IKEEP(1,1) ) + ELSE + CALL METIS_NODEND(NCMP, IW(L2), IW(1), NUMFLAG, + & OPTIONS_METIS, + & IKEEP(1,2), IKEEP(1,1) ) + ENDIF + DEALLOCATE (OPTIONS_METIS) + IF ( COMPRESS_SCHUR ) THEN + CALL DMUMPS_622( + & N, NCMP, IKEEP(1,1),IKEEP(1,2), + & LISTVAR_SCHUR, SIZE_SCHUR, FILS) + COMPRESS = -1 + ENDIF + IF (COMPRESS .EQ. 1) THEN + CALL DMUMPS_550(N,NCMP,KEEP(94), + & KEEP(93),PIV,IKEEP(1,1),IKEEP(1,2)) + COMPRESS = -1 + ENDIF + ENDIF +#endif + IF (PROK) THEN + IF (IORD.EQ.1) THEN + WRITE(MP,'(A)') ' Ordering given is used' + ENDIF + ENDIF + IF ((IORD.EQ.1) + & ) THEN + DO K=1,N + PTRAR(K,1) = 0 + ENDDO + DO K=1,N + IF ((IKEEP(K,1).LE.0).OR.(IKEEP(K,1).GT.N)) + & GO TO 40 + IF (PTRAR(IKEEP(K,1),1).EQ.1) THEN + GOTO 40 + ELSE + PTRAR(IKEEP(K,1),1) = 1 + ENDIF + ENDDO + ENDIF + IF (IORD.EQ.1 .OR. IORD.EQ.5 .OR. COMPRESS.EQ.-1) THEN + IF (KEEP(106)==1) THEN + IF ( COMPRESS .EQ. -1 ) THEN + CALL DMUMPS_351(N,NZ,IRN, ICN, IW(1), LLIW, + & IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, KEEP(50), + & MedDens, NBQD, AvgDens) + INFO(8) = symmetry + ENDIF + COMPRESS = 0 + ALLOCATE( HEAD ( 2*N ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = 2*N + RETURN + ENDIF + THRESH = -1 + IF (KEEP(60) == 0) THEN + ITEMP = 0 + ELSE + ITEMP = SIZE_SCHUR + IF (KEEP(60)==1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSE + KEEP(38) = LISTVAR_SCHUR(1) + ENDIF + ENDIF + AGG6 =.TRUE. + CALL MUMPS_422(THRESH, HEAD, + & N, LLIW, IW(L2), IWFR, PTRAR(1,2), IW, + & IW(L1), HEAD(N+1), + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), PTRAR, PTRAR(1,3), + & IKEEP(1,1), LISTVAR_SCHUR, ITEMP, AGG6) + DEALLOCATE(HEAD) + ELSE + CALL DMUMPS_198(N, NZ, IRN, ICN, IKEEP, IW(1), + & LLIW, IW(L2), + & PTRAR(1,2), IW(L1), IWFR, + & INFO(1),INFO(2), KEEP(11), MP) + IF (KEEP(60) .EQ. 0) THEN + ITEMP = 0 + CALL DMUMPS_199(N, IW(L2), IW, LLIW, IWFR, IKEEP, + & IKEEP(1,2), IW(L1), + & PTRAR, NCMPA, ITEMP) + ELSE + CALL DMUMPS_199(N, IW(L2), IW, LLIW, IWFR, IKEEP, + & IKEEP(1,2), IW(L1), + & PTRAR, NCMPA, SIZE_SCHUR) + IF (KEEP(60) .EQ. 1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSE + KEEP(38) = LISTVAR_SCHUR(1) + ENDIF + ENDIF + ENDIF + ENDIF +#if defined(OLDDFS) + CALL DMUMPS_200 + & (N, IW(L2), IW(L1), IKEEP(1,1), IKEEP(1,2), IKEEP(1,3), + & NFSIZ, INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, KEEP(60)) +#else + CALL DMUMPS_557 + & (N, IW(L2), IW(L1), IKEEP(1,1), IKEEP(1,2), IKEEP(1,3), + & NFSIZ, PTRAR, INFO(6), FILS, FRERE, + & PTRAR(1,3), NEMIN, PTRAR(1,4), KEEP(60), + & KEEP(20),KEEP(38),PTRAR(1,2),KEEP(104),IW(1),KEEP(50), + & ICNTL(13), KEEP(37), NSLAVES, KEEP(250).EQ.1) +#endif + IF (KEEP(60).NE.0) THEN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO WHILE (IN.GT.0) + IN = FILS (IN) + END DO + IFSON = -IN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO I=2,SIZE_SCHUR + FILS(IN) = LISTVAR_SCHUR (I) + IN = FILS(IN) + FRERE (IN) = N+1 + ENDDO + FILS(IN) = -IFSON + ENDIF + CALL DMUMPS_201(IKEEP(1,2), + & PTRAR(1,3), INFO(6), + & INFO(5), KEEP(2), KEEP(50), + & KEEP(101),KEEP(108),KEEP(5), + & KEEP(6), KEEP(226), KEEP(253)) + IF ( KEEP(53) .NE. 0 ) THEN + CALL MUMPS_209( N, FRERE, FILS, NFSIZ, KEEP(20) ) + END IF + IF ( (KEEP(48) == 4 .AND. KEEP8(21).GT.0_8) + & .OR. + & (KEEP (48)==5 .AND. KEEP8(21) .GT. 0_8 ) + & .OR. + & (KEEP(24).NE.0.AND.KEEP8(21).GT.0_8) ) THEN + CALL DMUMPS_510(KEEP8(21), KEEP(2), + & KEEP(48), KEEP(50), NSLAVES) + END IF + IF (KEEP(210).LT.0.OR.KEEP(210).GT.2) KEEP(210)=0 + IF (KEEP(210).EQ.0.AND.KEEP(201).GT.0) KEEP(210)=1 + IF (KEEP(210).EQ.0.AND.KEEP(201).EQ.0) KEEP(210)=2 + IF (KEEP(210).EQ.2) KEEP8(79)=huge(KEEP8(79)) + IF (KEEP(210).EQ.1.AND.KEEP8(79).LE.0_8) THEN + IF ( huge(KEEP8(79)) / K79REF + 1_8 .GE. int(NSLAVES,8) ) THEN + KEEP8(79)=huge(KEEP8(79)) + ELSE + KEEP8(79)=K79REF * int(NSLAVES,8) + ENDIF + ENDIF + IF ( (KEEP(79).EQ.0).OR.(KEEP(79).EQ.2).OR. + & (KEEP(79).EQ.3).OR.(KEEP(79).EQ.5).OR. + & (KEEP(79).EQ.6) + & ) THEN + IF (KEEP(210).EQ.1) THEN + SPLITROOT = .FALSE. + IF ( KEEP(62).GE.1) THEN + CALL DMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG,INFO(1),INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + ENDIF + ENDIF + SPLITROOT = ((ICNTL(13).GT.0 .AND. NSLAVES.GT.ICNTL(13)) .OR. + & ICNTL(13).EQ.-1 ) + & .AND. (KEEP(60).EQ.0) + IF (SPLITROOT) THEN + CALL DMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG,INFO(1),INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (K.GT.0) WRITE (MP,99997) (IKEEP(I,1),I=1,K) + IF (K.GT.0) WRITE (MP,99991) (IKEEP(I,2),I=1,K) + IF (K.GT.0) WRITE (MP,99990) (IKEEP(I,3),I=1,K) + IF (K.GT.0) WRITE (MP,99986) (PTRAR(I,1),I=1,K) + IF (K.GT.0) WRITE (MP,99985) (PTRAR(I,2),I=1,K) + IF (K.GT.0) WRITE (MP,99984) (PTRAR(I,3),I=1,K) + IF (K.GT.0) WRITE (MP,99987) (NFSIZ(I),I=1,K) + IF (K.GT.0) WRITE (MP,99989) (FILS(I),I=1,K) + IF (K.GT.0) WRITE (MP,99988) (FRERE(I),I=1,K) + ENDIF + GO TO 90 + 40 INFO(1) = -4 + INFO(2) = K + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99996) INFO(1) + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99982) INFO(2) + GOTO 90 + 90 CONTINUE + DEALLOCATE(IW) + RETURN +99999 FORMAT (/'Entering analysis phase with ...'/ + & ' N NZ LIW INFO(1)'/, + & 9X, I8, I11, I12, I14) +99998 FORMAT ('Matrix entries: IRN() ICN()'/ + & (I12, I7, I12, I7, I12, I7)) +99997 FORMAT ('IKEEP(.,1)=', 10I6/(12X, 10I6)) +99996 FORMAT (/'** Error return ** from Analysis * INFO(1)=', I3) +99991 FORMAT ('IKEEP(.,2)=', 10I6/(12X, 10I6)) +99990 FORMAT ('IKEEP(.,3)=', 10I6/(12X, 10I6)) +99989 FORMAT ('FILS (.) =', 10I6/(12X, 10I6)) +99988 FORMAT ('FRERE(.) =', 10I6/(12X, 10I6)) +99987 FORMAT ('NFSIZ(.) =', 10I6/(12X, 10I6)) +99986 FORMAT ('PTRAR(.,1)=', 10I6/(12X, 10I6)) +99985 FORMAT ('PTRAR(.,2)=', 10I6/(12X, 10I6)) +99984 FORMAT ('PTRAR(.,3)=', 10I6/(12X, 10I6)) +99982 FORMAT ('Error in permutation array KEEP INFO(2)=', I3) + END SUBROUTINE DMUMPS_195 + SUBROUTINE DMUMPS_199(N,IPE,IW, LW, IWFR, IPS, IPV, NV, FLAG, + & NCMPA, SIZE_SCHUR) + INTEGER N,LW,IWFR,NCMPA,SIZE_SCHUR + INTEGER FLAG(N) + INTEGER IPS(N), IPV(N) + INTEGER IW(LW), NV(N), IPE(N) + INTEGER I,J,ML,MS,ME,IP,MINJS,IE,KDUMMY,JP + INTEGER LN,JP1,JS,LWFR,JP2,JE + DO 10 I=1,N + FLAG(I) = 0 + NV(I) = 0 + J = IPS(I) + IPV(J) = I + 10 CONTINUE + NCMPA = 0 + DO 100 ML=1,N-SIZE_SCHUR + MS = IPV(ML) + ME = MS + FLAG(MS) = ME + IP = IWFR + MINJS = N + IE = ME + DO 70 KDUMMY=1,N + JP = IPE(IE) + LN = 0 + IF (JP.LE.0) GO TO 60 + LN = IW(JP) + DO 50 JP1=1,LN + JP = JP + 1 + JS = IW(JP) + IF (FLAG(JS).EQ.ME) GO TO 50 + FLAG(JS) = ME + IF (IWFR.LT.LW) GO TO 40 + IPE(IE) = JP + IW(JP) = LN - JP1 + CALL DMUMPS_194(N, IPE, IW, IP-1, LWFR,NCMPA) + JP2 = IWFR - 1 + IWFR = LWFR + IF (IP.GT.JP2) GO TO 30 + DO 20 JP=IP,JP2 + IW(IWFR) = IW(JP) + IWFR = IWFR + 1 + 20 CONTINUE + 30 IP = LWFR + JP = IPE(IE) + 40 IW(IWFR) = JS + MINJS = min0(MINJS,IPS(JS)+0) + IWFR = IWFR + 1 + 50 CONTINUE + 60 IPE(IE) = -ME + JE = NV(IE) + NV(IE) = LN + 1 + IE = JE + IF (IE.EQ.0) GO TO 80 + 70 CONTINUE + 80 IF (IWFR.GT.IP) GO TO 90 + IPE(ME) = 0 + NV(ME) = 1 + GO TO 100 + 90 MINJS = IPV(MINJS) + NV(ME) = NV(MINJS) + NV(MINJS) = ME + IW(IWFR) = IW(IP) + IW(IP) = IWFR - IP + IPE(ME) = IP + IWFR = IWFR + 1 + 100 CONTINUE + IF (SIZE_SCHUR == 0) RETURN + DO ML = N-SIZE_SCHUR+1,N + ME = IPV(ML) + IE = ME + DO KDUMMY=1,N + JP = IPE(IE) + LN = 0 + IF (JP.LE.0) GO TO 160 + LN = IW(JP) + 160 IPE(IE) = -IPV(N-SIZE_SCHUR+1) + JE = NV(IE) + NV(IE) = LN + 1 + IE = JE + IF (IE.EQ.0) GO TO 190 + ENDDO + 190 NV(ME) = 0 + IPE(ME) = -IPV(N-SIZE_SCHUR+1) + ENDDO + ME = IPV(N-SIZE_SCHUR+1) + IPE(ME) = 0 + NV(ME) = SIZE_SCHUR + RETURN + END SUBROUTINE DMUMPS_199 + SUBROUTINE DMUMPS_198(N, NZ, IRN, ICN, PERM, + & IW, LW, IPE, IQ, FLAG, + & IWFR, IFLAG, IERROR, IOVFLO, MP) + INTEGER N,NZ,LW,IWFR,IFLAG,IERROR + INTEGER PERM(N) + INTEGER IQ(N) + INTEGER IRN(NZ), ICN(NZ) + INTEGER IPE(N), IW(LW), FLAG(N) + INTEGER MP + INTEGER IOVFLO + INTEGER I,J,K,LBIG,L,ID,IN,LEN,JDUMMY,K1,K2 + IERROR = 0 + DO 10 I=1,N + IQ(I) = 0 + 10 CONTINUE + DO 80 K=1,NZ + I = IRN(K) + J = ICN(K) + IW(K) = -I + IF (I.EQ.J) GOTO 40 + IF (I.GT.J) GOTO 30 + IF (I.GE.1 .AND. J.LE.N) GO TO 60 + GO TO 50 + 30 IF (J.GE.1 .AND. I.LE.N) GO TO 60 + GO TO 50 + 40 IW(K) = 0 + IF (I.GE.1 .AND. I.LE.N) GO TO 80 + 50 IERROR = IERROR + 1 + IW(K) = 0 + IF (IERROR.LE.1 .AND. MP.GT.0) WRITE (MP,99999) + IF (IERROR.LE.10 .AND. MP.GT.0) WRITE (MP,99998) K, I, J + GO TO 80 + 60 IF (PERM(J).GT.PERM(I)) GO TO 70 + IQ(J) = IQ(J) + 1 + GO TO 80 + 70 IQ(I) = IQ(I) + 1 + 80 CONTINUE + IF (IERROR.GE.1) THEN + IF (mod(IFLAG,2) .EQ. 0) IFLAG = IFLAG+1 + ENDIF + IWFR = 1 + LBIG = 0 + DO 100 I=1,N + L = IQ(I) + LBIG = max0(L,LBIG) + IWFR = IWFR + L + IPE(I) = IWFR - 1 + 100 CONTINUE + DO 140 K=1,NZ + I = -IW(K) + IF (I.LE.0) GO TO 140 + L = K + IW(K) = 0 + DO 130 ID=1,NZ + J = ICN(L) + IF (PERM(I).LT.PERM(J)) GO TO 110 + L = IPE(J) + IPE(J) = L - 1 + IN = IW(L) + IW(L) = I + GO TO 120 + 110 L = IPE(I) + IPE(I) = L - 1 + IN = IW(L) + IW(L) = J + 120 I = -IN + IF (I.LE.0) GO TO 140 + 130 CONTINUE + 140 CONTINUE + K = IWFR - 1 + L = K + N + IWFR = L + 1 + DO 170 I=1,N + FLAG(I) = 0 + J = N + 1 - I + LEN = IQ(J) + IF (LEN.LE.0) GO TO 160 + DO 150 JDUMMY=1,LEN + IW(L) = IW(K) + K = K - 1 + L = L - 1 + 150 CONTINUE + 160 IPE(J) = L + L = L - 1 + 170 CONTINUE + IF (LBIG.GE.IOVFLO) GO TO 190 + DO 180 I=1,N + K = IPE(I) + IW(K) = IQ(I) + IF (IQ(I).EQ.0) IPE(I) = 0 + 180 CONTINUE + GO TO 230 + 190 IWFR = 1 + DO 220 I=1,N + K1 = IPE(I) + 1 + K2 = IPE(I) + IQ(I) + IF (K1.LE.K2) GO TO 200 + IPE(I) = 0 + GO TO 220 + 200 IPE(I) = IWFR + IWFR = IWFR + 1 + DO 210 K=K1,K2 + J = IW(K) + IF (FLAG(J).EQ.I) GO TO 210 + IW(IWFR) = J + IWFR = IWFR + 1 + FLAG(J) = I + 210 CONTINUE + K = IPE(I) + IW(K) = IWFR - K - 1 + 220 CONTINUE + 230 RETURN +99999 FORMAT (' *** WARNING MESSAGE FROM DMUMPS_198 ***' ) +99998 FORMAT (I6, ' NON-ZERO (IN ROW, I6, 11H AND COLUMN ', I6, + & ') IGNORED') + END SUBROUTINE DMUMPS_198 + SUBROUTINE DMUMPS_194(N, IPE, IW, LW, IWFR,NCMPA) + INTEGER N,LW,IWFR,NCMPA + INTEGER IPE(N) + INTEGER IW(LW) + INTEGER I,K1,LWFR,IR,K,K2 + NCMPA = NCMPA + 1 + DO 10 I=1,N + K1 = IPE(I) + IF (K1.LE.0) GO TO 10 + IPE(I) = IW(K1) + IW(K1) = -I + 10 CONTINUE + IWFR = 1 + LWFR = IWFR + DO 60 IR=1,N + IF (LWFR.GT.LW) GO TO 70 + DO 20 K=LWFR,LW + IF (IW(K).LT.0) GO TO 30 + 20 CONTINUE + GO TO 70 + 30 I = -IW(K) + IW(IWFR) = IPE(I) + IPE(I) = IWFR + K1 = K + 1 + K2 = K + IW(IWFR) + IWFR = IWFR + 1 + IF (K1.GT.K2) GO TO 50 + DO 40 K=K1,K2 + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + 40 CONTINUE + 50 LWFR = K2 + 1 + 60 CONTINUE + 70 RETURN + END SUBROUTINE DMUMPS_194 +#if defined(OLDDFS) + SUBROUTINE DMUMPS_200(N, IPE, NV, IPS, NE, NA, NFSIZ, + & NSTEPS, + & FILS, FRERE,NDD,NEMIN, KEEP60) + INTEGER N,NSTEPS + INTEGER NDD(N) + INTEGER FILS(N), FRERE(N) + INTEGER IPS(N), NE(N), NA(N), NFSIZ(N) + INTEGER IPE(N), NV(N) + INTEGER NEMIN, KEEP60 + INTEGER I,IF,IS,NR,NR1,INS,INL,INB,INF,INFS,INSW + INTEGER K,L,ISON,IN,INP,IFSON,INC,INO + INTEGER INOS,IB,IL + DO 10 I=1,N + IPS(I) = 0 + NE(I) = 0 + 10 CONTINUE + DO 20 I=1,N + IF (NV(I).GT.0) GO TO 20 + IF = -IPE(I) + IS = -IPS(IF) + IF (IS.GT.0) IPE(I) = IS + IPS(IF) = -I + 20 CONTINUE + NR = N + 1 + DO 50 I=1,N + IF (NV(I).LE.0) GO TO 50 + IF = -IPE(I) + IF (IF.NE.0) THEN + IS = -IPS(IF) + IF (IS.GT.0) IPE(I) = IS + IPS(IF) = -I + ELSE + NR = NR - 1 + NE(NR) = I + ENDIF + 50 CONTINUE + DO 999 I=1,N + FILS(I) = IPS(I) + 999 CONTINUE + NR1 = NR + INS = 0 + 1000 IF (NR1.GT.N) GO TO 1151 + INS = NE(NR1) + NR1 = NR1 + 1 + 1070 INL = FILS(INS) + IF (INL.LT.0) THEN + INS = -INL + GO TO 1070 + ENDIF + 1080 IF (IPE(INS).LT.0) THEN + INS = -IPE(INS) + FILS(INS) = 0 + GO TO 1080 + ENDIF + IF (IPE(INS).EQ.0) THEN + INS = 0 + GO TO 1000 + ENDIF + INB = IPE(INS) + IF (NV(INB).EQ.0) THEN + INS = INB + GO TO 1070 + ENDIF + IF (NV(INB).GE.NV(INS)) THEN + INS = INB + GO TO 1070 + ENDIF + INF = INB + 1090 INF = IPE(INF) + IF (INF.GT.0) GO TO 1090 + INF = -INF + INFS = -FILS(INF) + IF (INFS.EQ.INS) THEN + FILS(INF) = -INB + IPS(INF) = -INB + IPE(INS) = IPE(INB) + IPE(INB) = INS + INS = INB + GO TO 1070 + ENDIF + INSW = INFS + 1100 INFS = IPE(INSW) + IF (INFS.NE.INS) THEN + INSW = INFS + GO TO 1100 + ENDIF + IPE(INS) = IPE(INB) + IPE(INB) = INS + IPE(INSW)= INB + INS =INB + GO TO 1070 + 1151 CONTINUE + DO 51 I=1,N + FRERE(I) = IPE(I) + FILS(I) = IPS(I) + 51 CONTINUE + IS = 1 + I = 0 + IL = 0 + DO 160 K=1,N + IF (I.GT.0) GO TO 60 + I = NE(NR) + NE(NR) = 0 + NR = NR + 1 + IL = N + NA(N) = 0 + 60 DO 70 L=1,N + IF (IPS(I).GE.0) GO TO 80 + ISON = -IPS(I) + IPS(I) = 0 + I = ISON + IL = IL - 1 + NA(IL) = 0 + 70 CONTINUE + 80 IPS(I) = K + NE(IS) = NE(IS) + 1 + IF (NV(I).GT.0) GO TO 89 + IN = I + 81 IN = FRERE(IN) + IF (IN.GT.0) GO TO 81 + IF = -IN + IN = IF + 82 INL = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 82 + IFSON = -IN + FILS(INL) = I + IN = I + 83 INP = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 83 + IF (IFSON .EQ. I) GO TO 86 + FILS(INP) = -IFSON + IN = IFSON + 84 INC =IN + IN = FRERE(IN) + IF (IN.NE.I) GO TO 84 + FRERE(INC) = FRERE(I) + GO TO 120 + 86 IF (FRERE(I).LT.0) FILS(INP) = 0 + IF (FRERE(I).GT.0) FILS(INP) = -FRERE(I) + GO TO 120 + 89 IF (IL.LT.N) NA(IL+1) = NA(IL+1) + 1 + NA(IS) = NA(IL) + NDD(IS) = NV(I) + NFSIZ(I) = NV(I) + IF (NA(IS).LT.1) GO TO 110 + IF ( (KEEP60.NE.0).AND. + & (NE(IS).EQ.NDD(IS)) ) GOTO 110 + IF (NDD(IS-1)-NE(IS-1).EQ.NDD(IS)) GO TO 100 + IF ((NE(IS-1).GE.NEMIN).AND. + & (NE(IS).GE.NEMIN) ) GO TO 110 + IF (2*NE(IS-1)*(NDD(IS)-NDD(IS-1)+NE(IS-1)).GE. + & ((NDD(IS)+NE(IS-1))* + & (NDD(IS)+NE(IS-1))*NEMIN/100)) GO TO 110 + 100 NA(IS-1) = NA(IS-1) + NA(IS) - 1 + NDD(IS-1) = NDD(IS) + NE(IS-1) + NE(IS-1) = NE(IS) + NE(IS-1) + NE(IS) = 0 + IN=I + 101 INL = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 101 + IFSON = -IN + IN = IFSON + 102 INO = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 102 + FILS(INL) = INO + NFSIZ(I) = NDD(IS-1) + IN = INO + 103 INP = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 103 + INOS = -IN + IF (IFSON.EQ.INO) GO TO 107 + IN = IFSON + FILS(INP) = -IFSON + 105 INS = IN + IN = FRERE(IN) + IF (IN.NE.INO) GO TO 105 + IF (INOS.EQ.0) FRERE(INS) = -I + IF (INOS.NE.0) FRERE(INS) = INOS + IF (INOS.EQ.0) GO TO 109 + 107 IN = INOS + IF (IN.EQ.0) GO TO 109 + 108 INT = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 108 + FRERE(INT) = -I + 109 CONTINUE + GO TO 120 + 110 IS = IS + 1 + 120 IB = IPE(I) + IF (IB.LT.0) GOTO 150 + IF (IB.EQ.0) GOTO 140 + NA(IL) = 0 + 140 I = IB + GO TO 160 + 150 I = -IB + IL = IL + 1 + 160 CONTINUE + NSTEPS = IS - 1 + DO 170 I=1,N + K = FILS(I) + IF (K.GT.0) THEN + FRERE(K) = N + 1 + NFSIZ(K) = 0 + ENDIF + 170 CONTINUE + RETURN + END SUBROUTINE DMUMPS_200 +#else + SUBROUTINE DMUMPS_557(N, IPE, NV, IPS, NE, NA, NFSIZ, + & NODE, NSTEPS, + & FILS, FRERE, ND, NEMIN, SUBORD, KEEP60, + & KEEP20, KEEP38, NAMALG,NAMALGMAX, + & CUMUL,KEEP50, ICNTL13, KEEP37, NSLAVES, + & ALLOW_AMALG_TINY_NODES) + IMPLICIT NONE + INTEGER N, NSTEPS, KEEP60, KEEP20, KEEP38, KEEP50 + INTEGER ND(N), NFSIZ(N) + INTEGER IPE(N), FILS(N), FRERE(N), SUBORD(N) + INTEGER NV(N), IPS(N), NE(N), NA(N), NODE(N) + INTEGER NEMIN,AMALG_COUNT + INTEGER NAMALG(N),NAMALGMAX, CUMUL(N) + DOUBLE PRECISION ACCU, FLOPS_FATHER, FLOPS_SON, + & FLOPS_AVANT, FLOPS_APRES + INTEGER ICNTL13, KEEP37, NSLAVES + LOGICAL ALLOW_AMALG_TINY_NODES +#if defined(NOAMALGTOFATHER) +#else +#endif + INTEGER I,IF,IS,NR,INS + INTEGER K,L,ISON,IN,IFSON,INO + INTEGER INOS,IB,IL + INTEGER IPERM +#if defined(NOAMALGTOFATHER) + INTEGER INB,INF,INFS,INL,INSW,INT,NR1 +#else + INTEGER DADI + LOGICAL AMALG_TO_father_OK +#endif + AMALG_COUNT = 0 + DO 10 I=1,N + CUMUL(I)= 0 + IPS(I) = 0 + NE(I) = 0 + NODE(I) = 1 + SUBORD(I) = 0 + NAMALG(I) = 0 + 10 CONTINUE + FRERE(1:N) = IPE(1:N) + NR = N + 1 + DO 50 I=1,N + IF = -FRERE(I) + IF (NV(I).EQ.0) THEN + IF (SUBORD(IF).NE.0) SUBORD(I) = SUBORD(IF) + SUBORD(IF) = I + NODE(IF) = NODE(IF)+1 + ELSE + IF (IF.NE.0) THEN + IS = -IPS(IF) + IF (IS.GT.0) FRERE(I) = IS + IPS(IF) = -I + ELSE + NR = NR - 1 + NE(NR) = I + ENDIF + ENDIF + 50 CONTINUE +#if defined(NOAMALGTOFATHER) + DO 999 I=1,N + FILS(I) = IPS(I) + 999 CONTINUE + NR1 = NR + INS = 0 + 1000 IF (NR1.GT.N) GO TO 1151 + INS = NE(NR1) + NR1 = NR1 + 1 + 1070 INL = FILS(INS) + IF (INL.LT.0) THEN + INS = -INL + GO TO 1070 + ENDIF + 1080 IF (FRERE(INS).LT.0) THEN + INS = -FRERE(INS) + FILS(INS) = 0 + GO TO 1080 + ENDIF + IF (FRERE(INS).EQ.0) THEN + INS = 0 + GO TO 1000 + ENDIF + INB = FRERE(INS) + IF (NV(INB).GE.NV(INS)) THEN + INS = INB + GO TO 1070 + ENDIF + INF = INB + 1090 INF = FRERE(INF) + IF (INF.GT.0) GO TO 1090 + INF = -INF + INFS = -FILS(INF) + IF (INFS.EQ.INS) THEN + FILS(INF) = -INB + IPS(INF) = -INB + FRERE(INS) = FRERE(INB) + FRERE(INB) = INS + ELSE + INSW = INFS + 1100 INFS = FRERE(INSW) + IF (INFS.NE.INS) THEN + INSW = INFS + GO TO 1100 + ENDIF + FRERE(INS) = FRERE(INB) + FRERE(INB) = INS + FRERE(INSW)= INB + ENDIF + INS = INB + GO TO 1070 +#endif + DO 51 I=1,N + FILS(I) = IPS(I) + 51 CONTINUE + IS = 1 + I = 0 + IPERM = 1 + DO 160 K=1,N + AMALG_TO_father_OK=.FALSE. + IF (I.LE.0) THEN + IF (NR.GT.N) EXIT + I = NE(NR) + NE(NR) = 0 + NR = NR + 1 + IL = N + NA(N) = 0 + ENDIF + DO 70 L=1,N + IF (IPS(I).GE.0) EXIT + ISON = -IPS(I) + IPS(I) = 0 + I = ISON + IL = IL - 1 + NA(IL) = 0 + 70 CONTINUE +#if ! defined(NOAMALGTOFATHER) + DADI = -IPE(I) + IF ( (DADI.NE.0) .AND. + & ( + & (KEEP60.EQ.0).OR. + & ( (KEEP20.NE.DADI).AND.(KEEP38.NE.DADI) ) + & ) + & ) THEN + ACCU = + & ( dble(20000)* + & dble(NODE(I))*dble(NV(DADI)-NV(I)+NODE(I)) + & ) + & / + & ( dble(NV(DADI)+NODE(I))* + & dble(NV(DADI)+NODE(I)) ) + ACCU = ACCU + dble(CUMUL(I) ) + AMALG_TO_father_OK = ( (NODE(I).LE.NEMIN).OR. + & (NODE(DADI).LE.NEMIN) ) + AMALG_TO_father_OK = ( AMALG_TO_father_OK .AND. + & ( + & ( dble(2*(NODE(I)))* + & dble((NV(DADI)-NV(I)+NODE(I))) + & ) .LT. + & ( dble(NV(DADI)+NODE(I))* + & dble(NV(DADI)+NODE(I))*dble(NEMIN)/dble(100) + & ) + & ) ) + AMALG_TO_father_OK = ( AMALG_TO_father_OK .AND. + & ( ACCU .LE. dble(NEMIN)*dble(100) ) + & ) + IF (AMALG_TO_father_OK) THEN + CALL MUMPS_511(NV(I),NODE(I),NODE(I), + & KEEP50,1,FLOPS_SON) + CALL MUMPS_511(NV(DADI),NODE(DADI), + & NODE(DADI), + & KEEP50,1,FLOPS_FATHER) + FLOPS_AVANT = FLOPS_FATHER+FLOPS_SON + & + max(dble(200.0) * dble(NV(I)-NODE(I)) + & * dble(NV(I)-NODE(I)), + & dble(10000.0)) + CALL MUMPS_511(NV(DADI)+NODE(I), + & NODE(DADI)+NODE(I), + & NODE(DADI)+NODE(I), + & KEEP50,1,FLOPS_APRES) + IF(FLOPS_APRES .GT. FLOPS_AVANT) THEN + AMALG_TO_father_OK = .FALSE. + ENDIF + ENDIF + IF ( (NV(I).GT. 50*NV(DADI)).AND. (NSLAVES.GT.1) + & .AND. (ICNTL13.LE.0) + & .AND. (NV(I).GT. KEEP37) ) THEN + AMALG_TO_father_OK = .TRUE. + ENDIF + IF ( ALLOW_AMALG_TINY_NODES .AND. + & NODE(I) * 900 .LE. NV(DADI) - NAMALG(DADI)) THEN + IF ( NAMALG(DADI) < (NV(DADI)-NAMALG(DADI))/50 ) THEN + AMALG_TO_father_OK = .TRUE. + NAMALG(DADI) = NAMALG(DADI) + NODE(I) + ENDIF + ENDIF + AMALG_TO_father_OK = ( AMALG_TO_father_OK .OR. + & ( NV(I)-NODE(I).EQ.NV(DADI)) ) + IF (AMALG_TO_father_OK) THEN + CUMUL(DADI)=CUMUL(DADI)+nint(ACCU) + NAMALG(DADI) = NAMALG(DADI) + NAMALG(I) + AMALG_COUNT = AMALG_COUNT+1 + IN = DADI + 75 IF (SUBORD(IN).EQ.0) GOTO 76 + IN = SUBORD(IN) + GOTO 75 + 76 CONTINUE + SUBORD(IN) = I + NV(I) = 0 + IFSON = -FILS(DADI) + IF (IFSON.EQ.I) THEN + IF (FILS(I).LT.0) THEN + FILS(DADI) = FILS(I) + GOTO 78 + ELSE + IF (FRERE(I).GT.0) THEN + FILS(DADI) = -FRERE(I) + ELSE + FILS(DADI) = 0 + ENDIF + GOTO 90 + ENDIF + ENDIF + IN = IFSON + 77 INS = IN + IN = FRERE(IN) + IF (IN.NE.I) GOTO 77 + IF (FILS(I) .LT.0) THEN + FRERE(INS) = -FILS(I) + ELSE + FRERE(INS) = FRERE(I) + GOTO 90 + ENDIF + 78 CONTINUE + IN = -FILS(I) + 79 INO = IN + IN = FRERE(IN) + IF (IN.GT.0) GOTO 79 + FRERE(INO) = FRERE(I) + 90 CONTINUE + NODE(DADI) = NODE(DADI)+ NODE(I) + NV(DADI) = NV(DADI) + NODE(I) + NA(IL+1) = NA(IL+1) + NA(IL) + GOTO 120 + ENDIF + ENDIF +#endif + NE(IS) = NE(IS) + NODE(I) + IF (IL.LT.N) NA(IL+1) = NA(IL+1) + 1 + NA(IS) = NA(IL) + ND(IS) = NV(I) + NODE(I) = IS + IPS(I) = IPERM + IPERM = IPERM + 1 + IN = I + 777 IF (SUBORD(IN).EQ.0) GO TO 778 + IN = SUBORD(IN) + NODE(IN) = IS + IPS(IN) = IPERM + IPERM = IPERM + 1 + GO TO 777 + 778 IF (NA(IS).LE.0) GO TO 110 +#if defined(NOAMALGTOFATHER) + IF ( (KEEP60.NE.0).AND. + & (NE(IS).EQ.ND(IS)) ) GOTO 110 + IF (ND(IS-1)-NE(IS-1).EQ.ND(IS)) THEN + GO TO 100 + ENDIF + IF(NAMALG(IS-1) .GE. NAMALGMAX) THEN + GOTO 110 + ENDIF + IF ((NE(IS-1).GE.NEMIN).AND. + & (NE(IS).GE.NEMIN) ) GO TO 110 + IF (2*NE(IS-1)*(ND(IS)-ND(IS-1)+NE(IS-1)).GE. + & ((ND(IS)+NE(IS-1))* + & (ND(IS)+NE(IS-1))*NEMIN/100)) GO TO 110 + NAMALG(IS-1) = NAMALG(IS-1)+1 + 100 NA(IS-1) = NA(IS-1) + NA(IS) - 1 + ND(IS-1) = ND(IS) + NE(IS-1) + NE(IS-1) = NE(IS) + NE(IS-1) + NE(IS) = 0 + NODE(I) = IS-1 + IFSON = -FILS(I) + IN = IFSON + 102 INO = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 102 + NV(INO) = 0 + IN = I + 888 IF (SUBORD(IN).EQ.0) GO TO 889 + IN = SUBORD(IN) + GO TO 888 + 889 SUBORD(IN) = INO + INOS = -FILS(INO) + IF (IFSON.EQ.INO) THEN + FILS(I) = -INOS + GO TO 107 + ENDIF + IN = IFSON + 105 INS = IN + IN = FRERE(IN) + IF (IN.NE.INO) GO TO 105 + IF (INOS.EQ.0) THEN + FRERE(INS) = -I + GO TO 120 + ELSE + FRERE(INS) = INOS + ENDIF + 107 IN = INOS + IF (IN.EQ.0) GO TO 120 + 108 INT = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 108 + FRERE(INT) = -I + GO TO 120 +#endif + 110 IS = IS + 1 + 120 IB = FRERE(I) + IF (IB.GE.0) THEN + IF (IB.GT.0) NA(IL) = 0 + I = IB + ELSE + I = -IB + IL = IL + 1 + ENDIF + 160 CONTINUE + NSTEPS = IS - 1 + DO I=1, N + IF (NV(I).EQ.0) THEN + FRERE(I) = N+1 + NFSIZ(I) = 0 + ELSE + NFSIZ(I) = ND(NODE(I)) + IF (SUBORD(I) .NE.0) THEN + INOS = -FILS(I) + INO = I + DO WHILE (SUBORD(INO).NE.0) + IS = SUBORD(INO) + FILS(INO) = IS + INO = IS + END DO + FILS(INO) = -INOS + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_557 +#endif + SUBROUTINE DMUMPS_201(NE, ND, NSTEPS, + & MAXFR, MAXELIM, K50, MAXFAC, MAXNPIV, + & K5,K6,PANEL_SIZE,K253) + IMPLICIT NONE + INTEGER NSTEPS,MAXNPIV + INTEGER MAXFR, MAXELIM, K50, MAXFAC + INTEGER K5,K6,PANEL_SIZE,K253 + INTEGER NE(NSTEPS), ND(NSTEPS) + INTEGER ITREE, NFR, NELIM + INTEGER LKJIB + LKJIB = max(K5,K6) + MAXFR = 0 + MAXFAC = 0 + MAXELIM = 0 + MAXNPIV = 0 + PANEL_SIZE = 0 + DO ITREE=1,NSTEPS + NELIM = NE(ITREE) + NFR = ND(ITREE) + K253 + IF (NFR.GT.MAXFR) MAXFR = NFR + IF (NFR-NELIM.GT.MAXELIM) MAXELIM = NFR - NELIM + IF (NELIM .GT. MAXNPIV) THEN + IF(NFR .NE. NELIM) MAXNPIV = NELIM + ENDIF + IF (K50.EQ.0) THEN + MAXFAC = max(MAXFAC, (2*NFR - NELIM)*NELIM ) + PANEL_SIZE = max(PANEL_SIZE, NFR*(LKJIB+1)) + ELSE + MAXFAC = max(MAXFAC, NFR * NELIM) + PANEL_SIZE = max(PANEL_SIZE, NELIM*(LKJIB+1)) + PANEL_SIZE = max(PANEL_SIZE, (NFR-NELIM)*(LKJIB+1)) + ENDIF + END DO + RETURN + END SUBROUTINE DMUMPS_201 + SUBROUTINE DMUMPS_348( N, FILS, FRERE, + & NSTK, NA ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: N + INTEGER, INTENT(IN) :: FILS(N), FRERE(N) + INTEGER, INTENT(INOUT) :: NSTK(N), NA(N) + INTEGER NBROOT, NBLEAF, ILEAF, I, IN, ISON + NA = 0 + NSTK = 0 + NBROOT = 0 + ILEAF = 1 + DO 11 I=1,N + IF (FRERE(I).EQ. N+1) CYCLE + IF (FRERE(I).EQ.0) NBROOT = NBROOT + 1 + IN = I + 12 IN = FILS(IN) + IF (IN.GT.0) GO TO 12 + IF (IN.EQ.0) THEN + NA(ILEAF) = I + ILEAF = ILEAF + 1 + CYCLE + ENDIF + ISON = -IN + 13 NSTK(I) = NSTK(I) + 1 + ISON = FRERE(ISON) + IF (ISON.GT.0) GO TO 13 + 11 CONTINUE + NBLEAF = ILEAF-1 + IF (N.GT.1) THEN + IF (NBLEAF.GT.N-2) THEN + IF (NBLEAF.EQ.N-1) THEN + NA(N-1) = -NA(N-1)-1 + NA(N) = NBROOT + ELSE + NA(N) = -NA(N)-1 + ENDIF + ELSE + NA(N-1) = NBLEAF + NA(N) = NBROOT + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_348 + SUBROUTINE DMUMPS_203( N, NZ, MTRANS, PERM, + & id, ICNTL, INFO) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (DMUMPS_STRUC) :: id + INTEGER N, NZ, LIWG + INTEGER PERM(N) + INTEGER MTRANS + INTEGER ICNTL(40), INFO(40) + INTEGER allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: IW + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: S2 + TARGET :: S2 + INTEGER LS2,LSC + INTEGER ICNTL64(10), INFO64(10) + INTEGER ICNTL_SYM_MWM(10),INFO_SYM_MWM(10) + DOUBLE PRECISION CNTL64(10) + INTEGER LDW, LDWMIN + INTEGER MPRINT,LP, MP, IPIW, LIW, LIWMIN + INTEGER JPERM + INTEGER NUMNZ, I, J, JPOS, K, NZREAL + INTEGER PLENR, IP, IRNW,RSPOS,CSPOS + LOGICAL PROK, IDENT, DUPPLI + INTEGER NZTOT, K50, KER_SIZE, NZER_DIAG, MTRANSLOC,RZ_DIAG + LOGICAL SCALINGLOC + INTEGER,POINTER,DIMENSION(:) :: ZERODIAG + INTEGER,POINTER,DIMENSION(:) :: STR_KER + INTEGER,POINTER,DIMENSION(:) :: MARKED + INTEGER,POINTER,DIMENSION(:) :: FLAG + INTEGER,POINTER,DIMENSION(:) :: PIV_OUT + DOUBLE PRECISION THEMIN, THEMAX, COLNORM,MAXDBL + DOUBLE PRECISION ZERO,TWO,ONE + PARAMETER(ZERO = 0.0D0,TWO = 2.0D0,ONE = 1.0D0) + MPRINT = ICNTL(3) + LP = ICNTL(1) + MP = ICNTL(2) + PROK = (MPRINT.GT.0) + IF (PROK) WRITE(MPRINT,101) + 101 FORMAT(/'****** Preprocessing of original matrix '/) + K50 = id%KEEP(50) + SCALINGLOC = .FALSE. + IF(id%KEEP(52) .EQ. -2) THEN + IF(.not.associated(id%A)) THEN + INFO(1) = -22 + INFO(2) = 4 + GOTO 500 + ELSE + SCALINGLOC = .TRUE. + ENDIF + ELSE IF(id%KEEP(52) .EQ. 77) THEN + SCALINGLOC = .TRUE. + IF(K50 .NE. 2) THEN + IF( MTRANS .NE. 5 .AND. MTRANS .NE. 6 + & .AND. MTRANS .NE. 7) THEN + SCALINGLOC = .FALSE. + IF (PROK) + & WRITE(MPRINT,*) 'Analysis: auto scaling set OFF' + ENDIF + ENDIF + IF(.not.associated(id%A)) THEN + SCALINGLOC = .FALSE. + IF (PROK) + & WRITE(MPRINT,*) 'Analysis: auto scaling set OFF' + ENDIF + ENDIF + IF(SCALINGLOC) THEN + IF (PROK) WRITE(MPRINT,*) + & 'Scaling will be computed during analysis' + ENDIF + MTRANSLOC = MTRANS + IF (MTRANS.LT.0 .OR. MTRANS.GT.7) GO TO 500 + IF (K50 .EQ. 0) THEN + IF(.NOT. SCALINGLOC .AND. MTRANS .EQ. 7) THEN + GO TO 500 + ENDIF + IF(SCALINGLOC) THEN + MTRANSLOC = 5 + ENDIF + ELSE + IF (MTRANS .EQ. 7) MTRANSLOC = 5 + ENDIF + IF(SCALINGLOC .AND. MTRANSLOC .NE. 5 .AND. + & MTRANSLOC .NE. 6 ) THEN + IF (PROK) WRITE(MPRINT,*) + & 'WARNING scaling required: set MTRANS option to 5' + MTRANSLOC = 5 + ENDIF + IF (N.EQ.1) THEN + MTRANS=0 + GO TO 500 + ENDIF + IF(K50 .EQ. 2) THEN + NZTOT = 2*NZ+N + ELSE + NZTOT = NZ + ENDIF + ZERODIAG => id%IS1(N+1:2*N) + STR_KER => id%IS1(2*N+1:3*N) + CALL DMUMPS_448(ICNTL64,CNTL64) + ICNTL64(1) = ICNTL(1) + ICNTL64(2) = ICNTL(2) + ICNTL64(3) = ICNTL(2) + ICNTL64(4) = -1 + IF (ICNTL(4).EQ.3) ICNTL64(4) = 0 + IF (ICNTL(4).EQ.4) ICNTL64(4) = 1 + ICNTL64(5) = -1 + IF (PROK) THEN + WRITE(MPRINT,'(A,I3)') + & 'Compute maximum matching (Maximum Transversal):', + & MTRANSLOC + IF (MTRANSLOC.EQ.1) + & WRITE(MPRINT,'(A,I3)')' ... JOB =',MTRANSLOC + IF (MTRANSLOC.EQ.2) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC,': BOTTLENECK THESIS' + IF (MTRANSLOC.EQ.3) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC,': BOTTLENECK SIMAX' + IF (MTRANSLOC.EQ.4) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC,': MAXIMIZE SUM DIAGIONAL' + IF (MTRANSLOC.EQ.5 .OR. MTRANSLOC.EQ.6) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC, + & ': MAXIMIZE PRODUCT DIAGONAL AND SCALE' + ENDIF + id%INFOG(23) = MTRANSLOC + CNTL64(2) = huge(CNTL64(2)) + IRNW = 1 + IP = IRNW + NZTOT + PLENR = IP + N + 1 + IPIW = PLENR + IF (MTRANSLOC.EQ.1) LIWMIN = 5*N + IF (MTRANSLOC.EQ.2) LIWMIN = 4*N + IF (MTRANSLOC.EQ.3) LIWMIN = 10*N + NZTOT + IF (MTRANSLOC.EQ.4) LIWMIN = 5*N + IF (MTRANSLOC.EQ.5) LIWMIN = 5*N + IF (MTRANSLOC.EQ.6) LIWMIN = 5*N + NZTOT + LIW = LIWMIN + LIWG = LIW + (NZTOT + N + 1) + ALLOCATE(IW(LIWG), stat=allocok) + IF (allocok .GT. 0 ) GOTO 410 + IF (MTRANSLOC.EQ.1) THEN + LDWMIN = N+3 + ENDIF + IF (MTRANSLOC.EQ.2) LDWMIN = max(N+NZTOT,N+3) + IF (MTRANSLOC.EQ.3) LDWMIN = max(NZTOT+1,N+3) + IF (MTRANSLOC.EQ.4) LDWMIN = 2*N + max(NZTOT,N+3) + IF (MTRANSLOC.EQ.5) LDWMIN = 3*N + NZTOT + IF (MTRANSLOC.EQ.6) LDWMIN = 4*N + NZTOT + LDW = LDWMIN + ALLOCATE(S2(LDW), stat=allocok) + IF(MTRANSLOC .NE. 1) LDW = LDW-NZTOT + RSPOS = NZTOT + CSPOS = RSPOS+N + IF (allocok .GT. 0 ) GOTO 430 + NZREAL = 0 + DO 5 J=1,N + IW(PLENR+J-1) = 0 + 5 CONTINUE + IF(K50 .EQ. 0) THEN + DO 10 K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1).AND. + & (I.LE.N).AND.(I.GE.1) ) THEN + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + NZREAL = NZREAL + 1 + ENDIF + 10 CONTINUE + ELSE + ZERODIAG = 0 + NZER_DIAG = N + RZ_DIAG = 0 + DO K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1).AND. + & (I.LE.N).AND.(I.GE.1) ) THEN + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + NZREAL = NZREAL + 1 + IF(I .NE. J) THEN + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + NZREAL = NZREAL + 1 + ELSE + IF(ZERODIAG(I) .EQ. 0) THEN + ZERODIAG(I) = K + IF(associated(id%A)) THEN + IF(abs(id%A(K)) .EQ. dble(0.0D0)) THEN + RZ_DIAG = RZ_DIAG + 1 + ENDIF + ENDIF + NZER_DIAG = NZER_DIAG - 1 + ENDIF + ENDIF + ENDIF + ENDDO + IF(MTRANSLOC .GE. 4) THEN + DO I =1, N + IF(ZERODIAG(I) .EQ. 0) THEN + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + NZREAL = NZREAL + 1 + ENDIF + ENDDO + ENDIF + ENDIF + IW(IP) = 1 + DO 20 J=1,N + IW(IP+J) = IW(IP+J-1)+IW(PLENR+J-1) + 20 CONTINUE + DO 25 J=1, N + IW(PLENR+J-1 ) = IW(IP+J-1 ) + 25 CONTINUE + IF(K50 .EQ. 0) THEN + IF (MTRANSLOC.EQ.1) THEN + DO 30 K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + ENDIF + 30 CONTINUE + ELSE + IF ( .not.associated(id%A)) THEN + INFO(1) = -22 + INFO(2) = 4 + GOTO 500 + ENDIF + DO 35 K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + S2(JPOS) = abs(id%A(K)) + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + ENDIF + 35 CONTINUE + ENDIF + ELSE + IF (MTRANSLOC.EQ.1) THEN + DO K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + IF(I.NE.J) THEN + JPOS = IW(PLENR+I-1) + IW(IRNW+JPOS-1) = J + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + ENDIF + ENDIF + ENDDO + ELSE + IF ( .not.associated(id%A)) THEN + INFO(1) = -22 + INFO(2) = 4 + GOTO 500 + ENDIF + K = 1 + THEMIN = ZERO + DO + IF(THEMIN .NE. ZERO) EXIT + THEMIN = abs(id%A(K)) + K = K+1 + ENDDO + THEMAX = THEMIN + DO K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + S2(JPOS) = abs(id%A(K)) + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + IF(abs(id%A(K)) .GT. THEMAX) THEN + THEMAX = abs(id%A(K)) + ELSE IF(abs(id%A(K)) .LT. THEMIN + & .AND. abs(id%A(K)).GT. ZERO) THEN + THEMIN = abs(id%A(K)) + ENDIF + IF(I.NE.J) THEN + JPOS = IW(PLENR+I-1) + IW(IRNW+JPOS-1) = J + S2(JPOS) = abs(id%A(K)) + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + ENDIF + ENDIF + ENDDO + DO I =1, N + IF(ZERODIAG(I) .EQ. 0) THEN + JPOS = IW(PLENR+I-1) + IW(IRNW+JPOS-1) = I + S2(JPOS) = ZERO + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + ENDIF + ENDDO + CNTL64(2) = (log(THEMAX/THEMIN))*(dble(N)) + & - log(THEMIN) + ONE + ENDIF + ENDIF + DUPPLI = .FALSE. + I = NZREAL + FLAG => id%IS1(3*N+1:4*N) + IF(MTRANSLOC.NE.1) THEN + CALL DMUMPS_563(N,NZREAL,IW(IP),IW(IRNW),S2, + & PERM,FLAG(1)) + ELSE + CALL DMUMPS_562(N,NZREAL,IW(IP),IW(IRNW), + & PERM,FLAG(1)) + ENDIF + IF(NZREAL .NE. I) DUPPLI = .TRUE. + LS2 = NZTOT + IF ( MTRANSLOC .EQ. 1 ) THEN + LS2 = 1 + LDW = 1 + ENDIF + CALL DMUMPS_559(MTRANSLOC ,N, N, NZREAL, + & IW(IP), IW(IRNW), S2(1), LS2, + & NUMNZ, PERM, LIW, IW(IPIW), LDW, S2(LS2+1), + & ICNTL64, CNTL64, INFO64) + IF (INFO64(1).LT.0) THEN + IF (LP.GT.0 .AND. ICNTL(4).GE.1) + & WRITE(LP,'(A,I5)') + & ' INTERNAL ERROR in MAXTRANS INFO(1)=',INFO64(1) + INFO(1) = -9964 + INFO(2) = INFO64(1) + GO TO 500 + ENDIF + IF (INFO64(1).GT.0) THEN + IF (MP.GT.0 .AND. ICNTL(4).GE.2) + & WRITE(MP,'(A,I5)') + & ' WARNING in MAXTRANS INFO(1)=',INFO64(1) + ENDIF + KER_SIZE = 0 + IF(K50 .EQ. 2) THEN + DO I=1,N + IF(ZERODIAG(I) .EQ. 0) THEN + IF(PERM(I) .EQ. I) THEN + KER_SIZE = KER_SIZE + 1 + PERM(I) = -I + STR_KER(KER_SIZE) = I + ENDIF + ENDIF + ENDDO + ENDIF + IF (NUMNZ.LT.N) GO TO 400 + IF(K50 .EQ. 0) THEN + IDENT = .TRUE. + IF (MTRANS .EQ. 0 ) GOTO 102 + DO 80 J=1,N + JPERM = PERM(J) + IW(PLENR+JPERM-1) = J + IF (JPERM.NE.J) IDENT = .FALSE. + 80 CONTINUE + IF(IDENT) THEN + MTRANS = 0 + ELSE + IF(MTRANS .EQ. 7) THEN + MTRANS = -9876543 + GOTO 102 + ENDIF + IF (PROK) WRITE(MPRINT,'(A)') + & ' ... Apply column permutation' + DO 100 K=1,NZ + J = id%JCN(K) + IF ((J.LE.0).OR.(J.GT.N)) GO TO 100 + id%JCN(K) = IW(PLENR+J-1) + 100 CONTINUE + IF (MP.GT.0 .AND. ICNTL(4).GE.2) + & WRITE(MP,'(/A)') + & ' WARNING input matrix data modified' + ENDIF + 102 CONTINUE + IF (SCALINGLOC) THEN + IF ( associated(id%COLSCA)) + & DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) + & DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in DMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of COLSCA' + GOTO 500 + ENDIF + ENDIF + ALLOCATE( id%ROWSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in DMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of ROWSCA' + GOTO 500 + ENDIF + ENDIF + id%KEEP(52) = -2 + id%KEEP(74) = 1 + MAXDBL = log(huge(MAXDBL)) + DO J=1,N + IF(S2(RSPOS+J) .GT. MAXDBL) THEN + S2(RSPOS+J) = ZERO + ENDIF + IF(S2(CSPOS+J) .GT. MAXDBL) THEN + S2(CSPOS+J)= ZERO + ENDIF + ENDDO + DO 105 J=1,N + id%ROWSCA(J) = exp(S2(RSPOS+J)) + IF(id%ROWSCA(J) .EQ. ZERO) THEN + id%ROWSCA(J) = ONE + ENDIF + IF ( MTRANS .EQ. -9876543 .OR. MTRANS.EQ. 0 ) THEN + id%COLSCA(J)= exp(S2(CSPOS+J)) + IF(id%COLSCA(J) .EQ. ZERO) THEN + id%COLSCA(J) = ONE + ENDIF + ELSE + id%COLSCA(IW(PLENR+J-1))= exp(S2(CSPOS+J)) + IF(id%COLSCA(IW(PLENR+J-1)) .EQ. ZERO) THEN + id%COLSCA(IW(PLENR+J-1)) = ONE + ENDIF + ENDIF + 105 CONTINUE + ENDIF + ELSE + IDENT = .FALSE. + IF(SCALINGLOC) THEN + IF ( associated(id%COLSCA)) DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in DMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of COLSCA' + GOTO 500 + ENDIF + ENDIF + ALLOCATE( id%ROWSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in DMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of ROWSCA' + GOTO 500 + ENDIF + ENDIF + id%KEEP(52) = -2 + id%KEEP(74) = 1 + MAXDBL = log(huge(MAXDBL)) + DO J=1,N + IF(S2(RSPOS+J)+S2(CSPOS+J) .GT. MAXDBL) THEN + S2(RSPOS+J) = ZERO + S2(CSPOS+J)= ZERO + ENDIF + ENDDO + DO J=1,N + IF(PERM(J) .GT. 0) THEN + id%ROWSCA(J) = + & exp((S2(RSPOS+J)+S2(CSPOS+J))/TWO) + IF(id%ROWSCA(J) .EQ. ZERO) THEN + id%ROWSCA(J) = ONE + ENDIF + id%COLSCA(J)= id%ROWSCA(J) + ENDIF + ENDDO + DO JPOS=1,KER_SIZE + I = STR_KER(JPOS) + COLNORM = ZERO + DO J = IW(IP+I-1),IW(IP+I) - 1 + IF ( PERM( IW( IRNW+J-1) ) > 0 ) THEN + COLNORM = max(COLNORM,S2(J)) + ENDIF + ENDDO + COLNORM = exp(COLNORM) + id%ROWSCA(I) = ONE / COLNORM + id%COLSCA(I) = id%ROWSCA(I) + ENDDO + ENDIF + IF(MTRANS .EQ. 7 .OR. id%KEEP(95) .EQ. 0) THEN + IF( (NZER_DIAG+RZ_DIAG) .LT. (N/10) + & .AND. id%KEEP(95) .EQ. 0) THEN + MTRANS = 0 + id%KEEP(95) = 1 + GOTO 390 + ELSE + IF(id%KEEP(95) .EQ. 0) THEN + IF(SCALINGLOC) THEN + id%KEEP(95) = 3 + ELSE + id%KEEP(95) = 2 + ENDIF + ENDIF + IF(MTRANS .EQ. 7) MTRANS = 5 + ENDIF + ENDIF + IF(MTRANS .EQ. 0) GOTO 390 + ICNTL_SYM_MWM = 0 + INFO_SYM_MWM = 0 + IF(MTRANS .EQ. 5 .OR. MTRANS .EQ. 6 .OR. + & MTRANS .EQ. 7) THEN + ICNTL_SYM_MWM(1) = 0 + ICNTL_SYM_MWM(2) = 1 + ELSE IF(MTRANS .EQ. 4) THEN + ICNTL_SYM_MWM(1) = 2 + ICNTL_SYM_MWM(2) = 1 + ELSE + ICNTL_SYM_MWM(1) = 0 + ICNTL_SYM_MWM(2) = 1 + ENDIF + MARKED => id%IS1(2*N+1:3*N) + FLAG => id%IS1(3*N+1:4*N) + PIV_OUT => id%IS1(4*N+1:5*N) + IF(MTRANSLOC .LT. 4) THEN + LSC = 1 + ELSE + LSC = 2*N + ENDIF + CALL DMUMPS_551( + & N, NZREAL, IW(IP), IW(IRNW), S2(1),LSC, PERM, + & ZERODIAG(1), + & ICNTL_SYM_MWM, S2(LSC+1),MARKED(1),FLAG(1), + & PIV_OUT(1), INFO_SYM_MWM) + IF(INFO_SYM_MWM(1) .NE. 0) THEN + WRITE(*,*) '** Error in DMUMPS_203' + RETURN + ENDIF + IF(INFO_SYM_MWM(3) .EQ. N) THEN + IDENT = .TRUE. + ELSEIF( (N-INFO_SYM_MWM(4)-INFO_SYM_MWM(3)) .GT. N/10 + & ) THEN + IDENT = .TRUE. + id%KEEP(95) = 1 + ELSE + DO I=1,N + PERM(I) = PIV_OUT(I) + ENDDO + ENDIF + id%KEEP(93) = INFO_SYM_MWM(4) + id%KEEP(94) = INFO_SYM_MWM(3) + IF (IDENT) MTRANS=0 + ENDIF + 390 IF(MTRANS .EQ. 0) THEN + id%KEEP(95) = 1 + IF (PROK) THEN + WRITE (MPRINT,'(A)') + & ' ... Column permutation not used' + ENDIF + ENDIF + GO TO 500 + 400 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) + & WRITE (LP,'(/A)') '** Error: Matrix is structurally singular' + INFO(1) = -6 + INFO(2) = NUMNZ + GOTO 500 + 410 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in DMUMPS_203' + WRITE (LP,'(A,I9)') + & '** Failure during allocation of INTEGER array of size ', + & LIWG + ENDIF + INFO(1) = -5 + INFO(2) = LIWG + GOTO 500 + 430 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in DMUMPS_203' + WRITE (LP,'(A)') '** Failure during allocation of S2' + ENDIF + INFO(1) = -5 + INFO(2) = LDW + 500 CONTINUE + IF (allocated(IW)) DEALLOCATE(IW) + IF (allocated(S2)) DEALLOCATE(S2) + RETURN + END SUBROUTINE DMUMPS_203 + SUBROUTINE DMUMPS_100 + &( MYID, COMM, KEEP,KEEP8, INFO, INFOG, RINFO, RINFOG, ICNTL ) + IMPLICIT NONE + INTEGER COMM, MYID, KEEP(500), INFO(40), ICNTL(40), INFOG(40) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION RINFO(40), RINFOG(40) + INCLUDE 'mpif.h' + INTEGER MASTER, MPG + PARAMETER( MASTER = 0 ) + MPG = ICNTL(3) + IF ( MYID.eq.MASTER.and.MPG.GT.0) THEN + WRITE(MPG, 99992) INFO(1), INFO(2), + & KEEP8(109), KEEP8(111), INFOG(4), + & INFOG(5), KEEP(28), INFOG(32), INFOG(7), KEEP(23), ICNTL(7), + & KEEP(12), KEEP(56), KEEP(61), RINFOG(1) + IF (KEEP(95).GT.1) + & WRITE(MPG, 99993) KEEP(95) + IF (KEEP(54).GT.0) WRITE(MPG, 99994) KEEP(54) + IF (KEEP(60).GT.0) WRITE(MPG, 99995) KEEP(60) + IF (KEEP(253).GT.0) WRITE(MPG, 99996) KEEP(253) + ENDIF + RETURN +99992 FORMAT(/'Leaving analysis phase with ...'/ + & 'INFOG(1) =',I16/ + & 'INFOG(2) =',I16/ + & ' -- (20) Number of entries in factors (estim.) =',I16/ + & ' -- (3) Storage of factors (REAL, estimated) =',I16/ + & ' -- (4) Storage of factors (INT , estimated) =',I16/ + & ' -- (5) Maximum frontal size (estimated) =',I16/ + & ' -- (6) Number of nodes in the tree =',I16/ + & ' -- (32) Type of analysis effectively used =',I16/ + & ' -- (7) Ordering option effectively used =',I16/ + & 'ICNTL(6) Maximum transversal option =',I16/ + & 'ICNTL(7) Pivot order option =',I16/ + & 'Percentage of memory relaxation (effective) =',I16/ + & 'Number of level 2 nodes =',I16/ + & 'Number of split nodes =',I16/ + & 'RINFOG(1) Operations during elimination (estim)= ',1PD10.3) +99993 FORMAT('Ordering compressed/constrained (ICNTL(12)) =',I16) +99994 FORMAT('Distributed matrix entry format (ICNTL(18)) =',I16) +99995 FORMAT('Effective Schur option (ICNTL(19)) =',I16) +99996 FORMAT('Forward solution during factorization, NRHS =',I16) + END SUBROUTINE DMUMPS_100 + SUBROUTINE DMUMPS_97 + & ( N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, + & KEEP, KEEP8, SPLITROOT, MP, LDIAG, INFO1, INFO2 ) + IMPLICIT NONE + INTEGER N, NSTEPS, NSLAVES, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER FRERE( N ), FILS( N ), NFSIZ( N ) + LOGICAL SPLITROOT + INTEGER MP, LDIAG + INTEGER INFO1, INFO2 + INTEGER, DIMENSION(:), ALLOCATABLE :: IPOOL + INTEGER INODE, DEPTH, I, IBEG, IEND, IIPOOL, NROOT + INTEGER MAX_DEPTH, ISON, TOT_CUT, MAX_CUT, STRAT + INTEGER(8) :: K79 + INTEGER NFRONT, K82, allocok + K79 = KEEP8(79) + K82 = abs(KEEP(82)) + STRAT=KEEP(62) + IF (KEEP(210).EQ.1) THEN + MAX_DEPTH = 2*NSLAVES*K82 + STRAT = STRAT/4 + ELSE + IF (( NSLAVES .eq. 1 ).AND. (.NOT. SPLITROOT) ) RETURN + IF (NSLAVES.EQ.1) THEN + MAX_DEPTH = 1 + ELSE + MAX_DEPTH = int( log( dble( NSLAVES - 1 ) ) + & / log(2.0D0) ) + ENDIF + ENDIF + ALLOCATE(IPOOL(NSTEPS+1), stat=allocok) + IF (allocok.GT.0) THEN + INFO1= -7 + INFO2= NSTEPS+1 + RETURN + ENDIF + NROOT = 0 + DO INODE = 1, N + IF ( FRERE(INODE) .eq. 0 ) THEN + NROOT = NROOT + 1 + IPOOL( NROOT ) = INODE + END IF + END DO + IBEG = 1 + IEND = NROOT + IIPOOL = NROOT + 1 + IF (SPLITROOT) MAX_DEPTH=1 + DO DEPTH = 1, MAX_DEPTH + DO I = IBEG, IEND + INODE = IPOOL( I ) + ISON = INODE + DO WHILE ( ISON .GT. 0 ) + ISON = FILS( ISON ) + END DO + ISON = - ISON + DO WHILE ( ISON .GT. 0 ) + IPOOL( IIPOOL ) = ISON + IIPOOL = IIPOOL + 1 + ISON = FRERE( ISON ) + END DO + END DO + IPOOL( IBEG ) = -IPOOL( IBEG ) + IBEG = IEND + 1 + IEND = IIPOOL - 1 + END DO + IPOOL( IBEG ) = -IPOOL( IBEG ) + TOT_CUT = 0 + IF (SPLITROOT) THEN + MAX_CUT = NROOT*max(K82,2) + INODE = abs(IPOOL(1)) + NFRONT = NFSIZ( INODE ) + K79 = max( + & int(NFRONT,8)*int(NFRONT,8)/(int(K82+1,8)*int(K82+1,8)), + & 1_8) + ELSE + MAX_CUT = 2 * NSLAVES + IF (KEEP(210).EQ.1) THEN + MAX_CUT = 4 * (MAX_CUT + 4) + ENDIF + ENDIF + DEPTH = -1 + DO I = 1, IIPOOL - 1 + INODE = IPOOL( I ) + IF ( INODE .LT. 0 ) THEN + INODE = -INODE + DEPTH = DEPTH + 1 + END IF + CALL DMUMPS_313 + & ( INODE, N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, + & KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, + & K79, SPLITROOT, MP, LDIAG ) + IF ( TOT_CUT > MAX_CUT ) EXIT + END DO + KEEP(61) = TOT_CUT + DEALLOCATE(IPOOL) + RETURN + END SUBROUTINE DMUMPS_97 + RECURSIVE SUBROUTINE DMUMPS_313 + & ( INODE, N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, KEEP,KEEP8, + & TOT_CUT, STRAT, DEPTH, K79, SPLITROOT, MP, LDIAG ) + IMPLICIT NONE + INTEGER(8) :: K79 + INTEGER INODE, N, NSTEPS, NSLAVES, KEEP(500), STRAT, + & DEPTH, TOT_CUT, MP, LDIAG + INTEGER(8) KEEP8(150) + INTEGER FRERE( N ), FILS( N ), NFSIZ( N ) + LOGICAL SPLITROOT + INTEGER I, IN, NPIV, NFRONT, NSLAVES_ESTIM + DOUBLE PRECISION WK_SLAVE, WK_MASTER + INTEGER INODE_SON, INODE_FATH, IN_SON, IN_FATH, IN_GRANDFATH + INTEGER NPIV_SON, NPIV_FATH + INTEGER NCB, NSLAVESMIN, NSLAVESMAX + INTEGER MUMPS_50, + & MUMPS_52 + EXTERNAL MUMPS_50, + & MUMPS_52 + IF ( (KEEP(210).EQ.1.AND.KEEP(60).EQ.0) .OR. + & (SPLITROOT) ) THEN + IF ( FRERE ( INODE ) .eq. 0 ) THEN + NFRONT = NFSIZ( INODE ) + NPIV = NFRONT + NCB = 0 + IF (int(NFRONT,8)*int(NFRONT,8).GT.K79) THEN + GOTO 333 + ENDIF + ENDIF + ENDIF + IF ( FRERE ( INODE ) .eq. 0 ) RETURN + NFRONT = NFSIZ( INODE ) + IN = INODE + NPIV = 0 + DO WHILE( IN > 0 ) + IN = FILS( IN ) + NPIV = NPIV + 1 + END DO + NCB = NFRONT - NPIV + IF ( (NFRONT - (NPIV/2)) .LE. KEEP(9)) RETURN + IF ((KEEP(50) == 0.and.int(NFRONT,8) * int(NPIV,8) > K79 ) .OR. + &(KEEP(50) .NE.0.and.int(NPIV,8) * int(NPIV,8) > K79 )) GOTO 333 + IF (KEEP(210).EQ.1) THEN + NSLAVESMIN = 1 + NSLAVESMAX = 64 + NSLAVES_ESTIM = 32+NSLAVES + ELSE + NSLAVESMIN = MUMPS_50 + & ( NSLAVES, KEEP(48), KEEP8(21), KEEP(50), + & NFRONT, NCB) + NSLAVESMAX = MUMPS_52 + & ( NSLAVES, KEEP(48), KEEP8(21), KEEP(50), + & NFRONT, NCB) + NSLAVES_ESTIM = max (1, + & nint( dble(NSLAVESMAX-NSLAVESMIN)/dble(3) ) + & ) + NSLAVES_ESTIM = min (NSLAVES_ESTIM, NSLAVES-1) + ENDIF + IF ( KEEP(50) .eq. 0 ) THEN + WK_MASTER = 0.6667D0 * + & dble(NPIV)*dble(NPIV)*dble(NPIV) + + & dble(NPIV)*dble(NPIV)*dble(NCB) + WK_SLAVE = dble( NPIV ) * dble( NCB ) * + & ( 2.0D0 * dble(NFRONT) - dble(NPIV) ) + & / dble(NSLAVES_ESTIM) + ELSE + WK_MASTER = dble(NPIV)*dble(NPIV)*dble(NPIV) / dble(3) + WK_SLAVE = + & (dble(NPIV)*dble(NCB)*dble(NFRONT)) + & / dble(NSLAVES_ESTIM) + ENDIF + IF (KEEP(210).EQ.1) THEN + IF ( dble( 100 + STRAT ) + & * WK_SLAVE / dble(100) .GE. WK_MASTER ) RETURN + ELSE + IF ( dble( 100 + STRAT * max( DEPTH-1, 1 ) ) + & * WK_SLAVE / dble(100) .GE. WK_MASTER ) RETURN + ENDIF + 333 CONTINUE + IF (NPIV .LE. 1 ) RETURN + NSTEPS = NSTEPS + 1 + TOT_CUT = TOT_CUT + 1 + NPIV_SON = max(NPIV/2,1) + NPIV_FATH = NPIV - NPIV_SON + INODE_SON = INODE + IN_SON = INODE + DO I = 1, NPIV_SON - 1 + IN_SON = FILS( IN_SON ) + END DO + INODE_FATH = FILS( IN_SON ) + IF ( INODE_FATH .LT. 0 ) THEN + write(*,*) 'Error: INODE_FATH < 0 ', INODE_FATH + END IF + IN_FATH = INODE_FATH + DO WHILE ( FILS( IN_FATH ) > 0 ) + IN_FATH = FILS( IN_FATH ) + END DO + FRERE( INODE_FATH ) = FRERE( INODE_SON ) + FRERE( INODE_SON ) = - INODE_FATH + FILS ( IN_SON ) = FILS( IN_FATH ) + FILS ( IN_FATH ) = - INODE_SON + IN = FRERE( INODE_FATH ) + DO WHILE ( IN > 0 ) + IN = FRERE( IN ) + END DO + IF ( IN .eq. 0 ) GO TO 10 + IN = -IN + DO WHILE ( FILS( IN ) > 0 ) + IN = FILS( IN ) + END DO + IN_GRANDFATH = IN + IF ( FILS( IN_GRANDFATH ) .eq. - INODE_SON ) THEN + FILS( IN_GRANDFATH ) = -INODE_FATH + ELSE + IN = IN_GRANDFATH + IN = - FILS ( IN ) + DO WHILE ( FRERE( IN ) > 0 ) + IF ( FRERE( IN ) .eq. INODE_SON ) THEN + FRERE( IN ) = INODE_FATH + GOTO 10 + END IF + IN = FRERE( IN ) + END DO + WRITE(*,*) 'ERROR 2 in SPLIT NODE', + & IN_GRANDFATH, IN, FRERE(IN) + END IF + 10 CONTINUE + NFSIZ(INODE_SON) = NFRONT + NFSIZ(INODE_FATH) = NFRONT - NPIV_SON + KEEP(2) = max( KEEP(2), NFRONT - NPIV_SON ) + CALL DMUMPS_313 + & ( INODE_FATH, N, FRERE, FILS, NFSIZ, NSTEPS, + & NSLAVES, KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, + & K79, SPLITROOT, MP, LDIAG ) + IF (.NOT. SPLITROOT) THEN + CALL DMUMPS_313 + & ( INODE_SON, N, FRERE, FILS, NFSIZ, NSTEPS, + & NSLAVES, KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, + & K79, SPLITROOT, MP, LDIAG ) + ENDIF + RETURN + END SUBROUTINE DMUMPS_313 + SUBROUTINE DMUMPS_351 + & (N,NZ, IRN, ICN, IW, LW, IPE, LEN, + & IQ, FLAG, IWFR, + & NRORM, NIORM, IFLAG,IERROR, ICNTL, + & symmetry, SYM, MedDens, NBQD, AvgDens) + INTEGER N,NZ,LW,IFLAG,IERROR,NRORM,NIORM,IWFR + INTEGER symmetry, SYM + INTEGER MedDens, NBQD, AvgDens + INTEGER ICNTL(40) + INTEGER IRN(NZ), ICN(NZ) + INTEGER LEN(N) + INTEGER IPE(N+1) + INTEGER FLAG(N), IW(LW) + INTEGER IQ(N) + INTEGER MP, MPG + INTEGER I,K,J,N1,LAST,NDUP,K1,K2,L + INTEGER NBERR, THRESH + INTEGER NZOFFA, NDIAGA + DOUBLE PRECISION RSYM + INTRINSIC nint + MP = ICNTL(2) + MPG= ICNTL(3) + NIORM = 3*N + NDIAGA = 0 + IERROR = 0 + DO 10 I=1,N + IPE(I) = 0 + 10 CONTINUE + DO 50 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + IERROR = IERROR + 1 + ELSE + IF (I.NE.J) THEN + IPE(I) = IPE(I) + 1 + IPE(J) = IPE(J) + 1 + NIORM = NIORM + 1 + ELSE + NDIAGA = NDIAGA + 1 + ENDIF + ENDIF + 50 CONTINUE + NZOFFA = NIORM - 3*N + IF (IERROR.GE.1) THEN + NBERR = 0 + IF (mod(IFLAG,2) .EQ. 0) IFLAG = IFLAG+1 + IF ((MP.GT.0).AND.(ICNTL(4).GE.2)) THEN + WRITE (MP,99999) + DO 70 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + NBERR = NBERR + 1 + IF (NBERR.LE.10) THEN + IF (mod(K,10).GT.3 .OR. mod(K,10).EQ.0 .OR. + & (10.LE.K .AND. K.LE.20)) THEN + WRITE (MP,'(I8,A,I8,A,I8,A)') + & K,'th entry (in row',I,' and column',J,') ignored' + ELSE + IF (mod(K,10).EQ.1) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'st entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.2) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'nd entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.3) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'rd entry (in row',I,' and column',J,') ignored' + ENDIF + ELSE + GO TO 100 + ENDIF + ENDIF + 70 CONTINUE + ENDIF + ENDIF + 100 NRORM = NIORM - 2*N + IQ(1) = 1 + N1 = N - 1 + IF (N1.GT.0) THEN + DO 110 I=1,N1 + IQ(I+1) = IPE(I) + IQ(I) + 110 CONTINUE + ENDIF + LAST = max(IPE(N)+IQ(N)-1,IQ(N)) + FLAG(1:N) = 0 + IPE(1:N) = IQ(1:N) + IW(1:LAST) = 0 + IWFR = LAST + 1 + DO 200 K=1,NZ + I = IRN(K) + J = ICN(K) + IF (I.NE.J) THEN + IF (I.LT.J) THEN + IF ((I.GE.1).AND.(J.LE.N)) THEN + IW(IQ(I)) = -J + IQ(I) = IQ(I) + 1 + ENDIF + ELSE + IF ((J.GE.1).AND.(I.LE.N)) THEN + IW(IQ(J)) = -I + IQ(J) = IQ(J) + 1 + ENDIF + ENDIF + ENDIF + 200 CONTINUE + NDUP = 0 + DO 260 I=1,N + K1 = IPE(I) + K2 = IQ(I) -1 + IF (K1.GT.K2) THEN + LEN(I) = 0 + IQ(I) = 0 + ELSE + DO 240 K=K1,K2 + J = -IW(K) + IF (J.LE.0) GO TO 250 + L = IQ(J) + IQ(J) = L + 1 + IF (FLAG(J).EQ.I) THEN + NDUP = NDUP + 1 + IW(L) = 0 + IW(K) = 0 + ELSE + IW(L) = I + IW(K) = J + FLAG(J) = I + ENDIF + 240 CONTINUE + 250 IQ(I) = IQ(I) - IPE(I) + IF (NDUP.EQ.0) LEN(I) = IQ(I) + ENDIF + 260 CONTINUE + IF (NDUP.NE.0) THEN + IWFR = 1 + DO 280 I=1,N + IF (IQ(I).EQ.0) THEN + LEN(I) = 0 + IPE(I) = IWFR + GOTO 280 + ENDIF + K1 = IPE(I) + K2 = K1 + IQ(I) - 1 + L = IWFR + IPE(I) = IWFR + DO 270 K=K1,K2 + IF (IW(K).NE.0) THEN + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + ENDIF + 270 CONTINUE + LEN(I) = IWFR - L + 280 CONTINUE + ENDIF + IPE(N+1) = IPE(N) + LEN(N) + IWFR = IPE(N+1) + IF (SYM.EQ.0) THEN + RSYM = dble(NDIAGA+2*NZOFFA - (IWFR-1))/ + & dble(NZOFFA+NDIAGA) + symmetry = nint (100.0D0*RSYM) + IF (MPG .GT. 0) + & write(MPG,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + ELSE + symmetry = 100 + ENDIF + AvgDens = nint(dble(IWFR-1)/dble(N)) + THRESH = AvgDens*50 - AvgDens/10 + 1 + NBQD = 0 + IF (N.GT.2) THEN + IQ(1:N) = 0 + DO I= 1, N + K = max(LEN(I),1) + IQ(K) = IQ(K) + 1 + IF (K.GT.THRESH) NBQD = NBQD+1 + ENDDO + K = 0 + MedDens = 0 + DO WHILE (K .LT. (N/2)) + MedDens = MedDens + 1 + K = K+IQ(MedDens) + ENDDO + ELSE + MedDens = AvgDens + ENDIF + IF (MPG .GT. 0) + & write(MPG,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + RETURN +99999 FORMAT (/'*** Warning message from analysis routine ***') + END SUBROUTINE DMUMPS_351 + SUBROUTINE DMUMPS_701(N, SYM, NPROCS, IORD, + & symmetry,MedDens, NBQD, AvgDens, + & PROK, MP) + IMPLICIT NONE + INTEGER, intent(in) :: N, NPROCS, SYM + INTEGER, intent(in) :: symmetry,MedDens, NBQD, AvgDens, MP + LOGICAL, intent(in) :: PROK + INTEGER, intent(inout) :: IORD + INTEGER MAXQD + PARAMETER (MAXQD=2) + INTEGER SMALLSYM, SMALLUNS + PARAMETER (SMALLUNS=5000, SMALLSYM=10000) +#if ! defined(metis) && ! defined(parmetis) + IF ( IORD .EQ. 5 ) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: METIS not available. Ordering set to default.' + IORD = 7 + END IF +#endif +#if ! defined(pord) + IF ( IORD .EQ. 4 ) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: PORD not available. Ordering set to default.' + IORD = 7 + END IF +#endif +#if ! defined(scotch) && ! defined(ptscotch) + IF ( IORD .EQ. 3 ) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: SCOTCH not available. Ordering set to default.' + IORD = 7 + END IF +#endif + IF (IORD.EQ.7) THEN + IF (SYM.NE.0) THEN + IF ( N.LE.SMALLSYM ) THEN + IF (NBQD.GE.MAXQD) THEN + IORD = 6 + ELSE + IORD = 0 + ENDIF + ELSE + IF (NBQD.GE.MedDens*NPROCS) THEN + IORD = 6 + RETURN + ENDIF +#if defined(metis) || defined(parmetis) + IORD = 5 +#else +# if defined(scotch) || defined(ptscotch) + IORD = 3 +# else +# if defined(pord) + IORD = 4 +# else + IORD = 6 +# endif +# endif +#endif + ENDIF + ELSE + IF ( N.LE.SMALLUNS ) THEN + IF (NBQD.GE.MAXQD) THEN + IORD = 6 + ELSE + IORD = 0 + ENDIF + ELSE + IF (NBQD.GE.MedDens*NPROCS) THEN + IORD = 6 + RETURN + ENDIF +#if defined(metis) || defined(parmetis) + IORD = 5 +#else +# if defined(scotch) || defined(ptscotch) + IORD = 3 +# else +# if defined(pord) + IORD = 4 +# else + IORD = 6 +# endif +# endif +#endif + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_701 + SUBROUTINE DMUMPS_510 + & (KEEP821, KEEP2, KEEP48 ,KEEP50, NSLAVES) + IMPLICIT NONE + INTEGER NSLAVES, KEEP2, KEEP48, KEEP50 + INTEGER (8) :: KEEP821 + INTEGER(8) KEEP2_SQUARE, NSLAVES8 + NSLAVES8= int(NSLAVES,8) + KEEP2_SQUARE = int(KEEP2,8) * int(KEEP2,8) + KEEP821 = max(KEEP821*int(KEEP2,8),1_8) +#if defined(t3e) + KEEP821 = min(1500000_8, KEEP821) +#elif defined(SP_) + KEEP821 = min(3000000_8, KEEP821) +#else + KEEP821 = min(2000000_8, KEEP821) +#endif +#if defined(t3e) + IF (NSLAVES .GT. 64) THEN + KEEP821 = + & min(8_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ELSE + KEEP821 = + & min(4_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ENDIF +#else + IF (NSLAVES.GT.64) THEN + KEEP821 = + & min(6_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ELSE + KEEP821 = + & min(4_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ENDIF +#endif + IF (KEEP50 .EQ. 0 ) THEN + KEEP821 = max(KEEP821,(7_8*KEEP2_SQUARE / + & 4_8 / int(max(NSLAVES-1,1),8)) + int(KEEP2,8)) + ELSE + KEEP821 = max(KEEP821,(7_8*KEEP2_SQUARE / + & 4_8 / int(max(NSLAVES-1,1),8)) + int(KEEP2,8)) + ENDIF + IF (KEEP50 .EQ. 0 ) THEN +#if defined(t3e) + KEEP821 = max(KEEP821,200000_8) +#else + KEEP821 = max(KEEP821,300000_8) +#endif + ELSE +#if defined(t3e) + KEEP821 = max(KEEP821,40000_8) +#else + KEEP821 = max(KEEP821,80000_8) +#endif + ENDIF + KEEP821 = -KEEP821 + RETURN + END SUBROUTINE DMUMPS_510 + SUBROUTINE DMUMPS_559(JOB,M,N,NE, + & IP,IRN,A,LA,NUM,PERM,LIW,IW,LDW,DW, + & ICNTL,CNTL,INFO) + IMPLICIT NONE + INTEGER NICNTL, NCNTL, NINFO + PARAMETER (NICNTL=10, NCNTL=10, NINFO=10) + INTEGER JOB,M,N,NE,NUM,LIW,LDW + INTEGER IP(N+1),IRN(NE),PERM(M),IW(LIW) + INTEGER ICNTL(NICNTL),INFO(NINFO) + INTEGER LA + DOUBLE PRECISION A(LA) + DOUBLE PRECISION DW(LDW),CNTL(NCNTL) + INTEGER I,J,K,WARN1,WARN2,WARN4 + DOUBLE PRECISION FACT,ZERO,ONE,RINF,RINF2,RINF3 + PARAMETER (ZERO=0.0D+00,ONE=1.0D+0) + EXTERNAL DMUMPS_457,DMUMPS_444,DMUMPS_451, + & DMUMPS_452,DMUMPS_454 + INTRINSIC abs,log + RINF = CNTL(2) + RINF2 = huge(RINF2)/dble(2*N) + RINF3 = 0.0D0 + WARN1 = 0 + WARN2 = 0 + WARN4 = 0 + IF (JOB.LT.1 .OR. JOB.GT.6) THEN + INFO(1) = -1 + INFO(2) = JOB + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'JOB',JOB + GO TO 99 + ENDIF + IF (M.LT.1 .OR. M.LT.N) THEN + INFO(1) = -2 + INFO(2) = M + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'M',M + GO TO 99 + ENDIF + IF (N.LT.1) THEN + INFO(1) = -2 + INFO(2) = N + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'N',N + GO TO 99 + ENDIF + IF (NE.LT.1) THEN + INFO(1) = -3 + INFO(2) = NE + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'NE',NE + GO TO 99 + ENDIF + IF (JOB.EQ.1) K = 4*N + M + IF (JOB.EQ.2) K = 2*N + 2*M + IF (JOB.EQ.3) K = 8*N + 2*M + NE + IF (JOB.EQ.4) K = 3*N + 2*M + IF (JOB.EQ.5) K = 3*N + 2*M + IF (JOB.EQ.6) K = 3*N + 2*M + NE + IF (LIW.LT.K) THEN + INFO(1) = -4 + INFO(2) = K + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9004) INFO(1),K + GO TO 99 + ENDIF + IF (JOB.GT.1) THEN + IF (JOB.EQ.2) K = M + IF (JOB.EQ.3) K = 1 + IF (JOB.EQ.4) K = 2*M + IF (JOB.EQ.5) K = N + 2*M + IF (JOB.EQ.6) K = N + 3*M + IF (LDW.LT.K) THEN + INFO(1) = -5 + INFO(2) = K + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9005) INFO(1),K + GO TO 99 + ENDIF + ENDIF + IF (ICNTL(5).EQ.0) THEN + DO 3 I = 1,M + IW(I) = 0 + 3 CONTINUE + DO 6 J = 1,N + DO 4 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (I.LT.1 .OR. I.GT.M) THEN + INFO(1) = -6 + INFO(2) = J + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9006) INFO(1),J,I + GO TO 99 + ENDIF + IF (IW(I).EQ.J) THEN + INFO(1) = -7 + INFO(2) = J + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9007) INFO(1),J,I + GO TO 99 + ELSE + IW(I) = J + ENDIF + 4 CONTINUE + 6 CONTINUE + ENDIF + IF (ICNTL(3).GE.0) THEN + IF (ICNTL(4).EQ.0 .OR. ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9020) JOB,M,N,NE + IF (ICNTL(4).EQ.0) THEN + WRITE(ICNTL(3),9021) (IP(J),J=1,min(10,N+1)) + WRITE(ICNTL(3),9022) (IRN(J),J=1,min(10,NE)) + IF (JOB.GT.1) WRITE(ICNTL(3),9023) (A(J),J=1,min(10,NE)) + ELSEIF (ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9021) (IP(J),J=1,N+1) + WRITE(ICNTL(3),9022) (IRN(J),J=1,NE) + IF (JOB.GT.1) WRITE(ICNTL(3),9023) (A(J),J=1,NE) + ENDIF + WRITE(ICNTL(3),9024) (ICNTL(J),J=1,NICNTL) + WRITE(ICNTL(3),9025) (CNTL(J),J=1,NCNTL) + ENDIF + ENDIF + DO 8 I=1,NINFO + INFO(I) = 0 + 8 CONTINUE + IF (JOB.EQ.1) THEN + DO 10 J = 1,N + IW(J) = IP(J+1) - IP(J) + 10 CONTINUE + CALL DMUMPS_457(M,N,IRN,NE,IP,IW(1),PERM,NUM, + & IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1)) + GO TO 90 + ENDIF + IF (JOB.EQ.2) THEN + DW(1) = max(ZERO,CNTL(1)) + CALL DMUMPS_444(M,N,NE,IP,IRN,A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(2*N+M+1),DW,RINF2) + GO TO 90 + ENDIF + IF (JOB.EQ.3) THEN + DO 20 K = 1,NE + IW(K) = IRN(K) + 20 CONTINUE + CALL DMUMPS_451(N,NE,IP,IW,A) + FACT = max(ZERO,CNTL(1)) + CALL DMUMPS_452(M,N,NE,IP,IW(1),A,PERM,NUM,IW(NE+1), + & IW(NE+N+1),IW(NE+2*N+1),IW(NE+3*N+1),IW(NE+4*N+1), + & IW(NE+5*N+1),IW(NE+5*N+M+1),FACT,RINF2) + GO TO 90 + ENDIF + IF (JOB.EQ.4) THEN + DO 50 J = 1,N + FACT = ZERO + DO 30 K = IP(J),IP(J+1)-1 + IF (abs(A(K)).GT.FACT) FACT = abs(A(K)) + 30 CONTINUE + IF(FACT .GT. RINF3) RINF3 = FACT + DO 40 K = IP(J),IP(J+1)-1 + A(K) = FACT - abs(A(K)) + 40 CONTINUE + 50 CONTINUE + DW(1) = max(ZERO,CNTL(1)) + DW(2) = RINF3 + IW(1) = JOB + CALL DMUMPS_454(M,N,NE,IP,IRN,A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1), + & DW(1),DW(M+1),RINF2) + GO TO 90 + ENDIF + IF (JOB.EQ.5 .or. JOB.EQ.6) THEN + RINF3=ONE + IF (JOB.EQ.5) THEN + DO 75 J = 1,N + FACT = ZERO + DO 60 K = IP(J),IP(J+1)-1 + IF (A(K).GT.FACT) FACT = A(K) + 60 CONTINUE + DW(2*M+J) = FACT + IF (FACT.NE.ZERO) THEN + FACT = log(FACT) + IF(FACT .GT. RINF3) RINF3=FACT + DO 70 K = IP(J),IP(J+1)-1 + IF (A(K).NE.ZERO) THEN + A(K) = FACT - log(A(K)) + IF(A(K) .GT. RINF3) RINF3=A(K) + ELSE + A(K) = FACT + RINF + ENDIF + 70 CONTINUE + ELSE + DO 71 K = IP(J),IP(J+1)-1 + A(K) = ONE + 71 CONTINUE + ENDIF + 75 CONTINUE + ENDIF + IF (JOB.EQ.6) THEN + DO 175 K = 1,NE + IW(3*N+2*M+K) = IRN(K) + 175 CONTINUE + DO 61 I = 1,M + DW(2*M+N+I) = ZERO + 61 CONTINUE + DO 63 J = 1,N + DO 62 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (A(K).GT.DW(2*M+N+I)) THEN + DW(2*M+N+I) = A(K) + ENDIF + 62 CONTINUE + 63 CONTINUE + DO 64 I = 1,M + IF (DW(2*M+N+I).NE.ZERO) THEN + DW(2*M+N+I) = 1.0D0/DW(2*M+N+I) + ENDIF + 64 CONTINUE + DO 66 J = 1,N + DO 65 K = IP(J),IP(J+1)-1 + I = IRN(K) + A(K) = DW(2*M+N+I) * A(K) + 65 CONTINUE + 66 CONTINUE + CALL DMUMPS_451(N,NE,IP,IW(3*N+2*M+1),A) + DO 176 J = 1,N + IF (IP(J).NE.IP(J+1)) THEN + FACT = A(IP(J)) + ELSE + FACT = ZERO + ENDIF + DW(2*M+J) = FACT + IF (FACT.NE.ZERO) THEN + FACT = log(FACT) + DO 170 K = IP(J),IP(J+1)-1 + IF (A(K).NE.ZERO) THEN + A(K) = FACT - log(A(K)) + IF(A(K) .GT. RINF3) RINF3=A(K) + ELSE + A(K) = FACT + RINF + ENDIF + 170 CONTINUE + ELSE + DO 171 K = IP(J),IP(J+1)-1 + A(K) = ONE + 171 CONTINUE + ENDIF + 176 CONTINUE + ENDIF + DW(1) = max(ZERO,CNTL(1)) + RINF3 = RINF3+ONE + DW(2) = RINF3 + IW(1) = JOB + IF (JOB.EQ.5) THEN + CALL DMUMPS_454(M,N,NE,IP,IRN,A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1), + & DW(1),DW(M+1),RINF2) + ENDIF + IF (JOB.EQ.6) THEN + CALL DMUMPS_454(M,N,NE,IP,IW(3*N+2*M+1),A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1), + & DW(1),DW(M+1),RINF2) + ENDIF + IF (JOB.EQ.6) THEN + DO 79 I = 1,M + IF (DW(2*M+N+I).NE.0.0D0) THEN + DW(I) = DW(I) + log(DW(2*M+N+I)) + ENDIF + 79 CONTINUE + ENDIF + IF (NUM.EQ.N) THEN + DO 80 J = 1,N + IF (DW(2*M+J).NE.ZERO) THEN + DW(M+J) = DW(M+J) - log(DW(2*M+J)) + ELSE + DW(M+J) = ZERO + ENDIF + 80 CONTINUE + ENDIF + FACT = 0.5D0*log(RINF2) + DO 86 I = 1,M + IF (DW(I).LT.FACT) GO TO 86 + WARN2 = 2 + GO TO 90 + 86 CONTINUE + DO 87 J = 1,N + IF (DW(M+J).LT.FACT) GO TO 87 + WARN2 = 2 + GO TO 90 + 87 CONTINUE + ENDIF + 90 IF (NUM.LT.N) WARN1 = 1 + IF (JOB.EQ.4 .OR. JOB.EQ.5 .OR. JOB.EQ.6) THEN + IF (CNTL(1).LT.ZERO) WARN4 = 4 + ENDIF + IF (INFO(1).EQ.0) THEN + INFO(1) = WARN1 + WARN2 + WARN4 + IF (INFO(1).GT.0 .AND. ICNTL(2).GT.0) THEN + WRITE(ICNTL(2),9010) INFO(1) + IF (WARN1.EQ.1) WRITE(ICNTL(2),9011) + IF (WARN2.EQ.2) WRITE(ICNTL(2),9012) + IF (WARN4.EQ.4) WRITE(ICNTL(2),9014) + ENDIF + ENDIF + IF (ICNTL(3).GE.0) THEN + IF (ICNTL(4).EQ.0 .OR. ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9030) (INFO(J),J=1,2) + WRITE(ICNTL(3),9031) NUM + IF (ICNTL(4).EQ.0) THEN + WRITE(ICNTL(3),9032) (PERM(J),J=1,min(10,M)) + IF (JOB.EQ.5 .OR. JOB.EQ.6) THEN + WRITE(ICNTL(3),9033) (DW(J),J=1,min(10,M)) + WRITE(ICNTL(3),9034) (DW(M+J),J=1,min(10,N)) + ENDIF + ELSEIF (ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9032) (PERM(J),J=1,M) + IF (JOB.EQ.5 .OR. JOB.EQ.6) THEN + WRITE(ICNTL(3),9033) (DW(J),J=1,M) + WRITE(ICNTL(3),9034) (DW(M+J),J=1,N) + ENDIF + ENDIF + ENDIF + ENDIF + 99 RETURN + 9001 FORMAT (' ****** Error in DMUMPS_443. INFO(1) = ',I2, + & ' because ',(A),' = ',I10) + 9004 FORMAT (' ****** Error in DMUMPS_443. INFO(1) = ',I2/ + & ' LIW too small, must be at least ',I8) + 9005 FORMAT (' ****** Error in DMUMPS_443. INFO(1) = ',I2/ + & ' LDW too small, must be at least ',I8) + 9006 FORMAT (' ****** Error in DMUMPS_443. INFO(1) = ',I2/ + & ' Column ',I8, + & ' contains an entry with invalid row index ',I8) + 9007 FORMAT (' ****** Error in DMUMPS_443. INFO(1) = ',I2/ + & ' Column ',I8, + & ' contains two or more entries with row index ',I8) + 9010 FORMAT (' ****** Warning from DMUMPS_443. INFO(1) = ',I2) + 9011 FORMAT (' - The matrix is structurally singular.') + 9012 FORMAT (' - Some scaling factors may be too large.') + 9014 FORMAT (' - CNTL(1) is negative and was treated as zero.') + 9020 FORMAT (' ****** Input parameters for DMUMPS_443:'/ + & ' JOB =',I10/' M =',I10/' N =',I10/' NE =',I10) + 9021 FORMAT (' IP(1:N+1) = ',8I8/(15X,8I8)) + 9022 FORMAT (' IRN(1:NE) = ',8I8/(15X,8I8)) + 9023 FORMAT (' A(1:NE) = ',4(1PD14.4)/(15X,4(1PD14.4))) + 9024 FORMAT (' ICNTL(1:10) = ',8I8/(15X,2I8)) + 9025 FORMAT (' CNTL(1:10) = ',4(1PD14.4)/(15X,4(1PD14.4))) + 9030 FORMAT (' ****** Output parameters for DMUMPS_443:'/ + & ' INFO(1:2) = ',2I8) + 9031 FORMAT (' NUM = ',I8) + 9032 FORMAT (' PERM(1:M) = ',8I8/(15X,8I8)) + 9033 FORMAT (' DW(1:M) = ',5(F11.3)/(15X,5(F11.3))) + 9034 FORMAT (' DW(M+1:M+N) = ',5(F11.3)/(15X,5(F11.3))) + END SUBROUTINE DMUMPS_559 + SUBROUTINE DMUMPS_563(N,NZ,IP,IRN,A,FLAG,POSI) + IMPLICIT NONE + INTEGER N,NZ + INTEGER IP(N+1),IRN(NZ) + DOUBLE PRECISION A(NZ) + INTEGER WR_POS,BEG_COL,ROW,COL,K,SV_POS + INTEGER FLAG(N), POSI(N) + FLAG = 0 + WR_POS = 1 + DO COL=1,N + BEG_COL = WR_POS + DO K=IP(COL),IP(COL+1)-1 + ROW = IRN(K) + IF(FLAG(ROW) .NE. COL) THEN + IRN(WR_POS) = ROW + A(WR_POS) = A(K) + FLAG(ROW) = COL + POSI(ROW) = WR_POS + WR_POS = WR_POS+1 + ELSE + SV_POS = POSI(ROW) + A(SV_POS) = A(SV_POS) + A(K) + ENDIF + ENDDO + IP(COL) = BEG_COL + ENDDO + IP(N+1) = WR_POS + NZ = WR_POS-1 + RETURN + END SUBROUTINE DMUMPS_563 + SUBROUTINE DMUMPS_562(N,NZ,IP,IRN,FLAG,POSI) + IMPLICIT NONE + INTEGER N,NZ + INTEGER IP(N+1),IRN(NZ) + INTEGER WR_POS,BEG_COL,ROW,COL,K + INTEGER FLAG(N), POSI(N) + FLAG = 0 + WR_POS = 1 + DO COL=1,N + BEG_COL = WR_POS + DO K=IP(COL),IP(COL+1)-1 + ROW = IRN(K) + IF(FLAG(ROW) .NE. COL) THEN + IRN(WR_POS) = ROW + FLAG(ROW) = COL + POSI(ROW) = WR_POS + WR_POS = WR_POS+1 + ENDIF + ENDDO + IP(COL) = BEG_COL + ENDDO + IP(N+1) = WR_POS + NZ = WR_POS-1 + RETURN + END SUBROUTINE DMUMPS_562 + SUBROUTINE DMUMPS_181( N, NA, LNA, NE_STEPS, + & PERM, FILS, + & DAD_STEPS, STEP, NSTEPS, INFO) + IMPLICIT NONE + INTEGER, INTENT(IN) :: N, NSTEPS, LNA + INTEGER, INTENT(IN) :: FILS( N ), STEP(N), NA(LNA) + INTEGER, INTENT(IN) :: DAD_STEPS ( NSTEPS ), NE_STEPS (NSTEPS) + INTEGER, INTENT(INOUT) :: INFO(40) + INTEGER, INTENT(OUT) :: PERM( N ) + INTEGER :: IPERM, INODE, IN + INTEGER :: INBLEAF, INBROOT, allocok + INTEGER, ALLOCATABLE, DIMENSION (:) :: POOL, NSTK + INBLEAF = NA(1) + INBROOT = NA(2) + ALLOCATE(POOL(INBLEAF), NSTK(NSTEPS), stat=allocok) + IF (allocok > 0 ) THEN + INFO(1) = -7 + INFO(2) = INBLEAF + NSTEPS + RETURN + ENDIF + POOL(1:INBLEAF) = NA(3:2+INBLEAF) + NSTK(1:NSTEPS) = NE_STEPS(1:NSTEPS) + IPERM = 1 + DO WHILE ( INBLEAF .NE. 0 ) + INODE = POOL( INBLEAF ) + INBLEAF = INBLEAF - 1 + IN = INODE + DO WHILE ( IN .GT. 0 ) + PERM ( IN ) = IPERM + IPERM = IPERM + 1 + IN = FILS( IN ) + END DO + IN = DAD_STEPS(STEP( INODE )) + IF ( IN .eq. 0 ) THEN + INBROOT = INBROOT - 1 + ELSE + NSTK( STEP(IN) ) = NSTK( STEP(IN) ) - 1 + IF ( NSTK( STEP(IN) ) .eq. 0 ) THEN + INBLEAF = INBLEAF + 1 + POOL( INBLEAF ) = IN + END IF + END IF + END DO + DEALLOCATE(POOL, NSTK) + RETURN + END SUBROUTINE DMUMPS_181 + SUBROUTINE DMUMPS_746( ID, PTRAR ) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + include 'mpif.h' + TYPE(DMUMPS_STRUC), INTENT(IN), TARGET :: ID + INTEGER, TARGET :: PTRAR(ID%N,2) + INTEGER :: IERR + INTEGER :: IOLD, K, JOLD, INEW, JNEW, INZ + INTEGER, POINTER :: IIRN(:), IJCN(:), IWORK1(:), IWORK2(:) + LOGICAL :: IDO, PARANAL + PARANAL = .TRUE. + IF (PARANAL) THEN + IF(ID%KEEP(54) .EQ. 3) THEN + IIRN => ID%IRN_loc + IJCN => ID%JCN_loc + INZ = ID%NZ_loc + IWORK1 => PTRAR(1:ID%N,2) + allocate(IWORK2(ID%N)) + IDO = .TRUE. + ELSE + IIRN => ID%IRN + IJCN => ID%JCN + INZ = ID%NZ + IWORK1 => PTRAR(1:ID%N,1) + IWORK2 => PTRAR(1:ID%N,2) + IDO = ID%MYID .EQ. 0 + END IF + ELSE + IIRN => ID%IRN + IJCN => ID%JCN + INZ = ID%NZ + IWORK1 => PTRAR(1:ID%N,1) + IWORK2 => PTRAR(1:ID%N,2) + IDO = ID%MYID .EQ. 0 + END IF + DO 50 IOLD=1,ID%N + IWORK1(IOLD) = 0 + IWORK2(IOLD) = 0 + 50 CONTINUE + IF(IDO) THEN + DO 70 K=1,INZ + IOLD = IIRN(K) + JOLD = IJCN(K) + IF ( (IOLD.GT.ID%N).OR.(JOLD.GT.ID%N).OR.(IOLD.LT.1) + & .OR.(JOLD.LT.1) ) GOTO 70 + IF (IOLD.NE.JOLD) THEN + INEW = ID%SYM_PERM(IOLD) + JNEW = ID%SYM_PERM(JOLD) + IF ( ID%KEEP( 50 ) .EQ. 0 ) THEN + IF (INEW.LT.JNEW) THEN + IWORK2(IOLD) = IWORK2(IOLD) + 1 + ELSE + IWORK1(JOLD) = IWORK1(JOLD) + 1 + ENDIF + ELSE + IF ( INEW .LT. JNEW ) THEN + IWORK1( IOLD ) = IWORK1( IOLD ) + 1 + ELSE + IWORK1( JOLD ) = IWORK1( JOLD ) + 1 + END IF + ENDIF + ENDIF + 70 CONTINUE + END IF + IF(PARANAL .AND. (ID%KEEP(54) .EQ. 3) ) THEN + CALL MPI_ALLREDUCE(IWORK1(1), PTRAR(1,1), ID%N, MPI_INTEGER, + & MPI_SUM, ID%COMM, IERR ) + CALL MPI_ALLREDUCE(IWORK2(1), PTRAR(1,2), ID%N, MPI_INTEGER, + & MPI_SUM, ID%COMM, IERR ) + deallocate(IWORK2) + ELSE + CALL MPI_BCAST( PTRAR, 2*ID%N, MPI_INTEGER, + & 0, ID%COMM, IERR ) + END IF + RETURN + END SUBROUTINE DMUMPS_746 + MODULE DMUMPS_PARALLEL_ANALYSIS + USE DMUMPS_STRUC_DEF + USE TOOLS_COMMON + INCLUDE 'mpif.h' + PUBLIC DMUMPS_715 + INTERFACE DMUMPS_715 + MODULE PROCEDURE DMUMPS_715 + END INTERFACE + PRIVATE + TYPE ORD_TYPE + INTEGER :: CBLKNBR, N + INTEGER, POINTER :: PERMTAB(:) => null() + INTEGER, POINTER :: PERITAB(:) => null() + INTEGER, POINTER :: RANGTAB(:) => null() + INTEGER, POINTER :: TREETAB(:) => null() + INTEGER, POINTER :: BROTHER(:) => null() + INTEGER, POINTER :: SON(:) => null() + INTEGER, POINTER :: NW(:) => null() + INTEGER, POINTER :: FIRST(:) => null() + INTEGER, POINTER :: LAST(:) => null() + INTEGER, POINTER :: TOPNODES(:) => null() + INTEGER :: COMM, COMM_NODES, NPROCS, NSLAVES, MYID + INTEGER :: TOPSTRAT, SUBSTRAT, ORDTOOL, TOPVARS + LOGICAL :: IDO + END TYPE ORD_TYPE + TYPE GRAPH_TYPE + INTEGER :: NZ_LOC, N, COMM + INTEGER, POINTER :: IRN_LOC(:) => null() + INTEGER, POINTER :: JCN_LOC(:) => null() + END TYPE GRAPH_TYPE + TYPE ARRPNT + INTEGER, POINTER :: BUF(:) => null() + END TYPE ARRPNT + INTEGER :: MEMCNT, MAXMEM, MP, MPG, LP, NRL, TOPROWS + LOGICAL :: PROK, PROKG + CONTAINS + SUBROUTINE DMUMPS_715(id, WORK1, WORK2, NFSIZ, FILS, + & FRERE) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(DMUMPS_STRUC) :: id + INTEGER, POINTER :: WORK1(:), WORK2(:), + & NFSIZ(:), FILS(:), FRERE(:) + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: IPE(:), NV(:), + & NE(:), NA(:), NODE(:), + & ND(:), SUBORD(:), NAMALG(:), + & IPS(:), CUMUL(:), + & SAVEIRN(:), SAVEJCN(:) + INTEGER :: MYID, NPROCS, IERR, NEMIN, LDIAG + LOGICAL :: SPLITROOT + INTEGER(8), PARAMETER :: K79REF=12000000_8 + nullify(IPE, NV, NE, NA, NODE, ND, SUBORD, NAMALG, IPS, + & CUMUL, SAVEIRN, SAVEJCN) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + LP = id%ICNTL(1) + MP = id%ICNTL(2) + MPG = id%ICNTL(3) + PROK = (MP.GT.0) + PROKG = (MPG.GT.0) .AND. (MYID .EQ. 0) + LDIAG = id%ICNTL(4) + ord%PERMTAB => WORK1(1 : id%N) + ord%PERITAB => WORK1(id%N+1 : 2*id%N) + ord%TREETAB => WORK1(2*id%N+1 : 3*id%N) + IF(id%KEEP(54) .NE. 3) THEN + IF(MYID.EQ.0) THEN + SAVEIRN => id%IRN_loc + SAVEJCN => id%JCN_loc + id%IRN_loc => id%IRN + id%JCN_loc => id%JCN + id%NZ_loc = id%NZ + ELSE + id%NZ_loc = 0 + END IF + END IF + MAXMEM=0 + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + MEMCNT = size(work1)+ size(work2) + + & size(nfsiz) + size(fils) + size(frere) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT entry:',MEMCNT,MAXMEM +#endif + CALL DMUMPS_716(id, ord) + id%INFOG(7) = id%KEEP(245) + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + CALL DMUMPS_717(id, ord, WORK2) + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + IF(id%MYID .EQ. 0) THEN + CALL MUMPS_733(IPE, id%N, id%INFO, LP, FORCE=.FALSE., + & COPY=.FALSE., STRING='', + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NV, id%N, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT ipe nv:',MEMCNT,MAXMEM +#endif + END IF + ord%SUBSTRAT = 0 + ord%TOPSTRAT = 0 + CALL DMUMPS_720(id, ord, IPE, NV, WORK2) + IF(id%KEEP(54) .NE. 3) THEN + IF(MYID.EQ.0) THEN + id%IRN_loc => SAVEIRN + id%JCN_loc => SAVEJCN + END IF + END IF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + NULLIFY(ord%PERMTAB) + NULLIFY(ord%PERITAB) + NULLIFY(ord%TREETAB) + CALL MUMPS_734(ord%FIRST, ord%LAST, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT firstlast:',MEMCNT,MAXMEM +#endif + IF (MYID .EQ. 0) THEN + IPS => WORK1(1:id%N) + NE => WORK1(id%N+1 : 2*id%N) + NA => WORK1(2*id%N+1 : 3*id%N) + NODE => WORK2(1 : id%N ) + ND => WORK2(id%N+1 : 2*id%N) + SUBORD => WORK2(2*id%N+1 : 3*id%N) + NAMALG => WORK2(3*id%N+1 : 4*id%N) + CALL MUMPS_733(CUMUL, id%N, id%INFO, LP, + & STRING='CUMUL', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT cumul:',MEMCNT,MAXMEM +#endif + NEMIN = id%KEEP(1) + CALL DMUMPS_557(id%N, IPE(1), NV(1), IPS(1), NE(1), + & NA(1), NFSIZ(1), NODE(1), id%INFOG(6), FILS(1), FRERE(1), + & ND(1), NEMIN, SUBORD(1), id%KEEP(60), id%KEEP(20), + & id%KEEP(38), NAMALG(1), id%KEEP(104), CUMUL(1), + & id%KEEP(50), id%ICNTL(13), id%KEEP(37), id%NSLAVES, + & id%KEEP(250).EQ.1) + CALL MUMPS_734(CUMUL, NV, IPE, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall cumul:',MEMCNT,MAXMEM +#endif + CALL DMUMPS_201(NE(1), ND(1), id%INFOG(6), id%INFOG(5), + & id%KEEP(2), id%KEEP(50), id%KEEP(101), id%KEEP(108), + & id%KEEP(5), id%KEEP(6), id%KEEP(226), id%KEEP(253)) + IF ( id%KEEP(53) .NE. 0 ) THEN + CALL MUMPS_209(id%N, FRERE(1), FILS(1), NFSIZ(1), + & id%KEEP(20)) + END IF + IF ( (id%KEEP(48) == 4 .AND. id%KEEP8(21).GT.0_8) + & .OR. + & (id%KEEP (48)==5 .AND. id%KEEP8(21) .GT. 0_8 ) + & .OR. + & (id%KEEP(24).NE.0.AND.id%KEEP8(21).GT.0_8) ) THEN + CALL DMUMPS_510(id%KEEP8(21), id%KEEP(2), + & id%KEEP(48), id%KEEP(50), id%NSLAVES) + END IF + IF ((id%KEEP(210).LT.0) .OR. (id%KEEP(210).GT.2)) + & id%KEEP(210)=0 + IF ((id%KEEP(210).EQ.0) .AND. (id%KEEP(201).GT.0)) + & id%KEEP(210)=1 + IF ((id%KEEP(210).EQ.0) .AND. (id%KEEP(201).EQ.0)) + & id%KEEP(210)=2 + IF (id%KEEP(210).EQ.2) id%KEEP8(79)=huge(id%KEEP8(79)) + IF ((id%KEEP(210).EQ.1) .AND. (id%KEEP8(79).LE.0_8)) THEN + IF ( huge(id%KEEP8(79)) / K79REF + 1_8 .GE. + & int(id%NSLAVES,8) ) THEN + id%KEEP8(79)=huge(id%KEEP8(79)) + ELSE + id%KEEP8(79)=K79REF * int(id%NSLAVES,8) + ENDIF + ENDIF + IF ( (id%KEEP(79).EQ.0).OR.(id%KEEP(79).EQ.2).OR. + & (id%KEEP(79).EQ.3).OR.(id%KEEP(79).EQ.5).OR. + & (id%KEEP(79).EQ.6) + & ) THEN + IF (id%KEEP(210).EQ.1) THEN + SPLITROOT = .FALSE. + IF ( id%KEEP(62).GE.1) THEN + CALL DMUMPS_97(id%N, FRERE(1), FILS(1), + & NFSIZ(1), id%INFOG(6), + & id%NSLAVES, id%KEEP(1), id%KEEP8(1), SPLITROOT, + & MP, LDIAG, id%INFOG(1), id%INFOG(2)) + IF (id%INFOG(1).LT.0) RETURN + ENDIF + ENDIF + ENDIF + SPLITROOT = (((id%ICNTL(13).GT.0) .AND. + & (id%NSLAVES.GT.id%ICNTL(13))) .OR. + & (id%ICNTL(13).EQ.-1)) .AND. (id%KEEP(60).EQ.0) + IF (SPLITROOT) THEN + CALL DMUMPS_97(id%N, FRERE(1), FILS(1), NFSIZ(1), + & id%INFOG(6), id%NSLAVES, id%KEEP(1), id%KEEP8(1), + & SPLITROOT, MP, LDIAG, id%INFOG(1), id%INFOG(2)) + IF (id%INFOG(1).LT.0) RETURN + ENDIF + END IF +#if defined (memprof) + write(mp,'(i2,a30,3(i8,5x))')myid,'MEMCNT exit:',MEMCNT,MAXMEM, + & estimem(myid, id%n, 2*id%nz/id%n) +#endif + RETURN + END SUBROUTINE DMUMPS_715 + SUBROUTINE DMUMPS_716(id, ord) + TYPE(DMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER :: IERR +#if defined(parmetis) + INTEGER :: I, COLOR, BASE + LOGICAL :: IDO +#endif + IF(id%MYID .EQ. 0) id%KEEP(245) = id%ICNTL(29) + CALL MPI_BCAST( id%KEEP(245), 1, + & MPI_INTEGER, 0, id%COMM, IERR ) + IF ((id%KEEP(245) .LT. 0) .OR. (id%KEEP(245) .GT. 2)) THEN + id%KEEP(245) = 0 + END IF + IF (id%KEEP(245) .EQ. 0) THEN +#if defined(ptscotch) + IF(id%NSLAVES .LT. 2) THEN + IF(PROKG) WRITE(MPG,'("Warning: older versions + &of PT-SCOTCH require at least 2 processors.")') + END IF + ord%ORDTOOL = 1 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%COMM = id%COMM + ord%COMM_NODES = id%COMM_NODES + ord%NPROCS = id%NPROCS + ord%NSLAVES = id%NSLAVES + ord%MYID = id%MYID + ord%IDO = (id%MYID .GE. 1) .OR. (id%KEEP(46) .EQ. 1) + IF(PROKG) WRITE(MPG, + & '("Parallel ordering tool set to PT-SCOTCH.")') + RETURN +#endif +#if defined(parmetis) + I=1 + DO + IF (I .GT. id%NSLAVES) EXIT + ord%NSLAVES = I + I = I*2 + END DO + BASE = id%NPROCS-id%NSLAVES + ord%NPROCS = ord%NSLAVES + BASE + IDO = (id%MYID .GE. BASE) .AND. + & (id%MYID .LE. BASE+ord%NSLAVES-1) + ord%IDO = IDO + IF ( IDO ) THEN + COLOR = 1 + ELSE + COLOR = MPI_UNDEFINED + END IF + CALL MPI_COMM_SPLIT( id%COMM, COLOR, 0, + & ord%COMM_NODES, IERR ) + ord%ORDTOOL = 2 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%MYID = id%MYID + IF(PROKG) WRITE(MPG, + & '("Parallel ordering tool set to ParMETIS.")') + RETURN +#endif + id%INFO(1) = -38 + id%INFOG(1) = -38 + IF(id%MYID .EQ.0 ) THEN + WRITE(LP, + & '("No parallel ordering tools available.")') + WRITE(LP, + & '("Please install PT-SCOTCH or ParMETIS.")') + END IF + RETURN + ELSE IF (id%KEEP(245) .EQ. 1) THEN +#if defined(ptscotch) + IF(id%NSLAVES .LT. 2) THEN + IF(PROKG) WRITE(MPG,'("Warning: older versions + &of PT-SCOTCH require at least 2 processors.")') + END IF + ord%ORDTOOL = 1 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%COMM = id%COMM + ord%COMM_NODES = id%COMM_NODES + ord%NPROCS = id%NPROCS + ord%NSLAVES = id%NSLAVES + ord%MYID = id%MYID + ord%IDO = (id%MYID .GE. 1) .OR. (id%KEEP(46) .EQ. 1) + IF(PROKG) WRITE(MPG, + & '("Using PT-SCOTCH for parallel ordering.")') + RETURN +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) WRITE(LP, + & '("PT-SCOTCH not available.")') + RETURN +#endif + ELSE IF (id%KEEP(245) .EQ. 2) THEN +#if defined(parmetis) + I=1 + DO + IF (I .GT. id%NSLAVES) EXIT + ord%NSLAVES = I + I = I*2 + END DO + BASE = id%NPROCS-id%NSLAVES + ord%NPROCS = ord%NSLAVES + BASE + IDO = (id%MYID .GE. BASE) .AND. + & (id%MYID .LE. BASE+ord%NSLAVES-1) + ord%IDO = IDO + IF ( IDO ) THEN + COLOR = 1 + ELSE + COLOR = MPI_UNDEFINED + END IF + CALL MPI_COMM_SPLIT( id%COMM, COLOR, 0, ord%COMM_NODES, + & IERR ) + ord%ORDTOOL = 2 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%MYID = id%MYID + IF(PROKG) WRITE(MPG, + & '("Using ParMETIS for parallel ordering.")') + RETURN +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) WRITE(LP, + & '("ParMETIS not available.")') + RETURN +#endif + END IF + END SUBROUTINE DMUMPS_716 + SUBROUTINE DMUMPS_717(id, ord, WORK) + IMPLICIT NONE + TYPE(DMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: WORK(:) +#ifdef parmetis + INTEGER :: IERR +#endif + IF (ord%ORDTOOL .EQ. 1) THEN +#ifdef ptscotch + CALL DMUMPS_719(id, ord, WORK) +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + WRITE(LP,*)'PT-SCOTCH not available. Aborting...' + CALL MUMPS_ABORT() +#endif + ELSE IF (ord%ORDTOOL .EQ. 2) THEN +#ifdef parmetis + CALL DMUMPS_718(id, ord, WORK) + if(ord%IDO) CALL MPI_COMM_FREE(ord%COMM_NODES, IERR) +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + WRITE(LP,*)'ParMETIS not available. Aborting...' + CALL MUMPS_ABORT() +#endif + END IF + RETURN + END SUBROUTINE DMUMPS_717 +#if defined(parmetis) + SUBROUTINE DMUMPS_718(id, ord, WORK) + IMPLICIT NONE + TYPE(DMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: WORK(:) + INTEGER :: I, MYID, NPROCS, IERR, BASE + INTEGER, POINTER :: FIRST(:), + & LAST(:), SWORK(:) + INTEGER :: BASEVAL, VERTLOCNBR, + & EDGELOCNBR, OPTIONS(10), NROWS_LOC + INTEGER, POINTER :: VERTLOCTAB(:), + & EDGELOCTAB(:), RCVCNTS(:) + INTEGER, POINTER :: SIZES(:), ORDER(:) + nullify(FIRST, LAST, SWORK, VERTLOCTAB, EDGELOCTAB, RCVCNTS, + & SIZES, ORDER) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. ID%N*3) THEN + WRITE(LP, + & '("Insufficient workspace inside DMUMPS_718")') + CALL MUMPS_ABORT() + END IF + CALL MUMPS_733(ord%PERMTAB, id%N, id%INFO, LP, + & STRING='PERMTAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%PERITAB, id%N, id%INFO, LP, + & STRING='PERITAB', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT perm peri:', + & MEMCNT,MAXMEM +#endif + BASEVAL = 1 + BASE = id%NPROCS-id%NSLAVES + VERTLOCTAB => ord%PERMTAB + CALL MUMPS_733(FIRST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT first last:',MEMCNT, + & MAXMEM +#endif + DO I=0, BASE-1 + FIRST(I+1) = 0 + LAST(I+1) = -1 + END DO + DO I=BASE, BASE+ord%NSLAVES-2 + FIRST(I+1) = (id%N/ord%NSLAVES)*(I-BASE)+1 + LAST(I+1) = (id%N/ord%NSLAVES)*(I+1-BASE) + END DO + FIRST(BASE+ord%NSLAVES) = (id%N/ord%NSLAVES)* + & (BASE+ord%NSLAVES-1-BASE)+1 + LAST(BASE+ord%NSLAVES) = id%N + DO I=BASE+ord%NSLAVES, NPROCS + FIRST(I+1) = id%N+1 + LAST(I+1) = id%N + END DO + VERTLOCNBR = LAST(MYID+1)-FIRST(MYID+1) + 1 + SWORK => WORK(id%N+1:3*id%N) + CALL DMUMPS_776(id, FIRST, LAST, VERTLOCTAB, + & EDGELOCTAB, SWORK) + EDGELOCNBR = VERTLOCTAB(VERTLOCNBR+1)-1 + OPTIONS(:) = 0 + NROWS_LOC = LAST(MYID+1)-FIRST(MYID+1)+1 + ORDER => WORK(1:id%N) + CALL MUMPS_733(SIZES, 2*ord%NSLAVES, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT sizes:',MEMCNT,MAXMEM +#endif + IF(ord%IDO) THEN + CALL MUMPS_PARMETIS(FIRST(1+BASE), VERTLOCTAB, + & EDGELOCTAB, BASEVAL, OPTIONS, ORDER, + & SIZES, ord%COMM_NODES) + END IF + CALL MUMPS_734(EDGELOCTAB, MEMCNT=MEMCNT) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall elt:',MEMCNT,MAXMEM +#endif + NULLIFY(VERTLOCTAB) + CALL MPI_BCAST(SIZES, 2*ord%NSLAVES, MPI_INTEGER, + & BASE, id%COMM, IERR) + ord%CBLKNBR = 2*ord%NSLAVES-1 + CALL MUMPS_733(RCVCNTS, id%NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rcvcnts:',MEMCNT,MAXMEM +#endif + DO I=1, id%NPROCS + RCVCNTS(I) = max(LAST(I)-FIRST(I)+1,0) + END DO + FIRST = FIRST-1 + IF(FIRST(1) .LT. 0) THEN + FIRST(1) = 0 + END IF + CALL MPI_ALLGATHERV ( ORDER, NROWS_LOC, MPI_INTEGER, ord%PERMTAB, + & RCVCNTS, FIRST, MPI_INTEGER, id%COMM, IERR ) + DO I=1, id%N + ord%PERITAB(ord%PERMTAB(I)) = I + END DO + CALL MUMPS_733(ord%RANGTAB, 2*ord%NSLAVES, id%INFO, + & LP, STRING='RANGTAB', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rangtab:',MEMCNT,MAXMEM +#endif + CALL MUMPS_733(ord%TREETAB, ord%CBLKNBR, id%INFO, + & LP, STRING='TREETAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL DMUMPS_778(ord%TREETAB, ord%RANGTAB, + & SIZES, ord%CBLKNBR) + CALL MUMPS_734(SIZES, FIRST, LAST, + & RCVCNTS, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall sizes:',MEMCNT,MAXMEM +#endif + CALL MUMPS_733(ord%SON, ord%CBLKNBR, id%INFO, + & LP, STRING='SON', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%BROTHER, ord%CBLKNBR, id%INFO, + & LP, STRING='BROTHER', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%NW, ord%CBLKNBR, id%INFO, + & LP, STRING='NW', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT son:',MEMCNT,MAXMEM +#endif + CALL DMUMPS_777(ord) + ord%N = id%N + ord%COMM = id%COMM + RETURN + END SUBROUTINE DMUMPS_718 +#endif +#if defined(ptscotch) + SUBROUTINE DMUMPS_719(id, ord, WORK) + IMPLICIT NONE + INCLUDE 'ptscotchf.h' + TYPE(DMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: WORK(:) + INTEGER :: I, MYID, NPROCS, IERR + INTEGER, POINTER :: FIRST(:), + & LAST(:), SWORK(:) + INTEGER :: BASEVAL, VERTLOCNBR, + & EDGELOCNBR, MYWORKID, + & BASE + INTEGER, POINTER :: VERTLOCTAB(:), + & EDGELOCTAB(:) + DOUBLE PRECISION :: GRAPHDAT(SCOTCH_DGRAPHDIM), + & ORDEDAT(SCOTCH_DORDERDIM), STRADAT(SCOTCH_STRATDIM), + & CORDEDAT(SCOTCH_ORDERDIM) + CHARACTER STRSTRING*1024 + nullify(FIRST, LAST, SWORK, VERTLOCTAB, EDGELOCTAB) + IF(MUMPS_795(WORK) .LT. ID%N*3) THEN + WRITE(LP, + & '("Insufficient workspace inside DMUMPS_719")') + CALL MUMPS_ABORT() + END IF + IF(ord%SUBSTRAT .EQ. 0) THEN + STRSTRING='n{sep=m{asc=b{width=3,strat=q{strat=f}},'// + & 'low=q{strat=h},vert=1000,dvert=100,dlevl=0,proc=1,'// + & 'seq=q{strat=m{type=h,vert=100,low=h{pass=10},'// + & 'asc=b{width=3,bnd=f{bal=0.2},org=h{pass=10}'// + & 'f{bal=0.2}}}}},ole=s,ose=s,osq=n{sep=/(vert>120)?'// + & 'm{type=h,vert=100,low=h{pass=10},asc=b{width=3,'// + & 'bnd=f{bal=0.2},org=h{pass=10}f{bal=0.2}}};,'// + & 'ole=f{cmin=15,cmax=100000,frat=0.0},ose=g}}' + ELSE + STRSTRING='n{sep=m{asc=b{width=3,strat=q{strat=f}},'// + & 'low=q{strat=h},vert=1000,dvert=100,dlevl=0,'// + & 'proc=1,seq=q{strat=m{type=h,vert=100,'// + & 'low=h{pass=10},asc=b{width=3,bnd=f{bal=0.2},'// + & 'org=h{pass=10}f{bal=0.2}}}}},ole=s,ose=s,osq=s}' + END IF + CALL MPI_BARRIER(id%COMM, IERR) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + BASE = id%NPROCS-id%NSLAVES + BASEVAL = 1 + CALL MUMPS_733(FIRST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT first last:',MEMCNT, + & MAXMEM +#endif + DO I=0, BASE-1 + FIRST(I+1) = 0 + LAST(I+1) = -1 + END DO + DO I=BASE, BASE+ord%NSLAVES-2 + FIRST(I+1) = (id%N/ord%NSLAVES)*(I-BASE)+1 + LAST(I+1) = (id%N/ord%NSLAVES)*(I+1-BASE) + END DO + FIRST(BASE+ord%NSLAVES) = (id%N/ord%NSLAVES)* + & (BASE+ord%NSLAVES-1-BASE)+1 + LAST(BASE+ord%NSLAVES) = id%N + DO I=BASE+ord%NSLAVES, NPROCS-1 + FIRST(I+1) = id%N+1 + LAST(I+1) = id%N + END DO + VERTLOCNBR = LAST(MYID+1)-FIRST(MYID+1) + 1 + VERTLOCTAB => WORK(1:id%N) + SWORK => WORK(id%N+1:3*id%N) + CALL DMUMPS_776(id, FIRST, LAST, VERTLOCTAB, + & EDGELOCTAB, SWORK) + EDGELOCNBR = VERTLOCTAB(VERTLOCNBR+1)-1 + CALL MUMPS_733(ord%PERMTAB, id%N, id%INFO, + & LP, STRING='PERMTAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%PERITAB, id%N, id%INFO, + & LP, STRING='PERITAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%RANGTAB, id%N+1, id%INFO, + & LP, STRING='RANGTAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%TREETAB, id%N, id%INFO, + & LP, STRING='TREETAB', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT permtab:',MEMCNT,MAXMEM +#endif + IF(ord%IDO) THEN + CALL MPI_COMM_RANK (ord%COMM_NODES, MYWORKID, IERR) + ELSE + MYWORKID = -1 + END IF + IF(ord%IDO) THEN + CALL MUMPS_DGRAPHINIT(GRAPHDAT, ord%COMM_NODES, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in dgraph init")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFDGRAPHBUILD(GRAPHDAT, BASEVAL, VERTLOCNBR, + & VERTLOCNBR, VERTLOCTAB(1), VERTLOCTAB(2), VERTLOCTAB(1), + & VERTLOCTAB(1), EDGELOCNBR, EDGELOCNBR, EDGELOCTAB(1), + & EDGELOCTAB(1), EDGELOCTAB(1), IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in dgraph build")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFSTRATINIT(STRADAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in strat init")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFSTRATDGRAPHORDER(STRADAT, STRSTRING, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in strat build")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFDGRAPHORDERINIT(GRAPHDAT, ORDEDAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order init")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFDGRAPHORDERCOMPUTE(GRAPHDAT, ORDEDAT, STRADAT, + & IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order compute")') + CALL MUMPS_ABORT() + END IF + IF(MYWORKID .EQ. 0) THEN + CALL SCOTCHFDGRAPHCORDERINIT(GRAPHDAT, CORDEDAT, + & ord%PERMTAB, ord%PERITAB, ord%CBLKNBR, ord%RANGTAB, + & ord%TREETAB, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in Corder init")') + CALL MUMPS_ABORT() + END IF + END IF + IF(MYWORKID .EQ. 0) THEN + CALL SCOTCHFDGRAPHORDERGATHER(GRAPHDAT, ORDEDAT, + & CORDEDAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order gather")') + CALL MUMPS_ABORT() + END IF + ELSE + CALL SCOTCHFDGRAPHORDERGATHER(GRAPHDAT, ORDEDAT, + & ORDEDAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order gather")') + CALL MUMPS_ABORT() + END IF + END IF + END IF + IF(MYWORKID .EQ. 0) + & CALL SCOTCHFDGRAPHCORDEREXIT(GRAPHDAT, CORDEDAT) + CALL SCOTCHFDGRAPHORDEREXIT(GRAPHDAT, ORDEDAT) + CALL SCOTCHFSTRATEXIT(STRADAT) + CALL SCOTCHFDGRAPHEXIT(GRAPHDAT) + CALL MPI_BCAST (ord%CBLKNBR, 1, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%PERMTAB, id%N, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%PERITAB, id%N, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%RANGTAB, id%N+1, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%TREETAB, id%N, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MUMPS_733(ord%SON, ord%CBLKNBR, id%INFO, + & LP, STRING='SON', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%BROTHER, ord%CBLKNBR, id%INFO, + & LP, STRING='BROTHER', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%NW, ord%CBLKNBR, id%INFO, + & LP, STRING='NW', MEMCNT=MEMCNT, ERRCODE=-7) + CALL DMUMPS_777(ord) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT son:',MEMCNT,MAXMEM +#endif + ord%N = id%N + ord%COMM = id%COMM + CALL MUMPS_734(EDGELOCTAB, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall elt:',MEMCNT,MAXMEM +#endif + RETURN + END SUBROUTINE DMUMPS_719 +#endif + FUNCTION DMUMPS_793(id, ord, NACTIVE, ANODE, RPROC, + & ALIST, LIST, PEAKMEM, NNODES, CHECKMEM) + IMPLICIT NONE + LOGICAL :: DMUMPS_793 + INTEGER :: NACTIVE, RPROC, ANODE, PEAKMEM, NNODES + INTEGER :: ALIST(NNODES), LIST(NNODES) + TYPE(ORD_TYPE) :: ord + TYPE(DMUMPS_STRUC) :: id + LOGICAL, OPTIONAL :: CHECKMEM + INTEGER :: IPEAKMEM, BIG, MAX_NROWS, MIN_NROWS + INTEGER :: TOPROWS, NRL, HOSTMEM, SUBMEM + INTEGER :: I, NZ_ROW, WEIGHT + LOGICAL :: ICHECKMEM + IF(present(CHECKMEM)) THEN + ICHECKMEM = CHECKMEM + ELSE + ICHECKMEM = .FALSE. + END IF + DMUMPS_793 = .FALSE. + IF(NACTIVE .GE. RPROC) THEN + DMUMPS_793 = .TRUE. + RETURN + END IF + IF(NACTIVE .EQ. 0) THEN + DMUMPS_793 = .TRUE. + RETURN + END IF + IF(.NOT. ICHECKMEM) RETURN + BIG = ALIST(NACTIVE) + IF(NACTIVE .GT. 1) THEN + MAX_NROWS = ord%NW(ALIST(NACTIVE-1)) + MIN_NROWS = ord%NW(ALIST(1)) + ELSE + MAX_NROWS = 0 + MIN_NROWS = id%N + END IF + DO I=1, ANODE + WEIGHT = ord%NW(LIST(I)) + IF(WEIGHT .GT. MAX_NROWS) MAX_NROWS = WEIGHT + IF(WEIGHT .LT. MIN_NROWS) MIN_NROWS = WEIGHT + END DO + I = ord%SON(BIG) + DO + WEIGHT = ord%NW(I) + IF(WEIGHT .GT. MAX_NROWS) MAX_NROWS = WEIGHT + IF(WEIGHT .LT. MIN_NROWS) MIN_NROWS = WEIGHT + IF(ord%BROTHER(I) .EQ. -1) EXIT + I = ord%BROTHER(I) + END DO + TOPROWS = ord%TOPNODES(2)+ord%RANGTAB(BIG+1)-ord%RANGTAB(BIG) + SUBMEM = 7 *id%N + HOSTMEM = 12*id%N + NZ_ROW = 2*(id%NZ/id%N) + IF(id%KEEP(46) .EQ. 0) THEN + NRL = 0 + ELSE + NRL = MIN_NROWS + END IF + HOSTMEM = HOSTMEM + 2*TOPROWS*NZ_ROW + HOSTMEM = HOSTMEM +NRL + HOSTMEM = HOSTMEM + max(NRL,TOPROWS)*(NZ_ROW+2) + HOSTMEM = HOSTMEM + 6*max(NRL,TOPROWS) + HOSTMEM = HOSTMEM + 3*TOPROWS + NRL = MAX_NROWS + SUBMEM = SUBMEM +NRL + SUBMEM = SUBMEM + NRL*(NZ_ROW+2) + SUBMEM = SUBMEM + 6*NRL + IPEAKMEM = max(HOSTMEM, SUBMEM) + IF((IPEAKMEM .GT. PEAKMEM) .AND. + & (PEAKMEM .NE. 0)) THEN + DMUMPS_793 = .TRUE. + RETURN + ELSE + DMUMPS_793 = .FALSE. + PEAKMEM = IPEAKMEM + RETURN + END IF + END FUNCTION DMUMPS_793 + FUNCTION DMUMPS_779(NODE, ord) + IMPLICIT NONE + INTEGER :: DMUMPS_779 + INTEGER :: NODE + TYPE(ORD_TYPE) :: ord + INTEGER :: CURR + DMUMPS_779 = 0 + IF(ord%SON(NODE) .EQ. -1) THEN + RETURN + ELSE + DMUMPS_779 = 1 + CURR = ord%SON(NODE) + DO + IF(ord%BROTHER(CURR) .NE. -1) THEN + DMUMPS_779 = DMUMPS_779+1 + CURR = ord%BROTHER(CURR) + ELSE + EXIT + END IF + END DO + END IF + RETURN + END FUNCTION DMUMPS_779 + SUBROUTINE DMUMPS_781(ord, id) + USE TOOLS_COMMON + IMPLICIT NONE + TYPE(ORD_TYPE) :: ord + TYPE(DMUMPS_STRUC) :: id + INTEGER, ALLOCATABLE :: ALIST(:), AWEIGHTS(:), LIST(:), WORK(:) + INTEGER :: NNODES, BIG, CURR, ND, NACTIVE, RPROC, ANODE, BASE, I, + & NK, PEAKMEM + LOGICAL :: SD + NNODES = ord%NSLAVES + ALLOCATE(ALIST(NNODES), AWEIGHTS(NNODES), LIST(NNODES), + & WORK(0:NNODES+1)) + ALIST(1) = ord%CBLKNBR + AWEIGHTS(1) = ord%NW(ord%CBLKNBR) + NACTIVE = 1 + RPROC = NNODES + ANODE = 0 + PEAKMEM = 0 + CALL MUMPS_733(ord%TOPNODES, 2*max(NNODES,2), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%FIRST, id%NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%LAST, id%NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')ord%myid,'MEMCNT topnodes:',MEMCNT, + & MAXMEM +#endif + ord%TOPNODES = 0 + IF((ord%CBLKNBR .EQ. 1) .OR. + & ( RPROC .LT. DMUMPS_779(ord%CBLKNBR, ord) )) THEN + ord%TOPNODES(1) = 1 + ord%TOPNODES(2) = ord%RANGTAB(ord%CBLKNBR+1) - ord%RANGTAB(1) + ord%TOPNODES(3) = ord%RANGTAB(1) + ord%TOPNODES(4) = ord%RANGTAB(ord%CBLKNBR+1)-1 + ord%FIRST = 0 + ord%LAST = -1 + RETURN + END IF + DO + IF(NACTIVE .EQ. 0) EXIT + BIG = ALIST(NACTIVE) + NK = DMUMPS_779(BIG, ord) + IF((NK .GT. (RPROC-NACTIVE+1)) .OR. (NK .EQ. 0)) THEN + ANODE = ANODE+1 + LIST(ANODE) = BIG + NACTIVE = NACTIVE-1 + RPROC = RPROC-1 + CYCLE + END IF + SD = DMUMPS_793(id, ord, NACTIVE, ANODE, + & RPROC, ALIST, LIST, PEAKMEM, NNODES, CHECKMEM=.TRUE.) + IF ( SD ) + & THEN + IF(NACTIVE.GT.0) THEN + LIST(ANODE+1:ANODE+NACTIVE) = ALIST(1:NACTIVE) + ANODE = ANODE+NACTIVE + END IF + EXIT + END IF + ord%TOPNODES(1) = ord%TOPNODES(1)+1 + ord%TOPNODES(2) = ord%TOPNODES(2) + + & ord%RANGTAB(BIG+1) - ord%RANGTAB(BIG) + ord%TOPNODES(2+2*(ord%TOPNODES(1)-1)+1) = ord%RANGTAB(BIG) + ord%TOPNODES(2+2*(ord%TOPNODES(1)-1)+2) = + & ord%RANGTAB(BIG+1)-1 + CURR = ord%SON(BIG) + ALIST(NACTIVE) = CURR + AWEIGHTS(NACTIVE) = ord%NW(CURR) + DO + IF(ord%BROTHER(CURR) .EQ. -1) EXIT + NACTIVE = NACTIVE+1 + CURR = ord%BROTHER(CURR) + ALIST(NACTIVE) = CURR + AWEIGHTS(NACTIVE) = ord%NW(CURR) + END DO + CALL DMUMPS_783(NACTIVE, AWEIGHTS(1:NACTIVE), + & WORK(0:NACTIVE+1)) + CALL DMUMPS_784(NACTIVE, WORK(0:NACTIVE+1), + & AWEIGHTS(1:NACTIVE), + & ALIST(1:NACTIVE)) + END DO + DO I=1, ANODE + AWEIGHTS(I) = ord%NW(LIST(I)) + END DO + CALL DMUMPS_783(ANODE, AWEIGHTS(1:ANODE), WORK(0:ANODE+1)) + CALL DMUMPS_784(ANODE, WORK(0:ANODE+1), AWEIGHTS(1:ANODE), + & ALIST(1:ANODE)) + IF (id%KEEP(46) .EQ. 1) THEN + BASE = 0 + ELSE + ord%FIRST(1) = 0 + ord%LAST(1) = -1 + BASE = 1 + END IF + DO I=1, ANODE + CURR = LIST(I) + ND = CURR + IF(ord%SON(ND) .NE. -1) THEN + ND = ord%SON(ND) + DO + IF((ord%SON(ND) .EQ. -1) .AND. + & (ord%BROTHER(ND).EQ.-1)) THEN + EXIT + ELSE IF(ord%BROTHER(ND) .EQ. -1) THEN + ND = ord%SON(ND) + ELSE + ND = ord%BROTHER(ND) + END IF + END DO + END IF + ord%FIRST(BASE+I) = ord%RANGTAB(ND) + ord%LAST(BASE+I) = ord%RANGTAB(CURR+1)-1 + END DO + DO I=ANODE+1, id%NSLAVES + ord%FIRST(BASE+I) = id%N+1 + ord%LAST(BASE+I) = id%N + END DO + DEALLOCATE(LIST, ALIST, AWEIGHTS, WORK) + RETURN + END SUBROUTINE DMUMPS_781 + SUBROUTINE DMUMPS_720(id, ord, GPE, GNV, WORK) + IMPLICIT NONE + TYPE(DMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: GPE(:), GNV(:) + INTEGER, POINTER :: WORK(:) + TYPE(GRAPH_TYPE) :: top_graph + INTEGER, POINTER :: PE(:), IPE(:), + & LENG(:), I_HALO_MAP(:) + INTEGER, POINTER :: NDENSE(:), LAST(:), + & DEGREE(:), W(:), PERM(:), + & LISTVAR_SCHUR(:), NEXT(:), + & HEAD(:), NV(:), ELEN(:), + & RCVCNT(:), LSTVAR(:) + INTEGER, POINTER :: NROOTS(:), MYLIST(:), + & MYNVAR(:), LVARPT(:), + & DISPLS(:), LPERM(:), + & LIPERM(:), + & IPET(:), NVT(:), BUF_PE1(:), + & BUF_PE2(:), BUF_NV1(:), + & BUF_NV2(:), ROOTPERM(:), + & TMP1(:), TMP2(:), BWORK(:) + INTEGER :: HIDX, NCMPA, I, J, SIZE_SCHUR, MYID, + & NPROCS, IERR, NROWS_LOC, GLOB_IDX, MYNROOTS, PNT, TMP, + & NCLIQUES, NTVAR, PFREES, PFREET, TGSIZE, MAXS, RHANDPE, + & RHANDNV, STATUSPE(MPI_STATUS_SIZE), + & STATUSNV(MPI_STATUS_SIZE), RIDX, PROC, NBBUCK, + & PFS_SAVE, PFT_SAVE + LOGICAL :: AGG6 + INTEGER :: THRESH + nullify(PE, IPE, LENG, I_HALO_MAP) + nullify(NDENSE, LAST, DEGREE, W, PERM, LISTVAR_SCHUR, + & NEXT, HEAD, NV, ELEN, RCVCNT, LSTVAR) + nullify(NROOTS, MYLIST, MYNVAR, LVARPT, DISPLS, + & LPERM, LIPERM, IPET, NVT, BUF_PE1, BUF_PE2, + & BUF_NV1, BUF_NV2, ROOTPERM, TMP1, TMP2, BWORK) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. 4*id%N) THEN + WRITE(LP,*)'Insufficient workspace in DMUMPS_720' + CALL MUMPS_ABORT() + ELSE + HEAD => WORK( 1 : id%N) + ELEN => WORK( id%N+1 : 2*id%N) + LENG => WORK(2*id%N+1 : 3*id%N) + PERM => WORK(3*id%N+1 : 4*id%N) + END IF + CALL DMUMPS_781(ord, id) + CALL MUMPS_734(ord%SON, ord%BROTHER, ord%NW, + & ord%RANGTAB, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))') myid,'deall son:',MEMCNT,MAXMEM +#endif + NROWS_LOC = ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1 + NRL = NROWS_LOC + TOPROWS = ord%TOPNODES(2) + BWORK => WORK(1 : 2*id%N) + CALL DMUMPS_775(id, ord, HIDX, IPE, PE, LENG, + & I_HALO_MAP, top_graph, BWORK) + TMP = id%N + DO I=1, NPROCS + TMP = TMP-(ord%LAST(I)-ord%FIRST(I)+1) + END DO + TMP = ceiling(dble(TMP)*1.10D0) + IF(MYID .EQ. 0) THEN + TMP = max(max(TMP, HIDX),1) + ELSE + TMP = max(HIDX,1) + END IF + SIZE_SCHUR = HIDX - NROWS_LOC + CALL MUMPS_733(NDENSE, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NEXT, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(DEGREE, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(W, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NV, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LISTVAR_SCHUR, max(SIZE_SCHUR,1), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT allsub:',MEMCNT,MAXMEM +#endif + DO I=1, SIZE_SCHUR + LISTVAR_SCHUR(I) = NROWS_LOC+I + END DO + THRESH = -1 + AGG6 = .TRUE. + PFREES = IPE(NROWS_LOC+1) + PFS_SAVE = PFREES + IF (ord%SUBSTRAT .EQ. 0) THEN + DO I=1, HIDX + PERM(I) = I + END DO + CALL MUMPS_420(1, THRESH, NDENSE(1), HIDX, + & MUMPS_795(PE), IPE(1), PFREES, LENG(1), PE(1), NV(1), + & ELEN(1), LAST(1), NCMPA, DEGREE(1), HEAD(1), NEXT(1), + & W(1), PERM(1), LISTVAR_SCHUR(1), SIZE_SCHUR, AGG6) + ELSE + NBBUCK = 2*TMP + CALL MUMPS_419 (ord%SUBSTRAT, 1, .FALSE., HIDX, NBBUCK, + & MUMPS_795(PE), IPE(1), PFREES, LENG(1), PE(1), NV(1), + & ELEN(1), LAST(1), NCMPA, DEGREE(1), PERM(1), NEXT(1), + & W(1), HEAD(1), AGG6, SIZE_SCHUR, LISTVAR_SCHUR(1) ) + DO I=1, HIDX + PERM(I) = I + END DO + END IF + CALL MUMPS_733(W, 2*NPROCS, id%INFO, + & LP, STRING='W', MEMCNT=MEMCNT, ERRCODE=-7) + if(MEMCNT .gt. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT w:',MEMCNT,MAXMEM +#endif + NROOTS => W + DISPLS => W(NPROCS+1:2*NPROCS) + MYNVAR => DEGREE + MYLIST => NDENSE + LVARPT => NEXT + RCVCNT => HEAD + LSTVAR => LAST + NULLIFY(W, DEGREE, NDENSE, NEXT, HEAD, LAST) + MYNROOTS = 0 + PNT = 0 + DO I=1, HIDX + IF(IPE(I) .GT. 0) THEN + PNT = PNT+LENG(I) + MYNROOTS = MYNROOTS+1 + END IF + END DO + CALL MUMPS_733(MYLIST, PNT, id%INFO, + & LP, STRING='MYLIST', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT mylist:',MEMCNT,MAXMEM +#endif + MYNROOTS = 0 + PNT = 0 + DO I=1, HIDX + IF(IPE(I) .GT. 0) THEN + MYNROOTS = MYNROOTS+1 + MYNVAR(MYNROOTS) = LENG(I) + DO J=1, LENG(I) + MYLIST(PNT+J) = I_HALO_MAP(PE(IPE(I)+J-1)-NROWS_LOC) + END DO + PNT = PNT+LENG(I) + END IF + END DO + CALL MPI_BARRIER(id%COMM, IERR) + CALL MPI_GATHER(MYNROOTS, 1, MPI_INTEGER, NROOTS(1), 1, + & MPI_INTEGER, 0, id%COMM, IERR) + IF(MYID .EQ.0) THEN + DISPLS(1) = 0 + DO I=2, NPROCS + DISPLS(I) = DISPLS(I-1)+NROOTS(I-1) + END DO + NCLIQUES = sum(NROOTS(1:NPROCS)) + CALL MUMPS_733(LVARPT, NCLIQUES+1, id%INFO, + & LP, STRING='LVARPT', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT + ELSE + CALL MUMPS_733(LVARPT, 2, id%INFO, + & LP, STRING='LVARPT', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT + END IF +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT lvarpt:',MEMCNT,MAXMEM +#endif + CALL MPI_GATHERV(MYNVAR(1), MYNROOTS, MPI_INTEGER, LVARPT(2), + & NROOTS(1), DISPLS(1), MPI_INTEGER, 0, id%COMM, IERR) + IF(MYID .EQ. 0) THEN + DO I=1, NPROCS + RCVCNT(I) = sum(LVARPT(2+DISPLS(I):2+DISPLS(I)+NROOTS(I)-1)) + IF(I .EQ. 1) THEN + DISPLS(I) = 0 + ELSE + DISPLS(I) = DISPLS(I-1)+RCVCNT(I-1) + END IF + END DO + CALL MUMPS_733(LSTVAR, sum(RCVCNT(1:NPROCS)), id%INFO, + & LP, STRING='LSTVAR', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT lstvar:',MEMCNT,MAXMEM +#endif + END IF + CALL MPI_GATHERV(MYLIST(1), PNT, MPI_INTEGER, LSTVAR(1), + & RCVCNT(1), DISPLS(1), MPI_INTEGER, 0, id%COMM, IERR) + NULLIFY(DISPLS) + IF(MYID .EQ. 0) THEN + LVARPT(1) = 1 + DO I=2, NCLIQUES+1 + LVARPT(I) = LVARPT(I-1) + LVARPT(I) + END DO + LPERM => WORK(3*id%N+1 : 4*id%N) + NTVAR = ord%TOPNODES(2) + CALL DMUMPS_782(id, ord%TOPNODES, LPERM, LIPERM, ord) + CALL DMUMPS_774(id, ord%TOPNODES(2), LPERM, + & top_graph, NCLIQUES, LSTVAR, LVARPT, IPET, PE, LENG, ELEN) + TGSIZE = ord%TOPNODES(2)+NCLIQUES + PFREET = IPET(TGSIZE+1) + PFT_SAVE = PFREET + nullify(LPERM) + CALL MUMPS_734(top_graph%IRN_LOC, + & top_graph%JCN_LOC, ord%TOPNODES, MEMCNT=MEMCNT) + W => NROOTS + DEGREE => MYNVAR + NDENSE => MYLIST + NEXT => LVARPT + HEAD => RCVCNT + LAST => LSTVAR + NULLIFY(NROOTS, MYNVAR, MYLIST, LVARPT, RCVCNT, LSTVAR) + CALL MUMPS_733(PE, max(PFREET+TGSIZE,1), id%INFO, LP, + & COPY=.TRUE., STRING='J2:PE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NDENSE, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:NDENSE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NVT, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:NVT', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:LAST', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(DEGREE, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:DEGREE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NEXT, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:NEXT', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(W, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:W', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LISTVAR_SCHUR, max(NCLIQUES,1), id%INFO, LP, + & STRING='J2:LVSCH', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT pe:',MEMCNT,MAXMEM +#endif + DO I=1, NCLIQUES + LISTVAR_SCHUR(I) = NTVAR+I + END DO + THRESH = -1 + IF(ord%TOPSTRAT .EQ. 0) THEN + CALL MUMPS_733(HEAD, max(TGSIZE,1), id%INFO, + & LP, STRING='J2:HEAD', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(PERM, max(TGSIZE,1), id%INFO, + & LP, COPY=.TRUE., STRING='J2:PERM', + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rehead:',MEMCNT,MAXMEM +#endif + DO I=1, TGSIZE + PERM(I) = I + END DO + CALL MUMPS_420(2, -1, NDENSE(1), TGSIZE, + & MUMPS_795(PE), IPET(1), PFREET, LENG(1), PE(1), + & NVT(1), ELEN(1), LAST(1), NCMPA, DEGREE(1), HEAD(1), + & NEXT(1), W(1), PERM(1), LISTVAR_SCHUR(1), NCLIQUES, + & AGG6) + ELSE + NBBUCK = 2*TGSIZE + CALL MUMPS_733(HEAD, NBBUCK+2, id%INFO, + & LP, STRING='J2:HEAD', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(PERM, TGSIZE, id%INFO, + & LP, STRING='J2:PERM', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rehead:',MEMCNT,MAXMEM +#endif + CALL MUMPS_419 (ord%TOPSTRAT, 2, .FALSE., TGSIZE, + & NBBUCK, MUMPS_795(PE), IPET(1), PFREET, LENG(1), + & PE(1), NVT(1), ELEN(1), LAST(1), NCMPA, DEGREE(1), + & PERM(1), NEXT(1), W(1), HEAD(1), AGG6, NCLIQUES, + & LISTVAR_SCHUR(1) ) + END IF + END IF + CALL MPI_BARRIER(id%COMM, IERR) + CALL MUMPS_734(LISTVAR_SCHUR, PE, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall lvs:',MEMCNT,MAXMEM +#endif + IF(MYID .EQ. 0) THEN + BUF_PE1 => WORK( 1 : id%N) + BUF_PE2 => WORK( id%N+1 : 2*id%N) + BUF_NV1 => WORK(2*id%N+1 : 3*id%N) + BUF_NV2 => WORK(3*id%N+1 : 4*id%N) + MAXS = NROWS_LOC + DO I=2, NPROCS + IF((ord%LAST(I)-ord%FIRST(I)+1) .GT. MAXS) + & MAXS = (ord%LAST(I)-ord%FIRST(I)+1) + END DO + CALL MUMPS_733(BUF_PE1, MAXS, id%INFO, + & LP, STRING='BUF_PE1', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(BUF_PE2, MAXS, id%INFO, + & LP, STRING='BUF_PE2', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(BUF_NV1, MAXS, id%INFO, + & LP, STRING='BUF_NV1', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(BUF_NV2, MAXS, id%INFO, + & LP, STRING='BUF_NV2', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(GPE, id%N, id%INFO, + & LP, STRING='GPE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(GNV, id%N, id%INFO, + & LP, STRING='GNV', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ROOTPERM, NCLIQUES, id%INFO, + & LP, STRING='ROOTPERM', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT buf_pe1:',MEMCNT, + & MAXMEM +#endif + RIDX = 0 + TMP1 => BUF_PE1 + TMP2 => BUF_NV1 + NULLIFY(BUF_PE1, BUF_NV1) + BUF_PE1 => IPE + BUF_NV1 => NV + DO PROC=0, NPROCS-2 + CALL MPI_IRECV(BUF_PE2(1), ord%LAST(PROC+2)- + & ord%FIRST(PROC+2)+1, MPI_INTEGER, PROC+1, PROC+1, + & id%COMM, RHANDPE, IERR) + CALL MPI_IRECV(BUF_NV2(1), ord%LAST(PROC+2)- + & ord%FIRST(PROC+2)+1, MPI_INTEGER, PROC+1, PROC+1, + & id%COMM, RHANDNV, IERR) + DO I=1, ord%LAST(PROC+1)-ord%FIRST(PROC+1)+1 + GLOB_IDX = ord%PERITAB(I+ord%FIRST(PROC+1)-1) + IF(BUF_PE1(I) .GT. 0) THEN + RIDX=RIDX+1 + ROOTPERM(RIDX) = GLOB_IDX + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE IF (BUF_PE1(I) .EQ. 0) THEN + GPE(GLOB_IDX) = 0 + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE + GPE(GLOB_IDX) = -ord%PERITAB(-BUF_PE1(I)+ + & ord%FIRST(PROC+1)-1) + GNV(GLOB_IDX) = BUF_NV1(I) + END IF + END DO + CALL MPI_WAIT(RHANDPE, STATUSPE, IERR) + CALL MPI_WAIT(RHANDNV, STATUSNV, IERR) + IF(PROC .NE. 0) THEN + TMP1 => BUF_PE1 + TMP2 => BUF_NV1 + END IF + BUF_PE1 => BUF_PE2 + BUF_NV1 => BUF_NV2 + NULLIFY(BUF_PE2, BUF_NV2) + BUF_PE2 => TMP1 + BUF_NV2 => TMP2 + NULLIFY(TMP1, TMP2) + END DO + DO I=1, ord%LAST(PROC+1)-ord%FIRST(PROC+1)+1 + GLOB_IDX = ord%PERITAB(I+ord%FIRST(PROC+1)-1) + IF(BUF_PE1(I) .GT. 0) THEN + RIDX=RIDX+1 + ROOTPERM(RIDX) = GLOB_IDX + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE IF (BUF_PE1(I) .EQ. 0) THEN + GPE(GLOB_IDX) = 0 + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE + GPE(GLOB_IDX) = -ord%PERITAB(-BUF_PE1(I)+ + & ord%FIRST(PROC+1)-1) + GNV(GLOB_IDX) = BUF_NV1(I) + END IF + END DO + DO I=1, NTVAR + GLOB_IDX = LIPERM(I) + IF(IPET(I) .EQ. 0) THEN + GPE(GLOB_IDX) = 0 + GNV(GLOB_IDX) = NVT(I) + ELSE + GPE(GLOB_IDX) = -LIPERM(-IPET(I)) + GNV(GLOB_IDX) = NVT(I) + END IF + END DO + DO I=1, NCLIQUES + GLOB_IDX = ROOTPERM(I) + GPE(GLOB_IDX) = -LIPERM(-IPET(NTVAR+I)) + END DO + ELSE + CALL MPI_SEND(IPE(1), ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1, + & MPI_INTEGER, 0, MYID, id%COMM, IERR) + CALL MPI_SEND(NV(1), ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1, + & MPI_INTEGER, 0, MYID, id%COMM, IERR) + END IF + CALL MUMPS_734(PE, IPE, I_HALO_MAP, NDENSE, + & LAST, DEGREE, MEMCNT=MEMCNT) + CALL MUMPS_734(W, LISTVAR_SCHUR, NEXT, + & NV, MEMCNT=MEMCNT) + CALL MUMPS_734(LSTVAR, NROOTS, MYLIST, MYNVAR, + & LVARPT, MEMCNT=MEMCNT) + CALL MUMPS_734(LPERM, LIPERM, IPET, NVT, + & MEMCNT=MEMCNT) + CALL MUMPS_734(ROOTPERM, TMP1, TMP2, MEMCNT=MEMCNT) + NULLIFY(HEAD, ELEN, LENG, PERM, RCVCNT) + RETURN + END SUBROUTINE DMUMPS_720 + SUBROUTINE DMUMPS_782(id, TOPNODES, LPERM, LIPERM, ord) + IMPLICIT NONE + TYPE(DMUMPS_STRUC) :: id + INTEGER, POINTER :: TOPNODES(:), LPERM(:), LIPERM(:) + TYPE(ORD_TYPE) :: ord + INTEGER :: I, J, K, GIDX + CALL MUMPS_733(LPERM , ord%N, id%INFO, + & LP, STRING='LIDX:LPERM', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LIPERM, TOPNODES(2), id%INFO, + & LP, STRING='LIDX:LIPERM', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')id%myid,'MEMCNT lperm:',MEMCNT, + & MAXMEM +#endif + LPERM = 0 + K = 1 + DO I=1, TOPNODES(1) + DO J=TOPNODES(2*I+1), TOPNODES(2*I+2) + GIDX = ord%PERITAB(J) + LPERM(GIDX) = K + LIPERM(K) = GIDX + K = K+1 + END DO + END DO + RETURN + END SUBROUTINE DMUMPS_782 + SUBROUTINE DMUMPS_774(id, NLOCVARS, LPERM, + & top_graph, NCLIQUES, LSTVAR, LVARPT, IPE, PE, LENG, ELEN) + IMPLICIT NONE + TYPE(DMUMPS_STRUC) :: id + TYPE(GRAPH_TYPE) :: top_graph + INTEGER, POINTER :: LPERM(:), LSTVAR(:), LVARPT(:), + & IPE(:), PE(:), LENG(:), ELEN(:) + INTEGER :: NCLIQUES + INTEGER :: I, J, IDX, NLOCVARS, PNT, SAVEPNT + CALL MUMPS_733(LENG, max(NLOCVARS+NCLIQUES,1) , id%INFO, + & LP, STRING='ATG:LENG', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ELEN, max(NLOCVARS+NCLIQUES,1) , id%INFO, + & LP, STRING='ATG:ELEN', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(IPE , NLOCVARS+NCLIQUES+1, id%INFO, + & LP, STRING='ATG:IPE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')id%myid,'MEMCNT leng:',MEMCNT, + & MAXMEM +#endif + LENG = 0 + ELEN = 0 + DO I=1, top_graph%NZ_LOC + IF((LPERM(top_graph%JCN_LOC(I)) .NE. 0) .AND. + & (top_graph%JCN_LOC(I) .NE. top_graph%IRN_LOC(I))) THEN + LENG(LPERM(top_graph%IRN_LOC(I))) = + & LENG(LPERM(top_graph%IRN_LOC(I))) + 1 + END IF + END DO + DO I=1, NCLIQUES + DO J=LVARPT(I), LVARPT(I+1)-1 + ELEN(LPERM(LSTVAR(J))) = ELEN(LPERM(LSTVAR(J)))+1 + LENG(NLOCVARS+I) = LENG(NLOCVARS+I)+1 + END DO + END DO + IPE(1) = 1 + DO I=1, NLOCVARS+NCLIQUES + IPE(I+1) = IPE(I)+LENG(I)+ELEN(I) + END DO + CALL MUMPS_733(PE, IPE(NLOCVARS+NCLIQUES+1)+NLOCVARS+NCLIQUES, + & id%INFO, LP, STRING='ATG:PE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')id%myid,'MEMCNT repe:',MEMCNT, + & MAXMEM +#endif + LENG = 0 + ELEN = 0 + DO I=1, NCLIQUES + DO J=LVARPT(I), LVARPT(I+1)-1 + IDX = LPERM(LSTVAR(J)) + PE(IPE(IDX)+ELEN(IDX)) = NLOCVARS+I + PE(IPE(NLOCVARS+I)+LENG(NLOCVARS+I)) = IDX + ELEN(LPERM(LSTVAR(J))) = ELEN(LPERM(LSTVAR(J)))+1 + LENG(NLOCVARS+I) = LENG(NLOCVARS+I)+1 + end do + end do + DO I=1, top_graph%NZ_LOC + IF((LPERM(top_graph%JCN_LOC(I)) .NE. 0) .AND. + & (top_graph%JCN_LOC(I) .NE. top_graph%IRN_LOC(I))) THEN + PE(IPE(LPERM(top_graph%IRN_LOC(I)))+ + & ELEN(LPERM(top_graph%IRN_LOC(I))) + + & LENG(LPERM(top_graph%IRN_LOC(I)))) = + & LPERM(top_graph%JCN_LOC(I)) + LENG(LPERM(top_graph%IRN_LOC(I))) = + & LENG(LPERM(top_graph%IRN_LOC(I))) + 1 + END IF + END DO + DO I=1, NLOCVARS+NCLIQUES + LENG(I) = LENG(I)+ELEN(I) + END DO + SAVEPNT = 1 + PNT = 0 + LPERM(1:NLOCVARS+NCLIQUES) = 0 + DO I=1, NLOCVARS+NCLIQUES + DO J=IPE(I), IPE(I+1)-1 + IF(LPERM(PE(J)) .EQ. I) THEN + LENG(I) = LENG(I)-1 + ELSE + LPERM(PE(J)) = I + PNT = PNT+1 + PE(PNT) = PE(J) + END IF + END DO + IPE(I) = SAVEPNT + SAVEPNT = PNT+1 + END DO + IPE(NLOCVARS+NCLIQUES+1) = SAVEPNT + RETURN + END SUBROUTINE DMUMPS_774 + SUBROUTINE DMUMPS_778(TREETAB, RANGTAB, SIZES, CBLKNBR) + INTEGER, POINTER :: TREETAB(:), RANGTAB(:), SIZES(:) + INTEGER :: CBLKNBR + INTEGER :: LCHILD, RCHILD, K, I + INTEGER, POINTER :: PERM(:) + ALLOCATE(PERM(CBLKNBR)) + TREETAB(CBLKNBR) = -1 + IF(CBLKNBR .EQ. 1) THEN + DEALLOCATE(PERM) + TREETAB(1) = -1 + RANGTAB(1:2) = (/1, SIZES(1)+1/) + RETURN + END IF + LCHILD = CBLKNBR - (CBLKNBR+1)/2 + RCHILD = CBLKNBR-1 + K = 1 + PERM(CBLKNBR) = CBLKNBR + PERM(LCHILD) = CBLKNBR+1 - (2*K+1) + PERM(RCHILD) = CBLKNBR+1 - (2*K) + TREETAB(RCHILD) = CBLKNBR + TREETAB(LCHILD) = CBLKNBR + IF(CBLKNBR .GT. 3) THEN + CALL REC_TREETAB(TREETAB, PERM, (CBLKNBR-1)/2, + & LCHILD, CBLKNBR, 2*K+1) + CALL REC_TREETAB(TREETAB, PERM, (CBLKNBR-1)/2, + & RCHILD, CBLKNBR, 2*K) + END IF + RANGTAB(1)=1 + DO I=1, CBLKNBR + RANGTAB(I+1) = RANGTAB(I)+SIZES(PERM(I)) + END DO + DEALLOCATE(PERM) + RETURN + CONTAINS + RECURSIVE SUBROUTINE REC_TREETAB(TREETAB, PERM, SUBNODES, + & ROOTN, CBLKNBR, K) + INTEGER, POINTER :: TREETAB(:), PERM(:) + INTEGER :: SUBNODES, ROOTN, K, CBLKNBR + INTEGER :: LCHILD, RCHILD + LCHILD = ROOTN - (SUBNODES+1)/2 + RCHILD = ROOTN-1 + PERM(LCHILD) = CBLKNBR+1 - (2*K+1) + PERM(RCHILD) = CBLKNBR+1 - (2*K) + TREETAB(RCHILD) = ROOTN + TREETAB(LCHILD) = ROOTN + IF(SUBNODES .GT. 3) THEN + CALL REC_TREETAB(TREETAB, PERM, (SUBNODES-1)/2, LCHILD, + & CBLKNBR, 2*K+1) + CALL REC_TREETAB(TREETAB, PERM, (SUBNODES-1)/2, RCHILD, + & CBLKNBR, 2*K) + END IF + END SUBROUTINE REC_TREETAB + END SUBROUTINE DMUMPS_778 + SUBROUTINE DMUMPS_776(id, FIRST, LAST, IPE, + & PE, WORK) + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(DMUMPS_STRUC) :: id + INTEGER, POINTER :: FIRST(:), LAST(:), IPE(:), PE(:), + & WORK(:) + INTEGER :: IERR, MYID, NPROCS + INTEGER :: I, PROC, LOCNNZ, + & NEW_LOCNNZ, J, LOC_ROW + INTEGER :: TOP_CNT, TIDX, + & NROWS_LOC, DUPS, TOTDUPS, OFFDIAG + INTEGER :: STATUS(MPI_STATUS_SIZE) + INTEGER, POINTER :: MAPTAB(:), + & SNDCNT(:), RCVCNT(:), SDISPL(:) + INTEGER, POINTER :: RDISPL(:), + & MSGCNT(:), SIPES(:,:), LENG(:) + INTEGER, POINTER :: PCNT(:), TSENDI(:), + & TSENDJ(:), RCVBUF(:) + TYPE(ARRPNT), POINTER :: APNT(:) + INTEGER :: BUFSIZE, SOURCE, RCVPNT, MAXS, PNT, + & SAVEPNT + INTEGER, PARAMETER :: ITAG=30 + LOGICAL :: FLAG + DOUBLE PRECISION :: SYMMETRY + nullify(MAPTAB, SNDCNT, RCVCNT, SDISPL) + nullify(RDISPL, MSGCNT, SIPES, LENG) + nullify(PCNT, TSENDI, TSENDJ, RCVBUF, APNT) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. id%N*2) THEN + WRITE(LP, + & '("Insufficient workspace inside BUILD_SCOTCH_GRAPH")') + CALL MUMPS_ABORT() + END IF + CALL MUMPS_733(SNDCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(RCVCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(MSGCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT sndcnt:',MEMCNT,MAXMEM +#endif + ALLOCATE(APNT(NPROCS)) + SNDCNT = 0 + TOP_CNT = 0 + BUFSIZE = 1000 + LOCNNZ = id%NZ_loc + NROWS_LOC = LAST(MYID+1)-FIRST(MYID+1)+1 + MAPTAB => WORK( 1 : id%N) + LENG => WORK(id%N+1 : 2*id%N) + MAXS = 0 + DO I=1, NPROCS + IF((LAST(I)-FIRST(I)+1) .GT. MAXS) THEN + MAXS = LAST(I)-FIRST(I)+1 + END IF + DO J=FIRST(I), LAST(I) + MAPTAB(J) = I + END DO + END DO + ALLOCATE(SIPES(max(1,MAXS), NPROCS)) + OFFDIAG=0 + SIPES=0 + DO I=1, id%NZ_loc + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + OFFDIAG = OFFDIAG+1 + PROC = MAPTAB(id%IRN_loc(I)) + LOC_ROW = id%IRN_loc(I)-FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + PROC = MAPTAB(id%JCN_loc(I)) + LOC_ROW = id%JCN_loc(I)-FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + END IF + END DO + CALL MPI_ALLREDUCE (OFFDIAG, id%KEEP(114), 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR) + id%KEEP(114) = id%KEEP(114)+3*id%N + id%KEEP(113) = id%KEEP(114)-2*id%N + CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, id%COMM, IERR) + SNDCNT(:) = MAXS + CALL MPI_REDUCE_SCATTER ( SIPES(1,1), LENG(1), SNDCNT(1), + & MPI_INTEGER, MPI_SUM, id%COMM, IERR ) + DEALLOCATE(SIPES) + CALL MUMPS_733(IPE, NROWS_LOC+1, id%INFO, + & LP, STRING='IPE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT ripe:',MEMCNT,MAXMEM +#endif + IPE(1) = 1 + DO I=1, NROWS_LOC + IPE(I+1) = IPE(I) + LENG(I) + END DO + CALL MUMPS_733(PE, max(IPE(NROWS_LOC+1)-1,1), id%INFO, + & LP, STRING='PE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rrpe:',MEMCNT,MAXMEM +#endif + LENG(:) = 0 + CALL DMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, LENG, + & RCVBUF, MSGCNT, SNDCNT, id%COMM) + NEW_LOCNNZ = sum(RCVCNT) + DO I=1, NPROCS + MSGCNT(I) = RCVCNT(I)/BUFSIZE + END DO + RCVPNT = 1 + SNDCNT = 0 + TIDX = 0 + DO I=1, id%NZ_loc + IF(mod(I,BUFSIZE/10) .EQ. 0) THEN + CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, MPI_COMM_WORLD, + & FLAG, STATUS, IERR ) + IF(FLAG) THEN + SOURCE = STATUS(MPI_SOURCE) + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, SOURCE, + & ITAG, MPI_COMM_WORLD, STATUS, IERR) + CALL DMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + RCVPNT = RCVPNT + BUFSIZE + END IF + END IF + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + PROC = MAPTAB(id%IRN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) = id%IRN_loc(I)- + & FIRST(PROC)+1 + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = id%JCN_loc(I) + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL DMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, + & PE, LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + PROC = MAPTAB(id%JCN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) = id%JCN_loc(I)- + & FIRST(PROC)+1 + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = id%IRN_loc(I) + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL DMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, + & PE, LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + END IF + END DO + CALL DMUMPS_785(APNT, -1, NPROCS, BUFSIZE, IPE, PE, LENG, + & RCVBUF, MSGCNT, SNDCNT, id%COMM) + DUPS = 0 + PNT = 0 + SAVEPNT = 1 + MAPTAB = 0 + DO I=1, NROWS_LOC + DO J=IPE(I),IPE(I+1)-1 + IF(MAPTAB(PE(J)) .EQ. I) THEN + DUPS = DUPS+1 + ELSE + MAPTAB(PE(J)) = I + PNT = PNT+1 + PE(PNT) = PE(J) + END IF + END DO + IPE(I) = SAVEPNT + SAVEPNT = PNT+1 + END DO + CALL MPI_REDUCE( DUPS, TOTDUPS, 1, MPI_INTEGER, MPI_SUM, + & 0, id%COMM, IERR ) + SYMMETRY = dble(TOTDUPS)/(dble(id%NZ)-dble(id%N)) + IF(MYID .EQ. 0) THEN + IF(id%KEEP(50) .GE. 1) SYMMETRY = 1.d0 + IF(PROKG) WRITE(MPG,'("Structual symmetry is:",i3,"%")') + & ceiling(SYMMETRY*100.d0) + id%INFOG(8) = ceiling(SYMMETRY*100.0d0) + END IF + IPE(NROWS_LOC+1) = SAVEPNT + CALL MUMPS_734(SNDCNT, RCVCNT, MSGCNT, MEMCNT=MEMCNT) + DEALLOCATE(APNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall sndcnt:',MEMCNT,MAXMEM +#endif + RETURN + END SUBROUTINE DMUMPS_776 + SUBROUTINE DMUMPS_775(id, ord, GSIZE, IPE, PE, LENG, + & I_HALO_MAP, top_graph, WORK) + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(DMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + TYPE(GRAPH_TYPE) :: top_graph + INTEGER, POINTER :: IPE(:), PE(:), LENG(:), + & I_HALO_MAP(:), WORK(:) + INTEGER :: GSIZE + INTEGER :: IERR, MYID, NPROCS + INTEGER :: I, PROC, LOCNNZ, + & NEW_LOCNNZ, J, LOC_ROW + INTEGER :: TOP_CNT,IIDX,JJDX + INTEGER :: HALO_SIZE, TIDX, NROWS_LOC, DUPS + INTEGER :: STATUS(MPI_STATUS_SIZE) + INTEGER, POINTER :: MAPTAB(:), + & SNDCNT(:), RCVCNT(:), + & SDISPL(:), HALO_MAP(:) + INTEGER, POINTER :: RDISPL(:), + & MSGCNT(:), SIPES(:,:) + INTEGER, POINTER :: PCNT(:), TSENDI(:), + & TSENDJ(:), RCVBUF(:) + TYPE(ARRPNT), POINTER :: APNT(:) + INTEGER :: BUFSIZE, SOURCE, RCVPNT, MAXS, PNT, + & SAVEPNT + INTEGER, PARAMETER :: ITAG=30 + LOGICAL :: FLAG + nullify(MAPTAB, SNDCNT, RCVCNT, SDISPL, HALO_MAP) + nullify(RDISPL, MSGCNT, SIPES) + nullify(PCNT, TSENDI, TSENDJ, RCVBUF, APNT) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. id%N*2) THEN + WRITE(LP, + & '("Insufficient workspace inside BUILD_LOC_GRAPH")') + CALL MUMPS_ABORT() + END IF + MAPTAB => WORK( 1 : id%N) + HALO_MAP => WORK(id%N+1 : 2*id%N) + CALL MUMPS_733(SNDCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(RCVCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(MSGCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rrsndcnt:',MEMCNT,MAXMEM +#endif + ALLOCATE(APNT(NPROCS)) + SNDCNT = 0 + TOP_CNT = 0 + BUFSIZE = 10000 + LOCNNZ = id%NZ_loc + NROWS_LOC = ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1 + MAPTAB = 0 + MAXS = 0 + DO I=1, NPROCS + IF((ord%LAST(I)-ord%FIRST(I)+1) .GT. MAXS) THEN + MAXS = ord%LAST(I)-ord%FIRST(I)+1 + END IF + DO J=ord%FIRST(I), ord%LAST(I) + MAPTAB(ord%PERITAB(J)) = I + END DO + END DO + ALLOCATE(SIPES(max(1,MAXS), NPROCS)) + SIPES(:,:) = 0 + TOP_CNT = 0 + DO I=1, id%NZ_loc + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + PROC = MAPTAB(id%IRN_loc(I)) + IF(PROC .EQ. 0) THEN + TOP_CNT = TOP_CNT+1 + ELSE + IIDX = ord%PERMTAB(id%IRN_loc(I)) + LOC_ROW = IIDX-ord%FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + END IF + PROC = MAPTAB(id%JCN_loc(I)) + IF(PROC .EQ. 0) THEN + TOP_CNT = TOP_CNT+1 + ELSE + IIDX = ord%PERMTAB(id%JCN_loc(I)) + LOC_ROW = IIDX-ord%FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + END IF + END IF + END DO + CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, id%COMM, IERR) + I = ceiling(dble(MAXS)*1.20D0) + CALL MUMPS_733(LENG, max(I,1), id%INFO, + & LP, STRING='B_L_G:LENG', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rrleng2:',MEMCNT, + & MAXMEM +#endif + SNDCNT(:) = MAXS + CALL MPI_REDUCE_SCATTER ( SIPES(1,1), LENG(1), SNDCNT(1), + & MPI_INTEGER, MPI_SUM, id%COMM, IERR ) + DEALLOCATE(SIPES) + I = ceiling(dble(NROWS_LOC+1)*1.20D0) + CALL MUMPS_733(IPE, max(I,1), id%INFO, + & LP, STRING='B_L_G:IPE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rripe:',MEMCNT,MAXMEM +#endif + IPE(1) = 1 + DO I=1, NROWS_LOC + IPE(I+1) = IPE(I) + LENG(I) + END DO + CALL MUMPS_733(TSENDI, max(TOP_CNT,1), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(TSENDJ, max(TOP_CNT,1), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT tsendi:',MEMCNT,MAXMEM +#endif + LENG(:) = 0 + CALL DMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, + & LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + NEW_LOCNNZ = sum(RCVCNT) + DO I=1, NPROCS + MSGCNT(I) = RCVCNT(I)/BUFSIZE + END DO + CALL MUMPS_733(PE, max(NEW_LOCNNZ+2*NROWS_LOC,1), id%INFO, + & LP, STRING='B_L_G:PE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rrpe2:',MEMCNT,MAXMEM +#endif + RCVPNT = 1 + SNDCNT = 0 + TIDX = 0 + DO I=1, id%NZ_loc + IF(mod(I,BUFSIZE/10) .EQ. 0) THEN + CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, MPI_COMM_WORLD, + & FLAG, STATUS, IERR ) + IF(FLAG) THEN + SOURCE = STATUS(MPI_SOURCE) + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, SOURCE, + & ITAG, MPI_COMM_WORLD, STATUS, IERR) + CALL DMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + RCVPNT = RCVPNT + BUFSIZE + END IF + END IF + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + PROC = MAPTAB(id%IRN_loc(I)) + IF(PROC .EQ. 0) THEN + TIDX = TIDX+1 + TSENDI(TIDX) = id%IRN_loc(I) + TSENDJ(TIDX) = id%JCN_loc(I) + ELSE + IIDX = ord%PERMTAB(id%IRN_loc(I)) + JJDX = ord%PERMTAB(id%JCN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) =IIDX-ord%FIRST(PROC)+1 + IF( (JJDX .GE. ord%FIRST(PROC)) .AND. + & (JJDX .LE. ord%LAST(PROC)) ) THEN + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = JJDX-ord%FIRST(PROC)+1 + ELSE + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = -id%JCN_loc(I) + END IF + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL DMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, + & PE, LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + END IF + PROC = MAPTAB(id%JCN_loc(I)) + IF(PROC .EQ. 0) THEN + TIDX = TIDX+1 + TSENDI(TIDX) = id%JCN_loc(I) + TSENDJ(TIDX) = id%IRN_loc(I) + ELSE + IIDX = ord%PERMTAB(id%JCN_loc(I)) + JJDX = ord%PERMTAB(id%IRN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) = IIDX-ord%FIRST(PROC)+1 + IF( (JJDX .GE. ord%FIRST(PROC)) .AND. + & (JJDX .LE. ord%LAST(PROC)) ) THEN + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = JJDX-ord%FIRST(PROC)+1 + ELSE + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = -id%IRN_loc(I) + END IF + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL DMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, + & LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + END IF + END IF + END DO + CALL DMUMPS_785(APNT, -1, NPROCS, BUFSIZE, IPE, PE, LENG, + & RCVBUF, MSGCNT, SNDCNT, id%COMM) + DUPS = 0 + PNT = 0 + SAVEPNT = 1 + MAPTAB(:) = 0 + HALO_MAP(:) = 0 + HALO_SIZE = 0 + DO I=1, NROWS_LOC + DO J=IPE(I),IPE(I+1)-1 + IF(PE(J) .LT. 0) THEN + IF(HALO_MAP(-PE(J)) .EQ. 0) THEN + HALO_SIZE = HALO_SIZE+1 + HALO_MAP(-PE(J)) = NROWS_LOC+HALO_SIZE + END IF + PE(J) = HALO_MAP(-PE(J)) + END IF + IF(MAPTAB(PE(J)) .EQ. I) THEN + DUPS = DUPS+1 + LENG(I) = LENG(I)-1 + ELSE + MAPTAB(PE(J)) = I + PNT = PNT+1 + PE(PNT) = PE(J) + END IF + END DO + IPE(I) = SAVEPNT + SAVEPNT = PNT+1 + END DO + IPE(NROWS_LOC+1) = SAVEPNT + CALL MUMPS_733(I_HALO_MAP, HALO_SIZE, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT i_halo:',MEMCNT,MAXMEM +#endif + J=0 + DO I=1, id%N + IF(HALO_MAP(I) .GT. 0) THEN + J = J+1 + I_HALO_MAP(HALO_MAP(I)-NROWS_LOC) = I + END IF + IF(J .EQ. HALO_SIZE) EXIT + END DO + CALL MUMPS_733(LENG, max(NROWS_LOC+HALO_SIZE,1), id%INFO, + & LP, COPY=.TRUE., + & STRING='lcgrph:leng', MEMCNT=MEMCNT, ERRCODE=-7) + LENG(NROWS_LOC+1:NROWS_LOC+HALO_SIZE) = 0 + CALL MUMPS_733(IPE, NROWS_LOC+HALO_SIZE+1, id%INFO, + & LP, COPY=.TRUE., + & STRING='lcgrph:ipe', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT lengipe:',MEMCNT, + & MAXMEM +#endif + IPE(NROWS_LOC+2:NROWS_LOC+HALO_SIZE+1) = IPE(NROWS_LOC+1) + GSIZE = NROWS_LOC + HALO_SIZE + CALL MPI_GATHER(TOP_CNT, 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, 0, id%COMM, IERR) + RDISPL => MSGCNT + NULLIFY(MSGCNT) + IF(MYID.EQ.0) THEN + NEW_LOCNNZ = sum(RCVCNT) + RDISPL(1) = 0 + DO I=2, NPROCS + RDISPL(I) = RDISPL(I-1)+RCVCNT(I-1) + END DO + top_graph%NZ_LOC = NEW_LOCNNZ + top_graph%COMM = id%COMM + CALL MUMPS_733(top_graph%IRN_LOC, NEW_LOCNNZ, id%INFO, + & LP, MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(top_graph%JCN_LOC, NEW_LOCNNZ, id%INFO, + & LP, MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT top_graph:',MEMCNT, + & MAXMEM +#endif + ELSE + ALLOCATE(top_graph%IRN_LOC(1), top_graph%JCN_LOC(1)) + END IF + CALL MPI_GATHERV(TSENDI(1), TOP_CNT, MPI_INTEGER, + & top_graph%IRN_LOC(1), RCVCNT(1), RDISPL(1), MPI_INTEGER, + & 0, id%COMM, IERR) + CALL MPI_GATHERV(TSENDJ(1), TOP_CNT, MPI_INTEGER, + & top_graph%JCN_LOC(1), RCVCNT(1), RDISPL(1), MPI_INTEGER, + & 0, id%COMM, IERR) + CALL MUMPS_734(SNDCNT, RCVCNT, RDISPL, + & TSENDI, TSENDJ, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall sndcnt:',MEMCNT,MAXMEM +#endif + DEALLOCATE(APNT) + RETURN + END SUBROUTINE DMUMPS_775 + SUBROUTINE DMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, + & LENG, RCVBUF, MSGCNT, SNDCNT, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER :: NPROCS, PROC, COMM + TYPE(ARRPNT) :: APNT(:) + INTEGER :: BUFSIZE + INTEGER, POINTER :: RCVBUF(:), LENG(:), PE(:), IPE(:) + INTEGER :: MSGCNT(:), SNDCNT(:) + LOGICAL, SAVE :: INIT = .TRUE. + INTEGER, POINTER, SAVE :: SPACE(:,:,:) + LOGICAL, POINTER, SAVE :: PENDING(:) + INTEGER, POINTER, SAVE :: REQ(:), CPNT(:) + INTEGER :: IERR, MYID, I, SOURCE, TOTMSG + LOGICAL :: FLAG, TFLAG + INTEGER :: STATUS(MPI_STATUS_SIZE), + & TSTATUS(MPI_STATUS_SIZE) + INTEGER, PARAMETER :: ITAG=30, FTAG=31 + INTEGER, POINTER :: TMPI(:), RCVCNT(:) + CALL MPI_COMM_RANK (COMM, MYID, IERR) + CALL MPI_COMM_SIZE (COMM, NPROCS, IERR) + IF(INIT) THEN + ALLOCATE(SPACE(2*BUFSIZE, 2, NPROCS)) + ALLOCATE(RCVBUF(2*BUFSIZE)) + ALLOCATE(PENDING(NPROCS), CPNT(NPROCS)) + ALLOCATE(REQ(NPROCS)) + PENDING = .FALSE. + DO I=1, NPROCS + APNT(I)%BUF => SPACE(:,1,I) + CPNT(I) = 1 + END DO + INIT = .FALSE. + RETURN + END IF + IF(PROC .EQ. -1) THEN + TOTMSG = sum(MSGCNT) + DO + IF(TOTMSG .EQ. 0) EXIT + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, + & MPI_ANY_SOURCE, ITAG, COMM, STATUS, IERR) + CALL DMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) + SOURCE = STATUS(MPI_SOURCE) + TOTMSG = TOTMSG-1 + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + END DO + DO I=1, NPROCS + IF(PENDING(I)) THEN + CALL MPI_WAIT(REQ(I), TSTATUS, IERR) + END IF + END DO + ALLOCATE(RCVCNT(NPROCS)) + CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, COMM, IERR) + DO I=1, NPROCS + IF(SNDCNT(I) .GT. 0) THEN + TMPI => APNT(I)%BUF(:) + CALL MPI_ISEND(TMPI(1), 2*SNDCNT(I), MPI_INTEGER, I-1, + & FTAG, COMM, REQ(I), IERR) + END IF + END DO + DO I=1, NPROCS + IF(RCVCNT(I) .GT. 0) THEN + CALL MPI_RECV(RCVBUF(1), 2*RCVCNT(I), MPI_INTEGER, I-1, + & FTAG, COMM, STATUS, IERR) + CALL DMUMPS_773(RCVCNT(I), RCVBUF, + & IPE, PE, LENG) + END IF + END DO + DO I=1, NPROCS + IF(SNDCNT(I) .GT. 0) THEN + CALL MPI_WAIT(REQ(I), TSTATUS, IERR) + END IF + END DO + DEALLOCATE(SPACE) + DEALLOCATE(PENDING, CPNT) + DEALLOCATE(REQ) + DEALLOCATE(RCVBUF, RCVCNT) + nullify(SPACE, PENDING, CPNT, REQ, RCVBUF, RCVCNT) + INIT = .TRUE. + RETURN + END IF + IF(PENDING(PROC)) THEN + DO + CALL MPI_TEST(REQ(PROC), TFLAG, TSTATUS, IERR) + IF(TFLAG) THEN + PENDING(PROC) = .FALSE. + EXIT + ELSE + CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, COMM, + & FLAG, STATUS, IERR ) + IF(FLAG) THEN + SOURCE = STATUS(MPI_SOURCE) + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, + & SOURCE, ITAG, COMM, STATUS, IERR) + CALL DMUMPS_773(BUFSIZE, RCVBUF, IPE, + & PE, LENG) + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + END IF + END IF + END DO + END IF + TMPI => APNT(PROC)%BUF(:) + CALL MPI_ISEND(TMPI(1), 2*BUFSIZE, MPI_INTEGER, PROC-1, + & ITAG, COMM, REQ(PROC), IERR) + PENDING(PROC) = .TRUE. + CPNT(PROC) = mod(CPNT(PROC),2)+1 + APNT(PROC)%BUF => SPACE(:,CPNT(PROC),PROC) + SNDCNT(PROC) = 0 + RETURN + END SUBROUTINE DMUMPS_785 + SUBROUTINE DMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) +#ifdef MPELOG + USE MPEMOD + INCLUDE 'mpif.h' +#endif + IMPLICIT NONE + INTEGER :: BUFSIZE + INTEGER, POINTER :: RCVBUF(:), IPE(:), PE(:), LENG(:) + INTEGER :: I, ROW, COL +#ifdef MPELOG + INTEGER ::IERR + IERR = MPE_LOG_EVENT( MPE_ASM_BUF1, 0, '' ) +#endif + DO I=1, 2*BUFSIZE, 2 + ROW = RCVBUF(I) + COL = RCVBUF(I+1) + PE(IPE(ROW)+LENG(ROW)) = COL + LENG(ROW) = LENG(ROW) + 1 + END DO +#ifdef MPELOG + IERR = MPE_LOG_EVENT( MPE_ASM_BUF2, 0, '' ) +#endif + RETURN + END SUBROUTINE DMUMPS_773 + SUBROUTINE DMUMPS_777(ord) + TYPE(ORD_TYPE) :: ord + INTEGER :: I + ord%SON = -1 + ord%BROTHER = -1 + ord%NW = 0 + DO I=1, ord%CBLKNBR + ord%NW(I) = ord%NW(I)+ord%RANGTAB(I+1) - ord%RANGTAB(I) + IF (ord%TREETAB(I) .NE. -1) THEN + IF (ord%SON(ord%TREETAB(I)) .EQ. -1) THEN + ord%SON(ord%TREETAB(I)) = I + ELSE + ord%BROTHER(I) = ord%SON(ord%TREETAB(I)) + ord%SON(ord%TREETAB(I)) = I + END IF + ord%NW(ord%TREETAB(I)) = ord%NW(ord%TREETAB(I))+ ord%NW(I) + END IF + END DO + RETURN + END SUBROUTINE DMUMPS_777 + SUBROUTINE DMUMPS_784(N, L, A1, A2) + INTEGER :: I, LP, ISWAP, N + INTEGER :: L(0:), A1(:), A2(:) + LP = L(0) + I = 1 + DO + IF ((LP==0).OR.(I>N)) EXIT + DO + IF (LP >= I) EXIT + LP = L(LP) + END DO + ISWAP = A1(LP) + A1(LP) = A1(I) + A1(I) = ISWAP + ISWAP = A2(LP) + A2(LP) = A2(I) + A2(I) = ISWAP + ISWAP = L(LP) + L(LP) = L(I) + L(I) = LP + LP = ISWAP + I = I + 1 + ENDDO + END SUBROUTINE DMUMPS_784 + SUBROUTINE DMUMPS_783(N, K, L) + INTEGER :: N + INTEGER :: K(:), L(0:) + INTEGER :: P, Q, S, T + CONTINUE + L(0) = 1 + T = N + 1 + DO P = 1,N - 1 + IF (K(P) <= K(P+1)) THEN + L(P) = P + 1 + ELSE + L(T) = - (P+1) + T = P + END IF + END DO + L(T) = 0 + L(N) = 0 + IF (L(N+1) == 0) THEN + RETURN + ELSE + L(N+1) = iabs(L(N+1)) + END IF + 200 CONTINUE + S = 0 + T = N+1 + P = L(S) + Q = L(T) + IF(Q .EQ. 0) RETURN + 300 CONTINUE + IF(K(P) .GT. K(Q)) GOTO 600 + CONTINUE + L(S) = sign(P,L(S)) + S = P + P = L(P) + IF (P .GT. 0) GOTO 300 + CONTINUE + L(S) = Q + S = T + DO + T = Q + Q = L(Q) + IF (Q .LE. 0) EXIT + END DO + GOTO 800 + 600 CONTINUE + L(S) = sign(Q, L(S)) + S = Q + Q = L(Q) + IF (Q .GT. 0) GOTO 300 + CONTINUE + L(S) = P + S = T + DO + T = P + P = L(P) + IF (P .LE. 0) EXIT + END DO + 800 CONTINUE + P = -P + Q = -Q + IF(Q.EQ.0) THEN + L(S) = sign(P, L(S)) + L(T) = 0 + GOTO 200 + END IF + GOTO 300 + END SUBROUTINE DMUMPS_783 + FUNCTION MUMPS_795(A) + INTEGER, POINTER :: A(:) + INTEGER :: MUMPS_795 + IF(associated(A)) THEN + MUMPS_795 = size(A) + ELSE + MUMPS_795 = 0 + END IF + RETURN + END FUNCTION MUMPS_795 + SUBROUTINE MUMPS_734(A1, A2, A3, A4, A5, A6, A7, MEMCNT) + INTEGER, POINTER :: A1(:) + INTEGER, POINTER, OPTIONAL :: A2(:), A3(:), A4(:), A5(:), + & A6(:), A7(:) + INTEGER, OPTIONAL :: MEMCNT + INTEGER :: IMEMCNT + IMEMCNT = 0 + IF(associated(A1)) THEN + IMEMCNT = IMEMCNT+size(A1) + DEALLOCATE(A1) + END IF + IF(present(A2)) THEN + IF(associated(A2)) THEN + IMEMCNT = IMEMCNT+size(A2) + DEALLOCATE(A2) + END IF + END IF + IF(present(A3)) THEN + IF(associated(A3)) THEN + IMEMCNT = IMEMCNT+size(A3) + DEALLOCATE(A3) + END IF + END IF + IF(present(A4)) THEN + IF(associated(A4)) THEN + IMEMCNT = IMEMCNT+size(A4) + DEALLOCATE(A4) + END IF + END IF + IF(present(A5)) THEN + IF(associated(A5)) THEN + IMEMCNT = IMEMCNT+size(A5) + DEALLOCATE(A5) + END IF + END IF + IF(present(A6)) THEN + IF(associated(A6)) THEN + IMEMCNT = IMEMCNT+size(A6) + DEALLOCATE(A6) + END IF + END IF + IF(present(A7)) THEN + IF(associated(A7)) THEN + IMEMCNT = IMEMCNT+size(A7) + DEALLOCATE(A7) + END IF + END IF + IF(present(MEMCNT)) MEMCNT = MEMCNT-IMEMCNT + RETURN + END SUBROUTINE MUMPS_734 +#if defined(memprof) + FUNCTION ESTIMEM(MYID, N, NZR) + INTEGER :: ESTIMEM, MYID, NZR, N + IF(MYID.EQ.0) THEN + ESTIMEM = 12*N + ELSE + ESTIMEM = 7*N + END IF + IF(MYID.NE.0) TOPROWS=0 + IF(MYID .EQ. 0) ESTIMEM = ESTIMEM+2*TOPROWS*NZR + ESTIMEM = ESTIMEM+NRL + ESTIMEM = ESTIMEM+max(NRL,TOPROWS)*(NZR+2) + ESTIMEM = ESTIMEM+6*max(NRL,TOPROWS) + IF(MYID.EQ.0) ESTIMEM=ESTIMEM+3*TOPROWS + RETURN + END FUNCTION ESTIMEM +#endif + END MODULE + SUBROUTINE DMUMPS_448(ICNTL,CNTL) + IMPLICIT NONE + INTEGER NICNTL, NCNTL + PARAMETER (NICNTL=10, NCNTL=10) + INTEGER ICNTL(NICNTL) + DOUBLE PRECISION CNTL(NCNTL) + INTEGER I + ICNTL(1) = 6 + ICNTL(2) = 6 + ICNTL(3) = -1 + ICNTL(4) = -1 + ICNTL(5) = 0 + DO 10 I = 6,NICNTL + ICNTL(I) = 0 + 10 CONTINUE + CNTL(1) = 0.0D0 + CNTL(2) = 0.0D0 + DO 20 I = 3,NCNTL + CNTL(I) = 0.0D0 + 20 CONTINUE + RETURN + END SUBROUTINE DMUMPS_448 + SUBROUTINE DMUMPS_444 + & (M,N,NE,IP,IRN,A,IPERM,NUM,JPERM,PR,Q,L,D,RINF) + IMPLICIT NONE + INTEGER M,N,NE,NUM + INTEGER IP(N+1),IRN(NE),IPERM(M),JPERM(N),PR(N),Q(M),L(M) + DOUBLE PRECISION A(NE) + DOUBLE PRECISION D(M), RINF + INTEGER I,II,J,JJ,JORD,Q0,QLEN,IDUM,JDUM,ISP,JSP, + & K,KK,KK1,KK2,I0,UP,LOW + DOUBLE PRECISION CSP,DI,DNEW,DQ0,AI,A0,BV,TBV,RLX + DOUBLE PRECISION ZERO,MINONE,ONE + PARAMETER (ZERO=0.0D0,MINONE=-1.0D0,ONE=1.0D0) + INTRINSIC abs,min + EXTERNAL DMUMPS_445, DMUMPS_446, DMUMPS_447, DMUMPS_455 + RLX = D(1) + NUM = 0 + BV = RINF + DO 10 K = 1,N + JPERM(K) = 0 + PR(K) = IP(K) + 10 CONTINUE + DO 12 K = 1,M + IPERM(K) = 0 + D(K) = ZERO + 12 CONTINUE + DO 30 J = 1,N + A0 = MINONE + DO 20 K = IP(J),IP(J+1)-1 + I = IRN(K) + AI = abs(A(K)) + IF (AI.GT.D(I)) D(I) = AI + IF (JPERM(J).NE.0) GO TO 20 + IF (AI.GE.BV) THEN + A0 = BV + IF (IPERM(I).NE.0) GO TO 20 + JPERM(J) = I + IPERM(I) = J + NUM = NUM + 1 + ELSE + IF (AI.LE.A0) GO TO 20 + A0 = AI + I0 = I + ENDIF + 20 CONTINUE + IF (A0.NE.MINONE .AND. A0.LT.BV) THEN + BV = A0 + IF (IPERM(I0).NE.0) GO TO 30 + IPERM(I0) = J + JPERM(J) = I0 + NUM = NUM + 1 + ENDIF + 30 CONTINUE + IF (M.EQ.N) THEN + DO 35 I = 1,M + BV = min(BV,D(I)) + 35 CONTINUE + ENDIF + IF (NUM.EQ.N) GO TO 1000 + DO 95 J = 1,N + IF (JPERM(J).NE.0) GO TO 95 + DO 50 K = IP(J),IP(J+1)-1 + I = IRN(K) + AI = abs(A(K)) + IF (AI.LT.BV) GO TO 50 + IF (IPERM(I).EQ.0) GO TO 90 + JJ = IPERM(I) + KK1 = PR(JJ) + KK2 = IP(JJ+1) - 1 + IF (KK1.GT.KK2) GO TO 50 + DO 70 KK = KK1,KK2 + II = IRN(KK) + IF (IPERM(II).NE.0) GO TO 70 + IF (abs(A(KK)).GE.BV) GO TO 80 + 70 CONTINUE + PR(JJ) = KK2 + 1 + 50 CONTINUE + GO TO 95 + 80 JPERM(JJ) = II + IPERM(II) = JJ + PR(JJ) = KK + 1 + 90 NUM = NUM + 1 + JPERM(J) = I + IPERM(I) = J + PR(J) = K + 1 + 95 CONTINUE + IF (NUM.EQ.N) GO TO 1000 + DO 99 I = 1,M + D(I) = MINONE + L(I) = 0 + 99 CONTINUE + TBV = BV * (ONE-RLX) + DO 100 JORD = 1,N + IF (JPERM(JORD).NE.0) GO TO 100 + QLEN = 0 + LOW = M + 1 + UP = M + 1 + CSP = MINONE + J = JORD + PR(J) = -1 + DO 115 K = IP(J),IP(J+1)-1 + I = IRN(K) + DNEW = abs(A(K)) + IF (CSP.GE.DNEW) GO TO 115 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = I + JSP = J + IF (CSP.GE.TBV) GO TO 160 + ELSE + D(I) = DNEW + IF (DNEW.GE.TBV) THEN + LOW = LOW - 1 + Q(LOW) = I + ELSE + QLEN = QLEN + 1 + L(I) = QLEN + CALL DMUMPS_445(I,M,Q,D,L,1) + ENDIF + JJ = IPERM(I) + PR(JJ) = J + ENDIF + 115 CONTINUE + DO 150 JDUM = 1,NUM + IF (LOW.EQ.UP) THEN + IF (QLEN.EQ.0) GO TO 160 + I = Q(1) + IF (CSP.GE.D(I)) GO TO 160 + BV = D(I) + TBV = BV * (ONE-RLX) + DO 152 IDUM = 1,M + CALL DMUMPS_446(QLEN,M,Q,D,L,1) + L(I) = 0 + LOW = LOW - 1 + Q(LOW) = I + IF (QLEN.EQ.0) GO TO 153 + I = Q(1) + IF (D(I).LT.TBV) GO TO 153 + 152 CONTINUE + ENDIF + 153 UP = UP - 1 + Q0 = Q(UP) + DQ0 = D(Q0) + L(Q0) = UP + J = IPERM(Q0) + DO 155 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (L(I).GE.UP) GO TO 155 + DNEW = min(DQ0,abs(A(K))) + IF (CSP.GE.DNEW) GO TO 155 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = I + JSP = J + IF (CSP.GE.TBV) GO TO 160 + ELSE + DI = D(I) + IF (DI.GE.TBV .OR. DI.GE.DNEW) GO TO 155 + D(I) = DNEW + IF (DNEW.GE.TBV) THEN + IF (DI.NE.MINONE) THEN + CALL DMUMPS_447(L(I),QLEN,M,Q,D,L,1) + ENDIF + L(I) = 0 + LOW = LOW - 1 + Q(LOW) = I + ELSE + IF (DI.EQ.MINONE) THEN + QLEN = QLEN + 1 + L(I) = QLEN + ENDIF + CALL DMUMPS_445(I,M,Q,D,L,1) + ENDIF + JJ = IPERM(I) + PR(JJ) = J + ENDIF + 155 CONTINUE + 150 CONTINUE + 160 IF (CSP.EQ.MINONE) GO TO 190 + BV = min(BV,CSP) + TBV = BV * (ONE-RLX) + NUM = NUM + 1 + I = ISP + J = JSP + DO 170 JDUM = 1,NUM+1 + I0 = JPERM(J) + JPERM(J) = I + IPERM(I) = J + J = PR(J) + IF (J.EQ.-1) GO TO 190 + I = I0 + 170 CONTINUE + 190 DO 191 KK = UP,M + I = Q(KK) + D(I) = MINONE + L(I) = 0 + 191 CONTINUE + DO 192 KK = LOW,UP-1 + I = Q(KK) + D(I) = MINONE + 192 CONTINUE + DO 193 KK = 1,QLEN + I = Q(KK) + D(I) = MINONE + L(I) = 0 + 193 CONTINUE + 100 CONTINUE + 1000 IF (M.EQ.N .and. NUM.EQ.N) GO TO 2000 + CALL DMUMPS_455(M,N,IPERM,L,JPERM) + 2000 RETURN + END SUBROUTINE DMUMPS_444 + SUBROUTINE DMUMPS_445(I,N,Q,D,L,IWAY) + IMPLICIT NONE + INTEGER I,N,IWAY + INTEGER Q(N),L(N) + DOUBLE PRECISION D(N) + INTEGER IDUM,K,POS,POSK,QK + PARAMETER (K=2) + DOUBLE PRECISION DI + POS = L(I) + IF (POS.LE.1) GO TO 20 + DI = D(I) + IF (IWAY.EQ.1) THEN + DO 10 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.LE.D(QK)) GO TO 20 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 20 + 10 CONTINUE + ELSE + DO 15 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.GE.D(QK)) GO TO 20 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 20 + 15 CONTINUE + ENDIF + 20 Q(POS) = I + L(I) = POS + RETURN + END SUBROUTINE DMUMPS_445 + SUBROUTINE DMUMPS_446(QLEN,N,Q,D,L,IWAY) + IMPLICIT NONE + INTEGER QLEN,N,IWAY + INTEGER Q(N),L(N) + DOUBLE PRECISION D(N) + INTEGER I,IDUM,K,POS,POSK + PARAMETER (K=2) + DOUBLE PRECISION DK,DR,DI + I = Q(QLEN) + DI = D(I) + QLEN = QLEN - 1 + POS = 1 + IF (IWAY.EQ.1) THEN + DO 10 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 20 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.LT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.GE.DK) GO TO 20 + Q(POS) = Q(POSK) + L(Q(POS)) = POS + POS = POSK + 10 CONTINUE + ELSE + DO 15 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 20 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.GT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.LE.DK) GO TO 20 + Q(POS) = Q(POSK) + L(Q(POS)) = POS + POS = POSK + 15 CONTINUE + ENDIF + 20 Q(POS) = I + L(I) = POS + RETURN + END SUBROUTINE DMUMPS_446 + SUBROUTINE DMUMPS_447(POS0,QLEN,N,Q,D,L,IWAY) + IMPLICIT NONE + INTEGER POS0,QLEN,N,IWAY + INTEGER Q(N),L(N) + DOUBLE PRECISION D(N) + INTEGER I,IDUM,K,POS,POSK,QK + PARAMETER (K=2) + DOUBLE PRECISION DK,DR,DI + IF (QLEN.EQ.POS0) THEN + QLEN = QLEN - 1 + RETURN + ENDIF + I = Q(QLEN) + DI = D(I) + QLEN = QLEN - 1 + POS = POS0 + IF (IWAY.EQ.1) THEN + IF (POS.LE.1) GO TO 20 + DO 10 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.LE.D(QK)) GO TO 20 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 20 + 10 CONTINUE + 20 Q(POS) = I + L(I) = POS + IF (POS.NE.POS0) RETURN + DO 30 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 40 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.LT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.GE.DK) GO TO 40 + QK = Q(POSK) + Q(POS) = QK + L(QK) = POS + POS = POSK + 30 CONTINUE + ELSE + IF (POS.LE.1) GO TO 34 + DO 32 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.GE.D(QK)) GO TO 34 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 34 + 32 CONTINUE + 34 Q(POS) = I + L(I) = POS + IF (POS.NE.POS0) RETURN + DO 36 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 40 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.GT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.LE.DK) GO TO 40 + QK = Q(POSK) + Q(POS) = QK + L(QK) = POS + POS = POSK + 36 CONTINUE + ENDIF + 40 Q(POS) = I + L(I) = POS + RETURN + END SUBROUTINE DMUMPS_447 + SUBROUTINE DMUMPS_450(IP,LENL,LENH,W,WLEN,A,NVAL,VAL) + IMPLICIT NONE + INTEGER WLEN,NVAL + INTEGER IP(*),LENL(*),LENH(*),W(*) + DOUBLE PRECISION A(*),VAL + INTEGER XX,J,K,II,S,POS + PARAMETER (XX=10) + DOUBLE PRECISION SPLIT(XX),HA + NVAL = 0 + DO 10 K = 1,WLEN + J = W(K) + DO 15 II = IP(J)+LENL(J),IP(J)+LENH(J)-1 + HA = A(II) + IF (NVAL.EQ.0) THEN + SPLIT(1) = HA + NVAL = 1 + ELSE + DO 20 S = NVAL,1,-1 + IF (SPLIT(S).EQ.HA) GO TO 15 + IF (SPLIT(S).GT.HA) THEN + POS = S + 1 + GO TO 21 + ENDIF + 20 CONTINUE + POS = 1 + 21 DO 22 S = NVAL,POS,-1 + SPLIT(S+1) = SPLIT(S) + 22 CONTINUE + SPLIT(POS) = HA + NVAL = NVAL + 1 + ENDIF + IF (NVAL.EQ.XX) GO TO 11 + 15 CONTINUE + 10 CONTINUE + 11 IF (NVAL.GT.0) VAL = SPLIT((NVAL+1)/2) + RETURN + END SUBROUTINE DMUMPS_450 + SUBROUTINE DMUMPS_451(N,NE,IP,IRN,A) + IMPLICIT NONE + INTEGER N,NE + INTEGER IP(N+1),IRN(NE) + DOUBLE PRECISION A(NE) + INTEGER THRESH,TDLEN + PARAMETER (THRESH=15,TDLEN=50) + INTEGER J,IPJ,K,LEN,R,S,HI,FIRST,MID,LAST,TD + DOUBLE PRECISION HA,KEY + INTEGER TODO(TDLEN) + DO 100 J = 1,N + LEN = IP(J+1) - IP(J) + IF (LEN.LE.1) GO TO 100 + IPJ = IP(J) + IF (LEN.LT.THRESH) GO TO 400 + TODO(1) = IPJ + TODO(2) = IPJ + LEN + TD = 2 + 500 CONTINUE + FIRST = TODO(TD-1) + LAST = TODO(TD) + KEY = A((FIRST+LAST)/2) + DO 475 K = FIRST,LAST-1 + HA = A(K) + IF (HA.EQ.KEY) GO TO 475 + IF (HA.GT.KEY) GO TO 470 + KEY = HA + GO TO 470 + 475 CONTINUE + TD = TD - 2 + GO TO 425 + 470 MID = FIRST + DO 450 K = FIRST,LAST-1 + IF (A(K).LE.KEY) GO TO 450 + HA = A(MID) + A(MID) = A(K) + A(K) = HA + HI = IRN(MID) + IRN(MID) = IRN(K) + IRN(K) = HI + MID = MID + 1 + 450 CONTINUE + IF (MID-FIRST.GE.LAST-MID) THEN + TODO(TD+2) = LAST + TODO(TD+1) = MID + TODO(TD) = MID + ELSE + TODO(TD+2) = MID + TODO(TD+1) = FIRST + TODO(TD) = LAST + TODO(TD-1) = MID + ENDIF + TD = TD + 2 + 425 CONTINUE + IF (TD.EQ.0) GO TO 400 + IF (TODO(TD)-TODO(TD-1).GE.THRESH) GO TO 500 + TD = TD - 2 + GO TO 425 + 400 DO 200 R = IPJ+1,IPJ+LEN-1 + IF (A(R-1) .LT. A(R)) THEN + HA = A(R) + HI = IRN(R) + A(R) = A(R-1) + IRN(R) = IRN(R-1) + DO 300 S = R-1,IPJ+1,-1 + IF (A(S-1) .LT. HA) THEN + A(S) = A(S-1) + IRN(S) = IRN(S-1) + ELSE + A(S) = HA + IRN(S) = HI + GO TO 200 + END IF + 300 CONTINUE + A(IPJ) = HA + IRN(IPJ) = HI + END IF + 200 CONTINUE + 100 CONTINUE + RETURN + END SUBROUTINE DMUMPS_451 + SUBROUTINE DMUMPS_452(M,N,NE,IP,IRN,A,IPERM,NUMX, + & W,LEN,LENL,LENH,FC,IW,IW4,RLX,RINF) + IMPLICIT NONE + INTEGER M,N,NE,NUMX + INTEGER IP(N+1),IRN(NE),IPERM(N), + & W(N),LEN(N),LENL(N),LENH(N),FC(N),IW(M),IW4(3*N+M) + DOUBLE PRECISION A(NE),RLX,RINF + INTEGER NUM,NVAL,WLEN,II,I,J,K,L,CNT,MOD,IDUM1,IDUM2,IDUM3 + DOUBLE PRECISION BVAL,BMIN,BMAX + EXTERNAL DMUMPS_450,DMUMPS_453,DMUMPS_455 + DO 20 J = 1,N + FC(J) = J + LEN(J) = IP(J+1) - IP(J) + 20 CONTINUE + DO 21 I = 1,M + IW(I) = 0 + 21 CONTINUE + CNT = 1 + MOD = 1 + NUMX = 0 + CALL DMUMPS_453(CNT,MOD,M,N,IRN,NE,IP,LEN,FC,IW,NUMX,N, + & IW4(1),IW4(N+1),IW4(2*N+1),IW4(2*N+M+1)) + NUM = NUMX + IF (NUM.NE.N) THEN + BMAX = RINF + ELSE + BMAX = RINF + DO 30 J = 1,N + BVAL = 0.0D0 + DO 25 K = IP(J),IP(J+1)-1 + IF (A(K).GT.BVAL) BVAL = A(K) + 25 CONTINUE + IF (BVAL.LT.BMAX) BMAX = BVAL + 30 CONTINUE + BMAX = 1.001D0 * BMAX + ENDIF + BVAL = 0.0D0 + BMIN = 0.0D0 + WLEN = 0 + DO 48 J = 1,N + L = IP(J+1) - IP(J) + LENH(J) = L + LEN(J) = L + DO 45 K = IP(J),IP(J+1)-1 + IF (A(K).LT.BMAX) GO TO 46 + 45 CONTINUE + K = IP(J+1) + 46 LENL(J) = K - IP(J) + IF (LENL(J).EQ.L) GO TO 48 + WLEN = WLEN + 1 + W(WLEN) = J + 48 CONTINUE + DO 90 IDUM1 = 1,NE + IF (NUM.EQ.NUMX) THEN + DO 50 I = 1,M + IPERM(I) = IW(I) + 50 CONTINUE + DO 80 IDUM2 = 1,NE + BMIN = BVAL + IF (BMAX-BMIN .LE. RLX) GO TO 1000 + CALL DMUMPS_450(IP,LENL,LEN,W,WLEN,A,NVAL,BVAL) + IF (NVAL.LE.1) GO TO 1000 + K = 1 + DO 70 IDUM3 = 1,N + IF (K.GT.WLEN) GO TO 71 + J = W(K) + DO 55 II = IP(J)+LEN(J)-1,IP(J)+LENL(J),-1 + IF (A(II).GE.BVAL) GO TO 60 + I = IRN(II) + IF (IW(I).NE.J) GO TO 55 + IW(I) = 0 + NUM = NUM - 1 + FC(N-NUM) = J + 55 CONTINUE + 60 LENH(J) = LEN(J) + LEN(J) = II - IP(J) + 1 + IF (LENL(J).EQ.LENH(J)) THEN + W(K) = W(WLEN) + WLEN = WLEN - 1 + ELSE + K = K + 1 + ENDIF + 70 CONTINUE + 71 IF (NUM.LT.NUMX) GO TO 81 + 80 CONTINUE + 81 MOD = 1 + ELSE + BMAX = BVAL + IF (BMAX-BMIN .LE. RLX) GO TO 1000 + CALL DMUMPS_450(IP,LEN,LENH,W,WLEN,A,NVAL,BVAL) + IF (NVAL.EQ.0. OR. BVAL.EQ.BMIN) GO TO 1000 + K = 1 + DO 87 IDUM3 = 1,N + IF (K.GT.WLEN) GO TO 88 + J = W(K) + DO 85 II = IP(J)+LEN(J),IP(J)+LENH(J)-1 + IF (A(II).LT.BVAL) GO TO 86 + 85 CONTINUE + 86 LENL(J) = LEN(J) + LEN(J) = II - IP(J) + IF (LENL(J).EQ.LENH(J)) THEN + W(K) = W(WLEN) + WLEN = WLEN - 1 + ELSE + K = K + 1 + ENDIF + 87 CONTINUE + 88 MOD = 0 + ENDIF + CNT = CNT + 1 + CALL DMUMPS_453(CNT,MOD,M,N,IRN,NE,IP,LEN,FC,IW,NUM,NUMX, + & IW4(1),IW4(N+1),IW4(2*N+1),IW4(2*N+M+1)) + 90 CONTINUE + 1000 IF (M.EQ.N .and. NUMX.EQ.N) GO TO 2000 + CALL DMUMPS_455(M,N,IPERM,IW,W) + 2000 RETURN + END SUBROUTINE DMUMPS_452 + SUBROUTINE DMUMPS_453 + & (ID,MOD,M,N,IRN,LIRN,IP,LENC,FC,IPERM,NUM,NUMX, + & PR,ARP,CV,OUT) + IMPLICIT NONE + INTEGER ID,MOD,M,N,LIRN,NUM,NUMX + INTEGER ARP(N),CV(M),IRN(LIRN),IP(N), + & FC(N),IPERM(M),LENC(N),OUT(N),PR(N) + INTEGER I,II,IN1,IN2,J,J1,JORD,K,KK,LAST,NFC, + & NUM0,NUM1,NUM2,ID0,ID1 + IF (ID.EQ.1) THEN + DO 5 I = 1,M + CV(I) = 0 + 5 CONTINUE + DO 6 J = 1,N + ARP(J) = 0 + 6 CONTINUE + NUM1 = N + NUM2 = N + ELSE + IF (MOD.EQ.1) THEN + DO 8 J = 1,N + ARP(J) = 0 + 8 CONTINUE + ENDIF + NUM1 = NUMX + NUM2 = N - NUMX + ENDIF + NUM0 = NUM + NFC = 0 + ID0 = (ID-1)*N + DO 100 JORD = NUM0+1,N + ID1 = ID0 + JORD + J = FC(JORD-NUM0) + PR(J) = -1 + DO 70 K = 1,JORD + IF (ARP(J).GE.LENC(J)) GO TO 30 + IN1 = IP(J) + ARP(J) + IN2 = IP(J) + LENC(J) - 1 + DO 20 II = IN1,IN2 + I = IRN(II) + IF (IPERM(I).EQ.0) GO TO 80 + 20 CONTINUE + ARP(J) = LENC(J) + 30 OUT(J) = LENC(J) - 1 + DO 60 KK = 1,JORD + IN1 = OUT(J) + IF (IN1.LT.0) GO TO 50 + IN2 = IP(J) + LENC(J) - 1 + IN1 = IN2 - IN1 + DO 40 II = IN1,IN2 + I = IRN(II) + IF (CV(I).EQ.ID1) GO TO 40 + J1 = J + J = IPERM(I) + CV(I) = ID1 + PR(J) = J1 + OUT(J1) = IN2 - II - 1 + GO TO 70 + 40 CONTINUE + 50 J1 = PR(J) + IF (J1.EQ.-1) THEN + NFC = NFC + 1 + FC(NFC) = J + IF (NFC.GT.NUM2) THEN + LAST = JORD + GO TO 101 + ENDIF + GO TO 100 + ENDIF + J = J1 + 60 CONTINUE + 70 CONTINUE + 80 IPERM(I) = J + ARP(J) = II - IP(J) + 1 + NUM = NUM + 1 + DO 90 K = 1,JORD + J = PR(J) + IF (J.EQ.-1) GO TO 95 + II = IP(J) + LENC(J) - OUT(J) - 2 + I = IRN(II) + IPERM(I) = J + 90 CONTINUE + 95 IF (NUM.EQ.NUM1) THEN + LAST = JORD + GO TO 101 + ENDIF + 100 CONTINUE + LAST = N + 101 DO 110 JORD = LAST+1,N + NFC = NFC + 1 + FC(NFC) = FC(JORD-NUM0) + 110 CONTINUE + RETURN + END SUBROUTINE DMUMPS_453 + SUBROUTINE DMUMPS_454(M,N,NE,IP,IRN,A,IPERM,NUM, + & JPERM,OUT,PR,Q,L,U,D,RINF) + IMPLICIT NONE + INTEGER M,N,NE,NUM + INTEGER IP(N+1),IRN(NE),IPERM(M),JPERM(N),OUT(N),PR(N),Q(M),L(M) + DOUBLE PRECISION A(NE),U(M),D(M),RINF,RINF3 + INTEGER I,I0,II,J,JJ,JORD,Q0,QLEN,JDUM,ISP,JSP, + & K,K0,K1,K2,KK,KK1,KK2,UP,LOW + DOUBLE PRECISION CSP,DI,DMIN,DNEW,DQ0,VJ,RLX + LOGICAL LORD + DOUBLE PRECISION ZERO, ONE + PARAMETER (ZERO=0.0D0,ONE=1.0D0) + EXTERNAL DMUMPS_445, DMUMPS_446, DMUMPS_447, DMUMPS_455 + RLX = U(1) + RINF3 = U(2) + LORD = (JPERM(1).EQ.6) + NUM = 0 + DO 10 K = 1,N + JPERM(K) = 0 + PR(K) = IP(K) + D(K) = RINF + 10 CONTINUE + DO 15 K = 1,M + U(K) = RINF3 + IPERM(K) = 0 + L(K) = 0 + 15 CONTINUE + DO 30 J = 1,N + IF (IP(J+1)-IP(J) .GT. N/10 .AND. N.GT.50) GO TO 30 + DO 20 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (A(K).GT.U(I)) GO TO 20 + U(I) = A(K) + IPERM(I) = J + L(I) = K + 20 CONTINUE + 30 CONTINUE + DO 40 I = 1,M + J = IPERM(I) + IF (J.EQ.0) GO TO 40 + IF (JPERM(J).EQ.0) THEN + JPERM(J) = L(I) + D(J) = U(I) + NUM = NUM + 1 + ELSEIF (D(J).GT.U(I)) THEN + K = JPERM(J) + II = IRN(K) + IPERM(II) = 0 + JPERM(J) = L(I) + D(J) = U(I) + ELSE + IPERM(I) = 0 + ENDIF + 40 CONTINUE + IF (NUM.EQ.N) GO TO 1000 + DO 45 K = 1,M + D(K) = ZERO + 45 CONTINUE + DO 95 J = 1,N + IF (JPERM(J).NE.0) GO TO 95 + K1 = IP(J) + K2 = IP(J+1) - 1 + IF (K1.GT.K2) GO TO 95 + VJ = RINF + DO 50 K = K1,K2 + I = IRN(K) + DI = A(K) - U(I) + IF (DI.GT.VJ) GO TO 50 + IF (DI.LT.VJ .OR. DI.EQ.RINF) GO TO 55 + IF (IPERM(I).NE.0 .OR. IPERM(I0).EQ.0) GO TO 50 + 55 VJ = DI + I0 = I + K0 = K + 50 CONTINUE + D(J) = VJ + K = K0 + I = I0 + IF (IPERM(I).EQ.0) GO TO 90 + DO 60 K = K0,K2 + I = IRN(K) + IF (A(K)-U(I).GT.VJ) GO TO 60 + JJ = IPERM(I) + KK1 = PR(JJ) + KK2 = IP(JJ+1) - 1 + IF (KK1.GT.KK2) GO TO 60 + DO 70 KK = KK1,KK2 + II = IRN(KK) + IF (IPERM(II).GT.0) GO TO 70 + IF (A(KK)-U(II).LE.D(JJ)) GO TO 80 + 70 CONTINUE + PR(JJ) = KK2 + 1 + 60 CONTINUE + GO TO 95 + 80 JPERM(JJ) = KK + IPERM(II) = JJ + PR(JJ) = KK + 1 + 90 NUM = NUM + 1 + JPERM(J) = K + IPERM(I) = J + PR(J) = K + 1 + 95 CONTINUE + IF (NUM.EQ.N) GO TO 1000 + DO 99 I = 1,M + D(I) = RINF + L(I) = 0 + 99 CONTINUE + DO 100 JORD = 1,N + IF (JPERM(JORD).NE.0) GO TO 100 + DMIN = RINF + QLEN = 0 + LOW = M + 1 + UP = M + 1 + CSP = RINF + J = JORD + PR(J) = -1 + DO 115 K = IP(J),IP(J+1)-1 + I = IRN(K) + DNEW = A(K) - U(I) + IF (DNEW.GE.CSP) GO TO 115 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = K + JSP = J + ELSE + IF (DNEW.LT.DMIN) DMIN = DNEW + D(I) = DNEW + QLEN = QLEN + 1 + Q(QLEN) = K + ENDIF + 115 CONTINUE + Q0 = QLEN + QLEN = 0 + DO 120 KK = 1,Q0 + K = Q(KK) + I = IRN(K) + IF (CSP.LE.D(I)) THEN + D(I) = RINF + GO TO 120 + ENDIF + IF (D(I).LE.DMIN) THEN + LOW = LOW - 1 + Q(LOW) = I + L(I) = LOW + ELSE + QLEN = QLEN + 1 + L(I) = QLEN + CALL DMUMPS_445(I,M,Q,D,L,2) + ENDIF + JJ = IPERM(I) + OUT(JJ) = K + PR(JJ) = J + 120 CONTINUE + DO 150 JDUM = 1,NUM + IF (LOW.EQ.UP) THEN + IF (QLEN.EQ.0) GO TO 160 + I = Q(1) + IF (D(I).LT.RINF) DMIN = D(I)*(ONE+RLX) + IF (DMIN.GE.CSP) GO TO 160 + 152 CALL DMUMPS_446(QLEN,M,Q,D,L,2) + LOW = LOW - 1 + Q(LOW) = I + L(I) = LOW + IF (QLEN.EQ.0) GO TO 153 + I = Q(1) + IF (D(I).GT.DMIN) GO TO 153 + GO TO 152 + ENDIF + 153 Q0 = Q(UP-1) + DQ0 = D(Q0) + IF (DQ0.GE.CSP) GO TO 160 + IF (DMIN.GE.CSP) GO TO 160 + UP = UP - 1 + J = IPERM(Q0) + VJ = DQ0 - A(JPERM(J)) + U(Q0) + K1 = IP(J+1)-1 + IF (LORD) THEN + IF (CSP.NE.RINF) THEN + DI = CSP - VJ + IF (A(K1).GE.DI) THEN + K0 = JPERM(J) + IF (K0.GE.K1-6) GO TO 178 + 177 CONTINUE + K = (K0+K1)/2 + IF (A(K).GE.DI) THEN + K1 = K + ELSE + K0 = K + ENDIF + IF (K0.GE.K1-6) GO TO 178 + GO TO 177 + 178 DO 179 K = K0+1,K1 + IF (A(K).LT.DI) GO TO 179 + K1 = K - 1 + GO TO 181 + 179 CONTINUE + ENDIF + ENDIF + 181 IF (K1.EQ.JPERM(J)) K1 = K1 - 1 + ENDIF + K0 = IP(J) + DI = CSP - VJ + DO 155 K = K0,K1 + I = IRN(K) + IF (L(I).GE.LOW) GO TO 155 + DNEW = A(K) - U(I) + IF (DNEW.GE.DI) GO TO 155 + DNEW = DNEW + VJ + IF (DNEW.GT.D(I)) GO TO 155 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = K + JSP = J + DI = CSP - VJ + ELSE + IF (DNEW.GE.D(I)) GO TO 155 + D(I) = DNEW + IF (DNEW.LE.DMIN) THEN + IF (L(I).NE.0) THEN + CALL DMUMPS_447(L(I),QLEN,M,Q,D,L,2) + ENDIF + LOW = LOW - 1 + Q(LOW) = I + L(I) = LOW + ELSE + IF (L(I).EQ.0) THEN + QLEN = QLEN + 1 + L(I) = QLEN + ENDIF + CALL DMUMPS_445(I,M,Q,D,L,2) + ENDIF + JJ = IPERM(I) + OUT(JJ) = K + PR(JJ) = J + ENDIF + 155 CONTINUE + 150 CONTINUE + 160 IF (CSP.EQ.RINF) GO TO 190 + NUM = NUM + 1 + I = IRN(ISP) + J = JSP + IPERM(I) = J + JPERM(J) = ISP + DO 170 JDUM = 1,NUM + JJ = PR(J) + IF (JJ.EQ.-1) GO TO 180 + K = OUT(J) + I = IRN(K) + IPERM(I) = JJ + JPERM(JJ) = K + J = JJ + 170 CONTINUE + 180 DO 182 KK = UP,M + I = Q(KK) + U(I) = U(I) + D(I) - CSP + 182 CONTINUE + 190 DO 191 KK = UP,M + I = Q(KK) + D(I) = RINF + L(I) = 0 + 191 CONTINUE + DO 192 KK = LOW,UP-1 + I = Q(KK) + D(I) = RINF + L(I) = 0 + 192 CONTINUE + DO 193 KK = 1,QLEN + I = Q(KK) + D(I) = RINF + L(I) = 0 + 193 CONTINUE + 100 CONTINUE + 1000 CONTINUE + DO 1200 J = 1,N + K = JPERM(J) + IF (K.NE.0) THEN + D(J) = A(K) - U(IRN(K)) + ELSE + D(J) = ZERO + ENDIF + 1200 CONTINUE + DO 1201 I = 1,M + IF (IPERM(I).EQ.0) U(I) = ZERO + 1201 CONTINUE + IF (M.EQ.N .and. NUM.EQ.N) GO TO 2000 + CALL DMUMPS_455(M,N,IPERM,L,JPERM) + 2000 RETURN + END SUBROUTINE DMUMPS_454 + SUBROUTINE DMUMPS_457 + & (M,N,IRN,LIRN,IP,LENC,IPERM,NUM,PR,ARP,CV,OUT) + IMPLICIT NONE + INTEGER LIRN,M,N,NUM + INTEGER ARP(N),CV(M),IRN(LIRN),IP(N),IPERM(M),LENC(N),OUT(N),PR(N) + INTEGER I,II,IN1,IN2,J,J1,JORD,K,KK + EXTERNAL DMUMPS_455 + DO 10 I = 1,M + CV(I) = 0 + IPERM(I) = 0 + 10 CONTINUE + DO 12 J = 1,N + ARP(J) = LENC(J) - 1 + 12 CONTINUE + NUM = 0 + DO 1000 JORD = 1,N + J = JORD + PR(J) = -1 + DO 70 K = 1,JORD + IN1 = ARP(J) + IF (IN1.LT.0) GO TO 30 + IN2 = IP(J) + LENC(J) - 1 + IN1 = IN2 - IN1 + DO 20 II = IN1,IN2 + I = IRN(II) + IF (IPERM(I).EQ.0) GO TO 80 + 20 CONTINUE + ARP(J) = -1 + 30 CONTINUE + OUT(J) = LENC(J) - 1 + DO 60 KK = 1,JORD + IN1 = OUT(J) + IF (IN1.LT.0) GO TO 50 + IN2 = IP(J) + LENC(J) - 1 + IN1 = IN2 - IN1 + DO 40 II = IN1,IN2 + I = IRN(II) + IF (CV(I).EQ.JORD) GO TO 40 + J1 = J + J = IPERM(I) + CV(I) = JORD + PR(J) = J1 + OUT(J1) = IN2 - II - 1 + GO TO 70 + 40 CONTINUE + 50 CONTINUE + J = PR(J) + IF (J.EQ.-1) GO TO 1000 + 60 CONTINUE + 70 CONTINUE + 80 CONTINUE + IPERM(I) = J + ARP(J) = IN2 - II - 1 + NUM = NUM + 1 + DO 90 K = 1,JORD + J = PR(J) + IF (J.EQ.-1) GO TO 1000 + II = IP(J) + LENC(J) - OUT(J) - 2 + I = IRN(II) + IPERM(I) = J + 90 CONTINUE + 1000 CONTINUE + IF (M.EQ.N .and. NUM.EQ.N) GO TO 2000 + CALL DMUMPS_455(M,N,IPERM,CV,ARP) + 2000 RETURN + END SUBROUTINE DMUMPS_457 + SUBROUTINE DMUMPS_455(M,N,IPERM,RW,CW) + IMPLICIT NONE + INTEGER M,N + INTEGER RW(M),CW(N),IPERM(M) + INTEGER I,J,K + DO 10 J = 1,N + CW(J) = 0 + 10 CONTINUE + K = 0 + DO 20 I = 1,M + IF (IPERM(I).EQ.0) THEN + K = K + 1 + RW(K) = I + ELSE + J = IPERM(I) + CW(J) = I + ENDIF + 20 CONTINUE + K = 0 + DO 30 J = 1,N + IF (CW(J).NE.0) GO TO 30 + K = K + 1 + I = RW(K) + IPERM(I) = -J + 30 CONTINUE + DO 40 J = N+1,M + K = K + 1 + I = RW(K) + IPERM(I) = -J + 40 CONTINUE + RETURN + END SUBROUTINE DMUMPS_455 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part3.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part3.F new file mode 100644 index 000000000..b035ba55a --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part3.F @@ -0,0 +1,6715 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + RECURSIVE SUBROUTINE DMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & + & INODE_PERE, ISON, NSLAVES_PERE, LIST_SLAVES_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP, TROW, + & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, + & root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE DMUMPS_COMM_BUFFER + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC ) :: root + INTEGER LBUFR, LBUFR_BYTES + INTEGER ICNTL( 40 ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER SLAVEF, NBFIN + INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS, POSFAC + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), + & PIMASTER(KEEP(28)) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER COMP + INTEGER NSTK( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM, MYID + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER INODE_PERE, ISON + INTEGER NFS4FATHER + INTEGER NBROWS_ALREADY_SENT + INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE + INTEGER LIST_SLAVES_PERE( * ) + INTEGER LMAP + INTEGER TROW( LMAP ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER NOSLA, I, ISTCHK, ISTCHK_LOC + INTEGER INDICE_PERE + INTEGER INDICE_PERE_ARRAY_ARG(1) + INTEGER PDEST, PDEST_MASTER + INTEGER NFRONT + INTEGER(8) :: SIZFR + INTEGER LDA_SON + INTEGER NSLSON, NBCOLS, NROW, NROWS_TO_SEND, IROW_SON, + & NPIV, NROWS_TO_STACK, II, COLLIST + INTEGER(8) :: POSROW, SHIFTCB_SON + INTEGER NBCOLS_EFF + INTEGER PDEST_MASTER_ISON, IPOS_IN_SLAVE + LOGICAL DESCLU, SLAVE_ISON + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER MSGSOU, MSGTAG + INTEGER LP + INTEGER ITMP + LOGICAL SAME_PROC, COMPRESSCB + LOGICAL IS_ERROR_BROADCASTED, IS_ofType5or6 + INTEGER ITYPE, TYPESPLIT + INTEGER KEEP253_LOC + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275, MUMPS_330, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, MUMPS_810 + INTEGER LMAP_LOC, allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: NBROW + INTEGER, ALLOCATABLE, DIMENSION(:) :: SLAVES_PERE + INTEGER, ALLOCATABLE, DIMENSION(:) :: MAP, PERM + IS_ERROR_BROADCASTED = .FALSE. + TYPESPLIT = MUMPS_810(PROCNODE_STEPS(STEP(INODE_PERE)), + & SLAVEF) + IS_ofType5or6 = ((TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + ALLOCATE(SLAVES_PERE(0:NSLAVES_PERE), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP > 0) write(LP,*) MYID, + & ' : PB allocation SLAVES_PERE in DMUMPS_210' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 700 + endif + IF (NSLAVES_PERE.GT.0) + &SLAVES_PERE(1:NSLAVES_PERE) = LIST_SLAVES_PERE(1:NSLAVES_PERE) + SLAVES_PERE(0) = MUMPS_275( PROCNODE_STEPS(STEP(INODE_PERE)), + & SLAVEF ) + ALLOCATE(NBROW(0:NSLAVES_PERE), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP>0) write(LP,*) MYID, + & ' : PB allocation NBROW in DMUMPS_210' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 670 + endif + LMAP_LOC = LMAP + ALLOCATE(MAP(LMAP_LOC), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP>0) THEN + write(LP,*) MYID, ' : PB allocation LMAP in DMUMPS_210' + ENDIF + IFLAG =-13 + IERROR = LMAP + GOTO 680 + endif + MAP( 1 : LMAP ) = TROW( 1 : LMAP ) + PDEST_MASTER_ISON = MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) + SLAVE_ISON = PDEST_MASTER_ISON .NE. MYID + IF (SLAVE_ISON) THEN + DO WHILE ( PTRIST(STEP( ISON )) .EQ. 0 ) + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & PDEST_MASTER_ISON, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. + & ) + IF ( IFLAG .LT. 0 ) THEN + IS_ERROR_BROADCASTED = .TRUE. + GOTO 670 + ENDIF + END DO + DO WHILE ( + & ( IW( PTRIST(STEP(ISON)) + 1 + KEEP(IXSZ) ) .NE. + & IW( PTRIST(STEP(ISON)) + 3 + KEEP(IXSZ) ) ) .OR. + & ( KEEP(50) .NE. 0 .AND. + & IW( PTRIST(STEP(ISON)) + 6 + KEEP(IXSZ) ) .NE. 0 ) ) + IF ( KEEP(50).eq.0) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO + ELSE + IF ( IW( PTRIST(STEP(ISON)) + 1 + KEEP(IXSZ) ) .NE. + & IW( PTRIST(STEP(ISON)) + 3 + KEEP(IXSZ) ) ) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO_SYM + ELSE + MSGSOU = MPI_ANY_SOURCE + MSGTAG = BLOC_FACTO_SYM_SLAVE + END IF + END IF + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MSGTAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) THEN + IS_ERROR_BROADCASTED = .TRUE. + GOTO 670 + ENDIF + END DO + ENDIF + IF ( NSLAVES_PERE .EQ. 0 ) THEN + NBROW( 0 ) = LMAP + ELSE + DO I = 0, NSLAVES_PERE + NBROW( I ) = 0 + END DO + DO I = 1, LMAP_LOC + INDICE_PERE = MAP( I ) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + NBROW( NOSLA ) = NBROW( NOSLA ) + 1 + END DO + DO I = 1, NSLAVES_PERE + NBROW(I)=NBROW(I)+NBROW(I-1) + ENDDO + ENDIF + ALLOCATE(PERM(LMAP_LOC), stat=allocok) + IF (allocok .GT. 0) THEN + IF (LP.GT.0) THEN + write(LP,*) MYID,': PB allocation PERM in DMUMPS_210' + ENDIF + IFLAG =-13 + IERROR = LMAP_LOC + GOTO 670 + ENDIF + ISTCHK = PTRIST(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + KEEP253_LOC = 0 + DO I = LMAP_LOC, 1, -1 + INDICE_PERE = MAP( I ) + IF (INDICE_PERE > NFRONT_PERE - KEEP(253)) THEN + KEEP253_LOC = KEEP253_LOC + 1 + ENDIF + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + PERM( NBROW( NOSLA ) ) = I + NBROW( NOSLA ) = NBROW( NOSLA ) - 1 + ENDDO + DO I = 0, NSLAVES_PERE + NBROW(I)=NBROW(I)+1 + END DO + PDEST_MASTER = SLAVES_PERE(0) + DO I = 0, NSLAVES_PERE + PDEST = SLAVES_PERE( I ) + IF ( PDEST .EQ. MYID ) THEN + NBPROCFILS(STEP(INODE_PERE)) = + & NBPROCFILS(STEP(INODE_PERE)) - 1 + IF ( PDEST .EQ. PDEST_MASTER ) THEN + NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - 1 + ENDIF + ISTCHK = PTRIST(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + NROW = IW(ISTCHK+2+KEEP(IXSZ)) + NPIV = IW(ISTCHK+3+KEEP(IXSZ)) + NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) + NFRONT = NPIV + NBCOLS + COMPRESSCB = (IW(ISTCHK+XXS).EQ.S_CB1COMP) + CALL MUMPS_729(SIZFR, IW(ISTCHK+XXR)) + IF (IW(ISTCHK+XXS).EQ.S_NOLCBCONTIG) THEN + LDA_SON = NBCOLS + SHIFTCB_SON = int(NPIV,8)*int(NROW,8) + ELSE IF (IW(ISTCHK+XXS).EQ.S_NOLCLEANED) THEN + LDA_SON = NBCOLS + SHIFTCB_SON = 0_8 + ELSE + LDA_SON = NFRONT + SHIFTCB_SON = int(NPIV,8) + ENDIF + IF (I == NSLAVES_PERE) THEN + NROWS_TO_STACK=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_STACK=NBROW(I+1)-NBROW(I) + ENDIF + IF (PDEST .NE. PDEST_MASTER) THEN + IF ( KEEP(55) .eq. 0 ) THEN + CALL DMUMPS_539 + & (N, INODE_PERE, IW, LIW, + & A, LA, NROWS_TO_STACK, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, MYID ) + ELSE + CALL DMUMPS_123(NELT, FRTPTR, FRTELT, + & N, INODE_PERE, IW, LIW, + & A, LA, NROWS_TO_STACK, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP, KEEP8, MYID ) + ENDIF + ENDIF + DO II = 1,NROWS_TO_STACK + IROW_SON = PERM(NBROW(I)+II-1) + INDICE_PERE=MAP(IROW_SON) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + INDICE_PERE = IPOS_IN_SLAVE + IF ( COMPRESSCB ) THEN + IF (NBCOLS - NROW .EQ. 0 ) THEN + ITMP = IROW_SON + POSROW = PTRAST(STEP(ISON))+ + & int(ITMP,8) * int(ITMP-1,8) / 2_8 + ELSE + ITMP = IROW_SON + NBCOLS - NROW + POSROW = PTRAST(STEP(ISON)) + & + int(ITMP,8) * int(ITMP-1,8) / 2_8 + & - int(NBCOLS-NROW,8) * int(NBCOLS-NROW+1,8)/2_8 + ENDIF + ELSE + POSROW = PTRAST(STEP(ISON)) + SHIFTCB_SON + & +int(IROW_SON-1,8)*int(LDA_SON,8) + ENDIF + IF (PDEST == PDEST_MASTER) THEN + IF (KEEP(50).NE.0) THEN + NBCOLS_EFF = IROW_SON + NBCOLS - NROW + ELSE + NBCOLS_EFF = NBCOLS + ENDIF + INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE + IF ((IS_ofType5or6).AND.(KEEP(50).EQ.0)) THEN + CALL DMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NROWS_TO_STACK, NBCOLS_EFF, + & INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, LDA_SON + & ) + EXIT + ELSE IF ( (KEEP(50).NE.0) .AND. + & (.NOT.COMPRESSCB).AND.(IS_ofType5or6) ) THEN + CALL DMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NROWS_TO_STACK, + & NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, LDA_SON + &) + EXIT + ELSE + CALL DMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, LDA_SON + &) + ENDIF + ELSE + ISTCHK = PTRIST(STEP(ISON)) + COLLIST = ISTCHK + 6 + KEEP(IXSZ) + & + IW( ISTCHK + 5 +KEEP(IXSZ)) + NROW + NPIV + IF (KEEP(50).NE.0) THEN + NBCOLS_EFF = IROW_SON + NBCOLS - NROW + ELSE + NBCOLS_EFF = NBCOLS + ENDIF + INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE + IF ( (IS_ofType5or6) .AND. + & ( + & ( KEEP(50).EQ.0) + & .OR. + & ( (KEEP(50).NE.0).and. (.NOT.COMPRESSCB) ) + & ) + & ) THEN + CALL DMUMPS_40(N, INODE_PERE, + & IW, LIW, + & A, LA, NROWS_TO_STACK, NBCOLS, + & INDICE_PERE_ARRAY_ARG, + & IW( COLLIST ), A(POSROW), + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, ICNTL, KEEP,KEEP8, + & MYID, IS_ofType5or6, LDA_SON) + EXIT + ELSE + CALL DMUMPS_40(N, INODE_PERE, + & IW, LIW, + & A, LA, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & IW( COLLIST ), A(POSROW), + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, ICNTL, KEEP,KEEP8, + & MYID, IS_ofType5or6, LDA_SON) + ENDIF + ENDIF + ENDDO + IF (PDEST.EQ.PDEST_MASTER) THEN + IF (KEEP(219).NE.0) THEN + IF(NSLAVES_PERE.GT.0 .AND. KEEP(50).EQ.2) THEN + IF (COMPRESSCB) THEN + WRITE(*,*) "Error 1 in PARPIV/DMUMPS_210" + CALL MUMPS_ABORT() + ELSE + POSROW = PTRAST(STEP(ISON))+SHIFTCB_SON+ + & int(NBROW(1)-1,8)*int(LDA_SON,8) + ENDIF + CALL DMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE.0) THEN + IF (LP .GT. 0) THEN + WRITE(LP, *) "MAX_ARRAY allocation failed" + ENDIF + IFLAG=-13 + IERROR=NFS4FATHER + GOTO 600 + ENDIF + ITMP=-9999 + IF ( LMAP_LOC-NBROW(1)+1-KEEP253_LOC .NE. 0 ) THEN + CALL DMUMPS_618( + & A(POSROW), + & SIZFR-SHIFTCB_SON-int(NBROW(1)-1,8)*int(LDA_SON,8), + & LDA_SON, LMAP_LOC-NBROW(1)+1-KEEP253_LOC, + & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB,ITMP) + ELSE + CALL DMUMPS_757( + & BUF_MAX_ARRAY, NFS4FATHER) + ENDIF + CALL DMUMPS_619(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NFS4FATHER, + & BUF_MAX_ARRAY, PTLUST_S, PTRAST, + & STEP, PIMASTER, + & OPASSW,IWPOSCB,MYID, KEEP,KEEP8) + ENDIF + ENDIF + IF ( NBPROCFILS(STEP(ISON)) .EQ. 0) THEN + ISTCHK_LOC = PIMASTER(STEP(ISON)) + SAME_PROC= ISTCHK_LOC .LT. IWPOSCB + IF (SAME_PROC) THEN + CALL DMUMPS_530(N, ISON, INODE_PERE, + & IWPOSCB, PIMASTER, PTLUST_S, IW, LIW, STEP, + & KEEP,KEEP8) + ENDIF + IF (SAME_PROC) THEN + ISTCHK_LOC = PTRIST(STEP(ISON)) + PTRIST(STEP( ISON) ) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL DMUMPS_152(.FALSE., MYID, N, + & ISTCHK_LOC, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, IWPOSCB, + & LA, KEEP,KEEP8, .FALSE. + & ) + ENDIF + IF ( NBPROCFILS(STEP(INODE_PERE)) .EQ. 0 ) THEN + CALL DMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), + & KEEP(47), STEP, INODE_PERE+N ) + IF (KEEP(47) .GE. 3) THEN + CALL DMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + ELSE + CALL DMUMPS_531 + & (N, INODE_PERE, IW, LIW, + & NBROW(I), STEP, PTRIST, ITLOC, RHS_MUMPS, + & KEEP,KEEP8) + END IF + END IF + END DO + DO I = NSLAVES_PERE, 0, -1 + PDEST = SLAVES_PERE( I ) + IF ( PDEST .NE. MYID ) THEN + DESCLU = .FALSE. + NBROWS_ALREADY_SENT = 0 + IF (I == NSLAVES_PERE) THEN + NROWS_TO_SEND=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_SEND=NBROW(I+1)-NBROW(I) + ENDIF + COMPRESSCB=(IW(PTRIST(STEP(ISON))+XXS).EQ.S_CB1COMP) + 95 CONTINUE + IF ( PTRIST(STEP(ISON)) .lt.0 .or. + & IW ( PTRIST(STEP(ISON) )+KEEP(IXSZ) ) .GT. N ) THEN + WRITE(*,*) MYID,': Internal error in Maplig' + WRITE(*,*) MYID,': PTRIST(STEP(ISON))/N=', + & PTRIST(STEP(ISON)), N + WRITE(*,*) MYID,': I, NBROW(I)=',I, NBROW(I) + WRITE(*,*) MYID,': NSLAVES_PERE=',NSLAVES_PERE + WRITE(*,*) MYID,': ISON, INODE_PERE=',ISON,INODE_PERE + WRITE(*,*) MYID,': Son header=', + & IW(PTRIST(STEP(ISON)): PTRIST(STEP(ISON))+5+KEEP(IXSZ)) + CALL MUMPS_ABORT() + END IF + CALL DMUMPS_67( NBROWS_ALREADY_SENT, + & DESCLU, INODE_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER, + & NSLAVES_PERE, ISON, + & NROWS_TO_SEND, LMAP_LOC, MAP, + & PERM(min(LMAP_LOC,NBROW(I))), + & IW( PTRIST(STEP(ISON))), + & A(PTRAST(STEP(ISON))), I, PDEST, PDEST_MASTER, + & COMM, IERR, + & + & KEEP,KEEP8, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, COMPRESSCB, + & KEEP253_LOC ) + IF ( IERR .EQ. -2 ) THEN + IFLAG = -17 + IF (LP .GT. 0) THEN + WRITE(LP,*) + & "FAILURE: SEND BUFFER TOO SMALL IN DMUMPS_210" + ENDIF + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * IW(PTRIST(STEP(ISON))+KEEP(IXSZ)) + & * KEEP( 35 ) + GO TO 600 + END IF + IF ( IERR .EQ. -3 ) THEN + IF (LP .GT. 0) THEN + WRITE(LP,*) + & "FAILURE: RECV BUFFER TOO SMALL IN DMUMPS_210" + ENDIF + IFLAG = -20 + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * IW(PTRIST(STEP(ISON))+KEEP(IXSZ)) + & * KEEP( 35 ) + GOTO 600 + ENDIF + IF (KEEP(219).NE.0) THEN + IF ( IERR .EQ. -4 ) THEN + IFLAG = -13 + IERROR = NFS4FATHER + IF (LP .GT. 0) THEN + WRITE(LP, *) + & "FAILURE: MAX_ARRAY allocation failed IN DMUMPS_210" + ENDIF + GO TO 600 + END IF + END IF + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) THEN + IS_ERROR_BROADCASTED=.TRUE. + GOTO 600 + ENDIF + GO TO 95 + END IF + END IF + END DO + ITYPE = MUMPS_330(PROCNODE_STEPS(STEP(ISON)), SLAVEF) + IF (KEEP(214) .EQ. 2) THEN + CALL DMUMPS_314( N, ISON, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE + & ) + IF (IFLAG .LT. 0) THEN + IS_ERROR_BROADCASTED = .TRUE. + GOTO 600 + ENDIF + ENDIF + CALL DMUMPS_626( N, ISON, PTRIST, PTRAST, IW, LIW, + & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, + & STEP, MYID, KEEP + &) + 600 CONTINUE + DEALLOCATE(PERM) + 670 CONTINUE + DEALLOCATE(MAP) + 680 CONTINUE + DEALLOCATE(NBROW) + DEALLOCATE(SLAVES_PERE) + 700 CONTINUE + IF (IFLAG .LT. 0 .AND. .NOT. IS_ERROR_BROADCASTED) THEN + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + ENDIF + RETURN + END SUBROUTINE DMUMPS_210 + SUBROUTINE DMUMPS_211( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & + & INODE_PERE, ISON, NSLAVES_PERE, LIST_SLAVES_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER, LMAP, TROW, + & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE DMUMPS_COMM_BUFFER + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER ICNTL( 40 ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER SLAVEF, NBFIN + INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS, POSFAC + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + DOUBLE PRECISION A( LA ) + INTEGER COMP + INTEGER IFLAG, IERROR, COMM, MYID + INTEGER LPOOL, LEAF + INTEGER INODE_PERE, ISON + INTEGER NFS4FATHER + INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE + INTEGER LIST_SLAVES_PERE(NSLAVES_PERE) + INTEGER NELIM, LMAP, TROW( LMAP ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + INTEGER LPTRAR, NELT + INTEGER IW( LIW ) + INTEGER BUFR( LBUFR ) + INTEGER IPOOL( LPOOL ) + INTEGER NSTK( KEEP(28) ), ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER LP + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER NOSLA, I, ISTCHK, ISTCHK_LOC + INTEGER NBROWS_ALREADY_SENT + INTEGER INDICE_PERE + INTEGER INDICE_PERE_ARRAY_ARG(1) + INTEGER PDEST, PDEST_MASTER, NFRONT + LOGICAL SAME_PROC, DESCLU + INTEGER(8) :: APOS, POSROW, ASIZE + INTEGER NSLSON, NBCOLS, NROW, NROWS_TO_SEND, + & NPIV, NROWS_TO_STACK, II, IROW_SON, + & IPOS_IN_SLAVE + INTEGER NBCOLS_EFF + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + LOGICAL COMPRESSCB + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER LMAP_LOC, allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: NBROW + INTEGER, ALLOCATABLE, DIMENSION(:) :: SLAVES_PERE + INTEGER, ALLOCATABLE, DIMENSION(:) :: MAP, PERM + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + if (NSLAVES_PERE.le.0) then + write(6,*) ' error 2 in maplig_fils_niv1 ', NSLAVES_PERE + CALL MUMPS_ABORT() + endif + ALLOCATE(NBROW(0:NSLAVES_PERE), stat=allocok) + IF (allocok .GT. 0) THEN + IF (LP > 0) + & write(LP,*) MYID, + & ' : PB allocation NBROW in DMUMPS_211' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 700 + ENDIF + ALLOCATE(SLAVES_PERE(0:NSLAVES_PERE), stat =allocok) + IF ( allocok .GT. 0 ) THEN + IF (LP > 0) write(LP,*) MYID, + & ' : PB allocation SLAVES_PERE in DMUMPS_211' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 700 + ENDIF + SLAVES_PERE(1:NSLAVES_PERE) = LIST_SLAVES_PERE(1:NSLAVES_PERE) + SLAVES_PERE(0) = MUMPS_275( + & PROCNODE_STEPS(STEP(INODE_PERE)), + & SLAVEF ) + LMAP_LOC = LMAP + ALLOCATE(MAP(LMAP_LOC), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP > 0) write(LP,*) MYID, + & ' : PB allocation LMAP in DMUMPS_211' + IFLAG =-13 + IERROR = LMAP_LOC + GOTO 700 + endif + MAP( 1 : LMAP_LOC ) = TROW( 1 : LMAP_LOC ) + DO I = 0, NSLAVES_PERE + NBROW( I ) = 0 + END DO + IF (NSLAVES_PERE == 0) THEN + NBROW(0) = LMAP_LOC + ELSE + DO I = 1, LMAP_LOC + INDICE_PERE = MAP( I ) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + NBROW( NOSLA ) = NBROW( NOSLA ) + 1 + END DO + DO I = 1, NSLAVES_PERE + NBROW(I)=NBROW(I)+NBROW(I-1) + ENDDO + ENDIF + ALLOCATE(PERM(LMAP_LOC), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP > 0) write(LP,*) MYID, + & ': PB allocation PERM in DMUMPS_211' + IFLAG =-13 + IERROR = LMAP_LOC + GOTO 700 + endif + ISTCHK = PIMASTER(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + DO I = LMAP_LOC, 1, -1 + INDICE_PERE = MAP( I ) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + PERM( NBROW( NOSLA ) ) = I + NBROW( NOSLA ) = NBROW( NOSLA ) - 1 + ENDDO + DO I = 0, NSLAVES_PERE + NBROW(I)=NBROW(I)+1 + END DO + PDEST_MASTER = MYID + IF ( SLAVES_PERE(0) .NE. MYID ) THEN + WRITE(*,*) 'Error 1 in MAPLIG_FILS_NIV1:',MYID, SLAVES_PERE + CALL MUMPS_ABORT() + END IF + PDEST = PDEST_MASTER + I = 0 + NBPROCFILS(STEP(INODE_PERE))=NBPROCFILS(STEP(INODE_PERE))-1 + NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - 1 + ISTCHK = PIMASTER(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + NELIM = IW(ISTCHK+1+KEEP(IXSZ)) + NROW = IW(ISTCHK+2+KEEP(IXSZ)) + NPIV = IW(ISTCHK+3+KEEP(IXSZ)) + IF (NPIV.LT.0) THEN + write(6,*) ' Error 2 in DMUMPS_211 ', NPIV + CALL MUMPS_ABORT() + ENDIF + NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) + NFRONT = NPIV + NBCOLS + COMPRESSCB=(IW(PTRIST(STEP(ISON))+XXS) .eq. S_CB1COMP) + IF (I == NSLAVES_PERE) THEN + NROWS_TO_STACK=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_STACK=NBROW(I+1)-NBROW(I) + ENDIF + DO II = 1,NROWS_TO_STACK + IROW_SON=PERM(NBROW(I)+II-1) + INDICE_PERE = MAP(IROW_SON) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + INDICE_PERE = IPOS_IN_SLAVE + IF (COMPRESSCB) THEN + IF (NELIM.EQ.0) THEN + POSROW = PAMASTER(STEP(ISON)) + + & int(IROW_SON,8)*int(IROW_SON-1,8)/2_8 + ELSE + POSROW = PAMASTER(STEP(ISON)) + + & int(NELIM+IROW_SON,8)*int(NELIM+IROW_SON-1,8)/2_8 + ENDIF + ELSE + POSROW = PAMASTER(STEP(ISON)) + + & int(NELIM+IROW_SON-1,8)*int(NBCOLS,8) + ENDIF + IF (KEEP(50).NE.0) THEN + NBCOLS_EFF = NELIM + IROW_SON + ELSE + NBCOLS_EFF = NBCOLS + ENDIF + INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE + CALL DMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, IWPOSCB, + & MYID, KEEP,KEEP8,.FALSE.,NBCOLS_EFF) + ENDDO + IF (KEEP(219).NE.0) THEN + IF(NSLAVES_PERE.GT.0 .AND. KEEP(50).EQ.2) THEN + IF (COMPRESSCB) THEN + POSROW = PAMASTER(STEP(ISON)) + & + int(NELIM+NBROW(1),8)*int(NELIM+NBROW(1)-1,8)/2_8 + ASIZE = int(LMAP_LOC+NELIM,8)*int(NELIM+LMAP_LOC+1,8)/2_8 + & - int(NELIM+NBROW(1),8)*int(NELIM+NBROW(1)-1,8)/2_8 + ELSE + POSROW = PAMASTER(STEP(ISON)) + + & int(NELIM+NBROW(1)-1,8)*int(NBCOLS,8) + ASIZE = int(LMAP_LOC-NBROW(1)+1,8) * int(NBCOLS,8) + ENDIF + CALL DMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE.0) THEN + IF (LP > 0) WRITE(LP,*) MYID, + & ": PB allocation MAX_ARRAY during DMUMPS_211" + IFLAG=-13 + IERROR=NFS4FATHER + GOTO 700 + ENDIF + IF ( LMAP_LOC-NBROW(1)+1-KEEP(253).GT. 0 ) THEN + CALL DMUMPS_618( + & A(POSROW),ASIZE,NBCOLS, + & LMAP_LOC-NBROW(1)+1-KEEP(253), + & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB, + & NELIM+NBROW(1)) + ELSE + CALL DMUMPS_757(BUF_MAX_ARRAY, + & NFS4FATHER) + ENDIF + CALL DMUMPS_619(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NFS4FATHER, + & BUF_MAX_ARRAY, PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB,MYID, KEEP,KEEP8) + ENDIF + ENDIF + IF ( NBPROCFILS(STEP(ISON)) .EQ. 0) THEN + ISTCHK_LOC = PIMASTER(STEP(ISON)) + SAME_PROC= ISTCHK_LOC .LT. IWPOSCB + IF (SAME_PROC) THEN + CALL DMUMPS_530(N, ISON, INODE_PERE, + & IWPOSCB, PIMASTER, PTLUST_S, IW, LIW, STEP, + & KEEP,KEEP8) + ENDIF + ENDIF + IF ( NBPROCFILS(STEP(INODE_PERE)) .EQ. 0 ) THEN + CALL DMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), + & KEEP(47), STEP, INODE_PERE+N ) + IF (KEEP(47) .GE. 3) THEN + CALL DMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + DO I = 0, NSLAVES_PERE + PDEST = SLAVES_PERE( I ) + IF ( PDEST .NE. MYID ) THEN + NBROWS_ALREADY_SENT = 0 + 95 CONTINUE + NFRONT = IW(PIMASTER(STEP(ISON))+KEEP(IXSZ)) + NELIM = IW(PIMASTER(STEP(ISON))+1+KEEP(IXSZ)) + APOS = PAMASTER(STEP(ISON)) + DESCLU = .TRUE. + IF (I == NSLAVES_PERE) THEN + NROWS_TO_SEND=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_SEND=NBROW(I+1)-NBROW(I) + ENDIF + CALL DMUMPS_67(NBROWS_ALREADY_SENT, + & DESCLU, INODE_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER, + & NSLAVES_PERE, + & ISON, NROWS_TO_SEND, LMAP_LOC, + & MAP, PERM(min(LMAP_LOC,NBROW(I))), + & IW(PIMASTER(STEP(ISON))), + & A(APOS), I, PDEST, PDEST_MASTER, COMM, IERR, + & + & KEEP,KEEP8, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & COMPRESSCB, KEEP(253)) + IF ( IERR .EQ. -2 ) THEN + IF (LP > 0) WRITE(LP,*) MYID, + &": FAILURE, SEND BUFFER TOO SMALL DURING DMUMPS_211" + IFLAG = -17 + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * KEEP( 35 ) + GO TO 700 + END IF + IF ( IERR .EQ. -3 ) THEN + IF (LP > 0) WRITE(LP,*) MYID, + &": FAILURE, RECV BUFFER TOO SMALL DURING DMUMPS_211" + IFLAG = -20 + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * KEEP( 35 ) + GO TO 700 + ENDIF + IF (KEEP(219).NE.0) THEN + IF ( IERR .EQ. -4 ) THEN + IFLAG = -13 + IERROR = BUF_LMAX_ARRAY + IF (LP > 0) WRITE(LP,*) MYID, + &": FAILURE, MAX_ARRAY ALLOC FAILED DURING DMUMPS_211" + GO TO 700 + ENDIF + ENDIF + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + GO TO 95 + END IF + END IF + END DO + ISTCHK = PTRIST(STEP(ISON)) + PTRIST(STEP( ISON )) = -77777777 + IF ( IW(ISTCHK+KEEP(IXSZ)) .GE. 0 ) THEN + WRITE(*,*) 'error 3 in DMUMPS_211' + CALL MUMPS_ABORT() + ENDIF + CALL DMUMPS_152(.FALSE., MYID, N, ISTCHK, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + 600 CONTINUE + DEALLOCATE(NBROW) + DEALLOCATE(MAP) + DEALLOCATE(PERM) + DEALLOCATE(SLAVES_PERE) + RETURN + 700 CONTINUE + CALL DMUMPS_44(MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE DMUMPS_211 + SUBROUTINE DMUMPS_93(SIZE_INPLACE, + &MYID,N,IOLDPS,TYPE,IW, LIW, A, LA, + &POSFAC, LRLU, LRLUS, IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8, + &SSARBR,INODE,IERR) + USE DMUMPS_LOAD + USE DMUMPS_OOC + IMPLICIT NONE + INTEGER MYID + INTEGER IOLDPS, TYPE, LIW, N, KEEP(500) + INTEGER(8) :: SIZE_INPLACE, LA, POSFAC, LRLU, LRLUS + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) KEEP8(150) + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER IWPOS, LDLT + INTEGER STEP( N ) + INTEGER (8) :: PTRFAC(KEEP(28)) + LOGICAL SSARBR + INTEGER IOLDSHIFT, IPSSHIFT + INCLUDE 'mumps_headers.h' + INTEGER LCONT, NELIM, NROW, NPIV, INTSIZ + INTEGER NFRONT, NSLAVES + INTEGER IPS, IPSIZE + INTEGER(8) :: SIZELU, SIZECB, IAPOS, I + LOGICAL MOVEPTRAST + INTEGER INODE + INTEGER IERR + IERR=0 + LDLT = KEEP(50) + IOLDSHIFT = IOLDPS + KEEP(IXSZ) + IF ( IW( IOLDSHIFT ) < 0 ) THEN + write(*,*) ' ERROR 1 compressLU:Should not point to a band.' + CALL MUMPS_ABORT() + ELSE IF ( IW( IOLDSHIFT + 2 ) < 0 ) THEN + write(*,*) ' ERROR 2 compressLU:Stack not performed yet', + & IW(IOLDSHIFT + 2) + CALL MUMPS_ABORT() + ENDIF + LCONT = IW( IOLDSHIFT ) + NELIM = IW( IOLDSHIFT + 1 ) + NROW = IW( IOLDSHIFT + 2 ) + NPIV = IW( IOLDSHIFT + 3 ) + IAPOS = PTRFAC(IW( IOLDSHIFT + 4 )) + NSLAVES= IW( IOLDSHIFT + 5 ) + NFRONT = LCONT + NPIV + INTSIZ = IW(IOLDPS+XXI) + IF ( (NSLAVES > 0 .AND. TYPE .NE. 2) .OR. + & (NSLAVES .eq. 0 .AND. TYPE .EQ. 2 ) ) THEN + WRITE(*,*) ' ERROR 3 compressLU: problem with level of inode' + CALL MUMPS_ABORT() + END IF + IF (LDLT.EQ.0) THEN + SIZELU = int(LCONT + NROW, 8) * int(NPIV,8) + ELSE + SIZELU = int(NROW,8) * int(NPIV,8) + ENDIF + IF ( TYPE .EQ. 2 ) THEN + IF (LDLT.EQ.0) THEN + SIZECB = int(NELIM,8) * int(LCONT,8) + ELSE + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + SIZECB = int(NELIM+1,8) * int(NELIM + NPIV,8) + ELSE + SIZECB = int(NELIM,8) * int(NELIM + NPIV,8) + ENDIF + ENDIF + ELSE + IF (LDLT.EQ.0) THEN + SIZECB = int(LCONT,8) * int(LCONT,8) + ELSE + SIZECB = int(NROW,8) * int(LCONT,8) + ENDIF + END IF + CALL MUMPS_724( IW(IOLDPS+XXR), SIZECB ) + IF ((SIZECB.EQ.0_8).AND.(KEEP(201).EQ.0)) THEN + GOTO 500 + ENDIF + IF (KEEP(201).EQ.2) THEN + KEEP8(31)=KEEP8(31)+SIZELU + CALL DMUMPS_576(INODE,PTRFAC,KEEP,KEEP8, + & A,LA,SIZELU, IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID,': Internal error in DMUMPS_576' + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF ( IOLDPS + INTSIZ .NE. IWPOS ) THEN + IPS = IOLDPS + INTSIZ + MOVEPTRAST = .FALSE. + DO WHILE ( IPS .NE. IWPOS ) + IPSIZE = IW(IPS+XXI) + IPSSHIFT = IPS + KEEP(IXSZ) + IF ( IW( IPSSHIFT + 2 ) < 0 ) THEN + NFRONT = IW( IPSSHIFT ) + IF(KEEP(201).EQ.0)THEN + PTRFAC(IW( IPSSHIFT + 4 )) = + & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB + ELSE + PTRFAC(IW(IPSSHIFT+4))=PTRFAC(IW(IPSSHIFT+4)) - + & SIZECB - SIZELU + ENDIF + MOVEPTRAST = .TRUE. + IF(KEEP(201).EQ.0)THEN + PTRAST(IW(IPSSHIFT+4))=PTRAST(IW(IPSSHIFT+4))-SIZECB + ELSE + PTRAST(IW(IPSSHIFT+4))=PTRAST(IW(IPSSHIFT+4))-SIZECB + & - SIZELU + ENDIF + ELSE IF ( IW( IPSSHIFT ) < 0 ) THEN + IF(KEEP(201).EQ.0)THEN + PTRFAC(IW(IPSSHIFT+3)) = PTRFAC(IW(IPSSHIFT+3))-SIZECB + ELSE + PTRFAC(IW(IPSSHIFT+3)) = PTRFAC(IW(IPSSHIFT+3)) + & -SIZECB-SIZELU + ENDIF + ELSE + NFRONT = IW( IPSSHIFT ) + IW( IPSSHIFT + 3 ) + IF(KEEP(201).EQ.0)THEN + PTRFAC(IW( IPSSHIFT + 4 )) = + & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB + ELSE + PTRFAC(IW( IPSSHIFT + 4 )) = + & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB + & - SIZELU + ENDIF + END IF + IPS = IPS + IPSIZE + END DO + IF ((SIZECB .NE. 0_8).OR.(KEEP(201).NE.0)) THEN + IF (KEEP(201).NE.0) THEN + DO I=IAPOS, POSFAC - SIZECB - SIZELU - 1_8 + A( I ) = A( I + SIZECB + SIZELU) + END DO + ELSE + DO I=IAPOS + SIZELU, POSFAC - SIZECB - 1_8 + A( I ) = A( I + SIZECB ) + END DO + ENDIF + END IF + ENDIF + IF (KEEP(201).NE.0) THEN + POSFAC = POSFAC - (SIZECB+SIZELU) + LRLU = LRLU + (SIZECB+SIZELU) + LRLUS = LRLUS + (SIZECB+SIZELU) - SIZE_INPLACE + ELSE + POSFAC = POSFAC - SIZECB + LRLU = LRLU + SIZECB + LRLUS = LRLUS + SIZECB - SIZE_INPLACE + ENDIF + 500 CONTINUE + CALL DMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,SIZELU,-SIZECB+SIZE_INPLACE,KEEP,KEEP8,LRLU) + RETURN + END SUBROUTINE DMUMPS_93 + SUBROUTINE DMUMPS_314( N, ISON, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, TYPE_SON + & ) + USE DMUMPS_OOC + USE DMUMPS_LOAD + IMPLICIT NONE + INTEGER(8) :: LA, LRLU, LRLUS, POSFAC, IPTRLU + INTEGER N, ISON, LIW, IWPOS, IWPOSCB, + & COMP, IFLAG, IERROR, SLAVEF, MYID, COMM, + & TYPE_SON + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), STEP(N), + & PIMASTER(KEEP(28)), IW(LIW) + INTEGER PTLUST_S(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + DOUBLE PRECISION OPELIW + DOUBLE PRECISION FLOP1, FLOP1_EFFECTIVE + DOUBLE PRECISION A( LA ) + INTEGER(8) :: LREQA, POSA, POSALOC, OLDPOS, JJ + INTEGER NFRONT, NCOL_L, NROW_L, LREQI, NSLAVES_L, + & POSI, I, IROW_L, ICOL_L, LDA_BAND, NASS + LOGICAL NONEED_TO_COPY_FACTORS + INTEGER(8) :: LAFAC, LREQA_HEADER + INTEGER LIWFAC, STRAT, TYPEFile, NextPivDummy, + & IOLDPS_CB + LOGICAL LAST_CALL + TYPE(IO_BLOCK) :: MonBloc + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0d0) + FLOP1 = ZERO + NCOL_L = IW( PTRIST(STEP( ISON )) + 3 + KEEP(IXSZ) ) + NROW_L = IW( PTRIST(STEP( ISON )) + 2 + KEEP(IXSZ) ) + NSLAVES_L = IW( PTRIST(STEP( ISON )) + 5 + KEEP(IXSZ) ) + LDA_BAND = NCOL_L + IW( PTRIST(STEP( ISON )) + KEEP(IXSZ) ) + IF ( KEEP(50) .eq. 0 ) THEN + NFRONT = LDA_BAND + ELSE + NFRONT = IW( PTRIST(STEP( ISON )) + 7 + KEEP(IXSZ) ) + END IF + IF (KEEP(201).EQ.1) THEN + IOLDPS_CB = PTRIST(STEP( ISON )) + CALL MUMPS_729(LAFAC, IW(IOLDPS_CB+XXR)) + LIWFAC = IW(IOLDPS_CB+XXI) + TYPEFile = TYPEF_L + NextPivDummy = -8888 + MonBloc%INODE = ISON + MonBloc%MASTER = .FALSE. + MonBloc%Typenode = 2 + MonBloc%NROW = NROW_L + MonBloc%NCOL = LDA_BAND + MonBloc%NFS = IW(IOLDPS_CB+1+KEEP(IXSZ)) + MonBloc%LastPiv = NCOL_L + NULLIFY(MonBloc%INDICES) + STRAT = STRAT_WRITE_MAX + LAST_CALL = .TRUE. + MonBloc%Last = .TRUE. + CALL DMUMPS_688 + & ( STRAT, TYPEFile, + & A(PTRAST(STEP(ISON))), LAFAC, MonBloc, + & NextPivDummy, NextPivDummy, + & IW(IOLDPS_CB), LIWFAC, + & MYID, KEEP8(31), IFLAG,LAST_CALL ) + IF ((NCOL_L.EQ.0).OR.(NROW_L.EQ.0)) THEN + ENDIF + ENDIF + NONEED_TO_COPY_FACTORS = (KEEP(201).EQ.1) .OR. (KEEP(201).EQ.-1) + IF ((NCOL_L.EQ.0).OR.(NROW_L.EQ.0)) THEN + GOTO 80 + ENDIF + LREQI = 4 + NCOL_L + NROW_L + KEEP(IXSZ) + LREQA_HEADER = int(NCOL_L,8) * int(NROW_L,8) + IF (NONEED_TO_COPY_FACTORS) THEN + LREQA = 0_8 + ELSE + LREQA = LREQA_HEADER + ENDIF + IF ( LRLU .LT. LREQA .OR. + & IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LREQA ) THEN + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GO TO 700 + END IF + CALL DMUMPS_94( N,KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS,IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress Stack_band:LRLU,LRLUS=', + & LRLU, LRLUS + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GOTO 700 + END IF + IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + GOTO 700 + END IF + END IF + IF (.NOT. NONEED_TO_COPY_FACTORS) THEN + POSA = POSFAC + POSFAC = POSFAC + LREQA + LRLU = LRLU - LREQA + LRLUS = LRLUS - LREQA + KEEP8(67) = min(LRLUS, KEEP8(67)) + IF(KEEP(201).NE.2)THEN + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,LREQA,LREQA,KEEP,KEEP8,LRLU) + ELSE + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU) + ENDIF + ENDIF + POSI = IWPOS + IWPOS = IWPOS + LREQI + PTLUST_S(STEP( ISON )) = POSI + IW(POSI+XXI)=LREQI + CALL MUMPS_730(LREQA, IW(POSI+XXR)) + CALL MUMPS_730(LREQA_HEADER, IW(POSI+XXR)) + IW(POSI+XXS)=-9999 + POSI=POSI+KEEP(IXSZ) + IW( POSI ) = - NCOL_L + IW( POSI + 1 ) = NROW_L + IW( POSI + 2 ) = NFRONT - NCOL_L + IW( POSI + 3 ) = STEP(ISON) + IF (.NOT. NONEED_TO_COPY_FACTORS) THEN + PTRFAC(STEP(ISON)) = POSA + ELSE + PTRFAC(STEP(ISON)) = -77777_8 + ENDIF + IROW_L = PTRIST(STEP(ISON)) + 6 + NSLAVES_L + KEEP(IXSZ) + ICOL_L = PTRIST(STEP(ISON)) + 6 + NROW_L + NSLAVES_L + KEEP(IXSZ) + DO I = 1, NROW_L + IW( POSI+3+I ) = IW( IROW_L+I-1 ) + ENDDO + DO I = 1, NCOL_L + IW( POSI+NROW_L+3+I) = IW( ICOL_L+I-1 ) + ENDDO + IF (.NOT.NONEED_TO_COPY_FACTORS) THEN + POSALOC = POSA + DO I = 1, NROW_L + OLDPOS = PTRAST( STEP(ISON)) + int(I-1,8)*int(LDA_BAND,8) + DO JJ = 0_8, int(NCOL_L-1,8) + A( POSALOC+JJ ) = A( OLDPOS+JJ ) + ENDDO + POSALOC = POSALOC + int(NCOL_L,8) + END DO + ENDIF + IF (KEEP(201).EQ.2) THEN + KEEP8(31)=KEEP8(31)+LREQA + ENDIF + KEEP8(10) = KEEP8(10) + int(NCOL_L,8) * int(NROW_L,8) + IF (KEEP(201).EQ.2) THEN + CALL DMUMPS_576(ISON,PTRFAC,KEEP,KEEP8,A,LA,LREQA,IFLAG) + IF(IFLAG.LT.0)THEN + WRITE(*,*)MYID,': Internal error in DMUMPS_576' + IERROR=0 + GOTO 700 + ENDIF + ENDIF + IF (KEEP(201).EQ.2) THEN + POSFAC = POSFAC - LREQA + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,LREQA,0_8,KEEP,KEEP8,LRLU) + ENDIF + 80 CONTINUE + IF (TYPE_SON == 1) THEN + GOTO 90 + ENDIF + IF ( KEEP(50) .eq. 0 ) THEN + FLOP1 = dble( NCOL_L * NROW_L) + + & dble(NROW_L*NCOL_L)*dble(2*NFRONT-NCOL_L-1) + ELSE + FLOP1 = dble( NCOL_L ) * dble( NROW_L ) + & * dble( 2 * LDA_BAND - NROW_L - NCOL_L + 1) + END IF + OPELIW = OPELIW + FLOP1 + FLOP1_EFFECTIVE = FLOP1 + NASS = IW( PTRIST(STEP( ISON )) + 4 + KEEP(IXSZ) ) + IF ( NCOL_L .NE. NASS ) THEN + IF ( KEEP(50).eq.0 ) THEN + FLOP1 = dble( NASS * NROW_L) + + & dble(NROW_L*NASS)*dble(2*NFRONT-NASS-1) + ELSE + FLOP1 = dble( NASS ) * dble( NROW_L ) * + & dble( 2 * LDA_BAND - NROW_L - NASS + 1) + END IF + END IF + CALL DMUMPS_190(1,.FALSE.,FLOP1_EFFECTIVE-FLOP1, + & KEEP,KEEP8) + CALL DMUMPS_190(2,.FALSE.,-FLOP1,KEEP,KEEP8) + 90 CONTINUE + RETURN + 700 CONTINUE + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE DMUMPS_314 + SUBROUTINE DMUMPS_626( N, ISON, + & PTRIST, PTRAST, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + IMPLICIT NONE + include 'mumps_headers.h' + INTEGER(8) :: LRLU, LRLUS, IPTRLU, LA + INTEGER ISON, MYID, N, IWPOSCB + INTEGER KEEP(500), STEP(N) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER PTRIST(KEEP(28)) + INTEGER LIW + INTEGER IW(LIW) + DOUBLE PRECISION A(LA) + INTEGER ISTCHK + ISTCHK = PTRIST(STEP(ISON)) + CALL DMUMPS_152(.FALSE.,MYID, N, ISTCHK, + & PTRAST(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + PTRIST(STEP( ISON )) = -9999888 + PTRAST(STEP( ISON )) = -9999888_8 + RETURN + END SUBROUTINE DMUMPS_626 + SUBROUTINE DMUMPS_214( KEEP,KEEP8, + & MYID, N, NELT, LNA, NZ, NA_ELT, NSLAVES, + & MEMORY_MBYTES, EFF, OOC_STRAT, PERLU_ON, + & MEMORY_BYTES ) + IMPLICIT NONE + LOGICAL, INTENT(IN) :: EFF, PERLU_ON + INTEGER, INTENT(IN) :: OOC_STRAT + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER MYID, N, NELT, NSLAVES, LNA, NZ, NA_ELT + INTEGER(8), INTENT(OUT) :: MEMORY_BYTES + INTEGER, INTENT(OUT) :: MEMORY_MBYTES + LOGICAL :: I_AM_SLAVE, I_AM_MASTER + INTEGER :: PERLU, NBRECORDS + INTEGER(8) :: NB_REAL, MAXS_MIN + INTEGER(8) :: TEMP, NB_BYTES, NB_INT + INTEGER :: DMUMPS_LBUF_INT, DMUMPS_LBUFR_BYTES, DMUMPS_LBUF + INTEGER :: NBUFS + INTEGER(8) :: TEMPI + INTEGER(8) :: TEMPR + INTEGER :: MIN_PERLU + INTEGER(8) :: BUF_OOC, BUF_OOC_PANEL, BUF_OOC_NOPANEL + INTEGER(8) :: OOC_NB_FILE_TYPE + INTEGER(8) :: NSTEPS8, N8, NELT8 + INTEGER(8) :: I8OVERI + I8OVERI = int(KEEP(10),8) + PERLU = KEEP(12) + NSTEPS8 = int(KEEP(28),8) + N8 = int(N,8) + NELT8 = int(NELT,8) + IF (.NOT.PERLU_ON) PERLU = 0 + I_AM_MASTER = ( MYID .eq. 0 ) + I_AM_SLAVE = ( KEEP(46).eq. 1 .or. MYID .ne. 0 ) + TEMP = 0_8 + NB_REAL = 0_8 + NB_BYTES = 0_8 + NB_INT = 0_8 + NB_INT = NB_INT + 5_8 * NSTEPS8 + NB_INT = NB_INT + NSTEPS8 + int(KEEP(56),8)*int(NSLAVES+2,8) + NB_INT = NB_INT + 3_8 * N8 + IF (KEEP(23).ne.0 .and. I_AM_MASTER) NB_INT=NB_INT + N8 + IF (KEEP(55).eq.0) THEN + NB_INT = NB_INT + 2_8 * N8 + ELSE + NB_INT = NB_INT + 2_8 * ( NELT8 + 1_8 ) + ENDIF + IF (KEEP(55) .ne. 0 ) THEN + NB_INT = NB_INT + N8 + 1_8 + NELT8 + END IF + NB_INT = NB_INT + int(LNA,8) + IF ( OOC_STRAT .GT. 0 .OR. OOC_STRAT .EQ. -1 ) THEN + MAXS_MIN = KEEP8(14) + ELSE + MAXS_MIN = KEEP8(12) + ENDIF + IF ( .NOT. EFF ) THEN + IF ( KEEP8(24).EQ.0_8 ) THEN + NB_REAL = NB_REAL + MAXS_MIN + + & int(PERLU,8)*(MAXS_MIN / 100_8 + 1_8 ) + ENDIF + ELSE + NB_REAL = NB_REAL + KEEP8(67) + ENDIF + IF ( OOC_STRAT .GT. 0 .AND. I_AM_SLAVE ) THEN + BUF_OOC_NOPANEL = 2_8 * KEEP8(119) + IF (KEEP(50).EQ.0)THEN + BUF_OOC_PANEL = 8_8 * int(KEEP(226),8) + ELSE + BUF_OOC_PANEL = 4_8 * int(KEEP(226),8) + ENDIF + IF (OOC_STRAT .EQ. 2) THEN + BUF_OOC = BUF_OOC_NOPANEL + ELSE + BUF_OOC = BUF_OOC_PANEL + ENDIF + NB_REAL = NB_REAL + min(BUF_OOC + int(max(PERLU,0),8) * + & (BUF_OOC/100_8+1_8),12000000_8) + IF (OOC_STRAT .EQ. 2) THEN + OOC_NB_FILE_TYPE = 1_8 + ELSE + IF (KEEP(50).EQ.0) THEN + OOC_NB_FILE_TYPE = 2_8 + ELSE + OOC_NB_FILE_TYPE = 1_8 + ENDIF + ENDIF + NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 * I8OVERI + NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 * I8OVERI + NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 + ENDIF + NB_REAL = NB_REAL + int(KEEP(13),8) + IF (KEEP(252).EQ.1 .AND. .NOT. I_AM_MASTER) THEN + NB_REAL = NB_REAL + N8 + ENDIF + IF ( .not. ( I_AM_SLAVE .and. I_AM_MASTER .and. KEEP(52) .eq. 0 + & .and. KEEP(55) .ne. 0 ) ) THEN + NB_INT = NB_INT + int(KEEP(14),8) + END IF + IF ( I_AM_SLAVE .and. KEEP(38) .ne. 0 ) THEN + NB_INT = NB_INT + 2_8 * N8 + END IF + TEMPI= 0_8 + TEMPR = 0_8 + NBRECORDS = KEEP(39) + IF (KEEP(55).eq.0) THEN + NBRECORDS = min(KEEP(39), NZ) + ELSE + NBRECORDS = min(KEEP(39), NA_ELT) + ENDIF + IF ( KEEP(54) .eq. 0 ) THEN + IF ( I_AM_MASTER ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + NBUFS = NSLAVES + ELSE + NBUFS = NSLAVES - 1 + IF (KEEP(55) .eq. 0 ) + & TEMPI = TEMPI + 2_8 * N8 + END IF + TEMPI = TEMPI + 2_8 * int(NBRECORDS,8) * int(NBUFS,8) + TEMPR = TEMPR + int(NBRECORDS,8) * int(NBUFS,8) + ELSE + IF ( KEEP(55) .eq. 0 )THEN + TEMPI = TEMPI + 2_8 * int(NBRECORDS,8) + TEMPR = TEMPR + int(NBRECORDS,8) + END IF + END IF + ELSE + IF ( I_AM_SLAVE ) THEN + TEMPI = TEMPI + int(1+4*NSLAVES,8) * int(NBRECORDS,8) + TEMPR = TEMPR + int(1+2*NSLAVES,8) * int(NBRECORDS,8) + END IF + END IF + TEMP = max( NB_BYTES + (NB_INT + TEMPI) * int(KEEP(34),8) + & + (NB_REAL+TEMPR) * int(KEEP(35),8) + & , TEMP ) + IF ( I_AM_SLAVE ) THEN + DMUMPS_LBUFR_BYTES = KEEP( 44 ) * KEEP( 35 ) + DMUMPS_LBUFR_BYTES = max( DMUMPS_LBUFR_BYTES, + & 100000 ) + IF (KEEP(48).EQ.5) THEN + MIN_PERLU=2 + ELSE + MIN_PERLU=0 + ENDIF + DMUMPS_LBUFR_BYTES = DMUMPS_LBUFR_BYTES + & + int( 2.0D0 * dble(max(PERLU,MIN_PERLU))* + & dble(DMUMPS_LBUFR_BYTES)/100D0) + NB_BYTES = NB_BYTES + int(DMUMPS_LBUFR_BYTES,8) + DMUMPS_LBUF = int( dble(KEEP(213)) / 100.0D0 + & * dble(KEEP( 43 ) * KEEP( 35 )) ) + DMUMPS_LBUF = max( DMUMPS_LBUF, 100000 ) + DMUMPS_LBUF = DMUMPS_LBUF + & + int( 2.0D0 * dble(max(PERLU,0))* + & dble(DMUMPS_LBUF)/100D0) + DMUMPS_LBUF = max(DMUMPS_LBUF, DMUMPS_LBUFR_BYTES) + NB_BYTES = NB_BYTES + int(DMUMPS_LBUF,8) + DMUMPS_LBUF_INT = ( KEEP(56) + + & NSLAVES * NSLAVES ) * 5 + & * KEEP(34) + NB_BYTES = NB_BYTES + int(DMUMPS_LBUF_INT,8) + IF ( EFF ) THEN + IF (OOC_STRAT .GT. 0) THEN + NB_INT = NB_INT + int(KEEP(225),8) + ELSE + NB_INT = NB_INT + int(KEEP(15),8) + ENDIF + ELSE + IF (OOC_STRAT .GT. 0) THEN + NB_INT = NB_INT + int( + & KEEP(225) + 2 * max(PERLU,10) * + & ( KEEP(225) / 100 + 1 ) + & ,8) + ELSE + NB_INT = NB_INT + int( + & KEEP(15) + 2 * max(PERLU,10) * + & ( KEEP(15) / 100 + 1 ) + & ,8) + ENDIF + ENDIF + NB_INT = NB_INT + NSTEPS8 + NB_INT = NB_INT + NSTEPS8 * I8OVERI + NB_INT = NB_INT + N8 + 5_8 * NSTEPS8 + 3_8 + NB_INT = NB_INT + 2_8 * NSTEPS8 * I8OVERI + END IF + MEMORY_BYTES = NB_BYTES + NB_INT * int(KEEP(34),8) + + & NB_REAL * int(KEEP(35),8) + MEMORY_BYTES = max( MEMORY_BYTES, TEMP ) + MEMORY_MBYTES = int( MEMORY_BYTES / 1000000_8 ) + 1 + RETURN + END SUBROUTINE DMUMPS_214 + SUBROUTINE DMUMPS_757(M_ARRAY, M_SIZE) + IMPLICIT NONE + INTEGER M_SIZE + DOUBLE PRECISION M_ARRAY(M_SIZE) + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0D0) + M_ARRAY=ZERO + RETURN + END SUBROUTINE DMUMPS_757 + SUBROUTINE DMUMPS_618( + & A,ASIZE,NCOL,NROW, + & M_ARRAY,NMAX,COMPRESSCB,LROW1) + IMPLICIT NONE + INTEGER(8) :: ASIZE + INTEGER NROW,NCOL,NMAX,LROW1 + LOGICAL COMPRESSCB + DOUBLE PRECISION A(ASIZE) + DOUBLE PRECISION M_ARRAY(NMAX) + INTEGER I + INTEGER(8):: APOS, J, LROW + DOUBLE PRECISION ZERO,TMP + PARAMETER (ZERO=0.0D0) + M_ARRAY(1:NMAX) = ZERO + APOS = 0_8 + IF (COMPRESSCB) THEN + LROW=int(LROW1,8) + ELSE + LROW=int(NCOL,8) + ENDIF + DO I=1,NROW + DO J=1_8,int(NMAX,8) + TMP = abs(A(APOS+J)) + IF(TMP.GT.M_ARRAY(J)) M_ARRAY(J) = TMP + ENDDO + APOS = APOS + LROW + IF (COMPRESSCB) LROW=LROW+1_8 + ENDDO + RETURN + END SUBROUTINE DMUMPS_618 + SUBROUTINE DMUMPS_710 (id, NB_INT,NB_CMPLX ) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(DMUMPS_STRUC) :: id + INTEGER(8) NB_INT, NB_CMPLX + INTEGER(8) NB_REAL + NB_INT = 0_8 + NB_CMPLX = 0_8 + NB_REAL = 0_8 + IF (associated(id%IS)) NB_INT=NB_INT+size(id%IS) + IF (associated(id%IS1)) NB_INT=NB_INT+size(id%IS1) + NB_INT=NB_INT+size(id%KEEP) + NB_INT=NB_INT+size(id%ICNTL) + NB_INT=NB_INT+size(id%INFO) + NB_INT=NB_INT+size(id%INFOG) + IF (associated(id%MAPPING)) NB_INT=NB_INT+size(id%MAPPING) + IF (associated(id%POIDS)) NB_INT=NB_INT+size(id%POIDS) + IF (associated(id%BUFR)) NB_INT=NB_INT+size(id%BUFR) + IF (associated(id%STEP)) NB_INT=NB_INT+size(id%STEP) + IF (associated(id%NE_STEPS )) NB_INT=NB_INT+size(id%NE_STEPS ) + IF (associated(id%ND_STEPS)) NB_INT=NB_INT+size(id%ND_STEPS) + IF (associated(id%Step2node)) NB_INT=NB_INT+size(id%Step2node) + IF (associated(id%FRERE_STEPS)) NB_INT=NB_INT+size(id%FRERE_STEPS) + IF (associated(id%DAD_STEPS)) NB_INT=NB_INT+size(id%DAD_STEPS) + IF (associated(id%FILS)) NB_INT=NB_INT+size(id%FILS) + IF (associated(id%PTRAR)) NB_INT=NB_INT+size(id%PTRAR) + IF (associated(id%FRTPTR)) NB_INT=NB_INT+size(id%FRTPTR) + NB_INT=NB_INT+size(id%KEEP8) * id%KEEP(10) + IF (associated(id%PTRFAC)) NB_INT=NB_INT+size(id%PTRFAC) * + & id%KEEP(10) + IF (associated(id%FRTELT)) NB_INT=NB_INT+size(id%FRTELT) + IF (associated(id%NA)) NB_INT=NB_INT+size(id%NA) + IF (associated(id%PROCNODE_STEPS)) + & NB_INT=NB_INT+size(id%PROCNODE_STEPS) + IF (associated(id%PTLUST_S)) NB_INT=NB_INT+size(id%PTLUST_S) + IF (associated(id%PROCNODE)) NB_INT=NB_INT+size(id%PROCNODE) + IF (associated(id%INTARR)) NB_INT=NB_INT+size(id%INTARR) + IF (associated(id%ELTPROC)) NB_INT=NB_INT+size(id%ELTPROC) + IF (associated(id%CANDIDATES)) + & NB_INT=NB_INT+size(id%CANDIDATES) + IF (associated(id%ISTEP_TO_INIV2)) + & NB_INT=NB_INT+size(id%ISTEP_TO_INIV2) + IF (associated(id%FUTURE_NIV2)) + & NB_INT=NB_INT+size(id%FUTURE_NIV2) + IF (associated(id%TAB_POS_IN_PERE)) + & NB_INT=NB_INT+size(id%TAB_POS_IN_PERE) + IF (associated(id%I_AM_CAND)) + & NB_INT=NB_INT+size(id%I_AM_CAND) + IF (associated(id%MEM_DIST)) + & NB_INT=NB_INT+size(id%MEM_DIST) + IF (associated(id%POSINRHSCOMP)) + & NB_INT=NB_INT+size(id%POSINRHSCOMP) + IF (associated(id%MEM_SUBTREE)) + & NB_INT=NB_INT+size(id%MEM_SUBTREE) + IF (associated(id%MY_ROOT_SBTR)) + & NB_INT=NB_INT+size(id%MY_ROOT_SBTR) + IF (associated(id%MY_FIRST_LEAF)) + & NB_INT=NB_INT+size(id%MY_FIRST_LEAF) + IF (associated(id%MY_NB_LEAF)) NB_INT=NB_INT+size(id%MY_NB_LEAF) + IF (associated(id%DEPTH_FIRST)) NB_INT=NB_INT+size(id%DEPTH_FIRST) + IF (associated(id%COST_TRAV)) NB_INT=NB_INT+size(id%COST_TRAV) + IF (associated(id%CB_SON_SIZE)) NB_INT=NB_INT+size(id%CB_SON_SIZE) + IF (associated(id%OOC_INODE_SEQUENCE)) + & NB_INT=NB_INT+size(id%OOC_INODE_SEQUENCE) + IF (associated(id%OOC_SIZE_OF_BLOCK)) + & NB_INT=NB_INT+size(id%OOC_SIZE_OF_BLOCK) + IF (associated(id%OOC_VADDR)) + & NB_INT=NB_INT+size(id%OOC_VADDR) + IF (associated(id%OOC_TOTAL_NB_NODES)) + & NB_INT=NB_INT+size(id%OOC_TOTAL_NB_NODES) + IF (associated(id%OOC_NB_FILES)) + & NB_INT=NB_INT+size(id%OOC_NB_FILES) + IF (associated(id%OOC_FILE_NAME_LENGTH)) + & NB_INT=NB_INT+size(id%OOC_FILE_NAME_LENGTH) + IF (associated(id%PIVNUL_LIST)) NB_INT=NB_INT+size(id%PIVNUL_LIST) + IF (associated(id%SUP_PROC)) NB_INT=NB_INT+size(id%SUP_PROC) + IF (associated(id%DBLARR)) NB_CMPLX=NB_CMPLX+size(id%DBLARR) + IF (associated(id%RHSCOMP)) NB_CMPLX=NB_CMPLX+size(id%RHSCOMP) + IF (associated(id%S)) NB_CMPLX=NB_CMPLX+id%KEEP8(23) + IF (associated(id%COLSCA)) NB_REAL=NB_REAL+size(id%COLSCA) + IF (associated(id%ROWSCA)) NB_REAL=NB_REAL+size(id%ROWSCA) + NB_REAL=NB_REAL+size(id%CNTL) + NB_REAL=NB_REAL+size(id%RINFO) + NB_REAL=NB_REAL+size(id%RINFOG) + NB_REAL=NB_REAL+size(id%DKEEP) + NB_CMPLX = NB_CMPLX + NB_REAL + RETURN + END SUBROUTINE DMUMPS_710 + SUBROUTINE DMUMPS_756(N8,SRC,DEST) + IMPLICIT NONE + INTEGER(8) :: N8 + DOUBLE PRECISION, intent(in) :: SRC(N8) + DOUBLE PRECISION, intent(out) :: DEST(N8) + INTEGER(8) :: SHIFT8, HUG8 + INTEGER :: I, I4SIZE + HUG8=int(huge(I4SIZE),8) + DO I = 1, int(( N8 + HUG8 - 1_8 ) / HUG8) + SHIFT8 = 1_8 + int(I-1,8) * HUG8 + I4SIZE = int(min(HUG8, N8-SHIFT8+1_8)) + CALL dcopy(I4SIZE, SRC(SHIFT8), 1, DEST(SHIFT8), 1) + ENDDO + RETURN + END SUBROUTINE DMUMPS_756 + SUBROUTINE DMUMPS_22( INPLACE, MIN_SPACE_IN_PLACE, + & SSARBR, PROCESS_BANDE, + & MYID,N, KEEP,KEEP8, + & IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP,PIMASTER,PAMASTER, + & LREQ, LREQCB, NODE_ARG, STATE_ARG, SET_HEADER, + & COMP, LRLUS, IFLAG, IERROR ) + USE DMUMPS_LOAD + IMPLICIT NONE + INTEGER N,LIW, KEEP(500) + INTEGER(8) LA, LRLU, IPTRLU, LRLUS, LREQCB + INTEGER(8) PAMASTER(KEEP(28)), PTRAST(KEEP(28)) + INTEGER IWPOS,IWPOSCB + INTEGER(8) :: MIN_SPACE_IN_PLACE + INTEGER NODE_ARG, STATE_ARG + INTEGER(8) KEEP8(150) + INTEGER IW(LIW),PTRIST(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER MYID, IXXP + DOUBLE PRECISION A(LA) + LOGICAL INPLACE, PROCESS_BANDE, SSARBR, SET_HEADER + INTEGER COMP, LREQ, IFLAG, IERROR + INCLUDE 'mumps_headers.h' + INTEGER INODE_LOC,NPIV,NASS,NROW,NCB + INTEGER ISIZEHOLE + INTEGER(8) :: MEM_GAIN, RSIZEHOLE, LREQCB_EFF, LREQCB_WISHED + LOGICAL DONE + IF ( INPLACE ) THEN + LREQCB_EFF = MIN_SPACE_IN_PLACE + IF ( MIN_SPACE_IN_PLACE > 0_8 ) THEN + LREQCB_WISHED = LREQCB + ELSE + LREQCB_WISHED = 0_8 + ENDIF + ELSE + LREQCB_EFF = LREQCB + LREQCB_WISHED = LREQCB + ENDIF + IF (IWPOSCB.EQ.LIW) THEN + IF (LREQ.NE.KEEP(IXSZ).OR.LREQCB.NE.0_8 + & .OR. .NOT. SET_HEADER) THEN + WRITE(*,*) "Internal error in DMUMPS_22", + & SET_HEADER, LREQ, LREQCB + CALL MUMPS_ABORT() + ENDIF + IF (IWPOSCB-IWPOS+1 .LT. KEEP(IXSZ)) THEN + WRITE(*,*) "Problem with integer stack size",IWPOSCB, + & IWPOS, KEEP(IXSZ) + IFLAG = -8 + IERROR = LREQ + RETURN + ENDIF + IWPOSCB=IWPOSCB-KEEP(IXSZ) + IW(IWPOSCB+1+XXI)=KEEP(IXSZ) + CALL MUMPS_730(0_8,IW(IWPOSCB+1+XXR)) + IW(IWPOSCB+1+XXN)=-919191 + IW(IWPOSCB+1+XXS)=S_NOTFREE + IW(IWPOSCB+1+XXP)=TOP_OF_STACK + RETURN + ENDIF + IF (KEEP(214).EQ.1.AND. + & KEEP(216).EQ.1.AND. + & IWPOSCB.NE.LIW) THEN + IF (IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG.OR. + & IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG38) THEN + NCB = IW( IWPOSCB+1 + KEEP(IXSZ) ) + NROW = IW( IWPOSCB+1 + KEEP(IXSZ) + 2) + NPIV = IW( IWPOSCB+1 + KEEP(IXSZ) + 3) + INODE_LOC= IW( IWPOSCB+1 + XXN) + CALL DMUMPS_632(IWPOSCB+1,IW,LIW, + & ISIZEHOLE,RSIZEHOLE) + IF (IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG) THEN + CALL DMUMPS_627(A,LA,IPTRLU+1_8, + & NROW,NCB,NPIV+NCB,0, + & IW(IWPOSCB+1 + XXS),RSIZEHOLE) + IW(IWPOSCB+1 + XXS) =S_NOLCLEANED + MEM_GAIN = int(NROW,8)*int(NPIV,8) + ENDIF + IF (IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG38) THEN + NASS = IW( IWPOSCB+1 + KEEP(IXSZ) + 4) + CALL DMUMPS_627(A,LA,IPTRLU+1_8, + & NROW,NCB,NPIV+NCB,NASS-NPIV, + & IW(IWPOSCB+1 + XXS),RSIZEHOLE) + IW(IWPOSCB+1 + XXS) =S_NOLCLEANED38 + MEM_GAIN = int(NROW,8)*int(NPIV+NCB-(NASS-NPIV),8) + ENDIF + IF (ISIZEHOLE.NE.0) THEN + CALL DMUMPS_630( IW,LIW,IWPOSCB+1, + & IWPOSCB+IW(IWPOSCB+1+XXI), + & ISIZEHOLE ) + IWPOSCB=IWPOSCB+ISIZEHOLE + IW(IWPOSCB+1+XXP+IW(IWPOSCB+1+XXI))=IWPOSCB+1 + PTRIST(STEP(INODE_LOC))=PTRIST(STEP(INODE_LOC))+ + & ISIZEHOLE + ENDIF + CALL MUMPS_724(IW(IWPOSCB+1+XXR), MEM_GAIN) + IPTRLU = IPTRLU+MEM_GAIN+RSIZEHOLE + LRLU = LRLU+MEM_GAIN+RSIZEHOLE + PTRAST(STEP(INODE_LOC))= + & PTRAST(STEP(INODE_LOC))+MEM_GAIN+RSIZEHOLE + ENDIF + ENDIF + DONE =.FALSE. + IF ((IPTRLU.LT.LREQCB_WISHED).OR.(LRLU.LT.LREQCB_WISHED)) THEN + IF (LRLUS.LT.LREQCB_EFF) THEN + GOTO 620 + ELSE + CALL DMUMPS_94(N,KEEP(28),IW,LIW,A,LA, + & LRLU,IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST, + & STEP, PIMASTER,PAMASTER,KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress... alloc_cb', + & 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 620 + END IF + DONE = .TRUE. + COMP = COMP + 1 + ENDIF + ENDIF + IF (IWPOSCB-IWPOS+1 .LT. LREQ) THEN + IF (DONE) GOTO 600 + CALL DMUMPS_94(N,KEEP(28),IW,LIW,A,LA, + & LRLU,IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST, + & STEP, PIMASTER,PAMASTER,KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress... alloc_cb', + & 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 620 + END IF + COMP = COMP + 1 + IF (IWPOSCB-IWPOS+1 .LT. LREQ) GOTO 600 + ENDIF + IXXP=IWPOSCB+XXP+1 + IF (IXXP.GT.LIW) THEN + WRITE(*,*) "Internal error 3 in DMUMPS_22",IXXP + ENDIF + IF (IW(IXXP).GT.0) THEN + WRITE(*,*) "Internal error 2 in DMUMPS_22",IW(IXXP),IXXP + ENDIF + IWPOSCB = IWPOSCB - LREQ + IF (SET_HEADER) THEN + IW(IXXP)= IWPOSCB + 1 + IW(IWPOSCB+1+XXI)=LREQ + CALL MUMPS_730(LREQCB, IW(IWPOSCB+1+XXR)) + IW(IWPOSCB+1+XXS)=STATE_ARG + IW(IWPOSCB+1+XXN)=NODE_ARG + IW(IWPOSCB+1+XXP)=TOP_OF_STACK + ENDIF + IPTRLU = IPTRLU - LREQCB + LRLU = LRLU - LREQCB + LRLUS = LRLUS - LREQCB_EFF + KEEP8(67) = min(LRLUS, KEEP8(67)) +#if ! defined(OLD_LOAD_MECHANISM) + CALL DMUMPS_471(SSARBR,PROCESS_BANDE, + & LA-LRLUS,0_8,LREQCB_EFF,KEEP,KEEP8,LRLU) +#else +#if defined (CHECK_COHERENCE) + CALL DMUMPS_471(SSARBR,PROCESS_BANDE, + & LA-LRLUS,0_8,LREQCB_EFF,KEEP,KEEP8,LRLU) +#else + CALL DMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,0_8,LREQCB_EFF,KEEP,KEEP8,LRLU) +#endif +#endif + RETURN + 600 IFLAG = -8 + IERROR = LREQ + RETURN + 620 IFLAG = -9 + CALL MUMPS_731(LREQCB_EFF - LRLUS, IERROR) + RETURN + END SUBROUTINE DMUMPS_22 + SUBROUTINE DMUMPS_244(N, NSTEPS, + & A, LA, IW, LIW, SYM_PERM, NA, LNA, + & NE_STEPS, NFSIZ, FILS, + & STEP, FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & PTRAR, LDPTRAR, + & PTRIST, PTLUST_S, PTRFAC, IW1, IW2, ITLOC, RHS_MUMPS, + & POOL, LPOOL, + & CNTL1, ICNTL, INFO, RINFO, KEEP,KEEP8,PROCNODE_STEPS, + & SLAVEF, + & COMM_NODES, MYID, MYID_NODES, + & BUFR,LBUFR,LBUFR_BYTES,INTARR,DBLARR, + & root, NELT, FRTPTR, FRTELT, COMM_LOAD, + & ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, + & MEM_DISTRIB, + & DKEEP,PIVNUL_LIST,LPN_LIST) + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER(8) :: LA + INTEGER N,NSTEPS,LIW,LPOOL,SLAVEF,COMM_NODES + INTEGER MYID, MYID_NODES,LNA + DOUBLE PRECISION A(LA) + DOUBLE PRECISION RINFO(40) + INTEGER LBUFR, LBUFR_BYTES + INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB + INTEGER BUFR( LBUFR ) + INTEGER NELT, LDPTRAR + INTEGER FRTPTR(*), FRTELT(*) + DOUBLE PRECISION CNTL1 + INTEGER ICNTL(40) + INTEGER INFO(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IW(LIW), SYM_PERM(N), NA(LNA), + & NE_STEPS(KEEP(28)), FILS(N), + & FRERE(KEEP(28)), NFSIZ(KEEP(28)), + & DAD(KEEP(28)) + INTEGER CAND(SLAVEF+1, max(1,KEEP(56))) + INTEGER STEP(N) + INTEGER PTRAR(LDPTRAR,2) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER IW1(3*KEEP(28)), ITLOC(N+KEEP(253)), POOL(LPOOL) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: IW2(2*KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR(max(1,KEEP(14))) + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + DOUBLE PRECISION SEUIL, SEUIL_LDLT_NIV2 + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + DOUBLE PRECISION UULOC + INTEGER LP, MPRINT + INTEGER NSTK,PTRAST, NBPROCFILS + INTEGER PIMASTER, PAMASTER + LOGICAL PROK + DOUBLE PRECISION ZERO, ONE + DATA ZERO /0.0D0/ + DATA ONE /1.0D0/ + INTRINSIC int,real,log + INTEGER IERR + INTEGER NTOTPV, NTOTPVTOT, NMAXNPIV + INTEGER(8) :: POSFAC, LRLU, IPTRLU, LRLUS + INTEGER IWPOS, LEAF, NBROOT, NROOT + KEEP(41)=0 + KEEP(42)=0 + NSTEPS = 0 + LP = ICNTL(1) + MPRINT = ICNTL(2) + PROK = (MPRINT.GT.0) + UULOC = CNTL1 + IF (UULOC.GT.ONE) UULOC=ONE + IF (UULOC.LT.ZERO) UULOC=ZERO + IF (KEEP(50).NE.0.AND.UULOC.GT.0.5D0) THEN + UULOC = 0.5D0 + ENDIF + PIMASTER = 1 + NSTK = PIMASTER + KEEP(28) + NBPROCFILS = NSTK + KEEP(28) + PTRAST = 1 + PAMASTER = 1 + KEEP(28) + IF (KEEP(4).LE.0) KEEP(4)=32 + IF (KEEP(5).LE.0) KEEP(5)=16 + IF (KEEP(5).GT.KEEP(4)) KEEP(5) = KEEP(4) + IF (KEEP(6).LE.0) KEEP(6)=24 + IF (KEEP(3).LE.KEEP(4)) KEEP(3)=KEEP(4)*2 + IF (KEEP(6).GT.KEEP(3)) KEEP(6) = KEEP(3) + POSFAC = 1_8 + IWPOS = 1 + LRLU = LA + LRLUS = LRLU + KEEP8(67) = LRLUS + IPTRLU = LRLU + NTOTPV = 0 + NMAXNPIV = 0 + IW1(NSTK:NSTK+KEEP(28)-1) = NE_STEPS(1:KEEP(28)) + CALL MUMPS_362(N, LEAF, NBROOT, NROOT, + & MYID_NODES, + & SLAVEF, NA, LNA, + & KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & POOL, LPOOL) + CALL DMUMPS_506(POOL, LPOOL, LEAF) + CALL DMUMPS_555(POOL, LPOOL,KEEP,KEEP8) + IF ( KEEP( 38 ) .NE. 0 ) THEN + NBROOT = NBROOT + root%NPROW * root%NPCOL - 1 + END IF + IF ( root%yes ) THEN + IF ( MUMPS_275( PROCNODE_STEPS(STEP(KEEP(38))), SLAVEF ) + & .NE. MYID_NODES ) THEN + NROOT = NROOT + 1 + END IF + END IF + CALL DMUMPS_251(N,IW,LIW,A,LA,IW1(NSTK),IW1(NBPROCFILS), + & INFO(1),NFSIZ,FILS,STEP,FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & INFO(11), NTOTPV, NMAXNPIV, PTRIST,IW2(PTRAST), + & IW1(PIMASTER), IW2(PAMASTER), PTRAR(1,2), + & PTRAR(1,1), + & ITLOC, RHS_MUMPS, INFO(2), POOL, LPOOL, + & RINFO, POSFAC,IWPOS,LRLU,IPTRLU, + & LRLUS, LEAF, NROOT, NBROOT, + & UULOC,ICNTL,PTLUST_S,PTRFAC,NSTEPS,INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS,SLAVEF,MYID,COMM_NODES, + & MYID_NODES, BUFR,LBUFR, LBUFR_BYTES, + & INTARR, DBLARR, root, SYM_PERM, + & NELT, FRTPTR, FRTELT, LDPTRAR, + & COMM_LOAD, ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, + & MEM_DISTRIB,NE_STEPS, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST) + POSFAC = POSFAC -1_8 + IWPOS = IWPOS -1 + IF (KEEP(201).LE.0) THEN + KEEP8(31) = POSFAC + ENDIF + KEEP(32) = IWPOS + CALL MUMPS_735(KEEP8(31), INFO(9)) + INFO(10) = KEEP(32) + KEEP8(67) = LA - KEEP8(67) + KEEP(89) = NTOTPV + KEEP(246) = NMAXNPIV + INFO(23) = KEEP(89) + CALL MPI_ALLREDUCE(NTOTPV, NTOTPVTOT, 1, MPI_INTEGER, MPI_SUM, + & COMM_NODES, IERR) + IF ( ( (INFO(1).EQ.-10 .OR. INFO(1).EQ.-40) + & .AND. (NTOTPVTOT.EQ.N) ) + & .OR. ( NTOTPVTOT.GT.N ) ) THEN + write(*,*) ' Error 1 in mc51d NTOTPVTOT=', NTOTPVTOT + CALL MUMPS_ABORT() + ENDIF + IF ( (KEEP(19).NE.0 ) .AND. (NTOTPVTOT.NE.N) .AND. + & (INFO(1).GE.0) ) THEN + write(*,*) ' Error 2 in mc51d NTOTPVTOT=', NTOTPVTOT + CALL MUMPS_ABORT() + ENDIF + IF ( (INFO(1) .GE. 0 ) + & .AND. (NTOTPVTOT.NE.N) ) THEN + INFO(1) = -10 + INFO(2) = NTOTPVTOT + ENDIF + IF (PROK) THEN + WRITE (MPRINT,99980) INFO(1), INFO(2), + & KEEP(28), KEEP8(31), INFO(10), INFO(11), INFO(12), + & INFO(13), INFO(14), INFO(25), RINFO(2), RINFO(3) + ENDIF + RETURN +99980 FORMAT (/' LEAVING FACTORIZATION PHASE WITH ...'/ + & ' INFO (1) =',I15/ + & ' --- (2) =',I15/ + & ' NUMBER OF NODES IN THE TREE =',I15/ + & ' INFO (9) REAL SPACE FOR FACTORS =',I15/ + & ' --- (10) INTEGER SPACE FOR FACTORS =',I15/ + & ' --- (11) MAXIMUM SIZE OF FRONTAL MATRICES =',I15/ + & ' --- (12) NUMBER OF OFF DIAGONAL PIVOTS =',I15/ + & ' --- (13) NUMBER OF DELAYED PIVOTS =',I15/ + & ' --- (14) NUMBER OF MEMORY COMPRESSES =',I15/ + & ' --- (25) NUMBER OF ENTRIES IN FACTORS =',I15/ + & ' RINFO(2) OPERATIONS DURING NODE ASSEMBLY =',1PD10.3/ + & ' -----(3) OPERATIONS DURING NODE ELIMINATION =',1PD10.3) +99990 FORMAT(/ ' NUMBER OF MSGS RECVD FOR DYNAMIC LOAD =',I15) + END SUBROUTINE DMUMPS_244 + SUBROUTINE DMUMPS_269( MYID,KEEP,KEEP8, + & BUFR, LBUFR, LBUFR_BYTES, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, + & N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, + & FPERE, FLAG, IFLAG, IERROR, COMM, + & ITLOC, RHS_MUMPS ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER MYID + INTEGER LBUFR, LBUFR_BYTES + INTEGER KEEP(500), BUFR( LBUFR ) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER(8) :: PTRAST (KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP, FPERE + LOGICAL FLAG + INTEGER NSTK_S( KEEP(28) ), ITLOC( N + KEEP(253) ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER IFLAG, IERROR, COMM + INTEGER POSITION, FINODE, FLCONT, LREQ + INTEGER(8) :: LREQCB + INTEGER(8) :: IPOS_NODE, ISHIFT_PACKET + INTEGER SIZE_PACKET + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INCLUDE 'mumps_headers.h' + LOGICAL COMPRESSCB + FLAG = .FALSE. + POSITION = 0 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & FINODE, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & FPERE, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & FLCONT, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, MPI_INTEGER, + & COMM, IERR) + COMPRESSCB = (FLCONT.LT.0) + IF (COMPRESSCB) THEN + FLCONT = -FLCONT + LREQCB = (int(FLCONT,8) * int(FLCONT+1,8)) / 2_8 + ELSE + LREQCB = int(FLCONT,8) * int(FLCONT,8) + ENDIF + IF (NBROWS_ALREADY_SENT == 0) THEN + LREQ = 2 * FLCONT + 6 + KEEP(IXSZ) + IF (IPTRLU.LT.0_8) WRITE(*,*) 'before alloc_cb:IPTRLU = ',IPTRLU + CALL DMUMPS_22( .FALSE., 0_8, .FALSE.,.FALSE., + & MYID,N, KEEP,KEEP8, IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, + & LREQ, LREQCB, FINODE, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF (IPTRLU.LT.0_8) WRITE(*,*) 'after alloc_cb:IPTRLU = ',IPTRLU + IF ( IFLAG .LT. 0 ) RETURN + PIMASTER(STEP( FINODE )) = IWPOSCB + 1 + PAMASTER(STEP( FINODE )) = IPTRLU + 1_8 + IF (COMPRESSCB) IW(IWPOSCB + 1 + XXS ) = S_CB1COMP + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IW(IWPOSCB + 1+KEEP(IXSZ)), LREQ-KEEP(IXSZ), + & MPI_INTEGER, COMM, IERR) + ENDIF + IF (COMPRESSCB) THEN + ISHIFT_PACKET = int(NBROWS_ALREADY_SENT,8) * + & int(NBROWS_ALREADY_SENT+1,8) / 2_8 + SIZE_PACKET = (NBROWS_PACKET * (NBROWS_PACKET+1))/2 + + & NBROWS_ALREADY_SENT * NBROWS_PACKET + ELSE + ISHIFT_PACKET = int(NBROWS_ALREADY_SENT,8) * int(FLCONT,8) + SIZE_PACKET = NBROWS_PACKET * FLCONT + ENDIF + IF (NBROWS_PACKET.NE.0) THEN + IF ( LREQCB .ne. 0_8 ) THEN + IPOS_NODE = PAMASTER(STEP(FINODE))-1_8 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & A(IPOS_NODE + 1_8 + ISHIFT_PACKET), + & SIZE_PACKET, MPI_DOUBLE_PRECISION, COMM, IERR) + END IF + ENDIF + IF (NBROWS_ALREADY_SENT+NBROWS_PACKET == FLCONT) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF ( NSTK_S(STEP(FPERE)).EQ.0 ) THEN + FLAG = . TRUE. + END IF + ENDIF + RETURN + END SUBROUTINE DMUMPS_269 + SUBROUTINE DMUMPS_270( TOT_ROOT_SIZE, + & TOT_CONT_TO_RECV, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND) + USE DMUMPS_LOAD + USE DMUMPS_OOC + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER TOT_ROOT_SIZE, TOT_CONT_TO_RECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA, POSFAC + INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ), ND( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM, COMM_LOAD + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC(N+KEEP(253)), FILS(N), PTRARW(N), PTRAIW(N) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + INTEGER :: allocok + DOUBLE PRECISION, DIMENSION(:,:), POINTER :: TMP + INTEGER NEW_LOCAL_M, NEW_LOCAL_N + INTEGER OLD_LOCAL_M, OLD_LOCAL_N + INTEGER I, J + INTEGER LREQI, IROOT + INTEGER(8) :: LREQA + INTEGER POSHEAD, IPOS_SON,IERR + LOGICAL MASTER_OF_ROOT + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INCLUDE 'mumps_headers.h' + INTEGER numroc, MUMPS_275 + EXTERNAL numroc, MUMPS_275 + IROOT = KEEP( 38 ) + root%TOT_ROOT_SIZE = TOT_ROOT_SIZE + MASTER_OF_ROOT = ( MYID .EQ. + & MUMPS_275( PROCNODE_STEPS(STEP(IROOT)), + & SLAVEF ) ) + NEW_LOCAL_M = numroc( TOT_ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + NEW_LOCAL_M = max( 1, NEW_LOCAL_M ) + NEW_LOCAL_N = numroc( TOT_ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + IF ( PTRIST(STEP( IROOT )).GT.0) THEN + OLD_LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) ) + OLD_LOCAL_M = IW( PTRIST(STEP( IROOT )) + 1 + KEEP(IXSZ)) + ELSE + OLD_LOCAL_N = 0 + OLD_LOCAL_M = NEW_LOCAL_M + ENDIF + IF (KEEP(60) .NE. 0) THEN + IF (root%yes) THEN + IF ( NEW_LOCAL_M .NE. root%SCHUR_MLOC .OR. + & NEW_LOCAL_N .NE. root%SCHUR_NLOC ) THEN + WRITE(*,*) "Internal error 1 in DMUMPS_270" + CALL MUMPS_ABORT() + ENDIF + ENDIF + PTLUST_S(STEP(IROOT)) = -4444 + PTRFAC(STEP(IROOT)) = -4445_8 + PTRIST(STEP(IROOT)) = 0 + IF ( MASTER_OF_ROOT ) THEN + LREQI=6+2*TOT_ROOT_SIZE+KEEP(IXSZ) + LREQA=0_8 + IF ( IWPOS + LREQI - 1. GT. IWPOSCB ) THEN + CALL DMUMPS_94( N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB1 compress root2slave:LRLU,LRLUS=', + & LRLU, LRLUS + IFLAG = -9 + CALL MUMPS_731(LREQA-LRLUS, IERROR) + GOTO 700 + END IF + ENDIF + IF ( IWPOS + LREQI - 1. GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + GOTO 700 + ENDIF + PTLUST_S(STEP(IROOT))= IWPOS + IWPOS = IWPOS + LREQI + POSHEAD = PTLUST_S( STEP(IROOT)) + IW( POSHEAD + XXI )=LREQI + CALL MUMPS_730( LREQA, IW(POSHEAD + XXR)) + IW( POSHEAD + XXS )=-9999 + IW( POSHEAD +KEEP(IXSZ)) = 0 + IW( POSHEAD + 1 +KEEP(IXSZ)) = -1 + IW( POSHEAD + 2 +KEEP(IXSZ)) = -1 + IW( POSHEAD + 4 +KEEP(IXSZ)) = STEP(IROOT) + IW( POSHEAD + 5 +KEEP(IXSZ)) = 0 + IW( POSHEAD + 3 +KEEP(IXSZ)) = TOT_ROOT_SIZE + ENDIF + GOTO 100 + ENDIF + IF ( MASTER_OF_ROOT ) THEN + LREQI = 6 + 2 * TOT_ROOT_SIZE+KEEP(IXSZ) + ELSE + LREQI = 6+KEEP(IXSZ) + END IF + LREQA = int(NEW_LOCAL_M, 8) * int(NEW_LOCAL_N, 8) + IF ( LRLU . LT. LREQA .OR. + & IWPOS + LREQI - 1. GT. IWPOSCB )THEN + IF ( LRLUS .LT. LREQA ) THEN + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GOTO 700 + END IF + CALL DMUMPS_94( N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB2 compress root2slave:LRLU,LRLUS=', + & LRLU, LRLUS + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GOTO 700 + END IF + IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + GOTO 700 + END IF + END IF + PTLUST_S(STEP( IROOT )) = IWPOS + IWPOS = IWPOS + LREQI + IF (LREQA.EQ.0_8) THEN + PTRAST (STEP(IROOT)) = max(POSFAC-1_8,1_8) + PTRFAC (STEP(IROOT)) = max(POSFAC-1_8,1_8) + ELSE + PTRAST (STEP(IROOT)) = POSFAC + PTRFAC (STEP(IROOT)) = POSFAC + ENDIF + POSFAC = POSFAC + LREQA + LRLU = LRLU - LREQA + LRLUS = LRLUS - LREQA + KEEP8(67) = min(KEEP8(67), LRLUS) + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU) + POSHEAD = PTLUST_S( STEP(IROOT)) + IW( POSHEAD + XXI ) = LREQI + CALL MUMPS_730( LREQA, IW(POSHEAD + XXR)) + IW( POSHEAD + XXS ) = S_NOTFREE + IW( POSHEAD + KEEP(IXSZ) ) = 0 + IW( POSHEAD + 1 + KEEP(IXSZ) ) = NEW_LOCAL_N + IW( POSHEAD + 2 + KEEP(IXSZ) ) = NEW_LOCAL_M + IW( POSHEAD + 4 + KEEP(IXSZ) ) = STEP(IROOT) + IW( POSHEAD + 5 + KEEP(IXSZ) ) = 0 + IF ( MASTER_OF_ROOT ) THEN + IW( POSHEAD + 3 + KEEP(IXSZ) ) = TOT_ROOT_SIZE + ELSE + IW( POSHEAD + 3 + KEEP(IXSZ) ) = 0 + ENDIF + IF ( KEEP( 50 ) .eq. 0 .OR. KEEP(50) .eq. 2 ) THEN + OPELIW = OPELIW + ( dble(2*TOT_ROOT_SIZE) * + & dble(TOT_ROOT_SIZE) * dble(TOT_ROOT_SIZE ) / dble(3) + & - 0.5d0 * dble( TOT_ROOT_SIZE ) * dble( TOT_ROOT_SIZE ) + & - dble( TOT_ROOT_SIZE ) / dble( 6 ) ) + & / dble( root%NPROW * root%NPCOL ) + ELSE + OPELIW = OPELIW + ( dble(TOT_ROOT_SIZE) * + & dble( TOT_ROOT_SIZE) * + & dble( TOT_ROOT_SIZE + 1 ) ) + & / dble( 3 * root%NPROW * root%NPCOL ) + END IF + IF ( PTRIST(STEP( IROOT )) .LE. 0 ) THEN + PTRIST(STEP( IROOT )) = 0 + PAMASTER(STEP( IROOT )) = 0_8 + IF (LREQA.GT.0_8) A(PTRAST(STEP(IROOT)): + & PTRAST(STEP(IROOT))+LREQA-1_8) = ZERO + ELSE + OLD_LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) ) + OLD_LOCAL_M = IW( PTRIST(STEP( IROOT )) + 1 + KEEP(IXSZ)) + IF ( TOT_ROOT_SIZE .eq. root%ROOT_SIZE ) THEN + IF ( LREQA .NE. int(OLD_LOCAL_M,8) * int(OLD_LOCAL_N,8) ) + & THEN + write(*,*) 'error 1 in PROCESS_ROOT2SLAVE', + & OLD_LOCAL_M, OLD_LOCAL_N + CALL MUMPS_ABORT() + END IF + CALL DMUMPS_756(LREQA, + & A( PAMASTER(STEP(IROOT)) ), + & A( PTRAST (STEP(IROOT)) ) ) + ELSE + CALL DMUMPS_96( A( PTRAST(STEP(IROOT))), + & NEW_LOCAL_M, + & NEW_LOCAL_N, A( PAMASTER( STEP(IROOT)) ), OLD_LOCAL_M, + & OLD_LOCAL_N ) + END IF + IF ( PTRIST( STEP( IROOT ) ) .GT. 0 ) THEN + IPOS_SON= PTRIST( STEP(IROOT)) + CALL DMUMPS_152(.FALSE., MYID, N, IPOS_SON, + & PAMASTER(STEP(IROOT)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + PTRIST(STEP( IROOT )) = 0 + PAMASTER(STEP( IROOT )) = 0_8 + END IF + END IF + IF (NEW_LOCAL_M.GT.OLD_LOCAL_M) THEN + TMP => root%RHS_ROOT + NULLIFY(root%RHS_ROOT) + ALLOCATE (root%RHS_ROOT(NEW_LOCAL_M, root%RHS_NLOC), + & stat=allocok) + IF ( allocok.GT.0) THEN + IFLAG=-13 + IERROR = NEW_LOCAL_M*root%RHS_NLOC + GOTO 700 + ENDIF + DO J = 1, root%RHS_NLOC + DO I = 1, OLD_LOCAL_M + root%RHS_ROOT(I,J)=TMP(I,J) + ENDDO + DO I = OLD_LOCAL_M+1, NEW_LOCAL_M + root%RHS_ROOT(I,J) = ZERO + ENDDO + ENDDO + DEALLOCATE(TMP) + NULLIFY(TMP) + ENDIF + 100 CONTINUE + NBPROCFILS(STEP(IROOT))=NBPROCFILS(STEP(IROOT)) + TOT_CONT_TO_RECV + IF ( NBPROCFILS(STEP(IROOT)) .eq. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + CALL DMUMPS_681(IERR) + ELSE IF (KEEP(201).EQ.2) THEN + CALL DMUMPS_580(IERR) + ENDIF + CALL DMUMPS_507( N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IROOT + N ) + IF (KEEP(47) .GE. 3) THEN + CALL DMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + RETURN + 700 CONTINUE + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE DMUMPS_270 + SUBROUTINE DMUMPS_96 + &( NEW, M_NEW, N_NEW,OLD, M_OLD, N_OLD ) + INTEGER M_NEW, N_NEW, M_OLD, N_OLD + DOUBLE PRECISION NEW( M_NEW, N_NEW ), OLD( M_OLD, N_OLD ) + INTEGER J + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + DO J = 1, N_OLD + NEW( 1: M_OLD, J ) = OLD( 1: M_OLD, J ) + NEW( M_OLD + 1: M_NEW, J ) = ZERO + END DO + NEW( 1: M_NEW,N_OLD + 1: N_NEW ) = ZERO + RETURN + END SUBROUTINE DMUMPS_96 + INTEGER FUNCTION DMUMPS_505(KEEP,KEEP8) + IMPLICIT NONE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + DMUMPS_505 = KEEP(28) + 1 + 3 + RETURN + END FUNCTION DMUMPS_505 + SUBROUTINE DMUMPS_506(IPOOL, LPOOL, LEAF) + USE DMUMPS_LOAD + IMPLICIT NONE + INTEGER LPOOL, LEAF + INTEGER IPOOL(LPOOL) + IPOOL(LPOOL-2) = 0 + IPOOL(LPOOL-1) = 0 + IPOOL(LPOOL) = LEAF-1 + RETURN + END SUBROUTINE DMUMPS_506 + SUBROUTINE DMUMPS_507 + & (N, POOL, LPOOL, PROCNODE, SLAVEF, + & K28, K76, K80, K47, STEP, INODE) + USE DMUMPS_LOAD + IMPLICIT NONE + INTEGER N, INODE, LPOOL, K28, SLAVEF, K76, K80, K47 + INTEGER STEP(N), POOL(LPOOL), PROCNODE(K28) + EXTERNAL MUMPS_170 + LOGICAL MUMPS_170, ATM_CURRENT_NODE + INTEGER NBINSUBTREE, NBTOP, INODE_EFF,POS_TO_INSERT + INTEGER IPOS1, IPOS2, ISWAP + INTEGER NODE,J,I + ATM_CURRENT_NODE = ( K76 == 2 .OR. K76 ==3 .OR. + & K76==4 .OR. K76==5) + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + IF (INODE > N ) THEN + INODE_EFF = INODE - N + ELSE IF (INODE < 0) THEN + INODE_EFF = - INODE + ELSE + INODE_EFF = INODE + ENDIF + IF(((INODE.GT.0).AND.(INODE.LE.N)).AND.(.NOT. + & MUMPS_170(PROCNODE(STEP(INODE_EFF)), + & SLAVEF)) + & ) THEN + IF ((K80 == 1 .AND. K47 .GE. 1) .OR. + & (( K80 == 2 .OR. K80==3 ) .AND. + & ( K47 == 4 ))) THEN + CALL DMUMPS_514(INODE,1) + ENDIF + ENDIF + IF ( MUMPS_170(PROCNODE(STEP(INODE_EFF)), + & SLAVEF) ) THEN + POOL(NBINSUBTREE + 1 ) = INODE + NBINSUBTREE = NBINSUBTREE + 1 + ELSE + POS_TO_INSERT=NBTOP+1 + IF((K76.EQ.4).OR.(K76.EQ.5))THEN +#if defined(NOT_ATM_POOL_SPECIAL) + J=NBTOP +#else + IF((INODE.GT.N).OR.(INODE.LE.0))THEN + DO J=NBTOP,1,-1 + IF((POOL(LPOOL-2-J).GT.0) + & .AND.(POOL(LPOOL-2-J).LE.N))THEN + GOTO 333 + ENDIF + IF ( POOL(LPOOL-2-J) < 0 ) THEN + NODE=-POOL(LPOOL-2-J) + ELSE IF ( POOL(LPOOL-2-J) > N ) THEN + NODE = POOL(LPOOL-2-J) - N + ELSE + NODE = POOL(LPOOL-2-J) + ENDIF + IF(K76.EQ.4)THEN + IF(DEPTH_FIRST_LOAD(STEP(NODE)).GE. + & DEPTH_FIRST_LOAD(STEP(INODE_EFF)))THEN + GOTO 333 + ENDIF + ENDIF + IF(K76.EQ.5)THEN + IF(COST_TRAV(STEP(NODE)).LE. + & COST_TRAV(STEP(INODE_EFF)))THEN + GOTO 333 + ENDIF + ENDIF + POS_TO_INSERT=POS_TO_INSERT-1 + ENDDO + IF(J.EQ.0) J=1 + 333 CONTINUE + DO I=NBTOP,POS_TO_INSERT,-1 + POOL(LPOOL-2-I-1)=POOL(LPOOL-2-I) + ENDDO + POOL(LPOOL-2-POS_TO_INSERT)=INODE + NBTOP = NBTOP + 1 + GOTO 20 + ENDIF + DO J=NBTOP,1,-1 + IF((POOL(LPOOL-2-J).GT.0).AND.(POOL(LPOOL-2-J).LE.N))THEN + GOTO 888 + ENDIF + POS_TO_INSERT=POS_TO_INSERT-1 + ENDDO + 888 CONTINUE +#endif + DO I=J,1,-1 +#if defined(NOT_ATM_POOL_SPECIAL) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE = POOL(LPOOL-2-I) - N + ELSE + NODE = POOL(LPOOL-2-I) + ENDIF +#else + NODE=POOL(LPOOL-2-I) +#endif + IF(K76.EQ.4)THEN + IF(DEPTH_FIRST_LOAD(STEP(NODE)).GE. + & DEPTH_FIRST_LOAD(STEP(INODE_EFF)))THEN + GOTO 999 + ENDIF + ENDIF + IF(K76.EQ.5)THEN + IF(COST_TRAV(STEP(NODE)).LE. + & COST_TRAV(STEP(INODE_EFF)))THEN + GOTO 999 + ENDIF + ENDIF + POS_TO_INSERT=POS_TO_INSERT-1 + ENDDO + IF(I.EQ.0) I=1 + 999 CONTINUE + DO J=NBTOP,POS_TO_INSERT,-1 + POOL(LPOOL-2-J-1)=POOL(LPOOL-2-J) + ENDDO + POOL(LPOOL-2-POS_TO_INSERT)=INODE + NBTOP = NBTOP + 1 + GOTO 20 + ENDIF + POOL( LPOOL - 2 - ( NBTOP + 1 ) ) = INODE + NBTOP = NBTOP + 1 + IPOS1 = LPOOL - 2 - NBTOP + IPOS2 = LPOOL - 2 - NBTOP + 1 + 10 CONTINUE + IF ( IPOS2 == LPOOL - 2 ) GOTO 20 + IF ( POOL(IPOS1) < 0 ) GOTO 20 + IF ( POOL(IPOS2) < 0 ) GOTO 30 + IF ( ATM_CURRENT_NODE ) THEN + IF ( POOL(IPOS1) > N ) GOTO 20 + IF ( POOL(IPOS2) > N ) GOTO 30 + END IF + GOTO 20 + 30 CONTINUE + ISWAP = POOL(IPOS1) + POOL(IPOS1) = POOL(IPOS2) + POOL(IPOS2) = ISWAP + IPOS1 = IPOS1 + 1 + IPOS2 = IPOS2 + 1 + GOTO 10 + 20 CONTINUE + ENDIF + POOL(LPOOL) = NBINSUBTREE + POOL(LPOOL - 1) = NBTOP + RETURN + END SUBROUTINE DMUMPS_507 + LOGICAL FUNCTION DMUMPS_508(POOL, LPOOL) + IMPLICIT NONE + INTEGER LPOOL + INTEGER POOL(LPOOL) + INTEGER NBINSUBTREE, NBTOP + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + DMUMPS_508 = (NBINSUBTREE + NBTOP == 0) + RETURN + END FUNCTION DMUMPS_508 + SUBROUTINE DMUMPS_509( N, POOL, LPOOL, PROCNODE, SLAVEF, + & STEP, INODE, KEEP,KEEP8, MYID, ND, + & FORCE_EXTRACT_TOP_SBTR ) + USE DMUMPS_LOAD + IMPLICIT NONE + INTEGER INODE, LPOOL, SLAVEF, N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER STEP(N), POOL(LPOOL), PROCNODE(KEEP(28)), + & ND(KEEP(28)) + EXTERNAL MUMPS_167, MUMPS_283, DMUMPS_508 + LOGICAL MUMPS_167, MUMPS_283, DMUMPS_508 + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + INTEGER NBINSUBTREE, NBTOP, INSUBTREE, INODE_EFF, MYID + LOGICAL LEFT, ATOMIC_SUBTREE,UPPER,FLAG_MEM,SBTR_FLAG,PROC_FLAG + LOGICAL FORCE_EXTRACT_TOP_SBTR + INTEGER NODE_TO_EXTRACT,I,J,MIN_PROC +#if defined(POOL_EXTRACT_MNG) + INTEGER POS_TO_EXTRACT +#endif + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + IF ( KEEP(76) > 6 .OR. KEEP(76) < 0 ) THEN + WRITE(*,*) "Error 2 in DMUMPS_509: unknown strategy" + CALL MUMPS_ABORT() + ENDIF + ATOMIC_SUBTREE = ( KEEP(76) == 1 .OR. KEEP(76) == 3) + IF ( DMUMPS_508(POOL, LPOOL) ) THEN + WRITE(*,*) "Error 1 in DMUMPS_509" + CALL MUMPS_ABORT() + ENDIF + IF ( .NOT. ATOMIC_SUBTREE ) THEN + LEFT = (NBTOP == 0) + IF(.NOT.LEFT)THEN + IF((KEEP(76).EQ.4).OR.(KEEP(76).EQ.5))THEN + IF(NBINSUBTREE.EQ.0)THEN + LEFT=.FALSE. + ELSE + IF ( POOL(NBINSUBTREE) < 0 ) THEN + I = -POOL(NBINSUBTREE) + ELSE IF ( POOL(NBINSUBTREE) > N ) THEN + I = POOL(NBINSUBTREE) - N + ELSE + I = POOL(NBINSUBTREE) + ENDIF + IF ( POOL(LPOOL-2-NBTOP) < 0 ) THEN + J = -POOL(LPOOL-2-NBTOP) + ELSE IF ( POOL(LPOOL-2-NBTOP) > N ) THEN + J = POOL(LPOOL-2-NBTOP) - N + ELSE + J = POOL(LPOOL-2-NBTOP) + ENDIF + IF(KEEP(76).EQ.4)THEN + IF(DEPTH_FIRST_LOAD(STEP(J)).GE. + & DEPTH_FIRST_LOAD(STEP(I)))THEN + LEFT=.TRUE. + ELSE + LEFT=.FALSE. + ENDIF + ENDIF + IF(KEEP(76).EQ.5)THEN + IF(COST_TRAV(STEP(J)).LE. + & COST_TRAV(STEP(I)))THEN + LEFT=.TRUE. + ELSE + LEFT=.FALSE. + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + IF ( INSUBTREE == 1 ) THEN + IF (NBINSUBTREE == 0) THEN + WRITE(*,*) "Error 3 in DMUMPS_509" + CALL MUMPS_ABORT() + ENDIF + LEFT = .TRUE. + ELSE + LEFT = ( NBTOP == 0) + ENDIF + ENDIF + 222 CONTINUE + IF ( LEFT ) THEN + INODE = POOL( NBINSUBTREE ) + IF(KEEP(81).EQ.2)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + CALL DMUMPS_561(INODE,POOL,LPOOL,N, + & STEP,KEEP,KEEP8,PROCNODE,SLAVEF,MYID,SBTR_FLAG, + & PROC_FLAG,MIN_PROC) + IF(.NOT.SBTR_FLAG)THEN + WRITE(*,*)MYID,': ca a change pour moi' + LEFT=.FALSE. + GOTO 222 + ENDIF +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ELSEIF(KEEP(81).EQ.3)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + NODE_TO_EXTRACT=INODE + FLAG_MEM=.FALSE. + CALL DMUMPS_820(FLAG_MEM) + IF(FLAG_MEM)THEN + CALL DMUMPS_561(INODE,POOL,LPOOL,N, + & STEP,KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG, + & PROC_FLAG,MIN_PROC) + IF(.NOT.SBTR_FLAG)THEN + LEFT=.FALSE. + WRITE(*,*)MYID,': ca a change pour moi (2)' + GOTO 222 + ENDIF + ENDIF +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF + NBINSUBTREE = NBINSUBTREE - 1 + IF ( INODE < 0 ) THEN + INODE_EFF = -INODE + ELSE IF ( INODE > N ) THEN + INODE_EFF = INODE - N + ELSE + INODE_EFF = INODE + ENDIF + IF ( MUMPS_167( PROCNODE(STEP(INODE_EFF)), SLAVEF) ) THEN + IF((KEEP(47).GE.2.AND.KEEP(81).EQ.1).AND. + & (INSUBTREE.EQ.0))THEN + CALL DMUMPS_513(.TRUE.) + ENDIF + INSUBTREE = 1 + ELSE IF ( MUMPS_283( PROCNODE(STEP(INODE_EFF)), + & SLAVEF)) THEN + IF((KEEP(47).GE.2.AND.KEEP(81).EQ.1).AND. + & (INSUBTREE.EQ.1))THEN + CALL DMUMPS_513(.FALSE.) + ENDIF + INSUBTREE = 0 + END IF + ELSE + IF (NBTOP < 1 ) THEN + WRITE(*,*) "Error 5 in DMUMPS_509", NBTOP + CALL MUMPS_ABORT() + ENDIF + INODE = POOL( LPOOL - 2 - NBTOP ) + IF(KEEP(81).EQ.1)THEN + CALL DMUMPS_520 + & (INODE,UPPER,SLAVEF,KEEP,KEEP8, + & STEP,POOL,LPOOL,PROCNODE,N) + IF(UPPER)THEN + GOTO 666 + ELSE + NBINSUBTREE=NBINSUBTREE-1 + IF ( MUMPS_167( PROCNODE(STEP(INODE)), + & SLAVEF) ) THEN + INSUBTREE = 1 + ELSE IF ( MUMPS_283( PROCNODE(STEP(INODE)), + & SLAVEF)) THEN + INSUBTREE = 0 + ENDIF + GOTO 777 + ENDIF + ENDIF + IF(KEEP(81).EQ.2)THEN + CALL DMUMPS_561(INODE,POOL,LPOOL,N,STEP, + & KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) + IF(SBTR_FLAG)THEN + LEFT=.TRUE. + WRITE(*,*)MYID,': ca a change pour moi (3)' + GOTO 222 + ENDIF + ELSE +#if defined(POOL_EXTRACT_MNG) + IF(KEEP(76).EQ.4)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + POS_TO_EXTRACT=-1 + NODE_TO_EXTRACT=-1 + DO I=NBTOP,1,-1 + IF(NODE_TO_EXTRACT.LT.0)THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ELSE + IF(DEPTH_FIRST_LOAD(STEP(POOL(LPOOL-2-I))).LT. + & DEPTH_FIRST_LOAD(STEP(NODE_TO_EXTRACT))) + & THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ENDIF + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + INODE = NODE_TO_EXTRACT +#else + INODE = INODE_EFF +#endif + DO I=POS_TO_EXTRACT,NBTOP + IF(I.NE.NBTOP)THEN + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF + IF(KEEP(76).EQ.5)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + POS_TO_EXTRACT=-1 + NODE_TO_EXTRACT=-1 + DO I=NBTOP,1,-1 + IF(NODE_TO_EXTRACT.LT.0)THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ELSE + IF(COST_TRAV(STEP(POOL(LPOOL-2-I))).GT. + & COST_TRAV(STEP(NODE_TO_EXTRACT)))THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ENDIF + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + INODE = NODE_TO_EXTRACT +#else + INODE = INODE_EFF +#endif + DO I=POS_TO_EXTRACT,NBTOP + IF(I.NE.NBTOP)THEN + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF +#endif + IF(KEEP(81).EQ.3)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + NODE_TO_EXTRACT=INODE + FLAG_MEM=.FALSE. + CALL DMUMPS_820(FLAG_MEM) + IF(FLAG_MEM)THEN + CALL DMUMPS_561(INODE,POOL,LPOOL,N, + & STEP,KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG, + & PROC_FLAG,MIN_PROC) + IF(SBTR_FLAG)THEN + LEFT=.TRUE. + WRITE(*,*)MYID,': ca a change pour moi (4)' + GOTO 222 + ENDIF + ELSE + CALL DMUMPS_819(INODE) + ENDIF +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF + ENDIF + 666 CONTINUE + NBTOP = NBTOP - 1 + IF((INODE.GT.0).AND.(INODE.LE.N))THEN + IF ((( KEEP(80) == 2 .OR. KEEP(80)==3 ) .AND. + & ( KEEP(47) == 4 ))) THEN + CALL DMUMPS_514(INODE,2) + ENDIF + ENDIF + IF ( INODE < 0 ) THEN + INODE_EFF = -INODE + ELSE IF ( INODE > N ) THEN + INODE_EFF = INODE - N + ELSE + INODE_EFF = INODE + ENDIF + END IF + 777 CONTINUE + POOL(LPOOL) = NBINSUBTREE + POOL(LPOOL - 1) = NBTOP + POOL(LPOOL - 2) = INSUBTREE + RETURN + END SUBROUTINE DMUMPS_509 + SUBROUTINE DMUMPS_552(INODE,POOL,LPOOL,N,STEP, + & KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR,FLAG_SAME_PROC,MIN_PROC) + USE DMUMPS_LOAD + IMPLICIT NONE + INTEGER INODE,LPOOL,N,MYID,SLAVEF,PROC,MIN_PROC + INTEGER POOL(LPOOL),KEEP(500),STEP(N),PROCNODE(KEEP(28)) + INTEGER(8) KEEP8(150) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + LOGICAL SBTR,FLAG_SAME_PROC + INTEGER POS_TO_EXTRACT,NODE_TO_EXTRACT,NBTOP,I,INSUBTREE, + & NBINSUBTREE + DOUBLE PRECISION MIN_COST, TMP_COST + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + MIN_COST=huge(MIN_COST) + TMP_COST=huge(TMP_COST) + FLAG_SAME_PROC=.FALSE. + SBTR=.FALSE. + MIN_PROC=-9999 +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GT.0).AND.(INODE.LE.N))THEN +#endif + POS_TO_EXTRACT=-1 + NODE_TO_EXTRACT=-1 + DO I=NBTOP,1,-1 + IF(NODE_TO_EXTRACT.LT.0)THEN + POS_TO_EXTRACT=I + NODE_TO_EXTRACT=POOL(LPOOL-2-I) + CALL DMUMPS_818(NODE_TO_EXTRACT, + & TMP_COST,PROC) + MIN_COST=TMP_COST + MIN_PROC=PROC + ELSE + CALL DMUMPS_818(POOL(LPOOL-2-I), + & TMP_COST,PROC) + IF((PROC.NE.MIN_PROC).OR.(TMP_COST.NE.MIN_COST))THEN + FLAG_SAME_PROC=.TRUE. + ENDIF + IF(TMP_COST.GT.MIN_COST)THEN + POS_TO_EXTRACT=I + NODE_TO_EXTRACT=POOL(LPOOL-2-I) + MIN_COST=TMP_COST + MIN_PROC=PROC + ENDIF + ENDIF + ENDDO + IF((KEEP(47).EQ.4).AND.(NBINSUBTREE.NE.0))THEN + CALL DMUMPS_554(NBINSUBTREE,INSUBTREE,NBTOP, + & MIN_COST,SBTR) + IF(SBTR)THEN + WRITE(*,*)MYID,': selecting from subtree' + RETURN + ENDIF + ENDIF + IF((.NOT.SBTR).AND.(.NOT.FLAG_SAME_PROC))THEN + WRITE(*,*)MYID,': I must search for a task + & to save My friend' + RETURN + ENDIF + INODE = NODE_TO_EXTRACT + DO I=POS_TO_EXTRACT,NBTOP + IF(I.NE.NBTOP)THEN + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDIF + ENDDO + POOL(LPOOL-2-NBTOP)=INODE + CALL DMUMPS_819(INODE) +#if ! defined(NOT_ATM_POOL_SPECIAL) + ELSE + ENDIF +#endif + END SUBROUTINE DMUMPS_552 + SUBROUTINE DMUMPS_561(INODE,POOL,LPOOL,N,STEP, + & KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) + USE DMUMPS_LOAD + IMPLICIT NONE + INTEGER INODE,LPOOL,N,SLAVEF,MYID,MIN_PROC + INTEGER POOL(LPOOL),KEEP(500),PROCNODE(KEEP(28)),STEP(N) + INTEGER(8) KEEP8(150) + LOGICAL SBTR_FLAG,PROC_FLAG + EXTERNAL MUMPS_167 + LOGICAL MUMPS_167 + INTEGER NODE_TO_EXTRACT,I,POS_TO_EXTRACT,NBTOP,NBINSUBTREE + NBTOP= POOL(LPOOL - 1) + NBINSUBTREE = POOL(LPOOL) + IF(NBTOP.GT.0)THEN + WRITE(*,*)MYID,': NBTOP=',NBTOP + ENDIF + SBTR_FLAG=.FALSE. + PROC_FLAG=.FALSE. + CALL DMUMPS_552(INODE,POOL,LPOOL,N,STEP,KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) + IF(SBTR_FLAG)THEN + RETURN + ENDIF + IF(MIN_PROC.EQ.-9999)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GT.0).AND.(INODE.LT.N))THEN +#endif + SBTR_FLAG=(NBINSUBTREE.NE.0) +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + RETURN + ENDIF + IF(.NOT.PROC_FLAG)THEN + NODE_TO_EXTRACT=INODE + IF((INODE.GE.0).AND.(INODE.LE.N))THEN + CALL DMUMPS_553(MIN_PROC,POOL, + & LPOOL,INODE) + IF(MUMPS_167(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + WRITE(*,*)MYID,': Extracting from a subtree + & for helping',MIN_PROC + SBTR_FLAG=.TRUE. + RETURN + ELSE + IF(NODE_TO_EXTRACT.NE.INODE)THEN + WRITE(*,*)MYID,': Extracting from top + & inode=',INODE,'for helping',MIN_PROC + ENDIF + CALL DMUMPS_819(INODE) + ENDIF + ENDIF + DO I=1,NBTOP + IF (POOL(LPOOL-2-I).EQ.INODE)THEN + GOTO 452 + ENDIF + ENDDO + 452 CONTINUE + POS_TO_EXTRACT=I + DO I=POS_TO_EXTRACT,NBTOP-1 + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDDO + POOL(LPOOL-2-NBTOP)=INODE + ENDIF + END SUBROUTINE DMUMPS_561 + SUBROUTINE DMUMPS_574 + & ( IPOOL, LPOOL, III, LEAF, + & INODE, STRATEGIE ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: STRATEGIE, LPOOL + INTEGER IPOOL (LPOOL) + INTEGER III,LEAF + INTEGER, INTENT(OUT) :: INODE + LEAF = LEAF - 1 + INODE = IPOOL( LEAF ) + RETURN + END SUBROUTINE DMUMPS_574 + SUBROUTINE DMUMPS_128(N, NELT, ELTPTR, ELTVAR, LIW, + & IKEEP, PTRAR, + & IORD, NFSIZ, FILS, FRERE, + & LISTVAR_SCHUR, SIZE_SCHUR, + & ICNTL, INFO, KEEP,KEEP8, + & ELTNOD, NSLAVES, + & XNODEL, NODEL) + IMPLICIT NONE + INTEGER N,NELT,LIW,IORD, SIZE_SCHUR, NSLAVES + INTEGER PTRAR(N,3), NFSIZ(N), FILS(N), FRERE(N) + INTEGER ELTPTR(NELT+1) + INTEGER XNODEL(N+1), NODEL(ELTPTR(NELT+1)-1) + INTEGER ELTVAR(ELTPTR(NELT+1)-1) + INTEGER IKEEP(N,3) + INTEGER LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER INFO(40), ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER ELTNOD(NELT) + INTEGER K,I,L1,L2,IWFR,NCMPA,LLIW,IFSON,IN + INTEGER NEMIN, MPRINT, LP, MP, LDIAG + INTEGER NZ, allocok, ITEMP + LOGICAL PROK, NOSUPERVAR + INTEGER(8) :: K79REF + PARAMETER(K79REF=12000000_8) + LOGICAL SPLITROOT + INTEGER, DIMENSION(:), ALLOCATABLE :: IW + INTEGER, DIMENSION(:), ALLOCATABLE :: IW2 + INTEGER OPT_METIS_SIZE, NUMFLAG + PARAMETER(OPT_METIS_SIZE = 8, NUMFLAG = 1) + INTEGER OPTIONS_METIS(OPT_METIS_SIZE) + INTEGER IDUM + EXTERNAL MUMPS_197, DMUMPS_130, DMUMPS_131, + & DMUMPS_129, DMUMPS_132, + & DMUMPS_133, DMUMPS_134, + & DMUMPS_199, + & DMUMPS_557, DMUMPS_201 +#if defined(OLDDFS) + EXTERNAL DMUMPS_200 +#endif + ALLOCATE( IW ( LIW ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = LIW + RETURN + ENDIF + MPRINT= ICNTL(3) + PROK = (MPRINT.GT.0) + LP = ICNTL(1) + MP = ICNTL(3) + LDIAG = ICNTL(4) + IF (KEEP(60).NE.0) THEN + NOSUPERVAR=.TRUE. + IF (IORD.GT.1) IORD = 0 + ELSE + NOSUPERVAR=.FALSE. + ENDIF + IF (IORD == 7) THEN + IF ( N < 10000 ) THEN + IORD = 0 + ELSE +#if defined(metis) || defined(parmetis) + IORD = 5 +#else + IORD = 0 +#endif + ENDIF + END IF +#if ! defined(metis) && ! defined(parmetis) + IF (IORD == 5) IORD = 0 +#endif + IF (KEEP(1).LT.1) KEEP(1) = 1 + NEMIN = KEEP(1) + IF (LDIAG.LE.2 .OR. MP.LE.0) GO TO 10 + WRITE (MP,99999) N, NELT, LIW, INFO(1) + K = min0(10,NELT+1) + IF (LDIAG.EQ.4) K = NELT+1 + IF (K.GT.0) WRITE (MP,99998) (ELTPTR(I),I=1,K) + K = min0(10,ELTPTR(NELT+1)-1) + IF (LDIAG.EQ.4) K = ELTPTR(NELT+1)-1 + IF (K.GT.0) WRITE (MP,99995) (ELTVAR(I),I=1,K) + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (IORD.EQ.1 .AND. K.GT.0) THEN + WRITE (MP,99997) (IKEEP(I,1),I=1,K) + ENDIF + 10 L1 = 1 + L2 = L1 + N + IF (LIW .LT. 3*N) THEN + INFO(1)= -2002 + INFO(2) = LIW + ENDIF +#if defined(metis) || defined(parmetis) + IF ( IORD == 5 ) THEN + IF (LIW .LT. N+N+1) THEN + INFO(1)= -2002 + INFO(2) = LIW + RETURN + ENDIF + ELSE +#endif + IF (NOSUPERVAR) THEN + IF ( LIW .LT. 2*N ) THEN + INFO(1)= -2002 + INFO(2) = LIW + RETURN + END IF + ELSE + IF ( LIW .LT. 4*N+4 ) THEN + INFO(1)= -2002 + INFO(2) = LIW + RETURN + END IF + ENDIF +#if defined(metis) || defined(parmetis) + ENDIF +#endif + IDUM=0 + CALL DMUMPS_258(NELT, N, ELTPTR(NELT+1)-1, ELTPTR, ELTVAR, + & XNODEL, NODEL, IW(L1), IDUM, ICNTL) + IF (IORD.NE.1 .AND. IORD .NE. 5) THEN + IORD = 0 + IF (NOSUPERVAR) THEN + CALL DMUMPS_129(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & PTRAR(1,2), IW(L1)) + ELSE + CALL DMUMPS_130(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & PTRAR(1,2), 4*N+4, IW(L1)) + ENDIF + LLIW = max(NZ,N) + ALLOCATE( IW2(LLIW), stat = allocok ) + IF (allocok.GT.0) THEN + INFO(1) = -7 + INFO(2) = LLIW + RETURN + ENDIF + IF (NOSUPERVAR) THEN + CALL DMUMPS_132(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IW2, LLIW, PTRAR, PTRAR(1,2), + & IW(L1), IWFR) + ELSE + CALL DMUMPS_131(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IW2, LLIW, PTRAR, PTRAR(1,2), + & IW(L1), IWFR) + ENDIF + IF (NOSUPERVAR) THEN + CALL MUMPS_162(N, LLIW, PTRAR, IWFR, PTRAR(1,2), IW2, + & IW(L1), IKEEP, + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), IW(L2), PTRAR(1,3), + & LISTVAR_SCHUR, SIZE_SCHUR) + IF (KEEP(60) == 1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSEIF (KEEP(60) == 2 .OR. KEEP(60) == 3 ) THEN + KEEP(38) = LISTVAR_SCHUR(1) + ELSE + WRITE(*,*) "Internal error in DMUMPS_128",KEEP(60) + CALL MUMPS_ABORT() + ENDIF + ELSE + CALL MUMPS_23(N, LLIW, PTRAR, IWFR, PTRAR(1,2), IW2, + & IW(L1), IKEEP, + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), IW(L2), PTRAR(1,3)) + ENDIF + ELSE +#if defined(metis) || defined(parmetis) + IF (IORD.EQ.5) THEN + IF (PROK) THEN + WRITE(MPRINT,'(A)') ' Ordering based on METIS ' + ENDIF + CALL DMUMPS_129(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & PTRAR(1,2), IW(L1)) + LLIW = max(NZ,N) + ALLOCATE( IW2(LLIW), stat = allocok ) + IF (allocok.GT.0) THEN + INFO(1) = -7 + INFO(2) = LLIW + RETURN + ENDIF + CALL DMUMPS_538(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IW2, LLIW, IW(L2), PTRAR(1,2), + & IW(L1), IWFR) + OPTIONS_METIS(1) = 0 + CALL METIS_NODEND(N, IW(L2), IW2(1), NUMFLAG, OPTIONS_METIS, + & IKEEP(1,2), IKEEP(1,1) ) + DEALLOCATE(IW2) + ELSE IF (IORD.NE.1) THEN + WRITE(*,*) IORD + WRITE(*,*) 'bad option for ordering' + CALL MUMPS_ABORT() + ENDIF +#endif + DO K=1,N + IW(L1+K) = 0 + ENDDO + DO K=1,N + IF ((IKEEP(K,1).LE.0).OR.(IKEEP(K,1).GT.N)) + & GO TO 40 + IF (IW(L1+IKEEP(K,1)).EQ.1) THEN + GOTO 40 + ELSE + IW(L1+IKEEP(K,1)) = 1 + ENDIF + ENDDO + CALL DMUMPS_133(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IKEEP, PTRAR(1,2), IW(L1)) + LLIW = NZ+N + ALLOCATE( IW2(LLIW), stat = allocok ) + IF (allocok.GT.0) THEN + INFO(1) = -7 + INFO(2) = LLIW + RETURN + ENDIF + CALL DMUMPS_134(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IKEEP, IW2, LLIW, PTRAR, PTRAR(1,2), + & IW(L1), IWFR) + IF (KEEP(60) == 0) THEN + ITEMP = 0 + ELSE + ITEMP = SIZE_SCHUR + IF (KEEP(60) == 1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSEIF (KEEP(60) == 2 .OR. KEEP(60) == 3 ) THEN + KEEP(38) = LISTVAR_SCHUR(1) + ELSE + WRITE(*,*) "Internal error in DMUMPS_128",KEEP(60) + CALL MUMPS_ABORT() + ENDIF + ENDIF + CALL DMUMPS_199(N, PTRAR, IW2, LLIW, IWFR, IKEEP, + & IKEEP(1,2), IW(L1), + & IW(L2), NCMPA, ITEMP) + ENDIF +#if defined(OLDDFS) + CALL DMUMPS_200(N, PTRAR, IW(L1), IKEEP, IKEEP(1,2), + & IKEEP(1,3), + & NFSIZ, INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, KEEP(60)) +#else + CALL DMUMPS_557(N, PTRAR, IW(L1), IKEEP, IKEEP(1,2), + & IKEEP(1,3), + & NFSIZ, PTRAR(1,2), + & INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, + & IW(L2), KEEP(60), KEEP(20), KEEP(38), + & IW2,KEEP(104),IW(L2+N),KEEP(50), + & ICNTL(13), KEEP(37), NSLAVES, KEEP(250).EQ.1) +#endif + DEALLOCATE(IW2) + IF (KEEP(60).NE.0) THEN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO WHILE (IN.GT.0) + IN = FILS (IN) + END DO + IFSON = -IN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO I=2,SIZE_SCHUR + FILS(IN) = LISTVAR_SCHUR (I) + IN = FILS(IN) + FRERE (IN) = N+1 + ENDDO + FILS(IN) = -IFSON + ENDIF + CALL DMUMPS_201(IKEEP(1,2), + & PTRAR(1,3), INFO(6), + & INFO(5), KEEP(2),KEEP(50), + & KEEP(101), KEEP(108),KEEP(5), + & KEEP(6), KEEP(226), KEEP(253)) + IF ( KEEP(53) .NE. 0 ) THEN + CALL MUMPS_209( N, FRERE, FILS, NFSIZ, KEEP(20) ) + END IF + IF ( KEEP(48) == 4 .OR. + & ( (KEEP(24).NE.0).AND.(KEEP8(21).GT.0_8) ) ) THEN + CALL DMUMPS_510(KEEP8(21), KEEP(2), + & KEEP(48), KEEP(50), NSLAVES) + END IF + IF (KEEP(210).LT.0.OR.KEEP(210).GT.2) KEEP(210)=0 + IF (KEEP(210).EQ.0.AND.KEEP(201).GT.0) KEEP(210)=1 + IF (KEEP(210).EQ.0.AND.KEEP(201).EQ.0) KEEP(210)=2 + IF (KEEP(210).EQ.2) KEEP8(79)=huge(KEEP8(79)) + IF (KEEP(210).EQ.1.AND.KEEP8(79).LE.0_8) THEN + IF ( huge(KEEP8(79)) / K79REF + 1_8 .GE. int(NSLAVES,8) ) THEN + KEEP8(79)=huge(KEEP8(79)) + ELSE + KEEP8(79)=K79REF * int(NSLAVES,8) + ENDIF + ENDIF + IF (KEEP(79).EQ.0) THEN + IF (KEEP(210).EQ.1) THEN + SPLITROOT = .FALSE. + IF ( KEEP(62).GE.1) THEN + CALL DMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG, INFO(1), INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + ENDIF + ENDIF + SPLITROOT = ((ICNTL(13).GT.0) .AND. (NSLAVES.GE.ICNTL(13))) + IF (SPLITROOT) THEN + CALL DMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG, INFO(1), INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (K.GT.0) WRITE (MP,99997) (IKEEP(I,1),I=1,K) + IF (K.GT.0) WRITE (MP,99991) (IKEEP(I,2),I=1,K) + IF (K.GT.0) WRITE (MP,99990) (IKEEP(I,3),I=1,K) + IF (K.GT.0) WRITE (MP,99987) (NFSIZ(I),I=1,K) + IF (K.GT.0) WRITE (MP,99989) (FILS(I),I=1,K) + IF (K.GT.0) WRITE (MP,99988) (FRERE(I),I=1,K) + ENDIF + GO TO 90 + 40 INFO(1) = -4 + INFO(2) = K + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99996) INFO(1) + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99982) INFO(2) + 90 CONTINUE + DEALLOCATE(IW) + RETURN +99999 FORMAT (/'Entering analysis phase with ...'/ + & ' N NELT LIW INFO(1)'/, + & 9X, I8, I11, I12, I14) +99998 FORMAT ('Element pointers: ELTPTR() '/(9X, 7I10)) +99995 FORMAT ('Element variables: ELTVAR() '/(9X, 7I10)) +99997 FORMAT ('IKEEP(.,1)=', 10I6/(12X, 10I6)) +99996 FORMAT (/'** Error return ** from Analysis * INFO(1)=', I3) +99991 FORMAT ('IKEEP(.,2)=', 10I6/(12X, 10I6)) +99990 FORMAT ('IKEEP(.,3)=', 10I6/(12X, 10I6)) +99989 FORMAT ('FILS (.) =', 10I6/(12X, 10I6)) +99988 FORMAT ('FRERE(.) =', 10I6/(12X, 10I6)) +99987 FORMAT ('NFSIZ(.) =', 10I6/(12X, 10I6)) +99982 FORMAT ('Error in permutation array KEEP INFO(2)=', I3) + END SUBROUTINE DMUMPS_128 + SUBROUTINE DMUMPS_258( NELT, N, NELNOD, XELNOD, ELNOD, + & XNODEL, NODEL, FLAG, IERROR, ICNTL ) + IMPLICIT NONE + INTEGER NELT, N, NELNOD, IERROR, ICNTL(40) + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & FLAG(N) + INTEGER I, J, K, MP, NBERR + MP = ICNTL(2) + FLAG(1:N) = 0 + XNODEL(1:N) = 0 + IERROR = 0 + DO I = 1, NELT + DO K = XELNOD(I), XELNOD(I+1)-1 + J = ELNOD(K) + IF ( J.LT.1 .OR. J.GT.N ) THEN + IERROR = IERROR + 1 + ELSE + IF ( FLAG(J).NE.I ) THEN + XNODEL(J) = XNODEL(J) + 1 + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + IF ( IERROR.GT.0 .AND. MP.GT.0 .AND. ICNTL(4).GE.2 ) THEN + NBERR = 0 + WRITE(MP,99999) + DO I = 1, NELT + DO K = XELNOD(I), XELNOD(I+1)-1 + J = ELNOD(K) + IF ( J.LT.1 .OR. J.GT.N ) THEN + NBERR = NBERR + 1 + IF (NBERR.LE.10) THEN + WRITE(MP,'(A,I8,A,I8,A)') + & 'Element ',I,' variable ',J,' ignored.' + ELSE + GO TO 100 + ENDIF + ENDIF + ENDDO + ENDDO + ENDIF + 100 CONTINUE + K = 1 + DO I = 1, N + K = K + XNODEL(I) + XNODEL(I) = K + ENDDO + XNODEL(N+1) = XNODEL(N) + FLAG(1:N) = 0 + DO I = 1, NELT + DO K = XELNOD(I), XELNOD(I+1)-1 + J = ELNOD(K) + IF (FLAG(J).NE.I) THEN + XNODEL(J) = XNODEL(J) - 1 + NODEL(XNODEL(J)) = I + FLAG(J) = I + ENDIF + ENDDO + ENDDO + RETURN +99999 FORMAT (/'*** Warning message from subroutine DMUMPS_258 ***') + END SUBROUTINE DMUMPS_258 + SUBROUTINE DMUMPS_129(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & LEN, FLAG) + IMPLICIT NONE + INTEGER N, NELT, NELNOD, NZ + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & FLAG(N) + INTEGER I,J,K1,K2,K3 + FLAG(1:N) = 0 + LEN(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.LT.J) .AND. (FLAG(J).NE.I)) THEN + LEN(I) = LEN(I) + 1 + LEN(J) = LEN(J) + 1 + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + NZ = 0 + DO I = 1,N + NZ = NZ + LEN(I) + ENDDO + RETURN + END SUBROUTINE DMUMPS_129 + SUBROUTINE DMUMPS_538(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER LEN(N) + INTEGER IPE(N+1) + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW), FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 1 + DO I = 1,N + IWFR = IWFR + LEN(I) + IPE(I) = IWFR + ENDDO + IPE(N+1)=IPE(N) + FLAG(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.LT.J) .AND. (FLAG(J).NE.I)) THEN + IPE(I) = IPE(I) - 1 + IW(IPE(I)) = J + IPE(J) = IPE(J) - 1 + IW(IPE(J)) = I + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE DMUMPS_538 + SUBROUTINE DMUMPS_132(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER LEN(N) + INTEGER IPE(N) + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW), FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 1 + DO I = 1,N + IWFR = IWFR + LEN(I) + IF (LEN(I).GT.0) THEN + IPE(I) = IWFR + ELSE + IPE(I) = 0 + ENDIF + ENDDO + FLAG(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.LT.J) .AND. (FLAG(J).NE.I)) THEN + IPE(I) = IPE(I) - 1 + IW(IPE(I)) = J + IPE(J) = IPE(J) - 1 + IW(IPE(J)) = I + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE DMUMPS_132 + SUBROUTINE DMUMPS_133(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & PERM, LEN, FLAG) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER PERM(N) + INTEGER LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), FLAG(N) + INTEGER I,J,K1,K2,K3 + FLAG(1:N) = 0 + LEN(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I),XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2),XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.NE.J) .AND. (FLAG(J).NE.I)) THEN + IF (PERM(J).GT.PERM(I)) THEN + LEN(I) = LEN(I) + 1 + FLAG(J) = I + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + NZ = 0 + DO I = 1,N + NZ = NZ + LEN(I) + ENDDO + RETURN + END SUBROUTINE DMUMPS_133 + SUBROUTINE DMUMPS_134(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & PERM, IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER PERM(N) + INTEGER IPE(N), LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), IW(LW), + & FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 0 + DO I = 1,N + IWFR = IWFR + LEN(I) + 1 + IPE(I) = IWFR + ENDDO + IWFR = IWFR + 1 + FLAG(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I),XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2),XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.NE.J) .AND. (FLAG(J).NE.I)) THEN + IF (PERM(J).GT.PERM(I)) THEN + IW(IPE(I)) = J + IPE(I) = IPE(I) - 1 + FLAG(J) = I + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + DO I = 1,N + J = IPE(I) + IW(J) = LEN(I) + IF (LEN(I).EQ.0) IPE(I) = 0 + ENDDO + RETURN + END SUBROUTINE DMUMPS_134 + SUBROUTINE DMUMPS_25( MYID, SLAVEF, N, + & PROCNODE, STEP, PTRAIW, PTRARW, + & NELT, FRTPTR, FRTELT, + & KEEP,KEEP8, ICNTL, SYM ) + IMPLICIT NONE + INTEGER MYID, SLAVEF, N, NELT, SYM + INTEGER KEEP( 500 ), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER PTRAIW( NELT+1 ), PTRARW( NELT+1 ) + INTEGER STEP( N ) + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER PROCNODE( KEEP(28) ) + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER ELT, I, K, IPTRI, IPTRR, NVAR + INTEGER TYPE_PARALL, ITYPE, IRANK + TYPE_PARALL = KEEP(46) + PTRAIW( 1:NELT ) = 0 + DO I = 1, N + IF (STEP(I).LT.0) CYCLE + ITYPE = MUMPS_330( PROCNODE(abs(STEP(I))), SLAVEF ) + IRANK = MUMPS_275( PROCNODE(abs(STEP(I))), SLAVEF ) + IF ( TYPE_PARALL .eq. 0 ) THEN + IRANK = IRANK + 1 + END IF + IF ( (ITYPE .EQ. 2) .OR. + & (ITYPE .EQ. 1 .AND. IRANK .EQ. MYID) ) THEN + DO K = FRTPTR(I),FRTPTR(I+1)-1 + ELT = FRTELT(K) + PTRAIW( ELT ) = PTRARW(ELT+1) - PTRARW(ELT) + ENDDO + ELSE + END IF + END DO + IPTRI = 1 + DO ELT = 1,NELT + NVAR = PTRAIW( ELT ) + PTRAIW( ELT ) = IPTRI + IPTRI = IPTRI + NVAR + ENDDO + PTRAIW( NELT+1 ) = IPTRI + KEEP( 14 ) = IPTRI - 1 + IF ( .TRUE. ) THEN + IF (SYM .EQ. 0) THEN + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRAIW( ELT+1 ) - PTRAIW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + NVAR*NVAR + ENDDO + PTRARW( NELT+1 ) = IPTRR + ELSE + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRAIW( ELT+1 ) - PTRAIW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + (NVAR*(NVAR+1))/2 + ENDDO + PTRARW( NELT+1 ) = IPTRR + ENDIF + ELSE + IF (SYM .EQ. 0) THEN + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRARW( ELT+1 ) - PTRARW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + NVAR*NVAR + ENDDO + PTRARW( NELT+1 ) = IPTRR + ELSE + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRARW( ELT+1 ) - PTRARW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + (NVAR*(NVAR+1))/2 + ENDDO + PTRARW( NELT+1 ) = IPTRR + ENDIF + ENDIF + KEEP( 13 ) = IPTRR - 1 + RETURN + END SUBROUTINE DMUMPS_25 + SUBROUTINE DMUMPS_120( N, NELT, ELTPROC, SLAVEF, PROCNODE ) + IMPLICIT NONE + INTEGER N, NELT, SLAVEF + INTEGER PROCNODE( N ), ELTPROC( NELT ) + INTEGER ELT, I, ITYPE, MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + DO ELT = 1, NELT + I = ELTPROC(ELT) + IF ( I .NE. 0) THEN + ITYPE = MUMPS_330(PROCNODE(I),SLAVEF) + IF (ITYPE.EQ.1) THEN + ELTPROC(ELT) = MUMPS_275(PROCNODE(I),SLAVEF) + ELSE IF (ITYPE.EQ.2) THEN + ELTPROC(ELT) = -1 + ELSE + ELTPROC(ELT) = -2 + ENDIF + ELSE + ELTPROC(ELT) = -3 + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_120 + SUBROUTINE DMUMPS_153(N, NELT, NELNOD, FRERE, FILS, NA, NE, + & XNODEL, NODEL, FRTPTR, FRTELT, ELTNOD) + IMPLICIT NONE + INTEGER N, NELT, NELNOD + INTEGER FRERE(N), FILS(N), NA(N), NE(N) + INTEGER FRTPTR(N+1), FRTELT(NELT), ELTNOD(NELT) + INTEGER XNODEL(N+1), NODEL(NELNOD) + INTEGER TNSTK( N ), IPOOL( N ) + INTEGER I, K, IFATH + INTEGER INODE, LEAF, NBLEAF, NBROOT, III, IN + TNSTK = NE + LEAF = 1 + IF (N.EQ.1) THEN + NBROOT = 1 + NBLEAF = 1 + IPOOL(1) = 1 + LEAF = LEAF + 1 + ELSEIF (NA(N).LT.0) THEN + NBLEAF = N + NBROOT = N + DO 20 I=1,NBLEAF-1 + INODE = NA(I) + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + 20 CONTINUE + INODE = -NA(N)-1 + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + ELSEIF (NA(N-1).LT.0) THEN + NBLEAF = N-1 + NBROOT = NA(N) + IF (NBLEAF-1.GT.0) THEN + DO 30 I=1,NBLEAF-1 + INODE = NA(I) + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + 30 CONTINUE + ENDIF + INODE = -NA(N-1)-1 + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + ELSE + NBLEAF = NA(N-1) + NBROOT = NA(N) + DO 40 I = 1,NBLEAF + INODE = NA(I) + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + 40 CONTINUE + ENDIF + ELTNOD(1:NELT) = 0 + III = 1 + 90 CONTINUE + IF (III.NE.LEAF) THEN + INODE=IPOOL(III) + III = III + 1 + ELSE + WRITE(6,*) ' ERROR 1 in file DMUMPS_153 ' + CALL MUMPS_ABORT() + ENDIF + 95 CONTINUE + IN = INODE + 100 CONTINUE + DO K = XNODEL(IN),XNODEL(IN+1)-1 + I = NODEL(K) + IF (ELTNOD(I).EQ.0) ELTNOD(I) = INODE + ENDDO + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 100 + IN = INODE + 110 IN = FRERE(IN) + IF (IN.GT.0) GO TO 110 + IF (IN.EQ.0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 115 + GOTO 90 + ELSE + IFATH = -IN + ENDIF + TNSTK(IFATH) = TNSTK(IFATH) - 1 + IF ( TNSTK(IFATH) .EQ. 0 ) THEN + INODE = IFATH + GOTO 95 + ELSE + GOTO 90 + ENDIF + 115 CONTINUE + FRTPTR(1:N) = 0 + DO I = 1,NELT + IF (ELTNOD(I) .NE. 0) THEN + FRTPTR(ELTNOD(I)) = FRTPTR(ELTNOD(I)) + 1 + ENDIF + ENDDO + K = 1 + DO I = 1,N + K = K + FRTPTR(I) + FRTPTR(I) = K + ENDDO + FRTPTR(N+1) = FRTPTR(N) + DO K = 1,NELT + INODE = ELTNOD(K) + IF (INODE .NE. 0) THEN + FRTPTR(INODE) = FRTPTR(INODE) - 1 + FRTELT(FRTPTR(INODE)) = K + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_153 + SUBROUTINE DMUMPS_130(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & LEN, LW, IW) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW) + INTEGER I,J,K1,K2,K3,LP,NSUP,SUPVAR + INTEGER INFO44(6) + EXTERNAL DMUMPS_315 + LP = 6 + CALL DMUMPS_315(N,NELT,XELNOD(NELT+1)-1,ELNOD,XELNOD, + & NSUP,IW(3*N+3+1),3*N+3,IW,LP,INFO44) + IF (INFO44(1) .LT. 0) THEN + IF (LP.GE.0) WRITE(LP,*) + & 'Error return from DMUMPS_315. INFO(1) = ',INFO44(1) + ENDIF + IW(1:NSUP) = 0 + LEN(1:N) = 0 + DO I = 1,N + SUPVAR = IW(3*N+3+1+I) + IF (SUPVAR .EQ. 0) CYCLE + IF (IW(SUPVAR).NE.0) THEN + LEN(I) = -IW(SUPVAR) + ELSE + IW(SUPVAR) = I + ENDIF + ENDDO + IW(N+1:2*N) = 0 + NZ = 0 + DO SUPVAR = 1,NSUP + I = IW(SUPVAR) + DO K1 = XNODEL(I),XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2),XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF (LEN(J).GE.0) THEN + IF ((I.NE.J) .AND. (IW(N+J).NE.I)) THEN + IW(N+J) = I + LEN(I) = LEN(I) + 1 + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + NZ = NZ + LEN(I) + ENDDO + RETURN + END SUBROUTINE DMUMPS_130 + SUBROUTINE DMUMPS_131(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER LEN(N) + INTEGER IPE(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW), FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 1 + DO I = 1,N + IF (LEN(I).GT.0) THEN + IWFR = IWFR + LEN(I) + IPE(I) = IWFR + ELSE + IPE(I) = 0 + ENDIF + ENDDO + FLAG(1:N) = 0 + DO I = 1,N + IF (LEN(I).LE.0) CYCLE + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF (LEN(J) .GT. 0) THEN + IF ((I.NE.J) .AND. (FLAG(J).NE.I)) THEN + IPE(I) = IPE(I) - 1 + IW(IPE(I)) = J + FLAG(J) = I + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE DMUMPS_131 + SUBROUTINE DMUMPS_315(N,NELT,NZ,ELTVAR,ELTPTR,NSUP,SVAR, + & LIW,IW,LP,INFO) + INTEGER LIW,LP,N,NELT,NSUP,NZ + INTEGER INFO(6) + INTEGER ELTPTR(NELT+1),ELTVAR(NZ) + INTEGER IW(LIW),SVAR(0:N) + INTEGER FLAG,NEW,VARS + EXTERNAL DMUMPS_316 + INFO(1) = 0 + INFO(2) = 0 + INFO(3) = 0 + INFO(4) = 0 + IF (N.LT.1) GO TO 10 + IF (NELT.LT.1) GO TO 20 + IF (NZ.LT.ELTPTR(NELT+1)-1) GO TO 30 + IF (LIW.LT.6) THEN + INFO(4) = 3*N + 3 + GO TO 40 + END IF + NEW = 1 + VARS = NEW + LIW/3 + FLAG = VARS + LIW/3 + CALL DMUMPS_316(N,NELT,ELTPTR,NZ,ELTVAR,SVAR,NSUP,LIW/3-1, + & IW(NEW),IW(VARS),IW(FLAG),INFO) + IF (INFO(1).EQ.-4) THEN + INFO(4) = 3*N + 3 + GO TO 40 + ELSE + INFO(4) = 3*NSUP + 3 + END IF + GO TO 50 + 10 INFO(1) = -1 + IF (LP.GT.0) WRITE (LP,FMT=9000) INFO(1) + GO TO 50 + 20 INFO(1) = -2 + IF (LP.GT.0) WRITE (LP,FMT=9000) INFO(1) + GO TO 50 + 30 INFO(1) = -3 + IF (LP.GT.0) WRITE (LP,FMT=9000) INFO(1) + GO TO 50 + 40 INFO(1) = -4 + IF (LP.GT.0) THEN + WRITE (LP,FMT=9000) INFO(1) + WRITE (LP,FMT=9010) INFO(4) + END IF + 50 RETURN + 9000 FORMAT (/3X,'Error message from DMUMPS_315: INFO(1) = ',I2) + 9010 FORMAT (3X,'LIW is insufficient. Upper bound on required work', + & 'space is ',I8) + END SUBROUTINE DMUMPS_315 + SUBROUTINE DMUMPS_316( N, NELT, ELTPTR, NZ, ELTVAR, + & SVAR, NSUP, MAXSUP, NEW, VARS, FLAG, INFO ) + INTEGER MAXSUP,N,NELT,NSUP,NZ + INTEGER ELTPTR(NELT+1),ELTVAR(NZ) + INTEGER INFO(6) + INTEGER FLAG(0:MAXSUP), NEW(0:MAXSUP),SVAR(0:N), + & VARS(0:MAXSUP) + INTEGER I,IS,J,JS,K,K1,K2 + DO 10 I = 0,N + SVAR(I) = 0 + 10 CONTINUE + VARS(0) = N + 1 + NEW(0) = -1 + FLAG(0) = 0 + NSUP = 0 + DO 40 J = 1,NELT + K1 = ELTPTR(J) + K2 = ELTPTR(J+1) - 1 + DO 20 K = K1,K2 + I = ELTVAR(K) + IF (I.LT.1 .OR. I.GT.N) THEN + INFO(2) = INFO(2) + 1 + GO TO 20 + END IF + IS = SVAR(I) + IF (IS.LT.0) THEN + ELTVAR(K) = 0 + INFO(3) = INFO(3) + 1 + GO TO 20 + END IF + SVAR(I) = SVAR(I) - N - 2 + VARS(IS) = VARS(IS) - 1 + 20 CONTINUE + DO 30 K = K1,K2 + I = ELTVAR(K) + IF (I.LT.1 .OR. I.GT.N) GO TO 30 + IS = SVAR(I) + N + 2 + IF (FLAG(IS).LT.J) THEN + FLAG(IS) = J + IF (VARS(IS).GT.0) THEN + NSUP = NSUP + 1 + IF (NSUP.GT.MAXSUP) THEN + INFO(1) = -4 + RETURN + END IF + VARS(NSUP) = 1 + FLAG(NSUP) = J + NEW(IS) = NSUP + SVAR(I) = NSUP + ELSE + VARS(IS) = 1 + NEW(IS) = IS + SVAR(I) = IS + END IF + ELSE + JS = NEW(IS) + VARS(JS) = VARS(JS) + 1 + SVAR(I) = JS + END IF + 30 CONTINUE + 40 CONTINUE + RETURN + END SUBROUTINE DMUMPS_316 + SUBROUTINE DMUMPS_36( COMM_LOAD, ASS_IRECV, + & NELT, FRT_PTR, FRT_ELT, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, + & FILS, FRERE, DAD, MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER,PTRARW, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & + & NSTK_S,NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE DMUMPS_COMM_BUFFER + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mpif.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER IZERO + PARAMETER (IZERO=0) + INTEGER NELT,N,LIW,NSTEPS + INTEGER(8) LA, LRLU, LRLUS, IPTRLU, POSFAC + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & IWPOS, IWPOSCB, COMP + INTEGER IDUMMY(1) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(NELT+1), PTRAIW(NELT+1), ND(KEEP(28)), PERM(N), + & FILS(N), FRERE(KEEP(28)), DAD(KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)), + & PAMASTER(KEEP(28)) + INTEGER COMM, NBFIN, SLAVEF, MYID + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + LOGICAL SON_LEVEL2 + DOUBLE PRECISION A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER FRT_PTR(N+1), FRT_ELT(NELT) + INTEGER INTARR(max(1,KEEP(14))) + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + INTEGER LPOOL, LEAF + INTEGER LBUFR, LBUFR_BYTES + INTEGER IPOOL( LPOOL ) + INTEGER NBPROCFILS(KEEP(28)), NSTK_S(KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER BUFR( LBUFR ) + INTEGER ETATASS + INCLUDE 'mumps_headers.h' + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + INTEGER LP, HS, HF + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + INTEGER NFS4FATHER + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER(8) NFRONT8 + INTEGER(8) LAELL8, APOS, APOS2, LAPOS2 + INTEGER(8) POSELT, POSEL1, ICT12, ICT21 + INTEGER(8) IACHK + INTEGER(8) JJ2 + INTEGER(8) LSTK8, SIZFR8 +#if defined(ALLOW_NON_INIT) + INTEGER(8) :: JJ8 +#endif + INTEGER NBPANELS_L, NBPANELS_U, LREQ_OOC + INTEGER SIZFI, NCB + INTEGER JJ,J1,J2 + INTEGER NCOLS, NROWS, LDA_SON + INTEGER NELIM,JJ1,J3, + & IORG, IBROT + INTEGER JPOS,ICT11, IJROW + INTEGER Pos_First_NUMORG,NUMORG,IOLDPS, + & NUMELT, ELBEG + INTEGER AINPUT, + & AII, J + INTEGER NSLAVES, NSLSON, NPIVS, NPIV_ANA, NPIV + INTEGER PTRCOL, ISLAVE, PDEST,LEVEL + LOGICAL LEVEL1, NIV1 + INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX + INTEGER ELTI, SIZE_ELTI + INTEGER II, I + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER NCBSON + LOGICAL SAME_PROC + INTRINSIC real + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + LOGICAL MUMPS_167, SSARBR + EXTERNAL MUMPS_167 + DOUBLE PRECISION FLOP1,FLOP1_EFF + EXTERNAL MUMPS_170 + LOGICAL MUMPS_170 + NFS4FATHER = -1 + ETATASS = 0 + COMPRESSCB=.FALSE. + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + LEVEL = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (LEVEL.NE.1) THEN + write(6,*) 'Error1 in mpi51f_niv1 ' + CALL MUMPS_ABORT() + END IF + NSLAVES = 0 + HF = 6 + NSLAVES + KEEP(IXSZ) + NUMELT = FRT_PTR(INODE+1) - FRT_PTR(INODE) + IF ( NUMELT .ne. 0 ) THEN + ELBEG = FRT_PTR(INODE) + ELSE + ELBEG = 1 + END IF + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + END DO + NPIV_ANA=NUMORG + NSTEPS = NSTEPS + 1 + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + END DO + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + NASS1 = NASS + NUMORG + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL DMUMPS_684(KEEP(50), NFRONT, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL DMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + END IF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + END IF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + NIV1 = .TRUE. + IF (KEEP(50).EQ.0) THEN + CALL MUMPS_124( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, NFRONT, NFRONT_EFF, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, + & SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG ) + ELSE + CALL MUMPS_125( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, + & SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + IF (IFLAG.LT.0) GOTO 300 + END IF + IF (NFRONT_EFF.NE.NFRONT) THEN + IF (NFRONT.GT.NFRONT_EFF) THEN + IF(MUMPS_170(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF))THEN + NPIV=NASS1-(NFRONT_EFF-ND(STEP(INODE))) + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1) + NPIV=NPIV_ANA + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1_EFF) + CALL DMUMPS_190(0,.FALSE.,FLOP1-FLOP1_EFF, + & KEEP,KEEP8) + ENDIF + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) ' ERROR 1 during ass_niv1_ELT' + GOTO 270 + ENDIF + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL DMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + NCB = NFRONT - NASS1 + MAXFRW = max0(MAXFRW, NFRONT) + ICT11 = IOLDPS + HF - 1 + NFRONT + NFRONT8=int(NFRONT,8) + LAELL8 = NFRONT8*NFRONT8 + IF (LRLU .LT. LAELL8) THEN + IF (LRLUS .LT. LAELL8) THEN + GOTO 280 + ELSE + CALL DMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + END IF + END IF + END IF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + POSFAC = POSFAC + LAELL8 + SSARBR=MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + CALL DMUMPS_471(SSARBR,.FALSE.,LA-LRLUS,0_8,LAELL8, + & KEEP,KEEP8, + & LRLU) +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. NFRONT .LT. KEEP(63) ) THEN + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO + ELSE + APOS = POSELT + DO JJ8 = 0_8, int(NFRONT -1,8) + A(APOS:APOS+JJ8) = ZERO + APOS = APOS + NFRONT8 + END DO + END IF +#endif + NASS = NASS1 + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + IW(IOLDPS+KEEP(IXSZ)) = NFRONT + IW(IOLDPS+KEEP(IXSZ)+ 1) = 0 + IW(IOLDPS+KEEP(IXSZ) + 2) = -NASS1 + IW(IOLDPS+KEEP(IXSZ) + 3) = -NASS1 + IW(IOLDPS+KEEP(IXSZ) + 4) = STEP(INODE) + IW(IOLDPS+KEEP(IXSZ)+5) = NSLAVES + IF (NUMSTK.NE.0) THEN + ISON = IFSON + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + LSTK8 = int(LSTK,8) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB = + & ( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB = ( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + LEVEL1 = NSLSON.EQ.0 + IF (.NOT.SAME_PROC) THEN + NROWS = IW( ISTCHK + 2+KEEP(IXSZ)) + ELSE + NROWS = NCOLS + ENDIF + SIZFI = HS + NROWS + NCOLS + J1 = ISTCHK + HS + NROWS + NPIVS + IF ( .NOT. LEVEL1 .AND. NELIM.EQ.0 ) GOTO 205 + IF (LEVEL1) THEN + J2 = J1 + LSTK - 1 + IF (COMPRESSCB) THEN + SIZFR8 = (LSTK8*(LSTK8+1_8)/2_8) + ELSE + SIZFR8 = LSTK8*LSTK8 + ENDIF + ELSE + IF ( KEEP(50).eq.0 ) THEN + SIZFR8 = int(NELIM,8) * LSTK8 + ELSE + SIZFR8 = int(NELIM,8) * int(NELIM,8) + END IF + J2 = J1 + NELIM - 1 + ENDIF + OPASSW = OPASSW + dble(SIZFR8) + IACHK = PAMASTER(STEP(ISON)) + IF ( KEEP(50) .eq. 0 ) THEN + POSEL1 = PTRAST(STEP(INODE)) - NFRONT8 + IF (J2.GE.J1) THEN + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * NFRONT8 + DO 160 JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8)) + 160 CONTINUE + IACHK = IACHK + LSTK8 + 170 CONTINUE + END IF + ELSE + IF (LEVEL1) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = SIZFR8 + ELSE + LCB = int(LDA_SON,8)*int(J2 - J1 + 1,8) + ENDIF + CALL DMUMPS_178(A, LA, + & PTRAST(STEP( INODE )), NFRONT, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), J2 - J1 + 1, NELIM, ETATASS, + & COMPRESSCB, + & .FALSE. + & ) + ENDIF + 205 IF (LEVEL1) THEN + IF (SAME_PROC) ISTCHK = PTRIST(STEP(ISON)) + IF (SAME_PROC) THEN + IF (KEEP(50).NE.0) THEN + J2 = J1 + LSTK - 1 + DO JJ = J1, J2 + IW(JJ) = IW(JJ - NROWS) + END DO + ELSE + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM + DO JJ = J3, J2 + IW(JJ) = IW(JJ - NROWS) + END DO + IF (NELIM .NE. 0) THEN + J3 = J3 - 1 + DO JJ = J1, J3 + JPOS = IW(JJ) + ICT11 + IW(JJ) = IW(JPOS) + END DO + ENDIF + ENDIF + ENDIF + IF ( SAME_PROC ) THEN + PTRIST(STEP( ISON )) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL DMUMPS_152(SSARBR, MYID, N, ISTCHK, + & IACHK, + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + ELSE + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL DMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, IDUMMY, + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, + & LEAF, NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + END DO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL DMUMPS_71( INODE, NFRONT, + & NASS1, NFS4FATHER,ISON, MYID, + & IZERO, IDUMMY, IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, + & SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + 220 CONTINUE + END IF + DO IELL=ELBEG,ELBEG+NUMELT-1 + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + AII = PTRARW(ELTI) + SIZE_ELTI = J2 - J1 + 1 + DO II=J1,J2 + I = INTARR(II) + IF (KEEP(50).EQ.0) THEN + AINPUT = AII + II - J1 + ICT12 = POSELT + int(I-1,8) * NFRONT8 + DO JJ=J1,J2 + APOS2 = ICT12 + int(INTARR(JJ) - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + SIZE_ELTI + END DO + ELSE + ICT12 = POSELT + int(- NFRONT + I - 1,8) + ICT21 = POSELT + int(I-1,8)*NFRONT8 - 1_8 + DO JJ=II,J2 + J = INTARR(JJ) + IF (I.LT.J) THEN + APOS2 = ICT12 + int(J,8)*NFRONT8 + ELSE + APOS2 = ICT21 + int(J,8) + ENDIF + A(APOS2) = A(APOS2) + DBLARR(AII) + AII = AII + 1 + END DO + END IF + END DO + END DO + IF (KEEP(253).GT.0) THEN + POSELT = PTRAST(STEP(INODE)) + IBROT = INODE + IJROW = Pos_First_NUMORG + DO IORG = 1, NUMORG + IF (KEEP(50).EQ.0) THEN + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(IJROW-1,8) * NFRONT8 + + & int(NFRONT-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ELSE + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(NFRONT-KEEP(253)+JJ-1,8) * NFRONT8 + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + IJROW = IJROW+1 + ENDDO + ENDIF + GOTO 500 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER ALLOCATION DURING DMUMPS_36' + ENDIF + GOTO 490 + 280 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, WORKSPACE TOO SMALL DURING DMUMPS_36' + ENDIF + IFLAG = -9 + CALL MUMPS_731(LAELL8-LRLUS, IERROR) + GOTO 500 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, SEND BUFFER TOO SMALL DURING DMUMPS_36' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, RECV BUFFER TOO SMALL DURING DMUMPS_36' + ENDIF + IFLAG = -20 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE IN INTEGER', + & ' DYNAMIC ALLOCATION DURING DMUMPS_36' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 490 CALL DMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE DMUMPS_36 + SUBROUTINE DMUMPS_37( COMM_LOAD, ASS_IRECV, + & NELT, FRT_PTR, FRT_ELT, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, FILS, FRERE, DAD, + & CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_S, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, LEAF, IPOOL, LPOOL, + & PERM, + & MEM_DISTRIB) + USE DMUMPS_COMM_BUFFER + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER NELT, N,LIW,NSTEPS, NBFIN + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER(8) LRLU, IPTRLU, LRLUS, POSFAC, LA + INTEGER(8) LAELL8 + INTEGER JJ + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & LPOOL, LEAF, + & IWPOS, + & IWPOSCB, COMP, SLAVEF + INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB + INTEGER IPOOL(LPOOL) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(NELT+1), PTRAIW(NELT+1), ND(KEEP(28)), + & FILS(N), FRERE(KEEP(28)), STEP(N), DAD (KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), PERM(N) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRFAC(KEEP(28)), PAMASTER(KEEP(28)), + & PTRAST(KEEP(28)) + INTEGER CAND(SLAVEF+1,max(1,KEEP(56))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER FRT_PTR(N+1), FRT_ELT(NELT) + INTEGER INTARR(max(1,KEEP(14))) + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + INTEGER MYID, COMM + INTEGER LBUFR, LBUFR_BYTES + INTEGER NBPROCFILS(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER BUFR( LBUFR ) + INCLUDE 'mumps_headers.h' + INTEGER LP, HS, HF, HF_OLD, NSLAVES_OLD,NCBSON + INTEGER NCBSON_MAX + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + INTEGER NFS4FATHER + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER LREQ_OOC, NBPANELS_L, NBPANELS_U + INTEGER NCB + INTEGER J1,J2 + INTEGER(8) NFRONT8, LAPOS2, POSELT, POSEL1, LDAFS8, + & JJ2, IACHK, ICT12, ICT21 +#if defined(ALLOW_NON_INIT) + INTEGER(8) :: JJ8 +#endif + INTEGER(8) APOS, APOS2 + INTEGER NELIM,LDAFS,JJ1,NPIVS,NCOLS,NROWS, + & IORG + INTEGER LDA_SON, IJROW, IBROT + INTEGER Pos_First_NUMORG,NBCOL,NUMORG,IOLDPS + INTEGER AINPUT + INTEGER NSLAVES, NSLSON + INTEGER NBLIG, PTRCOL, PTRROW, ISLAVE, PDEST + INTEGER ELTI, SIZE_ELTI + INTEGER II, ELBEG, NUMELT, I, J, AII + LOGICAL SAME_PROC, NIV1, SON_LEVEL2 + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX + logical :: force_cand + INTEGER(8) APOSMAX + DOUBLE PRECISION MAXARR + INTEGER INIV2, SIZE_TMP_SLAVES_LIST, allocok + INTEGER NUMORG_SPLIT, TYPESPLIT, + & NCB_SPLIT, SIZE_LIST_SPLIT, NBSPLIT + INTEGER, ALLOCATABLE, DIMENSION(:) :: TMP_SLAVES_LIST, COPY_CAND + INTEGER IZERO + INTEGER IDUMMY(1) + INTEGER PDEST1(1) + INTEGER ETATASS + PARAMETER( IZERO = 0 ) + INTEGER MUMPS_275, MUMPS_330, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, MUMPS_810 + INTRINSIC real + DOUBLE PRECISION ZERO + DOUBLE PRECISION RZERO + PARAMETER( RZERO = 0.0D0 ) + PARAMETER( ZERO = 0.0D0 ) + COMPRESSCB=.FALSE. + ETATASS = 0 + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + NSTEPS = NSTEPS + 1 + NUMELT = FRT_PTR(INODE+1) - FRT_PTR(INODE) + IF ( NUMELT .NE. 0 ) THEN + ELBEG = FRT_PTR(INODE) + ELSE + ELBEG = 1 + END IF + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + END DO + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + NCBSON_MAX = 0 + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + IF ( KEEP(48)==5 .AND. + & MUMPS_330(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) .EQ. 1) THEN + NCBSON_MAX = + & max(NCBSON_MAX,IW(PIMASTER(STEP(ISON))+KEEP(IXSZ))) + END IF + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + END DO + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + MAXFRW = max0(MAXFRW, NFRONT) + NASS1 = NASS + NUMORG + NCB = NFRONT - NASS1 + IF((KEEP(24).eq.0).or.(KEEP(24).eq.1)) then + force_cand=.FALSE. + ELSE + force_cand=(mod(KEEP(24),2).eq.0) + end if + IF (force_cand) THEN + INIV2 = ISTEP_TO_INIV2( STEP( INODE )) + SIZE_TMP_SLAVES_LIST = CAND( SLAVEF+1, INIV2 ) + ELSE + INIV2 = 1 + SIZE_TMP_SLAVES_LIST = SLAVEF - 1 + ENDIF + ALLOCATE(TMP_SLAVES_LIST(SIZE_TMP_SLAVES_LIST),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + TYPESPLIT = MUMPS_810 (PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IF ( (TYPESPLIT.EQ.4) + & .OR.(TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) + & ) THEN + IF (TYPESPLIT.EQ.4) THEN + ALLOCATE(COPY_CAND(SLAVEF+1),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + CALL DMUMPS_791 ( + & INODE, STEP, N, SLAVEF, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & CAND(1,INIV2), ICNTL, COPY_CAND, + & NBSPLIT, NUMORG_SPLIT, TMP_SLAVES_LIST(1), + & SIZE_TMP_SLAVES_LIST + & ) + NCB_SPLIT = NCB-NUMORG_SPLIT + SIZE_LIST_SPLIT = SIZE_TMP_SLAVES_LIST - NBSPLIT + CALL DMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, COPY_CAND, + & MEM_DISTRIB(0), NCB_SPLIT, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST(NBSPLIT+1), + & SIZE_LIST_SPLIT,INODE ) + DEALLOCATE (COPY_CAND) + CALL DMUMPS_790 ( + & INODE, STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, + & TAB_POS_IN_PERE(1,INIV2), + & NSLAVES + & ) + ELSE + ISTCHK = PIMASTER(STEP(IFSON)) + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + TMP_SLAVES_LIST (1:SIZE_TMP_SLAVES_LIST) + & = CAND (1:SIZE_TMP_SLAVES_LIST, INIV2) + CALL DMUMPS_792 ( + & INODE, TYPESPLIT, IFSON, + & IW(PDEST), NSLSON, + & STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, ISTEP_TO_INIV2, INIV2, + & TAB_POS_IN_PERE, NSLAVES, + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST + & ) + ENDIF + ELSE + CALL DMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL DMUMPS_684(KEEP(50), NASS1, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL DMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + ENDIF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + ENDIF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + NIV1 = .FALSE. + IF (KEEP(50).EQ.0) THEN + CALL MUMPS_124( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, NFRONT,NFRONT_EFF, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + ELSE + CALL MUMPS_125( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + IF (IFLAG.LT.0) GOTO 250 + ENDIF + IF ( NFRONT .NE. NFRONT_EFF ) THEN + IF ( + & (TYPESPLIT.EQ.5) .OR. (TYPESPLIT.EQ.6)) THEN + WRITE(6,*) ' SPLITTING NOT YET READY FOR THAT' + CALL MUMPS_ABORT() + ENDIF + IF (NFRONT.GT.NFRONT_EFF) THEN + NCB = NFRONT_EFF - NASS1 + NSLAVES_OLD = NSLAVES + HF_OLD = HF + IF (TYPESPLIT.EQ.4) THEN + WRITE(6,*) ' Internal error 2 in fac_ass_elt due', + & ' to plitting ', + & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ELSE + CALL DMUMPS_472( NCBSON_MAX, + & SLAVEF, KEEP,KEEP8,ICNTL, + & CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT_EFF, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) - + & (NSLAVES_OLD - NSLAVES) + IF (NSLAVES_OLD .NE. NSLAVES) THEN + IF (NSLAVES_OLD > NSLAVES) THEN + DO JJ=0,2*NFRONT_EFF-1 + IW(IOLDPS+HF+JJ)=IW(IOLDPS+HF_OLD+JJ) + ENDDO + ELSE + IF (IWPOS - 1 > IWPOSCB ) GOTO 270 + DO JJ=2*NFRONT_EFF-1, 0, -1 + IW(IOLDPS+HF+JJ) = IW(IOLDPS+HF_OLD+JJ) + ENDDO + END IF + END IF + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) ' ERROR 2 during ass_niv2' + GOTO 270 + ENDIF + ENDIF + NFRONT8=int(NFRONT,8) + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL DMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + MAXFRW = max0(MAXFRW, NFRONT) + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS + 1+KEEP(IXSZ)) = 0 + IW(IOLDPS + 2+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 3+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) + IW(IOLDPS+KEEP(IXSZ)) = NFRONT + IW(IOLDPS+5+KEEP(IXSZ)) = NSLAVES + IW(IOLDPS+6+KEEP(IXSZ):IOLDPS+5+NSLAVES+KEEP(IXSZ))= + & TMP_SLAVES_LIST(1:NSLAVES) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + IF (KEEP(73) .EQ. 0) THEN +#endif +#endif + CALL DMUMPS_461(MYID, SLAVEF, COMM_LOAD, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP, KEEP8, IW(IOLDPS+6+KEEP(IXSZ)), NSLAVES,INODE) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + ENDIF +#endif +#endif + IF(KEEP(86).EQ.1)THEN + IF(mod(KEEP(24),2).eq.0)THEN + CALL DMUMPS_533(SLAVEF,CAND(SLAVEF+1,INIV2), + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE) + ELSEIF((KEEP(24).EQ.0).OR.(KEEP(24).EQ.1))THEN + CALL DMUMPS_533(SLAVEF,SLAVEF-1, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8,TMP_SLAVES_LIST, NSLAVES,INODE) + ENDIF + ENDIF + DEALLOCATE(TMP_SLAVES_LIST) + IF (KEEP(50).EQ.0) THEN + LAELL8 = int(NASS1,8) * NFRONT8 + LDAFS = NFRONT + LDAFS8 = NFRONT8 + ELSE + LAELL8 = int(NASS1,8)*int(NASS1,8) + IF (KEEP(219).NE.0) THEN + IF(KEEP(50) .EQ. 2) LAELL8 = LAELL8+int(NASS1,8) + ENDIF + LDAFS = NASS1 + LDAFS8 = int(NASS1,8) + ENDIF + IF (LRLU .LT. LAELL8) THEN + IF (LRLUS .LT. LAELL8) THEN + GOTO 280 + ELSE + CALL DMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + ENDIF + ENDIF + ENDIF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + POSFAC = POSFAC + LAELL8 + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + CALL DMUMPS_471(.FALSE.,.FALSE.,LA-LRLUS,0_8,LAELL8, + & KEEP,KEEP8, + &LRLU) + POSEL1 = POSELT - LDAFS8 +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. LDAFS .lt. KEEP(63) ) THEN + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO + ELSE + APOS = POSELT + DO JJ8 = 0_8, LDAFS8 - 1_8 + A(APOS:APOS+JJ8) = ZERO + APOS = APOS + LDAFS8 + END DO + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + A(APOS:APOS+LDAFS8-1_8)=ZERO + ENDIF + END IF +#endif + IF ((NUMSTK.NE.0).AND.(NASS.NE.0)) THEN + ISON = IFSON + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + KEEP(IXSZ) + 1) + IF (NELIM.EQ.0) GOTO 210 + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NPIVS = IW(ISTCHK + KEEP(IXSZ) + 3) + IF (NPIVS.LT.0) NPIVS=0 + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + HS = 6 + KEEP(IXSZ) + NSLSON + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + KEEP(IXSZ) + 2) + ELSE + NROWS = NCOLS + ENDIF + OPASSW = OPASSW + dble(NELIM*LSTK) + J1 = ISTCHK + HS + NROWS + NPIVS + J2 = J1 + NELIM - 1 + IACHK = PAMASTER(STEP(ISON)) + IF (KEEP(50).eq.0) THEN + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * LDAFS8 + DO 160 JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1),8) - 1_8 + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1,8) - 1_8) + 160 CONTINUE + IACHK = IACHK + int(LSTK,8) + 170 CONTINUE + ELSE + IF (NSLSON.EQ.0) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = (int(NELIM,8)*int(NELIM+1,8))/2_8 + ELSE + LCB = int(LDA_SON,8)*int(NELIM,8) + ENDIF + CALL DMUMPS_178(A, LA, + & POSELT, LDAFS, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), NELIM, NELIM, ETATASS, + & COMPRESSCB, + & .FALSE. + & ) + ENDIF + 210 ISON = FRERE(STEP(ISON)) + 220 CONTINUE + ENDIF + APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8) + IF (KEEP(219).NE.0) THEN + IF (KEEP(50).EQ.2) THEN + A( APOSMAX: APOSMAX+int(NASS1-1,8))=ZERO + ENDIF + ENDIF + DO IELL=ELBEG,ELBEG+NUMELT-1 + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + AII = PTRARW(ELTI) + SIZE_ELTI = J2 - J1 + 1 + DO II=J1,J2 + I = INTARR(II) + IF (KEEP(50).EQ.0) THEN + IF (I.LE.NASS1) THEN + AINPUT = AII + II - J1 + ICT12 = POSELT + int(I-1,8) * LDAFS8 + DO JJ=J1,J2 + APOS2 = ICT12 + int(INTARR(JJ) - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + SIZE_ELTI + END DO + ENDIF + ELSE + ICT12 = POSELT - LDAFS8 + int(I,8) - 1_8 + ICT21 = POSELT + int(I-1,8)*LDAFS8 - 1_8 + IF ( I .GT. NASS1 ) THEN + IF (KEEP(219).NE.0) THEN + IF (KEEP(50).EQ.2) THEN + AINPUT=AII + DO JJ=II,J2 + J=INTARR(JJ) + IF (J.LE.NASS1) THEN + A(APOSMAX+int(J-1,8))= + & max(dble(A(APOSMAX+int(J-1,8))), + & abs(DBLARR(AINPUT))) + ENDIF + AINPUT=AINPUT+1 + ENDDO + ELSE + AII = AII + J2 - II + 1 + CYCLE + ENDIF + ELSE + AII = AII + J2 - II + 1 + CYCLE + ENDIF + ELSE + IF (KEEP(219).NE.0) THEN + MAXARR = RZERO + ENDIF + DO JJ=II,J2 + J = INTARR(JJ) + IF ( J .LE. NASS1) THEN + IF (I.LT.J) THEN + APOS2 = ICT12 + int(J,8)*LDAFS8 + ELSE + APOS2 = ICT21 + int(J,8) + ENDIF + A(APOS2) = A(APOS2) + DBLARR(AII) + ELSE IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + MAXARR = max(MAXARR,abs(DBLARR(AII))) + ENDIF + AII = AII + 1 + END DO + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN + A(APOSMAX+int(I-1,8)) = + & max( MAXARR, dble(A(APOSMAX+int(I-1,8)))) + ENDIF + ENDIF + END IF + END DO + END DO + IF (KEEP(253).GT.0) THEN + POSELT = PTRAST(STEP(INODE)) + IBROT = INODE + IJROW = Pos_First_NUMORG + DO IORG = 1, NUMORG + IF (KEEP(50).EQ.0) THEN + DO JJ = 1, KEEP(253) + APOS = POSELT + + & int(IJROW-1,8) * int(LDAFS,8) + + & int(LDAFS-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + IJROW = IJROW+1 + ENDDO + ENDIF + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + PDEST = IOLDPS + 6 + KEEP(IXSZ) + DO ISLAVE = 1, NSLAVES + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB, + & NSLAVES, + & NBLIG, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + IERR = -1 + DO WHILE (IERR .EQ.-1) + IF ( KEEP(50) .eq. 0 ) THEN + NBCOL = NFRONT + CALL DMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & IZERO, IDUMMY, + & IW(PDEST), NFRONT, COMM, IERR) + ELSE + NBCOL = NASS1+SHIFT_INDEX+NBLIG + CALL DMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & NSLAVES-ISLAVE, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE), + & IW(PDEST), NFRONT, COMM, IERR) + ENDIF + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.) + IF ( IFLAG .LT. 0 ) GOTO 500 + IF (MESSAGE_RECEIVED) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + SHIFT_INDEX + ENDIF + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 300 + IF (IERR .EQ. -3) GOTO 305 + PTRROW = PTRROW + NBLIG + PDEST = PDEST + 1 + END DO + IF (NUMSTK.EQ.0) GOTO 500 + ISON = IFSON + DO IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + 1 + KEEP(IXSZ)) + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + 2 + KEEP(IXSZ) ) + ELSE + NROWS = NCOLS + ENDIF + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + NFS4FATHER = NCBSON + DO I=0,NCBSON-1 + IF(IW(PTRCOL+I) .GT. NASS1) THEN + NFS4FATHER = I + EXIT + ENDIF + ENDDO + NFS4FATHER=NFS4FATHER + NELIM + ELSE + NFS4FATHER = 0 + ENDIF + IF (NSLSON.EQ.0) THEN + NSLSON = 1 + PDEST1(1) = MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) + IF (PDEST1(1).EQ.MYID) THEN + CALL DMUMPS_211( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)), + & NFRONT, NASS1, NFS4FATHER,NCBSON, IW( PTRCOL ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, NELT+1, NELT, + & FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ELSE + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + CALL DMUMPS_71( + & INODE, NFRONT,NASS1,NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)), + & IW(PTRCOL), NCBSON, + & COMM, IERR, PDEST1, NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ELSE + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL DMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + END DO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL DMUMPS_71( + & INODE, NFRONT, NASS1, NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW(PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + END DO + GOTO 500 + 250 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE IN INTEGER', + & ' DYNAMIC ALLOCATION during assembly' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 1 + GOTO 490 + 265 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE ALLOCATING TMP_SLAVES_LIST', + & ' DYNAMIC ALLOCATION during assembly' + ENDIF + IFLAG = -13 + IERROR = SIZE_TMP_SLAVES_LIST + GOTO 490 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE IN INTEGER ALLOCATION DURING DMUMPS_37' + ENDIF + GOTO 490 + 280 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, WORKSPACE TOO SMALL DURING DMUMPS_37' + ENDIF + IFLAG = -9 + CALL MUMPS_731(LAELL8 - LRLUS, IERROR) + GOTO 490 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SEND BUFFER TOO SMALL (1) DURING DMUMPS_37' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECV BUFFER TOO SMALL (1) DURING DMUMPS_37' + ENDIF + IFLAG = -20 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SENDBUFFER TOO SMALL (2) DURING DMUMPS_37' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 305 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECVBUFFER TOO SMALL (2) DURING DMUMPS_37' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 490 CALL DMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE DMUMPS_37 + SUBROUTINE DMUMPS_123( + & NELT, FRT_PTR, FRT_ELT, + & N, INODE, IW, LIW, A, LA, + & NBROWS, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, + & RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP, KEEP8, MYID) + IMPLICIT NONE + INTEGER NELT, N,LIW + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER INODE, MYID + INTEGER NBROWS, NBCOLS + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER IW(LIW), ITLOC(N + KEEP(253)), STEP(N), + & PTRIST(KEEP(28)), + & FILS(N), PTRARW(NELT+1), + & PTRAIW(NELT+1) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER FRT_PTR(N+1), FRT_ELT(NELT) + DOUBLE PRECISION A(LA), + & DBLARR(max(1,KEEP(13))) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER(8) :: POSELT, APOS2, ICT12, APOS + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & K1,K2,K,I,J,JPOS,NASS,JJ, + & IN,AINPUT,J1,J2,IJROW,ILOC, + & ELBEG, NUMELT, ELTI, SIZE_ELTI, IPOS, + & IPOS1, IPOS2, AII, II, IELL + INTEGER :: K1RHS, K2RHS, JFirstRHS + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INCLUDE 'mumps_headers.h' + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NASS = IW(IOLDPS+1+KEEP(IXSZ)) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + IF (NASS.LT.0) THEN + NASS = -NASS + IW(IOLDPS+1+KEEP(IXSZ)) = NASS + A(POSELT:POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8) = + & ZERO + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -JPOS + JPOS = JPOS + 1 + END DO + K1 = IOLDPS + HF + K2 = K1 + NBROWF - 1 + JPOS = 1 + IF ((KEEP(253).GT.0).AND.(KEEP(50).NE.0)) THEN + K1RHS = 0 + K2RHS = -1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -ITLOC(J)*NBCOLF + JPOS + IF ((K1RHS.EQ.0).AND.(J.GT.N)) THEN + K1RHS = K + JFirstRHS=J-N + ENDIF + JPOS = JPOS + 1 + ENDDO + IF (K1RHS.GT.0) K2RHS=K2 + IF ( K2RHS.GE.K1RHS ) THEN + IN = INODE + DO WHILE (IN.GT.0) + IJROW = -ITLOC(IN) + DO K = K1RHS, K2RHS + J = IW(K) + I = ITLOC(J) + ILOC = mod(I,NBCOLF) + APOS = POSELT+int(ILOC-1,8)*int(NBCOLF,8) + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( + & (JFirstRHS+(K-K1RHS)-1)*KEEP(254)+ IN) + ENDDO + IN = FILS(IN) + ENDDO + ENDIF + ELSE + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -ITLOC(J)*NBCOLF + JPOS + JPOS = JPOS + 1 + END DO + ENDIF + ELBEG = FRT_PTR(INODE) + NUMELT = FRT_PTR(INODE+1) - ELBEG + DO IELL=ELBEG,ELBEG+NUMELT-1 + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + AII = PTRARW(ELTI) + SIZE_ELTI = J2 - J1 + 1 + DO II=J1,J2 + I = ITLOC(INTARR(II)) + IF (KEEP(50).EQ.0) THEN + IF (I.LE.0) CYCLE + AINPUT = AII + II - J1 + IPOS = mod(I,NBCOLF) + ICT12 = POSELT + int(IPOS-1,8) * int(NBCOLF,8) + DO JJ = J1, J2 + JPOS = ITLOC(INTARR(JJ)) + IF (JPOS.LE.0) THEN + JPOS = -JPOS + ELSE + JPOS = JPOS/NBCOLF + END IF + APOS2 = ICT12 + int(JPOS - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + SIZE_ELTI + END DO + ELSE + IF ( I .EQ. 0 ) THEN + AII = AII + J2 - II + 1 + CYCLE + ENDIF + IF ( I .LE. 0 ) THEN + IPOS1 = -I + IPOS2 = 0 + ELSE + IPOS1 = I/NBCOLF + IPOS2 = mod(I,NBCOLF) + END IF + ICT12 = POSELT + int(IPOS2-1,8)*int(NBCOLF,8) + DO JJ=II,J2 + AII = AII + 1 + J = ITLOC(INTARR(JJ)) + IF ( J .EQ. 0 ) CYCLE + IF ( IPOS2.EQ.0 .AND. J.LE.0) CYCLE + IF ( J .LE. 0 ) THEN + JPOS = -J + ELSE + JPOS = J/NBCOLF + END IF + IF ( (IPOS1.GE.JPOS) .AND. (IPOS2.GT.0) ) THEN + APOS2 = ICT12 + int(JPOS - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AII-1) + END IF + IF ( (IPOS1.LT.JPOS) .AND. (J.GT.0) ) THEN + IPOS = mod(J,NBCOLF) + JPOS = IPOS1 + APOS2 = POSELT + int(IPOS-1,8)*int(NBCOLF,8) + & + int(JPOS - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AII-1) + END IF + END DO + END IF + END DO + END DO + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = 0 + END DO + END IF + IF (NBROWS.GT.0) THEN + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + JPOS = JPOS + 1 + END DO + END IF + RETURN + END SUBROUTINE DMUMPS_123 + SUBROUTINE DMUMPS_126( + & N, NELT, NA_ELT, + & COMM, MYID, SLAVEF, + & IELPTR_LOC, RELPTR_LOC, + & ELTVAR_LOC, ELTVAL_LOC, + & KEEP,KEEP8, MAXELT_SIZE, + & FRTPTR, FRTELT, A, LA, FILS, + & id, root ) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N, NELT, NA_ELT + INTEGER COMM, MYID, SLAVEF, MAXELT_SIZE, MSGLEN + INTEGER(8), intent(IN) :: LA + INTEGER FRTPTR( N+1 ) + INTEGER FRTELT( NELT ), FILS ( N ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IELPTR_LOC( NELT + 1 ), RELPTR_LOC( NELT + 1 ) + INTEGER ELTVAR_LOC( max(1,KEEP(14)) ) + DOUBLE PRECISION ELTVAL_LOC( max(1,KEEP(13)) ) + DOUBLE PRECISION A( LA ) + TYPE(DMUMPS_STRUC) :: id + TYPE(DMUMPS_ROOT_STRUC) :: root + INTEGER numroc + EXTERNAL numroc + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR_MPI + INTEGER MSGTAG + INTEGER allocok + INTEGER I, DEST, MAXELT_REAL_SIZE, MPG, IEL, SIZEI, SIZER + INTEGER NBRECORDS, NBUF + INTEGER RECV_IELTPTR, RECV_RELTPTR + INTEGER IELTPTR, RELTPTR, INODE + LOGICAL FINI, PROKG, I_AM_SLAVE + INTEGER(8) :: PTR_ROOT + INTEGER LOCAL_M, LOCAL_N, LP, IBEG, IGLOB, JGLOB + INTEGER ARROW_ROOT + INTEGER IELT, J, K, NB_REC, IREC + INTEGER ILOCROOT, JLOCROOT, IPOSROOT, JPOSROOT, IPTR + INTEGER JCOL_GRID, IROW_GRID + INTEGER IVALPTR + INTEGER NBELROOT + INTEGER MASTER + PARAMETER( MASTER = 0 ) + DOUBLE PRECISION VAL + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INTEGER, DIMENSION( :, : ), ALLOCATABLE :: BUFI + DOUBLE PRECISION, DIMENSION( :, : ), ALLOCATABLE :: BUFR + DOUBLE PRECISION, DIMENSION( : ), ALLOCATABLE :: TEMP_ELT_R + INTEGER, DIMENSION( : ), ALLOCATABLE :: TEMP_ELT_I + INTEGER, DIMENSION( : ), ALLOCATABLE :: ELROOTPOS + INTEGER, DIMENSION( : ), ALLOCATABLE, TARGET :: RG2LALLOC + INTEGER, DIMENSION( : ), POINTER :: RG2L + MPG = id%ICNTL(3) + LP = id%ICNTL(1) + I_AM_SLAVE = ( KEEP(46) .eq. 1 .or. MYID .ne.MASTER ) + PROKG = ( MPG > 0 .and. MYID .eq. MASTER ) + KEEP(49) = 0 + ARROW_ROOT = 0 + IF ( MYID .eq. MASTER ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + NBUF = SLAVEF + ELSE + NBUF = SLAVEF - 1 + END IF + NBRECORDS = min(KEEP(39),NA_ELT) + IF ( KEEP(50) .eq. 0 ) THEN + MAXELT_REAL_SIZE = MAXELT_SIZE * MAXELT_SIZE + ELSE + MAXELT_REAL_SIZE = MAXELT_SIZE * (MAXELT_SIZE+1)/2 + END IF + IF ( MAXELT_REAL_SIZE .GT. KEEP(39) ) THEN + NBRECORDS = MAXELT_REAL_SIZE + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,*) + & ' ** Warning : For element distrib NBRECORDS set to ', + & MAXELT_REAL_SIZE,' because one element is large' + END IF + END IF + ALLOCATE( BUFI( 2*NBRECORDS+1, NBUF ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 2*NBRECORDS + 1 + GOTO 100 + END IF + ALLOCATE( BUFR( NBRECORDS+1, NBUF ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBRECORDS + 1 + GOTO 100 + END IF + IF ( KEEP(52) .ne. 0 ) THEN + ALLOCATE( TEMP_ELT_R( MAXELT_REAL_SIZE ), stat =allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = MAXELT_REAL_SIZE + GOTO 100 + END IF + END IF + ALLOCATE( TEMP_ELT_I( MAXELT_SIZE ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = MAXELT_SIZE + GOTO 100 + END IF + IF ( KEEP(38) .ne. 0 ) THEN + NBELROOT = FRTPTR(KEEP(38)+1)-FRTPTR(KEEP(38)) + ALLOCATE( ELROOTPOS( max(NBELROOT,1) ), + & stat = allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBELROOT + GOTO 100 + END IF + IF (KEEP(46) .eq. 0 ) THEN + ALLOCATE( RG2LALLOC( N ), stat = allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = N + GOTO 100 + END IF + INODE = KEEP(38) + I = 1 + DO WHILE ( INODE .GT. 0 ) + RG2LALLOC( INODE ) = I + INODE = FILS( INODE ) + I = I + 1 + END DO + RG2L => RG2LALLOC + ELSE + RG2L => root%RG2L_ROW + END IF + END IF + DO I = 1, NBUF + BUFI( 1, I ) = 0 + BUFR( 1, I ) = ZERO + END DO + END IF + 100 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), COMM, MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + CALL MPI_BCAST( NBRECORDS, 1, MPI_INTEGER, MASTER, + & COMM, IERR_MPI ) + RECV_IELTPTR = 1 + RECV_RELTPTR = 1 + IF ( MYID .eq. MASTER ) THEN + NBELROOT = 0 + RELTPTR = 1 + RELPTR_LOC(1) = 1 + DO IEL = 1, NELT + IELTPTR = id%ELTPTR( IEL ) + SIZEI = id%ELTPTR( IEL + 1 ) - IELTPTR + IF ( KEEP( 50 ) .eq. 0 ) THEN + SIZER = SIZEI * SIZEI + ELSE + SIZER = SIZEI * ( SIZEI + 1 ) / 2 + END IF + DEST = id%ELTPROC( IEL ) + IF ( DEST .eq. -2 ) THEN + NBELROOT = NBELROOT + 1 + FRTELT( FRTPTR(KEEP(38)) + NBELROOT - 1 ) = IEL + ELROOTPOS( NBELROOT ) = RELTPTR + GOTO 200 + END IF + IF ( DEST .ge. 0 .and. KEEP(46) .eq. 0 ) DEST = DEST + 1 + IF ( KEEP(52) .ne. 0 ) THEN + CALL DMUMPS_288( N, SIZEI, SIZER, + & id%ELTVAR( IELTPTR ), id%A_ELT( RELTPTR ), + & TEMP_ELT_R(1), MAXELT_REAL_SIZE, + & id%ROWSCA(1), id%COLSCA(1), KEEP(50) ) + END IF + IF ( DEST .eq. 0 .or. ( DEST .eq. -1 .and. KEEP(46) .ne. 0 ) ) + & THEN + ELTVAR_LOC( RECV_IELTPTR: RECV_IELTPTR + SIZEI - 1 ) + & = id%ELTVAR( IELTPTR: IELTPTR + SIZEI - 1 ) + RECV_IELTPTR = RECV_IELTPTR + SIZEI + IF ( KEEP(52) .ne. 0 ) THEN + ELTVAL_LOC( RECV_RELTPTR: RECV_RELTPTR + SIZER - 1) + & = TEMP_ELT_R( 1: SIZER ) + RECV_RELTPTR = RECV_RELTPTR + SIZER + END IF + END IF + IF ( DEST .NE. 0 .AND. DEST. NE. -3 ) THEN + IF ( KEEP(52) .eq. 0 ) THEN + CALL DMUMPS_127( + & id%ELTVAR(IELTPTR), + & id%A_ELT (RELTPTR), + & SIZEI, SIZER, + & + & DEST, NBUF, NBRECORDS, + & BUFI, BUFR, COMM ) + ELSE + CALL DMUMPS_127( + & id%ELTVAR(IELTPTR), + & TEMP_ELT_R( 1 ), + & SIZEI, SIZER, + & + & DEST, NBUF, NBRECORDS, + & BUFI, BUFR, COMM ) + END IF + END IF + 200 CONTINUE + RELTPTR = RELTPTR + SIZER + IF ( KEEP(46) .eq. 0 .OR. KEEP(52) .eq. 0 ) THEN + RELPTR_LOC( IEL + 1 ) = RELTPTR + ELSE + RELPTR_LOC( IEL + 1 ) = RECV_RELTPTR + ENDIF + END DO + IF ( KEEP(46) .eq. 0 .OR. KEEP(52) .eq. 0 ) THEN + KEEP(13) = RELTPTR - 1 + ELSE + KEEP(13) = RECV_RELTPTR - 1 + ENDIF + IF ( RELTPTR - 1 .ne. id%NA_ELT ) THEN + WRITE(*,*) ' ** ERROR ELT DIST: RELPTR - 1 / id%NA_ELT=', + & RELTPTR - 1,id%NA_ELT + CALL MUMPS_ABORT() + END IF + DEST = -2 + IELTPTR = 1 + RELTPTR = 1 + SIZEI = 1 + SIZER = 1 + CALL DMUMPS_127( + & id%ELTVAR(IELTPTR), + & id%A_ELT (RELTPTR), + & SIZEI, SIZER, + & + & DEST, NBUF, NBRECORDS, + & BUFI, BUFR, COMM ) + IF ( KEEP(52) .NE. 0 ) DEALLOCATE( TEMP_ELT_R ) + ELSE + FINI = ( RECV_IELTPTR .eq. IELPTR_LOC( NELT+1 ) + & .and. RECV_RELTPTR .eq. RELPTR_LOC( NELT+1 ) ) + DO WHILE ( .not. FINI ) + CALL MPI_PROBE( MASTER, MPI_ANY_TAG, + & COMM, STATUS, IERR_MPI ) + MSGTAG = STATUS( MPI_TAG ) + SELECT CASE ( MSGTAG ) + CASE( ELT_INT ) + CALL MPI_GET_COUNT( STATUS, MPI_INTEGER, + & MSGLEN, IERR_MPI ) + CALL MPI_RECV( ELTVAR_LOC( RECV_IELTPTR ), MSGLEN, + & MPI_INTEGER, MASTER, ELT_INT, + & COMM, STATUS, IERR_MPI ) + RECV_IELTPTR = RECV_IELTPTR + MSGLEN + CASE( ELT_REAL ) + CALL MPI_GET_COUNT( STATUS, MPI_DOUBLE_PRECISION, + & MSGLEN, IERR_MPI ) + CALL MPI_RECV( ELTVAL_LOC( RECV_RELTPTR ), MSGLEN, + & MPI_DOUBLE_PRECISION, MASTER, ELT_REAL, + & COMM, STATUS, IERR_MPI ) + RECV_RELTPTR = RECV_RELTPTR + MSGLEN + END SELECT + FINI = ( RECV_IELTPTR .eq. IELPTR_LOC( NELT+1 ) + & .and. RECV_RELTPTR .eq. RELPTR_LOC( NELT+1 ) ) + END DO + END IF + IF ( KEEP(38) .NE. 0 ) THEN + IF ( I_AM_SLAVE .and. root%yes ) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I = 1, root%SCHUR_NLOC + root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1: + & (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC)=ZERO + ENDDO + ENDIF + END IF + IF ( MYID .NE. MASTER ) THEN + ALLOCATE( BUFI( NBRECORDS * 2 + 1, 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBRECORDS * 2 + 1 + GOTO 250 + END IF + ALLOCATE( BUFR( NBRECORDS, 1 ) , stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBRECORDS + END IF + END IF + 250 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), COMM, MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + IF ( MYID .eq. MASTER ) THEN + DO IPTR = FRTPTR(KEEP(38)), FRTPTR(KEEP(38)+1) - 1 + IELT = FRTELT( IPTR ) + SIZEI = id%ELTPTR( IELT + 1 ) - id%ELTPTR( IELT ) + DO I = 1, SIZEI + TEMP_ELT_I( I ) = RG2L + & ( id%ELTVAR( id%ELTPTR(IELT) + I - 1 ) ) + END DO + IVALPTR = ELROOTPOS( IPTR - FRTPTR(KEEP(38)) + 1 ) - 1 + K = 1 + DO J = 1, SIZEI + JGLOB = id%ELTVAR( id%ELTPTR( IELT ) + J - 1 ) + IF ( KEEP(50).eq. 0 ) THEN + IBEG = 1 + ELSE + IBEG = J + END IF + DO I = IBEG, SIZEI + IGLOB = id%ELTVAR( id%ELTPTR( IELT ) + I - 1 ) + IF ( KEEP(52) .eq. 0 ) THEN + VAL = id%A_ELT( IVALPTR + K ) + ELSE + VAL = id%A_ELT( IVALPTR + K ) * + & id%ROWSCA( IGLOB ) * id%COLSCA( JGLOB ) + END IF + IF ( KEEP(50).eq.0 ) THEN + IPOSROOT = TEMP_ELT_I( I ) + JPOSROOT = TEMP_ELT_I( J ) + ELSE + IF ( TEMP_ELT_I(I) .GT. TEMP_ELT_I(J) ) THEN + IPOSROOT = TEMP_ELT_I(I) + JPOSROOT = TEMP_ELT_I(J) + ELSE + IPOSROOT = TEMP_ELT_I(J) + JPOSROOT = TEMP_ELT_I(I) + END IF + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, + & root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, + & root%NPCOL ) + IF ( KEEP(46) .eq. 0 ) THEN + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + 1 + ELSE + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + END IF + IF ( DEST .eq. MASTER ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & = A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & + VAL + ENDIF + ELSE + CALL DMUMPS_34( + & IPOSROOT, JPOSROOT, VAL, DEST, BUFI, BUFR, NBRECORDS, + & NBUF, LP, COMM, KEEP(46) ) + END IF + K = K + 1 + END DO + END DO + END DO + CALL DMUMPS_18( + & BUFI, BUFR, NBRECORDS, + & NBUF, LP, COMM, KEEP(46) ) + ELSE + FINI = .FALSE. + DO WHILE ( .not. FINI ) + CALL MPI_RECV( BUFI(1,1), 2*NBRECORDS+1, + & MPI_INTEGER, MASTER, + & ARROWHEAD, + & COMM, STATUS, IERR_MPI ) + NB_REC = BUFI(1,1) + IF (NB_REC.LE.0) THEN + FINI = .TRUE. + NB_REC = -NB_REC + ENDIF + IF (NB_REC.EQ.0) EXIT + CALL MPI_RECV( BUFR(1,1), NBRECORDS, MPI_DOUBLE_PRECISION, + & MASTER, ARROWHEAD, + & COMM, STATUS, IERR_MPI ) + ARROW_ROOT = ARROW_ROOT + NB_REC + DO IREC = 1, NB_REC + IPOSROOT = BUFI( IREC * 2, 1 ) + JPOSROOT = BUFI( IREC * 2 + 1, 1 ) + VAL = BUFR( IREC, 1 ) + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60).eq.0) THEN + A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8) + & + int(ILOCROOT-1,8)) + & = A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8) + & + int(ILOCROOT-1,8)) + & + VAL + ELSE + root%SCHUR_POINTER(int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + END DO + END DO + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + END IF + END IF + IF ( MYID .eq. MASTER ) THEN + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + IF (KEEP(38).ne.0) THEN + DEALLOCATE(ELROOTPOS) + IF (KEEP(46) .eq. 0 ) THEN + DEALLOCATE(RG2LALLOC) + ENDIF + ENDIF + DEALLOCATE( TEMP_ELT_I ) + END IF + KEEP(49) = ARROW_ROOT + RETURN + END SUBROUTINE DMUMPS_126 + SUBROUTINE DMUMPS_127( + & ELNODES, ELVAL, SIZEI, SIZER, + & DEST, NBUF, NBRECORDS, BUFI, BUFR, COMM ) + IMPLICIT NONE + INTEGER SIZEI, SIZER, DEST, NBUF, NBRECORDS, COMM + INTEGER ELNODES( SIZEI ), BUFI( 2*NBRECORDS + 1, NBUF ) + DOUBLE PRECISION ELVAL( SIZER ), BUFR( NBRECORDS + 1, NBUF ) + INCLUDE 'mumps_tags.h' + INCLUDE 'mpif.h' + INTEGER I, IBEG, IEND, IERR_MPI, NBRECR + INTEGER NBRECI + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + IF ( DEST .lt. 0 ) THEN + IBEG = 1 + IEND = NBUF + ELSE + IBEG = DEST + IEND = DEST + END IF + DO I = IBEG, IEND + NBRECI = BUFI(1,I) + IF ( NBRECI .ne.0 .and. + & ( DEST.eq.-2 .or. + & NBRECI + SIZEI .GT. 2*NBRECORDS ) ) THEN + CALL MPI_SEND( BUFI(2, I), NBRECI, MPI_INTEGER, + & I, ELT_INT, COMM, IERR_MPI ) + BUFI(1,I) = 0 + NBRECI = 0 + END IF + NBRECR = int(dble(BUFR(1,I))+0.5D0) + IF ( NBRECR .ne.0 .and. + & ( DEST.eq.-2 .or. + & NBRECR + SIZER .GT. NBRECORDS ) ) THEN + CALL MPI_SEND( BUFR(2, I), NBRECR, MPI_DOUBLE_PRECISION, + & I, ELT_REAL, COMM, IERR_MPI ) + BUFR(1,I) = ZERO + NBRECR = 0 + END IF + IF ( DEST .ne. -2 ) THEN + BUFI( 2 + NBRECI : 2 + NBRECI + SIZEI - 1, I ) = + & ELNODES( 1: SIZEI ) + BUFR( 2 + NBRECR : 2 + NBRECR + SIZER - 1, I ) = + & ELVAL( 1: SIZER ) + BUFI(1,I) = NBRECI + SIZEI + BUFR(1,I) = dble( NBRECR + SIZER ) + END IF + END DO + RETURN + END SUBROUTINE DMUMPS_127 + SUBROUTINE DMUMPS_213( ELTPTR, NELT, MAXELT_SIZE ) + INTEGER NELT, MAXELT_SIZE + INTEGER ELTPTR( NELT + 1 ) + INTEGER I, S + MAXELT_SIZE = 0 + DO I = 1, NELT + S = ELTPTR( I + 1 ) - ELTPTR( I ) + MAXELT_SIZE = max( S, MAXELT_SIZE ) + END DO + RETURN + END SUBROUTINE DMUMPS_213 + SUBROUTINE DMUMPS_288( N, SIZEI, SIZER, + & ELTVAR, ELTVAL, + & SELTVAL, LSELTVAL, + & ROWSCA, COLSCA, K50 ) + INTEGER N, SIZEI, SIZER, LSELTVAL, K50 + INTEGER ELTVAR( SIZEI ) + DOUBLE PRECISION ELTVAL( SIZER ) + DOUBLE PRECISION SELTVAL( LSELTVAL ) + DOUBLE PRECISION ROWSCA( N ), COLSCA( N ) + INTEGER I, J, K + K = 1 + IF ( K50 .eq. 0 ) THEN + DO J = 1, SIZEI + DO I = 1, SIZEI + SELTVAL(K) = ELTVAL(K) * + & ROWSCA(ELTVAR(I)) * + & COLSCA(ELTVAR(J)) + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + DO I = J, SIZEI + SELTVAL(K) = ELTVAL(K) * + & ROWSCA(ELTVAR(I)) * + & COLSCA(ELTVAR(J)) + K = K + 1 + END DO + END DO + END IF + RETURN + END SUBROUTINE DMUMPS_288 + SUBROUTINE DMUMPS_F77( JOB, SYM, PAR, COMM_F77, N, ICNTL, CNTL, + & NZ, IRN, IRNhere, JCN, JCNhere, A, Ahere, + & NZ_loc, IRN_loc, IRN_lochere, + & JCN_loc, JCN_lochere, + & A_loc, A_lochere, + & NELT, ELTPTR, ELTPTRhere, ELTVAR, + & ELTVARhere, A_ELT, A_ELThere, + & PERM_IN, PERM_INhere, + & RHS, RHShere, REDRHS, REDRHShere, + & INFO, RINFO, INFOG, RINFOG, + & DEFICIENCY, LWK_USER, + & SIZE_SCHUR, LISTVAR_SCHUR, + & LISTVAR_SCHURhere, SCHUR, SCHURhere, + & WK_USER, WK_USERhere, + & COLSCA, COLSCAhere, ROWSCA, ROWSCAhere, + & INSTANCE_NUMBER, NRHS, LRHS, LREDRHS, + & + & RHS_SPARSE, RHS_SPARSEhere, + & SOL_loc, SOL_lochere, + & IRHS_SPARSE, IRHS_SPARSEhere, + & IRHS_PTR, IRHS_PTRhere, + & ISOL_loc, ISOL_lochere, + & NZ_RHS, LSOL_loc + & , + & SCHUR_MLOC, + & SCHUR_NLOC, + & SCHUR_LLD, + & MBLOCK, + & NBLOCK, + & NPROW, + & NPCOL, + & + & OOC_TMPDIR, + & OOC_PREFIX, + & WRITE_PROBLEM, + & TMPDIRLEN, + & PREFIXLEN, + & WRITE_PROBLEMLEN + & + & ) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER OOC_PREFIX_MAX_LENGTH, OOC_TMPDIR_MAX_LENGTH + INTEGER PB_MAX_LENGTH + PARAMETER(OOC_PREFIX_MAX_LENGTH=63, OOC_TMPDIR_MAX_LENGTH=255) + PARAMETER(PB_MAX_LENGTH=255) + INTEGER JOB, SYM, PAR, COMM_F77, N, NZ, NZ_loc, NELT, + & DEFICIENCY, LWK_USER, SIZE_SCHUR, INSTANCE_NUMBER, + & NRHS, LRHS, + & NZ_RHS, LSOL_loc, LREDRHS + INTEGER ICNTL(40), INFO(40), INFOG(40) + INTEGER SCHUR_MLOC, SCHUR_NLOC, SCHUR_LLD + INTEGER MBLOCK, NBLOCK, NPROW, NPCOL + INTEGER TMPDIRLEN, PREFIXLEN, WRITE_PROBLEMLEN + DOUBLE PRECISION CNTL(15), RINFO(40), RINFOG(40) + INTEGER, TARGET :: IRN(*), JCN(*), ELTPTR(*), ELTVAR(*) + INTEGER, TARGET :: PERM_IN(*), IRN_loc(*), JCN_loc(*) + INTEGER, TARGET :: LISTVAR_SCHUR(*) + INTEGER, TARGET :: IRHS_PTR(*), IRHS_SPARSE(*), ISOL_loc(*) + DOUBLE PRECISION, TARGET :: A(*), A_ELT(*), A_loc(*), RHS(*) + DOUBLE PRECISION, TARGET :: WK_USER(*) + DOUBLE PRECISION, TARGET :: REDRHS(*) + DOUBLE PRECISION, TARGET :: ROWSCA(*), COLSCA(*) + DOUBLE PRECISION, TARGET :: SCHUR(*) + DOUBLE PRECISION, TARGET :: RHS_SPARSE(*), SOL_loc(*) + INTEGER, INTENT(in) :: OOC_TMPDIR(OOC_TMPDIR_MAX_LENGTH) + INTEGER, INTENT(in) :: OOC_PREFIX(OOC_PREFIX_MAX_LENGTH) + INTEGER, INTENT(in) :: WRITE_PROBLEM(PB_MAX_LENGTH) + INTEGER IRNhere, JCNhere, Ahere, ELTPTRhere, ELTVARhere, + & A_ELThere, PERM_INhere, WK_USERhere, + & RHShere, REDRHShere, IRN_lochere, + & JCN_lochere, A_lochere, LISTVAR_SCHURhere, + & SCHURhere, COLSCAhere, ROWSCAhere, RHS_SPARSEhere, + & SOL_lochere, IRHS_PTRhere, IRHS_SPARSEhere, ISOL_lochere + INCLUDE 'mpif.h' + TYPE DMUMPS_STRUC_PTR + TYPE (DMUMPS_STRUC), POINTER :: PTR + END TYPE DMUMPS_STRUC_PTR + TYPE (DMUMPS_STRUC), POINTER :: mumps_par + TYPE (DMUMPS_STRUC_PTR), DIMENSION (:), POINTER, SAVE :: + & mumps_par_array + TYPE (DMUMPS_STRUC_PTR), DIMENSION (:), POINTER :: + & mumps_par_array_bis + INTEGER, SAVE :: DMUMPS_STRUC_ARRAY_SIZE = 0 + INTEGER, SAVE :: N_INSTANCES = 0 + INTEGER A_ELT_SIZE, I, Np, IERR + INTEGER DMUMPS_STRUC_ARRAY_SIZE_INIT + PARAMETER (DMUMPS_STRUC_ARRAY_SIZE_INIT=10) + EXTERNAL MUMPS_AFFECT_MAPPING, + & MUMPS_AFFECT_PIVNUL_LIST, + & MUMPS_AFFECT_SYM_PERM, + & MUMPS_AFFECT_UNS_PERM + IF (JOB == -1) THEN + DO I = 1, DMUMPS_STRUC_ARRAY_SIZE + IF ( .NOT. associated(mumps_par_array(I)%PTR) ) GOTO 10 + END DO + ALLOCATE( mumps_par_array_bis(DMUMPS_STRUC_ARRAY_SIZE + + & DMUMPS_STRUC_ARRAY_SIZE_INIT), stat=IERR) + IF (IERR /= 0) THEN + WRITE(*,*) ' ** Allocation Error 1 in DMUMPS_F77.' + CALL MUMPS_ABORT() + END IF + DO I = 1, DMUMPS_STRUC_ARRAY_SIZE + mumps_par_array_bis(I)%PTR=>mumps_par_array(I)%PTR + ENDDO + IF (associated(mumps_par_array)) DEALLOCATE(mumps_par_array) + mumps_par_array=>mumps_par_array_bis + NULLIFY(mumps_par_array_bis) + DO I = DMUMPS_STRUC_ARRAY_SIZE+1, DMUMPS_STRUC_ARRAY_SIZE + + & DMUMPS_STRUC_ARRAY_SIZE_INIT + NULLIFY(mumps_par_array(I)%PTR) + ENDDO + I = DMUMPS_STRUC_ARRAY_SIZE+1 + DMUMPS_STRUC_ARRAY_SIZE = DMUMPS_STRUC_ARRAY_SIZE + + & DMUMPS_STRUC_ARRAY_SIZE_INIT + 10 CONTINUE + INSTANCE_NUMBER = I + N_INSTANCES = N_INSTANCES+1 + ALLOCATE( mumps_par_array(INSTANCE_NUMBER)%PTR,stat=IERR ) + IF (IERR /= 0) THEN + WRITE(*,*) '** Allocation Error 2 in DMUMPS_F77.' + CALL MUMPS_ABORT() + ENDIF + mumps_par_array(INSTANCE_NUMBER)%PTR%KEEP(40) = 0 + mumps_par_array(INSTANCE_NUMBER)%PTR%INSTANCE_NUMBER = + & INSTANCE_NUMBER + END IF + IF ( INSTANCE_NUMBER .LE. 0 .OR. INSTANCE_NUMBER .GT. + & DMUMPS_STRUC_ARRAY_SIZE ) THEN + WRITE(*,*) ' ** Instance Error 1 in DMUMPS_F77', + & INSTANCE_NUMBER + CALL MUMPS_ABORT() + END IF + IF ( .NOT. associated ( mumps_par_array(INSTANCE_NUMBER)%PTR ) ) + & THEN + WRITE(*,*) ' Instance Error 2 in DMUMPS_F77', + & INSTANCE_NUMBER + CALL MUMPS_ABORT() + END IF + mumps_par => mumps_par_array(INSTANCE_NUMBER)%PTR + mumps_par%SYM = SYM + mumps_par%PAR = PAR + mumps_par%JOB = JOB + mumps_par%N = N + mumps_par%NZ = NZ + mumps_par%NZ_loc = NZ_loc + mumps_par%LWK_USER = LWK_USER + mumps_par%SIZE_SCHUR = SIZE_SCHUR + mumps_par%NELT= NELT + mumps_par%ICNTL(1:40)=ICNTL(1:40) + mumps_par%CNTL(1:15)=CNTL(1:15) + mumps_par%NRHS = NRHS + mumps_par%LRHS = LRHS + mumps_par%LREDRHS = LREDRHS + mumps_par%NZ_RHS = NZ_RHS + mumps_par%LSOL_loc = LSOL_loc + mumps_par%SCHUR_MLOC = SCHUR_MLOC + mumps_par%SCHUR_NLOC = SCHUR_NLOC + mumps_par%SCHUR_LLD = SCHUR_LLD + mumps_par%MBLOCK = MBLOCK + mumps_par%NBLOCK = NBLOCK + mumps_par%NPROW = NPROW + mumps_par%NPCOL = NPCOL + IF ( COMM_F77 .NE. -987654 ) THEN + mumps_par%COMM = COMM_F77 + ELSE + mumps_par%COMM = MPI_COMM_WORLD + ENDIF + CALL MPI_BCAST(NRHS,1,MPI_INTEGER,0,mumps_par%COMM,IERR) + IF ( IRNhere /= 0 ) mumps_par%IRN => IRN(1:NZ) + IF ( JCNhere /= 0 ) mumps_par%JCN => JCN(1:NZ) + IF ( Ahere /= 0 ) mumps_par%A => A(1:NZ) + IF ( IRN_lochere /= 0 ) mumps_par%IRN_loc => IRN_loc(1:NZ_loc) + IF ( JCN_lochere /= 0 ) mumps_par%JCN_loc => JCN_loc(1:NZ_loc) + IF ( A_lochere /= 0 ) mumps_par%A_loc => A_loc(1:NZ_loc) + IF ( ELTPTRhere /= 0 ) mumps_par%ELTPTR => ELTPTR(1:NELT+1) + IF ( ELTVARhere /= 0 ) mumps_par%ELTVAR => + & ELTVAR(1:ELTPTR(NELT+1)-1) + IF ( A_ELThere /= 0 ) THEN + A_ELT_SIZE = 0 + DO I = 1, NELT + Np = ELTPTR(I+1) -ELTPTR(I) + IF (SYM == 0) THEN + A_ELT_SIZE = A_ELT_SIZE + Np * Np + ELSE + A_ELT_SIZE = A_ELT_SIZE + Np * ( Np + 1 ) / 2 + END IF + END DO + mumps_par%A_ELT => A_ELT(1:A_ELT_SIZE) + END IF + IF ( PERM_INhere /= 0) mumps_par%PERM_IN => PERM_IN(1:N) + IF ( LISTVAR_SCHURhere /= 0) + & mumps_par%LISTVAR_SCHUR =>LISTVAR_SCHUR(1:SIZE_SCHUR) + IF ( SCHURhere /= 0 ) THEN + mumps_par%SCHUR_CINTERFACE=>SCHUR(1:1) + ENDIF + IF (NRHS .NE. 1) THEN + IF ( RHShere /= 0 ) mumps_par%RHS => RHS(1:NRHS*LRHS) + IF (REDRHShere /= 0)mumps_par%REDRHS=>REDRHS(1:NRHS*LREDRHS) + ELSE + IF ( RHShere /= 0 ) mumps_par%RHS => RHS(1:N) + IF (REDRHShere /= 0)mumps_par%REDRHS=>REDRHS(1:SIZE_SCHUR) + ENDIF + IF ( WK_USERhere /=0 ) THEN + IF (LWK_USER > 0 ) THEN + mumps_par%WK_USER => WK_USER(1:LWK_USER) + ELSE + mumps_par%WK_USER => WK_USER(1_8:-int(LWK_USER,8)*1000000_8) + ENDIF + ENDIF + IF ( COLSCAhere /= 0) mumps_par%COLSCA => COLSCA(1:N) + IF ( ROWSCAhere /= 0) mumps_par%ROWSCA => ROWSCA(1:N) + IF ( RHS_SPARSEhere /=0 ) mumps_par%RHS_SPARSE=> + & RHS_SPARSE(1:NZ_RHS) + IF ( IRHS_SPARSEhere /=0 ) mumps_par%IRHS_SPARSE=> + & IRHS_SPARSE(1:NZ_RHS) + IF ( SOL_lochere /=0 ) mumps_par%SOL_loc=> + & SOL_loc(1:LSOL_loc*NRHS) + IF ( ISOL_lochere /=0 ) mumps_par%ISOL_loc=> + & ISOL_loc(1:LSOL_loc) + IF ( IRHS_PTRhere /=0 ) mumps_par%IRHS_PTR=> + & IRHS_PTR(1:NRHS+1) + DO I=1,TMPDIRLEN + mumps_par%OOC_TMPDIR(I:I)=char(OOC_TMPDIR(I)) + ENDDO + DO I=TMPDIRLEN+1,OOC_TMPDIR_MAX_LENGTH + mumps_par%OOC_TMPDIR(I:I)=' ' + ENDDO + DO I=1,PREFIXLEN + mumps_par%OOC_PREFIX(I:I)=char(OOC_PREFIX(I)) + ENDDO + DO I=PREFIXLEN+1,OOC_PREFIX_MAX_LENGTH + mumps_par%OOC_PREFIX(I:I)=' ' + ENDDO + DO I=1,WRITE_PROBLEMLEN + mumps_par%WRITE_PROBLEM(I:I)=char(WRITE_PROBLEM(I)) + ENDDO + DO I=WRITE_PROBLEMLEN+1,PB_MAX_LENGTH + mumps_par%WRITE_PROBLEM(I:I)=' ' + ENDDO + CALL DMUMPS( mumps_par ) + INFO(1:40)=mumps_par%INFO(1:40) + INFOG(1:40)=mumps_par%INFOG(1:40) + RINFO(1:40)=mumps_par%RINFO(1:40) + RINFOG(1:40)=mumps_par%RINFOG(1:40) + ICNTL(1:40) = mumps_par%ICNTL(1:40) + CNTL(1:15) = mumps_par%CNTL(1:15) + SYM = mumps_par%SYM + PAR = mumps_par%PAR + JOB = mumps_par%JOB + N = mumps_par%N + NZ = mumps_par%NZ + NRHS = mumps_par%NRHS + LRHS = mumps_par%LRHS + LREDRHS = mumps_par%LREDRHS + NZ_loc = mumps_par%NZ_loc + NZ_RHS = mumps_par%NZ_RHS + LSOL_loc= mumps_par%LSOL_loc + SIZE_SCHUR = mumps_par%SIZE_SCHUR + LWK_USER = mumps_par%LWK_USER + NELT= mumps_par%NELT + DEFICIENCY = mumps_par%Deficiency + SCHUR_MLOC = mumps_par%SCHUR_MLOC + SCHUR_NLOC = mumps_par%SCHUR_NLOC + SCHUR_LLD = mumps_par%SCHUR_LLD + MBLOCK = mumps_par%MBLOCK + NBLOCK = mumps_par%NBLOCK + NPROW = mumps_par%NPROW + NPCOL = mumps_par%NPCOL + IF ( associated (mumps_par%MAPPING) ) THEN + CALL MUMPS_AFFECT_MAPPING(mumps_par%MAPPING(1)) + ELSE + CALL MUMPS_NULLIFY_C_MAPPING() + ENDIF + IF ( associated (mumps_par%PIVNUL_LIST) ) THEN + CALL MUMPS_AFFECT_PIVNUL_LIST(mumps_par%PIVNUL_LIST(1)) + ELSE + CALL MUMPS_NULLIFY_C_PIVNUL_LIST() + ENDIF + IF ( associated (mumps_par%SYM_PERM) ) THEN + CALL MUMPS_AFFECT_SYM_PERM(mumps_par%SYM_PERM(1)) + ELSE + CALL MUMPS_NULLIFY_C_SYM_PERM() + ENDIF + IF ( associated (mumps_par%UNS_PERM) ) THEN + CALL MUMPS_AFFECT_UNS_PERM(mumps_par%UNS_PERM(1)) + ELSE + CALL MUMPS_NULLIFY_C_UNS_PERM() + ENDIF + IF ( JOB == -2 ) THEN + IF (associated(mumps_par_array(INSTANCE_NUMBER)%PTR))THEN + DEALLOCATE(mumps_par_array(INSTANCE_NUMBER)%PTR) + NULLIFY (mumps_par_array(INSTANCE_NUMBER)%PTR) + N_INSTANCES = N_INSTANCES - 1 + IF ( N_INSTANCES == 0 ) THEN + DEALLOCATE(mumps_par_array) + DMUMPS_STRUC_ARRAY_SIZE = 0 + END IF + ELSE + WRITE(*,*) "** Warning: instance already freed" + WRITE(*,*) " this should normally not happen." + ENDIF + END IF + RETURN + END SUBROUTINE DMUMPS_F77 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part4.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part4.F new file mode 100644 index 000000000..0b552a29e --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part4.F @@ -0,0 +1,6846 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE DMUMPS_246(MYID, N, STEP, FRERE, FILS, + & NA, LNA, NE, DAD, ND, PROCNODE, SLAVEF, + & NRLADU, NIRADU, NIRNEC, NRLNEC, + & NRLNEC_ACTIVE, + & NIRADU_OOC, NIRNEC_OOC, + & MAXFR, OPSA, + & KEEP,KEEP8, LOCAL_M, LOCAL_N, SBUF_RECOLD, + & SBUF_SEND, SBUF_REC, OPS_SUBTREE, NSTEPS, + & I_AM_CAND,NMB_PAR2, ISTEP_TO_INIV2, CANDIDATES, + & IFLAG, IERROR + & ,MAX_FRONT_SURFACE_LOCAL + & ,MAX_SIZE_FACTOR, ENTRIES_IN_FACTORS_LOC + & ,ENTRIES_IN_FACTORS_LOC_MASTERS + & ) + IMPLICIT NONE + INTEGER MYID, N, LNA, IFLAG, IERROR + INTEGER NIRADU, NIRNEC + INTEGER(8) NRLADU, NRLNEC, NRLNEC_ACTIVE + INTEGER(8) NRLADU_CURRENT, NRLADU_ROOT_3 + INTEGER NIRADU_OOC, NIRNEC_OOC + INTEGER MAXFR, NSTEPS + INTEGER(8) MAX_FRONT_SURFACE_LOCAL + INTEGER STEP(N) + INTEGER FRERE(NSTEPS), FILS(N), NA(LNA), NE(NSTEPS), + & ND(NSTEPS), PROCNODE(NSTEPS), DAD(NSTEPS) + INTEGER SLAVEF, KEEP(500), LOCAL_M, LOCAL_N + INTEGER(8) KEEP8(150) + INTEGER(8) ENTRIES_IN_FACTORS_LOC, + & ENTRIES_IN_FACTORS_LOC_MASTERS + INTEGER SBUF_SEND, SBUF_REC + INTEGER(8) SBUF_RECOLD + INTEGER NMB_PAR2 + INTEGER ISTEP_TO_INIV2( KEEP(71) ) + LOGICAL I_AM_CAND(NMB_PAR2) + INTEGER CANDIDATES( SLAVEF+1, NMB_PAR2 ) + DOUBLE PRECISION OPSA + DOUBLE PRECISION OPSA_LOC + INTEGER(8) MAX_SIZE_FACTOR + DOUBLE PRECISION OPS_SUBTREE + DOUBLE PRECISION OPS_SBTR_LOC + INTEGER, ALLOCATABLE, DIMENSION(:) :: TNSTK, IPOOL, LSTKI + INTEGER(8), ALLOCATABLE, DIMENSION(:) :: LSTKR + INTEGER(8) SBUFS_CB, SBUFR_CB + INTEGER SBUFR, SBUFS + INTEGER BLOCKING_RHS + INTEGER ITOP,NELIM,NFR + INTEGER(8) ISTKR, LSTK + INTEGER ISTKI, STKI, ISTKI_OOC + INTEGER K,NSTK, IFATH + INTEGER INODE, LEAF, NBROOT, IN + INTEGER LEVEL, MAXITEMPCB + INTEGER(8) CURRENT_ACTIVE_MEM, MAXTEMPCB + LOGICAL UPDATE, UPDATEF, MASTER, MASTERF, INSSARBR + INTEGER LEVELF, NCB, SIZECBI + INTEGER(8) NCB8 + INTEGER(8) NFR8, NELIM8 + INTEGER(8) SIZECB, SIZECBINFR, SIZECB_SLAVE + INTEGER SIZEHEADER, SIZEHEADER_OOC, XSIZE_OOC + INTEGER EXTRA_PERM_INFO_OOC + INTEGER NBROWMAX, NSLAVES_LOC, NSLAVES_PASSED, + & NELIMF, NFRF, NCBF, + & NBROWMAXF, LKJIB, + & LKJIBT, NBR, NBCOLFAC + INTEGER(8) LEV3MAXREC, CBMAXR, CBMAXS + INTEGER ALLOCOK + INTEGER PANEL_SIZE + LOGICAL COMPRESSCB + DOUBLE PRECISION OPS_NODE, OPS_NODE_MASTER, OPS_NODE_SLAVE + INTEGER(8) ENTRIES_NODE_UPPER_PART, ENTRIES_NODE_LOWER_PART + INCLUDE 'mumps_headers.h' + INTEGER WHAT + INTEGER(8) IDUMMY8 + INTRINSIC min, int, real + INTEGER DMUMPS_748 + EXTERNAL DMUMPS_748 + INTEGER MUMPS_275, MUMPS_330 + LOGICAL MUMPS_170 + INTEGER MUMPS_52 + EXTERNAL MUMPS_503, MUMPS_52 + EXTERNAL MUMPS_275, MUMPS_330, + & MUMPS_170 + logical :: FORCE_CAND, CONCERNED, UPDATES, STACKCB, MASTERSON + integer :: IFSON, LEVELSON + IF (KEEP(50).eq.2) THEN + EXTRA_PERM_INFO_OOC = 1 + ELSE IF (KEEP(50).eq.0) THEN + EXTRA_PERM_INFO_OOC = 2 + ELSE + EXTRA_PERM_INFO_OOC = 0 + ENDIF + COMPRESSCB=( KEEP(215).EQ.0 .AND. KEEP(50).NE.0 ) + MAX_FRONT_SURFACE_LOCAL=0_8 + MAX_SIZE_FACTOR=0_8 + ALLOCATE( LSTKR(NSTEPS), TNSTK(NSTEPS), IPOOL(NSTEPS), + & LSTKI(NSTEPS) , stat=ALLOCOK) + if (ALLOCOK .GT. 0) THEN + IFLAG =-7 + IERROR = 4*NSTEPS + RETURN + endif + LKJIB = max(KEEP(5),KEEP(6)) + TNSTK = NE + LEAF = NA(1)+1 + IPOOL(1:LEAF-1) = NA(3:3+LEAF-2) + NBROOT = NA(2) +#if defined(OLD_OOC_NOPANEL) + XSIZE_OOC=XSIZE_OOC_NOPANEL +#else + IF (KEEP(50).EQ.0) THEN + XSIZE_OOC=XSIZE_OOC_UNSYM + ELSE + XSIZE_OOC=XSIZE_OOC_SYM + ENDIF +#endif + SIZEHEADER_OOC = XSIZE_OOC+6 + SIZEHEADER = XSIZE_IC + 6 + ISTKR = 0_8 + ISTKI = 0 + ISTKI_OOC = 0 + OPSA_LOC = dble(0.0D0) + ENTRIES_IN_FACTORS_LOC = 0_8 + ENTRIES_IN_FACTORS_LOC_MASTERS = 0_8 + OPS_SBTR_LOC = dble(0.0D0) + NRLADU = 0_8 + NIRADU = 0 + NIRADU_OOC = 0 + NRLADU_CURRENT = 0_8 + NRLADU_ROOT_3 = 0_8 + NRLNEC_ACTIVE = 0_8 + NRLNEC = 0_8 + NIRNEC = 0 + NIRNEC_OOC = 0 + MAXFR = 0 + ITOP = 0 + MAXTEMPCB = 0_8 + MAXITEMPCB = 0 + SBUFS_CB = 1_8 + SBUFS = 1 + SBUFR_CB = 1_8 + SBUFR = 1 + IF (KEEP(38) .NE. 0 .AND. KEEP(60).EQ.0) THEN + INODE = KEEP(38) + NRLADU_ROOT_3 = int(LOCAL_M,8)*int(LOCAL_N,8) + NRLADU = NRLADU_ROOT_3 + NRLNEC_ACTIVE = NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_ROOT_3) + NRLNEC = NRLADU + IF (MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + & .EQ. MYID) THEN + NIRADU = SIZEHEADER+2*(ND(STEP(INODE))+KEEP(253)) + NIRADU_OOC = SIZEHEADER_OOC+2*(ND(STEP(INODE))+KEEP(253)) + ELSE + NIRADU = SIZEHEADER + NIRADU_OOC = SIZEHEADER_OOC + ENDIF + NIRNEC = NIRADU + NIRNEC_OOC = NIRADU_OOC + ENDIF + IF((KEEP(24).eq.0).OR.(KEEP(24).eq.1)) THEN + FORCE_CAND=.FALSE. + ELSE + FORCE_CAND=(mod(KEEP(24),2).eq.0) + END IF + 90 CONTINUE + IF (LEAF.NE.1) THEN + LEAF = LEAF - 1 + INODE = IPOOL(LEAF) + ELSE + WRITE(MYID+6,*) ' ERROR 1 in DMUMPS_246 ' + CALL MUMPS_ABORT() + ENDIF + 95 CONTINUE + NFR = ND(STEP(INODE))+KEEP(253) + NFR8 = int(NFR,8) + NSTK = NE(STEP(INODE)) + NELIM = 0 + IN = INODE + 100 NELIM = NELIM + 1 + NELIM8=int(NELIM,8) + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 100 + IFSON = -IN + IFATH = DAD(STEP(INODE)) + MASTER = MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + & .EQ. MYID + LEVEL = MUMPS_330(PROCNODE(STEP(INODE)),SLAVEF) + INSSARBR = MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF) + UPDATE=.FALSE. + if(.NOT.FORCE_CAND) then + UPDATE = ( (MASTER.AND.(LEVEL.NE.3) ).OR. LEVEL.EQ.2 ) + else + if(MASTER.and.(LEVEL.ne.3)) then + UPDATE = .TRUE. + else if(LEVEL.eq.2) then + if ( I_AM_CAND(ISTEP_TO_INIV2(STEP(INODE)))) THEN + UPDATE = .TRUE. + end if + end if + end if + NCB = NFR-NELIM + NCB8 = int(NCB,8) + SIZECBINFR = NCB8*NCB8 + IF (KEEP(50).EQ.0) THEN + SIZECB = SIZECBINFR + ELSE + IFATH = DAD(STEP(INODE)) + IF ( IFATH.NE.KEEP(38) .AND. COMPRESSCB ) THEN + SIZECB = (NCB8*(NCB8+1_8))/2_8 + ELSE + SIZECB = SIZECBINFR + ENDIF + ENDIF + SIZECBI = 2* NCB + SIZEHEADER + IF (LEVEL.NE.2) THEN + NSLAVES_LOC = -99999999 + SIZECB_SLAVE = -99999997_8 + NBROWMAX = NCB + ELSE + IF (KEEP(48) .EQ. 5) THEN + WHAT = 5 + IF (FORCE_CAND) THEN + NSLAVES_LOC=CANDIDATES(SLAVEF+1, + & ISTEP_TO_INIV2(STEP(INODE))) + ELSE + NSLAVES_LOC=SLAVEF-1 + ENDIF + NSLAVES_PASSED=NSLAVES_LOC + ELSE + WHAT = 2 + NSLAVES_PASSED=SLAVEF + NSLAVES_LOC =SLAVEF-1 + ENDIF + CALL MUMPS_503(WHAT, KEEP,KEEP8, + & NCB, NFR, NSLAVES_PASSED, NBROWMAX, SIZECB_SLAVE + & ) + ENDIF + IF (KEEP(60).GT.1) THEN + IF (MASTER .AND. INODE.EQ.KEEP(38)) THEN + NIRADU = NIRADU+SIZEHEADER+2*(ND(STEP(INODE))+KEEP(253)) + NIRADU_OOC = NIRADU_OOC+SIZEHEADER_OOC+ + & 2*(ND(STEP(INODE))+KEEP(253)) + ENDIF + ENDIF + IF (LEVEL.EQ.3) THEN + IF ( + & KEEP(60).LE.1 + & ) THEN + NRLNEC = max(NRLNEC,NRLADU+ISTKR+ + & int(LOCAL_M,8)*int(LOCAL_N,8)) + NRLADU_CURRENT = int(LOCAL_M,8)*int(LOCAL_N,8) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_ROOT_3 + + & NRLADU_CURRENT+ISTKR) + ENDIF + IF (MASTER) THEN + IF (NFR.GT.MAXFR) MAXFR = NFR + ENDIF + ENDIF + IF(KEEP(86).EQ.1)THEN + IF(MASTER.AND.(.NOT.MUMPS_170( + & PROCNODE(STEP(INODE)), SLAVEF)) + & )THEN + IF(LEVEL.EQ.1)THEN + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NFR8*NFR8) + ELSEIF(LEVEL.EQ.2)THEN + IF(KEEP(50).EQ.0)THEN + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NFR8*NELIM8) + ELSE + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NELIM8*NELIM8) + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NELIM8*(NELIM8+1_8)) + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + IF (LEVEL.EQ.2) THEN + IF (MASTER) THEN + IF (KEEP(50).EQ.0) THEN + SBUFS = max(SBUFS, NFR*LKJIB+LKJIB+4) + ELSE + SBUFS = max(SBUFS, NELIM*LKJIB+NELIM+6) + ENDIF + ELSEIF (UPDATE) THEN + if (KEEP(50).EQ.0) THEN + SBUFR = max(SBUFR, NFR*LKJIB+LKJIB+4) + else + SBUFR = max( SBUFR, NELIM*LKJIB+NELIM+6 ) + IF (KEEP(50).EQ.1) THEN + LKJIBT = LKJIB + ELSE + LKJIBT = min( NELIM, LKJIB * 2 ) + ENDIF + SBUFS = max(SBUFS, + & LKJIBT*NBROWMAX+6) + SBUFR = max( SBUFR, NBROWMAX*LKJIBT+6 ) + endif + ENDIF + ENDIF + IF ( UPDATE ) THEN + IF ( (MASTER) .AND. (LEVEL.EQ.1) ) THEN + NIRADU = NIRADU + 2*NFR + SIZEHEADER + NIRADU_OOC = NIRADU_OOC + 2*NFR + SIZEHEADER_OOC + PANEL_SIZE = DMUMPS_748( + & 2_8*int(KEEP(226),8), NFR, KEEP(227), KEEP(50)) + NIRADU_OOC = NIRADU_OOC + + & EXTRA_PERM_INFO_OOC*(2+NELIM + NELIM/PANEL_SIZE+1) + IF (KEEP(50).EQ.0) THEN + NRLADU_CURRENT = int(NELIM,8)*int(2*NFR-NELIM,8) + NRLADU = NRLADU + NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + ELSE + NRLADU_CURRENT = int(NELIM,8)*int(NFR,8) + NRLADU = NRLADU + NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + ENDIF + SIZECBI = 2* NCB + 6 + 3 + ELSEIF (LEVEL.EQ.2) THEN + IF (MASTER) THEN + NIRADU = NIRADU+SIZEHEADER +SLAVEF-1+2*NFR + NIRADU_OOC = NIRADU_OOC+SIZEHEADER_OOC +SLAVEF-1+2*NFR + IF (KEEP(50).EQ.0) THEN + NBCOLFAC=NFR + ELSE + NBCOLFAC=NELIM + ENDIF + PANEL_SIZE = DMUMPS_748( + & 2_8*int(KEEP(226),8), NBCOLFAC, KEEP(227), KEEP(50)) + NIRADU_OOC = NIRADU_OOC + + & EXTRA_PERM_INFO_OOC*(2+NELIM + NELIM/PANEL_SIZE+1) + NRLADU_CURRENT = int(NBCOLFAC,8)*int(NELIM,8) + NRLADU = NRLADU + NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + SIZECB = 0_8 + SIZECBINFR = 0_8 + SIZECBI = NCB + 5 + SLAVEF - 1 + ELSE + SIZECB=SIZECB_SLAVE + SIZECBINFR = SIZECB + NIRADU = NIRADU+4+NELIM+NBROWMAX + NIRADU_OOC = NIRADU_OOC+4+NELIM+NBROWMAX + IF (KEEP(50).EQ.0) THEN + NRLADU = NRLADU + int(NELIM,8)*int(NBROWMAX,8) + ELSE + NRLADU = NRLADU + int(NELIM,8)*int(NCB/NSLAVES_LOC,8) + ENDIF + NRLADU_CURRENT = int(NELIM,8)*int(NBROWMAX,8) + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + SIZECBI = 4 + NBROWMAX + NCB + IF (KEEP(50).NE.0) THEN + SIZECBI=SIZECBI+NSLAVES_LOC+ + & XTRA_SLAVES_SYM + ELSE + SIZECBI=SIZECBI+NSLAVES_LOC+ + & XTRA_SLAVES_UNSYM + ENDIF + ENDIF + ENDIF + NIRNEC = max0(NIRNEC, + & NIRADU+ISTKI+SIZECBI+MAXITEMPCB) + NIRNEC_OOC = max0(NIRNEC_OOC, + & NIRADU_OOC+ISTKI_OOC+SIZECBI+MAXITEMPCB + + & (XSIZE_OOC-XSIZE_IC) ) + CURRENT_ACTIVE_MEM = ISTKR+SIZECBINFR + IF (NSTK .NE. 0 .AND. INSSARBR .AND. + & KEEP(234).NE.0 .AND. KEEP(55).EQ.0) THEN + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM - LSTKR(ITOP) + ENDIF + IF (KEEP(50).NE.0.AND.UPDATE.AND.LEVEL.EQ.1) THEN + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM + + & int(NELIM,8)*int(NCB,8) + ENDIF + IF (MASTER .AND. KEEP(219).NE.0.AND. + & KEEP(50).EQ.2.AND.LEVEL.EQ.2) THEN + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM + int(NELIM,8) + ENDIF + IF (SLAVEF.EQ.1) THEN + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM) + ELSE + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+MAXTEMPCB) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM+MAXTEMPCB) + ENDIF + IF (NFR.GT.MAXFR) MAXFR = NFR + IF (NSTK.GT.0) THEN + DO 70 K=1,NSTK + LSTK = LSTKR(ITOP) + ISTKR = ISTKR - LSTK + IF (K==1 .AND. INSSARBR.AND.KEEP(234).NE.0 + & .AND.KEEP(55).EQ.0) THEN + ELSE + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM - LSTK + ENDIF + STKI = LSTKI( ITOP ) + ISTKI = ISTKI - STKI + ISTKI_OOC = ISTKI_OOC - STKI - (XSIZE_OOC-XSIZE_IC) + ITOP = ITOP - 1 + IF (ITOP.LT.0) THEN + write(*,*) MYID, + & ': ERROR 2 in DMUMPS_246. ITOP = ',ITOP + CALL MUMPS_ABORT() + ENDIF + 70 CONTINUE + ENDIF + ELSE IF (LEVEL.NE.3) THEN + DO WHILE (IFSON.GT.0) + UPDATES=.FALSE. + MASTERSON = MUMPS_275(PROCNODE(STEP(IFSON)),SLAVEF) + & .EQ.MYID + LEVELSON = MUMPS_330(PROCNODE(STEP(IFSON)),SLAVEF) + if(.NOT.FORCE_CAND) then + UPDATES =((MASTERSON.AND.(LEVELSON.NE.3)).OR. + & LEVELSON.EQ.2) + else + if(MASTERSON.and.(LEVELSON.ne.3)) then + UPDATES = .TRUE. + else if(LEVELSON.eq.2) then + if ( I_AM_CAND(ISTEP_TO_INIV2(STEP(IFSON)))) then + UPDATES = .TRUE. + end if + end if + end if + IF (UPDATES) THEN + LSTK = LSTKR(ITOP) + ISTKR = ISTKR - LSTK + STKI = LSTKI( ITOP ) + ISTKI = ISTKI - STKI + ISTKI_OOC = ISTKI_OOC - STKI - (XSIZE_OOC-XSIZE_IC) + ITOP = ITOP - 1 + IF (ITOP.LT.0) THEN + write(*,*) MYID, + & ': ERROR 2 in DMUMPS_246. ITOP = ',ITOP + CALL MUMPS_ABORT() + ENDIF + ENDIF + IFSON = FRERE(STEP(IFSON)) + END DO + ENDIF + IF ( + & ( (INODE.NE.KEEP(20)).OR.(KEEP(60).EQ.0) ) + & .AND. + & ( (INODE.NE.KEEP(38)).OR.(KEEP(60).LE.1) ) + & ) + &THEN + ENTRIES_NODE_LOWER_PART = int(NFR-NELIM,8) * int(NELIM,8) + IF ( KEEP(50).EQ.0 ) THEN + ENTRIES_NODE_UPPER_PART = int(NFR,8) * int(NELIM,8) + ELSE + ENTRIES_NODE_UPPER_PART = + & (int(NELIM,8)*int(NELIM+1,8))/2_8 + ENDIF + IF (KEEP(50).EQ.2 .AND. LEVEL.EQ.3) THEN + CALL MUMPS_511(NFR, + & NELIM, NELIM,0, + & 1,OPS_NODE) + ELSE + CALL MUMPS_511(NFR, + & NELIM, NELIM,KEEP(50), + & 1,OPS_NODE) + ENDIF + IF (LEVEL.EQ.2) THEN + CALL MUMPS_511(NFR, + & NELIM, NELIM,KEEP(50), + & 2,OPS_NODE_MASTER) + OPS_NODE_SLAVE=OPS_NODE-OPS_NODE_MASTER + ENDIF + ELSE + OPS_NODE = 0.0D0 + ENTRIES_NODE_UPPER_PART = 0_8 + ENTRIES_NODE_LOWER_PART = 0_8 + ENDIF + IF ( MASTER ) + & ENTRIES_IN_FACTORS_LOC_MASTERS = + & ENTRIES_IN_FACTORS_LOC_MASTERS + + & ENTRIES_NODE_UPPER_PART + + & ENTRIES_NODE_LOWER_PART + IF (UPDATE.OR.LEVEL.EQ.3) THEN + IF ( LEVEL .EQ. 3 ) THEN + OPSA_LOC = OPSA_LOC + OPS_NODE / dble( SLAVEF ) + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & ENTRIES_NODE_UPPER_PART / + & int(SLAVEF,8) + IF (MASTER) + & ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & mod(ENTRIES_NODE_UPPER_PART, + & int(SLAVEF,8)) + ELSE IF (MASTER .AND. LEVEL.EQ.2) THEN + OPSA_LOC = OPSA_LOC + OPS_NODE_MASTER + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & ENTRIES_NODE_UPPER_PART + + & mod(ENTRIES_NODE_LOWER_PART, + & int(NSLAVES_LOC,8)) + ELSE IF (MASTER .AND. LEVEL.EQ.1) THEN + OPSA_LOC = OPSA_LOC + dble(OPS_NODE) + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & ENTRIES_NODE_UPPER_PART + + & ENTRIES_NODE_LOWER_PART + ELSE IF (UPDATE) THEN + OPSA_LOC = OPSA_LOC + + & dble(OPS_NODE_SLAVE)/dble(NSLAVES_LOC) + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + & + ENTRIES_NODE_LOWER_PART / + & int(NSLAVES_LOC,8) + ENDIF + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF) .OR. NE(STEP(INODE))==0) THEN + IF (LEVEL == 1) THEN + OPS_SBTR_LOC = OPS_SBTR_LOC + OPS_NODE + ELSE + CALL MUMPS_511(NFR, + & NELIM, NELIM,KEEP(50), + & 1,OPS_NODE) + OPS_SBTR_LOC = OPS_SBTR_LOC + OPS_NODE + ENDIF + ENDIF + ENDIF + IF (IFATH .EQ. 0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 115 + GOTO 90 + ELSE + NFRF = ND(STEP(IFATH))+KEEP(253) + IF (DAD(STEP(IFATH)).EQ.0) THEN + NELIMF = NFRF + ELSE + NELIMF = 0 + IN = IFATH + DO WHILE (IN.GT.0) + IN = FILS(IN) + NELIMF = NELIMF+1 + ENDDO + ENDIF + NCBF = NFRF - NELIMF + LEVELF = MUMPS_330(PROCNODE(STEP(IFATH)),SLAVEF) + MASTERF= MUMPS_275(PROCNODE(STEP(IFATH)),SLAVEF).EQ.MYID + UPDATEF= .FALSE. + if(.NOT.FORCE_CAND) then + UPDATEF= ((MASTERF.AND.(LEVELF.NE.3)).OR.LEVELF.EQ.2) + else + if(MASTERF.and.(LEVELF.ne.3)) then + UPDATEF = .TRUE. + else if (LEVELF.eq.2) then + if ( I_AM_CAND(ISTEP_TO_INIV2(STEP(IFATH)))) THEN + UPDATEF = .TRUE. + end if + end if + end if + CONCERNED = UPDATEF .OR. UPDATE + IF (LEVELF .NE. 2) THEN + NBROWMAXF = -999999 + ELSE + IF (KEEP(48) .EQ. 5) THEN + WHAT = 4 + IF (FORCE_CAND) THEN + NSLAVES_LOC=CANDIDATES(SLAVEF+1, + & ISTEP_TO_INIV2(STEP(IFATH))) + ELSE + NSLAVES_LOC=SLAVEF-1 + ENDIF + ELSE + WHAT = 1 + NSLAVES_LOC=SLAVEF + ENDIF + CALL MUMPS_503( WHAT, KEEP, KEEP8, + & NCBF, NFRF, NSLAVES_LOC, NBROWMAXF, IDUMMY8 + & ) + ENDIF + IF(LEVEL.EQ.1.AND.UPDATE.AND. + & (UPDATEF.OR.LEVELF.EQ.2) + & .AND.LEVELF.NE.3) THEN + IF ( INSSARBR .AND. KEEP(234).NE.0) THEN + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM) + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM) + ELSE + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM+SIZECB) + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+SIZECB) + ENDIF + ENDIF + IF (UPDATE .AND. LEVEL.EQ.2 .AND. .NOT. MASTER) THEN + NRLNEC = + & max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+NRLADU_CURRENT) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,2_8*NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM) + ENDIF + IF (LEVELF.EQ.3) THEN + IF (LEVEL.EQ.1) THEN + LEV3MAXREC = int(min(NCB,LOCAL_M),8) * + & int(min(NCB,LOCAL_N),8) + ELSE + LEV3MAXREC = min(SIZECB, + & int(min(NBROWMAX,LOCAL_M),8) + & *int(min(NCB,LOCAL_N),8)) + ENDIF + MAXTEMPCB = max(MAXTEMPCB, LEV3MAXREC) + MAXITEMPCB = max(MAXITEMPCB,SIZECBI+SIZEHEADER) + SBUFR_CB = max(SBUFR_CB, LEV3MAXREC+int(SIZECBI,8)) + NIRNEC = max(NIRNEC,NIRADU+ISTKI+ + & min(NCB,LOCAL_M)+ min(NCB,LOCAL_N)+SIZEHEADER) + NIRNEC_OOC = max(NIRNEC_OOC,NIRADU_OOC+ISTKI_OOC+ + & min(NCB,LOCAL_M)+ min(NCB,LOCAL_N)+SIZEHEADER) + ENDIF + IF (CONCERNED) THEN + IF (LEVELF.EQ.2) THEN + IF (UPDATE.AND.(LEVEL.NE.2.OR..NOT.MASTER)) THEN + IF(MASTERF)THEN + NBR = min(NBROWMAXF,NBROWMAX) + ELSE + NBR = min(max(NELIMF,NBROWMAXF),NBROWMAX) + ENDIF + IF (KEEP(50).EQ.0) THEN + CBMAXS = int(NBR,8)*int(NCB,8) + ELSE + CBMAXS = int(NBR,8)*int(NCB,8) - + & (int(NBR,8)*int(NBR-1,8))/2_8 + ENDIF + ELSE + CBMAXS = 0_8 + END IF + IF (MASTERF) THEN + IF (LEVEL.EQ.1) THEN + IF (.NOT.UPDATE) THEN + NBR = min(NELIMF, NCB) + ELSE + NBR = 0 + ENDIF + ELSE + NBR = min(NELIMF, NBROWMAX) + ENDIF + IF (KEEP(50).EQ.0) THEN + CBMAXR = int(NBR,8)*NCB8 + ELSE + CBMAXR = int(NBR,8)*int(min(NCB,NELIMF),8)- + & (int(NBR,8)*int(NBR-1,8))/2_8 + CBMAXR = min(CBMAXR, int(NELIMF,8)*int(NELIMF+1,8)/2_8) + CBMAXR = min(CBMAXR, SIZECB) + IF ((LEVEL.EQ.1).AND.(.NOT. COMPRESSCB)) THEN + CBMAXR = min(CBMAXR,(NCB8*(NCB8+1_8))/2_8) + ENDIF + ENDIF + ELSE IF (UPDATEF) THEN + NBR = min(NBROWMAXF,NBROWMAX) + CBMAXR = int(NBR,8) * NCB8 + IF (KEEP(50).NE.0) THEN + CBMAXR = CBMAXR - (int(NBR,8)*(int(NBR-1,8)))/2_8 + ENDIF + ELSE + CBMAXR = 0_8 + ENDIF + ELSEIF (LEVELF.EQ.3) THEN + CBMAXR = LEV3MAXREC + IF (UPDATE.AND. .NOT. (MASTER.AND.LEVEL.EQ.2)) THEN + CBMAXS = LEV3MAXREC + ELSE + CBMAXS = 0_8 + ENDIF + ELSE + IF (MASTERF) THEN + CBMAXS = 0_8 + NBR = min(NFRF,NBROWMAX) + IF ((LEVEL.EQ.1).AND.UPDATE) THEN + NBR = 0 + ENDIF + CBMAXR = int(NBR,8)*int(min(NFRF,NCB),8) + IF (LEVEL.EQ.2) + & CBMAXR = min(CBMAXR, SIZECB_SLAVE) + IF ( KEEP(50).NE.0 ) THEN + CBMAXR = min(CBMAXR,(int(NFRF,8)*int(NFRF+1,8))/2_8) + ELSE + CBMAXR = min(CBMAXR,int(NFRF,8)*int(NFRF,8)) + ENDIF + ELSE + CBMAXR = 0_8 + CBMAXS = SIZECB + ENDIF + ENDIF + IF (UPDATE) THEN + CBMAXS = min(CBMAXS, SIZECB) + IF ( .not. ( LEVELF .eq. 1 .AND. UPDATEF ) )THEN + SBUFS_CB = max(SBUFS_CB, CBMAXS+int(SIZECBI,8)) + ENDIF + ENDIF + STACKCB = .FALSE. + IF (UPDATEF) THEN + STACKCB = .TRUE. + SIZECBI = 2 * NFR + SIZEHEADER + IF (LEVEL.EQ.1) THEN + IF (KEEP(50).NE.0.AND.LEVELF.NE.3 + & .AND.COMPRESSCB) THEN + SIZECB = (NCB8*(NCB8+1_8))/2_8 + ELSE + SIZECB = NCB8*NCB8 + ENDIF + IF (MASTER) THEN + SIZECBI = 2+ XSIZE_IC + ELSE IF (LEVELF.EQ.1) THEN + SIZECB = min(CBMAXR,SIZECB) + SIZECBI = 2 * NCB + 9 + SBUFR_CB = max(SBUFR_CB, int(SIZECBI,8)+SIZECB) + SIZECBI = 2 * NCB + SIZEHEADER + ELSE + SIZECBI = 2 * NCB + 9 + SBUFR_CB = max(SBUFR_CB, + & min(SIZECB,CBMAXR) + int(SIZECBI,8)) + MAXTEMPCB = max(MAXTEMPCB, min(SIZECB,CBMAXR)) + SIZECBI = 2 * NCB + SIZEHEADER + MAXITEMPCB = max(MAXITEMPCB, SIZECBI) + SIZECBI = 0 + SIZECB = 0_8 + ENDIF + ELSE + SIZECB = SIZECB_SLAVE + MAXTEMPCB = max(MAXTEMPCB, min(CBMAXR,SIZECB) ) + MAXITEMPCB = max(MAXITEMPCB,NBROWMAX+NCB+SIZEHEADER) + IF (.NOT. + & (UPDATE.AND.(.NOT.MASTER).AND.(NSLAVES_LOC.EQ.1)) + & ) + & SBUFR_CB = max(SBUFR_CB, + & min(CBMAXR,SIZECB) + int(NBROWMAX + NCB + 6,8)) + IF (MASTER) THEN + SIZECBI = NCB + 5 + SLAVEF - 1 + XSIZE_IC + SIZECB = 0_8 + ELSE IF (UPDATE) THEN + SIZECBI = NFR + 6 + SLAVEF - 1 + XSIZE_IC + IF (KEEP(50).EQ.0) THEN + SIZECBI = SIZECBI + NBROWMAX + NFR + + & SIZEHEADER + ELSE + SIZECBI = SIZECBI + NBROWMAX + NFR + + & SIZEHEADER+ NSLAVES_LOC + ENDIF + ELSE + SIZECB = 0_8 + SIZECBI = 0 + ENDIF + ENDIF + ELSE + IF (LEVELF.NE.3) THEN + STACKCB = .TRUE. + SIZECB = 0_8 + SIZECBI = 0 + IF ( (LEVEL.EQ.1) .AND. (LEVELF.NE.1) ) THEN + IF (COMPRESSCB) THEN + SIZECB = (NCB8*(NCB8+1_8))/2_8 + ELSE + SIZECB = NCB8*NCB8 + ENDIF + SIZECBI = 2 * NCB + SIZEHEADER + ELSE IF (LEVEL.EQ.2) THEN + IF (MASTER) THEN + SIZECBI = NCB + 5 + SLAVEF - 1 + XSIZE_IC + ELSE + SIZECB = SIZECB_SLAVE + SIZECBI = SIZECBI + NBROWMAX + NFR + SIZEHEADER + ENDIF + ENDIF + ENDIF + ENDIF + IF (STACKCB) THEN + IF (FRERE(STEP(INODE)).EQ.0) THEN + write(*,*) ' ERROR 3 in DMUMPS_246' + CALL MUMPS_ABORT() + ENDIF + ITOP = ITOP + 1 + IF ( ITOP .GT. NSTEPS ) THEN + WRITE(*,*) 'ERROR 4 in DMUMPS_246 ' + ENDIF + LSTKI(ITOP) = SIZECBI + ISTKI=ISTKI + SIZECBI + ISTKI_OOC = ISTKI_OOC + SIZECBI + (XSIZE_OOC-XSIZE_IC) + LSTKR(ITOP) = SIZECB + ISTKR = ISTKR + LSTKR(ITOP) + NRLNEC = max(NRLNEC,NRLADU+ISTKR+MAXTEMPCB) + NIRNEC = max0(NIRNEC,NIRADU+ISTKI+MAXITEMPCB) + NIRNEC_OOC = max0(NIRNEC_OOC,NIRADU_OOC+ISTKI_OOC+ + & MAXITEMPCB + + & (XSIZE_OOC-XSIZE_IC) ) + ENDIF + ENDIF + TNSTK(STEP(IFATH)) = TNSTK(STEP(IFATH)) - 1 + IF ( TNSTK(STEP(IFATH)) .EQ. 0 ) THEN + INODE = IFATH + GOTO 95 + ELSE + GOTO 90 + ENDIF + ENDIF + 115 CONTINUE + BLOCKING_RHS = KEEP(84) + IF (KEEP(84).EQ.0) BLOCKING_RHS=1 + NRLNEC = max(NRLNEC, + & NRLADU+int(4*KEEP(127)*abs(BLOCKING_RHS),8)) + IF (BLOCKING_RHS .LT. 0) THEN + BLOCKING_RHS = - 2 * BLOCKING_RHS + ENDIF + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE, MAX_SIZE_FACTOR+ + & int(4*KEEP(127)*BLOCKING_RHS,8)) + SBUF_RECOLD = max(int(SBUFR,8),SBUFR_CB) + SBUF_RECOLD = max(SBUF_RECOLD, + & MAXTEMPCB+int(MAXITEMPCB,8)) + 10_8 + SBUF_REC = max(SBUFR, int(min(100000_8,SBUFR_CB))) + SBUF_REC = SBUF_REC + 17 + SBUF_REC = SBUF_REC + 2 * KEEP(127) + SLAVEF - 1 + 7 + SBUF_SEND = max(SBUFS, int(min(100000_8,SBUFR_CB))) + SBUF_SEND = SBUF_SEND + 17 + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN + SBUF_RECOLD = SBUF_RECOLD+int(KEEP(108)+1,8) + SBUF_REC = SBUF_REC+KEEP(108)+1 + SBUF_SEND = SBUF_SEND+KEEP(108)+1 + ENDIF + IF (SLAVEF.EQ.1) THEN + SBUF_RECOLD = 1_8 + SBUF_REC = 1 + SBUF_SEND= 1 + ENDIF + DEALLOCATE( LSTKR, TNSTK, IPOOL, + & LSTKI ) + OPS_SUBTREE = dble(OPS_SBTR_LOC) + OPSA = dble(OPSA_LOC) + KEEP(66) = int(OPSA_LOC/1000000.d0) + RETURN + END SUBROUTINE DMUMPS_246 + RECURSIVE SUBROUTINE + & DMUMPS_271( COMM_LOAD, ASS_IRECV, + & INODE, NELIM_ROOT, root, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mpif.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER KEEP(500), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER INODE, NELIM_ROOT + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS(KEEP(28)) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER INTARR(max(1,KEEP(14))) + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mumps_tags.h' + INTEGER I, LCONT, NCOL_TO_SEND, LDA + INTEGER(8) :: SHIFT_VAL_SON, POSELT + INTEGER FPERE, IOLDPS, NFRONT, NPIV, NASS, NSLAVES, + & H_INODE, NELIM, NBCOL, LIST_NELIM_ROW, + & LIST_NELIM_COL, NELIM_LOCAL, TYPE_SON, + & NROW, NCOL, NBROW, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON, LDAFS, IERR, + & STATUS( MPI_STATUS_SIZE ), ISON, PDEST_MASTER_ISON + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER MSGSOU, MSGTAG + LOGICAL INVERT + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275, MUMPS_330 + EXTERNAL MUMPS_275, MUMPS_330 + FPERE = KEEP(38) + TYPE_SON = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF ( MUMPS_275( PROCNODE_STEPS(STEP(INODE)), + & SLAVEF ).EQ.MYID) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + H_INODE = 6 + NSLAVES + KEEP(IXSZ) + NELIM = NASS - NPIV + NBCOL = NFRONT - NPIV + LIST_NELIM_ROW = IOLDPS + H_INODE + NPIV + LIST_NELIM_COL = LIST_NELIM_ROW + NFRONT + IF (NELIM.LE.0) THEN + write(6,*) ' ERROR 1 in DMUMPS_271 ', NELIM + write(6,*) MYID,':Process root2son: INODE=',INODE, + & 'Header=',IW(PTLUST_S(STEP(INODE)):PTLUST_S(STEP(INODE)) + & +5+KEEP(IXSZ)) + CALL MUMPS_ABORT() + ENDIF + NELIM_LOCAL = NELIM_ROOT + DO I=1, NELIM + root%RG2L_ROW(IW(LIST_NELIM_ROW)) = NELIM_LOCAL + root%RG2L_COL(IW(LIST_NELIM_COL)) = NELIM_LOCAL + NELIM_LOCAL = NELIM_LOCAL + 1 + LIST_NELIM_ROW = LIST_NELIM_ROW + 1 + LIST_NELIM_COL = LIST_NELIM_COL + 1 + ENDDO + NBROW = NFRONT - NPIV + NROW = NELIM + IF ( KEEP( 50 ) .eq. 0 ) THEN + NCOL = NFRONT - NPIV + ELSE + NCOL = NELIM + END IF + SHIFT_LIST_ROW_SON = H_INODE + NPIV + SHIFT_LIST_COL_SON = H_INODE + NFRONT + NPIV + IF ( KEEP(50).eq.0 .OR. TYPE_SON .eq. 1 ) THEN + LDAFS = NFRONT + ELSE + LDAFS = NASS + END IF + SHIFT_VAL_SON = int(NPIV,8) * int(LDAFS,8) + int(NPIV,8) + CALL DMUMPS_80( COMM_LOAD, + & ASS_IRECV, + & N, INODE, FPERE, + & PTLUST_S(1), PTRAST(1), + & root, NROW, NCOL, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDAFS, + & ROOT_NON_ELIM_CB, MYID, COMM, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S(1), PTRFAC(1), PTRAST(1), + & STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0 ) RETURN + IF (TYPE_SON.EQ.1) THEN + NROW = NFRONT - NASS + NCOL = NELIM + SHIFT_LIST_ROW_SON = H_INODE + NASS + SHIFT_LIST_COL_SON = H_INODE + NFRONT + NPIV + SHIFT_VAL_SON = int(NASS,8) * int(NFRONT,8) + int(NPIV,8) + IF ( KEEP( 50 ) .eq. 0 ) THEN + INVERT = .FALSE. + ELSE + INVERT = .TRUE. + END IF + CALL DMUMPS_80( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTLUST_S, PTRAST, + & root, NROW, NCOL, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT, + & ROOT_NON_ELIM_CB, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0 ) RETURN + ENDIF + IOLDPS = PTLUST_S(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) + PTRFAC(STEP(INODE))=POSELT + IF ( TYPE_SON .eq. 1 ) THEN + NBROW = NFRONT - NPIV + ELSE + NBROW = NELIM + END IF + IF ( TYPE_SON .eq. 1 .OR. KEEP(50).EQ.0) THEN + LDA = NFRONT + ELSE + LDA = NPIV+NBROW + ENDIF + CALL DMUMPS_324(A(POSELT), LDA, + & NPIV, NBROW, KEEP(50)) + IW(IOLDPS + KEEP(IXSZ)) = NBCOL + IW(IOLDPS + 1 +KEEP(IXSZ)) = NASS - NPIV + IF (TYPE_SON.EQ.2) THEN + IW(IOLDPS + 2 +KEEP(IXSZ)) = NASS + ELSE + IW(IOLDPS + 2 +KEEP(IXSZ)) = NFRONT + ENDIF + IW(IOLDPS + 3 +KEEP(IXSZ)) = NPIV + CALL DMUMPS_93(0_8,MYID,N,IOLDPS,TYPE_SON,IW,LIW, + & A, LA, POSFAC, LRLU, LRLUS, + & IWPOS, PTRAST,PTRFAC,STEP, KEEP,KEEP8, .FALSE.,INODE,IERR) + IF(IERR.LT.0)THEN + IFLAG=IERR + IERROR=0 + RETURN + ENDIF + ELSE + ISON = INODE + PDEST_MASTER_ISON = + & MUMPS_275(PROCNODE_STEPS(STEP(ISON)), SLAVEF) + DO WHILE ( PTRIST(STEP(ISON)) .EQ. 0) + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & PDEST_MASTER_ISON, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) RETURN + ENDDO + DO WHILE ( + & ( IW( PTRIST(STEP(ISON)) + 1 +KEEP(IXSZ)) .NE. + & IW( PTRIST(STEP(ISON)) + 3 +KEEP(IXSZ)) ) .OR. + & ( KEEP(50) .NE. 0 .AND. + & IW( PTRIST(STEP(ISON)) + 6 +KEEP(IXSZ)) .NE. 0 ) ) + IF ( KEEP(50).eq.0) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO + ELSE + IF ( IW( PTRIST(STEP(ISON)) + 1 +KEEP(IXSZ)) .NE. + & IW( PTRIST(STEP(ISON)) + 3 +KEEP(IXSZ)) ) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO_SYM + ELSE + MSGSOU = MPI_ANY_SOURCE + MSGTAG = BLOC_FACTO_SYM_SLAVE + END IF + END IF + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MSGTAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) RETURN + END DO + IOLDPS = PTRIST(STEP(INODE)) + LCONT = IW(IOLDPS+KEEP(IXSZ)) + NROW = IW(IOLDPS+2+KEEP(IXSZ)) + NPIV = IW(IOLDPS+3+KEEP(IXSZ)) + NASS = IW(IOLDPS+4+KEEP(IXSZ)) + NELIM = NASS-NPIV + IF (NELIM.LE.0) THEN + write(6,*) MYID,': INODE,LCONT, NROW, NPIV, NASS, NELIM=', + & INODE,LCONT, NROW, NPIV, NASS, NELIM + write(6,*) MYID,': IOLDPS=',IOLDPS + write(6,*) MYID,': ERROR 2 in DMUMPS_271 ' + CALL MUMPS_ABORT() + ENDIF + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + H_INODE = 6 + NSLAVES + KEEP(IXSZ) + LIST_NELIM_COL = IOLDPS + H_INODE + NROW + NPIV + NELIM_LOCAL = NELIM_ROOT + DO I = 1, NELIM + root%RG2L_COL(IW(LIST_NELIM_COL)) = NELIM_LOCAL + root%RG2L_ROW(IW(LIST_NELIM_COL)) = NELIM_LOCAL + NELIM_LOCAL = NELIM_LOCAL + 1 + LIST_NELIM_COL = LIST_NELIM_COL + 1 + ENDDO + SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NPIV + NCOL_TO_SEND = NELIM + IF (IW(IOLDPS+XXS).EQ.S_NOLCBNOCONTIG38.OR. + & IW(IOLDPS+XXS).EQ.S_ALL) THEN + SHIFT_VAL_SON = int(NPIV,8) + LDA = LCONT + NPIV + ELSE IF (IW(IOLDPS+XXS).EQ.S_NOLCBCONTIG38) THEN + SHIFT_VAL_SON = int(NROW,8)*int(LCONT+NPIV-NELIM,8) + LDA = NELIM + ELSE IF (IW(IOLDPS+XXS).EQ.S_NOLCLEANED38) THEN + SHIFT_VAL_SON=0_8 + LDA = NELIM + ELSE + write(*,*) MYID,": internal error in DMUMPS_271", + & IW(IOLDPS+XXS), "INODE=",INODE + CALL MUMPS_ABORT() + ENDIF + IF ( KEEP( 50 ) .eq. 0 ) THEN + INVERT = .FALSE. + ELSE + INVERT = .TRUE. + END IF + CALL DMUMPS_80( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTRIST, PTRAST, + & root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA, + & ROOT_NON_ELIM_CB, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0 ) RETURN + IF (KEEP(214).EQ.2) THEN + CALL DMUMPS_314( N, INODE, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, TYPE_SON + & ) + ENDIF + IF (IFLAG.LT.0) THEN + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_271 + SUBROUTINE DMUMPS_221(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IFLAG,IOLDPS,POSELT,UU, SEUIL,KEEP,KEEP8, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & + & PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV,NOFFW + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + DOUBLE PRECISION UU, SEUIL + INTEGER IW(LIW) + INTEGER(8) :: POSELT + INTEGER IOLDPS + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION SWOP + INTEGER XSIZE + INTEGER(8) :: APOS, IDIAG + INTEGER(8) :: J1, J2, J3, JJ + INTEGER(8) :: NFRONT8 + DOUBLE PRECISION AMROW + DOUBLE PRECISION RMAX + DOUBLE PRECISION PIVNUL + DOUBLE PRECISION FIXA, CSEUIL + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,JMAX,J,ISW,ISWPS1 + INTEGER ISWPS2,KSW + INTEGER DMUMPS_IXAMAX + INTRINSIC max + DOUBLE PRECISION, PARAMETER :: RZERO = 0.0D0 + DOUBLE PRECISION, PARAMETER :: ZERO = 0.0D0 + INTEGER I_PIVRPTR_L, I_PIVR_L, NBPANELS_L + INTEGER I_PIVRPTR_U, I_PIVR_U, NBPANELS_U + PIVNUL = DKEEP(1) + FIXA = DKEEP(2) + CSEUIL = SEUIL + XSIZE = KEEP(IXSZ) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NFRONT8 = int(NFRONT,8) + IF (KEEP(201).EQ.1) THEN + CALL DMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + CALL DMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + ENDIF + NASSW = iabs(IW(IOLDPS+3+XSIZE)) + IF(INOPV .EQ. -1) THEN + APOS = POSELT + NFRONT8*int(NPIVP1-1,8) + int(NPIV,8) + IDIAG = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF(dble(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + KEEP(98) = KEEP(98)+1 + ELSE IF (KEEP(258) .NE. 0) THEN + CALL DMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL DMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL DMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + NFRONT8*int(IPIV-1,8) + int(NPIV,8) + JMAX = 1 + IF (UU.GT.RZERO) GO TO 340 + IF (abs(A(APOS)).EQ.RZERO) GO TO 630 + GO TO 380 + 340 AMROW = RZERO + J1 = APOS + J2 = APOS + int(- NPIV + NASS - 1,8) + J = NASS -NPIV + JMAX = DMUMPS_IXAMAX(J,A(J1),1) + JJ = J1 + int(JMAX - 1,8) + AMROW = abs(A(JJ)) + RMAX = AMROW + J1 = J2 + 1_8 + J2 = APOS +int(- NPIV + NFRONT - 1 - KEEP(253),8) + IF (J2.LT.J1) GO TO 370 + DO 360 JJ=J1,J2 + RMAX = max(abs(A(JJ)),RMAX) + 360 CONTINUE + 370 IDIAG = APOS + int(IPIV - NPIVP1,8) + IF ( RMAX .LE. PIVNUL ) THEN + KEEP(109) = KEEP(109)+1 + ISW = IOLDPS+IW(IOLDPS+1+XSIZE)+6+XSIZE+ + & IW(IOLDPS+5+XSIZE)+IPIV-NPIVP1 + PIVNUL_LIST(KEEP(109)) = IW(ISW) + IF(dble(FIXA).GT.RZERO) THEN + IF(dble(A(IDIAG)) .GE. RZERO) THEN + A(IDIAG) = FIXA + ELSE + A(IDIAG) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = APOS + int(- NPIV + NFRONT - 1 - KEEP(253),8) + DO JJ=J1,J2 + A(JJ) = ZERO + ENDDO + A(IDIAG) = -FIXA + ENDIF + JMAX = IPIV - NPIV + GOTO 385 + ENDIF + IF (abs(A(IDIAG)).GT. max(UU*RMAX,SEUIL)) THEN + JMAX = IPIV - NPIV + GO TO 380 + ENDIF + IF (AMROW.LE. max(UU*RMAX,SEUIL)) GO TO 460 + NOFFW = NOFFW + 1 + 380 CONTINUE + IF (KEEP(258) .NE. 0) THEN + CALL DMUMPS_762( + & A( APOS+int(JMAX-1,8) ), + & DKEEP(6), + & KEEP(259) ) + ENDIF + 385 CONTINUE + IF (IPIV.EQ.NPIVP1) GO TO 400 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8)*NFRONT8 + J2 = J1 + NFRONT8 - 1_8 + J3 = POSELT + int(IPIV-1,8)*NFRONT8 + DO 390 JJ=J1,J2 + SWOP = A(JJ) + A(JJ) = A(J3) + A(J3) = SWOP + J3 = J3 + 1_8 + 390 CONTINUE + ISWPS1 = IOLDPS + 5 + NPIVP1 + XSIZE + ISWPS2 = IOLDPS + 5 + IPIV + XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + 400 IF (JMAX.EQ.1) GO TO 420 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8) + J2 = POSELT + int(NPIV + JMAX - 1,8) + DO 410 KSW=1,NFRONT + SWOP = A(J1) + A(J1) = A(J2) + A(J2) = SWOP + J1 = J1 + NFRONT8 + J2 = J2 + NFRONT8 + 410 CONTINUE + ISWPS1 = IOLDPS + 5 + NFRONT + NPIV + 1 +XSIZE + ISWPS2 = IOLDPS + 5 + NFRONT + NPIV + JMAX +XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + GO TO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 430 + 630 CONTINUE + IFLAG = -10 + WRITE(*,*) 'Detected a null pivot, INODE/NPIV=',INODE,NPIV + GOTO 430 + 420 CONTINUE + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL DMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, IPIV, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL DMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIV+JMAX, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + 430 CONTINUE + RETURN + END SUBROUTINE DMUMPS_221 + SUBROUTINE DMUMPS_220(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IOLDPS,POSELT,UU,SEUIL,KEEP, DKEEP, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,INOPV + INTEGER(8) :: LA + INTEGER KEEP(500) + DOUBLE PRECISION DKEEP(30) + DOUBLE PRECISION UU, SEUIL + DOUBLE PRECISION A(LA) + INTEGER IW(LIW) + DOUBLE PRECISION AMROW + DOUBLE PRECISION RMAX + DOUBLE PRECISION SWOP + INTEGER(8) :: APOS, POSELT + INTEGER(8) :: J1, J2, J3_8, JJ, IDIAG + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS + INTEGER NOFFW,NPIV,IPIV + INTEGER J, J3 + INTEGER NPIVP1,JMAX,ISW,ISWPS1 + INTEGER ISWPS2,KSW,XSIZE + INTEGER I_PIVRPTR_L, I_PIVR_L, NBPANELS_L + INTEGER I_PIVRPTR_U, I_PIVR_U, NBPANELS_U + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U + INTEGER DMUMPS_IXAMAX + INCLUDE 'mumps_headers.h' + INTRINSIC max + DOUBLE PRECISION, PARAMETER :: RZERO = 0.0D0 + NFRONT8 = int(NFRONT,8) + INOPV = 0 + XSIZE = KEEP(IXSZ) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL DMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE) + & +KEEP(IXSZ), + & IW, LIW) + CALL DMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + ENDIF + DO 460 IPIV=NPIVP1,NASS + APOS = POSELT + NFRONT8*int(NPIV,8) + int(IPIV-1,8) + JMAX = 1 + AMROW = RZERO + J1 = APOS + J3 = NASS -NPIV + JMAX = DMUMPS_IXAMAX(J3,A(J1),NFRONT) + JJ = J1 + int(JMAX-1,8)*NFRONT8 + AMROW = abs(A(JJ)) + RMAX = AMROW + J1 = APOS + int(NASS-NPIV,8) * NFRONT8 + J3 = NFRONT - NASS - KEEP(253) + IF (J3.EQ.0) GOTO 370 + DO 360 J=1,J3 + RMAX = max(abs(A(J1)),RMAX) + J1 = J1 + NFRONT8 + 360 CONTINUE + 370 IF (RMAX.EQ.RZERO) GO TO 460 + IDIAG = APOS + int(IPIV - NPIVP1,8)*NFRONT8 + IF (abs(A(IDIAG)).GE.max(UU*RMAX,SEUIL)) THEN + JMAX = IPIV - NPIV + GO TO 380 + ENDIF + IF (AMROW.LT.max(UU*RMAX,SEUIL)) GO TO 460 + NOFFW = NOFFW + 1 + 380 CONTINUE + IF (KEEP(258) .NE. 0) THEN + CALL DMUMPS_762( + & A(APOS + int(JMAX - 1,8) * NFRONT8 ), + & DKEEP(6), + & KEEP(259) ) + ENDIF + IF (IPIV.EQ.NPIVP1) GO TO 400 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8) + J3_8 = POSELT + int(IPIV-1,8) + DO 390 J= 1,NFRONT + SWOP = A(J1) + A(J1) = A(J3_8) + A(J3_8) = SWOP + J1 = J1 + NFRONT8 + J3_8 = J3_8 + NFRONT8 + 390 CONTINUE + ISWPS1 = IOLDPS + 5 + NPIVP1 + NFRONT + XSIZE + ISWPS2 = IOLDPS + 5 + IPIV + NFRONT + XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + 400 IF (JMAX.EQ.1) GO TO 420 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8) * NFRONT8 + J2 = POSELT + int(NPIV + JMAX - 1,8) * NFRONT8 + DO 410 KSW=1,NFRONT + SWOP = A(J1) + A(J1) = A(J2) + A(J2) = SWOP + J1 = J1 + 1_8 + J2 = J2 + 1_8 + 410 CONTINUE + ISWPS1 = IOLDPS + 5 + NPIV + 1 + XSIZE + ISWPS2 = IOLDPS + 5 + NPIV + JMAX + XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + GO TO 420 + 460 CONTINUE + INOPV = 1 + GOTO 430 + 420 CONTINUE + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL DMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, NPIV+JMAX, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL DMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, IPIV, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + 430 CONTINUE + RETURN + END SUBROUTINE DMUMPS_220 + SUBROUTINE DMUMPS_225(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB,LKJIB,LKJIT,XSIZE) + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFINB,LKJIB,IBEG_BLOCK + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER IW(LIW) + DOUBLE PRECISION VALPIV + INTEGER(8) :: APOS, POSELT, UUPOS, LPOS + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS + INTEGER LKJIT, XSIZE + DOUBLE PRECISION ONE, ALPHA + INTEGER NPIV,JROW2 + INTEGER NEL2,NPIVP1,KROW,NEL + INCLUDE 'mumps_headers.h' + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + NFRONT8= int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NEL = NFRONT - NPIVP1 + IFINB = 0 + IF (IW(IOLDPS+3+XSIZE).LE.0) THEN + IF (NASS.LT.LKJIT) THEN + IW(IOLDPS+3+XSIZE) = NASS + ELSE + IW(IOLDPS+3+XSIZE) = min0(NASS,LKJIB) + ENDIF + ENDIF + JROW2 = IW(IOLDPS+3+XSIZE) + NEL2 = JROW2 - NPIVP1 + IF (NEL2.EQ.0) THEN + IF (JROW2.EQ.NASS) THEN + IFINB = -1 + ELSE + IFINB = 1 + IW(IOLDPS+3+XSIZE) = min0(JROW2+LKJIB,NASS) + IBEG_BLOCK = NPIVP1+1 + ENDIF + ELSE + APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + VALPIV = ONE/A(APOS) + LPOS = APOS + NFRONT8 + DO 541 KROW = 1,NEL2 + A(LPOS) = A(LPOS)*VALPIV + LPOS = LPOS + NFRONT8 + 541 CONTINUE + LPOS = APOS + NFRONT8 + UUPOS = APOS + 1_8 + CALL dger(NEL,NEL2,ALPHA,A(UUPOS),1,A(LPOS),NFRONT, + & A(LPOS+1_8),NFRONT) + ENDIF + RETURN + END SUBROUTINE DMUMPS_225 + SUBROUTINE DMUMPS_229(NFRONT,N,INODE,IW,LIW,A,LA,IOLDPS, + & POSELT,XSIZE) + IMPLICIT NONE + INTEGER NFRONT,N,INODE,LIW,XSIZE + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER IW(LIW) + DOUBLE PRECISION ALPHA,VALPIV + INTEGER(8) :: APOS, POSELT, UUPOS + INTEGER(8) :: NFRONT8, LPOS, IRWPOS + INTEGER IOLDPS,NPIV,NEL + INTEGER JROW + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION, PARAMETER :: ONE = 1.0D0 + NFRONT8= int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NEL = NFRONT - NPIV - 1 + APOS = POSELT + int(NPIV,8) * NFRONT8 + int(NPIV,8) + IF (NEL.EQ.0) GO TO 650 + VALPIV = ONE/A(APOS) + LPOS = APOS + NFRONT8 + DO 340 JROW = 1,NEL + A(LPOS) = VALPIV*A(LPOS) + LPOS = LPOS + NFRONT8 + 340 CONTINUE + LPOS = APOS + NFRONT8 + UUPOS = APOS+1_8 + DO 440 JROW = 1,NEL + IRWPOS = LPOS + 1_8 + ALPHA = -A(LPOS) + CALL daxpy(NEL,ALPHA,A(UUPOS),1,A(IRWPOS),1) + LPOS = LPOS + NFRONT8 + 440 CONTINUE + 650 RETURN + END SUBROUTINE DMUMPS_229 + SUBROUTINE DMUMPS_228(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB,XSIZE) + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER NFRONT,NASS,N,LIW,INODE,IFINB + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER IW(LIW) + DOUBLE PRECISION ALPHA,VALPIV + INTEGER(8) :: APOS, POSELT, UUPOS, LPOS, IRWPOS + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS,NPIV,KROW, XSIZE + INTEGER NEL,ICOL,NEL2 + INTEGER NPIVP1 + DOUBLE PRECISION, PARAMETER :: ONE = 1.0D0 + NFRONT8=int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NEL = NFRONT - NPIVP1 + NEL2 = NASS - NPIVP1 + IFINB = 0 + IF (NPIVP1.EQ.NASS) IFINB = 1 + APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + VALPIV = ONE/A(APOS) + LPOS = APOS + NFRONT8 + DO 541 KROW = 1,NEL + A(LPOS) = A(LPOS)*VALPIV + LPOS = LPOS + NFRONT8 + 541 CONTINUE + LPOS = APOS + NFRONT8 + UUPOS = APOS + 1_8 + DO 440 ICOL = 1,NEL + IRWPOS = LPOS + 1_8 + ALPHA = -A(LPOS) + CALL daxpy(NEL2,ALPHA,A(UUPOS),1,A(IRWPOS),1) + LPOS = LPOS + NFRONT8 + 440 CONTINUE + RETURN + END SUBROUTINE DMUMPS_228 + SUBROUTINE DMUMPS_231(A,LA,NFRONT, + & NPIV,NASS,POSELT) + IMPLICIT NONE + INTEGER(8) :: LA,POSELT + DOUBLE PRECISION A(LA) + INTEGER NFRONT, NPIV, NASS + INTEGER(8) :: LPOS, LPOS1, LPOS2 + INTEGER NEL1,NEL11 + DOUBLE PRECISION ALPHA, ONE + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + NEL1 = NFRONT - NASS + NEL11 = NFRONT - NPIV + LPOS2 = POSELT + int(NASS,8)*int(NFRONT,8) + CALL dtrsm('L','L','N','N',NPIV,NEL1,ONE,A(POSELT),NFRONT, + & A(LPOS2),NFRONT) + LPOS = LPOS2 + int(NPIV,8) + LPOS1 = POSELT + int(NPIV,8) + CALL dgemm('N','N',NEL11,NEL1,NPIV,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE DMUMPS_231 + SUBROUTINE DMUMPS_642(A,LAFAC,NFRONT, + & NPIV,NASS, IW, LIWFAC, + & MonBloc, TYPEFile, MYID, KEEP8, + & STRAT, IFLAG_OOC, + & LNextPiv2beWritten, UNextPiv2beWritten) + USE DMUMPS_OOC + IMPLICIT NONE + INTEGER NFRONT, NPIV, NASS + INTEGER(8) :: LAFAC + INTEGER LIWFAC, TYPEFile, MYID, IFLAG_OOC, + & LNextPiv2beWritten, UNextPiv2beWritten, STRAT + DOUBLE PRECISION A(LAFAC) + INTEGER IW(LIWFAC) + INTEGER(8) KEEP8(150) + TYPE(IO_BLOCK) :: MonBloc + INTEGER(8) :: LPOS2,LPOS1,LPOS + INTEGER NEL1,NEL11 + DOUBLE PRECISION ALPHA, ONE + LOGICAL LAST_CALL + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + NEL1 = NFRONT - NASS + NEL11 = NFRONT - NPIV + LPOS2 = 1_8 + int(NASS,8) * int(NFRONT,8) + CALL dtrsm('L','L','N','N',NPIV,NEL1,ONE,A(1),NFRONT, + & A(LPOS2),NFRONT) + LAST_CALL=.FALSE. + CALL DMUMPS_688 + & ( STRAT, TYPEFile, + & A, LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW, LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + LPOS = LPOS2 + int(NPIV,8) + LPOS1 = int(1 + NPIV,8) + CALL dgemm('N','N',NEL11,NEL1,NPIV,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE DMUMPS_642 + SUBROUTINE DMUMPS_232(A,LA,NFRONT,NPIV,NASS,POSELT,LKJIB) + INTEGER NFRONT, NPIV, NASS, LKJIB + INTEGER (8) :: POSELT, LA + DOUBLE PRECISION A(LA) + INTEGER(8) :: POSELT_LOCAL, LPOS, LPOS1, LPOS2 + INTEGER NEL1, NEL11, NPBEG + DOUBLE PRECISION ALPHA, ONE + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + POSELT_LOCAL = POSELT + NEL1 = NASS - NPIV + NPBEG = NPIV - LKJIB + 1 + NEL11 = NFRONT - NPIV + LPOS2 = POSELT_LOCAL + int(NPIV,8)*int(NFRONT,8) + & + int(NPBEG - 1,8) + POSELT_LOCAL = POSELT_LOCAL + int(NPBEG-1,8)*int(NFRONT,8) + & + int(NPBEG-1,8) + CALL dtrsm('L','L','N','N',LKJIB,NEL1,ONE,A(POSELT_LOCAL), + & NFRONT,A(LPOS2),NFRONT) + LPOS = LPOS2 + int(LKJIB,8) + LPOS1 = POSELT_LOCAL + int(LKJIB,8) + CALL dgemm('N','N',NEL11,NEL1,LKJIB,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE DMUMPS_232 + SUBROUTINE DMUMPS_233(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,LKJIB_ORIG,LKJIB,LKJIT,XSIZE ) + IMPLICIT NONE + INTEGER NFRONT, NASS,N,LIW + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER IW(LIW) + INTEGER LKJIB_ORIG,LKJIB, INODE, IBEG_BLOCK + INTEGER(8) :: POSELT, LPOS, LPOS1, LPOS2, POSLOCAL + INTEGER(8) :: IPOS, KPOS + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS, NPIV, JROW2, NPBEG + INTEGER NONEL, LKJIW, NEL1, NEL11 + INTEGER LBP, HF + INTEGER LBPT,I1,K1,II,ISWOP,LBP1 + INTEGER LKJIT, XSIZE + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION ALPHA, ONE + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + NFRONT8=int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + JROW2 = iabs(IW(IOLDPS+3+XSIZE)) + NPBEG = IBEG_BLOCK + HF = 6 + IW(IOLDPS+5+XSIZE) +XSIZE + NONEL = JROW2 - NPIV + 1 + IF ((NASS-NPIV).GE.LKJIT) THEN + LKJIB = LKJIB_ORIG + NONEL + IW(IOLDPS+3+XSIZE)= min0(NPIV+LKJIB,NASS) + ELSE + IW(IOLDPS+3+XSIZE) = NASS + ENDIF + IBEG_BLOCK = NPIV + 1 + NEL1 = NASS - JROW2 + LKJIW = NPIV - NPBEG + 1 + NEL11 = NFRONT - NPIV + IF ((NEL1.NE.0).AND.(LKJIW.NE.0)) THEN + LPOS2 = POSELT + int(JROW2,8)*NFRONT8 + + & int(NPBEG - 1,8) + POSLOCAL = POSELT + int(NPBEG-1,8)*NFRONT8 + int(NPBEG - 1,8) + CALL dtrsm('L','L','N','N',LKJIW,NEL1,ONE, + & A(POSLOCAL),NFRONT, + & A(LPOS2),NFRONT) + LPOS = LPOS2 + int(LKJIW,8) + LPOS1 = POSLOCAL + int(LKJIW,8) + CALL dgemm('N','N',NEL11,NEL1,LKJIW,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + ENDIF + RETURN + END SUBROUTINE DMUMPS_233 + SUBROUTINE DMUMPS_236(A,LA,NPIVB,NFRONT, + & NPIV,NASS,POSELT) + IMPLICIT NONE + INTEGER NPIVB,NASS + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER(8) :: APOS, POSELT + INTEGER NFRONT, NPIV, NASSL + INTEGER(8) :: LPOS, LPOS1, LPOS2 + INTEGER NEL1, NEL11, NPIVE + DOUBLE PRECISION ALPHA, ONE + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + NEL1 = NFRONT - NASS + NEL11 = NFRONT - NPIV + NPIVE = NPIV - NPIVB + NASSL = NASS - NPIVB + APOS = POSELT + int(NPIVB,8)*int(NFRONT,8) + & + int(NPIVB,8) + LPOS2 = APOS + int(NASSL,8) + CALL dtrsm('R','U','N','U',NEL1,NPIVE,ONE,A(APOS),NFRONT, + & A(LPOS2),NFRONT) + LPOS = LPOS2 + int(NFRONT,8)*int(NPIVE,8) + LPOS1 = APOS + int(NFRONT,8)*int(NPIVE,8) + CALL dgemm('N','N',NEL1,NEL11,NPIVE,ALPHA,A(LPOS2), + & NFRONT,A(LPOS1),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE DMUMPS_236 + SUBROUTINE DMUMPS_217(N, NZ, NSCA, + & ASPK, IRN, ICN, COLSCA, ROWSCA, WK, LWK, WK_REAL, + & LWK_REAL, ICNTL, INFO) + IMPLICIT NONE + INTEGER N, NZ, NSCA + INTEGER IRN(NZ), ICN(NZ) + INTEGER ICNTL(40), INFO(40) + DOUBLE PRECISION ASPK(NZ) + DOUBLE PRECISION COLSCA(*), ROWSCA(*) + INTEGER LWK, LWK_REAL + DOUBLE PRECISION WK(LWK) + DOUBLE PRECISION WK_REAL(LWK_REAL) + INTEGER MPG,LP + INTEGER IWNOR + INTEGER I, K + LOGICAL PROK + DOUBLE PRECISION ONE + PARAMETER( ONE = 1.0D0 ) + LP = ICNTL(1) + MPG = ICNTL(2) + MPG = ICNTL(3) + PROK = (MPG.GT.0) + IF (PROK) WRITE(MPG,101) + 101 FORMAT(/' ****** SCALING OF ORIGINAL MATRIX '/) + IF (NSCA.EQ.1) THEN + IF (PROK) + & WRITE (MPG,*) ' DIAGONAL SCALING ' + ELSEIF (NSCA.EQ.2) THEN + IF (PROK) + & WRITE (MPG,*) ' SCALING BASED ON (MC29)' + ELSEIF (NSCA.EQ.3) THEN + IF (PROK) + & WRITE (MPG,*) ' COLUMN SCALING' + ELSEIF (NSCA.EQ.4) THEN + IF (PROK) + & WRITE (MPG,*) ' ROW AND COLUMN SCALING (1 Pass)' + ELSEIF (NSCA.EQ.5) THEN + IF (PROK) + & WRITE (MPG,*) ' MC29 FOLLOWED BY ROW &COL SCALING' + ELSEIF (NSCA.EQ.6) THEN + IF (PROK) + & WRITE (MPG,*) ' MC29 FOLLOWED BY COLUMN SCALING' + ENDIF + DO 10 I=1,N + COLSCA(I) = ONE + ROWSCA(I) = ONE + 10 CONTINUE + IF ((NSCA.EQ.5).OR. + & (NSCA.EQ.6)) THEN + IF (NZ.GT.LWK) GOTO 400 + DO 15 K=1,NZ + WK(K) = ASPK(K) + 15 CONTINUE + ENDIF + IF (5*N.GT.LWK_REAL) GOTO 410 + IWNOR = 1 + IF (NSCA.EQ.1) THEN + CALL DMUMPS_238(N,NZ,ASPK,IRN,ICN, + & COLSCA,ROWSCA,MPG) + ELSEIF (NSCA.EQ.2) THEN + CALL DMUMPS_239(N,NZ,ASPK,IRN,ICN, + & ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA) + ELSEIF (NSCA.EQ.3) THEN + CALL DMUMPS_241(N,NZ,ASPK,IRN,ICN,WK_REAL(IWNOR), + & COLSCA, MPG) + ELSEIF (NSCA.EQ.4) THEN + CALL DMUMPS_287(N,NZ,IRN,ICN,ASPK, + & WK_REAL(IWNOR),WK_REAL(IWNOR+N),COLSCA,ROWSCA,MPG) + ELSEIF (NSCA.EQ.5) THEN + CALL DMUMPS_239(N,NZ,WK,IRN,ICN, + & ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA) + CALL DMUMPS_241(N,NZ,WK,IRN,ICN,WK_REAL(IWNOR), + & COLSCA, MPG) + ELSEIF (NSCA.EQ.6) THEN + CALL DMUMPS_239(N,NZ,WK,IRN,ICN, + & ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA) + CALL DMUMPS_240(NSCA,N,NZ,IRN,ICN,WK, + & WK_REAL(IWNOR+N),ROWSCA,MPG) + CALL DMUMPS_241(N,NZ,WK,IRN,ICN, + & WK_REAL(IWNOR), COLSCA, MPG) + ENDIF + GOTO 500 + 400 INFO(1) = -5 + INFO(2) = NZ-LWK + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) + & WRITE(LP,*) '*** ERROR: Not enough space to scale matrix' + GOTO 500 + 410 INFO(1) = -5 + INFO(2) = 5*N-LWK_REAL + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) + & WRITE(LP,*) '*** ERROR: Not enough space to scale matrix' + GOTO 500 + 500 CONTINUE + RETURN + END SUBROUTINE DMUMPS_217 + SUBROUTINE DMUMPS_287(N,NZ,IRN,ICN,VAL, + & RNOR,CNOR,COLSCA,ROWSCA,MPRINT) + INTEGER N, NZ + DOUBLE PRECISION VAL(NZ) + DOUBLE PRECISION RNOR(N),CNOR(N) + DOUBLE PRECISION COLSCA(N),ROWSCA(N) + DOUBLE PRECISION CMIN,CMAX,RMIN,ARNOR,ACNOR + INTEGER IRN(NZ), ICN(NZ) + DOUBLE PRECISION VDIAG + INTEGER MPRINT + INTEGER I,J,K + DOUBLE PRECISION ZERO, ONE + PARAMETER(ZERO=0.0D0, ONE=1.0D0) + DO 50 J=1,N + CNOR(J) = ZERO + RNOR(J) = ZERO + 50 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.LE.0).OR.(I.GT.N).OR. + & (J.LE.0).OR.(J.GT.N)) GOTO 100 + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.CNOR(J)) THEN + CNOR(J) = VDIAG + ENDIF + IF (VDIAG.GT.RNOR(I)) THEN + RNOR(I) = VDIAG + ENDIF + 100 CONTINUE + IF (MPRINT.GT.0) THEN + CMIN = CNOR(1) + CMAX = CNOR(1) + RMIN = RNOR(1) + DO 111 I=1,N + ARNOR = RNOR(I) + ACNOR = CNOR(I) + IF (ACNOR.GT.CMAX) CMAX=ACNOR + IF (ACNOR.LT.CMIN) CMIN=ACNOR + IF (ARNOR.LT.RMIN) RMIN=ARNOR + 111 CONTINUE + WRITE(MPRINT,*) '**** STAT. OF MATRIX PRIOR ROW&COL SCALING' + WRITE(MPRINT,*) ' MAXIMUM NORM-MAX OF COLUMNS:',CMAX + WRITE(MPRINT,*) ' MINIMUM NORM-MAX OF COLUMNS:',CMIN + WRITE(MPRINT,*) ' MINIMUM NORM-MAX OF ROWS :',RMIN + ENDIF + DO 120 J=1,N + IF (CNOR(J).LE.ZERO) THEN + CNOR(J) = ONE + ELSE + CNOR(J) = ONE / CNOR(J) + ENDIF + 120 CONTINUE + DO 130 J=1,N + IF (RNOR(J).LE.ZERO) THEN + RNOR(J) = ONE + ELSE + RNOR(J) = ONE / RNOR(J) + ENDIF + 130 CONTINUE + DO 110 I=1,N + ROWSCA(I) = ROWSCA(I) * RNOR(I) + COLSCA(I) = COLSCA(I) * CNOR(I) + 110 CONTINUE + IF (MPRINT.GT.0) + & WRITE(MPRINT,*) ' END OF SCALING BY MAX IN ROW AND COL' + RETURN + END SUBROUTINE DMUMPS_287 + SUBROUTINE DMUMPS_239(N,NZ,VAL,ROWIND,COLIND, + & RNOR,CNOR,WNOR,MPRINT,MP, + & NSCA) + INTEGER N, NZ + DOUBLE PRECISION VAL(NZ) + DOUBLE PRECISION WNOR(5*N) + DOUBLE PRECISION RNOR(N), CNOR(N) + INTEGER COLIND(NZ),ROWIND(NZ) + INTEGER J,I,K + INTEGER MPRINT,MP,NSCA + INTEGER IFAIL9 + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0) + DO 15 I=1,N + RNOR(I) = ZERO + CNOR(I) = ZERO + 15 CONTINUE + CALL DMUMPS_216(N,N,NZ,VAL,ROWIND,COLIND, + & RNOR,CNOR,WNOR, MP,IFAIL9) +*CVD$ NODEPCHK +*CVD$ VECTOR +*CVD$ CONCUR + DO 30 I=1,N + CNOR(I) = exp(CNOR(I)) + RNOR(I) = exp(RNOR(I)) + 30 CONTINUE + IF ((NSCA.EQ.5).OR.(NSCA.EQ.6)) THEN + DO 100 K=1,NZ + I = ROWIND(K) + J = COLIND(K) + IF (min(I,J).LT.1 .OR. I.GT.N .OR. J.GT.N) GOTO 100 + VAL(K) = VAL(K) * CNOR(J) * RNOR(I) + 100 CONTINUE + ENDIF + IF (MPRINT.GT.0) + & WRITE(MPRINT,*) ' END OF SCALING USING MC29' + RETURN + END SUBROUTINE DMUMPS_239 + SUBROUTINE DMUMPS_241(N,NZ,VAL,IRN,ICN, + & CNOR,COLSCA,MPRINT) + INTEGER N,NZ + DOUBLE PRECISION VAL(NZ) + DOUBLE PRECISION CNOR(N) + DOUBLE PRECISION COLSCA(N) + INTEGER IRN(NZ), ICN(NZ) + DOUBLE PRECISION VDIAG + INTEGER MPRINT + INTEGER I,J,K + DOUBLE PRECISION ZERO, ONE + PARAMETER (ZERO=0.0D0,ONE=1.0D0) + DO 10 J=1,N + CNOR(J) = ZERO + 10 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.LE.0).OR.(I.GT.N).OR. + & (J.LE.0).OR.(J.GT.N)) GOTO 100 + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.CNOR(J)) THEN + CNOR(J) = VDIAG + ENDIF + 100 CONTINUE + DO 110 J=1,N + IF (CNOR(J).LE.ZERO) THEN + CNOR(J) = ONE + ELSE + CNOR(J) = ONE/CNOR(J) + ENDIF + 110 CONTINUE + DO 215 I=1,N + COLSCA(I) = COLSCA(I) * CNOR(I) + 215 CONTINUE + IF (MPRINT.GT.0) WRITE(MPRINT,*) ' END OF COLUMN SCALING' + RETURN + END SUBROUTINE DMUMPS_241 + SUBROUTINE DMUMPS_238(N,NZ,VAL,IRN,ICN, + & COLSCA,ROWSCA,MPRINT) + INTEGER N, NZ + DOUBLE PRECISION VAL(NZ) + DOUBLE PRECISION ROWSCA(N),COLSCA(N) + INTEGER IRN(NZ),ICN(NZ) + DOUBLE PRECISION VDIAG + INTEGER MPRINT,I,J,K + INTRINSIC sqrt + DOUBLE PRECISION ZERO, ONE + PARAMETER(ZERO=0.0D0, ONE=1.0D0) + DO 10 I=1,N + ROWSCA(I) = ONE + 10 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + IF ((I.GT.N).OR.(I.LE.0)) GOTO 100 + J = ICN(K) + IF (I.EQ.J) THEN + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.ZERO) THEN + ROWSCA(J) = ONE/(sqrt(VDIAG)) + ENDIF + ENDIF + 100 CONTINUE + DO 110 I=1,N + COLSCA(I) = ROWSCA(I) + 110 CONTINUE + IF (MPRINT.GT.0) WRITE(MPRINT,*) ' END OF DIAGONAL SCALING' + RETURN + END SUBROUTINE DMUMPS_238 + SUBROUTINE DMUMPS_240(NSCA,N,NZ,IRN,ICN,VAL, + & RNOR,ROWSCA,MPRINT) + INTEGER N, NZ, NSCA + INTEGER IRN(NZ), ICN(NZ) + DOUBLE PRECISION VAL(NZ) + DOUBLE PRECISION RNOR(N) + DOUBLE PRECISION ROWSCA(N) + DOUBLE PRECISION VDIAG + INTEGER MPRINT + INTEGER I,J,K + DOUBLE PRECISION ZERO,ONE + PARAMETER (ZERO=0.0D0, ONE=1.0D0) + DO 50 J=1,N + RNOR(J) = ZERO + 50 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.LE.0).OR.(I.GT.N).OR. + & (J.LE.0).OR.(J.GT.N)) GOTO 100 + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.RNOR(I)) THEN + RNOR(I) = VDIAG + ENDIF + 100 CONTINUE + DO 130 J=1,N + IF (RNOR(J).LE.ZERO) THEN + RNOR(J) = ONE + ELSE + RNOR(J) = ONE/RNOR(J) + ENDIF + 130 CONTINUE + DO 110 I=1,N + ROWSCA(I) = ROWSCA(I)* RNOR(I) + 110 CONTINUE + IF ( (NSCA.EQ.4) .OR. (NSCA.EQ.6) ) THEN + DO 150 K=1,NZ + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.N .OR. J.GT.N) GOTO 150 + VAL(K) = VAL(K) * RNOR(I) + 150 CONTINUE + ENDIF + IF (MPRINT.GT.0) + & WRITE(MPRINT,'(A)') ' END OF ROW SCALING' + RETURN + END SUBROUTINE DMUMPS_240 + SUBROUTINE DMUMPS_216(M,N,NE,A,IRN,ICN,R,C,W,LP,IFAIL) + INTEGER M,N,NE + DOUBLE PRECISION A(NE) + INTEGER IRN(NE),ICN(NE) + DOUBLE PRECISION R(M),C(N) + DOUBLE PRECISION W(M*2+N*3) + INTEGER LP,IFAIL + INTRINSIC log,abs,min + INTEGER MAXIT + PARAMETER (MAXIT=100) + DOUBLE PRECISION ONE + DOUBLE PRECISION SMIN,ZERO + PARAMETER (ONE=1.0D0,SMIN=0.1D0,ZERO=0.0D0) + INTEGER I,I1,I2,I3,I4,I5,ITER,J,K + DOUBLE PRECISION E,E1,EM,Q,Q1,QM,S,S1,SM,U,V + IFAIL = 0 + IF (M.LT.1 .OR. N.LT.1) THEN + IFAIL = -1 + GO TO 220 + ELSE IF (NE.LE.0) THEN + IFAIL = -2 + GO TO 220 + END IF + I1 = 0 + I2 = M + I3 = M + N + I4 = M + N*2 + I5 = M + N*3 + DO 10 I = 1,M + R(I) = ZERO + W(I1+I) = ZERO + 10 CONTINUE + DO 20 J = 1,N + C(J) = ZERO + W(I2+J) = ZERO + W(I3+J) = ZERO + W(I4+J) = ZERO + 20 CONTINUE + DO 30 K = 1,NE + U = abs(A(K)) + IF (U.EQ.ZERO) GO TO 30 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 30 + U = log(U) + W(I1+I) = W(I1+I) + ONE + W(I2+J) = W(I2+J) + ONE + R(I) = R(I) + U + W(I3+J) = W(I3+J) + U + 30 CONTINUE + DO 40 I = 1,M + IF (W(I1+I).EQ.ZERO) W(I1+I) = ONE + R(I) = R(I)/W(I1+I) + W(I5+I) = R(I) + 40 CONTINUE + DO 50 J = 1,N + IF (W(I2+J).EQ.ZERO) W(I2+J) = ONE + W(I3+J) = W(I3+J)/W(I2+J) + 50 CONTINUE + SM = SMIN*dble(NE) + DO 60 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 60 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 60 + R(I) = R(I) - W(I3+J)/W(I1+I) + 60 CONTINUE + E = ZERO + Q = ONE + S = ZERO + DO 70 I = 1,M + S = S + W(I1+I)*R(I)**2 + 70 CONTINUE + IF (abs(S).LE.abs(SM)) GO TO 160 + DO 150 ITER = 1,MAXIT + DO 80 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 80 + J = ICN(K) + I = IRN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 80 + C(J) = C(J) + R(I) + 80 CONTINUE + S1 = S + S = ZERO + DO 90 J = 1,N + V = -C(J)/Q + C(J) = V/W(I2+J) + S = S + V*C(J) + 90 CONTINUE + E1 = E + E = Q*S/S1 + Q = ONE - E + IF (abs(S).LE.abs(SM)) E = ZERO + DO 100 I = 1,M + R(I) = R(I)*E*W(I1+I) + 100 CONTINUE + IF (abs(S).LE.abs(SM)) GO TO 180 + EM = E*E1 + DO 110 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 110 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 110 + R(I) = R(I) + C(J) + 110 CONTINUE + S1 = S + S = ZERO + DO 120 I = 1,M + V = -R(I)/Q + R(I) = V/W(I1+I) + S = S + V*R(I) + 120 CONTINUE + E1 = E + E = Q*S/S1 + Q1 = Q + Q = ONE - E + IF (abs(S).LE.abs(SM)) Q = ONE + QM = Q*Q1 + DO 130 J = 1,N + W(I4+J) = (EM*W(I4+J)+C(J))/QM + W(I3+J) = W(I3+J) + W(I4+J) + 130 CONTINUE + IF (abs(S).LE.abs(SM)) GO TO 160 + DO 140 J = 1,N + C(J) = C(J)*E*W(I2+J) + 140 CONTINUE + 150 CONTINUE + 160 DO 170 I = 1,M + R(I) = R(I)*W(I1+I) + 170 CONTINUE + 180 DO 190 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 190 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 190 + R(I) = R(I) + W(I3+J) + 190 CONTINUE + DO 200 I = 1,M + R(I) = R(I)/W(I1+I) - W(I5+I) + 200 CONTINUE + DO 210 J = 1,N + C(J) = -W(I3+J) + 210 CONTINUE + RETURN + 220 IF (LP.GT.0) WRITE (LP,'(/A/A,I3)') + & ' **** Error return from DMUMPS_216 ****',' IFAIL =',IFAIL + END SUBROUTINE DMUMPS_216 + SUBROUTINE DMUMPS_27( id, ANORMINF, LSCAL ) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MASTER, IERR + PARAMETER( MASTER = 0 ) + TYPE(DMUMPS_STRUC), TARGET :: id + DOUBLE PRECISION, INTENT(OUT) :: ANORMINF + LOGICAL :: LSCAL + INTEGER, DIMENSION (:), POINTER :: KEEP,INFO + INTEGER(8), DIMENSION (:), POINTER :: KEEP8 + LOGICAL :: I_AM_SLAVE + DOUBLE PRECISION DUMMY(1) + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0) + DOUBLE PRECISION, ALLOCATABLE :: SUMR(:), SUMR_LOC(:) + INTEGER :: allocok, MTYPE, I + INFO =>id%INFO + KEEP =>id%KEEP + KEEP8 =>id%KEEP8 + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & KEEP(46) .eq. 1 ) ) + IF (id%MYID .EQ. MASTER) THEN + ALLOCATE( SUMR( id%N ), stat =allocok ) + IF (allocok .GT.0 ) THEN + id%INFO(1)=-13 + id%INFO(2)=id%N + RETURN + ENDIF + ENDIF + IF ( KEEP(54) .eq. 0 ) THEN + IF (id%MYID .EQ. MASTER) THEN + IF (KEEP(55).EQ.0) THEN + IF (.NOT.LSCAL) THEN + CALL DMUMPS_207(id%A(1), + & id%NZ, id%N, + & id%IRN(1), id%JCN(1), + & SUMR, KEEP(1),KEEP8(1) ) + ELSE + CALL DMUMPS_289(id%A(1), + & id%NZ, id%N, + & id%IRN(1), id%JCN(1), + & SUMR, KEEP(1), KEEP8(1), + & id%COLSCA(1)) + ENDIF + ELSE + MTYPE = 1 + IF (.NOT.LSCAL) THEN + CALL DMUMPS_119(MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & SUMR, KEEP(1),KEEP8(1) ) + ELSE + CALL DMUMPS_135(MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & SUMR, KEEP(1),KEEP8(1), id%COLSCA(1)) + ENDIF + ENDIF + ENDIF + ELSE + ALLOCATE( SUMR_LOC( id%N ), stat =allocok ) + IF (allocok .GT.0 ) THEN + id%INFO(1)=-13 + id%INFO(2)=id%N + RETURN + ENDIF + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + IF (.NOT.LSCAL) THEN + CALL DMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & SUMR_LOC, id%KEEP(1),id%KEEP8(1) ) + ELSE + CALL DMUMPS_289(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & SUMR_LOC, id%KEEP(1),id%KEEP8(1), + & id%COLSCA(1)) + ENDIF + ELSE + SUMR_LOC = ZERO + ENDIF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( SUMR_LOC, SUMR, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( SUMR_LOC, DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + DEALLOCATE (SUMR_LOC) + ENDIF + IF ( id%MYID .eq. MASTER ) THEN + ANORMINF = dble(ZERO) + IF (LSCAL) THEN + DO I = 1, id%N + ANORMINF = max(abs(id%ROWSCA(I) * SUMR(I)), + & ANORMINF) + ENDDO + ELSE + DO I = 1, id%N + ANORMINF = max(abs(SUMR(I)), + & ANORMINF) + ENDDO + ENDIF + ENDIF + CALL MPI_BCAST(ANORMINF, 1, + & MPI_DOUBLE_PRECISION, MASTER, + & id%COMM, IERR ) + IF (id%MYID .eq. MASTER) DEALLOCATE (SUMR) + RETURN + END SUBROUTINE DMUMPS_27 + SUBROUTINE DMUMPS_693(IRN_loc, JCN_loc, A_loc, NZ_loc, + & M, N, NUMPROCS, MYID, COMM, + & RPARTVEC, CPARTVEC, + & RSNDRCVSZ, CSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, COLSCA, WRKRC, ISZWRKRC, + & SYM, NB1, NB2, NB3, EPS, + & ONENORMERR,INFNORMERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER NZ_loc, M, N, IWRKSZ, OP + INTEGER NUMPROCS, MYID, COMM + INTEGER INTSZ, RESZ + INTEGER IRN_loc(NZ_loc) + INTEGER JCN_loc(NZ_loc) + DOUBLE PRECISION A_loc(NZ_loc) + INTEGER RPARTVEC(M), RSNDRCVSZ(2*NUMPROCS) + INTEGER CPARTVEC(N), CSNDRCVSZ(2*NUMPROCS) + INTEGER IWRK(IWRKSZ) + INTEGER REGISTRE(12) + DOUBLE PRECISION ROWSCA(M) + DOUBLE PRECISION COLSCA(N) + INTEGER ISZWRKRC + DOUBLE PRECISION WRKRC(ISZWRKRC) + DOUBLE PRECISION ONENORMERR,INFNORMERR + INTEGER SYM, NB1, NB2, NB3 + DOUBLE PRECISION EPS + EXTERNAL DMUMPS_694,DMUMPS_687, + & DMUMPS_670 + INTEGER I + IF(SYM.EQ.0) THEN + CALL DMUMPS_694(IRN_loc, JCN_loc, A_loc, NZ_loc, + & M, N, NUMPROCS, MYID, COMM, + & RPARTVEC, CPARTVEC, + & RSNDRCVSZ, CSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, COLSCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + ELSE + CALL DMUMPS_687(IRN_loc, JCN_loc, A_loc, NZ_loc, + & N, NUMPROCS, MYID, COMM, + & RPARTVEC, + & RSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + DO I=1,N + COLSCA(I) = ROWSCA(I) + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_693 + SUBROUTINE DMUMPS_694(IRN_loc, JCN_loc, A_loc, NZ_loc, + & M, N, NUMPROCS, MYID, COMM, + & RPARTVEC, CPARTVEC, + & RSNDRCVSZ, CSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, COLSCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER NZ_loc, M, N, IWRKSZ, OP + INTEGER NUMPROCS, MYID, COMM + INTEGER INTSZ, RESZ + INTEGER IRN_loc(NZ_loc) + INTEGER JCN_loc(NZ_loc) + DOUBLE PRECISION A_loc(NZ_loc) + INTEGER RPARTVEC(M), RSNDRCVSZ(2*NUMPROCS) + INTEGER CPARTVEC(N), CSNDRCVSZ(2*NUMPROCS) + INTEGER IWRK(IWRKSZ) + INTEGER REGISTRE(12) + DOUBLE PRECISION ROWSCA(M) + DOUBLE PRECISION COLSCA(N) + INTEGER ISZWRKRC + DOUBLE PRECISION WRKRC(ISZWRKRC) + DOUBLE PRECISION ONENORMERR,INFNORMERR + INTEGER IRSNDRCVNUM, ORSNDRCVNUM + INTEGER IRSNDRCVVOL, ORSNDRCVVOL + INTEGER ICSNDRCVNUM, OCSNDRCVNUM + INTEGER ICSNDRCVVOL, OCSNDRCVVOL + INTEGER INUMMYR, INUMMYC + INTEGER IMYRPTR,IMYCPTR + INTEGER IRNGHBPRCS, IRSNDRCVIA,IRSNDRCVJA + INTEGER ORNGHBPRCS, ORSNDRCVIA,ORSNDRCVJA + INTEGER ICNGHBPRCS, ICSNDRCVIA,ICSNDRCVJA + INTEGER OCNGHBPRCS, OCSNDRCVIA,OCSNDRCVJA + INTEGER ISTATUS, REQUESTS, TMPWORK + INTEGER ITDRPTR, ITDCPTR, ISRRPTR + INTEGER OSRRPTR, ISRCPTR, OSRCPTR + INTEGER NB1, NB2, NB3 + DOUBLE PRECISION EPS + INTEGER ITER, NZIND, IR, IC + DOUBLE PRECISION ELM + INTEGER TAG_COMM_COL + PARAMETER(TAG_COMM_COL=100) + INTEGER TAG_COMM_ROW + PARAMETER(TAG_COMM_ROW=101) + INTEGER TAG_ITERS + PARAMETER(TAG_ITERS=102) + EXTERNAL DMUMPS_654, + & DMUMPS_672, + & DMUMPS_674, + & DMUMPS_662, + & DMUMPS_743, + & DMUMPS_745, + & DMUMPS_660, + & DMUMPS_670, + & DMUMPS_671, + & DMUMPS_657, + & DMUMPS_656 + INTEGER DMUMPS_743 + INTEGER DMUMPS_745 + DOUBLE PRECISION DMUMPS_737 + DOUBLE PRECISION DMUMPS_738 + INTRINSIC abs + DOUBLE PRECISION RONE, RZERO + PARAMETER(RONE=1.0D0,RZERO=0.0D0) + INTEGER RESZR, RESZC + INTEGER INTSZR, INTSZC + INTEGER MAXMN + INTEGER I, IERROR + DOUBLE PRECISION ONEERRROW, ONEERRCOL, ONEERRL, ONEERRG + DOUBLE PRECISION INFERRROW, INFERRCOL, INFERRL, INFERRG + INTEGER OORANGEIND + INFERRG = -RONE + ONEERRG = -RONE + OORANGEIND = 0 + MAXMN = M + IF(MAXMN < N) MAXMN = N + IF(OP == 1) THEN + IF(NUMPROCS > 1) THEN + CALL DMUMPS_654(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & RPARTVEC, M, N, + & IWRK, IWRKSZ) + CALL DMUMPS_654(MYID, NUMPROCS, COMM, + & JCN_loc, IRN_loc, NZ_loc, + & CPARTVEC, N, M, + & IWRK, IWRKSZ) + CALL DMUMPS_672(MYID, NUMPROCS, M, RPARTVEC, + & NZ_loc, IRN_loc, N, JCN_loc, + & IRSNDRCVNUM,IRSNDRCVVOL, + & ORSNDRCVNUM,ORSNDRCVVOL, + & IWRK,IWRKSZ, + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), COMM) + CALL DMUMPS_672(MYID, NUMPROCS, N, CPARTVEC, + & NZ_loc, JCN_loc, M, IRN_loc, + & ICSNDRCVNUM,ICSNDRCVVOL, + & OCSNDRCVNUM,OCSNDRCVVOL, + & IWRK,IWRKSZ, + & CSNDRCVSZ(1), CSNDRCVSZ(1+NUMPROCS), COMM) + CALL DMUMPS_662(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & RPARTVEC, CPARTVEC, M, N, + & INUMMYR, + & INUMMYC, + & IWRK, IWRKSZ) + INTSZR = IRSNDRCVNUM + ORSNDRCVNUM + + & IRSNDRCVVOL + ORSNDRCVVOL + + & 2*(NUMPROCS+1) + INUMMYR + INTSZC = ICSNDRCVNUM + OCSNDRCVNUM + + & ICSNDRCVVOL + OCSNDRCVVOL + + & 2*(NUMPROCS+1) + INUMMYC + INTSZ = INTSZR + INTSZC + MAXMN + + & (MPI_STATUS_SIZE +1) * NUMPROCS + ELSE + IRSNDRCVNUM = 0 + ORSNDRCVNUM = 0 + IRSNDRCVVOL = 0 + ORSNDRCVVOL = 0 + INUMMYR = 0 + ICSNDRCVNUM = 0 + OCSNDRCVNUM = 0 + ICSNDRCVVOL = 0 + OCSNDRCVVOL = 0 + INUMMYC = 0 + INTSZ = 0 + ENDIF + RESZR = M + IRSNDRCVVOL + ORSNDRCVVOL + RESZC = N + ICSNDRCVVOL + OCSNDRCVVOL + RESZ = RESZR + RESZC + REGISTRE(1) = IRSNDRCVNUM + REGISTRE(2) = ORSNDRCVNUM + REGISTRE(3) = IRSNDRCVVOL + REGISTRE(4) = ORSNDRCVVOL + REGISTRE(5) = ICSNDRCVNUM + REGISTRE(6) = OCSNDRCVNUM + REGISTRE(7) = ICSNDRCVVOL + REGISTRE(8) = OCSNDRCVVOL + REGISTRE(9) = INUMMYR + REGISTRE(10) = INUMMYC + REGISTRE(11) = INTSZ + REGISTRE(12) = RESZ + ELSE + IRSNDRCVNUM = REGISTRE(1) + ORSNDRCVNUM = REGISTRE(2) + IRSNDRCVVOL = REGISTRE(3) + ORSNDRCVVOL = REGISTRE(4) + ICSNDRCVNUM = REGISTRE(5) + OCSNDRCVNUM = REGISTRE(6) + ICSNDRCVVOL = REGISTRE(7) + OCSNDRCVVOL = REGISTRE(8) + INUMMYR = REGISTRE(9) + INUMMYC = REGISTRE(10) + IF(NUMPROCS > 1) THEN + CALL DMUMPS_660(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & RPARTVEC, CPARTVEC, M, N, + & IWRK(1), INUMMYR, + & IWRK(1+INUMMYR), INUMMYC, + & IWRK(1+INUMMYR+INUMMYC), IWRKSZ-INUMMYR-INUMMYC ) + IMYRPTR = 1 + IMYCPTR = IMYRPTR + INUMMYR + IRNGHBPRCS = IMYCPTR+ INUMMYC + IRSNDRCVIA = IRNGHBPRCS+IRSNDRCVNUM + IRSNDRCVJA = IRSNDRCVIA + NUMPROCS+1 + ORNGHBPRCS = IRSNDRCVJA + IRSNDRCVVOL + ORSNDRCVIA = ORNGHBPRCS + ORSNDRCVNUM + ORSNDRCVJA = ORSNDRCVIA + NUMPROCS + 1 + ICNGHBPRCS = ORSNDRCVJA + ORSNDRCVVOL + ICSNDRCVIA = ICNGHBPRCS + ICSNDRCVNUM + ICSNDRCVJA = ICSNDRCVIA + NUMPROCS+1 + OCNGHBPRCS = ICSNDRCVJA + ICSNDRCVVOL + OCSNDRCVIA = OCNGHBPRCS + OCSNDRCVNUM + OCSNDRCVJA = OCSNDRCVIA + NUMPROCS + 1 + REQUESTS = OCSNDRCVJA + OCSNDRCVVOL + ISTATUS = REQUESTS + NUMPROCS + TMPWORK = ISTATUS + MPI_STATUS_SIZE * NUMPROCS + CALL DMUMPS_674(MYID, NUMPROCS, M, RPARTVEC, + & NZ_loc, IRN_loc,N, JCN_loc, + & IRSNDRCVNUM, IRSNDRCVVOL, + & IWRK(IRNGHBPRCS),IWRK(IRSNDRCVIA),IWRK(IRSNDRCVJA), + & ORSNDRCVNUM, ORSNDRCVVOL, + & IWRK(ORNGHBPRCS),IWRK(ORSNDRCVIA),IWRK(ORSNDRCVJA), + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), + & IWRK(TMPWORK), + & IWRK(ISTATUS), IWRK(REQUESTS), + & TAG_COMM_ROW, COMM) + CALL DMUMPS_674(MYID, NUMPROCS, N, CPARTVEC, + & NZ_loc, JCN_loc, M, IRN_loc, + & ICSNDRCVNUM, ICSNDRCVVOL, + & IWRK(ICNGHBPRCS), + & IWRK(ICSNDRCVIA), + & IWRK(ICSNDRCVJA), + & OCSNDRCVNUM, OCSNDRCVVOL, + & IWRK(OCNGHBPRCS),IWRK(OCSNDRCVIA),IWRK(OCSNDRCVJA), + & CSNDRCVSZ(1), CSNDRCVSZ(1+NUMPROCS), + & IWRK(TMPWORK), + & IWRK(ISTATUS), IWRK(REQUESTS), + & TAG_COMM_COL, COMM) + CALL DMUMPS_670(ROWSCA, M, RZERO) + CALL DMUMPS_670(COLSCA, N, RZERO) + CALL DMUMPS_671(ROWSCA, M, + & IWRK(IMYRPTR),INUMMYR, RONE) + CALL DMUMPS_671(COLSCA, N, + & IWRK(IMYCPTR),INUMMYC, RONE) + ELSE + CALL DMUMPS_670(ROWSCA, M, RONE) + CALL DMUMPS_670(COLSCA, N, RONE) + ENDIF + ITDRPTR = 1 + ITDCPTR = ITDRPTR + M + ISRRPTR = ITDCPTR + N + OSRRPTR = ISRRPTR + IRSNDRCVVOL + ISRCPTR = OSRRPTR + ORSNDRCVVOL + OSRCPTR = ISRCPTR + ICSNDRCVVOL + IF(NUMPROCS == 1)THEN + OSRCPTR = OSRCPTR - 1 + ISRCPTR = ISRCPTR - 1 + OSRRPTR = OSRRPTR - 1 + ISRRPTR = ISRRPTR - 1 + ELSE + IF(IRSNDRCVVOL == 0) ISRRPTR = ISRRPTR - 1 + IF(ORSNDRCVVOL == 0) OSRRPTR = OSRRPTR - 1 + IF(ICSNDRCVVOL == 0) ISRCPTR = ISRCPTR - 1 + IF(OCSNDRCVVOL == 0) OSRCPTR = OSRCPTR - 1 + ENDIF + ITER = 1 + DO WHILE (ITER.LE.NB1+NB2+NB3) + IF(NUMPROCS > 1) THEN + CALL DMUMPS_650(WRKRC(ITDRPTR),M, + & IWRK(IMYRPTR),INUMMYR) + CALL DMUMPS_650(WRKRC(ITDCPTR),N, + & IWRK(IMYCPTR),INUMMYC) + ELSE + CALL DMUMPS_670(WRKRC(ITDRPTR),M, RZERO) + CALL DMUMPS_670(WRKRC(ITDCPTR),N, RZERO) + ENDIF + IF((ITER.LE.NB1).OR.(ITER > NB1+NB2)) THEN + IF((ITER.EQ.1).OR.(OORANGEIND.EQ.1)) THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*ROWSCA(IR)*COLSCA(IC) + IF(WRKRC(ITDRPTR-1+IR) 1) THEN + CALL DMUMPS_657(MYID, NUMPROCS, + & WRKRC(ITDCPTR), N, TAG_ITERS+ITER, + & ICSNDRCVNUM,IWRK(ICNGHBPRCS), + & ICSNDRCVVOL,IWRK(ICSNDRCVIA), IWRK(ICSNDRCVJA), + & WRKRC(ISRCPTR), + & OCSNDRCVNUM,IWRK(OCNGHBPRCS), + & OCSNDRCVVOL,IWRK(OCSNDRCVIA), IWRK(OCSNDRCVJA), + & WRKRC( OSRCPTR), + & IWRK(ISTATUS),IWRK(REQUESTS), + & COMM) + CALL DMUMPS_657(MYID, NUMPROCS, + & WRKRC(ITDRPTR), M, TAG_ITERS+2+ITER, + & IRSNDRCVNUM,IWRK(IRNGHBPRCS), + & IRSNDRCVVOL,IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM,IWRK(ORNGHBPRCS), + & ORSNDRCVVOL,IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS),IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRROW = DMUMPS_737(ROWSCA, + & WRKRC(ITDRPTR), M, + & IWRK(IMYRPTR),INUMMYR) + INFERRCOL = DMUMPS_737(COLSCA, + & WRKRC(ITDCPTR), N, + & IWRK(IMYCPTR),INUMMYC) + INFERRL = INFERRCOL + IF(INFERRROW > INFERRL ) THEN + INFERRL = INFERRROW + ENDIF + CALL MPI_ALLREDUCE(INFERRL, INFERRG, + & 1, MPI_DOUBLE_PRECISION, + & MPI_MAX, COMM, IERROR) + IF(INFERRG.LE.EPS) THEN + CALL DMUMPS_665(COLSCA, WRKRC(ITDCPTR), + & N, + & IWRK(IMYCPTR),INUMMYC) + CALL DMUMPS_665(ROWSCA, WRKRC(ITDRPTR), + & M, + & IWRK(IMYRPTR),INUMMYR) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRROW = DMUMPS_738(ROWSCA, + & WRKRC(ITDRPTR), M) + INFERRCOL = DMUMPS_738(COLSCA, + & WRKRC(ITDCPTR), N) + INFERRL = INFERRCOL + IF(INFERRROW > INFERRL) THEN + INFERRL = INFERRROW + ENDIF + INFERRG = INFERRL + IF(INFERRG.LE.EPS) THEN + CALL DMUMPS_666(COLSCA, WRKRC(ITDCPTR), N) + CALL DMUMPS_666(ROWSCA, WRKRC(ITDRPTR), M) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + IF((ITER .EQ.1).OR.(OORANGEIND.EQ.1))THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*ROWSCA(IR)*COLSCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + WRKRC(ITDCPTR-1+IC) = WRKRC(ITDCPTR-1+IC) + ELM + ELSE + OORANGEIND = 1 + ENDIF + ENDDO + ELSEIF(OORANGEIND.EQ.0) THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + ELM = abs(A_loc(NZIND))*ROWSCA(IR)*COLSCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + WRKRC(ITDCPTR-1+IC) = WRKRC(ITDCPTR-1+IC) + ELM + ENDDO + ENDIF + IF(NUMPROCS > 1) THEN + CALL DMUMPS_656(MYID, NUMPROCS, + & WRKRC(ITDCPTR), N, TAG_ITERS+ITER, + & ICSNDRCVNUM, IWRK(ICNGHBPRCS), + & ICSNDRCVVOL, IWRK(ICSNDRCVIA), IWRK(ICSNDRCVJA), + & WRKRC(ISRCPTR), + & OCSNDRCVNUM, IWRK(OCNGHBPRCS), + & OCSNDRCVVOL, IWRK(OCSNDRCVIA), IWRK(OCSNDRCVJA), + & WRKRC( OSRCPTR), + & IWRK(ISTATUS), IWRK(REQUESTS), + & COMM) + CALL DMUMPS_656(MYID, NUMPROCS, + & WRKRC(ITDRPTR), M, TAG_ITERS+2+ITER, + & IRSNDRCVNUM, IWRK(IRNGHBPRCS), + & IRSNDRCVVOL, IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM, IWRK(ORNGHBPRCS), + & ORSNDRCVVOL, IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS), IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRROW = DMUMPS_737(ROWSCA, + & WRKRC(ITDRPTR), M, + & IWRK(IMYRPTR),INUMMYR) + ONEERRCOL = DMUMPS_737(COLSCA, + & WRKRC(ITDCPTR), N, + & IWRK(IMYCPTR),INUMMYC) + ONEERRL = ONEERRCOL + IF(ONEERRROW > ONEERRL ) THEN + ONEERRL = ONEERRROW + ENDIF + CALL MPI_ALLREDUCE(ONEERRL, ONEERRG, + & 1, MPI_DOUBLE_PRECISION, + & MPI_MAX, COMM, IERROR) + IF(ONEERRG.LE.EPS) THEN + CALL DMUMPS_665(COLSCA, WRKRC(ITDCPTR), + & N, + & IWRK(IMYCPTR),INUMMYC) + CALL DMUMPS_665(ROWSCA, WRKRC(ITDRPTR), + & M, + & IWRK(IMYRPTR),INUMMYR) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRROW = DMUMPS_738(ROWSCA, + & WRKRC(ITDRPTR), M) + ONEERRCOL = DMUMPS_738(COLSCA, + & WRKRC(ITDCPTR), N) + ONEERRL = ONEERRCOL + IF(ONEERRROW > ONEERRL) THEN + ONEERRL = ONEERRROW + ENDIF + ONEERRG = ONEERRL + IF(ONEERRG.LE.EPS) THEN + CALL DMUMPS_666(COLSCA, WRKRC(ITDCPTR), N) + CALL DMUMPS_666(ROWSCA, WRKRC(ITDRPTR), M) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ENDIF + ENDIF + IF(NUMPROCS > 1) THEN + CALL DMUMPS_665(COLSCA, WRKRC(ITDCPTR), N, + & IWRK(IMYCPTR),INUMMYC) + CALL DMUMPS_665(ROWSCA, WRKRC(ITDRPTR), M, + & IWRK(IMYRPTR),INUMMYR) + ELSE + CALL DMUMPS_666(COLSCA, WRKRC(ITDCPTR), N) + CALL DMUMPS_666(ROWSCA, WRKRC(ITDRPTR), M) + ENDIF + ITER = ITER + 1 + ENDDO + ONENORMERR = ONEERRG + INFNORMERR = INFERRG + IF(NUMPROCS > 1) THEN + CALL MPI_REDUCE(ROWSCA, WRKRC(1), M, MPI_DOUBLE_PRECISION, + & MPI_MAX, 0, + & COMM, IERROR) + IF(MYID.EQ.0) THEN + DO I=1, M + ROWSCA(I) = WRKRC(I) + ENDDO + ENDIF + CALL MPI_REDUCE(COLSCA, WRKRC(1+M), N, MPI_DOUBLE_PRECISION, + & MPI_MAX, 0, + & COMM, IERROR) + If(MYID.EQ.0) THEN + DO I=1, N + COLSCA(I) = WRKRC(I+M) + ENDDO + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_694 + SUBROUTINE DMUMPS_687(IRN_loc, JCN_loc, A_loc, NZ_loc, + & N, NUMPROCS, MYID, COMM, + & PARTVEC, + & RSNDRCVSZ, + & REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & SCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER NZ_loc, N, IWRKSZ, OP + INTEGER NUMPROCS, MYID, COMM + INTEGER INTSZ, RESZ + INTEGER IRN_loc(NZ_loc) + INTEGER JCN_loc(NZ_loc) + DOUBLE PRECISION A_loc(NZ_loc) + INTEGER PARTVEC(N), RSNDRCVSZ(2*NUMPROCS) + INTEGER IWRK(IWRKSZ) + INTEGER REGISTRE(12) + DOUBLE PRECISION SCA(N) + INTEGER ISZWRKRC + DOUBLE PRECISION WRKRC(ISZWRKRC) + INTEGER IRSNDRCVNUM, ORSNDRCVNUM + INTEGER IRSNDRCVVOL, ORSNDRCVVOL + INTEGER INUMMYR + INTEGER IMYRPTR,IMYCPTR + INTEGER IRNGHBPRCS, IRSNDRCVIA,IRSNDRCVJA + INTEGER ORNGHBPRCS, ORSNDRCVIA,ORSNDRCVJA + INTEGER ISTATUS, REQUESTS, TMPWORK + INTEGER ITDRPTR, ISRRPTR, OSRRPTR + DOUBLE PRECISION ONENORMERR,INFNORMERR + INTEGER NB1, NB2, NB3 + DOUBLE PRECISION EPS + INTEGER ITER, NZIND, IR, IC + DOUBLE PRECISION ELM + INTEGER TAG_COMM_ROW + PARAMETER(TAG_COMM_ROW=101) + INTEGER TAG_ITERS + PARAMETER(TAG_ITERS=102) + EXTERNAL DMUMPS_655, + & DMUMPS_673, + & DMUMPS_692, + & DMUMPS_663, + & DMUMPS_742, + & DMUMPS_745, + & DMUMPS_661, + & DMUMPS_657, + & DMUMPS_656, + & DMUMPS_670, + & DMUMPS_671 + INTEGER DMUMPS_742 + INTEGER DMUMPS_745 + DOUBLE PRECISION DMUMPS_737 + DOUBLE PRECISION DMUMPS_738 + INTRINSIC abs + DOUBLE PRECISION RONE, RZERO + PARAMETER(RONE=1.0D0,RZERO=0.0D0) + INTEGER INTSZR + INTEGER MAXMN + INTEGER I, IERROR + DOUBLE PRECISION ONEERRL, ONEERRG + DOUBLE PRECISION INFERRL, INFERRG + INTEGER OORANGEIND + OORANGEIND = 0 + INFERRG = -RONE + ONEERRG = -RONE + MAXMN = N + IF(OP == 1) THEN + IF(NUMPROCS > 1) THEN + CALL DMUMPS_655(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & IWRK, IWRKSZ) + CALL DMUMPS_673(MYID, NUMPROCS, N, PARTVEC, + & NZ_loc, IRN_loc,JCN_loc, IRSNDRCVNUM,IRSNDRCVVOL, + & ORSNDRCVNUM, ORSNDRCVVOL, + & IWRK,IWRKSZ, + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), COMM) + CALL DMUMPS_663(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & INUMMYR, + & IWRK, IWRKSZ) + INTSZR = IRSNDRCVNUM + ORSNDRCVNUM + + & IRSNDRCVVOL + ORSNDRCVVOL + + & 2*(NUMPROCS+1) + INUMMYR + INTSZ = INTSZR + N + + & (MPI_STATUS_SIZE +1) * NUMPROCS + ELSE + IRSNDRCVNUM = 0 + ORSNDRCVNUM = 0 + IRSNDRCVVOL = 0 + ORSNDRCVVOL = 0 + INUMMYR = 0 + INTSZ = 0 + ENDIF + RESZ = N + IRSNDRCVVOL + ORSNDRCVVOL + REGISTRE(1) = IRSNDRCVNUM + REGISTRE(2) = ORSNDRCVNUM + REGISTRE(3) = IRSNDRCVVOL + REGISTRE(4) = ORSNDRCVVOL + REGISTRE(9) = INUMMYR + REGISTRE(11) = INTSZ + REGISTRE(12) = RESZ + ELSE + IRSNDRCVNUM = REGISTRE(1) + ORSNDRCVNUM = REGISTRE(2) + IRSNDRCVVOL = REGISTRE(3) + ORSNDRCVVOL = REGISTRE(4) + INUMMYR = REGISTRE(9) + IF(NUMPROCS > 1) THEN + CALL DMUMPS_661(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & IWRK(1), INUMMYR, + & IWRK(1+INUMMYR), IWRKSZ-INUMMYR) + IMYRPTR = 1 + IMYCPTR = IMYRPTR + INUMMYR + IRNGHBPRCS = IMYCPTR + IRSNDRCVIA = IRNGHBPRCS+IRSNDRCVNUM + IRSNDRCVJA = IRSNDRCVIA + NUMPROCS+1 + ORNGHBPRCS = IRSNDRCVJA + IRSNDRCVVOL + ORSNDRCVIA = ORNGHBPRCS + ORSNDRCVNUM + ORSNDRCVJA = ORSNDRCVIA + NUMPROCS + 1 + REQUESTS = ORSNDRCVJA + ORSNDRCVVOL + ISTATUS = REQUESTS + NUMPROCS + TMPWORK = ISTATUS + MPI_STATUS_SIZE * NUMPROCS + CALL DMUMPS_692(MYID, NUMPROCS, N, PARTVEC, + & NZ_loc, IRN_loc, JCN_loc, + & IRSNDRCVNUM, IRSNDRCVVOL, + & IWRK(IRNGHBPRCS),IWRK(IRSNDRCVIA),IWRK(IRSNDRCVJA), + & ORSNDRCVNUM, ORSNDRCVVOL, + & IWRK(ORNGHBPRCS),IWRK(ORSNDRCVIA),IWRK(ORSNDRCVJA), + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), + & IWRK(TMPWORK), + & IWRK(ISTATUS), IWRK(REQUESTS), + & TAG_COMM_ROW, COMM) + CALL DMUMPS_670(SCA, N, RZERO) + CALL DMUMPS_671(SCA, N, + & IWRK(IMYRPTR),INUMMYR, RONE) + ELSE + CALL DMUMPS_670(SCA, N, RONE) + ENDIF + ITDRPTR = 1 + ISRRPTR = ITDRPTR + N + OSRRPTR = ISRRPTR + IRSNDRCVVOL + IF(NUMPROCS == 1)THEN + OSRRPTR = OSRRPTR - 1 + ISRRPTR = ISRRPTR - 1 + ELSE + IF(IRSNDRCVVOL == 0) ISRRPTR = ISRRPTR - 1 + IF(ORSNDRCVVOL == 0) OSRRPTR = OSRRPTR - 1 + ENDIF + ITER = 1 + DO WHILE(ITER.LE.NB1+NB2+NB3) + IF(NUMPROCS > 1) THEN + CALL DMUMPS_650(WRKRC(ITDRPTR),N, + & IWRK(IMYRPTR),INUMMYR) + ELSE + CALL DMUMPS_670(WRKRC(ITDRPTR),N, RZERO) + ENDIF + IF((ITER.LE.NB1).OR.(ITER > NB1+NB2)) THEN + IF((ITER.EQ.1).OR.(OORANGEIND.EQ.1)) THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*SCA(IR)*SCA(IC) + IF(WRKRC(ITDRPTR-1+IR) 1) THEN + CALL DMUMPS_657(MYID, NUMPROCS, + & WRKRC(ITDRPTR), N, TAG_ITERS+2+ITER, + & IRSNDRCVNUM,IWRK(IRNGHBPRCS), + & IRSNDRCVVOL,IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM,IWRK(ORNGHBPRCS), + & ORSNDRCVVOL,IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS),IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRL = DMUMPS_737(SCA, + & WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + CALL MPI_ALLREDUCE(INFERRL, INFERRG, + & 1, MPI_DOUBLE_PRECISION, + & MPI_MAX, COMM, IERROR) + IF(INFERRG.LE.EPS) THEN + CALL DMUMPS_665(SCA, WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRL = DMUMPS_738(SCA, + & WRKRC(ITDRPTR), N) + INFERRG = INFERRL + IF(INFERRG.LE.EPS) THEN + CALL DMUMPS_666(SCA, WRKRC(ITDRPTR), N) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + IF((ITER.EQ.1).OR.(OORANGEIND.EQ.1))THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*SCA(IR)*SCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + IF(IR.NE.IC) THEN + WRKRC(ITDRPTR-1+IC) = + & WRKRC(ITDRPTR-1+IC) + ELM + ENDIF + ELSE + OORANGEIND = 1 + ENDIF + ENDDO + ELSEIF(OORANGEIND.EQ.0)THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + ELM = abs(A_loc(NZIND))*SCA(IR)*SCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + IF(IR.NE.IC) THEN + WRKRC(ITDRPTR-1+IC) = WRKRC(ITDRPTR-1+IC) + ELM + ENDIF + ENDDO + ENDIF + IF(NUMPROCS > 1) THEN + CALL DMUMPS_656(MYID, NUMPROCS, + & WRKRC(ITDRPTR), N, TAG_ITERS+2+ITER, + & IRSNDRCVNUM, IWRK(IRNGHBPRCS), + & IRSNDRCVVOL, IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM, IWRK(ORNGHBPRCS), + & ORSNDRCVVOL, IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS), IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRL = DMUMPS_737(SCA, + & WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + CALL MPI_ALLREDUCE(ONEERRL, ONEERRG, + & 1, MPI_DOUBLE_PRECISION, + & MPI_MAX, COMM, IERROR) + IF(ONEERRG.LE.EPS) THEN + CALL DMUMPS_665(SCA, WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRL = DMUMPS_738(SCA, + & WRKRC(ITDRPTR), N) + ONEERRG = ONEERRL + IF(ONEERRG.LE.EPS) THEN + CALL DMUMPS_666(SCA, WRKRC(ITDRPTR), N) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ENDIF + ENDIF + IF(NUMPROCS > 1) THEN + CALL DMUMPS_665(SCA, WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + ELSE + CALL DMUMPS_666(SCA, WRKRC(ITDRPTR), N) + ENDIF + ITER = ITER + 1 + ENDDO + ONENORMERR = ONEERRG + INFNORMERR = INFERRG + IF(NUMPROCS > 1) THEN + CALL MPI_REDUCE(SCA, WRKRC(1), N, MPI_DOUBLE_PRECISION, + & MPI_MAX, 0, + & COMM, IERROR) + IF(MYID.EQ.0) THEN + DO I=1, N + SCA(I) = WRKRC(I) + ENDDO + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_687 + SUBROUTINE DMUMPS_654(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & IPARTVEC, ISZ, OSZ, + & IWRK, IWSZ) + IMPLICIT NONE + EXTERNAL DMUMPS_703 + INTEGER MYID, NUMPROCS, COMM + INTEGER NZ_loc, ISZ, IWSZ, OSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWSZ) + INCLUDE 'mpif.h' + INTEGER I + INTEGER OP, IERROR + INTEGER IR, IC + IF(NUMPROCS.NE.1) THEN + CALL MPI_OP_CREATE(DMUMPS_703, .TRUE., OP, IERROR) + CALL DMUMPS_668(IWRK, 4*ISZ, ISZ) + DO I=1,ISZ + IWRK(2*I-1) = 0 + IWRK(2*I) = MYID + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.ISZ).AND. + & (IC.GE.1).AND.(IC.LE.OSZ)) THEN + IWRK(2*IR-1) = IWRK(2*IR-1) + 1 + ENDIF + ENDDO + CALL MPI_ALLREDUCE(IWRK(1), IWRK(1+2*ISZ), ISZ, + & MPI_2INTEGER, OP, COMM, IERROR) + DO I=1,ISZ + IPARTVEC(I) = IWRK(2*I+2*ISZ) + ENDDO + CALL MPI_OP_FREE(OP, IERROR) + ELSE + DO I=1,ISZ + IPARTVEC(I) = 0 + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_654 + SUBROUTINE DMUMPS_662(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & ROWPARTVEC, COLPARTVEC, M, N, + & INUMMYR, + & INUMMYC, + & IWRK, IWSZ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, M, N + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER ROWPARTVEC(M) + INTEGER COLPARTVEC(N) + INTEGER INUMMYR, INUMMYC + INTEGER IWSZ + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC + INUMMYR = 0 + INUMMYC = 0 + DO I=1,M + IWRK(I) = 0 + IF(ROWPARTVEC(I).EQ.MYID) THEN + IWRK(I)=1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IR) .EQ. 0) THEN + IWRK(IR)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + ENDDO + DO I=1,N + IWRK(I) = 0 + IF(COLPARTVEC(I).EQ.MYID) THEN + IWRK(I)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IC = JCN_loc(I) + IR = IRN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IC) .EQ. 0) THEN + IWRK(IC)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_662 + SUBROUTINE DMUMPS_660(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & ROWPARTVEC, COLPARTVEC, M, N, + & MYROWINDICES, INUMMYR, + & MYCOLINDICES, INUMMYC, + & IWRK, IWSZ ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, M, N + INTEGER INUMMYR, INUMMYC, IWSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER ROWPARTVEC(M) + INTEGER COLPARTVEC(N) + INTEGER MYROWINDICES(INUMMYR) + INTEGER MYCOLINDICES(INUMMYC) + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC, ITMP, MAXMN + MAXMN = M + IF(N > MAXMN) MAXMN = N + DO I=1,M + IWRK(I) = 0 + IF(ROWPARTVEC(I).EQ.MYID) IWRK(I)=1 + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IR) .EQ. 0) IWRK(IR)= 1 + ENDIF + ENDDO + ITMP = 1 + DO I=1,M + IF(IWRK(I).EQ.1) THEN + MYROWINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + DO I=1,N + IWRK(I) = 0 + IF(COLPARTVEC(I).EQ.MYID) IWRK(I)= 1 + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IC) .EQ. 0) IWRK(IC)= 1 + ENDIF + ENDDO + ITMP = 1 + DO I=1,N + IF(IWRK(I).EQ.1) THEN + MYCOLINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_660 + INTEGER FUNCTION DMUMPS_744(D, DSZ, INDX, INDXSZ, EPS) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + DOUBLE PRECISION D(DSZ) + INTEGER INDX(INDXSZ) + DOUBLE PRECISION EPS + INTEGER I, IID + DOUBLE PRECISION RONE + PARAMETER(RONE=1.0D0) + DMUMPS_744 = 1 + DO I=1, INDXSZ + IID = INDX(I) + IF (.NOT.( (D(IID).LE.(RONE+EPS)).AND. + & ((RONE-EPS).LE.D(IID)) )) THEN + DMUMPS_744 = 0 + ENDIF + ENDDO + RETURN + END FUNCTION DMUMPS_744 + INTEGER FUNCTION DMUMPS_745(D, DSZ, EPS) + IMPLICIT NONE + INTEGER DSZ + DOUBLE PRECISION D(DSZ) + DOUBLE PRECISION EPS + INTEGER I + DOUBLE PRECISION RONE + PARAMETER(RONE=1.0D0) + DMUMPS_745 = 1 + DO I=1, DSZ + IF (.NOT.( (D(I).LE.(RONE+EPS)).AND. + & ((RONE-EPS).LE.D(I)) )) THEN + DMUMPS_745 = 0 + ENDIF + ENDDO + RETURN + END FUNCTION DMUMPS_745 + INTEGER FUNCTION DMUMPS_743(DR, M, INDXR, INDXRSZ, + & DC, N, INDXC, INDXCSZ, EPS, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER M, N, INDXRSZ, INDXCSZ + DOUBLE PRECISION DR(M), DC(N) + INTEGER INDXR(INDXRSZ), INDXC(INDXCSZ) + DOUBLE PRECISION EPS + INTEGER COMM + EXTERNAL DMUMPS_744 + INTEGER DMUMPS_744 + INTEGER GLORES, MYRESR, MYRESC, MYRES + INTEGER IERR + MYRESR = DMUMPS_744(DR, M, INDXR, INDXRSZ, EPS) + MYRESC = DMUMPS_744(DC, N, INDXC, INDXCSZ, EPS) + MYRES = MYRESR + MYRESC + CALL MPI_ALLREDUCE(MYRES, GLORES, 1, MPI_INTEGER, + & MPI_SUM, COMM, IERR) + DMUMPS_743 = GLORES + RETURN + END FUNCTION DMUMPS_743 + DOUBLE PRECISION FUNCTION DMUMPS_737(D, TMPD, DSZ, + & INDX, INDXSZ) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + DOUBLE PRECISION D(DSZ) + DOUBLE PRECISION TMPD(DSZ) + INTEGER INDX(INDXSZ) + DOUBLE PRECISION RONE + PARAMETER(RONE=1.0D0) + INTEGER I, IIND + DOUBLE PRECISION ERRMAX + INTRINSIC abs + ERRMAX = -RONE + DO I=1,INDXSZ + IIND = INDX(I) + IF(abs(RONE-TMPD(IIND)).GT.ERRMAX) THEN + ERRMAX = abs(RONE-TMPD(IIND)) + ENDIF + ENDDO + DMUMPS_737 = ERRMAX + RETURN + END FUNCTION DMUMPS_737 + DOUBLE PRECISION FUNCTION DMUMPS_738(D, TMPD, DSZ) + IMPLICIT NONE + INTEGER DSZ + DOUBLE PRECISION D(DSZ) + DOUBLE PRECISION TMPD(DSZ) + DOUBLE PRECISION RONE + PARAMETER(RONE=1.0D0) + INTEGER I + DOUBLE PRECISION ERRMAX1 + INTRINSIC abs + ERRMAX1 = -RONE + DO I=1,DSZ + IF(abs(RONE-TMPD(I)).GT.ERRMAX1) THEN + ERRMAX1 = abs(RONE-TMPD(I)) + ENDIF + ENDDO + DMUMPS_738 = ERRMAX1 + RETURN + END FUNCTION DMUMPS_738 + SUBROUTINE DMUMPS_665(D, TMPD, DSZ, + & INDX, INDXSZ) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + DOUBLE PRECISION D(DSZ) + DOUBLE PRECISION TMPD(DSZ) + INTEGER INDX(INDXSZ) + INTRINSIC sqrt + INTEGER I, IIND + DOUBLE PRECISION RZERO + PARAMETER(RZERO=0.0D0) + DO I=1,INDXSZ + IIND = INDX(I) + IF (TMPD(IIND).NE.RZERO) D(IIND) = D(IIND)/sqrt(TMPD(IIND)) + ENDDO + RETURN + END SUBROUTINE DMUMPS_665 + SUBROUTINE DMUMPS_666(D, TMPD, DSZ) + IMPLICIT NONE + INTEGER DSZ + DOUBLE PRECISION D(DSZ) + DOUBLE PRECISION TMPD(DSZ) + INTRINSIC sqrt + INTEGER I + DOUBLE PRECISION RZERO + PARAMETER(RZERO=0.0D0) + DO I=1,DSZ + IF (TMPD(I) .NE. RZERO) D(I) = D(I)/sqrt(TMPD(I)) + ENDDO + RETURN + END SUBROUTINE DMUMPS_666 + SUBROUTINE DMUMPS_671(D, DSZ, INDX, INDXSZ, VAL) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + DOUBLE PRECISION D(DSZ) + INTEGER INDX(INDXSZ) + DOUBLE PRECISION VAL + INTEGER I, IIND + DO I=1,INDXSZ + IIND = INDX(I) + D(IIND) = VAL + ENDDO + RETURN + END SUBROUTINE DMUMPS_671 + SUBROUTINE DMUMPS_702(D, DSZ, INDX, INDXSZ) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + DOUBLE PRECISION D(DSZ) + INTEGER INDX(INDXSZ) + INTEGER I, IIND + DO I=1,INDXSZ + IIND = INDX(I) + D(IIND) = 1.0D0/D(IIND) + ENDDO + RETURN + END SUBROUTINE DMUMPS_702 + SUBROUTINE DMUMPS_670(D, DSZ, VAL) + IMPLICIT NONE + INTEGER DSZ + DOUBLE PRECISION D(DSZ) + DOUBLE PRECISION VAL + INTEGER I + DO I=1,DSZ + D(I) = VAL + ENDDO + RETURN + END SUBROUTINE DMUMPS_670 + SUBROUTINE DMUMPS_650(TMPD, TMPSZ, INDX, INDXSZ) + IMPLICIT NONE + INTEGER TMPSZ,INDXSZ + DOUBLE PRECISION TMPD(TMPSZ) + INTEGER INDX(INDXSZ) + INTEGER I + DOUBLE PRECISION DZERO + PARAMETER(DZERO=0.0D0) + DO I=1,INDXSZ + TMPD(INDX(I)) = DZERO + ENDDO + RETURN + END SUBROUTINE DMUMPS_650 + SUBROUTINE DMUMPS_703(INV, INOUTV, LEN, DTYPE) + IMPLICIT NONE + INTEGER LEN + INTEGER INV(2*LEN) + INTEGER INOUTV(2*LEN) + INTEGER DTYPE + INTEGER I + INTEGER DIN, DINOUT, PIN, PINOUT + DO I=1,2*LEN-1,2 + DIN = INV(I) + PIN = INV(I+1) + DINOUT = INOUTV(I) + PINOUT = INOUTV(I+1) + IF (DINOUT < DIN) THEN + INOUTV(I) = DIN + INOUTV(I+1) = PIN + ELSE IF (DINOUT == DIN) THEN + IF ((mod(DINOUT,2).EQ.0).AND.(PINPINOUT)) THEN + INOUTV(I+1) = PIN + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_703 + SUBROUTINE DMUMPS_668(IW, IWSZ, IVAL) + IMPLICIT NONE + INTEGER IWSZ + INTEGER IW(IWSZ) + INTEGER IVAL + INTEGER I + DO I=1,IWSZ + IW(I)=IVAL + ENDDO + RETURN + END SUBROUTINE DMUMPS_668 + SUBROUTINE DMUMPS_704(MYID, NUMPROCS, + & IRN_loc, JCN_loc, NZ_loc, + & ROWPARTVEC, COLPARTVEC, M, N, + & MYROWINDICES, INUMMYR, + & MYCOLINDICES, INUMMYC, + & IWRKROW, IWRKCOL, IWSZR, IWSZC, COMM ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, M, N + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER ROWPARTVEC(M) + INTEGER COLPARTVEC(N) + INTEGER MYROWINDICES(M) + INTEGER MYCOLINDICES(N) + INTEGER INUMMYR, INUMMYC + INTEGER IWSZR, IWSZC + INTEGER IWRKROW(IWSZR) + INTEGER IWRKCOL(IWSZC) + INTEGER COMM + INTEGER I, IR, IC, ITMP + INUMMYR = 0 + INUMMYC = 0 + DO I=1,M + IWRKROW(I) = 0 + IF(ROWPARTVEC(I).EQ.MYID) THEN + IWRKROW(I)=1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRKROW(IR) .EQ. 0) THEN + IWRKROW(IR)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + ENDDO + ITMP = 1 + DO I=1,M + IF(IWRKROW(I).EQ.1) THEN + MYROWINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + DO I=1,N + IWRKCOL(I) = 0 + IF(COLPARTVEC(I).EQ.MYID) THEN + IWRKCOL(I)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRKCOL(IC) .EQ. 0) THEN + IWRKCOL(IC)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDIF + ENDDO + ITMP = 1 + DO I=1,N + IF(IWRKCOL(I).EQ.1) THEN + MYCOLINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_704 + SUBROUTINE DMUMPS_672(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX, OSZ, OINDX,ISNDRCVNUM,ISNDRCVVOL, + & OSNDRCVNUM,OSNDRCVVOL, + & IWRK,IWRKSZ, SNDSZ, RCVSZ, COMM) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, IWRKSZ, OSZ + INTEGER ISNDRCVNUM, ISNDRCVVOL + INTEGER OSNDRCVNUM, OSNDRCVVOL + INTEGER COMM + INTEGER INDX(NZ_loc) + INTEGER OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWRKSZ) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INCLUDE 'mpif.h' + INTEGER I + INTEGER IIND, IIND2, PIND + INTEGER IERROR + DO I=1,NUMPROCS + SNDSZ(I) = 0 + RCVSZ(I) = 0 + ENDDO + DO I=1,IWRKSZ + IWRK(I) = 0 + ENDDO + DO I=1,NZ_loc + IIND = INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND. + & (IIND2.GE.1).AND.(IIND2.LE.OSZ))THEN + PIND = IPARTVEC(IIND) + IF(PIND .NE. MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWRK(IIND) = 1 + SNDSZ(PIND+1) = SNDSZ(PIND+1)+1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_ALLTOALL(SNDSZ, 1, MPI_INTEGER, + & RCVSZ, 1, MPI_INTEGER, COMM, IERROR) + ISNDRCVNUM = 0 + ISNDRCVVOL = 0 + OSNDRCVNUM = 0 + OSNDRCVVOL = 0 + DO I=1, NUMPROCS + IF(SNDSZ(I) > 0) OSNDRCVNUM = OSNDRCVNUM + 1 + OSNDRCVVOL = OSNDRCVVOL + SNDSZ(I) + IF(RCVSZ(I) > 0) ISNDRCVNUM = ISNDRCVNUM + 1 + ISNDRCVVOL = ISNDRCVVOL + RCVSZ(I) + ENDDO + RETURN + END SUBROUTINE DMUMPS_672 + SUBROUTINE DMUMPS_674(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX, OSZ, OINDX, + & ISNDRCVNUM, ISNDVOL, INGHBPRCS, ISNDRCVIA, ISNDRCVJA, + & OSNDRCVNUM, OSNDVOL, ONGHBPRCS, OSNDRCVIA, OSNDRCVJA, + & SNDSZ, RCVSZ, IWRK, + & ISTATUS, REQUESTS, + & ITAGCOMM, COMM ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, ISNDVOL, OSNDVOL, OSZ + INTEGER INDX(NZ_loc) + INTEGER OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER ISNDRCVNUM, INGHBPRCS(ISNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1) + INTEGER ISNDRCVJA(ISNDVOL) + INTEGER OSNDRCVNUM, ONGHBPRCS(OSNDRCVNUM) + INTEGER OSNDRCVIA(NUMPROCS+1) + INTEGER OSNDRCVJA(OSNDVOL) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INTEGER IWRK(ISZ) + INTEGER ISTATUS(MPI_STATUS_SIZE, ISNDRCVNUM) + INTEGER REQUESTS(ISNDRCVNUM) + INTEGER ITAGCOMM, COMM + INTEGER I, IIND, IIND2, IPID, OFFS + INTEGER IWHERETO, POFFS, ITMP, IERROR + DO I=1,ISZ + IWRK(I) = 0 + ENDDO + OFFS = 1 + POFFS = 1 + DO I=1,NUMPROCS + OSNDRCVIA(I) = OFFS + SNDSZ(I) + IF(SNDSZ(I) > 0) THEN + ONGHBPRCS(POFFS)=I + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + SNDSZ(I) + ENDDO + OSNDRCVIA(NUMPROCS+1) = OFFS + DO I=1,NZ_loc + IIND=INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND. + & (IIND2.GE.1).AND.(IIND2.LE.OSZ) ) THEN + IPID=IPARTVEC(IIND) + IF(IPID.NE.MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWHERETO = OSNDRCVIA(IPID+1)-1 + OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1 + OSNDRCVJA(IWHERETO) = IIND + IWRK(IIND) = 1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + OFFS = 1 + POFFS = 1 + ISNDRCVIA(1) = 1 + DO I=2,NUMPROCS+1 + ISNDRCVIA(I) = OFFS + RCVSZ(I-1) + IF(RCVSZ(I-1) > 0) THEN + INGHBPRCS(POFFS)=I-1 + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + RCVSZ(I-1) + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + DO I=1, ISNDRCVNUM + IPID = INGHBPRCS(I) + OFFS = ISNDRCVIA(IPID) + ITMP = ISNDRCVIA(IPID+1) - ISNDRCVIA(IPID) + CALL MPI_IRECV(ISNDRCVJA(OFFS), ITMP, MPI_INTEGER,IPID-1, + & ITAGCOMM, COMM, REQUESTS(I),IERROR) + ENDDO + DO I=1,OSNDRCVNUM + IPID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(IPID) + ITMP = OSNDRCVIA(IPID+1)-OSNDRCVIA(IPID) + CALL MPI_SEND(OSNDRCVJA(OFFS), ITMP, MPI_INTEGER, IPID-1, + & ITAGCOMM, COMM,IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + CALL MPI_BARRIER(COMM,IERROR) + RETURN + END SUBROUTINE DMUMPS_674 + SUBROUTINE DMUMPS_657(MYID, NUMPROCS,TMPD, IDSZ, ITAGCOMM, + & ISNDRCVNUM, INGHBPRCS, + & ISNDRCVVOL, ISNDRCVIA, ISNDRCVJA, ISNDRCVA, + & OSNDRCVNUM, ONGHBPRCS, + & OSNDRCVVOL, OSNDRCVIA, OSNDRCVJA, OSNDRCVA, + & ISTATUS, REQUESTS, + & COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, IDSZ, ITAGCOMM + INTEGER ISNDRCVNUM,OSNDRCVNUM, ISNDRCVVOL, OSNDRCVVOL + DOUBLE PRECISION TMPD(IDSZ) + INTEGER INGHBPRCS(ISNDRCVNUM), ONGHBPRCS(OSNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1), ISNDRCVJA(ISNDRCVVOL) + DOUBLE PRECISION ISNDRCVA(ISNDRCVVOL) + INTEGER OSNDRCVIA(NUMPROCS+1), OSNDRCVJA(OSNDRCVVOL) + DOUBLE PRECISION OSNDRCVA(OSNDRCVVOL) + INTEGER ISTATUS(MPI_STATUS_SIZE, max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER REQUESTS(max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER COMM, IERROR + INTEGER I, PID, OFFS, SZ, J, JS, JE, IID + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1) - ISNDRCVIA(PID) + CALL MPI_IRECV(ISNDRCVA(OFFS), SZ, + & MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS, JE + IID = OSNDRCVJA(J) + OSNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(OSNDRCVA(OFFS), SZ, MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM, COMM, IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1)-1 + DO J=JS,JE + IID = ISNDRCVJA(J) + IF(TMPD(IID) < ISNDRCVA(J)) TMPD(IID)= ISNDRCVA(J) + ENDDO + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + CALL MPI_IRECV(OSNDRCVA(OFFS), SZ, + & MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM+1,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1)-ISNDRCVIA(PID) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1) -1 + DO J=JS, JE + IID = ISNDRCVJA(J) + ISNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(ISNDRCVA(OFFS), SZ, MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM+1, COMM, IERROR) + ENDDO + IF(OSNDRCVNUM > 0) THEN + CALL MPI_WAITALL(OSNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS,JE + IID = OSNDRCVJA(J) + TMPD(IID)=OSNDRCVA(J) + ENDDO + ENDDO + RETURN + END SUBROUTINE DMUMPS_657 + SUBROUTINE DMUMPS_656(MYID, NUMPROCS,TMPD, IDSZ, ITAGCOMM, + & ISNDRCVNUM, INGHBPRCS, + & ISNDRCVVOL, ISNDRCVIA, ISNDRCVJA, ISNDRCVA, + & OSNDRCVNUM, ONGHBPRCS, + & OSNDRCVVOL, OSNDRCVIA, OSNDRCVJA, OSNDRCVA, + & ISTATUS, REQUESTS, + & COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, IDSZ, ITAGCOMM + INTEGER ISNDRCVNUM,OSNDRCVNUM, ISNDRCVVOL, OSNDRCVVOL + DOUBLE PRECISION TMPD(IDSZ) + INTEGER INGHBPRCS(ISNDRCVNUM), ONGHBPRCS(OSNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1), ISNDRCVJA(ISNDRCVVOL) + DOUBLE PRECISION ISNDRCVA(ISNDRCVVOL) + INTEGER OSNDRCVIA(NUMPROCS+1), OSNDRCVJA(OSNDRCVVOL) + DOUBLE PRECISION OSNDRCVA(OSNDRCVVOL) + INTEGER ISTATUS(MPI_STATUS_SIZE, max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER REQUESTS(max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER COMM, IERROR + INTEGER I, PID, OFFS, SZ, J, JS, JE, IID + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1) - ISNDRCVIA(PID) + CALL MPI_IRECV(ISNDRCVA(OFFS), SZ, + & MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS, JE + IID = OSNDRCVJA(J) + OSNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(OSNDRCVA(OFFS), SZ, MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM, COMM, IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1)-1 + DO J=JS,JE + IID = ISNDRCVJA(J) + TMPD(IID) = TMPD(IID)+ ISNDRCVA(J) + ENDDO + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + CALL MPI_IRECV(OSNDRCVA(OFFS), SZ, + & MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM+1,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1)-ISNDRCVIA(PID) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1) -1 + DO J=JS, JE + IID = ISNDRCVJA(J) + ISNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(ISNDRCVA(OFFS), SZ, MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM+1, COMM, IERROR) + ENDDO + IF(OSNDRCVNUM > 0) THEN + CALL MPI_WAITALL(OSNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS,JE + IID = OSNDRCVJA(J) + TMPD(IID)=OSNDRCVA(J) + ENDDO + ENDDO + RETURN + END SUBROUTINE DMUMPS_656 + SUBROUTINE DMUMPS_655(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & IPARTVEC, ISZ, + & IWRK, IWSZ) + IMPLICIT NONE + EXTERNAL DMUMPS_703 + INTEGER MYID, NUMPROCS, COMM + INTEGER NZ_loc, ISZ, IWSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWSZ) + INCLUDE 'mpif.h' + INTEGER I + INTEGER OP, IERROR + INTEGER IR, IC + IF(NUMPROCS.NE.1) THEN + CALL MPI_OP_CREATE(DMUMPS_703, .TRUE., OP, IERROR) + CALL DMUMPS_668(IWRK, 4*ISZ, ISZ) + DO I=1,ISZ + IWRK(2*I-1) = 0 + IWRK(2*I) = MYID + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.ISZ).AND. + & (IC.GE.1).AND.(IC.LE.ISZ)) THEN + IWRK(2*IR-1) = IWRK(2*IR-1) + 1 + IWRK(2*IC-1) = IWRK(2*IC-1) + 1 + ENDIF + ENDDO + CALL MPI_ALLREDUCE(IWRK(1), IWRK(1+2*ISZ), ISZ, + & MPI_2INTEGER, OP, COMM, IERROR) + DO I=1,ISZ + IPARTVEC(I) = IWRK(2*I+2*ISZ) + ENDDO + CALL MPI_OP_FREE(OP, IERROR) + ELSE + DO I=1,ISZ + IPARTVEC(I) = 0 + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_655 + SUBROUTINE DMUMPS_673(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX,OINDX,ISNDRCVNUM,ISNDRCVVOL,OSNDRCVNUM,OSNDRCVVOL, + & IWRK,IWRKSZ, SNDSZ, RCVSZ, COMM) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, IWRKSZ + INTEGER ISNDRCVNUM, ISNDRCVVOL + INTEGER OSNDRCVNUM, OSNDRCVVOL + INTEGER COMM + INTEGER INDX(NZ_loc), OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWRKSZ) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INCLUDE 'mpif.h' + INTEGER I + INTEGER IIND, IIND2, PIND + INTEGER IERROR + DO I=1,NUMPROCS + SNDSZ(I) = 0 + RCVSZ(I) = 0 + ENDDO + DO I=1,IWRKSZ + IWRK(I) = 0 + ENDDO + DO I=1,NZ_loc + IIND = INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND.(IIND2.GE.1) + & .AND.(IIND2.LE.ISZ)) THEN + PIND = IPARTVEC(IIND) + IF(PIND .NE. MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWRK(IIND) = 1 + SNDSZ(PIND+1) = SNDSZ(PIND+1)+1 + ENDIF + ENDIF + IIND = OINDX(I) + PIND = IPARTVEC(IIND) + IF(PIND .NE. MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWRK(IIND) = 1 + SNDSZ(PIND+1) = SNDSZ(PIND+1)+1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_ALLTOALL(SNDSZ, 1, MPI_INTEGER, + & RCVSZ, 1, MPI_INTEGER, COMM, IERROR) + ISNDRCVNUM = 0 + ISNDRCVVOL = 0 + OSNDRCVNUM = 0 + OSNDRCVVOL = 0 + DO I=1, NUMPROCS + IF(SNDSZ(I) > 0) OSNDRCVNUM = OSNDRCVNUM + 1 + OSNDRCVVOL = OSNDRCVVOL + SNDSZ(I) + IF(RCVSZ(I) > 0) ISNDRCVNUM = ISNDRCVNUM + 1 + ISNDRCVVOL = ISNDRCVVOL + RCVSZ(I) + ENDDO + RETURN + END SUBROUTINE DMUMPS_673 + SUBROUTINE DMUMPS_663(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & INUMMYR, + & IWRK, IWSZ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, N + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER PARTVEC(N) + INTEGER INUMMYR + INTEGER IWSZ + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC + INUMMYR = 0 + DO I=1,N + IWRK(I) = 0 + IF(PARTVEC(I).EQ.MYID) THEN + IWRK(I)=1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IR) .EQ. 0) THEN + IWRK(IR)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IC).EQ.0) THEN + IWRK(IC)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_663 + INTEGER FUNCTION DMUMPS_742(D, N, INDXR, INDXRSZ, + & EPS, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER N, INDXRSZ + DOUBLE PRECISION D(N) + INTEGER INDXR(INDXRSZ) + DOUBLE PRECISION EPS + INTEGER COMM + EXTERNAL DMUMPS_744 + INTEGER DMUMPS_744 + INTEGER GLORES, MYRESR, MYRES + INTEGER IERR + MYRESR = DMUMPS_744(D, N, INDXR, INDXRSZ, EPS) + MYRES = 2*MYRESR + CALL MPI_ALLREDUCE(MYRES, GLORES, 1, MPI_INTEGER, + & MPI_SUM, COMM, IERR) + DMUMPS_742 = GLORES + RETURN + END FUNCTION DMUMPS_742 + SUBROUTINE DMUMPS_661(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & MYROWINDICES, INUMMYR, + & IWRK, IWSZ ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, N + INTEGER INUMMYR, IWSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER PARTVEC(N) + INTEGER MYROWINDICES(INUMMYR) + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC, ITMP, MAXMN + MAXMN = N + DO I=1,N + IWRK(I) = 0 + IF(PARTVEC(I).EQ.MYID) IWRK(I)=1 + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IR) .EQ. 0) IWRK(IR)= 1 + ENDIF + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IC) .EQ.0) IWRK(IC)=1 + ENDIF + ENDDO + ITMP = 1 + DO I=1,N + IF(IWRK(I).EQ.1) THEN + MYROWINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_661 + SUBROUTINE DMUMPS_692(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX, OINDX, + & ISNDRCVNUM, ISNDVOL, INGHBPRCS, ISNDRCVIA, ISNDRCVJA, + & OSNDRCVNUM, OSNDVOL, ONGHBPRCS, OSNDRCVIA, OSNDRCVJA, + & SNDSZ, RCVSZ, IWRK, + & ISTATUS, REQUESTS, + & ITAGCOMM, COMM ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, ISNDVOL, OSNDVOL + INTEGER INDX(NZ_loc), OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER ISNDRCVNUM, INGHBPRCS(ISNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1) + INTEGER ISNDRCVJA(ISNDVOL) + INTEGER OSNDRCVNUM, ONGHBPRCS(OSNDRCVNUM) + INTEGER OSNDRCVIA(NUMPROCS+1) + INTEGER OSNDRCVJA(OSNDVOL) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INTEGER IWRK(ISZ) + INTEGER ISTATUS(MPI_STATUS_SIZE, ISNDRCVNUM) + INTEGER REQUESTS(ISNDRCVNUM) + INTEGER ITAGCOMM, COMM + INTEGER I, IIND,IIND2,IPID,OFFS,IWHERETO,POFFS, ITMP, IERROR + DO I=1,ISZ + IWRK(I) = 0 + ENDDO + OFFS = 1 + POFFS = 1 + DO I=1,NUMPROCS + OSNDRCVIA(I) = OFFS + SNDSZ(I) + IF(SNDSZ(I) > 0) THEN + ONGHBPRCS(POFFS)=I + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + SNDSZ(I) + ENDDO + OSNDRCVIA(NUMPROCS+1) = OFFS + DO I=1,NZ_loc + IIND=INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND.(IIND2.GE.1) + & .AND.(IIND2.LE.ISZ)) THEN + IPID=IPARTVEC(IIND) + IF(IPID.NE.MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWHERETO = OSNDRCVIA(IPID+1)-1 + OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1 + OSNDRCVJA(IWHERETO) = IIND + IWRK(IIND) = 1 + ENDIF + ENDIF + IIND = OINDX(I) + IPID=IPARTVEC(IIND) + IF(IPID.NE.MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWHERETO = OSNDRCVIA(IPID+1)-1 + OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1 + OSNDRCVJA(IWHERETO) = IIND + IWRK(IIND) = 1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + OFFS = 1 + POFFS = 1 + ISNDRCVIA(1) = 1 + DO I=2,NUMPROCS+1 + ISNDRCVIA(I) = OFFS + RCVSZ(I-1) + IF(RCVSZ(I-1) > 0) THEN + INGHBPRCS(POFFS)=I-1 + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + RCVSZ(I-1) + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + DO I=1, ISNDRCVNUM + IPID = INGHBPRCS(I) + OFFS = ISNDRCVIA(IPID) + ITMP = ISNDRCVIA(IPID+1) - ISNDRCVIA(IPID) + CALL MPI_IRECV(ISNDRCVJA(OFFS), ITMP, MPI_INTEGER,IPID-1, + & ITAGCOMM, COMM, REQUESTS(I),IERROR) + ENDDO + DO I=1,OSNDRCVNUM + IPID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(IPID) + ITMP = OSNDRCVIA(IPID+1)-OSNDRCVIA(IPID) + CALL MPI_SEND(OSNDRCVJA(OFFS), ITMP, MPI_INTEGER, IPID-1, + & ITAGCOMM, COMM,IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + CALL MPI_BARRIER(COMM,IERROR) + RETURN + END SUBROUTINE DMUMPS_692 + SUBROUTINE DMUMPS_628(IW,LREC,SIZE_FREE,XSIZE) + INTEGER, intent(in) :: LREC, XSIZE + INTEGER, intent(in) :: IW(LREC) + INTEGER(8), intent(out):: SIZE_FREE + INCLUDE 'mumps_headers.h' + IF (IW(1+XXS).EQ.S_NOLCBCONTIG .OR. + & IW(1+XXS).EQ.S_NOLCBNOCONTIG) THEN + SIZE_FREE=int(IW(1+XSIZE+2),8)*int(IW(1+XSIZE+3),8) + ELSE IF (IW(1+XXS).EQ.S_NOLCBCONTIG38 .OR. + & IW(1+XXS).EQ.S_NOLCBNOCONTIG38) THEN + SIZE_FREE=int(IW(1+XSIZE+2),8)*int(IW(1+XSIZE)+ + & IW(1+XSIZE + 3) - + & ( IW(1+XSIZE + 4) + & - IW(1+XSIZE + 3) ), 8) + ELSE + SIZE_FREE=0_8 + ENDIF + RETURN + END SUBROUTINE DMUMPS_628 + SUBROUTINE DMUMPS_629 + &(IW,LIW,IXXP,ICURRENT,NEXT, RCURRENT,ISIZE2SHIFT) + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER(8) :: RCURRENT + INTEGER LIW,IXXP,ICURRENT,NEXT,ISIZE2SHIFT + INTEGER IW(LIW) + INTEGER(8) :: RSIZE + ICURRENT=NEXT + CALL MUMPS_729( RSIZE, IW(ICURRENT + XXR) ) + RCURRENT = RCURRENT - RSIZE + NEXT=IW(ICURRENT+XXP) + IW(IXXP)=ICURRENT+ISIZE2SHIFT + IXXP=ICURRENT+XXP + RETURN + END SUBROUTINE DMUMPS_629 + SUBROUTINE DMUMPS_630(IW,LIW,BEG2SHIFT,END2SHIFT,ISIZE2SHIFT) + IMPLICIT NONE + INTEGER LIW, BEG2SHIFT, END2SHIFT, ISIZE2SHIFT + INTEGER IW(LIW) + INTEGER I + IF (ISIZE2SHIFT.GT.0) THEN + DO I=END2SHIFT,BEG2SHIFT,-1 + IW(I+ISIZE2SHIFT)=IW(I) + ENDDO + ELSE IF (ISIZE2SHIFT.LT.0) THEN + DO I=BEG2SHIFT,END2SHIFT + IW(I+ISIZE2SHIFT)=IW(I) + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_630 + SUBROUTINE DMUMPS_631(A, LA, BEG2SHIFT, END2SHIFT, RSIZE2SHIFT) + IMPLICIT NONE + INTEGER(8) :: LA, BEG2SHIFT, END2SHIFT, RSIZE2SHIFT + DOUBLE PRECISION A(LA) + INTEGER(8) :: I + IF (RSIZE2SHIFT.GT.0_8) THEN + DO I=END2SHIFT,BEG2SHIFT,-1_8 + A(I+RSIZE2SHIFT)=A(I) + ENDDO + ELSE IF (RSIZE2SHIFT.LT.0_8) THEN + DO I=BEG2SHIFT,END2SHIFT + A(I+RSIZE2SHIFT)=A(I) + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_631 + SUBROUTINE DMUMPS_94(N,KEEP28,IW,LIW,A,LA, + & LRLU,IPTRLU,IWPOS, + & IWPOSCB,PTRIST,PTRAST,STEP,PIMASTER,PAMASTER, + & KEEP216,LRLUS,XSIZE) + IMPLICIT NONE + INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS + INTEGER N,LIW,KEEP28, + & IWPOS,IWPOSCB,KEEP216,XSIZE + INTEGER(8) :: PTRAST(KEEP28), PAMASTER(KEEP28) + INTEGER IW(LIW),PTRIST(KEEP28), + & STEP(N), PIMASTER(KEEP28) + DOUBLE PRECISION A(LA) + INCLUDE 'mumps_headers.h' + INTEGER ICURRENT, NEXT, STATE_NEXT + INTEGER(8) :: RCURRENT + INTEGER ISIZE2SHIFT + INTEGER(8) :: RSIZE2SHIFT + INTEGER IBEGCONTIG + INTEGER(8) :: RBEGCONTIG + INTEGER(8) :: RBEG2SHIFT, REND2SHIFT + INTEGER INODE + INTEGER(8) :: FREE_IN_REC + INTEGER(8) :: RCURRENT_SIZE + INTEGER IXXP + ISIZE2SHIFT=0 + RSIZE2SHIFT=0_8 + ICURRENT = LIW-XSIZE+1 + RCURRENT = LA+1_8 + IBEGCONTIG = -999999 + RBEGCONTIG = -999999_8 + NEXT = IW(ICURRENT+XXP) + IF (NEXT.EQ.TOP_OF_STACK) RETURN + STATE_NEXT = IW(NEXT+XXS) + IXXP = ICURRENT+XXP + 10 CONTINUE + IF ( STATE_NEXT .NE. S_FREE .AND. + & (KEEP216.EQ.3.OR. + & (STATE_NEXT .NE. S_NOLCBNOCONTIG .AND. + & STATE_NEXT .NE. S_NOLCBCONTIG .AND. + & STATE_NEXT .NE. S_NOLCBNOCONTIG38 .AND. + & STATE_NEXT .NE. S_NOLCBCONTIG38))) THEN + CALL DMUMPS_629(IW,LIW, + & IXXP, ICURRENT, NEXT, RCURRENT, ISIZE2SHIFT) + CALL MUMPS_729(RCURRENT_SIZE, IW(ICURRENT+XXR)) + IF (IBEGCONTIG < 0) THEN + IBEGCONTIG=ICURRENT+IW(ICURRENT+XXI)-1 + ENDIF + IF (RBEGCONTIG < 0_8) THEN + RBEGCONTIG=RCURRENT+RCURRENT_SIZE-1_8 + ENDIF + INODE=IW(ICURRENT+XXN) + IF (RSIZE2SHIFT .NE. 0_8) THEN + IF (PTRAST(STEP(INODE)).EQ.RCURRENT) + & PTRAST(STEP(INODE))= + & PTRAST(STEP(INODE))+RSIZE2SHIFT + IF (PAMASTER(STEP(INODE)).EQ.RCURRENT) + & PAMASTER(STEP(INODE))= + & PAMASTER(STEP(INODE))+RSIZE2SHIFT + ENDIF + IF (ISIZE2SHIFT .NE. 0) THEN + IF (PTRIST(STEP(INODE)).EQ.ICURRENT) + & PTRIST(STEP(INODE))= + & PTRIST(STEP(INODE))+ISIZE2SHIFT + IF (PIMASTER(STEP(INODE)).EQ.ICURRENT) + & PIMASTER(STEP(INODE))= + & PIMASTER(STEP(INODE))+ISIZE2SHIFT + ENDIF + IF (NEXT .NE. TOP_OF_STACK) THEN + STATE_NEXT=IW(NEXT+XXS) + GOTO 10 + ENDIF + ENDIF + 20 CONTINUE + IF (IBEGCONTIG.NE.0 .AND. ISIZE2SHIFT .NE. 0) THEN + CALL DMUMPS_630(IW,LIW,ICURRENT,IBEGCONTIG,ISIZE2SHIFT) + IF (IXXP .LE.IBEGCONTIG) THEN + IXXP=IXXP+ISIZE2SHIFT + ENDIF + ENDIF + IBEGCONTIG=-9999 + 25 CONTINUE + IF (RBEGCONTIG .GT.0_8 .AND. RSIZE2SHIFT .NE. 0_8) THEN + CALL DMUMPS_631(A,LA,RCURRENT,RBEGCONTIG,RSIZE2SHIFT) + ENDIF + RBEGCONTIG=-99999_8 + 30 CONTINUE + IF (NEXT.EQ. TOP_OF_STACK) GOTO 100 + IF (STATE_NEXT .EQ. S_NOLCBCONTIG .OR. + & STATE_NEXT .EQ. S_NOLCBNOCONTIG .OR. + & STATE_NEXT .EQ. S_NOLCBCONTIG38 .OR. + & STATE_NEXT .EQ. S_NOLCBNOCONTIG38) THEN + IF ( KEEP216.eq.3) THEN + WRITE(*,*) "Internal error 2 in DMUMPS_94" + ENDIF + IF (RBEGCONTIG > 0_8) GOTO 25 + CALL DMUMPS_629 + & (IW,LIW,IXXP,ICURRENT,NEXT, RCURRENT,ISIZE2SHIFT) + IF (IBEGCONTIG < 0 ) THEN + IBEGCONTIG=ICURRENT+IW(ICURRENT+XXI)-1 + ENDIF + CALL DMUMPS_628(IW(ICURRENT), + & LIW-ICURRENT+1, + & FREE_IN_REC, + & XSIZE) + IF (STATE_NEXT .EQ. S_NOLCBNOCONTIG) THEN + CALL DMUMPS_627(A,LA,RCURRENT, + & IW(ICURRENT+XSIZE+2), + & IW(ICURRENT+XSIZE), + & IW(ICURRENT+XSIZE)+IW(ICURRENT+XSIZE+3), 0, + & IW(ICURRENT+XXS),RSIZE2SHIFT) + ELSE IF (STATE_NEXT .EQ. S_NOLCBNOCONTIG38) THEN + CALL DMUMPS_627(A,LA,RCURRENT, + & IW(ICURRENT+XSIZE+2), + & IW(ICURRENT+XSIZE), + & IW(ICURRENT+XSIZE)+IW(ICURRENT+XSIZE+3), + & IW(ICURRENT+XSIZE+4)-IW(ICURRENT+XSIZE+3), + & IW(ICURRENT+XXS),RSIZE2SHIFT) + ELSE IF (RSIZE2SHIFT .GT.0_8) THEN + RBEG2SHIFT = RCURRENT + FREE_IN_REC + CALL MUMPS_729(RCURRENT_SIZE, IW(ICURRENT+XXR)) + REND2SHIFT = RCURRENT + RCURRENT_SIZE - 1_8 + CALL DMUMPS_631(A, LA, + & RBEG2SHIFT, REND2SHIFT, + & RSIZE2SHIFT) + ENDIF + INODE=IW(ICURRENT+XXN) + IF (ISIZE2SHIFT.NE.0) THEN + PTRIST(STEP(INODE))=PTRIST(STEP(INODE))+ISIZE2SHIFT + ENDIF + PTRAST(STEP(INODE))=PTRAST(STEP(INODE))+RSIZE2SHIFT+ + & FREE_IN_REC + CALL MUMPS_724(IW(ICURRENT+XXR),FREE_IN_REC) + IF (STATE_NEXT.EQ.S_NOLCBCONTIG.OR. + & STATE_NEXT.EQ.S_NOLCBNOCONTIG) THEN + IW(ICURRENT+XXS)=S_NOLCLEANED + ELSE + IW(ICURRENT+XXS)=S_NOLCLEANED38 + ENDIF + RSIZE2SHIFT=RSIZE2SHIFT+FREE_IN_REC + RBEGCONTIG=-9999_8 + IF (NEXT.EQ.TOP_OF_STACK) THEN + GOTO 20 + ELSE + STATE_NEXT=IW(NEXT+XXS) + ENDIF + GOTO 30 + ENDIF + IF (IBEGCONTIG.GT.0) THEN + GOTO 20 + ENDIF + 40 CONTINUE + IF (STATE_NEXT == S_FREE) THEN + ICURRENT = NEXT + CALL MUMPS_729( RCURRENT_SIZE, IW(ICURRENT + XXR) ) + ISIZE2SHIFT = ISIZE2SHIFT + IW(ICURRENT+XXI) + RSIZE2SHIFT = RSIZE2SHIFT + RCURRENT_SIZE + RCURRENT = RCURRENT - RCURRENT_SIZE + NEXT=IW(ICURRENT+XXP) + IF (NEXT.EQ.TOP_OF_STACK) THEN + WRITE(*,*) "Internal error 1 in DMUMPS_94" + CALL MUMPS_ABORT() + ENDIF + STATE_NEXT = IW(NEXT+XXS) + GOTO 40 + ENDIF + GOTO 10 + 100 CONTINUE + IWPOSCB = IWPOSCB + ISIZE2SHIFT + LRLU = LRLU + RSIZE2SHIFT + IPTRLU = IPTRLU + RSIZE2SHIFT + RETURN + END SUBROUTINE DMUMPS_94 + SUBROUTINE DMUMPS_632(IREC, IW, LIW, + & ISIZEHOLE, RSIZEHOLE) + IMPLICIT NONE + INTEGER, intent(in) :: IREC, LIW + INTEGER, intent(in) :: IW(LIW) + INTEGER, intent(out):: ISIZEHOLE + INTEGER(8), intent(out) :: RSIZEHOLE + INTEGER IRECLOC + INTEGER(8) :: RECLOC_SIZE + INCLUDE 'mumps_headers.h' + ISIZEHOLE=0 + RSIZEHOLE=0_8 + IRECLOC = IREC + IW( IREC+XXI ) + 10 CONTINUE + CALL MUMPS_729(RECLOC_SIZE, IW(IRECLOC+XXR)) + IF (IW(IRECLOC+XXS).EQ.S_FREE) THEN + ISIZEHOLE=ISIZEHOLE+IW(IRECLOC+XXI) + RSIZEHOLE=RSIZEHOLE+RECLOC_SIZE + IRECLOC=IRECLOC+IW(IRECLOC+XXI) + GOTO 10 + ENDIF + RETURN + END SUBROUTINE DMUMPS_632 + SUBROUTINE DMUMPS_627(A, LA, RCURRENT, + & NROW, NCB, LD, NELIM, NODESTATE, ISHIFT) + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER LD, NROW, NCB, NELIM, NODESTATE + INTEGER(8) :: ISHIFT + INTEGER(8) :: LA, RCURRENT + DOUBLE PRECISION A(LA) + INTEGER I,J + INTEGER(8) :: IOLD,INEW + LOGICAL NELIM_ROOT + NELIM_ROOT=.TRUE. + IF (NODESTATE.EQ. S_NOLCBNOCONTIG) THEN + NELIM_ROOT=.FALSE. + IF (NELIM.NE.0) THEN + WRITE(*,*) "Internal error 1 IN DMUMPS_627" + CALL MUMPS_ABORT() + ENDIF + ELSE IF (NODESTATE .NE. S_NOLCBNOCONTIG38) THEN + WRITE(*,*) "Internal error 2 in DMUMPS_627" + & ,NODESTATE + CALL MUMPS_ABORT() + ENDIF + IF (ISHIFT .LT.0_8) THEN + WRITE(*,*) "Internal error 3 in DMUMPS_627",ISHIFT + CALL MUMPS_ABORT() + ENDIF + IF (NELIM_ROOT) THEN + IOLD=RCURRENT+int(LD,8)*int(NROW,8)+int(NELIM-1-NCB,8) + ELSE + IOLD = RCURRENT+int(LD,8)*int(NROW,8)-1_8 + ENDIF + INEW = RCURRENT+int(LD,8)*int(NROW,8)+ISHIFT-1_8 + DO I = NROW, 1, -1 + IF (I.EQ.NROW .AND. ISHIFT.EQ.0_8.AND. + & .NOT. NELIM_ROOT) THEN + IOLD=IOLD-int(LD,8) + INEW=INEW-int(NCB,8) + CYCLE + ENDIF + IF (NELIM_ROOT) THEN + DO J=1,NELIM + A( INEW ) = A( IOLD + int(- J + 1,8)) + INEW = INEW - 1_8 + ENDDO + ELSE + DO J=1, NCB + A( INEW ) = A( IOLD + int(- J + 1, 8)) + INEW = INEW - 1_8 + ENDDO + ENDIF + IOLD = IOLD - int(LD,8) + ENDDO + IF (NELIM_ROOT) THEN + NODESTATE=S_NOLCBCONTIG38 + ELSE + NODESTATE=S_NOLCBCONTIG + ENDIF + RETURN + END SUBROUTINE DMUMPS_627 + SUBROUTINE DMUMPS_700(BUFR,LBUFR, + & LBUFR_BYTES, + & root, N, IW, LIW, A, LA, + & NBPROCFILS, LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, + & COMP, LRLUS, IPOOL, LPOOL, LEAF, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, + & ITLOC, RHS_MUMPS, + & ND,PROCNODE_STEPS,SLAVEF ) + USE DMUMPS_LOAD + USE DMUMPS_OOC + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC ) :: root + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER LBUFR, LBUFR_BYTES, N, LIW, + & IWPOS, IWPOSCB, COMP, COMM, COMM_LOAD, IFLAG, + & IERROR + INTEGER LPOOL, LEAF + INTEGER IPOOL( LEAF ) + INTEGER PTRIST(KEEP(28)) + INTEGER PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)), ITLOC( N+KEEP(253) ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER BUFR( LBUFR_BYTES ), NBPROCFILS( KEEP(28) ) + INTEGER IW( LIW ) + INTEGER ND(KEEP(28)), PROCNODE_STEPS(KEEP(28)),SLAVEF + DOUBLE PRECISION A( LA ) + INTEGER MYID + INTEGER FILS( N ), PTRAIW(N), PTRARW( N ) + INTEGER INTARR(max(1,KEEP(14))) + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER POSITION, LOCAL_M, LOCAL_N, LREQI + INTEGER(8) :: LREQA, POS_ROOT + INTEGER NSUBSET_ROW, NSUBSET_COL, IROOT, ISON, NSUBSET_COL_EFF + INTEGER NSUPCOL_EFF + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INTEGER NSUPROW, NSUPCOL, BBPCBP + INCLUDE 'mumps_headers.h' + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & ISON, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUBSET_ROW, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUPROW, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUBSET_COL, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUPCOL, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, MPI_INTEGER, + & COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & BBPCBP, 1, MPI_INTEGER, + & COMM, IERR ) + IF (BBPCBP .EQ. 1) THEN + NSUBSET_COL_EFF = NSUBSET_COL - NSUPCOL + NSUPCOL_EFF = 0 + ELSE + NSUBSET_COL_EFF = NSUBSET_COL + NSUPCOL_EFF = NSUPCOL + ENDIF + IROOT = KEEP( 38 ) + IF ( PTRIST( STEP(IROOT) ) .NE. 0 .OR. + & PTLUST_S( STEP(IROOT)) .NE. 0 ) THEN + IF (NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. NSUBSET_ROW + & - NSUPROW .OR. NSUBSET_ROW - NSUPROW.EQ.0 .OR. + & NSUBSET_COL_EFF .EQ. 0)THEN + NBPROCFILS(STEP(IROOT)) = NBPROCFILS(STEP(IROOT))-1 + IF ( NBPROCFILS( STEP(IROOT) ) .eq. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + CALL DMUMPS_681(IERR) + ELSEIF (KEEP(201).EQ.2) THEN + CALL DMUMPS_580(IERR) + ENDIF + CALL DMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), + & STEP, IROOT + N) + IF (KEEP(47) .GE. 3) THEN + CALL DMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + ENDIF + ENDIF + ELSE + IF (NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. + & NSUBSET_ROW - NSUPROW .OR. + & NSUBSET_ROW - NSUPROW.EQ.0 .OR. + & NSUBSET_COL_EFF .EQ. 0)THEN + NBPROCFILS(STEP( IROOT ) ) = -1 + ENDIF + IF (KEEP(60) == 0) THEN + CALL DMUMPS_284( root, IROOT, N, + & IW, LIW, A, LA, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + IF ( IFLAG .LT. 0 ) RETURN + ELSE + PTRIST(STEP(IROOT)) = -55555 + ENDIF + END IF + IF (KEEP(60) .EQ.0) THEN + IF ( PTRIST(STEP(IROOT)) .GE. 0 ) THEN + IF ( PTRIST(STEP(IROOT)) .NE. 0 ) THEN + LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) ) + LOCAL_M = IW( PTRIST(STEP( IROOT )) + 1 + KEEP(IXSZ)) + POS_ROOT = PAMASTER(STEP( IROOT )) + ELSE + LOCAL_N = IW( PTLUST_S(STEP( IROOT ) ) + 1 + KEEP(IXSZ)) + LOCAL_M = IW( PTLUST_S(STEP( IROOT ) ) + 2 + KEEP(IXSZ)) + POS_ROOT = PTRFAC(IW(PTLUST_S(STEP(IROOT))+4+ + & KEEP(IXSZ))) + END IF + ENDIF + ELSE + LOCAL_M = root%SCHUR_LLD + LOCAL_N = root%SCHUR_NLOC + ENDIF + IF ( (BBPCBP.EQ.1).AND. (NBROWS_ALREADY_SENT.EQ.0).AND. + & (min(NSUPROW, NSUPCOL) .GT. 0) + & ) THEN + LREQI = NSUPROW+NSUPCOL + LREQA = int(NSUPROW,8) * int(NSUPCOL,8) + IF ( (LREQA.NE.0_8) .AND. + & (PTRIST(STEP(IROOT)).LT.0).AND. + & KEEP(60)==0) THEN + WRITE(*,*) ' Error in DMUMPS_700' + CALL MUMPS_ABORT() + ENDIF + CALL DMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A, LA, + & LRLU, IPTRLU, IWPOS, IWPOSCB, PTRIST, + & PTRAST, STEP, PIMASTER, PAMASTER, + & LREQI, LREQA, -1234, S_NOTFREE, .FALSE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IWPOSCB + 1 ), LREQI, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A( IPTRLU + 1_8 ), int(LREQA), + & MPI_DOUBLE_PRECISION, COMM, IERR ) + CALL DMUMPS_38( NSUPROW, NSUPCOL, + & IW( IWPOSCB + 1 ), + & IW( IWPOSCB + NSUPROW + 1 ), NSUPCOL, + & A( IPTRLU + 1_8 ), + & A( 1 ), + & LOCAL_M, LOCAL_N, + & root%RHS_ROOT(1,1), root%RHS_NLOC, + & 1) + IWPOSCB = IWPOSCB + LREQI + IPTRLU = IPTRLU + LREQA + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU) + ENDIF + LREQI = NBROWS_PACKET + NSUBSET_COL_EFF + LREQA = int(NBROWS_PACKET,8) * int(NSUBSET_COL_EFF,8) + IF ( (LREQA.NE.0_8) .AND. + & (PTRIST(STEP(IROOT)).LT.0).AND. + & KEEP(60)==0) THEN + WRITE(*,*) ' Error in DMUMPS_700' + CALL MUMPS_ABORT() + ENDIF + IF (LREQA.NE.0_8) THEN + CALL DMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A, LA, + & LRLU, IPTRLU, IWPOS, IWPOSCB, PTRIST, + & PTRAST, STEP, PIMASTER, PAMASTER, + & LREQI, LREQA, -1234, S_NOTFREE, .FALSE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IWPOSCB + 1 ), LREQI, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A( IPTRLU + 1_8 ), int(LREQA), + & MPI_DOUBLE_PRECISION, COMM, IERR ) + IF (KEEP(60).EQ.0) THEN + CALL DMUMPS_38( NBROWS_PACKET, NSUBSET_COL_EFF, + & IW( IWPOSCB + 1 ), + & IW( IWPOSCB + NBROWS_PACKET + 1 ), + & NSUPCOL_EFF, + & A( IPTRLU + 1_8 ), + & A( POS_ROOT ), LOCAL_M, LOCAL_N, + & root%RHS_ROOT(1,1), root%RHS_NLOC, + & 0) + ELSE + CALL DMUMPS_38( NBROWS_PACKET, NSUBSET_COL_EFF, + & IW( IWPOSCB + 1 ), + & IW( IWPOSCB + NBROWS_PACKET + 1 ), + & NSUPCOL_EFF, + & A( IPTRLU + 1_8 ), + & root%SCHUR_POINTER(1), + & root%SCHUR_LLD , root%SCHUR_NLOC, + & root%RHS_ROOT(1,1), root%RHS_NLOC, + & 0) + ENDIF + IWPOSCB = IWPOSCB + LREQI + IPTRLU = IPTRLU + LREQA + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU) + ENDIF + RETURN + END SUBROUTINE DMUMPS_700 + SUBROUTINE DMUMPS_762(PIV, DETER, NEXP) + IMPLICIT NONE + DOUBLE PRECISION, intent(in) :: PIV + DOUBLE PRECISION, intent(inout) :: DETER + INTEGER, intent(inout) :: NEXP + DETER=DETER*fraction(PIV) + NEXP=NEXP+exponent(PIV)+exponent(DETER) + DETER=fraction(DETER) + RETURN + END SUBROUTINE DMUMPS_762 + SUBROUTINE DMUMPS_761(PIV, DETER, NEXP) + IMPLICIT NONE + DOUBLE PRECISION, intent(in) :: PIV + DOUBLE PRECISION, intent(inout) :: DETER + INTEGER, intent(inout) :: NEXP + DETER=DETER*fraction(PIV) + NEXP=NEXP+exponent(PIV)+exponent(DETER) + DETER=fraction(DETER) + RETURN + END SUBROUTINE DMUMPS_761 + SUBROUTINE DMUMPS_763(BLOCK_SIZE,IPIV, + & MYROW, MYCOL, NPROW, NPCOL, + & A, LOCAL_M, LOCAL_N, N, MYID, + & DETER,NEXP,SYM) + IMPLICIT NONE + INTEGER, intent (in) :: SYM + INTEGER, intent (inout) :: NEXP + DOUBLE PRECISION, intent (inout) :: DETER + INTEGER, intent (in) :: BLOCK_SIZE, NPROW, NPCOL, + & LOCAL_M, LOCAL_N, N + INTEGER, intent (in) :: MYROW, MYCOL, MYID, IPIV(LOCAL_M) + DOUBLE PRECISION, intent(in) :: A(*) + INTEGER I,IMX,DI,NBLOCK,IBLOCK,ILOC,JLOC, + & ROW_PROC,COL_PROC, K + DI = LOCAL_M + 1 + NBLOCK = ( N - 1 ) / BLOCK_SIZE + DO IBLOCK = 0, NBLOCK + ROW_PROC = mod( IBLOCK, NPROW ) + IF ( MYROW.EQ.ROW_PROC ) THEN + COL_PROC = mod( IBLOCK, NPCOL ) + IF ( MYCOL.EQ.COL_PROC ) THEN + ILOC = ( IBLOCK / NPROW ) * BLOCK_SIZE + JLOC = ( IBLOCK / NPCOL ) * BLOCK_SIZE + I = ILOC + JLOC * LOCAL_M + 1 + IMX = min(ILOC+BLOCK_SIZE,LOCAL_M) + & + (min(JLOC+BLOCK_SIZE,LOCAL_N)-1)*LOCAL_M + & + 1 + K=1 + DO WHILE ( I .LT. IMX ) + CALL DMUMPS_762(A(I),DETER,NEXP) + IF (SYM.NE.1) THEN + IF (IPIV(ILOC+K) .NE. IBLOCK*BLOCK_SIZE+K) THEN + DETER = -DETER + ENDIF + ENDIF + K = K + 1 + I = I + DI + END DO + END IF + END IF + END DO + RETURN + END SUBROUTINE DMUMPS_763 + SUBROUTINE DMUMPS_764( + & COMM, DETER_IN, NEXP_IN, + & DETER_OUT, NEXP_OUT, NPROCS) + IMPLICIT NONE + INTEGER, intent(in) :: COMM, NPROCS + DOUBLE PRECISION, intent(in) :: DETER_IN + INTEGER,intent(in) :: NEXP_IN + DOUBLE PRECISION,intent(out):: DETER_OUT + INTEGER,intent(out):: NEXP_OUT + INTEGER :: IERR_MPI + EXTERNAL DMUMPS_771 + INTEGER TWO_SCALARS_TYPE, DETERREDUCE_OP + DOUBLE PRECISION :: INV(2) + DOUBLE PRECISION :: OUTV(2) + INCLUDE 'mpif.h' + IF (NPROCS .EQ. 1) THEN + DETER_OUT = DETER_IN + NEXP_OUT = NEXP_IN + RETURN + ENDIF + CALL MPI_TYPE_CONTIGUOUS(2, MPI_DOUBLE_PRECISION, + & TWO_SCALARS_TYPE, + & IERR_MPI) + CALL MPI_TYPE_COMMIT(TWO_SCALARS_TYPE, IERR_MPI) + CALL MPI_OP_CREATE(DMUMPS_771, + & .TRUE., + & DETERREDUCE_OP, + & IERR_MPI) + INV(1)=DETER_IN + INV(2)=dble(NEXP_IN) + CALL MPI_ALLREDUCE( INV, OUTV, 1, TWO_SCALARS_TYPE, + & DETERREDUCE_OP, COMM, IERR_MPI) + CALL MPI_OP_FREE(DETERREDUCE_OP, IERR_MPI) + CALL MPI_TYPE_FREE(TWO_SCALARS_TYPE, IERR_MPI) + DETER_OUT = OUTV(1) + NEXP_OUT = int(OUTV(2)) + RETURN + END SUBROUTINE DMUMPS_764 + SUBROUTINE DMUMPS_771(INV, INOUTV, NEL, DATATYPE) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NEL, DATATYPE + DOUBLE PRECISION, INTENT(IN) :: INV ( 2 * NEL ) + DOUBLE PRECISION, INTENT(INOUT) :: INOUTV ( 2 * NEL ) + INTEGER I, TMPEXPIN, TMPEXPINOUT + DO I = 1, NEL + TMPEXPIN = int(INV (I*2)) + TMPEXPINOUT = int(INOUTV(I*2)) + CALL DMUMPS_762(INV(I*2-1), + & INOUTV(I*2-1), + & TMPEXPINOUT) + TMPEXPINOUT = TMPEXPINOUT + TMPEXPIN + INOUTV(I*2) = dble(TMPEXPINOUT) + ENDDO + RETURN + END SUBROUTINE DMUMPS_771 + SUBROUTINE DMUMPS_765(DETER, NEXP) + IMPLICIT NONE + INTEGER, intent (inout) :: NEXP + DOUBLE PRECISION, intent (inout) :: DETER + DETER=DETER*DETER + NEXP=NEXP+NEXP + RETURN + END SUBROUTINE DMUMPS_765 + SUBROUTINE DMUMPS_766(DETER, NEXP) + IMPLICIT NONE + INTEGER, intent (inout) :: NEXP + DOUBLE PRECISION, intent (inout) :: DETER + DETER=1.0D0/DETER + NEXP=-NEXP + RETURN + END SUBROUTINE DMUMPS_766 + SUBROUTINE DMUMPS_767(DETER, N, VISITED, PERM) + IMPLICIT NONE + DOUBLE PRECISION, intent(inout) :: DETER + INTEGER, intent(in) :: N + INTEGER, intent(inout) :: VISITED(N) + INTEGER, intent(in) :: PERM(N) + INTEGER I, J, K + K = 0 + DO I = 1, N + IF (VISITED(I) .GT. N) THEN + VISITED(I)=VISITED(I)-N-N-1 + CYCLE + ENDIF + J = PERM(I) + DO WHILE (J.NE.I) + VISITED(J) = VISITED(J) + N + N + 1 + K = K + 1 + J = PERM(J) + ENDDO + ENDDO + IF (mod(K,2).EQ.1) THEN + DETER = -DETER + ENDIF + RETURN + END SUBROUTINE DMUMPS_767 + SUBROUTINE DMUMPS_224(NFRONT,NASS,IBEGKJI, LPIV, TIPIV, + & N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IFLAG,IOLDPS,POSELT,UU,SEUIL,KEEP,KEEP8, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER IBEGKJI, LPIV + INTEGER TIPIV(LPIV) + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV,NOFFW + DOUBLE PRECISION UU, SEUIL + INTEGER IW(LIW) + INTEGER IOLDPS + INTEGER(8) :: POSELT + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U + DOUBLE PRECISION SWOP + INTEGER(8) :: APOS, IDIAG + INTEGER(8) :: J1, J2, JJ, J3_8 + INTEGER(8) :: NFRONT8 + INTEGER ILOC + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + DOUBLE PRECISION RZERO, RMAX, AMROW, ONE + DOUBLE PRECISION PIVNUL + DOUBLE PRECISION FIXA, CSEUIL + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,JMAX,J3,ISW,ISWPS1 + INTEGER ISWPS2,KSW, HF + INCLUDE 'mumps_headers.h' + INTEGER DMUMPS_IXAMAX + INTRINSIC max + DATA RZERO /0.0D0/ + DATA ONE /1.0D0/ + INTEGER I_PIVRPTR_L, I_PIVR_L, NBPANELS_L + INTEGER I_PIVRPTR_U, I_PIVR_U, NBPANELS_U + INTEGER XSIZE + PIVNUL = DKEEP(1) + FIXA = DKEEP(2) + CSEUIL = SEUIL + NFRONT8=int(NFRONT,8) + XSIZE = KEEP(IXSZ) + NPIV = IW(IOLDPS+1+XSIZE) + HF = 6 + IW(IOLDPS+5+XSIZE)+XSIZE + NPIVP1 = NPIV + 1 + IF (KEEP(201).EQ.1) THEN + CALL DMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + CALL DMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + ENDIF + ILOC = NPIVP1 - IBEGKJI + 1 + TIPIV(ILOC) = ILOC + NASSW = iabs(IW(IOLDPS+3+XSIZE)) + IF(INOPV .EQ. -1) THEN + APOS = POSELT + NFRONT8*int(NPIVP1-1,8) + int(NPIV,8) + IDIAG = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF (dble(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + KEEP(98) = KEEP(98)+1 + ELSE IF (KEEP(258) .NE. 0) THEN + CALL DMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL DMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL DMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + NFRONT8*int(IPIV-1,8) + int(NPIV,8) + JMAX = 1 + IF (UU.GT.RZERO) GO TO 340 + IF (A(APOS).EQ.ZERO) GO TO 630 + GO TO 380 + 340 AMROW = RZERO + J1 = APOS + J2 = APOS +int(- NPIV + NASS - 1,8) + J3 = NASS -NPIV + JMAX = DMUMPS_IXAMAX(J3,A(J1),1) + JJ = int(JMAX,8) + J1 - 1_8 + AMROW = abs(A(JJ)) + RMAX = AMROW + J1 = J2 + 1_8 + J2 = APOS +int(- NPIV + NFRONT - KEEP(253)- 1,8) + IF (J2.LT.J1) GO TO 370 + DO 360 JJ=J1,J2 + RMAX = max(abs(A(JJ)),RMAX) + 360 CONTINUE + 370 IDIAG = APOS + int(IPIV - NPIVP1,8) + IF (RMAX.LE.PIVNUL) THEN + KEEP(109) = KEEP(109)+1 + ISW = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6+KEEP(IXSZ)+ + & IW(IOLDPS+5+KEEP(IXSZ))+IPIV-NPIVP1 + PIVNUL_LIST(KEEP(109)) = IW(ISW) + IF(dble(FIXA).GT.RZERO) THEN + IF(dble(A(IDIAG)) .GE. RZERO) THEN + A(IDIAG) = FIXA + ELSE + A(IDIAG) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = APOS +int(- NPIV + NFRONT - KEEP(253) - 1,8) + DO JJ=J1,J2 + A(JJ)= ZERO + ENDDO + A(IDIAG) = -FIXA + ENDIF + JMAX = IPIV - NPIV + GOTO 385 + ENDIF + IF (abs(A(IDIAG)).GT.max(UU*RMAX,SEUIL)) THEN + JMAX = IPIV - NPIV + GO TO 380 + ENDIF + IF (AMROW.LE.max(UU*RMAX,SEUIL)) GO TO 460 + NOFFW = NOFFW + 1 + 380 CONTINUE + IF (KEEP(258).NE.0) THEN + CALL DMUMPS_762( A(APOS+int(JMAX-1,8)), + & DKEEP(6), + & KEEP(259)) + ENDIF + 385 CONTINUE + IF (IPIV.EQ.NPIVP1) GO TO 400 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8)*NFRONT8 + J2 = J1 + NFRONT8 - 1_8 + J3_8 = POSELT + int(IPIV-1,8)*NFRONT8 + DO 390 JJ=J1,J2 + SWOP = A(JJ) + A(JJ) = A(J3_8) + A(J3_8) = SWOP + J3_8 = J3_8 + 1_8 + 390 CONTINUE + ISWPS1 = IOLDPS + HF - 1 + NPIVP1 + ISWPS2 = IOLDPS + HF - 1 + IPIV + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + 400 IF (JMAX.EQ.1) GO TO 420 + KEEP(260)=-KEEP(260) + TIPIV(ILOC) = ILOC + JMAX - 1 + J1 = POSELT + int(NPIV,8) + J2 = POSELT + int(NPIV + JMAX - 1,8) + DO 410 KSW=1,NASS + SWOP = A(J1) + A(J1) = A(J2) + A(J2) = SWOP + J1 = J1 + NFRONT8 + J2 = J2 + NFRONT8 + 410 CONTINUE + ISWPS1 = IOLDPS + HF - 1 + NFRONT + NPIV + 1 + ISWPS2 = IOLDPS + HF - 1 + NFRONT + NPIV + JMAX + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + GO TO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 430 + 630 CONTINUE + IFLAG = -10 + WRITE(*,*) 'NIV2:Detected 0 pivot, INODE,NPIV=',INODE,NPIV + GOTO 430 + 420 CONTINUE + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL DMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, IPIV, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL DMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIV+JMAX, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + 430 CONTINUE + RETURN + END SUBROUTINE DMUMPS_224 + SUBROUTINE DMUMPS_294( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & IW, LIW, + & IOLDPS, POSELT, A, LA, LDA_FS, + & IBEGKJI, IEND, TIPIV, LPIV, LASTBL, NB_BLOC_FAC, + & + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE DMUMPS_COMM_BUFFER + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mpif.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, INODE, FPERE, LIW, IBEGKJI, IEND, LPIV, + & IOLDPS, LDA_FS, NB_BLOC_FAC + INTEGER(8) :: POSELT, LA + INTEGER IW(LIW), TIPIV(LPIV) + LOGICAL LASTBL + DOUBLE PRECISION A(LA) + INTEGER COMM, MYID, LBUFR, LBUFR_BYTES + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NBFIN, IFLAG, IERROR, LEAF, LPOOL, + & SLAVEF, ICNTL(40) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB, COMP + INTEGER BUFR( LBUFR ), IPOOL(LPOOL), + & ITLOC(N+KEEP(253)), FILS(N), + & PTRARW(LPTRAR), PTRAIW(LPTRAR), + & ND( KEEP(28) ), FRERE( KEEP(28) ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER(8) :: PTRAST (KEEP(28)) + INTEGER(8) :: PTRFAC (KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), + & NBPROCFILS(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + EXTERNAL DMUMPS_329 + INCLUDE 'mumps_headers.h' + INTEGER(8) :: APOS, LREQA + INTEGER NPIV, NCOL, PDEST, NSLAVES + INTEGER IERR, LREQI + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + DOUBLE PRECISION FLOP1,FLOP2 + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + IF (NSLAVES.EQ.0) THEN + WRITE(6,*) ' ERROR 1 in DMUMPS_294 ' + CALL MUMPS_ABORT() + ENDIF + NPIV = IEND - IBEGKJI + 1 + NCOL = LDA_FS - IBEGKJI + 1 + APOS = POSELT + int(LDA_FS,8)*int(IBEGKJI-1,8) + + & int(IBEGKJI - 1,8) + IF (IBEGKJI > 0) THEN + CALL MUMPS_511( LDA_FS, IBEGKJI-1, LPIV, + & KEEP(50),2,FLOP1) + ELSE + FLOP1=0.0D0 + ENDIF + CALL MUMPS_511( LDA_FS, IEND, LPIV, + & KEEP(50),2,FLOP2) + FLOP2 = FLOP1 - FLOP2 + CALL DMUMPS_190(1, .FALSE., FLOP2, KEEP,KEEP8) + IF ((NPIV.GT.0) .OR. + & ((NPIV.EQ.0).AND.(LASTBL)) ) THEN + PDEST = IOLDPS + 6 + KEEP(IXSZ) + IERR = -1 + IF ( NPIV .NE. 0 ) THEN + NB_BLOC_FAC = NB_BLOC_FAC + 1 + END IF + DO WHILE (IERR .EQ.-1) + CALL DMUMPS_65( INODE, LDA_FS, NCOL, + & NPIV, FPERE, LASTBL, TIPIV, A(APOS), + & IW(PDEST), NSLAVES, KEEP(50), NB_BLOC_FAC, + & COMM, IERR ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF (MESSAGE_RECEIVED) POSELT = PTRAST(STEP(INODE)) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2 .OR. IERR.EQ.-3 ) THEN + IF (IERR.EQ.-2) IFLAG = -17 + IF (IERR.EQ.-3) IFLAG = -20 + LREQA = int(NCOL,8)*int(NPIV,8) + LREQI = NPIV + 6 + 2*NSLAVES + CALL MUMPS_731( + & int(LREQI,8) * int(KEEP(34),8) + LREQA * int(KEEP(35),8), + & IERROR) + GOTO 300 + ENDIF + ENDIF + GOTO 500 + 300 CONTINUE + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + 500 RETURN + END SUBROUTINE DMUMPS_294 + SUBROUTINE DMUMPS_273( ROOT, + & INODE, NELIM, NSLAVES, ROW_LIST, + & COL_LIST, SLAVE_LIST, + & + & PROCNODE_STEPS, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & ITLOC, RHS_MUMPS, COMP, + & IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8, + & COMM,COMM_LOAD,FILS,ND ) + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC) :: ROOT + INTEGER INODE, NELIM, NSLAVES + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER ROW_LIST(*), COL_LIST(*), + & SLAVE_LIST(*) + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER PTRIST( KEEP(28) ), PTLUST_S(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), ITLOC( N + KEEP(253) ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER IFLAG, IERROR + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF + INTEGER COMM,COMM_LOAD,ND(KEEP(28)),FILS(N) + INTEGER IROOT, TYPE_INODE, DEB_ROW, DEB_COL, + & NOINT + INTEGER(8) :: NOREAL + INCLUDE 'mumps_headers.h' + INCLUDE 'mumps_tags.h' + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + IROOT = KEEP(38) + NSTK_S(STEP(IROOT))= NSTK_S(STEP(IROOT)) - 1 + KEEP(42) = KEEP(42) + NELIM + TYPE_INODE= MUMPS_330(PROCNODE_STEPS(STEP(INODE)), SLAVEF) + IF (TYPE_INODE.EQ.1) THEN + IF (NELIM.EQ.0) THEN + KEEP(41) = KEEP(41) + 1 + ELSE + KEEP(41) = KEEP(41) + 3 + ENDIF + ELSE + IF (NELIM.EQ.0) THEN + KEEP(41) = KEEP(41) + NSLAVES + ELSE + KEEP(41) = KEEP(41) + 2*NSLAVES + 1 + ENDIF + ENDIF + IF (NELIM.EQ.0) THEN + PIMASTER(STEP(INODE)) = 0 + ELSE + NOINT = 6 + NSLAVES + NELIM + NELIM + KEEP(IXSZ) + NOREAL= 0_8 + CALL DMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, + & NOINT, NOREAL, INODE, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) THEN + WRITE(*,*) ' Failure in int space allocation in CB area ', + & ' during assembly of root : DMUMPS_273', + & ' size required was :', NOINT, + & 'INODE=',INODE,' NELIM=',NELIM, ' NSLAVES=', NSLAVES + RETURN + ENDIF + PIMASTER(STEP( INODE )) = IWPOSCB + 1 + PAMASTER(STEP( INODE )) = IPTRLU + 1_8 + IW( IWPOSCB + 1+KEEP(IXSZ) ) = 2*NELIM + IW( IWPOSCB + 2+KEEP(IXSZ) ) = NELIM + IW( IWPOSCB + 3+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 4+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 5+KEEP(IXSZ) ) = 1 + IW( IWPOSCB + 6+KEEP(IXSZ) ) = NSLAVES + IF (NSLAVES.GT.0) THEN + IW( IWPOSCB+7+KEEP(IXSZ):IWPOSCB+7+KEEP(IXSZ)+NSLAVES-1) = + & SLAVE_LIST(1:NSLAVES) + ENDIF + DEB_ROW = IWPOSCB+7+NSLAVES+KEEP(IXSZ) + IW(DEB_ROW : DEB_ROW+NELIM -1) = ROW_LIST(1:NELIM) + DEB_COL = DEB_ROW + NELIM + IW(DEB_COL : DEB_COL+NELIM -1) = COL_LIST(1:NELIM) + ENDIF + IF (NSTK_S(STEP(IROOT)) .EQ. 0 ) THEN + CALL DMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IROOT ) + IF (KEEP(47) .GE. 3) THEN + CALL DMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + RETURN + END SUBROUTINE DMUMPS_273 + SUBROUTINE DMUMPS_363(N,FRERE, STEP, FILS, + & NA,LNA,NE,ND, DAD, LDAD, USE_DAD, + & NSTEPS,PERM,SYM,INFO,LP,K215,K234,K55, + & PROCNODE,SLAVEF, PEAK,SBTR_WHICH_M + & ) + IMPLICIT NONE + INTEGER N,PERM,SYM, NSTEPS, LNA, LP,LDAD + INTEGER FRERE(NSTEPS), FILS(N), STEP(N) + INTEGER NA(LNA), NE(NSTEPS), ND(NSTEPS) + INTEGER K215,K234,K55 + INTEGER DAD(LDAD) + LOGICAL USE_DAD + INTEGER INFO(40) + INTEGER SLAVEF,PROCNODE(NSTEPS) + INTEGER :: SBTR_WHICH_M + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + DOUBLE PRECISION PEAK + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: COST_TRAV + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH + INTEGER IFATH,IN,NSTK,INODE,I,allocok,LOCAL_PERM + INTEGER(8) NCB + INTEGER(8) NELIM,NFR + INTEGER NFR4,NELIM4 + INTEGER LEAF,NBLEAF,NBROOT, SIZE_TAB + INTEGER, DIMENSION (:), ALLOCATABLE :: IPOOL,TNSTK + INTEGER, DIMENSION (:), ALLOCATABLE,TARGET :: SON,TEMP + INTEGER(8), DIMENSION (:), ALLOCATABLE :: M,M_TOTAL, fact + INTEGER(8), DIMENSION (:), ALLOCATABLE :: TAB1,TAB2 + INTEGER, DIMENSION (:), POINTER :: TAB + INTEGER dernier,fin + INTEGER cour,II + INTEGER CB_current,CB_MAX,ROOT_OF_CUR_SBTR + INTEGER(8), DIMENSION (:), ALLOCATABLE :: T1,T2 + INTEGER, DIMENSION (:), ALLOCATABLE :: RESULT + INTEGER(8) MEM_SIZE,FACT_SIZE,SUM,MEM_SEC_PERM,FACT_SIZE_T, + & MEM_SIZE_T,TOTAL_MEM_SIZE,TMP_TOTAL_MEM_SIZE,TMP_SUM, + & SIZECB, SIZECB_LASTSON + INTEGER(8) TMP8 + LOGICAL SBTR_M + INTEGER FIRST_LEAF,SIZE_SBTR + EXTERNAL MUMPS_170,MUMPS_167 + LOGICAL MUMPS_170,MUMPS_167 + DOUBLE PRECISION COST_NODE + INCLUDE 'mumps_headers.h' + TOTAL_MEM_SIZE=0_8 + ROOT_OF_CUR_SBTR=0 + IF((PERM.EQ.0).OR.(PERM.EQ.1).OR. + & (PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4).OR. + & (PERM.EQ.5).OR.(PERM.EQ.6))THEN + LOCAL_PERM=0 + ENDIF + SBTR_M=.FALSE. + MEM_SIZE=0_8 + FACT_SIZE=0_8 + IF ((PERM.LT.0 .OR. PERM.GT.7)) THEN + WRITE(*,*) "Internal Error in DMUMPS_363",PERM + CALL MUMPS_ABORT() + END IF + NBLEAF = NA(1) + NBROOT = NA(2) + IF((PERM.EQ.0).AND.(NBROOT.EQ.NBLEAF)) RETURN + IF ((PERM.NE.7).AND.(SBTR_M.OR.(PERM.EQ.2))) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + ALLOCATE(M_TOTAL(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & DMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ENDIF + ENDIF + IF(PERM.NE.7)THEN + ALLOCATE(M(NSTEPS),stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error + &in DMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ENDIF + ALLOCATE( IPOOL(NBLEAF), fact(NSTEPS),TNSTK(NSTEPS), + & stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in DMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + II=0 + DO I=1,NSTEPS + TNSTK(I) = NE(I) + IF(NE(I).GE.II) II=NE(I) + ENDDO + SIZE_TAB=max(II,NBROOT) + ALLOCATE(SON(II), TEMP(II), + & TAB1(SIZE_TAB), TAB2(SIZE_TAB), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in DMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ALLOCATE(T1(SIZE_TAB),T2(SIZE_TAB), + & RESULT(SIZE_TAB),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in DMUMPS_363' + INFO(1)=-7 + INFO(2)=SIZE_TAB + RETURN + ENDIF + IF(PERM.EQ.7) THEN + GOTO 001 + ENDIF + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + ALLOCATE(COST_TRAV(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error + & in DMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + COST_TRAV=0.0D0 + COST_NODE=0.0d0 + ENDIF + IF(NBROOT.EQ.NBLEAF)THEN + IF((PERM.NE.1).OR.(PERM.EQ.4).OR.(PERM.EQ.6))THEN + WRITE(*,*)'Internal Error in reordertree:' + WRITE(*,*)' problem with perm parameter in reordertree' + CALL MUMPS_ABORT() + ENDIF + DO I=1,NBROOT + TAB1(I)=int(ND(STEP(NA(I+2+NBLEAF))),8) + IPOOL(I)=NA(I+2+NBLEAF) + M(STEP(IPOOL(I)))=TAB1(I)*TAB1(I) + ENDDO + CALL DMUMPS_462(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4, + & RESULT,T1,T2) + GOTO 789 + ENDIF + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + ALLOCATE(DEPTH(NSTEPS),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & DMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + DEPTH=0 + NBROOT = NA(2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + fin=NBROOT + LEAF=NA(1) + 499 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IN=INODE + 4602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + GOTO 4602 + ENDIF + IN=-IN + DO I=1,NE(STEP(INODE)) + SON(I)=IN + IN=FRERE(STEP(IN)) + ENDDO + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=SON(I) + DEPTH(STEP(SON(I)))=DEPTH(STEP(INODE))+1 + SON(I)=0 + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 499 + ENDIF + fin=fin-1 + IF(fin.EQ.0) GOTO 489 + GOTO 499 + 489 CONTINUE + ENDIF + DO I=1,NSTEPS + M(I)=0_8 + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + M_TOTAL(I)=0_8 + ENDIF + ENDIF + ENDDO + DO I=1,NSTEPS + fact(I)=0_8 + ENDDO + IPOOL(1:NBLEAF)=NA(3:2+NBLEAF) + LEAF = NBLEAF + 1 + 91 CONTINUE + IF (LEAF.NE.1) THEN + LEAF = LEAF -1 + INODE = IPOOL(LEAF) + ENDIF + 96 CONTINUE + NFR = int(ND(STEP(INODE)),8) + NSTK = NE(STEP(INODE)) + NELIM4 = 0 + IN = INODE + 101 NELIM4 = NELIM4 + 1 + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 101 + NELIM=int(NELIM4,8) + IF(NE(STEP(INODE)).EQ.0) THEN + M(STEP(INODE))=NFR*NFR + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + M_TOTAL(STEP(INODE))=NFR*NFR + ENDIF + ENDIF + IF((PERM.EQ.4).OR.(PERM.EQ.3))THEN + IF(MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + DEPTH(STEP(INODE))=0 + ENDIF + ENDIF + IF ( SYM .eq. 0 ) THEN + fact(STEP(INODE))=fact(STEP(INODE))+ + & (2_8*NFR*NELIM)-(NELIM*NELIM) + ELSE + fact(STEP(INODE))=fact(STEP(INODE))+NFR*NELIM + ENDIF + IF (USE_DAD) THEN + IFATH = DAD( STEP(INODE) ) + ELSE + IN = INODE + 113 IN = FRERE(IN) + IF (IN.GT.0) GO TO 113 + IFATH = -IN + ENDIF + IF (IFATH.EQ.0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 116 + GOTO 91 + ELSE + fact(STEP(IFATH))=fact(STEP(IFATH))+fact(STEP(INODE)) + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + DEPTH(STEP(IFATH))=max(DEPTH(STEP(INODE)), + & DEPTH(STEP(IFATH))) + ENDIF + ENDIF + TNSTK(STEP(IFATH)) = TNSTK(STEP(IFATH)) - 1 + IF ( TNSTK(STEP(IFATH)) .EQ. 0 ) THEN + INODE = IFATH + IN=INODE + dernier=IN + I=1 + 5700 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + dernier=IN + I=I+1 + GOTO 5700 + ENDIF + NCB=int(ND(STEP(INODE))-I,8) + IN=-IN + IF(PERM.NE.7)THEN + DO I=1,NE(STEP(INODE)) + SON(I)=IN + TEMP(I)=IN + IF(IN.GT.0) IN=FRERE(STEP(IN)) + ENDDO + ELSE + DO I=NE(STEP(INODE)),1,-1 + SON(I)=IN + TEMP(I)=IN + IF(IN.GT.0) IN=FRERE(STEP(IN)) + ENDDO + ENDIF + NFR = int(ND(STEP(INODE)),8) + DO II=1,NE(STEP(INODE)) + TAB1(II)=0_8 + TAB2(II)=0_8 + cour=SON(II) + NELIM4=1 + 151 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 151 + ENDIF + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0)) THEN + SIZECB=(int(ND(STEP(SON(II))),8)-NELIM) + & *(int(ND(STEP(SON(II))),8)-NELIM) + ELSE + SIZECB=(int(ND(STEP(SON(II))),8)-NELIM) + & *(int(ND(STEP(SON(II))),8)- + & NELIM+1_8)/2_8 + ENDIF + IF((PERM.EQ.0).OR.(PERM.EQ.5))THEN + IF (K234 .NE. 0 .AND. K55.EQ.0 ) THEN + TMP8=NFR + TMP8=TMP8*TMP8 + TAB1(II)=max(TMP8, M(STEP(SON(II)))) - SIZECB + TAB2(II)=SIZECB + ELSE + TAB1(II)=M(STEP(SON(II)))- SIZECB + TAB2(II)=SIZECB + ENDIF + ENDIF + IF((PERM.EQ.1).OR.(PERM.EQ.6)) THEN + TAB1(II)=M(STEP(SON(II)))-SIZECB + TAB1(II)=TAB1(II)-fact(STEP(SON(II))) + TAB2(II)=SIZECB+fact(STEP(SON(II))) + ENDIF + IF(PERM.EQ.2)THEN + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + TAB1(II)=M_TOTAL(STEP(SON(II)))-SIZECB + & -fact(STEP(SON(II))) + TAB2(II)=SIZECB + ELSE + TAB1(II)=M(STEP(SON(II)))-SIZECB + TAB2(II)=SIZECB + ENDIF + ENDIF + IF(PERM.EQ.3)THEN + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + TAB1(II)=M(STEP(SON(II)))-SIZECB + TAB2(II)=SIZECB + ELSE + TAB1(II)=int(DEPTH(STEP(SON(II))),8) + TAB2(II)=M(STEP(SON(II))) + ENDIF + ENDIF + IF(PERM.EQ.4)THEN + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + TAB1(II)=M(STEP(SON(II)))- + & SIZECB-fact(STEP(SON(II))) + TAB2(II)=SIZECB + ELSE + TAB1(II)=int(DEPTH(STEP(SON(II))),8) + TAB2(II)=M(STEP(SON(II))) + ENDIF + ENDIF + ENDDO + CALL DMUMPS_462(SON,NE(STEP(INODE)),TAB1,TAB2, + & LOCAL_PERM + & ,RESULT,T1,T2) + IF(PERM.EQ.0) THEN + DO II=1,NE(STEP(INODE)) + cour=TEMP(II) + NELIM4=1 + 153 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 153 + ENDIF + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM) + ELSE + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM+1_8)/2_8 + ENDIF + TAB1(II)=SIZECB + ENDDO + CALL DMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2,3, + & RESULT,T1,T2) + ENDIF + IF(PERM.EQ.1) THEN + DO II=1,NE(STEP(INODE)) + cour=TEMP(II) + NELIM4=1 + 187 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 187 + ENDIF + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM) + ELSE + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM+1_8)/2_8 + ENDIF + TAB1(II)=SIZECB+fact(STEP(TEMP(II))) + ENDDO + CALL DMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2,3, + & RESULT,T1,T2) + ENDIF + CONTINUE + IFATH=INODE + DO II=1,2 + SUM=0_8 + FACT_SIZE=0_8 + FACT_SIZE_T=0_8 + MEM_SIZE=0_8 + MEM_SIZE_T=0_8 + CB_MAX=0 + CB_current=0 + TMP_SUM=0_8 + IF(II.EQ.1) TAB=>SON + IF(II.EQ.2) TAB=>TEMP + DO I=1,NE(STEP(INODE)) + cour=TAB(I) + NELIM4=1 + 149 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 149 + ENDIF + NELIM=int(NELIM4, 8) + NFR=int(ND(STEP(TAB(I))),8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(NFR-NELIM)*(NFR-NELIM) + ELSE + SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8 + ENDIF + MEM_SIZE=max(MEM_SIZE,(M(STEP(TAB(I)))+SUM+FACT_SIZE)) + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + MEM_SIZE_T=max(MEM_SIZE_T,(M_TOTAL(STEP(TAB(I)))+ + & SUM+ + & FACT_SIZE_T)) + FACT_SIZE_T=FACT_SIZE_T+fact(STEP(TAB(I))) + ENDIF + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & (M(STEP(TAB(I)))+SUM+FACT_SIZE)) + TMP_SUM=TMP_SUM+fact(STEP(TAB(I))) + SUM=SUM+SIZECB + SIZECB_LASTSON = SIZECB + IF((PERM.EQ.1).OR.(PERM.EQ.4))THEN + FACT_SIZE=FACT_SIZE+fact(STEP(TAB(I))) + ENDIF + ENDDO + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=NCB*NCB + ELSE + SIZECB=(NCB*(NCB+1_8))/2_8 + ENDIF + IF (K234.NE.0 .AND. K55.EQ.0) THEN + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & ( ( int(ND(STEP(IFATH)),8) + & * int(ND(STEP(IFATH)),8) ) + & + SUM-SIZECB_LASTSON+TMP_SUM ) + & ) + ELSE IF (K234.NE.0 .AND. K55.NE.0) THEN + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & ( ( int(ND(STEP(IFATH)),8) + & * int(ND(STEP(IFATH)),8) ) + & + SUM + TMP_SUM ) + & ) + ELSE + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & ( ( int(ND(STEP(IFATH)),8) + & * int(ND(STEP(IFATH)),8)) + & + max(SUM,SIZECB) + TMP_SUM ) + & ) + ENDIF + IF(II.EQ.1)THEN + TMP_TOTAL_MEM_SIZE=TOTAL_MEM_SIZE + ENDIF + IF(II.EQ.1)THEN + IF (K234.NE.0 .AND. K55.EQ.0) THEN + M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+SUM-SIZECB_LASTSON+ + & FACT_SIZE)) + ELSE IF (K234.NE.0 .AND. K55.NE.0) THEN + M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+SUM+FACT_SIZE)) + ELSE + M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+FACT_SIZE)) + ENDIF + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + M_TOTAL(STEP(IFATH))=max(MEM_SIZE_T, + & ((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+ + & FACT_SIZE_T)) + ENDIF + ENDIF + IF((II.EQ.2).AND.(PERM.EQ.1).OR.(PERM.EQ.0).OR. + & (PERM.EQ.5).OR.(PERM.EQ.6).OR. + & (.NOT.SBTR_M.OR.(SBTR_WHICH_M.NE.1)))THEN + MEM_SEC_PERM=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+FACT_SIZE)) + ENDIF + IF((PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4))THEN + MEM_SEC_PERM=huge(MEM_SEC_PERM) + ENDIF + ENDDO + IF(MEM_SEC_PERM.EQ.M(STEP(IFATH))) THEN + TAB=>TEMP + ELSE IF (MEM_SEC_PERM.LT.M(STEP(IFATH))) THEN + WRITE(*,*)'Probleme dans reorder!!!!' + CALL MUMPS_ABORT() + ELSE + TOTAL_MEM_SIZE=TMP_TOTAL_MEM_SIZE + TAB=>SON + ENDIF + DO I=NE(STEP(INODE)),1,-1 + IF(I.EQ.NE(STEP(INODE))) THEN + FILS(dernier)=-TAB(I) + dernier=TAB(I) + GOTO 222 + ENDIF + IF(I.EQ.1) THEN + FRERE(STEP(dernier))=TAB(I) + FRERE(STEP(TAB(I)))=-INODE + GOTO 222 + ENDIF + IF(I.GT.1) THEN + FRERE(STEP(dernier))=TAB(I) + dernier=TAB(I) + GOTO 222 + ENDIF + 222 CONTINUE + ENDDO + GOTO 96 + ELSE + GOTO 91 + ENDIF + 116 CONTINUE + NBROOT = NA(2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + IF (PERM.eq.1) THEN + DO I=1,NBROOT + TAB1(I)=M(STEP(NA(I+2+NBLEAF)))-fact(STEP(NA(I+2+NBLEAF))) + TAB1(I)=-TAB1(I) + ENDDO + CALL DMUMPS_462(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4, + & RESULT,T1,T2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + ENDIF + 001 CONTINUE + fin=NBROOT + LEAF=NA(1) + FIRST_LEAF=-9999 + SIZE_SBTR=0 + 999 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IN=INODE + 5602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + dernier=IN + GOTO 5602 + ENDIF + IN=-IN + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + IF(SLAVEF.NE.1)THEN + IF (USE_DAD) THEN + IFATH=DAD(INODE) + ELSE + IN = INODE + 395 IN = FRERE(IN) + IF (IN.GT.0) GO TO 395 + IFATH = -IN + ENDIF + NFR4 = ND(STEP(INODE)) + NFR = int(NFR4,8) + NELIM4 = 0 + IN = INODE + 396 NELIM4 = NELIM4 + 1 + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 396 + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(NFR-NELIM)*(NFR-NELIM) + ELSE + SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8 + ENDIF + CALL MUMPS_511(NFR4,NELIM4,NELIM4, + & SYM,1,COST_NODE) + IF(IFATH.NE.0)THEN + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + COST_TRAV(STEP(INODE))=COST_TRAV(STEP( + & ROOT_OF_CUR_SBTR)) + ELSE + COST_TRAV(STEP(INODE))=dble(COST_NODE)+ + & COST_TRAV(STEP(IFATH))+ + & dble(SIZECB*18_8) + ENDIF + ELSE + COST_TRAV(STEP(INODE))=dble(COST_NODE) + ENDIF + ENDIF + ENDIF + DO I=1,NE(STEP(INODE)) + TEMP(I)=IN + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + IF((SLAVEF.NE.1).AND.(.NOT.MUMPS_170( + & PROCNODE(STEP(INODE)),SLAVEF)))THEN + NFR4 = ND(STEP(INODE)) + NFR = int(NFR4,8) + NELIM4 = 0 + II = TEMP(I) + 845 NELIM4 = NELIM4 + 1 + II = FILS(II) + IF (II .GT. 0 ) GOTO 845 + NELIM=int(NELIM4,8) + CALL MUMPS_511(NFR4,NELIM4,NELIM4, + & SYM,1,COST_NODE) + TAB1(I)=int(dble(COST_NODE)+ + & COST_TRAV(STEP(INODE)),8) + TAB2(I)=0_8 + ELSE + SON(I)=IN + ENDIF + ELSE + SON(I)=IN + ENDIF + IN=FRERE(STEP(IN)) + ENDDO + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + IF((SLAVEF.NE.1).AND.(.NOT.MUMPS_170( + & PROCNODE(STEP(INODE)),SLAVEF)))THEN + CALL DMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2, + & LOCAL_PERM + & ,RESULT,T1,T2) + TAB=>TEMP + DO I=NE(STEP(INODE)),1,-1 + IF(I.EQ.NE(STEP(INODE))) THEN + FILS(dernier)=-TAB(I) + dernier=TAB(I) + GOTO 221 + ENDIF + IF(I.EQ.1) THEN + FRERE(STEP(dernier))=TAB(I) + FRERE(STEP(TAB(I)))=-INODE + GOTO 221 + ENDIF + IF(I.GT.1) THEN + FRERE(STEP(dernier))=TAB(I) + dernier=TAB(I) + GOTO 221 + ENDIF + 221 CONTINUE + SON(NE(STEP(INODE))-I+1)=TAB(I) + ENDDO + ENDIF + ENDIF + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=SON(I) + SON(I)=0 + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + IF(PERM.NE.7)THEN + NA(LEAF+2)=INODE + ENDIF + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 999 + ENDIF + fin=fin-1 + IF(fin.EQ.0) THEN + GOTO 789 + ENDIF + GOTO 999 + 789 CONTINUE + IF(PERM.EQ.7) GOTO 5483 + NBROOT=NA(2) + NBLEAF=NA(1) + PEAK=0.0D0 + FACT_SIZE=0_8 + DO I=1,NBROOT + PEAK=max(PEAK,dble(M(STEP(NA(2+NBLEAF+I))))) + FACT_SIZE=FACT_SIZE+fact(STEP(NA(2+NBLEAF+I))) + ENDDO + 5483 CONTINUE + DEALLOCATE(IPOOL) + DEALLOCATE(fact) + DEALLOCATE(TNSTK) + DEALLOCATE(SON) + DEALLOCATE(TAB2) + DEALLOCATE(TAB1) + DEALLOCATE(T1) + DEALLOCATE(T2) + DEALLOCATE(RESULT) + DEALLOCATE(TEMP) + IF(PERM.NE.7)THEN + DEALLOCATE(M) + ENDIF + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + DEALLOCATE(DEPTH) + ENDIF + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + DEALLOCATE(COST_TRAV) + ENDIF + IF ((PERM.NE.7).AND.(SBTR_M.OR.(PERM.EQ.2))) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1).OR.(PERM.EQ.2))THEN + DEALLOCATE(M_TOTAL) + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_363 + SUBROUTINE DMUMPS_364(N,FRERE, STEP, FILS, + & NA,LNA,NE,ND, DAD, LDAD, USE_DAD, + & NSTEPS,PERM,SYM,INFO,LP,K47,K81,K76,K215,K234,K55, + & PROCNODE,MEM_SUBTREE,SLAVEF, SIZE_MEM_SBTR, PEAK + & ,SBTR_WHICH_M,SIZE_DEPTH_FIRST,SIZE_COST_TRAV, + & DEPTH_FIRST_TRAV,DEPTH_FIRST_SEQ,COST_TRAV,MY_FIRST_LEAF, + & MY_NB_LEAF,MY_ROOT_SBTR,SBTR_ID + & ) + IMPLICIT NONE + INTEGER N,PERM,SYM, NSTEPS, LNA, LP, SIZE_MEM_SBTR,LDAD + INTEGER FRERE(NSTEPS), FILS(N), STEP(N) + INTEGER NA(LNA), NE(NSTEPS), ND(NSTEPS) + INTEGER K47,K81,K76,K215,K234,K55 + INTEGER DAD(LDAD) + LOGICAL USE_DAD + INTEGER INFO(40) + INTEGER SLAVEF,PROCNODE(NSTEPS) + DOUBLE PRECISION, intent(out) :: MEM_SUBTREE(SIZE_MEM_SBTR,SLAVEF) + INTEGER :: SBTR_WHICH_M + INTEGER MY_FIRST_LEAF(SIZE_MEM_SBTR,SLAVEF), + & MY_ROOT_SBTR(SIZE_MEM_SBTR,SLAVEF), + & MY_NB_LEAF(SIZE_MEM_SBTR,SLAVEF) + EXTERNAL MUMPS_283,MUMPS_275 + LOGICAL MUMPS_283 + INTEGER MUMPS_275 + DOUBLE PRECISION PEAK + INTEGER SIZE_DEPTH_FIRST,DEPTH_FIRST_TRAV(SIZE_DEPTH_FIRST), + & DEPTH_FIRST_SEQ(SIZE_DEPTH_FIRST) + INTEGER SIZE_COST_TRAV + INTEGER SBTR_ID(SIZE_DEPTH_FIRST),OOC_CUR_SBTR + DOUBLE PRECISION COST_TRAV(SIZE_COST_TRAV) + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH + INTEGER IFATH,IN,INODE,I,allocok,LOCAL_PERM + INTEGER(8) NELIM,NFR + INTEGER NFR4,NELIM4 + INTEGER LEAF,NBLEAF,NBROOT, SIZE_TAB + INTEGER, DIMENSION (:), ALLOCATABLE :: IPOOL,TNSTK + INTEGER, DIMENSION (:), ALLOCATABLE,TARGET :: SON,TEMP + INTEGER(8), DIMENSION (:), ALLOCATABLE :: M,M_TOTAL, fact + INTEGER(8), DIMENSION (:), ALLOCATABLE :: TAB1,TAB2 + INTEGER x,dernier,fin,RANK_TRAV + INTEGER II + INTEGER ROOT_OF_CUR_SBTR + INTEGER(8), DIMENSION (:), ALLOCATABLE :: T1,T2 + INTEGER, DIMENSION (:), ALLOCATABLE :: RESULT + INTEGER(8) MEM_SIZE,FACT_SIZE, + & TOTAL_MEM_SIZE, + & SIZECB + LOGICAL SBTR_M + INTEGER INDICE(SLAVEF),ID,FIRST_LEAF,SIZE_SBTR + EXTERNAL MUMPS_170,MUMPS_167 + LOGICAL MUMPS_170,MUMPS_167 + DOUBLE PRECISION COST_NODE + INTEGER CUR_DEPTH_FIRST_RANK + INCLUDE 'mumps_headers.h' + TOTAL_MEM_SIZE=0_8 + ROOT_OF_CUR_SBTR=0 + IF((PERM.EQ.0).OR.(PERM.EQ.1).OR. + & (PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4).OR. + & (PERM.EQ.5).OR.(PERM.EQ.6))THEN + LOCAL_PERM=0 + ENDIF + IF (K47 == 4 .OR. ((K47.GE.2).AND.(K81.GE. 1))) THEN + DO I=1,SLAVEF + INDICE(I)=1 + ENDDO + DO I=1,SLAVEF + DO x=1,SIZE_MEM_SBTR + MEM_SUBTREE(x,I)=-1.0D0 + ENDDO + ENDDO + ENDIF + SBTR_M=((K47 == 4 .OR. ((K47.GE.2).AND.(K81 .GE. 1)))) + MEM_SIZE=0_8 + FACT_SIZE=0_8 + IF ((PERM.GT.7).AND. + & (.NOT.(K47 == 4 .OR. ((K47.GE.2).AND.(K81 .GE. 1))))) THEN + WRITE(*,*) "Internal Error in DMUMPS_363",PERM + CALL MUMPS_ABORT() + END IF + NBLEAF = NA(1) + NBROOT = NA(2) + CUR_DEPTH_FIRST_RANK=1 + IF((PERM.EQ.0).AND.(NBROOT.EQ.NBLEAF)) RETURN + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + ALLOCATE(M_TOTAL(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & DMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ENDIF + ENDIF + ALLOCATE( IPOOL(NBLEAF), M(NSTEPS), fact(NSTEPS), + & TNSTK(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in DMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + II=0 + DO I=1,NSTEPS + TNSTK(I) = NE(I) + IF(NE(I).GE.II) II=NE(I) + ENDDO + SIZE_TAB=max(II,NBROOT) + ALLOCATE(SON(II), TEMP(II), + & TAB1(SIZE_TAB), TAB2(SIZE_TAB), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in DMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ALLOCATE(T1(SIZE_TAB),T2(SIZE_TAB), + & RESULT(SIZE_TAB),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in DMUMPS_363' + INFO(1)=-7 + INFO(2)=SIZE_TAB + RETURN + ENDIF + IF(NBROOT.EQ.NBLEAF)THEN + IF((PERM.NE.1).OR.(PERM.EQ.4).OR.(PERM.EQ.6))THEN + WRITE(*,*)'Internal Error in reordertree:' + WRITE(*,*)' problem with perm parameter in reordertree' + CALL MUMPS_ABORT() + ENDIF + DO I=1,NBROOT + TAB1(I)=int(ND(STEP(NA(I+2+NBLEAF))),8) + IPOOL(I)=NA(I+2+NBLEAF) + M(STEP(IPOOL(I)))=TAB1(I)*TAB1(I) + ENDDO + CALL DMUMPS_462(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4, + & RESULT,T1,T2) + GOTO 789 + ENDIF + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + ALLOCATE(DEPTH(NSTEPS),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & DMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + DEPTH=0 + NBROOT = NA(2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + fin=NBROOT + LEAF=NA(1) + 499 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IN=INODE + 4602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + GOTO 4602 + ENDIF + IN=-IN + DO I=1,NE(STEP(INODE)) + SON(I)=IN + IN=FRERE(STEP(IN)) + ENDDO + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=SON(I) + DEPTH(STEP(SON(I)))=DEPTH(STEP(INODE))+1 + SON(I)=0 + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 499 + ENDIF + fin=fin-1 + IF(fin.EQ.0) GOTO 489 + GOTO 499 + 489 CONTINUE + ENDIF + IF(K76.EQ.4.OR.(K76.EQ.6))THEN + RANK_TRAV=NSTEPS + DEPTH_FIRST_TRAV=0 + DEPTH_FIRST_SEQ=0 + ENDIF + IF((K76.EQ.5).OR.(PERM.EQ.5).OR.(PERM.EQ.6))THEN + COST_TRAV=0.0D0 + COST_NODE=0.0d0 + ENDIF + DO I=1,NSTEPS + M(I)=0_8 + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + M_TOTAL(I)=0_8 + ENDIF + ENDIF + ENDDO + DO I=1,NSTEPS + fact(I)=0_8 + ENDDO + NBROOT = NA(2) + NBLEAF = NA(1) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + CONTINUE + fin=NBROOT + LEAF=NA(1) + FIRST_LEAF=-9999 + SIZE_SBTR=0 + 999 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IF(SIZE_SBTR.NE.0)THEN + IF(.NOT.MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF((SLAVEF.NE.1))THEN + MY_FIRST_LEAF(INDICE(ID+1)-1,ID+1)=FIRST_LEAF + MY_NB_LEAF(INDICE(ID+1)-1,ID+1)=SIZE_SBTR + FIRST_LEAF=-9999 + SIZE_SBTR=0 + ENDIF + ENDIF + ENDIF + ENDIF + IF(MUMPS_283(PROCNODE(STEP(INODE)),SLAVEF))THEN + ROOT_OF_CUR_SBTR=INODE + ENDIF + IF (K76.EQ.4)THEN + IF(SLAVEF.NE.1)THEN + WRITE(*,*)'INODE=',INODE,'RANK',RANK_TRAV + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + DEPTH_FIRST_TRAV(STEP(INODE))=DEPTH_FIRST_TRAV(STEP( + & ROOT_OF_CUR_SBTR)) + ELSE + DEPTH_FIRST_TRAV(STEP(INODE))=RANK_TRAV + ENDIF + RANK_TRAV=RANK_TRAV-1 + ENDIF + ENDIF + IF (K76.EQ.5)THEN + IF(SLAVEF.NE.1)THEN + IF (USE_DAD) THEN + IFATH=DAD(INODE) + ELSE + IN = INODE + 395 IN = FRERE(IN) + IF (IN.GT.0) GO TO 395 + IFATH = -IN + ENDIF + NFR4 = ND(STEP(INODE)) + NFR = int(NFR4,8) + NELIM4 = 0 + IN = INODE + 396 NELIM4 = NELIM4 + 1 + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 396 + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(NFR-NELIM)*(NFR-NELIM) + ELSE + SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8 + ENDIF + CALL MUMPS_511(NFR4,NELIM4,NELIM4, + & SYM,1,COST_NODE) + IF(IFATH.NE.0)THEN + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + COST_TRAV(STEP(INODE))=COST_TRAV(STEP( + & ROOT_OF_CUR_SBTR)) + ELSE + COST_TRAV(STEP(INODE))=dble(COST_NODE)+ + & COST_TRAV(STEP(IFATH))+ + & dble(SIZECB*18_8) + ENDIF + ELSE + COST_TRAV(STEP(INODE))=dble(COST_NODE) + ENDIF + IF(K76.EQ.5)THEN + WRITE(*,*)'INODE=',INODE,'COST=',COST_TRAV(STEP(INODE)) + ENDIF + ENDIF + ENDIF + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF((SLAVEF.NE.1).AND. + & MUMPS_283(PROCNODE(STEP(INODE)),SLAVEF))THEN + IF (NE(STEP(INODE)).NE.0) THEN + ID=MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M_TOTAL(STEP(INODE))) + ELSE + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M(STEP(INODE))) + ENDIF + MY_ROOT_SBTR(INDICE(ID+1),ID+1)=INODE + INDICE(ID+1)=INDICE(ID+1)+1 + ENDIF + ENDIF + IF((SLAVEF.EQ.1).AND.FRERE(STEP(INODE)).EQ.0)THEN + ID=MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M_TOTAL(STEP(INODE))) + ELSE + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M(STEP(INODE))) + ENDIF + INDICE(ID+1)=INDICE(ID+1)+1 + ENDIF + ENDIF + IN=INODE + 5602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + dernier=IN + GOTO 5602 + ENDIF + IN=-IN + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=IN + IF(IN.GT.0) IN=FRERE(STEP(IN)) + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF(SLAVEF.NE.1)THEN + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + IF(FIRST_LEAF.EQ.-9999)THEN + FIRST_LEAF=INODE + ENDIF + SIZE_SBTR=SIZE_SBTR+1 + ENDIF + ENDIF + ENDIF + IF(PERM.NE.7)THEN + NA(LEAF+2)=INODE + ENDIF + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 999 + ENDIF + fin=fin-1 + IF(fin.EQ.0) THEN + IF(SIZE_SBTR.NE.0)THEN + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF((SLAVEF.NE.1))THEN + MY_FIRST_LEAF(INDICE(ID+1)-1,ID+1)=FIRST_LEAF + MY_NB_LEAF(INDICE(ID+1)-1,ID+1)=SIZE_SBTR + FIRST_LEAF=-9999 + SIZE_SBTR=0 + ENDIF + ENDIF + ENDIF + GOTO 789 + ENDIF + GOTO 999 + 789 CONTINUE + IF(K76.EQ.6)THEN + OOC_CUR_SBTR=1 + DO I=1,NSTEPS + TNSTK(I) = NE(I) + ENDDO + NBROOT=NA(2) + NBLEAF=NA(1) + IPOOL(1:NBLEAF)=NA(3:2+NBLEAF) + LEAF = NBLEAF + 1 + 9100 CONTINUE + IF (LEAF.NE.1) THEN + LEAF = LEAF -1 + INODE = IPOOL(LEAF) + ENDIF + 9600 CONTINUE + IF(SLAVEF.NE.1)THEN + ID=MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + DEPTH_FIRST_TRAV(STEP(INODE))=CUR_DEPTH_FIRST_RANK + DEPTH_FIRST_SEQ(CUR_DEPTH_FIRST_RANK)=INODE + WRITE(*,*)ID,': INODE -> ',INODE,'DF =', + & CUR_DEPTH_FIRST_RANK + CUR_DEPTH_FIRST_RANK=CUR_DEPTH_FIRST_RANK+1 + IF(MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + SBTR_ID(STEP(INODE))=OOC_CUR_SBTR + ELSE + SBTR_ID(STEP(INODE))=-9999 + ENDIF + IF(MUMPS_283(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + OOC_CUR_SBTR=OOC_CUR_SBTR+1 + ENDIF + ENDIF + IF (USE_DAD) THEN + IFATH = DAD( STEP(INODE) ) + ELSE + IN = INODE + 1133 IN = FRERE(IN) + IF (IN.GT.0) GO TO 1133 + IFATH = -IN + ENDIF + IF (IFATH.EQ.0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 1163 + GOTO 9100 + ENDIF + TNSTK(STEP(IFATH))=TNSTK(STEP(IFATH))-1 + IF(TNSTK(STEP(IFATH)).EQ.0) THEN + INODE=IFATH + GOTO 9600 + ELSE + GOTO 9100 + ENDIF + 1163 CONTINUE + ENDIF + PEAK=0.0D0 + FACT_SIZE=0_8 + DO I=1,NBROOT + PEAK=max(PEAK,dble(M(STEP(NA(2+NBLEAF+I))))) + FACT_SIZE=FACT_SIZE+fact(STEP(NA(2+NBLEAF+I))) + ENDDO + CONTINUE + DEALLOCATE(IPOOL) + DEALLOCATE(M) + DEALLOCATE(fact) + DEALLOCATE(TNSTK) + DEALLOCATE(SON) + DEALLOCATE(TAB2) + DEALLOCATE(TAB1) + DEALLOCATE(T1) + DEALLOCATE(T2) + DEALLOCATE(RESULT) + DEALLOCATE(TEMP) + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + DEALLOCATE(DEPTH) + ENDIF + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1).OR.(PERM.EQ.2))THEN + DEALLOCATE(M_TOTAL) + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_364 + RECURSIVE SUBROUTINE DMUMPS_462(TAB,DIM,TAB1,TAB2,PERM, + & RESULT,TEMP1,TEMP2) + IMPLICIT NONE + INTEGER DIM + INTEGER(8) TAB1(DIM),TAB2(DIM) + INTEGER(8) TEMP1(DIM),TEMP2(DIM) + INTEGER TAB(DIM), PERM,RESULT(DIM) + INTEGER I,J,I1,I2 + IF(DIM.EQ.1) THEN + RESULT(1)=TAB(1) + TEMP1(1)=TAB1(1) + TEMP2(1)=TAB2(1) + RETURN + ENDIF + I=DIM/2 + CALL DMUMPS_462(TAB(1),I,TAB1(1),TAB2(1),PERM, + & RESULT(1),TEMP1(1),TEMP2(1)) + CALL DMUMPS_462(TAB(I+1),DIM-I,TAB1(I+1),TAB2(I+1), + & PERM,RESULT(I+1),TEMP1(I+1),TEMP2(I+1)) + I1=1 + I2=I+1 + J=1 + DO WHILE ((I1.LE.I).AND.(I2.LE.DIM)) + IF((PERM.EQ.3))THEN + IF(TEMP1(I1).LE.TEMP1(I2))THEN + TAB(J)=RESULT(I1) + TAB1(J)=TEMP1(I1) + J=J+1 + I1=I1+1 + ELSE + TAB(J)=RESULT(I2) + TAB1(J)=TEMP1(I2) + J=J+1 + I2=I2+1 + ENDIF + GOTO 3 + ENDIF + IF((PERM.EQ.4).OR.(PERM.EQ.5))THEN + IF (TEMP1(I1).GE.TEMP1(I2))THEN + TAB(J)=RESULT(I1) + TAB1(J)=TEMP1(I1) + J=J+1 + I1=I1+1 + ELSE + TAB(J)=RESULT(I2) + TAB1(J)=TEMP1(I2) + J=J+1 + I2=I2+1 + ENDIF + GOTO 3 + ENDIF + IF((PERM.EQ.0).OR.(PERM.EQ.1).OR.(PERM.EQ.2)) THEN + IF(TEMP1(I1).GT.TEMP1(I2))THEN + TAB1(J)=TEMP1(I1) + TAB2(J)=TEMP2(I1) + TAB(J)=RESULT(I1) + J=J+1 + I1=I1+1 + GOTO 3 + ENDIF + IF(TEMP1(I1).LT.TEMP1(I2))THEN + TAB1(J)=TEMP1(I2) + TAB2(J)=TEMP2(I2) + TAB(J)=RESULT(I2) + J=J+1 + I2=I2+1 + GOTO 3 + ENDIF + IF((TEMP1(I1).EQ.TEMP1(I2)))THEN + IF(TEMP2(I1).LE.TEMP2(I2))THEN + TAB1(J)=TEMP1(I1) + TAB2(J)=TEMP2(I1) + TAB(J)=RESULT(I1) + J=J+1 + I1=I1+1 + ELSE + TAB1(J)=TEMP1(I2) + TAB2(J)=TEMP2(I2) + TAB(J)=RESULT(I2) + J=J+1 + I2=I2+1 + ENDIF + ENDIF + ENDIF + 3 CONTINUE + ENDDO + IF(I1.GT.I)THEN + DO WHILE(I2.LE.DIM) + TAB(J)=RESULT(I2) + TAB1(J)=TEMP1(I2) + TAB2(J)=TEMP2(I2) + J=J+1 + I2=I2+1 + ENDDO + ELSE + IF(I2.GT.DIM)THEN + DO WHILE(I1.LE.I) + TAB1(J)=TEMP1(I1) + TAB2(J)=TEMP2(I1) + TAB(J)=RESULT(I1) + J=J+1 + I1=I1+1 + ENDDO + ENDIF + ENDIF + DO I=1,DIM + TEMP1(I)=TAB1(I) + TEMP2(I)=TAB2(I) + RESULT(I)=TAB(I) + ENDDO + RETURN + END SUBROUTINE DMUMPS_462 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part5.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part5.F new file mode 100644 index 000000000..35dba6f17 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part5.F @@ -0,0 +1,7688 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE DMUMPS_26(id) + USE DMUMPS_LOAD + USE MUMPS_STATIC_MAPPING + USE DMUMPS_STRUC_DEF + USE TOOLS_COMMON + USE DMUMPS_PARALLEL_ANALYSIS + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, MASTER + PARAMETER( MASTER = 0 ) + TYPE(DMUMPS_STRUC), TARGET :: id + INTEGER LIW, IKEEP, FILS, FRERE, PTRAR, NFSIZ + INTEGER NE, NA + INTEGER I, allocok + INTEGER MAXIS1_CHECK + INTEGER NB_NIV2, IDEST + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER LOCAL_M, LOCAL_N + INTEGER numroc + EXTERNAL numroc + INTEGER IRANK + INTEGER MP, LP, MPG + LOGICAL PROK, PROKG, LISTVAR_SCHUR_2BE_FREED + INTEGER SIZE_SCHUR_PASSED + INTEGER SBUF_SEND, SBUF_REC, TOTAL_MBYTES + INTEGER(8) SBUF_RECOLD8, MIN_BUF_SIZE8 + INTEGER MIN_BUF_SIZE + INTEGER(8) MAX_SIZE_FACTOR_TMP + INTEGER LEAF, INODE, ISTEP, INN, LPTRAR + INTEGER NBLEAF, NBROOT, MYROW_CHECK, INIV2 + INTEGER(8) K13TMP8, K14TMP8 + DOUBLE PRECISION PEAK + INTEGER, ALLOCATABLE, DIMENSION(:) :: PAR2_NODES + INTEGER, DIMENSION(:), ALLOCATABLE :: IWtemp + INTEGER, DIMENSION(:), ALLOCATABLE :: XNODEL, NODEL + INTEGER, DIMENSION(:), POINTER :: SSARBR + INTEGER, POINTER :: NELT, LELTVAR + INTEGER, DIMENSION(:), POINTER :: KEEP,INFO, INFOG + INTEGER(8), DIMENSION(:), POINTER :: KEEP8 + INTEGER(8) :: ENTRIES_IN_FACTORS_LOC_MASTERS + DOUBLE PRECISION, DIMENSION(:), POINTER :: RINFO + DOUBLE PRECISION, DIMENSION(:), POINTER :: RINFOG + INTEGER, DIMENSION(:), POINTER :: ICNTL + LOGICAL I_AM_SLAVE, PERLU_ON, COND + INTEGER :: OOC_STAT + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER K,J, IFS + INTEGER SIZE_TEMP_MEM,SIZE_DEPTH_FIRST,SIZE_COST_TRAV + LOGICAL IS_BUILD_LOAD_MEM_CALLED + DOUBLE PRECISION, DIMENSION (:,:), ALLOCATABLE :: TEMP_MEM + INTEGER, DIMENSION (:,:), ALLOCATABLE :: TEMP_ROOT + INTEGER, DIMENSION (:,:), ALLOCATABLE :: TEMP_LEAF + INTEGER, DIMENSION (:,:), ALLOCATABLE :: TEMP_SIZE + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH_FIRST + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH_FIRST_SEQ + INTEGER, DIMENSION (:), ALLOCATABLE :: SBTR_ID + DOUBLE PRECISION, DIMENSION (:), ALLOCATABLE :: COST_TRAV_TMP + INTEGER(8) :: TOTAL_BYTES + INTEGER, POINTER, DIMENSION(:) :: WORK1PTR, WORK2PTR, + & NFSIZPTR, + & FILSPTR, + & FREREPTR + IS_BUILD_LOAD_MEM_CALLED=.FALSE. + KEEP => id%KEEP + KEEP8 => id%KEEP8 + INFO => id%INFO + RINFO => id%RINFO + INFOG => id%INFOG + RINFOG => id%RINFOG + ICNTL => id%ICNTL + NELT => id%NELT + LELTVAR => id%LELTVAR + KEEP8(24) = 0_8 + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & id%KEEP(46) .eq. 1 ) ) + LP = ICNTL( 1 ) + MP = ICNTL( 2 ) + MPG = ICNTL( 3 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF (PROK) WRITE( MP, 220 ) + IF (PROKG.AND.(MPG .NE. MP)) WRITE( MPG, 220 ) id%VERSION_NUMBER + 220 FORMAT( /' DMUMPS ',A ) + IF ( PROK ) THEN + IF ( KEEP(50) .eq. 0 ) THEN + WRITE(MP, '(A)') 'L U Solver for unsymmetric matrices' + ELSE IF ( KEEP(50) .eq. 1 ) THEN + WRITE(MP, '(A)') + & 'L D L^T Solver for symmetric positive definite matrices' + ELSE + WRITE(MP, '(A)') + & 'L D L^T Solver for general symmetric matrices' + END IF + IF ( KEEP(46) .eq. 1 ) THEN + WRITE(MP, '(A)') 'Type of parallelism: Working host' + ELSE + WRITE(MP, '(A)') 'Type of parallelism: Host not working' + END IF + END IF + IF ( PROKG .AND. (MP.NE.MPG)) THEN + IF ( KEEP(50) .eq. 0 ) THEN + WRITE(MPG, '(A)') 'L U Solver for unsymmetric matrices' + ELSE IF ( KEEP(50) .eq. 1 ) THEN + WRITE(MPG, '(A)') + & 'L D L^T Solver for symmetric positive definite matrices' + ELSE + WRITE(MPG, '(A)') + & 'L D L^T Solver for general symmetric matrices' + END IF + IF ( KEEP(46) .eq. 1 ) THEN + WRITE(MPG, '(A)') 'Type of parallelism: Working host' + ELSE + WRITE(MPG, '(A)') 'Type of parallelism: Host not working' + END IF + END IF + IF (PROK) WRITE( MP, 110 ) + IF (PROKG .AND. (MPG.NE.MP)) WRITE( MPG, 110 ) + CALL DMUMPS_647(id) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + CALL MPI_BCAST( KEEP(60), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + IF (id%KEEP(60) .EQ. 2 .or. id%KEEP(60). EQ. 3) THEN + CALL MPI_BCAST( id%NPROW, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%NPCOL, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%MBLOCK, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%NBLOCK, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + CALL MPI_BCAST( KEEP(54), 2, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(69), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(201), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(244), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(251), 3, MPI_INTEGER,MASTER,id%COMM,IERR) + CALL MPI_BCAST( id%N, 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + IF ( KEEP(55) .EQ. 0) THEN + IF ( KEEP(54) .eq. 3 ) THEN + CALL MPI_ALLREDUCE( id%NZ_loc, id%NZ, 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR ) + ELSE + CALL MPI_BCAST( id%NZ, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + END IF + ELSE + CALL MPI_BCAST( id%NA_ELT, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + ENDIF + IF ( associated(id%MEM_DIST) ) deallocate( id%MEM_DIST ) + allocate( id%MEM_DIST( 0:id%NSLAVES-1 ), STAT=IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -7 + INFO(2) = id%NSLAVES + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'MEM_DIST' + END IF + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + id%MEM_DIST(0:id%NSLAVES-1) = 0 + CALL MUMPS_427( + & id%COMM,id%COMM_NODES,KEEP(69),KEEP(46), + & id%NSLAVES,id%MEM_DIST,INFO) + CALL DMUMPS_658(id) + IF (KEEP(244) .EQ. 1) THEN + IF ( KEEP(54) .eq. 3 ) THEN + CALL DMUMPS_664(id) + END IF + IF ( id%MYID .eq. MASTER ) THEN + 1234 CONTINUE + IF ( ( (KEEP(23) .NE. 0) .AND. + & ( (KEEP(23).NE.7) .OR. KEEP(50).EQ. 2 ) ) + & .OR. + & ( associated(id%A) .AND. KEEP(52) .EQ. 77 .AND. + & (KEEP(50).EQ.2)) + & .OR. + & KEEP(52) .EQ. -2 ) THEN + IF (.not.associated(id%A)) THEN + IF (KEEP(23).GT.2) KEEP(23) = 1 + ENDIF + CALL DMUMPS_203(id%N, id%NZ, KEEP(23), id%IS1(1), id, + & ICNTL(1), INFO(1)) + IF (INFO(1) .LT. 0) THEN + KEEP(23) = 0 + GOTO 10 + END IF + END IF + IF (KEEP(55) .EQ. 0) THEN + IF ( KEEP(256) .EQ. 1 ) THEN + LIW = 2 * id%NZ + 3 * id%N + 2 + ELSE + LIW = 2 * id%NZ + 3 * id%N + 2 + ENDIF + IF (LIW.LT.3*id%N) LIW = 3*id%N + ELSE +#if defined(metis) || defined(parmetis) + COND = (KEEP(60) .NE. 0) .OR. (KEEP(256) .EQ. 5) +#else + COND = (KEEP(60) .NE. 0) +#endif + IF( COND ) THEN + LIW = id%N + id%N + 1 + ELSE + LIW = id%N + id%N + id%N+3 + id%N+1 + ENDIF + ENDIF + IF (LIW.LT.3*id%N) LIW = 3*id%N + IF (KEEP(23) .NE. 0) THEN + IKEEP = id%N + 1 + ELSE + IKEEP = 1 + END IF + NA = IKEEP + id%N + NE = IKEEP + 2 * id%N + FILS = IKEEP + 3 * id%N + FRERE = FILS + id%N + PTRAR = FRERE + id%N + IF (KEEP(55) .EQ. 0) THEN + NFSIZ = PTRAR + 4 * id%N + MAXIS1_CHECK = NFSIZ + id%N - 1 + ELSE + NFSIZ = PTRAR + 2 * (NELT + 1) + MAXIS1_CHECK = NFSIZ + id%N -1 + ENDIF + IF ( id%MAXIS1 .LT. MAXIS1_CHECK ) THEN + IF (LP.GE.0) THEN + WRITE(LP,*) '***********************************' + WRITE(LP,*) 'MAXIS1 and MAXIS1_CHECK are different !!' + WRITE(LP,*) 'MAXIS1, MAXIS1_CHECK=',id%MAXIS1, + & MAXIS1_CHECK + WRITE(LP,*) 'This might cause problems ...' + WRITE(LP,*) '***********************************' + ENDIF + END IF + IF ( KEEP(256) .EQ. 1 ) THEN + DO I = 1, id%N + id%IS1( IKEEP + I - 1 ) = id%PERM_IN( I ) + END DO + END IF + INFOG(1) = 0 + INFOG(2) = 0 + INFOG(8) = -1 + IF ( .NOT. associated( id%LISTVAR_SCHUR ) ) THEN + SIZE_SCHUR_PASSED = 1 + LISTVAR_SCHUR_2BE_FREED=.TRUE. + allocate( id%LISTVAR_SCHUR( 1 ), STAT=allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) + & 'PB allocating an array of size 1 in Schur ' + CALL MUMPS_ABORT() + END IF + ELSE + SIZE_SCHUR_PASSED=id%SIZE_SCHUR + LISTVAR_SCHUR_2BE_FREED = .FALSE. + END IF + IF (KEEP(55) .EQ. 0) THEN + CALL DMUMPS_195(id%N, id%NZ, id%IRN(1), id%JCN(1), + & LIW, id%IS1(IKEEP), + & id%IS1(PTRAR), KEEP(256), id%IS1(NFSIZ), + & id%IS1(FILS), id%IS1(FRERE), + & id%LISTVAR_SCHUR(1), SIZE_SCHUR_PASSED, + & ICNTL(1), INFOG(1), KEEP(1),KEEP8(1),id%NSLAVES, + & id%IS1(1),id) + IF ( (KEEP(23).LE.-1).AND.(KEEP(23).GE.-6) ) THEN + KEEP(23) = -KEEP(23) + IF (.NOT. associated(id%A)) KEEP(23) = 1 + GOTO 1234 + ENDIF + INFOG(7) = KEEP(256) + ELSE + allocate( IWtemp ( 3*id%N ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = 3*id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'IWtemp' + END IF + GOTO 10 + ENDIF + allocate( XNODEL ( id%N+1 ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = id%N + 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'XNODEL' + END IF + GOTO 10 + ENDIF + IF (LELTVAR.ne.id%ELTPTR(NELT+1)-1) THEN + INFO(1) = -2002 + INFO(2) = id%ELTPTR(NELT+1)-1 + GOTO 10 + ENDIF + allocate( NODEL ( LELTVAR ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = LELTVAR + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'NODEL' + END IF + GOTO 10 + ENDIF + CALL DMUMPS_128(id%N, NELT, + & id%ELTPTR(1), id%ELTVAR(1), LIW, + & id%IS1(IKEEP), + & IWtemp(1), KEEP(256), id%IS1(NFSIZ), id%IS1(FILS), + & id%IS1(FRERE), id%LISTVAR_SCHUR(1), + & SIZE_SCHUR_PASSED, + & ICNTL(1), INFOG(1), KEEP(1),KEEP8(1), + & id%ELTPROC(1), id%NSLAVES, + & XNODEL(1), NODEL(1)) + DEALLOCATE(IWtemp) + INFOG(7)=KEEP(256) + ENDIF + IF ( LISTVAR_SCHUR_2BE_FREED ) THEN + deallocate( id%LISTVAR_SCHUR ) + NULLIFY ( id%LISTVAR_SCHUR ) + ENDIF + INFO(1)=INFOG(1) + INFO(2)=INFOG(2) + KEEP(28) = INFOG(6) + IF ( INFO(1) .LT. 0 ) THEN + GO TO 10 + ENDIF + ENDIF + ELSE + IKEEP = 1 + NA = IKEEP + id%N + NE = IKEEP + 2 * id%N + FILS = IKEEP + 3 * id%N + FRERE = FILS + id%N + PTRAR = FRERE + id%N + NFSIZ = PTRAR + 4 * id%N + IF(id%MYID .EQ. MASTER) THEN + WORK1PTR => id%IS1(IKEEP : IKEEP + 3*id%N-1) + WORK2PTR => id%IS1(PTRAR : PTRAR + 4*id%N-1) + NFSIZPTR => id%IS1(NFSIZ : NFSIZ + id%N-1) + FILSPTR => id%IS1(FILS : FILS + id%N-1) + FREREPTR => id%IS1(FRERE : FRERE + id%N-1) + ELSE + ALLOCATE(WORK1PTR(3*id%N)) + ALLOCATE(WORK2PTR(4*id%N)) + END IF + CALL DMUMPS_715(id, + & WORK1PTR, + & WORK2PTR, + & NFSIZPTR, + & FILSPTR, + & FREREPTR) + IF(id%MYID .EQ. 0) THEN + NULLIFY(WORK1PTR, WORK2PTR, NFSIZPTR) + NULLIFY(FILSPTR, FREREPTR) + ELSE + DEALLOCATE(WORK1PTR, WORK2PTR) + END IF + KEEP(28) = INFOG(6) + END IF + 10 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + IF(id%MYID .EQ. MASTER) THEN + CALL MUMPS_633(KEEP(12),ICNTL(14), + & KEEP(50),KEEP(54),ICNTL(6),KEEP(52)) + CALL DMUMPS_348(id%N, id%IS1(FILS), id%IS1(FRERE), + & id%IS1(IKEEP+2*id%N), id%IS1(IKEEP+id%N)) + IF (id%NSLAVES .EQ. 1) THEN + id%NBSA = 0 + IF ( (id%KEEP(60).EQ.0). + & AND.(id%KEEP(53).EQ.0)) THEN + id%KEEP(20)=0 + id%KEEP(38)=0 + ENDIF + id%KEEP(56)=0 + id%PROCNODE = 0 + IF (id%KEEP(60) .EQ. 2 .OR. id%KEEP(60).EQ.3) THEN + CALL DMUMPS_564(id%KEEP(38), id%PROCNODE(1), + & 1+2*id%NSLAVES, id%IS1(FILS),id%N) + ENDIF + ELSE + PEAK = dble(id%INFOG(5))*dble(id%INFOG(5)) + + & dble(id%KEEP(2))*dble(id%KEEP(2)) + SSARBR => id%IS1(IKEEP:IKEEP+id%N-1) + CALL DMUMPS_537(id%N,id%NSLAVES,ICNTL(1), + & INFOG(1), + & id%IS1(NE), + & id%IS1(NFSIZ), + & id%IS1(FRERE), + & id%IS1(FILS), + & KEEP(1),KEEP8(1),id%PROCNODE(1), + & SSARBR(1),id%NBSA,PEAK,IERR + & ) + NULLIFY(SSARBR) + if(IERR.eq.-999) then + write(6,*) ' Internal error in MUMPS_369' + INFO(1) = IERR + GOTO 11 + ENDIF + IF(IERR.NE.0) THEN + INFO(1) = -135 + INFO(2) = IERR + GOTO 11 + ENDIF + CALL DMUMPS_348(id%N, id%IS1(FILS), + & id%IS1(FRERE), id%IS1(IKEEP+2*id%N), + & id%IS1(IKEEP+id%N)) + ENDIF + 11 CONTINUE + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + CALL MPI_BCAST( id%NELT, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + IF (KEEP(55) .EQ. 0) THEN + if (associated(id%FRTPTR)) DEALLOCATE(id%FRTPTR) + if (associated(id%FRTELT)) DEALLOCATE(id%FRTELT) + allocate( id%FRTPTR(1), id%FRTELT(1) ) + ELSE + LPTRAR = id%NELT+id%NELT+2 + CALL MUMPS_733(id%PTRAR, LPTRAR, id%INFO, LP, + & FORCE=.TRUE., STRING='id%PTRAR (Analysis)', ERRCODE=-7) + CALL MUMPS_733(id%FRTPTR, id%N+1, id%INFO, LP, + & FORCE=.TRUE., STRING='id%FRTPTR (Analysis)', ERRCODE=-7) + CALL MUMPS_733(id%FRTELT, id%NELT, id%INFO, LP, + & FORCE=.TRUE., STRING='id%FRTELT (Analysis)', ERRCODE=-7) + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + IF(id%MYID .EQ. MASTER) THEN + CALL DMUMPS_153( + & id%N, NELT, id%ELTPTR(NELT+1)-1, id%IS1(FRERE), + & id%IS1(FILS), + & id%IS1(IKEEP+id%N), id%IS1(IKEEP+2*id%N), XNODEL, + & NODEL, id%FRTPTR(1), id%FRTELT(1), id%ELTPROC(1)) + DO I=1, id%NELT+1 + id%PTRAR(id%NELT+I+1)=id%ELTPTR(I) + ENDDO + deallocate(XNODEL) + deallocate(NODEL) + END IF + CALL MPI_BCAST( id%PTRAR(id%NELT+2), id%NELT+1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%FRTPTR(1), id%N+1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%FRTELT(1), id%NELT, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + ENDIF + IF(id%MYID .EQ. MASTER) THEN + IF ( INFO( 1 ) .LT. 0 ) GOTO 12 + IF ( KEEP(55) .ne. 0 ) THEN + CALL DMUMPS_120(id%N, NELT, id%ELTPROC(1),id%NSLAVES, + & id%PROCNODE(1)) + END IF + NB_NIV2 = KEEP(56) + IF ( NB_NIV2.GT.0 ) THEN + allocate(PAR2_NODES(NB_NIV2), + & STAT=allocok) + IF (allocok .GT.0) then + INFO(1)= -7 + INFO(2)= NB_NIV2 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'PAR2_NODES' + END IF + GOTO 12 + END IF + ENDIF + IF ((NB_NIV2.GT.0) .AND. (KEEP(24).EQ.0)) THEN + INIV2 = 0 + DO 777 INODE = 1, id%N + IF ( ( id%IS1(FRERE+INODE-1) .NE. id%N+1 ) .AND. + & ( MUMPS_330(id%PROCNODE(INODE),id%NSLAVES) + & .eq. 2) ) THEN + INIV2 = INIV2 + 1 + PAR2_NODES(INIV2) = INODE + END IF + 777 CONTINUE + IF ( INIV2 .NE. NB_NIV2 ) THEN + WRITE(*,*) "Internal Error 2 in DMUMPS_26", + & INIV2, NB_NIV2 + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF ( (KEEP(24) .NE. 0) .AND. (NB_NIV2.GT.0) ) THEN + IF ( associated(id%CANDIDATES)) deallocate(id%CANDIDATES) + allocate( id%CANDIDATES(id%NSLAVES+1,NB_NIV2), + & stat=allocok) + if (allocok .gt.0) then + INFO(1)= -7 + INFO(2)= NB_NIV2*(id%NSLAVES+1) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'CANDIDATES' + END IF + GOTO 12 + END IF + CALL MUMPS_393 + & (PAR2_NODES,id%CANDIDATES,IERR) + IF(IERR.NE.0) THEN + INFO(1) = -2002 + GOTO 12 + ENDIF + CALL MUMPS_494() + IF(IERR.NE.0) THEN + INFO(1) = -2002 + GOTO 12 + ENDIF + ELSE + IF (associated(id%CANDIDATES)) DEALLOCATE(id%CANDIDATES) + allocate(id%CANDIDATES(1,1), stat=allocok) + IF (allocok .NE. 0) THEN + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'CANDIDATES' + END IF + GOTO 12 + ENDIF + ENDIF + 12 CONTINUE + KEEP(84) = ICNTL(27) + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + CALL MPI_BCAST( id%KEEP(1), 110, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MUMPS_749( id%KEEP8(21), MASTER, + & id%MYID, id%COMM, IERR) + CALL MPI_BCAST( id%KEEP(205), 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MPI_BCAST( id%NBSA, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + IF (id%MYID==MASTER) KEEP(127)=INFOG(5) + CALL MPI_BCAST( id%KEEP(127), 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MPI_BCAST( id%KEEP(226), 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MUMPS_733(id%STEP, id%N, id%INFO, LP, FORCE=.TRUE., + & STRING='id%STEP (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%PROCNODE_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%PROCNODE_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%NE_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%NE_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%ND_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%ND_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%FRERE_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%FRERE_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%DAD_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%DAD_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%FILS, id%N, id%INFO, LP, FORCE=.TRUE., + & STRING='id%FILS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%SYM_PERM, id%N, id%INFO, LP, FORCE=.TRUE., + & STRING='id%SYM_PERM (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + IF (KEEP(55) .EQ. 0) THEN + LPTRAR = id%N+id%N + CALL MUMPS_733(id%PTRAR, LPTRAR, id%INFO, LP, FORCE=.TRUE., + & STRING='id%PTRAR (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + ENDIF + IF ( associated( id%UNS_PERM ) ) deallocate(id%UNS_PERM) + IF ( id%MYID == MASTER .AND. id%KEEP(23) .NE. 0 ) THEN + allocate(id%UNS_PERM(id%N),stat=allocok) + IF ( allocok .ne. 0) THEN + INFO(1) = -7 + INFO(2) = id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%UNS_PERM' + END IF + GOTO 94 + ENDIF + DO I=1,id%N + id%UNS_PERM(I) = id%IS1(I) + END DO + ENDIF + 94 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( id%MYID .EQ. MASTER ) THEN + DO I=1,id%N + id%FILS(I) = id%IS1(FILS+I-1) + ENDDO + END IF + IF (id%MYID .EQ. MASTER ) THEN + IF (id%N.eq.1) THEN + NBROOT = 1 + NBLEAF = 1 + ELSE IF (id%IS1(NA+id%N-1) .LT.0) THEN + NBLEAF = id%N + NBROOT = id%N + ELSE IF (id%IS1(NA+id%N-2) .LT.0) THEN + NBLEAF = id%N-1 + NBROOT = id%IS1(NA+id%N-1) + ELSE + NBLEAF = id%IS1(NA+id%N-2) + NBROOT = id%IS1(NA+id%N-1) + ENDIF + id%LNA = 2+NBLEAF+NBROOT + ENDIF + CALL MPI_BCAST( id%LNA, 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MUMPS_733(id%NA, id%LNA, id%INFO, LP, FORCE=.TRUE., + & STRING='id%NA (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 96 + IF (id%MYID .EQ.MASTER ) THEN + id%NA(1) = NBLEAF + id%NA(2) = NBROOT + LEAF = 3 + IF ( id%N == 1 ) THEN + id%NA(LEAF) = 1 + LEAF = LEAF + 1 + ELSE IF (id%IS1(NA+id%N-1) < 0) THEN + id%NA(LEAF) = - id%IS1(NA+id%N-1)-1 + LEAF = LEAF + 1 + DO I = 1, NBLEAF - 1 + id%NA(LEAF) = id%IS1(NA+I-1) + LEAF = LEAF + 1 + ENDDO + ELSE IF (id%IS1(NA+id%N-2) < 0 ) THEN + INODE = - id%IS1(NA+id%N-2) - 1 + id%NA(LEAF) = INODE + LEAF =LEAF + 1 + IF ( NBLEAF > 1 ) THEN + DO I = 1, NBLEAF - 1 + id%NA(LEAF) = id%IS1(NA+I-1) + LEAF = LEAF + 1 + ENDDO + ENDIF + ELSE + DO I = 1, NBLEAF + id%NA(LEAF) = id%IS1(NA+I-1) + LEAF = LEAF + 1 + ENDDO + END IF + END IF + 96 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF (associated(id%Step2node)) THEN + DEALLOCATE(id%Step2node) + NULLIFY(id%Step2node) + ENDIF + IF ( id%MYID .EQ. MASTER ) THEN + ISTEP = 0 + DO I = 1, id%N + IF ( id%IS1(FRERE+I-1) .ne. id%N + 1 ) THEN + ISTEP = ISTEP + 1 + id%STEP(I)=ISTEP + INN = id%IS1(FILS+I-1) + DO WHILE ( INN .GT. 0 ) + id%STEP(INN) = - ISTEP + INN = id%IS1(FILS + INN -1) + END DO + IF (id%IS1(FRERE+I-1) .eq. 0) THEN + id%NA(LEAF) = I + LEAF = LEAF + 1 + ENDIF + ENDIF + END DO + IF ( LEAF - 1 .NE. 2+NBROOT + NBLEAF ) THEN + WRITE(*,*) 'Internal error 2 in DMUMPS_26' + CALL MUMPS_ABORT() + ENDIF + IF ( ISTEP .NE. id%KEEP(28) ) THEN + write(*,*) 'Internal error 3 in DMUMPS_26' + CALL MUMPS_ABORT() + ENDIF + DO I = 1, id%N + IF (id%IS1(FRERE+I-1) .NE. id%N+1) THEN + id%PROCNODE_STEPS(id%STEP(I)) = id%PROCNODE( I ) + id%FRERE_STEPS(id%STEP(I)) = id%IS1(FRERE+I-1) + id%NE_STEPS(id%STEP(I)) = id%IS1(NE+I-1) + id%ND_STEPS(id%STEP(I)) = id%IS1(NFSIZ+I-1) + ENDIF + ENDDO + DO I = 1, id%N + IF ( id%STEP(I) .LE. 0) CYCLE + IF (id%IS1(FRERE+I-1) .eq. 0) THEN + id%DAD_STEPS(id%STEP(I)) = 0 + ENDIF + IFS = id%IS1(FILS+I-1) + DO WHILE ( IFS .GT. 0 ) + IFS= id%IS1(FILS + IFS -1) + END DO + IFS = -IFS + DO WHILE (IFS.GT.0) + id%DAD_STEPS(id%STEP(IFS)) = I + IFS = id%IS1(FRERE+IFS-1) + ENDDO + END DO + deallocate(id%PROCNODE) + NULLIFY(id%PROCNODE) + deallocate(id%IS1) + NULLIFY(id%IS1) + CALL DMUMPS_363(id%N, id%FRERE_STEPS(1), + & id%STEP(1),id%FILS(1), id%NA(1), id%LNA, + & id%NE_STEPS(1), id%ND_STEPS(1), id%DAD_STEPS(1), + & id%KEEP(28), .TRUE., id%KEEP(28), id%KEEP(70), + & id%KEEP(50), id%INFO(1), id%ICNTL(1),id%KEEP(215), + & id%KEEP(234), id%KEEP(55), + & id%PROCNODE_STEPS(1),id%NSLAVES,PEAK,id%KEEP(90) + & ) + IF ((id%KEEP(76).GE.4).OR.(id%KEEP(76).GE.6).OR. + & (id%KEEP(47).EQ.4).OR.((id%KEEP(81).GT.0) + & .AND.(id%KEEP(47).GE.2)))THEN + IS_BUILD_LOAD_MEM_CALLED=.TRUE. + IF ((id%KEEP(47) .EQ. 4).OR. + & (( id%KEEP(81) .GT. 0).AND.(id%KEEP(47).GE.2))) THEN + IF(id%NSLAVES.GT.1) THEN + SIZE_TEMP_MEM = id%NBSA + ELSE + SIZE_TEMP_MEM = id%NA(2) + ENDIF + ELSE + SIZE_TEMP_MEM = 1 + ENDIF + IF((id%KEEP(76).EQ.4).OR.(id%KEEP(76).EQ.6))THEN + SIZE_DEPTH_FIRST=id%KEEP(28) + ELSE + SIZE_DEPTH_FIRST=1 + ENDIF + allocate(TEMP_MEM(SIZE_TEMP_MEM,id%NSLAVES),STAT=allocok) + IF (allocok .NE.0) THEN + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_MEM' + END IF + GOTO 80 + END IF + allocate(TEMP_LEAF(SIZE_TEMP_MEM,id%NSLAVES), + & stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_LEAF' + END IF + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + GOTO 80 + end if + allocate(TEMP_SIZE(SIZE_TEMP_MEM,id%NSLAVES), + & stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_SIZE' + END IF + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + GOTO 80 + end if + allocate(TEMP_ROOT(SIZE_TEMP_MEM,id%NSLAVES), + & stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_ROOT' + END IF + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + GOTO 80 + end if + allocate(DEPTH_FIRST(SIZE_DEPTH_FIRST),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'DEPTH_FIRST' + END IF + INFO(1)= -7 + INFO(2)= SIZE_DEPTH_FIRST + GOTO 80 + end if + ALLOCATE(DEPTH_FIRST_SEQ(SIZE_DEPTH_FIRST),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'DEPTH_FIRST_SEQ' + END IF + INFO(1)= -7 + INFO(2)= SIZE_DEPTH_FIRST + GOTO 80 + end if + ALLOCATE(SBTR_ID(SIZE_DEPTH_FIRST),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'SBTR_ID' + END IF + INFO(1)= -7 + INFO(2)= SIZE_DEPTH_FIRST + GOTO 80 + end if + IF(id%KEEP(76).EQ.5)THEN + SIZE_COST_TRAV=id%KEEP(28) + ELSE + SIZE_COST_TRAV=1 + ENDIF + allocate(COST_TRAV_TMP(SIZE_COST_TRAV),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'COST_TRAV_TMP' + END IF + INFO(1)= -7 + INFO(2)= SIZE_COST_TRAV + GOTO 80 + END IF + IF(id%KEEP(76).EQ.5)THEN + IF(id%KEEP(70).EQ.0)THEN + id%KEEP(70)=5 + ENDIF + IF(id%KEEP(70).EQ.1)THEN + id%KEEP(70)=6 + ENDIF + ENDIF + IF(id%KEEP(76).EQ.4)THEN + IF(id%KEEP(70).EQ.0)THEN + id%KEEP(70)=3 + ENDIF + IF(id%KEEP(70).EQ.1)THEN + id%KEEP(70)=4 + ENDIF + ENDIF + CALL DMUMPS_364(id%N, id%FRERE_STEPS(1), + & id%STEP(1),id%FILS(1), id%NA(1), id%LNA, + & id%NE_STEPS(1), id%ND_STEPS(1), id%DAD_STEPS(1), + & id%KEEP(28), .TRUE., id%KEEP(28), id%KEEP(70), + & id%KEEP(50), id%INFO(1), id%ICNTL(1),id%KEEP(47), + & id%KEEP(81),id%KEEP(76),id%KEEP(215), + & id%KEEP(234), id%KEEP(55), + & id%PROCNODE_STEPS(1),TEMP_MEM,id%NSLAVES, + & SIZE_TEMP_MEM, PEAK,id%KEEP(90),SIZE_DEPTH_FIRST, + & SIZE_COST_TRAV,DEPTH_FIRST(1),DEPTH_FIRST_SEQ(1), + & COST_TRAV_TMP(1), + & TEMP_LEAF,TEMP_SIZE,TEMP_ROOT,SBTR_ID(1) + & ) + END IF + CALL DMUMPS_181(id%N, id%NA(1), id%LNA, + & id%NE_STEPS(1), id%SYM_PERM(1), + & id%FILS(1), id%DAD_STEPS(1), + & id%STEP(1), id%KEEP(28), id%INFO(1) ) + ENDIF + 80 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + CALL MPI_BCAST( id%FILS(1), id%N, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%NA(1), id%LNA, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%STEP(1), id%N, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%PROCNODE_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%DAD_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%FRERE_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR) + CALL MPI_BCAST( id%NE_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%ND_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%SYM_PERM(1), id%N, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (KEEP(55) .EQ. 0) THEN + CALL DMUMPS_746(id, id%PTRAR(1)) + IF(id%MYID .EQ. MASTER) THEN + IF ( (KEEP(244) .EQ. 1) .AND. (KEEP(54) .EQ. 3) ) THEN + DEALLOCATE( id%IRN ) + DEALLOCATE( id%JCN ) + END IF + END IF + ENDIF + IF((id%KEEP(76).EQ.4).OR.(id%KEEP(76).EQ.6))THEN + IF(associated(id%DEPTH_FIRST)) + & deallocate(id%DEPTH_FIRST) + allocate(id%DEPTH_FIRST(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= id%KEEP(28) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST' + END IF + GOTO 87 + END IF + IF(associated(id%DEPTH_FIRST_SEQ)) + * DEALLOCATE(id%DEPTH_FIRST_SEQ) + ALLOCATE(id%DEPTH_FIRST_SEQ(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= id%KEEP(28) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + IF(associated(id%SBTR_ID)) + * DEALLOCATE(id%SBTR_ID) + ALLOCATE(id%SBTR_ID(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= id%KEEP(28) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + IF(id%MYID.EQ.MASTER)THEN + id%DEPTH_FIRST(1:id%KEEP(28))=DEPTH_FIRST(1:id%KEEP(28)) + id%DEPTH_FIRST_SEQ(1:id%KEEP(28))= + & DEPTH_FIRST_SEQ(1:id%KEEP(28)) + id%SBTR_ID(1:KEEP(28))=SBTR_ID(1:KEEP(28)) + ENDIF + CALL MPI_BCAST( id%DEPTH_FIRST(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%DEPTH_FIRST_SEQ(1), id%KEEP(28), + & MPI_INTEGER,MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%SBTR_ID(1), id%KEEP(28), + & MPI_INTEGER,MASTER, id%COMM, IERR ) + ELSE + IF(associated(id%DEPTH_FIRST)) + & deallocate(id%DEPTH_FIRST) + allocate(id%DEPTH_FIRST(1),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST' + END IF + GOTO 87 + END IF + IF(associated(id%DEPTH_FIRST_SEQ)) + * DEALLOCATE(id%DEPTH_FIRST_SEQ) + ALLOCATE(id%DEPTH_FIRST_SEQ(1),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + IF(associated(id%SBTR_ID)) + * DEALLOCATE(id%SBTR_ID) + ALLOCATE(id%SBTR_ID(1),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + id%SBTR_ID(1)=0 + id%DEPTH_FIRST(1)=0 + id%DEPTH_FIRST_SEQ(1)=0 + ENDIF + IF(id%KEEP(76).EQ.5)THEN + IF(associated(id%COST_TRAV)) + & deallocate(id%COST_TRAV) + allocate(id%COST_TRAV(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%COST_TRAV' + END IF + INFO(1)= -7 + INFO(2)= id%KEEP(28) + GOTO 87 + END IF + IF(id%MYID.EQ.MASTER)THEN + id%COST_TRAV(1:id%KEEP(28))= + & dble(COST_TRAV_TMP(1:id%KEEP(28))) + ENDIF + CALL MPI_BCAST( id%COST_TRAV(1), id%KEEP(28), + & MPI_DOUBLE_PRECISION,MASTER, id%COMM, IERR ) + ELSE + IF(associated(id%COST_TRAV)) + & deallocate(id%COST_TRAV) + allocate(id%COST_TRAV(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%COST_TRAV(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + id%COST_TRAV(1)=0.0d0 + ENDIF + IF (id%KEEP(47) .EQ. 4 .OR. + & ((id%KEEP(81) .GT. 0).AND.(id%KEEP(47).GE.2))) THEN + IF(id%MYID .EQ. MASTER)THEN + DO K=1,id%NSLAVES + DO J=1,SIZE_TEMP_MEM + IF(TEMP_MEM(J,K) < 0.0D0) GOTO 666 + ENDDO + 666 CONTINUE + J=J-1 + IF (id%KEEP(46) == 1) THEN + IDEST = K - 1 + ELSE + IDEST = K + ENDIF + IF (IDEST .NE. MASTER) THEN + CALL MPI_SEND(J,1,MPI_INTEGER,IDEST,0, + & id%COMM,IERR) + CALL MPI_SEND(TEMP_MEM(1,K),J,MPI_DOUBLE_PRECISION, + & IDEST, 0, id%COMM,IERR) + CALL MPI_SEND(TEMP_LEAF(1,K),J,MPI_INTEGER, + & IDEST, 0, id%COMM,IERR) + CALL MPI_SEND(TEMP_SIZE(1,K),J,MPI_INTEGER, + & IDEST, 0, id%COMM,IERR) + CALL MPI_SEND(TEMP_ROOT(1,K),J,MPI_INTEGER, + & IDEST, 0, id%COMM,IERR) + ELSE + IF(associated(id%MEM_SUBTREE)) + & deallocate(id%MEM_SUBTREE) + allocate(id%MEM_SUBTREE(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MEM_SUBTREE' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%NBSA_LOCAL = J + id%MEM_SUBTREE(1:J)=TEMP_MEM(1:J,1) + IF(associated(id%MY_ROOT_SBTR)) + & deallocate(id%MY_ROOT_SBTR) + allocate(id%MY_ROOT_SBTR(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_ROOT_SBTR' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%MY_ROOT_SBTR(1:J)=TEMP_ROOT(1:J,1) + IF(associated(id%MY_FIRST_LEAF)) + & deallocate(id%MY_FIRST_LEAF) + allocate(id%MY_FIRST_LEAF(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_FIRST_LEAF' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%MY_FIRST_LEAF(1:J)=TEMP_LEAF(1:J,1) + IF(associated(id%MY_NB_LEAF)) + & deallocate(id%MY_NB_LEAF) + allocate(id%MY_NB_LEAF(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_NB_LEAF' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%MY_NB_LEAF(1:J)=TEMP_SIZE(1:J,1) + ENDIF + ENDDO + ELSE + CALL MPI_RECV(id%NBSA_LOCAL,1,MPI_INTEGER, + & MASTER,0,id%COMM,STATUS, IERR) + IF(associated(id%MEM_SUBTREE)) + & deallocate(id%MEM_SUBTREE) + allocate(id%MEM_SUBTREE(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MEM_SUBTREE' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + IF(associated(id%MY_ROOT_SBTR)) + & deallocate(id%MY_ROOT_SBTR) + allocate(id%MY_ROOT_SBTR(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_ROOT_SBTR' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + IF(associated(id%MY_FIRST_LEAF)) + & deallocate(id%MY_FIRST_LEAF) + allocate(id%MY_FIRST_LEAF(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'MY_FIRST_LEAF' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + IF(associated(id%MY_NB_LEAF)) + & deallocate(id%MY_NB_LEAF) + allocate(id%MY_NB_LEAF(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'MY_NB_LEAF' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + CALL MPI_RECV(id%MEM_SUBTREE(1),id%NBSA_LOCAL, + & MPI_DOUBLE_PRECISION,MASTER,0, + & id%COMM,STATUS,IERR) + CALL MPI_RECV(id%MY_FIRST_LEAF(1),id%NBSA_LOCAL, + & MPI_INTEGER,MASTER,0, + & id%COMM,STATUS,IERR) + CALL MPI_RECV(id%MY_NB_LEAF(1),id%NBSA_LOCAL, + & MPI_INTEGER,MASTER,0, + & id%COMM,STATUS,IERR) + CALL MPI_RECV(id%MY_ROOT_SBTR(1),id%NBSA_LOCAL, + & MPI_INTEGER,MASTER,0, + & id%COMM,STATUS,IERR) + ENDIF + ELSE + id%NBSA_LOCAL = -999999 + IF(associated(id%MEM_SUBTREE)) + & deallocate(id%MEM_SUBTREE) + allocate(id%MEM_SUBTREE(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MEM_SUBTREE(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + IF(associated(id%MY_ROOT_SBTR)) + & deallocate(id%MY_ROOT_SBTR) + allocate(id%MY_ROOT_SBTR(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_ROOT_SBTR(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + IF(associated(id%MY_FIRST_LEAF)) + & deallocate(id%MY_FIRST_LEAF) + allocate(id%MY_FIRST_LEAF(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_FIRST_LEAF(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + IF(associated(id%MY_NB_LEAF)) + & deallocate(id%MY_NB_LEAF) + allocate(id%MY_NB_LEAF(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_NB_LEAF(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + ENDIF + IF(id%MYID.EQ.MASTER)THEN + IF(IS_BUILD_LOAD_MEM_CALLED)THEN + deallocate(TEMP_MEM) + deallocate(TEMP_SIZE) + deallocate(TEMP_ROOT) + deallocate(TEMP_LEAF) + deallocate(COST_TRAV_TMP) + deallocate(DEPTH_FIRST) + deallocate(DEPTH_FIRST_SEQ) + deallocate(SBTR_ID) + ENDIF + ENDIF + 87 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + NB_NIV2 = KEEP(56) + IF ( NB_NIV2.GT.0 ) THEN + if (id%MYID.ne.MASTER) then + IF (associated(id%CANDIDATES)) deallocate(id%CANDIDATES) + allocate(PAR2_NODES(NB_NIV2), + & id%CANDIDATES(id%NSLAVES+1,NB_NIV2), + & STAT=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= NB_NIV2*(id%NSLAVES+1) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'PAR2_NODES/id%CANDIDATES' + END IF + end if + end if + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + CALL MPI_BCAST(PAR2_NODES(1),NB_NIV2, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + IF (KEEP(24) .NE.0 ) THEN + CALL MPI_BCAST(id%CANDIDATES(1,1), + & (NB_NIV2*(id%NSLAVES+1)), + & MPI_INTEGER, MASTER, id%COMM, IERR ) + ENDIF + ENDIF + IF ( associated(id%ISTEP_TO_INIV2)) THEN + deallocate(id%ISTEP_TO_INIV2) + NULLIFY(id%ISTEP_TO_INIV2) + ENDIF + IF ( associated(id%I_AM_CAND)) THEN + deallocate(id%I_AM_CAND) + NULLIFY(id%I_AM_CAND) + ENDIF + IF (NB_NIV2.EQ.0) THEN + id%KEEP(71) = 1 + ELSE + id%KEEP(71) = id%KEEP(28) + ENDIF + allocate(id%ISTEP_TO_INIV2(id%KEEP(71)), + & id%I_AM_CAND(max(NB_NIV2,1)), + & stat=allocok) + IF (allocok .gt.0) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%ISTEP_TO_INIV2' + WRITE(LP, 150) 'id%TAB_POS_IN_PERE' + END IF + INFO(1)= -7 + IF (NB_NIV2.EQ.0) THEN + INFO(2)= 2 + ELSE + INFO(2)= id%KEEP(28)+NB_NIV2*(id%NSLAVES+2) + END IF + GOTO 321 + ENDIF + IF ( NB_NIV2 .GT.0 ) THEN + DO INIV2 = 1, NB_NIV2 + INN = PAR2_NODES(INIV2) + id%ISTEP_TO_INIV2(id%STEP(INN)) = INIV2 + END DO + CALL DMUMPS_649( id%NSLAVES, + & NB_NIV2, id%MYID_NODES, + & id%CANDIDATES(1,1), id%I_AM_CAND(1) ) + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (associated(id%FUTURE_NIV2)) THEN + deallocate(id%FUTURE_NIV2) + NULLIFY(id%FUTURE_NIV2) + ENDIF + allocate(id%FUTURE_NIV2(id%NSLAVES), stat=allocok) + IF (allocok .gt.0) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'FUTURE_NIV2' + END IF + INFO(1)= -7 + INFO(2)= id%NSLAVES + GOTO 321 + ENDIF + id%FUTURE_NIV2=0 + DO INIV2 = 1, NB_NIV2 + IDEST = MUMPS_275( + & id%PROCNODE_STEPS(id%STEP(PAR2_NODES(INIV2))), + & id%NSLAVES) + id%FUTURE_NIV2(IDEST+1)=id%FUTURE_NIV2(IDEST+1)+1 + ENDDO +#endif + IF ( I_AM_SLAVE ) THEN + IF ( associated(id%TAB_POS_IN_PERE)) THEN + deallocate(id%TAB_POS_IN_PERE) + NULLIFY(id%TAB_POS_IN_PERE) + ENDIF + allocate(id%TAB_POS_IN_PERE(id%NSLAVES+2,max(NB_NIV2,1)), + & stat=allocok) + IF (allocok .gt.0) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%ISTEP_TO_INIV2' + WRITE(LP, 150) 'id%TAB_POS_IN_PERE' + END IF + INFO(1)= -7 + IF (NB_NIV2.EQ.0) THEN + INFO(2)= 2 + ELSE + INFO(2)= id%KEEP(28)+NB_NIV2*(id%NSLAVES+2) + END IF + GOTO 321 + ENDIF + END IF + IF (NB_NIV2.GT.0) deallocate (PAR2_NODES) + 321 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF ( KEEP(23).NE.0 .and. id%MYID .EQ. MASTER ) THEN + IKEEP = id%N + 1 + ELSE + IKEEP = 1 + END IF + FILS = IKEEP + 3 * id%N + NE = IKEEP + 2 * id%N + NA = IKEEP + id%N + FRERE = FILS + id%N + PTRAR = FRERE + id%N + IF (KEEP(55) .EQ. 0) THEN + IF ( id%MYID.EQ.MASTER ) THEN + NFSIZ = PTRAR + 4 * id%N + ELSE + NFSIZ = PTRAR + 2 * id%N + ENDIF + ELSE + NFSIZ = PTRAR + 2 * (NELT + 1) + END IF + IF ( KEEP(38) .NE. 0 ) THEN + CALL DMUMPS_164( id%MYID, + & id%NSLAVES, id%N, id%root, + & id%COMM_NODES, KEEP( 38 ), id%FILS(1), + & id%KEEP(50), id%KEEP(46), + & id%KEEP(51) + & , id%KEEP(60), id%NPROW, id%NPCOL, id%MBLOCK, id%NBLOCK + & ) + ELSE + id%root%yes = .FALSE. + END IF + IF ( KEEP(38) .NE. 0 .and. I_AM_SLAVE ) THEN + CALL MPI_ALLREDUCE(id%root%MYROW, MYROW_CHECK, 1, + & MPI_INTEGER, MPI_MAX, id%COMM_NODES, IERR) + IF ( MYROW_CHECK .eq. -1) THEN + INFO(1) = -25 + INFO(2) = 0 + END IF + IF ( id%root%MYROW .LT. -1 .OR. + & id%root%MYCOL .LT. -1 ) THEN + INFO(1) = -25 + INFO(2) = 0 + END IF + IF ( LP > 0 .AND. INFO(1) == -25 ) THEN + WRITE(LP, '(A)') + & 'Problem with your version of the BLACS.' + WRITE(LP, '(A)') 'Try using a BLACS version from netlib.' + ENDIF + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF ( I_AM_SLAVE ) THEN + IF (KEEP(55) .EQ. 0) THEN + CALL DMUMPS_24( id%MYID, + & id%NSLAVES, id%N, id%PROCNODE_STEPS(1), + & id%STEP(1), id%PTRAR(1), + & id%PTRAR(id%N +1), + & id%ISTEP_TO_INIV2(1), id%I_AM_CAND(1), + & KEEP(1),KEEP8(1), ICNTL(1), id ) + ELSE + CALL DMUMPS_25( id%MYID, + & id%NSLAVES, id%N, id%PROCNODE_STEPS(1), + & id%STEP(1), + & id%PTRAR(1), + & id%PTRAR(id%NELT+2 ), + & id%NELT, + & id%FRTPTR(1), id%FRTELT(1), + & KEEP(1), KEEP8(1), ICNTL(1), id%KEEP(50) ) + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + IF ( id%root%yes ) THEN + LOCAL_M = numroc( id%ND_STEPS(id%STEP(KEEP(38))), + & id%root%MBLOCK, id%root%MYROW, 0, + & id%root%NPROW ) + LOCAL_M = max(1, LOCAL_M) + LOCAL_N = numroc( id%ND_STEPS(id%STEP(KEEP(38))), + & id%root%NBLOCK, id%root%MYCOL, 0, + & id%root%NPCOL ) + ELSE + LOCAL_M = 0 + LOCAL_N = 0 + END IF + IF ( KEEP(60) .EQ. 2 .OR. KEEP(60) .EQ. 3 ) THEN + id%SCHUR_MLOC=LOCAL_M + id%SCHUR_NLOC=LOCAL_N + id%root%SCHUR_MLOC=LOCAL_M + id%root%SCHUR_NLOC=LOCAL_N + ENDIF + IF ( .NOT. associated(id%CANDIDATES)) THEN + ALLOCATE(id%CANDIDATES(id%NSLAVES+1,1)) + ENDIF + CALL DMUMPS_246( id%MYID_NODES, id%N, + & id%STEP(1), id%FRERE_STEPS(1), id%FILS(1), + & id%NA(1), id%LNA, id%NE_STEPS(1), id%DAD_STEPS(1), + & id%ND_STEPS(1), id%PROCNODE_STEPS(1), + & id%NSLAVES, + & KEEP8(11), KEEP(26), KEEP(15), + & KEEP8(12), + & KEEP8(14), + & KEEP(224), KEEP(225), + & KEEP(27), RINFO(1), + & KEEP(1), KEEP8(1), LOCAL_M, LOCAL_N, SBUF_RECOLD8, + & SBUF_SEND, SBUF_REC, id%COST_SUBTREES, KEEP(28), + & id%I_AM_CAND(1), max(KEEP(56),1), + & id%ISTEP_TO_INIV2(1), id%CANDIDATES(1,1), + & INFO(1), INFO(2) + & ,KEEP8(15) + & ,MAX_SIZE_FACTOR_TMP, KEEP8(9) + & ,ENTRIES_IN_FACTORS_LOC_MASTERS + & ) + id%MAX_SURF_MASTER = KEEP8(15) + KEEP8(19)=MAX_SIZE_FACTOR_TMP + KEEP( 29 ) = KEEP(15) + 2* max(KEEP(12),10) + & * ( KEEP(15) / 100 + 1) + INFO( 19 ) = KEEP(225) + 2* max(KEEP(12),10) + & * ( KEEP(225) / 100 + 1) + KEEP8(13) = KEEP8(12) + int(KEEP(12),8) * + & ( KEEP8(12) / 100_8 + 1_8 ) + KEEP8(17) = KEEP8(14) + int(KEEP(12),8) * + & ( KEEP8(14) /100_8 +1_8) + CALL MUMPS_736 ( SBUF_RECOLD8, KEEP8(22), MPI_MAX, + & id%COMM_NODES ) + SBUF_SEND = max(SBUF_SEND,KEEP(27)) + SBUF_REC = max(SBUF_REC ,KEEP(27)) + CALL MPI_ALLREDUCE (SBUF_REC, KEEP(44), 1, + & MPI_INTEGER, MPI_MAX, + & id%COMM_NODES, IERR) + IF (KEEP(48)==5) THEN + KEEP(43)=KEEP(44) + ELSE + KEEP(43)=SBUF_SEND + ENDIF + MIN_BUF_SIZE8 = KEEP8(22) / int(KEEP(238),8) + MIN_BUF_SIZE8 = min( MIN_BUF_SIZE8, int(huge (KEEP(43)),8)) + MIN_BUF_SIZE = int( MIN_BUF_SIZE8 ) + KEEP(44) = max(KEEP(44), MIN_BUF_SIZE) + KEEP(43) = max(KEEP(43), MIN_BUF_SIZE) + IF ( MP .GT. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' Estimated INTEGER space for factors :', + & KEEP(26) + WRITE(MP,'(A,I10) ') + & ' INFO(3), est. real space to store factors :', + & KEEP8(11) + WRITE(MP,'(A,I10) ') + & ' Estimated number of entries in factors :', + & KEEP8(9) + WRITE(MP,'(A,I10) ') + & ' Current value of space relaxation parameter :', + & KEEP(12) + WRITE(MP,'(A,I10) ') + & ' Estimated size of IS (In Core factorization):', + & KEEP(29) + WRITE(MP,'(A,I10) ') + & ' Estimated size of S (In Core factorization):', + & KEEP8(13) + WRITE(MP,'(A,I10) ') + & ' Estimated size of S (OOC factorization) :', + & KEEP8(17) + END IF + ELSE + ENTRIES_IN_FACTORS_LOC_MASTERS = 0_8 + KEEP8(13) = 0_8 + KEEP(29) = 0 + KEEP8(17)= 0_8 + INFO(19) = 0 + KEEP8(11) = 0_8 + KEEP(26) = 0 + KEEP(27) = 0 + RINFO(1) = 0.0D0 + END IF + CALL MUMPS_736( ENTRIES_IN_FACTORS_LOC_MASTERS, + & KEEP8(109), MPI_SUM, id%COMM) + CALL MUMPS_736( KEEP8(19), KEEP8(119), + & MPI_MAX, id%COMM) + CALL MPI_ALLREDUCE( KEEP(27), KEEP(127), 1, + & MPI_INTEGER, MPI_MAX, + & id%COMM, IERR) + CALL MPI_ALLREDUCE( KEEP(26), KEEP(126), 1, + & MPI_INTEGER, MPI_SUM, + & id%COMM, IERR) + CALL MUMPS_646( KEEP8(11), KEEP8(111), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735( KEEP8(111), INFOG(3) ) + CALL MPI_ALLREDUCE( RINFO(1), RINFOG(1), 1, + & MPI_DOUBLE_PRECISION, MPI_SUM, + & id%COMM, IERR) + CALL MUMPS_735( KEEP8(11), INFO(3) ) + INFO ( 4 ) = KEEP( 26 ) + INFO ( 5 ) = KEEP( 27 ) + INFO ( 7 ) = KEEP( 29 ) + CALL MUMPS_735( KEEP8(13), INFO(8) ) + CALL MUMPS_735( KEEP8(17), INFO(20) ) + CALL MUMPS_735( KEEP8(9), INFO(24) ) + INFOG( 4 ) = KEEP( 126 ) + INFOG( 5 ) = KEEP( 127 ) + CALL MUMPS_735( KEEP8(109), INFOG(20) ) + CALL DMUMPS_100(id%MYID, id%COMM, KEEP(1), KEEP8(1), + & INFO(1), INFOG(1), RINFO(1), RINFOG(1), ICNTL(1)) + OOC_STAT = KEEP(201) + IF (KEEP(201) .NE. -1) OOC_STAT=0 + PERLU_ON = .FALSE. + CALL DMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + KEEP8(2) = TOTAL_BYTES + PERLU_ON = .TRUE. + CALL DMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + IF ( MP .gt. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' Estimated space in MBYTES for IC factorization :', + & TOTAL_MBYTES + END IF + id%INFO(15) = TOTAL_MBYTES + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(15), id%INFOG(16), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Rank of proc needing largest memory in IC facto :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Estimated corresponding MBYTES for IC facto :', + & id%INFOG(16) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (IC) :' + & ,(id%INFOG(17)-id%INFO(15))/id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (IC) :' + & ,id%INFOG(17)/id%NSLAVES + END IF + WRITE(MPG,'(A,I10) ') + & ' ** TOTAL space in MBYTES for IC factorization :' + & ,id%INFOG(17) + END IF + OOC_STAT = KEEP(201) +#if defined(OLD_OOC_NOPANEL) + IF (OOC_STAT .NE. -1) OOC_STAT=2 +#else + IF (OOC_STAT .NE. -1) OOC_STAT=1 +#endif + PERLU_ON = .FALSE. + CALL DMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + KEEP8(3) = TOTAL_BYTES + PERLU_ON = .TRUE. + CALL DMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + id%INFO(17) = TOTAL_MBYTES + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(17), id%INFOG(26), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Rank of proc needing largest memory for OOC facto :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Estimated corresponding MBYTES for OOC facto :', + & id%INFOG(26) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (OOC) :' + & ,(id%INFOG(27)-id%INFO(15))/id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (OOC) :' + & ,id%INFOG(27)/id%NSLAVES + END IF + WRITE(MPG,'(A,I10) ') + & ' ** TOTAL space in MBYTES for OOC factorization :' + & ,id%INFOG(27) + END IF + IF ( id%MYID. eq. MASTER .AND. KEEP(54) .eq. 1 ) THEN + IF (associated( id%MAPPING)) + & deallocate( id%MAPPING) + allocate( id%MAPPING(id%NZ), stat=allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1) = -7 + INFO(2) = id%NZ + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MAPPING' + END IF + GOTO 92 + END IF + allocate(IWtemp( id%N ), stat=allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-7 + INFO(2)=id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'IWtemp(N)' + END IF + GOTO 92 + END IF + CALL DMUMPS_83( + & id%N, id%MAPPING(1), + & id%NZ, id%IRN(1),id%JCN(1), id%PROCNODE_STEPS(1), + & id%STEP(1), + & id%NSLAVES, id%SYM_PERM(1), + & id%FILS(1), IWtemp, id%KEEP(1),id%KEEP8(1), + & id%root%MBLOCK, id%root%NBLOCK, + & id%root%NPROW, id%root%NPCOL ) + deallocate( IWtemp ) + 92 CONTINUE + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + RETURN + 110 FORMAT(/' ****** ANALYSIS STEP ********'/) + 150 FORMAT( + & /' ** FAILURE DURING DMUMPS_26, DYNAMIC ALLOCATION OF', + & A30) + END SUBROUTINE DMUMPS_26 + SUBROUTINE DMUMPS_537(N,NSLAVES, + & ICNTL,INFOG, NE, NFSIZ, + & FRERE, FILS, + & KEEP,KEEP8,PROCNODE, + & SSARBR,NBSA,PEAK,IERR + & ) + USE MUMPS_STATIC_MAPPING + IMPLICIT NONE + INTEGER N, NSLAVES, NBSA, IERR + INTEGER ICNTL(40),INFOG(40),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NE(N),NFSIZ(N),FRERE(N),FILS(N),PROCNODE(N) + INTEGER SSARBR(N) + DOUBLE PRECISION PEAK + CALL MUMPS_369(N,NSLAVES, + & ICNTL,INFOG, NE, NFSIZ, + & FRERE, FILS, + & KEEP,KEEP8,PROCNODE, + & SSARBR,NBSA,dble(PEAK),IERR + & ) + RETURN + END SUBROUTINE DMUMPS_537 + SUBROUTINE DMUMPS_564(INODE, PROCNODE, VALUE, FILS, N) + INTEGER, intent(in) :: INODE, N, VALUE + INTEGER, intent(in) :: FILS(N) + INTEGER, intent(inout) :: PROCNODE(N) + INTEGER IN + IN=INODE + DO WHILE ( IN > 0 ) + PROCNODE( IN ) = VALUE + IN=FILS( IN ) + ENDDO + RETURN + END SUBROUTINE DMUMPS_564 + SUBROUTINE DMUMPS_647(id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(DMUMPS_STRUC) :: id + INTEGER :: LP, MP, MPG, I + INTEGER :: MASTER + LOGICAL :: PROK, PROKG + PARAMETER( MASTER = 0 ) + LP = id%ICNTL( 1 ) + MP = id%ICNTL( 2 ) + MPG = id%ICNTL( 3 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF (id%MYID.eq.MASTER) THEN + id%KEEP(256) = id%ICNTL(7) + id%KEEP(252) = id%ICNTL(32) + IF (id%KEEP(252) < 0 .OR. id%KEEP(252) > 1 ) THEN + id%KEEP(252) = 0 + ENDIF + id%KEEP(251) = id%ICNTL(31) + IF (id%KEEP(251) < 0 .OR. id%KEEP(251) > 2 ) THEN + id%KEEP(251)=0 + ENDIF + IF (id%KEEP(50) .EQ. 0 .AND. id%KEEP(252).EQ.1) THEN + IF (id%KEEP(251) .NE. 1) id%KEEP(251) = 2 + ENDIF + IF (id%KEEP(50) .NE.0 .AND. id%KEEP(251) .EQ. 2) THEN + id%KEEP(251) = 0 + ENDIF + IF (id%KEEP(251) .EQ. 1) THEN + id%KEEP(201) = -1 + ENDIF + IF (id%KEEP(252).EQ.1) THEN + id%KEEP(253) = id%NRHS + IF (id%KEEP(253) .LE. 0) THEN + id%INFO(1)=-42 + id%INFO(2)=id%NRHS + RETURN + ENDIF + ELSE + id%KEEP(253) = 0 + ENDIF + ENDIF + IF ( (id%KEEP(24).NE.0) .AND. + & id%NSLAVES.eq.1 ) THEN + id%KEEP(24) = 0 + IF ( PROKG ) THEN + WRITE(MPG, '(A)') + & ' Resetting candidate strategy to 0 because NSLAVES=1' + WRITE(MPG, '(A)') ' ' + END IF + END IF + IF ( (id%KEEP(24).EQ.0) .AND. + & id%NSLAVES.GT.1 ) THEN + id%KEEP(24) = 8 + ENDIF + IF ( (id%KEEP(24).NE.0) .AND. (id%KEEP(24).NE.1) .AND. + & (id%KEEP(24).NE.8) .AND. (id%KEEP(24).NE.10) .AND. + & (id%KEEP(24).NE.12) .AND. (id%KEEP(24).NE.14) .AND. + & (id%KEEP(24).NE.16) .AND. (id%KEEP(24).NE.18)) THEN + id%KEEP(24) = 8 + IF ( PROKG ) THEN + WRITE(MPG, '(A)') + & ' Resetting candidate strategy to 8 ' + WRITE(MPG, '(A)') ' ' + END IF + END IF + id%KEEP8(21) = int(id%KEEP(85),8) + IF ( id%MYID .EQ. MASTER ) THEN + IF (id%KEEP(201).NE.-1) THEN + id%KEEP(201)=id%ICNTL(22) + IF (id%KEEP(201) .GT. 0) THEN +#if defined(OLD_OOC_NOPANEL) + id%KEEP(201)=2 +#else + id%KEEP(201)=1 +#endif + ENDIF + ENDIF + id%KEEP(54) = id%ICNTL(18) + IF ( id%KEEP(54) .LT. 0 .or. id%KEEP(54).GT.3 ) THEN + IF ( PROKG ) THEN + WRITE(MPG, *) ' Out-of-range value for id%ICNTL(18).' + WRITE(MPG, *) ' Used 0 ie matrix not distributed' + END IF + id%KEEP(54) = 0 + END IF + id%KEEP(55) = id%ICNTL(5) + IF ( id%KEEP(55) .LT. 0 .OR. id%KEEP(55) .GT. 1 ) THEN + IF ( PROKG ) THEN + WRITE(MPG, *) ' Out-of-range value for id%ICNTL(5).' + WRITE(MPG, *) ' Used 0 ie matrix is assembled' + END IF + id%KEEP(55) = 0 + END IF + id%KEEP(60) = id%ICNTL(19) + IF ( id%KEEP( 60 ) .LE. 0 ) id%KEEP( 60 ) = 0 + IF ( id%KEEP( 60 ) .GT. 3 ) id%KEEP( 60 ) = 0 + IF (id%KEEP(60) .NE. 0 .AND. id%SIZE_SCHUR == 0 ) THEN + WRITE(MPG,'(A)') + & ' ** Schur option ignored because SIZE_SCHUR=0' + id%KEEP(60)=0 + END IF + IF ( id%KEEP(60) .NE.0 ) THEN + id%KEEP(116) = id%SIZE_SCHUR + IF (id%SIZE_SCHUR .LT. 0 .OR. id%SIZE_SCHUR .GE. id%N) THEN + id%INFO(1)=-49 + id%INFO(2)=id%SIZE_SCHUR + RETURN + ENDIF + IF ( .NOT. associated( id%LISTVAR_SCHUR ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 8 + RETURN + ELSE IF (size(id%LISTVAR_SCHUR) 0 .AND. id%NBLOCK > 0 .AND. + & id%NPROW > 0 .AND. id%NPCOL > 0 ) THEN + IF (id%NPROW *id%NPCOL .LE. id%NSLAVES) THEN + IF (id%MBLOCK .NE. id%NBLOCK ) THEN + id%INFO(1)=-31 + id%INFO(2)=id%MBLOCK - id%NBLOCK + RETURN + ENDIF + ENDIF + ENDIF + ENDIF + id%KEEP(244) = id%ICNTL(28) + id%KEEP(245) = id%ICNTL(29) +#if ! defined(parmetis) + IF ((id%KEEP(244) .EQ. 2) .AND. (id%KEEP(245) .EQ. 2)) THEN + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) THEN + WRITE(LP,'("ParMETIS not available.")') + WRITE(LP,'("Aborting.")') + RETURN + END IF + END IF +#endif +#if ! defined(ptscotch) + IF ((id%KEEP(244) .EQ. 2) .AND. (id%KEEP(245) .EQ. 1)) THEN + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) THEN + WRITE(LP,'("PT-SCOTCH not available.")') + WRITE(LP,'("Aborting.")') + RETURN + END IF + END IF +#endif + IF((id%KEEP(244) .GT. 2) .OR. + & (id%KEEP(244) .LT. 0)) id%KEEP(244)=0 + IF(id%KEEP(244) .EQ. 0) THEN + id%KEEP(244) = 1 + ELSE IF (id%KEEP(244) .EQ. 2) THEN + IF(id%KEEP(55) .NE. 0) THEN + id%INFO(1) = -39 + WRITE(LP, + & '("Incompatible values for ICNTL(5), ICNTL(28)")') + WRITE(LP, + & '("Parallel analysis is not possible if the")') + WRITE(LP, + & '("matrix is not assembled")') + RETURN + ELSE IF(id%KEEP(60) .NE. 0) THEN + id%INFO(1) = -39 + WRITE(LP, + & '("Incompatible values for ICNTL(19), ICNTL(28)")') + WRITE(LP, + & '("Parallel analysis is not possible if SCHUR")') + WRITE(LP, + & '("complement must be returned")') + RETURN + END IF + IF(id%NSLAVES .LT. 2) THEN + id%KEEP(244) = 1 + IF(PROKG) WRITE(MPG, + & '("Too few processes. + & Reverting to sequential analysis")',advance='no') + IF(id%KEEP(245) .EQ. 1) THEN + IF(PROKG) WRITE(MPG, '(" with SCOTCH")') + id%KEEP(256) = 3 + ELSE IF(id%KEEP(245) .EQ. 2) THEN + IF(PROKG) WRITE(MPG, '(" with Metis")') + id%KEEP(256) = 5 + ELSE + IF(PROKG) WRITE(MPG, '(".")') + id%KEEP(256) = 0 + END IF + END IF + END IF + id%INFOG(32) = id%KEEP(244) + IF ( (id%KEEP(244) .EQ. 1) .AND. + & (id%KEEP(256) .EQ. 1) ) THEN + IF ( .NOT. associated( id%PERM_IN ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 3 + RETURN + ELSE IF ( size( id%PERM_IN ) < id%N ) THEN + id%INFO(1) = -22 + id%INFO(2) = 3 + RETURN + END IF + ENDIF + IF (id%KEEP(9) .LE. 1 ) id%KEEP(9) = 500 + IF ( id%KEEP8(21) .GT. 0_8 ) THEN + IF ((id%KEEP8(21).LE.1_8) .OR. + & (id%KEEP8(21).GT.int(id%KEEP(9),8))) + & id%KEEP8(21) = int(min(id%KEEP(9),100),8) + ENDIF + IF (id%KEEP(48). EQ. 1 ) id%KEEP(48) = -12345 + IF ( (id%KEEP(48).LT.0) .OR. (id%KEEP(48).GT.5) ) THEN + id%KEEP(48)=5 + ENDIF + IF ( (id%KEEP(60) .NE. 0) .AND. (id%KEEP(256) .EQ. 1) ) THEN + DO I = 1, id%SIZE_SCHUR + IF (id%PERM_IN(id%LISTVAR_SCHUR(I)) + & .EQ. id%N-id%SIZE_SCHUR+I) + & CYCLE + id%INFO(1) = -22 + id%INFO(2) = 8 + RETURN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Ignoring user-ordering, because incompatible with Schur.' + WRITE(MPG,'(A)') ' ** id%ICNTL(7) treated as 0.' + END IF + EXIT + ENDDO + END IF + id%KEEP(95) = id%ICNTL(12) + IF (id%KEEP(50).NE.2) id%KEEP(95) = 1 + IF ((id%KEEP(95).GT.3).OR.(id%KEEP(95).LT.0)) id%KEEP(95) = 0 + id%KEEP(23) = id%ICNTL(6) + IF (id%KEEP(23).LT.0.OR.id%KEEP(23).GT.7) id%KEEP(23) = 7 + IF ( id%KEEP(50) .EQ. 1 ) THEN + IF (id%KEEP(23) .NE. 0) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not compatible with LLT factorization' + END IF + id%KEEP(23) = 0 + ENDIF + IF (id%KEEP(95) .GT. 1) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) ignored: not compatible with LLT factorization' + END IF + ENDIF + id%KEEP(95) = 1 + END IF + IF (id%KEEP(60) .GT. 0) THEN + IF (id%KEEP(23) .NE. 0) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed because of Schur' + END IF + id%KEEP(23) = 0 + ENDIF + IF (id%KEEP(52).NE.0) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Scaling during analysis not allowed because of Schur' + ENDIF + id%KEEP(52) = 0 + ENDIF + IF (id%KEEP(95) .GT. 1) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) option not allowed because of Schur' + END IF + ENDIF + id%KEEP(95) = 1 + END IF + IF ( (id%KEEP(23) .NE. 0) .AND. (id%KEEP(256).EQ.1)) THEN + id%KEEP(23) = 0 + id%KEEP(95) = 1 + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed because ordering is given' + END IF + END IF + IF ( id%KEEP(256) .EQ. 1 ) THEN + IF (id%KEEP(95) > 1 .AND. MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) option incompatible with given ordering' + END IF + id%KEEP(95) = 1 + END IF + IF (id%KEEP(54) .NE. 0) THEN + IF( id%KEEP(23) .NE. 0 ) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed because matrix is distributed' + END IF + id%KEEP(23) = 0 + ENDIF + IF (id%KEEP(52).EQ.-2) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Scaling during analysis not allowed (matrix is distributed)' + ENDIF + ENDIF + id%KEEP(52) = 0 + IF (id%KEEP(95) .GT. 1 .AND. MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) option not allowed because matrix is + &distributed' + ENDIF + id%KEEP(95) = 1 + END IF + IF ( id%KEEP(55) .NE. 0 ) THEN + IF( id%KEEP(23) .NE. 0 ) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed for element matrix' + END IF + id%KEEP(23) = 0 + ENDIF + IF (MPG.GT.0 .AND. id%KEEP(52).EQ.-2) THEN + WRITE(MPG,'(A)') + & ' ** Scaling not allowed at analysis for element matrix' + ENDIF + id%KEEP(52) = 0 + id%KEEP(95) = 1 + ENDIF + IF(id%KEEP(244) .EQ. 2) THEN + IF(id%KEEP(23) .EQ. 7) THEN + id%KEEP(23) = 0 + ELSE IF (id%KEEP(23) .GT. 0) THEN + id%INFO(1) = -39 + id%KEEP(23) = 0 + WRITE(LP, + & '("Incompatible values for ICNTL(6), ICNTL(28)")') + WRITE(LP, + & '("Maximum transversal not allowed + & in parallel analysis")') + RETURN + END IF + END IF + IF ( id%KEEP(54) .NE. 0 .AND. id%KEEP(55) .NE. 0 ) THEN + id%KEEP(54) = 0 + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Distributed entry not available for element matrix' + END IF + ENDIF + IF (id%ICNTL(39).NE.1 .and. id%ICNTL(39).NE.2) THEN + id%KEEP(106)=1 + ELSE + id%KEEP(106)=id%ICNTL(39) + ENDIF + IF(id%KEEP(50) .EQ. 2) THEN + IF( .NOT. associated(id%A) ) THEN + IF(id%KEEP(95) .EQ. 3) THEN + id%KEEP(95) = 2 + ENDIF + ENDIF + IF(id%KEEP(95) .EQ. 3 .AND. id%KEEP(256) .NE. 2) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: DMUMPS_203 constrained ordering not ', + & 'available with selected ordering' + id%KEEP(95) = 2 + ENDIF + IF(id%KEEP(95) .EQ. 3) THEN + id%KEEP(23) = 5 + id%KEEP(52) = -2 + ELSE IF(id%KEEP(95) .EQ. 2 .AND. + & (id%KEEP(23) .EQ. 0 .OR. id%KEEP(23) .EQ. 7) ) THEN + IF( associated(id%A) ) THEN + id%KEEP(23) = 5 + ELSE + id%KEEP(23) = 1 + ENDIF + ELSE IF(id%KEEP(95) .EQ. 1) THEN + id%KEEP(23) = 0 + ELSE IF(id%KEEP(95) .EQ. 0 .AND. id%KEEP(23) .EQ. 0) THEN + id%KEEP(95) = 1 + ENDIF + ELSE + id%KEEP(95) = 1 + ENDIF + id%KEEP(53)=0 + IF(id%KEEP(86).EQ.1)THEN + IF(id%KEEP(47).LT.2) id%KEEP(47)=2 + ENDIF + IF(id%KEEP(48).EQ.5)THEN + IF(id%KEEP(50).EQ.0)THEN + id%KEEP(87)=50 + id%KEEP(88)=50 + ELSE + id%KEEP(87)=70 + id%KEEP(88)=70 + ENDIF + ENDIF + IF((id%NSLAVES.EQ.1).AND.(id%KEEP(76).GT.3))THEN + id%KEEP(76)=2 + ENDIF + IF(id%KEEP(81).GT.0)THEN + IF(id%KEEP(47).LT.2) id%KEEP(47)=2 + ENDIF + END IF + RETURN + END SUBROUTINE DMUMPS_647 + SUBROUTINE DMUMPS_664(id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + TYPE(DMUMPS_STRUC) :: id + INTEGER, ALLOCATABLE :: REQPTR(:,:) + INTEGER :: MASTER, IERR, INDX, NRECV + INTEGER :: STATUS( MPI_STATUS_SIZE ) + INTEGER :: LP, MP, MPG, I + LOGICAL :: PROK, PROKG + PARAMETER( MASTER = 0 ) + LP = id%ICNTL( 1 ) + MP = id%ICNTL( 2 ) + MPG = id%ICNTL( 3 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF ( id%KEEP(46) .EQ. 0 .AND. id%MYID .EQ. MASTER ) THEN + id%NZ_loc = 0 + END IF + IF ( id%MYID .eq. MASTER ) THEN + allocate( REQPTR( id%NPROCS, 3 ), STAT = IERR ) + IF ( IERR .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = 3 * id%NPROCS + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'REQPTR' + END IF + GOTO 13 + END IF + allocate( id%IRN( id%NZ ), STAT = IERR ) + IF ( IERR .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = id%NZ + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'IRN' + END IF + GOTO 13 + END IF + allocate( id%JCN( id%NZ ), STAT = IERR ) + IF ( IERR .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = id%NZ + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'JCN' + END IF + GOTO 13 + END IF + END IF + 13 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) < 0 ) RETURN + IF ( id%MYID .EQ. MASTER ) THEN + DO I = 1, id%NPROCS - 1 + CALL MPI_RECV( REQPTR( I+1, 1 ), 1, + & MPI_INTEGER, I, + & COLLECT_NZ, id%COMM, STATUS, IERR ) + END DO + IF ( id%KEEP(46) .eq. 0 ) THEN + REQPTR( 1, 1 ) = 1 + ELSE + REQPTR( 1, 1 ) = id%NZ_loc + 1 + END IF + DO I = 2, id%NPROCS + REQPTR( I, 1 ) = REQPTR( I, 1 ) + REQPTR( I-1, 1 ) + END DO + ELSE + CALL MPI_SEND( id%NZ_loc, 1, MPI_INTEGER, MASTER, + & COLLECT_NZ, id%COMM, IERR ) + END IF + IF ( id%MYID .eq. MASTER ) THEN + NRECV = 0 + DO I = 1, id%NPROCS - 1 + IF ( REQPTR( I + 1, 1 ) - REQPTR( I, 1 ) .NE. 0 ) THEN + NRECV = NRECV + 2 + CALL MPI_IRECV( id%IRN( REQPTR( I, 1 ) ), + & REQPTR( I + 1, 1 ) - REQPTR( I, 1 ), + & MPI_INTEGER, + & I, COLLECT_IRN, id%COMM, REQPTR(I, 2), IERR ) + CALL MPI_IRECV( id%JCN( REQPTR( I, 1 ) ), + & REQPTR( I + 1, 1 ) - REQPTR( I, 1 ), + & MPI_INTEGER, + & I, COLLECT_JCN, id%COMM, REQPTR(I, 3), IERR ) + ELSE + REQPTR(I, 2) = MPI_REQUEST_NULL + REQPTR(I, 3) = MPI_REQUEST_NULL + END IF + END DO + ELSE + IF ( id%NZ_loc .NE. 0 ) THEN + CALL MPI_SEND( id%IRN_loc(1), id%NZ_loc, + & MPI_INTEGER, MASTER, + & COLLECT_IRN, id%COMM, IERR ) + CALL MPI_SEND( id%JCN_loc(1), id%NZ_loc, + & MPI_INTEGER, MASTER, + & COLLECT_JCN, id%COMM, IERR ) + END IF + END IF + IF ( id%MYID .eq. MASTER ) THEN + IF ( id%NZ_loc .NE. 0 ) THEN + DO I=1,id%NZ_loc + id%IRN(I) = id%IRN_loc(I) + id%JCN(I) = id%JCN_loc(I) + ENDDO + END IF + REQPTR( id%NPROCS, 2 ) = MPI_REQUEST_NULL + REQPTR( id%NPROCS, 3 ) = MPI_REQUEST_NULL + DO I = 1, NRECV + CALL MPI_WAITANY + & ( 2 * id%NPROCS, REQPTR( 1, 2 ), INDX, STATUS, IERR ) + END DO + deallocate( REQPTR ) + END IF + RETURN + 150 FORMAT( + &/' ** FAILURE DURING DMUMPS_664, DYNAMIC ALLOCATION OF', + & A30) + END SUBROUTINE DMUMPS_664 + SUBROUTINE DMUMPS_658(id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(DMUMPS_STRUC) :: id + INTEGER :: MASTER, IERR + INTEGER :: IUNIT + LOGICAL :: IS_ELEMENTAL + LOGICAL :: IS_DISTRIBUTED + INTEGER :: MM_WRITE + INTEGER :: MM_WRITE_CHECK + CHARACTER(LEN=20) :: MM_IDSTR + LOGICAL :: I_AM_SLAVE, I_AM_MASTER + PARAMETER( MASTER = 0 ) + IUNIT = 69 + I_AM_SLAVE = ( id%MYID .NE. MASTER .OR. + & ( id%MYID .EQ. MASTER .AND. + & id%KEEP(46) .EQ. 1 ) ) + I_AM_MASTER = (id%MYID.EQ.MASTER) + IS_DISTRIBUTED = (id%KEEP(54) .EQ. 3) + IS_ELEMENTAL = (id%KEEP(55) .NE. 0) + IF (id%MYID.EQ.MASTER .AND. .NOT. IS_DISTRIBUTED) THEN + IF (id%WRITE_PROBLEM(1:20) .NE. "NAME_NOT_INITIALIZED")THEN + OPEN(IUNIT,FILE=trim(id%WRITE_PROBLEM)) + CALL DMUMPS_166( id, IUNIT, I_AM_SLAVE, I_AM_MASTER, + & IS_DISTRIBUTED, + & IS_ELEMENTAL ) + CLOSE(IUNIT) + ENDIF + ELSE IF (id%KEEP(54).EQ.3) THEN + IF (id%WRITE_PROBLEM(1:20) .EQ. "NAME_NOT_INITIALIZED" + & .OR. .NOT. I_AM_SLAVE )THEN + MM_WRITE = 0 + ELSE + MM_WRITE = 1 + ENDIF + CALL MPI_ALLREDUCE(MM_WRITE, MM_WRITE_CHECK, 1, + & MPI_INTEGER, MPI_SUM, id%COMM, IERR) + IF (MM_WRITE_CHECK.EQ.id%NSLAVES .AND. I_AM_SLAVE) THEN + WRITE(MM_IDSTR,'(I7)') id%MYID_NODES + OPEN(IUNIT, + & FILE=trim(id%WRITE_PROBLEM)//trim(adjustl(MM_IDSTR))) + CALL DMUMPS_166(id, IUNIT, I_AM_SLAVE, I_AM_MASTER, + & IS_DISTRIBUTED, + & IS_ELEMENTAL ) + CLOSE(IUNIT) + ENDIF + ENDIF + IF ( id%MYID.EQ.MASTER .AND. + & associated(id%RHS) .AND. + & id%WRITE_PROBLEM(1:20) + & .NE. "NAME_NOT_INITIALIZED")THEN + OPEN(IUNIT,FILE=trim(id%WRITE_PROBLEM) //".rhs") + CALL DMUMPS_179(IUNIT, id) + CLOSE(IUNIT) + ENDIF + RETURN + END SUBROUTINE DMUMPS_658 + SUBROUTINE DMUMPS_166 + & (id, IUNIT, I_AM_SLAVE, I_AM_MASTER, + & IS_DISTRIBUTED, IS_ELEMENTAL ) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + LOGICAL, intent(in) :: I_AM_SLAVE, + & I_AM_MASTER, + & IS_DISTRIBUTED, + & IS_ELEMENTAL + INTEGER, intent(in) :: IUNIT + TYPE(DMUMPS_STRUC), intent(in) :: id + CHARACTER (LEN=10) :: SYMM + CHARACTER (LEN=8) :: ARITH + INTEGER :: I + IF (IS_ELEMENTAL) THEN + RETURN + ENDIF + IF (I_AM_MASTER .AND. .NOT. IS_DISTRIBUTED) THEN + IF (associated(id%A)) THEN + ARITH='real' + ELSE + ARITH='pattern ' + ENDIF + IF (id%KEEP(50) .eq. 0) THEN + SYMM="general" + ELSE + SYMM="symmetric" + END IF + WRITE(IUNIT,FMT=*)'%%MatrixMarket matrix coordinate ', + & trim(ARITH)," ",trim(SYMM) + WRITE(IUNIT,*) id%N, id%N, id%NZ + IF (associated(id%A)) THEN + DO I=1,id%NZ + IF (id%KEEP(50).NE.0 .AND. id%IRN(I).LT.id%JCN(I)) THEN + WRITE(IUNIT,*) id%JCN(I), id%IRN(I), id%A(I) + ELSE + WRITE(IUNIT,*) id%IRN(I), id%JCN(I), id%A(I) + ENDIF + ENDDO + ELSE + DO I=1,id%NZ + IF (id%KEEP(50).NE.0 .AND. id%IRN(I).LT.id%JCN(I)) THEN + WRITE(IUNIT,*) id%JCN(I), id%IRN(I) + ELSE + WRITE(IUNIT,*) id%IRN(I), id%JCN(I) + ENDIF + ENDDO + ENDIF + ELSE IF ( IS_DISTRIBUTED .AND. I_AM_SLAVE ) THEN + IF (associated(id%A_loc)) THEN + ARITH='real' + ELSE + ARITH='pattern ' + ENDIF + IF (id%KEEP(50) .eq. 0) THEN + SYMM="general" + ELSE + SYMM="symmetric" + END IF + WRITE(IUNIT,FMT=*)'%%MatrixMarket matrix coordinate ', + & trim(ARITH)," ",trim(SYMM) + WRITE(IUNIT,*) id%N, id%N, id%NZ_loc + IF (associated(id%A_loc)) THEN + DO I=1,id%NZ_loc + IF (id%KEEP(50).NE.0 .AND. + & id%IRN_loc(I).LT.id%JCN_loc(I)) THEN + WRITE(IUNIT,*) id%JCN_loc(I), id%IRN_loc(I), + & id%A_loc(I) + ELSE + WRITE(IUNIT,*) id%IRN_loc(I), id%JCN_loc(I), + & id%A_loc(I) + ENDIF + ENDDO + ELSE + DO I=1,id%NZ_loc + IF (id%KEEP(50).NE.0 .AND. + & id%IRN_loc(I).LT.id%JCN_loc(I)) THEN + WRITE(IUNIT,*) id%JCN_loc(I), id%IRN_loc(I) + ELSE + WRITE(IUNIT,*) id%IRN_loc(I), id%JCN_loc(I) + ENDIF + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_166 + SUBROUTINE DMUMPS_179(IUNIT, id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(DMUMPS_STRUC), intent(in) :: id + INTEGER, intent(in) :: IUNIT + CHARACTER (LEN=8) :: ARITH + INTEGER :: I, J, K, LD_RHS + IF (associated(id%RHS)) THEN + ARITH='real' + WRITE(IUNIT,FMT=*)'%%MatrixMarket matrix array ', + & trim(ARITH), + & ' general' + WRITE(IUNIT,*) id%N, id%NRHS + IF ( id%NRHS .EQ. 1 ) THEN + LD_RHS = id%N + ELSE + LD_RHS = id%LRHS + ENDIF + DO J = 1, id%NRHS + DO I = 1, id%N + K=(J-1)*LD_RHS+I + WRITE(IUNIT,*) id%RHS(K) + ENDDO + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_179 + SUBROUTINE DMUMPS_649( NSLAVES, NB_NIV2, MYID_NODES, + & CANDIDATES, I_AM_CAND ) + IMPLICIT NONE + INTEGER, intent(in) :: NSLAVES, NB_NIV2, MYID_NODES + INTEGER, intent(in) :: CANDIDATES( NSLAVES+1, NB_NIV2 ) + LOGICAL, intent(out):: I_AM_CAND( NB_NIV2 ) + INTEGER I, INIV2, NCAND + DO INIV2=1, NB_NIV2 + I_AM_CAND(INIV2)=.FALSE. + NCAND = CANDIDATES(NSLAVES+1,INIV2) + DO I=1, NCAND + IF (CANDIDATES(I,INIV2).EQ.MYID_NODES) THEN + I_AM_CAND(INIV2)=.TRUE. + EXIT + ENDIF + ENDDO + END DO + RETURN + END SUBROUTINE DMUMPS_649 + SUBROUTINE DMUMPS_251(N,IW,LIW,A,LA, + & NSTK_STEPS, NBPROCFILS,IFLAG,ND,FILS,STEP, + & FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRT, NTOTPV, NMAXNPIV, PTRIST, PTRAST, + & PIMASTER, PAMASTER, PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, IERROR,IPOOL, LPOOL, + & RINFO, POSFAC ,IWPOS, LRLU, IPTRLU, + & LRLUS, LEAF, NBROOT, NBRTOT, + & UU, ICNTL, PTLUST_S, PTRFAC, NSTEPS, INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS,SLAVEF,MYID, COMM_NODES, + & MYID_NODES, + & BUFR,LBUFR,LBUFR_BYTES,INTARR,DBLARR,root, + & PERM, NELT, FRTPTR, FRTELT, LPTRAR, + & COMM_LOAD, ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, + & MEM_DISTRIB, NE, + & DKEEP,PIVNUL_LIST,LPN_LIST) + USE DMUMPS_LOAD + USE DMUMPS_OOC + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER N,IFLAG,NTOTPV,MAXFRT,LIW, LPTRAR, NMAXNPIV, + & IERROR, NSTEPS, INFO(40) + INTEGER(8) :: LA + DOUBLE PRECISION, TARGET :: A(LA) + INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES + INTEGER, DIMENSION(0: SLAVEF - 1) :: MEM_DISTRIB + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER LPOOL + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER ITLOC(N+KEEP(253)) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER IW(LIW), NSTK_STEPS(KEEP(28)), NBPROCFILS(KEEP(28)) + INTEGER PTRARW(LPTRAR), PTRAIW(LPTRAR), ND(KEEP(28)) + INTEGER FILS(N),PTRIST(KEEP(28)) + INTEGER STEP(N), FRERE(KEEP(28)), DAD(KEEP(28)) + INTEGER PIMASTER(KEEP(28)) + INTEGER PTLUST_S(KEEP(28)), PERM(N) + INTEGER CAND(SLAVEF+1,max(1,KEEP(56))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER IPOOL(LPOOL) + INTEGER NE(KEEP(28)) + DOUBLE PRECISION RINFO(40) + INTEGER(8) :: PAMASTER(KEEP(28)), PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: POSFAC, LRLU, LRLUS, IPTRLU + INTEGER IWPOS, LEAF, NBROOT + INTEGER COMM_LOAD, ASS_IRECV + DOUBLE PRECISION UU, SEUIL, SEUIL_LDLT_NIV2 + INTEGER NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION DBLARR( max(1,KEEP(13)) ) + LOGICAL IS_ISOLATED_NODE + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + DOUBLE PRECISION, PARAMETER :: DZERO = 0.0D0, DONE = 1.0D0 + INTEGER INODE + INTEGER IWPOSCB + INTEGER FPERE, TYPEF + INTEGER MP, LP, DUMMY(1) + INTEGER NBFIN, NBRTOT, NBROOT_TRAITEES + INTEGER NFRONT, IOLDPS + INTEGER(8) NFRONT8 + INTEGER(8) :: POSELT + INTEGER IPOSROOT, IPOSROOTROWINDICES + INTEGER GLOBK109 + INTEGER(8) :: LBUFRX + DOUBLE PRECISION, POINTER, DIMENSION(:) :: BUFRX + LOGICAL :: IS_BUFRX_ALLOCATED + DOUBLE PRECISION FLOP1 + INTEGER TYPE + LOGICAL SON_LEVEL2, SET_IRECV, BLOCKING, + & MESSAGE_RECEIVED + LOGICAL AVOID_DELAYED + LOGICAL LAST_CALL + INTEGER MASTER_ROOT + INTEGER LOCAL_M, LOCAL_N + INTEGER LRHS_CNTR_MASTER_ROOT, FWD_LOCAL_N_RHS + LOGICAL ROOT_OWNER + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER MUMPS_330, MUMPS_275 + LOGICAL MUMPS_167,MUMPS_283 + EXTERNAL MUMPS_167,MUMPS_283 + LOGICAL DMUMPS_508 + EXTERNAL DMUMPS_508, DMUMPS_509 + LOGICAL STACK_RIGHT_AUTHORIZED + INTEGER numroc + EXTERNAL numroc + INTEGER MAXFRW, NPVW, NOFFW, NELVAW, COMP, + & JOBASS, ETATASS + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten, + & IDUMMY + INTEGER(8) :: ITMP8 + TYPE(IO_BLOCK) :: MonBloc + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION OPASSW, OPELIW + ASS_IRECV = MPI_REQUEST_NULL + ITLOC(1:N+KEEP(253)) =0 + PTRIST (1:KEEP(28))=0 + PTLUST_S(1:KEEP(28))=0 + PTRAST(1:KEEP(28))=0_8 + PTRFAC(1:KEEP(28))=-99999_8 + MP = ICNTL(2) + LP = ICNTL(1) + MAXFRW = 0 + NPVW = 0 + NOFFW = 0 + NELVAW = 0 + COMP = 0 + OPASSW = DZERO + OPELIW = DZERO + IWPOSCB = LIW + STACK_RIGHT_AUTHORIZED = .TRUE. + CALL DMUMPS_22( .FALSE., 0_8, + & .FALSE., .FALSE., MYID_NODES, N, KEEP, KEEP8, + & IW, LIW, A, LA, LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTRAST, STEP, PIMASTER, + & PAMASTER, KEEP(IXSZ), 0_8, -444, -444, .true., + & COMP, LRLUS, + & IFLAG, IERROR + & ) + JOBASS = 0 + ETATASS = 0 + NBFIN = NBRTOT + NBROOT_TRAITEES = 0 + NBPROCFILS(1:KEEP(28)) = 0 + IF ( KEEP(38).NE.0 ) THEN + IF (root%yes) THEN + CALL DMUMPS_284( + & root, KEEP(38), N, IW, LIW, + & A, LA, + & FILS, MYID_NODES, PTRAIW, PTRARW, + & INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + ENDIF + IF ( IFLAG .LT. 0 ) GOTO 635 + END IF + 20 CONTINUE + NIV1_FLAG=0 + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( + & COMM_LOAD, ASS_IRECV, BLOCKING, SET_IRECV, + & MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_STEPS, + & COMP, IFLAG, + & IERROR, COMM_NODES, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID_NODES, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & STACK_RIGHT_AUTHORIZED ) + CALL DMUMPS_467(COMM_LOAD, KEEP) + IF (MESSAGE_RECEIVED) THEN + IF ( IFLAG .LT. 0 ) GO TO 640 + IF ( NBFIN .eq. 0 ) GOTO 640 + ELSE + IF ( .NOT. DMUMPS_508( IPOOL, LPOOL) )THEN + CALL DMUMPS_509( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, STEP, INODE, KEEP,KEEP8, MYID_NODES, ND, + & (.NOT. STACK_RIGHT_AUTHORIZED) ) + STACK_RIGHT_AUTHORIZED = .TRUE. + IF (KEEP(47) .GE. 3) THEN + CALL DMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID_NODES, STEP, N, ND, FILS ) + ENDIF + IF (KEEP(47).EQ.4) THEN + IF(INODE.GT.0.AND.INODE.LE.N)THEN + IF((NE(STEP(INODE)).EQ.0).AND. + & (FRERE(STEP(INODE)).EQ.0))THEN + IS_ISOLATED_NODE=.TRUE. + ELSE + IS_ISOLATED_NODE=.FALSE. + ENDIF + ENDIF + CALL DMUMPS_501( + & IS_ISOLATED_NODE,INODE,IPOOL,LPOOL, + & MYID_NODES,SLAVEF,COMM_LOAD,KEEP,KEEP8) + ENDIF + IF ((( KEEP(80) == 2 .OR. KEEP(80)==3 ) .AND. + & ( KEEP(47) == 4 )).OR. + & (KEEP(80) == 1 .AND. KEEP(47) .GE. 1)) THEN + CALL DMUMPS_512(INODE,STEP,KEEP(28), + & PROCNODE_STEPS,FRERE,ND,COMM_LOAD,SLAVEF, + & MYID_NODES,KEEP,KEEP8,N) + END IF + GOTO 30 + ENDIF + ENDIF + GO TO 20 + 30 CONTINUE + IF ( INODE .LT. 0 ) THEN + INODE = -INODE + FPERE = DAD(STEP(INODE)) + GOTO 130 + ELSE IF (INODE.GT.N) THEN + INODE = INODE - N + IF (INODE.EQ.KEEP(38)) THEN + NBROOT_TRAITEES = NBROOT_TRAITEES + 1 + IF ( NBROOT_TRAITEES .EQ. NBROOT ) THEN + NBFIN = NBFIN - NBROOT + IF (SLAVEF.GT.1) THEN + DUMMY(1) = NBROOT + CALL DMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID_NODES, + & COMM_NODES, RACINE, SLAVEF) + END IF + ENDIF + IF (NBFIN.EQ.0) GOTO 640 + GOTO 20 + ENDIF + TYPE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (TYPE.EQ.1) GOTO 100 + FPERE = DAD(STEP(INODE)) + AVOID_DELAYED = ( (FPERE .eq. KEEP(20) .OR. FPERE .eq. KEEP(38)) + & .AND. KEEP(60).ne.0 ) + IF ( KEEP(50) .eq. 0 ) THEN + CALL DMUMPS_144( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM_NODES, MYID_NODES, BUFR, LBUFR,LBUFR_BYTES, + & NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_STEPS,NBPROCFILS,PROCNODE_STEPS, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST) + IF ( IFLAG .LT. 0 ) GOTO 640 + ELSE + CALL DMUMPS_141( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM_NODES, MYID_NODES, BUFR, LBUFR,LBUFR_BYTES, + & NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_STEPS,NBPROCFILS,PROCNODE_STEPS, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL_LDLT_NIV2, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST) + IF ( IFLAG .LT. 0 ) GOTO 640 + IF ( IW( PTLUST_S(STEP(INODE)) + KEEP(IXSZ) + 5 ) .GT. 1 ) THEN + GOTO 20 + END IF + END IF + GOTO 130 + ENDIF + IF (INODE.EQ.KEEP(38)) THEN + CALL DMUMPS_176( COMM_LOAD, ASS_IRECV, + & root, FRERE, + & INODE, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_STEPS, COMP, + & IFLAG, IERROR, COMM_NODES, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID_NODES, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 640 + GOTO 20 + ENDIF + TYPE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (TYPE.EQ.1) THEN + IF (KEEP(55).NE.0) THEN + CALL DMUMPS_36( COMM_LOAD, ASS_IRECV, + & NELT, FRTPTR, FRTELT, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP, PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSE + JOBASS = 0 + CALL DMUMPS_252(COMM_LOAD, ASS_IRECV, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP, PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & JOBASS,ETATASS ) + ENDIF + IF ( IFLAG .LT. 0 ) GOTO 640 + IF ((NBPROCFILS(STEP(INODE)).GT.0).OR.(SON_LEVEL2)) GOTO 20 + ELSE + IF ( KEEP(55) .eq. 0 ) THEN + CALL DMUMPS_253(COMM_LOAD, ASS_IRECV, + & N, INODE, IW, LIW, A, LA, + & IFLAG, IERROR, + & ND, FILS, FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, + & root, OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_STEPS, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM_NODES, + & MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & NBFIN, LEAF, IPOOL, LPOOL, PERM, + & MEM_DISTRIB(0) + & ) + ELSE + CALL DMUMPS_37( COMM_LOAD, ASS_IRECV, + & NELT, FRTPTR, FRTELT, + & N, INODE, IW, LIW, A, LA, IFLAG, IERROR, + & ND, FILS, FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, + & root, OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_STEPS, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM_NODES, + & MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & NBFIN, LEAF, IPOOL, LPOOL, PERM, + & MEM_DISTRIB(0)) + END IF + IF (IFLAG.LT.0) GOTO 640 + GOTO 20 + ENDIF + 100 CONTINUE + FPERE = DAD(STEP(INODE)) + IF ( INODE .eq. KEEP(20) ) THEN + POSELT = PTRAST(STEP(INODE)) + IF (PTRFAC(STEP(INODE)).NE.POSELT) THEN + WRITE(*,*) "ERROR 2 in DMUMPS_251", POSELT + CALL MUMPS_ABORT() + ENDIF + CALL DMUMPS_87 + & ( IW(PTLUST_S(STEP(INODE))+KEEP(IXSZ)), KEEP(253) ) + GOTO 200 + END IF + POSELT = PTRAST(STEP(INODE)) + IOLDPS = PTLUST_S(STEP(INODE)) + AVOID_DELAYED = ( (FPERE .eq. KEEP(20) .OR. FPERE .eq. KEEP(38)) + & .AND. KEEP(60).ne.0 ) + IF (KEEP(50).EQ.0) THEN + CALL DMUMPS_143( N, INODE, IW, LIW, A, LA, + & IOLDPS, POSELT, + & IFLAG, UU, NOFFW, NPVW, + & KEEP,KEEP8, + & STEP, PROCNODE_STEPS, MYID_NODES, SLAVEF, + & SEUIL, AVOID_DELAYED, ETATASS, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, IWPOS) + JOBASS = ETATASS + IF (JOBASS.EQ.1) THEN + CALL DMUMPS_252(COMM_LOAD, ASS_IRECV, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP,PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & JOBASS,ETATASS ) + ENDIF + ELSE + IW( IOLDPS+4+KEEP(IXSZ) ) = 1 + CALL DMUMPS_140( N, INODE, + & IW, LIW, A, LA, + & IOLDPS, POSELT, + & IFLAG, UU, NOFFW, NPVW, + & KEEP,KEEP8, MYID_NODES, SEUIL, AVOID_DELAYED, + & ETATASS, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, IWPOS) + IW( IOLDPS+4+KEEP(IXSZ) ) = STEP(INODE) + JOBASS = ETATASS + IF (JOBASS.EQ.1) THEN + CALL DMUMPS_252(COMM_LOAD, ASS_IRECV, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP,PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & JOBASS,ETATASS ) + ENDIF + ENDIF + IF (IFLAG.LT.0) GOTO 635 + 130 CONTINUE + TYPE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF ( FPERE .NE. 0 ) THEN + TYPEF = MUMPS_330(PROCNODE_STEPS(STEP(FPERE)),SLAVEF) + ELSE + TYPEF = -9999 + END IF + CALL DMUMPS_254( COMM_LOAD, ASS_IRECV, + & N,INODE,TYPE,TYPEF,LA,IW,LIW,A, + & IFLAG,IERROR,OPELIW,NELVAW,NMAXNPIV, + & PTRIST,PTLUST_S,PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NE, POSFAC,LRLU, + & LRLUS,IPTRLU,ICNTL,KEEP,KEEP8,COMP,IWPOS,IWPOSCB, + & PROCNODE_STEPS,SLAVEF,FPERE,COMM_NODES,MYID_NODES, + & IPOOL, LPOOL, LEAF, + & NSTK_STEPS, NBPROCFILS, BUFR, LBUFR, LBUFR_BYTES, NBFIN, + & root, OPASSW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0) GOTO 640 + 200 CONTINUE + IF ( INODE .eq. KEEP(38) ) THEN + WRITE(*,*) 'Error .. in DMUMPS_251: ', + & ' INODE == KEEP(38)' + Stop + END IF + IF ( FPERE.EQ.0 ) THEN + NBROOT_TRAITEES = NBROOT_TRAITEES + 1 + IF ( NBROOT_TRAITEES .EQ. NBROOT ) THEN + IF (KEEP(201).EQ.1) THEN + CALL DMUMPS_681(IERR) + ELSE IF ( KEEP(201).EQ.2) THEN + CALL DMUMPS_580(IERR) + ENDIF + NBFIN = NBFIN - NBROOT + IF ( NBFIN .LT. 0 ) THEN + WRITE(*,*) ' ERROR 1 in DMUMPS_251: ', + & ' NBFIN=', NBFIN + CALL MUMPS_ABORT() + END IF + IF ( NBROOT .LT. 0 ) THEN + WRITE(*,*) ' ERROR 1 in DMUMPS_251: ', + & ' NBROOT=', NBROOT + CALL MUMPS_ABORT() + END IF + IF (SLAVEF.GT.1) THEN + DUMMY(1) = NBROOT + CALL DMUMPS_242( DUMMY(1), 1, MPI_INTEGER, + & MYID_NODES, COMM_NODES, RACINE, SLAVEF) + END IF + ENDIF + IF (NBFIN.EQ.0)THEN + GOTO 640 + ENDIF + ELSEIF ( FPERE.NE.KEEP(38) .AND. + & MUMPS_275(PROCNODE_STEPS(STEP(FPERE)),SLAVEF).EQ. + & MYID_NODES ) THEN + NSTK_STEPS(STEP(FPERE)) = NSTK_STEPS(STEP(FPERE))-1 + IF ( NSTK_STEPS( STEP( FPERE )).EQ.0) THEN + IF (KEEP(234).NE.0 .AND. + & MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF)) + & THEN + STACK_RIGHT_AUTHORIZED = .FALSE. + ENDIF + CALL DMUMPS_507(N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), STEP, FPERE ) + IF (KEEP(47) .GE. 3) THEN + CALL DMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID_NODES, STEP, N, ND, FILS ) + ENDIF + CALL MUMPS_137( FPERE, N, PROCNODE_STEPS,SLAVEF, + & ND, FILS, FRERE, STEP, PIMASTER, KEEP(28), + & KEEP(50), KEEP(253), FLOP1, + & IW, LIW, KEEP(IXSZ) ) + IF (FPERE.NE.KEEP(20)) + & CALL DMUMPS_190(1,.FALSE.,FLOP1,KEEP,KEEP8) + ENDIF + ENDIF + GO TO 20 + 635 CONTINUE + CALL DMUMPS_44( MYID_NODES, SLAVEF, COMM_NODES ) + 640 CONTINUE + CALL DMUMPS_255( INFO(1), + & ASS_IRECV, BUFR, LBUFR, + & LBUFR_BYTES, + & COMM_NODES, + & MYID_NODES, SLAVEF) + CALL DMUMPS_180( INFO(1), + & BUFR, LBUFR, + & LBUFR_BYTES, + & COMM_NODES, COMM_LOAD, SLAVEF, MP) + CALL MPI_BARRIER( COMM_NODES, IERR ) + IF ( INFO(1) .GE. 0 ) THEN + IF( KEEP(38) .NE. 0 .OR. KEEP(20).NE.0) THEN + MASTER_ROOT = MUMPS_275( + & PROCNODE_STEPS(STEP(max(KEEP(38),KEEP(20)))), + & SLAVEF) + ROOT_OWNER = (MASTER_ROOT .EQ. MYID_NODES) + IF ( KEEP(38) .NE. 0 )THEN + IF (KEEP(60).EQ.0) THEN + IOLDPS = PTLUST_S(STEP(KEEP(38))) + LOCAL_M = IW(IOLDPS+2+KEEP(IXSZ)) + LOCAL_N = IW(IOLDPS+1+KEEP(IXSZ)) + ELSE + IOLDPS = -999 + LOCAL_M = root%SCHUR_MLOC + LOCAL_N = root%SCHUR_NLOC + ENDIF + ITMP8 = int(LOCAL_M,8)*int(LOCAL_N,8) + LBUFRX = min(int(root%MBLOCK,8)*int(root%NBLOCK,8), + & int(root%TOT_ROOT_SIZE,8)*int(root%TOT_ROOT_SIZE,8) ) + IF ( LRLU .GT. LBUFRX ) THEN + BUFRX => A(POSFAC:POSFAC+LRLU-1_8) + LBUFRX=LRLU + IS_BUFRX_ALLOCATED = .FALSE. + ELSE + ALLOCATE( BUFRX( LBUFRX ), stat = IERR ) + IF (IERR.gt.0) THEN + INFO(1) = -9 + CALL MUMPS_731(LBUFRX, INFO(2) ) + IF (LP > 0 ) + & write(LP,*) ' Error allocating, real array ', + & 'of size before DMUMPS_146', LBUFRX + CALL MUMPS_ABORT() + ENDIF + IS_BUFRX_ALLOCATED = .FALSE. + ENDIF + CALL DMUMPS_146( MYID_NODES, + & root, N, KEEP(38), + & COMM_NODES, IW, LIW, IWPOS + 1, + & A, LA, PTRAST, PTLUST_S, PTRFAC, STEP, + & INFO(1), KEEP(50), KEEP(19), + & BUFRX(1), LBUFRX, KEEP,KEEP8, DKEEP ) + IF (IS_BUFRX_ALLOCATED) DEALLOCATE ( BUFRX ) + NULLIFY(BUFRX) + IF ( MYID_NODES .eq. + & MUMPS_275(PROCNODE_STEPS(STEP(KEEP(38))), + & SLAVEF) + & ) THEN + IF ( INFO(1) .EQ. -10 .OR. INFO(1) .EQ. -40 ) THEN + NPVW = NPVW + INFO(2) + ELSE + NPVW = NPVW + root%TOT_ROOT_SIZE + NMAXNPIV = max(NMAXNPIV,root%TOT_ROOT_SIZE) + END IF + END IF + IF (root%yes.AND.KEEP(60).EQ.0) THEN + IF (KEEP(252).EQ.0) THEN + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_L + NextPiv2beWritten = 1 + MonBloc%INODE = KEEP(38) + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 3 + MonBloc%NROW = LOCAL_M + MonBloc%NCOL = LOCAL_N + MonBloc%NFS = MonBloc%NCOL + MonBloc%Last = .TRUE. + MonBloc%LastPiv = MonBloc%NCOL + NULLIFY(MonBloc%INDICES) + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + LAST_CALL = .TRUE. + CALL DMUMPS_688 + & ( STRAT, TYPEFile, + & A(PTRFAC(STEP(KEEP(38)))), + & LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IERR,LAST_CALL) + ELSE IF (KEEP(201).EQ.2) THEN + KEEP8(31)=KEEP8(31)+ ITMP8 + CALL DMUMPS_576(KEEP(38),PTRFAC, + & KEEP,KEEP8,A,LA, ITMP8, IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error in DMUMPS_576' + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + IF (KEEP(201).NE.0 .OR. KEEP(252).NE.0) THEN + LRLUS = LRLUS + ITMP8 + IF (KEEP(252).NE.0) THEN + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS + & ,0_8,-ITMP8, + & KEEP,KEEP8,LRLU) + ELSE + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS + & ,ITMP8, + & 0_8, + & KEEP,KEEP8,LRLU) + ENDIF + IF (PTRFAC(STEP(KEEP(38))).EQ.POSFAC-ITMP8) THEN + POSFAC = POSFAC - ITMP8 + LRLU = LRLU + ITMP8 + ENDIF + ELSE + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS + & ,ITMP8, + & 0_8, + & KEEP,KEEP8,LRLU) + ENDIF + ENDIF + IF (root%yes. AND. KEEP(252) .NE. 0 .AND. + & (KEEP(60).EQ.0 .OR. KEEP(221).EQ.1)) THEN + IF (MYID_NODES .EQ. MASTER_ROOT) THEN + LRHS_CNTR_MASTER_ROOT = root%TOT_ROOT_SIZE*KEEP(253) + ELSE + LRHS_CNTR_MASTER_ROOT = 1 + ENDIF + ALLOCATE(root%RHS_CNTR_MASTER_ROOT( + & LRHS_CNTR_MASTER_ROOT), stat=IERR ) + IF (IERR.gt.0) THEN + INFO(1) = -13 + CALL MUMPS_731(LRHS_CNTR_MASTER_ROOT,INFO(2)) + IF (LP > 0 ) + & write(LP,*) ' Error allocating, real array ', + & 'of size before DMUMPS_146', + & LRHS_CNTR_MASTER_ROOT + CALL MUMPS_ABORT() + ENDIF + FWD_LOCAL_N_RHS = numroc(KEEP(253), root%NBLOCK, + & root%MYCOL, 0, root%NPCOL) + FWD_LOCAL_N_RHS = max(1,FWD_LOCAL_N_RHS) + CALL DMUMPS_156( MYID_NODES, + & root%TOT_ROOT_SIZE, KEEP(253), + & root%RHS_CNTR_MASTER_ROOT(1), LOCAL_M, + & FWD_LOCAL_N_RHS, root%MBLOCK, root%NBLOCK, + & root%RHS_ROOT(1,1), MASTER_ROOT, + & root%NPROW, root%NPCOL, COMM_NODES ) + & + ENDIF + ELSE + IF (KEEP(19).NE.0) THEN + CALL MPI_REDUCE(KEEP(109), GLOBK109, 1, + & MPI_INTEGER, MPI_SUM, + & MASTER_ROOT, + & COMM_NODES, IERR) + ENDIF + IF (ROOT_OWNER) THEN + IPOSROOT = PTLUST_S(STEP(KEEP(20))) + NFRONT = IW(IPOSROOT+KEEP(IXSZ)+3) + NFRONT8 = int(NFRONT,8) + IPOSROOTROWINDICES=IPOSROOT+6+KEEP(IXSZ)+ + & IW(IPOSROOT+5+KEEP(IXSZ)) + NPVW = NPVW + NFRONT + NMAXNPIV = max(NMAXNPIV,NFRONT) + END IF + IF (ROOT_OWNER.AND.KEEP(60).NE.0) THEN + IF ( PTRFAC(STEP(KEEP(20))) .EQ. POSFAC - + & NFRONT8*NFRONT8 ) THEN + POSFAC = POSFAC - NFRONT8*NFRONT8 + LRLUS = LRLUS + NFRONT8*NFRONT8 + LRLU = LRLUS + NFRONT8*NFRONT8 + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-NFRONT8*NFRONT8,KEEP,KEEP8,LRLU) + ENDIF + ENDIF + END IF + END IF + END IF + IF ( KEEP(38) .NE. 0 ) THEN + IF (MYID_NODES.EQ. + & MUMPS_275(PROCNODE_STEPS(STEP(KEEP(38))),SLAVEF) + & ) THEN + MAXFRW = max ( MAXFRW, root%TOT_ROOT_SIZE) + END IF + END IF + MAXFRT = MAXFRW + NTOTPV = NPVW + INFO(12) = NOFFW + RINFO(2) = dble(OPASSW) + RINFO(3) = dble(OPELIW) + INFO(13) = NELVAW + INFO(14) = COMP + RETURN + END SUBROUTINE DMUMPS_251 + SUBROUTINE DMUMPS_87( HEADER, KEEP253 ) + INTEGER HEADER( 6 ), KEEP253 + INTEGER NFRONT, NASS + NFRONT = HEADER(1) + IF ( HEADER(2) .ne. 0 ) THEN + WRITE(*,*) ' *** CHG_HEADER ERROR 1 :',HEADER(2) + CALL MUMPS_ABORT() + END IF + NASS = abs( HEADER( 3 ) ) + IF ( NASS .NE. abs( HEADER( 4 ) ) ) THEN + WRITE(*,*) ' *** CHG_HEADER ERROR 2 :',HEADER(3:4) + CALL MUMPS_ABORT() + END IF + IF ( NASS+KEEP253 .NE. NFRONT ) THEN + WRITE(*,*) ' *** CHG_HEADER ERROR 3 : not root' + CALL MUMPS_ABORT() + END IF + HEADER( 1 ) = KEEP253 + HEADER( 2 ) = 0 + HEADER( 3 ) = NFRONT + HEADER( 4 ) = NFRONT-KEEP253 + RETURN + END SUBROUTINE DMUMPS_87 + SUBROUTINE DMUMPS_136( id ) + USE DMUMPS_OOC + USE DMUMPS_STRUC_DEF + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + include 'mpif.h' + TYPE( DMUMPS_STRUC ) :: id + LOGICAL I_AM_SLAVE + INTEGER IERR, MASTER + PARAMETER ( MASTER = 0 ) + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. id%KEEP(46) .NE. 0 ) + IF (id%KEEP(201).GT.0 .AND. I_AM_SLAVE) THEN + CALL DMUMPS_587(id,IERR) + IF (IERR < 0) THEN + id%INFO(1) = -90 + id%INFO(2) = 0 + ENDIF + END IF + CALL MUMPS_276(id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID) + IF (id%root%gridinit_done) THEN + IF ( id%KEEP(38).NE.0 .and. id%root%yes ) THEN + CALL blacs_gridexit( id%root%CNTXT_BLACS ) + id%root%gridinit_done = .FALSE. + END IF + END IF + IF ( id%MYID .NE. MASTER .OR. id%KEEP(46) .ne. 0 ) THEN + CALL MPI_COMM_FREE( id%COMM_NODES, IERR ) + CALL MPI_COMM_FREE( id%COMM_LOAD, IERR ) + END IF + IF (associated(id%MEM_DIST)) THEN + DEALLOCATE(id%MEM_DIST) + NULLIFY(id%MEM_DIST) + ENDIF + IF (associated(id%MAPPING)) THEN + DEALLOCATE(id%MAPPING) + NULLIFY(id%MAPPING) + END IF + NULLIFY(id%SCHUR_CINTERFACE) + IF ( id%KEEP(52) .NE. -1 .or. id%MYID .ne. MASTER ) THEN + IF (associated(id%COLSCA)) THEN + DEALLOCATE(id%COLSCA) + NULLIFY(id%COLSCA) + ENDIF + IF (associated(id%ROWSCA)) THEN + DEALLOCATE(id%ROWSCA) + NULLIFY(id%ROWSCA) + ENDIF + END IF + IF (associated(id%PTLUST_S)) THEN + DEALLOCATE(id%PTLUST_S) + NULLIFY(id%PTLUST_S) + END IF + IF (associated(id%PTRFAC)) THEN + DEALLOCATE(id%PTRFAC) + NULLIFY(id%PTRFAC) + END IF + IF (associated(id%POIDS)) THEN + DEALLOCATE(id%POIDS) + NULLIFY(id%POIDS) + ENDIF + IF (associated(id%IS)) THEN + DEALLOCATE(id%IS) + NULLIFY(id%IS) + ENDIF + IF (associated(id%IS1)) THEN + DEALLOCATE(id%IS1) + NULLIFY(id%IS1) + ENDIF + IF (associated(id%STEP)) THEN + DEALLOCATE(id%STEP) + NULLIFY(id%STEP) + ENDIF + IF (associated(id%Step2node)) THEN + DEALLOCATE(id%Step2node) + NULLIFY(id%Step2node) + ENDIF + IF (associated(id%NE_STEPS)) THEN + DEALLOCATE(id%NE_STEPS) + NULLIFY(id%NE_STEPS) + ENDIF + IF (associated(id%ND_STEPS)) THEN + DEALLOCATE(id%ND_STEPS) + NULLIFY(id%ND_STEPS) + ENDIF + IF (associated(id%FRERE_STEPS)) THEN + DEALLOCATE(id%FRERE_STEPS) + NULLIFY(id%FRERE_STEPS) + ENDIF + IF (associated(id%DAD_STEPS)) THEN + DEALLOCATE(id%DAD_STEPS) + NULLIFY(id%DAD_STEPS) + ENDIF + IF (associated(id%SYM_PERM)) THEN + DEALLOCATE(id%SYM_PERM) + NULLIFY(id%SYM_PERM) + ENDIF + IF (associated(id%UNS_PERM)) THEN + DEALLOCATE(id%UNS_PERM) + NULLIFY(id%UNS_PERM) + ENDIF + IF (associated(id%PIVNUL_LIST)) THEN + DEALLOCATE(id%PIVNUL_LIST) + NULLIFY(id%PIVNUL_LIST) + ENDIF + IF (associated(id%FILS)) THEN + DEALLOCATE(id%FILS) + NULLIFY(id%FILS) + ENDIF + IF (associated(id%PTRAR)) THEN + DEALLOCATE(id%PTRAR) + NULLIFY(id%PTRAR) + ENDIF + IF (associated(id%FRTPTR)) THEN + DEALLOCATE(id%FRTPTR) + NULLIFY(id%FRTPTR) + ENDIF + IF (associated(id%FRTELT)) THEN + DEALLOCATE(id%FRTELT) + NULLIFY(id%FRTELT) + ENDIF + IF (associated(id%NA)) THEN + DEALLOCATE(id%NA) + NULLIFY(id%NA) + ENDIF + IF (associated(id%PROCNODE_STEPS)) THEN + DEALLOCATE(id%PROCNODE_STEPS) + NULLIFY(id%PROCNODE_STEPS) + ENDIF + IF (associated(id%PROCNODE)) THEN + DEALLOCATE(id%PROCNODE) + NULLIFY(id%PROCNODE) + ENDIF + IF (associated(id%RHSCOMP)) THEN + DEALLOCATE(id%RHSCOMP) + NULLIFY(id%RHSCOMP) + ENDIF + IF (associated(id%POSINRHSCOMP)) THEN + DEALLOCATE(id%POSINRHSCOMP) + NULLIFY(id%POSINRHSCOMP) + ENDIF + IF (id%KEEP(46).eq.1 .and. + & id%KEEP(55).ne.0 .and. + & id%MYID .eq. MASTER .and. + & id%KEEP(52) .eq. 0 ) THEN + NULLIFY(id%DBLARR) + ELSE + IF (associated(id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + END IF + IF (associated(id%INTARR)) THEN + DEALLOCATE(id%INTARR) + NULLIFY(id%INTARR) + ENDIF + IF (associated(id%root%RG2L_ROW))THEN + DEALLOCATE(id%root%RG2L_ROW) + NULLIFY(id%root%RG2L_ROW) + ENDIF + IF (associated(id%root%RG2L_COL))THEN + DEALLOCATE(id%root%RG2L_COL) + NULLIFY(id%root%RG2L_COL) + ENDIF + IF (associated(id%root%IPIV)) THEN + DEALLOCATE(id%root%IPIV) + NULLIFY(id%root%IPIV) + ENDIF + IF (associated(id%root%RHS_CNTR_MASTER_ROOT)) THEN + DEALLOCATE(id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY(id%root%RHS_CNTR_MASTER_ROOT) + ENDIF + IF (associated(id%root%RHS_ROOT))THEN + DEALLOCATE(id%root%RHS_ROOT) + NULLIFY(id%root%RHS_ROOT) + ENDIF + CALL DMUMPS_636(id) + IF (associated(id%ELTPROC)) THEN + DEALLOCATE(id%ELTPROC) + NULLIFY(id%ELTPROC) + ENDIF + IF (associated(id%CANDIDATES)) THEN + DEALLOCATE(id%CANDIDATES) + NULLIFY(id%CANDIDATES) + ENDIF + IF (associated(id%I_AM_CAND)) THEN + DEALLOCATE(id%I_AM_CAND) + NULLIFY(id%I_AM_CAND) + ENDIF + IF (associated(id%ISTEP_TO_INIV2)) THEN + DEALLOCATE(id%ISTEP_TO_INIV2) + NULLIFY(id%ISTEP_TO_INIV2) + ENDIF + IF (I_AM_SLAVE) THEN + IF (associated(id%TAB_POS_IN_PERE)) THEN + DEALLOCATE(id%TAB_POS_IN_PERE) + NULLIFY(id%TAB_POS_IN_PERE) + ENDIF + IF (associated(id%FUTURE_NIV2)) THEN + DEALLOCATE(id%FUTURE_NIV2) + NULLIFY(id%FUTURE_NIV2) + ENDIF + ENDIF + IF(associated(id%DEPTH_FIRST))THEN + DEALLOCATE(id%DEPTH_FIRST) + NULLIFY(id%DEPTH_FIRST) + ENDIF + IF(associated(id%DEPTH_FIRST_SEQ))THEN + DEALLOCATE(id%DEPTH_FIRST_SEQ) + NULLIFY(id%DEPTH_FIRST_SEQ) + ENDIF + IF(associated(id%SBTR_ID))THEN + DEALLOCATE(id%SBTR_ID) + NULLIFY(id%SBTR_ID) + ENDIF + IF (associated(id%MEM_SUBTREE)) THEN + DEALLOCATE(id%MEM_SUBTREE) + NULLIFY(id%MEM_SUBTREE) + ENDIF + IF (associated(id%MY_ROOT_SBTR)) THEN + DEALLOCATE(id%MY_ROOT_SBTR) + NULLIFY(id%MY_ROOT_SBTR) + ENDIF + IF (associated(id%MY_FIRST_LEAF)) THEN + DEALLOCATE(id%MY_FIRST_LEAF) + NULLIFY(id%MY_FIRST_LEAF) + ENDIF + IF (associated(id%MY_NB_LEAF)) THEN + DEALLOCATE(id%MY_NB_LEAF) + NULLIFY(id%MY_NB_LEAF) + ENDIF + IF (associated(id%COST_TRAV)) THEN + DEALLOCATE(id%COST_TRAV) + NULLIFY(id%COST_TRAV) + ENDIF + IF(associated (id%OOC_INODE_SEQUENCE))THEN + DEALLOCATE(id%OOC_INODE_SEQUENCE) + NULLIFY(id%OOC_INODE_SEQUENCE) + ENDIF + IF(associated (id%OOC_TOTAL_NB_NODES))THEN + DEALLOCATE(id%OOC_TOTAL_NB_NODES) + NULLIFY(id%OOC_TOTAL_NB_NODES) + ENDIF + IF(associated (id%OOC_SIZE_OF_BLOCK))THEN + DEALLOCATE(id%OOC_SIZE_OF_BLOCK) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + ENDIF + IF(associated (id%OOC_VADDR))THEN + DEALLOCATE(id%OOC_VADDR) + NULLIFY(id%OOC_VADDR) + ENDIF + IF(associated (id%OOC_NB_FILES))THEN + DEALLOCATE(id%OOC_NB_FILES) + NULLIFY(id%OOC_NB_FILES) + ENDIF + IF (id%KEEP8(24).EQ.0_8) THEN + IF (associated(id%S)) DEALLOCATE(id%S) + ELSE + ENDIF + NULLIFY(id%S) + IF (I_AM_SLAVE) THEN + CALL DMUMPS_57( IERR ) + CALL DMUMPS_59( IERR ) + END IF + IF ( associated( id%BUFR ) ) DEALLOCATE( id%BUFR ) + NULLIFY( id%BUFR ) + RETURN + END SUBROUTINE DMUMPS_136 + SUBROUTINE DMUMPS_150(MYID,COMM,S,MAXS,MAXS_BYTES) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + INTEGER COMM, MYID, MAXS, MAXS_BYTES + INTEGER S( MAXS ) + INTEGER MSGTAG, MSGSOU, MSGLEN + LOGICAL FLAG + FLAG = .TRUE. + DO WHILE ( FLAG ) + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + IF (FLAG) THEN + MSGTAG=STATUS(MPI_TAG) + MSGSOU=STATUS(MPI_SOURCE) + CALL MPI_GET_COUNT(STATUS,MPI_PACKED,MSGLEN,IERR) + IF (MSGLEN <= MAXS_BYTES) THEN + CALL MPI_RECV(S(1),MAXS_BYTES,MPI_PACKED, + & MSGSOU, MSGTAG, COMM, STATUS, IERR) + ELSE + EXIT + ENDIF + END IF + END DO + CALL MPI_BARRIER( COMM, IERR ) + RETURN + END SUBROUTINE DMUMPS_150 + SUBROUTINE DMUMPS_254(COMM_LOAD, ASS_IRECV, + & N, INODE, TYPE, TYPEF, + & LA, IW, LIW, A, + & IFLAG, IERROR, OPELIW, NELVAW, NMAXNPIV, + & PTRIST, PTLUST_S, + & PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, NE, + & POSFAC, LRLU, LRLUS, IPTRLU, ICNTL, KEEP,KEEP8, + & COMP, IWPOS, IWPOSCB, PROCNODE_STEPS, SLAVEF, + & FPERE, COMM, MYID, + & IPOOL, LPOOL, LEAF, NSTK_S, + & NBPROCFILS, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, root, + & OPASSW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE DMUMPS_COMM_BUFFER + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER COMM, MYID, TYPE, TYPEF + INTEGER N, LIW, INODE,IFLAG,IERROR + INTEGER ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA, POSFAC, LRLU, LRLUS, IPTRLU + INTEGER IWPOSCB, IWPOS, + & FPERE, SLAVEF, NELVAW, NMAXNPIV + INTEGER IW(LIW),PROCNODE_STEPS(KEEP(28)) + INTEGER(8) :: PTRAST (KEEP(28)) + INTEGER(8) :: PTRFAC (KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)), NE(KEEP(28)) + DOUBLE PRECISION A(LA) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER ITLOC( N + KEEP(253) ), FILS( N ), + & ND( KEEP(28) ), FRERE( KEEP(28) ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER LPOOL, LEAF, COMP + INTEGER IPOOL( LPOOL ) + INTEGER NSTK_S( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER NBFIN + INTEGER NFRONT_ESTIM,NELIM_ESTIM + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER LP + INTEGER NBROWS_ALREADY_SENT + INTEGER(8) :: POSELT, OPSFAC + INTEGER(8) :: IOLD, INEW, FACTOR_POS + INTEGER NSLAVES, NCB, + & H_INODE, IERR, NBCOL, NBROW, NBROW_SEND, + & NBROW_STACK, NBCOL_STACK, NELIM + INTEGER NCBROW_ALREADY_MOVED, NCBROW_PREVIOUSLY_MOVED, + &NCBROW_NEWLY_MOVED + INTEGER(8) :: LAST_ALLOWED_POS + INTEGER(8) :: LREQCB, MIN_SPACE_IN_PLACE + INTEGER(8) :: SHIFT_VAL_SON + INTEGER SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON, + & LIST_ROW_SON, LIST_COL_SON, LIST_SLAVES + INTEGER IOLDPS,NFRONT,NPIV,NASS,IOLDP1,PTROWEND, + & LREQI, LCONT + INTEGER I,LDA, INIV2 + INTEGER MSGDEST, MSGTAG, CHK_LOAD + INCLUDE 'mumps_headers.h' + LOGICAL COMPRESSCB, MUST_COMPACT_FACTORS + LOGICAL INPLACE + INTEGER(8) :: SIZE_INPLACE + INTEGER INTSIZ + DOUBLE PRECISION FLOP1, FLOP1_EFFECTIVE + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + LOGICAL SSARBR, SSARBR_ROOT, MUMPS_167, + &MUMPS_170 + EXTERNAL MUMPS_167, MUMPS_170 + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + INPLACE = .FALSE. + MIN_SPACE_IN_PLACE = 0_8 + IOLDPS = PTLUST_S(STEP(INODE)) + INTSIZ = IW(IOLDPS+XXI) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NPIV = IW(IOLDPS + 1+KEEP(IXSZ)) + NMAXNPIV = max(NPIV, NMAXNPIV) + NASS = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + H_INODE= 6 + NSLAVES + KEEP(IXSZ) + LCONT = NFRONT - NPIV + NBCOL = LCONT + SSARBR = MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + SSARBR_ROOT = MUMPS_170 + & (PROCNODE_STEPS(STEP(INODE)),SLAVEF) + LREQCB = 0_8 + INPLACE = .FALSE. + COMPRESSCB= ((KEEP(215).EQ.0) + & .AND.(KEEP(50).NE.0) + & .AND.(TYPEF.EQ.1 + & .OR.TYPEF.EQ.2 + & ) + & .AND.(TYPE.EQ.1)) + MUST_COMPACT_FACTORS = .TRUE. + IF (KEEP(201).EQ.1 .OR. KEEP(201).EQ.-1) THEN + MUST_COMPACT_FACTORS = .FALSE. + ENDIF + IF ((FPERE.EQ.0).AND.(NASS.NE.NPIV)) THEN + IFLAG = -10 + GOTO 600 + ENDIF + NBROW = LCONT + IF (TYPE.EQ.2) NBROW = NASS - NPIV + IF ((KEEP(50).NE.0).AND.(TYPE.EQ.2)) THEN + LDA = NASS + ELSE + LDA = NFRONT + ENDIF + NBROW_SEND = NBROW + NELIM = NASS-NPIV + IF (TYPEF.EQ.2) NBROW_SEND = NELIM + POSELT = PTRAST(STEP(INODE)) + IF (POSELT .ne. PTRFAC(STEP(INODE))) THEN + WRITE(*,*) "Error 1 in G" + CALL MUMPS_ABORT() + END IF + NELVAW = NELVAW + NASS - NPIV + IF (KEEP(50) .eq. 0) THEN + KEEP8(10) = KEEP8(10) + int(NPIV,8) * int(NFRONT,8) + ELSE + KEEP8(10) = KEEP8(10) + ( int(NPIV,8)*int(NPIV+1,8) )/ 2_8 + ENDIF + KEEP8(10) = KEEP8(10) + int(NBROW,8) * int(NPIV,8) + CALL MUMPS_511( NFRONT, NPIV, NASS, + & KEEP(50), TYPE,FLOP1 ) + IF ( (.NOT. SSARBR_ROOT) .and. TYPE == 1) THEN + IF (NE(STEP(INODE))==0) THEN + CHK_LOAD=0 + ELSE + CHK_LOAD=1 + ENDIF + CALL DMUMPS_190(CHK_LOAD, .FALSE., -FLOP1, + & KEEP,KEEP8) + ENDIF + FLOP1_EFFECTIVE = FLOP1 + OPELIW = OPELIW + FLOP1 + IF ( NPIV .NE. NASS ) THEN + CALL MUMPS_511( NFRONT, NASS, NASS, + & KEEP(50), TYPE,FLOP1 ) + IF (.NOT. SSARBR_ROOT ) THEN + IF (NE(STEP(INODE))==0) THEN + CHK_LOAD=0 + ELSE + CHK_LOAD=1 + ENDIF + CALL DMUMPS_190(CHK_LOAD, .FALSE., + & FLOP1_EFFECTIVE-FLOP1, + & KEEP,KEEP8) + ENDIF + END IF + IF ( SSARBR_ROOT ) THEN + NFRONT_ESTIM=ND(STEP(INODE)) + KEEP(253) + NELIM_ESTIM=NASS-(NFRONT-NFRONT_ESTIM) + CALL MUMPS_511(NFRONT_ESTIM,NELIM_ESTIM,NELIM_ESTIM, + & KEEP(50),1,FLOP1) + END IF + FLOP1=-FLOP1 + IF (SSARBR_ROOT) THEN + CALL DMUMPS_190(0,.FALSE.,FLOP1,KEEP,KEEP8) + ELSE + CALL DMUMPS_190(2,.FALSE.,FLOP1,KEEP,KEEP8) + ENDIF + IF ( FPERE .EQ. 0 ) THEN + IF ( KEEP(253) .NE. 0 .AND. KEEP(201).NE.-1 + & .AND. KEEP(201).NE.1 ) THEN + MUST_COMPACT_FACTORS = .TRUE. + GOTO 190 + ELSE + MUST_COMPACT_FACTORS = .FALSE. + GOTO 190 + ENDIF + ENDIF + IF ( FPERE.EQ.KEEP(38) ) THEN + NCB = NFRONT - NASS + SHIFT_LIST_ROW_SON = H_INODE + NASS + SHIFT_LIST_COL_SON = H_INODE + NFRONT + NASS + SHIFT_VAL_SON = int(NASS,8)*int(NFRONT+1,8) + IF (TYPE.EQ.1) THEN + CALL DMUMPS_80( + & COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTLUST_S, PTRAST, + & root, NCB, NCB, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT, + & ROOT_CONT_STATIC, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG < 0 ) GOTO 500 + ENDIF + MSGDEST= MUMPS_275(PROCNODE_STEPS(STEP(FPERE)),SLAVEF) + IOLDPS = PTLUST_S(STEP(INODE)) + LIST_ROW_SON = IOLDPS + H_INODE + NPIV + LIST_COL_SON = IOLDPS + H_INODE + NFRONT + NPIV + LIST_SLAVES = IOLDPS + 6 + KEEP(IXSZ) + IF (MSGDEST.EQ.MYID) THEN + CALL DMUMPS_273( root, + & INODE, NELIM, NSLAVES, IW(LIST_ROW_SON), + & IW(LIST_COL_SON), IW(LIST_SLAVES), + & + & PROCNODE_STEPS, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & ITLOC, RHS_MUMPS, COMP, + & IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8, + & COMM, COMM_LOAD, FILS, ND) + IF (IFLAG.LT.0) GOTO 600 + ELSE + IERR = -1 + DO WHILE (IERR.EQ.-1) + CALL DMUMPS_76( INODE, NELIM, + & IW(LIST_ROW_SON), IW(LIST_COL_SON), NSLAVES, + & IW(LIST_SLAVES), MSGDEST, COMM, IERR) + IF ( IERR .EQ. -1 ) THEN + BLOCKING =.FALSE. + SET_IRECV =.TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, + & ND, FRERE, LPTRAR, NELT, + & FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & .TRUE.) + IF ( IFLAG .LT. 0 ) GOTO 500 + IOLDPS = PTLUST_S(STEP(INODE)) + LIST_ROW_SON = IOLDPS + H_INODE + NPIV + LIST_COL_SON = IOLDPS + H_INODE + NFRONT + NPIV + LIST_SLAVES = IOLDPS + 6 + KEEP(IXSZ) + ENDIF + ENDDO + IF ( IERR .EQ. -2 ) THEN + IERROR = ( 3 + NSLAVES + 2 * NELIM ) * KEEP( 34 ) + IFLAG = - 17 + GOTO 600 + ELSE IF ( IERR .EQ. -3 ) THEN + IERROR = ( 3 + NSLAVES + 2 * NELIM ) * KEEP( 34 ) + IFLAG = -20 + GOTO 600 + ENDIF + ENDIF + IF (NELIM.EQ.0) THEN + POSELT = PTRAST(STEP(INODE)) + OPSFAC = POSELT + int(NPIV,8) * int(NFRONT,8) + int(NPIV,8) + GOTO 190 + ELSE + GOTO 500 + ENDIF + ENDIF + OPSFAC = POSELT + int(NPIV,8) * int(LDA,8) + int(NPIV,8) + IF ( MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .NE. MYID ) THEN + MSGTAG =NOEUD + MSGDEST=MUMPS_275( PROCNODE_STEPS(STEP(FPERE)), SLAVEF ) + IERR = -1 + NBROWS_ALREADY_SENT = 0 + DO WHILE (IERR.EQ.-1) + IF ( (TYPE.EQ.1) .AND. (TYPEF.EQ.1) ) THEN + CALL DMUMPS_66( NBROWS_ALREADY_SENT, + & INODE, FPERE, NFRONT, + & LCONT, NASS, NPIV, IW( IOLDPS + H_INODE + NPIV ), + & IW( IOLDPS + H_INODE + NPIV + NFRONT ), + & A( OPSFAC ), COMPRESSCB, + & MSGDEST, MSGTAG, COMM, IERR ) + ELSE + IF ( (TYPE.EQ.2).AND.(KEEP(48).NE.0)) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + ELSE + INIV2 = -9999 + ENDIF + CALL DMUMPS_70( NBROWS_ALREADY_SENT, + & FPERE, INODE, + & NBROW_SEND, IW(IOLDPS + H_INODE + NPIV ), + & NBCOL, IW(IOLDPS + H_INODE + NPIV + NFRONT ), + & A(OPSFAC), LDA, NELIM, TYPE, + & NSLAVES, IW(IOLDPS+6+KEEP(IXSZ)), MSGDEST, + & COMM, IERR, + & + & SLAVEF, KEEP,KEEP8, INIV2, TAB_POS_IN_PERE ) + END IF + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IOLDPS = PTLUST_S(STEP( INODE )) + OPSFAC = POSELT + int(NPIV,8) * int(LDA,8) + int(NPIV,8) + END DO + IF ( IERR .EQ. -2 .OR. IERR .EQ. -3 ) THEN + IF ( (TYPE.EQ.1) .AND. (TYPEF.EQ.1) ) THEN + IERROR = ( 2*LCONT + 9 ) * KEEP( 34 ) + + & LCONT*LCONT * KEEP( 35 ) + ELSE IF (KEEP(50).ne.0 .AND. TYPE .eq. 2 ) THEN + IERROR = ( NBROW_SEND + NBCOL+ 5 + NSLAVES) + & * KEEP( 34 ) + + & NBROW_SEND*NBROW_SEND*KEEP( 35 ) + ELSE + IERROR = ( NBROW_SEND + NBCOL+ 5 + NSLAVES) * KEEP( 34 ) + + & NBROW_SEND*NBCOL*KEEP( 35 ) + ENDIF + IF (IERR .EQ. -2) THEN + IFLAG = -17 + IF ( LP > 0 ) THEN + WRITE(LP, *) MYID, + & ": FAILURE, SEND BUFFER TOO SMALL DURING + & DMUMPS_254", TYPE, TYPEF + ENDIF + ENDIF + IF (IERR .EQ. -3) THEN + IFLAG = -20 + IF ( LP > 0 ) THEN + WRITE(LP, *) MYID, + & ": FAILURE, RECV BUFFER TOO SMALL DURING + & DMUMPS_254", TYPE, TYPEF + ENDIF + ENDIF + GOTO 600 + ENDIF + ENDIF + IF ( MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .EQ. MYID ) THEN + LREQI = 2 + KEEP(IXSZ) + NBROW_STACK = NBROW + NBROW_SEND = 0 + IF ((KEEP(50).NE.0).AND.(TYPE.EQ.2)) THEN + NBCOL_STACK = NBROW + ELSE + NBCOL_STACK = NBCOL + ENDIF + ELSE + NBROW_STACK = NBROW-NBROW_SEND + NBCOL_STACK = NBCOL + LREQI = 6 + NBROW_STACK + NBCOL + KEEP(IXSZ) + IF (.NOT. (TYPE.EQ.1 .AND. TYPEF.EQ.2 ) ) GOTO 190 + IF (FPERE.EQ.0) GOTO 190 + ENDIF + IF (COMPRESSCB) THEN + LREQCB = ( int(NBCOL_STACK,8) * int( NBCOL_STACK + 1, 8) ) / 2_8 + & - ( int(NBROW_SEND ,8) * int( NBROW_SEND + 1, 8) ) / 2_8 + ELSE + LREQCB = int(NBROW_STACK,8) * int(NBCOL_STACK,8) + ENDIF + INPLACE = ( KEEP(234).NE.0 ) + IF (KEEP(50).NE.0 .AND. TYPE .EQ. 2) INPLACE = .FALSE. + INPLACE = INPLACE .OR. .NOT. MUST_COMPACT_FACTORS + INPLACE = INPLACE .AND. + & ( PTLUST_S(STEP(INODE)) + INTSIZ .EQ. IWPOS ) + MIN_SPACE_IN_PLACE = 0_8 + IF ( INPLACE .AND. KEEP(50).eq. 0 .AND. + & MUST_COMPACT_FACTORS) THEN + MIN_SPACE_IN_PLACE = int(NBCOL_STACK,8) + ENDIF + IF ( MIN_SPACE_IN_PLACE .GT. LREQCB ) THEN + INPLACE = .FALSE. + ENDIF + CALL DMUMPS_22( INPLACE, MIN_SPACE_IN_PLACE, + & SSARBR, .FALSE., + & MYID,N,KEEP,KEEP8,IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER,PAMASTER, + & LREQI, LREQCB, INODE, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR ) + IF (IFLAG.LT.0) GOTO 600 + PTRIST(STEP(INODE)) = IWPOSCB+1 + IF ( MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .EQ. MYID ) THEN + PIMASTER (STEP(INODE)) = PTLUST_S(STEP(INODE)) + PAMASTER(STEP(INODE)) = IPTRLU + 1_8 + PTRAST(STEP(INODE)) = -99999999_8 + IW(IWPOSCB+1+KEEP(IXSZ)) = min(-NBCOL_STACK,-1) + IW(IWPOSCB+2+KEEP(IXSZ)) = NBROW_STACK + IF (COMPRESSCB) IW(IWPOSCB+1+XXS) = S_CB1COMP + ELSE + PTRAST(STEP(INODE)) = IPTRLU+1_8 + IF (COMPRESSCB) IW(IWPOSCB+1+XXS)=S_CB1COMP + IW(IWPOSCB+1+KEEP(IXSZ)) = NBCOL + IW(IWPOSCB+2+KEEP(IXSZ)) = 0 + IW(IWPOSCB+3+KEEP(IXSZ)) = NBROW_STACK + IW(IWPOSCB+4+KEEP(IXSZ)) = 0 + IW(IWPOSCB+5+KEEP(IXSZ)) = 1 + IW(IWPOSCB+6+KEEP(IXSZ)) = 0 + IOLDP1 = PTLUST_S(STEP(INODE))+H_INODE + PTROWEND = IWPOSCB+6+NBROW_STACK+KEEP(IXSZ) + DO I = 1, NBROW_STACK + IW(IWPOSCB+7+KEEP(IXSZ)+I-1) = + & IW(IOLDP1+NFRONT-NBROW_STACK+I-1) + ENDDO + DO I = 1, NBCOL + IW(PTROWEND+I)=IW(IOLDP1+NFRONT+NPIV+I-1) + ENDDO + END IF + IF ( KEEP(50).NE.0 .AND. TYPE .EQ. 1 + & .AND. MUST_COMPACT_FACTORS ) THEN + POSELT = PTRFAC(STEP(INODE)) + CALL DMUMPS_324(A(POSELT), LDA, + & NPIV, NBROW, KEEP(50)) + MUST_COMPACT_FACTORS = .FALSE. + ENDIF + IF ( KEEP(50).EQ.0 .AND. MUST_COMPACT_FACTORS ) + & THEN + LAST_ALLOWED_POS = POSELT + int(LDA,8)*int(NPIV+NBROW-1,8) + & + int(NPIV,8) + ELSE + LAST_ALLOWED_POS = -1_8 + ENDIF + NCBROW_ALREADY_MOVED = 0 + 10 CONTINUE + NCBROW_PREVIOUSLY_MOVED = NCBROW_ALREADY_MOVED + IF (IPTRLU .LT. POSFAC ) THEN + CALL DMUMPS_652( A, LA, LDA, + & POSELT, IPTRLU, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, LREQCB, KEEP, COMPRESSCB, + & LAST_ALLOWED_POS, NCBROW_ALREADY_MOVED ) + ELSE + CALL DMUMPS_705( A, LA, LDA, + & POSELT, IPTRLU, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, LREQCB, KEEP, COMPRESSCB ) + NCBROW_ALREADY_MOVED = NBROW_STACK + ENDIF + IF (LAST_ALLOWED_POS .NE. -1_8) THEN + MUST_COMPACT_FACTORS =.FALSE. + IF ( NCBROW_ALREADY_MOVED .EQ. NBROW_STACK ) THEN + NCBROW_ALREADY_MOVED = NCBROW_ALREADY_MOVED + NBROW_SEND + ENDIF + NCBROW_NEWLY_MOVED = NCBROW_ALREADY_MOVED + & - NCBROW_PREVIOUSLY_MOVED + FACTOR_POS = POSELT + + & int(LDA,8)*int(NPIV+NBROW-NCBROW_ALREADY_MOVED,8) + CALL DMUMPS_651( A(FACTOR_POS), LDA, NPIV, + & NCBROW_NEWLY_MOVED ) + INEW = FACTOR_POS + int(NPIV,8) * int(NCBROW_NEWLY_MOVED,8) + IOLD = INEW + int(NCBROW_NEWLY_MOVED,8) * int(NBCOL_STACK,8) + DO I = 1, NCBROW_PREVIOUSLY_MOVED*NPIV + A(INEW) = A(IOLD) + IOLD = IOLD + 1_8 + INEW = INEW + 1_8 + ENDDO + KEEP8(8)=KEEP8(8) + int(NCBROW_PREVIOUSLY_MOVED,8) + & * int(NPIV,8) + LAST_ALLOWED_POS = INEW + IF (NCBROW_ALREADY_MOVED.LT.NBROW_STACK) THEN + GOTO 10 + ENDIF + ENDIF + 190 CONTINUE + IF (MUST_COMPACT_FACTORS) THEN + POSELT = PTRFAC(STEP(INODE)) + CALL DMUMPS_324(A(POSELT), LDA, + & NPIV, NBROW, KEEP(50)) + MUST_COMPACT_FACTORS = .FALSE. + ENDIF + IOLDPS = PTLUST_S(STEP(INODE)) + IW(IOLDPS+KEEP(IXSZ)) = NBCOL + IW(IOLDPS + 1+KEEP(IXSZ)) = NASS - NPIV + IF (TYPE.EQ.2) THEN + IW(IOLDPS + 2+KEEP(IXSZ)) = NASS + ELSE + IW(IOLDPS + 2+KEEP(IXSZ)) = NFRONT + ENDIF + IW(IOLDPS + 3+KEEP(IXSZ)) = NPIV + IF (INPLACE) THEN + SIZE_INPLACE = LREQCB - MIN_SPACE_IN_PLACE + ELSE + SIZE_INPLACE = 0_8 + ENDIF + CALL DMUMPS_93(SIZE_INPLACE,MYID,N,IOLDPS,TYPE, IW, LIW, + & A, LA, POSFAC, LRLU, LRLUS, + & IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8, SSARBR,INODE,IERR) + IF(IERR.LT.0)THEN + IFLAG=IERR + IERROR=0 + GOTO 600 + ENDIF + 500 CONTINUE + RETURN + 600 CONTINUE + IF (IFLAG .NE. -1) CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE DMUMPS_254 + SUBROUTINE DMUMPS_142( id) + USE DMUMPS_COMM_BUFFER + USE DMUMPS_LOAD + USE DMUMPS_OOC + USE DMUMPS_STRUC_DEF + IMPLICIT NONE +#ifndef SUN_ + INTERFACE + SUBROUTINE DMUMPS_27(id, ANORMINF, LSCAL) + USE DMUMPS_STRUC_DEF + TYPE (DMUMPS_STRUC), TARGET :: id + DOUBLE PRECISION, INTENT(OUT) :: ANORMINF + LOGICAL :: LSCAL + END SUBROUTINE DMUMPS_27 + END INTERFACE +#endif + TYPE(DMUMPS_STRUC), TARGET :: id + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER IERR, MASTER + PARAMETER( MASTER = 0 ) + INCLUDE 'mumps_headers.h' + INTEGER NSEND, NSEND_TOT, LDPTRAR, NELT + INTEGER NLOCAL, NLOCAL_TOT, KEEP13_SAVE, ITMP + INTEGER(8) K67 + INTEGER(8) ITMP8 + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER MP, LP, MPG, allocok + LOGICAL PROK, PROKG, LSCAL + INTEGER DMUMPS_LBUF, DMUMPS_LBUFR_BYTES, DMUMPS_LBUF_INT + INTEGER PTRIST, PTRWB, MAXELT_SIZE, + & ITLOC, IPOOL, NSTEPS, K28, LPOOL, LIW + INTEGER IRANK, ID_ROOT + INTEGER KKKK, NZ_locMAX + INTEGER(8) MEMORY_MD_ARG + INTEGER(8) MAXS_BASE8, MAXS_BASE_RELAXED8 + DOUBLE PRECISION CNTL4 + INTEGER MIN_PERLU, MAXIS_ESTIM + INTEGER MAXIS + INTEGER(8) :: MAXS + DOUBLE PRECISION TIME + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INTEGER PERLU, TOTAL_MBYTES, K231, K232, K233 + INTEGER COLOUR, COMM_FOR_SCALING + INTEGER LIWK, LWK, LWK_REAL + LOGICAL I_AM_SLAVE, PERLU_ON, WK_USER_PROVIDED + DOUBLE PRECISION :: ANORMINF, SEUIL, SEUIL_LDLT_NIV2 + DOUBLE PRECISION :: CNTL1, CNTL3, CNTL5, CNTL6, EPS + INTEGER N, LPN_LIST,POSBUF + INTEGER, DIMENSION (:), ALLOCATABLE :: ITMP2 + INTEGER I,K + INTEGER, DIMENSION(:), ALLOCATABLE :: IWK + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: WK + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: WK_REAL + INTEGER(8), DIMENSION(:), ALLOCATABLE :: IWK8 + INTEGER, DIMENSION(:), ALLOCATABLE :: BURP + INTEGER, DIMENSION(:), ALLOCATABLE :: BUCP + INTEGER, DIMENSION(:), ALLOCATABLE :: BURS + INTEGER, DIMENSION(:), ALLOCATABLE :: BUCS + INTEGER BUREGISTRE(12) + INTEGER BUINTSZ, BURESZ, BUJOB + INTEGER BUMAXMN, M, SCMYID, SCNPROCS + DOUBLE PRECISION SCONEERR, SCINFERR + INTEGER, POINTER :: JOB, NZ + DOUBLE PRECISION,DIMENSION(:),POINTER::RINFO, RINFOG + DOUBLE PRECISION,DIMENSION(:),POINTER:: CNTL + INTEGER,DIMENSION(:),POINTER::INFO, INFOG, KEEP + INTEGER, DIMENSION(:), POINTER :: MYIRN_loc, MYJCN_loc + DOUBLE PRECISION, DIMENSION(:), POINTER :: MYA_loc + INTEGER, TARGET :: DUMMYIRN_loc(1), DUMMYJCN_loc(1) + DOUBLE PRECISION, TARGET :: DUMMYA_loc(1) + INTEGER(8),DIMENSION(:),POINTER::KEEP8 + INTEGER,DIMENSION(:),POINTER::ICNTL + EXTERNAL DMUMPS_505 + INTEGER DMUMPS_505 + INTEGER(8) TOTAL_BYTES + INTEGER(8) :: I8TMP + INTEGER numroc + EXTERNAL numroc + DOUBLE PRECISION, DIMENSION(:), POINTER :: RHS_MUMPS + LOGICAL :: RHS_MUMPS_ALLOCATED + JOB=>id%JOB + NZ=>id%NZ + RINFO=>id%RINFO + RINFOG=>id%RINFOG + CNTL=>id%CNTL + INFO=>id%INFO + INFOG=>id%INFOG + KEEP=>id%KEEP + KEEP8=>id%KEEP8 + ICNTL=>id%ICNTL + IF (id%NZ_loc .NE. 0) THEN + MYIRN_loc=>id%IRN_loc + MYJCN_loc=>id%JCN_loc + MYA_loc=>id%A_loc + ELSE + MYIRN_loc=>DUMMYIRN_loc + MYJCN_loc=>DUMMYJCN_loc + MYA_loc=>DUMMYA_loc + ENDIF + N = id%N + EPS = epsilon ( ZERO ) + NULLIFY(RHS_MUMPS) + RHS_MUMPS_ALLOCATED = .FALSE. + IF (KEEP8(24).GT.0_8) THEN + NULLIFY(id%S) + ENDIF + WK_USER_PROVIDED = (id%LWK_USER.NE.0) + IF (WK_USER_PROVIDED) THEN + IF (id%LWK_USER.GT.0) THEN + KEEP8(24) = int(id%LWK_USER,8) + ELSE + KEEP8(24) = -int(id%LWK_USER,8)* 1000000_8 + ENDIF + ELSE + KEEP8(24) = 0_8 + ENDIF + KEEP13_SAVE = KEEP(13) + id%DKEEP(4)=-1.0D0 + id%DKEEP(5)=-1.0D0 + MP = ICNTL( 2 ) + MPG = ICNTL( 3 ) + LP = ICNTL( 1 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF ( PROK ) WRITE( MP, 130 ) + IF ( PROKG ) WRITE( MPG, 130 ) + IF ( PROKG .and. KEEP(53).GT.0 ) THEN + WRITE(MPG,'(/A,I3)') ' Null space option :', KEEP(19) + IF ( KEEP(21) .ne. 0 ) THEN + WRITE( MPG, '(A,I10)') ' Max deficiency : ', KEEP(21) + END IF + IF ( KEEP(22) .ne. 0 ) THEN + WRITE( MPG, '(A,I10)') ' Min deficiency : ', KEEP(22) + END IF + END IF + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & KEEP(46) .eq. 1 ) ) + IF (id%MYID .EQ. MASTER .AND. KEEP(201) .NE. -1) THEN + KEEP(201)=id%ICNTL(22) + IF (KEEP(201) .NE. 0) THEN +# if defined(OLD_OOC_NOPANEL) + KEEP(201)=2 +# else + KEEP(201)=1 +# endif + ENDIF + ENDIF + CALL MPI_BCAST( KEEP(12), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(19), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(21), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(201), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (id%MYID.EQ.MASTER) THEN + IF (KEEP(217).GT.2.OR.KEEP(217).LT.0) THEN + KEEP(217)=0 + ENDIF + KEEP(214)=KEEP(217) + IF (KEEP(214).EQ.0) THEN + IF (KEEP(201).NE.0) THEN + KEEP(214)=1 + ELSE + KEEP(214)=2 + ENDIF + ENDIF + ENDIF + CALL MPI_BCAST( KEEP(214), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (KEEP(201).NE.0) THEN + CALL MPI_BCAST( KEEP(99), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(205), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(211), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + ENDIF + IF ( KEEP(50) .eq. 1 ) THEN + IF (id%CNTL(1) .ne. ZERO ) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') + &' ** Warning : SPD solver called, resetting CNTL(1) to 0.0D0' + END IF + END IF + id%CNTL(1) = ZERO + END IF + IF (KEEP(219).NE.0) THEN + CALL DMUMPS_617(max(KEEP(108),1),IERR) + IF (IERR .NE. 0) THEN + INFO(1) = -13 + INFO(2) = max(KEEP(108),1) + END IF + ENDIF + IF (id%KEEP(252).EQ.1 .AND. id%MYID.EQ.MASTER) THEN + IF (id%ICNTL(20).EQ.1) THEN + id%INFO(1)=-43 + id%INFO(2)=20 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Sparse RHS is incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ELSE IF (id%ICNTL(30).NE.0) THEN + id%INFO(1)=-43 + id%INFO(2)=30 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ELSE IF (id%ICNTL(9) .NE. 1) THEN + id%INFO(1)=-43 + id%INFO(2)=9 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: sparse RHS incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ENDIF + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 530 + IF ( PROKG ) THEN + WRITE( MPG, 172 ) id%NSLAVES, id%ICNTL(22), + & KEEP8(111), KEEP(126), KEEP(127), KEEP(28) + IF (KEEP(252).GT.0) + & WRITE(MPG,173) KEEP(253) + ENDIF + IF (KEEP(201).LE.0) THEN + KEEP(IXSZ)=XSIZE_IC + ELSE IF (KEEP(201).EQ.2) THEN + KEEP(IXSZ)=XSIZE_OOC_NOPANEL + ELSE IF (KEEP(201).EQ.1) THEN + IF (KEEP(50).EQ.0) THEN + KEEP(IXSZ)=XSIZE_OOC_UNSYM + ELSE + KEEP(IXSZ)=XSIZE_OOC_SYM + ENDIF + ENDIF + IF (id%MYID.EQ.MASTER) KEEP(258)=ICNTL(33) + CALL MPI_BCAST(KEEP(258), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + IF (KEEP(258) .NE. 0) THEN + KEEP(259) = 0 + KEEP(260) = 1 + id%DKEEP(6) = 1.0D0 + ENDIF + CALL MPI_BCAST(KEEP(52), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + LSCAL = ((KEEP(52) .GT. 0) .AND. (KEEP(52) .LE. 8)) + IF (LSCAL) THEN + IF ( id%MYID.EQ.MASTER ) THEN + ENDIF + IF (KEEP(52) .EQ. 7) THEN + K231= KEEP(231) + K232= KEEP(232) + K233= KEEP(233) + ELSEIF (KEEP(52) .EQ. 8) THEN + K231= KEEP(239) + K232= KEEP(240) + K233= KEEP(241) + ENDIF + CALL MPI_BCAST(id%DKEEP(3),1,MPI_DOUBLE_PRECISION,MASTER, + & id%COMM,IERR) + IF ( ((KEEP(52).EQ.7).OR.(KEEP(52).EQ.8)) .AND. + & KEEP(54).NE.0 ) THEN + IF ( id%MYID .NE. MASTER ) THEN + IF ( associated(id%COLSCA)) + & DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) + & DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=IERR) + IF (IERR .GT.0) THEN + id%INFO(1)=-13 + id%INFO(2)=N + ENDIF + ALLOCATE( id%ROWSCA(N), stat=IERR) + IF (IERR .GT.0) THEN + id%INFO(1)=-13 + id%INFO(2)=N + ENDIF + ENDIF + M = N + BUMAXMN=M + IF(N > BUMAXMN) BUMAXMN = N + LIWK = 4*BUMAXMN + ALLOCATE (IWK(LIWK),BURP(M),BUCP(N), + & BURS(2* (id%NPROCS)),BUCS(2* (id%NPROCS)), + & stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=LIWK+M+N+4* (id%NPROCS) + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 530 + BUJOB = 1 + LWK_REAL = 1 + ALLOCATE(WK_REAL(LWK_REAL)) + CALL DMUMPS_693( + & MYIRN_loc(1), MYJCN_loc(1), MYA_loc(1), + & id%NZ_loc, + & M, N, id%NPROCS, id%MYID, id%COMM, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + IF(LIWK < BUINTSZ) THEN + DEALLOCATE(IWK) + LIWK = BUINTSZ + ALLOCATE(IWK(LIWK), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=LIWK + ENDIF + ENDIF + LWK_REAL = BURESZ + DEALLOCATE(WK_REAL) + ALLOCATE (WK_REAL(LWK_REAL), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=LWK_REAL + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 530 + BUJOB = 2 + CALL DMUMPS_693( + & MYIRN_loc(1), MYJCN_loc(1), MYA_loc(1), + & id%NZ_loc, + & M, N, id%NPROCS, id%MYID, id%COMM, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + id%DKEEP(4) = SCONEERR + id%DKEEP(5) = SCINFERR + DEALLOCATE(IWK, WK_REAL,BURP,BUCP,BURS, BUCS) + ELSE IF ( KEEP(54) .EQ. 0 ) THEN + IF ((KEEP(52).EQ.7).OR.(KEEP(52).EQ.8)) THEN + IF (id%MYID.EQ.MASTER) THEN + COLOUR = 0 + ELSE + COLOUR = MPI_UNDEFINED + ENDIF + CALL MPI_COMM_SPLIT( id%COMM, COLOUR, 0, + & COMM_FOR_SCALING, IERR ) + IF (id%MYID.EQ.MASTER) THEN + M = N + BUMAXMN=N + IF(N > BUMAXMN) BUMAXMN = N + LIWK = 1 + ALLOCATE (IWK(LIWK),BURP(1),BUCP(1), + & BURS(1),BUCS(1), + & stat=allocok) + LWK_REAL = M + N + ALLOCATE (WK_REAL(LWK_REAL), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=1 + ENDIF + IF (INFO(1) .LT. 0) GOTO 400 + CALL MPI_COMM_RANK(COMM_FOR_SCALING, SCMYID, IERR) + CALL MPI_COMM_SIZE(COMM_FOR_SCALING, SCNPROCS, IERR) + BUJOB = 1 + CALL DMUMPS_693( + & id%IRN(1), id%JCN(1), id%A(1), + & id%NZ, + & M, N, SCNPROCS, SCMYID, COMM_FOR_SCALING, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + IF(LWK_REAL < BURESZ) THEN + INFO(1) = -136 + GOTO 400 + ENDIF + BUJOB = 2 + CALL DMUMPS_693(id%IRN(1), + & id%JCN(1), id%A(1), + & id%NZ, + & M, N, SCNPROCS, SCMYID, COMM_FOR_SCALING, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + id%DKEEP(4) = SCONEERR + id%DKEEP(5) = SCINFERR + DEALLOCATE(WK_REAL) + DEALLOCATE (IWK,BURP,BUCP, + & BURS,BUCS) + ENDIF + CALL MPI_BCAST( id%DKEEP(4),2,MPI_DOUBLE_PRECISION, + & MASTER, id%COMM, IERR ) + 400 CONTINUE + IF (id%MYID.EQ.MASTER) THEN + CALL MPI_COMM_FREE(COMM_FOR_SCALING, IERR) + ENDIF + CALL MUMPS_276(ICNTL(1), INFO(1), id%COMM, id%MYID) + IF (INFO(1).LT.0) GOTO 530 + ELSE IF (id%MYID.EQ.MASTER) THEN + IF (KEEP(52).GT.0 .AND. KEEP(52).LE.6) THEN + IF ( KEEP(52) .eq. 5 .or. + & KEEP(52) .eq. 6 ) THEN + LWK = NZ + ELSE + LWK = 1 + END IF + LWK_REAL = 5 * N + ALLOCATE( WK_REAL( LWK_REAL ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LWK_REAL + GOTO 137 + END IF + ALLOCATE( WK( LWK ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LWK + GOTO 137 + END IF + CALL DMUMPS_217(N, NZ, KEEP(52), id%A(1), + & id%IRN(1), id%JCN(1), + & id%COLSCA(1), id%ROWSCA(1), + & WK, LWK, WK_REAL, LWK_REAL, ICNTL(1), INFO(1) ) + DEALLOCATE( WK_REAL ) + DEALLOCATE( WK ) + ENDIF + ENDIF + ENDIF + IF (id%MYID.EQ.MASTER) THEN + IF (PROKG.AND.(KEEP(52).EQ.7.OR.KEEP(52).EQ.8) + & .AND. (K233+K231+K232).GT.0) THEN + IF (K232.GT.0) WRITE(MPG, 166) id%DKEEP(4) + ENDIF + ENDIF + ENDIF + LSCAL = (LSCAL .OR. (KEEP(52) .EQ. -1) .OR. KEEP(52) .EQ. -2) + IF (LSCAL .AND. KEEP(258).NE.0 .AND. id%MYID .EQ. MASTER) THEN + DO I = 1, id%N + CALL DMUMPS_761(id%ROWSCA(I), + & id%DKEEP(6), + & KEEP(259)) + ENDDO + IF (KEEP(50) .EQ. 0) THEN + DO I = 1, id%N + CALL DMUMPS_761(id%COLSCA(I), + & id%DKEEP(6), + & KEEP(259)) + ENDDO + ELSE + CALL DMUMPS_765(id%DKEEP(6), KEEP(259)) + ENDIF + CALL DMUMPS_766(id%DKEEP(6), KEEP(259)) + ENDIF + 137 CONTINUE + IF (associated(id%root%RHS_CNTR_MASTER_ROOT)) THEN + DEALLOCATE (id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY (id%root%RHS_CNTR_MASTER_ROOT) + ENDIF + IF ( id%MYID.EQ.MASTER.AND. KEEP(252).EQ.1 .AND. + & id%NRHS .NE. id%KEEP(253) ) THEN + id%INFO(1)=-42 + id%INFO(2)=id%KEEP(253) + ENDIF + IF (id%KEEP(252) .EQ. 1) THEN + IF ( id%MYID.NE.MASTER ) THEN + id%KEEP(254) = N + id%KEEP(255) = N*id%KEEP(253) + ALLOCATE(RHS_MUMPS(id%KEEP(255)),stat=IERR) + IF (IERR > 0) THEN + INFO(1)=-13 + INFO(2)=id%KEEP(255) + IF (LP > 0) + & WRITE(LP,*) 'ERREUR while allocating RHS on a slave' + NULLIFY(RHS_MUMPS) + ENDIF + RHS_MUMPS_ALLOCATED = .TRUE. + ELSE + id%KEEP(254)=id%LRHS + id%KEEP(255)=id%LRHS*(id%KEEP(253)-1)+id%N + RHS_MUMPS=>id%RHS + RHS_MUMPS_ALLOCATED = .FALSE. + IF (LSCAL) THEN + DO K=1, id%KEEP(253) + DO I=1, N + RHS_MUMPS( id%KEEP(254) * (K-1) + I ) + & = RHS_MUMPS( id%KEEP(254) * (K-1) + I ) + & * id%ROWSCA(I) + ENDDO + ENDDO + ENDIF + ENDIF + DO I= 1, id%KEEP(253) + CALL MPI_BCAST(RHS_MUMPS((I-1)*id%KEEP(254)+1), N, + & MPI_DOUBLE_PRECISION, MASTER,id%COMM,IERR) + END DO + ELSE + id%KEEP(255)=1 + ALLOCATE(RHS_MUMPS(1)) + RHS_MUMPS_ALLOCATED = .TRUE. + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).lt.0 ) GOTO 530 + KEEP(110)=ICNTL(24) + CALL MPI_BCAST(KEEP(110), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + IF (KEEP(110).NE.1) KEEP(110)=0 + IF (id%MYID .EQ. MASTER) CNTL3 = id%CNTL(3) + CALL MPI_BCAST(CNTL3, 1, MPI_DOUBLE_PRECISION, + & MASTER, id%COMM, IERR) + IF (id%MYID .EQ. MASTER) CNTL5 = id%CNTL(5) + CALL MPI_BCAST(CNTL5, 1, MPI_DOUBLE_PRECISION, + & MASTER, id%COMM, IERR) + IF (id%MYID .EQ. MASTER) CNTL6 = id%CNTL(6) + CALL MPI_BCAST(CNTL6, 1, MPI_DOUBLE_PRECISION, + & MASTER, id%COMM, IERR) + IF (id%MYID .EQ. MASTER) CNTL1 = id%CNTL(1) + CALL MPI_BCAST(CNTL1, 1, MPI_DOUBLE_PRECISION, + & MASTER, id%COMM, IERR) + ANORMINF = ZERO + IF (KEEP(19).EQ.0) THEN + SEUIL = ZERO + ELSE + CALL DMUMPS_27( id , ANORMINF, LSCAL ) + IF (CNTL6 .LT. ZERO) THEN + SEUIL = EPS*ANORMINF + ELSE + SEUIL = CNTL6*ANORMINF + ENDIF + IF (PROKG) WRITE(MPG,*) + & ' ABSOLUTE PIVOT THRESHOLD for rank revealing =',SEUIL + ENDIF + SEUIL_LDLT_NIV2 = SEUIL + IF (KEEP(110).EQ.0) THEN + id%DKEEP(1) = -1.0D0 + id%DKEEP(2) = ZERO + ELSE + IF (ANORMINF.EQ.ZERO) + & CALL DMUMPS_27( id , ANORMINF, LSCAL ) + IF (CNTL3 .LT. ZERO) THEN + id%DKEEP(1) = abs(CNTL(3)) + ELSE IF (CNTL3 .GT. ZERO) THEN + id%DKEEP(1) = CNTL3*ANORMINF + ELSE + id%DKEEP(1) = 1.0D-5*EPS*ANORMINF + ENDIF + IF (PROKG) WRITE(MPG,*) + & ' ZERO PIVOT DETECTION ON, THRESHOLD =',id%DKEEP(1) + IF (CNTL5.GT.ZERO) THEN + id%DKEEP(2) = CNTL5 * ANORMINF + IF (PROKG) WRITE(MPG,*) + & ' FIXATION FOR NULL PIVOTS =',id%DKEEP(2) + ELSE + IF (PROKG) WRITE(MPG,*) 'INFINITE FIXATION ' + IF (id%KEEP(50).EQ.0) THEN + id%DKEEP(2) = -max(1.0D10*ANORMINF, + & sqrt(huge(ANORMINF))/1.0D8) + ELSE + id%DKEEP(2) = ZERO + ENDIF + ENDIF + ENDIF + IF (KEEP(53).NE.0) THEN + ID_ROOT =MUMPS_275(id%PROCNODE_STEPS(id%STEP(KEEP(20))), + & id%NSLAVES) + IF ( KEEP( 46 ) .NE. 1 ) THEN + ID_ROOT = ID_ROOT + 1 + END IF + ENDIF + IF ( associated( id%PIVNUL_LIST) ) DEALLOCATE(id%PIVNUL_LIST) + IF(KEEP(110) .EQ. 1) THEN + LPN_LIST = N + ELSE + LPN_LIST = 1 + ENDIF + IF (KEEP(19).NE.0 .AND. + & (ID_ROOT.EQ.id%MYID .OR. id%MYID.EQ.MASTER)) THEN + LPN_LIST = N + ENDIF + ALLOCATE( id%PIVNUL_LIST(LPN_LIST),stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=LPN_LIST + END IF + id%PIVNUL_LIST(1:LPN_LIST) = 0 + KEEP(109) = 0 + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).lt.0 ) GOTO 530 + IF ((KEEP(19).EQ.0).AND.(KEEP(110).EQ.0)) THEN + IF (id%MYID .EQ. MASTER) CNTL4 = id%CNTL(4) + CALL MPI_BCAST( CNTL4, 1, MPI_DOUBLE_PRECISION, + & MASTER, id%COMM, IERR ) + IF ( CNTL4 .GE. ZERO ) THEN + KEEP(97) = 1 + IF ( CNTL4 .EQ. ZERO ) THEN + IF(ANORMINF .EQ. ZERO) THEN + CALL DMUMPS_27( id , ANORMINF, LSCAL ) + ENDIF + SEUIL = sqrt(EPS) * ANORMINF + ELSE + SEUIL = CNTL4 + ENDIF + SEUIL_LDLT_NIV2 = SEUIL + ELSE + SEUIL = ZERO + ENDIF + ENDIF + KEEP(98) = 0 + KEEP(103) = 0 + KEEP(105) = 0 + MAXS = 1_8 + IF ( id%MYID.EQ.MASTER ) THEN + ITMP = ICNTL(23) + END IF + CALL MPI_BCAST( ITMP, 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (WK_USER_PROVIDED) ITMP = 0 + ITMP8 = int(ITMP, 8) + KEEP8(4) = ITMP8 * 1000000_8 + PERLU = KEEP(12) + IF (KEEP(201) .EQ. 0) THEN + MAXS_BASE8=KEEP8(12) + ELSE + MAXS_BASE8=KEEP8(14) + ENDIF + IF (WK_USER_PROVIDED) THEN + MAXS = KEEP8(24) + ELSE + IF ( MAXS_BASE8 .GT. 0_8 ) THEN + MAXS_BASE_RELAXED8 = + & MAXS_BASE8 + int(PERLU,8) * ( MAXS_BASE8 / 100_8 + 1_8) + IF (MAXS_BASE_RELAXED8 > huge(MAXS)) THEN + WRITE(*,*) "Internal error: I8 overflow" + CALL MUMPS_ABORT() + ENDIF + MAXS_BASE_RELAXED8 = max(MAXS_BASE_RELAXED8, 1_8) + MAXS = MAXS_BASE_RELAXED8 + ELSE + MAXS = 1_8 + MAXS_BASE_RELAXED8 = 1_8 + END IF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1) .LT. 0) THEN + GOTO 530 + ENDIF + IF ((.NOT.WK_USER_PROVIDED).AND.(I_AM_SLAVE)) THEN + IF (KEEP(96).GT.0) THEN + MAXS=int(KEEP(96),8) + ELSE + IF (KEEP8(4) .NE. 0_8) THEN + PERLU_ON = .TRUE. + CALL DMUMPS_214( id%KEEP(1), id%KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., KEEP(201), + & PERLU_ON, TOTAL_BYTES) + MAXS_BASE_RELAXED8=MAXS_BASE_RELAXED8 + + & (KEEP8(4)-TOTAL_BYTES)/int(KEEP(35),8) + IF (MAXS_BASE_RELAXED8 > int(huge(MAXS),8)) THEN + WRITE(*,*) "Internal error: I8 overflow" + CALL MUMPS_ABORT() + ELSE IF (MAXS_BASE_RELAXED8 .LE. 0_8) THEN + id%INFO(1)=-9 + IF ( -MAXS_BASE_RELAXED8 .GT. + & int(huge(id%INFO(1)),8) ) THEN + WRITE(*,*) "I8: OVERFLOW" + CALL MUMPS_ABORT() + ENDIF + id%INFO(2)=-int(MAXS_BASE_RELAXED8,4) + ELSE + MAXS=MAXS_BASE_RELAXED8 + ENDIF + ENDIF + ENDIF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1) .LT. 0) THEN + GOTO 530 + ENDIF + CALL DMUMPS_713(PROKG, MPG, MAXS, id%NSLAVES, + & id%COMM, "effective relaxed size of S =") + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (id%INFO(1) .LT. 0) THEN + GOTO 530 + ENDIF + IF ( I_AM_SLAVE ) THEN + CALL DMUMPS_188( dble(id%COST_SUBTREES), + & KEEP(64), KEEP(66),MAXS ) + K28=KEEP(28) + MEMORY_MD_ARG = min(int(PERLU,8) * ( MAXS_BASE8 / 100_8 + 1_8 ), + & max(0_8, MAXS-MAXS_BASE8)) + CALL DMUMPS_185( id, MEMORY_MD_ARG, MAXS ) + CALL DMUMPS_587(id, IERR) + IF (IERR < 0) THEN + INFO(1) = -90 + INFO(2) = 0 + GOTO 112 + ENDIF + IF (KEEP(201) .GT. 0) THEN + IF (KEEP(201).EQ.1 + & .AND.KEEP(50).EQ.0 + & .AND.KEEP(251).NE.2 + & ) THEN + OOC_NB_FILE_TYPE=2 + ELSE + OOC_NB_FILE_TYPE=1 + ENDIF + IF (KEEP(205) .GT. 0) THEN + KEEP(100) = KEEP(205) + ELSE + IF (KEEP(201).EQ.1) THEN + I8TMP = int(OOC_NB_FILE_TYPE,8) * 2_8 * int(KEEP(226),8) + ELSE + I8TMP = 2_8 * KEEP8(119) + ENDIF + I8TMP = I8TMP + int(max(KEEP(12),0),8) * + & (I8TMP/100_8+1_8) + I8TMP = min(I8TMP, 12000000_8) + KEEP(100)=int(I8TMP) + ENDIF + IF (KEEP(201).EQ.1) THEN + IF ( KEEP(99) < 3 ) THEN + KEEP(99) = KEEP(99) + 3 + ENDIF + IF (id%MYID_NODES .eq. MASTER) THEN + write(6,*) ' PANEL: INIT and force STRAT_IO= ', + & id%KEEP(99) + ENDIF + ENDIF + IF (KEEP(99) .LT.3) KEEP(100)=0 + IF((dble(KEEP(100))*dble(KEEP(35))/dble(2)).GT. + & (dble(1999999999)))THEN + IF (PROKG) THEN + WRITE(MPG,*)id%MYID,': Warning: DIM_BUF_IO might be + & too big for Filesystem' + ENDIF + ENDIF + ALLOCATE (id%OOC_INODE_SEQUENCE(KEEP(28), + & OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE*KEEP(28) + NULLIFY(id%OOC_INODE_SEQUENCE) + GOTO 112 + ENDIF + ALLOCATE (id%OOC_TOTAL_NB_NODES(OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE + NULLIFY(id%OOC_TOTAL_NB_NODES) + GOTO 112 + ENDIF + ALLOCATE (id%OOC_SIZE_OF_BLOCK(KEEP(28), + & OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE*KEEP(28) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + GOTO 112 + ENDIF + ALLOCATE (id%OOC_VADDR(KEEP(28),OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE*KEEP(28) + NULLIFY(id%OOC_VADDR) + GOTO 112 + ENDIF + ENDIF + ENDIF + 112 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1) < 0) THEN + GOTO 513 + ENDIF + IF (I_AM_SLAVE) THEN + IF (KEEP(201) .GT. 0) THEN + IF ((KEEP(201).EQ.1).OR.(KEEP(201).EQ.2)) THEN + CALL DMUMPS_575(id,MAXS) + ELSE + WRITE(*,*) "Internal error in DMUMPS_142" + CALL MUMPS_ABORT() + ENDIF + IF(INFO(1).LT.0)THEN + GOTO 111 + ENDIF + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + CALL DMUMPS_190(0,.FALSE.,dble(id%COST_SUBTREES), + & id%KEEP(1),id%KEEP8(1)) +#endif + IF (INFO(1).LT.0) GOTO 111 +#if defined(stephinfo) + write(*,*) 'proc ',id%MYID,' array of dist : ', + & id%MEM_DIST(0:id%NSLAVES - 1) +#endif + END IF + IF ( associated (id%S) ) THEN + DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF +#if defined (LARGEMATRICES) + IF ( id%MYID .ne. MASTER ) THEN +#endif + IF (.NOT.WK_USER_PROVIDED) THEN + ALLOCATE (id%S(MAXS),stat=IERR) + KEEP8(23) = MAXS + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + CALL MUMPS_735(MAXS, INFO(2)) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + ELSE + id%S => id%WK_USER(1:KEEP8(24)) + ENDIF +#if defined (LARGEMATRICES) + END IF +#endif + 111 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( KEEP(55) .eq. 0 ) THEN + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + IF ( I_AM_SLAVE .and. KEEP(13) .ne. 0 ) THEN + ALLOCATE( id%DBLARR( KEEP(13) ), stat = IERR ) + ELSE + ALLOCATE( id%DBLARR( 1 ), stat =IERR ) + END IF + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID, + & ':Error allocating DBLARR : IERR = ', IERR + INFO(1)=-13 + INFO(2)=KEEP(13) + NULLIFY(id%DBLARR) + GOTO 100 + END IF + ELSE + IF ( associated( id%INTARR ) ) THEN + DEALLOCATE( id%INTARR ) + NULLIFY( id%INTARR ) + END IF + IF ( I_AM_SLAVE .and. KEEP(14) .ne. 0 ) THEN + ALLOCATE( id%INTARR( KEEP(14) ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = KEEP(14) + NULLIFY(id%INTARR) + GOTO 100 + END IF + ELSE + ALLOCATE( id%INTARR(1),stat=allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 1 + NULLIFY(id%INTARR) + GOTO 100 + END IF + END IF + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + IF ( I_AM_SLAVE ) THEN + IF ( id%MYID_NODES .eq. MASTER + & .AND. KEEP(46) .eq. 1 + & .AND. KEEP(52) .eq. 0 ) THEN + id%DBLARR => id%A_ELT + ELSE + IF ( KEEP(13) .ne. 0 ) THEN + ALLOCATE( id%DBLARR( KEEP(13) ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = KEEP(13) + NULLIFY(id%DBLARR) + GOTO 100 + END IF + ELSE + ALLOCATE( id%DBLARR(1), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 1 + NULLIFY(id%DBLARR) + GOTO 100 + END IF + END IF + END IF + ELSE + ALLOCATE( id%DBLARR(1), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 1 + NULLIFY(id%DBLARR) + GOTO 100 + END IF + END IF + END IF + IF ( KEEP(38).NE.0 .AND. I_AM_SLAVE ) THEN + CALL DMUMPS_165( id%N, + & id%root, id%FILS(1), KEEP(38), id%KEEP(1), id%INFO(1) ) + END IF + 100 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( KEEP( 55 ) .eq. 0 ) THEN + IF (KEEP(38).NE.0 .AND. I_AM_SLAVE) THEN + LWK = numroc( id%root%ROOT_SIZE, id%root%MBLOCK, + & id%root%MYROW, 0, id%root%NPROW ) + LWK = max( 1, LWK ) + LWK = LWK* + & numroc( id%root%ROOT_SIZE, id%root%NBLOCK, + & id%root%MYCOL, 0, id%root%NPCOL ) + LWK = max( 1, LWK ) + ELSE + LWK = 1 + ENDIF + IF (MAXS .LT. int(LWK,8)) THEN + INFO(1) = -9 + INFO(2) = LWK + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( KEEP(54) .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + ALLOCATE(IWK(id%N), stat=allocok) + IF ( allocok .NE. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + END IF +#if defined(LARGEMATRICES) + IF ( associated (id%S) ) THEN + DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + ALLOCATE (WK(LWK),stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LWK + write(6,*) ' PB1 ALLOC LARGEMAT' + ENDIF +#endif + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( id%MYID .eq. MASTER ) THEN + IF (PROKG ) THEN + CALL MUMPS_291(TIME) + END IF + IF ( .not. associated( id%INTARR ) ) THEN + ALLOCATE( id%INTARR( 1 ) ) + ENDIF +#if defined(LARGEMATRICES) + CALL DMUMPS_148(id%N, NZ, id%A(1), + & id%IRN(1), id%JCN(1), id%SYM_PERM(1), + & LSCAL, id%COLSCA(1), id%ROWSCA(1), + & id%MYID, id%NSLAVES, id%PROCNODE_STEPS(1), + & min(KEEP(39),id%NZ), + & LP, id%COMM, id%root, KEEP,KEEP8, + & id%FILS(1), IWK(1), + & + & id%INTARR(1), id%DBLARR(1), + & id%PTRAR(1), id%PTRAR(id%N+1), + & id%FRERE_STEPS(1), id%STEP(1), WK(1), int(LWK,8), + & id%ISTEP_TO_INIV2, id%I_AM_CAND, + & id%CANDIDATES) + write(6,*) '!!! A,IRN,JCN are freed during facto ' + DEALLOCATE (id%A) + NULLIFY(id%A) + DEALLOCATE (id%IRN) + NULLIFY (id%IRN) + DEALLOCATE (id%JCN) + NULLIFY (id%JCN) + IF (.NOT.WK_USER_PROVIDED) THEN + ALLOCATE (id%S(MAXS),stat=IERR) + KEEP8(23) = MAXS + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = MAXS + NULLIFY(id%S) + KEEP8(23)=0_8 + write(6,*) ' PB2 ALLOC LARGEMAT',MAXS + CALL MUMPS_ABORT() + ENDIF + ELSE + id%S => id%WK_USER(1:KEEP8(24)) + ENDIF + id%S(MAXS-LWK+1:MAXS) = WK(1:LWK) + DEALLOCATE (WK) +#else + CALL DMUMPS_148(id%N, NZ, id%A(1), + & id%IRN(1), id%JCN(1), id%SYM_PERM(1), + & LSCAL, id%COLSCA(1), id%ROWSCA(1), + & id%MYID, id%NSLAVES, id%PROCNODE_STEPS(1), + & min(KEEP(39),id%NZ), + & LP, id%COMM, id%root, KEEP(1),KEEP8(1), + & id%FILS(1), IWK(1), + & + & id%INTARR(1), id%DBLARR(1), + & id%PTRAR(1), id%PTRAR(id%N+1), + & id%FRERE_STEPS(1), id%STEP(1), id%S(1), MAXS, + & id%ISTEP_TO_INIV2(1), id%I_AM_CAND(1), + & id%CANDIDATES(1,1) ) +#endif + DEALLOCATE(IWK) + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,160) TIME + CALL MUMPS_291(TIME) + END IF + ELSE + CALL DMUMPS_145( id%N, + & id%DBLARR( 1 ), max(1,KEEP( 13 )), + & id%INTARR( 1 ), max(1,KEEP( 14 )), + & id%PTRAR( 1 ), + & id%PTRAR(id%N+1), + & KEEP( 1 ), KEEP8(1), id%MYID, id%COMM, + & min(id%KEEP(39),id%NZ), + & + & id%S(1), MAXS, + & id%root, + & id%PROCNODE_STEPS(1), id%NSLAVES, + & id%SYM_PERM(1), id%FRERE_STEPS(1), id%STEP(1), + & id%INFO(1), id%INFO(2) ) + ENDIF + ELSE + IF (PROKG ) THEN + CALL MUMPS_291(TIME) + END IF + IF ( I_AM_SLAVE ) THEN + NZ_locMAX = 0 + CALL MPI_ALLREDUCE(id%NZ_loc, NZ_locMAX, 1, MPI_INTEGER, + & MPI_MAX, id%COMM_NODES, IERR) + CALL DMUMPS_282( id%N, + & id%NZ_loc, + & id, + & id%DBLARR(1), KEEP(13), id%INTARR(1), + & KEEP(14), id%PTRAR(1), id%PTRAR(id%N+1), + & KEEP(1), KEEP8(1), id%MYID_NODES, + & id%COMM_NODES, min(id%KEEP(39),NZ_locMAX), + & id%S(1), MAXS, id%root, id%PROCNODE_STEPS(1), + & id%NSLAVES, id%SYM_PERM(1), id%STEP(1), + & id%ICNTL(1), id%INFO(1), NSEND, NLOCAL, + & id%ISTEP_TO_INIV2(1), + & id%CANDIDATES(1,1) ) + IF ( ( KEEP(52).EQ.7 ).OR. (KEEP(52).EQ.8) ) THEN + IF ( id%MYID > 0 ) THEN + IF (associated(id%ROWSCA)) THEN + DEALLOCATE(id%ROWSCA) + NULLIFY(id%ROWSCA) + ENDIF + IF (associated(id%COLSCA)) THEN + DEALLOCATE(id%COLSCA) + NULLIFY(id%COLSCA) + ENDIF + ENDIF + ENDIF +#if defined(LARGEMATRICES) + IF (associated(id%IRN_loc)) THEN + DEALLOCATE(id%IRN_loc) + NULLIFY(id%IRN_loc) + ENDIF + IF (associated(id%JCN_loc)) THEN + DEALLOCATE(id%JCN_loc) + NULLIFY(id%JCN_loc) + ENDIF + IF (associated(id%A_loc)) THEN + DEALLOCATE(id%A_loc) + NULLIFY(id%A_loc) + ENDIF + write(6,*) ' Warning :', + & ' id%A_loc, IRN_loc, JCN_loc deallocated !!! ' +#endif + IF (PROK) THEN + WRITE(MP,120) NLOCAL, NSEND + END IF + END IF + IF ( KEEP(46) .eq. 0 .AND. id%MYID.eq.MASTER ) THEN + NSEND = 0 + NLOCAL = 0 + END IF + CALL MPI_REDUCE( NSEND, NSEND_TOT, 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR ) + CALL MPI_REDUCE( NLOCAL, NLOCAL_TOT, 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR ) + IF ( PROKG ) THEN + WRITE(MPG,125) NLOCAL_TOT, NSEND_TOT + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 500 + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,160) TIME + CALL MUMPS_291(TIME) + END IF + END IF + ELSE + IF (PROKG ) THEN + CALL MUMPS_291(TIME) + END IF + IF ( id%MYID.eq.MASTER) + &CALL DMUMPS_213( id%ELTPTR(1), + & id%NELT, + & MAXELT_SIZE ) + CALL DMUMPS_126( id%N, id%NELT, id%NA_ELT, + & id%COMM, id%MYID, + & id%NSLAVES, id%PTRAR(1), + & id%PTRAR(id%NELT+2), + & id%INTARR(1), id%DBLARR(1), + & id%KEEP(1), id%KEEP8(1), MAXELT_SIZE, + & id%FRTPTR(1), id%FRTELT(1), + & id%S(1), MAXS, id%FILS(1), + & id, id%root ) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 500 + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,160) TIME + CALL MUMPS_291(TIME) + END IF + END IF + IF ( I_AM_SLAVE ) THEN + CALL DMUMPS_528(id%MYID_NODES) + DMUMPS_LBUFR_BYTES = KEEP( 44 ) * KEEP( 35 ) + DMUMPS_LBUFR_BYTES = max( DMUMPS_LBUFR_BYTES, + & 100000 ) + PERLU = KEEP( 12 ) + IF (KEEP(48).EQ.5) THEN + MIN_PERLU=2 + ELSE + MIN_PERLU=0 + ENDIF + DMUMPS_LBUFR_BYTES = DMUMPS_LBUFR_BYTES + & + int( 2.0D0 * dble(max(PERLU,MIN_PERLU))* + & dble(DMUMPS_LBUFR_BYTES)/100D0) + IF (KEEP(48)==5) THEN + KEEP8(21) = KEEP8(22) + int( dble(max(PERLU,MIN_PERLU))* + & dble(KEEP8(22))/100D0,8) + ENDIF + DMUMPS_LBUF = int( dble(KEEP(213)) / 100.0D0 * + & dble(KEEP(43)) * dble(KEEP(35)) ) + DMUMPS_LBUF = max( DMUMPS_LBUF, 100000 ) + DMUMPS_LBUF = DMUMPS_LBUF + & + int( 2.0D0 * dble(max(PERLU,MIN_PERLU))* + & dble(DMUMPS_LBUF)/100D0) + DMUMPS_LBUF = max(DMUMPS_LBUF, DMUMPS_LBUFR_BYTES+3*KEEP(34)) + IF(id%KEEP(48).EQ.4)THEN + DMUMPS_LBUFR_BYTES=DMUMPS_LBUFR_BYTES*5 + DMUMPS_LBUF=DMUMPS_LBUF*5 + ENDIF + DMUMPS_LBUF_INT = ( KEEP(56) + id%NSLAVES * id%NSLAVES ) * 5 + & * KEEP(34) + IF ( KEEP( 38 ) .NE. 0 ) THEN + KKKK = MUMPS_275( id%PROCNODE_STEPS(id%STEP(KEEP(38))), + & id%NSLAVES ) + IF ( KKKK .EQ. id%MYID_NODES ) THEN + DMUMPS_LBUF_INT = DMUMPS_LBUF_INT + + & 10 * + & 2 * ( id%NE_STEPS(id%STEP(KEEP(38))) + 1 ) * id%NSLAVES + & * KEEP(34) + END IF + END IF + IF ( MP .GT. 0 ) THEN + WRITE( MP, 9999 ) DMUMPS_LBUFR_BYTES, + & DMUMPS_LBUF, DMUMPS_LBUF_INT + END IF + 9999 FORMAT( /,' Allocated buffers',/,' ------------------',/, + & ' Size of reception buffer in bytes ...... = ', I10, + & /, + & ' Size of async. emission buffer (bytes).. = ', I10,/, + & ' Small emission buffer (bytes) .......... = ', I10) + CALL DMUMPS_55( DMUMPS_LBUF_INT, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID, + & ':Error allocating small Send buffer:IERR=' + & ,IERR + INFO(1)= -13 + INFO(2)= (DMUMPS_LBUF_INT+KEEP(34)-1)/KEEP(34) + GO TO 110 + END IF + CALL DMUMPS_53( DMUMPS_LBUF, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating Send buffer:IERR=' + & ,IERR + INFO(1)= -13 + INFO(2)= (DMUMPS_LBUF+KEEP(34)-1)/KEEP(34) + GO TO 110 + END IF + id%LBUFR_BYTES = DMUMPS_LBUFR_BYTES + id%LBUFR = (DMUMPS_LBUFR_BYTES+KEEP(34)-1)/KEEP(34) + IF (associated(id%BUFR)) DEALLOCATE(id%BUFR) + ALLOCATE( id%BUFR( id%LBUFR ),stat=IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating BUFR:IERR=' + & ,IERR + INFO(1)=-13 + INFO(2)=id%LBUFR + NULLIFY(id%BUFR) + GO TO 110 + END IF + PERLU = KEEP( 12 ) + IF (KEEP(201).GT.0) THEN + MAXIS_ESTIM = KEEP(225) + ELSE + MAXIS_ESTIM = KEEP(15) + ENDIF + MAXIS = max( 1, + & MAXIS_ESTIM + 2 * max(PERLU,10) * + & ( MAXIS_ESTIM / 100 + 1 ) + & ) + IF (associated(id%IS)) DEALLOCATE( id%IS ) + ALLOCATE( id%IS( MAXIS ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating IS:IERR=',IERR + INFO(1)=-13 + INFO(2)=MAXIS + NULLIFY(id%IS) + GO TO 110 + END IF + LIW = MAXIS + IF (associated( id%PTLUST_S )) DEALLOCATE(id%PTLUST_S) + ALLOCATE( id%PTLUST_S( id%KEEP(28) ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocatingPTLUST:IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=id%KEEP(28) + NULLIFY(id%PTLUST_S) + GOTO 100 + END IF + IF (associated( id%PTRFAC )) DEALLOCATE(id%PTRFAC) + ALLOCATE( id%PTRFAC( id%KEEP(28) ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocatingPTRFAC:IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=id%KEEP(28) + NULLIFY(id%PTRFAC) + GOTO 100 + END IF + PTRIST = 1 + PTRWB = PTRIST + id%KEEP(28) + ITLOC = PTRWB + 3 * id%KEEP(28) + IPOOL = ITLOC + id%N + id%KEEP(253) + LPOOL = DMUMPS_505(id%KEEP(1),id%KEEP8(1)) + ALLOCATE( IWK( IPOOL + LPOOL - 1 ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating IWK : IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=IPOOL + LPOOL - 1 + GOTO 110 + END IF + ALLOCATE(IWK8( 2 * id%KEEP(28)), stat = IERR) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating IWK : IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=2 * id%KEEP(28) + GOTO 110 + END IF + ENDIF + 110 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 500 + IF ( I_AM_SLAVE ) THEN + CALL DMUMPS_60( id%LBUFR_BYTES ) + IF (MP .GT. 0) THEN + WRITE( MP, 170 ) MAXS, MAXIS, KEEP8(12), KEEP(15), KEEP(13), + & KEEP(14), KEEP8(11), KEEP(26), KEEP(27) + ENDIF + END IF + PERLU_ON = .TRUE. + CALL DMUMPS_214( id%KEEP(1), id%KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., id%KEEP(201), + & PERLU_ON, TOTAL_BYTES) + id%INFO(16) = TOTAL_MBYTES + IF ( MP .gt. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' ** Space in MBYTES used during factorization :', + & id%INFO(16) + END IF + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(16), id%INFOG(18), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Memory relaxation parameter ( ICNTL(14) ) :', + & KEEP(12) + WRITE( MPG,'(A,I10) ') + & ' ** Rank of processor needing largest memory in facto :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Space in MBYTES used by this processor for facto :', + & id%INFOG(18) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during facto :', + & ( id%INFOG(19)-id%INFO(16) ) / id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during facto :', + & id%INFOG(19) / id%NSLAVES + END IF + END IF + KEEP8(31)= 0_8 + KEEP8(10) = 0_8 + KEEP8(8)=0_8 + INFO(9:14)=0 + RINFO(2:3)=ZERO + IF ( I_AM_SLAVE ) THEN + IF ( KEEP(55) .eq. 0 ) THEN + LDPTRAR = id%N + ELSE + LDPTRAR = id%NELT + 1 + END IF + IF ( id%KEEP(55) .NE. 0 ) THEN + NELT = id%NELT + ELSE + NELT = 1 + END IF + CALL DMUMPS_244( id%N, NSTEPS, id%S(1), + & MAXS, id%IS( 1 ), LIW, + & id%SYM_PERM(1), id%NA(1), id%LNA, id%NE_STEPS(1), + & id%ND_STEPS(1), id%FILS(1), id%STEP(1), + & id%FRERE_STEPS(1), id%DAD_STEPS(1), id%CANDIDATES(1,1), + & id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & id%PTRAR(1), LDPTRAR, IWK( PTRIST ), + & id%PTLUST_S(1), id%PTRFAC(1), IWK( PTRWB ), + & IWK8, + & IWK( ITLOC ), RHS_MUMPS(1), IWK( IPOOL ), LPOOL, + & CNTL1, ICNTL(1), INFO(1), RINFO(1), KEEP(1),KEEP8(1), + & id%PROCNODE_STEPS(1), + & id%NSLAVES, id%COMM_NODES, + & id%MYID, id%MYID_NODES, + & id%BUFR(1),id%LBUFR,id%LBUFR_BYTES, + & id%INTARR(1), id%DBLARR(1), id%root, + & NELT, id%FRTPTR(1), + & id%FRTELT(1), id%COMM_LOAD, id%ASS_IRECV, SEUIL, + & SEUIL_LDLT_NIV2, id%MEM_DIST(0), + & id%DKEEP(1),id%PIVNUL_LIST(1),LPN_LIST) + IF ( MP . GT. 0 .and. KEEP(38) .ne. 0 ) THEN + WRITE( MP, 175 ) KEEP(49) + END IF + DEALLOCATE( IWK ) + DEALLOCATE( IWK8 ) + ENDIF + IF ( KEEP(55) .eq. 0 ) THEN + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + ELSE + DEALLOCATE( id%INTARR) + NULLIFY( id%INTARR ) + IF ( id%MYID_NODES .eq. MASTER + & .AND. KEEP(46) .eq. 1 + & .AND. KEEP(52) .eq. 0 ) THEN + NULLIFY( id%DBLARR ) + ELSE + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + END IF + END IF + IF ( KEEP(19) .NE. 0 ) THEN + IF ( KEEP(46) .NE. 1 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_RECV( KEEP(17), 1, MPI_INTEGER, 1, DEFIC_TAG, + & id%COMM, STATUS, IERR ) + ELSE IF ( id%MYID .EQ. 1 ) THEN + CALL MPI_SEND( KEEP(17), 1, MPI_INTEGER, 0, DEFIC_TAG, + & id%COMM, IERR ) + END IF + END IF + END IF + IF (associated(id%BUFR)) THEN + DEALLOCATE(id%BUFR) + NULLIFY(id%BUFR) + END IF + CALL DMUMPS_57( IERR ) + CALL DMUMPS_59( IERR ) + IF (KEEP(219).NE.0) THEN + CALL DMUMPS_620() + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + CALL DMUMPS_770(id) + IF (KEEP(201) .GT. 0) THEN + IF ((KEEP(201).EQ.1) .OR. (KEEP(201).EQ.2)) THEN + IF ( I_AM_SLAVE ) THEN + CALL DMUMPS_591(IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + ENDIF + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + END IF + END IF + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,180) TIME + END IF + PERLU_ON = .TRUE. + CALL DMUMPS_214( id%KEEP(1),id%KEEP8(1), + & id%MYID, N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .TRUE., id%KEEP(201), + & PERLU_ON, TOTAL_BYTES) + KEEP8(7) = TOTAL_BYTES + id%INFO(22) = TOTAL_MBYTES + IF ( MP .gt. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' ** Effective minimum Space in MBYTES for facto :', + & TOTAL_MBYTES + ENDIF + IF (I_AM_SLAVE) THEN + K67 = KEEP8(67) + ELSE + K67 = 0_8 + ENDIF + CALL MUMPS_735(K67,id%INFO(21)) + CALL DMUMPS_713(PROKG, MPG, K67, id%NSLAVES, + & id%COMM, "effective space used in S (KEEP8(67) =") + CALL MUMPS_243( id%MYID, id%COMM, + & TOTAL_MBYTES, id%INFOG(21), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Rank of processor needing largest memory :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Space in MBYTES used by this processor :', + & id%INFOG(21) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Avg. Space in MBYTES per working proc :', + & ( id%INFOG(22)-TOTAL_MBYTES ) / id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Avg. Space in MBYTES per working proc :', + & id%INFOG(22) / id%NSLAVES + END IF + END IF + KEEP(33) = INFO(11) + CALL MPI_REDUCE( RINFO(2), RINFOG(2), 2, + & MPI_DOUBLE_PRECISION, + & MPI_SUM, MASTER, id%COMM, IERR) + KEEP(247) = 0 + CALL MPI_REDUCE( KEEP(246), KEEP(247), 1, MPI_INTEGER, + & MPI_MAX, MASTER, id%COMM, IERR) + CALL MPI_REDUCE( RINFO(2), RINFOG(2), 2, + & MPI_DOUBLE_PRECISION, + & MPI_SUM, MASTER, id%COMM, IERR) + CALL MUMPS_646( KEEP8(31),KEEP8(6), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735(KEEP8(6), INFOG(9)) + CALL MPI_REDUCE( INFO(10), INFOG(10), 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + CALL MPI_ALLREDUCE( INFO(11), INFOG(11), 1, MPI_INTEGER, + & MPI_MAX, id%COMM, IERR) + KEEP(133) = INFOG(11) + CALL MPI_REDUCE( INFO(12), INFOG(12), 3, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + CALL MPI_REDUCE( KEEP(103), INFOG(25), 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + KEEP(229) = INFOG(25) + CALL MPI_REDUCE( KEEP(105), INFOG(25), 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + KEEP(230) = INFOG(25) + INFO(25) = KEEP(98) + CALL MPI_ALLREDUCE( INFO(25), INFOG(25), 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR) + CALL MUMPS_646( KEEP8(8), KEEP8(108), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735(KEEP8(10), INFO(27)) + CALL MUMPS_646( KEEP8(10),KEEP8(110), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735(KEEP8(110), INFOG(29)) + IF (KEEP(258).NE.0) THEN + RINFOG(13)=0.0D0 + IF (KEEP(260).EQ.-1) THEN + id%DKEEP(6)=-id%DKEEP(6) + ENDIF + CALL DMUMPS_764( + & id%COMM, id%DKEEP(6), KEEP(259), + & RINFOG(12), INFOG(34), id%NPROCS) + IF (id%KEEP(50).EQ.0 .AND. id%MYID.EQ. MASTER) THEN + IF (id%KEEP(23).NE.0) THEN + CALL DMUMPS_767( + & RINFOG(12), id%N, + & id%STEP(1), + & id%UNS_PERM(1) ) + ENDIF + ENDIF + ENDIF + IF(KEEP(110) .EQ. 1) THEN + INFO(18) = KEEP(109) + CALL MPI_ALLREDUCE( KEEP(109), KEEP(112), 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR) + ELSE + INFO(18) = 0 + KEEP(109) = 0 + KEEP(112) = 0 + ENDIF + INFOG(28)=KEEP(112)+KEEP(17) + IF (KEEP(17) .NE. 0) THEN + IF (id%MYID .EQ. ID_ROOT) THEN + INFO(18)=INFO(18)+KEEP(17) + ENDIF + IF (ID_ROOT .EQ. MASTER) THEN + IF (id%MYID.EQ.MASTER) THEN + DO I=1, KEEP(17) + id%PIVNUL_LIST(KEEP(112)+I)=id%PIVNUL_LIST(KEEP(109)+I) + ENDDO + ENDIF + ELSE + IF (id%MYID .EQ. ID_ROOT) THEN + CALL MPI_SEND(id%PIVNUL_LIST(KEEP(109)+1), KEEP(17), + & MPI_INTEGER, MASTER, ZERO_PIV, + & id%COMM, IERR) + ELSE IF (id%MYID .EQ. MASTER) THEN + CALL MPI_RECV(id%PIVNUL_LIST(KEEP(112)+1), KEEP(17), + & MPI_INTEGER, ID_ROOT, ZERO_PIV, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + ENDIF + IF(KEEP(110) .EQ. 1) THEN + ALLOCATE(ITMP2(id%NPROCS),stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%NPROCS + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 490 + CALL MPI_GATHER ( KEEP(109),1, MPI_INTEGER, + & ITMP2(1), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + IF(id%MYID .EQ. MASTER) THEN + POSBUF = ITMP2(1)+1 + KEEP(220)=1 + DO I = 1,id%NPROCS-1 + CALL MPI_RECV(id%PIVNUL_LIST(POSBUF), ITMP2(I+1), + & MPI_INTEGER,I, + & ZERO_PIV, id%COMM, STATUS, IERR) + CALL MPI_SEND(POSBUF, 1, MPI_INTEGER, I, ZERO_PIV, + & id%COMM, IERR) + POSBUF = POSBUF + ITMP2(I+1) + ENDDO + ELSE + CALL MPI_SEND( id%PIVNUL_LIST(1), KEEP(109), MPI_INTEGER, + & MASTER,ZERO_PIV, id%COMM, IERR) + CALL MPI_RECV( KEEP(220), 1, MPI_INTEGER, MASTER, ZERO_PIV, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + 490 IF (allocated(ITMP2)) DEALLOCATE(ITMP2) + IF ( PROKG ) THEN + WRITE(MPG,99984) RINFOG(2),RINFOG(3),KEEP8(6),INFOG(10), + & INFOG(11), KEEP8(110) + IF (id%KEEP(50) == 1 .OR. id%KEEP(50) == 2) THEN + WRITE(MPG, 99987) INFOG(12) + END IF + IF (id%KEEP(50) == 0) THEN + WRITE(MPG, 99985) INFOG(12) + END IF + IF (id%KEEP(50) .NE. 1) THEN + WRITE(MPG, 99982) INFOG(13) + END IF + IF (KEEP(97) .NE. 0) THEN + WRITE(MPG, 99986) KEEP(98) + ENDIF + IF (id%KEEP(50) == 2) THEN + WRITE(MPG, 99988) KEEP(229) + WRITE(MPG, 99989) KEEP(230) + ENDIF + IF (KEEP(110) .NE.0) THEN + WRITE(MPG, 99991) KEEP(112) + ENDIF + IF ( KEEP(17) .ne. 0 ) + & WRITE(MPG, 99983) KEEP(17) + IF (KEEP(110).NE.0.OR.KEEP(17).NE.0) + & WRITE(MPG, 99992) KEEP(17)+KEEP(112) + WRITE(MPG, 99981) INFOG(14) + IF ((KEEP(201).EQ.0.OR.KEEP(201).EQ.2).AND. + & KEEP(50).EQ.0) THEN + WRITE(MPG, 99980) KEEP8(108) + ENDIF + IF ((KEEP(60).NE.0) .AND. INFOG(25).GT.0) THEN + WRITE(MPG, '(A)') + & " ** Warning Static pivoting was necessary" + WRITE(MPG, '(A)') + & " ** to factor interior variables with Schur ON" + ENDIF + IF (KEEP(258).NE.0) THEN + WRITE(MPG,99978) RINFOG(12) + WRITE(MPG,99977) INFOG(34) + ENDIF + END IF + 500 CONTINUE + IF ( I_AM_SLAVE ) THEN + IF ((KEEP(201).EQ.1).OR.(KEEP(201).EQ.2)) THEN + CALL DMUMPS_592(id,IERR) + IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR + ENDIF + IF (WK_USER_PROVIDED) THEN + NULLIFY(id%S) + ELSE IF (KEEP(201).NE.0) THEN + IF (associated(id%S)) DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + ELSE + IF (WK_USER_PROVIDED) THEN + NULLIFY(id%S) + ELSE + IF (associated(id%S)) DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + END IF + END IF + 513 CONTINUE + IF ( I_AM_SLAVE ) THEN + CALL DMUMPS_183( INFO(1), IERR ) + IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + 530 CONTINUE + IF (RHS_MUMPS_ALLOCATED) DEALLOCATE(RHS_MUMPS) + NULLIFY(RHS_MUMPS) + id%KEEP(13) = KEEP13_SAVE + RETURN + 120 FORMAT(/' LOCAL REDISTRIB: DATA LOCAL/SENT =',I12,I12) + 125 FORMAT(/' REDISTRIB: TOTAL DATA LOCAL/SENT =',I12,I12) + 130 FORMAT(/' ****** FACTORIZATION STEP ********'/) + 160 FORMAT(' GLOBAL TIME FOR MATRIX DISTRIBUTION =',F12.4) + 165 FORMAT(' Convergence error after scaling for INF-NORM', + & ' (option 7/8) =',D9.2) + 166 FORMAT(' Convergence error after scaling for ONE-NORM', + & ' (option 7/8) =',D9.2) + 170 FORMAT(/' STATISTICS PRIOR NUMERICAL FACTORIZATION ...'/ + & ' Size of internal working array S =',I12/ + & ' Size of internal working array IS =',I12/ + & ' MINIMUM (ICNTL(14)=0) size of S =',I12/ + & ' MINIMUM (ICNTL(14)=0) size of IS =',I12/ + & ' REAL SPACE FOR ORIGINAL MATRIX =',I12/ + & ' INTEGER SPACE FOR ORIGINAL MATRIX =',I12/ + & ' REAL SPACE FOR FACTORS =',I12/ + & ' INTEGER SPACE FOR FACTORS =',I12/ + & ' MAXIMUM FRONTAL SIZE (ESTIMATED) =',I12) + 172 FORMAT(/' GLOBAL STATISTICS PRIOR NUMERICAL FACTORIZATION ...'/ + & ' NUMBER OF WORKING PROCESSES =',I12/ + & ' OUT-OF-CORE OPTION (ICNTL(22)) =',I12/ + & ' REAL SPACE FOR FACTORS =',I12/ + & ' INTEGER SPACE FOR FACTORS =',I12/ + & ' MAXIMUM FRONTAL SIZE (ESTIMATED) =',I12/ + & ' NUMBER OF NODES IN THE TREE =',I12) + 173 FORMAT( ' PERFORM FORWARD DURING FACTO, NRHS =',I12) + 175 FORMAT(/' NUMBER OF ENTRIES FOR // ROOT =',I12) + 180 FORMAT(/' ELAPSED TIME FOR FACTORIZATION =',F12.4) +99977 FORMAT( ' INFOG(34) DETERMINANT (base 2 exponent) =',I12) +99978 FORMAT( ' RINFOG(12) DETERMINANT (real part) =',F12.4) +99980 FORMAT( ' KEEP8(108) Extra copies IP stacking =',I12) +99981 FORMAT( ' INFOG(14) NUMBER OF MEMORY COMPRESS =',I12) +99982 FORMAT( ' INFOG(13) NUMBER OF DELAYED PIVOTS =',I12) +99983 FORMAT( ' NB OF NULL PIVOTS DETECTED BY ICNTL(16) =',I12) +99991 FORMAT( ' NB OF NULL PIVOTS DETECTED BY ICNTL(24) =',I12) +99992 FORMAT( ' INFOG(28) ESTIMATED DEFICIENCY =',I12) +99984 FORMAT(/' GLOBAL STATISTICS '/ + & ' RINFOG(2) OPERATIONS IN NODE ASSEMBLY =',1PD10.3/ + & ' ------(3) OPERATIONS IN NODE ELIMINATION=',1PD10.3/ + & ' INFOG (9) REAL SPACE FOR FACTORS =',I12/ + & ' INFOG(10) INTEGER SPACE FOR FACTORS =',I12/ + & ' INFOG(11) MAXIMUM FRONT SIZE =',I12/ + & ' INFOG(29) NUMBER OF ENTRIES IN FACTORS =',I12) +99985 FORMAT( ' INFOG(12) NB OF OFF DIAGONAL PIVOTS =',I12) +99986 FORMAT( ' INFOG(25) NB TINY PIVOTS/STATIC PIVOTING =',I12) +99987 FORMAT( ' INFOG(12) NB OF NEGATIVE PIVOTS =',I12) +99988 FORMAT( ' NUMBER OF 2x2 PIVOTS in type 1 nodes =',I12) +99989 FORMAT( ' NUMBER OF 2x2 PIVOTS in type 2 nodes =',I12) + END SUBROUTINE DMUMPS_142 + SUBROUTINE DMUMPS_713(PROKG, MPG, VAL, NSLAVES, + & COMM, MSG) + IMPLICIT NONE + INCLUDE 'mpif.h' + LOGICAL PROKG + INTEGER MPG + INTEGER(8) VAL + INTEGER NSLAVES + INTEGER COMM + CHARACTER*42 MSG + INTEGER(8) MAX_VAL + INTEGER IERR, MASTER + DOUBLE PRECISION LOC_VAL, AVG_VAL + PARAMETER(MASTER=0) + CALL MUMPS_646( VAL, MAX_VAL, MPI_MAX, MASTER, COMM) + LOC_VAL = dble(VAL)/dble(NSLAVES) + CALL MPI_REDUCE( LOC_VAL, AVG_VAL, 1, MPI_DOUBLE_PRECISION, + & MPI_SUM, MASTER, COMM, IERR ) + IF (PROKG) THEN + WRITE(MPG,100) " Maximum ", MSG, MAX_VAL + WRITE(MPG,100) " Average ", MSG, int(AVG_VAL,8) + ENDIF + RETURN + 100 FORMAT(A9,A42,I12) + END SUBROUTINE DMUMPS_713 + SUBROUTINE DMUMPS_770(id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(DMUMPS_STRUC) :: id + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INCLUDE 'mumps_headers.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER IERR, MASTER + PARAMETER( MASTER = 0 ) + INTEGER :: ID_SCHUR, SIZE_SCHUR, LD_SCHUR, IB, BL4 + INTEGER :: ROW_LENGTH, I + INTEGER(8) :: SURFSCHUR8, BL8, SHIFT8 + INTEGER(8) :: ISCHUR_SRC, ISCHUR_DEST, ISCHUR_SYM, ISCHUR_UNS + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + IF (id%INFO(1) .LT. 0) RETURN + IF (id%KEEP(60) .EQ. 0) RETURN + ID_SCHUR =MUMPS_275( + & id%PROCNODE_STEPS(id%STEP(max(id%KEEP(20),id%KEEP(38)))), + & id%NSLAVES) + IF ( id%KEEP( 46 ) .NE. 1 ) THEN + ID_SCHUR = ID_SCHUR + 1 + END IF + IF (id%MYID.EQ.ID_SCHUR) THEN + IF (id%KEEP(60).EQ.1) THEN + LD_SCHUR = + & id%IS(id%PTLUST_S(id%STEP(id%KEEP(20)))+2+id%KEEP(IXSZ)) + SIZE_SCHUR = LD_SCHUR - id%KEEP(253) + ELSE + LD_SCHUR = -999999 + SIZE_SCHUR = id%root%TOT_ROOT_SIZE + ENDIF + ELSE IF (id%MYID .EQ. MASTER) THEN + SIZE_SCHUR = id%KEEP(116) + LD_SCHUR = -44444 + ELSE + RETURN + ENDIF + SURFSCHUR8 = int(SIZE_SCHUR,8)*int(SIZE_SCHUR,8) + IF (id%KEEP(60) .GT. 1) THEN + IF (id%KEEP(221).EQ.1) THEN + DO I = 1, id%KEEP(253) + IF (ID_SCHUR.EQ.MASTER) THEN + CALL dcopy(SIZE_SCHUR, + & id%root%RHS_CNTR_MASTER_ROOT((I-1)*SIZE_SCHUR+1), 1, + & id%REDRHS((I-1)*id%LREDRHS+1), 1) + ELSE + IF (id%MYID.EQ.ID_SCHUR) THEN + CALL MPI_SEND( + & id%root%RHS_CNTR_MASTER_ROOT((I-1)*SIZE_SCHUR+1), + & SIZE_SCHUR, + & MPI_DOUBLE_PRECISION, + & MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE + CALL MPI_RECV( id%REDRHS((I-1)*id%LREDRHS+1), + & SIZE_SCHUR, + & MPI_DOUBLE_PRECISION, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + ENDDO + IF (id%MYID.EQ.ID_SCHUR) THEN + DEALLOCATE(id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY (id%root%RHS_CNTR_MASTER_ROOT) + ENDIF + ENDIF + RETURN + ENDIF + IF (id%KEEP(252).EQ.0) THEN + IF ( ID_SCHUR .EQ. MASTER ) THEN + CALL DMUMPS_756( SURFSCHUR8, + & id%S(id%PTRFAC(id%STEP(id%KEEP(20)))), + & id%SCHUR(1) ) + ELSE + BL8=int(huge(BL4)/id%KEEP(35)/10,8) + DO IB=1, int((SURFSCHUR8+BL8-1_8) / BL8) + SHIFT8 = int(IB-1,8) * BL8 + BL4 = int(min(BL8,SURFSCHUR8-SHIFT8)) + IF ( id%MYID .eq. ID_SCHUR ) THEN + CALL MPI_SEND( id%S( SHIFT8 + + & id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ)))), + & BL4, + & MPI_DOUBLE_PRECISION, + & MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_RECV( id%SCHUR(1_8 + SHIFT8), + & BL4, + & MPI_DOUBLE_PRECISION, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + END IF + ENDDO + END IF + ELSE + ISCHUR_SRC = id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ))) + ISCHUR_DEST= 1_8 + DO I=1, SIZE_SCHUR + ROW_LENGTH = SIZE_SCHUR + IF (ID_SCHUR.EQ.MASTER) THEN + CALL dcopy(ROW_LENGTH, id%S(ISCHUR_SRC), 1, + & id%SCHUR(ISCHUR_DEST),1) + ELSE + IF (id%MYID.EQ.ID_SCHUR) THEN + CALL MPI_SEND( id%S(ISCHUR_SRC), ROW_LENGTH, + & MPI_DOUBLE_PRECISION, + & MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE + CALL MPI_RECV( id%SCHUR(ISCHUR_DEST), + & ROW_LENGTH, + & MPI_DOUBLE_PRECISION, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + ISCHUR_SRC = ISCHUR_SRC+int(LD_SCHUR,8) + ISCHUR_DEST= ISCHUR_DEST+int(SIZE_SCHUR,8) + ENDDO + IF (id%KEEP(221).EQ.1) THEN + ISCHUR_SYM = id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ))) + int(SIZE_SCHUR,8) * + & int(LD_SCHUR,8) + ISCHUR_UNS = + & id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ))) + int(SIZE_SCHUR,8) + ISCHUR_DEST = 1_8 + DO I = 1, id%KEEP(253) + IF (ID_SCHUR .EQ. MASTER) THEN + IF (id%KEEP(50) .EQ. 0) THEN + CALL dcopy(SIZE_SCHUR, id%S(ISCHUR_UNS), LD_SCHUR, + & id%REDRHS(ISCHUR_DEST), 1) + ELSE + CALL dcopy(SIZE_SCHUR, id%S(ISCHUR_SYM), 1, + & id%REDRHS(ISCHUR_DEST), 1) + ENDIF + ELSE + IF (id%MYID .NE. MASTER) THEN + IF (id%KEEP(50) .EQ. 0) THEN + CALL dcopy(SIZE_SCHUR, id%S(ISCHUR_UNS), LD_SCHUR, + & id%S(ISCHUR_SYM), 1) + ENDIF + CALL MPI_SEND(id%S(ISCHUR_SYM), SIZE_SCHUR, + & MPI_DOUBLE_PRECISION, MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE + CALL MPI_RECV(id%REDRHS(ISCHUR_DEST), + & SIZE_SCHUR, MPI_DOUBLE_PRECISION, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + IF (id%KEEP(50).EQ.0) THEN + ISCHUR_UNS = ISCHUR_UNS + int(LD_SCHUR,8) + ELSE + ISCHUR_SYM = ISCHUR_SYM + int(LD_SCHUR,8) + ENDIF + ISCHUR_DEST = ISCHUR_DEST + int(id%LREDRHS,8) + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_770 + SUBROUTINE DMUMPS_83 + & ( N, MAPPING, NZ, IRN, JCN, PROCNODE, STEP, + & SLAVEF, PERM, FILS, + & RG2L, KEEP,KEEP8, MBLOCK, NBLOCK, NPROW, NPCOL ) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N, NZ, SLAVEF, MBLOCK, NBLOCK, NPROW, NPCOL + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IRN( NZ ), JCN( NZ ) + INTEGER MAPPING( NZ ), STEP( N ) + INTEGER PROCNODE( KEEP(28) ), PERM( N ), FILS( N ), RG2L( N ) + INTEGER MUMPS_275, MUMPS_330 + EXTERNAL MUMPS_275, MUMPS_330 + INTEGER K, IOLD, JOLD, INEW, JNEW, ISEND, JSEND, IARR, INODE + INTEGER TYPE_NODE, DEST + INTEGER IPOSROOT, JPOSROOT, IROW_GRID, JCOL_GRID + INODE = KEEP(38) + K = 1 + DO WHILE ( INODE .GT. 0 ) + RG2L( INODE ) = K + INODE = FILS( INODE ) + K = K + 1 + END DO + DO K = 1, NZ + IOLD = IRN( K ) + JOLD = JCN( K ) + IF ( IOLD .GT. N .OR. IOLD .LT. 1 .OR. + & JOLD .GT. N .OR. JOLD .LT. 1 ) THEN + MAPPING( K ) = -1 + CYCLE + END IF + IF ( IOLD .eq. JOLD ) THEN + ISEND = IOLD + JSEND = JOLD + ELSE + INEW = PERM( IOLD ) + JNEW = PERM( JOLD ) + IF ( INEW .LT. JNEW ) THEN + ISEND = IOLD + IF ( KEEP(50) .ne. 0 ) ISEND = -IOLD + JSEND = JOLD + ELSE + ISEND = -JOLD + JSEND = IOLD + END IF + END IF + IARR = abs( ISEND ) + TYPE_NODE = MUMPS_330( PROCNODE(abs(STEP(IARR))), + & SLAVEF ) + IF ( TYPE_NODE .eq. 1 .or. TYPE_NODE .eq. 2 ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + DEST = MUMPS_275( PROCNODE(abs(STEP(IARR))), + & SLAVEF ) + 1 + ELSE + DEST = MUMPS_275( PROCNODE(abs(STEP(IARR))), + & SLAVEF ) + END IF + ELSE + IF ( ISEND .LT. 0 ) THEN + IPOSROOT = RG2L( JSEND ) + JPOSROOT = RG2L( IARR ) + ELSE + IPOSROOT = RG2L( IARR ) + JPOSROOT = RG2L( JSEND ) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/MBLOCK, NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/NBLOCK, NPCOL ) + IF ( KEEP( 46 ) .eq. 0 ) THEN + DEST = IROW_GRID * NPCOL + JCOL_GRID + 1 + ELSE + DEST = IROW_GRID * NPCOL + JCOL_GRID + END IF + END IF + MAPPING( K ) = DEST + END DO + RETURN + END SUBROUTINE DMUMPS_83 + SUBROUTINE DMUMPS_282( + & N, NZ_loc, id, + & DBLARR, LDBLARR, INTARR, LINTARR, + & PTRAIW, PTRARW, KEEP,KEEP8, MYID, COMM, NBRECORDS, + & + & A, LA, root, PROCNODE_STEPS, SLAVEF, PERM, STEP, + & ICNTL, INFO, NSEND, NLOCAL, + & ISTEP_TO_INIV2, CANDIDATES + & ) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N, NZ_loc + TYPE (DMUMPS_STRUC) :: id + INTEGER LDBLARR, LINTARR + DOUBLE PRECISION DBLARR( LDBLARR ) + INTEGER INTARR( LINTARR ) + INTEGER PTRAIW( N ), PTRARW( N ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER MYID, COMM, NBRECORDS + INTEGER(8) :: LA + INTEGER SLAVEF + INTEGER ISTEP_TO_INIV2(KEEP(71)) + INTEGER CANDIDATES(SLAVEF+1, max(1,KEEP(56))) + DOUBLE PRECISION A( LA ) + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER PROCNODE_STEPS(KEEP(28)), PERM( N ), STEP( N ) + INTEGER INFO( 40 ), ICNTL(40) + INTEGER MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + INCLUDE 'mumps_tags.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ), MSGSOU + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IW4 + INTEGER END_MSG_2_RECV + INTEGER I, K, I1, IA + INTEGER TYPE_NODE, DEST + INTEGER IOLD, JOLD, IARR, ISEND, JSEND, INEW, JNEW + INTEGER allocok, TYPESPLIT, T4MASTER, INIV2 + LOGICAL T4_MASTER_CONCERNED + DOUBLE PRECISION VAL + INTEGER(8) :: PTR_ROOT + INTEGER LOCAL_M, LOCAL_N, ARROW_ROOT + INTEGER IROW_GRID, JCOL_GRID, IPOSROOT, JPOSROOT + INTEGER MP,LP + INTEGER KPROBE, FREQPROBE + INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: BUFI + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: BUFR + INTEGER, ALLOCATABLE, DIMENSION(:) :: BUFRECI + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: BUFRECR + INTEGER IACT( SLAVEF ), IREQI( SLAVEF ), IREQR( SLAVEF ) + LOGICAL SEND_ACTIVE( SLAVEF ) + LOGICAL FLAG + INTEGER NSEND, NLOCAL + INTEGER MASTER_NODE, ISTEP + NSEND = 0 + NLOCAL = 0 + LP = ICNTL(1) + MP = ICNTL(2) + END_MSG_2_RECV = SLAVEF + ALLOCATE( BUFI( NBRECORDS * 2 + 1, 2, SLAVEF ), stat=allocok) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating int buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = ( NBRECORDS * 2 + 1 ) * SLAVEF * 2 + END IF + ALLOCATE( BUFR( NBRECORDS, 2, SLAVEF), stat = allocok) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating real buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = NBRECORDS * SLAVEF * 2 + GOTO 20 + END IF + ALLOCATE( BUFRECI( NBRECORDS * 2 + 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating int recv buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = NBRECORDS * 2 + 1 + GOTO 20 + END IF + ALLOCATE( BUFRECR( NBRECORDS ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating int recv buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = NBRECORDS + GOTO 20 + END IF + ALLOCATE( IW4( N, 2 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(LP,*) '** Error allocating IW4 for matrix distribution' + INFO(1) = -13 + INFO(2) = N * 2 + END IF + 20 CONTINUE + CALL MUMPS_276( ICNTL, INFO, COMM, MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + ARROW_ROOT = 0 + DO I = 1, N + I1 = PTRAIW( I ) + IA = PTRARW( I ) + IF ( IA .GT. 0 ) THEN + DBLARR( IA ) = ZERO + IW4( I, 1 ) = INTARR( I1 ) + IW4( I, 2 ) = -INTARR( I1 + 1 ) + INTARR( I1 + 2 ) = I + END IF + END DO + IF ( KEEP(38) .NE. 0 ) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I = 1, root%SCHUR_NLOC + root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1: + & (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC) = ZERO + ENDDO + ENDIF + END IF + DO I = 1, SLAVEF + BUFI( 1, 1, I ) = 0 + END DO + DO I = 1, SLAVEF + BUFI( 1, 2, I ) = 0 + END DO + DO I = 1, SLAVEF + SEND_ACTIVE( I ) = .FALSE. + IACT( I ) = 1 + END DO + KPROBE = 0 + FREQPROBE = max(1,NBRECORDS/10) + DO K = 1, NZ_loc + KPROBE = KPROBE + 1 + IF ( KPROBE .eq. FREQPROBE ) THEN + KPROBE = 0 + CALL MPI_IPROBE( MPI_ANY_SOURCE, ARR_INT, COMM, + & FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + MSGSOU = STATUS( MPI_SOURCE ) + CALL MPI_RECV( BUFRECI(1), NBRECORDS * 2 + 1, + & MPI_INTEGER, + & MSGSOU, ARR_INT, COMM, STATUS, IERR ) + CALL MPI_RECV( BUFRECR(1), NBRECORDS, MPI_DOUBLE_PRECISION, + & MSGSOU, ARR_REAL, COMM, STATUS, IERR ) + CALL DMUMPS_102( + & BUFRECI, BUFRECR, NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END IF + END IF + IOLD = id%IRN_loc(K) + JOLD = id%JCN_loc(K) + IF ( (IOLD.GT.N).OR.(JOLD.GT.N).OR.(IOLD.LT.1) + & .OR.(JOLD.LT.1) ) CYCLE + VAL = id%A_loc(K) + IF ((KEEP(52).EQ.7).OR.(KEEP(52).EQ.8)) THEN + VAL = VAL * id%ROWSCA(IOLD)*id%COLSCA(JOLD) + ENDIF + IF (IOLD.EQ.JOLD) THEN + ISEND = IOLD + JSEND = JOLD + ELSE + INEW = PERM(IOLD) + JNEW = PERM(JOLD) + IF (INEW.LT.JNEW) THEN + ISEND = IOLD + IF ( KEEP(50) .NE. 0 ) ISEND = -IOLD + JSEND = JOLD + ELSE + ISEND = -JOLD + JSEND = IOLD + ENDIF + ENDIF + IARR = abs( ISEND ) + ISTEP = abs(STEP(IARR)) + TYPE_NODE = MUMPS_330( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + MASTER_NODE= MUMPS_275( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + TYPESPLIT = MUMPS_810( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + T4_MASTER_CONCERNED = .FALSE. + T4MASTER = -9999 + IF (TYPE_NODE.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + T4_MASTER_CONCERNED = .TRUE. + T4MASTER=CANDIDATES(CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + ENDIF + ENDIF + IF ( TYPE_NODE .eq. 1 ) THEN + DEST = MASTER_NODE + ELSE IF ( TYPE_NODE .eq. 2 ) THEN + IF ( ISEND .LT. 0 ) THEN + DEST = -1 + ELSE + DEST = MASTER_NODE + END IF + ELSE + IF ( ISEND < 0 ) THEN + IPOSROOT = root%RG2L_ROW(JSEND) + JPOSROOT = root%RG2L_ROW(IARR ) + ELSE + IPOSROOT = root%RG2L_ROW(IARR ) + JPOSROOT = root%RG2L_ROW(JSEND) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, root%NPCOL ) + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + END IF + if (DEST .eq. -1) then + NLOCAL = NLOCAL + 1 + NSEND = NSEND + SLAVEF -1 + else + if (DEST .eq.MYID ) then + NLOCAL = NLOCAL + 1 + else + NSEND = NSEND + 1 + endif + end if + IF ( DEST.EQ.-1) THEN + DO I=1, CANDIDATES(SLAVEF+1,ISTEP_TO_INIV2(ISTEP)) + DEST=CANDIDATES(I,ISTEP_TO_INIV2(ISTEP)) + CALL DMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + ENDDO + DEST=MASTER_NODE + CALL DMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + IF (T4_MASTER_CONCERNED) THEN + DEST = T4MASTER + CALL DMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + ENDIF + ELSE + CALL DMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + IF (T4_MASTER_CONCERNED) THEN + DEST = T4MASTER + CALL DMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + ENDIF + ENDIF + END DO + DEST = -2 + CALL DMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, + & IW4(1,1), root, KEEP,KEEP8 ) + DO WHILE ( END_MSG_2_RECV .NE. 0 ) + CALL MPI_RECV( BUFRECI(1), NBRECORDS * 2 + 1, MPI_INTEGER, + & MPI_ANY_SOURCE, ARR_INT, COMM, STATUS, IERR ) + MSGSOU = STATUS( MPI_SOURCE ) + CALL MPI_RECV( BUFRECR(1), NBRECORDS, MPI_DOUBLE_PRECISION, + & MSGSOU, ARR_REAL, COMM, STATUS, IERR ) + CALL DMUMPS_102( + & BUFRECI, BUFRECR, NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END DO + DO I = 1, SLAVEF + IF ( SEND_ACTIVE( I ) ) THEN + CALL MPI_WAIT( IREQI( I ), STATUS, IERR ) + CALL MPI_WAIT( IREQR( I ), STATUS, IERR ) + END IF + END DO + KEEP(49) = ARROW_ROOT + DEALLOCATE( IW4 ) + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + DEALLOCATE( BUFRECI ) + DEALLOCATE( BUFRECR ) + RETURN + END SUBROUTINE DMUMPS_282 + SUBROUTINE DMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, N, + & PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4, root, + & KEEP,KEEP8 ) + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER ISEND, JSEND, DEST, NBRECORDS, SLAVEF, COMM, MYID, N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER ARROW_ROOT, END_MSG_2_RECV, LOCAL_M, LOCAL_N + INTEGER LINTARR, LDBLARR + INTEGER(8) :: LA, PTR_ROOT + INTEGER BUFI( NBRECORDS * 2 + 1, 2, SLAVEF ) + INTEGER BUFRECI( NBRECORDS * 2 + 1 ) + INTEGER IREQI(SLAVEF), IREQR(SLAVEF), IACT(SLAVEF) + INTEGER IW4( N, 2 ) + INTEGER PTRAIW( N ), PTRARW( N ), PERM( N ), STEP( N ) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER INTARR( LINTARR ) + DOUBLE PRECISION DBLARR( LDBLARR ), A( LA ) + LOGICAL SEND_ACTIVE(SLAVEF) + DOUBLE PRECISION BUFR( NBRECORDS, 2, SLAVEF ) + DOUBLE PRECISION BUFRECR( NBRECORDS ) + DOUBLE PRECISION VAL + INTEGER ISLAVE, IBEG, IEND, NBREC, IREQ + INTEGER TAILLE_SEND_I, TAILLE_SEND_R, MSGSOU + LOGICAL FLAG, SEND_LOCAL + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, STATUS(MPI_STATUS_SIZE) + IF ( DEST .eq. -2 ) THEN + IBEG = 1 + IEND = SLAVEF + ELSE + IBEG = DEST + 1 + IEND = DEST + 1 + END IF + SEND_LOCAL = .FALSE. + DO ISLAVE = IBEG, IEND + NBREC = BUFI(1,IACT(ISLAVE),ISLAVE) + IF ( DEST .eq. -2 ) THEN + BUFI(1,IACT(ISLAVE),ISLAVE) = - NBREC + END IF + IF ( DEST .eq. -2 .or. NBREC + 1 > NBRECORDS ) THEN + DO WHILE ( SEND_ACTIVE( ISLAVE ) ) + CALL MPI_TEST( IREQR( ISLAVE ), FLAG, STATUS, IERR ) + IF ( .NOT. FLAG ) THEN + CALL MPI_IPROBE( MPI_ANY_SOURCE, ARR_INT, COMM, + & FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + MSGSOU = STATUS(MPI_SOURCE) + CALL MPI_RECV( BUFRECI(1), 2*NBRECORDS+1, + & MPI_INTEGER, MSGSOU, ARR_INT, COMM, + & STATUS, IERR ) + CALL MPI_RECV( BUFRECR(1), NBRECORDS, + & MPI_DOUBLE_PRECISION, MSGSOU, + & ARR_REAL, COMM, STATUS, IERR ) + CALL DMUMPS_102( + & BUFRECI, BUFRECR, NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END IF + ELSE + CALL MPI_WAIT( IREQI( ISLAVE ), STATUS, IERR ) + SEND_ACTIVE( ISLAVE ) = .FALSE. + END IF + END DO + IF ( ISLAVE - 1 .ne. MYID ) THEN + TAILLE_SEND_I = NBREC * 2 + 1 + TAILLE_SEND_R = NBREC + CALL MPI_ISEND( BUFI(1, IACT(ISLAVE), ISLAVE ), + & TAILLE_SEND_I, + & MPI_INTEGER, ISLAVE - 1, ARR_INT, COMM, + & IREQI( ISLAVE ), IERR ) + CALL MPI_ISEND( BUFR(1, IACT(ISLAVE), ISLAVE ), + & TAILLE_SEND_R, + & MPI_DOUBLE_PRECISION, ISLAVE - 1, ARR_REAL, COMM, + & IREQR( ISLAVE ), IERR ) + SEND_ACTIVE( ISLAVE ) = .TRUE. + ELSE + SEND_LOCAL = .TRUE. + END IF + IACT( ISLAVE ) = 3 - IACT( ISLAVE ) + BUFI( 1, IACT( ISLAVE ), ISLAVE ) = 0 + END IF + IF ( DEST .ne. -2 ) THEN + IREQ = BUFI(1,IACT(ISLAVE),ISLAVE) + 1 + BUFI(1,IACT(ISLAVE),ISLAVE) = IREQ + BUFI(IREQ*2,IACT(ISLAVE),ISLAVE) = ISEND + BUFI(IREQ*2+1,IACT(ISLAVE),ISLAVE) = JSEND + BUFR(IREQ,IACT(ISLAVE),ISLAVE ) = VAL + END IF + END DO + IF ( SEND_LOCAL ) THEN + ISLAVE = MYID + 1 + CALL DMUMPS_102( + & BUFI(1,3-IACT(ISLAVE),ISLAVE), + & BUFR(1,3-IACT(ISLAVE),ISLAVE), + & NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END IF + RETURN + END SUBROUTINE DMUMPS_101 + SUBROUTINE DMUMPS_102 + & ( BUFI, BUFR, NBRECORDS, N, IW4, + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, + & SLAVEF, ARROW_ROOT, + & PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR ) + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER NBRECORDS, N, ARROW_ROOT, MYID, SLAVEF + INTEGER BUFI( NBRECORDS * 2 + 1 ) + DOUBLE PRECISION BUFR( NBRECORDS ) + INTEGER IW4( N, 2 ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER END_MSG_2_RECV + INTEGER PTRAIW( N ), PTRARW( N ), PERM( N ), STEP( N ) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER LINTARR, LDBLARR + INTEGER INTARR( LINTARR ) + INTEGER LOCAL_M, LOCAL_N + INTEGER(8) :: PTR_ROOT, LA + DOUBLE PRECISION A( LA ), DBLARR( LDBLARR ) + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER IREC, NB_REC, NODE_TYPE, IPROC + INTEGER IPOSROOT, JPOSROOT, IROW_GRID, JCOL_GRID, + & ILOCROOT, JLOCROOT + INTEGER IA, IS1, ISHIFT, IIW, IS, IAS, IARR, JARR + INTEGER TAILLE + DOUBLE PRECISION VAL + NB_REC = BUFI( 1 ) + IF ( NB_REC .LE. 0 ) THEN + END_MSG_2_RECV = END_MSG_2_RECV - 1 + NB_REC = - NB_REC + END IF + IF ( NB_REC .eq. 0 ) GOTO 100 + DO IREC = 1, NB_REC + IARR = BUFI( IREC * 2 ) + JARR = BUFI( IREC * 2 + 1 ) + VAL = BUFR( IREC ) + NODE_TYPE = MUMPS_330( + & PROCNODE_STEPS(abs(STEP(abs( IARR )))), + & SLAVEF ) + IF ( NODE_TYPE .eq. 3 ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + IF ( IARR .GT. 0 ) THEN + IPOSROOT = root%RG2L_ROW( IARR ) + JPOSROOT = root%RG2L_COL( JARR ) + ELSE + IPOSROOT = root%RG2L_ROW( JARR ) + JPOSROOT = root%RG2L_COL( -IARR ) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, root%NPCOL ) + IF ( IROW_GRID .NE. root%MYROW .OR. + & JCOL_GRID .NE. root%MYCOL ) THEN + WRITE(*,*) MYID,':INTERNAL Error: recvd root arrowhead ' + WRITE(*,*) MYID,':not belonging to me. IARR,JARR=',IARR,JARR + WRITE(*,*) MYID,':IROW_GRID,JCOL_GRID=',IROW_GRID,JCOL_GRID + WRITE(*,*) MYID,':MYROW, MYCOL=', root%MYROW, root%MYCOL + WRITE(*,*) MYID,':IPOSROOT,JPOSROOT=', IPOSROOT, JPOSROOT + CALL MUMPS_ABORT() + END IF + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8) + & + int(ILOCROOT-1,8)) = A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + ELSE IF (IARR.GE.0) THEN + IF (IARR.EQ.JARR) THEN + IA = PTRARW(IARR) + DBLARR(IA) = DBLARR(IA) + VAL + ELSE + IS1 = PTRAIW(IARR) + ISHIFT = INTARR(IS1) + IW4(IARR,2) + IW4(IARR,2) = IW4(IARR,2) - 1 + IIW = IS1 + ISHIFT + 2 + INTARR(IIW) = JARR + IS = PTRARW(IARR) + IAS = IS + ISHIFT + DBLARR(IAS) = VAL + ENDIF + ELSE + IARR = -IARR + ISHIFT = PTRAIW(IARR)+IW4(IARR,1)+2 + INTARR(ISHIFT) = JARR + IAS = PTRARW(IARR)+IW4(IARR,1) + IW4(IARR,1) = IW4(IARR,1) - 1 + DBLARR(IAS) = VAL + IPROC = MUMPS_275( PROCNODE_STEPS(abs(STEP(IARR))), + & SLAVEF ) + IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0) + & .AND. + & IW4(IARR,1) .EQ. 0 .AND. + & IPROC .EQ. MYID + & .AND. STEP(IARR) > 0 ) THEN + TAILLE = INTARR( PTRAIW(IARR) ) + CALL DMUMPS_310( N, PERM, + & INTARR( PTRAIW(IARR) + 3 ), + & DBLARR( PTRARW(IARR) + 1 ), + & TAILLE, 1, TAILLE ) + END IF + ENDIF + ENDDO + 100 CONTINUE + RETURN + END SUBROUTINE DMUMPS_102 + SUBROUTINE DMUMPS_151( NRHS, N, KEEP28, IWCB, LIWW, + & W, LWC, + & POSWCB,IWPOSCB,PTRICB,PTRACB) + IMPLICIT NONE + INTEGER NRHS, N,LIWW,LWC,POSWCB,IWPOSCB, KEEP28 + INTEGER IWCB(LIWW),PTRICB(KEEP28),PTRACB(KEEP28) + DOUBLE PRECISION W(LWC) + INTEGER SIZFI, SIZFR + IF ( IWPOSCB .eq. LIWW ) RETURN + DO WHILE ( IWCB( IWPOSCB + 2 ) .eq. 0 ) + SIZFR = IWCB( IWPOSCB + 1 ) + SIZFI = 2 + SIZFR = SIZFR * NRHS + IWPOSCB = IWPOSCB + SIZFI + POSWCB = POSWCB + SIZFR + IF ( IWPOSCB .eq. LIWW ) RETURN + END DO + RETURN + END SUBROUTINE DMUMPS_151 + SUBROUTINE DMUMPS_95(NRHS,N,KEEP28,IWCB,LIWW,W,LWC, + & POSWCB,IWPOSCB,PTRICB,PTRACB) + IMPLICIT NONE + INTEGER NRHS,N,LIWW,LWC,POSWCB,IWPOSCB,KEEP28 + INTEGER IWCB(LIWW),PTRICB(KEEP28),PTRACB(KEEP28) + DOUBLE PRECISION W(LWC) + INTEGER IPTIW,IPTA,SIZFI,SIZFR,LONGI,LONGR + INTEGER I + IPTIW = IWPOSCB + IPTA = POSWCB + LONGI = 0 + LONGR = 0 + IF ( IPTIW .EQ. LIWW ) RETURN +10 CONTINUE + IF (IWCB(IPTIW+2).EQ.0) THEN + SIZFR = IWCB(IPTIW+1) + SIZFI = 2 + SIZFR = SIZFR * NRHS + IF (LONGI.NE.0) THEN + DO 20 I=0,LONGI-1 + IWCB(IPTIW + SIZFI - I) = IWCB (IPTIW - I ) + 20 CONTINUE + DO 30 I=0,LONGR-1 + W(IPTA + SIZFR - I) = W(IPTA - I ) + 30 CONTINUE + ENDIF + DO 40 I=1,KEEP28 + IF ((PTRICB(I).LE.(IPTIW+1)).AND. + & (PTRICB(I).GT.IWPOSCB) ) THEN + PTRICB(I) = PTRICB(I) + SIZFI + PTRACB(I) = PTRACB(I) + SIZFR + ENDIF +40 CONTINUE + IWPOSCB = IWPOSCB + SIZFI + IPTIW = IPTIW + SIZFI + POSWCB = POSWCB + SIZFR + IPTA = IPTA + SIZFR + ELSE + SIZFR = IWCB(IPTIW+1) + SIZFI = 2 + SIZFR = SIZFR * NRHS + IPTIW = IPTIW + SIZFI + LONGI = LONGI + SIZFI + IPTA = IPTA + SIZFR + LONGR = LONGR + SIZFR + ENDIF + IF (IPTIW.NE.LIWW) GOTO 10 + RETURN + END SUBROUTINE DMUMPS_95 + SUBROUTINE DMUMPS_205(MTYPE, IFLAG, N, NZ, + & LHS, WRHS, W, RHS, GIVSOL, SOL, ANORM, XNORM, SCLNRM, + & MPRINT, ICNTL, KEEP,KEEP8) + INTEGER MTYPE,N,NZ,IFLAG,ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION RHS(N),LHS(N) + DOUBLE PRECISION WRHS(N),SOL(*) + DOUBLE PRECISION W(N) + DOUBLE PRECISION RESMAX,RESL2,XNORM, ERMAX,MAXSOL, + & COMAX, SCLNRM, ERL2, ERREL + DOUBLE PRECISION ANORM,DZERO,EPSI + LOGICAL GIVSOL,PROK + INTEGER MPRINT, MP + INTEGER K + INTRINSIC abs, max, sqrt + MP = ICNTL(2) + PROK = (MPRINT .GT. 0) + DZERO = 0.0D0 + EPSI = 0.1D-9 + ANORM = DZERO + RESMAX = DZERO + RESL2 = DZERO + DO 40 K = 1, N + RESMAX = max(RESMAX, abs(RHS(K))) + RESL2 = RESL2 + abs(RHS(K)) * abs(RHS(K)) + ANORM = max(ANORM, W(K)) + 40 CONTINUE + XNORM = DZERO + DO 50 K = 1, N + XNORM = max(XNORM, abs(LHS(K))) + 50 CONTINUE + IF (XNORM .GT. EPSI) THEN + SCLNRM = RESMAX / (ANORM * XNORM) + ELSE + IFLAG = IFLAG + 2 + IF ((MP .GT. 0) .AND. (ICNTL(4) .GE. 2)) WRITE( MP, * ) + &' max-NORM of computed solut. is zero' + SCLNRM = RESMAX / ANORM + ENDIF + RESL2 = sqrt(RESL2) + ERMAX = DZERO + COMAX = DZERO + ERL2 = DZERO + IF (.NOT.GIVSOL) THEN + IF (PROK) WRITE( MPRINT, 90 ) RESMAX, RESL2, ANORM, XNORM, + & SCLNRM + ELSE + MAXSOL = DZERO + DO 60 K = 1, N + MAXSOL = max(MAXSOL, abs(SOL(K))) + 60 CONTINUE + DO 70 K = 1, N + ERL2 = abs(LHS(K) - SOL(K)) ** 2 + ERL2 + ERMAX = max(ERMAX, abs(LHS(K) - SOL(K))) + 70 CONTINUE + DO 80 K = 1, N + IF (abs(SOL(K)) .GT. EPSI) THEN + COMAX = max(COMAX, (abs(LHS(K) - SOL(K)) / abs(SOL(K)))) + ENDIF + 80 CONTINUE + ERL2 = sqrt(ERL2) + IF (MAXSOL .GT. EPSI) THEN + ERREL = ERMAX / MAXSOL + ELSE + IFLAG = IFLAG + 2 + IF ((MP .GT. 0) .AND. (ICNTL(4) .GE. 2)) WRITE( MP, * ) + &' MAX-NORM of exact solution is zero' + ERREL = ERMAX + ENDIF + IF (PROK) WRITE( MPRINT, 100 ) ERMAX, ERL2, ERREL, COMAX, RESMAX + & , RESL2, ANORM, XNORM, SCLNRM + ENDIF + 90 FORMAT (/' RESIDUAL IS ............ (MAX-NORM) =',1PD9.2/ + & ' .. (2-NORM) =',1PD9.2/ + & ' RINFOG(4):NORM OF input Matrix (MAX-NORM)=',1PD9.2/ + & ' RINFOG(5):NORM OF Computed SOLUT (MAX-NORM)=',1PD9.2/ + & ' RINFOG(6):SCALED RESIDUAL ...... (MAX-NORM)=',1PD9.2) + RETURN + 100 FORMAT (/' ERROR IS ............ (MAX-NORM) =',1PD9.2/ + & ' ............ (2-NORM) =',1PD9.2/ + & ' RELATIVE ERROR........... (MAX-NORM) =',1PD9.2/ + & ' Comp. Wise ERROR......... (MAX-NORM) =',1PD9.2/ + & ' AND RESIDUAL IS ......... (MAX-NORM) =',1PD9.2/ + & ' .. (2-NORM) =',1PD9.2/ + & ' NORM OF input MATRIX ... (MAX-NORM) =',1PD9.2/ + & ' NORM of computed SOLUT... (MAX-NORM) =',1PD9.2/ + & ' SCALED RESIDUAL ......... (MAX-NORM) =',1PD9.2) + END SUBROUTINE DMUMPS_205 + SUBROUTINE DMUMPS_206(NZ, N, RHS, + & X, Y, D, R_W, C_W, IW, KASE, + & OMEGA, ERX, JOB, COND, MAXIT, NOITER, LP, KEEP,KEEP8, + & ARRET ) + IMPLICIT NONE + INTEGER NZ, N, KASE, KEEP(500), JOB + INTEGER(8) KEEP8(150) + INTEGER IW(N,2) + DOUBLE PRECISION RHS(N) + DOUBLE PRECISION X(N), Y(N) + DOUBLE PRECISION D(N) + DOUBLE PRECISION R_W(N,2) + DOUBLE PRECISION C_W(N) + INTEGER LP, MAXIT, NOITER + DOUBLE PRECISION COND(2),OMEGA(2) + DOUBLE PRECISION ARRET + DOUBLE PRECISION CGCE, CTAU + DATA CTAU /1.0D3/, CGCE /0.2D0/ + LOGICAL LCOND1, LCOND2 + INTEGER IFLAG, JUMP, I, IMAX + DOUBLE PRECISION ERX, DXMAX + DOUBLE PRECISION CONVER, OM1, OM2, DXIMAX + DOUBLE PRECISION ZERO, ONE,TAU, DD + DOUBLE PRECISION OLDOMG(2) + INTEGER DMUMPS_IXAMAX + INTRINSIC abs, max + SAVE LCOND1, LCOND2, JUMP, DXIMAX, DXMAX, CONVER, + & OM1, OLDOMG, IFLAG + DATA ZERO /0.0D0/, ONE /1.0D0/ + IF (KASE .EQ. 0) THEN + LCOND1 = .FALSE. + LCOND2 = .FALSE. + COND(1) = ONE + COND(2) = ONE + ERX = ZERO + OM1 = ZERO + IFLAG = 0 + NOITER = 0 + JUMP = 1 + ENDIF + SELECT CASE (JUMP) + CASE (1) + GOTO 30 + CASE(2) + GOTO 10 + CASE(3) + GOTO 110 + CASE(4) + GOTO 150 + CASE(5) + GOTO 35 + CASE DEFAULT + END SELECT + 10 CONTINUE + DO 20 I = 1, N + X(I) = X(I) + Y(I) + 20 CONTINUE + IF (NOITER .GT. MAXIT) THEN + IFLAG = IFLAG + 8 + GOTO 70 + ENDIF + 30 CONTINUE + KASE = 14 + JUMP = 5 + RETURN + 35 CONTINUE + IMAX = DMUMPS_IXAMAX(N, X, 1) + DXMAX = abs(X(IMAX)) + OMEGA(1) = ZERO + OMEGA(2) = ZERO + DO 40 I = 1, N + TAU = (R_W(I, 2) * DXMAX + abs(RHS(I))) * dble(N) * CTAU + DD = R_W(I, 1) + abs(RHS(I)) + IF ((DD + TAU) .GT. TAU) THEN + OMEGA(1) = max(OMEGA(1), abs(Y(I)) / DD) + IW(I, 1) = 1 + ELSE + IF (TAU .GT. ZERO) THEN + OMEGA(2) = max(OMEGA(2), + & abs(Y(I)) / (DD + R_W(I, 2) * DXMAX)) + ENDIF + IW(I, 1) = 2 + ENDIF + 40 CONTINUE + OM2 = OMEGA(1) + OMEGA(2) + IF (OM2 .LT. ARRET ) GOTO 70 + IF (MAXIT .EQ. 0) GOTO 70 + IF (NOITER .GT. 1 .AND. OM2 .GT. OM1 * CGCE) THEN + CONVER = OM2 / OM1 + IF (OM2 .GT. OM1) THEN + OMEGA(1) = OLDOMG(1) + OMEGA(2) = OLDOMG(2) + DO 50 I = 1, N + X(I) = C_W(I) + 50 CONTINUE + ENDIF + GOTO 70 + ENDIF + DO 60 I = 1, N + C_W(I) = X(I) + 60 CONTINUE + OLDOMG(1) = OMEGA(1) + OLDOMG(2) = OMEGA(2) + OM1 = OM2 + NOITER = NOITER + 1 + KASE = 2 + JUMP = 2 + RETURN + 70 KASE = 0 + IF (JOB .LE. 0) GOTO 170 + DO 80 I = 1, N + IF (IW(I, 1) .EQ. 1) THEN + R_W(I, 1) = R_W(I, 1) + abs(RHS(I)) + R_W(I, 2) = ZERO + LCOND1 = .TRUE. + ELSE + R_W(I, 2) = R_W(I, 2) * DXMAX + R_W(I, 1) + R_W(I, 1) = ZERO + LCOND2 = .TRUE. + ENDIF + 80 CONTINUE + DO 90 I = 1, N + C_W(I) = X(I) * D(I) + 90 CONTINUE + IMAX = DMUMPS_IXAMAX(N, C_W(1), 1) + DXIMAX = abs(C_W(IMAX)) + IF (.NOT.LCOND1) GOTO 130 + 100 CALL DMUMPS_218(N, KASE, Y, COND(1), C_W, IW(1, 2)) + IF (KASE .EQ. 0) GOTO 120 + IF (KASE .EQ. 1) CALL DMUMPS_204(N, Y, D) + IF (KASE .EQ. 2) CALL DMUMPS_204(N, Y, R_W) + JUMP = 3 + RETURN + 110 CONTINUE + IF (KASE .EQ. 1) CALL DMUMPS_204(N, Y, R_W) + IF (KASE .EQ. 2) CALL DMUMPS_204(N, Y, D) + GOTO 100 + 120 IF (DXIMAX .GT. ZERO) COND(1) = COND(1) / DXIMAX + ERX = OMEGA(1) * COND(1) + 130 IF (.NOT.LCOND2) GOTO 170 + KASE = 0 + 140 CALL DMUMPS_218(N, KASE, Y, COND(2), C_W, IW(1, 2)) + IF (KASE .EQ. 0) GOTO 160 + IF (KASE .EQ. 1) CALL DMUMPS_204(N, Y, D) + IF (KASE .EQ. 2) CALL DMUMPS_204(N, Y, R_W(1, 2)) + JUMP = 4 + RETURN + 150 CONTINUE + IF (KASE .EQ. 1) CALL DMUMPS_204(N, Y, R_W(1, 2)) + IF (KASE .EQ. 2) CALL DMUMPS_204(N, Y, D) + GOTO 140 + 160 IF (DXIMAX .GT. ZERO) THEN + COND(2) = COND(2) / DXIMAX + ENDIF + ERX = ERX + OMEGA(2) * COND(2) + 170 KASE = -IFLAG + RETURN + END SUBROUTINE DMUMPS_206 + SUBROUTINE DMUMPS_207(A, NZ, N, IRN, ICN, Z, KEEP,KEEP8) + INTEGER NZ, N, I, J, K, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IRN(NZ), ICN(NZ) + DOUBLE PRECISION A(NZ) + DOUBLE PRECISION Z(N) + DOUBLE PRECISION ZERO + INTRINSIC abs + DATA ZERO /0.0D0/ + DO 10 I = 1, N + Z(I) = ZERO + 10 CONTINUE + IF (KEEP(50) .EQ.0) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)) + IF (J.NE.I) THEN + Z(J) = Z(J) + abs(A(K)) + ENDIF + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_207 + SUBROUTINE DMUMPS_289(A, NZ, N, IRN, ICN, Z, + & KEEP, KEEP8, COLSCA) + INTEGER, intent(in) :: NZ, N, KEEP(500) + INTEGER(8), intent(in) :: KEEP8(150) + INTEGER, intent(in) :: IRN(NZ), ICN(NZ) + DOUBLE PRECISION, intent(in) :: A(NZ) + DOUBLE PRECISION, intent(in) :: COLSCA(N) + DOUBLE PRECISION, intent(out) :: Z(N) + DOUBLE PRECISION ZERO + DATA ZERO /0.0D0/ + INTEGER I, J, K + DO 10 I = 1, N + Z(I) = ZERO + 10 CONTINUE + IF (KEEP(50) .EQ.0) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)*COLSCA(J)) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)*COLSCA(J)) + IF (J.NE.I) THEN + Z(J) = Z(J) + abs(A(K)*COLSCA(I)) + ENDIF + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_289 + SUBROUTINE DMUMPS_208(A, NZ, N, IRN, ICN, RHS, X, R, W, + & KEEP,KEEP8) + IMPLICIT NONE + INTEGER, intent(in) :: NZ, N, KEEP(500) + INTEGER(8), intent(in) :: KEEP8(150) + INTEGER, intent(in) :: IRN(NZ), ICN(NZ) + DOUBLE PRECISION, intent(in) :: A(NZ), RHS(N), X(N) + DOUBLE PRECISION, intent(out) :: W(N) + DOUBLE PRECISION, intent(out) :: R(N) + INTEGER I, K, J + DOUBLE PRECISION ZERO + DATA ZERO /0.0D0/ + DOUBLE PRECISION D + DO I = 1, N + R(I) = RHS(I) + W(I) = ZERO + ENDDO + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .GT. N) .OR. (J .GT. N) .OR. (I .LT. 1) .OR. (J .LT. 1)) + & CYCLE + D = A(K) * X(J) + R(I) = R(I) - D + W(I) = W(I) + abs(D) + IF ((I.NE.J) .AND. (KEEP(50).NE.0) ) THEN + D = A(K) * X(I) + R(J) = R(J) - D + W(J) = W(J) + abs(D) + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_208 + SUBROUTINE DMUMPS_204(N, R, W) + INTEGER, intent(in) :: N + DOUBLE PRECISION, intent(in) :: W(N) + DOUBLE PRECISION, intent(inout) :: R(N) + INTEGER I + DO 10 I = 1, N + R(I) = R(I) * W(I) + 10 CONTINUE + RETURN + END SUBROUTINE DMUMPS_204 + SUBROUTINE DMUMPS_218(N, KASE, X, EST, W, IW) + INTEGER, intent(in) :: N + INTEGER, intent(inout) :: KASE + INTEGER IW(N) + DOUBLE PRECISION W(N), X(N) + DOUBLE PRECISION EST + INTRINSIC abs, nint, real, sign + INTEGER DMUMPS_IXAMAX + EXTERNAL DMUMPS_IXAMAX + INTEGER ITMAX + PARAMETER (ITMAX = 5) + INTEGER I, ITER, J, JLAST, JUMP + DOUBLE PRECISION ALTSGN + DOUBLE PRECISION TEMP + SAVE ITER, J, JLAST, JUMP + DOUBLE PRECISION ZERO, ONE + PARAMETER( ZERO = 0.0D0 ) + PARAMETER( ONE = 1.0D0 ) + DOUBLE PRECISION, PARAMETER :: RZERO = 0.0D0 + DOUBLE PRECISION, PARAMETER :: RONE = 1.0D0 + IF (KASE .EQ. 0) THEN + DO 10 I = 1, N + X(I) = ONE / dble(N) + 10 CONTINUE + KASE = 1 + JUMP = 1 + RETURN + ENDIF + SELECT CASE (JUMP) + CASE (1) + GOTO 20 + CASE(2) + GOTO 40 + CASE(3) + GOTO 70 + CASE(4) + GOTO 120 + CASE(5) + GOTO 160 + CASE DEFAULT + END SELECT + 20 CONTINUE + IF (N .EQ. 1) THEN + W(1) = X(1) + EST = abs(W(1)) + GOTO 190 + ENDIF + DO 30 I = 1, N + X(I) = sign( RONE,dble(X(I)) ) + IW(I) = nint(dble(X(I))) + 30 CONTINUE + KASE = 2 + JUMP = 2 + RETURN + 40 CONTINUE + J = DMUMPS_IXAMAX(N, X, 1) + ITER = 2 + 50 CONTINUE + DO 60 I = 1, N + X(I) = ZERO + 60 CONTINUE + X(J) = ONE + KASE = 1 + JUMP = 3 + RETURN + 70 CONTINUE + DO 80 I = 1, N + W(I) = X(I) + 80 CONTINUE + DO 90 I = 1, N + IF (nint(sign(RONE, dble(X(I)))) .NE. IW(I)) GOTO 100 + 90 CONTINUE + GOTO 130 + 100 CONTINUE + DO 110 I = 1, N + X(I) = sign(RONE, dble(X(I))) + IW(I) = nint(dble(X(I))) + 110 CONTINUE + KASE = 2 + JUMP = 4 + RETURN + 120 CONTINUE + JLAST = J + J = DMUMPS_IXAMAX(N, X, 1) + IF ((abs(X(JLAST)) .NE. abs(X(J))) .AND. (ITER .LT. ITMAX)) THEN + ITER = ITER + 1 + GOTO 50 + ENDIF + 130 CONTINUE + EST = RZERO + DO 140 I = 1, N + EST = EST + abs(W(I)) + 140 CONTINUE + ALTSGN = RONE + DO 150 I = 1, N + X(I) = ALTSGN * (RONE + dble(I - 1) / dble(N - 1)) + ALTSGN = -ALTSGN + 150 CONTINUE + KASE = 1 + JUMP = 5 + RETURN + 160 CONTINUE + TEMP = RZERO + DO 170 I = 1, N + TEMP = TEMP + abs(X(I)) + 170 CONTINUE + TEMP = 2.0D0 * TEMP / dble(3 * N) + IF (TEMP .GT. EST) THEN + DO 180 I = 1, N + W(I) = X(I) + 180 CONTINUE + EST = TEMP + ENDIF + 190 KASE = 0 + RETURN + END SUBROUTINE DMUMPS_218 + SUBROUTINE DMUMPS_278( MTYPE, N, NZ, ASPK, IRN, ICN, + & LHS, WRHS, W, RHS, KEEP,KEEP8) + IMPLICIT NONE + INTEGER MTYPE, N, NZ + INTEGER IRN( NZ ), ICN( NZ ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION, intent(in) :: ASPK( NZ ) + DOUBLE PRECISION, intent(in) :: LHS( N ), WRHS( N ) + DOUBLE PRECISION, intent(out):: RHS( N ) + DOUBLE PRECISION, intent(out):: W( N ) + INTEGER K, I, J + DOUBLE PRECISION DZERO + PARAMETER(DZERO = 0.0D0) + DO 10 K = 1, N + W(K) = DZERO + RHS(K) = WRHS(K) + 10 CONTINUE + IF ( KEEP(50) .EQ. 0 ) THEN + IF (MTYPE .EQ. 1) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + RHS(I) = RHS(I) - ASPK(K) * LHS(J) + W(I) = W(I) + abs(ASPK(K)) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + RHS(J) = RHS(J) - ASPK(K) * LHS(I) + W(J) = W(J) + abs(ASPK(K)) + ENDDO + ENDIF + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + RHS(I) = RHS(I) - ASPK(K) * LHS(J) + W(I) = W(I) + abs(ASPK(K)) + IF (J.NE.I) THEN + RHS(J) = RHS(J) - ASPK(K) * LHS(I) + W(J) = W(J) + abs(ASPK(K)) + ENDIF + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_278 + SUBROUTINE DMUMPS_121( MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & LHS, WRHS, W, RHS, KEEP,KEEP8) + IMPLICIT NONE + INTEGER MTYPE, N, NELT, LELTVAR, NA_ELT + INTEGER ELTPTR(NELT+1), ELTVAR(LELTVAR) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION A_ELT(NA_ELT) + DOUBLE PRECISION LHS( N ), WRHS( N ), RHS( N ) + DOUBLE PRECISION W(N) + CALL DMUMPS_257(N, NELT, ELTPTR, ELTVAR, A_ELT, + & LHS, RHS, KEEP(50), MTYPE ) + RHS = WRHS - RHS + CALL DMUMPS_119( MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & W, KEEP,KEEP8 ) + RETURN + END SUBROUTINE DMUMPS_121 + SUBROUTINE DMUMPS_119( MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & W, KEEP,KEEP8 ) + IMPLICIT NONE + INTEGER MTYPE, N, NELT, LELTVAR, NA_ELT + INTEGER ELTPTR(NELT+1), ELTVAR(LELTVAR) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION A_ELT(NA_ELT) + DOUBLE PRECISION TEMP + DOUBLE PRECISION W(N) + INTEGER K, I, J, IEL, SIZEI, IELPTR + DOUBLE PRECISION DZERO + PARAMETER(DZERO = 0.0D0) + W = DZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( KEEP(50).EQ.0 ) THEN + IF (MTYPE.EQ.1) THEN + DO J = 1, SIZEI + DO I = 1, SIZEI + W( ELTVAR( IELPTR + I) ) = + & W( ELTVAR( IELPTR + I) ) + & + abs(A_ELT( K )) + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = W( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + TEMP = TEMP + abs( A_ELT(K)) + K = K + 1 + END DO + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + TEMP + END DO + ENDIF + ELSE + DO J = 1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + abs(A_ELT( K )) + K = K + 1 + DO I = J+1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + abs(A_ELT( K )) + W(ELTVAR( IELPTR + I ) ) = + & W(ELTVAR( IELPTR + I )) + abs(A_ELT( K )) + K = K + 1 + END DO + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_119 + SUBROUTINE DMUMPS_135(MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & W, KEEP,KEEP8, COLSCA ) + IMPLICIT NONE + INTEGER MTYPE, N, NELT, LELTVAR, NA_ELT + INTEGER ELTPTR(NELT+1), ELTVAR(LELTVAR) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION COLSCA(N) + DOUBLE PRECISION A_ELT(NA_ELT) + DOUBLE PRECISION W(N) + DOUBLE PRECISION TEMP, TEMP2 + INTEGER K, I, J, IEL, SIZEI, IELPTR + DOUBLE PRECISION DZERO + PARAMETER(DZERO = 0.0D0) + W = DZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( KEEP(50).EQ.0 ) THEN + IF (MTYPE.EQ.1) THEN + DO J = 1, SIZEI + TEMP2 = abs(COLSCA(ELTVAR( IELPTR + J) )) + DO I = 1, SIZEI + W( ELTVAR( IELPTR + I) ) = + & W( ELTVAR( IELPTR + I) ) + & + abs(A_ELT( K )) * TEMP2 + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = W( ELTVAR( IELPTR + J ) ) + TEMP2= abs(COLSCA(ELTVAR( IELPTR + J) )) + DO I = 1, SIZEI + TEMP = TEMP + abs(A_ELT( K )) * TEMP2 + K = K + 1 + END DO + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + TEMP + END DO + ENDIF + ELSE + DO J = 1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + + & abs( A_ELT( K )*COLSCA(ELTVAR( IELPTR + J)) ) + K = K + 1 + DO I = J+1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + + & abs(A_ELT( K )*COLSCA(ELTVAR( IELPTR + J))) + W(ELTVAR( IELPTR + I ) ) = + & W(ELTVAR( IELPTR + I )) + + & abs(A_ELT( K )*COLSCA(ELTVAR( IELPTR + I))) + K = K + 1 + END DO + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_135 + SUBROUTINE DMUMPS_122( MTYPE, N, NELT, ELTPTR, + & LELTVAR, ELTVAR, NA_ELT, A_ELT, + & SAVERHS, X, Y, W, K50 ) + IMPLICIT NONE + INTEGER N, NELT, K50, MTYPE, LELTVAR, NA_ELT + INTEGER ELTPTR( NELT + 1 ), ELTVAR( LELTVAR ) + DOUBLE PRECISION A_ELT( NA_ELT ), X( N ), Y( N ), + & SAVERHS(N) + DOUBLE PRECISION W(N) + INTEGER IEL, I , J, K, SIZEI, IELPTR + DOUBLE PRECISION ZERO + DOUBLE PRECISION TEMP + DOUBLE PRECISION TEMP2 + PARAMETER( ZERO = 0.0D0 ) + Y = SAVERHS + W = ZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( K50 .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO J = 1, SIZEI + TEMP = X( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) - + & A_ELT( K ) * TEMP + W( ELTVAR( IELPTR + I ) ) = + & W( ELTVAR( IELPTR + I ) ) + + & abs( A_ELT( K ) * TEMP ) + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = Y( ELTVAR( IELPTR + J ) ) + TEMP2 = W( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + TEMP = TEMP - + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + TEMP2 = TEMP2 + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) ) + K = K + 1 + END DO + Y( ELTVAR( IELPTR + J ) ) = TEMP + W( ELTVAR( IELPTR + J ) ) = TEMP2 + END DO + END IF + ELSE + DO J = 1, SIZEI + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) - + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + W( ELTVAR( IELPTR + J ) ) = + & W( ELTVAR( IELPTR + J ) ) + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) ) + K = K + 1 + DO I = J+1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) - + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) - + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + W( ELTVAR( IELPTR + I ) ) = + & W( ELTVAR( IELPTR + I ) ) + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) ) + W( ELTVAR( IELPTR + J ) ) = + & W( ELTVAR( IELPTR + J ) ) + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) ) + K = K + 1 + END DO + END DO + END IF + END DO + RETURN + END SUBROUTINE DMUMPS_122 + SUBROUTINE DMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + USE DMUMPS_OOC + IMPLICIT NONE + INTEGER INODE,KEEP(500),N + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N) + INTEGER IERR + DOUBLE PRECISION A(LA) + INTEGER RETURN_VALUE + LOGICAL MUST_BE_PERMUTED + RETURN_VALUE=DMUMPS_726(INODE,PTRFAC, + & KEEP(28),A,LA,IERR) + IF(RETURN_VALUE.EQ.OOC_NODE_NOT_IN_MEM)THEN + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL DMUMPS_578(INODE,PTRFAC, + & KEEP,KEEP8,A,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL DMUMPS_577( + & A(PTRFAC(STEP(INODE))), + & INODE,IERR + & ) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ELSE + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + IF(RETURN_VALUE.NE.OOC_NODE_PERMUTED)THEN + MUST_BE_PERMUTED=.TRUE. + CALL DMUMPS_682(INODE) + ELSE + MUST_BE_PERMUTED=.FALSE. + ENDIF + RETURN + END SUBROUTINE DMUMPS_643 + SUBROUTINE DMUMPS_257( N, NELT, ELTPTR, ELTVAR, A_ELT, + & X, Y, K50, MTYPE ) + IMPLICIT NONE + INTEGER N, NELT, K50, MTYPE + INTEGER ELTPTR( NELT + 1 ), ELTVAR( * ) + DOUBLE PRECISION A_ELT( * ), X( N ), Y( N ) + INTEGER IEL, I , J, K, SIZEI, IELPTR + DOUBLE PRECISION TEMP + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + Y = ZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( K50 .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO J = 1, SIZEI + TEMP = X( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) + + & A_ELT( K ) * TEMP + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = Y( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + TEMP = TEMP + + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + K = K + 1 + END DO + Y( ELTVAR( IELPTR + J ) ) = TEMP + END DO + END IF + ELSE + DO J = 1, SIZEI + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) + + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + K = K + 1 + DO I = J+1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) + + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) + + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + K = K + 1 + END DO + END DO + END IF + END DO + RETURN + END SUBROUTINE DMUMPS_257 + SUBROUTINE DMUMPS_192 + &( N, NZ_loc, IRN_loc, JCN_loc, A_loc, X, Y_loc, + & LDLT, MTYPE) + IMPLICIT NONE + INTEGER N, NZ_loc + INTEGER IRN_loc( NZ_loc ), JCN_loc( NZ_loc ) + DOUBLE PRECISION A_loc( NZ_loc ), X( N ), Y_loc( N ) + INTEGER LDLT, MTYPE + INTEGER I, J, K + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + Y_loc = ZERO + IF ( LDLT .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + A_loc(K) * X(J) + ENDDO + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) + & .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(J) = Y_loc(J) + A_loc(K) * X(I) + ENDDO + END IF + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + A_loc(K) * X(J) + IF (J.NE.I) THEN + Y_loc(J) = Y_loc(J) + A_loc(K) * X(I) + ENDIF + ENDDO + END IF + RETURN + END SUBROUTINE DMUMPS_192 + SUBROUTINE DMUMPS_256( N, NZ, IRN, ICN, ASPK, X, Y, + & LDLT, MTYPE, MAXTRANS, PERM ) + INTEGER N, NZ, LDLT, MTYPE, MAXTRANS + INTEGER IRN( NZ ), ICN( NZ ) + INTEGER PERM( N ) + DOUBLE PRECISION ASPK( NZ ), X( N ), Y( N ) + INTEGER K, I, J + DOUBLE PRECISION PX( N ) + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + Y = ZERO + IF ( MAXTRANS .eq. 1 .and. MTYPE .eq. 1) THEN + DO I = 1, N + PX(I) = X( PERM( I ) ) + END DO + ELSE + PX = X + END IF + IF ( LDLT .eq. 0 ) THEN + IF (MTYPE .EQ. 1) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y(I) = Y(I) + ASPK(K) * PX(J) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y(J) = Y(J) + ASPK(K) * PX(I) + ENDDO + ENDIF + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y(I) = Y(I) + ASPK(K) * PX(J) + IF (J.NE.I) THEN + Y(J) = Y(J) + ASPK(K) * PX(I) + ENDIF + ENDDO + END IF + IF ( MAXTRANS .EQ. 1 .AND. MTYPE .eq. 0 ) THEN + PX = Y + DO I = 1, N + Y( PERM( I ) ) = PX( I ) + END DO + END IF + RETURN + END SUBROUTINE DMUMPS_256 + SUBROUTINE DMUMPS_193 + &( N, NZ_loc, IRN_loc, JCN_loc, A_loc, X, Y_loc, + & LDLT, MTYPE) + IMPLICIT NONE + INTEGER N, NZ_loc + INTEGER IRN_loc( NZ_loc ), JCN_loc( NZ_loc ) + DOUBLE PRECISION A_loc( NZ_loc ), X( N ) + DOUBLE PRECISION Y_loc( N ) + INTEGER LDLT, MTYPE + INTEGER I, J, K + DOUBLE PRECISION RZERO + PARAMETER( RZERO = 0.0D0 ) + Y_loc = RZERO + IF ( LDLT .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + abs( A_loc(K) * X(J) ) + ENDDO + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) + & .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(J) = Y_loc(J) + abs( A_loc(K) * X(I) ) + ENDDO + END IF + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + abs( A_loc(K) * X(J) ) + IF (J.NE.I) THEN + Y_loc(J) = Y_loc(J) + abs( A_loc(K) * X(I) ) + ENDIF + ENDDO + END IF + RETURN + END SUBROUTINE DMUMPS_193 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part6.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part6.F new file mode 100644 index 000000000..1c51f2519 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part6.F @@ -0,0 +1,4300 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE DMUMPS_324(A, LDA, NPIV, NBROW, K50 ) + IMPLICIT NONE + INTEGER LDA, NPIV, NBROW, K50 + DOUBLE PRECISION A(int(LDA,8)*int(NBROW+NPIV,8)) + INTEGER(8) :: IOLD, INEW, J8 + INTEGER I , ILAST + INTEGER NBROW_L_RECTANGLE_TO_MOVE + IF ((NPIV.EQ.0).OR.(LDA.EQ.NPIV)) GOTO 500 + IF ( K50.NE.0 ) THEN + IOLD = int(LDA + 1,8) + INEW = int(NPIV + 1,8) + IF (IOLD .EQ. INEW ) THEN + INEW = INEW + int(NPIV,8) * int(NPIV - 1,8) + IOLD = IOLD + int(LDA,8) * int(NPIV - 1,8) + ELSE + DO I = 1, NPIV - 1 + IF ( I .LE. NPIV-2 ) THEN + ILAST = I+1 + ELSE + ILAST = I + ENDIF + DO J8 = 0_8, int(ILAST,8) + A( INEW + J8 ) = A( IOLD + J8 ) + END DO + INEW = INEW + int(NPIV,8) + IOLD = IOLD + int(LDA,8) + END DO + ENDIF + NBROW_L_RECTANGLE_TO_MOVE = NBROW + ELSE + INEW = 1_8 + int(NPIV,8) * int(LDA + 1,8) + IOLD = 1_8 + int(LDA,8) * int(NPIV +1,8) + NBROW_L_RECTANGLE_TO_MOVE = NBROW - 1 + ENDIF + DO I = 1, NBROW_L_RECTANGLE_TO_MOVE + DO J8 = 0_8, int(NPIV - 1,8) + A( INEW + J8 ) = A( IOLD + J8 ) + END DO + INEW = INEW + int(NPIV,8) + IOLD = IOLD + int(LDA,8) + ENDDO + 500 RETURN + END SUBROUTINE DMUMPS_324 + SUBROUTINE DMUMPS_651(A, LDA, NPIV, NCONTIG ) + IMPLICIT NONE + INTEGER NCONTIG, NPIV, LDA + DOUBLE PRECISION A(NCONTIG*LDA) + INTEGER I, J + INTEGER(8) :: INEW, IOLD + INEW = int(NPIV+1,8) + IOLD = int(LDA+1,8) + DO I = 2, NCONTIG + DO J = 1, NPIV + A(INEW)=A(IOLD) + INEW = INEW + 1_8 + IOLD = IOLD + 1_8 + ENDDO + IOLD = IOLD + int(LDA - NPIV,8) + ENDDO + RETURN + END SUBROUTINE DMUMPS_651 + SUBROUTINE DMUMPS_652( A, LA, LDA, POSELT, + & IPTRLU, NPIV, + & NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, SIZECB, KEEP, COMPRESSCB, + & LAST_ALLOWED, NBROW_ALREADY_STACKED ) + IMPLICIT NONE + INTEGER(8), intent (in) :: POSELT, IPTRLU, LA, SIZECB + LOGICAL, intent (in) :: COMPRESSCB + DOUBLE PRECISION A(LA) + INTEGER, intent(in):: LDA, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND + INTEGER, intent(inout) :: NBROW_ALREADY_STACKED + INTEGER(8), intent(in) :: LAST_ALLOWED + INTEGER(8) :: APOS, NPOS + INTEGER NBROW + INTEGER(8) :: J + INTEGER I, KEEP(500) +#if ! defined(ALLOW_NON_INIT) + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) +#endif + NBROW = NBROW_STACK + NBROW_SEND + IF (NBROW_STACK .NE. 0 ) THEN + NPOS = IPTRLU + SIZECB + APOS = POSELT + int(NPIV+NBROW,8) * int(LDA,8) - 1_8 + IF ( KEEP(50) .EQ. 0 .OR. .NOT. COMPRESSCB ) THEN + APOS = APOS - int(LDA,8) * int(NBROW_ALREADY_STACKED,8) + NPOS = NPOS + & - int(NBCOL_STACK,8) * int(NBROW_ALREADY_STACKED,8) + ELSE + APOS = APOS - int(LDA - 1,8) * int(NBROW_ALREADY_STACKED,8) + NPOS = NPOS - ( int(NBROW_ALREADY_STACKED,8) * + & int(NBROW_ALREADY_STACKED+1,8) ) / 2_8 + ENDIF + DO I = NBROW - NBROW_ALREADY_STACKED, NBROW_SEND+1, -1 + IF (KEEP(50).EQ.0) THEN + IF ( NPOS - int(NBCOL_STACK,8) + 1_8 .LT. + & LAST_ALLOWED ) THEN + EXIT + ENDIF + DO J= 1_8,int(NBCOL_STACK,8) + A(NPOS-J+1_8) = A(APOS-J+1_8) + ENDDO + NPOS = NPOS - int(NBCOL_STACK,8) + ELSE + IF (.NOT. COMPRESSCB) THEN + IF ( NPOS - int(NBCOL_STACK,8) + 1_8 .LT. + & LAST_ALLOWED ) THEN + EXIT + ENDIF +#if ! defined(ALLOW_NON_INIT) + DO J = 1_8, int(NBCOL_STACK - I,8) + A(NPOS - J + 1_8) = ZERO + END DO +#endif + NPOS = NPOS + int(- NBCOL_STACK + I,8) + ENDIF + IF ( NPOS - int(I,8) + 1_8 .LT. LAST_ALLOWED ) THEN + EXIT + ENDIF + DO J =1_8, int(I,8) + A(NPOS-J+1_8) = A(APOS-J+1_8) + ENDDO + NPOS = NPOS - int(I,8) + ENDIF + IF (KEEP(50).EQ.0) THEN + APOS = APOS - int(LDA,8) + ELSE + APOS = APOS - int(LDA + 1,8) + ENDIF + NBROW_ALREADY_STACKED = NBROW_ALREADY_STACKED + 1 + ENDDO + END IF + RETURN + END SUBROUTINE DMUMPS_652 + SUBROUTINE DMUMPS_705( A, LA, LDA, POSELT, + & IPTRLU, NPIV, + & NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, SIZECB, KEEP, COMPRESSCB) + IMPLICIT NONE + INTEGER(8), intent (in) :: POSELT, IPTRLU, LA, SIZECB + LOGICAL, intent (in) :: COMPRESSCB + DOUBLE PRECISION A(LA) + INTEGER, intent(in):: LDA, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND + INTEGER(8) :: APOS, NPOS, APOS_ini, NPOS_ini + INTEGER I, KEEP(500) + INTEGER(8) :: J, LDA8 +#if ! defined(ALLOW_NON_INIT) + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) +#endif + LDA8 = int(LDA,8) + NPOS_ini = IPTRLU + 1_8 + APOS_ini = POSELT + int(NPIV+NBROW_SEND,8)* LDA8 + int(NPIV,8) + DO I = 1, NBROW_STACK + IF (COMPRESSCB) THEN + NPOS = NPOS_ini + int(I-1,8) * int(I,8)/2_8 + + & int(I-1,8) * int(NBROW_SEND,8) + ELSE + NPOS = NPOS_ini + int(I-1,8) * int(NBCOL_STACK,8) + ENDIF + APOS = APOS_ini + int(I-1,8) * LDA8 + IF (KEEP(50).EQ.0) THEN + DO J = 1_8, int(NBCOL_STACK,8) + A(NPOS+J-1_8) = A(APOS+J-1_8) + ENDDO + ELSE + DO J = 1_8, int(I + NBROW_SEND,8) + A(NPOS+J-1_8)=A(APOS+J-1_8) + ENDDO +#if ! defined(ALLOW_NON_INIT) + IF (.NOT. COMPRESSCB) THEN + A(NPOS+int(I+NBROW_SEND,8): + & NPOS+int(NBCOL_STACK-1,8))=ZERO + ENDIF +#endif + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_705 + SUBROUTINE DMUMPS_140( N, INODE, IW, LIW, A, LA, + & IOLDPS, POSELT, IFLAG, + & UU, NNEG, NPVW, + & KEEP,KEEP8, + & MYID, SEUIL, AVOID_DELAYED, ETATASS, + & DKEEP,PIVNUL_LIST,LPN_LIST, IWPOS ) + USE DMUMPS_OOC + IMPLICIT NONE + INTEGER(8) :: LA, POSELT + INTEGER N, INODE, LIW, IFLAG, NNEG, NPVW + INTEGER MYID, IOLDPS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION UU, SEUIL + DOUBLE PRECISION A( LA ) + INTEGER, TARGET :: IW( LIW ) + LOGICAL AVOID_DELAYED + INTEGER ETATASS, IWPOS + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER INOPV, IFINB, NFRONT, NPIV, NBOLKJ, + & NBTLKJ,IBEG_BLOCK + INTEGER NASS, NEL1, IFLAG_OOC + INTEGER :: LDA + DOUBLE PRECISION UUTEMP + INCLUDE 'mumps_headers.h' + EXTERNAL DMUMPS_222, DMUMPS_234, + & DMUMPS_230, DMUMPS_226, + & DMUMPS_237 + LOGICAL STATICMODE + DOUBLE PRECISION SEUIL_LOC + INTEGER PIVSIZ,IWPOSP2 + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten, + & IDUMMY + LOGICAL POSTPONE_COL_UPDATE, IS_MAXFROMM_AVAIL + DOUBLE PRECISION MAXFROMM + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INTEGER PP_FIRST2SWAP_L + INTEGER PP_LastPIVRPTRFilled + IS_MAXFROMM_AVAIL = .FALSE. + INOPV = 0 + SEUIL_LOC = SEUIL + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + UUTEMP=UU + ENDIF + POSTPONE_COL_UPDATE = (UUTEMP == 0.0D0 .AND. KEEP(201).NE.1) + IBEG_BLOCK = 1 + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + LDA = NFRONT + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5), NASS ) + ENDIF + NBTLKJ = NBOLKJ + IF (KEEP(201).EQ.1) THEN + IDUMMY = -8765 + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_L + NextPiv2beWritten = 1 + PP_FIRST2SWAP_L = NextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + PP_LastPIVRPTRFilled = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 1 + MonBloc%NROW = NFRONT + MonBloc%NCOL = NFRONT + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -77777 + MonBloc%INDICES => + & IW(IOLDPS+6+NFRONT+KEEP(IXSZ): + & IOLDPS+5+NFRONT+KEEP(IXSZ)+NFRONT) + ENDIF + IW(IOLDPS+3+KEEP(IXSZ)) = min0(NASS,NBTLKJ) + UUTEMP = UU + 50 CONTINUE + CALL DMUMPS_222(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV, NNEG, IFLAG,IOLDPS,POSELT,UUTEMP, + & SEUIL_LOC,KEEP,KEEP8,PIVSIZ, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, KEEP(IXSZ), + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled, MAXFROMM, IS_MAXFROMM_AVAIL) + IF (IFLAG.LT.0) GOTO 500 + IF(KEEP(109).GT. 0) THEN + IF(PIVNUL_LIST(KEEP(109)).EQ.-1) THEN + IWPOSP2 = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6+KEEP(IXSZ) + & +IW(IOLDPS+5+KEEP(IXSZ)) + PIVNUL_LIST(KEEP(109)) = IW(IWPOSP2) + ENDIF + ENDIF + IF (INOPV.EQ.1) THEN + IF(STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + CALL DMUMPS_237(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, KEEP,KEEP8, POSTPONE_COL_UPDATE, + & ETATASS, + & TYPEFile, LAFAC, MonBloc, NextPiv2beWritten, + & LIWFAC, MYID, IFLAG) + GOTO 500 + END IF + IF (INOPV.EQ.2) THEN + CALL DMUMPS_234(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, NBOLKJ, NBTLKJ,KEEP(4), + & POSTPONE_COL_UPDATE, + & KEEP,KEEP8) + GOTO 50 + ENDIF + NPVW = NPVW + PIVSIZ + IF (NASS.LE.1) THEN + CALL DMUMPS_230(NFRONT,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + GO TO 500 + ENDIF + CALL DMUMPS_226(IBEG_BLOCK, + & NFRONT, NASS, N,INODE,IW,LIW,A,LA, + & LDA, POSTPONE_COL_UPDATE, IOLDPS, + & POSELT,IFINB, + & NBTLKJ,PIVSIZ, KEEP(IXSZ),MAXFROMM, + & IS_MAXFROMM_AVAIL, (UUTEMP.NE.0.0D0), + & KEEP(253) ) + IF(PIVSIZ .EQ. 2) THEN + IWPOSP2 = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6 + IW(IWPOSP2+NFRONT+KEEP(IXSZ)) = -IW(IWPOSP2+NFRONT+KEEP(IXSZ)) + ENDIF + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + PIVSIZ + IF (IFINB.EQ.0) GOTO 50 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NEL1 = NASS - NPIV + IF (KEEP(201).EQ.1) THEN + IF (IFINB.EQ.-1) THEN + MonBloc%Last = .TRUE. + ELSE + MonBloc%Last = .FALSE. + ENDIF + MonBloc%LastPiv= NPIV + LAST_CALL=.FALSE. + CALL DMUMPS_688( + & STRAT_TRY_WRITE, + & TYPEFile, A(POSELT), + & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS), + & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + ENDIF + CALL DMUMPS_234(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, NBOLKJ, NBTLKJ,KEEP(4), + & POSTPONE_COL_UPDATE, + & KEEP,KEEP8) + IF (IFINB.EQ.-1) THEN + CALL DMUMPS_237(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, KEEP,KEEP8, + & POSTPONE_COL_UPDATE, ETATASS, + & TYPEFile, LAFAC, MonBloc, NextPiv2beWritten, + & LIWFAC, MYID, IFLAG) + & + GOTO 500 + ENDIF + GO TO 50 + 500 CONTINUE + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + LAST_CALL=.TRUE. + CALL DMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG < 0 ) RETURN + CALL DMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + RETURN + END SUBROUTINE DMUMPS_140 + SUBROUTINE DMUMPS_222 + & (NFRONT,NASS,N,INODE,IW,LIW, + & A,LA, INOPV, + & NNEG, + & IFLAG,IOLDPS,POSELT,UU, SEUIL,KEEP,KEEP8,PIVSIZ, + & DKEEP,PIVNUL_LIST,LPN_LIST, XSIZE, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled,MAXFROMM,IS_MAXFROMM_AVAIL) +#if defined (PROFILE_BLAS_ASS_G) + USE DMUMPS_LOAD +#endif + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER(8) :: POSELT, LA + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV, + & IOLDPS, NNEG + INTEGER PIVSIZ,LPIV, XSIZE + DOUBLE PRECISION A(LA) + DOUBLE PRECISION UU, UULOC, SEUIL + INTEGER IW(LIW) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk + INTEGER PP_LastPIVRPTRIndexFilled + DOUBLE PRECISION, intent(in) :: MAXFROMM + LOGICAL, intent(inout) :: IS_MAXFROMM_AVAIL + include 'mpif.h' + INTEGER (8) :: POSPV1,POSPV2,OFFDAG,APOSJ + INTEGER JMAX + DOUBLE PRECISION RMAX,AMAX,TMAX,TOL + DOUBLE PRECISION MAXPIV + DOUBLE PRECISION PIVNUL + DOUBLE PRECISION FIXA, CSEUIL + DOUBLE PRECISION PIVOT,DETPIV + PARAMETER(TOL = 1.0D-20) + INCLUDE 'mumps_headers.h' + INTEGER :: J + INTEGER(8) :: APOS, J1, J2, JJ, NFRONT8, KK, J1_ini, JJ_ini + INTEGER :: LDA + INTEGER(8) :: LDA8 + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,K + INTRINSIC max + DOUBLE PRECISION ZERO, ONE + PARAMETER( ZERO = 0.0D0 ) + PARAMETER( ONE = 1.0D0 ) + DOUBLE PRECISION RZERO,RONE + PARAMETER(RZERO=0.0D0, RONE=1.0D0) + LOGICAL OMP_FLAG + INTEGER I_PIVRPTR, I_PIVR, NBPANELS_L + PIVNUL = DKEEP(1) + FIXA = DKEEP(2) + CSEUIL = SEUIL + LDA = NFRONT + LDA8 = int(LDA,8) + NFRONT8 = int(NFRONT,8) + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL DMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR, I_PIVR, IOLDPS+2*NFRONT+6+KEEP(IXSZ), + & IW, LIW) + ENDIF + UULOC = UU + PIVSIZ = 1 + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NASSW = iabs(IW(IOLDPS+3+XSIZE)) + IF(INOPV .EQ. -1) THEN + APOS = POSELT + (LDA8+1_8) * int(NPIV,8) + POSPV1 = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF(dble(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + NNEG = NNEG+1 + ENDIF + KEEP(98) = KEEP(98)+1 + ELSE IF (KEEP(258) .NE. 0) THEN + CALL DMUMPS_762( A(APOS), DKEEP(6), KEEP(259) ) + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL DMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + LDA8*int(IPIV-1,8) + int(NPIV,8) + POSPV1 = APOS + int(IPIV - NPIVP1,8) + PIVOT = A(POSPV1) + IF (UULOC.EQ.RZERO) THEN + IF (abs(A(APOS)).EQ.RZERO) GO TO 630 + IF (A(APOS).LT.RZERO) NNEG = NNEG+1 + IF (KEEP(258) .NE. 0) THEN + CALL DMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + GO TO 420 + ENDIF + AMAX = RZERO + JMAX = 0 + IF ( IS_MAXFROMM_AVAIL ) THEN + IF ( MAXFROMM > PIVNUL .AND. abs(PIVOT) > TOL) THEN + IF ( abs(PIVOT) .GT. max(UULOC*MAXFROMM,SEUIL) ) THEN + IF (PIVOT .LT. RZERO) NNEG = NNEG+1 + IF (KEEP(258) .NE. 0) THEN + CALL DMUMPS_762(PIVOT, DKEEP(6), KEEP(259)) + ENDIF + GOTO 415 + ENDIF + ENDIF + IS_MAXFROMM_AVAIL = .FALSE. + ENDIF + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(abs(A(JJ)) .GT. AMAX) THEN + AMAX = abs(A(JJ)) + JMAX = IPIV - int(POSPV1-JJ) + ENDIF + ENDDO + J1 = POSPV1 + LDA8 + DO J=1, NASSW - IPIV + IF(abs(A(J1)) .GT. AMAX) THEN + AMAX = abs(A(J1)) + JMAX = IPIV + J + ENDIF + J1 = J1 + LDA8 + ENDDO + RMAX = RZERO + J1_ini = J1 + IF ( (NFRONT - KEEP(253) - NASSW).GE.300 ) THEN + OMP_FLAG = .TRUE. + ELSE + OMP_FLAG = .FALSE. + ENDIF + DO J=1, NFRONT - KEEP(253) - NASSW + J1 = J1_ini + int(J-1,8) * LDA8 + RMAX = max(abs(A(J1)),RMAX) + ENDDO + IF (max(AMAX,RMAX,abs(PIVOT)).LE.PIVNUL) THEN + KEEP(109) = KEEP(109)+1 + PIVNUL_LIST(KEEP(109)) = -1 + IF(dble(FIXA).GT.RZERO) THEN + IF(dble(PIVOT) .GE. RZERO) THEN + A(POSPV1) = FIXA + ELSE + A(POSPV1) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + A(JJ) = ZERO + ENDDO + J1 = POSPV1 + LDA8 + DO J=1, NASSW - IPIV + A(J1) = ZERO + J1 = J1 + LDA8 + ENDDO + DO J=1,NFRONT - NASSW + A(J1) = ZERO + J1 = J1 + LDA8 + ENDDO + A(POSPV1) = ONE + ENDIF + PIVOT = A(POSPV1) + GO TO 415 + ENDIF + IF ((KEEP(19).EQ.0).AND.(KEEP(110).EQ.0)) THEN + IF (max(AMAX,RMAX,abs(PIVOT)).LE.TOL) THEN + IF(SEUIL .GT. epsilon(SEUIL)) THEN + IF(dble(PIVOT) .GE. RZERO) THEN + A(POSPV1) = CSEUIL + ELSE + A(POSPV1) = -CSEUIL + NNEG = NNEG+1 + ENDIF + PIVOT = A(POSPV1) + KEEP(98) = KEEP(98)+1 + GO TO 415 + ENDIF + ENDIF + ENDIF + IF (max(AMAX,abs(PIVOT)).LE.TOL) GO TO 460 + IF (abs(PIVOT).GT.max(UULOC*max(RMAX,AMAX),SEUIL)) THEN + IF (PIVOT .LT. ZERO) NNEG = NNEG+1 + IF (KEEP(258) .NE.0 ) THEN + CALL DMUMPS_762(PIVOT, DKEEP(6), KEEP(259)) + ENDIF + GO TO 415 + END IF + IF (AMAX.LE.TOL) GO TO 460 + IF (RMAX.LT.AMAX) THEN + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(int(POSPV1-JJ) .NE. IPIV-JMAX) THEN + RMAX = max(RMAX,abs(A(JJ))) + ENDIF + ENDDO + J1 = POSPV1 + LDA8 + DO J=1,NASS-IPIV + IF(IPIV+J .NE. JMAX) THEN + RMAX = max(abs(A(J1)),RMAX) + ENDIF + J1 = J1 + LDA8 + ENDDO + ENDIF + APOSJ = POSELT + int(JMAX-1,8)*LDA8 + int(NPIV,8) + POSPV2 = APOSJ + int(JMAX - NPIVP1,8) + IF (IPIV.LT.JMAX) THEN + OFFDAG = APOSJ + int(IPIV - NPIVP1,8) + ELSE + OFFDAG = APOS + int(JMAX - NPIVP1,8) + END IF + TMAX = RZERO + IF(JMAX .LT. IPIV) THEN + JJ_ini = POSPV2 + OMP_FLAG = (NFRONT-JMAX-KEEP(253). GE. 300) + DO K = 1, NFRONT - JMAX - KEEP(253) + JJ = JJ_ini+ int(K,8)*NFRONT8 + IF (JMAX+K.NE.IPIV) THEN + TMAX=max(TMAX,abs(A(JJ))) + ENDIF + ENDDO + DO KK = APOSJ, POSPV2-1_8 + TMAX = max(TMAX,abs(A(KK))) + ENDDO + ELSE + JJ_ini = POSPV2 + OMP_FLAG = (NFRONT-JMAX-KEEP(253). GE. 300) + DO K = 1, NFRONT-JMAX-KEEP(253) + JJ = JJ_ini + int(K,8)*NFRONT8 + TMAX=max(TMAX,abs(A(JJ))) + ENDDO + DO KK = APOSJ, POSPV2 - 1_8 + IF (KK.NE.OFFDAG) THEN + TMAX = max(TMAX,abs(A(KK))) + ENDIF + ENDDO + ENDIF + DETPIV = A(POSPV1)*A(POSPV2) - A(OFFDAG)**2 + IF (SEUIL.GT.RZERO) THEN + IF (sqrt(abs(DETPIV)) .LE. SEUIL ) GOTO 460 + ENDIF + MAXPIV = max(abs(A(POSPV1)),abs(A(POSPV2))) + IF (MAXPIV.EQ.RZERO) MAXPIV = RONE + IF (abs(DETPIV)/MAXPIV.LE.TOL) GO TO 460 + IF ((abs(A(POSPV2))*RMAX+AMAX*TMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF ((abs(A(POSPV1))*TMAX+AMAX*RMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF (KEEP(258) .NE.0 ) THEN + CALL DMUMPS_762(DETPIV, DKEEP(6), KEEP(259)) + ENDIF + PIVSIZ = 2 + KEEP(103) = KEEP(103)+1 + IF(DETPIV .LT. RZERO) THEN + NNEG = NNEG+1 + ELSE IF(A(POSPV2) .LT. RZERO) THEN + NNEG = NNEG+2 + ENDIF + 415 CONTINUE + DO K=1,PIVSIZ + IF (PIVSIZ .EQ. 2) THEN + IF (K==1) THEN + LPIV = min(IPIV,JMAX) + ELSE + LPIV = max(IPIV,JMAX) + ENDIF + ELSE + LPIV = IPIV + ENDIF + IF (LPIV.EQ.NPIVP1) THEN + GOTO 416 + ENDIF + CALL DMUMPS_319( A, LA, IW, LIW, + & IOLDPS, NPIVP1, LPIV, POSELT, NASS, + & LDA, NFRONT, 1, KEEP(219), KEEP(50), + & KEEP(IXSZ)) + 416 CONTINUE + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL DMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, LPIV, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + NPIVP1 = NPIVP1 + 1 + ENDDO + IF(PIVSIZ .EQ. 2) THEN + A(POSELT+(LDA8+1_8)*int(NPIV,8)+1_8) = DETPIV + ENDIF + GOTO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 420 + 630 CONTINUE + PIVSIZ = 0 + IFLAG = -10 + 420 CONTINUE + IS_MAXFROMM_AVAIL = .FALSE. + RETURN + END SUBROUTINE DMUMPS_222 + SUBROUTINE DMUMPS_680( PIVRPTR, NBPANELS, PIVR, NASS, + & K, P, LastPanelonDisk, + & LastPIVRPTRIndexFilled) + IMPLICIT NONE + INTEGER, intent(in) :: NBPANELS, NASS, K, P + INTEGER, intent(inout) :: PIVRPTR(NBPANELS), PIVR(NASS) + INTEGER LastPanelonDisk, LastPIVRPTRIndexFilled + INTEGER I + IF ( LastPanelonDisk+1 > NBPANELS ) THEN + WRITE(*,*) "INTERNAL ERROR IN DMUMPS_680!" + WRITE(*,*) "NASS=",NASS,"PIVRPTR=",PIVRPTR(1:NBPANELS) + WRITE(*,*) "K=",K, "P=",P, "LastPanelonDisk=",LastPanelonDisk + WRITE(*,*) "LastPIVRPTRIndexFilled=", LastPIVRPTRIndexFilled + CALL MUMPS_ABORT() + ENDIF + PIVRPTR(LastPanelonDisk+1) = K + 1 + IF (LastPanelonDisk.NE.0) THEN + PIVR(K - PIVRPTR(1) + 1) = P + DO I = LastPIVRPTRIndexFilled + 1, LastPanelonDisk + PIVRPTR(I)=PIVRPTR(LastPIVRPTRIndexFilled) + ENDDO + ENDIF + LastPIVRPTRIndexFilled = LastPanelonDisk + 1 + RETURN + END SUBROUTINE DMUMPS_680 + SUBROUTINE DMUMPS_226(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW, + & A,LA,LDA, POSTPONE_COL_UPDATE, + & IOLDPS,POSELT,IFINB,LKJIB,PIVSIZ,XSIZE, + & MAXFROMM, IS_MAXFROMM_AVAIL, IS_MAX_USEFUL, + & KEEP253) + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFINB,LKJIB, + & NPBEG, IBEG_BLOCK + INTEGER LDA + INTEGER(8) :: LA + INTEGER(8) :: NFRONT8 + DOUBLE PRECISION A(LA) + LOGICAL POSTPONE_COL_UPDATE + INTEGER IW(LIW) + DOUBLE PRECISION VALPIV + INTEGER(8) :: POSELT + DOUBLE PRECISION, intent(out) :: MAXFROMM + LOGICAL, intent(out) :: IS_MAXFROMM_AVAIL + LOGICAL, intent(in) :: IS_MAX_USEFUL + INTEGER, INTENT(in) :: KEEP253 + DOUBLE PRECISION :: MAXFROMMTMP + INTEGER IOLDPS, NCB1 + INTEGER(8) :: LDA8 + INTEGER(8) :: K1POS + INTEGER NPIV,JROW2 + INTEGER NEL2,NEL + INTEGER XSIZE + DOUBLE PRECISION ONE, ZERO + INTEGER(8) :: APOS, LPOS, LPOS1, LPOS2 + INTEGER(8) :: POSPV1, POSPV2 + INTEGER PIVSIZ,NPIV_NEW,J2,I + INTEGER(8) :: OFFDAG, OFFDAG_OLD, IBEG, IEND + INTEGER(8) :: JJ, K1, K2, IROW + DOUBLE PRECISION SWOP,DETPIV,MULT1,MULT2 + INCLUDE 'mumps_headers.h' + PARAMETER(ONE = 1.0D0, + & ZERO = 0.0D0) + LDA8 = int(LDA,8) + NFRONT8= int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIV_NEW = NPIV + PIVSIZ + NEL = NFRONT - NPIV_NEW + IFINB = 0 + IS_MAXFROMM_AVAIL = .FALSE. + JROW2 = IW(IOLDPS+3+XSIZE) + NPBEG = IBEG_BLOCK + NEL2 = JROW2 - NPIV_NEW + IF (NEL2.EQ.0) THEN + IF (JROW2.EQ.NASS) THEN + IFINB = -1 + ELSE + IFINB = 1 + ENDIF + ENDIF + IF(PIVSIZ .EQ. 1) THEN + APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + VALPIV = ONE/A(APOS) + A(APOS) = VALPIV + LPOS = APOS + LDA8 + MAXFROMM = 0.0D00 + IF (NEL2 > 0) THEN + IF (.NOT. IS_MAX_USEFUL) THEN + DO I=1, NEL2 + K1POS = LPOS + int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + DO JJ=1_8, int(I,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + ELSE + IS_MAXFROMM_AVAIL = .TRUE. + DO I=1, NEL2 + K1POS = LPOS + int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + A(K1POS+1_8)=A(K1POS+1_8) - A(K1POS) * A(APOS+1_8) + MAXFROMM=max( MAXFROMM,abs(A(K1POS+1_8)) ) + DO JJ = 2_8, int(I,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + ENDIF + ENDIF + IF (POSTPONE_COL_UPDATE) THEN + NCB1 = NASS - JROW2 + ELSE + NCB1 = NFRONT - JROW2 + ENDIF + IF (.NOT. IS_MAX_USEFUL) THEN + DO I=NEL2+1, NEL2 + NCB1 + K1POS = LPOS+ int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + DO JJ = 1_8, int(NEL2,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + ELSE + MAXFROMMTMP=0.0D0 + DO I=NEL2+1, NEL2 + NCB1 - KEEP253 + K1POS = LPOS+ int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + IF (NEL2 > 0) THEN + A(K1POS+1_8) = A(K1POS+1_8) - A(K1POS) * A(APOS+1_8) + MAXFROMMTMP=max(MAXFROMMTMP, abs(A(K1POS+1_8))) + DO JJ = 2_8, int(NEL2,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDIF + ENDDO + DO I = NEL2 + NCB1 - KEEP253 + 1, NEL2 + NCB1 + K1POS = LPOS+ int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + DO JJ = 1_8, int(NEL2,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + MAXFROMM=max(MAXFROMM, MAXFROMMTMP) + ENDIF + ELSE + POSPV1 = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + POSPV2 = POSPV1 + NFRONT8 + 1_8 + OFFDAG_OLD = POSPV2 - 1_8 + OFFDAG = POSPV1 + 1_8 + SWOP = A(POSPV2) + DETPIV = A(OFFDAG) + A(POSPV2) = A(POSPV1)/DETPIV + A(POSPV1) = SWOP/DETPIV + A(OFFDAG) = -A(OFFDAG_OLD)/DETPIV + A(OFFDAG_OLD) = ZERO + LPOS1 = POSPV2 + LDA8 - 1_8 + LPOS2 = LPOS1 + 1_8 + CALL dcopy(NFRONT-NPIV_NEW, A(LPOS1), LDA, A(POSPV1+2_8), 1) + CALL dcopy(NFRONT-NPIV_NEW, A(LPOS2), LDA, A(POSPV2+1_8), 1) + JJ = POSPV2 + NFRONT8-1_8 + IBEG = JJ + 2_8 + IEND = IBEG + DO J2 = 1,NEL2 + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(OFFDAG)*A(K2)) + MULT2 = - (A(OFFDAG)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1 + 2_8 + K2 = POSPV2 + 1_8 + DO IROW = IBEG, IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A( JJ ) = -MULT1 + A( JJ + 1_8 ) = -MULT2 + IBEG = IBEG + NFRONT8 + IEND = IEND + NFRONT8 + 1_8 + JJ = JJ+NFRONT8 + ENDDO + IEND = IEND-1_8 + DO J2 = JROW2+1,NFRONT + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(OFFDAG)*A(K2)) + MULT2 = - (A(OFFDAG)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1 + 2_8 + K2 = POSPV2 + 1_8 + DO IROW = IBEG, IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A( JJ ) = -MULT1 + A( JJ + 1_8 ) = -MULT2 + IBEG = IBEG + NFRONT8 + IEND = IEND + NFRONT8 + JJ = JJ + NFRONT8 + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_226 + SUBROUTINE DMUMPS_230(NFRONT,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT) + IMPLICIT NONE + INTEGER NFRONT,N,INODE,LIW + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER IW(LIW) + DOUBLE PRECISION VALPIV + INTEGER (8) :: APOS, POSELT, LPOS, NFRONT8 + INTEGER IOLDPS,NEL + INTEGER JROW + DOUBLE PRECISION, PARAMETER :: ONE = 1.0D0 + APOS = POSELT + VALPIV = ONE/A(APOS) + A(APOS) = VALPIV + NEL = NFRONT - 1 + IF (NEL.EQ.0) GO TO 500 + NFRONT8 = int(NFRONT,8) + LPOS = APOS + NFRONT8 + CALL DMUMPS_XSYR('U',NEL, -VALPIV, + & A(LPOS), NFRONT, A(LPOS+1_8), NFRONT) + DO JROW = 1,NEL + A(LPOS) = VALPIV*A(LPOS) + LPOS = LPOS + NFRONT8 + END DO + 500 CONTINUE + RETURN + END SUBROUTINE DMUMPS_230 + SUBROUTINE DMUMPS_234(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, + & IOLDPS,POSELT,LKJIB_ORIG,LKJIB,LKJIT, + & POSTPONE_COL_UPDATE, + & KEEP,KEEP8 ) + IMPLICIT NONE + INTEGER NFRONT, NASS,N,LIW, IBEG_BLOCK + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER IW(LIW) + INTEGER LKJIB_ORIG, LKJIB, INODE, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: POSELT + INTEGER LDA + INTEGER(8) :: LDA8 + INTEGER IOLDPS, NPIV, JROW2, NPBEG + INTEGER NONEL, LKJIW, NEL1, NEL11 + INTEGER LBP, HF + INTEGER(8) :: LPOS,UPOS,APOS + INTEGER LKJIT + INTEGER LKJIBOLD, IROW + INTEGER I, Block + INTEGER BLSIZE + LOGICAL POSTPONE_COL_UPDATE + DOUBLE PRECISION ONE, ALPHA + INCLUDE 'mumps_headers.h' + PARAMETER (ONE=1.0D0, ALPHA=-1.0D0) + LDA8 = int(LDA,8) + LKJIBOLD = LKJIB + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + JROW2 = iabs(IW(IOLDPS+3+KEEP(IXSZ))) + NPBEG = IBEG_BLOCK + HF = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + NEL1 = NASS - JROW2 + LKJIW = NPIV - NPBEG + 1 + NEL11 = NFRONT - NPIV + IF ( LKJIW .NE. LKJIB ) THEN + NONEL = JROW2 - NPIV + 1 + IF ((NASS-NPIV).GE.LKJIT) THEN + LKJIB = LKJIB_ORIG + NONEL + IW(IOLDPS+3+KEEP(IXSZ))= min0(NPIV+LKJIB,NASS) + LKJIB = min0(LKJIB, NASS - NPIV) + ELSE + LKJIB = NASS - NPIV + IW(IOLDPS+3+KEEP(IXSZ)) = NASS + ENDIF + IBEG_BLOCK = NPIV + 1 + ELSEIF (JROW2.LT.NASS) THEN + IBEG_BLOCK = NPIV + 1 + IW(IOLDPS+3+KEEP(IXSZ)) = min0(JROW2+LKJIB,NASS) + LKJIB = min0(LKJIB,NASS-NPIV) + ENDIF + IF (LKJIW.EQ.0) GO TO 500 + IF (NEL1.NE.0) THEN + IF ( NASS - JROW2 > KEEP(7) ) THEN + BLSIZE = KEEP(8) + ELSE + BLSIZE = NASS - JROW2 + END IF + IF ( NASS - JROW2 .GT. 0 ) THEN +#if defined(SAK_BYROW) + DO IROW = JROW2+1, NASS, BLSIZE + Block = min( BLSIZE, NASS - IROW + 1 ) + LPOS = POSELT + int(IROW - 1,8) * LDA8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG - 1,8) * LDA8 + int(IROW - 1,8) + APOS = POSELT + int(IROW - 1,8) * LDA8 + int(JROW2,8) + CALL dgemm( 'N','N', IROW + Block - JROW2 - 1, Block, LKJIW, + & ALPHA, A( UPOS ), LDA, + & A( LPOS ), LDA, ONE, A( APOS ), LDA ) + ENDDO +#else + DO IROW = JROW2+1, NASS, BLSIZE + Block = min( BLSIZE, NASS - IROW + 1 ) + LPOS = POSELT + int( IROW - 1,8) * LDA8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG - 1,8) * LDA8 + int( IROW - 1,8) + APOS = POSELT + int( IROW - 1,8) * LDA8 + int( IROW - 1,8) + CALL dgemm( 'N','N', Block, NASS - IROW + 1, LKJIW, + & ALPHA, A( UPOS ), LDA, + & A( LPOS ), LDA, ONE, A( APOS ), LDA ) + END DO +#endif + END IF + LPOS = POSELT + int(NASS,8)*LDA8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG-1,8) * LDA8 + int(JROW2,8) + APOS = POSELT + int(NASS,8)*LDA8 + int(JROW2,8) + IF ( .NOT. POSTPONE_COL_UPDATE ) THEN + CALL dgemm('N', 'N', NEL1, NFRONT-NASS, LKJIW, ALPHA, + & A(UPOS), LDA, A(LPOS), LDA, ONE, + & A(APOS), LDA) + END IF + ENDIF + 500 CONTINUE + RETURN + END SUBROUTINE DMUMPS_234 + SUBROUTINE DMUMPS_319( A, LA, IW, LIW, + & IOLDPS, NPIVP1, IPIV, POSELT, NASS, + & LDA, NFRONT, LEVEL, K219, K50, XSIZE ) + IMPLICIT NONE + INTEGER(8) :: POSELT, LA + INTEGER LIW, IOLDPS, NPIVP1, IPIV + INTEGER LDA, NFRONT, NASS, LEVEL, K219, K50, XSIZE + DOUBLE PRECISION A( LA ) + INTEGER IW( LIW ) + INCLUDE 'mumps_headers.h' + INTEGER ISW, ISWPS1, ISWPS2, HF + INTEGER(8) :: IDIAG, APOS + INTEGER(8) :: LDA8 + DOUBLE PRECISION SWOP + LDA8 = int(LDA,8) + APOS = POSELT + LDA8*int(IPIV-1,8) + int(NPIVP1-1,8) + IDIAG = APOS + int(IPIV - NPIVP1,8) + HF = 6 + IW( IOLDPS + 5 + XSIZE) + XSIZE + ISWPS1 = IOLDPS + HF + NPIVP1 - 1 + ISWPS2 = IOLDPS + HF + IPIV - 1 + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + ISW = IW(ISWPS1+NFRONT) + IW(ISWPS1+NFRONT) = IW(ISWPS2+NFRONT) + IW(ISWPS2+NFRONT) = ISW + IF ( LEVEL .eq. 2 ) THEN + CALL dswap( NPIVP1 - 1, + & A( POSELT + int(NPIVP1-1,8) ), LDA, + & A( POSELT + int(IPIV-1,8) ), LDA ) + END IF + CALL dswap( NPIVP1-1, + & A( POSELT+int(NPIVP1-1,8) * LDA8 ), 1, + & A( POSELT + int(IPIV-1,8) * LDA8 ), 1 ) + CALL dswap( IPIV - NPIVP1 - 1, + & A( POSELT+int(NPIVP1,8) * LDA8 + int(NPIVP1-1,8) ), + & LDA, A( APOS + 1_8 ), 1 ) + SWOP = A(IDIAG) + A(IDIAG) = A( POSELT+int(NPIVP1-1,8)*LDA8+int(NPIVP1-1,8) ) + A( POSELT + int(NPIVP1-1,8)*LDA8 + int(NPIVP1-1,8) ) = SWOP + CALL dswap( NASS - IPIV, A( APOS + LDA8 ), LDA, + & A( IDIAG + LDA8 ), LDA ) + IF ( LEVEL .eq. 1 ) THEN + CALL dswap( NFRONT - NASS, + & A( APOS + int(NASS-IPIV+1,8) * LDA8 ), LDA, + & A( IDIAG + int(NASS-IPIV+1,8) * LDA8 ), LDA ) + END IF + IF (K219.NE.0 .AND.K50.EQ.2) THEN + IF ( LEVEL .eq. 2) THEN + APOS = POSELT+LDA8*LDA8-1_8 + SWOP = A(APOS+int(NPIVP1,8)) + A(APOS+int(NPIVP1,8))= A(APOS+int(IPIV,8)) + A(APOS+int(IPIV,8)) = SWOP + ENDIF + ENDIF + RETURN + END SUBROUTINE DMUMPS_319 + SUBROUTINE DMUMPS_237(NFRONT,NASS,N,INODE, + & IW,LIW,A,LA, + & LDA, + & IOLDPS,POSELT,KEEP,KEEP8, + & POSTPONE_COL_UPDATE, ETATASS, + & TYPEFile, LAFAC, MonBloc, NextPiv2beWritten, + & LIWFAC, MYID, IFLAG + & ) + USE DMUMPS_OOC + IMPLICIT NONE + INTEGER NFRONT, NASS,N,INODE,LIW + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER IW(LIW) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: POSELT + INTEGER LDA + INTEGER IOLDPS, ETATASS + LOGICAL POSTPONE_COL_UPDATE + INTEGER(8) :: LAFAC + INTEGER TYPEFile, NextPiv2beWritten + INTEGER LIWFAC, MYID, IFLAG + TYPE(IO_BLOCK):: MonBloc + INTEGER IDUMMY + LOGICAL LAST_CALL + INCLUDE 'mumps_headers.h' + INTEGER(8) :: UPOS, APOS, LPOS + INTEGER(8) :: LDA8 + INTEGER BLSIZE, BLSIZE2, Block, IROW, NPIV, I, IROWEND + INTEGER I2, I2END, Block2 + DOUBLE PRECISION ONE, ALPHA, BETA, ZERO + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + PARAMETER (ZERO=0.0D0) + LDA8 = int(LDA,8) + IF (ETATASS.EQ.1) THEN + BETA = ZERO + ELSE + BETA = ONE + ENDIF + IF ( NFRONT - NASS > KEEP(57) ) THEN + BLSIZE = KEEP(58) + ELSE + BLSIZE = NFRONT - NASS + END IF + BLSIZE2 = KEEP(218) + NPIV = IW( IOLDPS + 1 + KEEP(IXSZ)) + IF ( NFRONT - NASS .GT. 0 ) THEN + IF ( POSTPONE_COL_UPDATE ) THEN + CALL dtrsm( 'L', 'U', 'T', 'U', + & NPIV, NFRONT-NPIV, ONE, + & A( POSELT ), LDA, + & A( POSELT + LDA8 * int(NPIV,8) ), LDA ) + ENDIF + DO IROWEND = NFRONT - NASS, 1, -BLSIZE + Block = min( BLSIZE, IROWEND ) + IROW = IROWEND - Block + 1 + LPOS = POSELT + int(NASS,8)*LDA8 + int(IROW-1,8) * LDA8 + APOS = POSELT + int(NASS,8)*LDA8 + int(IROW-1,8) * LDA8 + + & int(NASS + IROW - 1,8) + UPOS = POSELT + int(NASS,8) + IF (.NOT. POSTPONE_COL_UPDATE) THEN + UPOS = POSELT + int(NASS + IROW - 1,8) + ENDIF + IF (POSTPONE_COL_UPDATE) THEN + DO I = 1, NPIV + CALL dcopy( Block, A( LPOS+int(I-1,8) ), LDA, + & A( UPOS+int(I-1,8)*LDA8 ), 1 ) + CALL dscal( Block, A(POSELT+(LDA8+1_8)*int(I-1,8)), + & A( LPOS + int(I - 1,8) ), LDA ) + ENDDO + ENDIF + DO I2END = Block, 1, -BLSIZE2 + Block2 = min(BLSIZE2, I2END) + I2 = I2END - Block2+1 + CALL dgemm('N', 'N', Block2, Block-I2+1, NPIV, ALPHA, + & A(UPOS+int(I2-1,8)), LDA, + & A(LPOS+int(I2-1,8)*LDA8), LDA, + & BETA, + & A(APOS + int(I2-1,8) + int(I2-1,8)*LDA8), LDA) + IF (KEEP(201).EQ.1) THEN + IF (NextPiv2beWritten.LE.NPIV) THEN + LAST_CALL=.FALSE. + CALL DMUMPS_688( + & STRAT_TRY_WRITE, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, MYID, + & KEEP8(31), + & IFLAG,LAST_CALL ) + IF (IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + ENDDO + IF ( NFRONT - NASS - IROW + 1 - Block > 0 ) THEN + CALL dgemm( 'N', 'N', Block, NFRONT-NASS-Block-IROW+1, NPIV, + & ALPHA, A( UPOS ), LDA, + & A( LPOS + LDA8 * int(Block,8) ), LDA, + & BETA, + & A( APOS + LDA8 * int(Block,8) ), LDA ) + ENDIF + END DO + END IF + RETURN + END SUBROUTINE DMUMPS_237 + SUBROUTINE DMUMPS_320( BUF, BLOCK_SIZE, + & MYROW, MYCOL, NPROW, NPCOL, + & A, LOCAL_M, LOCAL_N, N, MYID, COMM ) + IMPLICIT NONE + INTEGER BLOCK_SIZE, NPROW, NPCOL, LOCAL_M, LOCAL_N, N, COMM + INTEGER MYROW, MYCOL, MYID + DOUBLE PRECISION BUF( BLOCK_SIZE * BLOCK_SIZE ) + DOUBLE PRECISION A( LOCAL_M, LOCAL_N ) + INTEGER NBLOCK, IBLOCK, JBLOCK, IBLOCK_SIZE, JBLOCK_SIZE + INTEGER ROW_SOURCE, ROW_DEST, COL_SOURCE, COL_DEST + INTEGER IGLOB, JGLOB + INTEGER IROW_LOC_SOURCE, JCOL_LOC_SOURCE + INTEGER IROW_LOC_DEST, JCOL_LOC_DEST + INTEGER PROC_SOURCE, PROC_DEST + NBLOCK = ( N - 1 ) / BLOCK_SIZE + 1 + DO IBLOCK = 1, NBLOCK + IF ( IBLOCK .NE. NBLOCK + & ) THEN + IBLOCK_SIZE = BLOCK_SIZE + ELSE + IBLOCK_SIZE = N - ( NBLOCK - 1 ) * BLOCK_SIZE + END IF + ROW_SOURCE = mod( IBLOCK - 1, NPROW ) + COL_DEST = mod( IBLOCK - 1, NPCOL ) + IGLOB = ( IBLOCK - 1 ) * BLOCK_SIZE + 1 + IROW_LOC_SOURCE = BLOCK_SIZE * + & ( ( IGLOB - 1 ) / (BLOCK_SIZE*NPROW) ) + & + mod( IGLOB - 1, BLOCK_SIZE ) + 1 + JCOL_LOC_DEST = BLOCK_SIZE * + & ( ( IGLOB - 1 ) / (BLOCK_SIZE*NPCOL) ) + & + mod( IGLOB - 1, BLOCK_SIZE ) + 1 + DO JBLOCK = 1, IBLOCK + IF ( JBLOCK .NE. NBLOCK + & ) THEN + JBLOCK_SIZE = BLOCK_SIZE + ELSE + JBLOCK_SIZE = N - ( NBLOCK - 1 ) * BLOCK_SIZE + END IF + COL_SOURCE = mod( JBLOCK - 1, NPCOL ) + ROW_DEST = mod( JBLOCK - 1, NPROW ) + PROC_SOURCE = ROW_SOURCE * NPCOL + COL_SOURCE + PROC_DEST = ROW_DEST * NPCOL + COL_DEST + IF ( PROC_SOURCE .eq. PROC_DEST ) THEN + IF ( MYID .eq. PROC_DEST ) THEN + JGLOB = ( JBLOCK - 1 ) * BLOCK_SIZE + 1 + JCOL_LOC_SOURCE = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPCOL) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + IROW_LOC_DEST = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPROW) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + IF ( IBLOCK .eq. JBLOCK ) THEN + IF ( IBLOCK_SIZE .ne. JBLOCK_SIZE ) THEN + WRITE(*,*) MYID,': Error in calling transdiag:unsym' + CALL MUMPS_ABORT() + END IF + CALL DMUMPS_327( A( IROW_LOC_SOURCE, + & JCOL_LOC_SOURCE), + & IBLOCK_SIZE, LOCAL_M ) + ELSE + CALL DMUMPS_326( + & A( IROW_LOC_SOURCE, JCOL_LOC_SOURCE ), + & A( IROW_LOC_DEST, JCOL_LOC_DEST ), + & IBLOCK_SIZE, JBLOCK_SIZE, LOCAL_M ) + END IF + END IF + ELSE IF ( MYROW .eq. ROW_SOURCE + & .AND. MYCOL .eq. COL_SOURCE ) THEN + JGLOB = ( JBLOCK - 1 ) * BLOCK_SIZE + 1 + JCOL_LOC_SOURCE = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPCOL) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + CALL DMUMPS_293( BUF, + & A( IROW_LOC_SOURCE, JCOL_LOC_SOURCE ), LOCAL_M, + & IBLOCK_SIZE, JBLOCK_SIZE, COMM, PROC_DEST ) + ELSE IF ( MYROW .eq. ROW_DEST + & .AND. MYCOL .eq. COL_DEST ) THEN + JGLOB = ( JBLOCK - 1 ) * BLOCK_SIZE + 1 + IROW_LOC_DEST = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPROW) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + CALL DMUMPS_281( BUF, + & A( IROW_LOC_DEST, JCOL_LOC_DEST ), LOCAL_M, + & JBLOCK_SIZE, IBLOCK_SIZE, COMM, PROC_SOURCE ) + END IF + END DO + END DO + RETURN + END SUBROUTINE DMUMPS_320 + SUBROUTINE DMUMPS_293( BUF, A, LDA, M, N, COMM, DEST ) + IMPLICIT NONE + INTEGER M, N, LDA, DEST, COMM + DOUBLE PRECISION BUF(*), A(LDA,*) + INTEGER I, IBUF, IERR + INTEGER J + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + IBUF = 1 + DO J = 1, N + BUF( IBUF: IBUF + M - 1 ) = A( 1 : M, J ) + DO I = 1, M + END DO + IBUF = IBUF + M + END DO + CALL MPI_SEND( BUF, M * N, MPI_DOUBLE_PRECISION, + & DEST, SYMMETRIZE, COMM, IERR ) + RETURN + END SUBROUTINE DMUMPS_293 + SUBROUTINE DMUMPS_281( BUF, A, LDA, M, N, COMM, SOURCE ) + IMPLICIT NONE + INTEGER LDA, M, N, COMM, SOURCE + DOUBLE PRECISION BUF(*), A( LDA, *) + INTEGER I, IBUF, IERR + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + CALL MPI_RECV( BUF(1), M * N, MPI_DOUBLE_PRECISION, SOURCE, + & SYMMETRIZE, COMM, STATUS, IERR ) + IBUF = 1 + DO I = 1, M + CALL dcopy( N, BUF(IBUF), 1, A(I,1), LDA ) + IBUF = IBUF + N + END DO + RETURN + END SUBROUTINE DMUMPS_281 + SUBROUTINE DMUMPS_327( A, N, LDA ) + IMPLICIT NONE + INTEGER N,LDA + DOUBLE PRECISION A( LDA, * ) + INTEGER I, J + DO I = 2, N + DO J = 1, I - 1 + A( J, I ) = A( I, J ) + END DO + END DO + RETURN + END SUBROUTINE DMUMPS_327 + SUBROUTINE DMUMPS_326( A1, A2, M, N, LD ) + IMPLICIT NONE + INTEGER M,N,LD + DOUBLE PRECISION A1( LD,* ), A2( LD, * ) + INTEGER I, J + DO J = 1, N + DO I = 1, M + A2( J, I ) = A1( I, J ) + END DO + END DO + RETURN + END SUBROUTINE DMUMPS_326 + RECURSIVE SUBROUTINE DMUMPS_274( + & COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE DMUMPS_COMM_BUFFER + USE DMUMPS_LOAD + USE DMUMPS_OOC + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mumps_headers.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER(8) IPTRLU, LRLU, LRLUS, LA, POSFAC + INTEGER COMP + INTEGER IFLAG, IERROR, NBFIN, MSGSOU + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)) + INTEGER(8) PTRAST(KEEP(28)), PTRFAC(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER NBPROCFILS( KEEP(28) ), STEP(N), + & PIMASTER(KEEP(28)) + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER COMM, MYID + INTEGER PTLUST_S(KEEP(28)), + & ITLOC(N+KEEP(253)), FILS(N), ND(KEEP(28)) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER FRERE_STEPS(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION FLOP1 + DOUBLE PRECISION DBLARR( max(1,KEEP(13)) ) + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER PIVI + INTEGER (8) POSPV1,POSPV2,OFFDAG,LPOS1 + INTEGER J2 + DOUBLE PRECISION MULT1,MULT2 + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER LP + INTEGER INODE, POSITION, NPIV, IERR + INTEGER NCOL + INTEGER(8) LAELL, POSBLOCFACTO + INTEGER(8) POSELT + INTEGER IOLDPS, LCONT1, NASS1, NROW1, NCOL1, NPIV1 + INTEGER NSLAV1, HS, ISW, DEST + INTEGER ICT11 + INTEGER(8) LPOS, LPOS2, DPOS, UPOS + INTEGER (8) IPOS, KPOS + INTEGER I, IPIV, FPERE, NSLAVES_TOT, + & NSLAVES_FOLLOW, NB_BLOC_FAC + INTEGER IPOSK, JPOSK, NPIVSENT, Block, IROW, BLSIZE + INTEGER allocok, TO_UPDATE_CPT_END + DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE :: UIP21K + INTEGER, DIMENSION(:), ALLOCATABLE :: LIST_SLAVES_FOLLOW + LOGICAL LASTBL + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + DOUBLE PRECISION ONE,ALPHA + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, NextPivDummy + LOGICAL LAST_CALL + TYPE(IO_BLOCK) :: MonBloc + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + FPERE = -1 + POSITION = 0 + TO_UPDATE_CPT_END = -654321 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, + & MPI_INTEGER, COMM, IERR ) + LASTBL = (NPIV.LE.0) + IF (LASTBL) THEN + NPIV = -NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NSLAVES_TOT, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NB_BLOC_FAC, 1, + & MPI_INTEGER, COMM, IERR ) + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOL, 1, + & MPI_INTEGER, COMM, IERR ) + LAELL = int(NPIV,8) * int(NCOL,8) + IF ( NPIV.GT.0 ) THEN + IF ( LRLU .LT. LAELL .OR. IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LAELL ) THEN + IFLAG = -9 + CALL MUMPS_731(LAELL-LRLUS, IERROR) + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE IN DMUMPS_274, + & REAL WORKSPACE TOO SMALL" + GOTO 700 + END IF + CALL DMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS=' + & ,LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731(LAELL-LRLUS,IERROR) + GOTO 700 + END IF + IF ( IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE IN DMUMPS_274, + & INTEGER WORKSPACE TOO SMALL" + IFLAG = -8 + IERROR = IWPOS + NPIV - 1 - IWPOSCB + GOTO 700 + END IF + END IF + LRLU = LRLU - LAELL + LRLUS = LRLUS - LAELL + ENDIF + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSBLOCFACTO = POSFAC + POSFAC = POSFAC + LAELL + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LAELL,KEEP,KEEP8,LRLU) + IF ( NPIV.GT.0 ) THEN + IPIV = IWPOS + IWPOS = IWPOS + NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IPIV ), NPIV, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSBLOCFACTO), NPIV*NCOL, MPI_DOUBLE_PRECISION, + & COMM, IERR ) + ENDIF + IF (PTRIST(STEP( INODE )) .EQ. 0) THEN + DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 ) + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + ENDIF + DO WHILE ( NBPROCFILS(STEP(INODE)) .NE. 0 ) + BLOCKING = .TRUE. + SET_IRECV=.FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, CONTRIB_TYPE2, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .TRUE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + LCONT1 = IW( IOLDPS + KEEP(IXSZ)) + NASS1 = IW( IOLDPS + 1 + KEEP(IXSZ)) + NROW1 = IW( IOLDPS + 2 + KEEP(IXSZ)) + NPIV1 = IW( IOLDPS + 3 + KEEP(IXSZ)) + NSLAV1 = IW( IOLDPS + 5 + KEEP(IXSZ)) + NSLAVES_FOLLOW = NSLAV1 - XTRA_SLAVES_SYM + HS = 6 + NSLAV1 + KEEP(IXSZ) + NCOL1 = LCONT1 + NPIV1 + IF ( LASTBL ) THEN + TO_UPDATE_CPT_END = ( NSLAVES_TOT - NSLAVES_FOLLOW - 1 ) * + & NB_BLOC_FAC + END IF + IF (NPIV.GT.0) THEN + IF ( NPIV1 + NCOL .NE. NASS1 ) THEN + WRITE(*,*) 'SymBLFC Error: NPIV1 + NCOL .NE. NASS1 :', + & NPIV1,NCOL,NASS1 + CALL MUMPS_ABORT() + END IF + ICT11 = IOLDPS+HS+NROW1+NPIV1 - 1 + DO I = 1, NPIV + PIVI = abs(IW(IPIV+I-1)) + IF (PIVI.EQ.I) CYCLE + ISW = IW(ICT11+I) + IW(ICT11+I) = IW(ICT11+PIVI) + IW(ICT11+PIVI) = ISW + IPOS = POSELT + int(NPIV1 + I - 1,8) + KPOS = POSELT + int(NPIV1 + PIVI - 1,8) + CALL dswap(NROW1, A(IPOS), NCOL1, A(KPOS), NCOL1) + ENDDO + ALLOCATE( UIP21K( NPIV * NROW1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": ALLOCATION FAILURE FOR UIP21K IN DMUMPS_274" + IFLAG = -13 + IERROR = NPIV * NROW1 + GOTO 700 + END IF + IF ( NSLAVES_FOLLOW .NE. 0 .and. NPIV .NE. 0 ) THEN + ALLOCATE( LIST_SLAVES_FOLLOW ( NSLAVES_FOLLOW ), + & stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": ALLOCATION FAILURE FOR LIST_SLAVES_FOLLOW + & IN DMUMPS_274" + IFLAG = -13 + IERROR = NSLAVES_FOLLOW + GOTO 700 + END IF + LIST_SLAVES_FOLLOW(1:NSLAVES_FOLLOW)= + & IW(IOLDPS+6+XTRA_SLAVES_SYM+KEEP(IXSZ): + & IOLDPS+5+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_FOLLOW) + END IF + CALL dtrsm( 'L', 'U', 'T', 'U', NPIV, NROW1, ONE, + & A( POSBLOCFACTO ), NCOL, + & A(POSELT+int(NPIV1,8)), NCOL1 ) + LPOS = POSELT + int(NPIV1,8) + UPOS = 1_8 + DO I = 1, NROW1 + UIP21K( UPOS: UPOS + int(NPIV-1,8) ) = + & A(LPOS: LPOS+int(NPIV-1,8)) + LPOS = LPOS + int(NCOL1,8) + UPOS = UPOS + int(NPIV,8) + END DO + LPOS = POSELT + int(NPIV1,8) + DPOS = POSBLOCFACTO + I = 1 + DO + IF(I .GT. NPIV) EXIT + IF(IW(IPIV+I-1) .GT. 0) THEN + CALL dscal( NROW1, A(DPOS), A(LPOS), NCOL1 ) + LPOS = LPOS + 1_8 + DPOS = DPOS + int(NCOL + 1,8) + I = I+1 + ELSE + POSPV1 = DPOS + POSPV2 = DPOS+ int(NCOL + 1,8) + OFFDAG = POSPV1+1_8 + LPOS1 = LPOS + DO J2 = 1,NROW1 + MULT1 = A(POSPV1)*A(LPOS1)+A(OFFDAG)*A(LPOS1+1_8) + MULT2 = A(OFFDAG)*A(LPOS1)+A(POSPV2)*A(LPOS1+1_8) + A(LPOS1) = MULT1 + A(LPOS1+1_8) = MULT2 + LPOS1 = LPOS1 + int(NCOL1,8) + ENDDO + LPOS = LPOS + 2_8 + DPOS = POSPV2 + int(NCOL + 1,8) + I = I+2 + ENDIF + ENDDO + ENDIF + IF (KEEP(201).eq.1) THEN + MonBloc%INODE = INODE + MonBloc%MASTER = .FALSE. + MonBloc%Typenode = 2 + MonBloc%NROW = NROW1 + MonBloc%NCOL = NCOL1 + MonBloc%NFS = NASS1 + MonBloc%LastPiv = NPIV1 + NPIV + NULLIFY(MonBloc%INDICES) + MonBloc%Last = LASTBL + STRAT = STRAT_TRY_WRITE + NextPivDummy = -8888 + LIWFAC = IW(IOLDPS+XXI) + CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR)) + LAST_CALL=.FALSE. + CALL DMUMPS_688( STRAT, TYPEF_L, A(POSELT), + & LAFAC, MonBloc, NextPivDummy, NextPivDummy, + & IW(IOLDPS), LIWFAC, MYID, KEEP8(31), IFLAG,LAST_CALL) + ENDIF + IF (NPIV.GT.0) THEN + LPOS2 = POSELT + int(NPIV1,8) + UPOS = POSBLOCFACTO+int(NPIV,8) + LPOS = LPOS2 + int(NPIV,8) + CALL dgemm('N','N', NCOL-NPIV,NROW1,NPIV,ALPHA,A(UPOS),NCOL, + & A(LPOS2),NCOL1,ONE, A(LPOS),NCOL1) + DPOS = POSELT + int(NCOL1 - NROW1,8) + IF ( NROW1 .GT. KEEP(7) ) THEN + BLSIZE = KEEP(8) + ELSE + BLSIZE = NROW1 + ENDIF + IF ( NROW1 .GT. 0 ) THEN + DO IROW = 1, NROW1, BLSIZE + Block = min( BLSIZE, NROW1 - IROW + 1 ) + DPOS = POSELT + int(NCOL1 - NROW1,8) + & + int( IROW - 1, 8 ) * int( NCOL1 + 1, 8 ) + LPOS2 = POSELT + int(NPIV1,8) + & + int( IROW - 1, 8 ) * int( NCOL1, 8 ) + UPOS = int( IROW - 1, 8 ) * int(NPIV, 8) + 1_8 + DO I = 1, Block + CALL dgemv( 'T', NPIV, Block-I+1, ALPHA, + & A( LPOS2 + int(I - 1,8) * int(NCOL1,8) ), NCOL1, + & UIP21K( UPOS + int(NPIV,8) * int( I - 1, 8 ) ), + & 1, ONE, A(DPOS+int(NCOL1+1,8)*int(I-1,8)),NCOL1 ) + END DO + IF ( NROW1-IROW+1-Block .ne. 0 ) + & CALL dgemm( 'T', 'N', Block, NROW1-IROW+1-Block, NPIV, ALPHA, + & UIP21K( UPOS ), NPIV, + & A( LPOS2 + int(Block,8) * int(NCOL1,8) ), NCOL1, ONE, + & A( DPOS + int(Block,8) * int(NCOL1,8) ), NCOL1 ) + ENDDO + ENDIF + FLOP1 = dble(NROW1) * dble(NPIV) * + & dble( 2 * NCOL - NPIV + NROW1 +1 ) + FLOP1 = -FLOP1 + CALL DMUMPS_190( 1, .FALSE., FLOP1, KEEP,KEEP8 ) + ENDIF + IW(IOLDPS+KEEP(IXSZ)) = IW(IOLDPS+KEEP(IXSZ)) - NPIV + IW(IOLDPS + 3+KEEP(IXSZ)) = IW(IOLDPS+3+KEEP(IXSZ)) + NPIV + IF (LASTBL) IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS + 3+KEEP(IXSZ)) + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + IWPOS = IWPOS - NPIV + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + IF ( NSLAVES_FOLLOW .NE. 0 .and. NPIV .NE. 0 ) THEN + IPOSK = NPIV1 + 1 + JPOSK = NCOL1 - NROW1 + 1 + NPIVSENT = NPIV + IERR = -1 + DO WHILE ( IERR .eq. -1 ) + CALL DMUMPS_64( + & INODE, NPIVSENT, FPERE, + & IPOSK, JPOSK, + & UIP21K, NROW1, + & NSLAVES_FOLLOW, + & LIST_SLAVES_FOLLOW(1), + & COMM, IERR ) + IF (IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END IF + END DO + IF ( IERR .eq. -2 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE, SEND BUFFER TOO SMALL DURING + & DMUMPS_274" + WRITE(LP,*) "NPIV=", NPIV, "NROW1=",NROW1 + IFLAG = -17 + IERROR = 5 * KEEP(34) + NPIV * NROW1 * KEEP(35) + GOTO 700 + END IF + IF ( IERR .eq. -3 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE, RECV BUFFER TOO SMALL DURING + & DMUMPS_274" + IFLAG = -20 + IERROR = 5 * KEEP(34) + NPIV * NROW1 * KEEP(35) + GOTO 700 + END IF + DEALLOCATE(LIST_SLAVES_FOLLOW) + END IF + IF ( NPIV .NE. 0 ) DEALLOCATE( UIP21K ) + IOLDPS = PTRIST(STEP(INODE)) + IF (LASTBL) THEN + IW(IOLDPS+6+KEEP(IXSZ)) = IW(IOLDPS+6+KEEP(IXSZ)) - + & TO_UPDATE_CPT_END + IF ( IW(IOLDPS+6+KEEP(IXSZ) ) .eq. 0 + & .and. KEEP(50) .ne. 0 .and. NSLAVES_FOLLOW .eq. 0 + & .and. NSLAVES_TOT.NE.1)THEN + DEST = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + CALL DMUMPS_62( INODE, DEST, END_NIV2_LDLT, + & COMM, IERR ) + IF ( IERR .LT. 0 ) THEN + write(*,*) ' Internal error in PROCESS_SYM_BLOCFACTO.' + IFLAG = -99 + GOTO 700 + END IF + ENDIF + END IF + IF (LASTBL) THEN + IF (IW(IOLDPS+6+KEEP(IXSZ)) .eq. 0 ) THEN + CALL DMUMPS_759( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ENDIF + ENDIF + 600 CONTINUE + RETURN + 700 CONTINUE + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE DMUMPS_274 + RECURSIVE SUBROUTINE DMUMPS_759( + & COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mumps_headers.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER INODE, FPERE + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER COMM, MYID + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER IWPOS, IWPOSCB + INTEGER LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP, IFLAG, IERROR + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER NBFIN, SLAVEF + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER ND( KEEP(28) ) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER FRERE_STEPS(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION DBLARR( max(1,KEEP(13)) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER ITYPE2 + INTEGER IHDR_REC + PARAMETER (ITYPE2=2) + INTEGER IOLDPS, NROW, LDA + INTEGER NPIV, LCONT, NELIM, NASS, NCOL_TO_SEND, + & SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON + INTEGER(8) :: SHIFT_VAL_SON + INTEGER(8) MEM_GAIN + IF (KEEP(50).EQ.0) THEN + IHDR_REC=6 + ELSE + IHDR_REC=8 + ENDIF + IOLDPS = PTRIST(STEP(INODE)) + IW(IOLDPS+XXS)=S_ALL + IF (KEEP(214).EQ.1) THEN + CALL DMUMPS_314( N, INODE, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE2 + & ) + IOLDPS = PTRIST(STEP(INODE)) + IF (KEEP(38).NE.FPERE) THEN + IW(IOLDPS+XXS)=S_NOLCBNOCONTIG + IF (KEEP(216).NE.3) THEN + MEM_GAIN=int(IW( IOLDPS + 2 + KEEP(IXSZ) ),8)* + & int(IW( IOLDPS + 3 + KEEP(IXSZ) ),8) + LRLUS = LRLUS+MEM_GAIN + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLU) + ENDIF + ENDIF + IF (KEEP(216).EQ.2) THEN + IF (FPERE.NE.KEEP(38)) THEN + CALL DMUMPS_627(A,LA,PTRAST(STEP(INODE)), + & IW( IOLDPS + 2 + KEEP(IXSZ) ), + & IW( IOLDPS + KEEP(IXSZ) ), + & IW( IOLDPS + 3 + KEEP(IXSZ) )+ + & IW( IOLDPS + KEEP(IXSZ) ), 0, + & IW( IOLDPS + XXS ), 0_8 ) + IW(IOLDPS+XXS)=S_NOLCBCONTIG + IW(IOLDPS+XXS)=S_NOLCBCONTIG + ENDIF + ENDIF + ENDIF + IF ( KEEP(38).EQ.FPERE) THEN + LCONT = IW(IOLDPS+KEEP(IXSZ)) + NROW = IW(IOLDPS+2+KEEP(IXSZ)) + NPIV = IW(IOLDPS+3+KEEP(IXSZ)) + NASS = IW(IOLDPS+4+KEEP(IXSZ)) + NELIM = NASS-NPIV + NCOL_TO_SEND = LCONT-NELIM + SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NASS + SHIFT_VAL_SON = int(NASS,8) + LDA = LCONT + NPIV + IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOTBAND_INIT) THEN + IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_REC_CONTSTATIC + ELSE + ENDIF + CALL DMUMPS_80( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTRIST, PTRAST, + & root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA, + & ROOT_CONT_STATIC, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG < 0 ) GOTO 600 + IF (NELIM.EQ.0) THEN + IF (KEEP(214).EQ.2) THEN + CALL DMUMPS_314( N, INODE, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE2 + & ) + ENDIF + CALL DMUMPS_626( N, INODE, PTRIST, PTRAST, IW, LIW, + & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP, + & MYID, KEEP + & ) + ELSE + IOLDPS = PTRIST(STEP(INODE)) + IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOT2SON_CALLED) THEN + CALL DMUMPS_626( N, INODE, PTRIST, PTRAST, IW, LIW, + & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP, + & MYID, KEEP + & ) + ELSE + IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_ROOTBAND_INIT + IF (KEEP(214).EQ.1.AND.KEEP(216).NE.3) THEN + IW(IOLDPS+XXS)=S_NOLCBNOCONTIG38 + CALL DMUMPS_628( IW(IOLDPS), + & LIW-IOLDPS+1, + & MEM_GAIN, KEEP(IXSZ) ) + LRLUS = LRLUS + MEM_GAIN + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLU) + IF (KEEP(216).EQ.2) THEN + CALL DMUMPS_627(A,LA,PTRAST(STEP(INODE)), + & IW( IOLDPS + 2 + KEEP(IXSZ) ), + & IW( IOLDPS + KEEP(IXSZ) ), + & IW( IOLDPS + 3 + KEEP(IXSZ) )+ + & IW( IOLDPS + KEEP(IXSZ) ), + & IW( IOLDPS + 4 + KEEP(IXSZ) ) - + & IW( IOLDPS + 3 + KEEP(IXSZ) ), + & IW( IOLDPS + XXS ),0_8) + IW(IOLDPS+XXS)=S_NOLCBCONTIG38 + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + 600 CONTINUE + RETURN + END SUBROUTINE DMUMPS_759 + SUBROUTINE DMUMPS_141( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP,PIVNUL_LIST,LPN_LIST ) + USE DMUMPS_OOC + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, INODE, FPERE, LIW, NOFFW, NPVW + INTEGER(8) :: LA + DOUBLE PRECISION A( LA ) + DOUBLE PRECISION UU, SEUIL + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER COMM, MYID, LBUFR, LBUFR_BYTES + INTEGER LPTRAR, NELT + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS + INTEGER NBFIN, IFLAG, IERROR, LEAF, LPOOL, SLAVEF, + & IWPOS, IWPOSCB, COMP + INTEGER NB_BLOC_FAC + INTEGER ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER, TARGET :: IW( LIW ) + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER BUFR( LBUFR ), IPOOL(LPOOL), ITLOC(N+KEEP(253)) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW(LPTRAR), PTRAIW(LPTRAR), ND( KEEP(28) ) + INTEGER FRERE(KEEP(28)), FILS(N) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), + & PTLUST_S(KEEP(28)), + & + & PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), NBPROCFILS(KEEP(28)), + & PROCNODE_STEPS(KEEP(28)), STEP(N) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + LOGICAL AVOID_DELAYED + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER(8) :: POSELT + INTEGER INOPV, IFINB, NFRONT, NPIV, IBEGKJI, NBOLKJ, NBTLKJ + INTEGER NASS, IEND, IOLDPS, LDAFS,allocok, IBEG_BLOCK + LOGICAL LASTBL + LOGICAL RESET_TO_ONE, TO_UPDATE + INTEGER K109_ON_ENTRY + INTEGER I,J,JJ,K,IDEB + DOUBLE PRECISION UUTEMP + INCLUDE 'mumps_headers.h' + INTEGER , ALLOCATABLE, DIMENSION ( : ) :: IPIV + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten, + & IDUMMY + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INTEGER PP_FIRST2SWAP_L, IFLAG_OOC + INTEGER PP_LastPIVRPTRFilled + EXTERNAL DMUMPS_223, DMUMPS_235, + & DMUMPS_227, DMUMPS_294, + & DMUMPS_44 + LOGICAL STATICMODE + DOUBLE PRECISION SEUIL_LOC + INTEGER PIVSIZ,IWPOSPIV + DOUBLE PRECISION ONE + PARAMETER (ONE = 1.0D0) + INOPV = 0 + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + SEUIL_LOC=SEUIL + UUTEMP=UU + ENDIF + RESET_TO_ONE = ((KEEP(110).GT.0).AND.(DKEEP(2).LE.0.0D0)) + IF (RESET_TO_ONE) THEN + K109_ON_ENTRY = KEEP(109) + ENDIF + IBEG_BLOCK=1 + NB_BLOC_FAC = 0 + IOLDPS = PTLUST_S(STEP( INODE )) + POSELT = PTRAST( STEP( INODE )) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + LDAFS = NASS + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5), NASS ) + ENDIF + NBTLKJ = NBOLKJ + IW(IOLDPS+3+KEEP(IXSZ)) = min0(NASS,NBTLKJ) + IF (KEEP(201).EQ.1) THEN + IDUMMY = -9876 + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_L + NextPiv2beWritten = 1 + PP_FIRST2SWAP_L = NextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 2 + MonBloc%NROW = NASS + MonBloc%NCOL = NASS + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -66666 + MonBloc%INDICES => + & IW(IOLDPS+6+NFRONT+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ)) + & :IOLDPS+5+2*NFRONT+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))) + ENDIF + ALLOCATE( IPIV( NASS ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) MYID,' : FACTO_NIV2 :failed to allocate ',NASS, + & ' integers' + IFLAG=-13 + IERROR=NASS + GO TO 490 + END IF + 50 CONTINUE + IBEGKJI = IBEG_BLOCK + CALL DMUMPS_223( + & NFRONT,NASS,IBEGKJI, NASS, IPIV, + & N,INODE,IW,LIW,A,LA,NOFFW,INOPV, + & IFLAG,IOLDPS,POSELT,UU, SEUIL_LOC, + & KEEP,KEEP8,PIVSIZ, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled) + IF (IFLAG.LT.0) GOTO 490 + IF(KEEP(109).GT. 0) THEN + IF(PIVNUL_LIST(KEEP(109)).EQ.-1) THEN + IWPOSPIV = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6 + & +IW(IOLDPS+5+KEEP(IXSZ)) + PIVNUL_LIST(KEEP(109)) = IW(IWPOSPIV+KEEP(IXSZ)) + ENDIF + ENDIF + IF(INOPV.EQ. 1 .AND. STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + IF (INOPV.GE.1) THEN + LASTBL = (INOPV.EQ.1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL DMUMPS_294( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, LDAFS, + & IBEGKJI, IEND, IPIV, NASS,LASTBL, NB_BLOC_FAC, + & + & COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (INOPV.EQ.1) GO TO 500 + IF (INOPV.EQ.2) THEN + CALL DMUMPS_235(IBEG_BLOCK, + & NASS,N,INODE,IW,LIW,A,LA, + & LDAFS, + & IOLDPS,POSELT,NBOLKJ, NBTLKJ,KEEP(4),KEEP,KEEP8) + GOTO 50 + ENDIF + NPVW = NPVW + PIVSIZ + IF (NASS.LE.1) THEN + IFINB = -1 + IF (NASS == 1) A(POSELT)=ONE/A(POSELT) + ELSE + CALL DMUMPS_227(IBEG_BLOCK, + & NASS, N,INODE,IW,LIW,A,LA, + & LDAFS, IOLDPS,POSELT,IFINB, + & NBTLKJ,KEEP(4),PIVSIZ,KEEP(IXSZ)) + IF(PIVSIZ .EQ. 2) THEN + IWPOSPIV = IOLDPS+KEEP(IXSZ)+IW(IOLDPS+1+KEEP(IXSZ))+6+ + & IW(IOLDPS+5+KEEP(IXSZ)) + IW(IWPOSPIV+NFRONT) = -IW(IWPOSPIV+NFRONT) + ENDIF + ENDIF + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + PIVSIZ + IF (IFINB.EQ.0) GOTO 50 + IF ((IFINB.EQ.1).OR.(IFINB.EQ.-1)) THEN + LASTBL = (IFINB.EQ.-1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL DMUMPS_294(COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, LDAFS, + & IBEGKJI, IEND, IPIV, NASS, LASTBL,NB_BLOC_FAC, + & + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (IFINB.EQ.(-1)) GOTO 500 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + IF (KEEP(201).EQ.1) THEN + IF (.NOT.RESET_TO_ONE.OR.K109_ON_ENTRY.EQ.KEEP(109)) THEN + MonBloc%Last = .FALSE. + MonBloc%LastPiv= NPIV + LAST_CALL=.FALSE. + CALL DMUMPS_688( + & STRAT_TRY_WRITE, + & TYPEFile, A(POSELT), + & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS), + & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC .LT. 0 ) IFLAG = IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + CALL DMUMPS_235(IBEG_BLOCK, + & NASS,N,INODE,IW,LIW,A,LA, + & LDAFS, + & IOLDPS,POSELT,NBOLKJ,NBTLKJ,KEEP(4),KEEP,KEEP8) + IF (KEEP(201).EQ.1) THEN + IF (RESET_TO_ONE.AND.K109_ON_ENTRY.LT.KEEP(109)) THEN + IDEB = IOLDPS+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))+6 + JJ= IDEB + TO_UPDATE=.FALSE. + DO K = K109_ON_ENTRY+1, KEEP(109) + I = PIVNUL_LIST(K) + DO J=JJ,JJ+NASS + IF (IW(J).EQ.I) THEN + TO_UPDATE=.TRUE. + EXIT + ENDIF + ENDDO + IF (TO_UPDATE) THEN + JJ= J + J = J-IDEB+1 + A(POSELT+int(J-1,8)+int(LDAFS,8)*int(J-1,8))= ONE + TO_UPDATE=.FALSE. + ELSE + IF (ICNTL(1).GT.0) THEN + write(ICNTL(1),*) ' Internal error related ', + & 'to null pivot row detection' + ENDIF + EXIT + ENDIF + ENDDO + ENDIF + K109_ON_ENTRY = KEEP(109) + MonBloc%Last = .FALSE. + MonBloc%LastPiv= NPIV + LAST_CALL=.FALSE. + CALL DMUMPS_688( + & STRAT_TRY_WRITE, + & TYPEFile, A(POSELT), + & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS), + & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC .LT. 0 ) IFLAG = IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + ENDIF + GO TO 50 + 490 CONTINUE + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + IF (RESET_TO_ONE.AND.K109_ON_ENTRY.LT.KEEP(109)) THEN + IDEB = IOLDPS+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))+6 + JJ= IDEB + TO_UPDATE=.FALSE. + DO K = K109_ON_ENTRY+1, KEEP(109) + I = PIVNUL_LIST(K) + DO J=JJ,JJ+NASS + IF (IW(J).EQ.I) THEN + TO_UPDATE=.TRUE. + EXIT + ENDIF + ENDDO + IF (TO_UPDATE) THEN + JJ= J + J = J-IDEB+1 + A(POSELT+int(J-1,8)+int(LDAFS,8)*int(J-1,8))= ONE + TO_UPDATE=.FALSE. + ELSE + IF (ICNTL(1).GT.0) THEN + write(ICNTL(1),*) ' Internal error related ', + & 'to null pivot row detection' + ENDIF + EXIT + ENDIF + ENDDO + ENDIF + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + LAST_CALL = .TRUE. + CALL DMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC, LAST_CALL ) + IF (IFLAG_OOC .LT. 0 ) IFLAG = IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + CALL DMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + DEALLOCATE( IPIV ) + RETURN + END SUBROUTINE DMUMPS_141 + SUBROUTINE DMUMPS_223( NFRONT, NASS, + & IBEGKJI, NASS2, TIPIV, + & N, INODE, IW, LIW, + & A, LA, NNEG, + & INOPV, IFLAG, + & IOLDPS, POSELT, UU, + & SEUIL,KEEP,KEEP8,PIVSIZ, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV + INTEGER NASS2, IBEGKJI, NNEG + INTEGER TIPIV( NASS2 ) + INTEGER PIVSIZ,LPIV + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + DOUBLE PRECISION UU, UULOC, SEUIL + DOUBLE PRECISION CSEUIL + INTEGER IW(LIW) + INTEGER IOLDPS + INTEGER(8) :: POSELT + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk + INTEGER PP_LastPIVRPTRIndexFilled + include 'mpif.h' + INTEGER(8) :: POSPV1,POSPV2,OFFDAG,APOSJ + INTEGER JMAX + DOUBLE PRECISION RMAX,AMAX,TMAX,TOL + DOUBLE PRECISION MAXPIV + DOUBLE PRECISION PIVOT,DETPIV + PARAMETER(TOL = 1.0D-20) + INCLUDE 'mumps_headers.h' + INTEGER(8) :: APOSMAX + INTEGER(8) :: APOS + INTEGER(8) :: J1, J2, JJ, KK + INTEGER :: LDAFS + INTEGER(8) :: LDAFS8 + DOUBLE PRECISION, PARAMETER :: RZERO = 0.0D0 + DOUBLE PRECISION, PARAMETER :: RONE = 1.0D0 + DOUBLE PRECISION ZERO, ONE + PARAMETER( ZERO = 0.0D0 ) + PARAMETER( ONE = 1.0D0 ) + DOUBLE PRECISION PIVNUL, VALTMP + DOUBLE PRECISION FIXA + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,ILOC,K,J + INTRINSIC max + INTEGER I_PIVRPTR, I_PIVR, NBPANELS_L + PIVNUL = DKEEP(1) + FIXA = DKEEP(2) + CSEUIL = SEUIL + LDAFS = NASS + LDAFS8 = int(LDAFS,8) + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL DMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR, I_PIVR, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+KEEP(IXSZ)) + & +KEEP(IXSZ), + & IW, LIW) + ENDIF + UULOC = UU + PIVSIZ = 1 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NPIVP1 = NPIV + 1 + ILOC = NPIVP1 - IBEGKJI + 1 + TIPIV( ILOC ) = ILOC + NASSW = iabs(IW(IOLDPS+3+KEEP(IXSZ))) + APOSMAX = POSELT+LDAFS8*LDAFS8-1_8 + IF(INOPV .EQ. -1) THEN + APOS = POSELT + LDAFS8*int(NPIVP1-1,8) + int(NPIV,8) + POSPV1 = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF(dble(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + ELSE IF (KEEP(258) .NE.0 ) THEN + CALL DMUMPS_762( A(APOS), DKEEP(6), KEEP(259) ) + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL DMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + LDAFS8*int(IPIV-1,8) + int(NPIV,8) + POSPV1 = APOS + int(IPIV - NPIVP1,8) + PIVOT = A(POSPV1) + IF (UULOC.EQ.RZERO) THEN + IF (abs(A(APOS)).EQ.RZERO) GO TO 630 + IF (A(APOS).LT.RZERO) NNEG = NNEG+1 + IF (KEEP(258) .NE. 0) THEN + CALL DMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + GO TO 420 + ENDIF + AMAX = RZERO + JMAX = 0 + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(abs(A(JJ)) .GT. AMAX) THEN + AMAX = abs(A(JJ)) + JMAX = IPIV - int(POSPV1-JJ) + ENDIF + ENDDO + J1 = POSPV1 + LDAFS8 + DO J=1, NASSW - IPIV + IF(abs(A(J1)) .GT. AMAX) THEN + AMAX = max(abs(A(J1)),AMAX) + JMAX = IPIV + J + ENDIF + J1 = J1 + LDAFS8 + ENDDO + IF (KEEP(219).NE.0) THEN + RMAX = dble(A(APOSMAX+int(IPIV,8))) + ELSE + RMAX = RZERO + ENDIF + DO J=1,NASS - NASSW + RMAX = max(abs(A(J1)),RMAX) + J1 = J1 + LDAFS8 + ENDDO + IF (max(AMAX,RMAX,abs(PIVOT)).LE.PIVNUL) THEN + KEEP(109) = KEEP(109)+1 + PIVNUL_LIST(KEEP(109)) = -1 + IF (dble(FIXA).GT.RZERO) THEN + IF(dble(PIVOT) .GE. RZERO) THEN + A(POSPV1) = FIXA + ELSE + A(POSPV1) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + A(JJ) = ZERO + ENDDO + J1 = POSPV1 + LDAFS8 + DO J=1, NASSW - IPIV + A(J1) = ZERO + J1 = J1 + LDAFS8 + ENDDO + DO J=1,NASS - NASSW + A(J1) = ZERO + J1 = J1 + LDAFS8 + ENDDO + VALTMP = max(1.0D10*RMAX, sqrt(huge(RMAX))/1.0D8) + A(POSPV1) = VALTMP + ENDIF + PIVOT = A(POSPV1) + GO TO 415 + ENDIF + IF ((KEEP(19).EQ.0).AND.(KEEP(110).EQ.0)) THEN + IF (max(AMAX,RMAX,abs(PIVOT)).LE.TOL) THEN + IF(SEUIL .GT. epsilon(SEUIL)) THEN + IF(dble(PIVOT) .GE. RZERO) THEN + A(POSPV1) = CSEUIL + ELSE + A(POSPV1) = -CSEUIL + NNEG = NNEG+1 + ENDIF + PIVOT = A(POSPV1) + WRITE(*,*) 'WARNING matrix may be singular' + KEEP(98) = KEEP(98)+1 + GO TO 415 + ENDIF + ENDIF + ENDIF + IF (max(AMAX,abs(PIVOT)) .LE. TOL) GOTO 460 + IF (abs(PIVOT).GT.max(UULOC*max(RMAX,AMAX),SEUIL)) THEN + IF (A(POSPV1).LT.RZERO) NNEG = NNEG+1 + IF (KEEP(258) .NE.0 ) THEN + CALL DMUMPS_762(PIVOT, DKEEP(6), KEEP(259)) + ENDIF + GO TO 415 + END IF + IF (AMAX.LE.TOL) GO TO 460 + IF (RMAX.LT.AMAX) THEN + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(int(POSPV1-JJ) .NE. IPIV-JMAX) THEN + RMAX = max(RMAX,abs(A(JJ))) + ENDIF + ENDDO + J1 = POSPV1 + LDAFS8 + DO J=1,NASS-IPIV + IF(IPIV+J .NE. JMAX) THEN + RMAX = max(abs(A(J1)),RMAX) + ENDIF + J1 = J1 + LDAFS8 + ENDDO + ENDIF + APOSJ = POSELT + int(JMAX-1,8)*LDAFS8 + int(NPIV,8) + POSPV2 = APOSJ + int(JMAX - NPIVP1,8) + IF (IPIV.LT.JMAX) THEN + OFFDAG = APOSJ + int(IPIV - NPIVP1,8) + ELSE + OFFDAG = APOS + int(JMAX - NPIVP1,8) + END IF + IF (KEEP(219).NE.0) THEN + TMAX = max(SEUIL/UULOC,dble(A(APOSMAX+int(JMAX,8)))) + ELSE + TMAX = SEUIL/UULOC + ENDIF + IF(JMAX .LT. IPIV) THEN + JJ = POSPV2 + DO K = 1, NASS-JMAX + JJ = JJ+int(NASS,8) + IF (JMAX+K.NE.IPIV) THEN + TMAX=max(TMAX,abs(A(JJ))) + ENDIF + ENDDO + DO KK = APOSJ, POSPV2-1_8 + TMAX = max(TMAX,abs(A(KK))) + ENDDO + ELSE + JJ = POSPV2 + DO K = 1, NASS-JMAX + JJ = JJ+int(NASS,8) + TMAX=max(TMAX,abs(A(JJ))) + ENDDO + DO KK = APOSJ, POSPV2 - 1_8 + IF (KK.NE.OFFDAG) THEN + TMAX = max(TMAX,abs(A(KK))) + ENDIF + ENDDO + ENDIF + DETPIV = A(POSPV1)*A(POSPV2) - A(OFFDAG)**2 + IF (SEUIL.GT.RZERO) THEN + IF (sqrt(abs(DETPIV)) .LE. SEUIL ) GOTO 460 + ENDIF + MAXPIV = max(abs(A(POSPV1)),abs(A(POSPV2))) + IF (MAXPIV.EQ.RZERO) MAXPIV = RONE + IF (abs(DETPIV)/MAXPIV.LE.TOL) GO TO 460 + IF ((abs(A(POSPV2))*RMAX+AMAX*TMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF ((abs(A(POSPV1))*TMAX+AMAX*RMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF (KEEP(258).NE.0) THEN + CALL DMUMPS_762(DETPIV, DKEEP(6), KEEP(259)) + ENDIF + PIVSIZ = 2 + KEEP(105) = KEEP(105)+1 + IF(DETPIV .LT. RZERO) THEN + NNEG = NNEG+1 + ELSE IF(A(POSPV2) .LT. RZERO) THEN + NNEG = NNEG+2 + ENDIF + 415 CONTINUE + DO K=1,PIVSIZ + IF (PIVSIZ .EQ. 2 ) THEN + IF (K==1) THEN + LPIV = min(IPIV, JMAX) + TIPIV(ILOC) = -(LPIV - IBEGKJI + 1) + ELSE + LPIV = max(IPIV, JMAX) + TIPIV(ILOC+1) = -(LPIV - IBEGKJI + 1) + ENDIF + ELSE + LPIV = IPIV + TIPIV(ILOC) = IPIV - IBEGKJI + 1 + ENDIF + IF (LPIV.EQ.NPIVP1) THEN + GOTO 416 + ENDIF + CALL DMUMPS_319( A, LA, IW, LIW, + & IOLDPS, NPIVP1, LPIV, POSELT, NASS, + & LDAFS, NFRONT, 2, KEEP(219), KEEP(50), + & KEEP(IXSZ)) + 416 CONTINUE + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL DMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, LPIV, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + NPIVP1 = NPIVP1+1 + ENDDO + IF(PIVSIZ .EQ. 2) THEN + A(POSELT+LDAFS8*int(NPIV,8)+int(NPIV+1,8)) = DETPIV + ENDIF + GOTO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 420 + 630 CONTINUE + IFLAG = -10 + 420 CONTINUE + RETURN + END SUBROUTINE DMUMPS_223 + SUBROUTINE DMUMPS_235( + & IBEG_BLOCK, + & NASS, N, INODE, + & IW, LIW, A, LA, + & LDAFS, + & IOLDPS, POSELT, + & LKJIB_ORIG, LKJIB, LKJIT, KEEP,KEEP8 ) + IMPLICIT NONE + INTEGER NASS,N,LIW + INTEGER(8) :: LA + DOUBLE PRECISION A(LA) + INTEGER IW(LIW) + INTEGER LKJIB_ORIG, LKJIB, INODE, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER (8) :: POSELT + INTEGER (8) :: LDAFS8 + INTEGER LDAFS, IBEG_BLOCK + INTEGER IOLDPS, NPIV, JROW2, NPBEG + INTEGER NONEL, LKJIW, NEL1 + INTEGER HF + INTEGER(8) :: LPOS,UPOS,APOS + INTEGER LKJIT + INTEGER LKJIBOLD, IROW + INTEGER J, Block + INTEGER BLSIZE + DOUBLE PRECISION ONE, ALPHA + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + INCLUDE 'mumps_headers.h' + LDAFS8 = int(LDAFS,8) + LKJIBOLD = LKJIB + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + JROW2 = iabs(IW(IOLDPS+3+KEEP(IXSZ))) + NPBEG = IBEG_BLOCK + HF = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + NEL1 = NASS - JROW2 + LKJIW = NPIV - NPBEG + 1 + IF ( LKJIW .NE. LKJIB ) THEN + NONEL = JROW2 - NPIV + 1 + IF ((NASS-NPIV).GE.LKJIT) THEN + LKJIB = LKJIB_ORIG + NONEL + IW(IOLDPS+3+KEEP(IXSZ))= min0(NPIV+LKJIB,NASS) + LKJIB = min0(LKJIB, NASS - NPIV) + ELSE + LKJIB = NASS - NPIV + IW(IOLDPS+3+KEEP(IXSZ)) = NASS + ENDIF + ELSEIF (JROW2.LT.NASS) THEN + IW(IOLDPS+3+KEEP(IXSZ)) = min0(JROW2+LKJIB,NASS) + ENDIF + IBEG_BLOCK = NPIV + 1 + IF (LKJIW.EQ.0) GO TO 500 + IF (NEL1.NE.0) THEN + IF ( NASS - JROW2 > KEEP(7) ) THEN + BLSIZE = KEEP(8) + ELSE + BLSIZE = NASS - JROW2 + END IF + IF ( NASS - JROW2 .GT. 0 ) THEN + DO IROW = JROW2+1, NASS, BLSIZE + Block = min( BLSIZE, NASS - IROW + 1 ) + LPOS = POSELT + int(IROW - 1,8) * LDAFS8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG - 1,8) * LDAFS8 + int(IROW - 1,8) + APOS = POSELT + int(IROW-1,8) * LDAFS8 + int(IROW - 1,8) + DO J=1, Block + CALL dgemv( 'T', LKJIW, Block - J + 1, ALPHA, + & A( LPOS ), LDAFS, A( UPOS ), LDAFS, + & ONE, A( APOS ), LDAFS ) + LPOS = LPOS + LDAFS8 + APOS = APOS + LDAFS8 + 1_8 + UPOS = UPOS + 1_8 + END DO + LPOS = POSELT + int(IROW-1+Block,8) * LDAFS8 + & + int(NPBEG-1,8) + UPOS = POSELT + int(NPBEG-1,8) * LDAFS8 + int(IROW-1,8) + APOS = POSELT + int( IROW - 1 + Block,8 ) * LDAFS8 + & + int(IROW - 1,8) + CALL dgemm( 'N','N', Block, NASS - IROW + 1 - Block, LKJIW, + & ALPHA, A( UPOS ), LDAFS, + & A( LPOS ), LDAFS, ONE, A( APOS ), LDAFS ) + END DO + END IF + END IF + 500 CONTINUE + RETURN + END SUBROUTINE DMUMPS_235 + SUBROUTINE DMUMPS_227 + & ( IBEG_BLOCK, NASS, N, INODE, IW, LIW, + & A, LA, LDAFS, + & IOLDPS,POSELT,IFINB,LKJIB,LKJIT,PIVSIZ, + & XSIZE) + IMPLICIT NONE + INTEGER(8) :: LA, POSELT + INTEGER :: LIW + DOUBLE PRECISION A(LA) + INTEGER IW(LIW) + DOUBLE PRECISION VALPIV + INTEGER IOLDPS, NCB1 + INTEGER LKJIT, IBEG_BLOCK + INTEGER NPIV,JROW2 + INTEGER(8) :: APOS + INTEGER(8) :: LPOS, LPOS1, LPOS2, K1POS + INTEGER(8) :: JJ, K1, K2 + INTEGER(8) :: POSPV1, POSPV2, OFFDAG, OFFDAG_OLD + INTEGER(8) :: LDAFS8 + INTEGER NASS,N,INODE,IFINB,LKJIB,LDAFS, + & NPBEG + INTEGER NEL2 + INTEGER XSIZE + DOUBLE PRECISION ONE, ALPHA + DOUBLE PRECISION ZERO + INTEGER PIVSIZ,NPIV_NEW + INTEGER(8) :: IBEG, IEND, IROW + INTEGER :: J2 + DOUBLE PRECISION SWOP,DETPIV,MULT1,MULT2 + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + PARAMETER (ZERO=0.0D0) + INCLUDE 'mumps_headers.h' + LDAFS8 = int(LDAFS,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIV_NEW = NPIV + PIVSIZ + IFINB = 0 + IF (IW(IOLDPS+3+XSIZE).LE.0) THEN + IW(IOLDPS+3+XSIZE) = min0(NASS,LKJIB) + ENDIF + JROW2 = IW(IOLDPS+3+XSIZE) + NPBEG = IBEG_BLOCK + NEL2 = JROW2 - NPIV_NEW + IF (NEL2.EQ.0) THEN + IF (JROW2.EQ.NASS) THEN + IFINB = -1 + ELSE + IFINB = 1 + ENDIF + ENDIF + IF(PIVSIZ .EQ. 1) THEN + APOS = POSELT + int(NPIV,8)*(LDAFS8 + 1_8) + VALPIV = ONE/A(APOS) + A(APOS) = VALPIV + LPOS = APOS + LDAFS8 + CALL dcopy(NASS-NPIV_NEW, A(LPOS), LDAFS, A(APOS+1_8), 1) + CALL DMUMPS_XSYR('U', NEL2, -VALPIV, A(LPOS), LDAFS, + & A(LPOS+1_8), LDAFS) + CALL dscal(NASS-NPIV_NEW, VALPIV, A(LPOS), LDAFS) + IF (NEL2.GT.0) THEN + K1POS = LPOS + int(NEL2,8)*LDAFS8 + NCB1 = NASS - JROW2 + CALL dger(NEL2, NCB1 , ALPHA, A(APOS+1_8), 1, + & A(K1POS), LDAFS, A(K1POS+1_8), LDAFS) + ENDIF + ELSE + POSPV1 = POSELT + int(NPIV,8)*(LDAFS8 + 1_8) + POSPV2 = POSPV1+LDAFS8+1_8 + OFFDAG_OLD = POSPV2 - 1_8 + OFFDAG = POSPV1+1_8 + SWOP = A(POSPV2) + DETPIV = A(OFFDAG) + A(POSPV2) = A(POSPV1)/DETPIV + A(POSPV1) = SWOP/DETPIV + A(OFFDAG) = -A(OFFDAG_OLD)/DETPIV + A(OFFDAG_OLD) = ZERO + LPOS1 = POSPV2 + LDAFS8 - 1_8 + LPOS2 = LPOS1 + 1_8 + CALL dcopy(NASS-NPIV_NEW, A(LPOS1), LDAFS, A(POSPV1+2_8), 1) + CALL dcopy(NASS-NPIV_NEW, A(LPOS2), LDAFS, A(POSPV2+1_8), 1) + JJ = POSPV2 + int(NASS-1,8) + IBEG = JJ + 2_8 + IEND = IBEG + DO J2 = 1,NEL2 + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(OFFDAG)*A(K2)) + MULT2 = - (A(OFFDAG)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1+2_8 + K2 = POSPV2+1_8 + DO IROW = IBEG,IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A(JJ) = -MULT1 + A(JJ+1_8) = -MULT2 + IBEG = IBEG + int(NASS,8) + IEND = IEND + int(NASS + 1,8) + JJ = JJ+int(NASS,8) + ENDDO + IEND = IEND-1_8 + DO J2 = JROW2+1,NASS + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(POSPV1+1_8)*A(K2)) + MULT2 = - (A(POSPV1+1_8)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1+2_8 + K2 = POSPV2+1_8 + DO IROW = IBEG,IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A(JJ) = -MULT1 + A(JJ+1_8) = -MULT2 + IBEG = IBEG + int(NASS,8) + IEND = IEND + int(NASS,8) + JJ = JJ+int(NASS,8) + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_227 + RECURSIVE SUBROUTINE DMUMPS_263( + & COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE DMUMPS_COMM_BUFFER + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER COMP + INTEGER IFLAG, IERROR, NBFIN, MSGSOU + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)) + INTEGER NBPROCFILS(KEEP(28)), STEP(N), PIMASTER(KEEP(28)) + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N + 1 ), FRTELT( NELT ) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER COMM, MYID + INTEGER PTLUST_S(KEEP(28)) + INTEGER ITLOC( N + KEEP(253)), FILS( N ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER ND( KEEP(28) ), FRERE_STEPS( KEEP(28) ) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION FLOP1 + DOUBLE PRECISION DBLARR( max(1,KEEP(13)) ) + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INCLUDE 'mumps_headers.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER INODE, IPOSK, JPOSK, NCOLU, NPIV, POSITION, IERR + INTEGER(8) POSELT, POSBLOCFACTO + INTEGER(8) LAELL + INTEGER IOLDPS, LCONT1, NROW1, NCOL1, NPIV1 + INTEGER NSLAVES_TOT, HS, DEST, NSLAVES_FOLLOW + INTEGER FPERE + INTEGER(8) CPOS, LPOS + LOGICAL DYNAMIC + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER allocok + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: UDYNAMIC + DOUBLE PRECISION ONE,ALPHA + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + DYNAMIC = .FALSE. + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, IPOSK, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, JPOSK, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, + & MPI_INTEGER, COMM, IERR ) + IF ( NPIV .LE. 0 ) THEN + NPIV = - NPIV + WRITE(*,*) MYID,':error, received negative NPIV in BLFAC' + CALL MUMPS_ABORT() + END IF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOLU, 1, + & MPI_INTEGER, COMM, IERR ) + LAELL = int(NPIV,8) * int(NCOLU,8) + IF ( LRLU .LT. LAELL ) THEN + IF ( LRLUS .LT. LAELL ) THEN + IFLAG = -9 + CALL MUMPS_731(LAELL - LRLUS, IERROR) + GOTO 700 + END IF + CALL DMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS=' + & ,LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731(LAELL - LRLU, IERROR) + GOTO 700 + END IF + END IF + LRLU = LRLU - LAELL + LRLUS = LRLUS - LAELL + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSBLOCFACTO = POSFAC + POSFAC = POSFAC + LAELL + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8, LAELL,KEEP,KEEP8,LRLU) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSBLOCFACTO), NPIV*NCOLU, + & MPI_DOUBLE_PRECISION, + & COMM, IERR ) + IF (PTRIST(STEP( INODE )) .EQ. 0) DYNAMIC = .TRUE. + IF ( (PTRIST(STEP( INODE )).NE.0) .AND. + & (IPOSK + NPIV -1 .GT. + & IW(PTRIST(STEP(INODE))+3+KEEP(IXSZ))) )THEN + DYNAMIC = .TRUE. + ENDIF + IF (DYNAMIC) THEN + ALLOCATE(UDYNAMIC(LAELL), stat=allocok) + if (allocok .GT. 0) THEN + write(*,*) MYID, ' : PB allocation U in blfac_slave ' + & , LAELL + IFLAG = -13 + CALL MUMPS_731(LAELL,IERROR) + GOTO 700 + endif + UDYNAMIC(1_8:LAELL) = A(POSBLOCFACTO:POSBLOCFACTO+LAELL-1_8) + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + ENDIF + DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 ) + MSGSOU = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), + & SLAVEF ) + SET_IRECV = .FALSE. + BLOCKING = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + ENDDO + DO WHILE ( IPOSK + NPIV -1 .GT. + & IW( PTRIST(STEP( INODE )) + 3 +KEEP(IXSZ)) ) + MSGSOU = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + SET_IRECV = .FALSE. + BLOCKING = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, BLOC_FACTO_SYM, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .TRUE. + CALL DMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IOLDPS = PTRIST(STEP( INODE )) + POSELT = PTRAST(STEP( INODE )) + LCONT1 = IW( IOLDPS + KEEP(IXSZ) ) + NROW1 = IW( IOLDPS + 2 + KEEP(IXSZ)) + NPIV1 = IW( IOLDPS + 3 + KEEP(IXSZ)) + NSLAVES_TOT = IW( IOLDPS + 5 + KEEP(IXSZ)) + HS = 6 + NSLAVES_TOT + KEEP(IXSZ) + NCOL1 = LCONT1 + NPIV1 + CPOS = POSELT + int(JPOSK - 1,8) + LPOS = POSELT + int(IPOSK - 1,8) + IF ( NPIV .GT. 0 ) THEN + IF (DYNAMIC) THEN + CALL dgemm( 'T', 'N', NCOLU, NROW1, NPIV, ALPHA, + & UDYNAMIC(1), NPIV, + & A( LPOS ), NCOL1, ONE, + & A( CPOS ), NCOL1 ) + ELSE + CALL dgemm( 'T', 'N', NCOLU, NROW1, NPIV, ALPHA, + & A( POSBLOCFACTO ), NPIV, + & A( LPOS ), NCOL1, ONE, + & A( CPOS ), NCOL1 ) + ENDIF + FLOP1 = dble(NCOLU*NPIV)*dble(2*NROW1) + FLOP1 = -FLOP1 + CALL DMUMPS_190(1, .FALSE., FLOP1, KEEP,KEEP8 ) + ENDIF + IW( IOLDPS + 6 + KEEP(IXSZ) ) = IW( IOLDPS + 6+ KEEP(IXSZ) ) + 1 + IF (DYNAMIC) THEN + DEALLOCATE(UDYNAMIC) + ELSE + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + CALL DMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + ENDIF + NSLAVES_FOLLOW = IW( IOLDPS + 5 +KEEP(IXSZ) ) - XTRA_SLAVES_SYM + IF ( IW( IOLDPS + 6 +KEEP(IXSZ)) .eq. 0 .and. + & KEEP(50) .ne. 0 .and. NSLAVES_FOLLOW .eq. 0 ) + & THEN + DEST = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + CALL DMUMPS_62( INODE, DEST, END_NIV2_LDLT, + & COMM, IERR ) + IF ( IERR .LT. 0 ) THEN + write(*,*) ' Internal error in PROCESS_BLFAC_SLAVE.' + IFLAG = -99 + GOTO 700 + END IF + END IF + IF (IW(PTRIST(STEP(INODE)) + 6+KEEP(IXSZ) ) .eq. 0) THEN + CALL DMUMPS_759( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ENDIF + 600 CONTINUE + RETURN + 700 CONTINUE + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE DMUMPS_263 + SUBROUTINE DMUMPS_38( NROW_SON, NCOL_SON, INDROW_SON, + & INDCOL_SON, NSUPCOL, VAL_SON, VAL_ROOT, + & LOCAL_M, LOCAL_N, + & RHS_ROOT, NLOC_ROOT, CBP ) + IMPLICIT NONE + INTEGER NCOL_SON, NROW_SON, NSUPCOL + INTEGER, intent(in) :: CBP + INTEGER INDROW_SON( NROW_SON ), INDCOL_SON( NCOL_SON ) + INTEGER LOCAL_M, LOCAL_N + DOUBLE PRECISION VAL_SON( NCOL_SON, NROW_SON ) + DOUBLE PRECISION VAL_ROOT( LOCAL_M, LOCAL_N ) + INTEGER NLOC_ROOT + DOUBLE PRECISION RHS_ROOT( LOCAL_M, NLOC_ROOT ) + INTEGER I, J + IF (CBP .EQ. 0) THEN + DO I = 1, NROW_SON + DO J = 1, NCOL_SON-NSUPCOL + VAL_ROOT( INDROW_SON( I ), INDCOL_SON( J ) ) = + & VAL_ROOT( INDROW_SON( I ), INDCOL_SON( J ) ) + VAL_SON(J,I) + END DO + DO J = NCOL_SON-NSUPCOL+1, NCOL_SON + RHS_ROOT( INDROW_SON( I ), INDCOL_SON(J)) = + & RHS_ROOT(INDROW_SON(I),INDCOL_SON(J)) + VAL_SON(J,I) + ENDDO + END DO + ELSE + DO I=1, NROW_SON + DO J = 1, NCOL_SON + RHS_ROOT( INDROW_SON( I ), INDCOL_SON(J)) = + & RHS_ROOT(INDROW_SON(I),INDCOL_SON(J)) + VAL_SON(J,I) + ENDDO + ENDDO + ENDIF + RETURN + END SUBROUTINE DMUMPS_38 + RECURSIVE SUBROUTINE DMUMPS_80 + & ( COMM_LOAD, ASS_IRECV, N, ISON, IROOT, + & PTRI, PTRR, + & root, + & NBROW, NBCOL, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON, + & SHIFT_VAL_SON, LDA, TAG, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE DMUMPS_OOC + USE DMUMPS_COMM_BUFFER + USE DMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + TYPE (DMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, ISON, IROOT, TAG + INTEGER PTRI( KEEP(28) ) + INTEGER(8) :: PTRR( KEEP(28) ) + INTEGER NBROW, NBCOL, LDA + INTEGER(8) :: SHIFT_VAL_SON + INTEGER SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON + INTEGER MYID, COMM + LOGICAL INVERT + INCLUDE 'mpif.h' + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER LIW + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)), NSTK( N ) + INTEGER COMP, IFLAG, IERROR + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER NBFIN, SLAVEF + DOUBLE PRECISION OPASSW, OPELIW + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION DBLARR( max(1,KEEP(13)) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: PTRROW, PTRCOL + INTEGER, ALLOCATABLE, DIMENSION(:) :: NSUPROW, NSUPCOL + INTEGER, ALLOCATABLE, DIMENSION(:) :: ROW_INDEX_LIST + INTEGER, ALLOCATABLE, DIMENSION(:) :: COL_INDEX_LIST + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER I, POS_IN_ROOT, IROW, JCOL, IGLOB, JGLOB + INTEGER PDEST, IERR + INTEGER LOCAL_M, LOCAL_N + INTEGER(8) :: POSROOT + INTEGER NSUBSET_ROW, NSUBSET_COL + INTEGER NRLOCAL, NCLOCAL + LOGICAL SET_IRECV, BLOCKING, MESSAGE_RECEIVED + INTEGER NBROWS_ALREADY_SENT + INTEGER SIZE_MSG + INTEGER LP + INCLUDE 'mumps_headers.h' + LOGICAL SKIPLAST_RHS_ROWS, BCP_SYM_NONEMPTY + INTEGER BBPCBP + BBPCBP = 0 + LP = ICNTL(1) + IF ( ICNTL(4) .LE. 0 ) LP = -1 + ALLOCATE(PTRROW(root%NPROW + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPROW + 1 + endif + ALLOCATE(PTRCOL(root%NPCOL + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPCOL + 1 + endif + ALLOCATE(NSUPROW(root%NPROW + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPROW + 1 + endif + ALLOCATE(NSUPCOL(root%NPCOL + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPCOL + 1 + endif + IF (IFLAG.LT.0) THEN + IF (LP > 0) write(6,*) MYID, ' : MEMORY ALLOCATION ', + & 'FAILURE in DMUMPS_80' + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + SKIPLAST_RHS_ROWS = ((KEEP(253).GT.0).AND.(KEEP(50).EQ.0)) + BCP_SYM_NONEMPTY = .FALSE. + PTRROW = 0 + PTRCOL = 0 + NSUPROW = 0 + NSUPCOL = 0 + DO I = 1, NBROW + IGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_ROW_SON + I - 1 ) + IF (SKIPLAST_RHS_ROWS.AND.(IGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF (IGLOB.GT.N) THEN + BCP_SYM_NONEMPTY = .TRUE. + POS_IN_ROOT = IGLOB - N + JCOL = mod((POS_IN_ROOT-1)/root%NBLOCK,root%NPCOL) + NSUPCOL(JCOL+1) = NSUPCOL(JCOL+1) + 1 + PTRCOL( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + ELSE + POS_IN_ROOT = root%RG2L_ROW( IGLOB ) + IROW = mod((POS_IN_ROOT-1)/root%MBLOCK,root%NPROW) + PTRROW ( IROW + 2 ) = PTRROW( IROW + 2 ) + 1 + ENDIF + ELSE + IF (IGLOB .GT. N) THEN + POS_IN_ROOT = IGLOB - N + ELSE + POS_IN_ROOT = root%RG2L_COL( IGLOB ) + ENDIF + JCOL = mod( ( POS_IN_ROOT - 1 ) / root%NBLOCK, root%NPCOL ) + IF (IGLOB.GT.N) + & NSUPCOL(JCOL+1) = NSUPCOL(JCOL+1) + 1 + PTRCOL( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + END IF + END DO + IF ((KEEP(50).NE.0).AND.(.NOT.INVERT).AND.BCP_SYM_NONEMPTY) + & BBPCBP = 1 + DO I = 1, NBCOL + JGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_COL_SON + I - 1 ) + IF ((KEEP(50).GT.0) .AND. (JGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF (KEEP(50).EQ.0) THEN + IF (JGLOB.LE.N) THEN + POS_IN_ROOT = root%RG2L_COL(JGLOB) + ELSE + POS_IN_ROOT = JGLOB-N + ENDIF + JCOL = mod((POS_IN_ROOT-1) / root%NBLOCK, root%NPCOL ) + IF (JGLOB.GT.N) THEN + NSUPCOL(JCOL+1) = NSUPCOL(JCOL+1) + 1 + ENDIF + PTRCOL ( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + ELSE + POS_IN_ROOT = root%RG2L_COL(JGLOB) + JCOL = mod((POS_IN_ROOT-1) / root%NBLOCK, root%NPCOL ) + PTRCOL ( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + IF (BCP_SYM_NONEMPTY) THEN + POS_IN_ROOT = root%RG2L_ROW(JGLOB) + IROW = mod((POS_IN_ROOT-1)/root%MBLOCK,root%NPROW) + NSUPROW(IROW+1) = NSUPROW(IROW+1)+1 + PTRROW( IROW + 2 ) = PTRROW( IROW + 2 ) + 1 + ENDIF + ENDIF + ELSE + IF (JGLOB.LE.N) THEN + POS_IN_ROOT = root%RG2L_ROW( JGLOB ) + ELSE + POS_IN_ROOT = JGLOB-N + ENDIF + IROW = mod( ( POS_IN_ROOT - 1 ) / + & root%MBLOCK, root%NPROW ) + PTRROW ( IROW + 2 ) = PTRROW( IROW + 2 ) + 1 + END IF + END DO + PTRROW( 1 ) = 1 + DO IROW = 2, root%NPROW + 1 + PTRROW( IROW ) = PTRROW( IROW ) + PTRROW( IROW - 1 ) + END DO + PTRCOL( 1 ) = 1 + DO JCOL = 2, root%NPCOL + 1 + PTRCOL( JCOL ) = PTRCOL( JCOL ) + PTRCOL( JCOL - 1 ) + END DO + ALLOCATE(ROW_INDEX_LIST(PTRROW(root%NPROW+1)-1+1), + & stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = PTRROW(root%NPROW+1)-1+1 + endif + ALLOCATE(COL_INDEX_LIST(PTRCOL(root%NPCOL+1)-1+1), + & stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = PTRCOL(root%NPCOL+1)-1+1 + endif + DO I = 1, NBROW + IGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_ROW_SON + I - 1 ) + IF (SKIPLAST_RHS_ROWS.AND.(IGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF (IGLOB.GT.N) CYCLE + POS_IN_ROOT = root%RG2L_ROW( IGLOB ) + IROW = mod( ( POS_IN_ROOT - 1 ) / root%MBLOCK, + & root%NPROW ) + ROW_INDEX_LIST( PTRROW( IROW + 1 ) ) = I + PTRROW ( IROW + 1 ) = PTRROW( IROW + 1 ) + 1 + ELSE + IF (IGLOB.LE.N) THEN + POS_IN_ROOT = root%RG2L_COL( IGLOB ) + ELSE + POS_IN_ROOT = IGLOB - N + ENDIF + JCOL = mod( ( POS_IN_ROOT - 1 ) / root%NBLOCK, + & root%NPCOL ) + COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ) = I + PTRCOL ( JCOL + 1 ) = PTRCOL( JCOL + 1 ) + 1 + END IF + END DO + DO I = 1, NBCOL + JGLOB = IW( PTRI(STEP(ISON))+SHIFT_LIST_COL_SON+I - 1 ) + IF ((KEEP(50).GT.0) .AND. (JGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF ( JGLOB.LE.N ) THEN + POS_IN_ROOT = root%RG2L_COL( JGLOB ) + ELSE + POS_IN_ROOT = JGLOB - N + ENDIF + JCOL = mod( ( POS_IN_ROOT - 1 ) / + & root%NBLOCK, root%NPCOL ) + COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ) = I + PTRCOL ( JCOL + 1 ) = PTRCOL( JCOL + 1 ) + 1 + ELSE + IF ( JGLOB.LE.N ) THEN + POS_IN_ROOT = root%RG2L_ROW( JGLOB ) + ELSE + POS_IN_ROOT = JGLOB - N + ENDIF + IROW = mod( ( POS_IN_ROOT - 1 ) / + & root%MBLOCK, root%NPROW ) + ROW_INDEX_LIST( PTRROW( IROW + 1 ) ) = I + PTRROW( IROW + 1 ) = PTRROW( IROW + 1 ) + 1 + END IF + END DO + IF (BCP_SYM_NONEMPTY) THEN + DO I = 1, NBROW + IGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_ROW_SON + I - 1 ) + IF (IGLOB.LE.N) CYCLE + POS_IN_ROOT = IGLOB - N + JCOL = mod((POS_IN_ROOT-1)/root%NBLOCK,root%NPCOL) + COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ) = I + PTRCOL ( JCOL + 1 ) = PTRCOL( JCOL + 1 ) + 1 + ENDDO + DO I=1, NBCOL + JGLOB = IW( PTRI(STEP(ISON))+SHIFT_LIST_COL_SON+I - 1 ) + IF (JGLOB.GT.N) THEN + EXIT + ELSE + POS_IN_ROOT = root%RG2L_ROW(JGLOB) + ENDIF + IROW = mod((POS_IN_ROOT-1)/root%MBLOCK,root%NPROW) + ROW_INDEX_LIST( PTRROW( IROW + 1 ) ) = I + PTRROW( IROW + 1 ) = PTRROW( IROW + 1 ) + 1 + ENDDO + ENDIF + DO IROW = root%NPROW, 2, -1 + PTRROW( IROW ) = PTRROW( IROW - 1 ) + END DO + PTRROW( 1 ) = 1 + DO JCOL = root%NPCOL, 2, -1 + PTRCOL( JCOL ) = PTRCOL( JCOL - 1 ) + END DO + PTRCOL( 1 ) = 1 + JCOL = root%MYCOL + IROW = root%MYROW + IF ( root%yes ) THEN + if (IROW .ne. root%MYROW .or. JCOL.ne.root%MYCOL) then + write(*,*) ' error in grid position buildandsendcbroot' + CALL MUMPS_ABORT() + end if + IF ( PTRIST(STEP(IROOT)).EQ.0.AND. + & PTLUST_S(STEP(IROOT)).EQ.0) THEN + NBPROCFILS( STEP(IROOT) ) = -1 + CALL DMUMPS_284(root, IROOT, N, IW, LIW, + & A, LA, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + IF (IFLAG.LT.0) THEN + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + ELSE + NBPROCFILS(STEP(IROOT)) = NBPROCFILS(STEP(IROOT)) - 1 + IF ( NBPROCFILS( STEP(IROOT) ) .eq. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + CALL DMUMPS_681(IERR) + ELSE IF (KEEP(201).EQ.2) THEN + CALL DMUMPS_580(IERR) + ENDIF + CALL DMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IROOT+N ) + IF (KEEP(47) .GE. 3) THEN + CALL DMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + END IF + IF (KEEP(60) .NE. 0 ) THEN + LOCAL_M = root%SCHUR_LLD + LOCAL_N = root%SCHUR_NLOC + NRLOCAL = PTRROW( IROW + 2 ) - PTRROW( IROW + 1 ) + NCLOCAL = PTRCOL( JCOL + 2 ) - PTRCOL( JCOL + 1 ) + CALL DMUMPS_285( N, + & root%SCHUR_POINTER(1), + & LOCAL_M, LOCAL_N, + & root%NPCOL, root%NPROW, root%MBLOCK, root%NBLOCK, + & NBCOL, NBROW, + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_COL_SON ), + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_ROW_SON ), + & LDA, A( PTRR( STEP(ISON)) + SHIFT_VAL_SON ), + & ROW_INDEX_LIST( PTRROW( IROW + 1 ) ), + & COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ), + & NRLOCAL, + & NCLOCAL, + & NSUPROW(IROW+1), NSUPCOL(JCOL+1), + & root%RG2L_ROW(1), root%RG2L_COL(1), INVERT, + & KEEP, + & root%RHS_ROOT(1,1), root%RHS_NLOC ) + ELSE + IF ( PTRIST(STEP( IROOT )) .GE. 0 ) THEN + IF ( PTRIST(STEP( IROOT )) .EQ. 0 ) THEN + LOCAL_N = IW( PTLUST_S(STEP(IROOT)) + 1 + KEEP(IXSZ)) + LOCAL_M = IW( PTLUST_S(STEP(IROOT)) + 2 + KEEP(IXSZ)) + POSROOT = PTRFAC(IW( PTLUST_S(STEP(IROOT)) +4+KEEP(IXSZ) )) + ELSE + LOCAL_N = - IW( PTRIST(STEP(IROOT)) +KEEP(IXSZ)) + LOCAL_M = IW( PTRIST(STEP(IROOT)) + 1 +KEEP(IXSZ)) + POSROOT = PAMASTER(STEP( IROOT )) + ENDIF + NCLOCAL = PTRCOL( JCOL + 2 ) - PTRCOL( JCOL + 1 ) + NRLOCAL = PTRROW( IROW + 2 ) - PTRROW( IROW + 1 ) + CALL DMUMPS_285( N, A( POSROOT ), + & LOCAL_M, LOCAL_N, + & root%NPCOL, root%NPROW, root%MBLOCK, root%NBLOCK, + & NBCOL, NBROW, + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_COL_SON ), + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_ROW_SON ), + & LDA, A( PTRR( STEP(ISON)) + SHIFT_VAL_SON ), + & ROW_INDEX_LIST( PTRROW( IROW + 1 ) ), + & COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ), + & NRLOCAL, + & NCLOCAL, + & NSUPROW(IROW+1), NSUPCOL(JCOL+1), + & root%RG2L_ROW(1), root%RG2L_COL(1), INVERT, + & KEEP, + & root%RHS_ROOT(1,1), root%RHS_NLOC ) + END IF + ENDIF + END IF + DO IROW = 0, root%NPROW - 1 + DO JCOL = 0, root%NPCOL - 1 + PDEST = IROW * root%NPCOL + JCOL + IF ( (root%MYROW.eq.IROW.and.root%MYCOL.eq.JCOL) .and. + & MYID.ne.PDEST) THEN + write(*,*) 'error: myrow,mycol=',root%MYROW,root%MYCOL + write(*,*) ' MYID,PDEST=',MYID,PDEST + CALL MUMPS_ABORT() + END IF + IF ( root%MYROW .NE. IROW .OR. root%MYCOL .NE. JCOL) THEN + NBROWS_ALREADY_SENT = 0 + IERR = -1 + DO WHILE ( IERR .EQ. -1 ) + NSUBSET_ROW = PTRROW( IROW + 2 ) - PTRROW( IROW + 1 ) + NSUBSET_COL = PTRCOL( JCOL + 2 ) - PTRCOL( JCOL + 1 ) + IF ( LRLU .LT. int(NSUBSET_ROW,8) * int(NSUBSET_COL,8) + & .AND. LRLUS .GT. int(NSUBSET_ROW,8) * int(NSUBSET_COL,8) ) + & THEN + CALL DMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) MYID,': Error in b&scbroot: pb compress' + WRITE(*,*) MYID,': LRLU, LRLUS=',LRLU,LRLUS + CALL MUMPS_ABORT() + END IF + END IF + CALL DMUMPS_648( N, ISON, + & NBCOL, NBROW, + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_COL_SON ), + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_ROW_SON ), + & LDA, A( PTRR(STEP(ISON)) + SHIFT_VAL_SON ), + & TAG, + & ROW_INDEX_LIST( PTRROW( IROW + 1 ) ), + & COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ), + & NSUBSET_ROW, NSUBSET_COL, + & NSUPROW(IROW+1), NSUPCOL(JCOL+1), + & root%NPROW, root%NPCOL, root%MBLOCK, + & root%RG2L_ROW, root%RG2L_COL, + & root%NBLOCK, PDEST, + & COMM, IERR, A( POSFAC ), LRLU, INVERT, + & SIZE_MSG, NBROWS_ALREADY_SENT, KEEP, BBPCBP ) + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL DMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK, + & COMP, IFLAG, IERROR, COMM, NBPROCFILS, IPOOL, LPOOL, + & LEAF, NBFIN, MYID, SLAVEF, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, KEEP,KEEP8, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + END IF + END DO + IF ( IERR == -2 ) THEN + IFLAG = -17 + IERROR = SIZE_MSG + IF (LP > 0) WRITE(LP, *) "FAILURE, SEND BUFFER TOO + & SMALL DURING DMUMPS_80" + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + GOTO 500 + ENDIF + IF ( IERR == -3 ) THEN + IF (LP > 0) WRITE(LP, *) "FAILURE, RECV BUFFER TOO + & SMALL DURING DMUMPS_80" + IFLAG = -20 + IERROR = SIZE_MSG + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + GOTO 500 + ENDIF + END IF + END DO + END DO + 500 CONTINUE + DEALLOCATE(PTRROW) + DEALLOCATE(PTRCOL) + DEALLOCATE(ROW_INDEX_LIST) + DEALLOCATE(COL_INDEX_LIST) + RETURN + END SUBROUTINE DMUMPS_80 + SUBROUTINE DMUMPS_285( N, VAL_ROOT, + & LOCAL_M, LOCAL_N, + & NPCOL, NPROW, MBLOCK, NBLOCK, NBCOL_SON, NBROW_SON, INDCOL_SON, + & INDROW_SON, LD_SON, VAL_SON, SUBSET_ROW, SUBSET_COL, + & NSUBSET_ROW, NSUBSET_COL, NSUPROW, NSUPCOL, + & RG2L_ROW, RG2L_COL, INVERT, + & KEEP, RHS_ROOT, NLOC ) + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INTEGER N, LOCAL_M, LOCAL_N + DOUBLE PRECISION VAL_ROOT( LOCAL_M, LOCAL_N ) + INTEGER NPCOL, NPROW, MBLOCK, NBLOCK + INTEGER NBCOL_SON, NBROW_SON + INTEGER INDCOL_SON( NBCOL_SON ), INDROW_SON( NBROW_SON ) + INTEGER LD_SON + INTEGER NSUPROW, NSUPCOL + DOUBLE PRECISION VAL_SON( LD_SON, NBROW_SON ) + INTEGER KEEP(500) + INTEGER NSUBSET_ROW, NSUBSET_COL + INTEGER SUBSET_ROW( NSUBSET_ROW ), SUBSET_COL( NSUBSET_COL ) + INTEGER RG2L_ROW( N ), RG2L_COL( N ) + LOGICAL INVERT + INTEGER NLOC + DOUBLE PRECISION RHS_ROOT( LOCAL_M, NLOC) + INTEGER ISUB, JSUB, I, J, IPOS_ROOT, JPOS_ROOT + INTEGER ILOC_ROOT, JLOC_ROOT, IGLOB, JGLOB + IF (KEEP(50).EQ.0) THEN + DO ISUB = 1, NSUBSET_ROW + I = SUBSET_ROW( ISUB ) + IGLOB = INDROW_SON( I ) + IPOS_ROOT = RG2L_ROW( IGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + DO JSUB = 1, NSUBSET_COL-NSUPCOL + J = SUBSET_COL( JSUB ) + JGLOB = INDCOL_SON( J ) + JPOS_ROOT = RG2L_COL( JGLOB ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + DO JSUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL + J = SUBSET_COL( JSUB ) + JGLOB = INDCOL_SON( J ) + JPOS_ROOT = JGLOB - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + RHS_ROOT(ILOC_ROOT, JLOC_ROOT) = + & RHS_ROOT(ILOC_ROOT, JLOC_ROOT) + VAL_SON( J, I ) + ENDDO + END DO + ELSE + IF ( .NOT. INVERT ) THEN + DO ISUB = 1, NSUBSET_ROW - NSUPROW + I = SUBSET_ROW( ISUB ) + IGLOB = INDROW_SON( I ) + IPOS_ROOT = RG2L_ROW( IGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + DO JSUB = 1, NSUBSET_COL -NSUPCOL + J = SUBSET_COL( JSUB ) + JGLOB = INDCOL_SON( J ) + JPOS_ROOT = RG2L_COL( JGLOB ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + END DO + DO JSUB = NSUBSET_COL -NSUPCOL+1, NSUBSET_COL + J = SUBSET_COL( JSUB ) + JGLOB = INDROW_SON( J ) + JPOS_ROOT = JGLOB - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + DO ISUB = NSUBSET_ROW - NSUPROW +1, NSUBSET_ROW + I = SUBSET_ROW( ISUB ) + IGLOB = INDCOL_SON( I ) + IPOS_ROOT = RG2L_ROW(IGLOB) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + RHS_ROOT(ILOC_ROOT, JLOC_ROOT) = + & RHS_ROOT(ILOC_ROOT, JLOC_ROOT) + VAL_SON( I, J ) + END DO + END DO + ELSE + DO ISUB = 1, NSUBSET_COL-NSUPCOL + I = SUBSET_COL( ISUB ) + IGLOB = INDROW_SON( I ) + JPOS_ROOT = RG2L_COL( IGLOB ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + DO JSUB = 1, NSUBSET_ROW + J = SUBSET_ROW( JSUB ) + JGLOB = INDCOL_SON( J ) + IPOS_ROOT = RG2L_ROW( JGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + ENDDO + DO ISUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL + I = SUBSET_COL( ISUB ) + IGLOB = INDROW_SON( I ) + JPOS_ROOT = IGLOB - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + DO JSUB = 1, NSUBSET_ROW + J = SUBSET_ROW( JSUB ) + JGLOB = INDCOL_SON( J ) + IPOS_ROOT = RG2L_ROW( JGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + RHS_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & RHS_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + ENDDO + END IF + END IF + RETURN + END SUBROUTINE DMUMPS_285 + SUBROUTINE DMUMPS_164 + &( MYID, NPROCS, N, root, COMM_ROOT, IROOT, FILS, + & K50, K46, K51 + & , K60, IDNPROW, IDNPCOL, IDMBLOCK, IDNBLOCK + & ) + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INTEGER MYID, MYID_ROOT + TYPE (DMUMPS_ROOT_STRUC)::root + INTEGER COMM_ROOT + INTEGER N, IROOT, NPROCS, K50, K46, K51 + INTEGER FILS( N ) + INTEGER K60, IDNPROW, IDNPCOL, IDMBLOCK, IDNBLOCK + INTEGER INODE, NPROWtemp, NPCOLtemp + LOGICAL SLAVE + root%ROOT_SIZE = 0 + root%TOT_ROOT_SIZE = 0 + SLAVE = ( MYID .ne. 0 .or. + & ( MYID .eq. 0 .and. K46 .eq. 1 ) ) + INODE = IROOT + DO WHILE ( INODE .GT. 0 ) + INODE = FILS( INODE ) + root%ROOT_SIZE = root%ROOT_SIZE + 1 + END DO + IF ( ( K60 .NE. 2 .AND. K60 .NE. 3 ) .OR. + & IDNPROW .LE. 0 .OR. IDNPCOL .LE. 0 + & .OR. IDMBLOCK .LE.0 .OR. IDNBLOCK.LE.0 + & .OR. IDNPROW * IDNPCOL .GT. NPROCS ) THEN + root%MBLOCK = K51 + root%NBLOCK = K51 + CALL DMUMPS_99( NPROCS, root%NPROW, root%NPCOL, + & root%ROOT_SIZE, K50 ) + IF ( K60 .EQ. 2 .OR. K60 .EQ. 3 ) THEN + IDNPROW = root%NPROW + IDNPCOL = root%NPCOL + IDMBLOCK = root%MBLOCK + IDNBLOCK = root%NBLOCK + ENDIF + ELSE IF ( K60 .EQ. 2 .OR. K60 .EQ. 3 ) THEN + root%NPROW = IDNPROW + root%NPCOL = IDNPCOL + root%MBLOCK = IDMBLOCK + root%NBLOCK = IDNBLOCK + ENDIF + IF ( K60 .EQ. 2 .OR. K60 .EQ. 3 ) THEN + IF (SLAVE) THEN + root%LPIV = 0 + IF (K46.EQ.0) THEN + MYID_ROOT=MYID-1 + ELSE + MYID_ROOT=MYID + ENDIF + IF (MYID_ROOT < root%NPROW*root%NPCOL) THEN + root%MYROW = MYID_ROOT / root%NPCOL + root%MYCOL = mod(MYID_ROOT, root%NPCOL) + root%yes = .true. + ELSE + root%MYROW = -1 + root%MYCOL = -1 + root%yes = .FALSE. + ENDIF + ELSE + root%yes = .FALSE. + ENDIF + ELSE IF ( SLAVE ) THEN + IF ( root%gridinit_done) THEN + CALL blacs_gridexit( root%CNTXT_BLACS ) + root%gridinit_done = .FALSE. + END IF + root%CNTXT_BLACS = COMM_ROOT + CALL blacs_gridinit( root%CNTXT_BLACS, 'R', + & root%NPROW, root%NPCOL ) + root%gridinit_done = .TRUE. + CALL blacs_gridinfo( root%CNTXT_BLACS, + & NPROWtemp, NPCOLtemp, + & root%MYROW, root%MYCOL ) + IF ( root%MYROW .NE. -1 ) THEN + root%yes = .true. + ELSE + root%yes = .false. + END IF + root%LPIV = 0 + ELSE + root%yes = .FALSE. + ENDIF + RETURN + END SUBROUTINE DMUMPS_164 + SUBROUTINE DMUMPS_165( N, root, FILS, IROOT, + & KEEP, INFO ) + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + TYPE ( DMUMPS_ROOT_STRUC ):: root + INTEGER N, IROOT, INFO(40), KEEP(500) + INTEGER FILS( N ) + INTEGER INODE, I, allocok + IF ( associated( root%RG2L_ROW ) ) DEALLOCATE( root%RG2L_ROW ) + IF ( associated( root%RG2L_COL ) ) DEALLOCATE( root%RG2L_COL ) + ALLOCATE( root%RG2L_ROW( N ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=N + RETURN + ENDIF + ALLOCATE( root%RG2L_COL( N ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=N + RETURN + ENDIF + INODE = IROOT + I = 1 + DO WHILE ( INODE .GT. 0 ) + root%RG2L_ROW( INODE ) = I + root%RG2L_COL( INODE ) = I + I = I + 1 + INODE = FILS( INODE ) + END DO + RETURN + END SUBROUTINE DMUMPS_165 + SUBROUTINE DMUMPS_99( NPROCS, NPROW, NPCOL, SIZE, K50 ) + IMPLICIT NONE + INTEGER NPROCS, NPROW, NPCOL, SIZE, K50 + INTEGER NPROWtemp, NPCOLtemp, NPROCSused, FLATNESS + LOGICAL KEEPIT + IF ( K50 .EQ. 1 ) THEN + FLATNESS = 2 + ELSE + FLATNESS = 3 + ENDIF + NPROW = int(sqrt(dble(NPROCS))) + NPROWtemp = NPROW + NPCOL = int(NPROCS / NPROW) + NPCOLtemp = NPCOL + NPROCSused = NPROWtemp * NPCOLtemp + 10 CONTINUE + IF ( NPROWtemp >= NPCOLtemp/FLATNESS .AND. NPROWtemp > 1) THEN + NPROWtemp = NPROWtemp - 1 + NPCOLtemp = int(NPROCS / NPROWtemp) + KEEPIT=.FALSE. + IF ( NPROWtemp * NPCOLtemp .GE. NPROCSused ) THEN + IF ( ( K50 .NE. 1 .AND. NPROWtemp >= NPCOLtemp/FLATNESS) + & .OR. NPROWtemp * NPCOLtemp .GT. NPROCSused ) + & KEEPIT=.TRUE. + END IF + IF ( KEEPIT ) THEN + NPROW = NPROWtemp + NPCOL = NPCOLtemp + NPROCSused = NPROW * NPCOL + END IF + GO TO 10 + END IF + RETURN + END SUBROUTINE DMUMPS_99 + SUBROUTINE DMUMPS_290(MYID, M, N, ASEQ, + & LOCAL_M, LOCAL_N, + & MBLOCK, NBLOCK, + & APAR, + & MASTER_ROOT, + & NPROW, NPCOL, + & COMM) + IMPLICIT NONE + INTEGER MYID, MASTER_ROOT, COMM + INTEGER M, N + INTEGER NPROW, NPCOL + INTEGER LOCAL_M, LOCAL_N + INTEGER MBLOCK, NBLOCK + DOUBLE PRECISION APAR( LOCAL_M, LOCAL_N ) + DOUBLE PRECISION ASEQ( M, N ) + INCLUDE 'mpif.h' + INTEGER I, J, SIZE_IBLOCK, SIZE_JBLOCK, IDEST, IROW, ICOL + INTEGER IBLOCK, JBLOCK, II, JJ, KK + INTEGER IAPAR, JAPAR, IERR + INTEGER STATUS(MPI_STATUS_SIZE) + DOUBLE PRECISION WK( MBLOCK * NBLOCK ) + LOGICAL JUPDATE + IAPAR = 1 + JAPAR = 1 + DO J = 1, N, NBLOCK + SIZE_JBLOCK = NBLOCK + IF ( J + NBLOCK > N ) THEN + SIZE_JBLOCK = N - J + 1 + END IF + JUPDATE = .FALSE. + DO I = 1, M, MBLOCK + SIZE_IBLOCK = MBLOCK + IF ( I + MBLOCK > M ) THEN + SIZE_IBLOCK = M - I + 1 + END IF + IBLOCK = I / MBLOCK + JBLOCK = J / NBLOCK + IROW = mod ( IBLOCK, NPROW ) + ICOL = mod ( JBLOCK, NPCOL ) + IDEST = IROW * NPCOL + ICOL + IF ( IDEST .NE. MASTER_ROOT ) THEN + IF ( MYID .EQ. MASTER_ROOT ) THEN + KK=1 + DO JJ=J,J+SIZE_JBLOCK-1 + DO II=I,I+SIZE_IBLOCK-1 + WK(KK)=ASEQ(II,JJ) + KK=KK+1 + END DO + END DO + CALL MPI_SSEND( WK, SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_DOUBLE_PRECISION, + & IDEST, 128, COMM, IERR ) + ELSE IF ( MYID .EQ. IDEST ) THEN + CALL MPI_RECV( WK(1), + & SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_DOUBLE_PRECISION, + & MASTER_ROOT,128,COMM,STATUS,IERR) + KK=1 + DO JJ=JAPAR,JAPAR+SIZE_JBLOCK-1 + DO II=IAPAR,IAPAR+SIZE_IBLOCK-1 + APAR(II,JJ)=WK(KK) + KK=KK+1 + END DO + END DO + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + ELSE IF ( MYID.EQ. MASTER_ROOT ) THEN + APAR( IAPAR:IAPAR+SIZE_IBLOCK-1, + & JAPAR:JAPAR+SIZE_JBLOCK-1 ) + & = ASEQ(I:I+SIZE_IBLOCK-1,J:J+SIZE_JBLOCK-1) + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + END DO + IF ( JUPDATE ) THEN + IAPAR = 1 + JAPAR = JAPAR + SIZE_JBLOCK + END IF + END DO + RETURN + END SUBROUTINE DMUMPS_290 + SUBROUTINE DMUMPS_156(MYID, M, N, ASEQ, + & LOCAL_M, LOCAL_N, + & MBLOCK, NBLOCK, + & APAR, + & MASTER_ROOT, + & NPROW, NPCOL, + & COMM) + IMPLICIT NONE + INTEGER MYID, MASTER_ROOT, COMM + INTEGER M, N + INTEGER NPROW, NPCOL + INTEGER LOCAL_M, LOCAL_N + INTEGER MBLOCK, NBLOCK + DOUBLE PRECISION APAR( LOCAL_M, LOCAL_N ) + DOUBLE PRECISION ASEQ( M, N ) + INCLUDE 'mpif.h' + INTEGER I, J, SIZE_IBLOCK, SIZE_JBLOCK, ISOUR, IROW, ICOL + INTEGER IBLOCK, JBLOCK, II, JJ, KK + INTEGER IAPAR, JAPAR, IERR + INTEGER STATUS(MPI_STATUS_SIZE) + DOUBLE PRECISION WK( MBLOCK * NBLOCK ) + LOGICAL JUPDATE + IAPAR = 1 + JAPAR = 1 + DO J = 1, N, NBLOCK + SIZE_JBLOCK = NBLOCK + IF ( J + NBLOCK > N ) THEN + SIZE_JBLOCK = N - J + 1 + END IF + JUPDATE = .FALSE. + DO I = 1, M, MBLOCK + SIZE_IBLOCK = MBLOCK + IF ( I + MBLOCK > M ) THEN + SIZE_IBLOCK = M - I + 1 + END IF + IBLOCK = I / MBLOCK + JBLOCK = J / NBLOCK + IROW = mod ( IBLOCK, NPROW ) + ICOL = mod ( JBLOCK, NPCOL ) + ISOUR = IROW * NPCOL + ICOL + IF ( ISOUR .NE. MASTER_ROOT ) THEN + IF ( MYID .EQ. MASTER_ROOT ) THEN + CALL MPI_RECV( WK(1), SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_DOUBLE_PRECISION, + & ISOUR, 128, COMM, STATUS, IERR ) + KK=1 + DO JJ=J,J+SIZE_JBLOCK-1 + DO II=I,I+SIZE_IBLOCK-1 + ASEQ(II,JJ)=WK(KK) + KK=KK+1 + END DO + END DO + ELSE IF ( MYID .EQ. ISOUR ) THEN + KK=1 + DO JJ=JAPAR,JAPAR+SIZE_JBLOCK-1 + DO II=IAPAR,IAPAR+SIZE_IBLOCK-1 + WK(KK)=APAR(II,JJ) + KK=KK+1 + END DO + END DO + CALL MPI_SSEND( WK( 1 ), + & SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_DOUBLE_PRECISION, + & MASTER_ROOT,128,COMM,IERR) + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + ELSE IF ( MYID.EQ. MASTER_ROOT ) THEN + ASEQ(I:I+SIZE_IBLOCK-1,J:J+SIZE_JBLOCK-1) + & = APAR( IAPAR:IAPAR+SIZE_IBLOCK-1, + & JAPAR:JAPAR+SIZE_JBLOCK-1 ) + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + END DO + IF ( JUPDATE ) THEN + IAPAR = 1 + JAPAR = JAPAR + SIZE_JBLOCK + END IF + END DO + RETURN + END SUBROUTINE DMUMPS_156 + SUBROUTINE DMUMPS_284(root, IROOT, N, + & IW, LIW, A, LA, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INTEGER MYID + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + TYPE (DMUMPS_ROOT_STRUC ) :: root + INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS + INTEGER IROOT, LIW, N, IWPOS, IWPOSCB + INTEGER IW( LIW ) + DOUBLE PRECISION A( LA ) + INTEGER PTRIST(KEEP(28)), STEP(N) + INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER PIMASTER(KEEP(28)) + INTEGER ITLOC( N + KEEP(253) ) + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER COMP, IFLAG, IERROR + INCLUDE 'mumps_headers.h' + INTEGER FILS( N ), PTRAIW(N), PTRARW( N ) + INTEGER INTARR(max(1,KEEP(14))) + DOUBLE PRECISION DBLARR(max(1,KEEP(13))) + INTEGER numroc + EXTERNAL numroc + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INTEGER(8) :: LREQA_ROOT + INTEGER LREQI_ROOT, LOCAL_M, LOCAL_N, allocok + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + IF (KEEP(253).GT.0) THEN + root%RHS_NLOC = numroc( KEEP(253), root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + root%RHS_NLOC = max(1, root%RHS_NLOC) + ELSE + root%RHS_NLOC = 1 + ENDIF + IF (associated( root%RHS_ROOT) ) + & DEALLOCATE (root%RHS_ROOT) + ALLOCATE(root%RHS_ROOT(LOCAL_M,root%RHS_NLOC), + & stat=allocok) + IF ( allocok.GT.0) THEN + IFLAG=-13 + IERROR = LOCAL_M*root%RHS_NLOC + RETURN + ENDIF + IF (KEEP(253).NE.0) THEN + root%RHS_ROOT = ZERO + CALL DMUMPS_760 ( N, FILS, + & root, KEEP, RHS_MUMPS, + & IFLAG, IERROR ) + IF ( IFLAG .LT. 0 ) RETURN + ENDIF + IF (KEEP(60) .NE. 0) THEN + PTRIST(STEP(IROOT)) = -6666666 + RETURN + ENDIF + LREQI_ROOT = 2 + KEEP(IXSZ) + LREQA_ROOT = int(LOCAL_M,8) * int(LOCAL_N,8) + IF (LREQA_ROOT.EQ.0_8) THEN + PTRIST(STEP(IROOT)) = -9999999 + RETURN + ENDIF + CALL DMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A,LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, LREQI_ROOT, + & LREQA_ROOT, IROOT, S_NOTFREE, .TRUE., COMP, + & LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + PTRIST ( STEP(IROOT) ) = IWPOSCB + 1 + PAMASTER( STEP(IROOT) ) = IPTRLU + 1_8 + IW( IWPOSCB + 1 + KEEP(IXSZ)) = - LOCAL_N + IW( IWPOSCB + 2 + KEEP(IXSZ)) = LOCAL_M + RETURN + END SUBROUTINE DMUMPS_284 + SUBROUTINE DMUMPS_760 + & ( N, FILS, root, KEEP, RHS_MUMPS, + & IFLAG, IERROR ) + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INTEGER N, KEEP(500), IFLAG, IERROR + INTEGER FILS(N) + TYPE (DMUMPS_ROOT_STRUC ) :: root + DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) + INTEGER JCOL, IPOS_ROOT, JPOS_ROOT, + & IROW_GRID, JCOL_GRID, ILOCRHS, JLOCRHS, + & INODE + INODE = KEEP(38) + DO WHILE (INODE.GT.0) + IPOS_ROOT = root%RG2L_ROW( INODE ) + IROW_GRID = mod( ( IPOS_ROOT - 1 ) / root%MBLOCK, root%NPROW ) + IF ( IROW_GRID .NE. root%MYROW ) GOTO 100 + ILOCRHS = root%MBLOCK * ( ( IPOS_ROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOS_ROOT - 1, root%MBLOCK ) + 1 + DO JCOL = 1, KEEP(253) + JPOS_ROOT = JCOL + JCOL_GRID = mod((JPOS_ROOT-1)/root%NBLOCK, root%NPCOL) + IF (JCOL_GRID.NE.root%MYCOL ) CYCLE + JLOCRHS = root%NBLOCK * ( ( JPOS_ROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOS_ROOT - 1, root%NBLOCK ) + 1 + root%RHS_ROOT(ILOCRHS, JLOCRHS) = + & RHS_MUMPS(INODE+(JCOL-1)*KEEP(254)) + ENDDO + 100 CONTINUE + INODE=FILS(INODE) + ENDDO + RETURN + END SUBROUTINE DMUMPS_760 + INTEGER FUNCTION DMUMPS_IXAMAX(n,x,incx) + DOUBLE PRECISION x(*) + integer incx,n + INTEGER idamax + DMUMPS_IXAMAX = idamax(n,x,incx) + return + END FUNCTION DMUMPS_IXAMAX + SUBROUTINE DMUMPS_XSYR( UPLO, N, ALPHA, X, INCX, A, LDA ) + CHARACTER UPLO + INTEGER INCX, LDA, N + DOUBLE PRECISION ALPHA + DOUBLE PRECISION A( LDA, * ), X( * ) + CALL dsyr( UPLO, N, ALPHA, X, INCX, A, LDA ) + RETURN + END SUBROUTINE DMUMPS_XSYR diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part7.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part7.F new file mode 100644 index 000000000..f6f8d9c00 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part7.F @@ -0,0 +1,1037 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE DMUMPS_635(N,KEEP,ICNTL,MPG) + IMPLICIT NONE + INTEGER N, KEEP(500), ICNTL(40), MPG + KEEP(19)=0 + RETURN + END SUBROUTINE DMUMPS_635 + SUBROUTINE DMUMPS_634(ICNTL,KEEP,MPG,INFO) + IMPLICIT NONE + INTEGER KEEP(500), MPG, INFO(40), ICNTL(40) + IF (KEEP(19).EQ.0.AND.KEEP(110).EQ.0) THEN + IF (KEEP(111).NE.0) THEN + INFO(1) = -37 + INFO(2) = 16 + IF (KEEP(110).EQ.0) INFO(2) = 24 + IF(MPG.GT.0) THEN + WRITE( MPG,'(A)') + &'** ERROR : Null space computation requirement' + WRITE( MPG,'(A)') + &'** not consistent with factorization options' + ENDIF + GOTO 333 + ENDIF + ENDIF + IF (ICNTL(9).NE.1) THEN + IF (KEEP(111).NE.0) THEN + INFO(1) = -37 + INFO(2) = 9 + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + &'** ERROR ICNTL(25) incompatible with ' + WRITE( MPG,'(A)') + &'** option transposed system (ICNLT(9)=1) ' + ENDIF + ENDIF + GOTO 333 + ENDIF + 333 CONTINUE + RETURN + END SUBROUTINE DMUMPS_634 + SUBROUTINE DMUMPS_637(id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (DMUMPS_STRUC) id + NULLIFY(id%root%QR_TAU) + RETURN + END SUBROUTINE DMUMPS_637 + SUBROUTINE DMUMPS_636(id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (DMUMPS_STRUC) id + IF (associated(id%root%QR_TAU)) THEN + DEALLOCATE(id%root%QR_TAU) + NULLIFY(id%root%QR_TAU) + ENDIF + RETURN + END SUBROUTINE DMUMPS_636 + SUBROUTINE DMUMPS_146( MYID, root, N, IROOT, + & COMM, IW, LIW, IFREE, + & A, LA, PTRAST, PTLUST_S, PTRFAC, + & STEP, INFO, LDLT, QR, + & WK, LWK, KEEP,KEEP8,DKEEP) + IMPLICIT NONE + INCLUDE 'dmumps_root.h' + INCLUDE 'mpif.h' + TYPE ( DMUMPS_ROOT_STRUC ) :: root + INTEGER N, IROOT, COMM, LIW, MYID, IFREE + INTEGER(8) :: LA + INTEGER(8) :: LWK + DOUBLE PRECISION WK( LWK ) + INTEGER KEEP(500) + DOUBLE PRECISION DKEEP(30) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PTLUST_S(KEEP(28)), STEP(N), IW( LIW ) + INTEGER INFO( 2 ), LDLT, QR + DOUBLE PRECISION A( LA ) + INTEGER IOLDPS + INTEGER(8) :: IAPOS + INTEGER LOCAL_M, LOCAL_N, LPIV, IERR, allocok + INTEGER FWD_LOCAL_N_RHS, FWD_MTYPE + INCLUDE 'mumps_headers.h' + EXTERNAL numroc + INTEGER numroc + IF ( .NOT. root%yes ) RETURN + IF ( KEEP(60) .NE. 0 ) THEN + IF ((LDLT == 1 .OR. LDLT == 2) .AND. KEEP(60) == 3 ) THEN + CALL DMUMPS_320( WK, root%MBLOCK, + & root%MYROW, root%MYCOL, root%NPROW, root%NPCOL, + & root%SCHUR_POINTER(1), + & root%SCHUR_LLD, root%SCHUR_NLOC, + & root%TOT_ROOT_SIZE, MYID, COMM ) + ENDIF + RETURN + ENDIF + IOLDPS = PTLUST_S(STEP(IROOT))+KEEP(IXSZ) + IAPOS = PTRAST(STEP(IROOT)) + LOCAL_M = IW( IOLDPS + 2 ) + LOCAL_N = IW( IOLDPS + 1 ) + IAPOS = PTRFAC(IW ( IOLDPS + 4 )) + IF ( LDLT.EQ.0 .OR. LDLT.EQ.2 .OR. QR.ne.0 ) THEN + LPIV = LOCAL_M + root%MBLOCK + ELSE + LPIV = 1 + END IF + IF (associated( root%IPIV )) DEALLOCATE(root%IPIV) + root%LPIV = LPIV + ALLOCATE( root%IPIV( LPIV ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LPIV + WRITE(*,*) MYID,': problem allocating IPIV(',LPIV,') in root' + CALL MUMPS_ABORT() + END IF + CALL DESCINIT( root%DESCRIPTOR(1), root%TOT_ROOT_SIZE, + & root%TOT_ROOT_SIZE, root%MBLOCK, root%NBLOCK, + & 0, 0, root%CNTXT_BLACS, LOCAL_M, IERR ) + IF ( LDLT.EQ.2 ) THEN + IF(root%MBLOCK.NE.root%NBLOCK) THEN + WRITE(*,*) ' Error: symmetrization only works for' + WRITE(*,*) ' square block sizes, MBLOCK/NBLOCK=', + & root%MBLOCK, root%NBLOCK + CALL MUMPS_ABORT() + END IF + IF ( LWK .LT. min( + & int(root%MBLOCK,8) * int(root%NBLOCK,8), + & int(root%TOT_ROOT_SIZE,8)* int(root%TOT_ROOT_SIZE,8 ) + & )) THEN + WRITE(*,*) 'Not enough workspace for symmetrization.' + CALL MUMPS_ABORT() + END IF + CALL DMUMPS_320( WK, root%MBLOCK, + & root%MYROW, root%MYCOL, root%NPROW, root%NPCOL, + & A( IAPOS ), LOCAL_M, LOCAL_N, + & root%TOT_ROOT_SIZE, MYID, COMM ) + END IF + IF (LDLT.EQ.0.OR.LDLT.EQ.2) THEN + CALL pdgetrf( root%TOT_ROOT_SIZE, root%TOT_ROOT_SIZE, + & A( IAPOS ), + & 1, 1, root%DESCRIPTOR(1), root%IPIV(1), IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-10 + INFO(2)=IERR-1 + END IF + ELSE + CALL pdpotrf('L',root%TOT_ROOT_SIZE,A(IAPOS), + & 1,1,root%DESCRIPTOR(1),IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-40 + INFO(2)=IERR-1 + END IF + END IF + IF (KEEP(258).NE.0) THEN + IF (root%MBLOCK.NE.root%NBLOCK) THEN + write(*,*) "Internal error in DMUMPS_146:", + & "Block size different for rows and columns", + & root%MBLOCK, root%NBLOCK + CALL MUMPS_ABORT() + ENDIF + CALL DMUMPS_763(root%MBLOCK, root%IPIV(1),root%MYROW, + & root%MYCOL, root%NPROW, root%NPCOL, A(IAPOS), LOCAL_M, + & LOCAL_N, root%TOT_ROOT_SIZE, MYID, DKEEP(6), KEEP(259), + & LDLT) + ENDIF + IF (KEEP(252) .NE. 0) THEN + FWD_LOCAL_N_RHS = numroc(KEEP(253), root%NBLOCK, + & root%MYCOL, 0, root%NPCOL) + FWD_LOCAL_N_RHS = max(1,FWD_LOCAL_N_RHS) + FWD_MTYPE = 1 + CALL DMUMPS_768( + & root%TOT_ROOT_SIZE, + & KEEP(253), + & FWD_MTYPE, + & A(IAPOS), + & root%DESCRIPTOR(1), + & LOCAL_M, LOCAL_N, FWD_LOCAL_N_RHS, + & root%IPIV(1), LPIV, + & root%RHS_ROOT(1,1), LDLT, + & root%MBLOCK, root%NBLOCK, + & root%CNTXT_BLACS, IERR) + ENDIF + RETURN + END SUBROUTINE DMUMPS_146 + SUBROUTINE DMUMPS_556( + & N,PIV,FRERE,FILS,NFSIZ,IKEEP, + & NCST,KEEP,KEEP8,id) + USE DMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (DMUMPS_STRUC) :: id + INTEGER N,NCST + INTEGER PIV(N),FRERE(N),FILS(N),NFSIZ(N),IKEEP(N,3) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER I,P11,P1,P2,K1,K2,NLOCKED + LOGICAL V1,V2 + NCST = 0 + NLOCKED = 0 + P11 = KEEP(93) + DO I=KEEP(93)-1,1,-2 + P1 = PIV(I) + P2 = PIV(I+1) + K1 = IKEEP(P1,1) + IF(K1 .GT. 0) THEN + V1 = (abs(id%A(K1))*(id%ROWSCA(P1)**2).GE.1.0D-1) + ELSE + V1 = .FALSE. + ENDIF + K2 = IKEEP(P2,1) + IF(K2 .GT. 0) THEN + V2 = (abs(id%A(K2))*(id%ROWSCA(P2)**2).GE.1.0D-1) + ELSE + V2 = .FALSE. + ENDIF + IF(V1 .AND. V2) THEN + PIV(P11) = P1 + P11 = P11 - 1 + PIV(P11) = P2 + P11 = P11 - 1 + ELSE IF(V1) THEN + NCST = NCST+1 + FRERE(NCST) = P1 + NCST = NCST+1 + FRERE(NCST) = P2 + ELSE IF(V2) THEN + NCST = NCST+1 + FRERE(NCST) = P2 + NCST = NCST+1 + FRERE(NCST) = P1 + ELSE + NLOCKED = NLOCKED + 1 + FILS(NLOCKED) = P1 + NLOCKED = NLOCKED + 1 + FILS(NLOCKED) = P2 + ENDIF + ENDDO + DO I=1,NLOCKED + PIV(I) = FILS(I) + ENDDO + KEEP(94) = KEEP(94) + KEEP(93) - NLOCKED + KEEP(93) = NLOCKED + DO I=1,NCST + NLOCKED = NLOCKED + 1 + PIV(NLOCKED) = FRERE(I) + ENDDO + DO I=1,KEEP(93)/2 + NFSIZ(I) = 0 + ENDDO + DO I=(KEEP(93)/2)+1,(KEEP(93)/2)+NCST,2 + NFSIZ(I) = I+1 + NFSIZ(I+1) = -1 + ENDDO + DO I=(KEEP(93)/2)+NCST+1,(KEEP(93)/2)+KEEP(94) + NFSIZ(I) = 0 + ENDDO + END SUBROUTINE DMUMPS_556 + SUBROUTINE DMUMPS_550(N,NCMP,N11,N22,PIV, + & INVPERM,PERM) + IMPLICIT NONE + INTEGER N11,N22,N,NCMP + INTEGER, intent(in) :: PIV(N),PERM(N) + INTEGER, intent (out):: INVPERM(N) + INTEGER CMP_POS,EXP_POS,I,J,N2,K + N2 = N22/2 + EXP_POS = 1 + DO CMP_POS=1,NCMP + J = PERM(CMP_POS) + IF(J .LE. N2) THEN + K = 2*J-1 + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + K = K+1 + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + ELSE + K = N2 + J + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + ENDIF + ENDDO + DO K=N22+N11+1,N + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + ENDDO + RETURN + END SUBROUTINE DMUMPS_550 + SUBROUTINE DMUMPS_547( + & N,NZ, IRN, ICN, PIV, + & NCMP, IW, LW, IPE, LEN, IQ, + & FLAG, ICMP, IWFR, + & IERROR, KEEP,KEEP8, ICNTL) + IMPLICIT NONE + INTEGER N,NZ,NCMP,LW,IWFR,IERROR + INTEGER ICNTL(40),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IRN(NZ),ICN(NZ),IW(LW),PIV(N),IPE(N+1) + INTEGER LEN(N),IQ(N),FLAG(N),ICMP(N) + INTEGER MP,N11,N22,NDUP + INTEGER I,K,J,N1,LAST,K1,K2,L + MP = ICNTL(2) + IERROR = 0 + N22 = KEEP(93) + N11 = KEEP(94) + NCMP = N22/2 + N11 + DO I=1,NCMP + IPE(I) = 0 + ENDDO + K = 1 + DO I=1,N22/2 + J = PIV(K) + ICMP(J) = I + K = K + 1 + J = PIV(K) + ICMP(J) = I + K = K + 1 + ENDDO + K = N22/2 + 1 + DO I=N22+1,N22+N11 + J = PIV(I) + ICMP(J) = K + K = K + 1 + ENDDO + DO I=N11+N22+1,N + J = PIV(I) + ICMP(J) = 0 + ENDDO + DO K=1,NZ + I = IRN(K) + J = ICN(K) + I = ICMP(I) + J = ICMP(J) + IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + IERROR = IERROR + 1 + ELSE + IF (I.NE.J) THEN + IPE(I) = IPE(I) + 1 + IPE(J) = IPE(J) + 1 + ENDIF + ENDIF + ENDDO + IQ(1) = 1 + N1 = NCMP - 1 + IF (N1.GT.0) THEN + DO I=1,N1 + IQ(I+1) = IPE(I) + IQ(I) + ENDDO + ENDIF + LAST = max(IPE(NCMP)+IQ(NCMP)-1,IQ(NCMP)) + DO I = 1,NCMP + FLAG(I) = 0 + IPE(I) = IQ(I) + ENDDO + DO K=1,LAST + IW(K) = 0 + ENDDO + IWFR = LAST + 1 + DO K=1,NZ + I = IRN(K) + J = ICN(K) + I = ICMP(I) + J = ICMP(J) + IF (I.NE.J) THEN + IF (I.LT.J) THEN + IF ((I.GE.1).AND.(J.LE.N)) THEN + IW(IQ(I)) = -J + IQ(I) = IQ(I) + 1 + ENDIF + ELSE + IF ((J.GE.1).AND.(I.LE.N)) THEN + IW(IQ(J)) = -I + IQ(J) = IQ(J) + 1 + ENDIF + ENDIF + ENDIF + ENDDO + NDUP = 0 + DO I=1,NCMP + K1 = IPE(I) + K2 = IQ(I) -1 + IF (K1.GT.K2) THEN + LEN(I) = 0 + IQ(I) = 0 + ELSE + DO K=K1,K2 + J = -IW(K) + IF (J.LE.0) GO TO 250 + L = IQ(J) + IQ(J) = L + 1 + IF (FLAG(J).EQ.I) THEN + NDUP = NDUP + 1 + IW(L) = 0 + IW(K) = 0 + ELSE + IW(L) = I + IW(K) = J + FLAG(J) = I + ENDIF + ENDDO + 250 IQ(I) = IQ(I) - IPE(I) + IF (NDUP.EQ.0) LEN(I) = IQ(I) + ENDIF + ENDDO + IF (NDUP.NE.0) THEN + IWFR = 1 + DO I=1,NCMP + K1 = IPE(I) + IF (IQ(I).EQ.0) THEN + LEN(I) = 0 + IPE(I) = IWFR + CYCLE + ENDIF + K2 = K1 + IQ(I) - 1 + L = IWFR + IPE(I) = IWFR + DO K=K1,K2 + IF (IW(K).NE.0) THEN + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + ENDIF + ENDDO + LEN(I) = IWFR - L + ENDDO + ENDIF + IPE(NCMP+1) = IPE(NCMP) + LEN(NCMP) + IWFR = IPE(NCMP+1) + RETURN + END SUBROUTINE DMUMPS_547 + SUBROUTINE DMUMPS_551( + & N, NE, IP, IRN, SCALING,LSC,CPERM, DIAG, + & ICNTL, WEIGHT,MARKED,FLAG, + & PIV_OUT, INFO) + IMPLICIT NONE + INTEGER N, NE, ICNTL(10), INFO(10),LSC + INTEGER CPERM(N),PIV_OUT(N),IP(N+1),IRN(NE), DIAG(N) + DOUBLE PRECISION SCALING(LSC),WEIGHT(N+2) + INTEGER MARKED(N),FLAG(N) + INTEGER NUM1,NUM2,NUMTOT,PATH_LENGTH,NLAST + INTEGER I,CUR_EL,CUR_EL_PATH,CUR_EL_PATH_NEXT,BEST_BEG + INTEGER L1,L2,PTR_SET1,PTR_SET2,TUP,T22 + DOUBLE PRECISION BEST_SCORE,CUR_VAL,TMP,VAL + DOUBLE PRECISION INITSCORE, DMUMPS_739, + & DMUMPS_740, DMUMPS_741 + LOGICAL VRAI,FAUX,MAX_CARD_DIAG,USE_SCALING + INTEGER SUM + DOUBLE PRECISION ZERO,ONE + PARAMETER (SUM = 1, VRAI = .TRUE., FAUX = .FALSE.) + PARAMETER(ZERO = 0.0D0, ONE = 1.0D0) + MAX_CARD_DIAG = .TRUE. + NUM1 = 0 + NUM2 = 0 + NUMTOT = 0 + NLAST = N + INFO = 0 + MARKED = 1 + FLAG = 0 + VAL = ONE + IF(LSC .GT. 1) THEN + USE_SCALING = .TRUE. + ELSE + USE_SCALING = .FALSE. + ENDIF + TUP = ICNTL(2) + IF(TUP .EQ. SUM) THEN + INITSCORE = ZERO + ELSE + INITSCORE = ONE + ENDIF + IF(ICNTL(2) .GT. 2 .OR. ICNTL(2) .LE. 0) THEN + WRITE(*,*) + & 'ERROR: WRONG VALUE FOR ICNTL(2) = ',ICNTL(2) + INFO(1) = -1 + RETURN + ENDIF + T22 = ICNTL(1) + IF(ICNTL(1) .LT. 0 .OR. ICNTL(1) .GT. 2) THEN + WRITE(*,*) + & 'ERROR: WRONG VALUE FOR ICNTL(1) = ',ICNTL(1) + INFO(1) = -1 + RETURN + ENDIF + DO CUR_EL=1,N + IF(MARKED(CUR_EL) .LE. 0) THEN + CYCLE + ENDIF + IF(CPERM(CUR_EL) .LT. 0) THEN + MARKED(CUR_EL) = -1 + CYCLE + ENDIF + PATH_LENGTH = 2 + CUR_EL_PATH = CPERM(CUR_EL) + IF(CUR_EL_PATH .EQ. CUR_EL) THEN + MARKED(CUR_EL) = -1 + CYCLE + ENDIF + MARKED(CUR_EL) = 0 + WEIGHT(1) = INITSCORE + WEIGHT(2) = INITSCORE + L1 = IP(CUR_EL+1)-IP(CUR_EL) + L2 = IP(CUR_EL_PATH+1)-IP(CUR_EL_PATH) + PTR_SET1 = IP(CUR_EL) + PTR_SET2 = IP(CUR_EL_PATH) + IF(USE_SCALING) THEN + VAL = -SCALING(CUR_EL_PATH) - SCALING(CUR_EL+N) + ENDIF + CUR_VAL = DMUMPS_741( + & CUR_EL,CUR_EL_PATH, + & IRN(PTR_SET1),IRN(PTR_SET2), + & L1,L2, + & VAL,DIAG,N,FLAG,FAUX,T22) + WEIGHT(PATH_LENGTH+1) = + & DMUMPS_739(WEIGHT(1),CUR_VAL,TUP) + DO + IF(CUR_EL_PATH .EQ. CUR_EL) EXIT + PATH_LENGTH = PATH_LENGTH+1 + MARKED(CUR_EL_PATH) = 0 + CUR_EL_PATH_NEXT = CPERM(CUR_EL_PATH) + L1 = IP(CUR_EL_PATH+1)-IP(CUR_EL_PATH) + L2 = IP(CUR_EL_PATH_NEXT+1)-IP(CUR_EL_PATH_NEXT) + PTR_SET1 = IP(CUR_EL_PATH) + PTR_SET2 = IP(CUR_EL_PATH_NEXT) + IF(USE_SCALING) THEN + VAL = -SCALING(CUR_EL_PATH_NEXT) + & - SCALING(CUR_EL_PATH+N) + ENDIF + CUR_VAL = DMUMPS_741( + & CUR_EL_PATH,CUR_EL_PATH_NEXT, + & IRN(PTR_SET1),IRN(PTR_SET2), + & L1,L2, + & VAL,DIAG,N,FLAG,VRAI,T22) + WEIGHT(PATH_LENGTH+1) = + & DMUMPS_739(WEIGHT(PATH_LENGTH-1),CUR_VAL,TUP) + CUR_EL_PATH = CUR_EL_PATH_NEXT + ENDDO + IF(mod(PATH_LENGTH,2) .EQ. 1) THEN + IF(WEIGHT(PATH_LENGTH+1) .GE. WEIGHT(PATH_LENGTH)) THEN + CUR_EL_PATH = CPERM(CUR_EL) + ELSE + CUR_EL_PATH = CUR_EL + ENDIF + DO I=1,(PATH_LENGTH-1)/2 + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + ENDDO + NUMTOT = NUMTOT + PATH_LENGTH - 1 + ELSE + IF(MAX_CARD_DIAG) THEN + CUR_EL_PATH = CPERM(CUR_EL) + IF(DIAG(CUR_EL) .NE. 0) THEN + BEST_BEG = CUR_EL_PATH + GOTO 1000 + ENDIF + DO I=1,(PATH_LENGTH/2) + CUR_EL_PATH_NEXT = CPERM(CUR_EL_PATH) + IF(DIAG(CUR_EL_PATH) .NE. 0) THEN + BEST_BEG = CUR_EL_PATH_NEXT + GOTO 1000 + ENDIF + ENDDO + ENDIF + BEST_BEG = CUR_EL + BEST_SCORE = WEIGHT(PATH_LENGTH-1) + CUR_EL_PATH = CPERM(CUR_EL) + DO I=1,(PATH_LENGTH/2)-1 + TMP = DMUMPS_739(WEIGHT(PATH_LENGTH), + & WEIGHT(2*I-1),TUP) + TMP = DMUMPS_740(TMP,WEIGHT(2*I),TUP) + IF(TMP .GT. BEST_SCORE) THEN + BEST_SCORE = TMP + BEST_BEG = CUR_EL_PATH + ENDIF + CUR_EL_PATH = CPERM(CUR_EL_PATH) + TMP = DMUMPS_739(WEIGHT(PATH_LENGTH+1), + & WEIGHT(2*I),TUP) + TMP = DMUMPS_740(TMP,WEIGHT(2*I+1),TUP) + IF(TMP .GT. BEST_SCORE) THEN + BEST_SCORE = TMP + BEST_BEG = CUR_EL_PATH + ENDIF + CUR_EL_PATH = CPERM(CUR_EL_PATH) + ENDDO + 1000 CUR_EL_PATH = BEST_BEG + DO I=1,(PATH_LENGTH/2)-1 + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + ENDDO + NUMTOT = NUMTOT + PATH_LENGTH - 2 + MARKED(CUR_EL_PATH) = -1 + ENDIF + ENDDO + DO I=1,N + IF(MARKED(I) .LT. 0) THEN + IF(DIAG(I) .EQ. 0) THEN + PIV_OUT(NLAST) = I + NLAST = NLAST - 1 + ELSE + NUM1 = NUM1 + 1 + PIV_OUT(NUM2+NUM1) = I + NUMTOT = NUMTOT + 1 + ENDIF + ENDIF + ENDDO + INFO(2) = NUMTOT + INFO(3) = NUM1 + INFO(4) = NUM2 + RETURN + END SUBROUTINE DMUMPS_551 + FUNCTION DMUMPS_739(A,B,T) + IMPLICIT NONE + DOUBLE PRECISION DMUMPS_739 + DOUBLE PRECISION A,B + INTEGER T + INTEGER SUM + PARAMETER(SUM = 1) + IF(T .EQ. SUM) THEN + DMUMPS_739 = A+B + ELSE + DMUMPS_739 = A*B + ENDIF + END FUNCTION DMUMPS_739 + FUNCTION DMUMPS_740(A,B,T) + IMPLICIT NONE + DOUBLE PRECISION DMUMPS_740 + DOUBLE PRECISION A,B + INTEGER T + INTEGER SUM + PARAMETER(SUM = 1) + IF(T .EQ. SUM) THEN + DMUMPS_740 = A-B + ELSE + DMUMPS_740 = A/B + ENDIF + END FUNCTION DMUMPS_740 + FUNCTION DMUMPS_741(CUR_EL,CUR_EL_PATH, + & SET1,SET2,L1,L2,VAL,DIAG,N,FLAG,FLAGON,T) + IMPLICIT NONE + DOUBLE PRECISION DMUMPS_741 + INTEGER CUR_EL,CUR_EL_PATH,L1,L2,N + INTEGER SET1(L1),SET2(L2),DIAG(N),FLAG(N) + DOUBLE PRECISION VAL + LOGICAL FLAGON + INTEGER T + INTEGER I,INTER,MERGE + INTEGER STRUCT,MA47 + PARAMETER(STRUCT=0,MA47=1) + IF(T .EQ. STRUCT) THEN + IF(.NOT. FLAGON) THEN + DO I=1,L1 + FLAG(SET1(I)) = CUR_EL + ENDDO + ENDIF + INTER = 0 + DO I=1,L2 + IF(FLAG(SET2(I)) .EQ. CUR_EL) THEN + INTER = INTER + 1 + FLAG(SET2(I)) = CUR_EL_PATH + ENDIF + ENDDO + MERGE = L1 + L2 - INTER + DMUMPS_741 = dble(INTER) / dble(MERGE) + ELSE IF (T .EQ. MA47) THEN + MERGE = 3 + IF(DIAG(CUR_EL) .NE. 0) MERGE = 2 + IF(DIAG(CUR_EL_PATH) .NE. 0) MERGE = MERGE - 2 + IF(MERGE .EQ. 0) THEN + DMUMPS_741 = dble(L1+L2-2) + DMUMPS_741 = -(DMUMPS_741**2)/2.0D0 + ELSE IF(MERGE .EQ. 1) THEN + DMUMPS_741 = - dble(L1+L2-4) * dble(L1-2) + ELSE IF(MERGE .EQ. 2) THEN + DMUMPS_741 = - dble(L1+L2-4) * dble(L2-2) + ELSE + DMUMPS_741 = - dble(L1-2) * dble(L2-2) + ENDIF + ELSE + DMUMPS_741 = VAL + ENDIF + RETURN + END FUNCTION + SUBROUTINE DMUMPS_622(NA, NCMP, + & INVPERM,PERM, + & LISTVAR_SCHUR, SIZE_SCHUR, AOTOA) + IMPLICIT NONE + INTEGER, INTENT(IN):: SIZE_SCHUR, LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER, INTENT(IN):: NA, NCMP + INTEGER, INTENT(IN):: AOTOA(NCMP), PERM(NCMP) + INTEGER, INTENT(OUT):: INVPERM(NA) + INTEGER CMP_POS, IO, I, K, IPOS + DO CMP_POS=1, NCMP + IO = PERM(CMP_POS) + INVPERM(AOTOA(IO)) = CMP_POS + ENDDO + IPOS = NCMP + DO K =1, SIZE_SCHUR + I = LISTVAR_SCHUR(K) + IPOS = IPOS+1 + INVPERM(I) = IPOS + ENDDO + RETURN + END SUBROUTINE DMUMPS_622 + SUBROUTINE DMUMPS_623 + & (NA,N,NZ, IRN, ICN, IW, LW, IPE, LEN, + & IQ, FLAG, IWFR, + & NRORM, NIORM, IFLAG,IERROR, ICNTL, + & symmetry, SYM, MedDens, NBQD, AvgDens, + & LISTVAR_SCHUR, SIZE_SCHUR, ATOAO, AOTOA) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NA,N,NZ,LW + INTEGER, INTENT(IN) :: SIZE_SCHUR, LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER, INTENT(IN) :: IRN(NZ), ICN(NZ) + INTEGER, INTENT(IN) :: ICNTL(40), SYM + INTEGER, INTENT(INOUT) :: IFLAG + INTEGER, INTENT(OUT) :: IERROR,NRORM,NIORM,IWFR + INTEGER, INTENT(OUT) :: AOTOA(N) + INTEGER, INTENT(OUT) :: ATOAO(NA) + INTEGER, INTENT(OUT) :: LEN(N), IPE(N+1) + INTEGER, INTENT(OUT) :: symmetry, + & MedDens, NBQD, AvgDens + INTEGER, INTENT(OUT) :: FLAG(N), IW(LW), IQ(N) + INTEGER MP, MPG + INTEGER I,K,J,N1,LAST,NDUP,K1,K2,L + INTEGER NBERR, THRESH, IAO + INTEGER NZOFFA, NDIAGA + DOUBLE PRECISION RSYM + INTRINSIC nint + ATOAO(1:NA) = 0 + DO I = 1, SIZE_SCHUR + ATOAO(LISTVAR_SCHUR(I)) = -1 + ENDDO + IAO = 0 + DO I= 1, NA + IF (ATOAO(I).LT.0) CYCLE + IAO = IAO +1 + ATOAO(I) = IAO + AOTOA(IAO) = I + ENDDO + MP = ICNTL(2) + MPG= ICNTL(3) + NIORM = 3*N + NDIAGA = 0 + IERROR = 0 + IPE(1:N+1) = 0 + DO K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.NA).OR.(J.GT.NA).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + IERROR = IERROR + 1 + ELSE + I = ATOAO(I) + J = ATOAO(J) + IF ((I.LT.0).OR.(J.LT.0)) CYCLE + IF (I.NE.J) THEN + IPE(I) = IPE(I) + 1 + IPE(J) = IPE(J) + 1 + NIORM = NIORM + 1 + ELSE + NDIAGA = NDIAGA + 1 + ENDIF + ENDIF + ENDDO + NZOFFA = NIORM - 3*N + IF (IERROR.GE.1) THEN + NBERR = 0 + IF (mod(IFLAG,2).EQ.0) IFLAG = IFLAG+1 + IF ((MP.GT.0).AND.(ICNTL(4).GE.2)) THEN + WRITE (MP,99999) + DO 70 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.NA).OR.(J.GT.NA).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + NBERR = NBERR + 1 + IF (NBERR.LE.10) THEN + IF (mod(K,10).GT.3 .OR. mod(K,10).EQ.0 .OR. + & (10.LE.K .AND. K.LE.20)) THEN + WRITE (MP,'(I8,A,I8,A,I8,A)') + & K,'th entry (in row',I,' and column',J,') ignored' + ELSE + IF (mod(K,10).EQ.1) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'st entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.2) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'nd entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.3) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'rd entry (in row',I,' and column',J,') ignored' + ENDIF + ELSE + GO TO 100 + ENDIF + ENDIF + 70 CONTINUE + ENDIF + ENDIF + 100 NRORM = NIORM - 2*N + IQ(1) = 1 + N1 = N - 1 + IF (N1.GT.0) THEN + DO 110 I=1,N1 + IQ(I+1) = IPE(I) + IQ(I) + 110 CONTINUE + ENDIF + LAST = max(IPE(N)+IQ(N)-1,IQ(N)) + FLAG(1:N) = 0 + IPE(1:N) = IQ(1:N) + IW(1:LAST) = 0 + IWFR = LAST + 1 + DO 200 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.NA).OR.(J.GT.NA).OR.(I.LT.1) + & .OR.(J.LT.1)) CYCLE + I = ATOAO(I) + J = ATOAO(J) + IF ((I.LT.0).OR.(J.LT.0)) CYCLE + IF (I.NE.J) THEN + IF (I.LT.J) THEN + IW(IQ(I)) = -J + IQ(I) = IQ(I) + 1 + ELSE + IW(IQ(J)) = -I + IQ(J) = IQ(J) + 1 + ENDIF + ENDIF + 200 CONTINUE + NDUP = 0 + DO 260 I=1,N + K1 = IPE(I) + K2 = IQ(I) -1 + IF (K1.GT.K2) THEN + LEN(I) = 0 + IQ(I) = 0 + ELSE + DO 240 K=K1,K2 + J = -IW(K) + IF (J.LE.0) GO TO 250 + L = IQ(J) + IQ(J) = L + 1 + IF (FLAG(J).EQ.I) THEN + NDUP = NDUP + 1 + IW(L) = 0 + IW(K) = 0 + ELSE + IW(L) = I + IW(K) = J + FLAG(J) = I + ENDIF + 240 CONTINUE + 250 IQ(I) = IQ(I) - IPE(I) + IF (NDUP.EQ.0) LEN(I) = IQ(I) + ENDIF + 260 CONTINUE + IF (NDUP.NE.0) THEN + IWFR = 1 + DO 280 I=1,N + IF (IQ(I).EQ.0) THEN + LEN(I) = 0 + IPE(I) = IWFR + GOTO 280 + ENDIF + K1 = IPE(I) + K2 = K1 + IQ(I) - 1 + L = IWFR + IPE(I) = IWFR + DO 270 K=K1,K2 + IF (IW(K).NE.0) THEN + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + ENDIF + 270 CONTINUE + LEN(I) = IWFR - L + 280 CONTINUE + ENDIF + IPE(N+1) = IPE(N) + LEN(N) + IWFR = IPE(N+1) + IF (SYM.EQ.0) THEN + RSYM = dble(NDIAGA+2*NZOFFA - (IWFR-1))/ + & dble(NZOFFA+NDIAGA) + symmetry = nint (100.0D0*RSYM) + IF (MPG .GT. 0) + & write(MPG,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + ELSE + symmetry = 100 + ENDIF + AvgDens = nint(dble(IWFR-1)/dble(N)) + THRESH = AvgDens*50 - AvgDens/10 + 1 + NBQD = 0 + IF (N.GT.2) THEN + IQ(1:N) = 0 + DO I= 1, N + K = max(LEN(I),1) + IQ(K) = IQ(K) + 1 + IF (K.GT.THRESH) NBQD = NBQD+1 + ENDDO + K = 0 + MedDens = 0 + DO WHILE (K .LT. (N/2)) + MedDens = MedDens + 1 + K = K+IQ(MedDens) + ENDDO + ELSE + MedDens = AvgDens + ENDIF + IF (MPG .GT. 0) + & write(MPG,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + RETURN +99999 FORMAT (/'*** Warning message from analysis routine ***') + END SUBROUTINE DMUMPS_623 + SUBROUTINE DMUMPS_549(N,PE,INVPERM,NFILS,WORK) + IMPLICIT NONE + INTEGER N + INTEGER PE(N),INVPERM(N),NFILS(N),WORK(N) + INTEGER I,FATHER,STKLEN,STKPOS,PERMPOS,CURVAR + NFILS = 0 + DO I=1,N + FATHER = -PE(I) + IF(FATHER .NE. 0) NFILS(FATHER) = NFILS(FATHER) + 1 + ENDDO + STKLEN = 0 + PERMPOS = 1 + DO I=1,N + IF(NFILS(I) .EQ. 0) THEN + STKLEN = STKLEN + 1 + WORK(STKLEN) = I + INVPERM(I) = PERMPOS + PERMPOS = PERMPOS + 1 + ENDIF + ENDDO + DO STKPOS = 1,STKLEN + CURVAR = WORK(STKPOS) + FATHER = -PE(CURVAR) + DO + IF(FATHER .EQ. 0) EXIT + IF(NFILS(FATHER) .EQ. 1) THEN + INVPERM(FATHER) = PERMPOS + FATHER = -PE(FATHER) + PERMPOS = PERMPOS + 1 + ELSE + NFILS(FATHER) = NFILS(FATHER) - 1 + EXIT + ENDIF + ENDDO + ENDDO + RETURN + END SUBROUTINE DMUMPS_549 + SUBROUTINE DMUMPS_548(N,PE,NV,WORK) + IMPLICIT NONE + INTEGER N + INTEGER PE(N),NV(N),WORK(N) + INTEGER I,FATHER,LEN,NEWSON,NEWFATHER + DO I=1,N + IF(NV(I) .GT. 0) CYCLE + LEN = 1 + WORK(LEN) = I + FATHER = -PE(I) + DO + IF(NV(FATHER) .GT. 0) THEN + NEWSON = FATHER + EXIT + ENDIF + LEN = LEN + 1 + WORK(LEN) = FATHER + NV(FATHER) = 1 + FATHER = -PE(FATHER) + ENDDO + NEWFATHER = -PE(FATHER) + PE(WORK(LEN)) = -NEWFATHER + PE(NEWSON) = -WORK(1) + ENDDO + END SUBROUTINE DMUMPS_548 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part8.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part8.F new file mode 100644 index 000000000..27bb8cc54 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_part8.F @@ -0,0 +1,7516 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE DMUMPS_301( id) + USE DMUMPS_STRUC_DEF + USE MUMPS_SOL_ES + USE DMUMPS_COMM_BUFFER + USE DMUMPS_OOC + USE TOOLS_COMMON + IMPLICIT NONE + INTERFACE + SUBROUTINE DMUMPS_710( id, NB_INT,NB_CMPLX ) + USE DMUMPS_STRUC_DEF + TYPE (DMUMPS_STRUC) :: id + INTEGER(8) :: NB_INT,NB_CMPLX + END SUBROUTINE DMUMPS_710 + SUBROUTINE DMUMPS_758 + &(idRHS, idINFO, idN, idNRHS, idLRHS) + DOUBLE PRECISION, DIMENSION(:), POINTER :: idRHS + INTEGER, intent(in) :: idN, idNRHS, idLRHS + INTEGER, intent(inout) :: idINFO(:) + END SUBROUTINE DMUMPS_758 + END INTERFACE + INCLUDE 'mpif.h' + INCLUDE 'mumps_headers.h' +#if defined(V_T) + INCLUDE 'VT.inc' +#endif + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER MASTER, IERR + PARAMETER( MASTER = 0 ) + TYPE (DMUMPS_STRUC), TARGET :: id + INTEGER MP,LP, MPG + LOGICAL PROK, PROKG + INTEGER MTYPE, ICNTL21 + LOGICAL LSCAL, ERANAL, GIVSOL + INTEGER ICNTL10, ICNTL11 + INTEGER I,K,JPERM, J, II, IZ2 + INTEGER IZ, NZ_THIS_BLOCK + INTEGER LIW + INTEGER(8) :: LA, LA_PASSED + INTEGER LIW_PASSED + INTEGER LWCB_MIN, LWCB, LWCB_SOL_C + INTEGER(8) :: TMP_LWCB8 + INTEGER DMUMPS_LBUF, DMUMPS_LBUF_INT + INTEGER MSG_MAX_BYTES_SOLVE, MSG_MAX_BYTES_GTHRSOL + INTEGER IBEG_ROOT_DEF, IEND_ROOT_DEF, + & IBEG_GLOB_DEF, IEND_GLOB_DEF, + & IROOT_DEF_RHS_COL1 + INTEGER NITREF, NOITER, SOLVET, KASE, JOBIREF + DOUBLE PRECISION RSOL(1) + LOGICAL INTERLEAVE_PAR, DO_PERMUTE_RHS + INTEGER :: NRHS_NONEMPTY + INTEGER :: STRAT_PERMAM1 + INTEGER :: K220(0:id%NSLAVES) + LOGICAL :: DO_NULL_PIV + INTEGER, DIMENSION(:), POINTER :: IRHS_PTR_COPY + INTEGER, DIMENSION(:), POINTER :: IRHS_SPARSE_COPY + DOUBLE PRECISION, DIMENSION(:), POINTER :: RHS_SPARSE_COPY + LOGICAL IRHS_SPARSE_COPY_ALLOCATED, IRHS_PTR_COPY_ALLOCATED, + & RHS_SPARSE_COPY_ALLOCATED + INTEGER :: NBCOL, COLSIZE, JBEG_RHS, JEND_RHS, JBEG_NEW, + & NBCOL_INBLOC, IPOS, NBT + INTEGER :: PERM_PIV_LIST(max(id%KEEP(112),1)) + INTEGER :: MAP_PIVNUL_LIST(max(id%KEEP(112),1)) + INTEGER, DIMENSION(:), ALLOCATABLE :: PERM_RHS + DOUBLE PRECISION ONE + DOUBLE PRECISION ZERO + PARAMETER( ONE = 1.0D0 ) + PARAMETER( ZERO = 0.0D0 ) + DOUBLE PRECISION RZERO, RONE + PARAMETER( RZERO = 0.0D0, RONE = 1.0D0 ) + DOUBLE PRECISION, DIMENSION(:), POINTER :: RHS_MUMPS + DOUBLE PRECISION, DIMENSION(:), POINTER :: WORK_WCB + DOUBLE PRECISION, DIMENSION(:), POINTER :: PTR_RHS_ROOT + INTEGER :: LPTR_RHS_ROOT + DOUBLE PRECISION, ALLOCATABLE :: SAVERHS(:), C_RW1(:), + & C_RW2(:), + & SRW3(:), C_Y(:), + & C_W(:) + DOUBLE PRECISION, ALLOCATABLE :: CWORK(:) + DOUBLE PRECISION, ALLOCATABLE :: R_RW1(:), R_Y(:), D(:) + DOUBLE PRECISION, ALLOCATABLE :: R_W(:) + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: R_LOCWK54 + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: C_LOCWK54 + INTEGER, DIMENSION(:), ALLOCATABLE :: UNS_PERM_INV, + & POSINRHSCOMP_N + INTEGER LIWK_SOLVE, LIWCB + INTEGER, ALLOCATABLE :: IW1(:), IWK_SOLVE(:), IWCB(:) + INTEGER(8) :: MAXS + DOUBLE PRECISION, DIMENSION(:), POINTER :: CNTL + INTEGER, DIMENSION (:), POINTER :: KEEP,ICNTL,INFO + INTEGER(8), DIMENSION (:), POINTER :: KEEP8 + INTEGER, DIMENSION (:), POINTER :: IS + DOUBLE PRECISION, DIMENSION(:),POINTER:: RINFOG + type scaling_data_t + SEQUENCE + DOUBLE PRECISION, dimension(:), pointer :: SCALING + DOUBLE PRECISION, dimension(:), pointer :: SCALING_LOC + end type scaling_data_t + type (scaling_data_t) :: scaling_data + DOUBLE PRECISION, DIMENSION(:), POINTER :: PT_SCALING + DOUBLE PRECISION, TARGET :: Dummy_SCAL(1) + DOUBLE PRECISION ARRET + DOUBLE PRECISION C_DUMMY(1) + DOUBLE PRECISION R_DUMMY(1) + INTEGER IDUMMY(1), JDUMMY(1), KDUMMY(1), LDUMMY(1), MDUMMY(1) + INTEGER, TARGET :: IDUMMY_TARGET(1) + DOUBLE PRECISION, TARGET :: CDUMMY_TARGET(1) + INTEGER JJ, WHAT + INTEGER allocok + INTEGER NBRHS, NBRHS_EFF, BEG_RHS, NB_RHSSKIPPED, + & IBEG, LD_RHS, KDEC, + & MASTER_ROOT, MASTER_ROOT_IN_COMM + INTEGER IPT_RHS_ROOT, SIZE_ROOT, LD_REDRHS + INTEGER IBEG_REDRHS, IBEG_RHSCOMP, LD_RHSCOMP, LENRHSCOMP + INTEGER NB_K133, IRANK, TSIZE + INTEGER KMAX_246_247 + LOGICAL WORKSPACE_MINIMAL_PREFERRED, WK_USER_PROVIDED + INTEGER(8) NB_BYTES + INTEGER(8) NB_BYTES_MAX + INTEGER(8) NB_BYTES_EXTRA + INTEGER(8) NB_INT, NB_CMPLX, K34_8, K35_8, NB_BYTES_ON_ENTRY + INTEGER(8) K16_8, ITMP8 +#if defined(V_T) + INTEGER soln_drive_class, glob_comm_ini, perm_scal_ini, soln_dist, + & soln_assem, perm_scal_post +#endif + LOGICAL I_AM_SLAVE, BUILD_POSINRHSCOMP + LOGICAL WORK_WCB_ALLOCATED, IS_INIT_OOC_DONE + LOGICAL STOP_AT_NEXT_EMPTY_COL + INTEGER MTYPE_LOC + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 +#if defined(V_T) + CALL VTCLASSDEF( 'Soln driver',soln_drive_class,IERR) + CALL VTFUNCDEF( 'glob_comm_ini',soln_drive_class, + & glob_comm_ini,IERR) + CALL VTFUNCDEF( 'perm_scal_ini',soln_drive_class, + & perm_scal_ini,IERR) + CALL VTFUNCDEF( 'soln_dist',soln_drive_class,soln_dist,IERR) + CALL VTFUNCDEF( 'soln_assem',soln_drive_class,soln_assem,IERR) + CALL VTFUNCDEF( 'perm_scal_post',soln_drive_class, + & perm_scal_post,IERR) +#endif + IRHS_PTR_COPY => IDUMMY_TARGET + IRHS_PTR_COPY_ALLOCATED = .FALSE. + IRHS_SPARSE_COPY => IDUMMY_TARGET + IRHS_SPARSE_COPY_ALLOCATED=.FALSE. + RHS_SPARSE_COPY => CDUMMY_TARGET + RHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(RHS_MUMPS) + NULLIFY(WORK_WCB) + IS_INIT_OOC_DONE = .FALSE. + WK_USER_PROVIDED = .FALSE. + WORK_WCB_ALLOCATED = .FALSE. + CNTL =>id%CNTL + KEEP =>id%KEEP + KEEP8=>id%KEEP8 + IS =>id%IS + ICNTL=>id%ICNTL + INFO =>id%INFO + RINFOG =>id%RINFOG + MP = ICNTL( 2 ) + MPG = ICNTL( 3 ) + LP = id%ICNTL( 1 ) + PROK = (MP.GT.0) + PROKG = (MPG.GT.0 .and. id%MYID.eq.MASTER) + IF ( PROK ) WRITE(MP,100) + IF ( PROKG ) WRITE(MPG,100) + NB_BYTES = 0_8 + NB_BYTES_MAX = 0_8 + NB_BYTES_EXTRA = 0_8 + K34_8 = int(KEEP(34), 8) + K35_8 = int(KEEP(35), 8) + K16_8 = int(KEEP(16), 8) + NB_RHSSKIPPED = 0 + LSCAL = .FALSE. + WORK_WCB_ALLOCATED = .FALSE. + ICNTL21 = -99998 + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & KEEP(46) .eq. 1 ) ) + CALL DMUMPS_710 (id, NB_INT,NB_CMPLX ) + NB_BYTES = NB_BYTES + NB_INT * K34_8 + NB_CMPLX * K35_8 + NB_BYTES_ON_ENTRY = NB_BYTES + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID .EQ. MASTER) THEN + CALL DMUMPS_807(id) + id%KEEP(111) = id%ICNTL(25) + id%KEEP(248) = id%ICNTL(20) + ICNTL21 = id%ICNTL(21) + IF (ICNTL21 .ne.0.and.ICNTL21.ne.1) ICNTL21=0 + IF ( id%ICNTL(30) .NE.0 ) THEN + id%KEEP(237) = 1 + ELSE + id%KEEP(237) = 0 + ENDIF + IF (id%KEEP(248) .eq.0.and. id%KEEP(237).ne.0) THEN + id%KEEP(248)=1 + ENDIF + IF (id%KEEP(248) .ne.0.and.id%KEEP(248).ne.1) id%KEEP(248)=0 + IF ((id%KEEP(221).EQ.2 ).AND.(id%KEEP(248).NE.0) ) THEN + id%KEEP(248) = 0 + ENDIF + IF ((id%KEEP(221).EQ.2 ).AND.(id%KEEP(235).NE.0) ) THEN + id%KEEP(235) = 0 + ENDIF + IF ( (id%KEEP(248).EQ.0).AND.(id%KEEP(111).EQ.0) ) THEN + id%KEEP(235) = 0 + ENDIF + MTYPE = ICNTL( 9 ) + IF (id%KEEP(237).NE.0) MTYPE = 1 + ENDIF + CALL MPI_BCAST(MTYPE,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST( id%KEEP(111), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( id%KEEP(248), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( ICNTL21, 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%KEEP(235), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( id%KEEP(221), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( id%NRHS,1, MPI_INTEGER, MASTER, id%COMM,IERR) + CALL MPI_BCAST( id%KEEP(237), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + IF ( id%MYID .EQ. MASTER ) THEN + IF (KEEP(201) .EQ. -1) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Solve impossible because factors not kept' + id%INFO(1)=-44 + id%INFO(2)=KEEP(251) + GOTO 333 + ELSE IF (KEEP(221).EQ.0 .AND. KEEP(251) .EQ. 2 + & .AND. KEEP(252).EQ.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Solve impossible because factors not kept' + id%INFO(1)=-44 + id%INFO(2)=KEEP(251) + GOTO 333 + ENDIF + IF (KEEP(252).NE.0 .AND. id%NRHS .NE. id%KEEP(253)) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: id%NRHS not allowed to change when ICNTL(32)=1' + id%INFO(1)=-42 + id%INFO(2)=id%KEEP(253) + GOTO 333 + ENDIF + IF (KEEP(252).NE.0 .AND. ICNTL(9).NE.1) THEN + INFO(1) = -43 + INFO(2) = 9 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Transpose system (ICNTL(9).NE.0) not ', + & ' compatible with forward performed during', + & ' factorization (ICNTL(32)=1)' + GOTO 333 + ENDIF + IF (KEEP(248) .NE. 0.AND.KEEP(252).NE.0) THEN + INFO(1) = -43 + IF (KEEP(237).NE.0) THEN + INFO(2) = 30 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ELSE + INFO(2) = 20 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: sparse RHS incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ENDIF + GOTO 333 + ENDIF + IF (KEEP(237) .NE. 0 .AND. ICNTL21.NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality is incompatible', + & ' with distributed solution.' + INFO(1)=-48 + INFO(2)=21 + GOTO 333 + ENDIF + IF (KEEP(237) .NE. 0 .AND. KEEP(60) .NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality is incompatible', + & ' with Schur.' + INFO(1)=-48 + INFO(2)=19 + GOTO 333 + ENDIF + IF (KEEP(237) .NE. 0 .AND. KEEP(111) .NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality is incompatible', + & ' with null space.' + INFO(1)=-48 + INFO(2)=25 + GOTO 333 + ENDIF + IF (id%NRHS .LE. 0) THEN + id%INFO(1)=-45 + id%INFO(2)=id%NRHS + GOTO 333 + ENDIF + IF ( (id%KEEP(237).EQ.0) ) THEN + IF ((id%KEEP(248) == 0 .AND.KEEP(221).NE.2) + & .OR. ICNTL21==0) THEN + CALL DMUMPS_758 + & (id%RHS,id%INFO,id%N,id%NRHS,id%LRHS) + IF (id%INFO(1) .LT. 0) GOTO 333 + ENDIF + ELSE + IF (id%NRHS .NE. id%N) THEN + id%INFO(1)=-47 + id%INFO(2)=id%NRHS + GOTO 333 + ENDIF + ENDIF + IF (id%KEEP(248) == 1) THEN + IF ((id%NZ_RHS.LE.0).AND.(KEEP(237).NE.0)) THEN + id%INFO(1)=-46 + id%INFO(2)=id%NZ_RHS + GOTO 333 + ENDIF + IF (( id%NZ_RHS .LE.0 ).AND.(KEEP(221).EQ.1)) THEN + id%INFO(1)=-46 + id%INFO(2)=id%NZ_RHS + GOTO 333 + ENDIF + IF ( .not. associated(id%RHS_SPARSE) )THEN + id%INFO(1)=-22 + id%INFO(2)=10 + GOTO 333 + ENDIF + IF ( .not. associated(id%IRHS_SPARSE) )THEN + id%INFO(1)=-22 + id%INFO(2)=11 + GOTO 333 + ENDIF + IF ( .not. associated(id%IRHS_PTR) )THEN + id%INFO(1)=-22 + id%INFO(2)=12 + GOTO 333 + ENDIF + IF (size(id%IRHS_PTR) < id%NRHS + 1) THEN + id%INFO(1)=-22 + id%INFO(2)=12 + GOTO 333 + END IF + IF (id%IRHS_PTR(id%NRHS + 1).ne.id%NZ_RHS+1) THEN + id%INFO(1)=-27 + id%INFO(2)=id%IRHS_PTR(id%NRHS+1) + GOTO 333 + END IF + IF (dble(id%N)*dble(id%NRHS).LT.dble(id%NZ_RHS)) THEN + IF (PROKG) THEN + write(MPG,*)id%MYID, + & " Incompatible values for sparse RHS ", + & " id%NZ_RHS,id%N,id%NRHS =", + & id%NZ_RHS,id%N,id%NRHS + ENDIF + id%INFO(1)=-22 + id%INFO(2)=11 + GOTO 333 + END IF + IF (id%IRHS_PTR(1).ne.1) THEN + id%INFO(1)=-28 + id%INFO(2)=id%IRHS_PTR(1) + GOTO 333 + END IF + IF (size(id%IRHS_SPARSE) < id%NZ_RHS) THEN + id%INFO(1)=-22 + id%INFO(2)=11 + GOTO 333 + END IF + IF (size(id%RHS_SPARSE) < id%NZ_RHS) THEN + id%INFO(1)=-22 + id%INFO(2)=10 + GOTO 333 + END IF + ENDIF + CALL DMUMPS_634(ICNTL(1),KEEP(1),MPG,INFO(1)) + IF (INFO(1) .LT. 0) GOTO 333 + IF (KEEP(111).eq.-1.AND.id%NRHS.NE.KEEP(112)+KEEP(17))THEN + INFO(1)=-32 + INFO(2)=id%NRHS + GOTO 333 + ENDIF + IF (KEEP(111).gt.0 .AND. id%NRHS .NE. 1) THEN + INFO(1)=-32 + INFO(2)=id%NRHS + GOTO 333 + ENDIF + IF (KEEP(111) .NE. 0 .AND. id%KEEP(50) .EQ. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: null space not available for unsymmetric matrices' + INFO(1) = -37 + INFO(2) = 0 + GOTO 333 + ENDIF + IF (KEEP(248) .NE.0.AND.KEEP(111).NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: ICNTL(20) and ICNTL(30) functionalities ', + & ' incompatible with null space' + INFO(1) = -37 + IF (KEEP(237).NE.0) THEN + INFO(2) = 30 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: ICNTL(30) functionality ', + & ' incompatible with null space' + ELSE + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: ICNTL(20) functionality ', + & ' incompatible with null space' + INFO(2) = 20 + ENDIF + GOTO 333 + ENDIF + IF (( KEEP(111) .LT. -1 ) .OR. + & (KEEP(111).GT.KEEP(112)+KEEP(17)) .OR. + & (KEEP(111) .EQ.-1 .AND. KEEP(112)+KEEP(17).EQ.0)) + & THEN + INFO(1)=-36 + INFO(2)=KEEP(111) + GOTO 333 + ENDIF + END IF + IF (ICNTL21==1) THEN + IF ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & id%KEEP(46) .eq. 1 ) ) THEN + IF ( id%LSOL_loc < id%KEEP(89) ) THEN + id%INFO(1)= -29 + id%INFO(2)= id%LSOL_loc + GOTO 333 + ENDIF + IF (id%KEEP(89) .NE. 0) THEN + IF ( .not. associated(id%ISOL_loc) )THEN + id%INFO(1)=-22 + id%INFO(2)=13 + GOTO 333 + ENDIF + IF ( .not. associated(id%SOL_loc) )THEN + id%INFO(1)=-22 + id%INFO(2)=14 + GOTO 333 + ENDIF + IF (size(id%ISOL_loc) < id%KEEP(89) ) THEN + id%INFO(1)=-22 + id%INFO(2)=13 + GOTO 333 + END IF + IF (size(id%SOL_loc) < + & (id%NRHS-1)*id%LSOL_loc+id%KEEP(89)) THEN + id%INFO(1)=-22 + id%INFO(2)=14 + GOTO 333 + END IF + ENDIF + ENDIF + ENDIF + IF (id%MYID .NE. MASTER) THEN + IF (id%KEEP(248) == 1) THEN + IF ( associated( id%RHS ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 7 + GOTO 333 + END IF + IF ( associated( id%RHS_SPARSE ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 10 + GOTO 333 + END IF + IF ( associated( id%IRHS_SPARSE ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 11 + GOTO 333 + END IF + IF ( associated( id%IRHS_PTR ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 12 + GOTO 333 + END IF + END IF + ENDIF + IF (id%MYID.EQ.MASTER) THEN + CALL DMUMPS_769(id) + END IF + IF (id%INFO(1) .LT. 0) GOTO 333 + 333 CONTINUE + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) GO TO 90 + IF ((id%KEEP(248).EQ.1).AND.(id%KEEP(237).EQ.0)) THEN + CALL MPI_BCAST(id%NZ_RHS,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + IF (id%NZ_RHS.EQ.0) THEN + IF ((ICNTL21.EQ.1).AND.(I_AM_SLAVE)) THEN + LIW_PASSED=max(1,KEEP(32)) + IF (KEEP(89) .GT. 0) THEN + CALL DMUMPS_535( MTYPE, id%ISOL_loc(1), + & id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%IS(1), LIW_PASSED,id%MYID_NODES, + & id%N, id%STEP(1), id%PROCNODE_STEPS(1), + & id%NSLAVES, scaling_data, LSCAL ) + DO J=1, id%NRHS + DO I=1, KEEP(89) + id%SOL_loc((J-1)*id%LSOL_loc + I) =ZERO + ENDDO + ENDDO + ENDIF + ENDIF + IF (ICNTL21.NE.1) THEN + IF (id%MYID.EQ.MASTER) THEN + DO J=1, id%NRHS + DO I=1, id%N + id%RHS((J-1)*id%LRHS + I) =ZERO + ENDDO + ENDDO + ENDIF + ENDIF + IF ( PROKG ) THEN + WRITE( MPG, 150 ) + & id%NRHS, ICNTL(27), ICNTL(9), ICNTL(10), ICNTL(11), + & ICNTL(20), ICNTL(21), ICNTL(30) + IF (KEEP(221).NE.0) THEN + WRITE (MPG, 152) KEEP(221) + ENDIF + IF (KEEP(252).GT.0) THEN + WRITE (MPG, 153) KEEP(252) + ENDIF + ENDIF + GOTO 90 + ENDIF + ENDIF + IF (id%MYID.EQ.MASTER) THEN + IF ((KEEP(111).NE.0)) THEN + KEEP(242) = 0 + ENDIF + ENDIF + INTERLEAVE_PAR =.FALSE. + DO_PERMUTE_RHS =.FALSE. + IF ((id%KEEP(235).NE.0).or.(id%KEEP(237).NE.0)) THEN + IF (id%KEEP(237).NE.0.AND. + & id%KEEP(248).EQ.0) THEN + IF (LP.GT.0) THEN + WRITE(LP,'(A,I4,I4)') + & ' Internal Error in solution driver (A-1) ', + & id%KEEP(237), id%KEEP(248) + ENDIF + CALL MUMPS_ABORT() + ENDIF + NBT = 0 + CALL MUMPS_733(id%Step2node, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%Step2node (Solve)', MEMCNT=NBT, ERRCODE=-13) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF (NBT.NE.0) THEN + DO I=1, id%N + IF (id%STEP(I).LE.0) CYCLE + id%Step2node(id%STEP(I)) = I + ENDDO + ENDIF + NB_BYTES = NB_BYTES + int(NBT,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + NB_BYTES_EXTRA = NB_BYTES_EXTRA + int(NBT,8) * K34_8 + ENDIF + IF ( I_AM_SLAVE ) + & CALL MUMPS_804(id%OOC_SIZE_OF_BLOCK, id%KEEP(201)) + DO_NULL_PIV = .TRUE. + NBCOL_INBLOC = -9998 + NZ_THIS_BLOCK= -9998 + JBEG_RHS = -9998 + IF (id%MYID.EQ.MASTER) THEN + IF( KEEP(111)==0 .AND. KEEP(248)==1 ) THEN + NRHS_NONEMPTY = 0 + DO I=1, id%NRHS + IF (id%IRHS_PTR(I).LT.id%IRHS_PTR(I+1)) + & NRHS_NONEMPTY = NRHS_NONEMPTY+1 + ENDDO + IF (NRHS_NONEMPTY.LE.0) THEN + IF (LP.GT.0) + & WRITE(LP,*) 'Internal error : NRHS_NONEMPTY=', + & NRHS_NONEMPTY + CALL MUMPS_ABORT() + ENDIF + ELSE + NRHS_NONEMPTY = id%NRHS + ENDIF + ENDIF + BUILD_POSINRHSCOMP = .TRUE. + IF (KEEP(221).EQ.2 .AND. KEEP(252).EQ.0) THEN + BUILD_POSINRHSCOMP = .FALSE. + ENDIF + SIZE_ROOT = -33333 + IF ( KEEP( 38 ) .ne. 0 ) THEN + MASTER_ROOT = MUMPS_275( + & id%PROCNODE_STEPS(id%STEP( KEEP(38))), + & id%NSLAVES ) + IF (id%MYID_NODES .eq. MASTER_ROOT) THEN + SIZE_ROOT = id%root%TOT_ROOT_SIZE + ELSE IF ((id%MYID.EQ.MASTER).AND.KEEP(60).NE.0) THEN + SIZE_ROOT=id%KEEP(116) + ENDIF + ELSE IF (KEEP( 20 ) .ne. 0 ) THEN + MASTER_ROOT = MUMPS_275( + & id%PROCNODE_STEPS(id%STEP(KEEP(20))), + & id%NSLAVES ) + IF (id%MYID_NODES .eq. MASTER_ROOT) THEN + SIZE_ROOT = id%IS( + & id%PTLUST_S(id%STEP(KEEP(20)))+KEEP(IXSZ) + 3) + ELSE IF ((id%MYID.EQ.MASTER).AND.KEEP(60).NE.0) THEN + SIZE_ROOT=id%KEEP(116) + ENDIF + ELSE + MASTER_ROOT = -44444 + END IF + IF (id%MYID .eq. MASTER) THEN + KEEP(84) = ICNTL(27) + IF (KEEP(252).NE.0) THEN + NBRHS = KEEP(253) + ELSE + IF (KEEP(201) .EQ. 0 .OR. KEEP(84) .GT. 0) THEN + NBRHS = abs(KEEP(84)) + ELSE + NBRHS = -2*KEEP(84) + END IF + IF (NBRHS .GT. NRHS_NONEMPTY ) NBRHS = NRHS_NONEMPTY + ENDIF + ENDIF +#if defined(V_T) + CALL VTBEGIN(glob_comm_ini,IERR) +#endif + CALL MPI_BCAST(NRHS_NONEMPTY,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(NBRHS,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + IF (KEEP(201).GT.0) THEN + IF (I_AM_SLAVE) THEN + IF (KEEP(201).EQ.1 + & .AND.KEEP(50).EQ.0 + & .AND.KEEP(251).NE.2 + & ) THEN + OOC_NB_FILE_TYPE=2 + ELSE + OOC_NB_FILE_TYPE=1 + ENDIF + ENDIF + WORKSPACE_MINIMAL_PREFERRED = .FALSE. + IF (id%MYID .eq. MASTER) THEN + KEEP(107) = max(0,KEEP(107)) + IF ((KEEP(107).EQ.0).AND. + & (KEEP(204).EQ.0).AND.(KEEP(211).NE.1) ) THEN + WORKSPACE_MINIMAL_PREFERRED=.TRUE. + ENDIF + ENDIF + CALL MPI_BCAST( KEEP(107), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(204), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(208), 2, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( WORKSPACE_MINIMAL_PREFERRED, 1, + & MPI_LOGICAL, + & MASTER, id%COMM, IERR ) + ENDIF + IF ( I_AM_SLAVE ) THEN + NB_K133 = 3 + IF ( KEEP( 38 ) .NE. 0 .OR. KEEP( 20 ) .NE. 0 ) THEN + IF ( MASTER_ROOT .eq. id%MYID_NODES ) THEN + IF ( + & .NOT. associated(id%root%RHS_CNTR_MASTER_ROOT) + & ) THEN + NB_K133 = NB_K133 + 1 + ENDIF + END IF + ENDIF + LWCB_MIN = NB_K133*KEEP(133)*NBRHS + WK_USER_PROVIDED = (id%LWK_USER.NE.0) + IF (id%LWK_USER.EQ.0) THEN + ITMP8 = 0_8 + ELSE IF (id%LWK_USER.GT.0) THEN + ITMP8= int(id%LWK_USER,8) + ELSE + ITMP8 = -int(id%LWK_USER,8)* 1000000_8 + ENDIF + IF (KEEP(201).EQ.0) THEN + IF (ITMP8.NE.KEEP8(24)) THEN + INFO(1) = -41 + INFO(2) = id%LWK_USER + GOTO 99 + ENDIF + ELSE + KEEP8(24)=ITMP8 + ENDIF + MAXS = 0_8 + IF (WK_USER_PROVIDED) THEN + MAXS = KEEP8(24) + IF (MAXS.LT. KEEP8(20)) THEN + INFO(1)= -11 + ITMP8 = KEEP8(20)+1_8-MAXS + CALL MUMPS_731(ITMP8, INFO(2)) + ENDIF + IF (INFO(1) .GE. 0 ) id%S => id%WK_USER(1:KEEP8(24)) + ELSE IF (associated(id%S)) THEN + MAXS = KEEP8(23) + ELSE + IF (KEEP(201).EQ.0) THEN + WRITE(*,*) ' Working array S not allocated ', + & ' on entry to solve phase (in core) ' + CALL MUMPS_ABORT() + ELSE + IF ( KEEP(209).EQ.-1 .AND. WORKSPACE_MINIMAL_PREFERRED) + & THEN + MAXS = KEEP8(20) + 1_8 + ELSE IF ( KEEP(209) .GE.0 ) THEN + MAXS = max(int(KEEP(209),8), KEEP8(20) + 1_8) + ELSE + MAXS = id%KEEP8(14) + ENDIF + ALLOCATE (id%S(MAXS), stat = allocok) + KEEP8(23)=MAXS + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) ' Problem allocation of S at solve' + INFO(1) = -13 + CALL MUMPS_731(MAXS, INFO(2)) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + NB_BYTES = NB_BYTES + KEEP8(23) * K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + ENDIF + IF(KEEP(201).EQ.0)THEN + LA = KEEP8(31) + ELSE + LA = MAXS + IF(MAXS.GT.KEEP8(31)+KEEP8(20)*int(KEEP(107)+1,8))THEN + LA=KEEP8(31)+KEEP8(20)*int(KEEP(107)+1,8) + ENDIF + ENDIF + IF ( MAXS-LA .GT. int(LWCB_MIN,8) ) THEN + TMP_LWCB8 = min( MAXS - LA, int(huge(LWCB),8) ) + LWCB = int( TMP_LWCB8, kind(LWCB) ) + WORK_WCB => id%S(LA+1_8:LA+TMP_LWCB8) + WORK_WCB_ALLOCATED=.FALSE. + ELSE + LWCB = LWCB_MIN + ALLOCATE(WORK_WCB(LWCB_MIN), stat = allocok) + IF (allocok < 0 ) THEN + INFO(1)=-13 + INFO(2)=LWCB_MIN + ENDIF + WORK_WCB_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(size(WORK_WCB),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + ENDIF + 99 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) < 0) GOTO 90 + IF ( I_AM_SLAVE ) THEN + IF (KEEP(201).GT.0) THEN + CALL DMUMPS_590(LA) + CALL DMUMPS_586(id) + IS_INIT_OOC_DONE = .TRUE. + ENDIF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) < 0) GOTO 90 + IF (id%MYID .eq. MASTER) THEN + IF ( (KEEP(242).NE.0) .or. (KEEP(243).NE.0) ) THEN + IF ( (KEEP(237) .EQ.0) .and. (KEEP(111).EQ.0) ) THEN + KEEP(242) = 0 + KEEP(243) = 0 + ENDIF + ENDIF + IF ( PROKG ) THEN + WRITE( MPG, 150 ) + & id%NRHS, NBRHS, ICNTL(9), ICNTL(10), ICNTL(11), + & ICNTL(20), ICNTL(21), ICNTL(30) + IF (KEEP(111).NE.0) THEN + WRITE (MPG, 151) KEEP(111) + ENDIF + IF (KEEP(221).NE.0) THEN + WRITE (MPG, 152) KEEP(221) + ENDIF + IF (KEEP(252).GT.0) THEN + WRITE (MPG, 153) KEEP(252) + ENDIF + ENDIF + LSCAL = (((KEEP(52) .GT. 0) .AND. (KEEP(52) .LE. 8)) .OR. ( + & KEEP(52) .EQ. -1) .OR. KEEP(52) .EQ. -2) + ERANAL = ((ICNTL(11) .GT. 0) .OR. (ICNTL(10) .GT. 0)) + IF ( (KEEP(55).eq.0) .AND. KEEP(54).eq.0 .AND. + & .NOT.associated(id%A) ) THEN + ICNTL10 = 0 + ICNTL11 = 0 + ERANAL = .FALSE. + ELSE + ICNTL10 = ICNTL(10) + ICNTL11 = ICNTL(11) + ENDIF + IF ((KEEP(111).NE.0).OR.(KEEP(237).NE.0).OR. + & (KEEP(252).NE.0) ) THEN + IF (ICNTL10 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(10) treated as if set to 0 ' + ENDIF + IF (ICNTL11 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(11) treated as if set to 0 ' + ENDIF + ICNTL10 = 0 + ICNTL11 = 0 + ERANAL = .FALSE. + END IF + IF (KEEP(221).NE.0) THEN + IF (ICNTL10 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(10) treated as if set to 0 (reduced RHS))' + ENDIF + IF (ICNTL11 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(11) treated as if set to 0 (reduced RHS)' + ENDIF + ICNTL10 = 0 + ICNTL11 = 0 + ERANAL = .FALSE. + END IF + IF ((ERANAL .AND. NBRHS > 1) .OR. ICNTL(21) > 0) THEN + IF (ICNTL11 > 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(11) treated as if set to zero' + ICNTL11=0 + ENDIF + IF (ICNTL10 > 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(10) treated as if set to zero' + ICNTL10=0 + ENDIF + ERANAL = .FALSE. + ENDIF + IF (ERANAL) THEN + ALLOCATE(SAVERHS(id%N*NBRHS),stat = allocok) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) ' Problem in solve: error allocating SAVERHS' + INFO(1) = -13 + INFO(2) = id%N*NBRHS + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(size(SAVERHS),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + IF (KEEP(237).NE.0 .AND.KEEP(111).NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: KEEP(237) treated as if set to 0 (null space)' + KEEP(237)=0 + ENDIF + IF (KEEP(242).EQ.0) KEEP(243)=0 + END IF + CALL MPI_BCAST(ICNTL10,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(ICNTL11,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(ICNTL21,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(ERANAL,1,MPI_LOGICAL,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(LSCAL,1,MPI_LOGICAL,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(KEEP(111),1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(KEEP(242),1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(KEEP(243),1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + DO_PERMUTE_RHS = (KEEP(242).NE.0) + IF ( KEEP(242).NE.0) THEN + IF ((KEEP(237).EQ.0).AND.(KEEP(111).EQ.0)) THEN + IF (MP.GT.0) THEN + write(MP,*) ' Warning incompatible options ', + & ' permute RHS reset to false ' + ENDIF + DO_PERMUTE_RHS = .FALSE. + ENDIF + ENDIF + IF ( (id%NSLAVES.GT.1) .AND. (KEEP(243).NE.0) + & ) THEN + IF ((KEEP(237).NE.0).or.(KEEP(111).GT.0)) THEN + INTERLEAVE_PAR= .TRUE. + ELSE + IF (PROKG) THEN + write(MPG,*) ' Warning incompatible options ', + & ' interleave RHS reset to false ' + ENDIF + ENDIF + ENDIF +#if defined(check) + IF ( id%MYID_NODES .EQ. MASTER ) THEN + WRITE(*,*) " ES A-1 DO_Perm Interleave =" + WRITE(*,144) id%KEEP(235), id%KEEP(237), + & id%KEEP(242),id%KEEP(243) + ENDIF +#endif + MSG_MAX_BYTES_SOLVE = ( 4 + KEEP(133) ) * KEEP(34) + + & KEEP(133) * NBRHS * KEEP(35) + & + 16 * KEEP(34) + IF (KEEP(237).EQ.0) THEN + KMAX_246_247 = max(KEEP(246),KEEP(247)) + MSG_MAX_BYTES_GTHRSOL = ( ( 2 + KMAX_246_247 ) * KEEP(34) + + & KMAX_246_247 * NBRHS * KEEP(35) ) + ELSE + MSG_MAX_BYTES_GTHRSOL = ( 3 * KEEP(34) + KEEP(35) ) + ENDIF + id%LBUFR_BYTES = max(MSG_MAX_BYTES_SOLVE, MSG_MAX_BYTES_GTHRSOL) + TSIZE = int(min(100_8*int(MSG_MAX_BYTES_GTHRSOL,8), + & 10000000_8)) + id%LBUFR_BYTES = max(id%LBUFR_BYTES,TSIZE) + id%LBUFR = ( id%LBUFR_BYTES + KEEP(34) - 1 ) / KEEP(34) + IF ( associated (id%BUFR) ) THEN + NB_BYTES = NB_BYTES - int(size(id%BUFR),8)*K34_8 + DEALLOCATE(id%BUFR) + NULLIFY(id%BUFR) + ENDIF + ALLOCATE (id%BUFR(id%LBUFR),stat=allocok) + IF ( allocok .GT. 0 ) THEN + IF (LP.GT.0) + & WRITE(LP,*) id%MYID, + & ' Problem in solve: error allocating BUFR' + INFO(1) = -13 + INFO(2) = id%LBUFR + GOTO 111 + ENDIF + NB_BYTES = NB_BYTES + int(size(id%BUFR),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( I_AM_SLAVE ) THEN + DMUMPS_LBUF_INT = ( 20 + id%NSLAVES * id%NSLAVES * 4 ) + & * KEEP(34) + CALL DMUMPS_55( DMUMPS_LBUF_INT, IERR ) + IF ( IERR .NE. 0 ) THEN + INFO(1) = -13 + INFO(2) = DMUMPS_LBUF_INT + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) id%MYID, + & ':Error allocating small Send buffer:IERR=',IERR + END IF + GOTO 111 + END IF + DMUMPS_LBUF = (MSG_MAX_BYTES_SOLVE + 2*KEEP(34) )*id%NSLAVES + DMUMPS_LBUF = min(DMUMPS_LBUF, 100 000 000) + DMUMPS_LBUF = max(DMUMPS_LBUF, + & (MSG_MAX_BYTES_SOLVE+2*KEEP(34)) * min(id%NSLAVES,3)) + DMUMPS_LBUF = DMUMPS_LBUF + KEEP(34) + CALL DMUMPS_53( DMUMPS_LBUF, IERR ) + IF ( IERR .NE. 0 ) THEN + INFO(1) = -13 + INFO(2) = DMUMPS_LBUF/KEEP(34) + 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) id%MYID, + & ':Error allocating Send buffer:IERR=', IERR + END IF + GOTO 111 + END IF + ENDIF + IF ( + & ( id%MYID .NE. MASTER ) + & .or. + & ( I_AM_SLAVE .AND. id%MYID .EQ. MASTER .AND. + & ICNTL21 .NE.0 .AND. + & ( KEEP(248).ne.0 .OR. KEEP(221).EQ.2 + & .OR. KEEP(111).NE.0 ) + & ) + & .or. + & ( id%MYID .EQ. MASTER .AND. (KEEP(237).NE.0) ) + & ) THEN + ALLOCATE(RHS_MUMPS(id%N*NBRHS),stat=IERR) + NB_BYTES = NB_BYTES + int(size(RHS_MUMPS),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N*NBRHS + IF (LP > 0) + & WRITE(LP,*) 'ERROR while allocating RHS on a slave' + GOTO 111 + END IF + ELSE + RHS_MUMPS=>id%RHS + ENDIF + IF ( I_AM_SLAVE ) THEN + LD_RHSCOMP = max(KEEP(89),1) + IF (id%MYID.EQ.MASTER) THEN + LD_RHSCOMP = max(LD_RHSCOMP, KEEP(247)) + ENDIF + IF (KEEP(221).EQ.2 .AND. KEEP(252).EQ.0) THEN + IF (.NOT.associated(id%RHSCOMP)) THEN + INFO(1) = -35 + INFO(2) = 1 + GOTO 111 + ENDIF + IF (.NOT.associated(id%POSINRHSCOMP)) THEN + INFO(1) = -35 + INFO(2) = 2 + GOTO 111 + ENDIF + LENRHSCOMP = size(id%RHSCOMP) + LD_RHSCOMP = LENRHSCOMP/id%NRHS + ELSE IF (KEEP(221).EQ.1) THEN + IF (associated(id%RHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8 + DEALLOCATE(id%RHSCOMP) + ENDIF + LENRHSCOMP = LD_RHSCOMP*id%NRHS + ALLOCATE (id%RHSCOMP(LENRHSCOMP)) + NB_BYTES = NB_BYTES + int(size(id%RHSCOMP),8)*K35_8 + IF (associated(id%POSINRHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%POSINRHSCOMP),8)*K34_8 + DEALLOCATE(id%POSINRHSCOMP) + ENDIF + ALLOCATE (id%POSINRHSCOMP(KEEP(28)) ) + NB_BYTES = NB_BYTES + int(size(id%POSINRHSCOMP),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ELSE + LENRHSCOMP = LD_RHSCOMP*NBRHS + IF (associated(id%RHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8 + DEALLOCATE(id%RHSCOMP) + NULLIFY(id%RHSCOMP) + ENDIF + ALLOCATE (id%RHSCOMP(LENRHSCOMP)) + NB_BYTES = NB_BYTES + int(size(id%RHSCOMP),8)*K35_8 + IF (associated(id%POSINRHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%POSINRHSCOMP),8)*K34_8 + DEALLOCATE(id%POSINRHSCOMP) + ENDIF + ALLOCATE (id%POSINRHSCOMP(KEEP(28)) ) + NB_BYTES = NB_BYTES + int(size(id%POSINRHSCOMP),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + LIWK_SOLVE = 4 * KEEP(28) + 1 + IF (KEEP(201).EQ.1) THEN + LIWK_SOLVE = LIWK_SOLVE + KEEP(228) + 1 + ELSE + LIWK_SOLVE = LIWK_SOLVE + 1 + ENDIF + ALLOCATE ( IWK_SOLVE( LIWK_SOLVE), stat = allocok ) + IF (allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=LIWK_SOLVE + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(LIWK_SOLVE,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + LIWCB = 20*NB_K133*2 + KEEP(133) + ALLOCATE ( IWCB( LIWCB), stat = allocok ) + IF (allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=LIWCB + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(LIWCB,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + LIW = KEEP(32) + ALLOCATE(SRW3(KEEP(133)), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=KEEP(133) + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(size(SRW3),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( (KEEP(111).NE.0) .OR. (KEEP(248).NE.0) ) THEN + ALLOCATE(POSINRHSCOMP_N(id%N), stat=allocok) + IF ( allocok .GT. 0 ) THEN + IF (LP.GT.0) WRITE(LP,*) + & ' ERROR in DMUMPS_301: allocating POSINRHSCOMP_N' + INFO(1) = -13 + INFO(2) = id%N + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(size(POSINRHSCOMP_N),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + END IF + ELSE + LIW=0 + END IF + IF (allocated(UNS_PERM_INV)) DEALLOCATE(UNS_PERM_INV) + IF ( ( id%MYID .eq. MASTER.AND.(KEEP(23).GT.0) .AND. + & (MTYPE .NE. 1).AND.(KEEP(248).NE.0) + & ) + & .OR. ( ( KEEP(237).NE.0 ) .AND. (KEEP(23).NE.0) ) + & ) THEN + ALLOCATE(UNS_PERM_INV(id%N),stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 111 + endif + NB_BYTES = NB_BYTES + int(id%N,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID.EQ.MASTER) THEN + DO I = 1, id%N + UNS_PERM_INV(id%UNS_PERM(I))=I + ENDDO + ENDIF + ELSE + ALLOCATE(UNS_PERM_INV(1), stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=1 + GOTO 111 + endif + NB_BYTES = NB_BYTES + 1_8*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + 111 CONTINUE +#if defined(V_T) + CALL VTEND(glob_comm_ini,IERR) +#endif + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF ( ( KEEP(237).NE.0 ) .AND. (KEEP(23).NE.0) ) THEN + CALL MPI_BCAST(UNS_PERM_INV,id%N,MPI_INTEGER,MASTER, + & id%COMM,IERR) + ENDIF + IF ( ICNTL21==1 ) THEN + IF (LSCAL) THEN + IF (id%MYID.NE.MASTER) THEN + IF (MTYPE == 1) THEN + ALLOCATE(id%COLSCA(id%N),stat=allocok) + ELSE + ALLOCATE(id%ROWSCA(id%N),stat=allocok) + ENDIF + IF (allocok > 0) THEN + IF (LP > 0) THEN + WRITE(LP,*) 'Error allocating temporary scaling array' + ENDIF + INFO(1)=-13 + INFO(2)=id%N + GOTO 40 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + IF (MTYPE == 1) THEN + CALL MPI_BCAST(id%COLSCA(1),id%N, + & MPI_DOUBLE_PRECISION,MASTER, + & id%COMM,IERR) + scaling_data%SCALING=>id%COLSCA + ELSE + CALL MPI_BCAST(id%ROWSCA(1),id%N, + & MPI_DOUBLE_PRECISION,MASTER, + & id%COMM,IERR) + scaling_data%SCALING=>id%ROWSCA + ENDIF + IF (I_AM_SLAVE) THEN + ALLOCATE(scaling_data%SCALING_LOC(id%KEEP(89)), + & stat=allocok) + IF (allocok > 0) THEN + IF (LP > 0) THEN + WRITE(LP,*) 'Error allocating local scaling array' + ENDIF + INFO(1)=-13 + INFO(2)=id%KEEP(89) + GOTO 40 + ENDIF + NB_BYTES = NB_BYTES + int(id%KEEP(89),8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + LIW_PASSED=max(1,LIW) + IF (KEEP(89) .GT. 0) THEN + CALL DMUMPS_535( MTYPE, id%ISOL_loc(1), + & id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%IS(1), LIW_PASSED,id%MYID_NODES, + & id%N, id%STEP(1), id%PROCNODE_STEPS(1), + & id%NSLAVES, scaling_data, LSCAL ) + ENDIF + IF (id%MYID.NE.MASTER .AND. LSCAL) THEN + IF (MTYPE == 1) THEN + DEALLOCATE(id%COLSCA) + NULLIFY(id%COLSCA) + ELSE + DEALLOCATE(id%ROWSCA) + NULLIFY(id%ROWSCA) + ENDIF + NB_BYTES = NB_BYTES - int(id%N,8)*K16_8 + ENDIF + ENDIF + IF (KEEP(23) .NE. 0 .AND. MTYPE==1) THEN + IF (id%MYID.NE.MASTER) THEN + ALLOCATE(id%UNS_PERM(id%N),stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 40 + ENDIF + ENDIF + ENDIF + 40 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF (KEEP(23) .NE. 0 .AND. MTYPE==1) THEN + CALL MPI_BCAST(id%UNS_PERM(1),id%N,MPI_INTEGER,MASTER, + & id%COMM,IERR) + IF (I_AM_SLAVE) THEN + DO I=1, KEEP(89) + id%ISOL_loc(I) = id%UNS_PERM(id%ISOL_loc(I)) + ENDDO + ENDIF + IF (id%MYID.NE.MASTER) THEN + DEALLOCATE(id%UNS_PERM) + NULLIFY(id%UNS_PERM) + ENDIF + ENDIF + ENDIF + IF ( ( KEEP(221) .EQ. 1 ) .OR. + & ( KEEP(221) .EQ. 2 ) + & ) THEN + IF (KEEP(46).EQ.1) THEN + MASTER_ROOT_IN_COMM=MASTER_ROOT + ELSE + MASTER_ROOT_IN_COMM =MASTER_ROOT+1 + ENDIF + IF ( id%MYID .EQ. MASTER ) THEN + IF (id%NRHS.EQ.1) THEN + LD_REDRHS = id%KEEP(116) + ELSE + LD_REDRHS = id%LREDRHS + ENDIF + ENDIF + IF (MASTER.NE.MASTER_ROOT_IN_COMM) THEN + IF ( id%MYID .EQ. MASTER ) THEN + CALL MPI_SEND(LD_REDRHS,1,MPI_INTEGER, + & MASTER_ROOT_IN_COMM, 0, id%COMM,IERR) + ELSEIF ( id%MYID.EQ.MASTER_ROOT_IN_COMM) THEN + CALL MPI_RECV(LD_REDRHS,1,MPI_INTEGER, + & MASTER, 0, id%COMM,STATUS,IERR) + ENDIF + ENDIF + ENDIF + IF ( KEEP(248)==1 ) THEN + JEND_RHS = 0 + IF (DO_PERMUTE_RHS) THEN + ALLOCATE(PERM_RHS(id%NRHS),stat=allocok) + IF (allocok > 0) THEN + INFO(1) = -13 + INFO(2) = id%NRHS + GOTO 109 + ENDIF + NB_BYTES = NB_BYTES + int(id%NRHS,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID.EQ.MASTER) THEN + STRAT_PERMAM1 = KEEP(242) + CALL MUMPS_780 + & (STRAT_PERMAM1, id%SYM_PERM(1), + & id%IRHS_PTR(1), id%NRHS+1, + & PERM_RHS, id%NRHS, + & IERR + & ) + ENDIF + ENDIF + ENDIF +109 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF (id%NSLAVES .EQ. 1) THEN + IF (DO_PERMUTE_RHS .AND. KEEP(111).NE.0 ) THEN + WRITE(*,*) id%MYID, ':INTERNAL ERROR 1 : ', + & ' PERMUTE RHS during null space computation ', + & ' not available yet ' + CALL MUMPS_ABORT() + ENDIF + ELSE + IF (DO_PERMUTE_RHS .AND. KEEP(111).NE.0 ) THEN + WRITE(*,*) id%MYID, ':INTERNAL ERROR 2 : ', + & ' PERMUTE RHS during null space computation ', + & ' not available yet ' + CALL MUMPS_ABORT() + ENDIF + IF (INTERLEAVE_PAR) THEN + IF ( KEEP(111).NE.0 ) THEN + WRITE(*,*) id%MYID, ':INTERNAL ERROR 3 : ', + & ' INTERLEAVE RHS during null space computation ', + & ' not available yet ' + CALL MUMPS_ABORT() + ELSE + IF (id%MYID.EQ.MASTER) THEN + CALL MUMPS_772 + & (PERM_RHS, id%NRHS, id%N, id%KEEP(28), + & id%PROCNODE_STEPS(1), id%STEP(1), id%NSLAVES, + & id%Step2node(1), + & IERR) + ENDIF + ENDIF + ENDIF + ENDIF + IF (DO_PERMUTE_RHS.AND.(KEEP(111).EQ.0)) THEN + CALL MPI_BCAST(PERM_RHS(1), + & id%NRHS, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + ENDIF + BEG_RHS=1 + DO WHILE (BEG_RHS.LE.NRHS_NONEMPTY) + NBRHS_EFF = min(NRHS_NONEMPTY-BEG_RHS+1, NBRHS) + IF (IRHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_SPARSE_COPY),8)*K34_8 + DEALLOCATE(IRHS_SPARSE_COPY) + IRHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_SPARSE_COPY) + ENDIF + IF (IRHS_PTR_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_PTR_COPY),8)*K34_8 + DEALLOCATE(IRHS_PTR_COPY) + IRHS_PTR_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_PTR_COPY) + ENDIF + IF (RHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(RHS_SPARSE_COPY),8)*K35_8 + DEALLOCATE(RHS_SPARSE_COPY) + RHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(RHS_SPARSE_COPY) + ENDIF + IF ( + & ( id%MYID .NE. MASTER ) + & .or. + & ( I_AM_SLAVE .AND. id%MYID .EQ. MASTER .AND. + & ICNTL21 .NE.0 .AND. + & ( KEEP(248).ne.0 .OR. KEEP(221).EQ.2 + & .OR. KEEP(111).NE.0 ) + & ) + & .or. + & ( id%MYID .EQ. MASTER .AND. (KEEP(237).NE.0) ) + & ) THEN + LD_RHS = id%N + IBEG = 1 + ELSE + IF ( associated(id%RHS) ) THEN + LD_RHS = max(id%LRHS, id%N) + ELSE + LD_RHS = id%N + ENDIF + IBEG = (BEG_RHS-1) * LD_RHS + 1 + ENDIF + JBEG_RHS = BEG_RHS + IF ( (id%MYID.EQ.MASTER) .AND. + & KEEP(248)==1 ) THEN + JBEG_RHS = JEND_RHS + 1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + DO WHILE ( id%IRHS_PTR(PERM_RHS(JBEG_RHS)) .EQ. + & id%IRHS_PTR(PERM_RHS(JBEG_RHS)+1) ) + IF ((KEEP(237).EQ.0).AND.(ICNTL21.EQ.0).AND. + & (KEEP(221).NE.1) ) THEN + DO I=1, id%N + RHS_MUMPS((PERM_RHS(JBEG_RHS) -1)*LD_RHS+I) + & = ZERO + ENDDO + ENDIF + JBEG_RHS = JBEG_RHS +1 + CYCLE + ENDDO + ELSE + DO WHILE( id%IRHS_PTR(JBEG_RHS) .EQ. + & id%IRHS_PTR(JBEG_RHS+1) ) + IF ((KEEP(237).EQ.0).AND.(ICNTL21.EQ.0).AND. + & (KEEP(221).NE.1)) THEN + DO I=1, id%N + RHS_MUMPS((JBEG_RHS -1)*LD_RHS + I) = ZERO + ENDDO + ENDIF + IF (KEEP(221).EQ.1) THEN + DO I = 1, id%SIZE_SCHUR + id%REDRHS((JBEG_RHS-1)*LD_REDRHS + I) = ZERO + ENDDO + ENDIF + JBEG_RHS = JBEG_RHS +1 + ENDDO + ENDIF + NB_RHSSKIPPED = JBEG_RHS - (JEND_RHS + 1) + IF ((KEEP(248).EQ.1).AND.(KEEP(237).EQ.0) + & .AND. (ICNTL21.EQ.0)) + & THEN + IBEG = (JBEG_RHS-1) * LD_RHS + 1 + ENDIF + ENDIF + CALL MPI_BCAST( JBEG_RHS,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + IF (id%MYID.EQ.MASTER .AND. KEEP(221).NE.0) THEN + IBEG_REDRHS= (JBEG_RHS-1)*LD_REDRHS + 1 + ELSE + IBEG_REDRHS=-142424 + ENDIF + IF ( I_AM_SLAVE ) THEN + IF ( KEEP(221).EQ.0 ) THEN + IBEG_RHSCOMP= 1 + ELSE + IBEG_RHSCOMP= (JBEG_RHS-1)*LD_RHSCOMP + 1 + ENDIF + ELSE + IBEG_RHSCOMP=-152525 + ENDIF +#if defined(V_T) + CALL VTBEGIN(perm_scal_ini,IERR) +#endif + IF (id%MYID .eq. MASTER) THEN + IF (KEEP(248)==1) THEN + NBCOL = 0 + NBCOL_INBLOC = 0 + NZ_THIS_BLOCK = 0 + STOP_AT_NEXT_EMPTY_COL = .FALSE. + DO I=JBEG_RHS, id%NRHS + NBCOL_INBLOC = NBCOL_INBLOC +1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + ELSE + COLSIZE = id%IRHS_PTR(I+1) - id%IRHS_PTR(I) + ENDIF + IF ((.NOT.STOP_AT_NEXT_EMPTY_COL).AND.(COLSIZE.GT.0).AND. + & (KEEP(237).EQ.0)) + & STOP_AT_NEXT_EMPTY_COL =.TRUE. + IF (COLSIZE.GT.0) THEN + NBCOL = NBCOL+1 + NZ_THIS_BLOCK = NZ_THIS_BLOCK + COLSIZE + ELSE IF (STOP_AT_NEXT_EMPTY_COL) THEN + NBCOL_INBLOC = NBCOL_INBLOC -1 + NBRHS_EFF = NBCOL + EXIT + ENDIF + IF (NBCOL.EQ.NBRHS_EFF) EXIT + ENDDO + IF (NBCOL.NE.NBRHS_EFF) THEN + WRITE(6,*) 'INTERNAL ERROR 1 in DMUMPS_301 ', + & NBCOL, NBRHS_EFF + call MUMPS_ABORT() + ENDIF + ALLOCATE(IRHS_PTR_COPY(NBCOL_INBLOC+1),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NBCOL_INBLOC+1 + GOTO 30 + endif + IRHS_PTR_COPY_ALLOCATED = .TRUE. + NB_BYTES = NB_BYTES + int(NBCOL_INBLOC+1,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + JEND_RHS =JBEG_RHS + NBCOL_INBLOC - 1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + IPOS = 1 + J = 0 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + J = J+1 + IRHS_PTR_COPY(J) = IPOS + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + IPOS = IPOS + COLSIZE + ENDDO + ELSE + IPOS = 1 + J = 0 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + J = J+1 + IRHS_PTR_COPY(J) = IPOS + COLSIZE = id%IRHS_PTR(I+1) + & - id%IRHS_PTR(I) + IPOS = IPOS + COLSIZE + ENDDO + ENDIF + IRHS_PTR_COPY(NBCOL_INBLOC+1)= IPOS + IF ( IPOS-1 .NE. NZ_THIS_BLOCK ) THEN + WRITE(*,*) "Error in compressed copy of IRHS_PTR" + IERR = 99 + call MUMPS_ABORT() + ENDIF + IF (KEEP(23) .NE. 0 .and. MTYPE .NE. 1) THEN + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 30 + endif + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ELSE + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (KEEP(237).NE.0)) THEN + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK), stat=allocok) + IF (allocok .GT.0 ) THEN + IERR = 99 + GOTO 30 + ENDIF + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( DO_PERMUTE_RHS.OR.INTERLEAVE_PAR ) THEN + IPOS = 1 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + IRHS_SPARSE_COPY(IPOS:IPOS+COLSIZE-1) = + & id%IRHS_SPARSE(id%IRHS_PTR(PERM_RHS(I)): + & id%IRHS_PTR(PERM_RHS(I)+1) -1) + IPOS = IPOS + COLSIZE + ENDDO + ELSE + IRHS_SPARSE_COPY = id%IRHS_SPARSE(id%IRHS_PTR(JBEG_RHS): + & id%IRHS_PTR(JBEG_RHS)+NZ_THIS_BLOCK-1) + ENDIF + ELSE + IRHS_SPARSE_COPY + & => + & id%IRHS_SPARSE(id%IRHS_PTR(JBEG_RHS): + & id%IRHS_PTR(JBEG_RHS)+NZ_THIS_BLOCK-1) + ENDIF + ENDIF + IF (LSCAL.OR.DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (KEEP(237).NE.0)) THEN + ALLOCATE(RHS_SPARSE_COPY(NZ_THIS_BLOCK), stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 30 + endif + RHS_SPARSE_COPY_ALLOCATED = .TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ELSE + IF ( KEEP(248)==1 ) THEN + RHS_SPARSE_COPY + & => id%RHS_SPARSE(id%IRHS_PTR(JBEG_RHS): + & id%IRHS_PTR(JBEG_RHS)+NZ_THIS_BLOCK-1) + ELSE + RHS_SPARSE_COPY + & => id%RHS_SPARSE(id%IRHS_PTR(BEG_RHS): + & id%IRHS_PTR(BEG_RHS)+NZ_THIS_BLOCK-1) + ENDIF + ENDIF + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (id%KEEP(237).NE.0)) THEN + IF (id%KEEP(237).NE.0) THEN + RHS_SPARSE_COPY = ONE + ELSE IF (.NOT. LSCAL) THEN + IPOS = 1 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + IF (COLSIZE .EQ. 0) CYCLE + RHS_SPARSE_COPY(IPOS:IPOS+COLSIZE-1) = + & id%RHS_SPARSE(id%IRHS_PTR(PERM_RHS(I)): + & id%IRHS_PTR(PERM_RHS(I)+1) -1) + IPOS = IPOS + COLSIZE + ENDDO + ENDIF + ENDIF + ENDIF + IF (KEEP(23) .NE. 0) THEN + IF (MTYPE .NE. 1) THEN + IF (KEEP(248)==0) THEN + ALLOCATE( C_RW2( id%N ),stat =allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) id%MYID, + & ':Error allocating C_RW2 in DMUMPS_SOLVE_DRIVE' + END IF + GOTO 30 + END IF + DO K = 1, NBRHS_EFF + KDEC = IBEG+(K-1)*LD_RHS + DO I = 1, id%N + C_RW2(I)=RHS_MUMPS(I-1+KDEC) + END DO + DO I = 1, id%N + JPERM = id%UNS_PERM(I) + RHS_MUMPS(I-1+KDEC) = C_RW2(JPERM) + END DO + END DO + DEALLOCATE(C_RW2) + ELSE + IPOS = 1 + DO I=1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(I+1) - IRHS_PTR_COPY(I) + DO K = 1, COLSIZE + JPERM = UNS_PERM_INV(IRHS_SPARSE_COPY(IPOS+K-1)) + IRHS_SPARSE_COPY(IPOS+K-1) = JPERM + ENDDO + IPOS = IPOS + COLSIZE + ENDDO + ENDIF + ENDIF + ENDIF + IF (ERANAL) THEN + IF ( KEEP(248) == 0 ) THEN + DO K = 1, NBRHS_EFF + KDEC = IBEG+(K-1)*LD_RHS + DO I = 1, id%N + SAVERHS(I+(K-1)*id%N) = RHS_MUMPS(KDEC+I-1) + END DO + ENDDO + ENDIF + ENDIF + IF (LSCAL) THEN + IF (KEEP(248)==0) THEN + IF (MTYPE .EQ. 1) THEN + DO K =1, NBRHS_EFF + KDEC = (K-1) * LD_RHS + IBEG - 1 + DO I = 1, id%N + RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) * + & id%ROWSCA(I) + END DO + ENDDO + ELSE + DO K =1, NBRHS_EFF + KDEC = (K-1) * LD_RHS + IBEG - 1 + DO I = 1, id%N + RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) * + & id%COLSCA(I) + END DO + ENDDO + ENDIF + ELSE + KDEC=id%IRHS_PTR(JBEG_RHS) + IF ((KEEP(248)==1) .AND. + & (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (id%KEEP(237).NE.0)) + & ) THEN + IPOS = 1 + J = 0 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + J = J+1 + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE .EQ. 0) CYCLE + IF (id%KEEP(237).NE.0) THEN + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + RHS_SPARSE_COPY(IPOS) = id%ROWSCA(PERM_RHS(I)) * + & ONE + ELSE + RHS_SPARSE_COPY(IPOS) = id%ROWSCA(I) * ONE + ENDIF + ELSE + DO K = 1, COLSIZE + II = id%IRHS_SPARSE(id%IRHS_PTR(PERM_RHS(I))+K-1) + IF (MTYPE.EQ.1) THEN + RHS_SPARSE_COPY(IPOS+K-1) = + & id%RHS_SPARSE(id%IRHS_PTR(PERM_RHS(I))+K-1)* + & id%ROWSCA(II) + ELSE + RHS_SPARSE_COPY(IPOS+K-1) = + & id%RHS_SPARSE(id%IRHS_PTR(PERM_RHS(I))+K-1)* + & id%COLSCA(II) + ENDIF + ENDDO + ENDIF + IPOS = IPOS + COLSIZE + ENDDO + ELSE + IF (MTYPE .eq. 1) THEN + DO IZ=1,NZ_THIS_BLOCK + I=IRHS_SPARSE_COPY(IZ) + RHS_SPARSE_COPY(IZ)=id%RHS_SPARSE(KDEC+IZ-1)* + & id%ROWSCA(I) + ENDDO + ELSE + DO IZ=1,NZ_THIS_BLOCK + I=IRHS_SPARSE_COPY(IZ) + RHS_SPARSE_COPY(IZ)=id%RHS_SPARSE(KDEC+IZ-1)* + & id%COLSCA(I) + ENDDO + ENDIF + ENDIF + ENDIF + END IF + ENDIF +#if defined(V_T) + CALL VTEND(perm_scal_ini,IERR) +#endif + 30 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF ( I_AM_SLAVE ) THEN + IF ( (KEEP(111).NE.0) .OR. (KEEP(248).NE.0) .OR. + & (KEEP(252).NE.0) ) THEN + IF (BUILD_POSINRHSCOMP) THEN + IF (KEEP(111).NE.0) THEN + WHAT = 2 + MTYPE_LOC = 1 + ELSE IF (KEEP(252).NE.0) THEN + WHAT = 0 + MTYPE_LOC = 1 + ELSE + WHAT = 1 + MTYPE_LOC = MTYPE + ENDIF + LIW_PASSED=max(1,LIW) + IF (WHAT.EQ.0) THEN + CALL DMUMPS_639(id%NSLAVES,id%N, + & id%MYID_NODES, id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%PROCNODE_STEPS(1), id%IS(1), LIW_PASSED, + & id%STEP(1), + & id%POSINRHSCOMP(1), IDUMMY, 1, MTYPE_LOC, + & WHAT ) + ELSE + CALL DMUMPS_639(id%NSLAVES,id%N, + & id%MYID_NODES, id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%PROCNODE_STEPS(1), id%IS(1), LIW_PASSED, + & id%STEP(1), + & id%POSINRHSCOMP(1), POSINRHSCOMP_N(1), + & id%N, MTYPE_LOC, + & WHAT ) + ENDIF + BUILD_POSINRHSCOMP = .FALSE. + ENDIF + ENDIF + ENDIF + IF (KEEP(248)==1) THEN + CALL MPI_BCAST( NBCOL_INBLOC,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + ELSE + NBCOL_INBLOC = NBRHS_EFF + ENDIF + JEND_RHS =JBEG_RHS + NBCOL_INBLOC - 1 + IF ((KEEP(248).EQ.1).AND.(KEEP(237).EQ.0)) THEN + CALL MPI_BCAST( NBRHS_EFF,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(NB_RHSSKIPPED,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + ENDIF +#if defined(V_T) + CALL VTBEGIN(soln_dist,IERR) +#endif + IF ((KEEP(111).eq.0).AND.(KEEP(252).EQ.0)) THEN + IF (KEEP(248) == 0) THEN + IF ( .NOT.I_AM_SLAVE ) THEN + CALL DMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & JDUMMY, id%KEEP(1), id%KEEP8(1), id%PROCNODE_STEPS(1), + & IDUMMY, 1, + & id%STEP(1), KDUMMY, 1, BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + BUILD_POSINRHSCOMP=.FALSE. + ELSE + LIW_PASSED = max( LIW, 1 ) + CALL DMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), + & IS(1), LIW_PASSED, + & id%STEP(1), id%POSINRHSCOMP(1), KEEP(28), + & BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + BUILD_POSINRHSCOMP=.FALSE. + ENDIF + IF (INFO(1).LT.0) GOTO 90 + ELSE + CALL MPI_BCAST( NZ_THIS_BLOCK,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + IF (id%MYID.NE.MASTER) THEN + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 45 + endif + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + ALLOCATE(RHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 45 + endif + RHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*(K34_8+K35_8) + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ALLOCATE(IRHS_PTR_COPY(NBCOL_INBLOC+1),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NBCOL_INBLOC+1 + GOTO 45 + endif + IRHS_PTR_COPY_ALLOCATED = .TRUE. + NB_BYTES = NB_BYTES + int(NBCOL_INBLOC+1,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + 45 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + CALL MPI_BCAST(IRHS_SPARSE_COPY(1), + & NZ_THIS_BLOCK, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(RHS_SPARSE_COPY(1), + & NZ_THIS_BLOCK, + & MPI_DOUBLE_PRECISION, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(IRHS_PTR_COPY(1), + & NBCOL_INBLOC+1, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + IF (IERR.GT.0) THEN + WRITE (*,*)'NOT OK FOR ALLOC PTR ON SLAVES' + call MUMPS_ABORT() + ENDIF + IF ( I_AM_SLAVE ) THEN + IF (KEEP(237).NE.0) THEN + K=1 + RHS_MUMPS(1:NBRHS_EFF*LD_RHS) = ZERO + IPOS = 1 + DO I = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(I+1) - IRHS_PTR_COPY(I) + IF (COLSIZE.GT.0) THEN + J = I - 1 + JBEG_RHS + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + J = PERM_RHS(J) + ENDIF + IF (POSINRHSCOMP_N(J).NE.0) THEN + RHS_MUMPS((K-1) * LD_RHS + J) = + & RHS_SPARSE_COPY(IPOS) + ENDIF + K = K + 1 + IPOS = IPOS + COLSIZE + ENDIF + ENDDO + IF (K.NE.NBRHS_EFF+1) THEN + WRITE(6,*) 'INTERNAL ERROR 2 in DMUMPS_301 ', + & K, NBRHS_EFF + call MUMPS_ABORT() + ENDIF + ELSE + IF ((KEEP(221).EQ.1).AND.(NB_RHSSKIPPED.GT.0)) THEN + DO K = JBEG_RHS-NB_RHSSKIPPED, JBEG_RHS-1 + DO I = 1, LD_RHSCOMP + id%RHSCOMP((K-1)*LD_RHSCOMP + I) = ZERO + ENDDO + ENDDO + ENDIF + DO K = 1, NBCOL_INBLOC + KDEC = (K-1) * LD_RHS + IBEG - 1 + RHS_MUMPS(KDEC+1:KDEC+id%N) = ZERO + DO IZ=IRHS_PTR_COPY(K), IRHS_PTR_COPY(K+1)-1 + I=IRHS_SPARSE_COPY(IZ) + IF (POSINRHSCOMP_N(I).NE.0) THEN + RHS_MUMPS(KDEC+I)= RHS_SPARSE_COPY(IZ) + ENDIF + ENDDO + ENDDO + END IF + ENDIF + ENDIF + ELSE IF (I_AM_SLAVE) THEN + IF (KEEP(111).NE.0) THEN + IF (KEEP(111).GT.0) THEN + IBEG_GLOB_DEF = KEEP(111) + IEND_GLOB_DEF = KEEP(111) + ELSE + IBEG_GLOB_DEF = BEG_RHS + IEND_GLOB_DEF = BEG_RHS+NBRHS_EFF-1 + ENDIF + IF ( id%KEEP(112) .GT. 0 .AND. DO_NULL_PIV) THEN + IF (IBEG_GLOB_DEF .GT.id%KEEP(112)) THEN + id%KEEP(235) = 0 + DO_NULL_PIV = .FALSE. + ENDIF + IF (IBEG_GLOB_DEF .LT.id%KEEP(112) + & .AND. IEND_GLOB_DEF .GT.id%KEEP(112) + & .AND. DO_NULL_PIV ) THEN + IEND_GLOB_DEF = id%KEEP(112) + id%KEEP(235) = 1 + DO_NULL_PIV = .FALSE. + ENDIF + ENDIF + IF (id%KEEP(235).NE.0) THEN + NZ_THIS_BLOCK=IEND_GLOB_DEF-IBEG_GLOB_DEF+1 + ALLOCATE(IRHS_PTR_COPY(NZ_THIS_BLOCK+1),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 50 + endif + IRHS_PTR_COPY_ALLOCATED = .TRUE. + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 50 + endif + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*(K34_8+K35_8) + & + K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID.eq.MASTER) THEN + II = 1 + DO I = IBEG_GLOB_DEF, IEND_GLOB_DEF + IRHS_PTR_COPY(I-IBEG_GLOB_DEF+1) = I + IF (INTERLEAVE_PAR .AND.(id%NSLAVES .GT. 1) )THEN + IRHS_SPARSE_COPY(II) = PERM_PIV_LIST(I) + ELSE + IRHS_SPARSE_COPY(II) = id%PIVNUL_LIST(I) + ENDIF + II = II +1 + ENDDO + IRHS_PTR_COPY(NZ_THIS_BLOCK+1) = NZ_THIS_BLOCK+1 + ENDIF + 50 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + CALL MPI_BCAST(IRHS_SPARSE_COPY(1), + & NZ_THIS_BLOCK, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(IRHS_PTR_COPY(1), + & NZ_THIS_BLOCK+1, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + RHS_MUMPS( IBEG : + & (IBEG + (NBRHS_EFF)*LD_RHS -1) ) = ZERO + ENDIF + DO K=1, NBRHS_EFF + KDEC = (K-1) *LD_RHSCOMP + id%RHSCOMP(KDEC+1:KDEC+LD_RHSCOMP)=ZERO + END DO + IF ((KEEP(235).NE.0).AND. INTERLEAVE_PAR) THEN + DO I=IBEG_GLOB_DEF,IEND_GLOB_DEF + IF (id%MYID_NODES .EQ. MAP_PIVNUL_LIST(I) ) THEN + JJ= POSINRHSCOMP_N(PERM_PIV_LIST(I)) + IF (JJ.GT.LD_RHSCOMP) THEN + WRITE(6,*) ' Internal ERROR JJ, LD_RHSCOMP=', + & JJ, LD_RHSCOMP + ENDIF + IF (JJ.GT.0) THEN + IF (KEEP(50).EQ.0) THEN + id%RHSCOMP(IBEG_RHSCOMP -1+ + & (I-IBEG_GLOB_DEF)*LD_RHSCOMP + JJ) = + & abs(id%DKEEP(2)) + ELSE + id%RHSCOMP(IBEG_RHSCOMP -1+ + & (I-IBEG_GLOB_DEF)*LD_RHSCOMP + JJ) = ONE + ENDIF + ENDIF + ENDIF + ENDDO + ELSE + DO I=max(IBEG_GLOB_DEF,KEEP(220)), + & min(IEND_GLOB_DEF,KEEP(220)+KEEP(109)-1) + JJ= POSINRHSCOMP_N(id%PIVNUL_LIST(I-KEEP(220)+1)) + IF (JJ.GT.0) THEN + IF (KEEP(50).EQ.0) THEN + id%RHSCOMP(IBEG_RHSCOMP-1+(I-IBEG_GLOB_DEF)*LD_RHSCOMP + & + JJ) = id%DKEEP(2) + ELSE + id%RHSCOMP(IBEG_RHSCOMP-1+(I-IBEG_GLOB_DEF)*LD_RHSCOMP + & + JJ) = ONE + ENDIF + ENDIF + ENDDO + ENDIF + IF ( KEEP(17).NE.0 .and. id%MYID_NODES.EQ.MASTER_ROOT) THEN + IBEG_ROOT_DEF = max(IBEG_GLOB_DEF,KEEP(112)+1) + IEND_ROOT_DEF = min(IEND_GLOB_DEF,KEEP(112)+KEEP(17)) + IROOT_DEF_RHS_COL1 = IBEG_ROOT_DEF-IBEG_GLOB_DEF + 1 + IBEG_ROOT_DEF = IBEG_ROOT_DEF-KEEP(112) + IEND_ROOT_DEF = IEND_ROOT_DEF-KEEP(112) + ELSE + IBEG_ROOT_DEF = -90999 + IEND_ROOT_DEF = -90999 + ENDIF + ELSE + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + LWCB_SOL_C = LWCB + IF ( id%MYID_NODES .EQ. MASTER_ROOT ) THEN + IF ( associated(id%root%RHS_CNTR_MASTER_ROOT) ) THEN + PTR_RHS_ROOT => id%root%RHS_CNTR_MASTER_ROOT + LPTR_RHS_ROOT = size(id%root%RHS_CNTR_MASTER_ROOT) + ELSE + LPTR_RHS_ROOT = NBRHS_EFF * SIZE_ROOT + IPT_RHS_ROOT = LWCB - LPTR_RHS_ROOT + 1 + PTR_RHS_ROOT => WORK_WCB(IPT_RHS_ROOT:LWCB) + LWCB_SOL_C = LWCB_SOL_C - LPTR_RHS_ROOT + ENDIF + ELSE + LPTR_RHS_ROOT = 1 + IPT_RHS_ROOT = LWCB + PTR_RHS_ROOT => WORK_WCB(IPT_RHS_ROOT:LWCB) + LWCB_SOL_C = LWCB_SOL_C - LPTR_RHS_ROOT + ENDIF + ENDIF + IF (KEEP(221) .EQ. 2 ) THEN + IF ( ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) .AND. + & ( id%MYID .EQ. MASTER ) ) THEN + II = 0 + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS -1 + DO I = 1, SIZE_ROOT + PTR_RHS_ROOT(II+I) = id%REDRHS(KDEC+I) + ENDDO + II = II+SIZE_ROOT + ENDDO + ELSE + IF ( id%MYID .EQ. MASTER) THEN + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + KDEC = IBEG_REDRHS + CALL MPI_SEND(id%REDRHS(KDEC), + & SIZE_ROOT*NBRHS_EFF, + & MPI_DOUBLE_PRECISION, + & MASTER_ROOT_IN_COMM, 0, id%COMM,IERR) + ELSE + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS + CALL MPI_SEND(id%REDRHS(KDEC),SIZE_ROOT, + & MPI_DOUBLE_PRECISION, + & MASTER_ROOT_IN_COMM, 0, id%COMM,IERR) + ENDDO + ENDIF + ELSE IF ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) THEN + II = 1 + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + CALL MPI_RECV(PTR_RHS_ROOT(II), + & SIZE_ROOT*NBRHS_EFF, + & MPI_DOUBLE_PRECISION, + & MASTER, 0, id%COMM,STATUS,IERR) + ELSE + DO K=1, NBRHS_EFF + CALL MPI_RECV(PTR_RHS_ROOT(II),SIZE_ROOT, + & MPI_DOUBLE_PRECISION, + & MASTER, 0, id%COMM,STATUS,IERR) + II = II + SIZE_ROOT + ENDDO + ENDIF + ENDIF + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + LIW_PASSED = max( LIW, 1 ) + LA_PASSED = max( LA, 1_8 ) + IF ((id%KEEP(235).EQ.0).and.(id%KEEP(237).EQ.0) ) THEN + PRUNED_SIZE_LOADED = 0_8 + CALL DMUMPS_245(id%root, id%N, id%S(1), LA_PASSED, + & IS(1), LIW_PASSED, WORK_WCB(1), LWCB_SOL_C, + & IWCB, LIWCB, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%NA(1),id%LNA,id%NE_STEPS(1), SRW3, MTYPE, + & ICNTL(1), id%STEP(1), id%FRERE_STEPS(1), + & id%DAD_STEPS(1), id%FILS(1), id%PTLUST_S(1), id%PTRFAC(1), + & IWK_SOLVE, LIWK_SOLVE, id%PROCNODE_STEPS(1), + & id%NSLAVES, INFO(1), KEEP(1), KEEP8(1), + & id%COMM_NODES, id%MYID, id%MYID_NODES, + & id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & IBEG_ROOT_DEF, IEND_ROOT_DEF, + & IROOT_DEF_RHS_COL1, + & PTR_RHS_ROOT(1), LPTR_RHS_ROOT, SIZE_ROOT, MASTER_ROOT, + & id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP, + & id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP + & , 1 , 1 , 1 + & , 1 + & , IDUMMY, 1, JDUMMY, KDUMMY, 1, LDUMMY, 1, MDUMMY + & ) + ELSE + IF ((KEEP(235).NE.0).AND.KEEP(221).NE.2.AND. + & KEEP(111).EQ.0) THEN + DO K=1, NBRHS_EFF + DO I=1, LD_RHSCOMP + id%RHSCOMP(IBEG_RHSCOMP+(K-1)*LD_RHSCOMP+I-1)= ZERO + ENDDO + ENDDO + ELSEIF (KEEP(237).NE.0) THEN + DO K=1, NBRHS_EFF + DO I=1, LD_RHSCOMP + id%RHSCOMP(IBEG_RHSCOMP+(K-1)*LD_RHSCOMP+I-1)= ZERO + ENDDO + ENDDO + ENDIF + IF (.NOT. allocated(PERM_RHS)) THEN + ALLOCATE(PERM_RHS(1),stat=allocok) + NB_BYTES = NB_BYTES + int(size(PERM_RHS),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + CALL DMUMPS_245(id%root, id%N, id%S(1), LA_PASSED, + & IS(1), LIW_PASSED, WORK_WCB(1), LWCB_SOL_C, IWCB, LIWCB, + & RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, id%NA(1),id%LNA, + & id%NE_STEPS(1), SRW3, MTYPE, ICNTL(1), id%STEP(1), + & id%FRERE_STEPS(1), id%DAD_STEPS(1), id%FILS(1), + & id%PTLUST_S(1), id%PTRFAC(1), IWK_SOLVE, LIWK_SOLVE, + & id%PROCNODE_STEPS(1), id%NSLAVES, INFO(1),KEEP(1),KEEP8(1), + & id%COMM_NODES, id%MYID, id%MYID_NODES, + & id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1, + & PTR_RHS_ROOT(1), LPTR_RHS_ROOT, SIZE_ROOT, MASTER_ROOT, + & id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP, + & id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP, + & NZ_THIS_BLOCK, NBCOL_INBLOC, id%NRHS, + & JBEG_RHS , id%Step2node(1), id%KEEP(28), IRHS_SPARSE_COPY(1), + & IRHS_PTR_COPY(1), + & size(PERM_RHS), PERM_RHS, size(UNS_PERM_INV), UNS_PERM_INV + & ) + ENDIF + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1).eq.-2) then + INFO(1)=-11 + IF (LP.GT.0) + & write(LP,*) + & ' WARNING : -11 error code obtained in solve' + END IF + IF (INFO(1).eq.-3) then + INFO(1)=-14 + IF (LP.GT.0) + & write(LP,*) + & ' WARNING : -14 error code obtained in solve' + END IF + IF (INFO(1).LT.0) GO TO 90 + IF ( KEEP(221) .EQ. 1 ) THEN + IF ( ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) .AND. + & ( id%MYID .EQ. MASTER ) ) THEN + II = 0 + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS -1 + DO I = 1, SIZE_ROOT + id%REDRHS(KDEC+I) = PTR_RHS_ROOT(II+I) + ENDDO + II = II+SIZE_ROOT + ENDDO + ELSE + IF ( id%MYID .EQ. MASTER ) THEN + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + KDEC = IBEG_REDRHS + CALL MPI_RECV(id%REDRHS(KDEC), + & SIZE_ROOT*NBRHS_EFF, + & MPI_DOUBLE_PRECISION, + & MASTER_ROOT_IN_COMM, 0, id%COMM, + & STATUS,IERR) + ELSE + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS + CALL MPI_RECV(id%REDRHS(KDEC),SIZE_ROOT, + & MPI_DOUBLE_PRECISION, + & MASTER_ROOT_IN_COMM, 0, id%COMM, + & STATUS,IERR) + ENDDO + ENDIF + ELSE IF ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) THEN + II = 1 + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + CALL MPI_SEND(PTR_RHS_ROOT(II), + & SIZE_ROOT*NBRHS_EFF, + & MPI_DOUBLE_PRECISION, + & MASTER, 0, id%COMM,IERR) + ELSE + DO K=1, NBRHS_EFF + CALL MPI_SEND(PTR_RHS_ROOT(II),SIZE_ROOT, + & MPI_DOUBLE_PRECISION, + & MASTER, 0, id%COMM,IERR) + II = II + SIZE_ROOT + ENDDO + ENDIF + ENDIF + ENDIF + ENDIF + IF ( KEEP(221) .NE. 1 ) THEN + IF (ICNTL21 == 0) THEN + IF ((.NOT. I_AM_SLAVE).AND.KEEP(237).EQ.0) THEN + ALLOCATE( CWORK(KEEP(247)*NBRHS_EFF), stat=allocok) + IF (allocok > 0) THEN + ALLOCATE( CWORK(KEEP(247)), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=KEEP(247) + ENDIF + ENDIF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1).LT.0) GO TO 90 + IF ((id%MYID.NE.MASTER).OR. .NOT.LSCAL) THEN + PT_SCALING => Dummy_SCAL + ELSE + IF (MTYPE.EQ.1) THEN + PT_SCALING => id%COLSCA + ELSE + PT_SCALING => id%ROWSCA + ENDIF + ENDIF + LIW_PASSED = max( LIW, 1 ) + IF ( .NOT.I_AM_SLAVE ) THEN + IF (KEEP(237).EQ.0) THEN + CALL DMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & JDUMMY, id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), IDUMMY, 1, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & CWORK(1), size(CWORK), + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & ) + DEALLOCATE( CWORK ) + ELSE + CALL DMUMPS_812(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%KEEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & ,IRHS_PTR_COPY(1), size(IRHS_PTR_COPY), + & IRHS_SPARSE_COPY(1), size(IRHS_SPARSE_COPY), + & RHS_SPARSE_COPY(1), size(RHS_SPARSE_COPY), + & UNS_PERM_INV, size(UNS_PERM_INV), IDUMMY, 1 + & ) + ENDIF + ELSE + IF (KEEP(237).EQ.0) THEN + CALL DMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), IS(1), LIW_PASSED, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%RHSCOMP(1), LENRHSCOMP, + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & ) + ELSE + CALL DMUMPS_812(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%KEEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & , IRHS_PTR_COPY(1), size(IRHS_PTR_COPY), + & IRHS_SPARSE_COPY(1), size(IRHS_SPARSE_COPY), + & RHS_SPARSE_COPY(1), size(RHS_SPARSE_COPY), + & UNS_PERM_INV, size(UNS_PERM_INV), POSINRHSCOMP_N, + & id%N + & ) + ENDIF + ENDIF + IF ( (id%MYID.EQ.MASTER).AND. (KEEP(237).NE.0) + & ) THEN + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + DO J = JBEG_RHS, JBEG_RHS+NBCOL_INBLOC-1 + COLSIZE = id%IRHS_PTR(PERM_RHS(J)+1) - + & id%IRHS_PTR(PERM_RHS(J)) + IF (COLSIZE.EQ.0) CYCLE + JJ = J-JBEG_RHS+1 + DO IZ= id%IRHS_PTR(PERM_RHS(J)), + & id%IRHS_PTR(PERM_RHS(J)+1)-1 + I = id%IRHS_SPARSE (IZ) + DO IZ2 = IRHS_PTR_COPY(JJ),IRHS_PTR_COPY(JJ+1)-1 + IF (IRHS_SPARSE_COPY(IZ2).EQ.I) EXIT + IF (IZ2.EQ.IRHS_PTR_COPY(JJ+1)-1) THEN + WRITE(6,*) " INTERNAL ERROR 1 gather sol_driver" + CALL MUMPS_ABORT() + ENDIF + ENDDO + id%RHS_SPARSE(IZ) = RHS_SPARSE_COPY(IZ2) + ENDDO + ENDDO + ELSE + DO J = JBEG_RHS, JBEG_RHS+NBCOL_INBLOC-1 + COLSIZE = id%IRHS_PTR(J+1) - id%IRHS_PTR(J) + IF (COLSIZE.EQ.0) CYCLE + JJ = J-JBEG_RHS+1 + DO IZ= id%IRHS_PTR(J), id%IRHS_PTR(J+1) - 1 + I = id%IRHS_SPARSE (IZ) + DO IZ2 = IRHS_PTR_COPY(JJ),IRHS_PTR_COPY(JJ+1)-1 + IF (IRHS_SPARSE_COPY(IZ2).EQ.I) EXIT + IF (IZ2.EQ.IRHS_PTR_COPY(JJ+1)-1) THEN + WRITE(6,*) " INTERNAL ERROR 2 gather sol_driver" + CALL MUMPS_ABORT() + ENDIF + ENDDO + id%RHS_SPARSE(IZ) = RHS_SPARSE_COPY(IZ2) + ENDDO + ENDDO + ENDIF + ENDIF + ELSE + IF ( I_AM_SLAVE ) THEN + LIW_PASSED = max( LIW, 1 ) + IF ( KEEP(89) .GT. 0 ) THEN + CALL DMUMPS_532(id%NSLAVES, + & id%N, id%MYID_NODES, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%ISOL_loc(1), + & id%SOL_loc(1), JBEG_RHS-NB_RHSSKIPPED, id%LSOL_loc, + & id%PTLUST_S(1), id%PROCNODE_STEPS(1), + & id%KEEP(1),id%KEEP8(1), + & IS(1), LIW_PASSED, + & id%STEP(1), scaling_data, LSCAL, NB_RHSSKIPPED ) + ENDIF + ENDIF + ENDIF + ENDIF + IF ( ICNTL10 > 0 .AND. NBRHS_EFF > 1 ) THEN + DO I = 1, ICNTL10 + write(*,*) 'FIXME: to be implemented' + END DO + END IF + IF (ERANAL) THEN + IF ((ICNTL10 .GT. 0) .AND. (ICNTL11 .GT. 0)) THEN + IF (id%MYID .EQ. MASTER) THEN + GIVSOL = .FALSE. + IF (MP .GT. 0) WRITE( MP, 170 ) + ALLOCATE(R_RW1(id%N),stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 776 + ENDIF + ALLOCATE(C_RW2(id%N),stat=allocok) + IF (allocok .GT.0) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 776 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + int(id%N,8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + END IF + 776 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + IF ( KEEP(54) .eq. 0 ) THEN + IF (id%MYID .EQ. MASTER) THEN + IF (KEEP(55).EQ.0) THEN + CALL DMUMPS_278( ICNTL(9), id%N, id%NZ, id%A(1), + & id%IRN(1), id%JCN(1), + & RHS_MUMPS(IBEG), SAVERHS, R_RW1, C_RW2, + & KEEP(1),KEEP8(1) ) + ELSE + CALL DMUMPS_121( ICNTL(9), id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & RHS_MUMPS(IBEG), SAVERHS, R_RW1, C_RW2, + & KEEP(1),KEEP8(1) ) + ENDIF + END IF + ELSE + CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N, + & MPI_DOUBLE_PRECISION, MASTER, + & id%COMM, IERR ) + ALLOCATE( C_LOCWK54( id%N ), stat =allocok ) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + endif + CALL MUMPS_276(ICNTL(1), INFO(1), id%COMM, id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL DMUMPS_192( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE ) + ELSE + C_LOCWK54 = ZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( C_LOCWK54, C_RW2, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + C_RW2 = SAVERHS - C_RW2 + ELSE + CALL MPI_REDUCE( C_LOCWK54, C_DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + NB_BYTES = NB_BYTES - int(size(C_LOCWK54),8)*K35_8 + DEALLOCATE( C_LOCWK54 ) + ALLOCATE( R_LOCWK54( id%N ), stat =allocok ) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + endif + CALL MUMPS_276(ICNTL(1), INFO(1), id%COMM, id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( I_AM_SLAVE .AND. id%NZ_loc .NE. 0 ) THEN + CALL DMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1)) + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_RW1, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + NB_BYTES = NB_BYTES - int(size(R_LOCWK54),8)*K16_8 + DEALLOCATE( R_LOCWK54 ) + END IF + IF ( id%MYID .EQ. MASTER ) THEN + CALL DMUMPS_205(ICNTL(9),INFO(1),id%N,id%NZ, + & RHS_MUMPS(IBEG), SAVERHS,R_RW1,C_RW2,GIVSOL, + & RSOL,RINFOG(4),RINFOG(5),RINFOG(6),MP,ICNTL(1), + & KEEP(1),KEEP8(1)) + NB_BYTES = NB_BYTES - int(size(R_RW1),8)*K16_8 + & - int(size(C_RW2),8)*K35_8 + DEALLOCATE(R_RW1) + DEALLOCATE(C_RW2) + END IF + END IF + IF ( PROK .AND. ICNTL10 .GT. 0 ) WRITE( MP, 270 ) + IF ( PROKG .AND. ICNTL10 .GT. 0 ) WRITE( MPG, 270 ) + ALLOCATE(R_Y(id%N), stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + ALLOCATE(C_Y(id%N), stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + IF ( id%MYID .EQ. MASTER ) THEN + ALLOCATE( IW1( 2 * id%N ),stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=2 * id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(2*id%N,8)*K34_8 + ALLOCATE( D(id%N),stat =allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + ALLOCATE( C_W(id%N), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + ALLOCATE( R_W(2*id%N), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(2*id%N,8)*K16_8 + NITREF = ICNTL10 + JOBIREF= ICNTL11 + IF ( PROKG .AND. ICNTL10 .GT. 0 ) + & WRITE( MPG, 240) 'MAXIMUM NUMBER OF STEPS =', NITREF + DO I = 1, id%N + D( I ) = RONE + END DO + END IF + ALLOCATE(C_LOCWK54(id%N),stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + ALLOCATE(R_LOCWK54(id%N),stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + KASE = 0 + 777 CONTINUE + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + 22 CONTINUE + IF ( KEEP(54) .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + IF ( KASE .eq. 0 ) THEN + IF (KEEP(55).NE.0) THEN + CALL DMUMPS_119(MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & R_W(id%N+1), KEEP(1),KEEP8(1) ) + ELSE + IF ( MTYPE .eq. 1 ) THEN + CALL DMUMPS_207 + & ( id%A(1), id%NZ, id%N, id%IRN(1), id%JCN(1), + & R_W(id%N+1), KEEP(1),KEEP8(1)) + ELSE + CALL DMUMPS_207 + & ( id%A(1), id%NZ, id%N, id%JCN(1), id%IRN(1), + & R_W(id%N+1), KEEP(1),KEEP8(1)) + END IF + ENDIF + ENDIF + END IF + ELSE + IF ( KASE .eq. 0 ) THEN + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + CALL DMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1) ) + ELSE + CALL DMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%JCN_loc(1), id%IRN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1) ) + END IF + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_W( id%N + 1 ), + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + END IF + END IF + IF ( id%MYID .eq. MASTER ) THEN + ARRET = CNTL(2) + IF (ARRET .LT. 0.0D0) THEN + ARRET = sqrt(epsilon(0.0D0)) + END IF + CALL DMUMPS_206(id%NZ,id%N,SAVERHS,RHS_MUMPS(IBEG), + & C_Y, D, R_W, C_W, + & IW1, KASE,RINFOG(7), + & RINFOG(9), JOBIREF, RINFOG(10), NITREF, NOITER, MP, + & KEEP(1),KEEP8(1), ARRET ) + END IF + IF ( KEEP(54) .ne. 0 ) THEN + CALL MPI_BCAST( KASE, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + END IF + IF ( KEEP(54) .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + IF ( KASE .eq. 14 ) THEN + IF (KEEP(55).NE.0) THEN + CALL DMUMPS_122( MTYPE, id%N, + & id%NELT, id%ELTPTR(1), id%LELTVAR, + & id%ELTVAR(1), id%NA_ELT, id%A_ELT(1), + & SAVERHS, RHS_MUMPS(IBEG), + & C_Y, R_W, KEEP(50)) + ELSE + IF ( MTYPE .eq. 1 ) THEN + CALL DMUMPS_208 + & (id%A(1), id%NZ, id%N, id%IRN(1), id%JCN(1), SAVERHS, + & RHS_MUMPS(IBEG), C_Y, R_W, KEEP(1),KEEP8(1)) + ELSE + CALL DMUMPS_208 + & (id%A(1), id%NZ, id%N, id%JCN(1), id%IRN(1), SAVERHS, + & RHS_MUMPS(IBEG), C_Y, R_W, KEEP(1),KEEP8(1)) + END IF + ENDIF + GOTO 22 + END IF + END IF + ELSE + IF ( KASE.eq.14 ) THEN + CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N, + & MPI_DOUBLE_PRECISION, MASTER, + & id%COMM, IERR ) + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL DMUMPS_192( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE ) + ELSE + C_LOCWK54 = ZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( C_LOCWK54, C_Y, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + C_Y = SAVERHS - C_Y + ELSE + CALL MPI_REDUCE( C_LOCWK54, C_DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + IF ( I_AM_SLAVE .and. id%NZ_loc .NE. 0 ) THEN + CALL DMUMPS_193( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), R_LOCWK54, KEEP(50), MTYPE ) + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_W, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM, MASTER, id%COMM, IERR) + END IF + GOTO 22 + END IF + END IF + IF ( id%MYID .eq. MASTER ) THEN + IF ( KASE .GT. 0 ) THEN + IF ( MTYPE .EQ. 1 ) THEN + SOLVET = KASE - 1 + ELSE + SOLVET = KASE + END IF + IF ( LSCAL ) THEN + IF ( SOLVET .EQ. 1 ) THEN + DO K = 1, id%N + C_Y( K ) = C_Y( K ) * id%ROWSCA( K ) + END DO + ELSE + DO K = 1, id%N + C_Y( K ) = C_Y( K ) * id%COLSCA( K ) + END DO + END IF + END IF + END IF + END IF + CALL MPI_BCAST( KASE , 1, MPI_INTEGER, MASTER, + & id%COMM, IERR) + CALL MPI_BCAST( SOLVET, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR) + IF ( KASE .GT. 0 ) THEN + BUILD_POSINRHSCOMP=.FALSE. + IF ( .NOT.I_AM_SLAVE ) THEN + CALL DMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, C_Y(1), id%N, 1, + & JDUMMY, id%KEEP(1), id%KEEP8(1), id%PROCNODE_STEPS(1), + & IDUMMY, 1, + & id%STEP(1), KDUMMY, 1, BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + ELSE + LIW_PASSED = max( LIW, 1 ) + CALL DMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, C_Y(1), id%N, 1, + & id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), + & IS(1), LIW_PASSED, + & id%STEP(1), id%POSINRHSCOMP(1), KEEP(28), + & BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + ENDIF + IF (INFO(1).LT.0) GOTO 89 + IF ( I_AM_SLAVE ) THEN + LIW_PASSED = max( LIW, 1 ) + LA_PASSED = max( LA, 1_8 ) + CALL DMUMPS_245( id%root, id%N, id%S(1), LA_PASSED, + & id%IS(1), LIW_PASSED, WORK_WCB(1), LWCB_SOL_C, IWCB, LIWCB, C_Y, + & id%N, NBRHS_EFF, id%NA(1), id%LNA, id%NE_STEPS(1), SRW3, SOLVET, + & ICNTL(1), id%STEP(1), id%FRERE_STEPS(1), id%DAD_STEPS(1), id% + & FILS(1), id%PTLUST_S(1), id%PTRFAC(1), IWK_SOLVE(1), LIWK_SOLVE, + & id%PROCNODE_STEPS(1), id%NSLAVES, INFO(1), KEEP(1), KEEP8(1), + & id%COMM_NODES, id%MYID, id%MYID_NODES, id%BUFR(1), id%LBUFR, + & id%LBUFR_BYTES, id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1, + & PTR_RHS_ROOT(1), LPTR_RHS_ROOT, SIZE_ROOT, MASTER_ROOT, + & id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP, + & id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP + & , 1 , 1 , 1 + & , 1 + & , IDUMMY, 1, JDUMMY, KDUMMY, 1, LDUMMY, 1, MDUMMY + & ) + END IF + IF (INFO(1).eq.-2) INFO(1)=-12 + IF (INFO(1).eq.-3) INFO(1)=-15 + IF ( .NOT. I_AM_SLAVE .AND. INFO(1) .GE. 0) THEN + ALLOCATE( CWORK(KEEP(247)*NBRHS_EFF), stat=allocok) + IF (allocok > 0) THEN + ALLOCATE( CWORK(KEEP(247)), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=KEEP(247) + ENDIF + ENDIF + ENDIF + 89 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1).LT.0) GO TO 90 + IF ((id%MYID.NE.MASTER).OR. .NOT.LSCAL) THEN + PT_SCALING => Dummy_SCAL + ELSE + IF (SOLVET.EQ.1) THEN + PT_SCALING => id%COLSCA + ELSE + PT_SCALING => id%ROWSCA + ENDIF + ENDIF + LIW_PASSED = max( LIW, 1 ) + IF ( .NOT. I_AM_SLAVE ) THEN + CALL DMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & SOLVET, C_Y, id%N, NBRHS_EFF, + & JDUMMY, id%KEEP(1),id%KEEP8(1), id%PROCNODE_STEPS(1), + & IDUMMY, 1, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & CWORK, size(CWORK), + & LSCAL, PT_SCALING(1), size(PT_SCALING)) + DEALLOCATE( CWORK ) + ELSE + CALL DMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & SOLVET, C_Y, id%N, NBRHS_EFF, + & id%PTLUST_S(1), id%KEEP(1),id%KEEP8(1), + & id%PROCNODE_STEPS(1), + & IS(1), LIW_PASSED, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%RHSCOMP(1), LENRHSCOMP, + & LSCAL, PT_SCALING(1), size(PT_SCALING)) + ENDIF + GO TO 22 + ELSEIF ( KASE .LT. 0 ) THEN + INFO( 1 ) = INFO( 1 ) + 8 + END IF + IF ( id%MYID .eq. MASTER ) THEN + NB_BYTES = NB_BYTES - int(size(R_W),8)*K16_8 + & - int(size(D ),8)*K16_8 + & - int(size(IW1),8)*K34_8 + DEALLOCATE(R_W,D) + DEALLOCATE(IW1) + ENDIF + IF ( PROKG ) THEN + IF (NITREF.GT.0) THEN + WRITE( MPG, 81 ) + WRITE( MPG, 141 ) 'NUMBER OF STEPS OF ITERATIVE REFINEMENTS + &=', NOITER + ENDIF + ENDIF + IF ( id%MYID .EQ. MASTER ) THEN + IF ( NITREF .GT. 0 ) THEN + id%INFOG(15) = NOITER + END IF + END IF + IF ( PROK .AND. ICNTL10 .GT.0 ) WRITE( MP, 131 ) + IF (ICNTL11 .GT. 0) THEN + IF ( KEEP(54) .eq. 0 ) THEN + IF (id%MYID .EQ. MASTER) THEN + IF (KEEP(55).EQ.0) THEN + CALL DMUMPS_278( MTYPE, id%N, id%NZ, id%A(1), + & id%IRN(1), id%JCN(1), + & RHS_MUMPS(IBEG), SAVERHS, R_Y, C_W, KEEP(1),KEEP8(1)) + ELSE + CALL DMUMPS_121( MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & RHS_MUMPS(IBEG), SAVERHS, R_Y, C_W, KEEP(1),KEEP8(1)) + ENDIF + END IF + ELSE + CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N, + & MPI_DOUBLE_PRECISION, MASTER, + & id%COMM, IERR ) + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL DMUMPS_192( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE ) + ELSE + C_LOCWK54 = ZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( C_LOCWK54, C_W, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + C_W = SAVERHS - C_W + ELSE + CALL MPI_REDUCE( C_LOCWK54, C_DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL DMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1) ) + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_Y, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + END IF + IF (id%MYID .EQ. MASTER) THEN + IF ((MPG .GT. 0) .AND. (NITREF .GT. 0)) WRITE( MPG, 65 ) + IF ((MPG .GT. 0) .AND. (NITREF .LE. 0)) WRITE( MPG, 170 ) + GIVSOL = .FALSE. + CALL DMUMPS_205(MTYPE,INFO(1),id%N,id%NZ,RHS_MUMPS(IBEG), + & SAVERHS,R_Y,C_W,GIVSOL, + & RSOL,RINFOG(4),RINFOG(5),RINFOG(6),MPG,ICNTL(1), + & KEEP(1),KEEP8(1)) + IF ( MPG .GT. 0 ) THEN + WRITE( MPG, 115 ) + &'RINFOG(7):COMPONENTWISE SCALED RESIDUAL(W1)=', RINFOG(7) + WRITE( MPG, 115 ) + &'------(8):---------------------------- (W2)=', RINFOG(8) + WRITE( MPG, 115 ) + &'------(9):Upper bound ERROR ...............=', RINFOG(9) + WRITE( MPG, 115 ) + &'-----(10):CONDITION NUMBER (1) ............=', RINFOG(10) + WRITE( MPG, 115 ) + &'-----(11):CONDITION NUMBER (2) ............=', RINFOG(11) + END IF + END IF + END IF + IF (id%MYID == MASTER) THEN + NB_BYTES = NB_BYTES - int(size(C_W),8)*K35_8 + DEALLOCATE(C_W) + ENDIF + NB_BYTES = NB_BYTES - + & (int(size(R_Y),8)+int(size(R_LOCWK54),8))*K16_8 + NB_BYTES = NB_BYTES - + & (int(size(C_Y),8)+int(size(C_LOCWK54),8))*K35_8 + DEALLOCATE(R_Y) + DEALLOCATE(C_Y) + DEALLOCATE(R_LOCWK54) + DEALLOCATE(C_LOCWK54) + END IF + IF ( id%MYID .EQ. MASTER .AND. ICNTL21==0 + & .AND. KEEP(23) .NE. 0 .AND. KEEP(237).EQ.0 ) THEN + IF ((KEEP(221).NE.1 .AND. ICNTL(9) .EQ. 1) + & .OR. KEEP(111) .NE.0 .OR. KEEP(252).NE.0 ) THEN + ALLOCATE( C_RW1( id%N ),stat =allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + WRITE(*,*) 'could not allocate ', id%N, 'integers.' + CALL MUMPS_ABORT() + END IF + DO K = 1, NBRHS_EFF + KDEC = (K-1)*LD_RHS+IBEG-1 + DO 70 I = 1, id%N + C_RW1(I) = RHS_MUMPS(KDEC+I) + 70 CONTINUE + DO 80 I = 1, id%N + JPERM = id%UNS_PERM(I) + RHS_MUMPS( KDEC+JPERM ) = C_RW1( I ) + 80 CONTINUE + END DO + DEALLOCATE( C_RW1 ) + END IF + END IF + IF (id%MYID.EQ.MASTER .and.ICNTL21==0.and.KEEP(221).NE.1 + & .and. KEEP(237).EQ.0 ) THEN + IF ( INFO(1) .GE. 0 .AND. ICNTL(4).GE.3 .AND. ICNTL(3).GT.0) + & THEN + K = min0(10, id%N) + IF (ICNTL(4) .eq. 4 ) K = id%N + J = min0(10,NBRHS_EFF) + IF (ICNTL(4) .eq. 4 ) J = NBRHS_EFF + DO II=1, J + WRITE(ICNTL(3),110) BEG_RHS+II-1 + WRITE(ICNTL(3),160) + & (RHS_MUMPS(IBEG+(II-1)*LD_RHS+I-1),I=1,K) + ENDDO + END IF + END IF + IF ((KEEP(248).EQ.1).AND.(KEEP(237).EQ.0)) THEN + BEG_RHS = BEG_RHS + NBRHS_EFF + ELSE + BEG_RHS = BEG_RHS + NBRHS + ENDIF + ENDDO + IF ( (id%MYID.EQ.MASTER) + & .AND. ( KEEP(248).NE.0 ) + & .AND. ( KEEP(237).EQ.0 ) + & .AND. ( ICNTL21.EQ.0 ) + & .AND. ( KEEP(221) .NE.1 ) + & .AND. ( JEND_RHS .LT. id%NRHS ) + & ) + & THEN + JBEG_NEW = JEND_RHS + 1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, id%N + RHS_MUMPS((PERM_RHS(JBEG_NEW) -1)*LD_RHS+I) + & = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + CYCLE + ENDDO + ELSE + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, id%N + RHS_MUMPS((JBEG_NEW -1)*LD_RHS + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + ENDIF + IF ( I_AM_SLAVE .AND. (ICNTL21.NE.0) .AND. + & ( JEND_RHS .LT. id%NRHS ) .AND. KEEP(221).NE.1 ) THEN + JBEG_NEW = JEND_RHS + 1 + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, KEEP(89) + id%SOL_loc((JBEG_NEW -1)*id%LSOL_loc + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + IF ((KEEP(221).EQ.1) .AND. + & ( JEND_RHS .LT. id%NRHS ) ) THEN + IF (id%MYID .EQ. MASTER) THEN + JBEG_NEW = JEND_RHS + 1 + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, id%SIZE_SCHUR + id%REDRHS((JBEG_NEW -1)*LD_REDRHS + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + IF (I_AM_SLAVE) THEN + JBEG_NEW = JEND_RHS + 1 + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1,LD_RHSCOMP + id%RHSCOMP((JBEG_NEW -1)*LD_RHSCOMP + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + ENDIF + id%INFO(26) = int(NB_BYTES_MAX / 1000000_8, 4) + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(26), id%INFOG(30), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Rank of processor needing largest memory in solve :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Space in MBYTES used by this processor for solve :', + & id%INFOG(30) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during solve :', + & ( id%INFOG(31)-id%INFO(26) ) / id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during solve :', + & id%INFOG(31) / id%NSLAVES + END IF + END IF + 90 CONTINUE + IF (INFO(1) .LT.0 ) THEN + ENDIF + IF (KEEP(201).GT.0)THEN + IF (IS_INIT_OOC_DONE) THEN + CALL DMUMPS_582(IERR) + IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + ENDIF + IF (IRHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_SPARSE_COPY),8)*K34_8 + DEALLOCATE(IRHS_SPARSE_COPY) + IRHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_SPARSE_COPY) + ENDIF + IF (IRHS_PTR_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_PTR_COPY),8)*K34_8 + DEALLOCATE(IRHS_PTR_COPY) + IRHS_PTR_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_PTR_COPY) + ENDIF + IF (RHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(RHS_SPARSE_COPY),8)*K35_8 + DEALLOCATE(RHS_SPARSE_COPY) + RHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(RHS_SPARSE_COPY) + ENDIF + IF (allocated(PERM_RHS)) THEN + NB_BYTES = NB_BYTES - int(size(PERM_RHS),8)*K34_8 + DEALLOCATE(PERM_RHS) + ENDIF + IF (allocated(UNS_PERM_INV)) THEN + NB_BYTES = NB_BYTES - int(size(UNS_PERM_INV),8)*K34_8 + DEALLOCATE(UNS_PERM_INV) + ENDIF + IF (associated(id%BUFR)) THEN + NB_BYTES = NB_BYTES - int(size(id%BUFR),8)*K34_8 + DEALLOCATE(id%BUFR) + NULLIFY(id%BUFR) + ENDIF + IF ( I_AM_SLAVE ) THEN + IF (allocated(IWK_SOLVE)) THEN + NB_BYTES = NB_BYTES - int(size(IWK_SOLVE),8)*K34_8 + DEALLOCATE( IWK_SOLVE ) + ENDIF + IF (allocated(IWCB)) THEN + NB_BYTES = NB_BYTES - int(size(IWCB),8)*K34_8 + DEALLOCATE( IWCB ) + ENDIF + CALL DMUMPS_57( IERR ) + CALL DMUMPS_59( IERR ) + END IF + IF ( id%MYID .eq. MASTER ) THEN + IF (allocated(SAVERHS)) THEN + NB_BYTES = NB_BYTES - int(size(SAVERHS),8)*K35_8 + DEALLOCATE( SAVERHS) + ENDIF + IF ( + & ( + & ( KEEP(248).ne.0 .OR. KEEP(221).EQ.2 + & .OR. KEEP(111).NE.0 ) + & .and. ICNTL21.ne.0 ) + & .or. + & ( KEEP(237).NE.0 ) + & ) + & THEN + IF ( I_AM_SLAVE ) THEN + IF (associated(RHS_MUMPS) ) THEN + NB_BYTES = NB_BYTES - int(size(RHS_MUMPS),8)*K35_8 + DEALLOCATE(RHS_MUMPS) + ENDIF + ENDIF + ENDIF + NULLIFY(RHS_MUMPS) + ELSE + IF (associated(RHS_MUMPS)) THEN + NB_BYTES = NB_BYTES - int(size(RHS_MUMPS),8)*K35_8 + DEALLOCATE(RHS_MUMPS) + NULLIFY(RHS_MUMPS) + END IF + END IF + IF (I_AM_SLAVE) THEN + IF (allocated(SRW3)) THEN + NB_BYTES = NB_BYTES - int(size(SRW3),8)*K35_8 + DEALLOCATE(SRW3) + ENDIF + IF (allocated(POSINRHSCOMP_N)) THEN + NB_BYTES = NB_BYTES - int(size(POSINRHSCOMP_N),8)*K34_8 + DEALLOCATE(POSINRHSCOMP_N) + ENDIF + IF (LSCAL .AND. ICNTL21==1) THEN + NB_BYTES = NB_BYTES - + & int(size(scaling_data%SCALING_LOC),8)*K16_8 + DEALLOCATE(scaling_data%SCALING_LOC) + NULLIFY(scaling_data%SCALING_LOC) + ENDIF + IF (WK_USER_PROVIDED) THEN + NULLIFY(id%S) + ELSE IF (associated(id%S).AND.KEEP(201).GT.0) THEN + NB_BYTES = NB_BYTES - KEEP8(23)*K35_8 + id%KEEP8(23)=0_8 + DEALLOCATE(id%S) + NULLIFY(id%S) + ENDIF + IF (KEEP(221).NE.1) THEN + IF (associated(id%RHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8 + DEALLOCATE(id%RHSCOMP) + NULLIFY(id%RHSCOMP) + ENDIF + IF (associated(id%POSINRHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%POSINRHSCOMP),8)*K34_8 + DEALLOCATE(id%POSINRHSCOMP) + NULLIFY(id%POSINRHSCOMP) + ENDIF + ENDIF + IF ( WORK_WCB_ALLOCATED ) THEN + NB_BYTES = NB_BYTES - int(size(WORK_WCB),8)*K35_8 + DEALLOCATE( WORK_WCB ) + ENDIF + NULLIFY( WORK_WCB ) + ENDIF + RETURN + 65 FORMAT (//' ERROR ANALYSIS AFTER ITERATIVE REFINEMENT') + 100 FORMAT(//' ****** SOLVE & CHECK STEP ********'/) + 110 FORMAT (//' VECTOR SOLUTION FOR COLUMN ',I12) + 115 FORMAT(1X, A44,1P,D9.2) + 150 FORMAT (/' STATISTICS PRIOR SOLVE PHASE ...........'/ + & ' NUMBER OF RIGHT-HAND-SIDES =',I12/ + & ' BLOCKING FACTOR FOR MULTIPLE RHS =',I12/ + & ' ICNTL (9) =',I12/ + & ' --- (10) =',I12/ + & ' --- (11) =',I12/ + & ' --- (20) =',I12/ + & ' --- (21) =',I12/ + & ' --- (30) =',I12) + 151 FORMAT (' --- (25) =',I12) + 152 FORMAT (' --- (26) =',I12) + 153 FORMAT (' --- (32) =',I12) + 160 FORMAT (' RHS'/(1X,1P,5D14.6)) + 170 FORMAT (//' ERROR ANALYSIS' ) + 240 FORMAT (1X, A42,I4) + 270 FORMAT (//' BEGIN ITERATIVE REFINEMENT' ) + 81 FORMAT (/' STATISTICS AFTER ITERATIVE REFINEMENT ') + 131 FORMAT (/' END ITERATIVE REFINEMENT ') + 141 FORMAT(1X, A42,I4) + END SUBROUTINE DMUMPS_301 + SUBROUTINE DMUMPS_245(root, N, A, LA, IW, LIW, W, LWC, + & IWCB,LIWW,RHS,LRHS,NRHS,NA,LNA,NE_STEPS, W2, + & MTYPE, ICNTL, + & STEP, FRERE, DAD, FILS, PTRIST, PTRFAC, IW1,LIW1, + & PROCNODE_STEPS, SLAVEF, + & INFO, KEEP,KEEP8, COMM_NODES, MYID, + & MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & IBEG_ROOT_DEF, IEND_ROOT_DEF, + & IROOT_DEF_RHS_COL1, PTR_RHS_ROOT, LPTR_RHS_ROOT, + & SIZE_ROOT, MASTER_ROOT, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, BUILD_POSINRHSCOMP + & , NZ_RHS, NBCOL_INBLOC, NRHS_ORIG + & , JBEG_RHS + & , Step2node, LStep2node + & , IRHS_SPARSE + & , IRHS_PTR + & , SIZE_PERM_RHS, PERM_RHS + & , SIZE_UNS_PERM_INV, UNS_PERM_INV + & ) + USE DMUMPS_OOC + USE MUMPS_SOL_ES + IMPLICIT NONE + INCLUDE 'dmumps_root.h' +#if defined(V_T) + INCLUDE 'VT.inc' +#endif + TYPE ( DMUMPS_ROOT_STRUC ) :: root + INTEGER(8) :: LA + INTEGER LWC,N,LIW,MTYPE,LIW1,LIWW,LNA + INTEGER ICNTL(40),INFO(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IW(LIW),IW1(LIW1),NA(LNA),NE_STEPS(KEEP(28)),IWCB(LIWW) + INTEGER STEP(N), FRERE(KEEP(28)), FILS(N), PTRIST(KEEP(28)), + & DAD(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER LRHS, NRHS, LRHSCOMP + DOUBLE PRECISION A(LA), W(LWC), RHS(LRHS,NRHS), + & W2(KEEP(133)), + & RHSCOMP(LRHSCOMP,NRHS) + INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES + INTEGER PROCNODE_STEPS(KEEP(28)), POSINRHSCOMP(KEEP(28)) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR(LBUFR) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1 + INTEGER SIZE_ROOT, MASTER_ROOT + INTEGER LPTR_RHS_ROOT + DOUBLE PRECISION PTR_RHS_ROOT(LPTR_RHS_ROOT) + LOGICAL BUILD_POSINRHSCOMP + INTEGER MP, LP, LDIAG + INTEGER K,I,II + INTEGER allocok + INTEGER LPOOL,MYLEAF,LPANEL_POS + INTEGER NSTK_S,IPOOL,IPANEL_POS,PTRICB,PTRACB + INTEGER MTYPE_LOC + INTEGER IERR + INTEGER(8) :: IAPOS + INTEGER IOLDPS, + & LOCAL_M, + & LOCAL_N +#if defined(V_T) + INTEGER soln_c_class, forw_soln, back_soln, root_soln +#endif + INTEGER IZERO + LOGICAL DOFORWARD, DOROOT, DOBACKWARD + LOGICAL I_WORKED_ON_ROOT, SPECIAL_ROOT_REACHED + INTEGER IROOT + LOGICAL DOROOT_FWD_OOC, DOROOT_BWD_PANEL + LOGICAL SWITCH_OFF_ES + LOGICAL DUMMY_BOOL + PARAMETER (IZERO = 0 ) + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INCLUDE 'mumps_headers.h' + EXTERNAL DMUMPS_248, DMUMPS_249 + INTEGER, intent(in) :: NZ_RHS, NBCOL_INBLOC, NRHS_ORIG + INTEGER, intent(in) :: SIZE_UNS_PERM_INV + INTEGER, intent(in) :: SIZE_PERM_RHS + INTEGER, intent(in) :: JBEG_RHS + INTEGER, intent(in) :: IRHS_SPARSE(NZ_RHS) + INTEGER, intent(in) :: IRHS_PTR(NBCOL_INBLOC+1) + INTEGER, intent(in) :: PERM_RHS(SIZE_PERM_RHS) + INTEGER, intent(in) :: UNS_PERM_INV(SIZE_UNS_PERM_INV) + INTEGER, intent(in) :: LStep2node + INTEGER, intent(in) :: Step2node(LStep2node) + INTEGER, DIMENSION(:), ALLOCATABLE :: nodes_RHS + INTEGER nb_nodes_RHS + INTEGER nb_prun_leaves + INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_Leaves + INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_List + INTEGER nb_prun_nodes + INTEGER nb_prun_roots, JAM1 + INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_SONS, Pruned_Roots + INTEGER, DIMENSION(:), ALLOCATABLE :: prun_NA + INTEGER :: SIZE_TO_PROCESS + LOGICAL, DIMENSION(:), ALLOCATABLE :: TO_PROCESS + INTEGER ISTEP, INODE_PRINC + LOGICAL AM1, DO_PRUN + LOGICAL Exploit_Sparsity + INTEGER :: OOC_FCT_TYPE_TMP + INTEGER :: MUMPS_808 + EXTERNAL :: MUMPS_808 + MYLEAF = -1 + LP = ICNTL(1) + MP = ICNTL(2) + LDIAG = ICNTL(4) +#if defined(V_T) + CALL VTCLASSDEF( 'Soln_c',soln_c_class,ierr) + CALL VTFUNCDEF( 'forw_soln',soln_c_class,forw_soln,ierr) + CALL VTFUNCDEF( 'back_soln',soln_c_class,back_soln,ierr) + CALL VTFUNCDEF( 'root_soln',soln_c_class,root_soln,ierr) +#endif + NSTK_S = 1 + PTRICB = NSTK_S + KEEP(28) + PTRACB = PTRICB + KEEP(28) + IPOOL = PTRACB + KEEP(28) + LPOOL = KEEP(28)+1 + IPANEL_POS = IPOOL + LPOOL + IF (KEEP(201).EQ.1) THEN + LPANEL_POS = KEEP(228)+1 + ELSE + LPANEL_POS = 1 + ENDIF + IF (IPANEL_POS + LPANEL_POS -1 .ne. LIW1 ) THEN + WRITE(*,*) MYID, ": Internal Error in DMUMPS_245", + & IPANEL_POS, LPANEL_POS, LIW1 + CALL MUMPS_ABORT() + ENDIF + DOFORWARD = .TRUE. + DOBACKWARD= .TRUE. + SPECIAL_ROOT_REACHED = .TRUE. + SWITCH_OFF_ES = .FALSE. + IF ( KEEP(111).NE.0 .OR. KEEP(252).NE.0 ) THEN + DOFORWARD = .FALSE. + ENDIF + IF (KEEP(221).eq.1) DOBACKWARD = .FALSE. + IF (KEEP(221).eq.2) DOFORWARD = .FALSE. + IF ( KEEP(60).EQ.0 .AND. + & ( + & (KEEP(38).NE.0 .AND. root%yes) + & .OR. + & (KEEP(20).NE.0 .AND. MYID_NODES.EQ.MASTER_ROOT) + & ) + & .AND. KEEP(252).EQ.0 + & ) + &THEN + DOROOT = .TRUE. + ELSE + DOROOT = .FALSE. + ENDIF + DOROOT_BWD_PANEL = DOROOT .AND. MTYPE.NE.1 .AND. KEEP(50).EQ.0 + & .AND. KEEP(201).EQ.1 + DOROOT_FWD_OOC = DOROOT .AND. .NOT.DOROOT_BWD_PANEL + AM1 = (KEEP(237) .NE. 0) + Exploit_Sparsity = (KEEP(235) .NE. 0) .AND. (.NOT. AM1) + DO_PRUN = (Exploit_Sparsity.OR.AM1) + IF ( DO_PRUN ) THEN + IF (.not. allocated(Pruned_SONS)) THEN + ALLOCATE (Pruned_SONS(KEEP(28)), stat=I) + IF(I.GT.0) THEN + INFO(1)=-13 + INFO(2)=KEEP(28) + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + END IF + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + IF (.not. allocated(TO_PROCESS)) THEN + SIZE_TO_PROCESS = KEEP(28) + ALLOCATE (TO_PROCESS(SIZE_TO_PROCESS), stat=I) + IF(I.GT.0) THEN + INFO(1)=-13 + INFO(2)=KEEP(28) + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + END IF + TO_PROCESS(:) = .TRUE. + ENDIF + IF ( DOFORWARD .AND. DO_PRUN ) THEN + nb_prun_nodes = 0 + nb_prun_roots = 0 + Pruned_SONS(:) = -1 + IF ( Exploit_Sparsity ) THEN + nb_nodes_RHS = 0 + DO I = 1, NZ_RHS + ISTEP = abs( STEP(IRHS_SPARSE(I)) ) + INODE_PRINC = Step2node( ISTEP ) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_nodes_RHS + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + nb_nodes_RHS = 0 + Pruned_SONS = -1 + DO I = 1, NZ_RHS + ISTEP = abs( STEP(IRHS_SPARSE(I)) ) + INODE_PRINC = Step2node( ISTEP ) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + nodes_RHS(nb_nodes_RHS) = INODE_PRINC + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ELSE IF ( AM1 ) THEN +#if defined(NOT_USED) + IF ( KEEP(201).GT.0) THEN + CALL DMUMPS_789(KEEP(28), + & KEEP(38), KEEP(20) ) + ENDIF +#endif + nb_nodes_RHS = 0 +#if defined(check) + WRITE(*,*) "NBCOL_INBLOC=",NBCOL_INBLOC + WRITE(*,*) "JBEG SIZE=",JBEG_RHS, SIZE(IRHS_PTR) +#endif + DO I = 1, NBCOL_INBLOC + IF ( (IRHS_PTR(I+1)-IRHS_PTR(I)).EQ.0) CYCLE + IF ( (KEEP(242) .NE. 0 ).OR. (KEEP(243).NE.0) ) THEN + JAM1 = PERM_RHS(JBEG_RHS+I-1) + ELSE + JAM1 = JBEG_RHS+I-1 + ENDIF + ISTEP = abs(STEP(JAM1)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_nodes_RHS + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + nb_nodes_RHS = 0 + Pruned_SONS = -1 + DO I = 1, NBCOL_INBLOC + IF ( (IRHS_PTR(I+1)-IRHS_PTR(I)).EQ.0) CYCLE + IF ( (KEEP(242) .NE. 0 ).OR. (KEEP(243).NE.0) ) THEN + JAM1 = PERM_RHS(JBEG_RHS+I-1) + ELSE + JAM1 = JBEG_RHS+I-1 + ENDIF + ISTEP = abs(STEP(JAM1)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + nodes_RHS(nb_nodes_RHS) = INODE_PRINC + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ENDIF + CALL MUMPS_797( + & .FALSE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves ) + ALLOCATE(Pruned_List(nb_prun_nodes), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_nodes + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Roots(nb_prun_roots), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_roots + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Leaves(nb_prun_leaves), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + CALL MUMPS_797( + & .TRUE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves ) + IF(allocated(nodes_RHS)) DEALLOCATE(nodes_RHS) + CALL DMUMPS_809(N, + & KEEP(201), Pruned_List, nb_prun_nodes, + & STEP) + IF ( KEEP(201) .GT. 0) THEN + OOC_FCT_TYPE_TMP=MUMPS_808 + & ('F',MTYPE,KEEP(201),KEEP(50)) + ELSE + OOC_FCT_TYPE_TMP = -5959 + ENDIF + CALL MUMPS_802( + & MYID_NODES, N, KEEP(28), KEEP(201), KEEP8(31), + & STEP, Pruned_List, nb_prun_nodes, OOC_FCT_TYPE_TMP + & ) + SPECIAL_ROOT_REACHED = .FALSE. + DO I= 1, nb_prun_roots + IF ( (Pruned_Roots(I).EQ.KEEP(38)).OR. + & (Pruned_Roots(I).EQ.KEEP(20)) ) THEN + SPECIAL_ROOT_REACHED = .TRUE. + EXIT + ENDIF + ENDDO + ENDIF + IF (KEEP(201).GT.0) THEN + IF (DOFORWARD .OR. DOROOT_FWD_OOC) THEN + CALL DMUMPS_583(PTRFAC,KEEP(28),MTYPE, + & A,LA,DOFORWARD,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + IF (DOFORWARD) THEN + IF ( KEEP( 50 ) .eq. 0 ) THEN + MTYPE_LOC = MTYPE + ELSE + MTYPE_LOC = 1 + ENDIF +#if defined(V_T) + CALL VTBEGIN(forw_soln,ierr) +#endif + IF (.NOT.DO_PRUN) THEN + CALL DMUMPS_248(N, A(1), LA, IW(1), LIW, W(1), + & LWC, RHS, LRHS, NRHS, + & IW1(PTRICB), IWCB, LIWW, + & RHSCOMP,LRHSCOMP,POSINRHSCOMP,BUILD_POSINRHSCOMP, + & NE_STEPS, NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(NSTK_S),IW1(IPOOL),LPOOL,PTRIST,PTRFAC, + & MYLEAF,INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS, SLAVEF, COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, MTYPE_LOC, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + ELSE + ALLOCATE(prun_NA(nb_prun_leaves+nb_prun_roots+2), + & STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves+nb_prun_roots+2 + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(I.LT.0) GOTO 500 + prun_NA(1) = nb_prun_leaves + prun_NA(2) = nb_prun_roots + DO I = 1, nb_prun_leaves + prun_NA(I+2) = Pruned_Leaves(I) + ENDDO + DO I = 1, nb_prun_roots + prun_NA(I+2+nb_prun_leaves) = Pruned_Roots(I) + ENDDO + DEALLOCATE(Pruned_List) + DEALLOCATE(Pruned_Leaves) + IF (AM1) THEN + DEALLOCATE(Pruned_Roots) + END IF + IF ((Exploit_Sparsity).AND.(nb_prun_roots.EQ.NA(2))) THEN + DEALLOCATE(Pruned_Roots) + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + SWITCH_OFF_ES = .TRUE. + ENDIF + CALL DMUMPS_248(N, A(1), LA, IW(1), LIW, W(1), + & LWC, RHS, LRHS, NRHS, + & IW1(PTRICB), IWCB, LIWW, + & RHSCOMP,LRHSCOMP,POSINRHSCOMP,BUILD_POSINRHSCOMP, + & Pruned_SONS, prun_NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(NSTK_S),IW1(IPOOL),LPOOL,PTRIST,PTRFAC, + & MYLEAF,INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS, SLAVEF, COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, MTYPE_LOC, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + DEALLOCATE(prun_NA) + ENDIF + BUILD_POSINRHSCOMP = .FALSE. +#if defined(V_T) + CALL VTEND(forw_soln,ierr) +#endif + ENDIF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF ( INFO(1) .LT. 0 ) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) MYID, + & ': ** ERROR RETURN FROM DMUMPS_248,INFO(1:2)=', + & INFO(1:2) + END IF + GOTO 500 + END IF + CALL MPI_BARRIER( COMM_NODES, IERR ) + IF (DO_PRUN.AND.SWITCH_OFF_ES) THEN + DO_PRUN = .FALSE. + Exploit_Sparsity = .FALSE. + ENDIF + IF ( DOBACKWARD .AND. DO_PRUN ) THEN + nb_prun_leaves = 0 + IF ( Exploit_Sparsity .AND. (KEEP(111).EQ.0) ) THEN + nb_nodes_RHS = nb_prun_roots + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + WRITE(*,*)'Problem with allocation of nodes_RHS' + INFO(1) = -13 + INFO(2) = nb_nodes_RHS + CALL MUMPS_ABORT() + END IF + nodes_RHS(1:nb_prun_roots)=Pruned_Roots(1:nb_prun_roots) + DEALLOCATE(Pruned_Roots) + ELSE + nb_nodes_RHS = 0 + Pruned_SONS(:) = -1 + DO II = 1, NZ_RHS + I = IRHS_SPARSE(II) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + ISTEP = abs(STEP(I)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + WRITE(*,*)'Problem with allocation of nodes_RHS' + INFO(1) = -13 + INFO(2) = nb_nodes_RHS + CALL MUMPS_ABORT() + END IF + nb_nodes_RHS = 0 + Pruned_SONS(:) = -1 + DO II = 1, NZ_RHS + I = IRHS_SPARSE(II) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + ISTEP = abs(STEP(I)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + nodes_RHS(nb_nodes_RHS) = INODE_PRINC + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ENDIF + IF ( Exploit_Sparsity ) THEN + CALL MUMPS_798( + & .FALSE., + & DAD, NE_STEPS, FRERE, KEEP(28), + & FILS, STEP, N, + & nodes_RHS, nb_nodes_RHS, + & TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves + & ) + ALLOCATE(Pruned_List(nb_prun_nodes), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_nodes + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Roots(nb_prun_roots), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_roots + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Leaves(nb_prun_leaves), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + CALL MUMPS_798( + & .TRUE., + & DAD, NE_STEPS, FRERE, KEEP(28), + & FILS, STEP, N, + & nodes_RHS, nb_nodes_RHS, + & TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves + & ) + CALL DMUMPS_809(N, + & KEEP(201), Pruned_List, nb_prun_nodes, + & STEP) + IF(allocated(nodes_RHS)) DEALLOCATE(nodes_RHS) + IF (KEEP(201).GT.0) THEN + OOC_FCT_TYPE_TMP=MUMPS_808 + & ('B',MTYPE,KEEP(201),KEEP(50)) + ELSE + OOC_FCT_TYPE_TMP = -5959 + ENDIF + CALL MUMPS_803( + & MYID_NODES, N, KEEP(28), KEEP(201), + & KEEP8(31), STEP, + & Pruned_List, + & nb_prun_nodes, OOC_FCT_TYPE_TMP) + ENDIF + ENDIF + IF(KEEP(201).EQ.1.AND.DOROOT_BWD_PANEL) THEN + I_WORKED_ON_ROOT = .FALSE. + CALL DMUMPS_584(PTRFAC,KEEP(28),MTYPE, + & I_WORKED_ON_ROOT, IROOT, A, LA, IERR) + IF (IERR .LT. 0) THEN + INFO(1) = -90 + INFO(2) = IERR + ENDIF + ENDIF + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF ( INFO(1) .LT. 0 ) GOTO 500 + ENDIF + IF (KEEP(60).NE.0 .AND. KEEP(221).EQ.0 + & .AND. MYID_NODES .EQ. MASTER_ROOT) THEN + PTR_RHS_ROOT(1:NRHS*SIZE_ROOT) = ZERO + ENDIF + IF ( ( KEEP( 38 ) .NE. 0 ).AND. SPECIAL_ROOT_REACHED ) THEN + IF ( KEEP(60) .EQ. 0 .AND. KEEP(252) .EQ. 0 ) THEN + IF ( root%yes ) THEN + IF (KEEP(201).GT.0) THEN + IF ( (Exploit_Sparsity.AND.(KEEP(111).NE.0)) .and. + & (OOC_STATE_NODE(STEP(KEEP(38))).eq.-6) ) THEN + write(6,*) " CPA to be double checked " + GOTO 1010 + ENDIF + ENDIF + IOLDPS = PTRIST(STEP(KEEP(38))) + LOCAL_M = IW( IOLDPS + 2 + KEEP(IXSZ)) + LOCAL_N = IW( IOLDPS + 1 + KEEP(IXSZ)) + IF (KEEP(201).GT.0) THEN + CALL DMUMPS_643( + & KEEP(38),PTRFAC,KEEP,A,LA, + & STEP,KEEP8,N,DUMMY_BOOL,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + WRITE(*,*) '** ERROR after DMUMPS_643', + & INFO(1) + call MUMPS_ABORT() + ENDIF + ENDIF + IAPOS = PTRFAC(IW( IOLDPS + 4 + KEEP(IXSZ))) +#if defined(V_T) + CALL VTBEGIN(root_soln,ierr) +#endif + CALL DMUMPS_286( NRHS, root%DESCRIPTOR(1), + & root%CNTXT_BLACS, LOCAL_M, LOCAL_N, + & root%MBLOCK, root%NBLOCK, + & root%IPIV(1), root%LPIV, MASTER_ROOT, MYID_NODES, + & COMM_NODES, + & PTR_RHS_ROOT(1), + & root%TOT_ROOT_SIZE, A( IAPOS ), + & INFO(1), MTYPE, KEEP(50)) + IF(KEEP(201).GT.0)THEN + CALL DMUMPS_598(KEEP(38), + & PTRFAC,KEEP(28),A,LA,.FALSE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + WRITE(*,*) + & '** ERROR after DMUMPS_598 ', + & INFO(1) + call MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + ENDIF + ELSE IF ( ( KEEP(20) .NE. 0) .AND. SPECIAL_ROOT_REACHED ) THEN + IF ( MYID_NODES .eq. MASTER_ROOT ) THEN + END IF + END IF +#if defined(V_T) + CALL VTEND(root_soln,ierr) +#endif + 1010 CONTINUE + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + IF (DOBACKWARD) THEN + IF ( KEEP(201).GT.0 .AND. .NOT. DOROOT_BWD_PANEL ) + & THEN + I_WORKED_ON_ROOT = DOROOT + IF (KEEP(111).NE.0) + & I_WORKED_ON_ROOT = .FALSE. + IF (KEEP(38).gt.0 ) THEN + IF ( ( Exploit_Sparsity.AND.(KEEP(111).EQ.0) ) + & .OR. AM1 ) THEN + IF (OOC_STATE_NODE(STEP(KEEP(38))).eq.-6) THEN + OOC_STATE_NODE(STEP(KEEP(38)))=-4 + ENDIF + ENDIF + IF (Exploit_Sparsity.AND.(KEEP(111).NE.0)) THEN + IF (OOC_STATE_NODE(STEP(KEEP(38))).eq.-6) THEN + I_WORKED_ON_ROOT = .FALSE. + ENDIF + ENDIF + ENDIF + ENDIF + IF ( AM1 ) THEN + CALL MUMPS_797( + & .FALSE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves) + ALLOCATE(Pruned_List(nb_prun_nodes), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_nodes + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Roots(nb_prun_roots), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_roots + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Leaves(nb_prun_leaves), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + CALL MUMPS_797( + & .TRUE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves ) + CALL DMUMPS_809(N, + & KEEP(201), Pruned_List, nb_prun_nodes, + & STEP) + IF (KEEP(201).GT.0) THEN + OOC_FCT_TYPE_TMP=MUMPS_808 + & ('B',MTYPE,KEEP(201),KEEP(50)) + ELSE + OOC_FCT_TYPE_TMP = -5959 + ENDIF + CALL MUMPS_802( + & MYID_NODES, N, KEEP(28), KEEP(201), KEEP8(31), + & STEP, Pruned_List, nb_prun_nodes, OOC_FCT_TYPE_TMP + & ) + ENDIF + IF ( KEEP(201).GT.0 ) THEN + IROOT = max(KEEP(20),KEEP(38)) + CALL DMUMPS_584(PTRFAC,KEEP(28),MTYPE, + & I_WORKED_ON_ROOT, IROOT, A, LA, IERR) + ENDIF + IF ( KEEP( 50 ) .eq. 0 ) THEN + MTYPE_LOC = MTYPE + ELSE + MTYPE_LOC = IZERO + ENDIF +#if defined(V_T) + CALL VTBEGIN(back_soln,ierr) +#endif + IF ( .NOT.SPECIAL_ROOT_REACHED ) THEN + PTR_RHS_ROOT(1:NRHS*SIZE_ROOT) = ZERO + ENDIF + IF ( .NOT. DO_PRUN ) THEN + SIZE_TO_PROCESS = 1 + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + ALLOCATE (TO_PROCESS(SIZE_TO_PROCESS), stat=I) + TO_PROCESS(:) = .TRUE. + CALL DMUMPS_249( N, A, LA, IW, LIW, W(1), LWC, + & RHS, LRHS, NRHS, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & IW1(PTRICB),IW1(PTRACB),IWCB,LIWW, + & W2, NE_STEPS, NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(IPOOL),LPOOL,PTRIST,PTRFAC,MYLEAF,INFO, + & PROCNODE_STEPS, SLAVEF, COMM_NODES,MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, KEEP,KEEP8, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, + & MTYPE_LOC, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, IW1(IPANEL_POS), + & LPANEL_POS, TO_PROCESS, SIZE_TO_PROCESS) + ELSE + ALLOCATE(prun_NA(nb_prun_leaves+nb_prun_roots+2), + & STAT=allocok) + IF(allocok.GT.0) THEN + WRITE(*,*)'Problem with allocation of prun_na' + CALL MUMPS_ABORT() + END IF + prun_NA(1) = nb_prun_leaves + prun_NA(2) = nb_prun_roots + DO I = 1, nb_prun_leaves + prun_NA(I+2) = Pruned_Leaves(I) + ENDDO + DO I = 1, nb_prun_roots + prun_NA(I+2+nb_prun_leaves) = Pruned_Roots(I) + ENDDO + CALL DMUMPS_249( N, A, LA, IW, LIW, W(1), LWC, + & RHS, LRHS, NRHS, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & IW1(PTRICB),IW1(PTRACB),IWCB,LIWW, + & W2, NE_STEPS, prun_NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(IPOOL),LPOOL,PTRIST,PTRFAC,MYLEAF,INFO, + & PROCNODE_STEPS, SLAVEF, COMM_NODES,MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, KEEP,KEEP8, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, + & MTYPE_LOC, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, IW1(IPANEL_POS), + & LPANEL_POS, TO_PROCESS, SIZE_TO_PROCESS) + ENDIF +#if defined(V_T) + CALL VTEND(back_soln,ierr) +#endif + ENDIF + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + IF (DOFORWARD) THEN + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + WRITE (MP,99992) + IF (N.GT.0) WRITE (MP,99993) (RHS(I,1),I=1,K) + IF (N.GT.0.and.NRHS>1) + & WRITE (MP,99994) (RHS(I,2),I=1,K) + ENDIF + ENDIF +500 CONTINUE + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + IF (Exploit_Sparsity.OR.AM1.OR.SWITCH_OFF_ES) THEN + IF ( allocated(nodes_RHS)) DEALLOCATE (nodes_RHS) + IF ( allocated(Pruned_SONS)) DEALLOCATE (Pruned_SONS) + IF ( allocated(Pruned_Roots)) DEALLOCATE (Pruned_Roots) + IF ( allocated(prun_NA)) DEALLOCATE (prun_NA) + IF ( allocated(Pruned_List)) DEALLOCATE (Pruned_List) + IF ( allocated(Pruned_Leaves)) DEALLOCATE (Pruned_Leaves) + ENDIF + RETURN +99993 FORMAT (' RHS (first column)'/(1X,1P,5D14.6)) +99994 FORMAT (' RHS (2 nd column)'/(1X,1P,5D14.6)) +99992 FORMAT (//' LEAVING SOLVE (MPI41C) WITH') + END SUBROUTINE DMUMPS_245 + SUBROUTINE DMUMPS_521(NSLAVES, N, MYID, COMM, + & MTYPE, RHS, LRHS, NRHS, PTRIST, + & KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, BUFFER, + & SIZE_BUF, SIZE_BUF_BYTES, CWORK, LCWORK, + & LSCAL, SCALING, LSCALING) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID, COMM, LIW, MTYPE + INTEGER NRHS, LRHS, LCWORK + DOUBLE PRECISION RHS (LRHS, NRHS) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION :: CWORK(LCWORK) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N) + INTEGER SIZE_BUF, SIZE_BUF_BYTES + INTEGER BUFFER(SIZE_BUF) + LOGICAL, intent(in) :: LSCAL + INTEGER, intent(in) :: LSCALING + DOUBLE PRECISION, intent(in) :: SCALING(LSCALING) + INTEGER I, II, J, J1, ISTEP, MASTER, + & MYID_NODES, TYPE_PARAL, N2RECV + INTEGER LIELL, IPOS, NPIV, MAXNPIV_estim, MAXSurf + INTEGER STATUS(MPI_STATUS_SIZE), IERR + PARAMETER(MASTER=0) + LOGICAL I_AM_SLAVE + INTEGER RECORD_SIZE_P_1, SIZE1, SIZE2 + INTEGER POS_BUF, N2SEND + INTEGER SK38, SK20 + INTEGER, PARAMETER :: FIN = -1 + INTEGER, PARAMETER :: yes = 1 + INTEGER, PARAMETER :: no = 0 + INTEGER, ALLOCATABLE, DIMENSION(:) :: IROWlist(:) + INTEGER :: ONE_PACK + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + TYPE_PARAL = KEEP(46) + I_AM_SLAVE = MYID .ne. MASTER .OR. TYPE_PARAL .eq. 1 + IF ( TYPE_PARAL == 1 ) THEN + MYID_NODES = MYID + ELSE + MYID_NODES = MYID-1 + ENDIF + IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.1) THEN + IF (LSCAL) THEN + DO J=1, NRHS + DO I=1,N + RHS(I,J) = RHS(I,J)*SCALING(I) + ENDDO + ENDDO + ENDIF + RETURN + ENDIF + IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.0) THEN + DO J=1, NRHS + IF ( I_AM_SLAVE ) THEN + CALL MPI_SEND(RHS(1, J), N, MPI_DOUBLE_PRECISION, MASTER, + & GatherSol, COMM, IERR) + & + ELSE + CALL MPI_RECV(RHS(1, J), N, MPI_DOUBLE_PRECISION, + & 1, + & GatherSol, COMM, STATUS, IERR ) + IF (LSCAL) THEN + DO I=1,N + RHS(I,J) = RHS(I,J)*SCALING(I) + ENDDO + ENDIF + ENDIF + ENDDO + RETURN + ENDIF + MAXNPIV_estim = max(KEEP(246), KEEP(247)) + MAXSurf = MAXNPIV_estim*NRHS + IF (LCWORK .GE. MAXSurf) THEN + ONE_PACK = yes + ELSE IF (LCWORK .GE. MAXNPIV_estim) THEN + ONE_PACK = no + ELSE + WRITE(*,*) + & "Internal error 2 in DMUMPS_521:", + & TYPE_PARAL, LCWORK, KEEP(247), NRHS + CALL MUMPS_ABORT() + ENDIF + IF (ONE_PACK .EQ. no .AND. I_AM_SLAVE) THEN + WRITE(*,*) + & "Internal error 1 in DMUMPS_521:", + & TYPE_PARAL, LCWORK, KEEP(246),KEEP(247), NRHS + CALL MUMPS_ABORT() + ENDIF + IF (TYPE_PARAL .EQ. 0) + &CALL MPI_BCAST(ONE_PACK, 1, MPI_INTEGER, + & MASTER, COMM, IERR) + IF (MYID.EQ.MASTER) THEN + ALLOCATE(IROWlist(KEEP(247))) + ENDIF + IF (NSLAVES .EQ. 1 .AND. TYPE_PARAL .EQ. 1) THEN + CALL MUMPS_ABORT() + ENDIF + SIZE1=0 + CALL MPI_PACK_SIZE(MAXNPIV_estim+2,MPI_INTEGER, COMM, + & SIZE1, IERR) + SIZE2=0 + CALL MPI_PACK_SIZE(MAXSurf,MPI_DOUBLE_PRECISION, COMM, + & SIZE2, IERR) + RECORD_SIZE_P_1= SIZE1+SIZE2 + IF (RECORD_SIZE_P_1.GT.SIZE_BUF_BYTES) THEN + write(6,*) MYID, + & ' Internal error 3 in DMUMPS_521 ' + write(6,*) MYID, ' RECORD_SIZE_P_1, SIZE_BUF_BYTES=', + & RECORD_SIZE_P_1, SIZE_BUF_BYTES + CALL MUMPS_ABORT() + ENDIF + N2SEND =0 + N2RECV =N + POS_BUF =0 + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + IF (I_AM_SLAVE) THEN + POS_BUF = 0 + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & NSLAVES)) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP)+KEEP(IXSZ) + NPIV = IW(IPOS+3) + LIELL = IW(IPOS) + NPIV + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2+ KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .AND. KEEP(50).EQ.0) THEN + J1=IPOS+1+LIELL + ELSE + J1=IPOS+1 + END IF + IF (MYID .EQ. MASTER) THEN + N2RECV=N2RECV-NPIV + IF (NPIV.GT.0.AND.LSCAL) + & CALL DMUMPS_522 ( ONE_PACK, .TRUE. ) + ELSE + IF (NPIV.GT.0) + & CALL DMUMPS_522 ( ONE_PACK, .FALSE.) + ENDIF + ENDIF + ENDDO + CALL DMUMPS_523() + ENDIF + IF ( MYID .EQ. MASTER ) THEN + DO WHILE (N2RECV .NE. 0) + CALL MPI_RECV( BUFFER, SIZE_BUF_BYTES, MPI_PACKED, + & MPI_ANY_SOURCE, + & GatherSol, COMM, STATUS, IERR ) + POS_BUF = 0 + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & NPIV, 1, MPI_INTEGER, COMM, IERR) + DO WHILE (NPIV.NE.FIN) + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & IROWlist, NPIV, MPI_INTEGER, COMM, IERR) + IF (ONE_PACK.EQ.yes) THEN + CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF, + & CWORK, NPIV*NRHS, MPI_DOUBLE_PRECISION, + & COMM, IERR) + IF (LSCAL) THEN + DO J=1, NRHS + DO I=1,NPIV + RHS(IROWlist(I),J)= + & CWORK(I+(J-1)*NPIV)*SCALING(IROWlist(I)) + ENDDO + END DO + ELSE + DO J=1, NRHS + DO I=1,NPIV + RHS(IROWlist(I),J)= CWORK(I+(J-1)*NPIV) + ENDDO + END DO + ENDIF + ELSE + DO J=1,NRHS + CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF, + & CWORK, NPIV, MPI_DOUBLE_PRECISION, + & COMM, IERR) + IF (LSCAL) THEN + DO I=1,NPIV + RHS(IROWlist(I),J)=CWORK(I)*SCALING(IROWlist(I)) + ENDDO + ELSE + DO I=1,NPIV + RHS(IROWlist(I),J)=CWORK(I) + ENDDO + ENDIF + ENDDO + ENDIF + N2RECV=N2RECV-NPIV + CALL MPI_UNPACK( BUFFER, SIZE_BUF_BYTES, POS_BUF, + & NPIV, 1, MPI_INTEGER, COMM, IERR) + ENDDO + ENDDO + DEALLOCATE(IROWlist) + ENDIF + RETURN + CONTAINS + SUBROUTINE DMUMPS_522 ( ONE_PACK, SCALE_ONLY ) + INTEGER, intent(in) :: ONE_PACK + LOGICAL, intent(in) :: SCALE_ONLY + INTEGER III + IF (SCALE_ONLY) THEN + DO II=1,NPIV + I=IW(J1+II-1) + DO J=1, NRHS + RHS(I,J) = RHS(I,J)*SCALING(I) + ENDDO + ENDDO + RETURN + ENDIF + DO II=1,NPIV + I=IW(J1+II-1) + DO J=1, NRHS + CWORK(II+(J-1)*NPIV) = RHS(I,J) + ENDDO + ENDDO + CALL MPI_PACK(NPIV, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_PACK(IW(J1), NPIV, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + IF (ONE_PACK.EQ.yes) THEN + CALL MPI_PACK(CWORK(1), NPIV*NRHS, MPI_DOUBLE_PRECISION, + & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM, + & IERR) + ELSE + III = 1 + DO J=1,NRHS + CALL MPI_PACK(CWORK(III), NPIV, MPI_DOUBLE_PRECISION, + & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM, + & IERR) + III =III+NPIV + ENDDO + ENDIF + N2SEND=N2SEND+NPIV + IF ( POS_BUF + RECORD_SIZE_P_1 > SIZE_BUF_BYTES ) THEN + CALL DMUMPS_523() + END IF + RETURN + END SUBROUTINE DMUMPS_522 + SUBROUTINE DMUMPS_523() + IF (N2SEND .NE. 0) THEN + CALL MPI_PACK(FIN, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_SEND(BUFFER, POS_BUF, MPI_PACKED, MASTER, + & GatherSol, COMM, IERR) + ENDIF + POS_BUF=0 + N2SEND=0 + RETURN + END SUBROUTINE DMUMPS_523 + END SUBROUTINE DMUMPS_521 + SUBROUTINE DMUMPS_812(NSLAVES, N, MYID, COMM, + & RHS, LRHS, NRHS, KEEP, BUFFER, + & SIZE_BUF, SIZE_BUF_BYTES, + & LSCAL, SCALING, LSCALING, + & IRHS_PTR_COPY, LIRHS_PTR_COPY, + & IRHS_SPARSE_COPY, LIRHS_SPARSE_COPY, + & RHS_SPARSE_COPY, LRHS_SPARSE_COPY, + & UNS_PERM_INV, LUNS_PERM_INV, + & POSINRHSCOMP_N, LPOS_N ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID, COMM + INTEGER NRHS, LRHS, LPOS_N + DOUBLE PRECISION RHS (LRHS, NRHS) + INTEGER KEEP(500) + INTEGER SIZE_BUF, SIZE_BUF_BYTES + INTEGER BUFFER(SIZE_BUF) + INTEGER, intent(in) :: LIRHS_PTR_COPY, LIRHS_SPARSE_COPY, + & LRHS_SPARSE_COPY, LUNS_PERM_INV + INTEGER :: IRHS_SPARSE_COPY(LIRHS_SPARSE_COPY), + & IRHS_PTR_COPY(LIRHS_PTR_COPY), + & UNS_PERM_INV(LUNS_PERM_INV), + & POSINRHSCOMP_N(LPOS_N) + DOUBLE PRECISION :: RHS_SPARSE_COPY(LRHS_SPARSE_COPY) + LOGICAL, intent(in) :: LSCAL + INTEGER, intent(in) :: LSCALING + DOUBLE PRECISION, intent(in) :: SCALING(LSCALING) + INTEGER COLSIZE, K, IZ, IPREV, NBCOL_INBLOC + INTEGER I, II, J, MASTER, + & TYPE_PARAL, N2RECV + INTEGER STATUS(MPI_STATUS_SIZE), IERR + PARAMETER(MASTER=0) + LOGICAL I_AM_SLAVE + INTEGER RECORD_SIZE_P_1, SIZE1, SIZE2 + INTEGER POS_BUF, N2SEND + INTEGER, PARAMETER :: FIN = -1 + INCLUDE 'mumps_headers.h' + TYPE_PARAL = KEEP(46) + I_AM_SLAVE = MYID .ne. MASTER .OR. TYPE_PARAL .eq. 1 + NBCOL_INBLOC = size(IRHS_PTR_COPY)-1 + IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.1) THEN + K=1 + DO J = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE.EQ.0) CYCLE + DO IZ=IRHS_PTR_COPY(J), IRHS_PTR_COPY(J+1)-1 + I = IRHS_SPARSE_COPY(IZ) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + IF (POSINRHSCOMP_N(I).NE.0) THEN + IF (LSCAL) THEN + RHS_SPARSE_COPY(IZ)=RHS(I,K)*SCALING(I) + ELSE + RHS_SPARSE_COPY(IZ)=RHS(I,K) + ENDIF + ENDIF + ENDDO + K = K + 1 + ENDDO + RETURN + ENDIF + IF (I_AM_SLAVE) THEN + K=1 + DO J = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE.EQ.0) CYCLE + DO IZ=IRHS_PTR_COPY(J), IRHS_PTR_COPY(J+1)-1 + I = IRHS_SPARSE_COPY(IZ) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + IF (POSINRHSCOMP_N(I).NE.0) THEN + RHS_SPARSE_COPY(IZ)=RHS(I,K) + ENDIF + ENDDO + K = K + 1 + ENDDO + ENDIF + SIZE1=0 + CALL MPI_PACK_SIZE(3,MPI_INTEGER, COMM, + & SIZE1, IERR) + SIZE2=0 + CALL MPI_PACK_SIZE(1,MPI_DOUBLE_PRECISION, COMM, + & SIZE2, IERR) + RECORD_SIZE_P_1= SIZE1+SIZE2 + IF (RECORD_SIZE_P_1.GT.SIZE_BUF_BYTES) THEN + write(6,*) MYID, + & ' Internal error 3 in DMUMPS_812 ' + write(6,*) MYID, ' RECORD_SIZE_P_1, SIZE_BUF_BYTES=', + & RECORD_SIZE_P_1, SIZE_BUF_BYTES + CALL MUMPS_ABORT() + ENDIF + N2SEND =0 + N2RECV =size(IRHS_SPARSE_COPY) + POS_BUF =0 + IF (I_AM_SLAVE) THEN + DO J = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE.LE.0) CYCLE + K = 0 + DO IZ=IRHS_PTR_COPY(J), IRHS_PTR_COPY(J+1)-1 + I = IRHS_SPARSE_COPY(IZ) + II = I + IF (KEEP(23).NE.0) II = UNS_PERM_INV(I) + IF (POSINRHSCOMP_N(II).NE.0) THEN + IF (MYID .EQ. MASTER) THEN + N2RECV=N2RECV-1 + IF (LSCAL) + & CALL DMUMPS_813 ( .TRUE. ) + IRHS_SPARSE_COPY( IRHS_PTR_COPY(J) + K) = + & I + RHS_SPARSE_COPY( IRHS_PTR_COPY(J) + K) = + & RHS_SPARSE_COPY(IZ) + K = K+1 + ELSE + CALL DMUMPS_813 ( .FALSE. ) + ENDIF + ENDIF + ENDDO + IF (MYID.EQ.MASTER) + & IRHS_PTR_COPY(J) = IRHS_PTR_COPY(J) + K + ENDDO + CALL DMUMPS_814() + ENDIF + IF ( MYID .EQ. MASTER ) THEN + DO WHILE (N2RECV .NE. 0) + CALL MPI_RECV( BUFFER, SIZE_BUF_BYTES, MPI_PACKED, + & MPI_ANY_SOURCE, + & GatherSol, COMM, STATUS, IERR ) + POS_BUF = 0 + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & J, 1, MPI_INTEGER, COMM, IERR) + DO WHILE (J.NE.FIN) + IZ = IRHS_PTR_COPY(J) + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & I, 1, MPI_INTEGER, COMM, IERR) + IRHS_SPARSE_COPY(IZ) = I + CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF, + & RHS_SPARSE_COPY(IZ), 1, MPI_DOUBLE_PRECISION, + & COMM, IERR) + IF (LSCAL) THEN + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + RHS_SPARSE_COPY(IZ) = RHS_SPARSE_COPY(IZ)*SCALING(I) + ENDIF + N2RECV=N2RECV-1 + IRHS_PTR_COPY(J) = IRHS_PTR_COPY(J) + 1 + CALL MPI_UNPACK( BUFFER, SIZE_BUF_BYTES, POS_BUF, + & J, 1, MPI_INTEGER, COMM, IERR) + ENDDO + ENDDO + IPREV = 1 + DO J=1, size(IRHS_PTR_COPY)-1 + I= IRHS_PTR_COPY(J) + IRHS_PTR_COPY(J) = IPREV + IPREV = I + ENDDO + ENDIF + RETURN + CONTAINS + SUBROUTINE DMUMPS_813 ( SCALE_ONLY ) + LOGICAL, intent(in) :: SCALE_ONLY + INTEGER III + IF (SCALE_ONLY) THEN + III = I + IF (KEEP(23).NE.0) III = UNS_PERM_INV(I) + IF (LSCAL) THEN + RHS_SPARSE_COPY(IZ)=RHS_SPARSE_COPY(IZ)*SCALING(III) + ENDIF + RETURN + ENDIF + CALL MPI_PACK(J, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_PACK(I, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_PACK(RHS_SPARSE_COPY(IZ), 1, MPI_DOUBLE_PRECISION, + & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM, + & IERR) + N2SEND=N2SEND+1 + IF ( POS_BUF + RECORD_SIZE_P_1 > SIZE_BUF_BYTES ) THEN + CALL DMUMPS_814() + END IF + RETURN + END SUBROUTINE DMUMPS_813 + SUBROUTINE DMUMPS_814() + IF (N2SEND .NE. 0) THEN + CALL MPI_PACK(FIN, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_SEND(BUFFER, POS_BUF, MPI_PACKED, MASTER, + & GatherSol, COMM, IERR) + ENDIF + POS_BUF=0 + N2SEND=0 + RETURN + END SUBROUTINE DMUMPS_814 + END SUBROUTINE DMUMPS_812 + SUBROUTINE DMUMPS_535(MTYPE, ISOL_LOC, + & PTRIST, KEEP,KEEP8, + & IW, LIW_PASSED, MYID_NODES, N, STEP, + & PROCNODE, NSLAVES, scaling_data, LSCAL) + IMPLICIT NONE + INTEGER MTYPE, MYID_NODES, N, NSLAVES + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE(KEEP(28)) + INTEGER ISOL_LOC(KEEP(89)) + INTEGER LIW_PASSED + INTEGER IW(LIW_PASSED) + INTEGER STEP(N) + LOGICAL LSCAL + type scaling_data_t + SEQUENCE + DOUBLE PRECISION, dimension(:), pointer :: SCALING + DOUBLE PRECISION, dimension(:), pointer :: SCALING_LOC + end type scaling_data_t + type (scaling_data_t) :: scaling_data + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER ISTEP, K + INTEGER J1, IPOS, LIELL, NPIV, JJ + INTEGER SK38,SK20 + INCLUDE 'mumps_headers.h' + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + K=0 + DO ISTEP=1, KEEP(28) + IF ( MYID_NODES == MUMPS_275( PROCNODE(ISTEP), + & NSLAVES)) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP)+KEEP(IXSZ) + LIELL = IW(IPOS+3) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 + KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .AND. KEEP(50).EQ.0) THEN + J1=IPOS+1+LIELL + ELSE + J1=IPOS+1 + END IF + DO JJ=J1,J1+NPIV-1 + K=K+1 + ISOL_LOC(K)=IW(JJ) + IF (LSCAL) THEN + scaling_data%SCALING_LOC(K)= + & scaling_data%SCALING(IW(JJ)) + ENDIF + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_535 + SUBROUTINE DMUMPS_532( + & SLAVEF, N, MYID_NODES, + & MTYPE, RHS, LD_RHS, NRHS, + & ISOL_LOC, SOL_LOC, BEG_RHS, LSOL_LOC, + & PTRIST, + & PROCNODE_STEPS, KEEP,KEEP8, IW, LIW, STEP, + & scaling_data, LSCAL, NB_RHSSKIPPED) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + type scaling_data_t + SEQUENCE + DOUBLE PRECISION, dimension(:), pointer :: SCALING + DOUBLE PRECISION, dimension(:), pointer :: SCALING_LOC + end type scaling_data_t + TYPE (scaling_data_t) :: scaling_data + LOGICAL LSCAL + INTEGER SLAVEF, N, MYID_NODES, LIW, MTYPE, NRHS, LD_RHS + INTEGER LSOL_LOC, BEG_RHS, NB_RHSSKIPPED + INTEGER ISOL_LOC(LSOL_LOC) + DOUBLE PRECISION SOL_LOC( LSOL_LOC, BEG_RHS+NRHS+NB_RHSSKIPPED-1) + DOUBLE PRECISION RHS( LD_RHS , NRHS) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N) + INTEGER JJ, J1, ISTEP, K, JEMPTY, JEND + INTEGER IPOS, LIELL, NPIV + LOGICAL ROOT + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + K=0 + JEMPTY = BEG_RHS+NB_RHSSKIPPED-1 + JEND = BEG_RHS+NB_RHSSKIPPED+NRHS-1 + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & SLAVEF)) THEN + ROOT=.false. + IF (KEEP(38).ne.0) ROOT = STEP(KEEP(38))==ISTEP + IF (KEEP(20).ne.0) ROOT = STEP(KEEP(20))==ISTEP + IF ( ROOT ) THEN + IPOS = PTRIST(ISTEP) + KEEP(IXSZ) + LIELL = IW(IPOS+3) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2 +KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .AND. KEEP(50).EQ.0) THEN + J1=IPOS+1+LIELL + ELSE + J1=IPOS+1 + END IF + DO JJ=J1,J1+NPIV-1 + K=K+1 + IF (NB_RHSSKIPPED.GT.0) + & SOL_LOC(K, BEG_RHS:JEMPTY) = ZERO + IF (LSCAL) THEN + SOL_LOC(K,JEMPTY+1:JEND) = + & scaling_data%SCALING_LOC(K)*RHS(IW(JJ),1:NRHS) + ELSE + SOL_LOC(K,JEMPTY+1:JEND) = + & RHS(IW(JJ),1:NRHS) + ENDIF + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_532 + SUBROUTINE DMUMPS_638 + & (NSLAVES, N, MYID, COMM, + & MTYPE, RHS, LRHS, NRHS, PTRIST, + & KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, + & POSINRHSCOMP, LENPOSINRHSCOMP, + & BUILD_POSINRHSCOMP, ICNTL, INFO) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID, COMM, LIW, MTYPE + INTEGER NRHS, LRHS, LENPOSINRHSCOMP + INTEGER ICNTL(40), INFO(40) + DOUBLE PRECISION RHS (LRHS, NRHS) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N), POSINRHSCOMP(LENPOSINRHSCOMP) + LOGICAL BUILD_POSINRHSCOMP + INTEGER BUF_MAXSIZE, BUF_MAXREF + PARAMETER (BUF_MAXREF=200000) + INTEGER, ALLOCATABLE, DIMENSION(:) :: BUF_INDX + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: BUF_RHS + INTEGER ENTRIES_2_PROCESS, PROC_WHO_ASKS, BUF_EFFSIZE + INTEGER INDX + INTEGER allocok + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INTEGER I, K, JJ, J1, ISTEP, MASTER, + & MYID_NODES, TYPE_PARAL + INTEGER LIELL, IPOS, NPIV + INTEGER STATUS(MPI_STATUS_SIZE), IERR + PARAMETER(MASTER=0) + LOGICAL I_AM_SLAVE + INTEGER SK38, SK20, IPOSINRHSCOMP + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + TYPE_PARAL = KEEP(46) + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + I_AM_SLAVE = MYID .ne. 0 .OR. TYPE_PARAL .eq. 1 + IF ( TYPE_PARAL == 1 ) THEN + MYID_NODES = MYID + ELSE + MYID_NODES = MYID-1 + ENDIF + BUF_EFFSIZE = 0 + BUF_MAXSIZE = max(min(BUF_MAXREF,int(2000000/NRHS)),2000) + ALLOCATE (BUF_INDX(BUF_MAXSIZE), + & BUF_RHS(NRHS,BUF_MAXSIZE), + & stat=allocok) + IF (allocok .GT. 0) THEN + INFO(1)=-13 + INFO(2)=BUF_MAXSIZE*(NRHS+1) + ENDIF + CALL MUMPS_276(ICNTL, INFO, COMM, MYID ) + IF (INFO(1).LT.0) RETURN + IF (MYID.EQ.MASTER) THEN + ENTRIES_2_PROCESS = N - KEEP(89) + DO WHILE ( ENTRIES_2_PROCESS .NE. 0) + CALL MPI_RECV( BUF_INDX, BUF_MAXSIZE, MPI_INTEGER, + & MPI_ANY_SOURCE, + & ScatterRhsI, COMM, STATUS, IERR ) + CALL MPI_GET_COUNT( STATUS, MPI_INTEGER, BUF_EFFSIZE, IERR ) + PROC_WHO_ASKS = STATUS(MPI_SOURCE) + DO I = 1, BUF_EFFSIZE + INDX = BUF_INDX( I ) + DO K = 1, NRHS + BUF_RHS( K, I ) = RHS( INDX, K ) + RHS( BUF_INDX(I), K ) = ZERO + ENDDO + ENDDO + CALL MPI_SEND( BUF_RHS, NRHS*BUF_EFFSIZE, + & MPI_DOUBLE_PRECISION, PROC_WHO_ASKS, + & ScatterRhsR, COMM, IERR) + ENTRIES_2_PROCESS = ENTRIES_2_PROCESS - BUF_EFFSIZE + ENDDO + BUF_EFFSIZE= 0 + ENDIF + IF (I_AM_SLAVE) THEN + IF (BUILD_POSINRHSCOMP) THEN + IPOSINRHSCOMP = 1 + POSINRHSCOMP = -9678 + ENDIF + IF (MYID.NE.MASTER) RHS = ZERO + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & NSLAVES)) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP) + LIELL = IW(IPOS+3+KEEP(IXSZ)) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2+ KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .OR. KEEP(50).NE.0) THEN + J1=IPOS+1 + ELSE + J1=IPOS+1+LIELL + END IF + IF (BUILD_POSINRHSCOMP) THEN + POSINRHSCOMP(ISTEP) = IPOSINRHSCOMP + IPOSINRHSCOMP = IPOSINRHSCOMP + NPIV + ENDIF + IF (MYID.NE.MASTER) THEN + DO JJ=J1,J1+NPIV-1 + BUF_EFFSIZE = BUF_EFFSIZE + 1 + BUF_INDX(BUF_EFFSIZE) = IW(JJ) + IF (BUF_EFFSIZE + 1 .GT. BUF_MAXSIZE) THEN + CALL DMUMPS_640() + ENDIF + ENDDO + ENDIF + ENDIF + ENDDO + IF ( BUF_EFFSIZE .NE. 0 .AND. MYID.NE.MASTER ) + & CALL DMUMPS_640() + ENDIF + DEALLOCATE (BUF_INDX, BUF_RHS) + RETURN + CONTAINS + SUBROUTINE DMUMPS_640() + CALL MPI_SEND(BUF_INDX, BUF_EFFSIZE, MPI_INTEGER, + & MASTER, ScatterRhsI, COMM, IERR ) + CALL MPI_RECV(BUF_RHS, BUF_EFFSIZE*NRHS, + & MPI_DOUBLE_PRECISION, + & MASTER, + & ScatterRhsR, COMM, STATUS, IERR ) + DO I = 1, BUF_EFFSIZE + INDX = BUF_INDX(I) + DO K = 1, NRHS + RHS( INDX, K ) = BUF_RHS( K, I ) + ENDDO + ENDDO + BUF_EFFSIZE = 0 + RETURN + END SUBROUTINE DMUMPS_640 + END SUBROUTINE DMUMPS_638 + SUBROUTINE DMUMPS_639 + & (NSLAVES, N, MYID_NODES, + & PTRIST, + & KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, + & POSINRHSCOMP, POSINRHSCOMP_N, LPIRC_N, MTYPE, + & WHAT ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID_NODES, LIW + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N), POSINRHSCOMP(KEEP(28)) + INTEGER LPIRC_N, WHAT, MTYPE + INTEGER POSINRHSCOMP_N(LPIRC_N) + INTEGER ISTEP + INTEGER NPIV + INTEGER SK38, SK20, IPOS, LIELL + INTEGER JJ, J1 + INTEGER IPOSINRHSCOMP + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + IF (WHAT .NE. 0.AND. WHAT.NE.1.AND.WHAT.NE.2) THEN + WRITE(*,*) "Internal error in DMUMPS_639" + CALL MUMPS_ABORT() + ENDIF + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + IPOSINRHSCOMP = 1 + POSINRHSCOMP = -9678 + IF (WHAT .NE. 0) THEN + POSINRHSCOMP_N = 0 + ENDIF + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & NSLAVES)) THEN + IPOS = PTRIST(ISTEP) + NPIV = IW(IPOS+3+KEEP(IXSZ)) + POSINRHSCOMP(ISTEP) = IPOSINRHSCOMP + IF (WHAT .NE. 0) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP) + LIELL = IW(IPOS+3+KEEP(IXSZ)) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2+ KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + ENDIF + IF (MTYPE.eq.1 .OR. KEEP(50).NE.0) THEN + J1=IPOS+1 + ELSE + J1=IPOS+1+LIELL + END IF + DO JJ = J1, J1+NPIV-1 + POSINRHSCOMP_N(IW(JJ)) = IPOSINRHSCOMP+JJ-J1 + END DO + ENDIF + IPOSINRHSCOMP = IPOSINRHSCOMP + NPIV + ENDIF + ENDDO + RETURN + END SUBROUTINE DMUMPS_639 + SUBROUTINE DMUMPS_248(N, A, LA, IW, LIW, WCB, LWCB, + & RHS, LRHS, NRHS, + & PTRICB, IWCB, LIWCB, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, BUILD_POSINRHSCOMP, + & NE_STEPS, NA, LNA, STEP, + & FRERE, DAD, FILS, + & NSTK_S, IPOOL, LPOOL, PTRIST, PTRFAC, MYLEAF, INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS, + & SLAVEF, COMM, MYID, BUFR, LBUFR, LBUFR_BYTES, + & RHS_ROOT, LRHS_ROOT, MTYPE, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE DMUMPS_OOC + IMPLICIT NONE + INTEGER MTYPE + INTEGER(8) :: LA + INTEGER N, LIW, LWCB, LPOOL, LIWCB, LNA + INTEGER SLAVEF, MYLEAF, COMM, MYID + INTEGER INFO( 40 ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER LRHS, NRHS + DOUBLE PRECISION A( LA ), RHS( LRHS, NRHS ), WCB( LWCB ) + INTEGER LRHS_ROOT + DOUBLE PRECISION RHS_ROOT( LRHS_ROOT ) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER NA( LNA ), NE_STEPS( KEEP(28) ) + INTEGER STEP( N ), FRERE( KEEP(28) ), FILS( N ), + & DAD( KEEP(28) ) + INTEGER NSTK_S(KEEP(28)), IPOOL( LPOOL ) + INTEGER PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PTRICB( KEEP(28) ) + INTEGER IW( LIW ), IWCB( LIWCB ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER POSINRHSCOMP(KEEP(28)), LRHSCOMP + LOGICAL BUILD_POSINRHSCOMP + DOUBLE PRECISION RHSCOMP( LRHSCOMP, NRHS ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER MSGTAG, MSGSOU, DUMMY(1) + LOGICAL FLAG + INTEGER NBFIN, MYROOT + INTEGER POSIWCB,POSWCB,PLEFTWCB + INTEGER INODE + INTEGER RHSCOMPFREEPOS + INTEGER I + INTEGER III, NBROOT,LEAF + LOGICAL BLOQ + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + POSIWCB = LIWCB + POSWCB = LWCB + PLEFTWCB= 1 + IF (BUILD_POSINRHSCOMP) RHSCOMPFREEPOS= 1 + DO I = 1, KEEP(28) + NSTK_S(I) = NE_STEPS(I) + ENDDO + PTRICB = 0 + CALL MUMPS_362(N, LEAF, NBROOT, MYROOT, MYID, + & SLAVEF, NA, LNA, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, IPOOL, LPOOL) + NBFIN = SLAVEF + IF ( MYROOT .EQ. 0 ) THEN + NBFIN = NBFIN - 1 + DUMMY(1) = 1 + CALL DMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, + & RACINE_SOLVE, SLAVEF) + END IF + MYLEAF = LEAF - 1 + III = 1 + 50 CONTINUE + IF (SLAVEF .EQ. 1) THEN + CALL DMUMPS_574 + & ( IPOOL(1), LPOOL, III, LEAF, INODE, + & KEEP(208) ) + GOTO 60 + ENDIF + BLOQ = ( ( III .EQ. LEAF ) + & ) + CALL DMUMPS_303( BLOQ, FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 .OR. NBFIN .EQ. 0 ) GOTO 260 + IF (.not. FLAG) THEN + IF (III .NE. LEAF) THEN + CALL DMUMPS_574 + & (IPOOL(1), LPOOL, III, LEAF, INODE, + & KEEP(208) ) + GOTO 60 + ENDIF + ENDIF + GOTO 50 + 60 CONTINUE + CALL DMUMPS_302( INODE, BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, N, + & IPOOL, LPOOL, III, LEAF, NBFIN, NSTK_S, + & IWCB, LIWCB, WCB, LWCB, A, LA, + & IW, LIW, RHS, LRHS, NRHS, + & POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS, + & FILS, STEP, FRERE, DAD, + & MYROOT, INFO, KEEP,KEEP8, RHS_ROOT, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & RHSCOMPFREEPOS, BUILD_POSINRHSCOMP, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( INFO( 1 ) .LT. 0 .OR. NBFIN .EQ. 0 ) GOTO 260 + GOTO 50 + 260 CONTINUE + CALL DMUMPS_150( MYID,COMM,BUFR, + & LBUFR,LBUFR_BYTES ) + RETURN + END SUBROUTINE DMUMPS_248 + RECURSIVE SUBROUTINE DMUMPS_323 + & ( BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, + & PTRFAC, IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, + & INFO, KEEP,KEEP8, STEP, PROCNODE_STEPS, + & RHS, LRHS + & ) + USE DMUMPS_OOC + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER LBUFR, LBUFR_BYTES + INTEGER MSGTAG, MSGSOU, MYID, SLAVEF, COMM + INTEGER LIW + INTEGER(8) :: LA + INTEGER N, NRHS, LPOOL, III, LEAF, NBFIN + INTEGER LIWCB, LWCB, POSWCB, PLEFTWCB, POSIWCB + INTEGER INFO( 40 ), KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER BUFR( LBUFR ) + INTEGER IPOOL( LPOOL ), NSTK_S( N ) + INTEGER IWCB( LIWCB ) + INTEGER IW( LIW ) + INTEGER PTRICB(KEEP(28)),PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N) + INTEGER PROCNODE_STEPS(KEEP(28)) + DOUBLE PRECISION WCB( LWCB ), A( LA ) + INTEGER LRHS + DOUBLE PRECISION RHS(LRHS, NRHS) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, K, JJ + INTEGER FINODE, FPERE, LONG, NCB, POSITION, NCV, NPIV + INTEGER PTRX, PTRY, PDEST, I + INTEGER(8) :: APOS + LOGICAL DUMMY + LOGICAL FLAG + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + DOUBLE PRECISION ALPHA, ONE + PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0) + INCLUDE 'mumps_headers.h' + IF ( MSGTAG .EQ. RACINE_SOLVE ) THEN + NBFIN = NBFIN - 1 + IF ( NBFIN .eq. 0 ) GOTO 270 + ELSE IF (MSGTAG .EQ. ContVec ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FINODE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FPERE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NCB, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LONG, 1, MPI_INTEGER, COMM, IERR ) + IF ( NCB .eq. 0 ) THEN + PTRICB(STEP(FINODE)) = -1 + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF ( NSTK_S(STEP(FPERE)) .EQ. 0 ) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + IF ( LEAF > LPOOL ) THEN + WRITE(*,*) 'Internal error 41r2 : Pool is too small.' + CALL MUMPS_ABORT() + END IF + END IF + ELSE + IF ( PTRICB(STEP(FINODE)) .EQ. 0 ) THEN + PTRICB(STEP(FINODE)) = NCB + 1 + END IF + IF ( ( POSIWCB - LONG ) .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = LONG + GOTO 260 + END IF + IF ( POSWCB - PLEFTWCB + 1 .LT. LONG * NRHS) THEN + INFO( 1 ) = -11 + INFO( 2 ) = PLEFTWCB - POSWCB - 1 + LONG * NRHS + GOTO 260 + END IF + IF (LONG .GT. 0) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IWCB( 1 ), + & LONG, MPI_INTEGER, COMM, IERR ) + DO K = 1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WCB( PLEFTWCB ), + & LONG, MPI_DOUBLE_PRECISION, COMM, IERR ) + DO I = 1, LONG + RHS(IWCB(I),K) = RHS(IWCB(I),K) +WCB(PLEFTWCB+I-1) + ENDDO + END DO + PTRICB(STEP(FINODE)) = PTRICB(STEP(FINODE)) - LONG + ENDIF + IF ( PTRICB(STEP(FINODE)) == 1 ) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + END IF + IF ( NSTK_S(STEP(FPERE)) .EQ. 0 ) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + IF ( LEAF > LPOOL ) THEN + WRITE(*,*) 'Internal error 41r2 : Pool is too small.' + CALL MUMPS_ABORT() + END IF + ENDIF + END IF + ELSEIF ( MSGTAG .EQ. Master2Slave ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FINODE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FPERE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NCV, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NPIV, 1, MPI_INTEGER, COMM, IERR ) + PTRY = PLEFTWCB + PTRX = PLEFTWCB + NCV * NRHS + PLEFTWCB = PLEFTWCB + (NPIV + NCV) * NRHS + IF ( POSWCB - PLEFTWCB + 1 .LT. 0 ) THEN + INFO(1) = -11 + INFO(2) = -POSWCB + PLEFTWCB -1 + GO TO 260 + END IF + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WCB( PTRY + (K-1) * NCV ), NCV, + & MPI_DOUBLE_PRECISION, COMM, IERR ) + ENDDO + IF ( NPIV .GT. 0 ) THEN + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WCB( PTRX + (K-1)*NPIV ), NPIV, + & MPI_DOUBLE_PRECISION, COMM, IERR ) + END DO + END IF + IF (KEEP(201).GT.0) THEN + CALL DMUMPS_643( + & FINODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,DUMMY,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + APOS = PTRFAC(STEP(FINODE)) + IF (KEEP(201).EQ.1) THEN + IF ( NRHS == 1 ) THEN + CALL dgemv( 'N', NCV, NPIV, ALPHA, A(APOS), NCV, + & WCB( PTRX ), 1, ONE, + & WCB( PTRY ), 1 ) + ELSE + CALL dgemm( 'N', 'N', NCV, NRHS, NPIV, ALPHA, + & A(APOS), NCV, + & WCB( PTRX), NPIV, ONE, + & WCB( PTRY), NCV ) + ENDIF + ELSE + IF ( NRHS == 1 ) THEN + CALL dgemv( 'T', NPIV, NCV, ALPHA, A(APOS), NPIV, + & WCB( PTRX ), 1, ONE, + & WCB( PTRY ), 1 ) + ELSE + CALL dgemm( 'T', 'N', NCV, NRHS, NPIV, ALPHA, + & A(APOS), NPIV, + & WCB( PTRX), NPIV, ONE, + & WCB( PTRY), NCV ) + ENDIF + ENDIF + IF (KEEP(201).GT.0) THEN + CALL DMUMPS_598(FINODE,PTRFAC, + & KEEP(28),A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + PLEFTWCB = PLEFTWCB - NPIV * NRHS + PDEST = MUMPS_275( PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF ) + IF ( PDEST .EQ. MYID ) THEN + IF ( PTRICB(STEP(FINODE)) .EQ. 0 ) THEN + NCB = IW( PTRIST(STEP(FINODE)) + 2 + KEEP(IXSZ) ) + PTRICB(STEP(FINODE)) = NCB + 1 + END IF + DO I = 1, NCV + JJ=IW(PTRIST(STEP(FINODE))+3+I+ KEEP(IXSZ) ) + DO K=1, NRHS + RHS(JJ,K)= RHS(JJ,K) + WCB(PTRY+I-1+(K-1)*NCV) + ENDDO + END DO + PTRICB(STEP(FINODE)) = + & PTRICB(STEP(FINODE)) - NCV + IF ( PTRICB( STEP( FINODE ) ) == 1 ) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + END IF + IF ( NSTK_S(STEP(FPERE)) .EQ. 0 ) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + IF ( LEAF > LPOOL ) THEN + WRITE(*,*) 'INTERNAL Error 41r: Pool is too small.' + CALL MUMPS_ABORT() + END IF + ENDIF + ELSE + 210 CONTINUE + CALL DMUMPS_78( NRHS, FINODE, FPERE, + & IW(PTRIST(STEP( FINODE )) + 2 + KEEP(IXSZ) ), NCV,NCV, + & IW(PTRIST(STEP(FINODE))+4+ KEEP(IXSZ) ), + & WCB( PTRY ), PDEST, ContVec, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL DMUMPS_303( .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 210 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = ( NCV + 4 ) * KEEP( 34 ) + + & NCV * KEEP( 35 ) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = ( NCV + 4 ) * KEEP( 34 ) + + & NCV * KEEP( 35 ) + END IF + END IF + PLEFTWCB = PLEFTWCB - NCV * NRHS + ELSEIF ( MSGTAG .EQ. TERREUR ) THEN + INFO(1) = -001 + INFO(2) = MSGSOU + GOTO 270 + ELSE IF ( (MSGTAG.EQ.UPDATE_LOAD).OR. + & (MSGTAG.EQ.TAG_DUMMY) ) THEN + GO TO 270 + ELSE + INFO(1)=-100 + INFO(2)=MSGTAG + GO TO 260 + ENDIF + GO TO 270 + 260 CONTINUE + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + 270 CONTINUE + RETURN + END SUBROUTINE DMUMPS_323 + SUBROUTINE DMUMPS_302( INODE, + & BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, + & N, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, + & IWCB, LIWCB, + & WCB, LWCB, A, LA, IW, LIW, + & RHS, LRHS, NRHS, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS, + & FILS, STEP, FRERE, DAD, + & MYROOT, + & INFO, KEEP,KEEP8, RHS_ROOT, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & RHSCOMPFREEPOS, BUILD_POSINRHSCOMP, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & + & ) + USE DMUMPS_OOC + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER MTYPE + INTEGER INODE, LBUFR, LBUFR_BYTES + INTEGER MSGTAG, MSGSOU, MYID, SLAVEF, COMM + INTEGER LIWCB, LWCB, LIW, POSWCB, PLEFTWCB, POSIWCB + INTEGER(8) :: LA + INTEGER N, LPOOL, III, LEAF, NBFIN + INTEGER MYROOT + INTEGER INFO( 40 ), KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER BUFR( LBUFR ) + INTEGER IPOOL( LPOOL ), NSTK_S(KEEP(28)) + INTEGER IWCB( LIWCB ), IW( LIW ) + INTEGER LRHS, NRHS + DOUBLE PRECISION WCB( LWCB ), A( LA ) + DOUBLE PRECISION RHS(LRHS, NRHS ), RHS_ROOT( * ) + INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER FILS( N ), STEP( N ), FRERE(KEEP(28)), DAD(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER POSINRHSCOMP(KEEP(28)), LRHSCOMP, RHSCOMPFREEPOS + DOUBLE PRECISION RHSCOMP(LRHSCOMP, NRHS) + LOGICAL BUILD_POSINRHSCOMP + EXTERNAL dgemv, dtrsv, dgemm, dtrsm, MUMPS_275 + INTEGER MUMPS_275 + DOUBLE PRECISION ALPHA,ONE,ZERO + PARAMETER (ZERO=0.0D0, ONE = 1.0D0, ALPHA=-1.0D0) + INTEGER(8) :: APOS, APOS1, APOS2, APOSOFF + INTEGER I, J, K, IPOS, NSLAVES, J1, J2, J3, FPERE, NPIV, NCB, + & IERR, IFR_ini, + & IFR, LIELL, JJ, + & NELIM, PLEFT, PCB_COURANT, PPIV_COURANT + INTEGER IPOSINRHSCOMP + INTEGER Effective_CB_Size, NUPDATE, ISLAVE, PDEST, FirstIndex + LOGICAL FLAG, OMP_FLAG + INCLUDE 'mumps_headers.h' + INTEGER POSWCB1,POSWCB2 + INTEGER(8) :: APOSDEB + INTEGER TempNROW, TempNCOL, PANEL_SIZE, LIWFAC, + & JFIN, NBJ, NUPDATE_PANEL, + & PPIV_PANEL, PCB_PANEL, NBK, TYPEF + INTEGER LD_WCBPIV + INTEGER LD_WCBCB + INTEGER LDAJ, LDAJ_FIRST_PANEL + INTEGER TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPANEL + LOGICAL MUST_BE_PERMUTED + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER DUMMY( 1 ) + IF ( INODE .eq. KEEP( 38 ) .OR. INODE .eq.KEEP( 20 ) ) THEN + LIELL = IW( PTRIST( STEP(INODE)) + 3 + KEEP(IXSZ)) + NPIV = LIELL + NELIM = 0 + NSLAVES = 0 + IPOS = PTRIST( STEP(INODE)) + 5 + KEEP(IXSZ) + ELSE + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + NELIM = IW(IPOS-1) + NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) ) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + IPOS = IPOS + 1 + IF (KEEP(201).GT.0) THEN + CALL DMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL DMUMPS_755( + & IW(IPOS+1+2*LIELL+1+NSLAVES), + & MUST_BE_PERMUTED ) + ENDIF + ENDIF + NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ)) + IPOS = IPOS + 1 + NSLAVES + END IF + IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN + J1 = IPOS + 1 + J2 = IPOS + LIELL + J3 = IPOS + NPIV + ELSE + J1 = IPOS + LIELL + 1 + J2 = IPOS + 2 * LIELL + J3 = IPOS + LIELL + NPIV + END IF + NCB = LIELL-NPIV + IF ( INODE .eq. KEEP( 38 ) .OR. INODE .eq. KEEP(20) ) THEN + IFR = 0 + DO JJ = J1, J3 + J = IW( JJ ) + IFR = IFR + 1 + DO K=1,NRHS + RHS_ROOT(IFR+NPIV*(K-1)) = RHS(J,K) + END DO + END DO + IF ( NPIV .LT. LIELL ) THEN + WRITE(*,*) ' Internal error in SOLVE_NODE for Root node' + CALL MUMPS_ABORT() + END IF + MYROOT = MYROOT - 1 + IF ( MYROOT .EQ. 0 ) THEN + NBFIN = NBFIN - 1 + IF (SLAVEF .GT. 1) THEN + DUMMY (1) = 1 + CALL DMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, + & COMM, RACINE_SOLVE, SLAVEF) + ENDIF + END IF + GO TO 270 + END IF + APOS = PTRFAC(STEP(INODE)) + IF (KEEP(201).EQ.1) THEN + IF (MTYPE.EQ.1) THEN + IF ((MTYPE.EQ.1).AND.NSLAVES.NE.0) THEN + TempNROW= NPIV+NELIM + TempNCOL= NPIV + LDAJ_FIRST_PANEL=TempNROW + ELSE + TempNROW= LIELL + TempNCOL= NPIV + LDAJ_FIRST_PANEL=TempNROW + ENDIF + TYPEF=TYPEF_L + ELSE + TempNCOL= LIELL + TempNROW= NPIV + LDAJ_FIRST_PANEL=TempNCOL + TYPEF= TYPEF_U + ENDIF + LIWFAC = IW(PTRIST(STEP(INODE))+XXI) + PANEL_SIZE = DMUMPS_690( LDAJ_FIRST_PANEL ) + ENDIF + PLEFT = PLEFTWCB + PPIV_COURANT = PLEFTWCB + PLEFTWCB = PLEFTWCB + LIELL * NRHS + IF ( POSWCB - PLEFTWCB + 1 .LT. 0 ) THEN + INFO(1) = -11 + INFO(2) = PLEFTWCB - POSWCB - 1 + GO TO 260 + END IF + IF (KEEP(201).EQ.1) THEN + LD_WCBPIV = LIELL + LD_WCBCB = LIELL + PCB_COURANT = PPIV_COURANT + NPIV + DO K=1, NRHS + IFR = PPIV_COURANT + (K-1)*LIELL - 1 + DO JJ = J1, J3 + J = IW(JJ) + IFR = IFR + 1 + WCB(IFR) = RHS(J,K) + ENDDO + IF (NCB.GT.0) THEN + DO JJ = J3+1, J2 + J = IW(JJ) + IFR = IFR + 1 + WCB(IFR) = RHS(J,K) + RHS (J,K) = ZERO + ENDDO + ENDIF + END DO + ELSE + LD_WCBPIV = NPIV + LD_WCBCB = NCB + PCB_COURANT = PPIV_COURANT + NPIV*NRHS + IFR = PPIV_COURANT - 1 + OMP_FLAG = NRHS.GT.4 + IFR_ini = IFR + DO 130 JJ = J1, J3 + J = IW(JJ) + IFR = IFR_ini + (JJ-J1) + 1 + DO K=1, NRHS + WCB(IFR+(K-1)*NPIV) = RHS(J,K) + END DO + 130 CONTINUE + IFR = PCB_COURANT - 1 + IF (NPIV .LT. LIELL) THEN + IFR_ini = IFR + DO 140 JJ = J3 + 1, J2 + J = IW(JJ) + IFR = IFR_ini + (JJ-J3) + DO K=1, NRHS + WCB(IFR+(K-1)*NCB) = RHS(J,K) + RHS(J,K)=ZERO + ENDDO + 140 CONTINUE + ENDIF + ENDIF + IF ( NPIV .NE. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + APOSDEB = APOS + J = 1 + IPANEL = 0 + 10 CONTINUE + IPANEL = IPANEL + 1 + JFIN = min(J+PANEL_SIZE-1, NPIV) + IF (IW(IPOS+ LIELL + JFIN) < 0) THEN + JFIN=JFIN+1 + ENDIF + NBJ = JFIN-J+1 + LDAJ = LDAJ_FIRST_PANEL-J+1 + IF ( (KEEP(50).NE.1).AND. MUST_BE_PERMUTED ) THEN + CALL DMUMPS_667(TYPEF, TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPOS+1+2*LIELL, IW, LIW) + IF (NPIV.EQ.(IW(I_PIVRPTR+IPANEL-1)-1)) THEN + MUST_BE_PERMUTED=.FALSE. + ELSE + CALL DMUMPS_698( + & IW( I_PIVR+ IW(I_PIVRPTR+IPANEL-1)- + & IW(I_PIVRPTR)), + & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, + & IW(I_PIVRPTR+IPANEL-1)-1, + & + & A(APOSDEB), + & LDAJ, NBJ, J-1 ) + ENDIF + ENDIF + NUPDATE_PANEL = LDAJ - NBJ + PPIV_PANEL = PPIV_COURANT+J-1 + PCB_PANEL = PPIV_PANEL+NBJ + APOS1 = APOSDEB+int(NBJ,8) + IF (MTYPE.EQ.1) THEN + IF ( NRHS == 1 ) THEN + CALL dtrsv( 'L', 'N', 'U', NBJ, A(APOSDEB), LDAJ, + & WCB(PPIV_PANEL), 1 ) + IF (NUPDATE_PANEL.GT.0) THEN + CALL dgemv('N', NUPDATE_PANEL,NBJ,ALPHA, A(APOS1), + & LDAJ, WCB(PPIV_PANEL), 1, ONE, + & WCB(PCB_PANEL), 1) + ENDIF + ELSE + CALL dtrsm( 'L','L','N','U', NBJ, NRHS, ONE, + & A(APOSDEB), LDAJ, WCB(PPIV_PANEL), + & LIELL ) + IF (NUPDATE_PANEL.GT.0) THEN + CALL dgemm('N', 'N', NUPDATE_PANEL, NRHS, NBJ, + & ALPHA, + & A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE, + & WCB(PCB_PANEL), LIELL) + ENDIF + ENDIF + ELSE + IF (NRHS == 1) THEN + CALL dtrsv( 'L', 'N', 'N', NBJ, A(APOSDEB), LDAJ, + & WCB(PPIV_PANEL), 1 ) + IF (NUPDATE_PANEL.GT.0) THEN + CALL dgemv('N',NUPDATE_PANEL, NBJ, ALPHA, A(APOS1), + & LDAJ, WCB(PPIV_PANEL), 1, + & ONE, WCB(PCB_PANEL), 1 ) + ENDIF + ELSE + CALL dtrsm('L','L','N','N',NBJ, NRHS, ONE, + & A(APOSDEB), LDAJ, WCB(PPIV_PANEL), + & LIELL) + IF (NUPDATE_PANEL.GT.0) THEN + CALL dgemm('N', 'N', NUPDATE_PANEL, NRHS, NBJ, + & ALPHA, + & A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE, + & WCB(PCB_PANEL), LIELL) + ENDIF + ENDIF + ENDIF + APOSDEB = APOSDEB+int(LDAJ,8)*int(NBJ,8) + J=JFIN+1 + IF ( J .LE. NPIV ) GOTO 10 + ELSE + IF (KEEP(50).NE.0) THEN + IF ( NRHS == 1 ) THEN + CALL dtrsv( 'U', 'T', 'U', NPIV, A(APOS), NPIV, + & WCB(PPIV_COURANT), 1 ) + ELSE + CALL dtrsm( 'L','U','T','U', NPIV, NRHS, ONE, + & A(APOS), NPIV, WCB(PPIV_COURANT), + & NPIV ) + ENDIF + ELSE + IF ( MTYPE .eq. 1 ) THEN + IF ( NRHS == 1) THEN + CALL dtrsv( 'U', 'T', 'U', NPIV, A(APOS), LIELL, + & WCB(PPIV_COURANT), 1 ) + ELSE + CALL dtrsm( 'L','U','T','U', NPIV, NRHS, ONE, + & A(APOS), LIELL, WCB(PPIV_COURANT), + & NPIV ) + ENDIF + ELSE + IF (NRHS == 1) THEN + CALL dtrsv( 'L', 'N', 'N', NPIV, A(APOS), LIELL, + & WCB(PPIV_COURANT), 1 ) + ELSE + CALL dtrsm('L','L','N','N',NPIV, NRHS, ONE, + & A(APOS), LIELL, WCB(PPIV_COURANT), + & NPIV) + ENDIF + END IF + END IF + END IF + END IF + NCB = LIELL - NPIV + IF ( MTYPE .EQ. 1 ) THEN + IF ( KEEP(50) .eq. 0 ) THEN + APOS1 = APOS + int(NPIV,8) * int(LIELL,8) + ELSE + APOS1 = APOS + int(NPIV,8) * int(NPIV,8) + END IF + IF ( NSLAVES .EQ. 0 .OR. NPIV .eq. 0 ) THEN + NUPDATE = NCB + ELSE + NUPDATE = NELIM + END IF + ELSE + APOS1 = APOS + int(NPIV,8) + NUPDATE = NCB + END IF + IF (KEEP(201).NE.1) THEN + IF ( NPIV .NE. 0 .AND. NUPDATE.NE.0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + IF ( NRHS == 1 ) THEN + CALL dgemv('T', NPIV, NUPDATE, ALPHA, A(APOS1), + & NPIV, WCB(PPIV_COURANT), 1, ONE, + & WCB(PCB_COURANT), 1) + ELSE + CALL dgemm('T', 'N', NUPDATE, NRHS, NPIV, ALPHA, + & A(APOS1), NPIV, WCB(PPIV_COURANT), NPIV, ONE, + & WCB(PCB_COURANT), NCB) + END IF + ELSE + IF ( NRHS == 1 ) THEN + CALL dgemv('N',NUPDATE, NPIV, ALPHA, A(APOS1), + & LIELL, WCB(PPIV_COURANT), 1, + & ONE, WCB(PCB_COURANT), 1 ) + ELSE + CALL dgemm('N', 'N', NUPDATE, NRHS, NPIV, ALPHA, + & A(APOS1), LIELL, WCB(PPIV_COURANT), NPIV, ONE, + & WCB(PCB_COURANT), NCB) + END IF + END IF + END IF + END IF + IF (BUILD_POSINRHSCOMP) THEN + POSINRHSCOMP(STEP(INODE)) = RHSCOMPFREEPOS + RHSCOMPFREEPOS = RHSCOMPFREEPOS + NPIV + ENDIF + IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + IF ( KEEP(50) .eq. 0 ) THEN + DO K=1,NRHS + IFR = PPIV_COURANT + (K-1)*LD_WCBPIV + RHSCOMP(IPOSINRHSCOMP:IPOSINRHSCOMP+NPIV-1, K) = + & WCB(IFR:IFR+NPIV-1) + ENDDO + ELSE + IFR = PPIV_COURANT - 1 + IF (KEEP(201).EQ.1) THEN + LDAJ = TempNROW + ELSE + LDAJ = NPIV + ENDIF + APOS1 = APOS + JJ = J1 + IF (KEEP(201).EQ.1) THEN + NBK = 0 + ENDIF + DO + IF(JJ .GT. J3) EXIT + IFR = IFR + 1 + IF(IW(JJ+LIELL) .GT. 0) THEN + DO K=1, NRHS + RHSCOMP(IPOSINRHSCOMP+JJ-J1 , K ) = + & WCB( IFR+(K-1)*LD_WCBPIV ) * A( APOS1 ) + END DO + IF (KEEP(201).EQ.1) THEN + NBK = NBK+1 + IF (NBK.EQ.PANEL_SIZE) THEN + NBK = 0 + LDAJ = LDAJ - PANEL_SIZE + ENDIF + ENDIF + APOS1 = APOS1 + int(LDAJ + 1,8) + JJ = JJ+1 + ELSE + IF (KEEP(201).EQ.1) THEN + NBK = NBK+1 + ENDIF + APOS2 = APOS1+int(LDAJ+1,8) + IF (KEEP(201).EQ.1) THEN + APOSOFF = APOS1+int(LDAJ,8) + ELSE + APOSOFF=APOS1+1_8 + ENDIF + DO K=1, NRHS + POSWCB1 = IFR+(K-1)*LD_WCBPIV + POSWCB2 = POSWCB1+1 + RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = WCB(POSWCB1)*A(APOS1) + & + WCB(POSWCB2)*A(APOSOFF) + RHSCOMP(IPOSINRHSCOMP+JJ-J1+1,K) = + & WCB(POSWCB1)*A(APOSOFF) + & + WCB(POSWCB2)*A(APOS2) + END DO + IF (KEEP(201).EQ.1) THEN + NBK = NBK+1 + IF (NBK.GE.PANEL_SIZE) THEN + LDAJ = LDAJ - NBK + NBK = 0 + ENDIF + ENDIF + APOS1 = APOS2 + int(LDAJ + 1,8) + JJ = JJ+2 + IFR = IFR+1 + ENDIF + ENDDO + END IF + IF (KEEP(201).GT.0) THEN + CALL DMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + END IF + FPERE = DAD(STEP(INODE)) + IF ( FPERE .EQ. 0 ) THEN + MYROOT = MYROOT - 1 + PLEFTWCB = PLEFTWCB - LIELL *NRHS + IF ( MYROOT .EQ. 0 ) THEN + NBFIN = NBFIN - 1 + IF (SLAVEF .GT. 1) THEN + DUMMY (1) = 1 + CALL DMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, + & COMM, RACINE_SOLVE, SLAVEF) + ENDIF + END IF + GO TO 270 + ENDIF + IF ( NUPDATE .NE. 0 .OR. NCB.eq.0 ) THEN + IF (MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .EQ. MYID) THEN + IF ( NCB .ne. 0 ) THEN + PTRICB(STEP(INODE)) = NCB + 1 + DO 190 I = 1, NUPDATE + DO K=1, NRHS + RHS( IW(J3 + I), K ) = RHS( IW(J3 + I), K ) + & + WCB(PCB_COURANT + I-1 +(K-1)*LD_WCBCB) + ENDDO + 190 CONTINUE + PTRICB(STEP( INODE )) = PTRICB(STEP( INODE )) - NUPDATE + IF ( PTRICB(STEP(INODE)) == 1 ) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF (NSTK_S(STEP(FPERE)) .EQ. 0) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + ENDIF + END IF + ELSE + PTRICB(STEP( INODE )) = -1 + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF (NSTK_S(STEP(FPERE)) .EQ. 0) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + ENDIF + ENDIF + ELSE + 210 CONTINUE + CALL DMUMPS_78( NRHS, INODE, FPERE, NCB, LD_WCBCB, + & NUPDATE, + & IW( J3 + 1 ), WCB( PCB_COURANT ), + & MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), SLAVEF), + & ContVec, + & COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL DMUMPS_303( .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 210 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = NUPDATE * KEEP( 35 ) + + & ( NUPDATE + 3 ) * KEEP( 34 ) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = NUPDATE * KEEP( 35 ) + + & ( NUPDATE + 3 ) * KEEP( 34 ) + GOTO 260 + END IF + ENDIF + END IF + IF ( NSLAVES .NE. 0 .AND. MTYPE .eq. 1 + & .and. NPIV .NE. 0 ) THEN + DO ISLAVE = 1, NSLAVES + PDEST = IW( PTRIST(STEP(INODE)) + 5 + ISLAVE +KEEP(IXSZ)) + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB - NELIM, + & NSLAVES, + & Effective_CB_Size, FirstIndex ) + 222 CALL DMUMPS_72( NRHS, + & INODE, FPERE, + & Effective_CB_Size, LD_WCBCB, LD_WCBPIV, NPIV, + & WCB( PCB_COURANT + NELIM + FirstIndex - 1 ), + & WCB( PPIV_COURANT ), + & PDEST, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL DMUMPS_303( .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 222 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = (NPIV+Effective_CB_Size)*NRHS*KEEP(35) + + & ( Effective_CB_Size + 4 ) * KEEP( 34 ) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = (NPIV+Effective_CB_Size)*NRHS*KEEP(35) + + & ( Effective_CB_Size + 4 ) * KEEP( 34 ) + GOTO 260 + END IF + END DO + END IF + PLEFTWCB = PLEFTWCB - LIELL*NRHS + 270 CONTINUE + RETURN + 260 CONTINUE + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE DMUMPS_302 + RECURSIVE SUBROUTINE DMUMPS_303( BLOQ, FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, PROCNODE_STEPS, + & RHS, LRHS + & ) + IMPLICIT NONE + LOGICAL BLOQ + INTEGER LBUFR, LBUFR_BYTES + INTEGER MYID, SLAVEF, COMM + INTEGER N, NRHS, LPOOL, III, LEAF, NBFIN + INTEGER LIWCB, LWCB, POSWCB, PLEFTWCB, POSIWCB + INTEGER LIW + INTEGER(8) :: LA + INTEGER INFO( 40 ), KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER BUFR( LBUFR ), IPOOL(LPOOL) + INTEGER NSTK_S( KEEP(28) ) + INTEGER IWCB( LIWCB ) + INTEGER IW( LIW ) + DOUBLE PRECISION WCB( LWCB ), A( LA ) + INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER LRHS + DOUBLE PRECISION RHS(LRHS, NRHS) + LOGICAL FLAG + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + INTEGER MSGSOU, MSGTAG, MSGLEN + FLAG = .FALSE. + IF ( BLOQ ) THEN + CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, + & COMM, STATUS, IERR ) + FLAG = .TRUE. + ELSE + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + END IF + IF ( FLAG ) THEN + MSGSOU = STATUS( MPI_SOURCE ) + MSGTAG = STATUS( MPI_TAG ) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) + IF ( MSGLEN .GT. LBUFR_BYTES ) THEN + INFO(1) = -20 + INFO(2) = MSGLEN + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + ELSE + CALL MPI_RECV( BUFR, LBUFR_BYTES, MPI_PACKED, + & MSGSOU, MSGTAG, COMM, STATUS, IERR ) + CALL DMUMPS_323( BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + END IF + END IF + RETURN + END SUBROUTINE DMUMPS_303 + SUBROUTINE DMUMPS_249(N, A, LA, IW, LIW, W, LWC, + & RHS, LRHS, NRHS, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & PTRICB, PTRACB, IWCB, LIWW, W2, + & NE_STEPS, NA, LNA, STEP, + & FRERE, DAD, FILS, IPOOL, LPOOL, PTRIST, PTRFAC, + & MYLEAF, INFO, + & PROCNODE_STEPS, + & SLAVEF, COMM,MYID, BUFR, LBUFR, LBUFR_BYTES, + & KEEP,KEEP8, RHS_ROOT, LRHS_ROOT, MTYPE, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, PANEL_POS, LPANEL_POS + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + USE DMUMPS_OOC + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER MTYPE + INTEGER(8) :: LA + INTEGER N,LIW,LIWW,LWC,LPOOL,LNA + INTEGER SLAVEF,MYLEAF,COMM,MYID + INTEGER LPANEL_POS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER NA(LNA),NE_STEPS(KEEP(28)) + INTEGER IPOOL(LPOOL) + INTEGER PANEL_POS(LPANEL_POS) + INTEGER INFO(40) + INTEGER PTRIST(KEEP(28)), + & PTRICB(KEEP(28)),PTRACB(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER LRHS, NRHS + DOUBLE PRECISION A(LA), RHS(LRHS,NRHS), W(LWC) + DOUBLE PRECISION W2(KEEP(133)) + INTEGER IW(LIW),IWCB(LIWW) + INTEGER STEP(N), FRERE(KEEP(28)),DAD(KEEP(28)),FILS(N) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR(LBUFR) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28)) + DOUBLE PRECISION RHSCOMP(LRHSCOMP,NRHS) + INTEGER LRHS_ROOT + DOUBLE PRECISION RHS_ROOT( LRHS_ROOT ) + INTEGER, intent(in) :: SIZE_TO_PROCESS + LOGICAL, intent(in) :: TO_PROCESS(SIZE_TO_PROCESS) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + LOGICAL FLAG + INTEGER POSIWCB,POSWCB,K + INTEGER(8) :: APOS, IST + INTEGER NPIV + INTEGER IPOS,LIELL,NELIM,IFR,JJ,I + INTEGER J1,J2,J,NCB,NBFINF + INTEGER NBLEAF,INODE,NBROOT,NROOT,NBFILS + INTEGER IN,IF,LONG,POOL_FIRST_POS,TMP + INTEGER III,IIPOOL,MYLEAFE + INTEGER NSLAVES + DOUBLE PRECISION ALPHA,ONE,ZERO + PARAMETER (ZERO=0.0D0, ONE = 1.0D0, ALPHA=-1.0D0) + LOGICAL BLOQ,DEBUT + INTEGER PROCDEST, DEST + INTEGER POSINDICES, IPOSINRHSCOMP + INTEGER DUMMY(1) + INTEGER PLEFTW, PTWCB + INTEGER Offset, EffectiveSize, ISLAVE, FirstIndex + LOGICAL LTLEVEL2, IN_SUBTREE + INTEGER TYPENODE + INCLUDE 'mumps_headers.h' + LOGICAL BLOCK_SEQUENCE + INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR + LOGICAL MUST_BE_PERMUTED + LOGICAL NO_CHILDREN + LOGICAL Exploit_Sparsity, AM1 + LOGICAL DEJA_SEND( 0:SLAVEF-1 ) + INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS + INTEGER LDAJ, NBJ, LIWFAC, + & NBJLAST, NPIV_LAST, PANEL_SIZE, + & PTWCB_PANEL, NCB_PANEL, TYPEF + INTEGER BEG_PANEL + LOGICAL TWOBYTWO + INTEGER NPANELS, IPANEL + LOGICAL MUMPS_170 + INTEGER MUMPS_330 + EXTERNAL dgemv, dtrsv, dtrsm, dgemm, + & MUMPS_330, + & MUMPS_170 + PLEFTW = 1 + POSIWCB = LIWW + POSWCB = LWC + NROOT = 0 + NBLEAF = NA(1) + NBROOT = NA(2) + DO I = NBROOT, 1, -1 + INODE = NA(NBLEAF+I+2) + IF (MUMPS_275(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) .EQ. MYID) THEN + NROOT = NROOT + 1 + IPOOL(NROOT) = INODE + ENDIF + END DO + III = 1 + IIPOOL = NROOT + 1 + BLOCK_SEQUENCE = .FALSE. + Exploit_Sparsity = .FALSE. + AM1 = .FALSE. + IF (KEEP(235).NE.0) Exploit_Sparsity = .TRUE. + IF (KEEP(237).NE.0) AM1 = .TRUE. + NO_CHILDREN = .FALSE. + IF (Exploit_Sparsity .OR. AM1) MYLEAF = -1 + IF (MYLEAF .EQ. -1) THEN + MYLEAF = 0 + DO I=1, NBLEAF + INODE=NA(I+2) + IF (MUMPS_275(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) .EQ. MYID) THEN + MYLEAF = MYLEAF + 1 + ENDIF + ENDDO + ENDIF + MYLEAFE=MYLEAF + NBFINF = SLAVEF + IF (MYLEAFE .EQ. 0) THEN + CALL DMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, FEUILLE, + & SLAVEF) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) THEN + GOTO 340 + ENDIF + ENDIF + 50 CONTINUE + BLOQ = ( ( III .EQ. IIPOOL ) + & ) + CALL DMUMPS_41( BLOQ, FLAG, BUFR, LBUFR, + & LBUFR_BYTES, MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO(1) .LT. 0 ) GOTO 340 + IF ( .NOT. FLAG ) THEN + IF (III .NE. IIPOOL) THEN + INODE = IPOOL(IIPOOL-1) + IIPOOL = IIPOOL - 1 + GO TO 60 + ENDIF + END IF + IF ( NBFINF .eq. 0 ) GOTO 340 + GOTO 50 + 60 CONTINUE + IF ( INODE .EQ. KEEP( 38 ) .OR. INODE .EQ. KEEP( 20 ) ) THEN + IPOS = PTRIST(STEP(INODE))+KEEP(IXSZ) + NPIV = IW(IPOS+3) + LIELL = IW(IPOS) + NPIV + IPOS = PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) + IF ( MTYPE .EQ. 1 .AND. KEEP(50) .EQ. 0) THEN + J1 = IPOS + LIELL + 1 + J2 = IPOS + LIELL + NPIV + ELSE + J1 = IPOS + 1 + J2 = IPOS + NPIV + END IF + IFR = 0 + DO JJ = J1, J2 + J = IW( JJ ) + IFR = IFR + 1 + DO K=1,NRHS + RHS(J,K) = RHS_ROOT(IFR+NPIV*(K-1)) + END DO + END DO + IN = INODE + 270 IN = FILS(IN) + IF (IN .GT. 0) GOTO 270 + IF (IN .EQ. 0) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL DMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + ENDIF + GOTO 50 + ENDIF + IF = -IN + LONG = NPIV + NBFILS = NE_STEPS(STEP(INODE)) + IF ( AM1 ) THEN + I = NBFILS + NBFILS = 0 + DO WHILE (I.GT.0) + IF ( TO_PROCESS(STEP(IF)) ) NBFILS = NBFILS+1 + IF = FRERE(STEP(IF)) + I = I -1 + ENDDO + IF (NBFILS.EQ.0) THEN + NO_CHILDREN = .TRUE. + ELSE + NO_CHILDREN = .FALSE. + ENDIF + IF = -IN + ENDIF + DEBUT = .TRUE. + DO I = 0, SLAVEF - 1 + DEJA_SEND( I ) = .FALSE. + END DO + POOL_FIRST_POS=IIPOOL + DO I = 1, NBFILS + IF ( AM1 ) THEN + 1030 IF ( .NOT.TO_PROCESS(STEP(IF)) ) THEN + IF = FRERE(STEP(IF)) + GOTO 1030 + ENDIF + NO_CHILDREN = .FALSE. + ENDIF + IF (MUMPS_275(PROCNODE_STEPS(STEP(IF)),SLAVEF) + & .EQ. MYID) THEN + IPOOL(IIPOOL) = IF + IIPOOL = IIPOOL + 1 + ELSE + PROCDEST = MUMPS_275(PROCNODE_STEPS(STEP(IF)), + & SLAVEF) + IF (.NOT. DEJA_SEND( PROCDEST )) THEN + 600 CALL DMUMPS_78( NRHS, IF, 0, 0, + & LONG, LONG, IW( J1 ), + & RHS_ROOT( 1 ), PROCDEST, + & NOEUD, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL DMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 340 + GOTO 600 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = LONG * KEEP(35) + + & ( LONG + 2 ) * KEEP(34) + GOTO 330 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = LONG * KEEP(35) + + & ( LONG + 2 ) * KEEP(34) + GOTO 330 + END IF + DEJA_SEND( PROCDEST ) = .TRUE. + END IF + IF ( IERR .NE. 0 ) CALL MUMPS_ABORT() + ENDIF + IF = FRERE(STEP(IF)) + ENDDO + IF (AM1 .AND.NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL DMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + GOTO 50 + ENDIF + ENDIF + IF (IIPOOL.NE.POOL_FIRST_POS) THEN + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + ENDIF + GOTO 50 + END IF + IN_SUBTREE = MUMPS_170( + & PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + TYPENODE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + LTLEVEL2= ( + & (TYPENODE .eq.2 ) .AND. + & (MTYPE.NE.1) ) + NPIV = IW(PTRIST(STEP(INODE))+2+KEEP(IXSZ)+1) + IF ((NPIV.NE.0).AND.(LTLEVEL2)) THEN + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + NELIM = IW(IPOS-1) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + NCB = LIELL - NPIV - NELIM + IPOS = IPOS + 2 + NSLAVES = IW( IPOS ) + Offset = 0 + IPOS = IPOS + NSLAVES + IW(PTRIST(STEP(INODE))+XXS)= C_FINI+NSLAVES + IF ( POSIWCB - 2 .LT. 0 .or. + & POSWCB - NCB*NRHS .LT. PLEFTW - 1 ) THEN + CALL DMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - NCB*NRHS .LT. PLEFTW - 1 ) THEN + INFO( 1 ) = -11 + INFO( 2 ) = NCB * NRHS - POSWCB - PLEFTW + 1 + GOTO 330 + END IF + IF ( POSIWCB - 2 .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = 2 - POSIWCB + GO TO 330 + END IF + END IF + POSIWCB = POSIWCB - 2 + POSWCB = POSWCB - NCB*NRHS + PTRICB(STEP( INODE )) = POSIWCB + 1 + PTRACB(STEP( INODE )) = POSWCB + 1 + IWCB( PTRICB(STEP( INODE )) ) = NCB + IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 + IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN + POSINDICES = IPOS + LIELL + 1 + ELSE + POSINDICES = IPOS + 1 + END IF + IF ( NCB.EQ.0 ) THEN + write(6,*) ' Internal Error type 2 node with no CB ' + CALL MUMPS_ABORT() + ENDIF + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN + J1 = IPOS + LIELL + NPIV + NELIM +1 + J2 = IPOS + 2 * LIELL + ELSE + J1 = IPOS + NPIV + NELIM +1 + J2 = IPOS + LIELL + END IF + IFR = PTRACB(STEP( INODE )) - 1 + DO JJ = J1, J2 - KEEP(253) + J = IW(JJ) + IFR = IFR + 1 + DO K=1, NRHS + W(IFR+(K-1)*NCB) = RHS(J,K) + ENDDO + ENDDO + IF (KEEP(252).NE.0) THEN + DO JJ = J2-KEEP(253)+1, J2 + IFR = IFR + 1 + DO K=1, NRHS + IF (K.EQ.JJ-J2+KEEP(253)) THEN + W(IFR+(K-1)*NCB) = ALPHA + ELSE + W(IFR+(K-1)*NCB) = ZERO + ENDIF + ENDDO + ENDDO + ENDIF + DO ISLAVE = 1, NSLAVES + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB, + & NSLAVES, + & EffectiveSize, + & FirstIndex ) + 500 DEST = IW( PTRIST(STEP(INODE))+5+ISLAVE+KEEP(IXSZ)) + CALL DMUMPS_63(NRHS, INODE, + & W(Offset+PTRACB(STEP(INODE))), EffectiveSize, + & NCB, DEST, + & BACKSLV_MASTER2SLAVE, + & COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL DMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, + & PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 340 + GOTO 500 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = EffectiveSize * KEEP(35) + + & 2 * KEEP(34) + GOTO 330 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = EffectiveSize * KEEP(35) + + & 2 * KEEP(34) + GOTO 330 + END IF + Offset = Offset + EffectiveSize + END DO + IWCB( PTRICB(STEP( INODE )) + 1 ) = 0 + CALL DMUMPS_151(NRHS,N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB,POSIWCB,PTRICB,PTRACB) + GOTO 50 + ENDIF + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + NELIM = IW(IPOS-1) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + IPOS = IPOS + 1 + IF (KEEP(201).GT.0) THEN + CALL DMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 330 + ENDIF + ENDIF + APOS = PTRFAC(IW(IPOS)) + NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) ) + IPOS = IPOS + 1 + NSLAVES + IF (KEEP(201).EQ.1) THEN + LIWFAC = IW(PTRIST(STEP(INODE))+XXI) + IF (MTYPE.NE.1) THEN + TYPEF = TYPEF_L + ELSE + TYPEF = TYPEF_U + ENDIF + PANEL_SIZE = DMUMPS_690( LIELL ) + IF (KEEP(50).NE.1) THEN + CALL DMUMPS_755( + & IW(IPOS+1+2*LIELL), + & MUST_BE_PERMUTED ) + ENDIF + ENDIF + LONG = 0 + IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN + J1 = IPOS + 1 + J2 = IPOS + NPIV + ELSE + J1 = IPOS + LIELL + 1 + J2 = IPOS + NPIV + LIELL + END IF + IF (IN_SUBTREE) THEN + PTWCB = PLEFTW + IF ( POSWCB .LT. LIELL*NRHS ) THEN + CALL DMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB .LT. LIELL*NRHS ) THEN + INFO(1) = -11 + INFO(2) = LIELL*NRHS - POSWCB + GOTO 330 + END IF + END IF + ELSE + IF ( POSIWCB - 2 .LT. 0 .or. + & POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + CALL DMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + INFO( 1 ) = -11 + INFO( 2 ) = LIELL * NRHS - POSWCB - PLEFTW + 1 + GOTO 330 + END IF + IF ( POSIWCB - 2 .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = 2 - POSIWCB + GO TO 330 + END IF + END IF + POSIWCB = POSIWCB - 2 + POSWCB = POSWCB - LIELL*NRHS + PTRICB(STEP( INODE )) = POSIWCB + 1 + PTRACB(STEP( INODE )) = POSWCB + 1 + IWCB( PTRICB(STEP( INODE )) ) = LIELL + IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 + IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN + POSINDICES = IPOS + LIELL + 1 + ELSE + POSINDICES = IPOS + 1 + END IF + PTWCB = PTRACB(STEP( INODE )) + ENDIF + IF (KEEP(252).EQ.0) IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + DO K=1, NRHS + IF (KEEP(252).NE.0) THEN + DO JJ = J1, J2 + W(PTWCB+JJ-J1+(K-1)*LIELL) = ZERO + ENDDO + ELSE + DO JJ = J1, J2 + W(PTWCB+JJ-J1+(K-1)*LIELL) = RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + ENDDO + ENDIF + END DO + IFR = PTWCB + NPIV - 1 + IF ( LIELL .GT. NPIV ) THEN + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN + J1 = IPOS + LIELL + NPIV + 1 + J2 = IPOS + 2 * LIELL + ELSE + J1 = IPOS + NPIV + 1 + J2 = IPOS + LIELL + END IF + DO JJ = J1, J2-KEEP(253) + J = IW(JJ) + IFR = IFR + 1 + DO K=1, NRHS + W(IFR+(K-1)*LIELL) = RHS(J,K) + ENDDO + ENDDO + IF (KEEP(252).NE.0) THEN + DO JJ = J2-KEEP(253)+1, J2 + IFR = IFR + 1 + DO K=1, NRHS + IF (K.EQ.JJ-J2+KEEP(253)) THEN + W(IFR+(K-1)*LIELL) = ALPHA + ELSE + W(IFR+(K-1)*LIELL) = ZERO + ENDIF + ENDDO + ENDDO + ENDIF + NCB = LIELL - NPIV + IF (NPIV .EQ. 0) GOTO 160 + ENDIF + IF (KEEP(201).EQ.1) THEN + J = NPIV / PANEL_SIZE + TWOBYTWO = KEEP(50).EQ.2 .AND. + & ((TYPENODE.EQ.1.AND.KEEP(103).GT.0) .OR. + & (TYPENODE.EQ.2.AND.KEEP(105).GT.0)) + IF (TWOBYTWO) THEN + CALL DMUMPS_641(PANEL_SIZE, PANEL_POS, LPANEL_POS, + & IW(IPOS+1+LIELL), NPIV, NPANELS, LIELL, + & NBENTRIES_ALLPANELS) + ELSE + IF (NPIV.EQ.J*PANEL_SIZE) THEN + NPIV_LAST = NPIV + NBJLAST = PANEL_SIZE + NPANELS = J + ELSE + NPIV_LAST = (J+1)* PANEL_SIZE + NBJLAST = NPIV-J*PANEL_SIZE + NPANELS = J+1 + ENDIF + NBENTRIES_ALLPANELS = + & int(LIELL,8) * int(NPIV,8) + & - int( ( J * ( J - 1 ) ) / 2,8 ) + & * int(PANEL_SIZE,8) * int(PANEL_SIZE,8) + & - int(J,8) + & * int(mod(NPIV, PANEL_SIZE),8) + & * int(PANEL_SIZE,8) + JJ=NPIV_LAST + ENDIF + APOSDEB = APOS + NBENTRIES_ALLPANELS + DO IPANEL = NPANELS, 1, -1 + IF (TWOBYTWO) THEN + NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL) + BEG_PANEL = PANEL_POS(IPANEL) + ELSE + IF (JJ.EQ.NPIV_LAST) THEN + NBJ = NBJLAST + ELSE + NBJ = PANEL_SIZE + ENDIF + BEG_PANEL = JJ- PANEL_SIZE+1 + ENDIF + LDAJ = LIELL-BEG_PANEL+1 + APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8) + PTWCB_PANEL = PTWCB + BEG_PANEL - 1 + NCB_PANEL = LDAJ - NBJ + IF (KEEP(50).NE.1 .AND. MUST_BE_PERMUTED) THEN + CALL DMUMPS_667(TYPEF, TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW) + IF (NPIV.EQ.(IW(I_PIVRPTR)-1)) THEN + MUST_BE_PERMUTED=.FALSE. + ELSE + CALL DMUMPS_698( + & IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)), + & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, + & IW(I_PIVRPTR+IPANEL-1)-1, + & A(APOSDEB), + & LDAJ, NBJ, BEG_PANEL-1) + ENDIF + ENDIF + IF ( NRHS == 1 ) THEN + IF (NCB_PANEL.NE.0) THEN + CALL dgemv( 'T', NCB_PANEL, NBJ, ALPHA, + & A( APOSDEB + int(NBJ,8) ), LDAJ, + & W( NBJ + PTWCB_PANEL ), + & 1, ONE, + & W(PTWCB_PANEL), 1 ) + ENDIF + IF (MTYPE.NE.1) THEN + CALL dtrsv('L','T','U', NBJ, A(APOSDEB), LDAJ, + & W(PTWCB_PANEL), 1) + ELSE + CALL dtrsv('L','T','N', NBJ, A(APOSDEB), LDAJ, + & W(PTWCB_PANEL), 1) + ENDIF + ELSE + IF (NCB_PANEL.NE.0) THEN + CALL dgemm( 'T', 'N', NBJ, NRHS, NCB_PANEL, ALPHA, + & A(APOSDEB +int(NBJ,8)), LDAJ, + & W(NBJ+PTWCB_PANEL),LIELL, + & ONE, W(PTWCB_PANEL),LIELL) + ENDIF + IF (MTYPE.NE.1) THEN + CALL dtrsm('L','L','T','U',NBJ, NRHS, ONE, + & A(APOSDEB), + & LDAJ, W(PTWCB_PANEL), LIELL) + ELSE + CALL dtrsm('L','L','T','N',NBJ, NRHS, ONE, + & A(APOSDEB), + & LDAJ, W(PTWCB_PANEL), LIELL) + ENDIF + ENDIF + IF (.NOT. TWOBYTWO) JJ=BEG_PANEL-1 + ENDDO + ENDIF + IF (KEEP(201).EQ.0.OR.KEEP(201).EQ.2)THEN + IF ( LIELL .GT. NPIV ) THEN + IF ( MTYPE .eq. 1 ) THEN + IST = APOS + int(NPIV,8) + IF (NRHS == 1) THEN + CALL dgemv( 'T', NCB, NPIV, ALPHA, A(IST), LIELL, + & W(NPIV + PTWCB), 1, + & ONE, + & W(PTWCB), 1 ) + ELSE + CALL dgemm('T','N', NPIV, NRHS, NCB, ALPHA, A(IST), LIELL, + & W(NPIV+PTWCB), LIELL, ONE, + & W(PTWCB), LIELL) + ENDIF + ELSE + IF ( KEEP(50) .eq. 0 ) THEN + IST = APOS + int(NPIV,8) * int(LIELL,8) + ELSE + IST = APOS + int(NPIV,8) * int(NPIV,8) + END IF + IF ( NRHS == 1 ) THEN + CALL dgemv( 'N', NPIV, NCB, ALPHA, A( IST ), NPIV, + & W( NPIV + PTWCB ), + & 1, ONE, + & W(PTWCB), 1 ) + ELSE + CALL dgemm( 'N', 'N', NPIV, NRHS, NCB, ALPHA, + & A(IST), NPIV, W(NPIV+PTWCB),LIELL, + & ONE, W(PTWCB),LIELL) + END IF + END IF + ENDIF + IF ( MTYPE .eq. 1 ) THEN + IF ( NRHS == 1 ) THEN + CALL dtrsv('L', 'T', 'N', NPIV, A(APOS), LIELL, + & W(PTWCB), 1) + ELSE + CALL dtrsm('L','L','T','N', NPIV, NRHS, ONE, A(APOS), + & LIELL, W(PTWCB), LIELL) + ENDIF + ELSE + IF ( KEEP(50) .EQ. 0 ) THEN + IF ( NRHS == 1 ) THEN + CALL dtrsv('U','N','U', NPIV, A(APOS), LIELL, + & W(PTWCB), 1) + ELSE + CALL dtrsm('L','U','N','U', NPIV, NRHS, ONE, A(APOS), + & LIELL,W(PTWCB),LIELL) + END IF + ELSE + IF ( NRHS == 1 ) THEN + CALL dtrsv('U','N','U', NPIV, A(APOS), NPIV, + & W(PTWCB), 1) + ELSE + CALL dtrsm('L','U','N','U',NPIV, NRHS, ONE, A(APOS), + & NPIV, W(PTWCB), LIELL) + END IF + END IF + END IF + ENDIF + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0) THEN + J1 = IPOS + LIELL + 1 + ELSE + J1 = IPOS + 1 + END IF + DO 150 I = 1, NPIV + JJ = IW(J1 + I - 1) + DO K=1, NRHS + RHS(JJ, K) = W(PTWCB+I-1+(K-1)*LIELL) + ENDDO + 150 CONTINUE + 160 CONTINUE + IF (KEEP(201).GT.0) THEN + CALL DMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 330 + ENDIF + ENDIF + IN = INODE + 170 IN = FILS(IN) + IF (IN .GT. 0) GOTO 170 + IF (IN .EQ. 0) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL DMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + ENDIF + GOTO 50 + ENDIF + IF = -IN + NBFILS = NE_STEPS(STEP(INODE)) + IF (AM1) THEN + I = NBFILS + NBFILS = 0 + DO WHILE (I.GT.0) + IF ( TO_PROCESS(STEP(IF)) ) NBFILS = NBFILS+1 + IF = FRERE(STEP(IF)) + I = I -1 + ENDDO + IF (NBFILS.EQ.0) THEN + NO_CHILDREN = .TRUE. + ELSE + NO_CHILDREN = .FALSE. + ENDIF + IF = -IN + ENDIF + IF (IN_SUBTREE) THEN + DO I = 1, NBFILS + IF ( AM1 ) THEN + 1010 IF ( .NOT.TO_PROCESS(STEP(IF)) ) THEN + IF = FRERE(STEP(IF)) + GOTO 1010 + ENDIF + NO_CHILDREN = .FALSE. + ENDIF + IPOOL((IIPOOL-I+1)+NBFILS-I) = IF + IIPOOL = IIPOOL + 1 + IF = FRERE(STEP(IF)) + ENDDO + IF (AM1 .AND. NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL DMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + GOTO 50 + ENDIF + ENDIF + ELSE + DEBUT = .TRUE. + DO I = 0, SLAVEF - 1 + DEJA_SEND( I ) = .FALSE. + END DO + POOL_FIRST_POS=IIPOOL + DO 190 I = 1, NBFILS + IF ( AM1 ) THEN +1020 IF ( .NOT.TO_PROCESS(STEP(IF)) ) THEN + IF = FRERE(STEP(IF)) + GOTO 1020 + ENDIF + NO_CHILDREN = .FALSE. + ENDIF + IF (MUMPS_275(PROCNODE_STEPS(STEP(IF)), + & SLAVEF) .EQ. MYID) THEN + IPOOL(IIPOOL) = IF + IIPOOL = IIPOOL + 1 + IF = FRERE(STEP(IF)) + ELSE + PROCDEST = MUMPS_275(PROCNODE_STEPS(STEP(IF)),SLAVEF) + IF (.not. DEJA_SEND( PROCDEST )) THEN + 400 CONTINUE + CALL DMUMPS_78( NRHS, IF, 0, 0, LIELL, + & LIELL - KEEP(253), + & IW( POSINDICES ), + & W ( PTRACB(STEP( INODE ))), PROCDEST, + & NOEUD, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL DMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 340 + GOTO 400 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 330 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 330 + END IF + DEJA_SEND( PROCDEST ) = .TRUE. + END IF + IF = FRERE(STEP(IF)) + ENDIF + 190 CONTINUE + IF (AM1 .AND. NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL DMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + GOTO 50 + ENDIF + ENDIF + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + IWCB(PTRICB(STEP(INODE))+1) = IWCB(PTRICB(STEP(INODE))+1)-1 + CALL DMUMPS_151(NRHS,N, KEEP(28), IWCB, LIWW, + & W, LWC, + & POSWCB,POSIWCB,PTRICB,PTRACB) + ENDIF + GOTO 50 + 330 CONTINUE + CALL DMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, TERREUR, + & SLAVEF) + 340 CONTINUE + CALL DMUMPS_150( MYID,COMM,BUFR, + & LBUFR,LBUFR_BYTES ) + RETURN + END SUBROUTINE DMUMPS_249 + RECURSIVE SUBROUTINE DMUMPS_41( + & BLOQ, FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, RHS, + & LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IMPLICIT NONE + LOGICAL BLOQ, FLAG + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER MYID, SLAVEF, COMM + INTEGER N, LIWW + INTEGER IWCB( LIWW ) + INTEGER LWC + DOUBLE PRECISION W( LWC ) + INTEGER POSIWCB, POSWCB + INTEGER IIPOOL, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER LPANEL_POS + INTEGER PANEL_POS( LPANEL_POS ) + INTEGER NBFINF, INFO(40) + INTEGER PLEFTW, KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER PTRICB(KEEP(28)), PTRACB(KEEP(28)), STEP( N ), FILS( N ) + INTEGER LIW + INTEGER(8) :: LA + INTEGER PTRIST(KEEP(28)), IW( LIW ) + INTEGER (8) :: PTRFAC(KEEP(28)) + DOUBLE PRECISION A( LA ), W2( KEEP(133) ) + INTEGER LRHS, NRHS + DOUBLE PRECISION RHS(LRHS, NRHS) + INTEGER MYLEAFE, MTYPE + INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28)) + DOUBLE PRECISION RHSCOMP(LRHSCOMP,NRHS) + INTEGER SIZE_TO_PROCESS + LOGICAL TO_PROCESS(SIZE_TO_PROCESS) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER MSGSOU, MSGTAG, MSGLEN + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + FLAG = .FALSE. + IF ( BLOQ ) THEN + CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, + & COMM, STATUS, IERR ) + FLAG = .TRUE. + ELSE + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + END IF + IF (FLAG) THEN + MSGSOU=STATUS(MPI_SOURCE) + MSGTAG=STATUS(MPI_TAG) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) + IF ( MSGLEN .GT. LBUFR_BYTES ) THEN + INFO(1) = -20 + INFO(2) = MSGLEN + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + ELSE + CALL MPI_RECV(BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU, + & MSGTAG, COMM, STATUS, IERR) + CALL DMUMPS_42( MSGTAG, MSGSOU, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, + & KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + END IF + END IF + RETURN + END SUBROUTINE DMUMPS_41 + RECURSIVE SUBROUTINE DMUMPS_42( + & MSGTAG, MSGSOU, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + USE DMUMPS_OOC + USE DMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER MSGTAG, MSGSOU + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER MYID, SLAVEF, COMM + INTEGER N, LIWW + INTEGER IWCB( LIWW ) + INTEGER LWC + DOUBLE PRECISION W( LWC ) + INTEGER POSIWCB, POSWCB + INTEGER IIPOOL, LPOOL, LPANEL_POS + INTEGER IPOOL( LPOOL ) + INTEGER PANEL_POS( LPANEL_POS ) + INTEGER NBFINF, INFO(40) + INTEGER PLEFTW, KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER PTRICB(KEEP(28)), PTRACB(KEEP(28)), STEP( N ), FILS( N ) + INTEGER FRERE(KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER LIW + INTEGER(8) :: LA + INTEGER IW( LIW ), PTRIST( KEEP(28) ) + INTEGER(8) :: PTRFAC(KEEP(28)) + DOUBLE PRECISION A( LA ), W2( KEEP(133) ) + INTEGER LRHS, NRHS + DOUBLE PRECISION RHS(LRHS, NRHS) + INTEGER MYLEAFE, MTYPE + INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28)) + DOUBLE PRECISION RHSCOMP(LRHSCOMP,NRHS) + INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR + LOGICAL MUST_BE_PERMUTED + INTEGER SIZE_TO_PROCESS + LOGICAL TO_PROCESS(SIZE_TO_PROCESS), NO_CHILDREN + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER POSITION, IF, INODE, IERR, LONG, DUMMY(1) + INTEGER P_UPDATE, P_SOL_MAS, LIELL, K + INTEGER(8) :: APOS, IST + INTEGER NPIV, NROW_L, IPOS, NROW_RECU + INTEGER I, JJ, IN, PROCDEST, J1, J2, IFR, LDA + INTEGER NSLAVES, NELIM, J, POSINDICES, INODEPOS, + & IPOSINRHSCOMP + LOGICAL FLAG + DOUBLE PRECISION ZERO, ALPHA, ONE + PARAMETER (ZERO=0.0D0, ONE = 1.0D0, ALPHA=-1.0D0) + INCLUDE 'mumps_headers.h' + INTEGER POOL_FIRST_POS, TMP + LOGICAL DEJA_SEND( 0:SLAVEF-1 ) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275, dtrsv, dtrsm, dgemv, dgemm + INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS + INTEGER LDAJ, NBJ, LIWFAC, + & NBJLAST, NPIV_LAST, PANEL_SIZE, + & PTWCB_PANEL, NCB_PANEL, TYPEF + LOGICAL TWOBYTWO + INTEGER BEG_PANEL + INTEGER IPANEL, NPANELS + IF (MSGTAG .EQ. FEUILLE) THEN + NBFINF = NBFINF - 1 + ELSE IF (MSGTAG .EQ. NOEUD) THEN + POSITION = 0 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & INODE, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & LONG, 1, MPI_INTEGER, + & COMM, IERR) + IF ( POSIWCB - LONG - 2 .LT. 0 + & .OR. POSWCB - PLEFTW + 1 .LT. LONG ) THEN + CALL DMUMPS_95(NRHS, N, KEEP(28), IWCB, + & LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ((POSIWCB - LONG - 2 ) .LT. 0) THEN + INFO(1)=-14 + INFO(2)=-POSIWCB + LONG + 2 + WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' + GOTO 260 + END IF + IF ( POSWCB - PLEFTW + 1 .LT. LONG ) THEN + INFO(1) = -11 + INFO(2) = LONG + PLEFTW - POSWCB - 1 + WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' + GOTO 260 + END IF + ENDIF + POSIWCB = POSIWCB - LONG + POSWCB = POSWCB - LONG + IF (LONG .GT. 0) THEN + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IWCB(POSIWCB + 1), + & LONG, MPI_INTEGER, COMM, IERR) + DO K=1,NRHS + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & W(POSWCB + 1), LONG, + & MPI_DOUBLE_PRECISION, COMM, IERR) + DO JJ=0, LONG-1 + RHS(IWCB(POSIWCB+1+JJ),K) = W(POSWCB+1+JJ) + ENDDO + ENDDO + POSIWCB = POSIWCB + LONG + POSWCB = POSWCB + LONG + ENDIF + POOL_FIRST_POS = IIPOOL + IF ( KEEP(237).GT. 0 ) THEN + IF (.NOT.TO_PROCESS(STEP(INODE))) + & GOTO 1010 + ENDIF + IPOOL( IIPOOL ) = INODE + IIPOOL = IIPOOL + 1 + 1010 CONTINUE + IF = FRERE( STEP(INODE) ) + DO WHILE ( IF .GT. 0 ) + IF ( MUMPS_275(PROCNODE_STEPS(STEP(IF)), + & SLAVEF) .eq. MYID ) THEN + IF ( KEEP(237).GT. 0 ) THEN + IF (.NOT.TO_PROCESS(STEP(IF))) THEN + IF = FRERE(STEP(IF)) + CYCLE + ENDIF + ENDIF + IPOOL( IIPOOL ) = IF + IIPOOL = IIPOOL + 1 + END IF + IF = FRERE( STEP( IF ) ) + END DO + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + ELSE IF ( MSGTAG .EQ. BACKSLV_MASTER2SLAVE ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NROW_RECU, 1, MPI_INTEGER, COMM, IERR ) + IPOS = PTRIST( STEP(INODE) ) + KEEP(IXSZ) + NPIV = - IW( IPOS ) + NROW_L = IW( IPOS + 1 ) + IF (KEEP(201).GT.0) THEN + CALL DMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + APOS = PTRFAC(IW( IPOS + 3 )) + IF ( NROW_L .NE. NROW_RECU ) THEN + WRITE(*,*) 'Error1 in 41S : NROW L/RECU=',NROW_L, NROW_RECU + CALL MUMPS_ABORT() + END IF + LONG = NROW_L + NPIV + IF ( POSWCB - LONG*NRHS .LT. PLEFTW - 1 ) THEN + CALL DMUMPS_95(NRHS, N, KEEP(28), IWCB, + & LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - LONG*NRHS .LT. PLEFTW - 1 ) THEN + INFO(1) = -11 + INFO(2) = LONG * NRHS- POSWCB + WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' + GOTO 260 + END IF + END IF + P_UPDATE = PLEFTW + P_SOL_MAS = PLEFTW + NPIV * NRHS + PLEFTW = P_SOL_MAS + NROW_L * NRHS + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & W( P_SOL_MAS+(K-1)*NROW_L),NROW_L, + & MPI_DOUBLE_PRECISION, + & COMM, IERR ) + ENDDO + IF (KEEP(201).EQ.1) THEN + IF ( NRHS == 1 ) THEN + CALL dgemv( 'T', NROW_L, NPIV, ALPHA, A( APOS ), NROW_L, + & W( P_SOL_MAS ), 1, ZERO, + & W( P_UPDATE ), 1 ) + ELSE + CALL dgemm( 'T', 'N', NPIV, NRHS, NROW_L, ALPHA, A(APOS), + & NROW_L, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ), + & NPIV ) + ENDIF + ELSE + IF ( NRHS == 1 ) THEN + CALL dgemv( 'N', NPIV, NROW_L, ALPHA, A( APOS ), NPIV, + & W( P_SOL_MAS ), 1, ZERO, + & W( P_UPDATE ), 1 ) + ELSE + CALL dgemm( 'N', 'N', NPIV, NRHS, NROW_L, ALPHA, A(APOS), + & NPIV, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ), + & NPIV ) + END IF + ENDIF + IF (KEEP(201).GT.0) THEN + CALL DMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + PLEFTW = PLEFTW - NROW_L * NRHS + 100 CONTINUE + CALL DMUMPS_63( NRHS, INODE, W(P_UPDATE), + & NPIV, NPIV, + & MSGSOU, + & BACKSLV_UPDATERHS, + & COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL DMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 100 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 260 + END IF + PLEFTW = PLEFTW - NPIV * NRHS + ELSE IF ( MSGTAG .EQ. BACKSLV_UPDATERHS ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE, 1, MPI_INTEGER, COMM, IERR ) + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NPIV, 1, MPI_INTEGER, COMM, IERR ) + NELIM = IW(IPOS-1) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + IPOS = IPOS + 1 + NSLAVES = IW( IPOS + 1 ) + IPOS = IPOS + 1 + NSLAVES + INODEPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 4 + IF ( KEEP(50) .eq. 0 ) THEN + LDA = LIELL + ELSE + LDA = NPIV + ENDIF + IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN + J1 = IPOS + 1 + J2 = IPOS + NPIV + ELSE + J1 = IPOS + LIELL + 1 + J2 = IPOS + NPIV + LIELL + END IF + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & W2, NPIV, MPI_DOUBLE_PRECISION, + & COMM, IERR ) + IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + I = 1 + IF ( (KEEP(253).NE.0) .AND. + & (IW(PTRIST(STEP(INODE))+XXS).EQ.C_FINI+NSLAVES) + & ) THEN + DO JJ = J1,J2 + RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = W2(I) + I = I+1 + ENDDO + ELSE + DO JJ = J1,J2 + RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = + & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + W2(I) + I = I+1 + ENDDO + ENDIF + ENDDO + IW(PTRIST(STEP(INODE))+XXS) = + & IW(PTRIST(STEP(INODE))+XXS) - 1 + IF ( IW(PTRIST(STEP(INODE))+XXS).EQ.C_FINI ) THEN + IF (KEEP(201).GT.0) THEN + CALL DMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL DMUMPS_755( + & IW(IPOS+1+2*LIELL), + & MUST_BE_PERMUTED ) + ENDIF + ENDIF + APOS = PTRFAC(IW(INODEPOS)) + IF (KEEP(201).EQ.1) THEN + LIWFAC = IW(PTRIST(STEP(INODE))+XXI) + TYPEF = TYPEF_L + NROW_L = NPIV+NELIM + PANEL_SIZE = DMUMPS_690(NROW_L) + IF (PANEL_SIZE.LT.0) THEN + WRITE(6,*) ' Internal error in bwd solve PANEL_SIZE=', + & PANEL_SIZE + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF ( POSIWCB - 2 .LT. 0 .or. + & POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + CALL DMUMPS_95( NRHS, N, KEEP(28), IWCB, + & LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + INFO( 1 ) = -11 + INFO( 2 ) = LIELL * NRHS - POSWCB - PLEFTW + 1 + GOTO 260 + END IF + IF ( POSIWCB - 2 .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = 2 - POSIWCB + GO TO 260 + END IF + END IF + POSIWCB = POSIWCB - 2 + POSWCB = POSWCB - LIELL*NRHS + PTRICB(STEP( INODE )) = POSIWCB + 1 + PTRACB(STEP( INODE )) = POSWCB + 1 + IWCB( PTRICB(STEP( INODE )) ) = LIELL + IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 + IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 5 + NSLAVES + IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN + POSINDICES = IPOS + LIELL + 1 + ELSE + POSINDICES = IPOS + 1 + END IF + IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + IFR = PTRACB(STEP( INODE )) + DO K=1, NRHS + DO JJ = J1, J2 + W(IFR+JJ-J1+(K-1)*LIELL) = + & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + ENDDO + END DO + IFR = PTRACB(STEP(INODE))-1+NPIV + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN + J1 = IPOS + LIELL + NPIV + 1 + J2 = IPOS + 2 * LIELL + ELSE + J1 = IPOS + NPIV + 1 + J2 = IPOS + LIELL + END IF + DO JJ = J1, J2-KEEP(253) + J = IW(JJ) + IFR = IFR + 1 + DO K=1, NRHS + W(IFR+(K-1)*LIELL) = RHS(J,K) + ENDDO + ENDDO + IF ( KEEP(201).EQ.1 .AND. + & (( NELIM .GT. 0 ).OR. (MTYPE.NE.1 ))) THEN + J = NPIV / PANEL_SIZE + TWOBYTWO = KEEP(50).EQ.2 .AND. KEEP(105).GT.0 + IF (TWOBYTWO) THEN + CALL DMUMPS_641(PANEL_SIZE, PANEL_POS, + & LPANEL_POS, IW(IPOS+1+LIELL), NPIV, NPANELS, + & NROW_L, NBENTRIES_ALLPANELS) + ELSE + IF (NPIV.EQ.J*PANEL_SIZE) THEN + NPIV_LAST = NPIV + NBJLAST = PANEL_SIZE + NPANELS = J + ELSE + NPIV_LAST = (J+1)* PANEL_SIZE + NBJLAST = NPIV-J*PANEL_SIZE + NPANELS = J+1 + ENDIF + NBENTRIES_ALLPANELS = + & int(NROW_L,8) * int(NPIV,8) + & - int( ( J * ( J - 1 ) ) / 2,8 ) + & * int(PANEL_SIZE,8) * int(PANEL_SIZE,8) + & - int(J,8) + & * int(mod(NPIV, PANEL_SIZE),8) + & * int(PANEL_SIZE,8) + JJ=NPIV_LAST + ENDIF + APOSDEB = APOS + NBENTRIES_ALLPANELS + DO IPANEL=NPANELS,1,-1 + IF (TWOBYTWO) THEN + NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL) + BEG_PANEL = PANEL_POS(IPANEL) + ELSE + IF (JJ.EQ.NPIV_LAST) THEN + NBJ = NBJLAST + ELSE + NBJ = PANEL_SIZE + ENDIF + BEG_PANEL = JJ- PANEL_SIZE+1 + ENDIF + LDAJ = NROW_L-BEG_PANEL+1 + APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8) + PTWCB_PANEL = PTRACB(STEP(INODE)) + BEG_PANEL - 1 + NCB_PANEL = LDAJ - NBJ + IF (KEEP(50).NE.1 .AND.MUST_BE_PERMUTED) THEN + CALL DMUMPS_667(TYPEF, TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW) + CALL DMUMPS_698( + & IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)), + & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, + & IW(I_PIVRPTR+IPANEL-1)-1, + & A(APOSDEB), + & LDAJ, NBJ, BEG_PANEL-1) + ENDIF + IF ( NRHS == 1 ) THEN + IF (NCB_PANEL.NE.0) THEN + CALL dgemv( 'T', NCB_PANEL, NBJ, ALPHA, + & A( APOSDEB + int(NBJ,8) ), LDAJ, + & W( NBJ + PTWCB_PANEL ), + & 1, ONE, + & W(PTWCB_PANEL), 1 ) + ENDIF + CALL dtrsv('L','T','U', NBJ, A(APOSDEB), LDAJ, + & W(PTWCB_PANEL), 1) + ELSE + IF (NCB_PANEL.NE.0) THEN + CALL dgemm( 'T', 'N', NBJ, NRHS, NCB_PANEL, ALPHA, + & A(APOSDEB + int(NBJ,8)), LDAJ, + & W(NBJ+PTWCB_PANEL),LIELL, + & ONE, W(PTWCB_PANEL),LIELL) + ENDIF + CALL dtrsm('L','L','T','U',NBJ, NRHS, ONE, + & A(APOSDEB), + & LDAJ, W(PTWCB_PANEL), LIELL) + ENDIF + IF (.NOT. TWOBYTWO) JJ=BEG_PANEL-1 + ENDDO + GOTO 1234 + ENDIF + IF (NELIM .GT.0) THEN + IF ( KEEP(50) .eq. 0 ) THEN + IST = APOS + int(NPIV,8) * int(LIELL,8) + ELSE + IST = APOS + int(NPIV,8) * int(NPIV,8) + END IF + IF ( NRHS == 1 ) THEN + CALL dgemv( 'N', NPIV, NELIM, ALPHA, + & A( IST ), NPIV, + & W( NPIV + PTRACB(STEP(INODE)) ), + & 1, ONE, + & W(PTRACB(STEP(INODE))), 1 ) + ELSE + CALL dgemm( 'N', 'N', NPIV, NRHS, NELIM, ALPHA, + & A(IST), NPIV, W(NPIV+PTRACB(STEP(INODE))),LIELL, + & ONE, W(PTRACB(STEP(INODE))),LIELL) + END IF + ENDIF + IF ( NRHS == 1 ) THEN + CALL dtrsv( 'U', 'N', 'U', NPIV, A(APOS), LDA, + & W(PTRACB(STEP(INODE))),1) + ELSE + CALL dtrsm( 'L','U', 'N', 'U', NPIV, NRHS, ONE, + & A(APOS), LDA, + & W(PTRACB(STEP(INODE))),LIELL) + END IF + 1234 CONTINUE + IF (KEEP(201).GT.0) THEN + CALL DMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 6 + NSLAVES + DO I = 1, NPIV + JJ = IW( IPOS + I - 1 ) + DO K=1,NRHS + RHS( JJ, K ) = W( PTRACB(STEP(INODE))+I-1 + & + (K-1)*LIELL ) + ENDDO + END DO + IN = INODE + 200 IN = FILS(IN) + IF (IN .GT. 0) GOTO 200 + IF (IN .EQ. 0) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL DMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + ENDIF + IWCB( PTRICB(STEP(INODE)) + 1 ) = 0 + CALL DMUMPS_151(NRHS, N, KEEP(28), + & IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + GOTO 270 + ENDIF + DO I = 0, SLAVEF - 1 + DEJA_SEND( I ) = .FALSE. + END DO + IN = -IN + IF ( KEEP(237).GT.0 ) THEN + NO_CHILDREN = .TRUE. + ELSE + NO_CHILDREN = .FALSE. + ENDIF + DO WHILE (IN.GT.0) + IF ( KEEP(237).GT.0 ) THEN + IF (.NOT.TO_PROCESS(STEP(IN))) THEN + IN = FRERE(STEP(IN)) + CYCLE + ELSE + NO_CHILDREN = .FALSE. + ENDIF + ENDIF + POOL_FIRST_POS = IIPOOL + IF (MUMPS_275(PROCNODE_STEPS(STEP(IN)), + & SLAVEF) .EQ. MYID) THEN + IPOOL(IIPOOL ) = IN + IIPOOL = IIPOOL + 1 + ELSE + PROCDEST = MUMPS_275( PROCNODE_STEPS(STEP(IN)), + & SLAVEF ) + IF ( .NOT. DEJA_SEND( PROCDEST ) ) THEN + 110 CALL DMUMPS_78( NRHS, IN, 0, 0, + & LIELL, LIELL-KEEP(253), + & IW( POSINDICES ) , + & W( PTRACB(STEP(INODE))), + & PROCDEST, NOEUD, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL DMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 110 + ELSE IF ( IERR .eq. -2 ) THEN + INFO(1) = -17 + INFO(2) = LIELL * NRHS * KEEP(35) + + & ( LIELL + 2 ) * KEEP(34) + GOTO 260 + ELSE IF ( IERR .eq. -3 ) THEN + INFO(1) = -20 + INFO(2) = LIELL * NRHS * KEEP(35) + + & ( LIELL + 2 ) * KEEP(34) + GOTO 260 + END IF + DEJA_SEND( PROCDEST ) = .TRUE. + END IF + END IF + IN = FRERE( STEP( IN ) ) + END DO + IF (NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL DMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, + & COMM, FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + ENDIF + IWCB( PTRICB(STEP(INODE)) + 1 ) = 0 + CALL DMUMPS_151(NRHS, N, KEEP(28), + & IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + GOTO 270 + ENDIF + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + IWCB( PTRICB(STEP( INODE )) + 1 ) = 0 + CALL DMUMPS_151(NRHS, N, KEEP(28), + & IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + END IF + ELSE IF (MSGTAG.EQ.TERREUR) THEN + INFO(1) = -001 + INFO(2) = MSGSOU + GO TO 270 + ELSE IF ( (MSGTAG.EQ.UPDATE_LOAD).OR. + & (MSGTAG.EQ.TAG_DUMMY) ) THEN + GO TO 270 + ELSE + INFO(1) = -100 + INFO(2) = MSGTAG + GOTO 260 + ENDIF + GO TO 270 + 260 CONTINUE + CALL DMUMPS_44( MYID, SLAVEF, COMM ) + 270 CONTINUE + RETURN + END SUBROUTINE DMUMPS_42 + SUBROUTINE DMUMPS_641(PANEL_SIZE, PANEL_POS, + & LEN_PANEL_POS, INDICES, NPIV, + & NPANELS, NFRONT_OR_NASS, + & NBENTRIES_ALLPANELS) + IMPLICIT NONE + INTEGER, intent (in) :: PANEL_SIZE, NPIV + INTEGER, intent (in) :: INDICES(NPIV) + INTEGER, intent (in) :: LEN_PANEL_POS + INTEGER, intent (out) :: NPANELS + INTEGER, intent (out) :: PANEL_POS(LEN_PANEL_POS) + INTEGER, intent (in) :: NFRONT_OR_NASS + INTEGER(8), intent(out):: NBENTRIES_ALLPANELS + INTEGER NPANELS_MAX, I, NBeff + INTEGER(8) :: NBENTRIES_THISPANEL + NBENTRIES_ALLPANELS = 0_8 + NPANELS_MAX = (NPIV+PANEL_SIZE-1)/PANEL_SIZE + IF (LEN_PANEL_POS .LT. NPANELS_MAX + 1) THEN + WRITE(*,*) "Error 1 in DMUMPS_641", + & LEN_PANEL_POS,NPANELS_MAX + CALL MUMPS_ABORT() + ENDIF + I = 1 + NPANELS = 0 + IF (I .GT. NPIV) RETURN + 10 CONTINUE + NPANELS = NPANELS + 1 + PANEL_POS(NPANELS) = I + NBeff = min(PANEL_SIZE, NPIV-I+1) + IF ( INDICES(I+NBeff-1) < 0) THEN + NBeff=NBeff+1 + ENDIF + NBENTRIES_THISPANEL = int(NFRONT_OR_NASS-I+1,8) * int(NBeff,8) + NBENTRIES_ALLPANELS = NBENTRIES_ALLPANELS + NBENTRIES_THISPANEL + I=I+NBeff + IF ( I .LE. NPIV ) GOTO 10 + PANEL_POS(NPANELS+1)=NPIV+1 + RETURN + END SUBROUTINE DMUMPS_641 + SUBROUTINE DMUMPS_286( NRHS, DESCA_PAR, + & CNTXT_PAR,LOCAL_M,LOCAL_N,MBLOCK,NBLOCK, + & IPIV,LPIV,MASTER_ROOT,MYID,COMM, + & RHS_SEQ,SIZE_ROOT,A,INFO,MTYPE,LDLT ) + IMPLICIT NONE + INTEGER NRHS, MTYPE + INTEGER DESCA_PAR( 9 ) + INTEGER LOCAL_M, LOCAL_N, MBLOCK, NBLOCK + INTEGER CNTXT_PAR, MASTER_ROOT, SIZE_ROOT + INTEGER MYID, COMM + INTEGER LPIV, IPIV( LPIV ) + INTEGER INFO(40), LDLT + DOUBLE PRECISION RHS_SEQ( SIZE_ROOT *NRHS) + DOUBLE PRECISION A( LOCAL_M, LOCAL_N ) + INTEGER IERR, NPROW, NPCOL, MYROW, MYCOL + INTEGER LOCAL_N_RHS + DOUBLE PRECISION, ALLOCATABLE, DIMENSION( :,: ) ::RHS_PAR + EXTERNAL numroc + INTEGER numroc + INTEGER allocok + CALL blacs_gridinfo( CNTXT_PAR, NPROW, NPCOL, MYROW, MYCOL ) + LOCAL_N_RHS = numroc(NRHS, NBLOCK, MYCOL, 0, NPCOL) + LOCAL_N_RHS = max(1,LOCAL_N_RHS) + ALLOCATE(RHS_PAR(LOCAL_M, LOCAL_N_RHS),stat=allocok) + IF (allocok > 0 ) THEN + WRITE(*,*) ' Problem during solve of the root.' + WRITE(*,*) ' Reduce number of right hand sides.' + CALL MUMPS_ABORT() + ENDIF + CALL DMUMPS_290( MYID, SIZE_ROOT, NRHS, RHS_SEQ, + & LOCAL_M, LOCAL_N_RHS, + & MBLOCK, NBLOCK, RHS_PAR, MASTER_ROOT, + & NPROW, NPCOL, COMM ) + CALL DMUMPS_768 (SIZE_ROOT, NRHS, MTYPE, + & A, DESCA_PAR, LOCAL_M, LOCAL_N, LOCAL_N_RHS, + & IPIV, LPIV, RHS_PAR, LDLT, + & MBLOCK, NBLOCK, CNTXT_PAR, + & IERR) + CALL DMUMPS_156( MYID, SIZE_ROOT, NRHS, + & RHS_SEQ, LOCAL_M, LOCAL_N_RHS, + & MBLOCK, NBLOCK, RHS_PAR, MASTER_ROOT, + & NPROW, NPCOL, COMM ) + DEALLOCATE(RHS_PAR) + RETURN + END SUBROUTINE DMUMPS_286 + SUBROUTINE DMUMPS_768 (SIZE_ROOT, NRHS, MTYPE, + & A, DESCA_PAR, LOCAL_M, LOCAL_N, LOCAL_N_RHS, + & IPIV, LPIV, RHS_PAR, LDLT, + & MBLOCK, NBLOCK, CNTXT_PAR, + & IERR) + IMPLICIT NONE + INTEGER, intent (in) :: SIZE_ROOT, NRHS, LDLT, LOCAL_M, + & LOCAL_N, LOCAL_N_RHS, + & MBLOCK, NBLOCK, CNTXT_PAR, MTYPE + INTEGER, intent (in) :: DESCA_PAR( 9 ) + INTEGER, intent (in) :: LPIV, IPIV( LPIV ) + DOUBLE PRECISION, intent (in) :: A( LOCAL_M, LOCAL_N ) + DOUBLE PRECISION, intent (inout) :: RHS_PAR(LOCAL_M, LOCAL_N_RHS) + INTEGER, intent (out) :: IERR + INTEGER :: DESCB_PAR( 9 ) + IERR = 0 + CALL DESCINIT( DESCB_PAR, SIZE_ROOT, + & NRHS, MBLOCK, NBLOCK, 0, 0, + & CNTXT_PAR, LOCAL_M, IERR ) + IF (IERR.NE.0) THEN + WRITE(*,*) 'After DESCINIT, IERR = ', IERR + CALL MUMPS_ABORT() + END IF + IF ( LDLT .eq. 0 .OR. LDLT .eq. 2 ) THEN + IF ( MTYPE .eq. 1 ) THEN + CALL pdgetrs('N',SIZE_ROOT,NRHS,A,1,1,DESCA_PAR,IPIV, + & RHS_PAR,1,1,DESCB_PAR,IERR) + ELSE + CALL pdgetrs('T',SIZE_ROOT,NRHS,A,1,1,DESCA_PAR,IPIV, + & RHS_PAR, 1, 1, DESCB_PAR,IERR) + END IF + ELSE + CALL pdpotrs( 'L', SIZE_ROOT, NRHS, A, 1, 1, DESCA_PAR, + & RHS_PAR, 1, 1, DESCB_PAR, IERR ) + END IF + IF ( IERR .LT. 0 ) THEN + WRITE(*,*) ' Problem during solve of the root' + CALL MUMPS_ABORT() + END IF + RETURN + END SUBROUTINE DMUMPS_768 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_struc_def.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_struc_def.F new file mode 100644 index 000000000..6fc437ed6 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/dmumps_struc_def.F @@ -0,0 +1,50 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE DMUMPS_STRUC_DEF + INCLUDE 'dmumps_struc.h' + END MODULE DMUMPS_STRUC_DEF diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_c.c b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_c.c new file mode 100644 index 000000000..30a594b0a --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_c.c @@ -0,0 +1,468 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +/* Written by JYL, march 2002 */ +/* This file groups so far all C functions and symbols that vary with the + arithmetic */ +/* Header used for debug purpose only +#include +*/ +#include +#include "mumps_common.h" +#if MUMPS_ARITH == MUMPS_ARITH_s +# include "smumps_c.h" +# define MUMPS_REAL SMUMPS_REAL +# define MUMPS_COMPLEX SMUMPS_COMPLEX +#elif MUMPS_ARITH == MUMPS_ARITH_d +# include "dmumps_c.h" +# define MUMPS_REAL DMUMPS_REAL +# define MUMPS_COMPLEX DMUMPS_COMPLEX +#elif MUMPS_ARITH == MUMPS_ARITH_c +# include "cmumps_c.h" +# define MUMPS_REAL CMUMPS_REAL +# define MUMPS_COMPLEX CMUMPS_COMPLEX +#elif MUMPS_ARITH == MUMPS_ARITH_z +# include "zmumps_c.h" +# define MUMPS_REAL ZMUMPS_REAL +# define MUMPS_COMPLEX ZMUMPS_COMPLEX +#endif +/** + * F_SYM_ARITH is the same as F_SYMBOL (see mumps_commn.h) for the symbols + * that depend on the arithmetic. + * Example: For CMUMPS_XXX, first define + * #define CMUMPS_XXX F_SYM_ARITH(xxx,XXX) and then use + * CMUMPS_XXX in the code to get rid of any symbol convention annoyance. + */ +#if MUMPS_ARITH == MUMPS_ARITH_s +# if defined(UPPER) || defined(MUMPS_WIN32) +# define F_SYM_ARITH(lower_case,upper_case) SMUMPS_##upper_case +# elif defined(Add_) +# define F_SYM_ARITH(lower_case,upper_case) smumps_##lower_case##_ +# elif defined(Add__) +# define F_SYM_ARITH(lower_case,upper_case) smumps_##lower_case##__ +# else +# define F_SYM_ARITH(lower_case,upper_case) smumps_##lower_case +# endif +#elif MUMPS_ARITH == MUMPS_ARITH_d +# if defined(UPPER) || defined(MUMPS_WIN32) +# define F_SYM_ARITH(lower_case,upper_case) DMUMPS_##upper_case +# elif defined(Add_) +# define F_SYM_ARITH(lower_case,upper_case) dmumps_##lower_case##_ +# elif defined(Add__) +# define F_SYM_ARITH(lower_case,upper_case) dmumps_##lower_case##__ +# else +# define F_SYM_ARITH(lower_case,upper_case) dmumps_##lower_case +# endif +#elif MUMPS_ARITH == MUMPS_ARITH_c +# if defined(UPPER) || defined(MUMPS_WIN32) +# define F_SYM_ARITH(lower_case,upper_case) CMUMPS_##upper_case +# elif defined(Add_) +# define F_SYM_ARITH(lower_case,upper_case) cmumps_##lower_case##_ +# elif defined(Add__) +# define F_SYM_ARITH(lower_case,upper_case) cmumps_##lower_case##__ +# else +# define F_SYM_ARITH(lower_case,upper_case) cmumps_##lower_case +# endif +#elif MUMPS_ARITH == MUMPS_ARITH_z +# if defined(UPPER) || defined(MUMPS_WIN32) +# define F_SYM_ARITH(lower_case,upper_case) ZMUMPS_##upper_case +# elif defined(Add_) +# define F_SYM_ARITH(lower_case,upper_case) zmumps_##lower_case##_ +# elif defined(Add__) +# define F_SYM_ARITH(lower_case,upper_case) zmumps_##lower_case##__ +# else +# define F_SYM_ARITH(lower_case,upper_case) zmumps_##lower_case +# endif +#endif +#define MUMPS_F77 \ + F_SYM_ARITH(f77,F77) +void MUMPS_CALL +MUMPS_F77( MUMPS_INT *job, + MUMPS_INT *sym, + MUMPS_INT *par, + MUMPS_INT *comm_fortran, + MUMPS_INT *n, + MUMPS_INT *icntl, + MUMPS_REAL *cntl, + MUMPS_INT *nz, + MUMPS_INT *irn, + MUMPS_INT *irn_avail, + MUMPS_INT *jcn, + MUMPS_INT *jcn_avail, + MUMPS_COMPLEX *a, + MUMPS_INT *a_avail, + MUMPS_INT *nz_loc, + MUMPS_INT *irn_loc, + MUMPS_INT *irn_loc_avail, + MUMPS_INT *jcn_loc, + MUMPS_INT *jcn_loc_avail, + MUMPS_COMPLEX *a_loc, + MUMPS_INT *a_loc_avail, + MUMPS_INT *nelt, + MUMPS_INT *eltptr, + MUMPS_INT *eltptr_avail, + MUMPS_INT *eltvar, + MUMPS_INT *eltvar_avail, + MUMPS_COMPLEX *a_elt, + MUMPS_INT *a_elt_avail, + MUMPS_INT *perm_in, + MUMPS_INT *perm_in_avail, + MUMPS_COMPLEX *rhs, + MUMPS_INT *rhs_avail, + MUMPS_COMPLEX *redrhs, + MUMPS_INT *redrhs_avail, + MUMPS_INT *info, + MUMPS_REAL *rinfo, + MUMPS_INT *infog, + MUMPS_REAL *rinfog, + MUMPS_INT *deficiency, + MUMPS_INT *lwk_user, + MUMPS_INT *size_schur, + MUMPS_INT *listvar_schur, + MUMPS_INT *listvar_schur_avail, + MUMPS_COMPLEX *schur, + MUMPS_INT *schur_avail, + MUMPS_COMPLEX *wk_user, + MUMPS_INT *wk_user_avail, + MUMPS_REAL *colsca, + MUMPS_INT *colsca_avail, + MUMPS_REAL *rowsca, + MUMPS_INT *rowsca_avail, + MUMPS_INT *instance_number, + MUMPS_INT *nrhs, + MUMPS_INT *lrhs, + MUMPS_INT *lredrhs, + MUMPS_COMPLEX *rhs_sparse, + MUMPS_INT *rhs_sparse_avail, + MUMPS_COMPLEX *sol_loc, + MUMPS_INT *sol_loc_avail, + MUMPS_INT *irhs_sparse, + MUMPS_INT *irhs_sparse_avail, + MUMPS_INT *irhs_ptr, + MUMPS_INT *irhs_ptr_avail, + MUMPS_INT *isol_loc, + MUMPS_INT *isol_loc_avail, + MUMPS_INT *nz_rhs, + MUMPS_INT *lsol_loc, + MUMPS_INT *schur_mloc, + MUMPS_INT *schur_nloc, + MUMPS_INT *schur_lld, + MUMPS_INT *schur_mblock, + MUMPS_INT *schur_nblock, + MUMPS_INT *schur_nprow, + MUMPS_INT *schur_npcol, + MUMPS_INT *ooc_tmpdir, + MUMPS_INT *ooc_prefix, + MUMPS_INT *write_problem, + MUMPS_INT *ooc_tmpdirlen, + MUMPS_INT *ooc_prefixlen, + MUMPS_INT *write_problemlen + ); +#ifdef return_scaling +/* + * Those two are static. They are passed inside cmumps_f77 but + * might also be changed on return by MUMPS_AFFECT_COLSCA/ROWSCA + * NB: They are put here because they use MUMPS_REAL and need thus + * one symbol per arithmetic. + */ +#if MUMPS_ARITH == MUMPS_ARITH_s +# define MUMPS_COLSCA_STATIC SMUMPS_COLSCA_STATIC +# define MUMPS_ROWSCA_STATIC SMUMPS_ROWSCA_STATIC +#elif MUMPS_ARITH == MUMPS_ARITH_d +# define MUMPS_COLSCA_STATIC SMUMPS_COLSCA_STATIC +# define MUMPS_ROWSCA_STATIC SMUMPS_ROWSCA_STATIC +#elif MUMPS_ARITH == MUMPS_ARITH_c +# define MUMPS_COLSCA_STATIC CMUMPS_COLSCA_STATIC +# define MUMPS_ROWSCA_STATIC CMUMPS_ROWSCA_STATIC +#elif MUMPS_ARITH == MUMPS_ARITH_z +# define MUMPS_COLSCA_STATIC ZMUMPS_COLSCA_STATIC +# define MUMPS_ROWSCA_STATIC ZMUMPS_ROWSCA_STATIC +#endif +static MUMPS_REAL * MUMPS_COLSCA_STATIC; +static MUMPS_REAL * MUMPS_ROWSCA_STATIC; +#define MUMPS_AFFECT_COLSCA \ + F_SYM_ARITH(affect_colsca,AFFECT_COLSCA) +void MUMPS_CALL +MUMPS_AFFECT_COLSCA(MUMPS_REAL * f77colsca) +{ + MUMPS_COLSCA_STATIC = f77colsca; +} +#define MUMPS_NULLIFY_C_COLSCA \ + F_SYM_ARITH(nullify_c_colsca,NULLIFY_C_COLSCA) +void MUMPS_CALL +MUMPS_NULLIFY_C_COLSCA() +{ + MUMPS_COLSCA_STATIC = 0; +} +#define MUMPS_AFFECT_ROWSCA \ + F_SYM_ARITH(affect_rowsca,AFFECT_ROWSCA) +void MUMPS_CALL +MUMPS_AFFECT_ROWSCA(MUMPS_REAL * f77rowsca) +{ + MUMPS_ROWSCA_STATIC = f77rowsca; +} +#define MUMPS_NULLIFY_C_ROWSCA \ + F_SYM_ARITH(nullify_c_rowsca,NULLIFY_C_ROWSCA) +void MUMPS_CALL +MUMPS_NULLIFY_C_ROWSCA() +{ + MUMPS_ROWSCA_STATIC = 0; +} +#endif /* return_scaling */ +#if MUMPS_ARITH == MUMPS_ARITH_s +# define mumps_c smumps_c +# define MUMPS_STRUC_C SMUMPS_STRUC_C +#elif MUMPS_ARITH == MUMPS_ARITH_d +# define mumps_c dmumps_c +# define MUMPS_STRUC_C DMUMPS_STRUC_C +#elif MUMPS_ARITH == MUMPS_ARITH_c +# define mumps_c cmumps_c +# define MUMPS_STRUC_C CMUMPS_STRUC_C +#elif MUMPS_ARITH == MUMPS_ARITH_z +# define mumps_c zmumps_c +# define MUMPS_STRUC_C ZMUMPS_STRUC_C +#endif +void MUMPS_CALL +mumps_c(MUMPS_STRUC_C * mumps_par) +{ + /* + * The following local variables will + * be passed to the F77 interface. + */ + MUMPS_INT *icntl; + MUMPS_REAL *cntl; + MUMPS_INT *irn; MUMPS_INT *jcn; MUMPS_COMPLEX *a; + MUMPS_INT *irn_loc; MUMPS_INT *jcn_loc; MUMPS_COMPLEX *a_loc; + MUMPS_INT *eltptr, *eltvar; MUMPS_COMPLEX *a_elt; + MUMPS_INT *perm_in; MUMPS_INT perm_in_avail; + MUMPS_INT *listvar_schur; MUMPS_INT listvar_schur_avail; + MUMPS_COMPLEX *schur; MUMPS_INT schur_avail; + MUMPS_COMPLEX *rhs; MUMPS_COMPLEX *redrhs; + MUMPS_COMPLEX *wk_user; MUMPS_INT wk_user_avail; + MUMPS_REAL *colsca; MUMPS_REAL *rowsca; + MUMPS_COMPLEX *rhs_sparse, *sol_loc; + MUMPS_INT *irhs_sparse, *irhs_ptr, *isol_loc; + MUMPS_INT irn_avail, jcn_avail, a_avail, rhs_avail, redrhs_avail; + /* These are actually used + * as booleans, but we stick + * to simple types for the + * C-F77 interface */ + MUMPS_INT irn_loc_avail, jcn_loc_avail, a_loc_avail; + MUMPS_INT eltptr_avail, eltvar_avail, a_elt_avail; + MUMPS_INT colsca_avail, rowsca_avail; + MUMPS_INT irhs_ptr_avail, rhs_sparse_avail, sol_loc_avail; + MUMPS_INT irhs_sparse_avail, isol_loc_avail; + MUMPS_INT *info; MUMPS_INT *infog; + MUMPS_REAL *rinfo; MUMPS_REAL *rinfog; + MUMPS_INT ooc_tmpdir[255]; MUMPS_INT ooc_prefix[63]; + MUMPS_INT write_problem[255]; + /* Other local variables */ + MUMPS_INT idummy; MUMPS_INT *idummyp; + MUMPS_REAL rdummy; MUMPS_REAL *rdummyp; + MUMPS_COMPLEX cdummy; MUMPS_COMPLEX *cdummyp; + /* String lengths to be passed to Fortran by address */ + int ooc_tmpdirlen; + int ooc_prefixlen; + int write_problemlen; + int i; + static const MUMPS_INT no = 0; + static const MUMPS_INT yes = 1; + idummyp = &idummy; + cdummyp = &cdummy; + rdummyp = &rdummy; +#ifdef return_scaling + /* Don't forget to initialize those two before + * each call to mumps as we may copy values from + * old instances otherwise ! */ + MUMPS_COLSCA_STATIC=0; + MUMPS_ROWSCA_STATIC=0; +#endif + /* Initialize pointers to zero for job == -1 */ + if ( mumps_par->job == -1 ) + { /* job = -1: we just reset all pointers to 0 */ + mumps_par->irn=0; mumps_par->jcn=0; mumps_par->a=0; mumps_par->rhs=0; mumps_par->wk_user=0; + mumps_par->redrhs=0; + mumps_par->eltptr=0; mumps_par->eltvar=0; mumps_par->a_elt=0; mumps_par->perm_in=0; mumps_par->sym_perm=0; mumps_par->uns_perm=0; mumps_par->irn_loc=0;mumps_par->jcn_loc=0;mumps_par->a_loc=0; mumps_par->listvar_schur=0;mumps_par->schur=0;mumps_par->mapping=0;mumps_par->pivnul_list=0;mumps_par->colsca=0;mumps_par->rowsca=0; mumps_par->rhs_sparse=0; mumps_par->irhs_sparse=0; mumps_par->sol_loc=0; mumps_par->irhs_ptr=0; mumps_par->isol_loc=0; + strcpy(mumps_par->ooc_tmpdir,"NAME_NOT_INITIALIZED"); + strcpy(mumps_par->ooc_prefix,"NAME_NOT_INITIALIZED"); + strcpy(mumps_par->write_problem,"NAME_NOT_INITIALIZED"); + strncpy(mumps_par->version_number,MUMPS_VERSION,MUMPS_VERSION_MAX_LEN); + mumps_par->version_number[MUMPS_VERSION_MAX_LEN+1] = '\0'; + /* Next line initializes scalars to arbitrary values. + * Some of those will anyway be overwritten during the + * call to Fortran routine [SDCZ]MUMPS_INIT_PHASE */ + mumps_par->n=0; mumps_par->nz=0; mumps_par->nz_loc=0; mumps_par->nelt=0;mumps_par->instance_number=0;mumps_par->deficiency=0;mumps_par->lwk_user=0;mumps_par->size_schur=0;mumps_par->lrhs=0; mumps_par->lredrhs=0; mumps_par->nrhs=0; mumps_par->nz_rhs=0; mumps_par->lsol_loc=0; + mumps_par->schur_mloc=0; mumps_par->schur_nloc=0; mumps_par->schur_lld=0; mumps_par->mblock=0; mumps_par->nblock=0; mumps_par->nprow=0; mumps_par->npcol=0; + } + ooc_tmpdirlen=(int)strlen(mumps_par->ooc_tmpdir); + ooc_prefixlen=(int)strlen(mumps_par->ooc_prefix); + write_problemlen=(int)strlen(mumps_par->write_problem); + /* Avoid the use of strnlen which may not be + * available on all systems. Allow strings without + * \0 at the end, if the file is not found, the + * Fortran layer is responsible for raising an + * error. */ + if(ooc_tmpdirlen > 255){ + ooc_tmpdirlen=255; + } + if(ooc_prefixlen > 63){ + ooc_prefixlen=63; + } + if(write_problemlen > 255){ + write_problemlen=255; + } + /* + * Extract info from the C structure to call the F77 interface. The + * following macro avoids repeating the same code with risks of errors. + */ +#define EXTRACT_POINTERS(component,dummypointer) \ + if ( mumps_par-> component == 0) \ + { component = dummypointer; \ + component ## _avail = no; } \ + else \ + { component = mumps_par-> component; \ + component ## _avail = yes; } + /* + * For example, EXTRACT_POINTERS(irn,idummyp) produces the following line of code: + if (mumps_par->irn== 0) {irn= idummyp;irn_avail = no; } else { irn = mumps_par->irn;irn_avail = yes; } ; + * which says that irn is set to mumps_par->irn except if + * mumps_par->irn is 0, which means that it is not available. + */ + EXTRACT_POINTERS(irn,idummyp); + EXTRACT_POINTERS(jcn,idummyp); + EXTRACT_POINTERS(rhs,cdummyp); + EXTRACT_POINTERS(wk_user,cdummyp); + EXTRACT_POINTERS(redrhs,cdummyp); + EXTRACT_POINTERS(irn_loc,idummyp); + EXTRACT_POINTERS(jcn_loc,idummyp); + EXTRACT_POINTERS(a_loc,cdummyp); + EXTRACT_POINTERS(a,cdummyp); + EXTRACT_POINTERS(eltptr,idummyp); + EXTRACT_POINTERS(eltvar,idummyp); + EXTRACT_POINTERS(a_elt,cdummyp); + EXTRACT_POINTERS(perm_in,idummyp); + EXTRACT_POINTERS(listvar_schur,idummyp); + EXTRACT_POINTERS(schur,cdummyp); + EXTRACT_POINTERS(colsca,rdummyp); + EXTRACT_POINTERS(rowsca,rdummyp); + EXTRACT_POINTERS(rhs_sparse,cdummyp); + EXTRACT_POINTERS(sol_loc,cdummyp); + EXTRACT_POINTERS(irhs_sparse,idummyp); + EXTRACT_POINTERS(isol_loc,idummyp); + EXTRACT_POINTERS(irhs_ptr,idummyp); + /* printf("irn_avail,jcn_avail, rhs_avail, a_avail, eltptr_avail, eltvar_avail,a_elt_avail,perm_in_avail= %d %d %d %d %d %d %d \n", irn_avail,jcn_avail, rhs_avail, a_avail, eltptr_avail, eltvar_avail, a_elt_avail, perm_in_avail);*/ + /* + * Extract integers (input) or pointers that are + * always allocated (such as ICNTL, INFO, ...) + */ + /* size_schur = mumps_par->size_schur; */ + /* instance_number = mumps_par->instance_number; */ + icntl = mumps_par->icntl; + cntl = mumps_par->cntl; + info = mumps_par->info; + infog = mumps_par->infog; + rinfo = mumps_par->rinfo; + rinfog = mumps_par->rinfog; + for(i=0;iooc_tmpdir[i]; + } + for(i=0;iooc_prefix[i]; + } + for(i=0;iwrite_problem[i]; + } + /* Call F77 interface */ + MUMPS_F77(&(mumps_par->job), &(mumps_par->sym), &(mumps_par->par), &(mumps_par->comm_fortran), + &(mumps_par->n), icntl, cntl, + &(mumps_par->nz), irn, &irn_avail, jcn, &jcn_avail, a, &a_avail, + &(mumps_par->nz_loc), irn_loc, &irn_loc_avail, jcn_loc, &jcn_loc_avail, + a_loc, &a_loc_avail, + &(mumps_par->nelt), eltptr, &eltptr_avail, eltvar, &eltvar_avail, a_elt, &a_elt_avail, + perm_in, &perm_in_avail, + rhs, &rhs_avail, redrhs, &redrhs_avail, info, rinfo, infog, rinfog, + &(mumps_par->deficiency), &(mumps_par->lwk_user), &(mumps_par->size_schur), listvar_schur, &listvar_schur_avail, schur, + &schur_avail, wk_user, &wk_user_avail, colsca, &colsca_avail, rowsca, &rowsca_avail, + &(mumps_par->instance_number), &(mumps_par->nrhs), &(mumps_par->lrhs), + &(mumps_par->lredrhs), + rhs_sparse, &rhs_sparse_avail, sol_loc, &sol_loc_avail, irhs_sparse, + &irhs_sparse_avail, irhs_ptr, &irhs_ptr_avail, isol_loc, + &isol_loc_avail, &(mumps_par->nz_rhs), &(mumps_par->lsol_loc) + , &(mumps_par->schur_mloc) + , &(mumps_par->schur_nloc) + , &(mumps_par->schur_lld) + , &(mumps_par->mblock) + , &(mumps_par->nblock) + , &(mumps_par->nprow) + , &(mumps_par->npcol) + , ooc_tmpdir + , ooc_prefix + , write_problem + , &ooc_tmpdirlen + , &ooc_prefixlen + , &write_problemlen + ); + /* + * mapping and pivnul_list are usually 0 except if + * MUMPS_AFFECT_MAPPING/MUMPS_AFFECT_PIVNUL_LIST was called. + */ + mumps_par->mapping=mumps_get_mapping(); + mumps_par->pivnul_list=mumps_get_pivnul_list(); + /* to get permutations computed during analysis */ + mumps_par->sym_perm=mumps_get_sym_perm(); + mumps_par->uns_perm=mumps_get_uns_perm(); +#ifdef return_scaling + /* + * colsca/rowsca can either be user data or have been + * modified within mumps by calls to MUMPS_AFFECT_COLSCA/ROWSCA. + */ + if (colsca_avail == no) mumps_par->colsca = MUMPS_COLSCA_STATIC; + if (rowsca_avail == no) mumps_par->rowsca = MUMPS_ROWSCA_STATIC; +#endif +} diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_common.c b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_common.c new file mode 100644 index 000000000..794439cb0 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_common.c @@ -0,0 +1,116 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +#include "mumps_common.h" +/* Special case of mapping and pivnul_list -- allocated from MUMPS */ +static MUMPS_INT * MUMPS_MAPPING; +static MUMPS_INT * MUMPS_PIVNUL_LIST; +/* as uns_perm and sym_perm */ +static MUMPS_INT * MUMPS_SYM_PERM; +static MUMPS_INT * MUMPS_UNS_PERM; +MUMPS_INT* +mumps_get_mapping() +{ + return MUMPS_MAPPING; +} +void MUMPS_CALL +MUMPS_AFFECT_MAPPING(MUMPS_INT * f77mapping) +{ + MUMPS_MAPPING = f77mapping; +} +void MUMPS_CALL +MUMPS_NULLIFY_C_MAPPING() +{ + MUMPS_MAPPING = 0; +} +MUMPS_INT* +mumps_get_pivnul_list() +{ + return MUMPS_PIVNUL_LIST; +} +void MUMPS_CALL +MUMPS_AFFECT_PIVNUL_LIST(MUMPS_INT * f77pivnul_list) +{ + MUMPS_PIVNUL_LIST = f77pivnul_list; +} +void MUMPS_CALL +MUMPS_NULLIFY_C_PIVNUL_LIST() +{ + MUMPS_PIVNUL_LIST = 0; +} +MUMPS_INT* +mumps_get_sym_perm() +{ + return MUMPS_SYM_PERM; +} +void MUMPS_CALL +MUMPS_AFFECT_SYM_PERM(MUMPS_INT * f77sym_perm) +{ + MUMPS_SYM_PERM = f77sym_perm; +} +void MUMPS_CALL +MUMPS_NULLIFY_C_SYM_PERM() +{ + MUMPS_SYM_PERM = 0; +} +MUMPS_INT* +mumps_get_uns_perm() +{ + return MUMPS_UNS_PERM; +} +void MUMPS_CALL +MUMPS_AFFECT_UNS_PERM(MUMPS_INT * f77uns_perm) +{ + MUMPS_UNS_PERM = f77uns_perm; +} +void MUMPS_CALL +MUMPS_NULLIFY_C_UNS_PERM() +{ + MUMPS_UNS_PERM = 0; +} diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_common.h b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_common.h new file mode 100644 index 000000000..86013b626 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_common.h @@ -0,0 +1,113 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +#ifndef MUMPS_COMMON_H +#define MUMPS_COMMON_H +#include "mumps_compat.h" +#include "mumps_c_types.h" +/** + * F_SYMBOL is a macro that converts a couple (lower case symbol, upper + * case symbol) into the symbol defined by the compiler convention. + * Example: For MUMPS_XXX, first define + * #define MUMPS_XXX F_SYMBOL(xxx,XXX) and then use + * MUMPS_XXX in the code to get rid of any symbol convention annoyance. + * + * NB: We need to provide both upper and lower case versions because to our + * knowledge, there is no way to perform the conversion with CPP + * directives only. + */ +#if defined(UPPER) || defined(MUMPS_WIN32) +# define F_SYMBOL(lower_case,upper_case) MUMPS_##upper_case +#elif defined(Add_) +# define F_SYMBOL(lower_case,upper_case) mumps_##lower_case##_ +#elif defined(Add__) +# define F_SYMBOL(lower_case,upper_case) mumps_##lower_case##__ +#else +# define F_SYMBOL(lower_case,upper_case) mumps_##lower_case +#endif +MUMPS_INT* +mumps_get_mapping(); +#define MUMPS_AFFECT_MAPPING \ + F_SYMBOL(affect_mapping,AFFECT_MAPPING) +void MUMPS_CALL +MUMPS_AFFECT_MAPPING(MUMPS_INT *f77mapping); +#define MUMPS_NULLIFY_C_MAPPING F_SYMBOL(nullify_c_mapping,NULLIFY_C_MAPPING) +void MUMPS_CALL +MUMPS_NULLIFY_C_MAPPING(); +MUMPS_INT* +mumps_get_pivnul_list(); +#define MUMPS_AFFECT_PIVNUL_LIST \ + F_SYMBOL(affect_pivnul_list,AFFECT_PIVNUL_LIST) +void MUMPS_CALL +MUMPS_AFFECT_PIVNUL_LIST(MUMPS_INT *f77pivnul_list); +#define MUMPS_NULLIFY_C_PIVNUL_LIST \ + F_SYMBOL(nullify_c_pivnul_list,NULLIFY_C_PIVNUL_LIST) +void MUMPS_CALL +MUMPS_NULLIFY_C_PIVNUL_LIST(); +MUMPS_INT* +mumps_get_uns_perm(); +#define MUMPS_AFFECT_UNS_PERM \ + F_SYMBOL(affect_uns_perm,AFFECT_UNS_PERM) +void MUMPS_CALL +MUMPS_AFFECT_UNS_PERM(MUMPS_INT *f77sym_perm); +#define MUMPS_NULLIFY_C_UNS_PERM \ + F_SYMBOL(nullify_c_uns_perm,NULLIFY_C_UNS_PERM) +void MUMPS_CALL +MUMPS_NULLIFY_C_UNS_PERM(); +MUMPS_INT* +mumps_get_sym_perm(); +#define MUMPS_AFFECT_SYM_PERM \ + F_SYMBOL(affect_sym_perm,AFFECT_SYM_PERM) +void MUMPS_CALL +MUMPS_AFFECT_SYM_PERM(MUMPS_INT * f77sym_perm); +#define MUMPS_NULLIFY_C_SYM_PERM \ + F_SYMBOL(nullify_c_sym_perm,NULLIFY_C_SYM_PERM) +void MUMPS_CALL +MUMPS_NULLIFY_C_SYM_PERM(); +#endif /* MUMPS_COMMON_H */ diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_headers.h b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_headers.h new file mode 100644 index 000000000..e8573542b --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_headers.h @@ -0,0 +1,77 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + INTEGER XXI, XXR, XXS, XXN, XXP + PARAMETER(XXI=0,XXR=1,XXS=3,XXN=4,XXP=5) + INTEGER XXNDIAG2W + PARAMETER(XXNDIAG2W=6) + INTEGER XSIZE_IC, XSIZE_OOC_SYM, XSIZE_OOC_UNSYM + INTEGER XSIZE_OOC_NOPANEL + PARAMETER (XSIZE_IC=6,XSIZE_OOC_SYM=7,XSIZE_OOC_UNSYM=7, + * XSIZE_OOC_NOPANEL=6) + INTEGER IXSZ + PARAMETER(IXSZ= 222) + INTEGER S_CB1COMP + PARAMETER (S_CB1COMP=314) + INTEGER S_ACTIVE, S_ALL, S_NOLCBCONTIG, + * S_NOLCBNOCONTIG, S_NOLCLEANED, + * S_NOLCBNOCONTIG38, S_NOLCBCONTIG38, + * S_NOLCLEANED38, C_FINI + PARAMETER(S_ACTIVE=400, S_ALL=401, S_NOLCBCONTIG=402, + * S_NOLCBNOCONTIG=403, S_NOLCLEANED=404, + * S_NOLCBNOCONTIG38=405, S_NOLCBCONTIG38=406, + * S_NOLCLEANED38=407,C_FINI=1) + INTEGER S_FREE, S_NOTFREE + PARAMETER(S_FREE=54321,S_NOTFREE=-123456) + INTEGER TOP_OF_STACK + PARAMETER(TOP_OF_STACK=-999999) + INTEGER XTRA_SLAVES_SYM, XTRA_SLAVES_UNSYM + PARAMETER(XTRA_SLAVES_SYM=3, XTRA_SLAVES_UNSYM=1) + INTEGER S_ROOT2SON_CALLED, S_REC_CONTSTATIC, + & S_ROOTBAND_INIT + PARAMETER(S_ROOT2SON_CALLED=-341,S_REC_CONTSTATIC=1, + & S_ROOTBAND_INIT=0) diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io.c b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io.c new file mode 100644 index 000000000..7f886b307 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io.c @@ -0,0 +1,648 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +#include "mumps_io.h" +#include "mumps_io_basic.h" +#include "mumps_io_err.h" +#if ! defined (MUMPS_WIN32) && ! defined (WITHOUT_PTHREAD) +# include "mumps_io_thread.h" +#endif +#if ! defined(MUMPS_WIN32) +double mumps_time_spent_in_sync; +#endif +double read_op_vol,write_op_vol,total_vol; +/** + * Forward declaration. Definition at the end of the file. + */ +/*MUMPS_INLINE int + mumps_convert_2fint_to_longlong( int *, int *, long long *);*/ +/* Tests if the request "request_id" has finished. It sets the flag */ +/* argument to 1 if the request has finished (0 otherwise) */ +void MUMPS_CALL +MUMPS_TEST_REQUEST_C(MUMPS_INT *request_id,MUMPS_INT *flag,MUMPS_INT *ierr) +{ + char buf[64]; /* for error message */ + int request_id_loc,flag_loc; +#if ! defined(MUMPS_WIN32) + struct timeval start_time,end_time; + gettimeofday(&start_time,NULL); +#endif + request_id_loc=(int)*request_id; + switch(mumps_io_flag_async){ + case IO_SYNC: + /* printf("mumps_test_request_c should not be called with strategy %d\n",mumps_io_flag_async);*/ + /* JY+EA: Allow for this option, since it is similar to wait_request + * and wait_request is allowed in synchronous mode. + * We always return TRUE. + */ + *flag=1; + break; +#if ! defined(MUMPS_WIN32) && ! defined(WITHOUT_PTHREAD) + case IO_ASYNC_TH: + *ierr=(MUMPS_INT)mumps_test_request_th(&request_id_loc,&flag_loc); + *flag=(MUMPS_INT)flag_loc; + break; +#endif + default: + *ierr=-92; + sprintf(buf,"Error: unknown I/O strategy : %d\n",mumps_io_flag_async); + mumps_io_error((int)*ierr,buf); + return; + } +#if ! defined(MUMPS_WIN32) + gettimeofday(&end_time,NULL); + mumps_time_spent_in_sync=mumps_time_spent_in_sync+((double)end_time.tv_sec+((double)end_time.tv_usec/1000000))-((double)start_time.tv_sec+((double)start_time.tv_usec/1000000)); +#endif + return; +} +/* Waits for the termination of the request "request_id" */ +void MUMPS_CALL +MUMPS_WAIT_REQUEST(MUMPS_INT *request_id,MUMPS_INT *ierr) +{ + char buf[64]; /* for error message */ + int request_id_loc; +#if ! defined(MUMPS_WIN32) + struct timeval start_time,end_time; + gettimeofday(&start_time,NULL); +#endif + request_id_loc=(int)*request_id; + if(*request_id==-1) + return; + switch(mumps_io_flag_async){ + case IO_SYNC: + /* printf("mumps_wait_request should not be called with strategy %d\n",mumps_io_flag_async); */ + break; +#if ! defined(MUMPS_WIN32) && ! defined(WITHOUT_PTHREAD) + case IO_ASYNC_TH: + *ierr=(MUMPS_INT)mumps_wait_request_th(&request_id_loc); + break; +#endif + default: + *ierr=-92; + sprintf(buf,"Error: unknown I/O strategy : %d\n",mumps_io_flag_async); + mumps_io_error((int)*ierr,buf); + return; + /* printf("Error: unknown I/O strategy : %d\n",mumps_io_flag_async); + exit (-3);*/ + } +#if ! defined(MUMPS_WIN32) + gettimeofday(&end_time,NULL); + mumps_time_spent_in_sync=mumps_time_spent_in_sync+((double)end_time.tv_sec+((double)end_time.tv_usec/1000000))-((double)start_time.tv_sec+((double)start_time.tv_usec/1000000)); +#endif + return; +} +/** + * Inits the I/O OOC mechanism. + * Because on some computers, file size is limited, the I/O + * mechanism must be able to handle a multi-file access to data. + * Hence, we compute mumps_io_nb_file, which is the the number of files + * we estimate we need. + * Because of not exact matching between data packets written and size + * of files, the recoverment may be imperfect. Consequently, we must + * be able to reallocate if necessary. + */ +void MUMPS_CALL +MUMPS_LOW_LEVEL_INIT_PREFIX(MUMPS_INT *dim, char *str, mumps_ftnlen l1) +{ + int i; + MUMPS_OOC_STORE_PREFIXLEN = *dim; + if( *dim > MUMPS_OOC_PREFIX_MAX_LENGTH ) + MUMPS_OOC_STORE_PREFIXLEN = MUMPS_OOC_PREFIX_MAX_LENGTH; + for(i=0;i MUMPS_OOC_TMPDIR_MAX_LENGTH ) + MUMPS_OOC_STORE_TMPDIRLEN = MUMPS_OOC_TMPDIR_MAX_LENGTH; + for(i=0;i +pthread_mutex_t mumps_io_pwrite_mutex; +# endif +/* int* mumps_io_pfile_pointer_array; */ +/* int* mumps_io_current_file; */ +/* #else /\*MUMPS_WIN32*\/ */ +/* FILE** mumps_io_current_file; */ +/* FILE** mumps_io_pfile_pointer_array; */ +#endif /* MUMPS_WIN32 */ +/* mumps_file_struct* mumps_io_pfile_pointer_array; + mumps_file_struct* mumps_io_current_file; */ +mumps_file_type* mumps_files = NULL; +/* int mumps_io_current_file_number; */ +char* mumps_ooc_file_prefix = NULL; +/* char** mumps_io_pfile_name; */ +/* int mumps_io_current_file_position; */ +/* int mumps_io_write_pos; */ +/* int mumps_io_last_file_opened; */ +int mumps_elementary_data_size; +int mumps_io_is_init_called; +int mumps_io_myid; +int mumps_io_max_file_size; +/* int mumps_io_nb_file; */ +int mumps_io_flag_async; +int mumps_io_k211; +/* int mumps_flag_open;*/ +int mumps_directio_flag; +int mumps_io_nb_file_type; +/* Functions */ +int mumps_set_file(int type,int file_number_arg){ + /* Defines the pattern for the file name. The last 6 'X' will be replaced + so as to name were unique */ + char name[351]; +#if ! defined(_WIN32) + int fd; + char buf[64]; /* for error message */ +#endif + mumps_file_struct *mumps_io_pfile_pointer_array; + /* if ((mumps_files+type)->mumps_io_current_file_number >= ((mumps_files+type)->mumps_io_nb_file)-1){*/ + if (file_number_arg > ((mumps_files+type)->mumps_io_nb_file)-1){ + /* Exception : probably thrown because of a bad estimation + of number of files. */ + /* We increase the number of file needed and then realloc. */ + ((mumps_files+type)->mumps_io_nb_file)++; + (mumps_files+type)->mumps_io_pfile_pointer_array=realloc((void *)(mumps_files+type)->mumps_io_pfile_pointer_array,((mumps_files+type)->mumps_io_nb_file)*sizeof(mumps_file_struct)); + if((mumps_files+type)->mumps_io_pfile_pointer_array==NULL){ + return mumps_io_error(-13,"Allocation problem in low-level OOC layer\n"); + } + ((mumps_files+type)->mumps_io_pfile_pointer_array+((mumps_files+type)->mumps_io_nb_file)-1)->is_opened = 0; + } + mumps_io_pfile_pointer_array=(mumps_files+type)->mumps_io_pfile_pointer_array; + /* Do change the current file */ + ((mumps_files+type)->mumps_io_current_file_number)=file_number_arg; + if((mumps_io_pfile_pointer_array+file_number_arg)->is_opened!=0){ + ((mumps_files+type)->mumps_io_current_file_number)=file_number_arg; + return 0; + } +/* #if ! defined( MUMPS_WIN32 )*/ +/* MinGW does not have a mkstemp function and MinGW defines _WIN32, + * so we also go in the else branch below with MinGW */ +#if ! defined(_WIN32) + strcpy(name,mumps_ooc_file_prefix); + fd=mkstemp(name); + /* Note that a file name is built by mkstemp and that the file is + opened. fd hold the file descriptor to access it. + We want to close the file that will be opened later + and might be removed before the end of the processus. + */ + if(fd < 0) { + sprintf(buf,"File creation failure"); + return mumps_io_sys_error(-90,buf); + } else { + close(fd); + } +#else + sprintf(name,"%s_%d_%d",mumps_ooc_file_prefix,((mumps_files+type)->mumps_io_current_file_number)+1,type); +#endif +/* *(mumps_io_pfile_pointer_array+mumps_io_current_file_number)=fopen(name,"w+"); */ +/* *(mumps_io_pfile_name+mumps_io_current_file_number)=(char *)malloc((strlen(name)+1)*sizeof(char)); */ +/* if(*(mumps_io_pfile_name+mumps_io_current_file_number)==NULL){ */ +/* sprintf(error_str,"Allocation problem in low-level OOC layer\n"); */ +/* return -13; */ +/* } */ + strcpy((mumps_io_pfile_pointer_array+(mumps_files+type)->mumps_io_current_file_number)->name,name); + /* See mumps_io_basic.h for comments on the I/O flags passed to open */ +#if ! defined( MUMPS_WIN32 ) + (mumps_io_pfile_pointer_array+(mumps_files+type)->mumps_io_current_file_number)->file=open(name,(mumps_files+type)->mumps_flag_open,0666); + /* +CPA: for LU factor file: +(mumps_io_pfile_pointer_array+(mumps_files+type)->mumps_io_current_file_number)->file= open(name, O_WRONLY | O_CREAT | O_TRUNC, 0666); */ + if((mumps_io_pfile_pointer_array+(mumps_files+type)->mumps_io_current_file_number)->file==-1){ + return mumps_io_sys_error(-90,"Unable to open OOC file"); + } +#else + (mumps_io_pfile_pointer_array+(mumps_files+type)->mumps_io_current_file_number)->file=fopen(name,(mumps_files+type)->mumps_flag_open); + if((mumps_io_pfile_pointer_array+(mumps_files+type)->mumps_io_current_file_number)->file==NULL){ + return mumps_io_error(-90,"Problem while opening OOC file"); + } +#endif + (mumps_files+type)->mumps_io_current_file=(mumps_io_pfile_pointer_array+(mumps_files+type)->mumps_io_current_file_number); + ((mumps_files+type)->mumps_io_nb_file_opened)++; + if((mumps_files+type)->mumps_io_current_file_number>(mumps_files+type)->mumps_io_last_file_opened){ + (mumps_files+type)->mumps_io_last_file_opened=(mumps_files+type)->mumps_io_current_file_number; + } + /* if(*(mumps_io_pfile_pointer_array+mumps_io_current_file_number)==NULL) */ + ((mumps_files+type)->mumps_io_current_file)->write_pos=0; + ((mumps_files+type)->mumps_io_current_file)->is_opened=1; + /* printf("new file created -> num = %d \n", ((mumps_files+type)->mumps_io_last_file_opened));*/ + /* printf("new file created %d\n",mumps_io_current_file_number);*/ + return 0; +} +void mumps_update_current_file_position(mumps_file_struct* file_arg){ + file_arg->current_pos=file_arg->write_pos; +/* mumps_io_current_file_position=mumps_io_write_pos; */ +} +int mumps_compute_where_to_write(const double to_be_written,const int type,long long vaddr,size_t already_written){ + /* Check if the current file has enough memory to receive the whole block*/ + int ret_code; + int file; + mumps_file_struct *current_file; + long long vaddr_loc; + int pos; + /* Virtual address based file management scheme */ + vaddr_loc=vaddr*(long long)mumps_elementary_data_size+(long long)already_written; + mumps_gen_file_info(vaddr_loc,&pos,&file); + ret_code=mumps_set_file(type,file); + if(ret_code<0){ + return ret_code; + } + current_file=(mumps_files+type)->mumps_io_current_file; + current_file->write_pos=pos; + mumps_update_current_file_position(current_file); + return 0; +} +int mumps_prepare_pointers_for_write(double to_be_written,int * pos_in_file, int * file_number,const int type,long long vaddr,size_t already_written){ + int ret_code; + ret_code=mumps_compute_where_to_write(to_be_written,type,vaddr,already_written); + if(ret_code<0){ + return ret_code; + } + *pos_in_file=((mumps_files+type)->mumps_io_current_file)->current_pos; + /* should be modified to take into account the file arg */ + *file_number=(mumps_files+type)->mumps_io_current_file_number; + return 0; +} +MUMPS_INLINE int mumps_gen_file_info(long long vaddr, int * pos, int * file){ + *file=(int)(vaddr/(long long)mumps_io_max_file_size); + *pos=(int)(vaddr%(long long)mumps_io_max_file_size); + return 0; +} +int mumps_compute_nb_concerned_files(long long block_size, int * nb_concerned_files,long long vaddr){ + int file,pos,available_size; + long long vaddr_loc; + vaddr_loc=vaddr*(long long)mumps_elementary_data_size; + mumps_gen_file_info(vaddr_loc,&pos,&file); + available_size=mumps_io_max_file_size-pos+1; + *nb_concerned_files=(int)my_ceil((double)(my_max(0,((block_size)*(double)(mumps_elementary_data_size))-available_size))/(double)mumps_io_max_file_size)+1; + return 0; +} +int mumps_io_do_write_block(void * address_block, + long long block_size, + int * type_arg, + long long vaddr, + int * ierr){ + /* Type of fwrite : size_t fwrite(const void *ptr, size_t size, + *size_t nmemb, FILE *stream); */ + size_t write_size; + int i; + int nb_concerned_files=0; + int ret_code,file_number_loc,pos_in_file_loc; + double to_be_written; +#if ! defined( MUMPS_WIN32 ) + int* file; +#else + FILE** file; +#endif + int where; + void* loc_addr; + int type; + size_t already_written=0; + char buf[64]; + type=*type_arg; + loc_addr=address_block; + mumps_compute_nb_concerned_files(block_size,&nb_concerned_files,vaddr); + to_be_written=((double)mumps_elementary_data_size)*((double)(block_size)); + /* printf("nb_concerned -> %d | %lf \n",nb_concerned_files,to_be_written); */ + for(i=0;imumps_io_current_file)->write_pos)>to_be_written){ + write_size=(size_t)to_be_written; + already_written=(size_t)to_be_written; + }else{ + write_size=(size_t)((double)(mumps_io_max_file_size-((mumps_files+type)->mumps_io_current_file)->write_pos)); + already_written=already_written+(size_t)write_size; + } +#if defined( MUMPS_WIN32 ) + write_size=(size_t)(int)((write_size)/mumps_elementary_data_size); +#endif + file=&(((mumps_files+type)->mumps_io_current_file)->file); + where=((mumps_files+type)->mumps_io_current_file)->write_pos; +#if ! defined( MUMPS_WIN32 ) && ! defined (WITHOUT_PTHREAD) +# ifdef WITH_PFUNC + if(mumps_io_flag_async==IO_ASYNC_TH){ + mumps_io_unprotect_pointers(); + } +# endif +#endif + /* printf("1 write -> size = %d | off = %d | file = %d (%d) \n",(int)write_size,where,*file,((mumps_files+type)->mumps_io_current_file)->write_pos); */ + ret_code=mumps_io_write__(file,loc_addr,write_size,where,type); + if(ret_code<0){ + return ret_code; + } +#if ! defined( MUMPS_WIN32 ) && ! defined (WITHOUT_PTHREAD) +# ifdef WITH_PFUNC + if(mumps_io_flag_async==IO_ASYNC_TH){ + mumps_io_protect_pointers(); + } +# endif +#endif +#if ! defined( MUMPS_WIN32 ) + ((mumps_files+type)->mumps_io_current_file)->write_pos=((mumps_files+type)->mumps_io_current_file)->write_pos+((int)write_size); + to_be_written=to_be_written-((int)write_size); + loc_addr=(void*)((size_t)loc_addr+write_size); +/* mumps_io_write_pos=mumps_io_write_pos+((int)write_size); */ +/* to_be_written=to_be_written-((int)write_size); */ +/* loc_addr=(void*)((size_t)loc_addr+write_size); */ +#else + /* fread and write */ + ((mumps_files+type)->mumps_io_current_file)->write_pos=((mumps_files+type)->mumps_io_current_file)->write_pos+((int)write_size*mumps_elementary_data_size); + to_be_written=to_be_written-((int)write_size*mumps_elementary_data_size); + loc_addr=(void*)((size_t)loc_addr+(size_t)((int)write_size*mumps_elementary_data_size)); +/* mumps_io_write_pos=mumps_io_write_pos+((int)write_size*mumps_elementary_data_size); */ +/* to_be_written=to_be_written-((int)write_size*mumps_elementary_data_size); */ +/* loc_addr=(void*)((size_t)loc_addr+(size_t)((int)write_size*mumps_elementary_data_size)); */ +#endif +#if ! defined( MUMPS_WIN32 ) && ! defined (WITHOUT_PTHREAD) +# ifdef WITH_PFUNC + if(mumps_io_flag_async==IO_ASYNC_TH){ + mumps_io_unprotect_pointers(); + } +# endif +#endif + } + if(to_be_written!=0){ + *ierr = -90; + sprintf(buf,"Internal (1) error in low-level I/O operation %lf",to_be_written); + return mumps_io_error(*ierr,buf); + } + /* printf("write ok -> %d \n");*/ + return 0; +} +int mumps_io_do_read_block(void * address_block, + long long block_size, + int * type_arg, + long long vaddr, + int * ierr){ + size_t size; +#if ! defined( MUMPS_WIN32 ) + int* file; +#else + FILE** file; +#endif + double read_size; + int local_fnum,local_offset; + void *loc_addr; + long long vaddr_loc; + int type; + type=*type_arg; + /* if(((double)(*block_size))*((double)(mumps_elementary_data_size))>(double)mumps_io_max_file_size){ + sprintf(error_str,"Internal error in low-level I/O operation (requested size too big for file system) \n"); + return -90; + }*/ + if(block_size==0){ + return 0; + } + read_size=(double)mumps_elementary_data_size*(double)(block_size); + /* if((*file_number<0)&&(read_size<(double)mumps_io_max_file_size)){ + sprintf(error_str,"Internal error (1) in low level read op\n"); + return -90; + }*/ + loc_addr=address_block; + vaddr_loc=vaddr*(long long)mumps_elementary_data_size; + while(read_size>0){ + /* Virtual addressing based management stuff */ + local_fnum=(int)(vaddr_loc/(long long)mumps_io_max_file_size); + local_offset=(int)(vaddr_loc%(long long)mumps_io_max_file_size); + file=&((((mumps_files+type)->mumps_io_pfile_pointer_array)+local_fnum)->file); + /* printf("1 read | file -> %d | fnum -> %d | vaddr -> %d \n",*file,local_fnum,(int)vaddr_loc); */ +#if ! defined( MUMPS_WIN32 ) + if(read_size+(double)local_offset>(double)mumps_io_max_file_size){ + size=(size_t)mumps_io_max_file_size-(size_t)local_offset; + }else{ + size=(size_t)read_size; + } +#else + if(read_size+(double)local_offset>(double)mumps_io_max_file_size){ + size=((size_t)mumps_io_max_file_size-(size_t)local_offset)/(size_t)mumps_elementary_data_size; + }else{ + size=(size_t)(read_size/mumps_elementary_data_size); + } +#endif + *ierr=mumps_io_read__(file,loc_addr,size,local_offset,type); + if(*ierr<0){ + return *ierr; + } +#if defined( MUMPS_WIN32 ) + size=size*mumps_elementary_data_size; +#endif + vaddr_loc=vaddr_loc+(long long)size; + read_size=read_size-(double)size; + loc_addr=(void*)((size_t)loc_addr+size); + local_fnum++; + local_offset=0; + if(local_fnum>(mumps_files+type)->mumps_io_nb_file){ + *ierr = -90; + return mumps_io_error(*ierr,"Internal error (2) in low level read op\n"); + } + } + return 0; +} +int mumps_free_file_pointers(int *step){ + int i,j,bound,ierr; +/* Free prefix only for facto */ + if (*step == 0) free(mumps_ooc_file_prefix); + if(mumps_files == NULL ) + return 0; +#if ! defined( MUMPS_WIN32 ) +#endif + bound=mumps_io_nb_file_type; +/* if(*step==0){ */ +/* /\* factorization *\/ */ +/* bound=NB_FILE_TYPE_FACTO; */ +/* }else{ */ +/* /\* solve *\/ */ +/* bound=NB_FILE_TYPE_SOLVE; */ +/* } */ + for(j=0;jmumps_io_nb_file_opened;i++){ +#if ! defined( MUMPS_WIN32 ) + ierr=close((((mumps_files+j)->mumps_io_pfile_pointer_array)+i)->file); + if(ierr==-1){ + return mumps_io_sys_error(-90,"Problem while closing OOC file"); + } +#else + ierr=fclose((((mumps_files+j)->mumps_io_pfile_pointer_array)+i)->file); + if(ierr==-1){ + return mumps_io_error(-90,"Problem while closing OOC file\n"); + } +#endif + /* free(*(mumps_io_pfile_name+i)); */ + } + free((mumps_files+j)->mumps_io_pfile_pointer_array); + } +/* free(mumps_io_pfile_name); */ + free(mumps_files); +#if ! defined( MUMPS_WIN32 ) +#endif + return 0; +} +/* Initialize the mumps_file_type structure at th position in + mumps_files. It only set values with no allocation to avoid any errors. */ +void mumps_io_init_file_struct(int* nb,int which) +{ + (mumps_files+which)->mumps_io_current_file_number = -1; + (mumps_files+which)->mumps_io_last_file_opened = -1; + (mumps_files+which)->mumps_io_nb_file_opened = 0; + (mumps_files+which)->mumps_io_nb_file=*nb; + (mumps_files+which)->mumps_io_pfile_pointer_array = NULL; + (mumps_files+which)->mumps_io_current_file=NULL; +} +/* Allocate the file structures for factor files */ +int mumps_io_alloc_file_struct(int* nb,int which) +{ + int i; + (mumps_files+which)->mumps_io_pfile_pointer_array=(mumps_file_struct *)malloc((*nb)*sizeof(mumps_file_struct)); + if((mumps_files+which)->mumps_io_pfile_pointer_array==NULL){ + return mumps_io_error(-13,"Allocation problem in low-level OOC layer\n"); + } + for(i=0;i<*nb;i++){ + (((mumps_files+which)->mumps_io_pfile_pointer_array)+i)->is_opened=0; + } + return 0; +} +int mumps_init_file_structure(int* _myid, long long *total_size_io,int *size_element,int *nb_file_type,int *flag_tab) +{ + /* Computes the number of files needed. Uses ceil value. */ + int ierr; +#if ! defined( MUMPS_WIN32 ) + int k211_loc; + int mumps_flag_open; +#endif + int i,nb; + int mumps_io_nb_file; + mumps_io_max_file_size=MAX_FILE_SIZE; + mumps_io_nb_file_type=*nb_file_type; + mumps_io_nb_file=(int)((((double)(*total_size_io)*1000000)*((double)(*size_element)))/(double)mumps_io_max_file_size)+1; + mumps_directio_flag=0; +#if ! defined( MUMPS_WIN32 ) + mumps_flag_open=0; +#endif + mumps_io_myid=*_myid; + mumps_elementary_data_size=*size_element; + /* Allocates the memory necessary to handle the file pointer array.*/ + mumps_files=(mumps_file_type *)malloc(mumps_io_nb_file_type*sizeof(mumps_file_type)); + if(mumps_files==NULL){ + return mumps_io_error(-13,"Allocation problem in low-level OOC layer\n"); + } + /* Safe initialization of the mumps_file_type elements */ + for(i=0;imumps_flag_open=mumps_flag_open|O_WRONLY|O_CREAT|O_TRUNC; +#else + strcpy((mumps_files+i)->mumps_flag_open,"wb"); +#endif + break; + case 1: +#if ! defined( MUMPS_WIN32 ) + (mumps_files+i)->mumps_flag_open=mumps_flag_open|O_RDONLY|O_CREAT|O_TRUNC; +#else + strcpy((mumps_files+i)->mumps_flag_open,"rb"); +#endif + break; + case 2: +#if ! defined( MUMPS_WIN32 ) + (mumps_files+i)->mumps_flag_open=mumps_flag_open|O_RDWR|O_CREAT|O_TRUNC; +#else + strcpy((mumps_files+i)->mumps_flag_open,"rwb"); +#endif + break; + default: + return mumps_io_error(-90,"unknown value of flag_open\n"); + } + ierr=mumps_io_alloc_file_struct(&nb,i); + if(ierr<0){ + return ierr; + } + ierr=mumps_set_file(i,0); + if(ierr<0){ + return ierr; + } + } + /* Init the current file.*/ + return 0; +} +int mumps_init_file_name(char* mumps_dir,char* mumps_file, + int* mumps_dim_dir,int* mumps_dim_file,int* _myid){ + int i; + char *tmp_dir,*tmp_fname; + char base_name[20]; + int dir_flag=0,file_flag=0; + char mumps_base[10]="mumps_"; + tmp_dir=(char *)malloc(((*mumps_dim_dir)+1)*sizeof(char)); + if(tmp_dir==NULL){ + return mumps_io_error(-13,"Allocation problem in low-level OOC layer\n"); + } + tmp_fname=(char *)malloc(((*mumps_dim_file)+1)*sizeof(char)); + if(tmp_fname==NULL){ + return mumps_io_error(-13,"Allocation problem in low-level OOC layer\n"); + } + for(i=0;i<*mumps_dim_dir;i++){ + tmp_dir[i]=mumps_dir[i]; + } + tmp_dir[i]=0; + for(i=0;i<*mumps_dim_file;i++){ + tmp_fname[i]=mumps_file[i]; + } + tmp_fname[i]=0; + if(strcmp(tmp_dir,UNITIALIZED)==0){ + dir_flag=1; + free(tmp_dir); + tmp_dir=getenv("MUMPS_OOC_TMPDIR"); + if(tmp_dir==NULL){ +#ifdef _AIX +# ifndef CINES_ + tmp_dir=getenv("TMPDIR"); + if(tmp_dir==NULL){ + tmp_dir=MUMPS_OOC_DEFAULT_DIR; + } +# else + tmp_dir=MUMPS_OOC_DEFAULT_DIR; +# endif +#else + tmp_dir=MUMPS_OOC_DEFAULT_DIR; +#endif + } + } + if(strcmp(tmp_fname,UNITIALIZED)==0){ + free(tmp_fname); + tmp_fname=getenv("MUMPS_OOC_PREFIX"); + file_flag=1; + } + if(tmp_fname!=NULL){ +#if ! defined( MUMPS_WIN32 ) + sprintf(base_name,"_%s%d_XXXXXX",mumps_base,*_myid); +#else + sprintf(base_name,"_%s%d",mumps_base,*_myid); +#endif + mumps_ooc_file_prefix=(char *)malloc((strlen(SEPARATOR)+strlen(tmp_dir)+strlen(tmp_fname)+strlen(base_name)+1+1)*sizeof(char)); + if(mumps_ooc_file_prefix==NULL){ + return mumps_io_error(-13,"Allocation problem in low-level OOC layer\n"); + } + sprintf(mumps_ooc_file_prefix,"%s%s%s%s",tmp_dir,SEPARATOR,tmp_fname,base_name); + }else{ +#if ! defined( MUMPS_WIN32 ) + sprintf(base_name,"%s%s%d_XXXXXX",SEPARATOR,mumps_base,*_myid); +#else + sprintf(base_name,"%s%s%d",SEPARATOR,mumps_base,*_myid); +#endif + mumps_ooc_file_prefix=(char *)malloc((strlen(SEPARATOR)+strlen(tmp_dir)+strlen(base_name)+1)*sizeof(char)); + if(mumps_ooc_file_prefix==NULL){ + return mumps_io_error(-13,"Allocation problem in low-level OOC layer\n"); + } + sprintf(mumps_ooc_file_prefix,"%s%s%s",tmp_dir,SEPARATOR,base_name); + } + if(!dir_flag){ + free(tmp_dir); + } + if(!file_flag){ + free(tmp_fname); + } + return 0; +} +int mumps_io_get_nb_files(int* nb_files, const int* type){ + *nb_files=((mumps_files+*type)->mumps_io_last_file_opened)+1; + return 0; +} +int mumps_io_get_file_name(int* indice,char* name,int* length,int* type){ + int i; + i=(*indice)-1; + strcpy(name,(((mumps_files+*type)->mumps_io_pfile_pointer_array)+i)->name); + *length=(int)strlen(name)+1; + return 0; +} +int mumps_io_alloc_pointers(int* nb_file_type,int * dim){ + int ierr; + int i; + /* This is called by solve step, we have only one type of files */ + mumps_io_nb_file_type=*nb_file_type; + mumps_files=(mumps_file_type *)malloc(mumps_io_nb_file_type*sizeof(mumps_file_type)); + if(mumps_files==NULL){ + return mumps_io_error(-13,"Allocation problem in low-level OOC layer\n"); + } + for(i=0;imumps_flag_open=mumps_flag_open|O_RDONLY; +#else + strcpy((mumps_files+i)->mumps_flag_open,"rb"); +#endif + } + mumps_io_myid=*myid_arg; + mumps_elementary_data_size=*size_element; + mumps_io_flag_async=*async_arg; + return 0; +} +int mumps_io_set_file_name(int* indice,char* name,int* length,int* type){ + int i; + i=(*indice)-1; +/* *(mumps_io_pfile_name+i)=(char *) malloc((*length)*strlen(name)); */ +/* if(*(mumps_io_pfile_name+i)==NULL){ */ +/* sprintf(error_str,"Allocation problem in low-level OOC layer"); */ +/* return -13; */ +/* } */ + strcpy((((mumps_files+*type)->mumps_io_pfile_pointer_array)+i)->name,name); + return 0; +} +int mumps_io_open_files_for_read(){ + int i,j; + mumps_file_struct *mumps_io_pfile_pointer_array; +#if defined (sgi) || defined (__sgi) + struct dioattr dio; +#endif + for(j=0;jmumps_io_pfile_pointer_array; + for(i=0;i<(mumps_files+j)->mumps_io_nb_file;i++){ +#if ! defined( MUMPS_WIN32 ) + (mumps_io_pfile_pointer_array+i)->file=open((mumps_io_pfile_pointer_array+i)->name,(mumps_files+j)->mumps_flag_open); + if((mumps_io_pfile_pointer_array+i)->file==-1){ + return mumps_io_sys_error(-90,"Problem while opening OOC file"); + } +#else + (mumps_io_pfile_pointer_array+i)->file=fopen((mumps_io_pfile_pointer_array+i)->name,(mumps_files+j)->mumps_flag_open); + if((mumps_io_pfile_pointer_array+i)->file==NULL){ + return mumps_io_error(-90,"Problem while opening OOC file"); + } + (mumps_io_pfile_pointer_array+i)->is_opened=1; +#endif + } + } + return 0; +} +int mumps_io_set_last_file(int* dim,int* type){ + (mumps_files+*type)->mumps_io_last_file_opened=*dim-1; + (mumps_files+*type)->mumps_io_nb_file_opened=*dim; + return 0; +} +#if ! defined( MUMPS_WIN32 ) && ! defined (WITHOUT_PTHREAD) +# ifdef WITH_PFUNC +int mumps_io_protect_pointers(){ + pthread_mutex_lock(&mumps_io_pwrite_mutex); + return 0; +} +int mumps_io_unprotect_pointers(){ + pthread_mutex_unlock(&mumps_io_pwrite_mutex); + return 0; +} +int mumps_io_init_pointers_lock(){ + pthread_mutex_init(&mumps_io_pwrite_mutex,NULL); + return 0; +} +int mumps_io_destroy_pointers_lock(){ + pthread_mutex_destroy(&mumps_io_pwrite_mutex); + return 0; +} +# endif /*WITH_PFUNC*/ +#endif /* _WIN32 && WITHOUT_PTHREAD */ + int mumps_io_read__(void * file,void * loc_addr,size_t size,int local_offset,int type){ + int ret_code; +#if ! defined( MUMPS_WIN32 ) + if(!mumps_directio_flag){ + ret_code=mumps_io_read_os_buff__(file,loc_addr, size,local_offset); + if(ret_code<0){ + return ret_code; + } + } +#else + ret_code=mumps_io_read_win32__(file,loc_addr, size,local_offset); + if(ret_code<0){ + return ret_code; + } +#endif + return 0; +} +#if ! defined( MUMPS_WIN32 ) +int mumps_io_read_os_buff__(void * file,void * loc_addr,size_t size,int local_offset){ + size_t ret_code; + /* printf("Read with buff %d %d %d\n",(int) size, local_offset,*((int *)file)); */ +# ifdef WITH_PFUNC + ret_code=pread(*(int *)file,loc_addr,size,local_offset); +# else + lseek(*(int *)file,(long) local_offset,SEEK_SET); + ret_code=read(*(int *)file,loc_addr,size); +# endif + if((int) ret_code==-1){ + return mumps_io_sys_error(-90,"Problem with low level read"); + } + return 0; +} +#endif +#if defined( MUMPS_WIN32 ) +int mumps_io_read_win32__(void * file,void * loc_addr,size_t size,int local_offset){ + size_t ret_code; + fseek(*(FILE **)file,(long) local_offset,SEEK_SET); + ret_code=fread(loc_addr,mumps_elementary_data_size,size,*(FILE **)file); + if(ret_code!=size){ + return mumps_io_error(-90,"Problem with I/O operation\n"); + } + return 0; +} +#endif +int mumps_io_write__(void *file, void *loc_addr, size_t write_size, int where,int type){ + int ret_code; +#if ! defined( MUMPS_WIN32 ) + if(!mumps_directio_flag){ + ret_code=mumps_io_write_os_buff__(file,loc_addr, write_size,where); + if(ret_code<0){ + return ret_code; + } + } +#else + ret_code=mumps_io_write_win32__(file,loc_addr, write_size,where); + if(ret_code<0){ + return ret_code; + } +#endif + return 0; +} +#if ! defined( MUMPS_WIN32 ) +int mumps_io_write_os_buff__(void *file, void *loc_addr, size_t write_size, int where){ + size_t ret_code; + /* printf("write with buff %d %d %d\n",(int) write_size, where,*((int *)file)); */ +# ifdef WITH_PFUNC + ret_code=pwrite(*(int *)file,loc_addr,write_size,where); +# else + /*in this case all the I/O's are made by the I/O thread => we don't + need to protect the file pointer.*/ + lseek(*(int *)file,(long)where,SEEK_SET); + ret_code=write(*(int *)file,loc_addr,write_size); +# endif + if((int)ret_code==-1){ + return mumps_io_sys_error(-90,"Problem with low level write"); + } else if(ret_code!=write_size){ + return mumps_io_error(-90,"Error not enough space on disk \n"); + } + return 0; +} +#endif +#if defined( MUMPS_WIN32 ) +int mumps_io_write_win32__(void *file, void *loc_addr, size_t write_size, int where){ + size_t ret_code; + fseek(*(FILE **)file,(long)where,SEEK_SET); + ret_code=fwrite(loc_addr,mumps_elementary_data_size, write_size,*(FILE**)file); + if(ret_code!=write_size){ + return mumps_io_error(-90,"Problem with I/O operation\n"); + } + return 0; +} +#endif +int mumps_compute_file_size(void *file,size_t *size){ + /* Compute the size of the file pointed by file and return it in + size */ +#if defined(MUMPS_WIN32) + /* This works well as soon as we don't use threads under WIN32 */ + int ret_code; + long pos=0; + /* Get the current position */ + pos=ftell(*(FILE **)file); + /* Move the file pointer to the end of the file */ + fseek(*(FILE **)file,0,SEEK_END); + /* Get the current position which is in fact the size */ + *size=(size_t)ftell(*(FILE **)file); + /* Restore the old position */ + fseek(*(FILE **)file,pos,SEEK_SET); +#else + struct stat file_info; + /* fstat does everything :-) */ + fstat(*(int *)file, &file_info); + *size = (size_t)file_info.st_size; +#endif + return 0; +} diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io_basic.h b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io_basic.h new file mode 100644 index 000000000..e9eb6fff6 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io_basic.h @@ -0,0 +1,214 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +#ifndef MUMPS_IO_BASIC_H +#define MUMPS_IO_BASIC_H +#include "mumps_compat.h" +#if ! defined(WITHOUT_PTHREAD) && defined(MUMPS_WIN32) +# define WITHOUT_PTHREAD 1 +#endif +#if defined(_AIX) +# if ! defined(_ALL_SOURCE) +/* Macro needed for direct I/O on IBM AIX */ +# define _ALL_SOURCE 1 +# endif +#endif +#if ! defined (MUMPS_WIN32) +# if ! defined(_XOPEN_SOURCE) +/* Setting this macro avoids the warnings ("missing + * prototype") related to the use of pread /pwrite */ +# define _XOPEN_SOURCE 500 +# endif +#endif +#define MAX_FILE_SIZE 1879048192 /* (2^31)-1-(2^27) */ +/* #define MAX_FILE_SIZE 1000000 */ /* (2^31)-1-(2^27) */ +/* */ +/* Important Note : */ +/* ================ */ +/* On GNU systems, __USE_GNU must be defined to have */ +/* access to the O_DIRECT I/O flag. */ +/* */ +#include +#include +#include +#include +#if ! defined (MUMPS_WIN32) +# include +# include +# include +# include +# include +# include +#endif +#if ! defined (MUMPS_WIN32) +# define MUMPS_IO_FLAG_O_DIRECT 0 +#endif +/* Force WITH_PFUNC on architectures where we know that it should work */ +#if (defined (sgi) || defined (__sgi)) || defined(_AIX) || (defined(sun) || defined(__sun)) || defined(_GNU_SOURCE) +# undef WITH_PFUNC +# define WITH_PFUNC +#endif +#define IO_SYNC 0 +#define IO_ASYNC_TH 1 +#define IO_ASYNC_AIO 2 +#define IO_READ 1 +#define IO_WRITE 0 +#define UNITIALIZED "NAME_NOT_INITIALIZED" +#define MUMPS_OOC_DEFAULT_DIR "/tmp" +#ifdef MUMPS_WIN32 +# define SEPARATOR "\\" +#else +# define SEPARATOR "/" +#endif +/* #define NB_FILE_TYPE_FACTO 1 */ +/* #define NB_FILE_TYPE_SOLVE 1 */ +#define my_max(x,y) ( (x) > (y) ? (x) : (y) ) +#define my_ceil(x) ( (int)(x) >= (x) ? (int)(x) : ( (int)(x) + 1 ) ) +typedef struct __mumps_file_struct{ + int write_pos; + int current_pos; + int is_opened; +#if ! defined (MUMPS_WIN32) + int file; +#else + FILE* file; +#endif + char name[351]; /* Should be large enough to hold tmpdir, prefix, suffix */ +}mumps_file_struct; +typedef struct __mumps_file_type{ +#if ! defined (MUMPS_WIN32) + int mumps_flag_open; +#else + char mumps_flag_open[6]; +#endif + int mumps_io_current_file_number; + int mumps_io_last_file_opened; + int mumps_io_nb_file_opened; + int mumps_io_nb_file; + mumps_file_struct* mumps_io_pfile_pointer_array; + mumps_file_struct* mumps_io_current_file; +}mumps_file_type; +/* Exported global variables */ +#if ! defined (MUMPS_WIN32) +# if defined (WITH_PFUNC) && ! defined (WITHOUT_PTHREAD) +# include +extern pthread_mutex_t mumps_io_pwrite_mutex; +# endif +/* extern int* mumps_io_pfile_pointer_array; */ +/* extern int* mumps_io_current_file; */ +/* #else /\*_WIN32*\/ */ +/* extern FILE** mumps_io_current_file; */ +/* extern FILE** mumps_io_pfile_pointer_array; */ +#endif /* MUMPS_WIN32 */ +/*extern mumps_file_struct* mumps_io_pfile_pointer_array; + extern mumps_file_struct* mumps_io_current_file;*/ +extern mumps_file_type* mumps_files; +/* extern int mumps_io_current_file_number; */ +extern char* mumps_ooc_file_prefix; +/* extern char** mumps_io_pfile_name; */ +/* extern int mumps_io_current_file_position; */ +/* extern int mumps_io_write_pos; */ +/* extern int mumps_io_last_file_opened; */ +extern int mumps_elementary_data_size; +extern int mumps_io_is_init_called; +extern int mumps_io_myid; +extern int mumps_io_max_file_size; +/* extern int mumps_io_nb_file; */ +extern int mumps_io_flag_async; +extern int mumps_io_k211; +/* extern int mumps_flag_open; */ +extern int directio_flag; +extern int mumps_directio_flag; +extern int mumps_io_nb_file_type; +/* Exported functions */ +int mumps_set_file(int type,int file_number_arg); +void mumps_update_current_file_position(mumps_file_struct* file_arg); +int mumps_compute_where_to_write(const double to_be_written,const int type,long long vaddr,size_t already_written); +int mumps_prepare_pointers_for_write(double to_be_written,int * pos_in_file, int * file_number,const int type,long long vaddr,size_t already_written); +int mumps_io_do_write_block(void * address_block,long long block_size,int * type,long long vaddr,int * ierr); +int mumps_io_do_read_block(void * address_block,long long block_size,int * type,long long vaddr,int * ierr); +int mumps_compute_nb_concerned_files(long long block_size,int * nb_concerned_files,long long vaddr); +MUMPS_INLINE int mumps_gen_file_info(long long vaddr, int * pos, int * file); +int mumps_free_file_pointers(int* step); +int mumps_init_file_structure(int *_myid, long long *total_size_io,int *size_element,int *nb_file_type,int *flag_tab); +int mumps_init_file_name(char* mumps_dir,char* mumps_file,int* mumps_dim_dir,int* mumps_dim_file,int* _myid); +void mumps_io_init_file_struct(int* nb,int which); +int mumps_io_alloc_file_struct(int* nb,int which); +int mumps_io_get_nb_files(int* nb_files, const int* type); +int mumps_io_get_file_name(int* indice,char* name,int* length,int* type); +int mumps_io_alloc_pointers(int * nb_file_type, int * dim); +int mumps_io_init_vars(int* myid_arg,int* size_element,int* async_arg); +int mumps_io_set_file_name(int* indice,char* name,int* length,int* type); +int mumps_io_open_files_for_read(); +int mumps_io_set_last_file(int* dim,int* type); +int mumps_io_write__(void *file, void *loc_add, size_t write_size, int where,int type); +#if ! defined (MUMPS_WIN32) +int mumps_io_write_os_buff__(void *file, void *loc_add, size_t write_size, int where); +int mumps_io_write_direct_io__(void *file, void *loc_addr, size_t write_size, int where,int type); +int mumps_io_flush_write__(int type); +#else +int mumps_io_write_win32__(void *file, void *loc_add, size_t write_size, int where); +#endif +int mumps_io_read__(void * file,void * loc_addr,size_t size,int local_offset,int type); +#if ! defined (MUMPS_WIN32) +int mumps_io_read_os_buff__(void * file,void * loc_addr,size_t size,int local_offset); +int mumps_io_read_direct_io__(void * file,void * loc_addr,size_t size,int local_offset,int type); +#else +int mumps_io_read_win32__(void * file,void * loc_addr,size_t size,int local_offset); +#endif +int mumps_compute_file_size(void *file,size_t *size); +#if ! defined (MUMPS_WIN32) && ! defined (WITHOUT_PTHREAD) +# ifdef WITH_PFUNC +int mumps_io_protect_pointers(); +int mumps_io_unprotect_pointers(); +int mumps_io_init_pointers_lock(); +int mumps_io_destroy_pointers_lock(); +# endif /* WITH_PFUNC */ +#endif /* MUMPS_WIN32 */ +#endif /* MUMPS_IO_BASIC_H */ diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io_err.c b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io_err.c new file mode 100644 index 000000000..c4f710f8a --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io_err.c @@ -0,0 +1,188 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +#include "mumps_io_err.h" +#include "mumps_io_basic.h" +#if defined( MUMPS_WIN32 ) +# include +#endif +/* Exported global variables */ +char* mumps_err; +MUMPS_INT* dim_mumps_err; +int mumps_err_max_len; +int err_flag; +#if ! ( defined(MUMPS_WIN32) || defined(WITHOUT_PTHREAD) ) +pthread_mutex_t err_mutex; +#endif /* ! ( MUMPS_WIN32 || WITHOUT_PTHREAD ) */ +/* Functions */ +/* Keeps a C pointer to store error description string that will be + displayed by the Fortran layers. + * dim contains the size of the Fortran character array to store the + description. +*/ +void MUMPS_CALL +MUMPS_LOW_LEVEL_INIT_ERR_STR(MUMPS_INT *dim, char* err_str, mumps_ftnlen l1){ + mumps_err = err_str; + dim_mumps_err = (MUMPS_INT *) dim; + mumps_err_max_len = (int) *dim; + err_flag = 0; + return; +} +#if ! defined(MUMPS_WIN32) && ! defined(WITHOUT_PTHREAD) +MUMPS_INLINE int +mumps_io_protect_err() +{ + if(mumps_io_flag_async==IO_ASYNC_TH){ + pthread_mutex_lock(&err_mutex); + } + return 0; +} +MUMPS_INLINE int +mumps_io_unprotect_err() +{ + if(mumps_io_flag_async==IO_ASYNC_TH){ + pthread_mutex_unlock(&err_mutex); + } + return 0; +} +int +mumps_io_init_err_lock() +{ + pthread_mutex_init(&err_mutex,NULL); + return 0; +} +int +mumps_io_destroy_err_lock() +{ + pthread_mutex_destroy(&err_mutex); + return 0; +} +int +mumps_check_error_th() +{ + /* If err_flag != 0, then error_str is set */ + return err_flag; +} +#endif /* MUMPS_WIN32 && WITHOUT_PTHREAD */ +int +mumps_io_error(int mumps_errno, const char* desc) +{ + int len; +#if ! defined( MUMPS_WIN32 ) && ! defined( WITHOUT_PTHREAD ) + mumps_io_protect_err(); +#endif + if(err_flag == 0){ + strncpy(mumps_err, desc, mumps_err_max_len); + /* mumps_err is a FORTRAN string, we do not care about adding a final 0 */ + len = (int) strlen(desc); + *dim_mumps_err = (len <= mumps_err_max_len ) ? len : mumps_err_max_len; + err_flag = mumps_errno; + } +#if ! defined( MUMPS_WIN32 ) && ! defined( WITHOUT_PTHREAD ) + mumps_io_unprotect_err(); +#endif + return mumps_errno; +} +int +mumps_io_sys_error(int mumps_errno, const char* desc) +{ + int len = 2; /* length of ": " */ + const char* _desc; + char* _err; +#if defined( MUMPS_WIN32 ) + int _err_len; +#endif +#if ! defined( MUMPS_WIN32 ) && ! defined( WITHOUT_PTHREAD ) + mumps_io_protect_err(); +#endif + if(err_flag==0){ + if(desc == NULL) { + _desc = ""; + } else { + len += (int) strlen(desc); + _desc = desc; + } +#if ! defined( MUMPS_WIN32 ) + _err = strerror(errno); + len += (int) strlen(_err); + snprintf(mumps_err, mumps_err_max_len, "%s: %s", _desc, _err); + /* mumps_err is a FORTRAN string, we do not care about adding a final 0 */ +#else + /* This a VERY UGLY workaround for snprintf: this function has been + * integrated quite lately into the ANSI stdio: some windows compilers are + * not up-to-date yet. */ + if( len >= mumps_err_max_len - 1 ) { /* then do not print sys error msg at all */ + len -= 2; + len = (len >= mumps_err_max_len ) ? mumps_err_max_len - 1 : len; + _err = strdup( _desc ); + _err[len] = '\0'; + sprintf(mumps_err, "%s", _err); + } else { + _err = strdup(strerror(errno)); + _err_len = (int) strlen(_err); + /* We will use sprintf, so make space for the final '\0' ! */ + if((len + _err_len) >= mumps_err_max_len) { + /* truncate _err, not to overtake mumps_err_max_len at the end. */ + _err[mumps_err_max_len - len - 1] = '\0'; + len = mumps_err_max_len - 1; + } else { + len += _err_len; + } + sprintf(mumps_err, "%s: %s", _desc, _err); + } + free(_err); +#endif + *dim_mumps_err = (len <= mumps_err_max_len ) ? len : mumps_err_max_len; + err_flag = mumps_errno; + } +#if ! defined( MUMPS_WIN32 ) && ! defined( WITHOUT_PTHREAD ) + mumps_io_unprotect_err(); +#endif + return mumps_errno; +} diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io_err.h b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io_err.h new file mode 100644 index 000000000..7e7bc3faa --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io_err.h @@ -0,0 +1,75 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +#include +#include "mumps_common.h" +#if ! ( defined(MUMPS_WIN32) || defined(WITHOUT_PTHREAD) ) +# include +#endif /* ! ( MUMPS_WIN32 || WITHOUT_PTHREAD ) */ +#if ! ( defined(MUMPS_WIN32) || defined(WITHOUT_PTHREAD) ) +extern pthread_mutex_t err_mutex; +#endif /* ! ( MUMPS_WIN32 || WITHOUT_PTHREAD ) */ +/* Exported functions */ +#define MUMPS_LOW_LEVEL_INIT_ERR_STR \ + F_SYMBOL(low_level_init_err_str,LOW_LEVEL_INIT_ERR_STR) +void MUMPS_CALL +MUMPS_LOW_LEVEL_INIT_ERR_STR( MUMPS_INT *dim, char *err_str, mumps_ftnlen l1 ); +/* Export an error to the Fortran layer + Returns mumps_errno for convenience */ +int mumps_io_error(int mumps_errno, const char* desc); +/* Export a system error to the Fortran layer (errno must be set) + Returns mumps_errno for convenience */ +int mumps_io_sys_error(int mumps_errno, const char* desc); +#if ! ( defined(MUMPS_WIN32) || defined(WITHOUT_PTHREAD) ) +int mumps_io_init_err_lock(); +int mumps_io_destroy_err_lock(); +int mumps_check_error_th(); +MUMPS_INLINE int mumps_io_protect_err(); +MUMPS_INLINE int mumps_io_unprotect_err(); +#endif /* ! ( MUMPS_WIN32 || WITHOUT_PTHREAD ) */ diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io_thread.c b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io_thread.c new file mode 100644 index 000000000..688952ef9 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_io_thread.c @@ -0,0 +1,600 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +#include "mumps_io_basic.h" +#include "mumps_io_err.h" +#include "mumps_io_thread.h" +#if ! defined(MUMPS_WIN32) && ! defined(WITHOUT_PTHREAD) +/* Exported global variables */ +int io_flag_stop,current_req_num; +pthread_t io_thread,main_thread; +pthread_mutex_t io_mutex; +pthread_cond_t cond_io,cond_nb_free_finished_requests,cond_nb_free_active_requests,cond_stop; +pthread_mutex_t io_mutex_cond; +int int_sem_io,int_sem_nb_free_finished_requests,int_sem_nb_free_active_requests,int_sem_stop; +int with_sem; +struct request_io *io_queue; +int first_active,last_active,nb_active; +int *finished_requests_inode,*finished_requests_id,first_finished_requests, + last_finished_requests,nb_finished_requests,smallest_request_id; +int mumps_owns_mutex; +int test_request_called_from_mumps; +/* Other global variables */ +double inactive_time_io_thread; +int time_flag_io_thread; +struct timeval origin_time_io_thread; +/** + * Main function of the io thread when semaphores are used. + */ +void* mumps_async_thread_function_with_sem (void* arg){ + struct request_io *current_io_request; + int ierr,_sem_stop; + struct timeval start_time,end_time; + int ret_code; + for (;;){ + gettimeofday(&start_time,NULL); + if(with_sem==2){ + mumps_wait_sem(&int_sem_io,&cond_io); + } + /* sem_wait(&sem_io); */ + gettimeofday(&end_time,NULL); + if(time_flag_io_thread){ + inactive_time_io_thread=inactive_time_io_thread+((double)end_time.tv_sec+((double)end_time.tv_usec/1000000))-((double)start_time.tv_sec+((double)start_time.tv_usec/1000000)); + }else{ + inactive_time_io_thread=((double)end_time.tv_sec+((double)end_time.tv_usec/1000000))-((double)origin_time_io_thread.tv_sec+((double)origin_time_io_thread.tv_usec/1000000)); + } + if(!time_flag_io_thread){ + time_flag_io_thread=1; + } + /* Check if the main thread ordered to stop this slave thread */ + /* sem_getvalue(&sem_stop,&_sem_stop); */ + if(with_sem==2){ + mumps_get_sem(&int_sem_stop,&_sem_stop); + } + if(_sem_stop==IO_FLAG_STOP){ + /* The thread must stop */ + break; /* Breaks the while loop. */ + } + current_io_request=&io_queue[first_active]; + switch(current_io_request->io_type) + { + case IO_WRITE: + ret_code=mumps_io_do_write_block(current_io_request->addr, + current_io_request->size, + &(current_io_request->file_type), + current_io_request->vaddr, + &ierr); + if(ret_code<0){ + goto end; + } + break; + case IO_READ: + ret_code=mumps_io_do_read_block(current_io_request->addr, + current_io_request->size, + &(current_io_request->file_type), + current_io_request->vaddr, + &ierr); + if(ret_code<0){ + goto end; + } + break; + default: + printf("Error : Mumps_IO : Operation %d is neither READ nor WRITE\n",current_io_request->io_type); + exit (-3); + } + /* Notify that the IO was performed */ + /* Wait that finished_requests queue could register + the notification */ + if(with_sem==2){ + mumps_wait_sem(&int_sem_nb_free_finished_requests,&cond_nb_free_finished_requests); + } + pthread_mutex_lock(&io_mutex); + /* Updates active queue bounds */ + /* Register the notification in finished_requests queue + and updates its bounds. */ + finished_requests_id[last_finished_requests]=current_io_request->req_num; + finished_requests_inode[last_finished_requests]=current_io_request->inode; + last_finished_requests=(last_finished_requests+1)%(MAX_FINISH_REQ); /* ??? */ + nb_finished_requests++; + /* Realeases the lock : ***UNLOCK*** */ + nb_active--; + if(first_activeint_local_cond),&(current_io_request->local_cond)); + } + pthread_mutex_unlock(&io_mutex); + /* Finally increases the number of free active requests.*/ + /* sem_post(&sem_nb_free_active_requests); */ + mumps_post_sem(&int_sem_nb_free_active_requests,&cond_nb_free_active_requests); + } + end: + /* The main thread ordered the end of the IO thread (it changed sem_stop). + We exit. */ + pthread_exit(NULL); +/* Not reached */ + return NULL; +} +int mumps_test_request_th(int* request_id,int *flag){ + /* Tests if the request "request_id" has finished. It sets the flag */ + /* argument to 1 if the request has finished (0 otherwise) */ + int request_pos; + int i; + i=mumps_check_error_th(); + if(i!=0){ + return i; + } + pthread_mutex_lock(&io_mutex); + /* printf("entering test !!! \n"); */ + if(*request_id < smallest_request_id){ + *flag=1; + /* exit (-2); */ + }else{ + if(nb_finished_requests==0){ + *flag=0; + }else{ + request_pos=(first_finished_requests+nb_finished_requests-1)%(MAX_IO*2); + if(*request_id > finished_requests_id[request_pos]){ + /*the request has not been treated yet since it is not in + the list of treated requests*/ + i=0; + /*this loop is only for checking (no special treatment is done*/ + while(i we just have to + increase smallest_request_id*/ + smallest_request_id++; + if(!mumps_owns_mutex) pthread_mutex_unlock(&io_mutex); + if(with_sem) { + if(with_sem==2){ + mumps_post_sem(&int_sem_nb_free_finished_requests,&cond_nb_free_finished_requests); + } + } + return 0; +} +int mumps_low_level_init_ooc_c_th(int* async, int* ierr){ + int i, ret_code; + char buf[64]; + /* Computes the number of files needed. Uses ceil value. */ + *ierr=0; + current_req_num=0; + with_sem=2; + first_active=0; + last_active=0; + nb_active=0; + first_finished_requests=0; + last_finished_requests=0; + nb_finished_requests=0; + smallest_request_id=0; + mumps_owns_mutex=0; + inactive_time_io_thread=0; + time_flag_io_thread=0; + gettimeofday(&origin_time_io_thread,NULL); + /* mumps_io_flag_async=*async; */ + if(*async!=IO_ASYNC_TH){ + *ierr = -91; + sprintf(buf,"Internal error: mumps_low_level_init_ooc_c_th should not to be called with strat_IO=%d\n",*async); + return mumps_io_error(*ierr,buf); + } + if(*async){ + pthread_mutex_init(&io_mutex,NULL); + mumps_io_init_err_lock(); +#ifdef WITH_PFUNC + mumps_io_init_pointers_lock(); +#endif + io_queue=(struct request_io *)malloc(MAX_IO*sizeof(struct request_io)); + if(with_sem==2){ + for(i=0;i +# include +# include +# include +# include +# define MAX_IO 20 +# define MAX_FINISH_REQ 40 +# define IO_FLAG_STOP 1 +# define IO_FLAG_RUN 0 +# define IO_READ 1 +# define IO_WRITE 0 +struct request_io{ + int inode; + int req_num; /*request number*/ + void* addr; /*memory address (either source or dest)*/ + long long size; /* size of the requested io (unit=size of elementary mumps data)*/ + long long vaddr; /* virtual address for file management */ + int io_type; /*read or write*/ + int file_type; /* cb or lu or ... */ + pthread_cond_t local_cond; + int int_local_cond; +}; +/* Exported global variables */ +extern int io_flag_stop,current_req_num; +extern pthread_t io_thread,main_thread; +extern pthread_mutex_t io_mutex; +extern pthread_cond_t cond_io,cond_nb_free_finished_requests,cond_nb_free_active_requests,cond_stop; +extern pthread_mutex_t io_mutex_cond; +extern int int_sem_io,int_sem_nb_free_finished_requests,int_sem_nb_free_active_requests,int_sem_stop; +extern int with_sem; +extern struct request_io *io_queue; +extern int first_active,last_active,nb_active; +extern int *finished_requests_inode,*finished_requests_id,first_finished_requests, + last_finished_requests,nb_finished_requests,smallest_request_id; +extern int mumps_owns_mutex; +extern int test_request_called_from_mumps; +/* Exported functions */ +void* mumps_async_thread_function_with_sem (void* arg); +int mumps_is_there_finished_request_th(int* flag); +int mumps_clean_request_th(int* request_id); +int mumps_wait_req_sem_th(int *request_id); +int mumps_test_request_th(int* request_id,int *flag); +int mumps_wait_request_th(int *request_id); +int mumps_low_level_init_ooc_c_th(int* async, int* ierr); +int mumps_async_write_th(const int * strat_IO,void * address_block,long long block_size, + int * inode,int * request_arg,int * type,long long vaddr,int * ierr); +int mumps_async_read_th(const int * strat_IO,void * address_block,long long block_size,int * inode,int * request_arg, + int * type,long long vaddr,int * ierr); +int mumps_clean_io_data_c_th(int *myid); +int mumps_get_sem(void *arg,int *value); +int mumps_wait_sem(void *arg,pthread_cond_t *cond); +int mumps_post_sem(void *arg,pthread_cond_t *cond); +int mumps_clean_finished_queue_th(); +#endif /*_WIN32 && WITHOUT_PTHREAD*/ +#endif /* MUMPS_IO_THREAD_H */ diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_ooc_common.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_ooc_common.F new file mode 100644 index 000000000..3eea77c77 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_ooc_common.F @@ -0,0 +1,167 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER, PARAMETER :: FCT = 0 + INTEGER, PARAMETER, PUBLIC :: TYPEF_INVALID = -999999 + INTEGER, PUBLIC :: TYPEF_L, TYPEF_U, TYPEF_CB + INTEGER OOC_NB_FILE_TYPE, OOC_FCT_TYPE + INTEGER, DIMENSION(:,:),POINTER :: OOC_INODE_SEQUENCE + INTEGER(8), DIMENSION(:,:),POINTER :: OOC_VADDR + INTEGER,DIMENSION(:),POINTER:: KEEP_OOC + INTEGER ICNTL1 + INTEGER(8), DIMENSION(:),ALLOCATABLE :: AddVirtLibre + LOGICAL,SAVE :: STRAT_IO_ASYNC,WITH_BUF,SOLVE + INTEGER, DIMENSION(:),POINTER :: STEP_OOC,PROCNODE_OOC + INTEGER, SAVE :: MYID_OOC,SLAVEF_OOC,LOW_LEVEL_STRAT_IO + INTEGER(8), SAVE :: HBUF_SIZE, DIM_BUF_IO + INTEGER ERR_STR_OOC_MAX_LEN + PARAMETER(ERR_STR_OOC_MAX_LEN = 512) + CHARACTER*1 ERR_STR_OOC(ERR_STR_OOC_MAX_LEN) + INTEGER DIM_ERR_STR_OOC + TYPE IO_BLOCK + INTEGER :: INODE + LOGICAL :: MASTER + INTEGER :: Typenode + INTEGER :: NROW, NCOL, NFS + LOGICAL :: Last + INTEGER :: LastPiv + INTEGER :: LastPanelWritten_L + INTEGER :: LastPanelWritten_U + INTEGER,POINTER,DIMENSION(:) :: INDICES + END TYPE + PUBLIC IO_BLOCK + INTEGER, PUBLIC :: STRAT_WRITE_MAX, STRAT_TRY_WRITE + PARAMETER (STRAT_WRITE_MAX=1, STRAT_TRY_WRITE=2) + END MODULE MUMPS_OOC_COMMON + SUBROUTINE MUMPS_676(INT1,INT2,BIGINT) + IMPLICIT NONE + INTEGER INT1,INT2 + INTEGER(8) BIGINT + INTEGER(8) TMP1,TMP2,CONV + PARAMETER (CONV=1073741824_8) + TMP1=int(INT1,kind=kind(TMP1)) + TMP2=int(INT2,kind=kind(TMP2)) + BIGINT=(TMP1*CONV)+TMP2 + RETURN + END SUBROUTINE MUMPS_676 + SUBROUTINE MUMPS_677(INT1,INT2,BIGINT) + IMPLICIT NONE + INTEGER INT1,INT2 + INTEGER(8) BIGINT + INTEGER(8) TMP1,TMP2,CONV + PARAMETER (CONV=1073741824_8) + TMP1=BIGINT/CONV + TMP2=mod(BIGINT,CONV) + INT1=int(TMP1) + INT2=int(TMP2) + RETURN + END SUBROUTINE MUMPS_677 + SUBROUTINE MUMPS_796 + & (TYPEF_L,TYPEF_U,TYPEF_CB,K201, K251, K50, + & TYPEF_INVALID) + IMPLICIT NONE + INTEGER, intent(out):: TYPEF_L, TYPEF_U, TYPEF_CB + INTEGER, intent(in) :: K201, K251, K50 + INTEGER, intent(in) :: TYPEF_INVALID + IF (K201 .EQ. 1 .AND. K50.EQ.0) THEN + IF ( K251.NE.2 ) THEN + TYPEF_L = 1 + TYPEF_U = 2 + TYPEF_CB = 3 + ELSE + TYPEF_U = 1 + TYPEF_L = TYPEF_INVALID + TYPEF_CB = 2 + ENDIF + ELSE + TYPEF_L = 1 + TYPEF_U = TYPEF_INVALID + TYPEF_CB=2 + ENDIF + RETURN + END SUBROUTINE MUMPS_796 + INTEGER FUNCTION MUMPS_808 + & (FWDORBWD, MTYPE, K201, K50) + USE MUMPS_OOC_COMMON + INTEGER, intent(in) :: MTYPE, K201, K50 + CHARACTER*1, intent(in) :: FWDORBWD + IF ( (TYPEF_L .NE. 1 .AND. TYPEF_L .NE. TYPEF_INVALID) + & .OR. (TYPEF_U .NE. 1 .AND. TYPEF_U .NE. 2 .AND. + & TYPEF_U .NE. TYPEF_INVALID) ) THEN + WRITE(*,*) "Internal error 1 in MUMPS_808", + & TYPEF_L, TYPEF_U + CALL MUMPS_ABORT() + ENDIF + IF (FWDORBWD .NE. 'F' .AND. FWDORBWD .NE. 'B') THEN + WRITE(*,*) "Internal error in MUMPS_808,",FWDORBWD + CALL MUMPS_ABORT() + ENDIF + IF (K201 .EQ. 1) THEN + IF (FWDORBWD .EQ. 'F') THEN + IF((MTYPE.NE.1).AND.(K50.EQ.0))THEN + MUMPS_808=TYPEF_U + ELSE + MUMPS_808=TYPEF_L + ENDIF + ELSE + IF(K50.EQ.0)THEN + IF(MTYPE.NE.1)THEN + MUMPS_808=TYPEF_L + ELSE + MUMPS_808=TYPEF_U + ENDIF + ELSE + MUMPS_808=TYPEF_L + ENDIF + ENDIF + ELSE + MUMPS_808 = 1 + ENDIF + RETURN + END FUNCTION MUMPS_808 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_orderings.c b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_orderings.c new file mode 100644 index 000000000..77c9c9bcf --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_orderings.c @@ -0,0 +1,382 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +/* + * This file contains interfaces to external ordering packages. + * At the moment, PORD (J. Schulze) and SCOTCH are interfaced. + */ +#include "mumps_orderings.h" +#if defined(pord) +/* Interface to PORD */ +/*int mumps_pord( int, int, int *, int *, int * ); +#define MUMPS_PORDF \ +F_SYMBOL(pordf,PORDF)*/ +void MUMPS_CALL +MUMPS_PORDF( int *nvtx, int *nedges, + int *xadj, int *adjncy, + int *nv, int *ncmpa ) +{ + *ncmpa = mumps_pord( *nvtx, *nedges, xadj, adjncy, nv ); +} +/* Interface to PORD with weighted graph*/ +/*int mumps_pord_wnd( int, int, int *, int *, int *, int * ); +#define MUMPS_PORDF_WND \ + F_SYMBOL(pordf_wnd,PORDF_WND)*/ +void MUMPS_CALL +MUMPS_PORDF_WND( int *nvtx, int *nedges, + int *xadj, int *adjncy, + int *nv, int *ncmpa, int *totw ) +{ + *ncmpa = mumps_pord_wnd( *nvtx, *nedges, xadj, adjncy, nv, totw ); +} +/************************************************************ + mumps_pord is used in ana_aux.F + permutation and inverse permutation not set in output, + but may be printed in default file: "perm_pord" and "iperm_pord", + if associated part uncommneted. + But, if uncommetnted a bug occurs in psl_ma41_analysi.F +******************************************************************/ +/*********************************************************/ +int mumps_pord +( + int nvtx, + int nedges, + int *xadj_pe, + int *adjncy, + int *nv +) +{ +/********************************** +Argument Comments: +input: +----- +- nvtx : dimension of the Problem (N) +- nedges : number of entries (NZ) +- adjncy : non-zeros entries (IW input) +input/output: +------------- +- xadj_pe : pointer through beginning of column non-zeros entries (PTRAR) +- on exit, "father array" (PE) +ouput: +------ +- nv : "nfront array" (NV) +*************************************/ + graph_t *G; + elimtree_t *T; + timings_t cpus[12]; + options_t options[] = { SPACE_ORDTYPE, SPACE_NODE_SELECTION1, + SPACE_NODE_SELECTION2, SPACE_NODE_SELECTION3, + SPACE_DOMAIN_SIZE, 0 }; + int *ncolfactor, *ncolupdate, *parent, *vtx2front; + int *first, *link, nfronts, J, K, u, vertex, vertex_root, count; + /************************************************** + declaration to uncomment if printing ordering + *************************************************** + FILE *fp1, *fp2; + int *perm, *iperm; + */ +/*** decalage des indices couteux dans un premier temps: +**** A modifier dans une version ulterieure de MA41GD */ + for (u = nvtx; u >= 0; u--) + { + xadj_pe[u] = xadj_pe[u] - 1; + } + for (K = nedges-1; K >= 0; K--) + { + adjncy[K] = adjncy[K] - 1; + } + /* initialization of the graph */ + mymalloc(G, 1, graph_t); + G->xadj = xadj_pe; + G->adjncy = adjncy; + mymalloc(G->vwght, nvtx, int); + G->nvtx = nvtx; + G->nedges = nedges; + G->type = UNWEIGHTED; + G->totvwght = nvtx; + for (u = 0; u < nvtx; u++) + G->vwght[u] = 1; + /* main function of the Ordering */ + T = SPACE_ordering(G, options, cpus); + nfronts = T->nfronts; + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + parent = T->parent; + /* firstchild = T->firstchild; */ + vtx2front = T->vtx2front; + /* ----------------------------------------------------------- + store the vertices/columns of a front in a bucket structure + ----------------------------------------------------------- */ + mymalloc(first, nfronts, int); + mymalloc(link, nvtx, int); + for (J = 0; J < nfronts; J++) + first[J] = -1; + for (u = nvtx-1; u >= 0; u--) + { + J = vtx2front[u]; + link[u] = first[J]; + first[J] = u; + } + /* ----------------------------------------------------------- + fill the two arrays corresponding to the MUMPS tree structure + ----------------------------------------------------------- */ + count = 0; + for (K = firstPostorder(T); K != -1; K = nextPostorder(T, K)) + { + vertex_root = first[K]; + if (vertex_root == -1) + { + /* JY: I think this cannot happen */ + printf(" Internal error in mumps_pord (cf JY), %d\n",K); + exit(-1); + } + /* for the principal column of the supervariable */ + if (parent[K] == -1) + xadj_pe[vertex_root] = 0; /* root of the tree */ + else + xadj_pe[vertex_root] = - (first[parent[K]]+1); + nv[vertex_root] = ncolfactor[K] + ncolupdate[K]; + count++; + for (vertex = link[vertex_root]; vertex != -1; vertex = link[vertex]) + /* for the secondary columns of the supervariable */ + { + xadj_pe[vertex] = - (vertex_root+1); + nv[vertex] = 0; + count++; + } + } + /* ---------------------- + free memory and return + ---------------------- */ + free(first); free(link); + free(G->vwght); + free(G); + freeElimTree(T); + return (0); +} +/*********************************************************/ +int mumps_pord_wnd +( + int nvtx, + int nedges, + int *xadj_pe, + int *adjncy, + int *nv, + int *totw +) +{ +/********************************** +Argument Comments: +input: +----- +- nvtx : dimension of the Problem (N) +- nedges : number of entries (NZ) +- adjncy : non-zeros entries (IW input) +- totw : sum of the weigth of the vertices +input/output: +------------- +- xadj_pe : pointer through beginning of column non-zeros entries (PTRAR) +- on exit, "father array" (PE) +ouput: +------ +- nv : weight of the vertices +- on exit "nfront array" (NV) +*************************************/ + graph_t *G; + elimtree_t *T; + timings_t cpus[12]; + options_t options[] = { SPACE_ORDTYPE, SPACE_NODE_SELECTION1, + SPACE_NODE_SELECTION2, SPACE_NODE_SELECTION3, + SPACE_DOMAIN_SIZE, 0 }; + int *ncolfactor, *ncolupdate, *parent, *vtx2front; + int *first, *link, nfronts, J, K, u, vertex, vertex_root, count; + /************************************************** + declaration to uncomment if printing ordering + *************************************************** + FILE *fp1, *fp2; + int *perm, *iperm; + */ +/*** decalage des indices couteux dans un premier temps: +**** A modifier dans une version ulterieure de MA41GD */ + for (u = nvtx; u >= 0; u--) + { + xadj_pe[u] = xadj_pe[u] - 1; + } + for (K = nedges-1; K >= 0; K--) + { + adjncy[K] = adjncy[K] - 1; + } + /* initialization of the graph */ + mymalloc(G, 1, graph_t); + G->xadj = xadj_pe; + G->adjncy= adjncy; + mymalloc(G->vwght, nvtx, int); + G->nvtx = nvtx; + G->nedges = nedges; + G->type = WEIGHTED; + G->totvwght = (*totw); + for (u = 0; u < nvtx; u++) + G->vwght[u] = nv[u]; + /* main function of the Ordering */ + T = SPACE_ordering(G, options, cpus); + nfronts = T->nfronts; + ncolfactor = T->ncolfactor; + ncolupdate = T->ncolupdate; + parent = T->parent; + /* firstchild = T->firstchild; */ + vtx2front = T->vtx2front; + /* ----------------------------------------------------------- + store the vertices/columns of a front in a bucket structure + ----------------------------------------------------------- */ + mymalloc(first, nfronts, int); + mymalloc(link, nvtx, int); + for (J = 0; J < nfronts; J++) + first[J] = -1; + for (u = nvtx-1; u >= 0; u--) + { + J = vtx2front[u]; + link[u] = first[J]; + first[J] = u; + } + /* ----------------------------------------------------------- + fill the two arrays corresponding to the MUMPS tree structure + ----------------------------------------------------------- */ + count = 0; + for (K = firstPostorder(T); K != -1; K = nextPostorder(T, K)) + { + vertex_root = first[K]; + if (vertex_root == -1) + { + /* JY: I think this cannot happen */ + printf(" Internal error in mumps_pord (cf JY), %d\n",K); + exit(-1); + } + /* for the principal column of the supervariable */ + if (parent[K] == -1) + xadj_pe[vertex_root] = 0; /* root of the tree */ + else + xadj_pe[vertex_root] = - (first[parent[K]]+1); + nv[vertex_root] = ncolfactor[K] + ncolupdate[K]; + count++; + for (vertex = link[vertex_root]; vertex != -1; vertex = link[vertex]) + /* for the secondary columns of the supervariable */ + { + xadj_pe[vertex] = - (vertex_root+1); + nv[vertex] = 0; + count++; + } + } + /* ---------------------- + free memory and return + ---------------------- */ + free(first); free(link); + free(G->vwght); + free(G); + freeElimTree(T); + return (0); +} +#endif /* pord */ +/************************************************************/ +#if defined(scotch) || defined(ptscotch) +/*int esmumps( const int n, const int iwlen, int * const pe, const int pfree, + int * const len, int * const iw, int * const nv, int * const elen, + int * const last);*/ +/* Fortran interface to SCOTCH */ +/*#define MUMPS_SCOTCH \ + F_SYMBOL(scotch,SCOTCH)*/ +void MUMPS_CALL +MUMPS_SCOTCH( const int * const n, + const int * const iwlen, + int * const petab, + const int * const pfree, + int * const lentab, + int * const iwtab, + int * const nvtab, + int * const elentab, + int * const lasttab, + int * const ncmpa ) +{ + *ncmpa = esmumps( *n, *iwlen, petab, *pfree, + lentab, iwtab, nvtab, elentab, lasttab ); +} +#endif /* scotch */ +#if defined(ptscotch) +/* +#ifdef MPI +#include "mpi.h" +#else +#include "mumps_mpi.h" +#endif +#include +#include "ptscotch.h" +int mumps_dgraphinit( SCOTCH_Dgraph *, MPI_Fint *, MPI_Fint *); +#define MUMPS_DGRAPHINIT \ +F_SYMBOL(dgraphinit,DGRAPHINIT)*/ +void MUMPS_CALL +MUMPS_DGRAPHINIT(SCOTCH_Dgraph *graphptr, MPI_Fint *comm, MPI_Fint *ierr) +{ + MPI_Comm int_comm; + int_comm = MPI_Comm_f2c(*comm); + *ierr = SCOTCH_dgraphInit(graphptr, int_comm); + return; +} +#endif +#if defined(parmetis) +void MUMPS_CALL +MUMPS_PARMETIS(int *first, int *vertloctab, + int *edgeloctab, int *numflag, + int *options, int *order, + int *sizes, int *comm) +{ + MPI_Comm int_comm; + int_comm = MPI_Comm_f2c(*comm); + ParMETIS_V3_NodeND(first, vertloctab, edgeloctab, numflag, options, order, sizes, &int_comm); + return; +} +#endif diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_orderings.h b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_orderings.h new file mode 100644 index 000000000..4f5d6b73f --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_orderings.h @@ -0,0 +1,121 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +#ifndef MUMPS_ORDERINGS_H +#define MUMPS_ORDERINGS_H +#include "mumps_common.h" +#if defined(pord) +#include +int mumps_pord( int, int, int *, int *, int * ); +#define MUMPS_PORDF \ + F_SYMBOL(pordf,PORDF) +void MUMPS_CALL +MUMPS_PORDF( int *nvtx, int *nedges, + int *xadj, int *adjncy, + int *nv, int *ncmpa ); +int mumps_pord_wnd( int, int, int *, int *, int *, int * ); +#define MUMPS_PORDF_WND \ + F_SYMBOL(pordf_wnd,PORDF_WND) +void MUMPS_CALL +MUMPS_PORDF_WND( int *nvtx, int *nedges, + int *xadj, int *adjncy, + int *nv, int *ncmpa, int *totw ); +#endif /*PORD*/ +#if defined(scotch) || defined(ptscotch) +int esmumps( const int n, const int iwlen, int * const pe, const int pfree, + int * const len, int * const iw, int * const nv, int * const elen, + int * const last); +#define MUMPS_SCOTCH \ + F_SYMBOL(scotch,SCOTCH) +void MUMPS_CALL +MUMPS_SCOTCH( const int * const n, + const int * const iwlen, + int * const petab, + const int * const pfree, + int * const lentab, + int * const iwtab, + int * const nvtab, + int * const elentab, + int * const lasttab, + int * const ncmpa ); +#endif /*scotch or ptscotch*/ +#if defined(ptscotch) +#ifdef MPI +#include "mpi.h" +#else +#include "mumps_mpi.h" +#endif +#include +#include "ptscotch.h" +int mumps_dgraphinit( SCOTCH_Dgraph *, MPI_Fint *, MPI_Fint *); +#define MUMPS_DGRAPHINIT \ + F_SYMBOL(dgraphinit,DGRAPHINIT) +void MUMPS_CALL +MUMPS_DGRAPHINIT(SCOTCH_Dgraph *graphptr, MPI_Fint *comm, MPI_Fint *ierr); +#endif /*ptscotch*/ +#if defined(parmetis) +#ifdef MPI +#include "mpi.h" +#else +#include "mumps_mpi.h" +#endif +#include "parmetis.h" +void mumps_parmetis(int *first, int *vertloctab, + int *edgeloctab, int *numflag, + int *options, int *order, + int *sizes, int *comm); +#define MUMPS_PARMETIS \ + F_SYMBOL(parmetis,PARMETIS) +void MUMPS_CALL +MUMPS_PARMETIS(int *first, int *vertloctab, + int *edgeloctab, int *numflag, + int *options, int *order, + int *sizes, int *comm); +#endif /*PARMETIS*/ +#endif /* MUMPS_ORDERINGS_H */ diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_part9.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_part9.F new file mode 100644 index 000000000..9d67bf6fd --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_part9.F @@ -0,0 +1,8652 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C +C $Id$ + SUBROUTINE MUMPS_419 (METRIC, JOB, COMPRESS, N, NBBUCK, + & IWLEN, PE, PFREE, LEN, IW, NV, ELEN, + & LAST, NCMPA, DEGREE, + & WF, + & NEXT, W, HEAD, AGG4, + & SIZE_COMPLEM_LIST, + & COMPLEM_LIST) + IMPLICIT NONE + INTEGER, intent(in) :: METRIC, JOB, N, NBBUCK + LOGICAL, intent(in) :: COMPRESS + INTEGER IWLEN, PFREE, LEN(N), + & ELEN(N), LAST(N), NCMPA, DEGREE(N), NEXT(N), + & W(N) + INTEGER PE(N), IW(IWLEN), NV(N) + LOGICAL, intent(in) :: AGG4 + INTEGER, intent(in) :: SIZE_COMPLEM_LIST + INTEGER, intent(in), optional :: + & COMPLEM_LIST(max(1,SIZE_COMPLEM_LIST)) + INTEGER HEAD(0:NBBUCK+1), WF(N) + INTEGER AMD, AMF1, AMF4MA41 + PARAMETER (AMD=1, AMF1=2, AMF4MA41=4) + INTEGER DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I, + & ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3, + & LENJ, LN, MAXMEM, ME, MEM, MINDEG, NEL, NEWMEM, + & NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X, + & LASTD, NELME, N2, PAS + INTEGER MAXINT_N + INTEGER WF3, WF4 + INTEGER(8) HASH, HMOD + DOUBLE PRECISION RMF, RMF1 + DOUBLE PRECISION dummy + INTEGER idummy + LOGICAL SchurON + LOGICAL NOTDEFINEDAMD + INTEGER P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, PN, PSRC + INTRINSIC max, min, mod, huge + INTEGER TOTEL + NOTDEFINEDAMD = (METRIC.NE.AMD) + IF (N.EQ.1) THEN + ELEN(1) = 1 + LAST(1) = 1 + PE(1) = 0 + NV(1) = 1 + RETURN + ENDIF + IF (.NOT.present(COMPLEM_LIST)) SchurON=.FALSE. + IF ( SIZE_COMPLEM_LIST < 0 .OR. SIZE_COMPLEM_LIST > N ) THEN + WRITE(*,*) 'Internal MUMPS_419 ', SIZE_COMPLEM_LIST,N + CALL MUMPS_ABORT() + ENDIF + IF (JOB.EQ.2) THEN + SchurON = .FALSE. + ENDIF + IF (JOB.NE.2) THEN + SchurON = (SIZE_COMPLEM_LIST > 0) + IF ((JOB.EQ.1) .AND. (.NOT.SchurON) ) THEN + WRITE(6,*) ' WARNING MUMPS_419 on Options ', JOB + ENDIF + ENDIF + idummy = huge(idummy) - 1 + dummy = dble(idummy) + N2 = -NBBUCK-1 + PAS = max((N/8), 1) + WFLG = 2 + MAXINT_N = huge(MAXINT_N) - N + NCMPA = 0 + NEL = 0 + HMOD = int(max (1, NBBUCK-1),kind=8) + DMAX = 0 + MEM = PFREE - 1 + MAXMEM = MEM + MINDEG = 0 + LASTD = 0 + HEAD(0:NBBUCK+1) = 0 + DEGREE(1:N) = LEN(1:N) + LAST = 0 + W(1:N) = 1 + TOTEL = N + IF (.NOT.COMPRESS) THEN + NV = 1 + ENDIF + IF (JOB.EQ.2) THEN + DO I = 1,SIZE_COMPLEM_LIST + X = COMPLEM_LIST(I) + ELEN(X) = -I + NV(X) = LEN(X)+1 + ENDDO + NEL = NEL + SIZE_COMPLEM_LIST + ELSE + ELEN(1:N) = 0 + DO K=1, SIZE_COMPLEM_LIST + I = COMPLEM_LIST(K) + DEGREE(I) = N2 + IF ((LEN(I) .EQ.0).OR.(LEN(I).EQ.-N-1)) THEN + PE (I) = 0 + LEN(I) = 0 + ENDIF + DEG = NBBUCK + 1 + IF (LASTD.EQ.0) THEN + LASTD = I + HEAD(DEG) = I + NEXT(I) = 0 + LAST(I) = 0 + ELSE + NEXT(LASTD) = I + LAST(I) = LASTD + LASTD = I + NEXT(I) = 0 + ENDIF + ENDDO + ENDIF + IF(COMPRESS) THEN + TOTEL = 0 + DO I=1,N + IF (ELEN(I).LT.0) CYCLE + IF (DEGREE(I).NE.N2) THEN + TOTEL = TOTEL + NV(I) + DEGREE(I) = ELEN(I) + DO J= PE(I)+ELEN(I), PE(I)+LEN(I)-1 + DEGREE(I) = DEGREE(I) + NV(IW(J)) + ENDDO + ENDIF + ENDDO + ENDIF + RMF = dble(0) + DO I = 1, N + IF (ELEN(I).LT.0) CYCLE + DEG = DEGREE (I) + IF (DEG.EQ.N2) CYCLE + IF (DEG .GT. 0) THEN + IF (JOB.EQ.2) THEN + DEG = DEG - ELEN(I) + NVI = NV(I) + RMF = dble(0) + IF (ELEN(I).GT.0) THEN + DO J= PE(I), PE(I)+ELEN(I)-1 + DEG = DEG + LEN(IW(J)) - NVI + IF (NOTDEFINEDAMD) THEN + RMF1 = dble( LEN(IW(J))) + RMF1 = (RMF1-dble(NVI))*(RMF1-dble(NVI)-1.0D0) + RMF = max(RMF, RMF1) + ENDIF + ENDDO + DEG = min(DEG, TOTEL-NEL-NV(I)) + ENDIF + ENDIF + IF ( + & ( (JOB.EQ.2).AND.NOTDEFINEDAMD) + & .OR. (METRIC.EQ.AMF4MA41) + & ) THEN + DEG = nint ( + & ( (dble(DEG)*dble(DEG-1)) - RMF ) / dble(2) ) + DEG = max (DEG,1) + ENDIF + IF (NOTDEFINEDAMD) THEN + WF(I) = DEG + IF (DEG.GT.N) THEN + DEG = min(((DEG-N)/PAS) + N , NBBUCK) + ENDIF + ELSE + DEGREE(I) = DEG + ENDIF + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + ELSE + NEL = NEL + NV(I) + ELEN (I) = -NEL + PE (I) = 0 + W (I) = 0 + ENDIF + ENDDO + NLEFT = TOTEL-NEL + 30 IF ( ((NEL .LT. TOTEL).AND. (JOB.NE.1)) .OR. + & ((JOB.EQ.1).AND.(NEL.LT.TOTEL-SIZE_COMPLEM_LIST)) + & ) THEN + DO 40 DEG = MINDEG, NBBUCK + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 50 + 40 CONTINUE + 50 MINDEG = DEG + IF (ME.LE.0) THEN + NCMPA = -N + CALL MUMPS_ABORT() + ENDIF + IF (DEG.GT.N) THEN + IF (NOTDEFINEDAMD) THEN + J = NEXT(ME) + K = WF(ME) + 55 CONTINUE + IF (J.GT.0) THEN + IF (WF(J).LT.K) THEN + ME = J + K = WF(ME) + ENDIF + J= NEXT(J) + GOTO 55 + ENDIF + ILAST = LAST(ME) + INEXT = NEXT(ME) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (DEG) = INEXT + ENDIF + ELSE + WRITE(6,*) ' Internal error AMD, DEG>N ' + CALL MUMPS_ABORT() + ENDIF + ELSE + INEXT = NEXT (ME) + IF (INEXT .NE. 0) LAST (INEXT) = 0 + HEAD (DEG) = INEXT + ENDIF + ELENME = ELEN (ME) + ELEN (ME) = - (NEL + 1) + NVPIV = NV (ME) + NEL = NEL + NVPIV + NV (ME) = -NVPIV + DEGME = 0 + IF (ELENME .EQ. 0) THEN + PME1 = PE (ME) + PME2 = PME1 - 1 + DO 60 P = PME1, PME1 + LEN (ME) - 1 + I = IW (P) + NVI = NV (I) + IF (NVI .GT. 0) THEN + DEGME = DEGME + NVI + NV (I) = -NVI + PME2 = PME2 + 1 + IW (PME2) = I + IF (DEGREE(I).NE.N2) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + IF (NOTDEFINEDAMD) THEN + IF (WF(I).GT.N) THEN + DEG = min(((WF(I)-N)/PAS) + N , NBBUCK) + ELSE + DEG = WF(I) + ENDIF + HEAD (DEG) = INEXT + ELSE + HEAD (DEGREE (I)) = INEXT + ENDIF + ENDIF + ENDIF + ENDIF + 60 CONTINUE + NEWMEM = 0 + ELSE + P = PE (ME) + PME1 = PFREE + SLENME = LEN (ME) - ELENME + DO 120 KNT1 = 1, ELENME + 1 + IF (KNT1 .GT. ELENME) THEN + E = ME + PJ = P + LN = SLENME + ELSE + E = IW (P) + P = P + 1 + PJ = PE (E) + LN = LEN (E) + ENDIF + DO 110 KNT2 = 1, LN + I = IW (PJ) + PJ = PJ + 1 + NVI = NV (I) + IF (NVI .GT. 0) THEN + IF (PFREE .GT. IWLEN) THEN + PE (ME) = P + LEN (ME) = LEN (ME) - KNT1 + IF (LEN (ME) .EQ. 0) PE (ME) = 0 + PE (E) = PJ + LEN (E) = LN - KNT2 + IF (LEN (E) .EQ. 0) PE (E) = 0 + NCMPA = NCMPA + 1 + DO 70 J = 1, N + PN = PE (J) + IF (PN .GT. 0) THEN + PE (J) = IW (PN) + IW (PN) = -J + ENDIF + 70 CONTINUE + PDST = 1 + PSRC = 1 + PEND = PME1 - 1 + 80 CONTINUE + IF (PSRC .LE. PEND) THEN + J = -IW (PSRC) + PSRC = PSRC + 1 + IF (J .GT. 0) THEN + IW (PDST) = PE (J) + PE (J) = PDST + PDST = PDST + 1 + LENJ = LEN (J) + DO 90 KNT3 = 0, LENJ - 2 + IW (PDST + KNT3) = IW (PSRC + KNT3) + 90 CONTINUE + PDST = PDST + LENJ - 1 + PSRC = PSRC + LENJ - 1 + ENDIF + GO TO 80 + ENDIF + P1 = PDST + DO 100 PSRC = PME1, PFREE - 1 + IW (PDST) = IW (PSRC) + PDST = PDST + 1 + 100 CONTINUE + PME1 = P1 + PFREE = PDST + PJ = PE (E) + P = PE (ME) + ENDIF + DEGME = DEGME + NVI + NV (I) = -NVI + IW (PFREE) = I + PFREE = PFREE + 1 + IF (DEGREE(I).NE.N2) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + IF (NOTDEFINEDAMD) THEN + IF (WF(I).GT.N) THEN + DEG = min(((WF(I)-N)/PAS) + N , NBBUCK) + ELSE + DEG = WF(I) + ENDIF + HEAD (DEG) = INEXT + ELSE + HEAD(DEGREE(I)) = INEXT + ENDIF + ENDIF + ENDIF + ENDIF + 110 CONTINUE + IF (E .NE. ME) THEN + PE (E) = -ME + W (E) = 0 + ENDIF + 120 CONTINUE + PME2 = PFREE - 1 + NEWMEM = PFREE - PME1 + MEM = MEM + NEWMEM + MAXMEM = max(MAXMEM, MEM) + ENDIF + DEGREE (ME) = DEGME + PE (ME) = PME1 + LEN (ME) = PME2 - PME1 + 1 + IF (WFLG .GT. MAXINT_N) THEN + DO 130 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 130 CONTINUE + WFLG = 2 + ENDIF + DO 150 PME = PME1, PME2 + I = IW (PME) + IF (DEGREE(I).EQ.N2) GOTO 150 + ELN = ELEN (I) + IF (ELN .GT. 0) THEN + NVI = -NV (I) + WNVI = WFLG - NVI + DO 140 P = PE (I), PE (I) + ELN - 1 + E = IW (P) + WE = W (E) + IF (WE .GE. WFLG) THEN + WE = WE - NVI + ELSE IF (WE .NE. 0) THEN + WE = DEGREE (E) + WNVI + IF (NOTDEFINEDAMD) WF(E) = 0 + ENDIF + W (E) = WE + 140 CONTINUE + ENDIF + 150 CONTINUE + DO 180 PME = PME1, PME2 + I = IW (PME) + IF (DEGREE(I).EQ.N2) GOTO 180 + P1 = PE (I) + P2 = P1 + ELEN (I) - 1 + PN = P1 + HASH = 0_8 + DEG = 0 + IF (NOTDEFINEDAMD) THEN + WF3 = 0 + WF4 = 0 + ENDIF + NVI = -NV(I) + DO 160 P = P1, P2 + E = IW (P) + DEXT = W (E) - WFLG + IF (DEXT .GT. 0) THEN + IF (NOTDEFINEDAMD) THEN + IF ( WF(E) .EQ. 0 ) THEN + WF(E) = DEXT * ( (2 * DEGREE(E)) - DEXT - 1) + ENDIF + WF4 = WF4 + WF(E) + ENDIF + DEG = DEG + DEXT + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E, kind=8) + ELSE IF (DEXT .EQ. 0) THEN + IF (.NOT.AGG4) THEN + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) + ELSE + PE (E) = -ME + W (E) = 0 + ENDIF + ENDIF + 160 CONTINUE + ELEN (I) = PN - P1 + 1 + P3 = PN + DO 170 P = P2 + 1, P1 + LEN (I) - 1 + J = IW (P) + NVJ = NV (J) + IF (NVJ .GT. 0) THEN + DEG = DEG + NVJ + IF (NOTDEFINEDAMD) WF3 = WF3 + NVJ + IW (PN) = J + PN = PN + 1 + HASH = HASH + int(J,kind=8) + ENDIF + 170 CONTINUE + IF (DEGREE(I).EQ.N2) DEG = N2 + IF ( (AGG4.AND.(DEG .EQ. 0)).OR. + & (ELEN(I).EQ.1 .AND. P3.EQ.PN) ) THEN + PE (I) = -ME + NVI = -NV (I) + DEGME = DEGME - NVI + NVPIV = NVPIV + NVI + NEL = NEL + NVI + NV (I) = 0 + ELEN (I) = 0 + ELSE + IF ( DEGREE (I).LT.DEG ) THEN + IF (NOTDEFINEDAMD) THEN + WF4 = 0 + WF3 = 0 + ENDIF + ELSE + DEGREE(I) = DEG + ENDIF + IF (NOTDEFINEDAMD) THEN + WF(I) = WF4 + 2*NVI*WF3 + ENDIF + IW (PN) = IW (P3) + IW (P3) = IW (P1) + IW (P1) = ME + LEN (I) = PN - P1 + 1 + HASH = mod (HASH, HMOD) + 1_8 + J = HEAD (HASH) + IF (J .LE. 0) THEN + NEXT (I) = -J + HEAD (HASH) = -I + ELSE + NEXT (I) = LAST (J) + LAST (J) = I + ENDIF + LAST (I) = int(HASH,kind=kind(LAST)) + ENDIF + 180 CONTINUE + DEGREE (ME) = DEGME + DMAX = max (DMAX, DEGME) + WFLG = WFLG + DMAX + IF (WFLG .GT. MAXINT_N) THEN + DO 190 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 190 CONTINUE + WFLG = 2 + ENDIF + DO 250 PME = PME1, PME2 + I = IW (PME) + IF ( (NV (I) .LT. 0) .AND. (DEGREE(I).NE.N2) ) THEN + HASH = int(LAST (I),kind=8) + J = HEAD (HASH) + IF (J .EQ. 0) GO TO 250 + IF (J .LT. 0) THEN + I = -J + HEAD (HASH) = 0 + ELSE + I = LAST (J) + LAST (J) = 0 + ENDIF + IF (I .EQ. 0) GO TO 250 + 200 CONTINUE + IF (NEXT (I) .NE. 0) THEN + LN = LEN (I) + ELN = ELEN (I) + DO 210 P = PE (I) + 1, PE (I) + LN - 1 + W (IW (P)) = WFLG + 210 CONTINUE + JLAST = I + J = NEXT (I) + 220 CONTINUE + IF (J .NE. 0) THEN + IF (LEN (J) .NE. LN) GO TO 240 + IF (ELEN (J) .NE. ELN) GO TO 240 + DO 230 P = PE (J) + 1, PE (J) + LN - 1 + IF (W (IW (P)) .NE. WFLG) GO TO 240 + 230 CONTINUE + PE (J) = -I + IF (NOTDEFINEDAMD) WF(I) = max(WF(I),WF(J)) + NV (I) = NV (I) + NV (J) + NV (J) = 0 + ELEN (J) = 0 + J = NEXT (J) + NEXT (JLAST) = J + GO TO 220 + 240 CONTINUE + JLAST = J + J = NEXT (J) + GO TO 220 + ENDIF + WFLG = WFLG + 1 + I = NEXT (I) + IF (I .NE. 0) GO TO 200 + ENDIF + ENDIF + 250 CONTINUE + P = PME1 + NLEFT = TOTEL - NEL + DO 260 PME = PME1, PME2 + I = IW (PME) + NVI = -NV (I) + IF (NVI .GT. 0) THEN + NV (I) = NVI + IF (DEGREE(I).NE.N2) THEN + DEG = min (DEGREE (I) + DEGME - NVI, NLEFT - NVI) + IF (NOTDEFINEDAMD) THEN + IF(METRIC.EQ.AMF1) THEN + DEGREE(I) = DEG + RMF = dble(DEG)*dble(DEG-1) + & - dble(DEGME-NVI)*dble(DEGME-NVI-1) + ELSE + IF (DEGREE (I) + DEGME .GT. NLEFT ) THEN + DEG = DEGREE(I) + RMF1 = dble(DEG)*dble( (DEG-1) + 2*DEGME ) + & - dble(WF(I)) + DEGREE(I) = NLEFT - NVI + DEG = DEGREE(I) + RMF = dble(DEG)*dble(DEG-1) + & - dble(DEGME-NVI)*dble(DEGME-NVI-1) + RMF = min(RMF, RMF1) + ELSE + DEG = DEGREE(I) + DEGREE(I) = DEGREE (I) + DEGME - NVI + RMF = dble(DEG)*dble( (DEG-1) + 2*DEGME ) + & - dble(WF(I)) + ENDIF + ENDIF + IF (METRIC.EQ.AMF4MA41) THEN + RMF = RMF / dble(2*NVI) + ELSE + RMF = RMF / dble(NVI+1) + ENDIF + IF (RMF.LT.dummy) THEN + WF(I) = int ( anint( RMF )) + ELSEIF (RMF / dble(N) .LT. dummy) THEN + WF(I) = int ( anint( RMF/dble(N) )) + ELSE + WF(I) = idummy + ENDIF + WF(I) = max(1,WF(I)) + DEG = WF(I) + IF (DEG.GT.N) THEN + DEG = min(((DEG-N)/PAS) + N , NBBUCK) + ENDIF + ELSE + DEGREE(I) = DEG + ENDIF + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + LAST (I) = 0 + HEAD (DEG) = I + MINDEG = min (MINDEG, DEG) + ENDIF + IW (P) = I + P = P + 1 + ENDIF + 260 CONTINUE + NV (ME) = NVPIV + DEGME + LEN (ME) = P - PME1 + IF (LEN (ME) .EQ. 0) THEN + PE (ME) = 0 + W (ME) = 0 + ENDIF + IF (NEWMEM .NE. 0) THEN + PFREE = P + MEM = MEM - NEWMEM + LEN (ME) + ENDIF + GO TO 30 + ENDIF + IF (NEL.LT.TOTEL) THEN + IF (JOB.EQ.1) THEN + DO I = 1,SIZE_COMPLEM_LIST + X = COMPLEM_LIST(I) + ELEN(X) = -(N-SIZE_COMPLEM_LIST+I) + NV(X) = 1 + PE(X) = 0 + ENDDO + NEL = NEL+ SIZE_COMPLEM_LIST + ELSE + DO DEG = MINDEG, NBBUCK+1 + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 51 + ENDDO + 51 MINDEG = DEG + NELME = -(NEL+1) + DO X=1,N + IF ((PE(X).GT.0) .AND. (ELEN(X).LT.0)) THEN + PE(X) = -ME + ELSEIF (DEGREE(X).EQ.N2) THEN + NEL = NEL + NV(X) + PE(X) = -ME + ELEN(X) = 0 + NV(X) = 0 + ENDIF + ENDDO + ELEN(ME) = NELME + NV(ME) = SIZE_COMPLEM_LIST + PE(ME) = 0 + ENDIF + IF (NEL.NE.N) THEN + write(*,*) ' Error 2 in HALO AMD NEL, N=', NEL,N + NCMPA = -N - 1 + CALL MUMPS_ABORT() + ENDIF + ENDIF + DO 290 I = 1, N + IF (ELEN (I) .EQ. 0) THEN + J = -PE (I) + 270 CONTINUE + IF (ELEN (J) .GE. 0) THEN + J = -PE (J) + GO TO 270 + ENDIF + E = J + K = -ELEN (E) + J = I + 280 CONTINUE + IF (ELEN (J) .GE. 0) THEN + JNEXT = -PE (J) + PE (J) = -E + IF (ELEN (J) .EQ. 0) THEN + ELEN (J) = K + K = K + 1 + ENDIF + J = JNEXT + GO TO 280 + ENDIF + ELEN (E) = -K + ENDIF + 290 CONTINUE + IF(COMPRESS) THEN + LAST(1:N) = 0 + DEGREE(1:TOTEL-N)=0 + DO I = 1, N + K = abs (ELEN (I)) + IF ( K <= N ) THEN + LAST (K) = I + ELSE + DEGREE(K-N)=I + ENDIF + ENDDO + I = 1 + DO K = 1, N + IF(LAST (K) .NE. 0) THEN + LAST(I) = LAST(K) + ELEN(LAST(K)) = I + I = I + 1 + ENDIF + ENDDO + DO K = N+1, TOTEL + IF (DEGREE(K-N) .NE. 0) THEN + LAST(I)=DEGREE(K-N) + ELEN(DEGREE(K-N)) = I + I = I + 1 + ENDIF + END DO + ELSE + DO 300 I = 1, N + K = abs (ELEN (I)) + LAST (K) = I + ELEN (I) = K +300 CONTINUE + ENDIF + PFREE = MAXMEM + RETURN + END SUBROUTINE MUMPS_419 + SUBROUTINE MUMPS_197(N, IWLEN, PE, PFREE, LEN, IW, NV, ELEN, + & LAST, NCMPA, DEGREE, HEAD, NEXT, W) + INTEGER N, IWLEN, PFREE, NCMPA + INTEGER NEXT(N), LEN(N), + & ELEN(N), LAST(N), DEGREE(N), HEAD(N), + & W(N) + INTEGER IW(IWLEN), NV(N), PE(N) + INTEGER DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I, + & ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3, + & LENJ, LN, MAXMEM, ME, MEM, MINDEG, NEL, NEWMEM, + & NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X + INTEGER MAXINT_N + INTEGER(8) HASH, HMOD + INTEGER P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, PN, PSRC + INTRINSIC max, min, mod + WFLG = 2 + MAXINT_N=huge(WFLG)-N + MINDEG = 1 + NCMPA = 0 + NEL = 0 + HMOD = int(max (1, N-1),kind=8) + DMAX = 0 + MEM = PFREE - 1 + MAXMEM = MEM + DO 10 I = 1, N + LAST (I) = 0 + HEAD (I) = 0 + NV (I) = 1 + W (I) = 1 + ELEN (I) = 0 + DEGREE (I) = LEN (I) + 10 CONTINUE + DO 20 I = 1, N + DEG = DEGREE (I) + IF (DEG .GT. 0) THEN + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + ELSE + NEL = NEL + 1 + ELEN (I) = -NEL + PE (I) = 0 + W (I) = 0 + ENDIF + 20 CONTINUE + 30 IF (NEL .LT. N) THEN + DO 40 DEG = MINDEG, N + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 50 + 40 CONTINUE + 50 MINDEG = DEG + INEXT = NEXT (ME) + IF (INEXT .NE. 0) LAST (INEXT) = 0 + HEAD (DEG) = INEXT + ELENME = ELEN (ME) + ELEN (ME) = - (NEL + 1) + NVPIV = NV (ME) + NEL = NEL + NVPIV + NV (ME) = -NVPIV + DEGME = 0 + IF (ELENME .EQ. 0) THEN + PME1 = PE (ME) + PME2 = PME1 - 1 + DO 60 P = PME1, PME1 + LEN (ME) - 1 + I = IW (P) + NVI = NV (I) + IF (NVI .GT. 0) THEN + DEGME = DEGME + NVI + NV (I) = -NVI + PME2 = PME2 + 1 + IW (PME2) = I + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (DEGREE (I)) = INEXT + ENDIF + ENDIF + 60 CONTINUE + NEWMEM = 0 + ELSE + P = PE (ME) + PME1 = PFREE + SLENME = LEN (ME) - ELENME + DO 120 KNT1 = 1, ELENME + 1 + IF (KNT1 .GT. ELENME) THEN + E = ME + PJ = P + LN = SLENME + ELSE + E = IW (P) + P = P + 1 + PJ = PE (E) + LN = LEN (E) + ENDIF + DO 110 KNT2 = 1, LN + I = IW (PJ) + PJ = PJ + 1 + NVI = NV (I) + IF (NVI .GT. 0) THEN + IF (PFREE .GT. IWLEN) THEN + PE (ME) = P + LEN (ME) = LEN (ME) - KNT1 + IF (LEN (ME) .EQ. 0) PE (ME) = 0 + PE (E) = PJ + LEN (E) = LN - KNT2 + IF (LEN (E) .EQ. 0) PE (E) = 0 + NCMPA = NCMPA + 1 + DO 70 J = 1, N + PN = PE (J) + IF (PN .GT. 0) THEN + PE (J) = IW (PN) + IW (PN) = -J + ENDIF + 70 CONTINUE + PDST = 1 + PSRC = 1 + PEND = PME1 - 1 + 80 CONTINUE + IF (PSRC .LE. PEND) THEN + J = -IW (PSRC) + PSRC = PSRC + 1 + IF (J .GT. 0) THEN + IW (PDST) = PE (J) + PE (J) = PDST + PDST = PDST + 1 + LENJ = LEN (J) + DO 90 KNT3 = 0, LENJ - 2 + IW (PDST + KNT3) = IW (PSRC + KNT3) + 90 CONTINUE + PDST = PDST + LENJ - 1 + PSRC = PSRC + LENJ - 1 + ENDIF + GO TO 80 + ENDIF + P1 = PDST + DO 100 PSRC = PME1, PFREE - 1 + IW (PDST) = IW (PSRC) + PDST = PDST + 1 + 100 CONTINUE + PME1 = P1 + PFREE = PDST + PJ = PE (E) + P = PE (ME) + ENDIF + DEGME = DEGME + NVI + NV (I) = -NVI + IW (PFREE) = I + PFREE = PFREE + 1 + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (DEGREE (I)) = INEXT + ENDIF + ENDIF + 110 CONTINUE + IF (E .NE. ME) THEN + PE (E) = -ME + W (E) = 0 + ENDIF + 120 CONTINUE + PME2 = PFREE - 1 + NEWMEM = PFREE - PME1 + MEM = MEM + NEWMEM + MAXMEM = max (MAXMEM, MEM) + ENDIF + DEGREE (ME) = DEGME + PE (ME) = PME1 + LEN (ME) = PME2 - PME1 + 1 + IF (WFLG .GT. MAXINT_N) THEN + DO 130 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 130 CONTINUE + WFLG = 2 + ENDIF + DO 150 PME = PME1, PME2 + I = IW (PME) + ELN = ELEN (I) + IF (ELN .GT. 0) THEN + NVI = -NV (I) + WNVI = WFLG - NVI + DO 140 P = PE (I), PE (I) + ELN - 1 + E = IW (P) + WE = W (E) + IF (WE .GE. WFLG) THEN + WE = WE - NVI + ELSE IF (WE .NE. 0) THEN + WE = DEGREE (E) + WNVI + ENDIF + W (E) = WE + 140 CONTINUE + ENDIF + 150 CONTINUE + DO 180 PME = PME1, PME2 + I = IW (PME) + P1 = PE (I) + P2 = P1 + ELEN (I) - 1 + PN = P1 + HASH = 0_8 + DEG = 0 + DO 160 P = P1, P2 + E = IW (P) + DEXT = W (E) - WFLG + IF (DEXT .GT. 0) THEN + DEG = DEG + DEXT + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) + ELSE IF (DEXT .EQ. 0) THEN +#if defined (NOAGG1) + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) +#else + PE (E) = -ME + W (E) = 0 +#endif + ENDIF + 160 CONTINUE + ELEN (I) = PN - P1 + 1 + P3 = PN + DO 170 P = P2 + 1, P1 + LEN (I) - 1 + J = IW (P) + NVJ = NV (J) + IF (NVJ .GT. 0) THEN + DEG = DEG + NVJ + IW (PN) = J + PN = PN + 1 + HASH = HASH + int(J,kind=8) + ENDIF + 170 CONTINUE +#if defined (NOAGG1) + IF (ELEN(I).EQ.1 .AND. P3.EQ.PN) THEN +#else + IF (DEG .EQ. 0) THEN +#endif + PE (I) = -ME + NVI = -NV (I) + DEGME = DEGME - NVI + NVPIV = NVPIV + NVI + NEL = NEL + NVI + NV (I) = 0 + ELEN (I) = 0 + ELSE + DEGREE (I) = min (DEGREE (I), DEG) + IW (PN) = IW (P3) + IW (P3) = IW (P1) + IW (P1) = ME + LEN (I) = PN - P1 + 1 + HASH = mod (HASH, HMOD) + 1_8 + J = HEAD (HASH) + IF (J .LE. 0) THEN + NEXT (I) = -J + HEAD (HASH) = -I + ELSE + NEXT (I) = LAST (J) + LAST (J) = I + ENDIF + LAST (I) = int(HASH,kind=kind(LAST)) + ENDIF + 180 CONTINUE + DEGREE (ME) = DEGME + DMAX = max (DMAX, DEGME) + WFLG = WFLG + DMAX + IF (WFLG .GT. MAXINT_N) THEN + DO 190 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 190 CONTINUE + WFLG = 2 + ENDIF + DO 250 PME = PME1, PME2 + I = IW (PME) + IF (NV (I) .LT. 0) THEN + HASH = int(LAST (I),kind=8) + J = HEAD (HASH) + IF (J .EQ. 0) GO TO 250 + IF (J .LT. 0) THEN + I = -J + HEAD (HASH) = 0 + ELSE + I = LAST (J) + LAST (J) = 0 + ENDIF + IF (I .EQ. 0) GO TO 250 + 200 CONTINUE + IF (NEXT (I) .NE. 0) THEN + LN = LEN (I) + ELN = ELEN (I) + DO 210 P = PE (I) + 1, PE (I) + LN - 1 + W (IW (P)) = WFLG + 210 CONTINUE + JLAST = I + J = NEXT (I) + 220 CONTINUE + IF (J .NE. 0) THEN + IF (LEN (J) .NE. LN) GO TO 240 + IF (ELEN (J) .NE. ELN) GO TO 240 + DO 230 P = PE (J) + 1, PE (J) + LN - 1 + IF (W (IW (P)) .NE. WFLG) GO TO 240 + 230 CONTINUE + PE (J) = -I + NV (I) = NV (I) + NV (J) + NV (J) = 0 + ELEN (J) = 0 + J = NEXT (J) + NEXT (JLAST) = J + GO TO 220 + 240 CONTINUE + JLAST = J + J = NEXT (J) + GO TO 220 + ENDIF + WFLG = WFLG + 1 + I = NEXT (I) + IF (I .NE. 0) GO TO 200 + ENDIF + ENDIF + 250 CONTINUE + P = PME1 + NLEFT = N - NEL + DO 260 PME = PME1, PME2 + I = IW (PME) + NVI = -NV (I) + IF (NVI .GT. 0) THEN + NV (I) = NVI + DEG = min (DEGREE (I) + DEGME - NVI, NLEFT - NVI) + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + LAST (I) = 0 + HEAD (DEG) = I + MINDEG = min (MINDEG, DEG) + DEGREE (I) = DEG + IW (P) = I + P = P + 1 + ENDIF + 260 CONTINUE + NV (ME) = NVPIV + DEGME + LEN (ME) = P - PME1 + IF (LEN (ME) .EQ. 0) THEN + PE (ME) = 0 + W (ME) = 0 + ENDIF + IF (NEWMEM .NE. 0) THEN + PFREE = P + MEM = MEM - NEWMEM + LEN (ME) + ENDIF + GO TO 30 + ENDIF + DO 290 I = 1, N + IF (ELEN (I) .EQ. 0) THEN + J = -PE (I) + 270 CONTINUE + IF (ELEN (J) .GE. 0) THEN + J = -PE (J) + GO TO 270 + ENDIF + E = J + K = -ELEN (E) + J = I + 280 CONTINUE + IF (ELEN (J) .GE. 0) THEN + JNEXT = -PE (J) + PE (J) = -E + IF (ELEN (J) .EQ. 0) THEN + ELEN (J) = K + K = K + 1 + ENDIF + J = JNEXT + GO TO 280 + ENDIF + ELEN (E) = -K + ENDIF + 290 CONTINUE + DO 300 I = 1, N + K = abs (ELEN (I)) + LAST (K) = I + ELEN (I) = K + 300 CONTINUE + PFREE = MAXMEM + RETURN + END SUBROUTINE MUMPS_197 + SUBROUTINE MUMPS_23(N,IWLEN, PE, PFREE, LEN, IW, NV, ELEN, + & LAST, NCMPA, DEGREE, HEAD, NEXT, W) + INTEGER N, IWLEN, PFREE, NCMPA + INTEGER PE(N), LEN(N), + & ELEN(N), LAST(N), DEGREE(N), HEAD(N), + & W(N) + INTEGER IW(IWLEN), NV(N), NEXT(N) + INTEGER DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I, + & ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3, + & LENJ, LN, MAXMEM, ME, MEM, MINDEG, NEL, NEWMEM, + & NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X, + & NPRINC + INTEGER MAXINT_N + INTEGER(8) HASH, HMOD + INTEGER P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, PN, PSRC + INTRINSIC max, min, mod + WFLG = 2 + MAXINT_N=huge(WFLG)-N + MINDEG = 1 + NCMPA = 0 + NEL = 0 + HMOD = int(max (1, N-1),kind=8) + DMAX = 0 + MEM = PFREE - 1 + MAXMEM = MEM + NPRINC = 0 + DO I = 1, N + LAST (I) = 0 + HEAD (I) = 0 + NV (I) = 1 + W (I) = 1 + ELEN (I) = 0 + ENDDO + DO I=1, N + IF (LEN (I).GE.0) THEN + DEGREE (I) = LEN (I) + NPRINC = NPRINC + 1 + ELSE + J = -LEN (I) + DEGREE (I) = - 1 + IF ( PE(I) .NE. 0 ) THEN + LEN (I) = LEN(J) + ELSE + LEN (I) = 0 + ENDIF + PE (I) = -J + NV (J) = NV (J) + NV (I) + NV (I) = 0 + ELEN (I) = 0 + ENDIF + ENDDO + DO 20 I = 1, N + DEG = DEGREE (I) + IF (DEG .GT. 0) THEN + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + ELSE IF ( DEG.EQ. 0) THEN + ELEN (I) = - (NEL + 1) + NEL = NEL + NV(I) + PE (I) = 0 + W (I) = 0 + ENDIF + 20 CONTINUE + 30 IF (NEL .LT. N) THEN + DO 40 DEG = MINDEG, N + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 50 + 40 CONTINUE + 50 MINDEG = DEG + INEXT = NEXT (ME) + IF (INEXT .NE. 0) LAST (INEXT) = 0 + HEAD (DEG) = INEXT + ELENME = ELEN (ME) + ELEN (ME) = - (NEL + 1) + NVPIV = NV (ME) + NEL = NEL + NVPIV + NV (ME) = -NVPIV + DEGME = 0 + IF (ELENME .EQ. 0) THEN + PME1 = PE (ME) + PME2 = PME1 - 1 + DO 60 P = PME1, PME1 + LEN (ME) - 1 + I = IW (P) + NVI = NV (I) + IF (NVI .GT. 0) THEN + DEGME = DEGME + NVI + NV (I) = -NVI + PME2 = PME2 + 1 + IW (PME2) = I + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (DEGREE (I)) = INEXT + ENDIF + ENDIF + 60 CONTINUE + NEWMEM = 0 + ELSE + P = PE (ME) + PME1 = PFREE + SLENME = LEN (ME) - ELENME + DO 120 KNT1 = 1, ELENME + 1 + IF (KNT1 .GT. ELENME) THEN + E = ME + PJ = P + LN = SLENME + ELSE + E = IW (P) + P = P + 1 + PJ = PE (E) + LN = LEN (E) + ENDIF + DO 110 KNT2 = 1, LN + I = IW (PJ) + PJ = PJ + 1 + NVI = NV (I) + IF (NVI .GT. 0) THEN + IF (PFREE .GT. IWLEN) THEN + PE (ME) = P + LEN (ME) = LEN (ME) - KNT1 + IF (LEN (ME) .EQ. 0) PE (ME) = 0 + PE (E) = PJ + LEN (E) = LN - KNT2 + IF (LEN (E) .EQ. 0) PE (E) = 0 + NCMPA = NCMPA + 1 + DO 70 J = 1, N + PN = PE (J) + IF (PN .GT. 0) THEN + PE (J) = IW (PN) + IW (PN) = -J + ENDIF + 70 CONTINUE + PDST = 1 + PSRC = 1 + PEND = PME1 - 1 + 80 CONTINUE + IF (PSRC .LE. PEND) THEN + J = -IW (PSRC) + PSRC = PSRC + 1 + IF (J .GT. 0) THEN + IW (PDST) = PE (J) + PE (J) = PDST + PDST = PDST + 1 + LENJ = LEN (J) + DO 90 KNT3 = 0, LENJ - 2 + IW (PDST + KNT3) = IW (PSRC + KNT3) + 90 CONTINUE + PDST = PDST + LENJ - 1 + PSRC = PSRC + LENJ - 1 + ENDIF + GO TO 80 + ENDIF + P1 = PDST + DO 100 PSRC = PME1, PFREE - 1 + IW (PDST) = IW (PSRC) + PDST = PDST + 1 + 100 CONTINUE + PME1 = P1 + PFREE = PDST + PJ = PE (E) + P = PE (ME) + ENDIF + DEGME = DEGME + NVI + NV (I) = -NVI + IW (PFREE) = I + PFREE = PFREE + 1 + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (DEGREE (I)) = INEXT + ENDIF + ENDIF + 110 CONTINUE + IF (E .NE. ME) THEN + PE (E) = -ME + W (E) = 0 + ENDIF + 120 CONTINUE + PME2 = PFREE - 1 + NEWMEM = PFREE - PME1 + MEM = MEM + NEWMEM + MAXMEM = max (MAXMEM, MEM) + ENDIF + DEGREE (ME) = DEGME + PE (ME) = PME1 + LEN (ME) = PME2 - PME1 + 1 + IF (WFLG .GT. MAXINT_N) THEN + DO 130 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 130 CONTINUE + WFLG = 2 + ENDIF + DO 150 PME = PME1, PME2 + I = IW (PME) + ELN = ELEN (I) + IF (ELN .GT. 0) THEN + NVI = -NV (I) + WNVI = WFLG - NVI + DO 140 P = PE (I), PE (I) + ELN - 1 + E = IW (P) + WE = W (E) + IF (WE .GE. WFLG) THEN + WE = WE - NVI + ELSE IF (WE .NE. 0) THEN + WE = DEGREE (E) + WNVI + ENDIF + W (E) = WE + 140 CONTINUE + ENDIF + 150 CONTINUE + DO 180 PME = PME1, PME2 + I = IW (PME) + P1 = PE (I) + P2 = P1 + ELEN (I) - 1 + PN = P1 + HASH = 0_8 + DEG = 0 + DO 160 P = P1, P2 + E = IW (P) + DEXT = W (E) - WFLG + IF (DEXT .GT. 0) THEN + DEG = DEG + DEXT + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) + ELSE IF (DEXT .EQ. 0) THEN +#if defined (NOAGG2) + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) +#else + PE (E) = -ME + W (E) = 0 +#endif + ENDIF + 160 CONTINUE + ELEN (I) = PN - P1 + 1 + P3 = PN + DO 170 P = P2 + 1, P1 + LEN (I) - 1 + J = IW (P) + NVJ = NV (J) + IF (NVJ .GT. 0) THEN + DEG = DEG + NVJ + IW (PN) = J + PN = PN + 1 + HASH = HASH + int(J,kind=8) + ENDIF + 170 CONTINUE +#if defined (NOAGG2) + IF (ELEN(I).EQ.1 .AND. P3.EQ.PN) THEN +#else + IF (DEG .EQ. 0) THEN +#endif + PE (I) = -ME + NVI = -NV (I) + DEGME = DEGME - NVI + NVPIV = NVPIV + NVI + NEL = NEL + NVI + NV (I) = 0 + ELEN (I) = 0 + ELSE + DEGREE (I) = min (DEGREE (I), DEG) + IW (PN) = IW (P3) + IW (P3) = IW (P1) + IW (P1) = ME + LEN (I) = PN - P1 + 1 + HASH = mod (HASH, HMOD) + 1_8 + J = HEAD (HASH) + IF (J .LE. 0) THEN + NEXT (I) = -J + HEAD (HASH) = -I + ELSE + NEXT (I) = LAST (J) + LAST (J) = I + ENDIF + LAST (I) = int(HASH,kind=kind(LAST)) + ENDIF + 180 CONTINUE + DEGREE (ME) = DEGME + DMAX = max (DMAX, DEGME) + WFLG = WFLG + DMAX + IF (WFLG .GT. MAXINT_N) THEN + DO 190 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 190 CONTINUE + WFLG = 2 + ENDIF + DO 250 PME = PME1, PME2 + I = IW (PME) + IF (NV (I) .LT. 0) THEN + HASH = int(LAST (I),kind=8) + J = HEAD (HASH) + IF (J .EQ. 0) GO TO 250 + IF (J .LT. 0) THEN + I = -J + HEAD (HASH) = 0 + ELSE + I = LAST (J) + LAST (J) = 0 + ENDIF + IF (I .EQ. 0) GO TO 250 + 200 CONTINUE + IF (NEXT (I) .NE. 0) THEN + LN = LEN (I) + ELN = ELEN (I) + DO 210 P = PE (I) + 1, PE (I) + LN - 1 + W (IW (P)) = WFLG + 210 CONTINUE + JLAST = I + J = NEXT (I) + 220 CONTINUE + IF (J .NE. 0) THEN + IF (LEN (J) .NE. LN) GO TO 240 + IF (ELEN (J) .NE. ELN) GO TO 240 + DO 230 P = PE (J) + 1, PE (J) + LN - 1 + IF (W (IW (P)) .NE. WFLG) GO TO 240 + 230 CONTINUE + PE (J) = -I + NV (I) = NV (I) + NV (J) + NV (J) = 0 + ELEN (J) = 0 + J = NEXT (J) + NEXT (JLAST) = J + GO TO 220 + 240 CONTINUE + JLAST = J + J = NEXT (J) + GO TO 220 + ENDIF + WFLG = WFLG + 1 + I = NEXT (I) + IF (I .NE. 0) GO TO 200 + ENDIF + ENDIF + 250 CONTINUE + P = PME1 + NLEFT = N - NEL + DO 260 PME = PME1, PME2 + I = IW (PME) + NVI = -NV (I) + IF (NVI .GT. 0) THEN + NV (I) = NVI + DEG = min (DEGREE (I) + DEGME - NVI, NLEFT - NVI) + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + LAST (I) = 0 + HEAD (DEG) = I + MINDEG = min (MINDEG, DEG) + DEGREE (I) = DEG + IW (P) = I + P = P + 1 + ENDIF + 260 CONTINUE + NV (ME) = NVPIV + DEGME + LEN (ME) = P - PME1 + IF (LEN (ME) .EQ. 0) THEN + PE (ME) = 0 + W (ME) = 0 + ENDIF + IF (NEWMEM .NE. 0) THEN + PFREE = P + MEM = MEM - NEWMEM + LEN (ME) + ENDIF + GO TO 30 + ENDIF + DO 290 I = 1, N + IF (ELEN (I) .EQ. 0) THEN + J = -PE (I) + 270 CONTINUE + IF (ELEN (J) .GE. 0) THEN + J = -PE (J) + GO TO 270 + ENDIF + E = J + K = -ELEN (E) + J = I + 280 CONTINUE + IF (ELEN (J) .GE. 0) THEN + JNEXT = -PE (J) + PE (J) = -E + IF (ELEN (J) .EQ. 0) THEN + ELEN (J) = K + K = K + 1 + ENDIF + J = JNEXT + GO TO 280 + ENDIF + ELEN (E) = -K + ENDIF + 290 CONTINUE + DO 300 I = 1, N + K = abs (ELEN (I)) + LAST (K) = I + ELEN (I) = K + 300 CONTINUE + PFREE = MAXMEM + RETURN + END SUBROUTINE MUMPS_23 + SUBROUTINE MUMPS_162(N, IWLEN, PE, PFREE, LEN, IW, NV, ELEN, + & LAST, NCMPA, DEGREE, HEAD, NEXT, W, + & LISTVAR_SCHUR, SIZE_SCHUR) + INTEGER SIZE_SCHUR + INTEGER LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER N, IWLEN, PFREE, NCMPA + INTEGER LEN(N), + & ELEN(N), LAST(N), DEGREE(N), HEAD(N), + & W(N), NEXT(N) + INTEGER IW(IWLEN), NV(N), PE(N) + INTEGER DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I, + & ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3, + & LENJ, LN, MAXMEM, ME, MEM, MINDEG, NEL, NEWMEM, + & NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X, + & NBFLAG, NREAL, LASTD, NELME + INTEGER MAXINT_N + INTEGER(8) HASH, HMOD + INTEGER P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, PN, PSRC + INTRINSIC max, min, mod + WFLG = 2 + MAXINT_N=huge(WFLG)-N + MINDEG = 1 + NCMPA = 0 + NEL = 0 + HMOD = int(max (1, N-1),kind=8) + DMAX = 0 + MEM = PFREE - 1 + MAXMEM = MEM + NBFLAG = 0 + LASTD = 0 + DO 10 I = 1, N + LAST (I) = 0 + HEAD (I) = 0 + NV (I) = 1 + W (I) = 1 + ELEN (I) = 0 + DEGREE(I) = LEN(I) + 10 CONTINUE + NBFLAG = SIZE_SCHUR + DO K=1,SIZE_SCHUR + I = LISTVAR_SCHUR(K) + DEGREE(I) = N+1 + IF ((LEN(I) .EQ.0).OR.(LEN(I).EQ.-N-1)) THEN + PE (I) = 0 + LEN(I) = 0 + ENDIF + DEG = N + IF (LASTD.EQ.0) THEN + LASTD = I + HEAD(DEG) = I + NEXT(I) = 0 + LAST(I) = 0 + ELSE + NEXT(LASTD) = I + LAST(I) = LASTD + LASTD = I + NEXT(I) = 0 + ENDIF + ENDDO + NREAL = N - NBFLAG + DO 20 I = 1, N + DEG = DEGREE (I) + IF (DEG.EQ.N+1) GOTO 20 + IF (DEG .GT. 0) THEN + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + ELSE + NEL = NEL + 1 + ELEN (I) = -NEL + PE (I) = 0 + W (I) = 0 + ENDIF + 20 CONTINUE + NLEFT = N-NEL + 30 IF (NEL .LT. NREAL) THEN + DO 40 DEG = MINDEG, N + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 50 + 40 CONTINUE + 50 MINDEG = DEG + IF (ME.LE.0) THEN + write (*,*) ' Error 1 in HALO_AMD ' + NCMPA = -N + GOTO 500 + ENDIF + INEXT = NEXT (ME) + IF (INEXT .NE. 0) LAST (INEXT) = 0 + HEAD (DEG) = INEXT + ELENME = ELEN (ME) + ELEN (ME) = - (NEL + 1) + NVPIV = NV (ME) + NEL = NEL + NVPIV + NV (ME) = -NVPIV + DEGME = 0 + IF (ELENME .EQ. 0) THEN + PME1 = PE (ME) + PME2 = PME1 - 1 + DO 60 P = PME1, PME1 + LEN (ME) - 1 + I = IW (P) + NVI = NV (I) + IF (NVI .GT. 0) THEN + DEGME = DEGME + NVI + NV (I) = -NVI + PME2 = PME2 + 1 + IW (PME2) = I + IF (DEGREE(I).LE.N) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (DEGREE (I)) = INEXT + ENDIF + ENDIF + ENDIF + 60 CONTINUE + NEWMEM = 0 + ELSE + P = PE (ME) + PME1 = PFREE + SLENME = LEN (ME) - ELENME + DO 120 KNT1 = 1, ELENME + 1 + IF (KNT1 .GT. ELENME) THEN + E = ME + PJ = P + LN = SLENME + ELSE + E = IW (P) + P = P + 1 + PJ = PE (E) + LN = LEN (E) + ENDIF + DO 110 KNT2 = 1, LN + I = IW (PJ) + PJ = PJ + 1 + NVI = NV (I) + IF (NVI .GT. 0) THEN + IF (PFREE .GT. IWLEN) THEN + PE (ME) = P + LEN (ME) = LEN (ME) - KNT1 + IF (LEN (ME) .EQ. 0) PE (ME) = 0 + PE (E) = PJ + LEN (E) = LN - KNT2 + IF (LEN (E) .EQ. 0) PE (E) = 0 + NCMPA = NCMPA + 1 + DO 70 J = 1, N + PN = PE (J) + IF (PN .GT. 0) THEN + PE (J) = IW (PN) + IW (PN) = -J + ENDIF + 70 CONTINUE + PDST = 1 + PSRC = 1 + PEND = PME1 - 1 + 80 CONTINUE + IF (PSRC .LE. PEND) THEN + J = -IW (PSRC) + PSRC = PSRC + 1 + IF (J .GT. 0) THEN + IW (PDST) = PE (J) + PE (J) = PDST + PDST = PDST + 1 + LENJ = LEN (J) + DO 90 KNT3 = 0, LENJ - 2 + IW (PDST + KNT3) = IW (PSRC + KNT3) + 90 CONTINUE + PDST = PDST + LENJ - 1 + PSRC = PSRC + LENJ - 1 + ENDIF + GO TO 80 + ENDIF + P1 = PDST + DO 100 PSRC = PME1, PFREE - 1 + IW (PDST) = IW (PSRC) + PDST = PDST + 1 + 100 CONTINUE + PME1 = P1 + PFREE = PDST + PJ = PE (E) + P = PE (ME) + ENDIF + DEGME = DEGME + NVI + NV (I) = -NVI + IW (PFREE) = I + PFREE = PFREE + 1 + IF (DEGREE(I).LE.N) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (DEGREE (I)) = INEXT + ENDIF + ENDIF + ENDIF + 110 CONTINUE + IF (E .NE. ME) THEN + PE (E) = -ME + W (E) = 0 + ENDIF + 120 CONTINUE + PME2 = PFREE - 1 + NEWMEM = PFREE - PME1 + MEM = MEM + NEWMEM + MAXMEM = max (MAXMEM, MEM) + ENDIF + DEGREE (ME) = DEGME + PE (ME) = PME1 + LEN (ME) = PME2 - PME1 + 1 + IF (WFLG .GT. MAXINT_N) THEN + DO 130 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 130 CONTINUE + WFLG = 2 + ENDIF + DO 150 PME = PME1, PME2 + I = IW (PME) + ELN = ELEN (I) + IF (ELN .GT. 0) THEN + NVI = -NV (I) + WNVI = WFLG - NVI + DO 140 P = PE (I), PE (I) + ELN - 1 + E = IW (P) + WE = W (E) + IF (WE .GE. WFLG) THEN + WE = WE - NVI + ELSE IF (WE .NE. 0) THEN + WE = DEGREE (E) + WNVI + ENDIF + W (E) = WE + 140 CONTINUE + ENDIF + 150 CONTINUE + DO 180 PME = PME1, PME2 + I = IW (PME) + P1 = PE (I) + P2 = P1 + ELEN (I) - 1 + PN = P1 + HASH = 0_8 + DEG = 0 + DO 160 P = P1, P2 + E = IW (P) + DEXT = W (E) - WFLG + IF (DEXT .GT. 0) THEN + DEG = DEG + DEXT + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) + ELSE IF (DEXT .EQ. 0) THEN +#if defined (NOAGG3) + IW (PN) = E + PN = PN + 1 + HASH = HASH + E +#else + PE (E) = -ME + W (E) = 0 +#endif + ENDIF + 160 CONTINUE + ELEN (I) = PN - P1 + 1 + P3 = PN + DO 170 P = P2 + 1, P1 + LEN (I) - 1 + J = IW (P) + NVJ = NV (J) + IF (NVJ .GT. 0) THEN + DEG = DEG + NVJ + IW (PN) = J + PN = PN + 1 + HASH = HASH + int(J,kind=8) + ENDIF + 170 CONTINUE + IF (DEGREE(I).EQ.N+1) DEG = N+1 +#if defined (NOAGG3) + IF (ELEN(I).EQ.1 .AND. P3.EQ.PN) THEN +#else + IF (DEG .EQ. 0) THEN +#endif + PE (I) = -ME + NVI = -NV (I) + DEGME = DEGME - NVI + NVPIV = NVPIV + NVI + NEL = NEL + NVI + NV (I) = 0 + ELEN (I) = 0 + ELSE + IF (DEGREE(I).NE.N+1) THEN + DEG = min (DEG, NLEFT) + DEGREE (I) = min (DEGREE (I), DEG) + ENDIF + IW (PN) = IW (P3) + IW (P3) = IW (P1) + IW (P1) = ME + LEN (I) = PN - P1 + 1 + IF (DEG.LE.N) THEN + HASH = mod (HASH, HMOD) + 1_8 + J = HEAD (HASH) + IF (J .LE. 0) THEN + NEXT (I) = -J + HEAD (HASH) = -I + ELSE + NEXT (I) = LAST (J) + LAST (J) = I + ENDIF + LAST (I) = int(HASH, kind=kind(LAST)) + ENDIF + ENDIF + 180 CONTINUE + DEGREE (ME) = DEGME + DMAX = max (DMAX, DEGME) + WFLG = WFLG + DMAX + IF (WFLG .GT. MAXINT_N) THEN + DO 190 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 190 CONTINUE + WFLG = 2 + ENDIF + DO 250 PME = PME1, PME2 + I = IW (PME) + IF ( (NV (I) .LT. 0) .AND. (DEGREE(I) .LE. N) ) THEN + HASH = int(LAST (I),kind=8) + J = HEAD (HASH) + IF (J .EQ. 0) GO TO 250 + IF (J .LT. 0) THEN + I = -J + HEAD (HASH) = 0 + ELSE + I = LAST (J) + LAST (J) = 0 + ENDIF + IF (I .EQ. 0) GO TO 250 + 200 CONTINUE + IF (NEXT (I) .NE. 0) THEN + LN = LEN (I) + ELN = ELEN (I) + DO 210 P = PE (I) + 1, PE (I) + LN - 1 + W (IW (P)) = WFLG + 210 CONTINUE + JLAST = I + J = NEXT (I) + 220 CONTINUE + IF (J .NE. 0) THEN + IF (LEN (J) .NE. LN) GO TO 240 + IF (ELEN (J) .NE. ELN) GO TO 240 + DO 230 P = PE (J) + 1, PE (J) + LN - 1 + IF (W (IW (P)) .NE. WFLG) GO TO 240 + 230 CONTINUE + PE (J) = -I + NV (I) = NV (I) + NV (J) + NV (J) = 0 + ELEN (J) = 0 + J = NEXT (J) + NEXT (JLAST) = J + GO TO 220 + 240 CONTINUE + JLAST = J + J = NEXT (J) + GO TO 220 + ENDIF + WFLG = WFLG + 1 + I = NEXT (I) + IF (I .NE. 0) GO TO 200 + ENDIF + ENDIF + 250 CONTINUE + P = PME1 + NLEFT = N - NEL + DO 260 PME = PME1, PME2 + I = IW (PME) + NVI = -NV (I) + IF (NVI .GT. 0) THEN + NV (I) = NVI + IF (DEGREE(I).LE.N) THEN + DEG = min (DEGREE (I) + DEGME - NVI, NLEFT - NVI) + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + LAST (I) = 0 + HEAD (DEG) = I + MINDEG = min (MINDEG, DEG) + DEGREE (I) = DEG + ENDIF + IW (P) = I + P = P + 1 + ENDIF + 260 CONTINUE + NV (ME) = NVPIV + DEGME + LEN (ME) = P - PME1 + IF (LEN (ME) .EQ. 0) THEN + PE (ME) = 0 + W (ME) = 0 + ENDIF + IF (NEWMEM .NE. 0) THEN + PFREE = P + MEM = MEM - NEWMEM + LEN (ME) + ENDIF + GO TO 30 + ENDIF + IF (NEL.LT.N) THEN + DO DEG = MINDEG, N + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 51 + ENDDO + 51 MINDEG = DEG + IF (ME.NE.LISTVAR_SCHUR(1)) THEN + write(6,*) ' error 1 in MUMPS_162 ' + write(6,*) ' wrong principal var for Schur !!' + NCMPA = -N - 2 + CALL MUMPS_ABORT() + ENDIF + NELME = -(NEL+1) + DO X=1,N + IF ((PE(X).GT.0) .AND. (ELEN(X).LT.0)) THEN + PE(X) = -ME + ELSEIF (DEGREE(X).EQ.N+1) THEN + NEL = NEL + NV(X) + PE(X) = -ME + ELEN(X) = 0 + NV(X) = 0 + ENDIF + ENDDO + ELEN(ME) = NELME + NV(ME) = N-NREAL + PE(ME) = 0 + IF (NEL.NE.N) THEN + write(*,*) ' Error 2 in MUMPS_162 NEL, N=', NEL,N + NCMPA = -N - 1 + CALL MUMPS_ABORT() + ENDIF + ENDIF + DO 290 I = 1, N + IF (ELEN (I) .EQ. 0) THEN + J = -PE (I) + 270 CONTINUE + IF (ELEN (J) .GE. 0) THEN + J = -PE (J) + GO TO 270 + ENDIF + E = J + K = -ELEN (E) + J = I + 280 CONTINUE + IF (ELEN (J) .GE. 0) THEN + JNEXT = -PE (J) + PE (J) = -E + IF (ELEN (J) .EQ. 0) THEN + ELEN (J) = K + K = K + 1 + ENDIF + J = JNEXT + GO TO 280 + ENDIF + ELEN (E) = -K + ENDIF + 290 CONTINUE + DO 300 I = 1, N + K = abs (ELEN (I)) + LAST (K) = I + ELEN (I) = K + 300 CONTINUE + 500 PFREE = MAXMEM + RETURN + END SUBROUTINE MUMPS_162 + SUBROUTINE MUMPS_337(N, NBBUCK, + & IWLEN, PE, PFREE, LEN, IW, NV, ELEN, + & LAST, NCMPA, DEGREE, WF, NEXT, W, HEAD) + IMPLICIT NONE + INTEGER N, IWLEN, PFREE, LEN(N), + & ELEN(N), LAST(N), NCMPA, DEGREE(N), NEXT(N), + & W(N) + INTEGER PE(N), IW(IWLEN), NV(N) + INTEGER NBBUCK + INTEGER HEAD(0:NBBUCK+1), WF(N) + INTEGER DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I, + & ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3, + & LENJ, LN, MAXMEM, ME, MEM, MINDEG, NEL, NEWMEM, + & NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X, + & NBFLAG, NREAL, LASTD, NELME, WF3, WF4, N2, PAS + INTEGER MAXINT_N + INTEGER(8) HASH, HMOD + DOUBLE PRECISION RMF, RMF1 + DOUBLE PRECISION dummy + INTEGER idummy + INTEGER P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, PN, PSRC + INTRINSIC max, min, mod, huge + INTEGER TOTEL + LOGICAL COMPRESS + idummy = huge(idummy) - 1 + dummy = dble(idummy) + N2 = -NBBUCK-1 + PAS = max((N/8), 1) + WFLG = 2 + MAXINT_N=huge(WFLG)-N + NCMPA = 0 + NEL = 0 + HMOD = int(max (1, NBBUCK-1),kind=8) + DMAX = 0 + MEM = PFREE - 1 + MAXMEM = MEM + MINDEG = 0 + NBFLAG = 0 + LASTD = 0 + HEAD(0:NBBUCK+1) = 0 + DO 10 I = 1, N + LAST(I) = 0 + W(I) = 1 + ELEN (I) = 0 + 10 CONTINUE + IF(NV(1) .LT. 0) THEN + COMPRESS = .FALSE. + ELSE + COMPRESS = .TRUE. + ENDIF + IF(COMPRESS) THEN + TOTEL = 0 + DO I=1,N + IF (LEN(I).LT.0) THEN + DEGREE (I) = N2 + NBFLAG = NBFLAG +1 + IF (LEN(I).EQ.-N-1) THEN + LEN (I) = 0 + PE (I) = 0 + ELSE + LEN (I) = - LEN(I) + ENDIF + ELSE + TOTEL = TOTEL + NV(I) + DEGREE(I) = 0 + DO J= PE(I) , PE(I)+LEN(I)-1 + DEGREE(I) = DEGREE(I) + NV(IW(J)) + ENDDO + ENDIF + ENDDO + ELSE + DO I=1,N + NV(I) = 1 + IF (LEN(I).LT.0) THEN + DEGREE (I) = N2 + NBFLAG = NBFLAG +1 + IF (LEN(I).EQ.-N-1) THEN + LEN (I) = 0 + PE (I) = 0 + ELSE + LEN (I) = - LEN(I) + ENDIF + ELSE + DEGREE (I) = LEN (I) + ENDIF + ENDDO + TOTEL = N - NBFLAG + ENDIF + NREAL = N - NBFLAG + DO 20 I = 1, N + DEG = DEGREE (I) + IF (DEG.EQ.N2) THEN + DEG = NBBUCK + 1 + IF (LASTD.EQ.0) THEN + LASTD = I + HEAD(DEG) = I + NEXT(I) = 0 + LAST(I) = 0 + ELSE + NEXT(LASTD) = I + LAST(I) = LASTD + LASTD = I + NEXT(I) = 0 + ENDIF + GOTO 20 + ENDIF + IF (DEG .GT. 0) THEN + WF(I) = DEG + IF (DEG.GT.N) THEN + DEG = min(((DEG-N)/PAS) + N , NBBUCK) + ENDIF + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + ELSE + NEL = NEL + NV(I) + ELEN (I) = -NEL + PE (I) = 0 + W (I) = 0 + ENDIF + 20 CONTINUE + NLEFT = TOTEL-NEL + 30 IF (NEL .LT. TOTEL) THEN + DO 40 DEG = MINDEG, NBBUCK + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 50 + 40 CONTINUE + 50 MINDEG = DEG + IF (ME.LE.0) THEN + NCMPA = -N + CALL MUMPS_ABORT() + ENDIF + IF (DEG.GT.N) THEN + J = NEXT(ME) + K = WF(ME) + 55 CONTINUE + IF (J.GT.0) THEN + IF (WF(J).LT.K) THEN + ME = J + K = WF(ME) + ENDIF + J= NEXT(J) + GOTO 55 + ENDIF + ILAST = LAST(ME) + INEXT = NEXT(ME) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (DEG) = INEXT + ENDIF + ELSE + INEXT = NEXT (ME) + IF (INEXT .NE. 0) LAST (INEXT) = 0 + HEAD (DEG) = INEXT + ENDIF + ELENME = ELEN (ME) + ELEN (ME) = - (NEL + 1) + NVPIV = NV (ME) + NEL = NEL + NVPIV + NV (ME) = -NVPIV + DEGME = 0 + IF (ELENME .EQ. 0) THEN + PME1 = PE (ME) + PME2 = PME1 - 1 + DO 60 P = PME1, PME1 + LEN (ME) - 1 + I = IW (P) + NVI = NV (I) + IF (NVI .GT. 0) THEN + DEGME = DEGME + NVI + NV (I) = -NVI + PME2 = PME2 + 1 + IW (PME2) = I + IF (DEGREE(I).NE.N2) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + IF (WF(I).GT.N) THEN + DEG = min(((WF(I)-N)/PAS) + N , NBBUCK) + ELSE + DEG = WF(I) + ENDIF + HEAD (DEG) = INEXT + ENDIF + ENDIF + ENDIF + 60 CONTINUE + NEWMEM = 0 + ELSE + P = PE (ME) + PME1 = PFREE + SLENME = LEN (ME) - ELENME + DO 120 KNT1 = 1, ELENME + 1 + IF (KNT1 .GT. ELENME) THEN + E = ME + PJ = P + LN = SLENME + ELSE + E = IW (P) + P = P + 1 + PJ = PE (E) + LN = LEN (E) + ENDIF + DO 110 KNT2 = 1, LN + I = IW (PJ) + PJ = PJ + 1 + NVI = NV (I) + IF (NVI .GT. 0) THEN + IF (PFREE .GT. IWLEN) THEN + PE (ME) = P + LEN (ME) = LEN (ME) - KNT1 + IF (LEN (ME) .EQ. 0) PE (ME) = 0 + PE (E) = PJ + LEN (E) = LN - KNT2 + IF (LEN (E) .EQ. 0) PE (E) = 0 + NCMPA = NCMPA + 1 + DO 70 J = 1, N + PN = PE (J) + IF (PN .GT. 0) THEN + PE (J) = IW (PN) + IW (PN) = -J + ENDIF + 70 CONTINUE + PDST = 1 + PSRC = 1 + PEND = PME1 - 1 + 80 CONTINUE + IF (PSRC .LE. PEND) THEN + J = -IW (PSRC) + PSRC = PSRC + 1 + IF (J .GT. 0) THEN + IW (PDST) = PE (J) + PE (J) = PDST + PDST = PDST + 1 + LENJ = LEN (J) + DO 90 KNT3 = 0, LENJ - 2 + IW (PDST + KNT3) = IW (PSRC + KNT3) + 90 CONTINUE + PDST = PDST + LENJ - 1 + PSRC = PSRC + LENJ - 1 + ENDIF + GO TO 80 + ENDIF + P1 = PDST + DO 100 PSRC = PME1, PFREE - 1 + IW (PDST) = IW (PSRC) + PDST = PDST + 1 + 100 CONTINUE + PME1 = P1 + PFREE = PDST + PJ = PE (E) + P = PE (ME) + ENDIF + DEGME = DEGME + NVI + NV (I) = -NVI + IW (PFREE) = I + PFREE = PFREE + 1 + IF (DEGREE(I).NE.N2) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + IF (WF(I).GT.N) THEN + DEG = min(((WF(I)-N)/PAS) + N , NBBUCK) + ELSE + DEG = WF(I) + ENDIF + HEAD (DEG) = INEXT + ENDIF + ENDIF + ENDIF + 110 CONTINUE + IF (E .NE. ME) THEN + PE (E) = -ME + W (E) = 0 + ENDIF + 120 CONTINUE + PME2 = PFREE - 1 + NEWMEM = PFREE - PME1 + MEM = MEM + NEWMEM + MAXMEM = max (MAXMEM, MEM) + ENDIF + DEGREE (ME) = DEGME + PE (ME) = PME1 + LEN (ME) = PME2 - PME1 + 1 + IF (WFLG .GT. MAXINT_N) THEN + DO 130 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 130 CONTINUE + WFLG = 2 + ENDIF + DO 150 PME = PME1, PME2 + I = IW (PME) + ELN = ELEN (I) + IF (ELN .GT. 0) THEN + NVI = -NV (I) + WNVI = WFLG - NVI + DO 140 P = PE (I), PE (I) + ELN - 1 + E = IW (P) + WE = W (E) + IF (WE .GE. WFLG) THEN + WE = WE - NVI + ELSE IF (WE .NE. 0) THEN + WE = DEGREE (E) + WNVI + WF(E) = 0 + ENDIF + W (E) = WE + 140 CONTINUE + ENDIF + 150 CONTINUE + DO 180 PME = PME1, PME2 + I = IW (PME) + P1 = PE (I) + P2 = P1 + ELEN (I) - 1 + PN = P1 + HASH = 0_8 + DEG = 0 + WF3 = 0 + WF4 = 0 + NVI = -NV(I) + DO 160 P = P1, P2 + E = IW (P) + DEXT = W (E) - WFLG + IF (DEXT .GT. 0) THEN + IF ( WF(E) .EQ. 0 ) THEN + WF(E) = DEXT * ( (2 * DEGREE(E)) - DEXT - 1) + ENDIF + WF4 = WF4 + WF(E) + DEG = DEG + DEXT + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E, kind=8) + ELSE IF (DEXT .EQ. 0) THEN +#if defined (NOAGG4) + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) +#else + PE (E) = -ME + W (E) = 0 +#endif + ENDIF + 160 CONTINUE + ELEN (I) = PN - P1 + 1 + P3 = PN + DO 170 P = P2 + 1, P1 + LEN (I) - 1 + J = IW (P) + NVJ = NV (J) + IF (NVJ .GT. 0) THEN + DEG = DEG + NVJ + WF3 = WF3 + NVJ + IW (PN) = J + PN = PN + 1 + HASH = HASH + int(J,kind=8) + ENDIF + 170 CONTINUE + IF (DEGREE(I).EQ.N2) DEG = N2 +#if defined (NOAGG4) + IF (ELEN(I).EQ.1 .AND. P3.EQ.PN) THEN +#else + IF (DEG .EQ. 0) THEN +#endif + PE (I) = -ME + NVI = -NV (I) + DEGME = DEGME - NVI + NVPIV = NVPIV + NVI + NEL = NEL + NVI + NV (I) = 0 + ELEN (I) = 0 + ELSE + IF (DEGREE(I).NE.N2) THEN + IF ( DEGREE (I).LT.DEG ) THEN + WF4 = 0 + WF3 = 0 + ELSE + DEGREE(I) = DEG + ENDIF + ENDIF + WF(I) = WF4 + 2*NVI*WF3 + IW (PN) = IW (P3) + IW (P3) = IW (P1) + IW (P1) = ME + LEN (I) = PN - P1 + 1 + IF (DEG.NE.N2) THEN + HASH = mod (HASH, HMOD) + 1_8 + J = HEAD (HASH) + IF (J .LE. 0) THEN + NEXT (I) = -J + HEAD (HASH) = -I + ELSE + NEXT (I) = LAST (J) + LAST (J) = I + ENDIF + LAST (I) = int(HASH,kind=kind(LAST)) + ENDIF + ENDIF + 180 CONTINUE + DEGREE (ME) = DEGME + DMAX = max (DMAX, DEGME) + WFLG = WFLG + DMAX + IF (WFLG .GT. MAXINT_N) THEN + DO 190 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 190 CONTINUE + WFLG = 2 + ENDIF + DO 250 PME = PME1, PME2 + I = IW (PME) + IF ( (NV (I) .LT. 0) .AND. (DEGREE(I).NE.N2) ) THEN + HASH = int(LAST (I),kind=8) + J = HEAD (HASH) + IF (J .EQ. 0) GO TO 250 + IF (J .LT. 0) THEN + I = -J + HEAD (HASH) = 0 + ELSE + I = LAST (J) + LAST (J) = 0 + ENDIF + IF (I .EQ. 0) GO TO 250 + 200 CONTINUE + IF (NEXT (I) .NE. 0) THEN + LN = LEN (I) + ELN = ELEN (I) + DO 210 P = PE (I) + 1, PE (I) + LN - 1 + W (IW (P)) = WFLG + 210 CONTINUE + JLAST = I + J = NEXT (I) + 220 CONTINUE + IF (J .NE. 0) THEN + IF (LEN (J) .NE. LN) GO TO 240 + IF (ELEN (J) .NE. ELN) GO TO 240 + DO 230 P = PE (J) + 1, PE (J) + LN - 1 + IF (W (IW (P)) .NE. WFLG) GO TO 240 + 230 CONTINUE + PE (J) = -I + WF(I) = max(WF(I),WF(J)) + NV (I) = NV (I) + NV (J) + NV (J) = 0 + ELEN (J) = 0 + J = NEXT (J) + NEXT (JLAST) = J + GO TO 220 + 240 CONTINUE + JLAST = J + J = NEXT (J) + GO TO 220 + ENDIF + WFLG = WFLG + 1 + I = NEXT (I) + IF (I .NE. 0) GO TO 200 + ENDIF + ENDIF + 250 CONTINUE + P = PME1 + NLEFT = TOTEL - NEL + DO 260 PME = PME1, PME2 + I = IW (PME) + NVI = -NV (I) + IF (NVI .GT. 0) THEN + NV (I) = NVI + IF (DEGREE(I).NE.N2) THEN + DEG = min (DEGREE (I) + DEGME - NVI, NLEFT - NVI) + IF (DEGREE (I) + DEGME .GT. NLEFT ) THEN + DEG = DEGREE(I) + RMF1 = dble(DEG)*dble( (DEG-1) + 2*DEGME ) + & - dble(WF(I)) + DEGREE(I) = NLEFT - NVI + DEG = DEGREE(I) + RMF = dble(DEG)*dble(DEG-1) + & - dble(DEGME-NVI)*dble(DEGME-NVI-1) + RMF = min(RMF, RMF1) + ELSE + DEG = DEGREE(I) + DEGREE(I) = DEGREE (I) + DEGME - NVI + RMF = dble(DEG)*dble( (DEG-1) + 2*DEGME ) + & - dble(WF(I)) + ENDIF + RMF = RMF / dble(NVI+1) + IF (RMF.LT.dummy) THEN + WF(I) = int ( anint( RMF )) + ELSEIF (RMF / dble(N) .LT. dummy) THEN + WF(I) = int ( anint( RMF/dble(N) )) + ELSE + WF(I) = idummy + ENDIF + WF(I) = max(1,WF(I)) + DEG = WF(I) + IF (DEG.GT.N) THEN + DEG = min(((DEG-N)/PAS) + N , NBBUCK) + ENDIF + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + LAST (I) = 0 + HEAD (DEG) = I + MINDEG = min (MINDEG, DEG) + ENDIF + IW (P) = I + P = P + 1 + ENDIF + 260 CONTINUE + NV (ME) = NVPIV + DEGME + LEN (ME) = P - PME1 + IF (LEN (ME) .EQ. 0) THEN + PE (ME) = 0 + W (ME) = 0 + ENDIF + IF (NEWMEM .NE. 0) THEN + PFREE = P + MEM = MEM - NEWMEM + LEN (ME) + ENDIF + GO TO 30 + ENDIF + IF (NEL.LT.N) THEN + DO DEG = MINDEG, NBBUCK+1 + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 51 + ENDDO + 51 MINDEG = DEG + NELME = -(NEL+1) + DO X=1,N + IF ((PE(X).GT.0) .AND. (ELEN(X).LT.0)) THEN + PE(X) = -ME + ELSEIF (DEGREE(X).EQ.N2) THEN + NEL = NEL + NV(X) + PE(X) = -ME + ELEN(X) = 0 + NV(X) = 0 + ENDIF + ENDDO + ELEN(ME) = NELME + NV(ME) = N-NREAL + PE(ME) = 0 + IF (NEL.NE.N) THEN + NCMPA = -N - 1 + GOTO 500 + ENDIF + ENDIF + DO 290 I = 1, N + IF (ELEN (I) .EQ. 0) THEN + J = -PE (I) + 270 CONTINUE + IF (ELEN (J) .GE. 0) THEN + J = -PE (J) + GO TO 270 + ENDIF + E = J + K = -ELEN (E) + J = I + 280 CONTINUE + IF (ELEN (J) .GE. 0) THEN + JNEXT = -PE (J) + PE (J) = -E + IF (ELEN (J) .EQ. 0) THEN + ELEN (J) = K + K = K + 1 + ENDIF + J = JNEXT + GO TO 280 + ENDIF + ELEN (E) = -K + ENDIF + 290 CONTINUE + IF(COMPRESS) THEN + LAST(1:N) = 0 + DEGREE(1:TOTEL-N)=0 + DO I = 1, N + K = abs (ELEN (I)) + IF ( K <= N ) THEN + LAST (K) = I + ELSE + DEGREE(K-N)=I + ENDIF + ENDDO + I = 1 + DO K = 1, N + IF(LAST (K) .NE. 0) THEN + LAST(I) = LAST(K) + ELEN(LAST(K)) = I + I = I + 1 + ENDIF + ENDDO + DO K = N+1, TOTEL + IF (DEGREE(K-N) .NE. 0) THEN + LAST(I)=DEGREE(K-N) + ELEN(DEGREE(K-N)) = I + I = I + 1 + ENDIF + END DO + ELSE + DO 300 I = 1, N + K = abs (ELEN (I)) + LAST (K) = I + ELEN (I) = K +300 CONTINUE + ENDIF + 500 PFREE = MAXMEM + RETURN + END SUBROUTINE MUMPS_337 + SUBROUTINE MUMPS_421 + & (TOTEL, IVersion, THRESH, NDENSE, + & N, IWLEN, PE, PFREE, LEN, IW, NV, + & ELEN, LAST, NCMPA, DEGREE, HEAD, NEXT, W) + INTEGER TOTEL + INTEGER N, IWLEN, PE(N), PFREE, LEN(N), IW(IWLEN), NV(N), + & ELEN(N), NCMPA, DEGREE(N), + & LAST(TOTEL), HEAD(TOTEL), NEXT(N), + & W(N) + INTEGER NDENSE(N) + INTEGER IVersion, THRESH + INTEGER THRESM, MINDEN, MAXDEN, NDME + INTEGER NBD,NBED, NBDM, LASTD, NELME + LOGICAL IDENSE + DOUBLE PRECISION RELDEN + INTEGER DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I, + & ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3, + & LENJ, LN, MAXMEM, ME, MEM, MINDEG, NEL, NEWMEM, + & NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X + INTEGER MAXINT_N + INTEGER(8) HASH, HMOD + INTEGER P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, PN, PSRC + INTRINSIC max, min, mod + LOGICAL COMPRESS + IF (THRESH.GT.0) THEN + THRESM = min(N,THRESH) + DO I=1,N + THRESM = max(THRESM, LEN(I)) + ENDDO + RELDEN = dble(PFREE-1)/dble(N) + THRESM = int(RELDEN)*10 + (THRESM-int(RELDEN))/10 + 1 + ELSE + THRESM = TOTEL + ENDIF + IF (THRESM.GE.0) THEN + IF ((THRESM.GT.TOTEL).OR.(THRESM.LT.2)) THEN + THRESM = TOTEL + ENDIF + ENDIF + LASTD = 0 + NBD = 0 + NBED = 0 + NBDM = 0 + WFLG = 2 + MAXINT_N=huge(WFLG)-N + MINDEG = 1 + NCMPA = 0 + NEL = 0 + HMOD = int(max (1, N-1),kind=8) + DMAX = 0 + MEM = PFREE - 1 + MAXMEM = MEM + DO 10 I = 1, N + NDENSE(I)= 0 + LAST (I) = 0 + HEAD (I) = 0 + W (I) = 1 + ELEN (I) = 0 + 10 CONTINUE + HEAD(N:TOTEL) = 0 + LAST(N:TOTEL) = 0 + IF(NV(1) .LT. 0) THEN + COMPRESS = .FALSE. + ELSE + COMPRESS = .TRUE. + ENDIF + IF(COMPRESS) THEN + DO I=1,N + DEGREE(I) = 0 + DO J= PE(I) , PE(I)+LEN(I)-1 + DEGREE(I) = DEGREE(I) + NV(IW(J)) + ENDDO + ENDDO + ELSE + DO I=1,N + NV(I) = 1 + DEGREE (I) = LEN (I) + ENDDO + ENDIF + DO 20 I = 1, N + DEG = DEGREE (I) + IF (DEG .GT. 0) THEN + IF ( (THRESM.GE.0) .AND. + & (DEG+NV(I).GE.THRESM) ) THEN + NBD = NBD+1 + IF (DEG+NV(I).NE.TOTEL-NEL) THEN + DEGREE(I) = DEGREE(I)+TOTEL+1 + DEG = TOTEL + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + LAST(I) = 0 + IF (LASTD.EQ.0) LASTD=I + ELSE + NBED = NBED+1 + DEGREE(I) = TOTEL+1 + DEG = TOTEL + IF (LASTD.EQ.0) THEN + LASTD = I + HEAD(DEG) = I + NEXT(I) = 0 + LAST(I) = 0 + ELSE + NEXT(LASTD) = I + LAST(I) = LASTD + LASTD = I + NEXT(I) = 0 + ENDIF + ENDIF + ELSE + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + ENDIF + ELSE + NEL = NEL + NV(I) + ELEN (I) = -NEL + PE (I) = 0 + W (I) = 0 + ENDIF + 20 CONTINUE + IF (NBD.EQ.0) THRESM = TOTEL + NLEFT = TOTEL - NEL + 30 IF (NEL .LT. TOTEL) THEN + DO 40 DEG = MINDEG, TOTEL + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 50 + 40 CONTINUE + 50 MINDEG = DEG + IF (DEG.LT.TOTEL) THEN + INEXT = NEXT (ME) + IF (INEXT .NE. 0) LAST (INEXT) = 0 + HEAD (DEG) = INEXT + ELSE + NBDM = max(NBDM,NBD) + IF (DEGREE(ME).GT.TOTEL+1) THEN + MINDEN = NBD + MAXDEN = 0 + IF (WFLG .GT. MAXINT_N) THEN + DO 52 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 52 CONTINUE + WFLG = 2 + ENDIF + WFLG = WFLG + 1 + 51 CONTINUE + INEXT = NEXT (ME) + IF (INEXT .NE. 0) THEN + LAST (INEXT) = 0 + ELSE + LASTD = 0 + ENDIF + NDENSE(ME) = 0 + W(ME) = WFLG + P1 = PE(ME) + P2 = P1 + LEN(ME) -1 + LN = P1 + ELN = P1 + DO 55 P=P1,P2 + E= IW(P) + IF (W(E).EQ.WFLG) GOTO 55 + W(E) = WFLG + IF (PE(E).LT.0) THEN + X = E + 53 X = -PE(X) + IF (W(X) .EQ.WFLG) GOTO 55 + W(X) = WFLG + IF ( PE(X) .LT. 0 ) GOTO 53 + E = X + ENDIF + IF (ELEN(E).LT.0) THEN + NDENSE(E) = NDENSE(E) - NV(ME) + IW(LN) = IW(ELN) + IW(ELN) = E + LN = LN+1 + ELN = ELN + 1 + PME1 = PE(E) + DO 54 PME = PME1, PME1+LEN(E)-1 + X = IW(PME) + IF ((ELEN(X).GE.0).AND.(W(X).NE.WFLG)) THEN + NDENSE(ME) = NDENSE(ME) + NV(X) + W(X) = WFLG + ENDIF + 54 CONTINUE + ELSE + NDENSE(ME) = NDENSE(ME) + NV(E) + IW(LN)=E + LN = LN+1 + ENDIF + 55 CONTINUE + WFLG = WFLG + 1 + LEN(ME) = LN-P1 + ELEN(ME) = ELN- P1 + NDME = NDENSE(ME)+NV(ME) + MINDEN = min (MINDEN, NDME) + MAXDEN = max (MAXDEN, NDME) + IF (NDENSE(ME).EQ.0) NDENSE(ME) =1 + IF (IVersion.EQ.1) THEN + DEG = max (DEGREE(ME)-(TOTEL+1), 1) + ELSE + DEG = NDENSE(ME) + ENDIF + DEGREE(ME) = DEG + MINDEG = min(DEG,MINDEG) + JNEXT = HEAD(DEG) + IF (JNEXT.NE. 0) LAST (JNEXT) = ME + NEXT(ME) = JNEXT + HEAD(DEG) = ME + ME = INEXT + IF (ME.NE.0) THEN + IF (DEGREE(ME).GT.(TOTEL+1) ) GOTO 51 + ENDIF + HEAD (TOTEL) = ME + IF (IVersion .EQ.1 ) THEN + THRESM = TOTEL + ELSE + THRESM=max(THRESM*2,MINDEN+(MAXDEN-MINDEN)/2) + THRESM = min(THRESM,NBD) + IF (THRESM.GE.NBD) THRESM=TOTEL + ENDIF + NBD = NBED + GOTO 30 + ENDIF + IF (DEGREE(ME).EQ.TOTEL+1) THEN + IF (NBD.NE.NBED) THEN + write(6,*) ' Internal ERROR quasi dense rows remains' + CALL MUMPS_ABORT() + ENDIF + NELME = -(NEL+1) + DO 59 X=1,N + IF ((PE(X).GT.0) .AND. (ELEN(X).LT.0)) THEN + PE(X) = -ME + ELSEIF (DEGREE(X).EQ.TOTEL+1) THEN + NEL = NEL + NV(X) + PE(X) = -ME + ELEN(X) = 0 + NV(X) = 0 + ENDIF + 59 CONTINUE + ELEN(ME) = NELME + NV(ME) = NBD + PE(ME) = 0 + IF (NEL.NE.TOTEL) THEN + write(6,*) 'Internal ERROR 2 detected in QAMD' + write(6,*) ' NEL not equal to N: N, NEL =',N,NEL + CALL MUMPS_ABORT() + ENDIF + GOTO 265 + ENDIF + ENDIF + ELENME = ELEN (ME) + ELEN (ME) = - (NEL + 1) + NVPIV = NV (ME) + NEL = NEL + NVPIV + NDENSE(ME) = 0 + NV (ME) = -NVPIV + DEGME = 0 + IF (ELENME .EQ. 0) THEN + PME1 = PE (ME) + PME2 = PME1 - 1 + DO 60 P = PME1, PME1 + LEN (ME) - 1 + I = IW (P) + NVI = NV (I) + IF (NVI .GT. 0) THEN + DEGME = DEGME + NVI + NV (I) = -NVI + PME2 = PME2 + 1 + IW (PME2) = I + IF (DEGREE(I).LE.TOTEL) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (DEGREE (I)) = INEXT + ENDIF + ELSE + NDENSE(ME) = NDENSE(ME) + NVI + ENDIF + ENDIF + 60 CONTINUE + NEWMEM = 0 + ELSE + P = PE (ME) + PME1 = PFREE + SLENME = LEN (ME) - ELENME + DO 120 KNT1 = 1, ELENME + 1 + IF (KNT1 .GT. ELENME) THEN + E = ME + PJ = P + LN = SLENME + ELSE + E = IW (P) + P = P + 1 + PJ = PE (E) + LN = LEN (E) + ENDIF + DO 110 KNT2 = 1, LN + I = IW (PJ) + PJ = PJ + 1 + NVI = NV (I) + IF (NVI .GT. 0) THEN + IF (PFREE .GT. IWLEN) THEN + PE (ME) = P + LEN (ME) = LEN (ME) - KNT1 + IF (LEN (ME) .EQ. 0) PE (ME) = 0 + PE (E) = PJ + LEN (E) = LN - KNT2 + IF (LEN (E) .EQ. 0) PE (E) = 0 + NCMPA = NCMPA + 1 + DO 70 J = 1, N + PN = PE (J) + IF (PN .GT. 0) THEN + PE (J) = IW (PN) + IW (PN) = -J + ENDIF + 70 CONTINUE + PDST = 1 + PSRC = 1 + PEND = PME1 - 1 + 80 CONTINUE + IF (PSRC .LE. PEND) THEN + J = -IW (PSRC) + PSRC = PSRC + 1 + IF (J .GT. 0) THEN + IW (PDST) = PE (J) + PE (J) = PDST + PDST = PDST + 1 + LENJ = LEN (J) + DO 90 KNT3 = 0, LENJ - 2 + IW (PDST + KNT3) = IW (PSRC + KNT3) + 90 CONTINUE + PDST = PDST + LENJ - 1 + PSRC = PSRC + LENJ - 1 + ENDIF + GO TO 80 + ENDIF + P1 = PDST + DO 100 PSRC = PME1, PFREE - 1 + IW (PDST) = IW (PSRC) + PDST = PDST + 1 + 100 CONTINUE + PME1 = P1 + PFREE = PDST + PJ = PE (E) + P = PE (ME) + ENDIF + DEGME = DEGME + NVI + NV (I) = -NVI + IW (PFREE) = I + PFREE = PFREE + 1 + IF (DEGREE(I).LE.TOTEL) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (DEGREE (I)) = INEXT + ENDIF + ELSE + NDENSE(ME) = NDENSE(ME) + NVI + ENDIF + ENDIF + 110 CONTINUE + IF (E .NE. ME) THEN + PE (E) = -ME + W (E) = 0 + ENDIF + 120 CONTINUE + PME2 = PFREE - 1 + NEWMEM = PFREE - PME1 + MEM = MEM + NEWMEM + MAXMEM = max (MAXMEM, MEM) + ENDIF + DEGREE (ME) = DEGME + PE (ME) = PME1 + LEN (ME) = PME2 - PME1 + 1 + IF (WFLG .GT. MAXINT_N) THEN + DO 130 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 130 CONTINUE + WFLG = 2 + ENDIF + DO 150 PME = PME1, PME2 + I = IW (PME) + IF (DEGREE(I).GT.TOTEL) GOTO 150 + ELN = ELEN (I) + IF (ELN .GT. 0) THEN + NVI = -NV (I) + WNVI = WFLG - NVI + DO 140 P = PE (I), PE (I) + ELN - 1 + E = IW (P) + WE = W (E) + IF (WE .GE. WFLG) THEN + WE = WE - NVI + ELSE IF (WE .NE. 0) THEN + WE = DEGREE (E) + WNVI - NDENSE(E) + ENDIF + W (E) = WE + 140 CONTINUE + ENDIF + 150 CONTINUE + DO 180 PME = PME1, PME2 + I = IW (PME) + IF (DEGREE(I).GT.TOTEL) GOTO 180 + P1 = PE (I) + P2 = P1 + ELEN (I) - 1 + PN = P1 + HASH = 0_8 + DEG = 0 + DO 160 P = P1, P2 + E = IW (P) + DEXT = W (E) - WFLG + IF (DEXT .GT. 0) THEN + DEG = DEG + DEXT + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) +#if defined (NOAGG5) + ELSE IF (DEXT .EQ. 0) THEN + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) +#else + ELSE IF ((DEXT .EQ. 0) .AND. + & (NDENSE(ME).EQ.NBD)) THEN + PE (E) = -ME + W (E) = 0 + ELSE IF (DEXT.EQ.0) THEN + IW(PN) = E + PN = PN+1 + HASH = HASH + int(E,kind=8) +#endif + ENDIF + 160 CONTINUE + ELEN (I) = PN - P1 + 1 + P3 = PN + DO 170 P = P2 + 1, P1 + LEN (I) - 1 + J = IW (P) + NVJ = NV (J) + IF (NVJ .GT. 0) THEN + IF (DEGREE(J).LE.TOTEL) DEG=DEG+NVJ + IW (PN) = J + PN = PN + 1 + HASH = HASH + int(J,kind=8) + ENDIF + 170 CONTINUE +#if defined (NOAGG5) + IF (ELEN(I).EQ.1 .AND. P3.EQ.PN) THEN +#else + IF ((DEG .EQ. 0).AND.(NDENSE(ME).EQ.NBD)) THEN +#endif + PE (I) = -ME + NVI = -NV (I) + DEGME = DEGME - NVI + NVPIV = NVPIV + NVI + NEL = NEL + NVI + NV (I) = 0 + ELEN (I) = 0 + ELSE + DEGREE(I) = min (DEG+NBD-NDENSE(ME), + & DEGREE(I)) + IW (PN) = IW (P3) + IW (P3) = IW (P1) + IW (P1) = ME + LEN (I) = PN - P1 + 1 + HASH = mod (HASH, HMOD) + 1_8 + J = HEAD (HASH) + IF (J .LE. 0) THEN + NEXT (I) = -J + HEAD (HASH) = -I + ELSE + NEXT (I) = LAST (J) + LAST (J) = I + ENDIF + LAST (I) = int(HASH,kind=kind(LAST)) + ENDIF + 180 CONTINUE + DEGREE (ME) = DEGME + DMAX = max (DMAX, DEGME) + WFLG = WFLG + DMAX + IF (WFLG .GT. MAXINT_N) THEN + DO 190 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 190 CONTINUE + WFLG = 2 + ENDIF + DO 250 PME = PME1, PME2 + I = IW (PME) + IF ( (NV(I).LT.0) .AND. (DEGREE(I).LE.TOTEL) ) THEN + HASH = int(LAST (I),kind=8) + J = HEAD (HASH) + IF (J .EQ. 0) GO TO 250 + IF (J .LT. 0) THEN + I = -J + HEAD (HASH) = 0 + ELSE + I = LAST (J) + LAST (J) = 0 + ENDIF + IF (I .EQ. 0) GO TO 250 + 200 CONTINUE + IF (NEXT (I) .NE. 0) THEN + LN = LEN (I) + ELN = ELEN (I) + DO 210 P = PE (I) + 1, PE (I) + LN - 1 + W (IW (P)) = WFLG + 210 CONTINUE + JLAST = I + J = NEXT (I) + 220 CONTINUE + IF (J .NE. 0) THEN + IF (LEN (J) .NE. LN) GO TO 240 + IF (ELEN (J) .NE. ELN) GO TO 240 + DO 230 P = PE (J) + 1, PE (J) + LN - 1 + IF (W (IW (P)) .NE. WFLG) GO TO 240 + 230 CONTINUE + PE (J) = -I + NV (I) = NV (I) + NV (J) + NV (J) = 0 + ELEN (J) = 0 + J = NEXT (J) + NEXT (JLAST) = J + GO TO 220 + 240 CONTINUE + JLAST = J + J = NEXT (J) + GO TO 220 + ENDIF + WFLG = WFLG + 1 + I = NEXT (I) + IF (I .NE. 0) GO TO 200 + ENDIF + ENDIF + 250 CONTINUE + P = PME1 + NLEFT = TOTEL - NEL + DO 260 PME = PME1, PME2 + I = IW (PME) + NVI = -NV (I) + IF (NVI .GT. 0) THEN + NV (I) = NVI + IF (DEGREE(I).LE.TOTEL) THEN + DEG = min (DEGREE (I)+ DEGME - NVI, NLEFT - NVI) + DEGREE (I) = DEG + IDENSE = .FALSE. + IF ( (Iversion .NE. 1).AND. (THRESM.GE.0)) THEN + IF (DEG+NVI .GE. THRESM) THEN + IF (THRESM.EQ.TOTEL) THEN + IF ((ELEN(I).LE.2) .AND. ((DEG+NVI).EQ.NLEFT) ) THEN + DEGREE(I) = TOTEL+1 + IDENSE = .TRUE. + ENDIF + ELSE + IDENSE = .TRUE. + IF ((ELEN(I).LE.2).AND.((DEG+NVI).EQ.NLEFT) ) THEN + DEGREE(I) = TOTEL+1 + ELSE + DEGREE(I) = TOTEL+1+DEGREE(I) + ENDIF + ENDIF + ENDIF + IF (IDENSE) THEN + P1 = PE(I) + P2 = P1 + ELEN(I) - 1 + IF (P2.GE.P1) THEN + DO 264 PJ=P1,P2 + E= IW(PJ) + NDENSE (E) = NDENSE(E) + NVI + 264 CONTINUE + ENDIF + NBD = NBD+NVI + DEG = TOTEL + IF (DEGREE(I).EQ.TOTEL+1) THEN + NBED = NBED +NVI + IF (LASTD.EQ.0) THEN + LASTD = I + HEAD(DEG) = I + NEXT(I) = 0 + LAST(I) = 0 + ELSE + NEXT(LASTD) = I + LAST(I) = LASTD + LASTD = I + NEXT(I) = 0 + ENDIF + ELSE + INEXT = HEAD(DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + LAST(I) = 0 + IF (LASTD.EQ.0) LASTD=I + ENDIF + ENDIF + ENDIF + IF (.NOT.IDENSE) THEN + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + LAST (I) = 0 + HEAD (DEG) = I + ENDIF + MINDEG = min (MINDEG, DEG) + ENDIF + IW (P) = I + P = P + 1 + ENDIF + 260 CONTINUE + NV (ME) = NVPIV + DEGME + LEN (ME) = P - PME1 + IF (LEN (ME) .EQ. 0) THEN + PE (ME) = 0 + W (ME) = 0 + ENDIF + IF (NEWMEM .NE. 0) THEN + PFREE = P + MEM = MEM - NEWMEM + LEN (ME) + ENDIF + GO TO 30 + ENDIF + 265 CONTINUE + DO 290 I = 1, N + IF (ELEN (I) .EQ. 0) THEN + J = -PE (I) + 270 CONTINUE + IF (ELEN (J) .GE. 0) THEN + J = -PE (J) + GO TO 270 + ENDIF + E = J + K = -ELEN (E) + J = I + 280 CONTINUE + IF (ELEN (J) .GE. 0) THEN + JNEXT = -PE (J) + PE (J) = -E + IF (ELEN (J) .EQ. 0) THEN + ELEN (J) = K + K = K + 1 + ENDIF + J = JNEXT + GO TO 280 + ENDIF + ELEN (E) = -K + ENDIF + 290 CONTINUE + IF(COMPRESS) THEN + LAST(1:N) = 0 + DEGREE(1:TOTEL-N)=0 + DO I = 1, N + K = abs (ELEN (I)) + IF ( K <= N ) THEN + LAST (K) = I + ELSE + DEGREE(K-N)=I + ENDIF + ENDDO + I = 1 + DO K = 1, N + IF(LAST (K) .NE. 0) THEN + LAST(I) = LAST(K) + ELEN(LAST(K)) = I + I = I + 1 + ENDIF + ENDDO + DO K = N+1, TOTEL + IF (DEGREE(K-N) .NE. 0) THEN + LAST(I)=DEGREE(K-N) + ELEN(DEGREE(K-N)) = I + I = I + 1 + ENDIF + END DO + ELSE + DO 300 I = 1, N + K = abs (ELEN (I)) + LAST (K) = I + ELEN (I) = K + 300 CONTINUE + ENDIF + PFREE = MAXMEM + RETURN + END SUBROUTINE MUMPS_421 + SUBROUTINE MUMPS_560(N, NBBUCK, + & IWLEN, PE, PFREE, LEN, IW, NV, ELEN, + & LAST, NCMPA, DEGREE, WF, NEXT, W, HEAD, + & CONSTRAINT,THESON) + IMPLICIT NONE + INTEGER N, IWLEN, PFREE, LEN(N), + & ELEN(N), LAST(N), NCMPA, DEGREE(N), NEXT(N), + & W(N) + INTEGER PE(N), IW(IWLEN), NV(N) + INTEGER NBBUCK + INTEGER HEAD(0:NBBUCK+1), WF(N) + INTEGER CONSTRAINT(N),THESON(N) + INTEGER PREV,TOTO + INTEGER DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I, + & ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3, + & LENJ, LN, MAXMEM, ME, MEM, MINDEG, NEL, NEWMEM, + & NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X, + & NBFLAG, NREAL, LASTD, NELME, WF3, WF4, N2, PAS + INTEGER MAXINT_N + INTEGER(8) HASH, HMOD + DOUBLE PRECISION RMF, RMF1 + DOUBLE PRECISION dummy + INTEGER idummy + INTEGER P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, PN, PSRC + INTRINSIC max, min, mod, huge + INTEGER TOTEL + idummy = huge(idummy) - 1 + dummy = dble(idummy) + N2 = -NBBUCK-1 + PAS = max((N/8), 1) + WFLG = 2 + MAXINT_N=huge(WFLG)-N + NCMPA = 0 + NEL = 0 + HMOD = int(max (1, NBBUCK-1),kind=8) + DMAX = 0 + MEM = PFREE - 1 + MAXMEM = MEM + MINDEG = 0 + NBFLAG = 0 + LASTD = 0 + HEAD(0:NBBUCK+1) = 0 + DO 10 I = 1, N + THESON(I) = 0 + LAST (I) = 0 + W (I) = 1 + ELEN (I) = 0 + 10 CONTINUE + TOTEL = 0 + DO I=1,N + IF (LEN(I).LT.0) THEN + DEGREE (I) = N2 + NBFLAG = NBFLAG +1 + IF (LEN(I).EQ.-N-1) THEN + LEN (I) = 0 + PE (I) = 0 + ELSE + LEN (I) = - LEN(I) + ENDIF + ELSE + TOTEL = TOTEL + NV(I) + DEGREE(I) = 0 + DO J= PE(I) , PE(I)+LEN(I)-1 + DEGREE(I) = DEGREE(I) + NV(IW(J)) + ENDDO + ENDIF + ENDDO + NREAL = N - NBFLAG + DO 20 I = 1, N + DEG = DEGREE (I) + IF (DEG.EQ.N2) THEN + DEG = NBBUCK + 1 + IF (LASTD.EQ.0) THEN + LASTD = I + HEAD(DEG) = I + NEXT(I) = 0 + LAST(I) = 0 + ELSE + NEXT(LASTD) = I + LAST(I) = LASTD + LASTD = I + NEXT(I) = 0 + ENDIF + GOTO 20 + ENDIF + IF (DEG .GT. 0) THEN + WF(I) = DEG + IF (DEG.GT.N) THEN + DEG = min(((DEG-N)/PAS) + N , NBBUCK) + ENDIF + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + ELSE + NEL = NEL + NV(I) + ELEN (I) = -NEL + PE (I) = 0 + W (I) = 0 + ENDIF + 20 CONTINUE + NLEFT = TOTEL-NEL + 30 IF (NEL .LT. TOTEL) THEN + DO 40 DEG = MINDEG, NBBUCK + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 50 + 40 CONTINUE + 50 MINDEG = DEG + IF (ME.LE.0) THEN + NCMPA = -N + CALL MUMPS_ABORT() + ENDIF + IF (DEG.GT.N) THEN + J = NEXT(ME) + K = WF(ME) + IF(CONSTRAINT(ME) .LT. 0) THEN + K = -1 + ENDIF + 55 CONTINUE + IF (J.GT.0) THEN + IF(CONSTRAINT(J) .GE. 0) THEN + IF (WF(J).LT.K .OR. K .LT. 0) THEN + ME = J + K = WF(ME) + ENDIF + ENDIF + J= NEXT(J) + GOTO 55 + ENDIF + ILAST = LAST(ME) + INEXT = NEXT(ME) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (DEG) = INEXT + ENDIF + ELSE + IF(CONSTRAINT(ME) .GE. 0) GOTO 59 + 56 CONTINUE + IF(NEXT(ME) .NE. 0) THEN + ME = NEXT(ME) + IF(CONSTRAINT(ME) .GE. 0) THEN + GOTO 59 + ELSE + GOTO 56 + ENDIF + ELSE + 57 DEG = DEG+1 + ME = HEAD(DEG) + IF(ME .GT. 0) THEN + IF(CONSTRAINT(ME) .GE. 0) THEN + GOTO 59 + ELSE + GOTO 56 + ENDIF + ELSE + GOTO 57 + ENDIF + ENDIF + 59 PREV = LAST (ME) + INEXT = NEXT (ME) + IF(PREV .NE. 0) THEN + NEXT(PREV) = INEXT + ELSE + HEAD (DEG) = INEXT + ENDIF + IF (INEXT .NE. 0) LAST (INEXT) = PREV + ENDIF + TOTO = ME + 5910 IF(TOTO .NE. 0) THEN + J = CONSTRAINT(TOTO) + IF(J .GT. 0) THEN + CONSTRAINT(J) = 0 + ENDIF + TOTO = THESON(TOTO) + GOTO 5910 + ENDIF + ELENME = ELEN (ME) + ELEN (ME) = - (NEL + 1) + NVPIV = NV (ME) + NEL = NEL + NVPIV + NV (ME) = -NVPIV + DEGME = 0 + IF (ELENME .EQ. 0) THEN + PME1 = PE (ME) + PME2 = PME1 - 1 + DO 60 P = PME1, PME1 + LEN (ME) - 1 + I = IW (P) + NVI = NV (I) + IF (NVI .GT. 0) THEN + DEGME = DEGME + NVI + NV (I) = -NVI + PME2 = PME2 + 1 + IW (PME2) = I + IF (DEGREE(I).NE.N2) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + IF (WF(I).GT.N) THEN + DEG = min(((WF(I)-N)/PAS) + N , NBBUCK) + ELSE + DEG = WF(I) + ENDIF + HEAD (DEG) = INEXT + ENDIF + ENDIF + ENDIF + 60 CONTINUE + NEWMEM = 0 + ELSE + P = PE (ME) + PME1 = PFREE + SLENME = LEN (ME) - ELENME + DO 120 KNT1 = 1, ELENME + 1 + IF (KNT1 .GT. ELENME) THEN + E = ME + PJ = P + LN = SLENME + ELSE + E = IW (P) + P = P + 1 + PJ = PE (E) + LN = LEN (E) + ENDIF + DO 110 KNT2 = 1, LN + I = IW (PJ) + PJ = PJ + 1 + NVI = NV (I) + IF (NVI .GT. 0) THEN + IF (PFREE .GT. IWLEN) THEN + PE (ME) = P + LEN (ME) = LEN (ME) - KNT1 + IF (LEN (ME) .EQ. 0) PE (ME) = 0 + PE (E) = PJ + LEN (E) = LN - KNT2 + IF (LEN (E) .EQ. 0) PE (E) = 0 + NCMPA = NCMPA + 1 + DO 70 J = 1, N + PN = PE (J) + IF (PN .GT. 0) THEN + PE (J) = IW (PN) + IW (PN) = -J + ENDIF + 70 CONTINUE + PDST = 1 + PSRC = 1 + PEND = PME1 - 1 + 80 CONTINUE + IF (PSRC .LE. PEND) THEN + J = -IW (PSRC) + PSRC = PSRC + 1 + IF (J .GT. 0) THEN + IW (PDST) = PE (J) + PE (J) = PDST + PDST = PDST + 1 + LENJ = LEN (J) + DO 90 KNT3 = 0, LENJ - 2 + IW (PDST + KNT3) = IW (PSRC + KNT3) + 90 CONTINUE + PDST = PDST + LENJ - 1 + PSRC = PSRC + LENJ - 1 + ENDIF + GO TO 80 + ENDIF + P1 = PDST + DO 100 PSRC = PME1, PFREE - 1 + IW (PDST) = IW (PSRC) + PDST = PDST + 1 + 100 CONTINUE + PME1 = P1 + PFREE = PDST + PJ = PE (E) + P = PE (ME) + ENDIF + DEGME = DEGME + NVI + NV (I) = -NVI + IW (PFREE) = I + PFREE = PFREE + 1 + IF (DEGREE(I).NE.N2) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + IF (WF(I).GT.N) THEN + DEG = min(((WF(I)-N)/PAS) + N , NBBUCK) + ELSE + DEG = WF(I) + ENDIF + HEAD (DEG) = INEXT + ENDIF + ENDIF + ENDIF + 110 CONTINUE + IF (E .NE. ME) THEN + PE (E) = -ME + W (E) = 0 + ENDIF + 120 CONTINUE + PME2 = PFREE - 1 + NEWMEM = PFREE - PME1 + MEM = MEM + NEWMEM + MAXMEM = max (MAXMEM, MEM) + ENDIF + DEGREE (ME) = DEGME + PE (ME) = PME1 + LEN (ME) = PME2 - PME1 + 1 + IF (WFLG .GT. MAXINT_N) THEN + DO 130 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 130 CONTINUE + WFLG = 2 + ENDIF + DO 150 PME = PME1, PME2 + I = IW (PME) + ELN = ELEN (I) + IF (ELN .GT. 0) THEN + NVI = -NV (I) + WNVI = WFLG - NVI + DO 140 P = PE (I), PE (I) + ELN - 1 + E = IW (P) + WE = W (E) + IF (WE .GE. WFLG) THEN + WE = WE - NVI + ELSE IF (WE .NE. 0) THEN + WE = DEGREE (E) + WNVI + WF(E) = 0 + ENDIF + W (E) = WE + 140 CONTINUE + ENDIF + 150 CONTINUE + DO 180 PME = PME1, PME2 + I = IW (PME) + P1 = PE (I) + P2 = P1 + ELEN (I) - 1 + PN = P1 + HASH = 0_8 + DEG = 0 + WF3 = 0 + WF4 = 0 + NVI = -NV(I) + DO 160 P = P1, P2 + E = IW (P) + DEXT = W (E) - WFLG + IF (DEXT .GT. 0) THEN + IF ( WF(E) .EQ. 0 ) THEN + WF(E) = DEXT * ( (2 * DEGREE(E)) - DEXT - 1) + ENDIF + WF4 = WF4 + WF(E) + DEG = DEG + DEXT + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) + ELSE IF (DEXT .EQ. 0) THEN +#if defined (NOAGG4) + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) +#else + PE (E) = -ME + W (E) = 0 +#endif + ENDIF + 160 CONTINUE + ELEN (I) = PN - P1 + 1 + P3 = PN + DO 170 P = P2 + 1, P1 + LEN (I) - 1 + J = IW (P) + NVJ = NV (J) + IF (NVJ .GT. 0) THEN + DEG = DEG + NVJ + WF3 = WF3 + NVJ + IW (PN) = J + PN = PN + 1 + HASH = HASH + int(J,kind=8) + ENDIF + 170 CONTINUE + IF (DEGREE(I).EQ.N2) DEG = N2 +#if defined (NOAGG4) + IF (ELEN(I).EQ.1 .AND. P3.EQ.PN) THEN +#else + IF (DEG .EQ. 0) THEN +#endif + PE (I) = -ME + NVI = -NV (I) + DEGME = DEGME - NVI + NVPIV = NVPIV + NVI + NEL = NEL + NVI + NV (I) = 0 + ELEN (I) = 0 + ELSE + IF (DEGREE(I).NE.N2) THEN + IF ( DEGREE (I).LT.DEG ) THEN + WF4 = 0 + WF3 = 0 + ELSE + DEGREE(I) = DEG + ENDIF + ENDIF + WF(I) = WF4 + 2*NVI*WF3 + IW (PN) = IW (P3) + IW (P3) = IW (P1) + IW (P1) = ME + LEN (I) = PN - P1 + 1 + IF (DEG.NE.N2) THEN + HASH = mod (HASH, HMOD) + 1_8 + J = HEAD (HASH) + IF (J .LE. 0) THEN + NEXT (I) = -J + HEAD (HASH) = -I + ELSE + NEXT (I) = LAST (J) + LAST (J) = I + ENDIF + LAST (I) = int(HASH,kind=kind(LAST)) + ENDIF + ENDIF + 180 CONTINUE + DEGREE (ME) = DEGME + DMAX = max (DMAX, DEGME) + WFLG = WFLG + DMAX + IF (WFLG .GT. MAXINT_N) THEN + DO 190 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 190 CONTINUE + WFLG = 2 + ENDIF + DO 250 PME = PME1, PME2 + I = IW (PME) + IF ( (NV (I) .LT. 0) .AND. (DEGREE(I).NE.N2) ) THEN + HASH = int(LAST (I),kind=8) + J = HEAD (HASH) + IF (J .EQ. 0) GO TO 250 + IF (J .LT. 0) THEN + I = -J + HEAD (HASH) = 0 + ELSE + I = LAST (J) + LAST (J) = 0 + ENDIF + IF (I .EQ. 0) GO TO 250 + 200 CONTINUE + IF (NEXT (I) .NE. 0) THEN + LN = LEN (I) + ELN = ELEN (I) + DO 210 P = PE (I) + 1, PE (I) + LN - 1 + W (IW (P)) = WFLG + 210 CONTINUE + JLAST = I + J = NEXT (I) + 220 CONTINUE + IF (J .NE. 0) THEN + IF(CONSTRAINT(J) .LT. 0 + & .AND. CONSTRAINT(I) .LT. 0) THEN + GOTO 240 + ENDIF + IF(CONSTRAINT(I) .GE. 0) THEN + IF(CONSTRAINT(J) .LT. 0) THEN + TOTO = I + 221 IF(TOTO .NE. 0) THEN + IF(CONSTRAINT(TOTO) .EQ. J) THEN + GOTO 225 + ENDIF + TOTO =THESON(TOTO) + GOTO 221 + ENDIF + ELSE + GOTO 225 + ENDIF + ELSE + IF(CONSTRAINT(J) .GE. 0) THEN + TOTO = J + 222 IF(TOTO .NE. 0) THEN + IF(CONSTRAINT(TOTO) .EQ. I) THEN + GOTO 225 + ENDIF + TOTO =THESON(TOTO) + GOTO 222 + ENDIF + ENDIF + ENDIF + GOTO 240 + 225 CONTINUE + IF (LEN (J) .NE. LN) GO TO 240 + IF (ELEN (J) .NE. ELN) GO TO 240 + DO 230 P = PE (J) + 1, PE (J) + LN - 1 + IF (W (IW (P)) .NE. WFLG) GO TO 240 + 230 CONTINUE + TOTO = I + 231 IF(THESON(TOTO) .NE. 0) THEN + TOTO = THESON(TOTO) + GOTO 231 + ENDIF + THESON(TOTO) = J + IF(CONSTRAINT(I) .LT. 0) THEN + CONSTRAINT(I) = 0 + ENDIF + PE (J) = -I + WF(I) = max(WF(I),WF(J)) + NV (I) = NV (I) + NV (J) + NV (J) = 0 + ELEN (J) = 0 + J = NEXT (J) + NEXT (JLAST) = J + GO TO 220 + 240 CONTINUE + JLAST = J + J = NEXT (J) + GO TO 220 + ENDIF + WFLG = WFLG + 1 + I = NEXT (I) + IF (I .NE. 0) GO TO 200 + ENDIF + ENDIF + 250 CONTINUE + P = PME1 + NLEFT = TOTEL - NEL + DO 260 PME = PME1, PME2 + I = IW (PME) + NVI = -NV (I) + IF (NVI .GT. 0) THEN + NV (I) = NVI + IF (DEGREE(I).NE.N2) THEN + DEG = min (DEGREE (I) + DEGME - NVI, NLEFT - NVI) + IF (DEGREE (I) + DEGME .GT. NLEFT ) THEN + DEG = DEGREE(I) + RMF1 = dble(DEG)*dble( (DEG-1) + 2*DEGME ) + & - dble(WF(I)) + DEGREE(I) = NLEFT - NVI + DEG = DEGREE(I) + RMF = dble(DEG)*dble(DEG-1) + & - dble(DEGME-NVI)*dble(DEGME-NVI-1) + RMF = min(RMF, RMF1) + ELSE + DEG = DEGREE(I) + DEGREE(I) = DEGREE (I) + DEGME - NVI + RMF = dble(DEG)*dble( (DEG-1) + 2*DEGME ) + & - dble(WF(I)) + ENDIF + RMF = RMF / dble(NVI+1) + IF (RMF.LT.dummy) THEN + WF(I) = int ( anint( RMF )) + ELSEIF (RMF / dble(N) .LT. dummy) THEN + WF(I) = int ( anint( RMF/dble(N) )) + ELSE + WF(I) = idummy + ENDIF + WF(I) = max(1,WF(I)) + DEG = WF(I) + IF (DEG.GT.N) THEN + DEG = min(((DEG-N)/PAS) + N , NBBUCK) + ENDIF + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + LAST (I) = 0 + HEAD (DEG) = I + MINDEG = min (MINDEG, DEG) + ENDIF + IW (P) = I + P = P + 1 + ENDIF + 260 CONTINUE + NV (ME) = NVPIV + DEGME + LEN (ME) = P - PME1 + IF (LEN (ME) .EQ. 0) THEN + PE (ME) = 0 + W (ME) = 0 + ENDIF + IF (NEWMEM .NE. 0) THEN + PFREE = P + MEM = MEM - NEWMEM + LEN (ME) + ENDIF + GO TO 30 + ENDIF + IF (NEL.LT.N) THEN + DO DEG = MINDEG, NBBUCK+1 + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 51 + ENDDO + 51 MINDEG = DEG + NELME = -(NEL+1) + DO X=1,N + IF ((PE(X).GT.0) .AND. (ELEN(X).LT.0)) THEN + PE(X) = -ME + ELSEIF (DEGREE(X).EQ.N2) THEN + NEL = NEL + NV(X) + PE(X) = -ME + ELEN(X) = 0 + NV(X) = 0 + ENDIF + ENDDO + ELEN(ME) = NELME + NV(ME) = N-NREAL + PE(ME) = 0 + IF (NEL.NE.N) THEN + NCMPA = -N - 1 + GOTO 500 + ENDIF + ENDIF + DO 290 I = 1, N + IF (ELEN (I) .EQ. 0) THEN + J = -PE (I) + 270 CONTINUE + IF (ELEN (J) .GE. 0) THEN + J = -PE (J) + GO TO 270 + ENDIF + E = J + K = -ELEN (E) + J = I + 280 CONTINUE + IF (ELEN (J) .GE. 0) THEN + JNEXT = -PE (J) + PE (J) = -E + IF (ELEN (J) .EQ. 0) THEN + ELEN (J) = K + K = K + 1 + ENDIF + J = JNEXT + GO TO 280 + ENDIF + ELEN (E) = -K + ENDIF + 290 CONTINUE + IF(.TRUE.) THEN + LAST(1:N) = 0 + DEGREE(1:TOTEL-N)=0 + DO I = 1, N + K = abs (ELEN (I)) + IF ( K <= N ) THEN + LAST (K) = I + ELSE + DEGREE(K-N)=I + ENDIF + ENDDO + I = 1 + DO K = 1, N + IF(LAST (K) .NE. 0) THEN + LAST(I) = LAST(K) + ELEN(LAST(K)) = I + I = I + 1 + ENDIF + ENDDO + DO K = N+1, TOTEL + IF (DEGREE(K-N) .NE. 0) THEN + LAST(I)=DEGREE(K-N) + ELEN(DEGREE(K-N)) = I + I = I + 1 + ENDIF + END DO + ELSE + DO 300 I = 1, N + K = abs (ELEN (I)) + LAST (K) = I + ELEN (I) = K +300 CONTINUE + ENDIF + 500 PFREE = MAXMEM + RETURN + END SUBROUTINE MUMPS_560 + SUBROUTINE MUMPS_422 + & ( THRESH, NDENSE, + & N, IWLEN, PE, PFREE, LEN, IW, NV, + & ELEN, LAST, NCMPA, DEGREE, HEAD, NEXT, W, + & PERM, LISTVAR_SCHUR, SIZE_SCHUR, AGG6 ) + IMPLICIT NONE + INTEGER N, IWLEN, PE(N), PFREE, LEN(N), IW(IWLEN), NV(N), + & ELEN(N), LAST(N), NCMPA, DEGREE(N), HEAD(N), NEXT(N), + & W(N), SIZE_SCHUR + LOGICAL AGG6 + INTEGER NDENSE(N), LISTVAR_SCHUR(max(1,SIZE_SCHUR)) + INTEGER PERM(N) + INTEGER THRESH + INTEGER THRESM, NDME, PERMeqN + INTEGER NBD,NBED, NBDM, LASTD, NELME + LOGICAL IDENSE + INTEGER FDEG, ThresMin, ThresPrev, IBEGSchur, NbSchur, + & ThresMinINIT + LOGICAL SchurON + INTEGER DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I, + & ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3, + & LENJ, LN, MAXMEM, ME, MEM, MINDEG, NEL, NEWMEM, + & NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X + INTEGER MAXINT_N + INTEGER(8) HASH, HMOD + INTEGER P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, PN, PSRC + INTRINSIC max, min, mod + IF (N.EQ.1) THEN + ELEN(1) = 1 + LAST(1) = 1 + PE(1) = 0 + NV(1) = 1 + NCMPA = 0 + RETURN + ENDIF + SIZE_SCHUR = min(N,SIZE_SCHUR) + SIZE_SCHUR = max(0,SIZE_SCHUR) + SchurON = (SIZE_SCHUR > 0) + IBEGSchur = N-SIZE_SCHUR+1 + IF (THRESH.GT.N) THRESH = N + IF (THRESH.LT.0) THRESH = 0 + IF ( SchurON ) THEN + DO I= 1, N + IF ( PERM(I) .GE. IBEGSchur) THEN + PERM(I) = N + 1 + IF (LEN(I) .EQ.0) THEN + PE(I) = 0 + ENDIF + ENDIF + ENDDO + ENDIF + IF (SchurON) THEN + THRESM = N + ThresMin = N + ThresPrev = N + ELSE + THRESM = max(int(31*N/32),THRESH) + THRESM = max(THRESM,1) + ThresMin = max( 3*THRESM / 4, 1) + ThresPrev = THRESM + ENDIF + ThresMinINIT = ThresMin/4 + IF (THRESM.GT.0) THEN + IF ((THRESM.GT.N).OR.(THRESM.LT.2)) THEN + THRESM = N + ENDIF + ENDIF + LASTD = 0 + NBD = 0 + NBED = 0 + NBDM = 0 + WFLG = 2 + MAXINT_N=huge(WFLG)-N + MINDEG = 1 + NCMPA = 0 + NEL = 0 + HMOD = int(max (1, N-1),kind=8) + DMAX = 0 + MEM = PFREE - 1 + MAXMEM = MEM + DO 10 I = 1, N + NDENSE(I)= 0 + LAST (I) = 0 + HEAD (I) = 0 + NV (I) = 1 + W (I) = 1 + ELEN (I) = 0 + DEGREE (I) = LEN (I) + 10 CONTINUE + DO 20 I = 1, N + DEG = DEGREE (I) + IF (PERM(I).EQ.N) THEN + PERMeqN = I + PERM(I) = N-1 + ENDIF + FDEG = PERM(I) + IF ( (DEG .GT. 0).OR.(PERM(I).EQ.N+1) ) THEN + IF ( (THRESM.GT.0) .AND. + & (FDEG .GT.THRESM) ) THEN + NBD = NBD+1 + IF (FDEG.NE.N+1) THEN + DEGREE(I) = DEGREE(I)+N+2 + DEG = N + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + LAST(I) = 0 + IF (LASTD.EQ.0) LASTD=I + ELSE + NBED = NBED+1 + DEGREE(I) = N+1 + DEG = N + IF (LASTD.EQ.0) THEN + LASTD = I + HEAD(DEG) = I + NEXT(I) = 0 + LAST(I) = 0 + ELSE + NEXT(LASTD) = I + LAST(I) = LASTD + LASTD = I + NEXT(I) = 0 + ENDIF + ENDIF + ELSE + INEXT = HEAD (FDEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (FDEG) = I + ENDIF + ELSE + NEL = NEL + 1 + ELEN (I) = -NEL + PE (I) = 0 + W (I) = 0 + ENDIF + 20 CONTINUE + IF ((NBD.EQ.0).AND.(THRESM.GT.0)) THRESM = N + 30 IF (NEL .LT. N) THEN + DO 40 DEG = MINDEG, N + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 50 + 40 CONTINUE + 50 MINDEG = DEG + IF ( (DEG.NE.N) .AND. + & (DEG.GT.THRESM+1) .AND. (NBD.GT.0) ) THEN + MINDEG = N + GOTO 30 + ENDIF + IF (DEGREE(ME).LE.N) THEN + INEXT = NEXT (ME) + IF (INEXT .NE. 0) LAST (INEXT) = 0 + HEAD (DEG) = INEXT + ELSE + MINDEG = 1 + NBDM = max(NBDM,NBD) + IF (DEGREE(ME).GT.N+1) THEN + IF (WFLG .GT. MAXINT_N) THEN + DO 52 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 52 CONTINUE + WFLG = 2 + ENDIF + WFLG = WFLG + 1 + 51 CONTINUE + INEXT = NEXT (ME) + IF (INEXT .NE. 0) THEN + LAST (INEXT) = 0 + ELSE + LASTD = 0 + ENDIF + NDENSE(ME) = 0 + W(ME) = WFLG + P1 = PE(ME) + P2 = P1 + LEN(ME) -1 + LN = P1 + ELN = P1 + DO 55 P=P1,P2 + E= IW(P) + IF (W(E).EQ.WFLG) GOTO 55 + W(E) = WFLG + IF (PE(E).LT.0) THEN + X = E + 53 X = -PE(X) + IF (W(X) .EQ.WFLG) GOTO 55 + W(X) = WFLG + IF ( PE(X) .LT. 0 ) GOTO 53 + E = X + ENDIF + IF (ELEN(E).LT.0) THEN + NDENSE(E) = NDENSE(E) - NV(ME) + IW(LN) = IW(ELN) + IW(ELN) = E + LN = LN+1 + ELN = ELN + 1 + PME1 = PE(E) + DO 54 PME = PME1, PME1+LEN(E)-1 + X = IW(PME) + IF ((ELEN(X).GE.0).AND.(W(X).NE.WFLG)) THEN + NDENSE(ME) = NDENSE(ME) + NV(X) + W(X) = WFLG + ENDIF + 54 CONTINUE + ELSE + NDENSE(ME) = NDENSE(ME) + NV(E) + IW(LN)=E + LN = LN+1 + ENDIF + 55 CONTINUE + WFLG = WFLG + 1 + LEN(ME) = LN-P1 + ELEN(ME) = ELN- P1 + NDME = NDENSE(ME)+NV(ME) + IF (NDENSE(ME).EQ.0) NDENSE(ME) =1 + DEGREE(ME) = NDENSE(ME) + DEG = PERM(ME) + MINDEG = min(DEG,MINDEG) + JNEXT = HEAD(DEG) + IF (JNEXT.NE. 0) LAST (JNEXT) = ME + NEXT(ME) = JNEXT + HEAD(DEG) = ME + ME = INEXT + IF (ME.NE.0) THEN + IF (DEGREE(ME).GT.(N+1) ) GOTO 51 + ENDIF + HEAD (N) = ME + IF (THRESM.LT.N) THEN + ThresMin = max(THRESM+ThresMin,ThresPrev+ThresMin/2+1) + ThresMin = min(ThresMin, N) + ThresPrev = ThresPrev+(N-ThresPrev)/2+ThresMinINIT + THRESM = max( + & THRESM + int(sqrt(dble(ThresMin)))+ ThresMinINIT , + & ThresPrev) + THRESM = min(THRESM,N) + ThresMin = min(THRESM, ThresMin) + ThresPrev = THRESM + ENDIF + NBD = NBED + GOTO 30 + ENDIF + IF (DEGREE(ME).EQ.N+1) THEN + IF (NBD.NE.NBED) THEN + write(6,*) ' ERROR in MUMPS_422 quasi dense rows remains' + CALL MUMPS_ABORT() + ENDIF + NbSchur = 0 + NELME = -(NEL+1) + DO 59 X=1,N + IF ((PE(X).GT.0) .AND. (ELEN(X).LT.0)) THEN + PE(X) = -LISTVAR_SCHUR(1) + ELSE IF ((PE(X).GT.0) .AND. (ELEN(X).LT.0)) THEN + PE(X) = -LISTVAR_SCHUR(1) + ELSEIF (DEGREE(X).EQ.N+1) THEN + NEL = NEL + NV(X) + PE(X) = -ME + ELEN(X) = 0 + NV(X) = 0 + NbSchur = NbSchur+ 1 + ENDIF + 59 CONTINUE + IF (NbSchur.NE.SIZE_SCHUR) then + write(6,*) ' Internal error 2 in QAMD :', + & ' Schur size expected:',SIZE_SCHUR, 'Real:', NbSchur + CALL MUMPS_ABORT() + ENDIF + ELEN(ME) = NELME + NV(ME) = NBD + PE(ME) = 0 + IF (NEL.NE.N) THEN + write(6,*) 'Internal ERROR 2 detected in QAMD' + write(6,*) ' NEL not equal to N: N, NEL =',N,NEL + CALL MUMPS_ABORT() + ENDIF + IF (ME.NE. LISTVAR_SCHUR(1)) THEN + DO I=1, SIZE_SCHUR + PE(LISTVAR_SCHUR(I)) = -LISTVAR_SCHUR(1) + ENDDO + PE(LISTVAR_SCHUR(1)) = 0 + NV( LISTVAR_SCHUR(1))= NV(ME) + NV(ME) = 0 + ELEN( LISTVAR_SCHUR(1)) = ELEN(ME) + ELEN(ME) = 0 + ENDIF + GOTO 265 + ENDIF + ENDIF + ELENME = ELEN (ME) + ELEN (ME) = - (NEL + 1) + NVPIV = NV (ME) + NEL = NEL + NVPIV + NDENSE(ME) = 0 + NV (ME) = -NVPIV + DEGME = 0 + IF (ELENME .EQ. 0) THEN + PME1 = PE (ME) + PME2 = PME1 - 1 + DO 60 P = PME1, PME1 + LEN (ME) - 1 + I = IW (P) + NVI = NV (I) + IF (NVI .GT. 0) THEN + DEGME = DEGME + NVI + NV (I) = -NVI + PME2 = PME2 + 1 + IW (PME2) = I + IF (DEGREE(I).LE.N) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (PERM(I)) = INEXT + ENDIF + ELSE + NDENSE(ME) = NDENSE(ME) + NVI + ENDIF + ENDIF + 60 CONTINUE + NEWMEM = 0 + ELSE + P = PE (ME) + PME1 = PFREE + SLENME = LEN (ME) - ELENME + DO 120 KNT1 = 1, ELENME + 1 + IF (KNT1 .GT. ELENME) THEN + E = ME + PJ = P + LN = SLENME + ELSE + E = IW (P) + P = P + 1 + PJ = PE (E) + LN = LEN (E) + ENDIF + DO 110 KNT2 = 1, LN + I = IW (PJ) + PJ = PJ + 1 + NVI = NV (I) + IF (NVI .GT. 0) THEN + IF (PFREE .GT. IWLEN) THEN + PE (ME) = P + LEN (ME) = LEN (ME) - KNT1 + IF (LEN (ME) .EQ. 0) PE (ME) = 0 + PE (E) = PJ + LEN (E) = LN - KNT2 + IF (LEN (E) .EQ. 0) PE (E) = 0 + NCMPA = NCMPA + 1 + DO 70 J = 1, N + PN = PE (J) + IF (PN .GT. 0) THEN + PE (J) = IW (PN) + IW (PN) = -J + ENDIF + 70 CONTINUE + PDST = 1 + PSRC = 1 + PEND = PME1 - 1 + 80 CONTINUE + IF (PSRC .LE. PEND) THEN + J = -IW (PSRC) + PSRC = PSRC + 1 + IF (J .GT. 0) THEN + IW (PDST) = PE (J) + PE (J) = PDST + PDST = PDST + 1 + LENJ = LEN (J) + DO 90 KNT3 = 0, LENJ - 2 + IW (PDST + KNT3) = IW (PSRC + KNT3) + 90 CONTINUE + PDST = PDST + LENJ - 1 + PSRC = PSRC + LENJ - 1 + ENDIF + GO TO 80 + ENDIF + P1 = PDST + DO 100 PSRC = PME1, PFREE - 1 + IW (PDST) = IW (PSRC) + PDST = PDST + 1 + 100 CONTINUE + PME1 = P1 + PFREE = PDST + PJ = PE (E) + P = PE (ME) + ENDIF + DEGME = DEGME + NVI + NV (I) = -NVI + IW (PFREE) = I + PFREE = PFREE + 1 + IF (DEGREE(I).LE.N) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (PERM(I)) = INEXT + ENDIF + ELSE + NDENSE(ME) = NDENSE(ME) + NVI + ENDIF + ENDIF + 110 CONTINUE + IF (E .NE. ME) THEN + PE (E) = -ME + W (E) = 0 + ENDIF + 120 CONTINUE + PME2 = PFREE - 1 + NEWMEM = PFREE - PME1 + MEM = MEM + NEWMEM + MAXMEM = max (MAXMEM, MEM) + ENDIF + DEGREE (ME) = DEGME + PE (ME) = PME1 + LEN (ME) = PME2 - PME1 + 1 + IF (WFLG .GT. MAXINT_N) THEN + DO 130 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 130 CONTINUE + WFLG = 2 + ENDIF + DO 150 PME = PME1, PME2 + I = IW (PME) + IF (DEGREE(I).GT.N) GOTO 150 + ELN = ELEN (I) + IF (ELN .GT. 0) THEN + NVI = -NV (I) + WNVI = WFLG - NVI + DO 140 P = PE (I), PE (I) + ELN - 1 + E = IW (P) + WE = W (E) + IF (WE .GE. WFLG) THEN + WE = WE - NVI + ELSE IF (WE .NE. 0) THEN + WE = DEGREE (E) + WNVI - NDENSE(E) + ENDIF + W (E) = WE + 140 CONTINUE + ENDIF + 150 CONTINUE + DO 180 PME = PME1, PME2 + I = IW (PME) + IF (DEGREE(I).GT.N) GOTO 180 + P1 = PE (I) + P2 = P1 + ELEN (I) - 1 + PN = P1 + HASH = 0_8 + DEG = 0 + DO 160 P = P1, P2 + E = IW (P) + DEXT = W (E) - WFLG + IF (DEXT .GT. 0) THEN + DEG = DEG + DEXT + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) + ELSE IF (.NOT. AGG6 .AND. DEXT .EQ. 0) THEN + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) + ELSE IF (AGG6 .AND. (DEXT .EQ. 0) .AND. + & ((NDENSE(ME).EQ.NBD).OR.(NDENSE(E).EQ.0))) THEN + PE (E) = -ME + W (E) = 0 + ELSE IF (AGG6 .AND. DEXT.EQ.0) THEN + IW(PN) = E + PN = PN+1 + HASH = HASH + int(E,kind=8) + ENDIF + 160 CONTINUE + ELEN (I) = PN - P1 + 1 + P3 = PN + DO 170 P = P2 + 1, P1 + LEN (I) - 1 + J = IW (P) + NVJ = NV (J) + IF (NVJ .GT. 0) THEN + IF (DEGREE(J).LE.N) DEG=DEG+NVJ + IW (PN) = J + PN = PN + 1 + HASH = HASH + int(J,kind=8) + ENDIF + 170 CONTINUE + IF (((ELEN(I).EQ.1).AND.(P3.EQ.PN)) + & .OR. + & (AGG6.AND.(DEG .EQ. 0).AND.(NDENSE(ME).EQ.NBD)) + & ) + & THEN + PE (I) = -ME + NVI = -NV (I) + DEGME = DEGME - NVI + NVPIV = NVPIV + NVI + NEL = NEL + NVI + NV (I) = 0 + ELEN (I) = 0 + ELSE + DEGREE(I) = min (DEG+NBD-NDENSE(ME), + & DEGREE(I)) + IW (PN) = IW (P3) + IW (P3) = IW (P1) + IW (P1) = ME + LEN (I) = PN - P1 + 1 + HASH = mod (HASH, HMOD) + 1_8 + J = HEAD (HASH) + IF (J .LE. 0) THEN + NEXT (I) = -J + HEAD (HASH) = -I + ELSE + NEXT (I) = LAST (J) + LAST (J) = I + ENDIF + LAST (I) = int(HASH,kind=kind(LAST)) + ENDIF + 180 CONTINUE + DEGREE (ME) = DEGME + DMAX = max (DMAX, DEGME) + WFLG = WFLG + DMAX + IF (WFLG .GT. MAXINT_N) THEN + DO 190 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 190 CONTINUE + WFLG = 2 + ENDIF + DO 250 PME = PME1, PME2 + I = IW (PME) + IF ( (NV(I).LT.0) .AND. (DEGREE(I).LE.N) ) THEN + HASH = int(LAST (I),kind=8) + J = HEAD (HASH) + IF (J .EQ. 0) GO TO 250 + IF (J .LT. 0) THEN + I = -J + HEAD (HASH) = 0 + ELSE + I = LAST (J) + LAST (J) = 0 + ENDIF + IF (I .EQ. 0) GO TO 250 + 200 CONTINUE + IF (NEXT (I) .NE. 0) THEN + X = I + LN = LEN (I) + ELN = ELEN (I) + DO 210 P = PE (I) + 1, PE (I) + LN - 1 + W (IW (P)) = WFLG + 210 CONTINUE + JLAST = I + J = NEXT (I) + 220 CONTINUE + IF (J .NE. 0) THEN + IF (LEN (J) .NE. LN) GO TO 240 + IF (ELEN (J) .NE. ELN) GO TO 240 + DO 230 P = PE (J) + 1, PE (J) + LN - 1 + IF (W (IW (P)) .NE. WFLG) GO TO 240 + 230 CONTINUE + IF (PERM(J).GT.PERM(X)) THEN + PE (J) = -X + NV (X) = NV (X) + NV (J) + NV (J) = 0 + ELEN (J) = 0 + ELSE + PE (X) = -J + NV (J) = NV (X) + NV (J) + NV (X) = 0 + ELEN (X) = 0 + X = J + ENDIF + J = NEXT (J) + NEXT (JLAST) = J + GO TO 220 + 240 CONTINUE + JLAST = J + J = NEXT (J) + GO TO 220 + ENDIF + WFLG = WFLG + 1 + I = NEXT (I) + IF (I .NE. 0) GO TO 200 + ENDIF + ENDIF + 250 CONTINUE + IF ( (THRESM .GT. 0).AND.(THRESM.LT.N) ) THEN + THRESM = max(ThresMin, THRESM-NVPIV) + ENDIF + P = PME1 + NLEFT = N - NEL + DO 260 PME = PME1, PME2 + I = IW (PME) + NVI = -NV (I) + IF (NVI .GT. 0) THEN + NV (I) = NVI + IF (DEGREE(I).LE.N) THEN + DEG = min (DEGREE (I)+ DEGME - NVI, NLEFT - NVI) + DEGREE (I) = DEG + IDENSE = .FALSE. + IF (THRESM.GT.0) THEN + IF (PERM(I) .GT. THRESM) THEN + IDENSE = .TRUE. + DEGREE(I) = DEGREE(I)+N+2 + ENDIF + IF (IDENSE) THEN + P1 = PE(I) + P2 = P1 + ELEN(I) - 1 + IF (P2.GE.P1) THEN + DO 264 PJ=P1,P2 + E= IW(PJ) + NDENSE (E) = NDENSE(E) + NVI + 264 CONTINUE + ENDIF + NBD = NBD+NVI + FDEG = N + DEG = N + INEXT = HEAD(DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + LAST(I) = 0 + IF (LASTD.EQ.0) LASTD=I + ENDIF + ENDIF + IF (.NOT.IDENSE) THEN + FDEG = PERM(I) + INEXT = HEAD (FDEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + LAST (I) = 0 + HEAD (FDEG) = I + ENDIF + MINDEG = min (MINDEG, FDEG) + ENDIF + IW (P) = I + P = P + 1 + ENDIF + 260 CONTINUE + NV (ME) = NVPIV + DEGME + LEN (ME) = P - PME1 + IF (LEN (ME) .EQ. 0) THEN + PE (ME) = 0 + W (ME) = 0 + ENDIF + IF (NEWMEM .NE. 0) THEN + PFREE = P + MEM = MEM - NEWMEM + LEN (ME) + ENDIF + GO TO 30 + ENDIF + 265 CONTINUE + DO 290 I = 1, N + IF (ELEN (I) .EQ. 0) THEN + J = -PE (I) + 270 CONTINUE + IF (ELEN (J) .GE. 0) THEN + J = -PE (J) + GO TO 270 + ENDIF + E = J + K = -ELEN (E) + J = I + 280 CONTINUE + IF (ELEN (J) .GE. 0) THEN + JNEXT = -PE (J) + PE (J) = -E + IF (ELEN (J) .EQ. 0) THEN + ELEN (J) = K + K = K + 1 + ENDIF + J = JNEXT + GO TO 280 + ENDIF + ELEN (E) = -K + ENDIF + 290 CONTINUE + DO 300 I = 1, N + K = abs (ELEN (I)) + LAST (K) = I + ELEN (I) = K + 300 CONTINUE + IF (.NOT.SchurON) THEN + PERM(PERMeqN) = N + ENDIF + PFREE = MAXMEM + RETURN + END SUBROUTINE MUMPS_422 + SUBROUTINE MUMPS_276( ICNTL, INFO, COMM, ID ) + INTEGER ICNTL(40), INFO(40), COMM, ID + INCLUDE 'mpif.h' + INTEGER IN( 2 ), OUT( 2 ) + INTEGER LP, IERR + LP = ICNTL( 1 ) + IN( 1 ) = INFO ( 1 ) + IN( 2 ) = ID + CALL MPI_ALLREDUCE( IN, OUT, 1, MPI_2INTEGER, MPI_MINLOC, + & COMM, IERR) + IF ( OUT( 1 ) .LT. 0 .and. INFO(1) .GE. 0 ) THEN + INFO( 1 ) = -001 + INFO( 2 ) = OUT( 2 ) + END IF + RETURN + END SUBROUTINE MUMPS_276 + SUBROUTINE MUMPS_137( INODE, N, PROCNODE_STEPS, + & SLAVEF, + & ND, FILS, FRERE_STEPS, STEP, PIMASTER, + & KEEP28, KEEP50, KEEP253, + & FLOP1, + & IW, LIW, XSIZE ) + IMPLICIT NONE + INTEGER INODE, N, KEEP50, LIW, SLAVEF, KEEP28, KEEP253 + INTEGER PROCNODE_STEPS(KEEP28), ND(KEEP28), + & FILS(N), FRERE_STEPS(KEEP28), + & STEP(N), + & PIMASTER(KEEP28), + & IW( LIW ) + INTEGER XSIZE + DOUBLE PRECISION FLOP1 + INTEGER NUMORG, IN, NASS, IFSON, NUMSTK, NFRONT, NPIV, NCB, + & LEVEL, ISON + LOGICAL MUMPS_170 + INTEGER MUMPS_330 + EXTERNAL MUMPS_170, MUMPS_330 + INCLUDE 'mumps_headers.h' + FLOP1 = 0.0D0 + IF (MUMPS_170(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) ) RETURN + IN = INODE + NUMORG = 0 + 10 NUMORG = NUMORG + 1 + IN = FILS(IN) + IF (IN .GT. 0) GOTO 10 + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + IF (ISON .EQ. 0) GOTO 30 + 20 NUMSTK = NUMSTK + 1 + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 +XSIZE) + ISON = FRERE_STEPS(STEP(ISON)) + IF (ISON .GT. 0) GOTO 20 + 30 NFRONT = ND(STEP(INODE)) + NASS + KEEP253 + NPIV = NASS + NUMORG + NCB = NFRONT - NPIV + LEVEL = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + CALL MUMPS_511(NFRONT,NPIV,NPIV,KEEP50,LEVEL,FLOP1) + RETURN + END SUBROUTINE MUMPS_137 + SUBROUTINE MUMPS_511(NFRONT,NPIV,NASS, + & KEEP50,LEVEL,COST) + IMPLICIT NONE + INTEGER, intent(in) :: NFRONT,NPIV,KEEP50,LEVEL, NASS + DOUBLE PRECISION, intent(out) :: COST + IF (KEEP50.EQ.0) THEN + IF (LEVEL.EQ.1 .OR. LEVEL.EQ.3) THEN + COST = dble(2) * dble(NFRONT) * dble(NPIV) * + & dble(NFRONT - NPIV - 1) + + & dble(NPIV) * dble(NPIV + 1) * dble(2 * NPIV + 1) + & / dble(3) + COST = COST + dble(2 * NFRONT - NPIV - 1) + & * dble(NPIV) /dble(2) + ELSEIF (LEVEL.EQ.2) THEN + COST = dble(2*NASS)*dble(NFRONT) - + & dble(NASS+NFRONT)*dble(NPIV+1) + COST = dble(NPIV)*COST + + & dble(2 * NASS - NPIV - 1) * dble(NPIV) / dble(2) + + & dble(NPIV) * dble(NPIV + 1) * + & dble(2 * NPIV + 1) /dble(3) + ENDIF + ELSE + IF (LEVEL.EQ.1) THEN + COST = dble(NPIV) * ( + & dble( NFRONT ) * dble( NFRONT ) + + & dble( NFRONT ) - ( + & dble( NFRONT)*dble(NPIV) + dble(NPIV+1) + & )) +( dble(NPIV)*dble(NPIV+1) + & *dble(2*NPIV+1))/ dble(6) + ELSE IF (LEVEL.EQ.3.AND.KEEP50.EQ.2) THEN + COST = dble(2) * dble(NFRONT) * dble(NPIV) * + & dble(NFRONT - NPIV - 1) + + & dble(NPIV) * dble(NPIV + 1) * + & dble(2 * NPIV + 1) / dble(3) + COST = COST + dble(2 * NFRONT - NPIV - 1) + & * dble(NPIV) / dble(2) + ELSE + COST = dble(NPIV) * ( + & dble( NASS ) * dble( NASS ) + dble( NASS ) + & - ( dble( NASS) * dble(NPIV) + dble( NPIV + 1 ) ) ) + & + ( dble(NPIV)*dble(NPIV+1)*dble(2*NPIV+1) ) + & / dble( 6 ) + ENDIF + ENDIF + RETURN + END SUBROUTINE MUMPS_511 + SUBROUTINE MUMPS_81(MYID, INODE, N, IOLDPS, + & HF, NFRONT, NFRONT_EFF, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG, + & PROCNODE_STEPS, SLAVEF ) + IMPLICIT NONE + INTEGER, intent(in) :: INODE, N, IOLDPS, HF, NFRONT, + & NASS1, LIW, NASS, + & NUMSTK, NUMORG, IWPOSCB + INTEGER, intent(in) :: KEEP(500) + INTEGER(8) , intent(in) ::KEEP8(150) + INTEGER STEP(N), + & PIMASTER(KEEP(28)), + & PTRAIW(N), IW(LIW), + & ITLOC(N+KEEP(253)), FILS(N), FRERE(KEEP(28)) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER, intent(inout) :: NBPROCFILS(KEEP(28)) + LOGICAL, intent(in) :: NIV1 + INTEGER, intent(inout) :: IFLAG + LOGICAL, intent(out) :: SON_LEVEL2 + INTEGER, intent(out) :: NFRONT_EFF + INTEGER, intent(in) :: PROCNODE_STEPS(KEEP(28)), SLAVEF + INTEGER, intent(in) :: DAD (KEEP(28)), IFSON, MYID + INTEGER NEWEL, INEW, IOLDP2, INEW1, + & IN, NTOTFS, ICT11, NELIM, NPIVS, NSLSON, NCOLS, + & ITRANS, J, JJ, J1, J2, J3, JT1, ISON, IELL, LSTK, + & NROWS, HS, IP1, IP2, K1, K2, IBROT, IORG, + & I, K + LOGICAL LEVEL1 + INTEGER MUMPS_810, MUMPS_330 + EXTERNAL MUMPS_810, MUMPS_330 + INTEGER TYPESPLIT + INCLUDE 'mumps_headers.h' + SON_LEVEL2 = .FALSE. + IOLDP2 = IOLDPS + HF - 1 + ICT11 = IOLDP2 + NFRONT + NTOTFS = 0 + TYPESPLIT = MUMPS_810 (PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) ) THEN + J2 = PIMASTER(STEP(IFSON)) + LSTK = IW(J2 +KEEP(IXSZ)) + NELIM = IW(J2 + 1+KEEP(IXSZ)) + NPIVS = IW(J2 + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NSLSON = IW(J2 + 5+KEEP(IXSZ)) + IF( NSLSON.GT.0) SON_LEVEL2 = .TRUE. + LEVEL1 = NSLSON.EQ.0 + NCOLS = NPIVS + LSTK + NROWS = NCOLS + ITRANS = NROWS + IF (NIV1) THEN + write(6,*) MYID, ':', + & ' Internal error 2 in MUMPS_BUILD__INDEX ', + & ' interior split node of type 1 ' + CALL MUMPS_ABORT() + ELSE + I= MUMPS_330(PROCNODE_STEPS(STEP(IFSON)),SLAVEF) + J= MUMPS_810(PROCNODE_STEPS(STEP(IFSON)), + & SLAVEF) + IF (LEVEL1.or.J.LT.4) THEN + write(6,*) MYID, ':', + & ' Internal error 3 in MUMPS_81 ', + & ' son', IFSON, + & ' of interior split node', INODE, ' of type 1 ', + & ' NSLSON =', NSLSON, ' TYPE_SON=', I, 'TYPESPLIT_SON=', J + CALL MUMPS_ABORT() + ELSE + NBPROCFILS(STEP(IFSON)) = NSLSON + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE))+ + & NBPROCFILS(STEP(IFSON)) + ENDIF + ENDIF + IF ( J2.GT. IWPOSCB ) THEN + NROWS = IW(J2 + 2+KEEP(IXSZ)) + ITRANS = NPIVS + NROWS + ENDIF + HS = NSLSON + 6 + KEEP(IXSZ) + J1 = J2 + HS + NROWS + NPIVS + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM - 1 + IF (NELIM.GT.0) THEN + DO JJ=J1,J3 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + IW(ICT11 + NTOTFS) = JT1 + IW(JJ) = NTOTFS + IW(IOLDP2 + NTOTFS) = IW(JJ - ITRANS) + ENDDO + ENDIF + DO JJ =J3+1, J3+NUMORG + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + ITLOC(JT1) = NTOTFS + IW(JJ) = NTOTFS + IW(ICT11 + NTOTFS) = JT1 + IW(IOLDP2 + NTOTFS) = JT1 + ENDDO + DO JJ =J3+NUMORG+1, J2 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + ITLOC(JT1) = NTOTFS + IW(JJ) = NTOTFS + IW(ICT11 + NTOTFS) = JT1 + IW(IOLDP2 + NTOTFS) = JT1 + ENDDO + NFRONT_EFF = NTOTFS + IBROT = INODE + DO IORG = 1, NUMORG + K1 = PTRAIW(IBROT) + 2 + JT1 = INTARR(K1) + INTARR(K1) = ITLOC(JT1) + IBROT = FILS(IBROT) + K2 = K1 + INTARR(K1 - 2) - INTARR(K1 - 1) + K1 = K1 + 1 + IF (K1 .LE. K2) THEN + DO JJ = K1, K2 + J = INTARR(JJ) + INTARR(JJ) = ITLOC(J) + ENDDO + ENDIF + ENDDO + K1 = IOLDPS+HF + DO JJ=K1+NELIM,K1+NFRONT_EFF-1 + ITLOC(IW(JJ)) = 0 + ENDDO + RETURN + ENDIF + NEWEL = IOLDP2 + NASS1 + NFRONT_EFF = NASS1 + IN = INODE + INEW = IOLDPS + HF + INEW1 = 1 + 50 J1 = PTRAIW(IN) + 2 + JT1 = INTARR(J1) + INTARR(J1) = INEW1 + ITLOC(JT1) = INEW1 + IW(INEW) = JT1 + INEW = INEW + 1 + INEW1 = INEW1 + 1 + IN = FILS(IN) + IF (IN .GT. 0) GOTO 50 + IF (TYPESPLIT.EQ.4) THEN + IBROT = INODE + DO WHILE + & ( + & ( MUMPS_810 + & (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF) + & .EQ.5 + & ) + & .OR. + & ( MUMPS_810 + & (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF) + & .EQ.6 + & ) + & ) + IBROT = DAD(STEP(IBROT)) + IN = IBROT + DO WHILE (IN.GT.0) + NFRONT_EFF = NFRONT_EFF+1 + NEWEL = NEWEL + 1 + ITLOC(IN) = NFRONT_EFF + IW(NEWEL) = IN + IN = FILS( IN ) + ENDDO + ENDDO + ENDIF + IF (NUMSTK .NE. 0) THEN + NTOTFS = NUMORG + ISON = IFSON + DO 100 IELL = 1, NUMSTK + J2 = PIMASTER(STEP(ISON)) + LSTK = IW(J2+KEEP(IXSZ)) + NELIM = IW(J2 + 1+KEEP(IXSZ)) + NPIVS = IW(J2 + 3+KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(J2 + 5+KEEP(IXSZ)) + IF( NSLSON.GT.0) SON_LEVEL2 = .TRUE. + LEVEL1 = NSLSON.EQ.0 + NCOLS = NPIVS + LSTK + NROWS = NCOLS + ITRANS = NROWS + IF (NIV1) THEN + NBPROCFILS(STEP(ISON)) = NSLSON + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE)) + NSLSON + ELSE + IF (LEVEL1) THEN + NBPROCFILS(STEP(ISON)) = 1 + ELSE + NBPROCFILS(STEP(ISON)) = NSLSON + ENDIF + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE))+ + & NBPROCFILS(STEP(ISON)) + ENDIF + IF (J2.GT.IWPOSCB) THEN + NROWS = IW(J2 + 2+KEEP(IXSZ)) + ITRANS = NPIVS + NROWS + ENDIF + HS = NSLSON + 6 + KEEP(IXSZ) + J1 = J2 + HS + NROWS + NPIVS + J2 = J1 + LSTK - 1 - KEEP(253) + J3 = J1 + NELIM - 1 + IF (NELIM .EQ. 0) GOTO 70 + DO 60 JJ = J1, J3 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + IW(ICT11 + NTOTFS) = JT1 + ITLOC(JT1) = NTOTFS + IW(JJ) = NTOTFS + IW(IOLDP2 + NTOTFS) = IW(JJ - ITRANS) + 60 CONTINUE + 70 J1 = J3 + 1 + IF (NASS1 .NE. NFRONT - KEEP(253)) THEN + DO 80 JJ = J1, J2 + J = IW(JJ) + IF (ITLOC(J) .EQ. 0) THEN + NEWEL = NEWEL + 1 + NFRONT_EFF = NFRONT_EFF + 1 + IW(NEWEL) = J + IW(JJ) = NFRONT_EFF + ITLOC(J) = NFRONT_EFF + ELSE + IW(JJ) = ITLOC(J) + ENDIF + 80 CONTINUE + ELSE + DO 90 JJ = J1, J2 + IW(JJ) = ITLOC(IW(JJ)) + 90 CONTINUE + ENDIF + DO JJ=J2+1, J2+KEEP(253) + IW(JJ)=NFRONT-KEEP(253)+JJ-J2 + ENDDO + ISON = FRERE(STEP(ISON)) + 100 CONTINUE + ENDIF + IBROT = INODE + DO 120 IORG = 1, NUMORG + J1 = PTRAIW(IBROT) + 2 + IBROT = FILS(IBROT) + J2 = J1 + INTARR(J1 - 2) - INTARR(J1 - 1) + J1 = J1 + 1 + IF (J1 .LE. J2) THEN + DO 110 JJ = J1, J2 + J = INTARR(JJ) + IF (ITLOC(J) .EQ. 0) THEN + NEWEL = NEWEL + 1 + NFRONT_EFF = NFRONT_EFF + 1 + IW(NEWEL) = J + INTARR(JJ) = NFRONT_EFF + ITLOC(J) = NFRONT_EFF + ELSE + INTARR(JJ) = ITLOC(J) + ENDIF + 110 CONTINUE + ENDIF + 120 CONTINUE + IF ( (TYPESPLIT.EQ.4).AND.(NFRONT_EFF.LT.NFRONT-KEEP(253)) ) THEN + IBROT = INODE + DO WHILE + & ( + & ( MUMPS_810 + & (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF) + & .EQ.5 + & ) + & .OR. + & ( MUMPS_810 + & (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF) + & .EQ.6 + & ) + & ) + IBROT = DAD(STEP(IBROT)) + IN = IBROT + DO WHILE (IN.GT.0.AND.NFRONT_EFF.LT.NFRONT-KEEP(253)) + J1 = PTRAIW(IN) + 2 + J2 = J1 + INTARR(J1 - 2) - INTARR(J1-1) + IN = FILS( IN ) + DO JJ = J1+1, J2 + J = INTARR( JJ ) + IF ( ITLOC( J ) .eq. 0 ) THEN + NEWEL = NEWEL + 1 + NFRONT_EFF = NFRONT_EFF + 1 + IW( NEWEL ) = J + ITLOC( J ) = NFRONT_EFF + END IF + ENDDO + ENDDO + IF (NFRONT_EFF.EQ.NFRONT-KEEP(253)) EXIT + ENDDO + ENDIF + IF ( KEEP(253).NE.0) THEN + IP1 = IOLDPS + HF + NFRONT_EFF + IP2 = IOLDPS + HF + NFRONT + NFRONT_EFF + DO I= 1, KEEP(253) + IW(IP1+I-1) = N+I + IW(IP2+I-1) = N+I + ENDDO + NFRONT_EFF = NFRONT_EFF + KEEP(253) + ENDIF + IF (NFRONT.NE.NFRONT_EFF) THEN + IF (NUMORG.EQ.NASS1) THEN + IP1 = IOLDPS + HF + IP2 = IOLDPS + HF + NFRONT_EFF - 1 + DO I = IP1, IP2 + IW(I + NFRONT_EFF) = IW(I) + ENDDO + ELSE + IP1 = IOLDPS + NFRONT + HF + NUMORG + IP2 = IOLDPS + HF + NFRONT_EFF + NUMORG + DO I=1,NASS + IW(IP2+I-1)=IW(IP1+I-1) + ENDDO + IP1 = IOLDPS + NASS1 + HF + IP2 = IOLDPS + HF + NFRONT - 1 + DO I = IP1, IP2 + IW(I + NFRONT_EFF) = IW(I) + ENDDO + IP1 = IOLDPS + HF + IP2 = IOLDPS + HF + NUMORG - 1 + DO I = IP1, IP2 + IW(I + NFRONT_EFF) = IW(I) + ENDDO + ENDIF + ELSE + IP1 = IOLDPS + NASS1 + HF + IP2 = IOLDPS + HF + NFRONT - KEEP(253) - 1 + DO I = IP1, IP2 + IW(I + NFRONT) = IW(I) + ENDDO + IP1 = IOLDPS + HF + IP2 = IOLDPS + HF + NUMORG - 1 + DO I = IP1, IP2 + IW(I + NFRONT) = IW(I) + ENDDO + ENDIF + K1 = IOLDPS + HF + NUMORG + K2 = K1 + NFRONT_EFF - 1 + NASS + DO 150 K = K1, K2 + I = IW(K) + ITLOC(I) = 0 + 150 CONTINUE + RETURN + END SUBROUTINE MUMPS_81 + SUBROUTINE MUMPS_124( + & NUMELT, LIST_ELT, + & MYID, INODE, N, IOLDPS, + & HF, NFRONT, NFRONT_EFF, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, + & IW, LIW, + & INTARR, LINTARR, ITLOC, RHS_MUMPS, + & FILS, FRERE_STEPS, + & KEEP, + & SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD, PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + IMPLICIT NONE + INTEGER NELT, INODE, N, IOLDPS, HF, NFRONT, NASS1, LIW, NASS, + & NUMSTK, NUMORG, IWPOSCB, IFSON, MYID, IFLAG, + & LINTARR, NUMELT, NFRONT_EFF + INTEGER KEEP(500) + INTEGER LIST_ELT(*) + INTEGER STEP(N), + & PIMASTER(KEEP(28)), + & PTRAIW(NELT+1), IW(LIW), + & ITLOC(N+KEEP(253)), FILS(N), + & FRERE_STEPS(KEEP(28)), + & NBPROCFILS(KEEP(28)) + COMPLEX, POINTER, DIMENSION(:) :: RHS_MUMPS + INTEGER INTARR(LINTARR) + LOGICAL SON_LEVEL2, NIV1 + INTEGER, intent(in) :: DAD (KEEP(28)) + INTEGER, intent(in) :: PROCNODE_STEPS(KEEP(28)), SLAVEF + INTEGER, intent(in) :: FRT_PTR(N+1), FRT_ELT(NELT) + INTEGER, intent(out) :: Pos_First_NUMORG + INTEGER NEWEL, INEW, IOLDP2, INEW1, + & IN, NTOTFS, ICT11, NELIM, NPIVS, NSLSON, NCOLS, + & ITRANS, J, JJ, J1, J2, J3, JT1, ISON, IELL, LSTK, + & NROWS, HS, IP1, IP2, K1, K2, + & I, K, ELTI + LOGICAL LEVEL1 + INTEGER MUMPS_810, MUMPS_330 + EXTERNAL MUMPS_810, MUMPS_330 + INTEGER TYPESPLIT, NUMELT_IBROT, IBROT + INCLUDE 'mumps_headers.h' + SON_LEVEL2 = .FALSE. + IOLDP2 = IOLDPS + HF - 1 + NTOTFS = 0 + ICT11 = IOLDP2 + NFRONT + TYPESPLIT = MUMPS_810 (PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) ) THEN + J2 = PIMASTER(STEP(IFSON)) + LSTK = IW(J2 +KEEP(IXSZ)) + NELIM = IW(J2 + 1+KEEP(IXSZ)) + NPIVS = IW(J2 + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NSLSON = IW(J2 + 5+KEEP(IXSZ)) + IF( NSLSON.GT.0) SON_LEVEL2 = .TRUE. + LEVEL1 = NSLSON.EQ.0 + NCOLS = NPIVS + LSTK + NROWS = NCOLS + ITRANS = NROWS + IF (NIV1) THEN + write(6,*) MYID, ':', + & ' Internal error 2 in MUMPS_BUILD__INDEX ', + & ' interior split node of type 1 ' + CALL MUMPS_ABORT() + ELSE + I= MUMPS_330(PROCNODE_STEPS(STEP(IFSON)),SLAVEF) + J= MUMPS_810(PROCNODE_STEPS(STEP(IFSON)), + & SLAVEF) + IF (LEVEL1.or.J.LT.4) THEN + write(6,*) MYID, ':', + & ' Internal error 3 in MUMPS_81 ', + & ' son', IFSON, + & ' of interior split node', INODE, ' of type 1 ', + & ' NSLSON =', NSLSON, ' TYPE_SON=', I, 'TYPESPLIT_SON=', J + CALL MUMPS_ABORT() + ELSE + NBPROCFILS(STEP(IFSON)) = NSLSON + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE))+ + & NBPROCFILS(STEP(IFSON)) + ENDIF + ENDIF + IF ( J2.GT. IWPOSCB ) THEN + NROWS = IW(J2 + 2+KEEP(IXSZ)) + ITRANS = NPIVS + NROWS + ENDIF + HS = NSLSON + 6 + KEEP(IXSZ) + J1 = J2 + HS + NROWS + NPIVS + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM - 1 + IF (NELIM.GT.0) THEN + DO JJ=J1,J3 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + IW(ICT11 + NTOTFS) = JT1 + IW(JJ) = NTOTFS + IW(IOLDP2 + NTOTFS) = IW(JJ - ITRANS) + ENDDO + ENDIF + DO JJ =J3+1, J2 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + ITLOC(JT1) = NTOTFS + IW(JJ) = NTOTFS + IW(ICT11 + NTOTFS) = JT1 + IW(IOLDP2 + NTOTFS) = JT1 + ENDDO + NFRONT_EFF = NTOTFS + DO IELL=1,NUMELT + ELTI = LIST_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + DO JJ=J1,J2 + J = INTARR(JJ) + INTARR(JJ) = ITLOC(J) + END DO + ENDDO + K1 = IOLDPS+HF + DO JJ=K1+NELIM,K1+NFRONT_EFF-1 + ITLOC(IW(JJ)) = 0 + ENDDO + RETURN + ENDIF + NEWEL = IOLDP2 + NASS1 + NFRONT_EFF = NASS1 + IN = INODE + INEW = IOLDPS + HF + INEW1 = 1 + DO WHILE (IN.GT.0) + ITLOC(IN) = INEW1 + IW(INEW) = IN + INEW1 = INEW1 + 1 + INEW = INEW + 1 + IN = FILS(IN) + END DO + IF (TYPESPLIT.EQ.4) THEN + IBROT = INODE + DO WHILE + & ( + & ( MUMPS_810 + & (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF) + & .EQ.5 + & ) + & .OR. + & ( MUMPS_810 + & (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF) + & .EQ.6 + & ) + & ) + IBROT = DAD(STEP(IBROT)) + IN = IBROT + DO WHILE (IN.GT.0) + NFRONT_EFF = NFRONT_EFF+1 + NEWEL = NEWEL + 1 + ITLOC(IN) = NFRONT_EFF + IW(NEWEL) = IN + IN = FILS( IN ) + ENDDO + ENDDO + ENDIF + IF (NUMSTK .NE. 0) THEN + NTOTFS = NUMORG + ISON = IFSON + DO 100 IELL = 1, NUMSTK + J2 = PIMASTER(STEP(ISON)) + LSTK = IW(J2+KEEP(IXSZ)) + NELIM = IW(J2 + 1+KEEP(IXSZ)) + NPIVS = IW(J2 + 3+KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(J2 + 5+KEEP(IXSZ)) + IF( NSLSON.GT.0) SON_LEVEL2 = .TRUE. + LEVEL1 = NSLSON.EQ.0 + NCOLS = NPIVS + LSTK + NROWS = NCOLS + ITRANS = NROWS + IF (NIV1) THEN + NBPROCFILS(STEP(ISON)) = NSLSON + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE)) + NSLSON + ELSE + IF (LEVEL1) THEN + NBPROCFILS(STEP(ISON)) = 1 + ELSE + NBPROCFILS(STEP(ISON)) = NSLSON + ENDIF + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE))+ + & NBPROCFILS(STEP(ISON)) + ENDIF + IF (J2.GT.IWPOSCB) THEN + NROWS = IW(J2 + 2+KEEP(IXSZ)) + ITRANS = NPIVS + NROWS + ENDIF + HS = NSLSON + 6 +KEEP(IXSZ) + J1 = J2 + HS + NROWS + NPIVS + J2 = J1 + LSTK - 1 - KEEP(253) + J3 = J1 + NELIM - 1 + IF (NELIM .EQ. 0) GOTO 70 + DO 60 JJ = J1, J3 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + IW(ICT11 + NTOTFS) = JT1 + ITLOC(JT1) = NTOTFS + IW(JJ) = NTOTFS + IW(IOLDP2 + NTOTFS) = IW(JJ - ITRANS) + 60 CONTINUE + 70 J1 = J3 + 1 + IF (NASS1 .NE. NFRONT) THEN + DO 80 JJ = J1, J2 + J = IW(JJ) + IF (ITLOC(J) .EQ. 0) THEN + NEWEL = NEWEL + 1 + NFRONT_EFF = NFRONT_EFF + 1 + IW(NEWEL) = J + IW(JJ) = NFRONT_EFF + ITLOC(J) = NFRONT_EFF + ELSE + IW(JJ) = ITLOC(J) + ENDIF + 80 CONTINUE + ELSE + DO 90 JJ = J1, J2 + IW(JJ) = ITLOC(IW(JJ)) + 90 CONTINUE + ENDIF + DO JJ=J2+1, J2+KEEP(253) + IW(JJ)=NFRONT-KEEP(253)+JJ-J2 + ENDDO + ISON = FRERE_STEPS(STEP(ISON)) + 100 CONTINUE + ENDIF + DO IELL=1,NUMELT + ELTI = LIST_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + DO JJ=J1,J2 + J = INTARR(JJ) + IF (ITLOC(J) .EQ. 0) THEN + NEWEL = NEWEL + 1 + NFRONT_EFF = NFRONT_EFF + 1 + IW(NEWEL) = J + INTARR(JJ) = NFRONT_EFF + ITLOC(J) = NFRONT_EFF + ELSE + INTARR(JJ) = ITLOC(J) + ENDIF + END DO + ENDDO + IF ( (TYPESPLIT.EQ.4).AND.(NFRONT_EFF.LT.NFRONT-KEEP(253)) ) THEN + IBROT = INODE + DO WHILE + & ( + & ( MUMPS_810 + & (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF) + & .EQ.5 + & ) + & .OR. + & ( MUMPS_810 + & (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF) + & .EQ.6 + & ) + & ) + IBROT = DAD(STEP(IBROT)) + NUMELT_IBROT = FRT_PTR(IBROT+1) - FRT_PTR(IBROT) + IF (NUMELT_IBROT.EQ.0) CYCLE + DO IELL = FRT_PTR(IBROT), FRT_PTR(IBROT+1) + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + DO JJ=J1,J2 + J = INTARR( JJ ) + IF ( ITLOC( J ) .eq. 0 ) THEN + NEWEL = NEWEL + 1 + NFRONT_EFF = NFRONT_EFF + 1 + IW( NEWEL ) = J + ITLOC( J ) = NFRONT_EFF + END IF + ENDDO + ENDDO + IF (NFRONT_EFF.EQ.NFRONT) EXIT + ENDDO + ENDIF + IF ( KEEP(253).GT.0) THEN + IP1 = IOLDPS + HF + NFRONT_EFF + IP2 = IOLDPS + HF + NFRONT + NFRONT_EFF + DO I= 1, KEEP(253) + IW(IP1+I-1) = N+I + IW(IP2+I-1) = N+I + ENDDO + NFRONT_EFF = NFRONT_EFF + KEEP(253) + ENDIF + IF (NFRONT.NE.NFRONT_EFF) THEN + IF (NUMORG.EQ.NASS1) THEN + IP1 = IOLDPS + HF + IP2 = IOLDPS + HF + NFRONT_EFF - 1 + DO I = IP1, IP2 + IW(I + NFRONT_EFF) = IW(I) + ENDDO + ELSE + IP1 = IOLDPS + NFRONT + HF + NUMORG + IP2 = IOLDPS + HF + NFRONT_EFF + NUMORG + DO I=1,NASS + IW(IP2+I-1)=IW(IP1+I-1) + ENDDO + IP1 = IOLDPS + NASS1 + HF + IP2 = IOLDPS + HF + NFRONT - 1 + DO I = IP1, IP2 + IW(I + NFRONT_EFF) = IW(I) + ENDDO + IP1 = IOLDPS + HF + IP2 = IOLDPS + HF + NUMORG - 1 + DO I = IP1, IP2 + IW(I + NFRONT_EFF) = IW(I) + ENDDO + ENDIF + ELSE + IP1 = IOLDPS + NASS1 + HF + IP2 = IOLDPS + HF + NFRONT - 1 + DO I = IP1, IP2 + IW(I + NFRONT) = IW(I) + ENDDO + IP1 = IOLDPS + HF + IP2 = IOLDPS + HF + NUMORG - 1 + DO I = IP1, IP2 + IW(I + NFRONT) = IW(I) + ENDDO + ENDIF + Pos_First_NUMORG = ITLOC(INODE) + K1 = IOLDPS + HF + NUMORG + K2 = K1 + NFRONT_EFF - 1 + NASS + DO 150 K = K1, K2 + I = IW(K) + ITLOC(I) = 0 + 150 CONTINUE + RETURN + END SUBROUTINE MUMPS_124 + SUBROUTINE MUMPS_86(MYID, INODE, N, IOLDPS, + & HF, NFRONT, NFRONT_EFF, PERM, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE_STEPS, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG, + & ISON_IN_PLACE, PROCNODE_STEPS, SLAVEF ) + IMPLICIT NONE + INTEGER INODE, N, IOLDPS, HF, NFRONT, NASS1, LIW, NASS, + & NUMSTK, NUMORG, IWPOSCB, IFSON, MYID + INTEGER, intent(in) :: ISON_IN_PLACE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER STEP(N), PIMASTER(KEEP(28)), + & PTRAIW(N), IW(LIW), + & ITLOC(N+KEEP(253)), FILS(N), FRERE_STEPS(KEEP(28)), + & NBPROCFILS(KEEP(28)), PERM(N) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + LOGICAL, intent(in) :: NIV1 + INTEGER, intent(inout) :: IFLAG + LOGICAL, intent(out) :: SON_LEVEL2 + INTEGER, intent(out) :: NFRONT_EFF + INTEGER, intent(in) :: DAD (KEEP(28)) + INTEGER, intent(in) :: PROCNODE_STEPS(KEEP(28)), SLAVEF + INTEGER NELIM_SON_IN_PLACE + INTEGER NEWEL, IOLDP2, INEW, INEW1, + & IN, NTOTFS, ICT11, NELIM, NPIVS, NSLSON, NCOLS, + & ITRANS, J, JJ, J1, J2, J3, JT1, ISON, IELL, LSTK, + & NROWS, HS, IP1, IP2, K1, K2, IBROT, IORG, + & I, K, JDEBROW, ILOC, NEWEL_SAVE, NEWEL1_SAVE, + & LAST_J_ASS, JMIN, MIN_PERM + LOGICAL LEVEL1 + INTEGER TYPESPLIT + INCLUDE 'mumps_headers.h' + INTEGER allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: PTTRI, PTLAST + INTEGER MUMPS_810, MUMPS_330 + EXTERNAL MUMPS_810, MUMPS_330 + TYPESPLIT = MUMPS_810 (PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + SON_LEVEL2 = .FALSE. + IOLDP2 = IOLDPS + HF - 1 + ICT11 = IOLDP2 + NFRONT + NTOTFS = 0 + NELIM_SON_IN_PLACE = 0 + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) ) THEN + J2 = PIMASTER(STEP(IFSON)) + LSTK = IW(J2 +KEEP(IXSZ)) + NELIM = IW(J2 + 1+KEEP(IXSZ)) + IF ( ISON_IN_PLACE > 0 ) THEN + IF (ISON_IN_PLACE.NE.IFSON) THEN + write(6,*) MYID, ':', + & ' Internal error 1 in MUMPS_86 ', + & ' in place node is not the first son a interior split node ' + CALL MUMPS_ABORT() + ENDIF + NELIM_SON_IN_PLACE = NELIM + ENDIF + NPIVS = IW(J2 + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NSLSON = IW(J2 + 5+KEEP(IXSZ)) + IF( NSLSON.GT.0) SON_LEVEL2 = .TRUE. + LEVEL1 = NSLSON.EQ.0 + NCOLS = NPIVS + LSTK + NROWS = NCOLS + ITRANS = NROWS + IF (NIV1) THEN + write(6,*) MYID, ':', + & ' Internal error 2 in MUMPS_86 ', + & ' interior split node of type 1 ' + CALL MUMPS_ABORT() + ELSE + I= MUMPS_330(PROCNODE_STEPS(STEP(IFSON)),SLAVEF) + J= MUMPS_810(PROCNODE_STEPS(STEP(IFSON)), + & SLAVEF) + IF (LEVEL1.or.J.LT.4) THEN + write(6,*) MYID, ':', + & ' Internal error 3 in MUMPS_86 ', + & ' son', IFSON, + & ' of interior split node', INODE, ' of type 1 ', + & ' NSLSON =', NSLSON, ' TYPE_SON=', I, 'TYPESPLIT_SON=', J + CALL MUMPS_ABORT() + ELSE + NBPROCFILS(STEP(IFSON)) = NSLSON + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE))+ + & NBPROCFILS(STEP(IFSON)) + ENDIF + ENDIF + IF ( J2.GT. IWPOSCB ) THEN + NROWS = IW(J2 + 2+KEEP(IXSZ)) + ITRANS = NPIVS + NROWS + ENDIF + HS = NSLSON + 6 + KEEP(IXSZ) + J1 = J2 + HS + NROWS + NPIVS + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM - 1 + IF (NELIM.GT.0) THEN + DO JJ=J1,J3 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + IW(ICT11 + NTOTFS) = JT1 + IW(JJ) = NTOTFS + IW(IOLDP2 + NTOTFS) = IW(JJ - ITRANS) + ENDDO + ENDIF + DO JJ =J3+1, J3+NUMORG + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + ITLOC(JT1) = NTOTFS + IW(JJ) = NTOTFS + IW(ICT11 + NTOTFS) = JT1 + IW(IOLDP2 + NTOTFS) = JT1 + ENDDO + DO JJ =J3+NUMORG+1, J2 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + ITLOC(JT1) = NTOTFS + IW(JJ) = NTOTFS + IW(ICT11 + NTOTFS) = JT1 + IW(IOLDP2 + NTOTFS) = JT1 + ENDDO + NFRONT_EFF = NTOTFS + IBROT = INODE + DO IORG = 1, NUMORG + K1 = PTRAIW(IBROT) + 2 + JT1 = INTARR(K1) + INTARR(K1) = ITLOC(JT1) + IBROT = FILS(IBROT) + K2 = K1 + INTARR(K1 - 2) - INTARR(K1 - 1) + K1 = K1 + 1 + IF (K1 .LE. K2) THEN + DO JJ = K1, K2 + J = INTARR(JJ) + INTARR(JJ) = ITLOC(J) + ENDDO + ENDIF + ENDDO + K1 = IOLDPS+HF + DO JJ=K1+NELIM,K1+NFRONT_EFF-1 + ITLOC(IW(JJ)) = 0 + ENDDO + RETURN + ENDIF + ALLOCATE(PTTRI(NUMSTK+1), stat=allocok) + IF (allocok .GT. 0) THEN + IFLAG = -13 + GOTO 800 + ENDIF + ALLOCATE(PTLAST(NUMSTK+1), stat=allocok) + IF (allocok .GT. 0) THEN + IFLAG = -13 + GOTO 800 + ENDIF + NFRONT_EFF = NASS1 + IF ( ISON_IN_PLACE > 0 ) THEN + ISON = ISON_IN_PLACE + J2 = PIMASTER(STEP(ISON)) + LSTK = IW(J2 +KEEP(IXSZ)) + NELIM = IW(J2 + 1+KEEP(IXSZ)) + NPIVS = IW(J2 + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NSLSON = IW(J2 + 5+KEEP(IXSZ)) + NCOLS = NPIVS + LSTK + NROWS = NCOLS + ITRANS = NROWS + IF ( J2.GT. IWPOSCB ) THEN + NROWS = IW(J2 + 2+KEEP(IXSZ)) + ITRANS = NPIVS + NROWS + ENDIF + HS = NSLSON + 6 + KEEP(IXSZ) + J1 = J2 + HS + NROWS + NPIVS + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM - 1 + DO JJ = J1, J3 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + IW(ICT11 + NTOTFS) = JT1 + ITLOC(JT1) = NTOTFS + IW(JJ) = NTOTFS + IW(IOLDP2 + NTOTFS) = IW(JJ - ITRANS) + ENDDO + NELIM_SON_IN_PLACE = NTOTFS + ENDIF + IN = INODE + INEW = IOLDPS + HF + NTOTFS + INEW1 = NTOTFS + 1 + JDEBROW = PTRAIW(INODE)+3 + PTTRI(NUMSTK+1) = JDEBROW + PTLAST(NUMSTK+1) = JDEBROW + INTARR(JDEBROW-3) - 1 + 50 J1 = PTRAIW(IN) + 2 + JT1 = INTARR(J1) + INTARR(J1) = INEW1 + ITLOC(JT1) = INEW1 + IW(INEW) = JT1 + IW(INEW+NFRONT) = JT1 + INEW = INEW + 1 + INEW1 = INEW1 + 1 + IN = FILS(IN) + IF (IN .GT. 0) GOTO 50 + NTOTFS = NTOTFS + NUMORG + IF (NUMSTK .NE. 0) THEN + ISON = IFSON + DO IELL = 1, NUMSTK + J2 = PIMASTER(STEP(ISON)) + LSTK = IW(J2 +KEEP(IXSZ)) + NELIM = IW(J2 + 1+KEEP(IXSZ)) + NPIVS = IW(J2 + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NSLSON = IW(J2 + 5+KEEP(IXSZ)) + IF( NSLSON.GT.0) SON_LEVEL2 = .TRUE. + LEVEL1 = NSLSON.EQ.0 + NCOLS = NPIVS + LSTK + NROWS = NCOLS + ITRANS = NROWS + IF (NIV1) THEN + NBPROCFILS(STEP(ISON)) = NSLSON + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE)) + NSLSON + ELSE + IF (LEVEL1) THEN + NBPROCFILS(STEP(ISON)) = 1 + ELSE + NBPROCFILS(STEP(ISON)) = NSLSON + ENDIF + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE))+ + & NBPROCFILS(STEP(ISON)) + ENDIF + IF (J2.GT.IWPOSCB) THEN + NROWS = IW(J2 + 2+KEEP(IXSZ)) + ITRANS = NPIVS + NROWS + ENDIF + HS = NSLSON + 6 + KEEP(IXSZ) + J1 = J2 + HS + NROWS + NPIVS + J2 = J1 + LSTK - 1 - KEEP(253) + J3 = J1 + NELIM - 1 + IF (NELIM .NE. 0 .AND. ISON.NE.ISON_IN_PLACE) THEN + DO JJ = J1, J3 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + IW(ICT11 + NTOTFS) = JT1 + ITLOC(JT1) = NTOTFS + IW(JJ) = NTOTFS + IW(IOLDP2 + NTOTFS) = IW(JJ - ITRANS) + ENDDO + ENDIF + PTTRI(IELL) = J2+1 + PTLAST(IELL) = J2 + J1 = J3 + 1 + IF (NASS1 .NE. NFRONT - KEEP(253)) THEN + DO JJ = J1, J2 + J = IW(JJ) + IF (ITLOC(J) .EQ. 0) THEN + PTTRI(IELL) = JJ + EXIT + ENDIF + ENDDO + ELSE + DO JJ = J1, J2 + IW(JJ) = ITLOC(IW(JJ)) + ENDDO + DO JJ=J2+1, J2+KEEP(253) + IW(JJ)=NFRONT-KEEP(253)+JJ-J2 + ENDDO + ENDIF + ISON = FRERE_STEPS(STEP(ISON)) + ENDDO + ENDIF + IF (NFRONT-KEEP(253).EQ.NASS1) GOTO 500 + 199 CONTINUE + IF ( PTTRI( NUMSTK + 1 ) .LE. PTLAST( NUMSTK + 1 ) ) THEN + IF ( ITLOC( INTARR( PTTRI( NUMSTK + 1 ) ) ) .NE. 0 ) THEN + PTTRI( NUMSTK + 1 ) = PTTRI( NUMSTK + 1 ) + 1 + GOTO 199 + END IF + END IF + MIN_PERM = N + 1 + DO IELL = 1, NUMSTK + ILOC = PTTRI( IELL ) + IF ( ILOC .LE. PTLAST( IELL ) ) THEN + IF ( PERM( IW( ILOC ) ) .LT. MIN_PERM ) THEN + JMIN = IW( ILOC ) + MIN_PERM = PERM( JMIN ) + END IF + END IF + END DO + IELL = NUMSTK + 1 + ILOC = PTTRI( IELL ) + IF ( ILOC .LE. PTLAST( IELL ) ) THEN + IF ( PERM( INTARR( ILOC ) ) .LT. MIN_PERM ) THEN + JMIN = INTARR( ILOC ) + MIN_PERM = PERM( JMIN ) + END IF + END IF + NEWEL = IOLDP2 + NASS1 + NFRONT + DO WHILE ( MIN_PERM .NE. N + 1 ) + NEWEL = NEWEL + 1 + NFRONT_EFF = NFRONT_EFF + 1 + IW( NEWEL ) = JMIN + ITLOC( JMIN ) = NFRONT_EFF + LAST_J_ASS = JMIN + MIN_PERM = N + 1 + DO IELL = 1, NUMSTK + IF ( PTTRI( IELL ) .LE. PTLAST( IELL ) ) THEN + IF ( IW( PTTRI( IELL ) ) .eq. LAST_J_ASS ) + & PTTRI( IELL ) = PTTRI( IELL ) + 1 + ENDIF + IF ( PTTRI( IELL ) .LE. PTLAST( IELL ) ) THEN + IF ( PERM(IW( PTTRI( IELL )) ) .LT. MIN_PERM ) THEN + JMIN = IW( PTTRI( IELL ) ) + MIN_PERM = PERM( JMIN ) + END IF + END IF + END DO + IELL = NUMSTK + 1 + 145 CONTINUE + IF ( PTTRI( IELL ) .LE. PTLAST( IELL ) ) THEN + IF ( INTARR( PTTRI( IELL ) ) .eq. LAST_J_ASS ) THEN + PTTRI( IELL ) = PTTRI( IELL ) + 1 + GOTO 145 + END IF + END IF + IF ( PTTRI( IELL ) .LE. PTLAST( IELL ) ) THEN + IF (PERM(INTARR( PTTRI(IELL) )) .LT. MIN_PERM) THEN + JMIN = INTARR( PTTRI(IELL) ) + MIN_PERM = PERM( JMIN ) + END IF + END IF + END DO + NEWEL_SAVE = NEWEL + NEWEL1_SAVE = NFRONT_EFF + IF (NEWEL1_SAVE.LT.NFRONT - KEEP(253)) THEN + IBROT = INODE + DO IORG = 1, NUMORG + J1 = PTRAIW(IBROT) + 2 + J2 = J1 + INTARR(J1 - 2) - INTARR(J1-1) + IBROT = FILS( IBROT ) + IF ( IORG.EQ. 1) THEN + IF ( KEEP(50).NE.0 ) CYCLE + J1 = J1 + 1 + INTARR(J1-2) + ELSE + J1 = J1 + 1 + ENDIF + DO JJ = J1, J2 + J = INTARR( JJ ) + IF ( ITLOC( J ) .eq. 0 ) THEN + NEWEL = NEWEL + 1 + NFRONT_EFF = NFRONT_EFF + 1 + IW( NEWEL ) = J + ITLOC( J ) = NFRONT_EFF + END IF + ENDDO + ENDDO + IF ( (TYPESPLIT.EQ.4).AND. + & (NFRONT_EFF.LT.NFRONT-KEEP(253)) ) THEN + IBROT = INODE + DO WHILE + & ( + & ( MUMPS_810 + & (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF) + & .EQ.5 + & ) + & .OR. + & ( MUMPS_810 + & (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF) + & .EQ.6 + & ) + & ) + IBROT = DAD(STEP(IBROT)) + IN = IBROT + DO WHILE (IN.GT.0.AND.NFRONT_EFF.LT.NFRONT-KEEP(253)) + J1 = PTRAIW(IN) + 2 + J2 = J1 + INTARR(J1 - 2) - INTARR(J1-1) + IN = FILS( IN ) + DO JJ = J1, J2 + J = INTARR( JJ ) + IF ( ITLOC( J ) .eq. 0 ) THEN + NEWEL = NEWEL + 1 + NFRONT_EFF = NFRONT_EFF + 1 + IW( NEWEL ) = J + ITLOC( J ) = NFRONT_EFF + END IF + ENDDO + ENDDO + IF (NFRONT_EFF.EQ.NFRONT-KEEP(253)) EXIT + ENDDO + ENDIF + ENDIF + IF ( NEWEL1_SAVE .eq. NFRONT_EFF ) THEN + DO JJ=NASS1+1, NFRONT_EFF + IW( IOLDP2+JJ ) = IW( ICT11+JJ ) + ENDDO + ELSE + CALL MUMPS_308( N, PERM, + & IW( NEWEL_SAVE + 1 ), NFRONT_EFF - NEWEL1_SAVE ) + CALL MUMPS_309( N, NASS1, PERM, ITLOC, + & IW( NEWEL_SAVE + 1), NFRONT_EFF - NEWEL1_SAVE, + & IW( ICT11 + NASS1 + 1 ), NEWEL1_SAVE - NASS1, + & IW( IOLDP2 + NASS1 + 1 ), NFRONT_EFF - NASS1 ) + DO JJ = NASS1+1, NFRONT_EFF + IW(ICT11 + JJ) = IW(IOLDP2+JJ) + ENDDO + END IF + 500 CONTINUE + IF ( KEEP(253).GT.0) THEN + IP1 = IOLDPS + HF + NFRONT_EFF + IP2 = IOLDPS + HF + NFRONT + NFRONT_EFF + DO I= 1, KEEP(253) + IW(IP1+I-1) = N+I + IW(IP2+I-1) = N+I + ITLOC(N+I) = NFRONT_EFF + I + ENDDO + NFRONT_EFF = NFRONT_EFF + KEEP(253) + ENDIF + IF (NFRONT.NE.NFRONT_EFF) THEN + IP1 = IOLDPS + NFRONT + HF + IP2 = IOLDPS + NFRONT_EFF + HF + DO I=1, NFRONT_EFF + IW(IP2+I-1)=IW(IP1+I-1) + ENDDO + ENDIF + IF ((NUMSTK .NE. 0).AND.(NFRONT-KEEP(253).GT.NASS1)) THEN + ISON = IFSON + DO IELL = 1, NUMSTK + J2 = PIMASTER(STEP(ISON)) + LSTK = IW(J2+KEEP(IXSZ)) + NELIM = IW(J2 + 1+KEEP(IXSZ)) + NPIVS = IW(J2 + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NSLSON = IW(J2 + 5+KEEP(IXSZ)) + NCOLS = NPIVS + LSTK + NROWS = NCOLS + IF (J2.GT.IWPOSCB) THEN + NROWS = IW(J2 + 2+KEEP(IXSZ)) + ENDIF + HS = NSLSON + 6 +KEEP(IXSZ) + J1 = J2 + HS + NROWS + NPIVS + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM - 1 + J1 = J3 + 1 + DO JJ = J1, J2 + J = IW(JJ) + IW(JJ) = ITLOC(J) + ENDDO + ISON = FRERE_STEPS(STEP(ISON)) + ENDDO + ENDIF + IBROT = INODE + DO IORG = 1, NUMORG + J1 = PTRAIW(IBROT) + 2 + IBROT = FILS(IBROT) + J2 = J1 + INTARR(J1 - 2) - INTARR(J1 - 1) + J1 = J1 + 1 + IF (J1 .LE. J2) THEN + DO JJ = J1, J2 + J = INTARR(JJ) + INTARR(JJ) = ITLOC(J) + ENDDO + ENDIF + ENDDO + K1 = IOLDPS + HF + K2 = K1 + NFRONT_EFF -1 + IF (KEEP(50).EQ.0) K2 = K2 + NELIM_SON_IN_PLACE + DO K = K1, K2 + I = IW(K) + ITLOC(I) = 0 + ENDDO + IF (KEEP(50).EQ.0) THEN + K1 = IOLDPS+HF+NFRONT_EFF+NELIM_SON_IN_PLACE+NUMORG + K2 = K1 + NASS -NELIM_SON_IN_PLACE - 1 + DO K = K1, K2 + I = IW(K) + ITLOC(I) = 0 + ENDDO + ENDIF + 800 CONTINUE + IF (allocated(PTTRI)) DEALLOCATE(PTTRI) + IF (allocated(PTLAST)) DEALLOCATE(PTLAST) + RETURN + END SUBROUTINE MUMPS_86 + SUBROUTINE MUMPS_308( N, PERM, IW, LIW ) + IMPLICIT NONE + INTEGER N, LIW + INTEGER PERM( N ), IW( LIW ) + INTEGER I, SWAP + LOGICAL DONE + DONE = .FALSE. + DO WHILE ( .NOT. DONE ) + DONE = .TRUE. + DO I = 1, LIW - 1 + IF ( PERM( IW( I ) ) .GT. PERM( IW( I + 1 ) ) ) THEN + DONE = .FALSE. + SWAP = IW( I + 1 ) + IW( I + 1 ) = IW( I ) + IW( I ) = SWAP + END IF + END DO + END DO + RETURN + END SUBROUTINE MUMPS_308 + SUBROUTINE MUMPS_309( N, NASS1, PERM, ITLOC, + & SMALL, LSMALL, + & LARGE, LLARGE, + & MERGE, LMERGE ) + IMPLICIT NONE + INTEGER N, NASS1, LSMALL, LLARGE, LMERGE + INTEGER PERM( N ), ITLOC( N ) + INTEGER SMALL(LSMALL), LARGE(LLARGE), MERGE(LMERGE) + INTEGER PSMALL, PLARGE, PMERGE, VSMALL, VLARGE, VMERGE + PSMALL = 1 + PLARGE = 1 + PMERGE = 1 + DO WHILE ( PSMALL .LE. LSMALL .or. PLARGE.LE. LLARGE ) + IF ( PSMALL .GT. LSMALL ) THEN + VMERGE = LARGE( PLARGE ) + PLARGE = PLARGE + 1 + ELSE IF ( PLARGE .GT. LLARGE ) THEN + VMERGE = SMALL( PSMALL ) + PSMALL = PSMALL + 1 + ELSE + VSMALL = SMALL( PSMALL ) + VLARGE = LARGE( PLARGE ) + IF ( PERM( VSMALL ) .LT. PERM( VLARGE ) ) THEN + VMERGE = VSMALL + PSMALL = PSMALL + 1 + ELSE + VMERGE = VLARGE + PLARGE = PLARGE + 1 + END IF + END IF + MERGE( PMERGE ) = VMERGE + ITLOC( VMERGE ) = PMERGE + NASS1 + PMERGE = PMERGE + 1 + END DO + PMERGE = PMERGE - 1 + RETURN + END SUBROUTINE MUMPS_309 + SUBROUTINE MUMPS_125( + & NUMELT, LIST_ELT, + & MYID, INODE, N, IOLDPS, + & HF, NFRONT, NFRONT_EFF, PERM, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, + & IW, LIW, + & INTARR, LINTARR, ITLOC, RHS_MUMPS, + & FILS, FRERE_STEPS, + & KEEP, SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD, PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + IMPLICIT NONE + INTEGER NELT, INODE, N, IOLDPS, HF, NFRONT, NASS1, LIW, NASS, + & NUMSTK, NUMORG, IWPOSCB, IFSON, MYID, IFLAG, + & LINTARR, NUMELT + INTEGER KEEP(500) + INTEGER LIST_ELT(*) + INTEGER STEP(N), PIMASTER(KEEP(28)), + & PTRAIW(NELT+1), IW(LIW), + & ITLOC(N+KEEP(253)), FILS(N), FRERE_STEPS(KEEP(28)), + & NBPROCFILS(KEEP(28)), PERM(N) + COMPLEX :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(LINTARR) + LOGICAL, intent(in) :: NIV1 + LOGICAL, intent(out) :: SON_LEVEL2 + INTEGER, intent(out) :: NFRONT_EFF + INTEGER, intent(in) :: DAD (KEEP(28)) + INTEGER, intent(in) :: PROCNODE_STEPS(KEEP(28)), SLAVEF + INTEGER, intent(in) :: FRT_PTR(N+1), FRT_ELT(NELT) + INTEGER, intent(out) :: Pos_First_NUMORG + INTEGER NEWEL, IOLDP2, INEW, INEW1, + & IN, NTOTFS, ICT11, NELIM, NPIVS, NSLSON, NCOLS, + & ITRANS, J, JJ, J1, J2, J3, JT1, ISON, IELL, LSTK, + & NROWS, HS, IP1, IP2, K1, K2, IBROT, + & I, K, ILOC, NEWEL_SAVE, NEWEL1_SAVE, + & LAST_J_ASS, JMIN, MIN_PERM + INTEGER TYPESPLIT, NUMELT_IBROT + INTEGER ELTI + INCLUDE 'mumps_headers.h' + LOGICAL LEVEL1 + INTEGER allocok + INTEGER , ALLOCATABLE, DIMENSION(:) :: PTTRI, PTLAST + INTEGER MUMPS_810, MUMPS_330 + EXTERNAL MUMPS_810, MUMPS_330 + Pos_First_NUMORG = 1 + TYPESPLIT = MUMPS_810 (PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + SON_LEVEL2 = .FALSE. + IOLDP2 = IOLDPS + HF - 1 + ICT11 = IOLDP2 + NFRONT + NFRONT_EFF = NASS1 + NTOTFS = 0 + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) ) THEN + J2 = PIMASTER(STEP(IFSON)) + LSTK = IW(J2 +KEEP(IXSZ)) + NELIM = IW(J2 + 1+KEEP(IXSZ)) + NPIVS = IW(J2 + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NSLSON = IW(J2 + 5+KEEP(IXSZ)) + IF( NSLSON.GT.0) SON_LEVEL2 = .TRUE. + LEVEL1 = NSLSON.EQ.0 + NCOLS = NPIVS + LSTK + NROWS = NCOLS + ITRANS = NROWS + IF (NIV1) THEN + write(6,*) MYID, ':', + & ' Internal error 2 in MUMPS_86 ', + & ' interior split node of type 1 ' + CALL MUMPS_ABORT() + ELSE + I= MUMPS_330(PROCNODE_STEPS(STEP(IFSON)),SLAVEF) + J= MUMPS_810(PROCNODE_STEPS(STEP(IFSON)), + & SLAVEF) + IF (LEVEL1.or.J.LT.4) THEN + write(6,*) MYID, ':', + & ' Internal error 3 in MUMPS_86 ', + & ' son', IFSON, + & ' of interior split node', INODE, ' of type 1 ', + & ' NSLSON =', NSLSON, ' TYPE_SON=', I, 'TYPESPLIT_SON=', J + CALL MUMPS_ABORT() + ELSE + NBPROCFILS(STEP(IFSON)) = NSLSON + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE))+ + & NBPROCFILS(STEP(IFSON)) + ENDIF + ENDIF + IF ( J2.GT. IWPOSCB ) THEN + NROWS = IW(J2 + 2+KEEP(IXSZ)) + ITRANS = NPIVS + NROWS + ENDIF + HS = NSLSON + 6 + KEEP(IXSZ) + J1 = J2 + HS + NROWS + NPIVS + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM - 1 + IF (NELIM.GT.0) THEN + DO JJ=J1,J3 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + IW(ICT11 + NTOTFS) = JT1 + IW(JJ) = NTOTFS + IW(IOLDP2 + NTOTFS) = IW(JJ - ITRANS) + ENDDO + ENDIF + DO JJ =J3+1, J2 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + ITLOC(JT1) = NTOTFS + IW(JJ) = NTOTFS + IW(ICT11 + NTOTFS) = JT1 + IW(IOLDP2 + NTOTFS) = JT1 + ENDDO + NFRONT_EFF = NTOTFS + DO IELL=1,NUMELT + ELTI = LIST_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + DO JJ=J1,J2 + J = INTARR(JJ) + INTARR(JJ) = ITLOC(J) + END DO + ENDDO + Pos_First_NUMORG = ITLOC(INODE) + K1 = IOLDPS+HF + DO JJ=K1+NELIM,K1+NFRONT_EFF-1 + ITLOC(IW(JJ)) = 0 + ENDDO + RETURN + ENDIF + IF (NUMSTK.GT.0) THEN + ALLOCATE(PTTRI(NUMSTK), stat=allocok) + IF (allocok .GT. 0) THEN + IFLAG = -13 + GOTO 800 + ENDIF + ALLOCATE(PTLAST(NUMSTK), stat=allocok) + IF (allocok .GT. 0) THEN + IFLAG = -13 + GOTO 800 + ENDIF + ENDIF + IN = INODE + INEW = IOLDPS + HF + INEW1 = 1 + DO WHILE (IN.GT.0) + ITLOC(IN) = INEW1 + IW(INEW) = IN + IW(INEW+NFRONT) = IN + INEW1 = INEW1 + 1 + INEW = INEW + 1 + IN = FILS(IN) + END DO + NTOTFS = NUMORG + IF (NUMSTK .NE. 0) THEN + ISON = IFSON + DO IELL = 1, NUMSTK + J2 = PIMASTER(STEP(ISON)) + LSTK = IW(J2 +KEEP(IXSZ)) + NELIM = IW(J2 + 1+KEEP(IXSZ)) + NPIVS = IW(J2 + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NSLSON = IW(J2 + 5+KEEP(IXSZ)) + IF( NSLSON.GT.0) SON_LEVEL2 = .TRUE. + LEVEL1 = NSLSON.EQ.0 + NCOLS = NPIVS + LSTK + NROWS = NCOLS + ITRANS = NROWS + IF (NIV1) THEN + NBPROCFILS(STEP(ISON)) = NSLSON + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE)) + NSLSON + ELSE + IF (LEVEL1) THEN + NBPROCFILS(STEP(ISON)) = 1 + ELSE + NBPROCFILS(STEP(ISON)) = NSLSON + ENDIF + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE))+ + & NBPROCFILS(STEP(ISON)) + ENDIF + IF (J2.GT.IWPOSCB) THEN + NROWS = IW(J2 + 2+KEEP(IXSZ)) + ITRANS = NPIVS + NROWS + ENDIF + HS = NSLSON + 6 + KEEP(IXSZ) + J1 = J2 + HS + NROWS + NPIVS + J2 = J1 + LSTK - 1 - KEEP(253) + J3 = J1 + NELIM - 1 + IF (NELIM .NE. 0) THEN + DO JJ = J1, J3 + NTOTFS = NTOTFS + 1 + JT1 = IW(JJ) + IW(ICT11 + NTOTFS) = JT1 + ITLOC(JT1) = NTOTFS + IW(JJ) = NTOTFS + IW(IOLDP2 + NTOTFS) = IW(JJ - ITRANS) + ENDDO + ENDIF + PTTRI(IELL) = J2+1 + PTLAST(IELL) = J2 + J1 = J3 + 1 + IF (NASS1 .NE. NFRONT - KEEP(253)) THEN + DO JJ = J1, J2 + J = IW(JJ) + IF (ITLOC(J) .EQ. 0) THEN + PTTRI(IELL) = JJ + EXIT + ENDIF + ENDDO + ELSE + DO JJ = J1, J2 + IW(JJ) = ITLOC(IW(JJ)) + ENDDO + DO JJ=J2+1, J2+KEEP(253) + IW(JJ)=NFRONT-KEEP(253)+JJ-J2 + ENDDO + ENDIF + ISON = FRERE_STEPS(STEP(ISON)) + ENDDO + ENDIF + IF (NFRONT-KEEP(253).EQ.NASS1) GOTO 500 + MIN_PERM = N + 1 + JMIN = -1 + DO IELL = 1, NUMSTK + ILOC = PTTRI( IELL ) + IF ( ILOC .LE. PTLAST( IELL ) ) THEN + IF ( PERM( IW( ILOC ) ) .LT. MIN_PERM ) THEN + JMIN = IW( ILOC ) + MIN_PERM = PERM( JMIN ) + END IF + END IF + END DO + NEWEL = IOLDP2 + NASS1 + NFRONT + DO WHILE ( MIN_PERM .NE. N + 1 ) + NEWEL = NEWEL + 1 + NFRONT_EFF = NFRONT_EFF + 1 + IW( NEWEL ) = JMIN + ITLOC( JMIN ) = NFRONT_EFF + LAST_J_ASS = JMIN + MIN_PERM = N + 1 + DO IELL = 1, NUMSTK + IF ( PTTRI( IELL ) .LE. PTLAST( IELL ) ) THEN + IF ( IW( PTTRI( IELL ) ) .eq. LAST_J_ASS ) + & PTTRI( IELL ) = PTTRI( IELL ) + 1 + ENDIF + IF ( PTTRI( IELL ) .LE. PTLAST( IELL ) ) THEN + IF ( PERM(IW( PTTRI( IELL )) ) .LT. MIN_PERM ) THEN + JMIN = IW( PTTRI( IELL ) ) + MIN_PERM = PERM( JMIN ) + END IF + END IF + END DO + END DO + NEWEL_SAVE = NEWEL + NEWEL1_SAVE = NFRONT_EFF + IF (NEWEL1_SAVE.LT.NFRONT-KEEP(253)) THEN + DO IELL = 1,NUMELT + ELTI = LIST_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + DO JJ=J1,J2 + J = INTARR( JJ ) + IF ( ITLOC( J ) .eq. 0 ) THEN + NEWEL = NEWEL + 1 + NFRONT_EFF = NFRONT_EFF + 1 + IW( NEWEL ) = J + ITLOC( J ) = NFRONT_EFF + END IF + ENDDO + ENDDO + IF ( (TYPESPLIT.EQ.4).AND. + & (NFRONT_EFF.LT.NFRONT-KEEP(253)) ) THEN + IBROT = INODE + DO WHILE + & ( + & ( MUMPS_810 + & (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF) + & .EQ.5 + & ) + & .OR. + & ( MUMPS_810 + & (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF) + & .EQ.6 + & ) + & ) + IBROT = DAD(STEP(IBROT)) + NUMELT_IBROT = FRT_PTR(IBROT+1) - FRT_PTR(IBROT) + IF (NUMELT_IBROT.EQ.0) CYCLE + DO IELL = FRT_PTR(IBROT), FRT_PTR(IBROT+1) + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + DO JJ=J1,J2 + J = INTARR( JJ ) + IF ( ITLOC( J ) .eq. 0 ) THEN + NEWEL = NEWEL + 1 + NFRONT_EFF = NFRONT_EFF + 1 + IW( NEWEL ) = J + ITLOC( J ) = NFRONT_EFF + END IF + ENDDO + ENDDO + IF (NFRONT_EFF.EQ.NFRONT-KEEP(253)) EXIT + ENDDO + ENDIF + END IF + IF ( NEWEL1_SAVE .eq. NFRONT_EFF ) THEN + DO JJ=NASS1+1, NFRONT_EFF + IW( IOLDP2+JJ ) = IW( ICT11+JJ ) + ENDDO + ELSE + CALL MUMPS_308( N, PERM, + & IW( NEWEL_SAVE + 1 ), NFRONT_EFF - NEWEL1_SAVE ) + CALL MUMPS_309( N, NASS1, PERM, ITLOC, + & IW( NEWEL_SAVE + 1), NFRONT_EFF - NEWEL1_SAVE, + & IW( ICT11 + NASS1 + 1 ), NEWEL1_SAVE - NASS1, + & IW( IOLDP2 + NASS1 + 1 ), NFRONT_EFF - NASS1 ) + DO JJ = NASS1+1, NFRONT_EFF + IW(ICT11 + JJ) = IW(IOLDP2+JJ) + ENDDO + END IF + 500 CONTINUE + IF ( KEEP(253).GT.0) THEN + IP1 = IOLDPS + HF + NFRONT_EFF + IP2 = IOLDPS + HF + NFRONT + NFRONT_EFF + DO I= 1, KEEP(253) + IW(IP1+I-1) = N+I + IW(IP2+I-1) = N+I + ITLOC(N+I) = NFRONT_EFF + I + ENDDO + NFRONT_EFF = NFRONT_EFF + KEEP(253) + ENDIF + IF (NFRONT.GT.NFRONT_EFF) THEN + IP1 = IOLDPS + NFRONT + HF + IP2 = IOLDPS + NFRONT_EFF + HF + DO I=1,NFRONT_EFF + IW(IP2+I)=IW(IP1+I) + ENDDO + ELSE IF (NFRONT .LT. NFRONT_EFF) THEN + WRITE(*,*) "Internal error in MUMPS_125", + & NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ENDIF + IF ((NUMSTK .NE. 0).AND. + & (NFRONT-KEEP(253).GT.NASS1)) THEN + ISON = IFSON + DO IELL = 1, NUMSTK + J2 = PIMASTER(STEP(ISON)) + LSTK = IW(J2+KEEP(IXSZ)) + NELIM = IW(J2 + 1 +KEEP(IXSZ)) + NPIVS = IW(J2 + 3 +KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NSLSON = IW(J2 + 5 +KEEP(IXSZ)) + NCOLS = NPIVS + LSTK + NROWS = NCOLS + IF (J2.GT.IWPOSCB) THEN + NROWS = IW(J2 + 2+KEEP(IXSZ)) + ENDIF + HS = NSLSON + 6 +KEEP(IXSZ) + J1 = J2 + HS + NROWS + NPIVS + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM - 1 + J1 = J3 + 1 + DO JJ = J1, J2 + J = IW(JJ) + IW(JJ) = ITLOC(J) + ENDDO + ISON = FRERE_STEPS(STEP(ISON)) + ENDDO + ENDIF + DO IELL=1,NUMELT + ELTI = LIST_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + DO JJ=J1,J2 + J = INTARR(JJ) + INTARR(JJ) = ITLOC(J) + END DO + ENDDO + K1 = IOLDPS + HF + NUMORG + K2 = K1 + NFRONT_EFF - 1 + NASS + DO K = K1, K2 + I = IW(K) + ITLOC(I) = 0 + ENDDO + 800 CONTINUE + IF (allocated(PTTRI)) DEALLOCATE(PTTRI) + IF (allocated(PTLAST)) DEALLOCATE(PTLAST) + RETURN + END SUBROUTINE MUMPS_125 + INTEGER FUNCTION MUMPS_50 + & ( SLAVEF, K48, K821, K50, + & NFRONT, NCB) + IMPLICIT NONE + INTEGER, INTENT (IN) :: SLAVEF, K48, K50, NFRONT, NCB + INTEGER(8), INTENT (IN) :: K821 + INTEGER NSLAVESMIN, NASS, KMAX + REAL Wmaster, Wtotal, Wmax + INTEGER ACC,X + REAL MUMPS_45 + INTEGER MUMPS_497 + EXTERNAL MUMPS_45, MUMPS_497 + KMAX = MUMPS_497( K821, NCB ) + NASS = NFRONT - NCB + NSLAVESMIN = 1 + IF ( K48 .EQ.0 .OR. (K48.EQ.5 .AND.K50.EQ.0)) THEN + NSLAVESMIN = max(NCB/max(1,KMAX),1) + ELSE IF (K48 .EQ. 3 .OR.(K48.EQ.5 .AND.K50.NE.0) ) THEN + Wmax = MUMPS_45(KMAX,NFRONT,NASS) + Wtotal = MUMPS_45(NCB,NFRONT,NASS) + Wmaster = real(NASS*NASS)*real(NASS)/(3.0) + IF ( Wmaster .GT. Wmax ) THEN + NSLAVESMIN = max ( nint ( Wtotal / Wmaster ), 1 ) + ELSE + NSLAVESMIN = max ( nint ( Wtotal / Wmax ), 1 ) + ENDIF + IF (K48 .EQ. 5) THEN + NSLAVESMIN = max ( NSLAVESMIN/2, 1 ) + END IF + ELSE IF (K48 .EQ. 4 ) THEN + IF ( K821 > 0_8 ) THEN + WRITE(*,*) 'Internal Error 1 in MUMPS_50' + CALL MUMPS_ABORT() + ENDIF + CALL MUMPS_ABORT_ON_OVERFLOW(K821, + & "K821 too large in MUMPS_50" ) + KMAX=int(abs(K821)) + IF(K50.EQ.0)THEN + NSLAVESMIN = max(int( + & (int(NCB,8)*int(NCB,8))/int(KMAX,8) + & ),1) + ELSE + ACC=0 + NSLAVESMIN=0 + DO WHILE (ACC.NE.NCB) + X=int((-real(NFRONT-NCB+ACC) + & +sqrt(((real(NFRONT-NCB+ACC)* + & real(NFRONT-NCB+ACC))+real(4)* + & real(KMAX))))/ + & real(2)) + ACC=ACC+X + NSLAVESMIN=NSLAVESMIN+1 + IF (((NCB-ACC)*NCB).LT.KMAX)THEN + ACC=NCB + NSLAVESMIN=NSLAVESMIN+1 + ENDIF + ENDDO + ENDIF + ENDIF + NSLAVESMIN = min ( NSLAVESMIN,(SLAVEF-1) ) + MUMPS_50 = + & min ( NSLAVESMIN, NCB ) + RETURN + END FUNCTION MUMPS_50 + INTEGER FUNCTION MUMPS_52 + & ( SLAVEF, K48, K821, K50, + & NFRONT, NCB) + IMPLICIT NONE + INTEGER, INTENT (IN) :: SLAVEF, K48, K50,NFRONT, NCB + INTEGER(8), INTENT(IN) :: K821 + INTEGER NSLAVESMAX, KMAX, KMIN + INTEGER NSLAVESMIN + INTEGER MUMPS_497,MUMPS_442, + & MUMPS_50, + & MUMPS_46 + EXTERNAL MUMPS_497,MUMPS_442, + & MUMPS_50, + & MUMPS_46 + IF (K48 .eq. 0 .OR. K48.eq.3.OR.K48.EQ.5) THEN + KMAX = MUMPS_497( K821, NCB ) + KMIN = MUMPS_442( K821, K50, KMAX, NCB) + NSLAVESMAX = MUMPS_46( + & SLAVEF, K48, K50, KMIN, NFRONT, NCB ) + ELSE + NSLAVESMAX = SLAVEF-1 + ENDIF + NSLAVESMIN = MUMPS_50( + & SLAVEF, K48, K821, K50, NFRONT, NCB ) + NSLAVESMAX = max ( NSLAVESMAX, NSLAVESMIN ) + MUMPS_52 = + & min ( NSLAVESMAX, NCB ) + RETURN + END FUNCTION MUMPS_52 + SUBROUTINE MUMPS_503( WHAT, KEEP,KEEP8, + & NCB, NFR, SLAVEF, NBROWMAX, MAXSURFCB8 + & ) + IMPLICIT NONE + INTEGER, intent(in) :: WHAT, NCB, NFR, SLAVEF + INTEGER, intent(in) :: KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER, intent(out) :: NBROWMAX + INTEGER(8), intent(out) :: MAXSURFCB8 + INTEGER KMAX, KMIN, NSLAVES, SIZEDUMMY, TABDUMMY(1) + EXTERNAL MUMPS_497, MUMPS_442, + & MUMPS_50 + INTEGER MUMPS_497, MUMPS_442, + & MUMPS_50 + IF ( WHAT .NE. 1 .and. WHAT .NE. 2 ) THEN + IF (WHAT .NE. 4 .and. WHAT .NE. 5 .AND. + & KEEP(48).NE.5 ) THEN + WRITE(*,*) "Internal error 1 in MUMPS_503" + CALL MUMPS_ABORT() + END IF + ENDIF + KMAX = MUMPS_497( KEEP8(21), NCB ) + IF (WHAT .EQ.1.OR.WHAT.EQ.2) THEN + NSLAVES = MUMPS_50( SLAVEF, KEEP(48), + & KEEP8(21), KEEP(50), + & NFR, NCB ) + ELSE + NSLAVES=SLAVEF + ENDIF + IF ( KEEP(48) == 0 .OR. (KEEP(48).EQ.5.AND.KEEP(50).EQ.0)) THEN + NBROWMAX = NCB / NSLAVES + mod( NCB, NSLAVES ) + IF ( WHAT == 2 .OR. WHAT == 5 ) + & MAXSURFCB8 = int(NBROWMAX,8) * int(NCB,8) + ELSE IF (KEEP(48) == 3.OR.(KEEP(48).EQ.5.AND.KEEP(50).NE.0))THEN + KMIN = MUMPS_442( KEEP8(21), KEEP(50), KMAX, NCB ) + SIZEDUMMY = 1 + IF (WHAT.GT.3) THEN + CALL MUMPS_440( + & WHAT-3, NSLAVES, NFR, NCB, + & KMIN, KMAX, SLAVEF, + & NBROWMAX, MAXSURFCB8, TABDUMMY, SIZEDUMMY) + ELSE + CALL MUMPS_440( + & WHAT, NSLAVES, NFR, NCB, + & KMIN, KMAX, SLAVEF, + & NBROWMAX, MAXSURFCB8, TABDUMMY, SIZEDUMMY) + ENDIF + ELSE IF ( KEEP(48) == 4 ) THEN + IF (KEEP8(21) > 0_8) THEN + WRITE(*,*) "Internal error 2 in MUMPS_503" + CALL MUMPS_ABORT() + END IF + IF(KEEP(50).EQ.0)THEN + IF ( abs(KEEP8(21)) * int( SLAVEF - 1,8 ) > + & int( NCB,8) * int(NFR,8) ) THEN + NBROWMAX = (NCB + SLAVEF -2 ) / ( SLAVEF - 1 ) + IF ( WHAT == 2 ) MAXSURFCB8 = int(NBROWMAX,8) *int(NCB,8) + ELSE + NBROWMAX=int( + & (abs(KEEP8(21)) + int(NFR - 1,8)) + & / int(NFR,8) + & ) + IF ( WHAT == 2 ) MAXSURFCB8 = abs(KEEP8(21)) + ENDIF + ELSE + NBROWMAX=int((-real(NFR-NCB) + & +sqrt((real(NFR-NCB)* + & real(NFR-NCB))+real(4)* + & real(abs(KEEP8(21)))))/ + & real(2)) + IF ( WHAT == 2 ) MAXSURFCB8 = abs(KEEP8(21)) + ENDIF + ELSE + NBROWMAX = NCB + IF (WHAT == 2) MAXSURFCB8 = int(NCB,8) * int(NCB,8) + ENDIF + NBROWMAX = min ( max(NBROWMAX, 1), NCB) + RETURN + END SUBROUTINE MUMPS_503 + INTEGER FUNCTION MUMPS_46( SLAVEF, K48, K50, + & BLSIZE, NFRONT, NCB) + IMPLICIT NONE + INTEGER, INTENT (IN) :: SLAVEF, K48, K50, BLSIZE, NFRONT, NCB + INTEGER NSLAVES, NASS + REAL Wtotal, Wblsize + REAL MUMPS_45 + EXTERNAL MUMPS_45 + NASS = NFRONT - NCB + NSLAVES = SLAVEF-1 + IF ( K48 .EQ.0 .OR. (K48.EQ.5 .AND. K50.EQ.0)) THEN + NSLAVES = max(NCB/max(1,BLSIZE),1) + ELSE IF (K48.EQ.3 .OR. (K48.EQ.5 .AND. K50.NE.0))THEN + Wblsize = MUMPS_45(BLSIZE,NFRONT,NASS) + Wtotal = MUMPS_45(NCB,NFRONT,NASS) + NSLAVES = max(nint ( Wtotal / Wblsize ), 1) + ENDIF + MUMPS_46 = + & min ( NSLAVES,(SLAVEF-1) ) + RETURN + END FUNCTION MUMPS_46 + SUBROUTINE MUMPS_440( + & GETPOSITIONS, NSLAVES, NFRONT, NCB, + & KMIN, KMAX, SLAVEF, + & NBROWMAX, MAXSURFCB, TABPOS, SIZETABPOS) + IMPLICIT NONE + INTEGER, INTENT (IN) :: GETPOSITIONS, + & NSLAVES, NFRONT, NCB, + & KMIN, KMAX, SLAVEF, SIZETABPOS + INTEGER, INTENT (OUT) :: NBROWMAX + INTEGER(8), INTENT(OUT) :: MAXSURFCB + INTEGER, INTENT (OUT) :: TABPOS(SIZETABPOS) + REAL W, COSTni + REAL delta + INTEGER SumNi, NCOLim1, I, BLSIZE, NASS + LOGICAL GETROW, GETSURF, GETPOS, GET_AVGROW, GET_AVGSURF + REAL MUMPS_45 + EXTERNAL MUMPS_45 + GETROW = (GETPOSITIONS.EQ.1) + GETSURF= (GETPOSITIONS.EQ.2) + GETPOS = (GETPOSITIONS.EQ.3) + GET_AVGROW = (GETPOSITIONS.EQ.4) + GET_AVGSURF = (GETPOSITIONS.EQ.5) + NBROWMAX = 0 + MAXSURFCB = 0_8 + IF (GETPOS) THEN + TABPOS (1) = 1 + TABPOS (NSLAVES+1)= NCB+1 + TABPOS (SLAVEF+2) = NSLAVES + ENDIF + IF (NSLAVES.EQ.1) THEN + IF ( GETSURF ) THEN + NBROWMAX = NCB + MAXSURFCB = int(NCB,8)*int(NCB,8) + ELSEIF ( GETROW ) THEN + NBROWMAX = NCB + ENDIF + ELSE + NASS = NFRONT - NCB + W = MUMPS_45(NCB,NFRONT,NASS) + SumNi = 0 + NCOLim1 = NASS + DO I = 1, NSLAVES-1 + delta = real(2*NCOLim1-NASS+1)**2 + + & (real(4)*W)/real(NASS*(NSLAVES-I+1)) + delta = sqrt(delta) + delta = (real(-2*NCOLim1+NASS-1) + delta )/real(2) + BLSIZE = max(int(delta), 1) + IF ( (NFRONT-NCOLim1-BLSIZE) .LE. NSLAVES-I ) THEN + BLSIZE = 1 + ENDIF + NCOLim1 = NCOLim1+BLSIZE + COSTni = MUMPS_45(BLSIZE,NCOLim1,NASS) + W = W - COSTni + IF (GETPOS) TABPOS(I) = SumNi + 1 + IF (GETSURF) THEN + NBROWMAX = max ( NBROWMAX, + & BLSIZE ) + MAXSURFCB = max ( MAXSURFCB, + & int(BLSIZE,8)* int(SumNi+BLSIZE,8) ) + ELSEIF ( GETROW ) THEN + NBROWMAX = max ( NBROWMAX, + & BLSIZE ) + RETURN + ELSEIF (GET_AVGSURF) THEN + NBROWMAX = NBROWMAX + BLSIZE + MAXSURFCB = MAXSURFCB + int(BLSIZE,8)*int(SumNi+BLSIZE,8) + ELSEIF (GET_AVGROW) THEN + NBROWMAX = NBROWMAX + BLSIZE + ENDIF + SumNi = SumNi + BLSIZE + ENDDO + BLSIZE = NCB - SumNi + IF (BLSIZE.LE.0) THEN + write(*,*) ' Error in MUMPS_440: ', + & ' size lastbloc ', BLSIZE + CALL MUMPS_ABORT() + ENDIF + if (NCOLim1+BLSIZE.NE.NFRONT) then + write(*,*) ' Error in MUMPS_440: ', + & ' NCOLim1, BLSIZE, NFRONT=', + & NCOLim1, BLSIZE, NFRONT + CALL MUMPS_ABORT() + endif + IF (GETPOS) TABPOS(NSLAVES) = SumNi + 1 + IF (GETSURF) THEN + NBROWMAX = max ( NBROWMAX, + & BLSIZE ) + MAXSURFCB = max ( MAXSURFCB, + & int(BLSIZE,8)* int(SumNi+BLSIZE,8 )) + ELSEIF ( GETROW ) THEN + NBROWMAX = max ( NBROWMAX, + & BLSIZE ) + ELSEIF (GET_AVGSURF) THEN + NBROWMAX = NBROWMAX + BLSIZE + MAXSURFCB = MAXSURFCB + int(BLSIZE,8)*int(SumNi+BLSIZE,8) + NBROWMAX=(NBROWMAX+NSLAVES-1)/NSLAVES + MAXSURFCB=(MAXSURFCB+int(NSLAVES-1,8))/int(NSLAVES,8) + ELSEIF (GET_AVGROW) THEN + NBROWMAX = NBROWMAX + BLSIZE + NBROWMAX=(NBROWMAX+NSLAVES-1)/NSLAVES + ENDIF + ENDIF + RETURN + END SUBROUTINE MUMPS_440 + SUBROUTINE MUMPS_441( + & KEEP,KEEP8, SLAVEF, + & TAB_POS_IN_PERE, + & NSLAVES, NFRONT, NCB + & ) + IMPLICIT NONE + INTEGER, INTENT( IN ) :: NCB, NSLAVES, SLAVEF, NFRONT, + & KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER TAB_POS_IN_PERE(SLAVEF+2) + INTEGER :: I, BLSIZE + INTEGER KMIN, KMAX, NBROWDUMMY, + & GETPOSITIONS, SIZECOLTAB + INTEGER(8) MAXSURFDUMMY8 + INTEGER MUMPS_442, MUMPS_497 + EXTERNAL MUMPS_442, MUMPS_497, + & MUMPS_440 + IF (KEEP(48).EQ.0) THEN + BLSIZE = NCB / NSLAVES + TAB_POS_IN_PERE( 1 ) = 1 + DO I = 1, NSLAVES-1 + TAB_POS_IN_PERE( I+1 ) = TAB_POS_IN_PERE(I) + + & BLSIZE + ENDDO + TAB_POS_IN_PERE(NSLAVES+1) = NCB+1 + TAB_POS_IN_PERE(SLAVEF+2) = NSLAVES + RETURN + ELSE IF (KEEP(48).EQ.3 ) THEN + KMAX = MUMPS_497(KEEP8(21), NCB) + KMIN = MUMPS_442(KEEP8(21), KEEP(50), KMAX, NCB) + GETPOSITIONS = 3 + SIZECOLTAB = SLAVEF+2 + CALL MUMPS_440( + & GETPOSITIONS, NSLAVES, NFRONT, NCB, + & KMIN, KMAX, SLAVEF, + & NBROWDUMMY, MAXSURFDUMMY8, + & TAB_POS_IN_PERE(1), SIZECOLTAB) + ENDIF + RETURN + END SUBROUTINE MUMPS_441 + SUBROUTINE MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & ISLAVE, NCB, NSLAVES, SIZE, FIRST_INDEX ) + IMPLICIT NONE + INTEGER, INTENT( IN ) :: ISLAVE, NCB, NSLAVES, SLAVEF, + & KEEP(500), INODE, N + INTEGER(8) KEEP8(150) + INTEGER, INTENT( IN ) :: STEP(N), + & ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER, INTENT( OUT ):: SIZE, FIRST_INDEX + INTEGER BLSIZE, J + IF (KEEP(48).EQ.0) THEN + BLSIZE = NCB / NSLAVES + IF ( ISLAVE .NE. NSLAVES ) THEN + SIZE = BLSIZE + ELSE + SIZE = BLSIZE + mod( NCB, NSLAVES ) + END IF + FIRST_INDEX = ( ISLAVE - 1 ) * BLSIZE + 1 + ELSEIF (KEEP(48).EQ.3) THEN + J = ISTEP_TO_INIV2 ( STEP(INODE) ) + FIRST_INDEX = TAB_POS_IN_PERE (ISLAVE,J) + SIZE = TAB_POS_IN_PERE (ISLAVE+1,J) - FIRST_INDEX + ELSEIF (KEEP(48).EQ.4) THEN + J = ISTEP_TO_INIV2 ( STEP(INODE) ) + FIRST_INDEX = TAB_POS_IN_PERE (ISLAVE,J) + SIZE = TAB_POS_IN_PERE (ISLAVE+1,J) - FIRST_INDEX + ELSEIF (KEEP(48).EQ.5) THEN + J = ISTEP_TO_INIV2 ( STEP(INODE) ) + FIRST_INDEX = TAB_POS_IN_PERE (ISLAVE,J) + SIZE = TAB_POS_IN_PERE (ISLAVE+1,J) - FIRST_INDEX + ELSE + WRITE(*,*) 'Error in MUMPS_BLOC2 undef strat' + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE MUMPS_49 + REAL FUNCTION MUMPS_45(NROW,NCOL,NASS) + IMPLICIT NONE + INTEGER, INTENT (IN) :: NROW,NCOL,NASS + MUMPS_45 = real(NASS*NROW)* + & real(2*NCOL - NASS - NROW + 1) + RETURN + END FUNCTION MUMPS_45 + INTEGER FUNCTION MUMPS_12 + & (K821, K48, K50, SLAVEF, + & NCB, NFRONT, NSLAVES_less, NMB_OF_CAND ) + IMPLICIT NONE + INTEGER, INTENT( IN ) :: NCB, NFRONT, NSLAVES_less, + & K48, K50, SLAVEF, NMB_OF_CAND + INTEGER(8), INTENT(IN) :: K821 + INTEGER NSLAVES + INTEGER KMAX, NPIV, + & NSLAVES_ref, NSLAVES_max + REAL WK_MASTER, WK_SLAVE + INTEGER MUMPS_497, MUMPS_50, + & MUMPS_52 + REAL MUMPS_45 + EXTERNAL MUMPS_497, MUMPS_50, + & MUMPS_52 + EXTERNAL MUMPS_45 + IF (NMB_OF_CAND.LE.0) THEN + ENDIF + IF ( (K48.EQ.0).OR. (K48.EQ.3) ) THEN + KMAX = MUMPS_497( K821, NCB ) + NSLAVES_ref = MUMPS_50( + & SLAVEF, K48, K821, K50, NFRONT, NCB ) + NSLAVES = NSLAVES_ref + IF ( NSLAVES_ref.LT.SLAVEF ) THEN + NSLAVES_max = MUMPS_52( + & SLAVEF, K48, K821, K50, NFRONT, NCB ) + IF ( NSLAVES_max .LT. NSLAVES_less ) THEN + NSLAVES = NSLAVES_max + ELSE + NSLAVES = NSLAVES_less + ENDIF + NSLAVES = max(NSLAVES_ref,NSLAVES) + ENDIF + NSLAVES = min (NSLAVES, NMB_OF_CAND) + IF ( NSLAVES.GT.NSLAVES_ref) THEN + NPIV = NFRONT - NCB + IF ( K50.EQ.0 ) THEN + WK_SLAVE = real( NPIV ) * real( NCB ) * + & ( 2.0E0 * real(NFRONT) - real(NPIV) ) + & / real(NSLAVES) + WK_MASTER = 0.66667E0 * + & real(NPIV)*real(NPIV)*real(NPIV)+ + & real(NPIV)*real(NPIV)*real(NCB) + ELSE + WK_SLAVE = MUMPS_45(NCB,NFRONT,NPIV) + & / real(NSLAVES) + WK_MASTER = real(NPIV)*real(NPIV)*real(NPIV)/3.0E0 + ENDIF + IF ( (WK_MASTER.GT.WK_SLAVE).AND. + & (WK_SLAVE.GT.1.0E0) ) THEN + NSLAVES = + & int( real(NSLAVES) * (WK_SLAVE/WK_MASTER)) + NSLAVES = max(NSLAVES_ref, NSLAVES) + ENDIF + ENDIF + ELSE + NSLAVES = NSLAVES_less + ENDIF + NSLAVES = min (NSLAVES, NCB) + NSLAVES = min (NSLAVES, NMB_OF_CAND) + MUMPS_12 = NSLAVES + RETURN + END FUNCTION MUMPS_12 + SUBROUTINE MUMPS_47( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS, NCB, + & NSLAVES, POSITION, ISLAVE, IPOSSLAVE ) + IMPLICIT NONE + INTEGER, INTENT( IN ) :: KEEP(500),INODE,N,SLAVEF + INTEGER(8) KEEP8(150) + INTEGER, INTENT( IN ) :: STEP(N), + & ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER, INTENT( IN ) :: NASS, NCB, + & NSLAVES, POSITION + INTEGER, INTENT( OUT ) :: ISLAVE, IPOSSLAVE + INTEGER BLSIZE, J, ISHIFT + IF ((NSLAVES.LE.0).OR.(POSITION.LE.NASS)) THEN + ISLAVE = 0 + IPOSSLAVE = POSITION + RETURN + ENDIF + IF ( KEEP(48).EQ.0) THEN + BLSIZE = NCB / NSLAVES + ISLAVE = min( NSLAVES, + & ( POSITION - NASS - 1 ) / BLSIZE + 1 ) + IPOSSLAVE = POSITION - NASS - ( ISLAVE - 1 ) * BLSIZE + ELSEIF (KEEP(48).EQ.3) THEN + J = ISTEP_TO_INIV2 ( STEP(INODE) ) + ISHIFT = POSITION - NASS + DO ISLAVE = NSLAVES,1,-1 + IF ( ISHIFT .GE. TAB_POS_IN_PERE(ISLAVE,J)) THEN + IPOSSLAVE = ISHIFT - TAB_POS_IN_PERE(ISLAVE,J) + 1 + EXIT + END IF + END DO + ELSEIF (KEEP(48).EQ.4) THEN + J = ISTEP_TO_INIV2 ( STEP(INODE) ) + ISHIFT = POSITION - NASS + DO ISLAVE = NSLAVES,1,-1 + IF ( ISHIFT .GE. TAB_POS_IN_PERE(ISLAVE,J)) THEN + IPOSSLAVE = ISHIFT - TAB_POS_IN_PERE(ISLAVE,J) + 1 + EXIT + END IF + END DO + ELSEIF (KEEP(48).EQ.5) THEN + J = ISTEP_TO_INIV2 ( STEP(INODE) ) + ISHIFT = POSITION - NASS + DO ISLAVE = NSLAVES,1,-1 + IF ( ISHIFT .GE. TAB_POS_IN_PERE(ISLAVE,J)) THEN + IPOSSLAVE = ISHIFT - TAB_POS_IN_PERE(ISLAVE,J) + 1 + EXIT + END IF + END DO + ELSE + WRITE(*,*) 'Error in MUMPS_47: undef strat' + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE MUMPS_47 + INTEGER FUNCTION MUMPS_442( K821, K50, KMAX, NCB ) + IMPLICIT NONE + INTEGER, INTENT( IN ) :: KMAX, NCB, K50 + INTEGER(8), INTENT(IN) :: K821 + INTEGER KMIN, MINGRAN + INTEGER(8) :: KMINSURF + IF ( ( NCB .LE.0 ).OR. (KMAX.LE.0) ) THEN + MUMPS_442 = 1 + RETURN + ENDIF + IF (K50.EQ.0) THEN + KMINSURF = 60000_8 +#if defined(t3e) || defined(sgi) + MINGRAN = 40 +#else + MINGRAN = 50 +#endif + ELSE + KMINSURF = 30000_8 +#if defined(t3e) || defined(sgi) + MINGRAN = 10 +#else + MINGRAN = 20 +#endif + ENDIF + IF (K821.GT.0_8) THEN +#if defined(t3e) || defined(sgi) + KMIN = max(MINGRAN,KMAX/10) +#else + KMIN = max(MINGRAN,KMAX/20) +#endif + ELSE + KMINSURF = max( abs(K821)/500_8, KMINSURF ) + KMIN = max( + & int( KMINSURF / int(max(NCB,1),8) ), + & 1 + & ) + ENDIF + KMIN = min(KMIN,KMAX) + KMIN = max(KMIN,1) + MUMPS_442 = KMIN + RETURN + END FUNCTION MUMPS_442 + INTEGER FUNCTION MUMPS_497( KEEP821, NCB ) + IMPLICIT NONE + INTEGER, intent( in ) :: NCB + INTEGER(8), intent( in ) :: KEEP821 + INTEGER KMAX + IF ( NCB .LE.0 ) THEN + MUMPS_497 = 1 + RETURN + ENDIF + IF ( KEEP821.GT.0_8 ) THEN + KMAX = int(KEEP821) + ELSE + KMAX = -int(KEEP821/int(NCB,8)) + ENDIF + KMAX = min (NCB, KMAX) + MUMPS_497 = max ( KMAX, 1 ) + RETURN + END FUNCTION MUMPS_497 + SUBROUTINE MUMPS_546( IS, DS ) + INTEGER IS, DS +#if defined(t3e) + IS = 8 + DS = 16 +#else + IS = 4 + DS = 8 +#endif + END SUBROUTINE MUMPS_546 + SUBROUTINE MUMPS_SET_VERSION( VERSION_STR ) + IMPLICIT NONE + CHARACTER(LEN=*) :: VERSION_STR + CHARACTER(LEN=*) :: V; + PARAMETER (V = "4.10.0" ) + IF ( len(V) .GT. 14 ) THEN + WRITE(*,*) "Version string too long ( >14 characters )" + CALL MUMPS_ABORT() + END IF + VERSION_STR = V + RETURN + END SUBROUTINE MUMPS_SET_VERSION + SUBROUTINE MUMPS_420 + & ( JOB, THRESH, NDENSE, + & N, IWLEN, PE, PFREE, LEN, IW, NV, + & ELEN, LAST, NCMPA, DEGREE, HEAD, NEXT, W, + & PERM, COMPLEM_LIST, SIZE_COMPLEM_LIST, AGG6 ) + IMPLICIT NONE + INTEGER JOB + INTEGER N, IWLEN, PE(N), PFREE, LEN(N), IW(IWLEN), NV(N), + & ELEN(N), LAST(N), NCMPA, DEGREE(N), HEAD(N), NEXT(N), + & W(N) + LOGICAL AGG6 + INTEGER, intent(in) :: SIZE_COMPLEM_LIST + INTEGER NDENSE(N) + INTEGER, intent (in) :: COMPLEM_LIST(max(1,SIZE_COMPLEM_LIST)) + INTEGER PERM(N) + INTEGER THRESH + INTEGER THRESM, NDME, PERMeqN + INTEGER NBD,NBED, NBDM, LASTD, NELME + LOGICAL IDENSE + INTEGER FDEG, ThresMin, ThresPrev, IBEGSchur, + & ThresMinINIT + LOGICAL SchurON + INTEGER DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I, + & ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3, + & LENJ, LN, MAXMEM, ME, MEM, MINDEG, NEL, NEWMEM, + & NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X + INTEGER MAXINT_N + INTEGER(8) HASH, HMOD + INTEGER P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, PN, PSRC + INTRINSIC max, min, mod + IF (N.EQ.1) THEN + ELEN(1) = 1 + LAST(1) = 1 + PE(1) = 0 + NV(1) = 1 + RETURN + ENDIF + IF ( SIZE_COMPLEM_LIST < 0 .OR. SIZE_COMPLEM_LIST > N ) THEN + WRITE(*,*) "Internal MUMPS_420", SIZE_COMPLEM_LIST,N + CALL MUMPS_ABORT() + ENDIF + IF (JOB.EQ.2) THEN + SchurON = .FALSE. + ENDIF + IF (JOB.NE.2) THEN + SchurON = (SIZE_COMPLEM_LIST > 0) + IF ((JOB.EQ.1) .AND. (.NOT.SchurON) .AND. (N .GT. 0)) THEN + WRITE(6,*) ' WARNING MUMPS_420 on Options ' + ENDIF + IBEGSchur = N-SIZE_COMPLEM_LIST+1 + IF (THRESH.GT.N) THRESH = N + IF (THRESH.LT.0) THRESH = 0 + IF ( SchurON ) THEN + DO I= 1, N + IF ( PERM(I) .GE. IBEGSchur) THEN + PERM(I) = N + 1 + IF (LEN(I) .EQ.0) THEN + PE(I) = 0 + ENDIF + ENDIF + ENDDO + ENDIF + ENDIF + IF (SchurON) THEN + THRESM = N + ThresMin = N + ThresPrev = N + ELSE + THRESM = max(int(31*N/32),THRESH) + THRESM = max(THRESM,1) + ThresMin = max( 3*THRESM / 4, 1) + ThresPrev = THRESM + ENDIF + ThresMinINIT = ThresMin/4 + IF (THRESM.GT.0) THEN + IF ((THRESM.GT.N).OR.(THRESM.LT.2)) THEN + THRESM = N + ENDIF + ENDIF + IF (JOB.EQ.2) THEN + ENDIF + PERMeqN = 0 + LASTD = 0 + NBD = 0 + NBED = 0 + NBDM = 0 + NEL = 0 + WFLG = 2 + MAXINT_N=huge(WFLG)-N + MINDEG = 1 + NCMPA = 0 + HMOD = int(max (1, N-1),kind=8) + DMAX = 0 + MEM = PFREE - 1 + MAXMEM = MEM + DO 10 I = 1, N + NDENSE(I)= 0 + LAST (I) = 0 + HEAD (I) = 0 + NV (I) = 1 + W (I) = 1 + 10 CONTINUE + IF (JOB.EQ.2) THEN + DO I = 1,SIZE_COMPLEM_LIST + X = COMPLEM_LIST(I) + ELEN(X) = -I + NV(X) = LEN(X)+1 + DMAX = max(DMAX, LEN(X)) + ENDDO + NEL = NEL + SIZE_COMPLEM_LIST + DO I=1,N + DEGREE (I) = LEN (I) + ENDDO + ELSE + DO I=1, N + ELEN (I) = 0 + DEGREE (I) = LEN (I) + ENDDO + ENDIF + DO 20 I = 1, N + IF (ELEN(I).LT.0) CYCLE + DEG = DEGREE (I) + IF (PERM(I).EQ.N) THEN + PERMeqN = I + PERM(I) = N-1 + ENDIF + FDEG = PERM(I) + IF ( (DEG .GT. 0).OR.(PERM(I).EQ.N+1) ) THEN + IF ( (THRESM.GT.0) .AND. + & (FDEG .GT.THRESM) ) THEN + NBD = NBD+1 + IF (FDEG.NE.N+1) THEN + DEGREE(I) = DEGREE(I)+N+2 + DEG = N + INEXT = HEAD (DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + LAST(I) = 0 + IF (LASTD.EQ.0) LASTD=I + ELSE + NBED = NBED+1 + DEGREE(I) = N+1 + DEG = N + IF (LASTD.EQ.0) THEN + LASTD = I + HEAD(DEG) = I + NEXT(I) = 0 + LAST(I) = 0 + ELSE + NEXT(LASTD) = I + LAST(I) = LASTD + LASTD = I + NEXT(I) = 0 + ENDIF + ENDIF + ELSE + INEXT = HEAD (FDEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (FDEG) = I + ENDIF + ELSE + NEL = NEL + 1 + ELEN (I) = -NEL + PE (I) = 0 + W (I) = 0 + ENDIF + 20 CONTINUE + IF ((NBD.EQ.0).AND.(THRESM.GT.0)) THRESM = N + 30 IF (NEL .LT. N) THEN + DO 40 DEG = MINDEG, N + ME = HEAD (DEG) + IF (ME .GT. 0) GO TO 50 + 40 CONTINUE + 50 MINDEG = DEG + IF ( (DEG.NE.N) .AND. + & (DEG.GT.THRESM+1) .AND. (NBD.GT.0) ) THEN + MINDEG = N + GOTO 30 + ENDIF + IF (DEGREE(ME).LE.N) THEN + INEXT = NEXT (ME) + IF (INEXT .NE. 0) LAST (INEXT) = 0 + HEAD (DEG) = INEXT + ELSE + MINDEG = 1 + NBDM = max(NBDM,NBD) + IF (DEGREE(ME).GT.N+1) THEN + IF (WFLG .GT. MAXINT_N) THEN + DO 52 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 52 CONTINUE + WFLG = 2 + ENDIF + WFLG = WFLG + 1 + 51 CONTINUE + INEXT = NEXT (ME) + IF (INEXT .NE. 0) THEN + LAST (INEXT) = 0 + ELSE + LASTD = 0 + ENDIF + NDENSE(ME) = 0 + W(ME) = WFLG + P1 = PE(ME) + P2 = P1 + LEN(ME) -1 + LN = P1 + ELN = P1 + DO 55 P=P1,P2 + E= IW(P) + IF (W(E).EQ.WFLG) GOTO 55 + W(E) = WFLG + IF (PE(E).LT.0) THEN + X = E + 53 X = -PE(X) + IF (W(X) .EQ.WFLG) GOTO 55 + W(X) = WFLG + IF ( PE(X) .LT. 0 ) GOTO 53 + E = X + ENDIF + IF (ELEN(E).LT.0) THEN + NDENSE(E) = NDENSE(E) - NV(ME) + IW(LN) = IW(ELN) + IW(ELN) = E + LN = LN+1 + ELN = ELN + 1 + PME1 = PE(E) + DO 54 PME = PME1, PME1+LEN(E)-1 + X = IW(PME) + IF ((ELEN(X).GE.0).AND.(W(X).NE.WFLG)) THEN + NDENSE(ME) = NDENSE(ME) + NV(X) + W(X) = WFLG + ENDIF + 54 CONTINUE + ELSE + NDENSE(ME) = NDENSE(ME) + NV(E) + IW(LN)=E + LN = LN+1 + ENDIF + 55 CONTINUE + WFLG = WFLG + 1 + LEN(ME) = LN-P1 + ELEN(ME) = ELN- P1 + NDME = NDENSE(ME)+NV(ME) + IF (NDENSE(ME).EQ.0) NDENSE(ME) =1 + DEGREE(ME) = NDENSE(ME) + DEG = PERM(ME) + MINDEG = min(DEG,MINDEG) + JNEXT = HEAD(DEG) + IF (JNEXT.NE. 0) LAST (JNEXT) = ME + NEXT(ME) = JNEXT + HEAD(DEG) = ME + ME = INEXT + IF (ME.NE.0) THEN + IF (DEGREE(ME).GT.(N+1) ) GOTO 51 + ENDIF + HEAD (N) = ME + IF (THRESM.LT.N) THEN + ThresMin = max(THRESM+ThresMin,ThresPrev+ThresMin/2+1) + ThresMin = min(ThresMin, N) + ThresPrev = ThresPrev+(N-ThresPrev)/2+ThresMinINIT + THRESM = max( + & THRESM + int(sqrt(dble(ThresMin)))+ ThresMinINIT , + & ThresPrev) + THRESM = min(THRESM,N) + ThresMin = min(THRESM, ThresMin) + ThresPrev = THRESM + ENDIF + NBD = NBED + GOTO 30 + ENDIF + IF (DEGREE(ME).EQ.N+1) THEN + IF (NBD.NE.NBED) THEN + write(6,*) ' ERROR in MUMPS_420 ', + & ' quasi dense rows remains' + CALL MUMPS_ABORT() + ENDIF + IF (JOB.EQ.1) THEN + DO I = 1,SIZE_COMPLEM_LIST + X = COMPLEM_LIST(I) + ELEN(X) = -(N-SIZE_COMPLEM_LIST+I) + NV(X) = 1 + PE(X) = 0 + ENDDO + GOTO 265 + ENDIF + NELME = -(NEL+1) + DO 59 X=1,N + IF ((PE(X).GT.0) .AND. (ELEN(X).LT.0)) THEN + PE(X) = -COMPLEM_LIST(1) + ELSEIF (DEGREE(X).EQ.N+1) THEN + NEL = NEL + NV(X) + PE(X) = -ME + ELEN(X) = 0 + NV(X) = 0 + ENDIF + 59 CONTINUE + ELEN(ME) = NELME + NV(ME) = NBD + PE(ME) = 0 + IF (NEL.NE.N) THEN + write(6,*) 'Internal ERROR 2 detected in QAMD' + write(6,*) ' NEL not equal to N: N, NEL =',N,NEL + CALL MUMPS_ABORT() + ENDIF + IF (ME.NE. COMPLEM_LIST(1)) THEN + DO I=1, SIZE_COMPLEM_LIST + PE(COMPLEM_LIST(I)) = -COMPLEM_LIST(1) + ENDDO + PE(COMPLEM_LIST(1)) = 0 + NV( COMPLEM_LIST(1))= NV(ME) + NV(ME) = 0 + ELEN( COMPLEM_LIST(1)) = ELEN(ME) + ELEN(ME) = 0 + ENDIF + GOTO 265 + ENDIF + ENDIF + ELENME = ELEN (ME) + ELEN (ME) = - (NEL + 1) + NVPIV = NV (ME) + NEL = NEL + NVPIV + NDENSE(ME) = 0 + NV (ME) = -NVPIV + DEGME = 0 + IF (ELENME .EQ. 0) THEN + PME1 = PE (ME) + PME2 = PME1 - 1 + DO 60 P = PME1, PME1 + LEN (ME) - 1 + I = IW (P) + NVI = NV (I) + IF (NVI .GT. 0) THEN + DEGME = DEGME + NVI + NV (I) = -NVI + PME2 = PME2 + 1 + IW (PME2) = I + IF (DEGREE(I).LE.N) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (PERM(I)) = INEXT + ENDIF + ELSE + NDENSE(ME) = NDENSE(ME) + NVI + ENDIF + ENDIF + 60 CONTINUE + NEWMEM = 0 + ELSE + P = PE (ME) + PME1 = PFREE + SLENME = LEN (ME) - ELENME + DO 120 KNT1 = 1, ELENME + 1 + IF (KNT1 .GT. ELENME) THEN + E = ME + PJ = P + LN = SLENME + ELSE + E = IW (P) + P = P + 1 + PJ = PE (E) + LN = LEN (E) + ENDIF + DO 110 KNT2 = 1, LN + I = IW (PJ) + PJ = PJ + 1 + NVI = NV (I) + IF (NVI .GT. 0) THEN + IF (PFREE .GT. IWLEN) THEN + PE (ME) = P + LEN (ME) = LEN (ME) - KNT1 + IF (LEN (ME) .EQ. 0) PE (ME) = 0 + PE (E) = PJ + LEN (E) = LN - KNT2 + IF (LEN (E) .EQ. 0) PE (E) = 0 + NCMPA = NCMPA + 1 + DO 70 J = 1, N + PN = PE (J) + IF (PN .GT. 0) THEN + PE (J) = IW (PN) + IW (PN) = -J + ENDIF + 70 CONTINUE + PDST = 1 + PSRC = 1 + PEND = PME1 - 1 + 80 CONTINUE + IF (PSRC .LE. PEND) THEN + J = -IW (PSRC) + PSRC = PSRC + 1 + IF (J .GT. 0) THEN + IW (PDST) = PE (J) + PE (J) = PDST + PDST = PDST + 1 + LENJ = LEN (J) + DO 90 KNT3 = 0, LENJ - 2 + IW (PDST + KNT3) = IW (PSRC + KNT3) + 90 CONTINUE + PDST = PDST + LENJ - 1 + PSRC = PSRC + LENJ - 1 + ENDIF + GO TO 80 + ENDIF + P1 = PDST + DO 100 PSRC = PME1, PFREE - 1 + IW (PDST) = IW (PSRC) + PDST = PDST + 1 + 100 CONTINUE + PME1 = P1 + PFREE = PDST + PJ = PE (E) + P = PE (ME) + ENDIF + DEGME = DEGME + NVI + NV (I) = -NVI + IW (PFREE) = I + PFREE = PFREE + 1 + IF (DEGREE(I).LE.N) THEN + ILAST = LAST (I) + INEXT = NEXT (I) + IF (INEXT .NE. 0) LAST (INEXT) = ILAST + IF (ILAST .NE. 0) THEN + NEXT (ILAST) = INEXT + ELSE + HEAD (PERM(I)) = INEXT + ENDIF + ELSE + NDENSE(ME) = NDENSE(ME) + NVI + ENDIF + ENDIF + 110 CONTINUE + IF (E .NE. ME) THEN + PE (E) = -ME + W (E) = 0 + ENDIF + 120 CONTINUE + PME2 = PFREE - 1 + NEWMEM = PFREE - PME1 + MEM = MEM + NEWMEM + MAXMEM = max (MAXMEM, MEM) + ENDIF + DEGREE (ME) = DEGME + PE (ME) = PME1 + LEN (ME) = PME2 - PME1 + 1 + IF (WFLG .GT. MAXINT_N) THEN + DO 130 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 130 CONTINUE + WFLG = 2 + ENDIF + DO 150 PME = PME1, PME2 + I = IW (PME) + IF (DEGREE(I).GT.N) GOTO 150 + ELN = ELEN (I) + IF (ELN .GT. 0) THEN + NVI = -NV (I) + WNVI = WFLG - NVI + DO 140 P = PE (I), PE (I) + ELN - 1 + E = IW (P) + WE = W (E) + IF (WE .GE. WFLG) THEN + WE = WE - NVI + ELSE IF (WE .NE. 0) THEN + WE = DEGREE (E) + WNVI - NDENSE(E) + ENDIF + W (E) = WE + 140 CONTINUE + ENDIF + 150 CONTINUE + DO 180 PME = PME1, PME2 + I = IW (PME) + IF (DEGREE(I).GT.N) GOTO 180 + P1 = PE (I) + P2 = P1 + ELEN (I) - 1 + PN = P1 + HASH = 0_8 + DEG = 0 + DO 160 P = P1, P2 + E = IW (P) + DEXT = W (E) - WFLG + IF (DEXT .GT. 0) THEN + DEG = DEG + DEXT + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) + ELSE IF (.NOT. AGG6 .AND. DEXT .EQ. 0) THEN + IW (PN) = E + PN = PN + 1 + HASH = HASH + int(E,kind=8) + ELSE IF (AGG6 .AND. (DEXT .EQ. 0) .AND. + & ((NDENSE(ME).EQ.NBD).OR.(NDENSE(E).EQ.0))) THEN + PE (E) = -ME + W (E) = 0 + ELSE IF (AGG6 .AND. DEXT.EQ.0) THEN + IW(PN) = E + PN = PN+1 + HASH = HASH + int(E,kind=8) + ENDIF + 160 CONTINUE + ELEN (I) = PN - P1 + 1 + P3 = PN + DO 170 P = P2 + 1, P1 + LEN (I) - 1 + J = IW (P) + NVJ = NV (J) + IF (NVJ .GT. 0) THEN + IF (DEGREE(J).LE.N) DEG=DEG+NVJ + IW (PN) = J + PN = PN + 1 + HASH = HASH + int(J,kind=8) + ENDIF + 170 CONTINUE + IF (((ELEN(I).EQ.1).AND.(P3.EQ.PN)) + & .OR. + & (AGG6.AND.(DEG .EQ. 0).AND.(NDENSE(ME).EQ.NBD)) + & ) + & THEN + PE (I) = -ME + NVI = -NV (I) + DEGME = DEGME - NVI + NVPIV = NVPIV + NVI + NEL = NEL + NVI + NV (I) = 0 + ELEN (I) = 0 + ELSE + DEGREE(I) = min (DEG+NBD-NDENSE(ME), + & DEGREE(I)) + IW (PN) = IW (P3) + IW (P3) = IW (P1) + IW (P1) = ME + LEN (I) = PN - P1 + 1 + HASH = mod (HASH, HMOD) + 1_8 + J = HEAD (HASH) + IF (J .LE. 0) THEN + NEXT (I) = -J + HEAD (HASH) = -I + ELSE + NEXT (I) = LAST (J) + LAST (J) = I + ENDIF + LAST (I) = int(HASH,kind=kind(LAST)) + ENDIF + 180 CONTINUE + DEGREE (ME) = DEGME + DMAX = max (DMAX, DEGME) + WFLG = WFLG + DMAX + IF (WFLG .GT. MAXINT_N) THEN + DO 190 X = 1, N + IF (W (X) .NE. 0) W (X) = 1 + 190 CONTINUE + WFLG = 2 + ENDIF + DO 250 PME = PME1, PME2 + I = IW (PME) + IF ( (NV(I).LT.0) .AND. (DEGREE(I).LE.N) ) THEN + HASH = int(LAST (I),kind=8) + J = HEAD (HASH) + IF (J .EQ. 0) GO TO 250 + IF (J .LT. 0) THEN + I = -J + HEAD (HASH) = 0 + ELSE + I = LAST (J) + LAST (J) = 0 + ENDIF + IF (I .EQ. 0) GO TO 250 + 200 CONTINUE + IF (NEXT (I) .NE. 0) THEN + X = I + LN = LEN (I) + ELN = ELEN (I) + DO 210 P = PE (I) + 1, PE (I) + LN - 1 + W (IW (P)) = WFLG + 210 CONTINUE + JLAST = I + J = NEXT (I) + 220 CONTINUE + IF (J .NE. 0) THEN + IF (LEN (J) .NE. LN) GO TO 240 + IF (ELEN (J) .NE. ELN) GO TO 240 + DO 230 P = PE (J) + 1, PE (J) + LN - 1 + IF (W (IW (P)) .NE. WFLG) GO TO 240 + 230 CONTINUE + IF (PERM(J).GT.PERM(X)) THEN + PE (J) = -X + NV (X) = NV (X) + NV (J) + NV (J) = 0 + ELEN (J) = 0 + ELSE + PE (X) = -J + NV (J) = NV (X) + NV (J) + NV (X) = 0 + ELEN (X) = 0 + X = J + ENDIF + J = NEXT (J) + NEXT (JLAST) = J + GO TO 220 + 240 CONTINUE + JLAST = J + J = NEXT (J) + GO TO 220 + ENDIF + WFLG = WFLG + 1 + I = NEXT (I) + IF (I .NE. 0) GO TO 200 + ENDIF + ENDIF + 250 CONTINUE + IF ( (THRESM .GT. 0).AND.(THRESM.LT.N) ) THEN + THRESM = max(ThresMin, THRESM-NVPIV) + ENDIF + P = PME1 + NLEFT = N - NEL + DO 260 PME = PME1, PME2 + I = IW (PME) + NVI = -NV (I) + IF (NVI .GT. 0) THEN + NV (I) = NVI + IF (DEGREE(I).LE.N) THEN + DEG = min (DEGREE (I)+ DEGME - NVI, NLEFT - NVI) + DEGREE (I) = DEG + IDENSE = .FALSE. + IF (THRESM.GT.0) THEN + IF (PERM(I) .GT. THRESM) THEN + IDENSE = .TRUE. + DEGREE(I) = DEGREE(I)+N+2 + ENDIF + IF (IDENSE) THEN + P1 = PE(I) + P2 = P1 + ELEN(I) - 1 + IF (P2.GE.P1) THEN + DO 264 PJ=P1,P2 + E= IW(PJ) + NDENSE (E) = NDENSE(E) + NVI + 264 CONTINUE + ENDIF + NBD = NBD+NVI + FDEG = N + DEG = N + INEXT = HEAD(DEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + HEAD (DEG) = I + LAST(I) = 0 + IF (LASTD.EQ.0) LASTD=I + ENDIF + ENDIF + IF (.NOT.IDENSE) THEN + FDEG = PERM(I) + INEXT = HEAD (FDEG) + IF (INEXT .NE. 0) LAST (INEXT) = I + NEXT (I) = INEXT + LAST (I) = 0 + HEAD (FDEG) = I + ENDIF + MINDEG = min (MINDEG, FDEG) + ENDIF + IW (P) = I + P = P + 1 + ENDIF + 260 CONTINUE + NV (ME) = NVPIV + DEGME + LEN (ME) = P - PME1 + IF (LEN (ME) .EQ. 0) THEN + PE (ME) = 0 + W (ME) = 0 + ENDIF + IF (NEWMEM .NE. 0) THEN + PFREE = P + MEM = MEM - NEWMEM + LEN (ME) + ENDIF + GO TO 30 + ENDIF + 265 CONTINUE + DO 290 I = 1, N + IF (ELEN (I) .EQ. 0) THEN + J = -PE (I) + 270 CONTINUE + IF (ELEN (J) .GE. 0) THEN + J = -PE (J) + GO TO 270 + ENDIF + E = J + K = -ELEN (E) + J = I + 280 CONTINUE + IF (ELEN (J) .GE. 0) THEN + JNEXT = -PE (J) + PE (J) = -E + IF (ELEN (J) .EQ. 0) THEN + ELEN (J) = K + K = K + 1 + ENDIF + J = JNEXT + GO TO 280 + ENDIF + ELEN (E) = -K + ENDIF + 290 CONTINUE + DO 300 I = 1, N + K = abs (ELEN (I)) + LAST (K) = I + ELEN (I) = K + 300 CONTINUE + IF (.NOT.SchurON) THEN + IF (PERMeqN.GT.0) PERM(PERMeqN) = N + ENDIF + PFREE = MAXMEM + RETURN + END SUBROUTINE MUMPS_420 + SUBROUTINE MUMPS_209( N, FRERE, FILS, NFSIZ, THEROOT ) + IMPLICIT NONE + INTEGER, intent( in ) :: N + INTEGER, intent( in ) :: NFSIZ( N ) + INTEGER, intent( inout ) :: FRERE( N ), FILS( N ) + INTEGER, intent( out ) :: THEROOT + INTEGER INODE, IROOT, IFILS, IN, IROOTLAST, SIZE + IROOT = -9999 + SIZE = 0 + DO INODE = 1, N + IF ( FRERE( INODE ) .EQ. 0 ) THEN + IF ( NFSIZ( INODE ) .GT. SIZE ) THEN + SIZE = NFSIZ( INODE ) + IROOT = INODE + END IF + ENDIF + END DO + IN = IROOT + DO WHILE ( FILS( IN ) .GT. 0 ) + IN = FILS( IN ) + END DO + IROOTLAST = IN + IFILS = - FILS ( IN ) + DO INODE = 1, N + IF ( FRERE( INODE ) .eq. 0 .and. INODE .ne. IROOT ) THEN + IF ( IFILS .eq. 0 ) THEN + FILS( IROOTLAST ) = - INODE + FRERE( INODE ) = -IROOT + IFILS = INODE + ELSE + FRERE( INODE ) = -FILS( IROOTLAST ) + FILS( IROOTLAST ) = - INODE + END IF + END IF + END DO + THEROOT = IROOT + RETURN + END SUBROUTINE MUMPS_209 + INTEGER FUNCTION MUMPS_330(PROCINFO_INODE, SLAVEF) + IMPLICIT NONE + INTEGER SLAVEF + INTEGER PROCINFO_INODE, TPN + IF (PROCINFO_INODE <= SLAVEF ) THEN + MUMPS_330 = 1 + ELSE + TPN = (PROCINFO_INODE-1+2*SLAVEF)/SLAVEF - 1 + IF ( TPN .LT. 1 ) TPN = 1 + IF (TPN.EQ.4.OR.TPN.EQ.5.OR.TPN.EQ.6) TPN = 2 + MUMPS_330 = TPN + END IF + RETURN + END FUNCTION MUMPS_330 + INTEGER FUNCTION MUMPS_275(PROCINFO_INODE, SLAVEF) + IMPLICIT NONE + INTEGER SLAVEF + INTEGER PROCINFO_INODE + IF (SLAVEF == 1) THEN + MUMPS_275 = 0 + ELSE + MUMPS_275=mod(2*SLAVEF+PROCINFO_INODE-1,SLAVEF) + END IF + RETURN + END FUNCTION MUMPS_275 + INTEGER FUNCTION MUMPS_810 (PROCINFO_INODE, SLAVEF) + IMPLICIT NONE + INTEGER, intent(in) :: SLAVEF + INTEGER PROCINFO_INODE, TPN + IF (PROCINFO_INODE <= SLAVEF ) THEN + MUMPS_810 = 1 + ELSE + TPN = (PROCINFO_INODE-1+2*SLAVEF)/SLAVEF - 1 + IF ( TPN .LT. 1 ) TPN = 1 + MUMPS_810 = TPN + ENDIF + RETURN + END FUNCTION MUMPS_810 + LOGICAL FUNCTION MUMPS_283( PROCINFO_INODE, SLAVEF ) + IMPLICIT NONE + INTEGER SLAVEF + INTEGER TPN, PROCINFO_INODE + TPN = (PROCINFO_INODE-1+2*SLAVEF)/SLAVEF - 1 + MUMPS_283 = ( TPN .eq. 0 ) + RETURN + END FUNCTION MUMPS_283 + LOGICAL FUNCTION MUMPS_167( PROCINFO_INODE, SLAVEF ) + IMPLICIT NONE + INTEGER SLAVEF + INTEGER TPN, PROCINFO_INODE + TPN = (PROCINFO_INODE-1+SLAVEF+SLAVEF)/SLAVEF - 1 + MUMPS_167 = ( TPN .eq. -1 ) + RETURN + END FUNCTION MUMPS_167 + LOGICAL FUNCTION MUMPS_170 + & ( PROCINFO_INODE, SLAVEF ) + IMPLICIT NONE + INTEGER SLAVEF + INTEGER TPN, PROCINFO_INODE + TPN = (PROCINFO_INODE-1+SLAVEF+SLAVEF)/SLAVEF - 1 + MUMPS_170 = + & ( TPN .eq. -1 .OR. TPN .eq. 0 ) + RETURN + END FUNCTION MUMPS_170 + LOGICAL FUNCTION MUMPS_358( MYID, SLAVEF, INODE, + & NMB_PAR2, ISTEP_TO_INIV2 , K71, STEP, N, + & CANDIDATES, KEEP24 ) + IMPLICIT NONE + INTEGER MYID, SLAVEF, INODE, NMB_PAR2, KEEP24, I + INTEGER K71, N + INTEGER ISTEP_TO_INIV2 ( K71 ), STEP ( N ) + INTEGER CANDIDATES(SLAVEF+1, max(NMB_PAR2,1)) + INTEGER NCAND, POSINODE + MUMPS_358 = .FALSE. + IF (KEEP24 .eq. 0) RETURN + POSINODE = ISTEP_TO_INIV2 ( STEP (INODE) ) + NCAND = CANDIDATES( SLAVEF+1, POSINODE ) + DO I = 1, NCAND + IF (MYID .EQ. CANDIDATES( I, POSINODE )) + & MUMPS_358 = .TRUE. + END DO + RETURN + END FUNCTION MUMPS_358 + SUBROUTINE MUMPS_291(T) + DOUBLE PRECISION T + DOUBLE PRECISION MPI_WTIME + EXTERNAL MPI_WTIME + T=MPI_WTIME() + RETURN + END SUBROUTINE MUMPS_291 + SUBROUTINE MUMPS_292(T) + DOUBLE PRECISION T + DOUBLE PRECISION MPI_WTIME + EXTERNAL MPI_WTIME + T=MPI_WTIME()-T + RETURN + END SUBROUTINE MUMPS_292 + SUBROUTINE MUMPS_558( N, VAL, ID ) + INTEGER N + INTEGER ID( N ) + DOUBLE PRECISION VAL( N ) + INTEGER I, ISWAP + DOUBLE PRECISION SWAP + LOGICAL DONE + DONE = .FALSE. + DO WHILE ( .NOT. DONE ) + DONE = .TRUE. + DO I = 1, N - 1 + IF ( VAL( I ) .GT. VAL( I + 1 ) ) THEN + DONE = .FALSE. + ISWAP = ID( I ) + ID ( I ) = ID ( I + 1 ) + ID ( I + 1 ) = ISWAP + SWAP = VAL( I ) + VAL( I ) = VAL( I + 1 ) + VAL( I + 1 ) = SWAP + END IF + END DO + END DO + RETURN + END SUBROUTINE MUMPS_558 +#if defined (PESSL) + SUBROUTINE DESCINIT( DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, + & LLD, INFO ) + INTEGER ICSRC, ICTXT, INFO, IRSRC, LLD, M, MB, N, NB + INTEGER DESC( * ) + INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, + & LLD_, MB_, M_, NB_, N_, RSRC_ +# if defined(DESC8) + PARAMETER ( DLEN_ = 8, DTYPE_ = 1, + & CTXT_ = 7, M_ = 1, N_ = 2, MB_ = 3, NB_ = 4, + & RSRC_ = 5, CSRC_ = 6, LLD_ = 8 ) +# else + PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, + & CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, + & RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) +# endif + INTEGER MYCOL, MYROW, NPCOL, NPROW + EXTERNAL blacs_gridinfo, PXERBLA + INTEGER NUMROC + EXTERNAL NUMROC + INTRINSIC max, min + CALL blacs_gridinfo( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -3 + ELSE IF( MB.LT.1 ) THEN + INFO = -4 + ELSE IF( NB.LT.1 ) THEN + INFO = -5 + ELSE IF( IRSRC.LT.0 .OR. IRSRC.GE.NPROW ) THEN + INFO = -6 + ELSE IF( ICSRC.LT.0 .OR. ICSRC.GE.NPCOL ) THEN + INFO = -7 + ELSE IF( NPROW.EQ.-1 ) THEN + INFO = -8 + ELSE IF( LLD.LT.max( 1, numroc( M, MB, MYROW, IRSRC, + & NPROW ) ) ) THEN + INFO = -9 + END IF + IF( INFO.NE.0 ) + & CALL PXERBLA( ICTXT, 'DESCINIT', -INFO ) +# ifndef DESC8 + DESC( DTYPE_ ) = BLOCK_CYCLIC_2D +# endif + DESC( M_ ) = max( 0, M ) + DESC( N_ ) = max( 0, N ) + DESC( MB_ ) = max( 1, MB ) + DESC( NB_ ) = max( 1, NB ) + DESC( RSRC_ ) = max( 0, min( IRSRC, NPROW-1 ) ) + DESC( CSRC_ ) = max( 0, min( ICSRC, NPCOL-1 ) ) + DESC( CTXT_ ) = ICTXT + DESC( LLD_ ) = max( LLD, max( 1, numroc( DESC( M_ ), DESC( MB_ ), + & MYROW, DESC( RSRC_ ), NPROW ) ) ) + RETURN + END SUBROUTINE DESCINIT + SUBROUTINE PXERBLA( ICTXT, SRNAME, INFO ) + INTEGER ICTXT, INFO + CHARACTER*(*) SRNAME + INTEGER MYCOL, MYROW, NPCOL, NPROW + EXTERNAL blacs_gridinfo + CALL blacs_gridinfo( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) + WRITE( *, FMT = 9999 ) MYROW, MYCOL, SRNAME, INFO + 9999 FORMAT( '{', I5, ',', I5, '}: On entry to ', A, + & ' parameter number', I4, ' had an illegal value' ) + END SUBROUTINE PXERBLA +#endif + SUBROUTINE MUMPS_243(MYID, COMM, INFO, INFOG, IRANK) + IMPLICIT NONE + INTEGER MYID, COMM, IRANK, INFO, INFOG(2) + INCLUDE 'mpif.h' + INTEGER IERR_MPI, MASTER + INTEGER TEMP1(2), TEMP2(2) + PARAMETER( MASTER = 0 ) + CALL MPI_REDUCE( INFO, INFOG(1), 1, MPI_INTEGER, + & MPI_MAX, MASTER, COMM, IERR_MPI ) + CALL MPI_REDUCE( INFO, INFOG(2), 1, MPI_INTEGER, + & MPI_SUM, MASTER, COMM, IERR_MPI ) + TEMP1(1) = INFO + TEMP1(2) = MYID + CALL MPI_REDUCE( TEMP1, TEMP2, 1, MPI_2INTEGER, + & MPI_MAXLOC, MASTER, COMM, IERR_MPI ) + IF ( MYID.eq. MASTER ) THEN + IF ( INFOG(1) .ne. TEMP2(1) ) THEN + write(*,*) 'Error in MUMPS_243' + CALL MUMPS_ABORT() + END IF + IRANK = TEMP2(2) + ELSE + IRANK = -1 + END IF + RETURN + END SUBROUTINE MUMPS_243 + SUBROUTINE MUMPS_362(N, LEAF, NBROOT, NROOT_LOC, + & MYID_NODES, + & SLAVEF, NA, LNA, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, IPOOL, LPOOL) + IMPLICIT NONE + INTEGER N, LEAF, NROOT_LOC, NBROOT, MYID_NODES, + & SLAVEF, LPOOL, LNA + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER STEP(N) + INTEGER PROCNODE_STEPS(KEEP(28)), NA(LNA), + & IPOOL(LPOOL) + INTEGER NBLEAF, INODE, I + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + NBLEAF = NA(1) + NBROOT = NA(2) + LEAF = 1 + DO I = 1, NBLEAF + INODE = NA(I+2) + IF (MUMPS_275(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + & .EQ.MYID_NODES) THEN + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + ENDIF + ENDDO + NROOT_LOC = 0 + DO I = 1, NBROOT + INODE = NA(I+2+NBLEAF) + IF (MUMPS_275(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF).EQ.MYID_NODES) THEN + NROOT_LOC = NROOT_LOC + 1 + END IF + ENDDO + RETURN + END SUBROUTINE MUMPS_362 + LOGICAL FUNCTION MUMPS_438(TAB1,TAB2,LEN1,LEN2) + IMPLICIT NONE + INTEGER LEN1 , LEN2 ,I + INTEGER TAB1(LEN1) + INTEGER TAB2(LEN2) + MUMPS_438=.FALSE. + IF(LEN1 .NE. LEN2) THEN + RETURN + ENDIF + DO I=1 , LEN1 + IF(TAB1(I) .NE. TAB2(I)) THEN + RETURN + ENDIF + ENDDO + MUMPS_438=.TRUE. + RETURN + END FUNCTION MUMPS_438 + SUBROUTINE MUMPS_463( N, VAL, ID ) + INTEGER N + INTEGER ID( N ) + INTEGER VAL( N ) + INTEGER I, ISWAP + INTEGER SWAP + LOGICAL DONE + DONE = .FALSE. + DO WHILE ( .NOT. DONE ) + DONE = .TRUE. + DO I = 1, N - 1 + IF ( VAL( I ) .GT. VAL( I + 1 ) ) THEN + DONE = .FALSE. + ISWAP = ID( I ) + ID ( I ) = ID ( I + 1 ) + ID ( I + 1 ) = ISWAP + SWAP = VAL( I ) + VAL( I ) = VAL( I + 1 ) + VAL( I + 1 ) = SWAP + END IF + END DO + END DO + RETURN + END SUBROUTINE MUMPS_463 + SUBROUTINE MUMPS_466( N, VAL, ID ) + INTEGER N + INTEGER ID( N ) + INTEGER VAL( N ) + INTEGER I, ISWAP + INTEGER SWAP + LOGICAL DONE + DONE = .FALSE. + DO WHILE ( .NOT. DONE ) + DONE = .TRUE. + DO I = 1, N - 1 + IF ( VAL( I ) .LT. VAL( I + 1 ) ) THEN + DONE = .FALSE. + ISWAP = ID( I ) + ID ( I ) = ID ( I + 1 ) + ID ( I + 1 ) = ISWAP + SWAP = VAL( I ) + VAL( I ) = VAL( I + 1 ) + VAL( I + 1 ) = SWAP + END IF + END DO + END DO + RETURN + END SUBROUTINE MUMPS_466 + SUBROUTINE MUMPS_ABORT() + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR, IERRCODE + IERRCODE = -99 + CALL MPI_ABORT(MPI_COMM_WORLD, IERRCODE, IERR) + RETURN + END SUBROUTINE MUMPS_ABORT + SUBROUTINE MUMPS_633(KEEP12,ICNTL14, + & KEEP50,KEEP54,ICNTL6,ICNTL8) + IMPLICIT NONE + INTEGER, intent(out)::KEEP12 + INTEGER, intent(in)::ICNTL14,KEEP50,KEEP54,ICNTL6,ICNTL8 + KEEP12 = ICNTL14 + IF(ICNTL6.EQ.0 .AND. ICNTL8.EQ.0) RETURN + IF ( (KEEP54.NE.0).AND. (KEEP50.NE.1) + & .AND. (KEEP12 .GT. 0) ) KEEP12= KEEP12+5 + RETURN + END SUBROUTINE MUMPS_633 + SUBROUTINE MUMPS_749( I8_VALUE, ROOT, MYID, COMM, IERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER ROOT, MYID, COMM, IERR + INTEGER(8) :: I8_VALUE + DOUBLE PRECISION :: DBLE_VALUE + IF (MYID .EQ. ROOT) THEN + DBLE_VALUE = dble(I8_VALUE) + ENDIF + CALL MPI_BCAST( DBLE_VALUE, 1, MPI_DOUBLE_PRECISION, + & ROOT, COMM, IERR ) + I8_VALUE = int( DBLE_VALUE,8) + RETURN + END SUBROUTINE MUMPS_749 + SUBROUTINE MUMPS_646( IN, OUT, MPI_OP, ROOT, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER ROOT, COMM, MPI_OP + INTEGER(8) IN, OUT + INTEGER IERR + DOUBLE PRECISION DIN, DOUT + DIN =dble(IN) + DOUT=0.0D0 + CALL MPI_REDUCE(DIN, DOUT, 1, MPI_DOUBLE_PRECISION, + & MPI_OP, ROOT, COMM, IERR) + OUT=int(DOUT,kind=8) + RETURN + END SUBROUTINE MUMPS_646 + SUBROUTINE MUMPS_736( IN, OUT, MPI_OP, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER COMM, MPI_OP + INTEGER(8) IN, OUT + INTEGER IERR + DOUBLE PRECISION DIN, DOUT + DIN =dble(IN) + DOUT=0.0D0 + CALL MPI_ALLREDUCE(DIN, DOUT, 1, MPI_DOUBLE_PRECISION, + & MPI_OP, COMM, IERR) + OUT=int(DOUT,kind=8) + RETURN + END SUBROUTINE MUMPS_736 + SUBROUTINE MUMPS_754(ARRAY, MINSIZE, INFO, LP, FORCE, COPY, + & STRING, MEMCNT, ERRCODE) + INTEGER, POINTER :: ARRAY(:) + INTEGER :: INFO(:) + INTEGER :: MINSIZE, LP + LOGICAL, OPTIONAL :: FORCE + LOGICAL, OPTIONAL :: COPY + CHARACTER, OPTIONAL :: STRING*(*) + INTEGER, OPTIONAL :: ERRCODE, MEMCNT + LOGICAL :: ICOPY, IFORCE + INTEGER, POINTER :: TEMP(:) + INTEGER :: I, IERR, ERRTPL(2) + CHARACTER :: FMTA*60, FMTD*60 + IF(present(COPY)) THEN + ICOPY = COPY + ELSE + ICOPY = .FALSE. + END IF + IF (present(FORCE)) THEN + IFORCE = FORCE + ELSE + IFORCE = .FALSE. + END IF + IF (present(STRING)) THEN + FMTA = "Allocation failed inside realloc: "//STRING + FMTD = "Deallocation failed inside realloc: "//STRING + ELSE + FMTA = "Allocation failed inside realloc: " + FMTD = "Deallocation failed inside realloc: " + END IF + IF (present(ERRCODE)) THEN + ERRTPL = (/ERRCODE, MINSIZE/) + ELSE + ERRTPL = (/-13, MINSIZE/) + END IF + IF(ICOPY) THEN + IF(associated(ARRAY)) THEN + IF ((size(ARRAY) .LT. MINSIZE) .OR. + & ((size(ARRAY).NE.MINSIZE) .AND. IFORCE)) THEN + allocate(TEMP(MINSIZE), STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTA) + INFO(1:2) = ERRTPL + RETURN + ELSE + IF(present(MEMCNT))MEMCNT = MEMCNT+MINSIZE + END IF + DO I=1, min(size(ARRAY), MINSIZE) + TEMP(I) = ARRAY(I) + END DO + IF(present(MEMCNT))MEMCNT = MEMCNT-size(ARRAY) + deallocate(ARRAY, STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTD) + INFO(1:2) = ERRTPL + RETURN + END IF + NULLIFY(ARRAY) + ARRAY => TEMP + NULLIFY(TEMP) + END IF + ELSE + WRITE(LP, + & '("Input array is not associated. nothing to copy here")') + RETURN + END IF + ELSE + IF(associated(ARRAY)) THEN + IF ((size(ARRAY) .LT. MINSIZE) .OR. + & ((size(ARRAY).NE.MINSIZE) .AND. IFORCE)) THEN + IF(present(MEMCNT))MEMCNT = MEMCNT-size(ARRAY) + deallocate(ARRAY, STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTD) + INFO(1:2) = ERRTPL + RETURN + END IF + ELSE + RETURN + END IF + END IF + allocate(ARRAY(MINSIZE), STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTA) + INFO(1:2) = ERRTPL + RETURN + ELSE + IF(present(MEMCNT)) MEMCNT = MEMCNT+MINSIZE + END IF + END IF + RETURN + END SUBROUTINE MUMPS_754 + SUBROUTINE MUMPS_750(ARRAY, MINSIZE, INFO, LP, FORCE, COPY, + & STRING, MEMCNT, ERRCODE) + REAL(kind(1.E0)), POINTER :: ARRAY(:) + INTEGER :: INFO(:) + INTEGER :: MINSIZE, LP + LOGICAL, OPTIONAL :: FORCE + LOGICAL, OPTIONAL :: COPY + CHARACTER, OPTIONAL :: STRING*(*) + INTEGER, OPTIONAL :: ERRCODE, MEMCNT + LOGICAL :: ICOPY, IFORCE + REAL(kind(1.E0)), POINTER :: TEMP(:) + INTEGER :: I, IERR, ERRTPL(2) + CHARACTER :: FMTA*60, FMTD*60 + IF(present(COPY)) THEN + ICOPY = COPY + ELSE + ICOPY = .FALSE. + END IF + IF (present(FORCE)) THEN + IFORCE = FORCE + ELSE + IFORCE = .FALSE. + END IF + IF (present(STRING)) THEN + FMTA = "Allocation failed inside realloc: "//STRING + FMTD = "Deallocation failed inside realloc: "//STRING + ELSE + FMTA = "Allocation failed inside realloc: " + FMTD = "Deallocation failed inside realloc: " + END IF + IF (present(ERRCODE)) THEN + ERRTPL = (/ERRCODE, MINSIZE/) + ELSE + ERRTPL = (/-13, MINSIZE/) + END IF + IF(ICOPY) THEN + IF(associated(ARRAY)) THEN + IF ((size(ARRAY) .LT. MINSIZE) .OR. + & ((size(ARRAY).NE.MINSIZE) .AND. IFORCE)) THEN + allocate(TEMP(MINSIZE), STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTA) + INFO(1:2) = ERRTPL + RETURN + ELSE + IF(present(MEMCNT))MEMCNT = MEMCNT+MINSIZE + END IF + DO I=1, min(size(ARRAY), MINSIZE) + TEMP(I) = ARRAY(I) + END DO + IF(present(MEMCNT))MEMCNT = MEMCNT-size(ARRAY) + deallocate(ARRAY, STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTD) + INFO(1:2) = ERRTPL + RETURN + END IF + NULLIFY(ARRAY) + ARRAY => TEMP + NULLIFY(TEMP) + END IF + ELSE + WRITE(LP, + & '("Input array is not associated. nothing to copy here")') + RETURN + END IF + ELSE + IF(associated(ARRAY)) THEN + IF ((size(ARRAY) .LT. MINSIZE) .OR. + & ((size(ARRAY).NE.MINSIZE) .AND. IFORCE)) THEN + IF(present(MEMCNT))MEMCNT = MEMCNT-size(ARRAY) + deallocate(ARRAY, STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTD) + INFO(1:2) = ERRTPL + RETURN + END IF + ELSE + RETURN + END IF + END IF + allocate(ARRAY(MINSIZE), STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTA) + INFO(1:2) = ERRTPL + RETURN + ELSE + IF(present(MEMCNT)) MEMCNT = MEMCNT+MINSIZE + END IF + END IF + RETURN + END SUBROUTINE MUMPS_750 + SUBROUTINE MUMPS_752(ARRAY, MINSIZE, INFO, LP, FORCE, COPY, + & STRING, MEMCNT, ERRCODE) + REAL(kind(1.D0)), POINTER :: ARRAY(:) + INTEGER :: INFO(:) + INTEGER :: MINSIZE, LP + LOGICAL, OPTIONAL :: FORCE + LOGICAL, OPTIONAL :: COPY + CHARACTER, OPTIONAL :: STRING*(*) + INTEGER, OPTIONAL :: ERRCODE, MEMCNT + LOGICAL :: ICOPY, IFORCE + REAL(kind(1.D0)), POINTER :: TEMP(:) + INTEGER :: I, IERR, ERRTPL(2) + CHARACTER :: FMTA*60, FMTD*60 + IF(present(COPY)) THEN + ICOPY = COPY + ELSE + ICOPY = .FALSE. + END IF + IF (present(FORCE)) THEN + IFORCE = FORCE + ELSE + IFORCE = .FALSE. + END IF + IF (present(STRING)) THEN + FMTA = "Allocation failed inside realloc: "//STRING + FMTD = "Deallocation failed inside realloc: "//STRING + ELSE + FMTA = "Allocation failed inside realloc: " + FMTD = "Deallocation failed inside realloc: " + END IF + IF (present(ERRCODE)) THEN + ERRTPL = (/ERRCODE, MINSIZE/) + ELSE + ERRTPL = (/-13, MINSIZE/) + END IF + IF(ICOPY) THEN + IF(associated(ARRAY)) THEN + IF ((size(ARRAY) .LT. MINSIZE) .OR. + & ((size(ARRAY).NE.MINSIZE) .AND. IFORCE)) THEN + allocate(TEMP(MINSIZE), STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTA) + INFO(1:2) = ERRTPL + RETURN + ELSE + IF(present(MEMCNT))MEMCNT = MEMCNT+MINSIZE + END IF + DO I=1, min(size(ARRAY), MINSIZE) + TEMP(I) = ARRAY(I) + END DO + IF(present(MEMCNT))MEMCNT = MEMCNT-size(ARRAY) + deallocate(ARRAY, STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTD) + INFO(1:2) = ERRTPL + RETURN + END IF + NULLIFY(ARRAY) + ARRAY => TEMP + NULLIFY(TEMP) + END IF + ELSE + WRITE(LP, + & '("Input array is not associated. nothing to copy here")') + RETURN + END IF + ELSE + IF(associated(ARRAY)) THEN + IF ((size(ARRAY) .LT. MINSIZE) .OR. + & ((size(ARRAY).NE.MINSIZE) .AND. IFORCE)) THEN + IF(present(MEMCNT))MEMCNT = MEMCNT-size(ARRAY) + deallocate(ARRAY, STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTD) + INFO(1:2) = ERRTPL + RETURN + END IF + ELSE + RETURN + END IF + END IF + allocate(ARRAY(MINSIZE), STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTA) + INFO(1:2) = ERRTPL + RETURN + ELSE + IF(present(MEMCNT)) MEMCNT = MEMCNT+MINSIZE + END IF + END IF + RETURN + END SUBROUTINE MUMPS_752 + SUBROUTINE MUMPS_751(ARRAY, MINSIZE, INFO, LP, FORCE, COPY, + & STRING, MEMCNT, ERRCODE) + COMPLEX(kind((1.E0,1.E0))), POINTER :: ARRAY(:) + INTEGER :: INFO(:) + INTEGER :: MINSIZE, LP + LOGICAL, OPTIONAL :: FORCE + LOGICAL, OPTIONAL :: COPY + CHARACTER, OPTIONAL :: STRING*(*) + INTEGER, OPTIONAL :: ERRCODE, MEMCNT + LOGICAL :: ICOPY, IFORCE + COMPLEX(kind((1.E0,1.E0))), POINTER :: TEMP(:) + INTEGER :: I, IERR, ERRTPL(2) + CHARACTER :: FMTA*60, FMTD*60 + IF(present(COPY)) THEN + ICOPY = COPY + ELSE + ICOPY = .FALSE. + END IF + IF (present(FORCE)) THEN + IFORCE = FORCE + ELSE + IFORCE = .FALSE. + END IF + IF (present(STRING)) THEN + FMTA = "Allocation failed inside realloc: "//STRING + FMTD = "Deallocation failed inside realloc: "//STRING + ELSE + FMTA = "Allocation failed inside realloc: " + FMTD = "Deallocation failed inside realloc: " + END IF + IF (present(ERRCODE)) THEN + ERRTPL = (/ERRCODE, MINSIZE/) + ELSE + ERRTPL = (/-13, MINSIZE/) + END IF + IF(ICOPY) THEN + IF(associated(ARRAY)) THEN + IF ((size(ARRAY) .LT. MINSIZE) .OR. + & ((size(ARRAY).NE.MINSIZE) .AND. IFORCE)) THEN + allocate(TEMP(MINSIZE), STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTA) + INFO(1:2) = ERRTPL + RETURN + ELSE + IF(present(MEMCNT))MEMCNT = MEMCNT+MINSIZE + END IF + DO I=1, min(size(ARRAY), MINSIZE) + TEMP(I) = ARRAY(I) + END DO + IF(present(MEMCNT))MEMCNT = MEMCNT-size(ARRAY) + deallocate(ARRAY, STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTD) + INFO(1:2) = ERRTPL + RETURN + END IF + NULLIFY(ARRAY) + ARRAY => TEMP + NULLIFY(TEMP) + END IF + ELSE + WRITE(LP, + & '("Input array is not associated. nothing to copy here")') + RETURN + END IF + ELSE + IF(associated(ARRAY)) THEN + IF ((size(ARRAY) .LT. MINSIZE) .OR. + & ((size(ARRAY).NE.MINSIZE) .AND. IFORCE)) THEN + IF(present(MEMCNT))MEMCNT = MEMCNT-size(ARRAY) + deallocate(ARRAY, STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTD) + INFO(1:2) = ERRTPL + RETURN + END IF + ELSE + RETURN + END IF + END IF + allocate(ARRAY(MINSIZE), STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTA) + INFO(1:2) = ERRTPL + RETURN + ELSE + IF(present(MEMCNT)) MEMCNT = MEMCNT+MINSIZE + END IF + END IF + RETURN + END SUBROUTINE MUMPS_751 + SUBROUTINE MUMPS_753(ARRAY, MINSIZE, INFO, LP, FORCE, COPY, + & STRING, MEMCNT, ERRCODE) + COMPLEX(kind((1.D0,1.D0))), POINTER :: ARRAY(:) + INTEGER :: INFO(:) + INTEGER :: MINSIZE, LP + LOGICAL, OPTIONAL :: FORCE + LOGICAL, OPTIONAL :: COPY + CHARACTER, OPTIONAL :: STRING*(*) + INTEGER, OPTIONAL :: ERRCODE, MEMCNT + LOGICAL :: ICOPY, IFORCE + COMPLEX(kind((1.D0,1.D0))), POINTER :: TEMP(:) + INTEGER :: I, IERR, ERRTPL(2) + CHARACTER :: FMTA*60, FMTD*60 + IF(present(COPY)) THEN + ICOPY = COPY + ELSE + ICOPY = .FALSE. + END IF + IF (present(FORCE)) THEN + IFORCE = FORCE + ELSE + IFORCE = .FALSE. + END IF + IF (present(STRING)) THEN + FMTA = "Allocation failed inside realloc: "//STRING + FMTD = "Deallocation failed inside realloc: "//STRING + ELSE + FMTA = "Allocation failed inside realloc: " + FMTD = "Deallocation failed inside realloc: " + END IF + IF (present(ERRCODE)) THEN + ERRTPL = (/ERRCODE, MINSIZE/) + ELSE + ERRTPL = (/-13, MINSIZE/) + END IF + IF(ICOPY) THEN + IF(associated(ARRAY)) THEN + IF ((size(ARRAY) .LT. MINSIZE) .OR. + & ((size(ARRAY).NE.MINSIZE) .AND. IFORCE)) THEN + allocate(TEMP(MINSIZE), STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTA) + INFO(1:2) = ERRTPL + RETURN + ELSE + IF(present(MEMCNT))MEMCNT = MEMCNT+MINSIZE + END IF + DO I=1, min(size(ARRAY), MINSIZE) + TEMP(I) = ARRAY(I) + END DO + IF(present(MEMCNT))MEMCNT = MEMCNT-size(ARRAY) + deallocate(ARRAY, STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTD) + INFO(1:2) = ERRTPL + RETURN + END IF + NULLIFY(ARRAY) + ARRAY => TEMP + NULLIFY(TEMP) + END IF + ELSE + WRITE(LP, + & '("Input array is not associated. nothing to copy here")') + RETURN + END IF + ELSE + IF(associated(ARRAY)) THEN + IF ((size(ARRAY) .LT. MINSIZE) .OR. + & ((size(ARRAY).NE.MINSIZE) .AND. IFORCE)) THEN + IF(present(MEMCNT))MEMCNT = MEMCNT-size(ARRAY) + deallocate(ARRAY, STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTD) + INFO(1:2) = ERRTPL + RETURN + END IF + ELSE + RETURN + END IF + END IF + allocate(ARRAY(MINSIZE), STAT=IERR) + IF(IERR .LT. 0) THEN + WRITE(LP,FMTA) + INFO(1:2) = ERRTPL + RETURN + ELSE + IF(present(MEMCNT)) MEMCNT = MEMCNT+MINSIZE + END IF + END IF + RETURN + END SUBROUTINE MUMPS_753 + SUBROUTINE MUMPS_735(I8, I4) + IMPLICIT NONE + INTEGER , INTENT(OUT) :: I4 + INTEGER(8), INTENT(IN) :: I8 + IF ( I8 .GT. int(huge(I4),8) ) THEN + I4 = -int(I8/1000000_8,kind(I4)) + ELSE + I4 = int(I8,kind(I4)) + ENDIF + RETURN + END SUBROUTINE MUMPS_735 + SUBROUTINE MUMPS_ABORT_ON_OVERFLOW(I8, STRING) + IMPLICIT NONE + INTEGER(8), INTENT(IN) :: I8 + CHARACTER(*), INTENT(IN) :: STRING + INTEGER I4 + IF ( I8 .GT. int(huge(I4),8)) THEN + WRITE(*,*) STRING + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE MUMPS_ABORT_ON_OVERFLOW + SUBROUTINE MUMPS_731( SIZE8, IERROR ) + INTEGER(8), INTENT(IN) :: SIZE8 + INTEGER, INTENT(OUT) :: IERROR + CALL MUMPS_735(SIZE8, IERROR) + RETURN + END SUBROUTINE MUMPS_731 + SUBROUTINE MUMPS_730(I8, INT_ARRAY) + IMPLICIT NONE + INTEGER(8), intent(in) :: I8 + INTEGER, intent(out) :: INT_ARRAY(2) + INTEGER(kind(0_4)) :: I32 + INTEGER(8) :: IDIV, IPAR + PARAMETER (IPAR=int(huge(I32),8)) + PARAMETER (IDIV=IPAR+1_8) + IF ( I8 .LT. IDIV ) THEN + INT_ARRAY(1) = 0 + INT_ARRAY(2) = int(I8) + ELSE + INT_ARRAY(1) = int(I8 / IDIV) + INT_ARRAY(2) = int(mod(I8,IDIV)) + ENDIF + RETURN + END SUBROUTINE MUMPS_730 + SUBROUTINE MUMPS_729(I8, INT_ARRAY) + IMPLICIT NONE + INTEGER(8), intent(out) :: I8 + INTEGER, intent(in) :: INT_ARRAY(2) + INTEGER(kind(0_4)) :: I32 + INTEGER(8) :: IDIV, IPAR + PARAMETER (IPAR=int(huge(I32),8)) + PARAMETER (IDIV=IPAR+1_8) + IF ( INT_ARRAY(1) .EQ. 0 ) THEN + I8=int(INT_ARRAY(2),8) + ELSE + I8=int(INT_ARRAY(1),8)*IDIV+int(INT_ARRAY(2),8) + ENDIF + RETURN + END SUBROUTINE MUMPS_729 + SUBROUTINE MUMPS_723( INT_ARRAY, I8 ) + IMPLICIT NONE + INTEGER(8), intent(in) :: I8 + INTEGER, intent(inout) :: INT_ARRAY(2) + INTEGER(8) :: I8TMP + CALL MUMPS_729(I8TMP, INT_ARRAY) + I8TMP = I8TMP + I8 + CALL MUMPS_730(I8TMP, INT_ARRAY) + RETURN + END SUBROUTINE MUMPS_723 + SUBROUTINE MUMPS_724( INT_ARRAY, I8 ) + IMPLICIT NONE + INTEGER(8), intent(in) :: I8 + INTEGER, intent(inout) :: INT_ARRAY(2) + INTEGER(8) :: I8TMP + CALL MUMPS_729(I8TMP, INT_ARRAY) + I8TMP = I8TMP - I8 + CALL MUMPS_730(I8TMP, INT_ARRAY) + RETURN + END SUBROUTINE MUMPS_724 + FUNCTION MUMPS_815(WHICH) + LOGICAL :: MUMPS_815 + CHARACTER :: WHICH*(*) + LOGICAL :: PTSCOTCH=.FALSE., PARMETIS=.FALSE. +#if defined(ptscotch) + PTSCOTCH = .TRUE. +#endif +#if defined(parmetis) + PARMETIS = .TRUE. +#endif + SELECT CASE(WHICH) + CASE('ptscotch','PTSCOTCH') + MUMPS_815 = PTSCOTCH + CASE('parmetis','PARMETIS') + MUMPS_815 = PARMETIS + CASE('both','BOTH') + MUMPS_815 = PTSCOTCH .AND. PARMETIS + CASE('any','ANY') + MUMPS_815 = PTSCOTCH .OR. PARMETIS + CASE default + write(*,'("Invalid input in MUMPS_815")') + END SELECT + RETURN + END FUNCTION MUMPS_815 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_size.c b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_size.c new file mode 100644 index 000000000..37e6aa277 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_size.c @@ -0,0 +1,55 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +/* Utility to automatically get the sizes of Fortran types */ +#include "mumps_size.h" +void MUMPS_CALL MUMPS_SIZE_C(char *a, char *b, MUMPS_INT *diff) +{ + *diff = (MUMPS_INT) (b - a); +} diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_size.h b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_size.h new file mode 100644 index 000000000..a46d4208c --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_size.h @@ -0,0 +1,56 @@ +/* + * + * This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 + * + * + * This version of MUMPS is provided to you free of charge. It is public + * domain, based on public domain software developed during the Esprit IV + * European project PARASOL (1996-1999). Since this first public domain + * version in 1999, research and developments have been supported by the + * following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, + * INRIA, and University of Bordeaux. + * + * The MUMPS team at the moment of releasing this version includes + * Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, + * Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora + * Ucar and Clement Weisbecker. + * + * We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil + * Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, + * Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire + * Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who + * have been contributing to this project. + * + * Up-to-date copies of the MUMPS package can be obtained + * from the Web pages: + * http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS + * + * + * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY + * EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. + * + * + * User documentation of any code that uses this software can + * include this complete notice. You can acknowledge (using + * references [1] and [2]) the contribution of this package + * in any scientific publication dependent upon the use of the + * package. You shall use reasonable endeavours to notify + * the authors of the package of this publication. + * + * [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, + * A fully asynchronous multifrontal solver using distributed dynamic + * scheduling, SIAM Journal of Matrix Analysis and Applications, + * Vol 23, No 1, pp 15-41 (2001). + * + * [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and + * S. Pralet, Hybrid scheduling for the parallel solution of linear + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +#ifndef MUMPS_SIZE_H +#define MUMPS_SIZE_H +#include "mumps_common.h" +#define MUMPS_SIZE_C \ + F_SYMBOL( size_c, SIZE_C) +void MUMPS_CALL MUMPS_SIZE_C(char *a, char *b, MUMPS_INT *diff); +#endif /* MUMPS_SIZE_H */ diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_sol_es.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_sol_es.F new file mode 100644 index 000000000..b17558dae --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_sol_es.F @@ -0,0 +1,425 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE MUMPS_SOL_ES + PRIVATE + PUBLIC:: PRUNED_SIZE_LOADED + PUBLIC:: MUMPS_797 + PUBLIC:: MUMPS_802 + PUBLIC:: MUMPS_798 + PUBLIC:: MUMPS_803 + PUBLIC:: MUMPS_804 + INTEGER(8), POINTER, DIMENSION(:,:) :: SIZE_OF_BLOCK + INTEGER(8) :: PRUNED_SIZE_LOADED + CONTAINS + SUBROUTINE MUMPS_804(SIZE_OF_BLOCK_ARG, KEEP201) + IMPLICIT NONE + INTEGER, INTENT(IN) :: KEEP201 + INTEGER(8), POINTER, DIMENSION(:,:) :: SIZE_OF_BLOCK_ARG + IF (KEEP201 > 0) THEN + SIZE_OF_BLOCK => SIZE_OF_BLOCK_ARG + ELSE + NULLIFY(SIZE_OF_BLOCK) + ENDIF + RETURN + END SUBROUTINE MUMPS_804 + SUBROUTINE MUMPS_798( + & fill, + & DAD, NE_STEPS, FRERE, KEEP28, + & FILS, STEP, N, + & nodes_RHS, nb_nodes_RHS, + & TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves + & ) + IMPLICIT NONE + LOGICAL, INTENT(IN) :: fill + INTEGER, INTENT(IN) :: N, KEEP28 + INTEGER, INTENT(IN) :: DAD(KEEP28),NE_STEPS(KEEP28),FRERE(KEEP28) + INTEGER, INTENT(IN) :: FILS(N), STEP(N) + INTEGER, INTENT(IN) :: nodes_RHS(KEEP28), nb_nodes_RHS + INTEGER :: nb_prun_nodes + INTEGER, OPTIONAL, INTENT(INOUT):: Pruned_List(nb_prun_nodes) + INTEGER :: nb_prun_roots + INTEGER, OPTIONAL, INTENT(INOUT):: Pruned_Roots(nb_prun_roots) + INTEGER :: nb_prun_leaves + INTEGER, OPTIONAL, INTENT(INOUT):: Pruned_Leaves(nb_prun_leaves) + LOGICAL :: TO_PROCESS(KEEP28) + INTEGER :: IN, I, ISTEP, TMP, TMPsave + nb_prun_nodes = 0 + nb_prun_leaves = 0 + TO_PROCESS(:) = .FALSE. + DO I = 1, nb_nodes_RHS + TMP = nodes_RHS(I) + TMPsave = TMP + ISTEP = STEP(TMP) + DO WHILE(.NOT.TO_PROCESS(ISTEP)) + TO_PROCESS(ISTEP) = .TRUE. + nb_prun_nodes = nb_prun_nodes + 1 + IF(fill) THEN + Pruned_List(nb_prun_nodes) = TMP + END IF + IN = FILS(TMP) + DO WHILE(IN.GT.0) + IN = FILS(IN) + END DO + IF (IN.LT.0) THEN + TMP = -IN + ISTEP = STEP(TMP) + ELSE + nb_prun_leaves = nb_prun_leaves + 1 + IF(fill) THEN + Pruned_Leaves(nb_prun_leaves) = TMP + END IF + IF(TMP.NE.TMPsave) THEN + TMP = abs(FRERE(ISTEP)) + IF(TMP.NE.0) THEN + ISTEP = STEP(TMP) + END IF + END IF + END IF + END DO + END DO + nb_prun_roots = 0 + DO I=1,nb_nodes_RHS + TMP = nodes_RHS(I) + ISTEP = STEP(TMP) + IF(DAD(ISTEP).NE.0) THEN + IF(.NOT.TO_PROCESS(STEP(DAD(ISTEP)))) THEN + nb_prun_roots = nb_prun_roots + 1 + IF(fill) THEN + Pruned_Roots(nb_prun_roots) = TMP + END IF + END IF + ELSE + nb_prun_roots = nb_prun_roots + 1 + IF(fill) THEN + Pruned_Roots(nb_prun_roots) = TMP + END IF + END IF + END DO + RETURN + END SUBROUTINE MUMPS_798 + SUBROUTINE MUMPS_797( + & fill, + & DAD, KEEP28, + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes,nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves + & ) + IMPLICIT NONE + LOGICAL, INTENT(IN) :: fill + INTEGER, INTENT(IN) :: N + INTEGER, INTENT(IN) :: STEP(N) + INTEGER, INTENT(IN) :: KEEP28 + INTEGER, INTENT(IN) :: DAD(KEEP28) + INTEGER, INTENT(IN) :: nb_nodes_RHS + INTEGER, INTENT(IN) :: nodes_RHS(nb_nodes_RHS) + INTEGER :: nb_prun_nodes + INTEGER, OPTIONAL, INTENT(INOUT):: Pruned_List(nb_prun_nodes) + INTEGER :: nb_prun_roots + INTEGER, OPTIONAL, INTENT(INOUT):: Pruned_Roots(nb_prun_roots) + INTEGER :: nb_prun_leaves + INTEGER, OPTIONAL, INTENT(INOUT):: Pruned_Leaves(nb_prun_leaves) + INTEGER :: Pruned_SONS(KEEP28) + LOGICAL :: TO_PROCESS(KEEP28) + INTEGER :: IN, I, ISTEP, TMP + nb_prun_nodes = 0 + nb_prun_roots = 0 + TO_PROCESS(:) = .FALSE. + Pruned_SONS(:) = -1 + DO I = 1, nb_nodes_RHS + TMP = nodes_RHS(I) + ISTEP = STEP(TMP) + TO_PROCESS(ISTEP) = .TRUE. + IF (Pruned_SONS(ISTEP) .eq. -1) THEN + Pruned_SONS(ISTEP) = 0 + nb_prun_nodes = nb_prun_nodes + 1 + IF(fill) THEN + Pruned_List(nb_prun_nodes) = nodes_RHS(I) + END IF + IN = nodes_RHS(I) + IN = DAD(STEP(IN)) + DO WHILE (IN.NE.0) + TO_PROCESS(STEP(IN)) = .TRUE. + IF (Pruned_SONS(STEP(IN)).eq.-1) THEN + nb_prun_nodes = nb_prun_nodes + 1 + IF(fill) THEN + Pruned_List(nb_prun_nodes) = IN + END IF + Pruned_SONS(STEP(IN)) = 1 + TMP = IN + IN = DAD(STEP(IN)) + ELSE + Pruned_SONS(STEP(IN)) = Pruned_SONS(STEP(IN)) + 1 + GOTO 201 + ENDIF + ENDDO + nb_prun_roots = nb_prun_roots +1 + IF(fill) THEN + Pruned_Roots(nb_prun_roots) = TMP + END IF + ENDIF + 201 CONTINUE + ENDDO + nb_prun_leaves = 0 + DO I = 1, nb_nodes_RHS + TMP = nodes_RHS(I) + ISTEP = STEP(TMP) + IF (Pruned_SONS(ISTEP).EQ.0) THEN + nb_prun_leaves = nb_prun_leaves +1 + IF(fill) THEN + Pruned_Leaves(nb_prun_leaves) = TMP + END IF + END IF + ENDDO + RETURN + END SUBROUTINE MUMPS_797 + SUBROUTINE MUMPS_803(MYID, N, KEEP28, KEEP201, + & KEEP8_31, + & STEP, Pruned_List, nb_prun_nodes, OOC_FCT_TYPE_LOC) + INTEGER, intent(in) :: KEEP28, KEEP201, OOC_FCT_TYPE_LOC, MYID, N + INTEGER(8), intent(in) :: KEEP8_31 + INTEGER, intent(in) :: nb_prun_nodes + INTEGER, intent(in) :: Pruned_List(nb_prun_nodes) + INTEGER, intent(in) :: STEP(N) + INTEGER I, ISTEP + INTEGER(8) :: Pruned_Size +#if defined(Mila_Print) + write(*,*) ' in Pruned List nodes:',nb_prun_nodes + write(*,*) Pruned_List(1:nb_prun_nodes) +#endif + IF (KEEP201 .GT. 0) THEN + Pruned_Size = 0_8 + DO I = 1, nb_prun_nodes + ISTEP = STEP(Pruned_List(I)) + Pruned_Size = Pruned_Size + SIZE_OF_BLOCK + & (ISTEP, OOC_FCT_TYPE_LOC) + ENDDO + PRUNED_SIZE_LOADED = PRUNED_SIZE_LOADED +Pruned_Size +#if defined(Mila_Print) + write(*,*) 'Pruned_Size Total_Size:', + & Pruned_Size, KEEP8_31 + write(*,*) MYID,'Gain (%) = ', dble(100) + & - (dble(Pruned_Size)*dble(100)) /dble(KEEP8_31) + IF (Pruned_Size .EQ. 0) THEN + WRITE(*,*) "NOT NORMAL BEHAVIOUR !!" + DO I = 1, nb_nodes_RHS + WRITE(*,*) "starting_node node_size", + & nodes_RHS(I), + & SIZE_OF_BLOCK(STEP(nodes_RHS(I)),OOC_FCT_TYPE_LOC) + ENDDO + ENDIF + write(*,*) '=============================' +#endif + ENDIF + RETURN + END SUBROUTINE MUMPS_803 + SUBROUTINE MUMPS_802 + & (MYID, N, KEEP28, KEEP201, KEEP8_31, + & STEP, Pruned_List, nb_prun_nodes, OOC_FCT_TYPE_LOC + & ) + IMPLICIT NONE + INTEGER, intent(in) :: KEEP28, KEEP201, OOC_FCT_TYPE_LOC, N + INTEGER(8), intent(in) :: KEEP8_31 + INTEGER, intent(in) :: nb_prun_nodes, MYID + INTEGER, intent(in) :: Pruned_List(nb_prun_nodes) + INTEGER, intent(in) :: STEP(N) + INCLUDE 'mpif.h' + INTEGER I, ISTEP + INTEGER(8) :: Pruned_Size + Pruned_Size = 0_8 + DO I = 1, nb_prun_nodes + ISTEP = STEP(Pruned_List(I)) + IF (KEEP201 .GT. 0) THEN + Pruned_Size = Pruned_Size + SIZE_OF_BLOCK + & (ISTEP, OOC_FCT_TYPE_LOC) + ENDIF + ENDDO + IF (KEEP201.GT.0) THEN +# if defined(Mila_Print) + write(*,*) MYID,'PR leaves NODES',nb_prun_leaves, + & Pruned_Leaves(1:nb_prun_leaves) + write(*,*) MYID,'PR NODES',Pos_List, + & Pruned_List(1:Pos_List) + write(*,*) 'PR root NODES', + & Pruned_Roots(nb_prun_roots) +# endif + IF (KEEP8_31 .NE. 0_8) THEN +# if defined(Mila_Print) + write(*,*) MYID,'PRUNED and TOTAL Size:', + & Pruned_Size, KEEP8_31 + write(*,*) MYID,'Gain (%) = ', dble(100) + & - ((dble(Pruned_Size)*dble(100))/dble(KEEP8_31)) + IF (MYID.EQ.0) + & write(*,*) '=============================' +# endif + PRUNED_SIZE_LOADED = PRUNED_SIZE_LOADED +Pruned_Size + ENDIF + ENDIF + RETURN + END SUBROUTINE MUMPS_802 + END MODULE MUMPS_SOL_ES + SUBROUTINE MUMPS_780 + & (PERM_STRAT, SYM_PERM, + & IRHS_PTR, NHRS, + & PERM_RHS, SIZEPERM, IERR + & ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: PERM_STRAT, NHRS, SIZEPERM + INTEGER, INTENT(IN) :: SYM_PERM(SIZEPERM) + INTEGER, INTENT(IN) :: IRHS_PTR(NHRS) + INTEGER, INTENT(OUT):: IERR + INTEGER, INTENT(OUT):: PERM_RHS(SIZEPERM) + DOUBLE PRECISION :: RAND_NUM + INTEGER I, J, STRAT + IERR = 0 + STRAT = PERM_STRAT + IF( (STRAT.NE.-3).AND. + & (STRAT.NE.-2).AND. + & (STRAT.NE.-1).AND. + & (STRAT.NE. 1).AND. + & (STRAT.NE. 2).AND. + & (STRAT.NE. 6) ) THEN + WRITE(*,*)"Warning: incorrect value for the RHS permutation; ", + & "defaulting to post-order" + STRAT = 1 + END IF + IF (STRAT .EQ. -3) THEN + WRITE(*,*) "Processing the RHS in random order" + PERM_RHS(1:SIZEPERM)=0 + DO I=1, SIZEPERM + CALL random_number(RAND_NUM) + RAND_NUM = RAND_NUM*dble(SIZEPERM) + J = ceiling(RAND_NUM) + DO WHILE (PERM_RHS(J).NE.0) + CALL random_number(RAND_NUM) + RAND_NUM = RAND_NUM*dble(SIZEPERM) + J = ceiling(RAND_NUM) + ENDDO + PERM_RHS(J)=I + ENDDO + ELSEIF (STRAT .EQ. -2) THEN + WRITE(*,*) "Processing the RHS in inverse order" + DO I=1, SIZEPERM + PERM_RHS(SIZEPERM -I +1) = I + ENDDO + ELSEIF (STRAT .EQ. -1) THEN + WRITE(*,*) "Processing the RHS in natural order" + DO I=1, SIZEPERM + PERM_RHS(I) = I + ENDDO + ELSEIF (STRAT .EQ. 1) THEN + WRITE(*,*) "Processing the RHS in post-order" + DO I=1, SIZEPERM + PERM_RHS(SYM_PERM(I)) = I + ENDDO + ELSEIF (STRAT .EQ. 2) THEN + WRITE(*,*) "Processing the RHS in pre-order" + DO I=1, SIZEPERM + PERM_RHS(SIZEPERM-SYM_PERM(I)+1) = I + ENDDO + ENDIF + END SUBROUTINE MUMPS_780 + SUBROUTINE MUMPS_772 + & (PERM_RHS, SIZEPERM, N, KEEP_28, + & PROCNODE, STEP_S, Nprocs, Step2node, + & IERR) + IMPLICIT NONE + INTEGER, INTENT(IN) :: SIZEPERM + INTEGER, intent(in) :: N, KEEP_28, Nprocs + INTEGER, intent(in) :: PROCNODE(KEEP_28), STEP_S(N) + INTEGER, intent(in) :: Step2node(KEEP_28) + INTEGER, INTENT(OUT):: IERR + INTEGER, INTENT(INOUT):: PERM_RHS(SIZEPERM) + INTEGER I, TMP_RHS, TMP2, proc_num + INTEGER , ALLOCATABLE :: TEMP_LOC_ARRAY(:) + INTEGER PTR(0:Nprocs-1) + INTEGER MUMPS_275, MUMPS_330 + EXTERNAL MUMPS_275, MUMPS_330 + IERR = 0 + ALLOCATE(TEMP_LOC_ARRAY(SIZEPERM), stat=IERR) + IF (IERR.GT.0) THEN + WRITE(6,*) " Not enough memory to allocate working ", + & " arrays in MUMPS_772 " + CALL MUMPS_ABORT() + ENDIF + proc_num = 0 + PTR(:) = 1 + DO I = 1, SIZEPERM + 555 CONTINUE + IF ( PTR(proc_num).LE.SIZEPERM ) THEN + TMP_RHS = PERM_RHS(PTR(proc_num)) + TMP2 = Step2node(abs (STEP_S(TMP_RHS) )) + IF (proc_num .EQ. MUMPS_275 + & (PROCNODE(STEP_S(TMP2)),Nprocs)) THEN + TEMP_LOC_ARRAY(I) = TMP_RHS + PTR(proc_num) = PTR(proc_num)+1 + IF ( (MUMPS_330(PROCNODE(STEP_S(TMP2)), + & Nprocs).EQ.1) + & ) THEN + proc_num = mod(proc_num+1,Nprocs) + proc_num = mod(proc_num+1,Nprocs) + ENDIF + ELSE + PTR(proc_num) = PTR(proc_num)+1 + GOTO 555 + ENDIF + ELSE + proc_num = mod(proc_num+1,Nprocs) + GOTO 555 + ENDIF + ENDDO + WRITE(*,*) "Used interleaving of the RHS" + DO I = 1, SIZEPERM + PERM_RHS(I) = TEMP_LOC_ARRAY(I) + ENDDO + IF (allocated(TEMP_LOC_ARRAY)) DEALLOCATE (TEMP_LOC_ARRAY) + RETURN + END SUBROUTINE MUMPS_772 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_static_mapping.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_static_mapping.F new file mode 100644 index 000000000..1410cf15e --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_static_mapping.F @@ -0,0 +1,4657 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE MUMPS_STATIC_MAPPING + IMPLICIT NONE + PRIVATE + PUBLIC :: MUMPS_369, MUMPS_393, + & MUMPS_427,MUMPS_494 + integer,pointer,dimension(:,:),SAVE::cv_cand + integer,pointer,dimension(:),SAVE::cv_par2_nodes + integer,SAVE::cv_slavef,cv_nb_niv2,cv_lp,cv_mp +#if defined(OLDSPLITTING) + DOUBLE PRECISION,SAVE::cv_stack_peak + integer,SAVE::cv_mem_strat +#endif + integer, parameter:: tsplit_beg=4 + integer, parameter:: tsplit_mid=5 + integer, parameter:: tsplit_last=6 + integer,parameter::cv_invalid=-9999 + DOUBLE PRECISION,parameter::cv_d_invalid=-9999.D0 + integer,parameter::cv_equilib_flops=1 + integer,parameter::cv_equilib_mem=2 + integer,parameter::cv_error_memalloc = -13 + integer,parameter::cv_error_memdeloc = -96 + integer,dimension(:),allocatable,save :: mem_distribtmp + integer, dimension(:),allocatable, save :: table_of_process + integer,dimension(:),allocatable,save :: mem_distribmpi + integer, save ::ke69,nb_arch_nodes + logical,dimension(:),allocatable,save :: allowed_nodes + integer,dimension(:),allocatable,save :: score + type nodelist + integer::nodenumber + type(nodelist),pointer::next + end type nodelist + type alloc_arraytype + integer, pointer, dimension(:)::t2_nodenumbers + integer, pointer, dimension(:,:)::t2_cand + DOUBLE PRECISION, pointer, dimension(:)::t2_candcostw(:), + & t2_candcostm(:) + integer:: nmb_t2s + end type alloc_arraytype + type splitting_data + integer:: new_ison,new_ifather,old_keep2 + DOUBLE PRECISION:: ncostw_oldinode,ncostm_oldinode, + & tcostw_oldinode,tcostm_oldinode + end type splitting_data + type procs4node_t + integer, dimension(:), pointer :: ind_proc + end type procs4node_t + DOUBLE PRECISION, pointer, dimension(:) :: + & cv_proc_workload, + & cv_proc_maxwork, + & cv_proc_memused, + & cv_proc_maxmem + type(splitting_data)::cv_last_splitting + integer::cv_n,cv_nsteps,cv_maxlayer, + & cv_nbsa,cv_maxnsteps,cv_maxdepth, + & cv_maxnodenmb,cv_total_amalg,cv_total_split, + & cv_bitsize_of_int,cv_size_ind_proc + & ,cv_mixed_strat_bound,cv_dist_L0_mixed_strat_bound + & ,cv_layerl0_end,cv_layerl0_start + integer :: layerL0_endforarrangeL0 + DOUBLE PRECISION :: mincostw + DOUBLE PRECISION:: cv_costw_upper,cv_costm_upper, + & cv_costw_layer0,cv_costm_layer0,cv_relax, + & cv_costw_total,cv_costm_total,cv_l0wthresh,cv_splitthresh + logical::cv_constr_work,cv_constr_mem + integer,pointer,dimension(:):: cv_nodetype,cv_nodelayer, + & cv_layerl0_array,cv_proc_sorted,cv_depth + integer,dimension(:),pointer:: + & cv_ne,cv_nfsiz,cv_frere,cv_fils,cv_keep,cv_info, + & cv_procnode,cv_ssarbr,cv_icntl + integer(8),dimension(:),pointer::cv_keep8 + type(alloc_arraytype),pointer,dimension(:)::cv_layer_p2node + DOUBLE PRECISION,dimension(:),pointer:: cv_ncostw, + & cv_tcostw,cv_ncostm,cv_tcostm,cv_layerworkload,cv_layermemused + & ,cv_layerl0_sorted_costw + type(procs4node_t),dimension(:),pointer :: cv_prop_map + contains + subroutine MUMPS_369(n,slavef,icntl,info, + & ne,nfsiz,frere,fils,keep,KEEP8, + & procnode,ssarbr,nbsa,peak,istat + & ) + implicit none + integer,intent(in)::n,slavef + integer, intent(inout),TARGET:: ne(n),nfsiz(n), + & procnode(n),ssarbr(n),frere(n),fils(n),keep(500), + & icntl(40),info(40) + INTEGER(8) KEEP8(150) + integer,intent(out)::nbsa,istat + integer ierr,nmb_thislayer,layernmb,mapalgo,allocok,i + integer,pointer,dimension(:)::thislayer + integer,parameter::memonly=1,floponly=2,hybrid=3 + DOUBLE PRECISION:: + & maxwork,minwork,maxmem,minmem,workbalance,membalance + DOUBLE PRECISION:: cost_root_node + DOUBLE PRECISION,dimension(:),allocatable:: work_per_proc + integer,dimension(:),allocatable::id_son + logical::cont + character (len=48):: err_rep,subname + DOUBLE PRECISION peak + istat=-1 + subname='DISTRIBUTE' + cv_lp=icntl(1) + cv_mp=icntl(3) + nullify(thislayer) + err_rep='INITPART1' + call MUMPS_478(n,slavef, + & frere,fils,nfsiz,ne,keep,KEEP8,icntl,info, + & procnode,ssarbr,peak,ierr + & ) + if (ierr.ne.0) goto 99999 + err_rep='PROCINIT' + call MUMPS_391(istat=ierr) + if (ierr.ne.0) goto 99999 + err_rep='CALCCOST' + call MUMPS_417(ierr) + if (ierr.ne.0) goto 99999 + err_rep='ROOTLIST' + call MUMPS_394(ierr) + if (ierr.ne.0) goto 99999 + err_rep='LAYERL0' + call MUMPS_381(ierr) + if (ierr.ne.0) goto 99999 + if (ierr.ne.0) goto 99999 + err_rep='INITPART2' + call MUMPS_479(ierr) + if (ierr.ne.0) goto 99999 + err_rep='WORKMEM_' + call MUMPS_408( + & cv_proc_workload,cv_proc_memused, + & maxwork,minwork,maxmem,minmem) + if(maxwork.gt.0.0D0) then + workbalance=minwork/maxwork + else + workbalance=0.0D0 + endif + if(maxmem.gt.0.0D0) then + membalance=minmem/maxmem + else + membalance=0.0D0 + endif + err_rep='mem_alloc' + allocate(thislayer(cv_maxnodenmb),STAT=allocok) + if (allocok.gt.0) then + cv_info(1) = cv_error_memalloc + cv_info(2) = 2*cv_maxnsteps+cv_maxnodenmb + if(cv_lp.gt.0) + & write(cv_lp,*)'memory allocation error in ',subname + ierr = cv_error_memalloc + goto 99999 + end if + cont=.TRUE. + layernmb=0 + mapalgo=floponly + err_rep='SELECT_TYPE3' + call MUMPS_396(ierr) + if (ierr.ne.0) goto 99999 + IF (cv_keep(38) .ne. 0 .and. cv_keep(60) .eq. 0 ) THEN + call MUMPS_511(cv_nfsiz(keep(38)), + & cv_nfsiz(keep(38)), cv_nfsiz(keep(38)), + & cv_keep(50), 3, cost_root_node) + cost_root_node = cost_root_node / dble(cv_slavef) + do i=1, cv_slavef + cv_proc_memused(i)=cv_proc_memused(i)+ + & dble(cv_nfsiz(keep(38)))*dble(cv_nfsiz(keep(38)))/ + & dble(cv_slavef) + cv_proc_workload(i)=cv_proc_workload(i)+dble(cost_root_node) + enddo + ENDIF + do while((cont).OR.(layernmb.le.cv_maxlayer)) + err_rep='FIND_THIS' + call MUMPS_376(layernmb,thislayer,nmb_thislayer, + & ierr) + if (ierr.ne.0) goto 99999 + err_rep='DO_SPLITTING' + if(cv_keep(82) .gt. 0) then + if(layernmb.gt.0) call MUMPS_527 + & (layernmb,thislayer,nmb_thislayer,ierr) + endif + if (ierr.ne.0) goto 99999 + err_rep='ASSIGN_TYPES' + call MUMPS_416(layernmb,thislayer,nmb_thislayer, + & ierr) + if (ierr.ne.0) goto 99999 + if(layernmb.gt.0) then + if ((cv_keep(24).eq.1).OR.(cv_keep(24).eq.2).OR. + & (cv_keep(24).eq.4).OR.(cv_keep(24).eq.6)) then + err_rep='COSTS_LAYER_T2' + call MUMPS_367(layernmb,nmb_thislayer,ierr) + elseif((cv_keep(24).eq.8).OR.(cv_keep(24).eq.10) + & .OR.(cv_keep(24).eq.12).OR.(cv_keep(24).eq.14) + & .OR.(cv_keep(24).eq.16).OR.(cv_keep(24).eq.18)) then + err_rep='COSTS_LAYER_T2PM' + call MUMPS_489(layernmb,nmb_thislayer,ierr) + else + err_rep='wrong strategy for COSTS_LAYER_T2' + ierr = -9999 + endif + if (ierr.ne.0) goto 99999 + err_rep='WORKMEM_' + call MUMPS_408( + & cv_proc_workload,cv_proc_memused, + & maxwork,minwork,maxmem,minmem) + if(maxwork.gt.0.0D0) then + workbalance=minwork/maxwork + else + workbalance=0.0D0 + endif + if(maxmem.gt.0.0D0) then + membalance=minmem/maxmem + else + membalance=0.0D0 + endif + if(mapalgo.eq.memonly) then + err_rep='MAP_LAYER' + call MUMPS_387(layernmb,thislayer, + & nmb_thislayer,cv_equilib_mem,ierr) + if (ierr.ne.0) goto 99999 + elseif(mapalgo.eq.floponly) then + err_rep='MAP_LAYER' + call MUMPS_387(layernmb,thislayer, + & nmb_thislayer,cv_equilib_flops,ierr) + if (ierr.ne.0) goto 99999 + elseif(mapalgo.eq.hybrid) then + if (workbalance <= membalance) then + err_rep='MAP_LAYER' + call MUMPS_387(layernmb,thislayer, + & nmb_thislayer,cv_equilib_flops,ierr) + if (ierr.ne.0) goto 99999 + else + err_rep='MAP_LAYER' + call MUMPS_387(layernmb,thislayer, + & nmb_thislayer,cv_equilib_mem,ierr) + if (ierr.ne.0) goto 99999 + endif + else + if(cv_lp.gt.0) + & write(cv_lp,*)'Unknown mapalgo in ',subname + return + endif + endif + layernmb=layernmb+1 + err_rep='HIGHER_LAYER' + call MUMPS_377(layernmb,thislayer, + & nmb_thislayer,cont,ierr) + if (ierr.ne.0) goto 99999 + end do + IF ( (cv_keep(79).EQ.0).OR.(cv_keep(79).EQ.3).OR. + & (cv_keep(79).EQ.5).OR.(cv_keep(79).EQ.7) + & ) THEN + if(cv_slavef.gt.4) then + err_rep='POSTPROCESS' + call MUMPS_431() + endif + ENDIF + err_rep='SETUP_CAND' + call MUMPS_397(ierr) + if (ierr.ne.0) goto 99999 + err_rep='ENCODE_PROC' + call MUMPS_371(ierr) + if (ierr.ne.0) goto 99999 + err_rep='STORE_GLOB' + call MUMPS_402(ne,nfsiz,frere,fils,keep,KEEP8, + & info,procnode,ssarbr,nbsa) + err_rep='mem_dealloc' + deallocate(thislayer,STAT=ierr) + if (ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Memory deallocation error in ',subname + ierr = cv_error_memdeloc + goto 99999 + endif + err_rep='TERMGLOB' + call MUMPS_403(ierr) + if (ierr.ne.0) goto 99999 + istat=0 + return +99999 continue + if(cv_lp.gt.0) then + write(cv_lp,*)'Error in ',subname,', layernmb=',layernmb + write(cv_lp,*)'procedure reporting the error: ',err_rep + endif + if(ierr.eq.cv_error_memalloc) then + info(1) = cv_info(1) + info(2) = cv_info(2) + endif + istat=ierr + return + CONTAINS + subroutine MUMPS_413( + & map_strat,workload,memused,accepted, + & istat) + implicit none + integer,intent(in)::map_strat + DOUBLE PRECISION,dimension(:),intent(in)::workload, memused + logical,intent(out)::accepted + integer,intent(out)::istat + DOUBLE PRECISION maxi,mini,mean,stddev + integer i,nmb + intrinsic maxval,minval,count,sum + character (len=48):: subname + logical alternative_criterion + DOUBLE PRECISION:: + & MINFLOPS , MINMEM, + & CL_RATE, DV_RATE + istat=-1 + if ( cv_keep(72) .EQ. 1) then + MINFLOPS = 2.0D0 + MINMEM=50.0D0 + CL_RATE =0.8D0 + DV_RATE=0.2D0 + else + MINFLOPS = 5.0D7 + MINMEM=5.0D6 + CL_RATE =0.8D0 + DV_RATE=0.2D0 + endif + subname='ACCEPT_L0' + accepted=.FALSE. + alternative_criterion=.FALSE. + if(map_strat.eq.cv_equilib_flops) then + maxi=maxval(workload) + mini=minval(workload) + if (maxi.lt.MINFLOPS) then + accepted=.TRUE. + elseif(maxi.le.(dble(cv_keep(102))/dble(100))*mini)then + accepted=.TRUE. + endif + if ((.NOT.accepted).AND.(alternative_criterion)) then + mean=sum(workload)/max(dble(cv_slavef),dble(1)) + stddev=dble(0) + do i=1,cv_slavef + stddev=stddev+ + & (abs(workload(i)-mean)*abs(workload(i)-mean)) + enddo + stddev=sqrt(stddev/max(dble(cv_slavef),dble(1))) + nmb=count(mask=abs(workload-mean)=1) + write(*,*) 'k =',kk + write(*,*) 'master_mem =',mem_master, + & 'memory peak =',cv_stack_peak, + & 'max mem authorized', + & (dble(cv_mem_strat)/dble(100))*cv_stack_peak +# endif + if(mem_master.le. + & (dble(cv_mem_strat)/dble(100))*cv_stack_peak) then + k2 = kk + exit + endif +#endif + enddo + k2 = max(k2, 1) + k2 = min (k2, npiv) + if(present(istat)) istat=0 + return + end subroutine MUMPS_526 + subroutine MUMPS_529(inode,nfront,npiv,k, + & ison,ifather,istat) + implicit none + integer, intent(in)::nfront,npiv + integer, intent(in):: k + integer inode + integer,intent(out)::ison,ifather + integer, intent(out)::istat + integer i,lev,in,in_son,in_father,in_grandpa, + & npiv_son,nfrontk,npivk,d1,f1,e1,dk,fk,next_father + DOUBLE PRECISION:: ncostm,ncostw,ncostm_ison,ncostw_ison, + & ncostm_ifather,ncostw_ifather + character (len=48):: subname + istat=-1 + subname='SPLITNODE_INKPART' + ison=-1 + ifather=-1 + ncostw=cv_ncostw(inode) + ncostm=cv_ncostm(inode) + nfrontk = nfront + npivk = npiv + npiv_son = npiv/k + cv_keep(2)=max(cv_keep(2),nfront-npiv_son) + d1 = inode + f1 = d1 + e1 = cv_frere(d1) + do i=1,npiv_son-1 + f1 = cv_fils(f1) + enddo + ison = d1 + in_son = f1 + next_father = cv_fils(in_son) + call MUMPS_418(npiv_son,nfrontk, + & ncostw_ison,ncostm_ison) + cv_ncostw(ison)=ncostw_ison + cv_ncostm(ison)=ncostm_ison + if(associated(cv_tcostw)) cv_tcostw(ison) = cv_tcostw(inode) + & -ncostw +cv_ncostw(ison) + if(associated(cv_tcostm)) cv_tcostm(ison) = cv_tcostm(inode) + & -ncostm +cv_ncostm(ison) + do lev = 1,k-1 + ifather = next_father + in_father = ifather + if(lev .eq. k-1) then + do while (cv_fils(in_father).gt.0) + in_father=cv_fils(in_father) + end do + else + do i=1,npiv_son-1 + in_father=cv_fils(in_father) + enddo + endif + cv_frere(ison)=-ifather + next_father = cv_fils(in_father) + cv_fils(in_father)=-ison + cv_nfsiz(ison)=nfrontk + cv_nfsiz(ifather)=nfrontk-npiv_son + cv_ne(ifather)=1 + cv_keep(61)=cv_keep(61)+1 + call MUMPS_418(npiv_son,nfrontk-npiv_son, + & ncostw_ifather,ncostm_ifather) + cv_ncostw(ifather)=ncostw_ifather + cv_ncostm(ifather)=ncostm_ifather + if(associated(cv_tcostw)) + & cv_tcostw(ifather) = cv_tcostw(ison)+cv_ncostw(ifather) + if(associated(cv_tcostm)) + & cv_tcostm(ifather) = cv_tcostm(ison)+cv_ncostm(ifather) + cv_total_split=cv_total_split+1 + if(lev .gt. 1) then + call MUMPS_437(inode,ison,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'PROPMAP4SPLIT error in ',subname + istat = ierr + return + endif + endif + IF (cv_keep(79).EQ.0) THEN + if( MUMPS_359(nfrontk-npiv_son,npiv_son) ) then + cv_nodetype(ifather) = 2 + else + cv_nodetype(ifather) = 1 + endif + ELSE + if (lev.EQ.1) then + cv_nodetype(ison) = tsplit_beg + cv_nodetype(ifather) = tsplit_mid + else + cv_nodetype(ifather) = tsplit_mid + endif + ENDIF + nfrontk = nfrontk-npiv_son + npivk = npivk - npiv_son + ison = ifather + in_son = in_father + enddo + dk = ifather + fk = in_father + IF (keep(79).EQ.0) THEN + if( MUMPS_359(nfrontk,npivk) ) then + cv_nodetype(dk) = 2 + else + cv_nodetype(dk) = 1 + endif + ELSE + if (k.gt.1) then + cv_nodetype(ifather) = tsplit_last + endif + ENDIF +# if (check_mumps_static_mapping >= 3) + write(6,*) ' Last (close to root) node in chain :', ifather +#endif + call MUMPS_418(npivk,nfrontk, + & ncostw_ifather,ncostm_ifather) + cv_ncostw(dk)=ncostw_ifather + cv_ncostm(dk)=ncostm_ifather + if(associated(cv_tcostw)) + & cv_tcostw(dk) = cv_tcostw(ison)+cv_ncostw(dk) + if(associated(cv_tcostm)) + & cv_tcostm(dk) = cv_tcostm(ison)+cv_ncostm(dk) + cv_fils(f1) = next_father + cv_frere(dk) = e1 + in = e1 + do while (in.gt.0) + in=cv_frere(in) + end do + in = -in + do while(cv_fils(in).gt.0) + in=cv_fils(in) + end do + in_grandpa = in + if(cv_fils(in_grandpa).eq.-d1) then + cv_fils(in_grandpa)=-dk + else + in=-cv_fils(in_grandpa) + do while(cv_frere(in) .ne. d1) + in=cv_frere(in) + end do + cv_frere(in) = dk + end if + ison = dk + do lev=1,k + do while (cv_fils(ison).gt.0) + ison=cv_fils(ison) + end do + ison = -cv_fils(ison) + enddo + call MUMPS_437(inode,dk,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'PROPMAP4SPLIT error in ',subname + istat = ierr + return + endif + cv_nsteps = cv_nsteps + k-1 + cv_ncostw(inode) = ncostw + cv_ncostm(inode) = ncostm + istat = 0 + return + end subroutine MUMPS_529 + function MUMPS_811 (inode) + implicit none + integer, intent(in) :: inode + logical :: MUMPS_811 + if ( + & (cv_nodetype(inode).EQ.2).OR. + & (cv_nodetype(inode).EQ.tsplit_beg).OR. + & (cv_nodetype(inode).EQ.tsplit_mid).OR. + & (cv_nodetype(inode).EQ.tsplit_last) + & ) then + MUMPS_811 = .TRUE. + else + MUMPS_811 = .FALSE. + endif + return + end function MUMPS_811 + subroutine MUMPS_371(istat) + implicit none + integer, intent(out)::istat + integer i,in,inode + character (len=48):: subname + istat=-1 + subname='ENCODE_PROCNODE' + do i=1,cv_nbsa + inode=cv_ssarbr(i) + cv_nodetype(inode)=0 + in=cv_fils(inode) + do while (in>0) + in=cv_fils(in) + end do + in=-in + do while(in.gt.0) + call MUMPS_406(in) + in=cv_frere(in) + enddo + enddo + do i=1,cv_n + if (cv_frere(i).lt.cv_n+1) then + if(cv_nodetype(i).eq.cv_invalid) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + return + endif + if (i.eq.cv_keep(38)) then + cv_nodetype(i)=3 + endif + cv_procnode(i)=(cv_nodetype(i)-1)*cv_slavef+cv_procnode(i) + in=cv_fils(i) + do while (in>0) + cv_procnode(in)=cv_procnode(i) + in=cv_fils(in) + end do + end if + end do + istat = 0 + return + end subroutine MUMPS_371 + subroutine MUMPS_372(ifather,istat) + implicit none + integer,intent(in)::ifather + integer,intent(out)::istat + integer in,son,oldl0end + logical father_has_sons + character (len=48):: subname + istat=-1 + subname='FATHSON_REPLACE' + father_has_sons=.TRUE. + in=ifather + do while (in.gt.0) + in=cv_fils(in) + end do + if(in.eq.0) then + cv_nodelayer(ifather)=1 + father_has_sons=.FALSE. + end if + if(cv_layerl0_end-cv_layerl0_start.gt.0) then + cv_layerl0_start= cv_layerl0_start+1 + elseif(father_has_sons) then + cv_layerl0_start= cv_layerl0_start+1 + else + istat=1 + cv_nodelayer(ifather)=0 + return + endif + cv_nbsa=cv_nbsa-1 + oldl0end = cv_layerl0_end + if (father_has_sons) then + son=-in + son=-in + 10 continue + cv_layerl0_end=cv_layerl0_end+1 + if (cv_tcostw(son).GT.mincostw) + & layerL0_endforarrangeL0 = layerL0_endforarrangeL0+1 + cv_layerl0_array(cv_layerl0_end)=son + cv_layerl0_sorted_costw(cv_layerl0_end)=cv_tcostw(son) + cv_nbsa=cv_nbsa+1 + if((cv_frere(son).gt.0).and.(cv_frere(son).lt.cv_n+1)) then + son=cv_frere(son) + goto 10 + end if + endif + cv_costw_layer0=cv_costw_layer0 - cv_ncostw(ifather) + cv_costm_layer0=cv_costm_layer0 - cv_ncostm(ifather) + cv_costw_upper=cv_costw_upper + cv_ncostw(ifather) + cv_costm_upper=cv_costm_upper + cv_ncostm(ifather) + if(cv_layerl0_end.gt.oldl0end) then + call MUMPS_459(cv_layerl0_end-oldl0end, + & cv_layerl0_array(oldl0end+1:cv_layerl0_end), + & cv_layerl0_sorted_costw(oldl0end+1:cv_layerl0_end)) + call MUMPS_516( + & cv_layerl0_start,oldl0end,oldl0end-cv_layerl0_start+1, + & oldl0end+1,cv_layerl0_end,cv_layerl0_end-oldl0end, + & cv_layerl0_array(1:cv_layerl0_end), + & cv_layerl0_sorted_costw(1:cv_layerl0_end)) + endif + istat=0 + return + end subroutine MUMPS_372 + subroutine MUMPS_374(inode,map_strat,work,mem, + & workload,memused,proc,istat,respect_prop) +cDEC$ NOOPTIMIZE + implicit none + integer, intent(in)::inode,map_strat + DOUBLE PRECISION,intent(in)::work,mem + DOUBLE PRECISION,dimension(:),intent(inout)::workload, memused + integer,intent(out):: proc,istat + logical,intent(in),OPTIONAL::respect_prop + integer i + logical respect_proportional + intrinsic huge + DOUBLE PRECISION dummy + character (len=48):: subname + istat=-1 + respect_proportional=.FALSE. + if(present(respect_prop)) respect_proportional=respect_prop + subname='FIND_BEST_PROC' + proc=-1 + if((map_strat.ne.cv_equilib_flops).and. + & (map_strat.ne.cv_equilib_mem)) return + dummy=huge(dummy) + do i=cv_slavef,1,-1 + if ( + & ((.NOT.respect_proportional) + & .OR. + & (MUMPS_481(inode,i).AND.respect_proportional)) + & .AND. + & (((workload(i).lt.dummy).AND. + & (map_strat.eq.cv_equilib_flops)) + & .OR. + & ((memused(i).lt.dummy).AND. + & (map_strat.eq.cv_equilib_mem))))then + if((.not.cv_constr_work).or. + & (workload(i)+work.lt.cv_proc_maxwork(i))) then + if((.not.cv_constr_mem).or. + & (memused(i)+mem.lt.cv_proc_maxmem(i))) then + proc=i + if(map_strat.eq.cv_equilib_flops) then + dummy=workload(i) + elseif(map_strat.eq.cv_equilib_mem) then + dummy=memused(i) + endif + end if + end if + end if + end do + if (proc.ne.-1) then + workload(proc)=workload(proc)+work + memused(proc)=memused(proc)+mem + istat=0 + end if + return + end subroutine MUMPS_374 + subroutine MUMPS_376(nmb, + & thislayer,nmb_thislayer,istat) + implicit none + integer, intent(in)::nmb + integer,intent(out) :: thislayer(:) + integer,intent(out) :: nmb_thislayer,istat + integer i + character (len=48):: subname + istat=-1 + subname='FIND_THISLAYER' + thislayer=0 + nmb_thislayer=0 + if((nmb.lt.0).or.(nmb.gt.cv_maxlayer)) return + do i=1,cv_n + if(cv_nodelayer(i).eq.nmb) then + nmb_thislayer=nmb_thislayer+1 + if(nmb_thislayer.gt.cv_maxnodenmb) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Problem with nmb_thislayer in ',subname + return + endif + thislayer(nmb_thislayer)=i + end if + end do + istat=0 + return + end subroutine MUMPS_376 + subroutine MUMPS_377(startlayer,thislayer, + & nmb_thislayer,cont,istat) + implicit none + integer,intent(in)::startlayer,nmb_thislayer + integer,intent(in)::thislayer(:) + logical,intent(inout)::cont + integer,intent(out)::istat + integer :: visited + integer il,i,current,in,ifather + logical father_valid,upper_layer_exists + character (len=48):: subname + istat=-1 + subname='HIGHER_LAYER' + if(.NOT.cont) return + if(startlayer.lt.1) return + current=startlayer-1 + visited = -current-1 + upper_layer_exists=.FALSE. + if (current.eq.0) then + do i=1,cv_n + if (cv_nodelayer(i).ne.current) then + if(cv_nodelayer(i).eq.1) then + upper_layer_exists=.TRUE. + exit + endif + endif + enddo + endif + do il=1,nmb_thislayer + i = thislayer(il) + in=i + if (cv_nodetype(in).eq.tsplit_beg) then + do while (cv_frere(in).lt.0) + ifather = -cv_frere(in) + if (cv_nodetype(ifather).eq.tsplit_mid) then + in = ifather + cv_nodelayer (in) = -visited-1 + cycle + else if (cv_nodetype(ifather).eq.tsplit_last) then + in = ifather + cv_nodelayer (in) = current + exit + else + write(6,*) ' Internal error 1 in MUMPS_HIGER_LAYER' + call MUMPS_ABORT() + endif + end do + endif + enddo + do il=1,nmb_thislayer + i = thislayer(il) + if (cv_nodelayer(i).lt.current) cycle + in=i + if (cv_nodetype(in).eq.tsplit_beg) then + cv_nodelayer (in) = visited + do while (cv_frere(in).lt.0) + ifather = -cv_frere(in) + if (cv_nodetype(ifather).eq.tsplit_mid) then + in = ifather + cv_nodelayer (in) = -visited-1 + cycle + else if (cv_nodetype(ifather).eq.tsplit_last) then + in = ifather + exit + else + write(6,*) ' Internal error 1 in MUMPS_HIGER_LAYER' + call MUMPS_ABORT() + endif + end do + endif + if(cv_frere(in).eq.0) cycle + cv_nodelayer (in) = visited + father_valid=.TRUE. + do while(cv_frere(in).gt.0) + if (cv_nodelayer(cv_frere(in)).gt.current) then + father_valid=.FALSE. + in = cv_frere(in) + cycle + endif + if (cv_nodelayer(cv_frere(in)).eq.visited) exit + in=cv_frere(in) + if (cv_nodelayer(in).eq.current) then + cv_nodelayer(in) = visited + endif + end do + if (.not.father_valid .or. cv_frere(in).gt.0) then + cycle + endif + ifather=-cv_frere(in) + if(cv_nodelayer(ifather).eq.current+1) then + cycle + endif + in=ifather + do while (cv_fils(in).gt.0) + in=cv_fils(in) + end do + in=-cv_fils(in) + if(cv_nodelayer(in).gt.current) then + father_valid=.FALSE. + else + father_valid=.TRUE. + do while(cv_frere(in).gt.0) + in=cv_frere(in) + if(cv_nodelayer(in).gt.current) then + father_valid=.FALSE. + exit + endif + if(cv_nodelayer(in).eq.visited) then + exit + endif + end do + endif + if(father_valid) then + cv_nodelayer(ifather)=current+1 + upper_layer_exists=.TRUE. + end if + end do + if (upper_layer_exists) then + current=current+1 + cv_maxlayer=current + cont=.TRUE. + else + cv_maxlayer=current + cont=.FALSE. + endif + do il=1,nmb_thislayer + i = thislayer(il) + if (cv_nodelayer(i).eq.visited) cv_nodelayer(i) = -visited-1 + enddo + istat=0 + return + end subroutine MUMPS_377 + subroutine MUMPS_478(n,slavef, + & frere,fils,nfsiz,ne,keep,KEEP8,icntl,info, + & procnode,ssarbr,peak,istat + & ) + implicit none + integer, intent(in)::n,slavef + integer, intent(in), TARGET:: frere(n),fils(n),nfsiz(n),ne(n), + & keep(500),icntl(40),info(40), + & procnode(n),ssarbr(n) + INTEGER(8), intent(in), TARGET:: KEEP8(150) + integer,intent(out)::istat + integer i,allocok,rest + DOUBLE PRECISION peak + character (len=48):: subname + intrinsic bit_size,min,max + istat=-1 + nullify(cv_frere,cv_fils,cv_nfsiz,cv_ne,cv_keep,cv_keep8, + & cv_icntl,cv_info,cv_procnode,cv_ssarbr) + nullify(cv_ncostw,cv_tcostw,cv_ncostm,cv_tcostm, + & cv_nodelayer,cv_nodetype,cv_depth, + & cv_layerworkload,cv_layermemused,cv_prop_map) + subname='INITPART1' + cv_n=n + cv_slavef=slavef +#if defined(OLDSPLITTING) + cv_stack_peak = peak + cv_mem_strat = max((300 / cv_slavef),1) +#endif + cv_keep=>keep + cv_keep8=>KEEP8 + if(cv_keep(82) .lt. 0) then + write(cv_lp,*) + & 'Warning in mumps_static_mapping : splitting is set off' + cv_keep(82) = 0 + endif + if(cv_keep(83) .lt. 0) then + write(cv_lp,*) + & 'warning in mumps_static_mapping : keep(83) reset to 0' + cv_keep(83) = 0 + endif + if(slavef.gt.1) then + cv_mixed_strat_bound = max(cv_keep(78),1) + cv_maxdepth = slavef + else + cv_maxdepth = 0 + cv_mixed_strat_bound=0 + endif + cv_bitsize_of_int = bit_size(n) + if(cv_bitsize_of_int.le.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Problem with bit size in ',subname + return + endif + rest = mod(cv_slavef,cv_bitsize_of_int) + if (rest.eq.0) then + cv_size_ind_proc = cv_slavef / cv_bitsize_of_int + else + cv_size_ind_proc = cv_slavef / cv_bitsize_of_int + 1 + endif + allocate(cv_ncostw(n),cv_tcostw(n),cv_ncostm(n),cv_tcostm(n), + & cv_nodelayer(n),cv_nodetype(n),cv_depth(n), + & cv_layerworkload(slavef),cv_layermemused(slavef), + & cv_prop_map(n),STAT=allocok) + if (allocok.gt.0) then + cv_info(1) = cv_error_memalloc + cv_info(2) = 8*n+2*cv_slavef + istat = cv_error_memalloc + if(cv_lp.gt.0) + & write(cv_lp,*)'memory allocation error in ',subname + return + end if + if(cv_keep(82) .eq. 0) then + if(cv_lp.gt.0) + & write(cv_lp,*)' No splitting during static mapping ' + endif + cv_frere=>frere + cv_fils=>fils + cv_nfsiz=>nfsiz + cv_ne=>ne + cv_icntl=>icntl + cv_info=>info + cv_procnode=>procnode + cv_ssarbr=>ssarbr + cv_ssarbr=0 + cv_nodetype=cv_invalid + cv_nsteps=keep(28) + if((keep(28).gt.n).OR.(keep(28).lt.0)) then + if(cv_lp.gt.0) + & write(cv_lp,*)'problem with nsteps in ',subname + return + end if + cv_costw_upper=0.0D0 + cv_costm_upper=0.0D0 + cv_costw_layer0=0.0D0 + cv_costm_layer0=0.0D0 + cv_costw_total=0.0D0 + cv_costm_total=0.0D0 + cv_nodelayer=n+2 + cv_depth=cv_invalid + cv_l0wthresh=0.0D0 + cv_splitthresh=0.45D0 + cv_relax=dble(1) + dble(max(0,keep(68)))/dble(100) + cv_maxlayer=0 + cv_maxnsteps= cv_nsteps+1 + cv_layerworkload=dble(0) + cv_layermemused=dble(0) + cv_total_amalg=0 + cv_total_split=0 + cv_last_splitting%new_ison=cv_invalid + cv_last_splitting%new_ifather=cv_invalid + cv_last_splitting%old_keep2=cv_invalid + cv_last_splitting%ncostw_oldinode=cv_d_invalid + cv_last_splitting%ncostm_oldinode=cv_d_invalid + cv_last_splitting%tcostw_oldinode=cv_d_invalid + cv_last_splitting%tcostm_oldinode=cv_d_invalid + do i=1,cv_n + nullify(cv_prop_map(i)%ind_proc) + end do + istat=0 + return + end subroutine MUMPS_478 + subroutine MUMPS_479(istat) + implicit none + integer,intent(out)::istat + integer i,allocok,inode,in,inoderoot,ierr,maxcut + character (len=48):: subname + istat=-1 + subname='INITPART2' + if(associated(cv_layerl0_array))deallocate(cv_layerl0_array) + if(associated(cv_layerl0_sorted_costw)) + & deallocate(cv_layerl0_sorted_costw) +#if !defined(treeload)&&!defined(treestat) + deallocate(cv_depth,cv_tcostw,cv_tcostm,STAT=ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Memory deallocation error in ',subname + istat = cv_error_memdeloc + return + end if +#endif + if(cv_maxnsteps.lt.1) then + if(cv_lp.gt.0) + & write(cv_lp,*)'problem with maxnsteps in ',subname + return + end if + cv_maxnodenmb=cv_maxnsteps + do i=1,cv_nbsa + inode=cv_ssarbr(i) + inoderoot=inode + 300 continue + in = inode + do while (in.ne.0) + inode = in + do while (in.gt.0) + in = cv_fils(in) + end do + if (in.lt.0) in=-in + end do + 100 continue + if (inode.ne.inoderoot) then + cv_maxnodenmb=cv_maxnodenmb-1 + in = cv_frere(inode) + inode = abs(in) + if (in.lt.0) then + go to 100 + else + go to 300 + end if + end if + end do + if(cv_keep(82) .gt. 0) then + maxcut = min((cv_keep(82)-1)*cv_maxnodenmb,cv_n) + cv_maxnsteps = min(cv_maxnsteps+maxcut,cv_n) + cv_maxnodenmb = cv_maxnsteps + endif + nullify(cv_layer_p2node) + if(cv_maxnodenmb.lt.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'problem with maxnodenmb in ',subname + return + elseif(cv_maxnodenmb.lt.1) then + cv_maxnodenmb = 1 + end if + allocate(cv_layer_p2node(cv_maxnodenmb),STAT=allocok) + if (allocok.gt.0) then + cv_info(1) = cv_error_memalloc + cv_info(2) = cv_maxnodenmb + istat = cv_error_memalloc + if(cv_lp.gt.0) + & write(cv_lp,*)'memory allocation error in ',subname + return + end if + do i=1,cv_maxnodenmb + nullify(cv_layer_p2node(i)%t2_nodenumbers, + & cv_layer_p2node(i)%t2_cand, + & cv_layer_p2node(i)%t2_candcostw, + & cv_layer_p2node(i)%t2_candcostm) + cv_layer_p2node(i)%nmb_t2s=0 + enddo + istat = 0 + end subroutine MUMPS_479 + function MUMPS_359(nfront,npiv) + implicit none + logical::MUMPS_359 + integer,intent(in)::nfront,npiv + MUMPS_359=.FALSE. + if( (nfront - npiv > cv_keep(9)) + & .and. ((npiv > cv_keep(4)).or.(.TRUE.)) + & .and. (cv_icntl(40).eq.0) ) MUMPS_359=.TRUE. + return + end function MUMPS_359 + subroutine MUMPS_381(istat) + implicit none + integer,intent(out)::istat + integer i,ierr,inode + logical accepted,splitting_allowed + integer,parameter::map_strat=cv_equilib_flops + character (len=48):: err_rep,subname + logical use_geist_ng_replace, skiparrangeL0 + INTEGER MINSIZE_L0 + istat=-1 + subname='LAYERL0' + accepted=.FALSE. + splitting_allowed=.TRUE. + splitting_allowed=.FALSE. + IF (cv_keep(72).EQ.2) THEN + MINSIZE_L0 = 6*cv_slavef + ELSE + MINSIZE_L0 = 3*cv_slavef + ENDIF + 55 continue + skiparrangeL0 = .false. + do while(.not.accepted) + IF ( ( (layerL0_endforarrangeL0.LT.MINSIZE_L0) + & .OR. skiparrangeL0 + & ) + & .AND. + & (cv_layerl0_end.LT.cv_maxnsteps/2) ) THEN + accepted = .false. + ELSE + err_rep='ARRANGEL0' + call MUMPS_415(map_strat, layerL0_endforarrangeL0, + & cv_layerworkload,cv_layermemused, + & cv_procnode,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error reported by ',err_rep,' in ',subname + istat = ierr + return + end if + err_rep='ACCEPT_L0' + call MUMPS_413(map_strat, + & cv_layerworkload,cv_layermemused, + & accepted,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error reported by ',err_rep,' in ',subname + istat = ierr + return + end if + ENDIF + IF (cv_slavef.GT.16) + & skiparrangeL0 = .NOT.skiparrangeL0 + if (accepted.OR.(cv_costw_total.le.0.0D0)) then + exit + elseif(((cv_costw_layer0/cv_costw_total).gt.cv_l0wthresh) .AND. + & (.TRUE.))then + err_rep='MAX_TCOST_L0' + inode = cv_layerl0_array(cv_layerl0_start) + use_geist_ng_replace = .TRUE. + if(use_geist_ng_replace) then + err_rep='FATHSON_REPLACE' + call MUMPS_372(inode,ierr) + if(ierr.eq.1) then + accepted=.TRUE. + elseif(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*) + & 'Error rep. by ',err_rep,' in ',subname + istat = ierr + return + endif + endif + else + accepted=.TRUE. + end if + end do + accepted=.TRUE. + if (accepted) then + else + goto 55 + endif + err_rep='LIST2LAYER' + call MUMPS_382(ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error reported by ',err_rep,' in ',subname + istat = ierr + return + end if + err_rep='MAKE_PROPMAP' + call MUMPS_477(ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error reported by ',err_rep,' in ',subname + istat = ierr + return + end if + if ( cv_keep(75).EQ.1 ) then + call MUMPS_415(map_strat, cv_layerl0_end, + & cv_layerworkload,cv_layermemused, + & cv_procnode,ierr, respect_prop=.TRUE.) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error reported by ',err_rep,' in ',subname + istat = ierr + return + end if + else if (layerL0_endforarrangeL0.LT.cv_layerl0_end) THEN + call MUMPS_415(map_strat, cv_layerl0_end, + & cv_layerworkload,cv_layermemused, + & cv_procnode,ierr) + endif + call MUMPS_386(cv_procnode) + do i=1,cv_slavef + cv_proc_workload(i)=cv_layerworkload(i) + cv_proc_memused(i)=cv_layermemused(i) + end do + istat=0 + return + end subroutine MUMPS_381 + subroutine MUMPS_382(istat) + implicit none + integer, intent(out)::istat + character (len=48):: subname + integer i,inode + istat=-1 + subname='LIST2LAYER' + cv_dist_L0_mixed_strat_bound=0 + cv_nbsa=0 + do i=cv_layerl0_start,cv_layerl0_end + inode=cv_layerl0_array(i) + if(inode.gt.0) then + cv_dist_L0_mixed_strat_bound=max(cv_dist_L0_mixed_strat_bound + & ,max(cv_depth(inode)-cv_mixed_strat_bound,0)) + cv_nodelayer(inode)=0 + cv_nbsa=cv_nbsa+1 + cv_ssarbr(cv_nbsa)=inode + endif + enddo + istat=0 + return + end subroutine MUMPS_382 + subroutine MUMPS_477(istat) + implicit none + integer,intent(out)::istat + integer i,pctr,pctr2,ierr,procindex(cv_size_ind_proc) + istat = -1 + pctr=cv_n + pctr2=cv_mixed_strat_bound + do i=1,cv_slavef + call MUMPS_482(procindex,i,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0)write(cv_lp,*) + & 'BIT_SET signalled error to',subname + istat = ierr + return + end if + end do + do i=1,cv_n + if(cv_frere(i).eq.0) then + if(.NOT.associated(cv_prop_map(i)%ind_proc)) then + call MUMPS_434(i,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'PROPMAP_INIT signalled error to' + & ,subname + istat = ierr + return + end if + endif + cv_prop_map(i)%ind_proc = procindex + call MUMPS_433(i,pctr,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0)write(cv_lp,*) + & 'PROPMAP signalled error to',subname + istat = ierr + return + endif + if((cv_keep(24).eq.16).OR.(cv_keep(24).eq.18)) then + call MUMPS_517(i,pctr2,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0)write(cv_lp,*) + & 'MOD_PROPMAP signalled error to',subname + istat = ierr + return + endif + endif + endif + end do + istat = 0 + return + end subroutine MUMPS_477 + subroutine MUMPS_387(layernmb,thislayer, + & nmb_thislayer,map_strat,istat) + implicit none + integer, intent(in)::layernmb,thislayer(:), + & nmb_thislayer,map_strat + integer,intent(out)::istat + integer i,inode,j,k,ierr,nmb,aux_int,nmb_cand_needed + DOUBLE PRECISION aux_flop,aux_mem + INTEGER candid(cv_slavef) + integer sorted_nmb(2*nmb_thislayer) + DOUBLE PRECISION sorted_costw(2*nmb_thislayer), + & sorted_costm(2*nmb_thislayer), + & old_workload(cv_slavef),old_memused(cv_slavef) + character (len=48):: err_rep,subname + logical use_propmap + istat=-1 + subname='MAP_LAYER' + if((cv_keep(24).eq.8).OR.(cv_keep(24).eq.10) + & .OR.(cv_keep(24).eq.12).OR.(cv_keep(24).eq.14) + & .OR.(cv_keep(24).eq.16).OR.(cv_keep(24).eq.18)) then + use_propmap=.TRUE. + else + use_propmap=.FALSE. + endif + if((layernmb.lt.0).or.(layernmb.gt.cv_maxlayer)) return + if((map_strat.ne.cv_equilib_flops).and. + & (map_strat.ne.cv_equilib_mem)) return + do i=1,nmb_thislayer + inode=thislayer(i) + if (cv_nodetype(inode).eq.3) then + cv_procnode(inode)=1 + exit + end if + end do + do i=1,cv_slavef + old_workload(i)=cv_layerworkload(i) + old_memused(i)=cv_layermemused(i) + enddo + nmb=0 + do i=1,nmb_thislayer + inode=thislayer(i) + if(cv_nodetype(inode).eq.1) then + nmb=nmb+1 + sorted_nmb(nmb)=inode + sorted_costw(nmb)=cv_ncostw(inode) + sorted_costm(nmb)=cv_ncostm(inode) + else if(MUMPS_811(inode)) then + nmb=nmb+1 + do j=1,cv_layer_p2node(layernmb)%nmb_t2s + if(cv_layer_p2node(layernmb)%t2_nodenumbers(j).ne.inode) + & then + cycle + else + sorted_costw(nmb)= + & cv_layer_p2node(layernmb)%t2_candcostw(j) + sorted_costm(nmb)= + & cv_layer_p2node(layernmb)%t2_candcostm(j) + endif + enddo + if((sorted_costw(nmb).eq.cv_d_invalid).OR. + & (sorted_costm(nmb).eq.cv_d_invalid)) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + return + end if + if(sorted_costw(nmb).lt.cv_ncostw(inode))then + sorted_costw(nmb)=cv_ncostw(inode) + sorted_costm(nmb)=cv_ncostm(inode) + sorted_nmb(nmb)=inode + else + sorted_nmb(nmb)=-inode + endif + else if(cv_nodetype(inode).eq.3) then + cycle + else + if(cv_lp.gt.0) + & write(cv_lp,*)'Unknown node type. Error in ',subname + return + end if + end do + if (map_strat.eq.cv_equilib_flops) then + call MUMPS_459(nmb,sorted_nmb(1:nmb), + & sorted_costw(1:nmb),sorted_costm(1:nmb)) + elseif(map_strat.eq.cv_equilib_mem) then + call MUMPS_459(nmb,sorted_nmb(1:nmb), + & sorted_costm(1:nmb),sorted_costw(1:nmb)) + endif + do i=1,nmb + aux_int=sorted_nmb(i) + aux_flop=sorted_costw(i) + aux_mem=sorted_costm(i) + k=1 + if (aux_int.lt.0) then + inode=-aux_int + err_rep='SORTPROCS' + if(use_propmap) then + call MUMPS_398(map_strat, + & cv_proc_workload,cv_proc_memused, + & inode=inode,istat=ierr) + else + call MUMPS_398(map_strat, + & cv_proc_workload,cv_proc_memused, + & istat=ierr) + end if + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*) + & 'Error reported by ',err_rep,' in ',subname + istat = ierr + return + endif + nmb_cand_needed=cv_invalid + do j=1,cv_layer_p2node(layernmb)%nmb_t2s + if(cv_layer_p2node(layernmb)%t2_nodenumbers(j).ne.inode) + & then + cycle + else + nmb_cand_needed= + & cv_layer_p2node(layernmb)%t2_cand(j,cv_slavef+1) + exit + endif + enddo + if(nmb_cand_needed.eq.cv_invalid) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + return + endif + do while((k.le.cv_slavef).and.(nmb_cand_needed.gt.0)) + if(((.not.cv_constr_work).or. + & (cv_proc_workload(cv_proc_sorted(k))+aux_flop.lt. + & cv_proc_maxwork(cv_proc_sorted(k)))) + & .AND.((.not.cv_constr_mem).or. + & (cv_proc_memused(cv_proc_sorted(k))+aux_mem.lt. + & cv_proc_maxmem(cv_proc_sorted(k)))) + & .AND. + & (cv_layer_p2node(layernmb)%t2_cand(j,cv_proc_sorted(k)).eq.0)) + & then + cv_proc_workload(cv_proc_sorted(k))= + & cv_proc_workload(cv_proc_sorted(k))+aux_flop + cv_proc_memused(cv_proc_sorted(k))= + & cv_proc_memused(cv_proc_sorted(k))+aux_mem + cv_layer_p2node(layernmb)%t2_cand(j,cv_proc_sorted(k)) + & =inode + cv_layerworkload(cv_proc_sorted(k))= + & cv_layerworkload(cv_proc_sorted(k))+aux_flop + cv_layermemused(cv_proc_sorted(k))= + & cv_layermemused(cv_proc_sorted(k))+aux_mem + nmb_cand_needed=nmb_cand_needed-1 + k=k+1 + else + k=k+1 + if(k.gt.cv_slavef) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + return + endif + end if + end do + if(nmb_cand_needed.gt.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + return + endif + aux_flop=cv_ncostw(inode) + aux_mem=cv_ncostm(inode) + do while(k.le.cv_slavef) + if(((.not.cv_constr_work).or. + & (cv_proc_workload(cv_proc_sorted(k))+aux_flop.lt. + & cv_proc_maxwork(cv_proc_sorted(k)))) + & .AND.((.not.cv_constr_mem).or. + & (cv_proc_memused(cv_proc_sorted(k))+aux_mem.lt. + & cv_proc_maxmem(cv_proc_sorted(k)))) + & .AND. + & (cv_layer_p2node(layernmb)%t2_cand(j,cv_proc_sorted(k)).eq.0)) + & then + cv_procnode(inode)=cv_proc_sorted(k) + cv_proc_workload(cv_proc_sorted(k))= + & cv_proc_workload(cv_proc_sorted(k))+aux_flop + cv_proc_memused(cv_proc_sorted(k))= + & cv_proc_memused(cv_proc_sorted(k))+aux_mem + cv_layer_p2node(layernmb)%t2_cand(j,cv_proc_sorted(k)) + & =-inode + cv_layerworkload(cv_proc_sorted(k))= + & cv_layerworkload(cv_proc_sorted(k))+aux_flop + cv_layermemused(cv_proc_sorted(k))= + & cv_layermemused(cv_proc_sorted(k))+aux_mem + exit + else + k=k+1 + if(k.gt.cv_slavef) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + return + endif + end if + end do + else + inode=aux_int + err_rep='SORTPROCS' + if(use_propmap) then + call MUMPS_398(map_strat, + & cv_proc_workload,cv_proc_memused, + & inode=inode,istat=ierr) + else + call MUMPS_398(map_strat, + & cv_proc_workload,cv_proc_memused, + & inode,istat=ierr) + endif + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*) + & 'Error reported by ',err_rep,' in ',subname + istat = ierr + return + endif + if (cv_nodetype(inode).eq.1) then + do while(k.le.cv_slavef) + if((.not.cv_constr_work).or. + & (cv_proc_workload(cv_proc_sorted(k))+aux_flop.lt. + & cv_proc_maxwork(cv_proc_sorted(k))) + & .AND.((.not.cv_constr_mem).or. + & (cv_proc_memused(cv_proc_sorted(k))+aux_mem.lt. + & cv_proc_maxmem(cv_proc_sorted(k))))) then + cv_procnode(inode)=cv_proc_sorted(k) + cv_proc_workload(cv_proc_sorted(k))= + & cv_proc_workload(cv_proc_sorted(k))+aux_flop + cv_proc_memused(cv_proc_sorted(k))= + & cv_proc_memused(cv_proc_sorted(k))+aux_mem + cv_layerworkload(cv_proc_sorted(k))= + & cv_layerworkload(cv_proc_sorted(k))+aux_flop + cv_layermemused(cv_proc_sorted(k))= + & cv_layermemused(cv_proc_sorted(k))+aux_mem + exit + else + k=k+1 + if(k.gt.cv_slavef) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Inconsist data in ',subname + return + endif + end if + end do + elseif (MUMPS_811(inode)) then + do j=1,cv_layer_p2node(layernmb)%nmb_t2s + if(cv_layer_p2node(layernmb)%t2_nodenumbers(j).ne. + & inode) then + cycle + else + exit + endif + enddo + do while(k.le.cv_slavef) + if(((.not.cv_constr_work).or. + & (cv_proc_workload(cv_proc_sorted(k))+aux_flop.lt. + & cv_proc_maxwork(cv_proc_sorted(k)))) + & .AND.((.not.cv_constr_mem).or. + & (cv_proc_memused(cv_proc_sorted(k))+aux_mem.lt. + & cv_proc_maxmem(cv_proc_sorted(k)))) + & .AND. + & (cv_layer_p2node(layernmb)%t2_cand(j,cv_proc_sorted(k)).eq.0)) + & then + cv_procnode(inode)=cv_proc_sorted(k) + cv_proc_workload(cv_proc_sorted(k))= + & cv_proc_workload(cv_proc_sorted(k))+aux_flop + cv_proc_memused(cv_proc_sorted(k))= + & cv_proc_memused(cv_proc_sorted(k))+aux_mem + cv_layer_p2node(layernmb)%t2_cand(j,cv_proc_sorted(k)) + & =-inode + cv_layerworkload(cv_proc_sorted(k))= + & cv_layerworkload(cv_proc_sorted(k))+aux_flop + cv_layermemused(cv_proc_sorted(k))= + & cv_layermemused(cv_proc_sorted(k))+aux_mem + exit + else + k=k+1 + if(k.gt.cv_slavef) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + return + endif + end if + end do + nmb_cand_needed=cv_invalid + do j=1,cv_layer_p2node(layernmb)%nmb_t2s + if(cv_layer_p2node(layernmb)%t2_nodenumbers(j) + & .ne.inode) + & then + cycle + else + nmb_cand_needed= + & cv_layer_p2node(layernmb)% + & t2_cand(j,cv_slavef+1) + exit + endif + enddo + if(nmb_cand_needed.eq.cv_invalid) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + return + endif + aux_flop= + & cv_layer_p2node(layernmb)%t2_candcostw(j) + aux_mem= + & cv_layer_p2node(layernmb)%t2_candcostm(j) + do while((k.le.cv_slavef).and.(nmb_cand_needed.gt.0)) + if(((.not.cv_constr_work).or. + & (cv_proc_workload(cv_proc_sorted(k))+aux_flop.lt. + & cv_proc_maxwork(cv_proc_sorted(k)))) + & .AND.((.not.cv_constr_mem).or. + & (cv_proc_memused(cv_proc_sorted(k))+aux_mem.lt. + & cv_proc_maxmem(cv_proc_sorted(k)))) + & .AND. + & (cv_layer_p2node(layernmb)% + & t2_cand(j,cv_proc_sorted(k)).eq.0)) + & then + cv_proc_workload(cv_proc_sorted(k))= + & cv_proc_workload(cv_proc_sorted(k))+aux_flop + cv_proc_memused(cv_proc_sorted(k))= + & cv_proc_memused(cv_proc_sorted(k))+aux_mem + cv_layer_p2node(layernmb)% + & t2_cand(j,cv_proc_sorted(k)) + & =inode + cv_layerworkload(cv_proc_sorted(k))= + & cv_layerworkload(cv_proc_sorted(k))+aux_flop + cv_layermemused(cv_proc_sorted(k))= + & cv_layermemused(cv_proc_sorted(k))+aux_mem + nmb_cand_needed=nmb_cand_needed-1 + k=k+1 + else + k=k+1 + if(k.gt.cv_slavef) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + return + endif + end if + end do + if(nmb_cand_needed.gt.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + return + endif + end if + end if + end do + do i=1,cv_layer_p2node(layernmb)%nmb_t2s + nmb_cand_needed= + & cv_layer_p2node(layernmb)%t2_cand(i,cv_slavef+1) + candid= cv_layer_p2node(layernmb)%t2_cand(i,1:cv_slavef) + cv_layer_p2node(layernmb)%t2_cand(i,1:cv_slavef)=-1 + k=0 + do j=1,cv_slavef + if(candid(j).gt.0) then + k=k+1 + cv_layer_p2node(layernmb)%t2_cand(i,k)=j-1 + end if + end do + if (k.ne.nmb_cand_needed) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + return + endif + enddo + do i=1,cv_slavef + cv_layerworkload(i)=cv_layerworkload(i)-old_workload(i) + cv_layermemused(i)=cv_layermemused(i)-old_memused(i) + enddo + istat=0 + return + end subroutine MUMPS_387 + recursive subroutine MUMPS_385(inode,procnmb, + & procnode) + integer,intent(in)::inode,procnmb + integer,intent(inout)::procnode(:) + integer in + procnode(inode)=procnmb + if (cv_fils(inode).eq.0) return + in=cv_fils(inode) + do while(in>0) + procnode(in)=procnmb + in=cv_fils(in) + end do + in=-in + do while(in>0) + call MUMPS_385(in,procnmb,procnode) + in=cv_frere(in) + end do + return + end subroutine MUMPS_385 + subroutine MUMPS_386(procnode) + implicit none + integer,intent(inout)::procnode(:) + integer i,inode,procnmb + do i=cv_layerl0_start,cv_layerl0_end + inode=cv_layerl0_array(i) + if(inode.gt.0) then + procnmb=procnode(inode) + call MUMPS_385(inode,procnmb,procnode) + endif + enddo + return + end subroutine MUMPS_386 + subroutine MUMPS_389(map_strat,inode,istat) + implicit none + integer, intent(in)::map_strat + integer,intent(out)::inode,istat + character (len=48):: subname + subname='MAX_TCOST_L0' + inode=-1 + istat=-1 + if ((.NOT.associated(cv_tcostw)).OR.(.NOT.associated(cv_tcostm))) + & then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error:tcost must be allocated in ',subname + return + end if + if((map_strat.ne.cv_equilib_flops).and. + & (map_strat.ne.cv_equilib_mem)) return + inode=cv_layerl0_array(cv_layerl0_start) + istat=0 + return + end subroutine MUMPS_389 + subroutine MUMPS_431() + implicit none + integer candid,inode,index,i,j,layernmb,master,nmbcand,swapper, + & totalnmb,node_of_master,node_of_candid,node_of_swapper + DOUBLE PRECISION::mastermem,slavemem,maxmem + logical swapthem,cand_better_master_arch,cand_better_swapper_arch + intrinsic maxval,minval + maxmem=maxval(cv_proc_memused(:)) + totalnmb=0 + do layernmb=cv_maxlayer,1,-1 + do i=1,cv_layer_p2node(layernmb)%nmb_t2s + inode=cv_layer_p2node(layernmb)%t2_nodenumbers(i) + master=cv_procnode(inode) + if(ke69 .gt. 1) then + allowed_nodes = .FALSE. + call MUMPS_476(layernmb,i) + node_of_master = mem_distribmpi(master-1) + if (node_of_master .lt. 0 ) then + if(cv_mp.gt.0) write(cv_mp,*)'node_of_master_not found' + endif + node_of_swapper = node_of_master + endif + mastermem=cv_proc_memused(master) + nmbcand=cv_layer_p2node(layernmb)%t2_cand(i,cv_slavef+1) + swapper=master + index=0 + do j=1,nmbcand + candid=cv_layer_p2node(layernmb)%t2_cand(i,j)+1 + slavemem=cv_proc_memused(candid) + if(ke69 .gt. 1) then + node_of_candid = mem_distribmpi(candid-1) + if (node_of_candid .lt. 0 ) then + if(cv_mp.gt.0) write(cv_mp,*) + & 'node_of_candid_not found' + endif + endif + if(ke69 .le. 1) then + if((slavemem.lt.mastermem) .and. + & (slavemem.lt.cv_proc_memused(swapper))) then + swapper=candid + index=j + endif + else + cand_better_master_arch = ( + & ( + & (slavemem.lt.mastermem) .or. + & (.not. allowed_nodes(node_of_master)) + & ) + & .and. allowed_nodes(node_of_candid) + & ) + cand_better_swapper_arch = ( + & ( + & (slavemem.lt.cv_proc_memused(swapper)) .or. + & (.not. allowed_nodes(node_of_swapper)) + & ) + & .and. allowed_nodes(node_of_candid) + & ) + if(cand_better_master_arch .and. + & cand_better_swapper_arch ) then + swapper=candid + node_of_swapper = node_of_candid + index=j + endif + endif + enddo + if(swapper.ne.master) then + swapthem = .FALSE. + if(0.75D0*mastermem.ge.cv_proc_memused(swapper)) + & swapthem=.TRUE. + if(mastermem.le.mastermem-cv_ncostm(inode) + & +cv_layer_p2node(layernmb)%t2_candcostm(i)) + & swapthem=.FALSE. + if(mastermem.le.cv_proc_memused(swapper) + & +cv_ncostm(inode) + & -cv_layer_p2node(layernmb)%t2_candcostm(i)) + & swapthem=.FALSE. + if(maxmem.le.mastermem-cv_ncostm(inode) + & +cv_layer_p2node(layernmb)%t2_candcostm(i)) + & swapthem=.FALSE. + if(maxmem.le.cv_proc_memused(swapper)+cv_ncostm(inode) + & -cv_layer_p2node(layernmb)%t2_candcostm(i)) + & swapthem=.FALSE. + if(ke69 .gt. 1) then + if (.not. allowed_nodes(node_of_master)) then + swapthem=.TRUE. + endif + endif + if(.NOT.swapthem) cycle + cv_proc_workload(master)=cv_proc_workload(master) + & -cv_ncostw(inode) + & +cv_layer_p2node(layernmb)%t2_candcostw(i) + cv_proc_memused(master)=cv_proc_memused(master) + & -cv_ncostm(inode) + & +cv_layer_p2node(layernmb)%t2_candcostm(i) + cv_proc_workload(swapper)=cv_proc_workload(swapper) + & +cv_ncostw(inode) + & -cv_layer_p2node(layernmb)%t2_candcostw(i) + cv_proc_memused(swapper)=cv_proc_memused(swapper) + & +cv_ncostm(inode) + & -cv_layer_p2node(layernmb)%t2_candcostm(i) + cv_layer_p2node(layernmb)%t2_cand(i,index)=master-1 + cv_procnode(inode)=swapper + maxmem=maxval(cv_proc_memused(:)) + totalnmb = totalnmb+1 + endif + enddo + enddo + end subroutine MUMPS_431 + subroutine MUMPS_391(maxwork,maxmem,istat) + implicit none + DOUBLE PRECISION,intent(in),OPTIONAL::maxwork(cv_slavef), + & maxmem(cv_slavef) + integer,intent(out)::istat + integer i,allocok + intrinsic huge + DOUBLE PRECISION dummy + character (len=48):: subname + istat=-1 + subname='PROCINIT' + if(present(maxwork)) then + cv_constr_work=.TRUE. + else + cv_constr_work=.FALSE. + end if + if(present(maxmem)) then + cv_constr_mem=.TRUE. + else + cv_constr_mem=.FALSE. + end if + allocate(cv_proc_workload(cv_slavef), + & cv_proc_maxwork(cv_slavef), + & cv_proc_memused(cv_slavef), + & cv_proc_maxmem(cv_slavef), + & cv_proc_sorted(cv_slavef), + & STAT=allocok) + if (allocok.gt.0) then + cv_info(1) = cv_error_memalloc + cv_info(2) = 2*cv_slavef + istat = cv_error_memalloc + if(cv_lp.gt.0) + & write(cv_lp,*)'memory allocation error in ',subname + return + end if + allocate(work_per_proc(cv_slavef),id_son(cv_slavef),STAT=allocok) + if (allocok.gt.0) then + cv_info(1) = cv_error_memalloc + cv_info(2) = 2*cv_slavef + istat = cv_error_memalloc + if(cv_lp.gt.0) + & write(cv_lp,*)'memory allocation error in ',subname + return + end if + do i=1,cv_slavef + cv_proc_workload(i)=dble(0) + if(cv_constr_work) then + cv_proc_maxwork(i)=maxwork(i) + else + cv_proc_maxwork(i)=(huge(dummy)) + endif + cv_proc_memused(i)=dble(0) + if(cv_constr_mem) then + cv_proc_maxmem(i)=maxmem(i) + else + cv_proc_maxmem(i)=(huge(dummy)) + endif + end do + do i=1, cv_slavef + cv_proc_sorted(i)=i + enddo + istat=0 + return + end subroutine MUMPS_391 + recursive subroutine MUMPS_517 + & (inode,ctr,istat) + implicit none + integer, intent(in)::inode,ctr + integer, intent(inout)::istat + integer::j,k,in,in1,ierr,son,nmb_procs_inode,nmb_sons_inode, + & procs4son(cv_size_ind_proc),current,i + character (len=48):: subname + DOUBLE PRECISION :: relative_weight,costs_sons + DOUBLE PRECISION :: loc_relax + INTEGER :: depth + logical force_cand + DOUBLE PRECISION Y + intrinsic random_number + integer nmb_propmap_strict,share2,procsrest,current2 + integer k69onid + integer procs_inode(slavef) + if (ctr.le.0) then + istat = 0 + return + endif + procs_inode=-1 + istat= -1 + if(cv_frere(inode).eq.cv_n+1) return + subname='MOD_PROPMAP' + if(.NOT.associated(cv_prop_map(inode)%ind_proc)) return + nmb_procs_inode = 0 + do j=1,cv_slavef + if( MUMPS_481(inode,j))then + nmb_procs_inode = nmb_procs_inode + 1 + endif + end do + i=0 + do j=1,cv_slavef + if(ke69 .gt.1) then + call MUMPS_493(j-1, + & k69onid,ierr) + else + k69onid = j + endif + if(MUMPS_481(inode,k69onid))then + i = i + 1 + procs_inode(i)=k69onid + endif + end do + if(i.ne.nmb_procs_inode)then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + & ,subname + return + endif + if(nmb_procs_inode.eq.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + & ,subname + return + end if + if ((cv_nodelayer(inode).eq.0).AND. + & (cv_frere(inode).ne.cv_n+1)) then + istat = 0 + return + endif + nmb_sons_inode = 0 + costs_sons = dble(0) + force_cand=(mod(cv_keep(24),2).eq.0) + in = inode + do while (cv_fils(in).gt.0) + in=cv_fils(in) + end do + if (cv_fils(in).eq.0) then + istat = 0 + return + endif + in = -cv_fils(in) + son=in + do while(in.gt.0) + nmb_sons_inode = nmb_sons_inode + 1 + if(cv_tcostw(in).le.0.0D0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Subtree costs for ',in, + & ' should be positive in ',subname + return + endif + costs_sons = costs_sons + cv_tcostw(in) + in=cv_frere(in) + enddo + if(costs_sons.le.0D0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + & ,subname + return + endif + depth= max(cv_mixed_strat_bound - ctr,0) + if ((cv_keep(24).eq.16).OR.(cv_keep(24).eq.18)) then + if(depth.ge.cv_mixed_strat_bound) then + loc_relax = dble(1) + else + loc_relax = dble(1) + + & max(dble(cv_keep(77))/dble(100), dble(0)) + endif + else + loc_relax = dble(1) + endif + in=son + current = 1 + do while(in.gt.0) + if( (nmb_sons_inode.ge.nmb_procs_inode).AND. + & (nmb_procs_inode.LT.4) ) then + procs4son = cv_prop_map(inode)%ind_proc + else + do k=1,cv_size_ind_proc + do j=0,cv_bitsize_of_int-1 + procs4son(k)=ibclr(procs4son(k),j) + end do + end do + nmb_propmap_strict=0 + do k=1,cv_slavef + if( MUMPS_481(in,k)) then + nmb_propmap_strict=nmb_propmap_strict+1 + call MUMPS_482(procs4son,k,ierr) + end if + end do + if(costs_sons.gt.0.0D0) then + relative_weight=cv_tcostw(in)/costs_sons + else + relative_weight=0.0D0 + endif + current = nmb_propmap_strict + share2= + & max(0,nint(relative_weight*(loc_relax-dble(1))* + & dble(nmb_procs_inode))) + procsrest=nmb_procs_inode - nmb_propmap_strict + share2=min(share2,procsrest) + CALL random_number(Y) + current2=int(dble(Y)*dble(procsrest)) + k=1 + i=1 + do while((share2.gt.0).and.(i.le.2)) + do j=1,nmb_procs_inode + if(share2.le.0) exit + k69onid = procs_inode(j) + if(( MUMPS_481(inode,k69onid)).AND. + & (.NOT.MUMPS_480(procs4son,k69onid))) then + if(k.ge.current2)then + call MUMPS_482(procs4son,k69onid,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0)write(cv_lp,*) + & 'BIT_SET signalled error to',subname + istat = ierr + return + end if + share2 = share2 - 1 + endif + k=k+1 + end if + enddo + i=i+1 + enddo + if(share2.ne.0) then + if(cv_lp.gt.0) write(cv_lp,*) + & 'Error reported in ',subname + return + end if + end if + ierr=0 + in1=in + cv_prop_map(in1)%ind_proc=procs4son + call MUMPS_517(in1,ctr-1,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) write(cv_lp,*) + & 'Error reported in ',subname + istat=ierr + return + endif + in=cv_frere(in) + end do + istat = 0 + return + end subroutine MUMPS_517 + recursive subroutine MUMPS_433(inode,ctr,istat) + implicit none + integer, intent(in)::inode,ctr + integer, intent(inout)::istat + integer::j,k,in,in1,ierr,son,nmb_procs_inode,nmb_sons_inode, + & share,procs4son(cv_size_ind_proc),current,offset, + & in_tmp,nfront,npiv,ncb, + & keep48_loc,min_cand_needed + character (len=48):: subname + DOUBLE PRECISION :: relative_weight,costs_sons, shtemp + DOUBLE PRECISION :: costs_sons_real + DOUBLE PRECISION :: PartofaProc + LOGICAL :: SkipSmallNodes + PARAMETER (PartofaProc=0.01D0) + DOUBLE PRECISION :: loc_relax + INTEGER :: depth + logical force_cand + integer MUMPS_497, MUMPS_50 + external MUMPS_497, MUMPS_50 + DOUBLE PRECISION Y + intrinsic random_number + integer nmb_propmap_strict,share2,procsrest,current2 + integer k69onid,nb_free_procs,local_son_indice,nb_procs_for_sons, + & ptr_upper_ro_procs + logical upper_round_off,are_sons_treated + DOUBLE PRECISION tmp_cost + if (ctr.le.0) then + istat = 0 + return + endif + istat= -1 + if(cv_frere(inode).eq.cv_n+1) return + subname='PROPMAP' + nmb_procs_inode = 0 + do j=1,cv_slavef + if( MUMPS_481(inode,j)) + & nmb_procs_inode = nmb_procs_inode + 1 + end do + if(nmb_procs_inode.eq.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + & ,subname + return + end if + if ((cv_nodelayer(inode).eq.0).AND. + & (cv_frere(inode).ne.cv_n+1)) then + istat = 0 + return + endif + ptr_upper_ro_procs=1 + work_per_proc(1:cv_slavef)=0.0D0 + id_son(1:cv_slavef)=0 + nmb_sons_inode = 0 + costs_sons = dble(0) + force_cand=(mod(cv_keep(24),2).eq.0) + min_cand_needed=0 + in = inode + do while (cv_fils(in).gt.0) + in=cv_fils(in) + end do + if (cv_fils(in).eq.0) then + istat = 0 + return + endif + in = -cv_fils(in) + son=in + do while(in.gt.0) + nmb_sons_inode = nmb_sons_inode + 1 + if(cv_tcostw(in).le.0.0D0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Subtree costs for ',in, + & ' should be positive in ',subname + return + endif + costs_sons = costs_sons + cv_tcostw(in) + in=cv_frere(in) + enddo + costs_sons_real = costs_sons + SkipSmallNodes = .true. + IF (costs_sons_real.gt.0.0D0) then + in = son + do while (in.gt.0) + relative_weight=cv_tcostw(in)/costs_sons_real + shtemp = relative_weight*dble(nmb_procs_inode) + IF (shtemp.lt.PartofaProc) THEN + costs_sons = costs_sons - cv_tcostw(in) + ENDIF + in=cv_frere(in) + enddo + IF (costs_sons.LT. PartofaProc*costs_sons_real) THEN + costs_sons = costs_sons_real + SkipSmallNodes = .false. + ENDIF + ENDIF + if(costs_sons.le.0.0D0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname + & ,subname + return + endif + if(cv_relax.le.0.0D0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname,'. Wrong cv_relax' + return + endif + depth= max(cv_n - ctr,0) + if(cv_keep(24).eq.8) then + loc_relax = cv_relax + elseif ((cv_keep(24).eq.16).OR.(cv_keep(24).eq.18)) then + loc_relax = cv_relax + elseif (cv_keep(24).eq.10) then + loc_relax = cv_relax + elseif ((cv_keep(24).eq.12).OR.(cv_keep(24).eq.14)) then + if(depth.ge.cv_mixed_strat_bound) then + loc_relax = cv_relax + else + loc_relax = cv_relax + + & max(dble(cv_keep(77))/dble(100), dble(0)) + endif + endif + in=son + current = 1 + local_son_indice=1 + nb_procs_for_sons=0 + upper_round_off=.FALSE. + are_sons_treated=.TRUE. + do while(in.gt.0) + if( (nmb_sons_inode.ge.nmb_procs_inode).AND. + & (nmb_procs_inode.LT.4) ) then + procs4son = cv_prop_map(inode)%ind_proc + are_sons_treated=.FALSE. + nb_procs_for_sons=nmb_procs_inode + nmb_propmap_strict=nmb_procs_inode + elseif(nmb_procs_inode .LE. cv_keep(83)) then + procs4son = cv_prop_map(inode)%ind_proc + are_sons_treated=.FALSE. + nb_procs_for_sons=nmb_procs_inode + nmb_propmap_strict=nmb_procs_inode + else + do k=1,cv_size_ind_proc + do j=0,cv_bitsize_of_int-1 + procs4son(k)=ibclr(procs4son(k),j) + end do + end do + if(costs_sons.gt.0.0D0) then + relative_weight=cv_tcostw(in)/costs_sons + else + relative_weight=dble(0) + endif + shtemp = relative_weight*dble(nmb_procs_inode) + IF ( (shtemp.LT.PartofaProc) + & .AND. ( SkipSmallNodes ) ) THEN + share = 1 + do j=current,cv_slavef + if(ke69 .gt.1) then + call MUMPS_493(j-1,k69onid,ierr) + else + k69onid = j + endif + if( MUMPS_481(inode,k69onid)) then + call MUMPS_482(procs4son,k69onid,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0)write(cv_lp,*) + & 'BIT_SET signalled error to',subname + istat = ierr + return + end if + share = share -1 + exit + endif + enddo + if (share.gt.0) then + do j=1,current-1 + if(ke69 .gt.1) then + call MUMPS_493(j-1,k69onid,ierr) + else + k69onid = j + endif + if( MUMPS_481(inode,k69onid)) then + call MUMPS_482(procs4son,k69onid,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0)write(cv_lp,*) + & 'BIT_SET signalled error to',subname + istat = ierr + return + end if + share = share -1 + exit + endif + enddo + endif + if(share.ne.0) then + if(cv_lp.gt.0) write(cv_lp,*) + & 'Error reported in ',subname + return + end if + if(.NOT.associated(cv_prop_map(in)%ind_proc)) then + call MUMPS_434(in,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'PROPMAP_INIT signalled error to' + & ,subname + istat = ierr + return + end if + endif + current = j + cv_prop_map(in)%ind_proc = procs4son + in = cv_frere(in) + cycle + ENDIF + share = max(1,nint(shtemp)) + if (dble(share).ge.shtemp) then + upper_round_off=.TRUE. + else + upper_round_off = .FALSE. + endif + share=min(share,nmb_procs_inode) + nmb_propmap_strict=share + nb_procs_for_sons=nb_procs_for_sons+nmb_propmap_strict + offset=1 + do j=current,cv_slavef + if(ke69 .gt.1) then + call MUMPS_493(j-1,k69onid,ierr) + else + k69onid = j + endif + if( MUMPS_481(inode,k69onid)) then + call MUMPS_482(procs4son,k69onid,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0)write(cv_lp,*) + & 'BIT_SET signalled error to',subname + istat = ierr + return + end if + share = share-1 + if(share.le.0) then + current = j + offset + if(current.gt.cv_slavef) current = 1 + exit + end if + end if + end do + if(share.gt.0) then + do j=1,current-1 + if(ke69 .gt.1) then + call MUMPS_493(j-1,k69onid,ierr) + else + k69onid = j + endif + if( MUMPS_481(inode,k69onid)) then + call MUMPS_482(procs4son,k69onid,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0)write(cv_lp,*) + & 'BIT_SET signalled error to',subname + istat = ierr + return + end if + share = share-1 + if(share.le.0) then + current = j + offset + if(current.gt.cv_slavef) current = 1 + exit + end if + end if + end do + endif + if(share.ne.0) then + if(cv_lp.gt.0) write(cv_lp,*) + & 'Error reported in ',subname + return + end if + if(.not.upper_round_off)then + if(local_son_indice.lt.cv_slavef)then + id_son(local_son_indice)=in + work_per_proc(local_son_indice)=cv_tcostw(in)/ + & dble(nmb_propmap_strict) + local_son_indice=local_son_indice+1 + if(local_son_indice.eq.cv_slavef)then + CALL MUMPS_459(cv_slavef,id_son, + & work_per_proc) + endif + else + current2=cv_slavef + tmp_cost=cv_tcostw(in)/dble(nmb_propmap_strict) + do while(current2.ge.1) + if(tmp_cost.lt.work_per_proc(current2))exit + current2=current2-1 + enddo + if(current2.ne.cv_slavef)then + if(current2.eq.0)then + current2=1 + endif + do j=cv_slavef-1,current2,-1 + id_son(j+1)=id_son(j) + work_per_proc(j+1)=work_per_proc(j) + enddo + id_son(current2)=in + work_per_proc(current2)=tmp_cost + endif + endif + endif + upper_round_off=.FALSE. + endif + if(.NOT.associated(cv_prop_map(in)%ind_proc)) then + call MUMPS_434(in,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'PROPMAP_INIT signalled error to' + & ,subname + istat = ierr + return + end if + endif + cv_prop_map(in)%ind_proc = procs4son + in=cv_frere(in) + end do + if(are_sons_treated)then + if(nb_procs_for_sons.ne.nmb_procs_inode)then + do j=1,nmb_procs_inode-nb_procs_for_sons + procs4son=cv_prop_map(id_son(j))%ind_proc + do while(current.le.cv_slavef) + if(ke69 .gt.1) then + call MUMPS_493(current-1,k69onid,ierr) + else + k69onid = current + endif + if(.NOT.MUMPS_481(inode,k69onid)) then + current=current+1 + else + exit + endif + enddo + call MUMPS_482(procs4son,k69onid,ierr) + cv_prop_map(id_son(j))%ind_proc=procs4son + enddo + ptr_upper_ro_procs=min(j,nmb_procs_inode-nb_procs_for_sons) + endif + endif + in=son + current = 1 + do while(in.gt.0) + if( (nmb_sons_inode.ge.nmb_procs_inode).AND. + & (nmb_procs_inode.LT.4) ) then + procs4son = cv_prop_map(inode)%ind_proc + elseif(nmb_procs_inode .LE. cv_keep(83)) then + procs4son = cv_prop_map(inode)%ind_proc + else + procs4son = cv_prop_map(in)%ind_proc + in_tmp=in + nfront=cv_nfsiz(in_tmp) + npiv=0 + in_tmp=in_tmp + do while(in_tmp.gt.0) + npiv=npiv+1 + in_tmp=cv_fils(in_tmp) + end do + ncb=nfront-npiv + if (force_cand) then + if (cv_keep(50) == 0) then + keep48_loc=0 + else + keep48_loc=3 + endif + if (cv_keep(48).EQ.5) keep48_loc = 5 + min_cand_needed= + & MUMPS_50 + & (cv_slavef, keep48_loc,cv_keep8(21), + & cv_keep(50), + & nfront,ncb) + min_cand_needed=min(cv_slavef,min_cand_needed+1) + else + min_cand_needed = 0 + endif + min_cand_needed = max(min_cand_needed, cv_keep(91)) + if(costs_sons.gt.0.0D0) then + relative_weight=cv_tcostw(in)/costs_sons + else + relative_weight=dble(0) + endif + nmb_propmap_strict=0 + do k=1,cv_slavef + if( MUMPS_480(procs4son,k)) then + nmb_propmap_strict=nmb_propmap_strict+1 + end if + end do + offset=1 + share2= + & max(0,nint(relative_weight*(loc_relax-dble(1))* + & dble(nmb_procs_inode))) + share2 = max(share2, min_cand_needed -nmb_propmap_strict, + & (cv_keep(83)/2) - nmb_propmap_strict) + procsrest=nmb_procs_inode - nmb_propmap_strict + share2=min(share2,procsrest) + share2 = 0 + CALL random_number(Y) + current2 =int(dble(Y)*dble(procsrest)) + nb_free_procs=1 + do j=1,cv_slavef + if(share2.le.0) exit + if(ke69 .gt.1) then + call MUMPS_493(j-1,k69onid,ierr) + else + k69onid = j + endif + if(( MUMPS_481(inode,k69onid)).AND. + & (.NOT.MUMPS_480(procs4son,k69onid))) then + if(nb_free_procs.ge.current2)then + call MUMPS_482(procs4son,k69onid,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0)write(cv_lp,*) + & 'BIT_SET signalled error to',subname + istat = ierr + return + end if + share2 = share2 - 1 + endif + nb_free_procs=nb_free_procs+1 + end if + end do + if(share2.gt.0) then + do j=1,cv_slavef + if(share2.le.0) exit + if(ke69 .gt.1) then + call MUMPS_493(j-1,k69onid,ierr) + else + k69onid = j + endif + if(( MUMPS_481(inode,k69onid)).AND. + & (.NOT.MUMPS_480(procs4son,k69onid))) then + call MUMPS_482(procs4son,k69onid,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0)write(cv_lp,*) + & 'BIT_SET signalled error to',subname + istat = ierr + return + end if + share2 = share2 - 1 + end if + end do + endif + if(share2.ne.0) then + if(cv_lp.gt.0) write(cv_lp,*) + & 'Error reported in ',subname + return + end if + endif + ierr=0 + in1=in + cv_prop_map(in1)%ind_proc = procs4son + call MUMPS_433(in1,ctr-1,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) write(cv_lp,*) + & 'Error reported in ',subname + istat=ierr + return + endif + in=cv_frere(in) + end do + istat = 0 + return + end subroutine MUMPS_433 + subroutine MUMPS_434(inode,istat) + implicit none + integer, intent(in)::inode + integer, intent(out)::istat + integer j,k,allocok + character (len=48):: subname + istat = -1 + if(cv_frere(inode).eq.cv_n+1) return + subname='PROPMAP_INIT' + if(.not.associated( + & cv_prop_map(inode)%ind_proc)) then + allocate(cv_prop_map(inode)%ind_proc + & (cv_size_ind_proc),STAT=allocok) + if (allocok.gt.0) then + cv_info(1) = cv_error_memalloc + cv_info(2) = cv_size_ind_proc + istat = cv_error_memalloc + if(cv_lp.gt.0) + & write(cv_lp,*) + & 'memory allocation error in ',subname + return + end if + end if + do k=1,cv_size_ind_proc + do j=0,cv_bitsize_of_int-1 + cv_prop_map(inode)%ind_proc(k)= + & ibclr(cv_prop_map(inode)%ind_proc(k),j) + end do + end do + istat = 0 + return + end subroutine MUMPS_434 + subroutine MUMPS_435(inode,istat) + integer,intent(in)::inode + integer,intent(out)::istat + integer ierr + character (len=48):: subname + subname='PROPMAP_TERM' + istat =-1 + if(associated(cv_prop_map(inode)%ind_proc)) then + deallocate(cv_prop_map(inode)%ind_proc, STAT=ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Memory deallocation error in ', subname + istat = cv_error_memdeloc + return + endif + nullify(cv_prop_map(inode)%ind_proc) + end if + istat =0 + return + end subroutine MUMPS_435 + subroutine MUMPS_436(ison,ifather,istat) + implicit none + integer,intent(in)::ison,ifather + integer,intent(out)::istat + character (len=48):: subname + istat= -1 + subname='PROPMAP4AMALG' + call MUMPS_435(ison,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'PROPMAP_TERM signalled error in ', + & subname + istat = ierr + return + end if + istat = 0 + return + end subroutine MUMPS_436 + subroutine MUMPS_437(inode,ifather,istat) + implicit none + integer,intent(in)::inode,ifather + integer,intent(out)::istat + character (len=48):: subname + istat= -1 + subname='PROPMAP4SPLIT' + if((cv_frere(inode).eq.cv_n+1).OR.(cv_frere(ifather).eq.cv_n+1) + & .OR.(.NOT.associated(cv_prop_map(inode)%ind_proc))) then + if(cv_lp.gt.0) + & write(cv_lp,*)'tototo signalled error to' + & ,subname + return + endif + if(.NOT.associated(cv_prop_map(ifather)%ind_proc)) then + call MUMPS_434(ifather,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'PROPMAP_INIT signalled error to ' + & ,subname + istat = ierr + return + end if + endif + cv_prop_map(ifather)%ind_proc = + & cv_prop_map(inode)%ind_proc + istat=0 + return + end subroutine MUMPS_437 + subroutine MUMPS_394(istat) + implicit none + integer,intent(out)::istat + integer i,allocok + character (len=48):: subname + istat=-1 + subname='ROOTLIST' + allocate(cv_layerl0_array(cv_maxnsteps), + & cv_layerl0_sorted_costw(cv_maxnsteps),STAT=allocok) + if (allocok.gt.0) then + cv_info(1) = cv_error_memalloc + cv_info(2) = 12*cv_maxnsteps + istat = cv_error_memalloc + if(cv_lp.gt.0) + & write(cv_lp,*) + & 'memory allocation error in ',subname + return + end if + do i=1,cv_maxnsteps + cv_layerl0_sorted_costw(i)=dble(0) + cv_layerl0_array(i)=0 + end do + cv_layerl0_start = 0 + cv_layerl0_end = 0 + layerL0_endforarrangeL0 = 0 + if ((.NOT.associated(cv_tcostw)).OR.(.NOT.associated(cv_tcostm))) + & then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error:tcost must be allocated in ',subname + return + end if + cv_nbsa=0 + do i=1,cv_n + if (cv_frere(i).eq.0) then + cv_layerl0_start=1 + cv_layerl0_end=cv_layerl0_end+1 + IF (cv_tcostw(i).GT.mincostw) + & layerL0_endforarrangeL0 = layerL0_endforarrangeL0+1 + cv_layerl0_array(cv_layerl0_end)=i + cv_layerl0_sorted_costw(cv_layerl0_end)=cv_tcostw(i) + cv_costw_layer0=cv_costw_layer0 + cv_tcostw(i) + cv_costm_layer0=cv_costm_layer0 + cv_tcostm(i) + cv_nbsa=cv_nbsa+1 + end if + end do + if(cv_nbsa.eq.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error:no root nodes in ',subname + return + end if + call MUMPS_459(cv_layerl0_end-cv_layerl0_start+1, + & cv_layerl0_array(cv_layerl0_start:cv_layerl0_end), + & cv_layerl0_sorted_costw(cv_layerl0_start:cv_layerl0_end)) + cv_costw_total=cv_costw_layer0 + cv_costm_total=cv_costm_layer0 + istat=0 + return + end subroutine MUMPS_394 + subroutine MUMPS_396(istat) + implicit none + integer,intent(out)::istat + character (len=48):: subname + subname='SELECT_TYPE3' + CALL MUMPS_712(cv_n, slavef, cv_mp, cv_icntl(13), + & cv_keep(1), cv_frere(1), cv_nfsiz(1), istat) + IF (istat .NE. 0) THEN + if(cv_lp.gt.0) + & write(cv_lp,*) + & 'Error: Can''t select type 3 node in ',subname + ELSE IF (cv_keep(38) .ne. 0) then + IF(cv_nodelayer(cv_keep(38)).eq.0.and. + & (cv_keep(60).EQ.0)) then + cv_keep(38)=0 + ELSE + cv_nodetype(cv_keep(38))=3 + ENDIF + ENDIF + RETURN + end subroutine MUMPS_396 + subroutine MUMPS_397(istat) + integer,intent(out):: istat + integer :: i,dummy,layernmb,allocok + integer :: montype, in, ifather, nbcand, + & inode, k + character (len=48):: subname + istat=-1 + subname='SETUP_CAND' + cv_nb_niv2=0 + do i=1,cv_n + if(MUMPS_811(i)) cv_nb_niv2=cv_nb_niv2+1 + end do + cv_keep(56)=cv_nb_niv2 + nullify(cv_par2_nodes,cv_cand) + allocate(cv_par2_nodes(cv_nb_niv2), + & cv_cand(cv_nb_niv2,cv_slavef+1),STAT=allocok) + if (allocok.gt.0) then + cv_info(1) = cv_error_memalloc + cv_info(2) = cv_nb_niv2*(cv_slavef+2) + istat = cv_error_memalloc + if(cv_lp.gt.0) + & write(cv_lp,*) + & 'memory allocation error in ',subname + return + end if + cv_par2_nodes=0 + cv_cand(:,:)=0 + dummy=1 + do layernmb=1,cv_maxlayer + do i=1,cv_layer_p2node(layernmb)%nmb_t2s + inode = cv_layer_p2node(layernmb)%t2_nodenumbers(i) + cv_par2_nodes(dummy)= inode + nbcand = cv_layer_p2node(layernmb)%t2_cand(i,cv_slavef+1) + cv_cand(dummy,:)=cv_layer_p2node(layernmb)%t2_cand(i,:) + montype= cv_nodetype(inode) + if (montype.eq.4) then + in = inode + k = 1 + do while (cv_frere(in).lt.0) + ifather = -cv_frere(in) + if ( (cv_nodetype(ifather).eq.tsplit_mid) .or. + & (cv_nodetype(ifather).eq.tsplit_last) ) then + if (nbcand.lt.2) then + write(6,*) ' Internal WARNING 1 in SETUP_CAND', + & ' nb split = ', k, 'greater than nbcand = ', + & nbcand, ' see comment in code !' + cv_par2_nodes(dummy+1) = ifather + cv_procnode(ifather) = cv_procnode(in) + cv_cand(dummy+1,:) = cv_cand(dummy,:) + dummy = dummy + 1 + write(6,*) ' Mapping property', + & ' of procs in chain lost ' + CALL MUMPS_ABORT() + else + cv_par2_nodes(dummy+1) = ifather + cv_procnode(ifather) = cv_cand(dummy,1) + 1 + cv_cand(dummy+1,1:nbcand-1+k-1) = + & cv_cand(dummy,2:nbcand+k-1) + cv_cand(dummy+1,nbcand-1+k) = cv_procnode(in)-1 + cv_cand(dummy+1,cv_slavef+1)= nbcand-1 + cv_cand(dummy+1,nbcand-1+k+1:cv_slavef) = cv_invalid + nbcand = nbcand -1 + dummy = dummy+1 + endif + else + write(6,*) ' Internal error 2 in SETUP_CAND', + & ' in, ifather =', in, ifather, + & ' cv_nodetype(ifather) ', cv_nodetype(ifather) + endif + if (cv_nodetype(ifather).eq.tsplit_last) then + exit + endif + in = ifather + k = k + 1 + end do + endif + dummy=dummy+1 + enddo + enddo + if(dummy.ne.cv_nb_niv2+1) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error in ',subname, + & ' : dummy =',dummy,'nbniv2 =',cv_nb_niv2 + return + endif + istat=0 + return + end subroutine MUMPS_397 + subroutine MUMPS_398(map_strat,workload,memused, + & inode,istat) + implicit none + integer,intent(in)::map_strat + DOUBLE PRECISION,dimension(:),intent(in)::workload, memused + integer, optional::inode,istat + integer i,j,aux_int,nmb_procs,pos + character (len=48):: subname + logical enforce_prefsort + logical use_propmap + logical,SAVE::init1 = .FALSE. + logical,SAVE::init2 = .FALSE. + subname='SORTPROCS' + enforce_prefsort=.TRUE. + use_propmap=present(inode) + if(present(istat))istat=-1 + if((map_strat.ne.cv_equilib_flops).and. + & (map_strat.ne.cv_equilib_mem)) then + if(cv_lp.gt.0) + & write(cv_lp,*)'error in ',subname + return + endif + i=0 + do i = 1, cv_slavef + cv_proc_sorted(i)=i + enddo + if (.not.present(inode)) then + if(.NOT.init1) then + init1=.TRUE. + end if + do i=1,cv_slavef-1 + do j=i+1,cv_slavef + if(((workload(cv_proc_sorted(j)).lt. + & workload(cv_proc_sorted(i))).AND. + & (map_strat.eq.cv_equilib_flops)) + & .OR. + & ((memused(cv_proc_sorted(j)).lt. + & memused(cv_proc_sorted(i))).AND. + & (map_strat.eq.cv_equilib_mem)))then + aux_int=cv_proc_sorted(j) + cv_proc_sorted(j)=cv_proc_sorted(i) + cv_proc_sorted(i)=aux_int + end if + end do + end do + else if(present(inode)) then + if (use_propmap) then + if(.NOT.init2) then + init2=.TRUE. + end if + nmb_procs=0 + do pos=1,cv_slavef + if( MUMPS_481(inode,pos)) then + if (pos.le.nmb_procs) then + exit + else + nmb_procs=nmb_procs+1 + aux_int=cv_proc_sorted(pos) + cv_proc_sorted(pos)= + & cv_proc_sorted(nmb_procs) + cv_proc_sorted(nmb_procs)=aux_int + cycle + end if + end if + end do + end if + do i=1,nmb_procs-1 + do j=i+1,nmb_procs + if(((workload(cv_proc_sorted(j)).lt. + & workload(cv_proc_sorted(i))).AND. + & (map_strat.eq.cv_equilib_flops)) + & .OR. + & ((memused(cv_proc_sorted(j)).lt. + & memused(cv_proc_sorted(i))).AND. + & (map_strat.eq.cv_equilib_mem)))then + aux_int=cv_proc_sorted(j) + cv_proc_sorted(j)=cv_proc_sorted(i) + cv_proc_sorted(i)=aux_int + end if + end do + end do + do i=nmb_procs+1,cv_slavef-1 + do j=i+1,cv_slavef + if(((workload(cv_proc_sorted(j)).lt. + & workload(cv_proc_sorted(i))).AND. + & (map_strat.eq.cv_equilib_flops)) + & .OR. + & ((memused(cv_proc_sorted(j)).lt. + & memused(cv_proc_sorted(i))).AND. + & (map_strat.eq.cv_equilib_mem)))then + aux_int=cv_proc_sorted(j) + cv_proc_sorted(j)=cv_proc_sorted(i) + cv_proc_sorted(i)=aux_int + end if + end do + end do + if(.NOT.enforce_prefsort) then + if(((2.0D0*workload(cv_proc_sorted(nmb_procs+1)).lt. + & workload(cv_proc_sorted(1))).AND. + & (map_strat.eq.cv_equilib_flops)) + & .OR. + & ((2.0D0*memused(cv_proc_sorted(nmb_procs+1)).lt. + & memused(cv_proc_sorted(1))).AND. + & (map_strat.eq.cv_equilib_mem)))then + do i=1,cv_slavef-1 + do j=i+1,cv_slavef + if(((workload(cv_proc_sorted(j)).lt. + & workload(cv_proc_sorted(i))).AND. + & (map_strat.eq.cv_equilib_flops)) + & .OR. + & ((memused(cv_proc_sorted(j)).lt. + & memused(cv_proc_sorted(i))).AND. + & (map_strat.eq.cv_equilib_mem)))then + aux_int=cv_proc_sorted(j) + cv_proc_sorted(j)=cv_proc_sorted(i) + cv_proc_sorted(i)=aux_int + end if + end do + end do + endif + end if + endif + if(present(istat))istat=0 + return + end subroutine MUMPS_398 + subroutine MUMPS_402(ne,nfsiz,frere,fils,keep,KEEP8, + & info,procnode,ssarbr,nbsa) + implicit none + integer,dimension(cv_n),intent(inout)::ne,nfsiz,frere,fils, + & procnode,ssarbr + integer, intent(inout):: keep(500),info(40),nbsa + INTEGER(8) KEEP8(150) + ne=cv_ne + nfsiz=cv_nfsiz + frere=cv_frere + fils=cv_fils + keep(2) =cv_keep(2) + keep(20)=cv_keep(20) + keep(28)=cv_nsteps + keep(38)=cv_keep(38) + keep(56)=cv_keep(56) + keep(61)=cv_keep(61) + info(5)=cv_info(5) + info(6)=cv_nsteps + procnode=cv_procnode + ssarbr=cv_ssarbr + nbsa=cv_nbsa + end subroutine MUMPS_402 + subroutine MUMPS_403(istat) + implicit none + integer,intent(out)::istat + integer i,ierr,layernmb + character (len=48):: subname + istat=-1 + subname='TERMGLOB' + nullify(cv_frere,cv_fils,cv_nfsiz,cv_ne,cv_keep,cv_keep8, + & cv_icntl,cv_info,cv_procnode,cv_ssarbr) + deallocate(cv_proc_workload,cv_proc_maxwork,cv_proc_memused, + & cv_proc_maxmem,cv_nodetype, + & cv_nodelayer,cv_proc_sorted, + & cv_ncostw,cv_ncostm, + & cv_layerworkload,cv_layermemused, + & STAT=ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Memory deallocation error in ',subname + istat = cv_error_memdeloc + return + end if + deallocate(work_per_proc,id_son,STAT=ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Memory deallocation error in ',subname + istat = cv_error_memdeloc + return + end if + do layernmb=1,cv_maxlayer + if(cv_layer_p2node(layernmb)%nmb_t2s.gt.0) then + deallocate(cv_layer_p2node(layernmb)%t2_nodenumbers, + & cv_layer_p2node(layernmb)%t2_cand, + & cv_layer_p2node(layernmb)%t2_candcostw, + & cv_layer_p2node(layernmb)%t2_candcostm, + & STAT=ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Memory deallocation error in ', + & subname + istat = cv_error_memdeloc + return + end if + endif + enddo + if(associated(cv_layer_p2node)) then + deallocate(cv_layer_p2node,STAT=ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Memory deallocation error in ',subname + istat = cv_error_memdeloc + return + end if + end if + do i=1,cv_n + call MUMPS_435(i,ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'PROPMAP_TERM signalled error in ', + & subname + istat = ierr + return + end if + end do + if(associated(cv_prop_map))deallocate(cv_prop_map,STAT=ierr) + if(ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Memory deallocation error in ',subname + istat = cv_error_memdeloc + return + end if + istat=0 + return + end subroutine MUMPS_403 + recursive subroutine MUMPS_404(pos,istat) + implicit none + integer,intent(in)::pos + integer, intent(out)::istat + integer i,nfront,npiv,nextpos,ierr + DOUBLE PRECISION costw,costm + character (len=48):: subname + istat=-1 + subname='TREECOSTS' + if ((.NOT.associated(cv_tcostw)).OR.(.NOT.associated(cv_tcostm))) + & then + if(cv_lp.gt.0) + & write(cv_lp,*)'Error:tcost must be allocated in ',subname + return + end if + nfront=cv_nfsiz(pos) + npiv=1 + nextpos=cv_fils(pos) + do + if(nextpos.le.0) then + exit + else + npiv=npiv+1 + nextpos=cv_fils(nextpos) + end if + end do + call MUMPS_418(npiv,nfront,costw,costm) + cv_ncostw(pos)=costw + cv_ncostm(pos)=costm + if (cv_ne(pos).ne.0) then + nextpos=cv_fils(pos) + do while(nextpos.gt.0) + nextpos=cv_fils(nextpos) + end do + nextpos=-nextpos + do i=1,cv_ne(pos) + cv_depth(nextpos)=cv_depth(pos)+1 + call MUMPS_404(nextpos,ierr) + if (ierr.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Failure in recursive call to ',subname + return + end if + costw=costw+cv_tcostw(nextpos) + costm=costm+cv_tcostm(nextpos) + nextpos=cv_frere(nextpos) + end do + endif + cv_tcostw(pos) = costw + cv_tcostm(pos) = costm + istat = 0 + end subroutine MUMPS_404 + recursive subroutine MUMPS_406(inode) + implicit none + integer, intent(in)::inode + integer in + cv_nodetype(inode)=-1 + in=cv_fils(inode) + do while (in>0) + in=cv_fils(in) + end do + in=-in + do while(in.gt.0) + call MUMPS_406(in) + in=cv_frere(in) + enddo + end subroutine MUMPS_406 + subroutine MUMPS_408(workload,memused, + & maxwork,minwork,maxmem,minmem) + implicit none + DOUBLE PRECISION,dimension(:),intent(in)::workload, + & memused + DOUBLE PRECISION,intent(out)::maxwork,minwork,maxmem,minmem + intrinsic maxval,minval + maxwork=maxval(workload) + minwork=minval(workload, mask= workload > dble(0)) + maxmem=maxval(memused) + minmem=minval(memused, mask= memused > dble(0)) + end subroutine MUMPS_408 + subroutine MUMPS_476(layernumber,nodenumber) + implicit none + integer layernumber,nodenumber + integer i + integer inode + integer current_max,current_proc + current_max = 0 + score = 0 + allowed_nodes = .FALSE. + inode=cv_layer_p2node(layernumber)%t2_nodenumbers(nodenumber) + do i=1,cv_layer_p2node(layernumber)%t2_cand(nodenumber, + & cv_slavef+1) + current_proc=cv_layer_p2node(layernumber)%t2_cand(nodenumber,i) + if ( current_proc .ge. 0) then + score(mem_distribmpi(current_proc)) = + & score(mem_distribmpi(current_proc)) + 1 + endif + enddo + current_proc = cv_procnode(inode) - 1 + score(mem_distribmpi(current_proc)) = + & score(mem_distribmpi(current_proc)) + 1 + do i=0,nb_arch_nodes - 1 + if ( score(i) .gt. current_max ) then + current_max = score(i) + allowed_nodes = .FALSE. + allowed_nodes(i) = .TRUE. + else + if(score(i) .eq. current_max) then + allowed_nodes(i) = .TRUE. + endif + endif + enddo + return + end subroutine MUMPS_476 + end subroutine MUMPS_369 + subroutine MUMPS_393(par2_nodes,cand,istat) + integer, intent(out) :: par2_nodes(cv_nb_niv2), istat + integer, intent(out) :: cand(:,:) + character (len=48):: subname + integer iloop + istat=-1 + subname='MUMPS_393' + par2_nodes=cv_par2_nodes + do iloop=1, cv_slavef+1 + cand(iloop,:)=cv_cand(:,iloop) + enddo + deallocate(cv_par2_nodes,cv_cand,STAT=istat) + if(istat.ne.0) then + if(cv_lp.gt.0) + & write(cv_lp,*)'Memory deallocation error in ',subname + istat = cv_error_memdeloc + return + end if + istat = 0 + return + end subroutine MUMPS_393 + subroutine MUMPS_427( + & total_comm,working_comm,keep69,par, + & nbslaves,mem_distrib,informerr) + implicit none + include 'mpif.h' + integer nbslaves + integer, dimension(0:) :: mem_distrib + integer total_comm,working_comm,keep69,par + integer, dimension(:) ::informerr + integer myrank + integer host,i,ierr + integer,dimension(:),allocatable :: buffer_memdistrib + ierr = 0 + myrank = -1 + host = -1 + ke69 = keep69 + cv_slavef = nbslaves + if (ke69 .eq. 1) then + return + endif + if ( allocated(mem_distribtmp) ) deallocate(mem_distribtmp ) + allocate( mem_distribtmp( 0:cv_slavef-1 ), + & buffer_memdistrib( 0:cv_slavef-1 ), stat=ierr ) + if ( ierr .gt. 0 ) then + if(cv_mp.gt.0) write(cv_mp,*) 'pb allocation mem_dist' + informerr(1) = -13 + informerr(2) = cv_slavef + return + end if + mem_distribtmp = -1 + call MPI_COMM_RANK( total_comm, host, ierr ) + if ((par .eq. 1) .or. (host .ne. 0)) then + call MPI_COMM_RANK( working_comm, myrank, ierr ) + call MUMPS_430(ierr,myrank, + & working_comm,mem_distrib) + if ( ierr .ne. 0 ) then + if(cv_mp.gt.0) + & write(cv_mp,*) 'pb in mumps_init_arch_parameters' + informerr(1) = -13 + informerr(2) = cv_slavef + return + end if + mem_distribtmp = mem_distrib + call MUMPS_429(ierr) + if ( ierr .ne. 0 ) then + if(cv_mp.gt.0) write(cv_mp,*) + &'pb in mumps_init_arch_parameters' + informerr(1) = -13 + informerr(2) = cv_slavef + return + endif + endif + if(ke69 .le. 0) then + deallocate(mem_distribtmp) + deallocate(buffer_memdistrib) + return + endif + call MPI_ALLREDUCE(mem_distribtmp(0),buffer_memdistrib(0), + & cv_slavef,MPI_INTEGER, + & MPI_MAX,total_comm,ierr) + mem_distribtmp = buffer_memdistrib + deallocate (buffer_memdistrib) + call MUMPS_492() + if((cv_slavef/nb_arch_nodes) .le. 4) then + do i = 0, cv_slavef-1 + if ( mem_distrib(i) .NE. 1 ) then + mem_distrib(i)=max(ke69/2,2) + endif + enddo + endif + if((nb_arch_nodes .eq. 1) .or. + & (nb_arch_nodes .eq. cv_slavef)) then + ke69 = 1 + keep69 = 1 + deallocate(mem_distribtmp) + return + endif + if (host .eq. 0) then + if ( allocated(mem_distribmpi) ) deallocate(mem_distribmpi ) + allocate( mem_distribmpi( 0:cv_slavef-1 ), stat=ierr ) + if ( ierr .gt. 0 ) then + if(cv_mp.gt.0) write(cv_mp,*) 'pb allocation mem_dist' + informerr(1) = -13 + informerr(2) = cv_slavef + return + endif + call MUMPS_495(ierr) + if(ierr .ne. 0 ) then + return + endif + mem_distribmpi = mem_distribtmp + call MUMPS_428(ierr) + if ( ierr .ne. 0 ) then + if(cv_mp.gt.0) + & write(cv_mp,*) 'pb in mumps_init_arch_parameters' + informerr(1) = -13 + informerr(2) = cv_slavef + return + endif + else + deallocate(mem_distribtmp) + endif + return + end subroutine MUMPS_427 + subroutine MUMPS_492() + implicit none + integer i + nb_arch_nodes = 0 + do i=0,cv_slavef-1 + if(mem_distribtmp(i) .eq. i) then + nb_arch_nodes = nb_arch_nodes + 1 + endif + enddo + return + end subroutine MUMPS_492 + subroutine MUMPS_428(ierr) + implicit none + external MUMPS_463 + integer i,precnode,nodecount + integer sizesmp + integer ierr + ierr = 0 + sizesmp = 0 + if ( allocated(table_of_process) ) + & deallocate(table_of_process ) + allocate( table_of_process(0:cv_slavef-1), stat=ierr ) + if ( ierr .gt. 0 ) then + if(cv_mp.gt.0) write(cv_mp,*) + & 'pb allocation in MUMPS_428' + return + end if + do i=0,cv_slavef - 1 + table_of_process(i) = i + enddo + call MUMPS_463(cv_slavef,mem_distribtmp(0), + & table_of_process(0)) + precnode = 0 + nodecount = 0 + do i=0,cv_slavef-1 + if(mem_distribtmp(i) .eq. precnode) then + sizesmp = sizesmp + 1 + mem_distribtmp(i) = nodecount + mem_distribmpi(table_of_process(i)) = nodecount + else + score(nodecount) = sizesmp + sizesmp = 1 + nodecount = nodecount + 1 + precnode = mem_distribtmp(i) + mem_distribtmp(i) = nodecount + mem_distribmpi(table_of_process(i)) = nodecount + endif + enddo + score(nodecount) = sizesmp + do i=0,cv_slavef-1 + mem_distribtmp(i) = score(mem_distribtmp(i)) + enddo + CALL MUMPS_466(cv_slavef,mem_distribtmp(0), + & table_of_process(0)) + ierr = 0 + return + end subroutine MUMPS_428 + subroutine MUMPS_429(ierr) + implicit none + integer i,j,ierr + integer idmaster + idmaster = -1 + ierr = 0 + do i=0,cv_slavef-1 + if (mem_distribtmp(i) .eq. 1) then + idmaster = i + do j=i,cv_slavef-1 + if (mem_distribtmp(j) .eq. 1) then + mem_distribtmp(j) = idmaster + else + mem_distribtmp(j) = 0 + endif + enddo + return + else + mem_distribtmp(i) = 0 + endif + enddo + if(cv_mp.gt.0) write(cv_mp,*)'problem in MUMPS_429: + & cannot find a master' + ierr = 1 + return + end subroutine MUMPS_429 + subroutine MUMPS_430(ierr,myrank,working_comm, + & mem_distrib) + implicit none + include 'mpif.h' + integer ierr,resultlen,myrank,i,working_comm + integer , dimension(0:) :: mem_distrib + integer allocok + character(len=MPI_MAX_PROCESSOR_NAME) name + integer, dimension(:),allocatable :: namercv + integer, dimension(:),allocatable :: myname + integer lenrcv + external MUMPS_438 + logical MUMPS_438 + ierr = 0 + call MPI_GET_PROCESSOR_NAME(name,resultlen,ierr) + allocate(myname(resultlen),stat=allocok) + if ( allocok .gt. 0 ) then + if(cv_mp.gt.0) write(cv_mp,*) + & 'pb allocation in compute_dist for myname' + ierr = 1 + return + end if + do i=1, resultlen + myname(i) = ichar(name(i:i)) + enddo + do i=0, cv_slavef-1 + if(myrank .eq. i) then + lenrcv = resultlen + else + lenrcv = 0 + endif + call MPI_BCAST(lenrcv,1,MPI_INTEGER,i, + & working_comm,ierr) + allocate(namercv(lenrcv),stat=allocok) + if ( allocok .gt. 0 ) then + if(cv_mp.gt.0) write(cv_mp,*) + & 'pb allocation in compute_dist for namercv' + ierr = 1 + return + end if + if(myrank .eq. i) then + namercv = myname + endif + call MPI_BCAST(namercv,lenrcv,MPI_INTEGER,i, + & working_comm,ierr) + if( MUMPS_438(myname,namercv, + & resultlen,lenrcv)) then + mem_distrib(i)=1 + else + mem_distrib(i)=ke69 + endif + deallocate(namercv) + enddo + deallocate(myname) + ierr = 0 + return + end subroutine MUMPS_430 + subroutine MUMPS_493(current_proc,idarch,ierr) + implicit none + integer current_proc + integer idarch,ierr + ierr = 0 + if (current_proc .ge. cv_slavef) then + ierr = -1 + return + endif + if (current_proc .lt. 0) then + idarch = 1 + return + else + idarch = table_of_process(current_proc) + 1 + endif + return + end subroutine MUMPS_493 + subroutine MUMPS_494() + if (allocated(table_of_process)) deallocate(table_of_process) + if (allocated(allowed_nodes)) deallocate(allowed_nodes) + if (allocated(score)) deallocate(score) + if (allocated(mem_distribtmp)) deallocate(mem_distribtmp) + if (allocated(mem_distribmpi)) deallocate(mem_distribmpi) + return + end subroutine MUMPS_494 + subroutine MUMPS_495(ierr) + integer ierr + ierr = 0 + if (allocated(allowed_nodes)) deallocate(allowed_nodes) + allocate( allowed_nodes(0:nb_arch_nodes-1),stat=ierr) + if ( ierr .gt. 0 ) then + if(cv_mp.gt.0) write(cv_mp,*) + & 'pb allocation MUMPS_495' + ierr = -13 + return + end if + allowed_nodes = .FALSE. + if (allocated(score)) deallocate(score) + allocate( score(0:nb_arch_nodes-1),stat=ierr) + if ( ierr .gt. 0 ) then + if(cv_mp.gt.0) write(cv_mp,*) + & 'pb allocation MUMPS_495' + ierr = -13 + return + end if + score = 0 + ierr = 0 + return + end subroutine MUMPS_495 + subroutine MUMPS_496(idproc,thenode) + implicit none + integer idproc,thenode + thenode = mem_distribmpi(idproc) + return + end subroutine MUMPS_496 + SUBROUTINE MUMPS_516(start1st,end1st,dim1, + & start2nd,end2nd,dim2, + & indx, + & val) + implicit none + integer, intent(in):: start1st,end1st,dim1,start2nd,end2nd,dim2 + integer, intent(inout):: indx(:) + DOUBLE PRECISION, intent(inout):: val(:) + integer::index(dim1+dim2) + DOUBLE PRECISION ::dummy1(dim1+dim2) + integer:: a,b,c + a=start1st + b=start2nd + c=1 + do while((a.LT.end1st+1).AND.(b.LT.end2nd+1)) + if(val(a).GT.val(b))then + index(c)=indx(a) + dummy1(c)=val(a) + a=a+1 + c=c+1 + else + index(c)=indx(b) + dummy1(c)=val(b) + b=b+1 + c=c+1 + endif + end do + if(a.LT.end1st+1) then + do while(a.LT.end1st+1) + index(c)=indx(a) + dummy1(c)=val(a) + a=a+1 + c=c+1 + enddo + elseif(b.LT.end2nd+1) then + do while(b.LT.end2nd+1) + index(c)=indx(b) + dummy1(c)=val(b) + b=b+1 + c=c+1 + enddo + endif + indx(start1st:end1st)=index(1:dim1) + val(start1st:end1st)=dummy1(1:dim1) + indx(start2nd:end2nd)=index(dim1+1:dim1+dim2) + val(start2nd:end2nd)=dummy1(dim1+1:dim1+dim2) + end SUBROUTINE MUMPS_516 + SUBROUTINE MUMPS_459(dim,indx,val1,val2) + implicit none + integer, intent(in):: dim + integer, intent(inout):: indx(:) + DOUBLE PRECISION, intent(inout):: val1(:) + DOUBLE PRECISION, intent(inout),optional:: val2(:) + integer::index(dim),dummy1(dim) + DOUBLE PRECISION ::dummy2(dim) + integer, parameter :: ss = 35 + integer:: a,b,c,i,k,l,r,s,stackl(ss),stackr(ss) + do i=1,dim + index(i)=i + enddo + s = 1 + stackl(1) = 1 + stackr(1) = dim + 5511 CONTINUE + l = stackl(s) + r = stackr(s) + k = (l+r) / 2 + if(l.LT.k) then + if(s.GE.ss) stop 'maxsize of stack reached' + s = s + 1 + stackl(s) = l + stackr(s) = k + goto 5511 + endif + 5512 CONTINUE + l = stackl(s) + r = stackr(s) + k = (l+r) / 2 + if(k+1.LT.r) then + if(s.GE.ss) stop 'maxsize of stack reached' + s = s + 1 + stackl(s) = k+1 + stackr(s) = r + goto 5511 + endif + 5513 CONTINUE + l = stackl(s) + r = stackr(s) + k = (l+r) / 2 + a=l + b=k+1 + c=1 + do while((a.LT.k+1).AND.(b.LT.r+1)) + if(val1(index(a)).GT.val1(index(b)))then + dummy1(c)=index(a) + a=a+1 + c=c+1 + else + dummy1(c)=index(b) + b=b+1 + c=c+1 + endif + end do + if(a.LT.k+1) then + dummy1(c:r-l+1)=index(a:k) + elseif(b.LT.r+1) then + dummy1(c:r-l+1)=index(b:r) + endif + index(l:r)=dummy1(1:r-l+1) + if(s.GT.1) then + s = s - 1 + if(l.EQ.stackl(s)) goto 5512 + if(r.EQ.stackr(s)) goto 5513 + endif + do i=1,dim + dummy1(i)=indx(index(i)) + enddo + indx=dummy1 + do i=1,dim + dummy2(i)=val1(index(i)) + enddo + val1=dummy2 + if(present(val2)) then + do i=1,dim + dummy2(i)=val2(index(i)) + enddo + val2=dummy2 + endif + return + end subroutine MUMPS_459 + END MODULE MUMPS_STATIC_MAPPING + SUBROUTINE MUMPS_712(N, SLAVEF, MP, + & ICNTL13, KEEP, FRERE, ND, ISTAT) + IMPLICIT NONE + INTEGER, intent(in) :: N, SLAVEF, ICNTL13, MP + INTEGER KEEP(150) + INTEGER FRERE(N), ND(N) + INTEGER, intent(out) :: ISTAT + INTEGER IROOTTREE, SIZEROOT, NFRONT, I + ISTAT = 0 + IF (KEEP(60).EQ.2 .or. KEEP(60).EQ.3 ) THEN + ELSE + IF((SLAVEF.EQ.1).OR.(ICNTL13.GT.0).OR. + & (KEEP(60).NE.0)) THEN + KEEP(38) = 0 + ELSE + IROOTTREE=-1 + SIZEROOT=-1 + DO I=1,N + IF (FRERE(I).EQ.0) THEN + NFRONT = ND(I) + IF (NFRONT .GT.SIZEROOT) THEN + IROOTTREE = I + SIZEROOT = NFRONT + END IF + END IF + END DO + IF ((IROOTTREE.EQ.-1).OR.(SIZEROOT.EQ.-1)) THEN + ISTAT = -1 + RETURN + ENDIF + IF (SIZEROOT.LE.SLAVEF) THEN + KEEP(38) = 0 + ELSE IF((SIZEROOT.GT.KEEP(37)) + & .AND. (KEEP(53).EQ.0) + & ) THEN + IF (MP.GT.0) WRITE(MP,*) 'A root of estimated size ', + & SIZEROOT,' has been selected for Scalapack.' + KEEP(38) = IROOTTREE + ELSE + KEEP(38) = 0 + IF (MP.GT.0) WRITE(MP,*) + & ' WARNING: Largest root node of size ', SIZEROOT, + & ' not selected for parallel execution' + END IF + IF ((KEEP(38).EQ.0).AND.(KEEP(53).NE.0)) THEN + KEEP(20) = IROOTTREE + ELSE IF (KEEP(60).EQ.0) THEN + KEEP(20) = 0 + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE MUMPS_712 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_tags.h b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_tags.h new file mode 100644 index 000000000..363492f51 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/mumps_tags.h @@ -0,0 +1,122 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + INTEGER ARROWHEAD, ARR_INT, ARR_REAL, ELT_INT, ELT_REAL + PARAMETER ( ARROWHEAD = 20, + * ARR_INT = 29, + * ARR_REAL = 30, + * ELT_INT = 31, + * ELT_REAL = 32 ) + INTEGER COLLECT_NZ, COLLECT_IRN, COLLECT_JCN + PARAMETER( COLLECT_NZ = 35, + * COLLECT_IRN = 36, + * COLLECT_JCN = 37 ) + INTEGER RACINE, + * NOEUD, + * TERREUR, + * MAITRE_DESC_BANDE, + * MAITRE2, + * BLOC_FACTO, + * CONTRIB_TYPE2, + * MAPLIG, + * FACTOR + PARAMETER ( RACINE = 2, + * NOEUD = 3, + * MAITRE_DESC_BANDE = 4, + * MAITRE2 = 5, + * BLOC_FACTO = 6, + * CONTRIB_TYPE2 = 7, + * MAPLIG = 8, + * FACTOR = 9, + * TERREUR = 99 ) + INTEGER ROOT_NELIM_INDICES, + * ROOT_CONT_STATIC, + * ROOT_NON_ELIM_CB, + * ROOT_2SLAVE, + * ROOT_2SON + PARAMETER( ROOT_NELIM_INDICES = 15, + * ROOT_CONT_STATIC = 16, + * ROOT_NON_ELIM_CB = 17, + * ROOT_2SLAVE = 18, + * ROOT_2SON = 19 ) + INTEGER RACINE_SOLVE, + * ContVec, + * Master2Slave, + * GatherSol, + * ScatterRhsI, + * ScatterRhsR + PARAMETER( RACINE_SOLVE = 10, + * ContVec = 11, + * Master2Slave = 12, + * GatherSol = 13, + * ScatterRhsI = 54, + * ScatterRhsR = 55) + INTEGER FEUILLE, + * BACKSLV_UPDATERHS, + * BACKSLV_MASTER2SLAVE + PARAMETER( FEUILLE = 21, + * BACKSLV_UPDATERHS = 22, + * BACKSLV_MASTER2SLAVE = 23 ) + INTEGER SYMMETRIZE + PARAMETER ( SYMMETRIZE = 24 ) + INTEGER BLOC_FACTO_SYM, + * BLOC_FACTO_SYM_SLAVE, END_NIV2_LDLT, + * END_NIV2 + PARAMETER ( BLOC_FACTO_SYM = 25, + * BLOC_FACTO_SYM_SLAVE = 26, + * END_NIV2_LDLT = 33, + * END_NIV2 = 34 ) + INTEGER UPDATE_LOAD + PARAMETER ( UPDATE_LOAD = 27 ) + INTEGER DEFIC_TAG + PARAMETER( DEFIC_TAG = 28 ) + INTEGER TAG_SCHUR + PARAMETER( TAG_SCHUR = 38 ) + INTEGER TAG_DUMMY + PARAMETER( TAG_DUMMY = 39 ) + INTEGER ZERO_PIV + PARAMETER( ZERO_PIV = 40 ) diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_comm_buffer.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_comm_buffer.F new file mode 100644 index 000000000..a747d5cb5 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_comm_buffer.F @@ -0,0 +1,2718 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE SMUMPS_COMM_BUFFER + PRIVATE + PUBLIC :: SMUMPS_61, SMUMPS_528, + & SMUMPS_53 , SMUMPS_57 , + & SMUMPS_55, SMUMPS_59, + & SMUMPS_54,SMUMPS_58, + & SMUMPS_66, SMUMPS_78, + & SMUMPS_62, SMUMPS_68, + & SMUMPS_71, SMUMPS_70, + & SMUMPS_67, + & SMUMPS_65, SMUMPS_64, + & SMUMPS_72, + & SMUMPS_648, SMUMPS_76, + & SMUMPS_73, SMUMPS_74, + & SMUMPS_63,SMUMPS_77, + & SMUMPS_60, + & SMUMPS_524, SMUMPS_469, + & SMUMPS_460, SMUMPS_502, + & SMUMPS_519 ,SMUMPS_620 + & ,SMUMPS_617 + INTEGER NEXT, REQ, CONTENT, OVHSIZE + PARAMETER( NEXT = 0, REQ = 1, CONTENT = 2, OVHSIZE = 2 ) + INTEGER, SAVE :: SIZEofINT, SIZEofREAL, BUF_MYID + TYPE SMUMPS_COMM_BUFFER_TYPE + INTEGER LBUF, HEAD, TAIL,LBUF_INT, ILASTMSG + INTEGER, DIMENSION(:),POINTER :: CONTENT + END TYPE SMUMPS_COMM_BUFFER_TYPE + TYPE ( SMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_CB + TYPE ( SMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_SMALL + TYPE ( SMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_LOAD + INTEGER, SAVE :: SIZE_RBUF_BYTES + INTEGER BUF_LMAX_ARRAY + REAL, DIMENSION(:), ALLOCATABLE :: BUF_MAX_ARRAY + PUBLIC :: BUF_LMAX_ARRAY, BUF_MAX_ARRAY + CONTAINS + SUBROUTINE SMUMPS_528( MYID ) + IMPLICIT NONE + INTEGER MYID + BUF_MYID = MYID + RETURN + END SUBROUTINE SMUMPS_528 + SUBROUTINE SMUMPS_61( IntSize, RealSize ) + IMPLICIT NONE + INTEGER IntSize, RealSize + SIZEofINT = IntSize + SIZEofREAL = RealSize + NULLIFY(BUF_CB %CONTENT) + NULLIFY(BUF_SMALL%CONTENT) + NULLIFY(BUF_LOAD%CONTENT) + BUF_CB%LBUF = 0 + BUF_CB%LBUF_INT = 0 + BUF_CB%HEAD = 1 + BUF_CB%TAIL = 1 + BUF_CB%ILASTMSG = 1 + BUF_SMALL%LBUF = 0 + BUF_SMALL%LBUF_INT = 0 + BUF_SMALL%HEAD = 1 + BUF_SMALL%TAIL = 1 + BUF_SMALL%ILASTMSG = 1 + BUF_LOAD%LBUF = 0 + BUF_LOAD%LBUF_INT = 0 + BUF_LOAD%HEAD = 1 + BUF_LOAD%TAIL = 1 + BUF_LOAD%ILASTMSG = 1 + RETURN + END SUBROUTINE SMUMPS_61 + SUBROUTINE SMUMPS_53( SIZE, IERR ) + IMPLICIT NONE + INTEGER SIZE, IERR + CALL SMUMPS_2( BUF_CB, SIZE, IERR ) + RETURN + END SUBROUTINE SMUMPS_53 + SUBROUTINE SMUMPS_55( SIZE, IERR ) + IMPLICIT NONE + INTEGER SIZE, IERR + CALL SMUMPS_2( BUF_SMALL, SIZE, IERR ) + RETURN + END SUBROUTINE SMUMPS_55 + SUBROUTINE SMUMPS_54( SIZE, IERR ) + IMPLICIT NONE + INTEGER SIZE, IERR + CALL SMUMPS_2( BUF_LOAD, SIZE, IERR ) + RETURN + END SUBROUTINE SMUMPS_54 + SUBROUTINE SMUMPS_58( IERR ) + IMPLICIT NONE + INTEGER IERR + CALL SMUMPS_3( BUF_LOAD, IERR ) + RETURN + END SUBROUTINE SMUMPS_58 + SUBROUTINE SMUMPS_620() + IMPLICIT NONE + IF (allocated( BUF_MAX_ARRAY)) DEALLOCATE( BUF_MAX_ARRAY ) + RETURN + END SUBROUTINE SMUMPS_620 + SUBROUTINE SMUMPS_617(NFS4FATHER,IERR) + IMPLICIT NONE + INTEGER IERR, NFS4FATHER + IERR = 0 + IF (allocated( BUF_MAX_ARRAY)) THEN + IF (BUF_LMAX_ARRAY .GE. NFS4FATHER) RETURN + DEALLOCATE( BUF_MAX_ARRAY ) + ENDIF + ALLOCATE(BUF_MAX_ARRAY(NFS4FATHER),stat=IERR) + BUF_LMAX_ARRAY=NFS4FATHER + RETURN + END SUBROUTINE SMUMPS_617 + SUBROUTINE SMUMPS_57( IERR ) + IMPLICIT NONE + INTEGER IERR + CALL SMUMPS_3( BUF_CB, IERR ) + RETURN + END SUBROUTINE SMUMPS_57 + SUBROUTINE SMUMPS_59( IERR ) + IMPLICIT NONE + INTEGER IERR + CALL SMUMPS_3( BUF_SMALL, IERR ) + RETURN + END SUBROUTINE SMUMPS_59 + SUBROUTINE SMUMPS_2( BUF, SIZE, IERR ) + IMPLICIT NONE + TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: BUF + INTEGER SIZE, IERR + IERR = 0 + BUF%LBUF = SIZE + BUF%LBUF_INT = ( SIZE + SIZEofINT - 1 ) / SIZEofINT + IF ( associated ( BUF%CONTENT ) ) DEALLOCATE( BUF%CONTENT ) + ALLOCATE( BUF%CONTENT( BUF%LBUF_INT ), stat = IERR ) + IF (IERR .NE. 0) THEN + NULLIFY( BUF%CONTENT ) + IERR = -1 + BUF%LBUF = 0 + BUF%LBUF_INT = 0 + END IF + BUF%HEAD = 1 + BUF%TAIL = 1 + BUF%ILASTMSG = 1 + RETURN + END SUBROUTINE SMUMPS_2 + SUBROUTINE SMUMPS_3( BUF, IERR ) + IMPLICIT NONE + TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: BUF + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG + IF ( .NOT. associated ( BUF%CONTENT ) ) THEN + BUF%HEAD = 1 + BUF%LBUF = 0 + BUF%LBUF_INT = 0 + BUF%TAIL = 1 + BUF%ILASTMSG = 1 + RETURN + END IF + DO WHILE ( BUF%HEAD.NE.0 .AND. BUF%HEAD .NE. BUF%TAIL ) + CALL MPI_TEST(BUF%CONTENT( BUF%HEAD + REQ ), FLAG, + & STATUS, IERR) + IF ( .not. FLAG ) THEN + WRITE(*,*) '** Warning: trying to cancel a request.' + WRITE(*,*) '** This might be problematic on SGI' + CALL MPI_CANCEL( BUF%CONTENT( BUF%HEAD + REQ ), IERR ) + CALL MPI_REQUEST_FREE( BUF%CONTENT( BUF%HEAD + REQ ), IERR ) + END IF + BUF%HEAD = BUF%CONTENT( BUF%HEAD + NEXT ) + END DO + DEALLOCATE( BUF%CONTENT ) + NULLIFY( BUF%CONTENT ) + BUF%LBUF = 0 + BUF%LBUF_INT = 0 + BUF%HEAD = 1 + BUF%TAIL = 1 + BUF%ILASTMSG = 1 + RETURN + END SUBROUTINE SMUMPS_3 + SUBROUTINE SMUMPS_66( NBROWS_ALREADY_SENT, + & INODE, FPERE, NFRONT, LCONT, + & NASS, NPIV, + & IWROW, IWCOL, A, COMPRESSCB, + & DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INTEGER DEST, TAG, COMM, IERR + INTEGER NBROWS_ALREADY_SENT + INTEGER INODE, FPERE, NFRONT, LCONT, NASS, NPIV + INTEGER IWROW( LCONT ), IWCOL( LCONT ) + REAL A( * ) + LOGICAL COMPRESSCB + INCLUDE 'mpif.h' + INTEGER NBROWS_PACKET + INTEGER POSITION, IREQ, IPOS, I, J1 + INTEGER SIZE1, SIZE2, SIZE_PACK, SIZE_AV, SIZE_AV_REALS + INTEGER IZERO, IONE + INTEGER SIZECB + INTEGER LCONT_SENT + INTEGER DEST2(1) + PARAMETER( IZERO = 0, IONE = 1 ) + LOGICAL RECV_BUF_SMALLER_THAN_SEND + DOUBLE PRECISION TMP + DEST2(1) = DEST + IERR = 0 + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + CALL MPI_PACK_SIZE( 11 + LCONT + LCONT, MPI_INTEGER, + & COMM, SIZE1, IERR) + ELSE + CALL MPI_PACK_SIZE( 5, MPI_INTEGER, COMM, SIZE1, IERR) + ENDIF + CALL SMUMPS_79( BUF_CB, SIZE_AV ) + IF ( SIZE_AV .LT. SIZE_RBUF_BYTES ) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + SIZE_AV = SIZE_RBUF_BYTES + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + ENDIF + SIZE_AV_REALS = ( SIZE_AV - SIZE1 ) / SIZEofREAL + IF (SIZE_AV_REALS < 0 ) THEN + NBROWS_PACKET = 0 + ELSE + IF (COMPRESSCB) THEN + TMP=2.0D0*dble(NBROWS_ALREADY_SENT)+1.0D0 + NBROWS_PACKET = int( + & ( sqrt( TMP * TMP + & + 8.0D0 * dble(SIZE_AV_REALS)) - TMP ) + & / 2.0D0 ) + ELSE + NBROWS_PACKET = SIZE_AV_REALS / LCONT + ENDIF + ENDIF + 10 CONTINUE + NBROWS_PACKET = max(0, + & min(NBROWS_PACKET, LCONT - NBROWS_ALREADY_SENT)) + IF (NBROWS_PACKET .EQ. 0 .AND. LCONT .NE. 0) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + IF (COMPRESSCB) THEN + SIZECB = (NBROWS_ALREADY_SENT*NBROWS_PACKET)+(NBROWS_PACKET + & *(NBROWS_PACKET+1))/2 + ELSE + SIZECB = NBROWS_PACKET * LCONT + ENDIF + CALL MPI_PACK_SIZE( SIZECB, MPI_REAL, + & COMM, SIZE2, IERR ) + SIZE_PACK = SIZE1 + SIZE2 + IF (SIZE_PACK .GT. SIZE_AV ) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF (NBROWS_PACKET > 0) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR=-3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF + IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.LCONT .AND. + & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 + & .AND. + & .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF + CALL SMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE , DEST2 + & ) + IF (IERR .EQ. -1 .OR. IERR .EQ. -2) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF ( NBROWS_PACKET > 0 ) GOTO 10 + ENDIF + IF ( IERR .LT. 0 ) GOTO 100 + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( FPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (COMPRESSCB) THEN + LCONT_SENT=-LCONT + ELSE + LCONT_SENT=LCONT + ENDIF + CALL MPI_PACK( LCONT_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (NBROWS_ALREADY_SENT == 0) THEN + CALL MPI_PACK( LCONT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NASS-NPIV, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( LCONT , 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IZERO, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IONE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IZERO, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IWROW, LCONT, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IWCOL, LCONT, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + IF ( LCONT .NE. 0 ) THEN + J1 = 1 + NBROWS_ALREADY_SENT * NFRONT + IF (COMPRESSCB) THEN + DO I = NBROWS_ALREADY_SENT+1, + & NBROWS_ALREADY_SENT+NBROWS_PACKET + CALL MPI_PACK( A( J1 ), I, MPI_REAL, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + J1 = J1 + NFRONT + END DO + ELSE + DO I = NBROWS_ALREADY_SENT+1, + & NBROWS_ALREADY_SENT+NBROWS_PACKET + CALL MPI_PACK( A( J1 ), LCONT, MPI_REAL, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + J1 = J1 + NFRONT + END DO + ENDIF + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK .LT. POSITION ) THEN + WRITE(*,*) 'Error Try_send_cb: SIZE, POSITION=',SIZE_PACK, + & POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE_PACK .NE. POSITION ) + & CALL SMUMPS_1( BUF_CB, POSITION ) + NBROWS_ALREADY_SENT = NBROWS_ALREADY_SENT + NBROWS_PACKET + IF (NBROWS_ALREADY_SENT .NE. LCONT ) THEN + IERR = -1 + RETURN + ENDIF + 100 CONTINUE + RETURN + END SUBROUTINE SMUMPS_66 + SUBROUTINE SMUMPS_72( NRHS, INODE, IFATH, + & EFF_CB_SIZE, LD_CB, LD_PIV, NPIV, CB, SOL, + & DEST, COMM, IERR ) + IMPLICIT NONE + INTEGER NRHS, INODE, IFATH, EFF_CB_SIZE, LD_CB, LD_PIV, NPIV + INTEGER DEST, COMM, IERR + REAL CB( LD_CB*(NRHS-1)+EFF_CB_SIZE ) + REAL SOL( max(1, LD_PIV*(NRHS-1)+NPIV) ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE, SIZE1, SIZE2, K + INTEGER POSITION, IREQ, IPOS + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1) = DEST + IERR = 0 + CALL MPI_PACK_SIZE( 4, MPI_INTEGER, COMM, SIZE1, IERR ) + CALL MPI_PACK_SIZE( NRHS * (EFF_CB_SIZE + NPIV), + & MPI_REAL, COMM, + & SIZE2, IERR ) + SIZE = SIZE1 + SIZE2 + CALL SMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IFATH, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( EFF_CB_SIZE , 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NPIV , 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + DO K = 1, NRHS + CALL MPI_PACK( CB ( 1 + LD_CB * (K-1) ), + & EFF_CB_SIZE, MPI_REAL, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + END DO + IF ( NPIV .GT. 0 ) THEN + DO K=1, NRHS + CALL MPI_PACK( SOL(1+LD_PIV*(K-1)), + & NPIV, MPI_REAL, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + ENDDO + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, Master2Slave, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE .LT. POSITION ) THEN + WRITE(*,*) 'Try_send_master2slave: SIZE, POSITION = ', + & SIZE, POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE .NE. POSITION ) CALL SMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE SMUMPS_72 + SUBROUTINE SMUMPS_78( NRHS, NODE1, NODE2, NCB, LDW, + & LONG, + & IW, W, + & DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INTEGER LDW, DEST, TAG, COMM, IERR + INTEGER NRHS, NODE1, NODE2, NCB, LONG + INTEGER IW( max( 1, LONG ) ) + REAL W( max( 1, LDW * NRHS ) ) + INCLUDE 'mpif.h' + INTEGER POSITION, IREQ, IPOS + INTEGER SIZE1, SIZE2, SIZE, K + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1)=DEST + IERR = 0 + IF ( NODE2 .EQ. 0 ) THEN + CALL MPI_PACK_SIZE( 2+LONG, MPI_INTEGER, COMM, SIZE1, IERR ) + ELSE + CALL MPI_PACK_SIZE( 4+LONG, MPI_INTEGER, COMM, SIZE1, IERR ) + END IF + SIZE2 = 0 + IF ( LONG .GT. 0 ) THEN + CALL MPI_PACK_SIZE( NRHS*LONG, MPI_REAL, + & COMM, SIZE2, IERR ) + END IF + SIZE = SIZE1 + SIZE2 + CALL SMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + POSITION = 0 + CALL MPI_PACK( NODE1, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + IF ( NODE2 .NE. 0 ) THEN + CALL MPI_PACK( NODE2, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NCB, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + END IF + CALL MPI_PACK( LONG, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + IF ( LONG .GT. 0 ) THEN + CALL MPI_PACK( IW, LONG, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + DO K=1, NRHS + CALL MPI_PACK( W(1+(K-1)*LDW), LONG, MPI_REAL, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + END DO + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE .NE. POSITION ) CALL SMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE SMUMPS_78 + SUBROUTINE SMUMPS_62( I, DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INTEGER I + INTEGER DEST, TAG, COMM, IERR + INCLUDE 'mpif.h' + INTEGER IPOS, IREQ, MSG_SIZE, POSITION + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1)=DEST + IERR = 0 + CALL MPI_PACK_SIZE( 1, MPI_INTEGER, + & COMM, MSG_SIZE, IERR ) + CALL SMUMPS_4( BUF_SMALL, IPOS, IREQ, MSG_SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + write(6,*) ' Internal error in SMUMPS_62', + & ' Buf size (bytes)= ',BUF_SMALL%LBUF + RETURN + ENDIF + POSITION=0 + CALL MPI_PACK( I, 1, + & MPI_INTEGER, BUF_SMALL%CONTENT( IPOS ), + & MSG_SIZE, + & POSITION, COMM, IERR ) + CALL MPI_ISEND( BUF_SMALL%CONTENT(IPOS), MSG_SIZE, + & MPI_PACKED, DEST, TAG, COMM, + & BUF_SMALL%CONTENT( IREQ ), IERR ) + RETURN + END SUBROUTINE SMUMPS_62 + SUBROUTINE SMUMPS_469(FLAG) + LOGICAL FLAG + LOGICAL FLAG1, FLAG2, FLAG3 + CALL SMUMPS_468( BUF_SMALL, FLAG1 ) + CALL SMUMPS_468( BUF_CB, FLAG2 ) + CALL SMUMPS_468( BUF_LOAD, FLAG3 ) + FLAG = FLAG1 .AND. FLAG2 .AND. FLAG3 + RETURN + END SUBROUTINE SMUMPS_469 + SUBROUTINE SMUMPS_468( B, FLAG ) + TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: B + LOGICAL :: FLAG + INTEGER SIZE_AVAIL + CALL SMUMPS_79(B, SIZE_AVAIL) + FLAG = ( B%HEAD == B%TAIL ) + RETURN + END SUBROUTINE SMUMPS_468 + SUBROUTINE SMUMPS_79( B, SIZE_AV ) + IMPLICIT NONE + TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: B + INTEGER SIZE_AV + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG + IF ( B%HEAD .NE. B%TAIL ) THEN + 10 CONTINUE + CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + B%HEAD = B%CONTENT( B%HEAD + NEXT ) + IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL + IF ( B%HEAD .NE. B%TAIL ) GOTO 10 + END IF + END IF + IF ( B%HEAD .EQ. B%TAIL ) THEN + B%HEAD = 1 + B%TAIL = 1 + B%ILASTMSG = 1 + END IF + IF ( B%HEAD .LE. B%TAIL ) THEN + SIZE_AV = max( B%LBUF_INT - B%TAIL, B%HEAD - 2 ) + ELSE + SIZE_AV = B%HEAD - B%TAIL - 1 + END IF + SIZE_AV = min(SIZE_AV - OVHSIZE, SIZE_AV) + SIZE_AV = SIZE_AV * SIZEofINT + RETURN + END SUBROUTINE SMUMPS_79 + SUBROUTINE SMUMPS_4( B, IPOS, IREQ, MSG_SIZE, IERR, + & NDEST , PDEST + & ) + IMPLICIT NONE + TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: B + INTEGER, INTENT(IN) :: MSG_SIZE + INTEGER, INTENT(OUT) :: IPOS, IREQ, IERR + INTEGER NDEST + INTEGER, INTENT(IN) :: PDEST(max(1,NDEST)) + INCLUDE 'mpif.h' + INTEGER MSG_SIZE_INT + INTEGER IBUF + LOGICAL FLAG + INTEGER STATUS( MPI_STATUS_SIZE ) + IERR = 0 + IF ( B%HEAD .NE. B%TAIL ) THEN + 10 CONTINUE + CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + B%HEAD = B%CONTENT( B%HEAD + NEXT ) + IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL + IF ( B%HEAD .NE. B%TAIL ) GOTO 10 + END IF + END IF + IF ( B%HEAD .EQ. B%TAIL ) THEN + B%HEAD = 1 + B%TAIL = 1 + B%ILASTMSG = 1 + END iF + MSG_SIZE_INT = ( MSG_SIZE + ( SIZEofINT - 1 ) ) / SIZEofINT + MSG_SIZE_INT = MSG_SIZE_INT + OVHSIZE + FLAG = ( ( B%HEAD .LE. B%TAIL ) + & .AND. ( + & ( MSG_SIZE_INT .LE. B%LBUF_INT - B%TAIL ) + & .OR. ( MSG_SIZE_INT .LE. B%HEAD - 2 ) ) ) + & .OR. + & ( ( B%HEAD .GT. B%TAIL ) + & .AND. ( MSG_SIZE_INT .LE. B%HEAD - B%TAIL - 1 ) ) + IF ( .NOT. FLAG + & ) THEN + IERR = -1 + IF ( MSG_SIZE_INT .GT. B%LBUF_INT - 1 ) then + IERR = -2 + ENDIF + IPOS = -1 + IREQ = -1 + RETURN + END IF + IF ( B%HEAD .LE. B%TAIL ) THEN + IF ( MSG_SIZE_INT .LE. B%LBUF_INT - B%TAIL + 1 ) THEN + IBUF = B%TAIL + ELSE IF ( MSG_SIZE_INT .LE. B%HEAD - 1 ) THEN + IBUF = 1 + END IF + ELSE + IBUF = B%TAIL + END IF + B%CONTENT( B%ILASTMSG + NEXT ) = IBUF + B%ILASTMSG = IBUF + B%TAIL = IBUF + MSG_SIZE_INT + B%CONTENT( IBUF + NEXT ) = 0 + IPOS = IBUF + CONTENT + IREQ = IBUF + REQ + RETURN + END SUBROUTINE SMUMPS_4 + SUBROUTINE SMUMPS_1( BUF, SIZE ) + IMPLICIT NONE + TYPE ( SMUMPS_COMM_BUFFER_TYPE ) :: BUF + INTEGER SIZE + INTEGER SIZE_INT + SIZE_INT = ( SIZE + SIZEofINT - 1 ) / SIZEofINT + SIZE_INT = SIZE_INT + OVHSIZE + BUF%TAIL = BUF%ILASTMSG + SIZE_INT + RETURN + END SUBROUTINE SMUMPS_1 + SUBROUTINE SMUMPS_68( + & INODE, NBPROCFILS, NLIG, ILIG, NCOL, ICOL, + & NASS, NSLAVES, LIST_SLAVES, + & DEST, NFRONT, COMM, IERR ) + IMPLICIT NONE + INTEGER COMM, IERR, NFRONT + INTEGER INODE + INTEGER NLIG, NCOL, NASS, NSLAVES + INTEGER NBPROCFILS, DEST + INTEGER ILIG( NLIG ) + INTEGER ICOL( NCOL ) + INTEGER LIST_SLAVES( NSLAVES ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE, POSITION, IPOS, IREQ + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1) = DEST + IERR = 0 + SIZE = ( 6 + NLIG + NCOL + NSLAVES + 1 ) * SIZEofINT + IF (SIZE.GT.SIZE_RBUF_BYTES ) THEN + IERR = -2 + RETURN + END IF + CALL SMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + POSITION = IPOS + BUF_CB%CONTENT( POSITION ) = INODE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NBPROCFILS + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NLIG + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NCOL + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NASS + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFRONT + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NSLAVES + POSITION = POSITION + 1 + IF (NSLAVES.GT.0) THEN + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) = + & LIST_SLAVES( 1: NSLAVES ) + POSITION = POSITION + NSLAVES + ENDIF + BUF_CB%CONTENT( POSITION:POSITION + NLIG - 1 ) = ILIG + POSITION = POSITION + NLIG + BUF_CB%CONTENT( POSITION:POSITION + NCOL - 1 ) = ICOL + POSITION = POSITION + NCOL + POSITION = POSITION - IPOS + IF ( POSITION * SIZEofINT .NE. SIZE ) THEN + WRITE(*,*) 'Error in SMUMPS_68 :', + & ' wrong estimated size' + CALL MUMPS_ABORT() + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, MPI_PACKED, + & DEST, MAITRE_DESC_BANDE, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + RETURN + END SUBROUTINE SMUMPS_68 + SUBROUTINE SMUMPS_70( NBROWS_ALREADY_SENT, + & IPERE, ISON, NROW, + & IROW, NCOL, ICOL, VAL, LDA, NELIM, TYPE_SON, + & NSLAVES, SLAVES, DEST, COMM, IERR, + & + & SLAVEF, KEEP,KEEP8, INIV2, TAB_POS_IN_PERE ) + IMPLICIT NONE + INTEGER NBROWS_ALREADY_SENT + INTEGER LDA, NELIM, TYPE_SON + INTEGER IPERE, ISON, NROW, NCOL, NSLAVES + INTEGER IROW( NROW ) + INTEGER ICOL( NCOL ) + INTEGER SLAVES( NSLAVES ) + REAL VAL(LDA, *) + INTEGER IPOS, IREQ, DEST, COMM, IERR + INTEGER SLAVEF, KEEP(500), INIV2 + INTEGER(8) KEEP8(150) + INTEGER TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE1, SIZE2, SIZE3, SIZE_PACK, POSITION, I + INTEGER NBROWS_PACKET, NCOL_SEND + INTEGER SIZE_AV + LOGICAL RECV_BUF_SMALLER_THAN_SEND + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1) = DEST + IERR = 0 + IF ( NELIM .NE. NROW ) THEN + WRITE(*,*) 'Error in TRY_SEND_MAITRE2:',NELIM, NROW + CALL MUMPS_ABORT() + END IF + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + CALL MPI_PACK_SIZE( NROW+NCOL+7+NSLAVES, MPI_INTEGER, + & COMM, SIZE1, IERR ) + IF ( ( KEEP(48).NE. 0 ).AND.(TYPE_SON .eq. 2 )) THEN + CALL MPI_PACK_SIZE( NSLAVES+1, MPI_INTEGER, + & COMM, SIZE3, IERR ) + ELSE + SIZE3 = 0 + ENDIF + SIZE1=SIZE1+SIZE3 + ELSE + CALL MPI_PACK_SIZE(7, MPI_INTEGER,COMM,SIZE1,IERR) + ENDIF + IF ( KEEP(50).ne.0 .AND. TYPE_SON .eq. 2 ) THEN + NCOL_SEND = NROW + ELSE + NCOL_SEND = NCOL + ENDIF + CALL SMUMPS_79( BUF_CB, SIZE_AV ) + IF (SIZE_AV .LT. SIZE_RBUF_BYTES) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + SIZE_AV = SIZE_RBUF_BYTES + ENDIF + IF (NROW .GT. 0 ) THEN + NBROWS_PACKET = (SIZE_AV - SIZE1) / NCOL_SEND / SIZEofREAL + NBROWS_PACKET = min(NBROWS_PACKET, NROW - NBROWS_ALREADY_SENT) + NBROWS_PACKET = max(NBROWS_PACKET, 0) + ELSE + NBROWS_PACKET =0 + ENDIF + IF (NBROWS_PACKET .EQ. 0 .AND. NROW .NE. 0) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR=-3 + GOTO 100 + ELSE + IERR=-1 + GOTO 100 + ENDIF + ENDIF + 10 CONTINUE + CALL MPI_PACK_SIZE( NBROWS_PACKET * NCOL_SEND, + & MPI_REAL, + & COMM, SIZE2, IERR ) + SIZE_PACK = SIZE1 + SIZE2 + IF (SIZE_PACK .GT. SIZE_AV) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF ( NBROWS_PACKET .GT. 0 ) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF + IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.NROW .AND. + & SIZE_PACK - SIZE1 .LT. ( SIZE_RBUF_BYTES - SIZE1 ) / 2 + & .AND. + & .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF + CALL SMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + GOTO 100 + ENDIF + POSITION = 0 + CALL MPI_PACK( IPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( ISON, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NSLAVES, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NCOL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + IF (NSLAVES.GT.0) THEN + CALL MPI_PACK( SLAVES, NSLAVES, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + CALL MPI_PACK( IROW, NROW, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( ICOL, NCOL, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF ( ( KEEP(48).NE. 0 ).AND.(TYPE_SON .eq. 2 ) ) THEN + CALL MPI_PACK( TAB_POS_IN_PERE(1,INIV2), NSLAVES+1, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + ENDIF + IF (NBROWS_PACKET.GE.1) THEN + DO I=NBROWS_ALREADY_SENT+1, + & NBROWS_ALREADY_SENT+NBROWS_PACKET + CALL MPI_PACK( VAL(1,I), NCOL_SEND, + & MPI_REAL, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDDO + ENDIF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, MAITRE2, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK .LT. POSITION ) THEN + write(*,*) 'Try_send_maitre2, SIZE,POSITION=', + & SIZE_PACK,POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE_PACK .NE. POSITION ) + & CALL SMUMPS_1( BUF_CB, POSITION ) + NBROWS_ALREADY_SENT = NBROWS_ALREADY_SENT + NBROWS_PACKET + IF ( NBROWS_ALREADY_SENT .NE. NROW ) THEN + IERR = -1 + ENDIF + 100 CONTINUE + RETURN + END SUBROUTINE SMUMPS_70 + SUBROUTINE SMUMPS_67(NBROWS_ALREADY_SENT, + & DESC_IN_LU, + & IPERE, NFRONT_PERE, NASS_PERE, NFS4FATHER, + & NSLAVES_PERE, + & ISON, NBROW, LMAP, MAPROW, PERM, IW_CBSON, A_CBSON, + & ISLAVE, PDEST, PDEST_MASTER, COMM, IERR, + & + & KEEP,KEEP8, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & COMPRESSCB, KEEP253_LOC ) + IMPLICIT NONE + INTEGER NBROWS_ALREADY_SENT + INTEGER, INTENT (in) :: KEEP253_LOC + INTEGER IPERE, ISON, NBROW + INTEGER PDEST, ISLAVE, COMM, IERR + INTEGER PDEST_MASTER, NASS_PERE, NSLAVES_PERE, + & NFRONT_PERE, LMAP + INTEGER MAPROW( LMAP ), PERM( max(1, NBROW )) + INTEGER IW_CBSON( * ) + REAL A_CBSON( * ) + LOGICAL DESC_IN_LU, COMPRESSCB + INTEGER KEEP(500), N , SLAVEF + INTEGER(8) KEEP8(150) + INTEGER STEP(N), + & ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NFS4FATHER,SIZE3,PS1,NCA,LROW1 + INTEGER(8) :: ASIZE + LOGICAL COMPUTE_MAX + INTEGER NBROWS_PACKET + INTEGER MAX_ROW_LENGTH + INTEGER LROW, NELIM + INTEGER(8) :: SIZFR, ITMP8 + INTEGER NPIV, NFRONT, HS + INTEGER SIZE_PACK, SIZE1, SIZE2, POSITION,I + INTEGER SIZE_INTEGERS, B, SIZE_REALS, TMPSIZE, ONEorTWO, SIZE_AV + INTEGER NBINT, L + INTEGER(8) :: APOS, SHIFTCB_SON, LDA_SON8 + INTEGER IPOS_IN_SLAVE + INTEGER STATE_SON + INTEGER INDICE_PERE, NROW, IPOS, IREQ, NOSLA + INTEGER IONE, J, THIS_ROW_LENGTH + INTEGER SIZE_DESC_BANDE, DESC_BANDE_BYTES + LOGICAL RECV_BUF_SMALLER_THAN_SEND + LOGICAL NOT_ENOUGH_SPACE + INTEGER PDEST2(1) + PARAMETER ( IONE=1 ) + INCLUDE 'mumps_headers.h' + REAL ZERO + PARAMETER (ZERO = 0.0E0) + COMPUTE_MAX = (KEEP(219) .NE. 0) .AND. + & (KEEP(50) .EQ. 2) .AND. + & (PDEST.EQ.PDEST_MASTER) + IF (NBROWS_ALREADY_SENT == 0) THEN + IF (COMPUTE_MAX) THEN + CALL SMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE. 0) THEN + IERR = -4 + RETURN + ENDIF + ENDIF + ENDIF + PDEST2(1) = PDEST + IERR = 0 + LROW = IW_CBSON( 1 + KEEP(IXSZ)) + NELIM = IW_CBSON( 2 + KEEP(IXSZ)) + NPIV = IW_CBSON( 4 + KEEP(IXSZ)) + IF ( NPIV .LT. 0 ) THEN + NPIV = 0 + END IF + NROW = IW_CBSON( 3 + KEEP(IXSZ)) + NFRONT = LROW + NPIV + HS = 6 + IW_CBSON( 6 + KEEP(IXSZ)) + KEEP(IXSZ) + CALL MUMPS_729( SIZFR, IW_CBSON( 1 + XXR ) ) + STATE_SON = IW_CBSON(1+XXS) + IF (STATE_SON .EQ. S_NOLCBCONTIG) THEN + LDA_SON8 = int(LROW,8) + SHIFTCB_SON = int(NPIV,8)*int(NROW,8) + ELSE IF (STATE_SON .EQ. S_NOLCLEANED) THEN + LDA_SON8 = int(LROW,8) + SHIFTCB_SON = 0_8 + ELSE + LDA_SON8 = int(NFRONT,8) + SHIFTCB_SON = int(NPIV,8) + ENDIF + CALL SMUMPS_79( BUF_CB, SIZE_AV ) + IF (PDEST .EQ. PDEST_MASTER) THEN + SIZE_DESC_BANDE=0 + ELSE + SIZE_DESC_BANDE=(7+SLAVEF+KEEP(127)*2) + SIZE_DESC_BANDE=SIZE_DESC_BANDE+int(real(KEEP(12))* + & real(SIZE_DESC_BANDE)/100.0E0) + SIZE_DESC_BANDE=max(SIZE_DESC_BANDE, + & 7+NSLAVES_PERE+NFRONT_PERE+NFRONT_PERE-NASS_PERE) + ENDIF + DESC_BANDE_BYTES=SIZE_DESC_BANDE*SIZEofINT + IF ( SIZE_AV .LT. SIZE_RBUF_BYTES-DESC_BANDE_BYTES ) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + SIZE_AV = SIZE_RBUF_BYTES-DESC_BANDE_BYTES + ENDIF + SIZE1=0 + IF (NBROWS_ALREADY_SENT==0) THEN + IF(COMPUTE_MAX) THEN + CALL MPI_PACK_SIZE(1, MPI_INTEGER, + & COMM, PS1, IERR ) + IF(NFS4FATHER .GT. 0) THEN + CALL MPI_PACK_SIZE( NFS4FATHER, MPI_REAL, + & COMM, SIZE1, IERR ) + ENDIF + SIZE1 = SIZE1+PS1 + ENDIF + ENDIF + IF (KEEP(50) .EQ. 0) THEN + ONEorTWO = 1 + ELSE + ONEorTWO = 2 + ENDIF + IF (PDEST .EQ.PDEST_MASTER) THEN + L = 0 + ELSE IF (KEEP(50) .EQ. 0) THEN + L = LROW + ELSE + L = LROW + PERM(1) - LMAP + NBROWS_ALREADY_SENT - 1 + ONEorTWO=ONEorTWO+1 + ENDIF + NBINT = 6 + L + CALL MPI_PACK_SIZE( NBINT, MPI_INTEGER, + & COMM, TMPSIZE, IERR ) + SIZE1 = SIZE1 + TMPSIZE + SIZE_AV = SIZE_AV - SIZE1 + NOT_ENOUGH_SPACE=.FALSE. + IF (SIZE_AV .LT.0 ) THEN + NBROWS_PACKET = 0 + NOT_ENOUGH_SPACE=.TRUE. + ELSE + IF ( KEEP(50) .EQ. 0 ) THEN + NBROWS_PACKET = + & SIZE_AV / ( ONEorTWO*SIZEofINT+LROW*SIZEofREAL) + ELSE + B = 2 * ONEorTWO + + & ( 1 + 2 * LROW + 2 * PERM(1) + 2 * NBROWS_ALREADY_SENT ) + & * SIZEofREAL / SIZEofINT + NBROWS_PACKET=int((dble(-B)+sqrt((dble(B)*dble(B))+ + & dble(4)*dble(2*SIZE_AV)/dble(SIZEofINT) * + & dble(SIZEofREAL/SIZEofINT)))* + & dble(SIZEofINT) / dble(2) / dble(SIZEofREAL)) + ENDIF + ENDIF + 10 CONTINUE + NBROWS_PACKET = max( 0, + & min( NBROWS_PACKET, NBROW - NBROWS_ALREADY_SENT)) + NOT_ENOUGH_SPACE = NOT_ENOUGH_SPACE .OR. + & (NBROWS_PACKET .EQ.0.AND. NBROW.NE.0) + IF (NOT_ENOUGH_SPACE) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + IF (KEEP(50).EQ.0) THEN + MAX_ROW_LENGTH = -99999 + SIZE_REALS = NBROWS_PACKET * LROW + ELSE + SIZE_REALS = ( LROW + PERM(1) + NBROWS_ALREADY_SENT ) * + & NBROWS_PACKET + ( NBROWS_PACKET * ( NBROWS_PACKET + 1) ) / 2 + MAX_ROW_LENGTH = LROW+PERM(1)-LMAP+NBROWS_ALREADY_SENT + & + NBROWS_PACKET-1 + ENDIF + SIZE_INTEGERS = ONEorTWO* NBROWS_PACKET + CALL MPI_PACK_SIZE( SIZE_REALS, MPI_REAL, + & COMM, SIZE2, IERR) + CALL MPI_PACK_SIZE( SIZE_INTEGERS, MPI_INTEGER, + & COMM, SIZE3, IERR) + IF (SIZE2 + SIZE3 .GT. SIZE_AV ) THEN + NBROWS_PACKET = NBROWS_PACKET -1 + IF (NBROWS_PACKET .GT. 0 ) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF + SIZE_PACK = SIZE1 + SIZE2 + SIZE3 +#if ! defined(DBG_SMB3) + IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.NBROW .AND. + & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 .AND. + & .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF +#endif + CALL SMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE , PDEST2 + & ) + IF (IERR .EQ. -1 .OR. IERR.EQ. -2) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF (NBROWS_PACKET > 0 ) GOTO 10 + ENDIF + IF ( IERR .LT. 0 ) GOTO 100 + IF (SIZE_PACK.GT.SIZE_RBUF_BYTES ) THEN + IERR = -3 + GOTO 100 + ENDIF + POSITION = 0 + CALL MPI_PACK( IPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( ISON, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (KEEP(50)==0) THEN + CALL MPI_PACK( LROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ELSE + CALL MPI_PACK( MAX_ROW_LENGTH, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF ( PDEST .NE. PDEST_MASTER ) THEN + IF (KEEP(50)==0) THEN + CALL MPI_PACK( IW_CBSON( HS + NROW + NPIV + 1 ), LROW, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ELSE + IF (MAX_ROW_LENGTH > 0) THEN + CALL MPI_PACK( IW_CBSON( HS + NROW + NPIV + 1 ), + & MAX_ROW_LENGTH, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + ENDIF + END IF + DO J=NBROWS_ALREADY_SENT+1,NBROWS_ALREADY_SENT+NBROWS_PACKET + I = PERM(J) + INDICE_PERE=MAPROW(I) + CALL MUMPS_47( + & KEEP,KEEP8, IPERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + INDICE_PERE = IPOS_IN_SLAVE + CALL MPI_PACK( INDICE_PERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDDO + DO J=NBROWS_ALREADY_SENT+1,NBROWS_ALREADY_SENT+NBROWS_PACKET + I = PERM(J) + INDICE_PERE=MAPROW(I) + CALL MUMPS_47( + & KEEP,KEEP8, IPERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + IF (KEEP(50).ne.0) THEN + THIS_ROW_LENGTH = LROW + I - LMAP + CALL MPI_PACK( THIS_ROW_LENGTH, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ELSE + THIS_ROW_LENGTH = LROW + ENDIF + IF (DESC_IN_LU) THEN + IF ( COMPRESSCB ) THEN + IF (NELIM.EQ.0) THEN + ITMP8 = int(I,8) + ELSE + ITMP8 = int(NELIM+I,8) + ENDIF + APOS = ITMP8 * (ITMP8-1_8) / 2_8 + 1_8 + ELSE + APOS = int(I+NELIM-1, 8) * int(LROW,8) + 1_8 + ENDIF + ELSE + IF ( COMPRESSCB ) THEN + IF ( LROW .EQ. NROW ) THEN + ITMP8 = int(I,8) + APOS = ITMP8 * (ITMP8-1_8)/2_8 + 1_8 + ELSE + ITMP8 = int(I + LROW - NROW,8) + APOS = ITMP8 * (ITMP8-1_8)/2_8 + 1_8 - + & int(LROW - NROW, 8) * int(LROW-NROW+1,8) / 2_8 + ENDIF + ELSE + APOS = int( I - 1, 8 ) * LDA_SON8 + SHIFTCB_SON + 1_8 + ENDIF + ENDIF + CALL MPI_PACK( A_CBSON( APOS ), THIS_ROW_LENGTH, + & MPI_REAL, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDDO + IF (NBROWS_ALREADY_SENT == 0) THEN + IF (COMPUTE_MAX) THEN + CALL MPI_PACK(NFS4FATHER,1, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF(NFS4FATHER .GT. 0) THEN + BUF_MAX_ARRAY(1:NFS4FATHER) = ZERO + IF(MAPROW(NROW) .GT. NASS_PERE) THEN + DO PS1=1,NROW + IF(MAPROW(PS1).GT.NASS_PERE) EXIT + ENDDO + IF (DESC_IN_LU) THEN + IF (COMPRESSCB) THEN + APOS = int(NELIM+PS1,8) * int(NELIM+PS1-1,8) / + & 2_8 + 1_8 + NCA = -44444 + ASIZE = int(NROW,8) * int(NROW+1,8)/2_8 - + & int(NELIM+PS1,8) * int(NELIM+PS1-1,8)/2_8 + LROW1 = PS1 + NELIM + ELSE + APOS = int(PS1+NELIM-1,8) * int(LROW,8) + 1_8 + NCA = LROW + ASIZE = int(NCA,8) * int(NROW-PS1+1,8) + LROW1 = LROW + ENDIF + ELSE + IF (COMPRESSCB) THEN + IF (NPIV.NE.0) THEN + WRITE(*,*) "Error in PARPIV/SMUMPS_67" + CALL MUMPS_ABORT() + ENDIF + LROW1=LROW-NROW+PS1 + ITMP8 = int(PS1 + LROW - NROW,8) + APOS = ITMP8 * (ITMP8 - 1_8) / 2_8 + 1_8 - + & int(LROW-NROW,8)*int(LROW-NROW+1,8)/2_8 + ASIZE = int(LROW,8)*int(LROW+1,8)/2_8 - + & ITMP8*(ITMP8-1_8)/2_8 + NCA = -555555 + ELSE + APOS = int(PS1-1,8) * LDA_SON8 + 1_8 + SHIFTCB_SON + NCA = int(LDA_SON8) + ASIZE = SIZFR - (SHIFTCB_SON - + & int(PS1-1,8) * LDA_SON8) + LROW1=-666666 + ENDIF + ENDIF + IF ( NROW-PS1+1-KEEP253_LOC .NE. 0 ) THEN + CALL SMUMPS_618( + & A_CBSON(APOS),ASIZE,NCA, + & NROW-PS1+1-KEEP253_LOC, + & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB,LROW1) + ENDIF + ENDIF + CALL MPI_PACK(BUF_MAX_ARRAY, NFS4FATHER, + & MPI_REAL, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + ENDIF + ENDIF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & PDEST, CONTRIB_TYPE2, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK.LT. POSITION ) THEN + WRITE(*,*) ' contniv2: SIZE, POSITION =',SIZE_PACK, POSITION + WRITE(*,*) ' NBROW, LROW = ', NBROW, LROW + CALL MUMPS_ABORT() + END IF + IF ( SIZE_PACK .NE. POSITION ) + & CALL SMUMPS_1( BUF_CB, POSITION ) + NBROWS_ALREADY_SENT=NBROWS_ALREADY_SENT + NBROWS_PACKET + IF (NBROWS_ALREADY_SENT .NE. NBROW ) THEN + IERR = -1 + ENDIF + 100 CONTINUE + RETURN + END SUBROUTINE SMUMPS_67 + SUBROUTINE SMUMPS_71( + & INODE, NFRONT, NASS1, NFS4FATHER, + & ISON, MYID, NSLAVES, SLAVES_PERE, + & TROW, NCBSON, + & COMM, IERR, + & DEST, NDEST, SLAVEF, + & + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & + & ) + IMPLICIT NONE + INTEGER INODE, NFRONT, NASS1, NCBSON, NSLAVES, + & NDEST + INTEGER SLAVEF, MYID, ISON + INTEGER TROW( NCBSON ) + INTEGER DEST( NDEST ) + INTEGER SLAVES_PERE( NSLAVES ) + INTEGER COMM, IERR + INTEGER KEEP(500), N + INTEGER(8) KEEP8(150) + INTEGER STEP(N), + & ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE_AV, IDEST, NSEND, SIZE, NFS4FATHER + INTEGER TROW_SIZE, POSITION, INDX, INIV2 + INTEGER IPOS, IREQ + INTEGER IONE + PARAMETER ( IONE=1 ) + INTEGER NASS_SON + NASS_SON = -99998 + IERR = 0 + IF ( NDEST .eq. 1 ) THEN + IF ( DEST(1).EQ.MYID ) GOTO 500 + SIZE = SIZEofINT * ( 7 + NSLAVES + NCBSON ) + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + SIZE = SIZE + SIZEofINT * ( NSLAVES + 1 ) + ENDIF + CALL SMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE, DEST + & ) + IF (IERR .LT. 0 ) THEN + RETURN + ENDIF + IF (SIZE.GT.SIZE_RBUF_BYTES ) THEN + IERR = -3 + RETURN + END IF + POSITION = IPOS + BUF_CB%CONTENT( POSITION ) = INODE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = ISON + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NSLAVES + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFRONT + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NASS1 + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NCBSON + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFS4FATHER + POSITION = POSITION + 1 + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES ) + & = TAB_POS_IN_PERE(1:NSLAVES+1,INIV2) + POSITION = POSITION + NSLAVES + 1 + ENDIF + IF ( NSLAVES .NE. 0 ) THEN + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) + & = SLAVES_PERE( 1: NSLAVES ) + POSITION = POSITION + NSLAVES + END IF + BUF_CB%CONTENT( POSITION:POSITION+NCBSON-1 ) = + & TROW( 1: NCBSON ) + POSITION = POSITION + NCBSON + POSITION = POSITION - IPOS + IF ( POSITION * SIZEofINT .NE. SIZE ) THEN + WRITE(*,*) 'Error in SMUMPS_71 :', + & ' wrong estimated size' + CALL MUMPS_ABORT() + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, + & MPI_PACKED, + & DEST( NDEST ), MAPLIG, COMM, + & BUF_CB%CONTENT( IREQ ), + & IERR ) + ELSE + NSEND = 0 + DO IDEST = 1, NDEST + IF ( DEST( IDEST ) .ne. MYID ) NSEND = NSEND + 1 + END DO + SIZE = SIZEofINT * + & ( ( OVHSIZE + 7 + NSLAVES )* NSEND + NCBSON ) + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + SIZE = SIZE + SIZEofINT * NSEND*( NSLAVES + 1 ) + ENDIF + CALL SMUMPS_79( BUF_CB, SIZE_AV ) + IF ( SIZE_AV .LT. SIZE ) THEN + IERR = -1 + RETURN + END IF + DO IDEST= 1, NDEST + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & IDEST, NCBSON, + & NDEST, + & TROW_SIZE, INDX ) + SIZE = SIZEofINT * ( NSLAVES + TROW_SIZE + 7 ) + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + SIZE = SIZE + SIZEofINT * ( NSLAVES + 1 ) + ENDIF + IF ( MYID .NE. DEST( IDEST ) ) THEN + CALL SMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE, DEST(IDEST) + & ) + IF ( IERR .LT. 0 ) THEN + WRITE(*,*) 'Problem in SMUMPS_4: IERR<0' + CALL MUMPS_ABORT() + END IF + IF (SIZE.GT.SIZE_RBUF_BYTES) THEN + IERR = -3 + RETURN + ENDIF + POSITION = IPOS + BUF_CB%CONTENT( POSITION ) = INODE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = ISON + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NSLAVES + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFRONT + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NASS1 + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = TROW_SIZE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFS4FATHER + POSITION = POSITION + 1 + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES ) + & = TAB_POS_IN_PERE(1:NSLAVES+1,INIV2) + POSITION = POSITION + NSLAVES + 1 + ENDIF + IF ( NSLAVES .NE. 0 ) THEN + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) + & = SLAVES_PERE( 1: NSLAVES ) + POSITION = POSITION + NSLAVES + END IF + BUF_CB%CONTENT( POSITION:POSITION+TROW_SIZE-1 ) = + & TROW( INDX: INDX + TROW_SIZE - 1 ) + POSITION = POSITION + TROW_SIZE + POSITION = POSITION - IPOS + IF ( POSITION * SIZEofINT .NE. SIZE ) THEN + WRITE(*,*) ' ERROR 1 in TRY_SEND_MAPLIG:', + & 'Wrong estimated size' + CALL MUMPS_ABORT() + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, + & MPI_PACKED, + & DEST( IDEST ), MAPLIG, COMM, + & BUF_CB%CONTENT( IREQ ), + & IERR ) + END IF + END DO + END IF + 500 CONTINUE + RETURN + END SUBROUTINE SMUMPS_71 + SUBROUTINE SMUMPS_65( INODE, NFRONT, + & NCOL, NPIV, FPERE, LASTBL, IPIV, VAL, + & PDEST, NDEST, KEEP50, NB_BLOC_FAC, COMM, IERR ) + IMPLICIT NONE + INTEGER INODE, NCOL, NPIV, FPERE, NFRONT, NDEST + INTEGER IPIV( NPIV ) + REAL VAL( NFRONT, * ) + INTEGER PDEST( NDEST ) + INTEGER KEEP50, NB_BLOC_FAC, COMM, IERR + LOGICAL LASTBL + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE, + & IDEST, IPOSMSG, I + INTEGER NPIVSENT + INTEGER SSS, SS2 + IERR = 0 + IF ( LASTBL ) THEN + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 4 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + ELSE + CALL MPI_PACK_SIZE( 6 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + END IF + ELSE + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 3 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + ELSE + CALL MPI_PACK_SIZE( 4 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + END IF + END IF + SIZE2 = 0 + IF (NPIV.GT.0) + & CALL MPI_PACK_SIZE( NPIV*NCOL, MPI_REAL, + & COMM, SIZE2, IERR ) + SIZE = SIZE1 + SIZE2 + CALL SMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & NDEST , PDEST + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + IF (SIZE.GT.SIZE_RBUF_BYTES) THEN + SSS = 0 + IF ( LASTBL ) THEN + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 4 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + ELSE + CALL MPI_PACK_SIZE( 6 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + END IF + ELSE + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 3 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + ELSE + CALL MPI_PACK_SIZE( 4 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + END IF + END IF + IF (NPIV.GT.0) + & CALL MPI_PACK_SIZE( NPIV*NCOL, MPI_REAL, + & COMM, SS2, IERR ) + SSS = SSS + SS2 + IF (SSS.GT.SIZE_RBUF_BYTES) THEN + IERR = -2 + RETURN + ENDIF + ENDIF + BUF_CB%ILASTMSG = BUF_CB%ILASTMSG + ( NDEST - 1 ) * OVHSIZE + IPOS = IPOS - OVHSIZE + DO IDEST = 1, NDEST - 1 + BUF_CB%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = + & IPOS + IDEST * OVHSIZE + END DO + BUF_CB%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 + IPOSMSG = IPOS + OVHSIZE * NDEST + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + NPIVSENT = NPIV + IF (LASTBL) NPIVSENT = -NPIV + CALL MPI_PACK( NPIVSENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + IF ( LASTBL .or. KEEP50.ne.0 ) THEN + CALL MPI_PACK( FPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + END IF + IF ( LASTBL .AND. KEEP50 .NE. 0 ) THEN + CALL MPI_PACK( NDEST, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NB_BLOC_FAC, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + END IF + CALL MPI_PACK( NCOL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + IF ( NPIV.GT.0) THEN + CALL MPI_PACK( IPIV, NPIV, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + DO I = 1, NPIV + CALL MPI_PACK( VAL(1,I), NCOL, + & MPI_REAL, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + END DO + ENDIF + DO IDEST = 1, NDEST + IF ( KEEP50.eq.0) THEN + CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, + & PDEST(IDEST), BLOC_FACTO, COMM, + & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), + & IERR ) + ELSE + CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, + & PDEST(IDEST), BLOC_FACTO_SYM, COMM, + & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), + & IERR ) + END IF + END DO + SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT + IF ( SIZE .LT. POSITION ) THEN + WRITE(*,*) ' Error sending blocfacto : size < position' + WRITE(*,*) ' Size,position=',SIZE,POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE .NE. POSITION ) CALL SMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE SMUMPS_65 + SUBROUTINE SMUMPS_64( INODE, + & NPIV, FPERE, IPOSK, JPOSK, UIP21K, NCOLU, + & NDEST, PDEST, COMM, IERR ) + IMPLICIT NONE + INTEGER INODE, NCOLU, IPOSK, JPOSK, NPIV, NDEST, FPERE + REAL UIP21K( NPIV, NCOLU ) + INTEGER PDEST( NDEST ) + INTEGER COMM, IERR + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE, + & IDEST, IPOSMSG, SSS, SS2 + IERR = 0 + CALL MPI_PACK_SIZE( 6 + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + CALL MPI_PACK_SIZE( abs(NPIV)*NCOLU, MPI_REAL, + & COMM, SIZE2, IERR ) + SIZE = SIZE1 + SIZE2 + IF (SIZE.GT.SIZE_RBUF_BYTES) THEN + CALL MPI_PACK_SIZE( 6 , + & MPI_INTEGER, COMM, SSS, IERR ) + CALL MPI_PACK_SIZE( abs(NPIV)*NCOLU, MPI_REAL, + & COMM, SS2, IERR ) + SSS = SSS+SS2 + IF (SSS.GT.SIZE_RBUF_BYTES) THEN + IERR = -2 + RETURN + ENDIF + END IF + CALL SMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & NDEST, PDEST + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + BUF_CB%ILASTMSG = BUF_CB%ILASTMSG + ( NDEST - 1 ) * OVHSIZE + IPOS = IPOS - OVHSIZE + DO IDEST = 1, NDEST - 1 + BUF_CB%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = + & IPOS + IDEST * OVHSIZE + END DO + BUF_CB%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 + IPOSMSG = IPOS + OVHSIZE * NDEST + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IPOSK, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( JPOSK, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NPIV, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( FPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NCOLU, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( UIP21K, abs(NPIV) * NCOLU, + & MPI_REAL, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + DO IDEST = 1, NDEST + CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, + & PDEST(IDEST), BLOC_FACTO_SYM_SLAVE, COMM, + & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), + & IERR ) + END DO + SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT + IF ( SIZE .LT. POSITION ) THEN + WRITE(*,*) ' Error sending blfac slave : size < position' + WRITE(*,*) ' Size,position=',SIZE,POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE .NE. POSITION ) CALL SMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE SMUMPS_64 + SUBROUTINE SMUMPS_648( N, ISON, + & NBCOL_SON, NBROW_SON, INDCOL_SON, INDROW_SON, + & LD_SON, VAL_SON, TAG, SUBSET_ROW, SUBSET_COL, + & NSUBSET_ROW, NSUBSET_COL, + & NSUPROW, NSUPCOL, + & NPROW, NPCOL, MBLOCK, RG2L_ROW, RG2L_COL, + & NBLOCK, PDEST, COMM, IERR , + & TAB, TABSIZE, TRANSP, SIZE_PACK, + & N_ALREADY_SENT, KEEP, BBPCBP ) + IMPLICIT NONE + INTEGER N, ISON, NBCOL_SON, NBROW_SON, NSUBSET_ROW, NSUBSET_COL + INTEGER NPROW, NPCOL, MBLOCK, NBLOCK, LD_SON + INTEGER BBPCBP + INTEGER PDEST, TAG, COMM, IERR + INTEGER INDCOL_SON( NBCOL_SON ), INDROW_SON( NBROW_SON ) + INTEGER SUBSET_ROW( NSUBSET_ROW ), SUBSET_COL( NSUBSET_COL ) + INTEGER, DIMENSION(:) :: RG2L_ROW + INTEGER, DIMENSION(:) :: RG2L_COL + INTEGER NSUPROW, NSUPCOL + INTEGER(8), INTENT(IN) :: TABSIZE + INTEGER SIZE_PACK + INTEGER KEEP(500) + REAL VAL_SON( LD_SON, * ), TAB(*) + LOGICAL TRANSP + INTEGER N_ALREADY_SENT + INCLUDE 'mpif.h' + INTEGER SIZE1, SIZE2, SIZE_AV, POSITION + INTEGER SIZE_CBP, SIZE_TMP + INTEGER IREQ, IPOS, ITAB + INTEGER ISUB, JSUB, I, J + INTEGER ILOC_ROOT, JLOC_ROOT + INTEGER IPOS_ROOT, JPOS_ROOT + INTEGER IONE + LOGICAL RECV_BUF_SMALLER_THAN_SEND + INTEGER PDEST2(1) + PARAMETER ( IONE=1 ) + INTEGER N_PACKET + INTEGER NSUBSET_ROW_EFF, NSUBSET_COL_EFF, NSUPCOL_EFF + PDEST2(1) = PDEST + IERR = 0 + IF ( NSUBSET_ROW * NSUBSET_COL .NE. 0 ) THEN + CALL SMUMPS_79( BUF_CB, SIZE_AV ) + IF (SIZE_AV .LT. SIZE_RBUF_BYTES) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + SIZE_AV = SIZE_RBUF_BYTES + ENDIF + SIZE_AV = min(SIZE_AV, SIZE_RBUF_BYTES) + CALL MPI_PACK_SIZE(8 + NSUBSET_COL, + & MPI_INTEGER, COMM, SIZE1, IERR ) + SIZE_CBP = 0 + IF (N_ALREADY_SENT .EQ. 0 .AND. + & min(NSUPROW,NSUPCOL) .GT.0) THEN + CALL MPI_PACK_SIZE(NSUPROW, MPI_INTEGER, COMM, + & SIZE_CBP, IERR) + CALL MPI_PACK_SIZE(NSUPCOL, MPI_INTEGER, COMM, + & SIZE_TMP, IERR) + SIZE_CBP = SIZE_CBP + SIZE_TMP + CALL MPI_PACK_SIZE(NSUPROW*NSUPCOL, + & MPI_REAL, COMM, + & SIZE_TMP, IERR) + SIZE_CBP = SIZE_CBP + SIZE_TMP + SIZE1 = SIZE1 + SIZE_CBP + ENDIF + IF (BBPCBP.EQ.1) THEN + NSUBSET_COL_EFF = NSUBSET_COL - NSUPCOL + NSUPCOL_EFF = 0 + ELSE + NSUBSET_COL_EFF = NSUBSET_COL + NSUPCOL_EFF = NSUPCOL + ENDIF + NSUBSET_ROW_EFF = NSUBSET_ROW - NSUPROW + N_PACKET = + & (SIZE_AV - SIZE1) / (SIZEofINT + NSUBSET_COL_EFF * SIZEofREAL) + 10 CONTINUE + N_PACKET = min( N_PACKET, + & NSUBSET_ROW_EFF-N_ALREADY_SENT ) + IF (N_PACKET .LE. 0 .AND. + & NSUBSET_ROW_EFF-N_ALREADY_SENT.GT.0) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR=-3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + CALL MPI_PACK_SIZE( 8 + NSUBSET_COL_EFF + N_PACKET, + & MPI_INTEGER, COMM, SIZE1, IERR ) + SIZE1 = SIZE1 + SIZE_CBP + CALL MPI_PACK_SIZE( N_PACKET * NSUBSET_COL_EFF, + & MPI_REAL, + & COMM, SIZE2, IERR ) + SIZE_PACK = SIZE1 + SIZE2 + IF (SIZE_PACK .GT. SIZE_AV) THEN + N_PACKET = N_PACKET - 1 + IF ( N_PACKET > 0 ) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF +#if ! defined(DBG_SMB3) + IF (N_PACKET + N_ALREADY_SENT .NE. NSUBSET_ROW - NSUPROW + & .AND. + & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 + & .AND. .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF +#endif + ELSE + N_PACKET = 0 + CALL MPI_PACK_SIZE(8,MPI_INTEGER, COMM, SIZE_PACK, IERR ) + END IF + CALL SMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE, PDEST2 + & ) + IF ( IERR .LT. 0 ) GOTO 100 + IF ( SIZE_PACK.GT.SIZE_RBUF_BYTES ) THEN + IERR = -3 + GOTO 100 + ENDIF + POSITION = 0 + CALL MPI_PACK( ISON, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUBSET_ROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUPROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUBSET_COL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUPCOL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( N_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( N_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( BBPCBP, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + IF ( NSUBSET_ROW * NSUBSET_COL .NE. 0 ) THEN + IF (N_ALREADY_SENT .EQ. 0 .AND. + & min(NSUPROW, NSUPCOL) .GT. 0) THEN + DO ISUB = NSUBSET_ROW-NSUPROW+1, NSUBSET_ROW + I = SUBSET_ROW( ISUB ) + IPOS_ROOT = RG2L_ROW(INDCOL_SON( I )) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + DO ISUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL + J = SUBSET_COL( ISUB ) + JPOS_ROOT = INDROW_SON( J ) - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + IF ( TABSIZE.GE.int(NSUPROW,8)*int(NSUPCOL,8) ) THEN + ITAB = 1 + DO JSUB = NSUBSET_ROW - NSUPROW+1, NSUBSET_ROW + J = SUBSET_ROW(JSUB) + DO ISUB = NSUBSET_COL - NSUPCOL+1, NSUBSET_COL + I = SUBSET_COL(ISUB) + TAB(ITAB) = VAL_SON(J, I) + ITAB = ITAB + 1 + ENDDO + ENDDO + CALL MPI_PACK(TAB(1), NSUPROW*NSUPCOL, + & MPI_REAL, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ELSE + DO JSUB = NSUBSET_ROW - NSUPROW+1, NSUBSET_ROW + J = SUBSET_ROW(JSUB) + DO ISUB = NSUBSET_COL - NSUPCOL+1, NSUBSET_COL + I = SUBSET_COL(ISUB) + CALL MPI_PACK(VAL_SON(J,I), 1, + & MPI_REAL, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + ENDDO + ENDIF + ENDIF + IF ( .NOT. TRANSP ) THEN + DO ISUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + I = SUBSET_ROW( ISUB ) + IPOS_ROOT = RG2L_ROW( INDROW_SON( I ) ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO JSUB = 1, NSUBSET_COL_EFF - NSUPCOL_EFF + J = SUBSET_COL( JSUB ) + JPOS_ROOT = RG2L_COL( INDCOL_SON( J ) ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO JSUB = NSUBSET_COL_EFF-NSUPCOL_EFF+1, NSUBSET_COL_EFF + J = SUBSET_COL( JSUB ) + JPOS_ROOT = INDCOL_SON( J ) - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + ELSE + DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + J = SUBSET_ROW( JSUB ) + IPOS_ROOT = RG2L_ROW( INDCOL_SON( J ) ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO ISUB = 1, NSUBSET_COL_EFF - NSUPCOL_EFF + I = SUBSET_COL( ISUB ) + JPOS_ROOT = RG2L_COL( INDROW_SON( I ) ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO ISUB = NSUBSET_COL_EFF - NSUPCOL_EFF + 1, NSUBSET_COL_EFF + I = SUBSET_COL( ISUB ) + JPOS_ROOT = INDROW_SON(I) - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + END IF + IF ( TABSIZE.GE.int(N_PACKET,8)*int(NSUBSET_COL_EFF,8) ) THEN + IF ( .NOT. TRANSP ) THEN + ITAB = 1 + DO ISUB = N_ALREADY_SENT+1, + & N_ALREADY_SENT+N_PACKET + I = SUBSET_ROW( ISUB ) + DO JSUB = 1, NSUBSET_COL_EFF + J = SUBSET_COL( JSUB ) + TAB( ITAB ) = VAL_SON(J,I) + ITAB = ITAB + 1 + END DO + END DO + CALL MPI_PACK(TAB(1), NSUBSET_COL_EFF*N_PACKET, + & MPI_REAL, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ELSE + ITAB = 1 + DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + J = SUBSET_ROW( JSUB ) + DO ISUB = 1, NSUBSET_COL_EFF + I = SUBSET_COL( ISUB ) + TAB( ITAB ) = VAL_SON( J, I ) + ITAB = ITAB + 1 + END DO + END DO + CALL MPI_PACK(TAB(1), NSUBSET_COL_EFF*N_PACKET, + & MPI_REAL, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END IF + ELSE + IF ( .NOT. TRANSP ) THEN + DO ISUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + I = SUBSET_ROW( ISUB ) + DO JSUB = 1, NSUBSET_COL_EFF + J = SUBSET_COL( JSUB ) + CALL MPI_PACK( VAL_SON( J, I ), 1, + & MPI_REAL, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + END DO + ELSE + DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + J = SUBSET_ROW( JSUB ) + DO ISUB = 1, NSUBSET_COL_EFF + I = SUBSET_COL( ISUB ) + CALL MPI_PACK( VAL_SON( J, I ), 1, + & MPI_REAL, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + END DO + END IF + ENDIF + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & PDEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK .LT. POSITION ) THEN + WRITE(*,*) ' Error sending contribution to root:Sizeid%ISTEP_TO_INIV2 + CAND_LOAD=>id%CANDIDATES + ND_LOAD=>id%ND_STEPS + KEEP_LOAD=>id%KEEP + KEEP =>id%KEEP + KEEP8_LOAD=>id%KEEP8 + FILS_LOAD=>id%FILS + FRERE_LOAD=>id%FRERE_STEPS + DAD_LOAD=>id%DAD_STEPS + PROCNODE_LOAD=>id%PROCNODE_STEPS + STEP_LOAD=>id%STEP + NE_LOAD=>id%NE_STEPS + N_LOAD=id%N + ROOT_CURRENT_SUBTREE=-9999 + MEMORY_MD=MEMORY_MD_ARG + LA=MAXS + MAX_SURF_MASTER=id%MAX_SURF_MASTER+ + & (int(id%KEEP(12),8)*int(id%MAX_SURF_MASTER,8)/int(100,8)) + COMM_LD = id%COMM_LOAD + MAX_PEAK_STK = 0.0D0 + K69 = KEEP(69) + IF ( KEEP(47) .le. 0 .OR. KEEP(47) .gt. 4 ) THEN + write(*,*) "Internal error 1 in SMUMPS_185" + CALL MUMPS_ABORT() + END IF + CHK_LD=dble(0) + BDC_MEM = ( KEEP(47) >= 2 ) + BDC_POOL = ( KEEP(47) >= 3 ) + BDC_SBTR = ( KEEP(47) >= 4 ) + BDC_M2_MEM = ( ( KEEP(80) == 2 .OR. KEEP(80) == 3 ) + & .AND. KEEP(47) == 4 ) + BDC_M2_FLOPS = ( KEEP(80) == 1 + & .AND. KEEP(47) .GE. 1 ) + BDC_MD = (KEEP(86)==1) + SBTR_WHICH_M = KEEP(90) + REMOVE_NODE_FLAG=.FALSE. + REMOVE_NODE_FLAG_MEM=.FALSE. + REMOVE_NODE_COST_MEM=dble(0) + REMOVE_NODE_COST=dble(0) + IF (KEEP(80) .LT. 0 .OR. KEEP(80)>3) THEN + WRITE(*,*) "Unimplemented KEEP(80) Strategy" + CALL MUMPS_ABORT() + ENDIF + IF ((KEEP(80) == 2 .OR. KEEP(80)==3 ).AND. KEEP(47).NE.4) + & THEN + WRITE(*,*) "Internal error 3 in SMUMPS_185" + CALL MUMPS_ABORT() + END IF + IF (KEEP(81) == 1 .AND. KEEP(47) < 2) THEN + WRITE(*,*) "Internal error 2 in SMUMPS_185" + CALL MUMPS_ABORT() + ENDIF + BDC_POOL_MNG = ((KEEP(81) == 1).AND.(KEEP(47) >= 2)) + IF(KEEP(76).EQ.4)THEN + DEPTH_FIRST_LOAD=>id%DEPTH_FIRST + ENDIF + IF(KEEP(76).EQ.5)THEN + COST_TRAV=>id%COST_TRAV + ENDIF + IF(KEEP(76).EQ.6)THEN + DEPTH_FIRST_LOAD=>id%DEPTH_FIRST + DEPTH_FIRST_SEQ_LOAD=>id%DEPTH_FIRST_SEQ + SBTR_ID_LOAD=>id%SBTR_ID + ENDIF + IF (BDC_M2_MEM.OR.BDC_M2_FLOPS) THEN + ALLOCATE(NIV2(id%NSLAVES), NB_SON(KEEP(28)), + & POOL_NIV2(100),POOL_NIV2_COST(100), + & stat=allocok) + NB_SON=id%NE_STEPS + NIV2=dble(0) + IF (allocok > 0) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = id%NSLAVES + KEEP(28) + 200 + RETURN + ENDIF + ENDIF + K50 = id%KEEP(50) + CALL MPI_COMM_RANK( COMM_LD, MYID, IERR ) + NPROCS = id%NSLAVES + DM_SUMLU=ZERO + POOL_SIZE=0 + IF(BDC_MD)THEN + IF ( allocated(MD_MEM) ) DEALLOCATE(MD_MEM) + ALLOCATE( MD_MEM( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(TAB_MAXS) ) DEALLOCATE(TAB_MAXS) + ALLOCATE( TAB_MAXS( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + TAB_MAXS=0_8 + IF ( allocated(LU_USAGE) ) DEALLOCATE(LU_USAGE) + ALLOCATE( LU_USAGE( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + LU_USAGE=dble(0) + MD_MEM=int(0,8) + ENDIF + IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN + ALLOCATE(CB_COST_MEM(2*2000*id%NSLAVES), + & stat=allocok) + IF (allocok > 0) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = id%NSLAVES + RETURN + ENDIF + CB_COST_MEM=int(0,8) + ALLOCATE(CB_COST_ID(2000*3), + & stat=allocok) + IF (allocok > 0) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = id%NSLAVES + RETURN + ENDIF + CB_COST_ID=0 + POS_MEM=1 + POS_ID=1 + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + ALLOCATE(FUTURE_NIV2(NPROCS), stat=allocok) + IF (allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + ENDIF + DO i = 1, NPROCS + FUTURE_NIV2(i) = id%FUTURE_NIV2(i) + IF(BDC_MD)THEN + IF(FUTURE_NIV2(i).EQ.0)THEN + MD_MEM(i-1)=999999999_8 + ENDIF + ENDIF + ENDDO + DELTA_MEM=ZERO + DELTA_LOAD=ZERO +#endif + CHECK_MEM=0_8 +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + NB_LEVEL2=0 + AMI_CHOSEN=.FALSE. + IS_DISPLAYED=.FALSE. +#endif +#endif + IF(BDC_SBTR.OR.BDC_POOL_MNG)THEN + NB_SUBTREES=id%NBSA_LOCAL + IF (allocated(MEM_SUBTREE)) DEALLOCATE(MEM_SUBTREE) + ALLOCATE(MEM_SUBTREE(id%NBSA_LOCAL),stat=allocok) + DO i=1,id%NBSA_LOCAL + MEM_SUBTREE(i)=id%MEM_SUBTREE(i) + ENDDO + MY_FIRST_LEAF=>id%MY_FIRST_LEAF + MY_NB_LEAF=>id%MY_NB_LEAF + MY_ROOT_SBTR=>id%MY_ROOT_SBTR + IF (allocated(SBTR_FIRST_POS_IN_POOL)) + & DEALLOCATE(SBTR_FIRST_POS_IN_POOL) + ALLOCATE(SBTR_FIRST_POS_IN_POOL(id%NBSA_LOCAL),stat=allocok) + INSIDE_SUBTREE=0 + PEAK_SBTR_CUR_LOCAL = dble(0) + SBTR_CUR_LOCAL = dble(0) + IF (allocated(SBTR_PEAK_ARRAY)) DEALLOCATE(SBTR_PEAK_ARRAY) + ALLOCATE(SBTR_PEAK_ARRAY(id%NBSA_LOCAL),stat=allocok) + SBTR_PEAK_ARRAY=dble(0) + IF (allocated(SBTR_CUR_ARRAY)) DEALLOCATE(SBTR_CUR_ARRAY) + ALLOCATE(SBTR_CUR_ARRAY(id%NBSA_LOCAL),stat=allocok) + SBTR_CUR_ARRAY=dble(0) + INDICE_SBTR_ARRAY=1 + NIV1_FLAG=0 + INDICE_SBTR=1 + ENDIF + IF ( allocated(LOAD_FLOPS) ) DEALLOCATE( LOAD_FLOPS ) + ALLOCATE( LOAD_FLOPS( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(WLOAD) ) DEALLOCATE( WLOAD ) + ALLOCATE( WLOAD( NPROCS ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(IDWLOAD) ) DEALLOCATE( IDWLOAD ) + ALLOCATE( IDWLOAD( NPROCS ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( BDC_MEM ) THEN + IF ( allocated(DM_MEM) ) DEALLOCATE( DM_MEM ) + ALLOCATE( DM_MEM( 0:NPROCS-1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + END IF + IF ( BDC_POOL ) THEN + IF ( allocated(POOL_MEM) ) DEALLOCATE(POOL_MEM) + ALLOCATE( POOL_MEM(0: NPROCS -1), stat=allocok) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + POOL_MEM = dble(0) + POOL_LAST_COST_SENT = dble(0) + END IF + IF ( BDC_SBTR ) THEN + IF ( allocated(SBTR_MEM) ) DEALLOCATE(SBTR_MEM) + ALLOCATE( SBTR_MEM(0: NPROCS -1), stat=allocok) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(SBTR_CUR) ) DEALLOCATE(SBTR_CUR) + ALLOCATE( SBTR_CUR(0: NPROCS -1), stat=allocok) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + SBTR_CUR = dble(0) + SBTR_MEM = dble(0) + END IF + CALL MUMPS_546(K34_LOC,K35_LOC) + K35 = K35_LOC + BUF_LOAD_SIZE = K34_LOC * 2 * ( NPROCS - 1 ) + + & NPROCS * ( K35_LOC + K34_LOC ) + IF (BDC_MEM) THEN + BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35_LOC + END IF + IF (BDC_SBTR)THEN + BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35_LOC + ENDIF + LBUF_LOAD_RECV = (BUF_LOAD_SIZE+K34_LOC)/K34_LOC + LBUF_LOAD_RECV_BYTES = LBUF_LOAD_RECV * K34_LOC + IF ( allocated(BUF_LOAD_RECV) ) DEALLOCATE(BUF_LOAD_RECV) + ALLOCATE( BUF_LOAD_RECV( LBUF_LOAD_RECV), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = LBUF_LOAD_RECV + RETURN + ENDIF + BUF_LOAD_SIZE = BUF_LOAD_SIZE * 20 + CALL SMUMPS_54( BUF_LOAD_SIZE, IERR ) + IF ( IERR .LT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = BUF_LOAD_SIZE + RETURN + END IF + DO i = 0, NPROCS - 1 + LOAD_FLOPS( i ) = ZERO + END DO +#if defined(OLD_LOAD_MECHANISM) + LOAD_FLOPS( MYID ) = COST_SUBTREE + LAST_LOAD_SENT = ZERO +#endif + IF ( BDC_MEM ) THEN + DO i = 0, NPROCS - 1 + DM_MEM( i )=ZERO + END DO +#if defined(OLD_LOAD_MECHANISM) + DM_LAST_MEM_SENT=ZERO +#endif + ENDIF + CALL SMUMPS_425(KEEP(69)) + IF(BDC_MD)THEN + MAX_SBTR=0.0D0 + IF(BDC_SBTR)THEN + DO i=1,id%NBSA_LOCAL + MAX_SBTR=max(id%MEM_SUBTREE(i),MAX_SBTR) + ENDDO + ENDIF + MD_MEM(MYID)=MEMORY_MD + WHAT=8 + CALL SMUMPS_460( WHAT, + & COMM_LD, NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & dble(MEMORY_MD),dble(0) ,MYID, IERR ) + WHAT=9 + MEMORY_SENT = dble(LA-MAX_SURF_MASTER)-MAX_SBTR + & - max( dble(LA) * dble(3) / dble(100), + & dble(2) * dble(max(KEEP(5),KEEP(6))) * dble(KEEP(127))) + IF (KEEP(12) > 25) THEN + MEMORY_SENT = MEMORY_SENT - + & dble(KEEP(12))*0.2d0*dble(LA)/100.0d0 + ENDIF + TAB_MAXS(MYID)=int(MEMORY_SENT,8) + CALL SMUMPS_460( WHAT, + & COMM_LD, NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & MEMORY_SENT, + & dble(0),MYID, IERR ) + ENDIF + RETURN + END SUBROUTINE SMUMPS_185 + SUBROUTINE SMUMPS_190( CHECK_FLOPS,PROCESS_BANDE, + & INC_LOAD, KEEP,KEEP8 ) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + DOUBLE PRECISION INC_LOAD + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + LOGICAL PROCESS_BANDE + INTEGER CHECK_FLOPS + INTEGER IERR + DOUBLE PRECISION ZERO, SEND_MEM, SEND_LOAD,SBTR_TMP + PARAMETER( ZERO=0.0d0 ) + INTRINSIC max, abs + IF (INC_LOAD == 0.0D0) THEN + IF(REMOVE_NODE_FLAG)THEN + REMOVE_NODE_FLAG=.FALSE. + ENDIF + RETURN + ENDIF + IF((CHECK_FLOPS.NE.0).AND. + & (CHECK_FLOPS.NE.1).AND.(CHECK_FLOPS.NE.2))THEN + WRITE(*,*)MYID,': Bad value for CHECK_FLOPS' + CALL MUMPS_ABORT() + ENDIF + IF(CHECK_FLOPS.EQ.1)THEN + CHK_LD=CHK_LD+INC_LOAD + ELSE + IF(CHECK_FLOPS.EQ.2)THEN + RETURN + ENDIF + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF ( PROCESS_BANDE ) THEN + RETURN + ENDIF +#endif + LOAD_FLOPS( MYID ) = max( LOAD_FLOPS( MYID ) + INC_LOAD, ZERO) + IF(BDC_M2_FLOPS.AND.REMOVE_NODE_FLAG)THEN + IF(INC_LOAD.NE.REMOVE_NODE_COST)THEN + IF(INC_LOAD.GT.REMOVE_NODE_COST)THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = DELTA_LOAD + + & (INC_LOAD-REMOVE_NODE_COST) + GOTO 888 +#else + GOTO 888 +#endif + ELSE +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = DELTA_LOAD - + & (REMOVE_NODE_COST-INC_LOAD) + GOTO 888 +#else + GOTO 888 +#endif + ENDIF + ENDIF + GOTO 333 + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = DELTA_LOAD + INC_LOAD + 888 CONTINUE + IF ( DELTA_LOAD > MIN_DIFF .OR. DELTA_LOAD < -MIN_DIFF) THEN + SEND_LOAD = DELTA_LOAD + IF (BDC_MEM) THEN + SEND_MEM = DELTA_MEM + ELSE + SEND_MEM = ZERO + END IF +#else + 888 CONTINUE + IF ( abs( LOAD_FLOPS ( MYID ) - + & LAST_LOAD_SENT ).GT.MIN_DIFF)THEN + IERR = 0 + SEND_LOAD = LOAD_FLOPS( MYID ) + IF ( BDC_MEM ) THEN + SEND_MEM = DM_MEM(MYID) + ELSE + SEND_MEM = ZERO + END IF +#endif + IF(BDC_SBTR)THEN + SBTR_TMP=SBTR_CUR(MYID) + ELSE + SBTR_TMP=dble(0) + ENDIF + 111 CONTINUE + CALL SMUMPS_77( BDC_SBTR,BDC_MEM, + & BDC_MD,COMM_LD, NPROCS, + & SEND_LOAD, + & SEND_MEM,SBTR_TMP, + & DM_SUMLU, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & MYID, IERR ) + IF ( IERR == -1 )THEN + CALL SMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE.0 ) THEN + WRITE(*,*) "Internal Error in SMUMPS_190",IERR + CALL MUMPS_ABORT() + ENDIF + IF ( IERR .EQ. 0 ) THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = ZERO + IF (BDC_MEM) DELTA_MEM = ZERO +#else + LAST_LOAD_SENT = LOAD_FLOPS( MYID ) + IF ( BDC_MEM ) DM_LAST_MEM_SENT = DM_MEM( MYID ) +#endif + END IF + ENDIF + 333 CONTINUE + IF(REMOVE_NODE_FLAG)THEN + REMOVE_NODE_FLAG=.FALSE. + ENDIF + RETURN + END SUBROUTINE SMUMPS_190 + SUBROUTINE SMUMPS_471( SSARBR, + & PROCESS_BANDE_ARG, MEM_VALUE, NEW_LU, INC_MEM_ARG, + & KEEP,KEEP8,LRLU) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER(8), INTENT(IN) :: MEM_VALUE, INC_MEM_ARG, NEW_LU,LRLU + LOGICAL, INTENT(IN) :: PROCESS_BANDE_ARG, SSARBR + INTEGER IERR, KEEP(500) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION ZERO, SEND_MEM, SBTR_TMP + PARAMETER( ZERO=0.0d0 ) + INTRINSIC max, abs + INTEGER(8) :: INC_MEM + LOGICAL PROCESS_BANDE +#if defined(OLD_LOAD_MECHANISM) + DOUBLE PRECISION TMP_MEM +#endif + PROCESS_BANDE=PROCESS_BANDE_ARG + INC_MEM = INC_MEM_ARG +#if ! defined(OLD_LOAD_MECHANISM) + IF ( PROCESS_BANDE .AND. NEW_LU .NE. 0_8) THEN + WRITE(*,*) " Internal Error in SMUMPS_471." + WRITE(*,*) " NEW_LU must be zero if called from PROCESS_BANDE" + CALL MUMPS_ABORT() + ENDIF +#endif +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + IF(PROCESS_BANDE)THEN + PROCESS_BANDE=.FALSE. + NB_LEVEL2=NB_LEVEL2-1 + IF(NB_LEVEL2.LT.0)THEN + WRITE(*,*)MYID,': problem with NB_LEVEL2' + ELSEIF(NB_LEVEL2.EQ.0)THEN + IF(IS_DISPLAYED)THEN +#if defined(STATS_DYNAMIC_MEMORY) + WRITE(*,*)MYID,': end of Incoherent state at time=', + & MPI_WTIME()-TIME_REF +#endif + IS_DISPLAYED=.FALSE. + ENDIF + AMI_CHOSEN=.FALSE. + ENDIF + ENDIF + IF((KEEP(73).EQ.0).AND.(NB_LEVEL2.NE.0) + & .AND.(.NOT.IS_DISPLAYED))THEN + IS_DISPLAYED=.TRUE. +#if defined(STATS_DYNAMIC_MEMORY) + WRITE(*,*)MYID,': Begin of Incoherent state (1) at time=', + & MPI_WTIME()-TIME_REF +#endif + ENDIF +#endif +#endif + DM_SUMLU = DM_SUMLU + dble(NEW_LU) + IF(KEEP_LOAD(201).EQ.0)THEN + CHECK_MEM = CHECK_MEM + INC_MEM + ELSE + CHECK_MEM = CHECK_MEM + INC_MEM - NEW_LU + ENDIF + IF ( MEM_VALUE .NE. CHECK_MEM ) THEN + WRITE(*,*)MYID, + & ':Problem with increments in SMUMPS_471', + & CHECK_MEM, MEM_VALUE, INC_MEM,NEW_LU + CALL MUMPS_ABORT() + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (PROCESS_BANDE) THEN + RETURN + ENDIF +#endif + IF(BDC_POOL_MNG) THEN + IF(SBTR_WHICH_M.EQ.0)THEN + IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+ + & dble(INC_MEM-NEW_LU) + ELSE + IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+ + & dble(INC_MEM) + ENDIF + ENDIF + IF ( .NOT. BDC_MEM ) THEN + RETURN + ENDIF +#if defined(OLD_LOAD_MECHANISM) + IF(KEEP_LOAD(201).EQ.0)THEN + DM_MEM( MYID ) = dble(CHECK_MEM) - DM_SUMLU + ELSE + DM_MEM( MYID ) = dble(CHECK_MEM) + ENDIF + TMP_MEM = DM_MEM(MYID) +#endif + IF (BDC_SBTR .AND. SSARBR) THEN + IF((SBTR_WHICH_M.EQ.0).AND.(KEEP(201).NE.0))THEN + SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM-NEW_LU) + ELSE + SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM) + ENDIF + SBTR_TMP = SBTR_CUR(MYID) + ELSE + SBTR_TMP=dble(0) + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF ( NEW_LU > 0_8 ) THEN + INC_MEM = INC_MEM - NEW_LU + ENDIF + DM_MEM( MYID ) = DM_MEM(MYID) + dble(INC_MEM) + MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MYID)) + IF(BDC_M2_MEM.AND.REMOVE_NODE_FLAG_MEM)THEN + IF(dble(INC_MEM).NE.REMOVE_NODE_COST_MEM)THEN + IF(dble(INC_MEM).GT.REMOVE_NODE_COST_MEM)THEN + DELTA_MEM = DELTA_MEM + + & (dble(INC_MEM)-REMOVE_NODE_COST_MEM) + GOTO 888 + ELSE + DELTA_MEM = DELTA_MEM - + & (REMOVE_NODE_COST_MEM-dble(INC_MEM)) + GOTO 888 + ENDIF + ENDIF + GOTO 333 + ENDIF + DELTA_MEM = DELTA_MEM + dble(INC_MEM) + 888 CONTINUE + IF ((KEEP(48).NE.5).OR. + & ((KEEP(48).EQ.5).AND.(abs(DELTA_MEM) + & .GE.0.1d0*dble(LRLU))))THEN + IF ( abs(DELTA_MEM) > DM_THRES_MEM ) THEN + SEND_MEM = DELTA_MEM +#else + IF(BDC_M2_MEM.AND.REMOVE_NODE_FLAG_MEM)THEN + IF(INC_MEM.NE.REMOVE_NODE_COST_MEM)THEN + IF(INC_MEM.EQ.REMOVE_NODE_COST_MEM)THEN + GOTO 333 + ELSEIF(INC_MEM.LT.REMOVE_NODE_COST_MEM)THEN + GOTO 333 + ENDIF + ENDIF + ENDIF + IF ((KEEP(48).NE.5).OR. + & ((KEEP(48).EQ.5).AND. + & (abs(TMP_MEM-DM_LAST_MEM_SENT).GE. + & 0.1d0*dble(LRLU))))THEN + IF ( abs( TMP_MEM-DM_LAST_MEM_SENT) > + & DM_THRES_MEM ) THEN + IERR = 0 + SEND_MEM = TMP_MEM +#endif + 111 CONTINUE + CALL SMUMPS_77( + & BDC_SBTR, + & BDC_MEM,BDC_MD, COMM_LD, + & NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & DELTA_LOAD, +#else + & LOAD_FLOPS( MYID ), +#endif + & SEND_MEM,SBTR_TMP, + & DM_SUMLU, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & MYID,IERR ) + IF ( IERR == -1 )THEN + CALL SMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in SMUMPS_471",IERR + CALL MUMPS_ABORT() + ENDIF + IF ( IERR .EQ. 0 ) THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = ZERO + DELTA_MEM = ZERO +#else + LAST_LOAD_SENT = LOAD_FLOPS ( MYID ) + DM_LAST_MEM_SENT = TMP_MEM +#endif + END IF + ENDIF + ENDIF + 333 CONTINUE + IF(REMOVE_NODE_FLAG_MEM)THEN + REMOVE_NODE_FLAG_MEM=.FALSE. + ENDIF + END SUBROUTINE SMUMPS_471 + INTEGER FUNCTION SMUMPS_186( K69, MEM_DISTRIB,MSG_SIZE ) + IMPLICIT NONE + INTEGER i, NLESS, K69 + INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB + DOUBLE PRECISION LREF + DOUBLE PRECISION MSG_SIZE + NLESS = 0 + DO i=1,NPROCS + IDWLOAD(i) = i - 1 + ENDDO + WLOAD(1:NPROCS) = LOAD_FLOPS(0:NPROCS-1) + IF(BDC_M2_FLOPS)THEN + DO i=1,NPROCS + WLOAD(i)=WLOAD(i)+NIV2(i) + ENDDO + ENDIF + IF(K69 .gt. 1) THEN + CALL SMUMPS_426(MEM_DISTRIB,MSG_SIZE,IDWLOAD,NPROCS) + ENDIF + LREF = LOAD_FLOPS(MYID) + DO i=1, NPROCS + IF (WLOAD(i).LT.LREF) NLESS=NLESS+1 + ENDDO + SMUMPS_186 = NLESS + RETURN + END FUNCTION SMUMPS_186 + SUBROUTINE SMUMPS_189(MEM_DISTRIB,MSG_SIZE,DEST, + & NSLAVES) + IMPLICIT NONE + INTEGER NSLAVES + INTEGER DEST(NSLAVES) + INTEGER, DIMENSION(0:NPROCS - 1) :: MEM_DISTRIB + INTEGER i,J,NBDEST + DOUBLE PRECISION MSG_SIZE + IF ( NSLAVES.eq.NPROCS-1 ) THEN + J = MYID+1 + DO i=1,NSLAVES + J=J+1 + IF (J.GT.NPROCS) J=1 + DEST(i) = J - 1 + ENDDO + ELSE + DO i=1,NPROCS + IDWLOAD(i) = i - 1 + ENDDO + CALL MUMPS_558(NPROCS, WLOAD, IDWLOAD) + NBDEST = 0 + DO i=1, NSLAVES + J = IDWLOAD(i) + IF (J.NE.MYID) THEN + NBDEST = NBDEST+1 + DEST(NBDEST) = J + ENDIF + ENDDO + IF (NBDEST.NE.NSLAVES) THEN + DEST(NSLAVES) = IDWLOAD(NSLAVES+1) + ENDIF + IF(BDC_MD)THEN + J=NSLAVES+1 + do i=NSLAVES+1,NPROCS + IF(IDWLOAD(i).NE.MYID)THEN + DEST(J)= IDWLOAD(i) + J=J+1 + ENDIF + end do + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_189 + SUBROUTINE SMUMPS_183( INFO1, IERR ) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER, intent(in) :: INFO1 + INTEGER, intent(out) :: IERR + IERR=0 + DEALLOCATE( LOAD_FLOPS ) + DEALLOCATE( WLOAD ) + DEALLOCATE( IDWLOAD ) +#if ! defined(OLD_LOAD_MECHANISM) + DEALLOCATE(FUTURE_NIV2) +#endif + IF(BDC_MD)THEN + DEALLOCATE(MD_MEM) + DEALLOCATE(LU_USAGE) + DEALLOCATE(TAB_MAXS) + ENDIF + IF ( BDC_MEM ) DEALLOCATE( DM_MEM ) + IF ( BDC_POOL) DEALLOCATE( POOL_MEM ) + IF ( BDC_SBTR) THEN + DEALLOCATE( SBTR_MEM ) + DEALLOCATE( SBTR_CUR ) + DEALLOCATE(SBTR_FIRST_POS_IN_POOL) + NULLIFY(MY_FIRST_LEAF) + NULLIFY(MY_NB_LEAF) + NULLIFY(MY_ROOT_SBTR) + ENDIF + IF(KEEP_LOAD(76).EQ.4)THEN + NULLIFY(DEPTH_FIRST_LOAD) + ENDIF + IF(KEEP_LOAD(76).EQ.5)THEN + NULLIFY(COST_TRAV) + ENDIF + IF((KEEP_LOAD(76).EQ.4).OR.(KEEP_LOAD(76).EQ.6))THEN + NULLIFY(DEPTH_FIRST_LOAD) + NULLIFY(DEPTH_FIRST_SEQ_LOAD) + NULLIFY(SBTR_ID_LOAD) + ENDIF + IF (BDC_M2_MEM.OR.BDC_M2_FLOPS) THEN + DEALLOCATE(NB_SON,POOL_NIV2,POOL_NIV2_COST, NIV2) + END IF + IF((KEEP_LOAD(81).EQ.2).OR.(KEEP_LOAD(81).EQ.3))THEN + DEALLOCATE(CB_COST_MEM) + DEALLOCATE(CB_COST_ID) + ENDIF + NULLIFY(ND_LOAD) + NULLIFY(KEEP_LOAD) + NULLIFY(KEEP8_LOAD) + NULLIFY(FILS_LOAD) + NULLIFY(FRERE_LOAD) + NULLIFY(PROCNODE_LOAD) + NULLIFY(STEP_LOAD) + NULLIFY(NE_LOAD) + NULLIFY(CAND_LOAD) + NULLIFY(STEP_TO_NIV2_LOAD) + NULLIFY(DAD_LOAD) + IF (BDC_SBTR.OR.BDC_POOL_MNG) THEN + DEALLOCATE(MEM_SUBTREE) + DEALLOCATE(SBTR_PEAK_ARRAY) + DEALLOCATE(SBTR_CUR_ARRAY) + ENDIF + CALL SMUMPS_58( IERR ) + CALL SMUMPS_150( MYID, COMM_LD, + & BUF_LOAD_RECV, LBUF_LOAD_RECV, + & LBUF_LOAD_RECV_BYTES ) + DEALLOCATE(BUF_LOAD_RECV) + END SUBROUTINE SMUMPS_183 +#if defined (LAMPORT_) + RECURSIVE SUBROUTINE SMUMPS_467(COMM, KEEP) +#else + SUBROUTINE SMUMPS_467(COMM, KEEP) +#endif + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, MSGTAG, MSGLEN, MSGSOU,COMM + INTEGER KEEP(500) + INTEGER STATUS(MPI_STATUS_SIZE) + LOGICAL FLAG + 10 CONTINUE + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + IF (FLAG) THEN + KEEP(65)=KEEP(65)+1 + MSGTAG = STATUS( MPI_TAG ) + MSGSOU = STATUS( MPI_SOURCE ) + IF ( MSGTAG .NE. UPDATE_LOAD) THEN + write(*,*) "Internal error 1 in SMUMPS_467", + & MSGTAG + CALL MUMPS_ABORT() + ENDIF + CALL MPI_GET_COUNT(STATUS, MPI_PACKED, MSGLEN, IERR) + IF ( MSGLEN > LBUF_LOAD_RECV_BYTES ) THEN + write(*,*) "Internal error 2 in SMUMPS_467", + & MSGLEN, LBUF_LOAD_RECV_BYTES + CALL MUMPS_ABORT() + ENDIF + CALL MPI_RECV( BUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES, + & MPI_PACKED, MSGSOU, MSGTAG, COMM_LD, STATUS, IERR) + CALL SMUMPS_187( MSGSOU, BUF_LOAD_RECV, + & LBUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES ) + GOTO 10 + ENDIF + RETURN + END SUBROUTINE SMUMPS_467 + RECURSIVE SUBROUTINE SMUMPS_187 + & ( MSGSOU, BUFR, LBUFR, LBUFR_BYTES ) + IMPLICIT NONE + INTEGER MSGSOU, LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INCLUDE 'mpif.h' + INTEGER POSITION, IERR, WHAT, NSLAVES, i + DOUBLE PRECISION LOAD_RECEIVED + INTEGER INODE_RECEIVED,NCB_RECEIVED + DOUBLE PRECISION SURF + INTEGER, POINTER, DIMENSION (:) :: LIST_SLAVES + DOUBLE PRECISION, POINTER, DIMENSION (:) :: LOAD_INCR + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WHAT, 1, MPI_INTEGER, + & COMM_LD, IERR ) + IF ( WHAT == 0 ) THEN +#if ! defined(OLD_LOAD_MECHANISM) +#else +#endif + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) +#if ! defined(OLD_LOAD_MECHANISM) + LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED +#else + LOAD_FLOPS( MSGSOU ) = LOAD_RECEIVED +#endif + IF ( BDC_MEM ) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) +#if ! defined(OLD_LOAD_MECHANISM) + DM_MEM(MSGSOU) = DM_MEM(MSGSOU) + LOAD_RECEIVED +#else + DM_MEM(MSGSOU) = LOAD_RECEIVED +#endif + MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MSGSOU)) + END IF + IF(BDC_SBTR)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + SBTR_CUR(MSGSOU)=LOAD_RECEIVED + ENDIF + IF(BDC_MD)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(KEEP_LOAD(201).EQ.0)THEN + LU_USAGE(MSGSOU)=LOAD_RECEIVED + ENDIF + ENDIF + ELSEIF (( WHAT == 1).OR.(WHAT.EQ.19)) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSLAVES, 1, MPI_INTEGER, + & COMM_LD, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, MPI_INTEGER, + & COMM_LD, IERR ) + LIST_SLAVES => IDWLOAD + LOAD_INCR => WLOAD + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LIST_SLAVES(1), NSLAVES, MPI_INTEGER, + & COMM_LD, IERR) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + WRITE(*,*)MYID,':Receiving M2A from',MSGSOU + i=1 + DO WHILE ((i.LE.NSLAVES).AND.(LIST_SLAVES(i).NE.MYID)) + i=i+1 + ENDDO + IF(i.LT.(NSLAVES+1))THEN + NB_LEVEL2=NB_LEVEL2+1 + WRITE(*,*)MYID,':NB_LEVEL2=',NB_LEVEL2 + AMI_CHOSEN=.TRUE. + IF(KEEP_LOAD(73).EQ.1)THEN + IF(.NOT.IS_DISPLAYED)THEN + WRITE(*,*)MYID,': Begin of Incoherent state (2) at time=', + & MPI_WTIME()-TIME_REF + IS_DISPLAYED=.TRUE. + ENDIF + ENDIF + ENDIF + IF(KEEP_LOAD(73).EQ.1) GOTO 344 +#endif +#endif + DO i = 1, NSLAVES +#if defined(OLD_LOAD_MECHANISM) + IF ( LIST_SLAVES(i) /= MYID ) THEN +#endif + LOAD_FLOPS(LIST_SLAVES(i)) = + & LOAD_FLOPS(LIST_SLAVES(i)) + + & LOAD_INCR(i) +#if defined(OLD_LOAD_MECHANISM) + END IF +#endif + END DO + IF ( BDC_MEM ) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) + DO i = 1, NSLAVES +#if defined(OLD_LOAD_MECHANISM) + IF ( LIST_SLAVES(i) /= MYID ) THEN +#endif + DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i)) + + & LOAD_INCR(i) + MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(LIST_SLAVES(i))) +#if defined(OLD_LOAD_MECHANISM) + END IF +#endif + END DO + END IF + IF(WHAT.EQ.19)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) + CALL SMUMPS_819(INODE_RECEIVED) + CB_COST_ID(POS_ID)=INODE_RECEIVED + CB_COST_ID(POS_ID+1)=NSLAVES + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + DO i=1,NSLAVES + WRITE(*,*)MYID,':',LIST_SLAVES(i),'->',LOAD_INCR(i) + CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(LOAD_INCR(i),8) + POS_MEM=POS_MEM+1 + ENDDO + ENDIF +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + 344 CONTINUE +#endif +#endif + NULLIFY( LIST_SLAVES ) + NULLIFY( LOAD_INCR ) + ELSE IF (WHAT == 2 ) THEN + IF ( .not. BDC_POOL ) THEN + WRITE(*,*) "Internal error 2 in SMUMPS_187" + CALL MUMPS_ABORT() + END IF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + POOL_MEM(MSGSOU)=LOAD_RECEIVED + ELSE IF ( WHAT == 3 ) THEN + IF ( .NOT. BDC_SBTR) THEN + WRITE(*,*) "Internal error 3 in SMUMPS_187" + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + SBTR_MEM(MSGSOU)=SBTR_MEM(MSGSOU)+LOAD_RECEIVED +#if ! defined(OLD_LOAD_MECHANISM) + ELSE IF (WHAT == 4) THEN + FUTURE_NIV2(MSGSOU+1)=0 + IF(BDC_MD)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & SURF, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + MD_MEM(MSGSOU)=999999999_8 + TAB_MAXS(MSGSOU)=TAB_MAXS(MSGSOU)+int(SURF,8) + ENDIF +#endif + IF(BDC_M2_MEM.OR.BDC_M2_FLOPS)THEN + ENDIF + ELSE IF (WHAT == 5) THEN + IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN + WRITE(*,*) "Internal error 7 in SMUMPS_187" + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, + & MPI_INTEGER, + & COMM_LD, IERR ) + IF(BDC_M2_MEM) THEN + CALL SMUMPS_816(INODE_RECEIVED) + ELSEIF(BDC_M2_FLOPS) THEN + CALL SMUMPS_817(INODE_RECEIVED) + ENDIF + IF((KEEP_LOAD(81).EQ.2).OR.(KEEP_LOAD(81).EQ.3))THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, + & MPI_INTEGER, + & COMM_LD, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NCB_RECEIVED, 1, + & MPI_INTEGER, + & COMM_LD, IERR ) + IF( + & MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE_RECEIVED)), + & NPROCS).EQ.1 + & )THEN + CB_COST_ID(POS_ID)=INODE_RECEIVED + CB_COST_ID(POS_ID+1)=1 + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + CB_COST_MEM(POS_MEM)=int(MSGSOU,8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(NCB_RECEIVED,8)* + & int(NCB_RECEIVED,8) + POS_MEM=POS_MEM+1 + ENDIF + ENDIF + ELSE IF ( WHAT == 6 ) THEN + IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN + WRITE(*,*) "Internal error 8 in SMUMPS_187" + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(BDC_M2_MEM) THEN + NIV2(MSGSOU+1) = LOAD_RECEIVED + ELSEIF(BDC_M2_FLOPS) THEN + NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED + IF(NIV2(MSGSOU+1).LT.0.0D0)THEN + IF(abs(NIV2(MSGSOU+1)).LE. + & sqrt(epsilon(LOAD_RECEIVED)))THEN + NIV2(MSGSOU+1)=0.0D0 + ELSE + WRITE(*,*)'problem with NIV2_FLOPS message', + & NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + ELSEIF(WHAT == 17)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(BDC_M2_MEM) THEN + NIV2(MSGSOU+1) = LOAD_RECEIVED + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(BDC_MD)THEN +#if ! defined(OLD_LOAD_MECHANISM) + DM_MEM(MYID)=DM_MEM(MYID)+LOAD_RECEIVED +#else + DM_MEM(MYID)=LOAD_RECEIVED +#endif + ELSEIF(BDC_POOL)THEN + POOL_MEM(MSGSOU)=LOAD_RECEIVED + ENDIF + ELSEIF(BDC_M2_FLOPS) THEN + NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED + IF(NIV2(MSGSOU+1).LT.0.0D0)THEN + WRITE(*,*)'problem with NIV2_FLOPS message', + & NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) +#if ! defined(OLD_LOAD_MECHANISM) + LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED +#else + LOAD_FLOPS( MSGSOU ) = LOAD_RECEIVED +#endif + ENDIF + ELSEIF ( WHAT == 7 ) THEN + IF(.NOT.BDC_MD)THEN + WRITE(*,*)MYID,': Internal error 4 + &in SMUMPS_187' + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSLAVES, 1, MPI_INTEGER, + & COMM_LD, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, MPI_INTEGER, + & COMM_LD, IERR ) + LIST_SLAVES => IDWLOAD + LOAD_INCR => WLOAD + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LIST_SLAVES(1), NSLAVES, MPI_INTEGER, + & COMM_LD, IERR) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) + DO i = 1, NSLAVES +#if defined(OLD_LOAD_MECHANISM) + IF ( LIST_SLAVES(i) /= MYID ) THEN +#endif + MD_MEM(LIST_SLAVES(i)) = + & MD_MEM(LIST_SLAVES(i)) + + & int(LOAD_INCR(i),8) +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(LIST_SLAVES(i)+1).EQ.0)THEN + MD_MEM(LIST_SLAVES(i))=999999999_8 + ENDIF +#endif +#if defined(OLD_LOAD_MECHANISM) + END IF +#endif + END DO + ELSEIF ( WHAT == 8 ) THEN + IF(.NOT.BDC_MD)THEN + WRITE(*,*)MYID,': Internal error 5 + &in SMUMPS_187' + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + MD_MEM(MSGSOU)=MD_MEM(MSGSOU)+int(LOAD_RECEIVED,8) +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(MSGSOU+1).EQ.0)THEN + MD_MEM(MSGSOU)=999999999_8 + ENDIF +#endif + ELSEIF ( WHAT == 9 ) THEN + IF(.NOT.BDC_MD)THEN + WRITE(*,*)MYID,': Internal error 6 + &in SMUMPS_187' + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + TAB_MAXS(MSGSOU)=int(LOAD_RECEIVED,8) + ELSE + WRITE(*,*) "Internal error 1 in SMUMPS_187" + CALL MUMPS_ABORT() + END IF + RETURN + END SUBROUTINE SMUMPS_187 + integer function SMUMPS_409 + & (MEM_DISTRIB,CAND, + & K69, + & SLAVEF,MSG_SIZE, + & NMB_OF_CAND ) + implicit none + integer, intent(in) :: K69, SLAVEF + INTEGER, intent(in) :: CAND(SLAVEF+1) + INTEGER, DIMENSION(0:NPROCS - 1), intent(in) :: MEM_DISTRIB + INTEGER, intent(out) :: NMB_OF_CAND + integer i,nless + DOUBLE PRECISION lref + DOUBLE PRECISION MSG_SIZE + nless = 0 + NMB_OF_CAND=CAND(SLAVEF+1) + do i=1,NMB_OF_CAND + WLOAD(i)=LOAD_FLOPS(CAND(i)) + IF(BDC_M2_FLOPS)THEN + WLOAD(i)=WLOAD(i)+NIV2(CAND(i)+1) + ENDIF + end do + IF(K69 .gt. 1) THEN + CALL SMUMPS_426(MEM_DISTRIB,MSG_SIZE, + & CAND,NMB_OF_CAND) + ENDIF + lref = LOAD_FLOPS(MYID) + do i=1, NMB_OF_CAND + if (WLOAD(i).lt.lref) nless=nless+1 + end do + SMUMPS_409 = nless + return + end function SMUMPS_409 + subroutine SMUMPS_384 + & (MEM_DISTRIB,CAND, + & + & SLAVEF, + & nslaves_inode, DEST) + implicit none + integer, intent(in) :: nslaves_inode, SLAVEF + integer, intent(in) :: CAND(SLAVEF+1) + integer, dimension(0:NPROCS - 1), intent(in) :: MEM_DISTRIB + integer, intent(out) :: DEST(CAND(SLAVEF+1)) + integer i,j,NMB_OF_CAND + external MUMPS_558 + NMB_OF_CAND = CAND(SLAVEF+1) + if(nslaves_inode.ge.NPROCS .or. + & nslaves_inode.gt.NMB_OF_CAND) then + write(*,*)'Internal error in SMUMPS_384', + & nslaves_inode, NPROCS, NMB_OF_CAND + CALL MUMPS_ABORT() + end if + if (nslaves_inode.eq.NPROCS-1) then + j=MYID+1 + do i=1,nslaves_inode + if(j.ge.NPROCS) j=0 + DEST(i)=j + j=j+1 + end do + else + do i=1,NMB_OF_CAND + IDWLOAD(i)=i + end do + call MUMPS_558(NMB_OF_CAND, + & WLOAD(1),IDWLOAD(1) ) + do i=1,nslaves_inode + DEST(i)= CAND(IDWLOAD(i)) + end do + IF(BDC_MD)THEN + do i=nslaves_inode+1,NMB_OF_CAND + DEST(i)= CAND(IDWLOAD(i)) + end do + ENDIF + end if + return + end subroutine SMUMPS_384 + SUBROUTINE SMUMPS_425(K69) + IMPLICIT NONE + INTEGER K69 + IF (K69 .LE. 4) THEN + ALPHA = 0.0d0 + BETA = 0.0d0 + RETURN + ENDIF + IF (K69 .EQ. 5) THEN + ALPHA = 0.5d0 + BETA = 50000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 6) THEN + ALPHA = 0.5d0 + BETA = 100000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 7) THEN + ALPHA = 0.5d0 + BETA = 150000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 8) THEN + ALPHA = 1.0d0 + BETA = 50000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 9) THEN + ALPHA = 1.0d0 + BETA = 100000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 10) THEN + ALPHA = 1.0d0 + BETA = 150000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 11) THEN + ALPHA = 1.5d0 + BETA = 50000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 12) THEN + ALPHA = 1.5d0 + BETA = 100000.0d0 + RETURN + ENDIF + ALPHA = 1.5d0 + BETA = 150000.0d0 + RETURN + END SUBROUTINE SMUMPS_425 + SUBROUTINE SMUMPS_426(MEM_DISTRIB,MSG_SIZE,ARRAY_ADM,LEN) + IMPLICIT NONE + INTEGER i,LEN + INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB + DOUBLE PRECISION MSG_SIZE,FORBIGMSG + INTEGER ARRAY_ADM(LEN) + DOUBLE PRECISION MY_LOAD + FORBIGMSG = 1.0d0 + IF (K69 .lt.2) THEN + RETURN + ENDIF + IF(BDC_M2_FLOPS)THEN + MY_LOAD=LOAD_FLOPS(MYID)+NIV2(MYID+1) + ELSE + MY_LOAD=LOAD_FLOPS(MYID) + ENDIF + IF((MSG_SIZE * dble(K35) ) .gt. 3200000.0d0) THEN + FORBIGMSG = 2.0d0 + ENDIF + IF (K69 .le. 4) THEN + DO i = 1,LEN + IF ((MEM_DISTRIB(ARRAY_ADM(i)) .EQ. 1) .AND. + & WLOAD(i) .LT. MY_LOAD ) THEN + WLOAD(i) = WLOAD(i)/MY_LOAD + ELSE + IF ( MEM_DISTRIB(ARRAY_ADM(i)) .NE. 1 ) THEN + WLOAD(i) = WLOAD(i) * + & dble(MEM_DISTRIB(ARRAY_ADM(i))) + & * FORBIGMSG + & + dble(2) + ENDIF + ENDIF + ENDDO + RETURN + ENDIF + DO i = 1,LEN + IF ((MEM_DISTRIB(ARRAY_ADM(i)) .EQ. 1) .AND. + & WLOAD(i) .LT. MY_LOAD ) THEN + WLOAD(i) = WLOAD(i) / MY_LOAD + ELSE + IF(MEM_DISTRIB(ARRAY_ADM(i)) .NE. 1) THEN + WLOAD(i) = (WLOAD(i) + + & ALPHA * MSG_SIZE * dble(K35) + + & BETA) * FORBIGMSG + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_426 + SUBROUTINE SMUMPS_461(MYID, SLAVEF, COMM, + & TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, NSLAVES,INODE) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER, INTENT (IN) :: MYID, SLAVEF, COMM, NASS, NSLAVES + INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2) + INTEGER, INTENT (IN) :: LIST_SLAVES( NSLAVES ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NCB, NFRONT, NBROWS_SLAVE + INTEGER i, IERR,WHAT,INODE + DOUBLE PRECISION MEM_INCREMENT ( NSLAVES ) + DOUBLE PRECISION FLOPS_INCREMENT( NSLAVES ) + DOUBLE PRECISION CB_BAND( NSLAVES ) + IF((KEEP(81).NE.2).AND.(KEEP(81).NE.3))THEN + WHAT=1 + ELSE + WHAT=19 + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + FUTURE_NIV2(MYID+1) = FUTURE_NIV2(MYID+1) - 1 + IF ( FUTURE_NIV2(MYID+1) < 0 ) THEN + WRITE(*,*) "Internal error in SMUMPS_461" + CALL MUMPS_ABORT() + ENDIF + IF ( FUTURE_NIV2(MYID + 1) == 0 ) THEN + 112 CONTINUE + CALL SMUMPS_502(COMM,MYID,SLAVEF, + & dble(MAX_SURF_MASTER),IERR) + IF (IERR == -1 ) THEN + CALL SMUMPS_467(COMM_LD, KEEP) + GOTO 112 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in SMUMPS_461", + & IERR + CALL MUMPS_ABORT() + ENDIF + TAB_MAXS(MYID) = TAB_MAXS(MYID) + int(MAX_SURF_MASTER,8) + ENDIF +#endif + IF ( NSLAVES /= TAB_POS(SLAVEF + 2) ) THEN + write(*,*) "Error 1 in SMUMPS_461", + & NSLAVES, TAB_POS(SLAVEF+2) + CALL MUMPS_ABORT() + ENDIF + NCB = TAB_POS(NSLAVES+1) - 1 + NFRONT = NCB + NASS + DO i = 1, NSLAVES + NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i) + IF ( KEEP(50) == 0 ) THEN + FLOPS_INCREMENT( i ) = (dble(NBROWS_SLAVE)*dble( NASS ))+ + & dble(NBROWS_SLAVE) * dble(NASS) * + & dble(2*NFRONT-NASS-1) + ELSE + FLOPS_INCREMENT( i ) = dble(NBROWS_SLAVE) * dble(NASS ) * + & dble( 2 * ( NASS + TAB_POS(i+1) - 1 ) + & - NBROWS_SLAVE - NASS + 1 ) + ENDIF + IF ( BDC_MEM ) THEN + IF ( KEEP(50) == 0 ) THEN + MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) * + & dble(NFRONT) + ELSE + MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) * + & dble( NASS + TAB_POS(i+1) - 1 ) + END IF + ENDIF + IF((KEEP(81).NE.2).AND.(KEEP(81).NE.3))THEN + CB_BAND(i)=dble(-999999) + ELSE + IF ( KEEP(50) == 0 ) THEN + CB_BAND( i ) = dble(NBROWS_SLAVE) * + & dble(NFRONT-NASS) + ELSE + CB_BAND( i ) = dble(NBROWS_SLAVE) * + & dble(TAB_POS(i+1)-1) + END IF + ENDIF + END DO + IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN + CB_COST_ID(POS_ID)=INODE + CB_COST_ID(POS_ID+1)=NSLAVES + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + DO i=1,NSLAVES + CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(CB_BAND(i),8) + POS_MEM=POS_MEM+1 + ENDDO + ENDIF + 111 CONTINUE + CALL SMUMPS_524(BDC_MEM, COMM, MYID, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & NSLAVES, LIST_SLAVES,INODE, + & MEM_INCREMENT, + & FLOPS_INCREMENT,CB_BAND, WHAT,IERR) + IF ( IERR == -1 ) THEN + CALL SMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in SMUMPS_461", + & IERR + CALL MUMPS_ABORT() + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (FUTURE_NIV2(MYID+1) .NE. 0) THEN +#endif + DO i = 1, NSLAVES + LOAD_FLOPS(LIST_SLAVES(i)) = LOAD_FLOPS(LIST_SLAVES(i)) + & + FLOPS_INCREMENT(i) + IF ( BDC_MEM ) THEN + DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i)) + & + MEM_INCREMENT(i) + END IF + ENDDO +#if ! defined(OLD_LOAD_MECHANISM) + ENDIF +#endif + RETURN + END SUBROUTINE SMUMPS_461 + SUBROUTINE SMUMPS_500( + & POOL, LPOOL, + & PROCNODE, KEEP,KEEP8, SLAVEF, COMM, MYID, STEP, N, + & ND, FILS ) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER LPOOL, SLAVEF, COMM, MYID + INTEGER N, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER POOL( LPOOL ), PROCNODE( KEEP(28) ), STEP( N ) + INTEGER ND( KEEP(28) ), FILS( N ) + INTEGER i, INODE, NELIM, NFR, LEVEL, IERR, WHAT + DOUBLE PRECISION COST + INTEGER NBINSUBTREE,NBTOP,INSUBTREE + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + IF(BDC_MD)THEN + RETURN + ENDIF + IF((KEEP(76).EQ.0).OR.(KEEP(76).EQ.2))THEN + IF(NBTOP.NE.0)THEN + DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3) + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ELSE + DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1 + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ENDIF + ELSE + IF(KEEP(76).EQ.1)THEN + IF(INSUBTREE.EQ.1)THEN + DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1 + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ELSE + DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3) + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ENDIF + ELSE + WRITE(*,*) + & 'Internal error: Unknown pool management strategy' + CALL MUMPS_ABORT() + ENDIF + ENDIF + 20 CONTINUE + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS(i) + GOTO 10 + ENDIF + NFR = ND( STEP(INODE) ) + LEVEL = MUMPS_330( PROCNODE(STEP(INODE)), SLAVEF ) + IF (LEVEL .EQ. 1) THEN + COST = dble( NFR ) * dble( NFR ) + ELSE + IF ( KEEP(50) == 0 ) THEN + COST = dble( NFR ) * dble( NELIM ) + ELSE + COST = dble( NELIM ) * dble( NELIM ) + ENDIF + ENDIF + 30 CONTINUE + IF ( abs(POOL_LAST_COST_SENT-COST).GT.DM_THRES_MEM ) THEN + WHAT = 2 + 111 CONTINUE + CALL SMUMPS_460( WHAT, + & COMM, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & COST, dble(0),MYID, IERR ) + POOL_LAST_COST_SENT = COST + POOL_MEM(MYID)=COST + IF ( IERR == -1 )THEN + CALL SMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in SMUMPS_500", + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_500 + SUBROUTINE SMUMPS_501( + & OK,INODE,POOL,LPOOL,MYID,SLAVEF,COMM,KEEP,KEEP8) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER LPOOL,MYID,SLAVEF,COMM,INODE + INTEGER POOL(LPOOL),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER WHAT,IERR + LOGICAL OK + DOUBLE PRECISION COST + LOGICAL FLAG + EXTERNAL MUMPS_283,MUMPS_170 + LOGICAL MUMPS_283,MUMPS_170 + IF((INODE.LE.0).OR.(INODE.GT.N_LOAD)) THEN + RETURN + ENDIF + IF (.NOT.MUMPS_170( + & PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS) + & ) THEN + RETURN + ENDIF + IF(MUMPS_283(PROCNODE_LOAD(STEP_LOAD(INODE)),NPROCS))THEN + IF(NE_LOAD(STEP_LOAD(INODE)).EQ.0)THEN + RETURN + ENDIF + ENDIF + FLAG=.FALSE. + IF(INDICE_SBTR.LE.NB_SUBTREES)THEN + IF(INODE.EQ.MY_FIRST_LEAF(INDICE_SBTR))THEN + FLAG=.TRUE. + ENDIF + ENDIF + IF(FLAG)THEN + SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY)=MEM_SUBTREE(INDICE_SBTR) + SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY)=SBTR_CUR(MYID) + INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY+1 + WHAT = 3 + IF(dble(MEM_SUBTREE(INDICE_SBTR)).GE.DM_THRES_MEM)THEN + 111 CONTINUE + CALL SMUMPS_460( + & WHAT, COMM, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & dble(MEM_SUBTREE(INDICE_SBTR)), dble(0),MYID, IERR ) + IF ( IERR == -1 )THEN + CALL SMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) + & "Internal Error 1 in SMUMPS_501", + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + SBTR_MEM(MYID)=SBTR_MEM(MYID)+ + & dble(MEM_SUBTREE(INDICE_SBTR)) + INDICE_SBTR=INDICE_SBTR+1 + IF(INSIDE_SUBTREE.EQ.0)THEN + INSIDE_SUBTREE=1 + ENDIF + ELSE + IF(INODE.EQ.MY_ROOT_SBTR(INDICE_SBTR-1))THEN + WHAT = 3 + COST=-SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY-1) + IF(abs(COST).GE.DM_THRES_MEM)THEN + 112 CONTINUE + CALL SMUMPS_460( + & WHAT, COMM, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & COST, dble(0) ,MYID,IERR ) + IF ( IERR == -1 )THEN + CALL SMUMPS_467(COMM_LD, KEEP) + GOTO 112 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) + & "Internal Error 3 in SMUMPS_501", + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY-1 + SBTR_MEM(MYID)=SBTR_MEM(MYID)- + & SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY) + SBTR_CUR(MYID)=SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY) + IF(INDICE_SBTR_ARRAY.EQ.1)THEN + SBTR_CUR(MYID)=dble(0) + INSIDE_SUBTREE=0 + ENDIF + ENDIF + ENDIF + CONTINUE + END SUBROUTINE SMUMPS_501 + SUBROUTINE SMUMPS_504 + & (SLAVEF,KEEP,KEEP8,PROCS,MEM_DISTRIB,NCB,NFRONT, + & NSLAVES_NODE,TAB_POS, + & SLAVES_LIST,SIZE_SLAVES_LIST,MYID) + IMPLICIT NONE + INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST + INTEGER(8) KEEP8(150) + INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID + INTEGER, intent(in) :: PROCS(SLAVEF+1) + INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1) + INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST) + INTEGER, intent(out):: TAB_POS(SLAVEF+2) + INTEGER, intent(out):: NSLAVES_NODE + INTEGER NUMBER_OF_PROCS,K47, K48, K50 + INTEGER(8) :: K821 + DOUBLE PRECISION DK821 + INTEGER J + INTEGER KMIN, KMAX + INTEGER OTHERS,CHOSEN,SMALL_SET,ACC + DOUBLE PRECISION SOMME,TMP_SUM + INTEGER AFFECTED + INTEGER ADDITIONNAL_ROWS,i,X,REF,POS + INTEGER(8)::TOTAL_MEM + LOGICAL FORCE_CAND + DOUBLE PRECISION TEMP(SLAVEF),PEAK + INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF) + EXTERNAL MPI_WTIME + DOUBLE PRECISION MPI_WTIME + IF (KEEP8(21) .GT. 0_8) THEN + write(*,*)MYID, + & ": Internal Error 1 in SMUMPS_504" + CALL MUMPS_ABORT() + ENDIF + K821=abs(KEEP8(21)) + DK821=dble(K821) + K50=KEEP(50) + K48=KEEP(48) + K47=KEEP(47) + IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN + FORCE_CAND = .FALSE. + ELSE + FORCE_CAND = (mod(KEEP(24),2).eq.0) + END IF + IF(K48.NE.4)THEN + WRITE(*,*)'SMUMPS_COMPUTE_PARTI_ACTV_MEM_K821 + & should be called with KEEP(48) different from 4' + CALL MUMPS_ABORT() + ENDIF + KMIN=1 + KMAX=int(K821/int(NFRONT,8)) + IF(FORCE_CAND)THEN + DO i=1,PROCS(SLAVEF+1) + WLOAD(i)=DM_MEM(PROCS(i)) + IDWLOAD(i)=PROCS(i) + ENDDO + NUMBER_OF_PROCS=PROCS(SLAVEF+1) + OTHERS=NUMBER_OF_PROCS + ELSE + NUMBER_OF_PROCS=SLAVEF + WLOAD(1:SLAVEF) = DM_MEM(0:NUMBER_OF_PROCS-1) + DO i=1,NUMBER_OF_PROCS + IDWLOAD(i) = i - 1 + ENDDO + OTHERS=NUMBER_OF_PROCS-1 + ENDIF + NB_ROWS=0 + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, IDWLOAD) + TOTAL_MEM=int(NCB,8)*int(NFRONT,8) + SOMME=dble(0) + J=1 + PEAK=dble(0) + DO i=1,NUMBER_OF_PROCS + IF((IDWLOAD(i).NE.MYID))THEN + PEAK=max(PEAK,WLOAD(i)) + TEMP_ID(J)=IDWLOAD(i) + TEMP(J)=WLOAD(i) + IF(BDC_SBTR)THEN + TEMP(J)=TEMP(J)+SBTR_MEM(IDWLOAD(i))- + & SBTR_CUR(IDWLOAD(i)) + ENDIF + IF(BDC_POOL)THEN + TEMP(J)=TEMP(J)+POOL_MEM(TEMP_ID(J)) + ENDIF + IF(BDC_M2_MEM)THEN + TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1) + ENDIF + J=J+1 + ENDIF + ENDDO + NUMBER_OF_PROCS=J-1 + CALL MUMPS_558(NUMBER_OF_PROCS, TEMP, TEMP_ID) + IF(K50.EQ.0)THEN + PEAK=max(PEAK, + & DM_MEM(MYID)+dble(NFRONT)*dble(NFRONT-NCB)) + ELSE + PEAK=max(PEAK, + & DM_MEM(MYID)+dble(NFRONT-NCB)*dble(NFRONT-NCB)) + ENDIF + PEAK=max(PEAK,TEMP(OTHERS)) + SOMME=dble(0) + DO i=1,NUMBER_OF_PROCS + SOMME=SOMME+TEMP(OTHERS)-TEMP(i) + ENDDO + IF(SOMME.LE.dble(TOTAL_MEM)) THEN + GOTO 096 + ENDIF + 096 CONTINUE + SOMME=dble(0) + DO i=1,OTHERS + SOMME=SOMME+TEMP(OTHERS)-TEMP(i) + ENDDO + IF(dble(TOTAL_MEM).GE.SOMME) THEN +#if defined (OLD_PART) + 887 CONTINUE +#endif + AFFECTED=0 + CHOSEN=0 + ACC=0 + DO i=1,OTHERS + IF(K50.EQ.0)THEN + IF((TEMP(OTHERS)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(OTHERS)-TEMP(i) + ENDIF + X=int(TMP_SUM/dble(NFRONT)) + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + IF((TEMP(OTHERS)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(OTHERS)-TEMP(i) + ENDIF + X=int((-dble(NFRONT-NCB+ACC) + & +sqrt(((dble(NFRONT-NCB+ACC)* + & dble(NFRONT-NCB+ACC))+dble(4)* + & (TMP_SUM))))/ + & dble(2)) + IF((ACC+X).GT.NCB) X=NCB-ACC + IF(X.LE.0) THEN + WRITE(*,*)"Internal Error 2 in + & SMUMPS_504" + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_ROWS(i)=X + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB-ACC.LT.KMIN) GOTO 111 + IF(NCB.EQ.ACC) GOTO 111 + ENDDO + 111 CONTINUE + IF((ACC.GT.NCB))THEN + X=0 + DO i=1,OTHERS + X=X+NB_ROWS(i) + ENDDO + WRITE(*,*)'NCB=',NCB,',SOMME=',X + WRITE(*,*)MYID, + & ": Internal Error 3 in SMUMPS_504" + CALL MUMPS_ABORT() + ENDIF + IF((NCB.NE.ACC))THEN + IF(K50.NE.0)THEN + IF(CHOSEN.NE.0)THEN + ADDITIONNAL_ROWS=NCB-ACC + NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+ADDITIONNAL_ROWS + ELSE + TMP_SUM=dble(TOTAL_MEM)/dble(NUMBER_OF_PROCS) + CHOSEN=0 + ACC=0 + DO i=1,OTHERS + X=int((-dble(NFRONT-NCB+ACC) + & +sqrt(((dble(NFRONT-NCB+ACC)* + & dble(NFRONT-NCB+ACC))+dble(4)* + & (TMP_SUM))))/ + & dble(2)) + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB-ACC.LT.KMIN) GOTO 002 + IF(NCB.EQ.ACC) GOTO 002 + ENDDO + 002 CONTINUE + IF(ACC.LT.NCB)THEN + NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+(NCB-ACC) + ENDIF + ENDIF + GOTO 333 + ENDIF + ADDITIONNAL_ROWS=NCB-ACC + DO i=CHOSEN,1,-1 + IF(int(dble(ADDITIONNAL_ROWS)/ + & dble(i)).NE.0)THEN + GOTO 222 + ENDIF + ENDDO + 222 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(i)) + DO J=1,i + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDDO + IF(ADDITIONNAL_ROWS.NE.0) THEN + NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS + ENDIF + ENDIF + 333 CONTINUE + IF(NB_ROWS(CHOSEN).EQ.0) CHOSEN=CHOSEN-1 + GOTO 889 + ELSE + DO i=OTHERS,1,-1 + SOMME=dble(0) + DO J=1,i + SOMME=SOMME+TEMP(J) + ENDDO + SOMME=(dble(i)*TEMP(i))-SOMME + IF(dble(TOTAL_MEM).GE.SOMME) GOTO 444 + ENDDO + 444 CONTINUE + REF=i + DO J=1,i + IF(TEMP(J).EQ.TEMP(i)) THEN + SMALL_SET=J + GOTO 123 + ENDIF + ENDDO + 123 CONTINUE + IF(i.EQ.1)THEN + NB_ROWS(i)=NCB + CHOSEN=1 + GOTO 666 + ENDIF + 323 CONTINUE + AFFECTED=0 + CHOSEN=0 + ACC=0 + DO i=1,SMALL_SET + IF(K50.EQ.0)THEN + IF((TEMP(SMALL_SET)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(SMALL_SET)-TEMP(i) + ENDIF + X=int(TMP_SUM/dble(NFRONT)) + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + IF((TEMP(SMALL_SET)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(SMALL_SET)-TEMP(i) + ENDIF + X=int((-dble(NFRONT-NCB+ACC) + & +sqrt(((dble(NFRONT-NCB+ACC)* + & dble(NFRONT-NCB+ACC))+dble(4)* + & (TMP_SUM))))/ + & dble(2)) + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 4 in SMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + NB_ROWS(i)=X + ACC=ACC+X + CHOSEN=CHOSEN+1 + IF(NCB-ACC.LT.KMIN) GOTO 888 + IF(NCB.EQ.ACC) GOTO 888 + IF(ACC.GT.NCB) THEN + WRITE(*,*)MYID, + & ': Internal error 5 in SMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ENDDO + 888 CONTINUE + SOMME=dble(0) + X=NFRONT-NCB + IF((ACC.GT.NCB))THEN + WRITE(*,*)MYID, + & ':Internal error 6 in SMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF((ACC.LT.NCB))THEN + IF(K50.NE.0)THEN + IF(SMALL_SET.LT.OTHERS)THEN + SMALL_SET=REF+1 + REF=SMALL_SET + GOTO 323 + ELSE + NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+NCB-ACC + GOTO 666 + ENDIF + ENDIF + ADDITIONNAL_ROWS=NCB-ACC +#if ! defined (OLD_PART) + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + J=1 +#if ! defined (PART1_) + X=int(ADDITIONNAL_ROWS/(i-1)) + IF((X.EQ.0).AND.(ADDITIONNAL_ROWS.NE.0))THEN + DO WHILE ((J.LT.i).AND.(ADDITIONNAL_ROWS.GT.0)) + NB_ROWS(J)=NB_ROWS(J)+1 + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 + J=J+1 + ENDDO + IF(ADDITIONNAL_ROWS.NE.0)THEN + WRITE(*,*)MYID, + & ':Internal error 7 in SMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + GOTO 047 + ENDIF + IF((TEMP(1)+dble((NB_ROWS(1)+X)*NFRONT)).LE. + & TEMP(i))THEN + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + AFFECTED=X + IF((AFFECTED+NB_ROWS(J)).GT. + & KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & AFFECTED + J=J+1 + ENDDO + ELSE +#endif + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LE.i)) + AFFECTED=int((TEMP(i)-(TEMP(J)+ + & (dble(NB_ROWS(J))*dble(NFRONT)))) + & /dble(NFRONT)) + IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + ENDIF + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + J=J+1 + ENDDO +#if ! defined (PART1_) + ENDIF +#endif + i=i+1 + ENDDO + 047 CONTINUE + IF((ADDITIONNAL_ROWS.EQ.0).AND. + & (i.LT.NUMBER_OF_PROCS))THEN + CHOSEN=i-1 + ELSE + CHOSEN=i-2 + ENDIF +#if ! defined (PART1_) + IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. + & (ADDITIONNAL_ROWS.NE.0))THEN + DO i=1,CHOSEN + NB_ROWS(i)=NB_ROWS(i)+1 + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 048 + ENDDO + 048 CONTINUE + ENDIF +#endif + IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. + & (ADDITIONNAL_ROWS.NE.0))THEN + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LE.i)) + AFFECTED=int((TEMP(i)-(TEMP(J)+ + & (dble(NB_ROWS(J))* + & dble(NFRONT))))/dble(NFRONT)) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + J=J+1 + ENDDO + i=i+1 + ENDDO + CHOSEN=i-2 + ENDIF + CONTINUE +#else + DO i=CHOSEN,1,-1 + IF(int(dble(ADDITIONNAL_ROWS)/ + & dble(i)).NE.0)THEN + GOTO 555 + ENDIF + ENDDO + 555 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(i)) + DO J=1,i + IF(NB_ROWS(J)+X.GT.K821/NCB)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & ((K821/NCB)-NB_ROWS(J)) + NB_ROWS(J)=(K821/NFRONT) + ELSE IF ((TEMP(J)+dble((NB_ROWS(J)+X))* + & dble(NFRONT)).GT. + & PEAK)THEN + AFFECTED=int((PEAK-(TEMP(J)+dble(NB_ROWS(J))* + & dble(NFRONT))/dble(NFRONT)) + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ELSE + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDIF + IF(((TEMP(J)+dble(NB_ROWS(J))*dble(NFRONT)) + & .GT. PEAK) + & .AND.(SMALL_SET.LT.OTHERS))THEN + WRITE(*,*)MYID, + & ':Internal error 8 in SMUMPS_504' + SMALL_SET=SMALL_SET+1 + CALL MUMPS_ABORT() + ENDIF + ENDDO + SOMME=dble(0) + DO J=1,CHOSEN + SOMME=SOMME+NB_ROWS(J) + ENDDO + IF(ADDITIONNAL_ROWS.NE.0) THEN + DO J=1,CHOSEN + IF(NB_ROWS(J).LT.0)THEN + WRITE(*,*)MYID, + & ':Internal error 9 in SMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF ((TEMP(J)+dble(NB_ROWS(J)) + & *dble(NFRONT)).GT. + & PEAK)THEN + WRITE(*,*)MYID, + & ':Internal error 10 in SMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF ((TEMP(J)+dble(NB_ROWS(J)+ + & ADDITIONNAL_ROWS)*dble(NFRONT)).GE. + & PEAK)THEN + AFFECTED=int((PEAK-(TEMP(J)+ + & dble(NB_ROWS(J))* + & dble(NFRONT))/dble(NFRONT)) + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + IF((TEMP(J)+dble(NFRONT)* + & dble(NB_ROWS(J))).GT. + & PEAK)THEN + WRITE(*,*)MYID, + & ':Internal error 11 in SMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ELSE + NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 666 + ENDDO + IF(SMALL_SET.EQ.(NUMBER_OF_PROCS)) THEN + NB_ROWS=0 + GOTO 887 + ENDIF + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF(NB_ROWS(i)+ADDITIONNAL_ROWS.LT.K821/NFRONT) + & THEN + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-(K821/ + & NFRONT + & -NB_ROWS(i)) + NB_ROWS(i)=K821/NFRONT + ENDIF + i=i+1 + ENDDO + CHOSEN=i-1 + IF(ADDITIONNAL_ROWS.NE.0)THEN + DO i=CHOSEN,1,-1 + IF(int(dble(ADDITIONNAL_ROWS)/dble(i)) + & .NE.0)THEN + GOTO 372 + ENDIF + ENDDO + 372 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(i)) + DO J=1,i + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDDO + IF(ADDITIONNAL_ROWS.NE.0) THEN + NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS + ENDIF + ENDIF + ENDIF +#endif + ENDIF + 666 CONTINUE + SOMME=dble(0) + X=0 + POS=0 + DO i=1,CHOSEN + IF(K50.NE.0) THEN + IF((TEMP(i)+dble(NB_ROWS(i)) + & *dble(X+NB_ROWS(i)+NFRONT-NCB)) + & .GT.PEAK)THEN + SMALL_SET=SMALL_SET+1 + ENDIF + ENDIF + IF(K50.EQ.0) THEN + IF((TEMP(i)+dble(NB_ROWS(i))*dble(NFRONT)) + & .GT.PEAK)THEN + SMALL_SET=SMALL_SET+1 + ENDIF + ENDIF + X=X+NB_ROWS(i) + SOMME=SOMME+ dble(NB_ROWS(i)) + ENDDO + ENDIF + 889 CONTINUE + J=CHOSEN + X=0 + DO i=J,1,-1 + IF(NB_ROWS(i).EQ.0)THEN + IF(X.EQ.1)THEN + WRITE(*,*)MYID, + & ':Internal error 12 in SMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + CHOSEN=CHOSEN-1 + ELSE + IF(NB_ROWS(i).GT.0)THEN + X=1 + ELSE + WRITE(*,*) + & 'Internal error 13 in SMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDDO + NSLAVES_NODE=CHOSEN + TAB_POS(NSLAVES_NODE+1)= NCB+1 + TAB_POS(SLAVEF+2) = CHOSEN + POS=1 + DO i=1,CHOSEN + SLAVES_LIST(i)=TEMP_ID(i) + TAB_POS(i)=POS + POS=POS+NB_ROWS(i) + IF(NB_ROWS(i).LE.0)THEN + WRITE(*,*) + & 'Internal error 14 in SMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ENDDO + DO i=CHOSEN+1,NUMBER_OF_PROCS + SLAVES_LIST(i)=TEMP_ID(i) + ENDDO + IF(POS.NE.(NCB+1))THEN + WRITE(*,*) + & 'Internal error 15 in SMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + END SUBROUTINE SMUMPS_504 + SUBROUTINE SMUMPS_518 + & (NCBSON_MAX,SLAVEF,KEEP,KEEP8, + & PROCS,MEM_DISTRIB,NCB,NFRONT, + & NSLAVES_NODE,TAB_POS, + & SLAVES_LIST,SIZE_SLAVES_LIST,MYID,INODE,MP,LP) + IMPLICIT NONE + INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST + INTEGER(8) KEEP8(150) + INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID + INTEGER, intent(in) :: NCBSON_MAX + INTEGER, intent(in) :: PROCS(SLAVEF+1) + INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1),INODE + INTEGER, intent(in) :: MP,LP + INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST) + INTEGER, intent(out):: TAB_POS(SLAVEF+2) + INTEGER, intent(out):: NSLAVES_NODE + INTEGER NUMBER_OF_PROCS,K47,K48, K50,K83,K69 + INTEGER(8) :: K821 + INTEGER J + INTEGER KMIN, KMAX + INTEGER OTHERS,CHOSEN,SMALL_SET,ACC + DOUBLE PRECISION SOMME,TMP_SUM,DELTA,A,B,C,MASTER_WORK + INTEGER AFFECTED + INTEGER ADDITIONNAL_ROWS,i,X,REF,POS,NELIM + INTEGER(8) X8 + LOGICAL FORCE_CAND,SMP + DOUBLE PRECISION BANDE_K821 + INTEGER NB_SAT,NB_ZERO + DOUBLE PRECISION TEMP(SLAVEF),TOTAL_COST, MAX_MEM_ALLOW + INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF) + INTEGER NSLAVES_REF,NCB_FILS + EXTERNAL MPI_WTIME,MUMPS_442 + INTEGER MUMPS_442 + INTEGER POS_MIN_LOAD,SIZE_MY_SMP,WHAT,ADDITIONNAL_ROWS_SPECIAL + LOGICAL HAVE_TYPE1_SON + DOUBLE PRECISION MIN_LOAD,MAX_LOAD,TEMP_MAX_LOAD + DOUBLE PRECISION MPI_WTIME + DOUBLE PRECISION BUF_SIZE,NELIM_MEM_SIZE + DOUBLE PRECISION MEM_SIZE_STRONG(SLAVEF),MEM_SIZE_WEAK(SLAVEF) + K821=abs(KEEP8(21)) + TEMP_MAX_LOAD=dble(0) + K50=KEEP(50) + K48=KEEP(48) + K47=KEEP(47) + K83=KEEP(83) + K69=0 + NCB_FILS=NCBSON_MAX + IF(int(NCB_FILS,8)*int(min(NCB,NCB_FILS),8).GT.K821)THEN + HAVE_TYPE1_SON=.TRUE. + ELSE + HAVE_TYPE1_SON=.FALSE. + ENDIF + SMP=(K69.NE.0) + IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN + FORCE_CAND = .FALSE. + ELSE + FORCE_CAND = (mod(KEEP(24),2).eq.0) + END IF + NELIM=NFRONT-NCB + KMAX=int(K821/int(NCB,8)) + IF(FORCE_CAND)THEN + DO i=1,PROCS(SLAVEF+1) + WLOAD(i)=LOAD_FLOPS(PROCS(i)) + IDWLOAD(i)=PROCS(i) + IF (WLOAD(i) < -0.5d0 ) THEN + IF((MP.GT.0).AND.(LP.GE.2))THEN + WRITE(MP,*)MYID,': Warning: negative load ', + & WLOAD(i) + ENDIF + ENDIF + WLOAD(i)=max(WLOAD(i),0.0d0) + ENDDO + NUMBER_OF_PROCS=PROCS(SLAVEF+1) + OTHERS=NUMBER_OF_PROCS + ELSE + NUMBER_OF_PROCS=SLAVEF + WLOAD(1:SLAVEF) = LOAD_FLOPS(0:NUMBER_OF_PROCS-1) + DO i=1,NUMBER_OF_PROCS + IDWLOAD(i) = i - 1 + IF (WLOAD(i) < -0.5d0 ) THEN + IF((MP.GT.0).AND.(LP.GE.2))THEN + WRITE(MP,*)MYID,': Negative load ', + & WLOAD(i) + ENDIF + ENDIF + WLOAD(i)=max(WLOAD(i),0.0d0) + ENDDO + OTHERS=NUMBER_OF_PROCS-1 + ENDIF + KMAX=int(NCB/OTHERS) + KMIN=MUMPS_442(int(NCB,8)*int(KMAX,8),K50,KMAX,NCB) + NB_ROWS=0 + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, IDWLOAD) + IF(K50.EQ.0)THEN + TOTAL_COST=dble( NELIM ) * dble ( NCB ) + + & dble(NCB) * dble(NELIM)*dble(2*NFRONT-NELIM-1) + ELSE + TOTAL_COST=dble(NELIM) * dble ( NCB ) * + & dble(NFRONT+1) + ENDIF + CALL MUMPS_511(NFRONT,NELIM,NELIM,K50, + & 2,MASTER_WORK) + SOMME=dble(0) + J=1 + IF(FORCE_CAND.AND.(NUMBER_OF_PROCS.GT.K83))THEN + MASTER_WORK=dble(KEEP(88))*MASTER_WORK/dble(100) + ENDIF + IF(FORCE_CAND.AND.(NUMBER_OF_PROCS.LE.K83))THEN + MASTER_WORK=dble(KEEP(87))*MASTER_WORK/dble(100) + ENDIF + IF(MASTER_WORK.LT.dble(1))THEN + MASTER_WORK=dble(1) + ENDIF + NSLAVES_REF=int(TOTAL_COST/MASTER_WORK)+1 + IF(FORCE_CAND)THEN + NSLAVES_REF=min(NSLAVES_REF,NUMBER_OF_PROCS) + ELSE + NSLAVES_REF=min(NSLAVES_REF,NUMBER_OF_PROCS-1) + ENDIF + DO i=1,NUMBER_OF_PROCS + IF((IDWLOAD(i).NE.MYID))THEN + TEMP_ID(J)=IDWLOAD(i) + TEMP(J)=WLOAD(i) + IF(BDC_M2_FLOPS)THEN + TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1) + ENDIF + J=J+1 + ENDIF + ENDDO + NUMBER_OF_PROCS=J-1 + CALL MUMPS_558(NUMBER_OF_PROCS, TEMP, TEMP_ID) + SOMME=dble(0) + TMP_SUM=dble(0) + DO i=1,OTHERS + SOMME=SOMME+TEMP(OTHERS)-TEMP(i) + TMP_SUM=TMP_SUM+TEMP(i) + ENDDO + TMP_SUM=(TMP_SUM/dble(OTHERS))+ + & (TOTAL_COST/dble(OTHERS)) + SIZE_MY_SMP=OTHERS + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + IF(.NOT.SMP) MAX_LOAD=TEMP(OTHERS) + IF(SMP)THEN + J=1 + DO i=1,OTHERS + IF(MEM_DISTRIB(TEMP_ID(i)).EQ.1)THEN + IF(TEMP(i).LE.TMP_SUM)THEN + WLOAD(J)=TEMP(i) + IDWLOAD(J)=TEMP_ID(i) + J=J+1 + ELSE + ENDIF + ENDIF + ENDDO + MAX_LOAD=WLOAD(J-1) + SIZE_MY_SMP=J-1 + DO i=1,OTHERS + IF((MEM_DISTRIB(TEMP_ID(i)).NE.1).OR. + & ((MEM_DISTRIB(TEMP_ID(i)).EQ.1).AND. + & (TEMP(i).GE.TMP_SUM)))THEN + WLOAD(J)=TEMP(i) + IDWLOAD(J)=TEMP_ID(i) + J=J+1 + ENDIF + ENDDO + TEMP=WLOAD + TEMP_ID=IDWLOAD + ENDIF + IF(BDC_MD)THEN + BUF_SIZE=dble(K821) + IF (KEEP(201).EQ.2) THEN + A=dble(int((dble(KEEP(100))/dble(2))/dble(NELIM))) + IF(K50.EQ.0)THEN + BUF_SIZE=min(BUF_SIZE,A*dble(NCB)) + ELSE + BUF_SIZE=min(BUF_SIZE,A*A) + ENDIF + ENDIF + BUF_SIZE=dble(K821) + DO i=1,NUMBER_OF_PROCS + A=dble(MD_MEM(TEMP_ID(i)))/ + & dble(NELIM) + A=A*dble(NFRONT) + IF(K50.EQ.0)THEN + B=dble(int(dble(NCB)/dble(NUMBER_OF_PROCS))+1)* + & dble(NFRONT) + ELSE + WHAT = 5 +#if ! defined (OOC_PAR_MEM_SLAVE_SELECT) && ! defined (OOC_PAR_MEM2) + CALL MUMPS_503(WHAT, KEEP,KEEP8, NCB, + & NFRONT, min(NCB,OTHERS), J, X8) +#endif + B=dble(X8)+(dble(J)*dble(NELIM)) + ENDIF + NELIM_MEM_SIZE=A+B + MEM_SIZE_WEAK(i)=NELIM_MEM_SIZE + IF((SBTR_WHICH_M.EQ.0).OR.(.NOT.BDC_SBTR))THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i)) + ENDIF + ELSE + IF(BDC_SBTR)THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ENDIF + ENDIF + ENDIF + IF(min(MEM_SIZE_STRONG(i),MEM_SIZE_WEAK(i)).LT.dble(0))THEN + IF(MEM_SIZE_STRONG(i).LT.0.0d0)THEN + MEM_SIZE_STRONG(i)=dble(0) + ELSE + MEM_SIZE_WEAK(i)=dble(0) + ENDIF + ENDIF + ENDDO + ELSE + BUF_SIZE=dble(K821) + DO i=1,NUMBER_OF_PROCS + IF((SBTR_WHICH_M.EQ.0).OR.(.NOT.BDC_SBTR))THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i)) + ENDIF + ELSE + IF(BDC_SBTR)THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ENDIF + ENDIF + ENDIF + MEM_SIZE_STRONG(i)=max(dble(0),MEM_SIZE_STRONG(i)) + MEM_SIZE_WEAK(i)=huge(MEM_SIZE_WEAK(i)) + ENDDO + ENDIF + IF((((NUMBER_OF_PROCS.LE.K83).AND.FORCE_CAND).AND. + & (TOTAL_COST.GE.SOMME)).OR. + & (.NOT.FORCE_CAND).OR. + & (((NUMBER_OF_PROCS+1).GT.K83).AND.FORCE_CAND))THEN + REF=NSLAVES_REF + SMALL_SET=NSLAVES_REF + IF(.NOT.SMP)THEN + DO i=NSLAVES_REF,1,-1 + SOMME=dble(0) + DO J=1,i + SOMME=SOMME+TEMP(J) + ENDDO + SOMME=(dble(i)*TEMP(i))-SOMME + IF(TOTAL_COST.GE.SOMME) GOTO 444 + ENDDO + 444 CONTINUE + REF=i + SMALL_SET=REF + MAX_LOAD=TEMP(SMALL_SET) + ELSE + X=min(SIZE_MY_SMP,NSLAVES_REF) + 450 CONTINUE + SOMME=dble(0) + DO J=1,X + SOMME=SOMME+(TEMP(X)-TEMP(J)) + ENDDO + IF(SOMME.GT.TOTAL_COST)THEN + X=X-1 + GOTO 450 + ELSE + IF(X.LT.SIZE_MY_SMP) THEN + REF=X + SMALL_SET=REF + MAX_LOAD=TEMP(SMALL_SET) + ELSE + X=min(SIZE_MY_SMP,NSLAVES_REF) + J=X+1 + MAX_LOAD=TEMP(X) + TMP_SUM=MAX_LOAD + DO i=X+1,OTHERS + IF(TEMP(i).GT.MAX_LOAD)THEN + SOMME=SOMME+(dble(i-1)*(TEMP(i)-MAX_LOAD)) + TMP_SUM=MAX_LOAD + MAX_LOAD=TEMP(i) + ELSE + SOMME=SOMME+(MAX_LOAD-TEMP(i)) + ENDIF + IF(i.EQ.NSLAVES_REF)THEN + SMALL_SET=NSLAVES_REF + REF=SMALL_SET + GOTO 323 + ENDIF + IF(SOMME.GT.TOTAL_COST)THEN + REF=i-1 + SMALL_SET=i-1 + MAX_LOAD=TMP_SUM + GOTO 323 + ENDIF + ENDDO + ENDIF + ENDIF + ENDIF + 323 CONTINUE + MAX_LOAD=dble(0) + DO i=1,SMALL_SET + MAX_LOAD=max(MAX_LOAD,TEMP(i)) + ENDDO + TEMP_MAX_LOAD=MAX_LOAD + NB_ROWS=0 + TMP_SUM=dble(0) + CHOSEN=0 + ACC=0 + NB_SAT=0 + NB_ZERO=0 + DO i=1,SMALL_SET + IF(K50.EQ.0)THEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + IF(HAVE_TYPE1_SON)THEN + IF(K50.EQ.0)THEN + X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + IF(K50.EQ.0)THEN + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + X=int((MAX_LOAD-TEMP(i))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.KMIN)THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*(dble(NELIM)+dble(2*ACC+1)) + C=-(MAX_LOAD-TEMP(i)) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 1 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.KMIN)THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + NB_ROWS(i)=X + ACC=ACC+X + CHOSEN=CHOSEN+1 + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + TMP_SUM=MAX_LOAD + IF(K50.EQ.0)THEN + MAX_LOAD=max(MAX_LOAD, + & (TEMP(i)+(dble(NELIM) * + & dble(NB_ROWS(i)))+ + & (dble(NB_ROWS(i))*dble(NELIM)* + & dble(2*NFRONT-NELIM-1)))) + ELSE + MAX_LOAD=max(MAX_LOAD, + & TEMP(i)+(dble(NELIM) * dble(NB_ROWS(i)))* + & dble(2*(NELIM+ACC)-NB_ROWS(i) + & -NELIM+1)) + ENDIF + IF(TMP_SUM.LT.MAX_LOAD)THEN + ENDIF + IF(NCB-ACC.LT.KMIN) GOTO 888 + IF(NCB.EQ.ACC) GOTO 888 + IF(ACC.GT.NCB) THEN + WRITE(*,*)MYID, + & ': Internal error 2 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + ENDDO + 888 CONTINUE + SOMME=dble(0) + X=NFRONT-NCB + IF((ACC.GT.NCB))THEN + WRITE(*,*)MYID, + & ': Internal error 3 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF((ACC.LT.NCB))THEN + IF(K50.NE.0)THEN + IF(SMALL_SET.LE.OTHERS)THEN + IF((NB_SAT.EQ.SMALL_SET).AND.(SMALL_SET.LT. + & NSLAVES_REF))THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ADDITIONNAL_ROWS_SPECIAL=NCB-ACC + DO i=1,SMALL_SET + MAX_LOAD=TEMP_MAX_LOAD + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)* + & dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS-NELIM + & +1) + SOMME=SOMME/dble(SMALL_SET-NB_SAT) + NB_ROWS=0 + NB_ZERO=0 + ACC=0 + CHOSEN=0 + NB_SAT=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO J=1,SMALL_SET + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=(dble(NELIM)*dble(NELIM+2*ACC+1)) + C=-(MAX_LOAD-TEMP(J)+SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=X+1 + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 4 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + NB_ZERO=NB_ZERO+1 + X=0 + ENDIF + ELSE + IF(X.LT.min(KMIN,KMAX))THEN + NB_ZERO=NB_ZERO+1 + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(J)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(J))THEN + MIN_LOAD=TEMP(J) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + ACC=ACC+X + TMP_SUM=MAX_LOAD + TEMP_MAX_LOAD=max(TEMP_MAX_LOAD, + & TEMP(J)+(dble(NELIM) * + & dble(NB_ROWS(J)))* + & dble(2*(NELIM+ + & ACC)-NB_ROWS(J) + & -NELIM+1)) + IF(REF.LE.NUMBER_OF_PROCS-1)THEN + IF(TEMP_MAX_LOAD.GT.TEMP(REF+1))THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ENDIF + ENDIF + IF(NCB.EQ.ACC) GOTO 666 + ENDDO + IF(NB_SAT.EQ.SMALL_SET)THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + GOTO 434 + ENDIF + ENDIF + IF(NB_ZERO.EQ.SMALL_SET)THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + GOTO 434 + ENDIF + ENDIF + IF((NB_SAT+NB_ZERO).EQ.SMALL_SET)THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + GOTO 434 + ENDIF + ENDIF + ENDDO + 434 CONTINUE + ADDITIONNAL_ROWS=NCB-ACC + IF(ADDITIONNAL_ROWS.NE.0)THEN + IF(ADDITIONNAL_ROWS.LT.KMIN)THEN + i=CHOSEN + J=ACC + 436 CONTINUE + IF(NB_ROWS(i).NE.0)THEN + J=J-NB_ROWS(i) + A=dble(1) + B=dble(J+2) + C=-BUF_SIZE+dble(J+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-J) X=NCB-J + BANDE_K821=dble(X)*dble(NELIM+J+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(J+2+NELIM) + C=-BUF_SIZE+dble(J+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-J) X=NCB-J + BANDE_K821=dble(X)*dble(NELIM+J+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(J+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(NB_ROWS(i).NE.KMAX)THEN + IF(NCB-J.LE.KMAX)THEN + NB_ROWS(i)=+NCB-J + ADDITIONNAL_ROWS=0 + ENDIF + ENDIF + TEMP_MAX_LOAD=max(TEMP_MAX_LOAD, + & TEMP(i)+ + & (dble(NELIM) * dble(NB_ROWS(i)))* + & dble(2*(NELIM+ + & ACC)-NB_ROWS(i) + & -NELIM+1)) + IF(REF.LE.NUMBER_OF_PROCS-1)THEN + IF(TEMP_MAX_LOAD.GT.TEMP(REF+1))THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ENDIF + ENDIF + ELSE + i=i-1 + IF(i.NE.0)GOTO 436 + ENDIF + IF(ADDITIONNAL_ROWS.NE.0)THEN + i=CHOSEN + IF(i.NE.SMALL_SET)THEN + i=i+1 + IF(NB_ROWS(i).NE.0)THEN + WRITE(*,*)MYID, + & ': Internal error 5 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + CHOSEN=i + ENDIF + ENDIF + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF((TEMP(i).LE.MAX_LOAD))THEN + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(i)) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.KMIN)THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + ACC=ACC+X + ADDITIONNAL_ROWS=NCB-ACC + ELSE IF((TEMP(i).GT.MAX_LOAD))THEN + MAX_LOAD=TEMP(i) + NB_SAT=0 + ACC=0 + NB_ROWS=0 + DO J=1,i + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(J)) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 6 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.min(KMIN,KMAX))THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(J)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(J))THEN + MIN_LOAD=TEMP(J) + POS_MIN_LOAD=i + ENDIF + ENDIF + ACC=ACC+X + MAX_LOAD=max(MAX_LOAD, + & TEMP(J)+ + & (dble(NELIM)*dble(NB_ROWS(J)))* + & dble(2*(NELIM+ + & ACC)-NB_ROWS(J) + & -NELIM+1)) + IF(NCB.EQ.ACC) GOTO 741 + IF(NCB-ACC.LT.KMIN) GOTO 210 + ENDDO + 210 CONTINUE + ENDIF + 741 CONTINUE + i=i+1 + ADDITIONNAL_ROWS=NCB-ACC + ENDDO + CHOSEN=i-1 + IF(ADDITIONNAL_ROWS.NE.0)THEN + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)*dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS- + & NELIM+1) + SOMME=SOMME/dble(NUMBER_OF_PROCS) + NB_ROWS=0 + ACC=0 + CHOSEN=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(i)+SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 7 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.min(KMIN,KMAX))THEN + X=min(KMAX,KMIN) + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB.EQ.ACC) GOTO 666 + IF(NCB-ACC.LT.KMIN) GOTO 488 + ENDDO + 488 CONTINUE + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)* + & dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS- + & NELIM+1) + SOMME=SOMME/dble(NUMBER_OF_PROCS) + NB_ROWS=0 + ACC=0 + CHOSEN=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(i)+SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 8 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + X=KMAX + ELSE + IF(X.LT.KMIN)THEN + X=KMIN + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB.EQ.ACC) GOTO 666 + IF(NCB-ACC.LT.KMIN) GOTO 477 + ENDDO + 477 CONTINUE + IF(ACC.NE.NCB)THEN + NB_SAT=0 + ACC=0 + CHOSEN=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=KMAX-NB_ROWS(i) + IF((ACC+NB_ROWS(i)+X).GT.NCB) + & X=NCB-(ACC+NB_ROWS(i)) + NB_ROWS(i)=NB_ROWS(i)+X + IF((dble(NB_ROWS(i))* + & dble(NB_ROWS(i)+ACC)).EQ. + & BANDE_K821)THEN + NB_SAT=NB_SAT+1 + ENDIF + ACC=ACC+NB_ROWS(i) + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + IF(NCB.EQ.ACC) GOTO 666 + IF(NCB-ACC.LT.KMIN) GOTO 834 + ENDDO + 834 CONTINUE + ENDIF + IF(ACC.NE.NCB)THEN + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)* + & dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS- + & NELIM+1) + SOMME=SOMME/dble(NUMBER_OF_PROCS-NB_SAT) + ACC=0 + DO i=1,CHOSEN + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + IF((dble(NB_ROWS(i))* + & dble(NB_ROWS(i)+ACC)).EQ. + & BANDE_K821)THEN + GOTO 102 + ENDIF + A=dble(NELIM) + B=dble(NELIM)* + & dble(NELIM+2*(ACC+NB_ROWS(i))+1) + C=-(SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-BANDE_K821) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 9 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF((ACC+X+NB_ROWS(i)).GT.NCB)THEN + IF((NCB-ACC).GT.KMAX)THEN + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NCB-ACC + ENDIF + ELSE + IF((NB_ROWS(i)+X).GT.KMAX)THEN + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NB_ROWS(i)+X + ENDIF + ENDIF + 102 CONTINUE + ACC=ACC+NB_ROWS(i) + IF(NCB.EQ.ACC) THEN + CHOSEN=i + GOTO 666 + ENDIF + IF(NCB-ACC.LT.KMIN) THEN + CHOSEN=i + GOTO 007 + ENDIF + ENDDO + 007 CONTINUE + DO i=1,CHOSEN + NB_ROWS(i)=NB_ROWS(i)+1 + ACC=ACC+1 + IF(ACC.EQ.NCB)GOTO 666 + ENDDO + IF(ACC.LT.NCB)THEN + IF(SMP)THEN + NB_ROWS(1)=NB_ROWS(1)+NCB-ACC + ELSE + NB_ROWS(POS_MIN_LOAD)= + & NB_ROWS(POS_MIN_LOAD)+NCB-ACC + ENDIF + ENDIF + ENDIF + GOTO 666 + ENDIF + ENDIF + GOTO 666 + ENDIF + ADDITIONNAL_ROWS=NCB-ACC + i=CHOSEN+1 + IF(NB_SAT.EQ.SMALL_SET) GOTO 777 + DO i=1,SMALL_SET + IDWLOAD(i)=i + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & (dble(NFRONT+1))) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + WLOAD(i)=MAX_MEM_ALLOW + ENDDO + CALL MUMPS_558(SMALL_SET, WLOAD, IDWLOAD) + NB_ZERO=0 + IF((NB_SAT.EQ.SMALL_SET).AND. + & (SMALL_SET.LT.NSLAVES_REF))THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + IF((NB_SAT.EQ.SMALL_SET).AND. + & (SMALL_SET.LE.NUMBER_OF_PROCS))GOTO 777 + AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT)) + AFFECTED=max(AFFECTED,1) + DO i=1,SMALL_SET + KMAX=int(WLOAD(i)/dble(NFRONT)) + IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN + GOTO 912 + ENDIF + IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED, + & ADDITIONNAL_ROWS)).GT.KMAX)THEN + IF(NB_ROWS(IDWLOAD(i)).GT.KMAX)THEN + ENDIF + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(IDWLOAD(i))) + NB_ROWS(IDWLOAD(i))=KMAX + NB_SAT=NB_SAT+1 + IF(NB_SAT.EQ.SMALL_SET)THEN + IF(SMALL_SET.NE.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + MAX_LOAD=max(MAX_LOAD, + & (TEMP(IDWLOAD(i))+(dble(NELIM) * + & dble(NB_ROWS(IDWLOAD(i))))+ + & (dble(NB_ROWS(IDWLOAD(i)))* + & dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + GOTO 777 + ENDIF + ENDIF + AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT)) + AFFECTED=max(AFFECTED,1) + ELSE + IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED, + & ADDITIONNAL_ROWS)).GE.KMIN)THEN + X=min(AFFECTED,ADDITIONNAL_ROWS) + NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+ + & X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ELSE + X=int((MAX_LOAD-TEMP(IDWLOAD(i)))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X+AFFECTED.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ELSE + X=AFFECTED+X + ENDIF + IF(X.GE.KMIN)THEN + NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+ + & X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & X + ELSE + NB_ZERO=NB_ZERO+1 + ENDIF + ENDIF + ENDIF + 912 CONTINUE + MAX_LOAD=max(MAX_LOAD, + & (TEMP(IDWLOAD(i))+(dble(NELIM)* + & dble(NB_ROWS(IDWLOAD(i))))+ + & (dble(NB_ROWS(IDWLOAD(i)))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + IF(SMALL_SET.LT.NUMBER_OF_PROCS)THEN + IF(MAX_LOAD.GT.TEMP(SMALL_SET+1))THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ENDIF + ENDIF + IF(SMALL_SET.EQ.NB_SAT)GOTO 777 + IF(ADDITIONNAL_ROWS.EQ.0)THEN + CHOSEN=SMALL_SET + GOTO 049 + ENDIF + ENDDO + 777 CONTINUE + IF((NB_ZERO.NE.0).AND.(ADDITIONNAL_ROWS.GE.KMIN))THEN + J=NB_ZERO + 732 CONTINUE + X=int(ADDITIONNAL_ROWS/(J)) + IF(X.LT.KMIN)THEN + J=J-1 + GOTO 732 + ENDIF + IF(X*J.LT.ADDITIONNAL_ROWS)THEN + X=X+1 + ENDIF + DO i=1,SMALL_SET + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & dble(BANDE_K821)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(NB_ROWS(i).EQ.0)THEN + IF(X.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ENDIF + IF(X.GT.KMAX)THEN + X=KMAX + ENDIF + IF(X.GT.KMIN)THEN + NB_ROWS(i)=X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + MAX_LOAD=max(MAX_LOAD, + & (TEMP(i)+(dble(NELIM) * + & dble(NB_ROWS(i)))+ + & (dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + ENDIF + ENDIF + ENDDO + ENDIF + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF((TEMP(i).LE.MAX_LOAD))THEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + AFFECTED=int((MAX_LOAD-TEMP(i))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(i).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(i)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(i) + NB_SAT=NB_SAT+1 + ELSE + IF((AFFECTED+NB_ROWS(i)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(i)=NB_ROWS(i)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + ENDIF + ELSE IF((TEMP(i).GT.MAX_LOAD))THEN + IF(NB_SAT.EQ.i-1) GOTO 218 + X=(ADDITIONNAL_ROWS/(i-1-NB_SAT)) + ACC=1 + DO J=1,i-1 + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(J)+X)) + & +(dble(NB_ROWS(J)+X)*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + IF((TEMP(J)+TMP_SUM).GT.MAX_LOAD)THEN + ACC=0 + ENDIF + ENDDO + IF(ACC.EQ.1)THEN + MAX_LOAD=TEMP(i) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + AFFECTED=X + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(J).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + NB_SAT=NB_SAT+1 + ELSE + IF((AFFECTED+NB_ROWS(J)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & AFFECTED + ENDIF + J=J+1 + ENDDO + ELSE + MAX_LOAD=TEMP(i) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + TMP_SUM=((dble(NELIM)* dble(NB_ROWS(J))) + & +(dble(NB_ROWS(J))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((MAX_LOAD-(TEMP(J)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 10 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + AFFECTED=X + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(J).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + NB_SAT=NB_SAT+1 + ELSE + IF((AFFECTED+NB_ROWS(J)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & AFFECTED + ENDIF + J=J+1 + ENDDO + ENDIF + ENDIF + 218 CONTINUE + i=i+1 + ENDDO + CHOSEN=i-1 + IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. + & (ADDITIONNAL_ROWS.NE.0))THEN + DO i=1,CHOSEN + IF(NB_ROWS(i)+1.GE.KMIN)THEN + NB_ROWS(i)=NB_ROWS(i)+1 + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 + ENDIF + MAX_LOAD=max(MAX_LOAD, + & (TEMP(i)+(dble(NELIM) * + & dble(NB_ROWS(i)))+ + & (dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 048 + ENDDO + 048 CONTINUE + ENDIF + IF((ADDITIONNAL_ROWS.NE.0))THEN + IF(CHOSEN.LT.NUMBER_OF_PROCS)THEN + i=CHOSEN+1 + ELSE + IF(CHOSEN.NE.NUMBER_OF_PROCS)THEN + WRITE(*,*)MYID, + & ': Internal error 11 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + i=CHOSEN + ENDIF + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF(TEMP(i).LE.MAX_LOAD)THEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) + & +(dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((MAX_LOAD-(TEMP(i)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + AFFECTED=X + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 12 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(i).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(i)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(i) + ELSE + IF((AFFECTED+NB_ROWS(i)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(i)=NB_ROWS(i)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + ENDIF + IF(i.NE.NUMBER_OF_PROCS) GOTO 624 + ELSE IF((TEMP(i).GT.MAX_LOAD))THEN + X=int(ADDITIONNAL_ROWS/i-1) + X=max(X,1) + IF((MAX_LOAD+((dble(NELIM)* + & dble(X))+(dble( + & X)*dble(NELIM))*dble( + & (2*NFRONT-NELIM-1)))).LE.TEMP(i))THEN + AFFECTED=X + POS=1 + ELSE + POS=0 + ENDIF + MAX_LOAD=TEMP(i) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + MAX_MEM_ALLOW=BANDE_K821 + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(POS.EQ.0)THEN + TMP_SUM=((dble(NELIM) * + & dble(NB_ROWS(J))) + & +(dble(NB_ROWS(J))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((TEMP(i)-(TEMP(J)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT- + & NELIM))) + ELSE + X=int(TMP_SUM) + ENDIF + IF(X.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(J).LT.KMAX)THEN + IF((X+NB_ROWS(J)).GT.KMAX)THEN + X=KMAX-NB_ROWS(J) + ELSE + IF((NB_ROWS(J)+X).LT. + & KMIN)THEN + X=0 + ENDIF + ENDIF + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDIF + J=J+1 + ENDDO + ENDIF + 624 CONTINUE + i=i+1 + ENDDO + CHOSEN=i-1 + IF(ADDITIONNAL_ROWS.NE.0)THEN + ACC=0 + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) + & +(dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((MAX_LOAD- + & (TEMP(i)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 13 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(i).LT.KMAX)THEN + IF((X+NB_ROWS(i)).GE.KMAX)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + IF((X+NB_ROWS(i)).GE. + & KMIN)THEN + NB_ROWS(i)=NB_ROWS(i)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ACC=ACC+1 + ELSE + ACC=ACC+1 + ENDIF + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + IF(CHOSEN.LT.NUMBER_OF_PROCS)THEN + CHOSEN=CHOSEN+1 + ENDIF + IF(ACC.EQ.0)THEN + ACC=1 + ENDIF + X=int(ADDITIONNAL_ROWS/ACC) + X=max(X,1) + ACC=0 + DO i=1,CHOSEN + J=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(J)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + J=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(J)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) + & +(dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + J=int((MAX_LOAD- + & (TEMP(i)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(NB_ROWS(i).LT.KMAX)THEN + IF((min(X,J)+NB_ROWS(i)).GE.KMAX)THEN + IF((KMAX-NB_ROWS(i)).GT. + & ADDITIONNAL_ROWS)THEN + NB_ROWS(i)=NB_ROWS(i)+ + & ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ENDIF + ELSE + IF((min(X,J)+NB_ROWS(i)).GE. + & KMIN)THEN + NB_ROWS(i)=NB_ROWS(i)+min(X,J) + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & min(X,J) + ACC=ACC+1 + ENDIF + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + IF(ACC.GT.0)THEN + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(KMAX-NB_ROWS(i).LT. + & ADDITIONNAL_ROWS)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + IF(NB_ROWS(i).EQ.0)THEN + IF(min(KMIN,KMAX).LT. + & ADDITIONNAL_ROWS)THEN + NB_ROWS(i)=min(KMIN,KMAX) + ADDITIONNAL_ROWS= + & ADDITIONNAL_ROWS- + & min(KMIN,KMAX) + ENDIF + ELSE + NB_ROWS(i)=NB_ROWS(i)+ + & ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + ENDIF + DO i=1,CHOSEN + IDWLOAD(i)=i + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + WLOAD(i)=(BANDE_K821-dble(NB_ROWS(i)*NFRONT)) + ENDDO + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, + & IDWLOAD) + NB_SAT=0 + DO i=1,CHOSEN + X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT)) + X=max(X,1) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(NB_ROWS(IDWLOAD(i)).LT.KMAX)THEN + IF((NB_ROWS(IDWLOAD(i))+X).LT.KMAX)THEN + NB_ROWS(IDWLOAD(i))= + & NB_ROWS(IDWLOAD(i))+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(IDWLOAD(i))) + NB_ROWS(IDWLOAD(i))=KMAX + ENDIF + ENDIF + IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN + NB_SAT=NB_SAT+1 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 049 + ENDDO + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(KMAX-NB_ROWS(i).LT.ADDITIONNAL_ROWS)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + X=int(ADDITIONNAL_ROWS/CHOSEN) + X=max(X,1) + DO i=1,CHOSEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + NB_ROWS(i)=NB_ROWS(i)+X + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS + ENDIF + ENDIF + 049 CONTINUE + ENDIF + 666 CONTINUE + SOMME=dble(0) + X=0 + POS=0 + DO i=1,CHOSEN + X=X+NB_ROWS(i) + SOMME=SOMME+ dble(NB_ROWS(i)) + ENDDO + GOTO 890 + ELSE IF((KEEP(83).GE.NUMBER_OF_PROCS).AND.FORCE_CAND)THEN + MAX_LOAD=dble(0) + DO i=1,OTHERS + MAX_LOAD=max(MAX_LOAD,TEMP(i)) + ENDDO + ACC=0 + CHOSEN=0 + X=1 + DO i=1,OTHERS + ENDDO + DO i=2,OTHERS + IF(TEMP(i).EQ.TEMP(1))THEN + X=X+1 + ELSE + GOTO 329 + ENDIF + ENDDO + 329 CONTINUE + TMP_SUM=TOTAL_COST/dble(X) + TEMP_MAX_LOAD=dble(0) + DO i=1,OTHERS + IF(K50.EQ.0)THEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + IF(HAVE_TYPE1_SON)THEN + IF(K50.EQ.0)THEN + X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i))) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + IF(K50.EQ.0)THEN + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(TMP_SUM+TEMP(i).GT.MAX_LOAD)THEN + SOMME=MAX_LOAD-TEMP(i) + ELSE + SOMME=TMP_SUM + ENDIF + X=int(SOMME/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.GT.KMAX)THEN + X=KMAX + ELSE + IF(X.LT.KMIN)THEN + X=min(KMIN,KMAX) + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + IF(TMP_SUM+TEMP(i).GT.MAX_LOAD)THEN + C=-(MAX_LOAD-TEMP(i)) + ELSE + C=-TMP_SUM + ENDIF + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 14 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GT.KMIN)THEN + X=KMAX + ELSE + X=0 + ENDIF + ELSE + IF(X.LE.min(KMIN,KMAX))THEN + IF(KMAX.LT.KMIN)THEN + X=0 + ELSE + X=min(KMIN,KMAX) + ENDIF + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + TEMP_MAX_LOAD=max(TEMP_MAX_LOAD,TEMP(i)) + NB_ROWS(i)=X + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(ACC.EQ.NCB) GOTO 541 + ENDDO + 541 CONTINUE + IF(ACC.LT.NCB)THEN + IF(K50.EQ.0)THEN + ADDITIONNAL_ROWS=NCB-ACC + DO J=1,CHOSEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & dble(BANDE_K821)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF((NB_ROWS(J)).LT.KMAX)THEN + IF(ADDITIONNAL_ROWS.GT.(KMAX-NB_ROWS(J)))THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(J)) + NB_ROWS(J)=KMAX + ELSE + NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 + ENDDO + X=int(ADDITIONNAL_ROWS/CHOSEN) + X=max(X,1) + DO J=1,CHOSEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(J)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF((NB_ROWS(J)+X).GT.KMAX)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(J)) + NB_ROWS(J)=KMAX + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + NB_ROWS(J)=NB_ROWS(J)+X + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 + ENDDO + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(KMAX-NB_ROWS(i).LT.ADDITIONNAL_ROWS)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 + ENDDO + DO i=1,NUMBER_OF_PROCS + IDWLOAD(i)=i + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + WLOAD(i)=(BANDE_K821-(dble(NB_ROWS(i))* + & dble(NFRONT))) + ENDDO + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, + & IDWLOAD) + NB_SAT=0 + DO i=1,CHOSEN + X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT)) + X=max(X,1) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(NB_ROWS(IDWLOAD(i)).LT.KMAX)THEN + IF((NB_ROWS(IDWLOAD(i))+X).LT.KMAX)THEN + NB_ROWS(IDWLOAD(i))= + & NB_ROWS(IDWLOAD(i))+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(IDWLOAD(i))) + NB_ROWS(IDWLOAD(i))=KMAX + ENDIF + ENDIF + IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN + NB_SAT=NB_SAT+1 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 889 + ENDDO + GOTO 994 + ELSE + ACC=0 + CHOSEN=0 + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=KMAX-NB_ROWS(i) + IF((ACC+NB_ROWS(i)+X).GT.NCB) + & X=NCB-(ACC+NB_ROWS(i)) + NB_ROWS(i)=NB_ROWS(i)+X + ACC=ACC+NB_ROWS(i) + CHOSEN=CHOSEN+1 + IF(NCB.EQ.ACC) GOTO 889 + ENDDO + ADDITIONNAL_ROWS=NCB-ACC + ENDIF + ACC=0 + CHOSEN=0 + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=KMAX-NB_ROWS(i) + IF((ACC+NB_ROWS(i)+X).GT.NCB) + & X=NCB-(ACC+NB_ROWS(i)) + NB_ROWS(i)=NB_ROWS(i)+X + ACC=ACC+NB_ROWS(i) + CHOSEN=CHOSEN+1 + IF(NCB.EQ.ACC) GOTO 889 + ENDDO + ADDITIONNAL_ROWS=NCB-ACC + 994 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(OTHERS)) + IF((X*OTHERS).LT.ADDITIONNAL_ROWS)THEN + X=X+1 + ENDIF + DO i=1,OTHERS + NB_ROWS(i)=NB_ROWS(i)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + IF(ADDITIONNAL_ROWS.LT.X)X=ADDITIONNAL_ROWS + ENDDO + CHOSEN=OTHERS + ENDIF + ENDIF + 889 CONTINUE + MAX_LOAD=TEMP_MAX_LOAD + 890 CONTINUE + J=CHOSEN + X=0 + DO i=J,1,-1 + IF(NB_ROWS(i).EQ.0)THEN + CHOSEN=CHOSEN-1 + ELSE + IF(NB_ROWS(i).GT.0)THEN + X=1 + ELSE + WRITE(*,*)MYID, + & ': Internal error 15 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDDO + NSLAVES_NODE=CHOSEN + TAB_POS(NSLAVES_NODE+1)= NCB+1 + TAB_POS(SLAVEF+2) = CHOSEN + POS=1 + X=1 + DO i=1,J + IF(NB_ROWS(i).NE.0)THEN + SLAVES_LIST(X)=TEMP_ID(i) + TAB_POS(X)=POS + POS=POS+NB_ROWS(i) + IF(NB_ROWS(i).LE.0)THEN + WRITE(*,*)MYID, + & ': Internal error 16 in SMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + X=X+1 + ENDIF + ENDDO + DO i=CHOSEN+1,NUMBER_OF_PROCS + SLAVES_LIST(i)=TEMP_ID(i) + ENDDO + IF(POS.NE.(NCB+1))THEN + WRITE(*,*)MYID, + & ': Internal error 17 in SMUMPS_518', + & POS,NCB+1 + CALL MUMPS_ABORT() + ENDIF + END SUBROUTINE SMUMPS_518 + SUBROUTINE SMUMPS_520 + & (INODE,UPPER,SLAVEF,KEEP,KEEP8, + & STEP,POOL,LPOOL,PROCNODE,N) + IMPLICIT NONE + INTEGER INODE, LPOOL, SLAVEF, N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER STEP(KEEP(28)), POOL(LPOOL), PROCNODE(KEEP(28)) + LOGICAL UPPER + INTEGER J + DOUBLE PRECISION MEM_COST + INTEGER NBINSUBTREE,i,NBTOP + EXTERNAL SMUMPS_508, + & MUMPS_170 + LOGICAL SMUMPS_508, + & MUMPS_170 + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + IF(KEEP(47).LT.2)THEN + WRITE(*,*)'SMUMPS_520 must + & be called with K47>=2' + CALL MUMPS_ABORT() + ENDIF + IF((INODE.GT.0).AND.(INODE.LE.N))THEN + MEM_COST=SMUMPS_543(INODE) + IF((DM_MEM(MYID)+dble(MEM_COST)+ PEAK_SBTR_CUR_LOCAL- + & SBTR_CUR_LOCAL) + & .GT.MAX_PEAK_STK)THEN + DO i=NBTOP-1,1,-1 + INODE = POOL( LPOOL - 2 - i) + MEM_COST=SMUMPS_543(INODE) + IF((INODE.LT.0).OR.(INODE.GT.N)) THEN + DO J=i+1,NBTOP,-1 + POOL(J-1)=POOL(J) + ENDDO + UPPER=.TRUE. + RETURN + ENDIF + IF((DM_MEM(MYID)+dble(MEM_COST)+PEAK_SBTR_CUR_LOCAL- + & SBTR_CUR_LOCAL).LE. + & MAX_PEAK_STK) THEN + DO J=i+1,NBTOP,-1 + POOL(J-1)=POOL(J) + ENDDO + UPPER=.TRUE. + RETURN + ENDIF + ENDDO + IF(NBINSUBTREE.NE.0)THEN + INODE = POOL( NBINSUBTREE ) + IF(.NOT.MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + WRITE(*,*) + & 'Internal error 1 in SMUMPS_520' + CALL MUMPS_ABORT() + ENDIF + UPPER=.FALSE. + RETURN + ENDIF + INODE=POOL(LPOOL-2-NBTOP) + UPPER=.TRUE. + RETURN + ENDIF + ENDIF + UPPER=.TRUE. + END SUBROUTINE SMUMPS_520 + SUBROUTINE SMUMPS_513(WHAT) + IMPLICIT NONE + LOGICAL WHAT + IF(.NOT.BDC_POOL_MNG)THEN + WRITE(*,*)'SMUMPS_513 + & should be called when K81>0 and K47>2' + ENDIF + IF(WHAT)THEN + PEAK_SBTR_CUR_LOCAL=PEAK_SBTR_CUR_LOCAL+ + & dble(MEM_SUBTREE(INDICE_SBTR)) + IF(.NOT.BDC_SBTR) INDICE_SBTR=INDICE_SBTR+1 + ELSE + PEAK_SBTR_CUR_LOCAL=dble(0) + SBTR_CUR_LOCAL=dble(0) + ENDIF + END SUBROUTINE SMUMPS_513 + DOUBLE PRECISION FUNCTION SMUMPS_543( INODE ) + IMPLICIT NONE + INTEGER INODE,LEVEL,i,NELIM,NFR + DOUBLE PRECISION COST + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + NFR = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253) + LEVEL = MUMPS_330( PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS ) + IF (LEVEL .EQ. 1) THEN + COST = dble(NFR) * dble(NFR) + ELSE + IF ( K50 == 0 ) THEN + COST = dble(NFR) * dble(NELIM) + ELSE + COST = dble(NELIM) * dble(NELIM) + ENDIF + ENDIF + SMUMPS_543=COST + RETURN + END FUNCTION SMUMPS_543 + RECURSIVE SUBROUTINE SMUMPS_515(FLAG,COST,COMM) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER COMM,WHAT,IERR + LOGICAL FLAG + DOUBLE PRECISION COST + DOUBLE PRECISION TO_BE_SENT + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF(FLAG)THEN + WHAT=17 + IF(BDC_M2_FLOPS)THEN +#if ! defined(OLD_LOAD_MECHANISM) + TO_BE_SENT=DELTA_LOAD-COST + DELTA_LOAD=dble(0) +#else + TO_BE_SENT=LAST_LOAD_SENT-COST + LAST_LOAD_SENT=LAST_LOAD_SENT-COST +#endif + ELSE IF(BDC_M2_MEM)THEN + IF(BDC_POOL.AND.(.NOT.BDC_MD))THEN + TO_BE_SENT=max(TMP_M2,POOL_LAST_COST_SENT) + POOL_LAST_COST_SENT=TO_BE_SENT + ELSE IF(BDC_MD)THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_MEM=DELTA_MEM+TMP_M2 + TO_BE_SENT=DELTA_MEM +#else + TO_BE_SENT=DM_LAST_MEM_SENT+TMP_M2 + DM_LAST_MEM_SENT=DM_LAST_MEM_SENT+TMP_M2 +#endif + ELSE + TO_BE_SENT=dble(0) + ENDIF + ENDIF + ELSE + WHAT=6 + TO_BE_SENT=dble(0) + ENDIF + 111 CONTINUE + CALL SMUMPS_460( WHAT, + & COMM, NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & COST, + & TO_BE_SENT, + & MYID, IERR ) + IF ( IERR == -1 )THEN + CALL SMUMPS_467(COMM_LD, KEEP_LOAD) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in SMUMPS_500", + & IERR + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE SMUMPS_515 + SUBROUTINE SMUMPS_512(INODE,STEP,NSTEPS,PROCNODE,FRERE, + & NE,COMM,SLAVEF,MYID,KEEP,KEEP8,N) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER INODE,NSTEPS,MYID,SLAVEF,COMM,N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER FRERE(NSTEPS),NE(NSTEPS),STEP(N),PROCNODE(NSTEPS) + EXTERNAL MUMPS_170,MUMPS_275 + LOGICAL MUMPS_170 + INTEGER i,NCB,NELIM + INTEGER MUMPS_275 + INTEGER FATHER_NODE,FATHER,WHAT,IERR + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN + WRITE(*,*)MYID,': Problem in SMUMPS_512' + CALL MUMPS_ABORT() + ENDIF + IF((INODE.LT.0).OR.(INODE.GT.N)) THEN + RETURN + ENDIF + i=INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + NCB=ND_LOAD(STEP_LOAD(INODE))-NELIM + KEEP_LOAD(253) + WHAT=5 + FATHER_NODE=DAD_LOAD(STEP_LOAD(INODE)) + IF (FATHER_NODE.EQ.0) THEN + RETURN + ENDIF + IF((FRERE(STEP(FATHER_NODE)).EQ.0).AND. + & ((FATHER_NODE.EQ.KEEP(38)).OR. + & (FATHER_NODE.EQ.KEEP(20))))THEN + RETURN + ENDIF + IF(MUMPS_170(PROCNODE(STEP(FATHER_NODE)), + & SLAVEF)) THEN + RETURN + ENDIF + FATHER=MUMPS_275(PROCNODE(STEP(FATHER_NODE)),SLAVEF) + IF(FATHER.EQ.MYID)THEN + IF(BDC_M2_MEM)THEN + CALL SMUMPS_816(FATHER_NODE) + ELSEIF(BDC_M2_FLOPS)THEN + CALL SMUMPS_817(FATHER_NODE) + ENDIF + IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN + IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), + & NPROCS).EQ.1)THEN + CB_COST_ID(POS_ID)=INODE + CB_COST_ID(POS_ID+1)=1 + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + CB_COST_MEM(POS_MEM)=int(MYID,8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(NCB,8)*int(NCB,8) + POS_MEM=POS_MEM+1 + ENDIF + ENDIF + GOTO 666 + ENDIF + 111 CONTINUE + CALL SMUMPS_519(WHAT, COMM, NPROCS, + & FATHER_NODE,INODE,NCB, KEEP(81),MYID, + & FATHER, IERR) + IF (IERR == -1 ) THEN + CALL SMUMPS_467(COMM, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in SMUMPS_512", + & IERR + CALL MUMPS_ABORT() + ENDIF + 666 CONTINUE + END SUBROUTINE SMUMPS_512 + SUBROUTINE SMUMPS_514(INODE,NUM_CALL) + IMPLICIT NONE + DOUBLE PRECISION MAXI + INTEGER i,J,IND_MAXI + INTEGER INODE,NUM_CALL + IF(BDC_M2_MEM)THEN + IF(((NUM_CALL.EQ.1).AND.(BDC_MD)).OR. + & ((NUM_CALL.EQ.2).AND.(.NOT.BDC_MD)))THEN + RETURN + ENDIF + ENDIF + IF((FRERE_LOAD(STEP_LOAD(INODE)).EQ.0).AND. + & ((INODE.EQ.KEEP_LOAD(38)).OR. + & (INODE.EQ.KEEP_LOAD(20)))) THEN + RETURN + ENDIF + DO i=POOL_SIZE,1,-1 + IF(POOL_NIV2(i).EQ.INODE) GOTO 666 + ENDDO + NB_SON(STEP_LOAD(INODE))=-1 + RETURN + 666 CONTINUE + IF(BDC_M2_MEM)THEN + IF(POOL_NIV2_COST(i).EQ.MAX_M2)THEN + TMP_M2=MAX_M2 + MAXI=dble(0) + IND_MAXI=-9999 + DO J=POOL_SIZE,1,-1 + IF(J.NE.i) THEN + IF(POOL_NIV2_COST(J).GT.MAXI)THEN + MAXI=POOL_NIV2_COST(J) + IND_MAXI=J + ENDIF + ENDIF + ENDDO + MAX_M2=MAXI + J=IND_MAXI + REMOVE_NODE_FLAG_MEM=.TRUE. + REMOVE_NODE_COST_MEM=TMP_M2 + CALL SMUMPS_515(REMOVE_NODE_FLAG,MAX_M2,COMM_LD) + NIV2(MYID+1)=MAX_M2 + ENDIF + ELSEIF(BDC_M2_FLOPS)THEN + REMOVE_NODE_COST=POOL_NIV2_COST(i) + REMOVE_NODE_FLAG=.TRUE. + CALL SMUMPS_515(REMOVE_NODE_FLAG, + & -POOL_NIV2_COST(i),COMM_LD) + NIV2(MYID+1)=NIV2(MYID+1)-POOL_NIV2_COST(i) + ENDIF + DO J=i+1,POOL_SIZE + POOL_NIV2(J-1)=POOL_NIV2(J) + POOL_NIV2_COST(J-1)=POOL_NIV2_COST(J) + ENDDO + POOL_SIZE=POOL_SIZE-1 + END SUBROUTINE SMUMPS_514 + RECURSIVE SUBROUTINE SMUMPS_816(INODE) + IMPLICIT NONE + INTEGER INODE + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF((INODE.EQ.KEEP_LOAD(20)).OR. + & (INODE.EQ.KEEP_LOAD(38)))THEN + RETURN + ENDIF + IF(NB_SON(STEP_LOAD(INODE)).EQ.-1)THEN + RETURN + ELSE + IF(NB_SON(STEP_LOAD(INODE)).LT.0)THEN + WRITE(*,*) + & 'Internal error 1 in SMUMPS_816' + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_SON(STEP_LOAD(INODE))= + & NB_SON(STEP_LOAD(INODE))-1 + IF(NB_SON(STEP_LOAD(INODE)).EQ.0)THEN + POOL_NIV2(POOL_SIZE+1)=INODE + POOL_NIV2_COST(POOL_SIZE+1)= + & SMUMPS_543(INODE) + POOL_SIZE=POOL_SIZE+1 + IF(POOL_NIV2_COST(POOL_SIZE).GT.MAX_M2)THEN + MAX_M2=POOL_NIV2_COST(POOL_SIZE) + ID_MAX_M2=POOL_NIV2(POOL_SIZE) + CALL SMUMPS_515(REMOVE_NODE_FLAG_MEM,MAX_M2,COMM_LD) + NIV2(1+MYID)=MAX_M2 + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_816 + RECURSIVE SUBROUTINE SMUMPS_817(INODE) + IMPLICIT NONE + INTEGER INODE + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF((INODE.EQ.KEEP_LOAD(20)).OR. + & (INODE.EQ.KEEP_LOAD(38)))THEN + RETURN + ENDIF + IF(NB_SON(STEP_LOAD(INODE)).EQ.-1)THEN + RETURN + ELSE + IF(NB_SON(STEP_LOAD(INODE)).LT.0)THEN + WRITE(*,*) + & 'Internal error 1 in SMUMPS_817' + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_SON(STEP_LOAD(INODE))= + & NB_SON(STEP_LOAD(INODE))-1 + IF(NB_SON(STEP_LOAD(INODE)).EQ.0)THEN + POOL_NIV2(POOL_SIZE+1)=INODE + POOL_NIV2_COST(POOL_SIZE+1)= + & SMUMPS_542(INODE) + POOL_SIZE=POOL_SIZE+1 + MAX_M2=POOL_NIV2_COST(POOL_SIZE) + ID_MAX_M2=POOL_NIV2(POOL_SIZE) + CALL SMUMPS_515(REMOVE_NODE_FLAG, + & POOL_NIV2_COST(POOL_SIZE), + & COMM_LD) + NIV2(MYID+1)=POOL_NIV2_COST(POOL_SIZE)+NIV2(MYID+1) + ENDIF + RETURN + END SUBROUTINE SMUMPS_817 + DOUBLE PRECISION FUNCTION SMUMPS_542(INODE) + INTEGER INODE + INTEGER NFRONT,NELIM,i,LEVEL + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + DOUBLE PRECISION COST + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + NFRONT = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253) + LEVEL = MUMPS_330( PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS ) + COST=dble(0) + CALL MUMPS_511(NFRONT,NELIM,NELIM, + & KEEP_LOAD(50),LEVEL,COST) + SMUMPS_542=COST + RETURN + END FUNCTION SMUMPS_542 + INTEGER FUNCTION SMUMPS_541( INODE ) + IMPLICIT NONE + INTEGER INODE,NELIM,NFR,SON,IN,i + INTEGER COST_CB + COST_CB=0 + i = INODE + 10 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 10 + ENDIF + SON=-i + DO i=1, NE_LOAD(STEP_LOAD(INODE)) + NFR = ND_LOAD( STEP_LOAD(SON) ) + KEEP_LOAD(253) + IN=SON + NELIM = 0 + 20 CONTINUE + IF ( IN > 0 ) THEN + NELIM = NELIM + 1 + IN = FILS_LOAD(IN) + GOTO 20 + ENDIF + COST_CB=COST_CB+((NFR-NELIM)*(NFR-NELIM)) + SON=FRERE_LOAD(STEP_LOAD(SON)) + ENDDO + SMUMPS_541=COST_CB + RETURN + END FUNCTION SMUMPS_541 + SUBROUTINE SMUMPS_533(SLAVEF,NMB_OF_CAND, + & TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, + & NSLAVES,INODE) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER, INTENT (IN) :: SLAVEF, NASS, NSLAVES + INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2) + INTEGER, intent(in) :: NMB_OF_CAND + INTEGER, INTENT (IN) :: LIST_SLAVES( NMB_OF_CAND ) + INTEGER KEEP(500),INODE + INTEGER(8) KEEP8(150) + INTEGER allocok + DOUBLE PRECISION MEM_COST,FCT_COST + DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE ::EMPTY_ARRAY, + & DELTA_MD,EMPTY_ARRAY2 + INTEGER NBROWS_SLAVE,i,WHAT,IERR,NPROCS_LOC + LOGICAL FORCE_CAND + MEM_COST=dble(0) + FCT_COST=dble(0) + IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN + FORCE_CAND = .FALSE. + NPROCS_LOC=SLAVEF-1 + ELSE + FORCE_CAND = (mod(KEEP(24),2).eq.0) + NPROCS_LOC=NMB_OF_CAND + END IF + IF(FORCE_CAND)THEN + CALL SMUMPS_540(INODE,FCT_COST, + & MEM_COST,NPROCS_LOC,NASS) + ELSE + CALL SMUMPS_540(INODE,FCT_COST, + & MEM_COST,SLAVEF-1,NASS) + ENDIF + DO i=1,SLAVEF + IDWLOAD(i)=i-1 + ENDDO + ALLOCATE(EMPTY_ARRAY(NPROCS_LOC),DELTA_MD(NPROCS_LOC), + & EMPTY_ARRAY2(NPROCS_LOC), + & stat=allocok) + DO i = 1, NSLAVES + NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i) + DELTA_MD( i ) = FCT_COST - dble(NBROWS_SLAVE)* + & dble(NASS) + END DO + IF(FORCE_CAND)THEN + DO i=NSLAVES+1,NPROCS_LOC + DELTA_MD( i ) = FCT_COST + ENDDO + ELSE + DO i=NSLAVES+1,SLAVEF-1 + DELTA_MD( i ) = FCT_COST + ENDDO + ENDIF + WHAT=7 + 111 CONTINUE + CALL SMUMPS_524(.FALSE., COMM_LD, MYID, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & NPROCS_LOC, LIST_SLAVES,0, + & EMPTY_ARRAY, + & DELTA_MD,EMPTY_ARRAY2,WHAT, IERR) + IF ( IERR == -1 ) THEN + CALL SMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in SMUMPS_533", + & IERR + CALL MUMPS_ABORT() + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (FUTURE_NIV2(MYID+1) .NE. 0) THEN +#endif + DO i = 1, NSLAVES + MD_MEM(LIST_SLAVES(i))=MD_MEM(LIST_SLAVES(i))+ + & int(DELTA_MD( i ),8) +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(LIST_SLAVES(i)+1).EQ.0)THEN + MD_MEM(LIST_SLAVES(i))=999999999_8 + ENDIF +#endif + ENDDO +#if ! defined(OLD_LOAD_MECHANISM) + ENDIF +#endif + DEALLOCATE(EMPTY_ARRAY) + DEALLOCATE(DELTA_MD) + END SUBROUTINE SMUMPS_533 + SUBROUTINE SMUMPS_540(INODE,FCT_COST, + & MEM_COST,NSLAVES,NELIM) + IMPLICIT NONE + INTEGER INODE,NSLAVES,NFR,NELIM,IN + DOUBLE PRECISION MEM_COST,FCT_COST + NFR=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253) + IN = INODE + FCT_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)* + & dble(NELIM) + MEM_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)* + & dble(NFR) + END SUBROUTINE SMUMPS_540 + SUBROUTINE SMUMPS_819(INODE) + IMPLICIT NONE + INTEGER INODE + INTEGER i,J,SON,NSLAVES_TEMP,POS_TEMP,K + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + IF((INODE.LT.0).OR.(INODE.GT.N_LOAD))THEN + RETURN + ENDIF + IF(POS_ID.GT.1)THEN + i=INODE + 10 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 10 + ENDIF + SON=-i + IF(POS_ID.LT.NE_LOAD(STEP_LOAD(INODE))*3)THEN + i=1 + ENDIF + DO i=1, NE_LOAD(STEP_LOAD(INODE)) + J=1 + DO WHILE (J.LT.POS_ID) + IF(CB_COST_ID(J).EQ.SON)GOTO 295 + J=J+3 + ENDDO + 295 CONTINUE + IF(J.GE.POS_ID)THEN + IF(MUMPS_275( + & PROCNODE_LOAD(STEP_LOAD(INODE)),NPROCS).EQ.MYID)THEN + IF(INODE.EQ.KEEP_LOAD(38))THEN + GOTO 666 +#if ! defined(OLD_LOAD_MECHANISM) + ELSE + IF(FUTURE_NIV2(MYID+1).NE.0)THEN + WRITE(*,*)MYID,': i did not find ',SON + CALL MUMPS_ABORT() + ENDIF + GOTO 666 +#endif + ENDIF + ELSE + GOTO 666 + ENDIF + ENDIF + NSLAVES_TEMP=CB_COST_ID(J+1) + POS_TEMP=CB_COST_ID(J+2) + DO K=J,POS_ID-1 + CB_COST_ID(K)=CB_COST_ID(K+3) + ENDDO + K=POS_TEMP + DO WHILE (K.LE.POS_MEM-1) + CB_COST_MEM(K)=CB_COST_MEM(K+2*NSLAVES_TEMP) + K=K+1 + ENDDO + POS_MEM=POS_MEM-2*NSLAVES_TEMP + POS_ID=POS_ID-3 + IF((POS_MEM.LT.1).OR.(POS_ID.LT.1))THEN + WRITE(*,*)MYID,': negative pos_mem or pos_id' + CALL MUMPS_ABORT() + ENDIF + 666 CONTINUE + SON=FRERE_LOAD(STEP_LOAD(SON)) + ENDDO + ENDIF + END SUBROUTINE SMUMPS_819 + SUBROUTINE SMUMPS_820(FLAG) + IMPLICIT NONE + LOGICAL FLAG + INTEGER i + DOUBLE PRECISION MEM + FLAG=.FALSE. + DO i=0,NPROCS-1 + MEM=DM_MEM(i)+LU_USAGE(i) + IF(BDC_SBTR)THEN + MEM=MEM+SBTR_MEM(i)-SBTR_CUR(i) + ENDIF + IF((MEM/dble(TAB_MAXS(i))).GT.0.8d0)THEN + FLAG=.TRUE. + GOTO 666 + ENDIF + ENDDO + 666 CONTINUE + END SUBROUTINE SMUMPS_820 + SUBROUTINE SMUMPS_554(NBINSUBTREE,INSUBTREE,NBTOP, + & MIN_COST,SBTR) + IMPLICIT NONE + INTEGER NBINSUBTREE,INSUBTREE,NBTOP + DOUBLE PRECISION MIN_COST + LOGICAL SBTR + INTEGER i + DOUBLE PRECISION TMP_COST,TMP_MIN + TMP_MIN=huge(TMP_MIN) + DO i=0,NPROCS-1 + IF(i.NE.MYID)THEN + IF(BDC_SBTR)THEN + TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))-(DM_MEM(i)+ + & LU_USAGE(i))-(SBTR_MEM(i)-SBTR_CUR(i))) + ELSE + TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))- + & (DM_MEM(i)+LU_USAGE(i))) + ENDIF + ENDIF + ENDDO + IF(NBINSUBTREE.GT.0)THEN + IF(INSUBTREE.EQ.1)THEN + TMP_COST=dble(TAB_MAXS(MYID))-(DM_MEM(MYID)+ + & LU_USAGE(MYID)) + & -(SBTR_MEM(MYID)-SBTR_CUR(MYID)) + ELSE + SBTR=.FALSE. + GOTO 777 + ENDIF + ENDIF + TMP_MIN=min(TMP_COST,TMP_MIN) + IF(TMP_MIN.GT.MIN_COST) SBTR=.TRUE. + 777 CONTINUE + END SUBROUTINE SMUMPS_554 + SUBROUTINE SMUMPS_818(INODE,MAX_MEM,PROC) + IMPLICIT NONE + INTEGER INODE,PROC + INTEGER i,POS,NSLAVES,SLAVE,NCAND,J,NELIM,NCB,NFRONT,SON,K + INTEGER allocok + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + DOUBLE PRECISION MAX_MEM + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: MEM_ON_PROCS, + & RECV_BUF + LOGICAL, DIMENSION(:), ALLOCATABLE :: CONCERNED + DOUBLE PRECISION MAX_SENT_MSG +#if defined(NOT_ATM_POOL_SPECIAL) + DOUBLE PRECISION TMP +#endif + IF((FRERE_LOAD(STEP_LOAD(INODE)).EQ.0) + & .AND.(INODE.EQ.KEEP_LOAD(38)))THEN + RETURN + ENDIF +#if defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.LT.0).OR.(INODE.GT.N_LOAD))THEN + MAX_MEM=huge(MAX_MEM) + DO i=0,NPROCS-1 + TMP=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i)) + IF(BDC_SBTR)THEN + TMP=TMP-(SBTR_MEM(i)-SBTR_CUR(i)) + ENDIF + MAX_MEM=min(MAX_MEM,TMP) + ENDDO + RETURN + ENDIF +#endif + ALLOCATE( MEM_ON_PROCS(0:NPROCS-1), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_818' + CALL MUMPS_ABORT() + ENDIF + ALLOCATE( CONCERNED(0:NPROCS-1), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_818' + CALL MUMPS_ABORT() + ENDIF + ALLOCATE( RECV_BUF(0:NPROCS-1), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in SMUMPS_818' + CALL MUMPS_ABORT() + ENDIF + RECV_BUF=dble(0) + MAX_SENT_MSG=dble(0) + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + SON=-i + NFRONT=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253) + NCB=NFRONT-NELIM + IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), + & NPROCS).EQ.2)THEN + NCAND=CAND_LOAD(NPROCS+1, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE))) + ENDIF + DO i=0,NPROCS-1 + IF(i.EQ.MYID)THEN + MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+ + & LU_USAGE(i)+ + & SMUMPS_543(INODE)) + IF(BDC_SBTR)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i)) + ENDIF + CONCERNED(i)=.TRUE. + ELSE + MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i)) + IF(BDC_SBTR)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i)) + ENDIF + IF(BDC_M2_MEM)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-NIV2(i+1) + ENDIF + ENDIF + IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), + & NPROCS).EQ.2)THEN + IF(BDC_MD.AND.(KEEP_LOAD(48).EQ.5))THEN + DO J=1,NCAND + IF(CAND_LOAD(J, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE))) + & .EQ.i)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)- + & ((dble(NFRONT)*dble(NCB))/dble(NCAND)) + CONCERNED(i)=.TRUE. + GOTO 666 + ENDIF + ENDDO + ENDIF + ENDIF + 666 CONTINUE + ENDDO + DO K=1, NE_LOAD(STEP_LOAD(INODE)) + i=1 + DO WHILE (i.LE.POS_ID) + IF(CB_COST_ID(i).EQ.SON)GOTO 295 + i=i+3 + ENDDO + 295 CONTINUE + IF(i.GE.POS_ID)THEN +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(MYID+1).NE.0)THEN + WRITE(*,*)MYID,': ',SON,'has not been found + & in SMUMPS_818' + CALL MUMPS_ABORT() + ENDIF +#endif + GOTO 777 + ENDIF + NSLAVES=CB_COST_ID(i+1) + POS=CB_COST_ID(i+2) + DO i=1,NSLAVES + SLAVE=int(CB_COST_MEM(POS)) + IF(.NOT.CONCERNED(SLAVE))THEN + MEM_ON_PROCS(SLAVE)=MEM_ON_PROCS(SLAVE)+ + & dble(CB_COST_MEM(POS+1)) + ENDIF + DO J=0,NPROCS-1 + IF(CONCERNED(J))THEN + IF(SLAVE.NE.J)THEN + RECV_BUF(J)=max(RECV_BUF(J), + & dble(CB_COST_MEM(POS+1))) + ENDIF + ENDIF + ENDDO + POS=POS+2 + ENDDO + 777 CONTINUE + SON=FRERE_LOAD(STEP_LOAD(SON)) + ENDDO + MAX_MEM=huge(MAX_MEM) + WRITE(*,*)'NPROCS=',NPROCS,MAX_MEM + DO i=0,NPROCS-1 + IF(MAX_MEM.GT.MEM_ON_PROCS(i))THEN + PROC=i + ENDIF + MAX_MEM=min(MEM_ON_PROCS(i),MAX_MEM) + ENDDO + DEALLOCATE(MEM_ON_PROCS) + DEALLOCATE(CONCERNED) + DEALLOCATE(RECV_BUF) + END SUBROUTINE SMUMPS_818 + SUBROUTINE SMUMPS_553(MIN_PROC,POOL, + & LPOOL,INODE) + IMPLICIT NONE + INTEGER INODE,LPOOL,MIN_PROC + INTEGER POOL(LPOOL) + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + INTEGER i,NBTOP,INSUBTREE,NBINSUBTREE,NODE,FATHER,SON,J + INTEGER SBTR_NB_LEAF,POS,K,allocok,L + INTEGER, ALLOCATABLE, DIMENSION (:) :: TMP_SBTR + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + IF((KEEP_LOAD(47).EQ.4).AND. + & ((NBINSUBTREE.NE.0)))THEN + DO J=INDICE_SBTR,NB_SUBTREES + NODE=MY_ROOT_SBTR(J) + FATHER=DAD_LOAD(STEP_LOAD(NODE)) + i=FATHER + 110 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 110 + ENDIF + SON=-i + i=SON + 120 CONTINUE + IF ( i > 0 ) THEN + IF(MUMPS_275(PROCNODE_LOAD(STEP_LOAD(i)),NPROCS).EQ. + & MIN_PROC)THEN + SBTR_NB_LEAF=MY_NB_LEAF(J) + POS=SBTR_FIRST_POS_IN_POOL(J) + IF(POOL(POS+SBTR_NB_LEAF).NE.MY_FIRST_LEAF(J))THEN + WRITE(*,*)MYID,': The first leaf is not ok' + CALL MUMPS_ABORT() + ENDIF + ALLOCATE (TMP_SBTR(SBTR_NB_LEAF), stat=allocok) + IF (allocok > 0 ) THEN + WRITE(*,*)MYID,': Not enough space + & for allocation' + CALL MUMPS_ABORT() + ENDIF + POS=SBTR_FIRST_POS_IN_POOL(J) + DO K=1,SBTR_NB_LEAF + TMP_SBTR(K)=POOL(POS+K-1) + ENDDO + DO K=POS+1,NBINSUBTREE-SBTR_NB_LEAF + POOL(K)=POOL(K+SBTR_NB_LEAF) + ENDDO + POS=1 + DO K=NBINSUBTREE-SBTR_NB_LEAF+1,NBINSUBTREE + POOL(K)=TMP_SBTR(POS) + POS=POS+1 + ENDDO + DO K=INDICE_SBTR,J + SBTR_FIRST_POS_IN_POOL(K)=SBTR_FIRST_POS_IN_POOL(K) + & -SBTR_FIRST_POS_IN_POOL(J) + ENDDO + SBTR_FIRST_POS_IN_POOL(J)=NBINSUBTREE-SBTR_NB_LEAF + POS=MY_FIRST_LEAF(J) + L=MY_NB_LEAF(J) + DO K=INDICE_SBTR,J + MY_FIRST_LEAF(J)=MY_FIRST_LEAF(J+1) + MY_NB_LEAF(J)=MY_NB_LEAF(J+1) + ENDDO + MY_FIRST_LEAF(INDICE_SBTR)=POS + MY_NB_LEAF(INDICE_SBTR)=L + INODE=POOL(NBINSUBTREE) + DEALLOCATE(TMP_SBTR) + RETURN + ENDIF + i = FRERE_LOAD(STEP_LOAD(i)) + GOTO 120 + ENDIF + ENDDO + ENDIF + DO J=NBTOP,1,-1 +#if defined(NOT_ATM_POOL_SPECIAL) + IF ( POOL(LPOOL-2-J) < 0 ) THEN + NODE=-POOL(LPOOL-2-J) + ELSE IF ( POOL(LPOOL-2-J) > N_LOAD ) THEN + NODE = POOL(LPOOL-2-J) - N_LOAD + ELSE + NODE = POOL(LPOOL-2-J) + ENDIF +#else + NODE=POOL(LPOOL-2-J) +#endif + FATHER=DAD_LOAD(STEP_LOAD(NODE)) + i=FATHER + 11 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 11 + ENDIF + SON=-i + i=SON + 12 CONTINUE + IF ( i > 0 ) THEN + IF(MUMPS_275(PROCNODE_LOAD(STEP_LOAD(i)),NPROCS).EQ. + & MIN_PROC)THEN + INODE=NODE + RETURN + ENDIF + i = FRERE_LOAD(STEP_LOAD(i)) + GOTO 12 + ENDIF + ENDDO + END SUBROUTINE SMUMPS_553 + SUBROUTINE SMUMPS_555(POOL, LPOOL,KEEP,KEEP8) + IMPLICIT NONE + INTEGER LPOOL,POOL(LPOOL),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER i,POS + EXTERNAL MUMPS_283 + LOGICAL MUMPS_283 + IF(.NOT.BDC_SBTR) RETURN + POS=0 + DO i=NB_SUBTREES,1,-1 + DO WHILE(MUMPS_283( + & PROCNODE_LOAD(STEP_LOAD(POOL(POS+1))), + & NPROCS)) + POS=POS+1 + ENDDO + SBTR_FIRST_POS_IN_POOL(i)=POS+1 + POS=POS+MY_NB_LEAF(i) + ENDDO + END SUBROUTINE SMUMPS_555 + END MODULE SMUMPS_LOAD diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_ooc.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_ooc.F new file mode 100644 index 000000000..f81a15cd8 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_ooc.F @@ -0,0 +1,3501 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE SMUMPS_OOC + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NOT_IN_MEM,BEING_READ,NOT_USED,PERMUTED,USED, + & USED_NOT_PERMUTED,ALREADY_USED + PARAMETER (NOT_IN_MEM=0,BEING_READ=-1,NOT_USED=-2, + & PERMUTED=-3,USED=-4,USED_NOT_PERMUTED=-5,ALREADY_USED=-6) + INTEGER OOC_NODE_NOT_IN_MEM,OOC_NODE_PERMUTED, + & OOC_NODE_NOT_PERMUTED + PARAMETER (OOC_NODE_NOT_IN_MEM=-20, + & OOC_NODE_PERMUTED=-21,OOC_NODE_NOT_PERMUTED=-22) + INTEGER(8), DIMENSION(:,:),POINTER :: SIZE_OF_BLOCK + INTEGER, DIMENSION(:),POINTER :: TOTAL_NB_OOC_NODES + INTEGER :: OOC_SOLVE_TYPE_FCT + INTEGER, DIMENSION(:),ALLOCATABLE :: IO_REQ + INTEGER(8), DIMENSION(:), ALLOCATABLE:: LRLUS_SOLVE + INTEGER(8), DIMENSION(:), ALLOCATABLE:: SIZE_SOLVE_Z, + & LRLU_SOLVE_T, POSFAC_SOLVE, IDEB_SOLVE_Z, LRLU_SOLVE_B + INTEGER, DIMENSION(:),ALLOCATABLE :: PDEB_SOLVE_Z + INTEGER (8),SAVE :: FACT_AREA_SIZE, + & SIZE_ZONE_SOLVE,SIZE_SOLVE_EMM,TMP_SIZE_FACT, + & MAX_SIZE_FACTOR_OOC + INTEGER(8), SAVE :: MIN_SIZE_READ + INTEGER, SAVE :: TMP_NB_NODES, MAX_NB_NODES_FOR_ZONE,MAX_NB_REQ, + & CURRENT_SOLVE_READ_ZONE, + & CUR_POS_SEQUENCE,NB_Z,SOLVE_STEP, + & NB_ZONE_REQ,MTYPE_OOC,NB_ACT +#if defined (NEW_PREF_SCHEME) + INTEGER,SAVE :: MAX_PREF_SIZE +#endif + & ,NB_CALLED,REQ_ACT,NB_CALL + INTEGER(8), SAVE :: OOC_VADDR_PTR + INTEGER(8), SAVE :: SIZE_ZONE_REQ + DOUBLE PRECISION,SAVE :: MAX_OOC_FILE_SIZE + INTEGER(8), DIMENSION(:), ALLOCATABLE :: SIZE_OF_READ, READ_DEST + INTEGER,DIMENSION(:),ALLOCATABLE :: FIRST_POS_IN_READ, + & READ_MNG,REQ_TO_ZONE,POS_HOLE_T, + & POS_HOLE_B,REQ_ID,OOC_STATE_NODE + INTEGER SMUMPS_ELEMENTARY_DATA_SIZE,N_OOC + INTEGER, DIMENSION(:), ALLOCATABLE :: POS_IN_MEM, INODE_TO_POS + INTEGER, DIMENSION(:), ALLOCATABLE :: CURRENT_POS_T,CURRENT_POS_B + LOGICAL IS_ROOT_SPECIAL + INTEGER SPECIAL_ROOT_NODE + PUBLIC :: SMUMPS_575,SMUMPS_576, + & SMUMPS_577, + & SMUMPS_578, + & SMUMPS_579, + & SMUMPS_582, + & SMUMPS_583,SMUMPS_584, + & SMUMPS_585,SMUMPS_586 + INTEGER, PARAMETER, PUBLIC :: TYPEF_BOTH_LU = -99976 + PUBLIC SMUMPS_688, + & SMUMPS_690 + PRIVATE SMUMPS_695, + & SMUMPS_697 + CONTAINS + SUBROUTINE SMUMPS_711( STRAT_IO_ARG, + & STRAT_IO_ASYNC_ARG, WITH_BUF_ARG, LOW_LEVEL_STRAT_IO_ARG ) + IMPLICIT NONE + INTEGER, intent(out) :: LOW_LEVEL_STRAT_IO_ARG + LOGICAL, intent(out) :: STRAT_IO_ASYNC_ARG, WITH_BUF_ARG + INTEGER, intent(in) :: STRAT_IO_ARG + INTEGER TMP + CALL MUMPS_OOC_IS_ASYNC_AVAIL(TMP) + STRAT_IO_ASYNC_ARG=.FALSE. + WITH_BUF_ARG=.FALSE. + IF(TMP.EQ.1)THEN + IF((STRAT_IO_ARG.EQ.1).OR.(STRAT_IO_ARG.EQ.2))THEN + STRAT_IO_ASYNC=.TRUE. + WITH_BUF=.FALSE. + ELSEIF((STRAT_IO_ARG.EQ.4).OR.(STRAT_IO_ARG.EQ.5))THEN + STRAT_IO_ASYNC_ARG=.TRUE. + WITH_BUF_ARG=.TRUE. + ELSEIF(STRAT_IO_ARG.EQ.3)THEN + STRAT_IO_ASYNC_ARG=.FALSE. + WITH_BUF_ARG=.TRUE. + ENDIF + LOW_LEVEL_STRAT_IO_ARG=mod(STRAT_IO_ARG,3) + ELSE + LOW_LEVEL_STRAT_IO_ARG=0 + IF(STRAT_IO_ARG.GE.3)THEN + WITH_BUF_ARG=.TRUE. + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_711 + FUNCTION SMUMPS_579(INODE,ZONE) + IMPLICIT NONE + INTEGER INODE,ZONE + LOGICAL SMUMPS_579 + SMUMPS_579=(LRLUS_SOLVE(ZONE).GE. + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) + RETURN + END FUNCTION SMUMPS_579 + SUBROUTINE SMUMPS_590(LA) + IMPLICIT NONE + INTEGER(8) :: LA + FACT_AREA_SIZE=LA + END SUBROUTINE SMUMPS_590 + SUBROUTINE SMUMPS_575(id, MAXS) + USE SMUMPS_STRUC_DEF + USE SMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER TMPDIR_MAX_LENGTH, PREFIX_MAX_LENGTH + PARAMETER (TMPDIR_MAX_LENGTH=255, PREFIX_MAX_LENGTH=63) + INTEGER(8), intent(in) :: MAXS + TYPE(SMUMPS_STRUC), TARGET :: id + INTEGER IERR + INTEGER allocok + INTEGER ASYNC + CHARACTER*1 TMP_DIR(TMPDIR_MAX_LENGTH), + & TMP_PREFIX(PREFIX_MAX_LENGTH) + INTEGER DIM_DIR,DIM_PREFIX + INTEGER, DIMENSION(:), ALLOCATABLE :: FILE_FLAG_TAB + INTEGER TMP + INTEGER K211_LOC + ICNTL1=id%ICNTL(1) + MAX_SIZE_FACTOR_OOC=0_8 + N_OOC=id%N + ASYNC=0 + SOLVE=.FALSE. + IERR=0 + IF(allocated(IO_REQ))THEN + DEALLOCATE(IO_REQ) + ENDIF + IF(associated(KEEP_OOC))THEN + NULLIFY(KEEP_OOC) + ENDIF + IF(associated(STEP_OOC))THEN + NULLIFY(STEP_OOC) + ENDIF + IF(associated(PROCNODE_OOC))THEN + NULLIFY(PROCNODE_OOC) + ENDIF + IF(associated(OOC_INODE_SEQUENCE))THEN + NULLIFY(OOC_INODE_SEQUENCE) + ENDIF + IF(associated(TOTAL_NB_OOC_NODES))THEN + NULLIFY(TOTAL_NB_OOC_NODES) + ENDIF + IF(associated(SIZE_OF_BLOCK))THEN + NULLIFY(SIZE_OF_BLOCK) + ENDIF + IF(associated(OOC_VADDR))THEN + NULLIFY(OOC_VADDR) + ENDIF + IF(allocated(I_CUR_HBUF_NEXTPOS))THEN + DEALLOCATE(I_CUR_HBUF_NEXTPOS) + ENDIF + CALL SMUMPS_588(id,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 > 0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1) = IERR + id%INFO(2) = 0 + RETURN + ENDIF + CALL MUMPS_796(TYPEF_L, TYPEF_U, TYPEF_CB, + & id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID ) + IF (id%KEEP(201).EQ.2) THEN + OOC_FCT_TYPE=1 + ENDIF + STEP_OOC=>id%STEP + PROCNODE_OOC=>id%PROCNODE_STEPS + MYID_OOC=id%MYID + SLAVEF_OOC=id%NSLAVES + KEEP_OOC => id%KEEP + SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK + OOC_VADDR=>id%OOC_VADDR + IF(id%KEEP(107).GT.0)THEN + SIZE_SOLVE_EMM=max(id%KEEP8(19),int(dble(MAXS)* + & 0.9d0*0.2d0,8)) + SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM, + & int((dble(MAXS)*0.9d0- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)) + IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN + SIZE_SOLVE_EMM=id%KEEP8(19) + SIZE_ZONE_SOLVE=int((dble(MAXS)*0.9d0- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8) + ENDIF + ELSE + SIZE_ZONE_SOLVE=int(dble(MAXS)*0.9d0,8) + SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE + ENDIF + SMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35) + SIZE_OF_BLOCK=0_8 + ALLOCATE(id%OOC_NB_FILES(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + id%OOC_NB_FILES=0 + OOC_VADDR_PTR=0_8 + CALL SMUMPS_711( id%KEEP(99), STRAT_IO_ASYNC, + & WITH_BUF, LOW_LEVEL_STRAT_IO ) + TMP_SIZE_FACT=0_8 + TMP_NB_NODES=0 + MAX_NB_NODES_FOR_ZONE=0 + OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE + ALLOCATE(I_CUR_HBUF_NEXTPOS(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + I_CUR_HBUF_NEXTPOS = 1 + IF(WITH_BUF)THEN + CALL SMUMPS_669(id%INFO(1),id%INFO(2),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + IF(STRAT_IO_ASYNC)THEN + ASYNC=1 + ENDIF + DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN + CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC) + DIM_DIR=len(trim(id%OOC_TMPDIR)) + DIM_PREFIX=len(trim(id%OOC_PREFIX)) + CALL SMUMPS_589(TMP_DIR(1), + & id%OOC_TMPDIR, TMPDIR_MAX_LENGTH, DIM_DIR ) + CALL SMUMPS_589(TMP_PREFIX(1), + & id%OOC_PREFIX, PREFIX_MAX_LENGTH, DIM_PREFIX) + CALL MUMPS_LOW_LEVEL_INIT_PREFIX(DIM_PREFIX, TMP_PREFIX) + CALL MUMPS_LOW_LEVEL_INIT_TMPDIR(DIM_DIR, TMP_DIR) + ALLOCATE(FILE_FLAG_TAB(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1 .GT. 0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + FILE_FLAG_TAB(1:OOC_NB_FILE_TYPE)=0 + IERR=0 + TMP=int(id%KEEP8(11)/1000000_8,kind=4)+1 + IF((id%KEEP(201).EQ.1).AND.(id%KEEP(50).EQ.0) + & ) THEN + TMP=max(1,TMP/2) + ENDIF + CALL MUMPS_LOW_LEVEL_INIT_OOC_C(MYID_OOC,TMP, + & id%KEEP(35),LOW_LEVEL_STRAT_IO,K211_LOC,OOC_NB_FILE_TYPE, + & FILE_FLAG_TAB,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0 ) THEN + WRITE(ICNTL1,*)MYID_OOC,': PB in MUMPS_LOW_LEVEL_INIT_OOC_C' + WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + ENDIF + id%INFO(1) = IERR + id%INFO(2) = 0 + RETURN + ENDIF + CALL MUMPS_GET_MAX_FILE_SIZE_C(MAX_OOC_FILE_SIZE) + DEALLOCATE(FILE_FLAG_TAB) + RETURN + END SUBROUTINE SMUMPS_575 + SUBROUTINE SMUMPS_576(INODE,PTRFAC,KEEP,KEEP8, + & A,LA,SIZE,IERR) + USE SMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER(8) :: LA + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)), SIZE + REAL A(LA) + INTEGER IERR,NODE,ASYNC,REQUEST + LOGICAL IO_C + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER TYPE + INTEGER SIZE_INT1,SIZE_INT2 + TYPE=FCT + IF(STRAT_IO_ASYNC)THEN + ASYNC=1 + ELSE + ASYNC=0 + ENDIF + IERR=0 + IO_C=.TRUE. + SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)=SIZE + MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,SIZE) + OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)=OOC_VADDR_PTR + OOC_VADDR_PTR=OOC_VADDR_PTR+SIZE + TMP_SIZE_FACT=TMP_SIZE_FACT+SIZE + TMP_NB_NODES=TMP_NB_NODES+1 + IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN + MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE,TMP_NB_NODES) + TMP_SIZE_FACT=0_8 + TMP_NB_NODES=0 + ENDIF + IF (.NOT. WITH_BUF) THEN + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, + & A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN + WRITE(*,*)MYID_OOC,': Internal error (37) in OOC ' + CALL MUMPS_ABORT() + ENDIF + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), + & OOC_FCT_TYPE)=INODE + I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)= + & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1 + ELSE + IF(SIZE.LE.HBUF_SIZE)THEN + CALL SMUMPS_678 + & (A(PTRFAC(STEP_OOC(INODE))),SIZE,IERR) + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), + & OOC_FCT_TYPE) = INODE + I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) = + & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) + 1 +#if ! defined (OOC_DEBUG) + PTRFAC(STEP_OOC(INODE))=-777777_8 +#endif + RETURN + ELSE + CALL SMUMPS_707(OOC_FCT_TYPE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL SMUMPS_707(OOC_FCT_TYPE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, + & A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(*,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN + WRITE(*,*)MYID_OOC,': Internal error (38) in OOC ' + CALL MUMPS_ABORT() + ENDIF + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), + & OOC_FCT_TYPE)=INODE + I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)= + & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1 + CALL SMUMPS_689(OOC_FCT_TYPE) + ENDIF + END IF + NODE=-9999 +#if ! defined (OOC_DEBUG) + PTRFAC(STEP_OOC(INODE))=-777777_8 +#endif + IF(STRAT_IO_ASYNC)THEN + IERR=0 + CALL MUMPS_WAIT_REQUEST(REQUEST,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_576 + SUBROUTINE SMUMPS_577(DEST,INODE,IERR + & ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR,INODE + REAL DEST + INTEGER ASYNC + LOGICAL IO_C +#if defined(OLD_READ) + INTEGER REQUEST +#endif + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER TYPE + INTEGER SIZE_INT1,SIZE_INT2 + TYPE=OOC_SOLVE_TYPE_FCT + IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + & .EQ.0_8)THEN + GOTO 555 + ENDIF + IF(STRAT_IO_ASYNC)THEN + ASYNC=1 + ELSE + ASYNC=0 + ENDIF + IERR=0 + IO_C=.TRUE. +#if ! defined(OLD_READ) + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_LOW_LEVEL_DIRECT_READ(DEST, + & SIZE_INT1,SIZE_INT2, + & TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) THEN + WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + WRITE(ICNTL1,*)MYID_OOC, + & ': Problem in MUMPS_LOW_LEVEL_DIRECT_READ' + ENDIF + RETURN + ENDIF +#else + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO, + & DEST,SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0 ) THEN + WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + WRITE(ICNTL1,*)MYID_OOC, + & ': Problem in MUMPS_LOW_LEVEL_READ_OOC' + ENDIF + RETURN + ENDIF + IF(STRAT_IO_ASYNC)THEN + IERR=0 + CALL MUMPS_WAIT_REQUEST(REQUEST,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0 ) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + ENDIF +#endif + 555 CONTINUE + IF(.NOT.SMUMPS_727())THEN + IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ. + & INODE)THEN + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ELSEIF(SOLVE_STEP.EQ.1)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + CALL SMUMPS_728() + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_577 + SUBROUTINE SMUMPS_591(IERR) + USE SMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, intent(out):: IERR + IERR=0 + IF (WITH_BUF) THEN + CALL SMUMPS_675(IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + END IF + RETURN + END SUBROUTINE SMUMPS_591 + SUBROUTINE SMUMPS_592(id,IERR) + USE SMUMPS_OOC_BUFFER + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(SMUMPS_STRUC), TARGET :: id + INTEGER, intent(out) :: IERR + INTEGER I,SOLVE_OR_FACTO + IERR=0 + IF(WITH_BUF)THEN + CALL SMUMPS_659() + ENDIF + IF(associated(KEEP_OOC))THEN + NULLIFY(KEEP_OOC) + ENDIF + IF(associated(STEP_OOC))THEN + NULLIFY(STEP_OOC) + ENDIF + IF(associated(PROCNODE_OOC))THEN + NULLIFY(PROCNODE_OOC) + ENDIF + IF(associated(OOC_INODE_SEQUENCE))THEN + NULLIFY(OOC_INODE_SEQUENCE) + ENDIF + IF(associated(TOTAL_NB_OOC_NODES))THEN + NULLIFY(TOTAL_NB_OOC_NODES) + ENDIF + IF(associated(SIZE_OF_BLOCK))THEN + NULLIFY(SIZE_OF_BLOCK) + ENDIF + IF(associated(OOC_VADDR))THEN + NULLIFY(OOC_VADDR) + ENDIF + CALL MUMPS_OOC_END_WRITE_C(IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + GOTO 500 + ENDIF + id%OOC_MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE, + & TMP_NB_NODES) + IF(allocated(I_CUR_HBUF_NEXTPOS))THEN + DO I=1,OOC_NB_FILE_TYPE + id%OOC_TOTAL_NB_NODES(I)=I_CUR_HBUF_NEXTPOS(I)-1 + ENDDO + DEALLOCATE(I_CUR_HBUF_NEXTPOS) + ENDIF + id%KEEP8(20)=MAX_SIZE_FACTOR_OOC + CALL SMUMPS_613(id,IERR) + IF(IERR.LT.0)THEN + GOTO 500 + ENDIF + 500 CONTINUE + SOLVE_OR_FACTO=0 + CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + RETURN + END SUBROUTINE SMUMPS_592 + SUBROUTINE SMUMPS_588(id,IERR) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + EXTERNAL MUMPS_OOC_REMOVE_FILE_C + TYPE(SMUMPS_STRUC), TARGET :: id + INTEGER IERR + INTEGER I,J,I1,K + CHARACTER*1 TMP_NAME(350) + IERR=0 + K=1 + IF(associated(id%OOC_FILE_NAMES).AND. + & associated(id%OOC_FILE_NAME_LENGTH))THEN + DO I1=1,OOC_NB_FILE_TYPE + DO I=1,id%OOC_NB_FILES(I1) + DO J=1,id%OOC_FILE_NAME_LENGTH(K) + TMP_NAME(J)=id%OOC_FILE_NAMES(K,J) + ENDDO + CALL MUMPS_OOC_REMOVE_FILE_C(IERR, TMP_NAME(1)) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0)THEN + WRITE(ICNTL1,*)MYID_OOC,': ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + ENDIF + K=K+1 + ENDDO + ENDDO + ENDIF + IF(associated(id%OOC_FILE_NAMES))THEN + DEALLOCATE(id%OOC_FILE_NAMES) + NULLIFY(id%OOC_FILE_NAMES) + ENDIF + IF(associated(id%OOC_FILE_NAME_LENGTH))THEN + DEALLOCATE(id%OOC_FILE_NAME_LENGTH) + NULLIFY(id%OOC_FILE_NAME_LENGTH) + ENDIF + IF(associated(id%OOC_NB_FILES))THEN + DEALLOCATE(id%OOC_NB_FILES) + NULLIFY(id%OOC_NB_FILES) + ENDIF + RETURN + END SUBROUTINE SMUMPS_588 + SUBROUTINE SMUMPS_587(id,IERR) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(SMUMPS_STRUC), TARGET :: id + INTEGER IERR + IERR=0 + CALL SMUMPS_588(id,IERR) + IF(associated(id%OOC_TOTAL_NB_NODES))THEN + DEALLOCATE(id%OOC_TOTAL_NB_NODES) + NULLIFY(id%OOC_TOTAL_NB_NODES) + ENDIF + IF(associated(id%OOC_INODE_SEQUENCE))THEN + DEALLOCATE(id%OOC_INODE_SEQUENCE) + NULLIFY(id%OOC_INODE_SEQUENCE) + ENDIF + IF(associated(id%OOC_SIZE_OF_BLOCK))THEN + DEALLOCATE(id%OOC_SIZE_OF_BLOCK) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + ENDIF + IF(associated(id%OOC_VADDR))THEN + DEALLOCATE(id%OOC_VADDR) + NULLIFY(id%OOC_VADDR) + ENDIF + RETURN + END SUBROUTINE SMUMPS_587 + SUBROUTINE SMUMPS_586(id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(SMUMPS_STRUC), TARGET :: id + INTEGER TMP,I,J + INTEGER(8) :: TMP_SIZE8 + INTEGER allocok,IERR + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + INTEGER MASTER_ROOT + IERR=0 + ICNTL1=id%ICNTL(1) + SOLVE=.TRUE. + N_OOC=id%N + IF(allocated(LRLUS_SOLVE))THEN + DEALLOCATE(LRLUS_SOLVE) + ENDIF + IF(allocated(LRLU_SOLVE_T))THEN + DEALLOCATE(LRLU_SOLVE_T) + ENDIF + IF(allocated(LRLU_SOLVE_B))THEN + DEALLOCATE(LRLU_SOLVE_B) + ENDIF + IF(allocated(POSFAC_SOLVE))THEN + DEALLOCATE(POSFAC_SOLVE) + ENDIF + IF(allocated(IDEB_SOLVE_Z))THEN + DEALLOCATE(IDEB_SOLVE_Z) + ENDIF + IF(allocated(PDEB_SOLVE_Z))THEN + DEALLOCATE(PDEB_SOLVE_Z) + ENDIF + IF(allocated(SIZE_SOLVE_Z))THEN + DEALLOCATE(SIZE_SOLVE_Z) + ENDIF + IF(allocated(CURRENT_POS_T))THEN + DEALLOCATE(CURRENT_POS_T) + ENDIF + IF(allocated(CURRENT_POS_B))THEN + DEALLOCATE(CURRENT_POS_B) + ENDIF + IF(allocated(POS_HOLE_T))THEN + DEALLOCATE(POS_HOLE_T) + ENDIF + IF(allocated(POS_HOLE_B))THEN + DEALLOCATE(POS_HOLE_B) + ENDIF + IF(allocated(OOC_STATE_NODE))THEN + DEALLOCATE(OOC_STATE_NODE) + ENDIF + IF(allocated(POS_IN_MEM))THEN + DEALLOCATE(POS_IN_MEM) + ENDIF + IF(allocated(INODE_TO_POS))THEN + DEALLOCATE(INODE_TO_POS) + ENDIF + IF(allocated(SIZE_OF_READ))THEN + DEALLOCATE(SIZE_OF_READ) + ENDIF + IF(allocated(FIRST_POS_IN_READ))THEN + DEALLOCATE(FIRST_POS_IN_READ) + ENDIF + IF(allocated(READ_DEST))THEN + DEALLOCATE(READ_DEST) + ENDIF + IF(allocated(READ_MNG))THEN + DEALLOCATE(READ_MNG) + ENDIF + IF(allocated(REQ_TO_ZONE))THEN + DEALLOCATE(REQ_TO_ZONE) + ENDIF + IF(allocated(REQ_ID))THEN + DEALLOCATE(REQ_ID) + ENDIF + IF(allocated(IO_REQ))THEN + DEALLOCATE(IO_REQ) + ENDIF + IF(associated(KEEP_OOC))THEN + NULLIFY(KEEP_OOC) + ENDIF + IF(associated(STEP_OOC))THEN + NULLIFY(STEP_OOC) + ENDIF + IF(associated(PROCNODE_OOC))THEN + NULLIFY(PROCNODE_OOC) + ENDIF + IF(associated(TOTAL_NB_OOC_NODES))THEN + NULLIFY(TOTAL_NB_OOC_NODES) + ENDIF + IF(associated(SIZE_OF_BLOCK))THEN + NULLIFY(SIZE_OF_BLOCK) + ENDIF + IF(associated(OOC_INODE_SEQUENCE))THEN + NULLIFY(OOC_VADDR) + ENDIF + CALL MUMPS_796(TYPEF_L, TYPEF_U, TYPEF_CB, + & id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID ) + DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN + CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC) + CALL SMUMPS_614(id) + IF(id%INFO(1).LT.0)THEN + RETURN + ENDIF + STEP_OOC=>id%STEP + PROCNODE_OOC=>id%PROCNODE_STEPS + SLAVEF_OOC=id%NSLAVES + MYID_OOC=id%MYID + KEEP_OOC => id%KEEP + SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK + OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE + OOC_VADDR=>id%OOC_VADDR + ALLOCATE(IO_REQ(id%KEEP(28)), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = id%KEEP(28) + RETURN + ENDIF + SMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35) + MAX_NB_NODES_FOR_ZONE=id%OOC_MAX_NB_NODES_FOR_ZONE + TOTAL_NB_OOC_NODES=>id%OOC_TOTAL_NB_NODES + CALL SMUMPS_711( id%KEEP(204), STRAT_IO_ASYNC, + & WITH_BUF, LOW_LEVEL_STRAT_IO) + IF(id%KEEP(107).GT.0)THEN + SIZE_SOLVE_EMM=max(id%KEEP8(20), + & FACT_AREA_SIZE / 5_8) + SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM, + & int((dble(FACT_AREA_SIZE)- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)) + SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8) + IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN + SIZE_SOLVE_EMM=id%KEEP8(20) + SIZE_ZONE_SOLVE=int((real(FACT_AREA_SIZE)- + & real(SIZE_SOLVE_EMM))/real(id%KEEP(107)),8) + SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8) + ENDIF + ELSE + SIZE_ZONE_SOLVE=FACT_AREA_SIZE + SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE + ENDIF + IF(SIZE_SOLVE_EMM.LT.id%KEEP8(20))THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': More space needed for + & solution step in SMUMPS_586' + id%INFO(1) = -11 + CALL MUMPS_731(id%KEEP8(20), id%INFO(2)) + ENDIF + TMP=MAX_NB_NODES_FOR_ZONE + CALL MPI_ALLREDUCE(TMP,MAX_NB_NODES_FOR_ZONE,1, + & MPI_INTEGER,MPI_MAX,id%COMM_NODES, IERR) + NB_Z=KEEP_OOC(107)+1 + ALLOCATE(POS_IN_MEM(MAX_NB_NODES_FOR_ZONE*NB_Z), + & INODE_TO_POS(KEEP_OOC(28)), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = id%KEEP(28)+(MAX_NB_NODES_FOR_ZONE*NB_Z) + RETURN + ENDIF + ALLOCATE(OOC_STATE_NODE(KEEP_OOC(28)),stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = id%KEEP(28) + RETURN + ENDIF + OOC_STATE_NODE(1:KEEP_OOC(28))=0 + INODE_TO_POS=0 + POS_IN_MEM=0 + ALLOCATE(LRLUS_SOLVE(NB_Z), LRLU_SOLVE_T(NB_Z),LRLU_SOLVE_B(NB_Z), + & POSFAC_SOLVE(NB_Z),IDEB_SOLVE_Z(NB_Z), + & PDEB_SOLVE_Z(NB_Z),SIZE_SOLVE_Z(NB_Z), + & CURRENT_POS_T(NB_Z),CURRENT_POS_B(NB_Z), + & POS_HOLE_T(NB_Z),POS_HOLE_B(NB_Z), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = 9*(NB_Z+1) + RETURN + ENDIF + IERR=0 + CALL MUMPS_GET_MAX_NB_REQ_C(MAX_NB_REQ,IERR) + ALLOCATE(SIZE_OF_READ(MAX_NB_REQ),FIRST_POS_IN_READ(MAX_NB_REQ), + & READ_DEST(MAX_NB_REQ),READ_MNG(MAX_NB_REQ), + & REQ_TO_ZONE(MAX_NB_REQ),REQ_ID(MAX_NB_REQ),stat=allocok) + SIZE_OF_READ=-9999_8 + FIRST_POS_IN_READ=-9999 + READ_DEST=-9999_8 + READ_MNG=-9999 + REQ_TO_ZONE=-9999 + REQ_ID=-9999 + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = 6*(NB_Z+1) + RETURN + ENDIF + MIN_SIZE_READ=min(max((1024_8*1024_8)/int(id%KEEP(35),8), + & SIZE_ZONE_SOLVE/3_8), + & SIZE_ZONE_SOLVE) + TMP_SIZE8=1_8 + J=1 + DO I=1,NB_Z-1 + IDEB_SOLVE_Z(I)=TMP_SIZE8 + POSFAC_SOLVE(I)=TMP_SIZE8 + LRLUS_SOLVE(I)=SIZE_ZONE_SOLVE + LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE + LRLU_SOLVE_B(I)=0_8 + SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE + CURRENT_POS_T(I)=J + CURRENT_POS_B(I)=J + PDEB_SOLVE_Z(I)=J + POS_HOLE_T(I)=J + POS_HOLE_B(I)=J + J=J+MAX_NB_NODES_FOR_ZONE + TMP_SIZE8=TMP_SIZE8+SIZE_ZONE_SOLVE + ENDDO + IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8 + PDEB_SOLVE_Z(NB_Z)=J + POSFAC_SOLVE(NB_Z)=TMP_SIZE8 + LRLUS_SOLVE(NB_Z)=SIZE_SOLVE_EMM + LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM + LRLU_SOLVE_B(NB_Z)=0_8 + SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM + CURRENT_POS_T(NB_Z)=J + CURRENT_POS_B(NB_Z)=J + POS_HOLE_T(NB_Z)=J + POS_HOLE_B(NB_Z)=J + IO_REQ=-77777 + REQ_ACT=0 + OOC_STATE_NODE(1:KEEP_OOC(28))=NOT_IN_MEM + IF(KEEP_OOC(38).NE.0)THEN + MASTER_ROOT=MUMPS_275( + & PROCNODE_OOC(STEP_OOC( KEEP_OOC(38))), + & SLAVEF_OOC ) + SPECIAL_ROOT_NODE=KEEP_OOC(38) + ELSEIF(KEEP_OOC(20).NE.0)THEN + MASTER_ROOT=MUMPS_275( + & PROCNODE_OOC(STEP_OOC( KEEP_OOC(20))), + & SLAVEF_OOC ) + SPECIAL_ROOT_NODE=KEEP_OOC(20) + ELSE + MASTER_ROOT=-111111 + SPECIAL_ROOT_NODE=-2222222 + ENDIF + IF ( KEEP_OOC(60).EQ.0 .AND. + & ( + & (KEEP_OOC(38).NE.0 .AND. id%root%yes) + & .OR. + & (KEEP_OOC(20).NE.0 .AND. MYID_OOC.EQ.MASTER_ROOT)) + & ) + & THEN + IS_ROOT_SPECIAL = .TRUE. + ELSE + IS_ROOT_SPECIAL = .FALSE. + ENDIF + NB_ZONE_REQ=0 + SIZE_ZONE_REQ=0_8 + CURRENT_SOLVE_READ_ZONE=0 + NB_CALLED=0 + NB_CALL=0 + SOLVE_STEP=-9999 +#if defined (NEW_PREF_SCHEME) + MAX_PREF_SIZE=(1024*1024*2)/8 +#endif + RETURN + END SUBROUTINE SMUMPS_586 + SUBROUTINE SMUMPS_585(A,LA,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER NSTEPS,IERR + INTEGER(8) :: LA + REAL A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER I + IERR=0 + IF(NB_Z.GT.1)THEN + IF(STRAT_IO_ASYNC)THEN + DO I=1,NB_Z-1 + CALL SMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDDO + ELSE + CALL SMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_585 + SUBROUTINE SMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER NSTEPS,IERR + INTEGER(8) :: LA + REAL A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER ZONE + CALL SMUMPS_603(ZONE) + IERR=0 + CALL SMUMPS_611(ZONE,A,LA,PTRFAC,NSTEPS,IERR) + RETURN + END SUBROUTINE SMUMPS_594 + SUBROUTINE SMUMPS_595(DEST,INDICE,SIZE, + & ZONE,PTRFAC,NSTEPS,POS_SEQ,NB_NODES,FLAG,IERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER ZONE,NSTEPS,FLAG,POS_SEQ,NB_NODES + REAL DEST + INTEGER (8) :: INDICE, SIZE, PTRFAC(NSTEPS) + INTEGER REQUEST,INODE,IERR + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER TYPE + INTEGER SIZE_INT1,SIZE_INT2 + TYPE=OOC_SOLVE_TYPE_FCT + IERR=0 + INODE=OOC_INODE_SEQUENCE(POS_SEQ,OOC_FCT_TYPE) + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO, + & DEST,SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + IF(STRAT_IO_ASYNC)THEN + CALL SMUMPS_597(INODE,SIZE,INDICE,ZONE, + & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ELSE + CALL SMUMPS_597(INODE,SIZE,INDICE,ZONE, + & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL SMUMPS_596(IO_REQ(STEP_OOC(INODE)), + & PTRFAC,NSTEPS) + REQ_ACT=REQ_ACT-1 + ENDIF + END SUBROUTINE SMUMPS_595 + SUBROUTINE SMUMPS_596(REQUEST,PTRFAC, + & NSTEPS) + IMPLICIT NONE + INTEGER NSTEPS,REQUEST + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER (8) :: LAST, POS_IN_S, J + INTEGER ZONE + INTEGER POS_REQ,I,TMP_NODE,POS_IN_MANAGE + INTEGER (8) SIZE + LOGICAL DONT_USE + EXTERNAL MUMPS_330,MUMPS_275 + INTEGER MUMPS_330,MUMPS_275 + POS_REQ=mod(REQUEST,MAX_NB_REQ)+1 + SIZE=SIZE_OF_READ(POS_REQ) + I=FIRST_POS_IN_READ(POS_REQ) + POS_IN_S=READ_DEST(POS_REQ) + POS_IN_MANAGE=READ_MNG(POS_REQ) + ZONE=REQ_TO_ZONE(POS_REQ) + DONT_USE=.FALSE. + J=0_8 + DO WHILE((J.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))) + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + I=I+1 + CYCLE + ENDIF + IF((INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0).AND. + & (INODE_TO_POS(STEP_OOC(TMP_NODE)).LT. + & -((N_OOC+1)*NB_Z)))THEN + DONT_USE= + & (((MTYPE_OOC.EQ.1).AND.(KEEP_OOC(50).EQ.0).AND. + & (SOLVE_STEP.EQ.1).AND. + & ((MUMPS_330(PROCNODE_OOC(STEP_OOC(TMP_NODE)), + & SLAVEF_OOC).EQ.2).AND.(MUMPS_275( + & PROCNODE_OOC(STEP_OOC(TMP_NODE)),SLAVEF_OOC).NE. + & MYID_OOC))) + & .OR. + & ((MTYPE_OOC.NE.1).AND.(KEEP_OOC(50).EQ.0).AND. + & (SOLVE_STEP.EQ.0).AND. + & ((MUMPS_330(PROCNODE_OOC(STEP_OOC(TMP_NODE)), + & SLAVEF_OOC).EQ.2).AND.(MUMPS_275( + & PROCNODE_OOC(STEP_OOC(TMP_NODE)),SLAVEF_OOC).NE. + & MYID_OOC)))).OR. + & (OOC_STATE_NODE(STEP_OOC(TMP_NODE)).EQ.ALREADY_USED) + IF(DONT_USE)THEN + PTRFAC(STEP_OOC(TMP_NODE))=-POS_IN_S + ELSE + PTRFAC(STEP_OOC(TMP_NODE))=POS_IN_S + ENDIF + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).LT. + & IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Inernal error (42) in OOC ', + & PTRFAC(STEP_OOC(TMP_NODE)),IDEB_SOLVE_Z(ZONE) + CALL MUMPS_ABORT() + ENDIF + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).GT. + & (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN + WRITE(*,*)MYID_OOC,': Inernal error (43) in OOC ' + CALL MUMPS_ABORT() + ENDIF + IF(DONT_USE)THEN + POS_IN_MEM(POS_IN_MANAGE)=-TMP_NODE + INODE_TO_POS(STEP_OOC(TMP_NODE))=-POS_IN_MANAGE + IF(OOC_STATE_NODE(STEP_OOC(TMP_NODE)).NE. + & ALREADY_USED)THEN + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=USED_NOT_PERMUTED + ENDIF + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+LAST + ELSE + POS_IN_MEM(POS_IN_MANAGE)=TMP_NODE + INODE_TO_POS(STEP_OOC(TMP_NODE))=POS_IN_MANAGE + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + ENDIF + IO_REQ(STEP_OOC(TMP_NODE))=-7777 + ELSE + POS_IN_MEM(POS_IN_MANAGE)=0 + ENDIF + POS_IN_S=POS_IN_S+LAST + POS_IN_MANAGE=POS_IN_MANAGE+1 + J=J+LAST + I=I+1 + ENDDO + SIZE_OF_READ(POS_REQ)=-9999_8 + FIRST_POS_IN_READ(POS_REQ)=-9999 + READ_DEST(POS_REQ)=-9999_8 + READ_MNG(POS_REQ)=-9999 + REQ_TO_ZONE(POS_REQ)=-9999 + REQ_ID(POS_REQ)=-9999 + RETURN + END SUBROUTINE SMUMPS_596 + SUBROUTINE SMUMPS_597(INODE,SIZE,DEST,ZONE, + & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER INODE,ZONE,REQUEST,FLAG,POS_SEQ,NB_NODES,NSTEPS + INTEGER(8) :: SIZE + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER(8) :: DEST, LOCAL_DEST, J8 + INTEGER I,TMP_NODE,LOC_I,POS_REQ,NB + INTEGER(8)::LAST + INTEGER, intent(out) :: IERR + IERR=0 + IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + RETURN + ENDIF + NB=0 + LOCAL_DEST=DEST + I=POS_SEQ + POS_REQ=mod(REQUEST,MAX_NB_REQ)+1 + IF(REQ_ID(POS_REQ).NE.-9999)THEN + CALL MUMPS_WAIT_REQUEST(REQ_ID(POS_REQ),IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + CALL SMUMPS_596(REQUEST,PTRFAC,NSTEPS) + REQ_ACT=REQ_ACT-1 + ENDIF + SIZE_OF_READ(POS_REQ)=SIZE + FIRST_POS_IN_READ(POS_REQ)=I + READ_DEST(POS_REQ)=DEST + IF(FLAG.EQ.0)THEN + READ_MNG(POS_REQ)=CURRENT_POS_B(ZONE)-NB_NODES+1 + ELSEIF(FLAG.EQ.1)THEN + READ_MNG(POS_REQ)=CURRENT_POS_T(ZONE) + ENDIF + REQ_TO_ZONE(POS_REQ)=ZONE + REQ_ID(POS_REQ)=REQUEST + J8=0_8 + IF(FLAG.EQ.0)THEN + LOC_I=CURRENT_POS_B(ZONE)-NB_NODES+1 + ENDIF + DO WHILE((J8.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))) + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + INODE_TO_POS(STEP_OOC(TMP_NODE))=1 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + I=I+1 + CYCLE + ENDIF + IF((IO_REQ(STEP_OOC(TMP_NODE)).GE.0).OR. + & (INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0))THEN + IF(FLAG.EQ.1)THEN + POS_IN_MEM(CURRENT_POS_T(ZONE))=0 + ELSEIF(FLAG.EQ.0)THEN + POS_IN_MEM(CURRENT_POS_B(ZONE))=0 + ENDIF + ELSE + IO_REQ(STEP_OOC(TMP_NODE))=REQUEST + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-LAST + IF(FLAG.EQ.1)THEN + IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + CURRENT_POS_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+LAST + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)-LAST + POS_IN_MEM(CURRENT_POS_T(ZONE))=-TMP_NODE- + & ((N_OOC+1)*NB_Z) + INODE_TO_POS(STEP_OOC(TMP_NODE))=-CURRENT_POS_T(ZONE)- + & ((N_OOC+1)*NB_Z) + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ + PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST + LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(FLAG.EQ.0)THEN + LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)-LAST + POS_IN_MEM(LOC_I)=-TMP_NODE-((N_OOC+1)*NB_Z) + IF(LOC_I.EQ.POS_HOLE_T(ZONE))THEN + IF(POS_HOLE_T(ZONE).LT.CURRENT_POS_T(ZONE))THEN + POS_HOLE_T(ZONE)=POS_HOLE_T(ZONE)+1 + ENDIF + ENDIF + INODE_TO_POS(STEP_OOC(TMP_NODE))=-LOC_I-((N_OOC+1)*NB_Z) + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ + PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST + LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSE + WRITE(*,*)MYID_OOC,': Internal error (39) in OOC ', + & ' Invalid Flag Value in ', + & ' SMUMPS_597',FLAG + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).NE.0)THEN + IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).EQ. + & POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))THEN + IF(CURRENT_POS_T(ZONE).NE.PDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (40) in OOC ', + & CURRENT_POS_T(ZONE), + & PDEB_SOLVE_Z(ZONE), + & POS_IN_MEM(CURRENT_POS_T(ZONE)), + & POS_IN_MEM(PDEB_SOLVE_Z(ZONE)) + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + J8=J8+LAST + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (41) in OOC ', + & ' LRLUS_SOLVE must be (1) > 0', + & LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + I=I+1 + IF(FLAG.EQ.1)THEN + CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1 + IF(CURRENT_POS_T(ZONE).GT. + & MAX_NB_NODES_FOR_ZONE+PDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (1) in OOC ' + CALL MUMPS_ABORT() + ENDIF + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + ELSEIF(FLAG.EQ.0)THEN + IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (2) in OOC ', + & POS_HOLE_B(ZONE),LOC_I + CALL MUMPS_ABORT() + ENDIF + CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1 + POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE) + IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + ELSE + WRITE(*,*)MYID_OOC,': Internal error (3) in OOC ', + & ' Invalid Flag Value in ', + & ' SMUMPS_597',FLAG + CALL MUMPS_ABORT() + ENDIF + IF(FLAG.EQ.0)THEN + LOC_I=LOC_I+1 + ENDIF + NB=NB+1 + ENDDO + IF(NB.NE.NB_NODES)THEN + WRITE(*,*)MYID_OOC,': Internal error (4) in OOC ', + & ' SMUMPS_597 ',NB,NB_NODES + ENDIF + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=I + ELSE + CUR_POS_SEQUENCE=POS_SEQ-1 + ENDIF + RETURN + END SUBROUTINE SMUMPS_597 + SUBROUTINE SMUMPS_598(INODE,PTRFAC,NSTEPS,A, + & LA,FLAG,IERR) + IMPLICIT NONE + INTEGER(8) :: LA + INTEGER, intent(out):: IERR + REAL A(LA) + INTEGER INODE,NSTEPS + INTEGER(8) :: PTRFAC(NSTEPS) + LOGICAL FLAG + INTEGER(8) FREE_SIZE + INTEGER TMP,TMP_NODE,I,ZONE,J, FREE_HOLE_FLAG + INTEGER WHICH + INTEGER(8) :: DUMMY_SIZE + DUMMY_SIZE=1_8 + IERR = 0 + WHICH=-1 + IF(INODE_TO_POS(STEP_OOC(INODE)).LE.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (5) in OOC ', + & ' Problem in SMUMPS_598', + & INODE, STEP_OOC(INODE), INODE_TO_POS(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE).EQ.0_8)THEN + INODE_TO_POS(STEP_OOC(INODE))=0 + OOC_STATE_NODE(STEP_OOC(INODE))=ALREADY_USED + RETURN + ENDIF + CALL SMUMPS_600(INODE,ZONE,PTRFAC,NSTEPS) + TMP=INODE_TO_POS(STEP_OOC(INODE)) + INODE_TO_POS(STEP_OOC(INODE))=-TMP + POS_IN_MEM(TMP)=-INODE + PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE)) + IF (KEEP_OOC(237).eq.0) THEN + IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.PERMUTED)THEN + WRITE(*,*)MYID_OOC,': INTERNAL ERROR (53) in OOC',INODE, + & OOC_STATE_NODE(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + ENDIF + OOC_STATE_NODE(STEP_OOC(INODE))=USED + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+ + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (6) in OOC ', + & ': LRLUS_SOLVE must be (2) > 0' + CALL MUMPS_ABORT() + ENDIF + IF(ZONE.EQ.NB_Z)THEN + IF(INODE.NE.SPECIAL_ROOT_NODE)THEN + CALL SMUMPS_608(A,FACT_AREA_SIZE, + & DUMMY_SIZE,PTRFAC,KEEP_OOC(28),ZONE,IERR) + ENDIF + ELSE + FREE_HOLE_FLAG=0 + IF(SOLVE_STEP.EQ.0)THEN + IF(TMP.GT.POS_HOLE_B(ZONE))THEN + WHICH=0 + ELSEIF(TMP.LT.POS_HOLE_T(ZONE))THEN + WHICH=1 + ENDIF + ELSEIF(SOLVE_STEP.EQ.1)THEN + IF(TMP.LT.POS_HOLE_T(ZONE))THEN + WHICH=1 + ELSEIF(TMP.GT.POS_HOLE_B(ZONE))THEN + WHICH=0 + ENDIF + ENDIF + IF(WHICH.EQ.1)THEN + J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + FREE_SIZE=0_8 + DO I=J,TMP,-1 + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + GOTO 666 + ENDIF + ENDDO + POS_HOLE_T(ZONE)=TMP + 666 CONTINUE + ELSEIF(WHICH.EQ.0)THEN + J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + FREE_SIZE=0_8 + DO I=J,TMP + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + IF(J.EQ.PDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + CURRENT_POS_B(ZONE)=-9999 + ENDIF + GOTO 777 + ENDIF + ENDDO + POS_HOLE_B(ZONE)=TMP + 777 CONTINUE + ENDIF + IERR=0 + ENDIF + IF((NB_Z.GT.1).AND.FLAG)THEN + CALL SMUMPS_601(ZONE) + IF((LRLUS_SOLVE(ZONE).GE.MIN_SIZE_READ).OR. + & (LRLUS_SOLVE(ZONE).GE. + & int(0.3E0*real(SIZE_SOLVE_Z(ZONE)),8)))THEN + CALL SMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ELSE + CALL SMUMPS_603(ZONE) + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_598 + FUNCTION SMUMPS_726(INODE,PTRFAC,NSTEPS,A,LA, + & IERR) + IMPLICIT NONE + INTEGER INODE,NSTEPS + INTEGER(8) :: LA + INTEGER, INTENT(out)::IERR + REAL A(LA) + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER SMUMPS_726 + IERR=0 + IF(INODE_TO_POS(STEP_OOC(INODE)).GT.0)THEN + IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN + SMUMPS_726=OOC_NODE_PERMUTED + ELSE + SMUMPS_726=OOC_NODE_NOT_PERMUTED + ENDIF + IF(.NOT.SMUMPS_727())THEN + IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE) + & .EQ.INODE)THEN + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ELSEIF(SOLVE_STEP.EQ.1)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + CALL SMUMPS_728() + ENDIF + ENDIF + ELSEIF(INODE_TO_POS(STEP_OOC(INODE)).LT.0)THEN + IF(INODE_TO_POS(STEP_OOC(INODE)).LT.-((N_OOC+1)*NB_Z))THEN + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(INODE)),IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': Internal error (7) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + CALL SMUMPS_596(IO_REQ(STEP_OOC(INODE)), + & PTRFAC,NSTEPS) + REQ_ACT=REQ_ACT-1 + ELSE + CALL SMUMPS_599(INODE,PTRFAC,NSTEPS) + IF(.NOT.SMUMPS_727())THEN + IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ. + & INODE)THEN + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ELSEIF(SOLVE_STEP.EQ.1)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + CALL SMUMPS_728() + ENDIF + ENDIF + ENDIF + IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN + SMUMPS_726=OOC_NODE_PERMUTED + ELSE + SMUMPS_726=OOC_NODE_NOT_PERMUTED + ENDIF + ELSE + SMUMPS_726=OOC_NODE_NOT_IN_MEM + ENDIF + RETURN + END FUNCTION SMUMPS_726 + SUBROUTINE SMUMPS_682(INODE) + IMPLICIT NONE + INTEGER INODE + IF ( (KEEP_OOC(237).EQ.0) + & .AND. (KEEP_OOC(235).EQ.0) ) THEN + IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.NOT_USED)THEN + WRITE(*,*)MYID_OOC,': INTERNAL ERROR (51) in OOC',INODE, + & OOC_STATE_NODE(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + ENDIF + OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED + END SUBROUTINE SMUMPS_682 + SUBROUTINE SMUMPS_599(INODE,PTRFAC,NSTEPS) + IMPLICIT NONE + INTEGER INODE,NSTEPS + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER ZONE + INODE_TO_POS(STEP_OOC(INODE))=-INODE_TO_POS(STEP_OOC(INODE)) + POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE)))= + & -POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE))) + PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE)) + IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED_NOT_PERMUTED)THEN + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + ELSEIF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED)THEN + OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED + ELSE + WRITE(*,*)MYID_OOC,': Internal error (52) in OOC',INODE, + & OOC_STATE_NODE(STEP_OOC(INODE)), + & INODE_TO_POS(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + CALL SMUMPS_610(PTRFAC(STEP_OOC(INODE)),ZONE) + IF(INODE_TO_POS(STEP_OOC(INODE)).LE.POS_HOLE_B(ZONE))THEN + IF(INODE_TO_POS(STEP_OOC(INODE)).GT. + & PDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)= + & INODE_TO_POS(STEP_OOC(INODE))-1 + ELSE + CURRENT_POS_B(ZONE)=-9999 + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + ENDIF + IF(INODE_TO_POS(STEP_OOC(INODE)).GE.POS_HOLE_T(ZONE))THEN + IF(INODE_TO_POS(STEP_OOC(INODE)).LT. + & CURRENT_POS_T(ZONE)-1)THEN + POS_HOLE_T(ZONE)=INODE_TO_POS(STEP_OOC(INODE))+1 + ELSE + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + ENDIF + ENDIF + CALL SMUMPS_609(INODE,PTRFAC,NSTEPS,1) + END SUBROUTINE SMUMPS_599 + SUBROUTINE SMUMPS_600(INODE,ZONE,PTRFAC,NSTEPS) + IMPLICIT NONE + INTEGER INODE,ZONE,NSTEPS + INTEGER (8) :: PTRFAC(NSTEPS) + ZONE=1 + DO WHILE (ZONE.LE.NB_Z) + IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN + ZONE=ZONE-1 + EXIT + ENDIF + ZONE=ZONE+1 + ENDDO + IF(ZONE.EQ.NB_Z+1)THEN + ZONE=ZONE-1 + ENDIF + END SUBROUTINE SMUMPS_600 + SUBROUTINE SMUMPS_601(ZONE) + IMPLICIT NONE + INTEGER ZONE + ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1)+1 + END SUBROUTINE SMUMPS_601 + SUBROUTINE SMUMPS_603(ZONE) + IMPLICIT NONE + INTEGER ZONE + IF(NB_Z.GT.1)THEN + CURRENT_SOLVE_READ_ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1) + ZONE=CURRENT_SOLVE_READ_ZONE+1 + ELSE + ZONE=NB_Z + ENDIF + END SUBROUTINE SMUMPS_603 + SUBROUTINE SMUMPS_578(INODE,PTRFAC, + & KEEP,KEEP8, + & A,IERR) + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER, intent(out)::IERR + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)) + REAL A(FACT_AREA_SIZE) + INTEGER(8) :: REQUESTED_SIZE + INTEGER ZONE,IFLAG + IERR=0 + IFLAG=0 + IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + & .EQ.0_8)THEN + INODE_TO_POS(STEP_OOC(INODE))=1 + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + PTRFAC(STEP_OOC(INODE))=1_8 + RETURN + ENDIF + REQUESTED_SIZE=SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + ZONE=NB_Z + IF(CURRENT_POS_T(ZONE).GT. + & (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1))THEN + CALL SMUMPS_608(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + IF((LRLU_SOLVE_T(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE), + & OOC_FCT_TYPE)).AND. + & (CURRENT_POS_T(ZONE).LE. + & (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN + CALL SMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSEIF(LRLU_SOLVE_B(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE), + & OOC_FCT_TYPE).AND. + & (CURRENT_POS_B(ZONE).GT.0))THEN + CALL SMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSE + IF(SMUMPS_579(INODE,ZONE))THEN + IF(SOLVE_STEP.EQ.0)THEN + CALL SMUMPS_604(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL SMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSEIF(IFLAG.EQ.0)THEN + CALL SMUMPS_605(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL SMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ENDIF + ENDIF + ELSE + CALL SMUMPS_605(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL SMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSEIF(IFLAG.EQ.0)THEN + CALL SMUMPS_604(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL SMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ENDIF + ENDIF + ENDIF + IF(IFLAG.EQ.0)THEN + CALL SMUMPS_608(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL SMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ENDIF + ELSE + WRITE(*,*)MYID_OOC,': Internal error (8) in OOC ', + & ' Not enough space for Solve',INODE, + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE), + & LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (9) in OOC ', + & ' LRLUS_SOLVE must be (3) > 0' + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE SMUMPS_578 + SUBROUTINE SMUMPS_604(A,LA,REQUESTED_SIZE,PTRFAC, + & NSTEPS,ZONE,FLAG,IERR) + IMPLICIT NONE + INTEGER NSTEPS,ZONE,FLAG + INTEGER(8) :: REQUESTED_SIZE, LA + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER(8) :: FREE_SIZE, FREE_HOLE, FREE_HOLE_POS + REAL A(LA) + INTEGER I,TMP_NODE,FREE_HOLE_FLAG, J + INTEGER, intent(out)::IERR + IERR=0 + FLAG=0 + IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE).AND. + & (.NOT.(CURRENT_POS_T(ZONE) + & .GT.PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN + GOTO 50 + ENDIF + J=max(POS_HOLE_B(ZONE),PDEB_SOLVE_Z(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + DO I=POS_HOLE_T(ZONE)-1,J,-1 + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + EXIT + ENDIF + ENDDO + POS_HOLE_T(ZONE)=I+1 + IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR. + & (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR. + & (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN + CURRENT_POS_B(ZONE)=-9999 + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE) + ENDIF + FREE_HOLE=0_8 + FREE_SIZE=0_8 + FREE_HOLE_FLAG=0 + FREE_HOLE_POS=POSFAC_SOLVE(ZONE) + DO I=CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),-1 + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + FREE_HOLE_FLAG=0 + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE))) + PTRFAC(STEP_OOC(TMP_NODE))=-777777_8 + INODE_TO_POS(STEP_OOC(TMP_NODE))=0 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED + POS_IN_MEM(I)=0 + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).EQ.0)THEN + FREE_HOLE_FLAG=1 + ELSEIF(POS_IN_MEM(I).NE.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (10) in OOC ', + & ' SMUMPS_604', + & CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),I + CALL MUMPS_ABORT() + ENDIF + ENDDO + IF(POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE))THEN + IF(FREE_HOLE_FLAG.EQ.0)THEN + FREE_HOLE_FLAG=1 + ENDIF + ENDIF + IF(FREE_HOLE_FLAG.EQ.1)THEN + IF(POS_HOLE_T(ZONE)-1.GT.PDEB_SOLVE_Z(ZONE))THEN + I=POS_HOLE_T(ZONE)-1 + TMP_NODE=abs(POS_IN_MEM(I)) + IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN + TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (11) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + CALL MUMPS_ABORT() + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL SMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSEIF(TMP_NODE.EQ.0)THEN + DO J=I,PDEB_SOLVE_Z(ZONE),-1 + IF(POS_IN_MEM(J).NE.0) EXIT + ENDDO + IF(POS_IN_MEM(J).LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (12) in OOC ', + & ' SMUMPS_604' + CALL MUMPS_ABORT() + ENDIF + IF(J.GE.PDEB_SOLVE_Z(ZONE))THEN + TMP_NODE=POS_IN_MEM(J) + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSE + FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE) + ENDIF + ELSEIF(TMP_NODE.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (13) in OOC', + & ' SMUMPS_604' + CALL MUMPS_ABORT() + ELSE + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ENDIF + ELSE + FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE) + ENDIF + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + CURRENT_POS_T(ZONE)=POS_HOLE_T(ZONE) + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+FREE_SIZE + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-FREE_SIZE + 50 CONTINUE + IF(REQUESTED_SIZE.LE.LRLU_SOLVE_T(ZONE))THEN + FLAG=1 + ELSE + FLAG=0 + ENDIF + RETURN + END SUBROUTINE SMUMPS_604 + SUBROUTINE SMUMPS_605(A,LA,REQUESTED_SIZE, + & PTRFAC,NSTEPS,ZONE,FLAG,IERR) + IMPLICIT NONE + INTEGER NSTEPS,ZONE,FLAG + INTEGER (8) :: REQUESTED_SIZE + INTEGER (8) :: LA + INTEGER (8) :: PTRFAC(NSTEPS) + REAL A(LA) + INTEGER(8) :: FREE_SIZE, FREE_HOLE_POS, FREE_HOLE + INTEGER I,J,TMP_NODE,FREE_HOLE_FLAG + INTEGER, intent(out) :: IERR + IERR=0 + FLAG=0 + IF(LRLU_SOLVE_B(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN + GOTO 50 + ENDIF + IF(POS_HOLE_B(ZONE).EQ.-9999)THEN + GOTO 50 + ENDIF + J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + DO I=POS_HOLE_B(ZONE)+1,J + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + EXIT + ENDIF + ENDDO + POS_HOLE_B(ZONE)=I-1 + IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR. + & (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR. + & (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN + CURRENT_POS_B(ZONE)=-9999 + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE) + ENDIF + FREE_HOLE=0_8 + FREE_SIZE=0_8 + FREE_HOLE_FLAG=0 + FREE_HOLE_POS=IDEB_SOLVE_Z(ZONE) + IF(POS_HOLE_B(ZONE).EQ.-9999)THEN + GOTO 50 + ENDIF + DO I=PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE) + IF((POS_IN_MEM(I).LE.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + IF(TMP_NODE.NE.0)THEN + IF(I.EQ.PDEB_SOLVE_Z(ZONE))THEN + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE. + & IDEB_SOLVE_Z(ZONE))THEN + FREE_SIZE=FREE_SIZE+abs(PTRFAC(STEP_OOC(TMP_NODE))) + & -IDEB_SOLVE_Z(ZONE) + ENDIF + ENDIF + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + FREE_HOLE_FLAG=0 + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(TMP_NODE))=-777777_8 + INODE_TO_POS(STEP_OOC(TMP_NODE))=0 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSE + FREE_HOLE_FLAG=1 + ENDIF + POS_IN_MEM(I)=0 + ELSEIF(POS_IN_MEM(I).NE.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (14) in OOC ', + & ' SMUMPS_605', + & CURRENT_POS_T(ZONE)-1,POS_HOLE_B(ZONE),I,POS_IN_MEM(I) + CALL MUMPS_ABORT() + ENDIF + ENDDO + IF(FREE_HOLE_FLAG.EQ.1)THEN + IF(POS_HOLE_B(ZONE)+1.LT.CURRENT_POS_T(ZONE)-1)THEN + I=POS_HOLE_B(ZONE)+1 + TMP_NODE=abs(POS_IN_MEM(I)) + IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN + TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (15) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + CALL MUMPS_ABORT() + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL SMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-FREE_HOLE_POS + ELSEIF(TMP_NODE.EQ.0)THEN + DO J=I,CURRENT_POS_T(ZONE)-1 + IF(POS_IN_MEM(J).NE.0) EXIT + ENDDO + IF(POS_IN_MEM(J).LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (16) in OOC ', + & ' SMUMPS_605' + CALL MUMPS_ABORT() + ENDIF + IF(J.LE.CURRENT_POS_T(ZONE)-1)THEN + TMP_NODE=POS_IN_MEM(J) + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + ELSE + FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS + ENDIF + ELSEIF(TMP_NODE.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (17) in OOC ', + & ' SMUMPS_605' + CALL MUMPS_ABORT() + ELSE + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + ENDIF + ELSE + FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS + ENDIF + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + LRLU_SOLVE_B(ZONE)=FREE_SIZE + IF(POS_HOLE_B(ZONE).LT.CURRENT_POS_T(ZONE)-1)THEN + TMP_NODE=POS_IN_MEM(POS_HOLE_B(ZONE)+1) + IF(TMP_NODE.LT.-(N_OOC+1)*NB_Z)THEN + TMP_NODE=abs(TMP_NODE)-(N_OOC+1)*NB_Z + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (18) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + CALL MUMPS_ABORT() + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL SMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + ENDIF + LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)+ + & (abs(PTRFAC(STEP_OOC(abs(TMP_NODE))))-IDEB_SOLVE_Z(ZONE)- + & LRLU_SOLVE_B(ZONE)) + ENDIF + CURRENT_POS_B(ZONE)=POS_HOLE_B(ZONE) + 50 CONTINUE + IF((POS_HOLE_B(ZONE).EQ.-9999).AND. + & (LRLU_SOLVE_B(ZONE).NE.0_8))THEN + WRITE(*,*)MYID_OOC,': Internal error (19) in OOC ', + & 'SMUMPS_605' + CALL MUMPS_ABORT() + ENDIF + IF((REQUESTED_SIZE.LE.LRLU_SOLVE_B(ZONE)).AND. + & (POS_HOLE_B(ZONE).NE.-9999))THEN + FLAG=1 + ELSE + FLAG=0 + ENDIF + END SUBROUTINE SMUMPS_605 + SUBROUTINE SMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8, A,ZONE) + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)) + REAL A(FACT_AREA_SIZE) + INTEGER ZONE + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(INODE))=POSFAC_SOLVE(ZONE) + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + CURRENT_POS_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (20) in OOC ', + & ' Problem avec debut (2)',INODE, + & PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE),ZONE + CALL MUMPS_ABORT() + ENDIF + INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_T(ZONE) + POS_IN_MEM(CURRENT_POS_T(ZONE))=INODE + IF(CURRENT_POS_T(ZONE).GT.(PDEB_SOLVE_Z(ZONE)+ + & MAX_NB_NODES_FOR_ZONE-1))THEN + WRITE(*,*)MYID_OOC,': Internal error (21) in OOC ', + & ' Problem with CURRENT_POS_T', + & CURRENT_POS_T(ZONE),ZONE + CALL MUMPS_ABORT() + ENDIF + CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1 + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+ + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + END SUBROUTINE SMUMPS_606 + SUBROUTINE SMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8, + & A,ZONE) + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)) + REAL A(FACT_AREA_SIZE) + INTEGER ZONE + IF(POS_HOLE_B(ZONE).EQ.-9999)THEN + WRITE(*,*)MYID_OOC,': Internal error (22) in OOC ', + & ' SMUMPS_607' + CALL MUMPS_ABORT() + ENDIF + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(INODE))=IDEB_SOLVE_Z(ZONE)+ + & LRLU_SOLVE_B(ZONE) + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (23) in OOC ', + & PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE) + CALL MUMPS_ABORT() + ENDIF + INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_B(ZONE) + IF(CURRENT_POS_B(ZONE).EQ.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (23b) in OOC ' + CALL MUMPS_ABORT() + ENDIF + POS_IN_MEM(CURRENT_POS_B(ZONE))=INODE + CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1 + POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE) + END SUBROUTINE SMUMPS_607 + SUBROUTINE SMUMPS_608(A,LA,REQUESTED_SIZE,PTRFAC, + & NSTEPS,ZONE,IERR) + IMPLICIT NONE + INTEGER(8) :: LA, REQUESTED_SIZE + INTEGER NSTEPS,ZONE + INTEGER, intent(out) :: IERR + INTEGER(8) :: PTRFAC(NSTEPS) + REAL A(LA) + INTEGER (8) :: APOS_FIRST_FREE, + & SIZE_HOLE, + & FREE_HOLE, + & FREE_HOLE_POS + INTEGER J,I,TMP_NODE, NB_FREE, IPOS_FIRST_FREE + INTEGER(8) :: K8, AREA_POINTER + INTEGER FREE_HOLE_FLAG + IERR=0 + IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN + RETURN + ENDIF + AREA_POINTER=IDEB_SOLVE_Z(ZONE) + SIZE_HOLE=0_8 + DO I=PDEB_SOLVE_Z(ZONE),CURRENT_POS_T(ZONE)-1 + IF((POS_IN_MEM(I).LE.0).AND. + & (POS_IN_MEM(I).GT.-((N_OOC+1)*NB_Z))) GOTO 666 + TMP_NODE=abs(POS_IN_MEM(I)) + IF(TMP_NODE.GT.((N_OOC+1)*NB_Z))THEN + TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z) + ENDIF + AREA_POINTER=AREA_POINTER+ + & abs(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ENDDO + 666 CONTINUE + IF((I.EQ.CURRENT_POS_T(ZONE)-1).AND. + & (PDEB_SOLVE_Z(ZONE).NE.CURRENT_POS_T(ZONE)-1))THEN + IF((POS_IN_MEM(I).GT.0).OR. + & (POS_IN_MEM(I).LT.-((N_OOC+1)*NB_Z)))THEN + WRITE(*,*)MYID_OOC,': Internal error (25) in OOC ', + & ': There are no free blocks ', + & 'in SMUMPS_608',PDEB_SOLVE_Z(ZONE), + & CURRENT_POS_T(ZONE) + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF(POS_IN_MEM(I).EQ.0)THEN + APOS_FIRST_FREE=AREA_POINTER + FREE_HOLE_POS=AREA_POINTER + ELSE + TMP_NODE=abs(POS_IN_MEM(I)) + APOS_FIRST_FREE=abs(PTRFAC(STEP_OOC(TMP_NODE))) + ENDIF + IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).NE.0)THEN + IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).LT.-((N_OOC+1)*NB_Z))THEN + TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))- + & ((N_OOC+1)*NB_Z) + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL SMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + ELSE + TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE))) + ENDIF + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE.IDEB_SOLVE_Z(ZONE))THEN + IF((POS_IN_MEM(I).NE.0).OR.(I.EQ.CURRENT_POS_T(ZONE)))THEN + SIZE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & IDEB_SOLVE_Z(ZONE) + ENDIF + APOS_FIRST_FREE=IDEB_SOLVE_Z(ZONE) + IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).GT.0)THEN + DO J=PDEB_SOLVE_Z(ZONE),I-1 + TMP_NODE=POS_IN_MEM(J) + IF(TMP_NODE.LE.0)THEN + IF(TMP_NODE.LT.-((N_OOC+1)*NB_Z))THEN + TMP_NODE=abs(POS_IN_MEM(J))-((N_OOC+1)*NB_Z) + CALL MUMPS_WAIT_REQUEST( + & IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL SMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + TMP_NODE=POS_IN_MEM(J) + ELSE + WRITE(*,*)MYID_OOC,': Internal error (26) in OOC ', + & ' SMUMPS_608',TMP_NODE, + & J,I-1,(N_OOC+1)*NB_Z + CALL MUMPS_ABORT() + ENDIF + ENDIF + DO K8=1_8, + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + A(APOS_FIRST_FREE+K8-1_8)= + & A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8) + ENDDO + PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE + APOS_FIRST_FREE=APOS_FIRST_FREE+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + ENDDO + ENDIF + ENDIF + ENDIF + NB_FREE=0 + FREE_HOLE=0_8 + FREE_HOLE_FLAG=0 + DO J=I,CURRENT_POS_T(ZONE)-1 + TMP_NODE=abs(POS_IN_MEM(J)) + IF(POS_IN_MEM(J).LT.-((N_OOC+1)*NB_Z))THEN + TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z) + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL SMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + TMP_NODE=abs(POS_IN_MEM(J)) + ENDIF + IF(POS_IN_MEM(J).GT.0)THEN + DO K8=1_8,SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + A(APOS_FIRST_FREE+K8-1_8)= + & A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8) + ENDDO + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + FREE_HOLE_FLAG=0 + SIZE_HOLE=SIZE_HOLE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE + APOS_FIRST_FREE=APOS_FIRST_FREE+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(J).EQ.0)THEN + FREE_HOLE_FLAG=1 + NB_FREE=NB_FREE+1 + ELSE + NB_FREE=NB_FREE+1 + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + FREE_HOLE_FLAG=0 + SIZE_HOLE=SIZE_HOLE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + SIZE_HOLE=SIZE_HOLE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + PTRFAC(STEP_OOC(abs(POS_IN_MEM(J))))=-77777_8 + ENDIF + ENDDO + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS + FREE_HOLE_FLAG=0 + SIZE_HOLE=SIZE_HOLE+FREE_HOLE + ENDIF + IPOS_FIRST_FREE=I + DO J=I,CURRENT_POS_T(ZONE)-1 + IF(POS_IN_MEM(J).LT.0)THEN + TMP_NODE=abs(POS_IN_MEM(J)) + INODE_TO_POS(STEP_OOC(TMP_NODE))=0 + POS_IN_MEM(J)=0 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED + ELSEIF(POS_IN_MEM(J).GT.0)THEN + TMP_NODE=abs(POS_IN_MEM(J)) + POS_IN_MEM(IPOS_FIRST_FREE)=POS_IN_MEM(J) + INODE_TO_POS(STEP_OOC(TMP_NODE))=IPOS_FIRST_FREE + IPOS_FIRST_FREE=IPOS_FIRST_FREE+1 + ENDIF + ENDDO + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+SIZE_HOLE + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-SIZE_HOLE + CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)-NB_FREE + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + LRLU_SOLVE_B(ZONE)=0_8 + POS_HOLE_B(ZONE)=-9999 + CURRENT_POS_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + IF(LRLU_SOLVE_T(ZONE).NE.LRLUS_SOLVE(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (27) in OOC ', + & LRLU_SOLVE_T(ZONE), + & LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + LRLU_SOLVE_T(ZONE)=LRLUS_SOLVE(ZONE) + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (28) in OOC ', + & ' LRLUS_SOLVE must be (4) > 0' + CALL MUMPS_ABORT() + ENDIF + IF(POSFAC_SOLVE(ZONE).LT.IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (29) in OOC ', + & POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE) + CALL MUMPS_ABORT() + ENDIF + IF(POSFAC_SOLVE(ZONE).NE.(IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)- + & LRLUS_SOLVE(ZONE)))THEN + WRITE(*,*)MYID_OOC,': Internal error (30) in OOC ', + & ' Problem avec debut POSFAC_SOLVE', + & POSFAC_SOLVE(ZONE),(SIZE_SOLVE_Z(ZONE)- + & LRLUS_SOLVE(ZONE))+IDEB_SOLVE_Z(ZONE),LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + IF(POSFAC_SOLVE(ZONE).GT. + & (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN + WRITE(*,*)MYID_OOC,': Internal error (31) in OOC ', + & POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE)+ + & SIZE_SOLVE_Z(ZONE)-1_8 + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE SMUMPS_608 + SUBROUTINE SMUMPS_609(INODE,PTRFAC,NSTEPS,FLAG) + IMPLICIT NONE + INTEGER INODE,NSTEPS,FLAG + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER ZONE + IF((FLAG.LT.0).OR.(FLAG.GT.1))THEN + WRITE(*,*)MYID_OOC,': Internal error (32) in OOC ', + & ' SMUMPS_609' + CALL MUMPS_ABORT() + ENDIF + CALL SMUMPS_610(PTRFAC(STEP_OOC(INODE)),ZONE) + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (33) in OOC ', + & ' LRLUS_SOLVE must be (5) ++ > 0' + CALL MUMPS_ABORT() + ENDIF + IF(FLAG.EQ.0)THEN + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+ + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + ELSE + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + ENDIF + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (34) in OOC ', + & ' LRLUS_SOLVE must be (5) > 0' + CALL MUMPS_ABORT() + ENDIF + END SUBROUTINE SMUMPS_609 + SUBROUTINE SMUMPS_610(ADDR,ZONE) + IMPLICIT NONE + INTEGER (8) :: ADDR + INTEGER ZONE + INTEGER I + I=1 + DO WHILE (I.LE.NB_Z) + IF(ADDR.LT.IDEB_SOLVE_Z(I))THEN + EXIT + ENDIF + I=I+1 + ENDDO + ZONE=I-1 + END SUBROUTINE SMUMPS_610 + FUNCTION SMUMPS_727() + IMPLICIT NONE + LOGICAL SMUMPS_727 + SMUMPS_727=.FALSE. + IF(SOLVE_STEP.EQ.0)THEN + IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + SMUMPS_727=.TRUE. + ENDIF + ELSEIF(SOLVE_STEP.EQ.1)THEN + IF(CUR_POS_SEQUENCE.LT.1)THEN + SMUMPS_727=.TRUE. + ENDIF + ENDIF + RETURN + END FUNCTION SMUMPS_727 + SUBROUTINE SMUMPS_611(ZONE,A,LA,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER NSTEPS,ZONE + INTEGER(8), INTENT(IN) :: LA + INTEGER, intent(out) :: IERR + REAL A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER(8) :: SIZE, DEST + INTEGER(8) :: NEEDED_SIZE + INTEGER FLAG,TMP_FLAG,POS_SEQ,TMP_NODE, + & NB_NODES + IERR=0 + TMP_FLAG=0 + FLAG=0 + IF(SMUMPS_727())THEN + RETURN + ENDIF + IF(SOLVE_STEP.EQ.0)THEN + IF(CUR_POS_SEQUENCE.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT. + & SIZE_SOLVE_Z(ZONE)) + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + IF(SMUMPS_727())THEN + RETURN + ENDIF + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + ENDDO + CALL SMUMPS_728() + NEEDED_SIZE=max(MIN_SIZE_READ, + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSE + NEEDED_SIZE=MIN_SIZE_READ + ENDIF + ELSEIF(SOLVE_STEP.EQ.1)THEN + IF(CUR_POS_SEQUENCE.GE.1)THEN + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT. + & SIZE_SOLVE_Z(ZONE)) + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + IF(SMUMPS_727())THEN + RETURN + ENDIF + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + ENDDO + CALL SMUMPS_728() + NEEDED_SIZE=max(MIN_SIZE_READ, + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSE + NEEDED_SIZE=MIN_SIZE_READ + ENDIF + ENDIF + IF(LRLUS_SOLVE(ZONE).LT.NEEDED_SIZE)THEN + RETURN + ELSEIF((LRLU_SOLVE_T(ZONE).LT.NEEDED_SIZE).AND. + & (LRLU_SOLVE_B(ZONE).LT.NEEDED_SIZE).AND. + & (dble(LRLUS_SOLVE(ZONE)).LT.0.3d0* + & dble(SIZE_SOLVE_Z(ZONE)))) THEN + RETURN + ENDIF + IF((LRLU_SOLVE_T(ZONE).GT.NEEDED_SIZE).AND.(SOLVE_STEP.EQ.0).AND. + & ((CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1).LT. + & MAX_NB_NODES_FOR_ZONE))THEN + FLAG=1 + ELSE + IF(SOLVE_STEP.EQ.0)THEN + CALL SMUMPS_604(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=1 + IF(TMP_FLAG.EQ.0)THEN + CALL SMUMPS_605(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=0 + ENDIF + ELSE + CALL SMUMPS_605(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=0 + IF(TMP_FLAG.EQ.0)THEN + CALL SMUMPS_604(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=1 + ENDIF + ENDIF + IF(TMP_FLAG.EQ.0)THEN + CALL SMUMPS_608(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=1 + ENDIF + ENDIF + CALL SMUMPS_602(ZONE,SIZE,DEST,POS_SEQ, + & NB_NODES,FLAG,PTRFAC,NSTEPS) + IF(SIZE.EQ.0_8)THEN + RETURN + ENDIF + NB_ZONE_REQ=NB_ZONE_REQ+1 + SIZE_ZONE_REQ=SIZE_ZONE_REQ+SIZE + REQ_ACT=REQ_ACT+1 + CALL SMUMPS_595(A(DEST),DEST,SIZE,ZONE,PTRFAC,NSTEPS, + & POS_SEQ,NB_NODES,FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + END SUBROUTINE SMUMPS_611 + SUBROUTINE SMUMPS_602(ZONE,SIZE,DEST,POS_SEQ, + & NB_NODES,FLAG,PTRFAC,NSTEPS) + IMPLICIT NONE + INTEGER(8) :: SIZE, DEST + INTEGER ZONE,FLAG,POS_SEQ,NSTEPS + INTEGER(8) :: PTRFAC(NSTEPS), MAX_SIZE, LAST, J8 + INTEGER I,START_NODE,K,MAX_NB, + & NB_NODES + INTEGER NB_NODES_LOC + LOGICAL ALREADY + IF(SMUMPS_727())THEN + SIZE=0_8 + RETURN + ENDIF + IF(FLAG.EQ.0)THEN + MAX_SIZE=LRLU_SOLVE_B(ZONE) + MAX_NB=max(0,CURRENT_POS_B(ZONE)-PDEB_SOLVE_Z(ZONE)+1) + ELSEIF(FLAG.EQ.1)THEN + MAX_SIZE=LRLU_SOLVE_T(ZONE) + MAX_NB=MAX_NB_NODES_FOR_ZONE + ELSE + WRITE(*,*)MYID_OOC,': Internal error (35) in OOC ', + & ' Unknown Flag value in ', + & ' SMUMPS_602',FLAG + CALL MUMPS_ABORT() + ENDIF + CALL SMUMPS_728() + I=CUR_POS_SEQUENCE + START_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + ALREADY=.FALSE. + NB_NODES=0 + NB_NODES_LOC=0 +#if defined (NEW_PREF_SCHEME) + IF(MAX_SIZE.GT.MAX_PREF_SIZE)THEN + MAX_SIZE=MIN(MAX(MAX_PREF_SIZE, + & SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE)), + & MAX_SIZE) + ENDIF +#endif + IF(ZONE.EQ.NB_Z)THEN + SIZE=SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE) + ELSE + J8=0_8 + IF(FLAG.EQ.0)THEN + K=0 + ELSEIF(FLAG.EQ.1)THEN + K=CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1 + ENDIF + IF(SOLVE_STEP.EQ.0)THEN + I=CUR_POS_SEQUENCE + DO WHILE(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) + IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + & .NE.0_8)THEN + EXIT + ENDIF + I=I+1 + ENDDO + CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) + I=CUR_POS_SEQUENCE + DO WHILE((J8.LE.MAX_SIZE).AND. + & (I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND. + & (K.LT.MAX_NB) ) + LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + IF(.NOT.ALREADY)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ENDIF + I=I+1 + NB_NODES_LOC=NB_NODES_LOC+1 + CYCLE + ENDIF + IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))) + & .NE.0).OR. + & (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))).GE. + & 0))THEN + IF(.NOT.ALREADY)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + I=I+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ALREADY=.TRUE. + J8=J8+LAST + I=I+1 + K=K+1 + NB_NODES_LOC=NB_NODES_LOC+1 + NB_NODES=NB_NODES+1 + ENDDO + IF(J8.GT.MAX_SIZE)THEN + SIZE=J8-LAST + NB_NODES=NB_NODES-1 + NB_NODES_LOC=NB_NODES_LOC-1 + ELSE + SIZE=J8 + ENDIF + DO WHILE (CUR_POS_SEQUENCE+NB_NODES_LOC-1.GE. + & CUR_POS_SEQUENCE) + IF(SIZE_OF_BLOCK(STEP_OOC( + & OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE+NB_NODES-1, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + & .NE.0_8)THEN + EXIT + ENDIF + NB_NODES_LOC=NB_NODES_LOC-1 + ENDDO + POS_SEQ=CUR_POS_SEQUENCE + ELSEIF(SOLVE_STEP.EQ.1)THEN + DO WHILE(I.GE.1) + IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + & .NE.0_8)THEN + EXIT + ENDIF + I=I-1 + ENDDO + CUR_POS_SEQUENCE=max(I,1) + I=CUR_POS_SEQUENCE + DO WHILE((J8.LE.MAX_SIZE).AND.(I.GE.1).AND. + & (K.LT.MAX_NB)) + LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + IF(.NOT.ALREADY)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + NB_NODES_LOC=NB_NODES_LOC+1 + I=I-1 + CYCLE + ENDIF + IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))) + & .NE.0).OR. + & (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))).GE. + & 0))THEN + IF(.NOT.ALREADY)THEN + I=I-1 + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ALREADY=.TRUE. + J8=J8+LAST + I=I-1 + K=K+1 + NB_NODES=NB_NODES+1 + NB_NODES_LOC=NB_NODES_LOC+1 + ENDDO + IF(J8.GT.MAX_SIZE)THEN + SIZE=J8-LAST + NB_NODES=NB_NODES-1 + NB_NODES_LOC=NB_NODES_LOC-1 + ELSE + SIZE=J8 + ENDIF + I=CUR_POS_SEQUENCE-NB_NODES_LOC+1 + DO WHILE (I.LE.CUR_POS_SEQUENCE) + IF(SIZE_OF_BLOCK(STEP_OOC( + & OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)), + & OOC_FCT_TYPE).NE.0_8)THEN + EXIT + ENDIF + I=I+1 + NB_NODES_LOC=NB_NODES_LOC-1 + ENDDO + POS_SEQ=CUR_POS_SEQUENCE-NB_NODES_LOC+1 + ENDIF + ENDIF + IF(FLAG.EQ.0)THEN + DEST=IDEB_SOLVE_Z(ZONE)+LRLU_SOLVE_B(ZONE)-SIZE + ELSE + DEST=POSFAC_SOLVE(ZONE) + ENDIF + END SUBROUTINE SMUMPS_602 + SUBROUTINE SMUMPS_582(IERR) + IMPLICIT NONE + INTEGER SOLVE_OR_FACTO + INTEGER, intent(out) :: IERR + IERR=0 + IF(allocated(LRLUS_SOLVE))THEN + DEALLOCATE(LRLUS_SOLVE) + ENDIF + IF(allocated(LRLU_SOLVE_T))THEN + DEALLOCATE(LRLU_SOLVE_T) + ENDIF + IF(allocated(LRLU_SOLVE_B))THEN + DEALLOCATE(LRLU_SOLVE_B) + ENDIF + IF(allocated(POSFAC_SOLVE))THEN + DEALLOCATE(POSFAC_SOLVE) + ENDIF + IF(allocated(IDEB_SOLVE_Z))THEN + DEALLOCATE(IDEB_SOLVE_Z) + ENDIF + IF(allocated(PDEB_SOLVE_Z))THEN + DEALLOCATE(PDEB_SOLVE_Z) + ENDIF + IF(allocated(SIZE_SOLVE_Z))THEN + DEALLOCATE(SIZE_SOLVE_Z) + ENDIF + IF(allocated(CURRENT_POS_T))THEN + DEALLOCATE(CURRENT_POS_T) + ENDIF + IF(allocated(CURRENT_POS_B))THEN + DEALLOCATE(CURRENT_POS_B) + ENDIF + IF(allocated(POS_HOLE_T))THEN + DEALLOCATE(POS_HOLE_T) + ENDIF + IF(allocated(POS_HOLE_B))THEN + DEALLOCATE(POS_HOLE_B) + ENDIF + IF(allocated(OOC_STATE_NODE))THEN + DEALLOCATE(OOC_STATE_NODE) + ENDIF + IF(allocated(POS_IN_MEM))THEN + DEALLOCATE(POS_IN_MEM) + ENDIF + IF(allocated(INODE_TO_POS))THEN + DEALLOCATE(INODE_TO_POS) + ENDIF + IF(allocated(IO_REQ))THEN + DEALLOCATE(IO_REQ) + ENDIF + IF(allocated(SIZE_OF_READ))THEN + DEALLOCATE(SIZE_OF_READ) + ENDIF + IF(allocated(FIRST_POS_IN_READ))THEN + DEALLOCATE(FIRST_POS_IN_READ) + ENDIF + IF(allocated(READ_DEST))THEN + DEALLOCATE(READ_DEST) + ENDIF + IF(allocated(READ_MNG))THEN + DEALLOCATE(READ_MNG) + ENDIF + IF(allocated(REQ_TO_ZONE))THEN + DEALLOCATE(REQ_TO_ZONE) + ENDIF + IF(allocated(REQ_ID))THEN + DEALLOCATE(REQ_ID) + ENDIF + SOLVE_OR_FACTO=1 + CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + END SUBROUTINE SMUMPS_582 + SUBROUTINE SMUMPS_612(PTRFAC,NSTEPS, + & A,LA) + IMPLICIT NONE + INTEGER, INTENT(in) :: NSTEPS + INTEGER(8), INTENT(INOUT) :: PTRFAC(NSTEPS) + INTEGER(8), INTENT(IN) :: LA + REAL :: A(LA) + INTEGER :: I, TMP, ZONE, IPAS, IBEG, IEND + INTEGER(8) :: SAVE_PTR + LOGICAL :: COMPRESS_TO_BE_DONE, SET_POS_SEQUENCE + INTEGER :: J, IERR + INTEGER(8) :: DUMMY_SIZE + COMPRESS_TO_BE_DONE = .FALSE. + DUMMY_SIZE = 1_8 + IERR = 0 + SET_POS_SEQUENCE = .TRUE. + IF(SOLVE_STEP.EQ.0)THEN + IBEG = 1 + IEND = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + IPAS = 1 + ELSE + IBEG = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + IEND = 1 + IPAS = -1 + ENDIF + DO I=IBEG,IEND,IPAS + J = OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + TMP=INODE_TO_POS(STEP_OOC(J)) + IF(TMP.EQ.0)THEN + IF (SET_POS_SEQUENCE) THEN + SET_POS_SEQUENCE = .FALSE. + CUR_POS_SEQUENCE = I + ENDIF + IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN + OOC_STATE_NODE(STEP_OOC(J)) = NOT_IN_MEM + ENDIF + CYCLE + ELSE IF(TMP.LT.0)THEN + IF(TMP.GT.-(N_OOC+1)*NB_Z)THEN + SAVE_PTR=PTRFAC(STEP_OOC(J)) + PTRFAC(STEP_OOC(J)) = abs(SAVE_PTR) + CALL SMUMPS_600(J, + & ZONE,PTRFAC,NSTEPS) + PTRFAC(STEP_OOC(J)) = SAVE_PTR + IF(ZONE.EQ.NB_Z)THEN + IF(J.NE.SPECIAL_ROOT_NODE)THEN + WRITE(*,*)MYID_OOC,': Internal error 6 ', + & ' Node ', J, + & ' is in status USED in the + & emmergency buffer ' + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0) + & THEN + IF (OOC_STATE_NODE(STEP_OOC(J)).EQ.NOT_IN_MEM) THEN + OOC_STATE_NODE(STEP_OOC(J)) = USED + IF((SOLVE_STEP.NE.0).OR.(J.NE.SPECIAL_ROOT_NODE) + & .OR.(ZONE.NE.NB_Z))THEN + CALL SMUMPS_599(J,PTRFAC,NSTEPS) + ENDIF + CYCLE + ELSEIF(OOC_STATE_NODE(STEP_OOC(J)).EQ.ALREADY_USED) + & THEN + COMPRESS_TO_BE_DONE = .TRUE. + ELSE + WRITE(*,*)MYID_OOC,': Internal error Mila 4 ', + & ' wrong node status :', OOC_STATE_NODE(STEP_OOC(J)), + & ' on node ', J + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN + CALL SMUMPS_599(J,PTRFAC,NSTEPS) + ENDIF + ENDIF + ENDIF + ENDDO + IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0) + & THEN + IF (COMPRESS_TO_BE_DONE) THEN + DO ZONE=1,NB_Z-1 + CALL SMUMPS_608(A,LA, + & DUMMY_SIZE,PTRFAC, + & NSTEPS,ZONE,IERR) + IF (IERR .LT. 0) THEN + WRITE(*,*)MYID_OOC,': Internal error Mila 5 ', + & ' IERR on return to SMUMPS_608 =', + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_612 + SUBROUTINE SMUMPS_583(PTRFAC,NSTEPS,MTYPE, + & A,LA,DOPREFETCH,IERR) + IMPLICIT NONE + INTEGER NSTEPS,MTYPE + INTEGER, intent(out)::IERR + INTEGER(8) :: LA + REAL A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + LOGICAL DOPREFETCH + INTEGER MUMPS_808 + EXTERNAL MUMPS_808 + IERR = 0 + OOC_FCT_TYPE=MUMPS_808("F",MTYPE,KEEP_OOC(201), + & KEEP_OOC(50)) + OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1 + IF (KEEP_OOC(201).NE.1) THEN + OOC_SOLVE_TYPE_FCT = FCT + ENDIF + SOLVE_STEP=0 + CUR_POS_SEQUENCE=1 + MTYPE_OOC=MTYPE + IF ( KEEP_OOC(201).NE.1 +#if ! defined(TEMP_VERSION_TO_FORCE_DATA_REINIT) + & .OR. KEEP_OOC(50).NE.0 +#endif + & ) THEN + CALL SMUMPS_612(PTRFAC,NSTEPS,A,LA) + ELSE + CALL SMUMPS_683(KEEP_OOC(28), + & KEEP_OOC(38), KEEP_OOC(20) ) + ENDIF + IF (DOPREFETCH) THEN + CALL SMUMPS_585(A,LA,PTRFAC, + & KEEP_OOC(28),IERR) + ELSE + CUR_POS_SEQUENCE = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + ENDIF + RETURN + END SUBROUTINE SMUMPS_583 + SUBROUTINE SMUMPS_584(PTRFAC,NSTEPS,MTYPE, + & I_WORKED_ON_ROOT,IROOT,A,LA,IERR) + IMPLICIT NONE + INTEGER NSTEPS + INTEGER(8) :: LA + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER MTYPE + INTEGER IROOT + LOGICAL I_WORKED_ON_ROOT + INTEGER, intent(out):: IERR + REAL A(LA) + INTEGER(8) :: DUMMY_SIZE + INTEGER ZONE + INTEGER MUMPS_808 + EXTERNAL MUMPS_808 + IERR=0 + OOC_FCT_TYPE=MUMPS_808("B",MTYPE,KEEP_OOC(201), + & KEEP_OOC(50)) + OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1 + IF (KEEP_OOC(201).NE.1) OOC_SOLVE_TYPE_FCT=FCT + SOLVE_STEP=1 + CUR_POS_SEQUENCE=TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + MTYPE_OOC=MTYPE + IF ( KEEP_OOC(201).NE.1 +#if ! defined(TEMP_VERSION_TO_FORCE_DATA_REINIT) + & .OR. KEEP_OOC(50).NE.0 +#endif + & ) THEN + CALL SMUMPS_612(PTRFAC,NSTEPS,A,LA) + IF (I_WORKED_ON_ROOT) THEN + CALL SMUMPS_598 ( IROOT, + & PTRFAC, KEEP_OOC(28), A, LA,.FALSE.,IERR) + IF (IERR .LT. 0) RETURN + CALL SMUMPS_600(IROOT, + & ZONE,PTRFAC,NSTEPS) + IF(IROOT.EQ.NB_Z)THEN + DUMMY_SIZE=1_8 + CALL SMUMPS_608(A,LA, + & DUMMY_SIZE,PTRFAC, + & NSTEPS,NB_Z,IERR) + IF (IERR .LT. 0) THEN + WRITE(*,*)MYID_OOC,': Internal error in + & SMUMPS_608', + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + IF (NB_Z.GT.1) THEN + CALL SMUMPS_594(A,LA,PTRFAC, + & KEEP_OOC(28),IERR) + IF (IERR .LT. 0) RETURN + ENDIF + ELSE + CALL SMUMPS_683(KEEP_OOC(28), + & KEEP_OOC(38), KEEP_OOC(20) ) + CALL SMUMPS_585(A,LA,PTRFAC,KEEP_OOC(28),IERR) + IF (IERR .LT. 0 ) RETURN + ENDIF + RETURN + END SUBROUTINE SMUMPS_584 + SUBROUTINE SMUMPS_613(id,IERR) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(SMUMPS_STRUC), TARGET :: id + INTEGER, intent(out) :: IERR + INTEGER I,DIM,J,TMP,SIZE,K,I1 + CHARACTER*1 TMP_NAME(350) + EXTERNAL MUMPS_OOC_GET_NB_FILES_C, MUMPS_OOC_GET_FILE_NAME_C + IERR=0 + SIZE=0 + DO J=1,OOC_NB_FILE_TYPE + TMP=J-1 + CALL MUMPS_OOC_GET_NB_FILES_C(TMP,I) + id%OOC_NB_FILES(J)=I + SIZE=SIZE+I + ENDDO + IF(associated(id%OOC_FILE_NAMES))THEN + DEALLOCATE(id%OOC_FILE_NAMES) + NULLIFY(id%OOC_FILE_NAMES) + ENDIF + ALLOCATE(id%OOC_FILE_NAMES(SIZE,350),stat=IERR) + IF (IERR .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_613' + IERR=-1 + IF(id%INFO(1).GE.0)THEN + id%INFO(1) = -13 + id%INFO(2) = SIZE*350 + RETURN + ENDIF + ENDIF + IF(associated(id%OOC_FILE_NAME_LENGTH))THEN + DEALLOCATE(id%OOC_FILE_NAME_LENGTH) + NULLIFY(id%OOC_FILE_NAME_LENGTH) + ENDIF + ALLOCATE(id%OOC_FILE_NAME_LENGTH(SIZE),stat=IERR) + IF (IERR .GT. 0) THEN + IERR=-1 + IF(id%INFO(1).GE.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) + & 'PB allocation in SMUMPS_613' + id%INFO(1) = -13 + id%INFO(2) = SIZE + RETURN + ENDIF + ENDIF + K=1 + DO I1=1,OOC_NB_FILE_TYPE + TMP=I1-1 + DO I=1,id%OOC_NB_FILES(I1) + CALL MUMPS_OOC_GET_FILE_NAME_C(TMP,I,DIM,TMP_NAME(1)) + DO J=1,DIM+1 + id%OOC_FILE_NAMES(K,J)=TMP_NAME(J) + ENDDO + id%OOC_FILE_NAME_LENGTH(K)=DIM+1 + K=K+1 + ENDDO + ENDDO + END SUBROUTINE SMUMPS_613 + SUBROUTINE SMUMPS_614(id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(SMUMPS_STRUC), TARGET :: id + CHARACTER*1 TMP_NAME(350) + INTEGER I,I1,TMP,J,K,L,DIM,IERR + INTEGER, DIMENSION(:),ALLOCATABLE :: NB_FILES + INTEGER K211 + ALLOCATE(NB_FILES(OOC_NB_FILE_TYPE),stat=IERR) + IF (IERR .GT. 0) THEN + IERR=-1 + IF(id%INFO(1).GE.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) + & 'PB allocation in SMUMPS_614' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + ENDIF + IERR=0 + NB_FILES=id%OOC_NB_FILES + I=id%MYID + K=id%KEEP(35) + L=mod(id%KEEP(204),3) + K211=id%KEEP(211) + CALL MUMPS_OOC_ALLOC_POINTERS_C(OOC_NB_FILE_TYPE,NB_FILES,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + CALL MUMPS_OOC_INIT_VARS_C(I,K,L,K211,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + K=1 + DO I1=1,OOC_NB_FILE_TYPE + DO I=1,NB_FILES(I1) + DIM=id%OOC_FILE_NAME_LENGTH(K) + DO J=1,DIM + TMP_NAME(J)=id%OOC_FILE_NAMES(K,J) + ENDDO + TMP=I1-1 + CALL MUMPS_OOC_SET_FILE_NAME_C(TMP,I,DIM,IERR,TMP_NAME(1)) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + K=K+1 + ENDDO + ENDDO + CALL MUMPS_OOC_START_LOW_LEVEL(IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + DEALLOCATE(NB_FILES) + RETURN + END SUBROUTINE SMUMPS_614 + SUBROUTINE SMUMPS_589(DEST,SRC,NB,NB_EFF) + IMPLICIT NONE + INTEGER NB, NB_EFF + CHARACTER(LEN=NB) SRC + CHARACTER*1 DEST(NB) + INTEGER I + DO I=1,NB_EFF + DEST(I)=SRC(I:I) + ENDDO + END SUBROUTINE SMUMPS_589 + SUBROUTINE SMUMPS_580(IERR) + USE SMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, intent(out) :: IERR + IERR=0 + IF(.NOT.WITH_BUF)THEN + RETURN + ENDIF + CALL SMUMPS_707(OOC_FCT_TYPE,IERR) + IF (IERR < 0) THEN + RETURN + ENDIF + RETURN + END SUBROUTINE SMUMPS_580 + SUBROUTINE SMUMPS_681(IERR) + USE SMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, intent(out) :: IERR + INTEGER I + IERR=0 + IF(.NOT.WITH_BUF)THEN + RETURN + ENDIF + DO I=1,OOC_NB_FILE_TYPE + CALL SMUMPS_707(I,IERR) + IF (IERR < 0) RETURN + ENDDO + RETURN + END SUBROUTINE SMUMPS_681 + SUBROUTINE SMUMPS_683(NSTEPS, + & KEEP38, KEEP20) + IMPLICIT NONE + INTEGER NSTEPS + INTEGER I, J + INTEGER(8) :: TMP_SIZE8 + INTEGER KEEP38, KEEP20 + INODE_TO_POS = 0 + POS_IN_MEM = 0 + OOC_STATE_NODE(1:NSTEPS)=0 + TMP_SIZE8=1_8 + J=1 + DO I=1,NB_Z-1 + IDEB_SOLVE_Z(I)=TMP_SIZE8 + PDEB_SOLVE_Z(I)=J + POSFAC_SOLVE(I)=TMP_SIZE8 + LRLUS_SOLVE(I) =SIZE_ZONE_SOLVE + LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE + LRLU_SOLVE_B(I)=0_8 + SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE + CURRENT_POS_T(I)=J + CURRENT_POS_B(I)=J + POS_HOLE_T(I) =J + POS_HOLE_B(I) =J + J = J + MAX_NB_NODES_FOR_ZONE + TMP_SIZE8 = TMP_SIZE8 + SIZE_ZONE_SOLVE + ENDDO + IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8 + PDEB_SOLVE_Z(NB_Z)=J + POSFAC_SOLVE(NB_Z)=TMP_SIZE8 + LRLUS_SOLVE(NB_Z) =SIZE_SOLVE_EMM + LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM + LRLU_SOLVE_B(NB_Z)=0_8 + SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM + CURRENT_POS_T(NB_Z)=J + CURRENT_POS_B(NB_Z)=J + POS_HOLE_T(NB_Z) =J + POS_HOLE_B(NB_Z) =J + IO_REQ=-77777 + SIZE_OF_READ=-9999_8 + FIRST_POS_IN_READ=-9999 + READ_DEST=-9999_8 + READ_MNG=-9999 + REQ_TO_ZONE=-9999 + REQ_ID=-9999 + RETURN + END SUBROUTINE SMUMPS_683 + SUBROUTINE SMUMPS_688 + & ( STRAT, TYPEFile, + & AFAC, LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW, LIWFAC, + & MYID, FILESIZE, IERR , LAST_CALL) + IMPLICIT NONE + TYPE(IO_BLOCK), INTENT(INOUT):: MonBloc + INTEGER(8) :: LAFAC + INTEGER, INTENT(IN) :: STRAT, LIWFAC, + & MYID, TYPEFile + INTEGER, INTENT(INOUT) :: IW(0:LIWFAC-1) + REAL, INTENT(IN) :: AFAC(LAFAC) + INTEGER, INTENT(INOUT) :: LNextPiv2beWritten, + & UNextPiv2beWritten + INTEGER(8), INTENT(INOUT) :: FILESIZE + INTEGER, INTENT(OUT) :: IERR + LOGICAL, INTENT(IN) :: LAST_CALL + INTEGER(8) :: TMPSIZE_OF_BLOCK + INTEGER :: TempFTYPE + LOGICAL WRITE_L, WRITE_U + LOGICAL DO_U_FIRST + INCLUDE 'mumps_headers.h' + IERR = 0 + IF (KEEP_OOC(50).EQ.0 + & .AND.KEEP_OOC(251).EQ.2) THEN + WRITE_L = .FALSE. + ELSE + WRITE_L = (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_L) + ENDIF + WRITE_U = (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_U) + DO_U_FIRST = .FALSE. + IF ( TYPEFile.EQ.TYPEF_BOTH_LU ) THEN + IF ( LNextPiv2beWritten .GT. UNextPiv2beWritten ) THEN + DO_U_FIRST = .TRUE. + END IF + END IF + IF (DO_U_FIRST) GOTO 200 + 100 IF (WRITE_L .AND. TYPEF_L > 0 ) THEN + TempFTYPE = TYPEF_L + IF ((MonBloc%Typenode.EQ.2).AND.(.NOT.MonBloc%MASTER)) + & THEN + TMPSIZE_OF_BLOCK = SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE), + & TempFTYPE) + IF (TMPSIZE_OF_BLOCK .LT. 0_8) THEN + TMPSIZE_OF_BLOCK = -TMPSIZE_OF_BLOCK - 1_8 + ENDIF + LNextPiv2beWritten = + & int( + & TMPSIZE_OF_BLOCK + & / int(MonBloc%NROW,8) + & ) + & + 1 + ENDIF + CALL SMUMPS_695( STRAT, + & TempFTYPE, AFAC, LAFAC, MonBloc, + & IERR, + & LNextPiv2beWritten, + & OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE), + & SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE), + & FILESIZE, LAST_CALL ) + IF (IERR .LT. 0) RETURN + IF (DO_U_FIRST) GOTO 300 + ENDIF + 200 IF (WRITE_U) THEN + TempFTYPE = TYPEF_U + CALL SMUMPS_695( STRAT, + & TempFTYPE, AFAC, LAFAC, MonBloc, + & IERR, + & UNextPiv2beWritten, + & OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE), + & SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE), + & FILESIZE, LAST_CALL) + IF (IERR .LT. 0) RETURN + IF (DO_U_FIRST) GOTO 100 + ENDIF + 300 CONTINUE + RETURN + END SUBROUTINE SMUMPS_688 + SUBROUTINE SMUMPS_695( STRAT, TYPEF, + & AFAC, LAFAC, MonBloc, + & IERR, + & LorU_NextPiv2beWritten, + & LorU_AddVirtNodeI8, LorUSIZE_OF_BLOCK, + & FILESIZE, LAST_CALL + & ) + USE SMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, INTENT(IN) :: STRAT + INTEGER, INTENT(IN) :: TYPEF + INTEGER(8), INTENT(INOUT) :: FILESIZE + INTEGER(8), INTENT(IN) :: LAFAC + REAL, INTENT(IN) :: AFAC(LAFAC) + INTEGER, INTENT(INOUT) :: LorU_NextPiv2beWritten + INTEGER(8), INTENT(INOUT) :: LorU_AddVirtNodeI8 + INTEGER(8), INTENT(INOUT) :: LorUSIZE_OF_BLOCK + TYPE(IO_BLOCK), INTENT(INOUT) :: MonBloc + INTEGER, INTENT(OUT) :: IERR + LOGICAL, INTENT(IN) :: LAST_CALL + INTEGER NNMAX + INTEGER(8) :: TOTSIZE, EFFSIZE + INTEGER(8) :: TailleEcrite + INTEGER SIZE_PANEL + INTEGER(8) :: AddVirtCour + LOGICAL VIRT_ADD_RESERVED_BEF_CALL + LOGICAL VIRTUAL_ADDRESS_JUST_RESERVED + LOGICAL HOLE_PROCESSED_BEFORE_CALL + LOGICAL TMP_ESTIM + INTEGER ICUR, INODE_CUR, ILAST + INTEGER(8) :: ADDR_LAST + IERR = 0 + IF (TYPEF == TYPEF_L ) THEN + NNMAX = MonBloc%NROW + ELSE + NNMAX = MonBloc%NCOL + ENDIF + SIZE_PANEL = SMUMPS_690(NNMAX) + IF ( (.NOT.MonBloc%Last) .AND. + & (MonBloc%LastPiv-LorU_NextPiv2beWritten+1.LT.SIZE_PANEL)) + & THEN + RETURN + ENDIF + TMP_ESTIM = .TRUE. + TOTSIZE = SMUMPS_725 + & (MonBloc%NFS, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM) + IF (MonBloc%Last) THEN + TMP_ESTIM=.FALSE. + EFFSIZE = SMUMPS_725 + & (MonBloc%LastPiv, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM) + ELSE + EFFSIZE = -1034039740327_8 + ENDIF + IF (MonBloc%Typenode.EQ.3.AND. MonBloc%NFS.NE.MonBloc%NCOL) THEN + WRITE(*,*) 'Internal error in SMUMPS_695 for type3', + & MonBloc%NFS,MonBloc%NCOL + CALL MUMPS_ABORT() + ENDIF + IF (MonBloc%Typenode.EQ.3.AND. TYPEF.NE.TYPEF_L) THEN + WRITE(*,*) 'Internal error in SMUMPS_695,TYPEF=', + & TYPEF, 'for typenode=3' + CALL MUMPS_ABORT() + ENDIF + IF (MonBloc%Typenode.EQ.2.AND. + & TYPEF.EQ.TYPEF_U.AND. + & .NOT. MonBloc%MASTER ) THEN + WRITE(*,*) 'Internal error in SMUMPS_695', + & MonBloc%MASTER,MonBloc%Typenode, TYPEF + CALL MUMPS_ABORT() + ENDIF + HOLE_PROCESSED_BEFORE_CALL = (LorUSIZE_OF_BLOCK .LT. 0_8) + IF (HOLE_PROCESSED_BEFORE_CALL.AND.(.NOT.MonBloc%Last)) THEN + WRITE(6,*) ' Internal error in SMUMPS_695 ', + & ' last is false after earlier calls with last=true' + CALL MUMPS_ABORT() + ENDIF + IF (HOLE_PROCESSED_BEFORE_CALL) THEN + LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 + TOTSIZE = -99999999_8 + ENDIF + VIRTUAL_ADDRESS_JUST_RESERVED = .FALSE. + VIRT_ADD_RESERVED_BEF_CALL = + & ( LorUSIZE_OF_BLOCK .NE. 0_8 .OR. + & HOLE_PROCESSED_BEFORE_CALL ) + IF (MonBloc%Last .AND. .NOT. HOLE_PROCESSED_BEFORE_CALL) THEN + KEEP_OOC(228) = max(KEEP_OOC(228), + & (MonBloc%LastPiv+SIZE_PANEL-1) / SIZE_PANEL) + IF (VIRT_ADD_RESERVED_BEF_CALL) THEN + IF (AddVirtLibre(TYPEF).EQ. + & (LorU_AddVirtNodeI8+TOTSIZE) ) THEN + AddVirtLibre(TYPEF) = LorU_AddVirtNodeI8 + EFFSIZE + ENDIF + ELSE + VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE. + IF (EFFSIZE .EQ. 0_8) THEN + LorU_AddVirtNodeI8 = -9999_8 + ELSE + LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF) + ENDIF + AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + EFFSIZE + ENDIF + ELSE + IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL + & ) THEN + LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF) + AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + TOTSIZE + ENDIF + ENDIF + AddVirtCour = LorU_AddVirtNodeI8 + LorUSIZE_OF_BLOCK + CALL SMUMPS_697( STRAT, TYPEF, MonBloc, + & SIZE_PANEL, + & AFAC, LAFAC, + & LorU_NextPiv2beWritten, AddVirtCour, + & TailleEcrite, + & IERR ) + IF ( IERR .LT. 0 ) RETURN + LorUSIZE_OF_BLOCK = LorUSIZE_OF_BLOCK + TailleEcrite + IF (LorUSIZE_OF_BLOCK.EQ.0_8 ) THEN + IF ( .NOT. VIRT_ADD_RESERVED_BEF_CALL + & .AND. .NOT. VIRTUAL_ADDRESS_JUST_RESERVED ) + & THEN + AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) - TOTSIZE + LorU_AddVirtNodeI8 = 0_8 + ENDIF + ELSE IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL ) THEN + VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE. + ENDIF + IF ( VIRTUAL_ADDRESS_JUST_RESERVED) THEN + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(TYPEF), + & TYPEF) = MonBloc%INODE + I_CUR_HBUF_NEXTPOS(TYPEF) = I_CUR_HBUF_NEXTPOS(TYPEF) + 1 + IF (MonBloc%Last) THEN + MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,EFFSIZE) + TMP_SIZE_FACT=TMP_SIZE_FACT+EFFSIZE + ELSE + MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,TOTSIZE) + TMP_SIZE_FACT=TMP_SIZE_FACT+TOTSIZE + ENDIF + TMP_NB_NODES=TMP_NB_NODES+1 + IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN + MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE, + & TMP_NB_NODES) + TMP_SIZE_FACT=0_8 + TMP_NB_NODES=0 + ENDIF + ENDIF + IF (MonBloc%Last) THEN + LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 + ENDIF + IF (LAST_CALL) THEN + IF (.NOT.MonBloc%Last) THEN + WRITE(6,*) ' Internal error in SMUMPS_695 ', + & ' LAST and LAST_CALL are incompatible ' + CALL MUMPS_ABORT() + ENDIF + LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 + ICUR = I_CUR_HBUF_NEXTPOS(TYPEF) - 1 + INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF) + ADDR_LAST = AddVirtLibre(TYPEF) + IF (INODE_CUR .NE. MonBloc%INODE) THEN + 10 CONTINUE + ILAST = ICUR + IF ( OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF) .NE. -9999_8) THEN + ADDR_LAST = OOC_VADDR(STEP_OOC(INODE_CUR), TYPEF) + ENDIF + ICUR = ICUR - 1 + INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF) + IF (INODE_CUR .EQ. MonBloc%INODE) THEN + LorUSIZE_OF_BLOCK = ADDR_LAST - + & OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF) + ELSE + IF (ICUR .LE. 1) THEN + WRITE(*,*) "Internal error in SMUMPS_695" + WRITE(*,*) "Did not find current node in sequence" + CALL MUMPS_ABORT() + ENDIF + GOTO 10 + ENDIF + ENDIF + FILESIZE = FILESIZE + LorUSIZE_OF_BLOCK + ENDIF + RETURN + END SUBROUTINE SMUMPS_695 + SUBROUTINE SMUMPS_697( + & STRAT, TYPEF, MonBloc, + & SIZE_PANEL, + & AFAC, LAFAC, + & NextPiv2beWritten, AddVirtCour, + & TailleEcrite, IERR ) + USE SMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, INTENT(IN) :: STRAT, TYPEF, SIZE_PANEL + INTEGER(8) :: LAFAC + INTEGER(8), INTENT(IN) :: AddVirtCour + REAL, INTENT(IN) :: AFAC(LAFAC) + INTEGER, INTENT(INOUT) :: NextPiv2beWritten + TYPE(IO_BLOCK),INTENT(INOUT) :: MonBloc + INTEGER(8), INTENT(OUT) :: TailleEcrite + INTEGER, INTENT(OUT) :: IERR + INTEGER :: I, NBeff, LPANELeff, IEND + INTEGER(8) :: AddVirtDeb + IERR = 0 + TailleEcrite = 0_8 + AddVirtDeb = AddVirtCour + I = NextPiv2beWritten + IF ( NextPiv2beWritten .GT. MonBloc%LastPiv ) THEN + RETURN + ENDIF + 10 CONTINUE + NBeff = min(SIZE_PANEL,MonBloc%LastPiv-I+1 ) + IF ((NBeff.NE.SIZE_PANEL) .AND. (.NOT.MonBloc%Last)) THEN + GOTO 20 + ENDIF + IF (TYPEF.EQ.TYPEF_L.AND.MonBloc%MASTER.AND. + & KEEP_OOC(50).EQ.2 .AND. MonBloc%Typenode.NE.3) THEN + IF (MonBloc%INDICES(NBeff+I-1) < 0) + & THEN + NBeff=NBeff+1 + ENDIF + ENDIF + IEND = I + NBeff -1 + CALL SMUMPS_653( STRAT, TYPEF, MonBloc, + & AFAC, LAFAC, + & AddVirtDeb, I, IEND, LPANELeff, + & IERR) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + IF ( IERR .EQ. 1 ) THEN + IERR=0 + GOTO 20 + ENDIF + IF (TYPEF .EQ. TYPEF_L) THEN + MonBloc%LastPanelWritten_L = MonBloc%LastPanelWritten_L+1 + ELSE + MonBloc%LastPanelWritten_U = MonBloc%LastPanelWritten_U+1 + ENDIF + AddVirtDeb = AddVirtDeb + int(LPANELeff,8) + TailleEcrite = TailleEcrite + int(LPANELeff,8) + I=I+NBeff + IF ( I .LE. MonBloc%LastPiv ) GOTO 10 + 20 CONTINUE + NextPiv2beWritten = I + RETURN + END SUBROUTINE SMUMPS_697 + INTEGER(8) FUNCTION SMUMPS_725 + & (NFSorNPIV, NNMAX, SIZE_PANEL, MonBloc, ESTIM) + IMPLICIT NONE + TYPE(IO_BLOCK), INTENT(IN):: MonBloc + INTEGER, INTENT(IN) :: NFSorNPIV, NNMAX, SIZE_PANEL + LOGICAL, INTENT(IN) :: ESTIM + INTEGER :: I, NBeff + INTEGER(8) :: TOTSIZE + TOTSIZE = 0_8 + IF (NFSorNPIV.EQ.0) GOTO 100 + IF (.NOT. MonBloc%MASTER .OR. MonBloc%Typenode.EQ.3) THEN + TOTSIZE = int(NFSorNPIV,8) * int(NNMAX,8) + ELSE + I = 1 + 10 CONTINUE + NBeff = min(SIZE_PANEL, NFSorNPIV-I+1) + IF (KEEP_OOC(50).EQ.2) THEN + IF (ESTIM) THEN + NBeff = NBeff + 1 + ELSE + IF (MonBloc%INDICES(I+NBeff-1) < 0) THEN + NBeff = NBeff + 1 + ENDIF + ENDIF + ENDIF + TOTSIZE = TOTSIZE + + & int(NNMAX-I+1,8) * int(NBeff,8) + I = I + NBeff + IF ( I .LE. NFSorNPIV ) GOTO 10 + ENDIF + 100 CONTINUE + SMUMPS_725 = TOTSIZE + RETURN + END FUNCTION SMUMPS_725 + INTEGER FUNCTION SMUMPS_690( NNMAX ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NNMAX + INTEGER SMUMPS_748 + SMUMPS_690=SMUMPS_748( + & HBUF_SIZE, NNMAX, KEEP_OOC(227),KEEP_OOC(50)) + RETURN + END FUNCTION SMUMPS_690 + SUBROUTINE SMUMPS_728() + IMPLICIT NONE + INTEGER I,TMP_NODE + IF(.NOT.SMUMPS_727())THEN + IF(SOLVE_STEP.EQ.0)THEN + I=CUR_POS_SEQUENCE + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE ((I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND. + & (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + & .EQ.0_8)) + INODE_TO_POS(STEP_OOC(TMP_NODE))=1 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + I=I+1 + IF(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + ENDIF + ENDDO + CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) + ELSE + I=CUR_POS_SEQUENCE + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE ((I.GE.1).AND. + & (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + & .EQ.0_8)) + INODE_TO_POS(STEP_OOC(TMP_NODE))=1 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + I=I-1 + IF(I.GE.1)THEN + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + ENDIF + ENDDO + CUR_POS_SEQUENCE=max(I,1) + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_728 + SUBROUTINE SMUMPS_809(N,KEEP201, + & Pruned_List,nb_prun_nodes,STEP) + IMPLICIT NONE + INTEGER, INTENT(IN) :: N, KEEP201, nb_prun_nodes + INTEGER, INTENT(IN) :: STEP(N), + & Pruned_List(nb_prun_nodes) + INTEGER I, ISTEP + IF (KEEP201 .GT. 0) THEN + OOC_STATE_NODE(:) = ALREADY_USED + DO I = 1, nb_prun_nodes + ISTEP = STEP(Pruned_List(I)) + OOC_STATE_NODE(ISTEP) = NOT_IN_MEM + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_809 + END MODULE SMUMPS_OOC diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_ooc_buffer.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_ooc_buffer.F new file mode 100644 index 000000000..34d5f588d --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_ooc_buffer.F @@ -0,0 +1,570 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE SMUMPS_OOC_BUFFER + USE MUMPS_OOC_COMMON + IMPLICIT NONE + PUBLIC + INTEGER FIRST_HBUF,SECOND_HBUF + PARAMETER (FIRST_HBUF=0, SECOND_HBUF=1) + INTEGER,SAVE :: OOC_FCT_TYPE_LOC + INTEGER IO_STRAT + REAL, DIMENSION(:),ALLOCATABLE :: BUF_IO + LOGICAL,SAVE :: PANEL_FLAG + INTEGER,SAVE :: EARLIEST_WRITE_MIN_SIZE + INTEGER(8),SAVE,DIMENSION(:), ALLOCATABLE :: + & I_SHIFT_FIRST_HBUF, I_SHIFT_SECOND_HBUF, + & I_SHIFT_CUR_HBUF, I_REL_POS_CUR_HBUF + INTEGER, SAVE, DIMENSION(:), ALLOCATABLE :: + & LAST_IOREQUEST, CUR_HBUF + INTEGER, DIMENSION(:),ALLOCATABLE :: I_CUR_HBUF_NEXTPOS + INTEGER,SAVE :: I_CUR_HBUF_FSTPOS, + & I_SUB_HBUF_FSTPOS + INTEGER(8) :: BufferEmpty + PARAMETER (BufferEmpty=-1_8) + INTEGER(8), DIMENSION(:),ALLOCATABLE :: NextAddVirtBuffer + INTEGER(8), DIMENSION(:),ALLOCATABLE :: FIRST_VADDR_IN_BUF + CONTAINS + SUBROUTINE SMUMPS_689(TYPEF_ARG) + IMPLICIT NONE + INTEGER TYPEF_ARG + SELECT CASE(CUR_HBUF(TYPEF_ARG)) + CASE (FIRST_HBUF) + CUR_HBUF(TYPEF_ARG) = SECOND_HBUF + I_SHIFT_CUR_HBUF(TYPEF_ARG) = + & I_SHIFT_SECOND_HBUF(TYPEF_ARG) + CASE (SECOND_HBUF) + CUR_HBUF(TYPEF_ARG) = FIRST_HBUF + I_SHIFT_CUR_HBUF(TYPEF_ARG) = + & I_SHIFT_FIRST_HBUF(TYPEF_ARG) + END SELECT + IF(.NOT.PANEL_FLAG)THEN + I_SUB_HBUF_FSTPOS =I_CUR_HBUF_FSTPOS + I_CUR_HBUF_FSTPOS =I_CUR_HBUF_NEXTPOS(TYPEF_ARG) + ENDIF + I_REL_POS_CUR_HBUF(TYPEF_ARG) = 1_8 + RETURN + END SUBROUTINE SMUMPS_689 + SUBROUTINE SMUMPS_707(TYPEF_ARG,IERR) + IMPLICIT NONE + INTEGER TYPEF_ARG + INTEGER NEW_IOREQUEST + INTEGER IERR + IERR=0 + CALL SMUMPS_696(TYPEF_ARG,NEW_IOREQUEST, + & IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IERR=0 + CALL MUMPS_WAIT_REQUEST(LAST_IOREQUEST(TYPEF_ARG),IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + LAST_IOREQUEST(TYPEF_ARG) = NEW_IOREQUEST + CALL SMUMPS_689(TYPEF_ARG) + IF(PANEL_FLAG)THEN + NextAddVirtBuffer(TYPEF_ARG)=BufferEmpty + ENDIF + RETURN + END SUBROUTINE SMUMPS_707 + SUBROUTINE SMUMPS_675(IERR) + IMPLICIT NONE + INTEGER, intent(out) :: IERR + INTEGER TYPEF_LAST + INTEGER TYPEF_LOC + IERR = 0 + TYPEF_LAST = OOC_NB_FILE_TYPE + DO TYPEF_LOC = 1, TYPEF_LAST + IERR=0 + CALL SMUMPS_707(TYPEF_LOC,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IERR=0 + CALL SMUMPS_707(TYPEF_LOC,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_675 + SUBROUTINE SMUMPS_696(TYPEF_ARG,IOREQUEST, + & IERR) + IMPLICIT NONE + INTEGER IOREQUEST,IERR + INTEGER TYPEF_ARG + INTEGER FIRST_INODE + INTEGER(8) :: FROM_BUFIO_POS, SIZE + INTEGER TYPE + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER(8) TMP_VADDR + INTEGER SIZE_INT1,SIZE_INT2 + IERR=0 + IF (I_REL_POS_CUR_HBUF(TYPEF_ARG) == 1_8) THEN + IOREQUEST=-1 + RETURN + END IF + IF(PANEL_FLAG)THEN + TYPE=TYPEF_ARG-1 + FIRST_INODE=-9999 + TMP_VADDR=FIRST_VADDR_IN_BUF(TYPEF_ARG) + ELSE + TYPE=FCT + FIRST_INODE = + & OOC_INODE_SEQUENCE(I_CUR_HBUF_FSTPOS,TYPEF_ARG) + TMP_VADDR=OOC_VADDR(STEP_OOC(FIRST_INODE),TYPEF_ARG) + ENDIF + FROM_BUFIO_POS=I_SHIFT_CUR_HBUF(TYPEF_ARG)+1_8 + SIZE = I_REL_POS_CUR_HBUF(TYPEF_ARG)-1_8 + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & TMP_VADDR) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, + & BUF_IO(FROM_BUFIO_POS),SIZE_INT1,SIZE_INT2, + & FIRST_INODE,IOREQUEST, + & TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + RETURN + END SUBROUTINE SMUMPS_696 + SUBROUTINE SMUMPS_669(I1,I2,IERR) + IMPLICIT NONE + INTEGER I1,I2,IERR + INTEGER allocok + IERR=0 + PANEL_FLAG=.FALSE. + IF(allocated(I_SHIFT_FIRST_HBUF))THEN + DEALLOCATE(I_SHIFT_FIRST_HBUF) + ENDIF + IF(allocated(I_SHIFT_SECOND_HBUF))THEN + DEALLOCATE(I_SHIFT_SECOND_HBUF) + ENDIF + IF(allocated(I_SHIFT_CUR_HBUF))THEN + DEALLOCATE(I_SHIFT_CUR_HBUF) + ENDIF + IF(allocated(I_REL_POS_CUR_HBUF))THEN + DEALLOCATE(I_REL_POS_CUR_HBUF) + ENDIF + IF(allocated(LAST_IOREQUEST))THEN + DEALLOCATE(LAST_IOREQUEST) + ENDIF + IF(allocated(CUR_HBUF))THEN + DEALLOCATE(CUR_HBUF) + ENDIF + DIM_BUF_IO = int(KEEP_OOC(100),8) + ALLOCATE(I_SHIFT_FIRST_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(I_SHIFT_SECOND_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(I_SHIFT_CUR_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(I_REL_POS_CUR_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(LAST_IOREQUEST(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(CUR_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + OOC_FCT_TYPE_LOC=OOC_NB_FILE_TYPE + ALLOCATE(BUF_IO(DIM_BUF_IO), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC' + I1 = -13 + CALL MUMPS_731(DIM_BUF_IO, I2) + RETURN + ENDIF + PANEL_FLAG=(KEEP_OOC(201).EQ.1) + IF (PANEL_FLAG) THEN + IERR=0 + KEEP_OOC(228)=0 + IF(allocated(AddVirtLibre))THEN + DEALLOCATE(AddVirtLibre) + ENDIF + ALLOCATE(AddVirtLibre(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC_BUF_PANEL' + IERR=-1 + I1=-13 + I2=OOC_NB_FILE_TYPE + RETURN + ENDIF + AddVirtLibre(1:OOC_NB_FILE_TYPE)=0_8 + IF(allocated(NextAddVirtBuffer))THEN + DEALLOCATE(NextAddVirtBuffer) + ENDIF + ALLOCATE(NextAddVirtBuffer(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC_BUF_PANEL' + IERR=-1 + I1=-13 + I2=OOC_NB_FILE_TYPE + RETURN + ENDIF + NextAddVirtBuffer (1:OOC_NB_FILE_TYPE) = BufferEmpty + IF(allocated(FIRST_VADDR_IN_BUF))THEN + DEALLOCATE(FIRST_VADDR_IN_BUF) + ENDIF + ALLOCATE(FIRST_VADDR_IN_BUF(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC_BUF_PANEL' + IERR=-1 + I1=-13 + I2=OOC_NB_FILE_TYPE + RETURN + ENDIF + CALL SMUMPS_686() + ELSE + CALL SMUMPS_685() + ENDIF + RETURN + END SUBROUTINE SMUMPS_669 + SUBROUTINE SMUMPS_659() + IMPLICIT NONE + IF(allocated(BUF_IO))THEN + DEALLOCATE(BUF_IO) + ENDIF + IF(allocated(I_SHIFT_FIRST_HBUF))THEN + DEALLOCATE(I_SHIFT_FIRST_HBUF) + ENDIF + IF(allocated(I_SHIFT_SECOND_HBUF))THEN + DEALLOCATE(I_SHIFT_SECOND_HBUF) + ENDIF + IF(allocated(I_SHIFT_CUR_HBUF))THEN + DEALLOCATE(I_SHIFT_CUR_HBUF) + ENDIF + IF(allocated(I_REL_POS_CUR_HBUF))THEN + DEALLOCATE(I_REL_POS_CUR_HBUF) + ENDIF + IF(allocated(LAST_IOREQUEST))THEN + DEALLOCATE(LAST_IOREQUEST) + ENDIF + IF(allocated(CUR_HBUF))THEN + DEALLOCATE(CUR_HBUF) + ENDIF + IF(PANEL_FLAG)THEN + IF(allocated(NextAddVirtBuffer))THEN + DEALLOCATE(NextAddVirtBuffer) + ENDIF + IF(allocated(AddVirtLibre))THEN + DEALLOCATE(AddVirtLibre) + ENDIF + IF(allocated(FIRST_VADDR_IN_BUF))THEN + DEALLOCATE(FIRST_VADDR_IN_BUF) + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_659 + SUBROUTINE SMUMPS_685() + IMPLICIT NONE + OOC_FCT_TYPE_LOC=1 + HBUF_SIZE = DIM_BUF_IO / int(2,kind=kind(DIM_BUF_IO)) + EARLIEST_WRITE_MIN_SIZE = 0 + I_SHIFT_FIRST_HBUF(OOC_FCT_TYPE_LOC) = 0_8 + I_SHIFT_SECOND_HBUF(OOC_FCT_TYPE_LOC) = HBUF_SIZE + LAST_IOREQUEST(OOC_FCT_TYPE_LOC) = -1 + I_CUR_HBUF_NEXTPOS = 1 + I_CUR_HBUF_FSTPOS = 1 + I_SUB_HBUF_FSTPOS = 1 + CUR_HBUF(OOC_FCT_TYPE_LOC) = SECOND_HBUF + CALL SMUMPS_689(OOC_FCT_TYPE_LOC) + END SUBROUTINE SMUMPS_685 + SUBROUTINE SMUMPS_678(BLOCK,SIZE_OF_BLOCK, + & IERR) + IMPLICIT NONE + INTEGER(8) :: SIZE_OF_BLOCK + REAL BLOCK(SIZE_OF_BLOCK) + INTEGER, intent(out) :: IERR + INTEGER(8) :: I + IERR=0 + IF (I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) + + & SIZE_OF_BLOCK <= HBUF_SIZE + 1_8) THEN + ELSE + CALL SMUMPS_707(OOC_FCT_TYPE_LOC,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + END IF + DO I = 1_8, SIZE_OF_BLOCK + BUF_IO(I_SHIFT_CUR_HBUF(OOC_FCT_TYPE_LOC) + + & I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) + I - 1_8) = + & BLOCK(I) + END DO + I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) = + & I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) + SIZE_OF_BLOCK + RETURN + END SUBROUTINE SMUMPS_678 + SUBROUTINE SMUMPS_686() + IMPLICIT NONE + INTEGER(8) :: DIM_BUF_IO_L_OR_U + INTEGER TYPEF, TYPEF_LAST + INTEGER NB_DOUBLE_BUFFERS + TYPEF_LAST = OOC_NB_FILE_TYPE + NB_DOUBLE_BUFFERS = OOC_NB_FILE_TYPE + DIM_BUF_IO_L_OR_U = DIM_BUF_IO / + & int(NB_DOUBLE_BUFFERS,kind=kind(DIM_BUF_IO_L_OR_U)) + IF(.NOT.STRAT_IO_ASYNC)THEN + HBUF_SIZE = DIM_BUF_IO_L_OR_U + ELSE + HBUF_SIZE = DIM_BUF_IO_L_OR_U / 2_8 + ENDIF + DO TYPEF = 1, TYPEF_LAST + LAST_IOREQUEST(TYPEF) = -1 + IF (TYPEF == 1 ) THEN + I_SHIFT_FIRST_HBUF(TYPEF) = 0_8 + ELSE + I_SHIFT_FIRST_HBUF(TYPEF) = DIM_BUF_IO_L_OR_U + ENDIF + IF(.NOT.STRAT_IO_ASYNC)THEN + I_SHIFT_SECOND_HBUF(TYPEF) = I_SHIFT_FIRST_HBUF(TYPEF) + ELSE + I_SHIFT_SECOND_HBUF(TYPEF) = I_SHIFT_FIRST_HBUF(TYPEF) + + & HBUF_SIZE + ENDIF + CUR_HBUF(TYPEF) = SECOND_HBUF + CALL SMUMPS_689(TYPEF) + ENDDO + I_CUR_HBUF_NEXTPOS = 1 + RETURN + END SUBROUTINE SMUMPS_686 + SUBROUTINE SMUMPS_706(TYPEF,IERR) + IMPLICIT NONE + INTEGER, INTENT(in) :: TYPEF + INTEGER, INTENT(out) :: IERR + INTEGER IFLAG + INTEGER NEW_IOREQUEST + IERR=0 + CALL MUMPS_TEST_REQUEST_C(LAST_IOREQUEST(TYPEF),IFLAG, + & IERR) + IF (IFLAG.EQ.1) THEN + IERR = 0 + CALL SMUMPS_696(TYPEF, + & NEW_IOREQUEST, + & IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + LAST_IOREQUEST(TYPEF) = NEW_IOREQUEST + CALL SMUMPS_689(TYPEF) + NextAddVirtBuffer(TYPEF)=BufferEmpty + RETURN + ELSE IF(IFLAG.LT.0)THEN + WRITE(*,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ELSE + IERR = 1 + RETURN + ENDIF + END SUBROUTINE SMUMPS_706 + SUBROUTINE SMUMPS_709 (TYPEF,VADDR) + IMPLICIT NONE + INTEGER(8), INTENT(in) :: VADDR + INTEGER, INTENT(in) :: TYPEF + IF(I_REL_POS_CUR_HBUF(TYPEF).EQ.1_8)THEN + FIRST_VADDR_IN_BUF(TYPEF)=VADDR + ENDIF + RETURN + END SUBROUTINE SMUMPS_709 + SUBROUTINE SMUMPS_653( STRAT, TYPEF, MonBloc, + & AFAC, LAFAC, + & AddVirtCour, IPIVBEG, IPIVEND, LPANELeff, + & IERR) + IMPLICIT NONE + INTEGER, INTENT(IN) :: TYPEF, IPIVBEG, IPIVEND, STRAT + INTEGER(8), INTENT(IN) :: LAFAC + REAL, INTENT(IN) :: AFAC(LAFAC) + INTEGER(8), INTENT(IN) :: AddVirtCour + TYPE(IO_BLOCK), INTENT(IN) :: MonBloc + INTEGER, INTENT(OUT):: LPANELeff + INTEGER, INTENT(OUT):: IERR + INTEGER :: II, NBPIVeff + INTEGER(8) :: IPOS, IDIAG, IDEST + INTEGER(8) :: DeltaIPOS + INTEGER :: StrideIPOS + IERR=0 + IF (STRAT.NE.STRAT_WRITE_MAX.AND.STRAT.NE.STRAT_TRY_WRITE) THEN + write(6,*) ' SMUMPS_653: STRAT Not implemented ' + CALL MUMPS_ABORT() + ENDIF + NBPIVeff = IPIVEND - IPIVBEG + 1 + IF (MonBloc%MASTER .AND. MonBloc%Typenode .NE. 3) THEN + IF (TYPEF.EQ.TYPEF_L) THEN + LPANELeff = (MonBloc%NROW-IPIVBEG+1)*NBPIVeff + ELSE + LPANELeff = (MonBloc%NCOL-IPIVBEG+1)*NBPIVeff + ENDIF + ELSE + LPANELeff = MonBloc%NROW*NBPIVeff + ENDIF + IF ( ( I_REL_POS_CUR_HBUF(TYPEF) + int(LPANELeff - 1,8) + & > + & HBUF_SIZE ) + & .OR. + & ( (AddVirtCour.NE.NextAddVirtBuffer(TYPEF)) .AND. + & (NextAddVirtBuffer(TYPEF).NE.BufferEmpty) ) + & ) THEN + IF (STRAT.EQ.STRAT_WRITE_MAX) THEN + CALL SMUMPS_707(TYPEF,IERR) + ELSE IF (STRAT.EQ.STRAT_TRY_WRITE) THEN + CALL SMUMPS_706(TYPEF,IERR) + IF (IERR.EQ.1) RETURN + ELSE + write(6,*) 'SMUMPS_653: STRAT Not implemented' + ENDIF + ENDIF + IF (IERR < 0 ) THEN + RETURN + ENDIF + IF (NextAddVirtBuffer(TYPEF).EQ. BufferEmpty) THEN + CALL SMUMPS_709 (TYPEF,AddVirtCour) + NextAddVirtBuffer(TYPEF) = AddVirtCour + ENDIF + IF (MonBloc%MASTER .AND. MonBloc%Typenode .NE. 3) THEN + IDIAG = int(IPIVBEG-1,8)*int(MonBloc%NCOL,8) + int(IPIVBEG,8) + IPOS = IDIAG + IDEST = I_SHIFT_CUR_HBUF(TYPEF) + + & I_REL_POS_CUR_HBUF(TYPEF) + IF (TYPEF.EQ.TYPEF_L) THEN + DO II = IPIVBEG, IPIVEND + CALL scopy(MonBloc%NROW-IPIVBEG+1, + & AFAC(IPOS), MonBloc%NCOL, + & BUF_IO(IDEST), 1) + IDEST = IDEST + int(MonBloc%NROW-IPIVBEG+1,8) + IPOS = IPOS + 1_8 + ENDDO + ELSE + DO II = IPIVBEG, IPIVEND + CALL scopy(MonBloc%NCOL-IPIVBEG+1, + & AFAC(IPOS), 1, + & BUF_IO(IDEST), 1) + IDEST = IDEST + int(MonBloc%NCOL-IPIVBEG+1,8) + IPOS = IPOS + int(MonBloc%NCOL,8) + ENDDO + ENDIF + ELSE + IDEST = I_SHIFT_CUR_HBUF(TYPEF) + + & I_REL_POS_CUR_HBUF(TYPEF) + IF (MonBloc%Typenode.EQ.3) THEN + DeltaIPOS = int(MonBloc%NROW,8) + StrideIPOS = 1 + ELSE + DeltaIPOS = 1_8 + StrideIPOS = MonBloc%NCOL + ENDIF + IPOS = 1_8 + int(IPIVBEG - 1,8) * DeltaIPOS + DO II = IPIVBEG, IPIVEND + CALL scopy(MonBloc%NROW, + & AFAC(IPOS), StrideIPOS, + & BUF_IO(IDEST), 1) + IDEST = IDEST+int(MonBloc%NROW,8) + IPOS = IPOS + DeltaIPOS + ENDDO + ENDIF + I_REL_POS_CUR_HBUF(TYPEF) = + & I_REL_POS_CUR_HBUF(TYPEF) + int(LPANELeff,8) + NextAddVirtBuffer(TYPEF) = NextAddVirtBuffer(TYPEF) + & + int(LPANELeff,8) + RETURN + END SUBROUTINE SMUMPS_653 + END MODULE SMUMPS_OOC_BUFFER diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part1.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part1.F new file mode 100644 index 000000000..2326af574 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part1.F @@ -0,0 +1,6004 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE SMUMPS( id ) + USE SMUMPS_OOC + USE SMUMPS_STRUC_DEF + IMPLICIT NONE +C matrix in assembled format (ICNTL(5)=0, and ICNTL(18) $\neq$ 3), + INTERFACE + SUBROUTINE SMUMPS_758 + &(idRHS, idINFO, idN, idNRHS, idLRHS) + REAL, DIMENSION(:), POINTER :: idRHS + INTEGER, intent(in) :: idN, idNRHS, idLRHS + INTEGER, intent(inout) :: idINFO(:) + END SUBROUTINE SMUMPS_758 + SUBROUTINE SMUMPS_26( id ) + USE SMUMPS_STRUC_DEF + TYPE (SMUMPS_STRUC), TARGET :: id + END SUBROUTINE SMUMPS_26 + SUBROUTINE SMUMPS_142( id ) + USE SMUMPS_STRUC_DEF + TYPE (SMUMPS_STRUC), TARGET :: id + END SUBROUTINE SMUMPS_142 + SUBROUTINE SMUMPS_301( id ) + USE SMUMPS_STRUC_DEF + TYPE (SMUMPS_STRUC), TARGET :: id + END SUBROUTINE SMUMPS_301 + SUBROUTINE SMUMPS_349(id, LP) + USE SMUMPS_STRUC_DEF + TYPE (SMUMPS_STRUC), TARGET, INTENT(IN) :: id + INTEGER :: LP + END SUBROUTINE SMUMPS_349 + END INTERFACE + INCLUDE 'mpif.h' + INTEGER MASTER, IERR + PARAMETER( MASTER = 0 ) + TYPE (SMUMPS_STRUC) :: id + INTEGER JOBMIN, JOBMAX, OLDJOB + INTEGER I, J, MP, LP, MPG, KEEP235SAVE, KEEP242SAVE, + & KEEP243SAVE + LOGICAL LANAL, LFACTO, LSOLVE, PROK, FLAG, PROKG + LOGICAL NOERRORBEFOREPERM + LOGICAL UNS_PERM_DONE + INTEGER COMM_SAVE + INTEGER JOB, N, NZ, NELT + INTEGER, PARAMETER :: ICNTL18DIST_MIN = 1 + INTEGER, PARAMETER :: ICNTL18DIST_MAX = 3 + INTEGER, DIMENSION(:), ALLOCATABLE :: UNS_PERM_INV + NOERRORBEFOREPERM = .FALSE. + UNS_PERM_DONE = .FALSE. + JOB = id%JOB + N = id%N + NZ = id%NZ + NELT = id%NELT + id%INFO(1) = 0 + id%INFO(2) = 0 + IF ( JOB .NE. -1 ) THEN + LP = id%ICNTL(1) + MP = id%ICNTL(2) + MPG = id%ICNTL(3) + PROK = ((MP.GT.0).AND.(id%ICNTL(4).GE.3)) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF (PROKG) THEN + IF (id%ICNTL(5) .NE. 1) THEN + WRITE(MPG,'(A,I4,I12,I15)') + & 'Entering SMUMPS driver with JOB, N, NZ =', JOB,N,NZ + ELSE + WRITE(MPG,'(A,I4,I12,I15)') + & 'Entering SMUMPS driver with JOB, N, NELT =', JOB,N + & ,NELT + ENDIF + ENDIF + ELSE + MPG = 0 + PROK = .FALSE. + PROKG = .FALSE. + LP = 6 + MP = 6 + END IF + CALL MPI_INITIALIZED( FLAG, IERR ) + IF ( .NOT. FLAG ) THEN + WRITE(LP,990) + 990 FORMAT(' Error in SMUMPS initialization: MPI is not running.') + id%INFO(1) = -23 + id%INFO(2) = 0 + GOTO 500 + END IF + COMM_SAVE = id%COMM + CALL MPI_COMM_DUP( COMM_SAVE, id%COMM, IERR ) + CALL MPI_ALLREDUCE(JOB,JOBMIN,1,MPI_INTEGER,MPI_MAX, + & id%COMM,IERR) + CALL MPI_ALLREDUCE(JOB,JOBMAX,1,MPI_INTEGER,MPI_MIN, + & id%COMM,IERR) + IF ( JOBMIN .NE. JOBMAX ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + IF ( JOB .EQ. -1 ) THEN + id%INFO(1)=0 + id%INFO(2)=0 + IF ( id%KEEP(40) .EQ. 1 - 456789 .OR. + & id%KEEP(40) .EQ. 2 - 456789 .OR. + & id%KEEP(40) .EQ. 3 -456789 ) THEN + IF ( id%N > 0 ) THEN + id%INFO(1)=-3 + id%INFO(2)=JOB + ENDIF + ENDIF + CALL MPI_COMM_RANK(id%COMM, id%MYID, IERR) + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) THEN + IF (id%KEEP(201).GT.0) THEN + CALL SMUMPS_587(id, IERR) + ENDIF + GOTO 499 + ENDIF + CALL SMUMPS_163( id ) + GOTO 500 + END IF + IF ( JOB .EQ. -2 ) THEN + id%KEEP(40)= -2 - 456789 + CALL SMUMPS_136( id ) + GOTO 500 + END IF + IF ((JOB.LT.1).OR.(JOB.GT.6)) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + IF (id%MYID.EQ.MASTER) THEN + IF ( id%ICNTL(18) .LT. ICNTL18DIST_MIN + & .OR. id%ICNTL(18) .GT. ICNTL18DIST_MAX ) THEN + IF ((N.LE.0).OR.((N+N+N)/3.NE.N)) THEN + id%INFO(1) = -16 + id%INFO(2) = N + END IF + IF (id%ICNTL(5).NE.1) THEN + IF (NZ.LE.0) THEN + id%INFO(1) = -2 + id%INFO(2) = NZ + END IF + ELSE + IF (NELT.LE.0) THEN + id%INFO(1) = -24 + id%INFO(2) = NELT + END IF + ENDIF + END IF + IF ( (id%KEEP(46).EQ.0).AND.(id%NPROCS.LE.1) ) + & THEN + id%INFO(1) = -21 + id%INFO(2) = id%NPROCS + ENDIF + END IF + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) GOTO 499 + LANAL = .FALSE. + LFACTO = .FALSE. + LSOLVE = .FALSE. + IF ((JOB.EQ.1).OR.(JOB.EQ.4).OR. + & (JOB.EQ.6)) LANAL = .TRUE. + IF ((JOB.EQ.2).OR.(JOB.EQ.4).OR. + & (JOB.EQ.5).OR.(JOB.EQ.6)) LFACTO = .TRUE. + IF ((JOB.EQ.3).OR.(JOB.EQ.5).OR. + & (JOB.EQ.6)) LSOLVE = .TRUE. + IF (MP.GT.0) CALL SMUMPS_349(id, MP) + OLDJOB = id%KEEP( 40 ) + 456789 + IF ( LANAL ) THEN + IF ( OLDJOB .EQ. 0 .OR. OLDJOB .GT. 3 .OR. OLDJOB .LT. -1 ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + IF ( OLDJOB .GE. 2 ) THEN + IF (associated(id%IS)) THEN + DEALLOCATE (id%IS) + NULLIFY (id%IS) + END IF + IF (associated(id%S)) THEN + DEALLOCATE (id%S) + NULLIFY (id%S) + END IF + END IF + END IF + IF ( LFACTO ) THEN + IF ( OLDJOB .LT. 1 .and. .NOT. LANAL ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + END IF + IF ( LSOLVE ) THEN + IF ( OLDJOB .LT. 2 .AND. .NOT. LFACTO ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + END IF +#if ! defined (LARGEMATRICES) + NOERRORBEFOREPERM =.TRUE. + UNS_PERM_DONE=.FALSE. + IF (id%MYID .eq. MASTER .AND. id%KEEP(23) .NE. 0) THEN + IF ( id%JOB .EQ. 2 .OR. id%JOB .EQ. 5 .OR. + & (id%JOB .EQ. 3 .AND. (id%ICNTL(10) .NE.0 .OR. + & id%ICNTL(11).NE. 0))) THEN + UNS_PERM_DONE = .TRUE. + ALLOCATE(UNS_PERM_INV(id%N),stat=IERR) + IF (IERR .GT. 0) THEN + id%INFO(1)=-13 + id%INFO(2)=id%N + IF (id%ICNTL(1) .GT. 0 .AND. id%ICNTL(4) .GE.1) THEN + WRITE(id%ICNTL(2),99993) + END IF + GOTO 510 + ENDIF + DO I = 1, id%N + UNS_PERM_INV(id%UNS_PERM(I))=I + END DO + DO I = 1, id%NZ + J = id%JCN(I) + IF (J.LE.0.OR.J.GT.id%N) CYCLE + id%JCN(I)=UNS_PERM_INV(J) + END DO + DEALLOCATE(UNS_PERM_INV) + END IF + END IF +#endif + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499 + IF (LANAL) THEN + id%KEEP(40)=-1 -456789 + IF (id%MYID.EQ.MASTER) THEN + id%INFOG(7) = -9999 + id%INFOG(23) = 0 + id%INFOG(24) = 1 + IF (associated(id%IS1)) DEALLOCATE(id%IS1) + IF ( id%ICNTL(5) .NE. 1 ) THEN + IF ( id%KEEP(50) .NE. 1 + & .AND. ( + & (id%ICNTL(6) .NE. 0 .AND. id%ICNTL(7) .NE.1) + & .OR. + & id%ICNTL(12) .NE. 1) ) THEN + id%MAXIS1 = 11 * N + ELSE + id%MAXIS1 = 10 * N + END IF + ELSE + id%MAXIS1 = 6 * N + 2 * NELT + 2 + ENDIF + ALLOCATE( id%IS1(id%MAXIS1), stat=IERR ) + IF (IERR.gt.0) THEN + id%INFO(1) = -7 + id%INFO(2) = id%MAXIS1 + IF ( LP .GT.0 ) + & WRITE(LP,*) 'Problem in allocating work array for analysis.' + GO TO 100 + END IF + IF ( associated( id%PROCNODE ) ) + & DEALLOCATE( id%PROCNODE ) + ALLOCATE( id%PROCNODE(id%N), stat=IERR ) + IF (IERR.gt.0) THEN + id%INFO(1) = -7 + id%INFO(2) = id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) 'Problem in allocating work array PROCNODE' + END IF + GOTO 100 + END IF + id%PROCNODE(1:id%N) = 0 + IF ( id%ICNTL(5) .EQ. 1 ) THEN + IF ( associated( id%ELTPROC ) ) + & DEALLOCATE( id%ELTPROC ) + ALLOCATE( id%ELTPROC(id%NELT), stat=IERR ) + IF (IERR.gt.0) THEN + id%INFO(1) = -7 + id%INFO(2) = id%NELT + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) 'Problem in allocating work array ELTPROC' + END IF + GOTO 100 + END IF + END IF + IF ( id%ICNTL(5) .NE. 1 ) THEN + id%NA_ELT=0 + IF ( id%ICNTL(18) .LT. ICNTL18DIST_MIN + & .OR. id%ICNTL(18) .GT. ICNTL18DIST_MAX ) THEN + IF ( .not. associated( id%IRN ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( size( id%IRN ) < id%NZ ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( .not. associated( id%JCN ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + ELSE IF ( size( id%JCN ) < id%NZ ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + END IF + END IF + IF ( id%INFO( 1 ) .eq. -22 ) THEN + IF (LP.GT.0) WRITE(LP,*) + & 'Error in analysis: IRN/JCN badly allocated.' + END IF + ELSE + IF ( .not. associated( id%ELTPTR ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( size( id%ELTPTR ) < id%NELT+1 ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( .not. associated( id%ELTVAR ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + ELSE + id%LELTVAR = id%ELTPTR( id%NELT+1 ) - 1 + IF ( size( id%ELTVAR ) < id%LELTVAR ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + ELSE + id%NA_ELT = 0 + IF ( id%KEEP(50) .EQ. 0 ) THEN + DO I = 1,NELT + J = id%ELTPTR(I+1) - id%ELTPTR(I) + J = (J * J) + id%NA_ELT = id%NA_ELT + J + ENDDO + ELSE + DO I = 1,NELT + J = id%ELTPTR(I+1) - id%ELTPTR(I) + J = (J * (J+1))/2 + id%NA_ELT = id%NA_ELT + J + ENDDO + ENDIF + ENDIF + END IF + IF ( id%INFO( 1 ) .eq. -22 ) THEN + IF (LP.GT.0) WRITE(LP,*) + & 'Error in analysis: ELTPTR/ELTVAR badly allocated.' + END IF + ENDIF + 100 CONTINUE + END IF + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499 + id%KEEP(52) = id%ICNTL(8) + IF ( id%KEEP(52) .GT. 8 .OR. id%KEEP(52).LT.-2) + & id%KEEP(52) = 77 + IF ((id%KEEP(52).EQ.77).AND.(id%KEEP(50).EQ.1)) THEN + id%KEEP(52) = 0 + ENDIF + IF ( id%KEEP(52).EQ.77 .OR. id%KEEP(52).LE.-2) THEN + IF (.not.associated(id%A)) id%KEEP(52) = 0 + ENDIF + IF(id%KEEP(52) .EQ. -1) id%KEEP(52) = 0 + CALL SMUMPS_26( id ) + IF (id%MYID .eq. MASTER) THEN + IF (id%KEEP(52) .NE. 0) THEN + id%INFOG(33)=id%KEEP(52) + ELSE + id%INFOG(33)=id%ICNTL(8) + ENDIF + ENDIF + IF (id%MYID .eq. MASTER) id%INFOG(24)=id%KEEP(95) + IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499 + id%KEEP(40) = 1 -456789 + END IF + IF (LFACTO) THEN + id%KEEP(40) = 1 - 456789 + IF ( id%MYID .EQ. MASTER ) THEN + IF (id%KEEP(60).EQ.1) THEN + IF ( associated( id%SCHUR_CINTERFACE)) THEN + id%SCHUR=>id%SCHUR_CINTERFACE + & (1:id%SIZE_SCHUR*id%SIZE_SCHUR) + ENDIF + IF ( .NOT. associated (id%SCHUR)) THEN + IF (LP.GT.0) + & write(LP,'(A)') + & ' SCHUR not associated' + id%INFO(1)=-22 + id%INFO(2)=9 + ELSE IF ( size(id%SCHUR) .LT. + & id%SIZE_SCHUR * id%SIZE_SCHUR ) THEN + IF (LP.GT.0) + & write(LP,'(A)') + & ' SCHUR allocated but too small' + id%INFO(1)=-22 + id%INFO(2)=9 + END IF + END IF + IF ( id%KEEP(55) .EQ. 0 ) THEN + IF ( id%KEEP(54).eq.0 ) THEN + IF ( .not. associated( id%A ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + ELSE IF ( size( id%A ) < id%NZ ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + END IF + END IF + ELSE + IF ( .not. associated( id%A_ELT ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + ELSE + IF ( size( id%A_ELT ) < id%NA_ELT ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + ENDIF + END IF + ENDIF + CALL MUMPS_633(id%KEEP(12),id%ICNTL(14), + & id%KEEP(50),id%KEEP(54),id%ICNTL(6),id%ICNTL(8)) + CALL SMUMPS_635(N,id%KEEP(1),id%ICNTL(1),MPG) + IF( id%KEEP(52) .EQ. -2 .AND. id%ICNTL(8) .NE. -2 .AND. + & id%ICNTL(8).NE. 77 ) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** WARNING : SCALING' + WRITE(MPG,'(A)') + & ' ** scaling already computed during analysis' + WRITE(MPG,'(A)') + & ' ** keeping the scaling from the analysis' + ENDIF + ENDIF + IF (id%KEEP(52) .NE. -2) THEN + id%KEEP(52)=id%ICNTL(8) + ENDIF + IF ( id%KEEP(52) .GT. 8 .OR. id%KEEP(52).LT.-2) + & id%KEEP(52) = 77 + IF (id%KEEP(52).EQ.77) THEN + IF (id%KEEP(50).EQ.1) THEN + id%KEEP(52) = 0 + ELSE + id%KEEP(52) = 7 + ENDIF + ENDIF + IF (id%KEEP(23) .NE. 0 .AND. id%ICNTL(8) .EQ. -1) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** WARNING : SCALING' + WRITE(MPG,'(A)') + & ' ** column permutation applied:' + WRITE(MPG,'(A)') + & ' ** column scaling has to be permuted' + ENDIF + ENDIF + IF ( id%KEEP( 19 ) .ne. 0 .and. id%KEEP( 52 ).ne. 0 ) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.' + WRITE(MPG,'(A)') ' ** (incompatibility with null space)' + END IF + id%KEEP(52) = 0 + END IF + IF ( id%KEEP(60) .ne. 0 .and. id%KEEP(52) .ne. 0 ) THEN + id%KEEP(52) = 0 + IF ( MPG .GT. 0 .AND. id%ICNTL(8) .NE. 0 ) THEN + WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.' + WRITE(MPG,'(A)') ' ** (incompatibility with Schur)' + END IF + END IF + IF (id%KEEP(54) .NE. 0 .AND. + & id%KEEP(52).NE.7 .AND. id%KEEP(52).NE.8 .AND. + & id%KEEP(52) .NE. 0 ) THEN + id%KEEP(52) = 0 + IF ( MPG .GT. 0 .and. id%ICNTL(8) .ne. 0 ) THEN + WRITE(MPG,'(A)') + & ' ** Warning: This scaling option not available' + WRITE(MPG,'(A)') ' ** for distributed matrix entry' + END IF + END IF + IF ( id%KEEP(50) .NE. 0 ) THEN + IF ( id%KEEP(52).ne. 1 .and. + & id%KEEP(52).ne. -1 .and. + & id%KEEP(52).ne. 0 .and. + & id%KEEP(52).ne. 7 .and. + & id%KEEP(52).ne. 8 .and. + & id%KEEP(52).ne. -2 .and. + & id%KEEP(52).ne. 77) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') + & ' ** Warning: Scaling option n.a. for symmetric matrix' + END IF + id%KEEP(52) = 0 + END IF + END IF + IF (id%KEEP(55) .NE. 0 .AND. + & ( id%KEEP(52) .gt. 0 ) ) THEN + id%KEEP(52) = 0 + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.' + WRITE(MPG,'(A)') + & ' ** (only user scaling av. for elt. entry)' + END IF + END IF + IF ( id%KEEP(52) .eq. -1 ) THEN + IF ( .not. associated( id%ROWSCA ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 5 + ELSE IF ( size( id%ROWSCA ) < id%N ) THEN + id%INFO(1) = -22 + id%INFO(2) = 5 + ELSE IF ( .not. associated( id%COLSCA ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 6 + ELSE IF ( size( id%COLSCA ) < id%N ) THEN + id%INFO(1) = -22 + id%INFO(2) = 6 + END IF + END IF + IF (id%KEEP(52).GT.0 .AND. + & id%KEEP(52) .LE.8) THEN + IF ( associated(id%COLSCA)) + & DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) + & DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=IERR) + IF (IERR .GT.0) id%INFO(1)=-13 + ALLOCATE( id%ROWSCA(N), stat=IERR) + IF (IERR .GT.0) id%INFO(1)=-13 + END IF + IF (.NOT. associated(id%COLSCA)) THEN + ALLOCATE( id%COLSCA(1), stat=IERR) + END IF + IF (IERR .GT.0) id%INFO(1)=-13 + IF (.NOT. associated(id%ROWSCA)) + & ALLOCATE( id%ROWSCA(1), stat=IERR) + IF (IERR .GT.0) id%INFO(1)=-13 + IF ( id%INFO(1) .eq. -13 ) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*) 'Problems in allocations before facto' + GOTO 200 + END IF + IF (id%KEEP(252) .EQ. 1) THEN + CALL SMUMPS_758 + & (id%RHS,id%INFO,id%N,id%NRHS,id%LRHS) + CALL SMUMPS_807(id) + CALL SMUMPS_769(id) + ENDIF + 200 CONTINUE + END IF + CALL MPI_BCAST( id%KEEP(221), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + IF (id%KEEP(60).EQ.2.OR.id%KEEP(60).EQ.3) THEN + IF ( id%root%yes ) THEN + IF ( associated( id%SCHUR_CINTERFACE )) THEN + id%SCHUR=>id%SCHUR_CINTERFACE + & (1:id%SCHUR_LLD*(id%root%SCHUR_NLOC-1)+ + & id%root%SCHUR_MLOC) + ENDIF + IF (id%SCHUR_LLD < id%root%SCHUR_MLOC) THEN + IF (LP.GT.0) write(LP,*) + & ' SCHUR leading dimension SCHUR_LLD ', + & id%SCHUR_LLD, 'too small with respect to', + & id%root%SCHUR_MLOC + id%INFO(1)=-30 + id%INFO(2)=id%SCHUR_LLD + ELSE IF ( .NOT. associated (id%SCHUR)) THEN + IF (LP.GT.0) write(LP,'(A)') + & ' SCHUR not associated' + id%INFO(1)=-22 + id%INFO(2)=9 + ELSE IF (size(id%SCHUR) < + & id%SCHUR_LLD*(id%root%SCHUR_NLOC-1)+ + & id%root%SCHUR_MLOC) THEN + IF (LP.GT.0) THEN + write(LP,'(A)') + & ' SCHUR allocated but too small' + write(LP,*) id%MYID, ' : Size Schur=', + & size(id%SCHUR), + & ' SCHUR_LLD= ', id%SCHUR_LLD, + & ' SCHUR_MLOC=', id%root%SCHUR_NLOC, + & ' SCHUR_NLOC=', id%root%SCHUR_NLOC + ENDIF + id%INFO(1)=-22 + id%INFO(2)= 9 + ELSE + id%root%SCHUR_LLD=id%SCHUR_LLD + IF (id%root%SCHUR_NLOC==0) THEN + ALLOCATE(id%root%SCHUR_POINTER(1)) + ELSE + id%root%SCHUR_POINTER=>id%SCHUR + ENDIF + ENDIF + ENDIF + ENDIF + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) GO TO 499 + CALL SMUMPS_142(id) + IF (id%MYID .eq. MASTER) id%INFOG(33)=id%KEEP(52) + IF (id%KEEP(60).EQ.2.OR.id%KEEP(60).EQ.3) THEN + IF (id%root%yes) THEN + IF (id%root%SCHUR_NLOC==0) THEN + DEALLOCATE(id%root%SCHUR_POINTER) + NULLIFY(id%root%SCHUR_POINTER) + ELSE + NULLIFY(id%root%SCHUR_POINTER) + ENDIF + ENDIF + ENDIF + IF ( id%INFO(1) .LT. 0 ) GO TO 499 + id%KEEP(40) = 2 - 456789 + END IF + IF (LSOLVE) THEN + id%KEEP(40) = 2 -456789 + IF (id%MYID .eq. MASTER) THEN + KEEP235SAVE = id%KEEP(235) + KEEP242SAVE = id%KEEP(242) + KEEP243SAVE = id%KEEP(243) + IF (id%KEEP(242).EQ.0) id%KEEP(243)=0 + ENDIF + CALL SMUMPS_301(id) + IF (id%MYID .eq. MASTER) THEN + id%KEEP(235) = KEEP235SAVE + id%KEEP(242) = KEEP242SAVE + id%KEEP(243) = KEEP243SAVE + ENDIF + IF (id%INFO(1).LT.0) GOTO 499 + id%KEEP(40) = 3 -456789 + ENDIF + IF (MP.GT.0) CALL SMUMPS_349(id, MP) + GOTO 500 + 499 PROK = ((id%ICNTL(1).GT.0).AND. + & (id%ICNTL(4).GE.1)) + IF (PROK) WRITE (id%ICNTL(1),99995) id%INFO(1) + IF (PROK) WRITE (id%ICNTL(1),99994) id%INFO(2) +500 CONTINUE +#if ! defined(LARGEMATRICES) + IF (id%MYID .eq. MASTER .AND. id%KEEP(23) .NE. 0 + & .AND. NOERRORBEFOREPERM) THEN + IF (id%JOB .NE. 3 .OR. UNS_PERM_DONE) THEN + DO I = 1, id%NZ + J=id%JCN(I) + IF (J.LE.0.OR.J.GT.id%N) CYCLE + id%JCN(I)=id%UNS_PERM(J) + END DO + END IF + END IF +#endif + 510 CONTINUE + CALL SMUMPS_300(id%INFO(1), id%INFOG(1), id%COMM, id%MYID) + CALL MPI_BCAST( id%RINFOG(1), 40, MPI_REAL, MASTER, + & id%COMM, IERR ) + IF (id%MYID.EQ.MASTER.and.MPG.GT.0.and. + & id%INFOG(1).lt.0) THEN + WRITE(MPG,'(A,I12)') ' On return from SMUMPS, INFOG(1)=', + & id%INFOG(1) + WRITE(MPG,'(A,I12)') ' On return from SMUMPS, INFOG(2)=', + & id%INFOG(2) + END IF + CALL MPI_COMM_FREE( id%COMM, IERR ) + id%COMM = COMM_SAVE + RETURN +99995 FORMAT (' ** ERROR RETURN ** FROM SMUMPS INFO(1)=', I3) +99994 FORMAT (' ** INFO(2)=', I10) +99993 FORMAT (' ** Allocation error: could not permute JCN.') + END SUBROUTINE SMUMPS + SUBROUTINE SMUMPS_300( INFO, INFOG, COMM, MYID ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER INFO(40), INFOG(40), COMM, MYID + INTEGER TMP1(2),TMP(2) + INTEGER ROOT, IERR + INTEGER MASTER + PARAMETER (MASTER=0) + IF ( INFO(1) .ge. 0 .and. INFO(2) .ge. 0 ) THEN + INFOG(1) = INFO(1) + INFOG(2) = INFO(2) + ELSE + INFOG(1) = INFO(1) + TMP1(1) = INFO(1) + TMP1(2) = MYID + CALL MPI_ALLREDUCE(TMP1,TMP,1,MPI_2INTEGER, + & MPI_MINLOC,COMM,IERR ) + INFOG(2) = INFO(2) + ROOT = TMP(2) + CALL MPI_BCAST( INFOG(1), 1, MPI_INTEGER, ROOT, COMM, IERR ) + CALL MPI_BCAST( INFOG(2), 1, MPI_INTEGER, ROOT, COMM, IERR ) + END IF + CALL MPI_BCAST(INFOG(3), 38, MPI_INTEGER, MASTER, COMM, IERR ) + RETURN + END SUBROUTINE SMUMPS_300 + SUBROUTINE SMUMPS_349(id, LP) + USE SMUMPS_STRUC_DEF + TYPE (SMUMPS_STRUC), TARGET, INTENT(IN) :: id + INTEGER :: LP + INTEGER, POINTER :: JOB + INTEGER,DIMENSION(:),POINTER::ICNTL + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (LP.LT.0) RETURN + JOB=>id%JOB + ICNTL=>id%ICNTL + IF (id%MYID.EQ.MASTER) THEN + SELECT CASE (JOB) + CASE(1); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) ICNTL(5),ICNTL(6),ICNTL(7),ICNTL(12), + & ICNTL(13),ICNTL(18),ICNTL(19),ICNTL(22) + IF ((ICNTL(6).EQ.5).OR.(ICNTL(6).EQ.6).OR. + & (ICNTL(12).NE.1) ) THEN + WRITE (LP,992) ICNTL(8) + ENDIF + IF (id%ICNTL(19).NE.0) + & WRITE(LP,998) id%SIZE_SCHUR + WRITE (LP,993) ICNTL(14) + CASE(2); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,992) ICNTL(8) + WRITE (LP,993) ICNTL(14) + CASE(3); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + CASE(4); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,992) ICNTL(8) + IF (id%ICNTL(19).NE.0) + & WRITE(LP,998) id%SIZE_SCHUR + WRITE (LP,993) ICNTL(14) + CASE(5); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) ICNTL(5),ICNTL(6),ICNTL(7),ICNTL(12), + & ICNTL(13),ICNTL(18),ICNTL(19),ICNTL(22) + WRITE (LP,992) ICNTL(8) + WRITE (LP,993) ICNTL(14) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + CASE(6); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) ICNTL(5),ICNTL(6),ICNTL(7),ICNTL(12), + & ICNTL(13),ICNTL(18),ICNTL(19),ICNTL(22) + IF (id%ICNTL(19).NE.0) + & WRITE(LP,998) id%SIZE_SCHUR + WRITE (LP,992) ICNTL(8) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + WRITE (LP,993) ICNTL(14) + END SELECT + ENDIF + 980 FORMAT (/'***********CONTROL PARAMETERS (ICNTL)**************'/) + 990 FORMAT ( + & 'ICNTL(1) Output stream for error messages =',I10/ + & 'ICNTL(2) Output stream for diagnostic messages =',I10/ + & 'ICNTL(3) Output stream for global information =',I10/ + & 'ICNTL(4) Level of printing =',I10) + 991 FORMAT ( + & 'ICNTL(5) Matrix format ( keep(55) ) =',I10/ + & 'ICNTL(6) Maximum transversal ( keep(23) ) =',I10/ + & 'ICNTL(7) Ordering =',I10/ + & 'ICNTL(12) LDLT ordering strat ( keep(95) ) =',I10/ + & 'ICNTL(13) Parallel root (0=on, 1=off) =',I10/ + & 'ICNTL(18) Distributed matrix ( keep(54) ) =',I10/ + & 'ICNTL(19) Schur option ( keep(60) 0=off,else=on ) =',I10/ + & 'ICNTL(22) Out-off-core option (0=Off, >0=ON) =',I10) + 992 FORMAT ( + & 'ICNTL(8) Scaling strategy =',I10) + 993 FORMAT ( + & 'ICNTL(14) Percent of memory increase =',I10) + 995 FORMAT ( + & 'ICNTL(9) Solve A x=b (1) or A''x = b (else) =',I10/ + & 'ICNTL(10) Max steps iterative refinement =',I10/ + & 'ICNTL(11) Error analysis ( 0= off, else=on) =',I10) + 998 FORMAT ( + & ' Size of SCHUR matrix (SIZE_SHUR) =',I10) + END SUBROUTINE SMUMPS_349 + SUBROUTINE SMUMPS_350(id, LP) + USE SMUMPS_STRUC_DEF + TYPE (SMUMPS_STRUC), TARGET, INTENT(IN) :: id + INTEGER ::LP + INTEGER, POINTER :: JOB + INTEGER,DIMENSION(:),POINTER::ICNTL, KEEP + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (LP.LT.0) RETURN + JOB=>id%JOB + ICNTL=>id%ICNTL + KEEP=>id%KEEP + IF (id%MYID.EQ.MASTER) THEN + SELECT CASE (JOB) + CASE(1); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + IF ((KEEP(23).EQ.5).OR.(KEEP(23).EQ.6))THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,993) KEEP(12) + CASE(2); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + IF (KEEP(23).EQ.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,993) KEEP(12) + CASE(3); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + CASE(4); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + IF (KEEP(23).NE.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + WRITE (LP,993) KEEP(12) + CASE(5); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + IF ((KEEP(23).EQ.5).OR.(KEEP(23).EQ.6) + & .OR. (KEEP(23).EQ.7)) THEN + WRITE (LP,992) KEEP(52) + ENDIF + IF (KEEP(23).EQ.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,993) KEEP(12) + CASE(6); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + IF ((KEEP(23).EQ.5).OR.(KEEP(23).EQ.6) + & .OR. (KEEP(23).EQ.7)) THEN + WRITE (LP,992) KEEP(52) + ENDIF + IF (KEEP(23).EQ.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),KEEP(248),ICNTL(21) + WRITE (LP,993) KEEP(12) + END SELECT + ENDIF + 980 FORMAT (/'******INTERNAL VALUE OF PARAMETERS (ICNTL/KEEP)****'/) + 990 FORMAT ( + & 'ICNTL(1) Output stream for error messages =',I10/ + & 'ICNTL(2) Output stream for diagnostic messages =',I10/ + & 'ICNTL(3) Output stream for global information =',I10/ + & 'ICNTL(4) Level of printing =',I10) + 991 FORMAT ( + & 'ICNTL(5) Matrix format ( keep(55) ) =',I10/ + & 'ICNTL(6) Maximum transversal ( keep(23) ) =',I10/ + & 'ICNTL(7) Ordering =',I10/ + & 'ICNTL(12) LDLT ordering strat ( keep(95) ) =',I10/ + & 'ICNTL(13) Parallel root (0=on, 1=off) =',I10/ + & 'ICNTL(18) Distributed matrix ( keep(54) ) =',I10/ + & 'ICNTL(19) Schur option ( keep(60) 0=off,else=on ) =',I10/ + & 'ICNTL(22) Out-off-core option (0=Off, >0=ON) =',I10) + 992 FORMAT ( + & 'ICNTL(8) Scaling strategy ( keep(52) ) =',I10) + 993 FORMAT ( + & 'ICNTL(14) Percent of memory increase ( keep(12) ) =',I10) + 995 FORMAT ( + & 'ICNTL(9) Solve A x=b (1) or A''x = b (else) =',I10/ + & 'ICNTL(10) Max steps iterative refinement =',I10/ + & 'ICNTL(11) Error analysis ( 0= off, else=on) =',I10/ + & 'ICNTL(20) Dense (0) or sparse (1) RHS =',I10/ + & 'ICNTL(21) Gathered (0) or distributed(1) solution =',I10) + END SUBROUTINE SMUMPS_350 + SUBROUTINE SMUMPS_758 + & (idRHS, idINFO, idN, idNRHS, idLRHS) + IMPLICIT NONE + REAL, DIMENSION(:), POINTER :: idRHS + INTEGER, intent(in) :: idN, idNRHS, idLRHS + INTEGER, intent(inout) :: idINFO(:) + IF ( .not. associated( idRHS ) ) THEN + idINFO( 1 ) = -22 + idINFO( 2 ) = 7 + ELSE IF (idNRHS.EQ.1) THEN + IF ( size( idRHS ) < idN ) THEN + idINFO( 1 ) = -22 + idINFO( 2 ) = 7 + ENDIF + ELSE IF (idLRHS < idN) + & THEN + idINFO( 1 ) = -26 + idINFO( 2 ) = idLRHS + ELSE IF + & (size(idRHS)<(idNRHS*idLRHS-idLRHS+idN)) + & THEN + idINFO( 1 ) = -22 + idINFO( 2 ) = 7 + END IF + RETURN + END SUBROUTINE SMUMPS_758 + SUBROUTINE SMUMPS_807(id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (SMUMPS_STRUC) :: id + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (id%MYID.EQ.MASTER) THEN + id%KEEP(221)=id%ICNTL(26) + IF (id%KEEP(221).ne.0 .and. id%KEEP(221) .NE.1 + & .AND.id%KEEP(221).ne.2) id%KEEP(221)=0 + ENDIF + RETURN + END SUBROUTINE SMUMPS_807 + SUBROUTINE SMUMPS_769(id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (SMUMPS_STRUC) :: id + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (id%MYID .EQ. MASTER) THEN + IF ( id%KEEP(221) == 1 .or. id%KEEP(221) == 2 ) THEN + IF (id%KEEP(221) == 2 .and. id%JOB == 2) THEN + id%INFO(1)=-35 + id%INFO(2)=id%KEEP(221) + GOTO 333 + ENDIF + IF (id%KEEP(221) == 1 .and. id%KEEP(252) == 1 + & .and. id%JOB == 3) THEN + id%INFO(1)=-35 + id%INFO(2)=id%KEEP(221) + ENDIF + IF ( id%KEEP(60).eq. 0 .or. id%SIZE_SCHUR.EQ.0 ) THEN + id%INFO(1)=-33 + id%INFO(2)=id%KEEP(221) + GOTO 333 + ENDIF + IF ( .NOT. associated( id%REDRHS)) THEN + id%INFO(1)=-22 + id%INFO(2)=15 + GOTO 333 + ELSE IF (id%NRHS.EQ.1) THEN + IF (size(id%REDRHS) < id%SIZE_SCHUR ) THEN + id%INFO(1)=-22 + id%INFO(2)=15 + GOTO 333 + ENDIF + ELSE IF (id%LREDRHS < id%SIZE_SCHUR) THEN + id%INFO(1)=-34 + id%INFO(2)=id%LREDRHS + GOTO 333 + ELSE IF + & (size(id%REDRHS)< + & id%NRHS*id%LREDRHS-id%LREDRHS+id%SIZE_SCHUR) + & THEN + id%INFO(1)=-22 + id%INFO(2)=15 + GOTO 333 + ENDIF + ENDIF + ENDIF + 333 CONTINUE + RETURN + END SUBROUTINE SMUMPS_769 + SUBROUTINE SMUMPS_24( MYID, SLAVEF, N, + & PROCNODE, STEP, PTRAIW, PTRARW, ISTEP_TO_INIV2, + & I_AM_CAND, + & KEEP, KEEP8, ICNTL, id ) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (SMUMPS_STRUC) :: id + INTEGER MYID, N, SLAVEF + INTEGER KEEP( 500 ), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE( KEEP(28) ), STEP( N ), + & PTRAIW( N ), PTRARW( N ) + INTEGER ISTEP_TO_INIV2(KEEP(71)) + LOGICAL I_AM_CAND(max(1,KEEP(56))) + LOGICAL I_AM_SLAVE + LOGICAL I_AM_CAND_LOC + INTEGER MUMPS_330, MUMPS_275, MUMPS_810 + EXTERNAL MUMPS_330, MUMPS_275, MUMPS_810 + INTEGER ISTEP, I, IPTRI, IPTRR, NCOL, NROW, allocok + INTEGER TYPE_PARALL, ITYPE, IRANK, INIV2, TYPESPLIT + LOGICAL T4_MASTER_CONCERNED + TYPE_PARALL = KEEP(46) + I_AM_SLAVE = (KEEP(46).EQ.1 .OR. MYID.NE.0) + KEEP(14) = 0 + KEEP(13) = 0 + DO I = 1, N + ISTEP=abs(STEP(I)) + ITYPE = MUMPS_330( PROCNODE(ISTEP), SLAVEF ) + IRANK = MUMPS_275( PROCNODE(ISTEP), SLAVEF ) + TYPESPLIT = MUMPS_810 ( PROCNODE(ISTEP), SLAVEF ) + I_AM_CAND_LOC = .FALSE. + T4_MASTER_CONCERNED = .FALSE. + IF (ITYPE.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF (I_AM_SLAVE) THEN + I_AM_CAND_LOC = I_AM_CAND(INIV2) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + IF ( TYPE_PARALL .eq. 0 ) THEN + T4_MASTER_CONCERNED = + & ( id%CANDIDATES (id%CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + & .EQ.MYID-1 ) + ELSE + T4_MASTER_CONCERNED = + & ( id%CANDIDATES (id%CANDIDATES(SLAVEF+1, INIV2)+1,INIV2 ) + & .EQ.MYID ) + ENDIF + ENDIF + ENDIF + ENDIF + IF ( TYPE_PARALL .eq. 0 ) THEN + IRANK = IRANK + 1 + END IF + IF ( + & ( (ITYPE .EQ. 1.OR.ITYPE.EQ.2) .AND. + & IRANK .EQ. MYID ) + & .OR. + & ( T4_MASTER_CONCERNED ) + & ) THEN + KEEP( 14 ) = KEEP( 14 ) + 3 + PTRAIW( I ) + PTRARW( I ) + KEEP( 13 ) = KEEP( 13 ) + 1 + PTRAIW( I ) + PTRARW( I ) + ELSE IF ( ITYPE .EQ. 3 ) THEN + ELSE IF ( ITYPE .EQ. 2 .AND. I_AM_CAND_LOC ) THEN + PTRARW( I ) = 0 + KEEP(14) = KEEP(14) + 3 + PTRAIW( I ) + PTRARW( I ) + KEEP(13) = KEEP(13) + 1 + PTRAIW( I ) + PTRARW( I ) + END IF + END DO + IF ( associated( id%INTARR ) ) THEN + DEALLOCATE( id%INTARR ) + NULLIFY( id%INTARR ) + END IF + IF ( KEEP(14) > 0 ) THEN + ALLOCATE( id%INTARR( KEEP(14) ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = KEEP(14) + RETURN + END IF + ELSE + ALLOCATE( id%INTARR( 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = 1 + RETURN + END IF + END IF + IPTRI = 1 + IPTRR = 1 + DO I = 1, N + ISTEP = abs(STEP(I)) + ITYPE = MUMPS_330( PROCNODE(ISTEP), SLAVEF ) + IRANK = MUMPS_275( PROCNODE(ISTEP), SLAVEF ) + TYPESPLIT = MUMPS_810 ( PROCNODE(ISTEP), SLAVEF ) + I_AM_CAND_LOC = .FALSE. + T4_MASTER_CONCERNED = .FALSE. + IF (ITYPE.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF (I_AM_SLAVE) THEN + I_AM_CAND_LOC = I_AM_CAND(INIV2) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + IF ( TYPE_PARALL .eq. 0 ) THEN + T4_MASTER_CONCERNED = + & (id%CANDIDATES (id%CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + & .EQ.MYID-1 ) + ELSE + T4_MASTER_CONCERNED = + & (id%CANDIDATES (id%CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + & .EQ.MYID ) + ENDIF + ENDIF + ENDIF + ENDIF + IF ( TYPE_PARALL .eq. 0 ) THEN + IRANK =IRANK + 1 + END IF + IF ( + & ( ITYPE .eq. 2 .and. + & IRANK .eq. MYID ) + & .or. + & ( ITYPE .eq. 1 .and. + & IRANK .eq. MYID ) + & .or. + & ( T4_MASTER_CONCERNED ) + & ) THEN + NCOL = PTRAIW( I ) + NROW = PTRARW( I ) + id%INTARR( IPTRI ) = NCOL + id%INTARR( IPTRI + 1 ) = -NROW + id%INTARR( IPTRI + 2 ) = I + PTRAIW( I ) = IPTRI + PTRARW( I ) = IPTRR + IPTRI = IPTRI + NCOL + NROW + 3 + IPTRR = IPTRR + NCOL + NROW + 1 + ELSE IF ( ITYPE .eq. 2 .AND. I_AM_CAND_LOC ) THEN + NCOL = PTRAIW( I ) + NROW = 0 + id%INTARR( IPTRI ) = NCOL + id%INTARR( IPTRI + 1 ) = -NROW + id%INTARR( IPTRI + 2 ) = I + PTRAIW( I ) = IPTRI + PTRARW( I ) = IPTRR + IPTRI = IPTRI + NCOL + NROW + 3 + IPTRR = IPTRR + NCOL + NROW + 1 + ELSE + PTRAIW(I) = 0 + PTRARW(I) = 0 + END IF + END DO + IF ( IPTRI - 1 .NE. KEEP(14) ) THEN + WRITE(*,*) 'Error 1 in anal_arrowheads', + & ' IPTRI - 1, KEEP(14)=', IPTRI - 1, KEEP(14) + CALL MUMPS_ABORT() + END IF + IF ( IPTRR - 1 .NE. KEEP(13) ) THEN + WRITE(*,*) 'Error 2 in anal_arrowheads' + CALL MUMPS_ABORT() + END IF + RETURN + END SUBROUTINE SMUMPS_24 + SUBROUTINE SMUMPS_148(N, NZ, ASPK, + & IRN, ICN, PERM, + & LSCAL,COLSCA,ROWSCA, + & MYID, SLAVEF, PROCNODE_STEPS, NBRECORDS, + & LP, COMM, root, KEEP, KEEP8, FILS, RG2L, + & INTARR, DBLARR, PTRAIW, PTRARW, FRERE_STEPS, + & STEP, A, LA, ISTEP_TO_INIV2, I_AM_CAND, CANDIDATES ) + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INTEGER N,NZ, COMM, NBRECORDS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + REAL ASPK(NZ) + REAL COLSCA(*), ROWSCA(*) + INTEGER IRN(NZ), ICN(NZ) + INTEGER PERM(N), PROCNODE_STEPS(KEEP(28)) + INTEGER RG2L( N ), FILS( N ) + INTEGER ISTEP_TO_INIV2(KEEP(71)) + LOGICAL I_AM_CAND(max(1,KEEP(56))) + INTEGER LP, SLAVEF, MYID + INTEGER CANDIDATES(SLAVEF+1, max(1,KEEP(56))) + LOGICAL LSCAL + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER(8) :: LA + INTEGER PTRAIW( N ), PTRARW( N ), FRERE_STEPS( KEEP(28) ) + INTEGER STEP(N) + INTEGER INTARR( max(1,KEEP(14)) ) + REAL A( LA ), DBLARR(max(1,KEEP(13))) + INTEGER, DIMENSION(:,:), ALLOCATABLE :: BUFI + REAL, DIMENSION(:,:), ALLOCATABLE :: BUFR + INTEGER MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + REAL VAL + INTEGER IOLD,JOLD,INEW,JNEW,ISEND,JSEND,DEST,I,K,IARR + INTEGER IPOSROOT, JPOSROOT + INTEGER IROW_GRID, JCOL_GRID + INTEGER INODE, ISTEP + INTEGER NBUFS + INTEGER ARROW_ROOT, TAILLE + INTEGER LOCAL_M, LOCAL_N + INTEGER(8) :: PTR_ROOT + INTEGER TYPENODE_TMP, MASTER_NODE + LOGICAL I_AM_CAND_LOC, I_AM_SLAVE + INTEGER I1, IA, JARR, ILOCROOT, JLOCROOT + INTEGER IS1, ISHIFT, IIW, IS, IAS + INTEGER allocok, TYPESPLIT, T4MASTER, INIV2 + LOGICAL T4_MASTER_CONCERNED + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INTEGER, POINTER, DIMENSION(:,:) :: IW4 + ARROW_ROOT = 0 + I_AM_SLAVE=(MYID.NE.0.OR.KEEP(46).EQ.1) + IF ( KEEP(46) .eq. 0 ) THEN + NBUFS = SLAVEF + ELSE + NBUFS = SLAVEF - 1 + ALLOCATE( IW4( N, 2 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) 'Error allocating IW4' + CALL MUMPS_ABORT() + END IF + DO I = 1, N + I1 = PTRAIW( I ) + IA = PTRARW( I ) + IF ( IA .GT. 0 ) THEN + DBLARR( IA ) = ZERO + IW4( I, 1 ) = INTARR( I1 ) + IW4( I, 2 ) = -INTARR( I1 + 1 ) + INTARR( I1 + 2 ) = I + END IF + END DO + IF ( KEEP(38) .NE. 0 ) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I = 1, root%SCHUR_NLOC + root%SCHUR_POINTER(int(I-1,8)*int(root%SCHUR_LLD,8)+1_8: + & int(I-1,8)*int(root%SCHUR_LLD,8)+int(root%SCHUR_MLOC,8))= + & ZERO + ENDDO + ENDIF + END IF + END IF + IF (NBUFS.GT.0) THEN + ALLOCATE( BUFI(NBRECORDS*2+1,NBUFS),stat=allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) 'Error allocating BUFI' + CALL MUMPS_ABORT() + END IF + ALLOCATE( BUFR( NBRECORDS, NBUFS ), stat=allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) 'Error allocating BUFR' + CALL MUMPS_ABORT() + END IF + DO I = 1, NBUFS + BUFI( 1, I ) = 0 + ENDDO + ENDIF + INODE = KEEP(38) + I = 1 + DO WHILE ( INODE .GT. 0 ) + RG2L( INODE ) = I + INODE = FILS( INODE ) + I = I + 1 + END DO + DO 120 K=1,NZ + IOLD = IRN(K) + JOLD = ICN(K) + IF ( (IOLD.GT.N).OR.(JOLD.GT.N).OR.(IOLD.LT.1) + & .OR.(JOLD.LT.1) ) THEN + GOTO 120 + END IF + IF (LSCAL) THEN + VAL = ASPK(K)*ROWSCA(IOLD)*COLSCA(JOLD) + ELSE + VAL = ASPK(K) + ENDIF + IF (IOLD.EQ.JOLD) THEN + ISEND = IOLD + JSEND = JOLD + ELSE + INEW = PERM(IOLD) + JNEW = PERM(JOLD) + IF (INEW.LT.JNEW) THEN + ISEND = IOLD + IF ( KEEP(50) .NE. 0 ) ISEND = -IOLD + JSEND = JOLD + ELSE + ISEND = -JOLD + JSEND = IOLD + ENDIF + ENDIF + IARR = abs( ISEND ) + ISTEP = abs( STEP(IARR) ) + TYPENODE_TMP = MUMPS_330( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + MASTER_NODE = MUMPS_275( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + TYPESPLIT = MUMPS_810( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + I_AM_CAND_LOC = .FALSE. + T4_MASTER_CONCERNED = .FALSE. + T4MASTER = -9999 + IF (TYPENODE_TMP.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF (I_AM_SLAVE) I_AM_CAND_LOC = I_AM_CAND(INIV2) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + T4_MASTER_CONCERNED = .TRUE. + T4MASTER=CANDIDATES(CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + IF ( KEEP(46) .eq. 0 ) THEN + T4MASTER=T4MASTER+1 + ENDIF + ENDIF + ENDIF + IF ( TYPENODE_TMP .EQ. 1 ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + DEST = MASTER_NODE + 1 + ELSE + DEST = MASTER_NODE + END IF + ELSE IF ( TYPENODE_TMP .EQ. 2 ) THEN + IF ( ISEND .LT. 0 ) THEN + DEST = -1 + ELSE + IF ( KEEP( 46 ) .eq. 0 ) THEN + DEST = MASTER_NODE + 1 + ELSE + DEST = MASTER_NODE + END IF + END IF + ELSE + IF ( ISEND .LT. 0 ) THEN + IPOSROOT = RG2L(JSEND) + JPOSROOT = RG2L(IARR) + ELSE + IPOSROOT = RG2L( IARR ) + JPOSROOT = RG2L( JSEND ) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, root%NPCOL ) + IF ( KEEP( 46 ) .eq. 0 ) THEN + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + 1 + ELSE + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + END IF + END IF + IF ( DEST .eq. 0 .or. + & ( DEST .eq. -1 .and. KEEP( 46 ) .eq. 1 .AND. + & ( I_AM_CAND_LOC .OR. MASTER_NODE .EQ. 0 ) ) + & .or. + & ( T4MASTER.EQ.0 ) + & ) THEN + IARR = ISEND + JARR = JSEND + IF ( TYPENODE_TMP .eq. 3 ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + IF ( IROW_GRID .EQ. root%MYROW .AND. + & JCOL_GRID .EQ. root%MYCOL ) THEN + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & = A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + ELSE + WRITE(*,*) MYID,':INTERNAL Error: root arrowhead ' + WRITE(*,*) MYID,':is not belonging to me. IARR,JARR=' + & ,IARR,JARR + CALL MUMPS_ABORT() + END IF + ELSE IF ( IARR .GE. 0 ) THEN + IF ( IARR .eq. JARR ) THEN + IA = PTRARW( IARR ) + DBLARR( IA ) = DBLARR( IA ) + VAL + ELSE + IS1 = PTRAIW(IARR) + ISHIFT = INTARR(IS1) + IW4(IARR,2) + IW4(IARR,2) = IW4(IARR,2) - 1 + IIW = IS1 + ISHIFT + 2 + INTARR(IIW) = JARR + IS = PTRARW(IARR) + IAS = IS + ISHIFT + DBLARR(IAS) = VAL + END IF + ELSE + IARR = -IARR + ISHIFT = PTRAIW(IARR)+IW4(IARR,1)+2 + INTARR(ISHIFT) = JARR + IAS = PTRARW(IARR)+IW4(IARR,1) + IW4(IARR,1) = IW4(IARR,1) - 1 + DBLARR(IAS) = VAL + IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0 ) + & .AND. IW4(IARR,1) .EQ. 0 .AND. + & STEP( IARR) > 0 ) THEN + IF (MUMPS_275( PROCNODE_STEPS(abs(STEP(IARR))), + & SLAVEF ) == MYID) THEN + TAILLE = INTARR( PTRAIW(IARR) ) + CALL SMUMPS_310( N, PERM, + & INTARR( PTRAIW(IARR) + 3 ), + & DBLARR( PTRARW(IARR) + 1 ), + & TAILLE, 1, TAILLE ) + END IF + END IF + ENDIF + END IF + IF ( DEST.EQ. -1 ) THEN + DO I=1, CANDIDATES(SLAVEF+1,ISTEP_TO_INIV2(ISTEP)) + DEST=CANDIDATES(I,ISTEP_TO_INIV2(ISTEP)) + IF (KEEP(46).EQ.0) DEST=DEST+1 + IF (DEST.NE.0) + & CALL SMUMPS_34( ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDDO + DEST = MASTER_NODE + IF (KEEP(46).EQ.0) DEST=DEST+1 + IF ( DEST .NE. 0 ) THEN + CALL SMUMPS_34( ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDIF + IF ((T4_MASTER_CONCERNED).AND.(T4MASTER.GT.0)) THEN + CALL SMUMPS_34( ISEND, JSEND, VAL, + & T4MASTER, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDIF + ELSE IF ( DEST .GT. 0 ) THEN + CALL SMUMPS_34( ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + IF ( T4MASTER.GT.0 ) THEN + CALL SMUMPS_34( ISEND, JSEND, VAL, + & T4MASTER, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDIF + ELSE IF ( T4MASTER.GT.0 ) THEN + CALL SMUMPS_34( ISEND, JSEND, VAL, + & T4MASTER, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + END IF + 120 CONTINUE + KEEP(49) = ARROW_ROOT + IF (NBUFS.GT.0) THEN + CALL SMUMPS_18( + & BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP( 46 ) ) + ENDIF + IF ( KEEP( 46 ) .NE. 0 ) DEALLOCATE( IW4 ) + IF (NBUFS.GT.0) THEN + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + ENDIF + RETURN + END SUBROUTINE SMUMPS_148 + SUBROUTINE SMUMPS_34(ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, LP, COMM, + & TYPE_PARALL ) + IMPLICIT NONE + INTEGER ISEND, JSEND, DEST, NBUFS, NBRECORDS, TYPE_PARALL + INTEGER BUFI( NBRECORDS * 2 + 1, NBUFS ) + REAL BUFR( NBRECORDS, NBUFS ) + INTEGER COMM + INTEGER LP + REAL VAL + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + INTEGER TAILLE_SENDI, TAILLE_SENDR, IREQ + IF (BUFI(1,DEST)+1.GT.NBRECORDS) THEN + TAILLE_SENDI = BUFI(1,DEST) * 2 + 1 + TAILLE_SENDR = BUFI(1,DEST) + CALL MPI_SEND(BUFI(1,DEST),TAILLE_SENDI, + & MPI_INTEGER, + & DEST, ARROWHEAD, COMM, IERR ) + CALL MPI_SEND( BUFR(1,DEST), TAILLE_SENDR, + & MPI_REAL, DEST, + & ARROWHEAD, COMM, IERR ) + BUFI(1,DEST) = 0 + ENDIF + IREQ = BUFI(1,DEST) + 1 + BUFI(1,DEST) = IREQ + BUFI( IREQ * 2, DEST ) = ISEND + BUFI( IREQ * 2 + 1, DEST ) = JSEND + BUFR( IREQ, DEST ) = VAL + RETURN + END SUBROUTINE SMUMPS_34 + SUBROUTINE SMUMPS_18( + & BUFI, BUFR, NBRECORDS, NBUFS, LP, COMM, + & TYPE_PARALL ) + IMPLICIT NONE + INTEGER NBUFS, NBRECORDS, TYPE_PARALL + INTEGER BUFI( NBRECORDS * 2 + 1, NBUFS ) + REAL BUFR( NBRECORDS, NBUFS ) + INTEGER COMM + INTEGER LP + INTEGER ISLAVE, TAILLE_SENDI, TAILLE_SENDR, IERR + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + DO ISLAVE = 1,NBUFS + TAILLE_SENDI = BUFI(1,ISLAVE) * 2 + 1 + TAILLE_SENDR = BUFI(1,ISLAVE) + BUFI(1,ISLAVE) = - BUFI(1,ISLAVE) + CALL MPI_SEND(BUFI(1,ISLAVE),TAILLE_SENDI, + & MPI_INTEGER, + & ISLAVE, ARROWHEAD, COMM, IERR ) + IF ( TAILLE_SENDR .NE. 0 ) THEN + CALL MPI_SEND( BUFR(1,ISLAVE), TAILLE_SENDR, + & MPI_REAL, ISLAVE, + & ARROWHEAD, COMM, IERR ) + END IF + ENDDO + RETURN + END SUBROUTINE SMUMPS_18 + RECURSIVE SUBROUTINE SMUMPS_310( N, PERM, + & INTLIST, DBLLIST, TAILLE, LO, HI ) + IMPLICIT NONE + INTEGER N, TAILLE + INTEGER PERM( N ) + INTEGER INTLIST( TAILLE ) + REAL DBLLIST( TAILLE ) + INTEGER LO, HI + INTEGER I,J + INTEGER ISWAP, PIVOT + REAL sswap + I = LO + J = HI + PIVOT = PERM(INTLIST((I+J)/2)) + 10 IF (PERM(INTLIST(I)) < PIVOT) THEN + I=I+1 + GOTO 10 + ENDIF + 20 IF (PERM(INTLIST(J)) > PIVOT) THEN + J=J-1 + GOTO 20 + ENDIF + IF (I < J) THEN + ISWAP = INTLIST(I) + INTLIST(I) = INTLIST(J) + INTLIST(J)=ISWAP + sswap = DBLLIST(I) + DBLLIST(I) = DBLLIST(J) + DBLLIST(J) = sswap + ENDIF + IF ( I <= J) THEN + I = I+1 + J = J-1 + ENDIF + IF ( I <= J ) GOTO 10 + IF ( LO < J ) CALL SMUMPS_310(N, PERM, + & INTLIST, DBLLIST, TAILLE, LO, J) + IF ( I < HI ) CALL SMUMPS_310(N, PERM, + & INTLIST, DBLLIST, TAILLE, I, HI) + RETURN + END SUBROUTINE SMUMPS_310 + SUBROUTINE SMUMPS_145( N, + & DBLARR, LDBLARR, INTARR, LINTARR, PTRAIW, PTRARW, + & KEEP, KEEP8, MYID, COMM, NBRECORDS, + & A, LA, root, + & PROCNODE_STEPS, + & SLAVEF, PERM, FRERE_STEPS, STEP, INFO1, INFO2 + & ) + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INTEGER N, MYID, LDBLARR, LINTARR, + & COMM + INTEGER INTARR(LINTARR) + INTEGER PTRAIW(N), PTRARW(N) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8), intent(IN) :: LA + INTEGER PROCNODE_STEPS( KEEP(28) ), PERM( N ) + INTEGER SLAVEF, NBRECORDS + REAL A( LA ) + INTEGER INFO1, INFO2 + REAL DBLARR(LDBLARR) + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER, POINTER, DIMENSION(:) :: BUFI + REAL, POINTER, DIMENSION(:) :: BUFR + INTEGER, POINTER, DIMENSION(:,:) :: IW4 + LOGICAL FINI + INTEGER IREC, NB_REC, IARR, JARR, IA, I1, I, allocok + INTEGER IS, IS1, ISHIFT, IIW, IAS + INTEGER LOCAL_M, LOCAL_N, ILOCROOT, JLOCROOT, + & IPOSROOT, JPOSROOT, TAILLE, + & IPROC + INTEGER FRERE_STEPS( KEEP(28) ), STEP(N) + INTEGER(8) :: PTR_ROOT + INTEGER ARROW_ROOT, TYPE_PARALL + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + REAL VAL + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER MASTER + PARAMETER(MASTER=0) + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER IERR + INTEGER numroc + EXTERNAL numroc + TYPE_PARALL = KEEP(46) + ARROW_ROOT=0 + ALLOCATE( BUFI( NBRECORDS * 2 + 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO1 = -13 + INFO2 = NBRECORDS * 2 + 1 + WRITE(*,*) MYID,': Could not allocate BUFI: goto 500' + GOTO 500 + END IF + ALLOCATE( BUFR( NBRECORDS ) , stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO1 = -13 + INFO2 = NBRECORDS + WRITE(*,*) MYID,': Could not allocate BUFR: goto 500' + GOTO 500 + END IF + ALLOCATE( IW4(N,2), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO1 = -13 + INFO2 = 2 * N + WRITE(*,*) MYID,': Could not allocate IW4: goto 500' + GOTO 500 + END IF + IF ( KEEP(38).NE.0) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I=1, root%SCHUR_NLOC + root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1: + & (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC)=ZERO + ENDDO + ENDIF + END IF + FINI = .FALSE. + DO I=1,N + I1 = PTRAIW(I) + IA = PTRARW(I) + IF (IA.GT.0) THEN + DBLARR(IA) = ZERO + IW4(I,1) = INTARR(I1) + IW4(I,2) = -INTARR(I1+1) + INTARR(I1+2)=I + ENDIF + ENDDO + DO WHILE (.NOT.FINI) + CALL MPI_RECV( BUFI(1), 2*NBRECORDS+1, + & MPI_INTEGER, MASTER, + & ARROWHEAD, + & COMM, STATUS, IERR ) + NB_REC = BUFI(1) + IF (NB_REC.LE.0) THEN + FINI = .TRUE. + NB_REC = -NB_REC + ENDIF + IF (NB_REC.EQ.0) EXIT + CALL MPI_RECV( BUFR(1), NBRECORDS, MPI_REAL, + & MASTER, ARROWHEAD, + & COMM, STATUS, IERR ) + DO IREC=1, NB_REC + IARR = BUFI( IREC * 2 ) + JARR = BUFI( IREC * 2 + 1 ) + VAL = BUFR( IREC ) + IF ( MUMPS_330( PROCNODE_STEPS(abs(STEP(abs(IARR)))), + & SLAVEF ) .eq. 3 ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + IF ( IARR .GT. 0 ) THEN + IPOSROOT = root%RG2L_ROW( IARR ) + JPOSROOT = root%RG2L_COL( JARR ) + ELSE + IPOSROOT = root%RG2L_ROW( JARR ) + JPOSROOT = root%RG2L_COL( -IARR ) + END IF + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & = A( PTR_ROOT + int(JLOCROOT - 1,8) + & * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8)) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + ELSE IF (IARR.GE.0) THEN + IF (IARR.EQ.JARR) THEN + IA = PTRARW(IARR) + DBLARR(IA) = DBLARR(IA) + VAL + ELSE + IS1 = PTRAIW(IARR) + ISHIFT = INTARR(IS1) + IW4(IARR,2) + IW4(IARR,2) = IW4(IARR,2) - 1 + IIW = IS1 + ISHIFT + 2 + INTARR(IIW) = JARR + IS = PTRARW(IARR) + IAS = IS + ISHIFT + DBLARR(IAS) = VAL + ENDIF + ELSE + IARR = -IARR + ISHIFT = PTRAIW(IARR)+IW4(IARR,1)+2 + INTARR(ISHIFT) = JARR + IAS = PTRARW(IARR)+IW4(IARR,1) + IW4(IARR,1) = IW4(IARR,1) - 1 + DBLARR(IAS) = VAL + IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0) + & .AND. IW4(IARR,1) .EQ. 0 + & .AND. STEP(IARR) > 0 ) THEN + IPROC = MUMPS_275( PROCNODE_STEPS(abs(STEP(IARR))), + & SLAVEF ) + IF ( TYPE_PARALL .eq. 0 ) THEN + IPROC = IPROC + 1 + END IF + IF (IPROC .EQ. MYID) THEN + TAILLE = INTARR( PTRAIW(IARR) ) + CALL SMUMPS_310( N, PERM, + & INTARR( PTRAIW(IARR) + 3 ), + & DBLARR( PTRARW(IARR) + 1 ), + & TAILLE, 1, TAILLE ) + END IF + END IF + ENDIF + ENDDO + END DO + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + DEALLOCATE( IW4 ) + 500 CONTINUE + KEEP(49) = ARROW_ROOT + RETURN + END SUBROUTINE SMUMPS_145 + SUBROUTINE SMUMPS_266( MYID, BUFR, LBUFR, + & LBUFR_BYTES, + & IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, + & TNBPROCFILS, N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP, + & KEEP,KEEP8, ITLOC, RHS_MUMPS, + & IFLAG, IERROR ) + USE SMUMPS_LOAD + IMPLICIT NONE + INTEGER MYID + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB, N, LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER PTRIST(KEEP(28)), STEP(N), + & PIMASTER(KEEP(28)), + & TNBPROCFILS( KEEP(28) ), ITLOC( N + KEEP(253) ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER COMP, IFLAG, IERROR + INTEGER INODE, NBPROCFILS, NCOL, NROW, NASS, NSLAVES + INTEGER NSLAVES_RECU, NFRONT + INTEGER LREQ + INTEGER(8) :: LREQCB + DOUBLE PRECISION FLOP1 + INCLUDE 'mumps_headers.h' + INODE = BUFR( 1 ) + NBPROCFILS = BUFR( 2 ) + NROW = BUFR( 3 ) + NCOL = BUFR( 4 ) + NASS = BUFR( 5 ) + NFRONT = BUFR( 6 ) + NSLAVES_RECU = BUFR( 7 ) + IF ( KEEP(50) .eq. 0 ) THEN + FLOP1 = dble( NASS * NROW ) + + & dble(NROW*NASS)*dble(2*NCOL-NASS-1) + ELSE + FLOP1 = dble( NASS ) * dble( NROW ) + & * dble( 2 * NCOL - NROW - NASS + 1) + END IF + CALL SMUMPS_190(1,.TRUE.,FLOP1, KEEP,KEEP8) + IF ( KEEP(50) .eq. 0 ) THEN + NSLAVES = NSLAVES_RECU + XTRA_SLAVES_UNSYM + ELSE + NSLAVES = NSLAVES_RECU + XTRA_SLAVES_SYM + END IF + LREQ = NROW + NCOL + 6 + NSLAVES + KEEP(IXSZ) + LREQCB = int(NCOL,8) * int(NROW,8) + CALL SMUMPS_22(.FALSE., 0_8, .FALSE.,.TRUE., + & MYID,N, KEEP,KEEP8, IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST, STEP, PIMASTER,PAMASTER, + & LREQ, LREQCB, INODE, S_ACTIVE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + PTRIST(STEP(INODE)) = IWPOSCB + 1 + PTRAST(STEP(INODE)) = IPTRLU + 1_8 + IW( IWPOSCB + 1+KEEP(IXSZ) ) = NCOL + IW( IWPOSCB + 2+KEEP(IXSZ) ) = - NASS + IW( IWPOSCB + 3+KEEP(IXSZ) ) = NROW + IW( IWPOSCB + 4+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 5+KEEP(IXSZ) ) = NASS + IW( IWPOSCB + 6+KEEP(IXSZ) ) = NSLAVES + IW( IWPOSCB + 7+KEEP(IXSZ)+NSLAVES : + & IWPOSCB + 6+KEEP(IXSZ)+NSLAVES + NROW + NCOL ) + &= BUFR( 8 + NSLAVES_RECU : 7 + NSLAVES_RECU + NROW + NCOL ) + IF ( KEEP(50) .eq. 0 ) THEN + IW( IWPOSCB + 7+KEEP(IXSZ) ) = S_ROOTBAND_INIT + IF (NSLAVES_RECU.GT.0) + & IW( IWPOSCB + 7+XTRA_SLAVES_UNSYM+KEEP(IXSZ): + & IWPOSCB+6+KEEP(IXSZ)+NSLAVES_RECU ) = + & BUFR( 8: 7 + NSLAVES_RECU ) + ELSE + IW( IWPOSCB + 7+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 8+KEEP(IXSZ) ) = NFRONT + IW( IWPOSCB + 9+KEEP(IXSZ) ) = S_ROOTBAND_INIT + IW( IWPOSCB + 7+XTRA_SLAVES_SYM+KEEP(IXSZ): + & IWPOSCB + 6+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_RECU ) = + & BUFR( 8: 7 + NSLAVES_RECU ) + END IF + TNBPROCFILS(STEP( INODE )) = NBPROCFILS + RETURN + END SUBROUTINE SMUMPS_266 + SUBROUTINE SMUMPS_163( id ) + USE SMUMPS_STRUC_DEF + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE (SMUMPS_STRUC) id + INTEGER MASTER, IERR,PAR_loc,SYM_loc + PARAMETER( MASTER = 0 ) + INTEGER color + CALL MPI_COMM_SIZE(id%COMM, id%NPROCS, IERR ) + PAR_loc=id%PAR + SYM_loc=id%SYM + CALL MPI_BCAST(PAR_loc,1,MPI_INTEGER,MASTER,id%COMM,IERR) + CALL MPI_BCAST(SYM_loc,1,MPI_INTEGER,MASTER,id%COMM,IERR) + IF ( PAR_loc .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + color = MPI_UNDEFINED + ELSE + color = 0 + END IF + CALL MPI_COMM_SPLIT( id%COMM, color, 0, + & id%COMM_NODES, IERR ) + id%NSLAVES = id%NPROCS - 1 + ELSE + CALL MPI_COMM_DUP( id%COMM, id%COMM_NODES, IERR ) + id%NSLAVES = id%NPROCS + END IF + IF (PAR_loc .ne. 0 .or. id%MYID .NE. MASTER) THEN + CALL MPI_COMM_DUP( id%COMM_NODES, id%COMM_LOAD, IERR ) + ENDIF + CALL SMUMPS_20( id%NSLAVES, id%LWK_USER, + & id%CNTL(1), id%ICNTL(1), + & id%KEEP(1), id%KEEP8(1), id%INFO(1), id%INFOG(1), + & id%RINFO(1), id%RINFOG(1), + & SYM_loc, PAR_loc, id%DKEEP(1) ) + id%WRITE_PROBLEM="NAME_NOT_INITIALIZED" + CALL MUMPS_SET_VERSION( id%VERSION_NUMBER ) + id%OOC_TMPDIR="NAME_NOT_INITIALIZED" + id%OOC_PREFIX="NAME_NOT_INITIALIZED" + id%NRHS = 1 + id%LRHS = 0 + id%LREDRHS = 0 + CALL SMUMPS_61( id%KEEP( 34 ), id%KEEP(35) ) + NULLIFY(id%BUFR) + id%MAXIS1 = 0 + id%INST_Number = -1 + id%N = 0; id%NZ = 0 + NULLIFY(id%IRN) + NULLIFY(id%JCN) + NULLIFY(id%A) + id%NZ_loc = 0 + NULLIFY(id%IRN_loc) + NULLIFY(id%JCN_loc) + NULLIFY(id%A_loc) + NULLIFY(id%MAPPING) + NULLIFY(id%RHS) + NULLIFY(id%REDRHS) + id%NZ_RHS=0 + NULLIFY(id%RHS_SPARSE) + NULLIFY(id%IRHS_SPARSE) + NULLIFY(id%IRHS_PTR) + NULLIFY(id%ISOL_loc) + id%LSOL_loc=0 + NULLIFY(id%SOL_loc) + NULLIFY(id%COLSCA) + NULLIFY(id%ROWSCA) + NULLIFY(id%PERM_IN) + NULLIFY(id%IS) + NULLIFY(id%IS1) + NULLIFY(id%STEP) + NULLIFY(id%Step2node) + NULLIFY(id%DAD_STEPS) + NULLIFY(id%NE_STEPS) + NULLIFY(id%ND_STEPS) + NULLIFY(id%FRERE_STEPS) + NULLIFY(id%SYM_PERM) + NULLIFY(id%UNS_PERM) + NULLIFY(id%PIVNUL_LIST) + NULLIFY(id%FILS) + NULLIFY(id%PTRAR) + NULLIFY(id%FRTPTR) + NULLIFY(id%FRTELT) + NULLIFY(id%NA) + id%LNA=0 + NULLIFY(id%PROCNODE_STEPS) + NULLIFY(id%S) + NULLIFY(id%PROCNODE) + NULLIFY(id%POIDS) + NULLIFY(id%PTLUST_S) + NULLIFY(id%PTRFAC) + NULLIFY(id%INTARR) + NULLIFY(id%DBLARR) + NULLIFY(id%DEPTH_FIRST) + NULLIFY(id%DEPTH_FIRST_SEQ) + NULLIFY(id%SBTR_ID) + NULLIFY(id%MEM_SUBTREE) + NULLIFY(id%MEM_SUBTREE) + NULLIFY(id%MY_ROOT_SBTR) + NULLIFY(id%MY_FIRST_LEAF) + NULLIFY(id%MY_NB_LEAF) + NULLIFY(id%COST_TRAV) + NULLIFY(id%RHSCOMP) + NULLIFY(id%POSINRHSCOMP) + NULLIFY(id%OOC_INODE_SEQUENCE) + NULLIFY(id%OOC_TOTAL_NB_NODES) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + NULLIFY(id%OOC_FILE_NAME_LENGTH) + NULLIFY(id%OOC_FILE_NAMES) + NULLIFY(id%OOC_VADDR) + NULLIFY(id%OOC_NB_FILES) + NULLIFY(id%CB_SON_SIZE) + NULLIFY(id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY(id%root%RHS_ROOT) + NULLIFY(id%root%RG2L_ROW) + NULLIFY(id%root%RG2L_COL) + NULLIFY(id%root%IPIV) + NULLIFY(id%root%SCHUR_POINTER) + NULLIFY(id%SCHUR_CINTERFACE) + id%NELT=0 + NULLIFY(id%ELTPTR) + NULLIFY(id%ELTVAR) + NULLIFY(id%A_ELT) + NULLIFY(id%ELTPROC) + id%SIZE_SCHUR = 0 + NULLIFY( id%LISTVAR_SCHUR ) + NULLIFY( id%SCHUR ) + id%NPROW = 0 + id%NPCOL = 0 + id%MBLOCK = 0 + id%NBLOCK = 0 + id%SCHUR_MLOC = 0 + id%SCHUR_NLOC = 0 + id%SCHUR_LLD = 0 + NULLIFY(id%ISTEP_TO_INIV2) + NULLIFY(id%I_AM_CAND) + NULLIFY(id%FUTURE_NIV2) + NULLIFY(id%TAB_POS_IN_PERE) + NULLIFY(id%CANDIDATES) + CALL SMUMPS_637(id) + NULLIFY(id%MEM_DIST) + NULLIFY(id%SUP_PROC) + id%Deficiency = 0 + id%root%LPIV = -1 + id%root%yes = .FALSE. + id%root%gridinit_done = .FALSE. + IF ( id%KEEP( 46 ) .ne. 0 .OR. + & id%MYID .ne. MASTER ) THEN + CALL MPI_COMM_RANK + & (id%COMM_NODES, id%MYID_NODES, IERR ) + ELSE + id%MYID_NODES = -464646 + ENDIF + RETURN + END SUBROUTINE SMUMPS_163 + SUBROUTINE SMUMPS_252( COMM_LOAD, ASS_IRECV, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, + & FILS, FRERE, DAD, MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER,PTRARW, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & + & NSTK_S,NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, JOBASS, ETATASS + & ) + USE SMUMPS_COMM_BUFFER + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mpif.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER IZERO + PARAMETER (IZERO=0) + INTEGER N,LIW,NSTEPS + INTEGER(8) LA, LRLU, LRLUS, IPTRLU, POSFAC + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & IWPOS, IWPOSCB, COMP + INTEGER JOBASS,ETATASS + LOGICAL SON_LEVEL2 + REAL A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER COMM, NBFIN, SLAVEF, MYID + INTEGER LPOOL, LEAF + INTEGER LBUFR, LBUFR_BYTES + INTEGER NBPROCFILS(KEEP(28)) + INTEGER NSTK_S(KEEP(28)),PROCNODE_STEPS(KEEP(28)) + INTEGER IPOOL( LPOOL ) + INTEGER BUFR( LBUFR ) + INTEGER IDUMMY(1) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(N), PTRAIW(N), ND(KEEP(28)), PERM(N), + & FILS(N), FRERE(KEEP(28)), DAD(KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)), + & PAMASTER(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR(max(1,KEEP(14))) + REAL DBLARR(max(1,KEEP(13))) + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + INTEGER LP, HS, HF + INTEGER NBPANELS_L, NBPANELS_U + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + INTEGER NFS4FATHER + INTEGER(8) NFRONT8, LAELL8, LAELL_REQ8 + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER LREQ_OOC + INTEGER(8) :: SIZFR + INTEGER SIZFI, NCB + INTEGER J1,J2 + INTEGER NCOLS, NROWS, LDA_SON + INTEGER(8) :: JJ2, ICT13 +#if defined(ALLOW_NON_INIT) + INTEGER(8) :: NUMROWS, JJ3, JJ8, APOS_ini +#endif + INTEGER NELIM,JJ,JJ1,J3, + & IBROT,IORG + INTEGER JPOS,ICT11 + INTEGER JK,IJROW,NBCOL,NUMORG,IOLDPS,J4 + INTEGER(8) IACHK, POSELT, LAPOS2, IACHK_ini + INTEGER(8) APOS, APOS2, APOS3, POSEL1, ICT12 + INTEGER AINPUT + INTEGER NSLAVES, NSLSON, NPIVS,NPIV_ANA,NPIV + INTEGER PTRCOL, ISLAVE, PDEST,LEVEL + INTEGER ISON_IN_PLACE + INTEGER ISON_TOP + INTEGER(8) SIZE_ISON_TOP8 + LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS, + & RISK_OF_SAME_POS_THIS_LINE, OMP_PARALLEL_FLAG + LOGICAL LEVEL1, NIV1 + INTEGER TROW_SIZE + INTEGER INDX, FIRST_INDEX, SHIFT_INDEX + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INCLUDE 'mumps_headers.h' + INTEGER NCBSON + LOGICAL SAME_PROC + INTRINSIC real + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INTEGER NELT, LPTRAR + EXTERNAL MUMPS_167 + LOGICAL MUMPS_167 + LOGICAL SSARBR + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + DOUBLE PRECISION FLOP1,FLOP1_EFF + EXTERNAL MUMPS_170 + LOGICAL MUMPS_170 + COMPRESSCB =.FALSE. + NELT = 1 + LPTRAR = N + NFS4FATHER = -1 + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + LEVEL = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (LEVEL.NE.1) THEN + write(6,*) 'Error1 in mpi51f_niv1 ' + CALL MUMPS_ABORT() + ENDIF + NSLAVES = 0 + HF = 6 + NSLAVES + KEEP(IXSZ) + IF (JOBASS.EQ.0) THEN + ETATASS= 0 + ELSE + ETATASS= 2 + IOLDPS = PTLUST_S(STEP(INODE)) + NFRONT = IW(IOLDPS + KEEP(IXSZ)) + NASS1 = iabs(IW(IOLDPS + 2 + KEEP(IXSZ))) + ICT11 = IOLDPS + HF - 1 + NFRONT + SSARBR=MUMPS_167(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + ENDDO + NUMSTK = 0 + IFSON = -IN + ISON = IFSON + IF (ISON .NE. 0) THEN + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + ISON = FRERE(STEP(ISON)) + ENDDO + ENDIF + GOTO 123 + ENDIF + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + ENDDO + NPIV_ANA=NUMORG + NSTEPS = NSTEPS + 1 + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + IF (ISON .NE. 0) THEN + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + NASS = NASS + IW(PIMASTER(STEP(ISON))+1+KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + ENDDO + ENDIF + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + NASS1 = NASS + NUMORG + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL SMUMPS_684( KEEP(50), NFRONT, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL SMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + ENDIF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + ENDIF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + ISON_TOP = -9999 + ISON_IN_PLACE = -9999 + SIZE_ISON_TOP8 = 0_8 + IF (KEEP(234).NE.0) THEN + IF ( IWPOSCB .NE. LIW ) THEN + IF ( IWPOSCB+IW(IWPOSCB+1+XXI).NE.LIW) THEN + ISON = IW( IWPOSCB + 1 + XXN ) + IF ( DAD( STEP( ISON ) ) .EQ. INODE .AND. + & MUMPS_330(PROCNODE_STEPS(STEP(ISON)),SLAVEF) + & .EQ. 1 ) + & THEN + ISON_TOP = ISON + CALL MUMPS_729(SIZE_ISON_TOP8,IW(IWPOSCB + 1 + XXR)) + IF (LRLU .LT. int(NFRONT,8) * int(NFRONT,8)) THEN + ISON_IN_PLACE = ISON + ENDIF + END IF + END IF + END IF + END IF + NIV1 = .TRUE. + IF (KEEP(50).EQ.0 .AND. KEEP(234) .EQ. 0) THEN + CALL MUMPS_81(MYID, INODE, N, IOLDPS, HF, NFRONT, + & NFRONT_EFF, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP, KEEP8, IFLAG, + & PROCNODE_STEPS, SLAVEF ) + ELSE + CALL MUMPS_86( MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP, KEEP8, IFLAG, + & ISON_IN_PLACE, + & PROCNODE_STEPS, SLAVEF) + IF (IFLAG.LT.0) GOTO 300 + ENDIF + IF (NFRONT_EFF.NE.NFRONT) THEN + IF (NFRONT.GT.NFRONT_EFF) THEN + IF(MUMPS_170(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF))THEN + NPIV=NASS1-(NFRONT_EFF-ND(STEP(INODE))) + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1) + NPIV=NPIV_ANA + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1_EFF) + CALL SMUMPS_190(0,.FALSE.,FLOP1-FLOP1_EFF, + & KEEP,KEEP8) + ENDIF + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) ' ERROR 1 during ass_niv1', NFRONT, NFRONT_EFF + GOTO 270 + ENDIF + ENDIF + NFRONT8=int(NFRONT,8) + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL SMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + NCB = NFRONT - NASS1 + MAXFRW = max0(MAXFRW, NFRONT) + ICT11 = IOLDPS + HF - 1 + NFRONT + LAELL8 = NFRONT8 * NFRONT8 + LAELL_REQ8 = LAELL8 + IF ( ISON_IN_PLACE > 0 ) THEN + LAELL_REQ8 = LAELL8 - SIZE_ISON_TOP8 + ENDIF + IF (LRLU .LT. LAELL_REQ8) THEN + IF (LRLUS .LT. LAELL_REQ8) THEN + GOTO 280 + ELSE + CALL SMUMPS_94 + & (N, KEEP(28), IW, LIW, A, LA, LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, STEP, PIMASTER, + & PAMASTER,KEEP(216),LRLUS,KEEP(IXSZ)) + COMP = COMP + 1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + ENDIF + ENDIF + ENDIF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + SIZE_ISON_TOP8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + POSFAC = POSFAC + LAELL8 + SSARBR=MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + CALL SMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS, + & 0_8, + & LAELL8-SIZE_ISON_TOP8, + & KEEP,KEEP8, + & LRLU) +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = min(POSELT + LAELL8 - 1_8, IPTRLU) + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. NFRONT .LT. KEEP(63) ) THEN + LAPOS2 = min(POSELT + LAELL8 - 1_8, IPTRLU) + DO JJ8 = POSELT, LAPOS2 + A( JJ8 ) = ZERO + ENDDO + ELSE + IF (ETATASS.EQ.1) THEN + APOS_ini = POSELT + DO JJ8 = 0_8, NFRONT8 - 1_8 + JJ3 = min(JJ8,int(NASS1-1,8)) + APOS = APOS_ini + JJ8 * NFRONT8 + A(APOS:APOS+JJ3) = ZERO + END DO + ELSE + APOS_ini = POSELT + NUMROWS = min(NFRONT8, (IPTRLU-APOS_ini) / NFRONT8 ) + DO JJ8 = 0_8, NUMROWS - 1_8 + APOS = APOS_ini + JJ8 * NFRONT8 + A(APOS:APOS + JJ8) = ZERO + ENDDO + IF( NUMROWS .LT. NFRONT8 ) THEN + APOS = APOS_ini + NFRONT8*NUMROWS + A(APOS : min(IPTRLU,APOS+NUMROWS)) = ZERO + ENDIF + ENDIF + END IF +#endif + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + IW(IOLDPS + KEEP(IXSZ)) = NFRONT + IW(IOLDPS + KEEP(IXSZ) + 1) = 0 + IW(IOLDPS + KEEP(IXSZ) + 2) = -NASS1 + IW(IOLDPS + KEEP(IXSZ) + 3) = -NASS1 + IW(IOLDPS + KEEP(IXSZ) + 4) = STEP(INODE) + IW(IOLDPS + KEEP(IXSZ) + 5) = NSLAVES + 123 CONTINUE + IF (NUMSTK.NE.0) THEN + IF (ISON_TOP > 0) THEN + ISON = ISON_TOP + ELSE + ISON = IFSON + ENDIF + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NELIM = IW(ISTCHK + KEEP(IXSZ) + 1) + NPIVS = IW(ISTCHK + KEEP(IXSZ) + 3) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + HS = 6 + KEEP(IXSZ) + NSLSON + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + LEVEL1 = NSLSON.EQ.0 + IF (.NOT.SAME_PROC) THEN + NROWS = IW( ISTCHK + KEEP(IXSZ) + 2) + ELSE + NROWS = NCOLS + ENDIF + SIZFI = HS + NROWS + NCOLS + J1 = ISTCHK + HS + NROWS + NPIVS + IF ( .NOT. LEVEL1 .AND. NELIM.EQ.0 ) GOTO 205 + IF (LEVEL1) THEN + J2 = J1 + LSTK - 1 + SIZFR = int(LSTK,8)*int(LSTK,8) + IF (COMPRESSCB) SIZFR = (int(LSTK,8)*int(LSTK+1,8))/2_8 + ELSE + IF ( KEEP(50).eq.0 ) THEN + SIZFR = int(NELIM,8) * int(LSTK,8) + ELSE + SIZFR = int(NELIM,8) * int(NELIM,8) + END IF + J2 = J1 + NELIM - 1 + ENDIF + IF (JOBASS.EQ.0) OPASSW = OPASSW + dble(SIZFR) + IACHK = PAMASTER(STEP(ISON)) + IF ( KEEP(50) .eq. 0 ) THEN + POSEL1 = PTRAST(STEP(INODE)) - NFRONT8 + IF (NFRONT .EQ. LSTK.AND. ISON.EQ.ISON_IN_PLACE + & .AND.IACHK + SIZFR - 1_8 .EQ. POSFAC - 1_8 ) THEN + GOTO 205 + ENDIF + IF (J2.GE.J1) THEN + RESET_TO_ZERO = (IACHK .LT. POSFAC) + RISK_OF_SAME_POS = IACHK + SIZFR - 1_8 .EQ. POSFAC - 1_8 + RISK_OF_SAME_POS_THIS_LINE = .FALSE. + IACHK_ini = IACHK + OMP_PARALLEL_FLAG = (RESET_TO_ZERO.EQV..FALSE.).AND. + & ((J2-J1).GT.300) + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * int(NFRONT,8) + IACHK = IACHK_ini + int(JJ-J1,8)*int(LSTK,8) + IF (RISK_OF_SAME_POS) THEN + IF (JJ.EQ.J2) THEN + RISK_OF_SAME_POS_THIS_LINE = + & (ISON .EQ. ISON_IN_PLACE) + & .AND. ( APOS + int(IW(J1+LSTK-1)-1,8).EQ. + & IACHK+int(LSTK-1,8) ) + ENDIF + ENDIF + IF ((IACHK .GE. POSFAC).AND.(JJ>J1))THEN + RESET_TO_ZERO =.FALSE. + ENDIF + IF (RESET_TO_ZERO) THEN + IF (RISK_OF_SAME_POS_THIS_LINE) THEN + DO JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + IF ( IACHK+int(JJ1-1,8) .NE. JJ2 ) THEN + A(JJ2) = A(IACHK + int(JJ1 - 1,8)) + A(IACHK + int(JJ1 -1,8)) = ZERO + ENDIF + ENDDO + ELSE + DO JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1+JJ1-1),8) - 1_8 + A(JJ2) = A(IACHK + int(JJ1 - 1,8)) + A(IACHK + int(JJ1 -1,8)) = ZERO + ENDDO + ENDIF + ELSE + DO JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1+JJ1-1),8) - 1_8 + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8)) + ENDDO + ENDIF + 170 CONTINUE + END IF + ELSE + IF (LEVEL1) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = SIZFR + ELSE + LCB = int(LDA_SON,8)* int(J2-J1+1,8) + ENDIF + CALL SMUMPS_178(A, LA, + & PTRAST(STEP( INODE )), NFRONT, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), J2 - J1 + 1, NELIM, ETATASS, + & COMPRESSCB, (ISON.EQ.ISON_IN_PLACE) + & ) + ENDIF + 205 IF (LEVEL1) THEN + IF (SAME_PROC) ISTCHK = PTRIST(STEP(ISON)) + IF ((SAME_PROC).AND.ETATASS.NE.1) THEN + IF (KEEP(50).NE.0) THEN + J2 = J1 + LSTK - 1 + DO JJ = J1, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + ELSE + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM + DO JJ = J3, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + IF (NELIM .NE. 0) THEN + J3 = J3 - 1 + DO JJ = J1, J3 + JPOS = IW(JJ) + ICT11 + IW(JJ) = IW(JPOS) + ENDDO + ENDIF + ENDIF + ENDIF + IF (ETATASS.NE.1) THEN + IF ( SAME_PROC ) THEN + PTRIST(STEP(ISON)) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL SMUMPS_152(SSARBR, MYID, N, ISTCHK, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, + & (ISON .EQ. ISON_TOP) + & ) + ENDIF + ELSE + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP, KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL SMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, IDUMMY, + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, + & LEAF, NBFIN, ICNTL, KEEP, KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + ENDDO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL SMUMPS_71( + & INODE, NFRONT, NASS1, NFS4FATHER, + & ISON, MYID, + & IZERO, IDUMMY, IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, + & KEEP, KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( + & COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP, KEEP8, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + IF (ISON .LE. 0) THEN + ISON = IFSON + ENDIF + 220 CONTINUE + END IF + IF (ETATASS.EQ.2) GOTO 500 + POSELT = PTRAST(STEP(INODE)) + IBROT = INODE + DO 260 IORG = 1, NUMORG + JK = PTRAIW(IBROT) + AINPUT = PTRARW(IBROT) + JJ = JK + 1 + J1 = JJ + 1 + J2 = J1 + INTARR(JK) + J3 = J2 + 1 + J4 = J2 - INTARR(JJ) + IJROW = INTARR(J1) + ICT12 = POSELT + int(IJROW - NFRONT - 1,8) +Cduplicates --> CVD$ DEPCHK + DO 240 JJ = J1, J2 + APOS2 = ICT12 + int(INTARR(JJ),8) * NFRONT8 + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + 1 + 240 CONTINUE + IF (J3 .LE. J4) THEN + ICT13 = POSELT + int(IJROW - 1,8) * NFRONT8 + NBCOL = J4 - J3 + 1 +Cduplicates--> CVD$ DEPCHK +CduplicatesCVD$ NODEPCHK + DO 250 JJ = 1, NBCOL + APOS3 = ICT13 + int(INTARR(J3 + JJ - 1) - 1,8) + A(APOS3) = A(APOS3) + DBLARR(AINPUT + JJ - 1) + 250 CONTINUE + ENDIF + IF (KEEP(50).EQ.0) THEN + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(IJROW-1,8) * NFRONT8 + + & int(NFRONT-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ELSE + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(NFRONT-KEEP(253)+JJ-1,8) * NFRONT8 + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + 260 CONTINUE + GOTO 500 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER ALLOCATION DURING SMUMPS_252' + ENDIF + GOTO 490 + 280 CONTINUE + IFLAG = -9 + CALL MUMPS_731(LAELL_REQ8 - LRLUS, IERROR) + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, WORKSPACE TOO SMALL DURING SMUMPS_252' + ENDIF + GOTO 490 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, SEND BUFFER TOO SMALL DURING SMUMPS_252' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, SEND BUFFER TOO SMALL DURING SMUMPS_252' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING SMUMPS_252' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 1 + 490 CALL SMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE SMUMPS_252 + SUBROUTINE SMUMPS_253(COMM_LOAD, ASS_IRECV, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, FILS, FRERE, DAD, + & CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_S, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP, KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, LEAF, IPOOL, LPOOL, + & PERM , MEM_DISTRIB) + USE SMUMPS_COMM_BUFFER + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N,LIW,NSTEPS, NBFIN + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & LPOOL, LEAF, IWPOS, IWPOSCB, COMP + INTEGER(8) :: LRLUS, LRLU, IPTRLU, POSFAC + REAL A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER COMM, SLAVEF, MYID, LBUFR, LBUFR_BYTES + INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB + INTEGER IPOOL(LPOOL) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(N), PTRAIW(N), ND(KEEP(28)), + & FILS(N), FRERE(KEEP(28)), DAD (KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), + & PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), PERM(N) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER CAND(SLAVEF+1, max(1,KEEP(56))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER NBPROCFILS(KEEP(28)), + & PROCNODE_STEPS(KEEP(28)), BUFR(LBUFR) + INTEGER INTARR(max(1,KEEP(14))) + REAL DBLARR(max(1,KEEP(13))) + INTEGER LP, HS, HF, HF_OLD,NCBSON, NSLAVES_OLD, + & NBSPLIT + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + INTEGER NFS4FATHER,I + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER(8) :: LAELL8 + INTEGER LREQ_OOC + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + INTEGER NCB + INTEGER J1,J2,J3,MP + INTEGER(8) :: JJ8, LAPOS2, JJ2, JJ3 + INTEGER NELIM,JJ,JJ1,NPIVS,NCOLS,NROWS, + & IBROT,IORG + INTEGER LDAFS, LDA_SON + INTEGER JK,IJROW,NBCOL,NUMORG,IOLDPS,J4, NUMORG_SPLIT + INTEGER(8) :: ICT13 + INTEGER(8) :: IACHK, APOS, APOS2, POSELT, ICT12, POSEL1 + INTEGER AINPUT + INTEGER NSLAVES, NSLSON + INTEGER NBLIG, PTRCOL, PTRROW, ISLAVE, PDEST + INTEGER PDEST1(1) + INTEGER TYPESPLIT + INTEGER ISON_IN_PLACE + LOGICAL IS_ofType5or6 + LOGICAL SAME_PROC, NIV1, SON_LEVEL2 + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX + INTEGER IZERO + INTEGER IDUMMY(1) + PARAMETER( IZERO = 0 ) + INTEGER MUMPS_275, MUMPS_330, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, MUMPS_810 + REAL ZERO + REAL RZERO + PARAMETER(RZERO = 0.0E0 ) + PARAMETER( ZERO = 0.0E0 ) + INTEGER NELT, LPTRAR, NCBSON_MAX + logical :: force_cand + INTEGER ETATASS + INCLUDE 'mumps_headers.h' + INTEGER (8) :: APOSMAX + REAL MAXARR + INTEGER INIV2, SIZE_TMP_SLAVES_LIST, allocok, + & NCB_SPLIT, SIZE_LIST_SPLIT + INTEGER, ALLOCATABLE, DIMENSION(:) :: TMP_SLAVES_LIST, COPY_CAND + INTEGER NBPANELS_L, NBPANELS_U + MP = ICNTL(2) + IS_ofType5or6 = .FALSE. + COMPRESSCB = .FALSE. + ETATASS = 0 + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + NSTEPS = NSTEPS + 1 + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + ENDDO + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + NCBSON_MAX = 0 + NELT = 1 + LPTRAR = 1 + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + IF ( KEEP(48)==5 .AND. + & MUMPS_330(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) .EQ. 1) THEN + NCBSON_MAX = max + & ( + & IW(PIMASTER(STEP(ISON))+KEEP(IXSZ)), NCBSON_MAX + & ) + ENDIF + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + ENDDO + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + NASS1 = NASS + NUMORG + NCB = NFRONT - NASS1 + if((KEEP(24).eq.0).or.(KEEP(24).eq.1)) then + force_cand=.FALSE. + else + force_cand=(mod(KEEP(24),2).eq.0) + end if + IF (force_cand) THEN + INIV2 = ISTEP_TO_INIV2( STEP( INODE )) + SIZE_TMP_SLAVES_LIST = CAND( SLAVEF+1, INIV2 ) + ELSE + INIV2 = 1 + SIZE_TMP_SLAVES_LIST = SLAVEF - 1 + ENDIF + ALLOCATE(TMP_SLAVES_LIST(SIZE_TMP_SLAVES_LIST),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + TYPESPLIT = MUMPS_810 (PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IS_ofType5or6 = (TYPESPLIT.EQ.5 .OR. TYPESPLIT.EQ.6) + IF ( (TYPESPLIT.EQ.4) + & .OR.(TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) + & ) THEN + IF (TYPESPLIT.EQ.4) THEN + ALLOCATE(COPY_CAND(SLAVEF+1),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + CALL SMUMPS_791 ( + & INODE, STEP, N, SLAVEF, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & CAND(1,INIV2), ICNTL, COPY_CAND, + & NBSPLIT, NUMORG_SPLIT, TMP_SLAVES_LIST(1), + & SIZE_TMP_SLAVES_LIST + & ) + NCB_SPLIT = NCB-NUMORG_SPLIT + SIZE_LIST_SPLIT = SIZE_TMP_SLAVES_LIST - NBSPLIT + CALL SMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, COPY_CAND, + & MEM_DISTRIB(0), NCB_SPLIT, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST(NBSPLIT+1), + & SIZE_LIST_SPLIT,INODE ) + DEALLOCATE (COPY_CAND) + CALL SMUMPS_790 ( + & INODE, STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, + & TAB_POS_IN_PERE(1,INIV2), + & NSLAVES + & ) + ELSE + ISTCHK = PIMASTER(STEP(IFSON)) + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + TMP_SLAVES_LIST (1:SIZE_TMP_SLAVES_LIST) + & = CAND (1:SIZE_TMP_SLAVES_LIST, INIV2) + CALL SMUMPS_792 ( + & INODE, TYPESPLIT, IFSON, + & IW(PDEST), NSLSON, + & STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, ISTEP_TO_INIV2, INIV2, + & TAB_POS_IN_PERE, NSLAVES, + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST + & ) + ENDIF + ELSE + CALL SMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL SMUMPS_684(KEEP(50), NASS1, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL SMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, + & KEEP(216),LRLUS,KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + ENDIF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + ENDIF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + NIV1 = .FALSE. + IF (KEEP(50).EQ.0 .AND. KEEP(234).EQ.0) THEN + CALL MUMPS_81(MYID, INODE, N, IOLDPS, HF, NFRONT, + & NFRONT_EFF, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG, + & PROCNODE_STEPS, SLAVEF ) + ELSE + ISON_IN_PLACE = -9999 + CALL MUMPS_86( MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG, + & ISON_IN_PLACE, + & PROCNODE_STEPS, SLAVEF) + IF (IFLAG.LT.0) GOTO 250 + ENDIF + IF ( NFRONT .NE. NFRONT_EFF ) THEN + IF ( + & (TYPESPLIT.EQ.5) .OR. (TYPESPLIT.EQ.6) ) THEN + WRITE(6,*) ' Internal error 1 in fac_ass due to plitting ', + & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ENDIF + IF (NFRONT.GT.NFRONT_EFF) THEN + NCB = NFRONT_EFF - NASS1 + NSLAVES_OLD = NSLAVES + HF_OLD = HF + IF (TYPESPLIT.EQ.4) THEN + WRITE(6,*) ' Internal error 2 in fac_ass due', + & ' to splitting ', + & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ELSE + CALL SMUMPS_472( NCBSON_MAX, + & SLAVEF, KEEP,KEEP8, ICNTL, + & CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT_EFF, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) - + & (NSLAVES_OLD - NSLAVES) + IF (NSLAVES_OLD .NE. NSLAVES) THEN + IF (NSLAVES_OLD > NSLAVES) THEN + DO JJ=0,2*NFRONT_EFF-1 + IW(IOLDPS+HF+JJ)=IW(IOLDPS+HF_OLD+JJ) + ENDDO + ELSE + IF (IWPOS - 1 > IWPOSCB ) GOTO 270 + DO JJ=2*NFRONT_EFF-1, 0, -1 + IW(IOLDPS+HF+JJ) = IW(IOLDPS+HF_OLD+JJ) + ENDDO + END IF + END IF + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) MYID,': ERROR 2 during ass_niv2, INODE=', INODE, + & ' NFRONT, NFRONT_EFF=', NFRONT, NFRONT_EFF + GOTO 270 + ENDIF + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL SMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + MAXFRW = max0(MAXFRW, NFRONT) + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS + 1+KEEP(IXSZ)) = 0 + IW(IOLDPS + 2+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 3+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) + IW(IOLDPS+KEEP(IXSZ)) = NFRONT + IW(IOLDPS+5+KEEP(IXSZ)) = NSLAVES + IW(IOLDPS+6+KEEP(IXSZ):IOLDPS+5+KEEP(IXSZ)+NSLAVES)= + & TMP_SLAVES_LIST(1:NSLAVES) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + IF ( KEEP(73) .EQ. 0 ) THEN +#endif +#endif + CALL SMUMPS_461(MYID, SLAVEF, COMM_LOAD, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, IW(IOLDPS+6+KEEP(IXSZ)), NSLAVES,INODE) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + ENDIF +#endif +#endif + IF(KEEP(86).EQ.1)THEN + IF(mod(KEEP(24),2).eq.0)THEN + CALL SMUMPS_533(SLAVEF,CAND(SLAVEF+1,INIV2), + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE) + ELSEIF((KEEP(24).EQ.0).OR.(KEEP(24).EQ.1))THEN + CALL SMUMPS_533(SLAVEF,SLAVEF-1, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE) + ENDIF + ENDIF + DEALLOCATE(TMP_SLAVES_LIST) + IF (KEEP(50).EQ.0) THEN + LAELL8 = int(NASS1,8) * int(NFRONT,8) + LDAFS = NFRONT + ELSE + LAELL8 = int(NASS1,8)*int(NASS1,8) + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) + & LAELL8 = LAELL8+int(NASS1,8) + LDAFS = NASS1 + ENDIF + IF (LRLU .LT. LAELL8) THEN + IF (LRLUS .LT. LAELL8) THEN + GOTO 280 + ELSE + CALL SMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + ENDIF + ENDIF + ENDIF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + POSFAC = POSFAC + LAELL8 + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + CALL SMUMPS_471(.FALSE.,.FALSE.,LA-LRLUS,0_8,LAELL8, + & KEEP,KEEP8,LRLU) + POSEL1 = POSELT - int(LDAFS,8) +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. LDAFS .lt. KEEP(63) ) THEN + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO + ELSE + APOS = POSELT + DO JJ8 = 0_8, int(LDAFS-1,8) + A(APOS:APOS+JJ8) = ZERO + APOS = APOS + int(LDAFS,8) + END DO + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + A(APOS:APOS+int(LDAFS,8)-1_8)=ZERO + ENDIF + END IF +#endif + IF ((NUMSTK.NE.0).AND.(NASS.NE.0)) THEN + ISON = IFSON + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + IF (NELIM.EQ.0) GOTO 210 + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS=0 + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + 2+KEEP(IXSZ)) + ELSE + NROWS = NCOLS + ENDIF + OPASSW = OPASSW + dble(NELIM*LSTK) + J1 = ISTCHK + HS + NROWS + NPIVS + J2 = J1 + NELIM - 1 + IACHK = PAMASTER(STEP(ISON)) + IF (KEEP(50).eq.0) THEN + IF (IS_ofType5or6) THEN + APOS = POSELT + DO JJ8 = 1_8, int(NELIM,8)*int(LSTK,8) + A(APOS+JJ8-1_8) = A(APOS+JJ8-1_8) + A(IACHK+JJ8-1_8) + ENDDO + ELSE + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * int(LDAFS,8) + DO 160 JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1),8) - 1_8 + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8)) + 160 CONTINUE + IACHK = IACHK + int(LSTK,8) + 170 CONTINUE + ENDIF + ELSE + IF (NSLSON.EQ.0) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = (int(NELIM,8)*int(NELIM+1,8))/2_8 + ELSE + LCB = int(LDA_SON,8)*int(NELIM,8) + ENDIF + CALL SMUMPS_178( A, LA, + & POSELT, LDAFS, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), NELIM, NELIM, ETATASS, + & COMPRESSCB, + & .FALSE. + & ) + ENDIF + 210 ISON = FRERE(STEP(ISON)) + 220 CONTINUE + ENDIF + IBROT = INODE + APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8) + DO 260 IORG = 1, NUMORG + JK = PTRAIW(IBROT) + AINPUT = PTRARW(IBROT) + JJ = JK + 1 + J1 = JJ + 1 + J2 = J1 + INTARR(JK) + J3 = J2 + 1 + J4 = J2 - INTARR(JJ) + IJROW = INTARR(J1) + ICT12 = POSELT + int(IJROW - 1 - LDAFS, 8) + MAXARR = RZERO +CduplicatesCVD$ NODEPCHK + DO 240 JJ = J1, J2 + IF (KEEP(219).NE.0) THEN + IF (INTARR(JJ).LE.NASS1) THEN + APOS2 = ICT12 + int(INTARR(JJ),8) * int(LDAFS,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + ELSEIF (KEEP(50).EQ.2) THEN + MAXARR = max(MAXARR,abs(DBLARR(AINPUT))) + ENDIF + ELSE + IF (INTARR(JJ).LE.NASS1) THEN + APOS2 = ICT12 + int(INTARR(JJ),8) * int(LDAFS,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + ENDIF + ENDIF + AINPUT = AINPUT + 1 + 240 CONTINUE + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN + A(APOSMAX+int(IJROW-1,8)) = MAXARR + ENDIF + IF (J3 .GT. J4) GOTO 255 + ICT13 = POSELT + int(IJROW - 1,8) * int(LDAFS,8) + NBCOL = J4 - J3 + 1 +CduplicatesCVD$ NODEPCHK +CduplicatesCVD$ NODEPCHK + DO JJ = 1, NBCOL + JJ3 = ICT13 + int(INTARR(J3 + JJ - 1),8) - 1_8 + A(JJ3) = A(JJ3) + DBLARR(AINPUT + JJ - 1) + ENDDO + 255 CONTINUE + IF (KEEP(50).EQ.0) THEN + DO JJ = 1, KEEP(253) + APOS = POSELT + + & int(IJROW-1,8) * int(LDAFS,8) + + & int(LDAFS-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + 260 CONTINUE + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + PDEST = IOLDPS + 6 + KEEP(IXSZ) + DO ISLAVE = 1, NSLAVES + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB, + & NSLAVES, + & NBLIG, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + IERR = -1 + DO WHILE (IERR .EQ.-1) + IF ( KEEP(50) .eq. 0 ) THEN + NBCOL = NFRONT + CALL SMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & IZERO, IDUMMY, + & IW(PDEST), NFRONT, COMM, IERR) + ELSE + NBCOL = NASS1+SHIFT_INDEX+NBLIG + CALL SMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & NSLAVES-ISLAVE, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE), + & IW(PDEST), NFRONT, COMM, IERR) + ENDIF + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + IF (MESSAGE_RECEIVED) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + SHIFT_INDEX + ENDIF + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 300 + IF (IERR .EQ. -3) GOTO 305 + PTRROW = PTRROW + NBLIG + PDEST = PDEST + 1 + ENDDO + IF (NUMSTK.EQ.0) GOTO 500 + ISON = IFSON + DO IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + 2+KEEP(IXSZ)) + ELSE + NROWS = NCOLS + ENDIF + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + IF (KEEP(219).NE.0) THEN + IF(KEEP(50) .EQ. 2) THEN + NFS4FATHER = NCBSON + DO I=0,NCBSON-1 + IF(IW(PTRCOL+I) .GT. NASS1) THEN + NFS4FATHER = I + EXIT + ENDIF + ENDDO + NFS4FATHER = NFS4FATHER+NELIM + ELSE + NFS4FATHER = 0 + ENDIF + ELSE + NFS4FATHER = 0 + ENDIF + IF (NSLSON.EQ.0) THEN + NSLSON = 1 + PDEST1(1) = MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) + IF (PDEST1(1).EQ.MYID) THEN + CALL SMUMPS_211( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)), + & NFRONT, NASS1, NFS4FATHER, NCBSON, + & IW( PTRCOL ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, IW, IW, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ELSE + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON))+HS+NROWS+NPIVS+NELIM + CALL SMUMPS_71( + & INODE, NFRONT,NASS1,NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ) ), + & IW(PTRCOL), NCBSON, + & COMM, IERR, PDEST1, NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ELSE + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL SMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, LPTRAR, NELT, IW, + & IW, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + ENDDO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL SMUMPS_71( + & INODE, NFRONT,NASS1, NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW(PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + ENDDO + GOTO 500 + 250 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING + & SMUMPS_253' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 1 + GOTO 490 + 265 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE ALLOCATING TMP_SLAVES_LIST', + & ' DURING SMUMPS_253' + ENDIF + IFLAG = -13 + IERROR = SIZE_TMP_SLAVES_LIST + GOTO 490 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER ALLOCATION DURING SMUMPS_253' + ENDIF + GOTO 490 + 280 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, WORKSPACE TOO SMALL DURING SMUMPS_253' + ENDIF + IFLAG = -9 + CALL MUMPS_731(LAELL8-LRLUS, IERROR) + GOTO 490 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SEND BUFFER TOO SMALL (1) DURING SMUMPS_253' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECV BUFFER TOO SMALL (1) DURING SMUMPS_253' + ENDIF + IFLAG = -20 + LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SEND BUFFER TOO SMALL (2) DURING SMUMPS_253' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 305 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECV BUFFER TOO SMALL (2) DURING SMUMPS_253' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + 490 CALL SMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE SMUMPS_253 + SUBROUTINE SMUMPS_39(N, INODE, IW, LIW, A, LA, + & ISON, NBROWS, NBCOLS, ROWLIST, + & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER, + & OPASSW, IWPOSCB, MYID, KEEP,KEEP8, IS_ofType5or6, + & LDA_VALSON ) + USE SMUMPS_LOAD + IMPLICIT NONE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA + INTEGER N,LIW,MYID + INTEGER INODE,ISON, IWPOSCB + INTEGER NBROWS, NBCOLS, LDA_VALSON + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER IW(LIW), STEP(N), PIMASTER(KEEP(28)), + & PTLUST_S(KEEP(28)), ROWLIST(NBROWS) + REAL A(LA), VALSON(LDA_VALSON,NBROWS) + DOUBLE PRECISION OPASSW + LOGICAL, INTENT(IN) :: IS_ofType5or6 + INTEGER(8) :: POSELT, POSEL1, APOS, JJ2 + INTEGER HF,HS, NSLAVES, NFRONT, NASS1, + & IOLDPS, ISTCHK, LSTK, NSLSON,NELIM, + & NPIVS,NCOLS,J1,JJ,JJ1,NROWS, + & LDAFS_PERE, IBEG, DIAG + INCLUDE 'mumps_headers.h' + LOGICAL SAME_PROC + INTRINSIC real + IOLDPS = PTLUST_S(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS1 = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + IF (KEEP(50).EQ.0) THEN + LDAFS_PERE = NFRONT + ELSE + IF ( NSLAVES .eq. 0 ) THEN + LDAFS_PERE = NFRONT + ELSE + LDAFS_PERE = NASS1 + ENDIF + ENDIF + HF = 6 + NSLAVES + KEEP(IXSZ) + POSEL1 = POSELT - int(LDAFS_PERE,8) + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + OPASSW = OPASSW + dble(NBROWS*NBCOLS) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LT.IWPOSCB) + IF (SAME_PROC) THEN + NROWS = NCOLS + ELSE + NROWS = IW(ISTCHK+2+KEEP(IXSZ)) + ENDIF + J1 = ISTCHK + NROWS + HS + NPIVS + IF (KEEP(50).EQ.0) THEN + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(LDAFS_PERE,8) + DO JJ = 1, NBROWS + DO JJ1 = 1, NBCOLS + JJ2 = APOS + int(JJ1-1,8) + A(JJ2)=A(JJ2)+VALSON(JJ1,JJ) + ENDDO + APOS = APOS + int(LDAFS_PERE,8) + ENDDO + ELSE + DO 170 JJ = 1, NBROWS + APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8) + DO 160 JJ1 = 1, NBCOLS + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + 160 CONTINUE + 170 CONTINUE + ENDIF + ELSE + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(LDAFS_PERE,8) + DIAG = ROWLIST(1) + DO JJ = 1, NBROWS + DO JJ1 = 1, DIAG + JJ2 = APOS+int(JJ1-1,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + ENDDO + DIAG = DIAG+1 + APOS = APOS + int(LDAFS_PERE,8) + ENDDO + ELSE + DO JJ = 1, NBROWS + IF (ROWLIST(JJ).LE.NASS1.and..NOT.IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(JJ) - 1,8) + DO JJ1 = 1, NELIM + JJ2 = APOS + int(IW(J1+JJ1-1),8)*int(LDAFS_PERE,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + ENDDO + IBEG = NELIM+1 + ELSE + IBEG = 1 + ENDIF + APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8) + DO JJ1 = IBEG, NBCOLS + IF (ROWLIST(JJ).LT.IW(J1 + JJ1 - 1)) EXIT + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + ENDDO + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_39 + SUBROUTINE SMUMPS_539 + & (N, INODE, IW, LIW, A, LA, + & NBROWS, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, + & RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, MYID) + IMPLICIT NONE + INTEGER N,LIW + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER INODE, MYID + INTEGER NBROWS, NBCOLS + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), + & PTRIST(KEEP(28)), FILS(N), PTRARW(N), PTRAIW(N) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + REAL A(LA), + & DBLARR(max(1,KEEP(13))) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER(8) :: POSELT, ICT12, APOS + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & K1,K2,K,J,JPOS,NASS,JJ, + & IN,AINPUT,JK,J1,J2,IJROW, ILOC + INTEGER :: K1RHS, K2RHS, JFirstRHS + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INCLUDE 'mumps_headers.h' + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NASS = IW(IOLDPS+1+KEEP(IXSZ)) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES + KEEP(IXSZ) + IF (NASS.LT.0) THEN + NASS = -NASS + IW(IOLDPS+1+KEEP(IXSZ)) = NASS + A(POSELT:POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8) = + & ZERO + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NASS - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -JPOS + JPOS = JPOS + 1 + ENDDO + K1 = IOLDPS + HF + K2 = K1 + NBROWF - 1 + JPOS = 1 + IF ((KEEP(253).GT.0).AND.(KEEP(50).NE.0)) THEN + K1RHS = 0 + K2RHS = -1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + IF ((K1RHS.EQ.0).AND.(J.GT.N)) THEN + K1RHS = K + JFirstRHS=J-N + ENDIF + JPOS = JPOS + 1 + ENDDO + IF (K1RHS.GT.0) K2RHS=K2 + IF ( K2RHS.GE.K1RHS ) THEN + IN = INODE + DO WHILE (IN.GT.0) + IJROW = -ITLOC(IN) + DO K = K1RHS, K2RHS + J = IW(K) + ILOC = ITLOC(J) + APOS = POSELT+int(ILOC-1,8)*int(NBCOLF,8) + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( + & (JFirstRHS+(K-K1RHS)-1)*KEEP(254)+IN) + ENDDO + IN = FILS(IN) + ENDDO + ENDIF + ELSE + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + JPOS = JPOS + 1 + ENDDO + ENDIF + IN = INODE + DO WHILE (IN.GT.0) + AINPUT = PTRARW(IN) + JK = PTRAIW(IN) + JJ = JK + 1 + J1 = JJ + 1 + J2 = J1 + INTARR(JK) + IJROW = -ITLOC(INTARR(J1)) + ICT12 = POSELT +int(- NBCOLF + IJROW - 1,8) + DO JJ= J1,J2 + ILOC = ITLOC(INTARR(JJ)) + IF (ILOC.GT.0) THEN + APOS = ICT12 + int(ILOC,8)*int(NBCOLF,8) + A(APOS) = A(APOS) + DBLARR(AINPUT) + ENDIF + AINPUT = AINPUT + 1 + ENDDO + IN = FILS(IN) + ENDDO + K1 = IOLDPS + HF + K2 = K1 + NBROWF + NASS - 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = 0 + ENDDO + ENDIF + IF (NBROWS.GT.0) THEN + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + JPOS = JPOS + 1 + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_539 + SUBROUTINE SMUMPS_531 + & (N, INODE, IW, LIW, NBROWS, STEP, PTRIST, + & ITLOC, RHS_MUMPS, KEEP,KEEP8) + IMPLICIT NONE + INTEGER N, LIW + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER INODE + INTEGER NBROWS + INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), + & PTRIST(KEEP(28)) + REAL :: RHS_MUMPS(KEEP(255)) + INCLUDE 'mumps_headers.h' + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & K1,K2,K,J + IOLDPS = PTRIST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + IF (NBROWS.GT.0) THEN + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = 0 + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_531 + SUBROUTINE SMUMPS_40(N, INODE, IW, LIW, A, LA, + & NBROWS, NBCOLS, ROWLIST, COLLIST, VALSON, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, + & RHS_MUMPS, FILS, + & ICNTL, KEEP,KEEP8, MYID, IS_ofType5or6, LDA_VALSON) + IMPLICIT NONE + INTEGER N,LIW + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER INODE, MYID + LOGICAL, intent(in) :: IS_ofType5or6 + INTEGER NBROWS, NBCOLS, LDA_VALSON + INTEGER ROWLIST(NBROWS), COLLIST(NBCOLS) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), + & PTRIST(KEEP(28)), FILS(N) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRAST(KEEP(28)) + REAL A(LA), VALSON(LDA_VALSON,NBROWS) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER(8) :: POSEL1, POSELT, APOS, K8 + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & I,J,NASS,IDIAG + INCLUDE 'mumps_headers.h' + INTRINSIC real + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NASS = IW(IOLDPS+1+KEEP(IXSZ)) + IF ( NBROWS .GT. NBROWF ) THEN + WRITE(*,*) ' ERR: ERROR : NBROWS > NBROWF' + WRITE(*,*) ' ERR: INODE =', INODE + WRITE(*,*) ' ERR: NBROW=',NBROWS,'NBROWF=',NBROWF + WRITE(*,*) ' ERR: ROW_LIST=', ROWLIST + CALL MUMPS_ABORT() + END IF + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + IF (NBROWS.GT.0) THEN + POSEL1 = POSELT - int(NBCOLF,8) + IF (KEEP(50).EQ.0) THEN + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8) + DO I=1, NBROWS + DO J = 1, NBCOLS + A(APOS+int(J-1,8)) = A( APOS+int(J-1,8)) + VALSON(J,I) + ENDDO + APOS = APOS + int(NBCOLF,8) + END DO + ELSE + DO I=1,NBROWS + APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8) + DO J=1,NBCOLS + K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8 + A(K8) = A(K8) + VALSON(J,I) + ENDDO + ENDDO + ENDIF + ELSE + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8) + & + int((NBROWS-1),8)*int(NBCOLF,8) + IDIAG = 0 + DO I=NBROWS,1,-1 + A(APOS:APOS+int(NBCOLS-IDIAG-1,8))= + & A(APOS:APOS+int(NBCOLS-IDIAG-1,8)) + + & VALSON(1:NBCOLS-IDIAG,I) + APOS = APOS - int(NBCOLF,8) + IDIAG = IDIAG + 1 + ENDDO + ELSE + DO I=1,NBROWS + APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8) + DO J=1,NBCOLS + IF (ITLOC(COLLIST(J)) .EQ. 0) THEN + write(6,*) ' .. exit for col =', J + EXIT + ENDIF + K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8 + A(K8) = A(K8) + VALSON(J,I) + ENDDO + ENDDO + ENDIF + ENDIF + OPASSW = OPASSW + dble(NBROWS*NBCOLS) + ENDIF + RETURN + END SUBROUTINE SMUMPS_40 + SUBROUTINE SMUMPS_178( A, LA, + & IAFATH, NFRONT, NASS1, + & IACB, NCOLS, LCB, + & IW, NROWS, NELIM, ETATASS, + & CB_IS_COMPRESSED, IS_INPLACE + & ) + IMPLICIT NONE + INTEGER NFRONT, NASS1 + INTEGER(8) :: LA + INTEGER NCOLS, NROWS, NELIM + INTEGER(8) :: LCB + REAL A( LA ) + INTEGER(8) :: IAFATH, IACB + INTEGER IW( NCOLS ) + INTEGER ETATASS + LOGICAL CB_IS_COMPRESSED, IS_INPLACE + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS, + & RISK_OF_SAME_POS_THIS_LINE, OMP_FLAG + INTEGER I, J + INTEGER(8) :: APOS, POSELT + INTEGER(8) :: IPOSCB, IBEGCBROW, IENDFRONT + IENDFRONT = IAFATH+int(NFRONT,8)*int(NFRONT,8)-1_8 + IF ( IS_INPLACE ) THEN + IPOSCB=1_8 + RESET_TO_ZERO = IACB .LT. IENDFRONT + 1_8 + RISK_OF_SAME_POS = IACB + LCB .EQ. IENDFRONT + 1_8 + RISK_OF_SAME_POS_THIS_LINE = .FALSE. + DO I=1, NROWS + POSELT = int(IW(I)-1,8) * int(NFRONT,8) + IF (.NOT. CB_IS_COMPRESSED ) THEN + IPOSCB = 1_8 + int(I - 1,8) * int(NCOLS,8) + IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN + RESET_TO_ZERO = .FALSE. + ENDIF + ENDIF + IF ( RISK_OF_SAME_POS ) THEN + IF (I.EQ.NROWS .OR. .NOT. CB_IS_COMPRESSED) THEN + IF ( IAFATH + POSELT + int(IW(I)-1,8) .EQ. + & IACB+IPOSCB+int(I-1-1,8)) THEN + RISK_OF_SAME_POS_THIS_LINE = .TRUE. + ENDIF + ENDIF + ENDIF + IF (RESET_TO_ZERO) THEN + IF ( RISK_OF_SAME_POS_THIS_LINE ) THEN + DO J=1, I + APOS = POSELT + int(IW( J ),8) + IF (IAFATH + APOS - 1_8.NE. IACB+IPOSCB-1_8) THEN + A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) + A(IACB+IPOSCB-1_8) = ZERO + ENDIF + IPOSCB = IPOSCB + 1_8 + ENDDO + ELSE + DO J=1, I + APOS = POSELT + int(IW( J ),8) + A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) + A(IACB+IPOSCB-1_8) = ZERO + IPOSCB = IPOSCB + 1_8 + ENDDO + ENDIF + ELSE + DO J=1, I + APOS = POSELT + int(IW( J ),8) + A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + ENDDO + ENDIF + IF (.NOT. CB_IS_COMPRESSED ) THEN + IBEGCBROW = IACB+IPOSCB-1_8 + IF ( IBEGCBROW .LE. IENDFRONT ) THEN + A(IBEGCBROW:IBEGCBROW+int(NCOLS-I,8)-1_8)=ZERO + ENDIF + ENDIF + IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN + RESET_TO_ZERO = .FALSE. + ENDIF + ENDDO + RETURN + ENDIF + IF ((ETATASS.EQ.0) .OR. (ETATASS.EQ.1)) THEN + IPOSCB = 1_8 + DO I = 1, NELIM + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + IF (.NOT. CB_IS_COMPRESSED) THEN + IPOSCB = 1_8 + int( I - 1, 8 ) * int(NCOLS,8) + ENDIF + DO J = 1, I + APOS = POSELT + int(IW( J ),8) + A(IAFATH+ APOS -1_8) = A(IAFATH+ APOS -1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + END DO + ENDIF + IF ((ETATASS.EQ.0).OR.(ETATASS.EQ.1)) THEN + OMP_FLAG = (NROWS-NELIM).GE.300 + DO I = NELIM + 1, NROWS + IF (CB_IS_COMPRESSED) THEN + IPOSCB = (int(I,8) * int(I-1,8)) / 2_8 + 1_8 + ELSE + IPOSCB = int(I-1,8) * int(NCOLS,8) + 1_8 + ENDIF + POSELT = int(IW( I ),8) + IF (POSELT.LE. int(NASS1,8) .AND. .NOT. IS_INPLACE) THEN + DO J = 1, NELIM + APOS = POSELT + int( IW( J ) - 1, 8 ) * int(NFRONT,8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + + & A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + ELSE + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J = 1, NELIM + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + ENDIF + IF (ETATASS.EQ.1) THEN + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J = NELIM + 1, I + IF (IW(J).GT.NASS1) EXIT + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB +1_8 + END DO + ELSE + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J = NELIM + 1, I + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + ENDIF + END DO + ELSE + DO I= NROWS, NELIM+1, -1 + IF (CB_IS_COMPRESSED) THEN + IPOSCB = (int(I,8)*int(I+1,8))/2_8 + ELSE + IPOSCB = int(I-1,8) * int(NCOLS,8) + int(I,8) + ENDIF + POSELT = int(IW( I ),8) + IF (POSELT.LE.int(NASS1,8)) EXIT + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J=I,NELIM+1, -1 + IF (IW(J).LE.NASS1) EXIT + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB - 1_8 + ENDDO + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_178 + SUBROUTINE SMUMPS_530(N, ISON, INODE, IWPOSCB, + & PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8) + IMPLICIT NONE + INTEGER N, ISON, INODE, IWPOSCB + INTEGER KEEP(500), STEP(N) + INTEGER(8) KEEP8(150) + INTEGER PIMASTER(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER LIW + INTEGER IW(LIW) + INTEGER ISTCHK, LSTK, NSLSON, HS, NROWS, NCOLS, NPIVS, NELIM + INTEGER IOLDPS, NFRONT, NSLAVES, ICT11, HF + INTEGER J1, J2, J3, JJ, JPOS + LOGICAL SAME_PROC + INCLUDE 'mumps_headers.h' + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + NCOLS = NPIVS + LSTK + IF ( NPIVS < 0 ) NPIVS = 0 + SAME_PROC = ISTCHK < IWPOSCB + IF (SAME_PROC) THEN + NROWS = NCOLS + ELSE + NROWS = IW(ISTCHK+2+KEEP(IXSZ)) + ENDIF + J1 = ISTCHK + NROWS + HS + NPIVS + IF (KEEP(50).NE.0) THEN + J2 = J1 + LSTK - 1 + DO JJ = J1, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + ELSE + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM + DO JJ = J3, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + IF (NELIM .NE. 0) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + ICT11 = IOLDPS + HF - 1 + NFRONT + J3 = J3 - 1 + DO 190 JJ = J1, J3 + JPOS = IW(JJ) + ICT11 + IW(JJ) = IW(JPOS) + 190 CONTINUE + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_530 + SUBROUTINE SMUMPS_619( + & N, INODE, IW, LIW, A, LA, + & ISON, NBCOLS, + & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER, + & OPASSW, IWPOSCB,MYID, KEEP,KEEP8 ) + USE SMUMPS_LOAD + IMPLICIT NONE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA + INTEGER N,LIW,MYID + INTEGER INODE,ISON,IWPOSCB + INTEGER NBCOLS + INTEGER IW(LIW), STEP(N), + & PIMASTER(KEEP(28)), + & PTLUST_S(KEEP(28)) + INTEGER(8) PTRAST(KEEP(28)) + REAL A(LA) + REAL VALSON(NBCOLS) + DOUBLE PRECISION OPASSW + INTEGER HF,HS, NSLAVES, NASS1, + & IOLDPS, ISTCHK, + & LSTK, NSLSON,NELIM,NPIVS,NCOLS, J1, + & JJ1,NROWS + INTEGER(8) POSELT, APOS, JJ2 + INCLUDE 'mumps_headers.h' + LOGICAL SAME_PROC + INTRINSIC real + IOLDPS = PTLUST_S(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NASS1 = iabs(IW(IOLDPS + 2 + KEEP(IXSZ))) + NSLAVES= IW(IOLDPS+5 + KEEP(IXSZ)) + HF = 6 + NSLAVES + KEEP(IXSZ) + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NELIM = IW(ISTCHK + 1 + KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LT.IWPOSCB) + IF (SAME_PROC) THEN + NROWS = NCOLS + ELSE + NROWS = IW(ISTCHK+2 + KEEP(IXSZ)) + ENDIF + J1 = ISTCHK + NROWS + HS + NPIVS + APOS = POSELT + int(NASS1,8)*int(NASS1,8) - 1_8 + DO JJ1 = 1, NBCOLS + JJ2 = APOS+int(IW(J1 + JJ1 - 1),8) + IF(abs(A(JJ2)) .LT. VALSON(JJ1)) + & A(JJ2) = VALSON(JJ1) + ENDDO + RETURN + END SUBROUTINE SMUMPS_619 + RECURSIVE SUBROUTINE SMUMPS_264( + & COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE SMUMPS_OOC + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mumps_headers.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER(8) :: POSFAC + INTEGER COMP + INTEGER IFLAG, IERROR, NBFIN, MSGSOU + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER NBPROCFILS( KEEP(28) ), STEP(N), + & PIMASTER(KEEP(28)) + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER COMM, MYID + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER PTLUST_S(KEEP(28)), + & ITLOC(N+KEEP(253)), FILS(N), ND(KEEP(28)) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER FRERE_STEPS(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION FLOP1 + REAL DBLARR(max(1,KEEP(13))) + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER INODE, POSITION, NPIV, IERR, LP + INTEGER NCOL + INTEGER(8) :: POSBLOCFACTO + INTEGER(8) :: LAELL + INTEGER(8) :: POSELT + INTEGER IOLDPS, LCONT1, NASS1, NROW1, NCOL1, NPIV1 + INTEGER NSLAV1, HS, ISW + INTEGER (8) :: LPOS, LPOS1, LPOS2, IPOS, KPOS + INTEGER ICT11 + INTEGER I, IPIV, FPERE + LOGICAL LASTBL + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + REAL ONE,ALPHA + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, NextPivDummy + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + FPERE = -1 + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, + & MPI_INTEGER, COMM, IERR ) + LASTBL = (NPIV.LE.0) + IF (LASTBL) THEN + NPIV = -NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, + & MPI_INTEGER, COMM, IERR ) + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOL, 1, + & MPI_INTEGER, COMM, IERR ) + LAELL = int(NPIV,8) * int(NCOL,8) + IF ( LRLU .LT. LAELL .OR. IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LAELL ) THEN + IFLAG = -9 + CALL MUMPS_731(LAELL - LRLUS, IERROR) + IF (ICNTL(1).GT.0 .AND. ICNTL(4).GE.1) THEN + LP=ICNTL(1) + WRITE(LP,*) + &" FAILURE, WORKSPACE TOO SMALL DURING SMUMPS_264" + ENDIF + GOTO 700 + END IF + CALL SMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS=' + & ,LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731( LAELL-LRLUS, IERROR ) + GOTO 700 + END IF + IF ( IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF (ICNTL(1).GT.0 .AND. ICNTL(4).GE.1) THEN + LP=ICNTL(1) + WRITE(LP,*) + &" FAILURE IN INTEGER ALLOCATION DURING SMUMPS_264" + ENDIF + IFLAG = -8 + IERROR = IWPOS + NPIV - 1 - IWPOSCB + GOTO 700 + END IF + END IF + LRLU = LRLU - LAELL + LRLUS = LRLUS - LAELL + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSBLOCFACTO = POSFAC + POSFAC = POSFAC + LAELL + CALL SMUMPS_471(.FALSE., .FALSE., + & LA-LRLUS,0_8,LAELL,KEEP,KEEP8,LRLU) + IPIV = IWPOS + IWPOS = IWPOS + NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IPIV ), NPIV, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSBLOCFACTO), NPIV*NCOL, + & MPI_REAL, + & COMM, IERR ) + IF (PTRIST(STEP( INODE )) .EQ. 0) THEN + DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 ) + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. + & ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + ENDIF + DO WHILE ( NBPROCFILS( STEP(INODE)) .NE. 0 ) + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, CONTRIB_TYPE2, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .TRUE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + LCONT1 = IW( IOLDPS +KEEP(IXSZ)) + NASS1 = IW( IOLDPS + 1 +KEEP(IXSZ)) + NROW1 = IW( IOLDPS + 2 +KEEP(IXSZ)) + NPIV1 = IW( IOLDPS + 3 +KEEP(IXSZ)) + NSLAV1 = IW( IOLDPS + 5 +KEEP(IXSZ)) + HS = 6 + NSLAV1 + KEEP(IXSZ) + NCOL1 = LCONT1 + NPIV1 + IF (NPIV.GT.0) THEN + ICT11 = IOLDPS+HS+NROW1+NPIV1 - 1 + DO I = 1, NPIV + IF (IW(IPIV+I-1).EQ.I) CYCLE + ISW = IW(ICT11+I) + IW(ICT11+I) = IW(ICT11+IW(IPIV+I-1)) + IW(ICT11+IW(IPIV+I-1)) = ISW + IPOS = POSELT + int(NPIV1 + I - 1,8) + KPOS = POSELT + int(NPIV1 + IW(IPIV+I-1) - 1,8) + CALL sswap(NROW1, A(IPOS), NCOL1, A(KPOS), NCOL1) + ENDDO + LPOS2 = POSELT + int(NPIV1,8) + CALL strsm('L','L','N','N',NPIV, NROW1, ONE, + & A(POSBLOCFACTO), NCOL, A(LPOS2), NCOL1) + LPOS1 = POSBLOCFACTO+int(NPIV,8) + LPOS = LPOS2 + int(NPIV,8) + ENDIF + IF (KEEP(201).eq.1) THEN + MonBloc%INODE = INODE + MonBloc%MASTER = .FALSE. + MonBloc%Typenode = 2 + MonBloc%NROW = NROW1 + MonBloc%NCOL = NCOL1 + MonBloc%NFS = NASS1 + MonBloc%LastPiv = NPIV1 + NPIV + NULLIFY(MonBloc%INDICES) + MonBloc%Last = LASTBL + STRAT = STRAT_TRY_WRITE + NextPivDummy = -8888 + LIWFAC = IW(IOLDPS+XXI) + CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR)) + LAST_CALL = .FALSE. + CALL SMUMPS_688( STRAT, TYPEF_L, A(POSELT), + & LAFAC, MonBloc, NextPivDummy, NextPivDummy, + & IW(IOLDPS), LIWFAC, MYID, KEEP8(31), IFLAG,LAST_CALL) + ENDIF + IF ( NPIV .GT. 0 ) THEN + CALL sgemm('N','N', NCOL-NPIV,NROW1,NPIV, + & ALPHA,A(LPOS1),NCOL, + & A(LPOS2),NCOL1,ONE, A(LPOS),NCOL1) + ENDIF + IW(IOLDPS+KEEP(IXSZ) ) = IW(IOLDPS+KEEP(IXSZ) ) - NPIV + IW(IOLDPS + 3+KEEP(IXSZ) ) = IW(IOLDPS+3+KEEP(IXSZ) ) + NPIV + IF (LASTBL) IW(IOLDPS+1+KEEP(IXSZ) ) = IW(IOLDPS + 3+KEEP(IXSZ) ) + IF ( .not. LASTBL .AND. + & (IW(IOLDPS+1+KEEP(IXSZ)) .EQ. IW(IOLDPS + 3+KEEP(IXSZ))) ) THEN + write(*,*) ' ERROR 1 **** IN BLACFACTO ' + CALL MUMPS_ABORT() + ENDIF + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + IWPOS = IWPOS - NPIV + FLOP1 = dble( NPIV1*NROW1 ) + + & dble(NROW1*NPIV1)*dble(2*NCOL1-NPIV1-1) + & - + & dble((NPIV1+NPIV)*NROW1 ) - + & dble(NROW1*(NPIV1+NPIV))*dble(2*NCOL1-NPIV1-NPIV-1) + CALL SMUMPS_190( 1, .FALSE., FLOP1, KEEP,KEEP8 ) + IF (LASTBL) THEN + CALL SMUMPS_759( + & COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ENDIF + 600 CONTINUE + RETURN + 700 CONTINUE + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE SMUMPS_264 + SUBROUTINE SMUMPS_699( COMM_LOAD, ASS_IRECV, + & MSGLEN, BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC, + & N, IW, LIW, A, LA, PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, NBPROCFILS, + & COMP, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, NSTK_S, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, NBFIN, + & MYID, COMM, ICNTL, KEEP,KEEP8, IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, LPTRAR, NELT, + & FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE SMUMPS_LOAD + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV, MSGLEN + INTEGER BUFR( LBUFR ) + INTEGER(8) :: LRLU, IPTRLU, LRLUS, LA, POSFAC + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER NBFIN + INTEGER COMP + INTEGER NELT, LPTRAR + INTEGER PROCNODE_STEPS( KEEP(28) ), PTRIST(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER PTLUST_S( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER ITLOC( N + KEEP(253)), NSTK_S( KEEP(28) ), FILS( N ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER ND(KEEP(28)), FRERE_STEPS( KEEP(28) ) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER INTARR( max(1,KEEP(14)) ) + REAL DBLARR( max( 1,KEEP(13)) ) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER COMM, MYID, IFLAG, IERROR + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER FRTPTR(N+1), FRTELT( NELT ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER NFS4FATHER + INCLUDE 'mumps_headers.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER MUMPS_275, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_810 + INTEGER IERR + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INTEGER I, INODE, ISON, POSITION, NBROW, LROW, IROW, INDCOL + INTEGER LREQI + INTEGER(8) :: LREQA, POSCONTRIB + INTEGER ROW_LENGTH + INTEGER MASTER + INTEGER ISTCHK + LOGICAL SAME_PROC + LOGICAL SLAVE_NODE + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED, IS_ofType5or6 + INTEGER ISHIFT_BUFR, LBUFR_LOC, LBUFR_BYTES_LOC + INTEGER TYPESPLIT + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, ISON, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NBROW, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, LROW, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, + & MPI_INTEGER, COMM, IERR ) + MASTER = MUMPS_275(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + SLAVE_NODE = MASTER .NE. MYID + TYPESPLIT = MUMPS_810(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IS_ofType5or6 = ((TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) + IF (SLAVE_NODE .AND. PTRIST(STEP(INODE)) ==0) THEN + ISHIFT_BUFR = ( MSGLEN + KEEP(34) ) / KEEP(34) + LBUFR_LOC = LBUFR - ISHIFT_BUFR + 1 + LBUFR_BYTES_LOC = LBUFR_LOC * KEEP(34) + DO WHILE ( PTRIST( STEP(INODE) ) .EQ. 0 ) + MASTER = MUMPS_275(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MASTER, MAITRE_DESC_BANDE, + & STATUS, + & BUFR(ISHIFT_BUFR), LBUFR_LOC, LBUFR_BYTES_LOC, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF (IFLAG.LT.0) RETURN + END DO + ENDIF + IF ( SLAVE_NODE ) THEN + LREQI = LROW + NBROWS_PACKET + ELSE + LREQI = NBROWS_PACKET + END IF + LREQA = int(LROW,8) + IF ( LRLU .LT. LREQA .OR. IWPOS + LREQI + & - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LREQA ) THEN + IFLAG = -9 + CALL MUMPS_731( LREQA - LRLUS, IERROR ) + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END IF + CALL SMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..process_contrib' + WRITE(*,*) 'LRLU,LRLUS=',LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731( LREQA - LRLUS, IERROR ) + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END IF + IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END IF + END IF + LRLU = LRLU - LREQA + LRLUS = LRLUS - LREQA + POSCONTRIB = POSFAC + POSFAC = POSFAC + LREQA + KEEP8(67) = min(LRLUS, KEEP8(67)) + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU) + IF ( SLAVE_NODE ) THEN + IROW = IWPOS + INDCOL = IWPOS + NBROWS_PACKET + ELSE + IROW = IWPOS + INDCOL = -1 + END IF + IWPOS = IWPOS + LREQI + IF ( SLAVE_NODE ) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( INDCOL ), LROW, MPI_INTEGER, + & COMM, IERR ) + END IF + DO I = 1, NBROWS_PACKET + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IROW + I - 1 ), 1, MPI_INTEGER, + & COMM, IERR ) + END DO + IF ( SLAVE_NODE ) THEN + IF ( NBROWS_ALREADY_SENT + NBROWS_PACKET == NBROW ) THEN + NBPROCFILS(STEP(INODE))=NBPROCFILS(STEP(INODE))-1 + ENDIF + IF ( KEEP(55) .eq. 0 ) THEN + CALL SMUMPS_539 + & (N, INODE, IW, LIW, A, LA, + & NBROW, LROW, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, MYID ) + ELSE + CALL SMUMPS_123( + & NELT, FRTPTR, FRTELT, + & N, INODE, IW, LIW, A, LA, + & NBROW, LROW, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, MYID ) + ENDIF + DO I=1,NBROWS_PACKET + IF(KEEP(50).NE.0)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & ROW_LENGTH, + & 1, + & MPI_INTEGER, + & COMM, IERR ) + ELSE + ROW_LENGTH=LROW + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSCONTRIB), + & ROW_LENGTH, + & MPI_REAL, + & COMM, IERR ) + CALL SMUMPS_40(N, INODE, IW, LIW, A, LA, + & 1, ROW_LENGTH, IW( IROW+I-1 ),IW(INDCOL), + & A(POSCONTRIB), + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, ICNTL, KEEP,KEEP8, MYID, IS_ofType5or6, + & ROW_LENGTH ) + ENDDO + CALL SMUMPS_531 + & (N, INODE, IW, LIW, + & NBROWS_PACKET, STEP, PTRIST, + & ITLOC, RHS_MUMPS,KEEP,KEEP8) + ELSE + DO I=1,NBROWS_PACKET + IF(KEEP(50).NE.0)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & ROW_LENGTH, + & 1, + & MPI_INTEGER, + & COMM, IERR ) + ELSE + ROW_LENGTH=LROW + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSCONTRIB), + & ROW_LENGTH, + & MPI_REAL, + & COMM, IERR ) + CALL SMUMPS_39(N, INODE, IW, LIW, A, LA, + & ISON, 1, ROW_LENGTH, IW( IROW +I-1 ), + & A(POSCONTRIB), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, ROW_LENGTH + &) + ENDDO + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + IF (KEEP(219).NE.0) THEN + IF(KEEP(50) .EQ. 2) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NFS4FATHER, + & 1, + & MPI_INTEGER, + & COMM, IERR ) + IF(NFS4FATHER .GT. 0) THEN + CALL SMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE. 0) THEN + IERROR = BUF_LMAX_ARRAY + IFLAG = -13 + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & BUF_MAX_ARRAY, + & NFS4FATHER, + & MPI_REAL, + & COMM, IERR ) + CALL SMUMPS_619(N, INODE, IW, LIW, A, LA, + & ISON, NFS4FATHER, + & BUF_MAX_ARRAY, PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8) + ENDIF + ENDIF + ENDIF + ENDIF + IF (NBROWS_ALREADY_SENT + NBROWS_PACKET == NBROW ) THEN + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE)) - 1 + NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - 1 + IF ( NBPROCFILS(STEP(ISON)) .EQ. 0) THEN + ISTCHK = PIMASTER(STEP(ISON)) + SAME_PROC= ISTCHK .LT. IWPOSCB + IF (SAME_PROC) THEN + CALL SMUMPS_530(N, ISON, INODE, IWPOSCB, + & PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8) + ENDIF + IF (SAME_PROC) THEN + ISTCHK = PTRIST(STEP(ISON)) + PTRIST(STEP( ISON) ) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL SMUMPS_152(.FALSE., MYID, N, ISTCHK, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, IWPOSCB, + & LA, KEEP,KEEP8, .FALSE. + & ) + ENDIF + IF ( NBPROCFILS(STEP(INODE)) .EQ. 0 ) THEN + CALL SMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), + & KEEP(47), STEP, INODE+N ) + IF (KEEP(47) .GE. 3) THEN + CALL SMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + ENDIF + ENDIF + END IF + IWPOS = IWPOS - LREQI + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + POSFAC = POSFAC - LREQA + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU) + RETURN + END SUBROUTINE SMUMPS_699 + SUBROUTINE SMUMPS_143( N, INODE, IW, LIW, A, LA, + & IOLDPS, POSELT, IFLAG, UU, NOFFW, + & NPVW, + & KEEP,KEEP8, STEP, + & PROCNODE_STEPS, MYID, SLAVEF, SEUIL, + & AVOID_DELAYED, ETATASS, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & IWPOS ) + USE SMUMPS_OOC + IMPLICIT NONE + INTEGER(8) :: LA, POSELT + INTEGER N, INODE, LIW, IFLAG, NOFFW, NPVW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER MYID, SLAVEF, IOLDPS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS( KEEP(28) ), STEP(N) + REAL UU, SEUIL + LOGICAL AVOID_DELAYED + INTEGER ETATASS, IWPOS + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER INOPV, IFINB, NFRONT, NPIV, IBEG_BLOCK + INTEGER NASS, NEL1, NPIVB, NPIVE, NBOLKJ, NBTLKJ + REAL UUTEMP + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, LNextPiv2beWritten, + & UNextPiv2beWritten, IFLAG_OOC, + & PP_FIRST2SWAP_L, PP_FIRST2SWAP_U, + & PP_LastPIVRPTRFilled_L, + & PP_LastPIVRPTRFilled_U + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INCLUDE 'mumps_headers.h' + EXTERNAL MUMPS_330, SMUMPS_221, SMUMPS_233, + & SMUMPS_229, + & SMUMPS_225, SMUMPS_232, SMUMPS_231, + & SMUMPS_220, + & SMUMPS_228, SMUMPS_236 + INTEGER MUMPS_330 + LOGICAL STATICMODE + REAL SEUIL_LOC + INOPV = 0 + SEUIL_LOC = SEUIL + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + UUTEMP=UU + ENDIF + IBEG_BLOCK=1 + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5), NASS ) + ENDIF + NBTLKJ = NBOLKJ + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_BOTH_LU + LNextPiv2beWritten = 1 + UNextPiv2beWritten = 1 + PP_FIRST2SWAP_L = LNextPiv2beWritten + PP_FIRST2SWAP_U = UNextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + MonBloc%LastPanelWritten_U = 0 + PP_LastPIVRPTRFilled_L = 0 + PP_LastPIVRPTRFilled_U = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 1 + MonBloc%NROW = NFRONT + MonBloc%NCOL = NFRONT + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -88877 + NULLIFY(MonBloc%INDICES) + ENDIF + 50 CONTINUE + CALL SMUMPS_221(NFRONT,NASS,N,INODE,IW,LIW,A,LA,INOPV,NOFFW, + & IFLAG,IOLDPS,POSELT,UU,SEUIL_LOC,KEEP,KEEP8, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U, + & PP_LastPIVRPTRFilled_U) + IF (IFLAG.LT.0) GOTO 500 + IF (INOPV.EQ.1) THEN + IF(STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + GOTO 80 + ENDIF + IF (INOPV.EQ.2) THEN + CALL SMUMPS_233(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,NBOLKJ, NBTLKJ,KEEP(4),KEEP(IXSZ)) + GOTO 50 + ENDIF + NPVW = NPVW + 1 + IF (NASS.LE.1) THEN + CALL SMUMPS_229(NFRONT,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,KEEP(IXSZ)) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + GO TO 500 + ENDIF + CALL SMUMPS_225(IBEG_BLOCK,NFRONT, NASS, N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB, + & NBTLKJ,KEEP(4),KEEP(IXSZ)) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + IF (IFINB.EQ.0) GOTO 50 + IF (KEEP(201).EQ.1) THEN + MonBloc%LastPiv= IW(IOLDPS+1+KEEP(IXSZ)) + STRAT = STRAT_TRY_WRITE + TYPEFile = TYPEF_U + LAST_CALL = .FALSE. + CALL SMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + ENDIF + IF (IFINB.EQ.(-1)) GOTO 80 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NEL1 = NASS - NPIV + CALL SMUMPS_232(A,LA, + & NFRONT,NPIV,NASS,POSELT,NBTLKJ) + GO TO 50 + 80 CONTINUE + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + IF (NPIV.LE.0) GO TO 110 + NEL1 = NFRONT - NASS + IF (NEL1.LE.0) GO TO 110 + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_TRY_WRITE + TYPEFile = TYPEF_BOTH_LU + MonBloc%LastPiv= NPIV + CALL SMUMPS_642(A(POSELT), LAFAC, NFRONT, + & NPIV, NASS, IW(IOLDPS), LIWFAC, + & MonBloc, TYPEFile, MYID, KEEP8, + & STRAT, IFLAG_OOC, + & LNextPiv2beWritten, UNextPiv2beWritten) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + ELSE + CALL SMUMPS_231(A,LA,NFRONT, NPIV,NASS,POSELT) + ENDIF + 110 CONTINUE + IF (MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + & .EQ.1) THEN + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + IBEG_BLOCK = NPIV + IF (NASS.EQ.NPIV) GOTO 500 + 120 CALL SMUMPS_220(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IOLDPS,POSELT,UU,SEUIL, + & KEEP, DKEEP, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U, + & PP_LastPIVRPTRFilled_U) + IF (INOPV.NE.1) THEN + NPVW = NPVW + 1 + CALL SMUMPS_228(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB,KEEP(IXSZ)) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + IF (IFINB.EQ.0) GOTO 120 + ENDIF + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NPIVB = IBEG_BLOCK + NPIVE = NPIV - NPIVB + NEL1 = NFRONT - NASS + IF ((NPIVE.LE.0).OR.(NEL1.EQ.0)) GO TO 500 + CALL SMUMPS_236(A,LA,NPIVB, + & NFRONT,NPIV,NASS,POSELT) + ENDIF + 500 CONTINUE + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + TYPEFile = TYPEF_BOTH_LU + LAST_CALL = .TRUE. + CALL SMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC, LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + CALL SMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + RETURN + END SUBROUTINE SMUMPS_143 + RECURSIVE SUBROUTINE SMUMPS_322( + & COMM_LOAD, ASS_IRECV, + & MSGSOU, MSGTAG, MSGLEN, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mumps_headers.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER MSGSOU, MSGTAG, MSGLEN + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER KEEP(500), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR( max(1,KEEP(14)) ) + REAL DBLARR( max(1,KEEP(13)) ) + INTEGER INIV2, ISHIFT, IBEG + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + LOGICAL FLAG + INTEGER MP, LP + INTEGER TMP( 2 ) + INTEGER NBRECU, POSITION, INODE, ISON, IROOT + INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE, + & LMAP, FPERE, NELIM, + & HDMAPLIG,NFS4FATHER, + & TOT_ROOT_SIZE, TOT_CONT_TO_RECV + DOUBLE PRECISION FLOP1 + INCLUDE 'mumps_tags.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + CHARACTER(LEN=35)::SUBNAME + MP = ICNTL(2) + LP = ICNTL(1) + SUBNAME="??????" + CALL SMUMPS_467(COMM_LOAD, KEEP) + IF ( MSGTAG .EQ. RACINE ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NBRECU, + & 1, MPI_INTEGER, COMM, IERR) + NBRECU = BUFR( 1 ) + NBFIN = NBFIN - NBRECU + ELSEIF ( MSGTAG .EQ. NOEUD ) THEN + CALL SMUMPS_269( MYID,KEEP,KEEP8, + & BUFR, LBUFR, LBUFR_BYTES, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, FPERE, FLAG, IFLAG, IERROR, COMM, + & ITLOC, RHS_MUMPS ) + SUBNAME="SMUMPS_269" + IF ( IFLAG .LT. 0 ) GO TO 500 + IF ( FLAG ) THEN + CALL SMUMPS_507(N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), STEP, FPERE ) + IF (KEEP(47) .GE. 3) THEN + CALL SMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + CALL MUMPS_137( FPERE, N, + & PROCNODE_STEPS,SLAVEF, + & ND, FILS, FRERE, STEP, PIMASTER, + & KEEP(28), KEEP(50), KEEP(253), FLOP1, + & IW, LIW, KEEP(IXSZ) ) + IF (FPERE.NE.KEEP(20)) + & CALL SMUMPS_190(1,.FALSE.,FLOP1,KEEP,KEEP8) + ENDIF + ELSEIF ( MSGTAG .EQ. END_NIV2_LDLT ) THEN + INODE = BUFR( 1 ) + CALL SMUMPS_507(N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), + & STEP, -INODE ) + IF (KEEP(47) .GE. 3) THEN + CALL SMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + ELSEIF ( MSGTAG .EQ. TERREUR ) THEN + IFLAG = -001 + IERROR = MSGSOU + GOTO 100 + ELSEIF ( MSGTAG .EQ. MAITRE_DESC_BANDE ) THEN + CALL SMUMPS_266( MYID,BUFR, LBUFR, + & LBUFR_BYTES, IWPOS, + & IWPOSCB, + & IPTRLU, LRLU, LRLUS, NBPROCFILS, + & N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP, + & KEEP,KEEP8, ITLOC, RHS_MUMPS, + & IFLAG, IERROR ) + SUBNAME="SMUMPS_266" + IF ( IFLAG .LT. 0 ) GO to 500 + ELSEIF ( MSGTAG .EQ. MAITRE2 ) THEN + CALL SMUMPS_268(MYID,BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, SLAVEF, IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & KEEP,KEEP8, ND, FILS, FRERE, ITLOC, RHS_MUMPS, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + SUBNAME="SMUMPS_268" + IF ( IFLAG .LT. 0 ) GO to 500 + ELSEIF ( MSGTAG .EQ. BLOC_FACTO ) THEN + CALL SMUMPS_264( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM , IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSEIF ( MSGTAG .EQ. BLOC_FACTO_SYM_SLAVE ) THEN + CALL SMUMPS_263( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSEIF ( MSGTAG .EQ. BLOC_FACTO_SYM ) THEN + CALL SMUMPS_274( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSEIF ( MSGTAG .EQ. CONTRIB_TYPE2 ) THEN + CALL SMUMPS_699( COMM_LOAD, ASS_IRECV, + & MSGLEN, BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC, + & N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, NBPROCFILS, COMP, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, NSTK_S, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, NBFIN, MYID, COMM, + & ICNTL, KEEP,KEEP8, IFLAG, IERROR, IPOOL, LPOOL, LEAF, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GO TO 100 + ELSEIF ( MSGTAG .EQ. MAPLIG ) THEN + HDMAPLIG = 7 + INODE = BUFR( 1 ) + ISON = BUFR( 2 ) + NSLAVES_PERE = BUFR( 3 ) + NFRONT_PERE = BUFR( 4 ) + NASS_PERE = BUFR( 5 ) + LMAP = BUFR( 6 ) + NFS4FATHER = BUFR(7) + IF ( (NSLAVES_PERE.NE.0).AND.(KEEP(48).NE.0) ) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + ISHIFT = NSLAVES_PERE+1 + TAB_POS_IN_PERE(1:NSLAVES_PERE+1, INIV2) = + & BUFR(HDMAPLIG+1:HDMAPLIG+1+NSLAVES_PERE) + TAB_POS_IN_PERE(SLAVEF+2, INIV2) = NSLAVES_PERE + ELSE + ISHIFT = 0 + ENDIF + IBEG = HDMAPLIG+1+ISHIFT + CALL SMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES_PERE, + & BUFR(IBEG), + & NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP, + & BUFR(IBEG+NSLAVES_PERE), + & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GO TO 100 + ELSE IF ( MSGTAG .EQ. ROOT_CONT_STATIC ) THEN + CALL SMUMPS_700( + & BUFR, LBUFR, LBUFR_BYTES, + & root, N, IW, LIW, A, LA, NBPROCFILS, + & LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, + & COMP, LRLUS, IPOOL, LPOOL, LEAF, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, + & ITLOC, RHS_MUMPS, + & ND, PROCNODE_STEPS, SLAVEF) + SUBNAME="SMUMPS_700" + IF ( IFLAG .LT. 0 ) GO TO 500 + ELSE IF ( MSGTAG .EQ. ROOT_NON_ELIM_CB ) THEN + IROOT = KEEP( 38 ) + MSGSOU = MUMPS_275( PROCNODE_STEPS(STEP(IROOT)), + & SLAVEF ) + IF ( PTLUST_S( STEP(IROOT)) .EQ. 0 ) THEN + CALL MPI_RECV( TMP, 2 * KEEP(34), MPI_PACKED, + & MSGSOU, ROOT_2SLAVE, + & COMM, STATUS, IERR ) + CALL SMUMPS_270( TMP( 1 ), TMP( 2 ), + & root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND ) + SUBNAME="SMUMPS_270" + IF ( IFLAG .LT. 0 ) GOTO 500 + END IF + CALL SMUMPS_700( + & BUFR, LBUFR, LBUFR_BYTES, + & root, N, IW, LIW, A, LA, NBPROCFILS, + & LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, + & COMP, LRLUS, IPOOL, LPOOL, LEAF, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, + & ITLOC, RHS_MUMPS, + & ND, PROCNODE_STEPS, SLAVEF ) + SUBNAME="SMUMPS_700" + IF ( IFLAG .LT. 0 ) GO TO 500 + ELSE IF ( MSGTAG .EQ. ROOT_2SON ) THEN + ISON = BUFR( 1 ) + NELIM = BUFR( 2 ) + CALL SMUMPS_271( COMM_LOAD, ASS_IRECV, + & ISON, NELIM, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GO TO 100 + IF (MYID.NE.MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF)) THEN + IF (KEEP(50).EQ.0) THEN + IF (IW(PTRIST(STEP(ISON))+6+KEEP(IXSZ)).EQ. + & S_REC_CONTSTATIC) THEN + IW(PTRIST(STEP(ISON))+6+KEEP(IXSZ)) = S_ROOT2SON_CALLED + ELSE + CALL SMUMPS_626( N, ISON, PTRIST, PTRAST, + & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + ENDIF + ELSE + IF (IW(PTRIST(STEP(ISON))+8+KEEP(IXSZ)).EQ. + & S_REC_CONTSTATIC) THEN + IW(PTRIST(STEP(ISON))+8+KEEP(IXSZ)) = S_ROOT2SON_CALLED + ELSE + CALL SMUMPS_626( N, ISON, PTRIST, PTRAST, + & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + ENDIF + ENDIF + ENDIF + ELSE IF ( MSGTAG .EQ. ROOT_2SLAVE ) THEN + TOT_ROOT_SIZE = BUFR( 1 ) + TOT_CONT_TO_RECV = BUFR( 2 ) + CALL SMUMPS_270( TOT_ROOT_SIZE, + & TOT_CONT_TO_RECV, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND ) + IF ( IFLAG .LT. 0 ) GO TO 100 + ELSE IF ( MSGTAG .EQ. ROOT_NELIM_INDICES ) THEN + ISON = BUFR( 1 ) + NELIM = BUFR( 2 ) + NSLAVES_PERE = BUFR( 3 ) + CALL SMUMPS_273( root, + & ISON, NELIM, NSLAVES_PERE, BUFR(4), BUFR(4+BUFR(2)), + & BUFR(4+2*BUFR(2)), + & + & PROCNODE_STEPS, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & ITLOC, RHS_MUMPS, COMP, + & IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8, + & COMM, COMM_LOAD, FILS, ND) + SUBNAME="SMUMPS_273" + IF ( IFLAG .LT. 0 ) GO TO 500 + ELSE IF ( MSGTAG .EQ. UPDATE_LOAD ) THEN + WRITE(*,*) "Internal error 3 in SMUMPS_322" + CALL MUMPS_ABORT() + ELSE IF ( MSGTAG .EQ. TAG_DUMMY ) THEN + ELSE + IF ( LP > 0 ) + & WRITE(LP,*) MYID, + &': Internal error, routine SMUMPS_322.',MSGTAG + IFLAG = -100 + IERROR= MSGTAG + GOTO 500 + ENDIF + 100 CONTINUE + RETURN + 500 CONTINUE + IF ( ICNTL(1) .GT. 0 .AND. ICNTL(4).GE.1 ) THEN + LP=ICNTL(1) + IF (IFLAG.EQ.-9) THEN + WRITE(LP,*) 'FAILURE, WORKSPACE TOO SMALL DURING ',SUBNAME + ENDIF + IF (IFLAG.EQ.-8) THEN + WRITE(LP,*) 'FAILURE IN INTEGER ALLOCATION DURING ',SUBNAME + ENDIF + IF (IFLAG.EQ.-13) THEN + WRITE(LP,*) 'FAILURE IN DYNAMIC ALLOCATION DURING ',SUBNAME + ENDIF + ENDIF + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE SMUMPS_322 + RECURSIVE SUBROUTINE SMUMPS_280( + & COMM_LOAD, ASS_IRECV, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT , + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC, LA, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ), + & PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR( max(1,KEEP(14)) ) + REAL DBLARR( max(1,KEEP(13)) ) + INTEGER MSGSOU, MSGTAG, MSGLEN, IERR + MSGSOU = STATUS( MPI_SOURCE ) + MSGTAG = STATUS( MPI_TAG ) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) + IF ( MSGLEN .GT. LBUFR_BYTES ) THEN + IFLAG = -20 + IERROR = MSGLEN + WRITE(*,*) ' RECEPTION BUF TOO SMALL, Msgtag/len=', + & MSGTAG,MSGLEN + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + CALL MPI_RECV( BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU, + & MSGTAG, + & COMM, STATUS, IERR ) + CALL SMUMPS_322( + & COMM_LOAD, ASS_IRECV, + & MSGSOU, MSGTAG, MSGLEN, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + RETURN + END SUBROUTINE SMUMPS_280 + RECURSIVE SUBROUTINE SMUMPS_329( + & COMM_LOAD, ASS_IRECV, BLOCKING, SET_IRECV, + & MESSAGE_RECEIVED, MSGSOU, MSGTAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & STACK_RIGHT_AUTHORIZED ) + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL, INTENT (IN) :: BLOCKING + LOGICAL, INTENT (IN) :: SET_IRECV + LOGICAL, INTENT (INOUT) :: MESSAGE_RECEIVED + INTEGER, INTENT (IN) :: MSGSOU, MSGTAG + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ), + & PTLUST_S(KEEP(28)) + INTEGER STEP(N), + & PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR( max(1,KEEP(14)) ) + REAL DBLARR( max(1,KEEP(13)) ) + LOGICAL, intent(in) :: STACK_RIGHT_AUTHORIZED + LOGICAL FLAG, RIGHT_MESS, FLAGbis + INTEGER LP, MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC + INTEGER IERR + INTEGER STATUS_BIS( MPI_STATUS_SIZE ) + INTEGER, SAVE :: RECURS = 0 + CALL SMUMPS_467(COMM_LOAD, KEEP) + IF ( .NOT. STACK_RIGHT_AUTHORIZED ) THEN + RETURN + ENDIF + RECURS = RECURS + 1 + LP = ICNTL(1) + IF (ICNTL(4).LT.1) LP=-1 + IF ( MESSAGE_RECEIVED ) THEN + MSGSOU_LOC = MPI_ANY_SOURCE + MSGTAG_LOC = MPI_ANY_TAG + GOTO 250 + ENDIF + IF ( ASS_IRECV .NE. MPI_REQUEST_NULL) THEN + RIGHT_MESS = .TRUE. + IF (BLOCKING) THEN + CALL MPI_WAIT(ASS_IRECV, + & STATUS, IERR) + FLAG = .TRUE. + IF ( ( (MSGSOU.NE.MPI_ANY_SOURCE) .OR. + & (MSGTAG.NE.MPI_ANY_TAG) ) ) THEN + IF ( MSGSOU.NE.MPI_ANY_SOURCE) THEN + RIGHT_MESS = MSGSOU.EQ.STATUS(MPI_SOURCE) + ENDIF + IF ( MSGTAG.NE.MPI_ANY_TAG) THEN + RIGHT_MESS = + & ( (MSGTAG.EQ.STATUS(MPI_TAG)).AND.RIGHT_MESS ) + ENDIF + IF (.NOT.RIGHT_MESS) THEN + CALL MPI_PROBE(MSGSOU,MSGTAG, + & COMM, STATUS_BIS, IERR) + ENDIF + ENDIF + ELSE + CALL MPI_TEST(ASS_IRECV, + & FLAG, STATUS, IERR) + ENDIF + IF (IERR.LT.0) THEN + IFLAG = -20 + IF (LP.GT.0) + & write(LP,*) ' Error return from MPI_TEST ', + & IFLAG, ' in SMUMPS_329' + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + IF ( FLAG ) THEN + MESSAGE_RECEIVED = .TRUE. + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN_LOC, IERR ) + IF (.NOT.RIGHT_MESS) RECURS = RECURS + 10 + CALL SMUMPS_322( COMM_LOAD, ASS_IRECV, + & MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (.NOT.RIGHT_MESS) RECURS = RECURS - 10 + IF ( IFLAG .LT. 0 ) RETURN + IF (.NOT.RIGHT_MESS) THEN + IF (ASS_IRECV .NE. MPI_REQUEST_NULL) THEN + CALL MUMPS_ABORT() + ENDIF + CALL MPI_IPROBE(MSGSOU,MSGTAG, + & COMM, FLAGbis, STATUS, IERR) + IF (FLAGbis) THEN + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + CALL SMUMPS_280( COMM_LOAD, ASS_IRECV, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + ENDIF + ELSE + IF (BLOCKING) THEN + CALL MPI_PROBE(MSGSOU,MSGTAG, + & COMM, STATUS, IERR) + FLAG = .TRUE. + ELSE + CALL MPI_IPROBE(MPI_ANY_SOURCE,MPI_ANY_TAG, + & COMM, FLAG, STATUS, IERR) + ENDIF + IF (FLAG) THEN + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + MESSAGE_RECEIVED = .TRUE. + CALL SMUMPS_280( COMM_LOAD, ASS_IRECV, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + 250 CONTINUE + RECURS = RECURS - 1 + IF ( NBFIN .EQ. 0 ) RETURN + IF ( RECURS .GT. 3 ) RETURN + IF ( KEEP(36).EQ.1 .AND. SET_IRECV .AND. + & (ASS_IRECV.EQ.MPI_REQUEST_NULL) .AND. + & MESSAGE_RECEIVED ) THEN + CALL MPI_IRECV ( BUFR(1), + & LBUFR_BYTES, MPI_PACKED, MPI_ANY_SOURCE, + & MPI_ANY_TAG, COMM, + & ASS_IRECV, IERR ) + ENDIF + RETURN + END SUBROUTINE SMUMPS_329 + SUBROUTINE SMUMPS_255( INFO1, + & ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & COMM, + & MYID, SLAVEF) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER LBUFR, LBUFR_BYTES + INTEGER ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER COMM + INTEGER MYID, SLAVEF, INFO1, DEST + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL NO_ACTIVE_IRECV + INTEGER MSGSOU_LOC, MSGTAG_LOC + INTEGER IERR, DUMMY + INTRINSIC mod + IF (SLAVEF .EQ. 1) RETURN + IF (ASS_IRECV.EQ.MPI_REQUEST_NULL) THEN + NO_ACTIVE_IRECV=.TRUE. + ELSE + CALL MPI_TEST(ASS_IRECV, NO_ACTIVE_IRECV, + & STATUS, IERR) + ENDIF + CALL MPI_BARRIER(COMM,IERR) + DUMMY = 1 + DEST = mod(MYID+1, SLAVEF) + CALL SMUMPS_62 + & (DUMMY, DEST, TAG_DUMMY, COMM, IERR) + IF (NO_ACTIVE_IRECV) THEN + CALL MPI_RECV( BUFR, LBUFR, + & MPI_INTEGER, MPI_ANY_SOURCE, + & TAG_DUMMY, COMM, STATUS, IERR ) + ELSE + CALL MPI_WAIT(ASS_IRECV, + & STATUS, IERR) + ENDIF + RETURN + END SUBROUTINE SMUMPS_255 + SUBROUTINE SMUMPS_180( + & INFO1, BUFR, LBUFR, LBUFR_BYTES, + & COMM_NODES, COMM_LOAD, SLAVEF, MP ) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER COMM_NODES, COMM_LOAD, SLAVEF, INFO1, MP + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG, BUFFERS_EMPTY, BUFFERS_EMPTY_ON_ALL_PROCS + INTEGER MSGSOU_LOC, MSGTAG_LOC, COMM_EFF + INTEGER IERR + INTEGER IBUF_EMPTY, IBUF_EMPTY_ON_ALL_PROCS + IF (SLAVEF.EQ.1) RETURN + BUFFERS_EMPTY_ON_ALL_PROCS = .FALSE. + 10 CONTINUE + FLAG = .TRUE. + DO WHILE ( FLAG ) + COMM_EFF = COMM_NODES + CALL MPI_IPROBE(MPI_ANY_SOURCE,MPI_ANY_TAG, + & COMM_NODES, FLAG, STATUS, IERR) + IF ( .NOT. FLAG ) THEN + COMM_EFF = COMM_LOAD + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, + & COMM_LOAD, FLAG, STATUS, IERR) + END IF + IF (FLAG) THEN + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + CALL MPI_RECV( BUFR, LBUFR_BYTES, + & MPI_PACKED, MSGSOU_LOC, + & MSGTAG_LOC, COMM_EFF, STATUS, IERR ) + ENDIF + END DO + IF (BUFFERS_EMPTY_ON_ALL_PROCS) THEN + RETURN + ENDIF + CALL SMUMPS_469(BUFFERS_EMPTY) + IF ( BUFFERS_EMPTY ) THEN + IBUF_EMPTY = 0 + ELSE + IBUF_EMPTY = 1 + ENDIF + CALL MPI_ALLREDUCE(IBUF_EMPTY, + & IBUF_EMPTY_ON_ALL_PROCS, + & 1, MPI_INTEGER, MPI_MAX, + & COMM_NODES, IERR) + IF ( IBUF_EMPTY_ON_ALL_PROCS == 0) THEN + BUFFERS_EMPTY_ON_ALL_PROCS = .TRUE. + ELSE + BUFFERS_EMPTY_ON_ALL_PROCS = .FALSE. + ENDIF + GOTO 10 + END SUBROUTINE SMUMPS_180 + INTEGER FUNCTION SMUMPS_748 + & ( HBUF_SIZE, NNMAX, K227, K50 ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NNMAX, K227, K50 + INTEGER(8), INTENT(IN) :: HBUF_SIZE + INTEGER K227_LOC + INTEGER NBCOL_MAX + INTEGER EFFECTIVE_SIZE + NBCOL_MAX=int(HBUF_SIZE / int(NNMAX,8)) + K227_LOC = abs(K227) + IF (K50.EQ.2) THEN + K227_LOC=max(K227_LOC,2) + EFFECTIVE_SIZE = min(NBCOL_MAX-1, K227_LOC-1) + ELSE + EFFECTIVE_SIZE = min(NBCOL_MAX, K227_LOC) + ENDIF + IF (EFFECTIVE_SIZE.LE.0) THEN + write(6,*) 'Internal buffers too small to store ', + & ' ONE col/row of size', NNMAX + CALL MUMPS_ABORT() + ENDIF + SMUMPS_748 = EFFECTIVE_SIZE + RETURN + END FUNCTION SMUMPS_748 + SUBROUTINE SMUMPS_698( IPIV, LPIV, ISHIFT, + & THE_PANEL, NBROW, NBCOL, KbeforePanel ) + IMPLICIT NONE + INTEGER LPIV, ISHIFT, NBROW, NBCOL, KbeforePanel + INTEGER IPIV(LPIV) + REAL THE_PANEL(NBROW, NBCOL) + INTEGER I, IPERM + DO I = 1, LPIV + IPERM=IPIV(I) + IF ( I+ISHIFT.NE.IPERM) THEN + CALL sswap(NBCOL, + & THE_PANEL(I+ISHIFT-KbeforePanel,1), NBROW, + & THE_PANEL(IPERM-KbeforePanel,1), NBROW) + ENDIF + END DO + RETURN + END SUBROUTINE SMUMPS_698 + SUBROUTINE SMUMPS_667(TYPEF, + & NBPANELS, + & I_PIVPTR, I_PIV, IPOS, IW, LIW) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER, intent(out) :: NBPANELS, I_PIVPTR, I_PIV + INTEGER, intent(in) :: TYPEF + INTEGER, intent(in) :: LIW, IPOS + INTEGER IW(LIW) + INTEGER I_NBPANELS, I_NASS + I_NASS = IPOS + I_NBPANELS = I_NASS + 1 + NBPANELS = IW(I_NBPANELS) + I_PIVPTR = I_NBPANELS + 1 + I_PIV = I_PIVPTR + NBPANELS + IF (TYPEF==TYPEF_U) THEN + I_NBPANELS = I_PIV+IW(I_NASS) + NBPANELS = IW(I_NBPANELS) + I_PIVPTR = I_NBPANELS + 1 + I_PIV = I_PIVPTR + NBPANELS + ENDIF + RETURN + END SUBROUTINE SMUMPS_667 + SUBROUTINE SMUMPS_691(K50,NBPANELS_L,NBPANELS_U, + & NASS, IPOS, IW, LIW ) + IMPLICIT NONE + INTEGER K50 + INTEGER IPOS, NASS, NBPANELS_L, NBPANELS_U, LIW + INTEGER IW(LIW) + INTEGER IPOS_U + IF (K50.EQ.1) THEN + WRITE(*,*) "Internal error: SMUMPS_691 called" + ENDIF + IW(IPOS)=NASS + IW(IPOS+1)=NBPANELS_L + IW(IPOS+2:IPOS+1+NBPANELS_L)=NASS+1 + IF (K50 == 0) THEN + IPOS_U=IPOS+2+NASS+NBPANELS_L + IW(IPOS_U)=NBPANELS_U + IW(IPOS_U+1:IPOS_U+NBPANELS_U)=NASS+1 + ENDIF + RETURN + END SUBROUTINE SMUMPS_691 + SUBROUTINE SMUMPS_644 ( + & IWPOS, IOLDPS, IW, LIW, MonBloc, NFRONT, KEEP + & ) + USE SMUMPS_OOC + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER, INTENT(IN) :: IOLDPS, LIW, NFRONT, + & KEEP(500) + INTEGER, INTENT(INOUT) :: IWPOS, IW(LIW) + TYPE(IO_BLOCK), INTENT(IN):: MonBloc + INTEGER :: NBPANELS_L,I_PIVRPTR_L, I_PIVR_L, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, XSIZE, IBEGOOC + LOGICAL FREESPACE + IF (KEEP(50).EQ.1) RETURN + IF ((IOLDPS+IW(IOLDPS+XXI)).NE.IWPOS) RETURN + XSIZE = KEEP(IXSZ) + IBEGOOC = IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE + CALL SMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IBEGOOC, IW, LIW) + FREESPACE = + & (MonBloc%LastPiv.EQ.(IW(I_PIVRPTR_L)-1)) + IF (KEEP(50).EQ.0) THEN + CALL SMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IBEGOOC, IW, LIW) + FREESPACE = FREESPACE .AND. + & (MonBloc%LastPiv.EQ.(IW(I_PIVRPTR_U)-1)) + ENDIF + IF (FREESPACE) THEN + IW(IBEGOOC) = -7777 + IW(IOLDPS+XXI) = IBEGOOC - IOLDPS + 1 + IWPOS = IBEGOOC+1 + ENDIF + RETURN + END SUBROUTINE SMUMPS_644 + SUBROUTINE SMUMPS_684(K50, NBROW_L, NBCOL_U, NASS, + & NBPANELS_L, NBPANELS_U, LREQ) + USE SMUMPS_OOC + IMPLICIT NONE + INTEGER, intent(IN) :: K50, NBROW_L, NBCOL_U, NASS + INTEGER, intent(OUT) :: NBPANELS_L, NBPANELS_U, LREQ + NBPANELS_L=-99999 + NBPANELS_U=-99999 + IF (K50.EQ.1) THEN + LREQ = 0 + RETURN + ENDIF + NBPANELS_L = (NASS / SMUMPS_690(NBROW_L))+1 + LREQ = 1 + & + 1 + & + NASS + & + NBPANELS_L + IF (K50.eq.0) THEN + NBPANELS_U = (NASS / SMUMPS_690(NBCOL_U) ) +1 + LREQ = LREQ + 1 + & + NASS + & + NBPANELS_U + ENDIF + RETURN + END SUBROUTINE SMUMPS_684 + SUBROUTINE SMUMPS_755 + & (IW_LOCATION, MUST_BE_PERMUTED) + IMPLICIT NONE + INTEGER, INTENT(IN) :: IW_LOCATION + LOGICAL, INTENT(INOUT) :: MUST_BE_PERMUTED + IF (IW_LOCATION .EQ. -7777) THEN + MUST_BE_PERMUTED = .FALSE. + ENDIF + RETURN + END SUBROUTINE SMUMPS_755 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part2.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part2.F new file mode 100644 index 000000000..34f3f60a9 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part2.F @@ -0,0 +1,7683 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE SMUMPS_152(SSARBR, MYID, N, IPOSBLOCK, + & RPOSBLOCK, + & IW, LIW, + & LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP, KEEP8, IN_PLACE_STATS + & ) + USE SMUMPS_LOAD + IMPLICIT NONE + INTEGER(8) :: RPOSBLOCK + INTEGER IPOSBLOCK, + & LIW, IWPOSCB, N + INTEGER(8) :: LA, LRLU, LRLUS, IPTRLU + LOGICAL IN_PLACE_STATS + INTEGER IW( LIW ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER MYID + LOGICAL SSARBR + INTEGER SIZFI_BLOCK, SIZFI + INTEGER IPOSSHIFT + INTEGER(8) :: SIZFR, SIZFR_BLOCK, SIZFR_BLOCK_EFF, + & SIZEHOLE, MEM_INC + INCLUDE 'mumps_headers.h' + IPOSSHIFT = IPOSBLOCK + KEEP(IXSZ) + SIZFI_BLOCK=IW(IPOSBLOCK+XXI) + CALL MUMPS_729( SIZFR_BLOCK,IW(IPOSBLOCK+XXR) ) + IF (KEEP(216).eq.3) THEN + SIZFR_BLOCK_EFF=SIZFR_BLOCK + ELSE + CALL SMUMPS_628( IW(IPOSBLOCK), + & LIW-IPOSBLOCK+1, + & SIZEHOLE, KEEP(IXSZ)) + SIZFR_BLOCK_EFF=SIZFR_BLOCK-SIZEHOLE + ENDIF + IF ( IPOSBLOCK .eq. IWPOSCB + 1 ) THEN + IPTRLU = IPTRLU + SIZFR_BLOCK + IWPOSCB = IWPOSCB + SIZFI_BLOCK + LRLU = LRLU + SIZFR_BLOCK + IF (.NOT. IN_PLACE_STATS) THEN + LRLUS = LRLUS + SIZFR_BLOCK_EFF + ENDIF + MEM_INC = -SIZFR_BLOCK_EFF + IF (IN_PLACE_STATS) THEN + MEM_INC= 0_8 + ENDIF + CALL SMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,0_8,MEM_INC,KEEP,KEEP8,LRLU) + 90 IF ( IWPOSCB .eq. LIW ) GO TO 100 + IPOSSHIFT = IWPOSCB + KEEP(IXSZ) + SIZFI = IW( IWPOSCB+1+XXI ) + CALL MUMPS_729( SIZFR,IW(IWPOSCB+1+XXR) ) + IF ( IW( IWPOSCB+1+XXS ) .EQ. S_FREE ) THEN + IPTRLU = IPTRLU + SIZFR + LRLU = LRLU + SIZFR + IWPOSCB = IWPOSCB + SIZFI + GO TO 90 + ENDIF + 100 CONTINUE + IW( IWPOSCB+1+XXP)=TOP_OF_STACK + ELSE + IW( IPOSBLOCK +XXS)=S_FREE + IF (.NOT. IN_PLACE_STATS) LRLUS = LRLUS + SIZFR_BLOCK_EFF + CALL SMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,0_8,-SIZFR_BLOCK_EFF,KEEP,KEEP8,LRLU) + END IF + RETURN + END SUBROUTINE SMUMPS_152 + SUBROUTINE SMUMPS_144( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, PIMASTER, + & PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP,PIVNUL_LIST,LPN_LIST) + USE SMUMPS_OOC + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, INODE, FPERE, LIW, NOFFW, NPVW + INTEGER(8) :: LA + INTEGER IW( LIW ) + REAL A( LA ) + REAL UU, SEUIL + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER COMM, MYID, LBUFR, LBUFR_BYTES + INTEGER LPTRAR, NELT + INTEGER ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NBFIN, SLAVEF, + & IFLAG, IERROR, LEAF, LPOOL + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB, COMP + INTEGER FRTPTR( N + 1 ), FRTELT( NELT ) + INTEGER BUFR( LBUFR ), IPOOL(LPOOL), + & ITLOC(N+KEEP(253)), FILS(N), + & PTRARW(LPTRAR), PTRAIW(LPTRAR), + & ND( KEEP(28) ), FRERE( KEEP(28) ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), NBPROCFILS(KEEP(28)), + & PROCNODE_STEPS(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + REAL DBLARR(max(1,KEEP(13))) + LOGICAL AVOID_DELAYED + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER INOPV, IFINB, NFRONT, NPIV, IBEGKJI, NBOLKJ, + & NBTLKJ, IBEG_BLOCK + INTEGER(8) :: POSELT + INTEGER NASS, NEL1, IEND, IOLDPS, dummy, allocok + LOGICAL LASTBL + REAL UUTEMP + INTEGER , ALLOCATABLE, DIMENSION ( : ) :: IPIV + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, LNextPiv2beWritten, + & UNextPiv2beWritten, IFLAG_OOC, + & PP_FIRST2SWAP_L, PP_FIRST2SWAP_U, + & PP_LastPIVRPTRFilled_L, PP_LastPIVRPTRFilled_U + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INCLUDE 'mumps_headers.h' + EXTERNAL SMUMPS_224, SMUMPS_233, + & SMUMPS_225, SMUMPS_232, + & SMUMPS_294, + & SMUMPS_44 + LOGICAL STATICMODE + REAL SEUIL_LOC + INOPV = 0 + SEUIL_LOC = SEUIL + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + UUTEMP=UU + ENDIF + IBEG_BLOCK=1 + dummy = 0 + IOLDPS = PTLUST_S(STEP( INODE )) + POSELT = PTRAST(STEP( INODE )) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5),NASS ) + ENDIF + NBTLKJ = NBOLKJ + ALLOCATE( IPIV( NASS ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) MYID,' : FACTO_NIV2 :failed to allocate ',NASS, + & ' integers' + IFLAG = -13 + IERROR =NASS + GO TO 490 + END IF + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_U + LNextPiv2beWritten = 1 + UNextPiv2beWritten = 1 + PP_FIRST2SWAP_L = LNextPiv2beWritten + PP_FIRST2SWAP_U = UNextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + MonBloc%LastPanelWritten_U = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 2 + MonBloc%NROW = NASS + MonBloc%NCOL = NFRONT + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -68877 + NULLIFY(MonBloc%INDICES) + ENDIF + 50 CONTINUE + IBEGKJI = IBEG_BLOCK + CALL SMUMPS_224(NFRONT,NASS,IBEGKJI, NASS, IPIV, + & N,INODE,IW,LIW,A,LA,INOPV,NOFFW, + & IFLAG,IOLDPS,POSELT,UU,SEUIL_LOC,KEEP,KEEP8, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U, + & PP_LastPIVRPTRFilled_U) + IF (IFLAG.LT.0) GOTO 490 + IF (INOPV.EQ.1) THEN + IF(STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + ENDIF + IF (INOPV.GE.1) THEN + LASTBL = (INOPV.EQ.1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL SMUMPS_294( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, NFRONT, + & IBEGKJI, IEND, IPIV, NASS,LASTBL, dummy, + & + & COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (INOPV.EQ.1) GO TO 500 + IF (INOPV.EQ.2) THEN + CALL SMUMPS_233(IBEG_BLOCK,NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,NBOLKJ,NBTLKJ,KEEP(4),KEEP(IXSZ)) + GOTO 50 + ENDIF + NPVW = NPVW + 1 + IF (NASS.LE.1) THEN + IFINB = -1 + ELSE + CALL SMUMPS_225(IBEG_BLOCK, + & NFRONT, NASS, N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB, + & NBTLKJ,KEEP(4),KEEP(IXSZ)) + ENDIF + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + IF (IFINB.EQ.0) GOTO 50 + IF ((IFINB.EQ.1).OR.(IFINB.EQ.-1)) THEN + LASTBL = (IFINB.EQ.-1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL SMUMPS_294(COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, NFRONT, + & IBEGKJI, IEND, IPIV, NASS, LASTBL, dummy, + & + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (IFINB.EQ.(-1)) GOTO 500 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NEL1 = NASS - NPIV + CALL SMUMPS_232(A,LA, + & NFRONT,NPIV,NASS,POSELT,NBTLKJ) + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_TRY_WRITE + MonBloc%LastPiv = NPIV + TYPEFile = TYPEF_BOTH_LU + LAST_CALL= .FALSE. + CALL SMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG<0) RETURN + ENDIF + GO TO 50 + 490 CONTINUE + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + DEALLOCATE( IPIV ) + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + TYPEFile = TYPEF_BOTH_LU + LAST_CALL = .TRUE. + CALL SMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG<0) RETURN + CALL SMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + RETURN + END SUBROUTINE SMUMPS_144 + SUBROUTINE SMUMPS_176( COMM_LOAD, ASS_IRECV, + & root, FRERE, IROOT, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER IROOT + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC,IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER(8) :: LA + INTEGER N, LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND(KEEP(28)), FRERE(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + REAL DBLARR( max(1,KEEP(13)) ) + INTEGER I, NELIM, NB_CONTRI_GLOBAL, NUMORG, + & NFRONT, IROW, JCOL, PDEST, HF, IOLDPS, + & IN, DEB_ROW, ILOC_ROW, IFSON, ILOC_COL, + & IPOS_SON, NELIM_SON, NSLAVES_SON, HS, + & IROW_SON, ICOL_SON, ISLAVE, IERR, + & NELIM_SENT, IPOS_STATREC + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INCLUDE 'mumps_headers.h' + INCLUDE 'mumps_tags.h' + NB_CONTRI_GLOBAL = KEEP(41) + NUMORG = root%ROOT_SIZE + NELIM = KEEP(42) + NFRONT = NUMORG + KEEP(42) + DO IROW = 0, root%NPROW - 1 + DO JCOL = 0, root%NPCOL - 1 + PDEST = IROW * root%NPCOL + JCOL + IF ( PDEST .NE. MYID ) THEN + CALL SMUMPS_73(NFRONT, + & NB_CONTRI_GLOBAL, PDEST, COMM, IERR) + if (IERR.lt.0) then + write(6,*) ' error detected by ', + & 'SMUMPS_73' + CALL MUMPS_ABORT() + endif + ENDIF + END DO + END DO + CALL SMUMPS_270( NFRONT, + & NB_CONTRI_GLOBAL, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND ) + IF (IFLAG < 0 ) RETURN + HF = 6 + KEEP(IXSZ) + IOLDPS = PTLUST_S(STEP(IROOT)) + IN = IROOT + DEB_ROW = IOLDPS + HF + ILOC_ROW = DEB_ROW + DO WHILE (IN.GT.0) + IW(ILOC_ROW) = IN + IW(ILOC_ROW+NFRONT) = IN + ILOC_ROW = ILOC_ROW + 1 + IN = FILS(IN) + END DO + IFSON = -IN + ILOC_ROW = IOLDPS + HF + NUMORG + ILOC_COL = ILOC_ROW + NFRONT + IF ( NELIM.GT.0 ) THEN + IN = IFSON + DO WHILE (IN.GT.0) + IPOS_SON = PIMASTER(STEP(IN)) + IF (IPOS_SON .EQ. 0) GOTO 100 + NELIM_SON = IW(IPOS_SON+1+KEEP(IXSZ)) + if (NELIM_SON.eq.0) then + write(6,*) ' error 1 in process_last_rtnelind' + CALL MUMPS_ABORT() + endif + NSLAVES_SON = IW(IPOS_SON+5+KEEP(IXSZ)) + HS = 6 + NSLAVES_SON + KEEP(IXSZ) + IROW_SON = IPOS_SON + HS + ICOL_SON = IROW_SON + NELIM_SON + DO I = 1, NELIM_SON + IW( ILOC_ROW+I-1 ) = IW( IROW_SON+I-1 ) + ENDDO + DO I = 1, NELIM_SON + IW( ILOC_COL+I-1 ) = IW( ICOL_SON+I-1 ) + ENDDO + NELIM_SENT = ILOC_ROW - IOLDPS - HF + 1 + DO ISLAVE = 0,NSLAVES_SON + IF (ISLAVE.EQ.0) THEN + PDEST= MUMPS_275(PROCNODE_STEPS(STEP(IN)),SLAVEF) + ELSE + PDEST = IW(IPOS_SON + 5 + ISLAVE+KEEP(IXSZ)) + ENDIF + IF (PDEST.NE.MYID) THEN + CALL SMUMPS_74(IN, NELIM_SENT, + & PDEST, COMM, IERR ) + if (IERR.lt.0) then + write(6,*) ' error detected by ', + & 'SMUMPS_73' + CALL MUMPS_ABORT() + endif + ELSE + CALL SMUMPS_271( COMM_LOAD, ASS_IRECV, + & IN, NELIM_SENT, root, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( ISLAVE .NE. 0 ) THEN + IF (KEEP(50) .EQ. 0) THEN + IPOS_STATREC = PTRIST(STEP(IN))+6+KEEP(IXSZ) + ELSE + IPOS_STATREC = PTRIST(STEP(IN))+8+KEEP(IXSZ) + ENDIF + IF (IW(IPOS_STATREC).EQ. S_REC_CONTSTATIC) THEN + IW(IPOS_STATREC) = S_ROOT2SON_CALLED + ELSE + CALL SMUMPS_626( N, IN, PTRIST, PTRAST, + & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + ENDIF + ENDIF + IPOS_SON = PIMASTER(STEP(IN)) + ENDIF + END DO + CALL SMUMPS_152( .FALSE.,MYID,N, IPOS_SON, + & PTRAST(STEP(IN)), + & IW, LIW, + & LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + ILOC_ROW = ILOC_ROW + NELIM_SON + ILOC_COL = ILOC_COL + NELIM_SON + 100 CONTINUE + IN = FRERE(STEP(IN)) + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_176 + SUBROUTINE SMUMPS_268(MYID,BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, SLAVEF, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, + & N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, NBPROCFILS, + & IPOOL, LPOOL, LEAF, KEEP,KEEP8, ND, FILS, FRERE, + & ITLOC, RHS_MUMPS, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER MYID + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER SLAVEF + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), STEP(N), PIMASTER(KEEP(28)) + INTEGER PROCNODE_STEPS( KEEP(28) ), ITLOC( N +KEEP(253) ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM, COMM_LOAD + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER ND(KEEP(28)), FILS( N ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER POSITION, IFATH, ISON, NROW, NCOL, NELIM, + & NSLAVES + INTEGER(8) :: NOREAL + INTEGER NOINT, INIV2, NCOL_EFF + DOUBLE PRECISION FLOP1 + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INTEGER NOREAL_PACKET + LOGICAL PERETYPE2 + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + POSITION = 0 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IFATH, 1, MPI_INTEGER + & , COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & ISON , 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NSLAVES, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NROW , 1, MPI_INTEGER + & , COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NCOL , 1, MPI_INTEGER + & , COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, + & MPI_INTEGER, COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, + & MPI_INTEGER, COMM, IERR) + IF ( NSLAVES .NE. 0 .and. KEEP(50).ne.0 ) THEN + NCOL_EFF = NROW + ELSE + NCOL_EFF = NCOL + ENDIF + NOREAL_PACKET = NBROWS_PACKET * NCOL_EFF + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + NOINT = 6 + NROW + NCOL + NSLAVES + KEEP(IXSZ) + NOREAL= int(NROW,8) * int(NCOL_EFF,8) + CALL SMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A,LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, + & NOINT, NOREAL, ISON, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) THEN + RETURN + ENDIF + PIMASTER(STEP( ISON )) = IWPOSCB + 1 + PAMASTER(STEP( ISON )) = IPTRLU + 1_8 + IW( IWPOSCB + 1 + KEEP(IXSZ) ) = NCOL + NELIM = NROW + IW( IWPOSCB + 2 + KEEP(IXSZ) ) = NELIM + IW( IWPOSCB + 3 + KEEP(IXSZ) ) = NROW + IF ( NSLAVES .NE. 0 .and. KEEP(50).ne.0 ) THEN + IW( IWPOSCB + 4 + KEEP(IXSZ) ) = NROW - NCOL + IF ( NROW - NCOL .GE. 0 ) THEN + WRITE(*,*) 'Error in PROCESS_MAITRE2:',NROW,NCOL + CALL MUMPS_ABORT() + END IF + ELSE + IW( IWPOSCB + 4 + KEEP(IXSZ) ) = 0 + END IF + IW( IWPOSCB + 5 + KEEP(IXSZ) ) = 1 + IW( IWPOSCB + 6 + KEEP(IXSZ) ) = NSLAVES + IF (NSLAVES.GT.0) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IWPOSCB + 7 + KEEP(IXSZ) ), + & NSLAVES, MPI_INTEGER, COMM, IERR ) + ENDIF + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IW(IWPOSCB + 7 + KEEP(IXSZ) + NSLAVES), + & NROW, MPI_INTEGER, COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IW(IWPOSCB + 7 + KEEP(IXSZ) + NROW + NSLAVES), + & NCOL, MPI_INTEGER, COMM, IERR) + IF ( ( KEEP(48).NE. 0 ).AND.(NSLAVES .GT. 0 )) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(ISON) ) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & TAB_POS_IN_PERE(1,INIV2), + & NSLAVES+1, MPI_INTEGER, COMM, IERR) + TAB_POS_IN_PERE(SLAVEF+2,INIV2) = NSLAVES + ENDIF + ENDIF + IF (NOREAL_PACKET.GT.0) THEN + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & A(PAMASTER(STEP(ISON)) + + & int(NBROWS_ALREADY_SENT,8) * int(NCOL_EFF,8)), + & NOREAL_PACKET, MPI_REAL, COMM, IERR) + ENDIF + IF ( NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. NROW ) THEN + PERETYPE2 = ( MUMPS_330(PROCNODE_STEPS(STEP(IFATH)), + & SLAVEF) .EQ. 2 ) + NSTK_S( STEP(IFATH )) = NSTK_S( STEP(IFATH) ) - 1 + IF ( NSTK_S( STEP(IFATH)) .EQ. 0 ) THEN + CALL SMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IFATH ) + IF (KEEP(47) .GE. 3) THEN + CALL SMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + CALL MUMPS_137( IFATH, N, PROCNODE_STEPS, + & SLAVEF, ND, + & FILS,FRERE, STEP, PIMASTER, + & KEEP(28), KEEP(50), KEEP(253), + & FLOP1,IW, LIW, KEEP(IXSZ) ) + IF (IFATH.NE.KEEP(20)) + & CALL SMUMPS_190(1, .FALSE., FLOP1, KEEP,KEEP8) + END IF + ENDIF + RETURN + END SUBROUTINE SMUMPS_268 + SUBROUTINE SMUMPS_242(DATA, LDATA, MPITYPE, ROOT, COMMW, TAG, + &SLAVEF) + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER LDATA, ROOT, COMMW, TAG, MPITYPE, SLAVEF + INTEGER DEST + INTEGER DATA(LDATA) + DO 10 DEST = 0, SLAVEF - 1 + IF (DEST .NE. ROOT) THEN + IF ( LDATA .EQ. 1 .and. MPITYPE .EQ. MPI_INTEGER ) THEN + CALL SMUMPS_62( DATA(1), DEST, TAG, + & COMMW, IERR ) + ELSE + WRITE(*,*) 'Error : bad argument to SMUMPS_242' + CALL MUMPS_ABORT() + END IF + ENDIF + 10 CONTINUE + RETURN + END SUBROUTINE SMUMPS_242 + SUBROUTINE SMUMPS_44( MYID, SLAVEF, COMM ) + INTEGER MYID, SLAVEF, COMM + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER DUMMY (1) + CALL SMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, + & COMM, TERREUR, SLAVEF ) + RETURN + END SUBROUTINE SMUMPS_44 + SUBROUTINE SMUMPS_464( K34, K35, K16, K10 ) + IMPLICIT NONE + INTEGER, INTENT(OUT) :: K34, K35, K10, K16 + INTEGER SIZE_INT, SIZE_REAL_OR_DOUBLE + INTEGER I(2) + REAL R(2) + CALL MUMPS_SIZE_C(I(1),I(2),SIZE_INT) + CALL MUMPS_SIZE_C(R(1),R(2),SIZE_REAL_OR_DOUBLE) + K34 = int(SIZE_INT) + K10 = 8 / K34 + K16 = int(SIZE_REAL_OR_DOUBLE) + K35 = K16 + RETURN + END SUBROUTINE SMUMPS_464 + SUBROUTINE SMUMPS_20( NSLAVES, LWK_USER, CNTL, ICNTL, + & KEEP,KEEP8, + & INFO, INFOG, RINFO, RINFOG, SYM, PAR, + & DKEEP) + IMPLICIT NONE + REAL DKEEP(30) + REAL CNTL(15), RINFO(40), RINFOG(40) + INTEGER ICNTL(40), KEEP(500), SYM, PAR, NSLAVES + INTEGER INFO(40), INFOG(40) + INTEGER(8) KEEP8(150) + INTEGER LWK_USER +C Let $A_{preproc}$ be the preprocessed matrix to be factored (see + LWK_USER = 0 + KEEP(1:500) = 0 + KEEP8(1:150)= 0_8 + INFO(1:40) = 0 + INFOG(1:40) = 0 + ICNTL(1:40) = 0 + RINFO(1:40) = 0.0E0 + RINFOG(1:40)= 0.0E0 + CNTL(1:15) = 0.0E0 + DKEEP(1:30) = 0.0E0 + KEEP( 50 ) = SYM + IF ( KEEP(50).NE.1 .and. KEEP(50).NE.2 ) KEEP( 50 ) = 0 + IF ( KEEP(50) .NE. 1 ) THEN + CNTL(1) = 0.01E0 + ELSE + CNTL(1) = 0.0E0 + END IF + CNTL(2) = sqrt(epsilon(0.0E0)) + CNTL(3) = 0.0E0 + CNTL(4) = -1.0E0 + CNTL(5) = 0.0E0 + CNTL(6) = -1.0E0 + KEEP(46) = PAR + IF ( KEEP(46) .NE. 0 .AND. + & KEEP(46) .NE. 1 ) THEN + KEEP(46) = 1 + END IF + ICNTL(1) = 6 + ICNTL(2) = 0 + ICNTL(3) = 6 + ICNTL(4) = 2 + ICNTL(5) = 0 + IF (SYM.NE.1) THEN + ICNTL(6) = 7 + ELSE + ICNTL(6) = 0 + ENDIF + ICNTL(7) = 7 + ICNTL(8) = 77 + ICNTL(9) = 1 + ICNTL(10) = 0 + ICNTL(11) = 0 + IF(SYM .EQ. 2) THEN + ICNTL(12) = 0 + ELSE + ICNTL(12) = 1 + ENDIF + ICNTL(13) = 0 + IF (SYM.eq.1.AND.NSLAVES.EQ.1) THEN + ICNTL(14) = 5 + ELSE IF (NSLAVES .GT. 4) THEN + ICNTL(14) = 30 + ELSE + ICNTL(14) = 20 + END IF + ICNTL(15) = 0 + ICNTL(16) = 0 + ICNTL(17) = 0 + ICNTL(18) = 0 + ICNTL(19) = 0 + ICNTL(20) = 0 + ICNTL(21) = 0 + ICNTL(22) = 0 + ICNTL(23) = 0 + ICNTL(24) = 0 + ICNTL(27) = -8 + ICNTL(28) = 1 + ICNTL(29) = 0 + ICNTL(39) = 1 + ICNTL(40) = 0 + KEEP(12) = 0 + KEEP(11) = 2147483646 + KEEP(24) = 18 + KEEP(68) = 0 + KEEP(36) = 1 + KEEP(1) = 8 + KEEP(7) = 150 + KEEP(8) = 120 + KEEP(57) = 500 + KEEP(58) = 250 + IF ( SYM .eq. 0 ) THEN + KEEP(4) = 32 + KEEP(3) = 96 + KEEP(5) = 16 + KEEP(6) = 32 + KEEP(9) = 700 + KEEP(85) = 300 + KEEP(62) = 50 + IF (NSLAVES.GE.128) KEEP(62)=200 + IF (NSLAVES.GE.128) KEEP(9)=800 + IF (NSLAVES.GE.256) KEEP(9)=900 + ELSE + KEEP(4) = 24 + KEEP(3) = 96 + KEEP(5) = 16 + KEEP(6) = 48 + KEEP(9) = 400 + KEEP(85) = 100 + KEEP(62) = 100 + IF (NSLAVES.GE.128) KEEP(62)=150 + IF (NSLAVES.GE.64) KEEP(9)=800 + IF (NSLAVES.GE.128) KEEP(9)=900 + END IF + KEEP(63) = 60 + KEEP(48) = 5 + KEEP(17) = 0 + CALL SMUMPS_464( KEEP(34), KEEP(35), + & KEEP(16), KEEP(10) ) +#if defined(SP_) + KEEP( 51 ) = 70 +#else + KEEP( 51 ) = 48 +#endif + KEEP(37) = max(800, int(sqrt(real(NSLAVES+1))*real(KEEP(51)))) + IF ( NSLAVES > 256 ) THEN + KEEP(39) = 10000 + ELSEIF ( NSLAVES > 128 ) THEN + KEEP(39) = 20000 + ELSEIF ( NSLAVES > 64 ) THEN + KEEP(39) = 40000 + ELSEIF ( NSLAVES > 16 ) THEN + KEEP(39) = 80000 + ELSE + KEEP(39) = 160000 + END IF + KEEP(40) = -1 - 456789 + KEEP(45) = 0 + KEEP(47) = 2 + KEEP(64) = 10 + KEEP(69) = 4 + KEEP(75) = 1 + KEEP(76) = 2 + KEEP(77) = 30 + KEEP(79) = 0 + IF (NSLAVES.GT.4) THEN + KEEP(78)=max( + & int(log(real(NSLAVES))/log(real(2))) - 2 + & , 0 ) + ENDIF + KEEP(210) = 2 + KEEP8(79) = -10_8 + KEEP(80) = 1 + KEEP(81) = 0 + KEEP(82) = 5 + KEEP(83) = min(8,NSLAVES/4) + KEEP(83) = max(min(4,NSLAVES),max(KEEP(83),1)) + KEEP(86)=1 + KEEP(87)=0 + KEEP(88)=0 + KEEP(90)=1 + KEEP(91)=min(8, NSLAVES) + KEEP(91) = max(min(4,NSLAVES),min(KEEP(83),KEEP(91))) + IF(NSLAVES.LT.48)THEN + KEEP(102)=150 + ELSEIF(NSLAVES.LT.128)THEN + KEEP(102)=150 + ELSEIF(NSLAVES.LT.256)THEN + KEEP(102)=200 + ELSEIF(NSLAVES.LT.512)THEN + KEEP(102)=300 + ELSEIF(NSLAVES.GE.512)THEN + KEEP(102)=400 + ENDIF +#if defined(OLD_OOC_NOPANEL) + KEEP(99)=0 +#else + KEEP(99)=4 +#endif + KEEP(100)=0 + KEEP(204)=0 + KEEP(205)=0 + KEEP(209)=-1 + KEEP(104) = 16 + KEEP(107)=0 + KEEP(211)=2 + IF (NSLAVES .EQ. 2) THEN + KEEP(213) = 101 + ELSE + KEEP(213) = 201 + ENDIF + KEEP(217)=0 + KEEP(215)=0 + KEEP(216)=1 + KEEP(218)=50 + KEEP(219)=1 + IF (KEEP(50).EQ.2) THEN + KEEP(227)= max(2,32) + ELSE + KEEP(227)= max(1,32) + ENDIF + KEEP(231) = 1 + KEEP(232) = 3 + KEEP(233) = 0 + KEEP(239) = 1 + KEEP(240) = 10 + DKEEP(4) = -1.0E0 + DKEEP(5) = -1.0E0 + IF(NSLAVES.LE.8)THEN + KEEP(238)=12 + ELSE + KEEP(238)=7 + ENDIF + KEEP(234)= 1 + DKEEP(3)=-5.0E0 + KEEP(242) = 1 + KEEP(250) = 1 + RETURN + END SUBROUTINE SMUMPS_20 + SUBROUTINE SMUMPS_786(id, LP) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (SMUMPS_STRUC) :: id + INTEGER LP + IF (id%KEEP(72)==1) THEN + IF (LP.GT.0) + & write(LP,*) 'Warning KEEP(72) = 1 !!!!!!!!!! ' + id%KEEP(37) = 2*id%NSLAVES + id%KEEP(3)=3 + id%KEEP(4)=2 + id%KEEP(5)=1 + id%KEEP(6)=2 + id%KEEP(9)=3 + id%KEEP(39)=300 + id%CNTL(1)=0.1E0 + id%KEEP(213) = 101 + id%KEEP(85)=2 + id%KEEP(85)=-4 + id%KEEP(62) = 2 + id%KEEP(1) = 1 + id%KEEP(51) = 2 + ELSE IF (id%KEEP(72)==2) THEN + IF (LP.GT.0) + & write(LP,*)' OOC setting to reduce stack memory', + & ' KEEP(72)=', id%KEEP(72) + id%KEEP(85)=2 + id%KEEP(85)=-10000 + id%KEEP(62) = 10 + id%KEEP(210) = 1 + id%KEEP8(79) = 160000_8 + id%KEEP(1) = 2 + id%KEEP(102) = 110 + id%KEEP(213) = 121 + END IF + RETURN + END SUBROUTINE SMUMPS_786 + SUBROUTINE SMUMPS_195(N, NZ, IRN, ICN, LIW, IKEEP, PTRAR, + & IORD, NFSIZ, FILS, FRERE, LISTVAR_SCHUR, SIZE_SCHUR, + & ICNTL, INFO, KEEP,KEEP8, NSLAVES, PIV, id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N,NZ,LIW,IORD,SIZE_SCHUR, NSLAVES + INTEGER PTRAR(N,4), NFSIZ(N), FILS(N), FRERE(N) + INTEGER IKEEP(N,3) + INTEGER LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER INFO(40), ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + TYPE (SMUMPS_STRUC) :: id + INTEGER IRN(NZ), ICN(NZ) + INTEGER, DIMENSION(:), ALLOCATABLE :: IW + INTEGER IERR + INTEGER K,I,L1,L2,IWFR,NCMPA,LLIW, IN, IFSON + INTEGER NEMIN, LP, MP, LDIAG, ITEMP, symmetry + INTEGER MedDens, NBQD, AvgDens + LOGICAL PROK, COMPRESS_SCHUR + INTEGER NBBUCK + INTEGER, DIMENSION(:), ALLOCATABLE :: HEAD + INTEGER NUMFLAG + INTEGER OPT_METIS_SIZE + INTEGER, DIMENSION(:), ALLOCATABLE :: OPTIONS_METIS + REAL, DIMENSION(:), ALLOCATABLE :: COLSCA_TEMP + INTEGER THRESH, IVersion + LOGICAL AGG6 + INTEGER MINSYM + PARAMETER (MINSYM=50) + INTEGER(8) :: K79REF + PARAMETER(K79REF=12000000_8) + INTEGER PIV(N) + INTEGER MTRANS, COMPRESS,NCMP,IERROR,J,JPERM,NCST + INTEGER TOTEL + LOGICAL IDENT,SPLITROOT + EXTERNAL MUMPS_197, SMUMPS_198, + & SMUMPS_199, SMUMPS_351, + & SMUMPS_557, SMUMPS_201 +#if defined(OLDDFS) + EXTERNAL SMUMPS_200 +#endif + EXTERNAL SMUMPS_623 + EXTERNAL SMUMPS_547, SMUMPS_550, + & SMUMPS_556 + ALLOCATE( IW ( LIW ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = LIW + RETURN + ENDIF + LLIW = LIW - 2*N - 1 + L1 = LLIW + 1 + L2 = L1 + N + LP = ICNTL(1) + MP = ICNTL(3) + PROK = (MP.GT.0) + LDIAG = ICNTL(4) + COMPRESS_SCHUR = .FALSE. + IF (KEEP(1).LT.0) KEEP(1) = 0 + NEMIN = KEEP(1) + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + WRITE (MP,99999) N, NZ, LIW, INFO(1) + K = min0(10,NZ) + IF (LDIAG.EQ.4) K = NZ + IF (K.GT.0) WRITE (MP,99998) (IRN(I),ICN(I),I=1,K) + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (IORD.EQ.1 .AND. K.GT.0) THEN + WRITE (MP,99997) (IKEEP(I,1),I=1,K) + ENDIF + ENDIF + NCMP = N + IF (KEEP(60).NE.0) THEN + IF ((SIZE_SCHUR.LE.0 ).OR. + & (SIZE_SCHUR.GE.N) ) GOTO 90 + ENDIF +#if defined(metis) || defined(parmetis) + IF ( ( KEEP(60).NE.0).AND.(SIZE_SCHUR.GT.0) + & .AND. + & ((IORD.EQ.7).OR.(IORD.EQ.5)) + & )THEN + COMPRESS_SCHUR=.TRUE. + NCMP = N-SIZE_SCHUR + CALL SMUMPS_623(N,NCMP,NZ,IRN, ICN, IW(1), LLIW, + & IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, + & KEEP(50), MedDens, NBQD, AvgDens, + & LISTVAR_SCHUR, SIZE_SCHUR, + & FRERE,FILS) + IORD = 5 + KEEP(95) = 1 + NBQD = 0 + ELSE +#endif + CALL SMUMPS_351(N,NZ,IRN, ICN, IW(1), LLIW, + & IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, + & KEEP(50), MedDens, NBQD, AvgDens) +#if defined(metis) || defined(parmetis) + ENDIF +#endif + INFO(8) = symmetry + IF(NBQD .GT. 0) THEN + IF( KEEP(50) .EQ. 2 .AND. ICNTL(12) .LE. 1 ) THEN + IF(KEEP(95) .NE. 1) THEN + IF ( PROK ) + & WRITE( MP,*) + & 'Compressed/constrained ordering set OFF' + KEEP(95) = 1 + ENDIF + ENDIF + ENDIF + IF ( (KEEP(60).NE.0) .AND. (IORD.GT.1) .AND. + & .NOT. COMPRESS_SCHUR ) THEN + IORD = 0 + ENDIF + IF ( (KEEP(50).EQ.2) + & .AND. (KEEP(95) .EQ. 3) + & .AND. (IORD .EQ. 7) ) THEN + IORD = 2 + ENDIF + CALL SMUMPS_701( N, KEEP(50), NSLAVES, IORD, + & symmetry, MedDens, NBQD, AvgDens, + & PROK, MP ) + IF(KEEP(50) .EQ. 2) THEN + IF(KEEP(95) .EQ. 3 .AND. IORD .NE. 2) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: SMUMPS_195 constrained ordering not '// + & ' available with selected ordering. Move to' // + & ' compressed ordering.' + KEEP(95) = 2 + ENDIF + IF(KEEP(95) .EQ. 2 .AND. IORD .EQ. 0) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: SMUMPS_195 AMD not available with ', + & ' compressed ordering -> move to QAMD' + IORD = 6 + ENDIF + ELSE + KEEP(95) = 1 + ENDIF + MTRANS = KEEP(23) + COMPRESS = KEEP(95) - 1 + IF(COMPRESS .GT. 0 .AND. KEEP(52) .EQ. -2) THEN + IF(id%CNTL(4) .GE. 0.0E0) THEN + IF (KEEP(1).LE.8) THEN + NEMIN = 16 + ELSE + NEMIN = 2*KEEP(1) + ENDIF + IF (PROK) + & WRITE(MP,*) 'Setting static pivoting ON, COMPRESS =', + & COMPRESS + ENDIF + ENDIF + IF(MTRANS .GT. 0 .AND. KEEP(50) .EQ. 2) THEN + KEEP(23) = 0 + ENDIF + IF(COMPRESS .EQ. 2) THEN + IF (IORD.NE.2) THEN + WRITE(*,*) "IORD not compatible with COMPRESS:", + & IORD, COMPRESS + CALL MUMPS_ABORT() + ENDIF + CALL SMUMPS_556( + & N,PIV,FRERE,FILS,NFSIZ,IKEEP, + & NCST,KEEP,KEEP8,id) + ENDIF + IF ( IORD .NE. 1 ) THEN + IF(COMPRESS .GE. 1) THEN + CALL SMUMPS_547( + & N,NZ, IRN, ICN, PIV, + & NCMP, IW(1), LLIW, IW(L2),PTRAR(1,2),PTRAR, + & IW(L1), FILS, IWFR, + & IERROR, KEEP,KEEP8, ICNTL) + symmetry = 100 + ENDIF + IF ( (symmetry.LT.MINSYM).AND.(KEEP(50).EQ.0) ) THEN + IF(KEEP(23) .EQ. 7 ) THEN + KEEP(23) = -5 + DEALLOCATE (IW) + RETURN + ELSE IF(KEEP(23) .EQ. -9876543) THEN + IDENT = .TRUE. + KEEP(23) = 5 + IF (PROK) WRITE(MP,'(A)') + & ' ... Apply column permutation (already computed)' + DO J=1,N + JPERM = PIV(J) + FILS(JPERM) = J + IF (JPERM.NE.J) IDENT = .FALSE. + ENDDO + IF (.NOT.IDENT) THEN + DO K=1,NZ + J = ICN(K) + IF ((J.LE.0).OR.(J.GT.N)) CYCLE + ICN(K) = FILS(J) + ENDDO + ALLOCATE(COLSCA_TEMP(N), stat=IERR) + IF ( IERR > 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = N + RETURN + ENDIF + DO J = 1, N + COLSCA_TEMP(J)=id%COLSCA(J) + ENDDO + DO J=1, N + id%COLSCA(FILS(J))=COLSCA_TEMP(J) + ENDDO + DEALLOCATE(COLSCA_TEMP) + IF (MP.GT.0 .AND. ICNTL(4).GE.2) + & WRITE(MP,'(/A)') + & ' WARNING input matrix data modified' + CALL SMUMPS_351 + & (N,NZ,IRN, ICN, IW(1), LLIW, IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, KEEP(50), + & MedDens, NBQD, AvgDens) + INFO(8) = symmetry + NCMP = N + ELSE + KEEP(23) = 0 + ENDIF + ENDIF + ELSE IF (KEEP(23) .EQ. 7 .OR. KEEP(23) .EQ. -9876543 ) THEN + IF (PROK) WRITE(MP,'(A)') + & ' ... No column permutation' + KEEP(23) = 0 + ENDIF + ENDIF + IF (IORD.NE.1 .AND. IORD.NE.5) THEN + IF (PROK) THEN + IF (IORD.EQ.2) THEN + WRITE(MP,'(A)') ' Ordering based on AMF ' +#if defined(scotch) || defined(ptscotch) + ELSE IF (IORD.EQ.3) THEN + WRITE(MP,'(A)') ' Ordering based on SCOTCH ' +#endif +#if defined(pord) + ELSE IF (IORD.EQ.4) THEN + WRITE(MP,'(A)') ' Ordering based on PORD ' +#endif + ELSE IF (IORD.EQ.6) THEN + WRITE(MP,'(A)') ' Ordering based on QAMD ' + ELSE + WRITE(MP,'(A)') ' Ordering based on AMD ' + ENDIF + ENDIF + IF ( KEEP(60) .NE. 0 ) THEN + CALL MUMPS_162(N, LLIW, IW(L2), IWFR, PTRAR(1,2), IW(1), + & IW(L1), IKEEP, + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), PTRAR, PTRAR(1,3), + & LISTVAR_SCHUR, SIZE_SCHUR) + IF (KEEP(60)==1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSE + KEEP(38) = LISTVAR_SCHUR(1) + ENDIF + ELSE + IF ( .FALSE. ) THEN +#if defined(pord) + ELSEIF (IORD .EQ. 4) THEN + IF(COMPRESS .EQ. 1) THEN + DO I=L1,L1-1+KEEP(93)/2 + IW(I) = 2 + ENDDO + DO I=L1+KEEP(93)/2,L1+NCMP-1 + IW(I) = 1 + ENDDO + CALL MUMPS_PORDF_WND(NCMP, IWFR-1, IW(L2), IW, + & IW(L1), NCMPA, N) + CALL SMUMPS_548(NCMP,IW(L2),IW(L1),FILS) + CALL SMUMPS_549(NCMP,IW(L2),IKEEP(1,1), + & FRERE,PTRAR(1,1)) + DO I=1,NCMP + IKEEP(IKEEP(I,1),2)=I + ENDDO + ELSE + CALL MUMPS_PORDF(NCMP, IWFR-1, IW(L2), IW(1), + & IW(L1), NCMPA) + ENDIF + IF ( NCMPA .NE. 0 ) THEN + write(6,*) ' Out PORD, NCMPA=', NCMPA + INFO( 1 ) = -9999 + INFO( 2 ) = 4 + RETURN + ENDIF +#endif +#if defined(scotch) || defined(ptscotch) + ELSEIF (IORD .EQ. 3) THEN + CALL MUMPS_SCOTCH(NCMP, LLIW, IW(L2), IWFR, + & PTRAR(1,2), IW(1), IW(L1), IKEEP, + & IKEEP(1,2), NCMPA) + IF ( NCMPA .NE. 0 ) THEN + write(6,*) ' Out SCTOCH, NCMPA=', NCMPA + INFO( 1 ) = -9999 + INFO( 2 ) = 3 + RETURN + ENDIF + IF (COMPRESS .EQ. 1) THEN + CALL SMUMPS_548(NCMP,IW(L2),IW(L1),FILS) + CALL SMUMPS_549(NCMP,IW(L2),IKEEP(1,1), + & FRERE,PTRAR(1,1)) + DO I=1,NCMP + IKEEP(IKEEP(I,1),2)=I + ENDDO + ENDIF +#endif + ELSEIF (IORD .EQ. 2) THEN + NBBUCK = 2*N + ALLOCATE( HEAD ( 0: NBBUCK + 1), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = NBBUCK+2 + RETURN + ENDIF + IF(COMPRESS .GE. 1) THEN + DO I=L1,L1-1+KEEP(93)/2 + IW(I) = 2 + ENDDO + DO I=L1+KEEP(93)/2,L1+NCMP-1 + IW(I) = 1 + ENDDO + ELSE + IW(L1) = -1 + ENDIF + IF(COMPRESS .LE. 1) THEN + CALL MUMPS_337(NCMP, NBBUCK, LLIW, IW(L2), + & IWFR, PTRAR(1,2), + & IW(1), IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3), HEAD) + ELSE + IF(PROK) WRITE(MP,'(A)') + & ' Constrained Ordering based on AMF' + CALL MUMPS_560(NCMP, NBBUCK, LLIW, IW(L2), + & IWFR, PTRAR(1,2), + & IW(1), IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3), HEAD, + & NFSIZ, FRERE) + ENDIF + DEALLOCATE(HEAD) + ELSEIF (IORD .EQ. 6) THEN + ALLOCATE( HEAD ( N ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = N + RETURN + ENDIF + THRESH = 1 + IVersion = 2 + IF(COMPRESS .EQ. 1) THEN + DO I=L1,L1-1+KEEP(93)/2 + IW(I) = 2 + ENDDO + DO I=L1+KEEP(93)/2,L1+NCMP-1 + IW(I) = 1 + ENDDO + TOTEL = KEEP(93)+KEEP(94) + ELSE + IW(L1) = -1 + TOTEL = N + ENDIF + CALL MUMPS_421(TOTEL,IVersion, THRESH, HEAD, + & NCMP, LLIW, IW(L2), IWFR, PTRAR(1,2), IW(1), + & IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3)) + DEALLOCATE(HEAD) + ELSE + CALL MUMPS_197(NCMP, LLIW, IW(L2), IWFR, PTRAR(1,2), + & IW(1), IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3)) + ENDIF + ENDIF + IF(COMPRESS .GE. 1) THEN + CALL SMUMPS_550(N,NCMP,KEEP(94),KEEP(93), + & PIV,IKEEP(1,1),IKEEP(1,2)) + COMPRESS = -1 + ENDIF + ENDIF +#if defined(metis) || defined(parmetis) + IF (IORD.EQ.5) THEN + IF (PROK) THEN + WRITE(MP,'(A)') ' Ordering based on METIS ' + ENDIF + NUMFLAG = 1 + OPT_METIS_SIZE = 8 + ALLOCATE( OPTIONS_METIS (OPT_METIS_SIZE ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = OPT_METIS_SIZE + RETURN + ENDIF + OPTIONS_METIS(1) = 0 + IF (COMPRESS .EQ. 1) THEN + DO I=1,KEEP(93)/2 + FILS(I) = 2 + ENDDO + DO I=KEEP(93)/2+1,NCMP + FILS(I) = 1 + ENDDO + CALL METIS_NODEWND(NCMP, IW(L2), IW(1),FILS, + & NUMFLAG, OPTIONS_METIS, + & IKEEP(1,2), IKEEP(1,1) ) + ELSE + CALL METIS_NODEND(NCMP, IW(L2), IW(1), NUMFLAG, + & OPTIONS_METIS, + & IKEEP(1,2), IKEEP(1,1) ) + ENDIF + DEALLOCATE (OPTIONS_METIS) + IF ( COMPRESS_SCHUR ) THEN + CALL SMUMPS_622( + & N, NCMP, IKEEP(1,1),IKEEP(1,2), + & LISTVAR_SCHUR, SIZE_SCHUR, FILS) + COMPRESS = -1 + ENDIF + IF (COMPRESS .EQ. 1) THEN + CALL SMUMPS_550(N,NCMP,KEEP(94), + & KEEP(93),PIV,IKEEP(1,1),IKEEP(1,2)) + COMPRESS = -1 + ENDIF + ENDIF +#endif + IF (PROK) THEN + IF (IORD.EQ.1) THEN + WRITE(MP,'(A)') ' Ordering given is used' + ENDIF + ENDIF + IF ((IORD.EQ.1) + & ) THEN + DO K=1,N + PTRAR(K,1) = 0 + ENDDO + DO K=1,N + IF ((IKEEP(K,1).LE.0).OR.(IKEEP(K,1).GT.N)) + & GO TO 40 + IF (PTRAR(IKEEP(K,1),1).EQ.1) THEN + GOTO 40 + ELSE + PTRAR(IKEEP(K,1),1) = 1 + ENDIF + ENDDO + ENDIF + IF (IORD.EQ.1 .OR. IORD.EQ.5 .OR. COMPRESS.EQ.-1) THEN + IF (KEEP(106)==1) THEN + IF ( COMPRESS .EQ. -1 ) THEN + CALL SMUMPS_351(N,NZ,IRN, ICN, IW(1), LLIW, + & IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, KEEP(50), + & MedDens, NBQD, AvgDens) + INFO(8) = symmetry + ENDIF + COMPRESS = 0 + ALLOCATE( HEAD ( 2*N ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = 2*N + RETURN + ENDIF + THRESH = -1 + IF (KEEP(60) == 0) THEN + ITEMP = 0 + ELSE + ITEMP = SIZE_SCHUR + IF (KEEP(60)==1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSE + KEEP(38) = LISTVAR_SCHUR(1) + ENDIF + ENDIF + AGG6 =.TRUE. + CALL MUMPS_422(THRESH, HEAD, + & N, LLIW, IW(L2), IWFR, PTRAR(1,2), IW, + & IW(L1), HEAD(N+1), + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), PTRAR, PTRAR(1,3), + & IKEEP(1,1), LISTVAR_SCHUR, ITEMP, AGG6) + DEALLOCATE(HEAD) + ELSE + CALL SMUMPS_198(N, NZ, IRN, ICN, IKEEP, IW(1), + & LLIW, IW(L2), + & PTRAR(1,2), IW(L1), IWFR, + & INFO(1),INFO(2), KEEP(11), MP) + IF (KEEP(60) .EQ. 0) THEN + ITEMP = 0 + CALL SMUMPS_199(N, IW(L2), IW, LLIW, IWFR, IKEEP, + & IKEEP(1,2), IW(L1), + & PTRAR, NCMPA, ITEMP) + ELSE + CALL SMUMPS_199(N, IW(L2), IW, LLIW, IWFR, IKEEP, + & IKEEP(1,2), IW(L1), + & PTRAR, NCMPA, SIZE_SCHUR) + IF (KEEP(60) .EQ. 1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSE + KEEP(38) = LISTVAR_SCHUR(1) + ENDIF + ENDIF + ENDIF + ENDIF +#if defined(OLDDFS) + CALL SMUMPS_200 + & (N, IW(L2), IW(L1), IKEEP(1,1), IKEEP(1,2), IKEEP(1,3), + & NFSIZ, INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, KEEP(60)) +#else + CALL SMUMPS_557 + & (N, IW(L2), IW(L1), IKEEP(1,1), IKEEP(1,2), IKEEP(1,3), + & NFSIZ, PTRAR, INFO(6), FILS, FRERE, + & PTRAR(1,3), NEMIN, PTRAR(1,4), KEEP(60), + & KEEP(20),KEEP(38),PTRAR(1,2),KEEP(104),IW(1),KEEP(50), + & ICNTL(13), KEEP(37), NSLAVES, KEEP(250).EQ.1) +#endif + IF (KEEP(60).NE.0) THEN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO WHILE (IN.GT.0) + IN = FILS (IN) + END DO + IFSON = -IN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO I=2,SIZE_SCHUR + FILS(IN) = LISTVAR_SCHUR (I) + IN = FILS(IN) + FRERE (IN) = N+1 + ENDDO + FILS(IN) = -IFSON + ENDIF + CALL SMUMPS_201(IKEEP(1,2), + & PTRAR(1,3), INFO(6), + & INFO(5), KEEP(2), KEEP(50), + & KEEP(101),KEEP(108),KEEP(5), + & KEEP(6), KEEP(226), KEEP(253)) + IF ( KEEP(53) .NE. 0 ) THEN + CALL MUMPS_209( N, FRERE, FILS, NFSIZ, KEEP(20) ) + END IF + IF ( (KEEP(48) == 4 .AND. KEEP8(21).GT.0_8) + & .OR. + & (KEEP (48)==5 .AND. KEEP8(21) .GT. 0_8 ) + & .OR. + & (KEEP(24).NE.0.AND.KEEP8(21).GT.0_8) ) THEN + CALL SMUMPS_510(KEEP8(21), KEEP(2), + & KEEP(48), KEEP(50), NSLAVES) + END IF + IF (KEEP(210).LT.0.OR.KEEP(210).GT.2) KEEP(210)=0 + IF (KEEP(210).EQ.0.AND.KEEP(201).GT.0) KEEP(210)=1 + IF (KEEP(210).EQ.0.AND.KEEP(201).EQ.0) KEEP(210)=2 + IF (KEEP(210).EQ.2) KEEP8(79)=huge(KEEP8(79)) + IF (KEEP(210).EQ.1.AND.KEEP8(79).LE.0_8) THEN + IF ( huge(KEEP8(79)) / K79REF + 1_8 .GE. int(NSLAVES,8) ) THEN + KEEP8(79)=huge(KEEP8(79)) + ELSE + KEEP8(79)=K79REF * int(NSLAVES,8) + ENDIF + ENDIF + IF ( (KEEP(79).EQ.0).OR.(KEEP(79).EQ.2).OR. + & (KEEP(79).EQ.3).OR.(KEEP(79).EQ.5).OR. + & (KEEP(79).EQ.6) + & ) THEN + IF (KEEP(210).EQ.1) THEN + SPLITROOT = .FALSE. + IF ( KEEP(62).GE.1) THEN + CALL SMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG,INFO(1),INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + ENDIF + ENDIF + SPLITROOT = ((ICNTL(13).GT.0 .AND. NSLAVES.GT.ICNTL(13)) .OR. + & ICNTL(13).EQ.-1 ) + & .AND. (KEEP(60).EQ.0) + IF (SPLITROOT) THEN + CALL SMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG,INFO(1),INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (K.GT.0) WRITE (MP,99997) (IKEEP(I,1),I=1,K) + IF (K.GT.0) WRITE (MP,99991) (IKEEP(I,2),I=1,K) + IF (K.GT.0) WRITE (MP,99990) (IKEEP(I,3),I=1,K) + IF (K.GT.0) WRITE (MP,99986) (PTRAR(I,1),I=1,K) + IF (K.GT.0) WRITE (MP,99985) (PTRAR(I,2),I=1,K) + IF (K.GT.0) WRITE (MP,99984) (PTRAR(I,3),I=1,K) + IF (K.GT.0) WRITE (MP,99987) (NFSIZ(I),I=1,K) + IF (K.GT.0) WRITE (MP,99989) (FILS(I),I=1,K) + IF (K.GT.0) WRITE (MP,99988) (FRERE(I),I=1,K) + ENDIF + GO TO 90 + 40 INFO(1) = -4 + INFO(2) = K + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99996) INFO(1) + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99982) INFO(2) + GOTO 90 + 90 CONTINUE + DEALLOCATE(IW) + RETURN +99999 FORMAT (/'Entering analysis phase with ...'/ + & ' N NZ LIW INFO(1)'/, + & 9X, I8, I11, I12, I14) +99998 FORMAT ('Matrix entries: IRN() ICN()'/ + & (I12, I7, I12, I7, I12, I7)) +99997 FORMAT ('IKEEP(.,1)=', 10I6/(12X, 10I6)) +99996 FORMAT (/'** Error return ** from Analysis * INFO(1)=', I3) +99991 FORMAT ('IKEEP(.,2)=', 10I6/(12X, 10I6)) +99990 FORMAT ('IKEEP(.,3)=', 10I6/(12X, 10I6)) +99989 FORMAT ('FILS (.) =', 10I6/(12X, 10I6)) +99988 FORMAT ('FRERE(.) =', 10I6/(12X, 10I6)) +99987 FORMAT ('NFSIZ(.) =', 10I6/(12X, 10I6)) +99986 FORMAT ('PTRAR(.,1)=', 10I6/(12X, 10I6)) +99985 FORMAT ('PTRAR(.,2)=', 10I6/(12X, 10I6)) +99984 FORMAT ('PTRAR(.,3)=', 10I6/(12X, 10I6)) +99982 FORMAT ('Error in permutation array KEEP INFO(2)=', I3) + END SUBROUTINE SMUMPS_195 + SUBROUTINE SMUMPS_199(N,IPE,IW, LW, IWFR, IPS, IPV, NV, FLAG, + & NCMPA, SIZE_SCHUR) + INTEGER N,LW,IWFR,NCMPA,SIZE_SCHUR + INTEGER FLAG(N) + INTEGER IPS(N), IPV(N) + INTEGER IW(LW), NV(N), IPE(N) + INTEGER I,J,ML,MS,ME,IP,MINJS,IE,KDUMMY,JP + INTEGER LN,JP1,JS,LWFR,JP2,JE + DO 10 I=1,N + FLAG(I) = 0 + NV(I) = 0 + J = IPS(I) + IPV(J) = I + 10 CONTINUE + NCMPA = 0 + DO 100 ML=1,N-SIZE_SCHUR + MS = IPV(ML) + ME = MS + FLAG(MS) = ME + IP = IWFR + MINJS = N + IE = ME + DO 70 KDUMMY=1,N + JP = IPE(IE) + LN = 0 + IF (JP.LE.0) GO TO 60 + LN = IW(JP) + DO 50 JP1=1,LN + JP = JP + 1 + JS = IW(JP) + IF (FLAG(JS).EQ.ME) GO TO 50 + FLAG(JS) = ME + IF (IWFR.LT.LW) GO TO 40 + IPE(IE) = JP + IW(JP) = LN - JP1 + CALL SMUMPS_194(N, IPE, IW, IP-1, LWFR,NCMPA) + JP2 = IWFR - 1 + IWFR = LWFR + IF (IP.GT.JP2) GO TO 30 + DO 20 JP=IP,JP2 + IW(IWFR) = IW(JP) + IWFR = IWFR + 1 + 20 CONTINUE + 30 IP = LWFR + JP = IPE(IE) + 40 IW(IWFR) = JS + MINJS = min0(MINJS,IPS(JS)+0) + IWFR = IWFR + 1 + 50 CONTINUE + 60 IPE(IE) = -ME + JE = NV(IE) + NV(IE) = LN + 1 + IE = JE + IF (IE.EQ.0) GO TO 80 + 70 CONTINUE + 80 IF (IWFR.GT.IP) GO TO 90 + IPE(ME) = 0 + NV(ME) = 1 + GO TO 100 + 90 MINJS = IPV(MINJS) + NV(ME) = NV(MINJS) + NV(MINJS) = ME + IW(IWFR) = IW(IP) + IW(IP) = IWFR - IP + IPE(ME) = IP + IWFR = IWFR + 1 + 100 CONTINUE + IF (SIZE_SCHUR == 0) RETURN + DO ML = N-SIZE_SCHUR+1,N + ME = IPV(ML) + IE = ME + DO KDUMMY=1,N + JP = IPE(IE) + LN = 0 + IF (JP.LE.0) GO TO 160 + LN = IW(JP) + 160 IPE(IE) = -IPV(N-SIZE_SCHUR+1) + JE = NV(IE) + NV(IE) = LN + 1 + IE = JE + IF (IE.EQ.0) GO TO 190 + ENDDO + 190 NV(ME) = 0 + IPE(ME) = -IPV(N-SIZE_SCHUR+1) + ENDDO + ME = IPV(N-SIZE_SCHUR+1) + IPE(ME) = 0 + NV(ME) = SIZE_SCHUR + RETURN + END SUBROUTINE SMUMPS_199 + SUBROUTINE SMUMPS_198(N, NZ, IRN, ICN, PERM, + & IW, LW, IPE, IQ, FLAG, + & IWFR, IFLAG, IERROR, IOVFLO, MP) + INTEGER N,NZ,LW,IWFR,IFLAG,IERROR + INTEGER PERM(N) + INTEGER IQ(N) + INTEGER IRN(NZ), ICN(NZ) + INTEGER IPE(N), IW(LW), FLAG(N) + INTEGER MP + INTEGER IOVFLO + INTEGER I,J,K,LBIG,L,ID,IN,LEN,JDUMMY,K1,K2 + IERROR = 0 + DO 10 I=1,N + IQ(I) = 0 + 10 CONTINUE + DO 80 K=1,NZ + I = IRN(K) + J = ICN(K) + IW(K) = -I + IF (I.EQ.J) GOTO 40 + IF (I.GT.J) GOTO 30 + IF (I.GE.1 .AND. J.LE.N) GO TO 60 + GO TO 50 + 30 IF (J.GE.1 .AND. I.LE.N) GO TO 60 + GO TO 50 + 40 IW(K) = 0 + IF (I.GE.1 .AND. I.LE.N) GO TO 80 + 50 IERROR = IERROR + 1 + IW(K) = 0 + IF (IERROR.LE.1 .AND. MP.GT.0) WRITE (MP,99999) + IF (IERROR.LE.10 .AND. MP.GT.0) WRITE (MP,99998) K, I, J + GO TO 80 + 60 IF (PERM(J).GT.PERM(I)) GO TO 70 + IQ(J) = IQ(J) + 1 + GO TO 80 + 70 IQ(I) = IQ(I) + 1 + 80 CONTINUE + IF (IERROR.GE.1) THEN + IF (mod(IFLAG,2) .EQ. 0) IFLAG = IFLAG+1 + ENDIF + IWFR = 1 + LBIG = 0 + DO 100 I=1,N + L = IQ(I) + LBIG = max0(L,LBIG) + IWFR = IWFR + L + IPE(I) = IWFR - 1 + 100 CONTINUE + DO 140 K=1,NZ + I = -IW(K) + IF (I.LE.0) GO TO 140 + L = K + IW(K) = 0 + DO 130 ID=1,NZ + J = ICN(L) + IF (PERM(I).LT.PERM(J)) GO TO 110 + L = IPE(J) + IPE(J) = L - 1 + IN = IW(L) + IW(L) = I + GO TO 120 + 110 L = IPE(I) + IPE(I) = L - 1 + IN = IW(L) + IW(L) = J + 120 I = -IN + IF (I.LE.0) GO TO 140 + 130 CONTINUE + 140 CONTINUE + K = IWFR - 1 + L = K + N + IWFR = L + 1 + DO 170 I=1,N + FLAG(I) = 0 + J = N + 1 - I + LEN = IQ(J) + IF (LEN.LE.0) GO TO 160 + DO 150 JDUMMY=1,LEN + IW(L) = IW(K) + K = K - 1 + L = L - 1 + 150 CONTINUE + 160 IPE(J) = L + L = L - 1 + 170 CONTINUE + IF (LBIG.GE.IOVFLO) GO TO 190 + DO 180 I=1,N + K = IPE(I) + IW(K) = IQ(I) + IF (IQ(I).EQ.0) IPE(I) = 0 + 180 CONTINUE + GO TO 230 + 190 IWFR = 1 + DO 220 I=1,N + K1 = IPE(I) + 1 + K2 = IPE(I) + IQ(I) + IF (K1.LE.K2) GO TO 200 + IPE(I) = 0 + GO TO 220 + 200 IPE(I) = IWFR + IWFR = IWFR + 1 + DO 210 K=K1,K2 + J = IW(K) + IF (FLAG(J).EQ.I) GO TO 210 + IW(IWFR) = J + IWFR = IWFR + 1 + FLAG(J) = I + 210 CONTINUE + K = IPE(I) + IW(K) = IWFR - K - 1 + 220 CONTINUE + 230 RETURN +99999 FORMAT (' *** WARNING MESSAGE FROM SMUMPS_198 ***' ) +99998 FORMAT (I6, ' NON-ZERO (IN ROW, I6, 11H AND COLUMN ', I6, + & ') IGNORED') + END SUBROUTINE SMUMPS_198 + SUBROUTINE SMUMPS_194(N, IPE, IW, LW, IWFR,NCMPA) + INTEGER N,LW,IWFR,NCMPA + INTEGER IPE(N) + INTEGER IW(LW) + INTEGER I,K1,LWFR,IR,K,K2 + NCMPA = NCMPA + 1 + DO 10 I=1,N + K1 = IPE(I) + IF (K1.LE.0) GO TO 10 + IPE(I) = IW(K1) + IW(K1) = -I + 10 CONTINUE + IWFR = 1 + LWFR = IWFR + DO 60 IR=1,N + IF (LWFR.GT.LW) GO TO 70 + DO 20 K=LWFR,LW + IF (IW(K).LT.0) GO TO 30 + 20 CONTINUE + GO TO 70 + 30 I = -IW(K) + IW(IWFR) = IPE(I) + IPE(I) = IWFR + K1 = K + 1 + K2 = K + IW(IWFR) + IWFR = IWFR + 1 + IF (K1.GT.K2) GO TO 50 + DO 40 K=K1,K2 + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + 40 CONTINUE + 50 LWFR = K2 + 1 + 60 CONTINUE + 70 RETURN + END SUBROUTINE SMUMPS_194 +#if defined(OLDDFS) + SUBROUTINE SMUMPS_200(N, IPE, NV, IPS, NE, NA, NFSIZ, + & NSTEPS, + & FILS, FRERE,NDD,NEMIN, KEEP60) + INTEGER N,NSTEPS + INTEGER NDD(N) + INTEGER FILS(N), FRERE(N) + INTEGER IPS(N), NE(N), NA(N), NFSIZ(N) + INTEGER IPE(N), NV(N) + INTEGER NEMIN, KEEP60 + INTEGER I,IF,IS,NR,NR1,INS,INL,INB,INF,INFS,INSW + INTEGER K,L,ISON,IN,INP,IFSON,INC,INO + INTEGER INOS,IB,IL + DO 10 I=1,N + IPS(I) = 0 + NE(I) = 0 + 10 CONTINUE + DO 20 I=1,N + IF (NV(I).GT.0) GO TO 20 + IF = -IPE(I) + IS = -IPS(IF) + IF (IS.GT.0) IPE(I) = IS + IPS(IF) = -I + 20 CONTINUE + NR = N + 1 + DO 50 I=1,N + IF (NV(I).LE.0) GO TO 50 + IF = -IPE(I) + IF (IF.NE.0) THEN + IS = -IPS(IF) + IF (IS.GT.0) IPE(I) = IS + IPS(IF) = -I + ELSE + NR = NR - 1 + NE(NR) = I + ENDIF + 50 CONTINUE + DO 999 I=1,N + FILS(I) = IPS(I) + 999 CONTINUE + NR1 = NR + INS = 0 + 1000 IF (NR1.GT.N) GO TO 1151 + INS = NE(NR1) + NR1 = NR1 + 1 + 1070 INL = FILS(INS) + IF (INL.LT.0) THEN + INS = -INL + GO TO 1070 + ENDIF + 1080 IF (IPE(INS).LT.0) THEN + INS = -IPE(INS) + FILS(INS) = 0 + GO TO 1080 + ENDIF + IF (IPE(INS).EQ.0) THEN + INS = 0 + GO TO 1000 + ENDIF + INB = IPE(INS) + IF (NV(INB).EQ.0) THEN + INS = INB + GO TO 1070 + ENDIF + IF (NV(INB).GE.NV(INS)) THEN + INS = INB + GO TO 1070 + ENDIF + INF = INB + 1090 INF = IPE(INF) + IF (INF.GT.0) GO TO 1090 + INF = -INF + INFS = -FILS(INF) + IF (INFS.EQ.INS) THEN + FILS(INF) = -INB + IPS(INF) = -INB + IPE(INS) = IPE(INB) + IPE(INB) = INS + INS = INB + GO TO 1070 + ENDIF + INSW = INFS + 1100 INFS = IPE(INSW) + IF (INFS.NE.INS) THEN + INSW = INFS + GO TO 1100 + ENDIF + IPE(INS) = IPE(INB) + IPE(INB) = INS + IPE(INSW)= INB + INS =INB + GO TO 1070 + 1151 CONTINUE + DO 51 I=1,N + FRERE(I) = IPE(I) + FILS(I) = IPS(I) + 51 CONTINUE + IS = 1 + I = 0 + IL = 0 + DO 160 K=1,N + IF (I.GT.0) GO TO 60 + I = NE(NR) + NE(NR) = 0 + NR = NR + 1 + IL = N + NA(N) = 0 + 60 DO 70 L=1,N + IF (IPS(I).GE.0) GO TO 80 + ISON = -IPS(I) + IPS(I) = 0 + I = ISON + IL = IL - 1 + NA(IL) = 0 + 70 CONTINUE + 80 IPS(I) = K + NE(IS) = NE(IS) + 1 + IF (NV(I).GT.0) GO TO 89 + IN = I + 81 IN = FRERE(IN) + IF (IN.GT.0) GO TO 81 + IF = -IN + IN = IF + 82 INL = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 82 + IFSON = -IN + FILS(INL) = I + IN = I + 83 INP = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 83 + IF (IFSON .EQ. I) GO TO 86 + FILS(INP) = -IFSON + IN = IFSON + 84 INC =IN + IN = FRERE(IN) + IF (IN.NE.I) GO TO 84 + FRERE(INC) = FRERE(I) + GO TO 120 + 86 IF (FRERE(I).LT.0) FILS(INP) = 0 + IF (FRERE(I).GT.0) FILS(INP) = -FRERE(I) + GO TO 120 + 89 IF (IL.LT.N) NA(IL+1) = NA(IL+1) + 1 + NA(IS) = NA(IL) + NDD(IS) = NV(I) + NFSIZ(I) = NV(I) + IF (NA(IS).LT.1) GO TO 110 + IF ( (KEEP60.NE.0).AND. + & (NE(IS).EQ.NDD(IS)) ) GOTO 110 + IF (NDD(IS-1)-NE(IS-1).EQ.NDD(IS)) GO TO 100 + IF ((NE(IS-1).GE.NEMIN).AND. + & (NE(IS).GE.NEMIN) ) GO TO 110 + IF (2*NE(IS-1)*(NDD(IS)-NDD(IS-1)+NE(IS-1)).GE. + & ((NDD(IS)+NE(IS-1))* + & (NDD(IS)+NE(IS-1))*NEMIN/100)) GO TO 110 + 100 NA(IS-1) = NA(IS-1) + NA(IS) - 1 + NDD(IS-1) = NDD(IS) + NE(IS-1) + NE(IS-1) = NE(IS) + NE(IS-1) + NE(IS) = 0 + IN=I + 101 INL = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 101 + IFSON = -IN + IN = IFSON + 102 INO = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 102 + FILS(INL) = INO + NFSIZ(I) = NDD(IS-1) + IN = INO + 103 INP = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 103 + INOS = -IN + IF (IFSON.EQ.INO) GO TO 107 + IN = IFSON + FILS(INP) = -IFSON + 105 INS = IN + IN = FRERE(IN) + IF (IN.NE.INO) GO TO 105 + IF (INOS.EQ.0) FRERE(INS) = -I + IF (INOS.NE.0) FRERE(INS) = INOS + IF (INOS.EQ.0) GO TO 109 + 107 IN = INOS + IF (IN.EQ.0) GO TO 109 + 108 INT = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 108 + FRERE(INT) = -I + 109 CONTINUE + GO TO 120 + 110 IS = IS + 1 + 120 IB = IPE(I) + IF (IB.LT.0) GOTO 150 + IF (IB.EQ.0) GOTO 140 + NA(IL) = 0 + 140 I = IB + GO TO 160 + 150 I = -IB + IL = IL + 1 + 160 CONTINUE + NSTEPS = IS - 1 + DO 170 I=1,N + K = FILS(I) + IF (K.GT.0) THEN + FRERE(K) = N + 1 + NFSIZ(K) = 0 + ENDIF + 170 CONTINUE + RETURN + END SUBROUTINE SMUMPS_200 +#else + SUBROUTINE SMUMPS_557(N, IPE, NV, IPS, NE, NA, NFSIZ, + & NODE, NSTEPS, + & FILS, FRERE, ND, NEMIN, SUBORD, KEEP60, + & KEEP20, KEEP38, NAMALG,NAMALGMAX, + & CUMUL,KEEP50, ICNTL13, KEEP37, NSLAVES, + & ALLOW_AMALG_TINY_NODES) + IMPLICIT NONE + INTEGER N, NSTEPS, KEEP60, KEEP20, KEEP38, KEEP50 + INTEGER ND(N), NFSIZ(N) + INTEGER IPE(N), FILS(N), FRERE(N), SUBORD(N) + INTEGER NV(N), IPS(N), NE(N), NA(N), NODE(N) + INTEGER NEMIN,AMALG_COUNT + INTEGER NAMALG(N),NAMALGMAX, CUMUL(N) + DOUBLE PRECISION ACCU, FLOPS_FATHER, FLOPS_SON, + & FLOPS_AVANT, FLOPS_APRES + INTEGER ICNTL13, KEEP37, NSLAVES + LOGICAL ALLOW_AMALG_TINY_NODES +#if defined(NOAMALGTOFATHER) +#else +#endif + INTEGER I,IF,IS,NR,INS + INTEGER K,L,ISON,IN,IFSON,INO + INTEGER INOS,IB,IL + INTEGER IPERM +#if defined(NOAMALGTOFATHER) + INTEGER INB,INF,INFS,INL,INSW,INT,NR1 +#else + INTEGER DADI + LOGICAL AMALG_TO_father_OK +#endif + AMALG_COUNT = 0 + DO 10 I=1,N + CUMUL(I)= 0 + IPS(I) = 0 + NE(I) = 0 + NODE(I) = 1 + SUBORD(I) = 0 + NAMALG(I) = 0 + 10 CONTINUE + FRERE(1:N) = IPE(1:N) + NR = N + 1 + DO 50 I=1,N + IF = -FRERE(I) + IF (NV(I).EQ.0) THEN + IF (SUBORD(IF).NE.0) SUBORD(I) = SUBORD(IF) + SUBORD(IF) = I + NODE(IF) = NODE(IF)+1 + ELSE + IF (IF.NE.0) THEN + IS = -IPS(IF) + IF (IS.GT.0) FRERE(I) = IS + IPS(IF) = -I + ELSE + NR = NR - 1 + NE(NR) = I + ENDIF + ENDIF + 50 CONTINUE +#if defined(NOAMALGTOFATHER) + DO 999 I=1,N + FILS(I) = IPS(I) + 999 CONTINUE + NR1 = NR + INS = 0 + 1000 IF (NR1.GT.N) GO TO 1151 + INS = NE(NR1) + NR1 = NR1 + 1 + 1070 INL = FILS(INS) + IF (INL.LT.0) THEN + INS = -INL + GO TO 1070 + ENDIF + 1080 IF (FRERE(INS).LT.0) THEN + INS = -FRERE(INS) + FILS(INS) = 0 + GO TO 1080 + ENDIF + IF (FRERE(INS).EQ.0) THEN + INS = 0 + GO TO 1000 + ENDIF + INB = FRERE(INS) + IF (NV(INB).GE.NV(INS)) THEN + INS = INB + GO TO 1070 + ENDIF + INF = INB + 1090 INF = FRERE(INF) + IF (INF.GT.0) GO TO 1090 + INF = -INF + INFS = -FILS(INF) + IF (INFS.EQ.INS) THEN + FILS(INF) = -INB + IPS(INF) = -INB + FRERE(INS) = FRERE(INB) + FRERE(INB) = INS + ELSE + INSW = INFS + 1100 INFS = FRERE(INSW) + IF (INFS.NE.INS) THEN + INSW = INFS + GO TO 1100 + ENDIF + FRERE(INS) = FRERE(INB) + FRERE(INB) = INS + FRERE(INSW)= INB + ENDIF + INS = INB + GO TO 1070 +#endif + DO 51 I=1,N + FILS(I) = IPS(I) + 51 CONTINUE + IS = 1 + I = 0 + IPERM = 1 + DO 160 K=1,N + AMALG_TO_father_OK=.FALSE. + IF (I.LE.0) THEN + IF (NR.GT.N) EXIT + I = NE(NR) + NE(NR) = 0 + NR = NR + 1 + IL = N + NA(N) = 0 + ENDIF + DO 70 L=1,N + IF (IPS(I).GE.0) EXIT + ISON = -IPS(I) + IPS(I) = 0 + I = ISON + IL = IL - 1 + NA(IL) = 0 + 70 CONTINUE +#if ! defined(NOAMALGTOFATHER) + DADI = -IPE(I) + IF ( (DADI.NE.0) .AND. + & ( + & (KEEP60.EQ.0).OR. + & ( (KEEP20.NE.DADI).AND.(KEEP38.NE.DADI) ) + & ) + & ) THEN + ACCU = + & ( dble(20000)* + & dble(NODE(I))*dble(NV(DADI)-NV(I)+NODE(I)) + & ) + & / + & ( dble(NV(DADI)+NODE(I))* + & dble(NV(DADI)+NODE(I)) ) + ACCU = ACCU + dble(CUMUL(I) ) + AMALG_TO_father_OK = ( (NODE(I).LE.NEMIN).OR. + & (NODE(DADI).LE.NEMIN) ) + AMALG_TO_father_OK = ( AMALG_TO_father_OK .AND. + & ( + & ( dble(2*(NODE(I)))* + & dble((NV(DADI)-NV(I)+NODE(I))) + & ) .LT. + & ( dble(NV(DADI)+NODE(I))* + & dble(NV(DADI)+NODE(I))*dble(NEMIN)/dble(100) + & ) + & ) ) + AMALG_TO_father_OK = ( AMALG_TO_father_OK .AND. + & ( ACCU .LE. dble(NEMIN)*dble(100) ) + & ) + IF (AMALG_TO_father_OK) THEN + CALL MUMPS_511(NV(I),NODE(I),NODE(I), + & KEEP50,1,FLOPS_SON) + CALL MUMPS_511(NV(DADI),NODE(DADI), + & NODE(DADI), + & KEEP50,1,FLOPS_FATHER) + FLOPS_AVANT = FLOPS_FATHER+FLOPS_SON + & + max(dble(200.0) * dble(NV(I)-NODE(I)) + & * dble(NV(I)-NODE(I)), + & dble(10000.0)) + CALL MUMPS_511(NV(DADI)+NODE(I), + & NODE(DADI)+NODE(I), + & NODE(DADI)+NODE(I), + & KEEP50,1,FLOPS_APRES) + IF(FLOPS_APRES .GT. FLOPS_AVANT) THEN + AMALG_TO_father_OK = .FALSE. + ENDIF + ENDIF + IF ( (NV(I).GT. 50*NV(DADI)).AND. (NSLAVES.GT.1) + & .AND. (ICNTL13.LE.0) + & .AND. (NV(I).GT. KEEP37) ) THEN + AMALG_TO_father_OK = .TRUE. + ENDIF + IF ( ALLOW_AMALG_TINY_NODES .AND. + & NODE(I) * 900 .LE. NV(DADI) - NAMALG(DADI)) THEN + IF ( NAMALG(DADI) < (NV(DADI)-NAMALG(DADI))/50 ) THEN + AMALG_TO_father_OK = .TRUE. + NAMALG(DADI) = NAMALG(DADI) + NODE(I) + ENDIF + ENDIF + AMALG_TO_father_OK = ( AMALG_TO_father_OK .OR. + & ( NV(I)-NODE(I).EQ.NV(DADI)) ) + IF (AMALG_TO_father_OK) THEN + CUMUL(DADI)=CUMUL(DADI)+nint(ACCU) + NAMALG(DADI) = NAMALG(DADI) + NAMALG(I) + AMALG_COUNT = AMALG_COUNT+1 + IN = DADI + 75 IF (SUBORD(IN).EQ.0) GOTO 76 + IN = SUBORD(IN) + GOTO 75 + 76 CONTINUE + SUBORD(IN) = I + NV(I) = 0 + IFSON = -FILS(DADI) + IF (IFSON.EQ.I) THEN + IF (FILS(I).LT.0) THEN + FILS(DADI) = FILS(I) + GOTO 78 + ELSE + IF (FRERE(I).GT.0) THEN + FILS(DADI) = -FRERE(I) + ELSE + FILS(DADI) = 0 + ENDIF + GOTO 90 + ENDIF + ENDIF + IN = IFSON + 77 INS = IN + IN = FRERE(IN) + IF (IN.NE.I) GOTO 77 + IF (FILS(I) .LT.0) THEN + FRERE(INS) = -FILS(I) + ELSE + FRERE(INS) = FRERE(I) + GOTO 90 + ENDIF + 78 CONTINUE + IN = -FILS(I) + 79 INO = IN + IN = FRERE(IN) + IF (IN.GT.0) GOTO 79 + FRERE(INO) = FRERE(I) + 90 CONTINUE + NODE(DADI) = NODE(DADI)+ NODE(I) + NV(DADI) = NV(DADI) + NODE(I) + NA(IL+1) = NA(IL+1) + NA(IL) + GOTO 120 + ENDIF + ENDIF +#endif + NE(IS) = NE(IS) + NODE(I) + IF (IL.LT.N) NA(IL+1) = NA(IL+1) + 1 + NA(IS) = NA(IL) + ND(IS) = NV(I) + NODE(I) = IS + IPS(I) = IPERM + IPERM = IPERM + 1 + IN = I + 777 IF (SUBORD(IN).EQ.0) GO TO 778 + IN = SUBORD(IN) + NODE(IN) = IS + IPS(IN) = IPERM + IPERM = IPERM + 1 + GO TO 777 + 778 IF (NA(IS).LE.0) GO TO 110 +#if defined(NOAMALGTOFATHER) + IF ( (KEEP60.NE.0).AND. + & (NE(IS).EQ.ND(IS)) ) GOTO 110 + IF (ND(IS-1)-NE(IS-1).EQ.ND(IS)) THEN + GO TO 100 + ENDIF + IF(NAMALG(IS-1) .GE. NAMALGMAX) THEN + GOTO 110 + ENDIF + IF ((NE(IS-1).GE.NEMIN).AND. + & (NE(IS).GE.NEMIN) ) GO TO 110 + IF (2*NE(IS-1)*(ND(IS)-ND(IS-1)+NE(IS-1)).GE. + & ((ND(IS)+NE(IS-1))* + & (ND(IS)+NE(IS-1))*NEMIN/100)) GO TO 110 + NAMALG(IS-1) = NAMALG(IS-1)+1 + 100 NA(IS-1) = NA(IS-1) + NA(IS) - 1 + ND(IS-1) = ND(IS) + NE(IS-1) + NE(IS-1) = NE(IS) + NE(IS-1) + NE(IS) = 0 + NODE(I) = IS-1 + IFSON = -FILS(I) + IN = IFSON + 102 INO = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 102 + NV(INO) = 0 + IN = I + 888 IF (SUBORD(IN).EQ.0) GO TO 889 + IN = SUBORD(IN) + GO TO 888 + 889 SUBORD(IN) = INO + INOS = -FILS(INO) + IF (IFSON.EQ.INO) THEN + FILS(I) = -INOS + GO TO 107 + ENDIF + IN = IFSON + 105 INS = IN + IN = FRERE(IN) + IF (IN.NE.INO) GO TO 105 + IF (INOS.EQ.0) THEN + FRERE(INS) = -I + GO TO 120 + ELSE + FRERE(INS) = INOS + ENDIF + 107 IN = INOS + IF (IN.EQ.0) GO TO 120 + 108 INT = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 108 + FRERE(INT) = -I + GO TO 120 +#endif + 110 IS = IS + 1 + 120 IB = FRERE(I) + IF (IB.GE.0) THEN + IF (IB.GT.0) NA(IL) = 0 + I = IB + ELSE + I = -IB + IL = IL + 1 + ENDIF + 160 CONTINUE + NSTEPS = IS - 1 + DO I=1, N + IF (NV(I).EQ.0) THEN + FRERE(I) = N+1 + NFSIZ(I) = 0 + ELSE + NFSIZ(I) = ND(NODE(I)) + IF (SUBORD(I) .NE.0) THEN + INOS = -FILS(I) + INO = I + DO WHILE (SUBORD(INO).NE.0) + IS = SUBORD(INO) + FILS(INO) = IS + INO = IS + END DO + FILS(INO) = -INOS + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_557 +#endif + SUBROUTINE SMUMPS_201(NE, ND, NSTEPS, + & MAXFR, MAXELIM, K50, MAXFAC, MAXNPIV, + & K5,K6,PANEL_SIZE,K253) + IMPLICIT NONE + INTEGER NSTEPS,MAXNPIV + INTEGER MAXFR, MAXELIM, K50, MAXFAC + INTEGER K5,K6,PANEL_SIZE,K253 + INTEGER NE(NSTEPS), ND(NSTEPS) + INTEGER ITREE, NFR, NELIM + INTEGER LKJIB + LKJIB = max(K5,K6) + MAXFR = 0 + MAXFAC = 0 + MAXELIM = 0 + MAXNPIV = 0 + PANEL_SIZE = 0 + DO ITREE=1,NSTEPS + NELIM = NE(ITREE) + NFR = ND(ITREE) + K253 + IF (NFR.GT.MAXFR) MAXFR = NFR + IF (NFR-NELIM.GT.MAXELIM) MAXELIM = NFR - NELIM + IF (NELIM .GT. MAXNPIV) THEN + IF(NFR .NE. NELIM) MAXNPIV = NELIM + ENDIF + IF (K50.EQ.0) THEN + MAXFAC = max(MAXFAC, (2*NFR - NELIM)*NELIM ) + PANEL_SIZE = max(PANEL_SIZE, NFR*(LKJIB+1)) + ELSE + MAXFAC = max(MAXFAC, NFR * NELIM) + PANEL_SIZE = max(PANEL_SIZE, NELIM*(LKJIB+1)) + PANEL_SIZE = max(PANEL_SIZE, (NFR-NELIM)*(LKJIB+1)) + ENDIF + END DO + RETURN + END SUBROUTINE SMUMPS_201 + SUBROUTINE SMUMPS_348( N, FILS, FRERE, + & NSTK, NA ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: N + INTEGER, INTENT(IN) :: FILS(N), FRERE(N) + INTEGER, INTENT(INOUT) :: NSTK(N), NA(N) + INTEGER NBROOT, NBLEAF, ILEAF, I, IN, ISON + NA = 0 + NSTK = 0 + NBROOT = 0 + ILEAF = 1 + DO 11 I=1,N + IF (FRERE(I).EQ. N+1) CYCLE + IF (FRERE(I).EQ.0) NBROOT = NBROOT + 1 + IN = I + 12 IN = FILS(IN) + IF (IN.GT.0) GO TO 12 + IF (IN.EQ.0) THEN + NA(ILEAF) = I + ILEAF = ILEAF + 1 + CYCLE + ENDIF + ISON = -IN + 13 NSTK(I) = NSTK(I) + 1 + ISON = FRERE(ISON) + IF (ISON.GT.0) GO TO 13 + 11 CONTINUE + NBLEAF = ILEAF-1 + IF (N.GT.1) THEN + IF (NBLEAF.GT.N-2) THEN + IF (NBLEAF.EQ.N-1) THEN + NA(N-1) = -NA(N-1)-1 + NA(N) = NBROOT + ELSE + NA(N) = -NA(N)-1 + ENDIF + ELSE + NA(N-1) = NBLEAF + NA(N) = NBROOT + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_348 + SUBROUTINE SMUMPS_203( N, NZ, MTRANS, PERM, + & id, ICNTL, INFO) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (SMUMPS_STRUC) :: id + INTEGER N, NZ, LIWG + INTEGER PERM(N) + INTEGER MTRANS + INTEGER ICNTL(40), INFO(40) + INTEGER allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: IW + REAL, ALLOCATABLE, DIMENSION(:) :: S2 + TARGET :: S2 + INTEGER LS2,LSC + INTEGER ICNTL64(10), INFO64(10) + INTEGER ICNTL_SYM_MWM(10),INFO_SYM_MWM(10) + REAL CNTL64(10) + INTEGER LDW, LDWMIN + INTEGER MPRINT,LP, MP, IPIW, LIW, LIWMIN + INTEGER JPERM + INTEGER NUMNZ, I, J, JPOS, K, NZREAL + INTEGER PLENR, IP, IRNW,RSPOS,CSPOS + LOGICAL PROK, IDENT, DUPPLI + INTEGER NZTOT, K50, KER_SIZE, NZER_DIAG, MTRANSLOC,RZ_DIAG + LOGICAL SCALINGLOC + INTEGER,POINTER,DIMENSION(:) :: ZERODIAG + INTEGER,POINTER,DIMENSION(:) :: STR_KER + INTEGER,POINTER,DIMENSION(:) :: MARKED + INTEGER,POINTER,DIMENSION(:) :: FLAG + INTEGER,POINTER,DIMENSION(:) :: PIV_OUT + REAL THEMIN, THEMAX, COLNORM,MAXDBL + REAL ZERO,TWO,ONE + PARAMETER(ZERO = 0.0E0,TWO = 2.0E0,ONE = 1.0E0) + MPRINT = ICNTL(3) + LP = ICNTL(1) + MP = ICNTL(2) + PROK = (MPRINT.GT.0) + IF (PROK) WRITE(MPRINT,101) + 101 FORMAT(/'****** Preprocessing of original matrix '/) + K50 = id%KEEP(50) + SCALINGLOC = .FALSE. + IF(id%KEEP(52) .EQ. -2) THEN + IF(.not.associated(id%A)) THEN + INFO(1) = -22 + INFO(2) = 4 + GOTO 500 + ELSE + SCALINGLOC = .TRUE. + ENDIF + ELSE IF(id%KEEP(52) .EQ. 77) THEN + SCALINGLOC = .TRUE. + IF(K50 .NE. 2) THEN + IF( MTRANS .NE. 5 .AND. MTRANS .NE. 6 + & .AND. MTRANS .NE. 7) THEN + SCALINGLOC = .FALSE. + IF (PROK) + & WRITE(MPRINT,*) 'Analysis: auto scaling set OFF' + ENDIF + ENDIF + IF(.not.associated(id%A)) THEN + SCALINGLOC = .FALSE. + IF (PROK) + & WRITE(MPRINT,*) 'Analysis: auto scaling set OFF' + ENDIF + ENDIF + IF(SCALINGLOC) THEN + IF (PROK) WRITE(MPRINT,*) + & 'Scaling will be computed during analysis' + ENDIF + MTRANSLOC = MTRANS + IF (MTRANS.LT.0 .OR. MTRANS.GT.7) GO TO 500 + IF (K50 .EQ. 0) THEN + IF(.NOT. SCALINGLOC .AND. MTRANS .EQ. 7) THEN + GO TO 500 + ENDIF + IF(SCALINGLOC) THEN + MTRANSLOC = 5 + ENDIF + ELSE + IF (MTRANS .EQ. 7) MTRANSLOC = 5 + ENDIF + IF(SCALINGLOC .AND. MTRANSLOC .NE. 5 .AND. + & MTRANSLOC .NE. 6 ) THEN + IF (PROK) WRITE(MPRINT,*) + & 'WARNING scaling required: set MTRANS option to 5' + MTRANSLOC = 5 + ENDIF + IF (N.EQ.1) THEN + MTRANS=0 + GO TO 500 + ENDIF + IF(K50 .EQ. 2) THEN + NZTOT = 2*NZ+N + ELSE + NZTOT = NZ + ENDIF + ZERODIAG => id%IS1(N+1:2*N) + STR_KER => id%IS1(2*N+1:3*N) + CALL SMUMPS_448(ICNTL64,CNTL64) + ICNTL64(1) = ICNTL(1) + ICNTL64(2) = ICNTL(2) + ICNTL64(3) = ICNTL(2) + ICNTL64(4) = -1 + IF (ICNTL(4).EQ.3) ICNTL64(4) = 0 + IF (ICNTL(4).EQ.4) ICNTL64(4) = 1 + ICNTL64(5) = -1 + IF (PROK) THEN + WRITE(MPRINT,'(A,I3)') + & 'Compute maximum matching (Maximum Transversal):', + & MTRANSLOC + IF (MTRANSLOC.EQ.1) + & WRITE(MPRINT,'(A,I3)')' ... JOB =',MTRANSLOC + IF (MTRANSLOC.EQ.2) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC,': BOTTLENECK THESIS' + IF (MTRANSLOC.EQ.3) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC,': BOTTLENECK SIMAX' + IF (MTRANSLOC.EQ.4) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC,': MAXIMIZE SUM DIAGIONAL' + IF (MTRANSLOC.EQ.5 .OR. MTRANSLOC.EQ.6) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC, + & ': MAXIMIZE PRODUCT DIAGONAL AND SCALE' + ENDIF + id%INFOG(23) = MTRANSLOC + CNTL64(2) = huge(CNTL64(2)) + IRNW = 1 + IP = IRNW + NZTOT + PLENR = IP + N + 1 + IPIW = PLENR + IF (MTRANSLOC.EQ.1) LIWMIN = 5*N + IF (MTRANSLOC.EQ.2) LIWMIN = 4*N + IF (MTRANSLOC.EQ.3) LIWMIN = 10*N + NZTOT + IF (MTRANSLOC.EQ.4) LIWMIN = 5*N + IF (MTRANSLOC.EQ.5) LIWMIN = 5*N + IF (MTRANSLOC.EQ.6) LIWMIN = 5*N + NZTOT + LIW = LIWMIN + LIWG = LIW + (NZTOT + N + 1) + ALLOCATE(IW(LIWG), stat=allocok) + IF (allocok .GT. 0 ) GOTO 410 + IF (MTRANSLOC.EQ.1) THEN + LDWMIN = N+3 + ENDIF + IF (MTRANSLOC.EQ.2) LDWMIN = max(N+NZTOT,N+3) + IF (MTRANSLOC.EQ.3) LDWMIN = max(NZTOT+1,N+3) + IF (MTRANSLOC.EQ.4) LDWMIN = 2*N + max(NZTOT,N+3) + IF (MTRANSLOC.EQ.5) LDWMIN = 3*N + NZTOT + IF (MTRANSLOC.EQ.6) LDWMIN = 4*N + NZTOT + LDW = LDWMIN + ALLOCATE(S2(LDW), stat=allocok) + IF(MTRANSLOC .NE. 1) LDW = LDW-NZTOT + RSPOS = NZTOT + CSPOS = RSPOS+N + IF (allocok .GT. 0 ) GOTO 430 + NZREAL = 0 + DO 5 J=1,N + IW(PLENR+J-1) = 0 + 5 CONTINUE + IF(K50 .EQ. 0) THEN + DO 10 K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1).AND. + & (I.LE.N).AND.(I.GE.1) ) THEN + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + NZREAL = NZREAL + 1 + ENDIF + 10 CONTINUE + ELSE + ZERODIAG = 0 + NZER_DIAG = N + RZ_DIAG = 0 + DO K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1).AND. + & (I.LE.N).AND.(I.GE.1) ) THEN + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + NZREAL = NZREAL + 1 + IF(I .NE. J) THEN + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + NZREAL = NZREAL + 1 + ELSE + IF(ZERODIAG(I) .EQ. 0) THEN + ZERODIAG(I) = K + IF(associated(id%A)) THEN + IF(abs(id%A(K)) .EQ. real(0.0E0)) THEN + RZ_DIAG = RZ_DIAG + 1 + ENDIF + ENDIF + NZER_DIAG = NZER_DIAG - 1 + ENDIF + ENDIF + ENDIF + ENDDO + IF(MTRANSLOC .GE. 4) THEN + DO I =1, N + IF(ZERODIAG(I) .EQ. 0) THEN + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + NZREAL = NZREAL + 1 + ENDIF + ENDDO + ENDIF + ENDIF + IW(IP) = 1 + DO 20 J=1,N + IW(IP+J) = IW(IP+J-1)+IW(PLENR+J-1) + 20 CONTINUE + DO 25 J=1, N + IW(PLENR+J-1 ) = IW(IP+J-1 ) + 25 CONTINUE + IF(K50 .EQ. 0) THEN + IF (MTRANSLOC.EQ.1) THEN + DO 30 K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + ENDIF + 30 CONTINUE + ELSE + IF ( .not.associated(id%A)) THEN + INFO(1) = -22 + INFO(2) = 4 + GOTO 500 + ENDIF + DO 35 K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + S2(JPOS) = abs(id%A(K)) + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + ENDIF + 35 CONTINUE + ENDIF + ELSE + IF (MTRANSLOC.EQ.1) THEN + DO K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + IF(I.NE.J) THEN + JPOS = IW(PLENR+I-1) + IW(IRNW+JPOS-1) = J + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + ENDIF + ENDIF + ENDDO + ELSE + IF ( .not.associated(id%A)) THEN + INFO(1) = -22 + INFO(2) = 4 + GOTO 500 + ENDIF + K = 1 + THEMIN = ZERO + DO + IF(THEMIN .NE. ZERO) EXIT + THEMIN = abs(id%A(K)) + K = K+1 + ENDDO + THEMAX = THEMIN + DO K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + S2(JPOS) = abs(id%A(K)) + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + IF(abs(id%A(K)) .GT. THEMAX) THEN + THEMAX = abs(id%A(K)) + ELSE IF(abs(id%A(K)) .LT. THEMIN + & .AND. abs(id%A(K)).GT. ZERO) THEN + THEMIN = abs(id%A(K)) + ENDIF + IF(I.NE.J) THEN + JPOS = IW(PLENR+I-1) + IW(IRNW+JPOS-1) = J + S2(JPOS) = abs(id%A(K)) + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + ENDIF + ENDIF + ENDDO + DO I =1, N + IF(ZERODIAG(I) .EQ. 0) THEN + JPOS = IW(PLENR+I-1) + IW(IRNW+JPOS-1) = I + S2(JPOS) = ZERO + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + ENDIF + ENDDO + CNTL64(2) = (log(THEMAX/THEMIN))*(real(N)) + & - log(THEMIN) + ONE + ENDIF + ENDIF + DUPPLI = .FALSE. + I = NZREAL + FLAG => id%IS1(3*N+1:4*N) + IF(MTRANSLOC.NE.1) THEN + CALL SMUMPS_563(N,NZREAL,IW(IP),IW(IRNW),S2, + & PERM,FLAG(1)) + ELSE + CALL SMUMPS_562(N,NZREAL,IW(IP),IW(IRNW), + & PERM,FLAG(1)) + ENDIF + IF(NZREAL .NE. I) DUPPLI = .TRUE. + LS2 = NZTOT + IF ( MTRANSLOC .EQ. 1 ) THEN + LS2 = 1 + LDW = 1 + ENDIF + CALL SMUMPS_559(MTRANSLOC ,N, N, NZREAL, + & IW(IP), IW(IRNW), S2(1), LS2, + & NUMNZ, PERM, LIW, IW(IPIW), LDW, S2(LS2+1), + & ICNTL64, CNTL64, INFO64) + IF (INFO64(1).LT.0) THEN + IF (LP.GT.0 .AND. ICNTL(4).GE.1) + & WRITE(LP,'(A,I5)') + & ' INTERNAL ERROR in MAXTRANS INFO(1)=',INFO64(1) + INFO(1) = -9964 + INFO(2) = INFO64(1) + GO TO 500 + ENDIF + IF (INFO64(1).GT.0) THEN + IF (MP.GT.0 .AND. ICNTL(4).GE.2) + & WRITE(MP,'(A,I5)') + & ' WARNING in MAXTRANS INFO(1)=',INFO64(1) + ENDIF + KER_SIZE = 0 + IF(K50 .EQ. 2) THEN + DO I=1,N + IF(ZERODIAG(I) .EQ. 0) THEN + IF(PERM(I) .EQ. I) THEN + KER_SIZE = KER_SIZE + 1 + PERM(I) = -I + STR_KER(KER_SIZE) = I + ENDIF + ENDIF + ENDDO + ENDIF + IF (NUMNZ.LT.N) GO TO 400 + IF(K50 .EQ. 0) THEN + IDENT = .TRUE. + IF (MTRANS .EQ. 0 ) GOTO 102 + DO 80 J=1,N + JPERM = PERM(J) + IW(PLENR+JPERM-1) = J + IF (JPERM.NE.J) IDENT = .FALSE. + 80 CONTINUE + IF(IDENT) THEN + MTRANS = 0 + ELSE + IF(MTRANS .EQ. 7) THEN + MTRANS = -9876543 + GOTO 102 + ENDIF + IF (PROK) WRITE(MPRINT,'(A)') + & ' ... Apply column permutation' + DO 100 K=1,NZ + J = id%JCN(K) + IF ((J.LE.0).OR.(J.GT.N)) GO TO 100 + id%JCN(K) = IW(PLENR+J-1) + 100 CONTINUE + IF (MP.GT.0 .AND. ICNTL(4).GE.2) + & WRITE(MP,'(/A)') + & ' WARNING input matrix data modified' + ENDIF + 102 CONTINUE + IF (SCALINGLOC) THEN + IF ( associated(id%COLSCA)) + & DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) + & DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in SMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of COLSCA' + GOTO 500 + ENDIF + ENDIF + ALLOCATE( id%ROWSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in SMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of ROWSCA' + GOTO 500 + ENDIF + ENDIF + id%KEEP(52) = -2 + id%KEEP(74) = 1 + MAXDBL = log(huge(MAXDBL)) + DO J=1,N + IF(S2(RSPOS+J) .GT. MAXDBL) THEN + S2(RSPOS+J) = ZERO + ENDIF + IF(S2(CSPOS+J) .GT. MAXDBL) THEN + S2(CSPOS+J)= ZERO + ENDIF + ENDDO + DO 105 J=1,N + id%ROWSCA(J) = exp(S2(RSPOS+J)) + IF(id%ROWSCA(J) .EQ. ZERO) THEN + id%ROWSCA(J) = ONE + ENDIF + IF ( MTRANS .EQ. -9876543 .OR. MTRANS.EQ. 0 ) THEN + id%COLSCA(J)= exp(S2(CSPOS+J)) + IF(id%COLSCA(J) .EQ. ZERO) THEN + id%COLSCA(J) = ONE + ENDIF + ELSE + id%COLSCA(IW(PLENR+J-1))= exp(S2(CSPOS+J)) + IF(id%COLSCA(IW(PLENR+J-1)) .EQ. ZERO) THEN + id%COLSCA(IW(PLENR+J-1)) = ONE + ENDIF + ENDIF + 105 CONTINUE + ENDIF + ELSE + IDENT = .FALSE. + IF(SCALINGLOC) THEN + IF ( associated(id%COLSCA)) DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in SMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of COLSCA' + GOTO 500 + ENDIF + ENDIF + ALLOCATE( id%ROWSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in SMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of ROWSCA' + GOTO 500 + ENDIF + ENDIF + id%KEEP(52) = -2 + id%KEEP(74) = 1 + MAXDBL = log(huge(MAXDBL)) + DO J=1,N + IF(S2(RSPOS+J)+S2(CSPOS+J) .GT. MAXDBL) THEN + S2(RSPOS+J) = ZERO + S2(CSPOS+J)= ZERO + ENDIF + ENDDO + DO J=1,N + IF(PERM(J) .GT. 0) THEN + id%ROWSCA(J) = + & exp((S2(RSPOS+J)+S2(CSPOS+J))/TWO) + IF(id%ROWSCA(J) .EQ. ZERO) THEN + id%ROWSCA(J) = ONE + ENDIF + id%COLSCA(J)= id%ROWSCA(J) + ENDIF + ENDDO + DO JPOS=1,KER_SIZE + I = STR_KER(JPOS) + COLNORM = ZERO + DO J = IW(IP+I-1),IW(IP+I) - 1 + IF ( PERM( IW( IRNW+J-1) ) > 0 ) THEN + COLNORM = max(COLNORM,S2(J)) + ENDIF + ENDDO + COLNORM = exp(COLNORM) + id%ROWSCA(I) = ONE / COLNORM + id%COLSCA(I) = id%ROWSCA(I) + ENDDO + ENDIF + IF(MTRANS .EQ. 7 .OR. id%KEEP(95) .EQ. 0) THEN + IF( (NZER_DIAG+RZ_DIAG) .LT. (N/10) + & .AND. id%KEEP(95) .EQ. 0) THEN + MTRANS = 0 + id%KEEP(95) = 1 + GOTO 390 + ELSE + IF(id%KEEP(95) .EQ. 0) THEN + IF(SCALINGLOC) THEN + id%KEEP(95) = 3 + ELSE + id%KEEP(95) = 2 + ENDIF + ENDIF + IF(MTRANS .EQ. 7) MTRANS = 5 + ENDIF + ENDIF + IF(MTRANS .EQ. 0) GOTO 390 + ICNTL_SYM_MWM = 0 + INFO_SYM_MWM = 0 + IF(MTRANS .EQ. 5 .OR. MTRANS .EQ. 6 .OR. + & MTRANS .EQ. 7) THEN + ICNTL_SYM_MWM(1) = 0 + ICNTL_SYM_MWM(2) = 1 + ELSE IF(MTRANS .EQ. 4) THEN + ICNTL_SYM_MWM(1) = 2 + ICNTL_SYM_MWM(2) = 1 + ELSE + ICNTL_SYM_MWM(1) = 0 + ICNTL_SYM_MWM(2) = 1 + ENDIF + MARKED => id%IS1(2*N+1:3*N) + FLAG => id%IS1(3*N+1:4*N) + PIV_OUT => id%IS1(4*N+1:5*N) + IF(MTRANSLOC .LT. 4) THEN + LSC = 1 + ELSE + LSC = 2*N + ENDIF + CALL SMUMPS_551( + & N, NZREAL, IW(IP), IW(IRNW), S2(1),LSC, PERM, + & ZERODIAG(1), + & ICNTL_SYM_MWM, S2(LSC+1),MARKED(1),FLAG(1), + & PIV_OUT(1), INFO_SYM_MWM) + IF(INFO_SYM_MWM(1) .NE. 0) THEN + WRITE(*,*) '** Error in SMUMPS_203' + RETURN + ENDIF + IF(INFO_SYM_MWM(3) .EQ. N) THEN + IDENT = .TRUE. + ELSEIF( (N-INFO_SYM_MWM(4)-INFO_SYM_MWM(3)) .GT. N/10 + & ) THEN + IDENT = .TRUE. + id%KEEP(95) = 1 + ELSE + DO I=1,N + PERM(I) = PIV_OUT(I) + ENDDO + ENDIF + id%KEEP(93) = INFO_SYM_MWM(4) + id%KEEP(94) = INFO_SYM_MWM(3) + IF (IDENT) MTRANS=0 + ENDIF + 390 IF(MTRANS .EQ. 0) THEN + id%KEEP(95) = 1 + IF (PROK) THEN + WRITE (MPRINT,'(A)') + & ' ... Column permutation not used' + ENDIF + ENDIF + GO TO 500 + 400 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) + & WRITE (LP,'(/A)') '** Error: Matrix is structurally singular' + INFO(1) = -6 + INFO(2) = NUMNZ + GOTO 500 + 410 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in SMUMPS_203' + WRITE (LP,'(A,I9)') + & '** Failure during allocation of INTEGER array of size ', + & LIWG + ENDIF + INFO(1) = -5 + INFO(2) = LIWG + GOTO 500 + 430 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in SMUMPS_203' + WRITE (LP,'(A)') '** Failure during allocation of S2' + ENDIF + INFO(1) = -5 + INFO(2) = LDW + 500 CONTINUE + IF (allocated(IW)) DEALLOCATE(IW) + IF (allocated(S2)) DEALLOCATE(S2) + RETURN + END SUBROUTINE SMUMPS_203 + SUBROUTINE SMUMPS_100 + &( MYID, COMM, KEEP,KEEP8, INFO, INFOG, RINFO, RINFOG, ICNTL ) + IMPLICIT NONE + INTEGER COMM, MYID, KEEP(500), INFO(40), ICNTL(40), INFOG(40) + INTEGER(8) KEEP8(150) + REAL RINFO(40), RINFOG(40) + INCLUDE 'mpif.h' + INTEGER MASTER, MPG + PARAMETER( MASTER = 0 ) + MPG = ICNTL(3) + IF ( MYID.eq.MASTER.and.MPG.GT.0) THEN + WRITE(MPG, 99992) INFO(1), INFO(2), + & KEEP8(109), KEEP8(111), INFOG(4), + & INFOG(5), KEEP(28), INFOG(32), INFOG(7), KEEP(23), ICNTL(7), + & KEEP(12), KEEP(56), KEEP(61), RINFOG(1) + IF (KEEP(95).GT.1) + & WRITE(MPG, 99993) KEEP(95) + IF (KEEP(54).GT.0) WRITE(MPG, 99994) KEEP(54) + IF (KEEP(60).GT.0) WRITE(MPG, 99995) KEEP(60) + IF (KEEP(253).GT.0) WRITE(MPG, 99996) KEEP(253) + ENDIF + RETURN +99992 FORMAT(/'Leaving analysis phase with ...'/ + & 'INFOG(1) =',I16/ + & 'INFOG(2) =',I16/ + & ' -- (20) Number of entries in factors (estim.) =',I16/ + & ' -- (3) Storage of factors (REAL, estimated) =',I16/ + & ' -- (4) Storage of factors (INT , estimated) =',I16/ + & ' -- (5) Maximum frontal size (estimated) =',I16/ + & ' -- (6) Number of nodes in the tree =',I16/ + & ' -- (32) Type of analysis effectively used =',I16/ + & ' -- (7) Ordering option effectively used =',I16/ + & 'ICNTL(6) Maximum transversal option =',I16/ + & 'ICNTL(7) Pivot order option =',I16/ + & 'Percentage of memory relaxation (effective) =',I16/ + & 'Number of level 2 nodes =',I16/ + & 'Number of split nodes =',I16/ + & 'RINFOG(1) Operations during elimination (estim)= ',1PD10.3) +99993 FORMAT('Ordering compressed/constrained (ICNTL(12)) =',I16) +99994 FORMAT('Distributed matrix entry format (ICNTL(18)) =',I16) +99995 FORMAT('Effective Schur option (ICNTL(19)) =',I16) +99996 FORMAT('Forward solution during factorization, NRHS =',I16) + END SUBROUTINE SMUMPS_100 + SUBROUTINE SMUMPS_97 + & ( N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, + & KEEP, KEEP8, SPLITROOT, MP, LDIAG, INFO1, INFO2 ) + IMPLICIT NONE + INTEGER N, NSTEPS, NSLAVES, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER FRERE( N ), FILS( N ), NFSIZ( N ) + LOGICAL SPLITROOT + INTEGER MP, LDIAG + INTEGER INFO1, INFO2 + INTEGER, DIMENSION(:), ALLOCATABLE :: IPOOL + INTEGER INODE, DEPTH, I, IBEG, IEND, IIPOOL, NROOT + INTEGER MAX_DEPTH, ISON, TOT_CUT, MAX_CUT, STRAT + INTEGER(8) :: K79 + INTEGER NFRONT, K82, allocok + K79 = KEEP8(79) + K82 = abs(KEEP(82)) + STRAT=KEEP(62) + IF (KEEP(210).EQ.1) THEN + MAX_DEPTH = 2*NSLAVES*K82 + STRAT = STRAT/4 + ELSE + IF (( NSLAVES .eq. 1 ).AND. (.NOT. SPLITROOT) ) RETURN + IF (NSLAVES.EQ.1) THEN + MAX_DEPTH = 1 + ELSE + MAX_DEPTH = int( log( real( NSLAVES - 1 ) ) + & / log(2.0E0) ) + ENDIF + ENDIF + ALLOCATE(IPOOL(NSTEPS+1), stat=allocok) + IF (allocok.GT.0) THEN + INFO1= -7 + INFO2= NSTEPS+1 + RETURN + ENDIF + NROOT = 0 + DO INODE = 1, N + IF ( FRERE(INODE) .eq. 0 ) THEN + NROOT = NROOT + 1 + IPOOL( NROOT ) = INODE + END IF + END DO + IBEG = 1 + IEND = NROOT + IIPOOL = NROOT + 1 + IF (SPLITROOT) MAX_DEPTH=1 + DO DEPTH = 1, MAX_DEPTH + DO I = IBEG, IEND + INODE = IPOOL( I ) + ISON = INODE + DO WHILE ( ISON .GT. 0 ) + ISON = FILS( ISON ) + END DO + ISON = - ISON + DO WHILE ( ISON .GT. 0 ) + IPOOL( IIPOOL ) = ISON + IIPOOL = IIPOOL + 1 + ISON = FRERE( ISON ) + END DO + END DO + IPOOL( IBEG ) = -IPOOL( IBEG ) + IBEG = IEND + 1 + IEND = IIPOOL - 1 + END DO + IPOOL( IBEG ) = -IPOOL( IBEG ) + TOT_CUT = 0 + IF (SPLITROOT) THEN + MAX_CUT = NROOT*max(K82,2) + INODE = abs(IPOOL(1)) + NFRONT = NFSIZ( INODE ) + K79 = max( + & int(NFRONT,8)*int(NFRONT,8)/(int(K82+1,8)*int(K82+1,8)), + & 1_8) + ELSE + MAX_CUT = 2 * NSLAVES + IF (KEEP(210).EQ.1) THEN + MAX_CUT = 4 * (MAX_CUT + 4) + ENDIF + ENDIF + DEPTH = -1 + DO I = 1, IIPOOL - 1 + INODE = IPOOL( I ) + IF ( INODE .LT. 0 ) THEN + INODE = -INODE + DEPTH = DEPTH + 1 + END IF + CALL SMUMPS_313 + & ( INODE, N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, + & KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, + & K79, SPLITROOT, MP, LDIAG ) + IF ( TOT_CUT > MAX_CUT ) EXIT + END DO + KEEP(61) = TOT_CUT + DEALLOCATE(IPOOL) + RETURN + END SUBROUTINE SMUMPS_97 + RECURSIVE SUBROUTINE SMUMPS_313 + & ( INODE, N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, KEEP,KEEP8, + & TOT_CUT, STRAT, DEPTH, K79, SPLITROOT, MP, LDIAG ) + IMPLICIT NONE + INTEGER(8) :: K79 + INTEGER INODE, N, NSTEPS, NSLAVES, KEEP(500), STRAT, + & DEPTH, TOT_CUT, MP, LDIAG + INTEGER(8) KEEP8(150) + INTEGER FRERE( N ), FILS( N ), NFSIZ( N ) + LOGICAL SPLITROOT + INTEGER I, IN, NPIV, NFRONT, NSLAVES_ESTIM + REAL WK_SLAVE, WK_MASTER + INTEGER INODE_SON, INODE_FATH, IN_SON, IN_FATH, IN_GRANDFATH + INTEGER NPIV_SON, NPIV_FATH + INTEGER NCB, NSLAVESMIN, NSLAVESMAX + INTEGER MUMPS_50, + & MUMPS_52 + EXTERNAL MUMPS_50, + & MUMPS_52 + IF ( (KEEP(210).EQ.1.AND.KEEP(60).EQ.0) .OR. + & (SPLITROOT) ) THEN + IF ( FRERE ( INODE ) .eq. 0 ) THEN + NFRONT = NFSIZ( INODE ) + NPIV = NFRONT + NCB = 0 + IF (int(NFRONT,8)*int(NFRONT,8).GT.K79) THEN + GOTO 333 + ENDIF + ENDIF + ENDIF + IF ( FRERE ( INODE ) .eq. 0 ) RETURN + NFRONT = NFSIZ( INODE ) + IN = INODE + NPIV = 0 + DO WHILE( IN > 0 ) + IN = FILS( IN ) + NPIV = NPIV + 1 + END DO + NCB = NFRONT - NPIV + IF ( (NFRONT - (NPIV/2)) .LE. KEEP(9)) RETURN + IF ((KEEP(50) == 0.and.int(NFRONT,8) * int(NPIV,8) > K79 ) .OR. + &(KEEP(50) .NE.0.and.int(NPIV,8) * int(NPIV,8) > K79 )) GOTO 333 + IF (KEEP(210).EQ.1) THEN + NSLAVESMIN = 1 + NSLAVESMAX = 64 + NSLAVES_ESTIM = 32+NSLAVES + ELSE + NSLAVESMIN = MUMPS_50 + & ( NSLAVES, KEEP(48), KEEP8(21), KEEP(50), + & NFRONT, NCB) + NSLAVESMAX = MUMPS_52 + & ( NSLAVES, KEEP(48), KEEP8(21), KEEP(50), + & NFRONT, NCB) + NSLAVES_ESTIM = max (1, + & nint( real(NSLAVESMAX-NSLAVESMIN)/real(3) ) + & ) + NSLAVES_ESTIM = min (NSLAVES_ESTIM, NSLAVES-1) + ENDIF + IF ( KEEP(50) .eq. 0 ) THEN + WK_MASTER = 0.6667E0 * + & real(NPIV)*real(NPIV)*real(NPIV) + + & real(NPIV)*real(NPIV)*real(NCB) + WK_SLAVE = real( NPIV ) * real( NCB ) * + & ( 2.0E0 * real(NFRONT) - real(NPIV) ) + & / real(NSLAVES_ESTIM) + ELSE + WK_MASTER = real(NPIV)*real(NPIV)*real(NPIV) / real(3) + WK_SLAVE = + & (real(NPIV)*real(NCB)*real(NFRONT)) + & / real(NSLAVES_ESTIM) + ENDIF + IF (KEEP(210).EQ.1) THEN + IF ( real( 100 + STRAT ) + & * WK_SLAVE / real(100) .GE. WK_MASTER ) RETURN + ELSE + IF ( real( 100 + STRAT * max( DEPTH-1, 1 ) ) + & * WK_SLAVE / real(100) .GE. WK_MASTER ) RETURN + ENDIF + 333 CONTINUE + IF (NPIV .LE. 1 ) RETURN + NSTEPS = NSTEPS + 1 + TOT_CUT = TOT_CUT + 1 + NPIV_SON = max(NPIV/2,1) + NPIV_FATH = NPIV - NPIV_SON + INODE_SON = INODE + IN_SON = INODE + DO I = 1, NPIV_SON - 1 + IN_SON = FILS( IN_SON ) + END DO + INODE_FATH = FILS( IN_SON ) + IF ( INODE_FATH .LT. 0 ) THEN + write(*,*) 'Error: INODE_FATH < 0 ', INODE_FATH + END IF + IN_FATH = INODE_FATH + DO WHILE ( FILS( IN_FATH ) > 0 ) + IN_FATH = FILS( IN_FATH ) + END DO + FRERE( INODE_FATH ) = FRERE( INODE_SON ) + FRERE( INODE_SON ) = - INODE_FATH + FILS ( IN_SON ) = FILS( IN_FATH ) + FILS ( IN_FATH ) = - INODE_SON + IN = FRERE( INODE_FATH ) + DO WHILE ( IN > 0 ) + IN = FRERE( IN ) + END DO + IF ( IN .eq. 0 ) GO TO 10 + IN = -IN + DO WHILE ( FILS( IN ) > 0 ) + IN = FILS( IN ) + END DO + IN_GRANDFATH = IN + IF ( FILS( IN_GRANDFATH ) .eq. - INODE_SON ) THEN + FILS( IN_GRANDFATH ) = -INODE_FATH + ELSE + IN = IN_GRANDFATH + IN = - FILS ( IN ) + DO WHILE ( FRERE( IN ) > 0 ) + IF ( FRERE( IN ) .eq. INODE_SON ) THEN + FRERE( IN ) = INODE_FATH + GOTO 10 + END IF + IN = FRERE( IN ) + END DO + WRITE(*,*) 'ERROR 2 in SPLIT NODE', + & IN_GRANDFATH, IN, FRERE(IN) + END IF + 10 CONTINUE + NFSIZ(INODE_SON) = NFRONT + NFSIZ(INODE_FATH) = NFRONT - NPIV_SON + KEEP(2) = max( KEEP(2), NFRONT - NPIV_SON ) + CALL SMUMPS_313 + & ( INODE_FATH, N, FRERE, FILS, NFSIZ, NSTEPS, + & NSLAVES, KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, + & K79, SPLITROOT, MP, LDIAG ) + IF (.NOT. SPLITROOT) THEN + CALL SMUMPS_313 + & ( INODE_SON, N, FRERE, FILS, NFSIZ, NSTEPS, + & NSLAVES, KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, + & K79, SPLITROOT, MP, LDIAG ) + ENDIF + RETURN + END SUBROUTINE SMUMPS_313 + SUBROUTINE SMUMPS_351 + & (N,NZ, IRN, ICN, IW, LW, IPE, LEN, + & IQ, FLAG, IWFR, + & NRORM, NIORM, IFLAG,IERROR, ICNTL, + & symmetry, SYM, MedDens, NBQD, AvgDens) + INTEGER N,NZ,LW,IFLAG,IERROR,NRORM,NIORM,IWFR + INTEGER symmetry, SYM + INTEGER MedDens, NBQD, AvgDens + INTEGER ICNTL(40) + INTEGER IRN(NZ), ICN(NZ) + INTEGER LEN(N) + INTEGER IPE(N+1) + INTEGER FLAG(N), IW(LW) + INTEGER IQ(N) + INTEGER MP, MPG + INTEGER I,K,J,N1,LAST,NDUP,K1,K2,L + INTEGER NBERR, THRESH + INTEGER NZOFFA, NDIAGA + REAL RSYM + INTRINSIC nint + MP = ICNTL(2) + MPG= ICNTL(3) + NIORM = 3*N + NDIAGA = 0 + IERROR = 0 + DO 10 I=1,N + IPE(I) = 0 + 10 CONTINUE + DO 50 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + IERROR = IERROR + 1 + ELSE + IF (I.NE.J) THEN + IPE(I) = IPE(I) + 1 + IPE(J) = IPE(J) + 1 + NIORM = NIORM + 1 + ELSE + NDIAGA = NDIAGA + 1 + ENDIF + ENDIF + 50 CONTINUE + NZOFFA = NIORM - 3*N + IF (IERROR.GE.1) THEN + NBERR = 0 + IF (mod(IFLAG,2) .EQ. 0) IFLAG = IFLAG+1 + IF ((MP.GT.0).AND.(ICNTL(4).GE.2)) THEN + WRITE (MP,99999) + DO 70 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + NBERR = NBERR + 1 + IF (NBERR.LE.10) THEN + IF (mod(K,10).GT.3 .OR. mod(K,10).EQ.0 .OR. + & (10.LE.K .AND. K.LE.20)) THEN + WRITE (MP,'(I8,A,I8,A,I8,A)') + & K,'th entry (in row',I,' and column',J,') ignored' + ELSE + IF (mod(K,10).EQ.1) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'st entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.2) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'nd entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.3) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'rd entry (in row',I,' and column',J,') ignored' + ENDIF + ELSE + GO TO 100 + ENDIF + ENDIF + 70 CONTINUE + ENDIF + ENDIF + 100 NRORM = NIORM - 2*N + IQ(1) = 1 + N1 = N - 1 + IF (N1.GT.0) THEN + DO 110 I=1,N1 + IQ(I+1) = IPE(I) + IQ(I) + 110 CONTINUE + ENDIF + LAST = max(IPE(N)+IQ(N)-1,IQ(N)) + FLAG(1:N) = 0 + IPE(1:N) = IQ(1:N) + IW(1:LAST) = 0 + IWFR = LAST + 1 + DO 200 K=1,NZ + I = IRN(K) + J = ICN(K) + IF (I.NE.J) THEN + IF (I.LT.J) THEN + IF ((I.GE.1).AND.(J.LE.N)) THEN + IW(IQ(I)) = -J + IQ(I) = IQ(I) + 1 + ENDIF + ELSE + IF ((J.GE.1).AND.(I.LE.N)) THEN + IW(IQ(J)) = -I + IQ(J) = IQ(J) + 1 + ENDIF + ENDIF + ENDIF + 200 CONTINUE + NDUP = 0 + DO 260 I=1,N + K1 = IPE(I) + K2 = IQ(I) -1 + IF (K1.GT.K2) THEN + LEN(I) = 0 + IQ(I) = 0 + ELSE + DO 240 K=K1,K2 + J = -IW(K) + IF (J.LE.0) GO TO 250 + L = IQ(J) + IQ(J) = L + 1 + IF (FLAG(J).EQ.I) THEN + NDUP = NDUP + 1 + IW(L) = 0 + IW(K) = 0 + ELSE + IW(L) = I + IW(K) = J + FLAG(J) = I + ENDIF + 240 CONTINUE + 250 IQ(I) = IQ(I) - IPE(I) + IF (NDUP.EQ.0) LEN(I) = IQ(I) + ENDIF + 260 CONTINUE + IF (NDUP.NE.0) THEN + IWFR = 1 + DO 280 I=1,N + IF (IQ(I).EQ.0) THEN + LEN(I) = 0 + IPE(I) = IWFR + GOTO 280 + ENDIF + K1 = IPE(I) + K2 = K1 + IQ(I) - 1 + L = IWFR + IPE(I) = IWFR + DO 270 K=K1,K2 + IF (IW(K).NE.0) THEN + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + ENDIF + 270 CONTINUE + LEN(I) = IWFR - L + 280 CONTINUE + ENDIF + IPE(N+1) = IPE(N) + LEN(N) + IWFR = IPE(N+1) + IF (SYM.EQ.0) THEN + RSYM = real(NDIAGA+2*NZOFFA - (IWFR-1))/ + & real(NZOFFA+NDIAGA) + symmetry = nint (100.0E0*RSYM) + IF (MPG .GT. 0) + & write(MPG,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + ELSE + symmetry = 100 + ENDIF + AvgDens = nint(real(IWFR-1)/real(N)) + THRESH = AvgDens*50 - AvgDens/10 + 1 + NBQD = 0 + IF (N.GT.2) THEN + IQ(1:N) = 0 + DO I= 1, N + K = max(LEN(I),1) + IQ(K) = IQ(K) + 1 + IF (K.GT.THRESH) NBQD = NBQD+1 + ENDDO + K = 0 + MedDens = 0 + DO WHILE (K .LT. (N/2)) + MedDens = MedDens + 1 + K = K+IQ(MedDens) + ENDDO + ELSE + MedDens = AvgDens + ENDIF + IF (MPG .GT. 0) + & write(MPG,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + RETURN +99999 FORMAT (/'*** Warning message from analysis routine ***') + END SUBROUTINE SMUMPS_351 + SUBROUTINE SMUMPS_701(N, SYM, NPROCS, IORD, + & symmetry,MedDens, NBQD, AvgDens, + & PROK, MP) + IMPLICIT NONE + INTEGER, intent(in) :: N, NPROCS, SYM + INTEGER, intent(in) :: symmetry,MedDens, NBQD, AvgDens, MP + LOGICAL, intent(in) :: PROK + INTEGER, intent(inout) :: IORD + INTEGER MAXQD + PARAMETER (MAXQD=2) + INTEGER SMALLSYM, SMALLUNS + PARAMETER (SMALLUNS=5000, SMALLSYM=10000) +#if ! defined(metis) && ! defined(parmetis) + IF ( IORD .EQ. 5 ) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: METIS not available. Ordering set to default.' + IORD = 7 + END IF +#endif +#if ! defined(pord) + IF ( IORD .EQ. 4 ) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: PORD not available. Ordering set to default.' + IORD = 7 + END IF +#endif +#if ! defined(scotch) && ! defined(ptscotch) + IF ( IORD .EQ. 3 ) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: SCOTCH not available. Ordering set to default.' + IORD = 7 + END IF +#endif + IF (IORD.EQ.7) THEN + IF (SYM.NE.0) THEN + IF ( N.LE.SMALLSYM ) THEN + IF (NBQD.GE.MAXQD) THEN + IORD = 6 + ELSE + IORD = 2 + ENDIF + ELSE + IF (NBQD.GE.MedDens*NPROCS) THEN + IORD = 6 + RETURN + ENDIF +#if defined(metis) || defined(parmetis) + IORD = 5 +#else +# if defined(scotch) || defined(ptscotch) + IORD = 3 +# else +# if defined(pord) + IORD = 4 +# else + IORD = 6 +# endif +# endif +#endif + ENDIF + ELSE + IF ( N.LE.SMALLUNS ) THEN + IF (NBQD.GE.MAXQD) THEN + IORD = 6 + ELSE + IORD = 2 + ENDIF + ELSE + IF (NBQD.GE.MedDens*NPROCS) THEN + IORD = 6 + RETURN + ENDIF +#if defined(metis) || defined(parmetis) + IORD = 5 +#else +# if defined(scotch) || defined(ptscotch) + IORD = 3 +# else +# if defined(pord) + IORD = 4 +# else + IORD = 6 +# endif +# endif +#endif + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_701 + SUBROUTINE SMUMPS_510 + & (KEEP821, KEEP2, KEEP48 ,KEEP50, NSLAVES) + IMPLICIT NONE + INTEGER NSLAVES, KEEP2, KEEP48, KEEP50 + INTEGER (8) :: KEEP821 + INTEGER(8) KEEP2_SQUARE, NSLAVES8 + NSLAVES8= int(NSLAVES,8) + KEEP2_SQUARE = int(KEEP2,8) * int(KEEP2,8) + KEEP821 = max(KEEP821*int(KEEP2,8),1_8) +#if defined(t3e) + KEEP821 = min(1500000_8, KEEP821) +#elif defined(SP_) + KEEP821 = min(3000000_8, KEEP821) +#else + KEEP821 = min(2000000_8, KEEP821) +#endif +#if defined(t3e) + IF (NSLAVES .GT. 64) THEN + KEEP821 = + & min(8_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ELSE + KEEP821 = + & min(4_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ENDIF +#else + IF (NSLAVES.GT.64) THEN + KEEP821 = + & min(6_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ELSE + KEEP821 = + & min(4_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ENDIF +#endif + IF (KEEP50 .EQ. 0 ) THEN + KEEP821 = max(KEEP821,(7_8*KEEP2_SQUARE / + & 4_8 / int(max(NSLAVES-1,1),8)) + int(KEEP2,8)) + ELSE + KEEP821 = max(KEEP821,(7_8*KEEP2_SQUARE / + & 4_8 / int(max(NSLAVES-1,1),8)) + int(KEEP2,8)) + ENDIF + IF (KEEP50 .EQ. 0 ) THEN +#if defined(t3e) + KEEP821 = max(KEEP821,200000_8) +#else + KEEP821 = max(KEEP821,300000_8) +#endif + ELSE +#if defined(t3e) + KEEP821 = max(KEEP821,40000_8) +#else + KEEP821 = max(KEEP821,80000_8) +#endif + ENDIF + KEEP821 = -KEEP821 + RETURN + END SUBROUTINE SMUMPS_510 + SUBROUTINE SMUMPS_559(JOB,M,N,NE, + & IP,IRN,A,LA,NUM,PERM,LIW,IW,LDW,DW, + & ICNTL,CNTL,INFO) + IMPLICIT NONE + INTEGER NICNTL, NCNTL, NINFO + PARAMETER (NICNTL=10, NCNTL=10, NINFO=10) + INTEGER JOB,M,N,NE,NUM,LIW,LDW + INTEGER IP(N+1),IRN(NE),PERM(M),IW(LIW) + INTEGER ICNTL(NICNTL),INFO(NINFO) + INTEGER LA + REAL A(LA) + REAL DW(LDW),CNTL(NCNTL) + INTEGER I,J,K,WARN1,WARN2,WARN4 + REAL FACT,ZERO,ONE,RINF,RINF2,RINF3 + PARAMETER (ZERO=0.0E+00,ONE=1.0E+0) + EXTERNAL SMUMPS_457,SMUMPS_444,SMUMPS_451, + & SMUMPS_452,SMUMPS_454 + INTRINSIC abs,log + RINF = CNTL(2) + RINF2 = huge(RINF2)/real(2*N) + RINF3 = 0.0E0 + WARN1 = 0 + WARN2 = 0 + WARN4 = 0 + IF (JOB.LT.1 .OR. JOB.GT.6) THEN + INFO(1) = -1 + INFO(2) = JOB + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'JOB',JOB + GO TO 99 + ENDIF + IF (M.LT.1 .OR. M.LT.N) THEN + INFO(1) = -2 + INFO(2) = M + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'M',M + GO TO 99 + ENDIF + IF (N.LT.1) THEN + INFO(1) = -2 + INFO(2) = N + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'N',N + GO TO 99 + ENDIF + IF (NE.LT.1) THEN + INFO(1) = -3 + INFO(2) = NE + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'NE',NE + GO TO 99 + ENDIF + IF (JOB.EQ.1) K = 4*N + M + IF (JOB.EQ.2) K = 2*N + 2*M + IF (JOB.EQ.3) K = 8*N + 2*M + NE + IF (JOB.EQ.4) K = 3*N + 2*M + IF (JOB.EQ.5) K = 3*N + 2*M + IF (JOB.EQ.6) K = 3*N + 2*M + NE + IF (LIW.LT.K) THEN + INFO(1) = -4 + INFO(2) = K + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9004) INFO(1),K + GO TO 99 + ENDIF + IF (JOB.GT.1) THEN + IF (JOB.EQ.2) K = M + IF (JOB.EQ.3) K = 1 + IF (JOB.EQ.4) K = 2*M + IF (JOB.EQ.5) K = N + 2*M + IF (JOB.EQ.6) K = N + 3*M + IF (LDW.LT.K) THEN + INFO(1) = -5 + INFO(2) = K + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9005) INFO(1),K + GO TO 99 + ENDIF + ENDIF + IF (ICNTL(5).EQ.0) THEN + DO 3 I = 1,M + IW(I) = 0 + 3 CONTINUE + DO 6 J = 1,N + DO 4 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (I.LT.1 .OR. I.GT.M) THEN + INFO(1) = -6 + INFO(2) = J + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9006) INFO(1),J,I + GO TO 99 + ENDIF + IF (IW(I).EQ.J) THEN + INFO(1) = -7 + INFO(2) = J + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9007) INFO(1),J,I + GO TO 99 + ELSE + IW(I) = J + ENDIF + 4 CONTINUE + 6 CONTINUE + ENDIF + IF (ICNTL(3).GE.0) THEN + IF (ICNTL(4).EQ.0 .OR. ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9020) JOB,M,N,NE + IF (ICNTL(4).EQ.0) THEN + WRITE(ICNTL(3),9021) (IP(J),J=1,min(10,N+1)) + WRITE(ICNTL(3),9022) (IRN(J),J=1,min(10,NE)) + IF (JOB.GT.1) WRITE(ICNTL(3),9023) (A(J),J=1,min(10,NE)) + ELSEIF (ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9021) (IP(J),J=1,N+1) + WRITE(ICNTL(3),9022) (IRN(J),J=1,NE) + IF (JOB.GT.1) WRITE(ICNTL(3),9023) (A(J),J=1,NE) + ENDIF + WRITE(ICNTL(3),9024) (ICNTL(J),J=1,NICNTL) + WRITE(ICNTL(3),9025) (CNTL(J),J=1,NCNTL) + ENDIF + ENDIF + DO 8 I=1,NINFO + INFO(I) = 0 + 8 CONTINUE + IF (JOB.EQ.1) THEN + DO 10 J = 1,N + IW(J) = IP(J+1) - IP(J) + 10 CONTINUE + CALL SMUMPS_457(M,N,IRN,NE,IP,IW(1),PERM,NUM, + & IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1)) + GO TO 90 + ENDIF + IF (JOB.EQ.2) THEN + DW(1) = max(ZERO,CNTL(1)) + CALL SMUMPS_444(M,N,NE,IP,IRN,A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(2*N+M+1),DW,RINF2) + GO TO 90 + ENDIF + IF (JOB.EQ.3) THEN + DO 20 K = 1,NE + IW(K) = IRN(K) + 20 CONTINUE + CALL SMUMPS_451(N,NE,IP,IW,A) + FACT = max(ZERO,CNTL(1)) + CALL SMUMPS_452(M,N,NE,IP,IW(1),A,PERM,NUM,IW(NE+1), + & IW(NE+N+1),IW(NE+2*N+1),IW(NE+3*N+1),IW(NE+4*N+1), + & IW(NE+5*N+1),IW(NE+5*N+M+1),FACT,RINF2) + GO TO 90 + ENDIF + IF (JOB.EQ.4) THEN + DO 50 J = 1,N + FACT = ZERO + DO 30 K = IP(J),IP(J+1)-1 + IF (abs(A(K)).GT.FACT) FACT = abs(A(K)) + 30 CONTINUE + IF(FACT .GT. RINF3) RINF3 = FACT + DO 40 K = IP(J),IP(J+1)-1 + A(K) = FACT - abs(A(K)) + 40 CONTINUE + 50 CONTINUE + DW(1) = max(ZERO,CNTL(1)) + DW(2) = RINF3 + IW(1) = JOB + CALL SMUMPS_454(M,N,NE,IP,IRN,A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1), + & DW(1),DW(M+1),RINF2) + GO TO 90 + ENDIF + IF (JOB.EQ.5 .or. JOB.EQ.6) THEN + RINF3=ONE + IF (JOB.EQ.5) THEN + DO 75 J = 1,N + FACT = ZERO + DO 60 K = IP(J),IP(J+1)-1 + IF (A(K).GT.FACT) FACT = A(K) + 60 CONTINUE + DW(2*M+J) = FACT + IF (FACT.NE.ZERO) THEN + FACT = log(FACT) + IF(FACT .GT. RINF3) RINF3=FACT + DO 70 K = IP(J),IP(J+1)-1 + IF (A(K).NE.ZERO) THEN + A(K) = FACT - log(A(K)) + IF(A(K) .GT. RINF3) RINF3=A(K) + ELSE + A(K) = FACT + RINF + ENDIF + 70 CONTINUE + ELSE + DO 71 K = IP(J),IP(J+1)-1 + A(K) = ONE + 71 CONTINUE + ENDIF + 75 CONTINUE + ENDIF + IF (JOB.EQ.6) THEN + DO 175 K = 1,NE + IW(3*N+2*M+K) = IRN(K) + 175 CONTINUE + DO 61 I = 1,M + DW(2*M+N+I) = ZERO + 61 CONTINUE + DO 63 J = 1,N + DO 62 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (A(K).GT.DW(2*M+N+I)) THEN + DW(2*M+N+I) = A(K) + ENDIF + 62 CONTINUE + 63 CONTINUE + DO 64 I = 1,M + IF (DW(2*M+N+I).NE.ZERO) THEN + DW(2*M+N+I) = 1.0E0/DW(2*M+N+I) + ENDIF + 64 CONTINUE + DO 66 J = 1,N + DO 65 K = IP(J),IP(J+1)-1 + I = IRN(K) + A(K) = DW(2*M+N+I) * A(K) + 65 CONTINUE + 66 CONTINUE + CALL SMUMPS_451(N,NE,IP,IW(3*N+2*M+1),A) + DO 176 J = 1,N + IF (IP(J).NE.IP(J+1)) THEN + FACT = A(IP(J)) + ELSE + FACT = ZERO + ENDIF + DW(2*M+J) = FACT + IF (FACT.NE.ZERO) THEN + FACT = log(FACT) + DO 170 K = IP(J),IP(J+1)-1 + IF (A(K).NE.ZERO) THEN + A(K) = FACT - log(A(K)) + IF(A(K) .GT. RINF3) RINF3=A(K) + ELSE + A(K) = FACT + RINF + ENDIF + 170 CONTINUE + ELSE + DO 171 K = IP(J),IP(J+1)-1 + A(K) = ONE + 171 CONTINUE + ENDIF + 176 CONTINUE + ENDIF + DW(1) = max(ZERO,CNTL(1)) + RINF3 = RINF3+ONE + DW(2) = RINF3 + IW(1) = JOB + IF (JOB.EQ.5) THEN + CALL SMUMPS_454(M,N,NE,IP,IRN,A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1), + & DW(1),DW(M+1),RINF2) + ENDIF + IF (JOB.EQ.6) THEN + CALL SMUMPS_454(M,N,NE,IP,IW(3*N+2*M+1),A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1), + & DW(1),DW(M+1),RINF2) + ENDIF + IF (JOB.EQ.6) THEN + DO 79 I = 1,M + IF (DW(2*M+N+I).NE.0.0E0) THEN + DW(I) = DW(I) + log(DW(2*M+N+I)) + ENDIF + 79 CONTINUE + ENDIF + IF (NUM.EQ.N) THEN + DO 80 J = 1,N + IF (DW(2*M+J).NE.ZERO) THEN + DW(M+J) = DW(M+J) - log(DW(2*M+J)) + ELSE + DW(M+J) = ZERO + ENDIF + 80 CONTINUE + ENDIF + FACT = 0.5E0*log(RINF2) + DO 86 I = 1,M + IF (DW(I).LT.FACT) GO TO 86 + WARN2 = 2 + GO TO 90 + 86 CONTINUE + DO 87 J = 1,N + IF (DW(M+J).LT.FACT) GO TO 87 + WARN2 = 2 + GO TO 90 + 87 CONTINUE + ENDIF + 90 IF (NUM.LT.N) WARN1 = 1 + IF (JOB.EQ.4 .OR. JOB.EQ.5 .OR. JOB.EQ.6) THEN + IF (CNTL(1).LT.ZERO) WARN4 = 4 + ENDIF + IF (INFO(1).EQ.0) THEN + INFO(1) = WARN1 + WARN2 + WARN4 + IF (INFO(1).GT.0 .AND. ICNTL(2).GT.0) THEN + WRITE(ICNTL(2),9010) INFO(1) + IF (WARN1.EQ.1) WRITE(ICNTL(2),9011) + IF (WARN2.EQ.2) WRITE(ICNTL(2),9012) + IF (WARN4.EQ.4) WRITE(ICNTL(2),9014) + ENDIF + ENDIF + IF (ICNTL(3).GE.0) THEN + IF (ICNTL(4).EQ.0 .OR. ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9030) (INFO(J),J=1,2) + WRITE(ICNTL(3),9031) NUM + IF (ICNTL(4).EQ.0) THEN + WRITE(ICNTL(3),9032) (PERM(J),J=1,min(10,M)) + IF (JOB.EQ.5 .OR. JOB.EQ.6) THEN + WRITE(ICNTL(3),9033) (DW(J),J=1,min(10,M)) + WRITE(ICNTL(3),9034) (DW(M+J),J=1,min(10,N)) + ENDIF + ELSEIF (ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9032) (PERM(J),J=1,M) + IF (JOB.EQ.5 .OR. JOB.EQ.6) THEN + WRITE(ICNTL(3),9033) (DW(J),J=1,M) + WRITE(ICNTL(3),9034) (DW(M+J),J=1,N) + ENDIF + ENDIF + ENDIF + ENDIF + 99 RETURN + 9001 FORMAT (' ****** Error in SMUMPS_443. INFO(1) = ',I2, + & ' because ',(A),' = ',I10) + 9004 FORMAT (' ****** Error in SMUMPS_443. INFO(1) = ',I2/ + & ' LIW too small, must be at least ',I8) + 9005 FORMAT (' ****** Error in SMUMPS_443. INFO(1) = ',I2/ + & ' LDW too small, must be at least ',I8) + 9006 FORMAT (' ****** Error in SMUMPS_443. INFO(1) = ',I2/ + & ' Column ',I8, + & ' contains an entry with invalid row index ',I8) + 9007 FORMAT (' ****** Error in SMUMPS_443. INFO(1) = ',I2/ + & ' Column ',I8, + & ' contains two or more entries with row index ',I8) + 9010 FORMAT (' ****** Warning from SMUMPS_443. INFO(1) = ',I2) + 9011 FORMAT (' - The matrix is structurally singular.') + 9012 FORMAT (' - Some scaling factors may be too large.') + 9014 FORMAT (' - CNTL(1) is negative and was treated as zero.') + 9020 FORMAT (' ****** Input parameters for SMUMPS_443:'/ + & ' JOB =',I10/' M =',I10/' N =',I10/' NE =',I10) + 9021 FORMAT (' IP(1:N+1) = ',8I8/(15X,8I8)) + 9022 FORMAT (' IRN(1:NE) = ',8I8/(15X,8I8)) + 9023 FORMAT (' A(1:NE) = ',4(1PD14.4)/(15X,4(1PD14.4))) + 9024 FORMAT (' ICNTL(1:10) = ',8I8/(15X,2I8)) + 9025 FORMAT (' CNTL(1:10) = ',4(1PD14.4)/(15X,4(1PD14.4))) + 9030 FORMAT (' ****** Output parameters for SMUMPS_443:'/ + & ' INFO(1:2) = ',2I8) + 9031 FORMAT (' NUM = ',I8) + 9032 FORMAT (' PERM(1:M) = ',8I8/(15X,8I8)) + 9033 FORMAT (' DW(1:M) = ',5(F11.3)/(15X,5(F11.3))) + 9034 FORMAT (' DW(M+1:M+N) = ',5(F11.3)/(15X,5(F11.3))) + END SUBROUTINE SMUMPS_559 + SUBROUTINE SMUMPS_563(N,NZ,IP,IRN,A,FLAG,POSI) + IMPLICIT NONE + INTEGER N,NZ + INTEGER IP(N+1),IRN(NZ) + REAL A(NZ) + INTEGER WR_POS,BEG_COL,ROW,COL,K,SV_POS + INTEGER FLAG(N), POSI(N) + FLAG = 0 + WR_POS = 1 + DO COL=1,N + BEG_COL = WR_POS + DO K=IP(COL),IP(COL+1)-1 + ROW = IRN(K) + IF(FLAG(ROW) .NE. COL) THEN + IRN(WR_POS) = ROW + A(WR_POS) = A(K) + FLAG(ROW) = COL + POSI(ROW) = WR_POS + WR_POS = WR_POS+1 + ELSE + SV_POS = POSI(ROW) + A(SV_POS) = A(SV_POS) + A(K) + ENDIF + ENDDO + IP(COL) = BEG_COL + ENDDO + IP(N+1) = WR_POS + NZ = WR_POS-1 + RETURN + END SUBROUTINE SMUMPS_563 + SUBROUTINE SMUMPS_562(N,NZ,IP,IRN,FLAG,POSI) + IMPLICIT NONE + INTEGER N,NZ + INTEGER IP(N+1),IRN(NZ) + INTEGER WR_POS,BEG_COL,ROW,COL,K + INTEGER FLAG(N), POSI(N) + FLAG = 0 + WR_POS = 1 + DO COL=1,N + BEG_COL = WR_POS + DO K=IP(COL),IP(COL+1)-1 + ROW = IRN(K) + IF(FLAG(ROW) .NE. COL) THEN + IRN(WR_POS) = ROW + FLAG(ROW) = COL + POSI(ROW) = WR_POS + WR_POS = WR_POS+1 + ENDIF + ENDDO + IP(COL) = BEG_COL + ENDDO + IP(N+1) = WR_POS + NZ = WR_POS-1 + RETURN + END SUBROUTINE SMUMPS_562 + SUBROUTINE SMUMPS_181( N, NA, LNA, NE_STEPS, + & PERM, FILS, + & DAD_STEPS, STEP, NSTEPS, INFO) + IMPLICIT NONE + INTEGER, INTENT(IN) :: N, NSTEPS, LNA + INTEGER, INTENT(IN) :: FILS( N ), STEP(N), NA(LNA) + INTEGER, INTENT(IN) :: DAD_STEPS ( NSTEPS ), NE_STEPS (NSTEPS) + INTEGER, INTENT(INOUT) :: INFO(40) + INTEGER, INTENT(OUT) :: PERM( N ) + INTEGER :: IPERM, INODE, IN + INTEGER :: INBLEAF, INBROOT, allocok + INTEGER, ALLOCATABLE, DIMENSION (:) :: POOL, NSTK + INBLEAF = NA(1) + INBROOT = NA(2) + ALLOCATE(POOL(INBLEAF), NSTK(NSTEPS), stat=allocok) + IF (allocok > 0 ) THEN + INFO(1) = -7 + INFO(2) = INBLEAF + NSTEPS + RETURN + ENDIF + POOL(1:INBLEAF) = NA(3:2+INBLEAF) + NSTK(1:NSTEPS) = NE_STEPS(1:NSTEPS) + IPERM = 1 + DO WHILE ( INBLEAF .NE. 0 ) + INODE = POOL( INBLEAF ) + INBLEAF = INBLEAF - 1 + IN = INODE + DO WHILE ( IN .GT. 0 ) + PERM ( IN ) = IPERM + IPERM = IPERM + 1 + IN = FILS( IN ) + END DO + IN = DAD_STEPS(STEP( INODE )) + IF ( IN .eq. 0 ) THEN + INBROOT = INBROOT - 1 + ELSE + NSTK( STEP(IN) ) = NSTK( STEP(IN) ) - 1 + IF ( NSTK( STEP(IN) ) .eq. 0 ) THEN + INBLEAF = INBLEAF + 1 + POOL( INBLEAF ) = IN + END IF + END IF + END DO + DEALLOCATE(POOL, NSTK) + RETURN + END SUBROUTINE SMUMPS_181 + SUBROUTINE SMUMPS_746( ID, PTRAR ) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + include 'mpif.h' + TYPE(SMUMPS_STRUC), INTENT(IN), TARGET :: ID + INTEGER, TARGET :: PTRAR(ID%N,2) + INTEGER :: IERR + INTEGER :: IOLD, K, JOLD, INEW, JNEW, INZ + INTEGER, POINTER :: IIRN(:), IJCN(:), IWORK1(:), IWORK2(:) + LOGICAL :: IDO, PARANAL + PARANAL = .TRUE. + IF (PARANAL) THEN + IF(ID%KEEP(54) .EQ. 3) THEN + IIRN => ID%IRN_loc + IJCN => ID%JCN_loc + INZ = ID%NZ_loc + IWORK1 => PTRAR(1:ID%N,2) + allocate(IWORK2(ID%N)) + IDO = .TRUE. + ELSE + IIRN => ID%IRN + IJCN => ID%JCN + INZ = ID%NZ + IWORK1 => PTRAR(1:ID%N,1) + IWORK2 => PTRAR(1:ID%N,2) + IDO = ID%MYID .EQ. 0 + END IF + ELSE + IIRN => ID%IRN + IJCN => ID%JCN + INZ = ID%NZ + IWORK1 => PTRAR(1:ID%N,1) + IWORK2 => PTRAR(1:ID%N,2) + IDO = ID%MYID .EQ. 0 + END IF + DO 50 IOLD=1,ID%N + IWORK1(IOLD) = 0 + IWORK2(IOLD) = 0 + 50 CONTINUE + IF(IDO) THEN + DO 70 K=1,INZ + IOLD = IIRN(K) + JOLD = IJCN(K) + IF ( (IOLD.GT.ID%N).OR.(JOLD.GT.ID%N).OR.(IOLD.LT.1) + & .OR.(JOLD.LT.1) ) GOTO 70 + IF (IOLD.NE.JOLD) THEN + INEW = ID%SYM_PERM(IOLD) + JNEW = ID%SYM_PERM(JOLD) + IF ( ID%KEEP( 50 ) .EQ. 0 ) THEN + IF (INEW.LT.JNEW) THEN + IWORK2(IOLD) = IWORK2(IOLD) + 1 + ELSE + IWORK1(JOLD) = IWORK1(JOLD) + 1 + ENDIF + ELSE + IF ( INEW .LT. JNEW ) THEN + IWORK1( IOLD ) = IWORK1( IOLD ) + 1 + ELSE + IWORK1( JOLD ) = IWORK1( JOLD ) + 1 + END IF + ENDIF + ENDIF + 70 CONTINUE + END IF + IF(PARANAL .AND. (ID%KEEP(54) .EQ. 3) ) THEN + CALL MPI_ALLREDUCE(IWORK1(1), PTRAR(1,1), ID%N, MPI_INTEGER, + & MPI_SUM, ID%COMM, IERR ) + CALL MPI_ALLREDUCE(IWORK2(1), PTRAR(1,2), ID%N, MPI_INTEGER, + & MPI_SUM, ID%COMM, IERR ) + deallocate(IWORK2) + ELSE + CALL MPI_BCAST( PTRAR, 2*ID%N, MPI_INTEGER, + & 0, ID%COMM, IERR ) + END IF + RETURN + END SUBROUTINE SMUMPS_746 + MODULE SMUMPS_PARALLEL_ANALYSIS + USE SMUMPS_STRUC_DEF + USE TOOLS_COMMON + INCLUDE 'mpif.h' + PUBLIC SMUMPS_715 + INTERFACE SMUMPS_715 + MODULE PROCEDURE SMUMPS_715 + END INTERFACE + PRIVATE + TYPE ORD_TYPE + INTEGER :: CBLKNBR, N + INTEGER, POINTER :: PERMTAB(:) => null() + INTEGER, POINTER :: PERITAB(:) => null() + INTEGER, POINTER :: RANGTAB(:) => null() + INTEGER, POINTER :: TREETAB(:) => null() + INTEGER, POINTER :: BROTHER(:) => null() + INTEGER, POINTER :: SON(:) => null() + INTEGER, POINTER :: NW(:) => null() + INTEGER, POINTER :: FIRST(:) => null() + INTEGER, POINTER :: LAST(:) => null() + INTEGER, POINTER :: TOPNODES(:) => null() + INTEGER :: COMM, COMM_NODES, NPROCS, NSLAVES, MYID + INTEGER :: TOPSTRAT, SUBSTRAT, ORDTOOL, TOPVARS + LOGICAL :: IDO + END TYPE ORD_TYPE + TYPE GRAPH_TYPE + INTEGER :: NZ_LOC, N, COMM + INTEGER, POINTER :: IRN_LOC(:) => null() + INTEGER, POINTER :: JCN_LOC(:) => null() + END TYPE GRAPH_TYPE + TYPE ARRPNT + INTEGER, POINTER :: BUF(:) => null() + END TYPE ARRPNT + INTEGER :: MEMCNT, MAXMEM, MP, MPG, LP, NRL, TOPROWS + LOGICAL :: PROK, PROKG + CONTAINS + SUBROUTINE SMUMPS_715(id, WORK1, WORK2, NFSIZ, FILS, + & FRERE) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(SMUMPS_STRUC) :: id + INTEGER, POINTER :: WORK1(:), WORK2(:), + & NFSIZ(:), FILS(:), FRERE(:) + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: IPE(:), NV(:), + & NE(:), NA(:), NODE(:), + & ND(:), SUBORD(:), NAMALG(:), + & IPS(:), CUMUL(:), + & SAVEIRN(:), SAVEJCN(:) + INTEGER :: MYID, NPROCS, IERR, NEMIN, LDIAG + LOGICAL :: SPLITROOT + INTEGER(8), PARAMETER :: K79REF=12000000_8 + nullify(IPE, NV, NE, NA, NODE, ND, SUBORD, NAMALG, IPS, + & CUMUL, SAVEIRN, SAVEJCN) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + LP = id%ICNTL(1) + MP = id%ICNTL(2) + MPG = id%ICNTL(3) + PROK = (MP.GT.0) + PROKG = (MPG.GT.0) .AND. (MYID .EQ. 0) + LDIAG = id%ICNTL(4) + ord%PERMTAB => WORK1(1 : id%N) + ord%PERITAB => WORK1(id%N+1 : 2*id%N) + ord%TREETAB => WORK1(2*id%N+1 : 3*id%N) + IF(id%KEEP(54) .NE. 3) THEN + IF(MYID.EQ.0) THEN + SAVEIRN => id%IRN_loc + SAVEJCN => id%JCN_loc + id%IRN_loc => id%IRN + id%JCN_loc => id%JCN + id%NZ_loc = id%NZ + ELSE + id%NZ_loc = 0 + END IF + END IF + MAXMEM=0 + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + MEMCNT = size(work1)+ size(work2) + + & size(nfsiz) + size(fils) + size(frere) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT entry:',MEMCNT,MAXMEM +#endif + CALL SMUMPS_716(id, ord) + id%INFOG(7) = id%KEEP(245) + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + CALL SMUMPS_717(id, ord, WORK2) + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + IF(id%MYID .EQ. 0) THEN + CALL MUMPS_733(IPE, id%N, id%INFO, LP, FORCE=.FALSE., + & COPY=.FALSE., STRING='', + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NV, id%N, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT ipe nv:',MEMCNT,MAXMEM +#endif + END IF + ord%SUBSTRAT = 0 + ord%TOPSTRAT = 0 + CALL SMUMPS_720(id, ord, IPE, NV, WORK2) + IF(id%KEEP(54) .NE. 3) THEN + IF(MYID.EQ.0) THEN + id%IRN_loc => SAVEIRN + id%JCN_loc => SAVEJCN + END IF + END IF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + NULLIFY(ord%PERMTAB) + NULLIFY(ord%PERITAB) + NULLIFY(ord%TREETAB) + CALL MUMPS_734(ord%FIRST, ord%LAST, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT firstlast:',MEMCNT,MAXMEM +#endif + IF (MYID .EQ. 0) THEN + IPS => WORK1(1:id%N) + NE => WORK1(id%N+1 : 2*id%N) + NA => WORK1(2*id%N+1 : 3*id%N) + NODE => WORK2(1 : id%N ) + ND => WORK2(id%N+1 : 2*id%N) + SUBORD => WORK2(2*id%N+1 : 3*id%N) + NAMALG => WORK2(3*id%N+1 : 4*id%N) + CALL MUMPS_733(CUMUL, id%N, id%INFO, LP, + & STRING='CUMUL', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT cumul:',MEMCNT,MAXMEM +#endif + NEMIN = id%KEEP(1) + CALL SMUMPS_557(id%N, IPE(1), NV(1), IPS(1), NE(1), + & NA(1), NFSIZ(1), NODE(1), id%INFOG(6), FILS(1), FRERE(1), + & ND(1), NEMIN, SUBORD(1), id%KEEP(60), id%KEEP(20), + & id%KEEP(38), NAMALG(1), id%KEEP(104), CUMUL(1), + & id%KEEP(50), id%ICNTL(13), id%KEEP(37), id%NSLAVES, + & id%KEEP(250).EQ.1) + CALL MUMPS_734(CUMUL, NV, IPE, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall cumul:',MEMCNT,MAXMEM +#endif + CALL SMUMPS_201(NE(1), ND(1), id%INFOG(6), id%INFOG(5), + & id%KEEP(2), id%KEEP(50), id%KEEP(101), id%KEEP(108), + & id%KEEP(5), id%KEEP(6), id%KEEP(226), id%KEEP(253)) + IF ( id%KEEP(53) .NE. 0 ) THEN + CALL MUMPS_209(id%N, FRERE(1), FILS(1), NFSIZ(1), + & id%KEEP(20)) + END IF + IF ( (id%KEEP(48) == 4 .AND. id%KEEP8(21).GT.0_8) + & .OR. + & (id%KEEP (48)==5 .AND. id%KEEP8(21) .GT. 0_8 ) + & .OR. + & (id%KEEP(24).NE.0.AND.id%KEEP8(21).GT.0_8) ) THEN + CALL SMUMPS_510(id%KEEP8(21), id%KEEP(2), + & id%KEEP(48), id%KEEP(50), id%NSLAVES) + END IF + IF ((id%KEEP(210).LT.0) .OR. (id%KEEP(210).GT.2)) + & id%KEEP(210)=0 + IF ((id%KEEP(210).EQ.0) .AND. (id%KEEP(201).GT.0)) + & id%KEEP(210)=1 + IF ((id%KEEP(210).EQ.0) .AND. (id%KEEP(201).EQ.0)) + & id%KEEP(210)=2 + IF (id%KEEP(210).EQ.2) id%KEEP8(79)=huge(id%KEEP8(79)) + IF ((id%KEEP(210).EQ.1) .AND. (id%KEEP8(79).LE.0_8)) THEN + IF ( huge(id%KEEP8(79)) / K79REF + 1_8 .GE. + & int(id%NSLAVES,8) ) THEN + id%KEEP8(79)=huge(id%KEEP8(79)) + ELSE + id%KEEP8(79)=K79REF * int(id%NSLAVES,8) + ENDIF + ENDIF + IF ( (id%KEEP(79).EQ.0).OR.(id%KEEP(79).EQ.2).OR. + & (id%KEEP(79).EQ.3).OR.(id%KEEP(79).EQ.5).OR. + & (id%KEEP(79).EQ.6) + & ) THEN + IF (id%KEEP(210).EQ.1) THEN + SPLITROOT = .FALSE. + IF ( id%KEEP(62).GE.1) THEN + CALL SMUMPS_97(id%N, FRERE(1), FILS(1), + & NFSIZ(1), id%INFOG(6), + & id%NSLAVES, id%KEEP(1), id%KEEP8(1), SPLITROOT, + & MP, LDIAG, id%INFOG(1), id%INFOG(2)) + IF (id%INFOG(1).LT.0) RETURN + ENDIF + ENDIF + ENDIF + SPLITROOT = (((id%ICNTL(13).GT.0) .AND. + & (id%NSLAVES.GT.id%ICNTL(13))) .OR. + & (id%ICNTL(13).EQ.-1)) .AND. (id%KEEP(60).EQ.0) + IF (SPLITROOT) THEN + CALL SMUMPS_97(id%N, FRERE(1), FILS(1), NFSIZ(1), + & id%INFOG(6), id%NSLAVES, id%KEEP(1), id%KEEP8(1), + & SPLITROOT, MP, LDIAG, id%INFOG(1), id%INFOG(2)) + IF (id%INFOG(1).LT.0) RETURN + ENDIF + END IF +#if defined (memprof) + write(mp,'(i2,a30,3(i8,5x))')myid,'MEMCNT exit:',MEMCNT,MAXMEM, + & estimem(myid, id%n, 2*id%nz/id%n) +#endif + RETURN + END SUBROUTINE SMUMPS_715 + SUBROUTINE SMUMPS_716(id, ord) + TYPE(SMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER :: IERR +#if defined(parmetis) + INTEGER :: I, COLOR, BASE + LOGICAL :: IDO +#endif + IF(id%MYID .EQ. 0) id%KEEP(245) = id%ICNTL(29) + CALL MPI_BCAST( id%KEEP(245), 1, + & MPI_INTEGER, 0, id%COMM, IERR ) + IF ((id%KEEP(245) .LT. 0) .OR. (id%KEEP(245) .GT. 2)) THEN + id%KEEP(245) = 0 + END IF + IF (id%KEEP(245) .EQ. 0) THEN +#if defined(ptscotch) + IF(id%NSLAVES .LT. 2) THEN + IF(PROKG) WRITE(MPG,'("Warning: older versions + &of PT-SCOTCH require at least 2 processors.")') + END IF + ord%ORDTOOL = 1 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%COMM = id%COMM + ord%COMM_NODES = id%COMM_NODES + ord%NPROCS = id%NPROCS + ord%NSLAVES = id%NSLAVES + ord%MYID = id%MYID + ord%IDO = (id%MYID .GE. 1) .OR. (id%KEEP(46) .EQ. 1) + IF(PROKG) WRITE(MPG, + & '("Parallel ordering tool set to PT-SCOTCH.")') + RETURN +#endif +#if defined(parmetis) + I=1 + DO + IF (I .GT. id%NSLAVES) EXIT + ord%NSLAVES = I + I = I*2 + END DO + BASE = id%NPROCS-id%NSLAVES + ord%NPROCS = ord%NSLAVES + BASE + IDO = (id%MYID .GE. BASE) .AND. + & (id%MYID .LE. BASE+ord%NSLAVES-1) + ord%IDO = IDO + IF ( IDO ) THEN + COLOR = 1 + ELSE + COLOR = MPI_UNDEFINED + END IF + CALL MPI_COMM_SPLIT( id%COMM, COLOR, 0, + & ord%COMM_NODES, IERR ) + ord%ORDTOOL = 2 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%MYID = id%MYID + IF(PROKG) WRITE(MPG, + & '("Parallel ordering tool set to ParMETIS.")') + RETURN +#endif + id%INFO(1) = -38 + id%INFOG(1) = -38 + IF(id%MYID .EQ.0 ) THEN + WRITE(LP, + & '("No parallel ordering tools available.")') + WRITE(LP, + & '("Please install PT-SCOTCH or ParMETIS.")') + END IF + RETURN + ELSE IF (id%KEEP(245) .EQ. 1) THEN +#if defined(ptscotch) + IF(id%NSLAVES .LT. 2) THEN + IF(PROKG) WRITE(MPG,'("Warning: older versions + &of PT-SCOTCH require at least 2 processors.")') + END IF + ord%ORDTOOL = 1 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%COMM = id%COMM + ord%COMM_NODES = id%COMM_NODES + ord%NPROCS = id%NPROCS + ord%NSLAVES = id%NSLAVES + ord%MYID = id%MYID + ord%IDO = (id%MYID .GE. 1) .OR. (id%KEEP(46) .EQ. 1) + IF(PROKG) WRITE(MPG, + & '("Using PT-SCOTCH for parallel ordering.")') + RETURN +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) WRITE(LP, + & '("PT-SCOTCH not available.")') + RETURN +#endif + ELSE IF (id%KEEP(245) .EQ. 2) THEN +#if defined(parmetis) + I=1 + DO + IF (I .GT. id%NSLAVES) EXIT + ord%NSLAVES = I + I = I*2 + END DO + BASE = id%NPROCS-id%NSLAVES + ord%NPROCS = ord%NSLAVES + BASE + IDO = (id%MYID .GE. BASE) .AND. + & (id%MYID .LE. BASE+ord%NSLAVES-1) + ord%IDO = IDO + IF ( IDO ) THEN + COLOR = 1 + ELSE + COLOR = MPI_UNDEFINED + END IF + CALL MPI_COMM_SPLIT( id%COMM, COLOR, 0, ord%COMM_NODES, + & IERR ) + ord%ORDTOOL = 2 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%MYID = id%MYID + IF(PROKG) WRITE(MPG, + & '("Using ParMETIS for parallel ordering.")') + RETURN +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) WRITE(LP, + & '("ParMETIS not available.")') + RETURN +#endif + END IF + END SUBROUTINE SMUMPS_716 + SUBROUTINE SMUMPS_717(id, ord, WORK) + IMPLICIT NONE + TYPE(SMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: WORK(:) +#ifdef parmetis + INTEGER :: IERR +#endif + IF (ord%ORDTOOL .EQ. 1) THEN +#ifdef ptscotch + CALL SMUMPS_719(id, ord, WORK) +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + WRITE(LP,*)'PT-SCOTCH not available. Aborting...' + CALL MUMPS_ABORT() +#endif + ELSE IF (ord%ORDTOOL .EQ. 2) THEN +#ifdef parmetis + CALL SMUMPS_718(id, ord, WORK) + if(ord%IDO) CALL MPI_COMM_FREE(ord%COMM_NODES, IERR) +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + WRITE(LP,*)'ParMETIS not available. Aborting...' + CALL MUMPS_ABORT() +#endif + END IF + RETURN + END SUBROUTINE SMUMPS_717 +#if defined(parmetis) + SUBROUTINE SMUMPS_718(id, ord, WORK) + IMPLICIT NONE + TYPE(SMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: WORK(:) + INTEGER :: I, MYID, NPROCS, IERR, BASE + INTEGER, POINTER :: FIRST(:), + & LAST(:), SWORK(:) + INTEGER :: BASEVAL, VERTLOCNBR, + & EDGELOCNBR, OPTIONS(10), NROWS_LOC + INTEGER, POINTER :: VERTLOCTAB(:), + & EDGELOCTAB(:), RCVCNTS(:) + INTEGER, POINTER :: SIZES(:), ORDER(:) + nullify(FIRST, LAST, SWORK, VERTLOCTAB, EDGELOCTAB, RCVCNTS, + & SIZES, ORDER) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. ID%N*3) THEN + WRITE(LP, + & '("Insufficient workspace inside SMUMPS_718")') + CALL MUMPS_ABORT() + END IF + CALL MUMPS_733(ord%PERMTAB, id%N, id%INFO, LP, + & STRING='PERMTAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%PERITAB, id%N, id%INFO, LP, + & STRING='PERITAB', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT perm peri:', + & MEMCNT,MAXMEM +#endif + BASEVAL = 1 + BASE = id%NPROCS-id%NSLAVES + VERTLOCTAB => ord%PERMTAB + CALL MUMPS_733(FIRST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT first last:',MEMCNT, + & MAXMEM +#endif + DO I=0, BASE-1 + FIRST(I+1) = 0 + LAST(I+1) = -1 + END DO + DO I=BASE, BASE+ord%NSLAVES-2 + FIRST(I+1) = (id%N/ord%NSLAVES)*(I-BASE)+1 + LAST(I+1) = (id%N/ord%NSLAVES)*(I+1-BASE) + END DO + FIRST(BASE+ord%NSLAVES) = (id%N/ord%NSLAVES)* + & (BASE+ord%NSLAVES-1-BASE)+1 + LAST(BASE+ord%NSLAVES) = id%N + DO I=BASE+ord%NSLAVES, NPROCS + FIRST(I+1) = id%N+1 + LAST(I+1) = id%N + END DO + VERTLOCNBR = LAST(MYID+1)-FIRST(MYID+1) + 1 + SWORK => WORK(id%N+1:3*id%N) + CALL SMUMPS_776(id, FIRST, LAST, VERTLOCTAB, + & EDGELOCTAB, SWORK) + EDGELOCNBR = VERTLOCTAB(VERTLOCNBR+1)-1 + OPTIONS(:) = 0 + NROWS_LOC = LAST(MYID+1)-FIRST(MYID+1)+1 + ORDER => WORK(1:id%N) + CALL MUMPS_733(SIZES, 2*ord%NSLAVES, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT sizes:',MEMCNT,MAXMEM +#endif + IF(ord%IDO) THEN + CALL MUMPS_PARMETIS(FIRST(1+BASE), VERTLOCTAB, + & EDGELOCTAB, BASEVAL, OPTIONS, ORDER, + & SIZES, ord%COMM_NODES) + END IF + CALL MUMPS_734(EDGELOCTAB, MEMCNT=MEMCNT) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall elt:',MEMCNT,MAXMEM +#endif + NULLIFY(VERTLOCTAB) + CALL MPI_BCAST(SIZES, 2*ord%NSLAVES, MPI_INTEGER, + & BASE, id%COMM, IERR) + ord%CBLKNBR = 2*ord%NSLAVES-1 + CALL MUMPS_733(RCVCNTS, id%NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rcvcnts:',MEMCNT,MAXMEM +#endif + DO I=1, id%NPROCS + RCVCNTS(I) = max(LAST(I)-FIRST(I)+1,0) + END DO + FIRST = FIRST-1 + IF(FIRST(1) .LT. 0) THEN + FIRST(1) = 0 + END IF + CALL MPI_ALLGATHERV ( ORDER, NROWS_LOC, MPI_INTEGER, ord%PERMTAB, + & RCVCNTS, FIRST, MPI_INTEGER, id%COMM, IERR ) + DO I=1, id%N + ord%PERITAB(ord%PERMTAB(I)) = I + END DO + CALL MUMPS_733(ord%RANGTAB, 2*ord%NSLAVES, id%INFO, + & LP, STRING='RANGTAB', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rangtab:',MEMCNT,MAXMEM +#endif + CALL MUMPS_733(ord%TREETAB, ord%CBLKNBR, id%INFO, + & LP, STRING='TREETAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL SMUMPS_778(ord%TREETAB, ord%RANGTAB, + & SIZES, ord%CBLKNBR) + CALL MUMPS_734(SIZES, FIRST, LAST, + & RCVCNTS, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall sizes:',MEMCNT,MAXMEM +#endif + CALL MUMPS_733(ord%SON, ord%CBLKNBR, id%INFO, + & LP, STRING='SON', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%BROTHER, ord%CBLKNBR, id%INFO, + & LP, STRING='BROTHER', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%NW, ord%CBLKNBR, id%INFO, + & LP, STRING='NW', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT son:',MEMCNT,MAXMEM +#endif + CALL SMUMPS_777(ord) + ord%N = id%N + ord%COMM = id%COMM + RETURN + END SUBROUTINE SMUMPS_718 +#endif +#if defined(ptscotch) + SUBROUTINE SMUMPS_719(id, ord, WORK) + IMPLICIT NONE + INCLUDE 'ptscotchf.h' + TYPE(SMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: WORK(:) + INTEGER :: I, MYID, NPROCS, IERR + INTEGER, POINTER :: FIRST(:), + & LAST(:), SWORK(:) + INTEGER :: BASEVAL, VERTLOCNBR, + & EDGELOCNBR, MYWORKID, + & BASE + INTEGER, POINTER :: VERTLOCTAB(:), + & EDGELOCTAB(:) + DOUBLE PRECISION :: GRAPHDAT(SCOTCH_DGRAPHDIM), + & ORDEDAT(SCOTCH_DORDERDIM), STRADAT(SCOTCH_STRATDIM), + & CORDEDAT(SCOTCH_ORDERDIM) + CHARACTER STRSTRING*1024 + nullify(FIRST, LAST, SWORK, VERTLOCTAB, EDGELOCTAB) + IF(MUMPS_795(WORK) .LT. ID%N*3) THEN + WRITE(LP, + & '("Insufficient workspace inside SMUMPS_719")') + CALL MUMPS_ABORT() + END IF + IF(ord%SUBSTRAT .EQ. 0) THEN + STRSTRING='n{sep=m{asc=b{width=3,strat=q{strat=f}},'// + & 'low=q{strat=h},vert=1000,dvert=100,dlevl=0,proc=1,'// + & 'seq=q{strat=m{type=h,vert=100,low=h{pass=10},'// + & 'asc=b{width=3,bnd=f{bal=0.2},org=h{pass=10}'// + & 'f{bal=0.2}}}}},ole=s,ose=s,osq=n{sep=/(vert>120)?'// + & 'm{type=h,vert=100,low=h{pass=10},asc=b{width=3,'// + & 'bnd=f{bal=0.2},org=h{pass=10}f{bal=0.2}}};,'// + & 'ole=f{cmin=15,cmax=100000,frat=0.0},ose=g}}' + ELSE + STRSTRING='n{sep=m{asc=b{width=3,strat=q{strat=f}},'// + & 'low=q{strat=h},vert=1000,dvert=100,dlevl=0,'// + & 'proc=1,seq=q{strat=m{type=h,vert=100,'// + & 'low=h{pass=10},asc=b{width=3,bnd=f{bal=0.2},'// + & 'org=h{pass=10}f{bal=0.2}}}}},ole=s,ose=s,osq=s}' + END IF + CALL MPI_BARRIER(id%COMM, IERR) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + BASE = id%NPROCS-id%NSLAVES + BASEVAL = 1 + CALL MUMPS_733(FIRST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT first last:',MEMCNT, + & MAXMEM +#endif + DO I=0, BASE-1 + FIRST(I+1) = 0 + LAST(I+1) = -1 + END DO + DO I=BASE, BASE+ord%NSLAVES-2 + FIRST(I+1) = (id%N/ord%NSLAVES)*(I-BASE)+1 + LAST(I+1) = (id%N/ord%NSLAVES)*(I+1-BASE) + END DO + FIRST(BASE+ord%NSLAVES) = (id%N/ord%NSLAVES)* + & (BASE+ord%NSLAVES-1-BASE)+1 + LAST(BASE+ord%NSLAVES) = id%N + DO I=BASE+ord%NSLAVES, NPROCS-1 + FIRST(I+1) = id%N+1 + LAST(I+1) = id%N + END DO + VERTLOCNBR = LAST(MYID+1)-FIRST(MYID+1) + 1 + VERTLOCTAB => WORK(1:id%N) + SWORK => WORK(id%N+1:3*id%N) + CALL SMUMPS_776(id, FIRST, LAST, VERTLOCTAB, + & EDGELOCTAB, SWORK) + EDGELOCNBR = VERTLOCTAB(VERTLOCNBR+1)-1 + CALL MUMPS_733(ord%PERMTAB, id%N, id%INFO, + & LP, STRING='PERMTAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%PERITAB, id%N, id%INFO, + & LP, STRING='PERITAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%RANGTAB, id%N+1, id%INFO, + & LP, STRING='RANGTAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%TREETAB, id%N, id%INFO, + & LP, STRING='TREETAB', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT permtab:',MEMCNT,MAXMEM +#endif + IF(ord%IDO) THEN + CALL MPI_COMM_RANK (ord%COMM_NODES, MYWORKID, IERR) + ELSE + MYWORKID = -1 + END IF + IF(ord%IDO) THEN + CALL MUMPS_DGRAPHINIT(GRAPHDAT, ord%COMM_NODES, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in dgraph init")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFDGRAPHBUILD(GRAPHDAT, BASEVAL, VERTLOCNBR, + & VERTLOCNBR, VERTLOCTAB(1), VERTLOCTAB(2), VERTLOCTAB(1), + & VERTLOCTAB(1), EDGELOCNBR, EDGELOCNBR, EDGELOCTAB(1), + & EDGELOCTAB(1), EDGELOCTAB(1), IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in dgraph build")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFSTRATINIT(STRADAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in strat init")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFSTRATDGRAPHORDER(STRADAT, STRSTRING, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in strat build")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFDGRAPHORDERINIT(GRAPHDAT, ORDEDAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order init")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFDGRAPHORDERCOMPUTE(GRAPHDAT, ORDEDAT, STRADAT, + & IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order compute")') + CALL MUMPS_ABORT() + END IF + IF(MYWORKID .EQ. 0) THEN + CALL SCOTCHFDGRAPHCORDERINIT(GRAPHDAT, CORDEDAT, + & ord%PERMTAB, ord%PERITAB, ord%CBLKNBR, ord%RANGTAB, + & ord%TREETAB, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in Corder init")') + CALL MUMPS_ABORT() + END IF + END IF + IF(MYWORKID .EQ. 0) THEN + CALL SCOTCHFDGRAPHORDERGATHER(GRAPHDAT, ORDEDAT, + & CORDEDAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order gather")') + CALL MUMPS_ABORT() + END IF + ELSE + CALL SCOTCHFDGRAPHORDERGATHER(GRAPHDAT, ORDEDAT, + & ORDEDAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order gather")') + CALL MUMPS_ABORT() + END IF + END IF + END IF + IF(MYWORKID .EQ. 0) + & CALL SCOTCHFDGRAPHCORDEREXIT(GRAPHDAT, CORDEDAT) + CALL SCOTCHFDGRAPHORDEREXIT(GRAPHDAT, ORDEDAT) + CALL SCOTCHFSTRATEXIT(STRADAT) + CALL SCOTCHFDGRAPHEXIT(GRAPHDAT) + CALL MPI_BCAST (ord%CBLKNBR, 1, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%PERMTAB, id%N, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%PERITAB, id%N, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%RANGTAB, id%N+1, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%TREETAB, id%N, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MUMPS_733(ord%SON, ord%CBLKNBR, id%INFO, + & LP, STRING='SON', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%BROTHER, ord%CBLKNBR, id%INFO, + & LP, STRING='BROTHER', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%NW, ord%CBLKNBR, id%INFO, + & LP, STRING='NW', MEMCNT=MEMCNT, ERRCODE=-7) + CALL SMUMPS_777(ord) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT son:',MEMCNT,MAXMEM +#endif + ord%N = id%N + ord%COMM = id%COMM + CALL MUMPS_734(EDGELOCTAB, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall elt:',MEMCNT,MAXMEM +#endif + RETURN + END SUBROUTINE SMUMPS_719 +#endif + FUNCTION SMUMPS_793(id, ord, NACTIVE, ANODE, RPROC, + & ALIST, LIST, PEAKMEM, NNODES, CHECKMEM) + IMPLICIT NONE + LOGICAL :: SMUMPS_793 + INTEGER :: NACTIVE, RPROC, ANODE, PEAKMEM, NNODES + INTEGER :: ALIST(NNODES), LIST(NNODES) + TYPE(ORD_TYPE) :: ord + TYPE(SMUMPS_STRUC) :: id + LOGICAL, OPTIONAL :: CHECKMEM + INTEGER :: IPEAKMEM, BIG, MAX_NROWS, MIN_NROWS + INTEGER :: TOPROWS, NRL, HOSTMEM, SUBMEM + INTEGER :: I, NZ_ROW, WEIGHT + LOGICAL :: ICHECKMEM + IF(present(CHECKMEM)) THEN + ICHECKMEM = CHECKMEM + ELSE + ICHECKMEM = .FALSE. + END IF + SMUMPS_793 = .FALSE. + IF(NACTIVE .GE. RPROC) THEN + SMUMPS_793 = .TRUE. + RETURN + END IF + IF(NACTIVE .EQ. 0) THEN + SMUMPS_793 = .TRUE. + RETURN + END IF + IF(.NOT. ICHECKMEM) RETURN + BIG = ALIST(NACTIVE) + IF(NACTIVE .GT. 1) THEN + MAX_NROWS = ord%NW(ALIST(NACTIVE-1)) + MIN_NROWS = ord%NW(ALIST(1)) + ELSE + MAX_NROWS = 0 + MIN_NROWS = id%N + END IF + DO I=1, ANODE + WEIGHT = ord%NW(LIST(I)) + IF(WEIGHT .GT. MAX_NROWS) MAX_NROWS = WEIGHT + IF(WEIGHT .LT. MIN_NROWS) MIN_NROWS = WEIGHT + END DO + I = ord%SON(BIG) + DO + WEIGHT = ord%NW(I) + IF(WEIGHT .GT. MAX_NROWS) MAX_NROWS = WEIGHT + IF(WEIGHT .LT. MIN_NROWS) MIN_NROWS = WEIGHT + IF(ord%BROTHER(I) .EQ. -1) EXIT + I = ord%BROTHER(I) + END DO + TOPROWS = ord%TOPNODES(2)+ord%RANGTAB(BIG+1)-ord%RANGTAB(BIG) + SUBMEM = 7 *id%N + HOSTMEM = 12*id%N + NZ_ROW = 2*(id%NZ/id%N) + IF(id%KEEP(46) .EQ. 0) THEN + NRL = 0 + ELSE + NRL = MIN_NROWS + END IF + HOSTMEM = HOSTMEM + 2*TOPROWS*NZ_ROW + HOSTMEM = HOSTMEM +NRL + HOSTMEM = HOSTMEM + max(NRL,TOPROWS)*(NZ_ROW+2) + HOSTMEM = HOSTMEM + 6*max(NRL,TOPROWS) + HOSTMEM = HOSTMEM + 3*TOPROWS + NRL = MAX_NROWS + SUBMEM = SUBMEM +NRL + SUBMEM = SUBMEM + NRL*(NZ_ROW+2) + SUBMEM = SUBMEM + 6*NRL + IPEAKMEM = max(HOSTMEM, SUBMEM) + IF((IPEAKMEM .GT. PEAKMEM) .AND. + & (PEAKMEM .NE. 0)) THEN + SMUMPS_793 = .TRUE. + RETURN + ELSE + SMUMPS_793 = .FALSE. + PEAKMEM = IPEAKMEM + RETURN + END IF + END FUNCTION SMUMPS_793 + FUNCTION SMUMPS_779(NODE, ord) + IMPLICIT NONE + INTEGER :: SMUMPS_779 + INTEGER :: NODE + TYPE(ORD_TYPE) :: ord + INTEGER :: CURR + SMUMPS_779 = 0 + IF(ord%SON(NODE) .EQ. -1) THEN + RETURN + ELSE + SMUMPS_779 = 1 + CURR = ord%SON(NODE) + DO + IF(ord%BROTHER(CURR) .NE. -1) THEN + SMUMPS_779 = SMUMPS_779+1 + CURR = ord%BROTHER(CURR) + ELSE + EXIT + END IF + END DO + END IF + RETURN + END FUNCTION SMUMPS_779 + SUBROUTINE SMUMPS_781(ord, id) + USE TOOLS_COMMON + IMPLICIT NONE + TYPE(ORD_TYPE) :: ord + TYPE(SMUMPS_STRUC) :: id + INTEGER, ALLOCATABLE :: ALIST(:), AWEIGHTS(:), LIST(:), WORK(:) + INTEGER :: NNODES, BIG, CURR, ND, NACTIVE, RPROC, ANODE, BASE, I, + & NK, PEAKMEM + LOGICAL :: SD + NNODES = ord%NSLAVES + ALLOCATE(ALIST(NNODES), AWEIGHTS(NNODES), LIST(NNODES), + & WORK(0:NNODES+1)) + ALIST(1) = ord%CBLKNBR + AWEIGHTS(1) = ord%NW(ord%CBLKNBR) + NACTIVE = 1 + RPROC = NNODES + ANODE = 0 + PEAKMEM = 0 + CALL MUMPS_733(ord%TOPNODES, 2*max(NNODES,2), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%FIRST, id%NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%LAST, id%NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')ord%myid,'MEMCNT topnodes:',MEMCNT, + & MAXMEM +#endif + ord%TOPNODES = 0 + IF((ord%CBLKNBR .EQ. 1) .OR. + & ( RPROC .LT. SMUMPS_779(ord%CBLKNBR, ord) )) THEN + ord%TOPNODES(1) = 1 + ord%TOPNODES(2) = ord%RANGTAB(ord%CBLKNBR+1) - ord%RANGTAB(1) + ord%TOPNODES(3) = ord%RANGTAB(1) + ord%TOPNODES(4) = ord%RANGTAB(ord%CBLKNBR+1)-1 + ord%FIRST = 0 + ord%LAST = -1 + RETURN + END IF + DO + IF(NACTIVE .EQ. 0) EXIT + BIG = ALIST(NACTIVE) + NK = SMUMPS_779(BIG, ord) + IF((NK .GT. (RPROC-NACTIVE+1)) .OR. (NK .EQ. 0)) THEN + ANODE = ANODE+1 + LIST(ANODE) = BIG + NACTIVE = NACTIVE-1 + RPROC = RPROC-1 + CYCLE + END IF + SD = SMUMPS_793(id, ord, NACTIVE, ANODE, + & RPROC, ALIST, LIST, PEAKMEM, NNODES, CHECKMEM=.TRUE.) + IF ( SD ) + & THEN + IF(NACTIVE.GT.0) THEN + LIST(ANODE+1:ANODE+NACTIVE) = ALIST(1:NACTIVE) + ANODE = ANODE+NACTIVE + END IF + EXIT + END IF + ord%TOPNODES(1) = ord%TOPNODES(1)+1 + ord%TOPNODES(2) = ord%TOPNODES(2) + + & ord%RANGTAB(BIG+1) - ord%RANGTAB(BIG) + ord%TOPNODES(2+2*(ord%TOPNODES(1)-1)+1) = ord%RANGTAB(BIG) + ord%TOPNODES(2+2*(ord%TOPNODES(1)-1)+2) = + & ord%RANGTAB(BIG+1)-1 + CURR = ord%SON(BIG) + ALIST(NACTIVE) = CURR + AWEIGHTS(NACTIVE) = ord%NW(CURR) + DO + IF(ord%BROTHER(CURR) .EQ. -1) EXIT + NACTIVE = NACTIVE+1 + CURR = ord%BROTHER(CURR) + ALIST(NACTIVE) = CURR + AWEIGHTS(NACTIVE) = ord%NW(CURR) + END DO + CALL SMUMPS_783(NACTIVE, AWEIGHTS(1:NACTIVE), + & WORK(0:NACTIVE+1)) + CALL SMUMPS_784(NACTIVE, WORK(0:NACTIVE+1), + & AWEIGHTS(1:NACTIVE), + & ALIST(1:NACTIVE)) + END DO + DO I=1, ANODE + AWEIGHTS(I) = ord%NW(LIST(I)) + END DO + CALL SMUMPS_783(ANODE, AWEIGHTS(1:ANODE), WORK(0:ANODE+1)) + CALL SMUMPS_784(ANODE, WORK(0:ANODE+1), AWEIGHTS(1:ANODE), + & ALIST(1:ANODE)) + IF (id%KEEP(46) .EQ. 1) THEN + BASE = 0 + ELSE + ord%FIRST(1) = 0 + ord%LAST(1) = -1 + BASE = 1 + END IF + DO I=1, ANODE + CURR = LIST(I) + ND = CURR + IF(ord%SON(ND) .NE. -1) THEN + ND = ord%SON(ND) + DO + IF((ord%SON(ND) .EQ. -1) .AND. + & (ord%BROTHER(ND).EQ.-1)) THEN + EXIT + ELSE IF(ord%BROTHER(ND) .EQ. -1) THEN + ND = ord%SON(ND) + ELSE + ND = ord%BROTHER(ND) + END IF + END DO + END IF + ord%FIRST(BASE+I) = ord%RANGTAB(ND) + ord%LAST(BASE+I) = ord%RANGTAB(CURR+1)-1 + END DO + DO I=ANODE+1, id%NSLAVES + ord%FIRST(BASE+I) = id%N+1 + ord%LAST(BASE+I) = id%N + END DO + DEALLOCATE(LIST, ALIST, AWEIGHTS, WORK) + RETURN + END SUBROUTINE SMUMPS_781 + SUBROUTINE SMUMPS_720(id, ord, GPE, GNV, WORK) + IMPLICIT NONE + TYPE(SMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: GPE(:), GNV(:) + INTEGER, POINTER :: WORK(:) + TYPE(GRAPH_TYPE) :: top_graph + INTEGER, POINTER :: PE(:), IPE(:), + & LENG(:), I_HALO_MAP(:) + INTEGER, POINTER :: NDENSE(:), LAST(:), + & DEGREE(:), W(:), PERM(:), + & LISTVAR_SCHUR(:), NEXT(:), + & HEAD(:), NV(:), ELEN(:), + & RCVCNT(:), LSTVAR(:) + INTEGER, POINTER :: NROOTS(:), MYLIST(:), + & MYNVAR(:), LVARPT(:), + & DISPLS(:), LPERM(:), + & LIPERM(:), + & IPET(:), NVT(:), BUF_PE1(:), + & BUF_PE2(:), BUF_NV1(:), + & BUF_NV2(:), ROOTPERM(:), + & TMP1(:), TMP2(:), BWORK(:) + INTEGER :: HIDX, NCMPA, I, J, SIZE_SCHUR, MYID, + & NPROCS, IERR, NROWS_LOC, GLOB_IDX, MYNROOTS, PNT, TMP, + & NCLIQUES, NTVAR, PFREES, PFREET, TGSIZE, MAXS, RHANDPE, + & RHANDNV, STATUSPE(MPI_STATUS_SIZE), + & STATUSNV(MPI_STATUS_SIZE), RIDX, PROC, NBBUCK, + & PFS_SAVE, PFT_SAVE + LOGICAL :: AGG6 + INTEGER :: THRESH + nullify(PE, IPE, LENG, I_HALO_MAP) + nullify(NDENSE, LAST, DEGREE, W, PERM, LISTVAR_SCHUR, + & NEXT, HEAD, NV, ELEN, RCVCNT, LSTVAR) + nullify(NROOTS, MYLIST, MYNVAR, LVARPT, DISPLS, + & LPERM, LIPERM, IPET, NVT, BUF_PE1, BUF_PE2, + & BUF_NV1, BUF_NV2, ROOTPERM, TMP1, TMP2, BWORK) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. 4*id%N) THEN + WRITE(LP,*)'Insufficient workspace in SMUMPS_720' + CALL MUMPS_ABORT() + ELSE + HEAD => WORK( 1 : id%N) + ELEN => WORK( id%N+1 : 2*id%N) + LENG => WORK(2*id%N+1 : 3*id%N) + PERM => WORK(3*id%N+1 : 4*id%N) + END IF + CALL SMUMPS_781(ord, id) + CALL MUMPS_734(ord%SON, ord%BROTHER, ord%NW, + & ord%RANGTAB, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))') myid,'deall son:',MEMCNT,MAXMEM +#endif + NROWS_LOC = ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1 + NRL = NROWS_LOC + TOPROWS = ord%TOPNODES(2) + BWORK => WORK(1 : 2*id%N) + CALL SMUMPS_775(id, ord, HIDX, IPE, PE, LENG, + & I_HALO_MAP, top_graph, BWORK) + TMP = id%N + DO I=1, NPROCS + TMP = TMP-(ord%LAST(I)-ord%FIRST(I)+1) + END DO + TMP = ceiling(real(TMP)*1.10E0) + IF(MYID .EQ. 0) THEN + TMP = max(max(TMP, HIDX),1) + ELSE + TMP = max(HIDX,1) + END IF + SIZE_SCHUR = HIDX - NROWS_LOC + CALL MUMPS_733(NDENSE, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NEXT, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(DEGREE, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(W, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NV, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LISTVAR_SCHUR, max(SIZE_SCHUR,1), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT allsub:',MEMCNT,MAXMEM +#endif + DO I=1, SIZE_SCHUR + LISTVAR_SCHUR(I) = NROWS_LOC+I + END DO + THRESH = -1 + AGG6 = .TRUE. + PFREES = IPE(NROWS_LOC+1) + PFS_SAVE = PFREES + IF (ord%SUBSTRAT .EQ. 0) THEN + DO I=1, HIDX + PERM(I) = I + END DO + CALL MUMPS_420(1, THRESH, NDENSE(1), HIDX, + & MUMPS_795(PE), IPE(1), PFREES, LENG(1), PE(1), NV(1), + & ELEN(1), LAST(1), NCMPA, DEGREE(1), HEAD(1), NEXT(1), + & W(1), PERM(1), LISTVAR_SCHUR(1), SIZE_SCHUR, AGG6) + ELSE + NBBUCK = 2*TMP + CALL MUMPS_419 (ord%SUBSTRAT, 1, .FALSE., HIDX, NBBUCK, + & MUMPS_795(PE), IPE(1), PFREES, LENG(1), PE(1), NV(1), + & ELEN(1), LAST(1), NCMPA, DEGREE(1), PERM(1), NEXT(1), + & W(1), HEAD(1), AGG6, SIZE_SCHUR, LISTVAR_SCHUR(1) ) + DO I=1, HIDX + PERM(I) = I + END DO + END IF + CALL MUMPS_733(W, 2*NPROCS, id%INFO, + & LP, STRING='W', MEMCNT=MEMCNT, ERRCODE=-7) + if(MEMCNT .gt. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT w:',MEMCNT,MAXMEM +#endif + NROOTS => W + DISPLS => W(NPROCS+1:2*NPROCS) + MYNVAR => DEGREE + MYLIST => NDENSE + LVARPT => NEXT + RCVCNT => HEAD + LSTVAR => LAST + NULLIFY(W, DEGREE, NDENSE, NEXT, HEAD, LAST) + MYNROOTS = 0 + PNT = 0 + DO I=1, HIDX + IF(IPE(I) .GT. 0) THEN + PNT = PNT+LENG(I) + MYNROOTS = MYNROOTS+1 + END IF + END DO + CALL MUMPS_733(MYLIST, PNT, id%INFO, + & LP, STRING='MYLIST', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT mylist:',MEMCNT,MAXMEM +#endif + MYNROOTS = 0 + PNT = 0 + DO I=1, HIDX + IF(IPE(I) .GT. 0) THEN + MYNROOTS = MYNROOTS+1 + MYNVAR(MYNROOTS) = LENG(I) + DO J=1, LENG(I) + MYLIST(PNT+J) = I_HALO_MAP(PE(IPE(I)+J-1)-NROWS_LOC) + END DO + PNT = PNT+LENG(I) + END IF + END DO + CALL MPI_BARRIER(id%COMM, IERR) + CALL MPI_GATHER(MYNROOTS, 1, MPI_INTEGER, NROOTS(1), 1, + & MPI_INTEGER, 0, id%COMM, IERR) + IF(MYID .EQ.0) THEN + DISPLS(1) = 0 + DO I=2, NPROCS + DISPLS(I) = DISPLS(I-1)+NROOTS(I-1) + END DO + NCLIQUES = sum(NROOTS(1:NPROCS)) + CALL MUMPS_733(LVARPT, NCLIQUES+1, id%INFO, + & LP, STRING='LVARPT', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT + ELSE + CALL MUMPS_733(LVARPT, 2, id%INFO, + & LP, STRING='LVARPT', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT + END IF +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT lvarpt:',MEMCNT,MAXMEM +#endif + CALL MPI_GATHERV(MYNVAR(1), MYNROOTS, MPI_INTEGER, LVARPT(2), + & NROOTS(1), DISPLS(1), MPI_INTEGER, 0, id%COMM, IERR) + IF(MYID .EQ. 0) THEN + DO I=1, NPROCS + RCVCNT(I) = sum(LVARPT(2+DISPLS(I):2+DISPLS(I)+NROOTS(I)-1)) + IF(I .EQ. 1) THEN + DISPLS(I) = 0 + ELSE + DISPLS(I) = DISPLS(I-1)+RCVCNT(I-1) + END IF + END DO + CALL MUMPS_733(LSTVAR, sum(RCVCNT(1:NPROCS)), id%INFO, + & LP, STRING='LSTVAR', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT lstvar:',MEMCNT,MAXMEM +#endif + END IF + CALL MPI_GATHERV(MYLIST(1), PNT, MPI_INTEGER, LSTVAR(1), + & RCVCNT(1), DISPLS(1), MPI_INTEGER, 0, id%COMM, IERR) + NULLIFY(DISPLS) + IF(MYID .EQ. 0) THEN + LVARPT(1) = 1 + DO I=2, NCLIQUES+1 + LVARPT(I) = LVARPT(I-1) + LVARPT(I) + END DO + LPERM => WORK(3*id%N+1 : 4*id%N) + NTVAR = ord%TOPNODES(2) + CALL SMUMPS_782(id, ord%TOPNODES, LPERM, LIPERM, ord) + CALL SMUMPS_774(id, ord%TOPNODES(2), LPERM, + & top_graph, NCLIQUES, LSTVAR, LVARPT, IPET, PE, LENG, ELEN) + TGSIZE = ord%TOPNODES(2)+NCLIQUES + PFREET = IPET(TGSIZE+1) + PFT_SAVE = PFREET + nullify(LPERM) + CALL MUMPS_734(top_graph%IRN_LOC, + & top_graph%JCN_LOC, ord%TOPNODES, MEMCNT=MEMCNT) + W => NROOTS + DEGREE => MYNVAR + NDENSE => MYLIST + NEXT => LVARPT + HEAD => RCVCNT + LAST => LSTVAR + NULLIFY(NROOTS, MYNVAR, MYLIST, LVARPT, RCVCNT, LSTVAR) + CALL MUMPS_733(PE, max(PFREET+TGSIZE,1), id%INFO, LP, + & COPY=.TRUE., STRING='J2:PE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NDENSE, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:NDENSE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NVT, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:NVT', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:LAST', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(DEGREE, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:DEGREE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NEXT, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:NEXT', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(W, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:W', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LISTVAR_SCHUR, max(NCLIQUES,1), id%INFO, LP, + & STRING='J2:LVSCH', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT pe:',MEMCNT,MAXMEM +#endif + DO I=1, NCLIQUES + LISTVAR_SCHUR(I) = NTVAR+I + END DO + THRESH = -1 + IF(ord%TOPSTRAT .EQ. 0) THEN + CALL MUMPS_733(HEAD, max(TGSIZE,1), id%INFO, + & LP, STRING='J2:HEAD', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(PERM, max(TGSIZE,1), id%INFO, + & LP, COPY=.TRUE., STRING='J2:PERM', + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rehead:',MEMCNT,MAXMEM +#endif + DO I=1, TGSIZE + PERM(I) = I + END DO + CALL MUMPS_420(2, -1, NDENSE(1), TGSIZE, + & MUMPS_795(PE), IPET(1), PFREET, LENG(1), PE(1), + & NVT(1), ELEN(1), LAST(1), NCMPA, DEGREE(1), HEAD(1), + & NEXT(1), W(1), PERM(1), LISTVAR_SCHUR(1), NCLIQUES, + & AGG6) + ELSE + NBBUCK = 2*TGSIZE + CALL MUMPS_733(HEAD, NBBUCK+2, id%INFO, + & LP, STRING='J2:HEAD', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(PERM, TGSIZE, id%INFO, + & LP, STRING='J2:PERM', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rehead:',MEMCNT,MAXMEM +#endif + CALL MUMPS_419 (ord%TOPSTRAT, 2, .FALSE., TGSIZE, + & NBBUCK, MUMPS_795(PE), IPET(1), PFREET, LENG(1), + & PE(1), NVT(1), ELEN(1), LAST(1), NCMPA, DEGREE(1), + & PERM(1), NEXT(1), W(1), HEAD(1), AGG6, NCLIQUES, + & LISTVAR_SCHUR(1) ) + END IF + END IF + CALL MPI_BARRIER(id%COMM, IERR) + CALL MUMPS_734(LISTVAR_SCHUR, PE, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall lvs:',MEMCNT,MAXMEM +#endif + IF(MYID .EQ. 0) THEN + BUF_PE1 => WORK( 1 : id%N) + BUF_PE2 => WORK( id%N+1 : 2*id%N) + BUF_NV1 => WORK(2*id%N+1 : 3*id%N) + BUF_NV2 => WORK(3*id%N+1 : 4*id%N) + MAXS = NROWS_LOC + DO I=2, NPROCS + IF((ord%LAST(I)-ord%FIRST(I)+1) .GT. MAXS) + & MAXS = (ord%LAST(I)-ord%FIRST(I)+1) + END DO + CALL MUMPS_733(BUF_PE1, MAXS, id%INFO, + & LP, STRING='BUF_PE1', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(BUF_PE2, MAXS, id%INFO, + & LP, STRING='BUF_PE2', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(BUF_NV1, MAXS, id%INFO, + & LP, STRING='BUF_NV1', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(BUF_NV2, MAXS, id%INFO, + & LP, STRING='BUF_NV2', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(GPE, id%N, id%INFO, + & LP, STRING='GPE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(GNV, id%N, id%INFO, + & LP, STRING='GNV', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ROOTPERM, NCLIQUES, id%INFO, + & LP, STRING='ROOTPERM', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT buf_pe1:',MEMCNT, + & MAXMEM +#endif + RIDX = 0 + TMP1 => BUF_PE1 + TMP2 => BUF_NV1 + NULLIFY(BUF_PE1, BUF_NV1) + BUF_PE1 => IPE + BUF_NV1 => NV + DO PROC=0, NPROCS-2 + CALL MPI_IRECV(BUF_PE2(1), ord%LAST(PROC+2)- + & ord%FIRST(PROC+2)+1, MPI_INTEGER, PROC+1, PROC+1, + & id%COMM, RHANDPE, IERR) + CALL MPI_IRECV(BUF_NV2(1), ord%LAST(PROC+2)- + & ord%FIRST(PROC+2)+1, MPI_INTEGER, PROC+1, PROC+1, + & id%COMM, RHANDNV, IERR) + DO I=1, ord%LAST(PROC+1)-ord%FIRST(PROC+1)+1 + GLOB_IDX = ord%PERITAB(I+ord%FIRST(PROC+1)-1) + IF(BUF_PE1(I) .GT. 0) THEN + RIDX=RIDX+1 + ROOTPERM(RIDX) = GLOB_IDX + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE IF (BUF_PE1(I) .EQ. 0) THEN + GPE(GLOB_IDX) = 0 + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE + GPE(GLOB_IDX) = -ord%PERITAB(-BUF_PE1(I)+ + & ord%FIRST(PROC+1)-1) + GNV(GLOB_IDX) = BUF_NV1(I) + END IF + END DO + CALL MPI_WAIT(RHANDPE, STATUSPE, IERR) + CALL MPI_WAIT(RHANDNV, STATUSNV, IERR) + IF(PROC .NE. 0) THEN + TMP1 => BUF_PE1 + TMP2 => BUF_NV1 + END IF + BUF_PE1 => BUF_PE2 + BUF_NV1 => BUF_NV2 + NULLIFY(BUF_PE2, BUF_NV2) + BUF_PE2 => TMP1 + BUF_NV2 => TMP2 + NULLIFY(TMP1, TMP2) + END DO + DO I=1, ord%LAST(PROC+1)-ord%FIRST(PROC+1)+1 + GLOB_IDX = ord%PERITAB(I+ord%FIRST(PROC+1)-1) + IF(BUF_PE1(I) .GT. 0) THEN + RIDX=RIDX+1 + ROOTPERM(RIDX) = GLOB_IDX + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE IF (BUF_PE1(I) .EQ. 0) THEN + GPE(GLOB_IDX) = 0 + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE + GPE(GLOB_IDX) = -ord%PERITAB(-BUF_PE1(I)+ + & ord%FIRST(PROC+1)-1) + GNV(GLOB_IDX) = BUF_NV1(I) + END IF + END DO + DO I=1, NTVAR + GLOB_IDX = LIPERM(I) + IF(IPET(I) .EQ. 0) THEN + GPE(GLOB_IDX) = 0 + GNV(GLOB_IDX) = NVT(I) + ELSE + GPE(GLOB_IDX) = -LIPERM(-IPET(I)) + GNV(GLOB_IDX) = NVT(I) + END IF + END DO + DO I=1, NCLIQUES + GLOB_IDX = ROOTPERM(I) + GPE(GLOB_IDX) = -LIPERM(-IPET(NTVAR+I)) + END DO + ELSE + CALL MPI_SEND(IPE(1), ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1, + & MPI_INTEGER, 0, MYID, id%COMM, IERR) + CALL MPI_SEND(NV(1), ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1, + & MPI_INTEGER, 0, MYID, id%COMM, IERR) + END IF + CALL MUMPS_734(PE, IPE, I_HALO_MAP, NDENSE, + & LAST, DEGREE, MEMCNT=MEMCNT) + CALL MUMPS_734(W, LISTVAR_SCHUR, NEXT, + & NV, MEMCNT=MEMCNT) + CALL MUMPS_734(LSTVAR, NROOTS, MYLIST, MYNVAR, + & LVARPT, MEMCNT=MEMCNT) + CALL MUMPS_734(LPERM, LIPERM, IPET, NVT, + & MEMCNT=MEMCNT) + CALL MUMPS_734(ROOTPERM, TMP1, TMP2, MEMCNT=MEMCNT) + NULLIFY(HEAD, ELEN, LENG, PERM, RCVCNT) + RETURN + END SUBROUTINE SMUMPS_720 + SUBROUTINE SMUMPS_782(id, TOPNODES, LPERM, LIPERM, ord) + IMPLICIT NONE + TYPE(SMUMPS_STRUC) :: id + INTEGER, POINTER :: TOPNODES(:), LPERM(:), LIPERM(:) + TYPE(ORD_TYPE) :: ord + INTEGER :: I, J, K, GIDX + CALL MUMPS_733(LPERM , ord%N, id%INFO, + & LP, STRING='LIDX:LPERM', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LIPERM, TOPNODES(2), id%INFO, + & LP, STRING='LIDX:LIPERM', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')id%myid,'MEMCNT lperm:',MEMCNT, + & MAXMEM +#endif + LPERM = 0 + K = 1 + DO I=1, TOPNODES(1) + DO J=TOPNODES(2*I+1), TOPNODES(2*I+2) + GIDX = ord%PERITAB(J) + LPERM(GIDX) = K + LIPERM(K) = GIDX + K = K+1 + END DO + END DO + RETURN + END SUBROUTINE SMUMPS_782 + SUBROUTINE SMUMPS_774(id, NLOCVARS, LPERM, + & top_graph, NCLIQUES, LSTVAR, LVARPT, IPE, PE, LENG, ELEN) + IMPLICIT NONE + TYPE(SMUMPS_STRUC) :: id + TYPE(GRAPH_TYPE) :: top_graph + INTEGER, POINTER :: LPERM(:), LSTVAR(:), LVARPT(:), + & IPE(:), PE(:), LENG(:), ELEN(:) + INTEGER :: NCLIQUES + INTEGER :: I, J, IDX, NLOCVARS, PNT, SAVEPNT + CALL MUMPS_733(LENG, max(NLOCVARS+NCLIQUES,1) , id%INFO, + & LP, STRING='ATG:LENG', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ELEN, max(NLOCVARS+NCLIQUES,1) , id%INFO, + & LP, STRING='ATG:ELEN', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(IPE , NLOCVARS+NCLIQUES+1, id%INFO, + & LP, STRING='ATG:IPE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')id%myid,'MEMCNT leng:',MEMCNT, + & MAXMEM +#endif + LENG = 0 + ELEN = 0 + DO I=1, top_graph%NZ_LOC + IF((LPERM(top_graph%JCN_LOC(I)) .NE. 0) .AND. + & (top_graph%JCN_LOC(I) .NE. top_graph%IRN_LOC(I))) THEN + LENG(LPERM(top_graph%IRN_LOC(I))) = + & LENG(LPERM(top_graph%IRN_LOC(I))) + 1 + END IF + END DO + DO I=1, NCLIQUES + DO J=LVARPT(I), LVARPT(I+1)-1 + ELEN(LPERM(LSTVAR(J))) = ELEN(LPERM(LSTVAR(J)))+1 + LENG(NLOCVARS+I) = LENG(NLOCVARS+I)+1 + END DO + END DO + IPE(1) = 1 + DO I=1, NLOCVARS+NCLIQUES + IPE(I+1) = IPE(I)+LENG(I)+ELEN(I) + END DO + CALL MUMPS_733(PE, IPE(NLOCVARS+NCLIQUES+1)+NLOCVARS+NCLIQUES, + & id%INFO, LP, STRING='ATG:PE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')id%myid,'MEMCNT repe:',MEMCNT, + & MAXMEM +#endif + LENG = 0 + ELEN = 0 + DO I=1, NCLIQUES + DO J=LVARPT(I), LVARPT(I+1)-1 + IDX = LPERM(LSTVAR(J)) + PE(IPE(IDX)+ELEN(IDX)) = NLOCVARS+I + PE(IPE(NLOCVARS+I)+LENG(NLOCVARS+I)) = IDX + ELEN(LPERM(LSTVAR(J))) = ELEN(LPERM(LSTVAR(J)))+1 + LENG(NLOCVARS+I) = LENG(NLOCVARS+I)+1 + end do + end do + DO I=1, top_graph%NZ_LOC + IF((LPERM(top_graph%JCN_LOC(I)) .NE. 0) .AND. + & (top_graph%JCN_LOC(I) .NE. top_graph%IRN_LOC(I))) THEN + PE(IPE(LPERM(top_graph%IRN_LOC(I)))+ + & ELEN(LPERM(top_graph%IRN_LOC(I))) + + & LENG(LPERM(top_graph%IRN_LOC(I)))) = + & LPERM(top_graph%JCN_LOC(I)) + LENG(LPERM(top_graph%IRN_LOC(I))) = + & LENG(LPERM(top_graph%IRN_LOC(I))) + 1 + END IF + END DO + DO I=1, NLOCVARS+NCLIQUES + LENG(I) = LENG(I)+ELEN(I) + END DO + SAVEPNT = 1 + PNT = 0 + LPERM(1:NLOCVARS+NCLIQUES) = 0 + DO I=1, NLOCVARS+NCLIQUES + DO J=IPE(I), IPE(I+1)-1 + IF(LPERM(PE(J)) .EQ. I) THEN + LENG(I) = LENG(I)-1 + ELSE + LPERM(PE(J)) = I + PNT = PNT+1 + PE(PNT) = PE(J) + END IF + END DO + IPE(I) = SAVEPNT + SAVEPNT = PNT+1 + END DO + IPE(NLOCVARS+NCLIQUES+1) = SAVEPNT + RETURN + END SUBROUTINE SMUMPS_774 + SUBROUTINE SMUMPS_778(TREETAB, RANGTAB, SIZES, CBLKNBR) + INTEGER, POINTER :: TREETAB(:), RANGTAB(:), SIZES(:) + INTEGER :: CBLKNBR + INTEGER :: LCHILD, RCHILD, K, I + INTEGER, POINTER :: PERM(:) + ALLOCATE(PERM(CBLKNBR)) + TREETAB(CBLKNBR) = -1 + IF(CBLKNBR .EQ. 1) THEN + DEALLOCATE(PERM) + TREETAB(1) = -1 + RANGTAB(1:2) = (/1, SIZES(1)+1/) + RETURN + END IF + LCHILD = CBLKNBR - (CBLKNBR+1)/2 + RCHILD = CBLKNBR-1 + K = 1 + PERM(CBLKNBR) = CBLKNBR + PERM(LCHILD) = CBLKNBR+1 - (2*K+1) + PERM(RCHILD) = CBLKNBR+1 - (2*K) + TREETAB(RCHILD) = CBLKNBR + TREETAB(LCHILD) = CBLKNBR + IF(CBLKNBR .GT. 3) THEN + CALL REC_TREETAB(TREETAB, PERM, (CBLKNBR-1)/2, + & LCHILD, CBLKNBR, 2*K+1) + CALL REC_TREETAB(TREETAB, PERM, (CBLKNBR-1)/2, + & RCHILD, CBLKNBR, 2*K) + END IF + RANGTAB(1)=1 + DO I=1, CBLKNBR + RANGTAB(I+1) = RANGTAB(I)+SIZES(PERM(I)) + END DO + DEALLOCATE(PERM) + RETURN + CONTAINS + RECURSIVE SUBROUTINE REC_TREETAB(TREETAB, PERM, SUBNODES, + & ROOTN, CBLKNBR, K) + INTEGER, POINTER :: TREETAB(:), PERM(:) + INTEGER :: SUBNODES, ROOTN, K, CBLKNBR + INTEGER :: LCHILD, RCHILD + LCHILD = ROOTN - (SUBNODES+1)/2 + RCHILD = ROOTN-1 + PERM(LCHILD) = CBLKNBR+1 - (2*K+1) + PERM(RCHILD) = CBLKNBR+1 - (2*K) + TREETAB(RCHILD) = ROOTN + TREETAB(LCHILD) = ROOTN + IF(SUBNODES .GT. 3) THEN + CALL REC_TREETAB(TREETAB, PERM, (SUBNODES-1)/2, LCHILD, + & CBLKNBR, 2*K+1) + CALL REC_TREETAB(TREETAB, PERM, (SUBNODES-1)/2, RCHILD, + & CBLKNBR, 2*K) + END IF + END SUBROUTINE REC_TREETAB + END SUBROUTINE SMUMPS_778 + SUBROUTINE SMUMPS_776(id, FIRST, LAST, IPE, + & PE, WORK) + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(SMUMPS_STRUC) :: id + INTEGER, POINTER :: FIRST(:), LAST(:), IPE(:), PE(:), + & WORK(:) + INTEGER :: IERR, MYID, NPROCS + INTEGER :: I, PROC, LOCNNZ, + & NEW_LOCNNZ, J, LOC_ROW + INTEGER :: TOP_CNT, TIDX, + & NROWS_LOC, DUPS, TOTDUPS, OFFDIAG + INTEGER :: STATUS(MPI_STATUS_SIZE) + INTEGER, POINTER :: MAPTAB(:), + & SNDCNT(:), RCVCNT(:), SDISPL(:) + INTEGER, POINTER :: RDISPL(:), + & MSGCNT(:), SIPES(:,:), LENG(:) + INTEGER, POINTER :: PCNT(:), TSENDI(:), + & TSENDJ(:), RCVBUF(:) + TYPE(ARRPNT), POINTER :: APNT(:) + INTEGER :: BUFSIZE, SOURCE, RCVPNT, MAXS, PNT, + & SAVEPNT + INTEGER, PARAMETER :: ITAG=30 + LOGICAL :: FLAG + DOUBLE PRECISION :: SYMMETRY + nullify(MAPTAB, SNDCNT, RCVCNT, SDISPL) + nullify(RDISPL, MSGCNT, SIPES, LENG) + nullify(PCNT, TSENDI, TSENDJ, RCVBUF, APNT) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. id%N*2) THEN + WRITE(LP, + & '("Insufficient workspace inside BUILD_SCOTCH_GRAPH")') + CALL MUMPS_ABORT() + END IF + CALL MUMPS_733(SNDCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(RCVCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(MSGCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT sndcnt:',MEMCNT,MAXMEM +#endif + ALLOCATE(APNT(NPROCS)) + SNDCNT = 0 + TOP_CNT = 0 + BUFSIZE = 1000 + LOCNNZ = id%NZ_loc + NROWS_LOC = LAST(MYID+1)-FIRST(MYID+1)+1 + MAPTAB => WORK( 1 : id%N) + LENG => WORK(id%N+1 : 2*id%N) + MAXS = 0 + DO I=1, NPROCS + IF((LAST(I)-FIRST(I)+1) .GT. MAXS) THEN + MAXS = LAST(I)-FIRST(I)+1 + END IF + DO J=FIRST(I), LAST(I) + MAPTAB(J) = I + END DO + END DO + ALLOCATE(SIPES(max(1,MAXS), NPROCS)) + OFFDIAG=0 + SIPES=0 + DO I=1, id%NZ_loc + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + OFFDIAG = OFFDIAG+1 + PROC = MAPTAB(id%IRN_loc(I)) + LOC_ROW = id%IRN_loc(I)-FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + PROC = MAPTAB(id%JCN_loc(I)) + LOC_ROW = id%JCN_loc(I)-FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + END IF + END DO + CALL MPI_ALLREDUCE (OFFDIAG, id%KEEP(114), 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR) + id%KEEP(114) = id%KEEP(114)+3*id%N + id%KEEP(113) = id%KEEP(114)-2*id%N + CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, id%COMM, IERR) + SNDCNT(:) = MAXS + CALL MPI_REDUCE_SCATTER ( SIPES(1,1), LENG(1), SNDCNT(1), + & MPI_INTEGER, MPI_SUM, id%COMM, IERR ) + DEALLOCATE(SIPES) + CALL MUMPS_733(IPE, NROWS_LOC+1, id%INFO, + & LP, STRING='IPE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT ripe:',MEMCNT,MAXMEM +#endif + IPE(1) = 1 + DO I=1, NROWS_LOC + IPE(I+1) = IPE(I) + LENG(I) + END DO + CALL MUMPS_733(PE, max(IPE(NROWS_LOC+1)-1,1), id%INFO, + & LP, STRING='PE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rrpe:',MEMCNT,MAXMEM +#endif + LENG(:) = 0 + CALL SMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, LENG, + & RCVBUF, MSGCNT, SNDCNT, id%COMM) + NEW_LOCNNZ = sum(RCVCNT) + DO I=1, NPROCS + MSGCNT(I) = RCVCNT(I)/BUFSIZE + END DO + RCVPNT = 1 + SNDCNT = 0 + TIDX = 0 + DO I=1, id%NZ_loc + IF(mod(I,BUFSIZE/10) .EQ. 0) THEN + CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, MPI_COMM_WORLD, + & FLAG, STATUS, IERR ) + IF(FLAG) THEN + SOURCE = STATUS(MPI_SOURCE) + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, SOURCE, + & ITAG, MPI_COMM_WORLD, STATUS, IERR) + CALL SMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + RCVPNT = RCVPNT + BUFSIZE + END IF + END IF + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + PROC = MAPTAB(id%IRN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) = id%IRN_loc(I)- + & FIRST(PROC)+1 + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = id%JCN_loc(I) + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL SMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, + & PE, LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + PROC = MAPTAB(id%JCN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) = id%JCN_loc(I)- + & FIRST(PROC)+1 + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = id%IRN_loc(I) + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL SMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, + & PE, LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + END IF + END DO + CALL SMUMPS_785(APNT, -1, NPROCS, BUFSIZE, IPE, PE, LENG, + & RCVBUF, MSGCNT, SNDCNT, id%COMM) + DUPS = 0 + PNT = 0 + SAVEPNT = 1 + MAPTAB = 0 + DO I=1, NROWS_LOC + DO J=IPE(I),IPE(I+1)-1 + IF(MAPTAB(PE(J)) .EQ. I) THEN + DUPS = DUPS+1 + ELSE + MAPTAB(PE(J)) = I + PNT = PNT+1 + PE(PNT) = PE(J) + END IF + END DO + IPE(I) = SAVEPNT + SAVEPNT = PNT+1 + END DO + CALL MPI_REDUCE( DUPS, TOTDUPS, 1, MPI_INTEGER, MPI_SUM, + & 0, id%COMM, IERR ) + SYMMETRY = dble(TOTDUPS)/(dble(id%NZ)-dble(id%N)) + IF(MYID .EQ. 0) THEN + IF(id%KEEP(50) .GE. 1) SYMMETRY = 1.d0 + IF(PROKG) WRITE(MPG,'("Structual symmetry is:",i3,"%")') + & ceiling(SYMMETRY*100.d0) + id%INFOG(8) = ceiling(SYMMETRY*100.0d0) + END IF + IPE(NROWS_LOC+1) = SAVEPNT + CALL MUMPS_734(SNDCNT, RCVCNT, MSGCNT, MEMCNT=MEMCNT) + DEALLOCATE(APNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall sndcnt:',MEMCNT,MAXMEM +#endif + RETURN + END SUBROUTINE SMUMPS_776 + SUBROUTINE SMUMPS_775(id, ord, GSIZE, IPE, PE, LENG, + & I_HALO_MAP, top_graph, WORK) + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(SMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + TYPE(GRAPH_TYPE) :: top_graph + INTEGER, POINTER :: IPE(:), PE(:), LENG(:), + & I_HALO_MAP(:), WORK(:) + INTEGER :: GSIZE + INTEGER :: IERR, MYID, NPROCS + INTEGER :: I, PROC, LOCNNZ, + & NEW_LOCNNZ, J, LOC_ROW + INTEGER :: TOP_CNT,IIDX,JJDX + INTEGER :: HALO_SIZE, TIDX, NROWS_LOC, DUPS + INTEGER :: STATUS(MPI_STATUS_SIZE) + INTEGER, POINTER :: MAPTAB(:), + & SNDCNT(:), RCVCNT(:), + & SDISPL(:), HALO_MAP(:) + INTEGER, POINTER :: RDISPL(:), + & MSGCNT(:), SIPES(:,:) + INTEGER, POINTER :: PCNT(:), TSENDI(:), + & TSENDJ(:), RCVBUF(:) + TYPE(ARRPNT), POINTER :: APNT(:) + INTEGER :: BUFSIZE, SOURCE, RCVPNT, MAXS, PNT, + & SAVEPNT + INTEGER, PARAMETER :: ITAG=30 + LOGICAL :: FLAG + nullify(MAPTAB, SNDCNT, RCVCNT, SDISPL, HALO_MAP) + nullify(RDISPL, MSGCNT, SIPES) + nullify(PCNT, TSENDI, TSENDJ, RCVBUF, APNT) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. id%N*2) THEN + WRITE(LP, + & '("Insufficient workspace inside BUILD_LOC_GRAPH")') + CALL MUMPS_ABORT() + END IF + MAPTAB => WORK( 1 : id%N) + HALO_MAP => WORK(id%N+1 : 2*id%N) + CALL MUMPS_733(SNDCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(RCVCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(MSGCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rrsndcnt:',MEMCNT,MAXMEM +#endif + ALLOCATE(APNT(NPROCS)) + SNDCNT = 0 + TOP_CNT = 0 + BUFSIZE = 10000 + LOCNNZ = id%NZ_loc + NROWS_LOC = ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1 + MAPTAB = 0 + MAXS = 0 + DO I=1, NPROCS + IF((ord%LAST(I)-ord%FIRST(I)+1) .GT. MAXS) THEN + MAXS = ord%LAST(I)-ord%FIRST(I)+1 + END IF + DO J=ord%FIRST(I), ord%LAST(I) + MAPTAB(ord%PERITAB(J)) = I + END DO + END DO + ALLOCATE(SIPES(max(1,MAXS), NPROCS)) + SIPES(:,:) = 0 + TOP_CNT = 0 + DO I=1, id%NZ_loc + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + PROC = MAPTAB(id%IRN_loc(I)) + IF(PROC .EQ. 0) THEN + TOP_CNT = TOP_CNT+1 + ELSE + IIDX = ord%PERMTAB(id%IRN_loc(I)) + LOC_ROW = IIDX-ord%FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + END IF + PROC = MAPTAB(id%JCN_loc(I)) + IF(PROC .EQ. 0) THEN + TOP_CNT = TOP_CNT+1 + ELSE + IIDX = ord%PERMTAB(id%JCN_loc(I)) + LOC_ROW = IIDX-ord%FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + END IF + END IF + END DO + CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, id%COMM, IERR) + I = ceiling(real(MAXS)*1.20E0) + CALL MUMPS_733(LENG, max(I,1), id%INFO, + & LP, STRING='B_L_G:LENG', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rrleng2:',MEMCNT, + & MAXMEM +#endif + SNDCNT(:) = MAXS + CALL MPI_REDUCE_SCATTER ( SIPES(1,1), LENG(1), SNDCNT(1), + & MPI_INTEGER, MPI_SUM, id%COMM, IERR ) + DEALLOCATE(SIPES) + I = ceiling(real(NROWS_LOC+1)*1.20E0) + CALL MUMPS_733(IPE, max(I,1), id%INFO, + & LP, STRING='B_L_G:IPE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rripe:',MEMCNT,MAXMEM +#endif + IPE(1) = 1 + DO I=1, NROWS_LOC + IPE(I+1) = IPE(I) + LENG(I) + END DO + CALL MUMPS_733(TSENDI, max(TOP_CNT,1), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(TSENDJ, max(TOP_CNT,1), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT tsendi:',MEMCNT,MAXMEM +#endif + LENG(:) = 0 + CALL SMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, + & LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + NEW_LOCNNZ = sum(RCVCNT) + DO I=1, NPROCS + MSGCNT(I) = RCVCNT(I)/BUFSIZE + END DO + CALL MUMPS_733(PE, max(NEW_LOCNNZ+2*NROWS_LOC,1), id%INFO, + & LP, STRING='B_L_G:PE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rrpe2:',MEMCNT,MAXMEM +#endif + RCVPNT = 1 + SNDCNT = 0 + TIDX = 0 + DO I=1, id%NZ_loc + IF(mod(I,BUFSIZE/10) .EQ. 0) THEN + CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, MPI_COMM_WORLD, + & FLAG, STATUS, IERR ) + IF(FLAG) THEN + SOURCE = STATUS(MPI_SOURCE) + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, SOURCE, + & ITAG, MPI_COMM_WORLD, STATUS, IERR) + CALL SMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + RCVPNT = RCVPNT + BUFSIZE + END IF + END IF + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + PROC = MAPTAB(id%IRN_loc(I)) + IF(PROC .EQ. 0) THEN + TIDX = TIDX+1 + TSENDI(TIDX) = id%IRN_loc(I) + TSENDJ(TIDX) = id%JCN_loc(I) + ELSE + IIDX = ord%PERMTAB(id%IRN_loc(I)) + JJDX = ord%PERMTAB(id%JCN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) =IIDX-ord%FIRST(PROC)+1 + IF( (JJDX .GE. ord%FIRST(PROC)) .AND. + & (JJDX .LE. ord%LAST(PROC)) ) THEN + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = JJDX-ord%FIRST(PROC)+1 + ELSE + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = -id%JCN_loc(I) + END IF + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL SMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, + & PE, LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + END IF + PROC = MAPTAB(id%JCN_loc(I)) + IF(PROC .EQ. 0) THEN + TIDX = TIDX+1 + TSENDI(TIDX) = id%JCN_loc(I) + TSENDJ(TIDX) = id%IRN_loc(I) + ELSE + IIDX = ord%PERMTAB(id%JCN_loc(I)) + JJDX = ord%PERMTAB(id%IRN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) = IIDX-ord%FIRST(PROC)+1 + IF( (JJDX .GE. ord%FIRST(PROC)) .AND. + & (JJDX .LE. ord%LAST(PROC)) ) THEN + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = JJDX-ord%FIRST(PROC)+1 + ELSE + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = -id%IRN_loc(I) + END IF + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL SMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, + & LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + END IF + END IF + END DO + CALL SMUMPS_785(APNT, -1, NPROCS, BUFSIZE, IPE, PE, LENG, + & RCVBUF, MSGCNT, SNDCNT, id%COMM) + DUPS = 0 + PNT = 0 + SAVEPNT = 1 + MAPTAB(:) = 0 + HALO_MAP(:) = 0 + HALO_SIZE = 0 + DO I=1, NROWS_LOC + DO J=IPE(I),IPE(I+1)-1 + IF(PE(J) .LT. 0) THEN + IF(HALO_MAP(-PE(J)) .EQ. 0) THEN + HALO_SIZE = HALO_SIZE+1 + HALO_MAP(-PE(J)) = NROWS_LOC+HALO_SIZE + END IF + PE(J) = HALO_MAP(-PE(J)) + END IF + IF(MAPTAB(PE(J)) .EQ. I) THEN + DUPS = DUPS+1 + LENG(I) = LENG(I)-1 + ELSE + MAPTAB(PE(J)) = I + PNT = PNT+1 + PE(PNT) = PE(J) + END IF + END DO + IPE(I) = SAVEPNT + SAVEPNT = PNT+1 + END DO + IPE(NROWS_LOC+1) = SAVEPNT + CALL MUMPS_733(I_HALO_MAP, HALO_SIZE, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT i_halo:',MEMCNT,MAXMEM +#endif + J=0 + DO I=1, id%N + IF(HALO_MAP(I) .GT. 0) THEN + J = J+1 + I_HALO_MAP(HALO_MAP(I)-NROWS_LOC) = I + END IF + IF(J .EQ. HALO_SIZE) EXIT + END DO + CALL MUMPS_733(LENG, max(NROWS_LOC+HALO_SIZE,1), id%INFO, + & LP, COPY=.TRUE., + & STRING='lcgrph:leng', MEMCNT=MEMCNT, ERRCODE=-7) + LENG(NROWS_LOC+1:NROWS_LOC+HALO_SIZE) = 0 + CALL MUMPS_733(IPE, NROWS_LOC+HALO_SIZE+1, id%INFO, + & LP, COPY=.TRUE., + & STRING='lcgrph:ipe', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT lengipe:',MEMCNT, + & MAXMEM +#endif + IPE(NROWS_LOC+2:NROWS_LOC+HALO_SIZE+1) = IPE(NROWS_LOC+1) + GSIZE = NROWS_LOC + HALO_SIZE + CALL MPI_GATHER(TOP_CNT, 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, 0, id%COMM, IERR) + RDISPL => MSGCNT + NULLIFY(MSGCNT) + IF(MYID.EQ.0) THEN + NEW_LOCNNZ = sum(RCVCNT) + RDISPL(1) = 0 + DO I=2, NPROCS + RDISPL(I) = RDISPL(I-1)+RCVCNT(I-1) + END DO + top_graph%NZ_LOC = NEW_LOCNNZ + top_graph%COMM = id%COMM + CALL MUMPS_733(top_graph%IRN_LOC, NEW_LOCNNZ, id%INFO, + & LP, MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(top_graph%JCN_LOC, NEW_LOCNNZ, id%INFO, + & LP, MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT top_graph:',MEMCNT, + & MAXMEM +#endif + ELSE + ALLOCATE(top_graph%IRN_LOC(1), top_graph%JCN_LOC(1)) + END IF + CALL MPI_GATHERV(TSENDI(1), TOP_CNT, MPI_INTEGER, + & top_graph%IRN_LOC(1), RCVCNT(1), RDISPL(1), MPI_INTEGER, + & 0, id%COMM, IERR) + CALL MPI_GATHERV(TSENDJ(1), TOP_CNT, MPI_INTEGER, + & top_graph%JCN_LOC(1), RCVCNT(1), RDISPL(1), MPI_INTEGER, + & 0, id%COMM, IERR) + CALL MUMPS_734(SNDCNT, RCVCNT, RDISPL, + & TSENDI, TSENDJ, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall sndcnt:',MEMCNT,MAXMEM +#endif + DEALLOCATE(APNT) + RETURN + END SUBROUTINE SMUMPS_775 + SUBROUTINE SMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, + & LENG, RCVBUF, MSGCNT, SNDCNT, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER :: NPROCS, PROC, COMM + TYPE(ARRPNT) :: APNT(:) + INTEGER :: BUFSIZE + INTEGER, POINTER :: RCVBUF(:), LENG(:), PE(:), IPE(:) + INTEGER :: MSGCNT(:), SNDCNT(:) + LOGICAL, SAVE :: INIT = .TRUE. + INTEGER, POINTER, SAVE :: SPACE(:,:,:) + LOGICAL, POINTER, SAVE :: PENDING(:) + INTEGER, POINTER, SAVE :: REQ(:), CPNT(:) + INTEGER :: IERR, MYID, I, SOURCE, TOTMSG + LOGICAL :: FLAG, TFLAG + INTEGER :: STATUS(MPI_STATUS_SIZE), + & TSTATUS(MPI_STATUS_SIZE) + INTEGER, PARAMETER :: ITAG=30, FTAG=31 + INTEGER, POINTER :: TMPI(:), RCVCNT(:) + CALL MPI_COMM_RANK (COMM, MYID, IERR) + CALL MPI_COMM_SIZE (COMM, NPROCS, IERR) + IF(INIT) THEN + ALLOCATE(SPACE(2*BUFSIZE, 2, NPROCS)) + ALLOCATE(RCVBUF(2*BUFSIZE)) + ALLOCATE(PENDING(NPROCS), CPNT(NPROCS)) + ALLOCATE(REQ(NPROCS)) + PENDING = .FALSE. + DO I=1, NPROCS + APNT(I)%BUF => SPACE(:,1,I) + CPNT(I) = 1 + END DO + INIT = .FALSE. + RETURN + END IF + IF(PROC .EQ. -1) THEN + TOTMSG = sum(MSGCNT) + DO + IF(TOTMSG .EQ. 0) EXIT + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, + & MPI_ANY_SOURCE, ITAG, COMM, STATUS, IERR) + CALL SMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) + SOURCE = STATUS(MPI_SOURCE) + TOTMSG = TOTMSG-1 + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + END DO + DO I=1, NPROCS + IF(PENDING(I)) THEN + CALL MPI_WAIT(REQ(I), TSTATUS, IERR) + END IF + END DO + ALLOCATE(RCVCNT(NPROCS)) + CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, COMM, IERR) + DO I=1, NPROCS + IF(SNDCNT(I) .GT. 0) THEN + TMPI => APNT(I)%BUF(:) + CALL MPI_ISEND(TMPI(1), 2*SNDCNT(I), MPI_INTEGER, I-1, + & FTAG, COMM, REQ(I), IERR) + END IF + END DO + DO I=1, NPROCS + IF(RCVCNT(I) .GT. 0) THEN + CALL MPI_RECV(RCVBUF(1), 2*RCVCNT(I), MPI_INTEGER, I-1, + & FTAG, COMM, STATUS, IERR) + CALL SMUMPS_773(RCVCNT(I), RCVBUF, + & IPE, PE, LENG) + END IF + END DO + DO I=1, NPROCS + IF(SNDCNT(I) .GT. 0) THEN + CALL MPI_WAIT(REQ(I), TSTATUS, IERR) + END IF + END DO + DEALLOCATE(SPACE) + DEALLOCATE(PENDING, CPNT) + DEALLOCATE(REQ) + DEALLOCATE(RCVBUF, RCVCNT) + nullify(SPACE, PENDING, CPNT, REQ, RCVBUF, RCVCNT) + INIT = .TRUE. + RETURN + END IF + IF(PENDING(PROC)) THEN + DO + CALL MPI_TEST(REQ(PROC), TFLAG, TSTATUS, IERR) + IF(TFLAG) THEN + PENDING(PROC) = .FALSE. + EXIT + ELSE + CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, COMM, + & FLAG, STATUS, IERR ) + IF(FLAG) THEN + SOURCE = STATUS(MPI_SOURCE) + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, + & SOURCE, ITAG, COMM, STATUS, IERR) + CALL SMUMPS_773(BUFSIZE, RCVBUF, IPE, + & PE, LENG) + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + END IF + END IF + END DO + END IF + TMPI => APNT(PROC)%BUF(:) + CALL MPI_ISEND(TMPI(1), 2*BUFSIZE, MPI_INTEGER, PROC-1, + & ITAG, COMM, REQ(PROC), IERR) + PENDING(PROC) = .TRUE. + CPNT(PROC) = mod(CPNT(PROC),2)+1 + APNT(PROC)%BUF => SPACE(:,CPNT(PROC),PROC) + SNDCNT(PROC) = 0 + RETURN + END SUBROUTINE SMUMPS_785 + SUBROUTINE SMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) +#ifdef MPELOG + USE MPEMOD + INCLUDE 'mpif.h' +#endif + IMPLICIT NONE + INTEGER :: BUFSIZE + INTEGER, POINTER :: RCVBUF(:), IPE(:), PE(:), LENG(:) + INTEGER :: I, ROW, COL +#ifdef MPELOG + INTEGER ::IERR + IERR = MPE_LOG_EVENT( MPE_ASM_BUF1, 0, '' ) +#endif + DO I=1, 2*BUFSIZE, 2 + ROW = RCVBUF(I) + COL = RCVBUF(I+1) + PE(IPE(ROW)+LENG(ROW)) = COL + LENG(ROW) = LENG(ROW) + 1 + END DO +#ifdef MPELOG + IERR = MPE_LOG_EVENT( MPE_ASM_BUF2, 0, '' ) +#endif + RETURN + END SUBROUTINE SMUMPS_773 + SUBROUTINE SMUMPS_777(ord) + TYPE(ORD_TYPE) :: ord + INTEGER :: I + ord%SON = -1 + ord%BROTHER = -1 + ord%NW = 0 + DO I=1, ord%CBLKNBR + ord%NW(I) = ord%NW(I)+ord%RANGTAB(I+1) - ord%RANGTAB(I) + IF (ord%TREETAB(I) .NE. -1) THEN + IF (ord%SON(ord%TREETAB(I)) .EQ. -1) THEN + ord%SON(ord%TREETAB(I)) = I + ELSE + ord%BROTHER(I) = ord%SON(ord%TREETAB(I)) + ord%SON(ord%TREETAB(I)) = I + END IF + ord%NW(ord%TREETAB(I)) = ord%NW(ord%TREETAB(I))+ ord%NW(I) + END IF + END DO + RETURN + END SUBROUTINE SMUMPS_777 + SUBROUTINE SMUMPS_784(N, L, A1, A2) + INTEGER :: I, LP, ISWAP, N + INTEGER :: L(0:), A1(:), A2(:) + LP = L(0) + I = 1 + DO + IF ((LP==0).OR.(I>N)) EXIT + DO + IF (LP >= I) EXIT + LP = L(LP) + END DO + ISWAP = A1(LP) + A1(LP) = A1(I) + A1(I) = ISWAP + ISWAP = A2(LP) + A2(LP) = A2(I) + A2(I) = ISWAP + ISWAP = L(LP) + L(LP) = L(I) + L(I) = LP + LP = ISWAP + I = I + 1 + ENDDO + END SUBROUTINE SMUMPS_784 + SUBROUTINE SMUMPS_783(N, K, L) + INTEGER :: N + INTEGER :: K(:), L(0:) + INTEGER :: P, Q, S, T + CONTINUE + L(0) = 1 + T = N + 1 + DO P = 1,N - 1 + IF (K(P) <= K(P+1)) THEN + L(P) = P + 1 + ELSE + L(T) = - (P+1) + T = P + END IF + END DO + L(T) = 0 + L(N) = 0 + IF (L(N+1) == 0) THEN + RETURN + ELSE + L(N+1) = iabs(L(N+1)) + END IF + 200 CONTINUE + S = 0 + T = N+1 + P = L(S) + Q = L(T) + IF(Q .EQ. 0) RETURN + 300 CONTINUE + IF(K(P) .GT. K(Q)) GOTO 600 + CONTINUE + L(S) = sign(P,L(S)) + S = P + P = L(P) + IF (P .GT. 0) GOTO 300 + CONTINUE + L(S) = Q + S = T + DO + T = Q + Q = L(Q) + IF (Q .LE. 0) EXIT + END DO + GOTO 800 + 600 CONTINUE + L(S) = sign(Q, L(S)) + S = Q + Q = L(Q) + IF (Q .GT. 0) GOTO 300 + CONTINUE + L(S) = P + S = T + DO + T = P + P = L(P) + IF (P .LE. 0) EXIT + END DO + 800 CONTINUE + P = -P + Q = -Q + IF(Q.EQ.0) THEN + L(S) = sign(P, L(S)) + L(T) = 0 + GOTO 200 + END IF + GOTO 300 + END SUBROUTINE SMUMPS_783 + FUNCTION MUMPS_795(A) + INTEGER, POINTER :: A(:) + INTEGER :: MUMPS_795 + IF(associated(A)) THEN + MUMPS_795 = size(A) + ELSE + MUMPS_795 = 0 + END IF + RETURN + END FUNCTION MUMPS_795 + SUBROUTINE MUMPS_734(A1, A2, A3, A4, A5, A6, A7, MEMCNT) + INTEGER, POINTER :: A1(:) + INTEGER, POINTER, OPTIONAL :: A2(:), A3(:), A4(:), A5(:), + & A6(:), A7(:) + INTEGER, OPTIONAL :: MEMCNT + INTEGER :: IMEMCNT + IMEMCNT = 0 + IF(associated(A1)) THEN + IMEMCNT = IMEMCNT+size(A1) + DEALLOCATE(A1) + END IF + IF(present(A2)) THEN + IF(associated(A2)) THEN + IMEMCNT = IMEMCNT+size(A2) + DEALLOCATE(A2) + END IF + END IF + IF(present(A3)) THEN + IF(associated(A3)) THEN + IMEMCNT = IMEMCNT+size(A3) + DEALLOCATE(A3) + END IF + END IF + IF(present(A4)) THEN + IF(associated(A4)) THEN + IMEMCNT = IMEMCNT+size(A4) + DEALLOCATE(A4) + END IF + END IF + IF(present(A5)) THEN + IF(associated(A5)) THEN + IMEMCNT = IMEMCNT+size(A5) + DEALLOCATE(A5) + END IF + END IF + IF(present(A6)) THEN + IF(associated(A6)) THEN + IMEMCNT = IMEMCNT+size(A6) + DEALLOCATE(A6) + END IF + END IF + IF(present(A7)) THEN + IF(associated(A7)) THEN + IMEMCNT = IMEMCNT+size(A7) + DEALLOCATE(A7) + END IF + END IF + IF(present(MEMCNT)) MEMCNT = MEMCNT-IMEMCNT + RETURN + END SUBROUTINE MUMPS_734 +#if defined(memprof) + FUNCTION ESTIMEM(MYID, N, NZR) + INTEGER :: ESTIMEM, MYID, NZR, N + IF(MYID.EQ.0) THEN + ESTIMEM = 12*N + ELSE + ESTIMEM = 7*N + END IF + IF(MYID.NE.0) TOPROWS=0 + IF(MYID .EQ. 0) ESTIMEM = ESTIMEM+2*TOPROWS*NZR + ESTIMEM = ESTIMEM+NRL + ESTIMEM = ESTIMEM+max(NRL,TOPROWS)*(NZR+2) + ESTIMEM = ESTIMEM+6*max(NRL,TOPROWS) + IF(MYID.EQ.0) ESTIMEM=ESTIMEM+3*TOPROWS + RETURN + END FUNCTION ESTIMEM +#endif + END MODULE + SUBROUTINE SMUMPS_448(ICNTL,CNTL) + IMPLICIT NONE + INTEGER NICNTL, NCNTL + PARAMETER (NICNTL=10, NCNTL=10) + INTEGER ICNTL(NICNTL) + REAL CNTL(NCNTL) + INTEGER I + ICNTL(1) = 6 + ICNTL(2) = 6 + ICNTL(3) = -1 + ICNTL(4) = -1 + ICNTL(5) = 0 + DO 10 I = 6,NICNTL + ICNTL(I) = 0 + 10 CONTINUE + CNTL(1) = 0.0E0 + CNTL(2) = 0.0E0 + DO 20 I = 3,NCNTL + CNTL(I) = 0.0E0 + 20 CONTINUE + RETURN + END SUBROUTINE SMUMPS_448 + SUBROUTINE SMUMPS_444 + & (M,N,NE,IP,IRN,A,IPERM,NUM,JPERM,PR,Q,L,D,RINF) + IMPLICIT NONE + INTEGER M,N,NE,NUM + INTEGER IP(N+1),IRN(NE),IPERM(M),JPERM(N),PR(N),Q(M),L(M) + REAL A(NE) + REAL D(M), RINF + INTEGER I,II,J,JJ,JORD,Q0,QLEN,IDUM,JDUM,ISP,JSP, + & K,KK,KK1,KK2,I0,UP,LOW + REAL CSP,DI,DNEW,DQ0,AI,A0,BV,TBV,RLX + REAL ZERO,MINONE,ONE + PARAMETER (ZERO=0.0E0,MINONE=-1.0E0,ONE=1.0E0) + INTRINSIC abs,min + EXTERNAL SMUMPS_445, SMUMPS_446, SMUMPS_447, SMUMPS_455 + RLX = D(1) + NUM = 0 + BV = RINF + DO 10 K = 1,N + JPERM(K) = 0 + PR(K) = IP(K) + 10 CONTINUE + DO 12 K = 1,M + IPERM(K) = 0 + D(K) = ZERO + 12 CONTINUE + DO 30 J = 1,N + A0 = MINONE + DO 20 K = IP(J),IP(J+1)-1 + I = IRN(K) + AI = abs(A(K)) + IF (AI.GT.D(I)) D(I) = AI + IF (JPERM(J).NE.0) GO TO 20 + IF (AI.GE.BV) THEN + A0 = BV + IF (IPERM(I).NE.0) GO TO 20 + JPERM(J) = I + IPERM(I) = J + NUM = NUM + 1 + ELSE + IF (AI.LE.A0) GO TO 20 + A0 = AI + I0 = I + ENDIF + 20 CONTINUE + IF (A0.NE.MINONE .AND. A0.LT.BV) THEN + BV = A0 + IF (IPERM(I0).NE.0) GO TO 30 + IPERM(I0) = J + JPERM(J) = I0 + NUM = NUM + 1 + ENDIF + 30 CONTINUE + IF (M.EQ.N) THEN + DO 35 I = 1,M + BV = min(BV,D(I)) + 35 CONTINUE + ENDIF + IF (NUM.EQ.N) GO TO 1000 + DO 95 J = 1,N + IF (JPERM(J).NE.0) GO TO 95 + DO 50 K = IP(J),IP(J+1)-1 + I = IRN(K) + AI = abs(A(K)) + IF (AI.LT.BV) GO TO 50 + IF (IPERM(I).EQ.0) GO TO 90 + JJ = IPERM(I) + KK1 = PR(JJ) + KK2 = IP(JJ+1) - 1 + IF (KK1.GT.KK2) GO TO 50 + DO 70 KK = KK1,KK2 + II = IRN(KK) + IF (IPERM(II).NE.0) GO TO 70 + IF (abs(A(KK)).GE.BV) GO TO 80 + 70 CONTINUE + PR(JJ) = KK2 + 1 + 50 CONTINUE + GO TO 95 + 80 JPERM(JJ) = II + IPERM(II) = JJ + PR(JJ) = KK + 1 + 90 NUM = NUM + 1 + JPERM(J) = I + IPERM(I) = J + PR(J) = K + 1 + 95 CONTINUE + IF (NUM.EQ.N) GO TO 1000 + DO 99 I = 1,M + D(I) = MINONE + L(I) = 0 + 99 CONTINUE + TBV = BV * (ONE-RLX) + DO 100 JORD = 1,N + IF (JPERM(JORD).NE.0) GO TO 100 + QLEN = 0 + LOW = M + 1 + UP = M + 1 + CSP = MINONE + J = JORD + PR(J) = -1 + DO 115 K = IP(J),IP(J+1)-1 + I = IRN(K) + DNEW = abs(A(K)) + IF (CSP.GE.DNEW) GO TO 115 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = I + JSP = J + IF (CSP.GE.TBV) GO TO 160 + ELSE + D(I) = DNEW + IF (DNEW.GE.TBV) THEN + LOW = LOW - 1 + Q(LOW) = I + ELSE + QLEN = QLEN + 1 + L(I) = QLEN + CALL SMUMPS_445(I,M,Q,D,L,1) + ENDIF + JJ = IPERM(I) + PR(JJ) = J + ENDIF + 115 CONTINUE + DO 150 JDUM = 1,NUM + IF (LOW.EQ.UP) THEN + IF (QLEN.EQ.0) GO TO 160 + I = Q(1) + IF (CSP.GE.D(I)) GO TO 160 + BV = D(I) + TBV = BV * (ONE-RLX) + DO 152 IDUM = 1,M + CALL SMUMPS_446(QLEN,M,Q,D,L,1) + L(I) = 0 + LOW = LOW - 1 + Q(LOW) = I + IF (QLEN.EQ.0) GO TO 153 + I = Q(1) + IF (D(I).LT.TBV) GO TO 153 + 152 CONTINUE + ENDIF + 153 UP = UP - 1 + Q0 = Q(UP) + DQ0 = D(Q0) + L(Q0) = UP + J = IPERM(Q0) + DO 155 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (L(I).GE.UP) GO TO 155 + DNEW = min(DQ0,abs(A(K))) + IF (CSP.GE.DNEW) GO TO 155 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = I + JSP = J + IF (CSP.GE.TBV) GO TO 160 + ELSE + DI = D(I) + IF (DI.GE.TBV .OR. DI.GE.DNEW) GO TO 155 + D(I) = DNEW + IF (DNEW.GE.TBV) THEN + IF (DI.NE.MINONE) THEN + CALL SMUMPS_447(L(I),QLEN,M,Q,D,L,1) + ENDIF + L(I) = 0 + LOW = LOW - 1 + Q(LOW) = I + ELSE + IF (DI.EQ.MINONE) THEN + QLEN = QLEN + 1 + L(I) = QLEN + ENDIF + CALL SMUMPS_445(I,M,Q,D,L,1) + ENDIF + JJ = IPERM(I) + PR(JJ) = J + ENDIF + 155 CONTINUE + 150 CONTINUE + 160 IF (CSP.EQ.MINONE) GO TO 190 + BV = min(BV,CSP) + TBV = BV * (ONE-RLX) + NUM = NUM + 1 + I = ISP + J = JSP + DO 170 JDUM = 1,NUM+1 + I0 = JPERM(J) + JPERM(J) = I + IPERM(I) = J + J = PR(J) + IF (J.EQ.-1) GO TO 190 + I = I0 + 170 CONTINUE + 190 DO 191 KK = UP,M + I = Q(KK) + D(I) = MINONE + L(I) = 0 + 191 CONTINUE + DO 192 KK = LOW,UP-1 + I = Q(KK) + D(I) = MINONE + 192 CONTINUE + DO 193 KK = 1,QLEN + I = Q(KK) + D(I) = MINONE + L(I) = 0 + 193 CONTINUE + 100 CONTINUE + 1000 IF (M.EQ.N .and. NUM.EQ.N) GO TO 2000 + CALL SMUMPS_455(M,N,IPERM,L,JPERM) + 2000 RETURN + END SUBROUTINE SMUMPS_444 + SUBROUTINE SMUMPS_445(I,N,Q,D,L,IWAY) + IMPLICIT NONE + INTEGER I,N,IWAY + INTEGER Q(N),L(N) + REAL D(N) + INTEGER IDUM,K,POS,POSK,QK + PARAMETER (K=2) + REAL DI + POS = L(I) + IF (POS.LE.1) GO TO 20 + DI = D(I) + IF (IWAY.EQ.1) THEN + DO 10 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.LE.D(QK)) GO TO 20 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 20 + 10 CONTINUE + ELSE + DO 15 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.GE.D(QK)) GO TO 20 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 20 + 15 CONTINUE + ENDIF + 20 Q(POS) = I + L(I) = POS + RETURN + END SUBROUTINE SMUMPS_445 + SUBROUTINE SMUMPS_446(QLEN,N,Q,D,L,IWAY) + IMPLICIT NONE + INTEGER QLEN,N,IWAY + INTEGER Q(N),L(N) + REAL D(N) + INTEGER I,IDUM,K,POS,POSK + PARAMETER (K=2) + REAL DK,DR,DI + I = Q(QLEN) + DI = D(I) + QLEN = QLEN - 1 + POS = 1 + IF (IWAY.EQ.1) THEN + DO 10 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 20 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.LT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.GE.DK) GO TO 20 + Q(POS) = Q(POSK) + L(Q(POS)) = POS + POS = POSK + 10 CONTINUE + ELSE + DO 15 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 20 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.GT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.LE.DK) GO TO 20 + Q(POS) = Q(POSK) + L(Q(POS)) = POS + POS = POSK + 15 CONTINUE + ENDIF + 20 Q(POS) = I + L(I) = POS + RETURN + END SUBROUTINE SMUMPS_446 + SUBROUTINE SMUMPS_447(POS0,QLEN,N,Q,D,L,IWAY) + IMPLICIT NONE + INTEGER POS0,QLEN,N,IWAY + INTEGER Q(N),L(N) + REAL D(N) + INTEGER I,IDUM,K,POS,POSK,QK + PARAMETER (K=2) + REAL DK,DR,DI + IF (QLEN.EQ.POS0) THEN + QLEN = QLEN - 1 + RETURN + ENDIF + I = Q(QLEN) + DI = D(I) + QLEN = QLEN - 1 + POS = POS0 + IF (IWAY.EQ.1) THEN + IF (POS.LE.1) GO TO 20 + DO 10 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.LE.D(QK)) GO TO 20 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 20 + 10 CONTINUE + 20 Q(POS) = I + L(I) = POS + IF (POS.NE.POS0) RETURN + DO 30 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 40 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.LT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.GE.DK) GO TO 40 + QK = Q(POSK) + Q(POS) = QK + L(QK) = POS + POS = POSK + 30 CONTINUE + ELSE + IF (POS.LE.1) GO TO 34 + DO 32 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.GE.D(QK)) GO TO 34 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 34 + 32 CONTINUE + 34 Q(POS) = I + L(I) = POS + IF (POS.NE.POS0) RETURN + DO 36 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 40 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.GT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.LE.DK) GO TO 40 + QK = Q(POSK) + Q(POS) = QK + L(QK) = POS + POS = POSK + 36 CONTINUE + ENDIF + 40 Q(POS) = I + L(I) = POS + RETURN + END SUBROUTINE SMUMPS_447 + SUBROUTINE SMUMPS_450(IP,LENL,LENH,W,WLEN,A,NVAL,VAL) + IMPLICIT NONE + INTEGER WLEN,NVAL + INTEGER IP(*),LENL(*),LENH(*),W(*) + REAL A(*),VAL + INTEGER XX,J,K,II,S,POS + PARAMETER (XX=10) + REAL SPLIT(XX),HA + NVAL = 0 + DO 10 K = 1,WLEN + J = W(K) + DO 15 II = IP(J)+LENL(J),IP(J)+LENH(J)-1 + HA = A(II) + IF (NVAL.EQ.0) THEN + SPLIT(1) = HA + NVAL = 1 + ELSE + DO 20 S = NVAL,1,-1 + IF (SPLIT(S).EQ.HA) GO TO 15 + IF (SPLIT(S).GT.HA) THEN + POS = S + 1 + GO TO 21 + ENDIF + 20 CONTINUE + POS = 1 + 21 DO 22 S = NVAL,POS,-1 + SPLIT(S+1) = SPLIT(S) + 22 CONTINUE + SPLIT(POS) = HA + NVAL = NVAL + 1 + ENDIF + IF (NVAL.EQ.XX) GO TO 11 + 15 CONTINUE + 10 CONTINUE + 11 IF (NVAL.GT.0) VAL = SPLIT((NVAL+1)/2) + RETURN + END SUBROUTINE SMUMPS_450 + SUBROUTINE SMUMPS_451(N,NE,IP,IRN,A) + IMPLICIT NONE + INTEGER N,NE + INTEGER IP(N+1),IRN(NE) + REAL A(NE) + INTEGER THRESH,TDLEN + PARAMETER (THRESH=15,TDLEN=50) + INTEGER J,IPJ,K,LEN,R,S,HI,FIRST,MID,LAST,TD + REAL HA,KEY + INTEGER TODO(TDLEN) + DO 100 J = 1,N + LEN = IP(J+1) - IP(J) + IF (LEN.LE.1) GO TO 100 + IPJ = IP(J) + IF (LEN.LT.THRESH) GO TO 400 + TODO(1) = IPJ + TODO(2) = IPJ + LEN + TD = 2 + 500 CONTINUE + FIRST = TODO(TD-1) + LAST = TODO(TD) + KEY = A((FIRST+LAST)/2) + DO 475 K = FIRST,LAST-1 + HA = A(K) + IF (HA.EQ.KEY) GO TO 475 + IF (HA.GT.KEY) GO TO 470 + KEY = HA + GO TO 470 + 475 CONTINUE + TD = TD - 2 + GO TO 425 + 470 MID = FIRST + DO 450 K = FIRST,LAST-1 + IF (A(K).LE.KEY) GO TO 450 + HA = A(MID) + A(MID) = A(K) + A(K) = HA + HI = IRN(MID) + IRN(MID) = IRN(K) + IRN(K) = HI + MID = MID + 1 + 450 CONTINUE + IF (MID-FIRST.GE.LAST-MID) THEN + TODO(TD+2) = LAST + TODO(TD+1) = MID + TODO(TD) = MID + ELSE + TODO(TD+2) = MID + TODO(TD+1) = FIRST + TODO(TD) = LAST + TODO(TD-1) = MID + ENDIF + TD = TD + 2 + 425 CONTINUE + IF (TD.EQ.0) GO TO 400 + IF (TODO(TD)-TODO(TD-1).GE.THRESH) GO TO 500 + TD = TD - 2 + GO TO 425 + 400 DO 200 R = IPJ+1,IPJ+LEN-1 + IF (A(R-1) .LT. A(R)) THEN + HA = A(R) + HI = IRN(R) + A(R) = A(R-1) + IRN(R) = IRN(R-1) + DO 300 S = R-1,IPJ+1,-1 + IF (A(S-1) .LT. HA) THEN + A(S) = A(S-1) + IRN(S) = IRN(S-1) + ELSE + A(S) = HA + IRN(S) = HI + GO TO 200 + END IF + 300 CONTINUE + A(IPJ) = HA + IRN(IPJ) = HI + END IF + 200 CONTINUE + 100 CONTINUE + RETURN + END SUBROUTINE SMUMPS_451 + SUBROUTINE SMUMPS_452(M,N,NE,IP,IRN,A,IPERM,NUMX, + & W,LEN,LENL,LENH,FC,IW,IW4,RLX,RINF) + IMPLICIT NONE + INTEGER M,N,NE,NUMX + INTEGER IP(N+1),IRN(NE),IPERM(N), + & W(N),LEN(N),LENL(N),LENH(N),FC(N),IW(M),IW4(3*N+M) + REAL A(NE),RLX,RINF + INTEGER NUM,NVAL,WLEN,II,I,J,K,L,CNT,MOD,IDUM1,IDUM2,IDUM3 + REAL BVAL,BMIN,BMAX + EXTERNAL SMUMPS_450,SMUMPS_453,SMUMPS_455 + DO 20 J = 1,N + FC(J) = J + LEN(J) = IP(J+1) - IP(J) + 20 CONTINUE + DO 21 I = 1,M + IW(I) = 0 + 21 CONTINUE + CNT = 1 + MOD = 1 + NUMX = 0 + CALL SMUMPS_453(CNT,MOD,M,N,IRN,NE,IP,LEN,FC,IW,NUMX,N, + & IW4(1),IW4(N+1),IW4(2*N+1),IW4(2*N+M+1)) + NUM = NUMX + IF (NUM.NE.N) THEN + BMAX = RINF + ELSE + BMAX = RINF + DO 30 J = 1,N + BVAL = 0.0E0 + DO 25 K = IP(J),IP(J+1)-1 + IF (A(K).GT.BVAL) BVAL = A(K) + 25 CONTINUE + IF (BVAL.LT.BMAX) BMAX = BVAL + 30 CONTINUE + BMAX = 1.001E0 * BMAX + ENDIF + BVAL = 0.0E0 + BMIN = 0.0E0 + WLEN = 0 + DO 48 J = 1,N + L = IP(J+1) - IP(J) + LENH(J) = L + LEN(J) = L + DO 45 K = IP(J),IP(J+1)-1 + IF (A(K).LT.BMAX) GO TO 46 + 45 CONTINUE + K = IP(J+1) + 46 LENL(J) = K - IP(J) + IF (LENL(J).EQ.L) GO TO 48 + WLEN = WLEN + 1 + W(WLEN) = J + 48 CONTINUE + DO 90 IDUM1 = 1,NE + IF (NUM.EQ.NUMX) THEN + DO 50 I = 1,M + IPERM(I) = IW(I) + 50 CONTINUE + DO 80 IDUM2 = 1,NE + BMIN = BVAL + IF (BMAX-BMIN .LE. RLX) GO TO 1000 + CALL SMUMPS_450(IP,LENL,LEN,W,WLEN,A,NVAL,BVAL) + IF (NVAL.LE.1) GO TO 1000 + K = 1 + DO 70 IDUM3 = 1,N + IF (K.GT.WLEN) GO TO 71 + J = W(K) + DO 55 II = IP(J)+LEN(J)-1,IP(J)+LENL(J),-1 + IF (A(II).GE.BVAL) GO TO 60 + I = IRN(II) + IF (IW(I).NE.J) GO TO 55 + IW(I) = 0 + NUM = NUM - 1 + FC(N-NUM) = J + 55 CONTINUE + 60 LENH(J) = LEN(J) + LEN(J) = II - IP(J) + 1 + IF (LENL(J).EQ.LENH(J)) THEN + W(K) = W(WLEN) + WLEN = WLEN - 1 + ELSE + K = K + 1 + ENDIF + 70 CONTINUE + 71 IF (NUM.LT.NUMX) GO TO 81 + 80 CONTINUE + 81 MOD = 1 + ELSE + BMAX = BVAL + IF (BMAX-BMIN .LE. RLX) GO TO 1000 + CALL SMUMPS_450(IP,LEN,LENH,W,WLEN,A,NVAL,BVAL) + IF (NVAL.EQ.0. OR. BVAL.EQ.BMIN) GO TO 1000 + K = 1 + DO 87 IDUM3 = 1,N + IF (K.GT.WLEN) GO TO 88 + J = W(K) + DO 85 II = IP(J)+LEN(J),IP(J)+LENH(J)-1 + IF (A(II).LT.BVAL) GO TO 86 + 85 CONTINUE + 86 LENL(J) = LEN(J) + LEN(J) = II - IP(J) + IF (LENL(J).EQ.LENH(J)) THEN + W(K) = W(WLEN) + WLEN = WLEN - 1 + ELSE + K = K + 1 + ENDIF + 87 CONTINUE + 88 MOD = 0 + ENDIF + CNT = CNT + 1 + CALL SMUMPS_453(CNT,MOD,M,N,IRN,NE,IP,LEN,FC,IW,NUM,NUMX, + & IW4(1),IW4(N+1),IW4(2*N+1),IW4(2*N+M+1)) + 90 CONTINUE + 1000 IF (M.EQ.N .and. NUMX.EQ.N) GO TO 2000 + CALL SMUMPS_455(M,N,IPERM,IW,W) + 2000 RETURN + END SUBROUTINE SMUMPS_452 + SUBROUTINE SMUMPS_453 + & (ID,MOD,M,N,IRN,LIRN,IP,LENC,FC,IPERM,NUM,NUMX, + & PR,ARP,CV,OUT) + IMPLICIT NONE + INTEGER ID,MOD,M,N,LIRN,NUM,NUMX + INTEGER ARP(N),CV(M),IRN(LIRN),IP(N), + & FC(N),IPERM(M),LENC(N),OUT(N),PR(N) + INTEGER I,II,IN1,IN2,J,J1,JORD,K,KK,LAST,NFC, + & NUM0,NUM1,NUM2,ID0,ID1 + IF (ID.EQ.1) THEN + DO 5 I = 1,M + CV(I) = 0 + 5 CONTINUE + DO 6 J = 1,N + ARP(J) = 0 + 6 CONTINUE + NUM1 = N + NUM2 = N + ELSE + IF (MOD.EQ.1) THEN + DO 8 J = 1,N + ARP(J) = 0 + 8 CONTINUE + ENDIF + NUM1 = NUMX + NUM2 = N - NUMX + ENDIF + NUM0 = NUM + NFC = 0 + ID0 = (ID-1)*N + DO 100 JORD = NUM0+1,N + ID1 = ID0 + JORD + J = FC(JORD-NUM0) + PR(J) = -1 + DO 70 K = 1,JORD + IF (ARP(J).GE.LENC(J)) GO TO 30 + IN1 = IP(J) + ARP(J) + IN2 = IP(J) + LENC(J) - 1 + DO 20 II = IN1,IN2 + I = IRN(II) + IF (IPERM(I).EQ.0) GO TO 80 + 20 CONTINUE + ARP(J) = LENC(J) + 30 OUT(J) = LENC(J) - 1 + DO 60 KK = 1,JORD + IN1 = OUT(J) + IF (IN1.LT.0) GO TO 50 + IN2 = IP(J) + LENC(J) - 1 + IN1 = IN2 - IN1 + DO 40 II = IN1,IN2 + I = IRN(II) + IF (CV(I).EQ.ID1) GO TO 40 + J1 = J + J = IPERM(I) + CV(I) = ID1 + PR(J) = J1 + OUT(J1) = IN2 - II - 1 + GO TO 70 + 40 CONTINUE + 50 J1 = PR(J) + IF (J1.EQ.-1) THEN + NFC = NFC + 1 + FC(NFC) = J + IF (NFC.GT.NUM2) THEN + LAST = JORD + GO TO 101 + ENDIF + GO TO 100 + ENDIF + J = J1 + 60 CONTINUE + 70 CONTINUE + 80 IPERM(I) = J + ARP(J) = II - IP(J) + 1 + NUM = NUM + 1 + DO 90 K = 1,JORD + J = PR(J) + IF (J.EQ.-1) GO TO 95 + II = IP(J) + LENC(J) - OUT(J) - 2 + I = IRN(II) + IPERM(I) = J + 90 CONTINUE + 95 IF (NUM.EQ.NUM1) THEN + LAST = JORD + GO TO 101 + ENDIF + 100 CONTINUE + LAST = N + 101 DO 110 JORD = LAST+1,N + NFC = NFC + 1 + FC(NFC) = FC(JORD-NUM0) + 110 CONTINUE + RETURN + END SUBROUTINE SMUMPS_453 + SUBROUTINE SMUMPS_454(M,N,NE,IP,IRN,A,IPERM,NUM, + & JPERM,OUT,PR,Q,L,U,D,RINF) + IMPLICIT NONE + INTEGER M,N,NE,NUM + INTEGER IP(N+1),IRN(NE),IPERM(M),JPERM(N),OUT(N),PR(N),Q(M),L(M) + REAL A(NE),U(M),D(M),RINF,RINF3 + INTEGER I,I0,II,J,JJ,JORD,Q0,QLEN,JDUM,ISP,JSP, + & K,K0,K1,K2,KK,KK1,KK2,UP,LOW + REAL CSP,DI,DMIN,DNEW,DQ0,VJ,RLX + LOGICAL LORD + REAL ZERO, ONE + PARAMETER (ZERO=0.0E0,ONE=1.0E0) + EXTERNAL SMUMPS_445, SMUMPS_446, SMUMPS_447, SMUMPS_455 + RLX = U(1) + RINF3 = U(2) + LORD = (JPERM(1).EQ.6) + NUM = 0 + DO 10 K = 1,N + JPERM(K) = 0 + PR(K) = IP(K) + D(K) = RINF + 10 CONTINUE + DO 15 K = 1,M + U(K) = RINF3 + IPERM(K) = 0 + L(K) = 0 + 15 CONTINUE + DO 30 J = 1,N + IF (IP(J+1)-IP(J) .GT. N/10 .AND. N.GT.50) GO TO 30 + DO 20 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (A(K).GT.U(I)) GO TO 20 + U(I) = A(K) + IPERM(I) = J + L(I) = K + 20 CONTINUE + 30 CONTINUE + DO 40 I = 1,M + J = IPERM(I) + IF (J.EQ.0) GO TO 40 + IF (JPERM(J).EQ.0) THEN + JPERM(J) = L(I) + D(J) = U(I) + NUM = NUM + 1 + ELSEIF (D(J).GT.U(I)) THEN + K = JPERM(J) + II = IRN(K) + IPERM(II) = 0 + JPERM(J) = L(I) + D(J) = U(I) + ELSE + IPERM(I) = 0 + ENDIF + 40 CONTINUE + IF (NUM.EQ.N) GO TO 1000 + DO 45 K = 1,M + D(K) = ZERO + 45 CONTINUE + DO 95 J = 1,N + IF (JPERM(J).NE.0) GO TO 95 + K1 = IP(J) + K2 = IP(J+1) - 1 + IF (K1.GT.K2) GO TO 95 + VJ = RINF + DO 50 K = K1,K2 + I = IRN(K) + DI = A(K) - U(I) + IF (DI.GT.VJ) GO TO 50 + IF (DI.LT.VJ .OR. DI.EQ.RINF) GO TO 55 + IF (IPERM(I).NE.0 .OR. IPERM(I0).EQ.0) GO TO 50 + 55 VJ = DI + I0 = I + K0 = K + 50 CONTINUE + D(J) = VJ + K = K0 + I = I0 + IF (IPERM(I).EQ.0) GO TO 90 + DO 60 K = K0,K2 + I = IRN(K) + IF (A(K)-U(I).GT.VJ) GO TO 60 + JJ = IPERM(I) + KK1 = PR(JJ) + KK2 = IP(JJ+1) - 1 + IF (KK1.GT.KK2) GO TO 60 + DO 70 KK = KK1,KK2 + II = IRN(KK) + IF (IPERM(II).GT.0) GO TO 70 + IF (A(KK)-U(II).LE.D(JJ)) GO TO 80 + 70 CONTINUE + PR(JJ) = KK2 + 1 + 60 CONTINUE + GO TO 95 + 80 JPERM(JJ) = KK + IPERM(II) = JJ + PR(JJ) = KK + 1 + 90 NUM = NUM + 1 + JPERM(J) = K + IPERM(I) = J + PR(J) = K + 1 + 95 CONTINUE + IF (NUM.EQ.N) GO TO 1000 + DO 99 I = 1,M + D(I) = RINF + L(I) = 0 + 99 CONTINUE + DO 100 JORD = 1,N + IF (JPERM(JORD).NE.0) GO TO 100 + DMIN = RINF + QLEN = 0 + LOW = M + 1 + UP = M + 1 + CSP = RINF + J = JORD + PR(J) = -1 + DO 115 K = IP(J),IP(J+1)-1 + I = IRN(K) + DNEW = A(K) - U(I) + IF (DNEW.GE.CSP) GO TO 115 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = K + JSP = J + ELSE + IF (DNEW.LT.DMIN) DMIN = DNEW + D(I) = DNEW + QLEN = QLEN + 1 + Q(QLEN) = K + ENDIF + 115 CONTINUE + Q0 = QLEN + QLEN = 0 + DO 120 KK = 1,Q0 + K = Q(KK) + I = IRN(K) + IF (CSP.LE.D(I)) THEN + D(I) = RINF + GO TO 120 + ENDIF + IF (D(I).LE.DMIN) THEN + LOW = LOW - 1 + Q(LOW) = I + L(I) = LOW + ELSE + QLEN = QLEN + 1 + L(I) = QLEN + CALL SMUMPS_445(I,M,Q,D,L,2) + ENDIF + JJ = IPERM(I) + OUT(JJ) = K + PR(JJ) = J + 120 CONTINUE + DO 150 JDUM = 1,NUM + IF (LOW.EQ.UP) THEN + IF (QLEN.EQ.0) GO TO 160 + I = Q(1) + IF (D(I).LT.RINF) DMIN = D(I)*(ONE+RLX) + IF (DMIN.GE.CSP) GO TO 160 + 152 CALL SMUMPS_446(QLEN,M,Q,D,L,2) + LOW = LOW - 1 + Q(LOW) = I + L(I) = LOW + IF (QLEN.EQ.0) GO TO 153 + I = Q(1) + IF (D(I).GT.DMIN) GO TO 153 + GO TO 152 + ENDIF + 153 Q0 = Q(UP-1) + DQ0 = D(Q0) + IF (DQ0.GE.CSP) GO TO 160 + IF (DMIN.GE.CSP) GO TO 160 + UP = UP - 1 + J = IPERM(Q0) + VJ = DQ0 - A(JPERM(J)) + U(Q0) + K1 = IP(J+1)-1 + IF (LORD) THEN + IF (CSP.NE.RINF) THEN + DI = CSP - VJ + IF (A(K1).GE.DI) THEN + K0 = JPERM(J) + IF (K0.GE.K1-6) GO TO 178 + 177 CONTINUE + K = (K0+K1)/2 + IF (A(K).GE.DI) THEN + K1 = K + ELSE + K0 = K + ENDIF + IF (K0.GE.K1-6) GO TO 178 + GO TO 177 + 178 DO 179 K = K0+1,K1 + IF (A(K).LT.DI) GO TO 179 + K1 = K - 1 + GO TO 181 + 179 CONTINUE + ENDIF + ENDIF + 181 IF (K1.EQ.JPERM(J)) K1 = K1 - 1 + ENDIF + K0 = IP(J) + DI = CSP - VJ + DO 155 K = K0,K1 + I = IRN(K) + IF (L(I).GE.LOW) GO TO 155 + DNEW = A(K) - U(I) + IF (DNEW.GE.DI) GO TO 155 + DNEW = DNEW + VJ + IF (DNEW.GT.D(I)) GO TO 155 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = K + JSP = J + DI = CSP - VJ + ELSE + IF (DNEW.GE.D(I)) GO TO 155 + D(I) = DNEW + IF (DNEW.LE.DMIN) THEN + IF (L(I).NE.0) THEN + CALL SMUMPS_447(L(I),QLEN,M,Q,D,L,2) + ENDIF + LOW = LOW - 1 + Q(LOW) = I + L(I) = LOW + ELSE + IF (L(I).EQ.0) THEN + QLEN = QLEN + 1 + L(I) = QLEN + ENDIF + CALL SMUMPS_445(I,M,Q,D,L,2) + ENDIF + JJ = IPERM(I) + OUT(JJ) = K + PR(JJ) = J + ENDIF + 155 CONTINUE + 150 CONTINUE + 160 IF (CSP.EQ.RINF) GO TO 190 + NUM = NUM + 1 + I = IRN(ISP) + J = JSP + IPERM(I) = J + JPERM(J) = ISP + DO 170 JDUM = 1,NUM + JJ = PR(J) + IF (JJ.EQ.-1) GO TO 180 + K = OUT(J) + I = IRN(K) + IPERM(I) = JJ + JPERM(JJ) = K + J = JJ + 170 CONTINUE + 180 DO 182 KK = UP,M + I = Q(KK) + U(I) = U(I) + D(I) - CSP + 182 CONTINUE + 190 DO 191 KK = UP,M + I = Q(KK) + D(I) = RINF + L(I) = 0 + 191 CONTINUE + DO 192 KK = LOW,UP-1 + I = Q(KK) + D(I) = RINF + L(I) = 0 + 192 CONTINUE + DO 193 KK = 1,QLEN + I = Q(KK) + D(I) = RINF + L(I) = 0 + 193 CONTINUE + 100 CONTINUE + 1000 CONTINUE + DO 1200 J = 1,N + K = JPERM(J) + IF (K.NE.0) THEN + D(J) = A(K) - U(IRN(K)) + ELSE + D(J) = ZERO + ENDIF + 1200 CONTINUE + DO 1201 I = 1,M + IF (IPERM(I).EQ.0) U(I) = ZERO + 1201 CONTINUE + IF (M.EQ.N .and. NUM.EQ.N) GO TO 2000 + CALL SMUMPS_455(M,N,IPERM,L,JPERM) + 2000 RETURN + END SUBROUTINE SMUMPS_454 + SUBROUTINE SMUMPS_457 + & (M,N,IRN,LIRN,IP,LENC,IPERM,NUM,PR,ARP,CV,OUT) + IMPLICIT NONE + INTEGER LIRN,M,N,NUM + INTEGER ARP(N),CV(M),IRN(LIRN),IP(N),IPERM(M),LENC(N),OUT(N),PR(N) + INTEGER I,II,IN1,IN2,J,J1,JORD,K,KK + EXTERNAL SMUMPS_455 + DO 10 I = 1,M + CV(I) = 0 + IPERM(I) = 0 + 10 CONTINUE + DO 12 J = 1,N + ARP(J) = LENC(J) - 1 + 12 CONTINUE + NUM = 0 + DO 1000 JORD = 1,N + J = JORD + PR(J) = -1 + DO 70 K = 1,JORD + IN1 = ARP(J) + IF (IN1.LT.0) GO TO 30 + IN2 = IP(J) + LENC(J) - 1 + IN1 = IN2 - IN1 + DO 20 II = IN1,IN2 + I = IRN(II) + IF (IPERM(I).EQ.0) GO TO 80 + 20 CONTINUE + ARP(J) = -1 + 30 CONTINUE + OUT(J) = LENC(J) - 1 + DO 60 KK = 1,JORD + IN1 = OUT(J) + IF (IN1.LT.0) GO TO 50 + IN2 = IP(J) + LENC(J) - 1 + IN1 = IN2 - IN1 + DO 40 II = IN1,IN2 + I = IRN(II) + IF (CV(I).EQ.JORD) GO TO 40 + J1 = J + J = IPERM(I) + CV(I) = JORD + PR(J) = J1 + OUT(J1) = IN2 - II - 1 + GO TO 70 + 40 CONTINUE + 50 CONTINUE + J = PR(J) + IF (J.EQ.-1) GO TO 1000 + 60 CONTINUE + 70 CONTINUE + 80 CONTINUE + IPERM(I) = J + ARP(J) = IN2 - II - 1 + NUM = NUM + 1 + DO 90 K = 1,JORD + J = PR(J) + IF (J.EQ.-1) GO TO 1000 + II = IP(J) + LENC(J) - OUT(J) - 2 + I = IRN(II) + IPERM(I) = J + 90 CONTINUE + 1000 CONTINUE + IF (M.EQ.N .and. NUM.EQ.N) GO TO 2000 + CALL SMUMPS_455(M,N,IPERM,CV,ARP) + 2000 RETURN + END SUBROUTINE SMUMPS_457 + SUBROUTINE SMUMPS_455(M,N,IPERM,RW,CW) + IMPLICIT NONE + INTEGER M,N + INTEGER RW(M),CW(N),IPERM(M) + INTEGER I,J,K + DO 10 J = 1,N + CW(J) = 0 + 10 CONTINUE + K = 0 + DO 20 I = 1,M + IF (IPERM(I).EQ.0) THEN + K = K + 1 + RW(K) = I + ELSE + J = IPERM(I) + CW(J) = I + ENDIF + 20 CONTINUE + K = 0 + DO 30 J = 1,N + IF (CW(J).NE.0) GO TO 30 + K = K + 1 + I = RW(K) + IPERM(I) = -J + 30 CONTINUE + DO 40 J = N+1,M + K = K + 1 + I = RW(K) + IPERM(I) = -J + 40 CONTINUE + RETURN + END SUBROUTINE SMUMPS_455 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part3.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part3.F new file mode 100644 index 000000000..33fa4c497 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part3.F @@ -0,0 +1,6715 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + RECURSIVE SUBROUTINE SMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & + & INODE_PERE, ISON, NSLAVES_PERE, LIST_SLAVES_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP, TROW, + & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, + & root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE SMUMPS_COMM_BUFFER + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC ) :: root + INTEGER LBUFR, LBUFR_BYTES + INTEGER ICNTL( 40 ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER SLAVEF, NBFIN + INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS, POSFAC + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), + & PIMASTER(KEEP(28)) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER COMP + INTEGER NSTK( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM, MYID + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER INODE_PERE, ISON + INTEGER NFS4FATHER + INTEGER NBROWS_ALREADY_SENT + INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE + INTEGER LIST_SLAVES_PERE( * ) + INTEGER LMAP + INTEGER TROW( LMAP ) + DOUBLE PRECISION OPASSW, OPELIW + REAL DBLARR(max(1,KEEP(13))) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER NOSLA, I, ISTCHK, ISTCHK_LOC + INTEGER INDICE_PERE + INTEGER INDICE_PERE_ARRAY_ARG(1) + INTEGER PDEST, PDEST_MASTER + INTEGER NFRONT + INTEGER(8) :: SIZFR + INTEGER LDA_SON + INTEGER NSLSON, NBCOLS, NROW, NROWS_TO_SEND, IROW_SON, + & NPIV, NROWS_TO_STACK, II, COLLIST + INTEGER(8) :: POSROW, SHIFTCB_SON + INTEGER NBCOLS_EFF + INTEGER PDEST_MASTER_ISON, IPOS_IN_SLAVE + LOGICAL DESCLU, SLAVE_ISON + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER MSGSOU, MSGTAG + INTEGER LP + INTEGER ITMP + LOGICAL SAME_PROC, COMPRESSCB + LOGICAL IS_ERROR_BROADCASTED, IS_ofType5or6 + INTEGER ITYPE, TYPESPLIT + INTEGER KEEP253_LOC + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275, MUMPS_330, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, MUMPS_810 + INTEGER LMAP_LOC, allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: NBROW + INTEGER, ALLOCATABLE, DIMENSION(:) :: SLAVES_PERE + INTEGER, ALLOCATABLE, DIMENSION(:) :: MAP, PERM + IS_ERROR_BROADCASTED = .FALSE. + TYPESPLIT = MUMPS_810(PROCNODE_STEPS(STEP(INODE_PERE)), + & SLAVEF) + IS_ofType5or6 = ((TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + ALLOCATE(SLAVES_PERE(0:NSLAVES_PERE), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP > 0) write(LP,*) MYID, + & ' : PB allocation SLAVES_PERE in SMUMPS_210' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 700 + endif + IF (NSLAVES_PERE.GT.0) + &SLAVES_PERE(1:NSLAVES_PERE) = LIST_SLAVES_PERE(1:NSLAVES_PERE) + SLAVES_PERE(0) = MUMPS_275( PROCNODE_STEPS(STEP(INODE_PERE)), + & SLAVEF ) + ALLOCATE(NBROW(0:NSLAVES_PERE), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP>0) write(LP,*) MYID, + & ' : PB allocation NBROW in SMUMPS_210' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 670 + endif + LMAP_LOC = LMAP + ALLOCATE(MAP(LMAP_LOC), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP>0) THEN + write(LP,*) MYID, ' : PB allocation LMAP in SMUMPS_210' + ENDIF + IFLAG =-13 + IERROR = LMAP + GOTO 680 + endif + MAP( 1 : LMAP ) = TROW( 1 : LMAP ) + PDEST_MASTER_ISON = MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) + SLAVE_ISON = PDEST_MASTER_ISON .NE. MYID + IF (SLAVE_ISON) THEN + DO WHILE ( PTRIST(STEP( ISON )) .EQ. 0 ) + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & PDEST_MASTER_ISON, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. + & ) + IF ( IFLAG .LT. 0 ) THEN + IS_ERROR_BROADCASTED = .TRUE. + GOTO 670 + ENDIF + END DO + DO WHILE ( + & ( IW( PTRIST(STEP(ISON)) + 1 + KEEP(IXSZ) ) .NE. + & IW( PTRIST(STEP(ISON)) + 3 + KEEP(IXSZ) ) ) .OR. + & ( KEEP(50) .NE. 0 .AND. + & IW( PTRIST(STEP(ISON)) + 6 + KEEP(IXSZ) ) .NE. 0 ) ) + IF ( KEEP(50).eq.0) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO + ELSE + IF ( IW( PTRIST(STEP(ISON)) + 1 + KEEP(IXSZ) ) .NE. + & IW( PTRIST(STEP(ISON)) + 3 + KEEP(IXSZ) ) ) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO_SYM + ELSE + MSGSOU = MPI_ANY_SOURCE + MSGTAG = BLOC_FACTO_SYM_SLAVE + END IF + END IF + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MSGTAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) THEN + IS_ERROR_BROADCASTED = .TRUE. + GOTO 670 + ENDIF + END DO + ENDIF + IF ( NSLAVES_PERE .EQ. 0 ) THEN + NBROW( 0 ) = LMAP + ELSE + DO I = 0, NSLAVES_PERE + NBROW( I ) = 0 + END DO + DO I = 1, LMAP_LOC + INDICE_PERE = MAP( I ) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + NBROW( NOSLA ) = NBROW( NOSLA ) + 1 + END DO + DO I = 1, NSLAVES_PERE + NBROW(I)=NBROW(I)+NBROW(I-1) + ENDDO + ENDIF + ALLOCATE(PERM(LMAP_LOC), stat=allocok) + IF (allocok .GT. 0) THEN + IF (LP.GT.0) THEN + write(LP,*) MYID,': PB allocation PERM in SMUMPS_210' + ENDIF + IFLAG =-13 + IERROR = LMAP_LOC + GOTO 670 + ENDIF + ISTCHK = PTRIST(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + KEEP253_LOC = 0 + DO I = LMAP_LOC, 1, -1 + INDICE_PERE = MAP( I ) + IF (INDICE_PERE > NFRONT_PERE - KEEP(253)) THEN + KEEP253_LOC = KEEP253_LOC + 1 + ENDIF + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + PERM( NBROW( NOSLA ) ) = I + NBROW( NOSLA ) = NBROW( NOSLA ) - 1 + ENDDO + DO I = 0, NSLAVES_PERE + NBROW(I)=NBROW(I)+1 + END DO + PDEST_MASTER = SLAVES_PERE(0) + DO I = 0, NSLAVES_PERE + PDEST = SLAVES_PERE( I ) + IF ( PDEST .EQ. MYID ) THEN + NBPROCFILS(STEP(INODE_PERE)) = + & NBPROCFILS(STEP(INODE_PERE)) - 1 + IF ( PDEST .EQ. PDEST_MASTER ) THEN + NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - 1 + ENDIF + ISTCHK = PTRIST(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + NROW = IW(ISTCHK+2+KEEP(IXSZ)) + NPIV = IW(ISTCHK+3+KEEP(IXSZ)) + NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) + NFRONT = NPIV + NBCOLS + COMPRESSCB = (IW(ISTCHK+XXS).EQ.S_CB1COMP) + CALL MUMPS_729(SIZFR, IW(ISTCHK+XXR)) + IF (IW(ISTCHK+XXS).EQ.S_NOLCBCONTIG) THEN + LDA_SON = NBCOLS + SHIFTCB_SON = int(NPIV,8)*int(NROW,8) + ELSE IF (IW(ISTCHK+XXS).EQ.S_NOLCLEANED) THEN + LDA_SON = NBCOLS + SHIFTCB_SON = 0_8 + ELSE + LDA_SON = NFRONT + SHIFTCB_SON = int(NPIV,8) + ENDIF + IF (I == NSLAVES_PERE) THEN + NROWS_TO_STACK=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_STACK=NBROW(I+1)-NBROW(I) + ENDIF + IF (PDEST .NE. PDEST_MASTER) THEN + IF ( KEEP(55) .eq. 0 ) THEN + CALL SMUMPS_539 + & (N, INODE_PERE, IW, LIW, + & A, LA, NROWS_TO_STACK, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, MYID ) + ELSE + CALL SMUMPS_123(NELT, FRTPTR, FRTELT, + & N, INODE_PERE, IW, LIW, + & A, LA, NROWS_TO_STACK, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP, KEEP8, MYID ) + ENDIF + ENDIF + DO II = 1,NROWS_TO_STACK + IROW_SON = PERM(NBROW(I)+II-1) + INDICE_PERE=MAP(IROW_SON) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + INDICE_PERE = IPOS_IN_SLAVE + IF ( COMPRESSCB ) THEN + IF (NBCOLS - NROW .EQ. 0 ) THEN + ITMP = IROW_SON + POSROW = PTRAST(STEP(ISON))+ + & int(ITMP,8) * int(ITMP-1,8) / 2_8 + ELSE + ITMP = IROW_SON + NBCOLS - NROW + POSROW = PTRAST(STEP(ISON)) + & + int(ITMP,8) * int(ITMP-1,8) / 2_8 + & - int(NBCOLS-NROW,8) * int(NBCOLS-NROW+1,8)/2_8 + ENDIF + ELSE + POSROW = PTRAST(STEP(ISON)) + SHIFTCB_SON + & +int(IROW_SON-1,8)*int(LDA_SON,8) + ENDIF + IF (PDEST == PDEST_MASTER) THEN + IF (KEEP(50).NE.0) THEN + NBCOLS_EFF = IROW_SON + NBCOLS - NROW + ELSE + NBCOLS_EFF = NBCOLS + ENDIF + INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE + IF ((IS_ofType5or6).AND.(KEEP(50).EQ.0)) THEN + CALL SMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NROWS_TO_STACK, NBCOLS_EFF, + & INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, LDA_SON + & ) + EXIT + ELSE IF ( (KEEP(50).NE.0) .AND. + & (.NOT.COMPRESSCB).AND.(IS_ofType5or6) ) THEN + CALL SMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NROWS_TO_STACK, + & NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, LDA_SON + &) + EXIT + ELSE + CALL SMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, LDA_SON + &) + ENDIF + ELSE + ISTCHK = PTRIST(STEP(ISON)) + COLLIST = ISTCHK + 6 + KEEP(IXSZ) + & + IW( ISTCHK + 5 +KEEP(IXSZ)) + NROW + NPIV + IF (KEEP(50).NE.0) THEN + NBCOLS_EFF = IROW_SON + NBCOLS - NROW + ELSE + NBCOLS_EFF = NBCOLS + ENDIF + INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE + IF ( (IS_ofType5or6) .AND. + & ( + & ( KEEP(50).EQ.0) + & .OR. + & ( (KEEP(50).NE.0).and. (.NOT.COMPRESSCB) ) + & ) + & ) THEN + CALL SMUMPS_40(N, INODE_PERE, + & IW, LIW, + & A, LA, NROWS_TO_STACK, NBCOLS, + & INDICE_PERE_ARRAY_ARG, + & IW( COLLIST ), A(POSROW), + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, ICNTL, KEEP,KEEP8, + & MYID, IS_ofType5or6, LDA_SON) + EXIT + ELSE + CALL SMUMPS_40(N, INODE_PERE, + & IW, LIW, + & A, LA, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & IW( COLLIST ), A(POSROW), + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, ICNTL, KEEP,KEEP8, + & MYID, IS_ofType5or6, LDA_SON) + ENDIF + ENDIF + ENDDO + IF (PDEST.EQ.PDEST_MASTER) THEN + IF (KEEP(219).NE.0) THEN + IF(NSLAVES_PERE.GT.0 .AND. KEEP(50).EQ.2) THEN + IF (COMPRESSCB) THEN + WRITE(*,*) "Error 1 in PARPIV/SMUMPS_210" + CALL MUMPS_ABORT() + ELSE + POSROW = PTRAST(STEP(ISON))+SHIFTCB_SON+ + & int(NBROW(1)-1,8)*int(LDA_SON,8) + ENDIF + CALL SMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE.0) THEN + IF (LP .GT. 0) THEN + WRITE(LP, *) "MAX_ARRAY allocation failed" + ENDIF + IFLAG=-13 + IERROR=NFS4FATHER + GOTO 600 + ENDIF + ITMP=-9999 + IF ( LMAP_LOC-NBROW(1)+1-KEEP253_LOC .NE. 0 ) THEN + CALL SMUMPS_618( + & A(POSROW), + & SIZFR-SHIFTCB_SON-int(NBROW(1)-1,8)*int(LDA_SON,8), + & LDA_SON, LMAP_LOC-NBROW(1)+1-KEEP253_LOC, + & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB,ITMP) + ELSE + CALL SMUMPS_757( + & BUF_MAX_ARRAY, NFS4FATHER) + ENDIF + CALL SMUMPS_619(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NFS4FATHER, + & BUF_MAX_ARRAY, PTLUST_S, PTRAST, + & STEP, PIMASTER, + & OPASSW,IWPOSCB,MYID, KEEP,KEEP8) + ENDIF + ENDIF + IF ( NBPROCFILS(STEP(ISON)) .EQ. 0) THEN + ISTCHK_LOC = PIMASTER(STEP(ISON)) + SAME_PROC= ISTCHK_LOC .LT. IWPOSCB + IF (SAME_PROC) THEN + CALL SMUMPS_530(N, ISON, INODE_PERE, + & IWPOSCB, PIMASTER, PTLUST_S, IW, LIW, STEP, + & KEEP,KEEP8) + ENDIF + IF (SAME_PROC) THEN + ISTCHK_LOC = PTRIST(STEP(ISON)) + PTRIST(STEP( ISON) ) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL SMUMPS_152(.FALSE., MYID, N, + & ISTCHK_LOC, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, IWPOSCB, + & LA, KEEP,KEEP8, .FALSE. + & ) + ENDIF + IF ( NBPROCFILS(STEP(INODE_PERE)) .EQ. 0 ) THEN + CALL SMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), + & KEEP(47), STEP, INODE_PERE+N ) + IF (KEEP(47) .GE. 3) THEN + CALL SMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + ELSE + CALL SMUMPS_531 + & (N, INODE_PERE, IW, LIW, + & NBROW(I), STEP, PTRIST, ITLOC, RHS_MUMPS, + & KEEP,KEEP8) + END IF + END IF + END DO + DO I = NSLAVES_PERE, 0, -1 + PDEST = SLAVES_PERE( I ) + IF ( PDEST .NE. MYID ) THEN + DESCLU = .FALSE. + NBROWS_ALREADY_SENT = 0 + IF (I == NSLAVES_PERE) THEN + NROWS_TO_SEND=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_SEND=NBROW(I+1)-NBROW(I) + ENDIF + COMPRESSCB=(IW(PTRIST(STEP(ISON))+XXS).EQ.S_CB1COMP) + 95 CONTINUE + IF ( PTRIST(STEP(ISON)) .lt.0 .or. + & IW ( PTRIST(STEP(ISON) )+KEEP(IXSZ) ) .GT. N ) THEN + WRITE(*,*) MYID,': Internal error in Maplig' + WRITE(*,*) MYID,': PTRIST(STEP(ISON))/N=', + & PTRIST(STEP(ISON)), N + WRITE(*,*) MYID,': I, NBROW(I)=',I, NBROW(I) + WRITE(*,*) MYID,': NSLAVES_PERE=',NSLAVES_PERE + WRITE(*,*) MYID,': ISON, INODE_PERE=',ISON,INODE_PERE + WRITE(*,*) MYID,': Son header=', + & IW(PTRIST(STEP(ISON)): PTRIST(STEP(ISON))+5+KEEP(IXSZ)) + CALL MUMPS_ABORT() + END IF + CALL SMUMPS_67( NBROWS_ALREADY_SENT, + & DESCLU, INODE_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER, + & NSLAVES_PERE, ISON, + & NROWS_TO_SEND, LMAP_LOC, MAP, + & PERM(min(LMAP_LOC,NBROW(I))), + & IW( PTRIST(STEP(ISON))), + & A(PTRAST(STEP(ISON))), I, PDEST, PDEST_MASTER, + & COMM, IERR, + & + & KEEP,KEEP8, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, COMPRESSCB, + & KEEP253_LOC ) + IF ( IERR .EQ. -2 ) THEN + IFLAG = -17 + IF (LP .GT. 0) THEN + WRITE(LP,*) + & "FAILURE: SEND BUFFER TOO SMALL IN SMUMPS_210" + ENDIF + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * IW(PTRIST(STEP(ISON))+KEEP(IXSZ)) + & * KEEP( 35 ) + GO TO 600 + END IF + IF ( IERR .EQ. -3 ) THEN + IF (LP .GT. 0) THEN + WRITE(LP,*) + & "FAILURE: RECV BUFFER TOO SMALL IN SMUMPS_210" + ENDIF + IFLAG = -20 + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * IW(PTRIST(STEP(ISON))+KEEP(IXSZ)) + & * KEEP( 35 ) + GOTO 600 + ENDIF + IF (KEEP(219).NE.0) THEN + IF ( IERR .EQ. -4 ) THEN + IFLAG = -13 + IERROR = NFS4FATHER + IF (LP .GT. 0) THEN + WRITE(LP, *) + & "FAILURE: MAX_ARRAY allocation failed IN SMUMPS_210" + ENDIF + GO TO 600 + END IF + END IF + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) THEN + IS_ERROR_BROADCASTED=.TRUE. + GOTO 600 + ENDIF + GO TO 95 + END IF + END IF + END DO + ITYPE = MUMPS_330(PROCNODE_STEPS(STEP(ISON)), SLAVEF) + IF (KEEP(214) .EQ. 2) THEN + CALL SMUMPS_314( N, ISON, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE + & ) + IF (IFLAG .LT. 0) THEN + IS_ERROR_BROADCASTED = .TRUE. + GOTO 600 + ENDIF + ENDIF + CALL SMUMPS_626( N, ISON, PTRIST, PTRAST, IW, LIW, + & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, + & STEP, MYID, KEEP + &) + 600 CONTINUE + DEALLOCATE(PERM) + 670 CONTINUE + DEALLOCATE(MAP) + 680 CONTINUE + DEALLOCATE(NBROW) + DEALLOCATE(SLAVES_PERE) + 700 CONTINUE + IF (IFLAG .LT. 0 .AND. .NOT. IS_ERROR_BROADCASTED) THEN + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + ENDIF + RETURN + END SUBROUTINE SMUMPS_210 + SUBROUTINE SMUMPS_211( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & + & INODE_PERE, ISON, NSLAVES_PERE, LIST_SLAVES_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER, LMAP, TROW, + & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE SMUMPS_COMM_BUFFER + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER ICNTL( 40 ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER SLAVEF, NBFIN + INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS, POSFAC + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + REAL A( LA ) + INTEGER COMP + INTEGER IFLAG, IERROR, COMM, MYID + INTEGER LPOOL, LEAF + INTEGER INODE_PERE, ISON + INTEGER NFS4FATHER + INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE + INTEGER LIST_SLAVES_PERE(NSLAVES_PERE) + INTEGER NELIM, LMAP, TROW( LMAP ) + DOUBLE PRECISION OPASSW, OPELIW + REAL DBLARR(max(1,KEEP(13))) + INTEGER LPTRAR, NELT + INTEGER IW( LIW ) + INTEGER BUFR( LBUFR ) + INTEGER IPOOL( LPOOL ) + INTEGER NSTK( KEEP(28) ), ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER LP + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER NOSLA, I, ISTCHK, ISTCHK_LOC + INTEGER NBROWS_ALREADY_SENT + INTEGER INDICE_PERE + INTEGER INDICE_PERE_ARRAY_ARG(1) + INTEGER PDEST, PDEST_MASTER, NFRONT + LOGICAL SAME_PROC, DESCLU + INTEGER(8) :: APOS, POSROW, ASIZE + INTEGER NSLSON, NBCOLS, NROW, NROWS_TO_SEND, + & NPIV, NROWS_TO_STACK, II, IROW_SON, + & IPOS_IN_SLAVE + INTEGER NBCOLS_EFF + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + LOGICAL COMPRESSCB + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER LMAP_LOC, allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: NBROW + INTEGER, ALLOCATABLE, DIMENSION(:) :: SLAVES_PERE + INTEGER, ALLOCATABLE, DIMENSION(:) :: MAP, PERM + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + if (NSLAVES_PERE.le.0) then + write(6,*) ' error 2 in maplig_fils_niv1 ', NSLAVES_PERE + CALL MUMPS_ABORT() + endif + ALLOCATE(NBROW(0:NSLAVES_PERE), stat=allocok) + IF (allocok .GT. 0) THEN + IF (LP > 0) + & write(LP,*) MYID, + & ' : PB allocation NBROW in SMUMPS_211' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 700 + ENDIF + ALLOCATE(SLAVES_PERE(0:NSLAVES_PERE), stat =allocok) + IF ( allocok .GT. 0 ) THEN + IF (LP > 0) write(LP,*) MYID, + & ' : PB allocation SLAVES_PERE in SMUMPS_211' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 700 + ENDIF + SLAVES_PERE(1:NSLAVES_PERE) = LIST_SLAVES_PERE(1:NSLAVES_PERE) + SLAVES_PERE(0) = MUMPS_275( + & PROCNODE_STEPS(STEP(INODE_PERE)), + & SLAVEF ) + LMAP_LOC = LMAP + ALLOCATE(MAP(LMAP_LOC), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP > 0) write(LP,*) MYID, + & ' : PB allocation LMAP in SMUMPS_211' + IFLAG =-13 + IERROR = LMAP_LOC + GOTO 700 + endif + MAP( 1 : LMAP_LOC ) = TROW( 1 : LMAP_LOC ) + DO I = 0, NSLAVES_PERE + NBROW( I ) = 0 + END DO + IF (NSLAVES_PERE == 0) THEN + NBROW(0) = LMAP_LOC + ELSE + DO I = 1, LMAP_LOC + INDICE_PERE = MAP( I ) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + NBROW( NOSLA ) = NBROW( NOSLA ) + 1 + END DO + DO I = 1, NSLAVES_PERE + NBROW(I)=NBROW(I)+NBROW(I-1) + ENDDO + ENDIF + ALLOCATE(PERM(LMAP_LOC), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP > 0) write(LP,*) MYID, + & ': PB allocation PERM in SMUMPS_211' + IFLAG =-13 + IERROR = LMAP_LOC + GOTO 700 + endif + ISTCHK = PIMASTER(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + DO I = LMAP_LOC, 1, -1 + INDICE_PERE = MAP( I ) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + PERM( NBROW( NOSLA ) ) = I + NBROW( NOSLA ) = NBROW( NOSLA ) - 1 + ENDDO + DO I = 0, NSLAVES_PERE + NBROW(I)=NBROW(I)+1 + END DO + PDEST_MASTER = MYID + IF ( SLAVES_PERE(0) .NE. MYID ) THEN + WRITE(*,*) 'Error 1 in MAPLIG_FILS_NIV1:',MYID, SLAVES_PERE + CALL MUMPS_ABORT() + END IF + PDEST = PDEST_MASTER + I = 0 + NBPROCFILS(STEP(INODE_PERE))=NBPROCFILS(STEP(INODE_PERE))-1 + NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - 1 + ISTCHK = PIMASTER(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + NELIM = IW(ISTCHK+1+KEEP(IXSZ)) + NROW = IW(ISTCHK+2+KEEP(IXSZ)) + NPIV = IW(ISTCHK+3+KEEP(IXSZ)) + IF (NPIV.LT.0) THEN + write(6,*) ' Error 2 in SMUMPS_211 ', NPIV + CALL MUMPS_ABORT() + ENDIF + NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) + NFRONT = NPIV + NBCOLS + COMPRESSCB=(IW(PTRIST(STEP(ISON))+XXS) .eq. S_CB1COMP) + IF (I == NSLAVES_PERE) THEN + NROWS_TO_STACK=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_STACK=NBROW(I+1)-NBROW(I) + ENDIF + DO II = 1,NROWS_TO_STACK + IROW_SON=PERM(NBROW(I)+II-1) + INDICE_PERE = MAP(IROW_SON) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + INDICE_PERE = IPOS_IN_SLAVE + IF (COMPRESSCB) THEN + IF (NELIM.EQ.0) THEN + POSROW = PAMASTER(STEP(ISON)) + + & int(IROW_SON,8)*int(IROW_SON-1,8)/2_8 + ELSE + POSROW = PAMASTER(STEP(ISON)) + + & int(NELIM+IROW_SON,8)*int(NELIM+IROW_SON-1,8)/2_8 + ENDIF + ELSE + POSROW = PAMASTER(STEP(ISON)) + + & int(NELIM+IROW_SON-1,8)*int(NBCOLS,8) + ENDIF + IF (KEEP(50).NE.0) THEN + NBCOLS_EFF = NELIM + IROW_SON + ELSE + NBCOLS_EFF = NBCOLS + ENDIF + INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE + CALL SMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, IWPOSCB, + & MYID, KEEP,KEEP8,.FALSE.,NBCOLS_EFF) + ENDDO + IF (KEEP(219).NE.0) THEN + IF(NSLAVES_PERE.GT.0 .AND. KEEP(50).EQ.2) THEN + IF (COMPRESSCB) THEN + POSROW = PAMASTER(STEP(ISON)) + & + int(NELIM+NBROW(1),8)*int(NELIM+NBROW(1)-1,8)/2_8 + ASIZE = int(LMAP_LOC+NELIM,8)*int(NELIM+LMAP_LOC+1,8)/2_8 + & - int(NELIM+NBROW(1),8)*int(NELIM+NBROW(1)-1,8)/2_8 + ELSE + POSROW = PAMASTER(STEP(ISON)) + + & int(NELIM+NBROW(1)-1,8)*int(NBCOLS,8) + ASIZE = int(LMAP_LOC-NBROW(1)+1,8) * int(NBCOLS,8) + ENDIF + CALL SMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE.0) THEN + IF (LP > 0) WRITE(LP,*) MYID, + & ": PB allocation MAX_ARRAY during SMUMPS_211" + IFLAG=-13 + IERROR=NFS4FATHER + GOTO 700 + ENDIF + IF ( LMAP_LOC-NBROW(1)+1-KEEP(253).GT. 0 ) THEN + CALL SMUMPS_618( + & A(POSROW),ASIZE,NBCOLS, + & LMAP_LOC-NBROW(1)+1-KEEP(253), + & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB, + & NELIM+NBROW(1)) + ELSE + CALL SMUMPS_757(BUF_MAX_ARRAY, + & NFS4FATHER) + ENDIF + CALL SMUMPS_619(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NFS4FATHER, + & BUF_MAX_ARRAY, PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB,MYID, KEEP,KEEP8) + ENDIF + ENDIF + IF ( NBPROCFILS(STEP(ISON)) .EQ. 0) THEN + ISTCHK_LOC = PIMASTER(STEP(ISON)) + SAME_PROC= ISTCHK_LOC .LT. IWPOSCB + IF (SAME_PROC) THEN + CALL SMUMPS_530(N, ISON, INODE_PERE, + & IWPOSCB, PIMASTER, PTLUST_S, IW, LIW, STEP, + & KEEP,KEEP8) + ENDIF + ENDIF + IF ( NBPROCFILS(STEP(INODE_PERE)) .EQ. 0 ) THEN + CALL SMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), + & KEEP(47), STEP, INODE_PERE+N ) + IF (KEEP(47) .GE. 3) THEN + CALL SMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + DO I = 0, NSLAVES_PERE + PDEST = SLAVES_PERE( I ) + IF ( PDEST .NE. MYID ) THEN + NBROWS_ALREADY_SENT = 0 + 95 CONTINUE + NFRONT = IW(PIMASTER(STEP(ISON))+KEEP(IXSZ)) + NELIM = IW(PIMASTER(STEP(ISON))+1+KEEP(IXSZ)) + APOS = PAMASTER(STEP(ISON)) + DESCLU = .TRUE. + IF (I == NSLAVES_PERE) THEN + NROWS_TO_SEND=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_SEND=NBROW(I+1)-NBROW(I) + ENDIF + CALL SMUMPS_67(NBROWS_ALREADY_SENT, + & DESCLU, INODE_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER, + & NSLAVES_PERE, + & ISON, NROWS_TO_SEND, LMAP_LOC, + & MAP, PERM(min(LMAP_LOC,NBROW(I))), + & IW(PIMASTER(STEP(ISON))), + & A(APOS), I, PDEST, PDEST_MASTER, COMM, IERR, + & + & KEEP,KEEP8, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & COMPRESSCB, KEEP(253)) + IF ( IERR .EQ. -2 ) THEN + IF (LP > 0) WRITE(LP,*) MYID, + &": FAILURE, SEND BUFFER TOO SMALL DURING SMUMPS_211" + IFLAG = -17 + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * KEEP( 35 ) + GO TO 700 + END IF + IF ( IERR .EQ. -3 ) THEN + IF (LP > 0) WRITE(LP,*) MYID, + &": FAILURE, RECV BUFFER TOO SMALL DURING SMUMPS_211" + IFLAG = -20 + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * KEEP( 35 ) + GO TO 700 + ENDIF + IF (KEEP(219).NE.0) THEN + IF ( IERR .EQ. -4 ) THEN + IFLAG = -13 + IERROR = BUF_LMAX_ARRAY + IF (LP > 0) WRITE(LP,*) MYID, + &": FAILURE, MAX_ARRAY ALLOC FAILED DURING SMUMPS_211" + GO TO 700 + ENDIF + ENDIF + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + GO TO 95 + END IF + END IF + END DO + ISTCHK = PTRIST(STEP(ISON)) + PTRIST(STEP( ISON )) = -77777777 + IF ( IW(ISTCHK+KEEP(IXSZ)) .GE. 0 ) THEN + WRITE(*,*) 'error 3 in SMUMPS_211' + CALL MUMPS_ABORT() + ENDIF + CALL SMUMPS_152(.FALSE., MYID, N, ISTCHK, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + 600 CONTINUE + DEALLOCATE(NBROW) + DEALLOCATE(MAP) + DEALLOCATE(PERM) + DEALLOCATE(SLAVES_PERE) + RETURN + 700 CONTINUE + CALL SMUMPS_44(MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE SMUMPS_211 + SUBROUTINE SMUMPS_93(SIZE_INPLACE, + &MYID,N,IOLDPS,TYPE,IW, LIW, A, LA, + &POSFAC, LRLU, LRLUS, IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8, + &SSARBR,INODE,IERR) + USE SMUMPS_LOAD + USE SMUMPS_OOC + IMPLICIT NONE + INTEGER MYID + INTEGER IOLDPS, TYPE, LIW, N, KEEP(500) + INTEGER(8) :: SIZE_INPLACE, LA, POSFAC, LRLU, LRLUS + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) KEEP8(150) + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER IWPOS, LDLT + INTEGER STEP( N ) + INTEGER (8) :: PTRFAC(KEEP(28)) + LOGICAL SSARBR + INTEGER IOLDSHIFT, IPSSHIFT + INCLUDE 'mumps_headers.h' + INTEGER LCONT, NELIM, NROW, NPIV, INTSIZ + INTEGER NFRONT, NSLAVES + INTEGER IPS, IPSIZE + INTEGER(8) :: SIZELU, SIZECB, IAPOS, I + LOGICAL MOVEPTRAST + INTEGER INODE + INTEGER IERR + IERR=0 + LDLT = KEEP(50) + IOLDSHIFT = IOLDPS + KEEP(IXSZ) + IF ( IW( IOLDSHIFT ) < 0 ) THEN + write(*,*) ' ERROR 1 compressLU:Should not point to a band.' + CALL MUMPS_ABORT() + ELSE IF ( IW( IOLDSHIFT + 2 ) < 0 ) THEN + write(*,*) ' ERROR 2 compressLU:Stack not performed yet', + & IW(IOLDSHIFT + 2) + CALL MUMPS_ABORT() + ENDIF + LCONT = IW( IOLDSHIFT ) + NELIM = IW( IOLDSHIFT + 1 ) + NROW = IW( IOLDSHIFT + 2 ) + NPIV = IW( IOLDSHIFT + 3 ) + IAPOS = PTRFAC(IW( IOLDSHIFT + 4 )) + NSLAVES= IW( IOLDSHIFT + 5 ) + NFRONT = LCONT + NPIV + INTSIZ = IW(IOLDPS+XXI) + IF ( (NSLAVES > 0 .AND. TYPE .NE. 2) .OR. + & (NSLAVES .eq. 0 .AND. TYPE .EQ. 2 ) ) THEN + WRITE(*,*) ' ERROR 3 compressLU: problem with level of inode' + CALL MUMPS_ABORT() + END IF + IF (LDLT.EQ.0) THEN + SIZELU = int(LCONT + NROW, 8) * int(NPIV,8) + ELSE + SIZELU = int(NROW,8) * int(NPIV,8) + ENDIF + IF ( TYPE .EQ. 2 ) THEN + IF (LDLT.EQ.0) THEN + SIZECB = int(NELIM,8) * int(LCONT,8) + ELSE + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + SIZECB = int(NELIM+1,8) * int(NELIM + NPIV,8) + ELSE + SIZECB = int(NELIM,8) * int(NELIM + NPIV,8) + ENDIF + ENDIF + ELSE + IF (LDLT.EQ.0) THEN + SIZECB = int(LCONT,8) * int(LCONT,8) + ELSE + SIZECB = int(NROW,8) * int(LCONT,8) + ENDIF + END IF + CALL MUMPS_724( IW(IOLDPS+XXR), SIZECB ) + IF ((SIZECB.EQ.0_8).AND.(KEEP(201).EQ.0)) THEN + GOTO 500 + ENDIF + IF (KEEP(201).EQ.2) THEN + KEEP8(31)=KEEP8(31)+SIZELU + CALL SMUMPS_576(INODE,PTRFAC,KEEP,KEEP8, + & A,LA,SIZELU, IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID,': Internal error in SMUMPS_576' + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF ( IOLDPS + INTSIZ .NE. IWPOS ) THEN + IPS = IOLDPS + INTSIZ + MOVEPTRAST = .FALSE. + DO WHILE ( IPS .NE. IWPOS ) + IPSIZE = IW(IPS+XXI) + IPSSHIFT = IPS + KEEP(IXSZ) + IF ( IW( IPSSHIFT + 2 ) < 0 ) THEN + NFRONT = IW( IPSSHIFT ) + IF(KEEP(201).EQ.0)THEN + PTRFAC(IW( IPSSHIFT + 4 )) = + & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB + ELSE + PTRFAC(IW(IPSSHIFT+4))=PTRFAC(IW(IPSSHIFT+4)) - + & SIZECB - SIZELU + ENDIF + MOVEPTRAST = .TRUE. + IF(KEEP(201).EQ.0)THEN + PTRAST(IW(IPSSHIFT+4))=PTRAST(IW(IPSSHIFT+4))-SIZECB + ELSE + PTRAST(IW(IPSSHIFT+4))=PTRAST(IW(IPSSHIFT+4))-SIZECB + & - SIZELU + ENDIF + ELSE IF ( IW( IPSSHIFT ) < 0 ) THEN + IF(KEEP(201).EQ.0)THEN + PTRFAC(IW(IPSSHIFT+3)) = PTRFAC(IW(IPSSHIFT+3))-SIZECB + ELSE + PTRFAC(IW(IPSSHIFT+3)) = PTRFAC(IW(IPSSHIFT+3)) + & -SIZECB-SIZELU + ENDIF + ELSE + NFRONT = IW( IPSSHIFT ) + IW( IPSSHIFT + 3 ) + IF(KEEP(201).EQ.0)THEN + PTRFAC(IW( IPSSHIFT + 4 )) = + & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB + ELSE + PTRFAC(IW( IPSSHIFT + 4 )) = + & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB + & - SIZELU + ENDIF + END IF + IPS = IPS + IPSIZE + END DO + IF ((SIZECB .NE. 0_8).OR.(KEEP(201).NE.0)) THEN + IF (KEEP(201).NE.0) THEN + DO I=IAPOS, POSFAC - SIZECB - SIZELU - 1_8 + A( I ) = A( I + SIZECB + SIZELU) + END DO + ELSE + DO I=IAPOS + SIZELU, POSFAC - SIZECB - 1_8 + A( I ) = A( I + SIZECB ) + END DO + ENDIF + END IF + ENDIF + IF (KEEP(201).NE.0) THEN + POSFAC = POSFAC - (SIZECB+SIZELU) + LRLU = LRLU + (SIZECB+SIZELU) + LRLUS = LRLUS + (SIZECB+SIZELU) - SIZE_INPLACE + ELSE + POSFAC = POSFAC - SIZECB + LRLU = LRLU + SIZECB + LRLUS = LRLUS + SIZECB - SIZE_INPLACE + ENDIF + 500 CONTINUE + CALL SMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,SIZELU,-SIZECB+SIZE_INPLACE,KEEP,KEEP8,LRLU) + RETURN + END SUBROUTINE SMUMPS_93 + SUBROUTINE SMUMPS_314( N, ISON, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, TYPE_SON + & ) + USE SMUMPS_OOC + USE SMUMPS_LOAD + IMPLICIT NONE + INTEGER(8) :: LA, LRLU, LRLUS, POSFAC, IPTRLU + INTEGER N, ISON, LIW, IWPOS, IWPOSCB, + & COMP, IFLAG, IERROR, SLAVEF, MYID, COMM, + & TYPE_SON + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), STEP(N), + & PIMASTER(KEEP(28)), IW(LIW) + INTEGER PTLUST_S(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + DOUBLE PRECISION OPELIW + DOUBLE PRECISION FLOP1, FLOP1_EFFECTIVE + REAL A( LA ) + INTEGER(8) :: LREQA, POSA, POSALOC, OLDPOS, JJ + INTEGER NFRONT, NCOL_L, NROW_L, LREQI, NSLAVES_L, + & POSI, I, IROW_L, ICOL_L, LDA_BAND, NASS + LOGICAL NONEED_TO_COPY_FACTORS + INTEGER(8) :: LAFAC, LREQA_HEADER + INTEGER LIWFAC, STRAT, TYPEFile, NextPivDummy, + & IOLDPS_CB + LOGICAL LAST_CALL + TYPE(IO_BLOCK) :: MonBloc + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0d0) + FLOP1 = ZERO + NCOL_L = IW( PTRIST(STEP( ISON )) + 3 + KEEP(IXSZ) ) + NROW_L = IW( PTRIST(STEP( ISON )) + 2 + KEEP(IXSZ) ) + NSLAVES_L = IW( PTRIST(STEP( ISON )) + 5 + KEEP(IXSZ) ) + LDA_BAND = NCOL_L + IW( PTRIST(STEP( ISON )) + KEEP(IXSZ) ) + IF ( KEEP(50) .eq. 0 ) THEN + NFRONT = LDA_BAND + ELSE + NFRONT = IW( PTRIST(STEP( ISON )) + 7 + KEEP(IXSZ) ) + END IF + IF (KEEP(201).EQ.1) THEN + IOLDPS_CB = PTRIST(STEP( ISON )) + CALL MUMPS_729(LAFAC, IW(IOLDPS_CB+XXR)) + LIWFAC = IW(IOLDPS_CB+XXI) + TYPEFile = TYPEF_L + NextPivDummy = -8888 + MonBloc%INODE = ISON + MonBloc%MASTER = .FALSE. + MonBloc%Typenode = 2 + MonBloc%NROW = NROW_L + MonBloc%NCOL = LDA_BAND + MonBloc%NFS = IW(IOLDPS_CB+1+KEEP(IXSZ)) + MonBloc%LastPiv = NCOL_L + NULLIFY(MonBloc%INDICES) + STRAT = STRAT_WRITE_MAX + LAST_CALL = .TRUE. + MonBloc%Last = .TRUE. + CALL SMUMPS_688 + & ( STRAT, TYPEFile, + & A(PTRAST(STEP(ISON))), LAFAC, MonBloc, + & NextPivDummy, NextPivDummy, + & IW(IOLDPS_CB), LIWFAC, + & MYID, KEEP8(31), IFLAG,LAST_CALL ) + IF ((NCOL_L.EQ.0).OR.(NROW_L.EQ.0)) THEN + ENDIF + ENDIF + NONEED_TO_COPY_FACTORS = (KEEP(201).EQ.1) .OR. (KEEP(201).EQ.-1) + IF ((NCOL_L.EQ.0).OR.(NROW_L.EQ.0)) THEN + GOTO 80 + ENDIF + LREQI = 4 + NCOL_L + NROW_L + KEEP(IXSZ) + LREQA_HEADER = int(NCOL_L,8) * int(NROW_L,8) + IF (NONEED_TO_COPY_FACTORS) THEN + LREQA = 0_8 + ELSE + LREQA = LREQA_HEADER + ENDIF + IF ( LRLU .LT. LREQA .OR. + & IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LREQA ) THEN + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GO TO 700 + END IF + CALL SMUMPS_94( N,KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS,IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress Stack_band:LRLU,LRLUS=', + & LRLU, LRLUS + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GOTO 700 + END IF + IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + GOTO 700 + END IF + END IF + IF (.NOT. NONEED_TO_COPY_FACTORS) THEN + POSA = POSFAC + POSFAC = POSFAC + LREQA + LRLU = LRLU - LREQA + LRLUS = LRLUS - LREQA + KEEP8(67) = min(LRLUS, KEEP8(67)) + IF(KEEP(201).NE.2)THEN + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,LREQA,LREQA,KEEP,KEEP8,LRLU) + ELSE + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU) + ENDIF + ENDIF + POSI = IWPOS + IWPOS = IWPOS + LREQI + PTLUST_S(STEP( ISON )) = POSI + IW(POSI+XXI)=LREQI + CALL MUMPS_730(LREQA, IW(POSI+XXR)) + CALL MUMPS_730(LREQA_HEADER, IW(POSI+XXR)) + IW(POSI+XXS)=-9999 + POSI=POSI+KEEP(IXSZ) + IW( POSI ) = - NCOL_L + IW( POSI + 1 ) = NROW_L + IW( POSI + 2 ) = NFRONT - NCOL_L + IW( POSI + 3 ) = STEP(ISON) + IF (.NOT. NONEED_TO_COPY_FACTORS) THEN + PTRFAC(STEP(ISON)) = POSA + ELSE + PTRFAC(STEP(ISON)) = -77777_8 + ENDIF + IROW_L = PTRIST(STEP(ISON)) + 6 + NSLAVES_L + KEEP(IXSZ) + ICOL_L = PTRIST(STEP(ISON)) + 6 + NROW_L + NSLAVES_L + KEEP(IXSZ) + DO I = 1, NROW_L + IW( POSI+3+I ) = IW( IROW_L+I-1 ) + ENDDO + DO I = 1, NCOL_L + IW( POSI+NROW_L+3+I) = IW( ICOL_L+I-1 ) + ENDDO + IF (.NOT.NONEED_TO_COPY_FACTORS) THEN + POSALOC = POSA + DO I = 1, NROW_L + OLDPOS = PTRAST( STEP(ISON)) + int(I-1,8)*int(LDA_BAND,8) + DO JJ = 0_8, int(NCOL_L-1,8) + A( POSALOC+JJ ) = A( OLDPOS+JJ ) + ENDDO + POSALOC = POSALOC + int(NCOL_L,8) + END DO + ENDIF + IF (KEEP(201).EQ.2) THEN + KEEP8(31)=KEEP8(31)+LREQA + ENDIF + KEEP8(10) = KEEP8(10) + int(NCOL_L,8) * int(NROW_L,8) + IF (KEEP(201).EQ.2) THEN + CALL SMUMPS_576(ISON,PTRFAC,KEEP,KEEP8,A,LA,LREQA,IFLAG) + IF(IFLAG.LT.0)THEN + WRITE(*,*)MYID,': Internal error in SMUMPS_576' + IERROR=0 + GOTO 700 + ENDIF + ENDIF + IF (KEEP(201).EQ.2) THEN + POSFAC = POSFAC - LREQA + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,LREQA,0_8,KEEP,KEEP8,LRLU) + ENDIF + 80 CONTINUE + IF (TYPE_SON == 1) THEN + GOTO 90 + ENDIF + IF ( KEEP(50) .eq. 0 ) THEN + FLOP1 = dble( NCOL_L * NROW_L) + + & dble(NROW_L*NCOL_L)*dble(2*NFRONT-NCOL_L-1) + ELSE + FLOP1 = dble( NCOL_L ) * dble( NROW_L ) + & * dble( 2 * LDA_BAND - NROW_L - NCOL_L + 1) + END IF + OPELIW = OPELIW + FLOP1 + FLOP1_EFFECTIVE = FLOP1 + NASS = IW( PTRIST(STEP( ISON )) + 4 + KEEP(IXSZ) ) + IF ( NCOL_L .NE. NASS ) THEN + IF ( KEEP(50).eq.0 ) THEN + FLOP1 = dble( NASS * NROW_L) + + & dble(NROW_L*NASS)*dble(2*NFRONT-NASS-1) + ELSE + FLOP1 = dble( NASS ) * dble( NROW_L ) * + & dble( 2 * LDA_BAND - NROW_L - NASS + 1) + END IF + END IF + CALL SMUMPS_190(1,.FALSE.,FLOP1_EFFECTIVE-FLOP1, + & KEEP,KEEP8) + CALL SMUMPS_190(2,.FALSE.,-FLOP1,KEEP,KEEP8) + 90 CONTINUE + RETURN + 700 CONTINUE + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE SMUMPS_314 + SUBROUTINE SMUMPS_626( N, ISON, + & PTRIST, PTRAST, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + IMPLICIT NONE + include 'mumps_headers.h' + INTEGER(8) :: LRLU, LRLUS, IPTRLU, LA + INTEGER ISON, MYID, N, IWPOSCB + INTEGER KEEP(500), STEP(N) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER PTRIST(KEEP(28)) + INTEGER LIW + INTEGER IW(LIW) + REAL A(LA) + INTEGER ISTCHK + ISTCHK = PTRIST(STEP(ISON)) + CALL SMUMPS_152(.FALSE.,MYID, N, ISTCHK, + & PTRAST(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + PTRIST(STEP( ISON )) = -9999888 + PTRAST(STEP( ISON )) = -9999888_8 + RETURN + END SUBROUTINE SMUMPS_626 + SUBROUTINE SMUMPS_214( KEEP,KEEP8, + & MYID, N, NELT, LNA, NZ, NA_ELT, NSLAVES, + & MEMORY_MBYTES, EFF, OOC_STRAT, PERLU_ON, + & MEMORY_BYTES ) + IMPLICIT NONE + LOGICAL, INTENT(IN) :: EFF, PERLU_ON + INTEGER, INTENT(IN) :: OOC_STRAT + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER MYID, N, NELT, NSLAVES, LNA, NZ, NA_ELT + INTEGER(8), INTENT(OUT) :: MEMORY_BYTES + INTEGER, INTENT(OUT) :: MEMORY_MBYTES + LOGICAL :: I_AM_SLAVE, I_AM_MASTER + INTEGER :: PERLU, NBRECORDS + INTEGER(8) :: NB_REAL, MAXS_MIN + INTEGER(8) :: TEMP, NB_BYTES, NB_INT + INTEGER :: SMUMPS_LBUF_INT, SMUMPS_LBUFR_BYTES, SMUMPS_LBUF + INTEGER :: NBUFS + INTEGER(8) :: TEMPI + INTEGER(8) :: TEMPR + INTEGER :: MIN_PERLU + INTEGER(8) :: BUF_OOC, BUF_OOC_PANEL, BUF_OOC_NOPANEL + INTEGER(8) :: OOC_NB_FILE_TYPE + INTEGER(8) :: NSTEPS8, N8, NELT8 + INTEGER(8) :: I8OVERI + I8OVERI = int(KEEP(10),8) + PERLU = KEEP(12) + NSTEPS8 = int(KEEP(28),8) + N8 = int(N,8) + NELT8 = int(NELT,8) + IF (.NOT.PERLU_ON) PERLU = 0 + I_AM_MASTER = ( MYID .eq. 0 ) + I_AM_SLAVE = ( KEEP(46).eq. 1 .or. MYID .ne. 0 ) + TEMP = 0_8 + NB_REAL = 0_8 + NB_BYTES = 0_8 + NB_INT = 0_8 + NB_INT = NB_INT + 5_8 * NSTEPS8 + NB_INT = NB_INT + NSTEPS8 + int(KEEP(56),8)*int(NSLAVES+2,8) + NB_INT = NB_INT + 3_8 * N8 + IF (KEEP(23).ne.0 .and. I_AM_MASTER) NB_INT=NB_INT + N8 + IF (KEEP(55).eq.0) THEN + NB_INT = NB_INT + 2_8 * N8 + ELSE + NB_INT = NB_INT + 2_8 * ( NELT8 + 1_8 ) + ENDIF + IF (KEEP(55) .ne. 0 ) THEN + NB_INT = NB_INT + N8 + 1_8 + NELT8 + END IF + NB_INT = NB_INT + int(LNA,8) + IF ( OOC_STRAT .GT. 0 .OR. OOC_STRAT .EQ. -1 ) THEN + MAXS_MIN = KEEP8(14) + ELSE + MAXS_MIN = KEEP8(12) + ENDIF + IF ( .NOT. EFF ) THEN + IF ( KEEP8(24).EQ.0_8 ) THEN + NB_REAL = NB_REAL + MAXS_MIN + + & int(PERLU,8)*(MAXS_MIN / 100_8 + 1_8 ) + ENDIF + ELSE + NB_REAL = NB_REAL + KEEP8(67) + ENDIF + IF ( OOC_STRAT .GT. 0 .AND. I_AM_SLAVE ) THEN + BUF_OOC_NOPANEL = 2_8 * KEEP8(119) + IF (KEEP(50).EQ.0)THEN + BUF_OOC_PANEL = 8_8 * int(KEEP(226),8) + ELSE + BUF_OOC_PANEL = 4_8 * int(KEEP(226),8) + ENDIF + IF (OOC_STRAT .EQ. 2) THEN + BUF_OOC = BUF_OOC_NOPANEL + ELSE + BUF_OOC = BUF_OOC_PANEL + ENDIF + NB_REAL = NB_REAL + min(BUF_OOC + int(max(PERLU,0),8) * + & (BUF_OOC/100_8+1_8),12000000_8) + IF (OOC_STRAT .EQ. 2) THEN + OOC_NB_FILE_TYPE = 1_8 + ELSE + IF (KEEP(50).EQ.0) THEN + OOC_NB_FILE_TYPE = 2_8 + ELSE + OOC_NB_FILE_TYPE = 1_8 + ENDIF + ENDIF + NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 * I8OVERI + NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 * I8OVERI + NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 + ENDIF + NB_REAL = NB_REAL + int(KEEP(13),8) + IF (KEEP(252).EQ.1 .AND. .NOT. I_AM_MASTER) THEN + NB_REAL = NB_REAL + N8 + ENDIF + IF ( .not. ( I_AM_SLAVE .and. I_AM_MASTER .and. KEEP(52) .eq. 0 + & .and. KEEP(55) .ne. 0 ) ) THEN + NB_INT = NB_INT + int(KEEP(14),8) + END IF + IF ( I_AM_SLAVE .and. KEEP(38) .ne. 0 ) THEN + NB_INT = NB_INT + 2_8 * N8 + END IF + TEMPI= 0_8 + TEMPR = 0_8 + NBRECORDS = KEEP(39) + IF (KEEP(55).eq.0) THEN + NBRECORDS = min(KEEP(39), NZ) + ELSE + NBRECORDS = min(KEEP(39), NA_ELT) + ENDIF + IF ( KEEP(54) .eq. 0 ) THEN + IF ( I_AM_MASTER ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + NBUFS = NSLAVES + ELSE + NBUFS = NSLAVES - 1 + IF (KEEP(55) .eq. 0 ) + & TEMPI = TEMPI + 2_8 * N8 + END IF + TEMPI = TEMPI + 2_8 * int(NBRECORDS,8) * int(NBUFS,8) + TEMPR = TEMPR + int(NBRECORDS,8) * int(NBUFS,8) + ELSE + IF ( KEEP(55) .eq. 0 )THEN + TEMPI = TEMPI + 2_8 * int(NBRECORDS,8) + TEMPR = TEMPR + int(NBRECORDS,8) + END IF + END IF + ELSE + IF ( I_AM_SLAVE ) THEN + TEMPI = TEMPI + int(1+4*NSLAVES,8) * int(NBRECORDS,8) + TEMPR = TEMPR + int(1+2*NSLAVES,8) * int(NBRECORDS,8) + END IF + END IF + TEMP = max( NB_BYTES + (NB_INT + TEMPI) * int(KEEP(34),8) + & + (NB_REAL+TEMPR) * int(KEEP(35),8) + & , TEMP ) + IF ( I_AM_SLAVE ) THEN + SMUMPS_LBUFR_BYTES = KEEP( 44 ) * KEEP( 35 ) + SMUMPS_LBUFR_BYTES = max( SMUMPS_LBUFR_BYTES, + & 100000 ) + IF (KEEP(48).EQ.5) THEN + MIN_PERLU=2 + ELSE + MIN_PERLU=0 + ENDIF + SMUMPS_LBUFR_BYTES = SMUMPS_LBUFR_BYTES + & + int( 2.0E0 * real(max(PERLU,MIN_PERLU))* + & real(SMUMPS_LBUFR_BYTES)/100E0) + NB_BYTES = NB_BYTES + int(SMUMPS_LBUFR_BYTES,8) + SMUMPS_LBUF = int( real(KEEP(213)) / 100.0E0 + & * real(KEEP( 43 ) * KEEP( 35 )) ) + SMUMPS_LBUF = max( SMUMPS_LBUF, 100000 ) + SMUMPS_LBUF = SMUMPS_LBUF + & + int( 2.0E0 * real(max(PERLU,0))* + & real(SMUMPS_LBUF)/100E0) + SMUMPS_LBUF = max(SMUMPS_LBUF, SMUMPS_LBUFR_BYTES) + NB_BYTES = NB_BYTES + int(SMUMPS_LBUF,8) + SMUMPS_LBUF_INT = ( KEEP(56) + + & NSLAVES * NSLAVES ) * 5 + & * KEEP(34) + NB_BYTES = NB_BYTES + int(SMUMPS_LBUF_INT,8) + IF ( EFF ) THEN + IF (OOC_STRAT .GT. 0) THEN + NB_INT = NB_INT + int(KEEP(225),8) + ELSE + NB_INT = NB_INT + int(KEEP(15),8) + ENDIF + ELSE + IF (OOC_STRAT .GT. 0) THEN + NB_INT = NB_INT + int( + & KEEP(225) + 2 * max(PERLU,10) * + & ( KEEP(225) / 100 + 1 ) + & ,8) + ELSE + NB_INT = NB_INT + int( + & KEEP(15) + 2 * max(PERLU,10) * + & ( KEEP(15) / 100 + 1 ) + & ,8) + ENDIF + ENDIF + NB_INT = NB_INT + NSTEPS8 + NB_INT = NB_INT + NSTEPS8 * I8OVERI + NB_INT = NB_INT + N8 + 5_8 * NSTEPS8 + 3_8 + NB_INT = NB_INT + 2_8 * NSTEPS8 * I8OVERI + END IF + MEMORY_BYTES = NB_BYTES + NB_INT * int(KEEP(34),8) + + & NB_REAL * int(KEEP(35),8) + MEMORY_BYTES = max( MEMORY_BYTES, TEMP ) + MEMORY_MBYTES = int( MEMORY_BYTES / 1000000_8 ) + 1 + RETURN + END SUBROUTINE SMUMPS_214 + SUBROUTINE SMUMPS_757(M_ARRAY, M_SIZE) + IMPLICIT NONE + INTEGER M_SIZE + REAL M_ARRAY(M_SIZE) + REAL ZERO + PARAMETER (ZERO=0.0E0) + M_ARRAY=ZERO + RETURN + END SUBROUTINE SMUMPS_757 + SUBROUTINE SMUMPS_618( + & A,ASIZE,NCOL,NROW, + & M_ARRAY,NMAX,COMPRESSCB,LROW1) + IMPLICIT NONE + INTEGER(8) :: ASIZE + INTEGER NROW,NCOL,NMAX,LROW1 + LOGICAL COMPRESSCB + REAL A(ASIZE) + REAL M_ARRAY(NMAX) + INTEGER I + INTEGER(8):: APOS, J, LROW + REAL ZERO,TMP + PARAMETER (ZERO=0.0E0) + M_ARRAY(1:NMAX) = ZERO + APOS = 0_8 + IF (COMPRESSCB) THEN + LROW=int(LROW1,8) + ELSE + LROW=int(NCOL,8) + ENDIF + DO I=1,NROW + DO J=1_8,int(NMAX,8) + TMP = abs(A(APOS+J)) + IF(TMP.GT.M_ARRAY(J)) M_ARRAY(J) = TMP + ENDDO + APOS = APOS + LROW + IF (COMPRESSCB) LROW=LROW+1_8 + ENDDO + RETURN + END SUBROUTINE SMUMPS_618 + SUBROUTINE SMUMPS_710 (id, NB_INT,NB_CMPLX ) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(SMUMPS_STRUC) :: id + INTEGER(8) NB_INT, NB_CMPLX + INTEGER(8) NB_REAL + NB_INT = 0_8 + NB_CMPLX = 0_8 + NB_REAL = 0_8 + IF (associated(id%IS)) NB_INT=NB_INT+size(id%IS) + IF (associated(id%IS1)) NB_INT=NB_INT+size(id%IS1) + NB_INT=NB_INT+size(id%KEEP) + NB_INT=NB_INT+size(id%ICNTL) + NB_INT=NB_INT+size(id%INFO) + NB_INT=NB_INT+size(id%INFOG) + IF (associated(id%MAPPING)) NB_INT=NB_INT+size(id%MAPPING) + IF (associated(id%POIDS)) NB_INT=NB_INT+size(id%POIDS) + IF (associated(id%BUFR)) NB_INT=NB_INT+size(id%BUFR) + IF (associated(id%STEP)) NB_INT=NB_INT+size(id%STEP) + IF (associated(id%NE_STEPS )) NB_INT=NB_INT+size(id%NE_STEPS ) + IF (associated(id%ND_STEPS)) NB_INT=NB_INT+size(id%ND_STEPS) + IF (associated(id%Step2node)) NB_INT=NB_INT+size(id%Step2node) + IF (associated(id%FRERE_STEPS)) NB_INT=NB_INT+size(id%FRERE_STEPS) + IF (associated(id%DAD_STEPS)) NB_INT=NB_INT+size(id%DAD_STEPS) + IF (associated(id%FILS)) NB_INT=NB_INT+size(id%FILS) + IF (associated(id%PTRAR)) NB_INT=NB_INT+size(id%PTRAR) + IF (associated(id%FRTPTR)) NB_INT=NB_INT+size(id%FRTPTR) + NB_INT=NB_INT+size(id%KEEP8) * id%KEEP(10) + IF (associated(id%PTRFAC)) NB_INT=NB_INT+size(id%PTRFAC) * + & id%KEEP(10) + IF (associated(id%FRTELT)) NB_INT=NB_INT+size(id%FRTELT) + IF (associated(id%NA)) NB_INT=NB_INT+size(id%NA) + IF (associated(id%PROCNODE_STEPS)) + & NB_INT=NB_INT+size(id%PROCNODE_STEPS) + IF (associated(id%PTLUST_S)) NB_INT=NB_INT+size(id%PTLUST_S) + IF (associated(id%PROCNODE)) NB_INT=NB_INT+size(id%PROCNODE) + IF (associated(id%INTARR)) NB_INT=NB_INT+size(id%INTARR) + IF (associated(id%ELTPROC)) NB_INT=NB_INT+size(id%ELTPROC) + IF (associated(id%CANDIDATES)) + & NB_INT=NB_INT+size(id%CANDIDATES) + IF (associated(id%ISTEP_TO_INIV2)) + & NB_INT=NB_INT+size(id%ISTEP_TO_INIV2) + IF (associated(id%FUTURE_NIV2)) + & NB_INT=NB_INT+size(id%FUTURE_NIV2) + IF (associated(id%TAB_POS_IN_PERE)) + & NB_INT=NB_INT+size(id%TAB_POS_IN_PERE) + IF (associated(id%I_AM_CAND)) + & NB_INT=NB_INT+size(id%I_AM_CAND) + IF (associated(id%MEM_DIST)) + & NB_INT=NB_INT+size(id%MEM_DIST) + IF (associated(id%POSINRHSCOMP)) + & NB_INT=NB_INT+size(id%POSINRHSCOMP) + IF (associated(id%MEM_SUBTREE)) + & NB_INT=NB_INT+size(id%MEM_SUBTREE) + IF (associated(id%MY_ROOT_SBTR)) + & NB_INT=NB_INT+size(id%MY_ROOT_SBTR) + IF (associated(id%MY_FIRST_LEAF)) + & NB_INT=NB_INT+size(id%MY_FIRST_LEAF) + IF (associated(id%MY_NB_LEAF)) NB_INT=NB_INT+size(id%MY_NB_LEAF) + IF (associated(id%DEPTH_FIRST)) NB_INT=NB_INT+size(id%DEPTH_FIRST) + IF (associated(id%COST_TRAV)) NB_INT=NB_INT+size(id%COST_TRAV) + IF (associated(id%CB_SON_SIZE)) NB_INT=NB_INT+size(id%CB_SON_SIZE) + IF (associated(id%OOC_INODE_SEQUENCE)) + & NB_INT=NB_INT+size(id%OOC_INODE_SEQUENCE) + IF (associated(id%OOC_SIZE_OF_BLOCK)) + & NB_INT=NB_INT+size(id%OOC_SIZE_OF_BLOCK) + IF (associated(id%OOC_VADDR)) + & NB_INT=NB_INT+size(id%OOC_VADDR) + IF (associated(id%OOC_TOTAL_NB_NODES)) + & NB_INT=NB_INT+size(id%OOC_TOTAL_NB_NODES) + IF (associated(id%OOC_NB_FILES)) + & NB_INT=NB_INT+size(id%OOC_NB_FILES) + IF (associated(id%OOC_FILE_NAME_LENGTH)) + & NB_INT=NB_INT+size(id%OOC_FILE_NAME_LENGTH) + IF (associated(id%PIVNUL_LIST)) NB_INT=NB_INT+size(id%PIVNUL_LIST) + IF (associated(id%SUP_PROC)) NB_INT=NB_INT+size(id%SUP_PROC) + IF (associated(id%DBLARR)) NB_CMPLX=NB_CMPLX+size(id%DBLARR) + IF (associated(id%RHSCOMP)) NB_CMPLX=NB_CMPLX+size(id%RHSCOMP) + IF (associated(id%S)) NB_CMPLX=NB_CMPLX+id%KEEP8(23) + IF (associated(id%COLSCA)) NB_REAL=NB_REAL+size(id%COLSCA) + IF (associated(id%ROWSCA)) NB_REAL=NB_REAL+size(id%ROWSCA) + NB_REAL=NB_REAL+size(id%CNTL) + NB_REAL=NB_REAL+size(id%RINFO) + NB_REAL=NB_REAL+size(id%RINFOG) + NB_REAL=NB_REAL+size(id%DKEEP) + NB_CMPLX = NB_CMPLX + NB_REAL + RETURN + END SUBROUTINE SMUMPS_710 + SUBROUTINE SMUMPS_756(N8,SRC,DEST) + IMPLICIT NONE + INTEGER(8) :: N8 + REAL, intent(in) :: SRC(N8) + REAL, intent(out) :: DEST(N8) + INTEGER(8) :: SHIFT8, HUG8 + INTEGER :: I, I4SIZE + HUG8=int(huge(I4SIZE),8) + DO I = 1, int(( N8 + HUG8 - 1_8 ) / HUG8) + SHIFT8 = 1_8 + int(I-1,8) * HUG8 + I4SIZE = int(min(HUG8, N8-SHIFT8+1_8)) + CALL scopy(I4SIZE, SRC(SHIFT8), 1, DEST(SHIFT8), 1) + ENDDO + RETURN + END SUBROUTINE SMUMPS_756 + SUBROUTINE SMUMPS_22( INPLACE, MIN_SPACE_IN_PLACE, + & SSARBR, PROCESS_BANDE, + & MYID,N, KEEP,KEEP8, + & IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP,PIMASTER,PAMASTER, + & LREQ, LREQCB, NODE_ARG, STATE_ARG, SET_HEADER, + & COMP, LRLUS, IFLAG, IERROR ) + USE SMUMPS_LOAD + IMPLICIT NONE + INTEGER N,LIW, KEEP(500) + INTEGER(8) LA, LRLU, IPTRLU, LRLUS, LREQCB + INTEGER(8) PAMASTER(KEEP(28)), PTRAST(KEEP(28)) + INTEGER IWPOS,IWPOSCB + INTEGER(8) :: MIN_SPACE_IN_PLACE + INTEGER NODE_ARG, STATE_ARG + INTEGER(8) KEEP8(150) + INTEGER IW(LIW),PTRIST(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER MYID, IXXP + REAL A(LA) + LOGICAL INPLACE, PROCESS_BANDE, SSARBR, SET_HEADER + INTEGER COMP, LREQ, IFLAG, IERROR + INCLUDE 'mumps_headers.h' + INTEGER INODE_LOC,NPIV,NASS,NROW,NCB + INTEGER ISIZEHOLE + INTEGER(8) :: MEM_GAIN, RSIZEHOLE, LREQCB_EFF, LREQCB_WISHED + LOGICAL DONE + IF ( INPLACE ) THEN + LREQCB_EFF = MIN_SPACE_IN_PLACE + IF ( MIN_SPACE_IN_PLACE > 0_8 ) THEN + LREQCB_WISHED = LREQCB + ELSE + LREQCB_WISHED = 0_8 + ENDIF + ELSE + LREQCB_EFF = LREQCB + LREQCB_WISHED = LREQCB + ENDIF + IF (IWPOSCB.EQ.LIW) THEN + IF (LREQ.NE.KEEP(IXSZ).OR.LREQCB.NE.0_8 + & .OR. .NOT. SET_HEADER) THEN + WRITE(*,*) "Internal error in SMUMPS_22", + & SET_HEADER, LREQ, LREQCB + CALL MUMPS_ABORT() + ENDIF + IF (IWPOSCB-IWPOS+1 .LT. KEEP(IXSZ)) THEN + WRITE(*,*) "Problem with integer stack size",IWPOSCB, + & IWPOS, KEEP(IXSZ) + IFLAG = -8 + IERROR = LREQ + RETURN + ENDIF + IWPOSCB=IWPOSCB-KEEP(IXSZ) + IW(IWPOSCB+1+XXI)=KEEP(IXSZ) + CALL MUMPS_730(0_8,IW(IWPOSCB+1+XXR)) + IW(IWPOSCB+1+XXN)=-919191 + IW(IWPOSCB+1+XXS)=S_NOTFREE + IW(IWPOSCB+1+XXP)=TOP_OF_STACK + RETURN + ENDIF + IF (KEEP(214).EQ.1.AND. + & KEEP(216).EQ.1.AND. + & IWPOSCB.NE.LIW) THEN + IF (IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG.OR. + & IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG38) THEN + NCB = IW( IWPOSCB+1 + KEEP(IXSZ) ) + NROW = IW( IWPOSCB+1 + KEEP(IXSZ) + 2) + NPIV = IW( IWPOSCB+1 + KEEP(IXSZ) + 3) + INODE_LOC= IW( IWPOSCB+1 + XXN) + CALL SMUMPS_632(IWPOSCB+1,IW,LIW, + & ISIZEHOLE,RSIZEHOLE) + IF (IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG) THEN + CALL SMUMPS_627(A,LA,IPTRLU+1_8, + & NROW,NCB,NPIV+NCB,0, + & IW(IWPOSCB+1 + XXS),RSIZEHOLE) + IW(IWPOSCB+1 + XXS) =S_NOLCLEANED + MEM_GAIN = int(NROW,8)*int(NPIV,8) + ENDIF + IF (IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG38) THEN + NASS = IW( IWPOSCB+1 + KEEP(IXSZ) + 4) + CALL SMUMPS_627(A,LA,IPTRLU+1_8, + & NROW,NCB,NPIV+NCB,NASS-NPIV, + & IW(IWPOSCB+1 + XXS),RSIZEHOLE) + IW(IWPOSCB+1 + XXS) =S_NOLCLEANED38 + MEM_GAIN = int(NROW,8)*int(NPIV+NCB-(NASS-NPIV),8) + ENDIF + IF (ISIZEHOLE.NE.0) THEN + CALL SMUMPS_630( IW,LIW,IWPOSCB+1, + & IWPOSCB+IW(IWPOSCB+1+XXI), + & ISIZEHOLE ) + IWPOSCB=IWPOSCB+ISIZEHOLE + IW(IWPOSCB+1+XXP+IW(IWPOSCB+1+XXI))=IWPOSCB+1 + PTRIST(STEP(INODE_LOC))=PTRIST(STEP(INODE_LOC))+ + & ISIZEHOLE + ENDIF + CALL MUMPS_724(IW(IWPOSCB+1+XXR), MEM_GAIN) + IPTRLU = IPTRLU+MEM_GAIN+RSIZEHOLE + LRLU = LRLU+MEM_GAIN+RSIZEHOLE + PTRAST(STEP(INODE_LOC))= + & PTRAST(STEP(INODE_LOC))+MEM_GAIN+RSIZEHOLE + ENDIF + ENDIF + DONE =.FALSE. + IF ((IPTRLU.LT.LREQCB_WISHED).OR.(LRLU.LT.LREQCB_WISHED)) THEN + IF (LRLUS.LT.LREQCB_EFF) THEN + GOTO 620 + ELSE + CALL SMUMPS_94(N,KEEP(28),IW,LIW,A,LA, + & LRLU,IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST, + & STEP, PIMASTER,PAMASTER,KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress... alloc_cb', + & 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 620 + END IF + DONE = .TRUE. + COMP = COMP + 1 + ENDIF + ENDIF + IF (IWPOSCB-IWPOS+1 .LT. LREQ) THEN + IF (DONE) GOTO 600 + CALL SMUMPS_94(N,KEEP(28),IW,LIW,A,LA, + & LRLU,IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST, + & STEP, PIMASTER,PAMASTER,KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress... alloc_cb', + & 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 620 + END IF + COMP = COMP + 1 + IF (IWPOSCB-IWPOS+1 .LT. LREQ) GOTO 600 + ENDIF + IXXP=IWPOSCB+XXP+1 + IF (IXXP.GT.LIW) THEN + WRITE(*,*) "Internal error 3 in SMUMPS_22",IXXP + ENDIF + IF (IW(IXXP).GT.0) THEN + WRITE(*,*) "Internal error 2 in SMUMPS_22",IW(IXXP),IXXP + ENDIF + IWPOSCB = IWPOSCB - LREQ + IF (SET_HEADER) THEN + IW(IXXP)= IWPOSCB + 1 + IW(IWPOSCB+1+XXI)=LREQ + CALL MUMPS_730(LREQCB, IW(IWPOSCB+1+XXR)) + IW(IWPOSCB+1+XXS)=STATE_ARG + IW(IWPOSCB+1+XXN)=NODE_ARG + IW(IWPOSCB+1+XXP)=TOP_OF_STACK + ENDIF + IPTRLU = IPTRLU - LREQCB + LRLU = LRLU - LREQCB + LRLUS = LRLUS - LREQCB_EFF + KEEP8(67) = min(LRLUS, KEEP8(67)) +#if ! defined(OLD_LOAD_MECHANISM) + CALL SMUMPS_471(SSARBR,PROCESS_BANDE, + & LA-LRLUS,0_8,LREQCB_EFF,KEEP,KEEP8,LRLU) +#else +#if defined (CHECK_COHERENCE) + CALL SMUMPS_471(SSARBR,PROCESS_BANDE, + & LA-LRLUS,0_8,LREQCB_EFF,KEEP,KEEP8,LRLU) +#else + CALL SMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,0_8,LREQCB_EFF,KEEP,KEEP8,LRLU) +#endif +#endif + RETURN + 600 IFLAG = -8 + IERROR = LREQ + RETURN + 620 IFLAG = -9 + CALL MUMPS_731(LREQCB_EFF - LRLUS, IERROR) + RETURN + END SUBROUTINE SMUMPS_22 + SUBROUTINE SMUMPS_244(N, NSTEPS, + & A, LA, IW, LIW, SYM_PERM, NA, LNA, + & NE_STEPS, NFSIZ, FILS, + & STEP, FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & PTRAR, LDPTRAR, + & PTRIST, PTLUST_S, PTRFAC, IW1, IW2, ITLOC, RHS_MUMPS, + & POOL, LPOOL, + & CNTL1, ICNTL, INFO, RINFO, KEEP,KEEP8,PROCNODE_STEPS, + & SLAVEF, + & COMM_NODES, MYID, MYID_NODES, + & BUFR,LBUFR,LBUFR_BYTES,INTARR,DBLARR, + & root, NELT, FRTPTR, FRTELT, COMM_LOAD, + & ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, + & MEM_DISTRIB, + & DKEEP,PIVNUL_LIST,LPN_LIST) + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER(8) :: LA + INTEGER N,NSTEPS,LIW,LPOOL,SLAVEF,COMM_NODES + INTEGER MYID, MYID_NODES,LNA + REAL A(LA) + REAL RINFO(40) + INTEGER LBUFR, LBUFR_BYTES + INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB + INTEGER BUFR( LBUFR ) + INTEGER NELT, LDPTRAR + INTEGER FRTPTR(*), FRTELT(*) + REAL CNTL1 + INTEGER ICNTL(40) + INTEGER INFO(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IW(LIW), SYM_PERM(N), NA(LNA), + & NE_STEPS(KEEP(28)), FILS(N), + & FRERE(KEEP(28)), NFSIZ(KEEP(28)), + & DAD(KEEP(28)) + INTEGER CAND(SLAVEF+1, max(1,KEEP(56))) + INTEGER STEP(N) + INTEGER PTRAR(LDPTRAR,2) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER IW1(3*KEEP(28)), ITLOC(N+KEEP(253)), POOL(LPOOL) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: IW2(2*KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR(max(1,KEEP(14))) + REAL DBLARR(max(1,KEEP(13))) + REAL SEUIL, SEUIL_LDLT_NIV2 + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + REAL UULOC + INTEGER LP, MPRINT + INTEGER NSTK,PTRAST, NBPROCFILS + INTEGER PIMASTER, PAMASTER + LOGICAL PROK + REAL ZERO, ONE + DATA ZERO /0.0E0/ + DATA ONE /1.0E0/ + INTRINSIC int,real,log + INTEGER IERR + INTEGER NTOTPV, NTOTPVTOT, NMAXNPIV + INTEGER(8) :: POSFAC, LRLU, IPTRLU, LRLUS + INTEGER IWPOS, LEAF, NBROOT, NROOT + KEEP(41)=0 + KEEP(42)=0 + NSTEPS = 0 + LP = ICNTL(1) + MPRINT = ICNTL(2) + PROK = (MPRINT.GT.0) + UULOC = CNTL1 + IF (UULOC.GT.ONE) UULOC=ONE + IF (UULOC.LT.ZERO) UULOC=ZERO + IF (KEEP(50).NE.0.AND.UULOC.GT.0.5E0) THEN + UULOC = 0.5E0 + ENDIF + PIMASTER = 1 + NSTK = PIMASTER + KEEP(28) + NBPROCFILS = NSTK + KEEP(28) + PTRAST = 1 + PAMASTER = 1 + KEEP(28) + IF (KEEP(4).LE.0) KEEP(4)=32 + IF (KEEP(5).LE.0) KEEP(5)=16 + IF (KEEP(5).GT.KEEP(4)) KEEP(5) = KEEP(4) + IF (KEEP(6).LE.0) KEEP(6)=24 + IF (KEEP(3).LE.KEEP(4)) KEEP(3)=KEEP(4)*2 + IF (KEEP(6).GT.KEEP(3)) KEEP(6) = KEEP(3) + POSFAC = 1_8 + IWPOS = 1 + LRLU = LA + LRLUS = LRLU + KEEP8(67) = LRLUS + IPTRLU = LRLU + NTOTPV = 0 + NMAXNPIV = 0 + IW1(NSTK:NSTK+KEEP(28)-1) = NE_STEPS(1:KEEP(28)) + CALL MUMPS_362(N, LEAF, NBROOT, NROOT, + & MYID_NODES, + & SLAVEF, NA, LNA, + & KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & POOL, LPOOL) + CALL SMUMPS_506(POOL, LPOOL, LEAF) + CALL SMUMPS_555(POOL, LPOOL,KEEP,KEEP8) + IF ( KEEP( 38 ) .NE. 0 ) THEN + NBROOT = NBROOT + root%NPROW * root%NPCOL - 1 + END IF + IF ( root%yes ) THEN + IF ( MUMPS_275( PROCNODE_STEPS(STEP(KEEP(38))), SLAVEF ) + & .NE. MYID_NODES ) THEN + NROOT = NROOT + 1 + END IF + END IF + CALL SMUMPS_251(N,IW,LIW,A,LA,IW1(NSTK),IW1(NBPROCFILS), + & INFO(1),NFSIZ,FILS,STEP,FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & INFO(11), NTOTPV, NMAXNPIV, PTRIST,IW2(PTRAST), + & IW1(PIMASTER), IW2(PAMASTER), PTRAR(1,2), + & PTRAR(1,1), + & ITLOC, RHS_MUMPS, INFO(2), POOL, LPOOL, + & RINFO, POSFAC,IWPOS,LRLU,IPTRLU, + & LRLUS, LEAF, NROOT, NBROOT, + & UULOC,ICNTL,PTLUST_S,PTRFAC,NSTEPS,INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS,SLAVEF,MYID,COMM_NODES, + & MYID_NODES, BUFR,LBUFR, LBUFR_BYTES, + & INTARR, DBLARR, root, SYM_PERM, + & NELT, FRTPTR, FRTELT, LDPTRAR, + & COMM_LOAD, ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, + & MEM_DISTRIB,NE_STEPS, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST) + POSFAC = POSFAC -1_8 + IWPOS = IWPOS -1 + IF (KEEP(201).LE.0) THEN + KEEP8(31) = POSFAC + ENDIF + KEEP(32) = IWPOS + CALL MUMPS_735(KEEP8(31), INFO(9)) + INFO(10) = KEEP(32) + KEEP8(67) = LA - KEEP8(67) + KEEP(89) = NTOTPV + KEEP(246) = NMAXNPIV + INFO(23) = KEEP(89) + CALL MPI_ALLREDUCE(NTOTPV, NTOTPVTOT, 1, MPI_INTEGER, MPI_SUM, + & COMM_NODES, IERR) + IF ( ( (INFO(1).EQ.-10 .OR. INFO(1).EQ.-40) + & .AND. (NTOTPVTOT.EQ.N) ) + & .OR. ( NTOTPVTOT.GT.N ) ) THEN + write(*,*) ' Error 1 in mc51d NTOTPVTOT=', NTOTPVTOT + CALL MUMPS_ABORT() + ENDIF + IF ( (KEEP(19).NE.0 ) .AND. (NTOTPVTOT.NE.N) .AND. + & (INFO(1).GE.0) ) THEN + write(*,*) ' Error 2 in mc51d NTOTPVTOT=', NTOTPVTOT + CALL MUMPS_ABORT() + ENDIF + IF ( (INFO(1) .GE. 0 ) + & .AND. (NTOTPVTOT.NE.N) ) THEN + INFO(1) = -10 + INFO(2) = NTOTPVTOT + ENDIF + IF (PROK) THEN + WRITE (MPRINT,99980) INFO(1), INFO(2), + & KEEP(28), KEEP8(31), INFO(10), INFO(11), INFO(12), + & INFO(13), INFO(14), INFO(25), RINFO(2), RINFO(3) + ENDIF + RETURN +99980 FORMAT (/' LEAVING FACTORIZATION PHASE WITH ...'/ + & ' INFO (1) =',I15/ + & ' --- (2) =',I15/ + & ' NUMBER OF NODES IN THE TREE =',I15/ + & ' INFO (9) REAL SPACE FOR FACTORS =',I15/ + & ' --- (10) INTEGER SPACE FOR FACTORS =',I15/ + & ' --- (11) MAXIMUM SIZE OF FRONTAL MATRICES =',I15/ + & ' --- (12) NUMBER OF OFF DIAGONAL PIVOTS =',I15/ + & ' --- (13) NUMBER OF DELAYED PIVOTS =',I15/ + & ' --- (14) NUMBER OF MEMORY COMPRESSES =',I15/ + & ' --- (25) NUMBER OF ENTRIES IN FACTORS =',I15/ + & ' RINFO(2) OPERATIONS DURING NODE ASSEMBLY =',1PD10.3/ + & ' -----(3) OPERATIONS DURING NODE ELIMINATION =',1PD10.3) +99990 FORMAT(/ ' NUMBER OF MSGS RECVD FOR DYNAMIC LOAD =',I15) + END SUBROUTINE SMUMPS_244 + SUBROUTINE SMUMPS_269( MYID,KEEP,KEEP8, + & BUFR, LBUFR, LBUFR_BYTES, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, + & N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, + & FPERE, FLAG, IFLAG, IERROR, COMM, + & ITLOC, RHS_MUMPS ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER MYID + INTEGER LBUFR, LBUFR_BYTES + INTEGER KEEP(500), BUFR( LBUFR ) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER(8) :: PTRAST (KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP, FPERE + LOGICAL FLAG + INTEGER NSTK_S( KEEP(28) ), ITLOC( N + KEEP(253) ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER IFLAG, IERROR, COMM + INTEGER POSITION, FINODE, FLCONT, LREQ + INTEGER(8) :: LREQCB + INTEGER(8) :: IPOS_NODE, ISHIFT_PACKET + INTEGER SIZE_PACKET + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INCLUDE 'mumps_headers.h' + LOGICAL COMPRESSCB + FLAG = .FALSE. + POSITION = 0 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & FINODE, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & FPERE, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & FLCONT, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, MPI_INTEGER, + & COMM, IERR) + COMPRESSCB = (FLCONT.LT.0) + IF (COMPRESSCB) THEN + FLCONT = -FLCONT + LREQCB = (int(FLCONT,8) * int(FLCONT+1,8)) / 2_8 + ELSE + LREQCB = int(FLCONT,8) * int(FLCONT,8) + ENDIF + IF (NBROWS_ALREADY_SENT == 0) THEN + LREQ = 2 * FLCONT + 6 + KEEP(IXSZ) + IF (IPTRLU.LT.0_8) WRITE(*,*) 'before alloc_cb:IPTRLU = ',IPTRLU + CALL SMUMPS_22( .FALSE., 0_8, .FALSE.,.FALSE., + & MYID,N, KEEP,KEEP8, IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, + & LREQ, LREQCB, FINODE, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF (IPTRLU.LT.0_8) WRITE(*,*) 'after alloc_cb:IPTRLU = ',IPTRLU + IF ( IFLAG .LT. 0 ) RETURN + PIMASTER(STEP( FINODE )) = IWPOSCB + 1 + PAMASTER(STEP( FINODE )) = IPTRLU + 1_8 + IF (COMPRESSCB) IW(IWPOSCB + 1 + XXS ) = S_CB1COMP + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IW(IWPOSCB + 1+KEEP(IXSZ)), LREQ-KEEP(IXSZ), + & MPI_INTEGER, COMM, IERR) + ENDIF + IF (COMPRESSCB) THEN + ISHIFT_PACKET = int(NBROWS_ALREADY_SENT,8) * + & int(NBROWS_ALREADY_SENT+1,8) / 2_8 + SIZE_PACKET = (NBROWS_PACKET * (NBROWS_PACKET+1))/2 + + & NBROWS_ALREADY_SENT * NBROWS_PACKET + ELSE + ISHIFT_PACKET = int(NBROWS_ALREADY_SENT,8) * int(FLCONT,8) + SIZE_PACKET = NBROWS_PACKET * FLCONT + ENDIF + IF (NBROWS_PACKET.NE.0) THEN + IF ( LREQCB .ne. 0_8 ) THEN + IPOS_NODE = PAMASTER(STEP(FINODE))-1_8 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & A(IPOS_NODE + 1_8 + ISHIFT_PACKET), + & SIZE_PACKET, MPI_REAL, COMM, IERR) + END IF + ENDIF + IF (NBROWS_ALREADY_SENT+NBROWS_PACKET == FLCONT) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF ( NSTK_S(STEP(FPERE)).EQ.0 ) THEN + FLAG = . TRUE. + END IF + ENDIF + RETURN + END SUBROUTINE SMUMPS_269 + SUBROUTINE SMUMPS_270( TOT_ROOT_SIZE, + & TOT_CONT_TO_RECV, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND) + USE SMUMPS_LOAD + USE SMUMPS_OOC + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER TOT_ROOT_SIZE, TOT_CONT_TO_RECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA, POSFAC + INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ), ND( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM, COMM_LOAD + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC(N+KEEP(253)), FILS(N), PTRARW(N), PTRAIW(N) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + REAL DBLARR(max(1,KEEP(13))) + INTEGER :: allocok + REAL, DIMENSION(:,:), POINTER :: TMP + INTEGER NEW_LOCAL_M, NEW_LOCAL_N + INTEGER OLD_LOCAL_M, OLD_LOCAL_N + INTEGER I, J + INTEGER LREQI, IROOT + INTEGER(8) :: LREQA + INTEGER POSHEAD, IPOS_SON,IERR + LOGICAL MASTER_OF_ROOT + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INCLUDE 'mumps_headers.h' + INTEGER numroc, MUMPS_275 + EXTERNAL numroc, MUMPS_275 + IROOT = KEEP( 38 ) + root%TOT_ROOT_SIZE = TOT_ROOT_SIZE + MASTER_OF_ROOT = ( MYID .EQ. + & MUMPS_275( PROCNODE_STEPS(STEP(IROOT)), + & SLAVEF ) ) + NEW_LOCAL_M = numroc( TOT_ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + NEW_LOCAL_M = max( 1, NEW_LOCAL_M ) + NEW_LOCAL_N = numroc( TOT_ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + IF ( PTRIST(STEP( IROOT )).GT.0) THEN + OLD_LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) ) + OLD_LOCAL_M = IW( PTRIST(STEP( IROOT )) + 1 + KEEP(IXSZ)) + ELSE + OLD_LOCAL_N = 0 + OLD_LOCAL_M = NEW_LOCAL_M + ENDIF + IF (KEEP(60) .NE. 0) THEN + IF (root%yes) THEN + IF ( NEW_LOCAL_M .NE. root%SCHUR_MLOC .OR. + & NEW_LOCAL_N .NE. root%SCHUR_NLOC ) THEN + WRITE(*,*) "Internal error 1 in SMUMPS_270" + CALL MUMPS_ABORT() + ENDIF + ENDIF + PTLUST_S(STEP(IROOT)) = -4444 + PTRFAC(STEP(IROOT)) = -4445_8 + PTRIST(STEP(IROOT)) = 0 + IF ( MASTER_OF_ROOT ) THEN + LREQI=6+2*TOT_ROOT_SIZE+KEEP(IXSZ) + LREQA=0_8 + IF ( IWPOS + LREQI - 1. GT. IWPOSCB ) THEN + CALL SMUMPS_94( N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB1 compress root2slave:LRLU,LRLUS=', + & LRLU, LRLUS + IFLAG = -9 + CALL MUMPS_731(LREQA-LRLUS, IERROR) + GOTO 700 + END IF + ENDIF + IF ( IWPOS + LREQI - 1. GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + GOTO 700 + ENDIF + PTLUST_S(STEP(IROOT))= IWPOS + IWPOS = IWPOS + LREQI + POSHEAD = PTLUST_S( STEP(IROOT)) + IW( POSHEAD + XXI )=LREQI + CALL MUMPS_730( LREQA, IW(POSHEAD + XXR)) + IW( POSHEAD + XXS )=-9999 + IW( POSHEAD +KEEP(IXSZ)) = 0 + IW( POSHEAD + 1 +KEEP(IXSZ)) = -1 + IW( POSHEAD + 2 +KEEP(IXSZ)) = -1 + IW( POSHEAD + 4 +KEEP(IXSZ)) = STEP(IROOT) + IW( POSHEAD + 5 +KEEP(IXSZ)) = 0 + IW( POSHEAD + 3 +KEEP(IXSZ)) = TOT_ROOT_SIZE + ENDIF + GOTO 100 + ENDIF + IF ( MASTER_OF_ROOT ) THEN + LREQI = 6 + 2 * TOT_ROOT_SIZE+KEEP(IXSZ) + ELSE + LREQI = 6+KEEP(IXSZ) + END IF + LREQA = int(NEW_LOCAL_M, 8) * int(NEW_LOCAL_N, 8) + IF ( LRLU . LT. LREQA .OR. + & IWPOS + LREQI - 1. GT. IWPOSCB )THEN + IF ( LRLUS .LT. LREQA ) THEN + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GOTO 700 + END IF + CALL SMUMPS_94( N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB2 compress root2slave:LRLU,LRLUS=', + & LRLU, LRLUS + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GOTO 700 + END IF + IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + GOTO 700 + END IF + END IF + PTLUST_S(STEP( IROOT )) = IWPOS + IWPOS = IWPOS + LREQI + IF (LREQA.EQ.0_8) THEN + PTRAST (STEP(IROOT)) = max(POSFAC-1_8,1_8) + PTRFAC (STEP(IROOT)) = max(POSFAC-1_8,1_8) + ELSE + PTRAST (STEP(IROOT)) = POSFAC + PTRFAC (STEP(IROOT)) = POSFAC + ENDIF + POSFAC = POSFAC + LREQA + LRLU = LRLU - LREQA + LRLUS = LRLUS - LREQA + KEEP8(67) = min(KEEP8(67), LRLUS) + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU) + POSHEAD = PTLUST_S( STEP(IROOT)) + IW( POSHEAD + XXI ) = LREQI + CALL MUMPS_730( LREQA, IW(POSHEAD + XXR)) + IW( POSHEAD + XXS ) = S_NOTFREE + IW( POSHEAD + KEEP(IXSZ) ) = 0 + IW( POSHEAD + 1 + KEEP(IXSZ) ) = NEW_LOCAL_N + IW( POSHEAD + 2 + KEEP(IXSZ) ) = NEW_LOCAL_M + IW( POSHEAD + 4 + KEEP(IXSZ) ) = STEP(IROOT) + IW( POSHEAD + 5 + KEEP(IXSZ) ) = 0 + IF ( MASTER_OF_ROOT ) THEN + IW( POSHEAD + 3 + KEEP(IXSZ) ) = TOT_ROOT_SIZE + ELSE + IW( POSHEAD + 3 + KEEP(IXSZ) ) = 0 + ENDIF + IF ( KEEP( 50 ) .eq. 0 .OR. KEEP(50) .eq. 2 ) THEN + OPELIW = OPELIW + ( dble(2*TOT_ROOT_SIZE) * + & dble(TOT_ROOT_SIZE) * dble(TOT_ROOT_SIZE ) / dble(3) + & - 0.5d0 * dble( TOT_ROOT_SIZE ) * dble( TOT_ROOT_SIZE ) + & - dble( TOT_ROOT_SIZE ) / dble( 6 ) ) + & / dble( root%NPROW * root%NPCOL ) + ELSE + OPELIW = OPELIW + ( dble(TOT_ROOT_SIZE) * + & dble( TOT_ROOT_SIZE) * + & dble( TOT_ROOT_SIZE + 1 ) ) + & / dble( 3 * root%NPROW * root%NPCOL ) + END IF + IF ( PTRIST(STEP( IROOT )) .LE. 0 ) THEN + PTRIST(STEP( IROOT )) = 0 + PAMASTER(STEP( IROOT )) = 0_8 + IF (LREQA.GT.0_8) A(PTRAST(STEP(IROOT)): + & PTRAST(STEP(IROOT))+LREQA-1_8) = ZERO + ELSE + OLD_LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) ) + OLD_LOCAL_M = IW( PTRIST(STEP( IROOT )) + 1 + KEEP(IXSZ)) + IF ( TOT_ROOT_SIZE .eq. root%ROOT_SIZE ) THEN + IF ( LREQA .NE. int(OLD_LOCAL_M,8) * int(OLD_LOCAL_N,8) ) + & THEN + write(*,*) 'error 1 in PROCESS_ROOT2SLAVE', + & OLD_LOCAL_M, OLD_LOCAL_N + CALL MUMPS_ABORT() + END IF + CALL SMUMPS_756(LREQA, + & A( PAMASTER(STEP(IROOT)) ), + & A( PTRAST (STEP(IROOT)) ) ) + ELSE + CALL SMUMPS_96( A( PTRAST(STEP(IROOT))), + & NEW_LOCAL_M, + & NEW_LOCAL_N, A( PAMASTER( STEP(IROOT)) ), OLD_LOCAL_M, + & OLD_LOCAL_N ) + END IF + IF ( PTRIST( STEP( IROOT ) ) .GT. 0 ) THEN + IPOS_SON= PTRIST( STEP(IROOT)) + CALL SMUMPS_152(.FALSE., MYID, N, IPOS_SON, + & PAMASTER(STEP(IROOT)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + PTRIST(STEP( IROOT )) = 0 + PAMASTER(STEP( IROOT )) = 0_8 + END IF + END IF + IF (NEW_LOCAL_M.GT.OLD_LOCAL_M) THEN + TMP => root%RHS_ROOT + NULLIFY(root%RHS_ROOT) + ALLOCATE (root%RHS_ROOT(NEW_LOCAL_M, root%RHS_NLOC), + & stat=allocok) + IF ( allocok.GT.0) THEN + IFLAG=-13 + IERROR = NEW_LOCAL_M*root%RHS_NLOC + GOTO 700 + ENDIF + DO J = 1, root%RHS_NLOC + DO I = 1, OLD_LOCAL_M + root%RHS_ROOT(I,J)=TMP(I,J) + ENDDO + DO I = OLD_LOCAL_M+1, NEW_LOCAL_M + root%RHS_ROOT(I,J) = ZERO + ENDDO + ENDDO + DEALLOCATE(TMP) + NULLIFY(TMP) + ENDIF + 100 CONTINUE + NBPROCFILS(STEP(IROOT))=NBPROCFILS(STEP(IROOT)) + TOT_CONT_TO_RECV + IF ( NBPROCFILS(STEP(IROOT)) .eq. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + CALL SMUMPS_681(IERR) + ELSE IF (KEEP(201).EQ.2) THEN + CALL SMUMPS_580(IERR) + ENDIF + CALL SMUMPS_507( N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IROOT + N ) + IF (KEEP(47) .GE. 3) THEN + CALL SMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + RETURN + 700 CONTINUE + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE SMUMPS_270 + SUBROUTINE SMUMPS_96 + &( NEW, M_NEW, N_NEW,OLD, M_OLD, N_OLD ) + INTEGER M_NEW, N_NEW, M_OLD, N_OLD + REAL NEW( M_NEW, N_NEW ), OLD( M_OLD, N_OLD ) + INTEGER J + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + DO J = 1, N_OLD + NEW( 1: M_OLD, J ) = OLD( 1: M_OLD, J ) + NEW( M_OLD + 1: M_NEW, J ) = ZERO + END DO + NEW( 1: M_NEW,N_OLD + 1: N_NEW ) = ZERO + RETURN + END SUBROUTINE SMUMPS_96 + INTEGER FUNCTION SMUMPS_505(KEEP,KEEP8) + IMPLICIT NONE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + SMUMPS_505 = KEEP(28) + 1 + 3 + RETURN + END FUNCTION SMUMPS_505 + SUBROUTINE SMUMPS_506(IPOOL, LPOOL, LEAF) + USE SMUMPS_LOAD + IMPLICIT NONE + INTEGER LPOOL, LEAF + INTEGER IPOOL(LPOOL) + IPOOL(LPOOL-2) = 0 + IPOOL(LPOOL-1) = 0 + IPOOL(LPOOL) = LEAF-1 + RETURN + END SUBROUTINE SMUMPS_506 + SUBROUTINE SMUMPS_507 + & (N, POOL, LPOOL, PROCNODE, SLAVEF, + & K28, K76, K80, K47, STEP, INODE) + USE SMUMPS_LOAD + IMPLICIT NONE + INTEGER N, INODE, LPOOL, K28, SLAVEF, K76, K80, K47 + INTEGER STEP(N), POOL(LPOOL), PROCNODE(K28) + EXTERNAL MUMPS_170 + LOGICAL MUMPS_170, ATM_CURRENT_NODE + INTEGER NBINSUBTREE, NBTOP, INODE_EFF,POS_TO_INSERT + INTEGER IPOS1, IPOS2, ISWAP + INTEGER NODE,J,I + ATM_CURRENT_NODE = ( K76 == 2 .OR. K76 ==3 .OR. + & K76==4 .OR. K76==5) + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + IF (INODE > N ) THEN + INODE_EFF = INODE - N + ELSE IF (INODE < 0) THEN + INODE_EFF = - INODE + ELSE + INODE_EFF = INODE + ENDIF + IF(((INODE.GT.0).AND.(INODE.LE.N)).AND.(.NOT. + & MUMPS_170(PROCNODE(STEP(INODE_EFF)), + & SLAVEF)) + & ) THEN + IF ((K80 == 1 .AND. K47 .GE. 1) .OR. + & (( K80 == 2 .OR. K80==3 ) .AND. + & ( K47 == 4 ))) THEN + CALL SMUMPS_514(INODE,1) + ENDIF + ENDIF + IF ( MUMPS_170(PROCNODE(STEP(INODE_EFF)), + & SLAVEF) ) THEN + POOL(NBINSUBTREE + 1 ) = INODE + NBINSUBTREE = NBINSUBTREE + 1 + ELSE + POS_TO_INSERT=NBTOP+1 + IF((K76.EQ.4).OR.(K76.EQ.5))THEN +#if defined(NOT_ATM_POOL_SPECIAL) + J=NBTOP +#else + IF((INODE.GT.N).OR.(INODE.LE.0))THEN + DO J=NBTOP,1,-1 + IF((POOL(LPOOL-2-J).GT.0) + & .AND.(POOL(LPOOL-2-J).LE.N))THEN + GOTO 333 + ENDIF + IF ( POOL(LPOOL-2-J) < 0 ) THEN + NODE=-POOL(LPOOL-2-J) + ELSE IF ( POOL(LPOOL-2-J) > N ) THEN + NODE = POOL(LPOOL-2-J) - N + ELSE + NODE = POOL(LPOOL-2-J) + ENDIF + IF(K76.EQ.4)THEN + IF(DEPTH_FIRST_LOAD(STEP(NODE)).GE. + & DEPTH_FIRST_LOAD(STEP(INODE_EFF)))THEN + GOTO 333 + ENDIF + ENDIF + IF(K76.EQ.5)THEN + IF(COST_TRAV(STEP(NODE)).LE. + & COST_TRAV(STEP(INODE_EFF)))THEN + GOTO 333 + ENDIF + ENDIF + POS_TO_INSERT=POS_TO_INSERT-1 + ENDDO + IF(J.EQ.0) J=1 + 333 CONTINUE + DO I=NBTOP,POS_TO_INSERT,-1 + POOL(LPOOL-2-I-1)=POOL(LPOOL-2-I) + ENDDO + POOL(LPOOL-2-POS_TO_INSERT)=INODE + NBTOP = NBTOP + 1 + GOTO 20 + ENDIF + DO J=NBTOP,1,-1 + IF((POOL(LPOOL-2-J).GT.0).AND.(POOL(LPOOL-2-J).LE.N))THEN + GOTO 888 + ENDIF + POS_TO_INSERT=POS_TO_INSERT-1 + ENDDO + 888 CONTINUE +#endif + DO I=J,1,-1 +#if defined(NOT_ATM_POOL_SPECIAL) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE = POOL(LPOOL-2-I) - N + ELSE + NODE = POOL(LPOOL-2-I) + ENDIF +#else + NODE=POOL(LPOOL-2-I) +#endif + IF(K76.EQ.4)THEN + IF(DEPTH_FIRST_LOAD(STEP(NODE)).GE. + & DEPTH_FIRST_LOAD(STEP(INODE_EFF)))THEN + GOTO 999 + ENDIF + ENDIF + IF(K76.EQ.5)THEN + IF(COST_TRAV(STEP(NODE)).LE. + & COST_TRAV(STEP(INODE_EFF)))THEN + GOTO 999 + ENDIF + ENDIF + POS_TO_INSERT=POS_TO_INSERT-1 + ENDDO + IF(I.EQ.0) I=1 + 999 CONTINUE + DO J=NBTOP,POS_TO_INSERT,-1 + POOL(LPOOL-2-J-1)=POOL(LPOOL-2-J) + ENDDO + POOL(LPOOL-2-POS_TO_INSERT)=INODE + NBTOP = NBTOP + 1 + GOTO 20 + ENDIF + POOL( LPOOL - 2 - ( NBTOP + 1 ) ) = INODE + NBTOP = NBTOP + 1 + IPOS1 = LPOOL - 2 - NBTOP + IPOS2 = LPOOL - 2 - NBTOP + 1 + 10 CONTINUE + IF ( IPOS2 == LPOOL - 2 ) GOTO 20 + IF ( POOL(IPOS1) < 0 ) GOTO 20 + IF ( POOL(IPOS2) < 0 ) GOTO 30 + IF ( ATM_CURRENT_NODE ) THEN + IF ( POOL(IPOS1) > N ) GOTO 20 + IF ( POOL(IPOS2) > N ) GOTO 30 + END IF + GOTO 20 + 30 CONTINUE + ISWAP = POOL(IPOS1) + POOL(IPOS1) = POOL(IPOS2) + POOL(IPOS2) = ISWAP + IPOS1 = IPOS1 + 1 + IPOS2 = IPOS2 + 1 + GOTO 10 + 20 CONTINUE + ENDIF + POOL(LPOOL) = NBINSUBTREE + POOL(LPOOL - 1) = NBTOP + RETURN + END SUBROUTINE SMUMPS_507 + LOGICAL FUNCTION SMUMPS_508(POOL, LPOOL) + IMPLICIT NONE + INTEGER LPOOL + INTEGER POOL(LPOOL) + INTEGER NBINSUBTREE, NBTOP + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + SMUMPS_508 = (NBINSUBTREE + NBTOP == 0) + RETURN + END FUNCTION SMUMPS_508 + SUBROUTINE SMUMPS_509( N, POOL, LPOOL, PROCNODE, SLAVEF, + & STEP, INODE, KEEP,KEEP8, MYID, ND, + & FORCE_EXTRACT_TOP_SBTR ) + USE SMUMPS_LOAD + IMPLICIT NONE + INTEGER INODE, LPOOL, SLAVEF, N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER STEP(N), POOL(LPOOL), PROCNODE(KEEP(28)), + & ND(KEEP(28)) + EXTERNAL MUMPS_167, MUMPS_283, SMUMPS_508 + LOGICAL MUMPS_167, MUMPS_283, SMUMPS_508 + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + INTEGER NBINSUBTREE, NBTOP, INSUBTREE, INODE_EFF, MYID + LOGICAL LEFT, ATOMIC_SUBTREE,UPPER,FLAG_MEM,SBTR_FLAG,PROC_FLAG + LOGICAL FORCE_EXTRACT_TOP_SBTR + INTEGER NODE_TO_EXTRACT,I,J,MIN_PROC +#if defined(POOL_EXTRACT_MNG) + INTEGER POS_TO_EXTRACT +#endif + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + IF ( KEEP(76) > 6 .OR. KEEP(76) < 0 ) THEN + WRITE(*,*) "Error 2 in SMUMPS_509: unknown strategy" + CALL MUMPS_ABORT() + ENDIF + ATOMIC_SUBTREE = ( KEEP(76) == 1 .OR. KEEP(76) == 3) + IF ( SMUMPS_508(POOL, LPOOL) ) THEN + WRITE(*,*) "Error 1 in SMUMPS_509" + CALL MUMPS_ABORT() + ENDIF + IF ( .NOT. ATOMIC_SUBTREE ) THEN + LEFT = (NBTOP == 0) + IF(.NOT.LEFT)THEN + IF((KEEP(76).EQ.4).OR.(KEEP(76).EQ.5))THEN + IF(NBINSUBTREE.EQ.0)THEN + LEFT=.FALSE. + ELSE + IF ( POOL(NBINSUBTREE) < 0 ) THEN + I = -POOL(NBINSUBTREE) + ELSE IF ( POOL(NBINSUBTREE) > N ) THEN + I = POOL(NBINSUBTREE) - N + ELSE + I = POOL(NBINSUBTREE) + ENDIF + IF ( POOL(LPOOL-2-NBTOP) < 0 ) THEN + J = -POOL(LPOOL-2-NBTOP) + ELSE IF ( POOL(LPOOL-2-NBTOP) > N ) THEN + J = POOL(LPOOL-2-NBTOP) - N + ELSE + J = POOL(LPOOL-2-NBTOP) + ENDIF + IF(KEEP(76).EQ.4)THEN + IF(DEPTH_FIRST_LOAD(STEP(J)).GE. + & DEPTH_FIRST_LOAD(STEP(I)))THEN + LEFT=.TRUE. + ELSE + LEFT=.FALSE. + ENDIF + ENDIF + IF(KEEP(76).EQ.5)THEN + IF(COST_TRAV(STEP(J)).LE. + & COST_TRAV(STEP(I)))THEN + LEFT=.TRUE. + ELSE + LEFT=.FALSE. + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + IF ( INSUBTREE == 1 ) THEN + IF (NBINSUBTREE == 0) THEN + WRITE(*,*) "Error 3 in SMUMPS_509" + CALL MUMPS_ABORT() + ENDIF + LEFT = .TRUE. + ELSE + LEFT = ( NBTOP == 0) + ENDIF + ENDIF + 222 CONTINUE + IF ( LEFT ) THEN + INODE = POOL( NBINSUBTREE ) + IF(KEEP(81).EQ.2)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + CALL SMUMPS_561(INODE,POOL,LPOOL,N, + & STEP,KEEP,KEEP8,PROCNODE,SLAVEF,MYID,SBTR_FLAG, + & PROC_FLAG,MIN_PROC) + IF(.NOT.SBTR_FLAG)THEN + WRITE(*,*)MYID,': ca a change pour moi' + LEFT=.FALSE. + GOTO 222 + ENDIF +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ELSEIF(KEEP(81).EQ.3)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + NODE_TO_EXTRACT=INODE + FLAG_MEM=.FALSE. + CALL SMUMPS_820(FLAG_MEM) + IF(FLAG_MEM)THEN + CALL SMUMPS_561(INODE,POOL,LPOOL,N, + & STEP,KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG, + & PROC_FLAG,MIN_PROC) + IF(.NOT.SBTR_FLAG)THEN + LEFT=.FALSE. + WRITE(*,*)MYID,': ca a change pour moi (2)' + GOTO 222 + ENDIF + ENDIF +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF + NBINSUBTREE = NBINSUBTREE - 1 + IF ( INODE < 0 ) THEN + INODE_EFF = -INODE + ELSE IF ( INODE > N ) THEN + INODE_EFF = INODE - N + ELSE + INODE_EFF = INODE + ENDIF + IF ( MUMPS_167( PROCNODE(STEP(INODE_EFF)), SLAVEF) ) THEN + IF((KEEP(47).GE.2.AND.KEEP(81).EQ.1).AND. + & (INSUBTREE.EQ.0))THEN + CALL SMUMPS_513(.TRUE.) + ENDIF + INSUBTREE = 1 + ELSE IF ( MUMPS_283( PROCNODE(STEP(INODE_EFF)), + & SLAVEF)) THEN + IF((KEEP(47).GE.2.AND.KEEP(81).EQ.1).AND. + & (INSUBTREE.EQ.1))THEN + CALL SMUMPS_513(.FALSE.) + ENDIF + INSUBTREE = 0 + END IF + ELSE + IF (NBTOP < 1 ) THEN + WRITE(*,*) "Error 5 in SMUMPS_509", NBTOP + CALL MUMPS_ABORT() + ENDIF + INODE = POOL( LPOOL - 2 - NBTOP ) + IF(KEEP(81).EQ.1)THEN + CALL SMUMPS_520 + & (INODE,UPPER,SLAVEF,KEEP,KEEP8, + & STEP,POOL,LPOOL,PROCNODE,N) + IF(UPPER)THEN + GOTO 666 + ELSE + NBINSUBTREE=NBINSUBTREE-1 + IF ( MUMPS_167( PROCNODE(STEP(INODE)), + & SLAVEF) ) THEN + INSUBTREE = 1 + ELSE IF ( MUMPS_283( PROCNODE(STEP(INODE)), + & SLAVEF)) THEN + INSUBTREE = 0 + ENDIF + GOTO 777 + ENDIF + ENDIF + IF(KEEP(81).EQ.2)THEN + CALL SMUMPS_561(INODE,POOL,LPOOL,N,STEP, + & KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) + IF(SBTR_FLAG)THEN + LEFT=.TRUE. + WRITE(*,*)MYID,': ca a change pour moi (3)' + GOTO 222 + ENDIF + ELSE +#if defined(POOL_EXTRACT_MNG) + IF(KEEP(76).EQ.4)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + POS_TO_EXTRACT=-1 + NODE_TO_EXTRACT=-1 + DO I=NBTOP,1,-1 + IF(NODE_TO_EXTRACT.LT.0)THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ELSE + IF(DEPTH_FIRST_LOAD(STEP(POOL(LPOOL-2-I))).LT. + & DEPTH_FIRST_LOAD(STEP(NODE_TO_EXTRACT))) + & THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ENDIF + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + INODE = NODE_TO_EXTRACT +#else + INODE = INODE_EFF +#endif + DO I=POS_TO_EXTRACT,NBTOP + IF(I.NE.NBTOP)THEN + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF + IF(KEEP(76).EQ.5)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + POS_TO_EXTRACT=-1 + NODE_TO_EXTRACT=-1 + DO I=NBTOP,1,-1 + IF(NODE_TO_EXTRACT.LT.0)THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ELSE + IF(COST_TRAV(STEP(POOL(LPOOL-2-I))).GT. + & COST_TRAV(STEP(NODE_TO_EXTRACT)))THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ENDIF + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + INODE = NODE_TO_EXTRACT +#else + INODE = INODE_EFF +#endif + DO I=POS_TO_EXTRACT,NBTOP + IF(I.NE.NBTOP)THEN + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF +#endif + IF(KEEP(81).EQ.3)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + NODE_TO_EXTRACT=INODE + FLAG_MEM=.FALSE. + CALL SMUMPS_820(FLAG_MEM) + IF(FLAG_MEM)THEN + CALL SMUMPS_561(INODE,POOL,LPOOL,N, + & STEP,KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG, + & PROC_FLAG,MIN_PROC) + IF(SBTR_FLAG)THEN + LEFT=.TRUE. + WRITE(*,*)MYID,': ca a change pour moi (4)' + GOTO 222 + ENDIF + ELSE + CALL SMUMPS_819(INODE) + ENDIF +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF + ENDIF + 666 CONTINUE + NBTOP = NBTOP - 1 + IF((INODE.GT.0).AND.(INODE.LE.N))THEN + IF ((( KEEP(80) == 2 .OR. KEEP(80)==3 ) .AND. + & ( KEEP(47) == 4 ))) THEN + CALL SMUMPS_514(INODE,2) + ENDIF + ENDIF + IF ( INODE < 0 ) THEN + INODE_EFF = -INODE + ELSE IF ( INODE > N ) THEN + INODE_EFF = INODE - N + ELSE + INODE_EFF = INODE + ENDIF + END IF + 777 CONTINUE + POOL(LPOOL) = NBINSUBTREE + POOL(LPOOL - 1) = NBTOP + POOL(LPOOL - 2) = INSUBTREE + RETURN + END SUBROUTINE SMUMPS_509 + SUBROUTINE SMUMPS_552(INODE,POOL,LPOOL,N,STEP, + & KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR,FLAG_SAME_PROC,MIN_PROC) + USE SMUMPS_LOAD + IMPLICIT NONE + INTEGER INODE,LPOOL,N,MYID,SLAVEF,PROC,MIN_PROC + INTEGER POOL(LPOOL),KEEP(500),STEP(N),PROCNODE(KEEP(28)) + INTEGER(8) KEEP8(150) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + LOGICAL SBTR,FLAG_SAME_PROC + INTEGER POS_TO_EXTRACT,NODE_TO_EXTRACT,NBTOP,I,INSUBTREE, + & NBINSUBTREE + DOUBLE PRECISION MIN_COST, TMP_COST + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + MIN_COST=huge(MIN_COST) + TMP_COST=huge(TMP_COST) + FLAG_SAME_PROC=.FALSE. + SBTR=.FALSE. + MIN_PROC=-9999 +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GT.0).AND.(INODE.LE.N))THEN +#endif + POS_TO_EXTRACT=-1 + NODE_TO_EXTRACT=-1 + DO I=NBTOP,1,-1 + IF(NODE_TO_EXTRACT.LT.0)THEN + POS_TO_EXTRACT=I + NODE_TO_EXTRACT=POOL(LPOOL-2-I) + CALL SMUMPS_818(NODE_TO_EXTRACT, + & TMP_COST,PROC) + MIN_COST=TMP_COST + MIN_PROC=PROC + ELSE + CALL SMUMPS_818(POOL(LPOOL-2-I), + & TMP_COST,PROC) + IF((PROC.NE.MIN_PROC).OR.(TMP_COST.NE.MIN_COST))THEN + FLAG_SAME_PROC=.TRUE. + ENDIF + IF(TMP_COST.GT.MIN_COST)THEN + POS_TO_EXTRACT=I + NODE_TO_EXTRACT=POOL(LPOOL-2-I) + MIN_COST=TMP_COST + MIN_PROC=PROC + ENDIF + ENDIF + ENDDO + IF((KEEP(47).EQ.4).AND.(NBINSUBTREE.NE.0))THEN + CALL SMUMPS_554(NBINSUBTREE,INSUBTREE,NBTOP, + & MIN_COST,SBTR) + IF(SBTR)THEN + WRITE(*,*)MYID,': selecting from subtree' + RETURN + ENDIF + ENDIF + IF((.NOT.SBTR).AND.(.NOT.FLAG_SAME_PROC))THEN + WRITE(*,*)MYID,': I must search for a task + & to save My friend' + RETURN + ENDIF + INODE = NODE_TO_EXTRACT + DO I=POS_TO_EXTRACT,NBTOP + IF(I.NE.NBTOP)THEN + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDIF + ENDDO + POOL(LPOOL-2-NBTOP)=INODE + CALL SMUMPS_819(INODE) +#if ! defined(NOT_ATM_POOL_SPECIAL) + ELSE + ENDIF +#endif + END SUBROUTINE SMUMPS_552 + SUBROUTINE SMUMPS_561(INODE,POOL,LPOOL,N,STEP, + & KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) + USE SMUMPS_LOAD + IMPLICIT NONE + INTEGER INODE,LPOOL,N,SLAVEF,MYID,MIN_PROC + INTEGER POOL(LPOOL),KEEP(500),PROCNODE(KEEP(28)),STEP(N) + INTEGER(8) KEEP8(150) + LOGICAL SBTR_FLAG,PROC_FLAG + EXTERNAL MUMPS_167 + LOGICAL MUMPS_167 + INTEGER NODE_TO_EXTRACT,I,POS_TO_EXTRACT,NBTOP,NBINSUBTREE + NBTOP= POOL(LPOOL - 1) + NBINSUBTREE = POOL(LPOOL) + IF(NBTOP.GT.0)THEN + WRITE(*,*)MYID,': NBTOP=',NBTOP + ENDIF + SBTR_FLAG=.FALSE. + PROC_FLAG=.FALSE. + CALL SMUMPS_552(INODE,POOL,LPOOL,N,STEP,KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) + IF(SBTR_FLAG)THEN + RETURN + ENDIF + IF(MIN_PROC.EQ.-9999)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GT.0).AND.(INODE.LT.N))THEN +#endif + SBTR_FLAG=(NBINSUBTREE.NE.0) +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + RETURN + ENDIF + IF(.NOT.PROC_FLAG)THEN + NODE_TO_EXTRACT=INODE + IF((INODE.GE.0).AND.(INODE.LE.N))THEN + CALL SMUMPS_553(MIN_PROC,POOL, + & LPOOL,INODE) + IF(MUMPS_167(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + WRITE(*,*)MYID,': Extracting from a subtree + & for helping',MIN_PROC + SBTR_FLAG=.TRUE. + RETURN + ELSE + IF(NODE_TO_EXTRACT.NE.INODE)THEN + WRITE(*,*)MYID,': Extracting from top + & inode=',INODE,'for helping',MIN_PROC + ENDIF + CALL SMUMPS_819(INODE) + ENDIF + ENDIF + DO I=1,NBTOP + IF (POOL(LPOOL-2-I).EQ.INODE)THEN + GOTO 452 + ENDIF + ENDDO + 452 CONTINUE + POS_TO_EXTRACT=I + DO I=POS_TO_EXTRACT,NBTOP-1 + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDDO + POOL(LPOOL-2-NBTOP)=INODE + ENDIF + END SUBROUTINE SMUMPS_561 + SUBROUTINE SMUMPS_574 + & ( IPOOL, LPOOL, III, LEAF, + & INODE, STRATEGIE ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: STRATEGIE, LPOOL + INTEGER IPOOL (LPOOL) + INTEGER III,LEAF + INTEGER, INTENT(OUT) :: INODE + LEAF = LEAF - 1 + INODE = IPOOL( LEAF ) + RETURN + END SUBROUTINE SMUMPS_574 + SUBROUTINE SMUMPS_128(N, NELT, ELTPTR, ELTVAR, LIW, + & IKEEP, PTRAR, + & IORD, NFSIZ, FILS, FRERE, + & LISTVAR_SCHUR, SIZE_SCHUR, + & ICNTL, INFO, KEEP,KEEP8, + & ELTNOD, NSLAVES, + & XNODEL, NODEL) + IMPLICIT NONE + INTEGER N,NELT,LIW,IORD, SIZE_SCHUR, NSLAVES + INTEGER PTRAR(N,3), NFSIZ(N), FILS(N), FRERE(N) + INTEGER ELTPTR(NELT+1) + INTEGER XNODEL(N+1), NODEL(ELTPTR(NELT+1)-1) + INTEGER ELTVAR(ELTPTR(NELT+1)-1) + INTEGER IKEEP(N,3) + INTEGER LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER INFO(40), ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER ELTNOD(NELT) + INTEGER K,I,L1,L2,IWFR,NCMPA,LLIW,IFSON,IN + INTEGER NEMIN, MPRINT, LP, MP, LDIAG + INTEGER NZ, allocok, ITEMP + LOGICAL PROK, NOSUPERVAR + INTEGER(8) :: K79REF + PARAMETER(K79REF=12000000_8) + LOGICAL SPLITROOT + INTEGER, DIMENSION(:), ALLOCATABLE :: IW + INTEGER, DIMENSION(:), ALLOCATABLE :: IW2 + INTEGER OPT_METIS_SIZE, NUMFLAG + PARAMETER(OPT_METIS_SIZE = 8, NUMFLAG = 1) + INTEGER OPTIONS_METIS(OPT_METIS_SIZE) + INTEGER IDUM + EXTERNAL MUMPS_197, SMUMPS_130, SMUMPS_131, + & SMUMPS_129, SMUMPS_132, + & SMUMPS_133, SMUMPS_134, + & SMUMPS_199, + & SMUMPS_557, SMUMPS_201 +#if defined(OLDDFS) + EXTERNAL SMUMPS_200 +#endif + ALLOCATE( IW ( LIW ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = LIW + RETURN + ENDIF + MPRINT= ICNTL(3) + PROK = (MPRINT.GT.0) + LP = ICNTL(1) + MP = ICNTL(3) + LDIAG = ICNTL(4) + IF (KEEP(60).NE.0) THEN + NOSUPERVAR=.TRUE. + IF (IORD.GT.1) IORD = 0 + ELSE + NOSUPERVAR=.FALSE. + ENDIF + IF (IORD == 7) THEN + IF ( N < 10000 ) THEN + IORD = 0 + ELSE +#if defined(metis) || defined(parmetis) + IORD = 5 +#else + IORD = 0 +#endif + ENDIF + END IF +#if ! defined(metis) && ! defined(parmetis) + IF (IORD == 5) IORD = 0 +#endif + IF (KEEP(1).LT.1) KEEP(1) = 1 + NEMIN = KEEP(1) + IF (LDIAG.LE.2 .OR. MP.LE.0) GO TO 10 + WRITE (MP,99999) N, NELT, LIW, INFO(1) + K = min0(10,NELT+1) + IF (LDIAG.EQ.4) K = NELT+1 + IF (K.GT.0) WRITE (MP,99998) (ELTPTR(I),I=1,K) + K = min0(10,ELTPTR(NELT+1)-1) + IF (LDIAG.EQ.4) K = ELTPTR(NELT+1)-1 + IF (K.GT.0) WRITE (MP,99995) (ELTVAR(I),I=1,K) + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (IORD.EQ.1 .AND. K.GT.0) THEN + WRITE (MP,99997) (IKEEP(I,1),I=1,K) + ENDIF + 10 L1 = 1 + L2 = L1 + N + IF (LIW .LT. 3*N) THEN + INFO(1)= -2002 + INFO(2) = LIW + ENDIF +#if defined(metis) || defined(parmetis) + IF ( IORD == 5 ) THEN + IF (LIW .LT. N+N+1) THEN + INFO(1)= -2002 + INFO(2) = LIW + RETURN + ENDIF + ELSE +#endif + IF (NOSUPERVAR) THEN + IF ( LIW .LT. 2*N ) THEN + INFO(1)= -2002 + INFO(2) = LIW + RETURN + END IF + ELSE + IF ( LIW .LT. 4*N+4 ) THEN + INFO(1)= -2002 + INFO(2) = LIW + RETURN + END IF + ENDIF +#if defined(metis) || defined(parmetis) + ENDIF +#endif + IDUM=0 + CALL SMUMPS_258(NELT, N, ELTPTR(NELT+1)-1, ELTPTR, ELTVAR, + & XNODEL, NODEL, IW(L1), IDUM, ICNTL) + IF (IORD.NE.1 .AND. IORD .NE. 5) THEN + IORD = 0 + IF (NOSUPERVAR) THEN + CALL SMUMPS_129(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & PTRAR(1,2), IW(L1)) + ELSE + CALL SMUMPS_130(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & PTRAR(1,2), 4*N+4, IW(L1)) + ENDIF + LLIW = max(NZ,N) + ALLOCATE( IW2(LLIW), stat = allocok ) + IF (allocok.GT.0) THEN + INFO(1) = -7 + INFO(2) = LLIW + RETURN + ENDIF + IF (NOSUPERVAR) THEN + CALL SMUMPS_132(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IW2, LLIW, PTRAR, PTRAR(1,2), + & IW(L1), IWFR) + ELSE + CALL SMUMPS_131(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IW2, LLIW, PTRAR, PTRAR(1,2), + & IW(L1), IWFR) + ENDIF + IF (NOSUPERVAR) THEN + CALL MUMPS_162(N, LLIW, PTRAR, IWFR, PTRAR(1,2), IW2, + & IW(L1), IKEEP, + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), IW(L2), PTRAR(1,3), + & LISTVAR_SCHUR, SIZE_SCHUR) + IF (KEEP(60) == 1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSEIF (KEEP(60) == 2 .OR. KEEP(60) == 3 ) THEN + KEEP(38) = LISTVAR_SCHUR(1) + ELSE + WRITE(*,*) "Internal error in SMUMPS_128",KEEP(60) + CALL MUMPS_ABORT() + ENDIF + ELSE + CALL MUMPS_23(N, LLIW, PTRAR, IWFR, PTRAR(1,2), IW2, + & IW(L1), IKEEP, + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), IW(L2), PTRAR(1,3)) + ENDIF + ELSE +#if defined(metis) || defined(parmetis) + IF (IORD.EQ.5) THEN + IF (PROK) THEN + WRITE(MPRINT,'(A)') ' Ordering based on METIS ' + ENDIF + CALL SMUMPS_129(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & PTRAR(1,2), IW(L1)) + LLIW = max(NZ,N) + ALLOCATE( IW2(LLIW), stat = allocok ) + IF (allocok.GT.0) THEN + INFO(1) = -7 + INFO(2) = LLIW + RETURN + ENDIF + CALL SMUMPS_538(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IW2, LLIW, IW(L2), PTRAR(1,2), + & IW(L1), IWFR) + OPTIONS_METIS(1) = 0 + CALL METIS_NODEND(N, IW(L2), IW2(1), NUMFLAG, OPTIONS_METIS, + & IKEEP(1,2), IKEEP(1,1) ) + DEALLOCATE(IW2) + ELSE IF (IORD.NE.1) THEN + WRITE(*,*) IORD + WRITE(*,*) 'bad option for ordering' + CALL MUMPS_ABORT() + ENDIF +#endif + DO K=1,N + IW(L1+K) = 0 + ENDDO + DO K=1,N + IF ((IKEEP(K,1).LE.0).OR.(IKEEP(K,1).GT.N)) + & GO TO 40 + IF (IW(L1+IKEEP(K,1)).EQ.1) THEN + GOTO 40 + ELSE + IW(L1+IKEEP(K,1)) = 1 + ENDIF + ENDDO + CALL SMUMPS_133(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IKEEP, PTRAR(1,2), IW(L1)) + LLIW = NZ+N + ALLOCATE( IW2(LLIW), stat = allocok ) + IF (allocok.GT.0) THEN + INFO(1) = -7 + INFO(2) = LLIW + RETURN + ENDIF + CALL SMUMPS_134(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IKEEP, IW2, LLIW, PTRAR, PTRAR(1,2), + & IW(L1), IWFR) + IF (KEEP(60) == 0) THEN + ITEMP = 0 + ELSE + ITEMP = SIZE_SCHUR + IF (KEEP(60) == 1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSEIF (KEEP(60) == 2 .OR. KEEP(60) == 3 ) THEN + KEEP(38) = LISTVAR_SCHUR(1) + ELSE + WRITE(*,*) "Internal error in SMUMPS_128",KEEP(60) + CALL MUMPS_ABORT() + ENDIF + ENDIF + CALL SMUMPS_199(N, PTRAR, IW2, LLIW, IWFR, IKEEP, + & IKEEP(1,2), IW(L1), + & IW(L2), NCMPA, ITEMP) + ENDIF +#if defined(OLDDFS) + CALL SMUMPS_200(N, PTRAR, IW(L1), IKEEP, IKEEP(1,2), + & IKEEP(1,3), + & NFSIZ, INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, KEEP(60)) +#else + CALL SMUMPS_557(N, PTRAR, IW(L1), IKEEP, IKEEP(1,2), + & IKEEP(1,3), + & NFSIZ, PTRAR(1,2), + & INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, + & IW(L2), KEEP(60), KEEP(20), KEEP(38), + & IW2,KEEP(104),IW(L2+N),KEEP(50), + & ICNTL(13), KEEP(37), NSLAVES, KEEP(250).EQ.1) +#endif + DEALLOCATE(IW2) + IF (KEEP(60).NE.0) THEN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO WHILE (IN.GT.0) + IN = FILS (IN) + END DO + IFSON = -IN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO I=2,SIZE_SCHUR + FILS(IN) = LISTVAR_SCHUR (I) + IN = FILS(IN) + FRERE (IN) = N+1 + ENDDO + FILS(IN) = -IFSON + ENDIF + CALL SMUMPS_201(IKEEP(1,2), + & PTRAR(1,3), INFO(6), + & INFO(5), KEEP(2),KEEP(50), + & KEEP(101), KEEP(108),KEEP(5), + & KEEP(6), KEEP(226), KEEP(253)) + IF ( KEEP(53) .NE. 0 ) THEN + CALL MUMPS_209( N, FRERE, FILS, NFSIZ, KEEP(20) ) + END IF + IF ( KEEP(48) == 4 .OR. + & ( (KEEP(24).NE.0).AND.(KEEP8(21).GT.0_8) ) ) THEN + CALL SMUMPS_510(KEEP8(21), KEEP(2), + & KEEP(48), KEEP(50), NSLAVES) + END IF + IF (KEEP(210).LT.0.OR.KEEP(210).GT.2) KEEP(210)=0 + IF (KEEP(210).EQ.0.AND.KEEP(201).GT.0) KEEP(210)=1 + IF (KEEP(210).EQ.0.AND.KEEP(201).EQ.0) KEEP(210)=2 + IF (KEEP(210).EQ.2) KEEP8(79)=huge(KEEP8(79)) + IF (KEEP(210).EQ.1.AND.KEEP8(79).LE.0_8) THEN + IF ( huge(KEEP8(79)) / K79REF + 1_8 .GE. int(NSLAVES,8) ) THEN + KEEP8(79)=huge(KEEP8(79)) + ELSE + KEEP8(79)=K79REF * int(NSLAVES,8) + ENDIF + ENDIF + IF (KEEP(79).EQ.0) THEN + IF (KEEP(210).EQ.1) THEN + SPLITROOT = .FALSE. + IF ( KEEP(62).GE.1) THEN + CALL SMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG, INFO(1), INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + ENDIF + ENDIF + SPLITROOT = ((ICNTL(13).GT.0) .AND. (NSLAVES.GE.ICNTL(13))) + IF (SPLITROOT) THEN + CALL SMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG, INFO(1), INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (K.GT.0) WRITE (MP,99997) (IKEEP(I,1),I=1,K) + IF (K.GT.0) WRITE (MP,99991) (IKEEP(I,2),I=1,K) + IF (K.GT.0) WRITE (MP,99990) (IKEEP(I,3),I=1,K) + IF (K.GT.0) WRITE (MP,99987) (NFSIZ(I),I=1,K) + IF (K.GT.0) WRITE (MP,99989) (FILS(I),I=1,K) + IF (K.GT.0) WRITE (MP,99988) (FRERE(I),I=1,K) + ENDIF + GO TO 90 + 40 INFO(1) = -4 + INFO(2) = K + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99996) INFO(1) + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99982) INFO(2) + 90 CONTINUE + DEALLOCATE(IW) + RETURN +99999 FORMAT (/'Entering analysis phase with ...'/ + & ' N NELT LIW INFO(1)'/, + & 9X, I8, I11, I12, I14) +99998 FORMAT ('Element pointers: ELTPTR() '/(9X, 7I10)) +99995 FORMAT ('Element variables: ELTVAR() '/(9X, 7I10)) +99997 FORMAT ('IKEEP(.,1)=', 10I6/(12X, 10I6)) +99996 FORMAT (/'** Error return ** from Analysis * INFO(1)=', I3) +99991 FORMAT ('IKEEP(.,2)=', 10I6/(12X, 10I6)) +99990 FORMAT ('IKEEP(.,3)=', 10I6/(12X, 10I6)) +99989 FORMAT ('FILS (.) =', 10I6/(12X, 10I6)) +99988 FORMAT ('FRERE(.) =', 10I6/(12X, 10I6)) +99987 FORMAT ('NFSIZ(.) =', 10I6/(12X, 10I6)) +99982 FORMAT ('Error in permutation array KEEP INFO(2)=', I3) + END SUBROUTINE SMUMPS_128 + SUBROUTINE SMUMPS_258( NELT, N, NELNOD, XELNOD, ELNOD, + & XNODEL, NODEL, FLAG, IERROR, ICNTL ) + IMPLICIT NONE + INTEGER NELT, N, NELNOD, IERROR, ICNTL(40) + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & FLAG(N) + INTEGER I, J, K, MP, NBERR + MP = ICNTL(2) + FLAG(1:N) = 0 + XNODEL(1:N) = 0 + IERROR = 0 + DO I = 1, NELT + DO K = XELNOD(I), XELNOD(I+1)-1 + J = ELNOD(K) + IF ( J.LT.1 .OR. J.GT.N ) THEN + IERROR = IERROR + 1 + ELSE + IF ( FLAG(J).NE.I ) THEN + XNODEL(J) = XNODEL(J) + 1 + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + IF ( IERROR.GT.0 .AND. MP.GT.0 .AND. ICNTL(4).GE.2 ) THEN + NBERR = 0 + WRITE(MP,99999) + DO I = 1, NELT + DO K = XELNOD(I), XELNOD(I+1)-1 + J = ELNOD(K) + IF ( J.LT.1 .OR. J.GT.N ) THEN + NBERR = NBERR + 1 + IF (NBERR.LE.10) THEN + WRITE(MP,'(A,I8,A,I8,A)') + & 'Element ',I,' variable ',J,' ignored.' + ELSE + GO TO 100 + ENDIF + ENDIF + ENDDO + ENDDO + ENDIF + 100 CONTINUE + K = 1 + DO I = 1, N + K = K + XNODEL(I) + XNODEL(I) = K + ENDDO + XNODEL(N+1) = XNODEL(N) + FLAG(1:N) = 0 + DO I = 1, NELT + DO K = XELNOD(I), XELNOD(I+1)-1 + J = ELNOD(K) + IF (FLAG(J).NE.I) THEN + XNODEL(J) = XNODEL(J) - 1 + NODEL(XNODEL(J)) = I + FLAG(J) = I + ENDIF + ENDDO + ENDDO + RETURN +99999 FORMAT (/'*** Warning message from subroutine SMUMPS_258 ***') + END SUBROUTINE SMUMPS_258 + SUBROUTINE SMUMPS_129(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & LEN, FLAG) + IMPLICIT NONE + INTEGER N, NELT, NELNOD, NZ + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & FLAG(N) + INTEGER I,J,K1,K2,K3 + FLAG(1:N) = 0 + LEN(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.LT.J) .AND. (FLAG(J).NE.I)) THEN + LEN(I) = LEN(I) + 1 + LEN(J) = LEN(J) + 1 + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + NZ = 0 + DO I = 1,N + NZ = NZ + LEN(I) + ENDDO + RETURN + END SUBROUTINE SMUMPS_129 + SUBROUTINE SMUMPS_538(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER LEN(N) + INTEGER IPE(N+1) + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW), FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 1 + DO I = 1,N + IWFR = IWFR + LEN(I) + IPE(I) = IWFR + ENDDO + IPE(N+1)=IPE(N) + FLAG(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.LT.J) .AND. (FLAG(J).NE.I)) THEN + IPE(I) = IPE(I) - 1 + IW(IPE(I)) = J + IPE(J) = IPE(J) - 1 + IW(IPE(J)) = I + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE SMUMPS_538 + SUBROUTINE SMUMPS_132(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER LEN(N) + INTEGER IPE(N) + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW), FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 1 + DO I = 1,N + IWFR = IWFR + LEN(I) + IF (LEN(I).GT.0) THEN + IPE(I) = IWFR + ELSE + IPE(I) = 0 + ENDIF + ENDDO + FLAG(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.LT.J) .AND. (FLAG(J).NE.I)) THEN + IPE(I) = IPE(I) - 1 + IW(IPE(I)) = J + IPE(J) = IPE(J) - 1 + IW(IPE(J)) = I + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE SMUMPS_132 + SUBROUTINE SMUMPS_133(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & PERM, LEN, FLAG) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER PERM(N) + INTEGER LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), FLAG(N) + INTEGER I,J,K1,K2,K3 + FLAG(1:N) = 0 + LEN(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I),XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2),XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.NE.J) .AND. (FLAG(J).NE.I)) THEN + IF (PERM(J).GT.PERM(I)) THEN + LEN(I) = LEN(I) + 1 + FLAG(J) = I + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + NZ = 0 + DO I = 1,N + NZ = NZ + LEN(I) + ENDDO + RETURN + END SUBROUTINE SMUMPS_133 + SUBROUTINE SMUMPS_134(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & PERM, IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER PERM(N) + INTEGER IPE(N), LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), IW(LW), + & FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 0 + DO I = 1,N + IWFR = IWFR + LEN(I) + 1 + IPE(I) = IWFR + ENDDO + IWFR = IWFR + 1 + FLAG(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I),XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2),XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.NE.J) .AND. (FLAG(J).NE.I)) THEN + IF (PERM(J).GT.PERM(I)) THEN + IW(IPE(I)) = J + IPE(I) = IPE(I) - 1 + FLAG(J) = I + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + DO I = 1,N + J = IPE(I) + IW(J) = LEN(I) + IF (LEN(I).EQ.0) IPE(I) = 0 + ENDDO + RETURN + END SUBROUTINE SMUMPS_134 + SUBROUTINE SMUMPS_25( MYID, SLAVEF, N, + & PROCNODE, STEP, PTRAIW, PTRARW, + & NELT, FRTPTR, FRTELT, + & KEEP,KEEP8, ICNTL, SYM ) + IMPLICIT NONE + INTEGER MYID, SLAVEF, N, NELT, SYM + INTEGER KEEP( 500 ), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER PTRAIW( NELT+1 ), PTRARW( NELT+1 ) + INTEGER STEP( N ) + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER PROCNODE( KEEP(28) ) + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER ELT, I, K, IPTRI, IPTRR, NVAR + INTEGER TYPE_PARALL, ITYPE, IRANK + TYPE_PARALL = KEEP(46) + PTRAIW( 1:NELT ) = 0 + DO I = 1, N + IF (STEP(I).LT.0) CYCLE + ITYPE = MUMPS_330( PROCNODE(abs(STEP(I))), SLAVEF ) + IRANK = MUMPS_275( PROCNODE(abs(STEP(I))), SLAVEF ) + IF ( TYPE_PARALL .eq. 0 ) THEN + IRANK = IRANK + 1 + END IF + IF ( (ITYPE .EQ. 2) .OR. + & (ITYPE .EQ. 1 .AND. IRANK .EQ. MYID) ) THEN + DO K = FRTPTR(I),FRTPTR(I+1)-1 + ELT = FRTELT(K) + PTRAIW( ELT ) = PTRARW(ELT+1) - PTRARW(ELT) + ENDDO + ELSE + END IF + END DO + IPTRI = 1 + DO ELT = 1,NELT + NVAR = PTRAIW( ELT ) + PTRAIW( ELT ) = IPTRI + IPTRI = IPTRI + NVAR + ENDDO + PTRAIW( NELT+1 ) = IPTRI + KEEP( 14 ) = IPTRI - 1 + IF ( .TRUE. ) THEN + IF (SYM .EQ. 0) THEN + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRAIW( ELT+1 ) - PTRAIW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + NVAR*NVAR + ENDDO + PTRARW( NELT+1 ) = IPTRR + ELSE + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRAIW( ELT+1 ) - PTRAIW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + (NVAR*(NVAR+1))/2 + ENDDO + PTRARW( NELT+1 ) = IPTRR + ENDIF + ELSE + IF (SYM .EQ. 0) THEN + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRARW( ELT+1 ) - PTRARW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + NVAR*NVAR + ENDDO + PTRARW( NELT+1 ) = IPTRR + ELSE + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRARW( ELT+1 ) - PTRARW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + (NVAR*(NVAR+1))/2 + ENDDO + PTRARW( NELT+1 ) = IPTRR + ENDIF + ENDIF + KEEP( 13 ) = IPTRR - 1 + RETURN + END SUBROUTINE SMUMPS_25 + SUBROUTINE SMUMPS_120( N, NELT, ELTPROC, SLAVEF, PROCNODE ) + IMPLICIT NONE + INTEGER N, NELT, SLAVEF + INTEGER PROCNODE( N ), ELTPROC( NELT ) + INTEGER ELT, I, ITYPE, MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + DO ELT = 1, NELT + I = ELTPROC(ELT) + IF ( I .NE. 0) THEN + ITYPE = MUMPS_330(PROCNODE(I),SLAVEF) + IF (ITYPE.EQ.1) THEN + ELTPROC(ELT) = MUMPS_275(PROCNODE(I),SLAVEF) + ELSE IF (ITYPE.EQ.2) THEN + ELTPROC(ELT) = -1 + ELSE + ELTPROC(ELT) = -2 + ENDIF + ELSE + ELTPROC(ELT) = -3 + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_120 + SUBROUTINE SMUMPS_153(N, NELT, NELNOD, FRERE, FILS, NA, NE, + & XNODEL, NODEL, FRTPTR, FRTELT, ELTNOD) + IMPLICIT NONE + INTEGER N, NELT, NELNOD + INTEGER FRERE(N), FILS(N), NA(N), NE(N) + INTEGER FRTPTR(N+1), FRTELT(NELT), ELTNOD(NELT) + INTEGER XNODEL(N+1), NODEL(NELNOD) + INTEGER TNSTK( N ), IPOOL( N ) + INTEGER I, K, IFATH + INTEGER INODE, LEAF, NBLEAF, NBROOT, III, IN + TNSTK = NE + LEAF = 1 + IF (N.EQ.1) THEN + NBROOT = 1 + NBLEAF = 1 + IPOOL(1) = 1 + LEAF = LEAF + 1 + ELSEIF (NA(N).LT.0) THEN + NBLEAF = N + NBROOT = N + DO 20 I=1,NBLEAF-1 + INODE = NA(I) + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + 20 CONTINUE + INODE = -NA(N)-1 + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + ELSEIF (NA(N-1).LT.0) THEN + NBLEAF = N-1 + NBROOT = NA(N) + IF (NBLEAF-1.GT.0) THEN + DO 30 I=1,NBLEAF-1 + INODE = NA(I) + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + 30 CONTINUE + ENDIF + INODE = -NA(N-1)-1 + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + ELSE + NBLEAF = NA(N-1) + NBROOT = NA(N) + DO 40 I = 1,NBLEAF + INODE = NA(I) + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + 40 CONTINUE + ENDIF + ELTNOD(1:NELT) = 0 + III = 1 + 90 CONTINUE + IF (III.NE.LEAF) THEN + INODE=IPOOL(III) + III = III + 1 + ELSE + WRITE(6,*) ' ERROR 1 in file SMUMPS_153 ' + CALL MUMPS_ABORT() + ENDIF + 95 CONTINUE + IN = INODE + 100 CONTINUE + DO K = XNODEL(IN),XNODEL(IN+1)-1 + I = NODEL(K) + IF (ELTNOD(I).EQ.0) ELTNOD(I) = INODE + ENDDO + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 100 + IN = INODE + 110 IN = FRERE(IN) + IF (IN.GT.0) GO TO 110 + IF (IN.EQ.0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 115 + GOTO 90 + ELSE + IFATH = -IN + ENDIF + TNSTK(IFATH) = TNSTK(IFATH) - 1 + IF ( TNSTK(IFATH) .EQ. 0 ) THEN + INODE = IFATH + GOTO 95 + ELSE + GOTO 90 + ENDIF + 115 CONTINUE + FRTPTR(1:N) = 0 + DO I = 1,NELT + IF (ELTNOD(I) .NE. 0) THEN + FRTPTR(ELTNOD(I)) = FRTPTR(ELTNOD(I)) + 1 + ENDIF + ENDDO + K = 1 + DO I = 1,N + K = K + FRTPTR(I) + FRTPTR(I) = K + ENDDO + FRTPTR(N+1) = FRTPTR(N) + DO K = 1,NELT + INODE = ELTNOD(K) + IF (INODE .NE. 0) THEN + FRTPTR(INODE) = FRTPTR(INODE) - 1 + FRTELT(FRTPTR(INODE)) = K + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_153 + SUBROUTINE SMUMPS_130(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & LEN, LW, IW) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW) + INTEGER I,J,K1,K2,K3,LP,NSUP,SUPVAR + INTEGER INFO44(6) + EXTERNAL SMUMPS_315 + LP = 6 + CALL SMUMPS_315(N,NELT,XELNOD(NELT+1)-1,ELNOD,XELNOD, + & NSUP,IW(3*N+3+1),3*N+3,IW,LP,INFO44) + IF (INFO44(1) .LT. 0) THEN + IF (LP.GE.0) WRITE(LP,*) + & 'Error return from SMUMPS_315. INFO(1) = ',INFO44(1) + ENDIF + IW(1:NSUP) = 0 + LEN(1:N) = 0 + DO I = 1,N + SUPVAR = IW(3*N+3+1+I) + IF (SUPVAR .EQ. 0) CYCLE + IF (IW(SUPVAR).NE.0) THEN + LEN(I) = -IW(SUPVAR) + ELSE + IW(SUPVAR) = I + ENDIF + ENDDO + IW(N+1:2*N) = 0 + NZ = 0 + DO SUPVAR = 1,NSUP + I = IW(SUPVAR) + DO K1 = XNODEL(I),XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2),XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF (LEN(J).GE.0) THEN + IF ((I.NE.J) .AND. (IW(N+J).NE.I)) THEN + IW(N+J) = I + LEN(I) = LEN(I) + 1 + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + NZ = NZ + LEN(I) + ENDDO + RETURN + END SUBROUTINE SMUMPS_130 + SUBROUTINE SMUMPS_131(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER LEN(N) + INTEGER IPE(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW), FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 1 + DO I = 1,N + IF (LEN(I).GT.0) THEN + IWFR = IWFR + LEN(I) + IPE(I) = IWFR + ELSE + IPE(I) = 0 + ENDIF + ENDDO + FLAG(1:N) = 0 + DO I = 1,N + IF (LEN(I).LE.0) CYCLE + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF (LEN(J) .GT. 0) THEN + IF ((I.NE.J) .AND. (FLAG(J).NE.I)) THEN + IPE(I) = IPE(I) - 1 + IW(IPE(I)) = J + FLAG(J) = I + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE SMUMPS_131 + SUBROUTINE SMUMPS_315(N,NELT,NZ,ELTVAR,ELTPTR,NSUP,SVAR, + & LIW,IW,LP,INFO) + INTEGER LIW,LP,N,NELT,NSUP,NZ + INTEGER INFO(6) + INTEGER ELTPTR(NELT+1),ELTVAR(NZ) + INTEGER IW(LIW),SVAR(0:N) + INTEGER FLAG,NEW,VARS + EXTERNAL SMUMPS_316 + INFO(1) = 0 + INFO(2) = 0 + INFO(3) = 0 + INFO(4) = 0 + IF (N.LT.1) GO TO 10 + IF (NELT.LT.1) GO TO 20 + IF (NZ.LT.ELTPTR(NELT+1)-1) GO TO 30 + IF (LIW.LT.6) THEN + INFO(4) = 3*N + 3 + GO TO 40 + END IF + NEW = 1 + VARS = NEW + LIW/3 + FLAG = VARS + LIW/3 + CALL SMUMPS_316(N,NELT,ELTPTR,NZ,ELTVAR,SVAR,NSUP,LIW/3-1, + & IW(NEW),IW(VARS),IW(FLAG),INFO) + IF (INFO(1).EQ.-4) THEN + INFO(4) = 3*N + 3 + GO TO 40 + ELSE + INFO(4) = 3*NSUP + 3 + END IF + GO TO 50 + 10 INFO(1) = -1 + IF (LP.GT.0) WRITE (LP,FMT=9000) INFO(1) + GO TO 50 + 20 INFO(1) = -2 + IF (LP.GT.0) WRITE (LP,FMT=9000) INFO(1) + GO TO 50 + 30 INFO(1) = -3 + IF (LP.GT.0) WRITE (LP,FMT=9000) INFO(1) + GO TO 50 + 40 INFO(1) = -4 + IF (LP.GT.0) THEN + WRITE (LP,FMT=9000) INFO(1) + WRITE (LP,FMT=9010) INFO(4) + END IF + 50 RETURN + 9000 FORMAT (/3X,'Error message from SMUMPS_315: INFO(1) = ',I2) + 9010 FORMAT (3X,'LIW is insufficient. Upper bound on required work', + & 'space is ',I8) + END SUBROUTINE SMUMPS_315 + SUBROUTINE SMUMPS_316( N, NELT, ELTPTR, NZ, ELTVAR, + & SVAR, NSUP, MAXSUP, NEW, VARS, FLAG, INFO ) + INTEGER MAXSUP,N,NELT,NSUP,NZ + INTEGER ELTPTR(NELT+1),ELTVAR(NZ) + INTEGER INFO(6) + INTEGER FLAG(0:MAXSUP), NEW(0:MAXSUP),SVAR(0:N), + & VARS(0:MAXSUP) + INTEGER I,IS,J,JS,K,K1,K2 + DO 10 I = 0,N + SVAR(I) = 0 + 10 CONTINUE + VARS(0) = N + 1 + NEW(0) = -1 + FLAG(0) = 0 + NSUP = 0 + DO 40 J = 1,NELT + K1 = ELTPTR(J) + K2 = ELTPTR(J+1) - 1 + DO 20 K = K1,K2 + I = ELTVAR(K) + IF (I.LT.1 .OR. I.GT.N) THEN + INFO(2) = INFO(2) + 1 + GO TO 20 + END IF + IS = SVAR(I) + IF (IS.LT.0) THEN + ELTVAR(K) = 0 + INFO(3) = INFO(3) + 1 + GO TO 20 + END IF + SVAR(I) = SVAR(I) - N - 2 + VARS(IS) = VARS(IS) - 1 + 20 CONTINUE + DO 30 K = K1,K2 + I = ELTVAR(K) + IF (I.LT.1 .OR. I.GT.N) GO TO 30 + IS = SVAR(I) + N + 2 + IF (FLAG(IS).LT.J) THEN + FLAG(IS) = J + IF (VARS(IS).GT.0) THEN + NSUP = NSUP + 1 + IF (NSUP.GT.MAXSUP) THEN + INFO(1) = -4 + RETURN + END IF + VARS(NSUP) = 1 + FLAG(NSUP) = J + NEW(IS) = NSUP + SVAR(I) = NSUP + ELSE + VARS(IS) = 1 + NEW(IS) = IS + SVAR(I) = IS + END IF + ELSE + JS = NEW(IS) + VARS(JS) = VARS(JS) + 1 + SVAR(I) = JS + END IF + 30 CONTINUE + 40 CONTINUE + RETURN + END SUBROUTINE SMUMPS_316 + SUBROUTINE SMUMPS_36( COMM_LOAD, ASS_IRECV, + & NELT, FRT_PTR, FRT_ELT, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, + & FILS, FRERE, DAD, MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER,PTRARW, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & + & NSTK_S,NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE SMUMPS_COMM_BUFFER + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mpif.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER IZERO + PARAMETER (IZERO=0) + INTEGER NELT,N,LIW,NSTEPS + INTEGER(8) LA, LRLU, LRLUS, IPTRLU, POSFAC + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & IWPOS, IWPOSCB, COMP + INTEGER IDUMMY(1) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(NELT+1), PTRAIW(NELT+1), ND(KEEP(28)), PERM(N), + & FILS(N), FRERE(KEEP(28)), DAD(KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)), + & PAMASTER(KEEP(28)) + INTEGER COMM, NBFIN, SLAVEF, MYID + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + LOGICAL SON_LEVEL2 + REAL A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER FRT_PTR(N+1), FRT_ELT(NELT) + INTEGER INTARR(max(1,KEEP(14))) + REAL DBLARR(max(1,KEEP(13))) + INTEGER LPOOL, LEAF + INTEGER LBUFR, LBUFR_BYTES + INTEGER IPOOL( LPOOL ) + INTEGER NBPROCFILS(KEEP(28)), NSTK_S(KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER BUFR( LBUFR ) + INTEGER ETATASS + INCLUDE 'mumps_headers.h' + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + INTEGER LP, HS, HF + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + INTEGER NFS4FATHER + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER(8) NFRONT8 + INTEGER(8) LAELL8, APOS, APOS2, LAPOS2 + INTEGER(8) POSELT, POSEL1, ICT12, ICT21 + INTEGER(8) IACHK + INTEGER(8) JJ2 + INTEGER(8) LSTK8, SIZFR8 +#if defined(ALLOW_NON_INIT) + INTEGER(8) :: JJ8 +#endif + INTEGER NBPANELS_L, NBPANELS_U, LREQ_OOC + INTEGER SIZFI, NCB + INTEGER JJ,J1,J2 + INTEGER NCOLS, NROWS, LDA_SON + INTEGER NELIM,JJ1,J3, + & IORG, IBROT + INTEGER JPOS,ICT11, IJROW + INTEGER Pos_First_NUMORG,NUMORG,IOLDPS, + & NUMELT, ELBEG + INTEGER AINPUT, + & AII, J + INTEGER NSLAVES, NSLSON, NPIVS, NPIV_ANA, NPIV + INTEGER PTRCOL, ISLAVE, PDEST,LEVEL + LOGICAL LEVEL1, NIV1 + INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX + INTEGER ELTI, SIZE_ELTI + INTEGER II, I + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER NCBSON + LOGICAL SAME_PROC + INTRINSIC real + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + LOGICAL MUMPS_167, SSARBR + EXTERNAL MUMPS_167 + DOUBLE PRECISION FLOP1,FLOP1_EFF + EXTERNAL MUMPS_170 + LOGICAL MUMPS_170 + NFS4FATHER = -1 + ETATASS = 0 + COMPRESSCB=.FALSE. + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + LEVEL = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (LEVEL.NE.1) THEN + write(6,*) 'Error1 in mpi51f_niv1 ' + CALL MUMPS_ABORT() + END IF + NSLAVES = 0 + HF = 6 + NSLAVES + KEEP(IXSZ) + NUMELT = FRT_PTR(INODE+1) - FRT_PTR(INODE) + IF ( NUMELT .ne. 0 ) THEN + ELBEG = FRT_PTR(INODE) + ELSE + ELBEG = 1 + END IF + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + END DO + NPIV_ANA=NUMORG + NSTEPS = NSTEPS + 1 + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + END DO + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + NASS1 = NASS + NUMORG + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL SMUMPS_684(KEEP(50), NFRONT, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL SMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + END IF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + END IF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + NIV1 = .TRUE. + IF (KEEP(50).EQ.0) THEN + CALL MUMPS_124( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, NFRONT, NFRONT_EFF, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, + & SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG ) + ELSE + CALL MUMPS_125( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, + & SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + IF (IFLAG.LT.0) GOTO 300 + END IF + IF (NFRONT_EFF.NE.NFRONT) THEN + IF (NFRONT.GT.NFRONT_EFF) THEN + IF(MUMPS_170(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF))THEN + NPIV=NASS1-(NFRONT_EFF-ND(STEP(INODE))) + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1) + NPIV=NPIV_ANA + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1_EFF) + CALL SMUMPS_190(0,.FALSE.,FLOP1-FLOP1_EFF, + & KEEP,KEEP8) + ENDIF + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) ' ERROR 1 during ass_niv1_ELT' + GOTO 270 + ENDIF + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL SMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + NCB = NFRONT - NASS1 + MAXFRW = max0(MAXFRW, NFRONT) + ICT11 = IOLDPS + HF - 1 + NFRONT + NFRONT8=int(NFRONT,8) + LAELL8 = NFRONT8*NFRONT8 + IF (LRLU .LT. LAELL8) THEN + IF (LRLUS .LT. LAELL8) THEN + GOTO 280 + ELSE + CALL SMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + END IF + END IF + END IF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + POSFAC = POSFAC + LAELL8 + SSARBR=MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + CALL SMUMPS_471(SSARBR,.FALSE.,LA-LRLUS,0_8,LAELL8, + & KEEP,KEEP8, + & LRLU) +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. NFRONT .LT. KEEP(63) ) THEN + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO + ELSE + APOS = POSELT + DO JJ8 = 0_8, int(NFRONT -1,8) + A(APOS:APOS+JJ8) = ZERO + APOS = APOS + NFRONT8 + END DO + END IF +#endif + NASS = NASS1 + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + IW(IOLDPS+KEEP(IXSZ)) = NFRONT + IW(IOLDPS+KEEP(IXSZ)+ 1) = 0 + IW(IOLDPS+KEEP(IXSZ) + 2) = -NASS1 + IW(IOLDPS+KEEP(IXSZ) + 3) = -NASS1 + IW(IOLDPS+KEEP(IXSZ) + 4) = STEP(INODE) + IW(IOLDPS+KEEP(IXSZ)+5) = NSLAVES + IF (NUMSTK.NE.0) THEN + ISON = IFSON + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + LSTK8 = int(LSTK,8) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB = + & ( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB = ( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + LEVEL1 = NSLSON.EQ.0 + IF (.NOT.SAME_PROC) THEN + NROWS = IW( ISTCHK + 2+KEEP(IXSZ)) + ELSE + NROWS = NCOLS + ENDIF + SIZFI = HS + NROWS + NCOLS + J1 = ISTCHK + HS + NROWS + NPIVS + IF ( .NOT. LEVEL1 .AND. NELIM.EQ.0 ) GOTO 205 + IF (LEVEL1) THEN + J2 = J1 + LSTK - 1 + IF (COMPRESSCB) THEN + SIZFR8 = (LSTK8*(LSTK8+1_8)/2_8) + ELSE + SIZFR8 = LSTK8*LSTK8 + ENDIF + ELSE + IF ( KEEP(50).eq.0 ) THEN + SIZFR8 = int(NELIM,8) * LSTK8 + ELSE + SIZFR8 = int(NELIM,8) * int(NELIM,8) + END IF + J2 = J1 + NELIM - 1 + ENDIF + OPASSW = OPASSW + dble(SIZFR8) + IACHK = PAMASTER(STEP(ISON)) + IF ( KEEP(50) .eq. 0 ) THEN + POSEL1 = PTRAST(STEP(INODE)) - NFRONT8 + IF (J2.GE.J1) THEN + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * NFRONT8 + DO 160 JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8)) + 160 CONTINUE + IACHK = IACHK + LSTK8 + 170 CONTINUE + END IF + ELSE + IF (LEVEL1) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = SIZFR8 + ELSE + LCB = int(LDA_SON,8)*int(J2 - J1 + 1,8) + ENDIF + CALL SMUMPS_178(A, LA, + & PTRAST(STEP( INODE )), NFRONT, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), J2 - J1 + 1, NELIM, ETATASS, + & COMPRESSCB, + & .FALSE. + & ) + ENDIF + 205 IF (LEVEL1) THEN + IF (SAME_PROC) ISTCHK = PTRIST(STEP(ISON)) + IF (SAME_PROC) THEN + IF (KEEP(50).NE.0) THEN + J2 = J1 + LSTK - 1 + DO JJ = J1, J2 + IW(JJ) = IW(JJ - NROWS) + END DO + ELSE + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM + DO JJ = J3, J2 + IW(JJ) = IW(JJ - NROWS) + END DO + IF (NELIM .NE. 0) THEN + J3 = J3 - 1 + DO JJ = J1, J3 + JPOS = IW(JJ) + ICT11 + IW(JJ) = IW(JPOS) + END DO + ENDIF + ENDIF + ENDIF + IF ( SAME_PROC ) THEN + PTRIST(STEP( ISON )) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL SMUMPS_152(SSARBR, MYID, N, ISTCHK, + & IACHK, + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + ELSE + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL SMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, IDUMMY, + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, + & LEAF, NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + END DO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL SMUMPS_71( INODE, NFRONT, + & NASS1, NFS4FATHER,ISON, MYID, + & IZERO, IDUMMY, IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, + & SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + 220 CONTINUE + END IF + DO IELL=ELBEG,ELBEG+NUMELT-1 + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + AII = PTRARW(ELTI) + SIZE_ELTI = J2 - J1 + 1 + DO II=J1,J2 + I = INTARR(II) + IF (KEEP(50).EQ.0) THEN + AINPUT = AII + II - J1 + ICT12 = POSELT + int(I-1,8) * NFRONT8 + DO JJ=J1,J2 + APOS2 = ICT12 + int(INTARR(JJ) - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + SIZE_ELTI + END DO + ELSE + ICT12 = POSELT + int(- NFRONT + I - 1,8) + ICT21 = POSELT + int(I-1,8)*NFRONT8 - 1_8 + DO JJ=II,J2 + J = INTARR(JJ) + IF (I.LT.J) THEN + APOS2 = ICT12 + int(J,8)*NFRONT8 + ELSE + APOS2 = ICT21 + int(J,8) + ENDIF + A(APOS2) = A(APOS2) + DBLARR(AII) + AII = AII + 1 + END DO + END IF + END DO + END DO + IF (KEEP(253).GT.0) THEN + POSELT = PTRAST(STEP(INODE)) + IBROT = INODE + IJROW = Pos_First_NUMORG + DO IORG = 1, NUMORG + IF (KEEP(50).EQ.0) THEN + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(IJROW-1,8) * NFRONT8 + + & int(NFRONT-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ELSE + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(NFRONT-KEEP(253)+JJ-1,8) * NFRONT8 + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + IJROW = IJROW+1 + ENDDO + ENDIF + GOTO 500 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER ALLOCATION DURING SMUMPS_36' + ENDIF + GOTO 490 + 280 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, WORKSPACE TOO SMALL DURING SMUMPS_36' + ENDIF + IFLAG = -9 + CALL MUMPS_731(LAELL8-LRLUS, IERROR) + GOTO 500 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, SEND BUFFER TOO SMALL DURING SMUMPS_36' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, RECV BUFFER TOO SMALL DURING SMUMPS_36' + ENDIF + IFLAG = -20 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE IN INTEGER', + & ' DYNAMIC ALLOCATION DURING SMUMPS_36' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 490 CALL SMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE SMUMPS_36 + SUBROUTINE SMUMPS_37( COMM_LOAD, ASS_IRECV, + & NELT, FRT_PTR, FRT_ELT, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, FILS, FRERE, DAD, + & CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_S, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, LEAF, IPOOL, LPOOL, + & PERM, + & MEM_DISTRIB) + USE SMUMPS_COMM_BUFFER + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER NELT, N,LIW,NSTEPS, NBFIN + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER(8) LRLU, IPTRLU, LRLUS, POSFAC, LA + INTEGER(8) LAELL8 + INTEGER JJ + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & LPOOL, LEAF, + & IWPOS, + & IWPOSCB, COMP, SLAVEF + INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB + INTEGER IPOOL(LPOOL) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(NELT+1), PTRAIW(NELT+1), ND(KEEP(28)), + & FILS(N), FRERE(KEEP(28)), STEP(N), DAD (KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), PERM(N) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRFAC(KEEP(28)), PAMASTER(KEEP(28)), + & PTRAST(KEEP(28)) + INTEGER CAND(SLAVEF+1,max(1,KEEP(56))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + REAL A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER FRT_PTR(N+1), FRT_ELT(NELT) + INTEGER INTARR(max(1,KEEP(14))) + REAL DBLARR(max(1,KEEP(13))) + INTEGER MYID, COMM + INTEGER LBUFR, LBUFR_BYTES + INTEGER NBPROCFILS(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER BUFR( LBUFR ) + INCLUDE 'mumps_headers.h' + INTEGER LP, HS, HF, HF_OLD, NSLAVES_OLD,NCBSON + INTEGER NCBSON_MAX + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + INTEGER NFS4FATHER + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER LREQ_OOC, NBPANELS_L, NBPANELS_U + INTEGER NCB + INTEGER J1,J2 + INTEGER(8) NFRONT8, LAPOS2, POSELT, POSEL1, LDAFS8, + & JJ2, IACHK, ICT12, ICT21 +#if defined(ALLOW_NON_INIT) + INTEGER(8) :: JJ8 +#endif + INTEGER(8) APOS, APOS2 + INTEGER NELIM,LDAFS,JJ1,NPIVS,NCOLS,NROWS, + & IORG + INTEGER LDA_SON, IJROW, IBROT + INTEGER Pos_First_NUMORG,NBCOL,NUMORG,IOLDPS + INTEGER AINPUT + INTEGER NSLAVES, NSLSON + INTEGER NBLIG, PTRCOL, PTRROW, ISLAVE, PDEST + INTEGER ELTI, SIZE_ELTI + INTEGER II, ELBEG, NUMELT, I, J, AII + LOGICAL SAME_PROC, NIV1, SON_LEVEL2 + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX + logical :: force_cand + INTEGER(8) APOSMAX + REAL MAXARR + INTEGER INIV2, SIZE_TMP_SLAVES_LIST, allocok + INTEGER NUMORG_SPLIT, TYPESPLIT, + & NCB_SPLIT, SIZE_LIST_SPLIT, NBSPLIT + INTEGER, ALLOCATABLE, DIMENSION(:) :: TMP_SLAVES_LIST, COPY_CAND + INTEGER IZERO + INTEGER IDUMMY(1) + INTEGER PDEST1(1) + INTEGER ETATASS + PARAMETER( IZERO = 0 ) + INTEGER MUMPS_275, MUMPS_330, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, MUMPS_810 + INTRINSIC real + REAL ZERO + REAL RZERO + PARAMETER( RZERO = 0.0E0 ) + PARAMETER( ZERO = 0.0E0 ) + COMPRESSCB=.FALSE. + ETATASS = 0 + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + NSTEPS = NSTEPS + 1 + NUMELT = FRT_PTR(INODE+1) - FRT_PTR(INODE) + IF ( NUMELT .NE. 0 ) THEN + ELBEG = FRT_PTR(INODE) + ELSE + ELBEG = 1 + END IF + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + END DO + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + NCBSON_MAX = 0 + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + IF ( KEEP(48)==5 .AND. + & MUMPS_330(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) .EQ. 1) THEN + NCBSON_MAX = + & max(NCBSON_MAX,IW(PIMASTER(STEP(ISON))+KEEP(IXSZ))) + END IF + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + END DO + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + MAXFRW = max0(MAXFRW, NFRONT) + NASS1 = NASS + NUMORG + NCB = NFRONT - NASS1 + IF((KEEP(24).eq.0).or.(KEEP(24).eq.1)) then + force_cand=.FALSE. + ELSE + force_cand=(mod(KEEP(24),2).eq.0) + end if + IF (force_cand) THEN + INIV2 = ISTEP_TO_INIV2( STEP( INODE )) + SIZE_TMP_SLAVES_LIST = CAND( SLAVEF+1, INIV2 ) + ELSE + INIV2 = 1 + SIZE_TMP_SLAVES_LIST = SLAVEF - 1 + ENDIF + ALLOCATE(TMP_SLAVES_LIST(SIZE_TMP_SLAVES_LIST),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + TYPESPLIT = MUMPS_810 (PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IF ( (TYPESPLIT.EQ.4) + & .OR.(TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) + & ) THEN + IF (TYPESPLIT.EQ.4) THEN + ALLOCATE(COPY_CAND(SLAVEF+1),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + CALL SMUMPS_791 ( + & INODE, STEP, N, SLAVEF, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & CAND(1,INIV2), ICNTL, COPY_CAND, + & NBSPLIT, NUMORG_SPLIT, TMP_SLAVES_LIST(1), + & SIZE_TMP_SLAVES_LIST + & ) + NCB_SPLIT = NCB-NUMORG_SPLIT + SIZE_LIST_SPLIT = SIZE_TMP_SLAVES_LIST - NBSPLIT + CALL SMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, COPY_CAND, + & MEM_DISTRIB(0), NCB_SPLIT, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST(NBSPLIT+1), + & SIZE_LIST_SPLIT,INODE ) + DEALLOCATE (COPY_CAND) + CALL SMUMPS_790 ( + & INODE, STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, + & TAB_POS_IN_PERE(1,INIV2), + & NSLAVES + & ) + ELSE + ISTCHK = PIMASTER(STEP(IFSON)) + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + TMP_SLAVES_LIST (1:SIZE_TMP_SLAVES_LIST) + & = CAND (1:SIZE_TMP_SLAVES_LIST, INIV2) + CALL SMUMPS_792 ( + & INODE, TYPESPLIT, IFSON, + & IW(PDEST), NSLSON, + & STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, ISTEP_TO_INIV2, INIV2, + & TAB_POS_IN_PERE, NSLAVES, + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST + & ) + ENDIF + ELSE + CALL SMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL SMUMPS_684(KEEP(50), NASS1, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL SMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + ENDIF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + ENDIF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + NIV1 = .FALSE. + IF (KEEP(50).EQ.0) THEN + CALL MUMPS_124( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, NFRONT,NFRONT_EFF, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + ELSE + CALL MUMPS_125( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + IF (IFLAG.LT.0) GOTO 250 + ENDIF + IF ( NFRONT .NE. NFRONT_EFF ) THEN + IF ( + & (TYPESPLIT.EQ.5) .OR. (TYPESPLIT.EQ.6)) THEN + WRITE(6,*) ' SPLITTING NOT YET READY FOR THAT' + CALL MUMPS_ABORT() + ENDIF + IF (NFRONT.GT.NFRONT_EFF) THEN + NCB = NFRONT_EFF - NASS1 + NSLAVES_OLD = NSLAVES + HF_OLD = HF + IF (TYPESPLIT.EQ.4) THEN + WRITE(6,*) ' Internal error 2 in fac_ass_elt due', + & ' to plitting ', + & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ELSE + CALL SMUMPS_472( NCBSON_MAX, + & SLAVEF, KEEP,KEEP8,ICNTL, + & CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT_EFF, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) - + & (NSLAVES_OLD - NSLAVES) + IF (NSLAVES_OLD .NE. NSLAVES) THEN + IF (NSLAVES_OLD > NSLAVES) THEN + DO JJ=0,2*NFRONT_EFF-1 + IW(IOLDPS+HF+JJ)=IW(IOLDPS+HF_OLD+JJ) + ENDDO + ELSE + IF (IWPOS - 1 > IWPOSCB ) GOTO 270 + DO JJ=2*NFRONT_EFF-1, 0, -1 + IW(IOLDPS+HF+JJ) = IW(IOLDPS+HF_OLD+JJ) + ENDDO + END IF + END IF + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) ' ERROR 2 during ass_niv2' + GOTO 270 + ENDIF + ENDIF + NFRONT8=int(NFRONT,8) + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL SMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + MAXFRW = max0(MAXFRW, NFRONT) + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS + 1+KEEP(IXSZ)) = 0 + IW(IOLDPS + 2+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 3+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) + IW(IOLDPS+KEEP(IXSZ)) = NFRONT + IW(IOLDPS+5+KEEP(IXSZ)) = NSLAVES + IW(IOLDPS+6+KEEP(IXSZ):IOLDPS+5+NSLAVES+KEEP(IXSZ))= + & TMP_SLAVES_LIST(1:NSLAVES) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + IF (KEEP(73) .EQ. 0) THEN +#endif +#endif + CALL SMUMPS_461(MYID, SLAVEF, COMM_LOAD, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP, KEEP8, IW(IOLDPS+6+KEEP(IXSZ)), NSLAVES,INODE) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + ENDIF +#endif +#endif + IF(KEEP(86).EQ.1)THEN + IF(mod(KEEP(24),2).eq.0)THEN + CALL SMUMPS_533(SLAVEF,CAND(SLAVEF+1,INIV2), + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE) + ELSEIF((KEEP(24).EQ.0).OR.(KEEP(24).EQ.1))THEN + CALL SMUMPS_533(SLAVEF,SLAVEF-1, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8,TMP_SLAVES_LIST, NSLAVES,INODE) + ENDIF + ENDIF + DEALLOCATE(TMP_SLAVES_LIST) + IF (KEEP(50).EQ.0) THEN + LAELL8 = int(NASS1,8) * NFRONT8 + LDAFS = NFRONT + LDAFS8 = NFRONT8 + ELSE + LAELL8 = int(NASS1,8)*int(NASS1,8) + IF (KEEP(219).NE.0) THEN + IF(KEEP(50) .EQ. 2) LAELL8 = LAELL8+int(NASS1,8) + ENDIF + LDAFS = NASS1 + LDAFS8 = int(NASS1,8) + ENDIF + IF (LRLU .LT. LAELL8) THEN + IF (LRLUS .LT. LAELL8) THEN + GOTO 280 + ELSE + CALL SMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + ENDIF + ENDIF + ENDIF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + POSFAC = POSFAC + LAELL8 + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + CALL SMUMPS_471(.FALSE.,.FALSE.,LA-LRLUS,0_8,LAELL8, + & KEEP,KEEP8, + &LRLU) + POSEL1 = POSELT - LDAFS8 +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. LDAFS .lt. KEEP(63) ) THEN + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO + ELSE + APOS = POSELT + DO JJ8 = 0_8, LDAFS8 - 1_8 + A(APOS:APOS+JJ8) = ZERO + APOS = APOS + LDAFS8 + END DO + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + A(APOS:APOS+LDAFS8-1_8)=ZERO + ENDIF + END IF +#endif + IF ((NUMSTK.NE.0).AND.(NASS.NE.0)) THEN + ISON = IFSON + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + KEEP(IXSZ) + 1) + IF (NELIM.EQ.0) GOTO 210 + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NPIVS = IW(ISTCHK + KEEP(IXSZ) + 3) + IF (NPIVS.LT.0) NPIVS=0 + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + HS = 6 + KEEP(IXSZ) + NSLSON + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + KEEP(IXSZ) + 2) + ELSE + NROWS = NCOLS + ENDIF + OPASSW = OPASSW + dble(NELIM*LSTK) + J1 = ISTCHK + HS + NROWS + NPIVS + J2 = J1 + NELIM - 1 + IACHK = PAMASTER(STEP(ISON)) + IF (KEEP(50).eq.0) THEN + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * LDAFS8 + DO 160 JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1),8) - 1_8 + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1,8) - 1_8) + 160 CONTINUE + IACHK = IACHK + int(LSTK,8) + 170 CONTINUE + ELSE + IF (NSLSON.EQ.0) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = (int(NELIM,8)*int(NELIM+1,8))/2_8 + ELSE + LCB = int(LDA_SON,8)*int(NELIM,8) + ENDIF + CALL SMUMPS_178(A, LA, + & POSELT, LDAFS, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), NELIM, NELIM, ETATASS, + & COMPRESSCB, + & .FALSE. + & ) + ENDIF + 210 ISON = FRERE(STEP(ISON)) + 220 CONTINUE + ENDIF + APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8) + IF (KEEP(219).NE.0) THEN + IF (KEEP(50).EQ.2) THEN + A( APOSMAX: APOSMAX+int(NASS1-1,8))=ZERO + ENDIF + ENDIF + DO IELL=ELBEG,ELBEG+NUMELT-1 + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + AII = PTRARW(ELTI) + SIZE_ELTI = J2 - J1 + 1 + DO II=J1,J2 + I = INTARR(II) + IF (KEEP(50).EQ.0) THEN + IF (I.LE.NASS1) THEN + AINPUT = AII + II - J1 + ICT12 = POSELT + int(I-1,8) * LDAFS8 + DO JJ=J1,J2 + APOS2 = ICT12 + int(INTARR(JJ) - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + SIZE_ELTI + END DO + ENDIF + ELSE + ICT12 = POSELT - LDAFS8 + int(I,8) - 1_8 + ICT21 = POSELT + int(I-1,8)*LDAFS8 - 1_8 + IF ( I .GT. NASS1 ) THEN + IF (KEEP(219).NE.0) THEN + IF (KEEP(50).EQ.2) THEN + AINPUT=AII + DO JJ=II,J2 + J=INTARR(JJ) + IF (J.LE.NASS1) THEN + A(APOSMAX+int(J-1,8))= + & max(real(A(APOSMAX+int(J-1,8))), + & abs(DBLARR(AINPUT))) + ENDIF + AINPUT=AINPUT+1 + ENDDO + ELSE + AII = AII + J2 - II + 1 + CYCLE + ENDIF + ELSE + AII = AII + J2 - II + 1 + CYCLE + ENDIF + ELSE + IF (KEEP(219).NE.0) THEN + MAXARR = RZERO + ENDIF + DO JJ=II,J2 + J = INTARR(JJ) + IF ( J .LE. NASS1) THEN + IF (I.LT.J) THEN + APOS2 = ICT12 + int(J,8)*LDAFS8 + ELSE + APOS2 = ICT21 + int(J,8) + ENDIF + A(APOS2) = A(APOS2) + DBLARR(AII) + ELSE IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + MAXARR = max(MAXARR,abs(DBLARR(AII))) + ENDIF + AII = AII + 1 + END DO + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN + A(APOSMAX+int(I-1,8)) = + & max( MAXARR, real(A(APOSMAX+int(I-1,8)))) + ENDIF + ENDIF + END IF + END DO + END DO + IF (KEEP(253).GT.0) THEN + POSELT = PTRAST(STEP(INODE)) + IBROT = INODE + IJROW = Pos_First_NUMORG + DO IORG = 1, NUMORG + IF (KEEP(50).EQ.0) THEN + DO JJ = 1, KEEP(253) + APOS = POSELT + + & int(IJROW-1,8) * int(LDAFS,8) + + & int(LDAFS-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + IJROW = IJROW+1 + ENDDO + ENDIF + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + PDEST = IOLDPS + 6 + KEEP(IXSZ) + DO ISLAVE = 1, NSLAVES + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB, + & NSLAVES, + & NBLIG, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + IERR = -1 + DO WHILE (IERR .EQ.-1) + IF ( KEEP(50) .eq. 0 ) THEN + NBCOL = NFRONT + CALL SMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & IZERO, IDUMMY, + & IW(PDEST), NFRONT, COMM, IERR) + ELSE + NBCOL = NASS1+SHIFT_INDEX+NBLIG + CALL SMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & NSLAVES-ISLAVE, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE), + & IW(PDEST), NFRONT, COMM, IERR) + ENDIF + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.) + IF ( IFLAG .LT. 0 ) GOTO 500 + IF (MESSAGE_RECEIVED) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + SHIFT_INDEX + ENDIF + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 300 + IF (IERR .EQ. -3) GOTO 305 + PTRROW = PTRROW + NBLIG + PDEST = PDEST + 1 + END DO + IF (NUMSTK.EQ.0) GOTO 500 + ISON = IFSON + DO IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + 1 + KEEP(IXSZ)) + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + 2 + KEEP(IXSZ) ) + ELSE + NROWS = NCOLS + ENDIF + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + NFS4FATHER = NCBSON + DO I=0,NCBSON-1 + IF(IW(PTRCOL+I) .GT. NASS1) THEN + NFS4FATHER = I + EXIT + ENDIF + ENDDO + NFS4FATHER=NFS4FATHER + NELIM + ELSE + NFS4FATHER = 0 + ENDIF + IF (NSLSON.EQ.0) THEN + NSLSON = 1 + PDEST1(1) = MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) + IF (PDEST1(1).EQ.MYID) THEN + CALL SMUMPS_211( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)), + & NFRONT, NASS1, NFS4FATHER,NCBSON, IW( PTRCOL ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, NELT+1, NELT, + & FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ELSE + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + CALL SMUMPS_71( + & INODE, NFRONT,NASS1,NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)), + & IW(PTRCOL), NCBSON, + & COMM, IERR, PDEST1, NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ELSE + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL SMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + END DO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL SMUMPS_71( + & INODE, NFRONT, NASS1, NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW(PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + END DO + GOTO 500 + 250 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE IN INTEGER', + & ' DYNAMIC ALLOCATION during assembly' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 1 + GOTO 490 + 265 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE ALLOCATING TMP_SLAVES_LIST', + & ' DYNAMIC ALLOCATION during assembly' + ENDIF + IFLAG = -13 + IERROR = SIZE_TMP_SLAVES_LIST + GOTO 490 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE IN INTEGER ALLOCATION DURING SMUMPS_37' + ENDIF + GOTO 490 + 280 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, WORKSPACE TOO SMALL DURING SMUMPS_37' + ENDIF + IFLAG = -9 + CALL MUMPS_731(LAELL8 - LRLUS, IERROR) + GOTO 490 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SEND BUFFER TOO SMALL (1) DURING SMUMPS_37' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECV BUFFER TOO SMALL (1) DURING SMUMPS_37' + ENDIF + IFLAG = -20 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SENDBUFFER TOO SMALL (2) DURING SMUMPS_37' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 305 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECVBUFFER TOO SMALL (2) DURING SMUMPS_37' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 490 CALL SMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE SMUMPS_37 + SUBROUTINE SMUMPS_123( + & NELT, FRT_PTR, FRT_ELT, + & N, INODE, IW, LIW, A, LA, + & NBROWS, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, + & RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP, KEEP8, MYID) + IMPLICIT NONE + INTEGER NELT, N,LIW + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER INODE, MYID + INTEGER NBROWS, NBCOLS + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER IW(LIW), ITLOC(N + KEEP(253)), STEP(N), + & PTRIST(KEEP(28)), + & FILS(N), PTRARW(NELT+1), + & PTRAIW(NELT+1) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER FRT_PTR(N+1), FRT_ELT(NELT) + REAL A(LA), + & DBLARR(max(1,KEEP(13))) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER(8) :: POSELT, APOS2, ICT12, APOS + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & K1,K2,K,I,J,JPOS,NASS,JJ, + & IN,AINPUT,J1,J2,IJROW,ILOC, + & ELBEG, NUMELT, ELTI, SIZE_ELTI, IPOS, + & IPOS1, IPOS2, AII, II, IELL + INTEGER :: K1RHS, K2RHS, JFirstRHS + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INCLUDE 'mumps_headers.h' + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NASS = IW(IOLDPS+1+KEEP(IXSZ)) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + IF (NASS.LT.0) THEN + NASS = -NASS + IW(IOLDPS+1+KEEP(IXSZ)) = NASS + A(POSELT:POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8) = + & ZERO + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -JPOS + JPOS = JPOS + 1 + END DO + K1 = IOLDPS + HF + K2 = K1 + NBROWF - 1 + JPOS = 1 + IF ((KEEP(253).GT.0).AND.(KEEP(50).NE.0)) THEN + K1RHS = 0 + K2RHS = -1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -ITLOC(J)*NBCOLF + JPOS + IF ((K1RHS.EQ.0).AND.(J.GT.N)) THEN + K1RHS = K + JFirstRHS=J-N + ENDIF + JPOS = JPOS + 1 + ENDDO + IF (K1RHS.GT.0) K2RHS=K2 + IF ( K2RHS.GE.K1RHS ) THEN + IN = INODE + DO WHILE (IN.GT.0) + IJROW = -ITLOC(IN) + DO K = K1RHS, K2RHS + J = IW(K) + I = ITLOC(J) + ILOC = mod(I,NBCOLF) + APOS = POSELT+int(ILOC-1,8)*int(NBCOLF,8) + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( + & (JFirstRHS+(K-K1RHS)-1)*KEEP(254)+ IN) + ENDDO + IN = FILS(IN) + ENDDO + ENDIF + ELSE + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -ITLOC(J)*NBCOLF + JPOS + JPOS = JPOS + 1 + END DO + ENDIF + ELBEG = FRT_PTR(INODE) + NUMELT = FRT_PTR(INODE+1) - ELBEG + DO IELL=ELBEG,ELBEG+NUMELT-1 + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + AII = PTRARW(ELTI) + SIZE_ELTI = J2 - J1 + 1 + DO II=J1,J2 + I = ITLOC(INTARR(II)) + IF (KEEP(50).EQ.0) THEN + IF (I.LE.0) CYCLE + AINPUT = AII + II - J1 + IPOS = mod(I,NBCOLF) + ICT12 = POSELT + int(IPOS-1,8) * int(NBCOLF,8) + DO JJ = J1, J2 + JPOS = ITLOC(INTARR(JJ)) + IF (JPOS.LE.0) THEN + JPOS = -JPOS + ELSE + JPOS = JPOS/NBCOLF + END IF + APOS2 = ICT12 + int(JPOS - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + SIZE_ELTI + END DO + ELSE + IF ( I .EQ. 0 ) THEN + AII = AII + J2 - II + 1 + CYCLE + ENDIF + IF ( I .LE. 0 ) THEN + IPOS1 = -I + IPOS2 = 0 + ELSE + IPOS1 = I/NBCOLF + IPOS2 = mod(I,NBCOLF) + END IF + ICT12 = POSELT + int(IPOS2-1,8)*int(NBCOLF,8) + DO JJ=II,J2 + AII = AII + 1 + J = ITLOC(INTARR(JJ)) + IF ( J .EQ. 0 ) CYCLE + IF ( IPOS2.EQ.0 .AND. J.LE.0) CYCLE + IF ( J .LE. 0 ) THEN + JPOS = -J + ELSE + JPOS = J/NBCOLF + END IF + IF ( (IPOS1.GE.JPOS) .AND. (IPOS2.GT.0) ) THEN + APOS2 = ICT12 + int(JPOS - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AII-1) + END IF + IF ( (IPOS1.LT.JPOS) .AND. (J.GT.0) ) THEN + IPOS = mod(J,NBCOLF) + JPOS = IPOS1 + APOS2 = POSELT + int(IPOS-1,8)*int(NBCOLF,8) + & + int(JPOS - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AII-1) + END IF + END DO + END IF + END DO + END DO + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = 0 + END DO + END IF + IF (NBROWS.GT.0) THEN + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + JPOS = JPOS + 1 + END DO + END IF + RETURN + END SUBROUTINE SMUMPS_123 + SUBROUTINE SMUMPS_126( + & N, NELT, NA_ELT, + & COMM, MYID, SLAVEF, + & IELPTR_LOC, RELPTR_LOC, + & ELTVAR_LOC, ELTVAL_LOC, + & KEEP,KEEP8, MAXELT_SIZE, + & FRTPTR, FRTELT, A, LA, FILS, + & id, root ) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N, NELT, NA_ELT + INTEGER COMM, MYID, SLAVEF, MAXELT_SIZE, MSGLEN + INTEGER(8), intent(IN) :: LA + INTEGER FRTPTR( N+1 ) + INTEGER FRTELT( NELT ), FILS ( N ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IELPTR_LOC( NELT + 1 ), RELPTR_LOC( NELT + 1 ) + INTEGER ELTVAR_LOC( max(1,KEEP(14)) ) + REAL ELTVAL_LOC( max(1,KEEP(13)) ) + REAL A( LA ) + TYPE(SMUMPS_STRUC) :: id + TYPE(SMUMPS_ROOT_STRUC) :: root + INTEGER numroc + EXTERNAL numroc + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR_MPI + INTEGER MSGTAG + INTEGER allocok + INTEGER I, DEST, MAXELT_REAL_SIZE, MPG, IEL, SIZEI, SIZER + INTEGER NBRECORDS, NBUF + INTEGER RECV_IELTPTR, RECV_RELTPTR + INTEGER IELTPTR, RELTPTR, INODE + LOGICAL FINI, PROKG, I_AM_SLAVE + INTEGER(8) :: PTR_ROOT + INTEGER LOCAL_M, LOCAL_N, LP, IBEG, IGLOB, JGLOB + INTEGER ARROW_ROOT + INTEGER IELT, J, K, NB_REC, IREC + INTEGER ILOCROOT, JLOCROOT, IPOSROOT, JPOSROOT, IPTR + INTEGER JCOL_GRID, IROW_GRID + INTEGER IVALPTR + INTEGER NBELROOT + INTEGER MASTER + PARAMETER( MASTER = 0 ) + REAL VAL + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INTEGER, DIMENSION( :, : ), ALLOCATABLE :: BUFI + REAL, DIMENSION( :, : ), ALLOCATABLE :: BUFR + REAL, DIMENSION( : ), ALLOCATABLE :: TEMP_ELT_R + INTEGER, DIMENSION( : ), ALLOCATABLE :: TEMP_ELT_I + INTEGER, DIMENSION( : ), ALLOCATABLE :: ELROOTPOS + INTEGER, DIMENSION( : ), ALLOCATABLE, TARGET :: RG2LALLOC + INTEGER, DIMENSION( : ), POINTER :: RG2L + MPG = id%ICNTL(3) + LP = id%ICNTL(1) + I_AM_SLAVE = ( KEEP(46) .eq. 1 .or. MYID .ne.MASTER ) + PROKG = ( MPG > 0 .and. MYID .eq. MASTER ) + KEEP(49) = 0 + ARROW_ROOT = 0 + IF ( MYID .eq. MASTER ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + NBUF = SLAVEF + ELSE + NBUF = SLAVEF - 1 + END IF + NBRECORDS = min(KEEP(39),NA_ELT) + IF ( KEEP(50) .eq. 0 ) THEN + MAXELT_REAL_SIZE = MAXELT_SIZE * MAXELT_SIZE + ELSE + MAXELT_REAL_SIZE = MAXELT_SIZE * (MAXELT_SIZE+1)/2 + END IF + IF ( MAXELT_REAL_SIZE .GT. KEEP(39) ) THEN + NBRECORDS = MAXELT_REAL_SIZE + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,*) + & ' ** Warning : For element distrib NBRECORDS set to ', + & MAXELT_REAL_SIZE,' because one element is large' + END IF + END IF + ALLOCATE( BUFI( 2*NBRECORDS+1, NBUF ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 2*NBRECORDS + 1 + GOTO 100 + END IF + ALLOCATE( BUFR( NBRECORDS+1, NBUF ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBRECORDS + 1 + GOTO 100 + END IF + IF ( KEEP(52) .ne. 0 ) THEN + ALLOCATE( TEMP_ELT_R( MAXELT_REAL_SIZE ), stat =allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = MAXELT_REAL_SIZE + GOTO 100 + END IF + END IF + ALLOCATE( TEMP_ELT_I( MAXELT_SIZE ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = MAXELT_SIZE + GOTO 100 + END IF + IF ( KEEP(38) .ne. 0 ) THEN + NBELROOT = FRTPTR(KEEP(38)+1)-FRTPTR(KEEP(38)) + ALLOCATE( ELROOTPOS( max(NBELROOT,1) ), + & stat = allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBELROOT + GOTO 100 + END IF + IF (KEEP(46) .eq. 0 ) THEN + ALLOCATE( RG2LALLOC( N ), stat = allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = N + GOTO 100 + END IF + INODE = KEEP(38) + I = 1 + DO WHILE ( INODE .GT. 0 ) + RG2LALLOC( INODE ) = I + INODE = FILS( INODE ) + I = I + 1 + END DO + RG2L => RG2LALLOC + ELSE + RG2L => root%RG2L_ROW + END IF + END IF + DO I = 1, NBUF + BUFI( 1, I ) = 0 + BUFR( 1, I ) = ZERO + END DO + END IF + 100 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), COMM, MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + CALL MPI_BCAST( NBRECORDS, 1, MPI_INTEGER, MASTER, + & COMM, IERR_MPI ) + RECV_IELTPTR = 1 + RECV_RELTPTR = 1 + IF ( MYID .eq. MASTER ) THEN + NBELROOT = 0 + RELTPTR = 1 + RELPTR_LOC(1) = 1 + DO IEL = 1, NELT + IELTPTR = id%ELTPTR( IEL ) + SIZEI = id%ELTPTR( IEL + 1 ) - IELTPTR + IF ( KEEP( 50 ) .eq. 0 ) THEN + SIZER = SIZEI * SIZEI + ELSE + SIZER = SIZEI * ( SIZEI + 1 ) / 2 + END IF + DEST = id%ELTPROC( IEL ) + IF ( DEST .eq. -2 ) THEN + NBELROOT = NBELROOT + 1 + FRTELT( FRTPTR(KEEP(38)) + NBELROOT - 1 ) = IEL + ELROOTPOS( NBELROOT ) = RELTPTR + GOTO 200 + END IF + IF ( DEST .ge. 0 .and. KEEP(46) .eq. 0 ) DEST = DEST + 1 + IF ( KEEP(52) .ne. 0 ) THEN + CALL SMUMPS_288( N, SIZEI, SIZER, + & id%ELTVAR( IELTPTR ), id%A_ELT( RELTPTR ), + & TEMP_ELT_R(1), MAXELT_REAL_SIZE, + & id%ROWSCA(1), id%COLSCA(1), KEEP(50) ) + END IF + IF ( DEST .eq. 0 .or. ( DEST .eq. -1 .and. KEEP(46) .ne. 0 ) ) + & THEN + ELTVAR_LOC( RECV_IELTPTR: RECV_IELTPTR + SIZEI - 1 ) + & = id%ELTVAR( IELTPTR: IELTPTR + SIZEI - 1 ) + RECV_IELTPTR = RECV_IELTPTR + SIZEI + IF ( KEEP(52) .ne. 0 ) THEN + ELTVAL_LOC( RECV_RELTPTR: RECV_RELTPTR + SIZER - 1) + & = TEMP_ELT_R( 1: SIZER ) + RECV_RELTPTR = RECV_RELTPTR + SIZER + END IF + END IF + IF ( DEST .NE. 0 .AND. DEST. NE. -3 ) THEN + IF ( KEEP(52) .eq. 0 ) THEN + CALL SMUMPS_127( + & id%ELTVAR(IELTPTR), + & id%A_ELT (RELTPTR), + & SIZEI, SIZER, + & + & DEST, NBUF, NBRECORDS, + & BUFI, BUFR, COMM ) + ELSE + CALL SMUMPS_127( + & id%ELTVAR(IELTPTR), + & TEMP_ELT_R( 1 ), + & SIZEI, SIZER, + & + & DEST, NBUF, NBRECORDS, + & BUFI, BUFR, COMM ) + END IF + END IF + 200 CONTINUE + RELTPTR = RELTPTR + SIZER + IF ( KEEP(46) .eq. 0 .OR. KEEP(52) .eq. 0 ) THEN + RELPTR_LOC( IEL + 1 ) = RELTPTR + ELSE + RELPTR_LOC( IEL + 1 ) = RECV_RELTPTR + ENDIF + END DO + IF ( KEEP(46) .eq. 0 .OR. KEEP(52) .eq. 0 ) THEN + KEEP(13) = RELTPTR - 1 + ELSE + KEEP(13) = RECV_RELTPTR - 1 + ENDIF + IF ( RELTPTR - 1 .ne. id%NA_ELT ) THEN + WRITE(*,*) ' ** ERROR ELT DIST: RELPTR - 1 / id%NA_ELT=', + & RELTPTR - 1,id%NA_ELT + CALL MUMPS_ABORT() + END IF + DEST = -2 + IELTPTR = 1 + RELTPTR = 1 + SIZEI = 1 + SIZER = 1 + CALL SMUMPS_127( + & id%ELTVAR(IELTPTR), + & id%A_ELT (RELTPTR), + & SIZEI, SIZER, + & + & DEST, NBUF, NBRECORDS, + & BUFI, BUFR, COMM ) + IF ( KEEP(52) .NE. 0 ) DEALLOCATE( TEMP_ELT_R ) + ELSE + FINI = ( RECV_IELTPTR .eq. IELPTR_LOC( NELT+1 ) + & .and. RECV_RELTPTR .eq. RELPTR_LOC( NELT+1 ) ) + DO WHILE ( .not. FINI ) + CALL MPI_PROBE( MASTER, MPI_ANY_TAG, + & COMM, STATUS, IERR_MPI ) + MSGTAG = STATUS( MPI_TAG ) + SELECT CASE ( MSGTAG ) + CASE( ELT_INT ) + CALL MPI_GET_COUNT( STATUS, MPI_INTEGER, + & MSGLEN, IERR_MPI ) + CALL MPI_RECV( ELTVAR_LOC( RECV_IELTPTR ), MSGLEN, + & MPI_INTEGER, MASTER, ELT_INT, + & COMM, STATUS, IERR_MPI ) + RECV_IELTPTR = RECV_IELTPTR + MSGLEN + CASE( ELT_REAL ) + CALL MPI_GET_COUNT( STATUS, MPI_REAL, + & MSGLEN, IERR_MPI ) + CALL MPI_RECV( ELTVAL_LOC( RECV_RELTPTR ), MSGLEN, + & MPI_REAL, MASTER, ELT_REAL, + & COMM, STATUS, IERR_MPI ) + RECV_RELTPTR = RECV_RELTPTR + MSGLEN + END SELECT + FINI = ( RECV_IELTPTR .eq. IELPTR_LOC( NELT+1 ) + & .and. RECV_RELTPTR .eq. RELPTR_LOC( NELT+1 ) ) + END DO + END IF + IF ( KEEP(38) .NE. 0 ) THEN + IF ( I_AM_SLAVE .and. root%yes ) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I = 1, root%SCHUR_NLOC + root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1: + & (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC)=ZERO + ENDDO + ENDIF + END IF + IF ( MYID .NE. MASTER ) THEN + ALLOCATE( BUFI( NBRECORDS * 2 + 1, 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBRECORDS * 2 + 1 + GOTO 250 + END IF + ALLOCATE( BUFR( NBRECORDS, 1 ) , stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBRECORDS + END IF + END IF + 250 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), COMM, MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + IF ( MYID .eq. MASTER ) THEN + DO IPTR = FRTPTR(KEEP(38)), FRTPTR(KEEP(38)+1) - 1 + IELT = FRTELT( IPTR ) + SIZEI = id%ELTPTR( IELT + 1 ) - id%ELTPTR( IELT ) + DO I = 1, SIZEI + TEMP_ELT_I( I ) = RG2L + & ( id%ELTVAR( id%ELTPTR(IELT) + I - 1 ) ) + END DO + IVALPTR = ELROOTPOS( IPTR - FRTPTR(KEEP(38)) + 1 ) - 1 + K = 1 + DO J = 1, SIZEI + JGLOB = id%ELTVAR( id%ELTPTR( IELT ) + J - 1 ) + IF ( KEEP(50).eq. 0 ) THEN + IBEG = 1 + ELSE + IBEG = J + END IF + DO I = IBEG, SIZEI + IGLOB = id%ELTVAR( id%ELTPTR( IELT ) + I - 1 ) + IF ( KEEP(52) .eq. 0 ) THEN + VAL = id%A_ELT( IVALPTR + K ) + ELSE + VAL = id%A_ELT( IVALPTR + K ) * + & id%ROWSCA( IGLOB ) * id%COLSCA( JGLOB ) + END IF + IF ( KEEP(50).eq.0 ) THEN + IPOSROOT = TEMP_ELT_I( I ) + JPOSROOT = TEMP_ELT_I( J ) + ELSE + IF ( TEMP_ELT_I(I) .GT. TEMP_ELT_I(J) ) THEN + IPOSROOT = TEMP_ELT_I(I) + JPOSROOT = TEMP_ELT_I(J) + ELSE + IPOSROOT = TEMP_ELT_I(J) + JPOSROOT = TEMP_ELT_I(I) + END IF + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, + & root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, + & root%NPCOL ) + IF ( KEEP(46) .eq. 0 ) THEN + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + 1 + ELSE + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + END IF + IF ( DEST .eq. MASTER ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & = A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & + VAL + ENDIF + ELSE + CALL SMUMPS_34( + & IPOSROOT, JPOSROOT, VAL, DEST, BUFI, BUFR, NBRECORDS, + & NBUF, LP, COMM, KEEP(46) ) + END IF + K = K + 1 + END DO + END DO + END DO + CALL SMUMPS_18( + & BUFI, BUFR, NBRECORDS, + & NBUF, LP, COMM, KEEP(46) ) + ELSE + FINI = .FALSE. + DO WHILE ( .not. FINI ) + CALL MPI_RECV( BUFI(1,1), 2*NBRECORDS+1, + & MPI_INTEGER, MASTER, + & ARROWHEAD, + & COMM, STATUS, IERR_MPI ) + NB_REC = BUFI(1,1) + IF (NB_REC.LE.0) THEN + FINI = .TRUE. + NB_REC = -NB_REC + ENDIF + IF (NB_REC.EQ.0) EXIT + CALL MPI_RECV( BUFR(1,1), NBRECORDS, MPI_REAL, + & MASTER, ARROWHEAD, + & COMM, STATUS, IERR_MPI ) + ARROW_ROOT = ARROW_ROOT + NB_REC + DO IREC = 1, NB_REC + IPOSROOT = BUFI( IREC * 2, 1 ) + JPOSROOT = BUFI( IREC * 2 + 1, 1 ) + VAL = BUFR( IREC, 1 ) + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60).eq.0) THEN + A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8) + & + int(ILOCROOT-1,8)) + & = A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8) + & + int(ILOCROOT-1,8)) + & + VAL + ELSE + root%SCHUR_POINTER(int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + END DO + END DO + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + END IF + END IF + IF ( MYID .eq. MASTER ) THEN + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + IF (KEEP(38).ne.0) THEN + DEALLOCATE(ELROOTPOS) + IF (KEEP(46) .eq. 0 ) THEN + DEALLOCATE(RG2LALLOC) + ENDIF + ENDIF + DEALLOCATE( TEMP_ELT_I ) + END IF + KEEP(49) = ARROW_ROOT + RETURN + END SUBROUTINE SMUMPS_126 + SUBROUTINE SMUMPS_127( + & ELNODES, ELVAL, SIZEI, SIZER, + & DEST, NBUF, NBRECORDS, BUFI, BUFR, COMM ) + IMPLICIT NONE + INTEGER SIZEI, SIZER, DEST, NBUF, NBRECORDS, COMM + INTEGER ELNODES( SIZEI ), BUFI( 2*NBRECORDS + 1, NBUF ) + REAL ELVAL( SIZER ), BUFR( NBRECORDS + 1, NBUF ) + INCLUDE 'mumps_tags.h' + INCLUDE 'mpif.h' + INTEGER I, IBEG, IEND, IERR_MPI, NBRECR + INTEGER NBRECI + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + IF ( DEST .lt. 0 ) THEN + IBEG = 1 + IEND = NBUF + ELSE + IBEG = DEST + IEND = DEST + END IF + DO I = IBEG, IEND + NBRECI = BUFI(1,I) + IF ( NBRECI .ne.0 .and. + & ( DEST.eq.-2 .or. + & NBRECI + SIZEI .GT. 2*NBRECORDS ) ) THEN + CALL MPI_SEND( BUFI(2, I), NBRECI, MPI_INTEGER, + & I, ELT_INT, COMM, IERR_MPI ) + BUFI(1,I) = 0 + NBRECI = 0 + END IF + NBRECR = int(real(BUFR(1,I))+0.5E0) + IF ( NBRECR .ne.0 .and. + & ( DEST.eq.-2 .or. + & NBRECR + SIZER .GT. NBRECORDS ) ) THEN + CALL MPI_SEND( BUFR(2, I), NBRECR, MPI_REAL, + & I, ELT_REAL, COMM, IERR_MPI ) + BUFR(1,I) = ZERO + NBRECR = 0 + END IF + IF ( DEST .ne. -2 ) THEN + BUFI( 2 + NBRECI : 2 + NBRECI + SIZEI - 1, I ) = + & ELNODES( 1: SIZEI ) + BUFR( 2 + NBRECR : 2 + NBRECR + SIZER - 1, I ) = + & ELVAL( 1: SIZER ) + BUFI(1,I) = NBRECI + SIZEI + BUFR(1,I) = real( NBRECR + SIZER ) + END IF + END DO + RETURN + END SUBROUTINE SMUMPS_127 + SUBROUTINE SMUMPS_213( ELTPTR, NELT, MAXELT_SIZE ) + INTEGER NELT, MAXELT_SIZE + INTEGER ELTPTR( NELT + 1 ) + INTEGER I, S + MAXELT_SIZE = 0 + DO I = 1, NELT + S = ELTPTR( I + 1 ) - ELTPTR( I ) + MAXELT_SIZE = max( S, MAXELT_SIZE ) + END DO + RETURN + END SUBROUTINE SMUMPS_213 + SUBROUTINE SMUMPS_288( N, SIZEI, SIZER, + & ELTVAR, ELTVAL, + & SELTVAL, LSELTVAL, + & ROWSCA, COLSCA, K50 ) + INTEGER N, SIZEI, SIZER, LSELTVAL, K50 + INTEGER ELTVAR( SIZEI ) + REAL ELTVAL( SIZER ) + REAL SELTVAL( LSELTVAL ) + REAL ROWSCA( N ), COLSCA( N ) + INTEGER I, J, K + K = 1 + IF ( K50 .eq. 0 ) THEN + DO J = 1, SIZEI + DO I = 1, SIZEI + SELTVAL(K) = ELTVAL(K) * + & ROWSCA(ELTVAR(I)) * + & COLSCA(ELTVAR(J)) + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + DO I = J, SIZEI + SELTVAL(K) = ELTVAL(K) * + & ROWSCA(ELTVAR(I)) * + & COLSCA(ELTVAR(J)) + K = K + 1 + END DO + END DO + END IF + RETURN + END SUBROUTINE SMUMPS_288 + SUBROUTINE SMUMPS_F77( JOB, SYM, PAR, COMM_F77, N, ICNTL, CNTL, + & NZ, IRN, IRNhere, JCN, JCNhere, A, Ahere, + & NZ_loc, IRN_loc, IRN_lochere, + & JCN_loc, JCN_lochere, + & A_loc, A_lochere, + & NELT, ELTPTR, ELTPTRhere, ELTVAR, + & ELTVARhere, A_ELT, A_ELThere, + & PERM_IN, PERM_INhere, + & RHS, RHShere, REDRHS, REDRHShere, + & INFO, RINFO, INFOG, RINFOG, + & DEFICIENCY, LWK_USER, + & SIZE_SCHUR, LISTVAR_SCHUR, + & LISTVAR_SCHURhere, SCHUR, SCHURhere, + & WK_USER, WK_USERhere, + & COLSCA, COLSCAhere, ROWSCA, ROWSCAhere, + & INSTANCE_NUMBER, NRHS, LRHS, LREDRHS, + & + & RHS_SPARSE, RHS_SPARSEhere, + & SOL_loc, SOL_lochere, + & IRHS_SPARSE, IRHS_SPARSEhere, + & IRHS_PTR, IRHS_PTRhere, + & ISOL_loc, ISOL_lochere, + & NZ_RHS, LSOL_loc + & , + & SCHUR_MLOC, + & SCHUR_NLOC, + & SCHUR_LLD, + & MBLOCK, + & NBLOCK, + & NPROW, + & NPCOL, + & + & OOC_TMPDIR, + & OOC_PREFIX, + & WRITE_PROBLEM, + & TMPDIRLEN, + & PREFIXLEN, + & WRITE_PROBLEMLEN + & + & ) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER OOC_PREFIX_MAX_LENGTH, OOC_TMPDIR_MAX_LENGTH + INTEGER PB_MAX_LENGTH + PARAMETER(OOC_PREFIX_MAX_LENGTH=63, OOC_TMPDIR_MAX_LENGTH=255) + PARAMETER(PB_MAX_LENGTH=255) + INTEGER JOB, SYM, PAR, COMM_F77, N, NZ, NZ_loc, NELT, + & DEFICIENCY, LWK_USER, SIZE_SCHUR, INSTANCE_NUMBER, + & NRHS, LRHS, + & NZ_RHS, LSOL_loc, LREDRHS + INTEGER ICNTL(40), INFO(40), INFOG(40) + INTEGER SCHUR_MLOC, SCHUR_NLOC, SCHUR_LLD + INTEGER MBLOCK, NBLOCK, NPROW, NPCOL + INTEGER TMPDIRLEN, PREFIXLEN, WRITE_PROBLEMLEN + REAL CNTL(15), RINFO(40), RINFOG(40) + INTEGER, TARGET :: IRN(*), JCN(*), ELTPTR(*), ELTVAR(*) + INTEGER, TARGET :: PERM_IN(*), IRN_loc(*), JCN_loc(*) + INTEGER, TARGET :: LISTVAR_SCHUR(*) + INTEGER, TARGET :: IRHS_PTR(*), IRHS_SPARSE(*), ISOL_loc(*) + REAL, TARGET :: A(*), A_ELT(*), A_loc(*), RHS(*) + REAL, TARGET :: WK_USER(*) + REAL, TARGET :: REDRHS(*) + REAL, TARGET :: ROWSCA(*), COLSCA(*) + REAL, TARGET :: SCHUR(*) + REAL, TARGET :: RHS_SPARSE(*), SOL_loc(*) + INTEGER, INTENT(in) :: OOC_TMPDIR(OOC_TMPDIR_MAX_LENGTH) + INTEGER, INTENT(in) :: OOC_PREFIX(OOC_PREFIX_MAX_LENGTH) + INTEGER, INTENT(in) :: WRITE_PROBLEM(PB_MAX_LENGTH) + INTEGER IRNhere, JCNhere, Ahere, ELTPTRhere, ELTVARhere, + & A_ELThere, PERM_INhere, WK_USERhere, + & RHShere, REDRHShere, IRN_lochere, + & JCN_lochere, A_lochere, LISTVAR_SCHURhere, + & SCHURhere, COLSCAhere, ROWSCAhere, RHS_SPARSEhere, + & SOL_lochere, IRHS_PTRhere, IRHS_SPARSEhere, ISOL_lochere + INCLUDE 'mpif.h' + TYPE SMUMPS_STRUC_PTR + TYPE (SMUMPS_STRUC), POINTER :: PTR + END TYPE SMUMPS_STRUC_PTR + TYPE (SMUMPS_STRUC), POINTER :: mumps_par + TYPE (SMUMPS_STRUC_PTR), DIMENSION (:), POINTER, SAVE :: + & mumps_par_array + TYPE (SMUMPS_STRUC_PTR), DIMENSION (:), POINTER :: + & mumps_par_array_bis + INTEGER, SAVE :: SMUMPS_STRUC_ARRAY_SIZE = 0 + INTEGER, SAVE :: N_INSTANCES = 0 + INTEGER A_ELT_SIZE, I, Np, IERR + INTEGER SMUMPS_STRUC_ARRAY_SIZE_INIT + PARAMETER (SMUMPS_STRUC_ARRAY_SIZE_INIT=10) + EXTERNAL MUMPS_AFFECT_MAPPING, + & MUMPS_AFFECT_PIVNUL_LIST, + & MUMPS_AFFECT_SYM_PERM, + & MUMPS_AFFECT_UNS_PERM + IF (JOB == -1) THEN + DO I = 1, SMUMPS_STRUC_ARRAY_SIZE + IF ( .NOT. associated(mumps_par_array(I)%PTR) ) GOTO 10 + END DO + ALLOCATE( mumps_par_array_bis(SMUMPS_STRUC_ARRAY_SIZE + + & SMUMPS_STRUC_ARRAY_SIZE_INIT), stat=IERR) + IF (IERR /= 0) THEN + WRITE(*,*) ' ** Allocation Error 1 in SMUMPS_F77.' + CALL MUMPS_ABORT() + END IF + DO I = 1, SMUMPS_STRUC_ARRAY_SIZE + mumps_par_array_bis(I)%PTR=>mumps_par_array(I)%PTR + ENDDO + IF (associated(mumps_par_array)) DEALLOCATE(mumps_par_array) + mumps_par_array=>mumps_par_array_bis + NULLIFY(mumps_par_array_bis) + DO I = SMUMPS_STRUC_ARRAY_SIZE+1, SMUMPS_STRUC_ARRAY_SIZE + + & SMUMPS_STRUC_ARRAY_SIZE_INIT + NULLIFY(mumps_par_array(I)%PTR) + ENDDO + I = SMUMPS_STRUC_ARRAY_SIZE+1 + SMUMPS_STRUC_ARRAY_SIZE = SMUMPS_STRUC_ARRAY_SIZE + + & SMUMPS_STRUC_ARRAY_SIZE_INIT + 10 CONTINUE + INSTANCE_NUMBER = I + N_INSTANCES = N_INSTANCES+1 + ALLOCATE( mumps_par_array(INSTANCE_NUMBER)%PTR,stat=IERR ) + IF (IERR /= 0) THEN + WRITE(*,*) '** Allocation Error 2 in SMUMPS_F77.' + CALL MUMPS_ABORT() + ENDIF + mumps_par_array(INSTANCE_NUMBER)%PTR%KEEP(40) = 0 + mumps_par_array(INSTANCE_NUMBER)%PTR%INSTANCE_NUMBER = + & INSTANCE_NUMBER + END IF + IF ( INSTANCE_NUMBER .LE. 0 .OR. INSTANCE_NUMBER .GT. + & SMUMPS_STRUC_ARRAY_SIZE ) THEN + WRITE(*,*) ' ** Instance Error 1 in SMUMPS_F77', + & INSTANCE_NUMBER + CALL MUMPS_ABORT() + END IF + IF ( .NOT. associated ( mumps_par_array(INSTANCE_NUMBER)%PTR ) ) + & THEN + WRITE(*,*) ' Instance Error 2 in SMUMPS_F77', + & INSTANCE_NUMBER + CALL MUMPS_ABORT() + END IF + mumps_par => mumps_par_array(INSTANCE_NUMBER)%PTR + mumps_par%SYM = SYM + mumps_par%PAR = PAR + mumps_par%JOB = JOB + mumps_par%N = N + mumps_par%NZ = NZ + mumps_par%NZ_loc = NZ_loc + mumps_par%LWK_USER = LWK_USER + mumps_par%SIZE_SCHUR = SIZE_SCHUR + mumps_par%NELT= NELT + mumps_par%ICNTL(1:40)=ICNTL(1:40) + mumps_par%CNTL(1:15)=CNTL(1:15) + mumps_par%NRHS = NRHS + mumps_par%LRHS = LRHS + mumps_par%LREDRHS = LREDRHS + mumps_par%NZ_RHS = NZ_RHS + mumps_par%LSOL_loc = LSOL_loc + mumps_par%SCHUR_MLOC = SCHUR_MLOC + mumps_par%SCHUR_NLOC = SCHUR_NLOC + mumps_par%SCHUR_LLD = SCHUR_LLD + mumps_par%MBLOCK = MBLOCK + mumps_par%NBLOCK = NBLOCK + mumps_par%NPROW = NPROW + mumps_par%NPCOL = NPCOL + IF ( COMM_F77 .NE. -987654 ) THEN + mumps_par%COMM = COMM_F77 + ELSE + mumps_par%COMM = MPI_COMM_WORLD + ENDIF + CALL MPI_BCAST(NRHS,1,MPI_INTEGER,0,mumps_par%COMM,IERR) + IF ( IRNhere /= 0 ) mumps_par%IRN => IRN(1:NZ) + IF ( JCNhere /= 0 ) mumps_par%JCN => JCN(1:NZ) + IF ( Ahere /= 0 ) mumps_par%A => A(1:NZ) + IF ( IRN_lochere /= 0 ) mumps_par%IRN_loc => IRN_loc(1:NZ_loc) + IF ( JCN_lochere /= 0 ) mumps_par%JCN_loc => JCN_loc(1:NZ_loc) + IF ( A_lochere /= 0 ) mumps_par%A_loc => A_loc(1:NZ_loc) + IF ( ELTPTRhere /= 0 ) mumps_par%ELTPTR => ELTPTR(1:NELT+1) + IF ( ELTVARhere /= 0 ) mumps_par%ELTVAR => + & ELTVAR(1:ELTPTR(NELT+1)-1) + IF ( A_ELThere /= 0 ) THEN + A_ELT_SIZE = 0 + DO I = 1, NELT + Np = ELTPTR(I+1) -ELTPTR(I) + IF (SYM == 0) THEN + A_ELT_SIZE = A_ELT_SIZE + Np * Np + ELSE + A_ELT_SIZE = A_ELT_SIZE + Np * ( Np + 1 ) / 2 + END IF + END DO + mumps_par%A_ELT => A_ELT(1:A_ELT_SIZE) + END IF + IF ( PERM_INhere /= 0) mumps_par%PERM_IN => PERM_IN(1:N) + IF ( LISTVAR_SCHURhere /= 0) + & mumps_par%LISTVAR_SCHUR =>LISTVAR_SCHUR(1:SIZE_SCHUR) + IF ( SCHURhere /= 0 ) THEN + mumps_par%SCHUR_CINTERFACE=>SCHUR(1:1) + ENDIF + IF (NRHS .NE. 1) THEN + IF ( RHShere /= 0 ) mumps_par%RHS => RHS(1:NRHS*LRHS) + IF (REDRHShere /= 0)mumps_par%REDRHS=>REDRHS(1:NRHS*LREDRHS) + ELSE + IF ( RHShere /= 0 ) mumps_par%RHS => RHS(1:N) + IF (REDRHShere /= 0)mumps_par%REDRHS=>REDRHS(1:SIZE_SCHUR) + ENDIF + IF ( WK_USERhere /=0 ) THEN + IF (LWK_USER > 0 ) THEN + mumps_par%WK_USER => WK_USER(1:LWK_USER) + ELSE + mumps_par%WK_USER => WK_USER(1_8:-int(LWK_USER,8)*1000000_8) + ENDIF + ENDIF + IF ( COLSCAhere /= 0) mumps_par%COLSCA => COLSCA(1:N) + IF ( ROWSCAhere /= 0) mumps_par%ROWSCA => ROWSCA(1:N) + IF ( RHS_SPARSEhere /=0 ) mumps_par%RHS_SPARSE=> + & RHS_SPARSE(1:NZ_RHS) + IF ( IRHS_SPARSEhere /=0 ) mumps_par%IRHS_SPARSE=> + & IRHS_SPARSE(1:NZ_RHS) + IF ( SOL_lochere /=0 ) mumps_par%SOL_loc=> + & SOL_loc(1:LSOL_loc*NRHS) + IF ( ISOL_lochere /=0 ) mumps_par%ISOL_loc=> + & ISOL_loc(1:LSOL_loc) + IF ( IRHS_PTRhere /=0 ) mumps_par%IRHS_PTR=> + & IRHS_PTR(1:NRHS+1) + DO I=1,TMPDIRLEN + mumps_par%OOC_TMPDIR(I:I)=char(OOC_TMPDIR(I)) + ENDDO + DO I=TMPDIRLEN+1,OOC_TMPDIR_MAX_LENGTH + mumps_par%OOC_TMPDIR(I:I)=' ' + ENDDO + DO I=1,PREFIXLEN + mumps_par%OOC_PREFIX(I:I)=char(OOC_PREFIX(I)) + ENDDO + DO I=PREFIXLEN+1,OOC_PREFIX_MAX_LENGTH + mumps_par%OOC_PREFIX(I:I)=' ' + ENDDO + DO I=1,WRITE_PROBLEMLEN + mumps_par%WRITE_PROBLEM(I:I)=char(WRITE_PROBLEM(I)) + ENDDO + DO I=WRITE_PROBLEMLEN+1,PB_MAX_LENGTH + mumps_par%WRITE_PROBLEM(I:I)=' ' + ENDDO + CALL SMUMPS( mumps_par ) + INFO(1:40)=mumps_par%INFO(1:40) + INFOG(1:40)=mumps_par%INFOG(1:40) + RINFO(1:40)=mumps_par%RINFO(1:40) + RINFOG(1:40)=mumps_par%RINFOG(1:40) + ICNTL(1:40) = mumps_par%ICNTL(1:40) + CNTL(1:15) = mumps_par%CNTL(1:15) + SYM = mumps_par%SYM + PAR = mumps_par%PAR + JOB = mumps_par%JOB + N = mumps_par%N + NZ = mumps_par%NZ + NRHS = mumps_par%NRHS + LRHS = mumps_par%LRHS + LREDRHS = mumps_par%LREDRHS + NZ_loc = mumps_par%NZ_loc + NZ_RHS = mumps_par%NZ_RHS + LSOL_loc= mumps_par%LSOL_loc + SIZE_SCHUR = mumps_par%SIZE_SCHUR + LWK_USER = mumps_par%LWK_USER + NELT= mumps_par%NELT + DEFICIENCY = mumps_par%Deficiency + SCHUR_MLOC = mumps_par%SCHUR_MLOC + SCHUR_NLOC = mumps_par%SCHUR_NLOC + SCHUR_LLD = mumps_par%SCHUR_LLD + MBLOCK = mumps_par%MBLOCK + NBLOCK = mumps_par%NBLOCK + NPROW = mumps_par%NPROW + NPCOL = mumps_par%NPCOL + IF ( associated (mumps_par%MAPPING) ) THEN + CALL MUMPS_AFFECT_MAPPING(mumps_par%MAPPING(1)) + ELSE + CALL MUMPS_NULLIFY_C_MAPPING() + ENDIF + IF ( associated (mumps_par%PIVNUL_LIST) ) THEN + CALL MUMPS_AFFECT_PIVNUL_LIST(mumps_par%PIVNUL_LIST(1)) + ELSE + CALL MUMPS_NULLIFY_C_PIVNUL_LIST() + ENDIF + IF ( associated (mumps_par%SYM_PERM) ) THEN + CALL MUMPS_AFFECT_SYM_PERM(mumps_par%SYM_PERM(1)) + ELSE + CALL MUMPS_NULLIFY_C_SYM_PERM() + ENDIF + IF ( associated (mumps_par%UNS_PERM) ) THEN + CALL MUMPS_AFFECT_UNS_PERM(mumps_par%UNS_PERM(1)) + ELSE + CALL MUMPS_NULLIFY_C_UNS_PERM() + ENDIF + IF ( JOB == -2 ) THEN + IF (associated(mumps_par_array(INSTANCE_NUMBER)%PTR))THEN + DEALLOCATE(mumps_par_array(INSTANCE_NUMBER)%PTR) + NULLIFY (mumps_par_array(INSTANCE_NUMBER)%PTR) + N_INSTANCES = N_INSTANCES - 1 + IF ( N_INSTANCES == 0 ) THEN + DEALLOCATE(mumps_par_array) + SMUMPS_STRUC_ARRAY_SIZE = 0 + END IF + ELSE + WRITE(*,*) "** Warning: instance already freed" + WRITE(*,*) " this should normally not happen." + ENDIF + END IF + RETURN + END SUBROUTINE SMUMPS_F77 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part4.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part4.F new file mode 100644 index 000000000..17ad0bba1 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part4.F @@ -0,0 +1,6846 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE SMUMPS_246(MYID, N, STEP, FRERE, FILS, + & NA, LNA, NE, DAD, ND, PROCNODE, SLAVEF, + & NRLADU, NIRADU, NIRNEC, NRLNEC, + & NRLNEC_ACTIVE, + & NIRADU_OOC, NIRNEC_OOC, + & MAXFR, OPSA, + & KEEP,KEEP8, LOCAL_M, LOCAL_N, SBUF_RECOLD, + & SBUF_SEND, SBUF_REC, OPS_SUBTREE, NSTEPS, + & I_AM_CAND,NMB_PAR2, ISTEP_TO_INIV2, CANDIDATES, + & IFLAG, IERROR + & ,MAX_FRONT_SURFACE_LOCAL + & ,MAX_SIZE_FACTOR, ENTRIES_IN_FACTORS_LOC + & ,ENTRIES_IN_FACTORS_LOC_MASTERS + & ) + IMPLICIT NONE + INTEGER MYID, N, LNA, IFLAG, IERROR + INTEGER NIRADU, NIRNEC + INTEGER(8) NRLADU, NRLNEC, NRLNEC_ACTIVE + INTEGER(8) NRLADU_CURRENT, NRLADU_ROOT_3 + INTEGER NIRADU_OOC, NIRNEC_OOC + INTEGER MAXFR, NSTEPS + INTEGER(8) MAX_FRONT_SURFACE_LOCAL + INTEGER STEP(N) + INTEGER FRERE(NSTEPS), FILS(N), NA(LNA), NE(NSTEPS), + & ND(NSTEPS), PROCNODE(NSTEPS), DAD(NSTEPS) + INTEGER SLAVEF, KEEP(500), LOCAL_M, LOCAL_N + INTEGER(8) KEEP8(150) + INTEGER(8) ENTRIES_IN_FACTORS_LOC, + & ENTRIES_IN_FACTORS_LOC_MASTERS + INTEGER SBUF_SEND, SBUF_REC + INTEGER(8) SBUF_RECOLD + INTEGER NMB_PAR2 + INTEGER ISTEP_TO_INIV2( KEEP(71) ) + LOGICAL I_AM_CAND(NMB_PAR2) + INTEGER CANDIDATES( SLAVEF+1, NMB_PAR2 ) + REAL OPSA + DOUBLE PRECISION OPSA_LOC + INTEGER(8) MAX_SIZE_FACTOR + REAL OPS_SUBTREE + DOUBLE PRECISION OPS_SBTR_LOC + INTEGER, ALLOCATABLE, DIMENSION(:) :: TNSTK, IPOOL, LSTKI + INTEGER(8), ALLOCATABLE, DIMENSION(:) :: LSTKR + INTEGER(8) SBUFS_CB, SBUFR_CB + INTEGER SBUFR, SBUFS + INTEGER BLOCKING_RHS + INTEGER ITOP,NELIM,NFR + INTEGER(8) ISTKR, LSTK + INTEGER ISTKI, STKI, ISTKI_OOC + INTEGER K,NSTK, IFATH + INTEGER INODE, LEAF, NBROOT, IN + INTEGER LEVEL, MAXITEMPCB + INTEGER(8) CURRENT_ACTIVE_MEM, MAXTEMPCB + LOGICAL UPDATE, UPDATEF, MASTER, MASTERF, INSSARBR + INTEGER LEVELF, NCB, SIZECBI + INTEGER(8) NCB8 + INTEGER(8) NFR8, NELIM8 + INTEGER(8) SIZECB, SIZECBINFR, SIZECB_SLAVE + INTEGER SIZEHEADER, SIZEHEADER_OOC, XSIZE_OOC + INTEGER EXTRA_PERM_INFO_OOC + INTEGER NBROWMAX, NSLAVES_LOC, NSLAVES_PASSED, + & NELIMF, NFRF, NCBF, + & NBROWMAXF, LKJIB, + & LKJIBT, NBR, NBCOLFAC + INTEGER(8) LEV3MAXREC, CBMAXR, CBMAXS + INTEGER ALLOCOK + INTEGER PANEL_SIZE + LOGICAL COMPRESSCB + DOUBLE PRECISION OPS_NODE, OPS_NODE_MASTER, OPS_NODE_SLAVE + INTEGER(8) ENTRIES_NODE_UPPER_PART, ENTRIES_NODE_LOWER_PART + INCLUDE 'mumps_headers.h' + INTEGER WHAT + INTEGER(8) IDUMMY8 + INTRINSIC min, int, real + INTEGER SMUMPS_748 + EXTERNAL SMUMPS_748 + INTEGER MUMPS_275, MUMPS_330 + LOGICAL MUMPS_170 + INTEGER MUMPS_52 + EXTERNAL MUMPS_503, MUMPS_52 + EXTERNAL MUMPS_275, MUMPS_330, + & MUMPS_170 + logical :: FORCE_CAND, CONCERNED, UPDATES, STACKCB, MASTERSON + integer :: IFSON, LEVELSON + IF (KEEP(50).eq.2) THEN + EXTRA_PERM_INFO_OOC = 1 + ELSE IF (KEEP(50).eq.0) THEN + EXTRA_PERM_INFO_OOC = 2 + ELSE + EXTRA_PERM_INFO_OOC = 0 + ENDIF + COMPRESSCB=( KEEP(215).EQ.0 .AND. KEEP(50).NE.0 ) + MAX_FRONT_SURFACE_LOCAL=0_8 + MAX_SIZE_FACTOR=0_8 + ALLOCATE( LSTKR(NSTEPS), TNSTK(NSTEPS), IPOOL(NSTEPS), + & LSTKI(NSTEPS) , stat=ALLOCOK) + if (ALLOCOK .GT. 0) THEN + IFLAG =-7 + IERROR = 4*NSTEPS + RETURN + endif + LKJIB = max(KEEP(5),KEEP(6)) + TNSTK = NE + LEAF = NA(1)+1 + IPOOL(1:LEAF-1) = NA(3:3+LEAF-2) + NBROOT = NA(2) +#if defined(OLD_OOC_NOPANEL) + XSIZE_OOC=XSIZE_OOC_NOPANEL +#else + IF (KEEP(50).EQ.0) THEN + XSIZE_OOC=XSIZE_OOC_UNSYM + ELSE + XSIZE_OOC=XSIZE_OOC_SYM + ENDIF +#endif + SIZEHEADER_OOC = XSIZE_OOC+6 + SIZEHEADER = XSIZE_IC + 6 + ISTKR = 0_8 + ISTKI = 0 + ISTKI_OOC = 0 + OPSA_LOC = dble(0.0E0) + ENTRIES_IN_FACTORS_LOC = 0_8 + ENTRIES_IN_FACTORS_LOC_MASTERS = 0_8 + OPS_SBTR_LOC = dble(0.0E0) + NRLADU = 0_8 + NIRADU = 0 + NIRADU_OOC = 0 + NRLADU_CURRENT = 0_8 + NRLADU_ROOT_3 = 0_8 + NRLNEC_ACTIVE = 0_8 + NRLNEC = 0_8 + NIRNEC = 0 + NIRNEC_OOC = 0 + MAXFR = 0 + ITOP = 0 + MAXTEMPCB = 0_8 + MAXITEMPCB = 0 + SBUFS_CB = 1_8 + SBUFS = 1 + SBUFR_CB = 1_8 + SBUFR = 1 + IF (KEEP(38) .NE. 0 .AND. KEEP(60).EQ.0) THEN + INODE = KEEP(38) + NRLADU_ROOT_3 = int(LOCAL_M,8)*int(LOCAL_N,8) + NRLADU = NRLADU_ROOT_3 + NRLNEC_ACTIVE = NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_ROOT_3) + NRLNEC = NRLADU + IF (MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + & .EQ. MYID) THEN + NIRADU = SIZEHEADER+2*(ND(STEP(INODE))+KEEP(253)) + NIRADU_OOC = SIZEHEADER_OOC+2*(ND(STEP(INODE))+KEEP(253)) + ELSE + NIRADU = SIZEHEADER + NIRADU_OOC = SIZEHEADER_OOC + ENDIF + NIRNEC = NIRADU + NIRNEC_OOC = NIRADU_OOC + ENDIF + IF((KEEP(24).eq.0).OR.(KEEP(24).eq.1)) THEN + FORCE_CAND=.FALSE. + ELSE + FORCE_CAND=(mod(KEEP(24),2).eq.0) + END IF + 90 CONTINUE + IF (LEAF.NE.1) THEN + LEAF = LEAF - 1 + INODE = IPOOL(LEAF) + ELSE + WRITE(MYID+6,*) ' ERROR 1 in SMUMPS_246 ' + CALL MUMPS_ABORT() + ENDIF + 95 CONTINUE + NFR = ND(STEP(INODE))+KEEP(253) + NFR8 = int(NFR,8) + NSTK = NE(STEP(INODE)) + NELIM = 0 + IN = INODE + 100 NELIM = NELIM + 1 + NELIM8=int(NELIM,8) + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 100 + IFSON = -IN + IFATH = DAD(STEP(INODE)) + MASTER = MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + & .EQ. MYID + LEVEL = MUMPS_330(PROCNODE(STEP(INODE)),SLAVEF) + INSSARBR = MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF) + UPDATE=.FALSE. + if(.NOT.FORCE_CAND) then + UPDATE = ( (MASTER.AND.(LEVEL.NE.3) ).OR. LEVEL.EQ.2 ) + else + if(MASTER.and.(LEVEL.ne.3)) then + UPDATE = .TRUE. + else if(LEVEL.eq.2) then + if ( I_AM_CAND(ISTEP_TO_INIV2(STEP(INODE)))) THEN + UPDATE = .TRUE. + end if + end if + end if + NCB = NFR-NELIM + NCB8 = int(NCB,8) + SIZECBINFR = NCB8*NCB8 + IF (KEEP(50).EQ.0) THEN + SIZECB = SIZECBINFR + ELSE + IFATH = DAD(STEP(INODE)) + IF ( IFATH.NE.KEEP(38) .AND. COMPRESSCB ) THEN + SIZECB = (NCB8*(NCB8+1_8))/2_8 + ELSE + SIZECB = SIZECBINFR + ENDIF + ENDIF + SIZECBI = 2* NCB + SIZEHEADER + IF (LEVEL.NE.2) THEN + NSLAVES_LOC = -99999999 + SIZECB_SLAVE = -99999997_8 + NBROWMAX = NCB + ELSE + IF (KEEP(48) .EQ. 5) THEN + WHAT = 5 + IF (FORCE_CAND) THEN + NSLAVES_LOC=CANDIDATES(SLAVEF+1, + & ISTEP_TO_INIV2(STEP(INODE))) + ELSE + NSLAVES_LOC=SLAVEF-1 + ENDIF + NSLAVES_PASSED=NSLAVES_LOC + ELSE + WHAT = 2 + NSLAVES_PASSED=SLAVEF + NSLAVES_LOC =SLAVEF-1 + ENDIF + CALL MUMPS_503(WHAT, KEEP,KEEP8, + & NCB, NFR, NSLAVES_PASSED, NBROWMAX, SIZECB_SLAVE + & ) + ENDIF + IF (KEEP(60).GT.1) THEN + IF (MASTER .AND. INODE.EQ.KEEP(38)) THEN + NIRADU = NIRADU+SIZEHEADER+2*(ND(STEP(INODE))+KEEP(253)) + NIRADU_OOC = NIRADU_OOC+SIZEHEADER_OOC+ + & 2*(ND(STEP(INODE))+KEEP(253)) + ENDIF + ENDIF + IF (LEVEL.EQ.3) THEN + IF ( + & KEEP(60).LE.1 + & ) THEN + NRLNEC = max(NRLNEC,NRLADU+ISTKR+ + & int(LOCAL_M,8)*int(LOCAL_N,8)) + NRLADU_CURRENT = int(LOCAL_M,8)*int(LOCAL_N,8) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_ROOT_3 + + & NRLADU_CURRENT+ISTKR) + ENDIF + IF (MASTER) THEN + IF (NFR.GT.MAXFR) MAXFR = NFR + ENDIF + ENDIF + IF(KEEP(86).EQ.1)THEN + IF(MASTER.AND.(.NOT.MUMPS_170( + & PROCNODE(STEP(INODE)), SLAVEF)) + & )THEN + IF(LEVEL.EQ.1)THEN + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NFR8*NFR8) + ELSEIF(LEVEL.EQ.2)THEN + IF(KEEP(50).EQ.0)THEN + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NFR8*NELIM8) + ELSE + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NELIM8*NELIM8) + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NELIM8*(NELIM8+1_8)) + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + IF (LEVEL.EQ.2) THEN + IF (MASTER) THEN + IF (KEEP(50).EQ.0) THEN + SBUFS = max(SBUFS, NFR*LKJIB+LKJIB+4) + ELSE + SBUFS = max(SBUFS, NELIM*LKJIB+NELIM+6) + ENDIF + ELSEIF (UPDATE) THEN + if (KEEP(50).EQ.0) THEN + SBUFR = max(SBUFR, NFR*LKJIB+LKJIB+4) + else + SBUFR = max( SBUFR, NELIM*LKJIB+NELIM+6 ) + IF (KEEP(50).EQ.1) THEN + LKJIBT = LKJIB + ELSE + LKJIBT = min( NELIM, LKJIB * 2 ) + ENDIF + SBUFS = max(SBUFS, + & LKJIBT*NBROWMAX+6) + SBUFR = max( SBUFR, NBROWMAX*LKJIBT+6 ) + endif + ENDIF + ENDIF + IF ( UPDATE ) THEN + IF ( (MASTER) .AND. (LEVEL.EQ.1) ) THEN + NIRADU = NIRADU + 2*NFR + SIZEHEADER + NIRADU_OOC = NIRADU_OOC + 2*NFR + SIZEHEADER_OOC + PANEL_SIZE = SMUMPS_748( + & 2_8*int(KEEP(226),8), NFR, KEEP(227), KEEP(50)) + NIRADU_OOC = NIRADU_OOC + + & EXTRA_PERM_INFO_OOC*(2+NELIM + NELIM/PANEL_SIZE+1) + IF (KEEP(50).EQ.0) THEN + NRLADU_CURRENT = int(NELIM,8)*int(2*NFR-NELIM,8) + NRLADU = NRLADU + NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + ELSE + NRLADU_CURRENT = int(NELIM,8)*int(NFR,8) + NRLADU = NRLADU + NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + ENDIF + SIZECBI = 2* NCB + 6 + 3 + ELSEIF (LEVEL.EQ.2) THEN + IF (MASTER) THEN + NIRADU = NIRADU+SIZEHEADER +SLAVEF-1+2*NFR + NIRADU_OOC = NIRADU_OOC+SIZEHEADER_OOC +SLAVEF-1+2*NFR + IF (KEEP(50).EQ.0) THEN + NBCOLFAC=NFR + ELSE + NBCOLFAC=NELIM + ENDIF + PANEL_SIZE = SMUMPS_748( + & 2_8*int(KEEP(226),8), NBCOLFAC, KEEP(227), KEEP(50)) + NIRADU_OOC = NIRADU_OOC + + & EXTRA_PERM_INFO_OOC*(2+NELIM + NELIM/PANEL_SIZE+1) + NRLADU_CURRENT = int(NBCOLFAC,8)*int(NELIM,8) + NRLADU = NRLADU + NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + SIZECB = 0_8 + SIZECBINFR = 0_8 + SIZECBI = NCB + 5 + SLAVEF - 1 + ELSE + SIZECB=SIZECB_SLAVE + SIZECBINFR = SIZECB + NIRADU = NIRADU+4+NELIM+NBROWMAX + NIRADU_OOC = NIRADU_OOC+4+NELIM+NBROWMAX + IF (KEEP(50).EQ.0) THEN + NRLADU = NRLADU + int(NELIM,8)*int(NBROWMAX,8) + ELSE + NRLADU = NRLADU + int(NELIM,8)*int(NCB/NSLAVES_LOC,8) + ENDIF + NRLADU_CURRENT = int(NELIM,8)*int(NBROWMAX,8) + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + SIZECBI = 4 + NBROWMAX + NCB + IF (KEEP(50).NE.0) THEN + SIZECBI=SIZECBI+NSLAVES_LOC+ + & XTRA_SLAVES_SYM + ELSE + SIZECBI=SIZECBI+NSLAVES_LOC+ + & XTRA_SLAVES_UNSYM + ENDIF + ENDIF + ENDIF + NIRNEC = max0(NIRNEC, + & NIRADU+ISTKI+SIZECBI+MAXITEMPCB) + NIRNEC_OOC = max0(NIRNEC_OOC, + & NIRADU_OOC+ISTKI_OOC+SIZECBI+MAXITEMPCB + + & (XSIZE_OOC-XSIZE_IC) ) + CURRENT_ACTIVE_MEM = ISTKR+SIZECBINFR + IF (NSTK .NE. 0 .AND. INSSARBR .AND. + & KEEP(234).NE.0 .AND. KEEP(55).EQ.0) THEN + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM - LSTKR(ITOP) + ENDIF + IF (KEEP(50).NE.0.AND.UPDATE.AND.LEVEL.EQ.1) THEN + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM + + & int(NELIM,8)*int(NCB,8) + ENDIF + IF (MASTER .AND. KEEP(219).NE.0.AND. + & KEEP(50).EQ.2.AND.LEVEL.EQ.2) THEN + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM + int(NELIM,8) + ENDIF + IF (SLAVEF.EQ.1) THEN + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM) + ELSE + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+MAXTEMPCB) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM+MAXTEMPCB) + ENDIF + IF (NFR.GT.MAXFR) MAXFR = NFR + IF (NSTK.GT.0) THEN + DO 70 K=1,NSTK + LSTK = LSTKR(ITOP) + ISTKR = ISTKR - LSTK + IF (K==1 .AND. INSSARBR.AND.KEEP(234).NE.0 + & .AND.KEEP(55).EQ.0) THEN + ELSE + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM - LSTK + ENDIF + STKI = LSTKI( ITOP ) + ISTKI = ISTKI - STKI + ISTKI_OOC = ISTKI_OOC - STKI - (XSIZE_OOC-XSIZE_IC) + ITOP = ITOP - 1 + IF (ITOP.LT.0) THEN + write(*,*) MYID, + & ': ERROR 2 in SMUMPS_246. ITOP = ',ITOP + CALL MUMPS_ABORT() + ENDIF + 70 CONTINUE + ENDIF + ELSE IF (LEVEL.NE.3) THEN + DO WHILE (IFSON.GT.0) + UPDATES=.FALSE. + MASTERSON = MUMPS_275(PROCNODE(STEP(IFSON)),SLAVEF) + & .EQ.MYID + LEVELSON = MUMPS_330(PROCNODE(STEP(IFSON)),SLAVEF) + if(.NOT.FORCE_CAND) then + UPDATES =((MASTERSON.AND.(LEVELSON.NE.3)).OR. + & LEVELSON.EQ.2) + else + if(MASTERSON.and.(LEVELSON.ne.3)) then + UPDATES = .TRUE. + else if(LEVELSON.eq.2) then + if ( I_AM_CAND(ISTEP_TO_INIV2(STEP(IFSON)))) then + UPDATES = .TRUE. + end if + end if + end if + IF (UPDATES) THEN + LSTK = LSTKR(ITOP) + ISTKR = ISTKR - LSTK + STKI = LSTKI( ITOP ) + ISTKI = ISTKI - STKI + ISTKI_OOC = ISTKI_OOC - STKI - (XSIZE_OOC-XSIZE_IC) + ITOP = ITOP - 1 + IF (ITOP.LT.0) THEN + write(*,*) MYID, + & ': ERROR 2 in SMUMPS_246. ITOP = ',ITOP + CALL MUMPS_ABORT() + ENDIF + ENDIF + IFSON = FRERE(STEP(IFSON)) + END DO + ENDIF + IF ( + & ( (INODE.NE.KEEP(20)).OR.(KEEP(60).EQ.0) ) + & .AND. + & ( (INODE.NE.KEEP(38)).OR.(KEEP(60).LE.1) ) + & ) + &THEN + ENTRIES_NODE_LOWER_PART = int(NFR-NELIM,8) * int(NELIM,8) + IF ( KEEP(50).EQ.0 ) THEN + ENTRIES_NODE_UPPER_PART = int(NFR,8) * int(NELIM,8) + ELSE + ENTRIES_NODE_UPPER_PART = + & (int(NELIM,8)*int(NELIM+1,8))/2_8 + ENDIF + IF (KEEP(50).EQ.2 .AND. LEVEL.EQ.3) THEN + CALL MUMPS_511(NFR, + & NELIM, NELIM,0, + & 1,OPS_NODE) + ELSE + CALL MUMPS_511(NFR, + & NELIM, NELIM,KEEP(50), + & 1,OPS_NODE) + ENDIF + IF (LEVEL.EQ.2) THEN + CALL MUMPS_511(NFR, + & NELIM, NELIM,KEEP(50), + & 2,OPS_NODE_MASTER) + OPS_NODE_SLAVE=OPS_NODE-OPS_NODE_MASTER + ENDIF + ELSE + OPS_NODE = 0.0D0 + ENTRIES_NODE_UPPER_PART = 0_8 + ENTRIES_NODE_LOWER_PART = 0_8 + ENDIF + IF ( MASTER ) + & ENTRIES_IN_FACTORS_LOC_MASTERS = + & ENTRIES_IN_FACTORS_LOC_MASTERS + + & ENTRIES_NODE_UPPER_PART + + & ENTRIES_NODE_LOWER_PART + IF (UPDATE.OR.LEVEL.EQ.3) THEN + IF ( LEVEL .EQ. 3 ) THEN + OPSA_LOC = OPSA_LOC + OPS_NODE / dble( SLAVEF ) + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & ENTRIES_NODE_UPPER_PART / + & int(SLAVEF,8) + IF (MASTER) + & ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & mod(ENTRIES_NODE_UPPER_PART, + & int(SLAVEF,8)) + ELSE IF (MASTER .AND. LEVEL.EQ.2) THEN + OPSA_LOC = OPSA_LOC + OPS_NODE_MASTER + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & ENTRIES_NODE_UPPER_PART + + & mod(ENTRIES_NODE_LOWER_PART, + & int(NSLAVES_LOC,8)) + ELSE IF (MASTER .AND. LEVEL.EQ.1) THEN + OPSA_LOC = OPSA_LOC + dble(OPS_NODE) + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & ENTRIES_NODE_UPPER_PART + + & ENTRIES_NODE_LOWER_PART + ELSE IF (UPDATE) THEN + OPSA_LOC = OPSA_LOC + + & dble(OPS_NODE_SLAVE)/dble(NSLAVES_LOC) + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + & + ENTRIES_NODE_LOWER_PART / + & int(NSLAVES_LOC,8) + ENDIF + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF) .OR. NE(STEP(INODE))==0) THEN + IF (LEVEL == 1) THEN + OPS_SBTR_LOC = OPS_SBTR_LOC + OPS_NODE + ELSE + CALL MUMPS_511(NFR, + & NELIM, NELIM,KEEP(50), + & 1,OPS_NODE) + OPS_SBTR_LOC = OPS_SBTR_LOC + OPS_NODE + ENDIF + ENDIF + ENDIF + IF (IFATH .EQ. 0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 115 + GOTO 90 + ELSE + NFRF = ND(STEP(IFATH))+KEEP(253) + IF (DAD(STEP(IFATH)).EQ.0) THEN + NELIMF = NFRF + ELSE + NELIMF = 0 + IN = IFATH + DO WHILE (IN.GT.0) + IN = FILS(IN) + NELIMF = NELIMF+1 + ENDDO + ENDIF + NCBF = NFRF - NELIMF + LEVELF = MUMPS_330(PROCNODE(STEP(IFATH)),SLAVEF) + MASTERF= MUMPS_275(PROCNODE(STEP(IFATH)),SLAVEF).EQ.MYID + UPDATEF= .FALSE. + if(.NOT.FORCE_CAND) then + UPDATEF= ((MASTERF.AND.(LEVELF.NE.3)).OR.LEVELF.EQ.2) + else + if(MASTERF.and.(LEVELF.ne.3)) then + UPDATEF = .TRUE. + else if (LEVELF.eq.2) then + if ( I_AM_CAND(ISTEP_TO_INIV2(STEP(IFATH)))) THEN + UPDATEF = .TRUE. + end if + end if + end if + CONCERNED = UPDATEF .OR. UPDATE + IF (LEVELF .NE. 2) THEN + NBROWMAXF = -999999 + ELSE + IF (KEEP(48) .EQ. 5) THEN + WHAT = 4 + IF (FORCE_CAND) THEN + NSLAVES_LOC=CANDIDATES(SLAVEF+1, + & ISTEP_TO_INIV2(STEP(IFATH))) + ELSE + NSLAVES_LOC=SLAVEF-1 + ENDIF + ELSE + WHAT = 1 + NSLAVES_LOC=SLAVEF + ENDIF + CALL MUMPS_503( WHAT, KEEP, KEEP8, + & NCBF, NFRF, NSLAVES_LOC, NBROWMAXF, IDUMMY8 + & ) + ENDIF + IF(LEVEL.EQ.1.AND.UPDATE.AND. + & (UPDATEF.OR.LEVELF.EQ.2) + & .AND.LEVELF.NE.3) THEN + IF ( INSSARBR .AND. KEEP(234).NE.0) THEN + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM) + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM) + ELSE + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM+SIZECB) + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+SIZECB) + ENDIF + ENDIF + IF (UPDATE .AND. LEVEL.EQ.2 .AND. .NOT. MASTER) THEN + NRLNEC = + & max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+NRLADU_CURRENT) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,2_8*NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM) + ENDIF + IF (LEVELF.EQ.3) THEN + IF (LEVEL.EQ.1) THEN + LEV3MAXREC = int(min(NCB,LOCAL_M),8) * + & int(min(NCB,LOCAL_N),8) + ELSE + LEV3MAXREC = min(SIZECB, + & int(min(NBROWMAX,LOCAL_M),8) + & *int(min(NCB,LOCAL_N),8)) + ENDIF + MAXTEMPCB = max(MAXTEMPCB, LEV3MAXREC) + MAXITEMPCB = max(MAXITEMPCB,SIZECBI+SIZEHEADER) + SBUFR_CB = max(SBUFR_CB, LEV3MAXREC+int(SIZECBI,8)) + NIRNEC = max(NIRNEC,NIRADU+ISTKI+ + & min(NCB,LOCAL_M)+ min(NCB,LOCAL_N)+SIZEHEADER) + NIRNEC_OOC = max(NIRNEC_OOC,NIRADU_OOC+ISTKI_OOC+ + & min(NCB,LOCAL_M)+ min(NCB,LOCAL_N)+SIZEHEADER) + ENDIF + IF (CONCERNED) THEN + IF (LEVELF.EQ.2) THEN + IF (UPDATE.AND.(LEVEL.NE.2.OR..NOT.MASTER)) THEN + IF(MASTERF)THEN + NBR = min(NBROWMAXF,NBROWMAX) + ELSE + NBR = min(max(NELIMF,NBROWMAXF),NBROWMAX) + ENDIF + IF (KEEP(50).EQ.0) THEN + CBMAXS = int(NBR,8)*int(NCB,8) + ELSE + CBMAXS = int(NBR,8)*int(NCB,8) - + & (int(NBR,8)*int(NBR-1,8))/2_8 + ENDIF + ELSE + CBMAXS = 0_8 + END IF + IF (MASTERF) THEN + IF (LEVEL.EQ.1) THEN + IF (.NOT.UPDATE) THEN + NBR = min(NELIMF, NCB) + ELSE + NBR = 0 + ENDIF + ELSE + NBR = min(NELIMF, NBROWMAX) + ENDIF + IF (KEEP(50).EQ.0) THEN + CBMAXR = int(NBR,8)*NCB8 + ELSE + CBMAXR = int(NBR,8)*int(min(NCB,NELIMF),8)- + & (int(NBR,8)*int(NBR-1,8))/2_8 + CBMAXR = min(CBMAXR, int(NELIMF,8)*int(NELIMF+1,8)/2_8) + CBMAXR = min(CBMAXR, SIZECB) + IF ((LEVEL.EQ.1).AND.(.NOT. COMPRESSCB)) THEN + CBMAXR = min(CBMAXR,(NCB8*(NCB8+1_8))/2_8) + ENDIF + ENDIF + ELSE IF (UPDATEF) THEN + NBR = min(NBROWMAXF,NBROWMAX) + CBMAXR = int(NBR,8) * NCB8 + IF (KEEP(50).NE.0) THEN + CBMAXR = CBMAXR - (int(NBR,8)*(int(NBR-1,8)))/2_8 + ENDIF + ELSE + CBMAXR = 0_8 + ENDIF + ELSEIF (LEVELF.EQ.3) THEN + CBMAXR = LEV3MAXREC + IF (UPDATE.AND. .NOT. (MASTER.AND.LEVEL.EQ.2)) THEN + CBMAXS = LEV3MAXREC + ELSE + CBMAXS = 0_8 + ENDIF + ELSE + IF (MASTERF) THEN + CBMAXS = 0_8 + NBR = min(NFRF,NBROWMAX) + IF ((LEVEL.EQ.1).AND.UPDATE) THEN + NBR = 0 + ENDIF + CBMAXR = int(NBR,8)*int(min(NFRF,NCB),8) + IF (LEVEL.EQ.2) + & CBMAXR = min(CBMAXR, SIZECB_SLAVE) + IF ( KEEP(50).NE.0 ) THEN + CBMAXR = min(CBMAXR,(int(NFRF,8)*int(NFRF+1,8))/2_8) + ELSE + CBMAXR = min(CBMAXR,int(NFRF,8)*int(NFRF,8)) + ENDIF + ELSE + CBMAXR = 0_8 + CBMAXS = SIZECB + ENDIF + ENDIF + IF (UPDATE) THEN + CBMAXS = min(CBMAXS, SIZECB) + IF ( .not. ( LEVELF .eq. 1 .AND. UPDATEF ) )THEN + SBUFS_CB = max(SBUFS_CB, CBMAXS+int(SIZECBI,8)) + ENDIF + ENDIF + STACKCB = .FALSE. + IF (UPDATEF) THEN + STACKCB = .TRUE. + SIZECBI = 2 * NFR + SIZEHEADER + IF (LEVEL.EQ.1) THEN + IF (KEEP(50).NE.0.AND.LEVELF.NE.3 + & .AND.COMPRESSCB) THEN + SIZECB = (NCB8*(NCB8+1_8))/2_8 + ELSE + SIZECB = NCB8*NCB8 + ENDIF + IF (MASTER) THEN + SIZECBI = 2+ XSIZE_IC + ELSE IF (LEVELF.EQ.1) THEN + SIZECB = min(CBMAXR,SIZECB) + SIZECBI = 2 * NCB + 9 + SBUFR_CB = max(SBUFR_CB, int(SIZECBI,8)+SIZECB) + SIZECBI = 2 * NCB + SIZEHEADER + ELSE + SIZECBI = 2 * NCB + 9 + SBUFR_CB = max(SBUFR_CB, + & min(SIZECB,CBMAXR) + int(SIZECBI,8)) + MAXTEMPCB = max(MAXTEMPCB, min(SIZECB,CBMAXR)) + SIZECBI = 2 * NCB + SIZEHEADER + MAXITEMPCB = max(MAXITEMPCB, SIZECBI) + SIZECBI = 0 + SIZECB = 0_8 + ENDIF + ELSE + SIZECB = SIZECB_SLAVE + MAXTEMPCB = max(MAXTEMPCB, min(CBMAXR,SIZECB) ) + MAXITEMPCB = max(MAXITEMPCB,NBROWMAX+NCB+SIZEHEADER) + IF (.NOT. + & (UPDATE.AND.(.NOT.MASTER).AND.(NSLAVES_LOC.EQ.1)) + & ) + & SBUFR_CB = max(SBUFR_CB, + & min(CBMAXR,SIZECB) + int(NBROWMAX + NCB + 6,8)) + IF (MASTER) THEN + SIZECBI = NCB + 5 + SLAVEF - 1 + XSIZE_IC + SIZECB = 0_8 + ELSE IF (UPDATE) THEN + SIZECBI = NFR + 6 + SLAVEF - 1 + XSIZE_IC + IF (KEEP(50).EQ.0) THEN + SIZECBI = SIZECBI + NBROWMAX + NFR + + & SIZEHEADER + ELSE + SIZECBI = SIZECBI + NBROWMAX + NFR + + & SIZEHEADER+ NSLAVES_LOC + ENDIF + ELSE + SIZECB = 0_8 + SIZECBI = 0 + ENDIF + ENDIF + ELSE + IF (LEVELF.NE.3) THEN + STACKCB = .TRUE. + SIZECB = 0_8 + SIZECBI = 0 + IF ( (LEVEL.EQ.1) .AND. (LEVELF.NE.1) ) THEN + IF (COMPRESSCB) THEN + SIZECB = (NCB8*(NCB8+1_8))/2_8 + ELSE + SIZECB = NCB8*NCB8 + ENDIF + SIZECBI = 2 * NCB + SIZEHEADER + ELSE IF (LEVEL.EQ.2) THEN + IF (MASTER) THEN + SIZECBI = NCB + 5 + SLAVEF - 1 + XSIZE_IC + ELSE + SIZECB = SIZECB_SLAVE + SIZECBI = SIZECBI + NBROWMAX + NFR + SIZEHEADER + ENDIF + ENDIF + ENDIF + ENDIF + IF (STACKCB) THEN + IF (FRERE(STEP(INODE)).EQ.0) THEN + write(*,*) ' ERROR 3 in SMUMPS_246' + CALL MUMPS_ABORT() + ENDIF + ITOP = ITOP + 1 + IF ( ITOP .GT. NSTEPS ) THEN + WRITE(*,*) 'ERROR 4 in SMUMPS_246 ' + ENDIF + LSTKI(ITOP) = SIZECBI + ISTKI=ISTKI + SIZECBI + ISTKI_OOC = ISTKI_OOC + SIZECBI + (XSIZE_OOC-XSIZE_IC) + LSTKR(ITOP) = SIZECB + ISTKR = ISTKR + LSTKR(ITOP) + NRLNEC = max(NRLNEC,NRLADU+ISTKR+MAXTEMPCB) + NIRNEC = max0(NIRNEC,NIRADU+ISTKI+MAXITEMPCB) + NIRNEC_OOC = max0(NIRNEC_OOC,NIRADU_OOC+ISTKI_OOC+ + & MAXITEMPCB + + & (XSIZE_OOC-XSIZE_IC) ) + ENDIF + ENDIF + TNSTK(STEP(IFATH)) = TNSTK(STEP(IFATH)) - 1 + IF ( TNSTK(STEP(IFATH)) .EQ. 0 ) THEN + INODE = IFATH + GOTO 95 + ELSE + GOTO 90 + ENDIF + ENDIF + 115 CONTINUE + BLOCKING_RHS = KEEP(84) + IF (KEEP(84).EQ.0) BLOCKING_RHS=1 + NRLNEC = max(NRLNEC, + & NRLADU+int(4*KEEP(127)*abs(BLOCKING_RHS),8)) + IF (BLOCKING_RHS .LT. 0) THEN + BLOCKING_RHS = - 2 * BLOCKING_RHS + ENDIF + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE, MAX_SIZE_FACTOR+ + & int(4*KEEP(127)*BLOCKING_RHS,8)) + SBUF_RECOLD = max(int(SBUFR,8),SBUFR_CB) + SBUF_RECOLD = max(SBUF_RECOLD, + & MAXTEMPCB+int(MAXITEMPCB,8)) + 10_8 + SBUF_REC = max(SBUFR, int(min(100000_8,SBUFR_CB))) + SBUF_REC = SBUF_REC + 17 + SBUF_REC = SBUF_REC + 2 * KEEP(127) + SLAVEF - 1 + 7 + SBUF_SEND = max(SBUFS, int(min(100000_8,SBUFR_CB))) + SBUF_SEND = SBUF_SEND + 17 + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN + SBUF_RECOLD = SBUF_RECOLD+int(KEEP(108)+1,8) + SBUF_REC = SBUF_REC+KEEP(108)+1 + SBUF_SEND = SBUF_SEND+KEEP(108)+1 + ENDIF + IF (SLAVEF.EQ.1) THEN + SBUF_RECOLD = 1_8 + SBUF_REC = 1 + SBUF_SEND= 1 + ENDIF + DEALLOCATE( LSTKR, TNSTK, IPOOL, + & LSTKI ) + OPS_SUBTREE = real(OPS_SBTR_LOC) + OPSA = real(OPSA_LOC) + KEEP(66) = int(OPSA_LOC/1000000.d0) + RETURN + END SUBROUTINE SMUMPS_246 + RECURSIVE SUBROUTINE + & SMUMPS_271( COMM_LOAD, ASS_IRECV, + & INODE, NELIM_ROOT, root, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mpif.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER KEEP(500), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER INODE, NELIM_ROOT + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS(KEEP(28)) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER INTARR(max(1,KEEP(14))) + REAL DBLARR(max(1,KEEP(13))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mumps_tags.h' + INTEGER I, LCONT, NCOL_TO_SEND, LDA + INTEGER(8) :: SHIFT_VAL_SON, POSELT + INTEGER FPERE, IOLDPS, NFRONT, NPIV, NASS, NSLAVES, + & H_INODE, NELIM, NBCOL, LIST_NELIM_ROW, + & LIST_NELIM_COL, NELIM_LOCAL, TYPE_SON, + & NROW, NCOL, NBROW, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON, LDAFS, IERR, + & STATUS( MPI_STATUS_SIZE ), ISON, PDEST_MASTER_ISON + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER MSGSOU, MSGTAG + LOGICAL INVERT + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275, MUMPS_330 + EXTERNAL MUMPS_275, MUMPS_330 + FPERE = KEEP(38) + TYPE_SON = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF ( MUMPS_275( PROCNODE_STEPS(STEP(INODE)), + & SLAVEF ).EQ.MYID) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + H_INODE = 6 + NSLAVES + KEEP(IXSZ) + NELIM = NASS - NPIV + NBCOL = NFRONT - NPIV + LIST_NELIM_ROW = IOLDPS + H_INODE + NPIV + LIST_NELIM_COL = LIST_NELIM_ROW + NFRONT + IF (NELIM.LE.0) THEN + write(6,*) ' ERROR 1 in SMUMPS_271 ', NELIM + write(6,*) MYID,':Process root2son: INODE=',INODE, + & 'Header=',IW(PTLUST_S(STEP(INODE)):PTLUST_S(STEP(INODE)) + & +5+KEEP(IXSZ)) + CALL MUMPS_ABORT() + ENDIF + NELIM_LOCAL = NELIM_ROOT + DO I=1, NELIM + root%RG2L_ROW(IW(LIST_NELIM_ROW)) = NELIM_LOCAL + root%RG2L_COL(IW(LIST_NELIM_COL)) = NELIM_LOCAL + NELIM_LOCAL = NELIM_LOCAL + 1 + LIST_NELIM_ROW = LIST_NELIM_ROW + 1 + LIST_NELIM_COL = LIST_NELIM_COL + 1 + ENDDO + NBROW = NFRONT - NPIV + NROW = NELIM + IF ( KEEP( 50 ) .eq. 0 ) THEN + NCOL = NFRONT - NPIV + ELSE + NCOL = NELIM + END IF + SHIFT_LIST_ROW_SON = H_INODE + NPIV + SHIFT_LIST_COL_SON = H_INODE + NFRONT + NPIV + IF ( KEEP(50).eq.0 .OR. TYPE_SON .eq. 1 ) THEN + LDAFS = NFRONT + ELSE + LDAFS = NASS + END IF + SHIFT_VAL_SON = int(NPIV,8) * int(LDAFS,8) + int(NPIV,8) + CALL SMUMPS_80( COMM_LOAD, + & ASS_IRECV, + & N, INODE, FPERE, + & PTLUST_S(1), PTRAST(1), + & root, NROW, NCOL, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDAFS, + & ROOT_NON_ELIM_CB, MYID, COMM, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S(1), PTRFAC(1), PTRAST(1), + & STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0 ) RETURN + IF (TYPE_SON.EQ.1) THEN + NROW = NFRONT - NASS + NCOL = NELIM + SHIFT_LIST_ROW_SON = H_INODE + NASS + SHIFT_LIST_COL_SON = H_INODE + NFRONT + NPIV + SHIFT_VAL_SON = int(NASS,8) * int(NFRONT,8) + int(NPIV,8) + IF ( KEEP( 50 ) .eq. 0 ) THEN + INVERT = .FALSE. + ELSE + INVERT = .TRUE. + END IF + CALL SMUMPS_80( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTLUST_S, PTRAST, + & root, NROW, NCOL, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT, + & ROOT_NON_ELIM_CB, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0 ) RETURN + ENDIF + IOLDPS = PTLUST_S(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) + PTRFAC(STEP(INODE))=POSELT + IF ( TYPE_SON .eq. 1 ) THEN + NBROW = NFRONT - NPIV + ELSE + NBROW = NELIM + END IF + IF ( TYPE_SON .eq. 1 .OR. KEEP(50).EQ.0) THEN + LDA = NFRONT + ELSE + LDA = NPIV+NBROW + ENDIF + CALL SMUMPS_324(A(POSELT), LDA, + & NPIV, NBROW, KEEP(50)) + IW(IOLDPS + KEEP(IXSZ)) = NBCOL + IW(IOLDPS + 1 +KEEP(IXSZ)) = NASS - NPIV + IF (TYPE_SON.EQ.2) THEN + IW(IOLDPS + 2 +KEEP(IXSZ)) = NASS + ELSE + IW(IOLDPS + 2 +KEEP(IXSZ)) = NFRONT + ENDIF + IW(IOLDPS + 3 +KEEP(IXSZ)) = NPIV + CALL SMUMPS_93(0_8,MYID,N,IOLDPS,TYPE_SON,IW,LIW, + & A, LA, POSFAC, LRLU, LRLUS, + & IWPOS, PTRAST,PTRFAC,STEP, KEEP,KEEP8, .FALSE.,INODE,IERR) + IF(IERR.LT.0)THEN + IFLAG=IERR + IERROR=0 + RETURN + ENDIF + ELSE + ISON = INODE + PDEST_MASTER_ISON = + & MUMPS_275(PROCNODE_STEPS(STEP(ISON)), SLAVEF) + DO WHILE ( PTRIST(STEP(ISON)) .EQ. 0) + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & PDEST_MASTER_ISON, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) RETURN + ENDDO + DO WHILE ( + & ( IW( PTRIST(STEP(ISON)) + 1 +KEEP(IXSZ)) .NE. + & IW( PTRIST(STEP(ISON)) + 3 +KEEP(IXSZ)) ) .OR. + & ( KEEP(50) .NE. 0 .AND. + & IW( PTRIST(STEP(ISON)) + 6 +KEEP(IXSZ)) .NE. 0 ) ) + IF ( KEEP(50).eq.0) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO + ELSE + IF ( IW( PTRIST(STEP(ISON)) + 1 +KEEP(IXSZ)) .NE. + & IW( PTRIST(STEP(ISON)) + 3 +KEEP(IXSZ)) ) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO_SYM + ELSE + MSGSOU = MPI_ANY_SOURCE + MSGTAG = BLOC_FACTO_SYM_SLAVE + END IF + END IF + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MSGTAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) RETURN + END DO + IOLDPS = PTRIST(STEP(INODE)) + LCONT = IW(IOLDPS+KEEP(IXSZ)) + NROW = IW(IOLDPS+2+KEEP(IXSZ)) + NPIV = IW(IOLDPS+3+KEEP(IXSZ)) + NASS = IW(IOLDPS+4+KEEP(IXSZ)) + NELIM = NASS-NPIV + IF (NELIM.LE.0) THEN + write(6,*) MYID,': INODE,LCONT, NROW, NPIV, NASS, NELIM=', + & INODE,LCONT, NROW, NPIV, NASS, NELIM + write(6,*) MYID,': IOLDPS=',IOLDPS + write(6,*) MYID,': ERROR 2 in SMUMPS_271 ' + CALL MUMPS_ABORT() + ENDIF + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + H_INODE = 6 + NSLAVES + KEEP(IXSZ) + LIST_NELIM_COL = IOLDPS + H_INODE + NROW + NPIV + NELIM_LOCAL = NELIM_ROOT + DO I = 1, NELIM + root%RG2L_COL(IW(LIST_NELIM_COL)) = NELIM_LOCAL + root%RG2L_ROW(IW(LIST_NELIM_COL)) = NELIM_LOCAL + NELIM_LOCAL = NELIM_LOCAL + 1 + LIST_NELIM_COL = LIST_NELIM_COL + 1 + ENDDO + SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NPIV + NCOL_TO_SEND = NELIM + IF (IW(IOLDPS+XXS).EQ.S_NOLCBNOCONTIG38.OR. + & IW(IOLDPS+XXS).EQ.S_ALL) THEN + SHIFT_VAL_SON = int(NPIV,8) + LDA = LCONT + NPIV + ELSE IF (IW(IOLDPS+XXS).EQ.S_NOLCBCONTIG38) THEN + SHIFT_VAL_SON = int(NROW,8)*int(LCONT+NPIV-NELIM,8) + LDA = NELIM + ELSE IF (IW(IOLDPS+XXS).EQ.S_NOLCLEANED38) THEN + SHIFT_VAL_SON=0_8 + LDA = NELIM + ELSE + write(*,*) MYID,": internal error in SMUMPS_271", + & IW(IOLDPS+XXS), "INODE=",INODE + CALL MUMPS_ABORT() + ENDIF + IF ( KEEP( 50 ) .eq. 0 ) THEN + INVERT = .FALSE. + ELSE + INVERT = .TRUE. + END IF + CALL SMUMPS_80( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTRIST, PTRAST, + & root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA, + & ROOT_NON_ELIM_CB, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0 ) RETURN + IF (KEEP(214).EQ.2) THEN + CALL SMUMPS_314( N, INODE, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, TYPE_SON + & ) + ENDIF + IF (IFLAG.LT.0) THEN + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_271 + SUBROUTINE SMUMPS_221(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IFLAG,IOLDPS,POSELT,UU, SEUIL,KEEP,KEEP8, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & + & PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV,NOFFW + INTEGER(8) :: LA + REAL A(LA) + REAL UU, SEUIL + INTEGER IW(LIW) + INTEGER(8) :: POSELT + INTEGER IOLDPS + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U + INCLUDE 'mumps_headers.h' + REAL SWOP + INTEGER XSIZE + INTEGER(8) :: APOS, IDIAG + INTEGER(8) :: J1, J2, J3, JJ + INTEGER(8) :: NFRONT8 + REAL AMROW + REAL RMAX + REAL PIVNUL + REAL FIXA, CSEUIL + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,JMAX,J,ISW,ISWPS1 + INTEGER ISWPS2,KSW + INTEGER SMUMPS_IXAMAX + INTRINSIC max + REAL, PARAMETER :: RZERO = 0.0E0 + REAL, PARAMETER :: ZERO = 0.0E0 + INTEGER I_PIVRPTR_L, I_PIVR_L, NBPANELS_L + INTEGER I_PIVRPTR_U, I_PIVR_U, NBPANELS_U + PIVNUL = DKEEP(1) + FIXA = DKEEP(2) + CSEUIL = SEUIL + XSIZE = KEEP(IXSZ) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NFRONT8 = int(NFRONT,8) + IF (KEEP(201).EQ.1) THEN + CALL SMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + CALL SMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + ENDIF + NASSW = iabs(IW(IOLDPS+3+XSIZE)) + IF(INOPV .EQ. -1) THEN + APOS = POSELT + NFRONT8*int(NPIVP1-1,8) + int(NPIV,8) + IDIAG = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF(real(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + KEEP(98) = KEEP(98)+1 + ELSE IF (KEEP(258) .NE. 0) THEN + CALL SMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL SMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL SMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + NFRONT8*int(IPIV-1,8) + int(NPIV,8) + JMAX = 1 + IF (UU.GT.RZERO) GO TO 340 + IF (abs(A(APOS)).EQ.RZERO) GO TO 630 + GO TO 380 + 340 AMROW = RZERO + J1 = APOS + J2 = APOS + int(- NPIV + NASS - 1,8) + J = NASS -NPIV + JMAX = SMUMPS_IXAMAX(J,A(J1),1) + JJ = J1 + int(JMAX - 1,8) + AMROW = abs(A(JJ)) + RMAX = AMROW + J1 = J2 + 1_8 + J2 = APOS +int(- NPIV + NFRONT - 1 - KEEP(253),8) + IF (J2.LT.J1) GO TO 370 + DO 360 JJ=J1,J2 + RMAX = max(abs(A(JJ)),RMAX) + 360 CONTINUE + 370 IDIAG = APOS + int(IPIV - NPIVP1,8) + IF ( RMAX .LE. PIVNUL ) THEN + KEEP(109) = KEEP(109)+1 + ISW = IOLDPS+IW(IOLDPS+1+XSIZE)+6+XSIZE+ + & IW(IOLDPS+5+XSIZE)+IPIV-NPIVP1 + PIVNUL_LIST(KEEP(109)) = IW(ISW) + IF(real(FIXA).GT.RZERO) THEN + IF(real(A(IDIAG)) .GE. RZERO) THEN + A(IDIAG) = FIXA + ELSE + A(IDIAG) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = APOS + int(- NPIV + NFRONT - 1 - KEEP(253),8) + DO JJ=J1,J2 + A(JJ) = ZERO + ENDDO + A(IDIAG) = -FIXA + ENDIF + JMAX = IPIV - NPIV + GOTO 385 + ENDIF + IF (abs(A(IDIAG)).GT. max(UU*RMAX,SEUIL)) THEN + JMAX = IPIV - NPIV + GO TO 380 + ENDIF + IF (AMROW.LE. max(UU*RMAX,SEUIL)) GO TO 460 + NOFFW = NOFFW + 1 + 380 CONTINUE + IF (KEEP(258) .NE. 0) THEN + CALL SMUMPS_762( + & A( APOS+int(JMAX-1,8) ), + & DKEEP(6), + & KEEP(259) ) + ENDIF + 385 CONTINUE + IF (IPIV.EQ.NPIVP1) GO TO 400 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8)*NFRONT8 + J2 = J1 + NFRONT8 - 1_8 + J3 = POSELT + int(IPIV-1,8)*NFRONT8 + DO 390 JJ=J1,J2 + SWOP = A(JJ) + A(JJ) = A(J3) + A(J3) = SWOP + J3 = J3 + 1_8 + 390 CONTINUE + ISWPS1 = IOLDPS + 5 + NPIVP1 + XSIZE + ISWPS2 = IOLDPS + 5 + IPIV + XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + 400 IF (JMAX.EQ.1) GO TO 420 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8) + J2 = POSELT + int(NPIV + JMAX - 1,8) + DO 410 KSW=1,NFRONT + SWOP = A(J1) + A(J1) = A(J2) + A(J2) = SWOP + J1 = J1 + NFRONT8 + J2 = J2 + NFRONT8 + 410 CONTINUE + ISWPS1 = IOLDPS + 5 + NFRONT + NPIV + 1 +XSIZE + ISWPS2 = IOLDPS + 5 + NFRONT + NPIV + JMAX +XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + GO TO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 430 + 630 CONTINUE + IFLAG = -10 + WRITE(*,*) 'Detected a null pivot, INODE/NPIV=',INODE,NPIV + GOTO 430 + 420 CONTINUE + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL SMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, IPIV, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL SMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIV+JMAX, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + 430 CONTINUE + RETURN + END SUBROUTINE SMUMPS_221 + SUBROUTINE SMUMPS_220(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IOLDPS,POSELT,UU,SEUIL,KEEP, DKEEP, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,INOPV + INTEGER(8) :: LA + INTEGER KEEP(500) + REAL DKEEP(30) + REAL UU, SEUIL + REAL A(LA) + INTEGER IW(LIW) + REAL AMROW + REAL RMAX + REAL SWOP + INTEGER(8) :: APOS, POSELT + INTEGER(8) :: J1, J2, J3_8, JJ, IDIAG + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS + INTEGER NOFFW,NPIV,IPIV + INTEGER J, J3 + INTEGER NPIVP1,JMAX,ISW,ISWPS1 + INTEGER ISWPS2,KSW,XSIZE + INTEGER I_PIVRPTR_L, I_PIVR_L, NBPANELS_L + INTEGER I_PIVRPTR_U, I_PIVR_U, NBPANELS_U + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U + INTEGER SMUMPS_IXAMAX + INCLUDE 'mumps_headers.h' + INTRINSIC max + REAL, PARAMETER :: RZERO = 0.0E0 + NFRONT8 = int(NFRONT,8) + INOPV = 0 + XSIZE = KEEP(IXSZ) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL SMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE) + & +KEEP(IXSZ), + & IW, LIW) + CALL SMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + ENDIF + DO 460 IPIV=NPIVP1,NASS + APOS = POSELT + NFRONT8*int(NPIV,8) + int(IPIV-1,8) + JMAX = 1 + AMROW = RZERO + J1 = APOS + J3 = NASS -NPIV + JMAX = SMUMPS_IXAMAX(J3,A(J1),NFRONT) + JJ = J1 + int(JMAX-1,8)*NFRONT8 + AMROW = abs(A(JJ)) + RMAX = AMROW + J1 = APOS + int(NASS-NPIV,8) * NFRONT8 + J3 = NFRONT - NASS - KEEP(253) + IF (J3.EQ.0) GOTO 370 + DO 360 J=1,J3 + RMAX = max(abs(A(J1)),RMAX) + J1 = J1 + NFRONT8 + 360 CONTINUE + 370 IF (RMAX.EQ.RZERO) GO TO 460 + IDIAG = APOS + int(IPIV - NPIVP1,8)*NFRONT8 + IF (abs(A(IDIAG)).GE.max(UU*RMAX,SEUIL)) THEN + JMAX = IPIV - NPIV + GO TO 380 + ENDIF + IF (AMROW.LT.max(UU*RMAX,SEUIL)) GO TO 460 + NOFFW = NOFFW + 1 + 380 CONTINUE + IF (KEEP(258) .NE. 0) THEN + CALL SMUMPS_762( + & A(APOS + int(JMAX - 1,8) * NFRONT8 ), + & DKEEP(6), + & KEEP(259) ) + ENDIF + IF (IPIV.EQ.NPIVP1) GO TO 400 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8) + J3_8 = POSELT + int(IPIV-1,8) + DO 390 J= 1,NFRONT + SWOP = A(J1) + A(J1) = A(J3_8) + A(J3_8) = SWOP + J1 = J1 + NFRONT8 + J3_8 = J3_8 + NFRONT8 + 390 CONTINUE + ISWPS1 = IOLDPS + 5 + NPIVP1 + NFRONT + XSIZE + ISWPS2 = IOLDPS + 5 + IPIV + NFRONT + XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + 400 IF (JMAX.EQ.1) GO TO 420 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8) * NFRONT8 + J2 = POSELT + int(NPIV + JMAX - 1,8) * NFRONT8 + DO 410 KSW=1,NFRONT + SWOP = A(J1) + A(J1) = A(J2) + A(J2) = SWOP + J1 = J1 + 1_8 + J2 = J2 + 1_8 + 410 CONTINUE + ISWPS1 = IOLDPS + 5 + NPIV + 1 + XSIZE + ISWPS2 = IOLDPS + 5 + NPIV + JMAX + XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + GO TO 420 + 460 CONTINUE + INOPV = 1 + GOTO 430 + 420 CONTINUE + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL SMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, NPIV+JMAX, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL SMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, IPIV, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + 430 CONTINUE + RETURN + END SUBROUTINE SMUMPS_220 + SUBROUTINE SMUMPS_225(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB,LKJIB,LKJIT,XSIZE) + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFINB,LKJIB,IBEG_BLOCK + INTEGER(8) :: LA + REAL A(LA) + INTEGER IW(LIW) + REAL VALPIV + INTEGER(8) :: APOS, POSELT, UUPOS, LPOS + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS + INTEGER LKJIT, XSIZE + REAL ONE, ALPHA + INTEGER NPIV,JROW2 + INTEGER NEL2,NPIVP1,KROW,NEL + INCLUDE 'mumps_headers.h' + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + NFRONT8= int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NEL = NFRONT - NPIVP1 + IFINB = 0 + IF (IW(IOLDPS+3+XSIZE).LE.0) THEN + IF (NASS.LT.LKJIT) THEN + IW(IOLDPS+3+XSIZE) = NASS + ELSE + IW(IOLDPS+3+XSIZE) = min0(NASS,LKJIB) + ENDIF + ENDIF + JROW2 = IW(IOLDPS+3+XSIZE) + NEL2 = JROW2 - NPIVP1 + IF (NEL2.EQ.0) THEN + IF (JROW2.EQ.NASS) THEN + IFINB = -1 + ELSE + IFINB = 1 + IW(IOLDPS+3+XSIZE) = min0(JROW2+LKJIB,NASS) + IBEG_BLOCK = NPIVP1+1 + ENDIF + ELSE + APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + VALPIV = ONE/A(APOS) + LPOS = APOS + NFRONT8 + DO 541 KROW = 1,NEL2 + A(LPOS) = A(LPOS)*VALPIV + LPOS = LPOS + NFRONT8 + 541 CONTINUE + LPOS = APOS + NFRONT8 + UUPOS = APOS + 1_8 + CALL sger(NEL,NEL2,ALPHA,A(UUPOS),1,A(LPOS),NFRONT, + & A(LPOS+1_8),NFRONT) + ENDIF + RETURN + END SUBROUTINE SMUMPS_225 + SUBROUTINE SMUMPS_229(NFRONT,N,INODE,IW,LIW,A,LA,IOLDPS, + & POSELT,XSIZE) + IMPLICIT NONE + INTEGER NFRONT,N,INODE,LIW,XSIZE + INTEGER(8) :: LA + REAL A(LA) + INTEGER IW(LIW) + REAL ALPHA,VALPIV + INTEGER(8) :: APOS, POSELT, UUPOS + INTEGER(8) :: NFRONT8, LPOS, IRWPOS + INTEGER IOLDPS,NPIV,NEL + INTEGER JROW + INCLUDE 'mumps_headers.h' + REAL, PARAMETER :: ONE = 1.0E0 + NFRONT8= int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NEL = NFRONT - NPIV - 1 + APOS = POSELT + int(NPIV,8) * NFRONT8 + int(NPIV,8) + IF (NEL.EQ.0) GO TO 650 + VALPIV = ONE/A(APOS) + LPOS = APOS + NFRONT8 + DO 340 JROW = 1,NEL + A(LPOS) = VALPIV*A(LPOS) + LPOS = LPOS + NFRONT8 + 340 CONTINUE + LPOS = APOS + NFRONT8 + UUPOS = APOS+1_8 + DO 440 JROW = 1,NEL + IRWPOS = LPOS + 1_8 + ALPHA = -A(LPOS) + CALL saxpy(NEL,ALPHA,A(UUPOS),1,A(IRWPOS),1) + LPOS = LPOS + NFRONT8 + 440 CONTINUE + 650 RETURN + END SUBROUTINE SMUMPS_229 + SUBROUTINE SMUMPS_228(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB,XSIZE) + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER NFRONT,NASS,N,LIW,INODE,IFINB + INTEGER(8) :: LA + REAL A(LA) + INTEGER IW(LIW) + REAL ALPHA,VALPIV + INTEGER(8) :: APOS, POSELT, UUPOS, LPOS, IRWPOS + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS,NPIV,KROW, XSIZE + INTEGER NEL,ICOL,NEL2 + INTEGER NPIVP1 + REAL, PARAMETER :: ONE = 1.0E0 + NFRONT8=int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NEL = NFRONT - NPIVP1 + NEL2 = NASS - NPIVP1 + IFINB = 0 + IF (NPIVP1.EQ.NASS) IFINB = 1 + APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + VALPIV = ONE/A(APOS) + LPOS = APOS + NFRONT8 + DO 541 KROW = 1,NEL + A(LPOS) = A(LPOS)*VALPIV + LPOS = LPOS + NFRONT8 + 541 CONTINUE + LPOS = APOS + NFRONT8 + UUPOS = APOS + 1_8 + DO 440 ICOL = 1,NEL + IRWPOS = LPOS + 1_8 + ALPHA = -A(LPOS) + CALL saxpy(NEL2,ALPHA,A(UUPOS),1,A(IRWPOS),1) + LPOS = LPOS + NFRONT8 + 440 CONTINUE + RETURN + END SUBROUTINE SMUMPS_228 + SUBROUTINE SMUMPS_231(A,LA,NFRONT, + & NPIV,NASS,POSELT) + IMPLICIT NONE + INTEGER(8) :: LA,POSELT + REAL A(LA) + INTEGER NFRONT, NPIV, NASS + INTEGER(8) :: LPOS, LPOS1, LPOS2 + INTEGER NEL1,NEL11 + REAL ALPHA, ONE + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + NEL1 = NFRONT - NASS + NEL11 = NFRONT - NPIV + LPOS2 = POSELT + int(NASS,8)*int(NFRONT,8) + CALL strsm('L','L','N','N',NPIV,NEL1,ONE,A(POSELT),NFRONT, + & A(LPOS2),NFRONT) + LPOS = LPOS2 + int(NPIV,8) + LPOS1 = POSELT + int(NPIV,8) + CALL sgemm('N','N',NEL11,NEL1,NPIV,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE SMUMPS_231 + SUBROUTINE SMUMPS_642(A,LAFAC,NFRONT, + & NPIV,NASS, IW, LIWFAC, + & MonBloc, TYPEFile, MYID, KEEP8, + & STRAT, IFLAG_OOC, + & LNextPiv2beWritten, UNextPiv2beWritten) + USE SMUMPS_OOC + IMPLICIT NONE + INTEGER NFRONT, NPIV, NASS + INTEGER(8) :: LAFAC + INTEGER LIWFAC, TYPEFile, MYID, IFLAG_OOC, + & LNextPiv2beWritten, UNextPiv2beWritten, STRAT + REAL A(LAFAC) + INTEGER IW(LIWFAC) + INTEGER(8) KEEP8(150) + TYPE(IO_BLOCK) :: MonBloc + INTEGER(8) :: LPOS2,LPOS1,LPOS + INTEGER NEL1,NEL11 + REAL ALPHA, ONE + LOGICAL LAST_CALL + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + NEL1 = NFRONT - NASS + NEL11 = NFRONT - NPIV + LPOS2 = 1_8 + int(NASS,8) * int(NFRONT,8) + CALL strsm('L','L','N','N',NPIV,NEL1,ONE,A(1),NFRONT, + & A(LPOS2),NFRONT) + LAST_CALL=.FALSE. + CALL SMUMPS_688 + & ( STRAT, TYPEFile, + & A, LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW, LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + LPOS = LPOS2 + int(NPIV,8) + LPOS1 = int(1 + NPIV,8) + CALL sgemm('N','N',NEL11,NEL1,NPIV,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE SMUMPS_642 + SUBROUTINE SMUMPS_232(A,LA,NFRONT,NPIV,NASS,POSELT,LKJIB) + INTEGER NFRONT, NPIV, NASS, LKJIB + INTEGER (8) :: POSELT, LA + REAL A(LA) + INTEGER(8) :: POSELT_LOCAL, LPOS, LPOS1, LPOS2 + INTEGER NEL1, NEL11, NPBEG + REAL ALPHA, ONE + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + POSELT_LOCAL = POSELT + NEL1 = NASS - NPIV + NPBEG = NPIV - LKJIB + 1 + NEL11 = NFRONT - NPIV + LPOS2 = POSELT_LOCAL + int(NPIV,8)*int(NFRONT,8) + & + int(NPBEG - 1,8) + POSELT_LOCAL = POSELT_LOCAL + int(NPBEG-1,8)*int(NFRONT,8) + & + int(NPBEG-1,8) + CALL strsm('L','L','N','N',LKJIB,NEL1,ONE,A(POSELT_LOCAL), + & NFRONT,A(LPOS2),NFRONT) + LPOS = LPOS2 + int(LKJIB,8) + LPOS1 = POSELT_LOCAL + int(LKJIB,8) + CALL sgemm('N','N',NEL11,NEL1,LKJIB,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE SMUMPS_232 + SUBROUTINE SMUMPS_233(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,LKJIB_ORIG,LKJIB,LKJIT,XSIZE ) + IMPLICIT NONE + INTEGER NFRONT, NASS,N,LIW + INTEGER(8) :: LA + REAL A(LA) + INTEGER IW(LIW) + INTEGER LKJIB_ORIG,LKJIB, INODE, IBEG_BLOCK + INTEGER(8) :: POSELT, LPOS, LPOS1, LPOS2, POSLOCAL + INTEGER(8) :: IPOS, KPOS + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS, NPIV, JROW2, NPBEG + INTEGER NONEL, LKJIW, NEL1, NEL11 + INTEGER LBP, HF + INTEGER LBPT,I1,K1,II,ISWOP,LBP1 + INTEGER LKJIT, XSIZE + INCLUDE 'mumps_headers.h' + REAL ALPHA, ONE + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + NFRONT8=int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + JROW2 = iabs(IW(IOLDPS+3+XSIZE)) + NPBEG = IBEG_BLOCK + HF = 6 + IW(IOLDPS+5+XSIZE) +XSIZE + NONEL = JROW2 - NPIV + 1 + IF ((NASS-NPIV).GE.LKJIT) THEN + LKJIB = LKJIB_ORIG + NONEL + IW(IOLDPS+3+XSIZE)= min0(NPIV+LKJIB,NASS) + ELSE + IW(IOLDPS+3+XSIZE) = NASS + ENDIF + IBEG_BLOCK = NPIV + 1 + NEL1 = NASS - JROW2 + LKJIW = NPIV - NPBEG + 1 + NEL11 = NFRONT - NPIV + IF ((NEL1.NE.0).AND.(LKJIW.NE.0)) THEN + LPOS2 = POSELT + int(JROW2,8)*NFRONT8 + + & int(NPBEG - 1,8) + POSLOCAL = POSELT + int(NPBEG-1,8)*NFRONT8 + int(NPBEG - 1,8) + CALL strsm('L','L','N','N',LKJIW,NEL1,ONE, + & A(POSLOCAL),NFRONT, + & A(LPOS2),NFRONT) + LPOS = LPOS2 + int(LKJIW,8) + LPOS1 = POSLOCAL + int(LKJIW,8) + CALL sgemm('N','N',NEL11,NEL1,LKJIW,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + ENDIF + RETURN + END SUBROUTINE SMUMPS_233 + SUBROUTINE SMUMPS_236(A,LA,NPIVB,NFRONT, + & NPIV,NASS,POSELT) + IMPLICIT NONE + INTEGER NPIVB,NASS + INTEGER(8) :: LA + REAL A(LA) + INTEGER(8) :: APOS, POSELT + INTEGER NFRONT, NPIV, NASSL + INTEGER(8) :: LPOS, LPOS1, LPOS2 + INTEGER NEL1, NEL11, NPIVE + REAL ALPHA, ONE + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + NEL1 = NFRONT - NASS + NEL11 = NFRONT - NPIV + NPIVE = NPIV - NPIVB + NASSL = NASS - NPIVB + APOS = POSELT + int(NPIVB,8)*int(NFRONT,8) + & + int(NPIVB,8) + LPOS2 = APOS + int(NASSL,8) + CALL strsm('R','U','N','U',NEL1,NPIVE,ONE,A(APOS),NFRONT, + & A(LPOS2),NFRONT) + LPOS = LPOS2 + int(NFRONT,8)*int(NPIVE,8) + LPOS1 = APOS + int(NFRONT,8)*int(NPIVE,8) + CALL sgemm('N','N',NEL1,NEL11,NPIVE,ALPHA,A(LPOS2), + & NFRONT,A(LPOS1),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE SMUMPS_236 + SUBROUTINE SMUMPS_217(N, NZ, NSCA, + & ASPK, IRN, ICN, COLSCA, ROWSCA, WK, LWK, WK_REAL, + & LWK_REAL, ICNTL, INFO) + IMPLICIT NONE + INTEGER N, NZ, NSCA + INTEGER IRN(NZ), ICN(NZ) + INTEGER ICNTL(40), INFO(40) + REAL ASPK(NZ) + REAL COLSCA(*), ROWSCA(*) + INTEGER LWK, LWK_REAL + REAL WK(LWK) + REAL WK_REAL(LWK_REAL) + INTEGER MPG,LP + INTEGER IWNOR + INTEGER I, K + LOGICAL PROK + REAL ONE + PARAMETER( ONE = 1.0E0 ) + LP = ICNTL(1) + MPG = ICNTL(2) + MPG = ICNTL(3) + PROK = (MPG.GT.0) + IF (PROK) WRITE(MPG,101) + 101 FORMAT(/' ****** SCALING OF ORIGINAL MATRIX '/) + IF (NSCA.EQ.1) THEN + IF (PROK) + & WRITE (MPG,*) ' DIAGONAL SCALING ' + ELSEIF (NSCA.EQ.2) THEN + IF (PROK) + & WRITE (MPG,*) ' SCALING BASED ON (MC29)' + ELSEIF (NSCA.EQ.3) THEN + IF (PROK) + & WRITE (MPG,*) ' COLUMN SCALING' + ELSEIF (NSCA.EQ.4) THEN + IF (PROK) + & WRITE (MPG,*) ' ROW AND COLUMN SCALING (1 Pass)' + ELSEIF (NSCA.EQ.5) THEN + IF (PROK) + & WRITE (MPG,*) ' MC29 FOLLOWED BY ROW &COL SCALING' + ELSEIF (NSCA.EQ.6) THEN + IF (PROK) + & WRITE (MPG,*) ' MC29 FOLLOWED BY COLUMN SCALING' + ENDIF + DO 10 I=1,N + COLSCA(I) = ONE + ROWSCA(I) = ONE + 10 CONTINUE + IF ((NSCA.EQ.5).OR. + & (NSCA.EQ.6)) THEN + IF (NZ.GT.LWK) GOTO 400 + DO 15 K=1,NZ + WK(K) = ASPK(K) + 15 CONTINUE + ENDIF + IF (5*N.GT.LWK_REAL) GOTO 410 + IWNOR = 1 + IF (NSCA.EQ.1) THEN + CALL SMUMPS_238(N,NZ,ASPK,IRN,ICN, + & COLSCA,ROWSCA,MPG) + ELSEIF (NSCA.EQ.2) THEN + CALL SMUMPS_239(N,NZ,ASPK,IRN,ICN, + & ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA) + ELSEIF (NSCA.EQ.3) THEN + CALL SMUMPS_241(N,NZ,ASPK,IRN,ICN,WK_REAL(IWNOR), + & COLSCA, MPG) + ELSEIF (NSCA.EQ.4) THEN + CALL SMUMPS_287(N,NZ,IRN,ICN,ASPK, + & WK_REAL(IWNOR),WK_REAL(IWNOR+N),COLSCA,ROWSCA,MPG) + ELSEIF (NSCA.EQ.5) THEN + CALL SMUMPS_239(N,NZ,WK,IRN,ICN, + & ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA) + CALL SMUMPS_241(N,NZ,WK,IRN,ICN,WK_REAL(IWNOR), + & COLSCA, MPG) + ELSEIF (NSCA.EQ.6) THEN + CALL SMUMPS_239(N,NZ,WK,IRN,ICN, + & ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA) + CALL SMUMPS_240(NSCA,N,NZ,IRN,ICN,WK, + & WK_REAL(IWNOR+N),ROWSCA,MPG) + CALL SMUMPS_241(N,NZ,WK,IRN,ICN, + & WK_REAL(IWNOR), COLSCA, MPG) + ENDIF + GOTO 500 + 400 INFO(1) = -5 + INFO(2) = NZ-LWK + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) + & WRITE(LP,*) '*** ERROR: Not enough space to scale matrix' + GOTO 500 + 410 INFO(1) = -5 + INFO(2) = 5*N-LWK_REAL + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) + & WRITE(LP,*) '*** ERROR: Not enough space to scale matrix' + GOTO 500 + 500 CONTINUE + RETURN + END SUBROUTINE SMUMPS_217 + SUBROUTINE SMUMPS_287(N,NZ,IRN,ICN,VAL, + & RNOR,CNOR,COLSCA,ROWSCA,MPRINT) + INTEGER N, NZ + REAL VAL(NZ) + REAL RNOR(N),CNOR(N) + REAL COLSCA(N),ROWSCA(N) + REAL CMIN,CMAX,RMIN,ARNOR,ACNOR + INTEGER IRN(NZ), ICN(NZ) + REAL VDIAG + INTEGER MPRINT + INTEGER I,J,K + REAL ZERO, ONE + PARAMETER(ZERO=0.0E0, ONE=1.0E0) + DO 50 J=1,N + CNOR(J) = ZERO + RNOR(J) = ZERO + 50 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.LE.0).OR.(I.GT.N).OR. + & (J.LE.0).OR.(J.GT.N)) GOTO 100 + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.CNOR(J)) THEN + CNOR(J) = VDIAG + ENDIF + IF (VDIAG.GT.RNOR(I)) THEN + RNOR(I) = VDIAG + ENDIF + 100 CONTINUE + IF (MPRINT.GT.0) THEN + CMIN = CNOR(1) + CMAX = CNOR(1) + RMIN = RNOR(1) + DO 111 I=1,N + ARNOR = RNOR(I) + ACNOR = CNOR(I) + IF (ACNOR.GT.CMAX) CMAX=ACNOR + IF (ACNOR.LT.CMIN) CMIN=ACNOR + IF (ARNOR.LT.RMIN) RMIN=ARNOR + 111 CONTINUE + WRITE(MPRINT,*) '**** STAT. OF MATRIX PRIOR ROW&COL SCALING' + WRITE(MPRINT,*) ' MAXIMUM NORM-MAX OF COLUMNS:',CMAX + WRITE(MPRINT,*) ' MINIMUM NORM-MAX OF COLUMNS:',CMIN + WRITE(MPRINT,*) ' MINIMUM NORM-MAX OF ROWS :',RMIN + ENDIF + DO 120 J=1,N + IF (CNOR(J).LE.ZERO) THEN + CNOR(J) = ONE + ELSE + CNOR(J) = ONE / CNOR(J) + ENDIF + 120 CONTINUE + DO 130 J=1,N + IF (RNOR(J).LE.ZERO) THEN + RNOR(J) = ONE + ELSE + RNOR(J) = ONE / RNOR(J) + ENDIF + 130 CONTINUE + DO 110 I=1,N + ROWSCA(I) = ROWSCA(I) * RNOR(I) + COLSCA(I) = COLSCA(I) * CNOR(I) + 110 CONTINUE + IF (MPRINT.GT.0) + & WRITE(MPRINT,*) ' END OF SCALING BY MAX IN ROW AND COL' + RETURN + END SUBROUTINE SMUMPS_287 + SUBROUTINE SMUMPS_239(N,NZ,VAL,ROWIND,COLIND, + & RNOR,CNOR,WNOR,MPRINT,MP, + & NSCA) + INTEGER N, NZ + REAL VAL(NZ) + REAL WNOR(5*N) + REAL RNOR(N), CNOR(N) + INTEGER COLIND(NZ),ROWIND(NZ) + INTEGER J,I,K + INTEGER MPRINT,MP,NSCA + INTEGER IFAIL9 + REAL ZERO + PARAMETER( ZERO = 0.0E0) + DO 15 I=1,N + RNOR(I) = ZERO + CNOR(I) = ZERO + 15 CONTINUE + CALL SMUMPS_216(N,N,NZ,VAL,ROWIND,COLIND, + & RNOR,CNOR,WNOR, MP,IFAIL9) +*CVD$ NODEPCHK +*CVD$ VECTOR +*CVD$ CONCUR + DO 30 I=1,N + CNOR(I) = exp(CNOR(I)) + RNOR(I) = exp(RNOR(I)) + 30 CONTINUE + IF ((NSCA.EQ.5).OR.(NSCA.EQ.6)) THEN + DO 100 K=1,NZ + I = ROWIND(K) + J = COLIND(K) + IF (min(I,J).LT.1 .OR. I.GT.N .OR. J.GT.N) GOTO 100 + VAL(K) = VAL(K) * CNOR(J) * RNOR(I) + 100 CONTINUE + ENDIF + IF (MPRINT.GT.0) + & WRITE(MPRINT,*) ' END OF SCALING USING MC29' + RETURN + END SUBROUTINE SMUMPS_239 + SUBROUTINE SMUMPS_241(N,NZ,VAL,IRN,ICN, + & CNOR,COLSCA,MPRINT) + INTEGER N,NZ + REAL VAL(NZ) + REAL CNOR(N) + REAL COLSCA(N) + INTEGER IRN(NZ), ICN(NZ) + REAL VDIAG + INTEGER MPRINT + INTEGER I,J,K + REAL ZERO, ONE + PARAMETER (ZERO=0.0E0,ONE=1.0E0) + DO 10 J=1,N + CNOR(J) = ZERO + 10 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.LE.0).OR.(I.GT.N).OR. + & (J.LE.0).OR.(J.GT.N)) GOTO 100 + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.CNOR(J)) THEN + CNOR(J) = VDIAG + ENDIF + 100 CONTINUE + DO 110 J=1,N + IF (CNOR(J).LE.ZERO) THEN + CNOR(J) = ONE + ELSE + CNOR(J) = ONE/CNOR(J) + ENDIF + 110 CONTINUE + DO 215 I=1,N + COLSCA(I) = COLSCA(I) * CNOR(I) + 215 CONTINUE + IF (MPRINT.GT.0) WRITE(MPRINT,*) ' END OF COLUMN SCALING' + RETURN + END SUBROUTINE SMUMPS_241 + SUBROUTINE SMUMPS_238(N,NZ,VAL,IRN,ICN, + & COLSCA,ROWSCA,MPRINT) + INTEGER N, NZ + REAL VAL(NZ) + REAL ROWSCA(N),COLSCA(N) + INTEGER IRN(NZ),ICN(NZ) + REAL VDIAG + INTEGER MPRINT,I,J,K + INTRINSIC sqrt + REAL ZERO, ONE + PARAMETER(ZERO=0.0E0, ONE=1.0E0) + DO 10 I=1,N + ROWSCA(I) = ONE + 10 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + IF ((I.GT.N).OR.(I.LE.0)) GOTO 100 + J = ICN(K) + IF (I.EQ.J) THEN + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.ZERO) THEN + ROWSCA(J) = ONE/(sqrt(VDIAG)) + ENDIF + ENDIF + 100 CONTINUE + DO 110 I=1,N + COLSCA(I) = ROWSCA(I) + 110 CONTINUE + IF (MPRINT.GT.0) WRITE(MPRINT,*) ' END OF DIAGONAL SCALING' + RETURN + END SUBROUTINE SMUMPS_238 + SUBROUTINE SMUMPS_240(NSCA,N,NZ,IRN,ICN,VAL, + & RNOR,ROWSCA,MPRINT) + INTEGER N, NZ, NSCA + INTEGER IRN(NZ), ICN(NZ) + REAL VAL(NZ) + REAL RNOR(N) + REAL ROWSCA(N) + REAL VDIAG + INTEGER MPRINT + INTEGER I,J,K + REAL ZERO,ONE + PARAMETER (ZERO=0.0E0, ONE=1.0E0) + DO 50 J=1,N + RNOR(J) = ZERO + 50 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.LE.0).OR.(I.GT.N).OR. + & (J.LE.0).OR.(J.GT.N)) GOTO 100 + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.RNOR(I)) THEN + RNOR(I) = VDIAG + ENDIF + 100 CONTINUE + DO 130 J=1,N + IF (RNOR(J).LE.ZERO) THEN + RNOR(J) = ONE + ELSE + RNOR(J) = ONE/RNOR(J) + ENDIF + 130 CONTINUE + DO 110 I=1,N + ROWSCA(I) = ROWSCA(I)* RNOR(I) + 110 CONTINUE + IF ( (NSCA.EQ.4) .OR. (NSCA.EQ.6) ) THEN + DO 150 K=1,NZ + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.N .OR. J.GT.N) GOTO 150 + VAL(K) = VAL(K) * RNOR(I) + 150 CONTINUE + ENDIF + IF (MPRINT.GT.0) + & WRITE(MPRINT,'(A)') ' END OF ROW SCALING' + RETURN + END SUBROUTINE SMUMPS_240 + SUBROUTINE SMUMPS_216(M,N,NE,A,IRN,ICN,R,C,W,LP,IFAIL) + INTEGER M,N,NE + REAL A(NE) + INTEGER IRN(NE),ICN(NE) + REAL R(M),C(N) + REAL W(M*2+N*3) + INTEGER LP,IFAIL + INTRINSIC log,abs,min + INTEGER MAXIT + PARAMETER (MAXIT=100) + REAL ONE + REAL SMIN,ZERO + PARAMETER (ONE=1.0E0,SMIN=0.1E0,ZERO=0.0E0) + INTEGER I,I1,I2,I3,I4,I5,ITER,J,K + REAL E,E1,EM,Q,Q1,QM,S,S1,SM,U,V + IFAIL = 0 + IF (M.LT.1 .OR. N.LT.1) THEN + IFAIL = -1 + GO TO 220 + ELSE IF (NE.LE.0) THEN + IFAIL = -2 + GO TO 220 + END IF + I1 = 0 + I2 = M + I3 = M + N + I4 = M + N*2 + I5 = M + N*3 + DO 10 I = 1,M + R(I) = ZERO + W(I1+I) = ZERO + 10 CONTINUE + DO 20 J = 1,N + C(J) = ZERO + W(I2+J) = ZERO + W(I3+J) = ZERO + W(I4+J) = ZERO + 20 CONTINUE + DO 30 K = 1,NE + U = abs(A(K)) + IF (U.EQ.ZERO) GO TO 30 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 30 + U = log(U) + W(I1+I) = W(I1+I) + ONE + W(I2+J) = W(I2+J) + ONE + R(I) = R(I) + U + W(I3+J) = W(I3+J) + U + 30 CONTINUE + DO 40 I = 1,M + IF (W(I1+I).EQ.ZERO) W(I1+I) = ONE + R(I) = R(I)/W(I1+I) + W(I5+I) = R(I) + 40 CONTINUE + DO 50 J = 1,N + IF (W(I2+J).EQ.ZERO) W(I2+J) = ONE + W(I3+J) = W(I3+J)/W(I2+J) + 50 CONTINUE + SM = SMIN*real(NE) + DO 60 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 60 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 60 + R(I) = R(I) - W(I3+J)/W(I1+I) + 60 CONTINUE + E = ZERO + Q = ONE + S = ZERO + DO 70 I = 1,M + S = S + W(I1+I)*R(I)**2 + 70 CONTINUE + IF (abs(S).LE.abs(SM)) GO TO 160 + DO 150 ITER = 1,MAXIT + DO 80 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 80 + J = ICN(K) + I = IRN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 80 + C(J) = C(J) + R(I) + 80 CONTINUE + S1 = S + S = ZERO + DO 90 J = 1,N + V = -C(J)/Q + C(J) = V/W(I2+J) + S = S + V*C(J) + 90 CONTINUE + E1 = E + E = Q*S/S1 + Q = ONE - E + IF (abs(S).LE.abs(SM)) E = ZERO + DO 100 I = 1,M + R(I) = R(I)*E*W(I1+I) + 100 CONTINUE + IF (abs(S).LE.abs(SM)) GO TO 180 + EM = E*E1 + DO 110 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 110 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 110 + R(I) = R(I) + C(J) + 110 CONTINUE + S1 = S + S = ZERO + DO 120 I = 1,M + V = -R(I)/Q + R(I) = V/W(I1+I) + S = S + V*R(I) + 120 CONTINUE + E1 = E + E = Q*S/S1 + Q1 = Q + Q = ONE - E + IF (abs(S).LE.abs(SM)) Q = ONE + QM = Q*Q1 + DO 130 J = 1,N + W(I4+J) = (EM*W(I4+J)+C(J))/QM + W(I3+J) = W(I3+J) + W(I4+J) + 130 CONTINUE + IF (abs(S).LE.abs(SM)) GO TO 160 + DO 140 J = 1,N + C(J) = C(J)*E*W(I2+J) + 140 CONTINUE + 150 CONTINUE + 160 DO 170 I = 1,M + R(I) = R(I)*W(I1+I) + 170 CONTINUE + 180 DO 190 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 190 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 190 + R(I) = R(I) + W(I3+J) + 190 CONTINUE + DO 200 I = 1,M + R(I) = R(I)/W(I1+I) - W(I5+I) + 200 CONTINUE + DO 210 J = 1,N + C(J) = -W(I3+J) + 210 CONTINUE + RETURN + 220 IF (LP.GT.0) WRITE (LP,'(/A/A,I3)') + & ' **** Error return from SMUMPS_216 ****',' IFAIL =',IFAIL + END SUBROUTINE SMUMPS_216 + SUBROUTINE SMUMPS_27( id, ANORMINF, LSCAL ) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MASTER, IERR + PARAMETER( MASTER = 0 ) + TYPE(SMUMPS_STRUC), TARGET :: id + REAL, INTENT(OUT) :: ANORMINF + LOGICAL :: LSCAL + INTEGER, DIMENSION (:), POINTER :: KEEP,INFO + INTEGER(8), DIMENSION (:), POINTER :: KEEP8 + LOGICAL :: I_AM_SLAVE + REAL DUMMY(1) + REAL ZERO + PARAMETER( ZERO = 0.0E0) + REAL, ALLOCATABLE :: SUMR(:), SUMR_LOC(:) + INTEGER :: allocok, MTYPE, I + INFO =>id%INFO + KEEP =>id%KEEP + KEEP8 =>id%KEEP8 + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & KEEP(46) .eq. 1 ) ) + IF (id%MYID .EQ. MASTER) THEN + ALLOCATE( SUMR( id%N ), stat =allocok ) + IF (allocok .GT.0 ) THEN + id%INFO(1)=-13 + id%INFO(2)=id%N + RETURN + ENDIF + ENDIF + IF ( KEEP(54) .eq. 0 ) THEN + IF (id%MYID .EQ. MASTER) THEN + IF (KEEP(55).EQ.0) THEN + IF (.NOT.LSCAL) THEN + CALL SMUMPS_207(id%A(1), + & id%NZ, id%N, + & id%IRN(1), id%JCN(1), + & SUMR, KEEP(1),KEEP8(1) ) + ELSE + CALL SMUMPS_289(id%A(1), + & id%NZ, id%N, + & id%IRN(1), id%JCN(1), + & SUMR, KEEP(1), KEEP8(1), + & id%COLSCA(1)) + ENDIF + ELSE + MTYPE = 1 + IF (.NOT.LSCAL) THEN + CALL SMUMPS_119(MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & SUMR, KEEP(1),KEEP8(1) ) + ELSE + CALL SMUMPS_135(MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & SUMR, KEEP(1),KEEP8(1), id%COLSCA(1)) + ENDIF + ENDIF + ENDIF + ELSE + ALLOCATE( SUMR_LOC( id%N ), stat =allocok ) + IF (allocok .GT.0 ) THEN + id%INFO(1)=-13 + id%INFO(2)=id%N + RETURN + ENDIF + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + IF (.NOT.LSCAL) THEN + CALL SMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & SUMR_LOC, id%KEEP(1),id%KEEP8(1) ) + ELSE + CALL SMUMPS_289(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & SUMR_LOC, id%KEEP(1),id%KEEP8(1), + & id%COLSCA(1)) + ENDIF + ELSE + SUMR_LOC = ZERO + ENDIF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( SUMR_LOC, SUMR, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( SUMR_LOC, DUMMY, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + DEALLOCATE (SUMR_LOC) + ENDIF + IF ( id%MYID .eq. MASTER ) THEN + ANORMINF = real(ZERO) + IF (LSCAL) THEN + DO I = 1, id%N + ANORMINF = max(abs(id%ROWSCA(I) * SUMR(I)), + & ANORMINF) + ENDDO + ELSE + DO I = 1, id%N + ANORMINF = max(abs(SUMR(I)), + & ANORMINF) + ENDDO + ENDIF + ENDIF + CALL MPI_BCAST(ANORMINF, 1, + & MPI_REAL, MASTER, + & id%COMM, IERR ) + IF (id%MYID .eq. MASTER) DEALLOCATE (SUMR) + RETURN + END SUBROUTINE SMUMPS_27 + SUBROUTINE SMUMPS_693(IRN_loc, JCN_loc, A_loc, NZ_loc, + & M, N, NUMPROCS, MYID, COMM, + & RPARTVEC, CPARTVEC, + & RSNDRCVSZ, CSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, COLSCA, WRKRC, ISZWRKRC, + & SYM, NB1, NB2, NB3, EPS, + & ONENORMERR,INFNORMERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER NZ_loc, M, N, IWRKSZ, OP + INTEGER NUMPROCS, MYID, COMM + INTEGER INTSZ, RESZ + INTEGER IRN_loc(NZ_loc) + INTEGER JCN_loc(NZ_loc) + REAL A_loc(NZ_loc) + INTEGER RPARTVEC(M), RSNDRCVSZ(2*NUMPROCS) + INTEGER CPARTVEC(N), CSNDRCVSZ(2*NUMPROCS) + INTEGER IWRK(IWRKSZ) + INTEGER REGISTRE(12) + REAL ROWSCA(M) + REAL COLSCA(N) + INTEGER ISZWRKRC + REAL WRKRC(ISZWRKRC) + REAL ONENORMERR,INFNORMERR + INTEGER SYM, NB1, NB2, NB3 + REAL EPS + EXTERNAL SMUMPS_694,SMUMPS_687, + & SMUMPS_670 + INTEGER I + IF(SYM.EQ.0) THEN + CALL SMUMPS_694(IRN_loc, JCN_loc, A_loc, NZ_loc, + & M, N, NUMPROCS, MYID, COMM, + & RPARTVEC, CPARTVEC, + & RSNDRCVSZ, CSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, COLSCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + ELSE + CALL SMUMPS_687(IRN_loc, JCN_loc, A_loc, NZ_loc, + & N, NUMPROCS, MYID, COMM, + & RPARTVEC, + & RSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + DO I=1,N + COLSCA(I) = ROWSCA(I) + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_693 + SUBROUTINE SMUMPS_694(IRN_loc, JCN_loc, A_loc, NZ_loc, + & M, N, NUMPROCS, MYID, COMM, + & RPARTVEC, CPARTVEC, + & RSNDRCVSZ, CSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, COLSCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER NZ_loc, M, N, IWRKSZ, OP + INTEGER NUMPROCS, MYID, COMM + INTEGER INTSZ, RESZ + INTEGER IRN_loc(NZ_loc) + INTEGER JCN_loc(NZ_loc) + REAL A_loc(NZ_loc) + INTEGER RPARTVEC(M), RSNDRCVSZ(2*NUMPROCS) + INTEGER CPARTVEC(N), CSNDRCVSZ(2*NUMPROCS) + INTEGER IWRK(IWRKSZ) + INTEGER REGISTRE(12) + REAL ROWSCA(M) + REAL COLSCA(N) + INTEGER ISZWRKRC + REAL WRKRC(ISZWRKRC) + REAL ONENORMERR,INFNORMERR + INTEGER IRSNDRCVNUM, ORSNDRCVNUM + INTEGER IRSNDRCVVOL, ORSNDRCVVOL + INTEGER ICSNDRCVNUM, OCSNDRCVNUM + INTEGER ICSNDRCVVOL, OCSNDRCVVOL + INTEGER INUMMYR, INUMMYC + INTEGER IMYRPTR,IMYCPTR + INTEGER IRNGHBPRCS, IRSNDRCVIA,IRSNDRCVJA + INTEGER ORNGHBPRCS, ORSNDRCVIA,ORSNDRCVJA + INTEGER ICNGHBPRCS, ICSNDRCVIA,ICSNDRCVJA + INTEGER OCNGHBPRCS, OCSNDRCVIA,OCSNDRCVJA + INTEGER ISTATUS, REQUESTS, TMPWORK + INTEGER ITDRPTR, ITDCPTR, ISRRPTR + INTEGER OSRRPTR, ISRCPTR, OSRCPTR + INTEGER NB1, NB2, NB3 + REAL EPS + INTEGER ITER, NZIND, IR, IC + REAL ELM + INTEGER TAG_COMM_COL + PARAMETER(TAG_COMM_COL=100) + INTEGER TAG_COMM_ROW + PARAMETER(TAG_COMM_ROW=101) + INTEGER TAG_ITERS + PARAMETER(TAG_ITERS=102) + EXTERNAL SMUMPS_654, + & SMUMPS_672, + & SMUMPS_674, + & SMUMPS_662, + & SMUMPS_743, + & SMUMPS_745, + & SMUMPS_660, + & SMUMPS_670, + & SMUMPS_671, + & SMUMPS_657, + & SMUMPS_656 + INTEGER SMUMPS_743 + INTEGER SMUMPS_745 + REAL SMUMPS_737 + REAL SMUMPS_738 + INTRINSIC abs + REAL RONE, RZERO + PARAMETER(RONE=1.0E0,RZERO=0.0E0) + INTEGER RESZR, RESZC + INTEGER INTSZR, INTSZC + INTEGER MAXMN + INTEGER I, IERROR + REAL ONEERRROW, ONEERRCOL, ONEERRL, ONEERRG + REAL INFERRROW, INFERRCOL, INFERRL, INFERRG + INTEGER OORANGEIND + INFERRG = -RONE + ONEERRG = -RONE + OORANGEIND = 0 + MAXMN = M + IF(MAXMN < N) MAXMN = N + IF(OP == 1) THEN + IF(NUMPROCS > 1) THEN + CALL SMUMPS_654(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & RPARTVEC, M, N, + & IWRK, IWRKSZ) + CALL SMUMPS_654(MYID, NUMPROCS, COMM, + & JCN_loc, IRN_loc, NZ_loc, + & CPARTVEC, N, M, + & IWRK, IWRKSZ) + CALL SMUMPS_672(MYID, NUMPROCS, M, RPARTVEC, + & NZ_loc, IRN_loc, N, JCN_loc, + & IRSNDRCVNUM,IRSNDRCVVOL, + & ORSNDRCVNUM,ORSNDRCVVOL, + & IWRK,IWRKSZ, + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), COMM) + CALL SMUMPS_672(MYID, NUMPROCS, N, CPARTVEC, + & NZ_loc, JCN_loc, M, IRN_loc, + & ICSNDRCVNUM,ICSNDRCVVOL, + & OCSNDRCVNUM,OCSNDRCVVOL, + & IWRK,IWRKSZ, + & CSNDRCVSZ(1), CSNDRCVSZ(1+NUMPROCS), COMM) + CALL SMUMPS_662(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & RPARTVEC, CPARTVEC, M, N, + & INUMMYR, + & INUMMYC, + & IWRK, IWRKSZ) + INTSZR = IRSNDRCVNUM + ORSNDRCVNUM + + & IRSNDRCVVOL + ORSNDRCVVOL + + & 2*(NUMPROCS+1) + INUMMYR + INTSZC = ICSNDRCVNUM + OCSNDRCVNUM + + & ICSNDRCVVOL + OCSNDRCVVOL + + & 2*(NUMPROCS+1) + INUMMYC + INTSZ = INTSZR + INTSZC + MAXMN + + & (MPI_STATUS_SIZE +1) * NUMPROCS + ELSE + IRSNDRCVNUM = 0 + ORSNDRCVNUM = 0 + IRSNDRCVVOL = 0 + ORSNDRCVVOL = 0 + INUMMYR = 0 + ICSNDRCVNUM = 0 + OCSNDRCVNUM = 0 + ICSNDRCVVOL = 0 + OCSNDRCVVOL = 0 + INUMMYC = 0 + INTSZ = 0 + ENDIF + RESZR = M + IRSNDRCVVOL + ORSNDRCVVOL + RESZC = N + ICSNDRCVVOL + OCSNDRCVVOL + RESZ = RESZR + RESZC + REGISTRE(1) = IRSNDRCVNUM + REGISTRE(2) = ORSNDRCVNUM + REGISTRE(3) = IRSNDRCVVOL + REGISTRE(4) = ORSNDRCVVOL + REGISTRE(5) = ICSNDRCVNUM + REGISTRE(6) = OCSNDRCVNUM + REGISTRE(7) = ICSNDRCVVOL + REGISTRE(8) = OCSNDRCVVOL + REGISTRE(9) = INUMMYR + REGISTRE(10) = INUMMYC + REGISTRE(11) = INTSZ + REGISTRE(12) = RESZ + ELSE + IRSNDRCVNUM = REGISTRE(1) + ORSNDRCVNUM = REGISTRE(2) + IRSNDRCVVOL = REGISTRE(3) + ORSNDRCVVOL = REGISTRE(4) + ICSNDRCVNUM = REGISTRE(5) + OCSNDRCVNUM = REGISTRE(6) + ICSNDRCVVOL = REGISTRE(7) + OCSNDRCVVOL = REGISTRE(8) + INUMMYR = REGISTRE(9) + INUMMYC = REGISTRE(10) + IF(NUMPROCS > 1) THEN + CALL SMUMPS_660(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & RPARTVEC, CPARTVEC, M, N, + & IWRK(1), INUMMYR, + & IWRK(1+INUMMYR), INUMMYC, + & IWRK(1+INUMMYR+INUMMYC), IWRKSZ-INUMMYR-INUMMYC ) + IMYRPTR = 1 + IMYCPTR = IMYRPTR + INUMMYR + IRNGHBPRCS = IMYCPTR+ INUMMYC + IRSNDRCVIA = IRNGHBPRCS+IRSNDRCVNUM + IRSNDRCVJA = IRSNDRCVIA + NUMPROCS+1 + ORNGHBPRCS = IRSNDRCVJA + IRSNDRCVVOL + ORSNDRCVIA = ORNGHBPRCS + ORSNDRCVNUM + ORSNDRCVJA = ORSNDRCVIA + NUMPROCS + 1 + ICNGHBPRCS = ORSNDRCVJA + ORSNDRCVVOL + ICSNDRCVIA = ICNGHBPRCS + ICSNDRCVNUM + ICSNDRCVJA = ICSNDRCVIA + NUMPROCS+1 + OCNGHBPRCS = ICSNDRCVJA + ICSNDRCVVOL + OCSNDRCVIA = OCNGHBPRCS + OCSNDRCVNUM + OCSNDRCVJA = OCSNDRCVIA + NUMPROCS + 1 + REQUESTS = OCSNDRCVJA + OCSNDRCVVOL + ISTATUS = REQUESTS + NUMPROCS + TMPWORK = ISTATUS + MPI_STATUS_SIZE * NUMPROCS + CALL SMUMPS_674(MYID, NUMPROCS, M, RPARTVEC, + & NZ_loc, IRN_loc,N, JCN_loc, + & IRSNDRCVNUM, IRSNDRCVVOL, + & IWRK(IRNGHBPRCS),IWRK(IRSNDRCVIA),IWRK(IRSNDRCVJA), + & ORSNDRCVNUM, ORSNDRCVVOL, + & IWRK(ORNGHBPRCS),IWRK(ORSNDRCVIA),IWRK(ORSNDRCVJA), + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), + & IWRK(TMPWORK), + & IWRK(ISTATUS), IWRK(REQUESTS), + & TAG_COMM_ROW, COMM) + CALL SMUMPS_674(MYID, NUMPROCS, N, CPARTVEC, + & NZ_loc, JCN_loc, M, IRN_loc, + & ICSNDRCVNUM, ICSNDRCVVOL, + & IWRK(ICNGHBPRCS), + & IWRK(ICSNDRCVIA), + & IWRK(ICSNDRCVJA), + & OCSNDRCVNUM, OCSNDRCVVOL, + & IWRK(OCNGHBPRCS),IWRK(OCSNDRCVIA),IWRK(OCSNDRCVJA), + & CSNDRCVSZ(1), CSNDRCVSZ(1+NUMPROCS), + & IWRK(TMPWORK), + & IWRK(ISTATUS), IWRK(REQUESTS), + & TAG_COMM_COL, COMM) + CALL SMUMPS_670(ROWSCA, M, RZERO) + CALL SMUMPS_670(COLSCA, N, RZERO) + CALL SMUMPS_671(ROWSCA, M, + & IWRK(IMYRPTR),INUMMYR, RONE) + CALL SMUMPS_671(COLSCA, N, + & IWRK(IMYCPTR),INUMMYC, RONE) + ELSE + CALL SMUMPS_670(ROWSCA, M, RONE) + CALL SMUMPS_670(COLSCA, N, RONE) + ENDIF + ITDRPTR = 1 + ITDCPTR = ITDRPTR + M + ISRRPTR = ITDCPTR + N + OSRRPTR = ISRRPTR + IRSNDRCVVOL + ISRCPTR = OSRRPTR + ORSNDRCVVOL + OSRCPTR = ISRCPTR + ICSNDRCVVOL + IF(NUMPROCS == 1)THEN + OSRCPTR = OSRCPTR - 1 + ISRCPTR = ISRCPTR - 1 + OSRRPTR = OSRRPTR - 1 + ISRRPTR = ISRRPTR - 1 + ELSE + IF(IRSNDRCVVOL == 0) ISRRPTR = ISRRPTR - 1 + IF(ORSNDRCVVOL == 0) OSRRPTR = OSRRPTR - 1 + IF(ICSNDRCVVOL == 0) ISRCPTR = ISRCPTR - 1 + IF(OCSNDRCVVOL == 0) OSRCPTR = OSRCPTR - 1 + ENDIF + ITER = 1 + DO WHILE (ITER.LE.NB1+NB2+NB3) + IF(NUMPROCS > 1) THEN + CALL SMUMPS_650(WRKRC(ITDRPTR),M, + & IWRK(IMYRPTR),INUMMYR) + CALL SMUMPS_650(WRKRC(ITDCPTR),N, + & IWRK(IMYCPTR),INUMMYC) + ELSE + CALL SMUMPS_670(WRKRC(ITDRPTR),M, RZERO) + CALL SMUMPS_670(WRKRC(ITDCPTR),N, RZERO) + ENDIF + IF((ITER.LE.NB1).OR.(ITER > NB1+NB2)) THEN + IF((ITER.EQ.1).OR.(OORANGEIND.EQ.1)) THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*ROWSCA(IR)*COLSCA(IC) + IF(WRKRC(ITDRPTR-1+IR) 1) THEN + CALL SMUMPS_657(MYID, NUMPROCS, + & WRKRC(ITDCPTR), N, TAG_ITERS+ITER, + & ICSNDRCVNUM,IWRK(ICNGHBPRCS), + & ICSNDRCVVOL,IWRK(ICSNDRCVIA), IWRK(ICSNDRCVJA), + & WRKRC(ISRCPTR), + & OCSNDRCVNUM,IWRK(OCNGHBPRCS), + & OCSNDRCVVOL,IWRK(OCSNDRCVIA), IWRK(OCSNDRCVJA), + & WRKRC( OSRCPTR), + & IWRK(ISTATUS),IWRK(REQUESTS), + & COMM) + CALL SMUMPS_657(MYID, NUMPROCS, + & WRKRC(ITDRPTR), M, TAG_ITERS+2+ITER, + & IRSNDRCVNUM,IWRK(IRNGHBPRCS), + & IRSNDRCVVOL,IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM,IWRK(ORNGHBPRCS), + & ORSNDRCVVOL,IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS),IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRROW = SMUMPS_737(ROWSCA, + & WRKRC(ITDRPTR), M, + & IWRK(IMYRPTR),INUMMYR) + INFERRCOL = SMUMPS_737(COLSCA, + & WRKRC(ITDCPTR), N, + & IWRK(IMYCPTR),INUMMYC) + INFERRL = INFERRCOL + IF(INFERRROW > INFERRL ) THEN + INFERRL = INFERRROW + ENDIF + CALL MPI_ALLREDUCE(INFERRL, INFERRG, + & 1, MPI_REAL, + & MPI_MAX, COMM, IERROR) + IF(INFERRG.LE.EPS) THEN + CALL SMUMPS_665(COLSCA, WRKRC(ITDCPTR), + & N, + & IWRK(IMYCPTR),INUMMYC) + CALL SMUMPS_665(ROWSCA, WRKRC(ITDRPTR), + & M, + & IWRK(IMYRPTR),INUMMYR) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRROW = SMUMPS_738(ROWSCA, + & WRKRC(ITDRPTR), M) + INFERRCOL = SMUMPS_738(COLSCA, + & WRKRC(ITDCPTR), N) + INFERRL = INFERRCOL + IF(INFERRROW > INFERRL) THEN + INFERRL = INFERRROW + ENDIF + INFERRG = INFERRL + IF(INFERRG.LE.EPS) THEN + CALL SMUMPS_666(COLSCA, WRKRC(ITDCPTR), N) + CALL SMUMPS_666(ROWSCA, WRKRC(ITDRPTR), M) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + IF((ITER .EQ.1).OR.(OORANGEIND.EQ.1))THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*ROWSCA(IR)*COLSCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + WRKRC(ITDCPTR-1+IC) = WRKRC(ITDCPTR-1+IC) + ELM + ELSE + OORANGEIND = 1 + ENDIF + ENDDO + ELSEIF(OORANGEIND.EQ.0) THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + ELM = abs(A_loc(NZIND))*ROWSCA(IR)*COLSCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + WRKRC(ITDCPTR-1+IC) = WRKRC(ITDCPTR-1+IC) + ELM + ENDDO + ENDIF + IF(NUMPROCS > 1) THEN + CALL SMUMPS_656(MYID, NUMPROCS, + & WRKRC(ITDCPTR), N, TAG_ITERS+ITER, + & ICSNDRCVNUM, IWRK(ICNGHBPRCS), + & ICSNDRCVVOL, IWRK(ICSNDRCVIA), IWRK(ICSNDRCVJA), + & WRKRC(ISRCPTR), + & OCSNDRCVNUM, IWRK(OCNGHBPRCS), + & OCSNDRCVVOL, IWRK(OCSNDRCVIA), IWRK(OCSNDRCVJA), + & WRKRC( OSRCPTR), + & IWRK(ISTATUS), IWRK(REQUESTS), + & COMM) + CALL SMUMPS_656(MYID, NUMPROCS, + & WRKRC(ITDRPTR), M, TAG_ITERS+2+ITER, + & IRSNDRCVNUM, IWRK(IRNGHBPRCS), + & IRSNDRCVVOL, IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM, IWRK(ORNGHBPRCS), + & ORSNDRCVVOL, IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS), IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRROW = SMUMPS_737(ROWSCA, + & WRKRC(ITDRPTR), M, + & IWRK(IMYRPTR),INUMMYR) + ONEERRCOL = SMUMPS_737(COLSCA, + & WRKRC(ITDCPTR), N, + & IWRK(IMYCPTR),INUMMYC) + ONEERRL = ONEERRCOL + IF(ONEERRROW > ONEERRL ) THEN + ONEERRL = ONEERRROW + ENDIF + CALL MPI_ALLREDUCE(ONEERRL, ONEERRG, + & 1, MPI_REAL, + & MPI_MAX, COMM, IERROR) + IF(ONEERRG.LE.EPS) THEN + CALL SMUMPS_665(COLSCA, WRKRC(ITDCPTR), + & N, + & IWRK(IMYCPTR),INUMMYC) + CALL SMUMPS_665(ROWSCA, WRKRC(ITDRPTR), + & M, + & IWRK(IMYRPTR),INUMMYR) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRROW = SMUMPS_738(ROWSCA, + & WRKRC(ITDRPTR), M) + ONEERRCOL = SMUMPS_738(COLSCA, + & WRKRC(ITDCPTR), N) + ONEERRL = ONEERRCOL + IF(ONEERRROW > ONEERRL) THEN + ONEERRL = ONEERRROW + ENDIF + ONEERRG = ONEERRL + IF(ONEERRG.LE.EPS) THEN + CALL SMUMPS_666(COLSCA, WRKRC(ITDCPTR), N) + CALL SMUMPS_666(ROWSCA, WRKRC(ITDRPTR), M) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ENDIF + ENDIF + IF(NUMPROCS > 1) THEN + CALL SMUMPS_665(COLSCA, WRKRC(ITDCPTR), N, + & IWRK(IMYCPTR),INUMMYC) + CALL SMUMPS_665(ROWSCA, WRKRC(ITDRPTR), M, + & IWRK(IMYRPTR),INUMMYR) + ELSE + CALL SMUMPS_666(COLSCA, WRKRC(ITDCPTR), N) + CALL SMUMPS_666(ROWSCA, WRKRC(ITDRPTR), M) + ENDIF + ITER = ITER + 1 + ENDDO + ONENORMERR = ONEERRG + INFNORMERR = INFERRG + IF(NUMPROCS > 1) THEN + CALL MPI_REDUCE(ROWSCA, WRKRC(1), M, MPI_REAL, + & MPI_MAX, 0, + & COMM, IERROR) + IF(MYID.EQ.0) THEN + DO I=1, M + ROWSCA(I) = WRKRC(I) + ENDDO + ENDIF + CALL MPI_REDUCE(COLSCA, WRKRC(1+M), N, MPI_REAL, + & MPI_MAX, 0, + & COMM, IERROR) + If(MYID.EQ.0) THEN + DO I=1, N + COLSCA(I) = WRKRC(I+M) + ENDDO + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_694 + SUBROUTINE SMUMPS_687(IRN_loc, JCN_loc, A_loc, NZ_loc, + & N, NUMPROCS, MYID, COMM, + & PARTVEC, + & RSNDRCVSZ, + & REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & SCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER NZ_loc, N, IWRKSZ, OP + INTEGER NUMPROCS, MYID, COMM + INTEGER INTSZ, RESZ + INTEGER IRN_loc(NZ_loc) + INTEGER JCN_loc(NZ_loc) + REAL A_loc(NZ_loc) + INTEGER PARTVEC(N), RSNDRCVSZ(2*NUMPROCS) + INTEGER IWRK(IWRKSZ) + INTEGER REGISTRE(12) + REAL SCA(N) + INTEGER ISZWRKRC + REAL WRKRC(ISZWRKRC) + INTEGER IRSNDRCVNUM, ORSNDRCVNUM + INTEGER IRSNDRCVVOL, ORSNDRCVVOL + INTEGER INUMMYR + INTEGER IMYRPTR,IMYCPTR + INTEGER IRNGHBPRCS, IRSNDRCVIA,IRSNDRCVJA + INTEGER ORNGHBPRCS, ORSNDRCVIA,ORSNDRCVJA + INTEGER ISTATUS, REQUESTS, TMPWORK + INTEGER ITDRPTR, ISRRPTR, OSRRPTR + REAL ONENORMERR,INFNORMERR + INTEGER NB1, NB2, NB3 + REAL EPS + INTEGER ITER, NZIND, IR, IC + REAL ELM + INTEGER TAG_COMM_ROW + PARAMETER(TAG_COMM_ROW=101) + INTEGER TAG_ITERS + PARAMETER(TAG_ITERS=102) + EXTERNAL SMUMPS_655, + & SMUMPS_673, + & SMUMPS_692, + & SMUMPS_663, + & SMUMPS_742, + & SMUMPS_745, + & SMUMPS_661, + & SMUMPS_657, + & SMUMPS_656, + & SMUMPS_670, + & SMUMPS_671 + INTEGER SMUMPS_742 + INTEGER SMUMPS_745 + REAL SMUMPS_737 + REAL SMUMPS_738 + INTRINSIC abs + REAL RONE, RZERO + PARAMETER(RONE=1.0E0,RZERO=0.0E0) + INTEGER INTSZR + INTEGER MAXMN + INTEGER I, IERROR + REAL ONEERRL, ONEERRG + REAL INFERRL, INFERRG + INTEGER OORANGEIND + OORANGEIND = 0 + INFERRG = -RONE + ONEERRG = -RONE + MAXMN = N + IF(OP == 1) THEN + IF(NUMPROCS > 1) THEN + CALL SMUMPS_655(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & IWRK, IWRKSZ) + CALL SMUMPS_673(MYID, NUMPROCS, N, PARTVEC, + & NZ_loc, IRN_loc,JCN_loc, IRSNDRCVNUM,IRSNDRCVVOL, + & ORSNDRCVNUM, ORSNDRCVVOL, + & IWRK,IWRKSZ, + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), COMM) + CALL SMUMPS_663(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & INUMMYR, + & IWRK, IWRKSZ) + INTSZR = IRSNDRCVNUM + ORSNDRCVNUM + + & IRSNDRCVVOL + ORSNDRCVVOL + + & 2*(NUMPROCS+1) + INUMMYR + INTSZ = INTSZR + N + + & (MPI_STATUS_SIZE +1) * NUMPROCS + ELSE + IRSNDRCVNUM = 0 + ORSNDRCVNUM = 0 + IRSNDRCVVOL = 0 + ORSNDRCVVOL = 0 + INUMMYR = 0 + INTSZ = 0 + ENDIF + RESZ = N + IRSNDRCVVOL + ORSNDRCVVOL + REGISTRE(1) = IRSNDRCVNUM + REGISTRE(2) = ORSNDRCVNUM + REGISTRE(3) = IRSNDRCVVOL + REGISTRE(4) = ORSNDRCVVOL + REGISTRE(9) = INUMMYR + REGISTRE(11) = INTSZ + REGISTRE(12) = RESZ + ELSE + IRSNDRCVNUM = REGISTRE(1) + ORSNDRCVNUM = REGISTRE(2) + IRSNDRCVVOL = REGISTRE(3) + ORSNDRCVVOL = REGISTRE(4) + INUMMYR = REGISTRE(9) + IF(NUMPROCS > 1) THEN + CALL SMUMPS_661(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & IWRK(1), INUMMYR, + & IWRK(1+INUMMYR), IWRKSZ-INUMMYR) + IMYRPTR = 1 + IMYCPTR = IMYRPTR + INUMMYR + IRNGHBPRCS = IMYCPTR + IRSNDRCVIA = IRNGHBPRCS+IRSNDRCVNUM + IRSNDRCVJA = IRSNDRCVIA + NUMPROCS+1 + ORNGHBPRCS = IRSNDRCVJA + IRSNDRCVVOL + ORSNDRCVIA = ORNGHBPRCS + ORSNDRCVNUM + ORSNDRCVJA = ORSNDRCVIA + NUMPROCS + 1 + REQUESTS = ORSNDRCVJA + ORSNDRCVVOL + ISTATUS = REQUESTS + NUMPROCS + TMPWORK = ISTATUS + MPI_STATUS_SIZE * NUMPROCS + CALL SMUMPS_692(MYID, NUMPROCS, N, PARTVEC, + & NZ_loc, IRN_loc, JCN_loc, + & IRSNDRCVNUM, IRSNDRCVVOL, + & IWRK(IRNGHBPRCS),IWRK(IRSNDRCVIA),IWRK(IRSNDRCVJA), + & ORSNDRCVNUM, ORSNDRCVVOL, + & IWRK(ORNGHBPRCS),IWRK(ORSNDRCVIA),IWRK(ORSNDRCVJA), + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), + & IWRK(TMPWORK), + & IWRK(ISTATUS), IWRK(REQUESTS), + & TAG_COMM_ROW, COMM) + CALL SMUMPS_670(SCA, N, RZERO) + CALL SMUMPS_671(SCA, N, + & IWRK(IMYRPTR),INUMMYR, RONE) + ELSE + CALL SMUMPS_670(SCA, N, RONE) + ENDIF + ITDRPTR = 1 + ISRRPTR = ITDRPTR + N + OSRRPTR = ISRRPTR + IRSNDRCVVOL + IF(NUMPROCS == 1)THEN + OSRRPTR = OSRRPTR - 1 + ISRRPTR = ISRRPTR - 1 + ELSE + IF(IRSNDRCVVOL == 0) ISRRPTR = ISRRPTR - 1 + IF(ORSNDRCVVOL == 0) OSRRPTR = OSRRPTR - 1 + ENDIF + ITER = 1 + DO WHILE(ITER.LE.NB1+NB2+NB3) + IF(NUMPROCS > 1) THEN + CALL SMUMPS_650(WRKRC(ITDRPTR),N, + & IWRK(IMYRPTR),INUMMYR) + ELSE + CALL SMUMPS_670(WRKRC(ITDRPTR),N, RZERO) + ENDIF + IF((ITER.LE.NB1).OR.(ITER > NB1+NB2)) THEN + IF((ITER.EQ.1).OR.(OORANGEIND.EQ.1)) THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*SCA(IR)*SCA(IC) + IF(WRKRC(ITDRPTR-1+IR) 1) THEN + CALL SMUMPS_657(MYID, NUMPROCS, + & WRKRC(ITDRPTR), N, TAG_ITERS+2+ITER, + & IRSNDRCVNUM,IWRK(IRNGHBPRCS), + & IRSNDRCVVOL,IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM,IWRK(ORNGHBPRCS), + & ORSNDRCVVOL,IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS),IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRL = SMUMPS_737(SCA, + & WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + CALL MPI_ALLREDUCE(INFERRL, INFERRG, + & 1, MPI_REAL, + & MPI_MAX, COMM, IERROR) + IF(INFERRG.LE.EPS) THEN + CALL SMUMPS_665(SCA, WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRL = SMUMPS_738(SCA, + & WRKRC(ITDRPTR), N) + INFERRG = INFERRL + IF(INFERRG.LE.EPS) THEN + CALL SMUMPS_666(SCA, WRKRC(ITDRPTR), N) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + IF((ITER.EQ.1).OR.(OORANGEIND.EQ.1))THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*SCA(IR)*SCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + IF(IR.NE.IC) THEN + WRKRC(ITDRPTR-1+IC) = + & WRKRC(ITDRPTR-1+IC) + ELM + ENDIF + ELSE + OORANGEIND = 1 + ENDIF + ENDDO + ELSEIF(OORANGEIND.EQ.0)THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + ELM = abs(A_loc(NZIND))*SCA(IR)*SCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + IF(IR.NE.IC) THEN + WRKRC(ITDRPTR-1+IC) = WRKRC(ITDRPTR-1+IC) + ELM + ENDIF + ENDDO + ENDIF + IF(NUMPROCS > 1) THEN + CALL SMUMPS_656(MYID, NUMPROCS, + & WRKRC(ITDRPTR), N, TAG_ITERS+2+ITER, + & IRSNDRCVNUM, IWRK(IRNGHBPRCS), + & IRSNDRCVVOL, IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM, IWRK(ORNGHBPRCS), + & ORSNDRCVVOL, IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS), IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRL = SMUMPS_737(SCA, + & WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + CALL MPI_ALLREDUCE(ONEERRL, ONEERRG, + & 1, MPI_REAL, + & MPI_MAX, COMM, IERROR) + IF(ONEERRG.LE.EPS) THEN + CALL SMUMPS_665(SCA, WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRL = SMUMPS_738(SCA, + & WRKRC(ITDRPTR), N) + ONEERRG = ONEERRL + IF(ONEERRG.LE.EPS) THEN + CALL SMUMPS_666(SCA, WRKRC(ITDRPTR), N) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ENDIF + ENDIF + IF(NUMPROCS > 1) THEN + CALL SMUMPS_665(SCA, WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + ELSE + CALL SMUMPS_666(SCA, WRKRC(ITDRPTR), N) + ENDIF + ITER = ITER + 1 + ENDDO + ONENORMERR = ONEERRG + INFNORMERR = INFERRG + IF(NUMPROCS > 1) THEN + CALL MPI_REDUCE(SCA, WRKRC(1), N, MPI_REAL, + & MPI_MAX, 0, + & COMM, IERROR) + IF(MYID.EQ.0) THEN + DO I=1, N + SCA(I) = WRKRC(I) + ENDDO + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_687 + SUBROUTINE SMUMPS_654(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & IPARTVEC, ISZ, OSZ, + & IWRK, IWSZ) + IMPLICIT NONE + EXTERNAL SMUMPS_703 + INTEGER MYID, NUMPROCS, COMM + INTEGER NZ_loc, ISZ, IWSZ, OSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWSZ) + INCLUDE 'mpif.h' + INTEGER I + INTEGER OP, IERROR + INTEGER IR, IC + IF(NUMPROCS.NE.1) THEN + CALL MPI_OP_CREATE(SMUMPS_703, .TRUE., OP, IERROR) + CALL SMUMPS_668(IWRK, 4*ISZ, ISZ) + DO I=1,ISZ + IWRK(2*I-1) = 0 + IWRK(2*I) = MYID + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.ISZ).AND. + & (IC.GE.1).AND.(IC.LE.OSZ)) THEN + IWRK(2*IR-1) = IWRK(2*IR-1) + 1 + ENDIF + ENDDO + CALL MPI_ALLREDUCE(IWRK(1), IWRK(1+2*ISZ), ISZ, + & MPI_2INTEGER, OP, COMM, IERROR) + DO I=1,ISZ + IPARTVEC(I) = IWRK(2*I+2*ISZ) + ENDDO + CALL MPI_OP_FREE(OP, IERROR) + ELSE + DO I=1,ISZ + IPARTVEC(I) = 0 + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_654 + SUBROUTINE SMUMPS_662(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & ROWPARTVEC, COLPARTVEC, M, N, + & INUMMYR, + & INUMMYC, + & IWRK, IWSZ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, M, N + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER ROWPARTVEC(M) + INTEGER COLPARTVEC(N) + INTEGER INUMMYR, INUMMYC + INTEGER IWSZ + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC + INUMMYR = 0 + INUMMYC = 0 + DO I=1,M + IWRK(I) = 0 + IF(ROWPARTVEC(I).EQ.MYID) THEN + IWRK(I)=1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IR) .EQ. 0) THEN + IWRK(IR)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + ENDDO + DO I=1,N + IWRK(I) = 0 + IF(COLPARTVEC(I).EQ.MYID) THEN + IWRK(I)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IC = JCN_loc(I) + IR = IRN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IC) .EQ. 0) THEN + IWRK(IC)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_662 + SUBROUTINE SMUMPS_660(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & ROWPARTVEC, COLPARTVEC, M, N, + & MYROWINDICES, INUMMYR, + & MYCOLINDICES, INUMMYC, + & IWRK, IWSZ ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, M, N + INTEGER INUMMYR, INUMMYC, IWSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER ROWPARTVEC(M) + INTEGER COLPARTVEC(N) + INTEGER MYROWINDICES(INUMMYR) + INTEGER MYCOLINDICES(INUMMYC) + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC, ITMP, MAXMN + MAXMN = M + IF(N > MAXMN) MAXMN = N + DO I=1,M + IWRK(I) = 0 + IF(ROWPARTVEC(I).EQ.MYID) IWRK(I)=1 + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IR) .EQ. 0) IWRK(IR)= 1 + ENDIF + ENDDO + ITMP = 1 + DO I=1,M + IF(IWRK(I).EQ.1) THEN + MYROWINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + DO I=1,N + IWRK(I) = 0 + IF(COLPARTVEC(I).EQ.MYID) IWRK(I)= 1 + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IC) .EQ. 0) IWRK(IC)= 1 + ENDIF + ENDDO + ITMP = 1 + DO I=1,N + IF(IWRK(I).EQ.1) THEN + MYCOLINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_660 + INTEGER FUNCTION SMUMPS_744(D, DSZ, INDX, INDXSZ, EPS) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + REAL D(DSZ) + INTEGER INDX(INDXSZ) + REAL EPS + INTEGER I, IID + REAL RONE + PARAMETER(RONE=1.0E0) + SMUMPS_744 = 1 + DO I=1, INDXSZ + IID = INDX(I) + IF (.NOT.( (D(IID).LE.(RONE+EPS)).AND. + & ((RONE-EPS).LE.D(IID)) )) THEN + SMUMPS_744 = 0 + ENDIF + ENDDO + RETURN + END FUNCTION SMUMPS_744 + INTEGER FUNCTION SMUMPS_745(D, DSZ, EPS) + IMPLICIT NONE + INTEGER DSZ + REAL D(DSZ) + REAL EPS + INTEGER I + REAL RONE + PARAMETER(RONE=1.0E0) + SMUMPS_745 = 1 + DO I=1, DSZ + IF (.NOT.( (D(I).LE.(RONE+EPS)).AND. + & ((RONE-EPS).LE.D(I)) )) THEN + SMUMPS_745 = 0 + ENDIF + ENDDO + RETURN + END FUNCTION SMUMPS_745 + INTEGER FUNCTION SMUMPS_743(DR, M, INDXR, INDXRSZ, + & DC, N, INDXC, INDXCSZ, EPS, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER M, N, INDXRSZ, INDXCSZ + REAL DR(M), DC(N) + INTEGER INDXR(INDXRSZ), INDXC(INDXCSZ) + REAL EPS + INTEGER COMM + EXTERNAL SMUMPS_744 + INTEGER SMUMPS_744 + INTEGER GLORES, MYRESR, MYRESC, MYRES + INTEGER IERR + MYRESR = SMUMPS_744(DR, M, INDXR, INDXRSZ, EPS) + MYRESC = SMUMPS_744(DC, N, INDXC, INDXCSZ, EPS) + MYRES = MYRESR + MYRESC + CALL MPI_ALLREDUCE(MYRES, GLORES, 1, MPI_INTEGER, + & MPI_SUM, COMM, IERR) + SMUMPS_743 = GLORES + RETURN + END FUNCTION SMUMPS_743 + REAL FUNCTION SMUMPS_737(D, TMPD, DSZ, + & INDX, INDXSZ) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + REAL D(DSZ) + REAL TMPD(DSZ) + INTEGER INDX(INDXSZ) + REAL RONE + PARAMETER(RONE=1.0E0) + INTEGER I, IIND + REAL ERRMAX + INTRINSIC abs + ERRMAX = -RONE + DO I=1,INDXSZ + IIND = INDX(I) + IF(abs(RONE-TMPD(IIND)).GT.ERRMAX) THEN + ERRMAX = abs(RONE-TMPD(IIND)) + ENDIF + ENDDO + SMUMPS_737 = ERRMAX + RETURN + END FUNCTION SMUMPS_737 + REAL FUNCTION SMUMPS_738(D, TMPD, DSZ) + IMPLICIT NONE + INTEGER DSZ + REAL D(DSZ) + REAL TMPD(DSZ) + REAL RONE + PARAMETER(RONE=1.0E0) + INTEGER I + REAL ERRMAX1 + INTRINSIC abs + ERRMAX1 = -RONE + DO I=1,DSZ + IF(abs(RONE-TMPD(I)).GT.ERRMAX1) THEN + ERRMAX1 = abs(RONE-TMPD(I)) + ENDIF + ENDDO + SMUMPS_738 = ERRMAX1 + RETURN + END FUNCTION SMUMPS_738 + SUBROUTINE SMUMPS_665(D, TMPD, DSZ, + & INDX, INDXSZ) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + REAL D(DSZ) + REAL TMPD(DSZ) + INTEGER INDX(INDXSZ) + INTRINSIC sqrt + INTEGER I, IIND + REAL RZERO + PARAMETER(RZERO=0.0E0) + DO I=1,INDXSZ + IIND = INDX(I) + IF (TMPD(IIND).NE.RZERO) D(IIND) = D(IIND)/sqrt(TMPD(IIND)) + ENDDO + RETURN + END SUBROUTINE SMUMPS_665 + SUBROUTINE SMUMPS_666(D, TMPD, DSZ) + IMPLICIT NONE + INTEGER DSZ + REAL D(DSZ) + REAL TMPD(DSZ) + INTRINSIC sqrt + INTEGER I + REAL RZERO + PARAMETER(RZERO=0.0E0) + DO I=1,DSZ + IF (TMPD(I) .NE. RZERO) D(I) = D(I)/sqrt(TMPD(I)) + ENDDO + RETURN + END SUBROUTINE SMUMPS_666 + SUBROUTINE SMUMPS_671(D, DSZ, INDX, INDXSZ, VAL) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + REAL D(DSZ) + INTEGER INDX(INDXSZ) + REAL VAL + INTEGER I, IIND + DO I=1,INDXSZ + IIND = INDX(I) + D(IIND) = VAL + ENDDO + RETURN + END SUBROUTINE SMUMPS_671 + SUBROUTINE SMUMPS_702(D, DSZ, INDX, INDXSZ) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + REAL D(DSZ) + INTEGER INDX(INDXSZ) + INTEGER I, IIND + DO I=1,INDXSZ + IIND = INDX(I) + D(IIND) = 1.0E0/D(IIND) + ENDDO + RETURN + END SUBROUTINE SMUMPS_702 + SUBROUTINE SMUMPS_670(D, DSZ, VAL) + IMPLICIT NONE + INTEGER DSZ + REAL D(DSZ) + REAL VAL + INTEGER I + DO I=1,DSZ + D(I) = VAL + ENDDO + RETURN + END SUBROUTINE SMUMPS_670 + SUBROUTINE SMUMPS_650(TMPD, TMPSZ, INDX, INDXSZ) + IMPLICIT NONE + INTEGER TMPSZ,INDXSZ + REAL TMPD(TMPSZ) + INTEGER INDX(INDXSZ) + INTEGER I + REAL DZERO + PARAMETER(DZERO=0.0E0) + DO I=1,INDXSZ + TMPD(INDX(I)) = DZERO + ENDDO + RETURN + END SUBROUTINE SMUMPS_650 + SUBROUTINE SMUMPS_703(INV, INOUTV, LEN, DTYPE) + IMPLICIT NONE + INTEGER LEN + INTEGER INV(2*LEN) + INTEGER INOUTV(2*LEN) + INTEGER DTYPE + INTEGER I + INTEGER DIN, DINOUT, PIN, PINOUT + DO I=1,2*LEN-1,2 + DIN = INV(I) + PIN = INV(I+1) + DINOUT = INOUTV(I) + PINOUT = INOUTV(I+1) + IF (DINOUT < DIN) THEN + INOUTV(I) = DIN + INOUTV(I+1) = PIN + ELSE IF (DINOUT == DIN) THEN + IF ((mod(DINOUT,2).EQ.0).AND.(PINPINOUT)) THEN + INOUTV(I+1) = PIN + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_703 + SUBROUTINE SMUMPS_668(IW, IWSZ, IVAL) + IMPLICIT NONE + INTEGER IWSZ + INTEGER IW(IWSZ) + INTEGER IVAL + INTEGER I + DO I=1,IWSZ + IW(I)=IVAL + ENDDO + RETURN + END SUBROUTINE SMUMPS_668 + SUBROUTINE SMUMPS_704(MYID, NUMPROCS, + & IRN_loc, JCN_loc, NZ_loc, + & ROWPARTVEC, COLPARTVEC, M, N, + & MYROWINDICES, INUMMYR, + & MYCOLINDICES, INUMMYC, + & IWRKROW, IWRKCOL, IWSZR, IWSZC, COMM ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, M, N + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER ROWPARTVEC(M) + INTEGER COLPARTVEC(N) + INTEGER MYROWINDICES(M) + INTEGER MYCOLINDICES(N) + INTEGER INUMMYR, INUMMYC + INTEGER IWSZR, IWSZC + INTEGER IWRKROW(IWSZR) + INTEGER IWRKCOL(IWSZC) + INTEGER COMM + INTEGER I, IR, IC, ITMP + INUMMYR = 0 + INUMMYC = 0 + DO I=1,M + IWRKROW(I) = 0 + IF(ROWPARTVEC(I).EQ.MYID) THEN + IWRKROW(I)=1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRKROW(IR) .EQ. 0) THEN + IWRKROW(IR)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + ENDDO + ITMP = 1 + DO I=1,M + IF(IWRKROW(I).EQ.1) THEN + MYROWINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + DO I=1,N + IWRKCOL(I) = 0 + IF(COLPARTVEC(I).EQ.MYID) THEN + IWRKCOL(I)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRKCOL(IC) .EQ. 0) THEN + IWRKCOL(IC)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDIF + ENDDO + ITMP = 1 + DO I=1,N + IF(IWRKCOL(I).EQ.1) THEN + MYCOLINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_704 + SUBROUTINE SMUMPS_672(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX, OSZ, OINDX,ISNDRCVNUM,ISNDRCVVOL, + & OSNDRCVNUM,OSNDRCVVOL, + & IWRK,IWRKSZ, SNDSZ, RCVSZ, COMM) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, IWRKSZ, OSZ + INTEGER ISNDRCVNUM, ISNDRCVVOL + INTEGER OSNDRCVNUM, OSNDRCVVOL + INTEGER COMM + INTEGER INDX(NZ_loc) + INTEGER OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWRKSZ) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INCLUDE 'mpif.h' + INTEGER I + INTEGER IIND, IIND2, PIND + INTEGER IERROR + DO I=1,NUMPROCS + SNDSZ(I) = 0 + RCVSZ(I) = 0 + ENDDO + DO I=1,IWRKSZ + IWRK(I) = 0 + ENDDO + DO I=1,NZ_loc + IIND = INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND. + & (IIND2.GE.1).AND.(IIND2.LE.OSZ))THEN + PIND = IPARTVEC(IIND) + IF(PIND .NE. MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWRK(IIND) = 1 + SNDSZ(PIND+1) = SNDSZ(PIND+1)+1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_ALLTOALL(SNDSZ, 1, MPI_INTEGER, + & RCVSZ, 1, MPI_INTEGER, COMM, IERROR) + ISNDRCVNUM = 0 + ISNDRCVVOL = 0 + OSNDRCVNUM = 0 + OSNDRCVVOL = 0 + DO I=1, NUMPROCS + IF(SNDSZ(I) > 0) OSNDRCVNUM = OSNDRCVNUM + 1 + OSNDRCVVOL = OSNDRCVVOL + SNDSZ(I) + IF(RCVSZ(I) > 0) ISNDRCVNUM = ISNDRCVNUM + 1 + ISNDRCVVOL = ISNDRCVVOL + RCVSZ(I) + ENDDO + RETURN + END SUBROUTINE SMUMPS_672 + SUBROUTINE SMUMPS_674(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX, OSZ, OINDX, + & ISNDRCVNUM, ISNDVOL, INGHBPRCS, ISNDRCVIA, ISNDRCVJA, + & OSNDRCVNUM, OSNDVOL, ONGHBPRCS, OSNDRCVIA, OSNDRCVJA, + & SNDSZ, RCVSZ, IWRK, + & ISTATUS, REQUESTS, + & ITAGCOMM, COMM ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, ISNDVOL, OSNDVOL, OSZ + INTEGER INDX(NZ_loc) + INTEGER OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER ISNDRCVNUM, INGHBPRCS(ISNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1) + INTEGER ISNDRCVJA(ISNDVOL) + INTEGER OSNDRCVNUM, ONGHBPRCS(OSNDRCVNUM) + INTEGER OSNDRCVIA(NUMPROCS+1) + INTEGER OSNDRCVJA(OSNDVOL) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INTEGER IWRK(ISZ) + INTEGER ISTATUS(MPI_STATUS_SIZE, ISNDRCVNUM) + INTEGER REQUESTS(ISNDRCVNUM) + INTEGER ITAGCOMM, COMM + INTEGER I, IIND, IIND2, IPID, OFFS + INTEGER IWHERETO, POFFS, ITMP, IERROR + DO I=1,ISZ + IWRK(I) = 0 + ENDDO + OFFS = 1 + POFFS = 1 + DO I=1,NUMPROCS + OSNDRCVIA(I) = OFFS + SNDSZ(I) + IF(SNDSZ(I) > 0) THEN + ONGHBPRCS(POFFS)=I + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + SNDSZ(I) + ENDDO + OSNDRCVIA(NUMPROCS+1) = OFFS + DO I=1,NZ_loc + IIND=INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND. + & (IIND2.GE.1).AND.(IIND2.LE.OSZ) ) THEN + IPID=IPARTVEC(IIND) + IF(IPID.NE.MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWHERETO = OSNDRCVIA(IPID+1)-1 + OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1 + OSNDRCVJA(IWHERETO) = IIND + IWRK(IIND) = 1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + OFFS = 1 + POFFS = 1 + ISNDRCVIA(1) = 1 + DO I=2,NUMPROCS+1 + ISNDRCVIA(I) = OFFS + RCVSZ(I-1) + IF(RCVSZ(I-1) > 0) THEN + INGHBPRCS(POFFS)=I-1 + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + RCVSZ(I-1) + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + DO I=1, ISNDRCVNUM + IPID = INGHBPRCS(I) + OFFS = ISNDRCVIA(IPID) + ITMP = ISNDRCVIA(IPID+1) - ISNDRCVIA(IPID) + CALL MPI_IRECV(ISNDRCVJA(OFFS), ITMP, MPI_INTEGER,IPID-1, + & ITAGCOMM, COMM, REQUESTS(I),IERROR) + ENDDO + DO I=1,OSNDRCVNUM + IPID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(IPID) + ITMP = OSNDRCVIA(IPID+1)-OSNDRCVIA(IPID) + CALL MPI_SEND(OSNDRCVJA(OFFS), ITMP, MPI_INTEGER, IPID-1, + & ITAGCOMM, COMM,IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + CALL MPI_BARRIER(COMM,IERROR) + RETURN + END SUBROUTINE SMUMPS_674 + SUBROUTINE SMUMPS_657(MYID, NUMPROCS,TMPD, IDSZ, ITAGCOMM, + & ISNDRCVNUM, INGHBPRCS, + & ISNDRCVVOL, ISNDRCVIA, ISNDRCVJA, ISNDRCVA, + & OSNDRCVNUM, ONGHBPRCS, + & OSNDRCVVOL, OSNDRCVIA, OSNDRCVJA, OSNDRCVA, + & ISTATUS, REQUESTS, + & COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, IDSZ, ITAGCOMM + INTEGER ISNDRCVNUM,OSNDRCVNUM, ISNDRCVVOL, OSNDRCVVOL + REAL TMPD(IDSZ) + INTEGER INGHBPRCS(ISNDRCVNUM), ONGHBPRCS(OSNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1), ISNDRCVJA(ISNDRCVVOL) + REAL ISNDRCVA(ISNDRCVVOL) + INTEGER OSNDRCVIA(NUMPROCS+1), OSNDRCVJA(OSNDRCVVOL) + REAL OSNDRCVA(OSNDRCVVOL) + INTEGER ISTATUS(MPI_STATUS_SIZE, max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER REQUESTS(max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER COMM, IERROR + INTEGER I, PID, OFFS, SZ, J, JS, JE, IID + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1) - ISNDRCVIA(PID) + CALL MPI_IRECV(ISNDRCVA(OFFS), SZ, + & MPI_REAL, PID-1, + & ITAGCOMM,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS, JE + IID = OSNDRCVJA(J) + OSNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(OSNDRCVA(OFFS), SZ, MPI_REAL, PID-1, + & ITAGCOMM, COMM, IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1)-1 + DO J=JS,JE + IID = ISNDRCVJA(J) + IF(TMPD(IID) < ISNDRCVA(J)) TMPD(IID)= ISNDRCVA(J) + ENDDO + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + CALL MPI_IRECV(OSNDRCVA(OFFS), SZ, + & MPI_REAL, PID-1, + & ITAGCOMM+1,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1)-ISNDRCVIA(PID) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1) -1 + DO J=JS, JE + IID = ISNDRCVJA(J) + ISNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(ISNDRCVA(OFFS), SZ, MPI_REAL, PID-1, + & ITAGCOMM+1, COMM, IERROR) + ENDDO + IF(OSNDRCVNUM > 0) THEN + CALL MPI_WAITALL(OSNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS,JE + IID = OSNDRCVJA(J) + TMPD(IID)=OSNDRCVA(J) + ENDDO + ENDDO + RETURN + END SUBROUTINE SMUMPS_657 + SUBROUTINE SMUMPS_656(MYID, NUMPROCS,TMPD, IDSZ, ITAGCOMM, + & ISNDRCVNUM, INGHBPRCS, + & ISNDRCVVOL, ISNDRCVIA, ISNDRCVJA, ISNDRCVA, + & OSNDRCVNUM, ONGHBPRCS, + & OSNDRCVVOL, OSNDRCVIA, OSNDRCVJA, OSNDRCVA, + & ISTATUS, REQUESTS, + & COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, IDSZ, ITAGCOMM + INTEGER ISNDRCVNUM,OSNDRCVNUM, ISNDRCVVOL, OSNDRCVVOL + REAL TMPD(IDSZ) + INTEGER INGHBPRCS(ISNDRCVNUM), ONGHBPRCS(OSNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1), ISNDRCVJA(ISNDRCVVOL) + REAL ISNDRCVA(ISNDRCVVOL) + INTEGER OSNDRCVIA(NUMPROCS+1), OSNDRCVJA(OSNDRCVVOL) + REAL OSNDRCVA(OSNDRCVVOL) + INTEGER ISTATUS(MPI_STATUS_SIZE, max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER REQUESTS(max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER COMM, IERROR + INTEGER I, PID, OFFS, SZ, J, JS, JE, IID + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1) - ISNDRCVIA(PID) + CALL MPI_IRECV(ISNDRCVA(OFFS), SZ, + & MPI_REAL, PID-1, + & ITAGCOMM,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS, JE + IID = OSNDRCVJA(J) + OSNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(OSNDRCVA(OFFS), SZ, MPI_REAL, PID-1, + & ITAGCOMM, COMM, IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1)-1 + DO J=JS,JE + IID = ISNDRCVJA(J) + TMPD(IID) = TMPD(IID)+ ISNDRCVA(J) + ENDDO + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + CALL MPI_IRECV(OSNDRCVA(OFFS), SZ, + & MPI_REAL, PID-1, + & ITAGCOMM+1,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1)-ISNDRCVIA(PID) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1) -1 + DO J=JS, JE + IID = ISNDRCVJA(J) + ISNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(ISNDRCVA(OFFS), SZ, MPI_REAL, PID-1, + & ITAGCOMM+1, COMM, IERROR) + ENDDO + IF(OSNDRCVNUM > 0) THEN + CALL MPI_WAITALL(OSNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS,JE + IID = OSNDRCVJA(J) + TMPD(IID)=OSNDRCVA(J) + ENDDO + ENDDO + RETURN + END SUBROUTINE SMUMPS_656 + SUBROUTINE SMUMPS_655(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & IPARTVEC, ISZ, + & IWRK, IWSZ) + IMPLICIT NONE + EXTERNAL SMUMPS_703 + INTEGER MYID, NUMPROCS, COMM + INTEGER NZ_loc, ISZ, IWSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWSZ) + INCLUDE 'mpif.h' + INTEGER I + INTEGER OP, IERROR + INTEGER IR, IC + IF(NUMPROCS.NE.1) THEN + CALL MPI_OP_CREATE(SMUMPS_703, .TRUE., OP, IERROR) + CALL SMUMPS_668(IWRK, 4*ISZ, ISZ) + DO I=1,ISZ + IWRK(2*I-1) = 0 + IWRK(2*I) = MYID + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.ISZ).AND. + & (IC.GE.1).AND.(IC.LE.ISZ)) THEN + IWRK(2*IR-1) = IWRK(2*IR-1) + 1 + IWRK(2*IC-1) = IWRK(2*IC-1) + 1 + ENDIF + ENDDO + CALL MPI_ALLREDUCE(IWRK(1), IWRK(1+2*ISZ), ISZ, + & MPI_2INTEGER, OP, COMM, IERROR) + DO I=1,ISZ + IPARTVEC(I) = IWRK(2*I+2*ISZ) + ENDDO + CALL MPI_OP_FREE(OP, IERROR) + ELSE + DO I=1,ISZ + IPARTVEC(I) = 0 + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_655 + SUBROUTINE SMUMPS_673(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX,OINDX,ISNDRCVNUM,ISNDRCVVOL,OSNDRCVNUM,OSNDRCVVOL, + & IWRK,IWRKSZ, SNDSZ, RCVSZ, COMM) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, IWRKSZ + INTEGER ISNDRCVNUM, ISNDRCVVOL + INTEGER OSNDRCVNUM, OSNDRCVVOL + INTEGER COMM + INTEGER INDX(NZ_loc), OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWRKSZ) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INCLUDE 'mpif.h' + INTEGER I + INTEGER IIND, IIND2, PIND + INTEGER IERROR + DO I=1,NUMPROCS + SNDSZ(I) = 0 + RCVSZ(I) = 0 + ENDDO + DO I=1,IWRKSZ + IWRK(I) = 0 + ENDDO + DO I=1,NZ_loc + IIND = INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND.(IIND2.GE.1) + & .AND.(IIND2.LE.ISZ)) THEN + PIND = IPARTVEC(IIND) + IF(PIND .NE. MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWRK(IIND) = 1 + SNDSZ(PIND+1) = SNDSZ(PIND+1)+1 + ENDIF + ENDIF + IIND = OINDX(I) + PIND = IPARTVEC(IIND) + IF(PIND .NE. MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWRK(IIND) = 1 + SNDSZ(PIND+1) = SNDSZ(PIND+1)+1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_ALLTOALL(SNDSZ, 1, MPI_INTEGER, + & RCVSZ, 1, MPI_INTEGER, COMM, IERROR) + ISNDRCVNUM = 0 + ISNDRCVVOL = 0 + OSNDRCVNUM = 0 + OSNDRCVVOL = 0 + DO I=1, NUMPROCS + IF(SNDSZ(I) > 0) OSNDRCVNUM = OSNDRCVNUM + 1 + OSNDRCVVOL = OSNDRCVVOL + SNDSZ(I) + IF(RCVSZ(I) > 0) ISNDRCVNUM = ISNDRCVNUM + 1 + ISNDRCVVOL = ISNDRCVVOL + RCVSZ(I) + ENDDO + RETURN + END SUBROUTINE SMUMPS_673 + SUBROUTINE SMUMPS_663(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & INUMMYR, + & IWRK, IWSZ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, N + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER PARTVEC(N) + INTEGER INUMMYR + INTEGER IWSZ + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC + INUMMYR = 0 + DO I=1,N + IWRK(I) = 0 + IF(PARTVEC(I).EQ.MYID) THEN + IWRK(I)=1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IR) .EQ. 0) THEN + IWRK(IR)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IC).EQ.0) THEN + IWRK(IC)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_663 + INTEGER FUNCTION SMUMPS_742(D, N, INDXR, INDXRSZ, + & EPS, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER N, INDXRSZ + REAL D(N) + INTEGER INDXR(INDXRSZ) + REAL EPS + INTEGER COMM + EXTERNAL SMUMPS_744 + INTEGER SMUMPS_744 + INTEGER GLORES, MYRESR, MYRES + INTEGER IERR + MYRESR = SMUMPS_744(D, N, INDXR, INDXRSZ, EPS) + MYRES = 2*MYRESR + CALL MPI_ALLREDUCE(MYRES, GLORES, 1, MPI_INTEGER, + & MPI_SUM, COMM, IERR) + SMUMPS_742 = GLORES + RETURN + END FUNCTION SMUMPS_742 + SUBROUTINE SMUMPS_661(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & MYROWINDICES, INUMMYR, + & IWRK, IWSZ ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, N + INTEGER INUMMYR, IWSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER PARTVEC(N) + INTEGER MYROWINDICES(INUMMYR) + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC, ITMP, MAXMN + MAXMN = N + DO I=1,N + IWRK(I) = 0 + IF(PARTVEC(I).EQ.MYID) IWRK(I)=1 + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IR) .EQ. 0) IWRK(IR)= 1 + ENDIF + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IC) .EQ.0) IWRK(IC)=1 + ENDIF + ENDDO + ITMP = 1 + DO I=1,N + IF(IWRK(I).EQ.1) THEN + MYROWINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_661 + SUBROUTINE SMUMPS_692(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX, OINDX, + & ISNDRCVNUM, ISNDVOL, INGHBPRCS, ISNDRCVIA, ISNDRCVJA, + & OSNDRCVNUM, OSNDVOL, ONGHBPRCS, OSNDRCVIA, OSNDRCVJA, + & SNDSZ, RCVSZ, IWRK, + & ISTATUS, REQUESTS, + & ITAGCOMM, COMM ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, ISNDVOL, OSNDVOL + INTEGER INDX(NZ_loc), OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER ISNDRCVNUM, INGHBPRCS(ISNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1) + INTEGER ISNDRCVJA(ISNDVOL) + INTEGER OSNDRCVNUM, ONGHBPRCS(OSNDRCVNUM) + INTEGER OSNDRCVIA(NUMPROCS+1) + INTEGER OSNDRCVJA(OSNDVOL) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INTEGER IWRK(ISZ) + INTEGER ISTATUS(MPI_STATUS_SIZE, ISNDRCVNUM) + INTEGER REQUESTS(ISNDRCVNUM) + INTEGER ITAGCOMM, COMM + INTEGER I, IIND,IIND2,IPID,OFFS,IWHERETO,POFFS, ITMP, IERROR + DO I=1,ISZ + IWRK(I) = 0 + ENDDO + OFFS = 1 + POFFS = 1 + DO I=1,NUMPROCS + OSNDRCVIA(I) = OFFS + SNDSZ(I) + IF(SNDSZ(I) > 0) THEN + ONGHBPRCS(POFFS)=I + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + SNDSZ(I) + ENDDO + OSNDRCVIA(NUMPROCS+1) = OFFS + DO I=1,NZ_loc + IIND=INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND.(IIND2.GE.1) + & .AND.(IIND2.LE.ISZ)) THEN + IPID=IPARTVEC(IIND) + IF(IPID.NE.MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWHERETO = OSNDRCVIA(IPID+1)-1 + OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1 + OSNDRCVJA(IWHERETO) = IIND + IWRK(IIND) = 1 + ENDIF + ENDIF + IIND = OINDX(I) + IPID=IPARTVEC(IIND) + IF(IPID.NE.MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWHERETO = OSNDRCVIA(IPID+1)-1 + OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1 + OSNDRCVJA(IWHERETO) = IIND + IWRK(IIND) = 1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + OFFS = 1 + POFFS = 1 + ISNDRCVIA(1) = 1 + DO I=2,NUMPROCS+1 + ISNDRCVIA(I) = OFFS + RCVSZ(I-1) + IF(RCVSZ(I-1) > 0) THEN + INGHBPRCS(POFFS)=I-1 + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + RCVSZ(I-1) + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + DO I=1, ISNDRCVNUM + IPID = INGHBPRCS(I) + OFFS = ISNDRCVIA(IPID) + ITMP = ISNDRCVIA(IPID+1) - ISNDRCVIA(IPID) + CALL MPI_IRECV(ISNDRCVJA(OFFS), ITMP, MPI_INTEGER,IPID-1, + & ITAGCOMM, COMM, REQUESTS(I),IERROR) + ENDDO + DO I=1,OSNDRCVNUM + IPID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(IPID) + ITMP = OSNDRCVIA(IPID+1)-OSNDRCVIA(IPID) + CALL MPI_SEND(OSNDRCVJA(OFFS), ITMP, MPI_INTEGER, IPID-1, + & ITAGCOMM, COMM,IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + CALL MPI_BARRIER(COMM,IERROR) + RETURN + END SUBROUTINE SMUMPS_692 + SUBROUTINE SMUMPS_628(IW,LREC,SIZE_FREE,XSIZE) + INTEGER, intent(in) :: LREC, XSIZE + INTEGER, intent(in) :: IW(LREC) + INTEGER(8), intent(out):: SIZE_FREE + INCLUDE 'mumps_headers.h' + IF (IW(1+XXS).EQ.S_NOLCBCONTIG .OR. + & IW(1+XXS).EQ.S_NOLCBNOCONTIG) THEN + SIZE_FREE=int(IW(1+XSIZE+2),8)*int(IW(1+XSIZE+3),8) + ELSE IF (IW(1+XXS).EQ.S_NOLCBCONTIG38 .OR. + & IW(1+XXS).EQ.S_NOLCBNOCONTIG38) THEN + SIZE_FREE=int(IW(1+XSIZE+2),8)*int(IW(1+XSIZE)+ + & IW(1+XSIZE + 3) - + & ( IW(1+XSIZE + 4) + & - IW(1+XSIZE + 3) ), 8) + ELSE + SIZE_FREE=0_8 + ENDIF + RETURN + END SUBROUTINE SMUMPS_628 + SUBROUTINE SMUMPS_629 + &(IW,LIW,IXXP,ICURRENT,NEXT, RCURRENT,ISIZE2SHIFT) + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER(8) :: RCURRENT + INTEGER LIW,IXXP,ICURRENT,NEXT,ISIZE2SHIFT + INTEGER IW(LIW) + INTEGER(8) :: RSIZE + ICURRENT=NEXT + CALL MUMPS_729( RSIZE, IW(ICURRENT + XXR) ) + RCURRENT = RCURRENT - RSIZE + NEXT=IW(ICURRENT+XXP) + IW(IXXP)=ICURRENT+ISIZE2SHIFT + IXXP=ICURRENT+XXP + RETURN + END SUBROUTINE SMUMPS_629 + SUBROUTINE SMUMPS_630(IW,LIW,BEG2SHIFT,END2SHIFT,ISIZE2SHIFT) + IMPLICIT NONE + INTEGER LIW, BEG2SHIFT, END2SHIFT, ISIZE2SHIFT + INTEGER IW(LIW) + INTEGER I + IF (ISIZE2SHIFT.GT.0) THEN + DO I=END2SHIFT,BEG2SHIFT,-1 + IW(I+ISIZE2SHIFT)=IW(I) + ENDDO + ELSE IF (ISIZE2SHIFT.LT.0) THEN + DO I=BEG2SHIFT,END2SHIFT + IW(I+ISIZE2SHIFT)=IW(I) + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_630 + SUBROUTINE SMUMPS_631(A, LA, BEG2SHIFT, END2SHIFT, RSIZE2SHIFT) + IMPLICIT NONE + INTEGER(8) :: LA, BEG2SHIFT, END2SHIFT, RSIZE2SHIFT + REAL A(LA) + INTEGER(8) :: I + IF (RSIZE2SHIFT.GT.0_8) THEN + DO I=END2SHIFT,BEG2SHIFT,-1_8 + A(I+RSIZE2SHIFT)=A(I) + ENDDO + ELSE IF (RSIZE2SHIFT.LT.0_8) THEN + DO I=BEG2SHIFT,END2SHIFT + A(I+RSIZE2SHIFT)=A(I) + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_631 + SUBROUTINE SMUMPS_94(N,KEEP28,IW,LIW,A,LA, + & LRLU,IPTRLU,IWPOS, + & IWPOSCB,PTRIST,PTRAST,STEP,PIMASTER,PAMASTER, + & KEEP216,LRLUS,XSIZE) + IMPLICIT NONE + INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS + INTEGER N,LIW,KEEP28, + & IWPOS,IWPOSCB,KEEP216,XSIZE + INTEGER(8) :: PTRAST(KEEP28), PAMASTER(KEEP28) + INTEGER IW(LIW),PTRIST(KEEP28), + & STEP(N), PIMASTER(KEEP28) + REAL A(LA) + INCLUDE 'mumps_headers.h' + INTEGER ICURRENT, NEXT, STATE_NEXT + INTEGER(8) :: RCURRENT + INTEGER ISIZE2SHIFT + INTEGER(8) :: RSIZE2SHIFT + INTEGER IBEGCONTIG + INTEGER(8) :: RBEGCONTIG + INTEGER(8) :: RBEG2SHIFT, REND2SHIFT + INTEGER INODE + INTEGER(8) :: FREE_IN_REC + INTEGER(8) :: RCURRENT_SIZE + INTEGER IXXP + ISIZE2SHIFT=0 + RSIZE2SHIFT=0_8 + ICURRENT = LIW-XSIZE+1 + RCURRENT = LA+1_8 + IBEGCONTIG = -999999 + RBEGCONTIG = -999999_8 + NEXT = IW(ICURRENT+XXP) + IF (NEXT.EQ.TOP_OF_STACK) RETURN + STATE_NEXT = IW(NEXT+XXS) + IXXP = ICURRENT+XXP + 10 CONTINUE + IF ( STATE_NEXT .NE. S_FREE .AND. + & (KEEP216.EQ.3.OR. + & (STATE_NEXT .NE. S_NOLCBNOCONTIG .AND. + & STATE_NEXT .NE. S_NOLCBCONTIG .AND. + & STATE_NEXT .NE. S_NOLCBNOCONTIG38 .AND. + & STATE_NEXT .NE. S_NOLCBCONTIG38))) THEN + CALL SMUMPS_629(IW,LIW, + & IXXP, ICURRENT, NEXT, RCURRENT, ISIZE2SHIFT) + CALL MUMPS_729(RCURRENT_SIZE, IW(ICURRENT+XXR)) + IF (IBEGCONTIG < 0) THEN + IBEGCONTIG=ICURRENT+IW(ICURRENT+XXI)-1 + ENDIF + IF (RBEGCONTIG < 0_8) THEN + RBEGCONTIG=RCURRENT+RCURRENT_SIZE-1_8 + ENDIF + INODE=IW(ICURRENT+XXN) + IF (RSIZE2SHIFT .NE. 0_8) THEN + IF (PTRAST(STEP(INODE)).EQ.RCURRENT) + & PTRAST(STEP(INODE))= + & PTRAST(STEP(INODE))+RSIZE2SHIFT + IF (PAMASTER(STEP(INODE)).EQ.RCURRENT) + & PAMASTER(STEP(INODE))= + & PAMASTER(STEP(INODE))+RSIZE2SHIFT + ENDIF + IF (ISIZE2SHIFT .NE. 0) THEN + IF (PTRIST(STEP(INODE)).EQ.ICURRENT) + & PTRIST(STEP(INODE))= + & PTRIST(STEP(INODE))+ISIZE2SHIFT + IF (PIMASTER(STEP(INODE)).EQ.ICURRENT) + & PIMASTER(STEP(INODE))= + & PIMASTER(STEP(INODE))+ISIZE2SHIFT + ENDIF + IF (NEXT .NE. TOP_OF_STACK) THEN + STATE_NEXT=IW(NEXT+XXS) + GOTO 10 + ENDIF + ENDIF + 20 CONTINUE + IF (IBEGCONTIG.NE.0 .AND. ISIZE2SHIFT .NE. 0) THEN + CALL SMUMPS_630(IW,LIW,ICURRENT,IBEGCONTIG,ISIZE2SHIFT) + IF (IXXP .LE.IBEGCONTIG) THEN + IXXP=IXXP+ISIZE2SHIFT + ENDIF + ENDIF + IBEGCONTIG=-9999 + 25 CONTINUE + IF (RBEGCONTIG .GT.0_8 .AND. RSIZE2SHIFT .NE. 0_8) THEN + CALL SMUMPS_631(A,LA,RCURRENT,RBEGCONTIG,RSIZE2SHIFT) + ENDIF + RBEGCONTIG=-99999_8 + 30 CONTINUE + IF (NEXT.EQ. TOP_OF_STACK) GOTO 100 + IF (STATE_NEXT .EQ. S_NOLCBCONTIG .OR. + & STATE_NEXT .EQ. S_NOLCBNOCONTIG .OR. + & STATE_NEXT .EQ. S_NOLCBCONTIG38 .OR. + & STATE_NEXT .EQ. S_NOLCBNOCONTIG38) THEN + IF ( KEEP216.eq.3) THEN + WRITE(*,*) "Internal error 2 in SMUMPS_94" + ENDIF + IF (RBEGCONTIG > 0_8) GOTO 25 + CALL SMUMPS_629 + & (IW,LIW,IXXP,ICURRENT,NEXT, RCURRENT,ISIZE2SHIFT) + IF (IBEGCONTIG < 0 ) THEN + IBEGCONTIG=ICURRENT+IW(ICURRENT+XXI)-1 + ENDIF + CALL SMUMPS_628(IW(ICURRENT), + & LIW-ICURRENT+1, + & FREE_IN_REC, + & XSIZE) + IF (STATE_NEXT .EQ. S_NOLCBNOCONTIG) THEN + CALL SMUMPS_627(A,LA,RCURRENT, + & IW(ICURRENT+XSIZE+2), + & IW(ICURRENT+XSIZE), + & IW(ICURRENT+XSIZE)+IW(ICURRENT+XSIZE+3), 0, + & IW(ICURRENT+XXS),RSIZE2SHIFT) + ELSE IF (STATE_NEXT .EQ. S_NOLCBNOCONTIG38) THEN + CALL SMUMPS_627(A,LA,RCURRENT, + & IW(ICURRENT+XSIZE+2), + & IW(ICURRENT+XSIZE), + & IW(ICURRENT+XSIZE)+IW(ICURRENT+XSIZE+3), + & IW(ICURRENT+XSIZE+4)-IW(ICURRENT+XSIZE+3), + & IW(ICURRENT+XXS),RSIZE2SHIFT) + ELSE IF (RSIZE2SHIFT .GT.0_8) THEN + RBEG2SHIFT = RCURRENT + FREE_IN_REC + CALL MUMPS_729(RCURRENT_SIZE, IW(ICURRENT+XXR)) + REND2SHIFT = RCURRENT + RCURRENT_SIZE - 1_8 + CALL SMUMPS_631(A, LA, + & RBEG2SHIFT, REND2SHIFT, + & RSIZE2SHIFT) + ENDIF + INODE=IW(ICURRENT+XXN) + IF (ISIZE2SHIFT.NE.0) THEN + PTRIST(STEP(INODE))=PTRIST(STEP(INODE))+ISIZE2SHIFT + ENDIF + PTRAST(STEP(INODE))=PTRAST(STEP(INODE))+RSIZE2SHIFT+ + & FREE_IN_REC + CALL MUMPS_724(IW(ICURRENT+XXR),FREE_IN_REC) + IF (STATE_NEXT.EQ.S_NOLCBCONTIG.OR. + & STATE_NEXT.EQ.S_NOLCBNOCONTIG) THEN + IW(ICURRENT+XXS)=S_NOLCLEANED + ELSE + IW(ICURRENT+XXS)=S_NOLCLEANED38 + ENDIF + RSIZE2SHIFT=RSIZE2SHIFT+FREE_IN_REC + RBEGCONTIG=-9999_8 + IF (NEXT.EQ.TOP_OF_STACK) THEN + GOTO 20 + ELSE + STATE_NEXT=IW(NEXT+XXS) + ENDIF + GOTO 30 + ENDIF + IF (IBEGCONTIG.GT.0) THEN + GOTO 20 + ENDIF + 40 CONTINUE + IF (STATE_NEXT == S_FREE) THEN + ICURRENT = NEXT + CALL MUMPS_729( RCURRENT_SIZE, IW(ICURRENT + XXR) ) + ISIZE2SHIFT = ISIZE2SHIFT + IW(ICURRENT+XXI) + RSIZE2SHIFT = RSIZE2SHIFT + RCURRENT_SIZE + RCURRENT = RCURRENT - RCURRENT_SIZE + NEXT=IW(ICURRENT+XXP) + IF (NEXT.EQ.TOP_OF_STACK) THEN + WRITE(*,*) "Internal error 1 in SMUMPS_94" + CALL MUMPS_ABORT() + ENDIF + STATE_NEXT = IW(NEXT+XXS) + GOTO 40 + ENDIF + GOTO 10 + 100 CONTINUE + IWPOSCB = IWPOSCB + ISIZE2SHIFT + LRLU = LRLU + RSIZE2SHIFT + IPTRLU = IPTRLU + RSIZE2SHIFT + RETURN + END SUBROUTINE SMUMPS_94 + SUBROUTINE SMUMPS_632(IREC, IW, LIW, + & ISIZEHOLE, RSIZEHOLE) + IMPLICIT NONE + INTEGER, intent(in) :: IREC, LIW + INTEGER, intent(in) :: IW(LIW) + INTEGER, intent(out):: ISIZEHOLE + INTEGER(8), intent(out) :: RSIZEHOLE + INTEGER IRECLOC + INTEGER(8) :: RECLOC_SIZE + INCLUDE 'mumps_headers.h' + ISIZEHOLE=0 + RSIZEHOLE=0_8 + IRECLOC = IREC + IW( IREC+XXI ) + 10 CONTINUE + CALL MUMPS_729(RECLOC_SIZE, IW(IRECLOC+XXR)) + IF (IW(IRECLOC+XXS).EQ.S_FREE) THEN + ISIZEHOLE=ISIZEHOLE+IW(IRECLOC+XXI) + RSIZEHOLE=RSIZEHOLE+RECLOC_SIZE + IRECLOC=IRECLOC+IW(IRECLOC+XXI) + GOTO 10 + ENDIF + RETURN + END SUBROUTINE SMUMPS_632 + SUBROUTINE SMUMPS_627(A, LA, RCURRENT, + & NROW, NCB, LD, NELIM, NODESTATE, ISHIFT) + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER LD, NROW, NCB, NELIM, NODESTATE + INTEGER(8) :: ISHIFT + INTEGER(8) :: LA, RCURRENT + REAL A(LA) + INTEGER I,J + INTEGER(8) :: IOLD,INEW + LOGICAL NELIM_ROOT + NELIM_ROOT=.TRUE. + IF (NODESTATE.EQ. S_NOLCBNOCONTIG) THEN + NELIM_ROOT=.FALSE. + IF (NELIM.NE.0) THEN + WRITE(*,*) "Internal error 1 IN SMUMPS_627" + CALL MUMPS_ABORT() + ENDIF + ELSE IF (NODESTATE .NE. S_NOLCBNOCONTIG38) THEN + WRITE(*,*) "Internal error 2 in SMUMPS_627" + & ,NODESTATE + CALL MUMPS_ABORT() + ENDIF + IF (ISHIFT .LT.0_8) THEN + WRITE(*,*) "Internal error 3 in SMUMPS_627",ISHIFT + CALL MUMPS_ABORT() + ENDIF + IF (NELIM_ROOT) THEN + IOLD=RCURRENT+int(LD,8)*int(NROW,8)+int(NELIM-1-NCB,8) + ELSE + IOLD = RCURRENT+int(LD,8)*int(NROW,8)-1_8 + ENDIF + INEW = RCURRENT+int(LD,8)*int(NROW,8)+ISHIFT-1_8 + DO I = NROW, 1, -1 + IF (I.EQ.NROW .AND. ISHIFT.EQ.0_8.AND. + & .NOT. NELIM_ROOT) THEN + IOLD=IOLD-int(LD,8) + INEW=INEW-int(NCB,8) + CYCLE + ENDIF + IF (NELIM_ROOT) THEN + DO J=1,NELIM + A( INEW ) = A( IOLD + int(- J + 1,8)) + INEW = INEW - 1_8 + ENDDO + ELSE + DO J=1, NCB + A( INEW ) = A( IOLD + int(- J + 1, 8)) + INEW = INEW - 1_8 + ENDDO + ENDIF + IOLD = IOLD - int(LD,8) + ENDDO + IF (NELIM_ROOT) THEN + NODESTATE=S_NOLCBCONTIG38 + ELSE + NODESTATE=S_NOLCBCONTIG + ENDIF + RETURN + END SUBROUTINE SMUMPS_627 + SUBROUTINE SMUMPS_700(BUFR,LBUFR, + & LBUFR_BYTES, + & root, N, IW, LIW, A, LA, + & NBPROCFILS, LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, + & COMP, LRLUS, IPOOL, LPOOL, LEAF, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, + & ITLOC, RHS_MUMPS, + & ND,PROCNODE_STEPS,SLAVEF ) + USE SMUMPS_LOAD + USE SMUMPS_OOC + IMPLICIT NONE + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC ) :: root + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER LBUFR, LBUFR_BYTES, N, LIW, + & IWPOS, IWPOSCB, COMP, COMM, COMM_LOAD, IFLAG, + & IERROR + INTEGER LPOOL, LEAF + INTEGER IPOOL( LEAF ) + INTEGER PTRIST(KEEP(28)) + INTEGER PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)), ITLOC( N+KEEP(253) ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER BUFR( LBUFR_BYTES ), NBPROCFILS( KEEP(28) ) + INTEGER IW( LIW ) + INTEGER ND(KEEP(28)), PROCNODE_STEPS(KEEP(28)),SLAVEF + REAL A( LA ) + INTEGER MYID + INTEGER FILS( N ), PTRAIW(N), PTRARW( N ) + INTEGER INTARR(max(1,KEEP(14))) + REAL DBLARR(max(1,KEEP(13))) + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER POSITION, LOCAL_M, LOCAL_N, LREQI + INTEGER(8) :: LREQA, POS_ROOT + INTEGER NSUBSET_ROW, NSUBSET_COL, IROOT, ISON, NSUBSET_COL_EFF + INTEGER NSUPCOL_EFF + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INTEGER NSUPROW, NSUPCOL, BBPCBP + INCLUDE 'mumps_headers.h' + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & ISON, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUBSET_ROW, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUPROW, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUBSET_COL, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUPCOL, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, MPI_INTEGER, + & COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & BBPCBP, 1, MPI_INTEGER, + & COMM, IERR ) + IF (BBPCBP .EQ. 1) THEN + NSUBSET_COL_EFF = NSUBSET_COL - NSUPCOL + NSUPCOL_EFF = 0 + ELSE + NSUBSET_COL_EFF = NSUBSET_COL + NSUPCOL_EFF = NSUPCOL + ENDIF + IROOT = KEEP( 38 ) + IF ( PTRIST( STEP(IROOT) ) .NE. 0 .OR. + & PTLUST_S( STEP(IROOT)) .NE. 0 ) THEN + IF (NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. NSUBSET_ROW + & - NSUPROW .OR. NSUBSET_ROW - NSUPROW.EQ.0 .OR. + & NSUBSET_COL_EFF .EQ. 0)THEN + NBPROCFILS(STEP(IROOT)) = NBPROCFILS(STEP(IROOT))-1 + IF ( NBPROCFILS( STEP(IROOT) ) .eq. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + CALL SMUMPS_681(IERR) + ELSEIF (KEEP(201).EQ.2) THEN + CALL SMUMPS_580(IERR) + ENDIF + CALL SMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), + & STEP, IROOT + N) + IF (KEEP(47) .GE. 3) THEN + CALL SMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + ENDIF + ENDIF + ELSE + IF (NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. + & NSUBSET_ROW - NSUPROW .OR. + & NSUBSET_ROW - NSUPROW.EQ.0 .OR. + & NSUBSET_COL_EFF .EQ. 0)THEN + NBPROCFILS(STEP( IROOT ) ) = -1 + ENDIF + IF (KEEP(60) == 0) THEN + CALL SMUMPS_284( root, IROOT, N, + & IW, LIW, A, LA, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + IF ( IFLAG .LT. 0 ) RETURN + ELSE + PTRIST(STEP(IROOT)) = -55555 + ENDIF + END IF + IF (KEEP(60) .EQ.0) THEN + IF ( PTRIST(STEP(IROOT)) .GE. 0 ) THEN + IF ( PTRIST(STEP(IROOT)) .NE. 0 ) THEN + LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) ) + LOCAL_M = IW( PTRIST(STEP( IROOT )) + 1 + KEEP(IXSZ)) + POS_ROOT = PAMASTER(STEP( IROOT )) + ELSE + LOCAL_N = IW( PTLUST_S(STEP( IROOT ) ) + 1 + KEEP(IXSZ)) + LOCAL_M = IW( PTLUST_S(STEP( IROOT ) ) + 2 + KEEP(IXSZ)) + POS_ROOT = PTRFAC(IW(PTLUST_S(STEP(IROOT))+4+ + & KEEP(IXSZ))) + END IF + ENDIF + ELSE + LOCAL_M = root%SCHUR_LLD + LOCAL_N = root%SCHUR_NLOC + ENDIF + IF ( (BBPCBP.EQ.1).AND. (NBROWS_ALREADY_SENT.EQ.0).AND. + & (min(NSUPROW, NSUPCOL) .GT. 0) + & ) THEN + LREQI = NSUPROW+NSUPCOL + LREQA = int(NSUPROW,8) * int(NSUPCOL,8) + IF ( (LREQA.NE.0_8) .AND. + & (PTRIST(STEP(IROOT)).LT.0).AND. + & KEEP(60)==0) THEN + WRITE(*,*) ' Error in SMUMPS_700' + CALL MUMPS_ABORT() + ENDIF + CALL SMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A, LA, + & LRLU, IPTRLU, IWPOS, IWPOSCB, PTRIST, + & PTRAST, STEP, PIMASTER, PAMASTER, + & LREQI, LREQA, -1234, S_NOTFREE, .FALSE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IWPOSCB + 1 ), LREQI, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A( IPTRLU + 1_8 ), int(LREQA), + & MPI_REAL, COMM, IERR ) + CALL SMUMPS_38( NSUPROW, NSUPCOL, + & IW( IWPOSCB + 1 ), + & IW( IWPOSCB + NSUPROW + 1 ), NSUPCOL, + & A( IPTRLU + 1_8 ), + & A( 1 ), + & LOCAL_M, LOCAL_N, + & root%RHS_ROOT(1,1), root%RHS_NLOC, + & 1) + IWPOSCB = IWPOSCB + LREQI + IPTRLU = IPTRLU + LREQA + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU) + ENDIF + LREQI = NBROWS_PACKET + NSUBSET_COL_EFF + LREQA = int(NBROWS_PACKET,8) * int(NSUBSET_COL_EFF,8) + IF ( (LREQA.NE.0_8) .AND. + & (PTRIST(STEP(IROOT)).LT.0).AND. + & KEEP(60)==0) THEN + WRITE(*,*) ' Error in SMUMPS_700' + CALL MUMPS_ABORT() + ENDIF + IF (LREQA.NE.0_8) THEN + CALL SMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A, LA, + & LRLU, IPTRLU, IWPOS, IWPOSCB, PTRIST, + & PTRAST, STEP, PIMASTER, PAMASTER, + & LREQI, LREQA, -1234, S_NOTFREE, .FALSE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IWPOSCB + 1 ), LREQI, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A( IPTRLU + 1_8 ), int(LREQA), + & MPI_REAL, COMM, IERR ) + IF (KEEP(60).EQ.0) THEN + CALL SMUMPS_38( NBROWS_PACKET, NSUBSET_COL_EFF, + & IW( IWPOSCB + 1 ), + & IW( IWPOSCB + NBROWS_PACKET + 1 ), + & NSUPCOL_EFF, + & A( IPTRLU + 1_8 ), + & A( POS_ROOT ), LOCAL_M, LOCAL_N, + & root%RHS_ROOT(1,1), root%RHS_NLOC, + & 0) + ELSE + CALL SMUMPS_38( NBROWS_PACKET, NSUBSET_COL_EFF, + & IW( IWPOSCB + 1 ), + & IW( IWPOSCB + NBROWS_PACKET + 1 ), + & NSUPCOL_EFF, + & A( IPTRLU + 1_8 ), + & root%SCHUR_POINTER(1), + & root%SCHUR_LLD , root%SCHUR_NLOC, + & root%RHS_ROOT(1,1), root%RHS_NLOC, + & 0) + ENDIF + IWPOSCB = IWPOSCB + LREQI + IPTRLU = IPTRLU + LREQA + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU) + ENDIF + RETURN + END SUBROUTINE SMUMPS_700 + SUBROUTINE SMUMPS_762(PIV, DETER, NEXP) + IMPLICIT NONE + REAL, intent(in) :: PIV + REAL, intent(inout) :: DETER + INTEGER, intent(inout) :: NEXP + DETER=DETER*fraction(PIV) + NEXP=NEXP+exponent(PIV)+exponent(DETER) + DETER=fraction(DETER) + RETURN + END SUBROUTINE SMUMPS_762 + SUBROUTINE SMUMPS_761(PIV, DETER, NEXP) + IMPLICIT NONE + REAL, intent(in) :: PIV + REAL, intent(inout) :: DETER + INTEGER, intent(inout) :: NEXP + DETER=DETER*fraction(PIV) + NEXP=NEXP+exponent(PIV)+exponent(DETER) + DETER=fraction(DETER) + RETURN + END SUBROUTINE SMUMPS_761 + SUBROUTINE SMUMPS_763(BLOCK_SIZE,IPIV, + & MYROW, MYCOL, NPROW, NPCOL, + & A, LOCAL_M, LOCAL_N, N, MYID, + & DETER,NEXP,SYM) + IMPLICIT NONE + INTEGER, intent (in) :: SYM + INTEGER, intent (inout) :: NEXP + REAL, intent (inout) :: DETER + INTEGER, intent (in) :: BLOCK_SIZE, NPROW, NPCOL, + & LOCAL_M, LOCAL_N, N + INTEGER, intent (in) :: MYROW, MYCOL, MYID, IPIV(LOCAL_M) + REAL, intent(in) :: A(*) + INTEGER I,IMX,DI,NBLOCK,IBLOCK,ILOC,JLOC, + & ROW_PROC,COL_PROC, K + DI = LOCAL_M + 1 + NBLOCK = ( N - 1 ) / BLOCK_SIZE + DO IBLOCK = 0, NBLOCK + ROW_PROC = mod( IBLOCK, NPROW ) + IF ( MYROW.EQ.ROW_PROC ) THEN + COL_PROC = mod( IBLOCK, NPCOL ) + IF ( MYCOL.EQ.COL_PROC ) THEN + ILOC = ( IBLOCK / NPROW ) * BLOCK_SIZE + JLOC = ( IBLOCK / NPCOL ) * BLOCK_SIZE + I = ILOC + JLOC * LOCAL_M + 1 + IMX = min(ILOC+BLOCK_SIZE,LOCAL_M) + & + (min(JLOC+BLOCK_SIZE,LOCAL_N)-1)*LOCAL_M + & + 1 + K=1 + DO WHILE ( I .LT. IMX ) + CALL SMUMPS_762(A(I),DETER,NEXP) + IF (SYM.NE.1) THEN + IF (IPIV(ILOC+K) .NE. IBLOCK*BLOCK_SIZE+K) THEN + DETER = -DETER + ENDIF + ENDIF + K = K + 1 + I = I + DI + END DO + END IF + END IF + END DO + RETURN + END SUBROUTINE SMUMPS_763 + SUBROUTINE SMUMPS_764( + & COMM, DETER_IN, NEXP_IN, + & DETER_OUT, NEXP_OUT, NPROCS) + IMPLICIT NONE + INTEGER, intent(in) :: COMM, NPROCS + REAL, intent(in) :: DETER_IN + INTEGER,intent(in) :: NEXP_IN + REAL,intent(out):: DETER_OUT + INTEGER,intent(out):: NEXP_OUT + INTEGER :: IERR_MPI + EXTERNAL SMUMPS_771 + INTEGER TWO_SCALARS_TYPE, DETERREDUCE_OP + REAL :: INV(2) + REAL :: OUTV(2) + INCLUDE 'mpif.h' + IF (NPROCS .EQ. 1) THEN + DETER_OUT = DETER_IN + NEXP_OUT = NEXP_IN + RETURN + ENDIF + CALL MPI_TYPE_CONTIGUOUS(2, MPI_REAL, + & TWO_SCALARS_TYPE, + & IERR_MPI) + CALL MPI_TYPE_COMMIT(TWO_SCALARS_TYPE, IERR_MPI) + CALL MPI_OP_CREATE(SMUMPS_771, + & .TRUE., + & DETERREDUCE_OP, + & IERR_MPI) + INV(1)=DETER_IN + INV(2)=real(NEXP_IN) + CALL MPI_ALLREDUCE( INV, OUTV, 1, TWO_SCALARS_TYPE, + & DETERREDUCE_OP, COMM, IERR_MPI) + CALL MPI_OP_FREE(DETERREDUCE_OP, IERR_MPI) + CALL MPI_TYPE_FREE(TWO_SCALARS_TYPE, IERR_MPI) + DETER_OUT = OUTV(1) + NEXP_OUT = int(OUTV(2)) + RETURN + END SUBROUTINE SMUMPS_764 + SUBROUTINE SMUMPS_771(INV, INOUTV, NEL, DATATYPE) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NEL, DATATYPE + REAL, INTENT(IN) :: INV ( 2 * NEL ) + REAL, INTENT(INOUT) :: INOUTV ( 2 * NEL ) + INTEGER I, TMPEXPIN, TMPEXPINOUT + DO I = 1, NEL + TMPEXPIN = int(INV (I*2)) + TMPEXPINOUT = int(INOUTV(I*2)) + CALL SMUMPS_762(INV(I*2-1), + & INOUTV(I*2-1), + & TMPEXPINOUT) + TMPEXPINOUT = TMPEXPINOUT + TMPEXPIN + INOUTV(I*2) = real(TMPEXPINOUT) + ENDDO + RETURN + END SUBROUTINE SMUMPS_771 + SUBROUTINE SMUMPS_765(DETER, NEXP) + IMPLICIT NONE + INTEGER, intent (inout) :: NEXP + REAL, intent (inout) :: DETER + DETER=DETER*DETER + NEXP=NEXP+NEXP + RETURN + END SUBROUTINE SMUMPS_765 + SUBROUTINE SMUMPS_766(DETER, NEXP) + IMPLICIT NONE + INTEGER, intent (inout) :: NEXP + REAL, intent (inout) :: DETER + DETER=1.0E0/DETER + NEXP=-NEXP + RETURN + END SUBROUTINE SMUMPS_766 + SUBROUTINE SMUMPS_767(DETER, N, VISITED, PERM) + IMPLICIT NONE + REAL, intent(inout) :: DETER + INTEGER, intent(in) :: N + INTEGER, intent(inout) :: VISITED(N) + INTEGER, intent(in) :: PERM(N) + INTEGER I, J, K + K = 0 + DO I = 1, N + IF (VISITED(I) .GT. N) THEN + VISITED(I)=VISITED(I)-N-N-1 + CYCLE + ENDIF + J = PERM(I) + DO WHILE (J.NE.I) + VISITED(J) = VISITED(J) + N + N + 1 + K = K + 1 + J = PERM(J) + ENDDO + ENDDO + IF (mod(K,2).EQ.1) THEN + DETER = -DETER + ENDIF + RETURN + END SUBROUTINE SMUMPS_767 + SUBROUTINE SMUMPS_224(NFRONT,NASS,IBEGKJI, LPIV, TIPIV, + & N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IFLAG,IOLDPS,POSELT,UU,SEUIL,KEEP,KEEP8, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER IBEGKJI, LPIV + INTEGER TIPIV(LPIV) + INTEGER(8) :: LA + REAL A(LA) + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV,NOFFW + REAL UU, SEUIL + INTEGER IW(LIW) + INTEGER IOLDPS + INTEGER(8) :: POSELT + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U + REAL SWOP + INTEGER(8) :: APOS, IDIAG + INTEGER(8) :: J1, J2, JJ, J3_8 + INTEGER(8) :: NFRONT8 + INTEGER ILOC + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + REAL RZERO, RMAX, AMROW, ONE + REAL PIVNUL + REAL FIXA, CSEUIL + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,JMAX,J3,ISW,ISWPS1 + INTEGER ISWPS2,KSW, HF + INCLUDE 'mumps_headers.h' + INTEGER SMUMPS_IXAMAX + INTRINSIC max + DATA RZERO /0.0E0/ + DATA ONE /1.0E0/ + INTEGER I_PIVRPTR_L, I_PIVR_L, NBPANELS_L + INTEGER I_PIVRPTR_U, I_PIVR_U, NBPANELS_U + INTEGER XSIZE + PIVNUL = DKEEP(1) + FIXA = DKEEP(2) + CSEUIL = SEUIL + NFRONT8=int(NFRONT,8) + XSIZE = KEEP(IXSZ) + NPIV = IW(IOLDPS+1+XSIZE) + HF = 6 + IW(IOLDPS+5+XSIZE)+XSIZE + NPIVP1 = NPIV + 1 + IF (KEEP(201).EQ.1) THEN + CALL SMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + CALL SMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + ENDIF + ILOC = NPIVP1 - IBEGKJI + 1 + TIPIV(ILOC) = ILOC + NASSW = iabs(IW(IOLDPS+3+XSIZE)) + IF(INOPV .EQ. -1) THEN + APOS = POSELT + NFRONT8*int(NPIVP1-1,8) + int(NPIV,8) + IDIAG = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF (real(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + KEEP(98) = KEEP(98)+1 + ELSE IF (KEEP(258) .NE. 0) THEN + CALL SMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL SMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL SMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + NFRONT8*int(IPIV-1,8) + int(NPIV,8) + JMAX = 1 + IF (UU.GT.RZERO) GO TO 340 + IF (A(APOS).EQ.ZERO) GO TO 630 + GO TO 380 + 340 AMROW = RZERO + J1 = APOS + J2 = APOS +int(- NPIV + NASS - 1,8) + J3 = NASS -NPIV + JMAX = SMUMPS_IXAMAX(J3,A(J1),1) + JJ = int(JMAX,8) + J1 - 1_8 + AMROW = abs(A(JJ)) + RMAX = AMROW + J1 = J2 + 1_8 + J2 = APOS +int(- NPIV + NFRONT - KEEP(253)- 1,8) + IF (J2.LT.J1) GO TO 370 + DO 360 JJ=J1,J2 + RMAX = max(abs(A(JJ)),RMAX) + 360 CONTINUE + 370 IDIAG = APOS + int(IPIV - NPIVP1,8) + IF (RMAX.LE.PIVNUL) THEN + KEEP(109) = KEEP(109)+1 + ISW = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6+KEEP(IXSZ)+ + & IW(IOLDPS+5+KEEP(IXSZ))+IPIV-NPIVP1 + PIVNUL_LIST(KEEP(109)) = IW(ISW) + IF(real(FIXA).GT.RZERO) THEN + IF(real(A(IDIAG)) .GE. RZERO) THEN + A(IDIAG) = FIXA + ELSE + A(IDIAG) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = APOS +int(- NPIV + NFRONT - KEEP(253) - 1,8) + DO JJ=J1,J2 + A(JJ)= ZERO + ENDDO + A(IDIAG) = -FIXA + ENDIF + JMAX = IPIV - NPIV + GOTO 385 + ENDIF + IF (abs(A(IDIAG)).GT.max(UU*RMAX,SEUIL)) THEN + JMAX = IPIV - NPIV + GO TO 380 + ENDIF + IF (AMROW.LE.max(UU*RMAX,SEUIL)) GO TO 460 + NOFFW = NOFFW + 1 + 380 CONTINUE + IF (KEEP(258).NE.0) THEN + CALL SMUMPS_762( A(APOS+int(JMAX-1,8)), + & DKEEP(6), + & KEEP(259)) + ENDIF + 385 CONTINUE + IF (IPIV.EQ.NPIVP1) GO TO 400 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8)*NFRONT8 + J2 = J1 + NFRONT8 - 1_8 + J3_8 = POSELT + int(IPIV-1,8)*NFRONT8 + DO 390 JJ=J1,J2 + SWOP = A(JJ) + A(JJ) = A(J3_8) + A(J3_8) = SWOP + J3_8 = J3_8 + 1_8 + 390 CONTINUE + ISWPS1 = IOLDPS + HF - 1 + NPIVP1 + ISWPS2 = IOLDPS + HF - 1 + IPIV + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + 400 IF (JMAX.EQ.1) GO TO 420 + KEEP(260)=-KEEP(260) + TIPIV(ILOC) = ILOC + JMAX - 1 + J1 = POSELT + int(NPIV,8) + J2 = POSELT + int(NPIV + JMAX - 1,8) + DO 410 KSW=1,NASS + SWOP = A(J1) + A(J1) = A(J2) + A(J2) = SWOP + J1 = J1 + NFRONT8 + J2 = J2 + NFRONT8 + 410 CONTINUE + ISWPS1 = IOLDPS + HF - 1 + NFRONT + NPIV + 1 + ISWPS2 = IOLDPS + HF - 1 + NFRONT + NPIV + JMAX + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + GO TO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 430 + 630 CONTINUE + IFLAG = -10 + WRITE(*,*) 'NIV2:Detected 0 pivot, INODE,NPIV=',INODE,NPIV + GOTO 430 + 420 CONTINUE + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL SMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, IPIV, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL SMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIV+JMAX, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + 430 CONTINUE + RETURN + END SUBROUTINE SMUMPS_224 + SUBROUTINE SMUMPS_294( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & IW, LIW, + & IOLDPS, POSELT, A, LA, LDA_FS, + & IBEGKJI, IEND, TIPIV, LPIV, LASTBL, NB_BLOC_FAC, + & + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE SMUMPS_COMM_BUFFER + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mpif.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, INODE, FPERE, LIW, IBEGKJI, IEND, LPIV, + & IOLDPS, LDA_FS, NB_BLOC_FAC + INTEGER(8) :: POSELT, LA + INTEGER IW(LIW), TIPIV(LPIV) + LOGICAL LASTBL + REAL A(LA) + INTEGER COMM, MYID, LBUFR, LBUFR_BYTES + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NBFIN, IFLAG, IERROR, LEAF, LPOOL, + & SLAVEF, ICNTL(40) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB, COMP + INTEGER BUFR( LBUFR ), IPOOL(LPOOL), + & ITLOC(N+KEEP(253)), FILS(N), + & PTRARW(LPTRAR), PTRAIW(LPTRAR), + & ND( KEEP(28) ), FRERE( KEEP(28) ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER(8) :: PTRAST (KEEP(28)) + INTEGER(8) :: PTRFAC (KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), + & NBPROCFILS(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + REAL DBLARR(max(1,KEEP(13))) + EXTERNAL SMUMPS_329 + INCLUDE 'mumps_headers.h' + INTEGER(8) :: APOS, LREQA + INTEGER NPIV, NCOL, PDEST, NSLAVES + INTEGER IERR, LREQI + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + DOUBLE PRECISION FLOP1,FLOP2 + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + IF (NSLAVES.EQ.0) THEN + WRITE(6,*) ' ERROR 1 in SMUMPS_294 ' + CALL MUMPS_ABORT() + ENDIF + NPIV = IEND - IBEGKJI + 1 + NCOL = LDA_FS - IBEGKJI + 1 + APOS = POSELT + int(LDA_FS,8)*int(IBEGKJI-1,8) + + & int(IBEGKJI - 1,8) + IF (IBEGKJI > 0) THEN + CALL MUMPS_511( LDA_FS, IBEGKJI-1, LPIV, + & KEEP(50),2,FLOP1) + ELSE + FLOP1=0.0D0 + ENDIF + CALL MUMPS_511( LDA_FS, IEND, LPIV, + & KEEP(50),2,FLOP2) + FLOP2 = FLOP1 - FLOP2 + CALL SMUMPS_190(1, .FALSE., FLOP2, KEEP,KEEP8) + IF ((NPIV.GT.0) .OR. + & ((NPIV.EQ.0).AND.(LASTBL)) ) THEN + PDEST = IOLDPS + 6 + KEEP(IXSZ) + IERR = -1 + IF ( NPIV .NE. 0 ) THEN + NB_BLOC_FAC = NB_BLOC_FAC + 1 + END IF + DO WHILE (IERR .EQ.-1) + CALL SMUMPS_65( INODE, LDA_FS, NCOL, + & NPIV, FPERE, LASTBL, TIPIV, A(APOS), + & IW(PDEST), NSLAVES, KEEP(50), NB_BLOC_FAC, + & COMM, IERR ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF (MESSAGE_RECEIVED) POSELT = PTRAST(STEP(INODE)) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2 .OR. IERR.EQ.-3 ) THEN + IF (IERR.EQ.-2) IFLAG = -17 + IF (IERR.EQ.-3) IFLAG = -20 + LREQA = int(NCOL,8)*int(NPIV,8) + LREQI = NPIV + 6 + 2*NSLAVES + CALL MUMPS_731( + & int(LREQI,8) * int(KEEP(34),8) + LREQA * int(KEEP(35),8), + & IERROR) + GOTO 300 + ENDIF + ENDIF + GOTO 500 + 300 CONTINUE + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + 500 RETURN + END SUBROUTINE SMUMPS_294 + SUBROUTINE SMUMPS_273( ROOT, + & INODE, NELIM, NSLAVES, ROW_LIST, + & COL_LIST, SLAVE_LIST, + & + & PROCNODE_STEPS, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & ITLOC, RHS_MUMPS, COMP, + & IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8, + & COMM,COMM_LOAD,FILS,ND ) + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC) :: ROOT + INTEGER INODE, NELIM, NSLAVES + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER ROW_LIST(*), COL_LIST(*), + & SLAVE_LIST(*) + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER PTRIST( KEEP(28) ), PTLUST_S(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), ITLOC( N + KEEP(253) ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER IFLAG, IERROR + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF + INTEGER COMM,COMM_LOAD,ND(KEEP(28)),FILS(N) + INTEGER IROOT, TYPE_INODE, DEB_ROW, DEB_COL, + & NOINT + INTEGER(8) :: NOREAL + INCLUDE 'mumps_headers.h' + INCLUDE 'mumps_tags.h' + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + IROOT = KEEP(38) + NSTK_S(STEP(IROOT))= NSTK_S(STEP(IROOT)) - 1 + KEEP(42) = KEEP(42) + NELIM + TYPE_INODE= MUMPS_330(PROCNODE_STEPS(STEP(INODE)), SLAVEF) + IF (TYPE_INODE.EQ.1) THEN + IF (NELIM.EQ.0) THEN + KEEP(41) = KEEP(41) + 1 + ELSE + KEEP(41) = KEEP(41) + 3 + ENDIF + ELSE + IF (NELIM.EQ.0) THEN + KEEP(41) = KEEP(41) + NSLAVES + ELSE + KEEP(41) = KEEP(41) + 2*NSLAVES + 1 + ENDIF + ENDIF + IF (NELIM.EQ.0) THEN + PIMASTER(STEP(INODE)) = 0 + ELSE + NOINT = 6 + NSLAVES + NELIM + NELIM + KEEP(IXSZ) + NOREAL= 0_8 + CALL SMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, + & NOINT, NOREAL, INODE, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) THEN + WRITE(*,*) ' Failure in int space allocation in CB area ', + & ' during assembly of root : SMUMPS_273', + & ' size required was :', NOINT, + & 'INODE=',INODE,' NELIM=',NELIM, ' NSLAVES=', NSLAVES + RETURN + ENDIF + PIMASTER(STEP( INODE )) = IWPOSCB + 1 + PAMASTER(STEP( INODE )) = IPTRLU + 1_8 + IW( IWPOSCB + 1+KEEP(IXSZ) ) = 2*NELIM + IW( IWPOSCB + 2+KEEP(IXSZ) ) = NELIM + IW( IWPOSCB + 3+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 4+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 5+KEEP(IXSZ) ) = 1 + IW( IWPOSCB + 6+KEEP(IXSZ) ) = NSLAVES + IF (NSLAVES.GT.0) THEN + IW( IWPOSCB+7+KEEP(IXSZ):IWPOSCB+7+KEEP(IXSZ)+NSLAVES-1) = + & SLAVE_LIST(1:NSLAVES) + ENDIF + DEB_ROW = IWPOSCB+7+NSLAVES+KEEP(IXSZ) + IW(DEB_ROW : DEB_ROW+NELIM -1) = ROW_LIST(1:NELIM) + DEB_COL = DEB_ROW + NELIM + IW(DEB_COL : DEB_COL+NELIM -1) = COL_LIST(1:NELIM) + ENDIF + IF (NSTK_S(STEP(IROOT)) .EQ. 0 ) THEN + CALL SMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IROOT ) + IF (KEEP(47) .GE. 3) THEN + CALL SMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + RETURN + END SUBROUTINE SMUMPS_273 + SUBROUTINE SMUMPS_363(N,FRERE, STEP, FILS, + & NA,LNA,NE,ND, DAD, LDAD, USE_DAD, + & NSTEPS,PERM,SYM,INFO,LP,K215,K234,K55, + & PROCNODE,SLAVEF, PEAK,SBTR_WHICH_M + & ) + IMPLICIT NONE + INTEGER N,PERM,SYM, NSTEPS, LNA, LP,LDAD + INTEGER FRERE(NSTEPS), FILS(N), STEP(N) + INTEGER NA(LNA), NE(NSTEPS), ND(NSTEPS) + INTEGER K215,K234,K55 + INTEGER DAD(LDAD) + LOGICAL USE_DAD + INTEGER INFO(40) + INTEGER SLAVEF,PROCNODE(NSTEPS) + INTEGER :: SBTR_WHICH_M + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + REAL PEAK + REAL, DIMENSION(:), ALLOCATABLE :: COST_TRAV + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH + INTEGER IFATH,IN,NSTK,INODE,I,allocok,LOCAL_PERM + INTEGER(8) NCB + INTEGER(8) NELIM,NFR + INTEGER NFR4,NELIM4 + INTEGER LEAF,NBLEAF,NBROOT, SIZE_TAB + INTEGER, DIMENSION (:), ALLOCATABLE :: IPOOL,TNSTK + INTEGER, DIMENSION (:), ALLOCATABLE,TARGET :: SON,TEMP + INTEGER(8), DIMENSION (:), ALLOCATABLE :: M,M_TOTAL, fact + INTEGER(8), DIMENSION (:), ALLOCATABLE :: TAB1,TAB2 + INTEGER, DIMENSION (:), POINTER :: TAB + INTEGER dernier,fin + INTEGER cour,II + INTEGER CB_current,CB_MAX,ROOT_OF_CUR_SBTR + INTEGER(8), DIMENSION (:), ALLOCATABLE :: T1,T2 + INTEGER, DIMENSION (:), ALLOCATABLE :: RESULT + INTEGER(8) MEM_SIZE,FACT_SIZE,SUM,MEM_SEC_PERM,FACT_SIZE_T, + & MEM_SIZE_T,TOTAL_MEM_SIZE,TMP_TOTAL_MEM_SIZE,TMP_SUM, + & SIZECB, SIZECB_LASTSON + INTEGER(8) TMP8 + LOGICAL SBTR_M + INTEGER FIRST_LEAF,SIZE_SBTR + EXTERNAL MUMPS_170,MUMPS_167 + LOGICAL MUMPS_170,MUMPS_167 + DOUBLE PRECISION COST_NODE + INCLUDE 'mumps_headers.h' + TOTAL_MEM_SIZE=0_8 + ROOT_OF_CUR_SBTR=0 + IF((PERM.EQ.0).OR.(PERM.EQ.1).OR. + & (PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4).OR. + & (PERM.EQ.5).OR.(PERM.EQ.6))THEN + LOCAL_PERM=0 + ENDIF + SBTR_M=.FALSE. + MEM_SIZE=0_8 + FACT_SIZE=0_8 + IF ((PERM.LT.0 .OR. PERM.GT.7)) THEN + WRITE(*,*) "Internal Error in SMUMPS_363",PERM + CALL MUMPS_ABORT() + END IF + NBLEAF = NA(1) + NBROOT = NA(2) + IF((PERM.EQ.0).AND.(NBROOT.EQ.NBLEAF)) RETURN + IF ((PERM.NE.7).AND.(SBTR_M.OR.(PERM.EQ.2))) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + ALLOCATE(M_TOTAL(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & SMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ENDIF + ENDIF + IF(PERM.NE.7)THEN + ALLOCATE(M(NSTEPS),stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error + &in SMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ENDIF + ALLOCATE( IPOOL(NBLEAF), fact(NSTEPS),TNSTK(NSTEPS), + & stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in SMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + II=0 + DO I=1,NSTEPS + TNSTK(I) = NE(I) + IF(NE(I).GE.II) II=NE(I) + ENDDO + SIZE_TAB=max(II,NBROOT) + ALLOCATE(SON(II), TEMP(II), + & TAB1(SIZE_TAB), TAB2(SIZE_TAB), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in SMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ALLOCATE(T1(SIZE_TAB),T2(SIZE_TAB), + & RESULT(SIZE_TAB),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in SMUMPS_363' + INFO(1)=-7 + INFO(2)=SIZE_TAB + RETURN + ENDIF + IF(PERM.EQ.7) THEN + GOTO 001 + ENDIF + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + ALLOCATE(COST_TRAV(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error + & in SMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + COST_TRAV=0.0E0 + COST_NODE=0.0d0 + ENDIF + IF(NBROOT.EQ.NBLEAF)THEN + IF((PERM.NE.1).OR.(PERM.EQ.4).OR.(PERM.EQ.6))THEN + WRITE(*,*)'Internal Error in reordertree:' + WRITE(*,*)' problem with perm parameter in reordertree' + CALL MUMPS_ABORT() + ENDIF + DO I=1,NBROOT + TAB1(I)=int(ND(STEP(NA(I+2+NBLEAF))),8) + IPOOL(I)=NA(I+2+NBLEAF) + M(STEP(IPOOL(I)))=TAB1(I)*TAB1(I) + ENDDO + CALL SMUMPS_462(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4, + & RESULT,T1,T2) + GOTO 789 + ENDIF + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + ALLOCATE(DEPTH(NSTEPS),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & SMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + DEPTH=0 + NBROOT = NA(2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + fin=NBROOT + LEAF=NA(1) + 499 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IN=INODE + 4602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + GOTO 4602 + ENDIF + IN=-IN + DO I=1,NE(STEP(INODE)) + SON(I)=IN + IN=FRERE(STEP(IN)) + ENDDO + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=SON(I) + DEPTH(STEP(SON(I)))=DEPTH(STEP(INODE))+1 + SON(I)=0 + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 499 + ENDIF + fin=fin-1 + IF(fin.EQ.0) GOTO 489 + GOTO 499 + 489 CONTINUE + ENDIF + DO I=1,NSTEPS + M(I)=0_8 + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + M_TOTAL(I)=0_8 + ENDIF + ENDIF + ENDDO + DO I=1,NSTEPS + fact(I)=0_8 + ENDDO + IPOOL(1:NBLEAF)=NA(3:2+NBLEAF) + LEAF = NBLEAF + 1 + 91 CONTINUE + IF (LEAF.NE.1) THEN + LEAF = LEAF -1 + INODE = IPOOL(LEAF) + ENDIF + 96 CONTINUE + NFR = int(ND(STEP(INODE)),8) + NSTK = NE(STEP(INODE)) + NELIM4 = 0 + IN = INODE + 101 NELIM4 = NELIM4 + 1 + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 101 + NELIM=int(NELIM4,8) + IF(NE(STEP(INODE)).EQ.0) THEN + M(STEP(INODE))=NFR*NFR + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + M_TOTAL(STEP(INODE))=NFR*NFR + ENDIF + ENDIF + IF((PERM.EQ.4).OR.(PERM.EQ.3))THEN + IF(MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + DEPTH(STEP(INODE))=0 + ENDIF + ENDIF + IF ( SYM .eq. 0 ) THEN + fact(STEP(INODE))=fact(STEP(INODE))+ + & (2_8*NFR*NELIM)-(NELIM*NELIM) + ELSE + fact(STEP(INODE))=fact(STEP(INODE))+NFR*NELIM + ENDIF + IF (USE_DAD) THEN + IFATH = DAD( STEP(INODE) ) + ELSE + IN = INODE + 113 IN = FRERE(IN) + IF (IN.GT.0) GO TO 113 + IFATH = -IN + ENDIF + IF (IFATH.EQ.0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 116 + GOTO 91 + ELSE + fact(STEP(IFATH))=fact(STEP(IFATH))+fact(STEP(INODE)) + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + DEPTH(STEP(IFATH))=max(DEPTH(STEP(INODE)), + & DEPTH(STEP(IFATH))) + ENDIF + ENDIF + TNSTK(STEP(IFATH)) = TNSTK(STEP(IFATH)) - 1 + IF ( TNSTK(STEP(IFATH)) .EQ. 0 ) THEN + INODE = IFATH + IN=INODE + dernier=IN + I=1 + 5700 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + dernier=IN + I=I+1 + GOTO 5700 + ENDIF + NCB=int(ND(STEP(INODE))-I,8) + IN=-IN + IF(PERM.NE.7)THEN + DO I=1,NE(STEP(INODE)) + SON(I)=IN + TEMP(I)=IN + IF(IN.GT.0) IN=FRERE(STEP(IN)) + ENDDO + ELSE + DO I=NE(STEP(INODE)),1,-1 + SON(I)=IN + TEMP(I)=IN + IF(IN.GT.0) IN=FRERE(STEP(IN)) + ENDDO + ENDIF + NFR = int(ND(STEP(INODE)),8) + DO II=1,NE(STEP(INODE)) + TAB1(II)=0_8 + TAB2(II)=0_8 + cour=SON(II) + NELIM4=1 + 151 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 151 + ENDIF + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0)) THEN + SIZECB=(int(ND(STEP(SON(II))),8)-NELIM) + & *(int(ND(STEP(SON(II))),8)-NELIM) + ELSE + SIZECB=(int(ND(STEP(SON(II))),8)-NELIM) + & *(int(ND(STEP(SON(II))),8)- + & NELIM+1_8)/2_8 + ENDIF + IF((PERM.EQ.0).OR.(PERM.EQ.5))THEN + IF (K234 .NE. 0 .AND. K55.EQ.0 ) THEN + TMP8=NFR + TMP8=TMP8*TMP8 + TAB1(II)=max(TMP8, M(STEP(SON(II)))) - SIZECB + TAB2(II)=SIZECB + ELSE + TAB1(II)=M(STEP(SON(II)))- SIZECB + TAB2(II)=SIZECB + ENDIF + ENDIF + IF((PERM.EQ.1).OR.(PERM.EQ.6)) THEN + TAB1(II)=M(STEP(SON(II)))-SIZECB + TAB1(II)=TAB1(II)-fact(STEP(SON(II))) + TAB2(II)=SIZECB+fact(STEP(SON(II))) + ENDIF + IF(PERM.EQ.2)THEN + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + TAB1(II)=M_TOTAL(STEP(SON(II)))-SIZECB + & -fact(STEP(SON(II))) + TAB2(II)=SIZECB + ELSE + TAB1(II)=M(STEP(SON(II)))-SIZECB + TAB2(II)=SIZECB + ENDIF + ENDIF + IF(PERM.EQ.3)THEN + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + TAB1(II)=M(STEP(SON(II)))-SIZECB + TAB2(II)=SIZECB + ELSE + TAB1(II)=int(DEPTH(STEP(SON(II))),8) + TAB2(II)=M(STEP(SON(II))) + ENDIF + ENDIF + IF(PERM.EQ.4)THEN + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + TAB1(II)=M(STEP(SON(II)))- + & SIZECB-fact(STEP(SON(II))) + TAB2(II)=SIZECB + ELSE + TAB1(II)=int(DEPTH(STEP(SON(II))),8) + TAB2(II)=M(STEP(SON(II))) + ENDIF + ENDIF + ENDDO + CALL SMUMPS_462(SON,NE(STEP(INODE)),TAB1,TAB2, + & LOCAL_PERM + & ,RESULT,T1,T2) + IF(PERM.EQ.0) THEN + DO II=1,NE(STEP(INODE)) + cour=TEMP(II) + NELIM4=1 + 153 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 153 + ENDIF + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM) + ELSE + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM+1_8)/2_8 + ENDIF + TAB1(II)=SIZECB + ENDDO + CALL SMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2,3, + & RESULT,T1,T2) + ENDIF + IF(PERM.EQ.1) THEN + DO II=1,NE(STEP(INODE)) + cour=TEMP(II) + NELIM4=1 + 187 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 187 + ENDIF + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM) + ELSE + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM+1_8)/2_8 + ENDIF + TAB1(II)=SIZECB+fact(STEP(TEMP(II))) + ENDDO + CALL SMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2,3, + & RESULT,T1,T2) + ENDIF + CONTINUE + IFATH=INODE + DO II=1,2 + SUM=0_8 + FACT_SIZE=0_8 + FACT_SIZE_T=0_8 + MEM_SIZE=0_8 + MEM_SIZE_T=0_8 + CB_MAX=0 + CB_current=0 + TMP_SUM=0_8 + IF(II.EQ.1) TAB=>SON + IF(II.EQ.2) TAB=>TEMP + DO I=1,NE(STEP(INODE)) + cour=TAB(I) + NELIM4=1 + 149 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 149 + ENDIF + NELIM=int(NELIM4, 8) + NFR=int(ND(STEP(TAB(I))),8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(NFR-NELIM)*(NFR-NELIM) + ELSE + SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8 + ENDIF + MEM_SIZE=max(MEM_SIZE,(M(STEP(TAB(I)))+SUM+FACT_SIZE)) + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + MEM_SIZE_T=max(MEM_SIZE_T,(M_TOTAL(STEP(TAB(I)))+ + & SUM+ + & FACT_SIZE_T)) + FACT_SIZE_T=FACT_SIZE_T+fact(STEP(TAB(I))) + ENDIF + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & (M(STEP(TAB(I)))+SUM+FACT_SIZE)) + TMP_SUM=TMP_SUM+fact(STEP(TAB(I))) + SUM=SUM+SIZECB + SIZECB_LASTSON = SIZECB + IF((PERM.EQ.1).OR.(PERM.EQ.4))THEN + FACT_SIZE=FACT_SIZE+fact(STEP(TAB(I))) + ENDIF + ENDDO + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=NCB*NCB + ELSE + SIZECB=(NCB*(NCB+1_8))/2_8 + ENDIF + IF (K234.NE.0 .AND. K55.EQ.0) THEN + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & ( ( int(ND(STEP(IFATH)),8) + & * int(ND(STEP(IFATH)),8) ) + & + SUM-SIZECB_LASTSON+TMP_SUM ) + & ) + ELSE IF (K234.NE.0 .AND. K55.NE.0) THEN + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & ( ( int(ND(STEP(IFATH)),8) + & * int(ND(STEP(IFATH)),8) ) + & + SUM + TMP_SUM ) + & ) + ELSE + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & ( ( int(ND(STEP(IFATH)),8) + & * int(ND(STEP(IFATH)),8)) + & + max(SUM,SIZECB) + TMP_SUM ) + & ) + ENDIF + IF(II.EQ.1)THEN + TMP_TOTAL_MEM_SIZE=TOTAL_MEM_SIZE + ENDIF + IF(II.EQ.1)THEN + IF (K234.NE.0 .AND. K55.EQ.0) THEN + M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+SUM-SIZECB_LASTSON+ + & FACT_SIZE)) + ELSE IF (K234.NE.0 .AND. K55.NE.0) THEN + M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+SUM+FACT_SIZE)) + ELSE + M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+FACT_SIZE)) + ENDIF + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + M_TOTAL(STEP(IFATH))=max(MEM_SIZE_T, + & ((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+ + & FACT_SIZE_T)) + ENDIF + ENDIF + IF((II.EQ.2).AND.(PERM.EQ.1).OR.(PERM.EQ.0).OR. + & (PERM.EQ.5).OR.(PERM.EQ.6).OR. + & (.NOT.SBTR_M.OR.(SBTR_WHICH_M.NE.1)))THEN + MEM_SEC_PERM=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+FACT_SIZE)) + ENDIF + IF((PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4))THEN + MEM_SEC_PERM=huge(MEM_SEC_PERM) + ENDIF + ENDDO + IF(MEM_SEC_PERM.EQ.M(STEP(IFATH))) THEN + TAB=>TEMP + ELSE IF (MEM_SEC_PERM.LT.M(STEP(IFATH))) THEN + WRITE(*,*)'Probleme dans reorder!!!!' + CALL MUMPS_ABORT() + ELSE + TOTAL_MEM_SIZE=TMP_TOTAL_MEM_SIZE + TAB=>SON + ENDIF + DO I=NE(STEP(INODE)),1,-1 + IF(I.EQ.NE(STEP(INODE))) THEN + FILS(dernier)=-TAB(I) + dernier=TAB(I) + GOTO 222 + ENDIF + IF(I.EQ.1) THEN + FRERE(STEP(dernier))=TAB(I) + FRERE(STEP(TAB(I)))=-INODE + GOTO 222 + ENDIF + IF(I.GT.1) THEN + FRERE(STEP(dernier))=TAB(I) + dernier=TAB(I) + GOTO 222 + ENDIF + 222 CONTINUE + ENDDO + GOTO 96 + ELSE + GOTO 91 + ENDIF + 116 CONTINUE + NBROOT = NA(2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + IF (PERM.eq.1) THEN + DO I=1,NBROOT + TAB1(I)=M(STEP(NA(I+2+NBLEAF)))-fact(STEP(NA(I+2+NBLEAF))) + TAB1(I)=-TAB1(I) + ENDDO + CALL SMUMPS_462(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4, + & RESULT,T1,T2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + ENDIF + 001 CONTINUE + fin=NBROOT + LEAF=NA(1) + FIRST_LEAF=-9999 + SIZE_SBTR=0 + 999 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IN=INODE + 5602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + dernier=IN + GOTO 5602 + ENDIF + IN=-IN + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + IF(SLAVEF.NE.1)THEN + IF (USE_DAD) THEN + IFATH=DAD(INODE) + ELSE + IN = INODE + 395 IN = FRERE(IN) + IF (IN.GT.0) GO TO 395 + IFATH = -IN + ENDIF + NFR4 = ND(STEP(INODE)) + NFR = int(NFR4,8) + NELIM4 = 0 + IN = INODE + 396 NELIM4 = NELIM4 + 1 + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 396 + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(NFR-NELIM)*(NFR-NELIM) + ELSE + SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8 + ENDIF + CALL MUMPS_511(NFR4,NELIM4,NELIM4, + & SYM,1,COST_NODE) + IF(IFATH.NE.0)THEN + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + COST_TRAV(STEP(INODE))=COST_TRAV(STEP( + & ROOT_OF_CUR_SBTR)) + ELSE + COST_TRAV(STEP(INODE))=real(COST_NODE)+ + & COST_TRAV(STEP(IFATH))+ + & real(SIZECB*18_8) + ENDIF + ELSE + COST_TRAV(STEP(INODE))=real(COST_NODE) + ENDIF + ENDIF + ENDIF + DO I=1,NE(STEP(INODE)) + TEMP(I)=IN + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + IF((SLAVEF.NE.1).AND.(.NOT.MUMPS_170( + & PROCNODE(STEP(INODE)),SLAVEF)))THEN + NFR4 = ND(STEP(INODE)) + NFR = int(NFR4,8) + NELIM4 = 0 + II = TEMP(I) + 845 NELIM4 = NELIM4 + 1 + II = FILS(II) + IF (II .GT. 0 ) GOTO 845 + NELIM=int(NELIM4,8) + CALL MUMPS_511(NFR4,NELIM4,NELIM4, + & SYM,1,COST_NODE) + TAB1(I)=int(real(COST_NODE)+ + & COST_TRAV(STEP(INODE)),8) + TAB2(I)=0_8 + ELSE + SON(I)=IN + ENDIF + ELSE + SON(I)=IN + ENDIF + IN=FRERE(STEP(IN)) + ENDDO + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + IF((SLAVEF.NE.1).AND.(.NOT.MUMPS_170( + & PROCNODE(STEP(INODE)),SLAVEF)))THEN + CALL SMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2, + & LOCAL_PERM + & ,RESULT,T1,T2) + TAB=>TEMP + DO I=NE(STEP(INODE)),1,-1 + IF(I.EQ.NE(STEP(INODE))) THEN + FILS(dernier)=-TAB(I) + dernier=TAB(I) + GOTO 221 + ENDIF + IF(I.EQ.1) THEN + FRERE(STEP(dernier))=TAB(I) + FRERE(STEP(TAB(I)))=-INODE + GOTO 221 + ENDIF + IF(I.GT.1) THEN + FRERE(STEP(dernier))=TAB(I) + dernier=TAB(I) + GOTO 221 + ENDIF + 221 CONTINUE + SON(NE(STEP(INODE))-I+1)=TAB(I) + ENDDO + ENDIF + ENDIF + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=SON(I) + SON(I)=0 + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + IF(PERM.NE.7)THEN + NA(LEAF+2)=INODE + ENDIF + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 999 + ENDIF + fin=fin-1 + IF(fin.EQ.0) THEN + GOTO 789 + ENDIF + GOTO 999 + 789 CONTINUE + IF(PERM.EQ.7) GOTO 5483 + NBROOT=NA(2) + NBLEAF=NA(1) + PEAK=0.0E0 + FACT_SIZE=0_8 + DO I=1,NBROOT + PEAK=max(PEAK,real(M(STEP(NA(2+NBLEAF+I))))) + FACT_SIZE=FACT_SIZE+fact(STEP(NA(2+NBLEAF+I))) + ENDDO + 5483 CONTINUE + DEALLOCATE(IPOOL) + DEALLOCATE(fact) + DEALLOCATE(TNSTK) + DEALLOCATE(SON) + DEALLOCATE(TAB2) + DEALLOCATE(TAB1) + DEALLOCATE(T1) + DEALLOCATE(T2) + DEALLOCATE(RESULT) + DEALLOCATE(TEMP) + IF(PERM.NE.7)THEN + DEALLOCATE(M) + ENDIF + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + DEALLOCATE(DEPTH) + ENDIF + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + DEALLOCATE(COST_TRAV) + ENDIF + IF ((PERM.NE.7).AND.(SBTR_M.OR.(PERM.EQ.2))) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1).OR.(PERM.EQ.2))THEN + DEALLOCATE(M_TOTAL) + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_363 + SUBROUTINE SMUMPS_364(N,FRERE, STEP, FILS, + & NA,LNA,NE,ND, DAD, LDAD, USE_DAD, + & NSTEPS,PERM,SYM,INFO,LP,K47,K81,K76,K215,K234,K55, + & PROCNODE,MEM_SUBTREE,SLAVEF, SIZE_MEM_SBTR, PEAK + & ,SBTR_WHICH_M,SIZE_DEPTH_FIRST,SIZE_COST_TRAV, + & DEPTH_FIRST_TRAV,DEPTH_FIRST_SEQ,COST_TRAV,MY_FIRST_LEAF, + & MY_NB_LEAF,MY_ROOT_SBTR,SBTR_ID + & ) + IMPLICIT NONE + INTEGER N,PERM,SYM, NSTEPS, LNA, LP, SIZE_MEM_SBTR,LDAD + INTEGER FRERE(NSTEPS), FILS(N), STEP(N) + INTEGER NA(LNA), NE(NSTEPS), ND(NSTEPS) + INTEGER K47,K81,K76,K215,K234,K55 + INTEGER DAD(LDAD) + LOGICAL USE_DAD + INTEGER INFO(40) + INTEGER SLAVEF,PROCNODE(NSTEPS) + DOUBLE PRECISION, intent(out) :: MEM_SUBTREE(SIZE_MEM_SBTR,SLAVEF) + INTEGER :: SBTR_WHICH_M + INTEGER MY_FIRST_LEAF(SIZE_MEM_SBTR,SLAVEF), + & MY_ROOT_SBTR(SIZE_MEM_SBTR,SLAVEF), + & MY_NB_LEAF(SIZE_MEM_SBTR,SLAVEF) + EXTERNAL MUMPS_283,MUMPS_275 + LOGICAL MUMPS_283 + INTEGER MUMPS_275 + REAL PEAK + INTEGER SIZE_DEPTH_FIRST,DEPTH_FIRST_TRAV(SIZE_DEPTH_FIRST), + & DEPTH_FIRST_SEQ(SIZE_DEPTH_FIRST) + INTEGER SIZE_COST_TRAV + INTEGER SBTR_ID(SIZE_DEPTH_FIRST),OOC_CUR_SBTR + REAL COST_TRAV(SIZE_COST_TRAV) + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH + INTEGER IFATH,IN,INODE,I,allocok,LOCAL_PERM + INTEGER(8) NELIM,NFR + INTEGER NFR4,NELIM4 + INTEGER LEAF,NBLEAF,NBROOT, SIZE_TAB + INTEGER, DIMENSION (:), ALLOCATABLE :: IPOOL,TNSTK + INTEGER, DIMENSION (:), ALLOCATABLE,TARGET :: SON,TEMP + INTEGER(8), DIMENSION (:), ALLOCATABLE :: M,M_TOTAL, fact + INTEGER(8), DIMENSION (:), ALLOCATABLE :: TAB1,TAB2 + INTEGER x,dernier,fin,RANK_TRAV + INTEGER II + INTEGER ROOT_OF_CUR_SBTR + INTEGER(8), DIMENSION (:), ALLOCATABLE :: T1,T2 + INTEGER, DIMENSION (:), ALLOCATABLE :: RESULT + INTEGER(8) MEM_SIZE,FACT_SIZE, + & TOTAL_MEM_SIZE, + & SIZECB + LOGICAL SBTR_M + INTEGER INDICE(SLAVEF),ID,FIRST_LEAF,SIZE_SBTR + EXTERNAL MUMPS_170,MUMPS_167 + LOGICAL MUMPS_170,MUMPS_167 + DOUBLE PRECISION COST_NODE + INTEGER CUR_DEPTH_FIRST_RANK + INCLUDE 'mumps_headers.h' + TOTAL_MEM_SIZE=0_8 + ROOT_OF_CUR_SBTR=0 + IF((PERM.EQ.0).OR.(PERM.EQ.1).OR. + & (PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4).OR. + & (PERM.EQ.5).OR.(PERM.EQ.6))THEN + LOCAL_PERM=0 + ENDIF + IF (K47 == 4 .OR. ((K47.GE.2).AND.(K81.GE. 1))) THEN + DO I=1,SLAVEF + INDICE(I)=1 + ENDDO + DO I=1,SLAVEF + DO x=1,SIZE_MEM_SBTR + MEM_SUBTREE(x,I)=-1.0D0 + ENDDO + ENDDO + ENDIF + SBTR_M=((K47 == 4 .OR. ((K47.GE.2).AND.(K81 .GE. 1)))) + MEM_SIZE=0_8 + FACT_SIZE=0_8 + IF ((PERM.GT.7).AND. + & (.NOT.(K47 == 4 .OR. ((K47.GE.2).AND.(K81 .GE. 1))))) THEN + WRITE(*,*) "Internal Error in SMUMPS_363",PERM + CALL MUMPS_ABORT() + END IF + NBLEAF = NA(1) + NBROOT = NA(2) + CUR_DEPTH_FIRST_RANK=1 + IF((PERM.EQ.0).AND.(NBROOT.EQ.NBLEAF)) RETURN + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + ALLOCATE(M_TOTAL(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & SMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ENDIF + ENDIF + ALLOCATE( IPOOL(NBLEAF), M(NSTEPS), fact(NSTEPS), + & TNSTK(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in SMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + II=0 + DO I=1,NSTEPS + TNSTK(I) = NE(I) + IF(NE(I).GE.II) II=NE(I) + ENDDO + SIZE_TAB=max(II,NBROOT) + ALLOCATE(SON(II), TEMP(II), + & TAB1(SIZE_TAB), TAB2(SIZE_TAB), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in SMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ALLOCATE(T1(SIZE_TAB),T2(SIZE_TAB), + & RESULT(SIZE_TAB),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in SMUMPS_363' + INFO(1)=-7 + INFO(2)=SIZE_TAB + RETURN + ENDIF + IF(NBROOT.EQ.NBLEAF)THEN + IF((PERM.NE.1).OR.(PERM.EQ.4).OR.(PERM.EQ.6))THEN + WRITE(*,*)'Internal Error in reordertree:' + WRITE(*,*)' problem with perm parameter in reordertree' + CALL MUMPS_ABORT() + ENDIF + DO I=1,NBROOT + TAB1(I)=int(ND(STEP(NA(I+2+NBLEAF))),8) + IPOOL(I)=NA(I+2+NBLEAF) + M(STEP(IPOOL(I)))=TAB1(I)*TAB1(I) + ENDDO + CALL SMUMPS_462(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4, + & RESULT,T1,T2) + GOTO 789 + ENDIF + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + ALLOCATE(DEPTH(NSTEPS),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & SMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + DEPTH=0 + NBROOT = NA(2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + fin=NBROOT + LEAF=NA(1) + 499 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IN=INODE + 4602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + GOTO 4602 + ENDIF + IN=-IN + DO I=1,NE(STEP(INODE)) + SON(I)=IN + IN=FRERE(STEP(IN)) + ENDDO + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=SON(I) + DEPTH(STEP(SON(I)))=DEPTH(STEP(INODE))+1 + SON(I)=0 + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 499 + ENDIF + fin=fin-1 + IF(fin.EQ.0) GOTO 489 + GOTO 499 + 489 CONTINUE + ENDIF + IF(K76.EQ.4.OR.(K76.EQ.6))THEN + RANK_TRAV=NSTEPS + DEPTH_FIRST_TRAV=0 + DEPTH_FIRST_SEQ=0 + ENDIF + IF((K76.EQ.5).OR.(PERM.EQ.5).OR.(PERM.EQ.6))THEN + COST_TRAV=0.0E0 + COST_NODE=0.0d0 + ENDIF + DO I=1,NSTEPS + M(I)=0_8 + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + M_TOTAL(I)=0_8 + ENDIF + ENDIF + ENDDO + DO I=1,NSTEPS + fact(I)=0_8 + ENDDO + NBROOT = NA(2) + NBLEAF = NA(1) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + CONTINUE + fin=NBROOT + LEAF=NA(1) + FIRST_LEAF=-9999 + SIZE_SBTR=0 + 999 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IF(SIZE_SBTR.NE.0)THEN + IF(.NOT.MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF((SLAVEF.NE.1))THEN + MY_FIRST_LEAF(INDICE(ID+1)-1,ID+1)=FIRST_LEAF + MY_NB_LEAF(INDICE(ID+1)-1,ID+1)=SIZE_SBTR + FIRST_LEAF=-9999 + SIZE_SBTR=0 + ENDIF + ENDIF + ENDIF + ENDIF + IF(MUMPS_283(PROCNODE(STEP(INODE)),SLAVEF))THEN + ROOT_OF_CUR_SBTR=INODE + ENDIF + IF (K76.EQ.4)THEN + IF(SLAVEF.NE.1)THEN + WRITE(*,*)'INODE=',INODE,'RANK',RANK_TRAV + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + DEPTH_FIRST_TRAV(STEP(INODE))=DEPTH_FIRST_TRAV(STEP( + & ROOT_OF_CUR_SBTR)) + ELSE + DEPTH_FIRST_TRAV(STEP(INODE))=RANK_TRAV + ENDIF + RANK_TRAV=RANK_TRAV-1 + ENDIF + ENDIF + IF (K76.EQ.5)THEN + IF(SLAVEF.NE.1)THEN + IF (USE_DAD) THEN + IFATH=DAD(INODE) + ELSE + IN = INODE + 395 IN = FRERE(IN) + IF (IN.GT.0) GO TO 395 + IFATH = -IN + ENDIF + NFR4 = ND(STEP(INODE)) + NFR = int(NFR4,8) + NELIM4 = 0 + IN = INODE + 396 NELIM4 = NELIM4 + 1 + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 396 + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(NFR-NELIM)*(NFR-NELIM) + ELSE + SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8 + ENDIF + CALL MUMPS_511(NFR4,NELIM4,NELIM4, + & SYM,1,COST_NODE) + IF(IFATH.NE.0)THEN + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + COST_TRAV(STEP(INODE))=COST_TRAV(STEP( + & ROOT_OF_CUR_SBTR)) + ELSE + COST_TRAV(STEP(INODE))=real(COST_NODE)+ + & COST_TRAV(STEP(IFATH))+ + & real(SIZECB*18_8) + ENDIF + ELSE + COST_TRAV(STEP(INODE))=real(COST_NODE) + ENDIF + IF(K76.EQ.5)THEN + WRITE(*,*)'INODE=',INODE,'COST=',COST_TRAV(STEP(INODE)) + ENDIF + ENDIF + ENDIF + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF((SLAVEF.NE.1).AND. + & MUMPS_283(PROCNODE(STEP(INODE)),SLAVEF))THEN + IF (NE(STEP(INODE)).NE.0) THEN + ID=MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M_TOTAL(STEP(INODE))) + ELSE + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M(STEP(INODE))) + ENDIF + MY_ROOT_SBTR(INDICE(ID+1),ID+1)=INODE + INDICE(ID+1)=INDICE(ID+1)+1 + ENDIF + ENDIF + IF((SLAVEF.EQ.1).AND.FRERE(STEP(INODE)).EQ.0)THEN + ID=MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M_TOTAL(STEP(INODE))) + ELSE + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M(STEP(INODE))) + ENDIF + INDICE(ID+1)=INDICE(ID+1)+1 + ENDIF + ENDIF + IN=INODE + 5602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + dernier=IN + GOTO 5602 + ENDIF + IN=-IN + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=IN + IF(IN.GT.0) IN=FRERE(STEP(IN)) + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF(SLAVEF.NE.1)THEN + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + IF(FIRST_LEAF.EQ.-9999)THEN + FIRST_LEAF=INODE + ENDIF + SIZE_SBTR=SIZE_SBTR+1 + ENDIF + ENDIF + ENDIF + IF(PERM.NE.7)THEN + NA(LEAF+2)=INODE + ENDIF + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 999 + ENDIF + fin=fin-1 + IF(fin.EQ.0) THEN + IF(SIZE_SBTR.NE.0)THEN + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF((SLAVEF.NE.1))THEN + MY_FIRST_LEAF(INDICE(ID+1)-1,ID+1)=FIRST_LEAF + MY_NB_LEAF(INDICE(ID+1)-1,ID+1)=SIZE_SBTR + FIRST_LEAF=-9999 + SIZE_SBTR=0 + ENDIF + ENDIF + ENDIF + GOTO 789 + ENDIF + GOTO 999 + 789 CONTINUE + IF(K76.EQ.6)THEN + OOC_CUR_SBTR=1 + DO I=1,NSTEPS + TNSTK(I) = NE(I) + ENDDO + NBROOT=NA(2) + NBLEAF=NA(1) + IPOOL(1:NBLEAF)=NA(3:2+NBLEAF) + LEAF = NBLEAF + 1 + 9100 CONTINUE + IF (LEAF.NE.1) THEN + LEAF = LEAF -1 + INODE = IPOOL(LEAF) + ENDIF + 9600 CONTINUE + IF(SLAVEF.NE.1)THEN + ID=MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + DEPTH_FIRST_TRAV(STEP(INODE))=CUR_DEPTH_FIRST_RANK + DEPTH_FIRST_SEQ(CUR_DEPTH_FIRST_RANK)=INODE + WRITE(*,*)ID,': INODE -> ',INODE,'DF =', + & CUR_DEPTH_FIRST_RANK + CUR_DEPTH_FIRST_RANK=CUR_DEPTH_FIRST_RANK+1 + IF(MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + SBTR_ID(STEP(INODE))=OOC_CUR_SBTR + ELSE + SBTR_ID(STEP(INODE))=-9999 + ENDIF + IF(MUMPS_283(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + OOC_CUR_SBTR=OOC_CUR_SBTR+1 + ENDIF + ENDIF + IF (USE_DAD) THEN + IFATH = DAD( STEP(INODE) ) + ELSE + IN = INODE + 1133 IN = FRERE(IN) + IF (IN.GT.0) GO TO 1133 + IFATH = -IN + ENDIF + IF (IFATH.EQ.0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 1163 + GOTO 9100 + ENDIF + TNSTK(STEP(IFATH))=TNSTK(STEP(IFATH))-1 + IF(TNSTK(STEP(IFATH)).EQ.0) THEN + INODE=IFATH + GOTO 9600 + ELSE + GOTO 9100 + ENDIF + 1163 CONTINUE + ENDIF + PEAK=0.0E0 + FACT_SIZE=0_8 + DO I=1,NBROOT + PEAK=max(PEAK,real(M(STEP(NA(2+NBLEAF+I))))) + FACT_SIZE=FACT_SIZE+fact(STEP(NA(2+NBLEAF+I))) + ENDDO + CONTINUE + DEALLOCATE(IPOOL) + DEALLOCATE(M) + DEALLOCATE(fact) + DEALLOCATE(TNSTK) + DEALLOCATE(SON) + DEALLOCATE(TAB2) + DEALLOCATE(TAB1) + DEALLOCATE(T1) + DEALLOCATE(T2) + DEALLOCATE(RESULT) + DEALLOCATE(TEMP) + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + DEALLOCATE(DEPTH) + ENDIF + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1).OR.(PERM.EQ.2))THEN + DEALLOCATE(M_TOTAL) + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_364 + RECURSIVE SUBROUTINE SMUMPS_462(TAB,DIM,TAB1,TAB2,PERM, + & RESULT,TEMP1,TEMP2) + IMPLICIT NONE + INTEGER DIM + INTEGER(8) TAB1(DIM),TAB2(DIM) + INTEGER(8) TEMP1(DIM),TEMP2(DIM) + INTEGER TAB(DIM), PERM,RESULT(DIM) + INTEGER I,J,I1,I2 + IF(DIM.EQ.1) THEN + RESULT(1)=TAB(1) + TEMP1(1)=TAB1(1) + TEMP2(1)=TAB2(1) + RETURN + ENDIF + I=DIM/2 + CALL SMUMPS_462(TAB(1),I,TAB1(1),TAB2(1),PERM, + & RESULT(1),TEMP1(1),TEMP2(1)) + CALL SMUMPS_462(TAB(I+1),DIM-I,TAB1(I+1),TAB2(I+1), + & PERM,RESULT(I+1),TEMP1(I+1),TEMP2(I+1)) + I1=1 + I2=I+1 + J=1 + DO WHILE ((I1.LE.I).AND.(I2.LE.DIM)) + IF((PERM.EQ.3))THEN + IF(TEMP1(I1).LE.TEMP1(I2))THEN + TAB(J)=RESULT(I1) + TAB1(J)=TEMP1(I1) + J=J+1 + I1=I1+1 + ELSE + TAB(J)=RESULT(I2) + TAB1(J)=TEMP1(I2) + J=J+1 + I2=I2+1 + ENDIF + GOTO 3 + ENDIF + IF((PERM.EQ.4).OR.(PERM.EQ.5))THEN + IF (TEMP1(I1).GE.TEMP1(I2))THEN + TAB(J)=RESULT(I1) + TAB1(J)=TEMP1(I1) + J=J+1 + I1=I1+1 + ELSE + TAB(J)=RESULT(I2) + TAB1(J)=TEMP1(I2) + J=J+1 + I2=I2+1 + ENDIF + GOTO 3 + ENDIF + IF((PERM.EQ.0).OR.(PERM.EQ.1).OR.(PERM.EQ.2)) THEN + IF(TEMP1(I1).GT.TEMP1(I2))THEN + TAB1(J)=TEMP1(I1) + TAB2(J)=TEMP2(I1) + TAB(J)=RESULT(I1) + J=J+1 + I1=I1+1 + GOTO 3 + ENDIF + IF(TEMP1(I1).LT.TEMP1(I2))THEN + TAB1(J)=TEMP1(I2) + TAB2(J)=TEMP2(I2) + TAB(J)=RESULT(I2) + J=J+1 + I2=I2+1 + GOTO 3 + ENDIF + IF((TEMP1(I1).EQ.TEMP1(I2)))THEN + IF(TEMP2(I1).LE.TEMP2(I2))THEN + TAB1(J)=TEMP1(I1) + TAB2(J)=TEMP2(I1) + TAB(J)=RESULT(I1) + J=J+1 + I1=I1+1 + ELSE + TAB1(J)=TEMP1(I2) + TAB2(J)=TEMP2(I2) + TAB(J)=RESULT(I2) + J=J+1 + I2=I2+1 + ENDIF + ENDIF + ENDIF + 3 CONTINUE + ENDDO + IF(I1.GT.I)THEN + DO WHILE(I2.LE.DIM) + TAB(J)=RESULT(I2) + TAB1(J)=TEMP1(I2) + TAB2(J)=TEMP2(I2) + J=J+1 + I2=I2+1 + ENDDO + ELSE + IF(I2.GT.DIM)THEN + DO WHILE(I1.LE.I) + TAB1(J)=TEMP1(I1) + TAB2(J)=TEMP2(I1) + TAB(J)=RESULT(I1) + J=J+1 + I1=I1+1 + ENDDO + ENDIF + ENDIF + DO I=1,DIM + TEMP1(I)=TAB1(I) + TEMP2(I)=TAB2(I) + RESULT(I)=TAB(I) + ENDDO + RETURN + END SUBROUTINE SMUMPS_462 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part5.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part5.F new file mode 100644 index 000000000..f44217255 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part5.F @@ -0,0 +1,7688 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE SMUMPS_26(id) + USE SMUMPS_LOAD + USE MUMPS_STATIC_MAPPING + USE SMUMPS_STRUC_DEF + USE TOOLS_COMMON + USE SMUMPS_PARALLEL_ANALYSIS + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, MASTER + PARAMETER( MASTER = 0 ) + TYPE(SMUMPS_STRUC), TARGET :: id + INTEGER LIW, IKEEP, FILS, FRERE, PTRAR, NFSIZ + INTEGER NE, NA + INTEGER I, allocok + INTEGER MAXIS1_CHECK + INTEGER NB_NIV2, IDEST + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER LOCAL_M, LOCAL_N + INTEGER numroc + EXTERNAL numroc + INTEGER IRANK + INTEGER MP, LP, MPG + LOGICAL PROK, PROKG, LISTVAR_SCHUR_2BE_FREED + INTEGER SIZE_SCHUR_PASSED + INTEGER SBUF_SEND, SBUF_REC, TOTAL_MBYTES + INTEGER(8) SBUF_RECOLD8, MIN_BUF_SIZE8 + INTEGER MIN_BUF_SIZE + INTEGER(8) MAX_SIZE_FACTOR_TMP + INTEGER LEAF, INODE, ISTEP, INN, LPTRAR + INTEGER NBLEAF, NBROOT, MYROW_CHECK, INIV2 + INTEGER(8) K13TMP8, K14TMP8 + REAL PEAK + INTEGER, ALLOCATABLE, DIMENSION(:) :: PAR2_NODES + INTEGER, DIMENSION(:), ALLOCATABLE :: IWtemp + INTEGER, DIMENSION(:), ALLOCATABLE :: XNODEL, NODEL + INTEGER, DIMENSION(:), POINTER :: SSARBR + INTEGER, POINTER :: NELT, LELTVAR + INTEGER, DIMENSION(:), POINTER :: KEEP,INFO, INFOG + INTEGER(8), DIMENSION(:), POINTER :: KEEP8 + INTEGER(8) :: ENTRIES_IN_FACTORS_LOC_MASTERS + REAL, DIMENSION(:), POINTER :: RINFO + REAL, DIMENSION(:), POINTER :: RINFOG + INTEGER, DIMENSION(:), POINTER :: ICNTL + LOGICAL I_AM_SLAVE, PERLU_ON, COND + INTEGER :: OOC_STAT + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER K,J, IFS + INTEGER SIZE_TEMP_MEM,SIZE_DEPTH_FIRST,SIZE_COST_TRAV + LOGICAL IS_BUILD_LOAD_MEM_CALLED + DOUBLE PRECISION, DIMENSION (:,:), ALLOCATABLE :: TEMP_MEM + INTEGER, DIMENSION (:,:), ALLOCATABLE :: TEMP_ROOT + INTEGER, DIMENSION (:,:), ALLOCATABLE :: TEMP_LEAF + INTEGER, DIMENSION (:,:), ALLOCATABLE :: TEMP_SIZE + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH_FIRST + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH_FIRST_SEQ + INTEGER, DIMENSION (:), ALLOCATABLE :: SBTR_ID + REAL, DIMENSION (:), ALLOCATABLE :: COST_TRAV_TMP + INTEGER(8) :: TOTAL_BYTES + INTEGER, POINTER, DIMENSION(:) :: WORK1PTR, WORK2PTR, + & NFSIZPTR, + & FILSPTR, + & FREREPTR + IS_BUILD_LOAD_MEM_CALLED=.FALSE. + KEEP => id%KEEP + KEEP8 => id%KEEP8 + INFO => id%INFO + RINFO => id%RINFO + INFOG => id%INFOG + RINFOG => id%RINFOG + ICNTL => id%ICNTL + NELT => id%NELT + LELTVAR => id%LELTVAR + KEEP8(24) = 0_8 + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & id%KEEP(46) .eq. 1 ) ) + LP = ICNTL( 1 ) + MP = ICNTL( 2 ) + MPG = ICNTL( 3 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF (PROK) WRITE( MP, 220 ) + IF (PROKG.AND.(MPG .NE. MP)) WRITE( MPG, 220 ) id%VERSION_NUMBER + 220 FORMAT( /' SMUMPS ',A ) + IF ( PROK ) THEN + IF ( KEEP(50) .eq. 0 ) THEN + WRITE(MP, '(A)') 'L U Solver for unsymmetric matrices' + ELSE IF ( KEEP(50) .eq. 1 ) THEN + WRITE(MP, '(A)') + & 'L D L^T Solver for symmetric positive definite matrices' + ELSE + WRITE(MP, '(A)') + & 'L D L^T Solver for general symmetric matrices' + END IF + IF ( KEEP(46) .eq. 1 ) THEN + WRITE(MP, '(A)') 'Type of parallelism: Working host' + ELSE + WRITE(MP, '(A)') 'Type of parallelism: Host not working' + END IF + END IF + IF ( PROKG .AND. (MP.NE.MPG)) THEN + IF ( KEEP(50) .eq. 0 ) THEN + WRITE(MPG, '(A)') 'L U Solver for unsymmetric matrices' + ELSE IF ( KEEP(50) .eq. 1 ) THEN + WRITE(MPG, '(A)') + & 'L D L^T Solver for symmetric positive definite matrices' + ELSE + WRITE(MPG, '(A)') + & 'L D L^T Solver for general symmetric matrices' + END IF + IF ( KEEP(46) .eq. 1 ) THEN + WRITE(MPG, '(A)') 'Type of parallelism: Working host' + ELSE + WRITE(MPG, '(A)') 'Type of parallelism: Host not working' + END IF + END IF + IF (PROK) WRITE( MP, 110 ) + IF (PROKG .AND. (MPG.NE.MP)) WRITE( MPG, 110 ) + CALL SMUMPS_647(id) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + CALL MPI_BCAST( KEEP(60), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + IF (id%KEEP(60) .EQ. 2 .or. id%KEEP(60). EQ. 3) THEN + CALL MPI_BCAST( id%NPROW, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%NPCOL, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%MBLOCK, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%NBLOCK, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + CALL MPI_BCAST( KEEP(54), 2, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(69), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(201), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(244), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(251), 3, MPI_INTEGER,MASTER,id%COMM,IERR) + CALL MPI_BCAST( id%N, 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + IF ( KEEP(55) .EQ. 0) THEN + IF ( KEEP(54) .eq. 3 ) THEN + CALL MPI_ALLREDUCE( id%NZ_loc, id%NZ, 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR ) + ELSE + CALL MPI_BCAST( id%NZ, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + END IF + ELSE + CALL MPI_BCAST( id%NA_ELT, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + ENDIF + IF ( associated(id%MEM_DIST) ) deallocate( id%MEM_DIST ) + allocate( id%MEM_DIST( 0:id%NSLAVES-1 ), STAT=IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -7 + INFO(2) = id%NSLAVES + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'MEM_DIST' + END IF + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + id%MEM_DIST(0:id%NSLAVES-1) = 0 + CALL MUMPS_427( + & id%COMM,id%COMM_NODES,KEEP(69),KEEP(46), + & id%NSLAVES,id%MEM_DIST,INFO) + CALL SMUMPS_658(id) + IF (KEEP(244) .EQ. 1) THEN + IF ( KEEP(54) .eq. 3 ) THEN + CALL SMUMPS_664(id) + END IF + IF ( id%MYID .eq. MASTER ) THEN + 1234 CONTINUE + IF ( ( (KEEP(23) .NE. 0) .AND. + & ( (KEEP(23).NE.7) .OR. KEEP(50).EQ. 2 ) ) + & .OR. + & ( associated(id%A) .AND. KEEP(52) .EQ. 77 .AND. + & (KEEP(50).EQ.2)) + & .OR. + & KEEP(52) .EQ. -2 ) THEN + IF (.not.associated(id%A)) THEN + IF (KEEP(23).GT.2) KEEP(23) = 1 + ENDIF + CALL SMUMPS_203(id%N, id%NZ, KEEP(23), id%IS1(1), id, + & ICNTL(1), INFO(1)) + IF (INFO(1) .LT. 0) THEN + KEEP(23) = 0 + GOTO 10 + END IF + END IF + IF (KEEP(55) .EQ. 0) THEN + IF ( KEEP(256) .EQ. 1 ) THEN + LIW = 2 * id%NZ + 3 * id%N + 2 + ELSE + LIW = 2 * id%NZ + 3 * id%N + 2 + ENDIF + IF (LIW.LT.3*id%N) LIW = 3*id%N + ELSE +#if defined(metis) || defined(parmetis) + COND = (KEEP(60) .NE. 0) .OR. (KEEP(256) .EQ. 5) +#else + COND = (KEEP(60) .NE. 0) +#endif + IF( COND ) THEN + LIW = id%N + id%N + 1 + ELSE + LIW = id%N + id%N + id%N+3 + id%N+1 + ENDIF + ENDIF + IF (LIW.LT.3*id%N) LIW = 3*id%N + IF (KEEP(23) .NE. 0) THEN + IKEEP = id%N + 1 + ELSE + IKEEP = 1 + END IF + NA = IKEEP + id%N + NE = IKEEP + 2 * id%N + FILS = IKEEP + 3 * id%N + FRERE = FILS + id%N + PTRAR = FRERE + id%N + IF (KEEP(55) .EQ. 0) THEN + NFSIZ = PTRAR + 4 * id%N + MAXIS1_CHECK = NFSIZ + id%N - 1 + ELSE + NFSIZ = PTRAR + 2 * (NELT + 1) + MAXIS1_CHECK = NFSIZ + id%N -1 + ENDIF + IF ( id%MAXIS1 .LT. MAXIS1_CHECK ) THEN + IF (LP.GE.0) THEN + WRITE(LP,*) '***********************************' + WRITE(LP,*) 'MAXIS1 and MAXIS1_CHECK are different !!' + WRITE(LP,*) 'MAXIS1, MAXIS1_CHECK=',id%MAXIS1, + & MAXIS1_CHECK + WRITE(LP,*) 'This might cause problems ...' + WRITE(LP,*) '***********************************' + ENDIF + END IF + IF ( KEEP(256) .EQ. 1 ) THEN + DO I = 1, id%N + id%IS1( IKEEP + I - 1 ) = id%PERM_IN( I ) + END DO + END IF + INFOG(1) = 0 + INFOG(2) = 0 + INFOG(8) = -1 + IF ( .NOT. associated( id%LISTVAR_SCHUR ) ) THEN + SIZE_SCHUR_PASSED = 1 + LISTVAR_SCHUR_2BE_FREED=.TRUE. + allocate( id%LISTVAR_SCHUR( 1 ), STAT=allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) + & 'PB allocating an array of size 1 in Schur ' + CALL MUMPS_ABORT() + END IF + ELSE + SIZE_SCHUR_PASSED=id%SIZE_SCHUR + LISTVAR_SCHUR_2BE_FREED = .FALSE. + END IF + IF (KEEP(55) .EQ. 0) THEN + CALL SMUMPS_195(id%N, id%NZ, id%IRN(1), id%JCN(1), + & LIW, id%IS1(IKEEP), + & id%IS1(PTRAR), KEEP(256), id%IS1(NFSIZ), + & id%IS1(FILS), id%IS1(FRERE), + & id%LISTVAR_SCHUR(1), SIZE_SCHUR_PASSED, + & ICNTL(1), INFOG(1), KEEP(1),KEEP8(1),id%NSLAVES, + & id%IS1(1),id) + IF ( (KEEP(23).LE.-1).AND.(KEEP(23).GE.-6) ) THEN + KEEP(23) = -KEEP(23) + IF (.NOT. associated(id%A)) KEEP(23) = 1 + GOTO 1234 + ENDIF + INFOG(7) = KEEP(256) + ELSE + allocate( IWtemp ( 3*id%N ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = 3*id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'IWtemp' + END IF + GOTO 10 + ENDIF + allocate( XNODEL ( id%N+1 ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = id%N + 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'XNODEL' + END IF + GOTO 10 + ENDIF + IF (LELTVAR.ne.id%ELTPTR(NELT+1)-1) THEN + INFO(1) = -2002 + INFO(2) = id%ELTPTR(NELT+1)-1 + GOTO 10 + ENDIF + allocate( NODEL ( LELTVAR ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = LELTVAR + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'NODEL' + END IF + GOTO 10 + ENDIF + CALL SMUMPS_128(id%N, NELT, + & id%ELTPTR(1), id%ELTVAR(1), LIW, + & id%IS1(IKEEP), + & IWtemp(1), KEEP(256), id%IS1(NFSIZ), id%IS1(FILS), + & id%IS1(FRERE), id%LISTVAR_SCHUR(1), + & SIZE_SCHUR_PASSED, + & ICNTL(1), INFOG(1), KEEP(1),KEEP8(1), + & id%ELTPROC(1), id%NSLAVES, + & XNODEL(1), NODEL(1)) + DEALLOCATE(IWtemp) + INFOG(7)=KEEP(256) + ENDIF + IF ( LISTVAR_SCHUR_2BE_FREED ) THEN + deallocate( id%LISTVAR_SCHUR ) + NULLIFY ( id%LISTVAR_SCHUR ) + ENDIF + INFO(1)=INFOG(1) + INFO(2)=INFOG(2) + KEEP(28) = INFOG(6) + IF ( INFO(1) .LT. 0 ) THEN + GO TO 10 + ENDIF + ENDIF + ELSE + IKEEP = 1 + NA = IKEEP + id%N + NE = IKEEP + 2 * id%N + FILS = IKEEP + 3 * id%N + FRERE = FILS + id%N + PTRAR = FRERE + id%N + NFSIZ = PTRAR + 4 * id%N + IF(id%MYID .EQ. MASTER) THEN + WORK1PTR => id%IS1(IKEEP : IKEEP + 3*id%N-1) + WORK2PTR => id%IS1(PTRAR : PTRAR + 4*id%N-1) + NFSIZPTR => id%IS1(NFSIZ : NFSIZ + id%N-1) + FILSPTR => id%IS1(FILS : FILS + id%N-1) + FREREPTR => id%IS1(FRERE : FRERE + id%N-1) + ELSE + ALLOCATE(WORK1PTR(3*id%N)) + ALLOCATE(WORK2PTR(4*id%N)) + END IF + CALL SMUMPS_715(id, + & WORK1PTR, + & WORK2PTR, + & NFSIZPTR, + & FILSPTR, + & FREREPTR) + IF(id%MYID .EQ. 0) THEN + NULLIFY(WORK1PTR, WORK2PTR, NFSIZPTR) + NULLIFY(FILSPTR, FREREPTR) + ELSE + DEALLOCATE(WORK1PTR, WORK2PTR) + END IF + KEEP(28) = INFOG(6) + END IF + 10 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + IF(id%MYID .EQ. MASTER) THEN + CALL MUMPS_633(KEEP(12),ICNTL(14), + & KEEP(50),KEEP(54),ICNTL(6),KEEP(52)) + CALL SMUMPS_348(id%N, id%IS1(FILS), id%IS1(FRERE), + & id%IS1(IKEEP+2*id%N), id%IS1(IKEEP+id%N)) + IF (id%NSLAVES .EQ. 1) THEN + id%NBSA = 0 + IF ( (id%KEEP(60).EQ.0). + & AND.(id%KEEP(53).EQ.0)) THEN + id%KEEP(20)=0 + id%KEEP(38)=0 + ENDIF + id%KEEP(56)=0 + id%PROCNODE = 0 + IF (id%KEEP(60) .EQ. 2 .OR. id%KEEP(60).EQ.3) THEN + CALL SMUMPS_564(id%KEEP(38), id%PROCNODE(1), + & 1+2*id%NSLAVES, id%IS1(FILS),id%N) + ENDIF + ELSE + PEAK = real(id%INFOG(5))*real(id%INFOG(5)) + + & real(id%KEEP(2))*real(id%KEEP(2)) + SSARBR => id%IS1(IKEEP:IKEEP+id%N-1) + CALL SMUMPS_537(id%N,id%NSLAVES,ICNTL(1), + & INFOG(1), + & id%IS1(NE), + & id%IS1(NFSIZ), + & id%IS1(FRERE), + & id%IS1(FILS), + & KEEP(1),KEEP8(1),id%PROCNODE(1), + & SSARBR(1),id%NBSA,PEAK,IERR + & ) + NULLIFY(SSARBR) + if(IERR.eq.-999) then + write(6,*) ' Internal error in MUMPS_369' + INFO(1) = IERR + GOTO 11 + ENDIF + IF(IERR.NE.0) THEN + INFO(1) = -135 + INFO(2) = IERR + GOTO 11 + ENDIF + CALL SMUMPS_348(id%N, id%IS1(FILS), + & id%IS1(FRERE), id%IS1(IKEEP+2*id%N), + & id%IS1(IKEEP+id%N)) + ENDIF + 11 CONTINUE + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + CALL MPI_BCAST( id%NELT, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + IF (KEEP(55) .EQ. 0) THEN + if (associated(id%FRTPTR)) DEALLOCATE(id%FRTPTR) + if (associated(id%FRTELT)) DEALLOCATE(id%FRTELT) + allocate( id%FRTPTR(1), id%FRTELT(1) ) + ELSE + LPTRAR = id%NELT+id%NELT+2 + CALL MUMPS_733(id%PTRAR, LPTRAR, id%INFO, LP, + & FORCE=.TRUE., STRING='id%PTRAR (Analysis)', ERRCODE=-7) + CALL MUMPS_733(id%FRTPTR, id%N+1, id%INFO, LP, + & FORCE=.TRUE., STRING='id%FRTPTR (Analysis)', ERRCODE=-7) + CALL MUMPS_733(id%FRTELT, id%NELT, id%INFO, LP, + & FORCE=.TRUE., STRING='id%FRTELT (Analysis)', ERRCODE=-7) + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + IF(id%MYID .EQ. MASTER) THEN + CALL SMUMPS_153( + & id%N, NELT, id%ELTPTR(NELT+1)-1, id%IS1(FRERE), + & id%IS1(FILS), + & id%IS1(IKEEP+id%N), id%IS1(IKEEP+2*id%N), XNODEL, + & NODEL, id%FRTPTR(1), id%FRTELT(1), id%ELTPROC(1)) + DO I=1, id%NELT+1 + id%PTRAR(id%NELT+I+1)=id%ELTPTR(I) + ENDDO + deallocate(XNODEL) + deallocate(NODEL) + END IF + CALL MPI_BCAST( id%PTRAR(id%NELT+2), id%NELT+1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%FRTPTR(1), id%N+1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%FRTELT(1), id%NELT, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + ENDIF + IF(id%MYID .EQ. MASTER) THEN + IF ( INFO( 1 ) .LT. 0 ) GOTO 12 + IF ( KEEP(55) .ne. 0 ) THEN + CALL SMUMPS_120(id%N, NELT, id%ELTPROC(1),id%NSLAVES, + & id%PROCNODE(1)) + END IF + NB_NIV2 = KEEP(56) + IF ( NB_NIV2.GT.0 ) THEN + allocate(PAR2_NODES(NB_NIV2), + & STAT=allocok) + IF (allocok .GT.0) then + INFO(1)= -7 + INFO(2)= NB_NIV2 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'PAR2_NODES' + END IF + GOTO 12 + END IF + ENDIF + IF ((NB_NIV2.GT.0) .AND. (KEEP(24).EQ.0)) THEN + INIV2 = 0 + DO 777 INODE = 1, id%N + IF ( ( id%IS1(FRERE+INODE-1) .NE. id%N+1 ) .AND. + & ( MUMPS_330(id%PROCNODE(INODE),id%NSLAVES) + & .eq. 2) ) THEN + INIV2 = INIV2 + 1 + PAR2_NODES(INIV2) = INODE + END IF + 777 CONTINUE + IF ( INIV2 .NE. NB_NIV2 ) THEN + WRITE(*,*) "Internal Error 2 in SMUMPS_26", + & INIV2, NB_NIV2 + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF ( (KEEP(24) .NE. 0) .AND. (NB_NIV2.GT.0) ) THEN + IF ( associated(id%CANDIDATES)) deallocate(id%CANDIDATES) + allocate( id%CANDIDATES(id%NSLAVES+1,NB_NIV2), + & stat=allocok) + if (allocok .gt.0) then + INFO(1)= -7 + INFO(2)= NB_NIV2*(id%NSLAVES+1) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'CANDIDATES' + END IF + GOTO 12 + END IF + CALL MUMPS_393 + & (PAR2_NODES,id%CANDIDATES,IERR) + IF(IERR.NE.0) THEN + INFO(1) = -2002 + GOTO 12 + ENDIF + CALL MUMPS_494() + IF(IERR.NE.0) THEN + INFO(1) = -2002 + GOTO 12 + ENDIF + ELSE + IF (associated(id%CANDIDATES)) DEALLOCATE(id%CANDIDATES) + allocate(id%CANDIDATES(1,1), stat=allocok) + IF (allocok .NE. 0) THEN + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'CANDIDATES' + END IF + GOTO 12 + ENDIF + ENDIF + 12 CONTINUE + KEEP(84) = ICNTL(27) + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + CALL MPI_BCAST( id%KEEP(1), 110, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MUMPS_749( id%KEEP8(21), MASTER, + & id%MYID, id%COMM, IERR) + CALL MPI_BCAST( id%KEEP(205), 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MPI_BCAST( id%NBSA, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + IF (id%MYID==MASTER) KEEP(127)=INFOG(5) + CALL MPI_BCAST( id%KEEP(127), 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MPI_BCAST( id%KEEP(226), 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MUMPS_733(id%STEP, id%N, id%INFO, LP, FORCE=.TRUE., + & STRING='id%STEP (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%PROCNODE_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%PROCNODE_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%NE_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%NE_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%ND_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%ND_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%FRERE_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%FRERE_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%DAD_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%DAD_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%FILS, id%N, id%INFO, LP, FORCE=.TRUE., + & STRING='id%FILS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%SYM_PERM, id%N, id%INFO, LP, FORCE=.TRUE., + & STRING='id%SYM_PERM (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + IF (KEEP(55) .EQ. 0) THEN + LPTRAR = id%N+id%N + CALL MUMPS_733(id%PTRAR, LPTRAR, id%INFO, LP, FORCE=.TRUE., + & STRING='id%PTRAR (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + ENDIF + IF ( associated( id%UNS_PERM ) ) deallocate(id%UNS_PERM) + IF ( id%MYID == MASTER .AND. id%KEEP(23) .NE. 0 ) THEN + allocate(id%UNS_PERM(id%N),stat=allocok) + IF ( allocok .ne. 0) THEN + INFO(1) = -7 + INFO(2) = id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%UNS_PERM' + END IF + GOTO 94 + ENDIF + DO I=1,id%N + id%UNS_PERM(I) = id%IS1(I) + END DO + ENDIF + 94 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( id%MYID .EQ. MASTER ) THEN + DO I=1,id%N + id%FILS(I) = id%IS1(FILS+I-1) + ENDDO + END IF + IF (id%MYID .EQ. MASTER ) THEN + IF (id%N.eq.1) THEN + NBROOT = 1 + NBLEAF = 1 + ELSE IF (id%IS1(NA+id%N-1) .LT.0) THEN + NBLEAF = id%N + NBROOT = id%N + ELSE IF (id%IS1(NA+id%N-2) .LT.0) THEN + NBLEAF = id%N-1 + NBROOT = id%IS1(NA+id%N-1) + ELSE + NBLEAF = id%IS1(NA+id%N-2) + NBROOT = id%IS1(NA+id%N-1) + ENDIF + id%LNA = 2+NBLEAF+NBROOT + ENDIF + CALL MPI_BCAST( id%LNA, 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MUMPS_733(id%NA, id%LNA, id%INFO, LP, FORCE=.TRUE., + & STRING='id%NA (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 96 + IF (id%MYID .EQ.MASTER ) THEN + id%NA(1) = NBLEAF + id%NA(2) = NBROOT + LEAF = 3 + IF ( id%N == 1 ) THEN + id%NA(LEAF) = 1 + LEAF = LEAF + 1 + ELSE IF (id%IS1(NA+id%N-1) < 0) THEN + id%NA(LEAF) = - id%IS1(NA+id%N-1)-1 + LEAF = LEAF + 1 + DO I = 1, NBLEAF - 1 + id%NA(LEAF) = id%IS1(NA+I-1) + LEAF = LEAF + 1 + ENDDO + ELSE IF (id%IS1(NA+id%N-2) < 0 ) THEN + INODE = - id%IS1(NA+id%N-2) - 1 + id%NA(LEAF) = INODE + LEAF =LEAF + 1 + IF ( NBLEAF > 1 ) THEN + DO I = 1, NBLEAF - 1 + id%NA(LEAF) = id%IS1(NA+I-1) + LEAF = LEAF + 1 + ENDDO + ENDIF + ELSE + DO I = 1, NBLEAF + id%NA(LEAF) = id%IS1(NA+I-1) + LEAF = LEAF + 1 + ENDDO + END IF + END IF + 96 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF (associated(id%Step2node)) THEN + DEALLOCATE(id%Step2node) + NULLIFY(id%Step2node) + ENDIF + IF ( id%MYID .EQ. MASTER ) THEN + ISTEP = 0 + DO I = 1, id%N + IF ( id%IS1(FRERE+I-1) .ne. id%N + 1 ) THEN + ISTEP = ISTEP + 1 + id%STEP(I)=ISTEP + INN = id%IS1(FILS+I-1) + DO WHILE ( INN .GT. 0 ) + id%STEP(INN) = - ISTEP + INN = id%IS1(FILS + INN -1) + END DO + IF (id%IS1(FRERE+I-1) .eq. 0) THEN + id%NA(LEAF) = I + LEAF = LEAF + 1 + ENDIF + ENDIF + END DO + IF ( LEAF - 1 .NE. 2+NBROOT + NBLEAF ) THEN + WRITE(*,*) 'Internal error 2 in SMUMPS_26' + CALL MUMPS_ABORT() + ENDIF + IF ( ISTEP .NE. id%KEEP(28) ) THEN + write(*,*) 'Internal error 3 in SMUMPS_26' + CALL MUMPS_ABORT() + ENDIF + DO I = 1, id%N + IF (id%IS1(FRERE+I-1) .NE. id%N+1) THEN + id%PROCNODE_STEPS(id%STEP(I)) = id%PROCNODE( I ) + id%FRERE_STEPS(id%STEP(I)) = id%IS1(FRERE+I-1) + id%NE_STEPS(id%STEP(I)) = id%IS1(NE+I-1) + id%ND_STEPS(id%STEP(I)) = id%IS1(NFSIZ+I-1) + ENDIF + ENDDO + DO I = 1, id%N + IF ( id%STEP(I) .LE. 0) CYCLE + IF (id%IS1(FRERE+I-1) .eq. 0) THEN + id%DAD_STEPS(id%STEP(I)) = 0 + ENDIF + IFS = id%IS1(FILS+I-1) + DO WHILE ( IFS .GT. 0 ) + IFS= id%IS1(FILS + IFS -1) + END DO + IFS = -IFS + DO WHILE (IFS.GT.0) + id%DAD_STEPS(id%STEP(IFS)) = I + IFS = id%IS1(FRERE+IFS-1) + ENDDO + END DO + deallocate(id%PROCNODE) + NULLIFY(id%PROCNODE) + deallocate(id%IS1) + NULLIFY(id%IS1) + CALL SMUMPS_363(id%N, id%FRERE_STEPS(1), + & id%STEP(1),id%FILS(1), id%NA(1), id%LNA, + & id%NE_STEPS(1), id%ND_STEPS(1), id%DAD_STEPS(1), + & id%KEEP(28), .TRUE., id%KEEP(28), id%KEEP(70), + & id%KEEP(50), id%INFO(1), id%ICNTL(1),id%KEEP(215), + & id%KEEP(234), id%KEEP(55), + & id%PROCNODE_STEPS(1),id%NSLAVES,PEAK,id%KEEP(90) + & ) + IF ((id%KEEP(76).GE.4).OR.(id%KEEP(76).GE.6).OR. + & (id%KEEP(47).EQ.4).OR.((id%KEEP(81).GT.0) + & .AND.(id%KEEP(47).GE.2)))THEN + IS_BUILD_LOAD_MEM_CALLED=.TRUE. + IF ((id%KEEP(47) .EQ. 4).OR. + & (( id%KEEP(81) .GT. 0).AND.(id%KEEP(47).GE.2))) THEN + IF(id%NSLAVES.GT.1) THEN + SIZE_TEMP_MEM = id%NBSA + ELSE + SIZE_TEMP_MEM = id%NA(2) + ENDIF + ELSE + SIZE_TEMP_MEM = 1 + ENDIF + IF((id%KEEP(76).EQ.4).OR.(id%KEEP(76).EQ.6))THEN + SIZE_DEPTH_FIRST=id%KEEP(28) + ELSE + SIZE_DEPTH_FIRST=1 + ENDIF + allocate(TEMP_MEM(SIZE_TEMP_MEM,id%NSLAVES),STAT=allocok) + IF (allocok .NE.0) THEN + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_MEM' + END IF + GOTO 80 + END IF + allocate(TEMP_LEAF(SIZE_TEMP_MEM,id%NSLAVES), + & stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_LEAF' + END IF + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + GOTO 80 + end if + allocate(TEMP_SIZE(SIZE_TEMP_MEM,id%NSLAVES), + & stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_SIZE' + END IF + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + GOTO 80 + end if + allocate(TEMP_ROOT(SIZE_TEMP_MEM,id%NSLAVES), + & stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_ROOT' + END IF + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + GOTO 80 + end if + allocate(DEPTH_FIRST(SIZE_DEPTH_FIRST),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'DEPTH_FIRST' + END IF + INFO(1)= -7 + INFO(2)= SIZE_DEPTH_FIRST + GOTO 80 + end if + ALLOCATE(DEPTH_FIRST_SEQ(SIZE_DEPTH_FIRST),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'DEPTH_FIRST_SEQ' + END IF + INFO(1)= -7 + INFO(2)= SIZE_DEPTH_FIRST + GOTO 80 + end if + ALLOCATE(SBTR_ID(SIZE_DEPTH_FIRST),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'SBTR_ID' + END IF + INFO(1)= -7 + INFO(2)= SIZE_DEPTH_FIRST + GOTO 80 + end if + IF(id%KEEP(76).EQ.5)THEN + SIZE_COST_TRAV=id%KEEP(28) + ELSE + SIZE_COST_TRAV=1 + ENDIF + allocate(COST_TRAV_TMP(SIZE_COST_TRAV),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'COST_TRAV_TMP' + END IF + INFO(1)= -7 + INFO(2)= SIZE_COST_TRAV + GOTO 80 + END IF + IF(id%KEEP(76).EQ.5)THEN + IF(id%KEEP(70).EQ.0)THEN + id%KEEP(70)=5 + ENDIF + IF(id%KEEP(70).EQ.1)THEN + id%KEEP(70)=6 + ENDIF + ENDIF + IF(id%KEEP(76).EQ.4)THEN + IF(id%KEEP(70).EQ.0)THEN + id%KEEP(70)=3 + ENDIF + IF(id%KEEP(70).EQ.1)THEN + id%KEEP(70)=4 + ENDIF + ENDIF + CALL SMUMPS_364(id%N, id%FRERE_STEPS(1), + & id%STEP(1),id%FILS(1), id%NA(1), id%LNA, + & id%NE_STEPS(1), id%ND_STEPS(1), id%DAD_STEPS(1), + & id%KEEP(28), .TRUE., id%KEEP(28), id%KEEP(70), + & id%KEEP(50), id%INFO(1), id%ICNTL(1),id%KEEP(47), + & id%KEEP(81),id%KEEP(76),id%KEEP(215), + & id%KEEP(234), id%KEEP(55), + & id%PROCNODE_STEPS(1),TEMP_MEM,id%NSLAVES, + & SIZE_TEMP_MEM, PEAK,id%KEEP(90),SIZE_DEPTH_FIRST, + & SIZE_COST_TRAV,DEPTH_FIRST(1),DEPTH_FIRST_SEQ(1), + & COST_TRAV_TMP(1), + & TEMP_LEAF,TEMP_SIZE,TEMP_ROOT,SBTR_ID(1) + & ) + END IF + CALL SMUMPS_181(id%N, id%NA(1), id%LNA, + & id%NE_STEPS(1), id%SYM_PERM(1), + & id%FILS(1), id%DAD_STEPS(1), + & id%STEP(1), id%KEEP(28), id%INFO(1) ) + ENDIF + 80 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + CALL MPI_BCAST( id%FILS(1), id%N, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%NA(1), id%LNA, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%STEP(1), id%N, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%PROCNODE_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%DAD_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%FRERE_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR) + CALL MPI_BCAST( id%NE_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%ND_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%SYM_PERM(1), id%N, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (KEEP(55) .EQ. 0) THEN + CALL SMUMPS_746(id, id%PTRAR(1)) + IF(id%MYID .EQ. MASTER) THEN + IF ( (KEEP(244) .EQ. 1) .AND. (KEEP(54) .EQ. 3) ) THEN + DEALLOCATE( id%IRN ) + DEALLOCATE( id%JCN ) + END IF + END IF + ENDIF + IF((id%KEEP(76).EQ.4).OR.(id%KEEP(76).EQ.6))THEN + IF(associated(id%DEPTH_FIRST)) + & deallocate(id%DEPTH_FIRST) + allocate(id%DEPTH_FIRST(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= id%KEEP(28) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST' + END IF + GOTO 87 + END IF + IF(associated(id%DEPTH_FIRST_SEQ)) + * DEALLOCATE(id%DEPTH_FIRST_SEQ) + ALLOCATE(id%DEPTH_FIRST_SEQ(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= id%KEEP(28) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + IF(associated(id%SBTR_ID)) + * DEALLOCATE(id%SBTR_ID) + ALLOCATE(id%SBTR_ID(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= id%KEEP(28) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + IF(id%MYID.EQ.MASTER)THEN + id%DEPTH_FIRST(1:id%KEEP(28))=DEPTH_FIRST(1:id%KEEP(28)) + id%DEPTH_FIRST_SEQ(1:id%KEEP(28))= + & DEPTH_FIRST_SEQ(1:id%KEEP(28)) + id%SBTR_ID(1:KEEP(28))=SBTR_ID(1:KEEP(28)) + ENDIF + CALL MPI_BCAST( id%DEPTH_FIRST(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%DEPTH_FIRST_SEQ(1), id%KEEP(28), + & MPI_INTEGER,MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%SBTR_ID(1), id%KEEP(28), + & MPI_INTEGER,MASTER, id%COMM, IERR ) + ELSE + IF(associated(id%DEPTH_FIRST)) + & deallocate(id%DEPTH_FIRST) + allocate(id%DEPTH_FIRST(1),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST' + END IF + GOTO 87 + END IF + IF(associated(id%DEPTH_FIRST_SEQ)) + * DEALLOCATE(id%DEPTH_FIRST_SEQ) + ALLOCATE(id%DEPTH_FIRST_SEQ(1),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + IF(associated(id%SBTR_ID)) + * DEALLOCATE(id%SBTR_ID) + ALLOCATE(id%SBTR_ID(1),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + id%SBTR_ID(1)=0 + id%DEPTH_FIRST(1)=0 + id%DEPTH_FIRST_SEQ(1)=0 + ENDIF + IF(id%KEEP(76).EQ.5)THEN + IF(associated(id%COST_TRAV)) + & deallocate(id%COST_TRAV) + allocate(id%COST_TRAV(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%COST_TRAV' + END IF + INFO(1)= -7 + INFO(2)= id%KEEP(28) + GOTO 87 + END IF + IF(id%MYID.EQ.MASTER)THEN + id%COST_TRAV(1:id%KEEP(28))= + & dble(COST_TRAV_TMP(1:id%KEEP(28))) + ENDIF + CALL MPI_BCAST( id%COST_TRAV(1), id%KEEP(28), + & MPI_DOUBLE_PRECISION,MASTER, id%COMM, IERR ) + ELSE + IF(associated(id%COST_TRAV)) + & deallocate(id%COST_TRAV) + allocate(id%COST_TRAV(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%COST_TRAV(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + id%COST_TRAV(1)=0.0d0 + ENDIF + IF (id%KEEP(47) .EQ. 4 .OR. + & ((id%KEEP(81) .GT. 0).AND.(id%KEEP(47).GE.2))) THEN + IF(id%MYID .EQ. MASTER)THEN + DO K=1,id%NSLAVES + DO J=1,SIZE_TEMP_MEM + IF(TEMP_MEM(J,K) < 0.0D0) GOTO 666 + ENDDO + 666 CONTINUE + J=J-1 + IF (id%KEEP(46) == 1) THEN + IDEST = K - 1 + ELSE + IDEST = K + ENDIF + IF (IDEST .NE. MASTER) THEN + CALL MPI_SEND(J,1,MPI_INTEGER,IDEST,0, + & id%COMM,IERR) + CALL MPI_SEND(TEMP_MEM(1,K),J,MPI_DOUBLE_PRECISION, + & IDEST, 0, id%COMM,IERR) + CALL MPI_SEND(TEMP_LEAF(1,K),J,MPI_INTEGER, + & IDEST, 0, id%COMM,IERR) + CALL MPI_SEND(TEMP_SIZE(1,K),J,MPI_INTEGER, + & IDEST, 0, id%COMM,IERR) + CALL MPI_SEND(TEMP_ROOT(1,K),J,MPI_INTEGER, + & IDEST, 0, id%COMM,IERR) + ELSE + IF(associated(id%MEM_SUBTREE)) + & deallocate(id%MEM_SUBTREE) + allocate(id%MEM_SUBTREE(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MEM_SUBTREE' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%NBSA_LOCAL = J + id%MEM_SUBTREE(1:J)=TEMP_MEM(1:J,1) + IF(associated(id%MY_ROOT_SBTR)) + & deallocate(id%MY_ROOT_SBTR) + allocate(id%MY_ROOT_SBTR(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_ROOT_SBTR' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%MY_ROOT_SBTR(1:J)=TEMP_ROOT(1:J,1) + IF(associated(id%MY_FIRST_LEAF)) + & deallocate(id%MY_FIRST_LEAF) + allocate(id%MY_FIRST_LEAF(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_FIRST_LEAF' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%MY_FIRST_LEAF(1:J)=TEMP_LEAF(1:J,1) + IF(associated(id%MY_NB_LEAF)) + & deallocate(id%MY_NB_LEAF) + allocate(id%MY_NB_LEAF(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_NB_LEAF' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%MY_NB_LEAF(1:J)=TEMP_SIZE(1:J,1) + ENDIF + ENDDO + ELSE + CALL MPI_RECV(id%NBSA_LOCAL,1,MPI_INTEGER, + & MASTER,0,id%COMM,STATUS, IERR) + IF(associated(id%MEM_SUBTREE)) + & deallocate(id%MEM_SUBTREE) + allocate(id%MEM_SUBTREE(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MEM_SUBTREE' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + IF(associated(id%MY_ROOT_SBTR)) + & deallocate(id%MY_ROOT_SBTR) + allocate(id%MY_ROOT_SBTR(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_ROOT_SBTR' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + IF(associated(id%MY_FIRST_LEAF)) + & deallocate(id%MY_FIRST_LEAF) + allocate(id%MY_FIRST_LEAF(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'MY_FIRST_LEAF' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + IF(associated(id%MY_NB_LEAF)) + & deallocate(id%MY_NB_LEAF) + allocate(id%MY_NB_LEAF(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'MY_NB_LEAF' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + CALL MPI_RECV(id%MEM_SUBTREE(1),id%NBSA_LOCAL, + & MPI_DOUBLE_PRECISION,MASTER,0, + & id%COMM,STATUS,IERR) + CALL MPI_RECV(id%MY_FIRST_LEAF(1),id%NBSA_LOCAL, + & MPI_INTEGER,MASTER,0, + & id%COMM,STATUS,IERR) + CALL MPI_RECV(id%MY_NB_LEAF(1),id%NBSA_LOCAL, + & MPI_INTEGER,MASTER,0, + & id%COMM,STATUS,IERR) + CALL MPI_RECV(id%MY_ROOT_SBTR(1),id%NBSA_LOCAL, + & MPI_INTEGER,MASTER,0, + & id%COMM,STATUS,IERR) + ENDIF + ELSE + id%NBSA_LOCAL = -999999 + IF(associated(id%MEM_SUBTREE)) + & deallocate(id%MEM_SUBTREE) + allocate(id%MEM_SUBTREE(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MEM_SUBTREE(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + IF(associated(id%MY_ROOT_SBTR)) + & deallocate(id%MY_ROOT_SBTR) + allocate(id%MY_ROOT_SBTR(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_ROOT_SBTR(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + IF(associated(id%MY_FIRST_LEAF)) + & deallocate(id%MY_FIRST_LEAF) + allocate(id%MY_FIRST_LEAF(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_FIRST_LEAF(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + IF(associated(id%MY_NB_LEAF)) + & deallocate(id%MY_NB_LEAF) + allocate(id%MY_NB_LEAF(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_NB_LEAF(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + ENDIF + IF(id%MYID.EQ.MASTER)THEN + IF(IS_BUILD_LOAD_MEM_CALLED)THEN + deallocate(TEMP_MEM) + deallocate(TEMP_SIZE) + deallocate(TEMP_ROOT) + deallocate(TEMP_LEAF) + deallocate(COST_TRAV_TMP) + deallocate(DEPTH_FIRST) + deallocate(DEPTH_FIRST_SEQ) + deallocate(SBTR_ID) + ENDIF + ENDIF + 87 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + NB_NIV2 = KEEP(56) + IF ( NB_NIV2.GT.0 ) THEN + if (id%MYID.ne.MASTER) then + IF (associated(id%CANDIDATES)) deallocate(id%CANDIDATES) + allocate(PAR2_NODES(NB_NIV2), + & id%CANDIDATES(id%NSLAVES+1,NB_NIV2), + & STAT=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= NB_NIV2*(id%NSLAVES+1) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'PAR2_NODES/id%CANDIDATES' + END IF + end if + end if + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + CALL MPI_BCAST(PAR2_NODES(1),NB_NIV2, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + IF (KEEP(24) .NE.0 ) THEN + CALL MPI_BCAST(id%CANDIDATES(1,1), + & (NB_NIV2*(id%NSLAVES+1)), + & MPI_INTEGER, MASTER, id%COMM, IERR ) + ENDIF + ENDIF + IF ( associated(id%ISTEP_TO_INIV2)) THEN + deallocate(id%ISTEP_TO_INIV2) + NULLIFY(id%ISTEP_TO_INIV2) + ENDIF + IF ( associated(id%I_AM_CAND)) THEN + deallocate(id%I_AM_CAND) + NULLIFY(id%I_AM_CAND) + ENDIF + IF (NB_NIV2.EQ.0) THEN + id%KEEP(71) = 1 + ELSE + id%KEEP(71) = id%KEEP(28) + ENDIF + allocate(id%ISTEP_TO_INIV2(id%KEEP(71)), + & id%I_AM_CAND(max(NB_NIV2,1)), + & stat=allocok) + IF (allocok .gt.0) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%ISTEP_TO_INIV2' + WRITE(LP, 150) 'id%TAB_POS_IN_PERE' + END IF + INFO(1)= -7 + IF (NB_NIV2.EQ.0) THEN + INFO(2)= 2 + ELSE + INFO(2)= id%KEEP(28)+NB_NIV2*(id%NSLAVES+2) + END IF + GOTO 321 + ENDIF + IF ( NB_NIV2 .GT.0 ) THEN + DO INIV2 = 1, NB_NIV2 + INN = PAR2_NODES(INIV2) + id%ISTEP_TO_INIV2(id%STEP(INN)) = INIV2 + END DO + CALL SMUMPS_649( id%NSLAVES, + & NB_NIV2, id%MYID_NODES, + & id%CANDIDATES(1,1), id%I_AM_CAND(1) ) + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (associated(id%FUTURE_NIV2)) THEN + deallocate(id%FUTURE_NIV2) + NULLIFY(id%FUTURE_NIV2) + ENDIF + allocate(id%FUTURE_NIV2(id%NSLAVES), stat=allocok) + IF (allocok .gt.0) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'FUTURE_NIV2' + END IF + INFO(1)= -7 + INFO(2)= id%NSLAVES + GOTO 321 + ENDIF + id%FUTURE_NIV2=0 + DO INIV2 = 1, NB_NIV2 + IDEST = MUMPS_275( + & id%PROCNODE_STEPS(id%STEP(PAR2_NODES(INIV2))), + & id%NSLAVES) + id%FUTURE_NIV2(IDEST+1)=id%FUTURE_NIV2(IDEST+1)+1 + ENDDO +#endif + IF ( I_AM_SLAVE ) THEN + IF ( associated(id%TAB_POS_IN_PERE)) THEN + deallocate(id%TAB_POS_IN_PERE) + NULLIFY(id%TAB_POS_IN_PERE) + ENDIF + allocate(id%TAB_POS_IN_PERE(id%NSLAVES+2,max(NB_NIV2,1)), + & stat=allocok) + IF (allocok .gt.0) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%ISTEP_TO_INIV2' + WRITE(LP, 150) 'id%TAB_POS_IN_PERE' + END IF + INFO(1)= -7 + IF (NB_NIV2.EQ.0) THEN + INFO(2)= 2 + ELSE + INFO(2)= id%KEEP(28)+NB_NIV2*(id%NSLAVES+2) + END IF + GOTO 321 + ENDIF + END IF + IF (NB_NIV2.GT.0) deallocate (PAR2_NODES) + 321 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF ( KEEP(23).NE.0 .and. id%MYID .EQ. MASTER ) THEN + IKEEP = id%N + 1 + ELSE + IKEEP = 1 + END IF + FILS = IKEEP + 3 * id%N + NE = IKEEP + 2 * id%N + NA = IKEEP + id%N + FRERE = FILS + id%N + PTRAR = FRERE + id%N + IF (KEEP(55) .EQ. 0) THEN + IF ( id%MYID.EQ.MASTER ) THEN + NFSIZ = PTRAR + 4 * id%N + ELSE + NFSIZ = PTRAR + 2 * id%N + ENDIF + ELSE + NFSIZ = PTRAR + 2 * (NELT + 1) + END IF + IF ( KEEP(38) .NE. 0 ) THEN + CALL SMUMPS_164( id%MYID, + & id%NSLAVES, id%N, id%root, + & id%COMM_NODES, KEEP( 38 ), id%FILS(1), + & id%KEEP(50), id%KEEP(46), + & id%KEEP(51) + & , id%KEEP(60), id%NPROW, id%NPCOL, id%MBLOCK, id%NBLOCK + & ) + ELSE + id%root%yes = .FALSE. + END IF + IF ( KEEP(38) .NE. 0 .and. I_AM_SLAVE ) THEN + CALL MPI_ALLREDUCE(id%root%MYROW, MYROW_CHECK, 1, + & MPI_INTEGER, MPI_MAX, id%COMM_NODES, IERR) + IF ( MYROW_CHECK .eq. -1) THEN + INFO(1) = -25 + INFO(2) = 0 + END IF + IF ( id%root%MYROW .LT. -1 .OR. + & id%root%MYCOL .LT. -1 ) THEN + INFO(1) = -25 + INFO(2) = 0 + END IF + IF ( LP > 0 .AND. INFO(1) == -25 ) THEN + WRITE(LP, '(A)') + & 'Problem with your version of the BLACS.' + WRITE(LP, '(A)') 'Try using a BLACS version from netlib.' + ENDIF + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF ( I_AM_SLAVE ) THEN + IF (KEEP(55) .EQ. 0) THEN + CALL SMUMPS_24( id%MYID, + & id%NSLAVES, id%N, id%PROCNODE_STEPS(1), + & id%STEP(1), id%PTRAR(1), + & id%PTRAR(id%N +1), + & id%ISTEP_TO_INIV2(1), id%I_AM_CAND(1), + & KEEP(1),KEEP8(1), ICNTL(1), id ) + ELSE + CALL SMUMPS_25( id%MYID, + & id%NSLAVES, id%N, id%PROCNODE_STEPS(1), + & id%STEP(1), + & id%PTRAR(1), + & id%PTRAR(id%NELT+2 ), + & id%NELT, + & id%FRTPTR(1), id%FRTELT(1), + & KEEP(1), KEEP8(1), ICNTL(1), id%KEEP(50) ) + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + IF ( id%root%yes ) THEN + LOCAL_M = numroc( id%ND_STEPS(id%STEP(KEEP(38))), + & id%root%MBLOCK, id%root%MYROW, 0, + & id%root%NPROW ) + LOCAL_M = max(1, LOCAL_M) + LOCAL_N = numroc( id%ND_STEPS(id%STEP(KEEP(38))), + & id%root%NBLOCK, id%root%MYCOL, 0, + & id%root%NPCOL ) + ELSE + LOCAL_M = 0 + LOCAL_N = 0 + END IF + IF ( KEEP(60) .EQ. 2 .OR. KEEP(60) .EQ. 3 ) THEN + id%SCHUR_MLOC=LOCAL_M + id%SCHUR_NLOC=LOCAL_N + id%root%SCHUR_MLOC=LOCAL_M + id%root%SCHUR_NLOC=LOCAL_N + ENDIF + IF ( .NOT. associated(id%CANDIDATES)) THEN + ALLOCATE(id%CANDIDATES(id%NSLAVES+1,1)) + ENDIF + CALL SMUMPS_246( id%MYID_NODES, id%N, + & id%STEP(1), id%FRERE_STEPS(1), id%FILS(1), + & id%NA(1), id%LNA, id%NE_STEPS(1), id%DAD_STEPS(1), + & id%ND_STEPS(1), id%PROCNODE_STEPS(1), + & id%NSLAVES, + & KEEP8(11), KEEP(26), KEEP(15), + & KEEP8(12), + & KEEP8(14), + & KEEP(224), KEEP(225), + & KEEP(27), RINFO(1), + & KEEP(1), KEEP8(1), LOCAL_M, LOCAL_N, SBUF_RECOLD8, + & SBUF_SEND, SBUF_REC, id%COST_SUBTREES, KEEP(28), + & id%I_AM_CAND(1), max(KEEP(56),1), + & id%ISTEP_TO_INIV2(1), id%CANDIDATES(1,1), + & INFO(1), INFO(2) + & ,KEEP8(15) + & ,MAX_SIZE_FACTOR_TMP, KEEP8(9) + & ,ENTRIES_IN_FACTORS_LOC_MASTERS + & ) + id%MAX_SURF_MASTER = KEEP8(15) + KEEP8(19)=MAX_SIZE_FACTOR_TMP + KEEP( 29 ) = KEEP(15) + 2* max(KEEP(12),10) + & * ( KEEP(15) / 100 + 1) + INFO( 19 ) = KEEP(225) + 2* max(KEEP(12),10) + & * ( KEEP(225) / 100 + 1) + KEEP8(13) = KEEP8(12) + int(KEEP(12),8) * + & ( KEEP8(12) / 100_8 + 1_8 ) + KEEP8(17) = KEEP8(14) + int(KEEP(12),8) * + & ( KEEP8(14) /100_8 +1_8) + CALL MUMPS_736 ( SBUF_RECOLD8, KEEP8(22), MPI_MAX, + & id%COMM_NODES ) + SBUF_SEND = max(SBUF_SEND,KEEP(27)) + SBUF_REC = max(SBUF_REC ,KEEP(27)) + CALL MPI_ALLREDUCE (SBUF_REC, KEEP(44), 1, + & MPI_INTEGER, MPI_MAX, + & id%COMM_NODES, IERR) + IF (KEEP(48)==5) THEN + KEEP(43)=KEEP(44) + ELSE + KEEP(43)=SBUF_SEND + ENDIF + MIN_BUF_SIZE8 = KEEP8(22) / int(KEEP(238),8) + MIN_BUF_SIZE8 = min( MIN_BUF_SIZE8, int(huge (KEEP(43)),8)) + MIN_BUF_SIZE = int( MIN_BUF_SIZE8 ) + KEEP(44) = max(KEEP(44), MIN_BUF_SIZE) + KEEP(43) = max(KEEP(43), MIN_BUF_SIZE) + IF ( MP .GT. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' Estimated INTEGER space for factors :', + & KEEP(26) + WRITE(MP,'(A,I10) ') + & ' INFO(3), est. real space to store factors :', + & KEEP8(11) + WRITE(MP,'(A,I10) ') + & ' Estimated number of entries in factors :', + & KEEP8(9) + WRITE(MP,'(A,I10) ') + & ' Current value of space relaxation parameter :', + & KEEP(12) + WRITE(MP,'(A,I10) ') + & ' Estimated size of IS (In Core factorization):', + & KEEP(29) + WRITE(MP,'(A,I10) ') + & ' Estimated size of S (In Core factorization):', + & KEEP8(13) + WRITE(MP,'(A,I10) ') + & ' Estimated size of S (OOC factorization) :', + & KEEP8(17) + END IF + ELSE + ENTRIES_IN_FACTORS_LOC_MASTERS = 0_8 + KEEP8(13) = 0_8 + KEEP(29) = 0 + KEEP8(17)= 0_8 + INFO(19) = 0 + KEEP8(11) = 0_8 + KEEP(26) = 0 + KEEP(27) = 0 + RINFO(1) = 0.0E0 + END IF + CALL MUMPS_736( ENTRIES_IN_FACTORS_LOC_MASTERS, + & KEEP8(109), MPI_SUM, id%COMM) + CALL MUMPS_736( KEEP8(19), KEEP8(119), + & MPI_MAX, id%COMM) + CALL MPI_ALLREDUCE( KEEP(27), KEEP(127), 1, + & MPI_INTEGER, MPI_MAX, + & id%COMM, IERR) + CALL MPI_ALLREDUCE( KEEP(26), KEEP(126), 1, + & MPI_INTEGER, MPI_SUM, + & id%COMM, IERR) + CALL MUMPS_646( KEEP8(11), KEEP8(111), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735( KEEP8(111), INFOG(3) ) + CALL MPI_ALLREDUCE( RINFO(1), RINFOG(1), 1, + & MPI_REAL, MPI_SUM, + & id%COMM, IERR) + CALL MUMPS_735( KEEP8(11), INFO(3) ) + INFO ( 4 ) = KEEP( 26 ) + INFO ( 5 ) = KEEP( 27 ) + INFO ( 7 ) = KEEP( 29 ) + CALL MUMPS_735( KEEP8(13), INFO(8) ) + CALL MUMPS_735( KEEP8(17), INFO(20) ) + CALL MUMPS_735( KEEP8(9), INFO(24) ) + INFOG( 4 ) = KEEP( 126 ) + INFOG( 5 ) = KEEP( 127 ) + CALL MUMPS_735( KEEP8(109), INFOG(20) ) + CALL SMUMPS_100(id%MYID, id%COMM, KEEP(1), KEEP8(1), + & INFO(1), INFOG(1), RINFO(1), RINFOG(1), ICNTL(1)) + OOC_STAT = KEEP(201) + IF (KEEP(201) .NE. -1) OOC_STAT=0 + PERLU_ON = .FALSE. + CALL SMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + KEEP8(2) = TOTAL_BYTES + PERLU_ON = .TRUE. + CALL SMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + IF ( MP .gt. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' Estimated space in MBYTES for IC factorization :', + & TOTAL_MBYTES + END IF + id%INFO(15) = TOTAL_MBYTES + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(15), id%INFOG(16), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Rank of proc needing largest memory in IC facto :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Estimated corresponding MBYTES for IC facto :', + & id%INFOG(16) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (IC) :' + & ,(id%INFOG(17)-id%INFO(15))/id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (IC) :' + & ,id%INFOG(17)/id%NSLAVES + END IF + WRITE(MPG,'(A,I10) ') + & ' ** TOTAL space in MBYTES for IC factorization :' + & ,id%INFOG(17) + END IF + OOC_STAT = KEEP(201) +#if defined(OLD_OOC_NOPANEL) + IF (OOC_STAT .NE. -1) OOC_STAT=2 +#else + IF (OOC_STAT .NE. -1) OOC_STAT=1 +#endif + PERLU_ON = .FALSE. + CALL SMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + KEEP8(3) = TOTAL_BYTES + PERLU_ON = .TRUE. + CALL SMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + id%INFO(17) = TOTAL_MBYTES + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(17), id%INFOG(26), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Rank of proc needing largest memory for OOC facto :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Estimated corresponding MBYTES for OOC facto :', + & id%INFOG(26) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (OOC) :' + & ,(id%INFOG(27)-id%INFO(15))/id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (OOC) :' + & ,id%INFOG(27)/id%NSLAVES + END IF + WRITE(MPG,'(A,I10) ') + & ' ** TOTAL space in MBYTES for OOC factorization :' + & ,id%INFOG(27) + END IF + IF ( id%MYID. eq. MASTER .AND. KEEP(54) .eq. 1 ) THEN + IF (associated( id%MAPPING)) + & deallocate( id%MAPPING) + allocate( id%MAPPING(id%NZ), stat=allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1) = -7 + INFO(2) = id%NZ + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MAPPING' + END IF + GOTO 92 + END IF + allocate(IWtemp( id%N ), stat=allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-7 + INFO(2)=id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'IWtemp(N)' + END IF + GOTO 92 + END IF + CALL SMUMPS_83( + & id%N, id%MAPPING(1), + & id%NZ, id%IRN(1),id%JCN(1), id%PROCNODE_STEPS(1), + & id%STEP(1), + & id%NSLAVES, id%SYM_PERM(1), + & id%FILS(1), IWtemp, id%KEEP(1),id%KEEP8(1), + & id%root%MBLOCK, id%root%NBLOCK, + & id%root%NPROW, id%root%NPCOL ) + deallocate( IWtemp ) + 92 CONTINUE + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + RETURN + 110 FORMAT(/' ****** ANALYSIS STEP ********'/) + 150 FORMAT( + & /' ** FAILURE DURING SMUMPS_26, DYNAMIC ALLOCATION OF', + & A30) + END SUBROUTINE SMUMPS_26 + SUBROUTINE SMUMPS_537(N,NSLAVES, + & ICNTL,INFOG, NE, NFSIZ, + & FRERE, FILS, + & KEEP,KEEP8,PROCNODE, + & SSARBR,NBSA,PEAK,IERR + & ) + USE MUMPS_STATIC_MAPPING + IMPLICIT NONE + INTEGER N, NSLAVES, NBSA, IERR + INTEGER ICNTL(40),INFOG(40),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NE(N),NFSIZ(N),FRERE(N),FILS(N),PROCNODE(N) + INTEGER SSARBR(N) + REAL PEAK + CALL MUMPS_369(N,NSLAVES, + & ICNTL,INFOG, NE, NFSIZ, + & FRERE, FILS, + & KEEP,KEEP8,PROCNODE, + & SSARBR,NBSA,dble(PEAK),IERR + & ) + RETURN + END SUBROUTINE SMUMPS_537 + SUBROUTINE SMUMPS_564(INODE, PROCNODE, VALUE, FILS, N) + INTEGER, intent(in) :: INODE, N, VALUE + INTEGER, intent(in) :: FILS(N) + INTEGER, intent(inout) :: PROCNODE(N) + INTEGER IN + IN=INODE + DO WHILE ( IN > 0 ) + PROCNODE( IN ) = VALUE + IN=FILS( IN ) + ENDDO + RETURN + END SUBROUTINE SMUMPS_564 + SUBROUTINE SMUMPS_647(id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(SMUMPS_STRUC) :: id + INTEGER :: LP, MP, MPG, I + INTEGER :: MASTER + LOGICAL :: PROK, PROKG + PARAMETER( MASTER = 0 ) + LP = id%ICNTL( 1 ) + MP = id%ICNTL( 2 ) + MPG = id%ICNTL( 3 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF (id%MYID.eq.MASTER) THEN + id%KEEP(256) = id%ICNTL(7) + id%KEEP(252) = id%ICNTL(32) + IF (id%KEEP(252) < 0 .OR. id%KEEP(252) > 1 ) THEN + id%KEEP(252) = 0 + ENDIF + id%KEEP(251) = id%ICNTL(31) + IF (id%KEEP(251) < 0 .OR. id%KEEP(251) > 2 ) THEN + id%KEEP(251)=0 + ENDIF + IF (id%KEEP(50) .EQ. 0 .AND. id%KEEP(252).EQ.1) THEN + IF (id%KEEP(251) .NE. 1) id%KEEP(251) = 2 + ENDIF + IF (id%KEEP(50) .NE.0 .AND. id%KEEP(251) .EQ. 2) THEN + id%KEEP(251) = 0 + ENDIF + IF (id%KEEP(251) .EQ. 1) THEN + id%KEEP(201) = -1 + ENDIF + IF (id%KEEP(252).EQ.1) THEN + id%KEEP(253) = id%NRHS + IF (id%KEEP(253) .LE. 0) THEN + id%INFO(1)=-42 + id%INFO(2)=id%NRHS + RETURN + ENDIF + ELSE + id%KEEP(253) = 0 + ENDIF + ENDIF + IF ( (id%KEEP(24).NE.0) .AND. + & id%NSLAVES.eq.1 ) THEN + id%KEEP(24) = 0 + IF ( PROKG ) THEN + WRITE(MPG, '(A)') + & ' Resetting candidate strategy to 0 because NSLAVES=1' + WRITE(MPG, '(A)') ' ' + END IF + END IF + IF ( (id%KEEP(24).EQ.0) .AND. + & id%NSLAVES.GT.1 ) THEN + id%KEEP(24) = 8 + ENDIF + IF ( (id%KEEP(24).NE.0) .AND. (id%KEEP(24).NE.1) .AND. + & (id%KEEP(24).NE.8) .AND. (id%KEEP(24).NE.10) .AND. + & (id%KEEP(24).NE.12) .AND. (id%KEEP(24).NE.14) .AND. + & (id%KEEP(24).NE.16) .AND. (id%KEEP(24).NE.18)) THEN + id%KEEP(24) = 8 + IF ( PROKG ) THEN + WRITE(MPG, '(A)') + & ' Resetting candidate strategy to 8 ' + WRITE(MPG, '(A)') ' ' + END IF + END IF + id%KEEP8(21) = int(id%KEEP(85),8) + IF ( id%MYID .EQ. MASTER ) THEN + IF (id%KEEP(201).NE.-1) THEN + id%KEEP(201)=id%ICNTL(22) + IF (id%KEEP(201) .GT. 0) THEN +#if defined(OLD_OOC_NOPANEL) + id%KEEP(201)=2 +#else + id%KEEP(201)=1 +#endif + ENDIF + ENDIF + id%KEEP(54) = id%ICNTL(18) + IF ( id%KEEP(54) .LT. 0 .or. id%KEEP(54).GT.3 ) THEN + IF ( PROKG ) THEN + WRITE(MPG, *) ' Out-of-range value for id%ICNTL(18).' + WRITE(MPG, *) ' Used 0 ie matrix not distributed' + END IF + id%KEEP(54) = 0 + END IF + id%KEEP(55) = id%ICNTL(5) + IF ( id%KEEP(55) .LT. 0 .OR. id%KEEP(55) .GT. 1 ) THEN + IF ( PROKG ) THEN + WRITE(MPG, *) ' Out-of-range value for id%ICNTL(5).' + WRITE(MPG, *) ' Used 0 ie matrix is assembled' + END IF + id%KEEP(55) = 0 + END IF + id%KEEP(60) = id%ICNTL(19) + IF ( id%KEEP( 60 ) .LE. 0 ) id%KEEP( 60 ) = 0 + IF ( id%KEEP( 60 ) .GT. 3 ) id%KEEP( 60 ) = 0 + IF (id%KEEP(60) .NE. 0 .AND. id%SIZE_SCHUR == 0 ) THEN + WRITE(MPG,'(A)') + & ' ** Schur option ignored because SIZE_SCHUR=0' + id%KEEP(60)=0 + END IF + IF ( id%KEEP(60) .NE.0 ) THEN + id%KEEP(116) = id%SIZE_SCHUR + IF (id%SIZE_SCHUR .LT. 0 .OR. id%SIZE_SCHUR .GE. id%N) THEN + id%INFO(1)=-49 + id%INFO(2)=id%SIZE_SCHUR + RETURN + ENDIF + IF ( .NOT. associated( id%LISTVAR_SCHUR ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 8 + RETURN + ELSE IF (size(id%LISTVAR_SCHUR) 0 .AND. id%NBLOCK > 0 .AND. + & id%NPROW > 0 .AND. id%NPCOL > 0 ) THEN + IF (id%NPROW *id%NPCOL .LE. id%NSLAVES) THEN + IF (id%MBLOCK .NE. id%NBLOCK ) THEN + id%INFO(1)=-31 + id%INFO(2)=id%MBLOCK - id%NBLOCK + RETURN + ENDIF + ENDIF + ENDIF + ENDIF + id%KEEP(244) = id%ICNTL(28) + id%KEEP(245) = id%ICNTL(29) +#if ! defined(parmetis) + IF ((id%KEEP(244) .EQ. 2) .AND. (id%KEEP(245) .EQ. 2)) THEN + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) THEN + WRITE(LP,'("ParMETIS not available.")') + WRITE(LP,'("Aborting.")') + RETURN + END IF + END IF +#endif +#if ! defined(ptscotch) + IF ((id%KEEP(244) .EQ. 2) .AND. (id%KEEP(245) .EQ. 1)) THEN + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) THEN + WRITE(LP,'("PT-SCOTCH not available.")') + WRITE(LP,'("Aborting.")') + RETURN + END IF + END IF +#endif + IF((id%KEEP(244) .GT. 2) .OR. + & (id%KEEP(244) .LT. 0)) id%KEEP(244)=0 + IF(id%KEEP(244) .EQ. 0) THEN + id%KEEP(244) = 1 + ELSE IF (id%KEEP(244) .EQ. 2) THEN + IF(id%KEEP(55) .NE. 0) THEN + id%INFO(1) = -39 + WRITE(LP, + & '("Incompatible values for ICNTL(5), ICNTL(28)")') + WRITE(LP, + & '("Parallel analysis is not possible if the")') + WRITE(LP, + & '("matrix is not assembled")') + RETURN + ELSE IF(id%KEEP(60) .NE. 0) THEN + id%INFO(1) = -39 + WRITE(LP, + & '("Incompatible values for ICNTL(19), ICNTL(28)")') + WRITE(LP, + & '("Parallel analysis is not possible if SCHUR")') + WRITE(LP, + & '("complement must be returned")') + RETURN + END IF + IF(id%NSLAVES .LT. 2) THEN + id%KEEP(244) = 1 + IF(PROKG) WRITE(MPG, + & '("Too few processes. + & Reverting to sequential analysis")',advance='no') + IF(id%KEEP(245) .EQ. 1) THEN + IF(PROKG) WRITE(MPG, '(" with SCOTCH")') + id%KEEP(256) = 3 + ELSE IF(id%KEEP(245) .EQ. 2) THEN + IF(PROKG) WRITE(MPG, '(" with Metis")') + id%KEEP(256) = 5 + ELSE + IF(PROKG) WRITE(MPG, '(".")') + id%KEEP(256) = 0 + END IF + END IF + END IF + id%INFOG(32) = id%KEEP(244) + IF ( (id%KEEP(244) .EQ. 1) .AND. + & (id%KEEP(256) .EQ. 1) ) THEN + IF ( .NOT. associated( id%PERM_IN ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 3 + RETURN + ELSE IF ( size( id%PERM_IN ) < id%N ) THEN + id%INFO(1) = -22 + id%INFO(2) = 3 + RETURN + END IF + ENDIF + IF (id%KEEP(9) .LE. 1 ) id%KEEP(9) = 500 + IF ( id%KEEP8(21) .GT. 0_8 ) THEN + IF ((id%KEEP8(21).LE.1_8) .OR. + & (id%KEEP8(21).GT.int(id%KEEP(9),8))) + & id%KEEP8(21) = int(min(id%KEEP(9),100),8) + ENDIF + IF (id%KEEP(48). EQ. 1 ) id%KEEP(48) = -12345 + IF ( (id%KEEP(48).LT.0) .OR. (id%KEEP(48).GT.5) ) THEN + id%KEEP(48)=5 + ENDIF + IF ( (id%KEEP(60) .NE. 0) .AND. (id%KEEP(256) .EQ. 1) ) THEN + DO I = 1, id%SIZE_SCHUR + IF (id%PERM_IN(id%LISTVAR_SCHUR(I)) + & .EQ. id%N-id%SIZE_SCHUR+I) + & CYCLE + id%INFO(1) = -22 + id%INFO(2) = 8 + RETURN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Ignoring user-ordering, because incompatible with Schur.' + WRITE(MPG,'(A)') ' ** id%ICNTL(7) treated as 0.' + END IF + EXIT + ENDDO + END IF + id%KEEP(95) = id%ICNTL(12) + IF (id%KEEP(50).NE.2) id%KEEP(95) = 1 + IF ((id%KEEP(95).GT.3).OR.(id%KEEP(95).LT.0)) id%KEEP(95) = 0 + id%KEEP(23) = id%ICNTL(6) + IF (id%KEEP(23).LT.0.OR.id%KEEP(23).GT.7) id%KEEP(23) = 7 + IF ( id%KEEP(50) .EQ. 1 ) THEN + IF (id%KEEP(23) .NE. 0) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not compatible with LLT factorization' + END IF + id%KEEP(23) = 0 + ENDIF + IF (id%KEEP(95) .GT. 1) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) ignored: not compatible with LLT factorization' + END IF + ENDIF + id%KEEP(95) = 1 + END IF + IF (id%KEEP(60) .GT. 0) THEN + IF (id%KEEP(23) .NE. 0) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed because of Schur' + END IF + id%KEEP(23) = 0 + ENDIF + IF (id%KEEP(52).NE.0) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Scaling during analysis not allowed because of Schur' + ENDIF + id%KEEP(52) = 0 + ENDIF + IF (id%KEEP(95) .GT. 1) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) option not allowed because of Schur' + END IF + ENDIF + id%KEEP(95) = 1 + END IF + IF ( (id%KEEP(23) .NE. 0) .AND. (id%KEEP(256).EQ.1)) THEN + id%KEEP(23) = 0 + id%KEEP(95) = 1 + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed because ordering is given' + END IF + END IF + IF ( id%KEEP(256) .EQ. 1 ) THEN + IF (id%KEEP(95) > 1 .AND. MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) option incompatible with given ordering' + END IF + id%KEEP(95) = 1 + END IF + IF (id%KEEP(54) .NE. 0) THEN + IF( id%KEEP(23) .NE. 0 ) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed because matrix is distributed' + END IF + id%KEEP(23) = 0 + ENDIF + IF (id%KEEP(52).EQ.-2) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Scaling during analysis not allowed (matrix is distributed)' + ENDIF + ENDIF + id%KEEP(52) = 0 + IF (id%KEEP(95) .GT. 1 .AND. MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) option not allowed because matrix is + &distributed' + ENDIF + id%KEEP(95) = 1 + END IF + IF ( id%KEEP(55) .NE. 0 ) THEN + IF( id%KEEP(23) .NE. 0 ) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed for element matrix' + END IF + id%KEEP(23) = 0 + ENDIF + IF (MPG.GT.0 .AND. id%KEEP(52).EQ.-2) THEN + WRITE(MPG,'(A)') + & ' ** Scaling not allowed at analysis for element matrix' + ENDIF + id%KEEP(52) = 0 + id%KEEP(95) = 1 + ENDIF + IF(id%KEEP(244) .EQ. 2) THEN + IF(id%KEEP(23) .EQ. 7) THEN + id%KEEP(23) = 0 + ELSE IF (id%KEEP(23) .GT. 0) THEN + id%INFO(1) = -39 + id%KEEP(23) = 0 + WRITE(LP, + & '("Incompatible values for ICNTL(6), ICNTL(28)")') + WRITE(LP, + & '("Maximum transversal not allowed + & in parallel analysis")') + RETURN + END IF + END IF + IF ( id%KEEP(54) .NE. 0 .AND. id%KEEP(55) .NE. 0 ) THEN + id%KEEP(54) = 0 + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Distributed entry not available for element matrix' + END IF + ENDIF + IF (id%ICNTL(39).NE.1 .and. id%ICNTL(39).NE.2) THEN + id%KEEP(106)=1 + ELSE + id%KEEP(106)=id%ICNTL(39) + ENDIF + IF(id%KEEP(50) .EQ. 2) THEN + IF( .NOT. associated(id%A) ) THEN + IF(id%KEEP(95) .EQ. 3) THEN + id%KEEP(95) = 2 + ENDIF + ENDIF + IF(id%KEEP(95) .EQ. 3 .AND. id%KEEP(256) .NE. 2) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: SMUMPS_203 constrained ordering not ', + & 'available with selected ordering' + id%KEEP(95) = 2 + ENDIF + IF(id%KEEP(95) .EQ. 3) THEN + id%KEEP(23) = 5 + id%KEEP(52) = -2 + ELSE IF(id%KEEP(95) .EQ. 2 .AND. + & (id%KEEP(23) .EQ. 0 .OR. id%KEEP(23) .EQ. 7) ) THEN + IF( associated(id%A) ) THEN + id%KEEP(23) = 5 + ELSE + id%KEEP(23) = 1 + ENDIF + ELSE IF(id%KEEP(95) .EQ. 1) THEN + id%KEEP(23) = 0 + ELSE IF(id%KEEP(95) .EQ. 0 .AND. id%KEEP(23) .EQ. 0) THEN + id%KEEP(95) = 1 + ENDIF + ELSE + id%KEEP(95) = 1 + ENDIF + id%KEEP(53)=0 + IF(id%KEEP(86).EQ.1)THEN + IF(id%KEEP(47).LT.2) id%KEEP(47)=2 + ENDIF + IF(id%KEEP(48).EQ.5)THEN + IF(id%KEEP(50).EQ.0)THEN + id%KEEP(87)=50 + id%KEEP(88)=50 + ELSE + id%KEEP(87)=70 + id%KEEP(88)=70 + ENDIF + ENDIF + IF((id%NSLAVES.EQ.1).AND.(id%KEEP(76).GT.3))THEN + id%KEEP(76)=2 + ENDIF + IF(id%KEEP(81).GT.0)THEN + IF(id%KEEP(47).LT.2) id%KEEP(47)=2 + ENDIF + END IF + RETURN + END SUBROUTINE SMUMPS_647 + SUBROUTINE SMUMPS_664(id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + TYPE(SMUMPS_STRUC) :: id + INTEGER, ALLOCATABLE :: REQPTR(:,:) + INTEGER :: MASTER, IERR, INDX, NRECV + INTEGER :: STATUS( MPI_STATUS_SIZE ) + INTEGER :: LP, MP, MPG, I + LOGICAL :: PROK, PROKG + PARAMETER( MASTER = 0 ) + LP = id%ICNTL( 1 ) + MP = id%ICNTL( 2 ) + MPG = id%ICNTL( 3 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF ( id%KEEP(46) .EQ. 0 .AND. id%MYID .EQ. MASTER ) THEN + id%NZ_loc = 0 + END IF + IF ( id%MYID .eq. MASTER ) THEN + allocate( REQPTR( id%NPROCS, 3 ), STAT = IERR ) + IF ( IERR .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = 3 * id%NPROCS + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'REQPTR' + END IF + GOTO 13 + END IF + allocate( id%IRN( id%NZ ), STAT = IERR ) + IF ( IERR .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = id%NZ + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'IRN' + END IF + GOTO 13 + END IF + allocate( id%JCN( id%NZ ), STAT = IERR ) + IF ( IERR .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = id%NZ + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'JCN' + END IF + GOTO 13 + END IF + END IF + 13 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) < 0 ) RETURN + IF ( id%MYID .EQ. MASTER ) THEN + DO I = 1, id%NPROCS - 1 + CALL MPI_RECV( REQPTR( I+1, 1 ), 1, + & MPI_INTEGER, I, + & COLLECT_NZ, id%COMM, STATUS, IERR ) + END DO + IF ( id%KEEP(46) .eq. 0 ) THEN + REQPTR( 1, 1 ) = 1 + ELSE + REQPTR( 1, 1 ) = id%NZ_loc + 1 + END IF + DO I = 2, id%NPROCS + REQPTR( I, 1 ) = REQPTR( I, 1 ) + REQPTR( I-1, 1 ) + END DO + ELSE + CALL MPI_SEND( id%NZ_loc, 1, MPI_INTEGER, MASTER, + & COLLECT_NZ, id%COMM, IERR ) + END IF + IF ( id%MYID .eq. MASTER ) THEN + NRECV = 0 + DO I = 1, id%NPROCS - 1 + IF ( REQPTR( I + 1, 1 ) - REQPTR( I, 1 ) .NE. 0 ) THEN + NRECV = NRECV + 2 + CALL MPI_IRECV( id%IRN( REQPTR( I, 1 ) ), + & REQPTR( I + 1, 1 ) - REQPTR( I, 1 ), + & MPI_INTEGER, + & I, COLLECT_IRN, id%COMM, REQPTR(I, 2), IERR ) + CALL MPI_IRECV( id%JCN( REQPTR( I, 1 ) ), + & REQPTR( I + 1, 1 ) - REQPTR( I, 1 ), + & MPI_INTEGER, + & I, COLLECT_JCN, id%COMM, REQPTR(I, 3), IERR ) + ELSE + REQPTR(I, 2) = MPI_REQUEST_NULL + REQPTR(I, 3) = MPI_REQUEST_NULL + END IF + END DO + ELSE + IF ( id%NZ_loc .NE. 0 ) THEN + CALL MPI_SEND( id%IRN_loc(1), id%NZ_loc, + & MPI_INTEGER, MASTER, + & COLLECT_IRN, id%COMM, IERR ) + CALL MPI_SEND( id%JCN_loc(1), id%NZ_loc, + & MPI_INTEGER, MASTER, + & COLLECT_JCN, id%COMM, IERR ) + END IF + END IF + IF ( id%MYID .eq. MASTER ) THEN + IF ( id%NZ_loc .NE. 0 ) THEN + DO I=1,id%NZ_loc + id%IRN(I) = id%IRN_loc(I) + id%JCN(I) = id%JCN_loc(I) + ENDDO + END IF + REQPTR( id%NPROCS, 2 ) = MPI_REQUEST_NULL + REQPTR( id%NPROCS, 3 ) = MPI_REQUEST_NULL + DO I = 1, NRECV + CALL MPI_WAITANY + & ( 2 * id%NPROCS, REQPTR( 1, 2 ), INDX, STATUS, IERR ) + END DO + deallocate( REQPTR ) + END IF + RETURN + 150 FORMAT( + &/' ** FAILURE DURING SMUMPS_664, DYNAMIC ALLOCATION OF', + & A30) + END SUBROUTINE SMUMPS_664 + SUBROUTINE SMUMPS_658(id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(SMUMPS_STRUC) :: id + INTEGER :: MASTER, IERR + INTEGER :: IUNIT + LOGICAL :: IS_ELEMENTAL + LOGICAL :: IS_DISTRIBUTED + INTEGER :: MM_WRITE + INTEGER :: MM_WRITE_CHECK + CHARACTER(LEN=20) :: MM_IDSTR + LOGICAL :: I_AM_SLAVE, I_AM_MASTER + PARAMETER( MASTER = 0 ) + IUNIT = 69 + I_AM_SLAVE = ( id%MYID .NE. MASTER .OR. + & ( id%MYID .EQ. MASTER .AND. + & id%KEEP(46) .EQ. 1 ) ) + I_AM_MASTER = (id%MYID.EQ.MASTER) + IS_DISTRIBUTED = (id%KEEP(54) .EQ. 3) + IS_ELEMENTAL = (id%KEEP(55) .NE. 0) + IF (id%MYID.EQ.MASTER .AND. .NOT. IS_DISTRIBUTED) THEN + IF (id%WRITE_PROBLEM(1:20) .NE. "NAME_NOT_INITIALIZED")THEN + OPEN(IUNIT,FILE=trim(id%WRITE_PROBLEM)) + CALL SMUMPS_166( id, IUNIT, I_AM_SLAVE, I_AM_MASTER, + & IS_DISTRIBUTED, + & IS_ELEMENTAL ) + CLOSE(IUNIT) + ENDIF + ELSE IF (id%KEEP(54).EQ.3) THEN + IF (id%WRITE_PROBLEM(1:20) .EQ. "NAME_NOT_INITIALIZED" + & .OR. .NOT. I_AM_SLAVE )THEN + MM_WRITE = 0 + ELSE + MM_WRITE = 1 + ENDIF + CALL MPI_ALLREDUCE(MM_WRITE, MM_WRITE_CHECK, 1, + & MPI_INTEGER, MPI_SUM, id%COMM, IERR) + IF (MM_WRITE_CHECK.EQ.id%NSLAVES .AND. I_AM_SLAVE) THEN + WRITE(MM_IDSTR,'(I7)') id%MYID_NODES + OPEN(IUNIT, + & FILE=trim(id%WRITE_PROBLEM)//trim(adjustl(MM_IDSTR))) + CALL SMUMPS_166(id, IUNIT, I_AM_SLAVE, I_AM_MASTER, + & IS_DISTRIBUTED, + & IS_ELEMENTAL ) + CLOSE(IUNIT) + ENDIF + ENDIF + IF ( id%MYID.EQ.MASTER .AND. + & associated(id%RHS) .AND. + & id%WRITE_PROBLEM(1:20) + & .NE. "NAME_NOT_INITIALIZED")THEN + OPEN(IUNIT,FILE=trim(id%WRITE_PROBLEM) //".rhs") + CALL SMUMPS_179(IUNIT, id) + CLOSE(IUNIT) + ENDIF + RETURN + END SUBROUTINE SMUMPS_658 + SUBROUTINE SMUMPS_166 + & (id, IUNIT, I_AM_SLAVE, I_AM_MASTER, + & IS_DISTRIBUTED, IS_ELEMENTAL ) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + LOGICAL, intent(in) :: I_AM_SLAVE, + & I_AM_MASTER, + & IS_DISTRIBUTED, + & IS_ELEMENTAL + INTEGER, intent(in) :: IUNIT + TYPE(SMUMPS_STRUC), intent(in) :: id + CHARACTER (LEN=10) :: SYMM + CHARACTER (LEN=8) :: ARITH + INTEGER :: I + IF (IS_ELEMENTAL) THEN + RETURN + ENDIF + IF (I_AM_MASTER .AND. .NOT. IS_DISTRIBUTED) THEN + IF (associated(id%A)) THEN + ARITH='real' + ELSE + ARITH='pattern ' + ENDIF + IF (id%KEEP(50) .eq. 0) THEN + SYMM="general" + ELSE + SYMM="symmetric" + END IF + WRITE(IUNIT,FMT=*)'%%MatrixMarket matrix coordinate ', + & trim(ARITH)," ",trim(SYMM) + WRITE(IUNIT,*) id%N, id%N, id%NZ + IF (associated(id%A)) THEN + DO I=1,id%NZ + IF (id%KEEP(50).NE.0 .AND. id%IRN(I).LT.id%JCN(I)) THEN + WRITE(IUNIT,*) id%JCN(I), id%IRN(I), id%A(I) + ELSE + WRITE(IUNIT,*) id%IRN(I), id%JCN(I), id%A(I) + ENDIF + ENDDO + ELSE + DO I=1,id%NZ + IF (id%KEEP(50).NE.0 .AND. id%IRN(I).LT.id%JCN(I)) THEN + WRITE(IUNIT,*) id%JCN(I), id%IRN(I) + ELSE + WRITE(IUNIT,*) id%IRN(I), id%JCN(I) + ENDIF + ENDDO + ENDIF + ELSE IF ( IS_DISTRIBUTED .AND. I_AM_SLAVE ) THEN + IF (associated(id%A_loc)) THEN + ARITH='real' + ELSE + ARITH='pattern ' + ENDIF + IF (id%KEEP(50) .eq. 0) THEN + SYMM="general" + ELSE + SYMM="symmetric" + END IF + WRITE(IUNIT,FMT=*)'%%MatrixMarket matrix coordinate ', + & trim(ARITH)," ",trim(SYMM) + WRITE(IUNIT,*) id%N, id%N, id%NZ_loc + IF (associated(id%A_loc)) THEN + DO I=1,id%NZ_loc + IF (id%KEEP(50).NE.0 .AND. + & id%IRN_loc(I).LT.id%JCN_loc(I)) THEN + WRITE(IUNIT,*) id%JCN_loc(I), id%IRN_loc(I), + & id%A_loc(I) + ELSE + WRITE(IUNIT,*) id%IRN_loc(I), id%JCN_loc(I), + & id%A_loc(I) + ENDIF + ENDDO + ELSE + DO I=1,id%NZ_loc + IF (id%KEEP(50).NE.0 .AND. + & id%IRN_loc(I).LT.id%JCN_loc(I)) THEN + WRITE(IUNIT,*) id%JCN_loc(I), id%IRN_loc(I) + ELSE + WRITE(IUNIT,*) id%IRN_loc(I), id%JCN_loc(I) + ENDIF + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_166 + SUBROUTINE SMUMPS_179(IUNIT, id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(SMUMPS_STRUC), intent(in) :: id + INTEGER, intent(in) :: IUNIT + CHARACTER (LEN=8) :: ARITH + INTEGER :: I, J, K, LD_RHS + IF (associated(id%RHS)) THEN + ARITH='real' + WRITE(IUNIT,FMT=*)'%%MatrixMarket matrix array ', + & trim(ARITH), + & ' general' + WRITE(IUNIT,*) id%N, id%NRHS + IF ( id%NRHS .EQ. 1 ) THEN + LD_RHS = id%N + ELSE + LD_RHS = id%LRHS + ENDIF + DO J = 1, id%NRHS + DO I = 1, id%N + K=(J-1)*LD_RHS+I + WRITE(IUNIT,*) id%RHS(K) + ENDDO + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_179 + SUBROUTINE SMUMPS_649( NSLAVES, NB_NIV2, MYID_NODES, + & CANDIDATES, I_AM_CAND ) + IMPLICIT NONE + INTEGER, intent(in) :: NSLAVES, NB_NIV2, MYID_NODES + INTEGER, intent(in) :: CANDIDATES( NSLAVES+1, NB_NIV2 ) + LOGICAL, intent(out):: I_AM_CAND( NB_NIV2 ) + INTEGER I, INIV2, NCAND + DO INIV2=1, NB_NIV2 + I_AM_CAND(INIV2)=.FALSE. + NCAND = CANDIDATES(NSLAVES+1,INIV2) + DO I=1, NCAND + IF (CANDIDATES(I,INIV2).EQ.MYID_NODES) THEN + I_AM_CAND(INIV2)=.TRUE. + EXIT + ENDIF + ENDDO + END DO + RETURN + END SUBROUTINE SMUMPS_649 + SUBROUTINE SMUMPS_251(N,IW,LIW,A,LA, + & NSTK_STEPS, NBPROCFILS,IFLAG,ND,FILS,STEP, + & FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRT, NTOTPV, NMAXNPIV, PTRIST, PTRAST, + & PIMASTER, PAMASTER, PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, IERROR,IPOOL, LPOOL, + & RINFO, POSFAC ,IWPOS, LRLU, IPTRLU, + & LRLUS, LEAF, NBROOT, NBRTOT, + & UU, ICNTL, PTLUST_S, PTRFAC, NSTEPS, INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS,SLAVEF,MYID, COMM_NODES, + & MYID_NODES, + & BUFR,LBUFR,LBUFR_BYTES,INTARR,DBLARR,root, + & PERM, NELT, FRTPTR, FRTELT, LPTRAR, + & COMM_LOAD, ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, + & MEM_DISTRIB, NE, + & DKEEP,PIVNUL_LIST,LPN_LIST) + USE SMUMPS_LOAD + USE SMUMPS_OOC + IMPLICIT NONE + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER N,IFLAG,NTOTPV,MAXFRT,LIW, LPTRAR, NMAXNPIV, + & IERROR, NSTEPS, INFO(40) + INTEGER(8) :: LA + REAL, TARGET :: A(LA) + INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES + INTEGER, DIMENSION(0: SLAVEF - 1) :: MEM_DISTRIB + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER LPOOL + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER ITLOC(N+KEEP(253)) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER IW(LIW), NSTK_STEPS(KEEP(28)), NBPROCFILS(KEEP(28)) + INTEGER PTRARW(LPTRAR), PTRAIW(LPTRAR), ND(KEEP(28)) + INTEGER FILS(N),PTRIST(KEEP(28)) + INTEGER STEP(N), FRERE(KEEP(28)), DAD(KEEP(28)) + INTEGER PIMASTER(KEEP(28)) + INTEGER PTLUST_S(KEEP(28)), PERM(N) + INTEGER CAND(SLAVEF+1,max(1,KEEP(56))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER IPOOL(LPOOL) + INTEGER NE(KEEP(28)) + REAL RINFO(40) + INTEGER(8) :: PAMASTER(KEEP(28)), PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: POSFAC, LRLU, LRLUS, IPTRLU + INTEGER IWPOS, LEAF, NBROOT + INTEGER COMM_LOAD, ASS_IRECV + REAL UU, SEUIL, SEUIL_LDLT_NIV2 + INTEGER NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER INTARR( max(1,KEEP(14)) ) + REAL DBLARR( max(1,KEEP(13)) ) + LOGICAL IS_ISOLATED_NODE + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + DOUBLE PRECISION, PARAMETER :: DZERO = 0.0D0, DONE = 1.0D0 + INTEGER INODE + INTEGER IWPOSCB + INTEGER FPERE, TYPEF + INTEGER MP, LP, DUMMY(1) + INTEGER NBFIN, NBRTOT, NBROOT_TRAITEES + INTEGER NFRONT, IOLDPS + INTEGER(8) NFRONT8 + INTEGER(8) :: POSELT + INTEGER IPOSROOT, IPOSROOTROWINDICES + INTEGER GLOBK109 + INTEGER(8) :: LBUFRX + REAL, POINTER, DIMENSION(:) :: BUFRX + LOGICAL :: IS_BUFRX_ALLOCATED + DOUBLE PRECISION FLOP1 + INTEGER TYPE + LOGICAL SON_LEVEL2, SET_IRECV, BLOCKING, + & MESSAGE_RECEIVED + LOGICAL AVOID_DELAYED + LOGICAL LAST_CALL + INTEGER MASTER_ROOT + INTEGER LOCAL_M, LOCAL_N + INTEGER LRHS_CNTR_MASTER_ROOT, FWD_LOCAL_N_RHS + LOGICAL ROOT_OWNER + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER MUMPS_330, MUMPS_275 + LOGICAL MUMPS_167,MUMPS_283 + EXTERNAL MUMPS_167,MUMPS_283 + LOGICAL SMUMPS_508 + EXTERNAL SMUMPS_508, SMUMPS_509 + LOGICAL STACK_RIGHT_AUTHORIZED + INTEGER numroc + EXTERNAL numroc + INTEGER MAXFRW, NPVW, NOFFW, NELVAW, COMP, + & JOBASS, ETATASS + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten, + & IDUMMY + INTEGER(8) :: ITMP8 + TYPE(IO_BLOCK) :: MonBloc + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION OPASSW, OPELIW + ASS_IRECV = MPI_REQUEST_NULL + ITLOC(1:N+KEEP(253)) =0 + PTRIST (1:KEEP(28))=0 + PTLUST_S(1:KEEP(28))=0 + PTRAST(1:KEEP(28))=0_8 + PTRFAC(1:KEEP(28))=-99999_8 + MP = ICNTL(2) + LP = ICNTL(1) + MAXFRW = 0 + NPVW = 0 + NOFFW = 0 + NELVAW = 0 + COMP = 0 + OPASSW = DZERO + OPELIW = DZERO + IWPOSCB = LIW + STACK_RIGHT_AUTHORIZED = .TRUE. + CALL SMUMPS_22( .FALSE., 0_8, + & .FALSE., .FALSE., MYID_NODES, N, KEEP, KEEP8, + & IW, LIW, A, LA, LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTRAST, STEP, PIMASTER, + & PAMASTER, KEEP(IXSZ), 0_8, -444, -444, .true., + & COMP, LRLUS, + & IFLAG, IERROR + & ) + JOBASS = 0 + ETATASS = 0 + NBFIN = NBRTOT + NBROOT_TRAITEES = 0 + NBPROCFILS(1:KEEP(28)) = 0 + IF ( KEEP(38).NE.0 ) THEN + IF (root%yes) THEN + CALL SMUMPS_284( + & root, KEEP(38), N, IW, LIW, + & A, LA, + & FILS, MYID_NODES, PTRAIW, PTRARW, + & INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + ENDIF + IF ( IFLAG .LT. 0 ) GOTO 635 + END IF + 20 CONTINUE + NIV1_FLAG=0 + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( + & COMM_LOAD, ASS_IRECV, BLOCKING, SET_IRECV, + & MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_STEPS, + & COMP, IFLAG, + & IERROR, COMM_NODES, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID_NODES, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & STACK_RIGHT_AUTHORIZED ) + CALL SMUMPS_467(COMM_LOAD, KEEP) + IF (MESSAGE_RECEIVED) THEN + IF ( IFLAG .LT. 0 ) GO TO 640 + IF ( NBFIN .eq. 0 ) GOTO 640 + ELSE + IF ( .NOT. SMUMPS_508( IPOOL, LPOOL) )THEN + CALL SMUMPS_509( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, STEP, INODE, KEEP,KEEP8, MYID_NODES, ND, + & (.NOT. STACK_RIGHT_AUTHORIZED) ) + STACK_RIGHT_AUTHORIZED = .TRUE. + IF (KEEP(47) .GE. 3) THEN + CALL SMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID_NODES, STEP, N, ND, FILS ) + ENDIF + IF (KEEP(47).EQ.4) THEN + IF(INODE.GT.0.AND.INODE.LE.N)THEN + IF((NE(STEP(INODE)).EQ.0).AND. + & (FRERE(STEP(INODE)).EQ.0))THEN + IS_ISOLATED_NODE=.TRUE. + ELSE + IS_ISOLATED_NODE=.FALSE. + ENDIF + ENDIF + CALL SMUMPS_501( + & IS_ISOLATED_NODE,INODE,IPOOL,LPOOL, + & MYID_NODES,SLAVEF,COMM_LOAD,KEEP,KEEP8) + ENDIF + IF ((( KEEP(80) == 2 .OR. KEEP(80)==3 ) .AND. + & ( KEEP(47) == 4 )).OR. + & (KEEP(80) == 1 .AND. KEEP(47) .GE. 1)) THEN + CALL SMUMPS_512(INODE,STEP,KEEP(28), + & PROCNODE_STEPS,FRERE,ND,COMM_LOAD,SLAVEF, + & MYID_NODES,KEEP,KEEP8,N) + END IF + GOTO 30 + ENDIF + ENDIF + GO TO 20 + 30 CONTINUE + IF ( INODE .LT. 0 ) THEN + INODE = -INODE + FPERE = DAD(STEP(INODE)) + GOTO 130 + ELSE IF (INODE.GT.N) THEN + INODE = INODE - N + IF (INODE.EQ.KEEP(38)) THEN + NBROOT_TRAITEES = NBROOT_TRAITEES + 1 + IF ( NBROOT_TRAITEES .EQ. NBROOT ) THEN + NBFIN = NBFIN - NBROOT + IF (SLAVEF.GT.1) THEN + DUMMY(1) = NBROOT + CALL SMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID_NODES, + & COMM_NODES, RACINE, SLAVEF) + END IF + ENDIF + IF (NBFIN.EQ.0) GOTO 640 + GOTO 20 + ENDIF + TYPE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (TYPE.EQ.1) GOTO 100 + FPERE = DAD(STEP(INODE)) + AVOID_DELAYED = ( (FPERE .eq. KEEP(20) .OR. FPERE .eq. KEEP(38)) + & .AND. KEEP(60).ne.0 ) + IF ( KEEP(50) .eq. 0 ) THEN + CALL SMUMPS_144( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM_NODES, MYID_NODES, BUFR, LBUFR,LBUFR_BYTES, + & NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_STEPS,NBPROCFILS,PROCNODE_STEPS, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST) + IF ( IFLAG .LT. 0 ) GOTO 640 + ELSE + CALL SMUMPS_141( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM_NODES, MYID_NODES, BUFR, LBUFR,LBUFR_BYTES, + & NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_STEPS,NBPROCFILS,PROCNODE_STEPS, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL_LDLT_NIV2, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST) + IF ( IFLAG .LT. 0 ) GOTO 640 + IF ( IW( PTLUST_S(STEP(INODE)) + KEEP(IXSZ) + 5 ) .GT. 1 ) THEN + GOTO 20 + END IF + END IF + GOTO 130 + ENDIF + IF (INODE.EQ.KEEP(38)) THEN + CALL SMUMPS_176( COMM_LOAD, ASS_IRECV, + & root, FRERE, + & INODE, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_STEPS, COMP, + & IFLAG, IERROR, COMM_NODES, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID_NODES, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 640 + GOTO 20 + ENDIF + TYPE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (TYPE.EQ.1) THEN + IF (KEEP(55).NE.0) THEN + CALL SMUMPS_36( COMM_LOAD, ASS_IRECV, + & NELT, FRTPTR, FRTELT, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP, PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSE + JOBASS = 0 + CALL SMUMPS_252(COMM_LOAD, ASS_IRECV, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP, PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & JOBASS,ETATASS ) + ENDIF + IF ( IFLAG .LT. 0 ) GOTO 640 + IF ((NBPROCFILS(STEP(INODE)).GT.0).OR.(SON_LEVEL2)) GOTO 20 + ELSE + IF ( KEEP(55) .eq. 0 ) THEN + CALL SMUMPS_253(COMM_LOAD, ASS_IRECV, + & N, INODE, IW, LIW, A, LA, + & IFLAG, IERROR, + & ND, FILS, FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, + & root, OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_STEPS, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM_NODES, + & MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & NBFIN, LEAF, IPOOL, LPOOL, PERM, + & MEM_DISTRIB(0) + & ) + ELSE + CALL SMUMPS_37( COMM_LOAD, ASS_IRECV, + & NELT, FRTPTR, FRTELT, + & N, INODE, IW, LIW, A, LA, IFLAG, IERROR, + & ND, FILS, FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, + & root, OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_STEPS, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM_NODES, + & MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & NBFIN, LEAF, IPOOL, LPOOL, PERM, + & MEM_DISTRIB(0)) + END IF + IF (IFLAG.LT.0) GOTO 640 + GOTO 20 + ENDIF + 100 CONTINUE + FPERE = DAD(STEP(INODE)) + IF ( INODE .eq. KEEP(20) ) THEN + POSELT = PTRAST(STEP(INODE)) + IF (PTRFAC(STEP(INODE)).NE.POSELT) THEN + WRITE(*,*) "ERROR 2 in SMUMPS_251", POSELT + CALL MUMPS_ABORT() + ENDIF + CALL SMUMPS_87 + & ( IW(PTLUST_S(STEP(INODE))+KEEP(IXSZ)), KEEP(253) ) + GOTO 200 + END IF + POSELT = PTRAST(STEP(INODE)) + IOLDPS = PTLUST_S(STEP(INODE)) + AVOID_DELAYED = ( (FPERE .eq. KEEP(20) .OR. FPERE .eq. KEEP(38)) + & .AND. KEEP(60).ne.0 ) + IF (KEEP(50).EQ.0) THEN + CALL SMUMPS_143( N, INODE, IW, LIW, A, LA, + & IOLDPS, POSELT, + & IFLAG, UU, NOFFW, NPVW, + & KEEP,KEEP8, + & STEP, PROCNODE_STEPS, MYID_NODES, SLAVEF, + & SEUIL, AVOID_DELAYED, ETATASS, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, IWPOS) + JOBASS = ETATASS + IF (JOBASS.EQ.1) THEN + CALL SMUMPS_252(COMM_LOAD, ASS_IRECV, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP,PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & JOBASS,ETATASS ) + ENDIF + ELSE + IW( IOLDPS+4+KEEP(IXSZ) ) = 1 + CALL SMUMPS_140( N, INODE, + & IW, LIW, A, LA, + & IOLDPS, POSELT, + & IFLAG, UU, NOFFW, NPVW, + & KEEP,KEEP8, MYID_NODES, SEUIL, AVOID_DELAYED, + & ETATASS, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, IWPOS) + IW( IOLDPS+4+KEEP(IXSZ) ) = STEP(INODE) + JOBASS = ETATASS + IF (JOBASS.EQ.1) THEN + CALL SMUMPS_252(COMM_LOAD, ASS_IRECV, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP,PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & JOBASS,ETATASS ) + ENDIF + ENDIF + IF (IFLAG.LT.0) GOTO 635 + 130 CONTINUE + TYPE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF ( FPERE .NE. 0 ) THEN + TYPEF = MUMPS_330(PROCNODE_STEPS(STEP(FPERE)),SLAVEF) + ELSE + TYPEF = -9999 + END IF + CALL SMUMPS_254( COMM_LOAD, ASS_IRECV, + & N,INODE,TYPE,TYPEF,LA,IW,LIW,A, + & IFLAG,IERROR,OPELIW,NELVAW,NMAXNPIV, + & PTRIST,PTLUST_S,PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NE, POSFAC,LRLU, + & LRLUS,IPTRLU,ICNTL,KEEP,KEEP8,COMP,IWPOS,IWPOSCB, + & PROCNODE_STEPS,SLAVEF,FPERE,COMM_NODES,MYID_NODES, + & IPOOL, LPOOL, LEAF, + & NSTK_STEPS, NBPROCFILS, BUFR, LBUFR, LBUFR_BYTES, NBFIN, + & root, OPASSW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0) GOTO 640 + 200 CONTINUE + IF ( INODE .eq. KEEP(38) ) THEN + WRITE(*,*) 'Error .. in SMUMPS_251: ', + & ' INODE == KEEP(38)' + Stop + END IF + IF ( FPERE.EQ.0 ) THEN + NBROOT_TRAITEES = NBROOT_TRAITEES + 1 + IF ( NBROOT_TRAITEES .EQ. NBROOT ) THEN + IF (KEEP(201).EQ.1) THEN + CALL SMUMPS_681(IERR) + ELSE IF ( KEEP(201).EQ.2) THEN + CALL SMUMPS_580(IERR) + ENDIF + NBFIN = NBFIN - NBROOT + IF ( NBFIN .LT. 0 ) THEN + WRITE(*,*) ' ERROR 1 in SMUMPS_251: ', + & ' NBFIN=', NBFIN + CALL MUMPS_ABORT() + END IF + IF ( NBROOT .LT. 0 ) THEN + WRITE(*,*) ' ERROR 1 in SMUMPS_251: ', + & ' NBROOT=', NBROOT + CALL MUMPS_ABORT() + END IF + IF (SLAVEF.GT.1) THEN + DUMMY(1) = NBROOT + CALL SMUMPS_242( DUMMY(1), 1, MPI_INTEGER, + & MYID_NODES, COMM_NODES, RACINE, SLAVEF) + END IF + ENDIF + IF (NBFIN.EQ.0)THEN + GOTO 640 + ENDIF + ELSEIF ( FPERE.NE.KEEP(38) .AND. + & MUMPS_275(PROCNODE_STEPS(STEP(FPERE)),SLAVEF).EQ. + & MYID_NODES ) THEN + NSTK_STEPS(STEP(FPERE)) = NSTK_STEPS(STEP(FPERE))-1 + IF ( NSTK_STEPS( STEP( FPERE )).EQ.0) THEN + IF (KEEP(234).NE.0 .AND. + & MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF)) + & THEN + STACK_RIGHT_AUTHORIZED = .FALSE. + ENDIF + CALL SMUMPS_507(N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), STEP, FPERE ) + IF (KEEP(47) .GE. 3) THEN + CALL SMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID_NODES, STEP, N, ND, FILS ) + ENDIF + CALL MUMPS_137( FPERE, N, PROCNODE_STEPS,SLAVEF, + & ND, FILS, FRERE, STEP, PIMASTER, KEEP(28), + & KEEP(50), KEEP(253), FLOP1, + & IW, LIW, KEEP(IXSZ) ) + IF (FPERE.NE.KEEP(20)) + & CALL SMUMPS_190(1,.FALSE.,FLOP1,KEEP,KEEP8) + ENDIF + ENDIF + GO TO 20 + 635 CONTINUE + CALL SMUMPS_44( MYID_NODES, SLAVEF, COMM_NODES ) + 640 CONTINUE + CALL SMUMPS_255( INFO(1), + & ASS_IRECV, BUFR, LBUFR, + & LBUFR_BYTES, + & COMM_NODES, + & MYID_NODES, SLAVEF) + CALL SMUMPS_180( INFO(1), + & BUFR, LBUFR, + & LBUFR_BYTES, + & COMM_NODES, COMM_LOAD, SLAVEF, MP) + CALL MPI_BARRIER( COMM_NODES, IERR ) + IF ( INFO(1) .GE. 0 ) THEN + IF( KEEP(38) .NE. 0 .OR. KEEP(20).NE.0) THEN + MASTER_ROOT = MUMPS_275( + & PROCNODE_STEPS(STEP(max(KEEP(38),KEEP(20)))), + & SLAVEF) + ROOT_OWNER = (MASTER_ROOT .EQ. MYID_NODES) + IF ( KEEP(38) .NE. 0 )THEN + IF (KEEP(60).EQ.0) THEN + IOLDPS = PTLUST_S(STEP(KEEP(38))) + LOCAL_M = IW(IOLDPS+2+KEEP(IXSZ)) + LOCAL_N = IW(IOLDPS+1+KEEP(IXSZ)) + ELSE + IOLDPS = -999 + LOCAL_M = root%SCHUR_MLOC + LOCAL_N = root%SCHUR_NLOC + ENDIF + ITMP8 = int(LOCAL_M,8)*int(LOCAL_N,8) + LBUFRX = min(int(root%MBLOCK,8)*int(root%NBLOCK,8), + & int(root%TOT_ROOT_SIZE,8)*int(root%TOT_ROOT_SIZE,8) ) + IF ( LRLU .GT. LBUFRX ) THEN + BUFRX => A(POSFAC:POSFAC+LRLU-1_8) + LBUFRX=LRLU + IS_BUFRX_ALLOCATED = .FALSE. + ELSE + ALLOCATE( BUFRX( LBUFRX ), stat = IERR ) + IF (IERR.gt.0) THEN + INFO(1) = -9 + CALL MUMPS_731(LBUFRX, INFO(2) ) + IF (LP > 0 ) + & write(LP,*) ' Error allocating, real array ', + & 'of size before SMUMPS_146', LBUFRX + CALL MUMPS_ABORT() + ENDIF + IS_BUFRX_ALLOCATED = .FALSE. + ENDIF + CALL SMUMPS_146( MYID_NODES, + & root, N, KEEP(38), + & COMM_NODES, IW, LIW, IWPOS + 1, + & A, LA, PTRAST, PTLUST_S, PTRFAC, STEP, + & INFO(1), KEEP(50), KEEP(19), + & BUFRX(1), LBUFRX, KEEP,KEEP8, DKEEP ) + IF (IS_BUFRX_ALLOCATED) DEALLOCATE ( BUFRX ) + NULLIFY(BUFRX) + IF ( MYID_NODES .eq. + & MUMPS_275(PROCNODE_STEPS(STEP(KEEP(38))), + & SLAVEF) + & ) THEN + IF ( INFO(1) .EQ. -10 .OR. INFO(1) .EQ. -40 ) THEN + NPVW = NPVW + INFO(2) + ELSE + NPVW = NPVW + root%TOT_ROOT_SIZE + NMAXNPIV = max(NMAXNPIV,root%TOT_ROOT_SIZE) + END IF + END IF + IF (root%yes.AND.KEEP(60).EQ.0) THEN + IF (KEEP(252).EQ.0) THEN + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_L + NextPiv2beWritten = 1 + MonBloc%INODE = KEEP(38) + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 3 + MonBloc%NROW = LOCAL_M + MonBloc%NCOL = LOCAL_N + MonBloc%NFS = MonBloc%NCOL + MonBloc%Last = .TRUE. + MonBloc%LastPiv = MonBloc%NCOL + NULLIFY(MonBloc%INDICES) + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + LAST_CALL = .TRUE. + CALL SMUMPS_688 + & ( STRAT, TYPEFile, + & A(PTRFAC(STEP(KEEP(38)))), + & LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IERR,LAST_CALL) + ELSE IF (KEEP(201).EQ.2) THEN + KEEP8(31)=KEEP8(31)+ ITMP8 + CALL SMUMPS_576(KEEP(38),PTRFAC, + & KEEP,KEEP8,A,LA, ITMP8, IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error in SMUMPS_576' + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + IF (KEEP(201).NE.0 .OR. KEEP(252).NE.0) THEN + LRLUS = LRLUS + ITMP8 + IF (KEEP(252).NE.0) THEN + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS + & ,0_8,-ITMP8, + & KEEP,KEEP8,LRLU) + ELSE + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS + & ,ITMP8, + & 0_8, + & KEEP,KEEP8,LRLU) + ENDIF + IF (PTRFAC(STEP(KEEP(38))).EQ.POSFAC-ITMP8) THEN + POSFAC = POSFAC - ITMP8 + LRLU = LRLU + ITMP8 + ENDIF + ELSE + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS + & ,ITMP8, + & 0_8, + & KEEP,KEEP8,LRLU) + ENDIF + ENDIF + IF (root%yes. AND. KEEP(252) .NE. 0 .AND. + & (KEEP(60).EQ.0 .OR. KEEP(221).EQ.1)) THEN + IF (MYID_NODES .EQ. MASTER_ROOT) THEN + LRHS_CNTR_MASTER_ROOT = root%TOT_ROOT_SIZE*KEEP(253) + ELSE + LRHS_CNTR_MASTER_ROOT = 1 + ENDIF + ALLOCATE(root%RHS_CNTR_MASTER_ROOT( + & LRHS_CNTR_MASTER_ROOT), stat=IERR ) + IF (IERR.gt.0) THEN + INFO(1) = -13 + CALL MUMPS_731(LRHS_CNTR_MASTER_ROOT,INFO(2)) + IF (LP > 0 ) + & write(LP,*) ' Error allocating, real array ', + & 'of size before SMUMPS_146', + & LRHS_CNTR_MASTER_ROOT + CALL MUMPS_ABORT() + ENDIF + FWD_LOCAL_N_RHS = numroc(KEEP(253), root%NBLOCK, + & root%MYCOL, 0, root%NPCOL) + FWD_LOCAL_N_RHS = max(1,FWD_LOCAL_N_RHS) + CALL SMUMPS_156( MYID_NODES, + & root%TOT_ROOT_SIZE, KEEP(253), + & root%RHS_CNTR_MASTER_ROOT(1), LOCAL_M, + & FWD_LOCAL_N_RHS, root%MBLOCK, root%NBLOCK, + & root%RHS_ROOT(1,1), MASTER_ROOT, + & root%NPROW, root%NPCOL, COMM_NODES ) + & + ENDIF + ELSE + IF (KEEP(19).NE.0) THEN + CALL MPI_REDUCE(KEEP(109), GLOBK109, 1, + & MPI_INTEGER, MPI_SUM, + & MASTER_ROOT, + & COMM_NODES, IERR) + ENDIF + IF (ROOT_OWNER) THEN + IPOSROOT = PTLUST_S(STEP(KEEP(20))) + NFRONT = IW(IPOSROOT+KEEP(IXSZ)+3) + NFRONT8 = int(NFRONT,8) + IPOSROOTROWINDICES=IPOSROOT+6+KEEP(IXSZ)+ + & IW(IPOSROOT+5+KEEP(IXSZ)) + NPVW = NPVW + NFRONT + NMAXNPIV = max(NMAXNPIV,NFRONT) + END IF + IF (ROOT_OWNER.AND.KEEP(60).NE.0) THEN + IF ( PTRFAC(STEP(KEEP(20))) .EQ. POSFAC - + & NFRONT8*NFRONT8 ) THEN + POSFAC = POSFAC - NFRONT8*NFRONT8 + LRLUS = LRLUS + NFRONT8*NFRONT8 + LRLU = LRLUS + NFRONT8*NFRONT8 + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-NFRONT8*NFRONT8,KEEP,KEEP8,LRLU) + ENDIF + ENDIF + END IF + END IF + END IF + IF ( KEEP(38) .NE. 0 ) THEN + IF (MYID_NODES.EQ. + & MUMPS_275(PROCNODE_STEPS(STEP(KEEP(38))),SLAVEF) + & ) THEN + MAXFRW = max ( MAXFRW, root%TOT_ROOT_SIZE) + END IF + END IF + MAXFRT = MAXFRW + NTOTPV = NPVW + INFO(12) = NOFFW + RINFO(2) = real(OPASSW) + RINFO(3) = real(OPELIW) + INFO(13) = NELVAW + INFO(14) = COMP + RETURN + END SUBROUTINE SMUMPS_251 + SUBROUTINE SMUMPS_87( HEADER, KEEP253 ) + INTEGER HEADER( 6 ), KEEP253 + INTEGER NFRONT, NASS + NFRONT = HEADER(1) + IF ( HEADER(2) .ne. 0 ) THEN + WRITE(*,*) ' *** CHG_HEADER ERROR 1 :',HEADER(2) + CALL MUMPS_ABORT() + END IF + NASS = abs( HEADER( 3 ) ) + IF ( NASS .NE. abs( HEADER( 4 ) ) ) THEN + WRITE(*,*) ' *** CHG_HEADER ERROR 2 :',HEADER(3:4) + CALL MUMPS_ABORT() + END IF + IF ( NASS+KEEP253 .NE. NFRONT ) THEN + WRITE(*,*) ' *** CHG_HEADER ERROR 3 : not root' + CALL MUMPS_ABORT() + END IF + HEADER( 1 ) = KEEP253 + HEADER( 2 ) = 0 + HEADER( 3 ) = NFRONT + HEADER( 4 ) = NFRONT-KEEP253 + RETURN + END SUBROUTINE SMUMPS_87 + SUBROUTINE SMUMPS_136( id ) + USE SMUMPS_OOC + USE SMUMPS_STRUC_DEF + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + include 'mpif.h' + TYPE( SMUMPS_STRUC ) :: id + LOGICAL I_AM_SLAVE + INTEGER IERR, MASTER + PARAMETER ( MASTER = 0 ) + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. id%KEEP(46) .NE. 0 ) + IF (id%KEEP(201).GT.0 .AND. I_AM_SLAVE) THEN + CALL SMUMPS_587(id,IERR) + IF (IERR < 0) THEN + id%INFO(1) = -90 + id%INFO(2) = 0 + ENDIF + END IF + CALL MUMPS_276(id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID) + IF (id%root%gridinit_done) THEN + IF ( id%KEEP(38).NE.0 .and. id%root%yes ) THEN + CALL blacs_gridexit( id%root%CNTXT_BLACS ) + id%root%gridinit_done = .FALSE. + END IF + END IF + IF ( id%MYID .NE. MASTER .OR. id%KEEP(46) .ne. 0 ) THEN + CALL MPI_COMM_FREE( id%COMM_NODES, IERR ) + CALL MPI_COMM_FREE( id%COMM_LOAD, IERR ) + END IF + IF (associated(id%MEM_DIST)) THEN + DEALLOCATE(id%MEM_DIST) + NULLIFY(id%MEM_DIST) + ENDIF + IF (associated(id%MAPPING)) THEN + DEALLOCATE(id%MAPPING) + NULLIFY(id%MAPPING) + END IF + NULLIFY(id%SCHUR_CINTERFACE) + IF ( id%KEEP(52) .NE. -1 .or. id%MYID .ne. MASTER ) THEN + IF (associated(id%COLSCA)) THEN + DEALLOCATE(id%COLSCA) + NULLIFY(id%COLSCA) + ENDIF + IF (associated(id%ROWSCA)) THEN + DEALLOCATE(id%ROWSCA) + NULLIFY(id%ROWSCA) + ENDIF + END IF + IF (associated(id%PTLUST_S)) THEN + DEALLOCATE(id%PTLUST_S) + NULLIFY(id%PTLUST_S) + END IF + IF (associated(id%PTRFAC)) THEN + DEALLOCATE(id%PTRFAC) + NULLIFY(id%PTRFAC) + END IF + IF (associated(id%POIDS)) THEN + DEALLOCATE(id%POIDS) + NULLIFY(id%POIDS) + ENDIF + IF (associated(id%IS)) THEN + DEALLOCATE(id%IS) + NULLIFY(id%IS) + ENDIF + IF (associated(id%IS1)) THEN + DEALLOCATE(id%IS1) + NULLIFY(id%IS1) + ENDIF + IF (associated(id%STEP)) THEN + DEALLOCATE(id%STEP) + NULLIFY(id%STEP) + ENDIF + IF (associated(id%Step2node)) THEN + DEALLOCATE(id%Step2node) + NULLIFY(id%Step2node) + ENDIF + IF (associated(id%NE_STEPS)) THEN + DEALLOCATE(id%NE_STEPS) + NULLIFY(id%NE_STEPS) + ENDIF + IF (associated(id%ND_STEPS)) THEN + DEALLOCATE(id%ND_STEPS) + NULLIFY(id%ND_STEPS) + ENDIF + IF (associated(id%FRERE_STEPS)) THEN + DEALLOCATE(id%FRERE_STEPS) + NULLIFY(id%FRERE_STEPS) + ENDIF + IF (associated(id%DAD_STEPS)) THEN + DEALLOCATE(id%DAD_STEPS) + NULLIFY(id%DAD_STEPS) + ENDIF + IF (associated(id%SYM_PERM)) THEN + DEALLOCATE(id%SYM_PERM) + NULLIFY(id%SYM_PERM) + ENDIF + IF (associated(id%UNS_PERM)) THEN + DEALLOCATE(id%UNS_PERM) + NULLIFY(id%UNS_PERM) + ENDIF + IF (associated(id%PIVNUL_LIST)) THEN + DEALLOCATE(id%PIVNUL_LIST) + NULLIFY(id%PIVNUL_LIST) + ENDIF + IF (associated(id%FILS)) THEN + DEALLOCATE(id%FILS) + NULLIFY(id%FILS) + ENDIF + IF (associated(id%PTRAR)) THEN + DEALLOCATE(id%PTRAR) + NULLIFY(id%PTRAR) + ENDIF + IF (associated(id%FRTPTR)) THEN + DEALLOCATE(id%FRTPTR) + NULLIFY(id%FRTPTR) + ENDIF + IF (associated(id%FRTELT)) THEN + DEALLOCATE(id%FRTELT) + NULLIFY(id%FRTELT) + ENDIF + IF (associated(id%NA)) THEN + DEALLOCATE(id%NA) + NULLIFY(id%NA) + ENDIF + IF (associated(id%PROCNODE_STEPS)) THEN + DEALLOCATE(id%PROCNODE_STEPS) + NULLIFY(id%PROCNODE_STEPS) + ENDIF + IF (associated(id%PROCNODE)) THEN + DEALLOCATE(id%PROCNODE) + NULLIFY(id%PROCNODE) + ENDIF + IF (associated(id%RHSCOMP)) THEN + DEALLOCATE(id%RHSCOMP) + NULLIFY(id%RHSCOMP) + ENDIF + IF (associated(id%POSINRHSCOMP)) THEN + DEALLOCATE(id%POSINRHSCOMP) + NULLIFY(id%POSINRHSCOMP) + ENDIF + IF (id%KEEP(46).eq.1 .and. + & id%KEEP(55).ne.0 .and. + & id%MYID .eq. MASTER .and. + & id%KEEP(52) .eq. 0 ) THEN + NULLIFY(id%DBLARR) + ELSE + IF (associated(id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + END IF + IF (associated(id%INTARR)) THEN + DEALLOCATE(id%INTARR) + NULLIFY(id%INTARR) + ENDIF + IF (associated(id%root%RG2L_ROW))THEN + DEALLOCATE(id%root%RG2L_ROW) + NULLIFY(id%root%RG2L_ROW) + ENDIF + IF (associated(id%root%RG2L_COL))THEN + DEALLOCATE(id%root%RG2L_COL) + NULLIFY(id%root%RG2L_COL) + ENDIF + IF (associated(id%root%IPIV)) THEN + DEALLOCATE(id%root%IPIV) + NULLIFY(id%root%IPIV) + ENDIF + IF (associated(id%root%RHS_CNTR_MASTER_ROOT)) THEN + DEALLOCATE(id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY(id%root%RHS_CNTR_MASTER_ROOT) + ENDIF + IF (associated(id%root%RHS_ROOT))THEN + DEALLOCATE(id%root%RHS_ROOT) + NULLIFY(id%root%RHS_ROOT) + ENDIF + CALL SMUMPS_636(id) + IF (associated(id%ELTPROC)) THEN + DEALLOCATE(id%ELTPROC) + NULLIFY(id%ELTPROC) + ENDIF + IF (associated(id%CANDIDATES)) THEN + DEALLOCATE(id%CANDIDATES) + NULLIFY(id%CANDIDATES) + ENDIF + IF (associated(id%I_AM_CAND)) THEN + DEALLOCATE(id%I_AM_CAND) + NULLIFY(id%I_AM_CAND) + ENDIF + IF (associated(id%ISTEP_TO_INIV2)) THEN + DEALLOCATE(id%ISTEP_TO_INIV2) + NULLIFY(id%ISTEP_TO_INIV2) + ENDIF + IF (I_AM_SLAVE) THEN + IF (associated(id%TAB_POS_IN_PERE)) THEN + DEALLOCATE(id%TAB_POS_IN_PERE) + NULLIFY(id%TAB_POS_IN_PERE) + ENDIF + IF (associated(id%FUTURE_NIV2)) THEN + DEALLOCATE(id%FUTURE_NIV2) + NULLIFY(id%FUTURE_NIV2) + ENDIF + ENDIF + IF(associated(id%DEPTH_FIRST))THEN + DEALLOCATE(id%DEPTH_FIRST) + NULLIFY(id%DEPTH_FIRST) + ENDIF + IF(associated(id%DEPTH_FIRST_SEQ))THEN + DEALLOCATE(id%DEPTH_FIRST_SEQ) + NULLIFY(id%DEPTH_FIRST_SEQ) + ENDIF + IF(associated(id%SBTR_ID))THEN + DEALLOCATE(id%SBTR_ID) + NULLIFY(id%SBTR_ID) + ENDIF + IF (associated(id%MEM_SUBTREE)) THEN + DEALLOCATE(id%MEM_SUBTREE) + NULLIFY(id%MEM_SUBTREE) + ENDIF + IF (associated(id%MY_ROOT_SBTR)) THEN + DEALLOCATE(id%MY_ROOT_SBTR) + NULLIFY(id%MY_ROOT_SBTR) + ENDIF + IF (associated(id%MY_FIRST_LEAF)) THEN + DEALLOCATE(id%MY_FIRST_LEAF) + NULLIFY(id%MY_FIRST_LEAF) + ENDIF + IF (associated(id%MY_NB_LEAF)) THEN + DEALLOCATE(id%MY_NB_LEAF) + NULLIFY(id%MY_NB_LEAF) + ENDIF + IF (associated(id%COST_TRAV)) THEN + DEALLOCATE(id%COST_TRAV) + NULLIFY(id%COST_TRAV) + ENDIF + IF(associated (id%OOC_INODE_SEQUENCE))THEN + DEALLOCATE(id%OOC_INODE_SEQUENCE) + NULLIFY(id%OOC_INODE_SEQUENCE) + ENDIF + IF(associated (id%OOC_TOTAL_NB_NODES))THEN + DEALLOCATE(id%OOC_TOTAL_NB_NODES) + NULLIFY(id%OOC_TOTAL_NB_NODES) + ENDIF + IF(associated (id%OOC_SIZE_OF_BLOCK))THEN + DEALLOCATE(id%OOC_SIZE_OF_BLOCK) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + ENDIF + IF(associated (id%OOC_VADDR))THEN + DEALLOCATE(id%OOC_VADDR) + NULLIFY(id%OOC_VADDR) + ENDIF + IF(associated (id%OOC_NB_FILES))THEN + DEALLOCATE(id%OOC_NB_FILES) + NULLIFY(id%OOC_NB_FILES) + ENDIF + IF (id%KEEP8(24).EQ.0_8) THEN + IF (associated(id%S)) DEALLOCATE(id%S) + ELSE + ENDIF + NULLIFY(id%S) + IF (I_AM_SLAVE) THEN + CALL SMUMPS_57( IERR ) + CALL SMUMPS_59( IERR ) + END IF + IF ( associated( id%BUFR ) ) DEALLOCATE( id%BUFR ) + NULLIFY( id%BUFR ) + RETURN + END SUBROUTINE SMUMPS_136 + SUBROUTINE SMUMPS_150(MYID,COMM,S,MAXS,MAXS_BYTES) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + INTEGER COMM, MYID, MAXS, MAXS_BYTES + INTEGER S( MAXS ) + INTEGER MSGTAG, MSGSOU, MSGLEN + LOGICAL FLAG + FLAG = .TRUE. + DO WHILE ( FLAG ) + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + IF (FLAG) THEN + MSGTAG=STATUS(MPI_TAG) + MSGSOU=STATUS(MPI_SOURCE) + CALL MPI_GET_COUNT(STATUS,MPI_PACKED,MSGLEN,IERR) + IF (MSGLEN <= MAXS_BYTES) THEN + CALL MPI_RECV(S(1),MAXS_BYTES,MPI_PACKED, + & MSGSOU, MSGTAG, COMM, STATUS, IERR) + ELSE + EXIT + ENDIF + END IF + END DO + CALL MPI_BARRIER( COMM, IERR ) + RETURN + END SUBROUTINE SMUMPS_150 + SUBROUTINE SMUMPS_254(COMM_LOAD, ASS_IRECV, + & N, INODE, TYPE, TYPEF, + & LA, IW, LIW, A, + & IFLAG, IERROR, OPELIW, NELVAW, NMAXNPIV, + & PTRIST, PTLUST_S, + & PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, NE, + & POSFAC, LRLU, LRLUS, IPTRLU, ICNTL, KEEP,KEEP8, + & COMP, IWPOS, IWPOSCB, PROCNODE_STEPS, SLAVEF, + & FPERE, COMM, MYID, + & IPOOL, LPOOL, LEAF, NSTK_S, + & NBPROCFILS, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, root, + & OPASSW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE SMUMPS_COMM_BUFFER + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER COMM, MYID, TYPE, TYPEF + INTEGER N, LIW, INODE,IFLAG,IERROR + INTEGER ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA, POSFAC, LRLU, LRLUS, IPTRLU + INTEGER IWPOSCB, IWPOS, + & FPERE, SLAVEF, NELVAW, NMAXNPIV + INTEGER IW(LIW),PROCNODE_STEPS(KEEP(28)) + INTEGER(8) :: PTRAST (KEEP(28)) + INTEGER(8) :: PTRFAC (KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)), NE(KEEP(28)) + REAL A(LA) + DOUBLE PRECISION OPASSW, OPELIW + REAL DBLARR(max(1,KEEP(13))) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER ITLOC( N + KEEP(253) ), FILS( N ), + & ND( KEEP(28) ), FRERE( KEEP(28) ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER LPOOL, LEAF, COMP + INTEGER IPOOL( LPOOL ) + INTEGER NSTK_S( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER NBFIN + INTEGER NFRONT_ESTIM,NELIM_ESTIM + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER LP + INTEGER NBROWS_ALREADY_SENT + INTEGER(8) :: POSELT, OPSFAC + INTEGER(8) :: IOLD, INEW, FACTOR_POS + INTEGER NSLAVES, NCB, + & H_INODE, IERR, NBCOL, NBROW, NBROW_SEND, + & NBROW_STACK, NBCOL_STACK, NELIM + INTEGER NCBROW_ALREADY_MOVED, NCBROW_PREVIOUSLY_MOVED, + &NCBROW_NEWLY_MOVED + INTEGER(8) :: LAST_ALLOWED_POS + INTEGER(8) :: LREQCB, MIN_SPACE_IN_PLACE + INTEGER(8) :: SHIFT_VAL_SON + INTEGER SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON, + & LIST_ROW_SON, LIST_COL_SON, LIST_SLAVES + INTEGER IOLDPS,NFRONT,NPIV,NASS,IOLDP1,PTROWEND, + & LREQI, LCONT + INTEGER I,LDA, INIV2 + INTEGER MSGDEST, MSGTAG, CHK_LOAD + INCLUDE 'mumps_headers.h' + LOGICAL COMPRESSCB, MUST_COMPACT_FACTORS + LOGICAL INPLACE + INTEGER(8) :: SIZE_INPLACE + INTEGER INTSIZ + DOUBLE PRECISION FLOP1, FLOP1_EFFECTIVE + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + LOGICAL SSARBR, SSARBR_ROOT, MUMPS_167, + &MUMPS_170 + EXTERNAL MUMPS_167, MUMPS_170 + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + INPLACE = .FALSE. + MIN_SPACE_IN_PLACE = 0_8 + IOLDPS = PTLUST_S(STEP(INODE)) + INTSIZ = IW(IOLDPS+XXI) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NPIV = IW(IOLDPS + 1+KEEP(IXSZ)) + NMAXNPIV = max(NPIV, NMAXNPIV) + NASS = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + H_INODE= 6 + NSLAVES + KEEP(IXSZ) + LCONT = NFRONT - NPIV + NBCOL = LCONT + SSARBR = MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + SSARBR_ROOT = MUMPS_170 + & (PROCNODE_STEPS(STEP(INODE)),SLAVEF) + LREQCB = 0_8 + INPLACE = .FALSE. + COMPRESSCB= ((KEEP(215).EQ.0) + & .AND.(KEEP(50).NE.0) + & .AND.(TYPEF.EQ.1 + & .OR.TYPEF.EQ.2 + & ) + & .AND.(TYPE.EQ.1)) + MUST_COMPACT_FACTORS = .TRUE. + IF (KEEP(201).EQ.1 .OR. KEEP(201).EQ.-1) THEN + MUST_COMPACT_FACTORS = .FALSE. + ENDIF + IF ((FPERE.EQ.0).AND.(NASS.NE.NPIV)) THEN + IFLAG = -10 + GOTO 600 + ENDIF + NBROW = LCONT + IF (TYPE.EQ.2) NBROW = NASS - NPIV + IF ((KEEP(50).NE.0).AND.(TYPE.EQ.2)) THEN + LDA = NASS + ELSE + LDA = NFRONT + ENDIF + NBROW_SEND = NBROW + NELIM = NASS-NPIV + IF (TYPEF.EQ.2) NBROW_SEND = NELIM + POSELT = PTRAST(STEP(INODE)) + IF (POSELT .ne. PTRFAC(STEP(INODE))) THEN + WRITE(*,*) "Error 1 in G" + CALL MUMPS_ABORT() + END IF + NELVAW = NELVAW + NASS - NPIV + IF (KEEP(50) .eq. 0) THEN + KEEP8(10) = KEEP8(10) + int(NPIV,8) * int(NFRONT,8) + ELSE + KEEP8(10) = KEEP8(10) + ( int(NPIV,8)*int(NPIV+1,8) )/ 2_8 + ENDIF + KEEP8(10) = KEEP8(10) + int(NBROW,8) * int(NPIV,8) + CALL MUMPS_511( NFRONT, NPIV, NASS, + & KEEP(50), TYPE,FLOP1 ) + IF ( (.NOT. SSARBR_ROOT) .and. TYPE == 1) THEN + IF (NE(STEP(INODE))==0) THEN + CHK_LOAD=0 + ELSE + CHK_LOAD=1 + ENDIF + CALL SMUMPS_190(CHK_LOAD, .FALSE., -FLOP1, + & KEEP,KEEP8) + ENDIF + FLOP1_EFFECTIVE = FLOP1 + OPELIW = OPELIW + FLOP1 + IF ( NPIV .NE. NASS ) THEN + CALL MUMPS_511( NFRONT, NASS, NASS, + & KEEP(50), TYPE,FLOP1 ) + IF (.NOT. SSARBR_ROOT ) THEN + IF (NE(STEP(INODE))==0) THEN + CHK_LOAD=0 + ELSE + CHK_LOAD=1 + ENDIF + CALL SMUMPS_190(CHK_LOAD, .FALSE., + & FLOP1_EFFECTIVE-FLOP1, + & KEEP,KEEP8) + ENDIF + END IF + IF ( SSARBR_ROOT ) THEN + NFRONT_ESTIM=ND(STEP(INODE)) + KEEP(253) + NELIM_ESTIM=NASS-(NFRONT-NFRONT_ESTIM) + CALL MUMPS_511(NFRONT_ESTIM,NELIM_ESTIM,NELIM_ESTIM, + & KEEP(50),1,FLOP1) + END IF + FLOP1=-FLOP1 + IF (SSARBR_ROOT) THEN + CALL SMUMPS_190(0,.FALSE.,FLOP1,KEEP,KEEP8) + ELSE + CALL SMUMPS_190(2,.FALSE.,FLOP1,KEEP,KEEP8) + ENDIF + IF ( FPERE .EQ. 0 ) THEN + IF ( KEEP(253) .NE. 0 .AND. KEEP(201).NE.-1 + & .AND. KEEP(201).NE.1 ) THEN + MUST_COMPACT_FACTORS = .TRUE. + GOTO 190 + ELSE + MUST_COMPACT_FACTORS = .FALSE. + GOTO 190 + ENDIF + ENDIF + IF ( FPERE.EQ.KEEP(38) ) THEN + NCB = NFRONT - NASS + SHIFT_LIST_ROW_SON = H_INODE + NASS + SHIFT_LIST_COL_SON = H_INODE + NFRONT + NASS + SHIFT_VAL_SON = int(NASS,8)*int(NFRONT+1,8) + IF (TYPE.EQ.1) THEN + CALL SMUMPS_80( + & COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTLUST_S, PTRAST, + & root, NCB, NCB, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT, + & ROOT_CONT_STATIC, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG < 0 ) GOTO 500 + ENDIF + MSGDEST= MUMPS_275(PROCNODE_STEPS(STEP(FPERE)),SLAVEF) + IOLDPS = PTLUST_S(STEP(INODE)) + LIST_ROW_SON = IOLDPS + H_INODE + NPIV + LIST_COL_SON = IOLDPS + H_INODE + NFRONT + NPIV + LIST_SLAVES = IOLDPS + 6 + KEEP(IXSZ) + IF (MSGDEST.EQ.MYID) THEN + CALL SMUMPS_273( root, + & INODE, NELIM, NSLAVES, IW(LIST_ROW_SON), + & IW(LIST_COL_SON), IW(LIST_SLAVES), + & + & PROCNODE_STEPS, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & ITLOC, RHS_MUMPS, COMP, + & IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8, + & COMM, COMM_LOAD, FILS, ND) + IF (IFLAG.LT.0) GOTO 600 + ELSE + IERR = -1 + DO WHILE (IERR.EQ.-1) + CALL SMUMPS_76( INODE, NELIM, + & IW(LIST_ROW_SON), IW(LIST_COL_SON), NSLAVES, + & IW(LIST_SLAVES), MSGDEST, COMM, IERR) + IF ( IERR .EQ. -1 ) THEN + BLOCKING =.FALSE. + SET_IRECV =.TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, + & ND, FRERE, LPTRAR, NELT, + & FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & .TRUE.) + IF ( IFLAG .LT. 0 ) GOTO 500 + IOLDPS = PTLUST_S(STEP(INODE)) + LIST_ROW_SON = IOLDPS + H_INODE + NPIV + LIST_COL_SON = IOLDPS + H_INODE + NFRONT + NPIV + LIST_SLAVES = IOLDPS + 6 + KEEP(IXSZ) + ENDIF + ENDDO + IF ( IERR .EQ. -2 ) THEN + IERROR = ( 3 + NSLAVES + 2 * NELIM ) * KEEP( 34 ) + IFLAG = - 17 + GOTO 600 + ELSE IF ( IERR .EQ. -3 ) THEN + IERROR = ( 3 + NSLAVES + 2 * NELIM ) * KEEP( 34 ) + IFLAG = -20 + GOTO 600 + ENDIF + ENDIF + IF (NELIM.EQ.0) THEN + POSELT = PTRAST(STEP(INODE)) + OPSFAC = POSELT + int(NPIV,8) * int(NFRONT,8) + int(NPIV,8) + GOTO 190 + ELSE + GOTO 500 + ENDIF + ENDIF + OPSFAC = POSELT + int(NPIV,8) * int(LDA,8) + int(NPIV,8) + IF ( MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .NE. MYID ) THEN + MSGTAG =NOEUD + MSGDEST=MUMPS_275( PROCNODE_STEPS(STEP(FPERE)), SLAVEF ) + IERR = -1 + NBROWS_ALREADY_SENT = 0 + DO WHILE (IERR.EQ.-1) + IF ( (TYPE.EQ.1) .AND. (TYPEF.EQ.1) ) THEN + CALL SMUMPS_66( NBROWS_ALREADY_SENT, + & INODE, FPERE, NFRONT, + & LCONT, NASS, NPIV, IW( IOLDPS + H_INODE + NPIV ), + & IW( IOLDPS + H_INODE + NPIV + NFRONT ), + & A( OPSFAC ), COMPRESSCB, + & MSGDEST, MSGTAG, COMM, IERR ) + ELSE + IF ( (TYPE.EQ.2).AND.(KEEP(48).NE.0)) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + ELSE + INIV2 = -9999 + ENDIF + CALL SMUMPS_70( NBROWS_ALREADY_SENT, + & FPERE, INODE, + & NBROW_SEND, IW(IOLDPS + H_INODE + NPIV ), + & NBCOL, IW(IOLDPS + H_INODE + NPIV + NFRONT ), + & A(OPSFAC), LDA, NELIM, TYPE, + & NSLAVES, IW(IOLDPS+6+KEEP(IXSZ)), MSGDEST, + & COMM, IERR, + & + & SLAVEF, KEEP,KEEP8, INIV2, TAB_POS_IN_PERE ) + END IF + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IOLDPS = PTLUST_S(STEP( INODE )) + OPSFAC = POSELT + int(NPIV,8) * int(LDA,8) + int(NPIV,8) + END DO + IF ( IERR .EQ. -2 .OR. IERR .EQ. -3 ) THEN + IF ( (TYPE.EQ.1) .AND. (TYPEF.EQ.1) ) THEN + IERROR = ( 2*LCONT + 9 ) * KEEP( 34 ) + + & LCONT*LCONT * KEEP( 35 ) + ELSE IF (KEEP(50).ne.0 .AND. TYPE .eq. 2 ) THEN + IERROR = ( NBROW_SEND + NBCOL+ 5 + NSLAVES) + & * KEEP( 34 ) + + & NBROW_SEND*NBROW_SEND*KEEP( 35 ) + ELSE + IERROR = ( NBROW_SEND + NBCOL+ 5 + NSLAVES) * KEEP( 34 ) + + & NBROW_SEND*NBCOL*KEEP( 35 ) + ENDIF + IF (IERR .EQ. -2) THEN + IFLAG = -17 + IF ( LP > 0 ) THEN + WRITE(LP, *) MYID, + & ": FAILURE, SEND BUFFER TOO SMALL DURING + & SMUMPS_254", TYPE, TYPEF + ENDIF + ENDIF + IF (IERR .EQ. -3) THEN + IFLAG = -20 + IF ( LP > 0 ) THEN + WRITE(LP, *) MYID, + & ": FAILURE, RECV BUFFER TOO SMALL DURING + & SMUMPS_254", TYPE, TYPEF + ENDIF + ENDIF + GOTO 600 + ENDIF + ENDIF + IF ( MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .EQ. MYID ) THEN + LREQI = 2 + KEEP(IXSZ) + NBROW_STACK = NBROW + NBROW_SEND = 0 + IF ((KEEP(50).NE.0).AND.(TYPE.EQ.2)) THEN + NBCOL_STACK = NBROW + ELSE + NBCOL_STACK = NBCOL + ENDIF + ELSE + NBROW_STACK = NBROW-NBROW_SEND + NBCOL_STACK = NBCOL + LREQI = 6 + NBROW_STACK + NBCOL + KEEP(IXSZ) + IF (.NOT. (TYPE.EQ.1 .AND. TYPEF.EQ.2 ) ) GOTO 190 + IF (FPERE.EQ.0) GOTO 190 + ENDIF + IF (COMPRESSCB) THEN + LREQCB = ( int(NBCOL_STACK,8) * int( NBCOL_STACK + 1, 8) ) / 2_8 + & - ( int(NBROW_SEND ,8) * int( NBROW_SEND + 1, 8) ) / 2_8 + ELSE + LREQCB = int(NBROW_STACK,8) * int(NBCOL_STACK,8) + ENDIF + INPLACE = ( KEEP(234).NE.0 ) + IF (KEEP(50).NE.0 .AND. TYPE .EQ. 2) INPLACE = .FALSE. + INPLACE = INPLACE .OR. .NOT. MUST_COMPACT_FACTORS + INPLACE = INPLACE .AND. + & ( PTLUST_S(STEP(INODE)) + INTSIZ .EQ. IWPOS ) + MIN_SPACE_IN_PLACE = 0_8 + IF ( INPLACE .AND. KEEP(50).eq. 0 .AND. + & MUST_COMPACT_FACTORS) THEN + MIN_SPACE_IN_PLACE = int(NBCOL_STACK,8) + ENDIF + IF ( MIN_SPACE_IN_PLACE .GT. LREQCB ) THEN + INPLACE = .FALSE. + ENDIF + CALL SMUMPS_22( INPLACE, MIN_SPACE_IN_PLACE, + & SSARBR, .FALSE., + & MYID,N,KEEP,KEEP8,IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER,PAMASTER, + & LREQI, LREQCB, INODE, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR ) + IF (IFLAG.LT.0) GOTO 600 + PTRIST(STEP(INODE)) = IWPOSCB+1 + IF ( MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .EQ. MYID ) THEN + PIMASTER (STEP(INODE)) = PTLUST_S(STEP(INODE)) + PAMASTER(STEP(INODE)) = IPTRLU + 1_8 + PTRAST(STEP(INODE)) = -99999999_8 + IW(IWPOSCB+1+KEEP(IXSZ)) = min(-NBCOL_STACK,-1) + IW(IWPOSCB+2+KEEP(IXSZ)) = NBROW_STACK + IF (COMPRESSCB) IW(IWPOSCB+1+XXS) = S_CB1COMP + ELSE + PTRAST(STEP(INODE)) = IPTRLU+1_8 + IF (COMPRESSCB) IW(IWPOSCB+1+XXS)=S_CB1COMP + IW(IWPOSCB+1+KEEP(IXSZ)) = NBCOL + IW(IWPOSCB+2+KEEP(IXSZ)) = 0 + IW(IWPOSCB+3+KEEP(IXSZ)) = NBROW_STACK + IW(IWPOSCB+4+KEEP(IXSZ)) = 0 + IW(IWPOSCB+5+KEEP(IXSZ)) = 1 + IW(IWPOSCB+6+KEEP(IXSZ)) = 0 + IOLDP1 = PTLUST_S(STEP(INODE))+H_INODE + PTROWEND = IWPOSCB+6+NBROW_STACK+KEEP(IXSZ) + DO I = 1, NBROW_STACK + IW(IWPOSCB+7+KEEP(IXSZ)+I-1) = + & IW(IOLDP1+NFRONT-NBROW_STACK+I-1) + ENDDO + DO I = 1, NBCOL + IW(PTROWEND+I)=IW(IOLDP1+NFRONT+NPIV+I-1) + ENDDO + END IF + IF ( KEEP(50).NE.0 .AND. TYPE .EQ. 1 + & .AND. MUST_COMPACT_FACTORS ) THEN + POSELT = PTRFAC(STEP(INODE)) + CALL SMUMPS_324(A(POSELT), LDA, + & NPIV, NBROW, KEEP(50)) + MUST_COMPACT_FACTORS = .FALSE. + ENDIF + IF ( KEEP(50).EQ.0 .AND. MUST_COMPACT_FACTORS ) + & THEN + LAST_ALLOWED_POS = POSELT + int(LDA,8)*int(NPIV+NBROW-1,8) + & + int(NPIV,8) + ELSE + LAST_ALLOWED_POS = -1_8 + ENDIF + NCBROW_ALREADY_MOVED = 0 + 10 CONTINUE + NCBROW_PREVIOUSLY_MOVED = NCBROW_ALREADY_MOVED + IF (IPTRLU .LT. POSFAC ) THEN + CALL SMUMPS_652( A, LA, LDA, + & POSELT, IPTRLU, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, LREQCB, KEEP, COMPRESSCB, + & LAST_ALLOWED_POS, NCBROW_ALREADY_MOVED ) + ELSE + CALL SMUMPS_705( A, LA, LDA, + & POSELT, IPTRLU, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, LREQCB, KEEP, COMPRESSCB ) + NCBROW_ALREADY_MOVED = NBROW_STACK + ENDIF + IF (LAST_ALLOWED_POS .NE. -1_8) THEN + MUST_COMPACT_FACTORS =.FALSE. + IF ( NCBROW_ALREADY_MOVED .EQ. NBROW_STACK ) THEN + NCBROW_ALREADY_MOVED = NCBROW_ALREADY_MOVED + NBROW_SEND + ENDIF + NCBROW_NEWLY_MOVED = NCBROW_ALREADY_MOVED + & - NCBROW_PREVIOUSLY_MOVED + FACTOR_POS = POSELT + + & int(LDA,8)*int(NPIV+NBROW-NCBROW_ALREADY_MOVED,8) + CALL SMUMPS_651( A(FACTOR_POS), LDA, NPIV, + & NCBROW_NEWLY_MOVED ) + INEW = FACTOR_POS + int(NPIV,8) * int(NCBROW_NEWLY_MOVED,8) + IOLD = INEW + int(NCBROW_NEWLY_MOVED,8) * int(NBCOL_STACK,8) + DO I = 1, NCBROW_PREVIOUSLY_MOVED*NPIV + A(INEW) = A(IOLD) + IOLD = IOLD + 1_8 + INEW = INEW + 1_8 + ENDDO + KEEP8(8)=KEEP8(8) + int(NCBROW_PREVIOUSLY_MOVED,8) + & * int(NPIV,8) + LAST_ALLOWED_POS = INEW + IF (NCBROW_ALREADY_MOVED.LT.NBROW_STACK) THEN + GOTO 10 + ENDIF + ENDIF + 190 CONTINUE + IF (MUST_COMPACT_FACTORS) THEN + POSELT = PTRFAC(STEP(INODE)) + CALL SMUMPS_324(A(POSELT), LDA, + & NPIV, NBROW, KEEP(50)) + MUST_COMPACT_FACTORS = .FALSE. + ENDIF + IOLDPS = PTLUST_S(STEP(INODE)) + IW(IOLDPS+KEEP(IXSZ)) = NBCOL + IW(IOLDPS + 1+KEEP(IXSZ)) = NASS - NPIV + IF (TYPE.EQ.2) THEN + IW(IOLDPS + 2+KEEP(IXSZ)) = NASS + ELSE + IW(IOLDPS + 2+KEEP(IXSZ)) = NFRONT + ENDIF + IW(IOLDPS + 3+KEEP(IXSZ)) = NPIV + IF (INPLACE) THEN + SIZE_INPLACE = LREQCB - MIN_SPACE_IN_PLACE + ELSE + SIZE_INPLACE = 0_8 + ENDIF + CALL SMUMPS_93(SIZE_INPLACE,MYID,N,IOLDPS,TYPE, IW, LIW, + & A, LA, POSFAC, LRLU, LRLUS, + & IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8, SSARBR,INODE,IERR) + IF(IERR.LT.0)THEN + IFLAG=IERR + IERROR=0 + GOTO 600 + ENDIF + 500 CONTINUE + RETURN + 600 CONTINUE + IF (IFLAG .NE. -1) CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE SMUMPS_254 + SUBROUTINE SMUMPS_142( id) + USE SMUMPS_COMM_BUFFER + USE SMUMPS_LOAD + USE SMUMPS_OOC + USE SMUMPS_STRUC_DEF + IMPLICIT NONE +#ifndef SUN_ + INTERFACE + SUBROUTINE SMUMPS_27(id, ANORMINF, LSCAL) + USE SMUMPS_STRUC_DEF + TYPE (SMUMPS_STRUC), TARGET :: id + REAL, INTENT(OUT) :: ANORMINF + LOGICAL :: LSCAL + END SUBROUTINE SMUMPS_27 + END INTERFACE +#endif + TYPE(SMUMPS_STRUC), TARGET :: id + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER IERR, MASTER + PARAMETER( MASTER = 0 ) + INCLUDE 'mumps_headers.h' + INTEGER NSEND, NSEND_TOT, LDPTRAR, NELT + INTEGER NLOCAL, NLOCAL_TOT, KEEP13_SAVE, ITMP + INTEGER(8) K67 + INTEGER(8) ITMP8 + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER MP, LP, MPG, allocok + LOGICAL PROK, PROKG, LSCAL + INTEGER SMUMPS_LBUF, SMUMPS_LBUFR_BYTES, SMUMPS_LBUF_INT + INTEGER PTRIST, PTRWB, MAXELT_SIZE, + & ITLOC, IPOOL, NSTEPS, K28, LPOOL, LIW + INTEGER IRANK, ID_ROOT + INTEGER KKKK, NZ_locMAX + INTEGER(8) MEMORY_MD_ARG + INTEGER(8) MAXS_BASE8, MAXS_BASE_RELAXED8 + REAL CNTL4 + INTEGER MIN_PERLU, MAXIS_ESTIM + INTEGER MAXIS + INTEGER(8) :: MAXS + DOUBLE PRECISION TIME + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INTEGER PERLU, TOTAL_MBYTES, K231, K232, K233 + INTEGER COLOUR, COMM_FOR_SCALING + INTEGER LIWK, LWK, LWK_REAL + LOGICAL I_AM_SLAVE, PERLU_ON, WK_USER_PROVIDED + REAL :: ANORMINF, SEUIL, SEUIL_LDLT_NIV2 + REAL :: CNTL1, CNTL3, CNTL5, CNTL6, EPS + INTEGER N, LPN_LIST,POSBUF + INTEGER, DIMENSION (:), ALLOCATABLE :: ITMP2 + INTEGER I,K + INTEGER, DIMENSION(:), ALLOCATABLE :: IWK + REAL, DIMENSION(:), ALLOCATABLE :: WK + REAL, DIMENSION(:), ALLOCATABLE :: WK_REAL + INTEGER(8), DIMENSION(:), ALLOCATABLE :: IWK8 + INTEGER, DIMENSION(:), ALLOCATABLE :: BURP + INTEGER, DIMENSION(:), ALLOCATABLE :: BUCP + INTEGER, DIMENSION(:), ALLOCATABLE :: BURS + INTEGER, DIMENSION(:), ALLOCATABLE :: BUCS + INTEGER BUREGISTRE(12) + INTEGER BUINTSZ, BURESZ, BUJOB + INTEGER BUMAXMN, M, SCMYID, SCNPROCS + REAL SCONEERR, SCINFERR + INTEGER, POINTER :: JOB, NZ + REAL,DIMENSION(:),POINTER::RINFO, RINFOG + REAL,DIMENSION(:),POINTER:: CNTL + INTEGER,DIMENSION(:),POINTER::INFO, INFOG, KEEP + INTEGER, DIMENSION(:), POINTER :: MYIRN_loc, MYJCN_loc + REAL, DIMENSION(:), POINTER :: MYA_loc + INTEGER, TARGET :: DUMMYIRN_loc(1), DUMMYJCN_loc(1) + REAL, TARGET :: DUMMYA_loc(1) + INTEGER(8),DIMENSION(:),POINTER::KEEP8 + INTEGER,DIMENSION(:),POINTER::ICNTL + EXTERNAL SMUMPS_505 + INTEGER SMUMPS_505 + INTEGER(8) TOTAL_BYTES + INTEGER(8) :: I8TMP + INTEGER numroc + EXTERNAL numroc + REAL, DIMENSION(:), POINTER :: RHS_MUMPS + LOGICAL :: RHS_MUMPS_ALLOCATED + JOB=>id%JOB + NZ=>id%NZ + RINFO=>id%RINFO + RINFOG=>id%RINFOG + CNTL=>id%CNTL + INFO=>id%INFO + INFOG=>id%INFOG + KEEP=>id%KEEP + KEEP8=>id%KEEP8 + ICNTL=>id%ICNTL + IF (id%NZ_loc .NE. 0) THEN + MYIRN_loc=>id%IRN_loc + MYJCN_loc=>id%JCN_loc + MYA_loc=>id%A_loc + ELSE + MYIRN_loc=>DUMMYIRN_loc + MYJCN_loc=>DUMMYJCN_loc + MYA_loc=>DUMMYA_loc + ENDIF + N = id%N + EPS = epsilon ( ZERO ) + NULLIFY(RHS_MUMPS) + RHS_MUMPS_ALLOCATED = .FALSE. + IF (KEEP8(24).GT.0_8) THEN + NULLIFY(id%S) + ENDIF + WK_USER_PROVIDED = (id%LWK_USER.NE.0) + IF (WK_USER_PROVIDED) THEN + IF (id%LWK_USER.GT.0) THEN + KEEP8(24) = int(id%LWK_USER,8) + ELSE + KEEP8(24) = -int(id%LWK_USER,8)* 1000000_8 + ENDIF + ELSE + KEEP8(24) = 0_8 + ENDIF + KEEP13_SAVE = KEEP(13) + id%DKEEP(4)=-1.0E0 + id%DKEEP(5)=-1.0E0 + MP = ICNTL( 2 ) + MPG = ICNTL( 3 ) + LP = ICNTL( 1 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF ( PROK ) WRITE( MP, 130 ) + IF ( PROKG ) WRITE( MPG, 130 ) + IF ( PROKG .and. KEEP(53).GT.0 ) THEN + WRITE(MPG,'(/A,I3)') ' Null space option :', KEEP(19) + IF ( KEEP(21) .ne. 0 ) THEN + WRITE( MPG, '(A,I10)') ' Max deficiency : ', KEEP(21) + END IF + IF ( KEEP(22) .ne. 0 ) THEN + WRITE( MPG, '(A,I10)') ' Min deficiency : ', KEEP(22) + END IF + END IF + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & KEEP(46) .eq. 1 ) ) + IF (id%MYID .EQ. MASTER .AND. KEEP(201) .NE. -1) THEN + KEEP(201)=id%ICNTL(22) + IF (KEEP(201) .NE. 0) THEN +# if defined(OLD_OOC_NOPANEL) + KEEP(201)=2 +# else + KEEP(201)=1 +# endif + ENDIF + ENDIF + CALL MPI_BCAST( KEEP(12), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(19), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(21), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(201), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (id%MYID.EQ.MASTER) THEN + IF (KEEP(217).GT.2.OR.KEEP(217).LT.0) THEN + KEEP(217)=0 + ENDIF + KEEP(214)=KEEP(217) + IF (KEEP(214).EQ.0) THEN + IF (KEEP(201).NE.0) THEN + KEEP(214)=1 + ELSE + KEEP(214)=2 + ENDIF + ENDIF + ENDIF + CALL MPI_BCAST( KEEP(214), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (KEEP(201).NE.0) THEN + CALL MPI_BCAST( KEEP(99), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(205), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(211), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + ENDIF + IF ( KEEP(50) .eq. 1 ) THEN + IF (id%CNTL(1) .ne. ZERO ) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') + &' ** Warning : SPD solver called, resetting CNTL(1) to 0.0E0' + END IF + END IF + id%CNTL(1) = ZERO + END IF + IF (KEEP(219).NE.0) THEN + CALL SMUMPS_617(max(KEEP(108),1),IERR) + IF (IERR .NE. 0) THEN + INFO(1) = -13 + INFO(2) = max(KEEP(108),1) + END IF + ENDIF + IF (id%KEEP(252).EQ.1 .AND. id%MYID.EQ.MASTER) THEN + IF (id%ICNTL(20).EQ.1) THEN + id%INFO(1)=-43 + id%INFO(2)=20 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Sparse RHS is incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ELSE IF (id%ICNTL(30).NE.0) THEN + id%INFO(1)=-43 + id%INFO(2)=30 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ELSE IF (id%ICNTL(9) .NE. 1) THEN + id%INFO(1)=-43 + id%INFO(2)=9 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: sparse RHS incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ENDIF + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 530 + IF ( PROKG ) THEN + WRITE( MPG, 172 ) id%NSLAVES, id%ICNTL(22), + & KEEP8(111), KEEP(126), KEEP(127), KEEP(28) + IF (KEEP(252).GT.0) + & WRITE(MPG,173) KEEP(253) + ENDIF + IF (KEEP(201).LE.0) THEN + KEEP(IXSZ)=XSIZE_IC + ELSE IF (KEEP(201).EQ.2) THEN + KEEP(IXSZ)=XSIZE_OOC_NOPANEL + ELSE IF (KEEP(201).EQ.1) THEN + IF (KEEP(50).EQ.0) THEN + KEEP(IXSZ)=XSIZE_OOC_UNSYM + ELSE + KEEP(IXSZ)=XSIZE_OOC_SYM + ENDIF + ENDIF + IF (id%MYID.EQ.MASTER) KEEP(258)=ICNTL(33) + CALL MPI_BCAST(KEEP(258), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + IF (KEEP(258) .NE. 0) THEN + KEEP(259) = 0 + KEEP(260) = 1 + id%DKEEP(6) = 1.0E0 + ENDIF + CALL MPI_BCAST(KEEP(52), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + LSCAL = ((KEEP(52) .GT. 0) .AND. (KEEP(52) .LE. 8)) + IF (LSCAL) THEN + IF ( id%MYID.EQ.MASTER ) THEN + ENDIF + IF (KEEP(52) .EQ. 7) THEN + K231= KEEP(231) + K232= KEEP(232) + K233= KEEP(233) + ELSEIF (KEEP(52) .EQ. 8) THEN + K231= KEEP(239) + K232= KEEP(240) + K233= KEEP(241) + ENDIF + CALL MPI_BCAST(id%DKEEP(3),1,MPI_REAL,MASTER, + & id%COMM,IERR) + IF ( ((KEEP(52).EQ.7).OR.(KEEP(52).EQ.8)) .AND. + & KEEP(54).NE.0 ) THEN + IF ( id%MYID .NE. MASTER ) THEN + IF ( associated(id%COLSCA)) + & DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) + & DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=IERR) + IF (IERR .GT.0) THEN + id%INFO(1)=-13 + id%INFO(2)=N + ENDIF + ALLOCATE( id%ROWSCA(N), stat=IERR) + IF (IERR .GT.0) THEN + id%INFO(1)=-13 + id%INFO(2)=N + ENDIF + ENDIF + M = N + BUMAXMN=M + IF(N > BUMAXMN) BUMAXMN = N + LIWK = 4*BUMAXMN + ALLOCATE (IWK(LIWK),BURP(M),BUCP(N), + & BURS(2* (id%NPROCS)),BUCS(2* (id%NPROCS)), + & stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=LIWK+M+N+4* (id%NPROCS) + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 530 + BUJOB = 1 + LWK_REAL = 1 + ALLOCATE(WK_REAL(LWK_REAL)) + CALL SMUMPS_693( + & MYIRN_loc(1), MYJCN_loc(1), MYA_loc(1), + & id%NZ_loc, + & M, N, id%NPROCS, id%MYID, id%COMM, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + IF(LIWK < BUINTSZ) THEN + DEALLOCATE(IWK) + LIWK = BUINTSZ + ALLOCATE(IWK(LIWK), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=LIWK + ENDIF + ENDIF + LWK_REAL = BURESZ + DEALLOCATE(WK_REAL) + ALLOCATE (WK_REAL(LWK_REAL), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=LWK_REAL + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 530 + BUJOB = 2 + CALL SMUMPS_693( + & MYIRN_loc(1), MYJCN_loc(1), MYA_loc(1), + & id%NZ_loc, + & M, N, id%NPROCS, id%MYID, id%COMM, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + id%DKEEP(4) = SCONEERR + id%DKEEP(5) = SCINFERR + DEALLOCATE(IWK, WK_REAL,BURP,BUCP,BURS, BUCS) + ELSE IF ( KEEP(54) .EQ. 0 ) THEN + IF ((KEEP(52).EQ.7).OR.(KEEP(52).EQ.8)) THEN + IF (id%MYID.EQ.MASTER) THEN + COLOUR = 0 + ELSE + COLOUR = MPI_UNDEFINED + ENDIF + CALL MPI_COMM_SPLIT( id%COMM, COLOUR, 0, + & COMM_FOR_SCALING, IERR ) + IF (id%MYID.EQ.MASTER) THEN + M = N + BUMAXMN=N + IF(N > BUMAXMN) BUMAXMN = N + LIWK = 1 + ALLOCATE (IWK(LIWK),BURP(1),BUCP(1), + & BURS(1),BUCS(1), + & stat=allocok) + LWK_REAL = M + N + ALLOCATE (WK_REAL(LWK_REAL), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=1 + ENDIF + IF (INFO(1) .LT. 0) GOTO 400 + CALL MPI_COMM_RANK(COMM_FOR_SCALING, SCMYID, IERR) + CALL MPI_COMM_SIZE(COMM_FOR_SCALING, SCNPROCS, IERR) + BUJOB = 1 + CALL SMUMPS_693( + & id%IRN(1), id%JCN(1), id%A(1), + & id%NZ, + & M, N, SCNPROCS, SCMYID, COMM_FOR_SCALING, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + IF(LWK_REAL < BURESZ) THEN + INFO(1) = -136 + GOTO 400 + ENDIF + BUJOB = 2 + CALL SMUMPS_693(id%IRN(1), + & id%JCN(1), id%A(1), + & id%NZ, + & M, N, SCNPROCS, SCMYID, COMM_FOR_SCALING, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + id%DKEEP(4) = SCONEERR + id%DKEEP(5) = SCINFERR + DEALLOCATE(WK_REAL) + DEALLOCATE (IWK,BURP,BUCP, + & BURS,BUCS) + ENDIF + CALL MPI_BCAST( id%DKEEP(4),2,MPI_REAL, + & MASTER, id%COMM, IERR ) + 400 CONTINUE + IF (id%MYID.EQ.MASTER) THEN + CALL MPI_COMM_FREE(COMM_FOR_SCALING, IERR) + ENDIF + CALL MUMPS_276(ICNTL(1), INFO(1), id%COMM, id%MYID) + IF (INFO(1).LT.0) GOTO 530 + ELSE IF (id%MYID.EQ.MASTER) THEN + IF (KEEP(52).GT.0 .AND. KEEP(52).LE.6) THEN + IF ( KEEP(52) .eq. 5 .or. + & KEEP(52) .eq. 6 ) THEN + LWK = NZ + ELSE + LWK = 1 + END IF + LWK_REAL = 5 * N + ALLOCATE( WK_REAL( LWK_REAL ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LWK_REAL + GOTO 137 + END IF + ALLOCATE( WK( LWK ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LWK + GOTO 137 + END IF + CALL SMUMPS_217(N, NZ, KEEP(52), id%A(1), + & id%IRN(1), id%JCN(1), + & id%COLSCA(1), id%ROWSCA(1), + & WK, LWK, WK_REAL, LWK_REAL, ICNTL(1), INFO(1) ) + DEALLOCATE( WK_REAL ) + DEALLOCATE( WK ) + ENDIF + ENDIF + ENDIF + IF (id%MYID.EQ.MASTER) THEN + IF (PROKG.AND.(KEEP(52).EQ.7.OR.KEEP(52).EQ.8) + & .AND. (K233+K231+K232).GT.0) THEN + IF (K232.GT.0) WRITE(MPG, 166) id%DKEEP(4) + ENDIF + ENDIF + ENDIF + LSCAL = (LSCAL .OR. (KEEP(52) .EQ. -1) .OR. KEEP(52) .EQ. -2) + IF (LSCAL .AND. KEEP(258).NE.0 .AND. id%MYID .EQ. MASTER) THEN + DO I = 1, id%N + CALL SMUMPS_761(id%ROWSCA(I), + & id%DKEEP(6), + & KEEP(259)) + ENDDO + IF (KEEP(50) .EQ. 0) THEN + DO I = 1, id%N + CALL SMUMPS_761(id%COLSCA(I), + & id%DKEEP(6), + & KEEP(259)) + ENDDO + ELSE + CALL SMUMPS_765(id%DKEEP(6), KEEP(259)) + ENDIF + CALL SMUMPS_766(id%DKEEP(6), KEEP(259)) + ENDIF + 137 CONTINUE + IF (associated(id%root%RHS_CNTR_MASTER_ROOT)) THEN + DEALLOCATE (id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY (id%root%RHS_CNTR_MASTER_ROOT) + ENDIF + IF ( id%MYID.EQ.MASTER.AND. KEEP(252).EQ.1 .AND. + & id%NRHS .NE. id%KEEP(253) ) THEN + id%INFO(1)=-42 + id%INFO(2)=id%KEEP(253) + ENDIF + IF (id%KEEP(252) .EQ. 1) THEN + IF ( id%MYID.NE.MASTER ) THEN + id%KEEP(254) = N + id%KEEP(255) = N*id%KEEP(253) + ALLOCATE(RHS_MUMPS(id%KEEP(255)),stat=IERR) + IF (IERR > 0) THEN + INFO(1)=-13 + INFO(2)=id%KEEP(255) + IF (LP > 0) + & WRITE(LP,*) 'ERREUR while allocating RHS on a slave' + NULLIFY(RHS_MUMPS) + ENDIF + RHS_MUMPS_ALLOCATED = .TRUE. + ELSE + id%KEEP(254)=id%LRHS + id%KEEP(255)=id%LRHS*(id%KEEP(253)-1)+id%N + RHS_MUMPS=>id%RHS + RHS_MUMPS_ALLOCATED = .FALSE. + IF (LSCAL) THEN + DO K=1, id%KEEP(253) + DO I=1, N + RHS_MUMPS( id%KEEP(254) * (K-1) + I ) + & = RHS_MUMPS( id%KEEP(254) * (K-1) + I ) + & * id%ROWSCA(I) + ENDDO + ENDDO + ENDIF + ENDIF + DO I= 1, id%KEEP(253) + CALL MPI_BCAST(RHS_MUMPS((I-1)*id%KEEP(254)+1), N, + & MPI_REAL, MASTER,id%COMM,IERR) + END DO + ELSE + id%KEEP(255)=1 + ALLOCATE(RHS_MUMPS(1)) + RHS_MUMPS_ALLOCATED = .TRUE. + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).lt.0 ) GOTO 530 + KEEP(110)=ICNTL(24) + CALL MPI_BCAST(KEEP(110), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + IF (KEEP(110).NE.1) KEEP(110)=0 + IF (id%MYID .EQ. MASTER) CNTL3 = id%CNTL(3) + CALL MPI_BCAST(CNTL3, 1, MPI_REAL, + & MASTER, id%COMM, IERR) + IF (id%MYID .EQ. MASTER) CNTL5 = id%CNTL(5) + CALL MPI_BCAST(CNTL5, 1, MPI_REAL, + & MASTER, id%COMM, IERR) + IF (id%MYID .EQ. MASTER) CNTL6 = id%CNTL(6) + CALL MPI_BCAST(CNTL6, 1, MPI_REAL, + & MASTER, id%COMM, IERR) + IF (id%MYID .EQ. MASTER) CNTL1 = id%CNTL(1) + CALL MPI_BCAST(CNTL1, 1, MPI_REAL, + & MASTER, id%COMM, IERR) + ANORMINF = ZERO + IF (KEEP(19).EQ.0) THEN + SEUIL = ZERO + ELSE + CALL SMUMPS_27( id , ANORMINF, LSCAL ) + IF (CNTL6 .LT. ZERO) THEN + SEUIL = EPS*ANORMINF + ELSE + SEUIL = CNTL6*ANORMINF + ENDIF + IF (PROKG) WRITE(MPG,*) + & ' ABSOLUTE PIVOT THRESHOLD for rank revealing =',SEUIL + ENDIF + SEUIL_LDLT_NIV2 = SEUIL + IF (KEEP(110).EQ.0) THEN + id%DKEEP(1) = -1.0E0 + id%DKEEP(2) = ZERO + ELSE + IF (ANORMINF.EQ.ZERO) + & CALL SMUMPS_27( id , ANORMINF, LSCAL ) + IF (CNTL3 .LT. ZERO) THEN + id%DKEEP(1) = abs(CNTL(3)) + ELSE IF (CNTL3 .GT. ZERO) THEN + id%DKEEP(1) = CNTL3*ANORMINF + ELSE + id%DKEEP(1) = 1.0E-5*EPS*ANORMINF + ENDIF + IF (PROKG) WRITE(MPG,*) + & ' ZERO PIVOT DETECTION ON, THRESHOLD =',id%DKEEP(1) + IF (CNTL5.GT.ZERO) THEN + id%DKEEP(2) = CNTL5 * ANORMINF + IF (PROKG) WRITE(MPG,*) + & ' FIXATION FOR NULL PIVOTS =',id%DKEEP(2) + ELSE + IF (PROKG) WRITE(MPG,*) 'INFINITE FIXATION ' + IF (id%KEEP(50).EQ.0) THEN + id%DKEEP(2) = -max(1.0E10*ANORMINF, + & sqrt(huge(ANORMINF))/1.0E8) + ELSE + id%DKEEP(2) = ZERO + ENDIF + ENDIF + ENDIF + IF (KEEP(53).NE.0) THEN + ID_ROOT =MUMPS_275(id%PROCNODE_STEPS(id%STEP(KEEP(20))), + & id%NSLAVES) + IF ( KEEP( 46 ) .NE. 1 ) THEN + ID_ROOT = ID_ROOT + 1 + END IF + ENDIF + IF ( associated( id%PIVNUL_LIST) ) DEALLOCATE(id%PIVNUL_LIST) + IF(KEEP(110) .EQ. 1) THEN + LPN_LIST = N + ELSE + LPN_LIST = 1 + ENDIF + IF (KEEP(19).NE.0 .AND. + & (ID_ROOT.EQ.id%MYID .OR. id%MYID.EQ.MASTER)) THEN + LPN_LIST = N + ENDIF + ALLOCATE( id%PIVNUL_LIST(LPN_LIST),stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=LPN_LIST + END IF + id%PIVNUL_LIST(1:LPN_LIST) = 0 + KEEP(109) = 0 + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).lt.0 ) GOTO 530 + IF ((KEEP(19).EQ.0).AND.(KEEP(110).EQ.0)) THEN + IF (id%MYID .EQ. MASTER) CNTL4 = id%CNTL(4) + CALL MPI_BCAST( CNTL4, 1, MPI_REAL, + & MASTER, id%COMM, IERR ) + IF ( CNTL4 .GE. ZERO ) THEN + KEEP(97) = 1 + IF ( CNTL4 .EQ. ZERO ) THEN + IF(ANORMINF .EQ. ZERO) THEN + CALL SMUMPS_27( id , ANORMINF, LSCAL ) + ENDIF + SEUIL = sqrt(EPS) * ANORMINF + ELSE + SEUIL = CNTL4 + ENDIF + SEUIL_LDLT_NIV2 = SEUIL + ELSE + SEUIL = ZERO + ENDIF + ENDIF + KEEP(98) = 0 + KEEP(103) = 0 + KEEP(105) = 0 + MAXS = 1_8 + IF ( id%MYID.EQ.MASTER ) THEN + ITMP = ICNTL(23) + END IF + CALL MPI_BCAST( ITMP, 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (WK_USER_PROVIDED) ITMP = 0 + ITMP8 = int(ITMP, 8) + KEEP8(4) = ITMP8 * 1000000_8 + PERLU = KEEP(12) + IF (KEEP(201) .EQ. 0) THEN + MAXS_BASE8=KEEP8(12) + ELSE + MAXS_BASE8=KEEP8(14) + ENDIF + IF (WK_USER_PROVIDED) THEN + MAXS = KEEP8(24) + ELSE + IF ( MAXS_BASE8 .GT. 0_8 ) THEN + MAXS_BASE_RELAXED8 = + & MAXS_BASE8 + int(PERLU,8) * ( MAXS_BASE8 / 100_8 + 1_8) + IF (MAXS_BASE_RELAXED8 > huge(MAXS)) THEN + WRITE(*,*) "Internal error: I8 overflow" + CALL MUMPS_ABORT() + ENDIF + MAXS_BASE_RELAXED8 = max(MAXS_BASE_RELAXED8, 1_8) + MAXS = MAXS_BASE_RELAXED8 + ELSE + MAXS = 1_8 + MAXS_BASE_RELAXED8 = 1_8 + END IF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1) .LT. 0) THEN + GOTO 530 + ENDIF + IF ((.NOT.WK_USER_PROVIDED).AND.(I_AM_SLAVE)) THEN + IF (KEEP(96).GT.0) THEN + MAXS=int(KEEP(96),8) + ELSE + IF (KEEP8(4) .NE. 0_8) THEN + PERLU_ON = .TRUE. + CALL SMUMPS_214( id%KEEP(1), id%KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., KEEP(201), + & PERLU_ON, TOTAL_BYTES) + MAXS_BASE_RELAXED8=MAXS_BASE_RELAXED8 + + & (KEEP8(4)-TOTAL_BYTES)/int(KEEP(35),8) + IF (MAXS_BASE_RELAXED8 > int(huge(MAXS),8)) THEN + WRITE(*,*) "Internal error: I8 overflow" + CALL MUMPS_ABORT() + ELSE IF (MAXS_BASE_RELAXED8 .LE. 0_8) THEN + id%INFO(1)=-9 + IF ( -MAXS_BASE_RELAXED8 .GT. + & int(huge(id%INFO(1)),8) ) THEN + WRITE(*,*) "I8: OVERFLOW" + CALL MUMPS_ABORT() + ENDIF + id%INFO(2)=-int(MAXS_BASE_RELAXED8,4) + ELSE + MAXS=MAXS_BASE_RELAXED8 + ENDIF + ENDIF + ENDIF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1) .LT. 0) THEN + GOTO 530 + ENDIF + CALL SMUMPS_713(PROKG, MPG, MAXS, id%NSLAVES, + & id%COMM, "effective relaxed size of S =") + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (id%INFO(1) .LT. 0) THEN + GOTO 530 + ENDIF + IF ( I_AM_SLAVE ) THEN + CALL SMUMPS_188( dble(id%COST_SUBTREES), + & KEEP(64), KEEP(66),MAXS ) + K28=KEEP(28) + MEMORY_MD_ARG = min(int(PERLU,8) * ( MAXS_BASE8 / 100_8 + 1_8 ), + & max(0_8, MAXS-MAXS_BASE8)) + CALL SMUMPS_185( id, MEMORY_MD_ARG, MAXS ) + CALL SMUMPS_587(id, IERR) + IF (IERR < 0) THEN + INFO(1) = -90 + INFO(2) = 0 + GOTO 112 + ENDIF + IF (KEEP(201) .GT. 0) THEN + IF (KEEP(201).EQ.1 + & .AND.KEEP(50).EQ.0 + & .AND.KEEP(251).NE.2 + & ) THEN + OOC_NB_FILE_TYPE=2 + ELSE + OOC_NB_FILE_TYPE=1 + ENDIF + IF (KEEP(205) .GT. 0) THEN + KEEP(100) = KEEP(205) + ELSE + IF (KEEP(201).EQ.1) THEN + I8TMP = int(OOC_NB_FILE_TYPE,8) * 2_8 * int(KEEP(226),8) + ELSE + I8TMP = 2_8 * KEEP8(119) + ENDIF + I8TMP = I8TMP + int(max(KEEP(12),0),8) * + & (I8TMP/100_8+1_8) + I8TMP = min(I8TMP, 12000000_8) + KEEP(100)=int(I8TMP) + ENDIF + IF (KEEP(201).EQ.1) THEN + IF ( KEEP(99) < 3 ) THEN + KEEP(99) = KEEP(99) + 3 + ENDIF + IF (id%MYID_NODES .eq. MASTER) THEN + write(6,*) ' PANEL: INIT and force STRAT_IO= ', + & id%KEEP(99) + ENDIF + ENDIF + IF (KEEP(99) .LT.3) KEEP(100)=0 + IF((dble(KEEP(100))*dble(KEEP(35))/dble(2)).GT. + & (dble(1999999999)))THEN + IF (PROKG) THEN + WRITE(MPG,*)id%MYID,': Warning: DIM_BUF_IO might be + & too big for Filesystem' + ENDIF + ENDIF + ALLOCATE (id%OOC_INODE_SEQUENCE(KEEP(28), + & OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE*KEEP(28) + NULLIFY(id%OOC_INODE_SEQUENCE) + GOTO 112 + ENDIF + ALLOCATE (id%OOC_TOTAL_NB_NODES(OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE + NULLIFY(id%OOC_TOTAL_NB_NODES) + GOTO 112 + ENDIF + ALLOCATE (id%OOC_SIZE_OF_BLOCK(KEEP(28), + & OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE*KEEP(28) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + GOTO 112 + ENDIF + ALLOCATE (id%OOC_VADDR(KEEP(28),OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE*KEEP(28) + NULLIFY(id%OOC_VADDR) + GOTO 112 + ENDIF + ENDIF + ENDIF + 112 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1) < 0) THEN + GOTO 513 + ENDIF + IF (I_AM_SLAVE) THEN + IF (KEEP(201) .GT. 0) THEN + IF ((KEEP(201).EQ.1).OR.(KEEP(201).EQ.2)) THEN + CALL SMUMPS_575(id,MAXS) + ELSE + WRITE(*,*) "Internal error in SMUMPS_142" + CALL MUMPS_ABORT() + ENDIF + IF(INFO(1).LT.0)THEN + GOTO 111 + ENDIF + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + CALL SMUMPS_190(0,.FALSE.,dble(id%COST_SUBTREES), + & id%KEEP(1),id%KEEP8(1)) +#endif + IF (INFO(1).LT.0) GOTO 111 +#if defined(stephinfo) + write(*,*) 'proc ',id%MYID,' array of dist : ', + & id%MEM_DIST(0:id%NSLAVES - 1) +#endif + END IF + IF ( associated (id%S) ) THEN + DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF +#if defined (LARGEMATRICES) + IF ( id%MYID .ne. MASTER ) THEN +#endif + IF (.NOT.WK_USER_PROVIDED) THEN + ALLOCATE (id%S(MAXS),stat=IERR) + KEEP8(23) = MAXS + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + CALL MUMPS_735(MAXS, INFO(2)) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + ELSE + id%S => id%WK_USER(1:KEEP8(24)) + ENDIF +#if defined (LARGEMATRICES) + END IF +#endif + 111 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( KEEP(55) .eq. 0 ) THEN + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + IF ( I_AM_SLAVE .and. KEEP(13) .ne. 0 ) THEN + ALLOCATE( id%DBLARR( KEEP(13) ), stat = IERR ) + ELSE + ALLOCATE( id%DBLARR( 1 ), stat =IERR ) + END IF + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID, + & ':Error allocating DBLARR : IERR = ', IERR + INFO(1)=-13 + INFO(2)=KEEP(13) + NULLIFY(id%DBLARR) + GOTO 100 + END IF + ELSE + IF ( associated( id%INTARR ) ) THEN + DEALLOCATE( id%INTARR ) + NULLIFY( id%INTARR ) + END IF + IF ( I_AM_SLAVE .and. KEEP(14) .ne. 0 ) THEN + ALLOCATE( id%INTARR( KEEP(14) ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = KEEP(14) + NULLIFY(id%INTARR) + GOTO 100 + END IF + ELSE + ALLOCATE( id%INTARR(1),stat=allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 1 + NULLIFY(id%INTARR) + GOTO 100 + END IF + END IF + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + IF ( I_AM_SLAVE ) THEN + IF ( id%MYID_NODES .eq. MASTER + & .AND. KEEP(46) .eq. 1 + & .AND. KEEP(52) .eq. 0 ) THEN + id%DBLARR => id%A_ELT + ELSE + IF ( KEEP(13) .ne. 0 ) THEN + ALLOCATE( id%DBLARR( KEEP(13) ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = KEEP(13) + NULLIFY(id%DBLARR) + GOTO 100 + END IF + ELSE + ALLOCATE( id%DBLARR(1), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 1 + NULLIFY(id%DBLARR) + GOTO 100 + END IF + END IF + END IF + ELSE + ALLOCATE( id%DBLARR(1), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 1 + NULLIFY(id%DBLARR) + GOTO 100 + END IF + END IF + END IF + IF ( KEEP(38).NE.0 .AND. I_AM_SLAVE ) THEN + CALL SMUMPS_165( id%N, + & id%root, id%FILS(1), KEEP(38), id%KEEP(1), id%INFO(1) ) + END IF + 100 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( KEEP( 55 ) .eq. 0 ) THEN + IF (KEEP(38).NE.0 .AND. I_AM_SLAVE) THEN + LWK = numroc( id%root%ROOT_SIZE, id%root%MBLOCK, + & id%root%MYROW, 0, id%root%NPROW ) + LWK = max( 1, LWK ) + LWK = LWK* + & numroc( id%root%ROOT_SIZE, id%root%NBLOCK, + & id%root%MYCOL, 0, id%root%NPCOL ) + LWK = max( 1, LWK ) + ELSE + LWK = 1 + ENDIF + IF (MAXS .LT. int(LWK,8)) THEN + INFO(1) = -9 + INFO(2) = LWK + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( KEEP(54) .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + ALLOCATE(IWK(id%N), stat=allocok) + IF ( allocok .NE. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + END IF +#if defined(LARGEMATRICES) + IF ( associated (id%S) ) THEN + DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + ALLOCATE (WK(LWK),stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LWK + write(6,*) ' PB1 ALLOC LARGEMAT' + ENDIF +#endif + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( id%MYID .eq. MASTER ) THEN + IF (PROKG ) THEN + CALL MUMPS_291(TIME) + END IF + IF ( .not. associated( id%INTARR ) ) THEN + ALLOCATE( id%INTARR( 1 ) ) + ENDIF +#if defined(LARGEMATRICES) + CALL SMUMPS_148(id%N, NZ, id%A(1), + & id%IRN(1), id%JCN(1), id%SYM_PERM(1), + & LSCAL, id%COLSCA(1), id%ROWSCA(1), + & id%MYID, id%NSLAVES, id%PROCNODE_STEPS(1), + & min(KEEP(39),id%NZ), + & LP, id%COMM, id%root, KEEP,KEEP8, + & id%FILS(1), IWK(1), + & + & id%INTARR(1), id%DBLARR(1), + & id%PTRAR(1), id%PTRAR(id%N+1), + & id%FRERE_STEPS(1), id%STEP(1), WK(1), int(LWK,8), + & id%ISTEP_TO_INIV2, id%I_AM_CAND, + & id%CANDIDATES) + write(6,*) '!!! A,IRN,JCN are freed during facto ' + DEALLOCATE (id%A) + NULLIFY(id%A) + DEALLOCATE (id%IRN) + NULLIFY (id%IRN) + DEALLOCATE (id%JCN) + NULLIFY (id%JCN) + IF (.NOT.WK_USER_PROVIDED) THEN + ALLOCATE (id%S(MAXS),stat=IERR) + KEEP8(23) = MAXS + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = MAXS + NULLIFY(id%S) + KEEP8(23)=0_8 + write(6,*) ' PB2 ALLOC LARGEMAT',MAXS + CALL MUMPS_ABORT() + ENDIF + ELSE + id%S => id%WK_USER(1:KEEP8(24)) + ENDIF + id%S(MAXS-LWK+1:MAXS) = WK(1:LWK) + DEALLOCATE (WK) +#else + CALL SMUMPS_148(id%N, NZ, id%A(1), + & id%IRN(1), id%JCN(1), id%SYM_PERM(1), + & LSCAL, id%COLSCA(1), id%ROWSCA(1), + & id%MYID, id%NSLAVES, id%PROCNODE_STEPS(1), + & min(KEEP(39),id%NZ), + & LP, id%COMM, id%root, KEEP(1),KEEP8(1), + & id%FILS(1), IWK(1), + & + & id%INTARR(1), id%DBLARR(1), + & id%PTRAR(1), id%PTRAR(id%N+1), + & id%FRERE_STEPS(1), id%STEP(1), id%S(1), MAXS, + & id%ISTEP_TO_INIV2(1), id%I_AM_CAND(1), + & id%CANDIDATES(1,1) ) +#endif + DEALLOCATE(IWK) + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,160) TIME + CALL MUMPS_291(TIME) + END IF + ELSE + CALL SMUMPS_145( id%N, + & id%DBLARR( 1 ), max(1,KEEP( 13 )), + & id%INTARR( 1 ), max(1,KEEP( 14 )), + & id%PTRAR( 1 ), + & id%PTRAR(id%N+1), + & KEEP( 1 ), KEEP8(1), id%MYID, id%COMM, + & min(id%KEEP(39),id%NZ), + & + & id%S(1), MAXS, + & id%root, + & id%PROCNODE_STEPS(1), id%NSLAVES, + & id%SYM_PERM(1), id%FRERE_STEPS(1), id%STEP(1), + & id%INFO(1), id%INFO(2) ) + ENDIF + ELSE + IF (PROKG ) THEN + CALL MUMPS_291(TIME) + END IF + IF ( I_AM_SLAVE ) THEN + NZ_locMAX = 0 + CALL MPI_ALLREDUCE(id%NZ_loc, NZ_locMAX, 1, MPI_INTEGER, + & MPI_MAX, id%COMM_NODES, IERR) + CALL SMUMPS_282( id%N, + & id%NZ_loc, + & id, + & id%DBLARR(1), KEEP(13), id%INTARR(1), + & KEEP(14), id%PTRAR(1), id%PTRAR(id%N+1), + & KEEP(1), KEEP8(1), id%MYID_NODES, + & id%COMM_NODES, min(id%KEEP(39),NZ_locMAX), + & id%S(1), MAXS, id%root, id%PROCNODE_STEPS(1), + & id%NSLAVES, id%SYM_PERM(1), id%STEP(1), + & id%ICNTL(1), id%INFO(1), NSEND, NLOCAL, + & id%ISTEP_TO_INIV2(1), + & id%CANDIDATES(1,1) ) + IF ( ( KEEP(52).EQ.7 ).OR. (KEEP(52).EQ.8) ) THEN + IF ( id%MYID > 0 ) THEN + IF (associated(id%ROWSCA)) THEN + DEALLOCATE(id%ROWSCA) + NULLIFY(id%ROWSCA) + ENDIF + IF (associated(id%COLSCA)) THEN + DEALLOCATE(id%COLSCA) + NULLIFY(id%COLSCA) + ENDIF + ENDIF + ENDIF +#if defined(LARGEMATRICES) + IF (associated(id%IRN_loc)) THEN + DEALLOCATE(id%IRN_loc) + NULLIFY(id%IRN_loc) + ENDIF + IF (associated(id%JCN_loc)) THEN + DEALLOCATE(id%JCN_loc) + NULLIFY(id%JCN_loc) + ENDIF + IF (associated(id%A_loc)) THEN + DEALLOCATE(id%A_loc) + NULLIFY(id%A_loc) + ENDIF + write(6,*) ' Warning :', + & ' id%A_loc, IRN_loc, JCN_loc deallocated !!! ' +#endif + IF (PROK) THEN + WRITE(MP,120) NLOCAL, NSEND + END IF + END IF + IF ( KEEP(46) .eq. 0 .AND. id%MYID.eq.MASTER ) THEN + NSEND = 0 + NLOCAL = 0 + END IF + CALL MPI_REDUCE( NSEND, NSEND_TOT, 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR ) + CALL MPI_REDUCE( NLOCAL, NLOCAL_TOT, 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR ) + IF ( PROKG ) THEN + WRITE(MPG,125) NLOCAL_TOT, NSEND_TOT + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 500 + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,160) TIME + CALL MUMPS_291(TIME) + END IF + END IF + ELSE + IF (PROKG ) THEN + CALL MUMPS_291(TIME) + END IF + IF ( id%MYID.eq.MASTER) + &CALL SMUMPS_213( id%ELTPTR(1), + & id%NELT, + & MAXELT_SIZE ) + CALL SMUMPS_126( id%N, id%NELT, id%NA_ELT, + & id%COMM, id%MYID, + & id%NSLAVES, id%PTRAR(1), + & id%PTRAR(id%NELT+2), + & id%INTARR(1), id%DBLARR(1), + & id%KEEP(1), id%KEEP8(1), MAXELT_SIZE, + & id%FRTPTR(1), id%FRTELT(1), + & id%S(1), MAXS, id%FILS(1), + & id, id%root ) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 500 + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,160) TIME + CALL MUMPS_291(TIME) + END IF + END IF + IF ( I_AM_SLAVE ) THEN + CALL SMUMPS_528(id%MYID_NODES) + SMUMPS_LBUFR_BYTES = KEEP( 44 ) * KEEP( 35 ) + SMUMPS_LBUFR_BYTES = max( SMUMPS_LBUFR_BYTES, + & 100000 ) + PERLU = KEEP( 12 ) + IF (KEEP(48).EQ.5) THEN + MIN_PERLU=2 + ELSE + MIN_PERLU=0 + ENDIF + SMUMPS_LBUFR_BYTES = SMUMPS_LBUFR_BYTES + & + int( 2.0E0 * real(max(PERLU,MIN_PERLU))* + & real(SMUMPS_LBUFR_BYTES)/100E0) + IF (KEEP(48)==5) THEN + KEEP8(21) = KEEP8(22) + int( real(max(PERLU,MIN_PERLU))* + & real(KEEP8(22))/100E0,8) + ENDIF + SMUMPS_LBUF = int( real(KEEP(213)) / 100.0E0 * + & real(KEEP(43)) * real(KEEP(35)) ) + SMUMPS_LBUF = max( SMUMPS_LBUF, 100000 ) + SMUMPS_LBUF = SMUMPS_LBUF + & + int( 2.0E0 * real(max(PERLU,MIN_PERLU))* + & real(SMUMPS_LBUF)/100E0) + SMUMPS_LBUF = max(SMUMPS_LBUF, SMUMPS_LBUFR_BYTES+3*KEEP(34)) + IF(id%KEEP(48).EQ.4)THEN + SMUMPS_LBUFR_BYTES=SMUMPS_LBUFR_BYTES*5 + SMUMPS_LBUF=SMUMPS_LBUF*5 + ENDIF + SMUMPS_LBUF_INT = ( KEEP(56) + id%NSLAVES * id%NSLAVES ) * 5 + & * KEEP(34) + IF ( KEEP( 38 ) .NE. 0 ) THEN + KKKK = MUMPS_275( id%PROCNODE_STEPS(id%STEP(KEEP(38))), + & id%NSLAVES ) + IF ( KKKK .EQ. id%MYID_NODES ) THEN + SMUMPS_LBUF_INT = SMUMPS_LBUF_INT + + & 10 * + & 2 * ( id%NE_STEPS(id%STEP(KEEP(38))) + 1 ) * id%NSLAVES + & * KEEP(34) + END IF + END IF + IF ( MP .GT. 0 ) THEN + WRITE( MP, 9999 ) SMUMPS_LBUFR_BYTES, + & SMUMPS_LBUF, SMUMPS_LBUF_INT + END IF + 9999 FORMAT( /,' Allocated buffers',/,' ------------------',/, + & ' Size of reception buffer in bytes ...... = ', I10, + & /, + & ' Size of async. emission buffer (bytes).. = ', I10,/, + & ' Small emission buffer (bytes) .......... = ', I10) + CALL SMUMPS_55( SMUMPS_LBUF_INT, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID, + & ':Error allocating small Send buffer:IERR=' + & ,IERR + INFO(1)= -13 + INFO(2)= (SMUMPS_LBUF_INT+KEEP(34)-1)/KEEP(34) + GO TO 110 + END IF + CALL SMUMPS_53( SMUMPS_LBUF, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating Send buffer:IERR=' + & ,IERR + INFO(1)= -13 + INFO(2)= (SMUMPS_LBUF+KEEP(34)-1)/KEEP(34) + GO TO 110 + END IF + id%LBUFR_BYTES = SMUMPS_LBUFR_BYTES + id%LBUFR = (SMUMPS_LBUFR_BYTES+KEEP(34)-1)/KEEP(34) + IF (associated(id%BUFR)) DEALLOCATE(id%BUFR) + ALLOCATE( id%BUFR( id%LBUFR ),stat=IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating BUFR:IERR=' + & ,IERR + INFO(1)=-13 + INFO(2)=id%LBUFR + NULLIFY(id%BUFR) + GO TO 110 + END IF + PERLU = KEEP( 12 ) + IF (KEEP(201).GT.0) THEN + MAXIS_ESTIM = KEEP(225) + ELSE + MAXIS_ESTIM = KEEP(15) + ENDIF + MAXIS = max( 1, + & MAXIS_ESTIM + 2 * max(PERLU,10) * + & ( MAXIS_ESTIM / 100 + 1 ) + & ) + IF (associated(id%IS)) DEALLOCATE( id%IS ) + ALLOCATE( id%IS( MAXIS ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating IS:IERR=',IERR + INFO(1)=-13 + INFO(2)=MAXIS + NULLIFY(id%IS) + GO TO 110 + END IF + LIW = MAXIS + IF (associated( id%PTLUST_S )) DEALLOCATE(id%PTLUST_S) + ALLOCATE( id%PTLUST_S( id%KEEP(28) ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocatingPTLUST:IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=id%KEEP(28) + NULLIFY(id%PTLUST_S) + GOTO 100 + END IF + IF (associated( id%PTRFAC )) DEALLOCATE(id%PTRFAC) + ALLOCATE( id%PTRFAC( id%KEEP(28) ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocatingPTRFAC:IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=id%KEEP(28) + NULLIFY(id%PTRFAC) + GOTO 100 + END IF + PTRIST = 1 + PTRWB = PTRIST + id%KEEP(28) + ITLOC = PTRWB + 3 * id%KEEP(28) + IPOOL = ITLOC + id%N + id%KEEP(253) + LPOOL = SMUMPS_505(id%KEEP(1),id%KEEP8(1)) + ALLOCATE( IWK( IPOOL + LPOOL - 1 ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating IWK : IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=IPOOL + LPOOL - 1 + GOTO 110 + END IF + ALLOCATE(IWK8( 2 * id%KEEP(28)), stat = IERR) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating IWK : IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=2 * id%KEEP(28) + GOTO 110 + END IF + ENDIF + 110 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 500 + IF ( I_AM_SLAVE ) THEN + CALL SMUMPS_60( id%LBUFR_BYTES ) + IF (MP .GT. 0) THEN + WRITE( MP, 170 ) MAXS, MAXIS, KEEP8(12), KEEP(15), KEEP(13), + & KEEP(14), KEEP8(11), KEEP(26), KEEP(27) + ENDIF + END IF + PERLU_ON = .TRUE. + CALL SMUMPS_214( id%KEEP(1), id%KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., id%KEEP(201), + & PERLU_ON, TOTAL_BYTES) + id%INFO(16) = TOTAL_MBYTES + IF ( MP .gt. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' ** Space in MBYTES used during factorization :', + & id%INFO(16) + END IF + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(16), id%INFOG(18), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Memory relaxation parameter ( ICNTL(14) ) :', + & KEEP(12) + WRITE( MPG,'(A,I10) ') + & ' ** Rank of processor needing largest memory in facto :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Space in MBYTES used by this processor for facto :', + & id%INFOG(18) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during facto :', + & ( id%INFOG(19)-id%INFO(16) ) / id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during facto :', + & id%INFOG(19) / id%NSLAVES + END IF + END IF + KEEP8(31)= 0_8 + KEEP8(10) = 0_8 + KEEP8(8)=0_8 + INFO(9:14)=0 + RINFO(2:3)=ZERO + IF ( I_AM_SLAVE ) THEN + IF ( KEEP(55) .eq. 0 ) THEN + LDPTRAR = id%N + ELSE + LDPTRAR = id%NELT + 1 + END IF + IF ( id%KEEP(55) .NE. 0 ) THEN + NELT = id%NELT + ELSE + NELT = 1 + END IF + CALL SMUMPS_244( id%N, NSTEPS, id%S(1), + & MAXS, id%IS( 1 ), LIW, + & id%SYM_PERM(1), id%NA(1), id%LNA, id%NE_STEPS(1), + & id%ND_STEPS(1), id%FILS(1), id%STEP(1), + & id%FRERE_STEPS(1), id%DAD_STEPS(1), id%CANDIDATES(1,1), + & id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & id%PTRAR(1), LDPTRAR, IWK( PTRIST ), + & id%PTLUST_S(1), id%PTRFAC(1), IWK( PTRWB ), + & IWK8, + & IWK( ITLOC ), RHS_MUMPS(1), IWK( IPOOL ), LPOOL, + & CNTL1, ICNTL(1), INFO(1), RINFO(1), KEEP(1),KEEP8(1), + & id%PROCNODE_STEPS(1), + & id%NSLAVES, id%COMM_NODES, + & id%MYID, id%MYID_NODES, + & id%BUFR(1),id%LBUFR,id%LBUFR_BYTES, + & id%INTARR(1), id%DBLARR(1), id%root, + & NELT, id%FRTPTR(1), + & id%FRTELT(1), id%COMM_LOAD, id%ASS_IRECV, SEUIL, + & SEUIL_LDLT_NIV2, id%MEM_DIST(0), + & id%DKEEP(1),id%PIVNUL_LIST(1),LPN_LIST) + IF ( MP . GT. 0 .and. KEEP(38) .ne. 0 ) THEN + WRITE( MP, 175 ) KEEP(49) + END IF + DEALLOCATE( IWK ) + DEALLOCATE( IWK8 ) + ENDIF + IF ( KEEP(55) .eq. 0 ) THEN + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + ELSE + DEALLOCATE( id%INTARR) + NULLIFY( id%INTARR ) + IF ( id%MYID_NODES .eq. MASTER + & .AND. KEEP(46) .eq. 1 + & .AND. KEEP(52) .eq. 0 ) THEN + NULLIFY( id%DBLARR ) + ELSE + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + END IF + END IF + IF ( KEEP(19) .NE. 0 ) THEN + IF ( KEEP(46) .NE. 1 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_RECV( KEEP(17), 1, MPI_INTEGER, 1, DEFIC_TAG, + & id%COMM, STATUS, IERR ) + ELSE IF ( id%MYID .EQ. 1 ) THEN + CALL MPI_SEND( KEEP(17), 1, MPI_INTEGER, 0, DEFIC_TAG, + & id%COMM, IERR ) + END IF + END IF + END IF + IF (associated(id%BUFR)) THEN + DEALLOCATE(id%BUFR) + NULLIFY(id%BUFR) + END IF + CALL SMUMPS_57( IERR ) + CALL SMUMPS_59( IERR ) + IF (KEEP(219).NE.0) THEN + CALL SMUMPS_620() + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + CALL SMUMPS_770(id) + IF (KEEP(201) .GT. 0) THEN + IF ((KEEP(201).EQ.1) .OR. (KEEP(201).EQ.2)) THEN + IF ( I_AM_SLAVE ) THEN + CALL SMUMPS_591(IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + ENDIF + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + END IF + END IF + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,180) TIME + END IF + PERLU_ON = .TRUE. + CALL SMUMPS_214( id%KEEP(1),id%KEEP8(1), + & id%MYID, N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .TRUE., id%KEEP(201), + & PERLU_ON, TOTAL_BYTES) + KEEP8(7) = TOTAL_BYTES + id%INFO(22) = TOTAL_MBYTES + IF ( MP .gt. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' ** Effective minimum Space in MBYTES for facto :', + & TOTAL_MBYTES + ENDIF + IF (I_AM_SLAVE) THEN + K67 = KEEP8(67) + ELSE + K67 = 0_8 + ENDIF + CALL MUMPS_735(K67,id%INFO(21)) + CALL SMUMPS_713(PROKG, MPG, K67, id%NSLAVES, + & id%COMM, "effective space used in S (KEEP8(67) =") + CALL MUMPS_243( id%MYID, id%COMM, + & TOTAL_MBYTES, id%INFOG(21), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Rank of processor needing largest memory :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Space in MBYTES used by this processor :', + & id%INFOG(21) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Avg. Space in MBYTES per working proc :', + & ( id%INFOG(22)-TOTAL_MBYTES ) / id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Avg. Space in MBYTES per working proc :', + & id%INFOG(22) / id%NSLAVES + END IF + END IF + KEEP(33) = INFO(11) + CALL MPI_REDUCE( RINFO(2), RINFOG(2), 2, + & MPI_REAL, + & MPI_SUM, MASTER, id%COMM, IERR) + KEEP(247) = 0 + CALL MPI_REDUCE( KEEP(246), KEEP(247), 1, MPI_INTEGER, + & MPI_MAX, MASTER, id%COMM, IERR) + CALL MPI_REDUCE( RINFO(2), RINFOG(2), 2, + & MPI_REAL, + & MPI_SUM, MASTER, id%COMM, IERR) + CALL MUMPS_646( KEEP8(31),KEEP8(6), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735(KEEP8(6), INFOG(9)) + CALL MPI_REDUCE( INFO(10), INFOG(10), 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + CALL MPI_ALLREDUCE( INFO(11), INFOG(11), 1, MPI_INTEGER, + & MPI_MAX, id%COMM, IERR) + KEEP(133) = INFOG(11) + CALL MPI_REDUCE( INFO(12), INFOG(12), 3, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + CALL MPI_REDUCE( KEEP(103), INFOG(25), 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + KEEP(229) = INFOG(25) + CALL MPI_REDUCE( KEEP(105), INFOG(25), 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + KEEP(230) = INFOG(25) + INFO(25) = KEEP(98) + CALL MPI_ALLREDUCE( INFO(25), INFOG(25), 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR) + CALL MUMPS_646( KEEP8(8), KEEP8(108), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735(KEEP8(10), INFO(27)) + CALL MUMPS_646( KEEP8(10),KEEP8(110), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735(KEEP8(110), INFOG(29)) + IF (KEEP(258).NE.0) THEN + RINFOG(13)=0.0E0 + IF (KEEP(260).EQ.-1) THEN + id%DKEEP(6)=-id%DKEEP(6) + ENDIF + CALL SMUMPS_764( + & id%COMM, id%DKEEP(6), KEEP(259), + & RINFOG(12), INFOG(34), id%NPROCS) + IF (id%KEEP(50).EQ.0 .AND. id%MYID.EQ. MASTER) THEN + IF (id%KEEP(23).NE.0) THEN + CALL SMUMPS_767( + & RINFOG(12), id%N, + & id%STEP(1), + & id%UNS_PERM(1) ) + ENDIF + ENDIF + ENDIF + IF(KEEP(110) .EQ. 1) THEN + INFO(18) = KEEP(109) + CALL MPI_ALLREDUCE( KEEP(109), KEEP(112), 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR) + ELSE + INFO(18) = 0 + KEEP(109) = 0 + KEEP(112) = 0 + ENDIF + INFOG(28)=KEEP(112)+KEEP(17) + IF (KEEP(17) .NE. 0) THEN + IF (id%MYID .EQ. ID_ROOT) THEN + INFO(18)=INFO(18)+KEEP(17) + ENDIF + IF (ID_ROOT .EQ. MASTER) THEN + IF (id%MYID.EQ.MASTER) THEN + DO I=1, KEEP(17) + id%PIVNUL_LIST(KEEP(112)+I)=id%PIVNUL_LIST(KEEP(109)+I) + ENDDO + ENDIF + ELSE + IF (id%MYID .EQ. ID_ROOT) THEN + CALL MPI_SEND(id%PIVNUL_LIST(KEEP(109)+1), KEEP(17), + & MPI_INTEGER, MASTER, ZERO_PIV, + & id%COMM, IERR) + ELSE IF (id%MYID .EQ. MASTER) THEN + CALL MPI_RECV(id%PIVNUL_LIST(KEEP(112)+1), KEEP(17), + & MPI_INTEGER, ID_ROOT, ZERO_PIV, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + ENDIF + IF(KEEP(110) .EQ. 1) THEN + ALLOCATE(ITMP2(id%NPROCS),stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%NPROCS + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 490 + CALL MPI_GATHER ( KEEP(109),1, MPI_INTEGER, + & ITMP2(1), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + IF(id%MYID .EQ. MASTER) THEN + POSBUF = ITMP2(1)+1 + KEEP(220)=1 + DO I = 1,id%NPROCS-1 + CALL MPI_RECV(id%PIVNUL_LIST(POSBUF), ITMP2(I+1), + & MPI_INTEGER,I, + & ZERO_PIV, id%COMM, STATUS, IERR) + CALL MPI_SEND(POSBUF, 1, MPI_INTEGER, I, ZERO_PIV, + & id%COMM, IERR) + POSBUF = POSBUF + ITMP2(I+1) + ENDDO + ELSE + CALL MPI_SEND( id%PIVNUL_LIST(1), KEEP(109), MPI_INTEGER, + & MASTER,ZERO_PIV, id%COMM, IERR) + CALL MPI_RECV( KEEP(220), 1, MPI_INTEGER, MASTER, ZERO_PIV, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + 490 IF (allocated(ITMP2)) DEALLOCATE(ITMP2) + IF ( PROKG ) THEN + WRITE(MPG,99984) RINFOG(2),RINFOG(3),KEEP8(6),INFOG(10), + & INFOG(11), KEEP8(110) + IF (id%KEEP(50) == 1 .OR. id%KEEP(50) == 2) THEN + WRITE(MPG, 99987) INFOG(12) + END IF + IF (id%KEEP(50) == 0) THEN + WRITE(MPG, 99985) INFOG(12) + END IF + IF (id%KEEP(50) .NE. 1) THEN + WRITE(MPG, 99982) INFOG(13) + END IF + IF (KEEP(97) .NE. 0) THEN + WRITE(MPG, 99986) KEEP(98) + ENDIF + IF (id%KEEP(50) == 2) THEN + WRITE(MPG, 99988) KEEP(229) + WRITE(MPG, 99989) KEEP(230) + ENDIF + IF (KEEP(110) .NE.0) THEN + WRITE(MPG, 99991) KEEP(112) + ENDIF + IF ( KEEP(17) .ne. 0 ) + & WRITE(MPG, 99983) KEEP(17) + IF (KEEP(110).NE.0.OR.KEEP(17).NE.0) + & WRITE(MPG, 99992) KEEP(17)+KEEP(112) + WRITE(MPG, 99981) INFOG(14) + IF ((KEEP(201).EQ.0.OR.KEEP(201).EQ.2).AND. + & KEEP(50).EQ.0) THEN + WRITE(MPG, 99980) KEEP8(108) + ENDIF + IF ((KEEP(60).NE.0) .AND. INFOG(25).GT.0) THEN + WRITE(MPG, '(A)') + & " ** Warning Static pivoting was necessary" + WRITE(MPG, '(A)') + & " ** to factor interior variables with Schur ON" + ENDIF + IF (KEEP(258).NE.0) THEN + WRITE(MPG,99978) RINFOG(12) + WRITE(MPG,99977) INFOG(34) + ENDIF + END IF + 500 CONTINUE + IF ( I_AM_SLAVE ) THEN + IF ((KEEP(201).EQ.1).OR.(KEEP(201).EQ.2)) THEN + CALL SMUMPS_592(id,IERR) + IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR + ENDIF + IF (WK_USER_PROVIDED) THEN + NULLIFY(id%S) + ELSE IF (KEEP(201).NE.0) THEN + IF (associated(id%S)) DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + ELSE + IF (WK_USER_PROVIDED) THEN + NULLIFY(id%S) + ELSE + IF (associated(id%S)) DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + END IF + END IF + 513 CONTINUE + IF ( I_AM_SLAVE ) THEN + CALL SMUMPS_183( INFO(1), IERR ) + IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + 530 CONTINUE + IF (RHS_MUMPS_ALLOCATED) DEALLOCATE(RHS_MUMPS) + NULLIFY(RHS_MUMPS) + id%KEEP(13) = KEEP13_SAVE + RETURN + 120 FORMAT(/' LOCAL REDISTRIB: DATA LOCAL/SENT =',I12,I12) + 125 FORMAT(/' REDISTRIB: TOTAL DATA LOCAL/SENT =',I12,I12) + 130 FORMAT(/' ****** FACTORIZATION STEP ********'/) + 160 FORMAT(' GLOBAL TIME FOR MATRIX DISTRIBUTION =',F12.4) + 165 FORMAT(' Convergence error after scaling for INF-NORM', + & ' (option 7/8) =',D9.2) + 166 FORMAT(' Convergence error after scaling for ONE-NORM', + & ' (option 7/8) =',D9.2) + 170 FORMAT(/' STATISTICS PRIOR NUMERICAL FACTORIZATION ...'/ + & ' Size of internal working array S =',I12/ + & ' Size of internal working array IS =',I12/ + & ' MINIMUM (ICNTL(14)=0) size of S =',I12/ + & ' MINIMUM (ICNTL(14)=0) size of IS =',I12/ + & ' REAL SPACE FOR ORIGINAL MATRIX =',I12/ + & ' INTEGER SPACE FOR ORIGINAL MATRIX =',I12/ + & ' REAL SPACE FOR FACTORS =',I12/ + & ' INTEGER SPACE FOR FACTORS =',I12/ + & ' MAXIMUM FRONTAL SIZE (ESTIMATED) =',I12) + 172 FORMAT(/' GLOBAL STATISTICS PRIOR NUMERICAL FACTORIZATION ...'/ + & ' NUMBER OF WORKING PROCESSES =',I12/ + & ' OUT-OF-CORE OPTION (ICNTL(22)) =',I12/ + & ' REAL SPACE FOR FACTORS =',I12/ + & ' INTEGER SPACE FOR FACTORS =',I12/ + & ' MAXIMUM FRONTAL SIZE (ESTIMATED) =',I12/ + & ' NUMBER OF NODES IN THE TREE =',I12) + 173 FORMAT( ' PERFORM FORWARD DURING FACTO, NRHS =',I12) + 175 FORMAT(/' NUMBER OF ENTRIES FOR // ROOT =',I12) + 180 FORMAT(/' ELAPSED TIME FOR FACTORIZATION =',F12.4) +99977 FORMAT( ' INFOG(34) DETERMINANT (base 2 exponent) =',I12) +99978 FORMAT( ' RINFOG(12) DETERMINANT (real part) =',F12.4) +99980 FORMAT( ' KEEP8(108) Extra copies IP stacking =',I12) +99981 FORMAT( ' INFOG(14) NUMBER OF MEMORY COMPRESS =',I12) +99982 FORMAT( ' INFOG(13) NUMBER OF DELAYED PIVOTS =',I12) +99983 FORMAT( ' NB OF NULL PIVOTS DETECTED BY ICNTL(16) =',I12) +99991 FORMAT( ' NB OF NULL PIVOTS DETECTED BY ICNTL(24) =',I12) +99992 FORMAT( ' INFOG(28) ESTIMATED DEFICIENCY =',I12) +99984 FORMAT(/' GLOBAL STATISTICS '/ + & ' RINFOG(2) OPERATIONS IN NODE ASSEMBLY =',1PD10.3/ + & ' ------(3) OPERATIONS IN NODE ELIMINATION=',1PD10.3/ + & ' INFOG (9) REAL SPACE FOR FACTORS =',I12/ + & ' INFOG(10) INTEGER SPACE FOR FACTORS =',I12/ + & ' INFOG(11) MAXIMUM FRONT SIZE =',I12/ + & ' INFOG(29) NUMBER OF ENTRIES IN FACTORS =',I12) +99985 FORMAT( ' INFOG(12) NB OF OFF DIAGONAL PIVOTS =',I12) +99986 FORMAT( ' INFOG(25) NB TINY PIVOTS/STATIC PIVOTING =',I12) +99987 FORMAT( ' INFOG(12) NB OF NEGATIVE PIVOTS =',I12) +99988 FORMAT( ' NUMBER OF 2x2 PIVOTS in type 1 nodes =',I12) +99989 FORMAT( ' NUMBER OF 2x2 PIVOTS in type 2 nodes =',I12) + END SUBROUTINE SMUMPS_142 + SUBROUTINE SMUMPS_713(PROKG, MPG, VAL, NSLAVES, + & COMM, MSG) + IMPLICIT NONE + INCLUDE 'mpif.h' + LOGICAL PROKG + INTEGER MPG + INTEGER(8) VAL + INTEGER NSLAVES + INTEGER COMM + CHARACTER*42 MSG + INTEGER(8) MAX_VAL + INTEGER IERR, MASTER + REAL LOC_VAL, AVG_VAL + PARAMETER(MASTER=0) + CALL MUMPS_646( VAL, MAX_VAL, MPI_MAX, MASTER, COMM) + LOC_VAL = real(VAL)/real(NSLAVES) + CALL MPI_REDUCE( LOC_VAL, AVG_VAL, 1, MPI_REAL, + & MPI_SUM, MASTER, COMM, IERR ) + IF (PROKG) THEN + WRITE(MPG,100) " Maximum ", MSG, MAX_VAL + WRITE(MPG,100) " Average ", MSG, int(AVG_VAL,8) + ENDIF + RETURN + 100 FORMAT(A9,A42,I12) + END SUBROUTINE SMUMPS_713 + SUBROUTINE SMUMPS_770(id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(SMUMPS_STRUC) :: id + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INCLUDE 'mumps_headers.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER IERR, MASTER + PARAMETER( MASTER = 0 ) + INTEGER :: ID_SCHUR, SIZE_SCHUR, LD_SCHUR, IB, BL4 + INTEGER :: ROW_LENGTH, I + INTEGER(8) :: SURFSCHUR8, BL8, SHIFT8 + INTEGER(8) :: ISCHUR_SRC, ISCHUR_DEST, ISCHUR_SYM, ISCHUR_UNS + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + IF (id%INFO(1) .LT. 0) RETURN + IF (id%KEEP(60) .EQ. 0) RETURN + ID_SCHUR =MUMPS_275( + & id%PROCNODE_STEPS(id%STEP(max(id%KEEP(20),id%KEEP(38)))), + & id%NSLAVES) + IF ( id%KEEP( 46 ) .NE. 1 ) THEN + ID_SCHUR = ID_SCHUR + 1 + END IF + IF (id%MYID.EQ.ID_SCHUR) THEN + IF (id%KEEP(60).EQ.1) THEN + LD_SCHUR = + & id%IS(id%PTLUST_S(id%STEP(id%KEEP(20)))+2+id%KEEP(IXSZ)) + SIZE_SCHUR = LD_SCHUR - id%KEEP(253) + ELSE + LD_SCHUR = -999999 + SIZE_SCHUR = id%root%TOT_ROOT_SIZE + ENDIF + ELSE IF (id%MYID .EQ. MASTER) THEN + SIZE_SCHUR = id%KEEP(116) + LD_SCHUR = -44444 + ELSE + RETURN + ENDIF + SURFSCHUR8 = int(SIZE_SCHUR,8)*int(SIZE_SCHUR,8) + IF (id%KEEP(60) .GT. 1) THEN + IF (id%KEEP(221).EQ.1) THEN + DO I = 1, id%KEEP(253) + IF (ID_SCHUR.EQ.MASTER) THEN + CALL scopy(SIZE_SCHUR, + & id%root%RHS_CNTR_MASTER_ROOT((I-1)*SIZE_SCHUR+1), 1, + & id%REDRHS((I-1)*id%LREDRHS+1), 1) + ELSE + IF (id%MYID.EQ.ID_SCHUR) THEN + CALL MPI_SEND( + & id%root%RHS_CNTR_MASTER_ROOT((I-1)*SIZE_SCHUR+1), + & SIZE_SCHUR, + & MPI_REAL, + & MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE + CALL MPI_RECV( id%REDRHS((I-1)*id%LREDRHS+1), + & SIZE_SCHUR, + & MPI_REAL, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + ENDDO + IF (id%MYID.EQ.ID_SCHUR) THEN + DEALLOCATE(id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY (id%root%RHS_CNTR_MASTER_ROOT) + ENDIF + ENDIF + RETURN + ENDIF + IF (id%KEEP(252).EQ.0) THEN + IF ( ID_SCHUR .EQ. MASTER ) THEN + CALL SMUMPS_756( SURFSCHUR8, + & id%S(id%PTRFAC(id%STEP(id%KEEP(20)))), + & id%SCHUR(1) ) + ELSE + BL8=int(huge(BL4)/id%KEEP(35)/10,8) + DO IB=1, int((SURFSCHUR8+BL8-1_8) / BL8) + SHIFT8 = int(IB-1,8) * BL8 + BL4 = int(min(BL8,SURFSCHUR8-SHIFT8)) + IF ( id%MYID .eq. ID_SCHUR ) THEN + CALL MPI_SEND( id%S( SHIFT8 + + & id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ)))), + & BL4, + & MPI_REAL, + & MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_RECV( id%SCHUR(1_8 + SHIFT8), + & BL4, + & MPI_REAL, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + END IF + ENDDO + END IF + ELSE + ISCHUR_SRC = id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ))) + ISCHUR_DEST= 1_8 + DO I=1, SIZE_SCHUR + ROW_LENGTH = SIZE_SCHUR + IF (ID_SCHUR.EQ.MASTER) THEN + CALL scopy(ROW_LENGTH, id%S(ISCHUR_SRC), 1, + & id%SCHUR(ISCHUR_DEST),1) + ELSE + IF (id%MYID.EQ.ID_SCHUR) THEN + CALL MPI_SEND( id%S(ISCHUR_SRC), ROW_LENGTH, + & MPI_REAL, + & MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE + CALL MPI_RECV( id%SCHUR(ISCHUR_DEST), + & ROW_LENGTH, + & MPI_REAL, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + ISCHUR_SRC = ISCHUR_SRC+int(LD_SCHUR,8) + ISCHUR_DEST= ISCHUR_DEST+int(SIZE_SCHUR,8) + ENDDO + IF (id%KEEP(221).EQ.1) THEN + ISCHUR_SYM = id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ))) + int(SIZE_SCHUR,8) * + & int(LD_SCHUR,8) + ISCHUR_UNS = + & id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ))) + int(SIZE_SCHUR,8) + ISCHUR_DEST = 1_8 + DO I = 1, id%KEEP(253) + IF (ID_SCHUR .EQ. MASTER) THEN + IF (id%KEEP(50) .EQ. 0) THEN + CALL scopy(SIZE_SCHUR, id%S(ISCHUR_UNS), LD_SCHUR, + & id%REDRHS(ISCHUR_DEST), 1) + ELSE + CALL scopy(SIZE_SCHUR, id%S(ISCHUR_SYM), 1, + & id%REDRHS(ISCHUR_DEST), 1) + ENDIF + ELSE + IF (id%MYID .NE. MASTER) THEN + IF (id%KEEP(50) .EQ. 0) THEN + CALL scopy(SIZE_SCHUR, id%S(ISCHUR_UNS), LD_SCHUR, + & id%S(ISCHUR_SYM), 1) + ENDIF + CALL MPI_SEND(id%S(ISCHUR_SYM), SIZE_SCHUR, + & MPI_REAL, MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE + CALL MPI_RECV(id%REDRHS(ISCHUR_DEST), + & SIZE_SCHUR, MPI_REAL, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + IF (id%KEEP(50).EQ.0) THEN + ISCHUR_UNS = ISCHUR_UNS + int(LD_SCHUR,8) + ELSE + ISCHUR_SYM = ISCHUR_SYM + int(LD_SCHUR,8) + ENDIF + ISCHUR_DEST = ISCHUR_DEST + int(id%LREDRHS,8) + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_770 + SUBROUTINE SMUMPS_83 + & ( N, MAPPING, NZ, IRN, JCN, PROCNODE, STEP, + & SLAVEF, PERM, FILS, + & RG2L, KEEP,KEEP8, MBLOCK, NBLOCK, NPROW, NPCOL ) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N, NZ, SLAVEF, MBLOCK, NBLOCK, NPROW, NPCOL + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IRN( NZ ), JCN( NZ ) + INTEGER MAPPING( NZ ), STEP( N ) + INTEGER PROCNODE( KEEP(28) ), PERM( N ), FILS( N ), RG2L( N ) + INTEGER MUMPS_275, MUMPS_330 + EXTERNAL MUMPS_275, MUMPS_330 + INTEGER K, IOLD, JOLD, INEW, JNEW, ISEND, JSEND, IARR, INODE + INTEGER TYPE_NODE, DEST + INTEGER IPOSROOT, JPOSROOT, IROW_GRID, JCOL_GRID + INODE = KEEP(38) + K = 1 + DO WHILE ( INODE .GT. 0 ) + RG2L( INODE ) = K + INODE = FILS( INODE ) + K = K + 1 + END DO + DO K = 1, NZ + IOLD = IRN( K ) + JOLD = JCN( K ) + IF ( IOLD .GT. N .OR. IOLD .LT. 1 .OR. + & JOLD .GT. N .OR. JOLD .LT. 1 ) THEN + MAPPING( K ) = -1 + CYCLE + END IF + IF ( IOLD .eq. JOLD ) THEN + ISEND = IOLD + JSEND = JOLD + ELSE + INEW = PERM( IOLD ) + JNEW = PERM( JOLD ) + IF ( INEW .LT. JNEW ) THEN + ISEND = IOLD + IF ( KEEP(50) .ne. 0 ) ISEND = -IOLD + JSEND = JOLD + ELSE + ISEND = -JOLD + JSEND = IOLD + END IF + END IF + IARR = abs( ISEND ) + TYPE_NODE = MUMPS_330( PROCNODE(abs(STEP(IARR))), + & SLAVEF ) + IF ( TYPE_NODE .eq. 1 .or. TYPE_NODE .eq. 2 ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + DEST = MUMPS_275( PROCNODE(abs(STEP(IARR))), + & SLAVEF ) + 1 + ELSE + DEST = MUMPS_275( PROCNODE(abs(STEP(IARR))), + & SLAVEF ) + END IF + ELSE + IF ( ISEND .LT. 0 ) THEN + IPOSROOT = RG2L( JSEND ) + JPOSROOT = RG2L( IARR ) + ELSE + IPOSROOT = RG2L( IARR ) + JPOSROOT = RG2L( JSEND ) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/MBLOCK, NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/NBLOCK, NPCOL ) + IF ( KEEP( 46 ) .eq. 0 ) THEN + DEST = IROW_GRID * NPCOL + JCOL_GRID + 1 + ELSE + DEST = IROW_GRID * NPCOL + JCOL_GRID + END IF + END IF + MAPPING( K ) = DEST + END DO + RETURN + END SUBROUTINE SMUMPS_83 + SUBROUTINE SMUMPS_282( + & N, NZ_loc, id, + & DBLARR, LDBLARR, INTARR, LINTARR, + & PTRAIW, PTRARW, KEEP,KEEP8, MYID, COMM, NBRECORDS, + & + & A, LA, root, PROCNODE_STEPS, SLAVEF, PERM, STEP, + & ICNTL, INFO, NSEND, NLOCAL, + & ISTEP_TO_INIV2, CANDIDATES + & ) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N, NZ_loc + TYPE (SMUMPS_STRUC) :: id + INTEGER LDBLARR, LINTARR + REAL DBLARR( LDBLARR ) + INTEGER INTARR( LINTARR ) + INTEGER PTRAIW( N ), PTRARW( N ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER MYID, COMM, NBRECORDS + INTEGER(8) :: LA + INTEGER SLAVEF + INTEGER ISTEP_TO_INIV2(KEEP(71)) + INTEGER CANDIDATES(SLAVEF+1, max(1,KEEP(56))) + REAL A( LA ) + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER PROCNODE_STEPS(KEEP(28)), PERM( N ), STEP( N ) + INTEGER INFO( 40 ), ICNTL(40) + INTEGER MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + INCLUDE 'mumps_tags.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ), MSGSOU + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IW4 + INTEGER END_MSG_2_RECV + INTEGER I, K, I1, IA + INTEGER TYPE_NODE, DEST + INTEGER IOLD, JOLD, IARR, ISEND, JSEND, INEW, JNEW + INTEGER allocok, TYPESPLIT, T4MASTER, INIV2 + LOGICAL T4_MASTER_CONCERNED + REAL VAL + INTEGER(8) :: PTR_ROOT + INTEGER LOCAL_M, LOCAL_N, ARROW_ROOT + INTEGER IROW_GRID, JCOL_GRID, IPOSROOT, JPOSROOT + INTEGER MP,LP + INTEGER KPROBE, FREQPROBE + INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: BUFI + REAL, ALLOCATABLE, DIMENSION(:,:,:) :: BUFR + INTEGER, ALLOCATABLE, DIMENSION(:) :: BUFRECI + REAL, ALLOCATABLE, DIMENSION(:) :: BUFRECR + INTEGER IACT( SLAVEF ), IREQI( SLAVEF ), IREQR( SLAVEF ) + LOGICAL SEND_ACTIVE( SLAVEF ) + LOGICAL FLAG + INTEGER NSEND, NLOCAL + INTEGER MASTER_NODE, ISTEP + NSEND = 0 + NLOCAL = 0 + LP = ICNTL(1) + MP = ICNTL(2) + END_MSG_2_RECV = SLAVEF + ALLOCATE( BUFI( NBRECORDS * 2 + 1, 2, SLAVEF ), stat=allocok) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating int buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = ( NBRECORDS * 2 + 1 ) * SLAVEF * 2 + END IF + ALLOCATE( BUFR( NBRECORDS, 2, SLAVEF), stat = allocok) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating real buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = NBRECORDS * SLAVEF * 2 + GOTO 20 + END IF + ALLOCATE( BUFRECI( NBRECORDS * 2 + 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating int recv buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = NBRECORDS * 2 + 1 + GOTO 20 + END IF + ALLOCATE( BUFRECR( NBRECORDS ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating int recv buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = NBRECORDS + GOTO 20 + END IF + ALLOCATE( IW4( N, 2 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(LP,*) '** Error allocating IW4 for matrix distribution' + INFO(1) = -13 + INFO(2) = N * 2 + END IF + 20 CONTINUE + CALL MUMPS_276( ICNTL, INFO, COMM, MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + ARROW_ROOT = 0 + DO I = 1, N + I1 = PTRAIW( I ) + IA = PTRARW( I ) + IF ( IA .GT. 0 ) THEN + DBLARR( IA ) = ZERO + IW4( I, 1 ) = INTARR( I1 ) + IW4( I, 2 ) = -INTARR( I1 + 1 ) + INTARR( I1 + 2 ) = I + END IF + END DO + IF ( KEEP(38) .NE. 0 ) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I = 1, root%SCHUR_NLOC + root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1: + & (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC) = ZERO + ENDDO + ENDIF + END IF + DO I = 1, SLAVEF + BUFI( 1, 1, I ) = 0 + END DO + DO I = 1, SLAVEF + BUFI( 1, 2, I ) = 0 + END DO + DO I = 1, SLAVEF + SEND_ACTIVE( I ) = .FALSE. + IACT( I ) = 1 + END DO + KPROBE = 0 + FREQPROBE = max(1,NBRECORDS/10) + DO K = 1, NZ_loc + KPROBE = KPROBE + 1 + IF ( KPROBE .eq. FREQPROBE ) THEN + KPROBE = 0 + CALL MPI_IPROBE( MPI_ANY_SOURCE, ARR_INT, COMM, + & FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + MSGSOU = STATUS( MPI_SOURCE ) + CALL MPI_RECV( BUFRECI(1), NBRECORDS * 2 + 1, + & MPI_INTEGER, + & MSGSOU, ARR_INT, COMM, STATUS, IERR ) + CALL MPI_RECV( BUFRECR(1), NBRECORDS, MPI_REAL, + & MSGSOU, ARR_REAL, COMM, STATUS, IERR ) + CALL SMUMPS_102( + & BUFRECI, BUFRECR, NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END IF + END IF + IOLD = id%IRN_loc(K) + JOLD = id%JCN_loc(K) + IF ( (IOLD.GT.N).OR.(JOLD.GT.N).OR.(IOLD.LT.1) + & .OR.(JOLD.LT.1) ) CYCLE + VAL = id%A_loc(K) + IF ((KEEP(52).EQ.7).OR.(KEEP(52).EQ.8)) THEN + VAL = VAL * id%ROWSCA(IOLD)*id%COLSCA(JOLD) + ENDIF + IF (IOLD.EQ.JOLD) THEN + ISEND = IOLD + JSEND = JOLD + ELSE + INEW = PERM(IOLD) + JNEW = PERM(JOLD) + IF (INEW.LT.JNEW) THEN + ISEND = IOLD + IF ( KEEP(50) .NE. 0 ) ISEND = -IOLD + JSEND = JOLD + ELSE + ISEND = -JOLD + JSEND = IOLD + ENDIF + ENDIF + IARR = abs( ISEND ) + ISTEP = abs(STEP(IARR)) + TYPE_NODE = MUMPS_330( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + MASTER_NODE= MUMPS_275( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + TYPESPLIT = MUMPS_810( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + T4_MASTER_CONCERNED = .FALSE. + T4MASTER = -9999 + IF (TYPE_NODE.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + T4_MASTER_CONCERNED = .TRUE. + T4MASTER=CANDIDATES(CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + ENDIF + ENDIF + IF ( TYPE_NODE .eq. 1 ) THEN + DEST = MASTER_NODE + ELSE IF ( TYPE_NODE .eq. 2 ) THEN + IF ( ISEND .LT. 0 ) THEN + DEST = -1 + ELSE + DEST = MASTER_NODE + END IF + ELSE + IF ( ISEND < 0 ) THEN + IPOSROOT = root%RG2L_ROW(JSEND) + JPOSROOT = root%RG2L_ROW(IARR ) + ELSE + IPOSROOT = root%RG2L_ROW(IARR ) + JPOSROOT = root%RG2L_ROW(JSEND) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, root%NPCOL ) + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + END IF + if (DEST .eq. -1) then + NLOCAL = NLOCAL + 1 + NSEND = NSEND + SLAVEF -1 + else + if (DEST .eq.MYID ) then + NLOCAL = NLOCAL + 1 + else + NSEND = NSEND + 1 + endif + end if + IF ( DEST.EQ.-1) THEN + DO I=1, CANDIDATES(SLAVEF+1,ISTEP_TO_INIV2(ISTEP)) + DEST=CANDIDATES(I,ISTEP_TO_INIV2(ISTEP)) + CALL SMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + ENDDO + DEST=MASTER_NODE + CALL SMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + IF (T4_MASTER_CONCERNED) THEN + DEST = T4MASTER + CALL SMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + ENDIF + ELSE + CALL SMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + IF (T4_MASTER_CONCERNED) THEN + DEST = T4MASTER + CALL SMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + ENDIF + ENDIF + END DO + DEST = -2 + CALL SMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, + & IW4(1,1), root, KEEP,KEEP8 ) + DO WHILE ( END_MSG_2_RECV .NE. 0 ) + CALL MPI_RECV( BUFRECI(1), NBRECORDS * 2 + 1, MPI_INTEGER, + & MPI_ANY_SOURCE, ARR_INT, COMM, STATUS, IERR ) + MSGSOU = STATUS( MPI_SOURCE ) + CALL MPI_RECV( BUFRECR(1), NBRECORDS, MPI_REAL, + & MSGSOU, ARR_REAL, COMM, STATUS, IERR ) + CALL SMUMPS_102( + & BUFRECI, BUFRECR, NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END DO + DO I = 1, SLAVEF + IF ( SEND_ACTIVE( I ) ) THEN + CALL MPI_WAIT( IREQI( I ), STATUS, IERR ) + CALL MPI_WAIT( IREQR( I ), STATUS, IERR ) + END IF + END DO + KEEP(49) = ARROW_ROOT + DEALLOCATE( IW4 ) + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + DEALLOCATE( BUFRECI ) + DEALLOCATE( BUFRECR ) + RETURN + END SUBROUTINE SMUMPS_282 + SUBROUTINE SMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, N, + & PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4, root, + & KEEP,KEEP8 ) + IMPLICIT NONE + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER ISEND, JSEND, DEST, NBRECORDS, SLAVEF, COMM, MYID, N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER ARROW_ROOT, END_MSG_2_RECV, LOCAL_M, LOCAL_N + INTEGER LINTARR, LDBLARR + INTEGER(8) :: LA, PTR_ROOT + INTEGER BUFI( NBRECORDS * 2 + 1, 2, SLAVEF ) + INTEGER BUFRECI( NBRECORDS * 2 + 1 ) + INTEGER IREQI(SLAVEF), IREQR(SLAVEF), IACT(SLAVEF) + INTEGER IW4( N, 2 ) + INTEGER PTRAIW( N ), PTRARW( N ), PERM( N ), STEP( N ) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER INTARR( LINTARR ) + REAL DBLARR( LDBLARR ), A( LA ) + LOGICAL SEND_ACTIVE(SLAVEF) + REAL BUFR( NBRECORDS, 2, SLAVEF ) + REAL BUFRECR( NBRECORDS ) + REAL VAL + INTEGER ISLAVE, IBEG, IEND, NBREC, IREQ + INTEGER TAILLE_SEND_I, TAILLE_SEND_R, MSGSOU + LOGICAL FLAG, SEND_LOCAL + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, STATUS(MPI_STATUS_SIZE) + IF ( DEST .eq. -2 ) THEN + IBEG = 1 + IEND = SLAVEF + ELSE + IBEG = DEST + 1 + IEND = DEST + 1 + END IF + SEND_LOCAL = .FALSE. + DO ISLAVE = IBEG, IEND + NBREC = BUFI(1,IACT(ISLAVE),ISLAVE) + IF ( DEST .eq. -2 ) THEN + BUFI(1,IACT(ISLAVE),ISLAVE) = - NBREC + END IF + IF ( DEST .eq. -2 .or. NBREC + 1 > NBRECORDS ) THEN + DO WHILE ( SEND_ACTIVE( ISLAVE ) ) + CALL MPI_TEST( IREQR( ISLAVE ), FLAG, STATUS, IERR ) + IF ( .NOT. FLAG ) THEN + CALL MPI_IPROBE( MPI_ANY_SOURCE, ARR_INT, COMM, + & FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + MSGSOU = STATUS(MPI_SOURCE) + CALL MPI_RECV( BUFRECI(1), 2*NBRECORDS+1, + & MPI_INTEGER, MSGSOU, ARR_INT, COMM, + & STATUS, IERR ) + CALL MPI_RECV( BUFRECR(1), NBRECORDS, + & MPI_REAL, MSGSOU, + & ARR_REAL, COMM, STATUS, IERR ) + CALL SMUMPS_102( + & BUFRECI, BUFRECR, NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END IF + ELSE + CALL MPI_WAIT( IREQI( ISLAVE ), STATUS, IERR ) + SEND_ACTIVE( ISLAVE ) = .FALSE. + END IF + END DO + IF ( ISLAVE - 1 .ne. MYID ) THEN + TAILLE_SEND_I = NBREC * 2 + 1 + TAILLE_SEND_R = NBREC + CALL MPI_ISEND( BUFI(1, IACT(ISLAVE), ISLAVE ), + & TAILLE_SEND_I, + & MPI_INTEGER, ISLAVE - 1, ARR_INT, COMM, + & IREQI( ISLAVE ), IERR ) + CALL MPI_ISEND( BUFR(1, IACT(ISLAVE), ISLAVE ), + & TAILLE_SEND_R, + & MPI_REAL, ISLAVE - 1, ARR_REAL, COMM, + & IREQR( ISLAVE ), IERR ) + SEND_ACTIVE( ISLAVE ) = .TRUE. + ELSE + SEND_LOCAL = .TRUE. + END IF + IACT( ISLAVE ) = 3 - IACT( ISLAVE ) + BUFI( 1, IACT( ISLAVE ), ISLAVE ) = 0 + END IF + IF ( DEST .ne. -2 ) THEN + IREQ = BUFI(1,IACT(ISLAVE),ISLAVE) + 1 + BUFI(1,IACT(ISLAVE),ISLAVE) = IREQ + BUFI(IREQ*2,IACT(ISLAVE),ISLAVE) = ISEND + BUFI(IREQ*2+1,IACT(ISLAVE),ISLAVE) = JSEND + BUFR(IREQ,IACT(ISLAVE),ISLAVE ) = VAL + END IF + END DO + IF ( SEND_LOCAL ) THEN + ISLAVE = MYID + 1 + CALL SMUMPS_102( + & BUFI(1,3-IACT(ISLAVE),ISLAVE), + & BUFR(1,3-IACT(ISLAVE),ISLAVE), + & NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END IF + RETURN + END SUBROUTINE SMUMPS_101 + SUBROUTINE SMUMPS_102 + & ( BUFI, BUFR, NBRECORDS, N, IW4, + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, + & SLAVEF, ARROW_ROOT, + & PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR ) + IMPLICIT NONE + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER NBRECORDS, N, ARROW_ROOT, MYID, SLAVEF + INTEGER BUFI( NBRECORDS * 2 + 1 ) + REAL BUFR( NBRECORDS ) + INTEGER IW4( N, 2 ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER END_MSG_2_RECV + INTEGER PTRAIW( N ), PTRARW( N ), PERM( N ), STEP( N ) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER LINTARR, LDBLARR + INTEGER INTARR( LINTARR ) + INTEGER LOCAL_M, LOCAL_N + INTEGER(8) :: PTR_ROOT, LA + REAL A( LA ), DBLARR( LDBLARR ) + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER IREC, NB_REC, NODE_TYPE, IPROC + INTEGER IPOSROOT, JPOSROOT, IROW_GRID, JCOL_GRID, + & ILOCROOT, JLOCROOT + INTEGER IA, IS1, ISHIFT, IIW, IS, IAS, IARR, JARR + INTEGER TAILLE + REAL VAL + NB_REC = BUFI( 1 ) + IF ( NB_REC .LE. 0 ) THEN + END_MSG_2_RECV = END_MSG_2_RECV - 1 + NB_REC = - NB_REC + END IF + IF ( NB_REC .eq. 0 ) GOTO 100 + DO IREC = 1, NB_REC + IARR = BUFI( IREC * 2 ) + JARR = BUFI( IREC * 2 + 1 ) + VAL = BUFR( IREC ) + NODE_TYPE = MUMPS_330( + & PROCNODE_STEPS(abs(STEP(abs( IARR )))), + & SLAVEF ) + IF ( NODE_TYPE .eq. 3 ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + IF ( IARR .GT. 0 ) THEN + IPOSROOT = root%RG2L_ROW( IARR ) + JPOSROOT = root%RG2L_COL( JARR ) + ELSE + IPOSROOT = root%RG2L_ROW( JARR ) + JPOSROOT = root%RG2L_COL( -IARR ) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, root%NPCOL ) + IF ( IROW_GRID .NE. root%MYROW .OR. + & JCOL_GRID .NE. root%MYCOL ) THEN + WRITE(*,*) MYID,':INTERNAL Error: recvd root arrowhead ' + WRITE(*,*) MYID,':not belonging to me. IARR,JARR=',IARR,JARR + WRITE(*,*) MYID,':IROW_GRID,JCOL_GRID=',IROW_GRID,JCOL_GRID + WRITE(*,*) MYID,':MYROW, MYCOL=', root%MYROW, root%MYCOL + WRITE(*,*) MYID,':IPOSROOT,JPOSROOT=', IPOSROOT, JPOSROOT + CALL MUMPS_ABORT() + END IF + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8) + & + int(ILOCROOT-1,8)) = A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + ELSE IF (IARR.GE.0) THEN + IF (IARR.EQ.JARR) THEN + IA = PTRARW(IARR) + DBLARR(IA) = DBLARR(IA) + VAL + ELSE + IS1 = PTRAIW(IARR) + ISHIFT = INTARR(IS1) + IW4(IARR,2) + IW4(IARR,2) = IW4(IARR,2) - 1 + IIW = IS1 + ISHIFT + 2 + INTARR(IIW) = JARR + IS = PTRARW(IARR) + IAS = IS + ISHIFT + DBLARR(IAS) = VAL + ENDIF + ELSE + IARR = -IARR + ISHIFT = PTRAIW(IARR)+IW4(IARR,1)+2 + INTARR(ISHIFT) = JARR + IAS = PTRARW(IARR)+IW4(IARR,1) + IW4(IARR,1) = IW4(IARR,1) - 1 + DBLARR(IAS) = VAL + IPROC = MUMPS_275( PROCNODE_STEPS(abs(STEP(IARR))), + & SLAVEF ) + IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0) + & .AND. + & IW4(IARR,1) .EQ. 0 .AND. + & IPROC .EQ. MYID + & .AND. STEP(IARR) > 0 ) THEN + TAILLE = INTARR( PTRAIW(IARR) ) + CALL SMUMPS_310( N, PERM, + & INTARR( PTRAIW(IARR) + 3 ), + & DBLARR( PTRARW(IARR) + 1 ), + & TAILLE, 1, TAILLE ) + END IF + ENDIF + ENDDO + 100 CONTINUE + RETURN + END SUBROUTINE SMUMPS_102 + SUBROUTINE SMUMPS_151( NRHS, N, KEEP28, IWCB, LIWW, + & W, LWC, + & POSWCB,IWPOSCB,PTRICB,PTRACB) + IMPLICIT NONE + INTEGER NRHS, N,LIWW,LWC,POSWCB,IWPOSCB, KEEP28 + INTEGER IWCB(LIWW),PTRICB(KEEP28),PTRACB(KEEP28) + REAL W(LWC) + INTEGER SIZFI, SIZFR + IF ( IWPOSCB .eq. LIWW ) RETURN + DO WHILE ( IWCB( IWPOSCB + 2 ) .eq. 0 ) + SIZFR = IWCB( IWPOSCB + 1 ) + SIZFI = 2 + SIZFR = SIZFR * NRHS + IWPOSCB = IWPOSCB + SIZFI + POSWCB = POSWCB + SIZFR + IF ( IWPOSCB .eq. LIWW ) RETURN + END DO + RETURN + END SUBROUTINE SMUMPS_151 + SUBROUTINE SMUMPS_95(NRHS,N,KEEP28,IWCB,LIWW,W,LWC, + & POSWCB,IWPOSCB,PTRICB,PTRACB) + IMPLICIT NONE + INTEGER NRHS,N,LIWW,LWC,POSWCB,IWPOSCB,KEEP28 + INTEGER IWCB(LIWW),PTRICB(KEEP28),PTRACB(KEEP28) + REAL W(LWC) + INTEGER IPTIW,IPTA,SIZFI,SIZFR,LONGI,LONGR + INTEGER I + IPTIW = IWPOSCB + IPTA = POSWCB + LONGI = 0 + LONGR = 0 + IF ( IPTIW .EQ. LIWW ) RETURN +10 CONTINUE + IF (IWCB(IPTIW+2).EQ.0) THEN + SIZFR = IWCB(IPTIW+1) + SIZFI = 2 + SIZFR = SIZFR * NRHS + IF (LONGI.NE.0) THEN + DO 20 I=0,LONGI-1 + IWCB(IPTIW + SIZFI - I) = IWCB (IPTIW - I ) + 20 CONTINUE + DO 30 I=0,LONGR-1 + W(IPTA + SIZFR - I) = W(IPTA - I ) + 30 CONTINUE + ENDIF + DO 40 I=1,KEEP28 + IF ((PTRICB(I).LE.(IPTIW+1)).AND. + & (PTRICB(I).GT.IWPOSCB) ) THEN + PTRICB(I) = PTRICB(I) + SIZFI + PTRACB(I) = PTRACB(I) + SIZFR + ENDIF +40 CONTINUE + IWPOSCB = IWPOSCB + SIZFI + IPTIW = IPTIW + SIZFI + POSWCB = POSWCB + SIZFR + IPTA = IPTA + SIZFR + ELSE + SIZFR = IWCB(IPTIW+1) + SIZFI = 2 + SIZFR = SIZFR * NRHS + IPTIW = IPTIW + SIZFI + LONGI = LONGI + SIZFI + IPTA = IPTA + SIZFR + LONGR = LONGR + SIZFR + ENDIF + IF (IPTIW.NE.LIWW) GOTO 10 + RETURN + END SUBROUTINE SMUMPS_95 + SUBROUTINE SMUMPS_205(MTYPE, IFLAG, N, NZ, + & LHS, WRHS, W, RHS, GIVSOL, SOL, ANORM, XNORM, SCLNRM, + & MPRINT, ICNTL, KEEP,KEEP8) + INTEGER MTYPE,N,NZ,IFLAG,ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + REAL RHS(N),LHS(N) + REAL WRHS(N),SOL(*) + REAL W(N) + REAL RESMAX,RESL2,XNORM, ERMAX,MAXSOL, + & COMAX, SCLNRM, ERL2, ERREL + REAL ANORM,DZERO,EPSI + LOGICAL GIVSOL,PROK + INTEGER MPRINT, MP + INTEGER K + INTRINSIC abs, max, sqrt + MP = ICNTL(2) + PROK = (MPRINT .GT. 0) + DZERO = 0.0E0 + EPSI = 0.1E-9 + ANORM = DZERO + RESMAX = DZERO + RESL2 = DZERO + DO 40 K = 1, N + RESMAX = max(RESMAX, abs(RHS(K))) + RESL2 = RESL2 + abs(RHS(K)) * abs(RHS(K)) + ANORM = max(ANORM, W(K)) + 40 CONTINUE + XNORM = DZERO + DO 50 K = 1, N + XNORM = max(XNORM, abs(LHS(K))) + 50 CONTINUE + IF (XNORM .GT. EPSI) THEN + SCLNRM = RESMAX / (ANORM * XNORM) + ELSE + IFLAG = IFLAG + 2 + IF ((MP .GT. 0) .AND. (ICNTL(4) .GE. 2)) WRITE( MP, * ) + &' max-NORM of computed solut. is zero' + SCLNRM = RESMAX / ANORM + ENDIF + RESL2 = sqrt(RESL2) + ERMAX = DZERO + COMAX = DZERO + ERL2 = DZERO + IF (.NOT.GIVSOL) THEN + IF (PROK) WRITE( MPRINT, 90 ) RESMAX, RESL2, ANORM, XNORM, + & SCLNRM + ELSE + MAXSOL = DZERO + DO 60 K = 1, N + MAXSOL = max(MAXSOL, abs(SOL(K))) + 60 CONTINUE + DO 70 K = 1, N + ERL2 = abs(LHS(K) - SOL(K)) ** 2 + ERL2 + ERMAX = max(ERMAX, abs(LHS(K) - SOL(K))) + 70 CONTINUE + DO 80 K = 1, N + IF (abs(SOL(K)) .GT. EPSI) THEN + COMAX = max(COMAX, (abs(LHS(K) - SOL(K)) / abs(SOL(K)))) + ENDIF + 80 CONTINUE + ERL2 = sqrt(ERL2) + IF (MAXSOL .GT. EPSI) THEN + ERREL = ERMAX / MAXSOL + ELSE + IFLAG = IFLAG + 2 + IF ((MP .GT. 0) .AND. (ICNTL(4) .GE. 2)) WRITE( MP, * ) + &' MAX-NORM of exact solution is zero' + ERREL = ERMAX + ENDIF + IF (PROK) WRITE( MPRINT, 100 ) ERMAX, ERL2, ERREL, COMAX, RESMAX + & , RESL2, ANORM, XNORM, SCLNRM + ENDIF + 90 FORMAT (/' RESIDUAL IS ............ (MAX-NORM) =',1PD9.2/ + & ' .. (2-NORM) =',1PD9.2/ + & ' RINFOG(4):NORM OF input Matrix (MAX-NORM)=',1PD9.2/ + & ' RINFOG(5):NORM OF Computed SOLUT (MAX-NORM)=',1PD9.2/ + & ' RINFOG(6):SCALED RESIDUAL ...... (MAX-NORM)=',1PD9.2) + RETURN + 100 FORMAT (/' ERROR IS ............ (MAX-NORM) =',1PD9.2/ + & ' ............ (2-NORM) =',1PD9.2/ + & ' RELATIVE ERROR........... (MAX-NORM) =',1PD9.2/ + & ' Comp. Wise ERROR......... (MAX-NORM) =',1PD9.2/ + & ' AND RESIDUAL IS ......... (MAX-NORM) =',1PD9.2/ + & ' .. (2-NORM) =',1PD9.2/ + & ' NORM OF input MATRIX ... (MAX-NORM) =',1PD9.2/ + & ' NORM of computed SOLUT... (MAX-NORM) =',1PD9.2/ + & ' SCALED RESIDUAL ......... (MAX-NORM) =',1PD9.2) + END SUBROUTINE SMUMPS_205 + SUBROUTINE SMUMPS_206(NZ, N, RHS, + & X, Y, D, R_W, C_W, IW, KASE, + & OMEGA, ERX, JOB, COND, MAXIT, NOITER, LP, KEEP,KEEP8, + & ARRET ) + IMPLICIT NONE + INTEGER NZ, N, KASE, KEEP(500), JOB + INTEGER(8) KEEP8(150) + INTEGER IW(N,2) + REAL RHS(N) + REAL X(N), Y(N) + REAL D(N) + REAL R_W(N,2) + REAL C_W(N) + INTEGER LP, MAXIT, NOITER + REAL COND(2),OMEGA(2) + REAL ARRET + REAL CGCE, CTAU + DATA CTAU /1.0E3/, CGCE /0.2E0/ + LOGICAL LCOND1, LCOND2 + INTEGER IFLAG, JUMP, I, IMAX + REAL ERX, DXMAX + REAL CONVER, OM1, OM2, DXIMAX + REAL ZERO, ONE,TAU, DD + REAL OLDOMG(2) + INTEGER SMUMPS_IXAMAX + INTRINSIC abs, max + SAVE LCOND1, LCOND2, JUMP, DXIMAX, DXMAX, CONVER, + & OM1, OLDOMG, IFLAG + DATA ZERO /0.0E0/, ONE /1.0E0/ + IF (KASE .EQ. 0) THEN + LCOND1 = .FALSE. + LCOND2 = .FALSE. + COND(1) = ONE + COND(2) = ONE + ERX = ZERO + OM1 = ZERO + IFLAG = 0 + NOITER = 0 + JUMP = 1 + ENDIF + SELECT CASE (JUMP) + CASE (1) + GOTO 30 + CASE(2) + GOTO 10 + CASE(3) + GOTO 110 + CASE(4) + GOTO 150 + CASE(5) + GOTO 35 + CASE DEFAULT + END SELECT + 10 CONTINUE + DO 20 I = 1, N + X(I) = X(I) + Y(I) + 20 CONTINUE + IF (NOITER .GT. MAXIT) THEN + IFLAG = IFLAG + 8 + GOTO 70 + ENDIF + 30 CONTINUE + KASE = 14 + JUMP = 5 + RETURN + 35 CONTINUE + IMAX = SMUMPS_IXAMAX(N, X, 1) + DXMAX = abs(X(IMAX)) + OMEGA(1) = ZERO + OMEGA(2) = ZERO + DO 40 I = 1, N + TAU = (R_W(I, 2) * DXMAX + abs(RHS(I))) * real(N) * CTAU + DD = R_W(I, 1) + abs(RHS(I)) + IF ((DD + TAU) .GT. TAU) THEN + OMEGA(1) = max(OMEGA(1), abs(Y(I)) / DD) + IW(I, 1) = 1 + ELSE + IF (TAU .GT. ZERO) THEN + OMEGA(2) = max(OMEGA(2), + & abs(Y(I)) / (DD + R_W(I, 2) * DXMAX)) + ENDIF + IW(I, 1) = 2 + ENDIF + 40 CONTINUE + OM2 = OMEGA(1) + OMEGA(2) + IF (OM2 .LT. ARRET ) GOTO 70 + IF (MAXIT .EQ. 0) GOTO 70 + IF (NOITER .GT. 1 .AND. OM2 .GT. OM1 * CGCE) THEN + CONVER = OM2 / OM1 + IF (OM2 .GT. OM1) THEN + OMEGA(1) = OLDOMG(1) + OMEGA(2) = OLDOMG(2) + DO 50 I = 1, N + X(I) = C_W(I) + 50 CONTINUE + ENDIF + GOTO 70 + ENDIF + DO 60 I = 1, N + C_W(I) = X(I) + 60 CONTINUE + OLDOMG(1) = OMEGA(1) + OLDOMG(2) = OMEGA(2) + OM1 = OM2 + NOITER = NOITER + 1 + KASE = 2 + JUMP = 2 + RETURN + 70 KASE = 0 + IF (JOB .LE. 0) GOTO 170 + DO 80 I = 1, N + IF (IW(I, 1) .EQ. 1) THEN + R_W(I, 1) = R_W(I, 1) + abs(RHS(I)) + R_W(I, 2) = ZERO + LCOND1 = .TRUE. + ELSE + R_W(I, 2) = R_W(I, 2) * DXMAX + R_W(I, 1) + R_W(I, 1) = ZERO + LCOND2 = .TRUE. + ENDIF + 80 CONTINUE + DO 90 I = 1, N + C_W(I) = X(I) * D(I) + 90 CONTINUE + IMAX = SMUMPS_IXAMAX(N, C_W(1), 1) + DXIMAX = abs(C_W(IMAX)) + IF (.NOT.LCOND1) GOTO 130 + 100 CALL SMUMPS_218(N, KASE, Y, COND(1), C_W, IW(1, 2)) + IF (KASE .EQ. 0) GOTO 120 + IF (KASE .EQ. 1) CALL SMUMPS_204(N, Y, D) + IF (KASE .EQ. 2) CALL SMUMPS_204(N, Y, R_W) + JUMP = 3 + RETURN + 110 CONTINUE + IF (KASE .EQ. 1) CALL SMUMPS_204(N, Y, R_W) + IF (KASE .EQ. 2) CALL SMUMPS_204(N, Y, D) + GOTO 100 + 120 IF (DXIMAX .GT. ZERO) COND(1) = COND(1) / DXIMAX + ERX = OMEGA(1) * COND(1) + 130 IF (.NOT.LCOND2) GOTO 170 + KASE = 0 + 140 CALL SMUMPS_218(N, KASE, Y, COND(2), C_W, IW(1, 2)) + IF (KASE .EQ. 0) GOTO 160 + IF (KASE .EQ. 1) CALL SMUMPS_204(N, Y, D) + IF (KASE .EQ. 2) CALL SMUMPS_204(N, Y, R_W(1, 2)) + JUMP = 4 + RETURN + 150 CONTINUE + IF (KASE .EQ. 1) CALL SMUMPS_204(N, Y, R_W(1, 2)) + IF (KASE .EQ. 2) CALL SMUMPS_204(N, Y, D) + GOTO 140 + 160 IF (DXIMAX .GT. ZERO) THEN + COND(2) = COND(2) / DXIMAX + ENDIF + ERX = ERX + OMEGA(2) * COND(2) + 170 KASE = -IFLAG + RETURN + END SUBROUTINE SMUMPS_206 + SUBROUTINE SMUMPS_207(A, NZ, N, IRN, ICN, Z, KEEP,KEEP8) + INTEGER NZ, N, I, J, K, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IRN(NZ), ICN(NZ) + REAL A(NZ) + REAL Z(N) + REAL ZERO + INTRINSIC abs + DATA ZERO /0.0E0/ + DO 10 I = 1, N + Z(I) = ZERO + 10 CONTINUE + IF (KEEP(50) .EQ.0) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)) + IF (J.NE.I) THEN + Z(J) = Z(J) + abs(A(K)) + ENDIF + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_207 + SUBROUTINE SMUMPS_289(A, NZ, N, IRN, ICN, Z, + & KEEP, KEEP8, COLSCA) + INTEGER, intent(in) :: NZ, N, KEEP(500) + INTEGER(8), intent(in) :: KEEP8(150) + INTEGER, intent(in) :: IRN(NZ), ICN(NZ) + REAL, intent(in) :: A(NZ) + REAL, intent(in) :: COLSCA(N) + REAL, intent(out) :: Z(N) + REAL ZERO + DATA ZERO /0.0E0/ + INTEGER I, J, K + DO 10 I = 1, N + Z(I) = ZERO + 10 CONTINUE + IF (KEEP(50) .EQ.0) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)*COLSCA(J)) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)*COLSCA(J)) + IF (J.NE.I) THEN + Z(J) = Z(J) + abs(A(K)*COLSCA(I)) + ENDIF + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_289 + SUBROUTINE SMUMPS_208(A, NZ, N, IRN, ICN, RHS, X, R, W, + & KEEP,KEEP8) + IMPLICIT NONE + INTEGER, intent(in) :: NZ, N, KEEP(500) + INTEGER(8), intent(in) :: KEEP8(150) + INTEGER, intent(in) :: IRN(NZ), ICN(NZ) + REAL, intent(in) :: A(NZ), RHS(N), X(N) + REAL, intent(out) :: W(N) + REAL, intent(out) :: R(N) + INTEGER I, K, J + REAL ZERO + DATA ZERO /0.0E0/ + REAL D + DO I = 1, N + R(I) = RHS(I) + W(I) = ZERO + ENDDO + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .GT. N) .OR. (J .GT. N) .OR. (I .LT. 1) .OR. (J .LT. 1)) + & CYCLE + D = A(K) * X(J) + R(I) = R(I) - D + W(I) = W(I) + abs(D) + IF ((I.NE.J) .AND. (KEEP(50).NE.0) ) THEN + D = A(K) * X(I) + R(J) = R(J) - D + W(J) = W(J) + abs(D) + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_208 + SUBROUTINE SMUMPS_204(N, R, W) + INTEGER, intent(in) :: N + REAL, intent(in) :: W(N) + REAL, intent(inout) :: R(N) + INTEGER I + DO 10 I = 1, N + R(I) = R(I) * W(I) + 10 CONTINUE + RETURN + END SUBROUTINE SMUMPS_204 + SUBROUTINE SMUMPS_218(N, KASE, X, EST, W, IW) + INTEGER, intent(in) :: N + INTEGER, intent(inout) :: KASE + INTEGER IW(N) + REAL W(N), X(N) + REAL EST + INTRINSIC abs, nint, real, sign + INTEGER SMUMPS_IXAMAX + EXTERNAL SMUMPS_IXAMAX + INTEGER ITMAX + PARAMETER (ITMAX = 5) + INTEGER I, ITER, J, JLAST, JUMP + REAL ALTSGN + REAL TEMP + SAVE ITER, J, JLAST, JUMP + REAL ZERO, ONE + PARAMETER( ZERO = 0.0E0 ) + PARAMETER( ONE = 1.0E0 ) + REAL, PARAMETER :: RZERO = 0.0E0 + REAL, PARAMETER :: RONE = 1.0E0 + IF (KASE .EQ. 0) THEN + DO 10 I = 1, N + X(I) = ONE / real(N) + 10 CONTINUE + KASE = 1 + JUMP = 1 + RETURN + ENDIF + SELECT CASE (JUMP) + CASE (1) + GOTO 20 + CASE(2) + GOTO 40 + CASE(3) + GOTO 70 + CASE(4) + GOTO 120 + CASE(5) + GOTO 160 + CASE DEFAULT + END SELECT + 20 CONTINUE + IF (N .EQ. 1) THEN + W(1) = X(1) + EST = abs(W(1)) + GOTO 190 + ENDIF + DO 30 I = 1, N + X(I) = sign( RONE,real(X(I)) ) + IW(I) = nint(real(X(I))) + 30 CONTINUE + KASE = 2 + JUMP = 2 + RETURN + 40 CONTINUE + J = SMUMPS_IXAMAX(N, X, 1) + ITER = 2 + 50 CONTINUE + DO 60 I = 1, N + X(I) = ZERO + 60 CONTINUE + X(J) = ONE + KASE = 1 + JUMP = 3 + RETURN + 70 CONTINUE + DO 80 I = 1, N + W(I) = X(I) + 80 CONTINUE + DO 90 I = 1, N + IF (nint(sign(RONE, real(X(I)))) .NE. IW(I)) GOTO 100 + 90 CONTINUE + GOTO 130 + 100 CONTINUE + DO 110 I = 1, N + X(I) = sign(RONE, real(X(I))) + IW(I) = nint(real(X(I))) + 110 CONTINUE + KASE = 2 + JUMP = 4 + RETURN + 120 CONTINUE + JLAST = J + J = SMUMPS_IXAMAX(N, X, 1) + IF ((abs(X(JLAST)) .NE. abs(X(J))) .AND. (ITER .LT. ITMAX)) THEN + ITER = ITER + 1 + GOTO 50 + ENDIF + 130 CONTINUE + EST = RZERO + DO 140 I = 1, N + EST = EST + abs(W(I)) + 140 CONTINUE + ALTSGN = RONE + DO 150 I = 1, N + X(I) = ALTSGN * (RONE + real(I - 1) / real(N - 1)) + ALTSGN = -ALTSGN + 150 CONTINUE + KASE = 1 + JUMP = 5 + RETURN + 160 CONTINUE + TEMP = RZERO + DO 170 I = 1, N + TEMP = TEMP + abs(X(I)) + 170 CONTINUE + TEMP = 2.0E0 * TEMP / real(3 * N) + IF (TEMP .GT. EST) THEN + DO 180 I = 1, N + W(I) = X(I) + 180 CONTINUE + EST = TEMP + ENDIF + 190 KASE = 0 + RETURN + END SUBROUTINE SMUMPS_218 + SUBROUTINE SMUMPS_278( MTYPE, N, NZ, ASPK, IRN, ICN, + & LHS, WRHS, W, RHS, KEEP,KEEP8) + IMPLICIT NONE + INTEGER MTYPE, N, NZ + INTEGER IRN( NZ ), ICN( NZ ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + REAL, intent(in) :: ASPK( NZ ) + REAL, intent(in) :: LHS( N ), WRHS( N ) + REAL, intent(out):: RHS( N ) + REAL, intent(out):: W( N ) + INTEGER K, I, J + REAL DZERO + PARAMETER(DZERO = 0.0E0) + DO 10 K = 1, N + W(K) = DZERO + RHS(K) = WRHS(K) + 10 CONTINUE + IF ( KEEP(50) .EQ. 0 ) THEN + IF (MTYPE .EQ. 1) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + RHS(I) = RHS(I) - ASPK(K) * LHS(J) + W(I) = W(I) + abs(ASPK(K)) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + RHS(J) = RHS(J) - ASPK(K) * LHS(I) + W(J) = W(J) + abs(ASPK(K)) + ENDDO + ENDIF + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + RHS(I) = RHS(I) - ASPK(K) * LHS(J) + W(I) = W(I) + abs(ASPK(K)) + IF (J.NE.I) THEN + RHS(J) = RHS(J) - ASPK(K) * LHS(I) + W(J) = W(J) + abs(ASPK(K)) + ENDIF + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_278 + SUBROUTINE SMUMPS_121( MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & LHS, WRHS, W, RHS, KEEP,KEEP8) + IMPLICIT NONE + INTEGER MTYPE, N, NELT, LELTVAR, NA_ELT + INTEGER ELTPTR(NELT+1), ELTVAR(LELTVAR) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + REAL A_ELT(NA_ELT) + REAL LHS( N ), WRHS( N ), RHS( N ) + REAL W(N) + CALL SMUMPS_257(N, NELT, ELTPTR, ELTVAR, A_ELT, + & LHS, RHS, KEEP(50), MTYPE ) + RHS = WRHS - RHS + CALL SMUMPS_119( MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & W, KEEP,KEEP8 ) + RETURN + END SUBROUTINE SMUMPS_121 + SUBROUTINE SMUMPS_119( MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & W, KEEP,KEEP8 ) + IMPLICIT NONE + INTEGER MTYPE, N, NELT, LELTVAR, NA_ELT + INTEGER ELTPTR(NELT+1), ELTVAR(LELTVAR) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + REAL A_ELT(NA_ELT) + REAL TEMP + REAL W(N) + INTEGER K, I, J, IEL, SIZEI, IELPTR + REAL DZERO + PARAMETER(DZERO = 0.0E0) + W = DZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( KEEP(50).EQ.0 ) THEN + IF (MTYPE.EQ.1) THEN + DO J = 1, SIZEI + DO I = 1, SIZEI + W( ELTVAR( IELPTR + I) ) = + & W( ELTVAR( IELPTR + I) ) + & + abs(A_ELT( K )) + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = W( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + TEMP = TEMP + abs( A_ELT(K)) + K = K + 1 + END DO + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + TEMP + END DO + ENDIF + ELSE + DO J = 1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + abs(A_ELT( K )) + K = K + 1 + DO I = J+1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + abs(A_ELT( K )) + W(ELTVAR( IELPTR + I ) ) = + & W(ELTVAR( IELPTR + I )) + abs(A_ELT( K )) + K = K + 1 + END DO + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_119 + SUBROUTINE SMUMPS_135(MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & W, KEEP,KEEP8, COLSCA ) + IMPLICIT NONE + INTEGER MTYPE, N, NELT, LELTVAR, NA_ELT + INTEGER ELTPTR(NELT+1), ELTVAR(LELTVAR) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + REAL COLSCA(N) + REAL A_ELT(NA_ELT) + REAL W(N) + REAL TEMP, TEMP2 + INTEGER K, I, J, IEL, SIZEI, IELPTR + REAL DZERO + PARAMETER(DZERO = 0.0E0) + W = DZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( KEEP(50).EQ.0 ) THEN + IF (MTYPE.EQ.1) THEN + DO J = 1, SIZEI + TEMP2 = abs(COLSCA(ELTVAR( IELPTR + J) )) + DO I = 1, SIZEI + W( ELTVAR( IELPTR + I) ) = + & W( ELTVAR( IELPTR + I) ) + & + abs(A_ELT( K )) * TEMP2 + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = W( ELTVAR( IELPTR + J ) ) + TEMP2= abs(COLSCA(ELTVAR( IELPTR + J) )) + DO I = 1, SIZEI + TEMP = TEMP + abs(A_ELT( K )) * TEMP2 + K = K + 1 + END DO + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + TEMP + END DO + ENDIF + ELSE + DO J = 1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + + & abs( A_ELT( K )*COLSCA(ELTVAR( IELPTR + J)) ) + K = K + 1 + DO I = J+1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + + & abs(A_ELT( K )*COLSCA(ELTVAR( IELPTR + J))) + W(ELTVAR( IELPTR + I ) ) = + & W(ELTVAR( IELPTR + I )) + + & abs(A_ELT( K )*COLSCA(ELTVAR( IELPTR + I))) + K = K + 1 + END DO + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_135 + SUBROUTINE SMUMPS_122( MTYPE, N, NELT, ELTPTR, + & LELTVAR, ELTVAR, NA_ELT, A_ELT, + & SAVERHS, X, Y, W, K50 ) + IMPLICIT NONE + INTEGER N, NELT, K50, MTYPE, LELTVAR, NA_ELT + INTEGER ELTPTR( NELT + 1 ), ELTVAR( LELTVAR ) + REAL A_ELT( NA_ELT ), X( N ), Y( N ), + & SAVERHS(N) + REAL W(N) + INTEGER IEL, I , J, K, SIZEI, IELPTR + REAL ZERO + REAL TEMP + REAL TEMP2 + PARAMETER( ZERO = 0.0E0 ) + Y = SAVERHS + W = ZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( K50 .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO J = 1, SIZEI + TEMP = X( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) - + & A_ELT( K ) * TEMP + W( ELTVAR( IELPTR + I ) ) = + & W( ELTVAR( IELPTR + I ) ) + + & abs( A_ELT( K ) * TEMP ) + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = Y( ELTVAR( IELPTR + J ) ) + TEMP2 = W( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + TEMP = TEMP - + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + TEMP2 = TEMP2 + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) ) + K = K + 1 + END DO + Y( ELTVAR( IELPTR + J ) ) = TEMP + W( ELTVAR( IELPTR + J ) ) = TEMP2 + END DO + END IF + ELSE + DO J = 1, SIZEI + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) - + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + W( ELTVAR( IELPTR + J ) ) = + & W( ELTVAR( IELPTR + J ) ) + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) ) + K = K + 1 + DO I = J+1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) - + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) - + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + W( ELTVAR( IELPTR + I ) ) = + & W( ELTVAR( IELPTR + I ) ) + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) ) + W( ELTVAR( IELPTR + J ) ) = + & W( ELTVAR( IELPTR + J ) ) + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) ) + K = K + 1 + END DO + END DO + END IF + END DO + RETURN + END SUBROUTINE SMUMPS_122 + SUBROUTINE SMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + USE SMUMPS_OOC + IMPLICIT NONE + INTEGER INODE,KEEP(500),N + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N) + INTEGER IERR + REAL A(LA) + INTEGER RETURN_VALUE + LOGICAL MUST_BE_PERMUTED + RETURN_VALUE=SMUMPS_726(INODE,PTRFAC, + & KEEP(28),A,LA,IERR) + IF(RETURN_VALUE.EQ.OOC_NODE_NOT_IN_MEM)THEN + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL SMUMPS_578(INODE,PTRFAC, + & KEEP,KEEP8,A,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL SMUMPS_577( + & A(PTRFAC(STEP(INODE))), + & INODE,IERR + & ) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ELSE + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + IF(RETURN_VALUE.NE.OOC_NODE_PERMUTED)THEN + MUST_BE_PERMUTED=.TRUE. + CALL SMUMPS_682(INODE) + ELSE + MUST_BE_PERMUTED=.FALSE. + ENDIF + RETURN + END SUBROUTINE SMUMPS_643 + SUBROUTINE SMUMPS_257( N, NELT, ELTPTR, ELTVAR, A_ELT, + & X, Y, K50, MTYPE ) + IMPLICIT NONE + INTEGER N, NELT, K50, MTYPE + INTEGER ELTPTR( NELT + 1 ), ELTVAR( * ) + REAL A_ELT( * ), X( N ), Y( N ) + INTEGER IEL, I , J, K, SIZEI, IELPTR + REAL TEMP + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + Y = ZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( K50 .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO J = 1, SIZEI + TEMP = X( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) + + & A_ELT( K ) * TEMP + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = Y( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + TEMP = TEMP + + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + K = K + 1 + END DO + Y( ELTVAR( IELPTR + J ) ) = TEMP + END DO + END IF + ELSE + DO J = 1, SIZEI + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) + + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + K = K + 1 + DO I = J+1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) + + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) + + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + K = K + 1 + END DO + END DO + END IF + END DO + RETURN + END SUBROUTINE SMUMPS_257 + SUBROUTINE SMUMPS_192 + &( N, NZ_loc, IRN_loc, JCN_loc, A_loc, X, Y_loc, + & LDLT, MTYPE) + IMPLICIT NONE + INTEGER N, NZ_loc + INTEGER IRN_loc( NZ_loc ), JCN_loc( NZ_loc ) + REAL A_loc( NZ_loc ), X( N ), Y_loc( N ) + INTEGER LDLT, MTYPE + INTEGER I, J, K + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + Y_loc = ZERO + IF ( LDLT .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + A_loc(K) * X(J) + ENDDO + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) + & .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(J) = Y_loc(J) + A_loc(K) * X(I) + ENDDO + END IF + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + A_loc(K) * X(J) + IF (J.NE.I) THEN + Y_loc(J) = Y_loc(J) + A_loc(K) * X(I) + ENDIF + ENDDO + END IF + RETURN + END SUBROUTINE SMUMPS_192 + SUBROUTINE SMUMPS_256( N, NZ, IRN, ICN, ASPK, X, Y, + & LDLT, MTYPE, MAXTRANS, PERM ) + INTEGER N, NZ, LDLT, MTYPE, MAXTRANS + INTEGER IRN( NZ ), ICN( NZ ) + INTEGER PERM( N ) + REAL ASPK( NZ ), X( N ), Y( N ) + INTEGER K, I, J + REAL PX( N ) + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + Y = ZERO + IF ( MAXTRANS .eq. 1 .and. MTYPE .eq. 1) THEN + DO I = 1, N + PX(I) = X( PERM( I ) ) + END DO + ELSE + PX = X + END IF + IF ( LDLT .eq. 0 ) THEN + IF (MTYPE .EQ. 1) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y(I) = Y(I) + ASPK(K) * PX(J) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y(J) = Y(J) + ASPK(K) * PX(I) + ENDDO + ENDIF + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y(I) = Y(I) + ASPK(K) * PX(J) + IF (J.NE.I) THEN + Y(J) = Y(J) + ASPK(K) * PX(I) + ENDIF + ENDDO + END IF + IF ( MAXTRANS .EQ. 1 .AND. MTYPE .eq. 0 ) THEN + PX = Y + DO I = 1, N + Y( PERM( I ) ) = PX( I ) + END DO + END IF + RETURN + END SUBROUTINE SMUMPS_256 + SUBROUTINE SMUMPS_193 + &( N, NZ_loc, IRN_loc, JCN_loc, A_loc, X, Y_loc, + & LDLT, MTYPE) + IMPLICIT NONE + INTEGER N, NZ_loc + INTEGER IRN_loc( NZ_loc ), JCN_loc( NZ_loc ) + REAL A_loc( NZ_loc ), X( N ) + REAL Y_loc( N ) + INTEGER LDLT, MTYPE + INTEGER I, J, K + REAL RZERO + PARAMETER( RZERO = 0.0E0 ) + Y_loc = RZERO + IF ( LDLT .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + abs( A_loc(K) * X(J) ) + ENDDO + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) + & .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(J) = Y_loc(J) + abs( A_loc(K) * X(I) ) + ENDDO + END IF + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + abs( A_loc(K) * X(J) ) + IF (J.NE.I) THEN + Y_loc(J) = Y_loc(J) + abs( A_loc(K) * X(I) ) + ENDIF + ENDDO + END IF + RETURN + END SUBROUTINE SMUMPS_193 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part6.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part6.F new file mode 100644 index 000000000..29ae0caff --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part6.F @@ -0,0 +1,4300 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE SMUMPS_324(A, LDA, NPIV, NBROW, K50 ) + IMPLICIT NONE + INTEGER LDA, NPIV, NBROW, K50 + REAL A(int(LDA,8)*int(NBROW+NPIV,8)) + INTEGER(8) :: IOLD, INEW, J8 + INTEGER I , ILAST + INTEGER NBROW_L_RECTANGLE_TO_MOVE + IF ((NPIV.EQ.0).OR.(LDA.EQ.NPIV)) GOTO 500 + IF ( K50.NE.0 ) THEN + IOLD = int(LDA + 1,8) + INEW = int(NPIV + 1,8) + IF (IOLD .EQ. INEW ) THEN + INEW = INEW + int(NPIV,8) * int(NPIV - 1,8) + IOLD = IOLD + int(LDA,8) * int(NPIV - 1,8) + ELSE + DO I = 1, NPIV - 1 + IF ( I .LE. NPIV-2 ) THEN + ILAST = I+1 + ELSE + ILAST = I + ENDIF + DO J8 = 0_8, int(ILAST,8) + A( INEW + J8 ) = A( IOLD + J8 ) + END DO + INEW = INEW + int(NPIV,8) + IOLD = IOLD + int(LDA,8) + END DO + ENDIF + NBROW_L_RECTANGLE_TO_MOVE = NBROW + ELSE + INEW = 1_8 + int(NPIV,8) * int(LDA + 1,8) + IOLD = 1_8 + int(LDA,8) * int(NPIV +1,8) + NBROW_L_RECTANGLE_TO_MOVE = NBROW - 1 + ENDIF + DO I = 1, NBROW_L_RECTANGLE_TO_MOVE + DO J8 = 0_8, int(NPIV - 1,8) + A( INEW + J8 ) = A( IOLD + J8 ) + END DO + INEW = INEW + int(NPIV,8) + IOLD = IOLD + int(LDA,8) + ENDDO + 500 RETURN + END SUBROUTINE SMUMPS_324 + SUBROUTINE SMUMPS_651(A, LDA, NPIV, NCONTIG ) + IMPLICIT NONE + INTEGER NCONTIG, NPIV, LDA + REAL A(NCONTIG*LDA) + INTEGER I, J + INTEGER(8) :: INEW, IOLD + INEW = int(NPIV+1,8) + IOLD = int(LDA+1,8) + DO I = 2, NCONTIG + DO J = 1, NPIV + A(INEW)=A(IOLD) + INEW = INEW + 1_8 + IOLD = IOLD + 1_8 + ENDDO + IOLD = IOLD + int(LDA - NPIV,8) + ENDDO + RETURN + END SUBROUTINE SMUMPS_651 + SUBROUTINE SMUMPS_652( A, LA, LDA, POSELT, + & IPTRLU, NPIV, + & NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, SIZECB, KEEP, COMPRESSCB, + & LAST_ALLOWED, NBROW_ALREADY_STACKED ) + IMPLICIT NONE + INTEGER(8), intent (in) :: POSELT, IPTRLU, LA, SIZECB + LOGICAL, intent (in) :: COMPRESSCB + REAL A(LA) + INTEGER, intent(in):: LDA, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND + INTEGER, intent(inout) :: NBROW_ALREADY_STACKED + INTEGER(8), intent(in) :: LAST_ALLOWED + INTEGER(8) :: APOS, NPOS + INTEGER NBROW + INTEGER(8) :: J + INTEGER I, KEEP(500) +#if ! defined(ALLOW_NON_INIT) + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) +#endif + NBROW = NBROW_STACK + NBROW_SEND + IF (NBROW_STACK .NE. 0 ) THEN + NPOS = IPTRLU + SIZECB + APOS = POSELT + int(NPIV+NBROW,8) * int(LDA,8) - 1_8 + IF ( KEEP(50) .EQ. 0 .OR. .NOT. COMPRESSCB ) THEN + APOS = APOS - int(LDA,8) * int(NBROW_ALREADY_STACKED,8) + NPOS = NPOS + & - int(NBCOL_STACK,8) * int(NBROW_ALREADY_STACKED,8) + ELSE + APOS = APOS - int(LDA - 1,8) * int(NBROW_ALREADY_STACKED,8) + NPOS = NPOS - ( int(NBROW_ALREADY_STACKED,8) * + & int(NBROW_ALREADY_STACKED+1,8) ) / 2_8 + ENDIF + DO I = NBROW - NBROW_ALREADY_STACKED, NBROW_SEND+1, -1 + IF (KEEP(50).EQ.0) THEN + IF ( NPOS - int(NBCOL_STACK,8) + 1_8 .LT. + & LAST_ALLOWED ) THEN + EXIT + ENDIF + DO J= 1_8,int(NBCOL_STACK,8) + A(NPOS-J+1_8) = A(APOS-J+1_8) + ENDDO + NPOS = NPOS - int(NBCOL_STACK,8) + ELSE + IF (.NOT. COMPRESSCB) THEN + IF ( NPOS - int(NBCOL_STACK,8) + 1_8 .LT. + & LAST_ALLOWED ) THEN + EXIT + ENDIF +#if ! defined(ALLOW_NON_INIT) + DO J = 1_8, int(NBCOL_STACK - I,8) + A(NPOS - J + 1_8) = ZERO + END DO +#endif + NPOS = NPOS + int(- NBCOL_STACK + I,8) + ENDIF + IF ( NPOS - int(I,8) + 1_8 .LT. LAST_ALLOWED ) THEN + EXIT + ENDIF + DO J =1_8, int(I,8) + A(NPOS-J+1_8) = A(APOS-J+1_8) + ENDDO + NPOS = NPOS - int(I,8) + ENDIF + IF (KEEP(50).EQ.0) THEN + APOS = APOS - int(LDA,8) + ELSE + APOS = APOS - int(LDA + 1,8) + ENDIF + NBROW_ALREADY_STACKED = NBROW_ALREADY_STACKED + 1 + ENDDO + END IF + RETURN + END SUBROUTINE SMUMPS_652 + SUBROUTINE SMUMPS_705( A, LA, LDA, POSELT, + & IPTRLU, NPIV, + & NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, SIZECB, KEEP, COMPRESSCB) + IMPLICIT NONE + INTEGER(8), intent (in) :: POSELT, IPTRLU, LA, SIZECB + LOGICAL, intent (in) :: COMPRESSCB + REAL A(LA) + INTEGER, intent(in):: LDA, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND + INTEGER(8) :: APOS, NPOS, APOS_ini, NPOS_ini + INTEGER I, KEEP(500) + INTEGER(8) :: J, LDA8 +#if ! defined(ALLOW_NON_INIT) + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) +#endif + LDA8 = int(LDA,8) + NPOS_ini = IPTRLU + 1_8 + APOS_ini = POSELT + int(NPIV+NBROW_SEND,8)* LDA8 + int(NPIV,8) + DO I = 1, NBROW_STACK + IF (COMPRESSCB) THEN + NPOS = NPOS_ini + int(I-1,8) * int(I,8)/2_8 + + & int(I-1,8) * int(NBROW_SEND,8) + ELSE + NPOS = NPOS_ini + int(I-1,8) * int(NBCOL_STACK,8) + ENDIF + APOS = APOS_ini + int(I-1,8) * LDA8 + IF (KEEP(50).EQ.0) THEN + DO J = 1_8, int(NBCOL_STACK,8) + A(NPOS+J-1_8) = A(APOS+J-1_8) + ENDDO + ELSE + DO J = 1_8, int(I + NBROW_SEND,8) + A(NPOS+J-1_8)=A(APOS+J-1_8) + ENDDO +#if ! defined(ALLOW_NON_INIT) + IF (.NOT. COMPRESSCB) THEN + A(NPOS+int(I+NBROW_SEND,8): + & NPOS+int(NBCOL_STACK-1,8))=ZERO + ENDIF +#endif + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_705 + SUBROUTINE SMUMPS_140( N, INODE, IW, LIW, A, LA, + & IOLDPS, POSELT, IFLAG, + & UU, NNEG, NPVW, + & KEEP,KEEP8, + & MYID, SEUIL, AVOID_DELAYED, ETATASS, + & DKEEP,PIVNUL_LIST,LPN_LIST, IWPOS ) + USE SMUMPS_OOC + IMPLICIT NONE + INTEGER(8) :: LA, POSELT + INTEGER N, INODE, LIW, IFLAG, NNEG, NPVW + INTEGER MYID, IOLDPS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + REAL UU, SEUIL + REAL A( LA ) + INTEGER, TARGET :: IW( LIW ) + LOGICAL AVOID_DELAYED + INTEGER ETATASS, IWPOS + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER INOPV, IFINB, NFRONT, NPIV, NBOLKJ, + & NBTLKJ,IBEG_BLOCK + INTEGER NASS, NEL1, IFLAG_OOC + INTEGER :: LDA + REAL UUTEMP + INCLUDE 'mumps_headers.h' + EXTERNAL SMUMPS_222, SMUMPS_234, + & SMUMPS_230, SMUMPS_226, + & SMUMPS_237 + LOGICAL STATICMODE + REAL SEUIL_LOC + INTEGER PIVSIZ,IWPOSP2 + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten, + & IDUMMY + LOGICAL POSTPONE_COL_UPDATE, IS_MAXFROMM_AVAIL + REAL MAXFROMM + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INTEGER PP_FIRST2SWAP_L + INTEGER PP_LastPIVRPTRFilled + IS_MAXFROMM_AVAIL = .FALSE. + INOPV = 0 + SEUIL_LOC = SEUIL + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + UUTEMP=UU + ENDIF + POSTPONE_COL_UPDATE = (UUTEMP == 0.0E0 .AND. KEEP(201).NE.1) + IBEG_BLOCK = 1 + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + LDA = NFRONT + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5), NASS ) + ENDIF + NBTLKJ = NBOLKJ + IF (KEEP(201).EQ.1) THEN + IDUMMY = -8765 + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_L + NextPiv2beWritten = 1 + PP_FIRST2SWAP_L = NextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + PP_LastPIVRPTRFilled = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 1 + MonBloc%NROW = NFRONT + MonBloc%NCOL = NFRONT + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -77777 + MonBloc%INDICES => + & IW(IOLDPS+6+NFRONT+KEEP(IXSZ): + & IOLDPS+5+NFRONT+KEEP(IXSZ)+NFRONT) + ENDIF + IW(IOLDPS+3+KEEP(IXSZ)) = min0(NASS,NBTLKJ) + UUTEMP = UU + 50 CONTINUE + CALL SMUMPS_222(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV, NNEG, IFLAG,IOLDPS,POSELT,UUTEMP, + & SEUIL_LOC,KEEP,KEEP8,PIVSIZ, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, KEEP(IXSZ), + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled, MAXFROMM, IS_MAXFROMM_AVAIL) + IF (IFLAG.LT.0) GOTO 500 + IF(KEEP(109).GT. 0) THEN + IF(PIVNUL_LIST(KEEP(109)).EQ.-1) THEN + IWPOSP2 = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6+KEEP(IXSZ) + & +IW(IOLDPS+5+KEEP(IXSZ)) + PIVNUL_LIST(KEEP(109)) = IW(IWPOSP2) + ENDIF + ENDIF + IF (INOPV.EQ.1) THEN + IF(STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + CALL SMUMPS_237(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, KEEP,KEEP8, POSTPONE_COL_UPDATE, + & ETATASS, + & TYPEFile, LAFAC, MonBloc, NextPiv2beWritten, + & LIWFAC, MYID, IFLAG) + GOTO 500 + END IF + IF (INOPV.EQ.2) THEN + CALL SMUMPS_234(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, NBOLKJ, NBTLKJ,KEEP(4), + & POSTPONE_COL_UPDATE, + & KEEP,KEEP8) + GOTO 50 + ENDIF + NPVW = NPVW + PIVSIZ + IF (NASS.LE.1) THEN + CALL SMUMPS_230(NFRONT,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + GO TO 500 + ENDIF + CALL SMUMPS_226(IBEG_BLOCK, + & NFRONT, NASS, N,INODE,IW,LIW,A,LA, + & LDA, POSTPONE_COL_UPDATE, IOLDPS, + & POSELT,IFINB, + & NBTLKJ,PIVSIZ, KEEP(IXSZ),MAXFROMM, + & IS_MAXFROMM_AVAIL, (UUTEMP.NE.0.0E0), + & KEEP(253) ) + IF(PIVSIZ .EQ. 2) THEN + IWPOSP2 = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6 + IW(IWPOSP2+NFRONT+KEEP(IXSZ)) = -IW(IWPOSP2+NFRONT+KEEP(IXSZ)) + ENDIF + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + PIVSIZ + IF (IFINB.EQ.0) GOTO 50 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NEL1 = NASS - NPIV + IF (KEEP(201).EQ.1) THEN + IF (IFINB.EQ.-1) THEN + MonBloc%Last = .TRUE. + ELSE + MonBloc%Last = .FALSE. + ENDIF + MonBloc%LastPiv= NPIV + LAST_CALL=.FALSE. + CALL SMUMPS_688( + & STRAT_TRY_WRITE, + & TYPEFile, A(POSELT), + & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS), + & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + ENDIF + CALL SMUMPS_234(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, NBOLKJ, NBTLKJ,KEEP(4), + & POSTPONE_COL_UPDATE, + & KEEP,KEEP8) + IF (IFINB.EQ.-1) THEN + CALL SMUMPS_237(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, KEEP,KEEP8, + & POSTPONE_COL_UPDATE, ETATASS, + & TYPEFile, LAFAC, MonBloc, NextPiv2beWritten, + & LIWFAC, MYID, IFLAG) + & + GOTO 500 + ENDIF + GO TO 50 + 500 CONTINUE + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + LAST_CALL=.TRUE. + CALL SMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG < 0 ) RETURN + CALL SMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + RETURN + END SUBROUTINE SMUMPS_140 + SUBROUTINE SMUMPS_222 + & (NFRONT,NASS,N,INODE,IW,LIW, + & A,LA, INOPV, + & NNEG, + & IFLAG,IOLDPS,POSELT,UU, SEUIL,KEEP,KEEP8,PIVSIZ, + & DKEEP,PIVNUL_LIST,LPN_LIST, XSIZE, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled,MAXFROMM,IS_MAXFROMM_AVAIL) +#if defined (PROFILE_BLAS_ASS_G) + USE SMUMPS_LOAD +#endif + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER(8) :: POSELT, LA + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV, + & IOLDPS, NNEG + INTEGER PIVSIZ,LPIV, XSIZE + REAL A(LA) + REAL UU, UULOC, SEUIL + INTEGER IW(LIW) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk + INTEGER PP_LastPIVRPTRIndexFilled + REAL, intent(in) :: MAXFROMM + LOGICAL, intent(inout) :: IS_MAXFROMM_AVAIL + include 'mpif.h' + INTEGER (8) :: POSPV1,POSPV2,OFFDAG,APOSJ + INTEGER JMAX + REAL RMAX,AMAX,TMAX,TOL + REAL MAXPIV + REAL PIVNUL + REAL FIXA, CSEUIL + REAL PIVOT,DETPIV + PARAMETER(TOL = 1.0E-20) + INCLUDE 'mumps_headers.h' + INTEGER :: J + INTEGER(8) :: APOS, J1, J2, JJ, NFRONT8, KK, J1_ini, JJ_ini + INTEGER :: LDA + INTEGER(8) :: LDA8 + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,K + INTRINSIC max + REAL ZERO, ONE + PARAMETER( ZERO = 0.0E0 ) + PARAMETER( ONE = 1.0E0 ) + REAL RZERO,RONE + PARAMETER(RZERO=0.0E0, RONE=1.0E0) + LOGICAL OMP_FLAG + INTEGER I_PIVRPTR, I_PIVR, NBPANELS_L + PIVNUL = DKEEP(1) + FIXA = DKEEP(2) + CSEUIL = SEUIL + LDA = NFRONT + LDA8 = int(LDA,8) + NFRONT8 = int(NFRONT,8) + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL SMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR, I_PIVR, IOLDPS+2*NFRONT+6+KEEP(IXSZ), + & IW, LIW) + ENDIF + UULOC = UU + PIVSIZ = 1 + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NASSW = iabs(IW(IOLDPS+3+XSIZE)) + IF(INOPV .EQ. -1) THEN + APOS = POSELT + (LDA8+1_8) * int(NPIV,8) + POSPV1 = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF(real(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + NNEG = NNEG+1 + ENDIF + KEEP(98) = KEEP(98)+1 + ELSE IF (KEEP(258) .NE. 0) THEN + CALL SMUMPS_762( A(APOS), DKEEP(6), KEEP(259) ) + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL SMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + LDA8*int(IPIV-1,8) + int(NPIV,8) + POSPV1 = APOS + int(IPIV - NPIVP1,8) + PIVOT = A(POSPV1) + IF (UULOC.EQ.RZERO) THEN + IF (abs(A(APOS)).EQ.RZERO) GO TO 630 + IF (A(APOS).LT.RZERO) NNEG = NNEG+1 + IF (KEEP(258) .NE. 0) THEN + CALL SMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + GO TO 420 + ENDIF + AMAX = RZERO + JMAX = 0 + IF ( IS_MAXFROMM_AVAIL ) THEN + IF ( MAXFROMM > PIVNUL .AND. abs(PIVOT) > TOL) THEN + IF ( abs(PIVOT) .GT. max(UULOC*MAXFROMM,SEUIL) ) THEN + IF (PIVOT .LT. RZERO) NNEG = NNEG+1 + IF (KEEP(258) .NE. 0) THEN + CALL SMUMPS_762(PIVOT, DKEEP(6), KEEP(259)) + ENDIF + GOTO 415 + ENDIF + ENDIF + IS_MAXFROMM_AVAIL = .FALSE. + ENDIF + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(abs(A(JJ)) .GT. AMAX) THEN + AMAX = abs(A(JJ)) + JMAX = IPIV - int(POSPV1-JJ) + ENDIF + ENDDO + J1 = POSPV1 + LDA8 + DO J=1, NASSW - IPIV + IF(abs(A(J1)) .GT. AMAX) THEN + AMAX = abs(A(J1)) + JMAX = IPIV + J + ENDIF + J1 = J1 + LDA8 + ENDDO + RMAX = RZERO + J1_ini = J1 + IF ( (NFRONT - KEEP(253) - NASSW).GE.300 ) THEN + OMP_FLAG = .TRUE. + ELSE + OMP_FLAG = .FALSE. + ENDIF + DO J=1, NFRONT - KEEP(253) - NASSW + J1 = J1_ini + int(J-1,8) * LDA8 + RMAX = max(abs(A(J1)),RMAX) + ENDDO + IF (max(AMAX,RMAX,abs(PIVOT)).LE.PIVNUL) THEN + KEEP(109) = KEEP(109)+1 + PIVNUL_LIST(KEEP(109)) = -1 + IF(real(FIXA).GT.RZERO) THEN + IF(real(PIVOT) .GE. RZERO) THEN + A(POSPV1) = FIXA + ELSE + A(POSPV1) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + A(JJ) = ZERO + ENDDO + J1 = POSPV1 + LDA8 + DO J=1, NASSW - IPIV + A(J1) = ZERO + J1 = J1 + LDA8 + ENDDO + DO J=1,NFRONT - NASSW + A(J1) = ZERO + J1 = J1 + LDA8 + ENDDO + A(POSPV1) = ONE + ENDIF + PIVOT = A(POSPV1) + GO TO 415 + ENDIF + IF ((KEEP(19).EQ.0).AND.(KEEP(110).EQ.0)) THEN + IF (max(AMAX,RMAX,abs(PIVOT)).LE.TOL) THEN + IF(SEUIL .GT. epsilon(SEUIL)) THEN + IF(real(PIVOT) .GE. RZERO) THEN + A(POSPV1) = CSEUIL + ELSE + A(POSPV1) = -CSEUIL + NNEG = NNEG+1 + ENDIF + PIVOT = A(POSPV1) + KEEP(98) = KEEP(98)+1 + GO TO 415 + ENDIF + ENDIF + ENDIF + IF (max(AMAX,abs(PIVOT)).LE.TOL) GO TO 460 + IF (abs(PIVOT).GT.max(UULOC*max(RMAX,AMAX),SEUIL)) THEN + IF (PIVOT .LT. ZERO) NNEG = NNEG+1 + IF (KEEP(258) .NE.0 ) THEN + CALL SMUMPS_762(PIVOT, DKEEP(6), KEEP(259)) + ENDIF + GO TO 415 + END IF + IF (AMAX.LE.TOL) GO TO 460 + IF (RMAX.LT.AMAX) THEN + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(int(POSPV1-JJ) .NE. IPIV-JMAX) THEN + RMAX = max(RMAX,abs(A(JJ))) + ENDIF + ENDDO + J1 = POSPV1 + LDA8 + DO J=1,NASS-IPIV + IF(IPIV+J .NE. JMAX) THEN + RMAX = max(abs(A(J1)),RMAX) + ENDIF + J1 = J1 + LDA8 + ENDDO + ENDIF + APOSJ = POSELT + int(JMAX-1,8)*LDA8 + int(NPIV,8) + POSPV2 = APOSJ + int(JMAX - NPIVP1,8) + IF (IPIV.LT.JMAX) THEN + OFFDAG = APOSJ + int(IPIV - NPIVP1,8) + ELSE + OFFDAG = APOS + int(JMAX - NPIVP1,8) + END IF + TMAX = RZERO + IF(JMAX .LT. IPIV) THEN + JJ_ini = POSPV2 + OMP_FLAG = (NFRONT-JMAX-KEEP(253). GE. 300) + DO K = 1, NFRONT - JMAX - KEEP(253) + JJ = JJ_ini+ int(K,8)*NFRONT8 + IF (JMAX+K.NE.IPIV) THEN + TMAX=max(TMAX,abs(A(JJ))) + ENDIF + ENDDO + DO KK = APOSJ, POSPV2-1_8 + TMAX = max(TMAX,abs(A(KK))) + ENDDO + ELSE + JJ_ini = POSPV2 + OMP_FLAG = (NFRONT-JMAX-KEEP(253). GE. 300) + DO K = 1, NFRONT-JMAX-KEEP(253) + JJ = JJ_ini + int(K,8)*NFRONT8 + TMAX=max(TMAX,abs(A(JJ))) + ENDDO + DO KK = APOSJ, POSPV2 - 1_8 + IF (KK.NE.OFFDAG) THEN + TMAX = max(TMAX,abs(A(KK))) + ENDIF + ENDDO + ENDIF + DETPIV = A(POSPV1)*A(POSPV2) - A(OFFDAG)**2 + IF (SEUIL.GT.RZERO) THEN + IF (sqrt(abs(DETPIV)) .LE. SEUIL ) GOTO 460 + ENDIF + MAXPIV = max(abs(A(POSPV1)),abs(A(POSPV2))) + IF (MAXPIV.EQ.RZERO) MAXPIV = RONE + IF (abs(DETPIV)/MAXPIV.LE.TOL) GO TO 460 + IF ((abs(A(POSPV2))*RMAX+AMAX*TMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF ((abs(A(POSPV1))*TMAX+AMAX*RMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF (KEEP(258) .NE.0 ) THEN + CALL SMUMPS_762(DETPIV, DKEEP(6), KEEP(259)) + ENDIF + PIVSIZ = 2 + KEEP(103) = KEEP(103)+1 + IF(DETPIV .LT. RZERO) THEN + NNEG = NNEG+1 + ELSE IF(A(POSPV2) .LT. RZERO) THEN + NNEG = NNEG+2 + ENDIF + 415 CONTINUE + DO K=1,PIVSIZ + IF (PIVSIZ .EQ. 2) THEN + IF (K==1) THEN + LPIV = min(IPIV,JMAX) + ELSE + LPIV = max(IPIV,JMAX) + ENDIF + ELSE + LPIV = IPIV + ENDIF + IF (LPIV.EQ.NPIVP1) THEN + GOTO 416 + ENDIF + CALL SMUMPS_319( A, LA, IW, LIW, + & IOLDPS, NPIVP1, LPIV, POSELT, NASS, + & LDA, NFRONT, 1, KEEP(219), KEEP(50), + & KEEP(IXSZ)) + 416 CONTINUE + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL SMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, LPIV, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + NPIVP1 = NPIVP1 + 1 + ENDDO + IF(PIVSIZ .EQ. 2) THEN + A(POSELT+(LDA8+1_8)*int(NPIV,8)+1_8) = DETPIV + ENDIF + GOTO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 420 + 630 CONTINUE + PIVSIZ = 0 + IFLAG = -10 + 420 CONTINUE + IS_MAXFROMM_AVAIL = .FALSE. + RETURN + END SUBROUTINE SMUMPS_222 + SUBROUTINE SMUMPS_680( PIVRPTR, NBPANELS, PIVR, NASS, + & K, P, LastPanelonDisk, + & LastPIVRPTRIndexFilled) + IMPLICIT NONE + INTEGER, intent(in) :: NBPANELS, NASS, K, P + INTEGER, intent(inout) :: PIVRPTR(NBPANELS), PIVR(NASS) + INTEGER LastPanelonDisk, LastPIVRPTRIndexFilled + INTEGER I + IF ( LastPanelonDisk+1 > NBPANELS ) THEN + WRITE(*,*) "INTERNAL ERROR IN SMUMPS_680!" + WRITE(*,*) "NASS=",NASS,"PIVRPTR=",PIVRPTR(1:NBPANELS) + WRITE(*,*) "K=",K, "P=",P, "LastPanelonDisk=",LastPanelonDisk + WRITE(*,*) "LastPIVRPTRIndexFilled=", LastPIVRPTRIndexFilled + CALL MUMPS_ABORT() + ENDIF + PIVRPTR(LastPanelonDisk+1) = K + 1 + IF (LastPanelonDisk.NE.0) THEN + PIVR(K - PIVRPTR(1) + 1) = P + DO I = LastPIVRPTRIndexFilled + 1, LastPanelonDisk + PIVRPTR(I)=PIVRPTR(LastPIVRPTRIndexFilled) + ENDDO + ENDIF + LastPIVRPTRIndexFilled = LastPanelonDisk + 1 + RETURN + END SUBROUTINE SMUMPS_680 + SUBROUTINE SMUMPS_226(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW, + & A,LA,LDA, POSTPONE_COL_UPDATE, + & IOLDPS,POSELT,IFINB,LKJIB,PIVSIZ,XSIZE, + & MAXFROMM, IS_MAXFROMM_AVAIL, IS_MAX_USEFUL, + & KEEP253) + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFINB,LKJIB, + & NPBEG, IBEG_BLOCK + INTEGER LDA + INTEGER(8) :: LA + INTEGER(8) :: NFRONT8 + REAL A(LA) + LOGICAL POSTPONE_COL_UPDATE + INTEGER IW(LIW) + REAL VALPIV + INTEGER(8) :: POSELT + REAL, intent(out) :: MAXFROMM + LOGICAL, intent(out) :: IS_MAXFROMM_AVAIL + LOGICAL, intent(in) :: IS_MAX_USEFUL + INTEGER, INTENT(in) :: KEEP253 + REAL :: MAXFROMMTMP + INTEGER IOLDPS, NCB1 + INTEGER(8) :: LDA8 + INTEGER(8) :: K1POS + INTEGER NPIV,JROW2 + INTEGER NEL2,NEL + INTEGER XSIZE + REAL ONE, ZERO + INTEGER(8) :: APOS, LPOS, LPOS1, LPOS2 + INTEGER(8) :: POSPV1, POSPV2 + INTEGER PIVSIZ,NPIV_NEW,J2,I + INTEGER(8) :: OFFDAG, OFFDAG_OLD, IBEG, IEND + INTEGER(8) :: JJ, K1, K2, IROW + REAL SWOP,DETPIV,MULT1,MULT2 + INCLUDE 'mumps_headers.h' + PARAMETER(ONE = 1.0E0, + & ZERO = 0.0E0) + LDA8 = int(LDA,8) + NFRONT8= int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIV_NEW = NPIV + PIVSIZ + NEL = NFRONT - NPIV_NEW + IFINB = 0 + IS_MAXFROMM_AVAIL = .FALSE. + JROW2 = IW(IOLDPS+3+XSIZE) + NPBEG = IBEG_BLOCK + NEL2 = JROW2 - NPIV_NEW + IF (NEL2.EQ.0) THEN + IF (JROW2.EQ.NASS) THEN + IFINB = -1 + ELSE + IFINB = 1 + ENDIF + ENDIF + IF(PIVSIZ .EQ. 1) THEN + APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + VALPIV = ONE/A(APOS) + A(APOS) = VALPIV + LPOS = APOS + LDA8 + MAXFROMM = 0.0E00 + IF (NEL2 > 0) THEN + IF (.NOT. IS_MAX_USEFUL) THEN + DO I=1, NEL2 + K1POS = LPOS + int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + DO JJ=1_8, int(I,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + ELSE + IS_MAXFROMM_AVAIL = .TRUE. + DO I=1, NEL2 + K1POS = LPOS + int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + A(K1POS+1_8)=A(K1POS+1_8) - A(K1POS) * A(APOS+1_8) + MAXFROMM=max( MAXFROMM,abs(A(K1POS+1_8)) ) + DO JJ = 2_8, int(I,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + ENDIF + ENDIF + IF (POSTPONE_COL_UPDATE) THEN + NCB1 = NASS - JROW2 + ELSE + NCB1 = NFRONT - JROW2 + ENDIF + IF (.NOT. IS_MAX_USEFUL) THEN + DO I=NEL2+1, NEL2 + NCB1 + K1POS = LPOS+ int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + DO JJ = 1_8, int(NEL2,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + ELSE + MAXFROMMTMP=0.0E0 + DO I=NEL2+1, NEL2 + NCB1 - KEEP253 + K1POS = LPOS+ int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + IF (NEL2 > 0) THEN + A(K1POS+1_8) = A(K1POS+1_8) - A(K1POS) * A(APOS+1_8) + MAXFROMMTMP=max(MAXFROMMTMP, abs(A(K1POS+1_8))) + DO JJ = 2_8, int(NEL2,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDIF + ENDDO + DO I = NEL2 + NCB1 - KEEP253 + 1, NEL2 + NCB1 + K1POS = LPOS+ int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + DO JJ = 1_8, int(NEL2,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + MAXFROMM=max(MAXFROMM, MAXFROMMTMP) + ENDIF + ELSE + POSPV1 = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + POSPV2 = POSPV1 + NFRONT8 + 1_8 + OFFDAG_OLD = POSPV2 - 1_8 + OFFDAG = POSPV1 + 1_8 + SWOP = A(POSPV2) + DETPIV = A(OFFDAG) + A(POSPV2) = A(POSPV1)/DETPIV + A(POSPV1) = SWOP/DETPIV + A(OFFDAG) = -A(OFFDAG_OLD)/DETPIV + A(OFFDAG_OLD) = ZERO + LPOS1 = POSPV2 + LDA8 - 1_8 + LPOS2 = LPOS1 + 1_8 + CALL scopy(NFRONT-NPIV_NEW, A(LPOS1), LDA, A(POSPV1+2_8), 1) + CALL scopy(NFRONT-NPIV_NEW, A(LPOS2), LDA, A(POSPV2+1_8), 1) + JJ = POSPV2 + NFRONT8-1_8 + IBEG = JJ + 2_8 + IEND = IBEG + DO J2 = 1,NEL2 + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(OFFDAG)*A(K2)) + MULT2 = - (A(OFFDAG)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1 + 2_8 + K2 = POSPV2 + 1_8 + DO IROW = IBEG, IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A( JJ ) = -MULT1 + A( JJ + 1_8 ) = -MULT2 + IBEG = IBEG + NFRONT8 + IEND = IEND + NFRONT8 + 1_8 + JJ = JJ+NFRONT8 + ENDDO + IEND = IEND-1_8 + DO J2 = JROW2+1,NFRONT + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(OFFDAG)*A(K2)) + MULT2 = - (A(OFFDAG)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1 + 2_8 + K2 = POSPV2 + 1_8 + DO IROW = IBEG, IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A( JJ ) = -MULT1 + A( JJ + 1_8 ) = -MULT2 + IBEG = IBEG + NFRONT8 + IEND = IEND + NFRONT8 + JJ = JJ + NFRONT8 + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_226 + SUBROUTINE SMUMPS_230(NFRONT,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT) + IMPLICIT NONE + INTEGER NFRONT,N,INODE,LIW + INTEGER(8) :: LA + REAL A(LA) + INTEGER IW(LIW) + REAL VALPIV + INTEGER (8) :: APOS, POSELT, LPOS, NFRONT8 + INTEGER IOLDPS,NEL + INTEGER JROW + REAL, PARAMETER :: ONE = 1.0E0 + APOS = POSELT + VALPIV = ONE/A(APOS) + A(APOS) = VALPIV + NEL = NFRONT - 1 + IF (NEL.EQ.0) GO TO 500 + NFRONT8 = int(NFRONT,8) + LPOS = APOS + NFRONT8 + CALL SMUMPS_XSYR('U',NEL, -VALPIV, + & A(LPOS), NFRONT, A(LPOS+1_8), NFRONT) + DO JROW = 1,NEL + A(LPOS) = VALPIV*A(LPOS) + LPOS = LPOS + NFRONT8 + END DO + 500 CONTINUE + RETURN + END SUBROUTINE SMUMPS_230 + SUBROUTINE SMUMPS_234(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, + & IOLDPS,POSELT,LKJIB_ORIG,LKJIB,LKJIT, + & POSTPONE_COL_UPDATE, + & KEEP,KEEP8 ) + IMPLICIT NONE + INTEGER NFRONT, NASS,N,LIW, IBEG_BLOCK + INTEGER(8) :: LA + REAL A(LA) + INTEGER IW(LIW) + INTEGER LKJIB_ORIG, LKJIB, INODE, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: POSELT + INTEGER LDA + INTEGER(8) :: LDA8 + INTEGER IOLDPS, NPIV, JROW2, NPBEG + INTEGER NONEL, LKJIW, NEL1, NEL11 + INTEGER LBP, HF + INTEGER(8) :: LPOS,UPOS,APOS + INTEGER LKJIT + INTEGER LKJIBOLD, IROW + INTEGER I, Block + INTEGER BLSIZE + LOGICAL POSTPONE_COL_UPDATE + REAL ONE, ALPHA + INCLUDE 'mumps_headers.h' + PARAMETER (ONE=1.0E0, ALPHA=-1.0E0) + LDA8 = int(LDA,8) + LKJIBOLD = LKJIB + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + JROW2 = iabs(IW(IOLDPS+3+KEEP(IXSZ))) + NPBEG = IBEG_BLOCK + HF = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + NEL1 = NASS - JROW2 + LKJIW = NPIV - NPBEG + 1 + NEL11 = NFRONT - NPIV + IF ( LKJIW .NE. LKJIB ) THEN + NONEL = JROW2 - NPIV + 1 + IF ((NASS-NPIV).GE.LKJIT) THEN + LKJIB = LKJIB_ORIG + NONEL + IW(IOLDPS+3+KEEP(IXSZ))= min0(NPIV+LKJIB,NASS) + LKJIB = min0(LKJIB, NASS - NPIV) + ELSE + LKJIB = NASS - NPIV + IW(IOLDPS+3+KEEP(IXSZ)) = NASS + ENDIF + IBEG_BLOCK = NPIV + 1 + ELSEIF (JROW2.LT.NASS) THEN + IBEG_BLOCK = NPIV + 1 + IW(IOLDPS+3+KEEP(IXSZ)) = min0(JROW2+LKJIB,NASS) + LKJIB = min0(LKJIB,NASS-NPIV) + ENDIF + IF (LKJIW.EQ.0) GO TO 500 + IF (NEL1.NE.0) THEN + IF ( NASS - JROW2 > KEEP(7) ) THEN + BLSIZE = KEEP(8) + ELSE + BLSIZE = NASS - JROW2 + END IF + IF ( NASS - JROW2 .GT. 0 ) THEN +#if defined(SAK_BYROW) + DO IROW = JROW2+1, NASS, BLSIZE + Block = min( BLSIZE, NASS - IROW + 1 ) + LPOS = POSELT + int(IROW - 1,8) * LDA8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG - 1,8) * LDA8 + int(IROW - 1,8) + APOS = POSELT + int(IROW - 1,8) * LDA8 + int(JROW2,8) + CALL sgemm( 'N','N', IROW + Block - JROW2 - 1, Block, LKJIW, + & ALPHA, A( UPOS ), LDA, + & A( LPOS ), LDA, ONE, A( APOS ), LDA ) + ENDDO +#else + DO IROW = JROW2+1, NASS, BLSIZE + Block = min( BLSIZE, NASS - IROW + 1 ) + LPOS = POSELT + int( IROW - 1,8) * LDA8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG - 1,8) * LDA8 + int( IROW - 1,8) + APOS = POSELT + int( IROW - 1,8) * LDA8 + int( IROW - 1,8) + CALL sgemm( 'N','N', Block, NASS - IROW + 1, LKJIW, + & ALPHA, A( UPOS ), LDA, + & A( LPOS ), LDA, ONE, A( APOS ), LDA ) + END DO +#endif + END IF + LPOS = POSELT + int(NASS,8)*LDA8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG-1,8) * LDA8 + int(JROW2,8) + APOS = POSELT + int(NASS,8)*LDA8 + int(JROW2,8) + IF ( .NOT. POSTPONE_COL_UPDATE ) THEN + CALL sgemm('N', 'N', NEL1, NFRONT-NASS, LKJIW, ALPHA, + & A(UPOS), LDA, A(LPOS), LDA, ONE, + & A(APOS), LDA) + END IF + ENDIF + 500 CONTINUE + RETURN + END SUBROUTINE SMUMPS_234 + SUBROUTINE SMUMPS_319( A, LA, IW, LIW, + & IOLDPS, NPIVP1, IPIV, POSELT, NASS, + & LDA, NFRONT, LEVEL, K219, K50, XSIZE ) + IMPLICIT NONE + INTEGER(8) :: POSELT, LA + INTEGER LIW, IOLDPS, NPIVP1, IPIV + INTEGER LDA, NFRONT, NASS, LEVEL, K219, K50, XSIZE + REAL A( LA ) + INTEGER IW( LIW ) + INCLUDE 'mumps_headers.h' + INTEGER ISW, ISWPS1, ISWPS2, HF + INTEGER(8) :: IDIAG, APOS + INTEGER(8) :: LDA8 + REAL SWOP + LDA8 = int(LDA,8) + APOS = POSELT + LDA8*int(IPIV-1,8) + int(NPIVP1-1,8) + IDIAG = APOS + int(IPIV - NPIVP1,8) + HF = 6 + IW( IOLDPS + 5 + XSIZE) + XSIZE + ISWPS1 = IOLDPS + HF + NPIVP1 - 1 + ISWPS2 = IOLDPS + HF + IPIV - 1 + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + ISW = IW(ISWPS1+NFRONT) + IW(ISWPS1+NFRONT) = IW(ISWPS2+NFRONT) + IW(ISWPS2+NFRONT) = ISW + IF ( LEVEL .eq. 2 ) THEN + CALL sswap( NPIVP1 - 1, + & A( POSELT + int(NPIVP1-1,8) ), LDA, + & A( POSELT + int(IPIV-1,8) ), LDA ) + END IF + CALL sswap( NPIVP1-1, + & A( POSELT+int(NPIVP1-1,8) * LDA8 ), 1, + & A( POSELT + int(IPIV-1,8) * LDA8 ), 1 ) + CALL sswap( IPIV - NPIVP1 - 1, + & A( POSELT+int(NPIVP1,8) * LDA8 + int(NPIVP1-1,8) ), + & LDA, A( APOS + 1_8 ), 1 ) + SWOP = A(IDIAG) + A(IDIAG) = A( POSELT+int(NPIVP1-1,8)*LDA8+int(NPIVP1-1,8) ) + A( POSELT + int(NPIVP1-1,8)*LDA8 + int(NPIVP1-1,8) ) = SWOP + CALL sswap( NASS - IPIV, A( APOS + LDA8 ), LDA, + & A( IDIAG + LDA8 ), LDA ) + IF ( LEVEL .eq. 1 ) THEN + CALL sswap( NFRONT - NASS, + & A( APOS + int(NASS-IPIV+1,8) * LDA8 ), LDA, + & A( IDIAG + int(NASS-IPIV+1,8) * LDA8 ), LDA ) + END IF + IF (K219.NE.0 .AND.K50.EQ.2) THEN + IF ( LEVEL .eq. 2) THEN + APOS = POSELT+LDA8*LDA8-1_8 + SWOP = A(APOS+int(NPIVP1,8)) + A(APOS+int(NPIVP1,8))= A(APOS+int(IPIV,8)) + A(APOS+int(IPIV,8)) = SWOP + ENDIF + ENDIF + RETURN + END SUBROUTINE SMUMPS_319 + SUBROUTINE SMUMPS_237(NFRONT,NASS,N,INODE, + & IW,LIW,A,LA, + & LDA, + & IOLDPS,POSELT,KEEP,KEEP8, + & POSTPONE_COL_UPDATE, ETATASS, + & TYPEFile, LAFAC, MonBloc, NextPiv2beWritten, + & LIWFAC, MYID, IFLAG + & ) + USE SMUMPS_OOC + IMPLICIT NONE + INTEGER NFRONT, NASS,N,INODE,LIW + INTEGER(8) :: LA + REAL A(LA) + INTEGER IW(LIW) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: POSELT + INTEGER LDA + INTEGER IOLDPS, ETATASS + LOGICAL POSTPONE_COL_UPDATE + INTEGER(8) :: LAFAC + INTEGER TYPEFile, NextPiv2beWritten + INTEGER LIWFAC, MYID, IFLAG + TYPE(IO_BLOCK):: MonBloc + INTEGER IDUMMY + LOGICAL LAST_CALL + INCLUDE 'mumps_headers.h' + INTEGER(8) :: UPOS, APOS, LPOS + INTEGER(8) :: LDA8 + INTEGER BLSIZE, BLSIZE2, Block, IROW, NPIV, I, IROWEND + INTEGER I2, I2END, Block2 + REAL ONE, ALPHA, BETA, ZERO + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + PARAMETER (ZERO=0.0E0) + LDA8 = int(LDA,8) + IF (ETATASS.EQ.1) THEN + BETA = ZERO + ELSE + BETA = ONE + ENDIF + IF ( NFRONT - NASS > KEEP(57) ) THEN + BLSIZE = KEEP(58) + ELSE + BLSIZE = NFRONT - NASS + END IF + BLSIZE2 = KEEP(218) + NPIV = IW( IOLDPS + 1 + KEEP(IXSZ)) + IF ( NFRONT - NASS .GT. 0 ) THEN + IF ( POSTPONE_COL_UPDATE ) THEN + CALL strsm( 'L', 'U', 'T', 'U', + & NPIV, NFRONT-NPIV, ONE, + & A( POSELT ), LDA, + & A( POSELT + LDA8 * int(NPIV,8) ), LDA ) + ENDIF + DO IROWEND = NFRONT - NASS, 1, -BLSIZE + Block = min( BLSIZE, IROWEND ) + IROW = IROWEND - Block + 1 + LPOS = POSELT + int(NASS,8)*LDA8 + int(IROW-1,8) * LDA8 + APOS = POSELT + int(NASS,8)*LDA8 + int(IROW-1,8) * LDA8 + + & int(NASS + IROW - 1,8) + UPOS = POSELT + int(NASS,8) + IF (.NOT. POSTPONE_COL_UPDATE) THEN + UPOS = POSELT + int(NASS + IROW - 1,8) + ENDIF + IF (POSTPONE_COL_UPDATE) THEN + DO I = 1, NPIV + CALL scopy( Block, A( LPOS+int(I-1,8) ), LDA, + & A( UPOS+int(I-1,8)*LDA8 ), 1 ) + CALL sscal( Block, A(POSELT+(LDA8+1_8)*int(I-1,8)), + & A( LPOS + int(I - 1,8) ), LDA ) + ENDDO + ENDIF + DO I2END = Block, 1, -BLSIZE2 + Block2 = min(BLSIZE2, I2END) + I2 = I2END - Block2+1 + CALL sgemm('N', 'N', Block2, Block-I2+1, NPIV, ALPHA, + & A(UPOS+int(I2-1,8)), LDA, + & A(LPOS+int(I2-1,8)*LDA8), LDA, + & BETA, + & A(APOS + int(I2-1,8) + int(I2-1,8)*LDA8), LDA) + IF (KEEP(201).EQ.1) THEN + IF (NextPiv2beWritten.LE.NPIV) THEN + LAST_CALL=.FALSE. + CALL SMUMPS_688( + & STRAT_TRY_WRITE, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, MYID, + & KEEP8(31), + & IFLAG,LAST_CALL ) + IF (IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + ENDDO + IF ( NFRONT - NASS - IROW + 1 - Block > 0 ) THEN + CALL sgemm( 'N', 'N', Block, NFRONT-NASS-Block-IROW+1, NPIV, + & ALPHA, A( UPOS ), LDA, + & A( LPOS + LDA8 * int(Block,8) ), LDA, + & BETA, + & A( APOS + LDA8 * int(Block,8) ), LDA ) + ENDIF + END DO + END IF + RETURN + END SUBROUTINE SMUMPS_237 + SUBROUTINE SMUMPS_320( BUF, BLOCK_SIZE, + & MYROW, MYCOL, NPROW, NPCOL, + & A, LOCAL_M, LOCAL_N, N, MYID, COMM ) + IMPLICIT NONE + INTEGER BLOCK_SIZE, NPROW, NPCOL, LOCAL_M, LOCAL_N, N, COMM + INTEGER MYROW, MYCOL, MYID + REAL BUF( BLOCK_SIZE * BLOCK_SIZE ) + REAL A( LOCAL_M, LOCAL_N ) + INTEGER NBLOCK, IBLOCK, JBLOCK, IBLOCK_SIZE, JBLOCK_SIZE + INTEGER ROW_SOURCE, ROW_DEST, COL_SOURCE, COL_DEST + INTEGER IGLOB, JGLOB + INTEGER IROW_LOC_SOURCE, JCOL_LOC_SOURCE + INTEGER IROW_LOC_DEST, JCOL_LOC_DEST + INTEGER PROC_SOURCE, PROC_DEST + NBLOCK = ( N - 1 ) / BLOCK_SIZE + 1 + DO IBLOCK = 1, NBLOCK + IF ( IBLOCK .NE. NBLOCK + & ) THEN + IBLOCK_SIZE = BLOCK_SIZE + ELSE + IBLOCK_SIZE = N - ( NBLOCK - 1 ) * BLOCK_SIZE + END IF + ROW_SOURCE = mod( IBLOCK - 1, NPROW ) + COL_DEST = mod( IBLOCK - 1, NPCOL ) + IGLOB = ( IBLOCK - 1 ) * BLOCK_SIZE + 1 + IROW_LOC_SOURCE = BLOCK_SIZE * + & ( ( IGLOB - 1 ) / (BLOCK_SIZE*NPROW) ) + & + mod( IGLOB - 1, BLOCK_SIZE ) + 1 + JCOL_LOC_DEST = BLOCK_SIZE * + & ( ( IGLOB - 1 ) / (BLOCK_SIZE*NPCOL) ) + & + mod( IGLOB - 1, BLOCK_SIZE ) + 1 + DO JBLOCK = 1, IBLOCK + IF ( JBLOCK .NE. NBLOCK + & ) THEN + JBLOCK_SIZE = BLOCK_SIZE + ELSE + JBLOCK_SIZE = N - ( NBLOCK - 1 ) * BLOCK_SIZE + END IF + COL_SOURCE = mod( JBLOCK - 1, NPCOL ) + ROW_DEST = mod( JBLOCK - 1, NPROW ) + PROC_SOURCE = ROW_SOURCE * NPCOL + COL_SOURCE + PROC_DEST = ROW_DEST * NPCOL + COL_DEST + IF ( PROC_SOURCE .eq. PROC_DEST ) THEN + IF ( MYID .eq. PROC_DEST ) THEN + JGLOB = ( JBLOCK - 1 ) * BLOCK_SIZE + 1 + JCOL_LOC_SOURCE = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPCOL) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + IROW_LOC_DEST = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPROW) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + IF ( IBLOCK .eq. JBLOCK ) THEN + IF ( IBLOCK_SIZE .ne. JBLOCK_SIZE ) THEN + WRITE(*,*) MYID,': Error in calling transdiag:unsym' + CALL MUMPS_ABORT() + END IF + CALL SMUMPS_327( A( IROW_LOC_SOURCE, + & JCOL_LOC_SOURCE), + & IBLOCK_SIZE, LOCAL_M ) + ELSE + CALL SMUMPS_326( + & A( IROW_LOC_SOURCE, JCOL_LOC_SOURCE ), + & A( IROW_LOC_DEST, JCOL_LOC_DEST ), + & IBLOCK_SIZE, JBLOCK_SIZE, LOCAL_M ) + END IF + END IF + ELSE IF ( MYROW .eq. ROW_SOURCE + & .AND. MYCOL .eq. COL_SOURCE ) THEN + JGLOB = ( JBLOCK - 1 ) * BLOCK_SIZE + 1 + JCOL_LOC_SOURCE = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPCOL) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + CALL SMUMPS_293( BUF, + & A( IROW_LOC_SOURCE, JCOL_LOC_SOURCE ), LOCAL_M, + & IBLOCK_SIZE, JBLOCK_SIZE, COMM, PROC_DEST ) + ELSE IF ( MYROW .eq. ROW_DEST + & .AND. MYCOL .eq. COL_DEST ) THEN + JGLOB = ( JBLOCK - 1 ) * BLOCK_SIZE + 1 + IROW_LOC_DEST = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPROW) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + CALL SMUMPS_281( BUF, + & A( IROW_LOC_DEST, JCOL_LOC_DEST ), LOCAL_M, + & JBLOCK_SIZE, IBLOCK_SIZE, COMM, PROC_SOURCE ) + END IF + END DO + END DO + RETURN + END SUBROUTINE SMUMPS_320 + SUBROUTINE SMUMPS_293( BUF, A, LDA, M, N, COMM, DEST ) + IMPLICIT NONE + INTEGER M, N, LDA, DEST, COMM + REAL BUF(*), A(LDA,*) + INTEGER I, IBUF, IERR + INTEGER J + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + IBUF = 1 + DO J = 1, N + BUF( IBUF: IBUF + M - 1 ) = A( 1 : M, J ) + DO I = 1, M + END DO + IBUF = IBUF + M + END DO + CALL MPI_SEND( BUF, M * N, MPI_REAL, + & DEST, SYMMETRIZE, COMM, IERR ) + RETURN + END SUBROUTINE SMUMPS_293 + SUBROUTINE SMUMPS_281( BUF, A, LDA, M, N, COMM, SOURCE ) + IMPLICIT NONE + INTEGER LDA, M, N, COMM, SOURCE + REAL BUF(*), A( LDA, *) + INTEGER I, IBUF, IERR + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + CALL MPI_RECV( BUF(1), M * N, MPI_REAL, SOURCE, + & SYMMETRIZE, COMM, STATUS, IERR ) + IBUF = 1 + DO I = 1, M + CALL scopy( N, BUF(IBUF), 1, A(I,1), LDA ) + IBUF = IBUF + N + END DO + RETURN + END SUBROUTINE SMUMPS_281 + SUBROUTINE SMUMPS_327( A, N, LDA ) + IMPLICIT NONE + INTEGER N,LDA + REAL A( LDA, * ) + INTEGER I, J + DO I = 2, N + DO J = 1, I - 1 + A( J, I ) = A( I, J ) + END DO + END DO + RETURN + END SUBROUTINE SMUMPS_327 + SUBROUTINE SMUMPS_326( A1, A2, M, N, LD ) + IMPLICIT NONE + INTEGER M,N,LD + REAL A1( LD,* ), A2( LD, * ) + INTEGER I, J + DO J = 1, N + DO I = 1, M + A2( J, I ) = A1( I, J ) + END DO + END DO + RETURN + END SUBROUTINE SMUMPS_326 + RECURSIVE SUBROUTINE SMUMPS_274( + & COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE SMUMPS_COMM_BUFFER + USE SMUMPS_LOAD + USE SMUMPS_OOC + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mumps_headers.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER(8) IPTRLU, LRLU, LRLUS, LA, POSFAC + INTEGER COMP + INTEGER IFLAG, IERROR, NBFIN, MSGSOU + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)) + INTEGER(8) PTRAST(KEEP(28)), PTRFAC(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER NBPROCFILS( KEEP(28) ), STEP(N), + & PIMASTER(KEEP(28)) + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER COMM, MYID + INTEGER PTLUST_S(KEEP(28)), + & ITLOC(N+KEEP(253)), FILS(N), ND(KEEP(28)) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER FRERE_STEPS(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION FLOP1 + REAL DBLARR( max(1,KEEP(13)) ) + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER PIVI + INTEGER (8) POSPV1,POSPV2,OFFDAG,LPOS1 + INTEGER J2 + REAL MULT1,MULT2 + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER LP + INTEGER INODE, POSITION, NPIV, IERR + INTEGER NCOL + INTEGER(8) LAELL, POSBLOCFACTO + INTEGER(8) POSELT + INTEGER IOLDPS, LCONT1, NASS1, NROW1, NCOL1, NPIV1 + INTEGER NSLAV1, HS, ISW, DEST + INTEGER ICT11 + INTEGER(8) LPOS, LPOS2, DPOS, UPOS + INTEGER (8) IPOS, KPOS + INTEGER I, IPIV, FPERE, NSLAVES_TOT, + & NSLAVES_FOLLOW, NB_BLOC_FAC + INTEGER IPOSK, JPOSK, NPIVSENT, Block, IROW, BLSIZE + INTEGER allocok, TO_UPDATE_CPT_END + REAL, DIMENSION(:),ALLOCATABLE :: UIP21K + INTEGER, DIMENSION(:), ALLOCATABLE :: LIST_SLAVES_FOLLOW + LOGICAL LASTBL + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + REAL ONE,ALPHA + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, NextPivDummy + LOGICAL LAST_CALL + TYPE(IO_BLOCK) :: MonBloc + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + FPERE = -1 + POSITION = 0 + TO_UPDATE_CPT_END = -654321 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, + & MPI_INTEGER, COMM, IERR ) + LASTBL = (NPIV.LE.0) + IF (LASTBL) THEN + NPIV = -NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NSLAVES_TOT, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NB_BLOC_FAC, 1, + & MPI_INTEGER, COMM, IERR ) + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOL, 1, + & MPI_INTEGER, COMM, IERR ) + LAELL = int(NPIV,8) * int(NCOL,8) + IF ( NPIV.GT.0 ) THEN + IF ( LRLU .LT. LAELL .OR. IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LAELL ) THEN + IFLAG = -9 + CALL MUMPS_731(LAELL-LRLUS, IERROR) + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE IN SMUMPS_274, + & REAL WORKSPACE TOO SMALL" + GOTO 700 + END IF + CALL SMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS=' + & ,LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731(LAELL-LRLUS,IERROR) + GOTO 700 + END IF + IF ( IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE IN SMUMPS_274, + & INTEGER WORKSPACE TOO SMALL" + IFLAG = -8 + IERROR = IWPOS + NPIV - 1 - IWPOSCB + GOTO 700 + END IF + END IF + LRLU = LRLU - LAELL + LRLUS = LRLUS - LAELL + ENDIF + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSBLOCFACTO = POSFAC + POSFAC = POSFAC + LAELL + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LAELL,KEEP,KEEP8,LRLU) + IF ( NPIV.GT.0 ) THEN + IPIV = IWPOS + IWPOS = IWPOS + NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IPIV ), NPIV, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSBLOCFACTO), NPIV*NCOL, MPI_REAL, + & COMM, IERR ) + ENDIF + IF (PTRIST(STEP( INODE )) .EQ. 0) THEN + DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 ) + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + ENDIF + DO WHILE ( NBPROCFILS(STEP(INODE)) .NE. 0 ) + BLOCKING = .TRUE. + SET_IRECV=.FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, CONTRIB_TYPE2, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .TRUE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + LCONT1 = IW( IOLDPS + KEEP(IXSZ)) + NASS1 = IW( IOLDPS + 1 + KEEP(IXSZ)) + NROW1 = IW( IOLDPS + 2 + KEEP(IXSZ)) + NPIV1 = IW( IOLDPS + 3 + KEEP(IXSZ)) + NSLAV1 = IW( IOLDPS + 5 + KEEP(IXSZ)) + NSLAVES_FOLLOW = NSLAV1 - XTRA_SLAVES_SYM + HS = 6 + NSLAV1 + KEEP(IXSZ) + NCOL1 = LCONT1 + NPIV1 + IF ( LASTBL ) THEN + TO_UPDATE_CPT_END = ( NSLAVES_TOT - NSLAVES_FOLLOW - 1 ) * + & NB_BLOC_FAC + END IF + IF (NPIV.GT.0) THEN + IF ( NPIV1 + NCOL .NE. NASS1 ) THEN + WRITE(*,*) 'SymBLFC Error: NPIV1 + NCOL .NE. NASS1 :', + & NPIV1,NCOL,NASS1 + CALL MUMPS_ABORT() + END IF + ICT11 = IOLDPS+HS+NROW1+NPIV1 - 1 + DO I = 1, NPIV + PIVI = abs(IW(IPIV+I-1)) + IF (PIVI.EQ.I) CYCLE + ISW = IW(ICT11+I) + IW(ICT11+I) = IW(ICT11+PIVI) + IW(ICT11+PIVI) = ISW + IPOS = POSELT + int(NPIV1 + I - 1,8) + KPOS = POSELT + int(NPIV1 + PIVI - 1,8) + CALL sswap(NROW1, A(IPOS), NCOL1, A(KPOS), NCOL1) + ENDDO + ALLOCATE( UIP21K( NPIV * NROW1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": ALLOCATION FAILURE FOR UIP21K IN SMUMPS_274" + IFLAG = -13 + IERROR = NPIV * NROW1 + GOTO 700 + END IF + IF ( NSLAVES_FOLLOW .NE. 0 .and. NPIV .NE. 0 ) THEN + ALLOCATE( LIST_SLAVES_FOLLOW ( NSLAVES_FOLLOW ), + & stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": ALLOCATION FAILURE FOR LIST_SLAVES_FOLLOW + & IN SMUMPS_274" + IFLAG = -13 + IERROR = NSLAVES_FOLLOW + GOTO 700 + END IF + LIST_SLAVES_FOLLOW(1:NSLAVES_FOLLOW)= + & IW(IOLDPS+6+XTRA_SLAVES_SYM+KEEP(IXSZ): + & IOLDPS+5+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_FOLLOW) + END IF + CALL strsm( 'L', 'U', 'T', 'U', NPIV, NROW1, ONE, + & A( POSBLOCFACTO ), NCOL, + & A(POSELT+int(NPIV1,8)), NCOL1 ) + LPOS = POSELT + int(NPIV1,8) + UPOS = 1_8 + DO I = 1, NROW1 + UIP21K( UPOS: UPOS + int(NPIV-1,8) ) = + & A(LPOS: LPOS+int(NPIV-1,8)) + LPOS = LPOS + int(NCOL1,8) + UPOS = UPOS + int(NPIV,8) + END DO + LPOS = POSELT + int(NPIV1,8) + DPOS = POSBLOCFACTO + I = 1 + DO + IF(I .GT. NPIV) EXIT + IF(IW(IPIV+I-1) .GT. 0) THEN + CALL sscal( NROW1, A(DPOS), A(LPOS), NCOL1 ) + LPOS = LPOS + 1_8 + DPOS = DPOS + int(NCOL + 1,8) + I = I+1 + ELSE + POSPV1 = DPOS + POSPV2 = DPOS+ int(NCOL + 1,8) + OFFDAG = POSPV1+1_8 + LPOS1 = LPOS + DO J2 = 1,NROW1 + MULT1 = A(POSPV1)*A(LPOS1)+A(OFFDAG)*A(LPOS1+1_8) + MULT2 = A(OFFDAG)*A(LPOS1)+A(POSPV2)*A(LPOS1+1_8) + A(LPOS1) = MULT1 + A(LPOS1+1_8) = MULT2 + LPOS1 = LPOS1 + int(NCOL1,8) + ENDDO + LPOS = LPOS + 2_8 + DPOS = POSPV2 + int(NCOL + 1,8) + I = I+2 + ENDIF + ENDDO + ENDIF + IF (KEEP(201).eq.1) THEN + MonBloc%INODE = INODE + MonBloc%MASTER = .FALSE. + MonBloc%Typenode = 2 + MonBloc%NROW = NROW1 + MonBloc%NCOL = NCOL1 + MonBloc%NFS = NASS1 + MonBloc%LastPiv = NPIV1 + NPIV + NULLIFY(MonBloc%INDICES) + MonBloc%Last = LASTBL + STRAT = STRAT_TRY_WRITE + NextPivDummy = -8888 + LIWFAC = IW(IOLDPS+XXI) + CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR)) + LAST_CALL=.FALSE. + CALL SMUMPS_688( STRAT, TYPEF_L, A(POSELT), + & LAFAC, MonBloc, NextPivDummy, NextPivDummy, + & IW(IOLDPS), LIWFAC, MYID, KEEP8(31), IFLAG,LAST_CALL) + ENDIF + IF (NPIV.GT.0) THEN + LPOS2 = POSELT + int(NPIV1,8) + UPOS = POSBLOCFACTO+int(NPIV,8) + LPOS = LPOS2 + int(NPIV,8) + CALL sgemm('N','N', NCOL-NPIV,NROW1,NPIV,ALPHA,A(UPOS),NCOL, + & A(LPOS2),NCOL1,ONE, A(LPOS),NCOL1) + DPOS = POSELT + int(NCOL1 - NROW1,8) + IF ( NROW1 .GT. KEEP(7) ) THEN + BLSIZE = KEEP(8) + ELSE + BLSIZE = NROW1 + ENDIF + IF ( NROW1 .GT. 0 ) THEN + DO IROW = 1, NROW1, BLSIZE + Block = min( BLSIZE, NROW1 - IROW + 1 ) + DPOS = POSELT + int(NCOL1 - NROW1,8) + & + int( IROW - 1, 8 ) * int( NCOL1 + 1, 8 ) + LPOS2 = POSELT + int(NPIV1,8) + & + int( IROW - 1, 8 ) * int( NCOL1, 8 ) + UPOS = int( IROW - 1, 8 ) * int(NPIV, 8) + 1_8 + DO I = 1, Block + CALL sgemv( 'T', NPIV, Block-I+1, ALPHA, + & A( LPOS2 + int(I - 1,8) * int(NCOL1,8) ), NCOL1, + & UIP21K( UPOS + int(NPIV,8) * int( I - 1, 8 ) ), + & 1, ONE, A(DPOS+int(NCOL1+1,8)*int(I-1,8)),NCOL1 ) + END DO + IF ( NROW1-IROW+1-Block .ne. 0 ) + & CALL sgemm( 'T', 'N', Block, NROW1-IROW+1-Block, NPIV, ALPHA, + & UIP21K( UPOS ), NPIV, + & A( LPOS2 + int(Block,8) * int(NCOL1,8) ), NCOL1, ONE, + & A( DPOS + int(Block,8) * int(NCOL1,8) ), NCOL1 ) + ENDDO + ENDIF + FLOP1 = dble(NROW1) * dble(NPIV) * + & dble( 2 * NCOL - NPIV + NROW1 +1 ) + FLOP1 = -FLOP1 + CALL SMUMPS_190( 1, .FALSE., FLOP1, KEEP,KEEP8 ) + ENDIF + IW(IOLDPS+KEEP(IXSZ)) = IW(IOLDPS+KEEP(IXSZ)) - NPIV + IW(IOLDPS + 3+KEEP(IXSZ)) = IW(IOLDPS+3+KEEP(IXSZ)) + NPIV + IF (LASTBL) IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS + 3+KEEP(IXSZ)) + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + IWPOS = IWPOS - NPIV + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + IF ( NSLAVES_FOLLOW .NE. 0 .and. NPIV .NE. 0 ) THEN + IPOSK = NPIV1 + 1 + JPOSK = NCOL1 - NROW1 + 1 + NPIVSENT = NPIV + IERR = -1 + DO WHILE ( IERR .eq. -1 ) + CALL SMUMPS_64( + & INODE, NPIVSENT, FPERE, + & IPOSK, JPOSK, + & UIP21K, NROW1, + & NSLAVES_FOLLOW, + & LIST_SLAVES_FOLLOW(1), + & COMM, IERR ) + IF (IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END IF + END DO + IF ( IERR .eq. -2 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE, SEND BUFFER TOO SMALL DURING + & SMUMPS_274" + WRITE(LP,*) "NPIV=", NPIV, "NROW1=",NROW1 + IFLAG = -17 + IERROR = 5 * KEEP(34) + NPIV * NROW1 * KEEP(35) + GOTO 700 + END IF + IF ( IERR .eq. -3 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE, RECV BUFFER TOO SMALL DURING + & SMUMPS_274" + IFLAG = -20 + IERROR = 5 * KEEP(34) + NPIV * NROW1 * KEEP(35) + GOTO 700 + END IF + DEALLOCATE(LIST_SLAVES_FOLLOW) + END IF + IF ( NPIV .NE. 0 ) DEALLOCATE( UIP21K ) + IOLDPS = PTRIST(STEP(INODE)) + IF (LASTBL) THEN + IW(IOLDPS+6+KEEP(IXSZ)) = IW(IOLDPS+6+KEEP(IXSZ)) - + & TO_UPDATE_CPT_END + IF ( IW(IOLDPS+6+KEEP(IXSZ) ) .eq. 0 + & .and. KEEP(50) .ne. 0 .and. NSLAVES_FOLLOW .eq. 0 + & .and. NSLAVES_TOT.NE.1)THEN + DEST = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + CALL SMUMPS_62( INODE, DEST, END_NIV2_LDLT, + & COMM, IERR ) + IF ( IERR .LT. 0 ) THEN + write(*,*) ' Internal error in PROCESS_SYM_BLOCFACTO.' + IFLAG = -99 + GOTO 700 + END IF + ENDIF + END IF + IF (LASTBL) THEN + IF (IW(IOLDPS+6+KEEP(IXSZ)) .eq. 0 ) THEN + CALL SMUMPS_759( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ENDIF + ENDIF + 600 CONTINUE + RETURN + 700 CONTINUE + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE SMUMPS_274 + RECURSIVE SUBROUTINE SMUMPS_759( + & COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mumps_headers.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER INODE, FPERE + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER COMM, MYID + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER IWPOS, IWPOSCB + INTEGER LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP, IFLAG, IERROR + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER NBFIN, SLAVEF + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER ND( KEEP(28) ) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER FRERE_STEPS(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + REAL DBLARR( max(1,KEEP(13)) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER ITYPE2 + INTEGER IHDR_REC + PARAMETER (ITYPE2=2) + INTEGER IOLDPS, NROW, LDA + INTEGER NPIV, LCONT, NELIM, NASS, NCOL_TO_SEND, + & SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON + INTEGER(8) :: SHIFT_VAL_SON + INTEGER(8) MEM_GAIN + IF (KEEP(50).EQ.0) THEN + IHDR_REC=6 + ELSE + IHDR_REC=8 + ENDIF + IOLDPS = PTRIST(STEP(INODE)) + IW(IOLDPS+XXS)=S_ALL + IF (KEEP(214).EQ.1) THEN + CALL SMUMPS_314( N, INODE, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE2 + & ) + IOLDPS = PTRIST(STEP(INODE)) + IF (KEEP(38).NE.FPERE) THEN + IW(IOLDPS+XXS)=S_NOLCBNOCONTIG + IF (KEEP(216).NE.3) THEN + MEM_GAIN=int(IW( IOLDPS + 2 + KEEP(IXSZ) ),8)* + & int(IW( IOLDPS + 3 + KEEP(IXSZ) ),8) + LRLUS = LRLUS+MEM_GAIN + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLU) + ENDIF + ENDIF + IF (KEEP(216).EQ.2) THEN + IF (FPERE.NE.KEEP(38)) THEN + CALL SMUMPS_627(A,LA,PTRAST(STEP(INODE)), + & IW( IOLDPS + 2 + KEEP(IXSZ) ), + & IW( IOLDPS + KEEP(IXSZ) ), + & IW( IOLDPS + 3 + KEEP(IXSZ) )+ + & IW( IOLDPS + KEEP(IXSZ) ), 0, + & IW( IOLDPS + XXS ), 0_8 ) + IW(IOLDPS+XXS)=S_NOLCBCONTIG + IW(IOLDPS+XXS)=S_NOLCBCONTIG + ENDIF + ENDIF + ENDIF + IF ( KEEP(38).EQ.FPERE) THEN + LCONT = IW(IOLDPS+KEEP(IXSZ)) + NROW = IW(IOLDPS+2+KEEP(IXSZ)) + NPIV = IW(IOLDPS+3+KEEP(IXSZ)) + NASS = IW(IOLDPS+4+KEEP(IXSZ)) + NELIM = NASS-NPIV + NCOL_TO_SEND = LCONT-NELIM + SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NASS + SHIFT_VAL_SON = int(NASS,8) + LDA = LCONT + NPIV + IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOTBAND_INIT) THEN + IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_REC_CONTSTATIC + ELSE + ENDIF + CALL SMUMPS_80( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTRIST, PTRAST, + & root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA, + & ROOT_CONT_STATIC, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG < 0 ) GOTO 600 + IF (NELIM.EQ.0) THEN + IF (KEEP(214).EQ.2) THEN + CALL SMUMPS_314( N, INODE, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE2 + & ) + ENDIF + CALL SMUMPS_626( N, INODE, PTRIST, PTRAST, IW, LIW, + & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP, + & MYID, KEEP + & ) + ELSE + IOLDPS = PTRIST(STEP(INODE)) + IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOT2SON_CALLED) THEN + CALL SMUMPS_626( N, INODE, PTRIST, PTRAST, IW, LIW, + & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP, + & MYID, KEEP + & ) + ELSE + IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_ROOTBAND_INIT + IF (KEEP(214).EQ.1.AND.KEEP(216).NE.3) THEN + IW(IOLDPS+XXS)=S_NOLCBNOCONTIG38 + CALL SMUMPS_628( IW(IOLDPS), + & LIW-IOLDPS+1, + & MEM_GAIN, KEEP(IXSZ) ) + LRLUS = LRLUS + MEM_GAIN + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLU) + IF (KEEP(216).EQ.2) THEN + CALL SMUMPS_627(A,LA,PTRAST(STEP(INODE)), + & IW( IOLDPS + 2 + KEEP(IXSZ) ), + & IW( IOLDPS + KEEP(IXSZ) ), + & IW( IOLDPS + 3 + KEEP(IXSZ) )+ + & IW( IOLDPS + KEEP(IXSZ) ), + & IW( IOLDPS + 4 + KEEP(IXSZ) ) - + & IW( IOLDPS + 3 + KEEP(IXSZ) ), + & IW( IOLDPS + XXS ),0_8) + IW(IOLDPS+XXS)=S_NOLCBCONTIG38 + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + 600 CONTINUE + RETURN + END SUBROUTINE SMUMPS_759 + SUBROUTINE SMUMPS_141( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP,PIVNUL_LIST,LPN_LIST ) + USE SMUMPS_OOC + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, INODE, FPERE, LIW, NOFFW, NPVW + INTEGER(8) :: LA + REAL A( LA ) + REAL UU, SEUIL + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER COMM, MYID, LBUFR, LBUFR_BYTES + INTEGER LPTRAR, NELT + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS + INTEGER NBFIN, IFLAG, IERROR, LEAF, LPOOL, SLAVEF, + & IWPOS, IWPOSCB, COMP + INTEGER NB_BLOC_FAC + INTEGER ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER, TARGET :: IW( LIW ) + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER BUFR( LBUFR ), IPOOL(LPOOL), ITLOC(N+KEEP(253)) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW(LPTRAR), PTRAIW(LPTRAR), ND( KEEP(28) ) + INTEGER FRERE(KEEP(28)), FILS(N) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), + & PTLUST_S(KEEP(28)), + & + & PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), NBPROCFILS(KEEP(28)), + & PROCNODE_STEPS(KEEP(28)), STEP(N) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + REAL DBLARR(max(1,KEEP(13))) + LOGICAL AVOID_DELAYED + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER(8) :: POSELT + INTEGER INOPV, IFINB, NFRONT, NPIV, IBEGKJI, NBOLKJ, NBTLKJ + INTEGER NASS, IEND, IOLDPS, LDAFS,allocok, IBEG_BLOCK + LOGICAL LASTBL + LOGICAL RESET_TO_ONE, TO_UPDATE + INTEGER K109_ON_ENTRY + INTEGER I,J,JJ,K,IDEB + REAL UUTEMP + INCLUDE 'mumps_headers.h' + INTEGER , ALLOCATABLE, DIMENSION ( : ) :: IPIV + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten, + & IDUMMY + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INTEGER PP_FIRST2SWAP_L, IFLAG_OOC + INTEGER PP_LastPIVRPTRFilled + EXTERNAL SMUMPS_223, SMUMPS_235, + & SMUMPS_227, SMUMPS_294, + & SMUMPS_44 + LOGICAL STATICMODE + REAL SEUIL_LOC + INTEGER PIVSIZ,IWPOSPIV + REAL ONE + PARAMETER (ONE = 1.0E0) + INOPV = 0 + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + SEUIL_LOC=SEUIL + UUTEMP=UU + ENDIF + RESET_TO_ONE = ((KEEP(110).GT.0).AND.(DKEEP(2).LE.0.0E0)) + IF (RESET_TO_ONE) THEN + K109_ON_ENTRY = KEEP(109) + ENDIF + IBEG_BLOCK=1 + NB_BLOC_FAC = 0 + IOLDPS = PTLUST_S(STEP( INODE )) + POSELT = PTRAST( STEP( INODE )) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + LDAFS = NASS + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5), NASS ) + ENDIF + NBTLKJ = NBOLKJ + IW(IOLDPS+3+KEEP(IXSZ)) = min0(NASS,NBTLKJ) + IF (KEEP(201).EQ.1) THEN + IDUMMY = -9876 + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_L + NextPiv2beWritten = 1 + PP_FIRST2SWAP_L = NextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 2 + MonBloc%NROW = NASS + MonBloc%NCOL = NASS + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -66666 + MonBloc%INDICES => + & IW(IOLDPS+6+NFRONT+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ)) + & :IOLDPS+5+2*NFRONT+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))) + ENDIF + ALLOCATE( IPIV( NASS ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) MYID,' : FACTO_NIV2 :failed to allocate ',NASS, + & ' integers' + IFLAG=-13 + IERROR=NASS + GO TO 490 + END IF + 50 CONTINUE + IBEGKJI = IBEG_BLOCK + CALL SMUMPS_223( + & NFRONT,NASS,IBEGKJI, NASS, IPIV, + & N,INODE,IW,LIW,A,LA,NOFFW,INOPV, + & IFLAG,IOLDPS,POSELT,UU, SEUIL_LOC, + & KEEP,KEEP8,PIVSIZ, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled) + IF (IFLAG.LT.0) GOTO 490 + IF(KEEP(109).GT. 0) THEN + IF(PIVNUL_LIST(KEEP(109)).EQ.-1) THEN + IWPOSPIV = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6 + & +IW(IOLDPS+5+KEEP(IXSZ)) + PIVNUL_LIST(KEEP(109)) = IW(IWPOSPIV+KEEP(IXSZ)) + ENDIF + ENDIF + IF(INOPV.EQ. 1 .AND. STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + IF (INOPV.GE.1) THEN + LASTBL = (INOPV.EQ.1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL SMUMPS_294( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, LDAFS, + & IBEGKJI, IEND, IPIV, NASS,LASTBL, NB_BLOC_FAC, + & + & COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (INOPV.EQ.1) GO TO 500 + IF (INOPV.EQ.2) THEN + CALL SMUMPS_235(IBEG_BLOCK, + & NASS,N,INODE,IW,LIW,A,LA, + & LDAFS, + & IOLDPS,POSELT,NBOLKJ, NBTLKJ,KEEP(4),KEEP,KEEP8) + GOTO 50 + ENDIF + NPVW = NPVW + PIVSIZ + IF (NASS.LE.1) THEN + IFINB = -1 + IF (NASS == 1) A(POSELT)=ONE/A(POSELT) + ELSE + CALL SMUMPS_227(IBEG_BLOCK, + & NASS, N,INODE,IW,LIW,A,LA, + & LDAFS, IOLDPS,POSELT,IFINB, + & NBTLKJ,KEEP(4),PIVSIZ,KEEP(IXSZ)) + IF(PIVSIZ .EQ. 2) THEN + IWPOSPIV = IOLDPS+KEEP(IXSZ)+IW(IOLDPS+1+KEEP(IXSZ))+6+ + & IW(IOLDPS+5+KEEP(IXSZ)) + IW(IWPOSPIV+NFRONT) = -IW(IWPOSPIV+NFRONT) + ENDIF + ENDIF + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + PIVSIZ + IF (IFINB.EQ.0) GOTO 50 + IF ((IFINB.EQ.1).OR.(IFINB.EQ.-1)) THEN + LASTBL = (IFINB.EQ.-1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL SMUMPS_294(COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, LDAFS, + & IBEGKJI, IEND, IPIV, NASS, LASTBL,NB_BLOC_FAC, + & + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (IFINB.EQ.(-1)) GOTO 500 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + IF (KEEP(201).EQ.1) THEN + IF (.NOT.RESET_TO_ONE.OR.K109_ON_ENTRY.EQ.KEEP(109)) THEN + MonBloc%Last = .FALSE. + MonBloc%LastPiv= NPIV + LAST_CALL=.FALSE. + CALL SMUMPS_688( + & STRAT_TRY_WRITE, + & TYPEFile, A(POSELT), + & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS), + & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC .LT. 0 ) IFLAG = IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + CALL SMUMPS_235(IBEG_BLOCK, + & NASS,N,INODE,IW,LIW,A,LA, + & LDAFS, + & IOLDPS,POSELT,NBOLKJ,NBTLKJ,KEEP(4),KEEP,KEEP8) + IF (KEEP(201).EQ.1) THEN + IF (RESET_TO_ONE.AND.K109_ON_ENTRY.LT.KEEP(109)) THEN + IDEB = IOLDPS+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))+6 + JJ= IDEB + TO_UPDATE=.FALSE. + DO K = K109_ON_ENTRY+1, KEEP(109) + I = PIVNUL_LIST(K) + DO J=JJ,JJ+NASS + IF (IW(J).EQ.I) THEN + TO_UPDATE=.TRUE. + EXIT + ENDIF + ENDDO + IF (TO_UPDATE) THEN + JJ= J + J = J-IDEB+1 + A(POSELT+int(J-1,8)+int(LDAFS,8)*int(J-1,8))= ONE + TO_UPDATE=.FALSE. + ELSE + IF (ICNTL(1).GT.0) THEN + write(ICNTL(1),*) ' Internal error related ', + & 'to null pivot row detection' + ENDIF + EXIT + ENDIF + ENDDO + ENDIF + K109_ON_ENTRY = KEEP(109) + MonBloc%Last = .FALSE. + MonBloc%LastPiv= NPIV + LAST_CALL=.FALSE. + CALL SMUMPS_688( + & STRAT_TRY_WRITE, + & TYPEFile, A(POSELT), + & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS), + & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC .LT. 0 ) IFLAG = IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + ENDIF + GO TO 50 + 490 CONTINUE + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + IF (RESET_TO_ONE.AND.K109_ON_ENTRY.LT.KEEP(109)) THEN + IDEB = IOLDPS+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))+6 + JJ= IDEB + TO_UPDATE=.FALSE. + DO K = K109_ON_ENTRY+1, KEEP(109) + I = PIVNUL_LIST(K) + DO J=JJ,JJ+NASS + IF (IW(J).EQ.I) THEN + TO_UPDATE=.TRUE. + EXIT + ENDIF + ENDDO + IF (TO_UPDATE) THEN + JJ= J + J = J-IDEB+1 + A(POSELT+int(J-1,8)+int(LDAFS,8)*int(J-1,8))= ONE + TO_UPDATE=.FALSE. + ELSE + IF (ICNTL(1).GT.0) THEN + write(ICNTL(1),*) ' Internal error related ', + & 'to null pivot row detection' + ENDIF + EXIT + ENDIF + ENDDO + ENDIF + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + LAST_CALL = .TRUE. + CALL SMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC, LAST_CALL ) + IF (IFLAG_OOC .LT. 0 ) IFLAG = IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + CALL SMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + DEALLOCATE( IPIV ) + RETURN + END SUBROUTINE SMUMPS_141 + SUBROUTINE SMUMPS_223( NFRONT, NASS, + & IBEGKJI, NASS2, TIPIV, + & N, INODE, IW, LIW, + & A, LA, NNEG, + & INOPV, IFLAG, + & IOLDPS, POSELT, UU, + & SEUIL,KEEP,KEEP8,PIVSIZ, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV + INTEGER NASS2, IBEGKJI, NNEG + INTEGER TIPIV( NASS2 ) + INTEGER PIVSIZ,LPIV + INTEGER(8) :: LA + REAL A(LA) + REAL UU, UULOC, SEUIL + REAL CSEUIL + INTEGER IW(LIW) + INTEGER IOLDPS + INTEGER(8) :: POSELT + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + REAL DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk + INTEGER PP_LastPIVRPTRIndexFilled + include 'mpif.h' + INTEGER(8) :: POSPV1,POSPV2,OFFDAG,APOSJ + INTEGER JMAX + REAL RMAX,AMAX,TMAX,TOL + REAL MAXPIV + REAL PIVOT,DETPIV + PARAMETER(TOL = 1.0E-20) + INCLUDE 'mumps_headers.h' + INTEGER(8) :: APOSMAX + INTEGER(8) :: APOS + INTEGER(8) :: J1, J2, JJ, KK + INTEGER :: LDAFS + INTEGER(8) :: LDAFS8 + REAL, PARAMETER :: RZERO = 0.0E0 + REAL, PARAMETER :: RONE = 1.0E0 + REAL ZERO, ONE + PARAMETER( ZERO = 0.0E0 ) + PARAMETER( ONE = 1.0E0 ) + REAL PIVNUL, VALTMP + REAL FIXA + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,ILOC,K,J + INTRINSIC max + INTEGER I_PIVRPTR, I_PIVR, NBPANELS_L + PIVNUL = DKEEP(1) + FIXA = DKEEP(2) + CSEUIL = SEUIL + LDAFS = NASS + LDAFS8 = int(LDAFS,8) + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL SMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR, I_PIVR, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+KEEP(IXSZ)) + & +KEEP(IXSZ), + & IW, LIW) + ENDIF + UULOC = UU + PIVSIZ = 1 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NPIVP1 = NPIV + 1 + ILOC = NPIVP1 - IBEGKJI + 1 + TIPIV( ILOC ) = ILOC + NASSW = iabs(IW(IOLDPS+3+KEEP(IXSZ))) + APOSMAX = POSELT+LDAFS8*LDAFS8-1_8 + IF(INOPV .EQ. -1) THEN + APOS = POSELT + LDAFS8*int(NPIVP1-1,8) + int(NPIV,8) + POSPV1 = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF(real(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + ELSE IF (KEEP(258) .NE.0 ) THEN + CALL SMUMPS_762( A(APOS), DKEEP(6), KEEP(259) ) + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL SMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + LDAFS8*int(IPIV-1,8) + int(NPIV,8) + POSPV1 = APOS + int(IPIV - NPIVP1,8) + PIVOT = A(POSPV1) + IF (UULOC.EQ.RZERO) THEN + IF (abs(A(APOS)).EQ.RZERO) GO TO 630 + IF (A(APOS).LT.RZERO) NNEG = NNEG+1 + IF (KEEP(258) .NE. 0) THEN + CALL SMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + GO TO 420 + ENDIF + AMAX = RZERO + JMAX = 0 + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(abs(A(JJ)) .GT. AMAX) THEN + AMAX = abs(A(JJ)) + JMAX = IPIV - int(POSPV1-JJ) + ENDIF + ENDDO + J1 = POSPV1 + LDAFS8 + DO J=1, NASSW - IPIV + IF(abs(A(J1)) .GT. AMAX) THEN + AMAX = max(abs(A(J1)),AMAX) + JMAX = IPIV + J + ENDIF + J1 = J1 + LDAFS8 + ENDDO + IF (KEEP(219).NE.0) THEN + RMAX = real(A(APOSMAX+int(IPIV,8))) + ELSE + RMAX = RZERO + ENDIF + DO J=1,NASS - NASSW + RMAX = max(abs(A(J1)),RMAX) + J1 = J1 + LDAFS8 + ENDDO + IF (max(AMAX,RMAX,abs(PIVOT)).LE.PIVNUL) THEN + KEEP(109) = KEEP(109)+1 + PIVNUL_LIST(KEEP(109)) = -1 + IF (real(FIXA).GT.RZERO) THEN + IF(real(PIVOT) .GE. RZERO) THEN + A(POSPV1) = FIXA + ELSE + A(POSPV1) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + A(JJ) = ZERO + ENDDO + J1 = POSPV1 + LDAFS8 + DO J=1, NASSW - IPIV + A(J1) = ZERO + J1 = J1 + LDAFS8 + ENDDO + DO J=1,NASS - NASSW + A(J1) = ZERO + J1 = J1 + LDAFS8 + ENDDO + VALTMP = max(1.0E10*RMAX, sqrt(huge(RMAX))/1.0E8) + A(POSPV1) = VALTMP + ENDIF + PIVOT = A(POSPV1) + GO TO 415 + ENDIF + IF ((KEEP(19).EQ.0).AND.(KEEP(110).EQ.0)) THEN + IF (max(AMAX,RMAX,abs(PIVOT)).LE.TOL) THEN + IF(SEUIL .GT. epsilon(SEUIL)) THEN + IF(real(PIVOT) .GE. RZERO) THEN + A(POSPV1) = CSEUIL + ELSE + A(POSPV1) = -CSEUIL + NNEG = NNEG+1 + ENDIF + PIVOT = A(POSPV1) + WRITE(*,*) 'WARNING matrix may be singular' + KEEP(98) = KEEP(98)+1 + GO TO 415 + ENDIF + ENDIF + ENDIF + IF (max(AMAX,abs(PIVOT)) .LE. TOL) GOTO 460 + IF (abs(PIVOT).GT.max(UULOC*max(RMAX,AMAX),SEUIL)) THEN + IF (A(POSPV1).LT.RZERO) NNEG = NNEG+1 + IF (KEEP(258) .NE.0 ) THEN + CALL SMUMPS_762(PIVOT, DKEEP(6), KEEP(259)) + ENDIF + GO TO 415 + END IF + IF (AMAX.LE.TOL) GO TO 460 + IF (RMAX.LT.AMAX) THEN + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(int(POSPV1-JJ) .NE. IPIV-JMAX) THEN + RMAX = max(RMAX,abs(A(JJ))) + ENDIF + ENDDO + J1 = POSPV1 + LDAFS8 + DO J=1,NASS-IPIV + IF(IPIV+J .NE. JMAX) THEN + RMAX = max(abs(A(J1)),RMAX) + ENDIF + J1 = J1 + LDAFS8 + ENDDO + ENDIF + APOSJ = POSELT + int(JMAX-1,8)*LDAFS8 + int(NPIV,8) + POSPV2 = APOSJ + int(JMAX - NPIVP1,8) + IF (IPIV.LT.JMAX) THEN + OFFDAG = APOSJ + int(IPIV - NPIVP1,8) + ELSE + OFFDAG = APOS + int(JMAX - NPIVP1,8) + END IF + IF (KEEP(219).NE.0) THEN + TMAX = max(SEUIL/UULOC,real(A(APOSMAX+int(JMAX,8)))) + ELSE + TMAX = SEUIL/UULOC + ENDIF + IF(JMAX .LT. IPIV) THEN + JJ = POSPV2 + DO K = 1, NASS-JMAX + JJ = JJ+int(NASS,8) + IF (JMAX+K.NE.IPIV) THEN + TMAX=max(TMAX,abs(A(JJ))) + ENDIF + ENDDO + DO KK = APOSJ, POSPV2-1_8 + TMAX = max(TMAX,abs(A(KK))) + ENDDO + ELSE + JJ = POSPV2 + DO K = 1, NASS-JMAX + JJ = JJ+int(NASS,8) + TMAX=max(TMAX,abs(A(JJ))) + ENDDO + DO KK = APOSJ, POSPV2 - 1_8 + IF (KK.NE.OFFDAG) THEN + TMAX = max(TMAX,abs(A(KK))) + ENDIF + ENDDO + ENDIF + DETPIV = A(POSPV1)*A(POSPV2) - A(OFFDAG)**2 + IF (SEUIL.GT.RZERO) THEN + IF (sqrt(abs(DETPIV)) .LE. SEUIL ) GOTO 460 + ENDIF + MAXPIV = max(abs(A(POSPV1)),abs(A(POSPV2))) + IF (MAXPIV.EQ.RZERO) MAXPIV = RONE + IF (abs(DETPIV)/MAXPIV.LE.TOL) GO TO 460 + IF ((abs(A(POSPV2))*RMAX+AMAX*TMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF ((abs(A(POSPV1))*TMAX+AMAX*RMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF (KEEP(258).NE.0) THEN + CALL SMUMPS_762(DETPIV, DKEEP(6), KEEP(259)) + ENDIF + PIVSIZ = 2 + KEEP(105) = KEEP(105)+1 + IF(DETPIV .LT. RZERO) THEN + NNEG = NNEG+1 + ELSE IF(A(POSPV2) .LT. RZERO) THEN + NNEG = NNEG+2 + ENDIF + 415 CONTINUE + DO K=1,PIVSIZ + IF (PIVSIZ .EQ. 2 ) THEN + IF (K==1) THEN + LPIV = min(IPIV, JMAX) + TIPIV(ILOC) = -(LPIV - IBEGKJI + 1) + ELSE + LPIV = max(IPIV, JMAX) + TIPIV(ILOC+1) = -(LPIV - IBEGKJI + 1) + ENDIF + ELSE + LPIV = IPIV + TIPIV(ILOC) = IPIV - IBEGKJI + 1 + ENDIF + IF (LPIV.EQ.NPIVP1) THEN + GOTO 416 + ENDIF + CALL SMUMPS_319( A, LA, IW, LIW, + & IOLDPS, NPIVP1, LPIV, POSELT, NASS, + & LDAFS, NFRONT, 2, KEEP(219), KEEP(50), + & KEEP(IXSZ)) + 416 CONTINUE + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL SMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, LPIV, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + NPIVP1 = NPIVP1+1 + ENDDO + IF(PIVSIZ .EQ. 2) THEN + A(POSELT+LDAFS8*int(NPIV,8)+int(NPIV+1,8)) = DETPIV + ENDIF + GOTO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 420 + 630 CONTINUE + IFLAG = -10 + 420 CONTINUE + RETURN + END SUBROUTINE SMUMPS_223 + SUBROUTINE SMUMPS_235( + & IBEG_BLOCK, + & NASS, N, INODE, + & IW, LIW, A, LA, + & LDAFS, + & IOLDPS, POSELT, + & LKJIB_ORIG, LKJIB, LKJIT, KEEP,KEEP8 ) + IMPLICIT NONE + INTEGER NASS,N,LIW + INTEGER(8) :: LA + REAL A(LA) + INTEGER IW(LIW) + INTEGER LKJIB_ORIG, LKJIB, INODE, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER (8) :: POSELT + INTEGER (8) :: LDAFS8 + INTEGER LDAFS, IBEG_BLOCK + INTEGER IOLDPS, NPIV, JROW2, NPBEG + INTEGER NONEL, LKJIW, NEL1 + INTEGER HF + INTEGER(8) :: LPOS,UPOS,APOS + INTEGER LKJIT + INTEGER LKJIBOLD, IROW + INTEGER J, Block + INTEGER BLSIZE + REAL ONE, ALPHA + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + INCLUDE 'mumps_headers.h' + LDAFS8 = int(LDAFS,8) + LKJIBOLD = LKJIB + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + JROW2 = iabs(IW(IOLDPS+3+KEEP(IXSZ))) + NPBEG = IBEG_BLOCK + HF = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + NEL1 = NASS - JROW2 + LKJIW = NPIV - NPBEG + 1 + IF ( LKJIW .NE. LKJIB ) THEN + NONEL = JROW2 - NPIV + 1 + IF ((NASS-NPIV).GE.LKJIT) THEN + LKJIB = LKJIB_ORIG + NONEL + IW(IOLDPS+3+KEEP(IXSZ))= min0(NPIV+LKJIB,NASS) + LKJIB = min0(LKJIB, NASS - NPIV) + ELSE + LKJIB = NASS - NPIV + IW(IOLDPS+3+KEEP(IXSZ)) = NASS + ENDIF + ELSEIF (JROW2.LT.NASS) THEN + IW(IOLDPS+3+KEEP(IXSZ)) = min0(JROW2+LKJIB,NASS) + ENDIF + IBEG_BLOCK = NPIV + 1 + IF (LKJIW.EQ.0) GO TO 500 + IF (NEL1.NE.0) THEN + IF ( NASS - JROW2 > KEEP(7) ) THEN + BLSIZE = KEEP(8) + ELSE + BLSIZE = NASS - JROW2 + END IF + IF ( NASS - JROW2 .GT. 0 ) THEN + DO IROW = JROW2+1, NASS, BLSIZE + Block = min( BLSIZE, NASS - IROW + 1 ) + LPOS = POSELT + int(IROW - 1,8) * LDAFS8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG - 1,8) * LDAFS8 + int(IROW - 1,8) + APOS = POSELT + int(IROW-1,8) * LDAFS8 + int(IROW - 1,8) + DO J=1, Block + CALL sgemv( 'T', LKJIW, Block - J + 1, ALPHA, + & A( LPOS ), LDAFS, A( UPOS ), LDAFS, + & ONE, A( APOS ), LDAFS ) + LPOS = LPOS + LDAFS8 + APOS = APOS + LDAFS8 + 1_8 + UPOS = UPOS + 1_8 + END DO + LPOS = POSELT + int(IROW-1+Block,8) * LDAFS8 + & + int(NPBEG-1,8) + UPOS = POSELT + int(NPBEG-1,8) * LDAFS8 + int(IROW-1,8) + APOS = POSELT + int( IROW - 1 + Block,8 ) * LDAFS8 + & + int(IROW - 1,8) + CALL sgemm( 'N','N', Block, NASS - IROW + 1 - Block, LKJIW, + & ALPHA, A( UPOS ), LDAFS, + & A( LPOS ), LDAFS, ONE, A( APOS ), LDAFS ) + END DO + END IF + END IF + 500 CONTINUE + RETURN + END SUBROUTINE SMUMPS_235 + SUBROUTINE SMUMPS_227 + & ( IBEG_BLOCK, NASS, N, INODE, IW, LIW, + & A, LA, LDAFS, + & IOLDPS,POSELT,IFINB,LKJIB,LKJIT,PIVSIZ, + & XSIZE) + IMPLICIT NONE + INTEGER(8) :: LA, POSELT + INTEGER :: LIW + REAL A(LA) + INTEGER IW(LIW) + REAL VALPIV + INTEGER IOLDPS, NCB1 + INTEGER LKJIT, IBEG_BLOCK + INTEGER NPIV,JROW2 + INTEGER(8) :: APOS + INTEGER(8) :: LPOS, LPOS1, LPOS2, K1POS + INTEGER(8) :: JJ, K1, K2 + INTEGER(8) :: POSPV1, POSPV2, OFFDAG, OFFDAG_OLD + INTEGER(8) :: LDAFS8 + INTEGER NASS,N,INODE,IFINB,LKJIB,LDAFS, + & NPBEG + INTEGER NEL2 + INTEGER XSIZE + REAL ONE, ALPHA + REAL ZERO + INTEGER PIVSIZ,NPIV_NEW + INTEGER(8) :: IBEG, IEND, IROW + INTEGER :: J2 + REAL SWOP,DETPIV,MULT1,MULT2 + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + PARAMETER (ZERO=0.0E0) + INCLUDE 'mumps_headers.h' + LDAFS8 = int(LDAFS,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIV_NEW = NPIV + PIVSIZ + IFINB = 0 + IF (IW(IOLDPS+3+XSIZE).LE.0) THEN + IW(IOLDPS+3+XSIZE) = min0(NASS,LKJIB) + ENDIF + JROW2 = IW(IOLDPS+3+XSIZE) + NPBEG = IBEG_BLOCK + NEL2 = JROW2 - NPIV_NEW + IF (NEL2.EQ.0) THEN + IF (JROW2.EQ.NASS) THEN + IFINB = -1 + ELSE + IFINB = 1 + ENDIF + ENDIF + IF(PIVSIZ .EQ. 1) THEN + APOS = POSELT + int(NPIV,8)*(LDAFS8 + 1_8) + VALPIV = ONE/A(APOS) + A(APOS) = VALPIV + LPOS = APOS + LDAFS8 + CALL scopy(NASS-NPIV_NEW, A(LPOS), LDAFS, A(APOS+1_8), 1) + CALL SMUMPS_XSYR('U', NEL2, -VALPIV, A(LPOS), LDAFS, + & A(LPOS+1_8), LDAFS) + CALL sscal(NASS-NPIV_NEW, VALPIV, A(LPOS), LDAFS) + IF (NEL2.GT.0) THEN + K1POS = LPOS + int(NEL2,8)*LDAFS8 + NCB1 = NASS - JROW2 + CALL sger(NEL2, NCB1 , ALPHA, A(APOS+1_8), 1, + & A(K1POS), LDAFS, A(K1POS+1_8), LDAFS) + ENDIF + ELSE + POSPV1 = POSELT + int(NPIV,8)*(LDAFS8 + 1_8) + POSPV2 = POSPV1+LDAFS8+1_8 + OFFDAG_OLD = POSPV2 - 1_8 + OFFDAG = POSPV1+1_8 + SWOP = A(POSPV2) + DETPIV = A(OFFDAG) + A(POSPV2) = A(POSPV1)/DETPIV + A(POSPV1) = SWOP/DETPIV + A(OFFDAG) = -A(OFFDAG_OLD)/DETPIV + A(OFFDAG_OLD) = ZERO + LPOS1 = POSPV2 + LDAFS8 - 1_8 + LPOS2 = LPOS1 + 1_8 + CALL scopy(NASS-NPIV_NEW, A(LPOS1), LDAFS, A(POSPV1+2_8), 1) + CALL scopy(NASS-NPIV_NEW, A(LPOS2), LDAFS, A(POSPV2+1_8), 1) + JJ = POSPV2 + int(NASS-1,8) + IBEG = JJ + 2_8 + IEND = IBEG + DO J2 = 1,NEL2 + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(OFFDAG)*A(K2)) + MULT2 = - (A(OFFDAG)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1+2_8 + K2 = POSPV2+1_8 + DO IROW = IBEG,IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A(JJ) = -MULT1 + A(JJ+1_8) = -MULT2 + IBEG = IBEG + int(NASS,8) + IEND = IEND + int(NASS + 1,8) + JJ = JJ+int(NASS,8) + ENDDO + IEND = IEND-1_8 + DO J2 = JROW2+1,NASS + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(POSPV1+1_8)*A(K2)) + MULT2 = - (A(POSPV1+1_8)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1+2_8 + K2 = POSPV2+1_8 + DO IROW = IBEG,IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A(JJ) = -MULT1 + A(JJ+1_8) = -MULT2 + IBEG = IBEG + int(NASS,8) + IEND = IEND + int(NASS,8) + JJ = JJ+int(NASS,8) + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_227 + RECURSIVE SUBROUTINE SMUMPS_263( + & COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE SMUMPS_COMM_BUFFER + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER COMP + INTEGER IFLAG, IERROR, NBFIN, MSGSOU + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)) + INTEGER NBPROCFILS(KEEP(28)), STEP(N), PIMASTER(KEEP(28)) + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N + 1 ), FRTELT( NELT ) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER COMM, MYID + INTEGER PTLUST_S(KEEP(28)) + INTEGER ITLOC( N + KEEP(253)), FILS( N ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER ND( KEEP(28) ), FRERE_STEPS( KEEP(28) ) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION FLOP1 + REAL DBLARR( max(1,KEEP(13)) ) + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INCLUDE 'mumps_headers.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER INODE, IPOSK, JPOSK, NCOLU, NPIV, POSITION, IERR + INTEGER(8) POSELT, POSBLOCFACTO + INTEGER(8) LAELL + INTEGER IOLDPS, LCONT1, NROW1, NCOL1, NPIV1 + INTEGER NSLAVES_TOT, HS, DEST, NSLAVES_FOLLOW + INTEGER FPERE + INTEGER(8) CPOS, LPOS + LOGICAL DYNAMIC + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER allocok + REAL, ALLOCATABLE, DIMENSION(:) :: UDYNAMIC + REAL ONE,ALPHA + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + DYNAMIC = .FALSE. + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, IPOSK, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, JPOSK, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, + & MPI_INTEGER, COMM, IERR ) + IF ( NPIV .LE. 0 ) THEN + NPIV = - NPIV + WRITE(*,*) MYID,':error, received negative NPIV in BLFAC' + CALL MUMPS_ABORT() + END IF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOLU, 1, + & MPI_INTEGER, COMM, IERR ) + LAELL = int(NPIV,8) * int(NCOLU,8) + IF ( LRLU .LT. LAELL ) THEN + IF ( LRLUS .LT. LAELL ) THEN + IFLAG = -9 + CALL MUMPS_731(LAELL - LRLUS, IERROR) + GOTO 700 + END IF + CALL SMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS=' + & ,LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731(LAELL - LRLU, IERROR) + GOTO 700 + END IF + END IF + LRLU = LRLU - LAELL + LRLUS = LRLUS - LAELL + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSBLOCFACTO = POSFAC + POSFAC = POSFAC + LAELL + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8, LAELL,KEEP,KEEP8,LRLU) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSBLOCFACTO), NPIV*NCOLU, + & MPI_REAL, + & COMM, IERR ) + IF (PTRIST(STEP( INODE )) .EQ. 0) DYNAMIC = .TRUE. + IF ( (PTRIST(STEP( INODE )).NE.0) .AND. + & (IPOSK + NPIV -1 .GT. + & IW(PTRIST(STEP(INODE))+3+KEEP(IXSZ))) )THEN + DYNAMIC = .TRUE. + ENDIF + IF (DYNAMIC) THEN + ALLOCATE(UDYNAMIC(LAELL), stat=allocok) + if (allocok .GT. 0) THEN + write(*,*) MYID, ' : PB allocation U in blfac_slave ' + & , LAELL + IFLAG = -13 + CALL MUMPS_731(LAELL,IERROR) + GOTO 700 + endif + UDYNAMIC(1_8:LAELL) = A(POSBLOCFACTO:POSBLOCFACTO+LAELL-1_8) + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + ENDIF + DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 ) + MSGSOU = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), + & SLAVEF ) + SET_IRECV = .FALSE. + BLOCKING = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + ENDDO + DO WHILE ( IPOSK + NPIV -1 .GT. + & IW( PTRIST(STEP( INODE )) + 3 +KEEP(IXSZ)) ) + MSGSOU = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + SET_IRECV = .FALSE. + BLOCKING = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, BLOC_FACTO_SYM, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .TRUE. + CALL SMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IOLDPS = PTRIST(STEP( INODE )) + POSELT = PTRAST(STEP( INODE )) + LCONT1 = IW( IOLDPS + KEEP(IXSZ) ) + NROW1 = IW( IOLDPS + 2 + KEEP(IXSZ)) + NPIV1 = IW( IOLDPS + 3 + KEEP(IXSZ)) + NSLAVES_TOT = IW( IOLDPS + 5 + KEEP(IXSZ)) + HS = 6 + NSLAVES_TOT + KEEP(IXSZ) + NCOL1 = LCONT1 + NPIV1 + CPOS = POSELT + int(JPOSK - 1,8) + LPOS = POSELT + int(IPOSK - 1,8) + IF ( NPIV .GT. 0 ) THEN + IF (DYNAMIC) THEN + CALL sgemm( 'T', 'N', NCOLU, NROW1, NPIV, ALPHA, + & UDYNAMIC(1), NPIV, + & A( LPOS ), NCOL1, ONE, + & A( CPOS ), NCOL1 ) + ELSE + CALL sgemm( 'T', 'N', NCOLU, NROW1, NPIV, ALPHA, + & A( POSBLOCFACTO ), NPIV, + & A( LPOS ), NCOL1, ONE, + & A( CPOS ), NCOL1 ) + ENDIF + FLOP1 = dble(NCOLU*NPIV)*dble(2*NROW1) + FLOP1 = -FLOP1 + CALL SMUMPS_190(1, .FALSE., FLOP1, KEEP,KEEP8 ) + ENDIF + IW( IOLDPS + 6 + KEEP(IXSZ) ) = IW( IOLDPS + 6+ KEEP(IXSZ) ) + 1 + IF (DYNAMIC) THEN + DEALLOCATE(UDYNAMIC) + ELSE + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + CALL SMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + ENDIF + NSLAVES_FOLLOW = IW( IOLDPS + 5 +KEEP(IXSZ) ) - XTRA_SLAVES_SYM + IF ( IW( IOLDPS + 6 +KEEP(IXSZ)) .eq. 0 .and. + & KEEP(50) .ne. 0 .and. NSLAVES_FOLLOW .eq. 0 ) + & THEN + DEST = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + CALL SMUMPS_62( INODE, DEST, END_NIV2_LDLT, + & COMM, IERR ) + IF ( IERR .LT. 0 ) THEN + write(*,*) ' Internal error in PROCESS_BLFAC_SLAVE.' + IFLAG = -99 + GOTO 700 + END IF + END IF + IF (IW(PTRIST(STEP(INODE)) + 6+KEEP(IXSZ) ) .eq. 0) THEN + CALL SMUMPS_759( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ENDIF + 600 CONTINUE + RETURN + 700 CONTINUE + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE SMUMPS_263 + SUBROUTINE SMUMPS_38( NROW_SON, NCOL_SON, INDROW_SON, + & INDCOL_SON, NSUPCOL, VAL_SON, VAL_ROOT, + & LOCAL_M, LOCAL_N, + & RHS_ROOT, NLOC_ROOT, CBP ) + IMPLICIT NONE + INTEGER NCOL_SON, NROW_SON, NSUPCOL + INTEGER, intent(in) :: CBP + INTEGER INDROW_SON( NROW_SON ), INDCOL_SON( NCOL_SON ) + INTEGER LOCAL_M, LOCAL_N + REAL VAL_SON( NCOL_SON, NROW_SON ) + REAL VAL_ROOT( LOCAL_M, LOCAL_N ) + INTEGER NLOC_ROOT + REAL RHS_ROOT( LOCAL_M, NLOC_ROOT ) + INTEGER I, J + IF (CBP .EQ. 0) THEN + DO I = 1, NROW_SON + DO J = 1, NCOL_SON-NSUPCOL + VAL_ROOT( INDROW_SON( I ), INDCOL_SON( J ) ) = + & VAL_ROOT( INDROW_SON( I ), INDCOL_SON( J ) ) + VAL_SON(J,I) + END DO + DO J = NCOL_SON-NSUPCOL+1, NCOL_SON + RHS_ROOT( INDROW_SON( I ), INDCOL_SON(J)) = + & RHS_ROOT(INDROW_SON(I),INDCOL_SON(J)) + VAL_SON(J,I) + ENDDO + END DO + ELSE + DO I=1, NROW_SON + DO J = 1, NCOL_SON + RHS_ROOT( INDROW_SON( I ), INDCOL_SON(J)) = + & RHS_ROOT(INDROW_SON(I),INDCOL_SON(J)) + VAL_SON(J,I) + ENDDO + ENDDO + ENDIF + RETURN + END SUBROUTINE SMUMPS_38 + RECURSIVE SUBROUTINE SMUMPS_80 + & ( COMM_LOAD, ASS_IRECV, N, ISON, IROOT, + & PTRI, PTRR, + & root, + & NBROW, NBCOL, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON, + & SHIFT_VAL_SON, LDA, TAG, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE SMUMPS_OOC + USE SMUMPS_COMM_BUFFER + USE SMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + TYPE (SMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, ISON, IROOT, TAG + INTEGER PTRI( KEEP(28) ) + INTEGER(8) :: PTRR( KEEP(28) ) + INTEGER NBROW, NBCOL, LDA + INTEGER(8) :: SHIFT_VAL_SON + INTEGER SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON + INTEGER MYID, COMM + LOGICAL INVERT + INCLUDE 'mpif.h' + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER LIW + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)), NSTK( N ) + INTEGER COMP, IFLAG, IERROR + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER NBFIN, SLAVEF + DOUBLE PRECISION OPASSW, OPELIW + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER INTARR( max(1,KEEP(14)) ) + REAL DBLARR( max(1,KEEP(13)) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: PTRROW, PTRCOL + INTEGER, ALLOCATABLE, DIMENSION(:) :: NSUPROW, NSUPCOL + INTEGER, ALLOCATABLE, DIMENSION(:) :: ROW_INDEX_LIST + INTEGER, ALLOCATABLE, DIMENSION(:) :: COL_INDEX_LIST + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER I, POS_IN_ROOT, IROW, JCOL, IGLOB, JGLOB + INTEGER PDEST, IERR + INTEGER LOCAL_M, LOCAL_N + INTEGER(8) :: POSROOT + INTEGER NSUBSET_ROW, NSUBSET_COL + INTEGER NRLOCAL, NCLOCAL + LOGICAL SET_IRECV, BLOCKING, MESSAGE_RECEIVED + INTEGER NBROWS_ALREADY_SENT + INTEGER SIZE_MSG + INTEGER LP + INCLUDE 'mumps_headers.h' + LOGICAL SKIPLAST_RHS_ROWS, BCP_SYM_NONEMPTY + INTEGER BBPCBP + BBPCBP = 0 + LP = ICNTL(1) + IF ( ICNTL(4) .LE. 0 ) LP = -1 + ALLOCATE(PTRROW(root%NPROW + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPROW + 1 + endif + ALLOCATE(PTRCOL(root%NPCOL + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPCOL + 1 + endif + ALLOCATE(NSUPROW(root%NPROW + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPROW + 1 + endif + ALLOCATE(NSUPCOL(root%NPCOL + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPCOL + 1 + endif + IF (IFLAG.LT.0) THEN + IF (LP > 0) write(6,*) MYID, ' : MEMORY ALLOCATION ', + & 'FAILURE in SMUMPS_80' + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + SKIPLAST_RHS_ROWS = ((KEEP(253).GT.0).AND.(KEEP(50).EQ.0)) + BCP_SYM_NONEMPTY = .FALSE. + PTRROW = 0 + PTRCOL = 0 + NSUPROW = 0 + NSUPCOL = 0 + DO I = 1, NBROW + IGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_ROW_SON + I - 1 ) + IF (SKIPLAST_RHS_ROWS.AND.(IGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF (IGLOB.GT.N) THEN + BCP_SYM_NONEMPTY = .TRUE. + POS_IN_ROOT = IGLOB - N + JCOL = mod((POS_IN_ROOT-1)/root%NBLOCK,root%NPCOL) + NSUPCOL(JCOL+1) = NSUPCOL(JCOL+1) + 1 + PTRCOL( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + ELSE + POS_IN_ROOT = root%RG2L_ROW( IGLOB ) + IROW = mod((POS_IN_ROOT-1)/root%MBLOCK,root%NPROW) + PTRROW ( IROW + 2 ) = PTRROW( IROW + 2 ) + 1 + ENDIF + ELSE + IF (IGLOB .GT. N) THEN + POS_IN_ROOT = IGLOB - N + ELSE + POS_IN_ROOT = root%RG2L_COL( IGLOB ) + ENDIF + JCOL = mod( ( POS_IN_ROOT - 1 ) / root%NBLOCK, root%NPCOL ) + IF (IGLOB.GT.N) + & NSUPCOL(JCOL+1) = NSUPCOL(JCOL+1) + 1 + PTRCOL( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + END IF + END DO + IF ((KEEP(50).NE.0).AND.(.NOT.INVERT).AND.BCP_SYM_NONEMPTY) + & BBPCBP = 1 + DO I = 1, NBCOL + JGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_COL_SON + I - 1 ) + IF ((KEEP(50).GT.0) .AND. (JGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF (KEEP(50).EQ.0) THEN + IF (JGLOB.LE.N) THEN + POS_IN_ROOT = root%RG2L_COL(JGLOB) + ELSE + POS_IN_ROOT = JGLOB-N + ENDIF + JCOL = mod((POS_IN_ROOT-1) / root%NBLOCK, root%NPCOL ) + IF (JGLOB.GT.N) THEN + NSUPCOL(JCOL+1) = NSUPCOL(JCOL+1) + 1 + ENDIF + PTRCOL ( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + ELSE + POS_IN_ROOT = root%RG2L_COL(JGLOB) + JCOL = mod((POS_IN_ROOT-1) / root%NBLOCK, root%NPCOL ) + PTRCOL ( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + IF (BCP_SYM_NONEMPTY) THEN + POS_IN_ROOT = root%RG2L_ROW(JGLOB) + IROW = mod((POS_IN_ROOT-1)/root%MBLOCK,root%NPROW) + NSUPROW(IROW+1) = NSUPROW(IROW+1)+1 + PTRROW( IROW + 2 ) = PTRROW( IROW + 2 ) + 1 + ENDIF + ENDIF + ELSE + IF (JGLOB.LE.N) THEN + POS_IN_ROOT = root%RG2L_ROW( JGLOB ) + ELSE + POS_IN_ROOT = JGLOB-N + ENDIF + IROW = mod( ( POS_IN_ROOT - 1 ) / + & root%MBLOCK, root%NPROW ) + PTRROW ( IROW + 2 ) = PTRROW( IROW + 2 ) + 1 + END IF + END DO + PTRROW( 1 ) = 1 + DO IROW = 2, root%NPROW + 1 + PTRROW( IROW ) = PTRROW( IROW ) + PTRROW( IROW - 1 ) + END DO + PTRCOL( 1 ) = 1 + DO JCOL = 2, root%NPCOL + 1 + PTRCOL( JCOL ) = PTRCOL( JCOL ) + PTRCOL( JCOL - 1 ) + END DO + ALLOCATE(ROW_INDEX_LIST(PTRROW(root%NPROW+1)-1+1), + & stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = PTRROW(root%NPROW+1)-1+1 + endif + ALLOCATE(COL_INDEX_LIST(PTRCOL(root%NPCOL+1)-1+1), + & stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = PTRCOL(root%NPCOL+1)-1+1 + endif + DO I = 1, NBROW + IGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_ROW_SON + I - 1 ) + IF (SKIPLAST_RHS_ROWS.AND.(IGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF (IGLOB.GT.N) CYCLE + POS_IN_ROOT = root%RG2L_ROW( IGLOB ) + IROW = mod( ( POS_IN_ROOT - 1 ) / root%MBLOCK, + & root%NPROW ) + ROW_INDEX_LIST( PTRROW( IROW + 1 ) ) = I + PTRROW ( IROW + 1 ) = PTRROW( IROW + 1 ) + 1 + ELSE + IF (IGLOB.LE.N) THEN + POS_IN_ROOT = root%RG2L_COL( IGLOB ) + ELSE + POS_IN_ROOT = IGLOB - N + ENDIF + JCOL = mod( ( POS_IN_ROOT - 1 ) / root%NBLOCK, + & root%NPCOL ) + COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ) = I + PTRCOL ( JCOL + 1 ) = PTRCOL( JCOL + 1 ) + 1 + END IF + END DO + DO I = 1, NBCOL + JGLOB = IW( PTRI(STEP(ISON))+SHIFT_LIST_COL_SON+I - 1 ) + IF ((KEEP(50).GT.0) .AND. (JGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF ( JGLOB.LE.N ) THEN + POS_IN_ROOT = root%RG2L_COL( JGLOB ) + ELSE + POS_IN_ROOT = JGLOB - N + ENDIF + JCOL = mod( ( POS_IN_ROOT - 1 ) / + & root%NBLOCK, root%NPCOL ) + COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ) = I + PTRCOL ( JCOL + 1 ) = PTRCOL( JCOL + 1 ) + 1 + ELSE + IF ( JGLOB.LE.N ) THEN + POS_IN_ROOT = root%RG2L_ROW( JGLOB ) + ELSE + POS_IN_ROOT = JGLOB - N + ENDIF + IROW = mod( ( POS_IN_ROOT - 1 ) / + & root%MBLOCK, root%NPROW ) + ROW_INDEX_LIST( PTRROW( IROW + 1 ) ) = I + PTRROW( IROW + 1 ) = PTRROW( IROW + 1 ) + 1 + END IF + END DO + IF (BCP_SYM_NONEMPTY) THEN + DO I = 1, NBROW + IGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_ROW_SON + I - 1 ) + IF (IGLOB.LE.N) CYCLE + POS_IN_ROOT = IGLOB - N + JCOL = mod((POS_IN_ROOT-1)/root%NBLOCK,root%NPCOL) + COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ) = I + PTRCOL ( JCOL + 1 ) = PTRCOL( JCOL + 1 ) + 1 + ENDDO + DO I=1, NBCOL + JGLOB = IW( PTRI(STEP(ISON))+SHIFT_LIST_COL_SON+I - 1 ) + IF (JGLOB.GT.N) THEN + EXIT + ELSE + POS_IN_ROOT = root%RG2L_ROW(JGLOB) + ENDIF + IROW = mod((POS_IN_ROOT-1)/root%MBLOCK,root%NPROW) + ROW_INDEX_LIST( PTRROW( IROW + 1 ) ) = I + PTRROW( IROW + 1 ) = PTRROW( IROW + 1 ) + 1 + ENDDO + ENDIF + DO IROW = root%NPROW, 2, -1 + PTRROW( IROW ) = PTRROW( IROW - 1 ) + END DO + PTRROW( 1 ) = 1 + DO JCOL = root%NPCOL, 2, -1 + PTRCOL( JCOL ) = PTRCOL( JCOL - 1 ) + END DO + PTRCOL( 1 ) = 1 + JCOL = root%MYCOL + IROW = root%MYROW + IF ( root%yes ) THEN + if (IROW .ne. root%MYROW .or. JCOL.ne.root%MYCOL) then + write(*,*) ' error in grid position buildandsendcbroot' + CALL MUMPS_ABORT() + end if + IF ( PTRIST(STEP(IROOT)).EQ.0.AND. + & PTLUST_S(STEP(IROOT)).EQ.0) THEN + NBPROCFILS( STEP(IROOT) ) = -1 + CALL SMUMPS_284(root, IROOT, N, IW, LIW, + & A, LA, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + IF (IFLAG.LT.0) THEN + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + ELSE + NBPROCFILS(STEP(IROOT)) = NBPROCFILS(STEP(IROOT)) - 1 + IF ( NBPROCFILS( STEP(IROOT) ) .eq. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + CALL SMUMPS_681(IERR) + ELSE IF (KEEP(201).EQ.2) THEN + CALL SMUMPS_580(IERR) + ENDIF + CALL SMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IROOT+N ) + IF (KEEP(47) .GE. 3) THEN + CALL SMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + END IF + IF (KEEP(60) .NE. 0 ) THEN + LOCAL_M = root%SCHUR_LLD + LOCAL_N = root%SCHUR_NLOC + NRLOCAL = PTRROW( IROW + 2 ) - PTRROW( IROW + 1 ) + NCLOCAL = PTRCOL( JCOL + 2 ) - PTRCOL( JCOL + 1 ) + CALL SMUMPS_285( N, + & root%SCHUR_POINTER(1), + & LOCAL_M, LOCAL_N, + & root%NPCOL, root%NPROW, root%MBLOCK, root%NBLOCK, + & NBCOL, NBROW, + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_COL_SON ), + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_ROW_SON ), + & LDA, A( PTRR( STEP(ISON)) + SHIFT_VAL_SON ), + & ROW_INDEX_LIST( PTRROW( IROW + 1 ) ), + & COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ), + & NRLOCAL, + & NCLOCAL, + & NSUPROW(IROW+1), NSUPCOL(JCOL+1), + & root%RG2L_ROW(1), root%RG2L_COL(1), INVERT, + & KEEP, + & root%RHS_ROOT(1,1), root%RHS_NLOC ) + ELSE + IF ( PTRIST(STEP( IROOT )) .GE. 0 ) THEN + IF ( PTRIST(STEP( IROOT )) .EQ. 0 ) THEN + LOCAL_N = IW( PTLUST_S(STEP(IROOT)) + 1 + KEEP(IXSZ)) + LOCAL_M = IW( PTLUST_S(STEP(IROOT)) + 2 + KEEP(IXSZ)) + POSROOT = PTRFAC(IW( PTLUST_S(STEP(IROOT)) +4+KEEP(IXSZ) )) + ELSE + LOCAL_N = - IW( PTRIST(STEP(IROOT)) +KEEP(IXSZ)) + LOCAL_M = IW( PTRIST(STEP(IROOT)) + 1 +KEEP(IXSZ)) + POSROOT = PAMASTER(STEP( IROOT )) + ENDIF + NCLOCAL = PTRCOL( JCOL + 2 ) - PTRCOL( JCOL + 1 ) + NRLOCAL = PTRROW( IROW + 2 ) - PTRROW( IROW + 1 ) + CALL SMUMPS_285( N, A( POSROOT ), + & LOCAL_M, LOCAL_N, + & root%NPCOL, root%NPROW, root%MBLOCK, root%NBLOCK, + & NBCOL, NBROW, + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_COL_SON ), + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_ROW_SON ), + & LDA, A( PTRR( STEP(ISON)) + SHIFT_VAL_SON ), + & ROW_INDEX_LIST( PTRROW( IROW + 1 ) ), + & COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ), + & NRLOCAL, + & NCLOCAL, + & NSUPROW(IROW+1), NSUPCOL(JCOL+1), + & root%RG2L_ROW(1), root%RG2L_COL(1), INVERT, + & KEEP, + & root%RHS_ROOT(1,1), root%RHS_NLOC ) + END IF + ENDIF + END IF + DO IROW = 0, root%NPROW - 1 + DO JCOL = 0, root%NPCOL - 1 + PDEST = IROW * root%NPCOL + JCOL + IF ( (root%MYROW.eq.IROW.and.root%MYCOL.eq.JCOL) .and. + & MYID.ne.PDEST) THEN + write(*,*) 'error: myrow,mycol=',root%MYROW,root%MYCOL + write(*,*) ' MYID,PDEST=',MYID,PDEST + CALL MUMPS_ABORT() + END IF + IF ( root%MYROW .NE. IROW .OR. root%MYCOL .NE. JCOL) THEN + NBROWS_ALREADY_SENT = 0 + IERR = -1 + DO WHILE ( IERR .EQ. -1 ) + NSUBSET_ROW = PTRROW( IROW + 2 ) - PTRROW( IROW + 1 ) + NSUBSET_COL = PTRCOL( JCOL + 2 ) - PTRCOL( JCOL + 1 ) + IF ( LRLU .LT. int(NSUBSET_ROW,8) * int(NSUBSET_COL,8) + & .AND. LRLUS .GT. int(NSUBSET_ROW,8) * int(NSUBSET_COL,8) ) + & THEN + CALL SMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) MYID,': Error in b&scbroot: pb compress' + WRITE(*,*) MYID,': LRLU, LRLUS=',LRLU,LRLUS + CALL MUMPS_ABORT() + END IF + END IF + CALL SMUMPS_648( N, ISON, + & NBCOL, NBROW, + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_COL_SON ), + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_ROW_SON ), + & LDA, A( PTRR(STEP(ISON)) + SHIFT_VAL_SON ), + & TAG, + & ROW_INDEX_LIST( PTRROW( IROW + 1 ) ), + & COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ), + & NSUBSET_ROW, NSUBSET_COL, + & NSUPROW(IROW+1), NSUPCOL(JCOL+1), + & root%NPROW, root%NPCOL, root%MBLOCK, + & root%RG2L_ROW, root%RG2L_COL, + & root%NBLOCK, PDEST, + & COMM, IERR, A( POSFAC ), LRLU, INVERT, + & SIZE_MSG, NBROWS_ALREADY_SENT, KEEP, BBPCBP ) + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL SMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK, + & COMP, IFLAG, IERROR, COMM, NBPROCFILS, IPOOL, LPOOL, + & LEAF, NBFIN, MYID, SLAVEF, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, KEEP,KEEP8, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + END IF + END DO + IF ( IERR == -2 ) THEN + IFLAG = -17 + IERROR = SIZE_MSG + IF (LP > 0) WRITE(LP, *) "FAILURE, SEND BUFFER TOO + & SMALL DURING SMUMPS_80" + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + GOTO 500 + ENDIF + IF ( IERR == -3 ) THEN + IF (LP > 0) WRITE(LP, *) "FAILURE, RECV BUFFER TOO + & SMALL DURING SMUMPS_80" + IFLAG = -20 + IERROR = SIZE_MSG + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + GOTO 500 + ENDIF + END IF + END DO + END DO + 500 CONTINUE + DEALLOCATE(PTRROW) + DEALLOCATE(PTRCOL) + DEALLOCATE(ROW_INDEX_LIST) + DEALLOCATE(COL_INDEX_LIST) + RETURN + END SUBROUTINE SMUMPS_80 + SUBROUTINE SMUMPS_285( N, VAL_ROOT, + & LOCAL_M, LOCAL_N, + & NPCOL, NPROW, MBLOCK, NBLOCK, NBCOL_SON, NBROW_SON, INDCOL_SON, + & INDROW_SON, LD_SON, VAL_SON, SUBSET_ROW, SUBSET_COL, + & NSUBSET_ROW, NSUBSET_COL, NSUPROW, NSUPCOL, + & RG2L_ROW, RG2L_COL, INVERT, + & KEEP, RHS_ROOT, NLOC ) + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INTEGER N, LOCAL_M, LOCAL_N + REAL VAL_ROOT( LOCAL_M, LOCAL_N ) + INTEGER NPCOL, NPROW, MBLOCK, NBLOCK + INTEGER NBCOL_SON, NBROW_SON + INTEGER INDCOL_SON( NBCOL_SON ), INDROW_SON( NBROW_SON ) + INTEGER LD_SON + INTEGER NSUPROW, NSUPCOL + REAL VAL_SON( LD_SON, NBROW_SON ) + INTEGER KEEP(500) + INTEGER NSUBSET_ROW, NSUBSET_COL + INTEGER SUBSET_ROW( NSUBSET_ROW ), SUBSET_COL( NSUBSET_COL ) + INTEGER RG2L_ROW( N ), RG2L_COL( N ) + LOGICAL INVERT + INTEGER NLOC + REAL RHS_ROOT( LOCAL_M, NLOC) + INTEGER ISUB, JSUB, I, J, IPOS_ROOT, JPOS_ROOT + INTEGER ILOC_ROOT, JLOC_ROOT, IGLOB, JGLOB + IF (KEEP(50).EQ.0) THEN + DO ISUB = 1, NSUBSET_ROW + I = SUBSET_ROW( ISUB ) + IGLOB = INDROW_SON( I ) + IPOS_ROOT = RG2L_ROW( IGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + DO JSUB = 1, NSUBSET_COL-NSUPCOL + J = SUBSET_COL( JSUB ) + JGLOB = INDCOL_SON( J ) + JPOS_ROOT = RG2L_COL( JGLOB ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + DO JSUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL + J = SUBSET_COL( JSUB ) + JGLOB = INDCOL_SON( J ) + JPOS_ROOT = JGLOB - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + RHS_ROOT(ILOC_ROOT, JLOC_ROOT) = + & RHS_ROOT(ILOC_ROOT, JLOC_ROOT) + VAL_SON( J, I ) + ENDDO + END DO + ELSE + IF ( .NOT. INVERT ) THEN + DO ISUB = 1, NSUBSET_ROW - NSUPROW + I = SUBSET_ROW( ISUB ) + IGLOB = INDROW_SON( I ) + IPOS_ROOT = RG2L_ROW( IGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + DO JSUB = 1, NSUBSET_COL -NSUPCOL + J = SUBSET_COL( JSUB ) + JGLOB = INDCOL_SON( J ) + JPOS_ROOT = RG2L_COL( JGLOB ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + END DO + DO JSUB = NSUBSET_COL -NSUPCOL+1, NSUBSET_COL + J = SUBSET_COL( JSUB ) + JGLOB = INDROW_SON( J ) + JPOS_ROOT = JGLOB - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + DO ISUB = NSUBSET_ROW - NSUPROW +1, NSUBSET_ROW + I = SUBSET_ROW( ISUB ) + IGLOB = INDCOL_SON( I ) + IPOS_ROOT = RG2L_ROW(IGLOB) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + RHS_ROOT(ILOC_ROOT, JLOC_ROOT) = + & RHS_ROOT(ILOC_ROOT, JLOC_ROOT) + VAL_SON( I, J ) + END DO + END DO + ELSE + DO ISUB = 1, NSUBSET_COL-NSUPCOL + I = SUBSET_COL( ISUB ) + IGLOB = INDROW_SON( I ) + JPOS_ROOT = RG2L_COL( IGLOB ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + DO JSUB = 1, NSUBSET_ROW + J = SUBSET_ROW( JSUB ) + JGLOB = INDCOL_SON( J ) + IPOS_ROOT = RG2L_ROW( JGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + ENDDO + DO ISUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL + I = SUBSET_COL( ISUB ) + IGLOB = INDROW_SON( I ) + JPOS_ROOT = IGLOB - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + DO JSUB = 1, NSUBSET_ROW + J = SUBSET_ROW( JSUB ) + JGLOB = INDCOL_SON( J ) + IPOS_ROOT = RG2L_ROW( JGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + RHS_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & RHS_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + ENDDO + END IF + END IF + RETURN + END SUBROUTINE SMUMPS_285 + SUBROUTINE SMUMPS_164 + &( MYID, NPROCS, N, root, COMM_ROOT, IROOT, FILS, + & K50, K46, K51 + & , K60, IDNPROW, IDNPCOL, IDMBLOCK, IDNBLOCK + & ) + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INTEGER MYID, MYID_ROOT + TYPE (SMUMPS_ROOT_STRUC)::root + INTEGER COMM_ROOT + INTEGER N, IROOT, NPROCS, K50, K46, K51 + INTEGER FILS( N ) + INTEGER K60, IDNPROW, IDNPCOL, IDMBLOCK, IDNBLOCK + INTEGER INODE, NPROWtemp, NPCOLtemp + LOGICAL SLAVE + root%ROOT_SIZE = 0 + root%TOT_ROOT_SIZE = 0 + SLAVE = ( MYID .ne. 0 .or. + & ( MYID .eq. 0 .and. K46 .eq. 1 ) ) + INODE = IROOT + DO WHILE ( INODE .GT. 0 ) + INODE = FILS( INODE ) + root%ROOT_SIZE = root%ROOT_SIZE + 1 + END DO + IF ( ( K60 .NE. 2 .AND. K60 .NE. 3 ) .OR. + & IDNPROW .LE. 0 .OR. IDNPCOL .LE. 0 + & .OR. IDMBLOCK .LE.0 .OR. IDNBLOCK.LE.0 + & .OR. IDNPROW * IDNPCOL .GT. NPROCS ) THEN + root%MBLOCK = K51 + root%NBLOCK = K51 + CALL SMUMPS_99( NPROCS, root%NPROW, root%NPCOL, + & root%ROOT_SIZE, K50 ) + IF ( K60 .EQ. 2 .OR. K60 .EQ. 3 ) THEN + IDNPROW = root%NPROW + IDNPCOL = root%NPCOL + IDMBLOCK = root%MBLOCK + IDNBLOCK = root%NBLOCK + ENDIF + ELSE IF ( K60 .EQ. 2 .OR. K60 .EQ. 3 ) THEN + root%NPROW = IDNPROW + root%NPCOL = IDNPCOL + root%MBLOCK = IDMBLOCK + root%NBLOCK = IDNBLOCK + ENDIF + IF ( K60 .EQ. 2 .OR. K60 .EQ. 3 ) THEN + IF (SLAVE) THEN + root%LPIV = 0 + IF (K46.EQ.0) THEN + MYID_ROOT=MYID-1 + ELSE + MYID_ROOT=MYID + ENDIF + IF (MYID_ROOT < root%NPROW*root%NPCOL) THEN + root%MYROW = MYID_ROOT / root%NPCOL + root%MYCOL = mod(MYID_ROOT, root%NPCOL) + root%yes = .true. + ELSE + root%MYROW = -1 + root%MYCOL = -1 + root%yes = .FALSE. + ENDIF + ELSE + root%yes = .FALSE. + ENDIF + ELSE IF ( SLAVE ) THEN + IF ( root%gridinit_done) THEN + CALL blacs_gridexit( root%CNTXT_BLACS ) + root%gridinit_done = .FALSE. + END IF + root%CNTXT_BLACS = COMM_ROOT + CALL blacs_gridinit( root%CNTXT_BLACS, 'R', + & root%NPROW, root%NPCOL ) + root%gridinit_done = .TRUE. + CALL blacs_gridinfo( root%CNTXT_BLACS, + & NPROWtemp, NPCOLtemp, + & root%MYROW, root%MYCOL ) + IF ( root%MYROW .NE. -1 ) THEN + root%yes = .true. + ELSE + root%yes = .false. + END IF + root%LPIV = 0 + ELSE + root%yes = .FALSE. + ENDIF + RETURN + END SUBROUTINE SMUMPS_164 + SUBROUTINE SMUMPS_165( N, root, FILS, IROOT, + & KEEP, INFO ) + IMPLICIT NONE + INCLUDE 'smumps_root.h' + TYPE ( SMUMPS_ROOT_STRUC ):: root + INTEGER N, IROOT, INFO(40), KEEP(500) + INTEGER FILS( N ) + INTEGER INODE, I, allocok + IF ( associated( root%RG2L_ROW ) ) DEALLOCATE( root%RG2L_ROW ) + IF ( associated( root%RG2L_COL ) ) DEALLOCATE( root%RG2L_COL ) + ALLOCATE( root%RG2L_ROW( N ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=N + RETURN + ENDIF + ALLOCATE( root%RG2L_COL( N ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=N + RETURN + ENDIF + INODE = IROOT + I = 1 + DO WHILE ( INODE .GT. 0 ) + root%RG2L_ROW( INODE ) = I + root%RG2L_COL( INODE ) = I + I = I + 1 + INODE = FILS( INODE ) + END DO + RETURN + END SUBROUTINE SMUMPS_165 + SUBROUTINE SMUMPS_99( NPROCS, NPROW, NPCOL, SIZE, K50 ) + IMPLICIT NONE + INTEGER NPROCS, NPROW, NPCOL, SIZE, K50 + INTEGER NPROWtemp, NPCOLtemp, NPROCSused, FLATNESS + LOGICAL KEEPIT + IF ( K50 .EQ. 1 ) THEN + FLATNESS = 2 + ELSE + FLATNESS = 3 + ENDIF + NPROW = int(sqrt(real(NPROCS))) + NPROWtemp = NPROW + NPCOL = int(NPROCS / NPROW) + NPCOLtemp = NPCOL + NPROCSused = NPROWtemp * NPCOLtemp + 10 CONTINUE + IF ( NPROWtemp >= NPCOLtemp/FLATNESS .AND. NPROWtemp > 1) THEN + NPROWtemp = NPROWtemp - 1 + NPCOLtemp = int(NPROCS / NPROWtemp) + KEEPIT=.FALSE. + IF ( NPROWtemp * NPCOLtemp .GE. NPROCSused ) THEN + IF ( ( K50 .NE. 1 .AND. NPROWtemp >= NPCOLtemp/FLATNESS) + & .OR. NPROWtemp * NPCOLtemp .GT. NPROCSused ) + & KEEPIT=.TRUE. + END IF + IF ( KEEPIT ) THEN + NPROW = NPROWtemp + NPCOL = NPCOLtemp + NPROCSused = NPROW * NPCOL + END IF + GO TO 10 + END IF + RETURN + END SUBROUTINE SMUMPS_99 + SUBROUTINE SMUMPS_290(MYID, M, N, ASEQ, + & LOCAL_M, LOCAL_N, + & MBLOCK, NBLOCK, + & APAR, + & MASTER_ROOT, + & NPROW, NPCOL, + & COMM) + IMPLICIT NONE + INTEGER MYID, MASTER_ROOT, COMM + INTEGER M, N + INTEGER NPROW, NPCOL + INTEGER LOCAL_M, LOCAL_N + INTEGER MBLOCK, NBLOCK + REAL APAR( LOCAL_M, LOCAL_N ) + REAL ASEQ( M, N ) + INCLUDE 'mpif.h' + INTEGER I, J, SIZE_IBLOCK, SIZE_JBLOCK, IDEST, IROW, ICOL + INTEGER IBLOCK, JBLOCK, II, JJ, KK + INTEGER IAPAR, JAPAR, IERR + INTEGER STATUS(MPI_STATUS_SIZE) + REAL WK( MBLOCK * NBLOCK ) + LOGICAL JUPDATE + IAPAR = 1 + JAPAR = 1 + DO J = 1, N, NBLOCK + SIZE_JBLOCK = NBLOCK + IF ( J + NBLOCK > N ) THEN + SIZE_JBLOCK = N - J + 1 + END IF + JUPDATE = .FALSE. + DO I = 1, M, MBLOCK + SIZE_IBLOCK = MBLOCK + IF ( I + MBLOCK > M ) THEN + SIZE_IBLOCK = M - I + 1 + END IF + IBLOCK = I / MBLOCK + JBLOCK = J / NBLOCK + IROW = mod ( IBLOCK, NPROW ) + ICOL = mod ( JBLOCK, NPCOL ) + IDEST = IROW * NPCOL + ICOL + IF ( IDEST .NE. MASTER_ROOT ) THEN + IF ( MYID .EQ. MASTER_ROOT ) THEN + KK=1 + DO JJ=J,J+SIZE_JBLOCK-1 + DO II=I,I+SIZE_IBLOCK-1 + WK(KK)=ASEQ(II,JJ) + KK=KK+1 + END DO + END DO + CALL MPI_SSEND( WK, SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_REAL, + & IDEST, 128, COMM, IERR ) + ELSE IF ( MYID .EQ. IDEST ) THEN + CALL MPI_RECV( WK(1), + & SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_REAL, + & MASTER_ROOT,128,COMM,STATUS,IERR) + KK=1 + DO JJ=JAPAR,JAPAR+SIZE_JBLOCK-1 + DO II=IAPAR,IAPAR+SIZE_IBLOCK-1 + APAR(II,JJ)=WK(KK) + KK=KK+1 + END DO + END DO + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + ELSE IF ( MYID.EQ. MASTER_ROOT ) THEN + APAR( IAPAR:IAPAR+SIZE_IBLOCK-1, + & JAPAR:JAPAR+SIZE_JBLOCK-1 ) + & = ASEQ(I:I+SIZE_IBLOCK-1,J:J+SIZE_JBLOCK-1) + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + END DO + IF ( JUPDATE ) THEN + IAPAR = 1 + JAPAR = JAPAR + SIZE_JBLOCK + END IF + END DO + RETURN + END SUBROUTINE SMUMPS_290 + SUBROUTINE SMUMPS_156(MYID, M, N, ASEQ, + & LOCAL_M, LOCAL_N, + & MBLOCK, NBLOCK, + & APAR, + & MASTER_ROOT, + & NPROW, NPCOL, + & COMM) + IMPLICIT NONE + INTEGER MYID, MASTER_ROOT, COMM + INTEGER M, N + INTEGER NPROW, NPCOL + INTEGER LOCAL_M, LOCAL_N + INTEGER MBLOCK, NBLOCK + REAL APAR( LOCAL_M, LOCAL_N ) + REAL ASEQ( M, N ) + INCLUDE 'mpif.h' + INTEGER I, J, SIZE_IBLOCK, SIZE_JBLOCK, ISOUR, IROW, ICOL + INTEGER IBLOCK, JBLOCK, II, JJ, KK + INTEGER IAPAR, JAPAR, IERR + INTEGER STATUS(MPI_STATUS_SIZE) + REAL WK( MBLOCK * NBLOCK ) + LOGICAL JUPDATE + IAPAR = 1 + JAPAR = 1 + DO J = 1, N, NBLOCK + SIZE_JBLOCK = NBLOCK + IF ( J + NBLOCK > N ) THEN + SIZE_JBLOCK = N - J + 1 + END IF + JUPDATE = .FALSE. + DO I = 1, M, MBLOCK + SIZE_IBLOCK = MBLOCK + IF ( I + MBLOCK > M ) THEN + SIZE_IBLOCK = M - I + 1 + END IF + IBLOCK = I / MBLOCK + JBLOCK = J / NBLOCK + IROW = mod ( IBLOCK, NPROW ) + ICOL = mod ( JBLOCK, NPCOL ) + ISOUR = IROW * NPCOL + ICOL + IF ( ISOUR .NE. MASTER_ROOT ) THEN + IF ( MYID .EQ. MASTER_ROOT ) THEN + CALL MPI_RECV( WK(1), SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_REAL, + & ISOUR, 128, COMM, STATUS, IERR ) + KK=1 + DO JJ=J,J+SIZE_JBLOCK-1 + DO II=I,I+SIZE_IBLOCK-1 + ASEQ(II,JJ)=WK(KK) + KK=KK+1 + END DO + END DO + ELSE IF ( MYID .EQ. ISOUR ) THEN + KK=1 + DO JJ=JAPAR,JAPAR+SIZE_JBLOCK-1 + DO II=IAPAR,IAPAR+SIZE_IBLOCK-1 + WK(KK)=APAR(II,JJ) + KK=KK+1 + END DO + END DO + CALL MPI_SSEND( WK( 1 ), + & SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_REAL, + & MASTER_ROOT,128,COMM,IERR) + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + ELSE IF ( MYID.EQ. MASTER_ROOT ) THEN + ASEQ(I:I+SIZE_IBLOCK-1,J:J+SIZE_JBLOCK-1) + & = APAR( IAPAR:IAPAR+SIZE_IBLOCK-1, + & JAPAR:JAPAR+SIZE_JBLOCK-1 ) + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + END DO + IF ( JUPDATE ) THEN + IAPAR = 1 + JAPAR = JAPAR + SIZE_JBLOCK + END IF + END DO + RETURN + END SUBROUTINE SMUMPS_156 + SUBROUTINE SMUMPS_284(root, IROOT, N, + & IW, LIW, A, LA, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INTEGER MYID + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + TYPE (SMUMPS_ROOT_STRUC ) :: root + INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS + INTEGER IROOT, LIW, N, IWPOS, IWPOSCB + INTEGER IW( LIW ) + REAL A( LA ) + INTEGER PTRIST(KEEP(28)), STEP(N) + INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER PIMASTER(KEEP(28)) + INTEGER ITLOC( N + KEEP(253) ) + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER COMP, IFLAG, IERROR + INCLUDE 'mumps_headers.h' + INTEGER FILS( N ), PTRAIW(N), PTRARW( N ) + INTEGER INTARR(max(1,KEEP(14))) + REAL DBLARR(max(1,KEEP(13))) + INTEGER numroc + EXTERNAL numroc + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INTEGER(8) :: LREQA_ROOT + INTEGER LREQI_ROOT, LOCAL_M, LOCAL_N, allocok + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + IF (KEEP(253).GT.0) THEN + root%RHS_NLOC = numroc( KEEP(253), root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + root%RHS_NLOC = max(1, root%RHS_NLOC) + ELSE + root%RHS_NLOC = 1 + ENDIF + IF (associated( root%RHS_ROOT) ) + & DEALLOCATE (root%RHS_ROOT) + ALLOCATE(root%RHS_ROOT(LOCAL_M,root%RHS_NLOC), + & stat=allocok) + IF ( allocok.GT.0) THEN + IFLAG=-13 + IERROR = LOCAL_M*root%RHS_NLOC + RETURN + ENDIF + IF (KEEP(253).NE.0) THEN + root%RHS_ROOT = ZERO + CALL SMUMPS_760 ( N, FILS, + & root, KEEP, RHS_MUMPS, + & IFLAG, IERROR ) + IF ( IFLAG .LT. 0 ) RETURN + ENDIF + IF (KEEP(60) .NE. 0) THEN + PTRIST(STEP(IROOT)) = -6666666 + RETURN + ENDIF + LREQI_ROOT = 2 + KEEP(IXSZ) + LREQA_ROOT = int(LOCAL_M,8) * int(LOCAL_N,8) + IF (LREQA_ROOT.EQ.0_8) THEN + PTRIST(STEP(IROOT)) = -9999999 + RETURN + ENDIF + CALL SMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A,LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, LREQI_ROOT, + & LREQA_ROOT, IROOT, S_NOTFREE, .TRUE., COMP, + & LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + PTRIST ( STEP(IROOT) ) = IWPOSCB + 1 + PAMASTER( STEP(IROOT) ) = IPTRLU + 1_8 + IW( IWPOSCB + 1 + KEEP(IXSZ)) = - LOCAL_N + IW( IWPOSCB + 2 + KEEP(IXSZ)) = LOCAL_M + RETURN + END SUBROUTINE SMUMPS_284 + SUBROUTINE SMUMPS_760 + & ( N, FILS, root, KEEP, RHS_MUMPS, + & IFLAG, IERROR ) + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INTEGER N, KEEP(500), IFLAG, IERROR + INTEGER FILS(N) + TYPE (SMUMPS_ROOT_STRUC ) :: root + REAL :: RHS_MUMPS(KEEP(255)) + INTEGER JCOL, IPOS_ROOT, JPOS_ROOT, + & IROW_GRID, JCOL_GRID, ILOCRHS, JLOCRHS, + & INODE + INODE = KEEP(38) + DO WHILE (INODE.GT.0) + IPOS_ROOT = root%RG2L_ROW( INODE ) + IROW_GRID = mod( ( IPOS_ROOT - 1 ) / root%MBLOCK, root%NPROW ) + IF ( IROW_GRID .NE. root%MYROW ) GOTO 100 + ILOCRHS = root%MBLOCK * ( ( IPOS_ROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOS_ROOT - 1, root%MBLOCK ) + 1 + DO JCOL = 1, KEEP(253) + JPOS_ROOT = JCOL + JCOL_GRID = mod((JPOS_ROOT-1)/root%NBLOCK, root%NPCOL) + IF (JCOL_GRID.NE.root%MYCOL ) CYCLE + JLOCRHS = root%NBLOCK * ( ( JPOS_ROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOS_ROOT - 1, root%NBLOCK ) + 1 + root%RHS_ROOT(ILOCRHS, JLOCRHS) = + & RHS_MUMPS(INODE+(JCOL-1)*KEEP(254)) + ENDDO + 100 CONTINUE + INODE=FILS(INODE) + ENDDO + RETURN + END SUBROUTINE SMUMPS_760 + INTEGER FUNCTION SMUMPS_IXAMAX(n,x,incx) + REAL x(*) + integer incx,n + INTEGER isamax + SMUMPS_IXAMAX = isamax(n,x,incx) + return + END FUNCTION SMUMPS_IXAMAX + SUBROUTINE SMUMPS_XSYR( UPLO, N, ALPHA, X, INCX, A, LDA ) + CHARACTER UPLO + INTEGER INCX, LDA, N + REAL ALPHA + REAL A( LDA, * ), X( * ) + CALL ssyr( UPLO, N, ALPHA, X, INCX, A, LDA ) + RETURN + END SUBROUTINE SMUMPS_XSYR diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part7.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part7.F new file mode 100644 index 000000000..ad2bdf182 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part7.F @@ -0,0 +1,1037 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE SMUMPS_635(N,KEEP,ICNTL,MPG) + IMPLICIT NONE + INTEGER N, KEEP(500), ICNTL(40), MPG + KEEP(19)=0 + RETURN + END SUBROUTINE SMUMPS_635 + SUBROUTINE SMUMPS_634(ICNTL,KEEP,MPG,INFO) + IMPLICIT NONE + INTEGER KEEP(500), MPG, INFO(40), ICNTL(40) + IF (KEEP(19).EQ.0.AND.KEEP(110).EQ.0) THEN + IF (KEEP(111).NE.0) THEN + INFO(1) = -37 + INFO(2) = 16 + IF (KEEP(110).EQ.0) INFO(2) = 24 + IF(MPG.GT.0) THEN + WRITE( MPG,'(A)') + &'** ERROR : Null space computation requirement' + WRITE( MPG,'(A)') + &'** not consistent with factorization options' + ENDIF + GOTO 333 + ENDIF + ENDIF + IF (ICNTL(9).NE.1) THEN + IF (KEEP(111).NE.0) THEN + INFO(1) = -37 + INFO(2) = 9 + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + &'** ERROR ICNTL(25) incompatible with ' + WRITE( MPG,'(A)') + &'** option transposed system (ICNLT(9)=1) ' + ENDIF + ENDIF + GOTO 333 + ENDIF + 333 CONTINUE + RETURN + END SUBROUTINE SMUMPS_634 + SUBROUTINE SMUMPS_637(id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (SMUMPS_STRUC) id + NULLIFY(id%root%QR_TAU) + RETURN + END SUBROUTINE SMUMPS_637 + SUBROUTINE SMUMPS_636(id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (SMUMPS_STRUC) id + IF (associated(id%root%QR_TAU)) THEN + DEALLOCATE(id%root%QR_TAU) + NULLIFY(id%root%QR_TAU) + ENDIF + RETURN + END SUBROUTINE SMUMPS_636 + SUBROUTINE SMUMPS_146( MYID, root, N, IROOT, + & COMM, IW, LIW, IFREE, + & A, LA, PTRAST, PTLUST_S, PTRFAC, + & STEP, INFO, LDLT, QR, + & WK, LWK, KEEP,KEEP8,DKEEP) + IMPLICIT NONE + INCLUDE 'smumps_root.h' + INCLUDE 'mpif.h' + TYPE ( SMUMPS_ROOT_STRUC ) :: root + INTEGER N, IROOT, COMM, LIW, MYID, IFREE + INTEGER(8) :: LA + INTEGER(8) :: LWK + REAL WK( LWK ) + INTEGER KEEP(500) + REAL DKEEP(30) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PTLUST_S(KEEP(28)), STEP(N), IW( LIW ) + INTEGER INFO( 2 ), LDLT, QR + REAL A( LA ) + INTEGER IOLDPS + INTEGER(8) :: IAPOS + INTEGER LOCAL_M, LOCAL_N, LPIV, IERR, allocok + INTEGER FWD_LOCAL_N_RHS, FWD_MTYPE + INCLUDE 'mumps_headers.h' + EXTERNAL numroc + INTEGER numroc + IF ( .NOT. root%yes ) RETURN + IF ( KEEP(60) .NE. 0 ) THEN + IF ((LDLT == 1 .OR. LDLT == 2) .AND. KEEP(60) == 3 ) THEN + CALL SMUMPS_320( WK, root%MBLOCK, + & root%MYROW, root%MYCOL, root%NPROW, root%NPCOL, + & root%SCHUR_POINTER(1), + & root%SCHUR_LLD, root%SCHUR_NLOC, + & root%TOT_ROOT_SIZE, MYID, COMM ) + ENDIF + RETURN + ENDIF + IOLDPS = PTLUST_S(STEP(IROOT))+KEEP(IXSZ) + IAPOS = PTRAST(STEP(IROOT)) + LOCAL_M = IW( IOLDPS + 2 ) + LOCAL_N = IW( IOLDPS + 1 ) + IAPOS = PTRFAC(IW ( IOLDPS + 4 )) + IF ( LDLT.EQ.0 .OR. LDLT.EQ.2 .OR. QR.ne.0 ) THEN + LPIV = LOCAL_M + root%MBLOCK + ELSE + LPIV = 1 + END IF + IF (associated( root%IPIV )) DEALLOCATE(root%IPIV) + root%LPIV = LPIV + ALLOCATE( root%IPIV( LPIV ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LPIV + WRITE(*,*) MYID,': problem allocating IPIV(',LPIV,') in root' + CALL MUMPS_ABORT() + END IF + CALL DESCINIT( root%DESCRIPTOR(1), root%TOT_ROOT_SIZE, + & root%TOT_ROOT_SIZE, root%MBLOCK, root%NBLOCK, + & 0, 0, root%CNTXT_BLACS, LOCAL_M, IERR ) + IF ( LDLT.EQ.2 ) THEN + IF(root%MBLOCK.NE.root%NBLOCK) THEN + WRITE(*,*) ' Error: symmetrization only works for' + WRITE(*,*) ' square block sizes, MBLOCK/NBLOCK=', + & root%MBLOCK, root%NBLOCK + CALL MUMPS_ABORT() + END IF + IF ( LWK .LT. min( + & int(root%MBLOCK,8) * int(root%NBLOCK,8), + & int(root%TOT_ROOT_SIZE,8)* int(root%TOT_ROOT_SIZE,8 ) + & )) THEN + WRITE(*,*) 'Not enough workspace for symmetrization.' + CALL MUMPS_ABORT() + END IF + CALL SMUMPS_320( WK, root%MBLOCK, + & root%MYROW, root%MYCOL, root%NPROW, root%NPCOL, + & A( IAPOS ), LOCAL_M, LOCAL_N, + & root%TOT_ROOT_SIZE, MYID, COMM ) + END IF + IF (LDLT.EQ.0.OR.LDLT.EQ.2) THEN + CALL psgetrf( root%TOT_ROOT_SIZE, root%TOT_ROOT_SIZE, + & A( IAPOS ), + & 1, 1, root%DESCRIPTOR(1), root%IPIV(1), IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-10 + INFO(2)=IERR-1 + END IF + ELSE + CALL pspotrf('L',root%TOT_ROOT_SIZE,A(IAPOS), + & 1,1,root%DESCRIPTOR(1),IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-40 + INFO(2)=IERR-1 + END IF + END IF + IF (KEEP(258).NE.0) THEN + IF (root%MBLOCK.NE.root%NBLOCK) THEN + write(*,*) "Internal error in SMUMPS_146:", + & "Block size different for rows and columns", + & root%MBLOCK, root%NBLOCK + CALL MUMPS_ABORT() + ENDIF + CALL SMUMPS_763(root%MBLOCK, root%IPIV(1),root%MYROW, + & root%MYCOL, root%NPROW, root%NPCOL, A(IAPOS), LOCAL_M, + & LOCAL_N, root%TOT_ROOT_SIZE, MYID, DKEEP(6), KEEP(259), + & LDLT) + ENDIF + IF (KEEP(252) .NE. 0) THEN + FWD_LOCAL_N_RHS = numroc(KEEP(253), root%NBLOCK, + & root%MYCOL, 0, root%NPCOL) + FWD_LOCAL_N_RHS = max(1,FWD_LOCAL_N_RHS) + FWD_MTYPE = 1 + CALL SMUMPS_768( + & root%TOT_ROOT_SIZE, + & KEEP(253), + & FWD_MTYPE, + & A(IAPOS), + & root%DESCRIPTOR(1), + & LOCAL_M, LOCAL_N, FWD_LOCAL_N_RHS, + & root%IPIV(1), LPIV, + & root%RHS_ROOT(1,1), LDLT, + & root%MBLOCK, root%NBLOCK, + & root%CNTXT_BLACS, IERR) + ENDIF + RETURN + END SUBROUTINE SMUMPS_146 + SUBROUTINE SMUMPS_556( + & N,PIV,FRERE,FILS,NFSIZ,IKEEP, + & NCST,KEEP,KEEP8,id) + USE SMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (SMUMPS_STRUC) :: id + INTEGER N,NCST + INTEGER PIV(N),FRERE(N),FILS(N),NFSIZ(N),IKEEP(N,3) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER I,P11,P1,P2,K1,K2,NLOCKED + LOGICAL V1,V2 + NCST = 0 + NLOCKED = 0 + P11 = KEEP(93) + DO I=KEEP(93)-1,1,-2 + P1 = PIV(I) + P2 = PIV(I+1) + K1 = IKEEP(P1,1) + IF(K1 .GT. 0) THEN + V1 = (abs(id%A(K1))*(id%ROWSCA(P1)**2).GE.1.0E-1) + ELSE + V1 = .FALSE. + ENDIF + K2 = IKEEP(P2,1) + IF(K2 .GT. 0) THEN + V2 = (abs(id%A(K2))*(id%ROWSCA(P2)**2).GE.1.0E-1) + ELSE + V2 = .FALSE. + ENDIF + IF(V1 .AND. V2) THEN + PIV(P11) = P1 + P11 = P11 - 1 + PIV(P11) = P2 + P11 = P11 - 1 + ELSE IF(V1) THEN + NCST = NCST+1 + FRERE(NCST) = P1 + NCST = NCST+1 + FRERE(NCST) = P2 + ELSE IF(V2) THEN + NCST = NCST+1 + FRERE(NCST) = P2 + NCST = NCST+1 + FRERE(NCST) = P1 + ELSE + NLOCKED = NLOCKED + 1 + FILS(NLOCKED) = P1 + NLOCKED = NLOCKED + 1 + FILS(NLOCKED) = P2 + ENDIF + ENDDO + DO I=1,NLOCKED + PIV(I) = FILS(I) + ENDDO + KEEP(94) = KEEP(94) + KEEP(93) - NLOCKED + KEEP(93) = NLOCKED + DO I=1,NCST + NLOCKED = NLOCKED + 1 + PIV(NLOCKED) = FRERE(I) + ENDDO + DO I=1,KEEP(93)/2 + NFSIZ(I) = 0 + ENDDO + DO I=(KEEP(93)/2)+1,(KEEP(93)/2)+NCST,2 + NFSIZ(I) = I+1 + NFSIZ(I+1) = -1 + ENDDO + DO I=(KEEP(93)/2)+NCST+1,(KEEP(93)/2)+KEEP(94) + NFSIZ(I) = 0 + ENDDO + END SUBROUTINE SMUMPS_556 + SUBROUTINE SMUMPS_550(N,NCMP,N11,N22,PIV, + & INVPERM,PERM) + IMPLICIT NONE + INTEGER N11,N22,N,NCMP + INTEGER, intent(in) :: PIV(N),PERM(N) + INTEGER, intent (out):: INVPERM(N) + INTEGER CMP_POS,EXP_POS,I,J,N2,K + N2 = N22/2 + EXP_POS = 1 + DO CMP_POS=1,NCMP + J = PERM(CMP_POS) + IF(J .LE. N2) THEN + K = 2*J-1 + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + K = K+1 + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + ELSE + K = N2 + J + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + ENDIF + ENDDO + DO K=N22+N11+1,N + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + ENDDO + RETURN + END SUBROUTINE SMUMPS_550 + SUBROUTINE SMUMPS_547( + & N,NZ, IRN, ICN, PIV, + & NCMP, IW, LW, IPE, LEN, IQ, + & FLAG, ICMP, IWFR, + & IERROR, KEEP,KEEP8, ICNTL) + IMPLICIT NONE + INTEGER N,NZ,NCMP,LW,IWFR,IERROR + INTEGER ICNTL(40),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IRN(NZ),ICN(NZ),IW(LW),PIV(N),IPE(N+1) + INTEGER LEN(N),IQ(N),FLAG(N),ICMP(N) + INTEGER MP,N11,N22,NDUP + INTEGER I,K,J,N1,LAST,K1,K2,L + MP = ICNTL(2) + IERROR = 0 + N22 = KEEP(93) + N11 = KEEP(94) + NCMP = N22/2 + N11 + DO I=1,NCMP + IPE(I) = 0 + ENDDO + K = 1 + DO I=1,N22/2 + J = PIV(K) + ICMP(J) = I + K = K + 1 + J = PIV(K) + ICMP(J) = I + K = K + 1 + ENDDO + K = N22/2 + 1 + DO I=N22+1,N22+N11 + J = PIV(I) + ICMP(J) = K + K = K + 1 + ENDDO + DO I=N11+N22+1,N + J = PIV(I) + ICMP(J) = 0 + ENDDO + DO K=1,NZ + I = IRN(K) + J = ICN(K) + I = ICMP(I) + J = ICMP(J) + IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + IERROR = IERROR + 1 + ELSE + IF (I.NE.J) THEN + IPE(I) = IPE(I) + 1 + IPE(J) = IPE(J) + 1 + ENDIF + ENDIF + ENDDO + IQ(1) = 1 + N1 = NCMP - 1 + IF (N1.GT.0) THEN + DO I=1,N1 + IQ(I+1) = IPE(I) + IQ(I) + ENDDO + ENDIF + LAST = max(IPE(NCMP)+IQ(NCMP)-1,IQ(NCMP)) + DO I = 1,NCMP + FLAG(I) = 0 + IPE(I) = IQ(I) + ENDDO + DO K=1,LAST + IW(K) = 0 + ENDDO + IWFR = LAST + 1 + DO K=1,NZ + I = IRN(K) + J = ICN(K) + I = ICMP(I) + J = ICMP(J) + IF (I.NE.J) THEN + IF (I.LT.J) THEN + IF ((I.GE.1).AND.(J.LE.N)) THEN + IW(IQ(I)) = -J + IQ(I) = IQ(I) + 1 + ENDIF + ELSE + IF ((J.GE.1).AND.(I.LE.N)) THEN + IW(IQ(J)) = -I + IQ(J) = IQ(J) + 1 + ENDIF + ENDIF + ENDIF + ENDDO + NDUP = 0 + DO I=1,NCMP + K1 = IPE(I) + K2 = IQ(I) -1 + IF (K1.GT.K2) THEN + LEN(I) = 0 + IQ(I) = 0 + ELSE + DO K=K1,K2 + J = -IW(K) + IF (J.LE.0) GO TO 250 + L = IQ(J) + IQ(J) = L + 1 + IF (FLAG(J).EQ.I) THEN + NDUP = NDUP + 1 + IW(L) = 0 + IW(K) = 0 + ELSE + IW(L) = I + IW(K) = J + FLAG(J) = I + ENDIF + ENDDO + 250 IQ(I) = IQ(I) - IPE(I) + IF (NDUP.EQ.0) LEN(I) = IQ(I) + ENDIF + ENDDO + IF (NDUP.NE.0) THEN + IWFR = 1 + DO I=1,NCMP + K1 = IPE(I) + IF (IQ(I).EQ.0) THEN + LEN(I) = 0 + IPE(I) = IWFR + CYCLE + ENDIF + K2 = K1 + IQ(I) - 1 + L = IWFR + IPE(I) = IWFR + DO K=K1,K2 + IF (IW(K).NE.0) THEN + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + ENDIF + ENDDO + LEN(I) = IWFR - L + ENDDO + ENDIF + IPE(NCMP+1) = IPE(NCMP) + LEN(NCMP) + IWFR = IPE(NCMP+1) + RETURN + END SUBROUTINE SMUMPS_547 + SUBROUTINE SMUMPS_551( + & N, NE, IP, IRN, SCALING,LSC,CPERM, DIAG, + & ICNTL, WEIGHT,MARKED,FLAG, + & PIV_OUT, INFO) + IMPLICIT NONE + INTEGER N, NE, ICNTL(10), INFO(10),LSC + INTEGER CPERM(N),PIV_OUT(N),IP(N+1),IRN(NE), DIAG(N) + REAL SCALING(LSC),WEIGHT(N+2) + INTEGER MARKED(N),FLAG(N) + INTEGER NUM1,NUM2,NUMTOT,PATH_LENGTH,NLAST + INTEGER I,CUR_EL,CUR_EL_PATH,CUR_EL_PATH_NEXT,BEST_BEG + INTEGER L1,L2,PTR_SET1,PTR_SET2,TUP,T22 + REAL BEST_SCORE,CUR_VAL,TMP,VAL + REAL INITSCORE, SMUMPS_739, + & SMUMPS_740, SMUMPS_741 + LOGICAL VRAI,FAUX,MAX_CARD_DIAG,USE_SCALING + INTEGER SUM + REAL ZERO,ONE + PARAMETER (SUM = 1, VRAI = .TRUE., FAUX = .FALSE.) + PARAMETER(ZERO = 0.0E0, ONE = 1.0E0) + MAX_CARD_DIAG = .TRUE. + NUM1 = 0 + NUM2 = 0 + NUMTOT = 0 + NLAST = N + INFO = 0 + MARKED = 1 + FLAG = 0 + VAL = ONE + IF(LSC .GT. 1) THEN + USE_SCALING = .TRUE. + ELSE + USE_SCALING = .FALSE. + ENDIF + TUP = ICNTL(2) + IF(TUP .EQ. SUM) THEN + INITSCORE = ZERO + ELSE + INITSCORE = ONE + ENDIF + IF(ICNTL(2) .GT. 2 .OR. ICNTL(2) .LE. 0) THEN + WRITE(*,*) + & 'ERROR: WRONG VALUE FOR ICNTL(2) = ',ICNTL(2) + INFO(1) = -1 + RETURN + ENDIF + T22 = ICNTL(1) + IF(ICNTL(1) .LT. 0 .OR. ICNTL(1) .GT. 2) THEN + WRITE(*,*) + & 'ERROR: WRONG VALUE FOR ICNTL(1) = ',ICNTL(1) + INFO(1) = -1 + RETURN + ENDIF + DO CUR_EL=1,N + IF(MARKED(CUR_EL) .LE. 0) THEN + CYCLE + ENDIF + IF(CPERM(CUR_EL) .LT. 0) THEN + MARKED(CUR_EL) = -1 + CYCLE + ENDIF + PATH_LENGTH = 2 + CUR_EL_PATH = CPERM(CUR_EL) + IF(CUR_EL_PATH .EQ. CUR_EL) THEN + MARKED(CUR_EL) = -1 + CYCLE + ENDIF + MARKED(CUR_EL) = 0 + WEIGHT(1) = INITSCORE + WEIGHT(2) = INITSCORE + L1 = IP(CUR_EL+1)-IP(CUR_EL) + L2 = IP(CUR_EL_PATH+1)-IP(CUR_EL_PATH) + PTR_SET1 = IP(CUR_EL) + PTR_SET2 = IP(CUR_EL_PATH) + IF(USE_SCALING) THEN + VAL = -SCALING(CUR_EL_PATH) - SCALING(CUR_EL+N) + ENDIF + CUR_VAL = SMUMPS_741( + & CUR_EL,CUR_EL_PATH, + & IRN(PTR_SET1),IRN(PTR_SET2), + & L1,L2, + & VAL,DIAG,N,FLAG,FAUX,T22) + WEIGHT(PATH_LENGTH+1) = + & SMUMPS_739(WEIGHT(1),CUR_VAL,TUP) + DO + IF(CUR_EL_PATH .EQ. CUR_EL) EXIT + PATH_LENGTH = PATH_LENGTH+1 + MARKED(CUR_EL_PATH) = 0 + CUR_EL_PATH_NEXT = CPERM(CUR_EL_PATH) + L1 = IP(CUR_EL_PATH+1)-IP(CUR_EL_PATH) + L2 = IP(CUR_EL_PATH_NEXT+1)-IP(CUR_EL_PATH_NEXT) + PTR_SET1 = IP(CUR_EL_PATH) + PTR_SET2 = IP(CUR_EL_PATH_NEXT) + IF(USE_SCALING) THEN + VAL = -SCALING(CUR_EL_PATH_NEXT) + & - SCALING(CUR_EL_PATH+N) + ENDIF + CUR_VAL = SMUMPS_741( + & CUR_EL_PATH,CUR_EL_PATH_NEXT, + & IRN(PTR_SET1),IRN(PTR_SET2), + & L1,L2, + & VAL,DIAG,N,FLAG,VRAI,T22) + WEIGHT(PATH_LENGTH+1) = + & SMUMPS_739(WEIGHT(PATH_LENGTH-1),CUR_VAL,TUP) + CUR_EL_PATH = CUR_EL_PATH_NEXT + ENDDO + IF(mod(PATH_LENGTH,2) .EQ. 1) THEN + IF(WEIGHT(PATH_LENGTH+1) .GE. WEIGHT(PATH_LENGTH)) THEN + CUR_EL_PATH = CPERM(CUR_EL) + ELSE + CUR_EL_PATH = CUR_EL + ENDIF + DO I=1,(PATH_LENGTH-1)/2 + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + ENDDO + NUMTOT = NUMTOT + PATH_LENGTH - 1 + ELSE + IF(MAX_CARD_DIAG) THEN + CUR_EL_PATH = CPERM(CUR_EL) + IF(DIAG(CUR_EL) .NE. 0) THEN + BEST_BEG = CUR_EL_PATH + GOTO 1000 + ENDIF + DO I=1,(PATH_LENGTH/2) + CUR_EL_PATH_NEXT = CPERM(CUR_EL_PATH) + IF(DIAG(CUR_EL_PATH) .NE. 0) THEN + BEST_BEG = CUR_EL_PATH_NEXT + GOTO 1000 + ENDIF + ENDDO + ENDIF + BEST_BEG = CUR_EL + BEST_SCORE = WEIGHT(PATH_LENGTH-1) + CUR_EL_PATH = CPERM(CUR_EL) + DO I=1,(PATH_LENGTH/2)-1 + TMP = SMUMPS_739(WEIGHT(PATH_LENGTH), + & WEIGHT(2*I-1),TUP) + TMP = SMUMPS_740(TMP,WEIGHT(2*I),TUP) + IF(TMP .GT. BEST_SCORE) THEN + BEST_SCORE = TMP + BEST_BEG = CUR_EL_PATH + ENDIF + CUR_EL_PATH = CPERM(CUR_EL_PATH) + TMP = SMUMPS_739(WEIGHT(PATH_LENGTH+1), + & WEIGHT(2*I),TUP) + TMP = SMUMPS_740(TMP,WEIGHT(2*I+1),TUP) + IF(TMP .GT. BEST_SCORE) THEN + BEST_SCORE = TMP + BEST_BEG = CUR_EL_PATH + ENDIF + CUR_EL_PATH = CPERM(CUR_EL_PATH) + ENDDO + 1000 CUR_EL_PATH = BEST_BEG + DO I=1,(PATH_LENGTH/2)-1 + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + ENDDO + NUMTOT = NUMTOT + PATH_LENGTH - 2 + MARKED(CUR_EL_PATH) = -1 + ENDIF + ENDDO + DO I=1,N + IF(MARKED(I) .LT. 0) THEN + IF(DIAG(I) .EQ. 0) THEN + PIV_OUT(NLAST) = I + NLAST = NLAST - 1 + ELSE + NUM1 = NUM1 + 1 + PIV_OUT(NUM2+NUM1) = I + NUMTOT = NUMTOT + 1 + ENDIF + ENDIF + ENDDO + INFO(2) = NUMTOT + INFO(3) = NUM1 + INFO(4) = NUM2 + RETURN + END SUBROUTINE SMUMPS_551 + FUNCTION SMUMPS_739(A,B,T) + IMPLICIT NONE + REAL SMUMPS_739 + REAL A,B + INTEGER T + INTEGER SUM + PARAMETER(SUM = 1) + IF(T .EQ. SUM) THEN + SMUMPS_739 = A+B + ELSE + SMUMPS_739 = A*B + ENDIF + END FUNCTION SMUMPS_739 + FUNCTION SMUMPS_740(A,B,T) + IMPLICIT NONE + REAL SMUMPS_740 + REAL A,B + INTEGER T + INTEGER SUM + PARAMETER(SUM = 1) + IF(T .EQ. SUM) THEN + SMUMPS_740 = A-B + ELSE + SMUMPS_740 = A/B + ENDIF + END FUNCTION SMUMPS_740 + FUNCTION SMUMPS_741(CUR_EL,CUR_EL_PATH, + & SET1,SET2,L1,L2,VAL,DIAG,N,FLAG,FLAGON,T) + IMPLICIT NONE + REAL SMUMPS_741 + INTEGER CUR_EL,CUR_EL_PATH,L1,L2,N + INTEGER SET1(L1),SET2(L2),DIAG(N),FLAG(N) + REAL VAL + LOGICAL FLAGON + INTEGER T + INTEGER I,INTER,MERGE + INTEGER STRUCT,MA47 + PARAMETER(STRUCT=0,MA47=1) + IF(T .EQ. STRUCT) THEN + IF(.NOT. FLAGON) THEN + DO I=1,L1 + FLAG(SET1(I)) = CUR_EL + ENDDO + ENDIF + INTER = 0 + DO I=1,L2 + IF(FLAG(SET2(I)) .EQ. CUR_EL) THEN + INTER = INTER + 1 + FLAG(SET2(I)) = CUR_EL_PATH + ENDIF + ENDDO + MERGE = L1 + L2 - INTER + SMUMPS_741 = real(INTER) / real(MERGE) + ELSE IF (T .EQ. MA47) THEN + MERGE = 3 + IF(DIAG(CUR_EL) .NE. 0) MERGE = 2 + IF(DIAG(CUR_EL_PATH) .NE. 0) MERGE = MERGE - 2 + IF(MERGE .EQ. 0) THEN + SMUMPS_741 = real(L1+L2-2) + SMUMPS_741 = -(SMUMPS_741**2)/2.0E0 + ELSE IF(MERGE .EQ. 1) THEN + SMUMPS_741 = - real(L1+L2-4) * real(L1-2) + ELSE IF(MERGE .EQ. 2) THEN + SMUMPS_741 = - real(L1+L2-4) * real(L2-2) + ELSE + SMUMPS_741 = - real(L1-2) * real(L2-2) + ENDIF + ELSE + SMUMPS_741 = VAL + ENDIF + RETURN + END FUNCTION + SUBROUTINE SMUMPS_622(NA, NCMP, + & INVPERM,PERM, + & LISTVAR_SCHUR, SIZE_SCHUR, AOTOA) + IMPLICIT NONE + INTEGER, INTENT(IN):: SIZE_SCHUR, LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER, INTENT(IN):: NA, NCMP + INTEGER, INTENT(IN):: AOTOA(NCMP), PERM(NCMP) + INTEGER, INTENT(OUT):: INVPERM(NA) + INTEGER CMP_POS, IO, I, K, IPOS + DO CMP_POS=1, NCMP + IO = PERM(CMP_POS) + INVPERM(AOTOA(IO)) = CMP_POS + ENDDO + IPOS = NCMP + DO K =1, SIZE_SCHUR + I = LISTVAR_SCHUR(K) + IPOS = IPOS+1 + INVPERM(I) = IPOS + ENDDO + RETURN + END SUBROUTINE SMUMPS_622 + SUBROUTINE SMUMPS_623 + & (NA,N,NZ, IRN, ICN, IW, LW, IPE, LEN, + & IQ, FLAG, IWFR, + & NRORM, NIORM, IFLAG,IERROR, ICNTL, + & symmetry, SYM, MedDens, NBQD, AvgDens, + & LISTVAR_SCHUR, SIZE_SCHUR, ATOAO, AOTOA) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NA,N,NZ,LW + INTEGER, INTENT(IN) :: SIZE_SCHUR, LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER, INTENT(IN) :: IRN(NZ), ICN(NZ) + INTEGER, INTENT(IN) :: ICNTL(40), SYM + INTEGER, INTENT(INOUT) :: IFLAG + INTEGER, INTENT(OUT) :: IERROR,NRORM,NIORM,IWFR + INTEGER, INTENT(OUT) :: AOTOA(N) + INTEGER, INTENT(OUT) :: ATOAO(NA) + INTEGER, INTENT(OUT) :: LEN(N), IPE(N+1) + INTEGER, INTENT(OUT) :: symmetry, + & MedDens, NBQD, AvgDens + INTEGER, INTENT(OUT) :: FLAG(N), IW(LW), IQ(N) + INTEGER MP, MPG + INTEGER I,K,J,N1,LAST,NDUP,K1,K2,L + INTEGER NBERR, THRESH, IAO + INTEGER NZOFFA, NDIAGA + REAL RSYM + INTRINSIC nint + ATOAO(1:NA) = 0 + DO I = 1, SIZE_SCHUR + ATOAO(LISTVAR_SCHUR(I)) = -1 + ENDDO + IAO = 0 + DO I= 1, NA + IF (ATOAO(I).LT.0) CYCLE + IAO = IAO +1 + ATOAO(I) = IAO + AOTOA(IAO) = I + ENDDO + MP = ICNTL(2) + MPG= ICNTL(3) + NIORM = 3*N + NDIAGA = 0 + IERROR = 0 + IPE(1:N+1) = 0 + DO K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.NA).OR.(J.GT.NA).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + IERROR = IERROR + 1 + ELSE + I = ATOAO(I) + J = ATOAO(J) + IF ((I.LT.0).OR.(J.LT.0)) CYCLE + IF (I.NE.J) THEN + IPE(I) = IPE(I) + 1 + IPE(J) = IPE(J) + 1 + NIORM = NIORM + 1 + ELSE + NDIAGA = NDIAGA + 1 + ENDIF + ENDIF + ENDDO + NZOFFA = NIORM - 3*N + IF (IERROR.GE.1) THEN + NBERR = 0 + IF (mod(IFLAG,2).EQ.0) IFLAG = IFLAG+1 + IF ((MP.GT.0).AND.(ICNTL(4).GE.2)) THEN + WRITE (MP,99999) + DO 70 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.NA).OR.(J.GT.NA).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + NBERR = NBERR + 1 + IF (NBERR.LE.10) THEN + IF (mod(K,10).GT.3 .OR. mod(K,10).EQ.0 .OR. + & (10.LE.K .AND. K.LE.20)) THEN + WRITE (MP,'(I8,A,I8,A,I8,A)') + & K,'th entry (in row',I,' and column',J,') ignored' + ELSE + IF (mod(K,10).EQ.1) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'st entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.2) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'nd entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.3) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'rd entry (in row',I,' and column',J,') ignored' + ENDIF + ELSE + GO TO 100 + ENDIF + ENDIF + 70 CONTINUE + ENDIF + ENDIF + 100 NRORM = NIORM - 2*N + IQ(1) = 1 + N1 = N - 1 + IF (N1.GT.0) THEN + DO 110 I=1,N1 + IQ(I+1) = IPE(I) + IQ(I) + 110 CONTINUE + ENDIF + LAST = max(IPE(N)+IQ(N)-1,IQ(N)) + FLAG(1:N) = 0 + IPE(1:N) = IQ(1:N) + IW(1:LAST) = 0 + IWFR = LAST + 1 + DO 200 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.NA).OR.(J.GT.NA).OR.(I.LT.1) + & .OR.(J.LT.1)) CYCLE + I = ATOAO(I) + J = ATOAO(J) + IF ((I.LT.0).OR.(J.LT.0)) CYCLE + IF (I.NE.J) THEN + IF (I.LT.J) THEN + IW(IQ(I)) = -J + IQ(I) = IQ(I) + 1 + ELSE + IW(IQ(J)) = -I + IQ(J) = IQ(J) + 1 + ENDIF + ENDIF + 200 CONTINUE + NDUP = 0 + DO 260 I=1,N + K1 = IPE(I) + K2 = IQ(I) -1 + IF (K1.GT.K2) THEN + LEN(I) = 0 + IQ(I) = 0 + ELSE + DO 240 K=K1,K2 + J = -IW(K) + IF (J.LE.0) GO TO 250 + L = IQ(J) + IQ(J) = L + 1 + IF (FLAG(J).EQ.I) THEN + NDUP = NDUP + 1 + IW(L) = 0 + IW(K) = 0 + ELSE + IW(L) = I + IW(K) = J + FLAG(J) = I + ENDIF + 240 CONTINUE + 250 IQ(I) = IQ(I) - IPE(I) + IF (NDUP.EQ.0) LEN(I) = IQ(I) + ENDIF + 260 CONTINUE + IF (NDUP.NE.0) THEN + IWFR = 1 + DO 280 I=1,N + IF (IQ(I).EQ.0) THEN + LEN(I) = 0 + IPE(I) = IWFR + GOTO 280 + ENDIF + K1 = IPE(I) + K2 = K1 + IQ(I) - 1 + L = IWFR + IPE(I) = IWFR + DO 270 K=K1,K2 + IF (IW(K).NE.0) THEN + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + ENDIF + 270 CONTINUE + LEN(I) = IWFR - L + 280 CONTINUE + ENDIF + IPE(N+1) = IPE(N) + LEN(N) + IWFR = IPE(N+1) + IF (SYM.EQ.0) THEN + RSYM = real(NDIAGA+2*NZOFFA - (IWFR-1))/ + & real(NZOFFA+NDIAGA) + symmetry = nint (100.0E0*RSYM) + IF (MPG .GT. 0) + & write(MPG,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + ELSE + symmetry = 100 + ENDIF + AvgDens = nint(real(IWFR-1)/real(N)) + THRESH = AvgDens*50 - AvgDens/10 + 1 + NBQD = 0 + IF (N.GT.2) THEN + IQ(1:N) = 0 + DO I= 1, N + K = max(LEN(I),1) + IQ(K) = IQ(K) + 1 + IF (K.GT.THRESH) NBQD = NBQD+1 + ENDDO + K = 0 + MedDens = 0 + DO WHILE (K .LT. (N/2)) + MedDens = MedDens + 1 + K = K+IQ(MedDens) + ENDDO + ELSE + MedDens = AvgDens + ENDIF + IF (MPG .GT. 0) + & write(MPG,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + RETURN +99999 FORMAT (/'*** Warning message from analysis routine ***') + END SUBROUTINE SMUMPS_623 + SUBROUTINE SMUMPS_549(N,PE,INVPERM,NFILS,WORK) + IMPLICIT NONE + INTEGER N + INTEGER PE(N),INVPERM(N),NFILS(N),WORK(N) + INTEGER I,FATHER,STKLEN,STKPOS,PERMPOS,CURVAR + NFILS = 0 + DO I=1,N + FATHER = -PE(I) + IF(FATHER .NE. 0) NFILS(FATHER) = NFILS(FATHER) + 1 + ENDDO + STKLEN = 0 + PERMPOS = 1 + DO I=1,N + IF(NFILS(I) .EQ. 0) THEN + STKLEN = STKLEN + 1 + WORK(STKLEN) = I + INVPERM(I) = PERMPOS + PERMPOS = PERMPOS + 1 + ENDIF + ENDDO + DO STKPOS = 1,STKLEN + CURVAR = WORK(STKPOS) + FATHER = -PE(CURVAR) + DO + IF(FATHER .EQ. 0) EXIT + IF(NFILS(FATHER) .EQ. 1) THEN + INVPERM(FATHER) = PERMPOS + FATHER = -PE(FATHER) + PERMPOS = PERMPOS + 1 + ELSE + NFILS(FATHER) = NFILS(FATHER) - 1 + EXIT + ENDIF + ENDDO + ENDDO + RETURN + END SUBROUTINE SMUMPS_549 + SUBROUTINE SMUMPS_548(N,PE,NV,WORK) + IMPLICIT NONE + INTEGER N + INTEGER PE(N),NV(N),WORK(N) + INTEGER I,FATHER,LEN,NEWSON,NEWFATHER + DO I=1,N + IF(NV(I) .GT. 0) CYCLE + LEN = 1 + WORK(LEN) = I + FATHER = -PE(I) + DO + IF(NV(FATHER) .GT. 0) THEN + NEWSON = FATHER + EXIT + ENDIF + LEN = LEN + 1 + WORK(LEN) = FATHER + NV(FATHER) = 1 + FATHER = -PE(FATHER) + ENDDO + NEWFATHER = -PE(FATHER) + PE(WORK(LEN)) = -NEWFATHER + PE(NEWSON) = -WORK(1) + ENDDO + END SUBROUTINE SMUMPS_548 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part8.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part8.F new file mode 100644 index 000000000..087bac80a --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_part8.F @@ -0,0 +1,7516 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE SMUMPS_301( id) + USE SMUMPS_STRUC_DEF + USE MUMPS_SOL_ES + USE SMUMPS_COMM_BUFFER + USE SMUMPS_OOC + USE TOOLS_COMMON + IMPLICIT NONE + INTERFACE + SUBROUTINE SMUMPS_710( id, NB_INT,NB_CMPLX ) + USE SMUMPS_STRUC_DEF + TYPE (SMUMPS_STRUC) :: id + INTEGER(8) :: NB_INT,NB_CMPLX + END SUBROUTINE SMUMPS_710 + SUBROUTINE SMUMPS_758 + &(idRHS, idINFO, idN, idNRHS, idLRHS) + REAL, DIMENSION(:), POINTER :: idRHS + INTEGER, intent(in) :: idN, idNRHS, idLRHS + INTEGER, intent(inout) :: idINFO(:) + END SUBROUTINE SMUMPS_758 + END INTERFACE + INCLUDE 'mpif.h' + INCLUDE 'mumps_headers.h' +#if defined(V_T) + INCLUDE 'VT.inc' +#endif + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER MASTER, IERR + PARAMETER( MASTER = 0 ) + TYPE (SMUMPS_STRUC), TARGET :: id + INTEGER MP,LP, MPG + LOGICAL PROK, PROKG + INTEGER MTYPE, ICNTL21 + LOGICAL LSCAL, ERANAL, GIVSOL + INTEGER ICNTL10, ICNTL11 + INTEGER I,K,JPERM, J, II, IZ2 + INTEGER IZ, NZ_THIS_BLOCK + INTEGER LIW + INTEGER(8) :: LA, LA_PASSED + INTEGER LIW_PASSED + INTEGER LWCB_MIN, LWCB, LWCB_SOL_C + INTEGER(8) :: TMP_LWCB8 + INTEGER SMUMPS_LBUF, SMUMPS_LBUF_INT + INTEGER MSG_MAX_BYTES_SOLVE, MSG_MAX_BYTES_GTHRSOL + INTEGER IBEG_ROOT_DEF, IEND_ROOT_DEF, + & IBEG_GLOB_DEF, IEND_GLOB_DEF, + & IROOT_DEF_RHS_COL1 + INTEGER NITREF, NOITER, SOLVET, KASE, JOBIREF + REAL RSOL(1) + LOGICAL INTERLEAVE_PAR, DO_PERMUTE_RHS + INTEGER :: NRHS_NONEMPTY + INTEGER :: STRAT_PERMAM1 + INTEGER :: K220(0:id%NSLAVES) + LOGICAL :: DO_NULL_PIV + INTEGER, DIMENSION(:), POINTER :: IRHS_PTR_COPY + INTEGER, DIMENSION(:), POINTER :: IRHS_SPARSE_COPY + REAL, DIMENSION(:), POINTER :: RHS_SPARSE_COPY + LOGICAL IRHS_SPARSE_COPY_ALLOCATED, IRHS_PTR_COPY_ALLOCATED, + & RHS_SPARSE_COPY_ALLOCATED + INTEGER :: NBCOL, COLSIZE, JBEG_RHS, JEND_RHS, JBEG_NEW, + & NBCOL_INBLOC, IPOS, NBT + INTEGER :: PERM_PIV_LIST(max(id%KEEP(112),1)) + INTEGER :: MAP_PIVNUL_LIST(max(id%KEEP(112),1)) + INTEGER, DIMENSION(:), ALLOCATABLE :: PERM_RHS + REAL ONE + REAL ZERO + PARAMETER( ONE = 1.0E0 ) + PARAMETER( ZERO = 0.0E0 ) + REAL RZERO, RONE + PARAMETER( RZERO = 0.0E0, RONE = 1.0E0 ) + REAL, DIMENSION(:), POINTER :: RHS_MUMPS + REAL, DIMENSION(:), POINTER :: WORK_WCB + REAL, DIMENSION(:), POINTER :: PTR_RHS_ROOT + INTEGER :: LPTR_RHS_ROOT + REAL, ALLOCATABLE :: SAVERHS(:), C_RW1(:), + & C_RW2(:), + & SRW3(:), C_Y(:), + & C_W(:) + REAL, ALLOCATABLE :: CWORK(:) + REAL, ALLOCATABLE :: R_RW1(:), R_Y(:), D(:) + REAL, ALLOCATABLE :: R_W(:) + REAL, ALLOCATABLE, DIMENSION(:) :: R_LOCWK54 + REAL, ALLOCATABLE, DIMENSION(:) :: C_LOCWK54 + INTEGER, DIMENSION(:), ALLOCATABLE :: UNS_PERM_INV, + & POSINRHSCOMP_N + INTEGER LIWK_SOLVE, LIWCB + INTEGER, ALLOCATABLE :: IW1(:), IWK_SOLVE(:), IWCB(:) + INTEGER(8) :: MAXS + REAL, DIMENSION(:), POINTER :: CNTL + INTEGER, DIMENSION (:), POINTER :: KEEP,ICNTL,INFO + INTEGER(8), DIMENSION (:), POINTER :: KEEP8 + INTEGER, DIMENSION (:), POINTER :: IS + REAL, DIMENSION(:),POINTER:: RINFOG + type scaling_data_t + SEQUENCE + REAL, dimension(:), pointer :: SCALING + REAL, dimension(:), pointer :: SCALING_LOC + end type scaling_data_t + type (scaling_data_t) :: scaling_data + REAL, DIMENSION(:), POINTER :: PT_SCALING + REAL, TARGET :: Dummy_SCAL(1) + REAL ARRET + REAL C_DUMMY(1) + REAL R_DUMMY(1) + INTEGER IDUMMY(1), JDUMMY(1), KDUMMY(1), LDUMMY(1), MDUMMY(1) + INTEGER, TARGET :: IDUMMY_TARGET(1) + REAL, TARGET :: CDUMMY_TARGET(1) + INTEGER JJ, WHAT + INTEGER allocok + INTEGER NBRHS, NBRHS_EFF, BEG_RHS, NB_RHSSKIPPED, + & IBEG, LD_RHS, KDEC, + & MASTER_ROOT, MASTER_ROOT_IN_COMM + INTEGER IPT_RHS_ROOT, SIZE_ROOT, LD_REDRHS + INTEGER IBEG_REDRHS, IBEG_RHSCOMP, LD_RHSCOMP, LENRHSCOMP + INTEGER NB_K133, IRANK, TSIZE + INTEGER KMAX_246_247 + LOGICAL WORKSPACE_MINIMAL_PREFERRED, WK_USER_PROVIDED + INTEGER(8) NB_BYTES + INTEGER(8) NB_BYTES_MAX + INTEGER(8) NB_BYTES_EXTRA + INTEGER(8) NB_INT, NB_CMPLX, K34_8, K35_8, NB_BYTES_ON_ENTRY + INTEGER(8) K16_8, ITMP8 +#if defined(V_T) + INTEGER soln_drive_class, glob_comm_ini, perm_scal_ini, soln_dist, + & soln_assem, perm_scal_post +#endif + LOGICAL I_AM_SLAVE, BUILD_POSINRHSCOMP + LOGICAL WORK_WCB_ALLOCATED, IS_INIT_OOC_DONE + LOGICAL STOP_AT_NEXT_EMPTY_COL + INTEGER MTYPE_LOC + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 +#if defined(V_T) + CALL VTCLASSDEF( 'Soln driver',soln_drive_class,IERR) + CALL VTFUNCDEF( 'glob_comm_ini',soln_drive_class, + & glob_comm_ini,IERR) + CALL VTFUNCDEF( 'perm_scal_ini',soln_drive_class, + & perm_scal_ini,IERR) + CALL VTFUNCDEF( 'soln_dist',soln_drive_class,soln_dist,IERR) + CALL VTFUNCDEF( 'soln_assem',soln_drive_class,soln_assem,IERR) + CALL VTFUNCDEF( 'perm_scal_post',soln_drive_class, + & perm_scal_post,IERR) +#endif + IRHS_PTR_COPY => IDUMMY_TARGET + IRHS_PTR_COPY_ALLOCATED = .FALSE. + IRHS_SPARSE_COPY => IDUMMY_TARGET + IRHS_SPARSE_COPY_ALLOCATED=.FALSE. + RHS_SPARSE_COPY => CDUMMY_TARGET + RHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(RHS_MUMPS) + NULLIFY(WORK_WCB) + IS_INIT_OOC_DONE = .FALSE. + WK_USER_PROVIDED = .FALSE. + WORK_WCB_ALLOCATED = .FALSE. + CNTL =>id%CNTL + KEEP =>id%KEEP + KEEP8=>id%KEEP8 + IS =>id%IS + ICNTL=>id%ICNTL + INFO =>id%INFO + RINFOG =>id%RINFOG + MP = ICNTL( 2 ) + MPG = ICNTL( 3 ) + LP = id%ICNTL( 1 ) + PROK = (MP.GT.0) + PROKG = (MPG.GT.0 .and. id%MYID.eq.MASTER) + IF ( PROK ) WRITE(MP,100) + IF ( PROKG ) WRITE(MPG,100) + NB_BYTES = 0_8 + NB_BYTES_MAX = 0_8 + NB_BYTES_EXTRA = 0_8 + K34_8 = int(KEEP(34), 8) + K35_8 = int(KEEP(35), 8) + K16_8 = int(KEEP(16), 8) + NB_RHSSKIPPED = 0 + LSCAL = .FALSE. + WORK_WCB_ALLOCATED = .FALSE. + ICNTL21 = -99998 + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & KEEP(46) .eq. 1 ) ) + CALL SMUMPS_710 (id, NB_INT,NB_CMPLX ) + NB_BYTES = NB_BYTES + NB_INT * K34_8 + NB_CMPLX * K35_8 + NB_BYTES_ON_ENTRY = NB_BYTES + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID .EQ. MASTER) THEN + CALL SMUMPS_807(id) + id%KEEP(111) = id%ICNTL(25) + id%KEEP(248) = id%ICNTL(20) + ICNTL21 = id%ICNTL(21) + IF (ICNTL21 .ne.0.and.ICNTL21.ne.1) ICNTL21=0 + IF ( id%ICNTL(30) .NE.0 ) THEN + id%KEEP(237) = 1 + ELSE + id%KEEP(237) = 0 + ENDIF + IF (id%KEEP(248) .eq.0.and. id%KEEP(237).ne.0) THEN + id%KEEP(248)=1 + ENDIF + IF (id%KEEP(248) .ne.0.and.id%KEEP(248).ne.1) id%KEEP(248)=0 + IF ((id%KEEP(221).EQ.2 ).AND.(id%KEEP(248).NE.0) ) THEN + id%KEEP(248) = 0 + ENDIF + IF ((id%KEEP(221).EQ.2 ).AND.(id%KEEP(235).NE.0) ) THEN + id%KEEP(235) = 0 + ENDIF + IF ( (id%KEEP(248).EQ.0).AND.(id%KEEP(111).EQ.0) ) THEN + id%KEEP(235) = 0 + ENDIF + MTYPE = ICNTL( 9 ) + IF (id%KEEP(237).NE.0) MTYPE = 1 + ENDIF + CALL MPI_BCAST(MTYPE,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST( id%KEEP(111), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( id%KEEP(248), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( ICNTL21, 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%KEEP(235), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( id%KEEP(221), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( id%NRHS,1, MPI_INTEGER, MASTER, id%COMM,IERR) + CALL MPI_BCAST( id%KEEP(237), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + IF ( id%MYID .EQ. MASTER ) THEN + IF (KEEP(201) .EQ. -1) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Solve impossible because factors not kept' + id%INFO(1)=-44 + id%INFO(2)=KEEP(251) + GOTO 333 + ELSE IF (KEEP(221).EQ.0 .AND. KEEP(251) .EQ. 2 + & .AND. KEEP(252).EQ.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Solve impossible because factors not kept' + id%INFO(1)=-44 + id%INFO(2)=KEEP(251) + GOTO 333 + ENDIF + IF (KEEP(252).NE.0 .AND. id%NRHS .NE. id%KEEP(253)) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: id%NRHS not allowed to change when ICNTL(32)=1' + id%INFO(1)=-42 + id%INFO(2)=id%KEEP(253) + GOTO 333 + ENDIF + IF (KEEP(252).NE.0 .AND. ICNTL(9).NE.1) THEN + INFO(1) = -43 + INFO(2) = 9 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Transpose system (ICNTL(9).NE.0) not ', + & ' compatible with forward performed during', + & ' factorization (ICNTL(32)=1)' + GOTO 333 + ENDIF + IF (KEEP(248) .NE. 0.AND.KEEP(252).NE.0) THEN + INFO(1) = -43 + IF (KEEP(237).NE.0) THEN + INFO(2) = 30 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ELSE + INFO(2) = 20 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: sparse RHS incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ENDIF + GOTO 333 + ENDIF + IF (KEEP(237) .NE. 0 .AND. ICNTL21.NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality is incompatible', + & ' with distributed solution.' + INFO(1)=-48 + INFO(2)=21 + GOTO 333 + ENDIF + IF (KEEP(237) .NE. 0 .AND. KEEP(60) .NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality is incompatible', + & ' with Schur.' + INFO(1)=-48 + INFO(2)=19 + GOTO 333 + ENDIF + IF (KEEP(237) .NE. 0 .AND. KEEP(111) .NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality is incompatible', + & ' with null space.' + INFO(1)=-48 + INFO(2)=25 + GOTO 333 + ENDIF + IF (id%NRHS .LE. 0) THEN + id%INFO(1)=-45 + id%INFO(2)=id%NRHS + GOTO 333 + ENDIF + IF ( (id%KEEP(237).EQ.0) ) THEN + IF ((id%KEEP(248) == 0 .AND.KEEP(221).NE.2) + & .OR. ICNTL21==0) THEN + CALL SMUMPS_758 + & (id%RHS,id%INFO,id%N,id%NRHS,id%LRHS) + IF (id%INFO(1) .LT. 0) GOTO 333 + ENDIF + ELSE + IF (id%NRHS .NE. id%N) THEN + id%INFO(1)=-47 + id%INFO(2)=id%NRHS + GOTO 333 + ENDIF + ENDIF + IF (id%KEEP(248) == 1) THEN + IF ((id%NZ_RHS.LE.0).AND.(KEEP(237).NE.0)) THEN + id%INFO(1)=-46 + id%INFO(2)=id%NZ_RHS + GOTO 333 + ENDIF + IF (( id%NZ_RHS .LE.0 ).AND.(KEEP(221).EQ.1)) THEN + id%INFO(1)=-46 + id%INFO(2)=id%NZ_RHS + GOTO 333 + ENDIF + IF ( .not. associated(id%RHS_SPARSE) )THEN + id%INFO(1)=-22 + id%INFO(2)=10 + GOTO 333 + ENDIF + IF ( .not. associated(id%IRHS_SPARSE) )THEN + id%INFO(1)=-22 + id%INFO(2)=11 + GOTO 333 + ENDIF + IF ( .not. associated(id%IRHS_PTR) )THEN + id%INFO(1)=-22 + id%INFO(2)=12 + GOTO 333 + ENDIF + IF (size(id%IRHS_PTR) < id%NRHS + 1) THEN + id%INFO(1)=-22 + id%INFO(2)=12 + GOTO 333 + END IF + IF (id%IRHS_PTR(id%NRHS + 1).ne.id%NZ_RHS+1) THEN + id%INFO(1)=-27 + id%INFO(2)=id%IRHS_PTR(id%NRHS+1) + GOTO 333 + END IF + IF (dble(id%N)*dble(id%NRHS).LT.dble(id%NZ_RHS)) THEN + IF (PROKG) THEN + write(MPG,*)id%MYID, + & " Incompatible values for sparse RHS ", + & " id%NZ_RHS,id%N,id%NRHS =", + & id%NZ_RHS,id%N,id%NRHS + ENDIF + id%INFO(1)=-22 + id%INFO(2)=11 + GOTO 333 + END IF + IF (id%IRHS_PTR(1).ne.1) THEN + id%INFO(1)=-28 + id%INFO(2)=id%IRHS_PTR(1) + GOTO 333 + END IF + IF (size(id%IRHS_SPARSE) < id%NZ_RHS) THEN + id%INFO(1)=-22 + id%INFO(2)=11 + GOTO 333 + END IF + IF (size(id%RHS_SPARSE) < id%NZ_RHS) THEN + id%INFO(1)=-22 + id%INFO(2)=10 + GOTO 333 + END IF + ENDIF + CALL SMUMPS_634(ICNTL(1),KEEP(1),MPG,INFO(1)) + IF (INFO(1) .LT. 0) GOTO 333 + IF (KEEP(111).eq.-1.AND.id%NRHS.NE.KEEP(112)+KEEP(17))THEN + INFO(1)=-32 + INFO(2)=id%NRHS + GOTO 333 + ENDIF + IF (KEEP(111).gt.0 .AND. id%NRHS .NE. 1) THEN + INFO(1)=-32 + INFO(2)=id%NRHS + GOTO 333 + ENDIF + IF (KEEP(111) .NE. 0 .AND. id%KEEP(50) .EQ. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: null space not available for unsymmetric matrices' + INFO(1) = -37 + INFO(2) = 0 + GOTO 333 + ENDIF + IF (KEEP(248) .NE.0.AND.KEEP(111).NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: ICNTL(20) and ICNTL(30) functionalities ', + & ' incompatible with null space' + INFO(1) = -37 + IF (KEEP(237).NE.0) THEN + INFO(2) = 30 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: ICNTL(30) functionality ', + & ' incompatible with null space' + ELSE + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: ICNTL(20) functionality ', + & ' incompatible with null space' + INFO(2) = 20 + ENDIF + GOTO 333 + ENDIF + IF (( KEEP(111) .LT. -1 ) .OR. + & (KEEP(111).GT.KEEP(112)+KEEP(17)) .OR. + & (KEEP(111) .EQ.-1 .AND. KEEP(112)+KEEP(17).EQ.0)) + & THEN + INFO(1)=-36 + INFO(2)=KEEP(111) + GOTO 333 + ENDIF + END IF + IF (ICNTL21==1) THEN + IF ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & id%KEEP(46) .eq. 1 ) ) THEN + IF ( id%LSOL_loc < id%KEEP(89) ) THEN + id%INFO(1)= -29 + id%INFO(2)= id%LSOL_loc + GOTO 333 + ENDIF + IF (id%KEEP(89) .NE. 0) THEN + IF ( .not. associated(id%ISOL_loc) )THEN + id%INFO(1)=-22 + id%INFO(2)=13 + GOTO 333 + ENDIF + IF ( .not. associated(id%SOL_loc) )THEN + id%INFO(1)=-22 + id%INFO(2)=14 + GOTO 333 + ENDIF + IF (size(id%ISOL_loc) < id%KEEP(89) ) THEN + id%INFO(1)=-22 + id%INFO(2)=13 + GOTO 333 + END IF + IF (size(id%SOL_loc) < + & (id%NRHS-1)*id%LSOL_loc+id%KEEP(89)) THEN + id%INFO(1)=-22 + id%INFO(2)=14 + GOTO 333 + END IF + ENDIF + ENDIF + ENDIF + IF (id%MYID .NE. MASTER) THEN + IF (id%KEEP(248) == 1) THEN + IF ( associated( id%RHS ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 7 + GOTO 333 + END IF + IF ( associated( id%RHS_SPARSE ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 10 + GOTO 333 + END IF + IF ( associated( id%IRHS_SPARSE ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 11 + GOTO 333 + END IF + IF ( associated( id%IRHS_PTR ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 12 + GOTO 333 + END IF + END IF + ENDIF + IF (id%MYID.EQ.MASTER) THEN + CALL SMUMPS_769(id) + END IF + IF (id%INFO(1) .LT. 0) GOTO 333 + 333 CONTINUE + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) GO TO 90 + IF ((id%KEEP(248).EQ.1).AND.(id%KEEP(237).EQ.0)) THEN + CALL MPI_BCAST(id%NZ_RHS,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + IF (id%NZ_RHS.EQ.0) THEN + IF ((ICNTL21.EQ.1).AND.(I_AM_SLAVE)) THEN + LIW_PASSED=max(1,KEEP(32)) + IF (KEEP(89) .GT. 0) THEN + CALL SMUMPS_535( MTYPE, id%ISOL_loc(1), + & id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%IS(1), LIW_PASSED,id%MYID_NODES, + & id%N, id%STEP(1), id%PROCNODE_STEPS(1), + & id%NSLAVES, scaling_data, LSCAL ) + DO J=1, id%NRHS + DO I=1, KEEP(89) + id%SOL_loc((J-1)*id%LSOL_loc + I) =ZERO + ENDDO + ENDDO + ENDIF + ENDIF + IF (ICNTL21.NE.1) THEN + IF (id%MYID.EQ.MASTER) THEN + DO J=1, id%NRHS + DO I=1, id%N + id%RHS((J-1)*id%LRHS + I) =ZERO + ENDDO + ENDDO + ENDIF + ENDIF + IF ( PROKG ) THEN + WRITE( MPG, 150 ) + & id%NRHS, ICNTL(27), ICNTL(9), ICNTL(10), ICNTL(11), + & ICNTL(20), ICNTL(21), ICNTL(30) + IF (KEEP(221).NE.0) THEN + WRITE (MPG, 152) KEEP(221) + ENDIF + IF (KEEP(252).GT.0) THEN + WRITE (MPG, 153) KEEP(252) + ENDIF + ENDIF + GOTO 90 + ENDIF + ENDIF + IF (id%MYID.EQ.MASTER) THEN + IF ((KEEP(111).NE.0)) THEN + KEEP(242) = 0 + ENDIF + ENDIF + INTERLEAVE_PAR =.FALSE. + DO_PERMUTE_RHS =.FALSE. + IF ((id%KEEP(235).NE.0).or.(id%KEEP(237).NE.0)) THEN + IF (id%KEEP(237).NE.0.AND. + & id%KEEP(248).EQ.0) THEN + IF (LP.GT.0) THEN + WRITE(LP,'(A,I4,I4)') + & ' Internal Error in solution driver (A-1) ', + & id%KEEP(237), id%KEEP(248) + ENDIF + CALL MUMPS_ABORT() + ENDIF + NBT = 0 + CALL MUMPS_733(id%Step2node, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%Step2node (Solve)', MEMCNT=NBT, ERRCODE=-13) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF (NBT.NE.0) THEN + DO I=1, id%N + IF (id%STEP(I).LE.0) CYCLE + id%Step2node(id%STEP(I)) = I + ENDDO + ENDIF + NB_BYTES = NB_BYTES + int(NBT,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + NB_BYTES_EXTRA = NB_BYTES_EXTRA + int(NBT,8) * K34_8 + ENDIF + IF ( I_AM_SLAVE ) + & CALL MUMPS_804(id%OOC_SIZE_OF_BLOCK, id%KEEP(201)) + DO_NULL_PIV = .TRUE. + NBCOL_INBLOC = -9998 + NZ_THIS_BLOCK= -9998 + JBEG_RHS = -9998 + IF (id%MYID.EQ.MASTER) THEN + IF( KEEP(111)==0 .AND. KEEP(248)==1 ) THEN + NRHS_NONEMPTY = 0 + DO I=1, id%NRHS + IF (id%IRHS_PTR(I).LT.id%IRHS_PTR(I+1)) + & NRHS_NONEMPTY = NRHS_NONEMPTY+1 + ENDDO + IF (NRHS_NONEMPTY.LE.0) THEN + IF (LP.GT.0) + & WRITE(LP,*) 'Internal error : NRHS_NONEMPTY=', + & NRHS_NONEMPTY + CALL MUMPS_ABORT() + ENDIF + ELSE + NRHS_NONEMPTY = id%NRHS + ENDIF + ENDIF + BUILD_POSINRHSCOMP = .TRUE. + IF (KEEP(221).EQ.2 .AND. KEEP(252).EQ.0) THEN + BUILD_POSINRHSCOMP = .FALSE. + ENDIF + SIZE_ROOT = -33333 + IF ( KEEP( 38 ) .ne. 0 ) THEN + MASTER_ROOT = MUMPS_275( + & id%PROCNODE_STEPS(id%STEP( KEEP(38))), + & id%NSLAVES ) + IF (id%MYID_NODES .eq. MASTER_ROOT) THEN + SIZE_ROOT = id%root%TOT_ROOT_SIZE + ELSE IF ((id%MYID.EQ.MASTER).AND.KEEP(60).NE.0) THEN + SIZE_ROOT=id%KEEP(116) + ENDIF + ELSE IF (KEEP( 20 ) .ne. 0 ) THEN + MASTER_ROOT = MUMPS_275( + & id%PROCNODE_STEPS(id%STEP(KEEP(20))), + & id%NSLAVES ) + IF (id%MYID_NODES .eq. MASTER_ROOT) THEN + SIZE_ROOT = id%IS( + & id%PTLUST_S(id%STEP(KEEP(20)))+KEEP(IXSZ) + 3) + ELSE IF ((id%MYID.EQ.MASTER).AND.KEEP(60).NE.0) THEN + SIZE_ROOT=id%KEEP(116) + ENDIF + ELSE + MASTER_ROOT = -44444 + END IF + IF (id%MYID .eq. MASTER) THEN + KEEP(84) = ICNTL(27) + IF (KEEP(252).NE.0) THEN + NBRHS = KEEP(253) + ELSE + IF (KEEP(201) .EQ. 0 .OR. KEEP(84) .GT. 0) THEN + NBRHS = abs(KEEP(84)) + ELSE + NBRHS = -2*KEEP(84) + END IF + IF (NBRHS .GT. NRHS_NONEMPTY ) NBRHS = NRHS_NONEMPTY + ENDIF + ENDIF +#if defined(V_T) + CALL VTBEGIN(glob_comm_ini,IERR) +#endif + CALL MPI_BCAST(NRHS_NONEMPTY,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(NBRHS,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + IF (KEEP(201).GT.0) THEN + IF (I_AM_SLAVE) THEN + IF (KEEP(201).EQ.1 + & .AND.KEEP(50).EQ.0 + & .AND.KEEP(251).NE.2 + & ) THEN + OOC_NB_FILE_TYPE=2 + ELSE + OOC_NB_FILE_TYPE=1 + ENDIF + ENDIF + WORKSPACE_MINIMAL_PREFERRED = .FALSE. + IF (id%MYID .eq. MASTER) THEN + KEEP(107) = max(0,KEEP(107)) + IF ((KEEP(107).EQ.0).AND. + & (KEEP(204).EQ.0).AND.(KEEP(211).NE.1) ) THEN + WORKSPACE_MINIMAL_PREFERRED=.TRUE. + ENDIF + ENDIF + CALL MPI_BCAST( KEEP(107), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(204), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(208), 2, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( WORKSPACE_MINIMAL_PREFERRED, 1, + & MPI_LOGICAL, + & MASTER, id%COMM, IERR ) + ENDIF + IF ( I_AM_SLAVE ) THEN + NB_K133 = 3 + IF ( KEEP( 38 ) .NE. 0 .OR. KEEP( 20 ) .NE. 0 ) THEN + IF ( MASTER_ROOT .eq. id%MYID_NODES ) THEN + IF ( + & .NOT. associated(id%root%RHS_CNTR_MASTER_ROOT) + & ) THEN + NB_K133 = NB_K133 + 1 + ENDIF + END IF + ENDIF + LWCB_MIN = NB_K133*KEEP(133)*NBRHS + WK_USER_PROVIDED = (id%LWK_USER.NE.0) + IF (id%LWK_USER.EQ.0) THEN + ITMP8 = 0_8 + ELSE IF (id%LWK_USER.GT.0) THEN + ITMP8= int(id%LWK_USER,8) + ELSE + ITMP8 = -int(id%LWK_USER,8)* 1000000_8 + ENDIF + IF (KEEP(201).EQ.0) THEN + IF (ITMP8.NE.KEEP8(24)) THEN + INFO(1) = -41 + INFO(2) = id%LWK_USER + GOTO 99 + ENDIF + ELSE + KEEP8(24)=ITMP8 + ENDIF + MAXS = 0_8 + IF (WK_USER_PROVIDED) THEN + MAXS = KEEP8(24) + IF (MAXS.LT. KEEP8(20)) THEN + INFO(1)= -11 + ITMP8 = KEEP8(20)+1_8-MAXS + CALL MUMPS_731(ITMP8, INFO(2)) + ENDIF + IF (INFO(1) .GE. 0 ) id%S => id%WK_USER(1:KEEP8(24)) + ELSE IF (associated(id%S)) THEN + MAXS = KEEP8(23) + ELSE + IF (KEEP(201).EQ.0) THEN + WRITE(*,*) ' Working array S not allocated ', + & ' on entry to solve phase (in core) ' + CALL MUMPS_ABORT() + ELSE + IF ( KEEP(209).EQ.-1 .AND. WORKSPACE_MINIMAL_PREFERRED) + & THEN + MAXS = KEEP8(20) + 1_8 + ELSE IF ( KEEP(209) .GE.0 ) THEN + MAXS = max(int(KEEP(209),8), KEEP8(20) + 1_8) + ELSE + MAXS = id%KEEP8(14) + ENDIF + ALLOCATE (id%S(MAXS), stat = allocok) + KEEP8(23)=MAXS + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) ' Problem allocation of S at solve' + INFO(1) = -13 + CALL MUMPS_731(MAXS, INFO(2)) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + NB_BYTES = NB_BYTES + KEEP8(23) * K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + ENDIF + IF(KEEP(201).EQ.0)THEN + LA = KEEP8(31) + ELSE + LA = MAXS + IF(MAXS.GT.KEEP8(31)+KEEP8(20)*int(KEEP(107)+1,8))THEN + LA=KEEP8(31)+KEEP8(20)*int(KEEP(107)+1,8) + ENDIF + ENDIF + IF ( MAXS-LA .GT. int(LWCB_MIN,8) ) THEN + TMP_LWCB8 = min( MAXS - LA, int(huge(LWCB),8) ) + LWCB = int( TMP_LWCB8, kind(LWCB) ) + WORK_WCB => id%S(LA+1_8:LA+TMP_LWCB8) + WORK_WCB_ALLOCATED=.FALSE. + ELSE + LWCB = LWCB_MIN + ALLOCATE(WORK_WCB(LWCB_MIN), stat = allocok) + IF (allocok < 0 ) THEN + INFO(1)=-13 + INFO(2)=LWCB_MIN + ENDIF + WORK_WCB_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(size(WORK_WCB),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + ENDIF + 99 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) < 0) GOTO 90 + IF ( I_AM_SLAVE ) THEN + IF (KEEP(201).GT.0) THEN + CALL SMUMPS_590(LA) + CALL SMUMPS_586(id) + IS_INIT_OOC_DONE = .TRUE. + ENDIF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) < 0) GOTO 90 + IF (id%MYID .eq. MASTER) THEN + IF ( (KEEP(242).NE.0) .or. (KEEP(243).NE.0) ) THEN + IF ( (KEEP(237) .EQ.0) .and. (KEEP(111).EQ.0) ) THEN + KEEP(242) = 0 + KEEP(243) = 0 + ENDIF + ENDIF + IF ( PROKG ) THEN + WRITE( MPG, 150 ) + & id%NRHS, NBRHS, ICNTL(9), ICNTL(10), ICNTL(11), + & ICNTL(20), ICNTL(21), ICNTL(30) + IF (KEEP(111).NE.0) THEN + WRITE (MPG, 151) KEEP(111) + ENDIF + IF (KEEP(221).NE.0) THEN + WRITE (MPG, 152) KEEP(221) + ENDIF + IF (KEEP(252).GT.0) THEN + WRITE (MPG, 153) KEEP(252) + ENDIF + ENDIF + LSCAL = (((KEEP(52) .GT. 0) .AND. (KEEP(52) .LE. 8)) .OR. ( + & KEEP(52) .EQ. -1) .OR. KEEP(52) .EQ. -2) + ERANAL = ((ICNTL(11) .GT. 0) .OR. (ICNTL(10) .GT. 0)) + IF ( (KEEP(55).eq.0) .AND. KEEP(54).eq.0 .AND. + & .NOT.associated(id%A) ) THEN + ICNTL10 = 0 + ICNTL11 = 0 + ERANAL = .FALSE. + ELSE + ICNTL10 = ICNTL(10) + ICNTL11 = ICNTL(11) + ENDIF + IF ((KEEP(111).NE.0).OR.(KEEP(237).NE.0).OR. + & (KEEP(252).NE.0) ) THEN + IF (ICNTL10 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(10) treated as if set to 0 ' + ENDIF + IF (ICNTL11 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(11) treated as if set to 0 ' + ENDIF + ICNTL10 = 0 + ICNTL11 = 0 + ERANAL = .FALSE. + END IF + IF (KEEP(221).NE.0) THEN + IF (ICNTL10 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(10) treated as if set to 0 (reduced RHS))' + ENDIF + IF (ICNTL11 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(11) treated as if set to 0 (reduced RHS)' + ENDIF + ICNTL10 = 0 + ICNTL11 = 0 + ERANAL = .FALSE. + END IF + IF ((ERANAL .AND. NBRHS > 1) .OR. ICNTL(21) > 0) THEN + IF (ICNTL11 > 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(11) treated as if set to zero' + ICNTL11=0 + ENDIF + IF (ICNTL10 > 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(10) treated as if set to zero' + ICNTL10=0 + ENDIF + ERANAL = .FALSE. + ENDIF + IF (ERANAL) THEN + ALLOCATE(SAVERHS(id%N*NBRHS),stat = allocok) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) ' Problem in solve: error allocating SAVERHS' + INFO(1) = -13 + INFO(2) = id%N*NBRHS + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(size(SAVERHS),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + IF (KEEP(237).NE.0 .AND.KEEP(111).NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: KEEP(237) treated as if set to 0 (null space)' + KEEP(237)=0 + ENDIF + IF (KEEP(242).EQ.0) KEEP(243)=0 + END IF + CALL MPI_BCAST(ICNTL10,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(ICNTL11,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(ICNTL21,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(ERANAL,1,MPI_LOGICAL,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(LSCAL,1,MPI_LOGICAL,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(KEEP(111),1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(KEEP(242),1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(KEEP(243),1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + DO_PERMUTE_RHS = (KEEP(242).NE.0) + IF ( KEEP(242).NE.0) THEN + IF ((KEEP(237).EQ.0).AND.(KEEP(111).EQ.0)) THEN + IF (MP.GT.0) THEN + write(MP,*) ' Warning incompatible options ', + & ' permute RHS reset to false ' + ENDIF + DO_PERMUTE_RHS = .FALSE. + ENDIF + ENDIF + IF ( (id%NSLAVES.GT.1) .AND. (KEEP(243).NE.0) + & ) THEN + IF ((KEEP(237).NE.0).or.(KEEP(111).GT.0)) THEN + INTERLEAVE_PAR= .TRUE. + ELSE + IF (PROKG) THEN + write(MPG,*) ' Warning incompatible options ', + & ' interleave RHS reset to false ' + ENDIF + ENDIF + ENDIF +#if defined(check) + IF ( id%MYID_NODES .EQ. MASTER ) THEN + WRITE(*,*) " ES A-1 DO_Perm Interleave =" + WRITE(*,144) id%KEEP(235), id%KEEP(237), + & id%KEEP(242),id%KEEP(243) + ENDIF +#endif + MSG_MAX_BYTES_SOLVE = ( 4 + KEEP(133) ) * KEEP(34) + + & KEEP(133) * NBRHS * KEEP(35) + & + 16 * KEEP(34) + IF (KEEP(237).EQ.0) THEN + KMAX_246_247 = max(KEEP(246),KEEP(247)) + MSG_MAX_BYTES_GTHRSOL = ( ( 2 + KMAX_246_247 ) * KEEP(34) + + & KMAX_246_247 * NBRHS * KEEP(35) ) + ELSE + MSG_MAX_BYTES_GTHRSOL = ( 3 * KEEP(34) + KEEP(35) ) + ENDIF + id%LBUFR_BYTES = max(MSG_MAX_BYTES_SOLVE, MSG_MAX_BYTES_GTHRSOL) + TSIZE = int(min(100_8*int(MSG_MAX_BYTES_GTHRSOL,8), + & 10000000_8)) + id%LBUFR_BYTES = max(id%LBUFR_BYTES,TSIZE) + id%LBUFR = ( id%LBUFR_BYTES + KEEP(34) - 1 ) / KEEP(34) + IF ( associated (id%BUFR) ) THEN + NB_BYTES = NB_BYTES - int(size(id%BUFR),8)*K34_8 + DEALLOCATE(id%BUFR) + NULLIFY(id%BUFR) + ENDIF + ALLOCATE (id%BUFR(id%LBUFR),stat=allocok) + IF ( allocok .GT. 0 ) THEN + IF (LP.GT.0) + & WRITE(LP,*) id%MYID, + & ' Problem in solve: error allocating BUFR' + INFO(1) = -13 + INFO(2) = id%LBUFR + GOTO 111 + ENDIF + NB_BYTES = NB_BYTES + int(size(id%BUFR),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( I_AM_SLAVE ) THEN + SMUMPS_LBUF_INT = ( 20 + id%NSLAVES * id%NSLAVES * 4 ) + & * KEEP(34) + CALL SMUMPS_55( SMUMPS_LBUF_INT, IERR ) + IF ( IERR .NE. 0 ) THEN + INFO(1) = -13 + INFO(2) = SMUMPS_LBUF_INT + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) id%MYID, + & ':Error allocating small Send buffer:IERR=',IERR + END IF + GOTO 111 + END IF + SMUMPS_LBUF = (MSG_MAX_BYTES_SOLVE + 2*KEEP(34) )*id%NSLAVES + SMUMPS_LBUF = min(SMUMPS_LBUF, 100 000 000) + SMUMPS_LBUF = max(SMUMPS_LBUF, + & (MSG_MAX_BYTES_SOLVE+2*KEEP(34)) * min(id%NSLAVES,3)) + SMUMPS_LBUF = SMUMPS_LBUF + KEEP(34) + CALL SMUMPS_53( SMUMPS_LBUF, IERR ) + IF ( IERR .NE. 0 ) THEN + INFO(1) = -13 + INFO(2) = SMUMPS_LBUF/KEEP(34) + 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) id%MYID, + & ':Error allocating Send buffer:IERR=', IERR + END IF + GOTO 111 + END IF + ENDIF + IF ( + & ( id%MYID .NE. MASTER ) + & .or. + & ( I_AM_SLAVE .AND. id%MYID .EQ. MASTER .AND. + & ICNTL21 .NE.0 .AND. + & ( KEEP(248).ne.0 .OR. KEEP(221).EQ.2 + & .OR. KEEP(111).NE.0 ) + & ) + & .or. + & ( id%MYID .EQ. MASTER .AND. (KEEP(237).NE.0) ) + & ) THEN + ALLOCATE(RHS_MUMPS(id%N*NBRHS),stat=IERR) + NB_BYTES = NB_BYTES + int(size(RHS_MUMPS),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N*NBRHS + IF (LP > 0) + & WRITE(LP,*) 'ERROR while allocating RHS on a slave' + GOTO 111 + END IF + ELSE + RHS_MUMPS=>id%RHS + ENDIF + IF ( I_AM_SLAVE ) THEN + LD_RHSCOMP = max(KEEP(89),1) + IF (id%MYID.EQ.MASTER) THEN + LD_RHSCOMP = max(LD_RHSCOMP, KEEP(247)) + ENDIF + IF (KEEP(221).EQ.2 .AND. KEEP(252).EQ.0) THEN + IF (.NOT.associated(id%RHSCOMP)) THEN + INFO(1) = -35 + INFO(2) = 1 + GOTO 111 + ENDIF + IF (.NOT.associated(id%POSINRHSCOMP)) THEN + INFO(1) = -35 + INFO(2) = 2 + GOTO 111 + ENDIF + LENRHSCOMP = size(id%RHSCOMP) + LD_RHSCOMP = LENRHSCOMP/id%NRHS + ELSE IF (KEEP(221).EQ.1) THEN + IF (associated(id%RHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8 + DEALLOCATE(id%RHSCOMP) + ENDIF + LENRHSCOMP = LD_RHSCOMP*id%NRHS + ALLOCATE (id%RHSCOMP(LENRHSCOMP)) + NB_BYTES = NB_BYTES + int(size(id%RHSCOMP),8)*K35_8 + IF (associated(id%POSINRHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%POSINRHSCOMP),8)*K34_8 + DEALLOCATE(id%POSINRHSCOMP) + ENDIF + ALLOCATE (id%POSINRHSCOMP(KEEP(28)) ) + NB_BYTES = NB_BYTES + int(size(id%POSINRHSCOMP),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ELSE + LENRHSCOMP = LD_RHSCOMP*NBRHS + IF (associated(id%RHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8 + DEALLOCATE(id%RHSCOMP) + NULLIFY(id%RHSCOMP) + ENDIF + ALLOCATE (id%RHSCOMP(LENRHSCOMP)) + NB_BYTES = NB_BYTES + int(size(id%RHSCOMP),8)*K35_8 + IF (associated(id%POSINRHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%POSINRHSCOMP),8)*K34_8 + DEALLOCATE(id%POSINRHSCOMP) + ENDIF + ALLOCATE (id%POSINRHSCOMP(KEEP(28)) ) + NB_BYTES = NB_BYTES + int(size(id%POSINRHSCOMP),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + LIWK_SOLVE = 4 * KEEP(28) + 1 + IF (KEEP(201).EQ.1) THEN + LIWK_SOLVE = LIWK_SOLVE + KEEP(228) + 1 + ELSE + LIWK_SOLVE = LIWK_SOLVE + 1 + ENDIF + ALLOCATE ( IWK_SOLVE( LIWK_SOLVE), stat = allocok ) + IF (allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=LIWK_SOLVE + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(LIWK_SOLVE,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + LIWCB = 20*NB_K133*2 + KEEP(133) + ALLOCATE ( IWCB( LIWCB), stat = allocok ) + IF (allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=LIWCB + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(LIWCB,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + LIW = KEEP(32) + ALLOCATE(SRW3(KEEP(133)), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=KEEP(133) + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(size(SRW3),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( (KEEP(111).NE.0) .OR. (KEEP(248).NE.0) ) THEN + ALLOCATE(POSINRHSCOMP_N(id%N), stat=allocok) + IF ( allocok .GT. 0 ) THEN + IF (LP.GT.0) WRITE(LP,*) + & ' ERROR in SMUMPS_301: allocating POSINRHSCOMP_N' + INFO(1) = -13 + INFO(2) = id%N + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(size(POSINRHSCOMP_N),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + END IF + ELSE + LIW=0 + END IF + IF (allocated(UNS_PERM_INV)) DEALLOCATE(UNS_PERM_INV) + IF ( ( id%MYID .eq. MASTER.AND.(KEEP(23).GT.0) .AND. + & (MTYPE .NE. 1).AND.(KEEP(248).NE.0) + & ) + & .OR. ( ( KEEP(237).NE.0 ) .AND. (KEEP(23).NE.0) ) + & ) THEN + ALLOCATE(UNS_PERM_INV(id%N),stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 111 + endif + NB_BYTES = NB_BYTES + int(id%N,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID.EQ.MASTER) THEN + DO I = 1, id%N + UNS_PERM_INV(id%UNS_PERM(I))=I + ENDDO + ENDIF + ELSE + ALLOCATE(UNS_PERM_INV(1), stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=1 + GOTO 111 + endif + NB_BYTES = NB_BYTES + 1_8*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + 111 CONTINUE +#if defined(V_T) + CALL VTEND(glob_comm_ini,IERR) +#endif + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF ( ( KEEP(237).NE.0 ) .AND. (KEEP(23).NE.0) ) THEN + CALL MPI_BCAST(UNS_PERM_INV,id%N,MPI_INTEGER,MASTER, + & id%COMM,IERR) + ENDIF + IF ( ICNTL21==1 ) THEN + IF (LSCAL) THEN + IF (id%MYID.NE.MASTER) THEN + IF (MTYPE == 1) THEN + ALLOCATE(id%COLSCA(id%N),stat=allocok) + ELSE + ALLOCATE(id%ROWSCA(id%N),stat=allocok) + ENDIF + IF (allocok > 0) THEN + IF (LP > 0) THEN + WRITE(LP,*) 'Error allocating temporary scaling array' + ENDIF + INFO(1)=-13 + INFO(2)=id%N + GOTO 40 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + IF (MTYPE == 1) THEN + CALL MPI_BCAST(id%COLSCA(1),id%N, + & MPI_REAL,MASTER, + & id%COMM,IERR) + scaling_data%SCALING=>id%COLSCA + ELSE + CALL MPI_BCAST(id%ROWSCA(1),id%N, + & MPI_REAL,MASTER, + & id%COMM,IERR) + scaling_data%SCALING=>id%ROWSCA + ENDIF + IF (I_AM_SLAVE) THEN + ALLOCATE(scaling_data%SCALING_LOC(id%KEEP(89)), + & stat=allocok) + IF (allocok > 0) THEN + IF (LP > 0) THEN + WRITE(LP,*) 'Error allocating local scaling array' + ENDIF + INFO(1)=-13 + INFO(2)=id%KEEP(89) + GOTO 40 + ENDIF + NB_BYTES = NB_BYTES + int(id%KEEP(89),8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + LIW_PASSED=max(1,LIW) + IF (KEEP(89) .GT. 0) THEN + CALL SMUMPS_535( MTYPE, id%ISOL_loc(1), + & id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%IS(1), LIW_PASSED,id%MYID_NODES, + & id%N, id%STEP(1), id%PROCNODE_STEPS(1), + & id%NSLAVES, scaling_data, LSCAL ) + ENDIF + IF (id%MYID.NE.MASTER .AND. LSCAL) THEN + IF (MTYPE == 1) THEN + DEALLOCATE(id%COLSCA) + NULLIFY(id%COLSCA) + ELSE + DEALLOCATE(id%ROWSCA) + NULLIFY(id%ROWSCA) + ENDIF + NB_BYTES = NB_BYTES - int(id%N,8)*K16_8 + ENDIF + ENDIF + IF (KEEP(23) .NE. 0 .AND. MTYPE==1) THEN + IF (id%MYID.NE.MASTER) THEN + ALLOCATE(id%UNS_PERM(id%N),stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 40 + ENDIF + ENDIF + ENDIF + 40 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF (KEEP(23) .NE. 0 .AND. MTYPE==1) THEN + CALL MPI_BCAST(id%UNS_PERM(1),id%N,MPI_INTEGER,MASTER, + & id%COMM,IERR) + IF (I_AM_SLAVE) THEN + DO I=1, KEEP(89) + id%ISOL_loc(I) = id%UNS_PERM(id%ISOL_loc(I)) + ENDDO + ENDIF + IF (id%MYID.NE.MASTER) THEN + DEALLOCATE(id%UNS_PERM) + NULLIFY(id%UNS_PERM) + ENDIF + ENDIF + ENDIF + IF ( ( KEEP(221) .EQ. 1 ) .OR. + & ( KEEP(221) .EQ. 2 ) + & ) THEN + IF (KEEP(46).EQ.1) THEN + MASTER_ROOT_IN_COMM=MASTER_ROOT + ELSE + MASTER_ROOT_IN_COMM =MASTER_ROOT+1 + ENDIF + IF ( id%MYID .EQ. MASTER ) THEN + IF (id%NRHS.EQ.1) THEN + LD_REDRHS = id%KEEP(116) + ELSE + LD_REDRHS = id%LREDRHS + ENDIF + ENDIF + IF (MASTER.NE.MASTER_ROOT_IN_COMM) THEN + IF ( id%MYID .EQ. MASTER ) THEN + CALL MPI_SEND(LD_REDRHS,1,MPI_INTEGER, + & MASTER_ROOT_IN_COMM, 0, id%COMM,IERR) + ELSEIF ( id%MYID.EQ.MASTER_ROOT_IN_COMM) THEN + CALL MPI_RECV(LD_REDRHS,1,MPI_INTEGER, + & MASTER, 0, id%COMM,STATUS,IERR) + ENDIF + ENDIF + ENDIF + IF ( KEEP(248)==1 ) THEN + JEND_RHS = 0 + IF (DO_PERMUTE_RHS) THEN + ALLOCATE(PERM_RHS(id%NRHS),stat=allocok) + IF (allocok > 0) THEN + INFO(1) = -13 + INFO(2) = id%NRHS + GOTO 109 + ENDIF + NB_BYTES = NB_BYTES + int(id%NRHS,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID.EQ.MASTER) THEN + STRAT_PERMAM1 = KEEP(242) + CALL MUMPS_780 + & (STRAT_PERMAM1, id%SYM_PERM(1), + & id%IRHS_PTR(1), id%NRHS+1, + & PERM_RHS, id%NRHS, + & IERR + & ) + ENDIF + ENDIF + ENDIF +109 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF (id%NSLAVES .EQ. 1) THEN + IF (DO_PERMUTE_RHS .AND. KEEP(111).NE.0 ) THEN + WRITE(*,*) id%MYID, ':INTERNAL ERROR 1 : ', + & ' PERMUTE RHS during null space computation ', + & ' not available yet ' + CALL MUMPS_ABORT() + ENDIF + ELSE + IF (DO_PERMUTE_RHS .AND. KEEP(111).NE.0 ) THEN + WRITE(*,*) id%MYID, ':INTERNAL ERROR 2 : ', + & ' PERMUTE RHS during null space computation ', + & ' not available yet ' + CALL MUMPS_ABORT() + ENDIF + IF (INTERLEAVE_PAR) THEN + IF ( KEEP(111).NE.0 ) THEN + WRITE(*,*) id%MYID, ':INTERNAL ERROR 3 : ', + & ' INTERLEAVE RHS during null space computation ', + & ' not available yet ' + CALL MUMPS_ABORT() + ELSE + IF (id%MYID.EQ.MASTER) THEN + CALL MUMPS_772 + & (PERM_RHS, id%NRHS, id%N, id%KEEP(28), + & id%PROCNODE_STEPS(1), id%STEP(1), id%NSLAVES, + & id%Step2node(1), + & IERR) + ENDIF + ENDIF + ENDIF + ENDIF + IF (DO_PERMUTE_RHS.AND.(KEEP(111).EQ.0)) THEN + CALL MPI_BCAST(PERM_RHS(1), + & id%NRHS, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + ENDIF + BEG_RHS=1 + DO WHILE (BEG_RHS.LE.NRHS_NONEMPTY) + NBRHS_EFF = min(NRHS_NONEMPTY-BEG_RHS+1, NBRHS) + IF (IRHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_SPARSE_COPY),8)*K34_8 + DEALLOCATE(IRHS_SPARSE_COPY) + IRHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_SPARSE_COPY) + ENDIF + IF (IRHS_PTR_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_PTR_COPY),8)*K34_8 + DEALLOCATE(IRHS_PTR_COPY) + IRHS_PTR_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_PTR_COPY) + ENDIF + IF (RHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(RHS_SPARSE_COPY),8)*K35_8 + DEALLOCATE(RHS_SPARSE_COPY) + RHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(RHS_SPARSE_COPY) + ENDIF + IF ( + & ( id%MYID .NE. MASTER ) + & .or. + & ( I_AM_SLAVE .AND. id%MYID .EQ. MASTER .AND. + & ICNTL21 .NE.0 .AND. + & ( KEEP(248).ne.0 .OR. KEEP(221).EQ.2 + & .OR. KEEP(111).NE.0 ) + & ) + & .or. + & ( id%MYID .EQ. MASTER .AND. (KEEP(237).NE.0) ) + & ) THEN + LD_RHS = id%N + IBEG = 1 + ELSE + IF ( associated(id%RHS) ) THEN + LD_RHS = max(id%LRHS, id%N) + ELSE + LD_RHS = id%N + ENDIF + IBEG = (BEG_RHS-1) * LD_RHS + 1 + ENDIF + JBEG_RHS = BEG_RHS + IF ( (id%MYID.EQ.MASTER) .AND. + & KEEP(248)==1 ) THEN + JBEG_RHS = JEND_RHS + 1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + DO WHILE ( id%IRHS_PTR(PERM_RHS(JBEG_RHS)) .EQ. + & id%IRHS_PTR(PERM_RHS(JBEG_RHS)+1) ) + IF ((KEEP(237).EQ.0).AND.(ICNTL21.EQ.0).AND. + & (KEEP(221).NE.1) ) THEN + DO I=1, id%N + RHS_MUMPS((PERM_RHS(JBEG_RHS) -1)*LD_RHS+I) + & = ZERO + ENDDO + ENDIF + JBEG_RHS = JBEG_RHS +1 + CYCLE + ENDDO + ELSE + DO WHILE( id%IRHS_PTR(JBEG_RHS) .EQ. + & id%IRHS_PTR(JBEG_RHS+1) ) + IF ((KEEP(237).EQ.0).AND.(ICNTL21.EQ.0).AND. + & (KEEP(221).NE.1)) THEN + DO I=1, id%N + RHS_MUMPS((JBEG_RHS -1)*LD_RHS + I) = ZERO + ENDDO + ENDIF + IF (KEEP(221).EQ.1) THEN + DO I = 1, id%SIZE_SCHUR + id%REDRHS((JBEG_RHS-1)*LD_REDRHS + I) = ZERO + ENDDO + ENDIF + JBEG_RHS = JBEG_RHS +1 + ENDDO + ENDIF + NB_RHSSKIPPED = JBEG_RHS - (JEND_RHS + 1) + IF ((KEEP(248).EQ.1).AND.(KEEP(237).EQ.0) + & .AND. (ICNTL21.EQ.0)) + & THEN + IBEG = (JBEG_RHS-1) * LD_RHS + 1 + ENDIF + ENDIF + CALL MPI_BCAST( JBEG_RHS,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + IF (id%MYID.EQ.MASTER .AND. KEEP(221).NE.0) THEN + IBEG_REDRHS= (JBEG_RHS-1)*LD_REDRHS + 1 + ELSE + IBEG_REDRHS=-142424 + ENDIF + IF ( I_AM_SLAVE ) THEN + IF ( KEEP(221).EQ.0 ) THEN + IBEG_RHSCOMP= 1 + ELSE + IBEG_RHSCOMP= (JBEG_RHS-1)*LD_RHSCOMP + 1 + ENDIF + ELSE + IBEG_RHSCOMP=-152525 + ENDIF +#if defined(V_T) + CALL VTBEGIN(perm_scal_ini,IERR) +#endif + IF (id%MYID .eq. MASTER) THEN + IF (KEEP(248)==1) THEN + NBCOL = 0 + NBCOL_INBLOC = 0 + NZ_THIS_BLOCK = 0 + STOP_AT_NEXT_EMPTY_COL = .FALSE. + DO I=JBEG_RHS, id%NRHS + NBCOL_INBLOC = NBCOL_INBLOC +1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + ELSE + COLSIZE = id%IRHS_PTR(I+1) - id%IRHS_PTR(I) + ENDIF + IF ((.NOT.STOP_AT_NEXT_EMPTY_COL).AND.(COLSIZE.GT.0).AND. + & (KEEP(237).EQ.0)) + & STOP_AT_NEXT_EMPTY_COL =.TRUE. + IF (COLSIZE.GT.0) THEN + NBCOL = NBCOL+1 + NZ_THIS_BLOCK = NZ_THIS_BLOCK + COLSIZE + ELSE IF (STOP_AT_NEXT_EMPTY_COL) THEN + NBCOL_INBLOC = NBCOL_INBLOC -1 + NBRHS_EFF = NBCOL + EXIT + ENDIF + IF (NBCOL.EQ.NBRHS_EFF) EXIT + ENDDO + IF (NBCOL.NE.NBRHS_EFF) THEN + WRITE(6,*) 'INTERNAL ERROR 1 in SMUMPS_301 ', + & NBCOL, NBRHS_EFF + call MUMPS_ABORT() + ENDIF + ALLOCATE(IRHS_PTR_COPY(NBCOL_INBLOC+1),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NBCOL_INBLOC+1 + GOTO 30 + endif + IRHS_PTR_COPY_ALLOCATED = .TRUE. + NB_BYTES = NB_BYTES + int(NBCOL_INBLOC+1,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + JEND_RHS =JBEG_RHS + NBCOL_INBLOC - 1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + IPOS = 1 + J = 0 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + J = J+1 + IRHS_PTR_COPY(J) = IPOS + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + IPOS = IPOS + COLSIZE + ENDDO + ELSE + IPOS = 1 + J = 0 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + J = J+1 + IRHS_PTR_COPY(J) = IPOS + COLSIZE = id%IRHS_PTR(I+1) + & - id%IRHS_PTR(I) + IPOS = IPOS + COLSIZE + ENDDO + ENDIF + IRHS_PTR_COPY(NBCOL_INBLOC+1)= IPOS + IF ( IPOS-1 .NE. NZ_THIS_BLOCK ) THEN + WRITE(*,*) "Error in compressed copy of IRHS_PTR" + IERR = 99 + call MUMPS_ABORT() + ENDIF + IF (KEEP(23) .NE. 0 .and. MTYPE .NE. 1) THEN + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 30 + endif + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ELSE + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (KEEP(237).NE.0)) THEN + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK), stat=allocok) + IF (allocok .GT.0 ) THEN + IERR = 99 + GOTO 30 + ENDIF + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( DO_PERMUTE_RHS.OR.INTERLEAVE_PAR ) THEN + IPOS = 1 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + IRHS_SPARSE_COPY(IPOS:IPOS+COLSIZE-1) = + & id%IRHS_SPARSE(id%IRHS_PTR(PERM_RHS(I)): + & id%IRHS_PTR(PERM_RHS(I)+1) -1) + IPOS = IPOS + COLSIZE + ENDDO + ELSE + IRHS_SPARSE_COPY = id%IRHS_SPARSE(id%IRHS_PTR(JBEG_RHS): + & id%IRHS_PTR(JBEG_RHS)+NZ_THIS_BLOCK-1) + ENDIF + ELSE + IRHS_SPARSE_COPY + & => + & id%IRHS_SPARSE(id%IRHS_PTR(JBEG_RHS): + & id%IRHS_PTR(JBEG_RHS)+NZ_THIS_BLOCK-1) + ENDIF + ENDIF + IF (LSCAL.OR.DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (KEEP(237).NE.0)) THEN + ALLOCATE(RHS_SPARSE_COPY(NZ_THIS_BLOCK), stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 30 + endif + RHS_SPARSE_COPY_ALLOCATED = .TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ELSE + IF ( KEEP(248)==1 ) THEN + RHS_SPARSE_COPY + & => id%RHS_SPARSE(id%IRHS_PTR(JBEG_RHS): + & id%IRHS_PTR(JBEG_RHS)+NZ_THIS_BLOCK-1) + ELSE + RHS_SPARSE_COPY + & => id%RHS_SPARSE(id%IRHS_PTR(BEG_RHS): + & id%IRHS_PTR(BEG_RHS)+NZ_THIS_BLOCK-1) + ENDIF + ENDIF + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (id%KEEP(237).NE.0)) THEN + IF (id%KEEP(237).NE.0) THEN + RHS_SPARSE_COPY = ONE + ELSE IF (.NOT. LSCAL) THEN + IPOS = 1 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + IF (COLSIZE .EQ. 0) CYCLE + RHS_SPARSE_COPY(IPOS:IPOS+COLSIZE-1) = + & id%RHS_SPARSE(id%IRHS_PTR(PERM_RHS(I)): + & id%IRHS_PTR(PERM_RHS(I)+1) -1) + IPOS = IPOS + COLSIZE + ENDDO + ENDIF + ENDIF + ENDIF + IF (KEEP(23) .NE. 0) THEN + IF (MTYPE .NE. 1) THEN + IF (KEEP(248)==0) THEN + ALLOCATE( C_RW2( id%N ),stat =allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) id%MYID, + & ':Error allocating C_RW2 in SMUMPS_SOLVE_DRIVE' + END IF + GOTO 30 + END IF + DO K = 1, NBRHS_EFF + KDEC = IBEG+(K-1)*LD_RHS + DO I = 1, id%N + C_RW2(I)=RHS_MUMPS(I-1+KDEC) + END DO + DO I = 1, id%N + JPERM = id%UNS_PERM(I) + RHS_MUMPS(I-1+KDEC) = C_RW2(JPERM) + END DO + END DO + DEALLOCATE(C_RW2) + ELSE + IPOS = 1 + DO I=1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(I+1) - IRHS_PTR_COPY(I) + DO K = 1, COLSIZE + JPERM = UNS_PERM_INV(IRHS_SPARSE_COPY(IPOS+K-1)) + IRHS_SPARSE_COPY(IPOS+K-1) = JPERM + ENDDO + IPOS = IPOS + COLSIZE + ENDDO + ENDIF + ENDIF + ENDIF + IF (ERANAL) THEN + IF ( KEEP(248) == 0 ) THEN + DO K = 1, NBRHS_EFF + KDEC = IBEG+(K-1)*LD_RHS + DO I = 1, id%N + SAVERHS(I+(K-1)*id%N) = RHS_MUMPS(KDEC+I-1) + END DO + ENDDO + ENDIF + ENDIF + IF (LSCAL) THEN + IF (KEEP(248)==0) THEN + IF (MTYPE .EQ. 1) THEN + DO K =1, NBRHS_EFF + KDEC = (K-1) * LD_RHS + IBEG - 1 + DO I = 1, id%N + RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) * + & id%ROWSCA(I) + END DO + ENDDO + ELSE + DO K =1, NBRHS_EFF + KDEC = (K-1) * LD_RHS + IBEG - 1 + DO I = 1, id%N + RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) * + & id%COLSCA(I) + END DO + ENDDO + ENDIF + ELSE + KDEC=id%IRHS_PTR(JBEG_RHS) + IF ((KEEP(248)==1) .AND. + & (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (id%KEEP(237).NE.0)) + & ) THEN + IPOS = 1 + J = 0 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + J = J+1 + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE .EQ. 0) CYCLE + IF (id%KEEP(237).NE.0) THEN + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + RHS_SPARSE_COPY(IPOS) = id%ROWSCA(PERM_RHS(I)) * + & ONE + ELSE + RHS_SPARSE_COPY(IPOS) = id%ROWSCA(I) * ONE + ENDIF + ELSE + DO K = 1, COLSIZE + II = id%IRHS_SPARSE(id%IRHS_PTR(PERM_RHS(I))+K-1) + IF (MTYPE.EQ.1) THEN + RHS_SPARSE_COPY(IPOS+K-1) = + & id%RHS_SPARSE(id%IRHS_PTR(PERM_RHS(I))+K-1)* + & id%ROWSCA(II) + ELSE + RHS_SPARSE_COPY(IPOS+K-1) = + & id%RHS_SPARSE(id%IRHS_PTR(PERM_RHS(I))+K-1)* + & id%COLSCA(II) + ENDIF + ENDDO + ENDIF + IPOS = IPOS + COLSIZE + ENDDO + ELSE + IF (MTYPE .eq. 1) THEN + DO IZ=1,NZ_THIS_BLOCK + I=IRHS_SPARSE_COPY(IZ) + RHS_SPARSE_COPY(IZ)=id%RHS_SPARSE(KDEC+IZ-1)* + & id%ROWSCA(I) + ENDDO + ELSE + DO IZ=1,NZ_THIS_BLOCK + I=IRHS_SPARSE_COPY(IZ) + RHS_SPARSE_COPY(IZ)=id%RHS_SPARSE(KDEC+IZ-1)* + & id%COLSCA(I) + ENDDO + ENDIF + ENDIF + ENDIF + END IF + ENDIF +#if defined(V_T) + CALL VTEND(perm_scal_ini,IERR) +#endif + 30 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF ( I_AM_SLAVE ) THEN + IF ( (KEEP(111).NE.0) .OR. (KEEP(248).NE.0) .OR. + & (KEEP(252).NE.0) ) THEN + IF (BUILD_POSINRHSCOMP) THEN + IF (KEEP(111).NE.0) THEN + WHAT = 2 + MTYPE_LOC = 1 + ELSE IF (KEEP(252).NE.0) THEN + WHAT = 0 + MTYPE_LOC = 1 + ELSE + WHAT = 1 + MTYPE_LOC = MTYPE + ENDIF + LIW_PASSED=max(1,LIW) + IF (WHAT.EQ.0) THEN + CALL SMUMPS_639(id%NSLAVES,id%N, + & id%MYID_NODES, id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%PROCNODE_STEPS(1), id%IS(1), LIW_PASSED, + & id%STEP(1), + & id%POSINRHSCOMP(1), IDUMMY, 1, MTYPE_LOC, + & WHAT ) + ELSE + CALL SMUMPS_639(id%NSLAVES,id%N, + & id%MYID_NODES, id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%PROCNODE_STEPS(1), id%IS(1), LIW_PASSED, + & id%STEP(1), + & id%POSINRHSCOMP(1), POSINRHSCOMP_N(1), + & id%N, MTYPE_LOC, + & WHAT ) + ENDIF + BUILD_POSINRHSCOMP = .FALSE. + ENDIF + ENDIF + ENDIF + IF (KEEP(248)==1) THEN + CALL MPI_BCAST( NBCOL_INBLOC,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + ELSE + NBCOL_INBLOC = NBRHS_EFF + ENDIF + JEND_RHS =JBEG_RHS + NBCOL_INBLOC - 1 + IF ((KEEP(248).EQ.1).AND.(KEEP(237).EQ.0)) THEN + CALL MPI_BCAST( NBRHS_EFF,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(NB_RHSSKIPPED,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + ENDIF +#if defined(V_T) + CALL VTBEGIN(soln_dist,IERR) +#endif + IF ((KEEP(111).eq.0).AND.(KEEP(252).EQ.0)) THEN + IF (KEEP(248) == 0) THEN + IF ( .NOT.I_AM_SLAVE ) THEN + CALL SMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & JDUMMY, id%KEEP(1), id%KEEP8(1), id%PROCNODE_STEPS(1), + & IDUMMY, 1, + & id%STEP(1), KDUMMY, 1, BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + BUILD_POSINRHSCOMP=.FALSE. + ELSE + LIW_PASSED = max( LIW, 1 ) + CALL SMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), + & IS(1), LIW_PASSED, + & id%STEP(1), id%POSINRHSCOMP(1), KEEP(28), + & BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + BUILD_POSINRHSCOMP=.FALSE. + ENDIF + IF (INFO(1).LT.0) GOTO 90 + ELSE + CALL MPI_BCAST( NZ_THIS_BLOCK,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + IF (id%MYID.NE.MASTER) THEN + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 45 + endif + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + ALLOCATE(RHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 45 + endif + RHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*(K34_8+K35_8) + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ALLOCATE(IRHS_PTR_COPY(NBCOL_INBLOC+1),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NBCOL_INBLOC+1 + GOTO 45 + endif + IRHS_PTR_COPY_ALLOCATED = .TRUE. + NB_BYTES = NB_BYTES + int(NBCOL_INBLOC+1,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + 45 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + CALL MPI_BCAST(IRHS_SPARSE_COPY(1), + & NZ_THIS_BLOCK, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(RHS_SPARSE_COPY(1), + & NZ_THIS_BLOCK, + & MPI_REAL, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(IRHS_PTR_COPY(1), + & NBCOL_INBLOC+1, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + IF (IERR.GT.0) THEN + WRITE (*,*)'NOT OK FOR ALLOC PTR ON SLAVES' + call MUMPS_ABORT() + ENDIF + IF ( I_AM_SLAVE ) THEN + IF (KEEP(237).NE.0) THEN + K=1 + RHS_MUMPS(1:NBRHS_EFF*LD_RHS) = ZERO + IPOS = 1 + DO I = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(I+1) - IRHS_PTR_COPY(I) + IF (COLSIZE.GT.0) THEN + J = I - 1 + JBEG_RHS + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + J = PERM_RHS(J) + ENDIF + IF (POSINRHSCOMP_N(J).NE.0) THEN + RHS_MUMPS((K-1) * LD_RHS + J) = + & RHS_SPARSE_COPY(IPOS) + ENDIF + K = K + 1 + IPOS = IPOS + COLSIZE + ENDIF + ENDDO + IF (K.NE.NBRHS_EFF+1) THEN + WRITE(6,*) 'INTERNAL ERROR 2 in SMUMPS_301 ', + & K, NBRHS_EFF + call MUMPS_ABORT() + ENDIF + ELSE + IF ((KEEP(221).EQ.1).AND.(NB_RHSSKIPPED.GT.0)) THEN + DO K = JBEG_RHS-NB_RHSSKIPPED, JBEG_RHS-1 + DO I = 1, LD_RHSCOMP + id%RHSCOMP((K-1)*LD_RHSCOMP + I) = ZERO + ENDDO + ENDDO + ENDIF + DO K = 1, NBCOL_INBLOC + KDEC = (K-1) * LD_RHS + IBEG - 1 + RHS_MUMPS(KDEC+1:KDEC+id%N) = ZERO + DO IZ=IRHS_PTR_COPY(K), IRHS_PTR_COPY(K+1)-1 + I=IRHS_SPARSE_COPY(IZ) + IF (POSINRHSCOMP_N(I).NE.0) THEN + RHS_MUMPS(KDEC+I)= RHS_SPARSE_COPY(IZ) + ENDIF + ENDDO + ENDDO + END IF + ENDIF + ENDIF + ELSE IF (I_AM_SLAVE) THEN + IF (KEEP(111).NE.0) THEN + IF (KEEP(111).GT.0) THEN + IBEG_GLOB_DEF = KEEP(111) + IEND_GLOB_DEF = KEEP(111) + ELSE + IBEG_GLOB_DEF = BEG_RHS + IEND_GLOB_DEF = BEG_RHS+NBRHS_EFF-1 + ENDIF + IF ( id%KEEP(112) .GT. 0 .AND. DO_NULL_PIV) THEN + IF (IBEG_GLOB_DEF .GT.id%KEEP(112)) THEN + id%KEEP(235) = 0 + DO_NULL_PIV = .FALSE. + ENDIF + IF (IBEG_GLOB_DEF .LT.id%KEEP(112) + & .AND. IEND_GLOB_DEF .GT.id%KEEP(112) + & .AND. DO_NULL_PIV ) THEN + IEND_GLOB_DEF = id%KEEP(112) + id%KEEP(235) = 1 + DO_NULL_PIV = .FALSE. + ENDIF + ENDIF + IF (id%KEEP(235).NE.0) THEN + NZ_THIS_BLOCK=IEND_GLOB_DEF-IBEG_GLOB_DEF+1 + ALLOCATE(IRHS_PTR_COPY(NZ_THIS_BLOCK+1),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 50 + endif + IRHS_PTR_COPY_ALLOCATED = .TRUE. + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 50 + endif + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*(K34_8+K35_8) + & + K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID.eq.MASTER) THEN + II = 1 + DO I = IBEG_GLOB_DEF, IEND_GLOB_DEF + IRHS_PTR_COPY(I-IBEG_GLOB_DEF+1) = I + IF (INTERLEAVE_PAR .AND.(id%NSLAVES .GT. 1) )THEN + IRHS_SPARSE_COPY(II) = PERM_PIV_LIST(I) + ELSE + IRHS_SPARSE_COPY(II) = id%PIVNUL_LIST(I) + ENDIF + II = II +1 + ENDDO + IRHS_PTR_COPY(NZ_THIS_BLOCK+1) = NZ_THIS_BLOCK+1 + ENDIF + 50 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + CALL MPI_BCAST(IRHS_SPARSE_COPY(1), + & NZ_THIS_BLOCK, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(IRHS_PTR_COPY(1), + & NZ_THIS_BLOCK+1, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + RHS_MUMPS( IBEG : + & (IBEG + (NBRHS_EFF)*LD_RHS -1) ) = ZERO + ENDIF + DO K=1, NBRHS_EFF + KDEC = (K-1) *LD_RHSCOMP + id%RHSCOMP(KDEC+1:KDEC+LD_RHSCOMP)=ZERO + END DO + IF ((KEEP(235).NE.0).AND. INTERLEAVE_PAR) THEN + DO I=IBEG_GLOB_DEF,IEND_GLOB_DEF + IF (id%MYID_NODES .EQ. MAP_PIVNUL_LIST(I) ) THEN + JJ= POSINRHSCOMP_N(PERM_PIV_LIST(I)) + IF (JJ.GT.LD_RHSCOMP) THEN + WRITE(6,*) ' Internal ERROR JJ, LD_RHSCOMP=', + & JJ, LD_RHSCOMP + ENDIF + IF (JJ.GT.0) THEN + IF (KEEP(50).EQ.0) THEN + id%RHSCOMP(IBEG_RHSCOMP -1+ + & (I-IBEG_GLOB_DEF)*LD_RHSCOMP + JJ) = + & abs(id%DKEEP(2)) + ELSE + id%RHSCOMP(IBEG_RHSCOMP -1+ + & (I-IBEG_GLOB_DEF)*LD_RHSCOMP + JJ) = ONE + ENDIF + ENDIF + ENDIF + ENDDO + ELSE + DO I=max(IBEG_GLOB_DEF,KEEP(220)), + & min(IEND_GLOB_DEF,KEEP(220)+KEEP(109)-1) + JJ= POSINRHSCOMP_N(id%PIVNUL_LIST(I-KEEP(220)+1)) + IF (JJ.GT.0) THEN + IF (KEEP(50).EQ.0) THEN + id%RHSCOMP(IBEG_RHSCOMP-1+(I-IBEG_GLOB_DEF)*LD_RHSCOMP + & + JJ) = id%DKEEP(2) + ELSE + id%RHSCOMP(IBEG_RHSCOMP-1+(I-IBEG_GLOB_DEF)*LD_RHSCOMP + & + JJ) = ONE + ENDIF + ENDIF + ENDDO + ENDIF + IF ( KEEP(17).NE.0 .and. id%MYID_NODES.EQ.MASTER_ROOT) THEN + IBEG_ROOT_DEF = max(IBEG_GLOB_DEF,KEEP(112)+1) + IEND_ROOT_DEF = min(IEND_GLOB_DEF,KEEP(112)+KEEP(17)) + IROOT_DEF_RHS_COL1 = IBEG_ROOT_DEF-IBEG_GLOB_DEF + 1 + IBEG_ROOT_DEF = IBEG_ROOT_DEF-KEEP(112) + IEND_ROOT_DEF = IEND_ROOT_DEF-KEEP(112) + ELSE + IBEG_ROOT_DEF = -90999 + IEND_ROOT_DEF = -90999 + ENDIF + ELSE + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + LWCB_SOL_C = LWCB + IF ( id%MYID_NODES .EQ. MASTER_ROOT ) THEN + IF ( associated(id%root%RHS_CNTR_MASTER_ROOT) ) THEN + PTR_RHS_ROOT => id%root%RHS_CNTR_MASTER_ROOT + LPTR_RHS_ROOT = size(id%root%RHS_CNTR_MASTER_ROOT) + ELSE + LPTR_RHS_ROOT = NBRHS_EFF * SIZE_ROOT + IPT_RHS_ROOT = LWCB - LPTR_RHS_ROOT + 1 + PTR_RHS_ROOT => WORK_WCB(IPT_RHS_ROOT:LWCB) + LWCB_SOL_C = LWCB_SOL_C - LPTR_RHS_ROOT + ENDIF + ELSE + LPTR_RHS_ROOT = 1 + IPT_RHS_ROOT = LWCB + PTR_RHS_ROOT => WORK_WCB(IPT_RHS_ROOT:LWCB) + LWCB_SOL_C = LWCB_SOL_C - LPTR_RHS_ROOT + ENDIF + ENDIF + IF (KEEP(221) .EQ. 2 ) THEN + IF ( ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) .AND. + & ( id%MYID .EQ. MASTER ) ) THEN + II = 0 + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS -1 + DO I = 1, SIZE_ROOT + PTR_RHS_ROOT(II+I) = id%REDRHS(KDEC+I) + ENDDO + II = II+SIZE_ROOT + ENDDO + ELSE + IF ( id%MYID .EQ. MASTER) THEN + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + KDEC = IBEG_REDRHS + CALL MPI_SEND(id%REDRHS(KDEC), + & SIZE_ROOT*NBRHS_EFF, + & MPI_REAL, + & MASTER_ROOT_IN_COMM, 0, id%COMM,IERR) + ELSE + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS + CALL MPI_SEND(id%REDRHS(KDEC),SIZE_ROOT, + & MPI_REAL, + & MASTER_ROOT_IN_COMM, 0, id%COMM,IERR) + ENDDO + ENDIF + ELSE IF ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) THEN + II = 1 + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + CALL MPI_RECV(PTR_RHS_ROOT(II), + & SIZE_ROOT*NBRHS_EFF, + & MPI_REAL, + & MASTER, 0, id%COMM,STATUS,IERR) + ELSE + DO K=1, NBRHS_EFF + CALL MPI_RECV(PTR_RHS_ROOT(II),SIZE_ROOT, + & MPI_REAL, + & MASTER, 0, id%COMM,STATUS,IERR) + II = II + SIZE_ROOT + ENDDO + ENDIF + ENDIF + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + LIW_PASSED = max( LIW, 1 ) + LA_PASSED = max( LA, 1_8 ) + IF ((id%KEEP(235).EQ.0).and.(id%KEEP(237).EQ.0) ) THEN + PRUNED_SIZE_LOADED = 0_8 + CALL SMUMPS_245(id%root, id%N, id%S(1), LA_PASSED, + & IS(1), LIW_PASSED, WORK_WCB(1), LWCB_SOL_C, + & IWCB, LIWCB, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%NA(1),id%LNA,id%NE_STEPS(1), SRW3, MTYPE, + & ICNTL(1), id%STEP(1), id%FRERE_STEPS(1), + & id%DAD_STEPS(1), id%FILS(1), id%PTLUST_S(1), id%PTRFAC(1), + & IWK_SOLVE, LIWK_SOLVE, id%PROCNODE_STEPS(1), + & id%NSLAVES, INFO(1), KEEP(1), KEEP8(1), + & id%COMM_NODES, id%MYID, id%MYID_NODES, + & id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & IBEG_ROOT_DEF, IEND_ROOT_DEF, + & IROOT_DEF_RHS_COL1, + & PTR_RHS_ROOT(1), LPTR_RHS_ROOT, SIZE_ROOT, MASTER_ROOT, + & id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP, + & id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP + & , 1 , 1 , 1 + & , 1 + & , IDUMMY, 1, JDUMMY, KDUMMY, 1, LDUMMY, 1, MDUMMY + & ) + ELSE + IF ((KEEP(235).NE.0).AND.KEEP(221).NE.2.AND. + & KEEP(111).EQ.0) THEN + DO K=1, NBRHS_EFF + DO I=1, LD_RHSCOMP + id%RHSCOMP(IBEG_RHSCOMP+(K-1)*LD_RHSCOMP+I-1)= ZERO + ENDDO + ENDDO + ELSEIF (KEEP(237).NE.0) THEN + DO K=1, NBRHS_EFF + DO I=1, LD_RHSCOMP + id%RHSCOMP(IBEG_RHSCOMP+(K-1)*LD_RHSCOMP+I-1)= ZERO + ENDDO + ENDDO + ENDIF + IF (.NOT. allocated(PERM_RHS)) THEN + ALLOCATE(PERM_RHS(1),stat=allocok) + NB_BYTES = NB_BYTES + int(size(PERM_RHS),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + CALL SMUMPS_245(id%root, id%N, id%S(1), LA_PASSED, + & IS(1), LIW_PASSED, WORK_WCB(1), LWCB_SOL_C, IWCB, LIWCB, + & RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, id%NA(1),id%LNA, + & id%NE_STEPS(1), SRW3, MTYPE, ICNTL(1), id%STEP(1), + & id%FRERE_STEPS(1), id%DAD_STEPS(1), id%FILS(1), + & id%PTLUST_S(1), id%PTRFAC(1), IWK_SOLVE, LIWK_SOLVE, + & id%PROCNODE_STEPS(1), id%NSLAVES, INFO(1),KEEP(1),KEEP8(1), + & id%COMM_NODES, id%MYID, id%MYID_NODES, + & id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1, + & PTR_RHS_ROOT(1), LPTR_RHS_ROOT, SIZE_ROOT, MASTER_ROOT, + & id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP, + & id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP, + & NZ_THIS_BLOCK, NBCOL_INBLOC, id%NRHS, + & JBEG_RHS , id%Step2node(1), id%KEEP(28), IRHS_SPARSE_COPY(1), + & IRHS_PTR_COPY(1), + & size(PERM_RHS), PERM_RHS, size(UNS_PERM_INV), UNS_PERM_INV + & ) + ENDIF + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1).eq.-2) then + INFO(1)=-11 + IF (LP.GT.0) + & write(LP,*) + & ' WARNING : -11 error code obtained in solve' + END IF + IF (INFO(1).eq.-3) then + INFO(1)=-14 + IF (LP.GT.0) + & write(LP,*) + & ' WARNING : -14 error code obtained in solve' + END IF + IF (INFO(1).LT.0) GO TO 90 + IF ( KEEP(221) .EQ. 1 ) THEN + IF ( ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) .AND. + & ( id%MYID .EQ. MASTER ) ) THEN + II = 0 + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS -1 + DO I = 1, SIZE_ROOT + id%REDRHS(KDEC+I) = PTR_RHS_ROOT(II+I) + ENDDO + II = II+SIZE_ROOT + ENDDO + ELSE + IF ( id%MYID .EQ. MASTER ) THEN + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + KDEC = IBEG_REDRHS + CALL MPI_RECV(id%REDRHS(KDEC), + & SIZE_ROOT*NBRHS_EFF, + & MPI_REAL, + & MASTER_ROOT_IN_COMM, 0, id%COMM, + & STATUS,IERR) + ELSE + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS + CALL MPI_RECV(id%REDRHS(KDEC),SIZE_ROOT, + & MPI_REAL, + & MASTER_ROOT_IN_COMM, 0, id%COMM, + & STATUS,IERR) + ENDDO + ENDIF + ELSE IF ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) THEN + II = 1 + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + CALL MPI_SEND(PTR_RHS_ROOT(II), + & SIZE_ROOT*NBRHS_EFF, + & MPI_REAL, + & MASTER, 0, id%COMM,IERR) + ELSE + DO K=1, NBRHS_EFF + CALL MPI_SEND(PTR_RHS_ROOT(II),SIZE_ROOT, + & MPI_REAL, + & MASTER, 0, id%COMM,IERR) + II = II + SIZE_ROOT + ENDDO + ENDIF + ENDIF + ENDIF + ENDIF + IF ( KEEP(221) .NE. 1 ) THEN + IF (ICNTL21 == 0) THEN + IF ((.NOT. I_AM_SLAVE).AND.KEEP(237).EQ.0) THEN + ALLOCATE( CWORK(KEEP(247)*NBRHS_EFF), stat=allocok) + IF (allocok > 0) THEN + ALLOCATE( CWORK(KEEP(247)), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=KEEP(247) + ENDIF + ENDIF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1).LT.0) GO TO 90 + IF ((id%MYID.NE.MASTER).OR. .NOT.LSCAL) THEN + PT_SCALING => Dummy_SCAL + ELSE + IF (MTYPE.EQ.1) THEN + PT_SCALING => id%COLSCA + ELSE + PT_SCALING => id%ROWSCA + ENDIF + ENDIF + LIW_PASSED = max( LIW, 1 ) + IF ( .NOT.I_AM_SLAVE ) THEN + IF (KEEP(237).EQ.0) THEN + CALL SMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & JDUMMY, id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), IDUMMY, 1, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & CWORK(1), size(CWORK), + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & ) + DEALLOCATE( CWORK ) + ELSE + CALL SMUMPS_812(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%KEEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & ,IRHS_PTR_COPY(1), size(IRHS_PTR_COPY), + & IRHS_SPARSE_COPY(1), size(IRHS_SPARSE_COPY), + & RHS_SPARSE_COPY(1), size(RHS_SPARSE_COPY), + & UNS_PERM_INV, size(UNS_PERM_INV), IDUMMY, 1 + & ) + ENDIF + ELSE + IF (KEEP(237).EQ.0) THEN + CALL SMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), IS(1), LIW_PASSED, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%RHSCOMP(1), LENRHSCOMP, + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & ) + ELSE + CALL SMUMPS_812(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%KEEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & , IRHS_PTR_COPY(1), size(IRHS_PTR_COPY), + & IRHS_SPARSE_COPY(1), size(IRHS_SPARSE_COPY), + & RHS_SPARSE_COPY(1), size(RHS_SPARSE_COPY), + & UNS_PERM_INV, size(UNS_PERM_INV), POSINRHSCOMP_N, + & id%N + & ) + ENDIF + ENDIF + IF ( (id%MYID.EQ.MASTER).AND. (KEEP(237).NE.0) + & ) THEN + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + DO J = JBEG_RHS, JBEG_RHS+NBCOL_INBLOC-1 + COLSIZE = id%IRHS_PTR(PERM_RHS(J)+1) - + & id%IRHS_PTR(PERM_RHS(J)) + IF (COLSIZE.EQ.0) CYCLE + JJ = J-JBEG_RHS+1 + DO IZ= id%IRHS_PTR(PERM_RHS(J)), + & id%IRHS_PTR(PERM_RHS(J)+1)-1 + I = id%IRHS_SPARSE (IZ) + DO IZ2 = IRHS_PTR_COPY(JJ),IRHS_PTR_COPY(JJ+1)-1 + IF (IRHS_SPARSE_COPY(IZ2).EQ.I) EXIT + IF (IZ2.EQ.IRHS_PTR_COPY(JJ+1)-1) THEN + WRITE(6,*) " INTERNAL ERROR 1 gather sol_driver" + CALL MUMPS_ABORT() + ENDIF + ENDDO + id%RHS_SPARSE(IZ) = RHS_SPARSE_COPY(IZ2) + ENDDO + ENDDO + ELSE + DO J = JBEG_RHS, JBEG_RHS+NBCOL_INBLOC-1 + COLSIZE = id%IRHS_PTR(J+1) - id%IRHS_PTR(J) + IF (COLSIZE.EQ.0) CYCLE + JJ = J-JBEG_RHS+1 + DO IZ= id%IRHS_PTR(J), id%IRHS_PTR(J+1) - 1 + I = id%IRHS_SPARSE (IZ) + DO IZ2 = IRHS_PTR_COPY(JJ),IRHS_PTR_COPY(JJ+1)-1 + IF (IRHS_SPARSE_COPY(IZ2).EQ.I) EXIT + IF (IZ2.EQ.IRHS_PTR_COPY(JJ+1)-1) THEN + WRITE(6,*) " INTERNAL ERROR 2 gather sol_driver" + CALL MUMPS_ABORT() + ENDIF + ENDDO + id%RHS_SPARSE(IZ) = RHS_SPARSE_COPY(IZ2) + ENDDO + ENDDO + ENDIF + ENDIF + ELSE + IF ( I_AM_SLAVE ) THEN + LIW_PASSED = max( LIW, 1 ) + IF ( KEEP(89) .GT. 0 ) THEN + CALL SMUMPS_532(id%NSLAVES, + & id%N, id%MYID_NODES, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%ISOL_loc(1), + & id%SOL_loc(1), JBEG_RHS-NB_RHSSKIPPED, id%LSOL_loc, + & id%PTLUST_S(1), id%PROCNODE_STEPS(1), + & id%KEEP(1),id%KEEP8(1), + & IS(1), LIW_PASSED, + & id%STEP(1), scaling_data, LSCAL, NB_RHSSKIPPED ) + ENDIF + ENDIF + ENDIF + ENDIF + IF ( ICNTL10 > 0 .AND. NBRHS_EFF > 1 ) THEN + DO I = 1, ICNTL10 + write(*,*) 'FIXME: to be implemented' + END DO + END IF + IF (ERANAL) THEN + IF ((ICNTL10 .GT. 0) .AND. (ICNTL11 .GT. 0)) THEN + IF (id%MYID .EQ. MASTER) THEN + GIVSOL = .FALSE. + IF (MP .GT. 0) WRITE( MP, 170 ) + ALLOCATE(R_RW1(id%N),stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 776 + ENDIF + ALLOCATE(C_RW2(id%N),stat=allocok) + IF (allocok .GT.0) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 776 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + int(id%N,8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + END IF + 776 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + IF ( KEEP(54) .eq. 0 ) THEN + IF (id%MYID .EQ. MASTER) THEN + IF (KEEP(55).EQ.0) THEN + CALL SMUMPS_278( ICNTL(9), id%N, id%NZ, id%A(1), + & id%IRN(1), id%JCN(1), + & RHS_MUMPS(IBEG), SAVERHS, R_RW1, C_RW2, + & KEEP(1),KEEP8(1) ) + ELSE + CALL SMUMPS_121( ICNTL(9), id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & RHS_MUMPS(IBEG), SAVERHS, R_RW1, C_RW2, + & KEEP(1),KEEP8(1) ) + ENDIF + END IF + ELSE + CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N, + & MPI_REAL, MASTER, + & id%COMM, IERR ) + ALLOCATE( C_LOCWK54( id%N ), stat =allocok ) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + endif + CALL MUMPS_276(ICNTL(1), INFO(1), id%COMM, id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL SMUMPS_192( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE ) + ELSE + C_LOCWK54 = ZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( C_LOCWK54, C_RW2, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + C_RW2 = SAVERHS - C_RW2 + ELSE + CALL MPI_REDUCE( C_LOCWK54, C_DUMMY, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + NB_BYTES = NB_BYTES - int(size(C_LOCWK54),8)*K35_8 + DEALLOCATE( C_LOCWK54 ) + ALLOCATE( R_LOCWK54( id%N ), stat =allocok ) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + endif + CALL MUMPS_276(ICNTL(1), INFO(1), id%COMM, id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( I_AM_SLAVE .AND. id%NZ_loc .NE. 0 ) THEN + CALL SMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1)) + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_RW1, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + NB_BYTES = NB_BYTES - int(size(R_LOCWK54),8)*K16_8 + DEALLOCATE( R_LOCWK54 ) + END IF + IF ( id%MYID .EQ. MASTER ) THEN + CALL SMUMPS_205(ICNTL(9),INFO(1),id%N,id%NZ, + & RHS_MUMPS(IBEG), SAVERHS,R_RW1,C_RW2,GIVSOL, + & RSOL,RINFOG(4),RINFOG(5),RINFOG(6),MP,ICNTL(1), + & KEEP(1),KEEP8(1)) + NB_BYTES = NB_BYTES - int(size(R_RW1),8)*K16_8 + & - int(size(C_RW2),8)*K35_8 + DEALLOCATE(R_RW1) + DEALLOCATE(C_RW2) + END IF + END IF + IF ( PROK .AND. ICNTL10 .GT. 0 ) WRITE( MP, 270 ) + IF ( PROKG .AND. ICNTL10 .GT. 0 ) WRITE( MPG, 270 ) + ALLOCATE(R_Y(id%N), stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + ALLOCATE(C_Y(id%N), stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + IF ( id%MYID .EQ. MASTER ) THEN + ALLOCATE( IW1( 2 * id%N ),stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=2 * id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(2*id%N,8)*K34_8 + ALLOCATE( D(id%N),stat =allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + ALLOCATE( C_W(id%N), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + ALLOCATE( R_W(2*id%N), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(2*id%N,8)*K16_8 + NITREF = ICNTL10 + JOBIREF= ICNTL11 + IF ( PROKG .AND. ICNTL10 .GT. 0 ) + & WRITE( MPG, 240) 'MAXIMUM NUMBER OF STEPS =', NITREF + DO I = 1, id%N + D( I ) = RONE + END DO + END IF + ALLOCATE(C_LOCWK54(id%N),stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + ALLOCATE(R_LOCWK54(id%N),stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + KASE = 0 + 777 CONTINUE + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + 22 CONTINUE + IF ( KEEP(54) .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + IF ( KASE .eq. 0 ) THEN + IF (KEEP(55).NE.0) THEN + CALL SMUMPS_119(MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & R_W(id%N+1), KEEP(1),KEEP8(1) ) + ELSE + IF ( MTYPE .eq. 1 ) THEN + CALL SMUMPS_207 + & ( id%A(1), id%NZ, id%N, id%IRN(1), id%JCN(1), + & R_W(id%N+1), KEEP(1),KEEP8(1)) + ELSE + CALL SMUMPS_207 + & ( id%A(1), id%NZ, id%N, id%JCN(1), id%IRN(1), + & R_W(id%N+1), KEEP(1),KEEP8(1)) + END IF + ENDIF + ENDIF + END IF + ELSE + IF ( KASE .eq. 0 ) THEN + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + CALL SMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1) ) + ELSE + CALL SMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%JCN_loc(1), id%IRN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1) ) + END IF + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_W( id%N + 1 ), + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + END IF + END IF + IF ( id%MYID .eq. MASTER ) THEN + ARRET = CNTL(2) + IF (ARRET .LT. 0.0E0) THEN + ARRET = sqrt(epsilon(0.0E0)) + END IF + CALL SMUMPS_206(id%NZ,id%N,SAVERHS,RHS_MUMPS(IBEG), + & C_Y, D, R_W, C_W, + & IW1, KASE,RINFOG(7), + & RINFOG(9), JOBIREF, RINFOG(10), NITREF, NOITER, MP, + & KEEP(1),KEEP8(1), ARRET ) + END IF + IF ( KEEP(54) .ne. 0 ) THEN + CALL MPI_BCAST( KASE, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + END IF + IF ( KEEP(54) .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + IF ( KASE .eq. 14 ) THEN + IF (KEEP(55).NE.0) THEN + CALL SMUMPS_122( MTYPE, id%N, + & id%NELT, id%ELTPTR(1), id%LELTVAR, + & id%ELTVAR(1), id%NA_ELT, id%A_ELT(1), + & SAVERHS, RHS_MUMPS(IBEG), + & C_Y, R_W, KEEP(50)) + ELSE + IF ( MTYPE .eq. 1 ) THEN + CALL SMUMPS_208 + & (id%A(1), id%NZ, id%N, id%IRN(1), id%JCN(1), SAVERHS, + & RHS_MUMPS(IBEG), C_Y, R_W, KEEP(1),KEEP8(1)) + ELSE + CALL SMUMPS_208 + & (id%A(1), id%NZ, id%N, id%JCN(1), id%IRN(1), SAVERHS, + & RHS_MUMPS(IBEG), C_Y, R_W, KEEP(1),KEEP8(1)) + END IF + ENDIF + GOTO 22 + END IF + END IF + ELSE + IF ( KASE.eq.14 ) THEN + CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N, + & MPI_REAL, MASTER, + & id%COMM, IERR ) + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL SMUMPS_192( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE ) + ELSE + C_LOCWK54 = ZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( C_LOCWK54, C_Y, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + C_Y = SAVERHS - C_Y + ELSE + CALL MPI_REDUCE( C_LOCWK54, C_DUMMY, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + IF ( I_AM_SLAVE .and. id%NZ_loc .NE. 0 ) THEN + CALL SMUMPS_193( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), R_LOCWK54, KEEP(50), MTYPE ) + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_W, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_REAL, + & MPI_SUM, MASTER, id%COMM, IERR) + END IF + GOTO 22 + END IF + END IF + IF ( id%MYID .eq. MASTER ) THEN + IF ( KASE .GT. 0 ) THEN + IF ( MTYPE .EQ. 1 ) THEN + SOLVET = KASE - 1 + ELSE + SOLVET = KASE + END IF + IF ( LSCAL ) THEN + IF ( SOLVET .EQ. 1 ) THEN + DO K = 1, id%N + C_Y( K ) = C_Y( K ) * id%ROWSCA( K ) + END DO + ELSE + DO K = 1, id%N + C_Y( K ) = C_Y( K ) * id%COLSCA( K ) + END DO + END IF + END IF + END IF + END IF + CALL MPI_BCAST( KASE , 1, MPI_INTEGER, MASTER, + & id%COMM, IERR) + CALL MPI_BCAST( SOLVET, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR) + IF ( KASE .GT. 0 ) THEN + BUILD_POSINRHSCOMP=.FALSE. + IF ( .NOT.I_AM_SLAVE ) THEN + CALL SMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, C_Y(1), id%N, 1, + & JDUMMY, id%KEEP(1), id%KEEP8(1), id%PROCNODE_STEPS(1), + & IDUMMY, 1, + & id%STEP(1), KDUMMY, 1, BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + ELSE + LIW_PASSED = max( LIW, 1 ) + CALL SMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, C_Y(1), id%N, 1, + & id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), + & IS(1), LIW_PASSED, + & id%STEP(1), id%POSINRHSCOMP(1), KEEP(28), + & BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + ENDIF + IF (INFO(1).LT.0) GOTO 89 + IF ( I_AM_SLAVE ) THEN + LIW_PASSED = max( LIW, 1 ) + LA_PASSED = max( LA, 1_8 ) + CALL SMUMPS_245( id%root, id%N, id%S(1), LA_PASSED, + & id%IS(1), LIW_PASSED, WORK_WCB(1), LWCB_SOL_C, IWCB, LIWCB, C_Y, + & id%N, NBRHS_EFF, id%NA(1), id%LNA, id%NE_STEPS(1), SRW3, SOLVET, + & ICNTL(1), id%STEP(1), id%FRERE_STEPS(1), id%DAD_STEPS(1), id% + & FILS(1), id%PTLUST_S(1), id%PTRFAC(1), IWK_SOLVE(1), LIWK_SOLVE, + & id%PROCNODE_STEPS(1), id%NSLAVES, INFO(1), KEEP(1), KEEP8(1), + & id%COMM_NODES, id%MYID, id%MYID_NODES, id%BUFR(1), id%LBUFR, + & id%LBUFR_BYTES, id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1, + & PTR_RHS_ROOT(1), LPTR_RHS_ROOT, SIZE_ROOT, MASTER_ROOT, + & id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP, + & id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP + & , 1 , 1 , 1 + & , 1 + & , IDUMMY, 1, JDUMMY, KDUMMY, 1, LDUMMY, 1, MDUMMY + & ) + END IF + IF (INFO(1).eq.-2) INFO(1)=-12 + IF (INFO(1).eq.-3) INFO(1)=-15 + IF ( .NOT. I_AM_SLAVE .AND. INFO(1) .GE. 0) THEN + ALLOCATE( CWORK(KEEP(247)*NBRHS_EFF), stat=allocok) + IF (allocok > 0) THEN + ALLOCATE( CWORK(KEEP(247)), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=KEEP(247) + ENDIF + ENDIF + ENDIF + 89 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1).LT.0) GO TO 90 + IF ((id%MYID.NE.MASTER).OR. .NOT.LSCAL) THEN + PT_SCALING => Dummy_SCAL + ELSE + IF (SOLVET.EQ.1) THEN + PT_SCALING => id%COLSCA + ELSE + PT_SCALING => id%ROWSCA + ENDIF + ENDIF + LIW_PASSED = max( LIW, 1 ) + IF ( .NOT. I_AM_SLAVE ) THEN + CALL SMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & SOLVET, C_Y, id%N, NBRHS_EFF, + & JDUMMY, id%KEEP(1),id%KEEP8(1), id%PROCNODE_STEPS(1), + & IDUMMY, 1, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & CWORK, size(CWORK), + & LSCAL, PT_SCALING(1), size(PT_SCALING)) + DEALLOCATE( CWORK ) + ELSE + CALL SMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & SOLVET, C_Y, id%N, NBRHS_EFF, + & id%PTLUST_S(1), id%KEEP(1),id%KEEP8(1), + & id%PROCNODE_STEPS(1), + & IS(1), LIW_PASSED, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%RHSCOMP(1), LENRHSCOMP, + & LSCAL, PT_SCALING(1), size(PT_SCALING)) + ENDIF + GO TO 22 + ELSEIF ( KASE .LT. 0 ) THEN + INFO( 1 ) = INFO( 1 ) + 8 + END IF + IF ( id%MYID .eq. MASTER ) THEN + NB_BYTES = NB_BYTES - int(size(R_W),8)*K16_8 + & - int(size(D ),8)*K16_8 + & - int(size(IW1),8)*K34_8 + DEALLOCATE(R_W,D) + DEALLOCATE(IW1) + ENDIF + IF ( PROKG ) THEN + IF (NITREF.GT.0) THEN + WRITE( MPG, 81 ) + WRITE( MPG, 141 ) 'NUMBER OF STEPS OF ITERATIVE REFINEMENTS + &=', NOITER + ENDIF + ENDIF + IF ( id%MYID .EQ. MASTER ) THEN + IF ( NITREF .GT. 0 ) THEN + id%INFOG(15) = NOITER + END IF + END IF + IF ( PROK .AND. ICNTL10 .GT.0 ) WRITE( MP, 131 ) + IF (ICNTL11 .GT. 0) THEN + IF ( KEEP(54) .eq. 0 ) THEN + IF (id%MYID .EQ. MASTER) THEN + IF (KEEP(55).EQ.0) THEN + CALL SMUMPS_278( MTYPE, id%N, id%NZ, id%A(1), + & id%IRN(1), id%JCN(1), + & RHS_MUMPS(IBEG), SAVERHS, R_Y, C_W, KEEP(1),KEEP8(1)) + ELSE + CALL SMUMPS_121( MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & RHS_MUMPS(IBEG), SAVERHS, R_Y, C_W, KEEP(1),KEEP8(1)) + ENDIF + END IF + ELSE + CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N, + & MPI_REAL, MASTER, + & id%COMM, IERR ) + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL SMUMPS_192( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE ) + ELSE + C_LOCWK54 = ZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( C_LOCWK54, C_W, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + C_W = SAVERHS - C_W + ELSE + CALL MPI_REDUCE( C_LOCWK54, C_DUMMY, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL SMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1) ) + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_Y, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_REAL, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + END IF + IF (id%MYID .EQ. MASTER) THEN + IF ((MPG .GT. 0) .AND. (NITREF .GT. 0)) WRITE( MPG, 65 ) + IF ((MPG .GT. 0) .AND. (NITREF .LE. 0)) WRITE( MPG, 170 ) + GIVSOL = .FALSE. + CALL SMUMPS_205(MTYPE,INFO(1),id%N,id%NZ,RHS_MUMPS(IBEG), + & SAVERHS,R_Y,C_W,GIVSOL, + & RSOL,RINFOG(4),RINFOG(5),RINFOG(6),MPG,ICNTL(1), + & KEEP(1),KEEP8(1)) + IF ( MPG .GT. 0 ) THEN + WRITE( MPG, 115 ) + &'RINFOG(7):COMPONENTWISE SCALED RESIDUAL(W1)=', RINFOG(7) + WRITE( MPG, 115 ) + &'------(8):---------------------------- (W2)=', RINFOG(8) + WRITE( MPG, 115 ) + &'------(9):Upper bound ERROR ...............=', RINFOG(9) + WRITE( MPG, 115 ) + &'-----(10):CONDITION NUMBER (1) ............=', RINFOG(10) + WRITE( MPG, 115 ) + &'-----(11):CONDITION NUMBER (2) ............=', RINFOG(11) + END IF + END IF + END IF + IF (id%MYID == MASTER) THEN + NB_BYTES = NB_BYTES - int(size(C_W),8)*K35_8 + DEALLOCATE(C_W) + ENDIF + NB_BYTES = NB_BYTES - + & (int(size(R_Y),8)+int(size(R_LOCWK54),8))*K16_8 + NB_BYTES = NB_BYTES - + & (int(size(C_Y),8)+int(size(C_LOCWK54),8))*K35_8 + DEALLOCATE(R_Y) + DEALLOCATE(C_Y) + DEALLOCATE(R_LOCWK54) + DEALLOCATE(C_LOCWK54) + END IF + IF ( id%MYID .EQ. MASTER .AND. ICNTL21==0 + & .AND. KEEP(23) .NE. 0 .AND. KEEP(237).EQ.0 ) THEN + IF ((KEEP(221).NE.1 .AND. ICNTL(9) .EQ. 1) + & .OR. KEEP(111) .NE.0 .OR. KEEP(252).NE.0 ) THEN + ALLOCATE( C_RW1( id%N ),stat =allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + WRITE(*,*) 'could not allocate ', id%N, 'integers.' + CALL MUMPS_ABORT() + END IF + DO K = 1, NBRHS_EFF + KDEC = (K-1)*LD_RHS+IBEG-1 + DO 70 I = 1, id%N + C_RW1(I) = RHS_MUMPS(KDEC+I) + 70 CONTINUE + DO 80 I = 1, id%N + JPERM = id%UNS_PERM(I) + RHS_MUMPS( KDEC+JPERM ) = C_RW1( I ) + 80 CONTINUE + END DO + DEALLOCATE( C_RW1 ) + END IF + END IF + IF (id%MYID.EQ.MASTER .and.ICNTL21==0.and.KEEP(221).NE.1 + & .and. KEEP(237).EQ.0 ) THEN + IF ( INFO(1) .GE. 0 .AND. ICNTL(4).GE.3 .AND. ICNTL(3).GT.0) + & THEN + K = min0(10, id%N) + IF (ICNTL(4) .eq. 4 ) K = id%N + J = min0(10,NBRHS_EFF) + IF (ICNTL(4) .eq. 4 ) J = NBRHS_EFF + DO II=1, J + WRITE(ICNTL(3),110) BEG_RHS+II-1 + WRITE(ICNTL(3),160) + & (RHS_MUMPS(IBEG+(II-1)*LD_RHS+I-1),I=1,K) + ENDDO + END IF + END IF + IF ((KEEP(248).EQ.1).AND.(KEEP(237).EQ.0)) THEN + BEG_RHS = BEG_RHS + NBRHS_EFF + ELSE + BEG_RHS = BEG_RHS + NBRHS + ENDIF + ENDDO + IF ( (id%MYID.EQ.MASTER) + & .AND. ( KEEP(248).NE.0 ) + & .AND. ( KEEP(237).EQ.0 ) + & .AND. ( ICNTL21.EQ.0 ) + & .AND. ( KEEP(221) .NE.1 ) + & .AND. ( JEND_RHS .LT. id%NRHS ) + & ) + & THEN + JBEG_NEW = JEND_RHS + 1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, id%N + RHS_MUMPS((PERM_RHS(JBEG_NEW) -1)*LD_RHS+I) + & = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + CYCLE + ENDDO + ELSE + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, id%N + RHS_MUMPS((JBEG_NEW -1)*LD_RHS + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + ENDIF + IF ( I_AM_SLAVE .AND. (ICNTL21.NE.0) .AND. + & ( JEND_RHS .LT. id%NRHS ) .AND. KEEP(221).NE.1 ) THEN + JBEG_NEW = JEND_RHS + 1 + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, KEEP(89) + id%SOL_loc((JBEG_NEW -1)*id%LSOL_loc + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + IF ((KEEP(221).EQ.1) .AND. + & ( JEND_RHS .LT. id%NRHS ) ) THEN + IF (id%MYID .EQ. MASTER) THEN + JBEG_NEW = JEND_RHS + 1 + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, id%SIZE_SCHUR + id%REDRHS((JBEG_NEW -1)*LD_REDRHS + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + IF (I_AM_SLAVE) THEN + JBEG_NEW = JEND_RHS + 1 + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1,LD_RHSCOMP + id%RHSCOMP((JBEG_NEW -1)*LD_RHSCOMP + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + ENDIF + id%INFO(26) = int(NB_BYTES_MAX / 1000000_8, 4) + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(26), id%INFOG(30), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Rank of processor needing largest memory in solve :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Space in MBYTES used by this processor for solve :', + & id%INFOG(30) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during solve :', + & ( id%INFOG(31)-id%INFO(26) ) / id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during solve :', + & id%INFOG(31) / id%NSLAVES + END IF + END IF + 90 CONTINUE + IF (INFO(1) .LT.0 ) THEN + ENDIF + IF (KEEP(201).GT.0)THEN + IF (IS_INIT_OOC_DONE) THEN + CALL SMUMPS_582(IERR) + IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + ENDIF + IF (IRHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_SPARSE_COPY),8)*K34_8 + DEALLOCATE(IRHS_SPARSE_COPY) + IRHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_SPARSE_COPY) + ENDIF + IF (IRHS_PTR_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_PTR_COPY),8)*K34_8 + DEALLOCATE(IRHS_PTR_COPY) + IRHS_PTR_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_PTR_COPY) + ENDIF + IF (RHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(RHS_SPARSE_COPY),8)*K35_8 + DEALLOCATE(RHS_SPARSE_COPY) + RHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(RHS_SPARSE_COPY) + ENDIF + IF (allocated(PERM_RHS)) THEN + NB_BYTES = NB_BYTES - int(size(PERM_RHS),8)*K34_8 + DEALLOCATE(PERM_RHS) + ENDIF + IF (allocated(UNS_PERM_INV)) THEN + NB_BYTES = NB_BYTES - int(size(UNS_PERM_INV),8)*K34_8 + DEALLOCATE(UNS_PERM_INV) + ENDIF + IF (associated(id%BUFR)) THEN + NB_BYTES = NB_BYTES - int(size(id%BUFR),8)*K34_8 + DEALLOCATE(id%BUFR) + NULLIFY(id%BUFR) + ENDIF + IF ( I_AM_SLAVE ) THEN + IF (allocated(IWK_SOLVE)) THEN + NB_BYTES = NB_BYTES - int(size(IWK_SOLVE),8)*K34_8 + DEALLOCATE( IWK_SOLVE ) + ENDIF + IF (allocated(IWCB)) THEN + NB_BYTES = NB_BYTES - int(size(IWCB),8)*K34_8 + DEALLOCATE( IWCB ) + ENDIF + CALL SMUMPS_57( IERR ) + CALL SMUMPS_59( IERR ) + END IF + IF ( id%MYID .eq. MASTER ) THEN + IF (allocated(SAVERHS)) THEN + NB_BYTES = NB_BYTES - int(size(SAVERHS),8)*K35_8 + DEALLOCATE( SAVERHS) + ENDIF + IF ( + & ( + & ( KEEP(248).ne.0 .OR. KEEP(221).EQ.2 + & .OR. KEEP(111).NE.0 ) + & .and. ICNTL21.ne.0 ) + & .or. + & ( KEEP(237).NE.0 ) + & ) + & THEN + IF ( I_AM_SLAVE ) THEN + IF (associated(RHS_MUMPS) ) THEN + NB_BYTES = NB_BYTES - int(size(RHS_MUMPS),8)*K35_8 + DEALLOCATE(RHS_MUMPS) + ENDIF + ENDIF + ENDIF + NULLIFY(RHS_MUMPS) + ELSE + IF (associated(RHS_MUMPS)) THEN + NB_BYTES = NB_BYTES - int(size(RHS_MUMPS),8)*K35_8 + DEALLOCATE(RHS_MUMPS) + NULLIFY(RHS_MUMPS) + END IF + END IF + IF (I_AM_SLAVE) THEN + IF (allocated(SRW3)) THEN + NB_BYTES = NB_BYTES - int(size(SRW3),8)*K35_8 + DEALLOCATE(SRW3) + ENDIF + IF (allocated(POSINRHSCOMP_N)) THEN + NB_BYTES = NB_BYTES - int(size(POSINRHSCOMP_N),8)*K34_8 + DEALLOCATE(POSINRHSCOMP_N) + ENDIF + IF (LSCAL .AND. ICNTL21==1) THEN + NB_BYTES = NB_BYTES - + & int(size(scaling_data%SCALING_LOC),8)*K16_8 + DEALLOCATE(scaling_data%SCALING_LOC) + NULLIFY(scaling_data%SCALING_LOC) + ENDIF + IF (WK_USER_PROVIDED) THEN + NULLIFY(id%S) + ELSE IF (associated(id%S).AND.KEEP(201).GT.0) THEN + NB_BYTES = NB_BYTES - KEEP8(23)*K35_8 + id%KEEP8(23)=0_8 + DEALLOCATE(id%S) + NULLIFY(id%S) + ENDIF + IF (KEEP(221).NE.1) THEN + IF (associated(id%RHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8 + DEALLOCATE(id%RHSCOMP) + NULLIFY(id%RHSCOMP) + ENDIF + IF (associated(id%POSINRHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%POSINRHSCOMP),8)*K34_8 + DEALLOCATE(id%POSINRHSCOMP) + NULLIFY(id%POSINRHSCOMP) + ENDIF + ENDIF + IF ( WORK_WCB_ALLOCATED ) THEN + NB_BYTES = NB_BYTES - int(size(WORK_WCB),8)*K35_8 + DEALLOCATE( WORK_WCB ) + ENDIF + NULLIFY( WORK_WCB ) + ENDIF + RETURN + 65 FORMAT (//' ERROR ANALYSIS AFTER ITERATIVE REFINEMENT') + 100 FORMAT(//' ****** SOLVE & CHECK STEP ********'/) + 110 FORMAT (//' VECTOR SOLUTION FOR COLUMN ',I12) + 115 FORMAT(1X, A44,1P,D9.2) + 150 FORMAT (/' STATISTICS PRIOR SOLVE PHASE ...........'/ + & ' NUMBER OF RIGHT-HAND-SIDES =',I12/ + & ' BLOCKING FACTOR FOR MULTIPLE RHS =',I12/ + & ' ICNTL (9) =',I12/ + & ' --- (10) =',I12/ + & ' --- (11) =',I12/ + & ' --- (20) =',I12/ + & ' --- (21) =',I12/ + & ' --- (30) =',I12) + 151 FORMAT (' --- (25) =',I12) + 152 FORMAT (' --- (26) =',I12) + 153 FORMAT (' --- (32) =',I12) + 160 FORMAT (' RHS'/(1X,1P,5E14.6)) + 170 FORMAT (//' ERROR ANALYSIS' ) + 240 FORMAT (1X, A42,I4) + 270 FORMAT (//' BEGIN ITERATIVE REFINEMENT' ) + 81 FORMAT (/' STATISTICS AFTER ITERATIVE REFINEMENT ') + 131 FORMAT (/' END ITERATIVE REFINEMENT ') + 141 FORMAT(1X, A42,I4) + END SUBROUTINE SMUMPS_301 + SUBROUTINE SMUMPS_245(root, N, A, LA, IW, LIW, W, LWC, + & IWCB,LIWW,RHS,LRHS,NRHS,NA,LNA,NE_STEPS, W2, + & MTYPE, ICNTL, + & STEP, FRERE, DAD, FILS, PTRIST, PTRFAC, IW1,LIW1, + & PROCNODE_STEPS, SLAVEF, + & INFO, KEEP,KEEP8, COMM_NODES, MYID, + & MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & IBEG_ROOT_DEF, IEND_ROOT_DEF, + & IROOT_DEF_RHS_COL1, PTR_RHS_ROOT, LPTR_RHS_ROOT, + & SIZE_ROOT, MASTER_ROOT, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, BUILD_POSINRHSCOMP + & , NZ_RHS, NBCOL_INBLOC, NRHS_ORIG + & , JBEG_RHS + & , Step2node, LStep2node + & , IRHS_SPARSE + & , IRHS_PTR + & , SIZE_PERM_RHS, PERM_RHS + & , SIZE_UNS_PERM_INV, UNS_PERM_INV + & ) + USE SMUMPS_OOC + USE MUMPS_SOL_ES + IMPLICIT NONE + INCLUDE 'smumps_root.h' +#if defined(V_T) + INCLUDE 'VT.inc' +#endif + TYPE ( SMUMPS_ROOT_STRUC ) :: root + INTEGER(8) :: LA + INTEGER LWC,N,LIW,MTYPE,LIW1,LIWW,LNA + INTEGER ICNTL(40),INFO(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IW(LIW),IW1(LIW1),NA(LNA),NE_STEPS(KEEP(28)),IWCB(LIWW) + INTEGER STEP(N), FRERE(KEEP(28)), FILS(N), PTRIST(KEEP(28)), + & DAD(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER LRHS, NRHS, LRHSCOMP + REAL A(LA), W(LWC), RHS(LRHS,NRHS), + & W2(KEEP(133)), + & RHSCOMP(LRHSCOMP,NRHS) + INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES + INTEGER PROCNODE_STEPS(KEEP(28)), POSINRHSCOMP(KEEP(28)) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR(LBUFR) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1 + INTEGER SIZE_ROOT, MASTER_ROOT + INTEGER LPTR_RHS_ROOT + REAL PTR_RHS_ROOT(LPTR_RHS_ROOT) + LOGICAL BUILD_POSINRHSCOMP + INTEGER MP, LP, LDIAG + INTEGER K,I,II + INTEGER allocok + INTEGER LPOOL,MYLEAF,LPANEL_POS + INTEGER NSTK_S,IPOOL,IPANEL_POS,PTRICB,PTRACB + INTEGER MTYPE_LOC + INTEGER IERR + INTEGER(8) :: IAPOS + INTEGER IOLDPS, + & LOCAL_M, + & LOCAL_N +#if defined(V_T) + INTEGER soln_c_class, forw_soln, back_soln, root_soln +#endif + INTEGER IZERO + LOGICAL DOFORWARD, DOROOT, DOBACKWARD + LOGICAL I_WORKED_ON_ROOT, SPECIAL_ROOT_REACHED + INTEGER IROOT + LOGICAL DOROOT_FWD_OOC, DOROOT_BWD_PANEL + LOGICAL SWITCH_OFF_ES + LOGICAL DUMMY_BOOL + PARAMETER (IZERO = 0 ) + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INCLUDE 'mumps_headers.h' + EXTERNAL SMUMPS_248, SMUMPS_249 + INTEGER, intent(in) :: NZ_RHS, NBCOL_INBLOC, NRHS_ORIG + INTEGER, intent(in) :: SIZE_UNS_PERM_INV + INTEGER, intent(in) :: SIZE_PERM_RHS + INTEGER, intent(in) :: JBEG_RHS + INTEGER, intent(in) :: IRHS_SPARSE(NZ_RHS) + INTEGER, intent(in) :: IRHS_PTR(NBCOL_INBLOC+1) + INTEGER, intent(in) :: PERM_RHS(SIZE_PERM_RHS) + INTEGER, intent(in) :: UNS_PERM_INV(SIZE_UNS_PERM_INV) + INTEGER, intent(in) :: LStep2node + INTEGER, intent(in) :: Step2node(LStep2node) + INTEGER, DIMENSION(:), ALLOCATABLE :: nodes_RHS + INTEGER nb_nodes_RHS + INTEGER nb_prun_leaves + INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_Leaves + INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_List + INTEGER nb_prun_nodes + INTEGER nb_prun_roots, JAM1 + INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_SONS, Pruned_Roots + INTEGER, DIMENSION(:), ALLOCATABLE :: prun_NA + INTEGER :: SIZE_TO_PROCESS + LOGICAL, DIMENSION(:), ALLOCATABLE :: TO_PROCESS + INTEGER ISTEP, INODE_PRINC + LOGICAL AM1, DO_PRUN + LOGICAL Exploit_Sparsity + INTEGER :: OOC_FCT_TYPE_TMP + INTEGER :: MUMPS_808 + EXTERNAL :: MUMPS_808 + MYLEAF = -1 + LP = ICNTL(1) + MP = ICNTL(2) + LDIAG = ICNTL(4) +#if defined(V_T) + CALL VTCLASSDEF( 'Soln_c',soln_c_class,ierr) + CALL VTFUNCDEF( 'forw_soln',soln_c_class,forw_soln,ierr) + CALL VTFUNCDEF( 'back_soln',soln_c_class,back_soln,ierr) + CALL VTFUNCDEF( 'root_soln',soln_c_class,root_soln,ierr) +#endif + NSTK_S = 1 + PTRICB = NSTK_S + KEEP(28) + PTRACB = PTRICB + KEEP(28) + IPOOL = PTRACB + KEEP(28) + LPOOL = KEEP(28)+1 + IPANEL_POS = IPOOL + LPOOL + IF (KEEP(201).EQ.1) THEN + LPANEL_POS = KEEP(228)+1 + ELSE + LPANEL_POS = 1 + ENDIF + IF (IPANEL_POS + LPANEL_POS -1 .ne. LIW1 ) THEN + WRITE(*,*) MYID, ": Internal Error in SMUMPS_245", + & IPANEL_POS, LPANEL_POS, LIW1 + CALL MUMPS_ABORT() + ENDIF + DOFORWARD = .TRUE. + DOBACKWARD= .TRUE. + SPECIAL_ROOT_REACHED = .TRUE. + SWITCH_OFF_ES = .FALSE. + IF ( KEEP(111).NE.0 .OR. KEEP(252).NE.0 ) THEN + DOFORWARD = .FALSE. + ENDIF + IF (KEEP(221).eq.1) DOBACKWARD = .FALSE. + IF (KEEP(221).eq.2) DOFORWARD = .FALSE. + IF ( KEEP(60).EQ.0 .AND. + & ( + & (KEEP(38).NE.0 .AND. root%yes) + & .OR. + & (KEEP(20).NE.0 .AND. MYID_NODES.EQ.MASTER_ROOT) + & ) + & .AND. KEEP(252).EQ.0 + & ) + &THEN + DOROOT = .TRUE. + ELSE + DOROOT = .FALSE. + ENDIF + DOROOT_BWD_PANEL = DOROOT .AND. MTYPE.NE.1 .AND. KEEP(50).EQ.0 + & .AND. KEEP(201).EQ.1 + DOROOT_FWD_OOC = DOROOT .AND. .NOT.DOROOT_BWD_PANEL + AM1 = (KEEP(237) .NE. 0) + Exploit_Sparsity = (KEEP(235) .NE. 0) .AND. (.NOT. AM1) + DO_PRUN = (Exploit_Sparsity.OR.AM1) + IF ( DO_PRUN ) THEN + IF (.not. allocated(Pruned_SONS)) THEN + ALLOCATE (Pruned_SONS(KEEP(28)), stat=I) + IF(I.GT.0) THEN + INFO(1)=-13 + INFO(2)=KEEP(28) + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + END IF + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + IF (.not. allocated(TO_PROCESS)) THEN + SIZE_TO_PROCESS = KEEP(28) + ALLOCATE (TO_PROCESS(SIZE_TO_PROCESS), stat=I) + IF(I.GT.0) THEN + INFO(1)=-13 + INFO(2)=KEEP(28) + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + END IF + TO_PROCESS(:) = .TRUE. + ENDIF + IF ( DOFORWARD .AND. DO_PRUN ) THEN + nb_prun_nodes = 0 + nb_prun_roots = 0 + Pruned_SONS(:) = -1 + IF ( Exploit_Sparsity ) THEN + nb_nodes_RHS = 0 + DO I = 1, NZ_RHS + ISTEP = abs( STEP(IRHS_SPARSE(I)) ) + INODE_PRINC = Step2node( ISTEP ) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_nodes_RHS + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + nb_nodes_RHS = 0 + Pruned_SONS = -1 + DO I = 1, NZ_RHS + ISTEP = abs( STEP(IRHS_SPARSE(I)) ) + INODE_PRINC = Step2node( ISTEP ) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + nodes_RHS(nb_nodes_RHS) = INODE_PRINC + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ELSE IF ( AM1 ) THEN +#if defined(NOT_USED) + IF ( KEEP(201).GT.0) THEN + CALL SMUMPS_789(KEEP(28), + & KEEP(38), KEEP(20) ) + ENDIF +#endif + nb_nodes_RHS = 0 +#if defined(check) + WRITE(*,*) "NBCOL_INBLOC=",NBCOL_INBLOC + WRITE(*,*) "JBEG SIZE=",JBEG_RHS, SIZE(IRHS_PTR) +#endif + DO I = 1, NBCOL_INBLOC + IF ( (IRHS_PTR(I+1)-IRHS_PTR(I)).EQ.0) CYCLE + IF ( (KEEP(242) .NE. 0 ).OR. (KEEP(243).NE.0) ) THEN + JAM1 = PERM_RHS(JBEG_RHS+I-1) + ELSE + JAM1 = JBEG_RHS+I-1 + ENDIF + ISTEP = abs(STEP(JAM1)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_nodes_RHS + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + nb_nodes_RHS = 0 + Pruned_SONS = -1 + DO I = 1, NBCOL_INBLOC + IF ( (IRHS_PTR(I+1)-IRHS_PTR(I)).EQ.0) CYCLE + IF ( (KEEP(242) .NE. 0 ).OR. (KEEP(243).NE.0) ) THEN + JAM1 = PERM_RHS(JBEG_RHS+I-1) + ELSE + JAM1 = JBEG_RHS+I-1 + ENDIF + ISTEP = abs(STEP(JAM1)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + nodes_RHS(nb_nodes_RHS) = INODE_PRINC + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ENDIF + CALL MUMPS_797( + & .FALSE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves ) + ALLOCATE(Pruned_List(nb_prun_nodes), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_nodes + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Roots(nb_prun_roots), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_roots + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Leaves(nb_prun_leaves), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + CALL MUMPS_797( + & .TRUE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves ) + IF(allocated(nodes_RHS)) DEALLOCATE(nodes_RHS) + CALL SMUMPS_809(N, + & KEEP(201), Pruned_List, nb_prun_nodes, + & STEP) + IF ( KEEP(201) .GT. 0) THEN + OOC_FCT_TYPE_TMP=MUMPS_808 + & ('F',MTYPE,KEEP(201),KEEP(50)) + ELSE + OOC_FCT_TYPE_TMP = -5959 + ENDIF + CALL MUMPS_802( + & MYID_NODES, N, KEEP(28), KEEP(201), KEEP8(31), + & STEP, Pruned_List, nb_prun_nodes, OOC_FCT_TYPE_TMP + & ) + SPECIAL_ROOT_REACHED = .FALSE. + DO I= 1, nb_prun_roots + IF ( (Pruned_Roots(I).EQ.KEEP(38)).OR. + & (Pruned_Roots(I).EQ.KEEP(20)) ) THEN + SPECIAL_ROOT_REACHED = .TRUE. + EXIT + ENDIF + ENDDO + ENDIF + IF (KEEP(201).GT.0) THEN + IF (DOFORWARD .OR. DOROOT_FWD_OOC) THEN + CALL SMUMPS_583(PTRFAC,KEEP(28),MTYPE, + & A,LA,DOFORWARD,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + IF (DOFORWARD) THEN + IF ( KEEP( 50 ) .eq. 0 ) THEN + MTYPE_LOC = MTYPE + ELSE + MTYPE_LOC = 1 + ENDIF +#if defined(V_T) + CALL VTBEGIN(forw_soln,ierr) +#endif + IF (.NOT.DO_PRUN) THEN + CALL SMUMPS_248(N, A(1), LA, IW(1), LIW, W(1), + & LWC, RHS, LRHS, NRHS, + & IW1(PTRICB), IWCB, LIWW, + & RHSCOMP,LRHSCOMP,POSINRHSCOMP,BUILD_POSINRHSCOMP, + & NE_STEPS, NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(NSTK_S),IW1(IPOOL),LPOOL,PTRIST,PTRFAC, + & MYLEAF,INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS, SLAVEF, COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, MTYPE_LOC, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + ELSE + ALLOCATE(prun_NA(nb_prun_leaves+nb_prun_roots+2), + & STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves+nb_prun_roots+2 + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(I.LT.0) GOTO 500 + prun_NA(1) = nb_prun_leaves + prun_NA(2) = nb_prun_roots + DO I = 1, nb_prun_leaves + prun_NA(I+2) = Pruned_Leaves(I) + ENDDO + DO I = 1, nb_prun_roots + prun_NA(I+2+nb_prun_leaves) = Pruned_Roots(I) + ENDDO + DEALLOCATE(Pruned_List) + DEALLOCATE(Pruned_Leaves) + IF (AM1) THEN + DEALLOCATE(Pruned_Roots) + END IF + IF ((Exploit_Sparsity).AND.(nb_prun_roots.EQ.NA(2))) THEN + DEALLOCATE(Pruned_Roots) + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + SWITCH_OFF_ES = .TRUE. + ENDIF + CALL SMUMPS_248(N, A(1), LA, IW(1), LIW, W(1), + & LWC, RHS, LRHS, NRHS, + & IW1(PTRICB), IWCB, LIWW, + & RHSCOMP,LRHSCOMP,POSINRHSCOMP,BUILD_POSINRHSCOMP, + & Pruned_SONS, prun_NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(NSTK_S),IW1(IPOOL),LPOOL,PTRIST,PTRFAC, + & MYLEAF,INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS, SLAVEF, COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, MTYPE_LOC, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + DEALLOCATE(prun_NA) + ENDIF + BUILD_POSINRHSCOMP = .FALSE. +#if defined(V_T) + CALL VTEND(forw_soln,ierr) +#endif + ENDIF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF ( INFO(1) .LT. 0 ) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) MYID, + & ': ** ERROR RETURN FROM SMUMPS_248,INFO(1:2)=', + & INFO(1:2) + END IF + GOTO 500 + END IF + CALL MPI_BARRIER( COMM_NODES, IERR ) + IF (DO_PRUN.AND.SWITCH_OFF_ES) THEN + DO_PRUN = .FALSE. + Exploit_Sparsity = .FALSE. + ENDIF + IF ( DOBACKWARD .AND. DO_PRUN ) THEN + nb_prun_leaves = 0 + IF ( Exploit_Sparsity .AND. (KEEP(111).EQ.0) ) THEN + nb_nodes_RHS = nb_prun_roots + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + WRITE(*,*)'Problem with allocation of nodes_RHS' + INFO(1) = -13 + INFO(2) = nb_nodes_RHS + CALL MUMPS_ABORT() + END IF + nodes_RHS(1:nb_prun_roots)=Pruned_Roots(1:nb_prun_roots) + DEALLOCATE(Pruned_Roots) + ELSE + nb_nodes_RHS = 0 + Pruned_SONS(:) = -1 + DO II = 1, NZ_RHS + I = IRHS_SPARSE(II) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + ISTEP = abs(STEP(I)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + WRITE(*,*)'Problem with allocation of nodes_RHS' + INFO(1) = -13 + INFO(2) = nb_nodes_RHS + CALL MUMPS_ABORT() + END IF + nb_nodes_RHS = 0 + Pruned_SONS(:) = -1 + DO II = 1, NZ_RHS + I = IRHS_SPARSE(II) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + ISTEP = abs(STEP(I)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + nodes_RHS(nb_nodes_RHS) = INODE_PRINC + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ENDIF + IF ( Exploit_Sparsity ) THEN + CALL MUMPS_798( + & .FALSE., + & DAD, NE_STEPS, FRERE, KEEP(28), + & FILS, STEP, N, + & nodes_RHS, nb_nodes_RHS, + & TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves + & ) + ALLOCATE(Pruned_List(nb_prun_nodes), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_nodes + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Roots(nb_prun_roots), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_roots + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Leaves(nb_prun_leaves), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + CALL MUMPS_798( + & .TRUE., + & DAD, NE_STEPS, FRERE, KEEP(28), + & FILS, STEP, N, + & nodes_RHS, nb_nodes_RHS, + & TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves + & ) + CALL SMUMPS_809(N, + & KEEP(201), Pruned_List, nb_prun_nodes, + & STEP) + IF(allocated(nodes_RHS)) DEALLOCATE(nodes_RHS) + IF (KEEP(201).GT.0) THEN + OOC_FCT_TYPE_TMP=MUMPS_808 + & ('B',MTYPE,KEEP(201),KEEP(50)) + ELSE + OOC_FCT_TYPE_TMP = -5959 + ENDIF + CALL MUMPS_803( + & MYID_NODES, N, KEEP(28), KEEP(201), + & KEEP8(31), STEP, + & Pruned_List, + & nb_prun_nodes, OOC_FCT_TYPE_TMP) + ENDIF + ENDIF + IF(KEEP(201).EQ.1.AND.DOROOT_BWD_PANEL) THEN + I_WORKED_ON_ROOT = .FALSE. + CALL SMUMPS_584(PTRFAC,KEEP(28),MTYPE, + & I_WORKED_ON_ROOT, IROOT, A, LA, IERR) + IF (IERR .LT. 0) THEN + INFO(1) = -90 + INFO(2) = IERR + ENDIF + ENDIF + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF ( INFO(1) .LT. 0 ) GOTO 500 + ENDIF + IF (KEEP(60).NE.0 .AND. KEEP(221).EQ.0 + & .AND. MYID_NODES .EQ. MASTER_ROOT) THEN + PTR_RHS_ROOT(1:NRHS*SIZE_ROOT) = ZERO + ENDIF + IF ( ( KEEP( 38 ) .NE. 0 ).AND. SPECIAL_ROOT_REACHED ) THEN + IF ( KEEP(60) .EQ. 0 .AND. KEEP(252) .EQ. 0 ) THEN + IF ( root%yes ) THEN + IF (KEEP(201).GT.0) THEN + IF ( (Exploit_Sparsity.AND.(KEEP(111).NE.0)) .and. + & (OOC_STATE_NODE(STEP(KEEP(38))).eq.-6) ) THEN + write(6,*) " CPA to be double checked " + GOTO 1010 + ENDIF + ENDIF + IOLDPS = PTRIST(STEP(KEEP(38))) + LOCAL_M = IW( IOLDPS + 2 + KEEP(IXSZ)) + LOCAL_N = IW( IOLDPS + 1 + KEEP(IXSZ)) + IF (KEEP(201).GT.0) THEN + CALL SMUMPS_643( + & KEEP(38),PTRFAC,KEEP,A,LA, + & STEP,KEEP8,N,DUMMY_BOOL,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + WRITE(*,*) '** ERROR after SMUMPS_643', + & INFO(1) + call MUMPS_ABORT() + ENDIF + ENDIF + IAPOS = PTRFAC(IW( IOLDPS + 4 + KEEP(IXSZ))) +#if defined(V_T) + CALL VTBEGIN(root_soln,ierr) +#endif + CALL SMUMPS_286( NRHS, root%DESCRIPTOR(1), + & root%CNTXT_BLACS, LOCAL_M, LOCAL_N, + & root%MBLOCK, root%NBLOCK, + & root%IPIV(1), root%LPIV, MASTER_ROOT, MYID_NODES, + & COMM_NODES, + & PTR_RHS_ROOT(1), + & root%TOT_ROOT_SIZE, A( IAPOS ), + & INFO(1), MTYPE, KEEP(50)) + IF(KEEP(201).GT.0)THEN + CALL SMUMPS_598(KEEP(38), + & PTRFAC,KEEP(28),A,LA,.FALSE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + WRITE(*,*) + & '** ERROR after SMUMPS_598 ', + & INFO(1) + call MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + ENDIF + ELSE IF ( ( KEEP(20) .NE. 0) .AND. SPECIAL_ROOT_REACHED ) THEN + IF ( MYID_NODES .eq. MASTER_ROOT ) THEN + END IF + END IF +#if defined(V_T) + CALL VTEND(root_soln,ierr) +#endif + 1010 CONTINUE + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + IF (DOBACKWARD) THEN + IF ( KEEP(201).GT.0 .AND. .NOT. DOROOT_BWD_PANEL ) + & THEN + I_WORKED_ON_ROOT = DOROOT + IF (KEEP(111).NE.0) + & I_WORKED_ON_ROOT = .FALSE. + IF (KEEP(38).gt.0 ) THEN + IF ( ( Exploit_Sparsity.AND.(KEEP(111).EQ.0) ) + & .OR. AM1 ) THEN + IF (OOC_STATE_NODE(STEP(KEEP(38))).eq.-6) THEN + OOC_STATE_NODE(STEP(KEEP(38)))=-4 + ENDIF + ENDIF + IF (Exploit_Sparsity.AND.(KEEP(111).NE.0)) THEN + IF (OOC_STATE_NODE(STEP(KEEP(38))).eq.-6) THEN + I_WORKED_ON_ROOT = .FALSE. + ENDIF + ENDIF + ENDIF + ENDIF + IF ( AM1 ) THEN + CALL MUMPS_797( + & .FALSE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves) + ALLOCATE(Pruned_List(nb_prun_nodes), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_nodes + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Roots(nb_prun_roots), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_roots + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Leaves(nb_prun_leaves), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + CALL MUMPS_797( + & .TRUE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves ) + CALL SMUMPS_809(N, + & KEEP(201), Pruned_List, nb_prun_nodes, + & STEP) + IF (KEEP(201).GT.0) THEN + OOC_FCT_TYPE_TMP=MUMPS_808 + & ('B',MTYPE,KEEP(201),KEEP(50)) + ELSE + OOC_FCT_TYPE_TMP = -5959 + ENDIF + CALL MUMPS_802( + & MYID_NODES, N, KEEP(28), KEEP(201), KEEP8(31), + & STEP, Pruned_List, nb_prun_nodes, OOC_FCT_TYPE_TMP + & ) + ENDIF + IF ( KEEP(201).GT.0 ) THEN + IROOT = max(KEEP(20),KEEP(38)) + CALL SMUMPS_584(PTRFAC,KEEP(28),MTYPE, + & I_WORKED_ON_ROOT, IROOT, A, LA, IERR) + ENDIF + IF ( KEEP( 50 ) .eq. 0 ) THEN + MTYPE_LOC = MTYPE + ELSE + MTYPE_LOC = IZERO + ENDIF +#if defined(V_T) + CALL VTBEGIN(back_soln,ierr) +#endif + IF ( .NOT.SPECIAL_ROOT_REACHED ) THEN + PTR_RHS_ROOT(1:NRHS*SIZE_ROOT) = ZERO + ENDIF + IF ( .NOT. DO_PRUN ) THEN + SIZE_TO_PROCESS = 1 + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + ALLOCATE (TO_PROCESS(SIZE_TO_PROCESS), stat=I) + TO_PROCESS(:) = .TRUE. + CALL SMUMPS_249( N, A, LA, IW, LIW, W(1), LWC, + & RHS, LRHS, NRHS, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & IW1(PTRICB),IW1(PTRACB),IWCB,LIWW, + & W2, NE_STEPS, NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(IPOOL),LPOOL,PTRIST,PTRFAC,MYLEAF,INFO, + & PROCNODE_STEPS, SLAVEF, COMM_NODES,MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, KEEP,KEEP8, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, + & MTYPE_LOC, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, IW1(IPANEL_POS), + & LPANEL_POS, TO_PROCESS, SIZE_TO_PROCESS) + ELSE + ALLOCATE(prun_NA(nb_prun_leaves+nb_prun_roots+2), + & STAT=allocok) + IF(allocok.GT.0) THEN + WRITE(*,*)'Problem with allocation of prun_na' + CALL MUMPS_ABORT() + END IF + prun_NA(1) = nb_prun_leaves + prun_NA(2) = nb_prun_roots + DO I = 1, nb_prun_leaves + prun_NA(I+2) = Pruned_Leaves(I) + ENDDO + DO I = 1, nb_prun_roots + prun_NA(I+2+nb_prun_leaves) = Pruned_Roots(I) + ENDDO + CALL SMUMPS_249( N, A, LA, IW, LIW, W(1), LWC, + & RHS, LRHS, NRHS, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & IW1(PTRICB),IW1(PTRACB),IWCB,LIWW, + & W2, NE_STEPS, prun_NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(IPOOL),LPOOL,PTRIST,PTRFAC,MYLEAF,INFO, + & PROCNODE_STEPS, SLAVEF, COMM_NODES,MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, KEEP,KEEP8, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, + & MTYPE_LOC, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, IW1(IPANEL_POS), + & LPANEL_POS, TO_PROCESS, SIZE_TO_PROCESS) + ENDIF +#if defined(V_T) + CALL VTEND(back_soln,ierr) +#endif + ENDIF + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + IF (DOFORWARD) THEN + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + WRITE (MP,99992) + IF (N.GT.0) WRITE (MP,99993) (RHS(I,1),I=1,K) + IF (N.GT.0.and.NRHS>1) + & WRITE (MP,99994) (RHS(I,2),I=1,K) + ENDIF + ENDIF +500 CONTINUE + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + IF (Exploit_Sparsity.OR.AM1.OR.SWITCH_OFF_ES) THEN + IF ( allocated(nodes_RHS)) DEALLOCATE (nodes_RHS) + IF ( allocated(Pruned_SONS)) DEALLOCATE (Pruned_SONS) + IF ( allocated(Pruned_Roots)) DEALLOCATE (Pruned_Roots) + IF ( allocated(prun_NA)) DEALLOCATE (prun_NA) + IF ( allocated(Pruned_List)) DEALLOCATE (Pruned_List) + IF ( allocated(Pruned_Leaves)) DEALLOCATE (Pruned_Leaves) + ENDIF + RETURN +99993 FORMAT (' RHS (first column)'/(1X,1P,5E14.6)) +99994 FORMAT (' RHS (2 nd column)'/(1X,1P,5E14.6)) +99992 FORMAT (//' LEAVING SOLVE (MPI41C) WITH') + END SUBROUTINE SMUMPS_245 + SUBROUTINE SMUMPS_521(NSLAVES, N, MYID, COMM, + & MTYPE, RHS, LRHS, NRHS, PTRIST, + & KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, BUFFER, + & SIZE_BUF, SIZE_BUF_BYTES, CWORK, LCWORK, + & LSCAL, SCALING, LSCALING) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID, COMM, LIW, MTYPE + INTEGER NRHS, LRHS, LCWORK + REAL RHS (LRHS, NRHS) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + REAL :: CWORK(LCWORK) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N) + INTEGER SIZE_BUF, SIZE_BUF_BYTES + INTEGER BUFFER(SIZE_BUF) + LOGICAL, intent(in) :: LSCAL + INTEGER, intent(in) :: LSCALING + REAL, intent(in) :: SCALING(LSCALING) + INTEGER I, II, J, J1, ISTEP, MASTER, + & MYID_NODES, TYPE_PARAL, N2RECV + INTEGER LIELL, IPOS, NPIV, MAXNPIV_estim, MAXSurf + INTEGER STATUS(MPI_STATUS_SIZE), IERR + PARAMETER(MASTER=0) + LOGICAL I_AM_SLAVE + INTEGER RECORD_SIZE_P_1, SIZE1, SIZE2 + INTEGER POS_BUF, N2SEND + INTEGER SK38, SK20 + INTEGER, PARAMETER :: FIN = -1 + INTEGER, PARAMETER :: yes = 1 + INTEGER, PARAMETER :: no = 0 + INTEGER, ALLOCATABLE, DIMENSION(:) :: IROWlist(:) + INTEGER :: ONE_PACK + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + TYPE_PARAL = KEEP(46) + I_AM_SLAVE = MYID .ne. MASTER .OR. TYPE_PARAL .eq. 1 + IF ( TYPE_PARAL == 1 ) THEN + MYID_NODES = MYID + ELSE + MYID_NODES = MYID-1 + ENDIF + IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.1) THEN + IF (LSCAL) THEN + DO J=1, NRHS + DO I=1,N + RHS(I,J) = RHS(I,J)*SCALING(I) + ENDDO + ENDDO + ENDIF + RETURN + ENDIF + IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.0) THEN + DO J=1, NRHS + IF ( I_AM_SLAVE ) THEN + CALL MPI_SEND(RHS(1, J), N, MPI_REAL, MASTER, + & GatherSol, COMM, IERR) + & + ELSE + CALL MPI_RECV(RHS(1, J), N, MPI_REAL, + & 1, + & GatherSol, COMM, STATUS, IERR ) + IF (LSCAL) THEN + DO I=1,N + RHS(I,J) = RHS(I,J)*SCALING(I) + ENDDO + ENDIF + ENDIF + ENDDO + RETURN + ENDIF + MAXNPIV_estim = max(KEEP(246), KEEP(247)) + MAXSurf = MAXNPIV_estim*NRHS + IF (LCWORK .GE. MAXSurf) THEN + ONE_PACK = yes + ELSE IF (LCWORK .GE. MAXNPIV_estim) THEN + ONE_PACK = no + ELSE + WRITE(*,*) + & "Internal error 2 in SMUMPS_521:", + & TYPE_PARAL, LCWORK, KEEP(247), NRHS + CALL MUMPS_ABORT() + ENDIF + IF (ONE_PACK .EQ. no .AND. I_AM_SLAVE) THEN + WRITE(*,*) + & "Internal error 1 in SMUMPS_521:", + & TYPE_PARAL, LCWORK, KEEP(246),KEEP(247), NRHS + CALL MUMPS_ABORT() + ENDIF + IF (TYPE_PARAL .EQ. 0) + &CALL MPI_BCAST(ONE_PACK, 1, MPI_INTEGER, + & MASTER, COMM, IERR) + IF (MYID.EQ.MASTER) THEN + ALLOCATE(IROWlist(KEEP(247))) + ENDIF + IF (NSLAVES .EQ. 1 .AND. TYPE_PARAL .EQ. 1) THEN + CALL MUMPS_ABORT() + ENDIF + SIZE1=0 + CALL MPI_PACK_SIZE(MAXNPIV_estim+2,MPI_INTEGER, COMM, + & SIZE1, IERR) + SIZE2=0 + CALL MPI_PACK_SIZE(MAXSurf,MPI_REAL, COMM, + & SIZE2, IERR) + RECORD_SIZE_P_1= SIZE1+SIZE2 + IF (RECORD_SIZE_P_1.GT.SIZE_BUF_BYTES) THEN + write(6,*) MYID, + & ' Internal error 3 in SMUMPS_521 ' + write(6,*) MYID, ' RECORD_SIZE_P_1, SIZE_BUF_BYTES=', + & RECORD_SIZE_P_1, SIZE_BUF_BYTES + CALL MUMPS_ABORT() + ENDIF + N2SEND =0 + N2RECV =N + POS_BUF =0 + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + IF (I_AM_SLAVE) THEN + POS_BUF = 0 + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & NSLAVES)) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP)+KEEP(IXSZ) + NPIV = IW(IPOS+3) + LIELL = IW(IPOS) + NPIV + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2+ KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .AND. KEEP(50).EQ.0) THEN + J1=IPOS+1+LIELL + ELSE + J1=IPOS+1 + END IF + IF (MYID .EQ. MASTER) THEN + N2RECV=N2RECV-NPIV + IF (NPIV.GT.0.AND.LSCAL) + & CALL SMUMPS_522 ( ONE_PACK, .TRUE. ) + ELSE + IF (NPIV.GT.0) + & CALL SMUMPS_522 ( ONE_PACK, .FALSE.) + ENDIF + ENDIF + ENDDO + CALL SMUMPS_523() + ENDIF + IF ( MYID .EQ. MASTER ) THEN + DO WHILE (N2RECV .NE. 0) + CALL MPI_RECV( BUFFER, SIZE_BUF_BYTES, MPI_PACKED, + & MPI_ANY_SOURCE, + & GatherSol, COMM, STATUS, IERR ) + POS_BUF = 0 + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & NPIV, 1, MPI_INTEGER, COMM, IERR) + DO WHILE (NPIV.NE.FIN) + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & IROWlist, NPIV, MPI_INTEGER, COMM, IERR) + IF (ONE_PACK.EQ.yes) THEN + CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF, + & CWORK, NPIV*NRHS, MPI_REAL, + & COMM, IERR) + IF (LSCAL) THEN + DO J=1, NRHS + DO I=1,NPIV + RHS(IROWlist(I),J)= + & CWORK(I+(J-1)*NPIV)*SCALING(IROWlist(I)) + ENDDO + END DO + ELSE + DO J=1, NRHS + DO I=1,NPIV + RHS(IROWlist(I),J)= CWORK(I+(J-1)*NPIV) + ENDDO + END DO + ENDIF + ELSE + DO J=1,NRHS + CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF, + & CWORK, NPIV, MPI_REAL, + & COMM, IERR) + IF (LSCAL) THEN + DO I=1,NPIV + RHS(IROWlist(I),J)=CWORK(I)*SCALING(IROWlist(I)) + ENDDO + ELSE + DO I=1,NPIV + RHS(IROWlist(I),J)=CWORK(I) + ENDDO + ENDIF + ENDDO + ENDIF + N2RECV=N2RECV-NPIV + CALL MPI_UNPACK( BUFFER, SIZE_BUF_BYTES, POS_BUF, + & NPIV, 1, MPI_INTEGER, COMM, IERR) + ENDDO + ENDDO + DEALLOCATE(IROWlist) + ENDIF + RETURN + CONTAINS + SUBROUTINE SMUMPS_522 ( ONE_PACK, SCALE_ONLY ) + INTEGER, intent(in) :: ONE_PACK + LOGICAL, intent(in) :: SCALE_ONLY + INTEGER III + IF (SCALE_ONLY) THEN + DO II=1,NPIV + I=IW(J1+II-1) + DO J=1, NRHS + RHS(I,J) = RHS(I,J)*SCALING(I) + ENDDO + ENDDO + RETURN + ENDIF + DO II=1,NPIV + I=IW(J1+II-1) + DO J=1, NRHS + CWORK(II+(J-1)*NPIV) = RHS(I,J) + ENDDO + ENDDO + CALL MPI_PACK(NPIV, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_PACK(IW(J1), NPIV, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + IF (ONE_PACK.EQ.yes) THEN + CALL MPI_PACK(CWORK(1), NPIV*NRHS, MPI_REAL, + & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM, + & IERR) + ELSE + III = 1 + DO J=1,NRHS + CALL MPI_PACK(CWORK(III), NPIV, MPI_REAL, + & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM, + & IERR) + III =III+NPIV + ENDDO + ENDIF + N2SEND=N2SEND+NPIV + IF ( POS_BUF + RECORD_SIZE_P_1 > SIZE_BUF_BYTES ) THEN + CALL SMUMPS_523() + END IF + RETURN + END SUBROUTINE SMUMPS_522 + SUBROUTINE SMUMPS_523() + IF (N2SEND .NE. 0) THEN + CALL MPI_PACK(FIN, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_SEND(BUFFER, POS_BUF, MPI_PACKED, MASTER, + & GatherSol, COMM, IERR) + ENDIF + POS_BUF=0 + N2SEND=0 + RETURN + END SUBROUTINE SMUMPS_523 + END SUBROUTINE SMUMPS_521 + SUBROUTINE SMUMPS_812(NSLAVES, N, MYID, COMM, + & RHS, LRHS, NRHS, KEEP, BUFFER, + & SIZE_BUF, SIZE_BUF_BYTES, + & LSCAL, SCALING, LSCALING, + & IRHS_PTR_COPY, LIRHS_PTR_COPY, + & IRHS_SPARSE_COPY, LIRHS_SPARSE_COPY, + & RHS_SPARSE_COPY, LRHS_SPARSE_COPY, + & UNS_PERM_INV, LUNS_PERM_INV, + & POSINRHSCOMP_N, LPOS_N ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID, COMM + INTEGER NRHS, LRHS, LPOS_N + REAL RHS (LRHS, NRHS) + INTEGER KEEP(500) + INTEGER SIZE_BUF, SIZE_BUF_BYTES + INTEGER BUFFER(SIZE_BUF) + INTEGER, intent(in) :: LIRHS_PTR_COPY, LIRHS_SPARSE_COPY, + & LRHS_SPARSE_COPY, LUNS_PERM_INV + INTEGER :: IRHS_SPARSE_COPY(LIRHS_SPARSE_COPY), + & IRHS_PTR_COPY(LIRHS_PTR_COPY), + & UNS_PERM_INV(LUNS_PERM_INV), + & POSINRHSCOMP_N(LPOS_N) + REAL :: RHS_SPARSE_COPY(LRHS_SPARSE_COPY) + LOGICAL, intent(in) :: LSCAL + INTEGER, intent(in) :: LSCALING + REAL, intent(in) :: SCALING(LSCALING) + INTEGER COLSIZE, K, IZ, IPREV, NBCOL_INBLOC + INTEGER I, II, J, MASTER, + & TYPE_PARAL, N2RECV + INTEGER STATUS(MPI_STATUS_SIZE), IERR + PARAMETER(MASTER=0) + LOGICAL I_AM_SLAVE + INTEGER RECORD_SIZE_P_1, SIZE1, SIZE2 + INTEGER POS_BUF, N2SEND + INTEGER, PARAMETER :: FIN = -1 + INCLUDE 'mumps_headers.h' + TYPE_PARAL = KEEP(46) + I_AM_SLAVE = MYID .ne. MASTER .OR. TYPE_PARAL .eq. 1 + NBCOL_INBLOC = size(IRHS_PTR_COPY)-1 + IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.1) THEN + K=1 + DO J = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE.EQ.0) CYCLE + DO IZ=IRHS_PTR_COPY(J), IRHS_PTR_COPY(J+1)-1 + I = IRHS_SPARSE_COPY(IZ) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + IF (POSINRHSCOMP_N(I).NE.0) THEN + IF (LSCAL) THEN + RHS_SPARSE_COPY(IZ)=RHS(I,K)*SCALING(I) + ELSE + RHS_SPARSE_COPY(IZ)=RHS(I,K) + ENDIF + ENDIF + ENDDO + K = K + 1 + ENDDO + RETURN + ENDIF + IF (I_AM_SLAVE) THEN + K=1 + DO J = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE.EQ.0) CYCLE + DO IZ=IRHS_PTR_COPY(J), IRHS_PTR_COPY(J+1)-1 + I = IRHS_SPARSE_COPY(IZ) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + IF (POSINRHSCOMP_N(I).NE.0) THEN + RHS_SPARSE_COPY(IZ)=RHS(I,K) + ENDIF + ENDDO + K = K + 1 + ENDDO + ENDIF + SIZE1=0 + CALL MPI_PACK_SIZE(3,MPI_INTEGER, COMM, + & SIZE1, IERR) + SIZE2=0 + CALL MPI_PACK_SIZE(1,MPI_REAL, COMM, + & SIZE2, IERR) + RECORD_SIZE_P_1= SIZE1+SIZE2 + IF (RECORD_SIZE_P_1.GT.SIZE_BUF_BYTES) THEN + write(6,*) MYID, + & ' Internal error 3 in SMUMPS_812 ' + write(6,*) MYID, ' RECORD_SIZE_P_1, SIZE_BUF_BYTES=', + & RECORD_SIZE_P_1, SIZE_BUF_BYTES + CALL MUMPS_ABORT() + ENDIF + N2SEND =0 + N2RECV =size(IRHS_SPARSE_COPY) + POS_BUF =0 + IF (I_AM_SLAVE) THEN + DO J = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE.LE.0) CYCLE + K = 0 + DO IZ=IRHS_PTR_COPY(J), IRHS_PTR_COPY(J+1)-1 + I = IRHS_SPARSE_COPY(IZ) + II = I + IF (KEEP(23).NE.0) II = UNS_PERM_INV(I) + IF (POSINRHSCOMP_N(II).NE.0) THEN + IF (MYID .EQ. MASTER) THEN + N2RECV=N2RECV-1 + IF (LSCAL) + & CALL SMUMPS_813 ( .TRUE. ) + IRHS_SPARSE_COPY( IRHS_PTR_COPY(J) + K) = + & I + RHS_SPARSE_COPY( IRHS_PTR_COPY(J) + K) = + & RHS_SPARSE_COPY(IZ) + K = K+1 + ELSE + CALL SMUMPS_813 ( .FALSE. ) + ENDIF + ENDIF + ENDDO + IF (MYID.EQ.MASTER) + & IRHS_PTR_COPY(J) = IRHS_PTR_COPY(J) + K + ENDDO + CALL SMUMPS_814() + ENDIF + IF ( MYID .EQ. MASTER ) THEN + DO WHILE (N2RECV .NE. 0) + CALL MPI_RECV( BUFFER, SIZE_BUF_BYTES, MPI_PACKED, + & MPI_ANY_SOURCE, + & GatherSol, COMM, STATUS, IERR ) + POS_BUF = 0 + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & J, 1, MPI_INTEGER, COMM, IERR) + DO WHILE (J.NE.FIN) + IZ = IRHS_PTR_COPY(J) + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & I, 1, MPI_INTEGER, COMM, IERR) + IRHS_SPARSE_COPY(IZ) = I + CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF, + & RHS_SPARSE_COPY(IZ), 1, MPI_REAL, + & COMM, IERR) + IF (LSCAL) THEN + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + RHS_SPARSE_COPY(IZ) = RHS_SPARSE_COPY(IZ)*SCALING(I) + ENDIF + N2RECV=N2RECV-1 + IRHS_PTR_COPY(J) = IRHS_PTR_COPY(J) + 1 + CALL MPI_UNPACK( BUFFER, SIZE_BUF_BYTES, POS_BUF, + & J, 1, MPI_INTEGER, COMM, IERR) + ENDDO + ENDDO + IPREV = 1 + DO J=1, size(IRHS_PTR_COPY)-1 + I= IRHS_PTR_COPY(J) + IRHS_PTR_COPY(J) = IPREV + IPREV = I + ENDDO + ENDIF + RETURN + CONTAINS + SUBROUTINE SMUMPS_813 ( SCALE_ONLY ) + LOGICAL, intent(in) :: SCALE_ONLY + INTEGER III + IF (SCALE_ONLY) THEN + III = I + IF (KEEP(23).NE.0) III = UNS_PERM_INV(I) + IF (LSCAL) THEN + RHS_SPARSE_COPY(IZ)=RHS_SPARSE_COPY(IZ)*SCALING(III) + ENDIF + RETURN + ENDIF + CALL MPI_PACK(J, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_PACK(I, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_PACK(RHS_SPARSE_COPY(IZ), 1, MPI_REAL, + & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM, + & IERR) + N2SEND=N2SEND+1 + IF ( POS_BUF + RECORD_SIZE_P_1 > SIZE_BUF_BYTES ) THEN + CALL SMUMPS_814() + END IF + RETURN + END SUBROUTINE SMUMPS_813 + SUBROUTINE SMUMPS_814() + IF (N2SEND .NE. 0) THEN + CALL MPI_PACK(FIN, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_SEND(BUFFER, POS_BUF, MPI_PACKED, MASTER, + & GatherSol, COMM, IERR) + ENDIF + POS_BUF=0 + N2SEND=0 + RETURN + END SUBROUTINE SMUMPS_814 + END SUBROUTINE SMUMPS_812 + SUBROUTINE SMUMPS_535(MTYPE, ISOL_LOC, + & PTRIST, KEEP,KEEP8, + & IW, LIW_PASSED, MYID_NODES, N, STEP, + & PROCNODE, NSLAVES, scaling_data, LSCAL) + IMPLICIT NONE + INTEGER MTYPE, MYID_NODES, N, NSLAVES + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE(KEEP(28)) + INTEGER ISOL_LOC(KEEP(89)) + INTEGER LIW_PASSED + INTEGER IW(LIW_PASSED) + INTEGER STEP(N) + LOGICAL LSCAL + type scaling_data_t + SEQUENCE + REAL, dimension(:), pointer :: SCALING + REAL, dimension(:), pointer :: SCALING_LOC + end type scaling_data_t + type (scaling_data_t) :: scaling_data + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER ISTEP, K + INTEGER J1, IPOS, LIELL, NPIV, JJ + INTEGER SK38,SK20 + INCLUDE 'mumps_headers.h' + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + K=0 + DO ISTEP=1, KEEP(28) + IF ( MYID_NODES == MUMPS_275( PROCNODE(ISTEP), + & NSLAVES)) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP)+KEEP(IXSZ) + LIELL = IW(IPOS+3) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 + KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .AND. KEEP(50).EQ.0) THEN + J1=IPOS+1+LIELL + ELSE + J1=IPOS+1 + END IF + DO JJ=J1,J1+NPIV-1 + K=K+1 + ISOL_LOC(K)=IW(JJ) + IF (LSCAL) THEN + scaling_data%SCALING_LOC(K)= + & scaling_data%SCALING(IW(JJ)) + ENDIF + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_535 + SUBROUTINE SMUMPS_532( + & SLAVEF, N, MYID_NODES, + & MTYPE, RHS, LD_RHS, NRHS, + & ISOL_LOC, SOL_LOC, BEG_RHS, LSOL_LOC, + & PTRIST, + & PROCNODE_STEPS, KEEP,KEEP8, IW, LIW, STEP, + & scaling_data, LSCAL, NB_RHSSKIPPED) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + type scaling_data_t + SEQUENCE + REAL, dimension(:), pointer :: SCALING + REAL, dimension(:), pointer :: SCALING_LOC + end type scaling_data_t + TYPE (scaling_data_t) :: scaling_data + LOGICAL LSCAL + INTEGER SLAVEF, N, MYID_NODES, LIW, MTYPE, NRHS, LD_RHS + INTEGER LSOL_LOC, BEG_RHS, NB_RHSSKIPPED + INTEGER ISOL_LOC(LSOL_LOC) + REAL SOL_LOC( LSOL_LOC, BEG_RHS+NRHS+NB_RHSSKIPPED-1) + REAL RHS( LD_RHS , NRHS) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N) + INTEGER JJ, J1, ISTEP, K, JEMPTY, JEND + INTEGER IPOS, LIELL, NPIV + LOGICAL ROOT + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + K=0 + JEMPTY = BEG_RHS+NB_RHSSKIPPED-1 + JEND = BEG_RHS+NB_RHSSKIPPED+NRHS-1 + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & SLAVEF)) THEN + ROOT=.false. + IF (KEEP(38).ne.0) ROOT = STEP(KEEP(38))==ISTEP + IF (KEEP(20).ne.0) ROOT = STEP(KEEP(20))==ISTEP + IF ( ROOT ) THEN + IPOS = PTRIST(ISTEP) + KEEP(IXSZ) + LIELL = IW(IPOS+3) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2 +KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .AND. KEEP(50).EQ.0) THEN + J1=IPOS+1+LIELL + ELSE + J1=IPOS+1 + END IF + DO JJ=J1,J1+NPIV-1 + K=K+1 + IF (NB_RHSSKIPPED.GT.0) + & SOL_LOC(K, BEG_RHS:JEMPTY) = ZERO + IF (LSCAL) THEN + SOL_LOC(K,JEMPTY+1:JEND) = + & scaling_data%SCALING_LOC(K)*RHS(IW(JJ),1:NRHS) + ELSE + SOL_LOC(K,JEMPTY+1:JEND) = + & RHS(IW(JJ),1:NRHS) + ENDIF + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_532 + SUBROUTINE SMUMPS_638 + & (NSLAVES, N, MYID, COMM, + & MTYPE, RHS, LRHS, NRHS, PTRIST, + & KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, + & POSINRHSCOMP, LENPOSINRHSCOMP, + & BUILD_POSINRHSCOMP, ICNTL, INFO) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID, COMM, LIW, MTYPE + INTEGER NRHS, LRHS, LENPOSINRHSCOMP + INTEGER ICNTL(40), INFO(40) + REAL RHS (LRHS, NRHS) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N), POSINRHSCOMP(LENPOSINRHSCOMP) + LOGICAL BUILD_POSINRHSCOMP + INTEGER BUF_MAXSIZE, BUF_MAXREF + PARAMETER (BUF_MAXREF=200000) + INTEGER, ALLOCATABLE, DIMENSION(:) :: BUF_INDX + REAL, ALLOCATABLE, DIMENSION(:,:) :: BUF_RHS + INTEGER ENTRIES_2_PROCESS, PROC_WHO_ASKS, BUF_EFFSIZE + INTEGER INDX + INTEGER allocok + REAL ZERO + PARAMETER( ZERO = 0.0E0 ) + INTEGER I, K, JJ, J1, ISTEP, MASTER, + & MYID_NODES, TYPE_PARAL + INTEGER LIELL, IPOS, NPIV + INTEGER STATUS(MPI_STATUS_SIZE), IERR + PARAMETER(MASTER=0) + LOGICAL I_AM_SLAVE + INTEGER SK38, SK20, IPOSINRHSCOMP + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + TYPE_PARAL = KEEP(46) + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + I_AM_SLAVE = MYID .ne. 0 .OR. TYPE_PARAL .eq. 1 + IF ( TYPE_PARAL == 1 ) THEN + MYID_NODES = MYID + ELSE + MYID_NODES = MYID-1 + ENDIF + BUF_EFFSIZE = 0 + BUF_MAXSIZE = max(min(BUF_MAXREF,int(2000000/NRHS)),2000) + ALLOCATE (BUF_INDX(BUF_MAXSIZE), + & BUF_RHS(NRHS,BUF_MAXSIZE), + & stat=allocok) + IF (allocok .GT. 0) THEN + INFO(1)=-13 + INFO(2)=BUF_MAXSIZE*(NRHS+1) + ENDIF + CALL MUMPS_276(ICNTL, INFO, COMM, MYID ) + IF (INFO(1).LT.0) RETURN + IF (MYID.EQ.MASTER) THEN + ENTRIES_2_PROCESS = N - KEEP(89) + DO WHILE ( ENTRIES_2_PROCESS .NE. 0) + CALL MPI_RECV( BUF_INDX, BUF_MAXSIZE, MPI_INTEGER, + & MPI_ANY_SOURCE, + & ScatterRhsI, COMM, STATUS, IERR ) + CALL MPI_GET_COUNT( STATUS, MPI_INTEGER, BUF_EFFSIZE, IERR ) + PROC_WHO_ASKS = STATUS(MPI_SOURCE) + DO I = 1, BUF_EFFSIZE + INDX = BUF_INDX( I ) + DO K = 1, NRHS + BUF_RHS( K, I ) = RHS( INDX, K ) + RHS( BUF_INDX(I), K ) = ZERO + ENDDO + ENDDO + CALL MPI_SEND( BUF_RHS, NRHS*BUF_EFFSIZE, + & MPI_REAL, PROC_WHO_ASKS, + & ScatterRhsR, COMM, IERR) + ENTRIES_2_PROCESS = ENTRIES_2_PROCESS - BUF_EFFSIZE + ENDDO + BUF_EFFSIZE= 0 + ENDIF + IF (I_AM_SLAVE) THEN + IF (BUILD_POSINRHSCOMP) THEN + IPOSINRHSCOMP = 1 + POSINRHSCOMP = -9678 + ENDIF + IF (MYID.NE.MASTER) RHS = ZERO + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & NSLAVES)) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP) + LIELL = IW(IPOS+3+KEEP(IXSZ)) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2+ KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .OR. KEEP(50).NE.0) THEN + J1=IPOS+1 + ELSE + J1=IPOS+1+LIELL + END IF + IF (BUILD_POSINRHSCOMP) THEN + POSINRHSCOMP(ISTEP) = IPOSINRHSCOMP + IPOSINRHSCOMP = IPOSINRHSCOMP + NPIV + ENDIF + IF (MYID.NE.MASTER) THEN + DO JJ=J1,J1+NPIV-1 + BUF_EFFSIZE = BUF_EFFSIZE + 1 + BUF_INDX(BUF_EFFSIZE) = IW(JJ) + IF (BUF_EFFSIZE + 1 .GT. BUF_MAXSIZE) THEN + CALL SMUMPS_640() + ENDIF + ENDDO + ENDIF + ENDIF + ENDDO + IF ( BUF_EFFSIZE .NE. 0 .AND. MYID.NE.MASTER ) + & CALL SMUMPS_640() + ENDIF + DEALLOCATE (BUF_INDX, BUF_RHS) + RETURN + CONTAINS + SUBROUTINE SMUMPS_640() + CALL MPI_SEND(BUF_INDX, BUF_EFFSIZE, MPI_INTEGER, + & MASTER, ScatterRhsI, COMM, IERR ) + CALL MPI_RECV(BUF_RHS, BUF_EFFSIZE*NRHS, + & MPI_REAL, + & MASTER, + & ScatterRhsR, COMM, STATUS, IERR ) + DO I = 1, BUF_EFFSIZE + INDX = BUF_INDX(I) + DO K = 1, NRHS + RHS( INDX, K ) = BUF_RHS( K, I ) + ENDDO + ENDDO + BUF_EFFSIZE = 0 + RETURN + END SUBROUTINE SMUMPS_640 + END SUBROUTINE SMUMPS_638 + SUBROUTINE SMUMPS_639 + & (NSLAVES, N, MYID_NODES, + & PTRIST, + & KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, + & POSINRHSCOMP, POSINRHSCOMP_N, LPIRC_N, MTYPE, + & WHAT ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID_NODES, LIW + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N), POSINRHSCOMP(KEEP(28)) + INTEGER LPIRC_N, WHAT, MTYPE + INTEGER POSINRHSCOMP_N(LPIRC_N) + INTEGER ISTEP + INTEGER NPIV + INTEGER SK38, SK20, IPOS, LIELL + INTEGER JJ, J1 + INTEGER IPOSINRHSCOMP + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + IF (WHAT .NE. 0.AND. WHAT.NE.1.AND.WHAT.NE.2) THEN + WRITE(*,*) "Internal error in SMUMPS_639" + CALL MUMPS_ABORT() + ENDIF + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + IPOSINRHSCOMP = 1 + POSINRHSCOMP = -9678 + IF (WHAT .NE. 0) THEN + POSINRHSCOMP_N = 0 + ENDIF + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & NSLAVES)) THEN + IPOS = PTRIST(ISTEP) + NPIV = IW(IPOS+3+KEEP(IXSZ)) + POSINRHSCOMP(ISTEP) = IPOSINRHSCOMP + IF (WHAT .NE. 0) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP) + LIELL = IW(IPOS+3+KEEP(IXSZ)) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2+ KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + ENDIF + IF (MTYPE.eq.1 .OR. KEEP(50).NE.0) THEN + J1=IPOS+1 + ELSE + J1=IPOS+1+LIELL + END IF + DO JJ = J1, J1+NPIV-1 + POSINRHSCOMP_N(IW(JJ)) = IPOSINRHSCOMP+JJ-J1 + END DO + ENDIF + IPOSINRHSCOMP = IPOSINRHSCOMP + NPIV + ENDIF + ENDDO + RETURN + END SUBROUTINE SMUMPS_639 + SUBROUTINE SMUMPS_248(N, A, LA, IW, LIW, WCB, LWCB, + & RHS, LRHS, NRHS, + & PTRICB, IWCB, LIWCB, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, BUILD_POSINRHSCOMP, + & NE_STEPS, NA, LNA, STEP, + & FRERE, DAD, FILS, + & NSTK_S, IPOOL, LPOOL, PTRIST, PTRFAC, MYLEAF, INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS, + & SLAVEF, COMM, MYID, BUFR, LBUFR, LBUFR_BYTES, + & RHS_ROOT, LRHS_ROOT, MTYPE, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE SMUMPS_OOC + IMPLICIT NONE + INTEGER MTYPE + INTEGER(8) :: LA + INTEGER N, LIW, LWCB, LPOOL, LIWCB, LNA + INTEGER SLAVEF, MYLEAF, COMM, MYID + INTEGER INFO( 40 ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER LRHS, NRHS + REAL A( LA ), RHS( LRHS, NRHS ), WCB( LWCB ) + INTEGER LRHS_ROOT + REAL RHS_ROOT( LRHS_ROOT ) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER NA( LNA ), NE_STEPS( KEEP(28) ) + INTEGER STEP( N ), FRERE( KEEP(28) ), FILS( N ), + & DAD( KEEP(28) ) + INTEGER NSTK_S(KEEP(28)), IPOOL( LPOOL ) + INTEGER PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PTRICB( KEEP(28) ) + INTEGER IW( LIW ), IWCB( LIWCB ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER POSINRHSCOMP(KEEP(28)), LRHSCOMP + LOGICAL BUILD_POSINRHSCOMP + REAL RHSCOMP( LRHSCOMP, NRHS ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER MSGTAG, MSGSOU, DUMMY(1) + LOGICAL FLAG + INTEGER NBFIN, MYROOT + INTEGER POSIWCB,POSWCB,PLEFTWCB + INTEGER INODE + INTEGER RHSCOMPFREEPOS + INTEGER I + INTEGER III, NBROOT,LEAF + LOGICAL BLOQ + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + POSIWCB = LIWCB + POSWCB = LWCB + PLEFTWCB= 1 + IF (BUILD_POSINRHSCOMP) RHSCOMPFREEPOS= 1 + DO I = 1, KEEP(28) + NSTK_S(I) = NE_STEPS(I) + ENDDO + PTRICB = 0 + CALL MUMPS_362(N, LEAF, NBROOT, MYROOT, MYID, + & SLAVEF, NA, LNA, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, IPOOL, LPOOL) + NBFIN = SLAVEF + IF ( MYROOT .EQ. 0 ) THEN + NBFIN = NBFIN - 1 + DUMMY(1) = 1 + CALL SMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, + & RACINE_SOLVE, SLAVEF) + END IF + MYLEAF = LEAF - 1 + III = 1 + 50 CONTINUE + IF (SLAVEF .EQ. 1) THEN + CALL SMUMPS_574 + & ( IPOOL(1), LPOOL, III, LEAF, INODE, + & KEEP(208) ) + GOTO 60 + ENDIF + BLOQ = ( ( III .EQ. LEAF ) + & ) + CALL SMUMPS_303( BLOQ, FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 .OR. NBFIN .EQ. 0 ) GOTO 260 + IF (.not. FLAG) THEN + IF (III .NE. LEAF) THEN + CALL SMUMPS_574 + & (IPOOL(1), LPOOL, III, LEAF, INODE, + & KEEP(208) ) + GOTO 60 + ENDIF + ENDIF + GOTO 50 + 60 CONTINUE + CALL SMUMPS_302( INODE, BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, N, + & IPOOL, LPOOL, III, LEAF, NBFIN, NSTK_S, + & IWCB, LIWCB, WCB, LWCB, A, LA, + & IW, LIW, RHS, LRHS, NRHS, + & POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS, + & FILS, STEP, FRERE, DAD, + & MYROOT, INFO, KEEP,KEEP8, RHS_ROOT, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & RHSCOMPFREEPOS, BUILD_POSINRHSCOMP, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( INFO( 1 ) .LT. 0 .OR. NBFIN .EQ. 0 ) GOTO 260 + GOTO 50 + 260 CONTINUE + CALL SMUMPS_150( MYID,COMM,BUFR, + & LBUFR,LBUFR_BYTES ) + RETURN + END SUBROUTINE SMUMPS_248 + RECURSIVE SUBROUTINE SMUMPS_323 + & ( BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, + & PTRFAC, IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, + & INFO, KEEP,KEEP8, STEP, PROCNODE_STEPS, + & RHS, LRHS + & ) + USE SMUMPS_OOC + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER LBUFR, LBUFR_BYTES + INTEGER MSGTAG, MSGSOU, MYID, SLAVEF, COMM + INTEGER LIW + INTEGER(8) :: LA + INTEGER N, NRHS, LPOOL, III, LEAF, NBFIN + INTEGER LIWCB, LWCB, POSWCB, PLEFTWCB, POSIWCB + INTEGER INFO( 40 ), KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER BUFR( LBUFR ) + INTEGER IPOOL( LPOOL ), NSTK_S( N ) + INTEGER IWCB( LIWCB ) + INTEGER IW( LIW ) + INTEGER PTRICB(KEEP(28)),PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N) + INTEGER PROCNODE_STEPS(KEEP(28)) + REAL WCB( LWCB ), A( LA ) + INTEGER LRHS + REAL RHS(LRHS, NRHS) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, K, JJ + INTEGER FINODE, FPERE, LONG, NCB, POSITION, NCV, NPIV + INTEGER PTRX, PTRY, PDEST, I + INTEGER(8) :: APOS + LOGICAL DUMMY + LOGICAL FLAG + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + REAL ALPHA, ONE + PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0) + INCLUDE 'mumps_headers.h' + IF ( MSGTAG .EQ. RACINE_SOLVE ) THEN + NBFIN = NBFIN - 1 + IF ( NBFIN .eq. 0 ) GOTO 270 + ELSE IF (MSGTAG .EQ. ContVec ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FINODE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FPERE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NCB, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LONG, 1, MPI_INTEGER, COMM, IERR ) + IF ( NCB .eq. 0 ) THEN + PTRICB(STEP(FINODE)) = -1 + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF ( NSTK_S(STEP(FPERE)) .EQ. 0 ) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + IF ( LEAF > LPOOL ) THEN + WRITE(*,*) 'Internal error 41r2 : Pool is too small.' + CALL MUMPS_ABORT() + END IF + END IF + ELSE + IF ( PTRICB(STEP(FINODE)) .EQ. 0 ) THEN + PTRICB(STEP(FINODE)) = NCB + 1 + END IF + IF ( ( POSIWCB - LONG ) .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = LONG + GOTO 260 + END IF + IF ( POSWCB - PLEFTWCB + 1 .LT. LONG * NRHS) THEN + INFO( 1 ) = -11 + INFO( 2 ) = PLEFTWCB - POSWCB - 1 + LONG * NRHS + GOTO 260 + END IF + IF (LONG .GT. 0) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IWCB( 1 ), + & LONG, MPI_INTEGER, COMM, IERR ) + DO K = 1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WCB( PLEFTWCB ), + & LONG, MPI_REAL, COMM, IERR ) + DO I = 1, LONG + RHS(IWCB(I),K) = RHS(IWCB(I),K) +WCB(PLEFTWCB+I-1) + ENDDO + END DO + PTRICB(STEP(FINODE)) = PTRICB(STEP(FINODE)) - LONG + ENDIF + IF ( PTRICB(STEP(FINODE)) == 1 ) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + END IF + IF ( NSTK_S(STEP(FPERE)) .EQ. 0 ) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + IF ( LEAF > LPOOL ) THEN + WRITE(*,*) 'Internal error 41r2 : Pool is too small.' + CALL MUMPS_ABORT() + END IF + ENDIF + END IF + ELSEIF ( MSGTAG .EQ. Master2Slave ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FINODE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FPERE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NCV, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NPIV, 1, MPI_INTEGER, COMM, IERR ) + PTRY = PLEFTWCB + PTRX = PLEFTWCB + NCV * NRHS + PLEFTWCB = PLEFTWCB + (NPIV + NCV) * NRHS + IF ( POSWCB - PLEFTWCB + 1 .LT. 0 ) THEN + INFO(1) = -11 + INFO(2) = -POSWCB + PLEFTWCB -1 + GO TO 260 + END IF + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WCB( PTRY + (K-1) * NCV ), NCV, + & MPI_REAL, COMM, IERR ) + ENDDO + IF ( NPIV .GT. 0 ) THEN + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WCB( PTRX + (K-1)*NPIV ), NPIV, + & MPI_REAL, COMM, IERR ) + END DO + END IF + IF (KEEP(201).GT.0) THEN + CALL SMUMPS_643( + & FINODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,DUMMY,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + APOS = PTRFAC(STEP(FINODE)) + IF (KEEP(201).EQ.1) THEN + IF ( NRHS == 1 ) THEN + CALL sgemv( 'N', NCV, NPIV, ALPHA, A(APOS), NCV, + & WCB( PTRX ), 1, ONE, + & WCB( PTRY ), 1 ) + ELSE + CALL sgemm( 'N', 'N', NCV, NRHS, NPIV, ALPHA, + & A(APOS), NCV, + & WCB( PTRX), NPIV, ONE, + & WCB( PTRY), NCV ) + ENDIF + ELSE + IF ( NRHS == 1 ) THEN + CALL sgemv( 'T', NPIV, NCV, ALPHA, A(APOS), NPIV, + & WCB( PTRX ), 1, ONE, + & WCB( PTRY ), 1 ) + ELSE + CALL sgemm( 'T', 'N', NCV, NRHS, NPIV, ALPHA, + & A(APOS), NPIV, + & WCB( PTRX), NPIV, ONE, + & WCB( PTRY), NCV ) + ENDIF + ENDIF + IF (KEEP(201).GT.0) THEN + CALL SMUMPS_598(FINODE,PTRFAC, + & KEEP(28),A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + PLEFTWCB = PLEFTWCB - NPIV * NRHS + PDEST = MUMPS_275( PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF ) + IF ( PDEST .EQ. MYID ) THEN + IF ( PTRICB(STEP(FINODE)) .EQ. 0 ) THEN + NCB = IW( PTRIST(STEP(FINODE)) + 2 + KEEP(IXSZ) ) + PTRICB(STEP(FINODE)) = NCB + 1 + END IF + DO I = 1, NCV + JJ=IW(PTRIST(STEP(FINODE))+3+I+ KEEP(IXSZ) ) + DO K=1, NRHS + RHS(JJ,K)= RHS(JJ,K) + WCB(PTRY+I-1+(K-1)*NCV) + ENDDO + END DO + PTRICB(STEP(FINODE)) = + & PTRICB(STEP(FINODE)) - NCV + IF ( PTRICB( STEP( FINODE ) ) == 1 ) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + END IF + IF ( NSTK_S(STEP(FPERE)) .EQ. 0 ) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + IF ( LEAF > LPOOL ) THEN + WRITE(*,*) 'INTERNAL Error 41r: Pool is too small.' + CALL MUMPS_ABORT() + END IF + ENDIF + ELSE + 210 CONTINUE + CALL SMUMPS_78( NRHS, FINODE, FPERE, + & IW(PTRIST(STEP( FINODE )) + 2 + KEEP(IXSZ) ), NCV,NCV, + & IW(PTRIST(STEP(FINODE))+4+ KEEP(IXSZ) ), + & WCB( PTRY ), PDEST, ContVec, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL SMUMPS_303( .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 210 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = ( NCV + 4 ) * KEEP( 34 ) + + & NCV * KEEP( 35 ) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = ( NCV + 4 ) * KEEP( 34 ) + + & NCV * KEEP( 35 ) + END IF + END IF + PLEFTWCB = PLEFTWCB - NCV * NRHS + ELSEIF ( MSGTAG .EQ. TERREUR ) THEN + INFO(1) = -001 + INFO(2) = MSGSOU + GOTO 270 + ELSE IF ( (MSGTAG.EQ.UPDATE_LOAD).OR. + & (MSGTAG.EQ.TAG_DUMMY) ) THEN + GO TO 270 + ELSE + INFO(1)=-100 + INFO(2)=MSGTAG + GO TO 260 + ENDIF + GO TO 270 + 260 CONTINUE + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + 270 CONTINUE + RETURN + END SUBROUTINE SMUMPS_323 + SUBROUTINE SMUMPS_302( INODE, + & BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, + & N, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, + & IWCB, LIWCB, + & WCB, LWCB, A, LA, IW, LIW, + & RHS, LRHS, NRHS, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS, + & FILS, STEP, FRERE, DAD, + & MYROOT, + & INFO, KEEP,KEEP8, RHS_ROOT, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & RHSCOMPFREEPOS, BUILD_POSINRHSCOMP, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & + & ) + USE SMUMPS_OOC + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER MTYPE + INTEGER INODE, LBUFR, LBUFR_BYTES + INTEGER MSGTAG, MSGSOU, MYID, SLAVEF, COMM + INTEGER LIWCB, LWCB, LIW, POSWCB, PLEFTWCB, POSIWCB + INTEGER(8) :: LA + INTEGER N, LPOOL, III, LEAF, NBFIN + INTEGER MYROOT + INTEGER INFO( 40 ), KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER BUFR( LBUFR ) + INTEGER IPOOL( LPOOL ), NSTK_S(KEEP(28)) + INTEGER IWCB( LIWCB ), IW( LIW ) + INTEGER LRHS, NRHS + REAL WCB( LWCB ), A( LA ) + REAL RHS(LRHS, NRHS ), RHS_ROOT( * ) + INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER FILS( N ), STEP( N ), FRERE(KEEP(28)), DAD(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER POSINRHSCOMP(KEEP(28)), LRHSCOMP, RHSCOMPFREEPOS + REAL RHSCOMP(LRHSCOMP, NRHS) + LOGICAL BUILD_POSINRHSCOMP + EXTERNAL sgemv, strsv, sgemm, strsm, MUMPS_275 + INTEGER MUMPS_275 + REAL ALPHA,ONE,ZERO + PARAMETER (ZERO=0.0E0, ONE = 1.0E0, ALPHA=-1.0E0) + INTEGER(8) :: APOS, APOS1, APOS2, APOSOFF + INTEGER I, J, K, IPOS, NSLAVES, J1, J2, J3, FPERE, NPIV, NCB, + & IERR, IFR_ini, + & IFR, LIELL, JJ, + & NELIM, PLEFT, PCB_COURANT, PPIV_COURANT + INTEGER IPOSINRHSCOMP + INTEGER Effective_CB_Size, NUPDATE, ISLAVE, PDEST, FirstIndex + LOGICAL FLAG, OMP_FLAG + INCLUDE 'mumps_headers.h' + INTEGER POSWCB1,POSWCB2 + INTEGER(8) :: APOSDEB + INTEGER TempNROW, TempNCOL, PANEL_SIZE, LIWFAC, + & JFIN, NBJ, NUPDATE_PANEL, + & PPIV_PANEL, PCB_PANEL, NBK, TYPEF + INTEGER LD_WCBPIV + INTEGER LD_WCBCB + INTEGER LDAJ, LDAJ_FIRST_PANEL + INTEGER TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPANEL + LOGICAL MUST_BE_PERMUTED + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER DUMMY( 1 ) + IF ( INODE .eq. KEEP( 38 ) .OR. INODE .eq.KEEP( 20 ) ) THEN + LIELL = IW( PTRIST( STEP(INODE)) + 3 + KEEP(IXSZ)) + NPIV = LIELL + NELIM = 0 + NSLAVES = 0 + IPOS = PTRIST( STEP(INODE)) + 5 + KEEP(IXSZ) + ELSE + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + NELIM = IW(IPOS-1) + NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) ) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + IPOS = IPOS + 1 + IF (KEEP(201).GT.0) THEN + CALL SMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL SMUMPS_755( + & IW(IPOS+1+2*LIELL+1+NSLAVES), + & MUST_BE_PERMUTED ) + ENDIF + ENDIF + NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ)) + IPOS = IPOS + 1 + NSLAVES + END IF + IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN + J1 = IPOS + 1 + J2 = IPOS + LIELL + J3 = IPOS + NPIV + ELSE + J1 = IPOS + LIELL + 1 + J2 = IPOS + 2 * LIELL + J3 = IPOS + LIELL + NPIV + END IF + NCB = LIELL-NPIV + IF ( INODE .eq. KEEP( 38 ) .OR. INODE .eq. KEEP(20) ) THEN + IFR = 0 + DO JJ = J1, J3 + J = IW( JJ ) + IFR = IFR + 1 + DO K=1,NRHS + RHS_ROOT(IFR+NPIV*(K-1)) = RHS(J,K) + END DO + END DO + IF ( NPIV .LT. LIELL ) THEN + WRITE(*,*) ' Internal error in SOLVE_NODE for Root node' + CALL MUMPS_ABORT() + END IF + MYROOT = MYROOT - 1 + IF ( MYROOT .EQ. 0 ) THEN + NBFIN = NBFIN - 1 + IF (SLAVEF .GT. 1) THEN + DUMMY (1) = 1 + CALL SMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, + & COMM, RACINE_SOLVE, SLAVEF) + ENDIF + END IF + GO TO 270 + END IF + APOS = PTRFAC(STEP(INODE)) + IF (KEEP(201).EQ.1) THEN + IF (MTYPE.EQ.1) THEN + IF ((MTYPE.EQ.1).AND.NSLAVES.NE.0) THEN + TempNROW= NPIV+NELIM + TempNCOL= NPIV + LDAJ_FIRST_PANEL=TempNROW + ELSE + TempNROW= LIELL + TempNCOL= NPIV + LDAJ_FIRST_PANEL=TempNROW + ENDIF + TYPEF=TYPEF_L + ELSE + TempNCOL= LIELL + TempNROW= NPIV + LDAJ_FIRST_PANEL=TempNCOL + TYPEF= TYPEF_U + ENDIF + LIWFAC = IW(PTRIST(STEP(INODE))+XXI) + PANEL_SIZE = SMUMPS_690( LDAJ_FIRST_PANEL ) + ENDIF + PLEFT = PLEFTWCB + PPIV_COURANT = PLEFTWCB + PLEFTWCB = PLEFTWCB + LIELL * NRHS + IF ( POSWCB - PLEFTWCB + 1 .LT. 0 ) THEN + INFO(1) = -11 + INFO(2) = PLEFTWCB - POSWCB - 1 + GO TO 260 + END IF + IF (KEEP(201).EQ.1) THEN + LD_WCBPIV = LIELL + LD_WCBCB = LIELL + PCB_COURANT = PPIV_COURANT + NPIV + DO K=1, NRHS + IFR = PPIV_COURANT + (K-1)*LIELL - 1 + DO JJ = J1, J3 + J = IW(JJ) + IFR = IFR + 1 + WCB(IFR) = RHS(J,K) + ENDDO + IF (NCB.GT.0) THEN + DO JJ = J3+1, J2 + J = IW(JJ) + IFR = IFR + 1 + WCB(IFR) = RHS(J,K) + RHS (J,K) = ZERO + ENDDO + ENDIF + END DO + ELSE + LD_WCBPIV = NPIV + LD_WCBCB = NCB + PCB_COURANT = PPIV_COURANT + NPIV*NRHS + IFR = PPIV_COURANT - 1 + OMP_FLAG = NRHS.GT.4 + IFR_ini = IFR + DO 130 JJ = J1, J3 + J = IW(JJ) + IFR = IFR_ini + (JJ-J1) + 1 + DO K=1, NRHS + WCB(IFR+(K-1)*NPIV) = RHS(J,K) + END DO + 130 CONTINUE + IFR = PCB_COURANT - 1 + IF (NPIV .LT. LIELL) THEN + IFR_ini = IFR + DO 140 JJ = J3 + 1, J2 + J = IW(JJ) + IFR = IFR_ini + (JJ-J3) + DO K=1, NRHS + WCB(IFR+(K-1)*NCB) = RHS(J,K) + RHS(J,K)=ZERO + ENDDO + 140 CONTINUE + ENDIF + ENDIF + IF ( NPIV .NE. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + APOSDEB = APOS + J = 1 + IPANEL = 0 + 10 CONTINUE + IPANEL = IPANEL + 1 + JFIN = min(J+PANEL_SIZE-1, NPIV) + IF (IW(IPOS+ LIELL + JFIN) < 0) THEN + JFIN=JFIN+1 + ENDIF + NBJ = JFIN-J+1 + LDAJ = LDAJ_FIRST_PANEL-J+1 + IF ( (KEEP(50).NE.1).AND. MUST_BE_PERMUTED ) THEN + CALL SMUMPS_667(TYPEF, TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPOS+1+2*LIELL, IW, LIW) + IF (NPIV.EQ.(IW(I_PIVRPTR+IPANEL-1)-1)) THEN + MUST_BE_PERMUTED=.FALSE. + ELSE + CALL SMUMPS_698( + & IW( I_PIVR+ IW(I_PIVRPTR+IPANEL-1)- + & IW(I_PIVRPTR)), + & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, + & IW(I_PIVRPTR+IPANEL-1)-1, + & + & A(APOSDEB), + & LDAJ, NBJ, J-1 ) + ENDIF + ENDIF + NUPDATE_PANEL = LDAJ - NBJ + PPIV_PANEL = PPIV_COURANT+J-1 + PCB_PANEL = PPIV_PANEL+NBJ + APOS1 = APOSDEB+int(NBJ,8) + IF (MTYPE.EQ.1) THEN + IF ( NRHS == 1 ) THEN + CALL strsv( 'L', 'N', 'U', NBJ, A(APOSDEB), LDAJ, + & WCB(PPIV_PANEL), 1 ) + IF (NUPDATE_PANEL.GT.0) THEN + CALL sgemv('N', NUPDATE_PANEL,NBJ,ALPHA, A(APOS1), + & LDAJ, WCB(PPIV_PANEL), 1, ONE, + & WCB(PCB_PANEL), 1) + ENDIF + ELSE + CALL strsm( 'L','L','N','U', NBJ, NRHS, ONE, + & A(APOSDEB), LDAJ, WCB(PPIV_PANEL), + & LIELL ) + IF (NUPDATE_PANEL.GT.0) THEN + CALL sgemm('N', 'N', NUPDATE_PANEL, NRHS, NBJ, + & ALPHA, + & A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE, + & WCB(PCB_PANEL), LIELL) + ENDIF + ENDIF + ELSE + IF (NRHS == 1) THEN + CALL strsv( 'L', 'N', 'N', NBJ, A(APOSDEB), LDAJ, + & WCB(PPIV_PANEL), 1 ) + IF (NUPDATE_PANEL.GT.0) THEN + CALL sgemv('N',NUPDATE_PANEL, NBJ, ALPHA, A(APOS1), + & LDAJ, WCB(PPIV_PANEL), 1, + & ONE, WCB(PCB_PANEL), 1 ) + ENDIF + ELSE + CALL strsm('L','L','N','N',NBJ, NRHS, ONE, + & A(APOSDEB), LDAJ, WCB(PPIV_PANEL), + & LIELL) + IF (NUPDATE_PANEL.GT.0) THEN + CALL sgemm('N', 'N', NUPDATE_PANEL, NRHS, NBJ, + & ALPHA, + & A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE, + & WCB(PCB_PANEL), LIELL) + ENDIF + ENDIF + ENDIF + APOSDEB = APOSDEB+int(LDAJ,8)*int(NBJ,8) + J=JFIN+1 + IF ( J .LE. NPIV ) GOTO 10 + ELSE + IF (KEEP(50).NE.0) THEN + IF ( NRHS == 1 ) THEN + CALL strsv( 'U', 'T', 'U', NPIV, A(APOS), NPIV, + & WCB(PPIV_COURANT), 1 ) + ELSE + CALL strsm( 'L','U','T','U', NPIV, NRHS, ONE, + & A(APOS), NPIV, WCB(PPIV_COURANT), + & NPIV ) + ENDIF + ELSE + IF ( MTYPE .eq. 1 ) THEN + IF ( NRHS == 1) THEN + CALL strsv( 'U', 'T', 'U', NPIV, A(APOS), LIELL, + & WCB(PPIV_COURANT), 1 ) + ELSE + CALL strsm( 'L','U','T','U', NPIV, NRHS, ONE, + & A(APOS), LIELL, WCB(PPIV_COURANT), + & NPIV ) + ENDIF + ELSE + IF (NRHS == 1) THEN + CALL strsv( 'L', 'N', 'N', NPIV, A(APOS), LIELL, + & WCB(PPIV_COURANT), 1 ) + ELSE + CALL strsm('L','L','N','N',NPIV, NRHS, ONE, + & A(APOS), LIELL, WCB(PPIV_COURANT), + & NPIV) + ENDIF + END IF + END IF + END IF + END IF + NCB = LIELL - NPIV + IF ( MTYPE .EQ. 1 ) THEN + IF ( KEEP(50) .eq. 0 ) THEN + APOS1 = APOS + int(NPIV,8) * int(LIELL,8) + ELSE + APOS1 = APOS + int(NPIV,8) * int(NPIV,8) + END IF + IF ( NSLAVES .EQ. 0 .OR. NPIV .eq. 0 ) THEN + NUPDATE = NCB + ELSE + NUPDATE = NELIM + END IF + ELSE + APOS1 = APOS + int(NPIV,8) + NUPDATE = NCB + END IF + IF (KEEP(201).NE.1) THEN + IF ( NPIV .NE. 0 .AND. NUPDATE.NE.0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + IF ( NRHS == 1 ) THEN + CALL sgemv('T', NPIV, NUPDATE, ALPHA, A(APOS1), + & NPIV, WCB(PPIV_COURANT), 1, ONE, + & WCB(PCB_COURANT), 1) + ELSE + CALL sgemm('T', 'N', NUPDATE, NRHS, NPIV, ALPHA, + & A(APOS1), NPIV, WCB(PPIV_COURANT), NPIV, ONE, + & WCB(PCB_COURANT), NCB) + END IF + ELSE + IF ( NRHS == 1 ) THEN + CALL sgemv('N',NUPDATE, NPIV, ALPHA, A(APOS1), + & LIELL, WCB(PPIV_COURANT), 1, + & ONE, WCB(PCB_COURANT), 1 ) + ELSE + CALL sgemm('N', 'N', NUPDATE, NRHS, NPIV, ALPHA, + & A(APOS1), LIELL, WCB(PPIV_COURANT), NPIV, ONE, + & WCB(PCB_COURANT), NCB) + END IF + END IF + END IF + END IF + IF (BUILD_POSINRHSCOMP) THEN + POSINRHSCOMP(STEP(INODE)) = RHSCOMPFREEPOS + RHSCOMPFREEPOS = RHSCOMPFREEPOS + NPIV + ENDIF + IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + IF ( KEEP(50) .eq. 0 ) THEN + DO K=1,NRHS + IFR = PPIV_COURANT + (K-1)*LD_WCBPIV + RHSCOMP(IPOSINRHSCOMP:IPOSINRHSCOMP+NPIV-1, K) = + & WCB(IFR:IFR+NPIV-1) + ENDDO + ELSE + IFR = PPIV_COURANT - 1 + IF (KEEP(201).EQ.1) THEN + LDAJ = TempNROW + ELSE + LDAJ = NPIV + ENDIF + APOS1 = APOS + JJ = J1 + IF (KEEP(201).EQ.1) THEN + NBK = 0 + ENDIF + DO + IF(JJ .GT. J3) EXIT + IFR = IFR + 1 + IF(IW(JJ+LIELL) .GT. 0) THEN + DO K=1, NRHS + RHSCOMP(IPOSINRHSCOMP+JJ-J1 , K ) = + & WCB( IFR+(K-1)*LD_WCBPIV ) * A( APOS1 ) + END DO + IF (KEEP(201).EQ.1) THEN + NBK = NBK+1 + IF (NBK.EQ.PANEL_SIZE) THEN + NBK = 0 + LDAJ = LDAJ - PANEL_SIZE + ENDIF + ENDIF + APOS1 = APOS1 + int(LDAJ + 1,8) + JJ = JJ+1 + ELSE + IF (KEEP(201).EQ.1) THEN + NBK = NBK+1 + ENDIF + APOS2 = APOS1+int(LDAJ+1,8) + IF (KEEP(201).EQ.1) THEN + APOSOFF = APOS1+int(LDAJ,8) + ELSE + APOSOFF=APOS1+1_8 + ENDIF + DO K=1, NRHS + POSWCB1 = IFR+(K-1)*LD_WCBPIV + POSWCB2 = POSWCB1+1 + RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = WCB(POSWCB1)*A(APOS1) + & + WCB(POSWCB2)*A(APOSOFF) + RHSCOMP(IPOSINRHSCOMP+JJ-J1+1,K) = + & WCB(POSWCB1)*A(APOSOFF) + & + WCB(POSWCB2)*A(APOS2) + END DO + IF (KEEP(201).EQ.1) THEN + NBK = NBK+1 + IF (NBK.GE.PANEL_SIZE) THEN + LDAJ = LDAJ - NBK + NBK = 0 + ENDIF + ENDIF + APOS1 = APOS2 + int(LDAJ + 1,8) + JJ = JJ+2 + IFR = IFR+1 + ENDIF + ENDDO + END IF + IF (KEEP(201).GT.0) THEN + CALL SMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + END IF + FPERE = DAD(STEP(INODE)) + IF ( FPERE .EQ. 0 ) THEN + MYROOT = MYROOT - 1 + PLEFTWCB = PLEFTWCB - LIELL *NRHS + IF ( MYROOT .EQ. 0 ) THEN + NBFIN = NBFIN - 1 + IF (SLAVEF .GT. 1) THEN + DUMMY (1) = 1 + CALL SMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, + & COMM, RACINE_SOLVE, SLAVEF) + ENDIF + END IF + GO TO 270 + ENDIF + IF ( NUPDATE .NE. 0 .OR. NCB.eq.0 ) THEN + IF (MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .EQ. MYID) THEN + IF ( NCB .ne. 0 ) THEN + PTRICB(STEP(INODE)) = NCB + 1 + DO 190 I = 1, NUPDATE + DO K=1, NRHS + RHS( IW(J3 + I), K ) = RHS( IW(J3 + I), K ) + & + WCB(PCB_COURANT + I-1 +(K-1)*LD_WCBCB) + ENDDO + 190 CONTINUE + PTRICB(STEP( INODE )) = PTRICB(STEP( INODE )) - NUPDATE + IF ( PTRICB(STEP(INODE)) == 1 ) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF (NSTK_S(STEP(FPERE)) .EQ. 0) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + ENDIF + END IF + ELSE + PTRICB(STEP( INODE )) = -1 + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF (NSTK_S(STEP(FPERE)) .EQ. 0) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + ENDIF + ENDIF + ELSE + 210 CONTINUE + CALL SMUMPS_78( NRHS, INODE, FPERE, NCB, LD_WCBCB, + & NUPDATE, + & IW( J3 + 1 ), WCB( PCB_COURANT ), + & MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), SLAVEF), + & ContVec, + & COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL SMUMPS_303( .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 210 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = NUPDATE * KEEP( 35 ) + + & ( NUPDATE + 3 ) * KEEP( 34 ) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = NUPDATE * KEEP( 35 ) + + & ( NUPDATE + 3 ) * KEEP( 34 ) + GOTO 260 + END IF + ENDIF + END IF + IF ( NSLAVES .NE. 0 .AND. MTYPE .eq. 1 + & .and. NPIV .NE. 0 ) THEN + DO ISLAVE = 1, NSLAVES + PDEST = IW( PTRIST(STEP(INODE)) + 5 + ISLAVE +KEEP(IXSZ)) + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB - NELIM, + & NSLAVES, + & Effective_CB_Size, FirstIndex ) + 222 CALL SMUMPS_72( NRHS, + & INODE, FPERE, + & Effective_CB_Size, LD_WCBCB, LD_WCBPIV, NPIV, + & WCB( PCB_COURANT + NELIM + FirstIndex - 1 ), + & WCB( PPIV_COURANT ), + & PDEST, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL SMUMPS_303( .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 222 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = (NPIV+Effective_CB_Size)*NRHS*KEEP(35) + + & ( Effective_CB_Size + 4 ) * KEEP( 34 ) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = (NPIV+Effective_CB_Size)*NRHS*KEEP(35) + + & ( Effective_CB_Size + 4 ) * KEEP( 34 ) + GOTO 260 + END IF + END DO + END IF + PLEFTWCB = PLEFTWCB - LIELL*NRHS + 270 CONTINUE + RETURN + 260 CONTINUE + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE SMUMPS_302 + RECURSIVE SUBROUTINE SMUMPS_303( BLOQ, FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, PROCNODE_STEPS, + & RHS, LRHS + & ) + IMPLICIT NONE + LOGICAL BLOQ + INTEGER LBUFR, LBUFR_BYTES + INTEGER MYID, SLAVEF, COMM + INTEGER N, NRHS, LPOOL, III, LEAF, NBFIN + INTEGER LIWCB, LWCB, POSWCB, PLEFTWCB, POSIWCB + INTEGER LIW + INTEGER(8) :: LA + INTEGER INFO( 40 ), KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER BUFR( LBUFR ), IPOOL(LPOOL) + INTEGER NSTK_S( KEEP(28) ) + INTEGER IWCB( LIWCB ) + INTEGER IW( LIW ) + REAL WCB( LWCB ), A( LA ) + INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER LRHS + REAL RHS(LRHS, NRHS) + LOGICAL FLAG + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + INTEGER MSGSOU, MSGTAG, MSGLEN + FLAG = .FALSE. + IF ( BLOQ ) THEN + CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, + & COMM, STATUS, IERR ) + FLAG = .TRUE. + ELSE + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + END IF + IF ( FLAG ) THEN + MSGSOU = STATUS( MPI_SOURCE ) + MSGTAG = STATUS( MPI_TAG ) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) + IF ( MSGLEN .GT. LBUFR_BYTES ) THEN + INFO(1) = -20 + INFO(2) = MSGLEN + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + ELSE + CALL MPI_RECV( BUFR, LBUFR_BYTES, MPI_PACKED, + & MSGSOU, MSGTAG, COMM, STATUS, IERR ) + CALL SMUMPS_323( BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + END IF + END IF + RETURN + END SUBROUTINE SMUMPS_303 + SUBROUTINE SMUMPS_249(N, A, LA, IW, LIW, W, LWC, + & RHS, LRHS, NRHS, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & PTRICB, PTRACB, IWCB, LIWW, W2, + & NE_STEPS, NA, LNA, STEP, + & FRERE, DAD, FILS, IPOOL, LPOOL, PTRIST, PTRFAC, + & MYLEAF, INFO, + & PROCNODE_STEPS, + & SLAVEF, COMM,MYID, BUFR, LBUFR, LBUFR_BYTES, + & KEEP,KEEP8, RHS_ROOT, LRHS_ROOT, MTYPE, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, PANEL_POS, LPANEL_POS + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + USE SMUMPS_OOC + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER MTYPE + INTEGER(8) :: LA + INTEGER N,LIW,LIWW,LWC,LPOOL,LNA + INTEGER SLAVEF,MYLEAF,COMM,MYID + INTEGER LPANEL_POS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER NA(LNA),NE_STEPS(KEEP(28)) + INTEGER IPOOL(LPOOL) + INTEGER PANEL_POS(LPANEL_POS) + INTEGER INFO(40) + INTEGER PTRIST(KEEP(28)), + & PTRICB(KEEP(28)),PTRACB(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER LRHS, NRHS + REAL A(LA), RHS(LRHS,NRHS), W(LWC) + REAL W2(KEEP(133)) + INTEGER IW(LIW),IWCB(LIWW) + INTEGER STEP(N), FRERE(KEEP(28)),DAD(KEEP(28)),FILS(N) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR(LBUFR) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28)) + REAL RHSCOMP(LRHSCOMP,NRHS) + INTEGER LRHS_ROOT + REAL RHS_ROOT( LRHS_ROOT ) + INTEGER, intent(in) :: SIZE_TO_PROCESS + LOGICAL, intent(in) :: TO_PROCESS(SIZE_TO_PROCESS) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + LOGICAL FLAG + INTEGER POSIWCB,POSWCB,K + INTEGER(8) :: APOS, IST + INTEGER NPIV + INTEGER IPOS,LIELL,NELIM,IFR,JJ,I + INTEGER J1,J2,J,NCB,NBFINF + INTEGER NBLEAF,INODE,NBROOT,NROOT,NBFILS + INTEGER IN,IF,LONG,POOL_FIRST_POS,TMP + INTEGER III,IIPOOL,MYLEAFE + INTEGER NSLAVES + REAL ALPHA,ONE,ZERO + PARAMETER (ZERO=0.0E0, ONE = 1.0E0, ALPHA=-1.0E0) + LOGICAL BLOQ,DEBUT + INTEGER PROCDEST, DEST + INTEGER POSINDICES, IPOSINRHSCOMP + INTEGER DUMMY(1) + INTEGER PLEFTW, PTWCB + INTEGER Offset, EffectiveSize, ISLAVE, FirstIndex + LOGICAL LTLEVEL2, IN_SUBTREE + INTEGER TYPENODE + INCLUDE 'mumps_headers.h' + LOGICAL BLOCK_SEQUENCE + INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR + LOGICAL MUST_BE_PERMUTED + LOGICAL NO_CHILDREN + LOGICAL Exploit_Sparsity, AM1 + LOGICAL DEJA_SEND( 0:SLAVEF-1 ) + INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS + INTEGER LDAJ, NBJ, LIWFAC, + & NBJLAST, NPIV_LAST, PANEL_SIZE, + & PTWCB_PANEL, NCB_PANEL, TYPEF + INTEGER BEG_PANEL + LOGICAL TWOBYTWO + INTEGER NPANELS, IPANEL + LOGICAL MUMPS_170 + INTEGER MUMPS_330 + EXTERNAL sgemv, strsv, strsm, sgemm, + & MUMPS_330, + & MUMPS_170 + PLEFTW = 1 + POSIWCB = LIWW + POSWCB = LWC + NROOT = 0 + NBLEAF = NA(1) + NBROOT = NA(2) + DO I = NBROOT, 1, -1 + INODE = NA(NBLEAF+I+2) + IF (MUMPS_275(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) .EQ. MYID) THEN + NROOT = NROOT + 1 + IPOOL(NROOT) = INODE + ENDIF + END DO + III = 1 + IIPOOL = NROOT + 1 + BLOCK_SEQUENCE = .FALSE. + Exploit_Sparsity = .FALSE. + AM1 = .FALSE. + IF (KEEP(235).NE.0) Exploit_Sparsity = .TRUE. + IF (KEEP(237).NE.0) AM1 = .TRUE. + NO_CHILDREN = .FALSE. + IF (Exploit_Sparsity .OR. AM1) MYLEAF = -1 + IF (MYLEAF .EQ. -1) THEN + MYLEAF = 0 + DO I=1, NBLEAF + INODE=NA(I+2) + IF (MUMPS_275(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) .EQ. MYID) THEN + MYLEAF = MYLEAF + 1 + ENDIF + ENDDO + ENDIF + MYLEAFE=MYLEAF + NBFINF = SLAVEF + IF (MYLEAFE .EQ. 0) THEN + CALL SMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, FEUILLE, + & SLAVEF) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) THEN + GOTO 340 + ENDIF + ENDIF + 50 CONTINUE + BLOQ = ( ( III .EQ. IIPOOL ) + & ) + CALL SMUMPS_41( BLOQ, FLAG, BUFR, LBUFR, + & LBUFR_BYTES, MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO(1) .LT. 0 ) GOTO 340 + IF ( .NOT. FLAG ) THEN + IF (III .NE. IIPOOL) THEN + INODE = IPOOL(IIPOOL-1) + IIPOOL = IIPOOL - 1 + GO TO 60 + ENDIF + END IF + IF ( NBFINF .eq. 0 ) GOTO 340 + GOTO 50 + 60 CONTINUE + IF ( INODE .EQ. KEEP( 38 ) .OR. INODE .EQ. KEEP( 20 ) ) THEN + IPOS = PTRIST(STEP(INODE))+KEEP(IXSZ) + NPIV = IW(IPOS+3) + LIELL = IW(IPOS) + NPIV + IPOS = PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) + IF ( MTYPE .EQ. 1 .AND. KEEP(50) .EQ. 0) THEN + J1 = IPOS + LIELL + 1 + J2 = IPOS + LIELL + NPIV + ELSE + J1 = IPOS + 1 + J2 = IPOS + NPIV + END IF + IFR = 0 + DO JJ = J1, J2 + J = IW( JJ ) + IFR = IFR + 1 + DO K=1,NRHS + RHS(J,K) = RHS_ROOT(IFR+NPIV*(K-1)) + END DO + END DO + IN = INODE + 270 IN = FILS(IN) + IF (IN .GT. 0) GOTO 270 + IF (IN .EQ. 0) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL SMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + ENDIF + GOTO 50 + ENDIF + IF = -IN + LONG = NPIV + NBFILS = NE_STEPS(STEP(INODE)) + IF ( AM1 ) THEN + I = NBFILS + NBFILS = 0 + DO WHILE (I.GT.0) + IF ( TO_PROCESS(STEP(IF)) ) NBFILS = NBFILS+1 + IF = FRERE(STEP(IF)) + I = I -1 + ENDDO + IF (NBFILS.EQ.0) THEN + NO_CHILDREN = .TRUE. + ELSE + NO_CHILDREN = .FALSE. + ENDIF + IF = -IN + ENDIF + DEBUT = .TRUE. + DO I = 0, SLAVEF - 1 + DEJA_SEND( I ) = .FALSE. + END DO + POOL_FIRST_POS=IIPOOL + DO I = 1, NBFILS + IF ( AM1 ) THEN + 1030 IF ( .NOT.TO_PROCESS(STEP(IF)) ) THEN + IF = FRERE(STEP(IF)) + GOTO 1030 + ENDIF + NO_CHILDREN = .FALSE. + ENDIF + IF (MUMPS_275(PROCNODE_STEPS(STEP(IF)),SLAVEF) + & .EQ. MYID) THEN + IPOOL(IIPOOL) = IF + IIPOOL = IIPOOL + 1 + ELSE + PROCDEST = MUMPS_275(PROCNODE_STEPS(STEP(IF)), + & SLAVEF) + IF (.NOT. DEJA_SEND( PROCDEST )) THEN + 600 CALL SMUMPS_78( NRHS, IF, 0, 0, + & LONG, LONG, IW( J1 ), + & RHS_ROOT( 1 ), PROCDEST, + & NOEUD, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL SMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 340 + GOTO 600 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = LONG * KEEP(35) + + & ( LONG + 2 ) * KEEP(34) + GOTO 330 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = LONG * KEEP(35) + + & ( LONG + 2 ) * KEEP(34) + GOTO 330 + END IF + DEJA_SEND( PROCDEST ) = .TRUE. + END IF + IF ( IERR .NE. 0 ) CALL MUMPS_ABORT() + ENDIF + IF = FRERE(STEP(IF)) + ENDDO + IF (AM1 .AND.NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL SMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + GOTO 50 + ENDIF + ENDIF + IF (IIPOOL.NE.POOL_FIRST_POS) THEN + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + ENDIF + GOTO 50 + END IF + IN_SUBTREE = MUMPS_170( + & PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + TYPENODE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + LTLEVEL2= ( + & (TYPENODE .eq.2 ) .AND. + & (MTYPE.NE.1) ) + NPIV = IW(PTRIST(STEP(INODE))+2+KEEP(IXSZ)+1) + IF ((NPIV.NE.0).AND.(LTLEVEL2)) THEN + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + NELIM = IW(IPOS-1) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + NCB = LIELL - NPIV - NELIM + IPOS = IPOS + 2 + NSLAVES = IW( IPOS ) + Offset = 0 + IPOS = IPOS + NSLAVES + IW(PTRIST(STEP(INODE))+XXS)= C_FINI+NSLAVES + IF ( POSIWCB - 2 .LT. 0 .or. + & POSWCB - NCB*NRHS .LT. PLEFTW - 1 ) THEN + CALL SMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - NCB*NRHS .LT. PLEFTW - 1 ) THEN + INFO( 1 ) = -11 + INFO( 2 ) = NCB * NRHS - POSWCB - PLEFTW + 1 + GOTO 330 + END IF + IF ( POSIWCB - 2 .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = 2 - POSIWCB + GO TO 330 + END IF + END IF + POSIWCB = POSIWCB - 2 + POSWCB = POSWCB - NCB*NRHS + PTRICB(STEP( INODE )) = POSIWCB + 1 + PTRACB(STEP( INODE )) = POSWCB + 1 + IWCB( PTRICB(STEP( INODE )) ) = NCB + IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 + IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN + POSINDICES = IPOS + LIELL + 1 + ELSE + POSINDICES = IPOS + 1 + END IF + IF ( NCB.EQ.0 ) THEN + write(6,*) ' Internal Error type 2 node with no CB ' + CALL MUMPS_ABORT() + ENDIF + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN + J1 = IPOS + LIELL + NPIV + NELIM +1 + J2 = IPOS + 2 * LIELL + ELSE + J1 = IPOS + NPIV + NELIM +1 + J2 = IPOS + LIELL + END IF + IFR = PTRACB(STEP( INODE )) - 1 + DO JJ = J1, J2 - KEEP(253) + J = IW(JJ) + IFR = IFR + 1 + DO K=1, NRHS + W(IFR+(K-1)*NCB) = RHS(J,K) + ENDDO + ENDDO + IF (KEEP(252).NE.0) THEN + DO JJ = J2-KEEP(253)+1, J2 + IFR = IFR + 1 + DO K=1, NRHS + IF (K.EQ.JJ-J2+KEEP(253)) THEN + W(IFR+(K-1)*NCB) = ALPHA + ELSE + W(IFR+(K-1)*NCB) = ZERO + ENDIF + ENDDO + ENDDO + ENDIF + DO ISLAVE = 1, NSLAVES + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB, + & NSLAVES, + & EffectiveSize, + & FirstIndex ) + 500 DEST = IW( PTRIST(STEP(INODE))+5+ISLAVE+KEEP(IXSZ)) + CALL SMUMPS_63(NRHS, INODE, + & W(Offset+PTRACB(STEP(INODE))), EffectiveSize, + & NCB, DEST, + & BACKSLV_MASTER2SLAVE, + & COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL SMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, + & PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 340 + GOTO 500 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = EffectiveSize * KEEP(35) + + & 2 * KEEP(34) + GOTO 330 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = EffectiveSize * KEEP(35) + + & 2 * KEEP(34) + GOTO 330 + END IF + Offset = Offset + EffectiveSize + END DO + IWCB( PTRICB(STEP( INODE )) + 1 ) = 0 + CALL SMUMPS_151(NRHS,N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB,POSIWCB,PTRICB,PTRACB) + GOTO 50 + ENDIF + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + NELIM = IW(IPOS-1) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + IPOS = IPOS + 1 + IF (KEEP(201).GT.0) THEN + CALL SMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 330 + ENDIF + ENDIF + APOS = PTRFAC(IW(IPOS)) + NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) ) + IPOS = IPOS + 1 + NSLAVES + IF (KEEP(201).EQ.1) THEN + LIWFAC = IW(PTRIST(STEP(INODE))+XXI) + IF (MTYPE.NE.1) THEN + TYPEF = TYPEF_L + ELSE + TYPEF = TYPEF_U + ENDIF + PANEL_SIZE = SMUMPS_690( LIELL ) + IF (KEEP(50).NE.1) THEN + CALL SMUMPS_755( + & IW(IPOS+1+2*LIELL), + & MUST_BE_PERMUTED ) + ENDIF + ENDIF + LONG = 0 + IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN + J1 = IPOS + 1 + J2 = IPOS + NPIV + ELSE + J1 = IPOS + LIELL + 1 + J2 = IPOS + NPIV + LIELL + END IF + IF (IN_SUBTREE) THEN + PTWCB = PLEFTW + IF ( POSWCB .LT. LIELL*NRHS ) THEN + CALL SMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB .LT. LIELL*NRHS ) THEN + INFO(1) = -11 + INFO(2) = LIELL*NRHS - POSWCB + GOTO 330 + END IF + END IF + ELSE + IF ( POSIWCB - 2 .LT. 0 .or. + & POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + CALL SMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + INFO( 1 ) = -11 + INFO( 2 ) = LIELL * NRHS - POSWCB - PLEFTW + 1 + GOTO 330 + END IF + IF ( POSIWCB - 2 .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = 2 - POSIWCB + GO TO 330 + END IF + END IF + POSIWCB = POSIWCB - 2 + POSWCB = POSWCB - LIELL*NRHS + PTRICB(STEP( INODE )) = POSIWCB + 1 + PTRACB(STEP( INODE )) = POSWCB + 1 + IWCB( PTRICB(STEP( INODE )) ) = LIELL + IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 + IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN + POSINDICES = IPOS + LIELL + 1 + ELSE + POSINDICES = IPOS + 1 + END IF + PTWCB = PTRACB(STEP( INODE )) + ENDIF + IF (KEEP(252).EQ.0) IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + DO K=1, NRHS + IF (KEEP(252).NE.0) THEN + DO JJ = J1, J2 + W(PTWCB+JJ-J1+(K-1)*LIELL) = ZERO + ENDDO + ELSE + DO JJ = J1, J2 + W(PTWCB+JJ-J1+(K-1)*LIELL) = RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + ENDDO + ENDIF + END DO + IFR = PTWCB + NPIV - 1 + IF ( LIELL .GT. NPIV ) THEN + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN + J1 = IPOS + LIELL + NPIV + 1 + J2 = IPOS + 2 * LIELL + ELSE + J1 = IPOS + NPIV + 1 + J2 = IPOS + LIELL + END IF + DO JJ = J1, J2-KEEP(253) + J = IW(JJ) + IFR = IFR + 1 + DO K=1, NRHS + W(IFR+(K-1)*LIELL) = RHS(J,K) + ENDDO + ENDDO + IF (KEEP(252).NE.0) THEN + DO JJ = J2-KEEP(253)+1, J2 + IFR = IFR + 1 + DO K=1, NRHS + IF (K.EQ.JJ-J2+KEEP(253)) THEN + W(IFR+(K-1)*LIELL) = ALPHA + ELSE + W(IFR+(K-1)*LIELL) = ZERO + ENDIF + ENDDO + ENDDO + ENDIF + NCB = LIELL - NPIV + IF (NPIV .EQ. 0) GOTO 160 + ENDIF + IF (KEEP(201).EQ.1) THEN + J = NPIV / PANEL_SIZE + TWOBYTWO = KEEP(50).EQ.2 .AND. + & ((TYPENODE.EQ.1.AND.KEEP(103).GT.0) .OR. + & (TYPENODE.EQ.2.AND.KEEP(105).GT.0)) + IF (TWOBYTWO) THEN + CALL SMUMPS_641(PANEL_SIZE, PANEL_POS, LPANEL_POS, + & IW(IPOS+1+LIELL), NPIV, NPANELS, LIELL, + & NBENTRIES_ALLPANELS) + ELSE + IF (NPIV.EQ.J*PANEL_SIZE) THEN + NPIV_LAST = NPIV + NBJLAST = PANEL_SIZE + NPANELS = J + ELSE + NPIV_LAST = (J+1)* PANEL_SIZE + NBJLAST = NPIV-J*PANEL_SIZE + NPANELS = J+1 + ENDIF + NBENTRIES_ALLPANELS = + & int(LIELL,8) * int(NPIV,8) + & - int( ( J * ( J - 1 ) ) / 2,8 ) + & * int(PANEL_SIZE,8) * int(PANEL_SIZE,8) + & - int(J,8) + & * int(mod(NPIV, PANEL_SIZE),8) + & * int(PANEL_SIZE,8) + JJ=NPIV_LAST + ENDIF + APOSDEB = APOS + NBENTRIES_ALLPANELS + DO IPANEL = NPANELS, 1, -1 + IF (TWOBYTWO) THEN + NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL) + BEG_PANEL = PANEL_POS(IPANEL) + ELSE + IF (JJ.EQ.NPIV_LAST) THEN + NBJ = NBJLAST + ELSE + NBJ = PANEL_SIZE + ENDIF + BEG_PANEL = JJ- PANEL_SIZE+1 + ENDIF + LDAJ = LIELL-BEG_PANEL+1 + APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8) + PTWCB_PANEL = PTWCB + BEG_PANEL - 1 + NCB_PANEL = LDAJ - NBJ + IF (KEEP(50).NE.1 .AND. MUST_BE_PERMUTED) THEN + CALL SMUMPS_667(TYPEF, TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW) + IF (NPIV.EQ.(IW(I_PIVRPTR)-1)) THEN + MUST_BE_PERMUTED=.FALSE. + ELSE + CALL SMUMPS_698( + & IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)), + & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, + & IW(I_PIVRPTR+IPANEL-1)-1, + & A(APOSDEB), + & LDAJ, NBJ, BEG_PANEL-1) + ENDIF + ENDIF + IF ( NRHS == 1 ) THEN + IF (NCB_PANEL.NE.0) THEN + CALL sgemv( 'T', NCB_PANEL, NBJ, ALPHA, + & A( APOSDEB + int(NBJ,8) ), LDAJ, + & W( NBJ + PTWCB_PANEL ), + & 1, ONE, + & W(PTWCB_PANEL), 1 ) + ENDIF + IF (MTYPE.NE.1) THEN + CALL strsv('L','T','U', NBJ, A(APOSDEB), LDAJ, + & W(PTWCB_PANEL), 1) + ELSE + CALL strsv('L','T','N', NBJ, A(APOSDEB), LDAJ, + & W(PTWCB_PANEL), 1) + ENDIF + ELSE + IF (NCB_PANEL.NE.0) THEN + CALL sgemm( 'T', 'N', NBJ, NRHS, NCB_PANEL, ALPHA, + & A(APOSDEB +int(NBJ,8)), LDAJ, + & W(NBJ+PTWCB_PANEL),LIELL, + & ONE, W(PTWCB_PANEL),LIELL) + ENDIF + IF (MTYPE.NE.1) THEN + CALL strsm('L','L','T','U',NBJ, NRHS, ONE, + & A(APOSDEB), + & LDAJ, W(PTWCB_PANEL), LIELL) + ELSE + CALL strsm('L','L','T','N',NBJ, NRHS, ONE, + & A(APOSDEB), + & LDAJ, W(PTWCB_PANEL), LIELL) + ENDIF + ENDIF + IF (.NOT. TWOBYTWO) JJ=BEG_PANEL-1 + ENDDO + ENDIF + IF (KEEP(201).EQ.0.OR.KEEP(201).EQ.2)THEN + IF ( LIELL .GT. NPIV ) THEN + IF ( MTYPE .eq. 1 ) THEN + IST = APOS + int(NPIV,8) + IF (NRHS == 1) THEN + CALL sgemv( 'T', NCB, NPIV, ALPHA, A(IST), LIELL, + & W(NPIV + PTWCB), 1, + & ONE, + & W(PTWCB), 1 ) + ELSE + CALL sgemm('T','N', NPIV, NRHS, NCB, ALPHA, A(IST), LIELL, + & W(NPIV+PTWCB), LIELL, ONE, + & W(PTWCB), LIELL) + ENDIF + ELSE + IF ( KEEP(50) .eq. 0 ) THEN + IST = APOS + int(NPIV,8) * int(LIELL,8) + ELSE + IST = APOS + int(NPIV,8) * int(NPIV,8) + END IF + IF ( NRHS == 1 ) THEN + CALL sgemv( 'N', NPIV, NCB, ALPHA, A( IST ), NPIV, + & W( NPIV + PTWCB ), + & 1, ONE, + & W(PTWCB), 1 ) + ELSE + CALL sgemm( 'N', 'N', NPIV, NRHS, NCB, ALPHA, + & A(IST), NPIV, W(NPIV+PTWCB),LIELL, + & ONE, W(PTWCB),LIELL) + END IF + END IF + ENDIF + IF ( MTYPE .eq. 1 ) THEN + IF ( NRHS == 1 ) THEN + CALL strsv('L', 'T', 'N', NPIV, A(APOS), LIELL, + & W(PTWCB), 1) + ELSE + CALL strsm('L','L','T','N', NPIV, NRHS, ONE, A(APOS), + & LIELL, W(PTWCB), LIELL) + ENDIF + ELSE + IF ( KEEP(50) .EQ. 0 ) THEN + IF ( NRHS == 1 ) THEN + CALL strsv('U','N','U', NPIV, A(APOS), LIELL, + & W(PTWCB), 1) + ELSE + CALL strsm('L','U','N','U', NPIV, NRHS, ONE, A(APOS), + & LIELL,W(PTWCB),LIELL) + END IF + ELSE + IF ( NRHS == 1 ) THEN + CALL strsv('U','N','U', NPIV, A(APOS), NPIV, + & W(PTWCB), 1) + ELSE + CALL strsm('L','U','N','U',NPIV, NRHS, ONE, A(APOS), + & NPIV, W(PTWCB), LIELL) + END IF + END IF + END IF + ENDIF + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0) THEN + J1 = IPOS + LIELL + 1 + ELSE + J1 = IPOS + 1 + END IF + DO 150 I = 1, NPIV + JJ = IW(J1 + I - 1) + DO K=1, NRHS + RHS(JJ, K) = W(PTWCB+I-1+(K-1)*LIELL) + ENDDO + 150 CONTINUE + 160 CONTINUE + IF (KEEP(201).GT.0) THEN + CALL SMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 330 + ENDIF + ENDIF + IN = INODE + 170 IN = FILS(IN) + IF (IN .GT. 0) GOTO 170 + IF (IN .EQ. 0) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL SMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + ENDIF + GOTO 50 + ENDIF + IF = -IN + NBFILS = NE_STEPS(STEP(INODE)) + IF (AM1) THEN + I = NBFILS + NBFILS = 0 + DO WHILE (I.GT.0) + IF ( TO_PROCESS(STEP(IF)) ) NBFILS = NBFILS+1 + IF = FRERE(STEP(IF)) + I = I -1 + ENDDO + IF (NBFILS.EQ.0) THEN + NO_CHILDREN = .TRUE. + ELSE + NO_CHILDREN = .FALSE. + ENDIF + IF = -IN + ENDIF + IF (IN_SUBTREE) THEN + DO I = 1, NBFILS + IF ( AM1 ) THEN + 1010 IF ( .NOT.TO_PROCESS(STEP(IF)) ) THEN + IF = FRERE(STEP(IF)) + GOTO 1010 + ENDIF + NO_CHILDREN = .FALSE. + ENDIF + IPOOL((IIPOOL-I+1)+NBFILS-I) = IF + IIPOOL = IIPOOL + 1 + IF = FRERE(STEP(IF)) + ENDDO + IF (AM1 .AND. NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL SMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + GOTO 50 + ENDIF + ENDIF + ELSE + DEBUT = .TRUE. + DO I = 0, SLAVEF - 1 + DEJA_SEND( I ) = .FALSE. + END DO + POOL_FIRST_POS=IIPOOL + DO 190 I = 1, NBFILS + IF ( AM1 ) THEN +1020 IF ( .NOT.TO_PROCESS(STEP(IF)) ) THEN + IF = FRERE(STEP(IF)) + GOTO 1020 + ENDIF + NO_CHILDREN = .FALSE. + ENDIF + IF (MUMPS_275(PROCNODE_STEPS(STEP(IF)), + & SLAVEF) .EQ. MYID) THEN + IPOOL(IIPOOL) = IF + IIPOOL = IIPOOL + 1 + IF = FRERE(STEP(IF)) + ELSE + PROCDEST = MUMPS_275(PROCNODE_STEPS(STEP(IF)),SLAVEF) + IF (.not. DEJA_SEND( PROCDEST )) THEN + 400 CONTINUE + CALL SMUMPS_78( NRHS, IF, 0, 0, LIELL, + & LIELL - KEEP(253), + & IW( POSINDICES ), + & W ( PTRACB(STEP( INODE ))), PROCDEST, + & NOEUD, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL SMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 340 + GOTO 400 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 330 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 330 + END IF + DEJA_SEND( PROCDEST ) = .TRUE. + END IF + IF = FRERE(STEP(IF)) + ENDIF + 190 CONTINUE + IF (AM1 .AND. NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL SMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + GOTO 50 + ENDIF + ENDIF + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + IWCB(PTRICB(STEP(INODE))+1) = IWCB(PTRICB(STEP(INODE))+1)-1 + CALL SMUMPS_151(NRHS,N, KEEP(28), IWCB, LIWW, + & W, LWC, + & POSWCB,POSIWCB,PTRICB,PTRACB) + ENDIF + GOTO 50 + 330 CONTINUE + CALL SMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, TERREUR, + & SLAVEF) + 340 CONTINUE + CALL SMUMPS_150( MYID,COMM,BUFR, + & LBUFR,LBUFR_BYTES ) + RETURN + END SUBROUTINE SMUMPS_249 + RECURSIVE SUBROUTINE SMUMPS_41( + & BLOQ, FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, RHS, + & LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IMPLICIT NONE + LOGICAL BLOQ, FLAG + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER MYID, SLAVEF, COMM + INTEGER N, LIWW + INTEGER IWCB( LIWW ) + INTEGER LWC + REAL W( LWC ) + INTEGER POSIWCB, POSWCB + INTEGER IIPOOL, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER LPANEL_POS + INTEGER PANEL_POS( LPANEL_POS ) + INTEGER NBFINF, INFO(40) + INTEGER PLEFTW, KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER PTRICB(KEEP(28)), PTRACB(KEEP(28)), STEP( N ), FILS( N ) + INTEGER LIW + INTEGER(8) :: LA + INTEGER PTRIST(KEEP(28)), IW( LIW ) + INTEGER (8) :: PTRFAC(KEEP(28)) + REAL A( LA ), W2( KEEP(133) ) + INTEGER LRHS, NRHS + REAL RHS(LRHS, NRHS) + INTEGER MYLEAFE, MTYPE + INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28)) + REAL RHSCOMP(LRHSCOMP,NRHS) + INTEGER SIZE_TO_PROCESS + LOGICAL TO_PROCESS(SIZE_TO_PROCESS) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER MSGSOU, MSGTAG, MSGLEN + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + FLAG = .FALSE. + IF ( BLOQ ) THEN + CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, + & COMM, STATUS, IERR ) + FLAG = .TRUE. + ELSE + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + END IF + IF (FLAG) THEN + MSGSOU=STATUS(MPI_SOURCE) + MSGTAG=STATUS(MPI_TAG) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) + IF ( MSGLEN .GT. LBUFR_BYTES ) THEN + INFO(1) = -20 + INFO(2) = MSGLEN + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + ELSE + CALL MPI_RECV(BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU, + & MSGTAG, COMM, STATUS, IERR) + CALL SMUMPS_42( MSGTAG, MSGSOU, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, + & KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + END IF + END IF + RETURN + END SUBROUTINE SMUMPS_41 + RECURSIVE SUBROUTINE SMUMPS_42( + & MSGTAG, MSGSOU, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + USE SMUMPS_OOC + USE SMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER MSGTAG, MSGSOU + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER MYID, SLAVEF, COMM + INTEGER N, LIWW + INTEGER IWCB( LIWW ) + INTEGER LWC + REAL W( LWC ) + INTEGER POSIWCB, POSWCB + INTEGER IIPOOL, LPOOL, LPANEL_POS + INTEGER IPOOL( LPOOL ) + INTEGER PANEL_POS( LPANEL_POS ) + INTEGER NBFINF, INFO(40) + INTEGER PLEFTW, KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER PTRICB(KEEP(28)), PTRACB(KEEP(28)), STEP( N ), FILS( N ) + INTEGER FRERE(KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER LIW + INTEGER(8) :: LA + INTEGER IW( LIW ), PTRIST( KEEP(28) ) + INTEGER(8) :: PTRFAC(KEEP(28)) + REAL A( LA ), W2( KEEP(133) ) + INTEGER LRHS, NRHS + REAL RHS(LRHS, NRHS) + INTEGER MYLEAFE, MTYPE + INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28)) + REAL RHSCOMP(LRHSCOMP,NRHS) + INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR + LOGICAL MUST_BE_PERMUTED + INTEGER SIZE_TO_PROCESS + LOGICAL TO_PROCESS(SIZE_TO_PROCESS), NO_CHILDREN + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER POSITION, IF, INODE, IERR, LONG, DUMMY(1) + INTEGER P_UPDATE, P_SOL_MAS, LIELL, K + INTEGER(8) :: APOS, IST + INTEGER NPIV, NROW_L, IPOS, NROW_RECU + INTEGER I, JJ, IN, PROCDEST, J1, J2, IFR, LDA + INTEGER NSLAVES, NELIM, J, POSINDICES, INODEPOS, + & IPOSINRHSCOMP + LOGICAL FLAG + REAL ZERO, ALPHA, ONE + PARAMETER (ZERO=0.0E0, ONE = 1.0E0, ALPHA=-1.0E0) + INCLUDE 'mumps_headers.h' + INTEGER POOL_FIRST_POS, TMP + LOGICAL DEJA_SEND( 0:SLAVEF-1 ) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275, strsv, strsm, sgemv, sgemm + INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS + INTEGER LDAJ, NBJ, LIWFAC, + & NBJLAST, NPIV_LAST, PANEL_SIZE, + & PTWCB_PANEL, NCB_PANEL, TYPEF + LOGICAL TWOBYTWO + INTEGER BEG_PANEL + INTEGER IPANEL, NPANELS + IF (MSGTAG .EQ. FEUILLE) THEN + NBFINF = NBFINF - 1 + ELSE IF (MSGTAG .EQ. NOEUD) THEN + POSITION = 0 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & INODE, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & LONG, 1, MPI_INTEGER, + & COMM, IERR) + IF ( POSIWCB - LONG - 2 .LT. 0 + & .OR. POSWCB - PLEFTW + 1 .LT. LONG ) THEN + CALL SMUMPS_95(NRHS, N, KEEP(28), IWCB, + & LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ((POSIWCB - LONG - 2 ) .LT. 0) THEN + INFO(1)=-14 + INFO(2)=-POSIWCB + LONG + 2 + WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' + GOTO 260 + END IF + IF ( POSWCB - PLEFTW + 1 .LT. LONG ) THEN + INFO(1) = -11 + INFO(2) = LONG + PLEFTW - POSWCB - 1 + WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' + GOTO 260 + END IF + ENDIF + POSIWCB = POSIWCB - LONG + POSWCB = POSWCB - LONG + IF (LONG .GT. 0) THEN + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IWCB(POSIWCB + 1), + & LONG, MPI_INTEGER, COMM, IERR) + DO K=1,NRHS + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & W(POSWCB + 1), LONG, + & MPI_REAL, COMM, IERR) + DO JJ=0, LONG-1 + RHS(IWCB(POSIWCB+1+JJ),K) = W(POSWCB+1+JJ) + ENDDO + ENDDO + POSIWCB = POSIWCB + LONG + POSWCB = POSWCB + LONG + ENDIF + POOL_FIRST_POS = IIPOOL + IF ( KEEP(237).GT. 0 ) THEN + IF (.NOT.TO_PROCESS(STEP(INODE))) + & GOTO 1010 + ENDIF + IPOOL( IIPOOL ) = INODE + IIPOOL = IIPOOL + 1 + 1010 CONTINUE + IF = FRERE( STEP(INODE) ) + DO WHILE ( IF .GT. 0 ) + IF ( MUMPS_275(PROCNODE_STEPS(STEP(IF)), + & SLAVEF) .eq. MYID ) THEN + IF ( KEEP(237).GT. 0 ) THEN + IF (.NOT.TO_PROCESS(STEP(IF))) THEN + IF = FRERE(STEP(IF)) + CYCLE + ENDIF + ENDIF + IPOOL( IIPOOL ) = IF + IIPOOL = IIPOOL + 1 + END IF + IF = FRERE( STEP( IF ) ) + END DO + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + ELSE IF ( MSGTAG .EQ. BACKSLV_MASTER2SLAVE ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NROW_RECU, 1, MPI_INTEGER, COMM, IERR ) + IPOS = PTRIST( STEP(INODE) ) + KEEP(IXSZ) + NPIV = - IW( IPOS ) + NROW_L = IW( IPOS + 1 ) + IF (KEEP(201).GT.0) THEN + CALL SMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + APOS = PTRFAC(IW( IPOS + 3 )) + IF ( NROW_L .NE. NROW_RECU ) THEN + WRITE(*,*) 'Error1 in 41S : NROW L/RECU=',NROW_L, NROW_RECU + CALL MUMPS_ABORT() + END IF + LONG = NROW_L + NPIV + IF ( POSWCB - LONG*NRHS .LT. PLEFTW - 1 ) THEN + CALL SMUMPS_95(NRHS, N, KEEP(28), IWCB, + & LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - LONG*NRHS .LT. PLEFTW - 1 ) THEN + INFO(1) = -11 + INFO(2) = LONG * NRHS- POSWCB + WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' + GOTO 260 + END IF + END IF + P_UPDATE = PLEFTW + P_SOL_MAS = PLEFTW + NPIV * NRHS + PLEFTW = P_SOL_MAS + NROW_L * NRHS + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & W( P_SOL_MAS+(K-1)*NROW_L),NROW_L, + & MPI_REAL, + & COMM, IERR ) + ENDDO + IF (KEEP(201).EQ.1) THEN + IF ( NRHS == 1 ) THEN + CALL sgemv( 'T', NROW_L, NPIV, ALPHA, A( APOS ), NROW_L, + & W( P_SOL_MAS ), 1, ZERO, + & W( P_UPDATE ), 1 ) + ELSE + CALL sgemm( 'T', 'N', NPIV, NRHS, NROW_L, ALPHA, A(APOS), + & NROW_L, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ), + & NPIV ) + ENDIF + ELSE + IF ( NRHS == 1 ) THEN + CALL sgemv( 'N', NPIV, NROW_L, ALPHA, A( APOS ), NPIV, + & W( P_SOL_MAS ), 1, ZERO, + & W( P_UPDATE ), 1 ) + ELSE + CALL sgemm( 'N', 'N', NPIV, NRHS, NROW_L, ALPHA, A(APOS), + & NPIV, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ), + & NPIV ) + END IF + ENDIF + IF (KEEP(201).GT.0) THEN + CALL SMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + PLEFTW = PLEFTW - NROW_L * NRHS + 100 CONTINUE + CALL SMUMPS_63( NRHS, INODE, W(P_UPDATE), + & NPIV, NPIV, + & MSGSOU, + & BACKSLV_UPDATERHS, + & COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL SMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 100 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 260 + END IF + PLEFTW = PLEFTW - NPIV * NRHS + ELSE IF ( MSGTAG .EQ. BACKSLV_UPDATERHS ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE, 1, MPI_INTEGER, COMM, IERR ) + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NPIV, 1, MPI_INTEGER, COMM, IERR ) + NELIM = IW(IPOS-1) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + IPOS = IPOS + 1 + NSLAVES = IW( IPOS + 1 ) + IPOS = IPOS + 1 + NSLAVES + INODEPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 4 + IF ( KEEP(50) .eq. 0 ) THEN + LDA = LIELL + ELSE + LDA = NPIV + ENDIF + IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN + J1 = IPOS + 1 + J2 = IPOS + NPIV + ELSE + J1 = IPOS + LIELL + 1 + J2 = IPOS + NPIV + LIELL + END IF + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & W2, NPIV, MPI_REAL, + & COMM, IERR ) + IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + I = 1 + IF ( (KEEP(253).NE.0) .AND. + & (IW(PTRIST(STEP(INODE))+XXS).EQ.C_FINI+NSLAVES) + & ) THEN + DO JJ = J1,J2 + RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = W2(I) + I = I+1 + ENDDO + ELSE + DO JJ = J1,J2 + RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = + & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + W2(I) + I = I+1 + ENDDO + ENDIF + ENDDO + IW(PTRIST(STEP(INODE))+XXS) = + & IW(PTRIST(STEP(INODE))+XXS) - 1 + IF ( IW(PTRIST(STEP(INODE))+XXS).EQ.C_FINI ) THEN + IF (KEEP(201).GT.0) THEN + CALL SMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL SMUMPS_755( + & IW(IPOS+1+2*LIELL), + & MUST_BE_PERMUTED ) + ENDIF + ENDIF + APOS = PTRFAC(IW(INODEPOS)) + IF (KEEP(201).EQ.1) THEN + LIWFAC = IW(PTRIST(STEP(INODE))+XXI) + TYPEF = TYPEF_L + NROW_L = NPIV+NELIM + PANEL_SIZE = SMUMPS_690(NROW_L) + IF (PANEL_SIZE.LT.0) THEN + WRITE(6,*) ' Internal error in bwd solve PANEL_SIZE=', + & PANEL_SIZE + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF ( POSIWCB - 2 .LT. 0 .or. + & POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + CALL SMUMPS_95( NRHS, N, KEEP(28), IWCB, + & LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + INFO( 1 ) = -11 + INFO( 2 ) = LIELL * NRHS - POSWCB - PLEFTW + 1 + GOTO 260 + END IF + IF ( POSIWCB - 2 .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = 2 - POSIWCB + GO TO 260 + END IF + END IF + POSIWCB = POSIWCB - 2 + POSWCB = POSWCB - LIELL*NRHS + PTRICB(STEP( INODE )) = POSIWCB + 1 + PTRACB(STEP( INODE )) = POSWCB + 1 + IWCB( PTRICB(STEP( INODE )) ) = LIELL + IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 + IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 5 + NSLAVES + IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN + POSINDICES = IPOS + LIELL + 1 + ELSE + POSINDICES = IPOS + 1 + END IF + IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + IFR = PTRACB(STEP( INODE )) + DO K=1, NRHS + DO JJ = J1, J2 + W(IFR+JJ-J1+(K-1)*LIELL) = + & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + ENDDO + END DO + IFR = PTRACB(STEP(INODE))-1+NPIV + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN + J1 = IPOS + LIELL + NPIV + 1 + J2 = IPOS + 2 * LIELL + ELSE + J1 = IPOS + NPIV + 1 + J2 = IPOS + LIELL + END IF + DO JJ = J1, J2-KEEP(253) + J = IW(JJ) + IFR = IFR + 1 + DO K=1, NRHS + W(IFR+(K-1)*LIELL) = RHS(J,K) + ENDDO + ENDDO + IF ( KEEP(201).EQ.1 .AND. + & (( NELIM .GT. 0 ).OR. (MTYPE.NE.1 ))) THEN + J = NPIV / PANEL_SIZE + TWOBYTWO = KEEP(50).EQ.2 .AND. KEEP(105).GT.0 + IF (TWOBYTWO) THEN + CALL SMUMPS_641(PANEL_SIZE, PANEL_POS, + & LPANEL_POS, IW(IPOS+1+LIELL), NPIV, NPANELS, + & NROW_L, NBENTRIES_ALLPANELS) + ELSE + IF (NPIV.EQ.J*PANEL_SIZE) THEN + NPIV_LAST = NPIV + NBJLAST = PANEL_SIZE + NPANELS = J + ELSE + NPIV_LAST = (J+1)* PANEL_SIZE + NBJLAST = NPIV-J*PANEL_SIZE + NPANELS = J+1 + ENDIF + NBENTRIES_ALLPANELS = + & int(NROW_L,8) * int(NPIV,8) + & - int( ( J * ( J - 1 ) ) / 2,8 ) + & * int(PANEL_SIZE,8) * int(PANEL_SIZE,8) + & - int(J,8) + & * int(mod(NPIV, PANEL_SIZE),8) + & * int(PANEL_SIZE,8) + JJ=NPIV_LAST + ENDIF + APOSDEB = APOS + NBENTRIES_ALLPANELS + DO IPANEL=NPANELS,1,-1 + IF (TWOBYTWO) THEN + NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL) + BEG_PANEL = PANEL_POS(IPANEL) + ELSE + IF (JJ.EQ.NPIV_LAST) THEN + NBJ = NBJLAST + ELSE + NBJ = PANEL_SIZE + ENDIF + BEG_PANEL = JJ- PANEL_SIZE+1 + ENDIF + LDAJ = NROW_L-BEG_PANEL+1 + APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8) + PTWCB_PANEL = PTRACB(STEP(INODE)) + BEG_PANEL - 1 + NCB_PANEL = LDAJ - NBJ + IF (KEEP(50).NE.1 .AND.MUST_BE_PERMUTED) THEN + CALL SMUMPS_667(TYPEF, TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW) + CALL SMUMPS_698( + & IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)), + & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, + & IW(I_PIVRPTR+IPANEL-1)-1, + & A(APOSDEB), + & LDAJ, NBJ, BEG_PANEL-1) + ENDIF + IF ( NRHS == 1 ) THEN + IF (NCB_PANEL.NE.0) THEN + CALL sgemv( 'T', NCB_PANEL, NBJ, ALPHA, + & A( APOSDEB + int(NBJ,8) ), LDAJ, + & W( NBJ + PTWCB_PANEL ), + & 1, ONE, + & W(PTWCB_PANEL), 1 ) + ENDIF + CALL strsv('L','T','U', NBJ, A(APOSDEB), LDAJ, + & W(PTWCB_PANEL), 1) + ELSE + IF (NCB_PANEL.NE.0) THEN + CALL sgemm( 'T', 'N', NBJ, NRHS, NCB_PANEL, ALPHA, + & A(APOSDEB + int(NBJ,8)), LDAJ, + & W(NBJ+PTWCB_PANEL),LIELL, + & ONE, W(PTWCB_PANEL),LIELL) + ENDIF + CALL strsm('L','L','T','U',NBJ, NRHS, ONE, + & A(APOSDEB), + & LDAJ, W(PTWCB_PANEL), LIELL) + ENDIF + IF (.NOT. TWOBYTWO) JJ=BEG_PANEL-1 + ENDDO + GOTO 1234 + ENDIF + IF (NELIM .GT.0) THEN + IF ( KEEP(50) .eq. 0 ) THEN + IST = APOS + int(NPIV,8) * int(LIELL,8) + ELSE + IST = APOS + int(NPIV,8) * int(NPIV,8) + END IF + IF ( NRHS == 1 ) THEN + CALL sgemv( 'N', NPIV, NELIM, ALPHA, + & A( IST ), NPIV, + & W( NPIV + PTRACB(STEP(INODE)) ), + & 1, ONE, + & W(PTRACB(STEP(INODE))), 1 ) + ELSE + CALL sgemm( 'N', 'N', NPIV, NRHS, NELIM, ALPHA, + & A(IST), NPIV, W(NPIV+PTRACB(STEP(INODE))),LIELL, + & ONE, W(PTRACB(STEP(INODE))),LIELL) + END IF + ENDIF + IF ( NRHS == 1 ) THEN + CALL strsv( 'U', 'N', 'U', NPIV, A(APOS), LDA, + & W(PTRACB(STEP(INODE))),1) + ELSE + CALL strsm( 'L','U', 'N', 'U', NPIV, NRHS, ONE, + & A(APOS), LDA, + & W(PTRACB(STEP(INODE))),LIELL) + END IF + 1234 CONTINUE + IF (KEEP(201).GT.0) THEN + CALL SMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 6 + NSLAVES + DO I = 1, NPIV + JJ = IW( IPOS + I - 1 ) + DO K=1,NRHS + RHS( JJ, K ) = W( PTRACB(STEP(INODE))+I-1 + & + (K-1)*LIELL ) + ENDDO + END DO + IN = INODE + 200 IN = FILS(IN) + IF (IN .GT. 0) GOTO 200 + IF (IN .EQ. 0) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL SMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + ENDIF + IWCB( PTRICB(STEP(INODE)) + 1 ) = 0 + CALL SMUMPS_151(NRHS, N, KEEP(28), + & IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + GOTO 270 + ENDIF + DO I = 0, SLAVEF - 1 + DEJA_SEND( I ) = .FALSE. + END DO + IN = -IN + IF ( KEEP(237).GT.0 ) THEN + NO_CHILDREN = .TRUE. + ELSE + NO_CHILDREN = .FALSE. + ENDIF + DO WHILE (IN.GT.0) + IF ( KEEP(237).GT.0 ) THEN + IF (.NOT.TO_PROCESS(STEP(IN))) THEN + IN = FRERE(STEP(IN)) + CYCLE + ELSE + NO_CHILDREN = .FALSE. + ENDIF + ENDIF + POOL_FIRST_POS = IIPOOL + IF (MUMPS_275(PROCNODE_STEPS(STEP(IN)), + & SLAVEF) .EQ. MYID) THEN + IPOOL(IIPOOL ) = IN + IIPOOL = IIPOOL + 1 + ELSE + PROCDEST = MUMPS_275( PROCNODE_STEPS(STEP(IN)), + & SLAVEF ) + IF ( .NOT. DEJA_SEND( PROCDEST ) ) THEN + 110 CALL SMUMPS_78( NRHS, IN, 0, 0, + & LIELL, LIELL-KEEP(253), + & IW( POSINDICES ) , + & W( PTRACB(STEP(INODE))), + & PROCDEST, NOEUD, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL SMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 110 + ELSE IF ( IERR .eq. -2 ) THEN + INFO(1) = -17 + INFO(2) = LIELL * NRHS * KEEP(35) + + & ( LIELL + 2 ) * KEEP(34) + GOTO 260 + ELSE IF ( IERR .eq. -3 ) THEN + INFO(1) = -20 + INFO(2) = LIELL * NRHS * KEEP(35) + + & ( LIELL + 2 ) * KEEP(34) + GOTO 260 + END IF + DEJA_SEND( PROCDEST ) = .TRUE. + END IF + END IF + IN = FRERE( STEP( IN ) ) + END DO + IF (NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL SMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, + & COMM, FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + ENDIF + IWCB( PTRICB(STEP(INODE)) + 1 ) = 0 + CALL SMUMPS_151(NRHS, N, KEEP(28), + & IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + GOTO 270 + ENDIF + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + IWCB( PTRICB(STEP( INODE )) + 1 ) = 0 + CALL SMUMPS_151(NRHS, N, KEEP(28), + & IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + END IF + ELSE IF (MSGTAG.EQ.TERREUR) THEN + INFO(1) = -001 + INFO(2) = MSGSOU + GO TO 270 + ELSE IF ( (MSGTAG.EQ.UPDATE_LOAD).OR. + & (MSGTAG.EQ.TAG_DUMMY) ) THEN + GO TO 270 + ELSE + INFO(1) = -100 + INFO(2) = MSGTAG + GOTO 260 + ENDIF + GO TO 270 + 260 CONTINUE + CALL SMUMPS_44( MYID, SLAVEF, COMM ) + 270 CONTINUE + RETURN + END SUBROUTINE SMUMPS_42 + SUBROUTINE SMUMPS_641(PANEL_SIZE, PANEL_POS, + & LEN_PANEL_POS, INDICES, NPIV, + & NPANELS, NFRONT_OR_NASS, + & NBENTRIES_ALLPANELS) + IMPLICIT NONE + INTEGER, intent (in) :: PANEL_SIZE, NPIV + INTEGER, intent (in) :: INDICES(NPIV) + INTEGER, intent (in) :: LEN_PANEL_POS + INTEGER, intent (out) :: NPANELS + INTEGER, intent (out) :: PANEL_POS(LEN_PANEL_POS) + INTEGER, intent (in) :: NFRONT_OR_NASS + INTEGER(8), intent(out):: NBENTRIES_ALLPANELS + INTEGER NPANELS_MAX, I, NBeff + INTEGER(8) :: NBENTRIES_THISPANEL + NBENTRIES_ALLPANELS = 0_8 + NPANELS_MAX = (NPIV+PANEL_SIZE-1)/PANEL_SIZE + IF (LEN_PANEL_POS .LT. NPANELS_MAX + 1) THEN + WRITE(*,*) "Error 1 in SMUMPS_641", + & LEN_PANEL_POS,NPANELS_MAX + CALL MUMPS_ABORT() + ENDIF + I = 1 + NPANELS = 0 + IF (I .GT. NPIV) RETURN + 10 CONTINUE + NPANELS = NPANELS + 1 + PANEL_POS(NPANELS) = I + NBeff = min(PANEL_SIZE, NPIV-I+1) + IF ( INDICES(I+NBeff-1) < 0) THEN + NBeff=NBeff+1 + ENDIF + NBENTRIES_THISPANEL = int(NFRONT_OR_NASS-I+1,8) * int(NBeff,8) + NBENTRIES_ALLPANELS = NBENTRIES_ALLPANELS + NBENTRIES_THISPANEL + I=I+NBeff + IF ( I .LE. NPIV ) GOTO 10 + PANEL_POS(NPANELS+1)=NPIV+1 + RETURN + END SUBROUTINE SMUMPS_641 + SUBROUTINE SMUMPS_286( NRHS, DESCA_PAR, + & CNTXT_PAR,LOCAL_M,LOCAL_N,MBLOCK,NBLOCK, + & IPIV,LPIV,MASTER_ROOT,MYID,COMM, + & RHS_SEQ,SIZE_ROOT,A,INFO,MTYPE,LDLT ) + IMPLICIT NONE + INTEGER NRHS, MTYPE + INTEGER DESCA_PAR( 9 ) + INTEGER LOCAL_M, LOCAL_N, MBLOCK, NBLOCK + INTEGER CNTXT_PAR, MASTER_ROOT, SIZE_ROOT + INTEGER MYID, COMM + INTEGER LPIV, IPIV( LPIV ) + INTEGER INFO(40), LDLT + REAL RHS_SEQ( SIZE_ROOT *NRHS) + REAL A( LOCAL_M, LOCAL_N ) + INTEGER IERR, NPROW, NPCOL, MYROW, MYCOL + INTEGER LOCAL_N_RHS + REAL, ALLOCATABLE, DIMENSION( :,: ) ::RHS_PAR + EXTERNAL numroc + INTEGER numroc + INTEGER allocok + CALL blacs_gridinfo( CNTXT_PAR, NPROW, NPCOL, MYROW, MYCOL ) + LOCAL_N_RHS = numroc(NRHS, NBLOCK, MYCOL, 0, NPCOL) + LOCAL_N_RHS = max(1,LOCAL_N_RHS) + ALLOCATE(RHS_PAR(LOCAL_M, LOCAL_N_RHS),stat=allocok) + IF (allocok > 0 ) THEN + WRITE(*,*) ' Problem during solve of the root.' + WRITE(*,*) ' Reduce number of right hand sides.' + CALL MUMPS_ABORT() + ENDIF + CALL SMUMPS_290( MYID, SIZE_ROOT, NRHS, RHS_SEQ, + & LOCAL_M, LOCAL_N_RHS, + & MBLOCK, NBLOCK, RHS_PAR, MASTER_ROOT, + & NPROW, NPCOL, COMM ) + CALL SMUMPS_768 (SIZE_ROOT, NRHS, MTYPE, + & A, DESCA_PAR, LOCAL_M, LOCAL_N, LOCAL_N_RHS, + & IPIV, LPIV, RHS_PAR, LDLT, + & MBLOCK, NBLOCK, CNTXT_PAR, + & IERR) + CALL SMUMPS_156( MYID, SIZE_ROOT, NRHS, + & RHS_SEQ, LOCAL_M, LOCAL_N_RHS, + & MBLOCK, NBLOCK, RHS_PAR, MASTER_ROOT, + & NPROW, NPCOL, COMM ) + DEALLOCATE(RHS_PAR) + RETURN + END SUBROUTINE SMUMPS_286 + SUBROUTINE SMUMPS_768 (SIZE_ROOT, NRHS, MTYPE, + & A, DESCA_PAR, LOCAL_M, LOCAL_N, LOCAL_N_RHS, + & IPIV, LPIV, RHS_PAR, LDLT, + & MBLOCK, NBLOCK, CNTXT_PAR, + & IERR) + IMPLICIT NONE + INTEGER, intent (in) :: SIZE_ROOT, NRHS, LDLT, LOCAL_M, + & LOCAL_N, LOCAL_N_RHS, + & MBLOCK, NBLOCK, CNTXT_PAR, MTYPE + INTEGER, intent (in) :: DESCA_PAR( 9 ) + INTEGER, intent (in) :: LPIV, IPIV( LPIV ) + REAL, intent (in) :: A( LOCAL_M, LOCAL_N ) + REAL, intent (inout) :: RHS_PAR(LOCAL_M, LOCAL_N_RHS) + INTEGER, intent (out) :: IERR + INTEGER :: DESCB_PAR( 9 ) + IERR = 0 + CALL DESCINIT( DESCB_PAR, SIZE_ROOT, + & NRHS, MBLOCK, NBLOCK, 0, 0, + & CNTXT_PAR, LOCAL_M, IERR ) + IF (IERR.NE.0) THEN + WRITE(*,*) 'After DESCINIT, IERR = ', IERR + CALL MUMPS_ABORT() + END IF + IF ( LDLT .eq. 0 .OR. LDLT .eq. 2 ) THEN + IF ( MTYPE .eq. 1 ) THEN + CALL psgetrs('N',SIZE_ROOT,NRHS,A,1,1,DESCA_PAR,IPIV, + & RHS_PAR,1,1,DESCB_PAR,IERR) + ELSE + CALL psgetrs('T',SIZE_ROOT,NRHS,A,1,1,DESCA_PAR,IPIV, + & RHS_PAR, 1, 1, DESCB_PAR,IERR) + END IF + ELSE + CALL pspotrs( 'L', SIZE_ROOT, NRHS, A, 1, 1, DESCA_PAR, + & RHS_PAR, 1, 1, DESCB_PAR, IERR ) + END IF + IF ( IERR .LT. 0 ) THEN + WRITE(*,*) ' Problem during solve of the root' + CALL MUMPS_ABORT() + END IF + RETURN + END SUBROUTINE SMUMPS_768 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_struc_def.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_struc_def.F new file mode 100644 index 000000000..5dbf58c00 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/smumps_struc_def.F @@ -0,0 +1,50 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE SMUMPS_STRUC_DEF + INCLUDE 'smumps_struc.h' + END MODULE SMUMPS_STRUC_DEF diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/tools_common_mod.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/tools_common_mod.F new file mode 100644 index 000000000..83cd3a4fc --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/tools_common_mod.F @@ -0,0 +1,101 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE TOOLS_COMMON + INTERFACE MUMPS_733 + SUBROUTINE MUMPS_754(ARRAY, MINSIZE, INFO, LP, FORCE, COPY, + & STRING, MEMCNT, ERRCODE) + INTEGER, POINTER :: ARRAY(:) + INTEGER :: MINSIZE, LP + INTEGER :: INFO(:) + LOGICAL, OPTIONAL :: FORCE + LOGICAL, OPTIONAL :: COPY + CHARACTER, OPTIONAL :: STRING*(*) + INTEGER, OPTIONAL :: ERRCODE, MEMCNT + END SUBROUTINE MUMPS_754 + SUBROUTINE MUMPS_752(ARRAY, MINSIZE, INFO, LP, FORCE, COPY, + & STRING, MEMCNT, ERRCODE) + REAL(kind(1.D0)), POINTER :: ARRAY(:) + INTEGER :: MINSIZE, LP + INTEGER :: INFO(:) + LOGICAL, OPTIONAL :: FORCE + LOGICAL, OPTIONAL :: COPY + CHARACTER, OPTIONAL :: STRING*(*) + INTEGER, OPTIONAL :: ERRCODE, MEMCNT + END SUBROUTINE MUMPS_752 + SUBROUTINE MUMPS_750(ARRAY, MINSIZE, INFO, LP, FORCE, COPY, + & STRING, MEMCNT, ERRCODE) + REAL(kind(1.E0)), POINTER :: ARRAY(:) + INTEGER :: MINSIZE, LP + INTEGER :: INFO(:) + LOGICAL, OPTIONAL :: FORCE + LOGICAL, OPTIONAL :: COPY + CHARACTER, OPTIONAL :: STRING*(*) + INTEGER, OPTIONAL :: ERRCODE, MEMCNT + END SUBROUTINE MUMPS_750 + SUBROUTINE MUMPS_753(ARRAY, MINSIZE, INFO, LP, FORCE, COPY, + & STRING, MEMCNT, ERRCODE) + COMPLEX(kind((1.D0,1.D0))), POINTER :: ARRAY(:) + INTEGER :: MINSIZE, LP + INTEGER :: INFO(:) + LOGICAL, OPTIONAL :: FORCE + LOGICAL, OPTIONAL :: COPY + CHARACTER, OPTIONAL :: STRING*(*) + INTEGER, OPTIONAL :: ERRCODE, MEMCNT + END SUBROUTINE MUMPS_753 + SUBROUTINE MUMPS_751(ARRAY, MINSIZE, INFO, LP, FORCE, COPY, + & STRING, MEMCNT, ERRCODE) + COMPLEX(kind((1.E0,1.E0))), POINTER :: ARRAY(:) + INTEGER :: MINSIZE, LP + INTEGER :: INFO(:) + LOGICAL, OPTIONAL :: FORCE + LOGICAL, OPTIONAL :: COPY + CHARACTER, OPTIONAL :: STRING*(*) + INTEGER, OPTIONAL :: ERRCODE, MEMCNT + END SUBROUTINE MUMPS_751 + END INTERFACE + END MODULE diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_comm_buffer.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_comm_buffer.F new file mode 100644 index 000000000..eb988e191 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_comm_buffer.F @@ -0,0 +1,2718 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE ZMUMPS_COMM_BUFFER + PRIVATE + PUBLIC :: ZMUMPS_61, ZMUMPS_528, + & ZMUMPS_53 , ZMUMPS_57 , + & ZMUMPS_55, ZMUMPS_59, + & ZMUMPS_54,ZMUMPS_58, + & ZMUMPS_66, ZMUMPS_78, + & ZMUMPS_62, ZMUMPS_68, + & ZMUMPS_71, ZMUMPS_70, + & ZMUMPS_67, + & ZMUMPS_65, ZMUMPS_64, + & ZMUMPS_72, + & ZMUMPS_648, ZMUMPS_76, + & ZMUMPS_73, ZMUMPS_74, + & ZMUMPS_63,ZMUMPS_77, + & ZMUMPS_60, + & ZMUMPS_524, ZMUMPS_469, + & ZMUMPS_460, ZMUMPS_502, + & ZMUMPS_519 ,ZMUMPS_620 + & ,ZMUMPS_617 + INTEGER NEXT, REQ, CONTENT, OVHSIZE + PARAMETER( NEXT = 0, REQ = 1, CONTENT = 2, OVHSIZE = 2 ) + INTEGER, SAVE :: SIZEofINT, SIZEofREAL, BUF_MYID + TYPE ZMUMPS_COMM_BUFFER_TYPE + INTEGER LBUF, HEAD, TAIL,LBUF_INT, ILASTMSG + INTEGER, DIMENSION(:),POINTER :: CONTENT + END TYPE ZMUMPS_COMM_BUFFER_TYPE + TYPE ( ZMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_CB + TYPE ( ZMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_SMALL + TYPE ( ZMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_LOAD + INTEGER, SAVE :: SIZE_RBUF_BYTES + INTEGER BUF_LMAX_ARRAY + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: BUF_MAX_ARRAY + PUBLIC :: BUF_LMAX_ARRAY, BUF_MAX_ARRAY + CONTAINS + SUBROUTINE ZMUMPS_528( MYID ) + IMPLICIT NONE + INTEGER MYID + BUF_MYID = MYID + RETURN + END SUBROUTINE ZMUMPS_528 + SUBROUTINE ZMUMPS_61( IntSize, RealSize ) + IMPLICIT NONE + INTEGER IntSize, RealSize + SIZEofINT = IntSize + SIZEofREAL = RealSize + NULLIFY(BUF_CB %CONTENT) + NULLIFY(BUF_SMALL%CONTENT) + NULLIFY(BUF_LOAD%CONTENT) + BUF_CB%LBUF = 0 + BUF_CB%LBUF_INT = 0 + BUF_CB%HEAD = 1 + BUF_CB%TAIL = 1 + BUF_CB%ILASTMSG = 1 + BUF_SMALL%LBUF = 0 + BUF_SMALL%LBUF_INT = 0 + BUF_SMALL%HEAD = 1 + BUF_SMALL%TAIL = 1 + BUF_SMALL%ILASTMSG = 1 + BUF_LOAD%LBUF = 0 + BUF_LOAD%LBUF_INT = 0 + BUF_LOAD%HEAD = 1 + BUF_LOAD%TAIL = 1 + BUF_LOAD%ILASTMSG = 1 + RETURN + END SUBROUTINE ZMUMPS_61 + SUBROUTINE ZMUMPS_53( SIZE, IERR ) + IMPLICIT NONE + INTEGER SIZE, IERR + CALL ZMUMPS_2( BUF_CB, SIZE, IERR ) + RETURN + END SUBROUTINE ZMUMPS_53 + SUBROUTINE ZMUMPS_55( SIZE, IERR ) + IMPLICIT NONE + INTEGER SIZE, IERR + CALL ZMUMPS_2( BUF_SMALL, SIZE, IERR ) + RETURN + END SUBROUTINE ZMUMPS_55 + SUBROUTINE ZMUMPS_54( SIZE, IERR ) + IMPLICIT NONE + INTEGER SIZE, IERR + CALL ZMUMPS_2( BUF_LOAD, SIZE, IERR ) + RETURN + END SUBROUTINE ZMUMPS_54 + SUBROUTINE ZMUMPS_58( IERR ) + IMPLICIT NONE + INTEGER IERR + CALL ZMUMPS_3( BUF_LOAD, IERR ) + RETURN + END SUBROUTINE ZMUMPS_58 + SUBROUTINE ZMUMPS_620() + IMPLICIT NONE + IF (allocated( BUF_MAX_ARRAY)) DEALLOCATE( BUF_MAX_ARRAY ) + RETURN + END SUBROUTINE ZMUMPS_620 + SUBROUTINE ZMUMPS_617(NFS4FATHER,IERR) + IMPLICIT NONE + INTEGER IERR, NFS4FATHER + IERR = 0 + IF (allocated( BUF_MAX_ARRAY)) THEN + IF (BUF_LMAX_ARRAY .GE. NFS4FATHER) RETURN + DEALLOCATE( BUF_MAX_ARRAY ) + ENDIF + ALLOCATE(BUF_MAX_ARRAY(NFS4FATHER),stat=IERR) + BUF_LMAX_ARRAY=NFS4FATHER + RETURN + END SUBROUTINE ZMUMPS_617 + SUBROUTINE ZMUMPS_57( IERR ) + IMPLICIT NONE + INTEGER IERR + CALL ZMUMPS_3( BUF_CB, IERR ) + RETURN + END SUBROUTINE ZMUMPS_57 + SUBROUTINE ZMUMPS_59( IERR ) + IMPLICIT NONE + INTEGER IERR + CALL ZMUMPS_3( BUF_SMALL, IERR ) + RETURN + END SUBROUTINE ZMUMPS_59 + SUBROUTINE ZMUMPS_2( BUF, SIZE, IERR ) + IMPLICIT NONE + TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: BUF + INTEGER SIZE, IERR + IERR = 0 + BUF%LBUF = SIZE + BUF%LBUF_INT = ( SIZE + SIZEofINT - 1 ) / SIZEofINT + IF ( associated ( BUF%CONTENT ) ) DEALLOCATE( BUF%CONTENT ) + ALLOCATE( BUF%CONTENT( BUF%LBUF_INT ), stat = IERR ) + IF (IERR .NE. 0) THEN + NULLIFY( BUF%CONTENT ) + IERR = -1 + BUF%LBUF = 0 + BUF%LBUF_INT = 0 + END IF + BUF%HEAD = 1 + BUF%TAIL = 1 + BUF%ILASTMSG = 1 + RETURN + END SUBROUTINE ZMUMPS_2 + SUBROUTINE ZMUMPS_3( BUF, IERR ) + IMPLICIT NONE + TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: BUF + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG + IF ( .NOT. associated ( BUF%CONTENT ) ) THEN + BUF%HEAD = 1 + BUF%LBUF = 0 + BUF%LBUF_INT = 0 + BUF%TAIL = 1 + BUF%ILASTMSG = 1 + RETURN + END IF + DO WHILE ( BUF%HEAD.NE.0 .AND. BUF%HEAD .NE. BUF%TAIL ) + CALL MPI_TEST(BUF%CONTENT( BUF%HEAD + REQ ), FLAG, + & STATUS, IERR) + IF ( .not. FLAG ) THEN + WRITE(*,*) '** Warning: trying to cancel a request.' + WRITE(*,*) '** This might be problematic on SGI' + CALL MPI_CANCEL( BUF%CONTENT( BUF%HEAD + REQ ), IERR ) + CALL MPI_REQUEST_FREE( BUF%CONTENT( BUF%HEAD + REQ ), IERR ) + END IF + BUF%HEAD = BUF%CONTENT( BUF%HEAD + NEXT ) + END DO + DEALLOCATE( BUF%CONTENT ) + NULLIFY( BUF%CONTENT ) + BUF%LBUF = 0 + BUF%LBUF_INT = 0 + BUF%HEAD = 1 + BUF%TAIL = 1 + BUF%ILASTMSG = 1 + RETURN + END SUBROUTINE ZMUMPS_3 + SUBROUTINE ZMUMPS_66( NBROWS_ALREADY_SENT, + & INODE, FPERE, NFRONT, LCONT, + & NASS, NPIV, + & IWROW, IWCOL, A, COMPRESSCB, + & DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INTEGER DEST, TAG, COMM, IERR + INTEGER NBROWS_ALREADY_SENT + INTEGER INODE, FPERE, NFRONT, LCONT, NASS, NPIV + INTEGER IWROW( LCONT ), IWCOL( LCONT ) + COMPLEX(kind=8) A( * ) + LOGICAL COMPRESSCB + INCLUDE 'mpif.h' + INTEGER NBROWS_PACKET + INTEGER POSITION, IREQ, IPOS, I, J1 + INTEGER SIZE1, SIZE2, SIZE_PACK, SIZE_AV, SIZE_AV_REALS + INTEGER IZERO, IONE + INTEGER SIZECB + INTEGER LCONT_SENT + INTEGER DEST2(1) + PARAMETER( IZERO = 0, IONE = 1 ) + LOGICAL RECV_BUF_SMALLER_THAN_SEND + DOUBLE PRECISION TMP + DEST2(1) = DEST + IERR = 0 + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + CALL MPI_PACK_SIZE( 11 + LCONT + LCONT, MPI_INTEGER, + & COMM, SIZE1, IERR) + ELSE + CALL MPI_PACK_SIZE( 5, MPI_INTEGER, COMM, SIZE1, IERR) + ENDIF + CALL ZMUMPS_79( BUF_CB, SIZE_AV ) + IF ( SIZE_AV .LT. SIZE_RBUF_BYTES ) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + SIZE_AV = SIZE_RBUF_BYTES + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + ENDIF + SIZE_AV_REALS = ( SIZE_AV - SIZE1 ) / SIZEofREAL + IF (SIZE_AV_REALS < 0 ) THEN + NBROWS_PACKET = 0 + ELSE + IF (COMPRESSCB) THEN + TMP=2.0D0*dble(NBROWS_ALREADY_SENT)+1.0D0 + NBROWS_PACKET = int( + & ( sqrt( TMP * TMP + & + 8.0D0 * dble(SIZE_AV_REALS)) - TMP ) + & / 2.0D0 ) + ELSE + NBROWS_PACKET = SIZE_AV_REALS / LCONT + ENDIF + ENDIF + 10 CONTINUE + NBROWS_PACKET = max(0, + & min(NBROWS_PACKET, LCONT - NBROWS_ALREADY_SENT)) + IF (NBROWS_PACKET .EQ. 0 .AND. LCONT .NE. 0) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + IF (COMPRESSCB) THEN + SIZECB = (NBROWS_ALREADY_SENT*NBROWS_PACKET)+(NBROWS_PACKET + & *(NBROWS_PACKET+1))/2 + ELSE + SIZECB = NBROWS_PACKET * LCONT + ENDIF + CALL MPI_PACK_SIZE( SIZECB, MPI_DOUBLE_COMPLEX, + & COMM, SIZE2, IERR ) + SIZE_PACK = SIZE1 + SIZE2 + IF (SIZE_PACK .GT. SIZE_AV ) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF (NBROWS_PACKET > 0) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR=-3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF + IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.LCONT .AND. + & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 + & .AND. + & .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF + CALL ZMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE , DEST2 + & ) + IF (IERR .EQ. -1 .OR. IERR .EQ. -2) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF ( NBROWS_PACKET > 0 ) GOTO 10 + ENDIF + IF ( IERR .LT. 0 ) GOTO 100 + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( FPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (COMPRESSCB) THEN + LCONT_SENT=-LCONT + ELSE + LCONT_SENT=LCONT + ENDIF + CALL MPI_PACK( LCONT_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (NBROWS_ALREADY_SENT == 0) THEN + CALL MPI_PACK( LCONT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NASS-NPIV, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( LCONT , 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IZERO, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IONE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IZERO, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IWROW, LCONT, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IWCOL, LCONT, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + IF ( LCONT .NE. 0 ) THEN + J1 = 1 + NBROWS_ALREADY_SENT * NFRONT + IF (COMPRESSCB) THEN + DO I = NBROWS_ALREADY_SENT+1, + & NBROWS_ALREADY_SENT+NBROWS_PACKET + CALL MPI_PACK( A( J1 ), I, MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + J1 = J1 + NFRONT + END DO + ELSE + DO I = NBROWS_ALREADY_SENT+1, + & NBROWS_ALREADY_SENT+NBROWS_PACKET + CALL MPI_PACK( A( J1 ), LCONT, MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + J1 = J1 + NFRONT + END DO + ENDIF + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK .LT. POSITION ) THEN + WRITE(*,*) 'Error Try_send_cb: SIZE, POSITION=',SIZE_PACK, + & POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE_PACK .NE. POSITION ) + & CALL ZMUMPS_1( BUF_CB, POSITION ) + NBROWS_ALREADY_SENT = NBROWS_ALREADY_SENT + NBROWS_PACKET + IF (NBROWS_ALREADY_SENT .NE. LCONT ) THEN + IERR = -1 + RETURN + ENDIF + 100 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_66 + SUBROUTINE ZMUMPS_72( NRHS, INODE, IFATH, + & EFF_CB_SIZE, LD_CB, LD_PIV, NPIV, CB, SOL, + & DEST, COMM, IERR ) + IMPLICIT NONE + INTEGER NRHS, INODE, IFATH, EFF_CB_SIZE, LD_CB, LD_PIV, NPIV + INTEGER DEST, COMM, IERR + COMPLEX(kind=8) CB( LD_CB*(NRHS-1)+EFF_CB_SIZE ) + COMPLEX(kind=8) SOL( max(1, LD_PIV*(NRHS-1)+NPIV) ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE, SIZE1, SIZE2, K + INTEGER POSITION, IREQ, IPOS + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1) = DEST + IERR = 0 + CALL MPI_PACK_SIZE( 4, MPI_INTEGER, COMM, SIZE1, IERR ) + CALL MPI_PACK_SIZE( NRHS * (EFF_CB_SIZE + NPIV), + & MPI_DOUBLE_COMPLEX, COMM, + & SIZE2, IERR ) + SIZE = SIZE1 + SIZE2 + CALL ZMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IFATH, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( EFF_CB_SIZE , 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NPIV , 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + DO K = 1, NRHS + CALL MPI_PACK( CB ( 1 + LD_CB * (K-1) ), + & EFF_CB_SIZE, MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + END DO + IF ( NPIV .GT. 0 ) THEN + DO K=1, NRHS + CALL MPI_PACK( SOL(1+LD_PIV*(K-1)), + & NPIV, MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + ENDDO + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, Master2Slave, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE .LT. POSITION ) THEN + WRITE(*,*) 'Try_send_master2slave: SIZE, POSITION = ', + & SIZE, POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE .NE. POSITION ) CALL ZMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE ZMUMPS_72 + SUBROUTINE ZMUMPS_78( NRHS, NODE1, NODE2, NCB, LDW, + & LONG, + & IW, W, + & DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INTEGER LDW, DEST, TAG, COMM, IERR + INTEGER NRHS, NODE1, NODE2, NCB, LONG + INTEGER IW( max( 1, LONG ) ) + COMPLEX(kind=8) W( max( 1, LDW * NRHS ) ) + INCLUDE 'mpif.h' + INTEGER POSITION, IREQ, IPOS + INTEGER SIZE1, SIZE2, SIZE, K + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1)=DEST + IERR = 0 + IF ( NODE2 .EQ. 0 ) THEN + CALL MPI_PACK_SIZE( 2+LONG, MPI_INTEGER, COMM, SIZE1, IERR ) + ELSE + CALL MPI_PACK_SIZE( 4+LONG, MPI_INTEGER, COMM, SIZE1, IERR ) + END IF + SIZE2 = 0 + IF ( LONG .GT. 0 ) THEN + CALL MPI_PACK_SIZE( NRHS*LONG, MPI_DOUBLE_COMPLEX, + & COMM, SIZE2, IERR ) + END IF + SIZE = SIZE1 + SIZE2 + CALL ZMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + POSITION = 0 + CALL MPI_PACK( NODE1, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + IF ( NODE2 .NE. 0 ) THEN + CALL MPI_PACK( NODE2, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NCB, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + END IF + CALL MPI_PACK( LONG, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + IF ( LONG .GT. 0 ) THEN + CALL MPI_PACK( IW, LONG, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + DO K=1, NRHS + CALL MPI_PACK( W(1+(K-1)*LDW), LONG, MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE, + & POSITION, COMM, IERR ) + END DO + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE .NE. POSITION ) CALL ZMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE ZMUMPS_78 + SUBROUTINE ZMUMPS_62( I, DEST, TAG, COMM, IERR ) + IMPLICIT NONE + INTEGER I + INTEGER DEST, TAG, COMM, IERR + INCLUDE 'mpif.h' + INTEGER IPOS, IREQ, MSG_SIZE, POSITION + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1)=DEST + IERR = 0 + CALL MPI_PACK_SIZE( 1, MPI_INTEGER, + & COMM, MSG_SIZE, IERR ) + CALL ZMUMPS_4( BUF_SMALL, IPOS, IREQ, MSG_SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + write(6,*) ' Internal error in ZMUMPS_62', + & ' Buf size (bytes)= ',BUF_SMALL%LBUF + RETURN + ENDIF + POSITION=0 + CALL MPI_PACK( I, 1, + & MPI_INTEGER, BUF_SMALL%CONTENT( IPOS ), + & MSG_SIZE, + & POSITION, COMM, IERR ) + CALL MPI_ISEND( BUF_SMALL%CONTENT(IPOS), MSG_SIZE, + & MPI_PACKED, DEST, TAG, COMM, + & BUF_SMALL%CONTENT( IREQ ), IERR ) + RETURN + END SUBROUTINE ZMUMPS_62 + SUBROUTINE ZMUMPS_469(FLAG) + LOGICAL FLAG + LOGICAL FLAG1, FLAG2, FLAG3 + CALL ZMUMPS_468( BUF_SMALL, FLAG1 ) + CALL ZMUMPS_468( BUF_CB, FLAG2 ) + CALL ZMUMPS_468( BUF_LOAD, FLAG3 ) + FLAG = FLAG1 .AND. FLAG2 .AND. FLAG3 + RETURN + END SUBROUTINE ZMUMPS_469 + SUBROUTINE ZMUMPS_468( B, FLAG ) + TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: B + LOGICAL :: FLAG + INTEGER SIZE_AVAIL + CALL ZMUMPS_79(B, SIZE_AVAIL) + FLAG = ( B%HEAD == B%TAIL ) + RETURN + END SUBROUTINE ZMUMPS_468 + SUBROUTINE ZMUMPS_79( B, SIZE_AV ) + IMPLICIT NONE + TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: B + INTEGER SIZE_AV + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG + IF ( B%HEAD .NE. B%TAIL ) THEN + 10 CONTINUE + CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + B%HEAD = B%CONTENT( B%HEAD + NEXT ) + IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL + IF ( B%HEAD .NE. B%TAIL ) GOTO 10 + END IF + END IF + IF ( B%HEAD .EQ. B%TAIL ) THEN + B%HEAD = 1 + B%TAIL = 1 + B%ILASTMSG = 1 + END IF + IF ( B%HEAD .LE. B%TAIL ) THEN + SIZE_AV = max( B%LBUF_INT - B%TAIL, B%HEAD - 2 ) + ELSE + SIZE_AV = B%HEAD - B%TAIL - 1 + END IF + SIZE_AV = min(SIZE_AV - OVHSIZE, SIZE_AV) + SIZE_AV = SIZE_AV * SIZEofINT + RETURN + END SUBROUTINE ZMUMPS_79 + SUBROUTINE ZMUMPS_4( B, IPOS, IREQ, MSG_SIZE, IERR, + & NDEST , PDEST + & ) + IMPLICIT NONE + TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: B + INTEGER, INTENT(IN) :: MSG_SIZE + INTEGER, INTENT(OUT) :: IPOS, IREQ, IERR + INTEGER NDEST + INTEGER, INTENT(IN) :: PDEST(max(1,NDEST)) + INCLUDE 'mpif.h' + INTEGER MSG_SIZE_INT + INTEGER IBUF + LOGICAL FLAG + INTEGER STATUS( MPI_STATUS_SIZE ) + IERR = 0 + IF ( B%HEAD .NE. B%TAIL ) THEN + 10 CONTINUE + CALL MPI_TEST( B%CONTENT( B%HEAD + REQ ), FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + B%HEAD = B%CONTENT( B%HEAD + NEXT ) + IF ( B%HEAD .EQ. 0 ) B%HEAD = B%TAIL + IF ( B%HEAD .NE. B%TAIL ) GOTO 10 + END IF + END IF + IF ( B%HEAD .EQ. B%TAIL ) THEN + B%HEAD = 1 + B%TAIL = 1 + B%ILASTMSG = 1 + END iF + MSG_SIZE_INT = ( MSG_SIZE + ( SIZEofINT - 1 ) ) / SIZEofINT + MSG_SIZE_INT = MSG_SIZE_INT + OVHSIZE + FLAG = ( ( B%HEAD .LE. B%TAIL ) + & .AND. ( + & ( MSG_SIZE_INT .LE. B%LBUF_INT - B%TAIL ) + & .OR. ( MSG_SIZE_INT .LE. B%HEAD - 2 ) ) ) + & .OR. + & ( ( B%HEAD .GT. B%TAIL ) + & .AND. ( MSG_SIZE_INT .LE. B%HEAD - B%TAIL - 1 ) ) + IF ( .NOT. FLAG + & ) THEN + IERR = -1 + IF ( MSG_SIZE_INT .GT. B%LBUF_INT - 1 ) then + IERR = -2 + ENDIF + IPOS = -1 + IREQ = -1 + RETURN + END IF + IF ( B%HEAD .LE. B%TAIL ) THEN + IF ( MSG_SIZE_INT .LE. B%LBUF_INT - B%TAIL + 1 ) THEN + IBUF = B%TAIL + ELSE IF ( MSG_SIZE_INT .LE. B%HEAD - 1 ) THEN + IBUF = 1 + END IF + ELSE + IBUF = B%TAIL + END IF + B%CONTENT( B%ILASTMSG + NEXT ) = IBUF + B%ILASTMSG = IBUF + B%TAIL = IBUF + MSG_SIZE_INT + B%CONTENT( IBUF + NEXT ) = 0 + IPOS = IBUF + CONTENT + IREQ = IBUF + REQ + RETURN + END SUBROUTINE ZMUMPS_4 + SUBROUTINE ZMUMPS_1( BUF, SIZE ) + IMPLICIT NONE + TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: BUF + INTEGER SIZE + INTEGER SIZE_INT + SIZE_INT = ( SIZE + SIZEofINT - 1 ) / SIZEofINT + SIZE_INT = SIZE_INT + OVHSIZE + BUF%TAIL = BUF%ILASTMSG + SIZE_INT + RETURN + END SUBROUTINE ZMUMPS_1 + SUBROUTINE ZMUMPS_68( + & INODE, NBPROCFILS, NLIG, ILIG, NCOL, ICOL, + & NASS, NSLAVES, LIST_SLAVES, + & DEST, NFRONT, COMM, IERR ) + IMPLICIT NONE + INTEGER COMM, IERR, NFRONT + INTEGER INODE + INTEGER NLIG, NCOL, NASS, NSLAVES + INTEGER NBPROCFILS, DEST + INTEGER ILIG( NLIG ) + INTEGER ICOL( NCOL ) + INTEGER LIST_SLAVES( NSLAVES ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE, POSITION, IPOS, IREQ + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1) = DEST + IERR = 0 + SIZE = ( 6 + NLIG + NCOL + NSLAVES + 1 ) * SIZEofINT + IF (SIZE.GT.SIZE_RBUF_BYTES ) THEN + IERR = -2 + RETURN + END IF + CALL ZMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + POSITION = IPOS + BUF_CB%CONTENT( POSITION ) = INODE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NBPROCFILS + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NLIG + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NCOL + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NASS + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFRONT + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NSLAVES + POSITION = POSITION + 1 + IF (NSLAVES.GT.0) THEN + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) = + & LIST_SLAVES( 1: NSLAVES ) + POSITION = POSITION + NSLAVES + ENDIF + BUF_CB%CONTENT( POSITION:POSITION + NLIG - 1 ) = ILIG + POSITION = POSITION + NLIG + BUF_CB%CONTENT( POSITION:POSITION + NCOL - 1 ) = ICOL + POSITION = POSITION + NCOL + POSITION = POSITION - IPOS + IF ( POSITION * SIZEofINT .NE. SIZE ) THEN + WRITE(*,*) 'Error in ZMUMPS_68 :', + & ' wrong estimated size' + CALL MUMPS_ABORT() + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, MPI_PACKED, + & DEST, MAITRE_DESC_BANDE, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + RETURN + END SUBROUTINE ZMUMPS_68 + SUBROUTINE ZMUMPS_70( NBROWS_ALREADY_SENT, + & IPERE, ISON, NROW, + & IROW, NCOL, ICOL, VAL, LDA, NELIM, TYPE_SON, + & NSLAVES, SLAVES, DEST, COMM, IERR, + & + & SLAVEF, KEEP,KEEP8, INIV2, TAB_POS_IN_PERE ) + IMPLICIT NONE + INTEGER NBROWS_ALREADY_SENT + INTEGER LDA, NELIM, TYPE_SON + INTEGER IPERE, ISON, NROW, NCOL, NSLAVES + INTEGER IROW( NROW ) + INTEGER ICOL( NCOL ) + INTEGER SLAVES( NSLAVES ) + COMPLEX(kind=8) VAL(LDA, *) + INTEGER IPOS, IREQ, DEST, COMM, IERR + INTEGER SLAVEF, KEEP(500), INIV2 + INTEGER(8) KEEP8(150) + INTEGER TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE1, SIZE2, SIZE3, SIZE_PACK, POSITION, I + INTEGER NBROWS_PACKET, NCOL_SEND + INTEGER SIZE_AV + LOGICAL RECV_BUF_SMALLER_THAN_SEND + INTEGER IONE + INTEGER DEST2(1) + PARAMETER ( IONE=1 ) + DEST2(1) = DEST + IERR = 0 + IF ( NELIM .NE. NROW ) THEN + WRITE(*,*) 'Error in TRY_SEND_MAITRE2:',NELIM, NROW + CALL MUMPS_ABORT() + END IF + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + CALL MPI_PACK_SIZE( NROW+NCOL+7+NSLAVES, MPI_INTEGER, + & COMM, SIZE1, IERR ) + IF ( ( KEEP(48).NE. 0 ).AND.(TYPE_SON .eq. 2 )) THEN + CALL MPI_PACK_SIZE( NSLAVES+1, MPI_INTEGER, + & COMM, SIZE3, IERR ) + ELSE + SIZE3 = 0 + ENDIF + SIZE1=SIZE1+SIZE3 + ELSE + CALL MPI_PACK_SIZE(7, MPI_INTEGER,COMM,SIZE1,IERR) + ENDIF + IF ( KEEP(50).ne.0 .AND. TYPE_SON .eq. 2 ) THEN + NCOL_SEND = NROW + ELSE + NCOL_SEND = NCOL + ENDIF + CALL ZMUMPS_79( BUF_CB, SIZE_AV ) + IF (SIZE_AV .LT. SIZE_RBUF_BYTES) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + SIZE_AV = SIZE_RBUF_BYTES + ENDIF + IF (NROW .GT. 0 ) THEN + NBROWS_PACKET = (SIZE_AV - SIZE1) / NCOL_SEND / SIZEofREAL + NBROWS_PACKET = min(NBROWS_PACKET, NROW - NBROWS_ALREADY_SENT) + NBROWS_PACKET = max(NBROWS_PACKET, 0) + ELSE + NBROWS_PACKET =0 + ENDIF + IF (NBROWS_PACKET .EQ. 0 .AND. NROW .NE. 0) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR=-3 + GOTO 100 + ELSE + IERR=-1 + GOTO 100 + ENDIF + ENDIF + 10 CONTINUE + CALL MPI_PACK_SIZE( NBROWS_PACKET * NCOL_SEND, + & MPI_DOUBLE_COMPLEX, + & COMM, SIZE2, IERR ) + SIZE_PACK = SIZE1 + SIZE2 + IF (SIZE_PACK .GT. SIZE_AV) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF ( NBROWS_PACKET .GT. 0 ) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF + IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.NROW .AND. + & SIZE_PACK - SIZE1 .LT. ( SIZE_RBUF_BYTES - SIZE1 ) / 2 + & .AND. + & .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF + CALL ZMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE , DEST2 + & ) + IF ( IERR .LT. 0 ) THEN + GOTO 100 + ENDIF + POSITION = 0 + CALL MPI_PACK( IPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( ISON, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NSLAVES, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NCOL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + IF (NSLAVES.GT.0) THEN + CALL MPI_PACK( SLAVES, NSLAVES, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + CALL MPI_PACK( IROW, NROW, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( ICOL, NCOL, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF ( ( KEEP(48).NE. 0 ).AND.(TYPE_SON .eq. 2 ) ) THEN + CALL MPI_PACK( TAB_POS_IN_PERE(1,INIV2), NSLAVES+1, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + ENDIF + IF (NBROWS_PACKET.GE.1) THEN + DO I=NBROWS_ALREADY_SENT+1, + & NBROWS_ALREADY_SENT+NBROWS_PACKET + CALL MPI_PACK( VAL(1,I), NCOL_SEND, + & MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDDO + ENDIF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & DEST, MAITRE2, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK .LT. POSITION ) THEN + write(*,*) 'Try_send_maitre2, SIZE,POSITION=', + & SIZE_PACK,POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE_PACK .NE. POSITION ) + & CALL ZMUMPS_1( BUF_CB, POSITION ) + NBROWS_ALREADY_SENT = NBROWS_ALREADY_SENT + NBROWS_PACKET + IF ( NBROWS_ALREADY_SENT .NE. NROW ) THEN + IERR = -1 + ENDIF + 100 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_70 + SUBROUTINE ZMUMPS_67(NBROWS_ALREADY_SENT, + & DESC_IN_LU, + & IPERE, NFRONT_PERE, NASS_PERE, NFS4FATHER, + & NSLAVES_PERE, + & ISON, NBROW, LMAP, MAPROW, PERM, IW_CBSON, A_CBSON, + & ISLAVE, PDEST, PDEST_MASTER, COMM, IERR, + & + & KEEP,KEEP8, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & COMPRESSCB, KEEP253_LOC ) + IMPLICIT NONE + INTEGER NBROWS_ALREADY_SENT + INTEGER, INTENT (in) :: KEEP253_LOC + INTEGER IPERE, ISON, NBROW + INTEGER PDEST, ISLAVE, COMM, IERR + INTEGER PDEST_MASTER, NASS_PERE, NSLAVES_PERE, + & NFRONT_PERE, LMAP + INTEGER MAPROW( LMAP ), PERM( max(1, NBROW )) + INTEGER IW_CBSON( * ) + COMPLEX(kind=8) A_CBSON( * ) + LOGICAL DESC_IN_LU, COMPRESSCB + INTEGER KEEP(500), N , SLAVEF + INTEGER(8) KEEP8(150) + INTEGER STEP(N), + & ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NFS4FATHER,SIZE3,PS1,NCA,LROW1 + INTEGER(8) :: ASIZE + LOGICAL COMPUTE_MAX + INTEGER NBROWS_PACKET + INTEGER MAX_ROW_LENGTH + INTEGER LROW, NELIM + INTEGER(8) :: SIZFR, ITMP8 + INTEGER NPIV, NFRONT, HS + INTEGER SIZE_PACK, SIZE1, SIZE2, POSITION,I + INTEGER SIZE_INTEGERS, B, SIZE_REALS, TMPSIZE, ONEorTWO, SIZE_AV + INTEGER NBINT, L + INTEGER(8) :: APOS, SHIFTCB_SON, LDA_SON8 + INTEGER IPOS_IN_SLAVE + INTEGER STATE_SON + INTEGER INDICE_PERE, NROW, IPOS, IREQ, NOSLA + INTEGER IONE, J, THIS_ROW_LENGTH + INTEGER SIZE_DESC_BANDE, DESC_BANDE_BYTES + LOGICAL RECV_BUF_SMALLER_THAN_SEND + LOGICAL NOT_ENOUGH_SPACE + INTEGER PDEST2(1) + PARAMETER ( IONE=1 ) + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION ZERO + PARAMETER (ZERO = 0.0D0) + COMPUTE_MAX = (KEEP(219) .NE. 0) .AND. + & (KEEP(50) .EQ. 2) .AND. + & (PDEST.EQ.PDEST_MASTER) + IF (NBROWS_ALREADY_SENT == 0) THEN + IF (COMPUTE_MAX) THEN + CALL ZMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE. 0) THEN + IERR = -4 + RETURN + ENDIF + ENDIF + ENDIF + PDEST2(1) = PDEST + IERR = 0 + LROW = IW_CBSON( 1 + KEEP(IXSZ)) + NELIM = IW_CBSON( 2 + KEEP(IXSZ)) + NPIV = IW_CBSON( 4 + KEEP(IXSZ)) + IF ( NPIV .LT. 0 ) THEN + NPIV = 0 + END IF + NROW = IW_CBSON( 3 + KEEP(IXSZ)) + NFRONT = LROW + NPIV + HS = 6 + IW_CBSON( 6 + KEEP(IXSZ)) + KEEP(IXSZ) + CALL MUMPS_729( SIZFR, IW_CBSON( 1 + XXR ) ) + STATE_SON = IW_CBSON(1+XXS) + IF (STATE_SON .EQ. S_NOLCBCONTIG) THEN + LDA_SON8 = int(LROW,8) + SHIFTCB_SON = int(NPIV,8)*int(NROW,8) + ELSE IF (STATE_SON .EQ. S_NOLCLEANED) THEN + LDA_SON8 = int(LROW,8) + SHIFTCB_SON = 0_8 + ELSE + LDA_SON8 = int(NFRONT,8) + SHIFTCB_SON = int(NPIV,8) + ENDIF + CALL ZMUMPS_79( BUF_CB, SIZE_AV ) + IF (PDEST .EQ. PDEST_MASTER) THEN + SIZE_DESC_BANDE=0 + ELSE + SIZE_DESC_BANDE=(7+SLAVEF+KEEP(127)*2) + SIZE_DESC_BANDE=SIZE_DESC_BANDE+int(dble(KEEP(12))* + & dble(SIZE_DESC_BANDE)/100.0D0) + SIZE_DESC_BANDE=max(SIZE_DESC_BANDE, + & 7+NSLAVES_PERE+NFRONT_PERE+NFRONT_PERE-NASS_PERE) + ENDIF + DESC_BANDE_BYTES=SIZE_DESC_BANDE*SIZEofINT + IF ( SIZE_AV .LT. SIZE_RBUF_BYTES-DESC_BANDE_BYTES ) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + SIZE_AV = SIZE_RBUF_BYTES-DESC_BANDE_BYTES + ENDIF + SIZE1=0 + IF (NBROWS_ALREADY_SENT==0) THEN + IF(COMPUTE_MAX) THEN + CALL MPI_PACK_SIZE(1, MPI_INTEGER, + & COMM, PS1, IERR ) + IF(NFS4FATHER .GT. 0) THEN + CALL MPI_PACK_SIZE( NFS4FATHER, MPI_DOUBLE_PRECISION, + & COMM, SIZE1, IERR ) + ENDIF + SIZE1 = SIZE1+PS1 + ENDIF + ENDIF + IF (KEEP(50) .EQ. 0) THEN + ONEorTWO = 1 + ELSE + ONEorTWO = 2 + ENDIF + IF (PDEST .EQ.PDEST_MASTER) THEN + L = 0 + ELSE IF (KEEP(50) .EQ. 0) THEN + L = LROW + ELSE + L = LROW + PERM(1) - LMAP + NBROWS_ALREADY_SENT - 1 + ONEorTWO=ONEorTWO+1 + ENDIF + NBINT = 6 + L + CALL MPI_PACK_SIZE( NBINT, MPI_INTEGER, + & COMM, TMPSIZE, IERR ) + SIZE1 = SIZE1 + TMPSIZE + SIZE_AV = SIZE_AV - SIZE1 + NOT_ENOUGH_SPACE=.FALSE. + IF (SIZE_AV .LT.0 ) THEN + NBROWS_PACKET = 0 + NOT_ENOUGH_SPACE=.TRUE. + ELSE + IF ( KEEP(50) .EQ. 0 ) THEN + NBROWS_PACKET = + & SIZE_AV / ( ONEorTWO*SIZEofINT+LROW*SIZEofREAL) + ELSE + B = 2 * ONEorTWO + + & ( 1 + 2 * LROW + 2 * PERM(1) + 2 * NBROWS_ALREADY_SENT ) + & * SIZEofREAL / SIZEofINT + NBROWS_PACKET=int((dble(-B)+sqrt((dble(B)*dble(B))+ + & dble(4)*dble(2*SIZE_AV)/dble(SIZEofINT) * + & dble(SIZEofREAL/SIZEofINT)))* + & dble(SIZEofINT) / dble(2) / dble(SIZEofREAL)) + ENDIF + ENDIF + 10 CONTINUE + NBROWS_PACKET = max( 0, + & min( NBROWS_PACKET, NBROW - NBROWS_ALREADY_SENT)) + NOT_ENOUGH_SPACE = NOT_ENOUGH_SPACE .OR. + & (NBROWS_PACKET .EQ.0.AND. NBROW.NE.0) + IF (NOT_ENOUGH_SPACE) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + IF (KEEP(50).EQ.0) THEN + MAX_ROW_LENGTH = -99999 + SIZE_REALS = NBROWS_PACKET * LROW + ELSE + SIZE_REALS = ( LROW + PERM(1) + NBROWS_ALREADY_SENT ) * + & NBROWS_PACKET + ( NBROWS_PACKET * ( NBROWS_PACKET + 1) ) / 2 + MAX_ROW_LENGTH = LROW+PERM(1)-LMAP+NBROWS_ALREADY_SENT + & + NBROWS_PACKET-1 + ENDIF + SIZE_INTEGERS = ONEorTWO* NBROWS_PACKET + CALL MPI_PACK_SIZE( SIZE_REALS, MPI_DOUBLE_COMPLEX, + & COMM, SIZE2, IERR) + CALL MPI_PACK_SIZE( SIZE_INTEGERS, MPI_INTEGER, + & COMM, SIZE3, IERR) + IF (SIZE2 + SIZE3 .GT. SIZE_AV ) THEN + NBROWS_PACKET = NBROWS_PACKET -1 + IF (NBROWS_PACKET .GT. 0 ) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF + SIZE_PACK = SIZE1 + SIZE2 + SIZE3 +#if ! defined(DBG_SMB3) + IF (NBROWS_PACKET + NBROWS_ALREADY_SENT.NE.NBROW .AND. + & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 .AND. + & .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF +#endif + CALL ZMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE , PDEST2 + & ) + IF (IERR .EQ. -1 .OR. IERR.EQ. -2) THEN + NBROWS_PACKET = NBROWS_PACKET - 1 + IF (NBROWS_PACKET > 0 ) GOTO 10 + ENDIF + IF ( IERR .LT. 0 ) GOTO 100 + IF (SIZE_PACK.GT.SIZE_RBUF_BYTES ) THEN + IERR = -3 + GOTO 100 + ENDIF + POSITION = 0 + CALL MPI_PACK( IPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( ISON, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF (KEEP(50)==0) THEN + CALL MPI_PACK( LROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ELSE + CALL MPI_PACK( MAX_ROW_LENGTH, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + CALL MPI_PACK( NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NBROWS_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF ( PDEST .NE. PDEST_MASTER ) THEN + IF (KEEP(50)==0) THEN + CALL MPI_PACK( IW_CBSON( HS + NROW + NPIV + 1 ), LROW, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ELSE + IF (MAX_ROW_LENGTH > 0) THEN + CALL MPI_PACK( IW_CBSON( HS + NROW + NPIV + 1 ), + & MAX_ROW_LENGTH, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + ENDIF + END IF + DO J=NBROWS_ALREADY_SENT+1,NBROWS_ALREADY_SENT+NBROWS_PACKET + I = PERM(J) + INDICE_PERE=MAPROW(I) + CALL MUMPS_47( + & KEEP,KEEP8, IPERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + INDICE_PERE = IPOS_IN_SLAVE + CALL MPI_PACK( INDICE_PERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDDO + DO J=NBROWS_ALREADY_SENT+1,NBROWS_ALREADY_SENT+NBROWS_PACKET + I = PERM(J) + INDICE_PERE=MAPROW(I) + CALL MUMPS_47( + & KEEP,KEEP8, IPERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + IF (KEEP(50).ne.0) THEN + THIS_ROW_LENGTH = LROW + I - LMAP + CALL MPI_PACK( THIS_ROW_LENGTH, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ELSE + THIS_ROW_LENGTH = LROW + ENDIF + IF (DESC_IN_LU) THEN + IF ( COMPRESSCB ) THEN + IF (NELIM.EQ.0) THEN + ITMP8 = int(I,8) + ELSE + ITMP8 = int(NELIM+I,8) + ENDIF + APOS = ITMP8 * (ITMP8-1_8) / 2_8 + 1_8 + ELSE + APOS = int(I+NELIM-1, 8) * int(LROW,8) + 1_8 + ENDIF + ELSE + IF ( COMPRESSCB ) THEN + IF ( LROW .EQ. NROW ) THEN + ITMP8 = int(I,8) + APOS = ITMP8 * (ITMP8-1_8)/2_8 + 1_8 + ELSE + ITMP8 = int(I + LROW - NROW,8) + APOS = ITMP8 * (ITMP8-1_8)/2_8 + 1_8 - + & int(LROW - NROW, 8) * int(LROW-NROW+1,8) / 2_8 + ENDIF + ELSE + APOS = int( I - 1, 8 ) * LDA_SON8 + SHIFTCB_SON + 1_8 + ENDIF + ENDIF + CALL MPI_PACK( A_CBSON( APOS ), THIS_ROW_LENGTH, + & MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDDO + IF (NBROWS_ALREADY_SENT == 0) THEN + IF (COMPUTE_MAX) THEN + CALL MPI_PACK(NFS4FATHER,1, + & MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + IF(NFS4FATHER .GT. 0) THEN + BUF_MAX_ARRAY(1:NFS4FATHER) = ZERO + IF(MAPROW(NROW) .GT. NASS_PERE) THEN + DO PS1=1,NROW + IF(MAPROW(PS1).GT.NASS_PERE) EXIT + ENDDO + IF (DESC_IN_LU) THEN + IF (COMPRESSCB) THEN + APOS = int(NELIM+PS1,8) * int(NELIM+PS1-1,8) / + & 2_8 + 1_8 + NCA = -44444 + ASIZE = int(NROW,8) * int(NROW+1,8)/2_8 - + & int(NELIM+PS1,8) * int(NELIM+PS1-1,8)/2_8 + LROW1 = PS1 + NELIM + ELSE + APOS = int(PS1+NELIM-1,8) * int(LROW,8) + 1_8 + NCA = LROW + ASIZE = int(NCA,8) * int(NROW-PS1+1,8) + LROW1 = LROW + ENDIF + ELSE + IF (COMPRESSCB) THEN + IF (NPIV.NE.0) THEN + WRITE(*,*) "Error in PARPIV/ZMUMPS_67" + CALL MUMPS_ABORT() + ENDIF + LROW1=LROW-NROW+PS1 + ITMP8 = int(PS1 + LROW - NROW,8) + APOS = ITMP8 * (ITMP8 - 1_8) / 2_8 + 1_8 - + & int(LROW-NROW,8)*int(LROW-NROW+1,8)/2_8 + ASIZE = int(LROW,8)*int(LROW+1,8)/2_8 - + & ITMP8*(ITMP8-1_8)/2_8 + NCA = -555555 + ELSE + APOS = int(PS1-1,8) * LDA_SON8 + 1_8 + SHIFTCB_SON + NCA = int(LDA_SON8) + ASIZE = SIZFR - (SHIFTCB_SON - + & int(PS1-1,8) * LDA_SON8) + LROW1=-666666 + ENDIF + ENDIF + IF ( NROW-PS1+1-KEEP253_LOC .NE. 0 ) THEN + CALL ZMUMPS_618( + & A_CBSON(APOS),ASIZE,NCA, + & NROW-PS1+1-KEEP253_LOC, + & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB,LROW1) + ENDIF + ENDIF + CALL MPI_PACK(BUF_MAX_ARRAY, NFS4FATHER, + & MPI_DOUBLE_PRECISION, + & BUF_CB%CONTENT( IPOS ), SIZE_PACK, + & POSITION, COMM, IERR ) + ENDIF + ENDIF + ENDIF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & PDEST, CONTRIB_TYPE2, COMM, + & BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK.LT. POSITION ) THEN + WRITE(*,*) ' contniv2: SIZE, POSITION =',SIZE_PACK, POSITION + WRITE(*,*) ' NBROW, LROW = ', NBROW, LROW + CALL MUMPS_ABORT() + END IF + IF ( SIZE_PACK .NE. POSITION ) + & CALL ZMUMPS_1( BUF_CB, POSITION ) + NBROWS_ALREADY_SENT=NBROWS_ALREADY_SENT + NBROWS_PACKET + IF (NBROWS_ALREADY_SENT .NE. NBROW ) THEN + IERR = -1 + ENDIF + 100 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_67 + SUBROUTINE ZMUMPS_71( + & INODE, NFRONT, NASS1, NFS4FATHER, + & ISON, MYID, NSLAVES, SLAVES_PERE, + & TROW, NCBSON, + & COMM, IERR, + & DEST, NDEST, SLAVEF, + & + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & + & ) + IMPLICIT NONE + INTEGER INODE, NFRONT, NASS1, NCBSON, NSLAVES, + & NDEST + INTEGER SLAVEF, MYID, ISON + INTEGER TROW( NCBSON ) + INTEGER DEST( NDEST ) + INTEGER SLAVES_PERE( NSLAVES ) + INTEGER COMM, IERR + INTEGER KEEP(500), N + INTEGER(8) KEEP8(150) + INTEGER STEP(N), + & ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER SIZE_AV, IDEST, NSEND, SIZE, NFS4FATHER + INTEGER TROW_SIZE, POSITION, INDX, INIV2 + INTEGER IPOS, IREQ + INTEGER IONE + PARAMETER ( IONE=1 ) + INTEGER NASS_SON + NASS_SON = -99998 + IERR = 0 + IF ( NDEST .eq. 1 ) THEN + IF ( DEST(1).EQ.MYID ) GOTO 500 + SIZE = SIZEofINT * ( 7 + NSLAVES + NCBSON ) + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + SIZE = SIZE + SIZEofINT * ( NSLAVES + 1 ) + ENDIF + CALL ZMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE, DEST + & ) + IF (IERR .LT. 0 ) THEN + RETURN + ENDIF + IF (SIZE.GT.SIZE_RBUF_BYTES ) THEN + IERR = -3 + RETURN + END IF + POSITION = IPOS + BUF_CB%CONTENT( POSITION ) = INODE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = ISON + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NSLAVES + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFRONT + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NASS1 + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NCBSON + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFS4FATHER + POSITION = POSITION + 1 + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES ) + & = TAB_POS_IN_PERE(1:NSLAVES+1,INIV2) + POSITION = POSITION + NSLAVES + 1 + ENDIF + IF ( NSLAVES .NE. 0 ) THEN + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) + & = SLAVES_PERE( 1: NSLAVES ) + POSITION = POSITION + NSLAVES + END IF + BUF_CB%CONTENT( POSITION:POSITION+NCBSON-1 ) = + & TROW( 1: NCBSON ) + POSITION = POSITION + NCBSON + POSITION = POSITION - IPOS + IF ( POSITION * SIZEofINT .NE. SIZE ) THEN + WRITE(*,*) 'Error in ZMUMPS_71 :', + & ' wrong estimated size' + CALL MUMPS_ABORT() + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, + & MPI_PACKED, + & DEST( NDEST ), MAPLIG, COMM, + & BUF_CB%CONTENT( IREQ ), + & IERR ) + ELSE + NSEND = 0 + DO IDEST = 1, NDEST + IF ( DEST( IDEST ) .ne. MYID ) NSEND = NSEND + 1 + END DO + SIZE = SIZEofINT * + & ( ( OVHSIZE + 7 + NSLAVES )* NSEND + NCBSON ) + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + SIZE = SIZE + SIZEofINT * NSEND*( NSLAVES + 1 ) + ENDIF + CALL ZMUMPS_79( BUF_CB, SIZE_AV ) + IF ( SIZE_AV .LT. SIZE ) THEN + IERR = -1 + RETURN + END IF + DO IDEST= 1, NDEST + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & IDEST, NCBSON, + & NDEST, + & TROW_SIZE, INDX ) + SIZE = SIZEofINT * ( NSLAVES + TROW_SIZE + 7 ) + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + SIZE = SIZE + SIZEofINT * ( NSLAVES + 1 ) + ENDIF + IF ( MYID .NE. DEST( IDEST ) ) THEN + CALL ZMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & IONE, DEST(IDEST) + & ) + IF ( IERR .LT. 0 ) THEN + WRITE(*,*) 'Problem in ZMUMPS_4: IERR<0' + CALL MUMPS_ABORT() + END IF + IF (SIZE.GT.SIZE_RBUF_BYTES) THEN + IERR = -3 + RETURN + ENDIF + POSITION = IPOS + BUF_CB%CONTENT( POSITION ) = INODE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = ISON + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NSLAVES + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFRONT + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NASS1 + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = TROW_SIZE + POSITION = POSITION + 1 + BUF_CB%CONTENT( POSITION ) = NFS4FATHER + POSITION = POSITION + 1 + IF (( NSLAVES.GT.0 ) .AND. (KEEP(48).NE.0) ) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES ) + & = TAB_POS_IN_PERE(1:NSLAVES+1,INIV2) + POSITION = POSITION + NSLAVES + 1 + ENDIF + IF ( NSLAVES .NE. 0 ) THEN + BUF_CB%CONTENT( POSITION: POSITION + NSLAVES - 1 ) + & = SLAVES_PERE( 1: NSLAVES ) + POSITION = POSITION + NSLAVES + END IF + BUF_CB%CONTENT( POSITION:POSITION+TROW_SIZE-1 ) = + & TROW( INDX: INDX + TROW_SIZE - 1 ) + POSITION = POSITION + TROW_SIZE + POSITION = POSITION - IPOS + IF ( POSITION * SIZEofINT .NE. SIZE ) THEN + WRITE(*,*) ' ERROR 1 in TRY_SEND_MAPLIG:', + & 'Wrong estimated size' + CALL MUMPS_ABORT() + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), SIZE, + & MPI_PACKED, + & DEST( IDEST ), MAPLIG, COMM, + & BUF_CB%CONTENT( IREQ ), + & IERR ) + END IF + END DO + END IF + 500 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_71 + SUBROUTINE ZMUMPS_65( INODE, NFRONT, + & NCOL, NPIV, FPERE, LASTBL, IPIV, VAL, + & PDEST, NDEST, KEEP50, NB_BLOC_FAC, COMM, IERR ) + IMPLICIT NONE + INTEGER INODE, NCOL, NPIV, FPERE, NFRONT, NDEST + INTEGER IPIV( NPIV ) + COMPLEX(kind=8) VAL( NFRONT, * ) + INTEGER PDEST( NDEST ) + INTEGER KEEP50, NB_BLOC_FAC, COMM, IERR + LOGICAL LASTBL + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE, + & IDEST, IPOSMSG, I + INTEGER NPIVSENT + INTEGER SSS, SS2 + IERR = 0 + IF ( LASTBL ) THEN + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 4 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + ELSE + CALL MPI_PACK_SIZE( 6 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + END IF + ELSE + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 3 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + ELSE + CALL MPI_PACK_SIZE( 4 + NPIV + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + END IF + END IF + SIZE2 = 0 + IF (NPIV.GT.0) + & CALL MPI_PACK_SIZE( NPIV*NCOL, MPI_DOUBLE_COMPLEX, + & COMM, SIZE2, IERR ) + SIZE = SIZE1 + SIZE2 + CALL ZMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & NDEST , PDEST + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + IF (SIZE.GT.SIZE_RBUF_BYTES) THEN + SSS = 0 + IF ( LASTBL ) THEN + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 4 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + ELSE + CALL MPI_PACK_SIZE( 6 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + END IF + ELSE + IF ( KEEP50 .eq. 0 ) THEN + CALL MPI_PACK_SIZE( 3 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + ELSE + CALL MPI_PACK_SIZE( 4 + NPIV , + & MPI_INTEGER, COMM, SSS, IERR ) + END IF + END IF + IF (NPIV.GT.0) + & CALL MPI_PACK_SIZE( NPIV*NCOL, MPI_DOUBLE_COMPLEX, + & COMM, SS2, IERR ) + SSS = SSS + SS2 + IF (SSS.GT.SIZE_RBUF_BYTES) THEN + IERR = -2 + RETURN + ENDIF + ENDIF + BUF_CB%ILASTMSG = BUF_CB%ILASTMSG + ( NDEST - 1 ) * OVHSIZE + IPOS = IPOS - OVHSIZE + DO IDEST = 1, NDEST - 1 + BUF_CB%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = + & IPOS + IDEST * OVHSIZE + END DO + BUF_CB%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 + IPOSMSG = IPOS + OVHSIZE * NDEST + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + NPIVSENT = NPIV + IF (LASTBL) NPIVSENT = -NPIV + CALL MPI_PACK( NPIVSENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + IF ( LASTBL .or. KEEP50.ne.0 ) THEN + CALL MPI_PACK( FPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + END IF + IF ( LASTBL .AND. KEEP50 .NE. 0 ) THEN + CALL MPI_PACK( NDEST, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NB_BLOC_FAC, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + END IF + CALL MPI_PACK( NCOL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + IF ( NPIV.GT.0) THEN + CALL MPI_PACK( IPIV, NPIV, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + DO I = 1, NPIV + CALL MPI_PACK( VAL(1,I), NCOL, + & MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + END DO + ENDIF + DO IDEST = 1, NDEST + IF ( KEEP50.eq.0) THEN + CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, + & PDEST(IDEST), BLOC_FACTO, COMM, + & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), + & IERR ) + ELSE + CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, + & PDEST(IDEST), BLOC_FACTO_SYM, COMM, + & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), + & IERR ) + END IF + END DO + SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT + IF ( SIZE .LT. POSITION ) THEN + WRITE(*,*) ' Error sending blocfacto : size < position' + WRITE(*,*) ' Size,position=',SIZE,POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE .NE. POSITION ) CALL ZMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE ZMUMPS_65 + SUBROUTINE ZMUMPS_64( INODE, + & NPIV, FPERE, IPOSK, JPOSK, UIP21K, NCOLU, + & NDEST, PDEST, COMM, IERR ) + IMPLICIT NONE + INTEGER INODE, NCOLU, IPOSK, JPOSK, NPIV, NDEST, FPERE + COMPLEX(kind=8) UIP21K( NPIV, NCOLU ) + INTEGER PDEST( NDEST ) + INTEGER COMM, IERR + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE, + & IDEST, IPOSMSG, SSS, SS2 + IERR = 0 + CALL MPI_PACK_SIZE( 6 + ( NDEST - 1 ) * OVHSIZE, + & MPI_INTEGER, COMM, SIZE1, IERR ) + CALL MPI_PACK_SIZE( abs(NPIV)*NCOLU, MPI_DOUBLE_COMPLEX, + & COMM, SIZE2, IERR ) + SIZE = SIZE1 + SIZE2 + IF (SIZE.GT.SIZE_RBUF_BYTES) THEN + CALL MPI_PACK_SIZE( 6 , + & MPI_INTEGER, COMM, SSS, IERR ) + CALL MPI_PACK_SIZE( abs(NPIV)*NCOLU, MPI_DOUBLE_COMPLEX, + & COMM, SS2, IERR ) + SSS = SSS+SS2 + IF (SSS.GT.SIZE_RBUF_BYTES) THEN + IERR = -2 + RETURN + ENDIF + END IF + CALL ZMUMPS_4( BUF_CB, IPOS, IREQ, SIZE, IERR, + & NDEST, PDEST + & ) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + BUF_CB%ILASTMSG = BUF_CB%ILASTMSG + ( NDEST - 1 ) * OVHSIZE + IPOS = IPOS - OVHSIZE + DO IDEST = 1, NDEST - 1 + BUF_CB%CONTENT( IPOS + ( IDEST - 1 ) * OVHSIZE ) = + & IPOS + IDEST * OVHSIZE + END DO + BUF_CB%CONTENT( IPOS + ( NDEST - 1 ) * OVHSIZE ) = 0 + IPOSMSG = IPOS + OVHSIZE * NDEST + POSITION = 0 + CALL MPI_PACK( INODE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( IPOSK, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( JPOSK, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NPIV, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( FPERE, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( NCOLU, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + CALL MPI_PACK( UIP21K, abs(NPIV) * NCOLU, + & MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOSMSG ), SIZE, + & POSITION, COMM, IERR ) + DO IDEST = 1, NDEST + CALL MPI_ISEND( BUF_CB%CONTENT( IPOSMSG ), POSITION, MPI_PACKED, + & PDEST(IDEST), BLOC_FACTO_SYM_SLAVE, COMM, + & BUF_CB%CONTENT( IREQ + ( IDEST-1 ) * OVHSIZE ), + & IERR ) + END DO + SIZE = SIZE - ( NDEST - 1 ) * OVHSIZE * SIZEofINT + IF ( SIZE .LT. POSITION ) THEN + WRITE(*,*) ' Error sending blfac slave : size < position' + WRITE(*,*) ' Size,position=',SIZE,POSITION + CALL MUMPS_ABORT() + END IF + IF ( SIZE .NE. POSITION ) CALL ZMUMPS_1( BUF_CB, POSITION ) + RETURN + END SUBROUTINE ZMUMPS_64 + SUBROUTINE ZMUMPS_648( N, ISON, + & NBCOL_SON, NBROW_SON, INDCOL_SON, INDROW_SON, + & LD_SON, VAL_SON, TAG, SUBSET_ROW, SUBSET_COL, + & NSUBSET_ROW, NSUBSET_COL, + & NSUPROW, NSUPCOL, + & NPROW, NPCOL, MBLOCK, RG2L_ROW, RG2L_COL, + & NBLOCK, PDEST, COMM, IERR , + & TAB, TABSIZE, TRANSP, SIZE_PACK, + & N_ALREADY_SENT, KEEP, BBPCBP ) + IMPLICIT NONE + INTEGER N, ISON, NBCOL_SON, NBROW_SON, NSUBSET_ROW, NSUBSET_COL + INTEGER NPROW, NPCOL, MBLOCK, NBLOCK, LD_SON + INTEGER BBPCBP + INTEGER PDEST, TAG, COMM, IERR + INTEGER INDCOL_SON( NBCOL_SON ), INDROW_SON( NBROW_SON ) + INTEGER SUBSET_ROW( NSUBSET_ROW ), SUBSET_COL( NSUBSET_COL ) + INTEGER, DIMENSION(:) :: RG2L_ROW + INTEGER, DIMENSION(:) :: RG2L_COL + INTEGER NSUPROW, NSUPCOL + INTEGER(8), INTENT(IN) :: TABSIZE + INTEGER SIZE_PACK + INTEGER KEEP(500) + COMPLEX(kind=8) VAL_SON( LD_SON, * ), TAB(*) + LOGICAL TRANSP + INTEGER N_ALREADY_SENT + INCLUDE 'mpif.h' + INTEGER SIZE1, SIZE2, SIZE_AV, POSITION + INTEGER SIZE_CBP, SIZE_TMP + INTEGER IREQ, IPOS, ITAB + INTEGER ISUB, JSUB, I, J + INTEGER ILOC_ROOT, JLOC_ROOT + INTEGER IPOS_ROOT, JPOS_ROOT + INTEGER IONE + LOGICAL RECV_BUF_SMALLER_THAN_SEND + INTEGER PDEST2(1) + PARAMETER ( IONE=1 ) + INTEGER N_PACKET + INTEGER NSUBSET_ROW_EFF, NSUBSET_COL_EFF, NSUPCOL_EFF + PDEST2(1) = PDEST + IERR = 0 + IF ( NSUBSET_ROW * NSUBSET_COL .NE. 0 ) THEN + CALL ZMUMPS_79( BUF_CB, SIZE_AV ) + IF (SIZE_AV .LT. SIZE_RBUF_BYTES) THEN + RECV_BUF_SMALLER_THAN_SEND = .FALSE. + ELSE + RECV_BUF_SMALLER_THAN_SEND = .TRUE. + SIZE_AV = SIZE_RBUF_BYTES + ENDIF + SIZE_AV = min(SIZE_AV, SIZE_RBUF_BYTES) + CALL MPI_PACK_SIZE(8 + NSUBSET_COL, + & MPI_INTEGER, COMM, SIZE1, IERR ) + SIZE_CBP = 0 + IF (N_ALREADY_SENT .EQ. 0 .AND. + & min(NSUPROW,NSUPCOL) .GT.0) THEN + CALL MPI_PACK_SIZE(NSUPROW, MPI_INTEGER, COMM, + & SIZE_CBP, IERR) + CALL MPI_PACK_SIZE(NSUPCOL, MPI_INTEGER, COMM, + & SIZE_TMP, IERR) + SIZE_CBP = SIZE_CBP + SIZE_TMP + CALL MPI_PACK_SIZE(NSUPROW*NSUPCOL, + & MPI_DOUBLE_COMPLEX, COMM, + & SIZE_TMP, IERR) + SIZE_CBP = SIZE_CBP + SIZE_TMP + SIZE1 = SIZE1 + SIZE_CBP + ENDIF + IF (BBPCBP.EQ.1) THEN + NSUBSET_COL_EFF = NSUBSET_COL - NSUPCOL + NSUPCOL_EFF = 0 + ELSE + NSUBSET_COL_EFF = NSUBSET_COL + NSUPCOL_EFF = NSUPCOL + ENDIF + NSUBSET_ROW_EFF = NSUBSET_ROW - NSUPROW + N_PACKET = + & (SIZE_AV - SIZE1) / (SIZEofINT + NSUBSET_COL_EFF * SIZEofREAL) + 10 CONTINUE + N_PACKET = min( N_PACKET, + & NSUBSET_ROW_EFF-N_ALREADY_SENT ) + IF (N_PACKET .LE. 0 .AND. + & NSUBSET_ROW_EFF-N_ALREADY_SENT.GT.0) THEN + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR=-3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + CALL MPI_PACK_SIZE( 8 + NSUBSET_COL_EFF + N_PACKET, + & MPI_INTEGER, COMM, SIZE1, IERR ) + SIZE1 = SIZE1 + SIZE_CBP + CALL MPI_PACK_SIZE( N_PACKET * NSUBSET_COL_EFF, + & MPI_DOUBLE_COMPLEX, + & COMM, SIZE2, IERR ) + SIZE_PACK = SIZE1 + SIZE2 + IF (SIZE_PACK .GT. SIZE_AV) THEN + N_PACKET = N_PACKET - 1 + IF ( N_PACKET > 0 ) THEN + GOTO 10 + ELSE + IF (RECV_BUF_SMALLER_THAN_SEND) THEN + IERR = -3 + GOTO 100 + ELSE + IERR = -1 + GOTO 100 + ENDIF + ENDIF + ENDIF +#if ! defined(DBG_SMB3) + IF (N_PACKET + N_ALREADY_SENT .NE. NSUBSET_ROW - NSUPROW + & .AND. + & SIZE_PACK .LT. SIZE_RBUF_BYTES / 4 + & .AND. .NOT. RECV_BUF_SMALLER_THAN_SEND) + & THEN + IERR = -1 + GOTO 100 + ENDIF +#endif + ELSE + N_PACKET = 0 + CALL MPI_PACK_SIZE(8,MPI_INTEGER, COMM, SIZE_PACK, IERR ) + END IF + CALL ZMUMPS_4( BUF_CB, IPOS, IREQ, SIZE_PACK, IERR, + & IONE, PDEST2 + & ) + IF ( IERR .LT. 0 ) GOTO 100 + IF ( SIZE_PACK.GT.SIZE_RBUF_BYTES ) THEN + IERR = -3 + GOTO 100 + ENDIF + POSITION = 0 + CALL MPI_PACK( ISON, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUBSET_ROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUPROW, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUBSET_COL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( NSUPCOL, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( N_ALREADY_SENT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( N_PACKET, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + CALL MPI_PACK( BBPCBP, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + IF ( NSUBSET_ROW * NSUBSET_COL .NE. 0 ) THEN + IF (N_ALREADY_SENT .EQ. 0 .AND. + & min(NSUPROW, NSUPCOL) .GT. 0) THEN + DO ISUB = NSUBSET_ROW-NSUPROW+1, NSUBSET_ROW + I = SUBSET_ROW( ISUB ) + IPOS_ROOT = RG2L_ROW(INDCOL_SON( I )) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + DO ISUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL + J = SUBSET_COL( ISUB ) + JPOS_ROOT = INDROW_SON( J ) - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + IF ( TABSIZE.GE.int(NSUPROW,8)*int(NSUPCOL,8) ) THEN + ITAB = 1 + DO JSUB = NSUBSET_ROW - NSUPROW+1, NSUBSET_ROW + J = SUBSET_ROW(JSUB) + DO ISUB = NSUBSET_COL - NSUPCOL+1, NSUBSET_COL + I = SUBSET_COL(ISUB) + TAB(ITAB) = VAL_SON(J, I) + ITAB = ITAB + 1 + ENDDO + ENDDO + CALL MPI_PACK(TAB(1), NSUPROW*NSUPCOL, + & MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ELSE + DO JSUB = NSUBSET_ROW - NSUPROW+1, NSUBSET_ROW + J = SUBSET_ROW(JSUB) + DO ISUB = NSUBSET_COL - NSUPCOL+1, NSUBSET_COL + I = SUBSET_COL(ISUB) + CALL MPI_PACK(VAL_SON(J,I), 1, + & MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + ENDDO + ENDIF + ENDIF + IF ( .NOT. TRANSP ) THEN + DO ISUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + I = SUBSET_ROW( ISUB ) + IPOS_ROOT = RG2L_ROW( INDROW_SON( I ) ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO JSUB = 1, NSUBSET_COL_EFF - NSUPCOL_EFF + J = SUBSET_COL( JSUB ) + JPOS_ROOT = RG2L_COL( INDCOL_SON( J ) ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO JSUB = NSUBSET_COL_EFF-NSUPCOL_EFF+1, NSUBSET_COL_EFF + J = SUBSET_COL( JSUB ) + JPOS_ROOT = INDCOL_SON( J ) - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + ELSE + DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + J = SUBSET_ROW( JSUB ) + IPOS_ROOT = RG2L_ROW( INDCOL_SON( J ) ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + CALL MPI_PACK( ILOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO ISUB = 1, NSUBSET_COL_EFF - NSUPCOL_EFF + I = SUBSET_COL( ISUB ) + JPOS_ROOT = RG2L_COL( INDROW_SON( I ) ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + DO ISUB = NSUBSET_COL_EFF - NSUPCOL_EFF + 1, NSUBSET_COL_EFF + I = SUBSET_COL( ISUB ) + JPOS_ROOT = INDROW_SON(I) - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + CALL MPI_PACK( JLOC_ROOT, 1, MPI_INTEGER, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ENDDO + END IF + IF ( TABSIZE.GE.int(N_PACKET,8)*int(NSUBSET_COL_EFF,8) ) THEN + IF ( .NOT. TRANSP ) THEN + ITAB = 1 + DO ISUB = N_ALREADY_SENT+1, + & N_ALREADY_SENT+N_PACKET + I = SUBSET_ROW( ISUB ) + DO JSUB = 1, NSUBSET_COL_EFF + J = SUBSET_COL( JSUB ) + TAB( ITAB ) = VAL_SON(J,I) + ITAB = ITAB + 1 + END DO + END DO + CALL MPI_PACK(TAB(1), NSUBSET_COL_EFF*N_PACKET, + & MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + ELSE + ITAB = 1 + DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + J = SUBSET_ROW( JSUB ) + DO ISUB = 1, NSUBSET_COL_EFF + I = SUBSET_COL( ISUB ) + TAB( ITAB ) = VAL_SON( J, I ) + ITAB = ITAB + 1 + END DO + END DO + CALL MPI_PACK(TAB(1), NSUBSET_COL_EFF*N_PACKET, + & MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END IF + ELSE + IF ( .NOT. TRANSP ) THEN + DO ISUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + I = SUBSET_ROW( ISUB ) + DO JSUB = 1, NSUBSET_COL_EFF + J = SUBSET_COL( JSUB ) + CALL MPI_PACK( VAL_SON( J, I ), 1, + & MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + END DO + ELSE + DO JSUB = N_ALREADY_SENT+1, N_ALREADY_SENT+N_PACKET + J = SUBSET_ROW( JSUB ) + DO ISUB = 1, NSUBSET_COL_EFF + I = SUBSET_COL( ISUB ) + CALL MPI_PACK( VAL_SON( J, I ), 1, + & MPI_DOUBLE_COMPLEX, + & BUF_CB%CONTENT( IPOS ), + & SIZE_PACK, POSITION, COMM, IERR ) + END DO + END DO + END IF + ENDIF + END IF + CALL MPI_ISEND( BUF_CB%CONTENT( IPOS ), POSITION, MPI_PACKED, + & PDEST, TAG, COMM, BUF_CB%CONTENT( IREQ ), IERR ) + IF ( SIZE_PACK .LT. POSITION ) THEN + WRITE(*,*) ' Error sending contribution to root:Sizeid%ISTEP_TO_INIV2 + CAND_LOAD=>id%CANDIDATES + ND_LOAD=>id%ND_STEPS + KEEP_LOAD=>id%KEEP + KEEP =>id%KEEP + KEEP8_LOAD=>id%KEEP8 + FILS_LOAD=>id%FILS + FRERE_LOAD=>id%FRERE_STEPS + DAD_LOAD=>id%DAD_STEPS + PROCNODE_LOAD=>id%PROCNODE_STEPS + STEP_LOAD=>id%STEP + NE_LOAD=>id%NE_STEPS + N_LOAD=id%N + ROOT_CURRENT_SUBTREE=-9999 + MEMORY_MD=MEMORY_MD_ARG + LA=MAXS + MAX_SURF_MASTER=id%MAX_SURF_MASTER+ + & (int(id%KEEP(12),8)*int(id%MAX_SURF_MASTER,8)/int(100,8)) + COMM_LD = id%COMM_LOAD + MAX_PEAK_STK = 0.0D0 + K69 = KEEP(69) + IF ( KEEP(47) .le. 0 .OR. KEEP(47) .gt. 4 ) THEN + write(*,*) "Internal error 1 in ZMUMPS_185" + CALL MUMPS_ABORT() + END IF + CHK_LD=dble(0) + BDC_MEM = ( KEEP(47) >= 2 ) + BDC_POOL = ( KEEP(47) >= 3 ) + BDC_SBTR = ( KEEP(47) >= 4 ) + BDC_M2_MEM = ( ( KEEP(80) == 2 .OR. KEEP(80) == 3 ) + & .AND. KEEP(47) == 4 ) + BDC_M2_FLOPS = ( KEEP(80) == 1 + & .AND. KEEP(47) .GE. 1 ) + BDC_MD = (KEEP(86)==1) + SBTR_WHICH_M = KEEP(90) + REMOVE_NODE_FLAG=.FALSE. + REMOVE_NODE_FLAG_MEM=.FALSE. + REMOVE_NODE_COST_MEM=dble(0) + REMOVE_NODE_COST=dble(0) + IF (KEEP(80) .LT. 0 .OR. KEEP(80)>3) THEN + WRITE(*,*) "Unimplemented KEEP(80) Strategy" + CALL MUMPS_ABORT() + ENDIF + IF ((KEEP(80) == 2 .OR. KEEP(80)==3 ).AND. KEEP(47).NE.4) + & THEN + WRITE(*,*) "Internal error 3 in ZMUMPS_185" + CALL MUMPS_ABORT() + END IF + IF (KEEP(81) == 1 .AND. KEEP(47) < 2) THEN + WRITE(*,*) "Internal error 2 in ZMUMPS_185" + CALL MUMPS_ABORT() + ENDIF + BDC_POOL_MNG = ((KEEP(81) == 1).AND.(KEEP(47) >= 2)) + IF(KEEP(76).EQ.4)THEN + DEPTH_FIRST_LOAD=>id%DEPTH_FIRST + ENDIF + IF(KEEP(76).EQ.5)THEN + COST_TRAV=>id%COST_TRAV + ENDIF + IF(KEEP(76).EQ.6)THEN + DEPTH_FIRST_LOAD=>id%DEPTH_FIRST + DEPTH_FIRST_SEQ_LOAD=>id%DEPTH_FIRST_SEQ + SBTR_ID_LOAD=>id%SBTR_ID + ENDIF + IF (BDC_M2_MEM.OR.BDC_M2_FLOPS) THEN + ALLOCATE(NIV2(id%NSLAVES), NB_SON(KEEP(28)), + & POOL_NIV2(100),POOL_NIV2_COST(100), + & stat=allocok) + NB_SON=id%NE_STEPS + NIV2=dble(0) + IF (allocok > 0) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = id%NSLAVES + KEEP(28) + 200 + RETURN + ENDIF + ENDIF + K50 = id%KEEP(50) + CALL MPI_COMM_RANK( COMM_LD, MYID, IERR ) + NPROCS = id%NSLAVES + DM_SUMLU=ZERO + POOL_SIZE=0 + IF(BDC_MD)THEN + IF ( allocated(MD_MEM) ) DEALLOCATE(MD_MEM) + ALLOCATE( MD_MEM( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(TAB_MAXS) ) DEALLOCATE(TAB_MAXS) + ALLOCATE( TAB_MAXS( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + TAB_MAXS=0_8 + IF ( allocated(LU_USAGE) ) DEALLOCATE(LU_USAGE) + ALLOCATE( LU_USAGE( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + LU_USAGE=dble(0) + MD_MEM=int(0,8) + ENDIF + IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN + ALLOCATE(CB_COST_MEM(2*2000*id%NSLAVES), + & stat=allocok) + IF (allocok > 0) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = id%NSLAVES + RETURN + ENDIF + CB_COST_MEM=int(0,8) + ALLOCATE(CB_COST_ID(2000*3), + & stat=allocok) + IF (allocok > 0) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = id%NSLAVES + RETURN + ENDIF + CB_COST_ID=0 + POS_MEM=1 + POS_ID=1 + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + ALLOCATE(FUTURE_NIV2(NPROCS), stat=allocok) + IF (allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + ENDIF + DO i = 1, NPROCS + FUTURE_NIV2(i) = id%FUTURE_NIV2(i) + IF(BDC_MD)THEN + IF(FUTURE_NIV2(i).EQ.0)THEN + MD_MEM(i-1)=999999999_8 + ENDIF + ENDIF + ENDDO + DELTA_MEM=ZERO + DELTA_LOAD=ZERO +#endif + CHECK_MEM=0_8 +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + NB_LEVEL2=0 + AMI_CHOSEN=.FALSE. + IS_DISPLAYED=.FALSE. +#endif +#endif + IF(BDC_SBTR.OR.BDC_POOL_MNG)THEN + NB_SUBTREES=id%NBSA_LOCAL + IF (allocated(MEM_SUBTREE)) DEALLOCATE(MEM_SUBTREE) + ALLOCATE(MEM_SUBTREE(id%NBSA_LOCAL),stat=allocok) + DO i=1,id%NBSA_LOCAL + MEM_SUBTREE(i)=id%MEM_SUBTREE(i) + ENDDO + MY_FIRST_LEAF=>id%MY_FIRST_LEAF + MY_NB_LEAF=>id%MY_NB_LEAF + MY_ROOT_SBTR=>id%MY_ROOT_SBTR + IF (allocated(SBTR_FIRST_POS_IN_POOL)) + & DEALLOCATE(SBTR_FIRST_POS_IN_POOL) + ALLOCATE(SBTR_FIRST_POS_IN_POOL(id%NBSA_LOCAL),stat=allocok) + INSIDE_SUBTREE=0 + PEAK_SBTR_CUR_LOCAL = dble(0) + SBTR_CUR_LOCAL = dble(0) + IF (allocated(SBTR_PEAK_ARRAY)) DEALLOCATE(SBTR_PEAK_ARRAY) + ALLOCATE(SBTR_PEAK_ARRAY(id%NBSA_LOCAL),stat=allocok) + SBTR_PEAK_ARRAY=dble(0) + IF (allocated(SBTR_CUR_ARRAY)) DEALLOCATE(SBTR_CUR_ARRAY) + ALLOCATE(SBTR_CUR_ARRAY(id%NBSA_LOCAL),stat=allocok) + SBTR_CUR_ARRAY=dble(0) + INDICE_SBTR_ARRAY=1 + NIV1_FLAG=0 + INDICE_SBTR=1 + ENDIF + IF ( allocated(LOAD_FLOPS) ) DEALLOCATE( LOAD_FLOPS ) + ALLOCATE( LOAD_FLOPS( 0: NPROCS - 1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(WLOAD) ) DEALLOCATE( WLOAD ) + ALLOCATE( WLOAD( NPROCS ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(IDWLOAD) ) DEALLOCATE( IDWLOAD ) + ALLOCATE( IDWLOAD( NPROCS ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( BDC_MEM ) THEN + IF ( allocated(DM_MEM) ) DEALLOCATE( DM_MEM ) + ALLOCATE( DM_MEM( 0:NPROCS-1 ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + END IF + IF ( BDC_POOL ) THEN + IF ( allocated(POOL_MEM) ) DEALLOCATE(POOL_MEM) + ALLOCATE( POOL_MEM(0: NPROCS -1), stat=allocok) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + POOL_MEM = dble(0) + POOL_LAST_COST_SENT = dble(0) + END IF + IF ( BDC_SBTR ) THEN + IF ( allocated(SBTR_MEM) ) DEALLOCATE(SBTR_MEM) + ALLOCATE( SBTR_MEM(0: NPROCS -1), stat=allocok) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + IF ( allocated(SBTR_CUR) ) DEALLOCATE(SBTR_CUR) + ALLOCATE( SBTR_CUR(0: NPROCS -1), stat=allocok) + IF ( allocok .gt. 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = NPROCS + RETURN + END IF + SBTR_CUR = dble(0) + SBTR_MEM = dble(0) + END IF + CALL MUMPS_546(K34_LOC,K35_LOC) + K35 = K35_LOC + BUF_LOAD_SIZE = K34_LOC * 2 * ( NPROCS - 1 ) + + & NPROCS * ( K35_LOC + K34_LOC ) + IF (BDC_MEM) THEN + BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35_LOC + END IF + IF (BDC_SBTR)THEN + BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35_LOC + ENDIF + LBUF_LOAD_RECV = (BUF_LOAD_SIZE+K34_LOC)/K34_LOC + LBUF_LOAD_RECV_BYTES = LBUF_LOAD_RECV * K34_LOC + IF ( allocated(BUF_LOAD_RECV) ) DEALLOCATE(BUF_LOAD_RECV) + ALLOCATE( BUF_LOAD_RECV( LBUF_LOAD_RECV), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_185' + id%INFO(1) = -13 + id%INFO(2) = LBUF_LOAD_RECV + RETURN + ENDIF + BUF_LOAD_SIZE = BUF_LOAD_SIZE * 20 + CALL ZMUMPS_54( BUF_LOAD_SIZE, IERR ) + IF ( IERR .LT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = BUF_LOAD_SIZE + RETURN + END IF + DO i = 0, NPROCS - 1 + LOAD_FLOPS( i ) = ZERO + END DO +#if defined(OLD_LOAD_MECHANISM) + LOAD_FLOPS( MYID ) = COST_SUBTREE + LAST_LOAD_SENT = ZERO +#endif + IF ( BDC_MEM ) THEN + DO i = 0, NPROCS - 1 + DM_MEM( i )=ZERO + END DO +#if defined(OLD_LOAD_MECHANISM) + DM_LAST_MEM_SENT=ZERO +#endif + ENDIF + CALL ZMUMPS_425(KEEP(69)) + IF(BDC_MD)THEN + MAX_SBTR=0.0D0 + IF(BDC_SBTR)THEN + DO i=1,id%NBSA_LOCAL + MAX_SBTR=max(id%MEM_SUBTREE(i),MAX_SBTR) + ENDDO + ENDIF + MD_MEM(MYID)=MEMORY_MD + WHAT=8 + CALL ZMUMPS_460( WHAT, + & COMM_LD, NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & dble(MEMORY_MD),dble(0) ,MYID, IERR ) + WHAT=9 + MEMORY_SENT = dble(LA-MAX_SURF_MASTER)-MAX_SBTR + & - max( dble(LA) * dble(3) / dble(100), + & dble(2) * dble(max(KEEP(5),KEEP(6))) * dble(KEEP(127))) + IF (KEEP(12) > 25) THEN + MEMORY_SENT = MEMORY_SENT - + & dble(KEEP(12))*0.2d0*dble(LA)/100.0d0 + ENDIF + TAB_MAXS(MYID)=int(MEMORY_SENT,8) + CALL ZMUMPS_460( WHAT, + & COMM_LD, NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & MEMORY_SENT, + & dble(0),MYID, IERR ) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_185 + SUBROUTINE ZMUMPS_190( CHECK_FLOPS,PROCESS_BANDE, + & INC_LOAD, KEEP,KEEP8 ) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + DOUBLE PRECISION INC_LOAD + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + LOGICAL PROCESS_BANDE + INTEGER CHECK_FLOPS + INTEGER IERR + DOUBLE PRECISION ZERO, SEND_MEM, SEND_LOAD,SBTR_TMP + PARAMETER( ZERO=0.0d0 ) + INTRINSIC max, abs + IF (INC_LOAD == 0.0D0) THEN + IF(REMOVE_NODE_FLAG)THEN + REMOVE_NODE_FLAG=.FALSE. + ENDIF + RETURN + ENDIF + IF((CHECK_FLOPS.NE.0).AND. + & (CHECK_FLOPS.NE.1).AND.(CHECK_FLOPS.NE.2))THEN + WRITE(*,*)MYID,': Bad value for CHECK_FLOPS' + CALL MUMPS_ABORT() + ENDIF + IF(CHECK_FLOPS.EQ.1)THEN + CHK_LD=CHK_LD+INC_LOAD + ELSE + IF(CHECK_FLOPS.EQ.2)THEN + RETURN + ENDIF + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF ( PROCESS_BANDE ) THEN + RETURN + ENDIF +#endif + LOAD_FLOPS( MYID ) = max( LOAD_FLOPS( MYID ) + INC_LOAD, ZERO) + IF(BDC_M2_FLOPS.AND.REMOVE_NODE_FLAG)THEN + IF(INC_LOAD.NE.REMOVE_NODE_COST)THEN + IF(INC_LOAD.GT.REMOVE_NODE_COST)THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = DELTA_LOAD + + & (INC_LOAD-REMOVE_NODE_COST) + GOTO 888 +#else + GOTO 888 +#endif + ELSE +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = DELTA_LOAD - + & (REMOVE_NODE_COST-INC_LOAD) + GOTO 888 +#else + GOTO 888 +#endif + ENDIF + ENDIF + GOTO 333 + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = DELTA_LOAD + INC_LOAD + 888 CONTINUE + IF ( DELTA_LOAD > MIN_DIFF .OR. DELTA_LOAD < -MIN_DIFF) THEN + SEND_LOAD = DELTA_LOAD + IF (BDC_MEM) THEN + SEND_MEM = DELTA_MEM + ELSE + SEND_MEM = ZERO + END IF +#else + 888 CONTINUE + IF ( abs( LOAD_FLOPS ( MYID ) - + & LAST_LOAD_SENT ).GT.MIN_DIFF)THEN + IERR = 0 + SEND_LOAD = LOAD_FLOPS( MYID ) + IF ( BDC_MEM ) THEN + SEND_MEM = DM_MEM(MYID) + ELSE + SEND_MEM = ZERO + END IF +#endif + IF(BDC_SBTR)THEN + SBTR_TMP=SBTR_CUR(MYID) + ELSE + SBTR_TMP=dble(0) + ENDIF + 111 CONTINUE + CALL ZMUMPS_77( BDC_SBTR,BDC_MEM, + & BDC_MD,COMM_LD, NPROCS, + & SEND_LOAD, + & SEND_MEM,SBTR_TMP, + & DM_SUMLU, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & MYID, IERR ) + IF ( IERR == -1 )THEN + CALL ZMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE.0 ) THEN + WRITE(*,*) "Internal Error in ZMUMPS_190",IERR + CALL MUMPS_ABORT() + ENDIF + IF ( IERR .EQ. 0 ) THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = ZERO + IF (BDC_MEM) DELTA_MEM = ZERO +#else + LAST_LOAD_SENT = LOAD_FLOPS( MYID ) + IF ( BDC_MEM ) DM_LAST_MEM_SENT = DM_MEM( MYID ) +#endif + END IF + ENDIF + 333 CONTINUE + IF(REMOVE_NODE_FLAG)THEN + REMOVE_NODE_FLAG=.FALSE. + ENDIF + RETURN + END SUBROUTINE ZMUMPS_190 + SUBROUTINE ZMUMPS_471( SSARBR, + & PROCESS_BANDE_ARG, MEM_VALUE, NEW_LU, INC_MEM_ARG, + & KEEP,KEEP8,LRLU) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER(8), INTENT(IN) :: MEM_VALUE, INC_MEM_ARG, NEW_LU,LRLU + LOGICAL, INTENT(IN) :: PROCESS_BANDE_ARG, SSARBR + INTEGER IERR, KEEP(500) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION ZERO, SEND_MEM, SBTR_TMP + PARAMETER( ZERO=0.0d0 ) + INTRINSIC max, abs + INTEGER(8) :: INC_MEM + LOGICAL PROCESS_BANDE +#if defined(OLD_LOAD_MECHANISM) + DOUBLE PRECISION TMP_MEM +#endif + PROCESS_BANDE=PROCESS_BANDE_ARG + INC_MEM = INC_MEM_ARG +#if ! defined(OLD_LOAD_MECHANISM) + IF ( PROCESS_BANDE .AND. NEW_LU .NE. 0_8) THEN + WRITE(*,*) " Internal Error in ZMUMPS_471." + WRITE(*,*) " NEW_LU must be zero if called from PROCESS_BANDE" + CALL MUMPS_ABORT() + ENDIF +#endif +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + IF(PROCESS_BANDE)THEN + PROCESS_BANDE=.FALSE. + NB_LEVEL2=NB_LEVEL2-1 + IF(NB_LEVEL2.LT.0)THEN + WRITE(*,*)MYID,': problem with NB_LEVEL2' + ELSEIF(NB_LEVEL2.EQ.0)THEN + IF(IS_DISPLAYED)THEN +#if defined(STATS_DYNAMIC_MEMORY) + WRITE(*,*)MYID,': end of Incoherent state at time=', + & MPI_WTIME()-TIME_REF +#endif + IS_DISPLAYED=.FALSE. + ENDIF + AMI_CHOSEN=.FALSE. + ENDIF + ENDIF + IF((KEEP(73).EQ.0).AND.(NB_LEVEL2.NE.0) + & .AND.(.NOT.IS_DISPLAYED))THEN + IS_DISPLAYED=.TRUE. +#if defined(STATS_DYNAMIC_MEMORY) + WRITE(*,*)MYID,': Begin of Incoherent state (1) at time=', + & MPI_WTIME()-TIME_REF +#endif + ENDIF +#endif +#endif + DM_SUMLU = DM_SUMLU + dble(NEW_LU) + IF(KEEP_LOAD(201).EQ.0)THEN + CHECK_MEM = CHECK_MEM + INC_MEM + ELSE + CHECK_MEM = CHECK_MEM + INC_MEM - NEW_LU + ENDIF + IF ( MEM_VALUE .NE. CHECK_MEM ) THEN + WRITE(*,*)MYID, + & ':Problem with increments in ZMUMPS_471', + & CHECK_MEM, MEM_VALUE, INC_MEM,NEW_LU + CALL MUMPS_ABORT() + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (PROCESS_BANDE) THEN + RETURN + ENDIF +#endif + IF(BDC_POOL_MNG) THEN + IF(SBTR_WHICH_M.EQ.0)THEN + IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+ + & dble(INC_MEM-NEW_LU) + ELSE + IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+ + & dble(INC_MEM) + ENDIF + ENDIF + IF ( .NOT. BDC_MEM ) THEN + RETURN + ENDIF +#if defined(OLD_LOAD_MECHANISM) + IF(KEEP_LOAD(201).EQ.0)THEN + DM_MEM( MYID ) = dble(CHECK_MEM) - DM_SUMLU + ELSE + DM_MEM( MYID ) = dble(CHECK_MEM) + ENDIF + TMP_MEM = DM_MEM(MYID) +#endif + IF (BDC_SBTR .AND. SSARBR) THEN + IF((SBTR_WHICH_M.EQ.0).AND.(KEEP(201).NE.0))THEN + SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM-NEW_LU) + ELSE + SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM) + ENDIF + SBTR_TMP = SBTR_CUR(MYID) + ELSE + SBTR_TMP=dble(0) + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF ( NEW_LU > 0_8 ) THEN + INC_MEM = INC_MEM - NEW_LU + ENDIF + DM_MEM( MYID ) = DM_MEM(MYID) + dble(INC_MEM) + MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MYID)) + IF(BDC_M2_MEM.AND.REMOVE_NODE_FLAG_MEM)THEN + IF(dble(INC_MEM).NE.REMOVE_NODE_COST_MEM)THEN + IF(dble(INC_MEM).GT.REMOVE_NODE_COST_MEM)THEN + DELTA_MEM = DELTA_MEM + + & (dble(INC_MEM)-REMOVE_NODE_COST_MEM) + GOTO 888 + ELSE + DELTA_MEM = DELTA_MEM - + & (REMOVE_NODE_COST_MEM-dble(INC_MEM)) + GOTO 888 + ENDIF + ENDIF + GOTO 333 + ENDIF + DELTA_MEM = DELTA_MEM + dble(INC_MEM) + 888 CONTINUE + IF ((KEEP(48).NE.5).OR. + & ((KEEP(48).EQ.5).AND.(abs(DELTA_MEM) + & .GE.0.1d0*dble(LRLU))))THEN + IF ( abs(DELTA_MEM) > DM_THRES_MEM ) THEN + SEND_MEM = DELTA_MEM +#else + IF(BDC_M2_MEM.AND.REMOVE_NODE_FLAG_MEM)THEN + IF(INC_MEM.NE.REMOVE_NODE_COST_MEM)THEN + IF(INC_MEM.EQ.REMOVE_NODE_COST_MEM)THEN + GOTO 333 + ELSEIF(INC_MEM.LT.REMOVE_NODE_COST_MEM)THEN + GOTO 333 + ENDIF + ENDIF + ENDIF + IF ((KEEP(48).NE.5).OR. + & ((KEEP(48).EQ.5).AND. + & (abs(TMP_MEM-DM_LAST_MEM_SENT).GE. + & 0.1d0*dble(LRLU))))THEN + IF ( abs( TMP_MEM-DM_LAST_MEM_SENT) > + & DM_THRES_MEM ) THEN + IERR = 0 + SEND_MEM = TMP_MEM +#endif + 111 CONTINUE + CALL ZMUMPS_77( + & BDC_SBTR, + & BDC_MEM,BDC_MD, COMM_LD, + & NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & DELTA_LOAD, +#else + & LOAD_FLOPS( MYID ), +#endif + & SEND_MEM,SBTR_TMP, + & DM_SUMLU, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & MYID,IERR ) + IF ( IERR == -1 )THEN + CALL ZMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in ZMUMPS_471",IERR + CALL MUMPS_ABORT() + ENDIF + IF ( IERR .EQ. 0 ) THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_LOAD = ZERO + DELTA_MEM = ZERO +#else + LAST_LOAD_SENT = LOAD_FLOPS ( MYID ) + DM_LAST_MEM_SENT = TMP_MEM +#endif + END IF + ENDIF + ENDIF + 333 CONTINUE + IF(REMOVE_NODE_FLAG_MEM)THEN + REMOVE_NODE_FLAG_MEM=.FALSE. + ENDIF + END SUBROUTINE ZMUMPS_471 + INTEGER FUNCTION ZMUMPS_186( K69, MEM_DISTRIB,MSG_SIZE ) + IMPLICIT NONE + INTEGER i, NLESS, K69 + INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB + DOUBLE PRECISION LREF + DOUBLE PRECISION MSG_SIZE + NLESS = 0 + DO i=1,NPROCS + IDWLOAD(i) = i - 1 + ENDDO + WLOAD(1:NPROCS) = LOAD_FLOPS(0:NPROCS-1) + IF(BDC_M2_FLOPS)THEN + DO i=1,NPROCS + WLOAD(i)=WLOAD(i)+NIV2(i) + ENDDO + ENDIF + IF(K69 .gt. 1) THEN + CALL ZMUMPS_426(MEM_DISTRIB,MSG_SIZE,IDWLOAD,NPROCS) + ENDIF + LREF = LOAD_FLOPS(MYID) + DO i=1, NPROCS + IF (WLOAD(i).LT.LREF) NLESS=NLESS+1 + ENDDO + ZMUMPS_186 = NLESS + RETURN + END FUNCTION ZMUMPS_186 + SUBROUTINE ZMUMPS_189(MEM_DISTRIB,MSG_SIZE,DEST, + & NSLAVES) + IMPLICIT NONE + INTEGER NSLAVES + INTEGER DEST(NSLAVES) + INTEGER, DIMENSION(0:NPROCS - 1) :: MEM_DISTRIB + INTEGER i,J,NBDEST + DOUBLE PRECISION MSG_SIZE + IF ( NSLAVES.eq.NPROCS-1 ) THEN + J = MYID+1 + DO i=1,NSLAVES + J=J+1 + IF (J.GT.NPROCS) J=1 + DEST(i) = J - 1 + ENDDO + ELSE + DO i=1,NPROCS + IDWLOAD(i) = i - 1 + ENDDO + CALL MUMPS_558(NPROCS, WLOAD, IDWLOAD) + NBDEST = 0 + DO i=1, NSLAVES + J = IDWLOAD(i) + IF (J.NE.MYID) THEN + NBDEST = NBDEST+1 + DEST(NBDEST) = J + ENDIF + ENDDO + IF (NBDEST.NE.NSLAVES) THEN + DEST(NSLAVES) = IDWLOAD(NSLAVES+1) + ENDIF + IF(BDC_MD)THEN + J=NSLAVES+1 + do i=NSLAVES+1,NPROCS + IF(IDWLOAD(i).NE.MYID)THEN + DEST(J)= IDWLOAD(i) + J=J+1 + ENDIF + end do + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_189 + SUBROUTINE ZMUMPS_183( INFO1, IERR ) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER, intent(in) :: INFO1 + INTEGER, intent(out) :: IERR + IERR=0 + DEALLOCATE( LOAD_FLOPS ) + DEALLOCATE( WLOAD ) + DEALLOCATE( IDWLOAD ) +#if ! defined(OLD_LOAD_MECHANISM) + DEALLOCATE(FUTURE_NIV2) +#endif + IF(BDC_MD)THEN + DEALLOCATE(MD_MEM) + DEALLOCATE(LU_USAGE) + DEALLOCATE(TAB_MAXS) + ENDIF + IF ( BDC_MEM ) DEALLOCATE( DM_MEM ) + IF ( BDC_POOL) DEALLOCATE( POOL_MEM ) + IF ( BDC_SBTR) THEN + DEALLOCATE( SBTR_MEM ) + DEALLOCATE( SBTR_CUR ) + DEALLOCATE(SBTR_FIRST_POS_IN_POOL) + NULLIFY(MY_FIRST_LEAF) + NULLIFY(MY_NB_LEAF) + NULLIFY(MY_ROOT_SBTR) + ENDIF + IF(KEEP_LOAD(76).EQ.4)THEN + NULLIFY(DEPTH_FIRST_LOAD) + ENDIF + IF(KEEP_LOAD(76).EQ.5)THEN + NULLIFY(COST_TRAV) + ENDIF + IF((KEEP_LOAD(76).EQ.4).OR.(KEEP_LOAD(76).EQ.6))THEN + NULLIFY(DEPTH_FIRST_LOAD) + NULLIFY(DEPTH_FIRST_SEQ_LOAD) + NULLIFY(SBTR_ID_LOAD) + ENDIF + IF (BDC_M2_MEM.OR.BDC_M2_FLOPS) THEN + DEALLOCATE(NB_SON,POOL_NIV2,POOL_NIV2_COST, NIV2) + END IF + IF((KEEP_LOAD(81).EQ.2).OR.(KEEP_LOAD(81).EQ.3))THEN + DEALLOCATE(CB_COST_MEM) + DEALLOCATE(CB_COST_ID) + ENDIF + NULLIFY(ND_LOAD) + NULLIFY(KEEP_LOAD) + NULLIFY(KEEP8_LOAD) + NULLIFY(FILS_LOAD) + NULLIFY(FRERE_LOAD) + NULLIFY(PROCNODE_LOAD) + NULLIFY(STEP_LOAD) + NULLIFY(NE_LOAD) + NULLIFY(CAND_LOAD) + NULLIFY(STEP_TO_NIV2_LOAD) + NULLIFY(DAD_LOAD) + IF (BDC_SBTR.OR.BDC_POOL_MNG) THEN + DEALLOCATE(MEM_SUBTREE) + DEALLOCATE(SBTR_PEAK_ARRAY) + DEALLOCATE(SBTR_CUR_ARRAY) + ENDIF + CALL ZMUMPS_58( IERR ) + CALL ZMUMPS_150( MYID, COMM_LD, + & BUF_LOAD_RECV, LBUF_LOAD_RECV, + & LBUF_LOAD_RECV_BYTES ) + DEALLOCATE(BUF_LOAD_RECV) + END SUBROUTINE ZMUMPS_183 +#if defined (LAMPORT_) + RECURSIVE SUBROUTINE ZMUMPS_467(COMM, KEEP) +#else + SUBROUTINE ZMUMPS_467(COMM, KEEP) +#endif + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, MSGTAG, MSGLEN, MSGSOU,COMM + INTEGER KEEP(500) + INTEGER STATUS(MPI_STATUS_SIZE) + LOGICAL FLAG + 10 CONTINUE + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + IF (FLAG) THEN + KEEP(65)=KEEP(65)+1 + MSGTAG = STATUS( MPI_TAG ) + MSGSOU = STATUS( MPI_SOURCE ) + IF ( MSGTAG .NE. UPDATE_LOAD) THEN + write(*,*) "Internal error 1 in ZMUMPS_467", + & MSGTAG + CALL MUMPS_ABORT() + ENDIF + CALL MPI_GET_COUNT(STATUS, MPI_PACKED, MSGLEN, IERR) + IF ( MSGLEN > LBUF_LOAD_RECV_BYTES ) THEN + write(*,*) "Internal error 2 in ZMUMPS_467", + & MSGLEN, LBUF_LOAD_RECV_BYTES + CALL MUMPS_ABORT() + ENDIF + CALL MPI_RECV( BUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES, + & MPI_PACKED, MSGSOU, MSGTAG, COMM_LD, STATUS, IERR) + CALL ZMUMPS_187( MSGSOU, BUF_LOAD_RECV, + & LBUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES ) + GOTO 10 + ENDIF + RETURN + END SUBROUTINE ZMUMPS_467 + RECURSIVE SUBROUTINE ZMUMPS_187 + & ( MSGSOU, BUFR, LBUFR, LBUFR_BYTES ) + IMPLICIT NONE + INTEGER MSGSOU, LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INCLUDE 'mpif.h' + INTEGER POSITION, IERR, WHAT, NSLAVES, i + DOUBLE PRECISION LOAD_RECEIVED + INTEGER INODE_RECEIVED,NCB_RECEIVED + DOUBLE PRECISION SURF + INTEGER, POINTER, DIMENSION (:) :: LIST_SLAVES + DOUBLE PRECISION, POINTER, DIMENSION (:) :: LOAD_INCR + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WHAT, 1, MPI_INTEGER, + & COMM_LD, IERR ) + IF ( WHAT == 0 ) THEN +#if ! defined(OLD_LOAD_MECHANISM) +#else +#endif + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) +#if ! defined(OLD_LOAD_MECHANISM) + LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED +#else + LOAD_FLOPS( MSGSOU ) = LOAD_RECEIVED +#endif + IF ( BDC_MEM ) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) +#if ! defined(OLD_LOAD_MECHANISM) + DM_MEM(MSGSOU) = DM_MEM(MSGSOU) + LOAD_RECEIVED +#else + DM_MEM(MSGSOU) = LOAD_RECEIVED +#endif + MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MSGSOU)) + END IF + IF(BDC_SBTR)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + SBTR_CUR(MSGSOU)=LOAD_RECEIVED + ENDIF + IF(BDC_MD)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(KEEP_LOAD(201).EQ.0)THEN + LU_USAGE(MSGSOU)=LOAD_RECEIVED + ENDIF + ENDIF + ELSEIF (( WHAT == 1).OR.(WHAT.EQ.19)) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSLAVES, 1, MPI_INTEGER, + & COMM_LD, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, MPI_INTEGER, + & COMM_LD, IERR ) + LIST_SLAVES => IDWLOAD + LOAD_INCR => WLOAD + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LIST_SLAVES(1), NSLAVES, MPI_INTEGER, + & COMM_LD, IERR) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + WRITE(*,*)MYID,':Receiving M2A from',MSGSOU + i=1 + DO WHILE ((i.LE.NSLAVES).AND.(LIST_SLAVES(i).NE.MYID)) + i=i+1 + ENDDO + IF(i.LT.(NSLAVES+1))THEN + NB_LEVEL2=NB_LEVEL2+1 + WRITE(*,*)MYID,':NB_LEVEL2=',NB_LEVEL2 + AMI_CHOSEN=.TRUE. + IF(KEEP_LOAD(73).EQ.1)THEN + IF(.NOT.IS_DISPLAYED)THEN + WRITE(*,*)MYID,': Begin of Incoherent state (2) at time=', + & MPI_WTIME()-TIME_REF + IS_DISPLAYED=.TRUE. + ENDIF + ENDIF + ENDIF + IF(KEEP_LOAD(73).EQ.1) GOTO 344 +#endif +#endif + DO i = 1, NSLAVES +#if defined(OLD_LOAD_MECHANISM) + IF ( LIST_SLAVES(i) /= MYID ) THEN +#endif + LOAD_FLOPS(LIST_SLAVES(i)) = + & LOAD_FLOPS(LIST_SLAVES(i)) + + & LOAD_INCR(i) +#if defined(OLD_LOAD_MECHANISM) + END IF +#endif + END DO + IF ( BDC_MEM ) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) + DO i = 1, NSLAVES +#if defined(OLD_LOAD_MECHANISM) + IF ( LIST_SLAVES(i) /= MYID ) THEN +#endif + DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i)) + + & LOAD_INCR(i) + MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(LIST_SLAVES(i))) +#if defined(OLD_LOAD_MECHANISM) + END IF +#endif + END DO + END IF + IF(WHAT.EQ.19)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) + CALL ZMUMPS_819(INODE_RECEIVED) + CB_COST_ID(POS_ID)=INODE_RECEIVED + CB_COST_ID(POS_ID+1)=NSLAVES + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + DO i=1,NSLAVES + WRITE(*,*)MYID,':',LIST_SLAVES(i),'->',LOAD_INCR(i) + CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(LOAD_INCR(i),8) + POS_MEM=POS_MEM+1 + ENDDO + ENDIF +#if defined(OLD_LOAD_MECHANISM) +#if defined(CHECK_COHERENCE) + 344 CONTINUE +#endif +#endif + NULLIFY( LIST_SLAVES ) + NULLIFY( LOAD_INCR ) + ELSE IF (WHAT == 2 ) THEN + IF ( .not. BDC_POOL ) THEN + WRITE(*,*) "Internal error 2 in ZMUMPS_187" + CALL MUMPS_ABORT() + END IF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + POOL_MEM(MSGSOU)=LOAD_RECEIVED + ELSE IF ( WHAT == 3 ) THEN + IF ( .NOT. BDC_SBTR) THEN + WRITE(*,*) "Internal error 3 in ZMUMPS_187" + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + SBTR_MEM(MSGSOU)=SBTR_MEM(MSGSOU)+LOAD_RECEIVED +#if ! defined(OLD_LOAD_MECHANISM) + ELSE IF (WHAT == 4) THEN + FUTURE_NIV2(MSGSOU+1)=0 + IF(BDC_MD)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & SURF, 1, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + MD_MEM(MSGSOU)=999999999_8 + TAB_MAXS(MSGSOU)=TAB_MAXS(MSGSOU)+int(SURF,8) + ENDIF +#endif + IF(BDC_M2_MEM.OR.BDC_M2_FLOPS)THEN + ENDIF + ELSE IF (WHAT == 5) THEN + IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN + WRITE(*,*) "Internal error 7 in ZMUMPS_187" + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, + & MPI_INTEGER, + & COMM_LD, IERR ) + IF(BDC_M2_MEM) THEN + CALL ZMUMPS_816(INODE_RECEIVED) + ELSEIF(BDC_M2_FLOPS) THEN + CALL ZMUMPS_817(INODE_RECEIVED) + ENDIF + IF((KEEP_LOAD(81).EQ.2).OR.(KEEP_LOAD(81).EQ.3))THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, + & MPI_INTEGER, + & COMM_LD, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NCB_RECEIVED, 1, + & MPI_INTEGER, + & COMM_LD, IERR ) + IF( + & MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE_RECEIVED)), + & NPROCS).EQ.1 + & )THEN + CB_COST_ID(POS_ID)=INODE_RECEIVED + CB_COST_ID(POS_ID+1)=1 + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + CB_COST_MEM(POS_MEM)=int(MSGSOU,8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(NCB_RECEIVED,8)* + & int(NCB_RECEIVED,8) + POS_MEM=POS_MEM+1 + ENDIF + ENDIF + ELSE IF ( WHAT == 6 ) THEN + IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN + WRITE(*,*) "Internal error 8 in ZMUMPS_187" + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(BDC_M2_MEM) THEN + NIV2(MSGSOU+1) = LOAD_RECEIVED + ELSEIF(BDC_M2_FLOPS) THEN + NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED + IF(NIV2(MSGSOU+1).LT.0.0D0)THEN + IF(abs(NIV2(MSGSOU+1)).LE. + & sqrt(epsilon(LOAD_RECEIVED)))THEN + NIV2(MSGSOU+1)=0.0D0 + ELSE + WRITE(*,*)'problem with NIV2_FLOPS message', + & NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + ELSEIF(WHAT == 17)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(BDC_M2_MEM) THEN + NIV2(MSGSOU+1) = LOAD_RECEIVED + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + IF(BDC_MD)THEN +#if ! defined(OLD_LOAD_MECHANISM) + DM_MEM(MYID)=DM_MEM(MYID)+LOAD_RECEIVED +#else + DM_MEM(MYID)=LOAD_RECEIVED +#endif + ELSEIF(BDC_POOL)THEN + POOL_MEM(MSGSOU)=LOAD_RECEIVED + ENDIF + ELSEIF(BDC_M2_FLOPS) THEN + NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED + IF(NIV2(MSGSOU+1).LT.0.0D0)THEN + WRITE(*,*)'problem with NIV2_FLOPS message', + & NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) +#if ! defined(OLD_LOAD_MECHANISM) + LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED +#else + LOAD_FLOPS( MSGSOU ) = LOAD_RECEIVED +#endif + ENDIF + ELSEIF ( WHAT == 7 ) THEN + IF(.NOT.BDC_MD)THEN + WRITE(*,*)MYID,': Internal error 4 + &in ZMUMPS_187' + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSLAVES, 1, MPI_INTEGER, + & COMM_LD, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE_RECEIVED, 1, MPI_INTEGER, + & COMM_LD, IERR ) + LIST_SLAVES => IDWLOAD + LOAD_INCR => WLOAD + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LIST_SLAVES(1), NSLAVES, MPI_INTEGER, + & COMM_LD, IERR) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION, + & COMM_LD, IERR) + DO i = 1, NSLAVES +#if defined(OLD_LOAD_MECHANISM) + IF ( LIST_SLAVES(i) /= MYID ) THEN +#endif + MD_MEM(LIST_SLAVES(i)) = + & MD_MEM(LIST_SLAVES(i)) + + & int(LOAD_INCR(i),8) +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(LIST_SLAVES(i)+1).EQ.0)THEN + MD_MEM(LIST_SLAVES(i))=999999999_8 + ENDIF +#endif +#if defined(OLD_LOAD_MECHANISM) + END IF +#endif + END DO + ELSEIF ( WHAT == 8 ) THEN + IF(.NOT.BDC_MD)THEN + WRITE(*,*)MYID,': Internal error 5 + &in ZMUMPS_187' + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + MD_MEM(MSGSOU)=MD_MEM(MSGSOU)+int(LOAD_RECEIVED,8) +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(MSGSOU+1).EQ.0)THEN + MD_MEM(MSGSOU)=999999999_8 + ENDIF +#endif + ELSEIF ( WHAT == 9 ) THEN + IF(.NOT.BDC_MD)THEN + WRITE(*,*)MYID,': Internal error 6 + &in ZMUMPS_187' + CALL MUMPS_ABORT() + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LOAD_RECEIVED, 1, + & MPI_DOUBLE_PRECISION, + & COMM_LD, IERR ) + TAB_MAXS(MSGSOU)=int(LOAD_RECEIVED,8) + ELSE + WRITE(*,*) "Internal error 1 in ZMUMPS_187" + CALL MUMPS_ABORT() + END IF + RETURN + END SUBROUTINE ZMUMPS_187 + integer function ZMUMPS_409 + & (MEM_DISTRIB,CAND, + & K69, + & SLAVEF,MSG_SIZE, + & NMB_OF_CAND ) + implicit none + integer, intent(in) :: K69, SLAVEF + INTEGER, intent(in) :: CAND(SLAVEF+1) + INTEGER, DIMENSION(0:NPROCS - 1), intent(in) :: MEM_DISTRIB + INTEGER, intent(out) :: NMB_OF_CAND + integer i,nless + DOUBLE PRECISION lref + DOUBLE PRECISION MSG_SIZE + nless = 0 + NMB_OF_CAND=CAND(SLAVEF+1) + do i=1,NMB_OF_CAND + WLOAD(i)=LOAD_FLOPS(CAND(i)) + IF(BDC_M2_FLOPS)THEN + WLOAD(i)=WLOAD(i)+NIV2(CAND(i)+1) + ENDIF + end do + IF(K69 .gt. 1) THEN + CALL ZMUMPS_426(MEM_DISTRIB,MSG_SIZE, + & CAND,NMB_OF_CAND) + ENDIF + lref = LOAD_FLOPS(MYID) + do i=1, NMB_OF_CAND + if (WLOAD(i).lt.lref) nless=nless+1 + end do + ZMUMPS_409 = nless + return + end function ZMUMPS_409 + subroutine ZMUMPS_384 + & (MEM_DISTRIB,CAND, + & + & SLAVEF, + & nslaves_inode, DEST) + implicit none + integer, intent(in) :: nslaves_inode, SLAVEF + integer, intent(in) :: CAND(SLAVEF+1) + integer, dimension(0:NPROCS - 1), intent(in) :: MEM_DISTRIB + integer, intent(out) :: DEST(CAND(SLAVEF+1)) + integer i,j,NMB_OF_CAND + external MUMPS_558 + NMB_OF_CAND = CAND(SLAVEF+1) + if(nslaves_inode.ge.NPROCS .or. + & nslaves_inode.gt.NMB_OF_CAND) then + write(*,*)'Internal error in ZMUMPS_384', + & nslaves_inode, NPROCS, NMB_OF_CAND + CALL MUMPS_ABORT() + end if + if (nslaves_inode.eq.NPROCS-1) then + j=MYID+1 + do i=1,nslaves_inode + if(j.ge.NPROCS) j=0 + DEST(i)=j + j=j+1 + end do + else + do i=1,NMB_OF_CAND + IDWLOAD(i)=i + end do + call MUMPS_558(NMB_OF_CAND, + & WLOAD(1),IDWLOAD(1) ) + do i=1,nslaves_inode + DEST(i)= CAND(IDWLOAD(i)) + end do + IF(BDC_MD)THEN + do i=nslaves_inode+1,NMB_OF_CAND + DEST(i)= CAND(IDWLOAD(i)) + end do + ENDIF + end if + return + end subroutine ZMUMPS_384 + SUBROUTINE ZMUMPS_425(K69) + IMPLICIT NONE + INTEGER K69 + IF (K69 .LE. 4) THEN + ALPHA = 0.0d0 + BETA = 0.0d0 + RETURN + ENDIF + IF (K69 .EQ. 5) THEN + ALPHA = 0.5d0 + BETA = 50000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 6) THEN + ALPHA = 0.5d0 + BETA = 100000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 7) THEN + ALPHA = 0.5d0 + BETA = 150000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 8) THEN + ALPHA = 1.0d0 + BETA = 50000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 9) THEN + ALPHA = 1.0d0 + BETA = 100000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 10) THEN + ALPHA = 1.0d0 + BETA = 150000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 11) THEN + ALPHA = 1.5d0 + BETA = 50000.0d0 + RETURN + ENDIF + IF (K69 .EQ. 12) THEN + ALPHA = 1.5d0 + BETA = 100000.0d0 + RETURN + ENDIF + ALPHA = 1.5d0 + BETA = 150000.0d0 + RETURN + END SUBROUTINE ZMUMPS_425 + SUBROUTINE ZMUMPS_426(MEM_DISTRIB,MSG_SIZE,ARRAY_ADM,LEN) + IMPLICIT NONE + INTEGER i,LEN + INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB + DOUBLE PRECISION MSG_SIZE,FORBIGMSG + INTEGER ARRAY_ADM(LEN) + DOUBLE PRECISION MY_LOAD + FORBIGMSG = 1.0d0 + IF (K69 .lt.2) THEN + RETURN + ENDIF + IF(BDC_M2_FLOPS)THEN + MY_LOAD=LOAD_FLOPS(MYID)+NIV2(MYID+1) + ELSE + MY_LOAD=LOAD_FLOPS(MYID) + ENDIF + IF((MSG_SIZE * dble(K35) ) .gt. 3200000.0d0) THEN + FORBIGMSG = 2.0d0 + ENDIF + IF (K69 .le. 4) THEN + DO i = 1,LEN + IF ((MEM_DISTRIB(ARRAY_ADM(i)) .EQ. 1) .AND. + & WLOAD(i) .LT. MY_LOAD ) THEN + WLOAD(i) = WLOAD(i)/MY_LOAD + ELSE + IF ( MEM_DISTRIB(ARRAY_ADM(i)) .NE. 1 ) THEN + WLOAD(i) = WLOAD(i) * + & dble(MEM_DISTRIB(ARRAY_ADM(i))) + & * FORBIGMSG + & + dble(2) + ENDIF + ENDIF + ENDDO + RETURN + ENDIF + DO i = 1,LEN + IF ((MEM_DISTRIB(ARRAY_ADM(i)) .EQ. 1) .AND. + & WLOAD(i) .LT. MY_LOAD ) THEN + WLOAD(i) = WLOAD(i) / MY_LOAD + ELSE + IF(MEM_DISTRIB(ARRAY_ADM(i)) .NE. 1) THEN + WLOAD(i) = (WLOAD(i) + + & ALPHA * MSG_SIZE * dble(K35) + + & BETA) * FORBIGMSG + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_426 + SUBROUTINE ZMUMPS_461(MYID, SLAVEF, COMM, + & TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, NSLAVES,INODE) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER, INTENT (IN) :: MYID, SLAVEF, COMM, NASS, NSLAVES + INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2) + INTEGER, INTENT (IN) :: LIST_SLAVES( NSLAVES ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NCB, NFRONT, NBROWS_SLAVE + INTEGER i, IERR,WHAT,INODE + DOUBLE PRECISION MEM_INCREMENT ( NSLAVES ) + DOUBLE PRECISION FLOPS_INCREMENT( NSLAVES ) + DOUBLE PRECISION CB_BAND( NSLAVES ) + IF((KEEP(81).NE.2).AND.(KEEP(81).NE.3))THEN + WHAT=1 + ELSE + WHAT=19 + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + FUTURE_NIV2(MYID+1) = FUTURE_NIV2(MYID+1) - 1 + IF ( FUTURE_NIV2(MYID+1) < 0 ) THEN + WRITE(*,*) "Internal error in ZMUMPS_461" + CALL MUMPS_ABORT() + ENDIF + IF ( FUTURE_NIV2(MYID + 1) == 0 ) THEN + 112 CONTINUE + CALL ZMUMPS_502(COMM,MYID,SLAVEF, + & dble(MAX_SURF_MASTER),IERR) + IF (IERR == -1 ) THEN + CALL ZMUMPS_467(COMM_LD, KEEP) + GOTO 112 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in ZMUMPS_461", + & IERR + CALL MUMPS_ABORT() + ENDIF + TAB_MAXS(MYID) = TAB_MAXS(MYID) + int(MAX_SURF_MASTER,8) + ENDIF +#endif + IF ( NSLAVES /= TAB_POS(SLAVEF + 2) ) THEN + write(*,*) "Error 1 in ZMUMPS_461", + & NSLAVES, TAB_POS(SLAVEF+2) + CALL MUMPS_ABORT() + ENDIF + NCB = TAB_POS(NSLAVES+1) - 1 + NFRONT = NCB + NASS + DO i = 1, NSLAVES + NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i) + IF ( KEEP(50) == 0 ) THEN + FLOPS_INCREMENT( i ) = (dble(NBROWS_SLAVE)*dble( NASS ))+ + & dble(NBROWS_SLAVE) * dble(NASS) * + & dble(2*NFRONT-NASS-1) + ELSE + FLOPS_INCREMENT( i ) = dble(NBROWS_SLAVE) * dble(NASS ) * + & dble( 2 * ( NASS + TAB_POS(i+1) - 1 ) + & - NBROWS_SLAVE - NASS + 1 ) + ENDIF + IF ( BDC_MEM ) THEN + IF ( KEEP(50) == 0 ) THEN + MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) * + & dble(NFRONT) + ELSE + MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) * + & dble( NASS + TAB_POS(i+1) - 1 ) + END IF + ENDIF + IF((KEEP(81).NE.2).AND.(KEEP(81).NE.3))THEN + CB_BAND(i)=dble(-999999) + ELSE + IF ( KEEP(50) == 0 ) THEN + CB_BAND( i ) = dble(NBROWS_SLAVE) * + & dble(NFRONT-NASS) + ELSE + CB_BAND( i ) = dble(NBROWS_SLAVE) * + & dble(TAB_POS(i+1)-1) + END IF + ENDIF + END DO + IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN + CB_COST_ID(POS_ID)=INODE + CB_COST_ID(POS_ID+1)=NSLAVES + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + DO i=1,NSLAVES + CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(CB_BAND(i),8) + POS_MEM=POS_MEM+1 + ENDDO + ENDIF + 111 CONTINUE + CALL ZMUMPS_524(BDC_MEM, COMM, MYID, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & NSLAVES, LIST_SLAVES,INODE, + & MEM_INCREMENT, + & FLOPS_INCREMENT,CB_BAND, WHAT,IERR) + IF ( IERR == -1 ) THEN + CALL ZMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in ZMUMPS_461", + & IERR + CALL MUMPS_ABORT() + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (FUTURE_NIV2(MYID+1) .NE. 0) THEN +#endif + DO i = 1, NSLAVES + LOAD_FLOPS(LIST_SLAVES(i)) = LOAD_FLOPS(LIST_SLAVES(i)) + & + FLOPS_INCREMENT(i) + IF ( BDC_MEM ) THEN + DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i)) + & + MEM_INCREMENT(i) + END IF + ENDDO +#if ! defined(OLD_LOAD_MECHANISM) + ENDIF +#endif + RETURN + END SUBROUTINE ZMUMPS_461 + SUBROUTINE ZMUMPS_500( + & POOL, LPOOL, + & PROCNODE, KEEP,KEEP8, SLAVEF, COMM, MYID, STEP, N, + & ND, FILS ) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER LPOOL, SLAVEF, COMM, MYID + INTEGER N, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER POOL( LPOOL ), PROCNODE( KEEP(28) ), STEP( N ) + INTEGER ND( KEEP(28) ), FILS( N ) + INTEGER i, INODE, NELIM, NFR, LEVEL, IERR, WHAT + DOUBLE PRECISION COST + INTEGER NBINSUBTREE,NBTOP,INSUBTREE + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + IF(BDC_MD)THEN + RETURN + ENDIF + IF((KEEP(76).EQ.0).OR.(KEEP(76).EQ.2))THEN + IF(NBTOP.NE.0)THEN + DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3) + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ELSE + DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1 + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ENDIF + ELSE + IF(KEEP(76).EQ.1)THEN + IF(INSUBTREE.EQ.1)THEN + DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1 + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ELSE + DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3) + INODE = POOL( i ) + IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN + GOTO 20 + END IF + END DO + COST=dble(0) + GOTO 30 + ENDIF + ELSE + WRITE(*,*) + & 'Internal error: Unknown pool management strategy' + CALL MUMPS_ABORT() + ENDIF + ENDIF + 20 CONTINUE + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS(i) + GOTO 10 + ENDIF + NFR = ND( STEP(INODE) ) + LEVEL = MUMPS_330( PROCNODE(STEP(INODE)), SLAVEF ) + IF (LEVEL .EQ. 1) THEN + COST = dble( NFR ) * dble( NFR ) + ELSE + IF ( KEEP(50) == 0 ) THEN + COST = dble( NFR ) * dble( NELIM ) + ELSE + COST = dble( NELIM ) * dble( NELIM ) + ENDIF + ENDIF + 30 CONTINUE + IF ( abs(POOL_LAST_COST_SENT-COST).GT.DM_THRES_MEM ) THEN + WHAT = 2 + 111 CONTINUE + CALL ZMUMPS_460( WHAT, + & COMM, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & COST, dble(0),MYID, IERR ) + POOL_LAST_COST_SENT = COST + POOL_MEM(MYID)=COST + IF ( IERR == -1 )THEN + CALL ZMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in ZMUMPS_500", + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_500 + SUBROUTINE ZMUMPS_501( + & OK,INODE,POOL,LPOOL,MYID,SLAVEF,COMM,KEEP,KEEP8) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER LPOOL,MYID,SLAVEF,COMM,INODE + INTEGER POOL(LPOOL),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER WHAT,IERR + LOGICAL OK + DOUBLE PRECISION COST + LOGICAL FLAG + EXTERNAL MUMPS_283,MUMPS_170 + LOGICAL MUMPS_283,MUMPS_170 + IF((INODE.LE.0).OR.(INODE.GT.N_LOAD)) THEN + RETURN + ENDIF + IF (.NOT.MUMPS_170( + & PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS) + & ) THEN + RETURN + ENDIF + IF(MUMPS_283(PROCNODE_LOAD(STEP_LOAD(INODE)),NPROCS))THEN + IF(NE_LOAD(STEP_LOAD(INODE)).EQ.0)THEN + RETURN + ENDIF + ENDIF + FLAG=.FALSE. + IF(INDICE_SBTR.LE.NB_SUBTREES)THEN + IF(INODE.EQ.MY_FIRST_LEAF(INDICE_SBTR))THEN + FLAG=.TRUE. + ENDIF + ENDIF + IF(FLAG)THEN + SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY)=MEM_SUBTREE(INDICE_SBTR) + SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY)=SBTR_CUR(MYID) + INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY+1 + WHAT = 3 + IF(dble(MEM_SUBTREE(INDICE_SBTR)).GE.DM_THRES_MEM)THEN + 111 CONTINUE + CALL ZMUMPS_460( + & WHAT, COMM, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & dble(MEM_SUBTREE(INDICE_SBTR)), dble(0),MYID, IERR ) + IF ( IERR == -1 )THEN + CALL ZMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) + & "Internal Error 1 in ZMUMPS_501", + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + SBTR_MEM(MYID)=SBTR_MEM(MYID)+ + & dble(MEM_SUBTREE(INDICE_SBTR)) + INDICE_SBTR=INDICE_SBTR+1 + IF(INSIDE_SUBTREE.EQ.0)THEN + INSIDE_SUBTREE=1 + ENDIF + ELSE + IF(INODE.EQ.MY_ROOT_SBTR(INDICE_SBTR-1))THEN + WHAT = 3 + COST=-SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY-1) + IF(abs(COST).GE.DM_THRES_MEM)THEN + 112 CONTINUE + CALL ZMUMPS_460( + & WHAT, COMM, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & COST, dble(0) ,MYID,IERR ) + IF ( IERR == -1 )THEN + CALL ZMUMPS_467(COMM_LD, KEEP) + GOTO 112 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) + & "Internal Error 3 in ZMUMPS_501", + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY-1 + SBTR_MEM(MYID)=SBTR_MEM(MYID)- + & SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY) + SBTR_CUR(MYID)=SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY) + IF(INDICE_SBTR_ARRAY.EQ.1)THEN + SBTR_CUR(MYID)=dble(0) + INSIDE_SUBTREE=0 + ENDIF + ENDIF + ENDIF + CONTINUE + END SUBROUTINE ZMUMPS_501 + SUBROUTINE ZMUMPS_504 + & (SLAVEF,KEEP,KEEP8,PROCS,MEM_DISTRIB,NCB,NFRONT, + & NSLAVES_NODE,TAB_POS, + & SLAVES_LIST,SIZE_SLAVES_LIST,MYID) + IMPLICIT NONE + INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST + INTEGER(8) KEEP8(150) + INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID + INTEGER, intent(in) :: PROCS(SLAVEF+1) + INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1) + INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST) + INTEGER, intent(out):: TAB_POS(SLAVEF+2) + INTEGER, intent(out):: NSLAVES_NODE + INTEGER NUMBER_OF_PROCS,K47, K48, K50 + INTEGER(8) :: K821 + DOUBLE PRECISION DK821 + INTEGER J + INTEGER KMIN, KMAX + INTEGER OTHERS,CHOSEN,SMALL_SET,ACC + DOUBLE PRECISION SOMME,TMP_SUM + INTEGER AFFECTED + INTEGER ADDITIONNAL_ROWS,i,X,REF,POS + INTEGER(8)::TOTAL_MEM + LOGICAL FORCE_CAND + DOUBLE PRECISION TEMP(SLAVEF),PEAK + INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF) + EXTERNAL MPI_WTIME + DOUBLE PRECISION MPI_WTIME + IF (KEEP8(21) .GT. 0_8) THEN + write(*,*)MYID, + & ": Internal Error 1 in ZMUMPS_504" + CALL MUMPS_ABORT() + ENDIF + K821=abs(KEEP8(21)) + DK821=dble(K821) + K50=KEEP(50) + K48=KEEP(48) + K47=KEEP(47) + IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN + FORCE_CAND = .FALSE. + ELSE + FORCE_CAND = (mod(KEEP(24),2).eq.0) + END IF + IF(K48.NE.4)THEN + WRITE(*,*)'ZMUMPS_COMPUTE_PARTI_ACTV_MEM_K821 + & should be called with KEEP(48) different from 4' + CALL MUMPS_ABORT() + ENDIF + KMIN=1 + KMAX=int(K821/int(NFRONT,8)) + IF(FORCE_CAND)THEN + DO i=1,PROCS(SLAVEF+1) + WLOAD(i)=DM_MEM(PROCS(i)) + IDWLOAD(i)=PROCS(i) + ENDDO + NUMBER_OF_PROCS=PROCS(SLAVEF+1) + OTHERS=NUMBER_OF_PROCS + ELSE + NUMBER_OF_PROCS=SLAVEF + WLOAD(1:SLAVEF) = DM_MEM(0:NUMBER_OF_PROCS-1) + DO i=1,NUMBER_OF_PROCS + IDWLOAD(i) = i - 1 + ENDDO + OTHERS=NUMBER_OF_PROCS-1 + ENDIF + NB_ROWS=0 + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, IDWLOAD) + TOTAL_MEM=int(NCB,8)*int(NFRONT,8) + SOMME=dble(0) + J=1 + PEAK=dble(0) + DO i=1,NUMBER_OF_PROCS + IF((IDWLOAD(i).NE.MYID))THEN + PEAK=max(PEAK,WLOAD(i)) + TEMP_ID(J)=IDWLOAD(i) + TEMP(J)=WLOAD(i) + IF(BDC_SBTR)THEN + TEMP(J)=TEMP(J)+SBTR_MEM(IDWLOAD(i))- + & SBTR_CUR(IDWLOAD(i)) + ENDIF + IF(BDC_POOL)THEN + TEMP(J)=TEMP(J)+POOL_MEM(TEMP_ID(J)) + ENDIF + IF(BDC_M2_MEM)THEN + TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1) + ENDIF + J=J+1 + ENDIF + ENDDO + NUMBER_OF_PROCS=J-1 + CALL MUMPS_558(NUMBER_OF_PROCS, TEMP, TEMP_ID) + IF(K50.EQ.0)THEN + PEAK=max(PEAK, + & DM_MEM(MYID)+dble(NFRONT)*dble(NFRONT-NCB)) + ELSE + PEAK=max(PEAK, + & DM_MEM(MYID)+dble(NFRONT-NCB)*dble(NFRONT-NCB)) + ENDIF + PEAK=max(PEAK,TEMP(OTHERS)) + SOMME=dble(0) + DO i=1,NUMBER_OF_PROCS + SOMME=SOMME+TEMP(OTHERS)-TEMP(i) + ENDDO + IF(SOMME.LE.dble(TOTAL_MEM)) THEN + GOTO 096 + ENDIF + 096 CONTINUE + SOMME=dble(0) + DO i=1,OTHERS + SOMME=SOMME+TEMP(OTHERS)-TEMP(i) + ENDDO + IF(dble(TOTAL_MEM).GE.SOMME) THEN +#if defined (OLD_PART) + 887 CONTINUE +#endif + AFFECTED=0 + CHOSEN=0 + ACC=0 + DO i=1,OTHERS + IF(K50.EQ.0)THEN + IF((TEMP(OTHERS)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(OTHERS)-TEMP(i) + ENDIF + X=int(TMP_SUM/dble(NFRONT)) + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + IF((TEMP(OTHERS)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(OTHERS)-TEMP(i) + ENDIF + X=int((-dble(NFRONT-NCB+ACC) + & +sqrt(((dble(NFRONT-NCB+ACC)* + & dble(NFRONT-NCB+ACC))+dble(4)* + & (TMP_SUM))))/ + & dble(2)) + IF((ACC+X).GT.NCB) X=NCB-ACC + IF(X.LE.0) THEN + WRITE(*,*)"Internal Error 2 in + & ZMUMPS_504" + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_ROWS(i)=X + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB-ACC.LT.KMIN) GOTO 111 + IF(NCB.EQ.ACC) GOTO 111 + ENDDO + 111 CONTINUE + IF((ACC.GT.NCB))THEN + X=0 + DO i=1,OTHERS + X=X+NB_ROWS(i) + ENDDO + WRITE(*,*)'NCB=',NCB,',SOMME=',X + WRITE(*,*)MYID, + & ": Internal Error 3 in ZMUMPS_504" + CALL MUMPS_ABORT() + ENDIF + IF((NCB.NE.ACC))THEN + IF(K50.NE.0)THEN + IF(CHOSEN.NE.0)THEN + ADDITIONNAL_ROWS=NCB-ACC + NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+ADDITIONNAL_ROWS + ELSE + TMP_SUM=dble(TOTAL_MEM)/dble(NUMBER_OF_PROCS) + CHOSEN=0 + ACC=0 + DO i=1,OTHERS + X=int((-dble(NFRONT-NCB+ACC) + & +sqrt(((dble(NFRONT-NCB+ACC)* + & dble(NFRONT-NCB+ACC))+dble(4)* + & (TMP_SUM))))/ + & dble(2)) + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB-ACC.LT.KMIN) GOTO 002 + IF(NCB.EQ.ACC) GOTO 002 + ENDDO + 002 CONTINUE + IF(ACC.LT.NCB)THEN + NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+(NCB-ACC) + ENDIF + ENDIF + GOTO 333 + ENDIF + ADDITIONNAL_ROWS=NCB-ACC + DO i=CHOSEN,1,-1 + IF(int(dble(ADDITIONNAL_ROWS)/ + & dble(i)).NE.0)THEN + GOTO 222 + ENDIF + ENDDO + 222 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(i)) + DO J=1,i + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDDO + IF(ADDITIONNAL_ROWS.NE.0) THEN + NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS + ENDIF + ENDIF + 333 CONTINUE + IF(NB_ROWS(CHOSEN).EQ.0) CHOSEN=CHOSEN-1 + GOTO 889 + ELSE + DO i=OTHERS,1,-1 + SOMME=dble(0) + DO J=1,i + SOMME=SOMME+TEMP(J) + ENDDO + SOMME=(dble(i)*TEMP(i))-SOMME + IF(dble(TOTAL_MEM).GE.SOMME) GOTO 444 + ENDDO + 444 CONTINUE + REF=i + DO J=1,i + IF(TEMP(J).EQ.TEMP(i)) THEN + SMALL_SET=J + GOTO 123 + ENDIF + ENDDO + 123 CONTINUE + IF(i.EQ.1)THEN + NB_ROWS(i)=NCB + CHOSEN=1 + GOTO 666 + ENDIF + 323 CONTINUE + AFFECTED=0 + CHOSEN=0 + ACC=0 + DO i=1,SMALL_SET + IF(K50.EQ.0)THEN + IF((TEMP(SMALL_SET)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(SMALL_SET)-TEMP(i) + ENDIF + X=int(TMP_SUM/dble(NFRONT)) + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + IF((TEMP(SMALL_SET)-TEMP(i)).GT.DK821)THEN + TMP_SUM=DK821 + ELSE + TMP_SUM=TEMP(SMALL_SET)-TEMP(i) + ENDIF + X=int((-dble(NFRONT-NCB+ACC) + & +sqrt(((dble(NFRONT-NCB+ACC)* + & dble(NFRONT-NCB+ACC))+dble(4)* + & (TMP_SUM))))/ + & dble(2)) + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 4 in ZMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + NB_ROWS(i)=X + ACC=ACC+X + CHOSEN=CHOSEN+1 + IF(NCB-ACC.LT.KMIN) GOTO 888 + IF(NCB.EQ.ACC) GOTO 888 + IF(ACC.GT.NCB) THEN + WRITE(*,*)MYID, + & ': Internal error 5 in ZMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ENDDO + 888 CONTINUE + SOMME=dble(0) + X=NFRONT-NCB + IF((ACC.GT.NCB))THEN + WRITE(*,*)MYID, + & ':Internal error 6 in ZMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF((ACC.LT.NCB))THEN + IF(K50.NE.0)THEN + IF(SMALL_SET.LT.OTHERS)THEN + SMALL_SET=REF+1 + REF=SMALL_SET + GOTO 323 + ELSE + NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+NCB-ACC + GOTO 666 + ENDIF + ENDIF + ADDITIONNAL_ROWS=NCB-ACC +#if ! defined (OLD_PART) + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + J=1 +#if ! defined (PART1_) + X=int(ADDITIONNAL_ROWS/(i-1)) + IF((X.EQ.0).AND.(ADDITIONNAL_ROWS.NE.0))THEN + DO WHILE ((J.LT.i).AND.(ADDITIONNAL_ROWS.GT.0)) + NB_ROWS(J)=NB_ROWS(J)+1 + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 + J=J+1 + ENDDO + IF(ADDITIONNAL_ROWS.NE.0)THEN + WRITE(*,*)MYID, + & ':Internal error 7 in ZMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + GOTO 047 + ENDIF + IF((TEMP(1)+dble((NB_ROWS(1)+X)*NFRONT)).LE. + & TEMP(i))THEN + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + AFFECTED=X + IF((AFFECTED+NB_ROWS(J)).GT. + & KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & AFFECTED + J=J+1 + ENDDO + ELSE +#endif + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LE.i)) + AFFECTED=int((TEMP(i)-(TEMP(J)+ + & (dble(NB_ROWS(J))*dble(NFRONT)))) + & /dble(NFRONT)) + IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + ENDIF + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + J=J+1 + ENDDO +#if ! defined (PART1_) + ENDIF +#endif + i=i+1 + ENDDO + 047 CONTINUE + IF((ADDITIONNAL_ROWS.EQ.0).AND. + & (i.LT.NUMBER_OF_PROCS))THEN + CHOSEN=i-1 + ELSE + CHOSEN=i-2 + ENDIF +#if ! defined (PART1_) + IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. + & (ADDITIONNAL_ROWS.NE.0))THEN + DO i=1,CHOSEN + NB_ROWS(i)=NB_ROWS(i)+1 + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 048 + ENDDO + 048 CONTINUE + ENDIF +#endif + IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. + & (ADDITIONNAL_ROWS.NE.0))THEN + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LE.i)) + AFFECTED=int((TEMP(i)-(TEMP(J)+ + & (dble(NB_ROWS(J))* + & dble(NFRONT))))/dble(NFRONT)) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + J=J+1 + ENDDO + i=i+1 + ENDDO + CHOSEN=i-2 + ENDIF + CONTINUE +#else + DO i=CHOSEN,1,-1 + IF(int(dble(ADDITIONNAL_ROWS)/ + & dble(i)).NE.0)THEN + GOTO 555 + ENDIF + ENDDO + 555 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(i)) + DO J=1,i + IF(NB_ROWS(J)+X.GT.K821/NCB)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & ((K821/NCB)-NB_ROWS(J)) + NB_ROWS(J)=(K821/NFRONT) + ELSE IF ((TEMP(J)+dble((NB_ROWS(J)+X))* + & dble(NFRONT)).GT. + & PEAK)THEN + AFFECTED=int((PEAK-(TEMP(J)+dble(NB_ROWS(J))* + & dble(NFRONT))/dble(NFRONT)) + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ELSE + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDIF + IF(((TEMP(J)+dble(NB_ROWS(J))*dble(NFRONT)) + & .GT. PEAK) + & .AND.(SMALL_SET.LT.OTHERS))THEN + WRITE(*,*)MYID, + & ':Internal error 8 in ZMUMPS_504' + SMALL_SET=SMALL_SET+1 + CALL MUMPS_ABORT() + ENDIF + ENDDO + SOMME=dble(0) + DO J=1,CHOSEN + SOMME=SOMME+NB_ROWS(J) + ENDDO + IF(ADDITIONNAL_ROWS.NE.0) THEN + DO J=1,CHOSEN + IF(NB_ROWS(J).LT.0)THEN + WRITE(*,*)MYID, + & ':Internal error 9 in ZMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF ((TEMP(J)+dble(NB_ROWS(J)) + & *dble(NFRONT)).GT. + & PEAK)THEN + WRITE(*,*)MYID, + & ':Internal error 10 in ZMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + IF ((TEMP(J)+dble(NB_ROWS(J)+ + & ADDITIONNAL_ROWS)*dble(NFRONT)).GE. + & PEAK)THEN + AFFECTED=int((PEAK-(TEMP(J)+ + & dble(NB_ROWS(J))* + & dble(NFRONT))/dble(NFRONT)) + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + IF((TEMP(J)+dble(NFRONT)* + & dble(NB_ROWS(J))).GT. + & PEAK)THEN + WRITE(*,*)MYID, + & ':Internal error 11 in ZMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ELSE + NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 666 + ENDDO + IF(SMALL_SET.EQ.(NUMBER_OF_PROCS)) THEN + NB_ROWS=0 + GOTO 887 + ENDIF + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF(NB_ROWS(i)+ADDITIONNAL_ROWS.LT.K821/NFRONT) + & THEN + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-(K821/ + & NFRONT + & -NB_ROWS(i)) + NB_ROWS(i)=K821/NFRONT + ENDIF + i=i+1 + ENDDO + CHOSEN=i-1 + IF(ADDITIONNAL_ROWS.NE.0)THEN + DO i=CHOSEN,1,-1 + IF(int(dble(ADDITIONNAL_ROWS)/dble(i)) + & .NE.0)THEN + GOTO 372 + ENDIF + ENDDO + 372 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(i)) + DO J=1,i + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDDO + IF(ADDITIONNAL_ROWS.NE.0) THEN + NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS + ENDIF + ENDIF + ENDIF +#endif + ENDIF + 666 CONTINUE + SOMME=dble(0) + X=0 + POS=0 + DO i=1,CHOSEN + IF(K50.NE.0) THEN + IF((TEMP(i)+dble(NB_ROWS(i)) + & *dble(X+NB_ROWS(i)+NFRONT-NCB)) + & .GT.PEAK)THEN + SMALL_SET=SMALL_SET+1 + ENDIF + ENDIF + IF(K50.EQ.0) THEN + IF((TEMP(i)+dble(NB_ROWS(i))*dble(NFRONT)) + & .GT.PEAK)THEN + SMALL_SET=SMALL_SET+1 + ENDIF + ENDIF + X=X+NB_ROWS(i) + SOMME=SOMME+ dble(NB_ROWS(i)) + ENDDO + ENDIF + 889 CONTINUE + J=CHOSEN + X=0 + DO i=J,1,-1 + IF(NB_ROWS(i).EQ.0)THEN + IF(X.EQ.1)THEN + WRITE(*,*)MYID, + & ':Internal error 12 in ZMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + CHOSEN=CHOSEN-1 + ELSE + IF(NB_ROWS(i).GT.0)THEN + X=1 + ELSE + WRITE(*,*) + & 'Internal error 13 in ZMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDDO + NSLAVES_NODE=CHOSEN + TAB_POS(NSLAVES_NODE+1)= NCB+1 + TAB_POS(SLAVEF+2) = CHOSEN + POS=1 + DO i=1,CHOSEN + SLAVES_LIST(i)=TEMP_ID(i) + TAB_POS(i)=POS + POS=POS+NB_ROWS(i) + IF(NB_ROWS(i).LE.0)THEN + WRITE(*,*) + & 'Internal error 14 in ZMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + ENDDO + DO i=CHOSEN+1,NUMBER_OF_PROCS + SLAVES_LIST(i)=TEMP_ID(i) + ENDDO + IF(POS.NE.(NCB+1))THEN + WRITE(*,*) + & 'Internal error 15 in ZMUMPS_504' + CALL MUMPS_ABORT() + ENDIF + END SUBROUTINE ZMUMPS_504 + SUBROUTINE ZMUMPS_518 + & (NCBSON_MAX,SLAVEF,KEEP,KEEP8, + & PROCS,MEM_DISTRIB,NCB,NFRONT, + & NSLAVES_NODE,TAB_POS, + & SLAVES_LIST,SIZE_SLAVES_LIST,MYID,INODE,MP,LP) + IMPLICIT NONE + INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST + INTEGER(8) KEEP8(150) + INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID + INTEGER, intent(in) :: NCBSON_MAX + INTEGER, intent(in) :: PROCS(SLAVEF+1) + INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1),INODE + INTEGER, intent(in) :: MP,LP + INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST) + INTEGER, intent(out):: TAB_POS(SLAVEF+2) + INTEGER, intent(out):: NSLAVES_NODE + INTEGER NUMBER_OF_PROCS,K47,K48, K50,K83,K69 + INTEGER(8) :: K821 + INTEGER J + INTEGER KMIN, KMAX + INTEGER OTHERS,CHOSEN,SMALL_SET,ACC + DOUBLE PRECISION SOMME,TMP_SUM,DELTA,A,B,C,MASTER_WORK + INTEGER AFFECTED + INTEGER ADDITIONNAL_ROWS,i,X,REF,POS,NELIM + INTEGER(8) X8 + LOGICAL FORCE_CAND,SMP + DOUBLE PRECISION BANDE_K821 + INTEGER NB_SAT,NB_ZERO + DOUBLE PRECISION TEMP(SLAVEF),TOTAL_COST, MAX_MEM_ALLOW + INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF) + INTEGER NSLAVES_REF,NCB_FILS + EXTERNAL MPI_WTIME,MUMPS_442 + INTEGER MUMPS_442 + INTEGER POS_MIN_LOAD,SIZE_MY_SMP,WHAT,ADDITIONNAL_ROWS_SPECIAL + LOGICAL HAVE_TYPE1_SON + DOUBLE PRECISION MIN_LOAD,MAX_LOAD,TEMP_MAX_LOAD + DOUBLE PRECISION MPI_WTIME + DOUBLE PRECISION BUF_SIZE,NELIM_MEM_SIZE + DOUBLE PRECISION MEM_SIZE_STRONG(SLAVEF),MEM_SIZE_WEAK(SLAVEF) + K821=abs(KEEP8(21)) + TEMP_MAX_LOAD=dble(0) + K50=KEEP(50) + K48=KEEP(48) + K47=KEEP(47) + K83=KEEP(83) + K69=0 + NCB_FILS=NCBSON_MAX + IF(int(NCB_FILS,8)*int(min(NCB,NCB_FILS),8).GT.K821)THEN + HAVE_TYPE1_SON=.TRUE. + ELSE + HAVE_TYPE1_SON=.FALSE. + ENDIF + SMP=(K69.NE.0) + IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN + FORCE_CAND = .FALSE. + ELSE + FORCE_CAND = (mod(KEEP(24),2).eq.0) + END IF + NELIM=NFRONT-NCB + KMAX=int(K821/int(NCB,8)) + IF(FORCE_CAND)THEN + DO i=1,PROCS(SLAVEF+1) + WLOAD(i)=LOAD_FLOPS(PROCS(i)) + IDWLOAD(i)=PROCS(i) + IF (WLOAD(i) < -0.5d0 ) THEN + IF((MP.GT.0).AND.(LP.GE.2))THEN + WRITE(MP,*)MYID,': Warning: negative load ', + & WLOAD(i) + ENDIF + ENDIF + WLOAD(i)=max(WLOAD(i),0.0d0) + ENDDO + NUMBER_OF_PROCS=PROCS(SLAVEF+1) + OTHERS=NUMBER_OF_PROCS + ELSE + NUMBER_OF_PROCS=SLAVEF + WLOAD(1:SLAVEF) = LOAD_FLOPS(0:NUMBER_OF_PROCS-1) + DO i=1,NUMBER_OF_PROCS + IDWLOAD(i) = i - 1 + IF (WLOAD(i) < -0.5d0 ) THEN + IF((MP.GT.0).AND.(LP.GE.2))THEN + WRITE(MP,*)MYID,': Negative load ', + & WLOAD(i) + ENDIF + ENDIF + WLOAD(i)=max(WLOAD(i),0.0d0) + ENDDO + OTHERS=NUMBER_OF_PROCS-1 + ENDIF + KMAX=int(NCB/OTHERS) + KMIN=MUMPS_442(int(NCB,8)*int(KMAX,8),K50,KMAX,NCB) + NB_ROWS=0 + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, IDWLOAD) + IF(K50.EQ.0)THEN + TOTAL_COST=dble( NELIM ) * dble ( NCB ) + + & dble(NCB) * dble(NELIM)*dble(2*NFRONT-NELIM-1) + ELSE + TOTAL_COST=dble(NELIM) * dble ( NCB ) * + & dble(NFRONT+1) + ENDIF + CALL MUMPS_511(NFRONT,NELIM,NELIM,K50, + & 2,MASTER_WORK) + SOMME=dble(0) + J=1 + IF(FORCE_CAND.AND.(NUMBER_OF_PROCS.GT.K83))THEN + MASTER_WORK=dble(KEEP(88))*MASTER_WORK/dble(100) + ENDIF + IF(FORCE_CAND.AND.(NUMBER_OF_PROCS.LE.K83))THEN + MASTER_WORK=dble(KEEP(87))*MASTER_WORK/dble(100) + ENDIF + IF(MASTER_WORK.LT.dble(1))THEN + MASTER_WORK=dble(1) + ENDIF + NSLAVES_REF=int(TOTAL_COST/MASTER_WORK)+1 + IF(FORCE_CAND)THEN + NSLAVES_REF=min(NSLAVES_REF,NUMBER_OF_PROCS) + ELSE + NSLAVES_REF=min(NSLAVES_REF,NUMBER_OF_PROCS-1) + ENDIF + DO i=1,NUMBER_OF_PROCS + IF((IDWLOAD(i).NE.MYID))THEN + TEMP_ID(J)=IDWLOAD(i) + TEMP(J)=WLOAD(i) + IF(BDC_M2_FLOPS)THEN + TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1) + ENDIF + J=J+1 + ENDIF + ENDDO + NUMBER_OF_PROCS=J-1 + CALL MUMPS_558(NUMBER_OF_PROCS, TEMP, TEMP_ID) + SOMME=dble(0) + TMP_SUM=dble(0) + DO i=1,OTHERS + SOMME=SOMME+TEMP(OTHERS)-TEMP(i) + TMP_SUM=TMP_SUM+TEMP(i) + ENDDO + TMP_SUM=(TMP_SUM/dble(OTHERS))+ + & (TOTAL_COST/dble(OTHERS)) + SIZE_MY_SMP=OTHERS + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + IF(.NOT.SMP) MAX_LOAD=TEMP(OTHERS) + IF(SMP)THEN + J=1 + DO i=1,OTHERS + IF(MEM_DISTRIB(TEMP_ID(i)).EQ.1)THEN + IF(TEMP(i).LE.TMP_SUM)THEN + WLOAD(J)=TEMP(i) + IDWLOAD(J)=TEMP_ID(i) + J=J+1 + ELSE + ENDIF + ENDIF + ENDDO + MAX_LOAD=WLOAD(J-1) + SIZE_MY_SMP=J-1 + DO i=1,OTHERS + IF((MEM_DISTRIB(TEMP_ID(i)).NE.1).OR. + & ((MEM_DISTRIB(TEMP_ID(i)).EQ.1).AND. + & (TEMP(i).GE.TMP_SUM)))THEN + WLOAD(J)=TEMP(i) + IDWLOAD(J)=TEMP_ID(i) + J=J+1 + ENDIF + ENDDO + TEMP=WLOAD + TEMP_ID=IDWLOAD + ENDIF + IF(BDC_MD)THEN + BUF_SIZE=dble(K821) + IF (KEEP(201).EQ.2) THEN + A=dble(int((dble(KEEP(100))/dble(2))/dble(NELIM))) + IF(K50.EQ.0)THEN + BUF_SIZE=min(BUF_SIZE,A*dble(NCB)) + ELSE + BUF_SIZE=min(BUF_SIZE,A*A) + ENDIF + ENDIF + BUF_SIZE=dble(K821) + DO i=1,NUMBER_OF_PROCS + A=dble(MD_MEM(TEMP_ID(i)))/ + & dble(NELIM) + A=A*dble(NFRONT) + IF(K50.EQ.0)THEN + B=dble(int(dble(NCB)/dble(NUMBER_OF_PROCS))+1)* + & dble(NFRONT) + ELSE + WHAT = 5 +#if ! defined (OOC_PAR_MEM_SLAVE_SELECT) && ! defined (OOC_PAR_MEM2) + CALL MUMPS_503(WHAT, KEEP,KEEP8, NCB, + & NFRONT, min(NCB,OTHERS), J, X8) +#endif + B=dble(X8)+(dble(J)*dble(NELIM)) + ENDIF + NELIM_MEM_SIZE=A+B + MEM_SIZE_WEAK(i)=NELIM_MEM_SIZE + IF((SBTR_WHICH_M.EQ.0).OR.(.NOT.BDC_SBTR))THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i)) + ENDIF + ELSE + IF(BDC_SBTR)THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ENDIF + ENDIF + ENDIF + IF(min(MEM_SIZE_STRONG(i),MEM_SIZE_WEAK(i)).LT.dble(0))THEN + IF(MEM_SIZE_STRONG(i).LT.0.0d0)THEN + MEM_SIZE_STRONG(i)=dble(0) + ELSE + MEM_SIZE_WEAK(i)=dble(0) + ENDIF + ENDIF + ENDDO + ELSE + BUF_SIZE=dble(K821) + DO i=1,NUMBER_OF_PROCS + IF((SBTR_WHICH_M.EQ.0).OR.(.NOT.BDC_SBTR))THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i)) + ENDIF + ELSE + IF(BDC_SBTR)THEN + IF(BDC_M2_MEM)THEN + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ELSE + MEM_SIZE_STRONG(i)= + & dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))- + & LU_USAGE(TEMP_ID(i))- + & (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i))) + ENDIF + ENDIF + ENDIF + MEM_SIZE_STRONG(i)=max(dble(0),MEM_SIZE_STRONG(i)) + MEM_SIZE_WEAK(i)=huge(MEM_SIZE_WEAK(i)) + ENDDO + ENDIF + IF((((NUMBER_OF_PROCS.LE.K83).AND.FORCE_CAND).AND. + & (TOTAL_COST.GE.SOMME)).OR. + & (.NOT.FORCE_CAND).OR. + & (((NUMBER_OF_PROCS+1).GT.K83).AND.FORCE_CAND))THEN + REF=NSLAVES_REF + SMALL_SET=NSLAVES_REF + IF(.NOT.SMP)THEN + DO i=NSLAVES_REF,1,-1 + SOMME=dble(0) + DO J=1,i + SOMME=SOMME+TEMP(J) + ENDDO + SOMME=(dble(i)*TEMP(i))-SOMME + IF(TOTAL_COST.GE.SOMME) GOTO 444 + ENDDO + 444 CONTINUE + REF=i + SMALL_SET=REF + MAX_LOAD=TEMP(SMALL_SET) + ELSE + X=min(SIZE_MY_SMP,NSLAVES_REF) + 450 CONTINUE + SOMME=dble(0) + DO J=1,X + SOMME=SOMME+(TEMP(X)-TEMP(J)) + ENDDO + IF(SOMME.GT.TOTAL_COST)THEN + X=X-1 + GOTO 450 + ELSE + IF(X.LT.SIZE_MY_SMP) THEN + REF=X + SMALL_SET=REF + MAX_LOAD=TEMP(SMALL_SET) + ELSE + X=min(SIZE_MY_SMP,NSLAVES_REF) + J=X+1 + MAX_LOAD=TEMP(X) + TMP_SUM=MAX_LOAD + DO i=X+1,OTHERS + IF(TEMP(i).GT.MAX_LOAD)THEN + SOMME=SOMME+(dble(i-1)*(TEMP(i)-MAX_LOAD)) + TMP_SUM=MAX_LOAD + MAX_LOAD=TEMP(i) + ELSE + SOMME=SOMME+(MAX_LOAD-TEMP(i)) + ENDIF + IF(i.EQ.NSLAVES_REF)THEN + SMALL_SET=NSLAVES_REF + REF=SMALL_SET + GOTO 323 + ENDIF + IF(SOMME.GT.TOTAL_COST)THEN + REF=i-1 + SMALL_SET=i-1 + MAX_LOAD=TMP_SUM + GOTO 323 + ENDIF + ENDDO + ENDIF + ENDIF + ENDIF + 323 CONTINUE + MAX_LOAD=dble(0) + DO i=1,SMALL_SET + MAX_LOAD=max(MAX_LOAD,TEMP(i)) + ENDDO + TEMP_MAX_LOAD=MAX_LOAD + NB_ROWS=0 + TMP_SUM=dble(0) + CHOSEN=0 + ACC=0 + NB_SAT=0 + NB_ZERO=0 + DO i=1,SMALL_SET + IF(K50.EQ.0)THEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + IF(HAVE_TYPE1_SON)THEN + IF(K50.EQ.0)THEN + X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + IF(K50.EQ.0)THEN + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + X=int((MAX_LOAD-TEMP(i))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.KMIN)THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*(dble(NELIM)+dble(2*ACC+1)) + C=-(MAX_LOAD-TEMP(i)) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 1 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.KMIN)THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + NB_ROWS(i)=X + ACC=ACC+X + CHOSEN=CHOSEN+1 + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + TMP_SUM=MAX_LOAD + IF(K50.EQ.0)THEN + MAX_LOAD=max(MAX_LOAD, + & (TEMP(i)+(dble(NELIM) * + & dble(NB_ROWS(i)))+ + & (dble(NB_ROWS(i))*dble(NELIM)* + & dble(2*NFRONT-NELIM-1)))) + ELSE + MAX_LOAD=max(MAX_LOAD, + & TEMP(i)+(dble(NELIM) * dble(NB_ROWS(i)))* + & dble(2*(NELIM+ACC)-NB_ROWS(i) + & -NELIM+1)) + ENDIF + IF(TMP_SUM.LT.MAX_LOAD)THEN + ENDIF + IF(NCB-ACC.LT.KMIN) GOTO 888 + IF(NCB.EQ.ACC) GOTO 888 + IF(ACC.GT.NCB) THEN + WRITE(*,*)MYID, + & ': Internal error 2 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + ENDDO + 888 CONTINUE + SOMME=dble(0) + X=NFRONT-NCB + IF((ACC.GT.NCB))THEN + WRITE(*,*)MYID, + & ': Internal error 3 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF((ACC.LT.NCB))THEN + IF(K50.NE.0)THEN + IF(SMALL_SET.LE.OTHERS)THEN + IF((NB_SAT.EQ.SMALL_SET).AND.(SMALL_SET.LT. + & NSLAVES_REF))THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ADDITIONNAL_ROWS_SPECIAL=NCB-ACC + DO i=1,SMALL_SET + MAX_LOAD=TEMP_MAX_LOAD + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)* + & dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS-NELIM + & +1) + SOMME=SOMME/dble(SMALL_SET-NB_SAT) + NB_ROWS=0 + NB_ZERO=0 + ACC=0 + CHOSEN=0 + NB_SAT=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO J=1,SMALL_SET + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=(dble(NELIM)*dble(NELIM+2*ACC+1)) + C=-(MAX_LOAD-TEMP(J)+SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=X+1 + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 4 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + NB_ZERO=NB_ZERO+1 + X=0 + ENDIF + ELSE + IF(X.LT.min(KMIN,KMAX))THEN + NB_ZERO=NB_ZERO+1 + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(J)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(J))THEN + MIN_LOAD=TEMP(J) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + ACC=ACC+X + TMP_SUM=MAX_LOAD + TEMP_MAX_LOAD=max(TEMP_MAX_LOAD, + & TEMP(J)+(dble(NELIM) * + & dble(NB_ROWS(J)))* + & dble(2*(NELIM+ + & ACC)-NB_ROWS(J) + & -NELIM+1)) + IF(REF.LE.NUMBER_OF_PROCS-1)THEN + IF(TEMP_MAX_LOAD.GT.TEMP(REF+1))THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ENDIF + ENDIF + IF(NCB.EQ.ACC) GOTO 666 + ENDDO + IF(NB_SAT.EQ.SMALL_SET)THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + GOTO 434 + ENDIF + ENDIF + IF(NB_ZERO.EQ.SMALL_SET)THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + GOTO 434 + ENDIF + ENDIF + IF((NB_SAT+NB_ZERO).EQ.SMALL_SET)THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + GOTO 434 + ENDIF + ENDIF + ENDDO + 434 CONTINUE + ADDITIONNAL_ROWS=NCB-ACC + IF(ADDITIONNAL_ROWS.NE.0)THEN + IF(ADDITIONNAL_ROWS.LT.KMIN)THEN + i=CHOSEN + J=ACC + 436 CONTINUE + IF(NB_ROWS(i).NE.0)THEN + J=J-NB_ROWS(i) + A=dble(1) + B=dble(J+2) + C=-BUF_SIZE+dble(J+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-J) X=NCB-J + BANDE_K821=dble(X)*dble(NELIM+J+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(J+2+NELIM) + C=-BUF_SIZE+dble(J+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-J) X=NCB-J + BANDE_K821=dble(X)*dble(NELIM+J+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(J+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(NB_ROWS(i).NE.KMAX)THEN + IF(NCB-J.LE.KMAX)THEN + NB_ROWS(i)=+NCB-J + ADDITIONNAL_ROWS=0 + ENDIF + ENDIF + TEMP_MAX_LOAD=max(TEMP_MAX_LOAD, + & TEMP(i)+ + & (dble(NELIM) * dble(NB_ROWS(i)))* + & dble(2*(NELIM+ + & ACC)-NB_ROWS(i) + & -NELIM+1)) + IF(REF.LE.NUMBER_OF_PROCS-1)THEN + IF(TEMP_MAX_LOAD.GT.TEMP(REF+1))THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ENDIF + ENDIF + ELSE + i=i-1 + IF(i.NE.0)GOTO 436 + ENDIF + IF(ADDITIONNAL_ROWS.NE.0)THEN + i=CHOSEN + IF(i.NE.SMALL_SET)THEN + i=i+1 + IF(NB_ROWS(i).NE.0)THEN + WRITE(*,*)MYID, + & ': Internal error 5 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + CHOSEN=i + ENDIF + ENDIF + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF((TEMP(i).LE.MAX_LOAD))THEN + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(i)) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.KMIN)THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + ACC=ACC+X + ADDITIONNAL_ROWS=NCB-ACC + ELSE IF((TEMP(i).GT.MAX_LOAD))THEN + MAX_LOAD=TEMP(i) + NB_SAT=0 + ACC=0 + NB_ROWS=0 + DO J=1,i + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(J)) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 6 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + NB_SAT=NB_SAT+1 + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.min(KMIN,KMAX))THEN + X=0 + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(J)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(J))THEN + MIN_LOAD=TEMP(J) + POS_MIN_LOAD=i + ENDIF + ENDIF + ACC=ACC+X + MAX_LOAD=max(MAX_LOAD, + & TEMP(J)+ + & (dble(NELIM)*dble(NB_ROWS(J)))* + & dble(2*(NELIM+ + & ACC)-NB_ROWS(J) + & -NELIM+1)) + IF(NCB.EQ.ACC) GOTO 741 + IF(NCB-ACC.LT.KMIN) GOTO 210 + ENDDO + 210 CONTINUE + ENDIF + 741 CONTINUE + i=i+1 + ADDITIONNAL_ROWS=NCB-ACC + ENDDO + CHOSEN=i-1 + IF(ADDITIONNAL_ROWS.NE.0)THEN + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)*dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS- + & NELIM+1) + SOMME=SOMME/dble(NUMBER_OF_PROCS) + NB_ROWS=0 + ACC=0 + CHOSEN=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(i)+SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 7 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GE.KMIN)THEN + X=KMAX + ELSE + X=0 + ENDIF + ELSE + IF(X.LT.min(KMIN,KMAX))THEN + X=min(KMAX,KMIN) + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB.EQ.ACC) GOTO 666 + IF(NCB-ACC.LT.KMIN) GOTO 488 + ENDDO + 488 CONTINUE + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)* + & dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS- + & NELIM+1) + SOMME=SOMME/dble(NUMBER_OF_PROCS) + NB_ROWS=0 + ACC=0 + CHOSEN=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + C=-(MAX_LOAD-TEMP(i)+SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 8 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + X=KMAX + ELSE + IF(X.LT.KMIN)THEN + X=KMIN + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + NB_ROWS(i)=X + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(NCB.EQ.ACC) GOTO 666 + IF(NCB-ACC.LT.KMIN) GOTO 477 + ENDDO + 477 CONTINUE + IF(ACC.NE.NCB)THEN + NB_SAT=0 + ACC=0 + CHOSEN=0 + IF(SMP)THEN + MIN_LOAD=TEMP(1) + POS_MIN_LOAD=1 + ENDIF + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=KMAX-NB_ROWS(i) + IF((ACC+NB_ROWS(i)+X).GT.NCB) + & X=NCB-(ACC+NB_ROWS(i)) + NB_ROWS(i)=NB_ROWS(i)+X + IF((dble(NB_ROWS(i))* + & dble(NB_ROWS(i)+ACC)).EQ. + & BANDE_K821)THEN + NB_SAT=NB_SAT+1 + ENDIF + ACC=ACC+NB_ROWS(i) + IF(SMP)THEN + IF(MIN_LOAD.GT.TEMP(i))THEN + MIN_LOAD=TEMP(i) + POS_MIN_LOAD=i + ENDIF + ENDIF + CHOSEN=CHOSEN+1 + IF(NCB.EQ.ACC) GOTO 666 + IF(NCB-ACC.LT.KMIN) GOTO 834 + ENDDO + 834 CONTINUE + ENDIF + IF(ACC.NE.NCB)THEN + ADDITIONNAL_ROWS=NCB-ACC + SOMME=dble(NELIM)* + & dble(ADDITIONNAL_ROWS)* + & dble(2*NFRONT-ADDITIONNAL_ROWS- + & NELIM+1) + SOMME=SOMME/dble(NUMBER_OF_PROCS-NB_SAT) + ACC=0 + DO i=1,CHOSEN + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + IF((dble(NB_ROWS(i))* + & dble(NB_ROWS(i)+ACC)).EQ. + & BANDE_K821)THEN + GOTO 102 + ENDIF + A=dble(NELIM) + B=dble(NELIM)* + & dble(NELIM+2*(ACC+NB_ROWS(i))+1) + C=-(SOMME) + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-BANDE_K821) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 9 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF((ACC+X+NB_ROWS(i)).GT.NCB)THEN + IF((NCB-ACC).GT.KMAX)THEN + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NCB-ACC + ENDIF + ELSE + IF((NB_ROWS(i)+X).GT.KMAX)THEN + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NB_ROWS(i)+X + ENDIF + ENDIF + 102 CONTINUE + ACC=ACC+NB_ROWS(i) + IF(NCB.EQ.ACC) THEN + CHOSEN=i + GOTO 666 + ENDIF + IF(NCB-ACC.LT.KMIN) THEN + CHOSEN=i + GOTO 007 + ENDIF + ENDDO + 007 CONTINUE + DO i=1,CHOSEN + NB_ROWS(i)=NB_ROWS(i)+1 + ACC=ACC+1 + IF(ACC.EQ.NCB)GOTO 666 + ENDDO + IF(ACC.LT.NCB)THEN + IF(SMP)THEN + NB_ROWS(1)=NB_ROWS(1)+NCB-ACC + ELSE + NB_ROWS(POS_MIN_LOAD)= + & NB_ROWS(POS_MIN_LOAD)+NCB-ACC + ENDIF + ENDIF + ENDIF + GOTO 666 + ENDIF + ENDIF + GOTO 666 + ENDIF + ADDITIONNAL_ROWS=NCB-ACC + i=CHOSEN+1 + IF(NB_SAT.EQ.SMALL_SET) GOTO 777 + DO i=1,SMALL_SET + IDWLOAD(i)=i + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & (dble(NFRONT+1))) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + WLOAD(i)=MAX_MEM_ALLOW + ENDDO + CALL MUMPS_558(SMALL_SET, WLOAD, IDWLOAD) + NB_ZERO=0 + IF((NB_SAT.EQ.SMALL_SET).AND. + & (SMALL_SET.LT.NSLAVES_REF))THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + IF((NB_SAT.EQ.SMALL_SET).AND. + & (SMALL_SET.LE.NUMBER_OF_PROCS))GOTO 777 + AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT)) + AFFECTED=max(AFFECTED,1) + DO i=1,SMALL_SET + KMAX=int(WLOAD(i)/dble(NFRONT)) + IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN + GOTO 912 + ENDIF + IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED, + & ADDITIONNAL_ROWS)).GT.KMAX)THEN + IF(NB_ROWS(IDWLOAD(i)).GT.KMAX)THEN + ENDIF + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(IDWLOAD(i))) + NB_ROWS(IDWLOAD(i))=KMAX + NB_SAT=NB_SAT+1 + IF(NB_SAT.EQ.SMALL_SET)THEN + IF(SMALL_SET.NE.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ELSE + MAX_LOAD=max(MAX_LOAD, + & (TEMP(IDWLOAD(i))+(dble(NELIM) * + & dble(NB_ROWS(IDWLOAD(i))))+ + & (dble(NB_ROWS(IDWLOAD(i)))* + & dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + GOTO 777 + ENDIF + ENDIF + AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT)) + AFFECTED=max(AFFECTED,1) + ELSE + IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED, + & ADDITIONNAL_ROWS)).GE.KMIN)THEN + X=min(AFFECTED,ADDITIONNAL_ROWS) + NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+ + & X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ELSE + X=int((MAX_LOAD-TEMP(IDWLOAD(i)))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X+AFFECTED.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ELSE + X=AFFECTED+X + ENDIF + IF(X.GE.KMIN)THEN + NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+ + & X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & X + ELSE + NB_ZERO=NB_ZERO+1 + ENDIF + ENDIF + ENDIF + 912 CONTINUE + MAX_LOAD=max(MAX_LOAD, + & (TEMP(IDWLOAD(i))+(dble(NELIM)* + & dble(NB_ROWS(IDWLOAD(i))))+ + & (dble(NB_ROWS(IDWLOAD(i)))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + IF(SMALL_SET.LT.NUMBER_OF_PROCS)THEN + IF(MAX_LOAD.GT.TEMP(SMALL_SET+1))THEN + IF(SMALL_SET.LT.NSLAVES_REF)THEN + SMALL_SET=REF+1 + REF=REF+1 + NB_ROWS=0 + GOTO 323 + ENDIF + ENDIF + ENDIF + IF(SMALL_SET.EQ.NB_SAT)GOTO 777 + IF(ADDITIONNAL_ROWS.EQ.0)THEN + CHOSEN=SMALL_SET + GOTO 049 + ENDIF + ENDDO + 777 CONTINUE + IF((NB_ZERO.NE.0).AND.(ADDITIONNAL_ROWS.GE.KMIN))THEN + J=NB_ZERO + 732 CONTINUE + X=int(ADDITIONNAL_ROWS/(J)) + IF(X.LT.KMIN)THEN + J=J-1 + GOTO 732 + ENDIF + IF(X*J.LT.ADDITIONNAL_ROWS)THEN + X=X+1 + ENDIF + DO i=1,SMALL_SET + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & dble(BANDE_K821)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(NB_ROWS(i).EQ.0)THEN + IF(X.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ENDIF + IF(X.GT.KMAX)THEN + X=KMAX + ENDIF + IF(X.GT.KMIN)THEN + NB_ROWS(i)=X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + MAX_LOAD=max(MAX_LOAD, + & (TEMP(i)+(dble(NELIM) * + & dble(NB_ROWS(i)))+ + & (dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + ENDIF + ENDIF + ENDDO + ENDIF + i=CHOSEN+1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF((TEMP(i).LE.MAX_LOAD))THEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + AFFECTED=int((MAX_LOAD-TEMP(i))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(i).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(i)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(i) + NB_SAT=NB_SAT+1 + ELSE + IF((AFFECTED+NB_ROWS(i)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(i)=NB_ROWS(i)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + ENDIF + ELSE IF((TEMP(i).GT.MAX_LOAD))THEN + IF(NB_SAT.EQ.i-1) GOTO 218 + X=(ADDITIONNAL_ROWS/(i-1-NB_SAT)) + ACC=1 + DO J=1,i-1 + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(J)+X)) + & +(dble(NB_ROWS(J)+X)*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + IF((TEMP(J)+TMP_SUM).GT.MAX_LOAD)THEN + ACC=0 + ENDIF + ENDDO + IF(ACC.EQ.1)THEN + MAX_LOAD=TEMP(i) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + AFFECTED=X + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(J).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + NB_SAT=NB_SAT+1 + ELSE + IF((AFFECTED+NB_ROWS(J)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & AFFECTED + ENDIF + J=J+1 + ENDDO + ELSE + MAX_LOAD=TEMP(i) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + TMP_SUM=((dble(NELIM)* dble(NB_ROWS(J))) + & +(dble(NB_ROWS(J))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((MAX_LOAD-(TEMP(J)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 10 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + AFFECTED=X + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(J).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(J) + NB_SAT=NB_SAT+1 + ELSE + IF((AFFECTED+NB_ROWS(J)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(J)=NB_ROWS(J)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & AFFECTED + ENDIF + J=J+1 + ENDDO + ENDIF + ENDIF + 218 CONTINUE + i=i+1 + ENDDO + CHOSEN=i-1 + IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND. + & (ADDITIONNAL_ROWS.NE.0))THEN + DO i=1,CHOSEN + IF(NB_ROWS(i)+1.GE.KMIN)THEN + NB_ROWS(i)=NB_ROWS(i)+1 + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1 + ENDIF + MAX_LOAD=max(MAX_LOAD, + & (TEMP(i)+(dble(NELIM) * + & dble(NB_ROWS(i)))+ + & (dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1))) + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 048 + ENDDO + 048 CONTINUE + ENDIF + IF((ADDITIONNAL_ROWS.NE.0))THEN + IF(CHOSEN.LT.NUMBER_OF_PROCS)THEN + i=CHOSEN+1 + ELSE + IF(CHOSEN.NE.NUMBER_OF_PROCS)THEN + WRITE(*,*)MYID, + & ': Internal error 11 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + i=CHOSEN + ENDIF + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(i.LE.NUMBER_OF_PROCS)) + IF(TEMP(i).LE.MAX_LOAD)THEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) + & +(dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((MAX_LOAD-(TEMP(i)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + AFFECTED=X + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 12 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN + AFFECTED=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(i).LT.KMAX)THEN + IF((AFFECTED+NB_ROWS(i)).GT.KMAX)THEN + AFFECTED=KMAX-NB_ROWS(i) + ELSE + IF((AFFECTED+NB_ROWS(i)).LT. + & KMIN)THEN + AFFECTED=0 + ENDIF + ENDIF + NB_ROWS(i)=NB_ROWS(i)+AFFECTED + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED + ENDIF + IF(i.NE.NUMBER_OF_PROCS) GOTO 624 + ELSE IF((TEMP(i).GT.MAX_LOAD))THEN + X=int(ADDITIONNAL_ROWS/i-1) + X=max(X,1) + IF((MAX_LOAD+((dble(NELIM)* + & dble(X))+(dble( + & X)*dble(NELIM))*dble( + & (2*NFRONT-NELIM-1)))).LE.TEMP(i))THEN + AFFECTED=X + POS=1 + ELSE + POS=0 + ENDIF + MAX_LOAD=TEMP(i) + J=1 + DO WHILE ((ADDITIONNAL_ROWS.NE.0) + & .AND.(J.LT.i)) + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + MAX_MEM_ALLOW=BANDE_K821 + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(POS.EQ.0)THEN + TMP_SUM=((dble(NELIM) * + & dble(NB_ROWS(J))) + & +(dble(NB_ROWS(J))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((TEMP(i)-(TEMP(J)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT- + & NELIM))) + ELSE + X=int(TMP_SUM) + ENDIF + IF(X.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(J).LT.KMAX)THEN + IF((X+NB_ROWS(J)).GT.KMAX)THEN + X=KMAX-NB_ROWS(J) + ELSE + IF((NB_ROWS(J)+X).LT. + & KMIN)THEN + X=0 + ENDIF + ENDIF + NB_ROWS(J)=NB_ROWS(J)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ENDIF + J=J+1 + ENDDO + ENDIF + 624 CONTINUE + i=i+1 + ENDDO + CHOSEN=i-1 + IF(ADDITIONNAL_ROWS.NE.0)THEN + ACC=0 + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) + & +(dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + X=int((MAX_LOAD- + & (TEMP(i)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error 13 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GT.ADDITIONNAL_ROWS)THEN + X=ADDITIONNAL_ROWS + ENDIF + IF(NB_ROWS(i).LT.KMAX)THEN + IF((X+NB_ROWS(i)).GE.KMAX)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + IF((X+NB_ROWS(i)).GE. + & KMIN)THEN + NB_ROWS(i)=NB_ROWS(i)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ACC=ACC+1 + ELSE + ACC=ACC+1 + ENDIF + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + IF(CHOSEN.LT.NUMBER_OF_PROCS)THEN + CHOSEN=CHOSEN+1 + ENDIF + IF(ACC.EQ.0)THEN + ACC=1 + ENDIF + X=int(ADDITIONNAL_ROWS/ACC) + X=max(X,1) + ACC=0 + DO i=1,CHOSEN + J=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(J)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + J=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(J)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i))) + & +(dble(NB_ROWS(i))*dble(NELIM))* + & dble(2*NFRONT-NELIM-1)) + J=int((MAX_LOAD- + & (TEMP(i)+TMP_SUM))/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(NB_ROWS(i).LT.KMAX)THEN + IF((min(X,J)+NB_ROWS(i)).GE.KMAX)THEN + IF((KMAX-NB_ROWS(i)).GT. + & ADDITIONNAL_ROWS)THEN + NB_ROWS(i)=NB_ROWS(i)+ + & ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ENDIF + ELSE + IF((min(X,J)+NB_ROWS(i)).GE. + & KMIN)THEN + NB_ROWS(i)=NB_ROWS(i)+min(X,J) + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & min(X,J) + ACC=ACC+1 + ENDIF + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + IF(ACC.GT.0)THEN + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)), + & BANDE_K821) + MAX_MEM_ALLOW=max(dble(0), + & MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(KMAX-NB_ROWS(i).LT. + & ADDITIONNAL_ROWS)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + IF(NB_ROWS(i).EQ.0)THEN + IF(min(KMIN,KMAX).LT. + & ADDITIONNAL_ROWS)THEN + NB_ROWS(i)=min(KMIN,KMAX) + ADDITIONNAL_ROWS= + & ADDITIONNAL_ROWS- + & min(KMIN,KMAX) + ENDIF + ELSE + NB_ROWS(i)=NB_ROWS(i)+ + & ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + ENDIF + DO i=1,CHOSEN + IDWLOAD(i)=i + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + WLOAD(i)=(BANDE_K821-dble(NB_ROWS(i)*NFRONT)) + ENDDO + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, + & IDWLOAD) + NB_SAT=0 + DO i=1,CHOSEN + X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT)) + X=max(X,1) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(NB_ROWS(IDWLOAD(i)).LT.KMAX)THEN + IF((NB_ROWS(IDWLOAD(i))+X).LT.KMAX)THEN + NB_ROWS(IDWLOAD(i))= + & NB_ROWS(IDWLOAD(i))+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(IDWLOAD(i))) + NB_ROWS(IDWLOAD(i))=KMAX + ENDIF + ENDIF + IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN + NB_SAT=NB_SAT+1 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 049 + ENDDO + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(KMAX-NB_ROWS(i).LT.ADDITIONNAL_ROWS)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + X=int(ADDITIONNAL_ROWS/CHOSEN) + X=max(X,1) + DO i=1,CHOSEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + NB_ROWS(i)=NB_ROWS(i)+X + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049 + ENDDO + NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS + ENDIF + ENDIF + 049 CONTINUE + ENDIF + 666 CONTINUE + SOMME=dble(0) + X=0 + POS=0 + DO i=1,CHOSEN + X=X+NB_ROWS(i) + SOMME=SOMME+ dble(NB_ROWS(i)) + ENDDO + GOTO 890 + ELSE IF((KEEP(83).GE.NUMBER_OF_PROCS).AND.FORCE_CAND)THEN + MAX_LOAD=dble(0) + DO i=1,OTHERS + MAX_LOAD=max(MAX_LOAD,TEMP(i)) + ENDDO + ACC=0 + CHOSEN=0 + X=1 + DO i=1,OTHERS + ENDDO + DO i=2,OTHERS + IF(TEMP(i).EQ.TEMP(1))THEN + X=X+1 + ELSE + GOTO 329 + ENDIF + ENDDO + 329 CONTINUE + TMP_SUM=TOTAL_COST/dble(X) + TEMP_MAX_LOAD=dble(0) + DO i=1,OTHERS + IF(K50.EQ.0)THEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + IF(HAVE_TYPE1_SON)THEN + IF(K50.EQ.0)THEN + X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ELSE + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i))) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + IF(K50.EQ.0)THEN + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(TMP_SUM+TEMP(i).GT.MAX_LOAD)THEN + SOMME=MAX_LOAD-TEMP(i) + ELSE + SOMME=TMP_SUM + ENDIF + X=int(SOMME/ + & (dble(NELIM)*dble(2*NFRONT-NELIM))) + IF(X.GT.KMAX)THEN + X=KMAX + ELSE + IF(X.LT.KMIN)THEN + X=min(KMIN,KMAX) + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + IF(K50.NE.0)THEN + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + A=dble(NELIM) + B=dble(NELIM)*dble(NELIM+2*ACC+1) + IF(TMP_SUM+TEMP(i).GT.MAX_LOAD)THEN + C=-(MAX_LOAD-TEMP(i)) + ELSE + C=-TMP_SUM + ENDIF + DELTA=(B*B-(dble(4)*A*C)) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.LT.0) THEN + WRITE(*,*)MYID, + & ': Internal error 14 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + IF(X.GE.KMAX)THEN + IF(KMAX.GT.KMIN)THEN + X=KMAX + ELSE + X=0 + ENDIF + ELSE + IF(X.LE.min(KMIN,KMAX))THEN + IF(KMAX.LT.KMIN)THEN + X=0 + ELSE + X=min(KMIN,KMAX) + ENDIF + ENDIF + ENDIF + IF((ACC+X).GT.NCB) X=NCB-ACC + ENDIF + TEMP_MAX_LOAD=max(TEMP_MAX_LOAD,TEMP(i)) + NB_ROWS(i)=X + CHOSEN=CHOSEN+1 + ACC=ACC+X + IF(ACC.EQ.NCB) GOTO 541 + ENDDO + 541 CONTINUE + IF(ACC.LT.NCB)THEN + IF(K50.EQ.0)THEN + ADDITIONNAL_ROWS=NCB-ACC + DO J=1,CHOSEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min( + & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)), + & dble(BANDE_K821)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF((NB_ROWS(J)).LT.KMAX)THEN + IF(ADDITIONNAL_ROWS.GT.(KMAX-NB_ROWS(J)))THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(J)) + NB_ROWS(J)=KMAX + ELSE + NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 + ENDDO + X=int(ADDITIONNAL_ROWS/CHOSEN) + X=max(X,1) + DO J=1,CHOSEN + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(J)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF((NB_ROWS(J)+X).GT.KMAX)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(J)) + NB_ROWS(J)=KMAX + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + NB_ROWS(J)=NB_ROWS(J)+X + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 + ENDDO + DO i=1,CHOSEN + X=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(X)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + X=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(X)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(KMAX-NB_ROWS(i).LT.ADDITIONNAL_ROWS)THEN + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(i)) + NB_ROWS(i)=KMAX + ELSE + NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS + ADDITIONNAL_ROWS=0 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889 + ENDDO + DO i=1,NUMBER_OF_PROCS + IDWLOAD(i)=i + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + WLOAD(i)=(BANDE_K821-(dble(NB_ROWS(i))* + & dble(NFRONT))) + ENDDO + CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, + & IDWLOAD) + NB_SAT=0 + DO i=1,CHOSEN + X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT)) + X=max(X,1) + AFFECTED=int(BUF_SIZE/dble(NCB+1))-1 + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + IF(HAVE_TYPE1_SON)THEN + AFFECTED=int((BUF_SIZE-dble(NFRONT))/ + & dble(NFRONT+1)) + BANDE_K821=dble(AFFECTED)*dble(NFRONT) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + KMAX=int(MAX_MEM_ALLOW/dble(NFRONT)) + IF(NB_ROWS(IDWLOAD(i)).LT.KMAX)THEN + IF((NB_ROWS(IDWLOAD(i))+X).LT.KMAX)THEN + NB_ROWS(IDWLOAD(i))= + & NB_ROWS(IDWLOAD(i))+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + ELSE + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS- + & (KMAX-NB_ROWS(IDWLOAD(i))) + NB_ROWS(IDWLOAD(i))=KMAX + ENDIF + ENDIF + IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN + NB_SAT=NB_SAT+1 + ENDIF + IF(ADDITIONNAL_ROWS.EQ.0) GOTO 889 + ENDDO + GOTO 994 + ELSE + ACC=0 + CHOSEN=0 + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + IF(BDC_MD)THEN + MAX_MEM_ALLOW=min(BANDE_K821, + & MEM_SIZE_STRONG(i)) + MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW) + ENDIF + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=KMAX-NB_ROWS(i) + IF((ACC+NB_ROWS(i)+X).GT.NCB) + & X=NCB-(ACC+NB_ROWS(i)) + NB_ROWS(i)=NB_ROWS(i)+X + ACC=ACC+NB_ROWS(i) + CHOSEN=CHOSEN+1 + IF(NCB.EQ.ACC) GOTO 889 + ENDDO + ADDITIONNAL_ROWS=NCB-ACC + ENDIF + ACC=0 + CHOSEN=0 + DO i=1,OTHERS + A=dble(1) + B=dble(ACC+2) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + IF(HAVE_TYPE1_SON)THEN + A=dble(1) + B=dble(ACC+2+NELIM) + C=-BUF_SIZE+dble(ACC+NELIM) + DELTA=(B*B)-(dble(4)*A*C) + X=int((-B+sqrt(DELTA))/(dble(2)*A)) + IF(X.GT.NCB-ACC) X=NCB-ACC + BANDE_K821=dble(X)*dble(NELIM+ACC+X) + ENDIF + MAX_MEM_ALLOW=BANDE_K821 + A=dble(1) + B=dble(ACC+NELIM) + C=dble(-MAX_MEM_ALLOW) + DELTA=((B*B)-(dble(4)*A*C)) + KMAX=int((-B+sqrt(DELTA))/(dble(2)*A)) + X=KMAX-NB_ROWS(i) + IF((ACC+NB_ROWS(i)+X).GT.NCB) + & X=NCB-(ACC+NB_ROWS(i)) + NB_ROWS(i)=NB_ROWS(i)+X + ACC=ACC+NB_ROWS(i) + CHOSEN=CHOSEN+1 + IF(NCB.EQ.ACC) GOTO 889 + ENDDO + ADDITIONNAL_ROWS=NCB-ACC + 994 CONTINUE + X=int(dble(ADDITIONNAL_ROWS)/dble(OTHERS)) + IF((X*OTHERS).LT.ADDITIONNAL_ROWS)THEN + X=X+1 + ENDIF + DO i=1,OTHERS + NB_ROWS(i)=NB_ROWS(i)+X + ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X + IF(ADDITIONNAL_ROWS.LT.X)X=ADDITIONNAL_ROWS + ENDDO + CHOSEN=OTHERS + ENDIF + ENDIF + 889 CONTINUE + MAX_LOAD=TEMP_MAX_LOAD + 890 CONTINUE + J=CHOSEN + X=0 + DO i=J,1,-1 + IF(NB_ROWS(i).EQ.0)THEN + CHOSEN=CHOSEN-1 + ELSE + IF(NB_ROWS(i).GT.0)THEN + X=1 + ELSE + WRITE(*,*)MYID, + & ': Internal error 15 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDDO + NSLAVES_NODE=CHOSEN + TAB_POS(NSLAVES_NODE+1)= NCB+1 + TAB_POS(SLAVEF+2) = CHOSEN + POS=1 + X=1 + DO i=1,J + IF(NB_ROWS(i).NE.0)THEN + SLAVES_LIST(X)=TEMP_ID(i) + TAB_POS(X)=POS + POS=POS+NB_ROWS(i) + IF(NB_ROWS(i).LE.0)THEN + WRITE(*,*)MYID, + & ': Internal error 16 in ZMUMPS_518' + CALL MUMPS_ABORT() + ENDIF + X=X+1 + ENDIF + ENDDO + DO i=CHOSEN+1,NUMBER_OF_PROCS + SLAVES_LIST(i)=TEMP_ID(i) + ENDDO + IF(POS.NE.(NCB+1))THEN + WRITE(*,*)MYID, + & ': Internal error 17 in ZMUMPS_518', + & POS,NCB+1 + CALL MUMPS_ABORT() + ENDIF + END SUBROUTINE ZMUMPS_518 + SUBROUTINE ZMUMPS_520 + & (INODE,UPPER,SLAVEF,KEEP,KEEP8, + & STEP,POOL,LPOOL,PROCNODE,N) + IMPLICIT NONE + INTEGER INODE, LPOOL, SLAVEF, N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER STEP(KEEP(28)), POOL(LPOOL), PROCNODE(KEEP(28)) + LOGICAL UPPER + INTEGER J + DOUBLE PRECISION MEM_COST + INTEGER NBINSUBTREE,i,NBTOP + EXTERNAL ZMUMPS_508, + & MUMPS_170 + LOGICAL ZMUMPS_508, + & MUMPS_170 + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + IF(KEEP(47).LT.2)THEN + WRITE(*,*)'ZMUMPS_520 must + & be called with K47>=2' + CALL MUMPS_ABORT() + ENDIF + IF((INODE.GT.0).AND.(INODE.LE.N))THEN + MEM_COST=ZMUMPS_543(INODE) + IF((DM_MEM(MYID)+dble(MEM_COST)+ PEAK_SBTR_CUR_LOCAL- + & SBTR_CUR_LOCAL) + & .GT.MAX_PEAK_STK)THEN + DO i=NBTOP-1,1,-1 + INODE = POOL( LPOOL - 2 - i) + MEM_COST=ZMUMPS_543(INODE) + IF((INODE.LT.0).OR.(INODE.GT.N)) THEN + DO J=i+1,NBTOP,-1 + POOL(J-1)=POOL(J) + ENDDO + UPPER=.TRUE. + RETURN + ENDIF + IF((DM_MEM(MYID)+dble(MEM_COST)+PEAK_SBTR_CUR_LOCAL- + & SBTR_CUR_LOCAL).LE. + & MAX_PEAK_STK) THEN + DO J=i+1,NBTOP,-1 + POOL(J-1)=POOL(J) + ENDDO + UPPER=.TRUE. + RETURN + ENDIF + ENDDO + IF(NBINSUBTREE.NE.0)THEN + INODE = POOL( NBINSUBTREE ) + IF(.NOT.MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + WRITE(*,*) + & 'Internal error 1 in ZMUMPS_520' + CALL MUMPS_ABORT() + ENDIF + UPPER=.FALSE. + RETURN + ENDIF + INODE=POOL(LPOOL-2-NBTOP) + UPPER=.TRUE. + RETURN + ENDIF + ENDIF + UPPER=.TRUE. + END SUBROUTINE ZMUMPS_520 + SUBROUTINE ZMUMPS_513(WHAT) + IMPLICIT NONE + LOGICAL WHAT + IF(.NOT.BDC_POOL_MNG)THEN + WRITE(*,*)'ZMUMPS_513 + & should be called when K81>0 and K47>2' + ENDIF + IF(WHAT)THEN + PEAK_SBTR_CUR_LOCAL=PEAK_SBTR_CUR_LOCAL+ + & dble(MEM_SUBTREE(INDICE_SBTR)) + IF(.NOT.BDC_SBTR) INDICE_SBTR=INDICE_SBTR+1 + ELSE + PEAK_SBTR_CUR_LOCAL=dble(0) + SBTR_CUR_LOCAL=dble(0) + ENDIF + END SUBROUTINE ZMUMPS_513 + DOUBLE PRECISION FUNCTION ZMUMPS_543( INODE ) + IMPLICIT NONE + INTEGER INODE,LEVEL,i,NELIM,NFR + DOUBLE PRECISION COST + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + NFR = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253) + LEVEL = MUMPS_330( PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS ) + IF (LEVEL .EQ. 1) THEN + COST = dble(NFR) * dble(NFR) + ELSE + IF ( K50 == 0 ) THEN + COST = dble(NFR) * dble(NELIM) + ELSE + COST = dble(NELIM) * dble(NELIM) + ENDIF + ENDIF + ZMUMPS_543=COST + RETURN + END FUNCTION ZMUMPS_543 + RECURSIVE SUBROUTINE ZMUMPS_515(FLAG,COST,COMM) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER COMM,WHAT,IERR + LOGICAL FLAG + DOUBLE PRECISION COST + DOUBLE PRECISION TO_BE_SENT + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF(FLAG)THEN + WHAT=17 + IF(BDC_M2_FLOPS)THEN +#if ! defined(OLD_LOAD_MECHANISM) + TO_BE_SENT=DELTA_LOAD-COST + DELTA_LOAD=dble(0) +#else + TO_BE_SENT=LAST_LOAD_SENT-COST + LAST_LOAD_SENT=LAST_LOAD_SENT-COST +#endif + ELSE IF(BDC_M2_MEM)THEN + IF(BDC_POOL.AND.(.NOT.BDC_MD))THEN + TO_BE_SENT=max(TMP_M2,POOL_LAST_COST_SENT) + POOL_LAST_COST_SENT=TO_BE_SENT + ELSE IF(BDC_MD)THEN +#if ! defined(OLD_LOAD_MECHANISM) + DELTA_MEM=DELTA_MEM+TMP_M2 + TO_BE_SENT=DELTA_MEM +#else + TO_BE_SENT=DM_LAST_MEM_SENT+TMP_M2 + DM_LAST_MEM_SENT=DM_LAST_MEM_SENT+TMP_M2 +#endif + ELSE + TO_BE_SENT=dble(0) + ENDIF + ENDIF + ELSE + WHAT=6 + TO_BE_SENT=dble(0) + ENDIF + 111 CONTINUE + CALL ZMUMPS_460( WHAT, + & COMM, NPROCS, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & COST, + & TO_BE_SENT, + & MYID, IERR ) + IF ( IERR == -1 )THEN + CALL ZMUMPS_467(COMM_LD, KEEP_LOAD) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in ZMUMPS_500", + & IERR + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE ZMUMPS_515 + SUBROUTINE ZMUMPS_512(INODE,STEP,NSTEPS,PROCNODE,FRERE, + & NE,COMM,SLAVEF,MYID,KEEP,KEEP8,N) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER INODE,NSTEPS,MYID,SLAVEF,COMM,N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER FRERE(NSTEPS),NE(NSTEPS),STEP(N),PROCNODE(NSTEPS) + EXTERNAL MUMPS_170,MUMPS_275 + LOGICAL MUMPS_170 + INTEGER i,NCB,NELIM + INTEGER MUMPS_275 + INTEGER FATHER_NODE,FATHER,WHAT,IERR + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN + WRITE(*,*)MYID,': Problem in ZMUMPS_512' + CALL MUMPS_ABORT() + ENDIF + IF((INODE.LT.0).OR.(INODE.GT.N)) THEN + RETURN + ENDIF + i=INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + NCB=ND_LOAD(STEP_LOAD(INODE))-NELIM + KEEP_LOAD(253) + WHAT=5 + FATHER_NODE=DAD_LOAD(STEP_LOAD(INODE)) + IF (FATHER_NODE.EQ.0) THEN + RETURN + ENDIF + IF((FRERE(STEP(FATHER_NODE)).EQ.0).AND. + & ((FATHER_NODE.EQ.KEEP(38)).OR. + & (FATHER_NODE.EQ.KEEP(20))))THEN + RETURN + ENDIF + IF(MUMPS_170(PROCNODE(STEP(FATHER_NODE)), + & SLAVEF)) THEN + RETURN + ENDIF + FATHER=MUMPS_275(PROCNODE(STEP(FATHER_NODE)),SLAVEF) + IF(FATHER.EQ.MYID)THEN + IF(BDC_M2_MEM)THEN + CALL ZMUMPS_816(FATHER_NODE) + ELSEIF(BDC_M2_FLOPS)THEN + CALL ZMUMPS_817(FATHER_NODE) + ENDIF + IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN + IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), + & NPROCS).EQ.1)THEN + CB_COST_ID(POS_ID)=INODE + CB_COST_ID(POS_ID+1)=1 + CB_COST_ID(POS_ID+2)=POS_MEM + POS_ID=POS_ID+3 + CB_COST_MEM(POS_MEM)=int(MYID,8) + POS_MEM=POS_MEM+1 + CB_COST_MEM(POS_MEM)=int(NCB,8)*int(NCB,8) + POS_MEM=POS_MEM+1 + ENDIF + ENDIF + GOTO 666 + ENDIF + 111 CONTINUE + CALL ZMUMPS_519(WHAT, COMM, NPROCS, + & FATHER_NODE,INODE,NCB, KEEP(81),MYID, + & FATHER, IERR) + IF (IERR == -1 ) THEN + CALL ZMUMPS_467(COMM, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in ZMUMPS_512", + & IERR + CALL MUMPS_ABORT() + ENDIF + 666 CONTINUE + END SUBROUTINE ZMUMPS_512 + SUBROUTINE ZMUMPS_514(INODE,NUM_CALL) + IMPLICIT NONE + DOUBLE PRECISION MAXI + INTEGER i,J,IND_MAXI + INTEGER INODE,NUM_CALL + IF(BDC_M2_MEM)THEN + IF(((NUM_CALL.EQ.1).AND.(BDC_MD)).OR. + & ((NUM_CALL.EQ.2).AND.(.NOT.BDC_MD)))THEN + RETURN + ENDIF + ENDIF + IF((FRERE_LOAD(STEP_LOAD(INODE)).EQ.0).AND. + & ((INODE.EQ.KEEP_LOAD(38)).OR. + & (INODE.EQ.KEEP_LOAD(20)))) THEN + RETURN + ENDIF + DO i=POOL_SIZE,1,-1 + IF(POOL_NIV2(i).EQ.INODE) GOTO 666 + ENDDO + NB_SON(STEP_LOAD(INODE))=-1 + RETURN + 666 CONTINUE + IF(BDC_M2_MEM)THEN + IF(POOL_NIV2_COST(i).EQ.MAX_M2)THEN + TMP_M2=MAX_M2 + MAXI=dble(0) + IND_MAXI=-9999 + DO J=POOL_SIZE,1,-1 + IF(J.NE.i) THEN + IF(POOL_NIV2_COST(J).GT.MAXI)THEN + MAXI=POOL_NIV2_COST(J) + IND_MAXI=J + ENDIF + ENDIF + ENDDO + MAX_M2=MAXI + J=IND_MAXI + REMOVE_NODE_FLAG_MEM=.TRUE. + REMOVE_NODE_COST_MEM=TMP_M2 + CALL ZMUMPS_515(REMOVE_NODE_FLAG,MAX_M2,COMM_LD) + NIV2(MYID+1)=MAX_M2 + ENDIF + ELSEIF(BDC_M2_FLOPS)THEN + REMOVE_NODE_COST=POOL_NIV2_COST(i) + REMOVE_NODE_FLAG=.TRUE. + CALL ZMUMPS_515(REMOVE_NODE_FLAG, + & -POOL_NIV2_COST(i),COMM_LD) + NIV2(MYID+1)=NIV2(MYID+1)-POOL_NIV2_COST(i) + ENDIF + DO J=i+1,POOL_SIZE + POOL_NIV2(J-1)=POOL_NIV2(J) + POOL_NIV2_COST(J-1)=POOL_NIV2_COST(J) + ENDDO + POOL_SIZE=POOL_SIZE-1 + END SUBROUTINE ZMUMPS_514 + RECURSIVE SUBROUTINE ZMUMPS_816(INODE) + IMPLICIT NONE + INTEGER INODE + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF((INODE.EQ.KEEP_LOAD(20)).OR. + & (INODE.EQ.KEEP_LOAD(38)))THEN + RETURN + ENDIF + IF(NB_SON(STEP_LOAD(INODE)).EQ.-1)THEN + RETURN + ELSE + IF(NB_SON(STEP_LOAD(INODE)).LT.0)THEN + WRITE(*,*) + & 'Internal error 1 in ZMUMPS_816' + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_SON(STEP_LOAD(INODE))= + & NB_SON(STEP_LOAD(INODE))-1 + IF(NB_SON(STEP_LOAD(INODE)).EQ.0)THEN + POOL_NIV2(POOL_SIZE+1)=INODE + POOL_NIV2_COST(POOL_SIZE+1)= + & ZMUMPS_543(INODE) + POOL_SIZE=POOL_SIZE+1 + IF(POOL_NIV2_COST(POOL_SIZE).GT.MAX_M2)THEN + MAX_M2=POOL_NIV2_COST(POOL_SIZE) + ID_MAX_M2=POOL_NIV2(POOL_SIZE) + CALL ZMUMPS_515(REMOVE_NODE_FLAG_MEM,MAX_M2,COMM_LD) + NIV2(1+MYID)=MAX_M2 + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_816 + RECURSIVE SUBROUTINE ZMUMPS_817(INODE) + IMPLICIT NONE + INTEGER INODE + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + IF((INODE.EQ.KEEP_LOAD(20)).OR. + & (INODE.EQ.KEEP_LOAD(38)))THEN + RETURN + ENDIF + IF(NB_SON(STEP_LOAD(INODE)).EQ.-1)THEN + RETURN + ELSE + IF(NB_SON(STEP_LOAD(INODE)).LT.0)THEN + WRITE(*,*) + & 'Internal error 1 in ZMUMPS_817' + CALL MUMPS_ABORT() + ENDIF + ENDIF + NB_SON(STEP_LOAD(INODE))= + & NB_SON(STEP_LOAD(INODE))-1 + IF(NB_SON(STEP_LOAD(INODE)).EQ.0)THEN + POOL_NIV2(POOL_SIZE+1)=INODE + POOL_NIV2_COST(POOL_SIZE+1)= + & ZMUMPS_542(INODE) + POOL_SIZE=POOL_SIZE+1 + MAX_M2=POOL_NIV2_COST(POOL_SIZE) + ID_MAX_M2=POOL_NIV2(POOL_SIZE) + CALL ZMUMPS_515(REMOVE_NODE_FLAG, + & POOL_NIV2_COST(POOL_SIZE), + & COMM_LD) + NIV2(MYID+1)=POOL_NIV2_COST(POOL_SIZE)+NIV2(MYID+1) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_817 + DOUBLE PRECISION FUNCTION ZMUMPS_542(INODE) + INTEGER INODE + INTEGER NFRONT,NELIM,i,LEVEL + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + DOUBLE PRECISION COST + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + NFRONT = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253) + LEVEL = MUMPS_330( PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS ) + COST=dble(0) + CALL MUMPS_511(NFRONT,NELIM,NELIM, + & KEEP_LOAD(50),LEVEL,COST) + ZMUMPS_542=COST + RETURN + END FUNCTION ZMUMPS_542 + INTEGER FUNCTION ZMUMPS_541( INODE ) + IMPLICIT NONE + INTEGER INODE,NELIM,NFR,SON,IN,i + INTEGER COST_CB + COST_CB=0 + i = INODE + 10 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 10 + ENDIF + SON=-i + DO i=1, NE_LOAD(STEP_LOAD(INODE)) + NFR = ND_LOAD( STEP_LOAD(SON) ) + KEEP_LOAD(253) + IN=SON + NELIM = 0 + 20 CONTINUE + IF ( IN > 0 ) THEN + NELIM = NELIM + 1 + IN = FILS_LOAD(IN) + GOTO 20 + ENDIF + COST_CB=COST_CB+((NFR-NELIM)*(NFR-NELIM)) + SON=FRERE_LOAD(STEP_LOAD(SON)) + ENDDO + ZMUMPS_541=COST_CB + RETURN + END FUNCTION ZMUMPS_541 + SUBROUTINE ZMUMPS_533(SLAVEF,NMB_OF_CAND, + & TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, + & NSLAVES,INODE) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER, INTENT (IN) :: SLAVEF, NASS, NSLAVES + INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2) + INTEGER, intent(in) :: NMB_OF_CAND + INTEGER, INTENT (IN) :: LIST_SLAVES( NMB_OF_CAND ) + INTEGER KEEP(500),INODE + INTEGER(8) KEEP8(150) + INTEGER allocok + DOUBLE PRECISION MEM_COST,FCT_COST + DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE ::EMPTY_ARRAY, + & DELTA_MD,EMPTY_ARRAY2 + INTEGER NBROWS_SLAVE,i,WHAT,IERR,NPROCS_LOC + LOGICAL FORCE_CAND + MEM_COST=dble(0) + FCT_COST=dble(0) + IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN + FORCE_CAND = .FALSE. + NPROCS_LOC=SLAVEF-1 + ELSE + FORCE_CAND = (mod(KEEP(24),2).eq.0) + NPROCS_LOC=NMB_OF_CAND + END IF + IF(FORCE_CAND)THEN + CALL ZMUMPS_540(INODE,FCT_COST, + & MEM_COST,NPROCS_LOC,NASS) + ELSE + CALL ZMUMPS_540(INODE,FCT_COST, + & MEM_COST,SLAVEF-1,NASS) + ENDIF + DO i=1,SLAVEF + IDWLOAD(i)=i-1 + ENDDO + ALLOCATE(EMPTY_ARRAY(NPROCS_LOC),DELTA_MD(NPROCS_LOC), + & EMPTY_ARRAY2(NPROCS_LOC), + & stat=allocok) + DO i = 1, NSLAVES + NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i) + DELTA_MD( i ) = FCT_COST - dble(NBROWS_SLAVE)* + & dble(NASS) + END DO + IF(FORCE_CAND)THEN + DO i=NSLAVES+1,NPROCS_LOC + DELTA_MD( i ) = FCT_COST + ENDDO + ELSE + DO i=NSLAVES+1,SLAVEF-1 + DELTA_MD( i ) = FCT_COST + ENDDO + ENDIF + WHAT=7 + 111 CONTINUE + CALL ZMUMPS_524(.FALSE., COMM_LD, MYID, SLAVEF, +#if ! defined(OLD_LOAD_MECHANISM) + & FUTURE_NIV2, +#endif + & NPROCS_LOC, LIST_SLAVES,0, + & EMPTY_ARRAY, + & DELTA_MD,EMPTY_ARRAY2,WHAT, IERR) + IF ( IERR == -1 ) THEN + CALL ZMUMPS_467(COMM_LD, KEEP) + GOTO 111 + ELSE IF ( IERR .NE. 0 ) THEN + WRITE(*,*) "Internal Error in ZMUMPS_533", + & IERR + CALL MUMPS_ABORT() + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (FUTURE_NIV2(MYID+1) .NE. 0) THEN +#endif + DO i = 1, NSLAVES + MD_MEM(LIST_SLAVES(i))=MD_MEM(LIST_SLAVES(i))+ + & int(DELTA_MD( i ),8) +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(LIST_SLAVES(i)+1).EQ.0)THEN + MD_MEM(LIST_SLAVES(i))=999999999_8 + ENDIF +#endif + ENDDO +#if ! defined(OLD_LOAD_MECHANISM) + ENDIF +#endif + DEALLOCATE(EMPTY_ARRAY) + DEALLOCATE(DELTA_MD) + END SUBROUTINE ZMUMPS_533 + SUBROUTINE ZMUMPS_540(INODE,FCT_COST, + & MEM_COST,NSLAVES,NELIM) + IMPLICIT NONE + INTEGER INODE,NSLAVES,NFR,NELIM,IN + DOUBLE PRECISION MEM_COST,FCT_COST + NFR=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253) + IN = INODE + FCT_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)* + & dble(NELIM) + MEM_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)* + & dble(NFR) + END SUBROUTINE ZMUMPS_540 + SUBROUTINE ZMUMPS_819(INODE) + IMPLICIT NONE + INTEGER INODE + INTEGER i,J,SON,NSLAVES_TEMP,POS_TEMP,K + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + IF((INODE.LT.0).OR.(INODE.GT.N_LOAD))THEN + RETURN + ENDIF + IF(POS_ID.GT.1)THEN + i=INODE + 10 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 10 + ENDIF + SON=-i + IF(POS_ID.LT.NE_LOAD(STEP_LOAD(INODE))*3)THEN + i=1 + ENDIF + DO i=1, NE_LOAD(STEP_LOAD(INODE)) + J=1 + DO WHILE (J.LT.POS_ID) + IF(CB_COST_ID(J).EQ.SON)GOTO 295 + J=J+3 + ENDDO + 295 CONTINUE + IF(J.GE.POS_ID)THEN + IF(MUMPS_275( + & PROCNODE_LOAD(STEP_LOAD(INODE)),NPROCS).EQ.MYID)THEN + IF(INODE.EQ.KEEP_LOAD(38))THEN + GOTO 666 +#if ! defined(OLD_LOAD_MECHANISM) + ELSE + IF(FUTURE_NIV2(MYID+1).NE.0)THEN + WRITE(*,*)MYID,': i did not find ',SON + CALL MUMPS_ABORT() + ENDIF + GOTO 666 +#endif + ENDIF + ELSE + GOTO 666 + ENDIF + ENDIF + NSLAVES_TEMP=CB_COST_ID(J+1) + POS_TEMP=CB_COST_ID(J+2) + DO K=J,POS_ID-1 + CB_COST_ID(K)=CB_COST_ID(K+3) + ENDDO + K=POS_TEMP + DO WHILE (K.LE.POS_MEM-1) + CB_COST_MEM(K)=CB_COST_MEM(K+2*NSLAVES_TEMP) + K=K+1 + ENDDO + POS_MEM=POS_MEM-2*NSLAVES_TEMP + POS_ID=POS_ID-3 + IF((POS_MEM.LT.1).OR.(POS_ID.LT.1))THEN + WRITE(*,*)MYID,': negative pos_mem or pos_id' + CALL MUMPS_ABORT() + ENDIF + 666 CONTINUE + SON=FRERE_LOAD(STEP_LOAD(SON)) + ENDDO + ENDIF + END SUBROUTINE ZMUMPS_819 + SUBROUTINE ZMUMPS_820(FLAG) + IMPLICIT NONE + LOGICAL FLAG + INTEGER i + DOUBLE PRECISION MEM + FLAG=.FALSE. + DO i=0,NPROCS-1 + MEM=DM_MEM(i)+LU_USAGE(i) + IF(BDC_SBTR)THEN + MEM=MEM+SBTR_MEM(i)-SBTR_CUR(i) + ENDIF + IF((MEM/dble(TAB_MAXS(i))).GT.0.8d0)THEN + FLAG=.TRUE. + GOTO 666 + ENDIF + ENDDO + 666 CONTINUE + END SUBROUTINE ZMUMPS_820 + SUBROUTINE ZMUMPS_554(NBINSUBTREE,INSUBTREE,NBTOP, + & MIN_COST,SBTR) + IMPLICIT NONE + INTEGER NBINSUBTREE,INSUBTREE,NBTOP + DOUBLE PRECISION MIN_COST + LOGICAL SBTR + INTEGER i + DOUBLE PRECISION TMP_COST,TMP_MIN + TMP_MIN=huge(TMP_MIN) + DO i=0,NPROCS-1 + IF(i.NE.MYID)THEN + IF(BDC_SBTR)THEN + TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))-(DM_MEM(i)+ + & LU_USAGE(i))-(SBTR_MEM(i)-SBTR_CUR(i))) + ELSE + TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))- + & (DM_MEM(i)+LU_USAGE(i))) + ENDIF + ENDIF + ENDDO + IF(NBINSUBTREE.GT.0)THEN + IF(INSUBTREE.EQ.1)THEN + TMP_COST=dble(TAB_MAXS(MYID))-(DM_MEM(MYID)+ + & LU_USAGE(MYID)) + & -(SBTR_MEM(MYID)-SBTR_CUR(MYID)) + ELSE + SBTR=.FALSE. + GOTO 777 + ENDIF + ENDIF + TMP_MIN=min(TMP_COST,TMP_MIN) + IF(TMP_MIN.GT.MIN_COST) SBTR=.TRUE. + 777 CONTINUE + END SUBROUTINE ZMUMPS_554 + SUBROUTINE ZMUMPS_818(INODE,MAX_MEM,PROC) + IMPLICIT NONE + INTEGER INODE,PROC + INTEGER i,POS,NSLAVES,SLAVE,NCAND,J,NELIM,NCB,NFRONT,SON,K + INTEGER allocok + EXTERNAL MUMPS_330 + INTEGER MUMPS_330 + DOUBLE PRECISION MAX_MEM + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: MEM_ON_PROCS, + & RECV_BUF + LOGICAL, DIMENSION(:), ALLOCATABLE :: CONCERNED + DOUBLE PRECISION MAX_SENT_MSG +#if defined(NOT_ATM_POOL_SPECIAL) + DOUBLE PRECISION TMP +#endif + IF((FRERE_LOAD(STEP_LOAD(INODE)).EQ.0) + & .AND.(INODE.EQ.KEEP_LOAD(38)))THEN + RETURN + ENDIF +#if defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.LT.0).OR.(INODE.GT.N_LOAD))THEN + MAX_MEM=huge(MAX_MEM) + DO i=0,NPROCS-1 + TMP=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i)) + IF(BDC_SBTR)THEN + TMP=TMP-(SBTR_MEM(i)-SBTR_CUR(i)) + ENDIF + MAX_MEM=min(MAX_MEM,TMP) + ENDDO + RETURN + ENDIF +#endif + ALLOCATE( MEM_ON_PROCS(0:NPROCS-1), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_818' + CALL MUMPS_ABORT() + ENDIF + ALLOCATE( CONCERNED(0:NPROCS-1), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_818' + CALL MUMPS_ABORT() + ENDIF + ALLOCATE( RECV_BUF(0:NPROCS-1), stat=allocok) + IF ( allocok > 0 ) THEN + WRITE(*,*) 'PB allocation in ZMUMPS_818' + CALL MUMPS_ABORT() + ENDIF + RECV_BUF=dble(0) + MAX_SENT_MSG=dble(0) + i = INODE + NELIM = 0 + 10 CONTINUE + IF ( i > 0 ) THEN + NELIM = NELIM + 1 + i = FILS_LOAD(i) + GOTO 10 + ENDIF + SON=-i + NFRONT=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253) + NCB=NFRONT-NELIM + IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), + & NPROCS).EQ.2)THEN + NCAND=CAND_LOAD(NPROCS+1, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE))) + ENDIF + DO i=0,NPROCS-1 + IF(i.EQ.MYID)THEN + MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+ + & LU_USAGE(i)+ + & ZMUMPS_543(INODE)) + IF(BDC_SBTR)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i)) + ENDIF + CONCERNED(i)=.TRUE. + ELSE + MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i)) + IF(BDC_SBTR)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i)) + ENDIF + IF(BDC_M2_MEM)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-NIV2(i+1) + ENDIF + ENDIF + IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)), + & NPROCS).EQ.2)THEN + IF(BDC_MD.AND.(KEEP_LOAD(48).EQ.5))THEN + DO J=1,NCAND + IF(CAND_LOAD(J, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE))) + & .EQ.i)THEN + MEM_ON_PROCS(i)=MEM_ON_PROCS(i)- + & ((dble(NFRONT)*dble(NCB))/dble(NCAND)) + CONCERNED(i)=.TRUE. + GOTO 666 + ENDIF + ENDDO + ENDIF + ENDIF + 666 CONTINUE + ENDDO + DO K=1, NE_LOAD(STEP_LOAD(INODE)) + i=1 + DO WHILE (i.LE.POS_ID) + IF(CB_COST_ID(i).EQ.SON)GOTO 295 + i=i+3 + ENDDO + 295 CONTINUE + IF(i.GE.POS_ID)THEN +#if ! defined(OLD_LOAD_MECHANISM) + IF(FUTURE_NIV2(MYID+1).NE.0)THEN + WRITE(*,*)MYID,': ',SON,'has not been found + & in ZMUMPS_818' + CALL MUMPS_ABORT() + ENDIF +#endif + GOTO 777 + ENDIF + NSLAVES=CB_COST_ID(i+1) + POS=CB_COST_ID(i+2) + DO i=1,NSLAVES + SLAVE=int(CB_COST_MEM(POS)) + IF(.NOT.CONCERNED(SLAVE))THEN + MEM_ON_PROCS(SLAVE)=MEM_ON_PROCS(SLAVE)+ + & dble(CB_COST_MEM(POS+1)) + ENDIF + DO J=0,NPROCS-1 + IF(CONCERNED(J))THEN + IF(SLAVE.NE.J)THEN + RECV_BUF(J)=max(RECV_BUF(J), + & dble(CB_COST_MEM(POS+1))) + ENDIF + ENDIF + ENDDO + POS=POS+2 + ENDDO + 777 CONTINUE + SON=FRERE_LOAD(STEP_LOAD(SON)) + ENDDO + MAX_MEM=huge(MAX_MEM) + WRITE(*,*)'NPROCS=',NPROCS,MAX_MEM + DO i=0,NPROCS-1 + IF(MAX_MEM.GT.MEM_ON_PROCS(i))THEN + PROC=i + ENDIF + MAX_MEM=min(MEM_ON_PROCS(i),MAX_MEM) + ENDDO + DEALLOCATE(MEM_ON_PROCS) + DEALLOCATE(CONCERNED) + DEALLOCATE(RECV_BUF) + END SUBROUTINE ZMUMPS_818 + SUBROUTINE ZMUMPS_553(MIN_PROC,POOL, + & LPOOL,INODE) + IMPLICIT NONE + INTEGER INODE,LPOOL,MIN_PROC + INTEGER POOL(LPOOL) + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + INTEGER i,NBTOP,INSUBTREE,NBINSUBTREE,NODE,FATHER,SON,J + INTEGER SBTR_NB_LEAF,POS,K,allocok,L + INTEGER, ALLOCATABLE, DIMENSION (:) :: TMP_SBTR + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + IF((KEEP_LOAD(47).EQ.4).AND. + & ((NBINSUBTREE.NE.0)))THEN + DO J=INDICE_SBTR,NB_SUBTREES + NODE=MY_ROOT_SBTR(J) + FATHER=DAD_LOAD(STEP_LOAD(NODE)) + i=FATHER + 110 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 110 + ENDIF + SON=-i + i=SON + 120 CONTINUE + IF ( i > 0 ) THEN + IF(MUMPS_275(PROCNODE_LOAD(STEP_LOAD(i)),NPROCS).EQ. + & MIN_PROC)THEN + SBTR_NB_LEAF=MY_NB_LEAF(J) + POS=SBTR_FIRST_POS_IN_POOL(J) + IF(POOL(POS+SBTR_NB_LEAF).NE.MY_FIRST_LEAF(J))THEN + WRITE(*,*)MYID,': The first leaf is not ok' + CALL MUMPS_ABORT() + ENDIF + ALLOCATE (TMP_SBTR(SBTR_NB_LEAF), stat=allocok) + IF (allocok > 0 ) THEN + WRITE(*,*)MYID,': Not enough space + & for allocation' + CALL MUMPS_ABORT() + ENDIF + POS=SBTR_FIRST_POS_IN_POOL(J) + DO K=1,SBTR_NB_LEAF + TMP_SBTR(K)=POOL(POS+K-1) + ENDDO + DO K=POS+1,NBINSUBTREE-SBTR_NB_LEAF + POOL(K)=POOL(K+SBTR_NB_LEAF) + ENDDO + POS=1 + DO K=NBINSUBTREE-SBTR_NB_LEAF+1,NBINSUBTREE + POOL(K)=TMP_SBTR(POS) + POS=POS+1 + ENDDO + DO K=INDICE_SBTR,J + SBTR_FIRST_POS_IN_POOL(K)=SBTR_FIRST_POS_IN_POOL(K) + & -SBTR_FIRST_POS_IN_POOL(J) + ENDDO + SBTR_FIRST_POS_IN_POOL(J)=NBINSUBTREE-SBTR_NB_LEAF + POS=MY_FIRST_LEAF(J) + L=MY_NB_LEAF(J) + DO K=INDICE_SBTR,J + MY_FIRST_LEAF(J)=MY_FIRST_LEAF(J+1) + MY_NB_LEAF(J)=MY_NB_LEAF(J+1) + ENDDO + MY_FIRST_LEAF(INDICE_SBTR)=POS + MY_NB_LEAF(INDICE_SBTR)=L + INODE=POOL(NBINSUBTREE) + DEALLOCATE(TMP_SBTR) + RETURN + ENDIF + i = FRERE_LOAD(STEP_LOAD(i)) + GOTO 120 + ENDIF + ENDDO + ENDIF + DO J=NBTOP,1,-1 +#if defined(NOT_ATM_POOL_SPECIAL) + IF ( POOL(LPOOL-2-J) < 0 ) THEN + NODE=-POOL(LPOOL-2-J) + ELSE IF ( POOL(LPOOL-2-J) > N_LOAD ) THEN + NODE = POOL(LPOOL-2-J) - N_LOAD + ELSE + NODE = POOL(LPOOL-2-J) + ENDIF +#else + NODE=POOL(LPOOL-2-J) +#endif + FATHER=DAD_LOAD(STEP_LOAD(NODE)) + i=FATHER + 11 CONTINUE + IF ( i > 0 ) THEN + i = FILS_LOAD(i) + GOTO 11 + ENDIF + SON=-i + i=SON + 12 CONTINUE + IF ( i > 0 ) THEN + IF(MUMPS_275(PROCNODE_LOAD(STEP_LOAD(i)),NPROCS).EQ. + & MIN_PROC)THEN + INODE=NODE + RETURN + ENDIF + i = FRERE_LOAD(STEP_LOAD(i)) + GOTO 12 + ENDIF + ENDDO + END SUBROUTINE ZMUMPS_553 + SUBROUTINE ZMUMPS_555(POOL, LPOOL,KEEP,KEEP8) + IMPLICIT NONE + INTEGER LPOOL,POOL(LPOOL),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER i,POS + EXTERNAL MUMPS_283 + LOGICAL MUMPS_283 + IF(.NOT.BDC_SBTR) RETURN + POS=0 + DO i=NB_SUBTREES,1,-1 + DO WHILE(MUMPS_283( + & PROCNODE_LOAD(STEP_LOAD(POOL(POS+1))), + & NPROCS)) + POS=POS+1 + ENDDO + SBTR_FIRST_POS_IN_POOL(i)=POS+1 + POS=POS+MY_NB_LEAF(i) + ENDDO + END SUBROUTINE ZMUMPS_555 + END MODULE ZMUMPS_LOAD diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_ooc.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_ooc.F new file mode 100644 index 000000000..3b54f7c39 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_ooc.F @@ -0,0 +1,3501 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE ZMUMPS_OOC + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NOT_IN_MEM,BEING_READ,NOT_USED,PERMUTED,USED, + & USED_NOT_PERMUTED,ALREADY_USED + PARAMETER (NOT_IN_MEM=0,BEING_READ=-1,NOT_USED=-2, + & PERMUTED=-3,USED=-4,USED_NOT_PERMUTED=-5,ALREADY_USED=-6) + INTEGER OOC_NODE_NOT_IN_MEM,OOC_NODE_PERMUTED, + & OOC_NODE_NOT_PERMUTED + PARAMETER (OOC_NODE_NOT_IN_MEM=-20, + & OOC_NODE_PERMUTED=-21,OOC_NODE_NOT_PERMUTED=-22) + INTEGER(8), DIMENSION(:,:),POINTER :: SIZE_OF_BLOCK + INTEGER, DIMENSION(:),POINTER :: TOTAL_NB_OOC_NODES + INTEGER :: OOC_SOLVE_TYPE_FCT + INTEGER, DIMENSION(:),ALLOCATABLE :: IO_REQ + INTEGER(8), DIMENSION(:), ALLOCATABLE:: LRLUS_SOLVE + INTEGER(8), DIMENSION(:), ALLOCATABLE:: SIZE_SOLVE_Z, + & LRLU_SOLVE_T, POSFAC_SOLVE, IDEB_SOLVE_Z, LRLU_SOLVE_B + INTEGER, DIMENSION(:),ALLOCATABLE :: PDEB_SOLVE_Z + INTEGER (8),SAVE :: FACT_AREA_SIZE, + & SIZE_ZONE_SOLVE,SIZE_SOLVE_EMM,TMP_SIZE_FACT, + & MAX_SIZE_FACTOR_OOC + INTEGER(8), SAVE :: MIN_SIZE_READ + INTEGER, SAVE :: TMP_NB_NODES, MAX_NB_NODES_FOR_ZONE,MAX_NB_REQ, + & CURRENT_SOLVE_READ_ZONE, + & CUR_POS_SEQUENCE,NB_Z,SOLVE_STEP, + & NB_ZONE_REQ,MTYPE_OOC,NB_ACT +#if defined (NEW_PREF_SCHEME) + INTEGER,SAVE :: MAX_PREF_SIZE +#endif + & ,NB_CALLED,REQ_ACT,NB_CALL + INTEGER(8), SAVE :: OOC_VADDR_PTR + INTEGER(8), SAVE :: SIZE_ZONE_REQ + DOUBLE PRECISION,SAVE :: MAX_OOC_FILE_SIZE + INTEGER(8), DIMENSION(:), ALLOCATABLE :: SIZE_OF_READ, READ_DEST + INTEGER,DIMENSION(:),ALLOCATABLE :: FIRST_POS_IN_READ, + & READ_MNG,REQ_TO_ZONE,POS_HOLE_T, + & POS_HOLE_B,REQ_ID,OOC_STATE_NODE + INTEGER ZMUMPS_ELEMENTARY_DATA_SIZE,N_OOC + INTEGER, DIMENSION(:), ALLOCATABLE :: POS_IN_MEM, INODE_TO_POS + INTEGER, DIMENSION(:), ALLOCATABLE :: CURRENT_POS_T,CURRENT_POS_B + LOGICAL IS_ROOT_SPECIAL + INTEGER SPECIAL_ROOT_NODE + PUBLIC :: ZMUMPS_575,ZMUMPS_576, + & ZMUMPS_577, + & ZMUMPS_578, + & ZMUMPS_579, + & ZMUMPS_582, + & ZMUMPS_583,ZMUMPS_584, + & ZMUMPS_585,ZMUMPS_586 + INTEGER, PARAMETER, PUBLIC :: TYPEF_BOTH_LU = -99976 + PUBLIC ZMUMPS_688, + & ZMUMPS_690 + PRIVATE ZMUMPS_695, + & ZMUMPS_697 + CONTAINS + SUBROUTINE ZMUMPS_711( STRAT_IO_ARG, + & STRAT_IO_ASYNC_ARG, WITH_BUF_ARG, LOW_LEVEL_STRAT_IO_ARG ) + IMPLICIT NONE + INTEGER, intent(out) :: LOW_LEVEL_STRAT_IO_ARG + LOGICAL, intent(out) :: STRAT_IO_ASYNC_ARG, WITH_BUF_ARG + INTEGER, intent(in) :: STRAT_IO_ARG + INTEGER TMP + CALL MUMPS_OOC_IS_ASYNC_AVAIL(TMP) + STRAT_IO_ASYNC_ARG=.FALSE. + WITH_BUF_ARG=.FALSE. + IF(TMP.EQ.1)THEN + IF((STRAT_IO_ARG.EQ.1).OR.(STRAT_IO_ARG.EQ.2))THEN + STRAT_IO_ASYNC=.TRUE. + WITH_BUF=.FALSE. + ELSEIF((STRAT_IO_ARG.EQ.4).OR.(STRAT_IO_ARG.EQ.5))THEN + STRAT_IO_ASYNC_ARG=.TRUE. + WITH_BUF_ARG=.TRUE. + ELSEIF(STRAT_IO_ARG.EQ.3)THEN + STRAT_IO_ASYNC_ARG=.FALSE. + WITH_BUF_ARG=.TRUE. + ENDIF + LOW_LEVEL_STRAT_IO_ARG=mod(STRAT_IO_ARG,3) + ELSE + LOW_LEVEL_STRAT_IO_ARG=0 + IF(STRAT_IO_ARG.GE.3)THEN + WITH_BUF_ARG=.TRUE. + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_711 + FUNCTION ZMUMPS_579(INODE,ZONE) + IMPLICIT NONE + INTEGER INODE,ZONE + LOGICAL ZMUMPS_579 + ZMUMPS_579=(LRLUS_SOLVE(ZONE).GE. + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) + RETURN + END FUNCTION ZMUMPS_579 + SUBROUTINE ZMUMPS_590(LA) + IMPLICIT NONE + INTEGER(8) :: LA + FACT_AREA_SIZE=LA + END SUBROUTINE ZMUMPS_590 + SUBROUTINE ZMUMPS_575(id, MAXS) + USE ZMUMPS_STRUC_DEF + USE ZMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER TMPDIR_MAX_LENGTH, PREFIX_MAX_LENGTH + PARAMETER (TMPDIR_MAX_LENGTH=255, PREFIX_MAX_LENGTH=63) + INTEGER(8), intent(in) :: MAXS + TYPE(ZMUMPS_STRUC), TARGET :: id + INTEGER IERR + INTEGER allocok + INTEGER ASYNC + CHARACTER*1 TMP_DIR(TMPDIR_MAX_LENGTH), + & TMP_PREFIX(PREFIX_MAX_LENGTH) + INTEGER DIM_DIR,DIM_PREFIX + INTEGER, DIMENSION(:), ALLOCATABLE :: FILE_FLAG_TAB + INTEGER TMP + INTEGER K211_LOC + ICNTL1=id%ICNTL(1) + MAX_SIZE_FACTOR_OOC=0_8 + N_OOC=id%N + ASYNC=0 + SOLVE=.FALSE. + IERR=0 + IF(allocated(IO_REQ))THEN + DEALLOCATE(IO_REQ) + ENDIF + IF(associated(KEEP_OOC))THEN + NULLIFY(KEEP_OOC) + ENDIF + IF(associated(STEP_OOC))THEN + NULLIFY(STEP_OOC) + ENDIF + IF(associated(PROCNODE_OOC))THEN + NULLIFY(PROCNODE_OOC) + ENDIF + IF(associated(OOC_INODE_SEQUENCE))THEN + NULLIFY(OOC_INODE_SEQUENCE) + ENDIF + IF(associated(TOTAL_NB_OOC_NODES))THEN + NULLIFY(TOTAL_NB_OOC_NODES) + ENDIF + IF(associated(SIZE_OF_BLOCK))THEN + NULLIFY(SIZE_OF_BLOCK) + ENDIF + IF(associated(OOC_VADDR))THEN + NULLIFY(OOC_VADDR) + ENDIF + IF(allocated(I_CUR_HBUF_NEXTPOS))THEN + DEALLOCATE(I_CUR_HBUF_NEXTPOS) + ENDIF + CALL ZMUMPS_588(id,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 > 0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1) = IERR + id%INFO(2) = 0 + RETURN + ENDIF + CALL MUMPS_796(TYPEF_L, TYPEF_U, TYPEF_CB, + & id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID ) + IF (id%KEEP(201).EQ.2) THEN + OOC_FCT_TYPE=1 + ENDIF + STEP_OOC=>id%STEP + PROCNODE_OOC=>id%PROCNODE_STEPS + MYID_OOC=id%MYID + SLAVEF_OOC=id%NSLAVES + KEEP_OOC => id%KEEP + SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK + OOC_VADDR=>id%OOC_VADDR + IF(id%KEEP(107).GT.0)THEN + SIZE_SOLVE_EMM=max(id%KEEP8(19),int(dble(MAXS)* + & 0.9d0*0.2d0,8)) + SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM, + & int((dble(MAXS)*0.9d0- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)) + IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN + SIZE_SOLVE_EMM=id%KEEP8(19) + SIZE_ZONE_SOLVE=int((dble(MAXS)*0.9d0- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8) + ENDIF + ELSE + SIZE_ZONE_SOLVE=int(dble(MAXS)*0.9d0,8) + SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE + ENDIF + ZMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35) + SIZE_OF_BLOCK=0_8 + ALLOCATE(id%OOC_NB_FILES(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + id%OOC_NB_FILES=0 + OOC_VADDR_PTR=0_8 + CALL ZMUMPS_711( id%KEEP(99), STRAT_IO_ASYNC, + & WITH_BUF, LOW_LEVEL_STRAT_IO ) + TMP_SIZE_FACT=0_8 + TMP_NB_NODES=0 + MAX_NB_NODES_FOR_ZONE=0 + OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE + ALLOCATE(I_CUR_HBUF_NEXTPOS(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + I_CUR_HBUF_NEXTPOS = 1 + IF(WITH_BUF)THEN + CALL ZMUMPS_669(id%INFO(1),id%INFO(2),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + IF(STRAT_IO_ASYNC)THEN + ASYNC=1 + ENDIF + DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN + CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC) + DIM_DIR=len(trim(id%OOC_TMPDIR)) + DIM_PREFIX=len(trim(id%OOC_PREFIX)) + CALL ZMUMPS_589(TMP_DIR(1), + & id%OOC_TMPDIR, TMPDIR_MAX_LENGTH, DIM_DIR ) + CALL ZMUMPS_589(TMP_PREFIX(1), + & id%OOC_PREFIX, PREFIX_MAX_LENGTH, DIM_PREFIX) + CALL MUMPS_LOW_LEVEL_INIT_PREFIX(DIM_PREFIX, TMP_PREFIX) + CALL MUMPS_LOW_LEVEL_INIT_TMPDIR(DIM_DIR, TMP_DIR) + ALLOCATE(FILE_FLAG_TAB(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1 .GT. 0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + FILE_FLAG_TAB(1:OOC_NB_FILE_TYPE)=0 + IERR=0 + TMP=int(id%KEEP8(11)/1000000_8,kind=4)+1 + IF((id%KEEP(201).EQ.1).AND.(id%KEEP(50).EQ.0) + & ) THEN + TMP=max(1,TMP/2) + ENDIF + CALL MUMPS_LOW_LEVEL_INIT_OOC_C(MYID_OOC,TMP, + & id%KEEP(35),LOW_LEVEL_STRAT_IO,K211_LOC,OOC_NB_FILE_TYPE, + & FILE_FLAG_TAB,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0 ) THEN + WRITE(ICNTL1,*)MYID_OOC,': PB in MUMPS_LOW_LEVEL_INIT_OOC_C' + WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + ENDIF + id%INFO(1) = IERR + id%INFO(2) = 0 + RETURN + ENDIF + CALL MUMPS_GET_MAX_FILE_SIZE_C(MAX_OOC_FILE_SIZE) + DEALLOCATE(FILE_FLAG_TAB) + RETURN + END SUBROUTINE ZMUMPS_575 + SUBROUTINE ZMUMPS_576(INODE,PTRFAC,KEEP,KEEP8, + & A,LA,SIZE,IERR) + USE ZMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER(8) :: LA + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)), SIZE + COMPLEX(kind=8) A(LA) + INTEGER IERR,NODE,ASYNC,REQUEST + LOGICAL IO_C + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER TYPE + INTEGER SIZE_INT1,SIZE_INT2 + TYPE=FCT + IF(STRAT_IO_ASYNC)THEN + ASYNC=1 + ELSE + ASYNC=0 + ENDIF + IERR=0 + IO_C=.TRUE. + SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)=SIZE + MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,SIZE) + OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)=OOC_VADDR_PTR + OOC_VADDR_PTR=OOC_VADDR_PTR+SIZE + TMP_SIZE_FACT=TMP_SIZE_FACT+SIZE + TMP_NB_NODES=TMP_NB_NODES+1 + IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN + MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE,TMP_NB_NODES) + TMP_SIZE_FACT=0_8 + TMP_NB_NODES=0 + ENDIF + IF (.NOT. WITH_BUF) THEN + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, + & A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN + WRITE(*,*)MYID_OOC,': Internal error (37) in OOC ' + CALL MUMPS_ABORT() + ENDIF + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), + & OOC_FCT_TYPE)=INODE + I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)= + & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1 + ELSE + IF(SIZE.LE.HBUF_SIZE)THEN + CALL ZMUMPS_678 + & (A(PTRFAC(STEP_OOC(INODE))),SIZE,IERR) + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), + & OOC_FCT_TYPE) = INODE + I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) = + & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) + 1 +#if ! defined (OOC_DEBUG) + PTRFAC(STEP_OOC(INODE))=-777777_8 +#endif + RETURN + ELSE + CALL ZMUMPS_707(OOC_FCT_TYPE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL ZMUMPS_707(OOC_FCT_TYPE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, + & A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(*,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN + WRITE(*,*)MYID_OOC,': Internal error (38) in OOC ' + CALL MUMPS_ABORT() + ENDIF + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), + & OOC_FCT_TYPE)=INODE + I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)= + & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1 + CALL ZMUMPS_689(OOC_FCT_TYPE) + ENDIF + END IF + NODE=-9999 +#if ! defined (OOC_DEBUG) + PTRFAC(STEP_OOC(INODE))=-777777_8 +#endif + IF(STRAT_IO_ASYNC)THEN + IERR=0 + CALL MUMPS_WAIT_REQUEST(REQUEST,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_576 + SUBROUTINE ZMUMPS_577(DEST,INODE,IERR + & ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR,INODE + COMPLEX(kind=8) DEST + INTEGER ASYNC + LOGICAL IO_C +#if defined(OLD_READ) + INTEGER REQUEST +#endif + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER TYPE + INTEGER SIZE_INT1,SIZE_INT2 + TYPE=OOC_SOLVE_TYPE_FCT + IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + & .EQ.0_8)THEN + GOTO 555 + ENDIF + IF(STRAT_IO_ASYNC)THEN + ASYNC=1 + ELSE + ASYNC=0 + ENDIF + IERR=0 + IO_C=.TRUE. +#if ! defined(OLD_READ) + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_LOW_LEVEL_DIRECT_READ(DEST, + & SIZE_INT1,SIZE_INT2, + & TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) THEN + WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + WRITE(ICNTL1,*)MYID_OOC, + & ': Problem in MUMPS_LOW_LEVEL_DIRECT_READ' + ENDIF + RETURN + ENDIF +#else + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO, + & DEST,SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0 ) THEN + WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + WRITE(ICNTL1,*)MYID_OOC, + & ': Problem in MUMPS_LOW_LEVEL_READ_OOC' + ENDIF + RETURN + ENDIF + IF(STRAT_IO_ASYNC)THEN + IERR=0 + CALL MUMPS_WAIT_REQUEST(REQUEST,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0 ) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + ENDIF +#endif + 555 CONTINUE + IF(.NOT.ZMUMPS_727())THEN + IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ. + & INODE)THEN + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ELSEIF(SOLVE_STEP.EQ.1)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + CALL ZMUMPS_728() + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_577 + SUBROUTINE ZMUMPS_591(IERR) + USE ZMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, intent(out):: IERR + IERR=0 + IF (WITH_BUF) THEN + CALL ZMUMPS_675(IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + END IF + RETURN + END SUBROUTINE ZMUMPS_591 + SUBROUTINE ZMUMPS_592(id,IERR) + USE ZMUMPS_OOC_BUFFER + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(ZMUMPS_STRUC), TARGET :: id + INTEGER, intent(out) :: IERR + INTEGER I,SOLVE_OR_FACTO + IERR=0 + IF(WITH_BUF)THEN + CALL ZMUMPS_659() + ENDIF + IF(associated(KEEP_OOC))THEN + NULLIFY(KEEP_OOC) + ENDIF + IF(associated(STEP_OOC))THEN + NULLIFY(STEP_OOC) + ENDIF + IF(associated(PROCNODE_OOC))THEN + NULLIFY(PROCNODE_OOC) + ENDIF + IF(associated(OOC_INODE_SEQUENCE))THEN + NULLIFY(OOC_INODE_SEQUENCE) + ENDIF + IF(associated(TOTAL_NB_OOC_NODES))THEN + NULLIFY(TOTAL_NB_OOC_NODES) + ENDIF + IF(associated(SIZE_OF_BLOCK))THEN + NULLIFY(SIZE_OF_BLOCK) + ENDIF + IF(associated(OOC_VADDR))THEN + NULLIFY(OOC_VADDR) + ENDIF + CALL MUMPS_OOC_END_WRITE_C(IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1 .GT. 0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + GOTO 500 + ENDIF + id%OOC_MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE, + & TMP_NB_NODES) + IF(allocated(I_CUR_HBUF_NEXTPOS))THEN + DO I=1,OOC_NB_FILE_TYPE + id%OOC_TOTAL_NB_NODES(I)=I_CUR_HBUF_NEXTPOS(I)-1 + ENDDO + DEALLOCATE(I_CUR_HBUF_NEXTPOS) + ENDIF + id%KEEP8(20)=MAX_SIZE_FACTOR_OOC + CALL ZMUMPS_613(id,IERR) + IF(IERR.LT.0)THEN + GOTO 500 + ENDIF + 500 CONTINUE + SOLVE_OR_FACTO=0 + CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + RETURN + END SUBROUTINE ZMUMPS_592 + SUBROUTINE ZMUMPS_588(id,IERR) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + EXTERNAL MUMPS_OOC_REMOVE_FILE_C + TYPE(ZMUMPS_STRUC), TARGET :: id + INTEGER IERR + INTEGER I,J,I1,K + CHARACTER*1 TMP_NAME(350) + IERR=0 + K=1 + IF(associated(id%OOC_FILE_NAMES).AND. + & associated(id%OOC_FILE_NAME_LENGTH))THEN + DO I1=1,OOC_NB_FILE_TYPE + DO I=1,id%OOC_NB_FILES(I1) + DO J=1,id%OOC_FILE_NAME_LENGTH(K) + TMP_NAME(J)=id%OOC_FILE_NAMES(K,J) + ENDDO + CALL MUMPS_OOC_REMOVE_FILE_C(IERR, TMP_NAME(1)) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0)THEN + WRITE(ICNTL1,*)MYID_OOC,': ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + ENDIF + K=K+1 + ENDDO + ENDDO + ENDIF + IF(associated(id%OOC_FILE_NAMES))THEN + DEALLOCATE(id%OOC_FILE_NAMES) + NULLIFY(id%OOC_FILE_NAMES) + ENDIF + IF(associated(id%OOC_FILE_NAME_LENGTH))THEN + DEALLOCATE(id%OOC_FILE_NAME_LENGTH) + NULLIFY(id%OOC_FILE_NAME_LENGTH) + ENDIF + IF(associated(id%OOC_NB_FILES))THEN + DEALLOCATE(id%OOC_NB_FILES) + NULLIFY(id%OOC_NB_FILES) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_588 + SUBROUTINE ZMUMPS_587(id,IERR) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(ZMUMPS_STRUC), TARGET :: id + INTEGER IERR + IERR=0 + CALL ZMUMPS_588(id,IERR) + IF(associated(id%OOC_TOTAL_NB_NODES))THEN + DEALLOCATE(id%OOC_TOTAL_NB_NODES) + NULLIFY(id%OOC_TOTAL_NB_NODES) + ENDIF + IF(associated(id%OOC_INODE_SEQUENCE))THEN + DEALLOCATE(id%OOC_INODE_SEQUENCE) + NULLIFY(id%OOC_INODE_SEQUENCE) + ENDIF + IF(associated(id%OOC_SIZE_OF_BLOCK))THEN + DEALLOCATE(id%OOC_SIZE_OF_BLOCK) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + ENDIF + IF(associated(id%OOC_VADDR))THEN + DEALLOCATE(id%OOC_VADDR) + NULLIFY(id%OOC_VADDR) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_587 + SUBROUTINE ZMUMPS_586(id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(ZMUMPS_STRUC), TARGET :: id + INTEGER TMP,I,J + INTEGER(8) :: TMP_SIZE8 + INTEGER allocok,IERR + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + INTEGER MASTER_ROOT + IERR=0 + ICNTL1=id%ICNTL(1) + SOLVE=.TRUE. + N_OOC=id%N + IF(allocated(LRLUS_SOLVE))THEN + DEALLOCATE(LRLUS_SOLVE) + ENDIF + IF(allocated(LRLU_SOLVE_T))THEN + DEALLOCATE(LRLU_SOLVE_T) + ENDIF + IF(allocated(LRLU_SOLVE_B))THEN + DEALLOCATE(LRLU_SOLVE_B) + ENDIF + IF(allocated(POSFAC_SOLVE))THEN + DEALLOCATE(POSFAC_SOLVE) + ENDIF + IF(allocated(IDEB_SOLVE_Z))THEN + DEALLOCATE(IDEB_SOLVE_Z) + ENDIF + IF(allocated(PDEB_SOLVE_Z))THEN + DEALLOCATE(PDEB_SOLVE_Z) + ENDIF + IF(allocated(SIZE_SOLVE_Z))THEN + DEALLOCATE(SIZE_SOLVE_Z) + ENDIF + IF(allocated(CURRENT_POS_T))THEN + DEALLOCATE(CURRENT_POS_T) + ENDIF + IF(allocated(CURRENT_POS_B))THEN + DEALLOCATE(CURRENT_POS_B) + ENDIF + IF(allocated(POS_HOLE_T))THEN + DEALLOCATE(POS_HOLE_T) + ENDIF + IF(allocated(POS_HOLE_B))THEN + DEALLOCATE(POS_HOLE_B) + ENDIF + IF(allocated(OOC_STATE_NODE))THEN + DEALLOCATE(OOC_STATE_NODE) + ENDIF + IF(allocated(POS_IN_MEM))THEN + DEALLOCATE(POS_IN_MEM) + ENDIF + IF(allocated(INODE_TO_POS))THEN + DEALLOCATE(INODE_TO_POS) + ENDIF + IF(allocated(SIZE_OF_READ))THEN + DEALLOCATE(SIZE_OF_READ) + ENDIF + IF(allocated(FIRST_POS_IN_READ))THEN + DEALLOCATE(FIRST_POS_IN_READ) + ENDIF + IF(allocated(READ_DEST))THEN + DEALLOCATE(READ_DEST) + ENDIF + IF(allocated(READ_MNG))THEN + DEALLOCATE(READ_MNG) + ENDIF + IF(allocated(REQ_TO_ZONE))THEN + DEALLOCATE(REQ_TO_ZONE) + ENDIF + IF(allocated(REQ_ID))THEN + DEALLOCATE(REQ_ID) + ENDIF + IF(allocated(IO_REQ))THEN + DEALLOCATE(IO_REQ) + ENDIF + IF(associated(KEEP_OOC))THEN + NULLIFY(KEEP_OOC) + ENDIF + IF(associated(STEP_OOC))THEN + NULLIFY(STEP_OOC) + ENDIF + IF(associated(PROCNODE_OOC))THEN + NULLIFY(PROCNODE_OOC) + ENDIF + IF(associated(TOTAL_NB_OOC_NODES))THEN + NULLIFY(TOTAL_NB_OOC_NODES) + ENDIF + IF(associated(SIZE_OF_BLOCK))THEN + NULLIFY(SIZE_OF_BLOCK) + ENDIF + IF(associated(OOC_INODE_SEQUENCE))THEN + NULLIFY(OOC_VADDR) + ENDIF + CALL MUMPS_796(TYPEF_L, TYPEF_U, TYPEF_CB, + & id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID ) + DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN + CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC) + CALL ZMUMPS_614(id) + IF(id%INFO(1).LT.0)THEN + RETURN + ENDIF + STEP_OOC=>id%STEP + PROCNODE_OOC=>id%PROCNODE_STEPS + SLAVEF_OOC=id%NSLAVES + MYID_OOC=id%MYID + KEEP_OOC => id%KEEP + SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK + OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE + OOC_VADDR=>id%OOC_VADDR + ALLOCATE(IO_REQ(id%KEEP(28)), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = id%KEEP(28) + RETURN + ENDIF + ZMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35) + MAX_NB_NODES_FOR_ZONE=id%OOC_MAX_NB_NODES_FOR_ZONE + TOTAL_NB_OOC_NODES=>id%OOC_TOTAL_NB_NODES + CALL ZMUMPS_711( id%KEEP(204), STRAT_IO_ASYNC, + & WITH_BUF, LOW_LEVEL_STRAT_IO) + IF(id%KEEP(107).GT.0)THEN + SIZE_SOLVE_EMM=max(id%KEEP8(20), + & FACT_AREA_SIZE / 5_8) + SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM, + & int((dble(FACT_AREA_SIZE)- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)) + SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8) + IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN + SIZE_SOLVE_EMM=id%KEEP8(20) + SIZE_ZONE_SOLVE=int((dble(FACT_AREA_SIZE)- + & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8) + SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8) + ENDIF + ELSE + SIZE_ZONE_SOLVE=FACT_AREA_SIZE + SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE + ENDIF + IF(SIZE_SOLVE_EMM.LT.id%KEEP8(20))THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': More space needed for + & solution step in ZMUMPS_586' + id%INFO(1) = -11 + CALL MUMPS_731(id%KEEP8(20), id%INFO(2)) + ENDIF + TMP=MAX_NB_NODES_FOR_ZONE + CALL MPI_ALLREDUCE(TMP,MAX_NB_NODES_FOR_ZONE,1, + & MPI_INTEGER,MPI_MAX,id%COMM_NODES, IERR) + NB_Z=KEEP_OOC(107)+1 + ALLOCATE(POS_IN_MEM(MAX_NB_NODES_FOR_ZONE*NB_Z), + & INODE_TO_POS(KEEP_OOC(28)), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = id%KEEP(28)+(MAX_NB_NODES_FOR_ZONE*NB_Z) + RETURN + ENDIF + ALLOCATE(OOC_STATE_NODE(KEEP_OOC(28)),stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = id%KEEP(28) + RETURN + ENDIF + OOC_STATE_NODE(1:KEEP_OOC(28))=0 + INODE_TO_POS=0 + POS_IN_MEM=0 + ALLOCATE(LRLUS_SOLVE(NB_Z), LRLU_SOLVE_T(NB_Z),LRLU_SOLVE_B(NB_Z), + & POSFAC_SOLVE(NB_Z),IDEB_SOLVE_Z(NB_Z), + & PDEB_SOLVE_Z(NB_Z),SIZE_SOLVE_Z(NB_Z), + & CURRENT_POS_T(NB_Z),CURRENT_POS_B(NB_Z), + & POS_HOLE_T(NB_Z),POS_HOLE_B(NB_Z), + & stat=allocok) + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = 9*(NB_Z+1) + RETURN + ENDIF + IERR=0 + CALL MUMPS_GET_MAX_NB_REQ_C(MAX_NB_REQ,IERR) + ALLOCATE(SIZE_OF_READ(MAX_NB_REQ),FIRST_POS_IN_READ(MAX_NB_REQ), + & READ_DEST(MAX_NB_REQ),READ_MNG(MAX_NB_REQ), + & REQ_TO_ZONE(MAX_NB_REQ),REQ_ID(MAX_NB_REQ),stat=allocok) + SIZE_OF_READ=-9999_8 + FIRST_POS_IN_READ=-9999 + READ_DEST=-9999_8 + READ_MNG=-9999 + REQ_TO_ZONE=-9999 + REQ_ID=-9999 + IF (allocok .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_586' + id%INFO(1) = -13 + id%INFO(2) = 6*(NB_Z+1) + RETURN + ENDIF + MIN_SIZE_READ=min(max((1024_8*1024_8)/int(id%KEEP(35),8), + & SIZE_ZONE_SOLVE/3_8), + & SIZE_ZONE_SOLVE) + TMP_SIZE8=1_8 + J=1 + DO I=1,NB_Z-1 + IDEB_SOLVE_Z(I)=TMP_SIZE8 + POSFAC_SOLVE(I)=TMP_SIZE8 + LRLUS_SOLVE(I)=SIZE_ZONE_SOLVE + LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE + LRLU_SOLVE_B(I)=0_8 + SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE + CURRENT_POS_T(I)=J + CURRENT_POS_B(I)=J + PDEB_SOLVE_Z(I)=J + POS_HOLE_T(I)=J + POS_HOLE_B(I)=J + J=J+MAX_NB_NODES_FOR_ZONE + TMP_SIZE8=TMP_SIZE8+SIZE_ZONE_SOLVE + ENDDO + IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8 + PDEB_SOLVE_Z(NB_Z)=J + POSFAC_SOLVE(NB_Z)=TMP_SIZE8 + LRLUS_SOLVE(NB_Z)=SIZE_SOLVE_EMM + LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM + LRLU_SOLVE_B(NB_Z)=0_8 + SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM + CURRENT_POS_T(NB_Z)=J + CURRENT_POS_B(NB_Z)=J + POS_HOLE_T(NB_Z)=J + POS_HOLE_B(NB_Z)=J + IO_REQ=-77777 + REQ_ACT=0 + OOC_STATE_NODE(1:KEEP_OOC(28))=NOT_IN_MEM + IF(KEEP_OOC(38).NE.0)THEN + MASTER_ROOT=MUMPS_275( + & PROCNODE_OOC(STEP_OOC( KEEP_OOC(38))), + & SLAVEF_OOC ) + SPECIAL_ROOT_NODE=KEEP_OOC(38) + ELSEIF(KEEP_OOC(20).NE.0)THEN + MASTER_ROOT=MUMPS_275( + & PROCNODE_OOC(STEP_OOC( KEEP_OOC(20))), + & SLAVEF_OOC ) + SPECIAL_ROOT_NODE=KEEP_OOC(20) + ELSE + MASTER_ROOT=-111111 + SPECIAL_ROOT_NODE=-2222222 + ENDIF + IF ( KEEP_OOC(60).EQ.0 .AND. + & ( + & (KEEP_OOC(38).NE.0 .AND. id%root%yes) + & .OR. + & (KEEP_OOC(20).NE.0 .AND. MYID_OOC.EQ.MASTER_ROOT)) + & ) + & THEN + IS_ROOT_SPECIAL = .TRUE. + ELSE + IS_ROOT_SPECIAL = .FALSE. + ENDIF + NB_ZONE_REQ=0 + SIZE_ZONE_REQ=0_8 + CURRENT_SOLVE_READ_ZONE=0 + NB_CALLED=0 + NB_CALL=0 + SOLVE_STEP=-9999 +#if defined (NEW_PREF_SCHEME) + MAX_PREF_SIZE=(1024*1024*2)/8 +#endif + RETURN + END SUBROUTINE ZMUMPS_586 + SUBROUTINE ZMUMPS_585(A,LA,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER NSTEPS,IERR + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER I + IERR=0 + IF(NB_Z.GT.1)THEN + IF(STRAT_IO_ASYNC)THEN + DO I=1,NB_Z-1 + CALL ZMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDDO + ELSE + CALL ZMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_585 + SUBROUTINE ZMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER NSTEPS,IERR + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER ZONE + CALL ZMUMPS_603(ZONE) + IERR=0 + CALL ZMUMPS_611(ZONE,A,LA,PTRFAC,NSTEPS,IERR) + RETURN + END SUBROUTINE ZMUMPS_594 + SUBROUTINE ZMUMPS_595(DEST,INDICE,SIZE, + & ZONE,PTRFAC,NSTEPS,POS_SEQ,NB_NODES,FLAG,IERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER ZONE,NSTEPS,FLAG,POS_SEQ,NB_NODES + COMPLEX(kind=8) DEST + INTEGER (8) :: INDICE, SIZE, PTRFAC(NSTEPS) + INTEGER REQUEST,INODE,IERR + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER TYPE + INTEGER SIZE_INT1,SIZE_INT2 + TYPE=OOC_SOLVE_TYPE_FCT + IERR=0 + INODE=OOC_INODE_SEQUENCE(POS_SEQ,OOC_FCT_TYPE) + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO, + & DEST,SIZE_INT1,SIZE_INT2, + & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + IF(STRAT_IO_ASYNC)THEN + CALL ZMUMPS_597(INODE,SIZE,INDICE,ZONE, + & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ELSE + CALL ZMUMPS_597(INODE,SIZE,INDICE,ZONE, + & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL ZMUMPS_596(IO_REQ(STEP_OOC(INODE)), + & PTRFAC,NSTEPS) + REQ_ACT=REQ_ACT-1 + ENDIF + END SUBROUTINE ZMUMPS_595 + SUBROUTINE ZMUMPS_596(REQUEST,PTRFAC, + & NSTEPS) + IMPLICIT NONE + INTEGER NSTEPS,REQUEST + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER (8) :: LAST, POS_IN_S, J + INTEGER ZONE + INTEGER POS_REQ,I,TMP_NODE,POS_IN_MANAGE + INTEGER (8) SIZE + LOGICAL DONT_USE + EXTERNAL MUMPS_330,MUMPS_275 + INTEGER MUMPS_330,MUMPS_275 + POS_REQ=mod(REQUEST,MAX_NB_REQ)+1 + SIZE=SIZE_OF_READ(POS_REQ) + I=FIRST_POS_IN_READ(POS_REQ) + POS_IN_S=READ_DEST(POS_REQ) + POS_IN_MANAGE=READ_MNG(POS_REQ) + ZONE=REQ_TO_ZONE(POS_REQ) + DONT_USE=.FALSE. + J=0_8 + DO WHILE((J.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))) + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + I=I+1 + CYCLE + ENDIF + IF((INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0).AND. + & (INODE_TO_POS(STEP_OOC(TMP_NODE)).LT. + & -((N_OOC+1)*NB_Z)))THEN + DONT_USE= + & (((MTYPE_OOC.EQ.1).AND.(KEEP_OOC(50).EQ.0).AND. + & (SOLVE_STEP.EQ.1).AND. + & ((MUMPS_330(PROCNODE_OOC(STEP_OOC(TMP_NODE)), + & SLAVEF_OOC).EQ.2).AND.(MUMPS_275( + & PROCNODE_OOC(STEP_OOC(TMP_NODE)),SLAVEF_OOC).NE. + & MYID_OOC))) + & .OR. + & ((MTYPE_OOC.NE.1).AND.(KEEP_OOC(50).EQ.0).AND. + & (SOLVE_STEP.EQ.0).AND. + & ((MUMPS_330(PROCNODE_OOC(STEP_OOC(TMP_NODE)), + & SLAVEF_OOC).EQ.2).AND.(MUMPS_275( + & PROCNODE_OOC(STEP_OOC(TMP_NODE)),SLAVEF_OOC).NE. + & MYID_OOC)))).OR. + & (OOC_STATE_NODE(STEP_OOC(TMP_NODE)).EQ.ALREADY_USED) + IF(DONT_USE)THEN + PTRFAC(STEP_OOC(TMP_NODE))=-POS_IN_S + ELSE + PTRFAC(STEP_OOC(TMP_NODE))=POS_IN_S + ENDIF + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).LT. + & IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Inernal error (42) in OOC ', + & PTRFAC(STEP_OOC(TMP_NODE)),IDEB_SOLVE_Z(ZONE) + CALL MUMPS_ABORT() + ENDIF + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).GT. + & (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN + WRITE(*,*)MYID_OOC,': Inernal error (43) in OOC ' + CALL MUMPS_ABORT() + ENDIF + IF(DONT_USE)THEN + POS_IN_MEM(POS_IN_MANAGE)=-TMP_NODE + INODE_TO_POS(STEP_OOC(TMP_NODE))=-POS_IN_MANAGE + IF(OOC_STATE_NODE(STEP_OOC(TMP_NODE)).NE. + & ALREADY_USED)THEN + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=USED_NOT_PERMUTED + ENDIF + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+LAST + ELSE + POS_IN_MEM(POS_IN_MANAGE)=TMP_NODE + INODE_TO_POS(STEP_OOC(TMP_NODE))=POS_IN_MANAGE + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + ENDIF + IO_REQ(STEP_OOC(TMP_NODE))=-7777 + ELSE + POS_IN_MEM(POS_IN_MANAGE)=0 + ENDIF + POS_IN_S=POS_IN_S+LAST + POS_IN_MANAGE=POS_IN_MANAGE+1 + J=J+LAST + I=I+1 + ENDDO + SIZE_OF_READ(POS_REQ)=-9999_8 + FIRST_POS_IN_READ(POS_REQ)=-9999 + READ_DEST(POS_REQ)=-9999_8 + READ_MNG(POS_REQ)=-9999 + REQ_TO_ZONE(POS_REQ)=-9999 + REQ_ID(POS_REQ)=-9999 + RETURN + END SUBROUTINE ZMUMPS_596 + SUBROUTINE ZMUMPS_597(INODE,SIZE,DEST,ZONE, + & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER INODE,ZONE,REQUEST,FLAG,POS_SEQ,NB_NODES,NSTEPS + INTEGER(8) :: SIZE + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER(8) :: DEST, LOCAL_DEST, J8 + INTEGER I,TMP_NODE,LOC_I,POS_REQ,NB + INTEGER(8)::LAST + INTEGER, intent(out) :: IERR + IERR=0 + IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + RETURN + ENDIF + NB=0 + LOCAL_DEST=DEST + I=POS_SEQ + POS_REQ=mod(REQUEST,MAX_NB_REQ)+1 + IF(REQ_ID(POS_REQ).NE.-9999)THEN + CALL MUMPS_WAIT_REQUEST(REQ_ID(POS_REQ),IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + CALL ZMUMPS_596(REQUEST,PTRFAC,NSTEPS) + REQ_ACT=REQ_ACT-1 + ENDIF + SIZE_OF_READ(POS_REQ)=SIZE + FIRST_POS_IN_READ(POS_REQ)=I + READ_DEST(POS_REQ)=DEST + IF(FLAG.EQ.0)THEN + READ_MNG(POS_REQ)=CURRENT_POS_B(ZONE)-NB_NODES+1 + ELSEIF(FLAG.EQ.1)THEN + READ_MNG(POS_REQ)=CURRENT_POS_T(ZONE) + ENDIF + REQ_TO_ZONE(POS_REQ)=ZONE + REQ_ID(POS_REQ)=REQUEST + J8=0_8 + IF(FLAG.EQ.0)THEN + LOC_I=CURRENT_POS_B(ZONE)-NB_NODES+1 + ENDIF + DO WHILE((J8.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))) + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + INODE_TO_POS(STEP_OOC(TMP_NODE))=1 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + I=I+1 + CYCLE + ENDIF + IF((IO_REQ(STEP_OOC(TMP_NODE)).GE.0).OR. + & (INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0))THEN + IF(FLAG.EQ.1)THEN + POS_IN_MEM(CURRENT_POS_T(ZONE))=0 + ELSEIF(FLAG.EQ.0)THEN + POS_IN_MEM(CURRENT_POS_B(ZONE))=0 + ENDIF + ELSE + IO_REQ(STEP_OOC(TMP_NODE))=REQUEST + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-LAST + IF(FLAG.EQ.1)THEN + IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + CURRENT_POS_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+LAST + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)-LAST + POS_IN_MEM(CURRENT_POS_T(ZONE))=-TMP_NODE- + & ((N_OOC+1)*NB_Z) + INODE_TO_POS(STEP_OOC(TMP_NODE))=-CURRENT_POS_T(ZONE)- + & ((N_OOC+1)*NB_Z) + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ + PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST + LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(FLAG.EQ.0)THEN + LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)-LAST + POS_IN_MEM(LOC_I)=-TMP_NODE-((N_OOC+1)*NB_Z) + IF(LOC_I.EQ.POS_HOLE_T(ZONE))THEN + IF(POS_HOLE_T(ZONE).LT.CURRENT_POS_T(ZONE))THEN + POS_HOLE_T(ZONE)=POS_HOLE_T(ZONE)+1 + ENDIF + ENDIF + INODE_TO_POS(STEP_OOC(TMP_NODE))=-LOC_I-((N_OOC+1)*NB_Z) + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ + PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST + LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSE + WRITE(*,*)MYID_OOC,': Internal error (39) in OOC ', + & ' Invalid Flag Value in ', + & ' ZMUMPS_597',FLAG + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).NE.0)THEN + IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).EQ. + & POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))THEN + IF(CURRENT_POS_T(ZONE).NE.PDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (40) in OOC ', + & CURRENT_POS_T(ZONE), + & PDEB_SOLVE_Z(ZONE), + & POS_IN_MEM(CURRENT_POS_T(ZONE)), + & POS_IN_MEM(PDEB_SOLVE_Z(ZONE)) + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + J8=J8+LAST + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (41) in OOC ', + & ' LRLUS_SOLVE must be (1) > 0', + & LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + I=I+1 + IF(FLAG.EQ.1)THEN + CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1 + IF(CURRENT_POS_T(ZONE).GT. + & MAX_NB_NODES_FOR_ZONE+PDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (1) in OOC ' + CALL MUMPS_ABORT() + ENDIF + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + ELSEIF(FLAG.EQ.0)THEN + IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (2) in OOC ', + & POS_HOLE_B(ZONE),LOC_I + CALL MUMPS_ABORT() + ENDIF + CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1 + POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE) + IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + ELSE + WRITE(*,*)MYID_OOC,': Internal error (3) in OOC ', + & ' Invalid Flag Value in ', + & ' ZMUMPS_597',FLAG + CALL MUMPS_ABORT() + ENDIF + IF(FLAG.EQ.0)THEN + LOC_I=LOC_I+1 + ENDIF + NB=NB+1 + ENDDO + IF(NB.NE.NB_NODES)THEN + WRITE(*,*)MYID_OOC,': Internal error (4) in OOC ', + & ' ZMUMPS_597 ',NB,NB_NODES + ENDIF + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=I + ELSE + CUR_POS_SEQUENCE=POS_SEQ-1 + ENDIF + RETURN + END SUBROUTINE ZMUMPS_597 + SUBROUTINE ZMUMPS_598(INODE,PTRFAC,NSTEPS,A, + & LA,FLAG,IERR) + IMPLICIT NONE + INTEGER(8) :: LA + INTEGER, intent(out):: IERR + COMPLEX(kind=8) A(LA) + INTEGER INODE,NSTEPS + INTEGER(8) :: PTRFAC(NSTEPS) + LOGICAL FLAG + INTEGER(8) FREE_SIZE + INTEGER TMP,TMP_NODE,I,ZONE,J, FREE_HOLE_FLAG + INTEGER WHICH + INTEGER(8) :: DUMMY_SIZE + DUMMY_SIZE=1_8 + IERR = 0 + WHICH=-1 + IF(INODE_TO_POS(STEP_OOC(INODE)).LE.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (5) in OOC ', + & ' Problem in ZMUMPS_598', + & INODE, STEP_OOC(INODE), INODE_TO_POS(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE).EQ.0_8)THEN + INODE_TO_POS(STEP_OOC(INODE))=0 + OOC_STATE_NODE(STEP_OOC(INODE))=ALREADY_USED + RETURN + ENDIF + CALL ZMUMPS_600(INODE,ZONE,PTRFAC,NSTEPS) + TMP=INODE_TO_POS(STEP_OOC(INODE)) + INODE_TO_POS(STEP_OOC(INODE))=-TMP + POS_IN_MEM(TMP)=-INODE + PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE)) + IF (KEEP_OOC(237).eq.0) THEN + IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.PERMUTED)THEN + WRITE(*,*)MYID_OOC,': INTERNAL ERROR (53) in OOC',INODE, + & OOC_STATE_NODE(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + ENDIF + OOC_STATE_NODE(STEP_OOC(INODE))=USED + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+ + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (6) in OOC ', + & ': LRLUS_SOLVE must be (2) > 0' + CALL MUMPS_ABORT() + ENDIF + IF(ZONE.EQ.NB_Z)THEN + IF(INODE.NE.SPECIAL_ROOT_NODE)THEN + CALL ZMUMPS_608(A,FACT_AREA_SIZE, + & DUMMY_SIZE,PTRFAC,KEEP_OOC(28),ZONE,IERR) + ENDIF + ELSE + FREE_HOLE_FLAG=0 + IF(SOLVE_STEP.EQ.0)THEN + IF(TMP.GT.POS_HOLE_B(ZONE))THEN + WHICH=0 + ELSEIF(TMP.LT.POS_HOLE_T(ZONE))THEN + WHICH=1 + ENDIF + ELSEIF(SOLVE_STEP.EQ.1)THEN + IF(TMP.LT.POS_HOLE_T(ZONE))THEN + WHICH=1 + ELSEIF(TMP.GT.POS_HOLE_B(ZONE))THEN + WHICH=0 + ENDIF + ENDIF + IF(WHICH.EQ.1)THEN + J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + FREE_SIZE=0_8 + DO I=J,TMP,-1 + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + GOTO 666 + ENDIF + ENDDO + POS_HOLE_T(ZONE)=TMP + 666 CONTINUE + ELSEIF(WHICH.EQ.0)THEN + J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + FREE_SIZE=0_8 + DO I=J,TMP + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + IF(J.EQ.PDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + CURRENT_POS_B(ZONE)=-9999 + ENDIF + GOTO 777 + ENDIF + ENDDO + POS_HOLE_B(ZONE)=TMP + 777 CONTINUE + ENDIF + IERR=0 + ENDIF + IF((NB_Z.GT.1).AND.FLAG)THEN + CALL ZMUMPS_601(ZONE) + IF((LRLUS_SOLVE(ZONE).GE.MIN_SIZE_READ).OR. + & (LRLUS_SOLVE(ZONE).GE. + & int(0.3D0*dble(SIZE_SOLVE_Z(ZONE)),8)))THEN + CALL ZMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ELSE + CALL ZMUMPS_603(ZONE) + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_598 + FUNCTION ZMUMPS_726(INODE,PTRFAC,NSTEPS,A,LA, + & IERR) + IMPLICIT NONE + INTEGER INODE,NSTEPS + INTEGER(8) :: LA + INTEGER, INTENT(out)::IERR + COMPLEX(kind=8) A(LA) + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER ZMUMPS_726 + IERR=0 + IF(INODE_TO_POS(STEP_OOC(INODE)).GT.0)THEN + IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN + ZMUMPS_726=OOC_NODE_PERMUTED + ELSE + ZMUMPS_726=OOC_NODE_NOT_PERMUTED + ENDIF + IF(.NOT.ZMUMPS_727())THEN + IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE) + & .EQ.INODE)THEN + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ELSEIF(SOLVE_STEP.EQ.1)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + CALL ZMUMPS_728() + ENDIF + ENDIF + ELSEIF(INODE_TO_POS(STEP_OOC(INODE)).LT.0)THEN + IF(INODE_TO_POS(STEP_OOC(INODE)).LT.-((N_OOC+1)*NB_Z))THEN + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(INODE)),IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': Internal error (7) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + CALL ZMUMPS_596(IO_REQ(STEP_OOC(INODE)), + & PTRFAC,NSTEPS) + REQ_ACT=REQ_ACT-1 + ELSE + CALL ZMUMPS_599(INODE,PTRFAC,NSTEPS) + IF(.NOT.ZMUMPS_727())THEN + IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ. + & INODE)THEN + IF(SOLVE_STEP.EQ.0)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ELSEIF(SOLVE_STEP.EQ.1)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + CALL ZMUMPS_728() + ENDIF + ENDIF + ENDIF + IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN + ZMUMPS_726=OOC_NODE_PERMUTED + ELSE + ZMUMPS_726=OOC_NODE_NOT_PERMUTED + ENDIF + ELSE + ZMUMPS_726=OOC_NODE_NOT_IN_MEM + ENDIF + RETURN + END FUNCTION ZMUMPS_726 + SUBROUTINE ZMUMPS_682(INODE) + IMPLICIT NONE + INTEGER INODE + IF ( (KEEP_OOC(237).EQ.0) + & .AND. (KEEP_OOC(235).EQ.0) ) THEN + IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.NOT_USED)THEN + WRITE(*,*)MYID_OOC,': INTERNAL ERROR (51) in OOC',INODE, + & OOC_STATE_NODE(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + ENDIF + OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED + END SUBROUTINE ZMUMPS_682 + SUBROUTINE ZMUMPS_599(INODE,PTRFAC,NSTEPS) + IMPLICIT NONE + INTEGER INODE,NSTEPS + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER ZONE + INODE_TO_POS(STEP_OOC(INODE))=-INODE_TO_POS(STEP_OOC(INODE)) + POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE)))= + & -POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE))) + PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE)) + IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED_NOT_PERMUTED)THEN + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + ELSEIF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED)THEN + OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED + ELSE + WRITE(*,*)MYID_OOC,': Internal error (52) in OOC',INODE, + & OOC_STATE_NODE(STEP_OOC(INODE)), + & INODE_TO_POS(STEP_OOC(INODE)) + CALL MUMPS_ABORT() + ENDIF + CALL ZMUMPS_610(PTRFAC(STEP_OOC(INODE)),ZONE) + IF(INODE_TO_POS(STEP_OOC(INODE)).LE.POS_HOLE_B(ZONE))THEN + IF(INODE_TO_POS(STEP_OOC(INODE)).GT. + & PDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)= + & INODE_TO_POS(STEP_OOC(INODE))-1 + ELSE + CURRENT_POS_B(ZONE)=-9999 + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + ENDIF + IF(INODE_TO_POS(STEP_OOC(INODE)).GE.POS_HOLE_T(ZONE))THEN + IF(INODE_TO_POS(STEP_OOC(INODE)).LT. + & CURRENT_POS_T(ZONE)-1)THEN + POS_HOLE_T(ZONE)=INODE_TO_POS(STEP_OOC(INODE))+1 + ELSE + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + ENDIF + ENDIF + CALL ZMUMPS_609(INODE,PTRFAC,NSTEPS,1) + END SUBROUTINE ZMUMPS_599 + SUBROUTINE ZMUMPS_600(INODE,ZONE,PTRFAC,NSTEPS) + IMPLICIT NONE + INTEGER INODE,ZONE,NSTEPS + INTEGER (8) :: PTRFAC(NSTEPS) + ZONE=1 + DO WHILE (ZONE.LE.NB_Z) + IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN + ZONE=ZONE-1 + EXIT + ENDIF + ZONE=ZONE+1 + ENDDO + IF(ZONE.EQ.NB_Z+1)THEN + ZONE=ZONE-1 + ENDIF + END SUBROUTINE ZMUMPS_600 + SUBROUTINE ZMUMPS_601(ZONE) + IMPLICIT NONE + INTEGER ZONE + ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1)+1 + END SUBROUTINE ZMUMPS_601 + SUBROUTINE ZMUMPS_603(ZONE) + IMPLICIT NONE + INTEGER ZONE + IF(NB_Z.GT.1)THEN + CURRENT_SOLVE_READ_ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1) + ZONE=CURRENT_SOLVE_READ_ZONE+1 + ELSE + ZONE=NB_Z + ENDIF + END SUBROUTINE ZMUMPS_603 + SUBROUTINE ZMUMPS_578(INODE,PTRFAC, + & KEEP,KEEP8, + & A,IERR) + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER, intent(out)::IERR + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)) + COMPLEX(kind=8) A(FACT_AREA_SIZE) + INTEGER(8) :: REQUESTED_SIZE + INTEGER ZONE,IFLAG + IERR=0 + IFLAG=0 + IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + & .EQ.0_8)THEN + INODE_TO_POS(STEP_OOC(INODE))=1 + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + PTRFAC(STEP_OOC(INODE))=1_8 + RETURN + ENDIF + REQUESTED_SIZE=SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + ZONE=NB_Z + IF(CURRENT_POS_T(ZONE).GT. + & (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1))THEN + CALL ZMUMPS_608(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + IF((LRLU_SOLVE_T(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE), + & OOC_FCT_TYPE)).AND. + & (CURRENT_POS_T(ZONE).LE. + & (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN + CALL ZMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSEIF(LRLU_SOLVE_B(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE), + & OOC_FCT_TYPE).AND. + & (CURRENT_POS_B(ZONE).GT.0))THEN + CALL ZMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSE + IF(ZMUMPS_579(INODE,ZONE))THEN + IF(SOLVE_STEP.EQ.0)THEN + CALL ZMUMPS_604(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL ZMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSEIF(IFLAG.EQ.0)THEN + CALL ZMUMPS_605(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL ZMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ENDIF + ENDIF + ELSE + CALL ZMUMPS_605(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL ZMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ELSEIF(IFLAG.EQ.0)THEN + CALL ZMUMPS_604(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC, + & KEEP(28),ZONE,IFLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IF(IFLAG.EQ.1)THEN + CALL ZMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ENDIF + ENDIF + ENDIF + IF(IFLAG.EQ.0)THEN + CALL ZMUMPS_608(A,FACT_AREA_SIZE, + & REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL ZMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8,A,ZONE) + ENDIF + ELSE + WRITE(*,*)MYID_OOC,': Internal error (8) in OOC ', + & ' Not enough space for Solve',INODE, + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE), + & LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (9) in OOC ', + & ' LRLUS_SOLVE must be (3) > 0' + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE ZMUMPS_578 + SUBROUTINE ZMUMPS_604(A,LA,REQUESTED_SIZE,PTRFAC, + & NSTEPS,ZONE,FLAG,IERR) + IMPLICIT NONE + INTEGER NSTEPS,ZONE,FLAG + INTEGER(8) :: REQUESTED_SIZE, LA + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER(8) :: FREE_SIZE, FREE_HOLE, FREE_HOLE_POS + COMPLEX(kind=8) A(LA) + INTEGER I,TMP_NODE,FREE_HOLE_FLAG, J + INTEGER, intent(out)::IERR + IERR=0 + FLAG=0 + IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE).AND. + & (.NOT.(CURRENT_POS_T(ZONE) + & .GT.PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN + GOTO 50 + ENDIF + J=max(POS_HOLE_B(ZONE),PDEB_SOLVE_Z(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + DO I=POS_HOLE_T(ZONE)-1,J,-1 + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + EXIT + ENDIF + ENDDO + POS_HOLE_T(ZONE)=I+1 + IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR. + & (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR. + & (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN + CURRENT_POS_B(ZONE)=-9999 + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE) + ENDIF + FREE_HOLE=0_8 + FREE_SIZE=0_8 + FREE_HOLE_FLAG=0 + FREE_HOLE_POS=POSFAC_SOLVE(ZONE) + DO I=CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),-1 + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + FREE_HOLE_FLAG=0 + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE))) + PTRFAC(STEP_OOC(TMP_NODE))=-777777_8 + INODE_TO_POS(STEP_OOC(TMP_NODE))=0 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED + POS_IN_MEM(I)=0 + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).EQ.0)THEN + FREE_HOLE_FLAG=1 + ELSEIF(POS_IN_MEM(I).NE.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (10) in OOC ', + & ' ZMUMPS_604', + & CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),I + CALL MUMPS_ABORT() + ENDIF + ENDDO + IF(POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE))THEN + IF(FREE_HOLE_FLAG.EQ.0)THEN + FREE_HOLE_FLAG=1 + ENDIF + ENDIF + IF(FREE_HOLE_FLAG.EQ.1)THEN + IF(POS_HOLE_T(ZONE)-1.GT.PDEB_SOLVE_Z(ZONE))THEN + I=POS_HOLE_T(ZONE)-1 + TMP_NODE=abs(POS_IN_MEM(I)) + IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN + TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (11) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + CALL MUMPS_ABORT() + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL ZMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSEIF(TMP_NODE.EQ.0)THEN + DO J=I,PDEB_SOLVE_Z(ZONE),-1 + IF(POS_IN_MEM(J).NE.0) EXIT + ENDDO + IF(POS_IN_MEM(J).LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (12) in OOC ', + & ' ZMUMPS_604' + CALL MUMPS_ABORT() + ENDIF + IF(J.GE.PDEB_SOLVE_Z(ZONE))THEN + TMP_NODE=POS_IN_MEM(J) + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSE + FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE) + ENDIF + ELSEIF(TMP_NODE.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (13) in OOC', + & ' ZMUMPS_604' + CALL MUMPS_ABORT() + ELSE + FREE_HOLE=FREE_HOLE_POS- + & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ENDIF + ELSE + FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE) + ENDIF + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + CURRENT_POS_T(ZONE)=POS_HOLE_T(ZONE) + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+FREE_SIZE + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-FREE_SIZE + 50 CONTINUE + IF(REQUESTED_SIZE.LE.LRLU_SOLVE_T(ZONE))THEN + FLAG=1 + ELSE + FLAG=0 + ENDIF + RETURN + END SUBROUTINE ZMUMPS_604 + SUBROUTINE ZMUMPS_605(A,LA,REQUESTED_SIZE, + & PTRFAC,NSTEPS,ZONE,FLAG,IERR) + IMPLICIT NONE + INTEGER NSTEPS,ZONE,FLAG + INTEGER (8) :: REQUESTED_SIZE + INTEGER (8) :: LA + INTEGER (8) :: PTRFAC(NSTEPS) + COMPLEX(kind=8) A(LA) + INTEGER(8) :: FREE_SIZE, FREE_HOLE_POS, FREE_HOLE + INTEGER I,J,TMP_NODE,FREE_HOLE_FLAG + INTEGER, intent(out) :: IERR + IERR=0 + FLAG=0 + IF(LRLU_SOLVE_B(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN + GOTO 50 + ENDIF + IF(POS_HOLE_B(ZONE).EQ.-9999)THEN + GOTO 50 + ENDIF + J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE)) + J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) + DO I=POS_HOLE_B(ZONE)+1,J + IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(I).NE.0)THEN + EXIT + ENDIF + ENDDO + POS_HOLE_B(ZONE)=I-1 + IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR. + & (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR. + & (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN + CURRENT_POS_B(ZONE)=-9999 + POS_HOLE_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE) + ENDIF + FREE_HOLE=0_8 + FREE_SIZE=0_8 + FREE_HOLE_FLAG=0 + FREE_HOLE_POS=IDEB_SOLVE_Z(ZONE) + IF(POS_HOLE_B(ZONE).EQ.-9999)THEN + GOTO 50 + ENDIF + DO I=PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE) + IF((POS_IN_MEM(I).LE.0).AND.(POS_IN_MEM(I).GT. + & -(N_OOC+1)*NB_Z))THEN + TMP_NODE=-POS_IN_MEM(I) + IF(TMP_NODE.NE.0)THEN + IF(I.EQ.PDEB_SOLVE_Z(ZONE))THEN + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE. + & IDEB_SOLVE_Z(ZONE))THEN + FREE_SIZE=FREE_SIZE+abs(PTRFAC(STEP_OOC(TMP_NODE))) + & -IDEB_SOLVE_Z(ZONE) + ENDIF + ENDIF + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + FREE_HOLE_FLAG=0 + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(TMP_NODE))=-777777_8 + INODE_TO_POS(STEP_OOC(TMP_NODE))=0 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED + FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + ELSE + FREE_HOLE_FLAG=1 + ENDIF + POS_IN_MEM(I)=0 + ELSEIF(POS_IN_MEM(I).NE.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (14) in OOC ', + & ' ZMUMPS_605', + & CURRENT_POS_T(ZONE)-1,POS_HOLE_B(ZONE),I,POS_IN_MEM(I) + CALL MUMPS_ABORT() + ENDIF + ENDDO + IF(FREE_HOLE_FLAG.EQ.1)THEN + IF(POS_HOLE_B(ZONE)+1.LT.CURRENT_POS_T(ZONE)-1)THEN + I=POS_HOLE_B(ZONE)+1 + TMP_NODE=abs(POS_IN_MEM(I)) + IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN + TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (15) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + CALL MUMPS_ABORT() + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL ZMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-FREE_HOLE_POS + ELSEIF(TMP_NODE.EQ.0)THEN + DO J=I,CURRENT_POS_T(ZONE)-1 + IF(POS_IN_MEM(J).NE.0) EXIT + ENDDO + IF(POS_IN_MEM(J).LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (16) in OOC ', + & ' ZMUMPS_605' + CALL MUMPS_ABORT() + ENDIF + IF(J.LE.CURRENT_POS_T(ZONE)-1)THEN + TMP_NODE=POS_IN_MEM(J) + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + ELSE + FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS + ENDIF + ELSEIF(TMP_NODE.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (17) in OOC ', + & ' ZMUMPS_605' + CALL MUMPS_ABORT() + ELSE + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + ENDIF + ELSE + FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS + ENDIF + FREE_SIZE=FREE_SIZE+FREE_HOLE + ENDIF + LRLU_SOLVE_B(ZONE)=FREE_SIZE + IF(POS_HOLE_B(ZONE).LT.CURRENT_POS_T(ZONE)-1)THEN + TMP_NODE=POS_IN_MEM(POS_HOLE_B(ZONE)+1) + IF(TMP_NODE.LT.-(N_OOC+1)*NB_Z)THEN + TMP_NODE=abs(TMP_NODE)-(N_OOC+1)*NB_Z + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (18) in OOC ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + CALL MUMPS_ABORT() + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL ZMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + ENDIF + LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)+ + & (abs(PTRFAC(STEP_OOC(abs(TMP_NODE))))-IDEB_SOLVE_Z(ZONE)- + & LRLU_SOLVE_B(ZONE)) + ENDIF + CURRENT_POS_B(ZONE)=POS_HOLE_B(ZONE) + 50 CONTINUE + IF((POS_HOLE_B(ZONE).EQ.-9999).AND. + & (LRLU_SOLVE_B(ZONE).NE.0_8))THEN + WRITE(*,*)MYID_OOC,': Internal error (19) in OOC ', + & 'ZMUMPS_605' + CALL MUMPS_ABORT() + ENDIF + IF((REQUESTED_SIZE.LE.LRLU_SOLVE_B(ZONE)).AND. + & (POS_HOLE_B(ZONE).NE.-9999))THEN + FLAG=1 + ELSE + FLAG=0 + ENDIF + END SUBROUTINE ZMUMPS_605 + SUBROUTINE ZMUMPS_606(INODE,PTRFAC, + & KEEP,KEEP8, A,ZONE) + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)) + COMPLEX(kind=8) A(FACT_AREA_SIZE) + INTEGER ZONE + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(INODE))=POSFAC_SOLVE(ZONE) + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN + POS_HOLE_B(ZONE)=-9999 + CURRENT_POS_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + ENDIF + IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (20) in OOC ', + & ' Problem avec debut (2)',INODE, + & PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE),ZONE + CALL MUMPS_ABORT() + ENDIF + INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_T(ZONE) + POS_IN_MEM(CURRENT_POS_T(ZONE))=INODE + IF(CURRENT_POS_T(ZONE).GT.(PDEB_SOLVE_Z(ZONE)+ + & MAX_NB_NODES_FOR_ZONE-1))THEN + WRITE(*,*)MYID_OOC,': Internal error (21) in OOC ', + & ' Problem with CURRENT_POS_T', + & CURRENT_POS_T(ZONE),ZONE + CALL MUMPS_ABORT() + ENDIF + CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1 + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+ + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + END SUBROUTINE ZMUMPS_606 + SUBROUTINE ZMUMPS_607(INODE,PTRFAC, + & KEEP,KEEP8, + & A,ZONE) + IMPLICIT NONE + INTEGER INODE,KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRFAC(KEEP(28)) + COMPLEX(kind=8) A(FACT_AREA_SIZE) + INTEGER ZONE + IF(POS_HOLE_B(ZONE).EQ.-9999)THEN + WRITE(*,*)MYID_OOC,': Internal error (22) in OOC ', + & ' ZMUMPS_607' + CALL MUMPS_ABORT() + ENDIF + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(INODE))=IDEB_SOLVE_Z(ZONE)+ + & LRLU_SOLVE_B(ZONE) + OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED + IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (23) in OOC ', + & PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE) + CALL MUMPS_ABORT() + ENDIF + INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_B(ZONE) + IF(CURRENT_POS_B(ZONE).EQ.0)THEN + WRITE(*,*)MYID_OOC,': Internal error (23b) in OOC ' + CALL MUMPS_ABORT() + ENDIF + POS_IN_MEM(CURRENT_POS_B(ZONE))=INODE + CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1 + POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE) + END SUBROUTINE ZMUMPS_607 + SUBROUTINE ZMUMPS_608(A,LA,REQUESTED_SIZE,PTRFAC, + & NSTEPS,ZONE,IERR) + IMPLICIT NONE + INTEGER(8) :: LA, REQUESTED_SIZE + INTEGER NSTEPS,ZONE + INTEGER, intent(out) :: IERR + INTEGER(8) :: PTRFAC(NSTEPS) + COMPLEX(kind=8) A(LA) + INTEGER (8) :: APOS_FIRST_FREE, + & SIZE_HOLE, + & FREE_HOLE, + & FREE_HOLE_POS + INTEGER J,I,TMP_NODE, NB_FREE, IPOS_FIRST_FREE + INTEGER(8) :: K8, AREA_POINTER + INTEGER FREE_HOLE_FLAG + IERR=0 + IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN + RETURN + ENDIF + AREA_POINTER=IDEB_SOLVE_Z(ZONE) + SIZE_HOLE=0_8 + DO I=PDEB_SOLVE_Z(ZONE),CURRENT_POS_T(ZONE)-1 + IF((POS_IN_MEM(I).LE.0).AND. + & (POS_IN_MEM(I).GT.-((N_OOC+1)*NB_Z))) GOTO 666 + TMP_NODE=abs(POS_IN_MEM(I)) + IF(TMP_NODE.GT.((N_OOC+1)*NB_Z))THEN + TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z) + ENDIF + AREA_POINTER=AREA_POINTER+ + & abs(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ENDDO + 666 CONTINUE + IF((I.EQ.CURRENT_POS_T(ZONE)-1).AND. + & (PDEB_SOLVE_Z(ZONE).NE.CURRENT_POS_T(ZONE)-1))THEN + IF((POS_IN_MEM(I).GT.0).OR. + & (POS_IN_MEM(I).LT.-((N_OOC+1)*NB_Z)))THEN + WRITE(*,*)MYID_OOC,': Internal error (25) in OOC ', + & ': There are no free blocks ', + & 'in ZMUMPS_608',PDEB_SOLVE_Z(ZONE), + & CURRENT_POS_T(ZONE) + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF(POS_IN_MEM(I).EQ.0)THEN + APOS_FIRST_FREE=AREA_POINTER + FREE_HOLE_POS=AREA_POINTER + ELSE + TMP_NODE=abs(POS_IN_MEM(I)) + APOS_FIRST_FREE=abs(PTRFAC(STEP_OOC(TMP_NODE))) + ENDIF + IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).NE.0)THEN + IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).LT.-((N_OOC+1)*NB_Z))THEN + TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))- + & ((N_OOC+1)*NB_Z) + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL ZMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + ELSE + TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE))) + ENDIF + IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE.IDEB_SOLVE_Z(ZONE))THEN + IF((POS_IN_MEM(I).NE.0).OR.(I.EQ.CURRENT_POS_T(ZONE)))THEN + SIZE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & IDEB_SOLVE_Z(ZONE) + ENDIF + APOS_FIRST_FREE=IDEB_SOLVE_Z(ZONE) + IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).GT.0)THEN + DO J=PDEB_SOLVE_Z(ZONE),I-1 + TMP_NODE=POS_IN_MEM(J) + IF(TMP_NODE.LE.0)THEN + IF(TMP_NODE.LT.-((N_OOC+1)*NB_Z))THEN + TMP_NODE=abs(POS_IN_MEM(J))-((N_OOC+1)*NB_Z) + CALL MUMPS_WAIT_REQUEST( + & IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL ZMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + TMP_NODE=POS_IN_MEM(J) + ELSE + WRITE(*,*)MYID_OOC,': Internal error (26) in OOC ', + & ' ZMUMPS_608',TMP_NODE, + & J,I-1,(N_OOC+1)*NB_Z + CALL MUMPS_ABORT() + ENDIF + ENDIF + DO K8=1_8, + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + A(APOS_FIRST_FREE+K8-1_8)= + & A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8) + ENDDO + PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE + APOS_FIRST_FREE=APOS_FIRST_FREE+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + ENDDO + ENDIF + ENDIF + ENDIF + NB_FREE=0 + FREE_HOLE=0_8 + FREE_HOLE_FLAG=0 + DO J=I,CURRENT_POS_T(ZONE)-1 + TMP_NODE=abs(POS_IN_MEM(J)) + IF(POS_IN_MEM(J).LT.-((N_OOC+1)*NB_Z))THEN + TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z) + CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + REQ_ACT=REQ_ACT-1 + CALL ZMUMPS_596( + & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) + TMP_NODE=abs(POS_IN_MEM(J)) + ENDIF + IF(POS_IN_MEM(J).GT.0)THEN + DO K8=1_8,SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + A(APOS_FIRST_FREE+K8-1_8)= + & A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8) + ENDDO + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + FREE_HOLE_FLAG=0 + SIZE_HOLE=SIZE_HOLE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE + APOS_FIRST_FREE=APOS_FIRST_FREE+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + ELSEIF(POS_IN_MEM(J).EQ.0)THEN + FREE_HOLE_FLAG=1 + NB_FREE=NB_FREE+1 + ELSE + NB_FREE=NB_FREE+1 + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- + & FREE_HOLE_POS + FREE_HOLE_FLAG=0 + SIZE_HOLE=SIZE_HOLE+FREE_HOLE + ENDIF + FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + SIZE_HOLE=SIZE_HOLE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), + & OOC_FCT_TYPE) + PTRFAC(STEP_OOC(abs(POS_IN_MEM(J))))=-77777_8 + ENDIF + ENDDO + IF(FREE_HOLE_FLAG.EQ.1)THEN + FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS + FREE_HOLE_FLAG=0 + SIZE_HOLE=SIZE_HOLE+FREE_HOLE + ENDIF + IPOS_FIRST_FREE=I + DO J=I,CURRENT_POS_T(ZONE)-1 + IF(POS_IN_MEM(J).LT.0)THEN + TMP_NODE=abs(POS_IN_MEM(J)) + INODE_TO_POS(STEP_OOC(TMP_NODE))=0 + POS_IN_MEM(J)=0 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED + ELSEIF(POS_IN_MEM(J).GT.0)THEN + TMP_NODE=abs(POS_IN_MEM(J)) + POS_IN_MEM(IPOS_FIRST_FREE)=POS_IN_MEM(J) + INODE_TO_POS(STEP_OOC(TMP_NODE))=IPOS_FIRST_FREE + IPOS_FIRST_FREE=IPOS_FIRST_FREE+1 + ENDIF + ENDDO + LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+SIZE_HOLE + POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-SIZE_HOLE + CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)-NB_FREE + POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) + LRLU_SOLVE_B(ZONE)=0_8 + POS_HOLE_B(ZONE)=-9999 + CURRENT_POS_B(ZONE)=-9999 + LRLU_SOLVE_B(ZONE)=0_8 + IF(LRLU_SOLVE_T(ZONE).NE.LRLUS_SOLVE(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (27) in OOC ', + & LRLU_SOLVE_T(ZONE), + & LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + LRLU_SOLVE_T(ZONE)=LRLUS_SOLVE(ZONE) + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (28) in OOC ', + & ' LRLUS_SOLVE must be (4) > 0' + CALL MUMPS_ABORT() + ENDIF + IF(POSFAC_SOLVE(ZONE).LT.IDEB_SOLVE_Z(ZONE))THEN + WRITE(*,*)MYID_OOC,': Internal error (29) in OOC ', + & POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE) + CALL MUMPS_ABORT() + ENDIF + IF(POSFAC_SOLVE(ZONE).NE.(IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)- + & LRLUS_SOLVE(ZONE)))THEN + WRITE(*,*)MYID_OOC,': Internal error (30) in OOC ', + & ' Problem avec debut POSFAC_SOLVE', + & POSFAC_SOLVE(ZONE),(SIZE_SOLVE_Z(ZONE)- + & LRLUS_SOLVE(ZONE))+IDEB_SOLVE_Z(ZONE),LRLUS_SOLVE(ZONE) + CALL MUMPS_ABORT() + ENDIF + IF(POSFAC_SOLVE(ZONE).GT. + & (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN + WRITE(*,*)MYID_OOC,': Internal error (31) in OOC ', + & POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE)+ + & SIZE_SOLVE_Z(ZONE)-1_8 + CALL MUMPS_ABORT() + ENDIF + RETURN + END SUBROUTINE ZMUMPS_608 + SUBROUTINE ZMUMPS_609(INODE,PTRFAC,NSTEPS,FLAG) + IMPLICIT NONE + INTEGER INODE,NSTEPS,FLAG + INTEGER (8) :: PTRFAC(NSTEPS) + INTEGER ZONE + IF((FLAG.LT.0).OR.(FLAG.GT.1))THEN + WRITE(*,*)MYID_OOC,': Internal error (32) in OOC ', + & ' ZMUMPS_609' + CALL MUMPS_ABORT() + ENDIF + CALL ZMUMPS_610(PTRFAC(STEP_OOC(INODE)),ZONE) + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (33) in OOC ', + & ' LRLUS_SOLVE must be (5) ++ > 0' + CALL MUMPS_ABORT() + ENDIF + IF(FLAG.EQ.0)THEN + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+ + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + ELSE + LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- + & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) + ENDIF + IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN + WRITE(*,*)MYID_OOC,': Internal error (34) in OOC ', + & ' LRLUS_SOLVE must be (5) > 0' + CALL MUMPS_ABORT() + ENDIF + END SUBROUTINE ZMUMPS_609 + SUBROUTINE ZMUMPS_610(ADDR,ZONE) + IMPLICIT NONE + INTEGER (8) :: ADDR + INTEGER ZONE + INTEGER I + I=1 + DO WHILE (I.LE.NB_Z) + IF(ADDR.LT.IDEB_SOLVE_Z(I))THEN + EXIT + ENDIF + I=I+1 + ENDDO + ZONE=I-1 + END SUBROUTINE ZMUMPS_610 + FUNCTION ZMUMPS_727() + IMPLICIT NONE + LOGICAL ZMUMPS_727 + ZMUMPS_727=.FALSE. + IF(SOLVE_STEP.EQ.0)THEN + IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + ZMUMPS_727=.TRUE. + ENDIF + ELSEIF(SOLVE_STEP.EQ.1)THEN + IF(CUR_POS_SEQUENCE.LT.1)THEN + ZMUMPS_727=.TRUE. + ENDIF + ENDIF + RETURN + END FUNCTION ZMUMPS_727 + SUBROUTINE ZMUMPS_611(ZONE,A,LA,PTRFAC,NSTEPS,IERR) + IMPLICIT NONE + INTEGER NSTEPS,ZONE + INTEGER(8), INTENT(IN) :: LA + INTEGER, intent(out) :: IERR + COMPLEX(kind=8) A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER(8) :: SIZE, DEST + INTEGER(8) :: NEEDED_SIZE + INTEGER FLAG,TMP_FLAG,POS_SEQ,TMP_NODE, + & NB_NODES + IERR=0 + TMP_FLAG=0 + FLAG=0 + IF(ZMUMPS_727())THEN + RETURN + ENDIF + IF(SOLVE_STEP.EQ.0)THEN + IF(CUR_POS_SEQUENCE.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT. + & SIZE_SOLVE_Z(ZONE)) + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + IF(ZMUMPS_727())THEN + RETURN + ENDIF + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + ENDDO + CALL ZMUMPS_728() + NEEDED_SIZE=max(MIN_SIZE_READ, + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSE + NEEDED_SIZE=MIN_SIZE_READ + ENDIF + ELSEIF(SOLVE_STEP.EQ.1)THEN + IF(CUR_POS_SEQUENCE.GE.1)THEN + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT. + & SIZE_SOLVE_Z(ZONE)) + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + IF(ZMUMPS_727())THEN + RETURN + ENDIF + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + ENDDO + CALL ZMUMPS_728() + NEEDED_SIZE=max(MIN_SIZE_READ, + & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) + ELSE + NEEDED_SIZE=MIN_SIZE_READ + ENDIF + ENDIF + IF(LRLUS_SOLVE(ZONE).LT.NEEDED_SIZE)THEN + RETURN + ELSEIF((LRLU_SOLVE_T(ZONE).LT.NEEDED_SIZE).AND. + & (LRLU_SOLVE_B(ZONE).LT.NEEDED_SIZE).AND. + & (dble(LRLUS_SOLVE(ZONE)).LT.0.3d0* + & dble(SIZE_SOLVE_Z(ZONE)))) THEN + RETURN + ENDIF + IF((LRLU_SOLVE_T(ZONE).GT.NEEDED_SIZE).AND.(SOLVE_STEP.EQ.0).AND. + & ((CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1).LT. + & MAX_NB_NODES_FOR_ZONE))THEN + FLAG=1 + ELSE + IF(SOLVE_STEP.EQ.0)THEN + CALL ZMUMPS_604(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=1 + IF(TMP_FLAG.EQ.0)THEN + CALL ZMUMPS_605(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=0 + ENDIF + ELSE + CALL ZMUMPS_605(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=0 + IF(TMP_FLAG.EQ.0)THEN + CALL ZMUMPS_604(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=1 + ENDIF + ENDIF + IF(TMP_FLAG.EQ.0)THEN + CALL ZMUMPS_608(A,FACT_AREA_SIZE, + & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + FLAG=1 + ENDIF + ENDIF + CALL ZMUMPS_602(ZONE,SIZE,DEST,POS_SEQ, + & NB_NODES,FLAG,PTRFAC,NSTEPS) + IF(SIZE.EQ.0_8)THEN + RETURN + ENDIF + NB_ZONE_REQ=NB_ZONE_REQ+1 + SIZE_ZONE_REQ=SIZE_ZONE_REQ+SIZE + REQ_ACT=REQ_ACT+1 + CALL ZMUMPS_595(A(DEST),DEST,SIZE,ZONE,PTRFAC,NSTEPS, + & POS_SEQ,NB_NODES,FLAG,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + END SUBROUTINE ZMUMPS_611 + SUBROUTINE ZMUMPS_602(ZONE,SIZE,DEST,POS_SEQ, + & NB_NODES,FLAG,PTRFAC,NSTEPS) + IMPLICIT NONE + INTEGER(8) :: SIZE, DEST + INTEGER ZONE,FLAG,POS_SEQ,NSTEPS + INTEGER(8) :: PTRFAC(NSTEPS), MAX_SIZE, LAST, J8 + INTEGER I,START_NODE,K,MAX_NB, + & NB_NODES + INTEGER NB_NODES_LOC + LOGICAL ALREADY + IF(ZMUMPS_727())THEN + SIZE=0_8 + RETURN + ENDIF + IF(FLAG.EQ.0)THEN + MAX_SIZE=LRLU_SOLVE_B(ZONE) + MAX_NB=max(0,CURRENT_POS_B(ZONE)-PDEB_SOLVE_Z(ZONE)+1) + ELSEIF(FLAG.EQ.1)THEN + MAX_SIZE=LRLU_SOLVE_T(ZONE) + MAX_NB=MAX_NB_NODES_FOR_ZONE + ELSE + WRITE(*,*)MYID_OOC,': Internal error (35) in OOC ', + & ' Unknown Flag value in ', + & ' ZMUMPS_602',FLAG + CALL MUMPS_ABORT() + ENDIF + CALL ZMUMPS_728() + I=CUR_POS_SEQUENCE + START_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + ALREADY=.FALSE. + NB_NODES=0 + NB_NODES_LOC=0 +#if defined (NEW_PREF_SCHEME) + IF(MAX_SIZE.GT.MAX_PREF_SIZE)THEN + MAX_SIZE=MIN(MAX(MAX_PREF_SIZE, + & SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE)), + & MAX_SIZE) + ENDIF +#endif + IF(ZONE.EQ.NB_Z)THEN + SIZE=SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE) + ELSE + J8=0_8 + IF(FLAG.EQ.0)THEN + K=0 + ELSEIF(FLAG.EQ.1)THEN + K=CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1 + ENDIF + IF(SOLVE_STEP.EQ.0)THEN + I=CUR_POS_SEQUENCE + DO WHILE(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) + IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + & .NE.0_8)THEN + EXIT + ENDIF + I=I+1 + ENDDO + CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) + I=CUR_POS_SEQUENCE + DO WHILE((J8.LE.MAX_SIZE).AND. + & (I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND. + & (K.LT.MAX_NB) ) + LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + IF(.NOT.ALREADY)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + ENDIF + I=I+1 + NB_NODES_LOC=NB_NODES_LOC+1 + CYCLE + ENDIF + IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))) + & .NE.0).OR. + & (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))).GE. + & 0))THEN + IF(.NOT.ALREADY)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 + I=I+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ALREADY=.TRUE. + J8=J8+LAST + I=I+1 + K=K+1 + NB_NODES_LOC=NB_NODES_LOC+1 + NB_NODES=NB_NODES+1 + ENDDO + IF(J8.GT.MAX_SIZE)THEN + SIZE=J8-LAST + NB_NODES=NB_NODES-1 + NB_NODES_LOC=NB_NODES_LOC-1 + ELSE + SIZE=J8 + ENDIF + DO WHILE (CUR_POS_SEQUENCE+NB_NODES_LOC-1.GE. + & CUR_POS_SEQUENCE) + IF(SIZE_OF_BLOCK(STEP_OOC( + & OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE+NB_NODES-1, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + & .NE.0_8)THEN + EXIT + ENDIF + NB_NODES_LOC=NB_NODES_LOC-1 + ENDDO + POS_SEQ=CUR_POS_SEQUENCE + ELSEIF(SOLVE_STEP.EQ.1)THEN + DO WHILE(I.GE.1) + IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + & .NE.0_8)THEN + EXIT + ENDIF + I=I-1 + ENDDO + CUR_POS_SEQUENCE=max(I,1) + I=CUR_POS_SEQUENCE + DO WHILE((J8.LE.MAX_SIZE).AND.(I.GE.1).AND. + & (K.LT.MAX_NB)) + LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE)), + & OOC_FCT_TYPE) + IF(LAST.EQ.0_8)THEN + IF(.NOT.ALREADY)THEN + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + ENDIF + NB_NODES_LOC=NB_NODES_LOC+1 + I=I-1 + CYCLE + ENDIF + IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))) + & .NE.0).OR. + & (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I, + & OOC_FCT_TYPE))).GE. + & 0))THEN + IF(.NOT.ALREADY)THEN + I=I-1 + CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ALREADY=.TRUE. + J8=J8+LAST + I=I-1 + K=K+1 + NB_NODES=NB_NODES+1 + NB_NODES_LOC=NB_NODES_LOC+1 + ENDDO + IF(J8.GT.MAX_SIZE)THEN + SIZE=J8-LAST + NB_NODES=NB_NODES-1 + NB_NODES_LOC=NB_NODES_LOC-1 + ELSE + SIZE=J8 + ENDIF + I=CUR_POS_SEQUENCE-NB_NODES_LOC+1 + DO WHILE (I.LE.CUR_POS_SEQUENCE) + IF(SIZE_OF_BLOCK(STEP_OOC( + & OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)), + & OOC_FCT_TYPE).NE.0_8)THEN + EXIT + ENDIF + I=I+1 + NB_NODES_LOC=NB_NODES_LOC-1 + ENDDO + POS_SEQ=CUR_POS_SEQUENCE-NB_NODES_LOC+1 + ENDIF + ENDIF + IF(FLAG.EQ.0)THEN + DEST=IDEB_SOLVE_Z(ZONE)+LRLU_SOLVE_B(ZONE)-SIZE + ELSE + DEST=POSFAC_SOLVE(ZONE) + ENDIF + END SUBROUTINE ZMUMPS_602 + SUBROUTINE ZMUMPS_582(IERR) + IMPLICIT NONE + INTEGER SOLVE_OR_FACTO + INTEGER, intent(out) :: IERR + IERR=0 + IF(allocated(LRLUS_SOLVE))THEN + DEALLOCATE(LRLUS_SOLVE) + ENDIF + IF(allocated(LRLU_SOLVE_T))THEN + DEALLOCATE(LRLU_SOLVE_T) + ENDIF + IF(allocated(LRLU_SOLVE_B))THEN + DEALLOCATE(LRLU_SOLVE_B) + ENDIF + IF(allocated(POSFAC_SOLVE))THEN + DEALLOCATE(POSFAC_SOLVE) + ENDIF + IF(allocated(IDEB_SOLVE_Z))THEN + DEALLOCATE(IDEB_SOLVE_Z) + ENDIF + IF(allocated(PDEB_SOLVE_Z))THEN + DEALLOCATE(PDEB_SOLVE_Z) + ENDIF + IF(allocated(SIZE_SOLVE_Z))THEN + DEALLOCATE(SIZE_SOLVE_Z) + ENDIF + IF(allocated(CURRENT_POS_T))THEN + DEALLOCATE(CURRENT_POS_T) + ENDIF + IF(allocated(CURRENT_POS_B))THEN + DEALLOCATE(CURRENT_POS_B) + ENDIF + IF(allocated(POS_HOLE_T))THEN + DEALLOCATE(POS_HOLE_T) + ENDIF + IF(allocated(POS_HOLE_B))THEN + DEALLOCATE(POS_HOLE_B) + ENDIF + IF(allocated(OOC_STATE_NODE))THEN + DEALLOCATE(OOC_STATE_NODE) + ENDIF + IF(allocated(POS_IN_MEM))THEN + DEALLOCATE(POS_IN_MEM) + ENDIF + IF(allocated(INODE_TO_POS))THEN + DEALLOCATE(INODE_TO_POS) + ENDIF + IF(allocated(IO_REQ))THEN + DEALLOCATE(IO_REQ) + ENDIF + IF(allocated(SIZE_OF_READ))THEN + DEALLOCATE(SIZE_OF_READ) + ENDIF + IF(allocated(FIRST_POS_IN_READ))THEN + DEALLOCATE(FIRST_POS_IN_READ) + ENDIF + IF(allocated(READ_DEST))THEN + DEALLOCATE(READ_DEST) + ENDIF + IF(allocated(READ_MNG))THEN + DEALLOCATE(READ_MNG) + ENDIF + IF(allocated(REQ_TO_ZONE))THEN + DEALLOCATE(REQ_TO_ZONE) + ENDIF + IF(allocated(REQ_ID))THEN + DEALLOCATE(REQ_ID) + ENDIF + SOLVE_OR_FACTO=1 + CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + END SUBROUTINE ZMUMPS_582 + SUBROUTINE ZMUMPS_612(PTRFAC,NSTEPS, + & A,LA) + IMPLICIT NONE + INTEGER, INTENT(in) :: NSTEPS + INTEGER(8), INTENT(INOUT) :: PTRFAC(NSTEPS) + INTEGER(8), INTENT(IN) :: LA + COMPLEX(kind=8) :: A(LA) + INTEGER :: I, TMP, ZONE, IPAS, IBEG, IEND + INTEGER(8) :: SAVE_PTR + LOGICAL :: COMPRESS_TO_BE_DONE, SET_POS_SEQUENCE + INTEGER :: J, IERR + INTEGER(8) :: DUMMY_SIZE + COMPRESS_TO_BE_DONE = .FALSE. + DUMMY_SIZE = 1_8 + IERR = 0 + SET_POS_SEQUENCE = .TRUE. + IF(SOLVE_STEP.EQ.0)THEN + IBEG = 1 + IEND = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + IPAS = 1 + ELSE + IBEG = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + IEND = 1 + IPAS = -1 + ENDIF + DO I=IBEG,IEND,IPAS + J = OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + TMP=INODE_TO_POS(STEP_OOC(J)) + IF(TMP.EQ.0)THEN + IF (SET_POS_SEQUENCE) THEN + SET_POS_SEQUENCE = .FALSE. + CUR_POS_SEQUENCE = I + ENDIF + IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN + OOC_STATE_NODE(STEP_OOC(J)) = NOT_IN_MEM + ENDIF + CYCLE + ELSE IF(TMP.LT.0)THEN + IF(TMP.GT.-(N_OOC+1)*NB_Z)THEN + SAVE_PTR=PTRFAC(STEP_OOC(J)) + PTRFAC(STEP_OOC(J)) = abs(SAVE_PTR) + CALL ZMUMPS_600(J, + & ZONE,PTRFAC,NSTEPS) + PTRFAC(STEP_OOC(J)) = SAVE_PTR + IF(ZONE.EQ.NB_Z)THEN + IF(J.NE.SPECIAL_ROOT_NODE)THEN + WRITE(*,*)MYID_OOC,': Internal error 6 ', + & ' Node ', J, + & ' is in status USED in the + & emmergency buffer ' + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0) + & THEN + IF (OOC_STATE_NODE(STEP_OOC(J)).EQ.NOT_IN_MEM) THEN + OOC_STATE_NODE(STEP_OOC(J)) = USED + IF((SOLVE_STEP.NE.0).OR.(J.NE.SPECIAL_ROOT_NODE) + & .OR.(ZONE.NE.NB_Z))THEN + CALL ZMUMPS_599(J,PTRFAC,NSTEPS) + ENDIF + CYCLE + ELSEIF(OOC_STATE_NODE(STEP_OOC(J)).EQ.ALREADY_USED) + & THEN + COMPRESS_TO_BE_DONE = .TRUE. + ELSE + WRITE(*,*)MYID_OOC,': Internal error Mila 4 ', + & ' wrong node status :', OOC_STATE_NODE(STEP_OOC(J)), + & ' on node ', J + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN + CALL ZMUMPS_599(J,PTRFAC,NSTEPS) + ENDIF + ENDIF + ENDIF + ENDDO + IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0) + & THEN + IF (COMPRESS_TO_BE_DONE) THEN + DO ZONE=1,NB_Z-1 + CALL ZMUMPS_608(A,LA, + & DUMMY_SIZE,PTRFAC, + & NSTEPS,ZONE,IERR) + IF (IERR .LT. 0) THEN + WRITE(*,*)MYID_OOC,': Internal error Mila 5 ', + & ' IERR on return to ZMUMPS_608 =', + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_612 + SUBROUTINE ZMUMPS_583(PTRFAC,NSTEPS,MTYPE, + & A,LA,DOPREFETCH,IERR) + IMPLICIT NONE + INTEGER NSTEPS,MTYPE + INTEGER, intent(out)::IERR + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER(8) :: PTRFAC(NSTEPS) + LOGICAL DOPREFETCH + INTEGER MUMPS_808 + EXTERNAL MUMPS_808 + IERR = 0 + OOC_FCT_TYPE=MUMPS_808("F",MTYPE,KEEP_OOC(201), + & KEEP_OOC(50)) + OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1 + IF (KEEP_OOC(201).NE.1) THEN + OOC_SOLVE_TYPE_FCT = FCT + ENDIF + SOLVE_STEP=0 + CUR_POS_SEQUENCE=1 + MTYPE_OOC=MTYPE + IF ( KEEP_OOC(201).NE.1 +#if ! defined(TEMP_VERSION_TO_FORCE_DATA_REINIT) + & .OR. KEEP_OOC(50).NE.0 +#endif + & ) THEN + CALL ZMUMPS_612(PTRFAC,NSTEPS,A,LA) + ELSE + CALL ZMUMPS_683(KEEP_OOC(28), + & KEEP_OOC(38), KEEP_OOC(20) ) + ENDIF + IF (DOPREFETCH) THEN + CALL ZMUMPS_585(A,LA,PTRFAC, + & KEEP_OOC(28),IERR) + ELSE + CUR_POS_SEQUENCE = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_583 + SUBROUTINE ZMUMPS_584(PTRFAC,NSTEPS,MTYPE, + & I_WORKED_ON_ROOT,IROOT,A,LA,IERR) + IMPLICIT NONE + INTEGER NSTEPS + INTEGER(8) :: LA + INTEGER(8) :: PTRFAC(NSTEPS) + INTEGER MTYPE + INTEGER IROOT + LOGICAL I_WORKED_ON_ROOT + INTEGER, intent(out):: IERR + COMPLEX(kind=8) A(LA) + INTEGER(8) :: DUMMY_SIZE + INTEGER ZONE + INTEGER MUMPS_808 + EXTERNAL MUMPS_808 + IERR=0 + OOC_FCT_TYPE=MUMPS_808("B",MTYPE,KEEP_OOC(201), + & KEEP_OOC(50)) + OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1 + IF (KEEP_OOC(201).NE.1) OOC_SOLVE_TYPE_FCT=FCT + SOLVE_STEP=1 + CUR_POS_SEQUENCE=TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) + MTYPE_OOC=MTYPE + IF ( KEEP_OOC(201).NE.1 +#if ! defined(TEMP_VERSION_TO_FORCE_DATA_REINIT) + & .OR. KEEP_OOC(50).NE.0 +#endif + & ) THEN + CALL ZMUMPS_612(PTRFAC,NSTEPS,A,LA) + IF (I_WORKED_ON_ROOT) THEN + CALL ZMUMPS_598 ( IROOT, + & PTRFAC, KEEP_OOC(28), A, LA,.FALSE.,IERR) + IF (IERR .LT. 0) RETURN + CALL ZMUMPS_600(IROOT, + & ZONE,PTRFAC,NSTEPS) + IF(IROOT.EQ.NB_Z)THEN + DUMMY_SIZE=1_8 + CALL ZMUMPS_608(A,LA, + & DUMMY_SIZE,PTRFAC, + & NSTEPS,NB_Z,IERR) + IF (IERR .LT. 0) THEN + WRITE(*,*)MYID_OOC,': Internal error in + & ZMUMPS_608', + & IERR + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + IF (NB_Z.GT.1) THEN + CALL ZMUMPS_594(A,LA,PTRFAC, + & KEEP_OOC(28),IERR) + IF (IERR .LT. 0) RETURN + ENDIF + ELSE + CALL ZMUMPS_683(KEEP_OOC(28), + & KEEP_OOC(38), KEEP_OOC(20) ) + CALL ZMUMPS_585(A,LA,PTRFAC,KEEP_OOC(28),IERR) + IF (IERR .LT. 0 ) RETURN + ENDIF + RETURN + END SUBROUTINE ZMUMPS_584 + SUBROUTINE ZMUMPS_613(id,IERR) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(ZMUMPS_STRUC), TARGET :: id + INTEGER, intent(out) :: IERR + INTEGER I,DIM,J,TMP,SIZE,K,I1 + CHARACTER*1 TMP_NAME(350) + EXTERNAL MUMPS_OOC_GET_NB_FILES_C, MUMPS_OOC_GET_FILE_NAME_C + IERR=0 + SIZE=0 + DO J=1,OOC_NB_FILE_TYPE + TMP=J-1 + CALL MUMPS_OOC_GET_NB_FILES_C(TMP,I) + id%OOC_NB_FILES(J)=I + SIZE=SIZE+I + ENDDO + IF(associated(id%OOC_FILE_NAMES))THEN + DEALLOCATE(id%OOC_FILE_NAMES) + NULLIFY(id%OOC_FILE_NAMES) + ENDIF + ALLOCATE(id%OOC_FILE_NAMES(SIZE,350),stat=IERR) + IF (IERR .GT. 0) THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_613' + IERR=-1 + IF(id%INFO(1).GE.0)THEN + id%INFO(1) = -13 + id%INFO(2) = SIZE*350 + RETURN + ENDIF + ENDIF + IF(associated(id%OOC_FILE_NAME_LENGTH))THEN + DEALLOCATE(id%OOC_FILE_NAME_LENGTH) + NULLIFY(id%OOC_FILE_NAME_LENGTH) + ENDIF + ALLOCATE(id%OOC_FILE_NAME_LENGTH(SIZE),stat=IERR) + IF (IERR .GT. 0) THEN + IERR=-1 + IF(id%INFO(1).GE.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) + & 'PB allocation in ZMUMPS_613' + id%INFO(1) = -13 + id%INFO(2) = SIZE + RETURN + ENDIF + ENDIF + K=1 + DO I1=1,OOC_NB_FILE_TYPE + TMP=I1-1 + DO I=1,id%OOC_NB_FILES(I1) + CALL MUMPS_OOC_GET_FILE_NAME_C(TMP,I,DIM,TMP_NAME(1)) + DO J=1,DIM+1 + id%OOC_FILE_NAMES(K,J)=TMP_NAME(J) + ENDDO + id%OOC_FILE_NAME_LENGTH(K)=DIM+1 + K=K+1 + ENDDO + ENDDO + END SUBROUTINE ZMUMPS_613 + SUBROUTINE ZMUMPS_614(id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(ZMUMPS_STRUC), TARGET :: id + CHARACTER*1 TMP_NAME(350) + INTEGER I,I1,TMP,J,K,L,DIM,IERR + INTEGER, DIMENSION(:),ALLOCATABLE :: NB_FILES + INTEGER K211 + ALLOCATE(NB_FILES(OOC_NB_FILE_TYPE),stat=IERR) + IF (IERR .GT. 0) THEN + IERR=-1 + IF(id%INFO(1).GE.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*) + & 'PB allocation in ZMUMPS_614' + id%INFO(1) = -13 + id%INFO(2) = OOC_NB_FILE_TYPE + RETURN + ENDIF + ENDIF + IERR=0 + NB_FILES=id%OOC_NB_FILES + I=id%MYID + K=id%KEEP(35) + L=mod(id%KEEP(204),3) + K211=id%KEEP(211) + CALL MUMPS_OOC_ALLOC_POINTERS_C(OOC_NB_FILE_TYPE,NB_FILES,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + CALL MUMPS_OOC_INIT_VARS_C(I,K,L,K211,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + K=1 + DO I1=1,OOC_NB_FILE_TYPE + DO I=1,NB_FILES(I1) + DIM=id%OOC_FILE_NAME_LENGTH(K) + DO J=1,DIM + TMP_NAME(J)=id%OOC_FILE_NAMES(K,J) + ENDDO + TMP=I1-1 + CALL MUMPS_OOC_SET_FILE_NAME_C(TMP,I,DIM,IERR,TMP_NAME(1)) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ', + & ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + K=K+1 + ENDDO + ENDDO + CALL MUMPS_OOC_START_LOW_LEVEL(IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1.GT.0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + id%INFO(1)=IERR + RETURN + ENDIF + DEALLOCATE(NB_FILES) + RETURN + END SUBROUTINE ZMUMPS_614 + SUBROUTINE ZMUMPS_589(DEST,SRC,NB,NB_EFF) + IMPLICIT NONE + INTEGER NB, NB_EFF + CHARACTER(LEN=NB) SRC + CHARACTER*1 DEST(NB) + INTEGER I + DO I=1,NB_EFF + DEST(I)=SRC(I:I) + ENDDO + END SUBROUTINE ZMUMPS_589 + SUBROUTINE ZMUMPS_580(IERR) + USE ZMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, intent(out) :: IERR + IERR=0 + IF(.NOT.WITH_BUF)THEN + RETURN + ENDIF + CALL ZMUMPS_707(OOC_FCT_TYPE,IERR) + IF (IERR < 0) THEN + RETURN + ENDIF + RETURN + END SUBROUTINE ZMUMPS_580 + SUBROUTINE ZMUMPS_681(IERR) + USE ZMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, intent(out) :: IERR + INTEGER I + IERR=0 + IF(.NOT.WITH_BUF)THEN + RETURN + ENDIF + DO I=1,OOC_NB_FILE_TYPE + CALL ZMUMPS_707(I,IERR) + IF (IERR < 0) RETURN + ENDDO + RETURN + END SUBROUTINE ZMUMPS_681 + SUBROUTINE ZMUMPS_683(NSTEPS, + & KEEP38, KEEP20) + IMPLICIT NONE + INTEGER NSTEPS + INTEGER I, J + INTEGER(8) :: TMP_SIZE8 + INTEGER KEEP38, KEEP20 + INODE_TO_POS = 0 + POS_IN_MEM = 0 + OOC_STATE_NODE(1:NSTEPS)=0 + TMP_SIZE8=1_8 + J=1 + DO I=1,NB_Z-1 + IDEB_SOLVE_Z(I)=TMP_SIZE8 + PDEB_SOLVE_Z(I)=J + POSFAC_SOLVE(I)=TMP_SIZE8 + LRLUS_SOLVE(I) =SIZE_ZONE_SOLVE + LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE + LRLU_SOLVE_B(I)=0_8 + SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE + CURRENT_POS_T(I)=J + CURRENT_POS_B(I)=J + POS_HOLE_T(I) =J + POS_HOLE_B(I) =J + J = J + MAX_NB_NODES_FOR_ZONE + TMP_SIZE8 = TMP_SIZE8 + SIZE_ZONE_SOLVE + ENDDO + IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8 + PDEB_SOLVE_Z(NB_Z)=J + POSFAC_SOLVE(NB_Z)=TMP_SIZE8 + LRLUS_SOLVE(NB_Z) =SIZE_SOLVE_EMM + LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM + LRLU_SOLVE_B(NB_Z)=0_8 + SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM + CURRENT_POS_T(NB_Z)=J + CURRENT_POS_B(NB_Z)=J + POS_HOLE_T(NB_Z) =J + POS_HOLE_B(NB_Z) =J + IO_REQ=-77777 + SIZE_OF_READ=-9999_8 + FIRST_POS_IN_READ=-9999 + READ_DEST=-9999_8 + READ_MNG=-9999 + REQ_TO_ZONE=-9999 + REQ_ID=-9999 + RETURN + END SUBROUTINE ZMUMPS_683 + SUBROUTINE ZMUMPS_688 + & ( STRAT, TYPEFile, + & AFAC, LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW, LIWFAC, + & MYID, FILESIZE, IERR , LAST_CALL) + IMPLICIT NONE + TYPE(IO_BLOCK), INTENT(INOUT):: MonBloc + INTEGER(8) :: LAFAC + INTEGER, INTENT(IN) :: STRAT, LIWFAC, + & MYID, TYPEFile + INTEGER, INTENT(INOUT) :: IW(0:LIWFAC-1) + COMPLEX(kind=8), INTENT(IN) :: AFAC(LAFAC) + INTEGER, INTENT(INOUT) :: LNextPiv2beWritten, + & UNextPiv2beWritten + INTEGER(8), INTENT(INOUT) :: FILESIZE + INTEGER, INTENT(OUT) :: IERR + LOGICAL, INTENT(IN) :: LAST_CALL + INTEGER(8) :: TMPSIZE_OF_BLOCK + INTEGER :: TempFTYPE + LOGICAL WRITE_L, WRITE_U + LOGICAL DO_U_FIRST + INCLUDE 'mumps_headers.h' + IERR = 0 + IF (KEEP_OOC(50).EQ.0 + & .AND.KEEP_OOC(251).EQ.2) THEN + WRITE_L = .FALSE. + ELSE + WRITE_L = (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_L) + ENDIF + WRITE_U = (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_U) + DO_U_FIRST = .FALSE. + IF ( TYPEFile.EQ.TYPEF_BOTH_LU ) THEN + IF ( LNextPiv2beWritten .GT. UNextPiv2beWritten ) THEN + DO_U_FIRST = .TRUE. + END IF + END IF + IF (DO_U_FIRST) GOTO 200 + 100 IF (WRITE_L .AND. TYPEF_L > 0 ) THEN + TempFTYPE = TYPEF_L + IF ((MonBloc%Typenode.EQ.2).AND.(.NOT.MonBloc%MASTER)) + & THEN + TMPSIZE_OF_BLOCK = SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE), + & TempFTYPE) + IF (TMPSIZE_OF_BLOCK .LT. 0_8) THEN + TMPSIZE_OF_BLOCK = -TMPSIZE_OF_BLOCK - 1_8 + ENDIF + LNextPiv2beWritten = + & int( + & TMPSIZE_OF_BLOCK + & / int(MonBloc%NROW,8) + & ) + & + 1 + ENDIF + CALL ZMUMPS_695( STRAT, + & TempFTYPE, AFAC, LAFAC, MonBloc, + & IERR, + & LNextPiv2beWritten, + & OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE), + & SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE), + & FILESIZE, LAST_CALL ) + IF (IERR .LT. 0) RETURN + IF (DO_U_FIRST) GOTO 300 + ENDIF + 200 IF (WRITE_U) THEN + TempFTYPE = TYPEF_U + CALL ZMUMPS_695( STRAT, + & TempFTYPE, AFAC, LAFAC, MonBloc, + & IERR, + & UNextPiv2beWritten, + & OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE), + & SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE), + & FILESIZE, LAST_CALL) + IF (IERR .LT. 0) RETURN + IF (DO_U_FIRST) GOTO 100 + ENDIF + 300 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_688 + SUBROUTINE ZMUMPS_695( STRAT, TYPEF, + & AFAC, LAFAC, MonBloc, + & IERR, + & LorU_NextPiv2beWritten, + & LorU_AddVirtNodeI8, LorUSIZE_OF_BLOCK, + & FILESIZE, LAST_CALL + & ) + USE ZMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, INTENT(IN) :: STRAT + INTEGER, INTENT(IN) :: TYPEF + INTEGER(8), INTENT(INOUT) :: FILESIZE + INTEGER(8), INTENT(IN) :: LAFAC + COMPLEX(kind=8), INTENT(IN) :: AFAC(LAFAC) + INTEGER, INTENT(INOUT) :: LorU_NextPiv2beWritten + INTEGER(8), INTENT(INOUT) :: LorU_AddVirtNodeI8 + INTEGER(8), INTENT(INOUT) :: LorUSIZE_OF_BLOCK + TYPE(IO_BLOCK), INTENT(INOUT) :: MonBloc + INTEGER, INTENT(OUT) :: IERR + LOGICAL, INTENT(IN) :: LAST_CALL + INTEGER NNMAX + INTEGER(8) :: TOTSIZE, EFFSIZE + INTEGER(8) :: TailleEcrite + INTEGER SIZE_PANEL + INTEGER(8) :: AddVirtCour + LOGICAL VIRT_ADD_RESERVED_BEF_CALL + LOGICAL VIRTUAL_ADDRESS_JUST_RESERVED + LOGICAL HOLE_PROCESSED_BEFORE_CALL + LOGICAL TMP_ESTIM + INTEGER ICUR, INODE_CUR, ILAST + INTEGER(8) :: ADDR_LAST + IERR = 0 + IF (TYPEF == TYPEF_L ) THEN + NNMAX = MonBloc%NROW + ELSE + NNMAX = MonBloc%NCOL + ENDIF + SIZE_PANEL = ZMUMPS_690(NNMAX) + IF ( (.NOT.MonBloc%Last) .AND. + & (MonBloc%LastPiv-LorU_NextPiv2beWritten+1.LT.SIZE_PANEL)) + & THEN + RETURN + ENDIF + TMP_ESTIM = .TRUE. + TOTSIZE = ZMUMPS_725 + & (MonBloc%NFS, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM) + IF (MonBloc%Last) THEN + TMP_ESTIM=.FALSE. + EFFSIZE = ZMUMPS_725 + & (MonBloc%LastPiv, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM) + ELSE + EFFSIZE = -1034039740327_8 + ENDIF + IF (MonBloc%Typenode.EQ.3.AND. MonBloc%NFS.NE.MonBloc%NCOL) THEN + WRITE(*,*) 'Internal error in ZMUMPS_695 for type3', + & MonBloc%NFS,MonBloc%NCOL + CALL MUMPS_ABORT() + ENDIF + IF (MonBloc%Typenode.EQ.3.AND. TYPEF.NE.TYPEF_L) THEN + WRITE(*,*) 'Internal error in ZMUMPS_695,TYPEF=', + & TYPEF, 'for typenode=3' + CALL MUMPS_ABORT() + ENDIF + IF (MonBloc%Typenode.EQ.2.AND. + & TYPEF.EQ.TYPEF_U.AND. + & .NOT. MonBloc%MASTER ) THEN + WRITE(*,*) 'Internal error in ZMUMPS_695', + & MonBloc%MASTER,MonBloc%Typenode, TYPEF + CALL MUMPS_ABORT() + ENDIF + HOLE_PROCESSED_BEFORE_CALL = (LorUSIZE_OF_BLOCK .LT. 0_8) + IF (HOLE_PROCESSED_BEFORE_CALL.AND.(.NOT.MonBloc%Last)) THEN + WRITE(6,*) ' Internal error in ZMUMPS_695 ', + & ' last is false after earlier calls with last=true' + CALL MUMPS_ABORT() + ENDIF + IF (HOLE_PROCESSED_BEFORE_CALL) THEN + LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 + TOTSIZE = -99999999_8 + ENDIF + VIRTUAL_ADDRESS_JUST_RESERVED = .FALSE. + VIRT_ADD_RESERVED_BEF_CALL = + & ( LorUSIZE_OF_BLOCK .NE. 0_8 .OR. + & HOLE_PROCESSED_BEFORE_CALL ) + IF (MonBloc%Last .AND. .NOT. HOLE_PROCESSED_BEFORE_CALL) THEN + KEEP_OOC(228) = max(KEEP_OOC(228), + & (MonBloc%LastPiv+SIZE_PANEL-1) / SIZE_PANEL) + IF (VIRT_ADD_RESERVED_BEF_CALL) THEN + IF (AddVirtLibre(TYPEF).EQ. + & (LorU_AddVirtNodeI8+TOTSIZE) ) THEN + AddVirtLibre(TYPEF) = LorU_AddVirtNodeI8 + EFFSIZE + ENDIF + ELSE + VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE. + IF (EFFSIZE .EQ. 0_8) THEN + LorU_AddVirtNodeI8 = -9999_8 + ELSE + LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF) + ENDIF + AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + EFFSIZE + ENDIF + ELSE + IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL + & ) THEN + LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF) + AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + TOTSIZE + ENDIF + ENDIF + AddVirtCour = LorU_AddVirtNodeI8 + LorUSIZE_OF_BLOCK + CALL ZMUMPS_697( STRAT, TYPEF, MonBloc, + & SIZE_PANEL, + & AFAC, LAFAC, + & LorU_NextPiv2beWritten, AddVirtCour, + & TailleEcrite, + & IERR ) + IF ( IERR .LT. 0 ) RETURN + LorUSIZE_OF_BLOCK = LorUSIZE_OF_BLOCK + TailleEcrite + IF (LorUSIZE_OF_BLOCK.EQ.0_8 ) THEN + IF ( .NOT. VIRT_ADD_RESERVED_BEF_CALL + & .AND. .NOT. VIRTUAL_ADDRESS_JUST_RESERVED ) + & THEN + AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) - TOTSIZE + LorU_AddVirtNodeI8 = 0_8 + ENDIF + ELSE IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL ) THEN + VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE. + ENDIF + IF ( VIRTUAL_ADDRESS_JUST_RESERVED) THEN + OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(TYPEF), + & TYPEF) = MonBloc%INODE + I_CUR_HBUF_NEXTPOS(TYPEF) = I_CUR_HBUF_NEXTPOS(TYPEF) + 1 + IF (MonBloc%Last) THEN + MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,EFFSIZE) + TMP_SIZE_FACT=TMP_SIZE_FACT+EFFSIZE + ELSE + MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,TOTSIZE) + TMP_SIZE_FACT=TMP_SIZE_FACT+TOTSIZE + ENDIF + TMP_NB_NODES=TMP_NB_NODES+1 + IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN + MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE, + & TMP_NB_NODES) + TMP_SIZE_FACT=0_8 + TMP_NB_NODES=0 + ENDIF + ENDIF + IF (MonBloc%Last) THEN + LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 + ENDIF + IF (LAST_CALL) THEN + IF (.NOT.MonBloc%Last) THEN + WRITE(6,*) ' Internal error in ZMUMPS_695 ', + & ' LAST and LAST_CALL are incompatible ' + CALL MUMPS_ABORT() + ENDIF + LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 + ICUR = I_CUR_HBUF_NEXTPOS(TYPEF) - 1 + INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF) + ADDR_LAST = AddVirtLibre(TYPEF) + IF (INODE_CUR .NE. MonBloc%INODE) THEN + 10 CONTINUE + ILAST = ICUR + IF ( OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF) .NE. -9999_8) THEN + ADDR_LAST = OOC_VADDR(STEP_OOC(INODE_CUR), TYPEF) + ENDIF + ICUR = ICUR - 1 + INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF) + IF (INODE_CUR .EQ. MonBloc%INODE) THEN + LorUSIZE_OF_BLOCK = ADDR_LAST - + & OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF) + ELSE + IF (ICUR .LE. 1) THEN + WRITE(*,*) "Internal error in ZMUMPS_695" + WRITE(*,*) "Did not find current node in sequence" + CALL MUMPS_ABORT() + ENDIF + GOTO 10 + ENDIF + ENDIF + FILESIZE = FILESIZE + LorUSIZE_OF_BLOCK + ENDIF + RETURN + END SUBROUTINE ZMUMPS_695 + SUBROUTINE ZMUMPS_697( + & STRAT, TYPEF, MonBloc, + & SIZE_PANEL, + & AFAC, LAFAC, + & NextPiv2beWritten, AddVirtCour, + & TailleEcrite, IERR ) + USE ZMUMPS_OOC_BUFFER + IMPLICIT NONE + INTEGER, INTENT(IN) :: STRAT, TYPEF, SIZE_PANEL + INTEGER(8) :: LAFAC + INTEGER(8), INTENT(IN) :: AddVirtCour + COMPLEX(kind=8), INTENT(IN) :: AFAC(LAFAC) + INTEGER, INTENT(INOUT) :: NextPiv2beWritten + TYPE(IO_BLOCK),INTENT(INOUT) :: MonBloc + INTEGER(8), INTENT(OUT) :: TailleEcrite + INTEGER, INTENT(OUT) :: IERR + INTEGER :: I, NBeff, LPANELeff, IEND + INTEGER(8) :: AddVirtDeb + IERR = 0 + TailleEcrite = 0_8 + AddVirtDeb = AddVirtCour + I = NextPiv2beWritten + IF ( NextPiv2beWritten .GT. MonBloc%LastPiv ) THEN + RETURN + ENDIF + 10 CONTINUE + NBeff = min(SIZE_PANEL,MonBloc%LastPiv-I+1 ) + IF ((NBeff.NE.SIZE_PANEL) .AND. (.NOT.MonBloc%Last)) THEN + GOTO 20 + ENDIF + IF (TYPEF.EQ.TYPEF_L.AND.MonBloc%MASTER.AND. + & KEEP_OOC(50).EQ.2 .AND. MonBloc%Typenode.NE.3) THEN + IF (MonBloc%INDICES(NBeff+I-1) < 0) + & THEN + NBeff=NBeff+1 + ENDIF + ENDIF + IEND = I + NBeff -1 + CALL ZMUMPS_653( STRAT, TYPEF, MonBloc, + & AFAC, LAFAC, + & AddVirtDeb, I, IEND, LPANELeff, + & IERR) + IF ( IERR .LT. 0 ) THEN + RETURN + ENDIF + IF ( IERR .EQ. 1 ) THEN + IERR=0 + GOTO 20 + ENDIF + IF (TYPEF .EQ. TYPEF_L) THEN + MonBloc%LastPanelWritten_L = MonBloc%LastPanelWritten_L+1 + ELSE + MonBloc%LastPanelWritten_U = MonBloc%LastPanelWritten_U+1 + ENDIF + AddVirtDeb = AddVirtDeb + int(LPANELeff,8) + TailleEcrite = TailleEcrite + int(LPANELeff,8) + I=I+NBeff + IF ( I .LE. MonBloc%LastPiv ) GOTO 10 + 20 CONTINUE + NextPiv2beWritten = I + RETURN + END SUBROUTINE ZMUMPS_697 + INTEGER(8) FUNCTION ZMUMPS_725 + & (NFSorNPIV, NNMAX, SIZE_PANEL, MonBloc, ESTIM) + IMPLICIT NONE + TYPE(IO_BLOCK), INTENT(IN):: MonBloc + INTEGER, INTENT(IN) :: NFSorNPIV, NNMAX, SIZE_PANEL + LOGICAL, INTENT(IN) :: ESTIM + INTEGER :: I, NBeff + INTEGER(8) :: TOTSIZE + TOTSIZE = 0_8 + IF (NFSorNPIV.EQ.0) GOTO 100 + IF (.NOT. MonBloc%MASTER .OR. MonBloc%Typenode.EQ.3) THEN + TOTSIZE = int(NFSorNPIV,8) * int(NNMAX,8) + ELSE + I = 1 + 10 CONTINUE + NBeff = min(SIZE_PANEL, NFSorNPIV-I+1) + IF (KEEP_OOC(50).EQ.2) THEN + IF (ESTIM) THEN + NBeff = NBeff + 1 + ELSE + IF (MonBloc%INDICES(I+NBeff-1) < 0) THEN + NBeff = NBeff + 1 + ENDIF + ENDIF + ENDIF + TOTSIZE = TOTSIZE + + & int(NNMAX-I+1,8) * int(NBeff,8) + I = I + NBeff + IF ( I .LE. NFSorNPIV ) GOTO 10 + ENDIF + 100 CONTINUE + ZMUMPS_725 = TOTSIZE + RETURN + END FUNCTION ZMUMPS_725 + INTEGER FUNCTION ZMUMPS_690( NNMAX ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NNMAX + INTEGER ZMUMPS_748 + ZMUMPS_690=ZMUMPS_748( + & HBUF_SIZE, NNMAX, KEEP_OOC(227),KEEP_OOC(50)) + RETURN + END FUNCTION ZMUMPS_690 + SUBROUTINE ZMUMPS_728() + IMPLICIT NONE + INTEGER I,TMP_NODE + IF(.NOT.ZMUMPS_727())THEN + IF(SOLVE_STEP.EQ.0)THEN + I=CUR_POS_SEQUENCE + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE ((I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND. + & (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + & .EQ.0_8)) + INODE_TO_POS(STEP_OOC(TMP_NODE))=1 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + I=I+1 + IF(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + ENDIF + ENDDO + CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) + ELSE + I=CUR_POS_SEQUENCE + TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, + & OOC_FCT_TYPE) + DO WHILE ((I.GE.1).AND. + & (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) + & .EQ.0_8)) + INODE_TO_POS(STEP_OOC(TMP_NODE))=1 + OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED + I=I-1 + IF(I.GE.1)THEN + TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) + ENDIF + ENDDO + CUR_POS_SEQUENCE=max(I,1) + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_728 + SUBROUTINE ZMUMPS_809(N,KEEP201, + & Pruned_List,nb_prun_nodes,STEP) + IMPLICIT NONE + INTEGER, INTENT(IN) :: N, KEEP201, nb_prun_nodes + INTEGER, INTENT(IN) :: STEP(N), + & Pruned_List(nb_prun_nodes) + INTEGER I, ISTEP + IF (KEEP201 .GT. 0) THEN + OOC_STATE_NODE(:) = ALREADY_USED + DO I = 1, nb_prun_nodes + ISTEP = STEP(Pruned_List(I)) + OOC_STATE_NODE(ISTEP) = NOT_IN_MEM + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_809 + END MODULE ZMUMPS_OOC diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_ooc_buffer.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_ooc_buffer.F new file mode 100644 index 000000000..d90c2c373 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_ooc_buffer.F @@ -0,0 +1,570 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE ZMUMPS_OOC_BUFFER + USE MUMPS_OOC_COMMON + IMPLICIT NONE + PUBLIC + INTEGER FIRST_HBUF,SECOND_HBUF + PARAMETER (FIRST_HBUF=0, SECOND_HBUF=1) + INTEGER,SAVE :: OOC_FCT_TYPE_LOC + INTEGER IO_STRAT + COMPLEX(kind=8), DIMENSION(:),ALLOCATABLE :: BUF_IO + LOGICAL,SAVE :: PANEL_FLAG + INTEGER,SAVE :: EARLIEST_WRITE_MIN_SIZE + INTEGER(8),SAVE,DIMENSION(:), ALLOCATABLE :: + & I_SHIFT_FIRST_HBUF, I_SHIFT_SECOND_HBUF, + & I_SHIFT_CUR_HBUF, I_REL_POS_CUR_HBUF + INTEGER, SAVE, DIMENSION(:), ALLOCATABLE :: + & LAST_IOREQUEST, CUR_HBUF + INTEGER, DIMENSION(:),ALLOCATABLE :: I_CUR_HBUF_NEXTPOS + INTEGER,SAVE :: I_CUR_HBUF_FSTPOS, + & I_SUB_HBUF_FSTPOS + INTEGER(8) :: BufferEmpty + PARAMETER (BufferEmpty=-1_8) + INTEGER(8), DIMENSION(:),ALLOCATABLE :: NextAddVirtBuffer + INTEGER(8), DIMENSION(:),ALLOCATABLE :: FIRST_VADDR_IN_BUF + CONTAINS + SUBROUTINE ZMUMPS_689(TYPEF_ARG) + IMPLICIT NONE + INTEGER TYPEF_ARG + SELECT CASE(CUR_HBUF(TYPEF_ARG)) + CASE (FIRST_HBUF) + CUR_HBUF(TYPEF_ARG) = SECOND_HBUF + I_SHIFT_CUR_HBUF(TYPEF_ARG) = + & I_SHIFT_SECOND_HBUF(TYPEF_ARG) + CASE (SECOND_HBUF) + CUR_HBUF(TYPEF_ARG) = FIRST_HBUF + I_SHIFT_CUR_HBUF(TYPEF_ARG) = + & I_SHIFT_FIRST_HBUF(TYPEF_ARG) + END SELECT + IF(.NOT.PANEL_FLAG)THEN + I_SUB_HBUF_FSTPOS =I_CUR_HBUF_FSTPOS + I_CUR_HBUF_FSTPOS =I_CUR_HBUF_NEXTPOS(TYPEF_ARG) + ENDIF + I_REL_POS_CUR_HBUF(TYPEF_ARG) = 1_8 + RETURN + END SUBROUTINE ZMUMPS_689 + SUBROUTINE ZMUMPS_707(TYPEF_ARG,IERR) + IMPLICIT NONE + INTEGER TYPEF_ARG + INTEGER NEW_IOREQUEST + INTEGER IERR + IERR=0 + CALL ZMUMPS_696(TYPEF_ARG,NEW_IOREQUEST, + & IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IERR=0 + CALL MUMPS_WAIT_REQUEST(LAST_IOREQUEST(TYPEF_ARG),IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + LAST_IOREQUEST(TYPEF_ARG) = NEW_IOREQUEST + CALL ZMUMPS_689(TYPEF_ARG) + IF(PANEL_FLAG)THEN + NextAddVirtBuffer(TYPEF_ARG)=BufferEmpty + ENDIF + RETURN + END SUBROUTINE ZMUMPS_707 + SUBROUTINE ZMUMPS_675(IERR) + IMPLICIT NONE + INTEGER, intent(out) :: IERR + INTEGER TYPEF_LAST + INTEGER TYPEF_LOC + IERR = 0 + TYPEF_LAST = OOC_NB_FILE_TYPE + DO TYPEF_LOC = 1, TYPEF_LAST + IERR=0 + CALL ZMUMPS_707(TYPEF_LOC,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + IERR=0 + CALL ZMUMPS_707(TYPEF_LOC,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_675 + SUBROUTINE ZMUMPS_696(TYPEF_ARG,IOREQUEST, + & IERR) + IMPLICIT NONE + INTEGER IOREQUEST,IERR + INTEGER TYPEF_ARG + INTEGER FIRST_INODE + INTEGER(8) :: FROM_BUFIO_POS, SIZE + INTEGER TYPE + INTEGER ADDR_INT1,ADDR_INT2 + INTEGER(8) TMP_VADDR + INTEGER SIZE_INT1,SIZE_INT2 + IERR=0 + IF (I_REL_POS_CUR_HBUF(TYPEF_ARG) == 1_8) THEN + IOREQUEST=-1 + RETURN + END IF + IF(PANEL_FLAG)THEN + TYPE=TYPEF_ARG-1 + FIRST_INODE=-9999 + TMP_VADDR=FIRST_VADDR_IN_BUF(TYPEF_ARG) + ELSE + TYPE=FCT + FIRST_INODE = + & OOC_INODE_SEQUENCE(I_CUR_HBUF_FSTPOS,TYPEF_ARG) + TMP_VADDR=OOC_VADDR(STEP_OOC(FIRST_INODE),TYPEF_ARG) + ENDIF + FROM_BUFIO_POS=I_SHIFT_CUR_HBUF(TYPEF_ARG)+1_8 + SIZE = I_REL_POS_CUR_HBUF(TYPEF_ARG)-1_8 + CALL MUMPS_677(ADDR_INT1,ADDR_INT2, + & TMP_VADDR) + CALL MUMPS_677(SIZE_INT1,SIZE_INT2, + & SIZE) + CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, + & BUF_IO(FROM_BUFIO_POS),SIZE_INT1,SIZE_INT2, + & FIRST_INODE,IOREQUEST, + & TYPE,ADDR_INT1,ADDR_INT2,IERR) + IF(IERR.LT.0)THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ENDIF + RETURN + END SUBROUTINE ZMUMPS_696 + SUBROUTINE ZMUMPS_669(I1,I2,IERR) + IMPLICIT NONE + INTEGER I1,I2,IERR + INTEGER allocok + IERR=0 + PANEL_FLAG=.FALSE. + IF(allocated(I_SHIFT_FIRST_HBUF))THEN + DEALLOCATE(I_SHIFT_FIRST_HBUF) + ENDIF + IF(allocated(I_SHIFT_SECOND_HBUF))THEN + DEALLOCATE(I_SHIFT_SECOND_HBUF) + ENDIF + IF(allocated(I_SHIFT_CUR_HBUF))THEN + DEALLOCATE(I_SHIFT_CUR_HBUF) + ENDIF + IF(allocated(I_REL_POS_CUR_HBUF))THEN + DEALLOCATE(I_REL_POS_CUR_HBUF) + ENDIF + IF(allocated(LAST_IOREQUEST))THEN + DEALLOCATE(LAST_IOREQUEST) + ENDIF + IF(allocated(CUR_HBUF))THEN + DEALLOCATE(CUR_HBUF) + ENDIF + DIM_BUF_IO = int(KEEP_OOC(100),8) + ALLOCATE(I_SHIFT_FIRST_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(I_SHIFT_SECOND_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(I_SHIFT_CUR_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(I_REL_POS_CUR_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(LAST_IOREQUEST(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + ALLOCATE(CUR_HBUF(OOC_NB_FILE_TYPE), + & stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC' + I1 = -13 + I2 = OOC_NB_FILE_TYPE + IERR=-1 + RETURN + ENDIF + OOC_FCT_TYPE_LOC=OOC_NB_FILE_TYPE + ALLOCATE(BUF_IO(DIM_BUF_IO), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC' + I1 = -13 + CALL MUMPS_731(DIM_BUF_IO, I2) + RETURN + ENDIF + PANEL_FLAG=(KEEP_OOC(201).EQ.1) + IF (PANEL_FLAG) THEN + IERR=0 + KEEP_OOC(228)=0 + IF(allocated(AddVirtLibre))THEN + DEALLOCATE(AddVirtLibre) + ENDIF + ALLOCATE(AddVirtLibre(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC_BUF_PANEL' + IERR=-1 + I1=-13 + I2=OOC_NB_FILE_TYPE + RETURN + ENDIF + AddVirtLibre(1:OOC_NB_FILE_TYPE)=0_8 + IF(allocated(NextAddVirtBuffer))THEN + DEALLOCATE(NextAddVirtBuffer) + ENDIF + ALLOCATE(NextAddVirtBuffer(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC_BUF_PANEL' + IERR=-1 + I1=-13 + I2=OOC_NB_FILE_TYPE + RETURN + ENDIF + NextAddVirtBuffer (1:OOC_NB_FILE_TYPE) = BufferEmpty + IF(allocated(FIRST_VADDR_IN_BUF))THEN + DEALLOCATE(FIRST_VADDR_IN_BUF) + ENDIF + ALLOCATE(FIRST_VADDR_IN_BUF(OOC_NB_FILE_TYPE), stat=allocok) + IF (allocok > 0) THEN + IF (ICNTL1>0) + & WRITE(ICNTL1,*) 'PB allocation in ZMUMPS_INIT_OOC_BUF_PANEL' + IERR=-1 + I1=-13 + I2=OOC_NB_FILE_TYPE + RETURN + ENDIF + CALL ZMUMPS_686() + ELSE + CALL ZMUMPS_685() + ENDIF + RETURN + END SUBROUTINE ZMUMPS_669 + SUBROUTINE ZMUMPS_659() + IMPLICIT NONE + IF(allocated(BUF_IO))THEN + DEALLOCATE(BUF_IO) + ENDIF + IF(allocated(I_SHIFT_FIRST_HBUF))THEN + DEALLOCATE(I_SHIFT_FIRST_HBUF) + ENDIF + IF(allocated(I_SHIFT_SECOND_HBUF))THEN + DEALLOCATE(I_SHIFT_SECOND_HBUF) + ENDIF + IF(allocated(I_SHIFT_CUR_HBUF))THEN + DEALLOCATE(I_SHIFT_CUR_HBUF) + ENDIF + IF(allocated(I_REL_POS_CUR_HBUF))THEN + DEALLOCATE(I_REL_POS_CUR_HBUF) + ENDIF + IF(allocated(LAST_IOREQUEST))THEN + DEALLOCATE(LAST_IOREQUEST) + ENDIF + IF(allocated(CUR_HBUF))THEN + DEALLOCATE(CUR_HBUF) + ENDIF + IF(PANEL_FLAG)THEN + IF(allocated(NextAddVirtBuffer))THEN + DEALLOCATE(NextAddVirtBuffer) + ENDIF + IF(allocated(AddVirtLibre))THEN + DEALLOCATE(AddVirtLibre) + ENDIF + IF(allocated(FIRST_VADDR_IN_BUF))THEN + DEALLOCATE(FIRST_VADDR_IN_BUF) + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_659 + SUBROUTINE ZMUMPS_685() + IMPLICIT NONE + OOC_FCT_TYPE_LOC=1 + HBUF_SIZE = DIM_BUF_IO / int(2,kind=kind(DIM_BUF_IO)) + EARLIEST_WRITE_MIN_SIZE = 0 + I_SHIFT_FIRST_HBUF(OOC_FCT_TYPE_LOC) = 0_8 + I_SHIFT_SECOND_HBUF(OOC_FCT_TYPE_LOC) = HBUF_SIZE + LAST_IOREQUEST(OOC_FCT_TYPE_LOC) = -1 + I_CUR_HBUF_NEXTPOS = 1 + I_CUR_HBUF_FSTPOS = 1 + I_SUB_HBUF_FSTPOS = 1 + CUR_HBUF(OOC_FCT_TYPE_LOC) = SECOND_HBUF + CALL ZMUMPS_689(OOC_FCT_TYPE_LOC) + END SUBROUTINE ZMUMPS_685 + SUBROUTINE ZMUMPS_678(BLOCK,SIZE_OF_BLOCK, + & IERR) + IMPLICIT NONE + INTEGER(8) :: SIZE_OF_BLOCK + COMPLEX(kind=8) BLOCK(SIZE_OF_BLOCK) + INTEGER, intent(out) :: IERR + INTEGER(8) :: I + IERR=0 + IF (I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) + + & SIZE_OF_BLOCK <= HBUF_SIZE + 1_8) THEN + ELSE + CALL ZMUMPS_707(OOC_FCT_TYPE_LOC,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + END IF + DO I = 1_8, SIZE_OF_BLOCK + BUF_IO(I_SHIFT_CUR_HBUF(OOC_FCT_TYPE_LOC) + + & I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) + I - 1_8) = + & BLOCK(I) + END DO + I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) = + & I_REL_POS_CUR_HBUF(OOC_FCT_TYPE_LOC) + SIZE_OF_BLOCK + RETURN + END SUBROUTINE ZMUMPS_678 + SUBROUTINE ZMUMPS_686() + IMPLICIT NONE + INTEGER(8) :: DIM_BUF_IO_L_OR_U + INTEGER TYPEF, TYPEF_LAST + INTEGER NB_DOUBLE_BUFFERS + TYPEF_LAST = OOC_NB_FILE_TYPE + NB_DOUBLE_BUFFERS = OOC_NB_FILE_TYPE + DIM_BUF_IO_L_OR_U = DIM_BUF_IO / + & int(NB_DOUBLE_BUFFERS,kind=kind(DIM_BUF_IO_L_OR_U)) + IF(.NOT.STRAT_IO_ASYNC)THEN + HBUF_SIZE = DIM_BUF_IO_L_OR_U + ELSE + HBUF_SIZE = DIM_BUF_IO_L_OR_U / 2_8 + ENDIF + DO TYPEF = 1, TYPEF_LAST + LAST_IOREQUEST(TYPEF) = -1 + IF (TYPEF == 1 ) THEN + I_SHIFT_FIRST_HBUF(TYPEF) = 0_8 + ELSE + I_SHIFT_FIRST_HBUF(TYPEF) = DIM_BUF_IO_L_OR_U + ENDIF + IF(.NOT.STRAT_IO_ASYNC)THEN + I_SHIFT_SECOND_HBUF(TYPEF) = I_SHIFT_FIRST_HBUF(TYPEF) + ELSE + I_SHIFT_SECOND_HBUF(TYPEF) = I_SHIFT_FIRST_HBUF(TYPEF) + + & HBUF_SIZE + ENDIF + CUR_HBUF(TYPEF) = SECOND_HBUF + CALL ZMUMPS_689(TYPEF) + ENDDO + I_CUR_HBUF_NEXTPOS = 1 + RETURN + END SUBROUTINE ZMUMPS_686 + SUBROUTINE ZMUMPS_706(TYPEF,IERR) + IMPLICIT NONE + INTEGER, INTENT(in) :: TYPEF + INTEGER, INTENT(out) :: IERR + INTEGER IFLAG + INTEGER NEW_IOREQUEST + IERR=0 + CALL MUMPS_TEST_REQUEST_C(LAST_IOREQUEST(TYPEF),IFLAG, + & IERR) + IF (IFLAG.EQ.1) THEN + IERR = 0 + CALL ZMUMPS_696(TYPEF, + & NEW_IOREQUEST, + & IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + LAST_IOREQUEST(TYPEF) = NEW_IOREQUEST + CALL ZMUMPS_689(TYPEF) + NextAddVirtBuffer(TYPEF)=BufferEmpty + RETURN + ELSE IF(IFLAG.LT.0)THEN + WRITE(*,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) + RETURN + ELSE + IERR = 1 + RETURN + ENDIF + END SUBROUTINE ZMUMPS_706 + SUBROUTINE ZMUMPS_709 (TYPEF,VADDR) + IMPLICIT NONE + INTEGER(8), INTENT(in) :: VADDR + INTEGER, INTENT(in) :: TYPEF + IF(I_REL_POS_CUR_HBUF(TYPEF).EQ.1_8)THEN + FIRST_VADDR_IN_BUF(TYPEF)=VADDR + ENDIF + RETURN + END SUBROUTINE ZMUMPS_709 + SUBROUTINE ZMUMPS_653( STRAT, TYPEF, MonBloc, + & AFAC, LAFAC, + & AddVirtCour, IPIVBEG, IPIVEND, LPANELeff, + & IERR) + IMPLICIT NONE + INTEGER, INTENT(IN) :: TYPEF, IPIVBEG, IPIVEND, STRAT + INTEGER(8), INTENT(IN) :: LAFAC + COMPLEX(kind=8), INTENT(IN) :: AFAC(LAFAC) + INTEGER(8), INTENT(IN) :: AddVirtCour + TYPE(IO_BLOCK), INTENT(IN) :: MonBloc + INTEGER, INTENT(OUT):: LPANELeff + INTEGER, INTENT(OUT):: IERR + INTEGER :: II, NBPIVeff + INTEGER(8) :: IPOS, IDIAG, IDEST + INTEGER(8) :: DeltaIPOS + INTEGER :: StrideIPOS + IERR=0 + IF (STRAT.NE.STRAT_WRITE_MAX.AND.STRAT.NE.STRAT_TRY_WRITE) THEN + write(6,*) ' ZMUMPS_653: STRAT Not implemented ' + CALL MUMPS_ABORT() + ENDIF + NBPIVeff = IPIVEND - IPIVBEG + 1 + IF (MonBloc%MASTER .AND. MonBloc%Typenode .NE. 3) THEN + IF (TYPEF.EQ.TYPEF_L) THEN + LPANELeff = (MonBloc%NROW-IPIVBEG+1)*NBPIVeff + ELSE + LPANELeff = (MonBloc%NCOL-IPIVBEG+1)*NBPIVeff + ENDIF + ELSE + LPANELeff = MonBloc%NROW*NBPIVeff + ENDIF + IF ( ( I_REL_POS_CUR_HBUF(TYPEF) + int(LPANELeff - 1,8) + & > + & HBUF_SIZE ) + & .OR. + & ( (AddVirtCour.NE.NextAddVirtBuffer(TYPEF)) .AND. + & (NextAddVirtBuffer(TYPEF).NE.BufferEmpty) ) + & ) THEN + IF (STRAT.EQ.STRAT_WRITE_MAX) THEN + CALL ZMUMPS_707(TYPEF,IERR) + ELSE IF (STRAT.EQ.STRAT_TRY_WRITE) THEN + CALL ZMUMPS_706(TYPEF,IERR) + IF (IERR.EQ.1) RETURN + ELSE + write(6,*) 'ZMUMPS_653: STRAT Not implemented' + ENDIF + ENDIF + IF (IERR < 0 ) THEN + RETURN + ENDIF + IF (NextAddVirtBuffer(TYPEF).EQ. BufferEmpty) THEN + CALL ZMUMPS_709 (TYPEF,AddVirtCour) + NextAddVirtBuffer(TYPEF) = AddVirtCour + ENDIF + IF (MonBloc%MASTER .AND. MonBloc%Typenode .NE. 3) THEN + IDIAG = int(IPIVBEG-1,8)*int(MonBloc%NCOL,8) + int(IPIVBEG,8) + IPOS = IDIAG + IDEST = I_SHIFT_CUR_HBUF(TYPEF) + + & I_REL_POS_CUR_HBUF(TYPEF) + IF (TYPEF.EQ.TYPEF_L) THEN + DO II = IPIVBEG, IPIVEND + CALL zcopy(MonBloc%NROW-IPIVBEG+1, + & AFAC(IPOS), MonBloc%NCOL, + & BUF_IO(IDEST), 1) + IDEST = IDEST + int(MonBloc%NROW-IPIVBEG+1,8) + IPOS = IPOS + 1_8 + ENDDO + ELSE + DO II = IPIVBEG, IPIVEND + CALL zcopy(MonBloc%NCOL-IPIVBEG+1, + & AFAC(IPOS), 1, + & BUF_IO(IDEST), 1) + IDEST = IDEST + int(MonBloc%NCOL-IPIVBEG+1,8) + IPOS = IPOS + int(MonBloc%NCOL,8) + ENDDO + ENDIF + ELSE + IDEST = I_SHIFT_CUR_HBUF(TYPEF) + + & I_REL_POS_CUR_HBUF(TYPEF) + IF (MonBloc%Typenode.EQ.3) THEN + DeltaIPOS = int(MonBloc%NROW,8) + StrideIPOS = 1 + ELSE + DeltaIPOS = 1_8 + StrideIPOS = MonBloc%NCOL + ENDIF + IPOS = 1_8 + int(IPIVBEG - 1,8) * DeltaIPOS + DO II = IPIVBEG, IPIVEND + CALL zcopy(MonBloc%NROW, + & AFAC(IPOS), StrideIPOS, + & BUF_IO(IDEST), 1) + IDEST = IDEST+int(MonBloc%NROW,8) + IPOS = IPOS + DeltaIPOS + ENDDO + ENDIF + I_REL_POS_CUR_HBUF(TYPEF) = + & I_REL_POS_CUR_HBUF(TYPEF) + int(LPANELeff,8) + NextAddVirtBuffer(TYPEF) = NextAddVirtBuffer(TYPEF) + & + int(LPANELeff,8) + RETURN + END SUBROUTINE ZMUMPS_653 + END MODULE ZMUMPS_OOC_BUFFER diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part1.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part1.F new file mode 100644 index 000000000..03650bad6 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part1.F @@ -0,0 +1,6004 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE ZMUMPS( id ) + USE ZMUMPS_OOC + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE +C matrix in assembled format (ICNTL(5)=0, and ICNTL(18) $\neq$ 3), + INTERFACE + SUBROUTINE ZMUMPS_758 + &(idRHS, idINFO, idN, idNRHS, idLRHS) + COMPLEX(kind=8), DIMENSION(:), POINTER :: idRHS + INTEGER, intent(in) :: idN, idNRHS, idLRHS + INTEGER, intent(inout) :: idINFO(:) + END SUBROUTINE ZMUMPS_758 + SUBROUTINE ZMUMPS_26( id ) + USE ZMUMPS_STRUC_DEF + TYPE (ZMUMPS_STRUC), TARGET :: id + END SUBROUTINE ZMUMPS_26 + SUBROUTINE ZMUMPS_142( id ) + USE ZMUMPS_STRUC_DEF + TYPE (ZMUMPS_STRUC), TARGET :: id + END SUBROUTINE ZMUMPS_142 + SUBROUTINE ZMUMPS_301( id ) + USE ZMUMPS_STRUC_DEF + TYPE (ZMUMPS_STRUC), TARGET :: id + END SUBROUTINE ZMUMPS_301 + SUBROUTINE ZMUMPS_349(id, LP) + USE ZMUMPS_STRUC_DEF + TYPE (ZMUMPS_STRUC), TARGET, INTENT(IN) :: id + INTEGER :: LP + END SUBROUTINE ZMUMPS_349 + END INTERFACE + INCLUDE 'mpif.h' + INTEGER MASTER, IERR + PARAMETER( MASTER = 0 ) + TYPE (ZMUMPS_STRUC) :: id + INTEGER JOBMIN, JOBMAX, OLDJOB + INTEGER I, J, MP, LP, MPG, KEEP235SAVE, KEEP242SAVE, + & KEEP243SAVE + LOGICAL LANAL, LFACTO, LSOLVE, PROK, FLAG, PROKG + LOGICAL NOERRORBEFOREPERM + LOGICAL UNS_PERM_DONE + INTEGER COMM_SAVE + INTEGER JOB, N, NZ, NELT + INTEGER, PARAMETER :: ICNTL18DIST_MIN = 1 + INTEGER, PARAMETER :: ICNTL18DIST_MAX = 3 + INTEGER, DIMENSION(:), ALLOCATABLE :: UNS_PERM_INV + NOERRORBEFOREPERM = .FALSE. + UNS_PERM_DONE = .FALSE. + JOB = id%JOB + N = id%N + NZ = id%NZ + NELT = id%NELT + id%INFO(1) = 0 + id%INFO(2) = 0 + IF ( JOB .NE. -1 ) THEN + LP = id%ICNTL(1) + MP = id%ICNTL(2) + MPG = id%ICNTL(3) + PROK = ((MP.GT.0).AND.(id%ICNTL(4).GE.3)) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF (PROKG) THEN + IF (id%ICNTL(5) .NE. 1) THEN + WRITE(MPG,'(A,I4,I12,I15)') + & 'Entering ZMUMPS driver with JOB, N, NZ =', JOB,N,NZ + ELSE + WRITE(MPG,'(A,I4,I12,I15)') + & 'Entering ZMUMPS driver with JOB, N, NELT =', JOB,N + & ,NELT + ENDIF + ENDIF + ELSE + MPG = 0 + PROK = .FALSE. + PROKG = .FALSE. + LP = 6 + MP = 6 + END IF + CALL MPI_INITIALIZED( FLAG, IERR ) + IF ( .NOT. FLAG ) THEN + WRITE(LP,990) + 990 FORMAT(' Error in ZMUMPS initialization: MPI is not running.') + id%INFO(1) = -23 + id%INFO(2) = 0 + GOTO 500 + END IF + COMM_SAVE = id%COMM + CALL MPI_COMM_DUP( COMM_SAVE, id%COMM, IERR ) + CALL MPI_ALLREDUCE(JOB,JOBMIN,1,MPI_INTEGER,MPI_MAX, + & id%COMM,IERR) + CALL MPI_ALLREDUCE(JOB,JOBMAX,1,MPI_INTEGER,MPI_MIN, + & id%COMM,IERR) + IF ( JOBMIN .NE. JOBMAX ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + IF ( JOB .EQ. -1 ) THEN + id%INFO(1)=0 + id%INFO(2)=0 + IF ( id%KEEP(40) .EQ. 1 - 456789 .OR. + & id%KEEP(40) .EQ. 2 - 456789 .OR. + & id%KEEP(40) .EQ. 3 -456789 ) THEN + IF ( id%N > 0 ) THEN + id%INFO(1)=-3 + id%INFO(2)=JOB + ENDIF + ENDIF + CALL MPI_COMM_RANK(id%COMM, id%MYID, IERR) + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) THEN + IF (id%KEEP(201).GT.0) THEN + CALL ZMUMPS_587(id, IERR) + ENDIF + GOTO 499 + ENDIF + CALL ZMUMPS_163( id ) + GOTO 500 + END IF + IF ( JOB .EQ. -2 ) THEN + id%KEEP(40)= -2 - 456789 + CALL ZMUMPS_136( id ) + GOTO 500 + END IF + IF ((JOB.LT.1).OR.(JOB.GT.6)) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + IF (id%MYID.EQ.MASTER) THEN + IF ( id%ICNTL(18) .LT. ICNTL18DIST_MIN + & .OR. id%ICNTL(18) .GT. ICNTL18DIST_MAX ) THEN + IF ((N.LE.0).OR.((N+N+N)/3.NE.N)) THEN + id%INFO(1) = -16 + id%INFO(2) = N + END IF + IF (id%ICNTL(5).NE.1) THEN + IF (NZ.LE.0) THEN + id%INFO(1) = -2 + id%INFO(2) = NZ + END IF + ELSE + IF (NELT.LE.0) THEN + id%INFO(1) = -24 + id%INFO(2) = NELT + END IF + ENDIF + END IF + IF ( (id%KEEP(46).EQ.0).AND.(id%NPROCS.LE.1) ) + & THEN + id%INFO(1) = -21 + id%INFO(2) = id%NPROCS + ENDIF + END IF + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) GOTO 499 + LANAL = .FALSE. + LFACTO = .FALSE. + LSOLVE = .FALSE. + IF ((JOB.EQ.1).OR.(JOB.EQ.4).OR. + & (JOB.EQ.6)) LANAL = .TRUE. + IF ((JOB.EQ.2).OR.(JOB.EQ.4).OR. + & (JOB.EQ.5).OR.(JOB.EQ.6)) LFACTO = .TRUE. + IF ((JOB.EQ.3).OR.(JOB.EQ.5).OR. + & (JOB.EQ.6)) LSOLVE = .TRUE. + IF (MP.GT.0) CALL ZMUMPS_349(id, MP) + OLDJOB = id%KEEP( 40 ) + 456789 + IF ( LANAL ) THEN + IF ( OLDJOB .EQ. 0 .OR. OLDJOB .GT. 3 .OR. OLDJOB .LT. -1 ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + IF ( OLDJOB .GE. 2 ) THEN + IF (associated(id%IS)) THEN + DEALLOCATE (id%IS) + NULLIFY (id%IS) + END IF + IF (associated(id%S)) THEN + DEALLOCATE (id%S) + NULLIFY (id%S) + END IF + END IF + END IF + IF ( LFACTO ) THEN + IF ( OLDJOB .LT. 1 .and. .NOT. LANAL ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + END IF + IF ( LSOLVE ) THEN + IF ( OLDJOB .LT. 2 .AND. .NOT. LFACTO ) THEN + id%INFO(1) = -3 + id%INFO(2) = JOB + GOTO 499 + END IF + END IF +#if ! defined (LARGEMATRICES) + NOERRORBEFOREPERM =.TRUE. + UNS_PERM_DONE=.FALSE. + IF (id%MYID .eq. MASTER .AND. id%KEEP(23) .NE. 0) THEN + IF ( id%JOB .EQ. 2 .OR. id%JOB .EQ. 5 .OR. + & (id%JOB .EQ. 3 .AND. (id%ICNTL(10) .NE.0 .OR. + & id%ICNTL(11).NE. 0))) THEN + UNS_PERM_DONE = .TRUE. + ALLOCATE(UNS_PERM_INV(id%N),stat=IERR) + IF (IERR .GT. 0) THEN + id%INFO(1)=-13 + id%INFO(2)=id%N + IF (id%ICNTL(1) .GT. 0 .AND. id%ICNTL(4) .GE.1) THEN + WRITE(id%ICNTL(2),99993) + END IF + GOTO 510 + ENDIF + DO I = 1, id%N + UNS_PERM_INV(id%UNS_PERM(I))=I + END DO + DO I = 1, id%NZ + J = id%JCN(I) + IF (J.LE.0.OR.J.GT.id%N) CYCLE + id%JCN(I)=UNS_PERM_INV(J) + END DO + DEALLOCATE(UNS_PERM_INV) + END IF + END IF +#endif + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499 + IF (LANAL) THEN + id%KEEP(40)=-1 -456789 + IF (id%MYID.EQ.MASTER) THEN + id%INFOG(7) = -9999 + id%INFOG(23) = 0 + id%INFOG(24) = 1 + IF (associated(id%IS1)) DEALLOCATE(id%IS1) + IF ( id%ICNTL(5) .NE. 1 ) THEN + IF ( id%KEEP(50) .NE. 1 + & .AND. ( + & (id%ICNTL(6) .NE. 0 .AND. id%ICNTL(7) .NE.1) + & .OR. + & id%ICNTL(12) .NE. 1) ) THEN + id%MAXIS1 = 11 * N + ELSE + id%MAXIS1 = 10 * N + END IF + ELSE + id%MAXIS1 = 6 * N + 2 * NELT + 2 + ENDIF + ALLOCATE( id%IS1(id%MAXIS1), stat=IERR ) + IF (IERR.gt.0) THEN + id%INFO(1) = -7 + id%INFO(2) = id%MAXIS1 + IF ( LP .GT.0 ) + & WRITE(LP,*) 'Problem in allocating work array for analysis.' + GO TO 100 + END IF + IF ( associated( id%PROCNODE ) ) + & DEALLOCATE( id%PROCNODE ) + ALLOCATE( id%PROCNODE(id%N), stat=IERR ) + IF (IERR.gt.0) THEN + id%INFO(1) = -7 + id%INFO(2) = id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) 'Problem in allocating work array PROCNODE' + END IF + GOTO 100 + END IF + id%PROCNODE(1:id%N) = 0 + IF ( id%ICNTL(5) .EQ. 1 ) THEN + IF ( associated( id%ELTPROC ) ) + & DEALLOCATE( id%ELTPROC ) + ALLOCATE( id%ELTPROC(id%NELT), stat=IERR ) + IF (IERR.gt.0) THEN + id%INFO(1) = -7 + id%INFO(2) = id%NELT + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) 'Problem in allocating work array ELTPROC' + END IF + GOTO 100 + END IF + END IF + IF ( id%ICNTL(5) .NE. 1 ) THEN + id%NA_ELT=0 + IF ( id%ICNTL(18) .LT. ICNTL18DIST_MIN + & .OR. id%ICNTL(18) .GT. ICNTL18DIST_MAX ) THEN + IF ( .not. associated( id%IRN ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( size( id%IRN ) < id%NZ ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( .not. associated( id%JCN ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + ELSE IF ( size( id%JCN ) < id%NZ ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + END IF + END IF + IF ( id%INFO( 1 ) .eq. -22 ) THEN + IF (LP.GT.0) WRITE(LP,*) + & 'Error in analysis: IRN/JCN badly allocated.' + END IF + ELSE + IF ( .not. associated( id%ELTPTR ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( size( id%ELTPTR ) < id%NELT+1 ) THEN + id%INFO(1) = -22 + id%INFO(2) = 1 + ELSE IF ( .not. associated( id%ELTVAR ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + ELSE + id%LELTVAR = id%ELTPTR( id%NELT+1 ) - 1 + IF ( size( id%ELTVAR ) < id%LELTVAR ) THEN + id%INFO(1) = -22 + id%INFO(2) = 2 + ELSE + id%NA_ELT = 0 + IF ( id%KEEP(50) .EQ. 0 ) THEN + DO I = 1,NELT + J = id%ELTPTR(I+1) - id%ELTPTR(I) + J = (J * J) + id%NA_ELT = id%NA_ELT + J + ENDDO + ELSE + DO I = 1,NELT + J = id%ELTPTR(I+1) - id%ELTPTR(I) + J = (J * (J+1))/2 + id%NA_ELT = id%NA_ELT + J + ENDDO + ENDIF + ENDIF + END IF + IF ( id%INFO( 1 ) .eq. -22 ) THEN + IF (LP.GT.0) WRITE(LP,*) + & 'Error in analysis: ELTPTR/ELTVAR badly allocated.' + END IF + ENDIF + 100 CONTINUE + END IF + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499 + id%KEEP(52) = id%ICNTL(8) + IF ( id%KEEP(52) .GT. 8 .OR. id%KEEP(52).LT.-2) + & id%KEEP(52) = 77 + IF ((id%KEEP(52).EQ.77).AND.(id%KEEP(50).EQ.1)) THEN + id%KEEP(52) = 0 + ENDIF + IF ( id%KEEP(52).EQ.77 .OR. id%KEEP(52).LE.-2) THEN + IF (.not.associated(id%A)) id%KEEP(52) = 0 + ENDIF + IF(id%KEEP(52) .EQ. -1) id%KEEP(52) = 0 + CALL ZMUMPS_26( id ) + IF (id%MYID .eq. MASTER) THEN + IF (id%KEEP(52) .NE. 0) THEN + id%INFOG(33)=id%KEEP(52) + ELSE + id%INFOG(33)=id%ICNTL(8) + ENDIF + ENDIF + IF (id%MYID .eq. MASTER) id%INFOG(24)=id%KEEP(95) + IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499 + id%KEEP(40) = 1 -456789 + END IF + IF (LFACTO) THEN + id%KEEP(40) = 1 - 456789 + IF ( id%MYID .EQ. MASTER ) THEN + IF (id%KEEP(60).EQ.1) THEN + IF ( associated( id%SCHUR_CINTERFACE)) THEN + id%SCHUR=>id%SCHUR_CINTERFACE + & (1:id%SIZE_SCHUR*id%SIZE_SCHUR) + ENDIF + IF ( .NOT. associated (id%SCHUR)) THEN + IF (LP.GT.0) + & write(LP,'(A)') + & ' SCHUR not associated' + id%INFO(1)=-22 + id%INFO(2)=9 + ELSE IF ( size(id%SCHUR) .LT. + & id%SIZE_SCHUR * id%SIZE_SCHUR ) THEN + IF (LP.GT.0) + & write(LP,'(A)') + & ' SCHUR allocated but too small' + id%INFO(1)=-22 + id%INFO(2)=9 + END IF + END IF + IF ( id%KEEP(55) .EQ. 0 ) THEN + IF ( id%KEEP(54).eq.0 ) THEN + IF ( .not. associated( id%A ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + ELSE IF ( size( id%A ) < id%NZ ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + END IF + END IF + ELSE + IF ( .not. associated( id%A_ELT ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + ELSE + IF ( size( id%A_ELT ) < id%NA_ELT ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 4 + ENDIF + END IF + ENDIF + CALL MUMPS_633(id%KEEP(12),id%ICNTL(14), + & id%KEEP(50),id%KEEP(54),id%ICNTL(6),id%ICNTL(8)) + CALL ZMUMPS_635(N,id%KEEP(1),id%ICNTL(1),MPG) + IF( id%KEEP(52) .EQ. -2 .AND. id%ICNTL(8) .NE. -2 .AND. + & id%ICNTL(8).NE. 77 ) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** WARNING : SCALING' + WRITE(MPG,'(A)') + & ' ** scaling already computed during analysis' + WRITE(MPG,'(A)') + & ' ** keeping the scaling from the analysis' + ENDIF + ENDIF + IF (id%KEEP(52) .NE. -2) THEN + id%KEEP(52)=id%ICNTL(8) + ENDIF + IF ( id%KEEP(52) .GT. 8 .OR. id%KEEP(52).LT.-2) + & id%KEEP(52) = 77 + IF (id%KEEP(52).EQ.77) THEN + IF (id%KEEP(50).EQ.1) THEN + id%KEEP(52) = 0 + ELSE + id%KEEP(52) = 7 + ENDIF + ENDIF + IF (id%KEEP(23) .NE. 0 .AND. id%ICNTL(8) .EQ. -1) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** WARNING : SCALING' + WRITE(MPG,'(A)') + & ' ** column permutation applied:' + WRITE(MPG,'(A)') + & ' ** column scaling has to be permuted' + ENDIF + ENDIF + IF ( id%KEEP( 19 ) .ne. 0 .and. id%KEEP( 52 ).ne. 0 ) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.' + WRITE(MPG,'(A)') ' ** (incompatibility with null space)' + END IF + id%KEEP(52) = 0 + END IF + IF ( id%KEEP(60) .ne. 0 .and. id%KEEP(52) .ne. 0 ) THEN + id%KEEP(52) = 0 + IF ( MPG .GT. 0 .AND. id%ICNTL(8) .NE. 0 ) THEN + WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.' + WRITE(MPG,'(A)') ' ** (incompatibility with Schur)' + END IF + END IF + IF (id%KEEP(54) .NE. 0 .AND. + & id%KEEP(52).NE.7 .AND. id%KEEP(52).NE.8 .AND. + & id%KEEP(52) .NE. 0 ) THEN + id%KEEP(52) = 0 + IF ( MPG .GT. 0 .and. id%ICNTL(8) .ne. 0 ) THEN + WRITE(MPG,'(A)') + & ' ** Warning: This scaling option not available' + WRITE(MPG,'(A)') ' ** for distributed matrix entry' + END IF + END IF + IF ( id%KEEP(50) .NE. 0 ) THEN + IF ( id%KEEP(52).ne. 1 .and. + & id%KEEP(52).ne. -1 .and. + & id%KEEP(52).ne. 0 .and. + & id%KEEP(52).ne. 7 .and. + & id%KEEP(52).ne. 8 .and. + & id%KEEP(52).ne. -2 .and. + & id%KEEP(52).ne. 77) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') + & ' ** Warning: Scaling option n.a. for symmetric matrix' + END IF + id%KEEP(52) = 0 + END IF + END IF + IF (id%KEEP(55) .NE. 0 .AND. + & ( id%KEEP(52) .gt. 0 ) ) THEN + id%KEEP(52) = 0 + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.' + WRITE(MPG,'(A)') + & ' ** (only user scaling av. for elt. entry)' + END IF + END IF + IF ( id%KEEP(52) .eq. -1 ) THEN + IF ( .not. associated( id%ROWSCA ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 5 + ELSE IF ( size( id%ROWSCA ) < id%N ) THEN + id%INFO(1) = -22 + id%INFO(2) = 5 + ELSE IF ( .not. associated( id%COLSCA ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 6 + ELSE IF ( size( id%COLSCA ) < id%N ) THEN + id%INFO(1) = -22 + id%INFO(2) = 6 + END IF + END IF + IF (id%KEEP(52).GT.0 .AND. + & id%KEEP(52) .LE.8) THEN + IF ( associated(id%COLSCA)) + & DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) + & DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=IERR) + IF (IERR .GT.0) id%INFO(1)=-13 + ALLOCATE( id%ROWSCA(N), stat=IERR) + IF (IERR .GT.0) id%INFO(1)=-13 + END IF + IF (.NOT. associated(id%COLSCA)) THEN + ALLOCATE( id%COLSCA(1), stat=IERR) + END IF + IF (IERR .GT.0) id%INFO(1)=-13 + IF (.NOT. associated(id%ROWSCA)) + & ALLOCATE( id%ROWSCA(1), stat=IERR) + IF (IERR .GT.0) id%INFO(1)=-13 + IF ( id%INFO(1) .eq. -13 ) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*) 'Problems in allocations before facto' + GOTO 200 + END IF + IF (id%KEEP(252) .EQ. 1) THEN + CALL ZMUMPS_758 + & (id%RHS,id%INFO,id%N,id%NRHS,id%LRHS) + CALL ZMUMPS_807(id) + CALL ZMUMPS_769(id) + ENDIF + 200 CONTINUE + END IF + CALL MPI_BCAST( id%KEEP(221), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + IF (id%KEEP(60).EQ.2.OR.id%KEEP(60).EQ.3) THEN + IF ( id%root%yes ) THEN + IF ( associated( id%SCHUR_CINTERFACE )) THEN + id%SCHUR=>id%SCHUR_CINTERFACE + & (1:id%SCHUR_LLD*(id%root%SCHUR_NLOC-1)+ + & id%root%SCHUR_MLOC) + ENDIF + IF (id%SCHUR_LLD < id%root%SCHUR_MLOC) THEN + IF (LP.GT.0) write(LP,*) + & ' SCHUR leading dimension SCHUR_LLD ', + & id%SCHUR_LLD, 'too small with respect to', + & id%root%SCHUR_MLOC + id%INFO(1)=-30 + id%INFO(2)=id%SCHUR_LLD + ELSE IF ( .NOT. associated (id%SCHUR)) THEN + IF (LP.GT.0) write(LP,'(A)') + & ' SCHUR not associated' + id%INFO(1)=-22 + id%INFO(2)=9 + ELSE IF (size(id%SCHUR) < + & id%SCHUR_LLD*(id%root%SCHUR_NLOC-1)+ + & id%root%SCHUR_MLOC) THEN + IF (LP.GT.0) THEN + write(LP,'(A)') + & ' SCHUR allocated but too small' + write(LP,*) id%MYID, ' : Size Schur=', + & size(id%SCHUR), + & ' SCHUR_LLD= ', id%SCHUR_LLD, + & ' SCHUR_MLOC=', id%root%SCHUR_NLOC, + & ' SCHUR_NLOC=', id%root%SCHUR_NLOC + ENDIF + id%INFO(1)=-22 + id%INFO(2)= 9 + ELSE + id%root%SCHUR_LLD=id%SCHUR_LLD + IF (id%root%SCHUR_NLOC==0) THEN + ALLOCATE(id%root%SCHUR_POINTER(1)) + ELSE + id%root%SCHUR_POINTER=>id%SCHUR + ENDIF + ENDIF + ENDIF + ENDIF + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) GO TO 499 + CALL ZMUMPS_142(id) + IF (id%MYID .eq. MASTER) id%INFOG(33)=id%KEEP(52) + IF (id%KEEP(60).EQ.2.OR.id%KEEP(60).EQ.3) THEN + IF (id%root%yes) THEN + IF (id%root%SCHUR_NLOC==0) THEN + DEALLOCATE(id%root%SCHUR_POINTER) + NULLIFY(id%root%SCHUR_POINTER) + ELSE + NULLIFY(id%root%SCHUR_POINTER) + ENDIF + ENDIF + ENDIF + IF ( id%INFO(1) .LT. 0 ) GO TO 499 + id%KEEP(40) = 2 - 456789 + END IF + IF (LSOLVE) THEN + id%KEEP(40) = 2 -456789 + IF (id%MYID .eq. MASTER) THEN + KEEP235SAVE = id%KEEP(235) + KEEP242SAVE = id%KEEP(242) + KEEP243SAVE = id%KEEP(243) + IF (id%KEEP(242).EQ.0) id%KEEP(243)=0 + ENDIF + CALL ZMUMPS_301(id) + IF (id%MYID .eq. MASTER) THEN + id%KEEP(235) = KEEP235SAVE + id%KEEP(242) = KEEP242SAVE + id%KEEP(243) = KEEP243SAVE + ENDIF + IF (id%INFO(1).LT.0) GOTO 499 + id%KEEP(40) = 3 -456789 + ENDIF + IF (MP.GT.0) CALL ZMUMPS_349(id, MP) + GOTO 500 + 499 PROK = ((id%ICNTL(1).GT.0).AND. + & (id%ICNTL(4).GE.1)) + IF (PROK) WRITE (id%ICNTL(1),99995) id%INFO(1) + IF (PROK) WRITE (id%ICNTL(1),99994) id%INFO(2) +500 CONTINUE +#if ! defined(LARGEMATRICES) + IF (id%MYID .eq. MASTER .AND. id%KEEP(23) .NE. 0 + & .AND. NOERRORBEFOREPERM) THEN + IF (id%JOB .NE. 3 .OR. UNS_PERM_DONE) THEN + DO I = 1, id%NZ + J=id%JCN(I) + IF (J.LE.0.OR.J.GT.id%N) CYCLE + id%JCN(I)=id%UNS_PERM(J) + END DO + END IF + END IF +#endif + 510 CONTINUE + CALL ZMUMPS_300(id%INFO(1), id%INFOG(1), id%COMM, id%MYID) + CALL MPI_BCAST( id%RINFOG(1), 40, MPI_DOUBLE_PRECISION, MASTER, + & id%COMM, IERR ) + IF (id%MYID.EQ.MASTER.and.MPG.GT.0.and. + & id%INFOG(1).lt.0) THEN + WRITE(MPG,'(A,I12)') ' On return from ZMUMPS, INFOG(1)=', + & id%INFOG(1) + WRITE(MPG,'(A,I12)') ' On return from ZMUMPS, INFOG(2)=', + & id%INFOG(2) + END IF + CALL MPI_COMM_FREE( id%COMM, IERR ) + id%COMM = COMM_SAVE + RETURN +99995 FORMAT (' ** ERROR RETURN ** FROM ZMUMPS INFO(1)=', I3) +99994 FORMAT (' ** INFO(2)=', I10) +99993 FORMAT (' ** Allocation error: could not permute JCN.') + END SUBROUTINE ZMUMPS + SUBROUTINE ZMUMPS_300( INFO, INFOG, COMM, MYID ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER INFO(40), INFOG(40), COMM, MYID + INTEGER TMP1(2),TMP(2) + INTEGER ROOT, IERR + INTEGER MASTER + PARAMETER (MASTER=0) + IF ( INFO(1) .ge. 0 .and. INFO(2) .ge. 0 ) THEN + INFOG(1) = INFO(1) + INFOG(2) = INFO(2) + ELSE + INFOG(1) = INFO(1) + TMP1(1) = INFO(1) + TMP1(2) = MYID + CALL MPI_ALLREDUCE(TMP1,TMP,1,MPI_2INTEGER, + & MPI_MINLOC,COMM,IERR ) + INFOG(2) = INFO(2) + ROOT = TMP(2) + CALL MPI_BCAST( INFOG(1), 1, MPI_INTEGER, ROOT, COMM, IERR ) + CALL MPI_BCAST( INFOG(2), 1, MPI_INTEGER, ROOT, COMM, IERR ) + END IF + CALL MPI_BCAST(INFOG(3), 38, MPI_INTEGER, MASTER, COMM, IERR ) + RETURN + END SUBROUTINE ZMUMPS_300 + SUBROUTINE ZMUMPS_349(id, LP) + USE ZMUMPS_STRUC_DEF + TYPE (ZMUMPS_STRUC), TARGET, INTENT(IN) :: id + INTEGER :: LP + INTEGER, POINTER :: JOB + INTEGER,DIMENSION(:),POINTER::ICNTL + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (LP.LT.0) RETURN + JOB=>id%JOB + ICNTL=>id%ICNTL + IF (id%MYID.EQ.MASTER) THEN + SELECT CASE (JOB) + CASE(1); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) ICNTL(5),ICNTL(6),ICNTL(7),ICNTL(12), + & ICNTL(13),ICNTL(18),ICNTL(19),ICNTL(22) + IF ((ICNTL(6).EQ.5).OR.(ICNTL(6).EQ.6).OR. + & (ICNTL(12).NE.1) ) THEN + WRITE (LP,992) ICNTL(8) + ENDIF + IF (id%ICNTL(19).NE.0) + & WRITE(LP,998) id%SIZE_SCHUR + WRITE (LP,993) ICNTL(14) + CASE(2); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,992) ICNTL(8) + WRITE (LP,993) ICNTL(14) + CASE(3); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + CASE(4); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,992) ICNTL(8) + IF (id%ICNTL(19).NE.0) + & WRITE(LP,998) id%SIZE_SCHUR + WRITE (LP,993) ICNTL(14) + CASE(5); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) ICNTL(5),ICNTL(6),ICNTL(7),ICNTL(12), + & ICNTL(13),ICNTL(18),ICNTL(19),ICNTL(22) + WRITE (LP,992) ICNTL(8) + WRITE (LP,993) ICNTL(14) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + CASE(6); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) ICNTL(5),ICNTL(6),ICNTL(7),ICNTL(12), + & ICNTL(13),ICNTL(18),ICNTL(19),ICNTL(22) + IF (id%ICNTL(19).NE.0) + & WRITE(LP,998) id%SIZE_SCHUR + WRITE (LP,992) ICNTL(8) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + WRITE (LP,993) ICNTL(14) + END SELECT + ENDIF + 980 FORMAT (/'***********CONTROL PARAMETERS (ICNTL)**************'/) + 990 FORMAT ( + & 'ICNTL(1) Output stream for error messages =',I10/ + & 'ICNTL(2) Output stream for diagnostic messages =',I10/ + & 'ICNTL(3) Output stream for global information =',I10/ + & 'ICNTL(4) Level of printing =',I10) + 991 FORMAT ( + & 'ICNTL(5) Matrix format ( keep(55) ) =',I10/ + & 'ICNTL(6) Maximum transversal ( keep(23) ) =',I10/ + & 'ICNTL(7) Ordering =',I10/ + & 'ICNTL(12) LDLT ordering strat ( keep(95) ) =',I10/ + & 'ICNTL(13) Parallel root (0=on, 1=off) =',I10/ + & 'ICNTL(18) Distributed matrix ( keep(54) ) =',I10/ + & 'ICNTL(19) Schur option ( keep(60) 0=off,else=on ) =',I10/ + & 'ICNTL(22) Out-off-core option (0=Off, >0=ON) =',I10) + 992 FORMAT ( + & 'ICNTL(8) Scaling strategy =',I10) + 993 FORMAT ( + & 'ICNTL(14) Percent of memory increase =',I10) + 995 FORMAT ( + & 'ICNTL(9) Solve A x=b (1) or A''x = b (else) =',I10/ + & 'ICNTL(10) Max steps iterative refinement =',I10/ + & 'ICNTL(11) Error analysis ( 0= off, else=on) =',I10) + 998 FORMAT ( + & ' Size of SCHUR matrix (SIZE_SHUR) =',I10) + END SUBROUTINE ZMUMPS_349 + SUBROUTINE ZMUMPS_350(id, LP) + USE ZMUMPS_STRUC_DEF + TYPE (ZMUMPS_STRUC), TARGET, INTENT(IN) :: id + INTEGER ::LP + INTEGER, POINTER :: JOB + INTEGER,DIMENSION(:),POINTER::ICNTL, KEEP + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (LP.LT.0) RETURN + JOB=>id%JOB + ICNTL=>id%ICNTL + KEEP=>id%KEEP + IF (id%MYID.EQ.MASTER) THEN + SELECT CASE (JOB) + CASE(1); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + IF ((KEEP(23).EQ.5).OR.(KEEP(23).EQ.6))THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,993) KEEP(12) + CASE(2); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + IF (KEEP(23).EQ.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,993) KEEP(12) + CASE(3); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + CASE(4); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + IF (KEEP(23).NE.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),ICNTL(20),ICNTL(21) + WRITE (LP,993) KEEP(12) + CASE(5); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + IF ((KEEP(23).EQ.5).OR.(KEEP(23).EQ.6) + & .OR. (KEEP(23).EQ.7)) THEN + WRITE (LP,992) KEEP(52) + ENDIF + IF (KEEP(23).EQ.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,993) KEEP(12) + CASE(6); + WRITE (LP,980) + WRITE (LP,990) ICNTL(1),ICNTL(2),ICNTL(3),ICNTL(4) + WRITE (LP,991) KEEP(55),KEEP(23),ICNTL(7),KEEP(95), + & ICNTL(13),KEEP(54),KEEP(60),ICNTL(22) + IF ((KEEP(23).EQ.5).OR.(KEEP(23).EQ.6) + & .OR. (KEEP(23).EQ.7)) THEN + WRITE (LP,992) KEEP(52) + ENDIF + IF (KEEP(23).EQ.0)THEN + WRITE (LP,992) KEEP(52) + ENDIF + WRITE (LP,995) + & ICNTL(9),ICNTL(10),ICNTL(11),KEEP(248),ICNTL(21) + WRITE (LP,993) KEEP(12) + END SELECT + ENDIF + 980 FORMAT (/'******INTERNAL VALUE OF PARAMETERS (ICNTL/KEEP)****'/) + 990 FORMAT ( + & 'ICNTL(1) Output stream for error messages =',I10/ + & 'ICNTL(2) Output stream for diagnostic messages =',I10/ + & 'ICNTL(3) Output stream for global information =',I10/ + & 'ICNTL(4) Level of printing =',I10) + 991 FORMAT ( + & 'ICNTL(5) Matrix format ( keep(55) ) =',I10/ + & 'ICNTL(6) Maximum transversal ( keep(23) ) =',I10/ + & 'ICNTL(7) Ordering =',I10/ + & 'ICNTL(12) LDLT ordering strat ( keep(95) ) =',I10/ + & 'ICNTL(13) Parallel root (0=on, 1=off) =',I10/ + & 'ICNTL(18) Distributed matrix ( keep(54) ) =',I10/ + & 'ICNTL(19) Schur option ( keep(60) 0=off,else=on ) =',I10/ + & 'ICNTL(22) Out-off-core option (0=Off, >0=ON) =',I10) + 992 FORMAT ( + & 'ICNTL(8) Scaling strategy ( keep(52) ) =',I10) + 993 FORMAT ( + & 'ICNTL(14) Percent of memory increase ( keep(12) ) =',I10) + 995 FORMAT ( + & 'ICNTL(9) Solve A x=b (1) or A''x = b (else) =',I10/ + & 'ICNTL(10) Max steps iterative refinement =',I10/ + & 'ICNTL(11) Error analysis ( 0= off, else=on) =',I10/ + & 'ICNTL(20) Dense (0) or sparse (1) RHS =',I10/ + & 'ICNTL(21) Gathered (0) or distributed(1) solution =',I10) + END SUBROUTINE ZMUMPS_350 + SUBROUTINE ZMUMPS_758 + & (idRHS, idINFO, idN, idNRHS, idLRHS) + IMPLICIT NONE + COMPLEX(kind=8), DIMENSION(:), POINTER :: idRHS + INTEGER, intent(in) :: idN, idNRHS, idLRHS + INTEGER, intent(inout) :: idINFO(:) + IF ( .not. associated( idRHS ) ) THEN + idINFO( 1 ) = -22 + idINFO( 2 ) = 7 + ELSE IF (idNRHS.EQ.1) THEN + IF ( size( idRHS ) < idN ) THEN + idINFO( 1 ) = -22 + idINFO( 2 ) = 7 + ENDIF + ELSE IF (idLRHS < idN) + & THEN + idINFO( 1 ) = -26 + idINFO( 2 ) = idLRHS + ELSE IF + & (size(idRHS)<(idNRHS*idLRHS-idLRHS+idN)) + & THEN + idINFO( 1 ) = -22 + idINFO( 2 ) = 7 + END IF + RETURN + END SUBROUTINE ZMUMPS_758 + SUBROUTINE ZMUMPS_807(id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (ZMUMPS_STRUC) :: id + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (id%MYID.EQ.MASTER) THEN + id%KEEP(221)=id%ICNTL(26) + IF (id%KEEP(221).ne.0 .and. id%KEEP(221) .NE.1 + & .AND.id%KEEP(221).ne.2) id%KEEP(221)=0 + ENDIF + RETURN + END SUBROUTINE ZMUMPS_807 + SUBROUTINE ZMUMPS_769(id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (ZMUMPS_STRUC) :: id + INTEGER MASTER + PARAMETER( MASTER = 0 ) + IF (id%MYID .EQ. MASTER) THEN + IF ( id%KEEP(221) == 1 .or. id%KEEP(221) == 2 ) THEN + IF (id%KEEP(221) == 2 .and. id%JOB == 2) THEN + id%INFO(1)=-35 + id%INFO(2)=id%KEEP(221) + GOTO 333 + ENDIF + IF (id%KEEP(221) == 1 .and. id%KEEP(252) == 1 + & .and. id%JOB == 3) THEN + id%INFO(1)=-35 + id%INFO(2)=id%KEEP(221) + ENDIF + IF ( id%KEEP(60).eq. 0 .or. id%SIZE_SCHUR.EQ.0 ) THEN + id%INFO(1)=-33 + id%INFO(2)=id%KEEP(221) + GOTO 333 + ENDIF + IF ( .NOT. associated( id%REDRHS)) THEN + id%INFO(1)=-22 + id%INFO(2)=15 + GOTO 333 + ELSE IF (id%NRHS.EQ.1) THEN + IF (size(id%REDRHS) < id%SIZE_SCHUR ) THEN + id%INFO(1)=-22 + id%INFO(2)=15 + GOTO 333 + ENDIF + ELSE IF (id%LREDRHS < id%SIZE_SCHUR) THEN + id%INFO(1)=-34 + id%INFO(2)=id%LREDRHS + GOTO 333 + ELSE IF + & (size(id%REDRHS)< + & id%NRHS*id%LREDRHS-id%LREDRHS+id%SIZE_SCHUR) + & THEN + id%INFO(1)=-22 + id%INFO(2)=15 + GOTO 333 + ENDIF + ENDIF + ENDIF + 333 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_769 + SUBROUTINE ZMUMPS_24( MYID, SLAVEF, N, + & PROCNODE, STEP, PTRAIW, PTRARW, ISTEP_TO_INIV2, + & I_AM_CAND, + & KEEP, KEEP8, ICNTL, id ) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (ZMUMPS_STRUC) :: id + INTEGER MYID, N, SLAVEF + INTEGER KEEP( 500 ), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE( KEEP(28) ), STEP( N ), + & PTRAIW( N ), PTRARW( N ) + INTEGER ISTEP_TO_INIV2(KEEP(71)) + LOGICAL I_AM_CAND(max(1,KEEP(56))) + LOGICAL I_AM_SLAVE + LOGICAL I_AM_CAND_LOC + INTEGER MUMPS_330, MUMPS_275, MUMPS_810 + EXTERNAL MUMPS_330, MUMPS_275, MUMPS_810 + INTEGER ISTEP, I, IPTRI, IPTRR, NCOL, NROW, allocok + INTEGER TYPE_PARALL, ITYPE, IRANK, INIV2, TYPESPLIT + LOGICAL T4_MASTER_CONCERNED + TYPE_PARALL = KEEP(46) + I_AM_SLAVE = (KEEP(46).EQ.1 .OR. MYID.NE.0) + KEEP(14) = 0 + KEEP(13) = 0 + DO I = 1, N + ISTEP=abs(STEP(I)) + ITYPE = MUMPS_330( PROCNODE(ISTEP), SLAVEF ) + IRANK = MUMPS_275( PROCNODE(ISTEP), SLAVEF ) + TYPESPLIT = MUMPS_810 ( PROCNODE(ISTEP), SLAVEF ) + I_AM_CAND_LOC = .FALSE. + T4_MASTER_CONCERNED = .FALSE. + IF (ITYPE.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF (I_AM_SLAVE) THEN + I_AM_CAND_LOC = I_AM_CAND(INIV2) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + IF ( TYPE_PARALL .eq. 0 ) THEN + T4_MASTER_CONCERNED = + & ( id%CANDIDATES (id%CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + & .EQ.MYID-1 ) + ELSE + T4_MASTER_CONCERNED = + & ( id%CANDIDATES (id%CANDIDATES(SLAVEF+1, INIV2)+1,INIV2 ) + & .EQ.MYID ) + ENDIF + ENDIF + ENDIF + ENDIF + IF ( TYPE_PARALL .eq. 0 ) THEN + IRANK = IRANK + 1 + END IF + IF ( + & ( (ITYPE .EQ. 1.OR.ITYPE.EQ.2) .AND. + & IRANK .EQ. MYID ) + & .OR. + & ( T4_MASTER_CONCERNED ) + & ) THEN + KEEP( 14 ) = KEEP( 14 ) + 3 + PTRAIW( I ) + PTRARW( I ) + KEEP( 13 ) = KEEP( 13 ) + 1 + PTRAIW( I ) + PTRARW( I ) + ELSE IF ( ITYPE .EQ. 3 ) THEN + ELSE IF ( ITYPE .EQ. 2 .AND. I_AM_CAND_LOC ) THEN + PTRARW( I ) = 0 + KEEP(14) = KEEP(14) + 3 + PTRAIW( I ) + PTRARW( I ) + KEEP(13) = KEEP(13) + 1 + PTRAIW( I ) + PTRARW( I ) + END IF + END DO + IF ( associated( id%INTARR ) ) THEN + DEALLOCATE( id%INTARR ) + NULLIFY( id%INTARR ) + END IF + IF ( KEEP(14) > 0 ) THEN + ALLOCATE( id%INTARR( KEEP(14) ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = KEEP(14) + RETURN + END IF + ELSE + ALLOCATE( id%INTARR( 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = 1 + RETURN + END IF + END IF + IPTRI = 1 + IPTRR = 1 + DO I = 1, N + ISTEP = abs(STEP(I)) + ITYPE = MUMPS_330( PROCNODE(ISTEP), SLAVEF ) + IRANK = MUMPS_275( PROCNODE(ISTEP), SLAVEF ) + TYPESPLIT = MUMPS_810 ( PROCNODE(ISTEP), SLAVEF ) + I_AM_CAND_LOC = .FALSE. + T4_MASTER_CONCERNED = .FALSE. + IF (ITYPE.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF (I_AM_SLAVE) THEN + I_AM_CAND_LOC = I_AM_CAND(INIV2) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + IF ( TYPE_PARALL .eq. 0 ) THEN + T4_MASTER_CONCERNED = + & (id%CANDIDATES (id%CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + & .EQ.MYID-1 ) + ELSE + T4_MASTER_CONCERNED = + & (id%CANDIDATES (id%CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + & .EQ.MYID ) + ENDIF + ENDIF + ENDIF + ENDIF + IF ( TYPE_PARALL .eq. 0 ) THEN + IRANK =IRANK + 1 + END IF + IF ( + & ( ITYPE .eq. 2 .and. + & IRANK .eq. MYID ) + & .or. + & ( ITYPE .eq. 1 .and. + & IRANK .eq. MYID ) + & .or. + & ( T4_MASTER_CONCERNED ) + & ) THEN + NCOL = PTRAIW( I ) + NROW = PTRARW( I ) + id%INTARR( IPTRI ) = NCOL + id%INTARR( IPTRI + 1 ) = -NROW + id%INTARR( IPTRI + 2 ) = I + PTRAIW( I ) = IPTRI + PTRARW( I ) = IPTRR + IPTRI = IPTRI + NCOL + NROW + 3 + IPTRR = IPTRR + NCOL + NROW + 1 + ELSE IF ( ITYPE .eq. 2 .AND. I_AM_CAND_LOC ) THEN + NCOL = PTRAIW( I ) + NROW = 0 + id%INTARR( IPTRI ) = NCOL + id%INTARR( IPTRI + 1 ) = -NROW + id%INTARR( IPTRI + 2 ) = I + PTRAIW( I ) = IPTRI + PTRARW( I ) = IPTRR + IPTRI = IPTRI + NCOL + NROW + 3 + IPTRR = IPTRR + NCOL + NROW + 1 + ELSE + PTRAIW(I) = 0 + PTRARW(I) = 0 + END IF + END DO + IF ( IPTRI - 1 .NE. KEEP(14) ) THEN + WRITE(*,*) 'Error 1 in anal_arrowheads', + & ' IPTRI - 1, KEEP(14)=', IPTRI - 1, KEEP(14) + CALL MUMPS_ABORT() + END IF + IF ( IPTRR - 1 .NE. KEEP(13) ) THEN + WRITE(*,*) 'Error 2 in anal_arrowheads' + CALL MUMPS_ABORT() + END IF + RETURN + END SUBROUTINE ZMUMPS_24 + SUBROUTINE ZMUMPS_148(N, NZ, ASPK, + & IRN, ICN, PERM, + & LSCAL,COLSCA,ROWSCA, + & MYID, SLAVEF, PROCNODE_STEPS, NBRECORDS, + & LP, COMM, root, KEEP, KEEP8, FILS, RG2L, + & INTARR, DBLARR, PTRAIW, PTRARW, FRERE_STEPS, + & STEP, A, LA, ISTEP_TO_INIV2, I_AM_CAND, CANDIDATES ) + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INTEGER N,NZ, COMM, NBRECORDS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + COMPLEX(kind=8) ASPK(NZ) + DOUBLE PRECISION COLSCA(*), ROWSCA(*) + INTEGER IRN(NZ), ICN(NZ) + INTEGER PERM(N), PROCNODE_STEPS(KEEP(28)) + INTEGER RG2L( N ), FILS( N ) + INTEGER ISTEP_TO_INIV2(KEEP(71)) + LOGICAL I_AM_CAND(max(1,KEEP(56))) + INTEGER LP, SLAVEF, MYID + INTEGER CANDIDATES(SLAVEF+1, max(1,KEEP(56))) + LOGICAL LSCAL + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER(8) :: LA + INTEGER PTRAIW( N ), PTRARW( N ), FRERE_STEPS( KEEP(28) ) + INTEGER STEP(N) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX(kind=8) A( LA ), DBLARR(max(1,KEEP(13))) + INTEGER, DIMENSION(:,:), ALLOCATABLE :: BUFI + COMPLEX(kind=8), DIMENSION(:,:), ALLOCATABLE :: BUFR + INTEGER MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + COMPLEX(kind=8) VAL + INTEGER IOLD,JOLD,INEW,JNEW,ISEND,JSEND,DEST,I,K,IARR + INTEGER IPOSROOT, JPOSROOT + INTEGER IROW_GRID, JCOL_GRID + INTEGER INODE, ISTEP + INTEGER NBUFS + INTEGER ARROW_ROOT, TAILLE + INTEGER LOCAL_M, LOCAL_N + INTEGER(8) :: PTR_ROOT + INTEGER TYPENODE_TMP, MASTER_NODE + LOGICAL I_AM_CAND_LOC, I_AM_SLAVE + INTEGER I1, IA, JARR, ILOCROOT, JLOCROOT + INTEGER IS1, ISHIFT, IIW, IS, IAS + INTEGER allocok, TYPESPLIT, T4MASTER, INIV2 + LOGICAL T4_MASTER_CONCERNED + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INTEGER, POINTER, DIMENSION(:,:) :: IW4 + ARROW_ROOT = 0 + I_AM_SLAVE=(MYID.NE.0.OR.KEEP(46).EQ.1) + IF ( KEEP(46) .eq. 0 ) THEN + NBUFS = SLAVEF + ELSE + NBUFS = SLAVEF - 1 + ALLOCATE( IW4( N, 2 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) 'Error allocating IW4' + CALL MUMPS_ABORT() + END IF + DO I = 1, N + I1 = PTRAIW( I ) + IA = PTRARW( I ) + IF ( IA .GT. 0 ) THEN + DBLARR( IA ) = ZERO + IW4( I, 1 ) = INTARR( I1 ) + IW4( I, 2 ) = -INTARR( I1 + 1 ) + INTARR( I1 + 2 ) = I + END IF + END DO + IF ( KEEP(38) .NE. 0 ) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I = 1, root%SCHUR_NLOC + root%SCHUR_POINTER(int(I-1,8)*int(root%SCHUR_LLD,8)+1_8: + & int(I-1,8)*int(root%SCHUR_LLD,8)+int(root%SCHUR_MLOC,8))= + & ZERO + ENDDO + ENDIF + END IF + END IF + IF (NBUFS.GT.0) THEN + ALLOCATE( BUFI(NBRECORDS*2+1,NBUFS),stat=allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) 'Error allocating BUFI' + CALL MUMPS_ABORT() + END IF + ALLOCATE( BUFR( NBRECORDS, NBUFS ), stat=allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) 'Error allocating BUFR' + CALL MUMPS_ABORT() + END IF + DO I = 1, NBUFS + BUFI( 1, I ) = 0 + ENDDO + ENDIF + INODE = KEEP(38) + I = 1 + DO WHILE ( INODE .GT. 0 ) + RG2L( INODE ) = I + INODE = FILS( INODE ) + I = I + 1 + END DO + DO 120 K=1,NZ + IOLD = IRN(K) + JOLD = ICN(K) + IF ( (IOLD.GT.N).OR.(JOLD.GT.N).OR.(IOLD.LT.1) + & .OR.(JOLD.LT.1) ) THEN + GOTO 120 + END IF + IF (LSCAL) THEN + VAL = ASPK(K)*ROWSCA(IOLD)*COLSCA(JOLD) + ELSE + VAL = ASPK(K) + ENDIF + IF (IOLD.EQ.JOLD) THEN + ISEND = IOLD + JSEND = JOLD + ELSE + INEW = PERM(IOLD) + JNEW = PERM(JOLD) + IF (INEW.LT.JNEW) THEN + ISEND = IOLD + IF ( KEEP(50) .NE. 0 ) ISEND = -IOLD + JSEND = JOLD + ELSE + ISEND = -JOLD + JSEND = IOLD + ENDIF + ENDIF + IARR = abs( ISEND ) + ISTEP = abs( STEP(IARR) ) + TYPENODE_TMP = MUMPS_330( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + MASTER_NODE = MUMPS_275( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + TYPESPLIT = MUMPS_810( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + I_AM_CAND_LOC = .FALSE. + T4_MASTER_CONCERNED = .FALSE. + T4MASTER = -9999 + IF (TYPENODE_TMP.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF (I_AM_SLAVE) I_AM_CAND_LOC = I_AM_CAND(INIV2) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + T4_MASTER_CONCERNED = .TRUE. + T4MASTER=CANDIDATES(CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + IF ( KEEP(46) .eq. 0 ) THEN + T4MASTER=T4MASTER+1 + ENDIF + ENDIF + ENDIF + IF ( TYPENODE_TMP .EQ. 1 ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + DEST = MASTER_NODE + 1 + ELSE + DEST = MASTER_NODE + END IF + ELSE IF ( TYPENODE_TMP .EQ. 2 ) THEN + IF ( ISEND .LT. 0 ) THEN + DEST = -1 + ELSE + IF ( KEEP( 46 ) .eq. 0 ) THEN + DEST = MASTER_NODE + 1 + ELSE + DEST = MASTER_NODE + END IF + END IF + ELSE + IF ( ISEND .LT. 0 ) THEN + IPOSROOT = RG2L(JSEND) + JPOSROOT = RG2L(IARR) + ELSE + IPOSROOT = RG2L( IARR ) + JPOSROOT = RG2L( JSEND ) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, root%NPCOL ) + IF ( KEEP( 46 ) .eq. 0 ) THEN + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + 1 + ELSE + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + END IF + END IF + IF ( DEST .eq. 0 .or. + & ( DEST .eq. -1 .and. KEEP( 46 ) .eq. 1 .AND. + & ( I_AM_CAND_LOC .OR. MASTER_NODE .EQ. 0 ) ) + & .or. + & ( T4MASTER.EQ.0 ) + & ) THEN + IARR = ISEND + JARR = JSEND + IF ( TYPENODE_TMP .eq. 3 ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + IF ( IROW_GRID .EQ. root%MYROW .AND. + & JCOL_GRID .EQ. root%MYCOL ) THEN + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & = A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + ELSE + WRITE(*,*) MYID,':INTERNAL Error: root arrowhead ' + WRITE(*,*) MYID,':is not belonging to me. IARR,JARR=' + & ,IARR,JARR + CALL MUMPS_ABORT() + END IF + ELSE IF ( IARR .GE. 0 ) THEN + IF ( IARR .eq. JARR ) THEN + IA = PTRARW( IARR ) + DBLARR( IA ) = DBLARR( IA ) + VAL + ELSE + IS1 = PTRAIW(IARR) + ISHIFT = INTARR(IS1) + IW4(IARR,2) + IW4(IARR,2) = IW4(IARR,2) - 1 + IIW = IS1 + ISHIFT + 2 + INTARR(IIW) = JARR + IS = PTRARW(IARR) + IAS = IS + ISHIFT + DBLARR(IAS) = VAL + END IF + ELSE + IARR = -IARR + ISHIFT = PTRAIW(IARR)+IW4(IARR,1)+2 + INTARR(ISHIFT) = JARR + IAS = PTRARW(IARR)+IW4(IARR,1) + IW4(IARR,1) = IW4(IARR,1) - 1 + DBLARR(IAS) = VAL + IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0 ) + & .AND. IW4(IARR,1) .EQ. 0 .AND. + & STEP( IARR) > 0 ) THEN + IF (MUMPS_275( PROCNODE_STEPS(abs(STEP(IARR))), + & SLAVEF ) == MYID) THEN + TAILLE = INTARR( PTRAIW(IARR) ) + CALL ZMUMPS_310( N, PERM, + & INTARR( PTRAIW(IARR) + 3 ), + & DBLARR( PTRARW(IARR) + 1 ), + & TAILLE, 1, TAILLE ) + END IF + END IF + ENDIF + END IF + IF ( DEST.EQ. -1 ) THEN + DO I=1, CANDIDATES(SLAVEF+1,ISTEP_TO_INIV2(ISTEP)) + DEST=CANDIDATES(I,ISTEP_TO_INIV2(ISTEP)) + IF (KEEP(46).EQ.0) DEST=DEST+1 + IF (DEST.NE.0) + & CALL ZMUMPS_34( ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDDO + DEST = MASTER_NODE + IF (KEEP(46).EQ.0) DEST=DEST+1 + IF ( DEST .NE. 0 ) THEN + CALL ZMUMPS_34( ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDIF + IF ((T4_MASTER_CONCERNED).AND.(T4MASTER.GT.0)) THEN + CALL ZMUMPS_34( ISEND, JSEND, VAL, + & T4MASTER, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDIF + ELSE IF ( DEST .GT. 0 ) THEN + CALL ZMUMPS_34( ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + IF ( T4MASTER.GT.0 ) THEN + CALL ZMUMPS_34( ISEND, JSEND, VAL, + & T4MASTER, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + ENDIF + ELSE IF ( T4MASTER.GT.0 ) THEN + CALL ZMUMPS_34( ISEND, JSEND, VAL, + & T4MASTER, BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP(46)) + END IF + 120 CONTINUE + KEEP(49) = ARROW_ROOT + IF (NBUFS.GT.0) THEN + CALL ZMUMPS_18( + & BUFI, BUFR, NBRECORDS, NBUFS, + & LP, COMM, KEEP( 46 ) ) + ENDIF + IF ( KEEP( 46 ) .NE. 0 ) DEALLOCATE( IW4 ) + IF (NBUFS.GT.0) THEN + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_148 + SUBROUTINE ZMUMPS_34(ISEND, JSEND, VAL, + & DEST, BUFI, BUFR, NBRECORDS, NBUFS, LP, COMM, + & TYPE_PARALL ) + IMPLICIT NONE + INTEGER ISEND, JSEND, DEST, NBUFS, NBRECORDS, TYPE_PARALL + INTEGER BUFI( NBRECORDS * 2 + 1, NBUFS ) + COMPLEX(kind=8) BUFR( NBRECORDS, NBUFS ) + INTEGER COMM + INTEGER LP + COMPLEX(kind=8) VAL + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + INTEGER TAILLE_SENDI, TAILLE_SENDR, IREQ + IF (BUFI(1,DEST)+1.GT.NBRECORDS) THEN + TAILLE_SENDI = BUFI(1,DEST) * 2 + 1 + TAILLE_SENDR = BUFI(1,DEST) + CALL MPI_SEND(BUFI(1,DEST),TAILLE_SENDI, + & MPI_INTEGER, + & DEST, ARROWHEAD, COMM, IERR ) + CALL MPI_SEND( BUFR(1,DEST), TAILLE_SENDR, + & MPI_DOUBLE_COMPLEX, DEST, + & ARROWHEAD, COMM, IERR ) + BUFI(1,DEST) = 0 + ENDIF + IREQ = BUFI(1,DEST) + 1 + BUFI(1,DEST) = IREQ + BUFI( IREQ * 2, DEST ) = ISEND + BUFI( IREQ * 2 + 1, DEST ) = JSEND + BUFR( IREQ, DEST ) = VAL + RETURN + END SUBROUTINE ZMUMPS_34 + SUBROUTINE ZMUMPS_18( + & BUFI, BUFR, NBRECORDS, NBUFS, LP, COMM, + & TYPE_PARALL ) + IMPLICIT NONE + INTEGER NBUFS, NBRECORDS, TYPE_PARALL + INTEGER BUFI( NBRECORDS * 2 + 1, NBUFS ) + COMPLEX(kind=8) BUFR( NBRECORDS, NBUFS ) + INTEGER COMM + INTEGER LP + INTEGER ISLAVE, TAILLE_SENDI, TAILLE_SENDR, IERR + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + DO ISLAVE = 1,NBUFS + TAILLE_SENDI = BUFI(1,ISLAVE) * 2 + 1 + TAILLE_SENDR = BUFI(1,ISLAVE) + BUFI(1,ISLAVE) = - BUFI(1,ISLAVE) + CALL MPI_SEND(BUFI(1,ISLAVE),TAILLE_SENDI, + & MPI_INTEGER, + & ISLAVE, ARROWHEAD, COMM, IERR ) + IF ( TAILLE_SENDR .NE. 0 ) THEN + CALL MPI_SEND( BUFR(1,ISLAVE), TAILLE_SENDR, + & MPI_DOUBLE_COMPLEX, ISLAVE, + & ARROWHEAD, COMM, IERR ) + END IF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_18 + RECURSIVE SUBROUTINE ZMUMPS_310( N, PERM, + & INTLIST, DBLLIST, TAILLE, LO, HI ) + IMPLICIT NONE + INTEGER N, TAILLE + INTEGER PERM( N ) + INTEGER INTLIST( TAILLE ) + COMPLEX(kind=8) DBLLIST( TAILLE ) + INTEGER LO, HI + INTEGER I,J + INTEGER ISWAP, PIVOT + COMPLEX(kind=8) zswap + I = LO + J = HI + PIVOT = PERM(INTLIST((I+J)/2)) + 10 IF (PERM(INTLIST(I)) < PIVOT) THEN + I=I+1 + GOTO 10 + ENDIF + 20 IF (PERM(INTLIST(J)) > PIVOT) THEN + J=J-1 + GOTO 20 + ENDIF + IF (I < J) THEN + ISWAP = INTLIST(I) + INTLIST(I) = INTLIST(J) + INTLIST(J)=ISWAP + zswap = DBLLIST(I) + DBLLIST(I) = DBLLIST(J) + DBLLIST(J) = zswap + ENDIF + IF ( I <= J) THEN + I = I+1 + J = J-1 + ENDIF + IF ( I <= J ) GOTO 10 + IF ( LO < J ) CALL ZMUMPS_310(N, PERM, + & INTLIST, DBLLIST, TAILLE, LO, J) + IF ( I < HI ) CALL ZMUMPS_310(N, PERM, + & INTLIST, DBLLIST, TAILLE, I, HI) + RETURN + END SUBROUTINE ZMUMPS_310 + SUBROUTINE ZMUMPS_145( N, + & DBLARR, LDBLARR, INTARR, LINTARR, PTRAIW, PTRARW, + & KEEP, KEEP8, MYID, COMM, NBRECORDS, + & A, LA, root, + & PROCNODE_STEPS, + & SLAVEF, PERM, FRERE_STEPS, STEP, INFO1, INFO2 + & ) + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INTEGER N, MYID, LDBLARR, LINTARR, + & COMM + INTEGER INTARR(LINTARR) + INTEGER PTRAIW(N), PTRARW(N) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8), intent(IN) :: LA + INTEGER PROCNODE_STEPS( KEEP(28) ), PERM( N ) + INTEGER SLAVEF, NBRECORDS + COMPLEX(kind=8) A( LA ) + INTEGER INFO1, INFO2 + COMPLEX(kind=8) DBLARR(LDBLARR) + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER, POINTER, DIMENSION(:) :: BUFI + COMPLEX(kind=8), POINTER, DIMENSION(:) :: BUFR + INTEGER, POINTER, DIMENSION(:,:) :: IW4 + LOGICAL FINI + INTEGER IREC, NB_REC, IARR, JARR, IA, I1, I, allocok + INTEGER IS, IS1, ISHIFT, IIW, IAS + INTEGER LOCAL_M, LOCAL_N, ILOCROOT, JLOCROOT, + & IPOSROOT, JPOSROOT, TAILLE, + & IPROC + INTEGER FRERE_STEPS( KEEP(28) ), STEP(N) + INTEGER(8) :: PTR_ROOT + INTEGER ARROW_ROOT, TYPE_PARALL + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + COMPLEX(kind=8) VAL + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER MASTER + PARAMETER(MASTER=0) + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER IERR + INTEGER numroc + EXTERNAL numroc + TYPE_PARALL = KEEP(46) + ARROW_ROOT=0 + ALLOCATE( BUFI( NBRECORDS * 2 + 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO1 = -13 + INFO2 = NBRECORDS * 2 + 1 + WRITE(*,*) MYID,': Could not allocate BUFI: goto 500' + GOTO 500 + END IF + ALLOCATE( BUFR( NBRECORDS ) , stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO1 = -13 + INFO2 = NBRECORDS + WRITE(*,*) MYID,': Could not allocate BUFR: goto 500' + GOTO 500 + END IF + ALLOCATE( IW4(N,2), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO1 = -13 + INFO2 = 2 * N + WRITE(*,*) MYID,': Could not allocate IW4: goto 500' + GOTO 500 + END IF + IF ( KEEP(38).NE.0) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I=1, root%SCHUR_NLOC + root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1: + & (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC)=ZERO + ENDDO + ENDIF + END IF + FINI = .FALSE. + DO I=1,N + I1 = PTRAIW(I) + IA = PTRARW(I) + IF (IA.GT.0) THEN + DBLARR(IA) = ZERO + IW4(I,1) = INTARR(I1) + IW4(I,2) = -INTARR(I1+1) + INTARR(I1+2)=I + ENDIF + ENDDO + DO WHILE (.NOT.FINI) + CALL MPI_RECV( BUFI(1), 2*NBRECORDS+1, + & MPI_INTEGER, MASTER, + & ARROWHEAD, + & COMM, STATUS, IERR ) + NB_REC = BUFI(1) + IF (NB_REC.LE.0) THEN + FINI = .TRUE. + NB_REC = -NB_REC + ENDIF + IF (NB_REC.EQ.0) EXIT + CALL MPI_RECV( BUFR(1), NBRECORDS, MPI_DOUBLE_COMPLEX, + & MASTER, ARROWHEAD, + & COMM, STATUS, IERR ) + DO IREC=1, NB_REC + IARR = BUFI( IREC * 2 ) + JARR = BUFI( IREC * 2 + 1 ) + VAL = BUFR( IREC ) + IF ( MUMPS_330( PROCNODE_STEPS(abs(STEP(abs(IARR)))), + & SLAVEF ) .eq. 3 ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + IF ( IARR .GT. 0 ) THEN + IPOSROOT = root%RG2L_ROW( IARR ) + JPOSROOT = root%RG2L_COL( JARR ) + ELSE + IPOSROOT = root%RG2L_ROW( JARR ) + JPOSROOT = root%RG2L_COL( -IARR ) + END IF + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & = A( PTR_ROOT + int(JLOCROOT - 1,8) + & * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8)) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + ELSE IF (IARR.GE.0) THEN + IF (IARR.EQ.JARR) THEN + IA = PTRARW(IARR) + DBLARR(IA) = DBLARR(IA) + VAL + ELSE + IS1 = PTRAIW(IARR) + ISHIFT = INTARR(IS1) + IW4(IARR,2) + IW4(IARR,2) = IW4(IARR,2) - 1 + IIW = IS1 + ISHIFT + 2 + INTARR(IIW) = JARR + IS = PTRARW(IARR) + IAS = IS + ISHIFT + DBLARR(IAS) = VAL + ENDIF + ELSE + IARR = -IARR + ISHIFT = PTRAIW(IARR)+IW4(IARR,1)+2 + INTARR(ISHIFT) = JARR + IAS = PTRARW(IARR)+IW4(IARR,1) + IW4(IARR,1) = IW4(IARR,1) - 1 + DBLARR(IAS) = VAL + IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0) + & .AND. IW4(IARR,1) .EQ. 0 + & .AND. STEP(IARR) > 0 ) THEN + IPROC = MUMPS_275( PROCNODE_STEPS(abs(STEP(IARR))), + & SLAVEF ) + IF ( TYPE_PARALL .eq. 0 ) THEN + IPROC = IPROC + 1 + END IF + IF (IPROC .EQ. MYID) THEN + TAILLE = INTARR( PTRAIW(IARR) ) + CALL ZMUMPS_310( N, PERM, + & INTARR( PTRAIW(IARR) + 3 ), + & DBLARR( PTRARW(IARR) + 1 ), + & TAILLE, 1, TAILLE ) + END IF + END IF + ENDIF + ENDDO + END DO + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + DEALLOCATE( IW4 ) + 500 CONTINUE + KEEP(49) = ARROW_ROOT + RETURN + END SUBROUTINE ZMUMPS_145 + SUBROUTINE ZMUMPS_266( MYID, BUFR, LBUFR, + & LBUFR_BYTES, + & IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, + & TNBPROCFILS, N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP, + & KEEP,KEEP8, ITLOC, RHS_MUMPS, + & IFLAG, IERROR ) + USE ZMUMPS_LOAD + IMPLICIT NONE + INTEGER MYID + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB, N, LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER PTRIST(KEEP(28)), STEP(N), + & PIMASTER(KEEP(28)), + & TNBPROCFILS( KEEP(28) ), ITLOC( N + KEEP(253) ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER COMP, IFLAG, IERROR + INTEGER INODE, NBPROCFILS, NCOL, NROW, NASS, NSLAVES + INTEGER NSLAVES_RECU, NFRONT + INTEGER LREQ + INTEGER(8) :: LREQCB + DOUBLE PRECISION FLOP1 + INCLUDE 'mumps_headers.h' + INODE = BUFR( 1 ) + NBPROCFILS = BUFR( 2 ) + NROW = BUFR( 3 ) + NCOL = BUFR( 4 ) + NASS = BUFR( 5 ) + NFRONT = BUFR( 6 ) + NSLAVES_RECU = BUFR( 7 ) + IF ( KEEP(50) .eq. 0 ) THEN + FLOP1 = dble( NASS * NROW ) + + & dble(NROW*NASS)*dble(2*NCOL-NASS-1) + ELSE + FLOP1 = dble( NASS ) * dble( NROW ) + & * dble( 2 * NCOL - NROW - NASS + 1) + END IF + CALL ZMUMPS_190(1,.TRUE.,FLOP1, KEEP,KEEP8) + IF ( KEEP(50) .eq. 0 ) THEN + NSLAVES = NSLAVES_RECU + XTRA_SLAVES_UNSYM + ELSE + NSLAVES = NSLAVES_RECU + XTRA_SLAVES_SYM + END IF + LREQ = NROW + NCOL + 6 + NSLAVES + KEEP(IXSZ) + LREQCB = int(NCOL,8) * int(NROW,8) + CALL ZMUMPS_22(.FALSE., 0_8, .FALSE.,.TRUE., + & MYID,N, KEEP,KEEP8, IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST, STEP, PIMASTER,PAMASTER, + & LREQ, LREQCB, INODE, S_ACTIVE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + PTRIST(STEP(INODE)) = IWPOSCB + 1 + PTRAST(STEP(INODE)) = IPTRLU + 1_8 + IW( IWPOSCB + 1+KEEP(IXSZ) ) = NCOL + IW( IWPOSCB + 2+KEEP(IXSZ) ) = - NASS + IW( IWPOSCB + 3+KEEP(IXSZ) ) = NROW + IW( IWPOSCB + 4+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 5+KEEP(IXSZ) ) = NASS + IW( IWPOSCB + 6+KEEP(IXSZ) ) = NSLAVES + IW( IWPOSCB + 7+KEEP(IXSZ)+NSLAVES : + & IWPOSCB + 6+KEEP(IXSZ)+NSLAVES + NROW + NCOL ) + &= BUFR( 8 + NSLAVES_RECU : 7 + NSLAVES_RECU + NROW + NCOL ) + IF ( KEEP(50) .eq. 0 ) THEN + IW( IWPOSCB + 7+KEEP(IXSZ) ) = S_ROOTBAND_INIT + IF (NSLAVES_RECU.GT.0) + & IW( IWPOSCB + 7+XTRA_SLAVES_UNSYM+KEEP(IXSZ): + & IWPOSCB+6+KEEP(IXSZ)+NSLAVES_RECU ) = + & BUFR( 8: 7 + NSLAVES_RECU ) + ELSE + IW( IWPOSCB + 7+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 8+KEEP(IXSZ) ) = NFRONT + IW( IWPOSCB + 9+KEEP(IXSZ) ) = S_ROOTBAND_INIT + IW( IWPOSCB + 7+XTRA_SLAVES_SYM+KEEP(IXSZ): + & IWPOSCB + 6+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_RECU ) = + & BUFR( 8: 7 + NSLAVES_RECU ) + END IF + TNBPROCFILS(STEP( INODE )) = NBPROCFILS + RETURN + END SUBROUTINE ZMUMPS_266 + SUBROUTINE ZMUMPS_163( id ) + USE ZMUMPS_STRUC_DEF + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE (ZMUMPS_STRUC) id + INTEGER MASTER, IERR,PAR_loc,SYM_loc + PARAMETER( MASTER = 0 ) + INTEGER color + CALL MPI_COMM_SIZE(id%COMM, id%NPROCS, IERR ) + PAR_loc=id%PAR + SYM_loc=id%SYM + CALL MPI_BCAST(PAR_loc,1,MPI_INTEGER,MASTER,id%COMM,IERR) + CALL MPI_BCAST(SYM_loc,1,MPI_INTEGER,MASTER,id%COMM,IERR) + IF ( PAR_loc .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + color = MPI_UNDEFINED + ELSE + color = 0 + END IF + CALL MPI_COMM_SPLIT( id%COMM, color, 0, + & id%COMM_NODES, IERR ) + id%NSLAVES = id%NPROCS - 1 + ELSE + CALL MPI_COMM_DUP( id%COMM, id%COMM_NODES, IERR ) + id%NSLAVES = id%NPROCS + END IF + IF (PAR_loc .ne. 0 .or. id%MYID .NE. MASTER) THEN + CALL MPI_COMM_DUP( id%COMM_NODES, id%COMM_LOAD, IERR ) + ENDIF + CALL ZMUMPS_20( id%NSLAVES, id%LWK_USER, + & id%CNTL(1), id%ICNTL(1), + & id%KEEP(1), id%KEEP8(1), id%INFO(1), id%INFOG(1), + & id%RINFO(1), id%RINFOG(1), + & SYM_loc, PAR_loc, id%DKEEP(1) ) + id%WRITE_PROBLEM="NAME_NOT_INITIALIZED" + CALL MUMPS_SET_VERSION( id%VERSION_NUMBER ) + id%OOC_TMPDIR="NAME_NOT_INITIALIZED" + id%OOC_PREFIX="NAME_NOT_INITIALIZED" + id%NRHS = 1 + id%LRHS = 0 + id%LREDRHS = 0 + CALL ZMUMPS_61( id%KEEP( 34 ), id%KEEP(35) ) + NULLIFY(id%BUFR) + id%MAXIS1 = 0 + id%INST_Number = -1 + id%N = 0; id%NZ = 0 + NULLIFY(id%IRN) + NULLIFY(id%JCN) + NULLIFY(id%A) + id%NZ_loc = 0 + NULLIFY(id%IRN_loc) + NULLIFY(id%JCN_loc) + NULLIFY(id%A_loc) + NULLIFY(id%MAPPING) + NULLIFY(id%RHS) + NULLIFY(id%REDRHS) + id%NZ_RHS=0 + NULLIFY(id%RHS_SPARSE) + NULLIFY(id%IRHS_SPARSE) + NULLIFY(id%IRHS_PTR) + NULLIFY(id%ISOL_loc) + id%LSOL_loc=0 + NULLIFY(id%SOL_loc) + NULLIFY(id%COLSCA) + NULLIFY(id%ROWSCA) + NULLIFY(id%PERM_IN) + NULLIFY(id%IS) + NULLIFY(id%IS1) + NULLIFY(id%STEP) + NULLIFY(id%Step2node) + NULLIFY(id%DAD_STEPS) + NULLIFY(id%NE_STEPS) + NULLIFY(id%ND_STEPS) + NULLIFY(id%FRERE_STEPS) + NULLIFY(id%SYM_PERM) + NULLIFY(id%UNS_PERM) + NULLIFY(id%PIVNUL_LIST) + NULLIFY(id%FILS) + NULLIFY(id%PTRAR) + NULLIFY(id%FRTPTR) + NULLIFY(id%FRTELT) + NULLIFY(id%NA) + id%LNA=0 + NULLIFY(id%PROCNODE_STEPS) + NULLIFY(id%S) + NULLIFY(id%PROCNODE) + NULLIFY(id%POIDS) + NULLIFY(id%PTLUST_S) + NULLIFY(id%PTRFAC) + NULLIFY(id%INTARR) + NULLIFY(id%DBLARR) + NULLIFY(id%DEPTH_FIRST) + NULLIFY(id%DEPTH_FIRST_SEQ) + NULLIFY(id%SBTR_ID) + NULLIFY(id%MEM_SUBTREE) + NULLIFY(id%MEM_SUBTREE) + NULLIFY(id%MY_ROOT_SBTR) + NULLIFY(id%MY_FIRST_LEAF) + NULLIFY(id%MY_NB_LEAF) + NULLIFY(id%COST_TRAV) + NULLIFY(id%RHSCOMP) + NULLIFY(id%POSINRHSCOMP) + NULLIFY(id%OOC_INODE_SEQUENCE) + NULLIFY(id%OOC_TOTAL_NB_NODES) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + NULLIFY(id%OOC_FILE_NAME_LENGTH) + NULLIFY(id%OOC_FILE_NAMES) + NULLIFY(id%OOC_VADDR) + NULLIFY(id%OOC_NB_FILES) + NULLIFY(id%CB_SON_SIZE) + NULLIFY(id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY(id%root%RHS_ROOT) + NULLIFY(id%root%RG2L_ROW) + NULLIFY(id%root%RG2L_COL) + NULLIFY(id%root%IPIV) + NULLIFY(id%root%SCHUR_POINTER) + NULLIFY(id%SCHUR_CINTERFACE) + id%NELT=0 + NULLIFY(id%ELTPTR) + NULLIFY(id%ELTVAR) + NULLIFY(id%A_ELT) + NULLIFY(id%ELTPROC) + id%SIZE_SCHUR = 0 + NULLIFY( id%LISTVAR_SCHUR ) + NULLIFY( id%SCHUR ) + id%NPROW = 0 + id%NPCOL = 0 + id%MBLOCK = 0 + id%NBLOCK = 0 + id%SCHUR_MLOC = 0 + id%SCHUR_NLOC = 0 + id%SCHUR_LLD = 0 + NULLIFY(id%ISTEP_TO_INIV2) + NULLIFY(id%I_AM_CAND) + NULLIFY(id%FUTURE_NIV2) + NULLIFY(id%TAB_POS_IN_PERE) + NULLIFY(id%CANDIDATES) + CALL ZMUMPS_637(id) + NULLIFY(id%MEM_DIST) + NULLIFY(id%SUP_PROC) + id%Deficiency = 0 + id%root%LPIV = -1 + id%root%yes = .FALSE. + id%root%gridinit_done = .FALSE. + IF ( id%KEEP( 46 ) .ne. 0 .OR. + & id%MYID .ne. MASTER ) THEN + CALL MPI_COMM_RANK + & (id%COMM_NODES, id%MYID_NODES, IERR ) + ELSE + id%MYID_NODES = -464646 + ENDIF + RETURN + END SUBROUTINE ZMUMPS_163 + SUBROUTINE ZMUMPS_252( COMM_LOAD, ASS_IRECV, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, + & FILS, FRERE, DAD, MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER,PTRARW, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & + & NSTK_S,NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, JOBASS, ETATASS + & ) + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mpif.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER IZERO + PARAMETER (IZERO=0) + INTEGER N,LIW,NSTEPS + INTEGER(8) LA, LRLU, LRLUS, IPTRLU, POSFAC + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & IWPOS, IWPOSCB, COMP + INTEGER JOBASS,ETATASS + LOGICAL SON_LEVEL2 + COMPLEX(kind=8) A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER COMM, NBFIN, SLAVEF, MYID + INTEGER LPOOL, LEAF + INTEGER LBUFR, LBUFR_BYTES + INTEGER NBPROCFILS(KEEP(28)) + INTEGER NSTK_S(KEEP(28)),PROCNODE_STEPS(KEEP(28)) + INTEGER IPOOL( LPOOL ) + INTEGER BUFR( LBUFR ) + INTEGER IDUMMY(1) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(N), PTRAIW(N), ND(KEEP(28)), PERM(N), + & FILS(N), FRERE(KEEP(28)), DAD(KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)), + & PAMASTER(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + INTEGER LP, HS, HF + INTEGER NBPANELS_L, NBPANELS_U + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + INTEGER NFS4FATHER + INTEGER(8) NFRONT8, LAELL8, LAELL_REQ8 + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER LREQ_OOC + INTEGER(8) :: SIZFR + INTEGER SIZFI, NCB + INTEGER J1,J2 + INTEGER NCOLS, NROWS, LDA_SON + INTEGER(8) :: JJ2, ICT13 +#if defined(ALLOW_NON_INIT) + INTEGER(8) :: NUMROWS, JJ3, JJ8, APOS_ini +#endif + INTEGER NELIM,JJ,JJ1,J3, + & IBROT,IORG + INTEGER JPOS,ICT11 + INTEGER JK,IJROW,NBCOL,NUMORG,IOLDPS,J4 + INTEGER(8) IACHK, POSELT, LAPOS2, IACHK_ini + INTEGER(8) APOS, APOS2, APOS3, POSEL1, ICT12 + INTEGER AINPUT + INTEGER NSLAVES, NSLSON, NPIVS,NPIV_ANA,NPIV + INTEGER PTRCOL, ISLAVE, PDEST,LEVEL + INTEGER ISON_IN_PLACE + INTEGER ISON_TOP + INTEGER(8) SIZE_ISON_TOP8 + LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS, + & RISK_OF_SAME_POS_THIS_LINE, OMP_PARALLEL_FLAG + LOGICAL LEVEL1, NIV1 + INTEGER TROW_SIZE + INTEGER INDX, FIRST_INDEX, SHIFT_INDEX + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INCLUDE 'mumps_headers.h' + INTEGER NCBSON + LOGICAL SAME_PROC + INTRINSIC real + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INTEGER NELT, LPTRAR + EXTERNAL MUMPS_167 + LOGICAL MUMPS_167 + LOGICAL SSARBR + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + DOUBLE PRECISION FLOP1,FLOP1_EFF + EXTERNAL MUMPS_170 + LOGICAL MUMPS_170 + COMPRESSCB =.FALSE. + NELT = 1 + LPTRAR = N + NFS4FATHER = -1 + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + LEVEL = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (LEVEL.NE.1) THEN + write(6,*) 'Error1 in mpi51f_niv1 ' + CALL MUMPS_ABORT() + ENDIF + NSLAVES = 0 + HF = 6 + NSLAVES + KEEP(IXSZ) + IF (JOBASS.EQ.0) THEN + ETATASS= 0 + ELSE + ETATASS= 2 + IOLDPS = PTLUST_S(STEP(INODE)) + NFRONT = IW(IOLDPS + KEEP(IXSZ)) + NASS1 = iabs(IW(IOLDPS + 2 + KEEP(IXSZ))) + ICT11 = IOLDPS + HF - 1 + NFRONT + SSARBR=MUMPS_167(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + ENDDO + NUMSTK = 0 + IFSON = -IN + ISON = IFSON + IF (ISON .NE. 0) THEN + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + ISON = FRERE(STEP(ISON)) + ENDDO + ENDIF + GOTO 123 + ENDIF + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + ENDDO + NPIV_ANA=NUMORG + NSTEPS = NSTEPS + 1 + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + IF (ISON .NE. 0) THEN + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + NASS = NASS + IW(PIMASTER(STEP(ISON))+1+KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + ENDDO + ENDIF + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + NASS1 = NASS + NUMORG + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL ZMUMPS_684( KEEP(50), NFRONT, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL ZMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + ENDIF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + ENDIF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + ISON_TOP = -9999 + ISON_IN_PLACE = -9999 + SIZE_ISON_TOP8 = 0_8 + IF (KEEP(234).NE.0) THEN + IF ( IWPOSCB .NE. LIW ) THEN + IF ( IWPOSCB+IW(IWPOSCB+1+XXI).NE.LIW) THEN + ISON = IW( IWPOSCB + 1 + XXN ) + IF ( DAD( STEP( ISON ) ) .EQ. INODE .AND. + & MUMPS_330(PROCNODE_STEPS(STEP(ISON)),SLAVEF) + & .EQ. 1 ) + & THEN + ISON_TOP = ISON + CALL MUMPS_729(SIZE_ISON_TOP8,IW(IWPOSCB + 1 + XXR)) + IF (LRLU .LT. int(NFRONT,8) * int(NFRONT,8)) THEN + ISON_IN_PLACE = ISON + ENDIF + END IF + END IF + END IF + END IF + NIV1 = .TRUE. + IF (KEEP(50).EQ.0 .AND. KEEP(234) .EQ. 0) THEN + CALL MUMPS_81(MYID, INODE, N, IOLDPS, HF, NFRONT, + & NFRONT_EFF, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP, KEEP8, IFLAG, + & PROCNODE_STEPS, SLAVEF ) + ELSE + CALL MUMPS_86( MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP, KEEP8, IFLAG, + & ISON_IN_PLACE, + & PROCNODE_STEPS, SLAVEF) + IF (IFLAG.LT.0) GOTO 300 + ENDIF + IF (NFRONT_EFF.NE.NFRONT) THEN + IF (NFRONT.GT.NFRONT_EFF) THEN + IF(MUMPS_170(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF))THEN + NPIV=NASS1-(NFRONT_EFF-ND(STEP(INODE))) + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1) + NPIV=NPIV_ANA + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1_EFF) + CALL ZMUMPS_190(0,.FALSE.,FLOP1-FLOP1_EFF, + & KEEP,KEEP8) + ENDIF + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) ' ERROR 1 during ass_niv1', NFRONT, NFRONT_EFF + GOTO 270 + ENDIF + ENDIF + NFRONT8=int(NFRONT,8) + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL ZMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + NCB = NFRONT - NASS1 + MAXFRW = max0(MAXFRW, NFRONT) + ICT11 = IOLDPS + HF - 1 + NFRONT + LAELL8 = NFRONT8 * NFRONT8 + LAELL_REQ8 = LAELL8 + IF ( ISON_IN_PLACE > 0 ) THEN + LAELL_REQ8 = LAELL8 - SIZE_ISON_TOP8 + ENDIF + IF (LRLU .LT. LAELL_REQ8) THEN + IF (LRLUS .LT. LAELL_REQ8) THEN + GOTO 280 + ELSE + CALL ZMUMPS_94 + & (N, KEEP(28), IW, LIW, A, LA, LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, STEP, PIMASTER, + & PAMASTER,KEEP(216),LRLUS,KEEP(IXSZ)) + COMP = COMP + 1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + ENDIF + ENDIF + ENDIF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + SIZE_ISON_TOP8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + POSFAC = POSFAC + LAELL8 + SSARBR=MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + CALL ZMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS, + & 0_8, + & LAELL8-SIZE_ISON_TOP8, + & KEEP,KEEP8, + & LRLU) +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = min(POSELT + LAELL8 - 1_8, IPTRLU) + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. NFRONT .LT. KEEP(63) ) THEN + LAPOS2 = min(POSELT + LAELL8 - 1_8, IPTRLU) + DO JJ8 = POSELT, LAPOS2 + A( JJ8 ) = ZERO + ENDDO + ELSE + IF (ETATASS.EQ.1) THEN + APOS_ini = POSELT + DO JJ8 = 0_8, NFRONT8 - 1_8 + JJ3 = min(JJ8,int(NASS1-1,8)) + APOS = APOS_ini + JJ8 * NFRONT8 + A(APOS:APOS+JJ3) = ZERO + END DO + ELSE + APOS_ini = POSELT + NUMROWS = min(NFRONT8, (IPTRLU-APOS_ini) / NFRONT8 ) + DO JJ8 = 0_8, NUMROWS - 1_8 + APOS = APOS_ini + JJ8 * NFRONT8 + A(APOS:APOS + JJ8) = ZERO + ENDDO + IF( NUMROWS .LT. NFRONT8 ) THEN + APOS = APOS_ini + NFRONT8*NUMROWS + A(APOS : min(IPTRLU,APOS+NUMROWS)) = ZERO + ENDIF + ENDIF + END IF +#endif + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + IW(IOLDPS + KEEP(IXSZ)) = NFRONT + IW(IOLDPS + KEEP(IXSZ) + 1) = 0 + IW(IOLDPS + KEEP(IXSZ) + 2) = -NASS1 + IW(IOLDPS + KEEP(IXSZ) + 3) = -NASS1 + IW(IOLDPS + KEEP(IXSZ) + 4) = STEP(INODE) + IW(IOLDPS + KEEP(IXSZ) + 5) = NSLAVES + 123 CONTINUE + IF (NUMSTK.NE.0) THEN + IF (ISON_TOP > 0) THEN + ISON = ISON_TOP + ELSE + ISON = IFSON + ENDIF + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NELIM = IW(ISTCHK + KEEP(IXSZ) + 1) + NPIVS = IW(ISTCHK + KEEP(IXSZ) + 3) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + HS = 6 + KEEP(IXSZ) + NSLSON + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + LEVEL1 = NSLSON.EQ.0 + IF (.NOT.SAME_PROC) THEN + NROWS = IW( ISTCHK + KEEP(IXSZ) + 2) + ELSE + NROWS = NCOLS + ENDIF + SIZFI = HS + NROWS + NCOLS + J1 = ISTCHK + HS + NROWS + NPIVS + IF ( .NOT. LEVEL1 .AND. NELIM.EQ.0 ) GOTO 205 + IF (LEVEL1) THEN + J2 = J1 + LSTK - 1 + SIZFR = int(LSTK,8)*int(LSTK,8) + IF (COMPRESSCB) SIZFR = (int(LSTK,8)*int(LSTK+1,8))/2_8 + ELSE + IF ( KEEP(50).eq.0 ) THEN + SIZFR = int(NELIM,8) * int(LSTK,8) + ELSE + SIZFR = int(NELIM,8) * int(NELIM,8) + END IF + J2 = J1 + NELIM - 1 + ENDIF + IF (JOBASS.EQ.0) OPASSW = OPASSW + dble(SIZFR) + IACHK = PAMASTER(STEP(ISON)) + IF ( KEEP(50) .eq. 0 ) THEN + POSEL1 = PTRAST(STEP(INODE)) - NFRONT8 + IF (NFRONT .EQ. LSTK.AND. ISON.EQ.ISON_IN_PLACE + & .AND.IACHK + SIZFR - 1_8 .EQ. POSFAC - 1_8 ) THEN + GOTO 205 + ENDIF + IF (J2.GE.J1) THEN + RESET_TO_ZERO = (IACHK .LT. POSFAC) + RISK_OF_SAME_POS = IACHK + SIZFR - 1_8 .EQ. POSFAC - 1_8 + RISK_OF_SAME_POS_THIS_LINE = .FALSE. + IACHK_ini = IACHK + OMP_PARALLEL_FLAG = (RESET_TO_ZERO.EQV..FALSE.).AND. + & ((J2-J1).GT.300) + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * int(NFRONT,8) + IACHK = IACHK_ini + int(JJ-J1,8)*int(LSTK,8) + IF (RISK_OF_SAME_POS) THEN + IF (JJ.EQ.J2) THEN + RISK_OF_SAME_POS_THIS_LINE = + & (ISON .EQ. ISON_IN_PLACE) + & .AND. ( APOS + int(IW(J1+LSTK-1)-1,8).EQ. + & IACHK+int(LSTK-1,8) ) + ENDIF + ENDIF + IF ((IACHK .GE. POSFAC).AND.(JJ>J1))THEN + RESET_TO_ZERO =.FALSE. + ENDIF + IF (RESET_TO_ZERO) THEN + IF (RISK_OF_SAME_POS_THIS_LINE) THEN + DO JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + IF ( IACHK+int(JJ1-1,8) .NE. JJ2 ) THEN + A(JJ2) = A(IACHK + int(JJ1 - 1,8)) + A(IACHK + int(JJ1 -1,8)) = ZERO + ENDIF + ENDDO + ELSE + DO JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1+JJ1-1),8) - 1_8 + A(JJ2) = A(IACHK + int(JJ1 - 1,8)) + A(IACHK + int(JJ1 -1,8)) = ZERO + ENDDO + ENDIF + ELSE + DO JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1+JJ1-1),8) - 1_8 + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8)) + ENDDO + ENDIF + 170 CONTINUE + END IF + ELSE + IF (LEVEL1) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = SIZFR + ELSE + LCB = int(LDA_SON,8)* int(J2-J1+1,8) + ENDIF + CALL ZMUMPS_178(A, LA, + & PTRAST(STEP( INODE )), NFRONT, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), J2 - J1 + 1, NELIM, ETATASS, + & COMPRESSCB, (ISON.EQ.ISON_IN_PLACE) + & ) + ENDIF + 205 IF (LEVEL1) THEN + IF (SAME_PROC) ISTCHK = PTRIST(STEP(ISON)) + IF ((SAME_PROC).AND.ETATASS.NE.1) THEN + IF (KEEP(50).NE.0) THEN + J2 = J1 + LSTK - 1 + DO JJ = J1, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + ELSE + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM + DO JJ = J3, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + IF (NELIM .NE. 0) THEN + J3 = J3 - 1 + DO JJ = J1, J3 + JPOS = IW(JJ) + ICT11 + IW(JJ) = IW(JPOS) + ENDDO + ENDIF + ENDIF + ENDIF + IF (ETATASS.NE.1) THEN + IF ( SAME_PROC ) THEN + PTRIST(STEP(ISON)) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL ZMUMPS_152(SSARBR, MYID, N, ISTCHK, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, + & (ISON .EQ. ISON_TOP) + & ) + ENDIF + ELSE + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP, KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL ZMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, IDUMMY, + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, + & LEAF, NBFIN, ICNTL, KEEP, KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + ENDDO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL ZMUMPS_71( + & INODE, NFRONT, NASS1, NFS4FATHER, + & ISON, MYID, + & IZERO, IDUMMY, IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, + & KEEP, KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( + & COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP, KEEP8, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + IF (ISON .LE. 0) THEN + ISON = IFSON + ENDIF + 220 CONTINUE + END IF + IF (ETATASS.EQ.2) GOTO 500 + POSELT = PTRAST(STEP(INODE)) + IBROT = INODE + DO 260 IORG = 1, NUMORG + JK = PTRAIW(IBROT) + AINPUT = PTRARW(IBROT) + JJ = JK + 1 + J1 = JJ + 1 + J2 = J1 + INTARR(JK) + J3 = J2 + 1 + J4 = J2 - INTARR(JJ) + IJROW = INTARR(J1) + ICT12 = POSELT + int(IJROW - NFRONT - 1,8) +Cduplicates --> CVD$ DEPCHK + DO 240 JJ = J1, J2 + APOS2 = ICT12 + int(INTARR(JJ),8) * NFRONT8 + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + 1 + 240 CONTINUE + IF (J3 .LE. J4) THEN + ICT13 = POSELT + int(IJROW - 1,8) * NFRONT8 + NBCOL = J4 - J3 + 1 +Cduplicates--> CVD$ DEPCHK +CduplicatesCVD$ NODEPCHK + DO 250 JJ = 1, NBCOL + APOS3 = ICT13 + int(INTARR(J3 + JJ - 1) - 1,8) + A(APOS3) = A(APOS3) + DBLARR(AINPUT + JJ - 1) + 250 CONTINUE + ENDIF + IF (KEEP(50).EQ.0) THEN + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(IJROW-1,8) * NFRONT8 + + & int(NFRONT-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ELSE + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(NFRONT-KEEP(253)+JJ-1,8) * NFRONT8 + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + 260 CONTINUE + GOTO 500 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER ALLOCATION DURING ZMUMPS_252' + ENDIF + GOTO 490 + 280 CONTINUE + IFLAG = -9 + CALL MUMPS_731(LAELL_REQ8 - LRLUS, IERROR) + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, WORKSPACE TOO SMALL DURING ZMUMPS_252' + ENDIF + GOTO 490 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, SEND BUFFER TOO SMALL DURING ZMUMPS_252' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, SEND BUFFER TOO SMALL DURING ZMUMPS_252' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING ZMUMPS_252' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 1 + 490 CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_252 + SUBROUTINE ZMUMPS_253(COMM_LOAD, ASS_IRECV, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, FILS, FRERE, DAD, + & CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_S, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP, KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, LEAF, IPOOL, LPOOL, + & PERM , MEM_DISTRIB) + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N,LIW,NSTEPS, NBFIN + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & LPOOL, LEAF, IWPOS, IWPOSCB, COMP + INTEGER(8) :: LRLUS, LRLU, IPTRLU, POSFAC + COMPLEX(kind=8) A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER COMM, SLAVEF, MYID, LBUFR, LBUFR_BYTES + INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB + INTEGER IPOOL(LPOOL) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(N), PTRAIW(N), ND(KEEP(28)), + & FILS(N), FRERE(KEEP(28)), DAD (KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), + & PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), PERM(N) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER CAND(SLAVEF+1, max(1,KEEP(56))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER NBPROCFILS(KEEP(28)), + & PROCNODE_STEPS(KEEP(28)), BUFR(LBUFR) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + INTEGER LP, HS, HF, HF_OLD,NCBSON, NSLAVES_OLD, + & NBSPLIT + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + INTEGER NFS4FATHER,I + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER(8) :: LAELL8 + INTEGER LREQ_OOC + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + INTEGER NCB + INTEGER J1,J2,J3,MP + INTEGER(8) :: JJ8, LAPOS2, JJ2, JJ3 + INTEGER NELIM,JJ,JJ1,NPIVS,NCOLS,NROWS, + & IBROT,IORG + INTEGER LDAFS, LDA_SON + INTEGER JK,IJROW,NBCOL,NUMORG,IOLDPS,J4, NUMORG_SPLIT + INTEGER(8) :: ICT13 + INTEGER(8) :: IACHK, APOS, APOS2, POSELT, ICT12, POSEL1 + INTEGER AINPUT + INTEGER NSLAVES, NSLSON + INTEGER NBLIG, PTRCOL, PTRROW, ISLAVE, PDEST + INTEGER PDEST1(1) + INTEGER TYPESPLIT + INTEGER ISON_IN_PLACE + LOGICAL IS_ofType5or6 + LOGICAL SAME_PROC, NIV1, SON_LEVEL2 + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX + INTEGER IZERO + INTEGER IDUMMY(1) + PARAMETER( IZERO = 0 ) + INTEGER MUMPS_275, MUMPS_330, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, MUMPS_810 + COMPLEX(kind=8) ZERO + DOUBLE PRECISION RZERO + PARAMETER(RZERO = 0.0D0 ) + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INTEGER NELT, LPTRAR, NCBSON_MAX + logical :: force_cand + INTEGER ETATASS + INCLUDE 'mumps_headers.h' + INTEGER (8) :: APOSMAX + DOUBLE PRECISION MAXARR + INTEGER INIV2, SIZE_TMP_SLAVES_LIST, allocok, + & NCB_SPLIT, SIZE_LIST_SPLIT + INTEGER, ALLOCATABLE, DIMENSION(:) :: TMP_SLAVES_LIST, COPY_CAND + INTEGER NBPANELS_L, NBPANELS_U + MP = ICNTL(2) + IS_ofType5or6 = .FALSE. + COMPRESSCB = .FALSE. + ETATASS = 0 + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + NSTEPS = NSTEPS + 1 + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + ENDDO + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + NCBSON_MAX = 0 + NELT = 1 + LPTRAR = 1 + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + IF ( KEEP(48)==5 .AND. + & MUMPS_330(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) .EQ. 1) THEN + NCBSON_MAX = max + & ( + & IW(PIMASTER(STEP(ISON))+KEEP(IXSZ)), NCBSON_MAX + & ) + ENDIF + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + ENDDO + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + NASS1 = NASS + NUMORG + NCB = NFRONT - NASS1 + if((KEEP(24).eq.0).or.(KEEP(24).eq.1)) then + force_cand=.FALSE. + else + force_cand=(mod(KEEP(24),2).eq.0) + end if + IF (force_cand) THEN + INIV2 = ISTEP_TO_INIV2( STEP( INODE )) + SIZE_TMP_SLAVES_LIST = CAND( SLAVEF+1, INIV2 ) + ELSE + INIV2 = 1 + SIZE_TMP_SLAVES_LIST = SLAVEF - 1 + ENDIF + ALLOCATE(TMP_SLAVES_LIST(SIZE_TMP_SLAVES_LIST),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + TYPESPLIT = MUMPS_810 (PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IS_ofType5or6 = (TYPESPLIT.EQ.5 .OR. TYPESPLIT.EQ.6) + IF ( (TYPESPLIT.EQ.4) + & .OR.(TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) + & ) THEN + IF (TYPESPLIT.EQ.4) THEN + ALLOCATE(COPY_CAND(SLAVEF+1),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + CALL ZMUMPS_791 ( + & INODE, STEP, N, SLAVEF, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & CAND(1,INIV2), ICNTL, COPY_CAND, + & NBSPLIT, NUMORG_SPLIT, TMP_SLAVES_LIST(1), + & SIZE_TMP_SLAVES_LIST + & ) + NCB_SPLIT = NCB-NUMORG_SPLIT + SIZE_LIST_SPLIT = SIZE_TMP_SLAVES_LIST - NBSPLIT + CALL ZMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, COPY_CAND, + & MEM_DISTRIB(0), NCB_SPLIT, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST(NBSPLIT+1), + & SIZE_LIST_SPLIT,INODE ) + DEALLOCATE (COPY_CAND) + CALL ZMUMPS_790 ( + & INODE, STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, + & TAB_POS_IN_PERE(1,INIV2), + & NSLAVES + & ) + ELSE + ISTCHK = PIMASTER(STEP(IFSON)) + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + TMP_SLAVES_LIST (1:SIZE_TMP_SLAVES_LIST) + & = CAND (1:SIZE_TMP_SLAVES_LIST, INIV2) + CALL ZMUMPS_792 ( + & INODE, TYPESPLIT, IFSON, + & IW(PDEST), NSLSON, + & STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, ISTEP_TO_INIV2, INIV2, + & TAB_POS_IN_PERE, NSLAVES, + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST + & ) + ENDIF + ELSE + CALL ZMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL ZMUMPS_684(KEEP(50), NASS1, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL ZMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, + & KEEP(216),LRLUS,KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + ENDIF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + ENDIF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + NIV1 = .FALSE. + IF (KEEP(50).EQ.0 .AND. KEEP(234).EQ.0) THEN + CALL MUMPS_81(MYID, INODE, N, IOLDPS, HF, NFRONT, + & NFRONT_EFF, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG, + & PROCNODE_STEPS, SLAVEF ) + ELSE + ISON_IN_PLACE = -9999 + CALL MUMPS_86( MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, DAD, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, IW, LIW, + & INTARR, ITLOC, RHS_MUMPS, FILS, FRERE, + & SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG, + & ISON_IN_PLACE, + & PROCNODE_STEPS, SLAVEF) + IF (IFLAG.LT.0) GOTO 250 + ENDIF + IF ( NFRONT .NE. NFRONT_EFF ) THEN + IF ( + & (TYPESPLIT.EQ.5) .OR. (TYPESPLIT.EQ.6) ) THEN + WRITE(6,*) ' Internal error 1 in fac_ass due to plitting ', + & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ENDIF + IF (NFRONT.GT.NFRONT_EFF) THEN + NCB = NFRONT_EFF - NASS1 + NSLAVES_OLD = NSLAVES + HF_OLD = HF + IF (TYPESPLIT.EQ.4) THEN + WRITE(6,*) ' Internal error 2 in fac_ass due', + & ' to splitting ', + & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ELSE + CALL ZMUMPS_472( NCBSON_MAX, + & SLAVEF, KEEP,KEEP8, ICNTL, + & CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT_EFF, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) - + & (NSLAVES_OLD - NSLAVES) + IF (NSLAVES_OLD .NE. NSLAVES) THEN + IF (NSLAVES_OLD > NSLAVES) THEN + DO JJ=0,2*NFRONT_EFF-1 + IW(IOLDPS+HF+JJ)=IW(IOLDPS+HF_OLD+JJ) + ENDDO + ELSE + IF (IWPOS - 1 > IWPOSCB ) GOTO 270 + DO JJ=2*NFRONT_EFF-1, 0, -1 + IW(IOLDPS+HF+JJ) = IW(IOLDPS+HF_OLD+JJ) + ENDDO + END IF + END IF + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) MYID,': ERROR 2 during ass_niv2, INODE=', INODE, + & ' NFRONT, NFRONT_EFF=', NFRONT, NFRONT_EFF + GOTO 270 + ENDIF + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL ZMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + MAXFRW = max0(MAXFRW, NFRONT) + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS + 1+KEEP(IXSZ)) = 0 + IW(IOLDPS + 2+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 3+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) + IW(IOLDPS+KEEP(IXSZ)) = NFRONT + IW(IOLDPS+5+KEEP(IXSZ)) = NSLAVES + IW(IOLDPS+6+KEEP(IXSZ):IOLDPS+5+KEEP(IXSZ)+NSLAVES)= + & TMP_SLAVES_LIST(1:NSLAVES) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + IF ( KEEP(73) .EQ. 0 ) THEN +#endif +#endif + CALL ZMUMPS_461(MYID, SLAVEF, COMM_LOAD, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, IW(IOLDPS+6+KEEP(IXSZ)), NSLAVES,INODE) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + ENDIF +#endif +#endif + IF(KEEP(86).EQ.1)THEN + IF(mod(KEEP(24),2).eq.0)THEN + CALL ZMUMPS_533(SLAVEF,CAND(SLAVEF+1,INIV2), + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE) + ELSEIF((KEEP(24).EQ.0).OR.(KEEP(24).EQ.1))THEN + CALL ZMUMPS_533(SLAVEF,SLAVEF-1, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE) + ENDIF + ENDIF + DEALLOCATE(TMP_SLAVES_LIST) + IF (KEEP(50).EQ.0) THEN + LAELL8 = int(NASS1,8) * int(NFRONT,8) + LDAFS = NFRONT + ELSE + LAELL8 = int(NASS1,8)*int(NASS1,8) + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) + & LAELL8 = LAELL8+int(NASS1,8) + LDAFS = NASS1 + ENDIF + IF (LRLU .LT. LAELL8) THEN + IF (LRLUS .LT. LAELL8) THEN + GOTO 280 + ELSE + CALL ZMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + ENDIF + ENDIF + ENDIF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + POSFAC = POSFAC + LAELL8 + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + CALL ZMUMPS_471(.FALSE.,.FALSE.,LA-LRLUS,0_8,LAELL8, + & KEEP,KEEP8,LRLU) + POSEL1 = POSELT - int(LDAFS,8) +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. LDAFS .lt. KEEP(63) ) THEN + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO + ELSE + APOS = POSELT + DO JJ8 = 0_8, int(LDAFS-1,8) + A(APOS:APOS+JJ8) = ZERO + APOS = APOS + int(LDAFS,8) + END DO + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + A(APOS:APOS+int(LDAFS,8)-1_8)=ZERO + ENDIF + END IF +#endif + IF ((NUMSTK.NE.0).AND.(NASS.NE.0)) THEN + ISON = IFSON + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + IF (NELIM.EQ.0) GOTO 210 + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS=0 + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + 2+KEEP(IXSZ)) + ELSE + NROWS = NCOLS + ENDIF + OPASSW = OPASSW + dble(NELIM*LSTK) + J1 = ISTCHK + HS + NROWS + NPIVS + J2 = J1 + NELIM - 1 + IACHK = PAMASTER(STEP(ISON)) + IF (KEEP(50).eq.0) THEN + IF (IS_ofType5or6) THEN + APOS = POSELT + DO JJ8 = 1_8, int(NELIM,8)*int(LSTK,8) + A(APOS+JJ8-1_8) = A(APOS+JJ8-1_8) + A(IACHK+JJ8-1_8) + ENDDO + ELSE + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * int(LDAFS,8) + DO 160 JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1),8) - 1_8 + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8)) + 160 CONTINUE + IACHK = IACHK + int(LSTK,8) + 170 CONTINUE + ENDIF + ELSE + IF (NSLSON.EQ.0) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = (int(NELIM,8)*int(NELIM+1,8))/2_8 + ELSE + LCB = int(LDA_SON,8)*int(NELIM,8) + ENDIF + CALL ZMUMPS_178( A, LA, + & POSELT, LDAFS, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), NELIM, NELIM, ETATASS, + & COMPRESSCB, + & .FALSE. + & ) + ENDIF + 210 ISON = FRERE(STEP(ISON)) + 220 CONTINUE + ENDIF + IBROT = INODE + APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8) + DO 260 IORG = 1, NUMORG + JK = PTRAIW(IBROT) + AINPUT = PTRARW(IBROT) + JJ = JK + 1 + J1 = JJ + 1 + J2 = J1 + INTARR(JK) + J3 = J2 + 1 + J4 = J2 - INTARR(JJ) + IJROW = INTARR(J1) + ICT12 = POSELT + int(IJROW - 1 - LDAFS, 8) + MAXARR = RZERO +CduplicatesCVD$ NODEPCHK + DO 240 JJ = J1, J2 + IF (KEEP(219).NE.0) THEN + IF (INTARR(JJ).LE.NASS1) THEN + APOS2 = ICT12 + int(INTARR(JJ),8) * int(LDAFS,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + ELSEIF (KEEP(50).EQ.2) THEN + MAXARR = max(MAXARR,abs(DBLARR(AINPUT))) + ENDIF + ELSE + IF (INTARR(JJ).LE.NASS1) THEN + APOS2 = ICT12 + int(INTARR(JJ),8) * int(LDAFS,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + ENDIF + ENDIF + AINPUT = AINPUT + 1 + 240 CONTINUE + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN + A(APOSMAX+int(IJROW-1,8)) = cmplx(MAXARR,kind=kind(A)) + ENDIF + IF (J3 .GT. J4) GOTO 255 + ICT13 = POSELT + int(IJROW - 1,8) * int(LDAFS,8) + NBCOL = J4 - J3 + 1 +CduplicatesCVD$ NODEPCHK +CduplicatesCVD$ NODEPCHK + DO JJ = 1, NBCOL + JJ3 = ICT13 + int(INTARR(J3 + JJ - 1),8) - 1_8 + A(JJ3) = A(JJ3) + DBLARR(AINPUT + JJ - 1) + ENDDO + 255 CONTINUE + IF (KEEP(50).EQ.0) THEN + DO JJ = 1, KEEP(253) + APOS = POSELT + + & int(IJROW-1,8) * int(LDAFS,8) + + & int(LDAFS-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + 260 CONTINUE + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + PDEST = IOLDPS + 6 + KEEP(IXSZ) + DO ISLAVE = 1, NSLAVES + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB, + & NSLAVES, + & NBLIG, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + IERR = -1 + DO WHILE (IERR .EQ.-1) + IF ( KEEP(50) .eq. 0 ) THEN + NBCOL = NFRONT + CALL ZMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & IZERO, IDUMMY, + & IW(PDEST), NFRONT, COMM, IERR) + ELSE + NBCOL = NASS1+SHIFT_INDEX+NBLIG + CALL ZMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & NSLAVES-ISLAVE, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE), + & IW(PDEST), NFRONT, COMM, IERR) + ENDIF + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + IF (MESSAGE_RECEIVED) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + SHIFT_INDEX + ENDIF + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 300 + IF (IERR .EQ. -3) GOTO 305 + PTRROW = PTRROW + NBLIG + PDEST = PDEST + 1 + ENDDO + IF (NUMSTK.EQ.0) GOTO 500 + ISON = IFSON + DO IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + 2+KEEP(IXSZ)) + ELSE + NROWS = NCOLS + ENDIF + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + IF (KEEP(219).NE.0) THEN + IF(KEEP(50) .EQ. 2) THEN + NFS4FATHER = NCBSON + DO I=0,NCBSON-1 + IF(IW(PTRCOL+I) .GT. NASS1) THEN + NFS4FATHER = I + EXIT + ENDIF + ENDDO + NFS4FATHER = NFS4FATHER+NELIM + ELSE + NFS4FATHER = 0 + ENDIF + ELSE + NFS4FATHER = 0 + ENDIF + IF (NSLSON.EQ.0) THEN + NSLSON = 1 + PDEST1(1) = MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) + IF (PDEST1(1).EQ.MYID) THEN + CALL ZMUMPS_211( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)), + & NFRONT, NASS1, NFS4FATHER, NCBSON, + & IW( PTRCOL ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, IW, IW, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ELSE + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON))+HS+NROWS+NPIVS+NELIM + CALL ZMUMPS_71( + & INODE, NFRONT,NASS1,NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ) ), + & IW(PTRCOL), NCBSON, + & COMM, IERR, PDEST1, NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ELSE + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL ZMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, LPTRAR, NELT, IW, + & IW, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + ENDDO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL ZMUMPS_71( + & INODE, NFRONT,NASS1, NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW(PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, IW, IW, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + ENDDO + GOTO 500 + 250 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING + & ZMUMPS_253' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 1 + GOTO 490 + 265 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE ALLOCATING TMP_SLAVES_LIST', + & ' DURING ZMUMPS_253' + ENDIF + IFLAG = -13 + IERROR = SIZE_TMP_SLAVES_LIST + GOTO 490 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER ALLOCATION DURING ZMUMPS_253' + ENDIF + GOTO 490 + 280 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, WORKSPACE TOO SMALL DURING ZMUMPS_253' + ENDIF + IFLAG = -9 + CALL MUMPS_731(LAELL8-LRLUS, IERROR) + GOTO 490 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SEND BUFFER TOO SMALL (1) DURING ZMUMPS_253' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECV BUFFER TOO SMALL (1) DURING ZMUMPS_253' + ENDIF + IFLAG = -20 + LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SEND BUFFER TOO SMALL (2) DURING ZMUMPS_253' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 305 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECV BUFFER TOO SMALL (2) DURING ZMUMPS_253' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + 490 CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_253 + SUBROUTINE ZMUMPS_39(N, INODE, IW, LIW, A, LA, + & ISON, NBROWS, NBCOLS, ROWLIST, + & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER, + & OPASSW, IWPOSCB, MYID, KEEP,KEEP8, IS_ofType5or6, + & LDA_VALSON ) + USE ZMUMPS_LOAD + IMPLICIT NONE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA + INTEGER N,LIW,MYID + INTEGER INODE,ISON, IWPOSCB + INTEGER NBROWS, NBCOLS, LDA_VALSON + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER IW(LIW), STEP(N), PIMASTER(KEEP(28)), + & PTLUST_S(KEEP(28)), ROWLIST(NBROWS) + COMPLEX(kind=8) A(LA), VALSON(LDA_VALSON,NBROWS) + DOUBLE PRECISION OPASSW + LOGICAL, INTENT(IN) :: IS_ofType5or6 + INTEGER(8) :: POSELT, POSEL1, APOS, JJ2 + INTEGER HF,HS, NSLAVES, NFRONT, NASS1, + & IOLDPS, ISTCHK, LSTK, NSLSON,NELIM, + & NPIVS,NCOLS,J1,JJ,JJ1,NROWS, + & LDAFS_PERE, IBEG, DIAG + INCLUDE 'mumps_headers.h' + LOGICAL SAME_PROC + INTRINSIC real + IOLDPS = PTLUST_S(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS1 = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + IF (KEEP(50).EQ.0) THEN + LDAFS_PERE = NFRONT + ELSE + IF ( NSLAVES .eq. 0 ) THEN + LDAFS_PERE = NFRONT + ELSE + LDAFS_PERE = NASS1 + ENDIF + ENDIF + HF = 6 + NSLAVES + KEEP(IXSZ) + POSEL1 = POSELT - int(LDAFS_PERE,8) + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + OPASSW = OPASSW + dble(NBROWS*NBCOLS) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LT.IWPOSCB) + IF (SAME_PROC) THEN + NROWS = NCOLS + ELSE + NROWS = IW(ISTCHK+2+KEEP(IXSZ)) + ENDIF + J1 = ISTCHK + NROWS + HS + NPIVS + IF (KEEP(50).EQ.0) THEN + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(LDAFS_PERE,8) + DO JJ = 1, NBROWS + DO JJ1 = 1, NBCOLS + JJ2 = APOS + int(JJ1-1,8) + A(JJ2)=A(JJ2)+VALSON(JJ1,JJ) + ENDDO + APOS = APOS + int(LDAFS_PERE,8) + ENDDO + ELSE + DO 170 JJ = 1, NBROWS + APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8) + DO 160 JJ1 = 1, NBCOLS + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + 160 CONTINUE + 170 CONTINUE + ENDIF + ELSE + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(LDAFS_PERE,8) + DIAG = ROWLIST(1) + DO JJ = 1, NBROWS + DO JJ1 = 1, DIAG + JJ2 = APOS+int(JJ1-1,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + ENDDO + DIAG = DIAG+1 + APOS = APOS + int(LDAFS_PERE,8) + ENDDO + ELSE + DO JJ = 1, NBROWS + IF (ROWLIST(JJ).LE.NASS1.and..NOT.IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(JJ) - 1,8) + DO JJ1 = 1, NELIM + JJ2 = APOS + int(IW(J1+JJ1-1),8)*int(LDAFS_PERE,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + ENDDO + IBEG = NELIM+1 + ELSE + IBEG = 1 + ENDIF + APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8) + DO JJ1 = IBEG, NBCOLS + IF (ROWLIST(JJ).LT.IW(J1 + JJ1 - 1)) EXIT + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) + ENDDO + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_39 + SUBROUTINE ZMUMPS_539 + & (N, INODE, IW, LIW, A, LA, + & NBROWS, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, + & RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, MYID) + IMPLICIT NONE + INTEGER N,LIW + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER INODE, MYID + INTEGER NBROWS, NBCOLS + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), + & PTRIST(KEEP(28)), FILS(N), PTRARW(N), PTRAIW(N) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX(kind=8) A(LA), + & DBLARR(max(1,KEEP(13))) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER(8) :: POSELT, ICT12, APOS + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & K1,K2,K,J,JPOS,NASS,JJ, + & IN,AINPUT,JK,J1,J2,IJROW, ILOC + INTEGER :: K1RHS, K2RHS, JFirstRHS + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INCLUDE 'mumps_headers.h' + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NASS = IW(IOLDPS+1+KEEP(IXSZ)) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES + KEEP(IXSZ) + IF (NASS.LT.0) THEN + NASS = -NASS + IW(IOLDPS+1+KEEP(IXSZ)) = NASS + A(POSELT:POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8) = + & ZERO + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NASS - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -JPOS + JPOS = JPOS + 1 + ENDDO + K1 = IOLDPS + HF + K2 = K1 + NBROWF - 1 + JPOS = 1 + IF ((KEEP(253).GT.0).AND.(KEEP(50).NE.0)) THEN + K1RHS = 0 + K2RHS = -1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + IF ((K1RHS.EQ.0).AND.(J.GT.N)) THEN + K1RHS = K + JFirstRHS=J-N + ENDIF + JPOS = JPOS + 1 + ENDDO + IF (K1RHS.GT.0) K2RHS=K2 + IF ( K2RHS.GE.K1RHS ) THEN + IN = INODE + DO WHILE (IN.GT.0) + IJROW = -ITLOC(IN) + DO K = K1RHS, K2RHS + J = IW(K) + ILOC = ITLOC(J) + APOS = POSELT+int(ILOC-1,8)*int(NBCOLF,8) + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( + & (JFirstRHS+(K-K1RHS)-1)*KEEP(254)+IN) + ENDDO + IN = FILS(IN) + ENDDO + ENDIF + ELSE + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + JPOS = JPOS + 1 + ENDDO + ENDIF + IN = INODE + DO WHILE (IN.GT.0) + AINPUT = PTRARW(IN) + JK = PTRAIW(IN) + JJ = JK + 1 + J1 = JJ + 1 + J2 = J1 + INTARR(JK) + IJROW = -ITLOC(INTARR(J1)) + ICT12 = POSELT +int(- NBCOLF + IJROW - 1,8) + DO JJ= J1,J2 + ILOC = ITLOC(INTARR(JJ)) + IF (ILOC.GT.0) THEN + APOS = ICT12 + int(ILOC,8)*int(NBCOLF,8) + A(APOS) = A(APOS) + DBLARR(AINPUT) + ENDIF + AINPUT = AINPUT + 1 + ENDDO + IN = FILS(IN) + ENDDO + K1 = IOLDPS + HF + K2 = K1 + NBROWF + NASS - 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = 0 + ENDDO + ENDIF + IF (NBROWS.GT.0) THEN + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + JPOS = JPOS + 1 + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_539 + SUBROUTINE ZMUMPS_531 + & (N, INODE, IW, LIW, NBROWS, STEP, PTRIST, + & ITLOC, RHS_MUMPS, KEEP,KEEP8) + IMPLICIT NONE + INTEGER N, LIW + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER INODE + INTEGER NBROWS + INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), + & PTRIST(KEEP(28)) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INCLUDE 'mumps_headers.h' + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & K1,K2,K,J + IOLDPS = PTRIST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + IF (NBROWS.GT.0) THEN + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = 0 + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_531 + SUBROUTINE ZMUMPS_40(N, INODE, IW, LIW, A, LA, + & NBROWS, NBCOLS, ROWLIST, COLLIST, VALSON, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, + & RHS_MUMPS, FILS, + & ICNTL, KEEP,KEEP8, MYID, IS_ofType5or6, LDA_VALSON) + IMPLICIT NONE + INTEGER N,LIW + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER INODE, MYID + LOGICAL, intent(in) :: IS_ofType5or6 + INTEGER NBROWS, NBCOLS, LDA_VALSON + INTEGER ROWLIST(NBROWS), COLLIST(NBCOLS) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), + & PTRIST(KEEP(28)), FILS(N) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRAST(KEEP(28)) + COMPLEX(kind=8) A(LA), VALSON(LDA_VALSON,NBROWS) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER(8) :: POSEL1, POSELT, APOS, K8 + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & I,J,NASS,IDIAG + INCLUDE 'mumps_headers.h' + INTRINSIC real + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NASS = IW(IOLDPS+1+KEEP(IXSZ)) + IF ( NBROWS .GT. NBROWF ) THEN + WRITE(*,*) ' ERR: ERROR : NBROWS > NBROWF' + WRITE(*,*) ' ERR: INODE =', INODE + WRITE(*,*) ' ERR: NBROW=',NBROWS,'NBROWF=',NBROWF + WRITE(*,*) ' ERR: ROW_LIST=', ROWLIST + CALL MUMPS_ABORT() + END IF + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + IF (NBROWS.GT.0) THEN + POSEL1 = POSELT - int(NBCOLF,8) + IF (KEEP(50).EQ.0) THEN + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8) + DO I=1, NBROWS + DO J = 1, NBCOLS + A(APOS+int(J-1,8)) = A( APOS+int(J-1,8)) + VALSON(J,I) + ENDDO + APOS = APOS + int(NBCOLF,8) + END DO + ELSE + DO I=1,NBROWS + APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8) + DO J=1,NBCOLS + K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8 + A(K8) = A(K8) + VALSON(J,I) + ENDDO + ENDDO + ENDIF + ELSE + IF (IS_ofType5or6) THEN + APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8) + & + int((NBROWS-1),8)*int(NBCOLF,8) + IDIAG = 0 + DO I=NBROWS,1,-1 + A(APOS:APOS+int(NBCOLS-IDIAG-1,8))= + & A(APOS:APOS+int(NBCOLS-IDIAG-1,8)) + + & VALSON(1:NBCOLS-IDIAG,I) + APOS = APOS - int(NBCOLF,8) + IDIAG = IDIAG + 1 + ENDDO + ELSE + DO I=1,NBROWS + APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8) + DO J=1,NBCOLS + IF (ITLOC(COLLIST(J)) .EQ. 0) THEN + write(6,*) ' .. exit for col =', J + EXIT + ENDIF + K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8 + A(K8) = A(K8) + VALSON(J,I) + ENDDO + ENDDO + ENDIF + ENDIF + OPASSW = OPASSW + dble(NBROWS*NBCOLS) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_40 + SUBROUTINE ZMUMPS_178( A, LA, + & IAFATH, NFRONT, NASS1, + & IACB, NCOLS, LCB, + & IW, NROWS, NELIM, ETATASS, + & CB_IS_COMPRESSED, IS_INPLACE + & ) + IMPLICIT NONE + INTEGER NFRONT, NASS1 + INTEGER(8) :: LA + INTEGER NCOLS, NROWS, NELIM + INTEGER(8) :: LCB + COMPLEX(kind=8) A( LA ) + INTEGER(8) :: IAFATH, IACB + INTEGER IW( NCOLS ) + INTEGER ETATASS + LOGICAL CB_IS_COMPRESSED, IS_INPLACE + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS, + & RISK_OF_SAME_POS_THIS_LINE, OMP_FLAG + INTEGER I, J + INTEGER(8) :: APOS, POSELT + INTEGER(8) :: IPOSCB, IBEGCBROW, IENDFRONT + IENDFRONT = IAFATH+int(NFRONT,8)*int(NFRONT,8)-1_8 + IF ( IS_INPLACE ) THEN + IPOSCB=1_8 + RESET_TO_ZERO = IACB .LT. IENDFRONT + 1_8 + RISK_OF_SAME_POS = IACB + LCB .EQ. IENDFRONT + 1_8 + RISK_OF_SAME_POS_THIS_LINE = .FALSE. + DO I=1, NROWS + POSELT = int(IW(I)-1,8) * int(NFRONT,8) + IF (.NOT. CB_IS_COMPRESSED ) THEN + IPOSCB = 1_8 + int(I - 1,8) * int(NCOLS,8) + IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN + RESET_TO_ZERO = .FALSE. + ENDIF + ENDIF + IF ( RISK_OF_SAME_POS ) THEN + IF (I.EQ.NROWS .OR. .NOT. CB_IS_COMPRESSED) THEN + IF ( IAFATH + POSELT + int(IW(I)-1,8) .EQ. + & IACB+IPOSCB+int(I-1-1,8)) THEN + RISK_OF_SAME_POS_THIS_LINE = .TRUE. + ENDIF + ENDIF + ENDIF + IF (RESET_TO_ZERO) THEN + IF ( RISK_OF_SAME_POS_THIS_LINE ) THEN + DO J=1, I + APOS = POSELT + int(IW( J ),8) + IF (IAFATH + APOS - 1_8.NE. IACB+IPOSCB-1_8) THEN + A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) + A(IACB+IPOSCB-1_8) = ZERO + ENDIF + IPOSCB = IPOSCB + 1_8 + ENDDO + ELSE + DO J=1, I + APOS = POSELT + int(IW( J ),8) + A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) + A(IACB+IPOSCB-1_8) = ZERO + IPOSCB = IPOSCB + 1_8 + ENDDO + ENDIF + ELSE + DO J=1, I + APOS = POSELT + int(IW( J ),8) + A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + ENDDO + ENDIF + IF (.NOT. CB_IS_COMPRESSED ) THEN + IBEGCBROW = IACB+IPOSCB-1_8 + IF ( IBEGCBROW .LE. IENDFRONT ) THEN + A(IBEGCBROW:IBEGCBROW+int(NCOLS-I,8)-1_8)=ZERO + ENDIF + ENDIF + IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN + RESET_TO_ZERO = .FALSE. + ENDIF + ENDDO + RETURN + ENDIF + IF ((ETATASS.EQ.0) .OR. (ETATASS.EQ.1)) THEN + IPOSCB = 1_8 + DO I = 1, NELIM + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + IF (.NOT. CB_IS_COMPRESSED) THEN + IPOSCB = 1_8 + int( I - 1, 8 ) * int(NCOLS,8) + ENDIF + DO J = 1, I + APOS = POSELT + int(IW( J ),8) + A(IAFATH+ APOS -1_8) = A(IAFATH+ APOS -1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + END DO + ENDIF + IF ((ETATASS.EQ.0).OR.(ETATASS.EQ.1)) THEN + OMP_FLAG = (NROWS-NELIM).GE.300 + DO I = NELIM + 1, NROWS + IF (CB_IS_COMPRESSED) THEN + IPOSCB = (int(I,8) * int(I-1,8)) / 2_8 + 1_8 + ELSE + IPOSCB = int(I-1,8) * int(NCOLS,8) + 1_8 + ENDIF + POSELT = int(IW( I ),8) + IF (POSELT.LE. int(NASS1,8) .AND. .NOT. IS_INPLACE) THEN + DO J = 1, NELIM + APOS = POSELT + int( IW( J ) - 1, 8 ) * int(NFRONT,8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + + & A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + ELSE + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J = 1, NELIM + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + ENDIF + IF (ETATASS.EQ.1) THEN + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J = NELIM + 1, I + IF (IW(J).GT.NASS1) EXIT + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB +1_8 + END DO + ELSE + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J = NELIM + 1, I + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB + 1_8 + END DO + ENDIF + END DO + ELSE + DO I= NROWS, NELIM+1, -1 + IF (CB_IS_COMPRESSED) THEN + IPOSCB = (int(I,8)*int(I+1,8))/2_8 + ELSE + IPOSCB = int(I-1,8) * int(NCOLS,8) + int(I,8) + ENDIF + POSELT = int(IW( I ),8) + IF (POSELT.LE.int(NASS1,8)) EXIT + POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) + DO J=I,NELIM+1, -1 + IF (IW(J).LE.NASS1) EXIT + APOS = POSELT + int(IW( J ), 8) + A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + & + A(IACB+IPOSCB-1_8) + IPOSCB = IPOSCB - 1_8 + ENDDO + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_178 + SUBROUTINE ZMUMPS_530(N, ISON, INODE, IWPOSCB, + & PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8) + IMPLICIT NONE + INTEGER N, ISON, INODE, IWPOSCB + INTEGER KEEP(500), STEP(N) + INTEGER(8) KEEP8(150) + INTEGER PIMASTER(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER LIW + INTEGER IW(LIW) + INTEGER ISTCHK, LSTK, NSLSON, HS, NROWS, NCOLS, NPIVS, NELIM + INTEGER IOLDPS, NFRONT, NSLAVES, ICT11, HF + INTEGER J1, J2, J3, JJ, JPOS + LOGICAL SAME_PROC + INCLUDE 'mumps_headers.h' + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + NCOLS = NPIVS + LSTK + IF ( NPIVS < 0 ) NPIVS = 0 + SAME_PROC = ISTCHK < IWPOSCB + IF (SAME_PROC) THEN + NROWS = NCOLS + ELSE + NROWS = IW(ISTCHK+2+KEEP(IXSZ)) + ENDIF + J1 = ISTCHK + NROWS + HS + NPIVS + IF (KEEP(50).NE.0) THEN + J2 = J1 + LSTK - 1 + DO JJ = J1, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + ELSE + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM + DO JJ = J3, J2 + IW(JJ) = IW(JJ - NROWS) + ENDDO + IF (NELIM .NE. 0) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + ICT11 = IOLDPS + HF - 1 + NFRONT + J3 = J3 - 1 + DO 190 JJ = J1, J3 + JPOS = IW(JJ) + ICT11 + IW(JJ) = IW(JPOS) + 190 CONTINUE + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_530 + SUBROUTINE ZMUMPS_619( + & N, INODE, IW, LIW, A, LA, + & ISON, NBCOLS, + & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER, + & OPASSW, IWPOSCB,MYID, KEEP,KEEP8 ) + USE ZMUMPS_LOAD + IMPLICIT NONE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA + INTEGER N,LIW,MYID + INTEGER INODE,ISON,IWPOSCB + INTEGER NBCOLS + INTEGER IW(LIW), STEP(N), + & PIMASTER(KEEP(28)), + & PTLUST_S(KEEP(28)) + INTEGER(8) PTRAST(KEEP(28)) + COMPLEX(kind=8) A(LA) + DOUBLE PRECISION VALSON(NBCOLS) + DOUBLE PRECISION OPASSW + INTEGER HF,HS, NSLAVES, NASS1, + & IOLDPS, ISTCHK, + & LSTK, NSLSON,NELIM,NPIVS,NCOLS, J1, + & JJ1,NROWS + INTEGER(8) POSELT, APOS, JJ2 + INCLUDE 'mumps_headers.h' + LOGICAL SAME_PROC + INTRINSIC real + IOLDPS = PTLUST_S(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NASS1 = iabs(IW(IOLDPS + 2 + KEEP(IXSZ))) + NSLAVES= IW(IOLDPS+5 + KEEP(IXSZ)) + HF = 6 + NSLAVES + KEEP(IXSZ) + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NELIM = IW(ISTCHK + 1 + KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ)) + IF (NPIVS.LT.0) NPIVS = 0 + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LT.IWPOSCB) + IF (SAME_PROC) THEN + NROWS = NCOLS + ELSE + NROWS = IW(ISTCHK+2 + KEEP(IXSZ)) + ENDIF + J1 = ISTCHK + NROWS + HS + NPIVS + APOS = POSELT + int(NASS1,8)*int(NASS1,8) - 1_8 + DO JJ1 = 1, NBCOLS + JJ2 = APOS+int(IW(J1 + JJ1 - 1),8) + IF(abs(A(JJ2)) .LT. VALSON(JJ1)) + & A(JJ2) = cmplx(VALSON(JJ1),kind=kind(A)) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_619 + RECURSIVE SUBROUTINE ZMUMPS_264( + & COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE ZMUMPS_OOC + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mumps_headers.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER(8) :: POSFAC + INTEGER COMP + INTEGER IFLAG, IERROR, NBFIN, MSGSOU + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER NBPROCFILS( KEEP(28) ), STEP(N), + & PIMASTER(KEEP(28)) + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER COMM, MYID + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER PTLUST_S(KEEP(28)), + & ITLOC(N+KEEP(253)), FILS(N), ND(KEEP(28)) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER FRERE_STEPS(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION FLOP1 + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER INODE, POSITION, NPIV, IERR, LP + INTEGER NCOL + INTEGER(8) :: POSBLOCFACTO + INTEGER(8) :: LAELL + INTEGER(8) :: POSELT + INTEGER IOLDPS, LCONT1, NASS1, NROW1, NCOL1, NPIV1 + INTEGER NSLAV1, HS, ISW + INTEGER (8) :: LPOS, LPOS1, LPOS2, IPOS, KPOS + INTEGER ICT11 + INTEGER I, IPIV, FPERE + LOGICAL LASTBL + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + COMPLEX(kind=8) ONE,ALPHA + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, NextPivDummy + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + FPERE = -1 + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, + & MPI_INTEGER, COMM, IERR ) + LASTBL = (NPIV.LE.0) + IF (LASTBL) THEN + NPIV = -NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, + & MPI_INTEGER, COMM, IERR ) + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOL, 1, + & MPI_INTEGER, COMM, IERR ) + LAELL = int(NPIV,8) * int(NCOL,8) + IF ( LRLU .LT. LAELL .OR. IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LAELL ) THEN + IFLAG = -9 + CALL MUMPS_731(LAELL - LRLUS, IERROR) + IF (ICNTL(1).GT.0 .AND. ICNTL(4).GE.1) THEN + LP=ICNTL(1) + WRITE(LP,*) + &" FAILURE, WORKSPACE TOO SMALL DURING ZMUMPS_264" + ENDIF + GOTO 700 + END IF + CALL ZMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS=' + & ,LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731( LAELL-LRLUS, IERROR ) + GOTO 700 + END IF + IF ( IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF (ICNTL(1).GT.0 .AND. ICNTL(4).GE.1) THEN + LP=ICNTL(1) + WRITE(LP,*) + &" FAILURE IN INTEGER ALLOCATION DURING ZMUMPS_264" + ENDIF + IFLAG = -8 + IERROR = IWPOS + NPIV - 1 - IWPOSCB + GOTO 700 + END IF + END IF + LRLU = LRLU - LAELL + LRLUS = LRLUS - LAELL + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSBLOCFACTO = POSFAC + POSFAC = POSFAC + LAELL + CALL ZMUMPS_471(.FALSE., .FALSE., + & LA-LRLUS,0_8,LAELL,KEEP,KEEP8,LRLU) + IPIV = IWPOS + IWPOS = IWPOS + NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IPIV ), NPIV, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSBLOCFACTO), NPIV*NCOL, + & MPI_DOUBLE_COMPLEX, + & COMM, IERR ) + IF (PTRIST(STEP( INODE )) .EQ. 0) THEN + DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 ) + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. + & ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + ENDIF + DO WHILE ( NBPROCFILS( STEP(INODE)) .NE. 0 ) + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, CONTRIB_TYPE2, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .TRUE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + LCONT1 = IW( IOLDPS +KEEP(IXSZ)) + NASS1 = IW( IOLDPS + 1 +KEEP(IXSZ)) + NROW1 = IW( IOLDPS + 2 +KEEP(IXSZ)) + NPIV1 = IW( IOLDPS + 3 +KEEP(IXSZ)) + NSLAV1 = IW( IOLDPS + 5 +KEEP(IXSZ)) + HS = 6 + NSLAV1 + KEEP(IXSZ) + NCOL1 = LCONT1 + NPIV1 + IF (NPIV.GT.0) THEN + ICT11 = IOLDPS+HS+NROW1+NPIV1 - 1 + DO I = 1, NPIV + IF (IW(IPIV+I-1).EQ.I) CYCLE + ISW = IW(ICT11+I) + IW(ICT11+I) = IW(ICT11+IW(IPIV+I-1)) + IW(ICT11+IW(IPIV+I-1)) = ISW + IPOS = POSELT + int(NPIV1 + I - 1,8) + KPOS = POSELT + int(NPIV1 + IW(IPIV+I-1) - 1,8) + CALL zswap(NROW1, A(IPOS), NCOL1, A(KPOS), NCOL1) + ENDDO + LPOS2 = POSELT + int(NPIV1,8) + CALL ztrsm('L','L','N','N',NPIV, NROW1, ONE, + & A(POSBLOCFACTO), NCOL, A(LPOS2), NCOL1) + LPOS1 = POSBLOCFACTO+int(NPIV,8) + LPOS = LPOS2 + int(NPIV,8) + ENDIF + IF (KEEP(201).eq.1) THEN + MonBloc%INODE = INODE + MonBloc%MASTER = .FALSE. + MonBloc%Typenode = 2 + MonBloc%NROW = NROW1 + MonBloc%NCOL = NCOL1 + MonBloc%NFS = NASS1 + MonBloc%LastPiv = NPIV1 + NPIV + NULLIFY(MonBloc%INDICES) + MonBloc%Last = LASTBL + STRAT = STRAT_TRY_WRITE + NextPivDummy = -8888 + LIWFAC = IW(IOLDPS+XXI) + CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR)) + LAST_CALL = .FALSE. + CALL ZMUMPS_688( STRAT, TYPEF_L, A(POSELT), + & LAFAC, MonBloc, NextPivDummy, NextPivDummy, + & IW(IOLDPS), LIWFAC, MYID, KEEP8(31), IFLAG,LAST_CALL) + ENDIF + IF ( NPIV .GT. 0 ) THEN + CALL zgemm('N','N', NCOL-NPIV,NROW1,NPIV, + & ALPHA,A(LPOS1),NCOL, + & A(LPOS2),NCOL1,ONE, A(LPOS),NCOL1) + ENDIF + IW(IOLDPS+KEEP(IXSZ) ) = IW(IOLDPS+KEEP(IXSZ) ) - NPIV + IW(IOLDPS + 3+KEEP(IXSZ) ) = IW(IOLDPS+3+KEEP(IXSZ) ) + NPIV + IF (LASTBL) IW(IOLDPS+1+KEEP(IXSZ) ) = IW(IOLDPS + 3+KEEP(IXSZ) ) + IF ( .not. LASTBL .AND. + & (IW(IOLDPS+1+KEEP(IXSZ)) .EQ. IW(IOLDPS + 3+KEEP(IXSZ))) ) THEN + write(*,*) ' ERROR 1 **** IN BLACFACTO ' + CALL MUMPS_ABORT() + ENDIF + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + IWPOS = IWPOS - NPIV + FLOP1 = dble( NPIV1*NROW1 ) + + & dble(NROW1*NPIV1)*dble(2*NCOL1-NPIV1-1) + & - + & dble((NPIV1+NPIV)*NROW1 ) - + & dble(NROW1*(NPIV1+NPIV))*dble(2*NCOL1-NPIV1-NPIV-1) + CALL ZMUMPS_190( 1, .FALSE., FLOP1, KEEP,KEEP8 ) + IF (LASTBL) THEN + CALL ZMUMPS_759( + & COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ENDIF + 600 CONTINUE + RETURN + 700 CONTINUE + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE ZMUMPS_264 + SUBROUTINE ZMUMPS_699( COMM_LOAD, ASS_IRECV, + & MSGLEN, BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC, + & N, IW, LIW, A, LA, PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, NBPROCFILS, + & COMP, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, NSTK_S, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, NBFIN, + & MYID, COMM, ICNTL, KEEP,KEEP8, IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, LPTRAR, NELT, + & FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE ZMUMPS_LOAD + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV, MSGLEN + INTEGER BUFR( LBUFR ) + INTEGER(8) :: LRLU, IPTRLU, LRLUS, LA, POSFAC + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER NBFIN + INTEGER COMP + INTEGER NELT, LPTRAR + INTEGER PROCNODE_STEPS( KEEP(28) ), PTRIST(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER PTLUST_S( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER ITLOC( N + KEEP(253)), NSTK_S( KEEP(28) ), FILS( N ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER ND(KEEP(28)), FRERE_STEPS( KEEP(28) ) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX(kind=8) DBLARR( max( 1,KEEP(13)) ) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER COMM, MYID, IFLAG, IERROR + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER FRTPTR(N+1), FRTELT( NELT ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER NFS4FATHER + INCLUDE 'mumps_headers.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER MUMPS_275, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_810 + INTEGER IERR + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INTEGER I, INODE, ISON, POSITION, NBROW, LROW, IROW, INDCOL + INTEGER LREQI + INTEGER(8) :: LREQA, POSCONTRIB + INTEGER ROW_LENGTH + INTEGER MASTER + INTEGER ISTCHK + LOGICAL SAME_PROC + LOGICAL SLAVE_NODE + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED, IS_ofType5or6 + INTEGER ISHIFT_BUFR, LBUFR_LOC, LBUFR_BYTES_LOC + INTEGER TYPESPLIT + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, ISON, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NBROW, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, LROW, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, + & MPI_INTEGER, COMM, IERR ) + MASTER = MUMPS_275(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + SLAVE_NODE = MASTER .NE. MYID + TYPESPLIT = MUMPS_810(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IS_ofType5or6 = ((TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) + IF (SLAVE_NODE .AND. PTRIST(STEP(INODE)) ==0) THEN + ISHIFT_BUFR = ( MSGLEN + KEEP(34) ) / KEEP(34) + LBUFR_LOC = LBUFR - ISHIFT_BUFR + 1 + LBUFR_BYTES_LOC = LBUFR_LOC * KEEP(34) + DO WHILE ( PTRIST( STEP(INODE) ) .EQ. 0 ) + MASTER = MUMPS_275(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MASTER, MAITRE_DESC_BANDE, + & STATUS, + & BUFR(ISHIFT_BUFR), LBUFR_LOC, LBUFR_BYTES_LOC, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF (IFLAG.LT.0) RETURN + END DO + ENDIF + IF ( SLAVE_NODE ) THEN + LREQI = LROW + NBROWS_PACKET + ELSE + LREQI = NBROWS_PACKET + END IF + LREQA = int(LROW,8) + IF ( LRLU .LT. LREQA .OR. IWPOS + LREQI + & - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LREQA ) THEN + IFLAG = -9 + CALL MUMPS_731( LREQA - LRLUS, IERROR ) + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END IF + CALL ZMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..process_contrib' + WRITE(*,*) 'LRLU,LRLUS=',LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731( LREQA - LRLUS, IERROR ) + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END IF + IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END IF + END IF + LRLU = LRLU - LREQA + LRLUS = LRLUS - LREQA + POSCONTRIB = POSFAC + POSFAC = POSFAC + LREQA + KEEP8(67) = min(LRLUS, KEEP8(67)) + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU) + IF ( SLAVE_NODE ) THEN + IROW = IWPOS + INDCOL = IWPOS + NBROWS_PACKET + ELSE + IROW = IWPOS + INDCOL = -1 + END IF + IWPOS = IWPOS + LREQI + IF ( SLAVE_NODE ) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( INDCOL ), LROW, MPI_INTEGER, + & COMM, IERR ) + END IF + DO I = 1, NBROWS_PACKET + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IROW + I - 1 ), 1, MPI_INTEGER, + & COMM, IERR ) + END DO + IF ( SLAVE_NODE ) THEN + IF ( NBROWS_ALREADY_SENT + NBROWS_PACKET == NBROW ) THEN + NBPROCFILS(STEP(INODE))=NBPROCFILS(STEP(INODE))-1 + ENDIF + IF ( KEEP(55) .eq. 0 ) THEN + CALL ZMUMPS_539 + & (N, INODE, IW, LIW, A, LA, + & NBROW, LROW, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, MYID ) + ELSE + CALL ZMUMPS_123( + & NELT, FRTPTR, FRTELT, + & N, INODE, IW, LIW, A, LA, + & NBROW, LROW, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, MYID ) + ENDIF + DO I=1,NBROWS_PACKET + IF(KEEP(50).NE.0)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & ROW_LENGTH, + & 1, + & MPI_INTEGER, + & COMM, IERR ) + ELSE + ROW_LENGTH=LROW + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSCONTRIB), + & ROW_LENGTH, + & MPI_DOUBLE_COMPLEX, + & COMM, IERR ) + CALL ZMUMPS_40(N, INODE, IW, LIW, A, LA, + & 1, ROW_LENGTH, IW( IROW+I-1 ),IW(INDCOL), + & A(POSCONTRIB), + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, ICNTL, KEEP,KEEP8, MYID, IS_ofType5or6, + & ROW_LENGTH ) + ENDDO + CALL ZMUMPS_531 + & (N, INODE, IW, LIW, + & NBROWS_PACKET, STEP, PTRIST, + & ITLOC, RHS_MUMPS,KEEP,KEEP8) + ELSE + DO I=1,NBROWS_PACKET + IF(KEEP(50).NE.0)THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & ROW_LENGTH, + & 1, + & MPI_INTEGER, + & COMM, IERR ) + ELSE + ROW_LENGTH=LROW + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSCONTRIB), + & ROW_LENGTH, + & MPI_DOUBLE_COMPLEX, + & COMM, IERR ) + CALL ZMUMPS_39(N, INODE, IW, LIW, A, LA, + & ISON, 1, ROW_LENGTH, IW( IROW +I-1 ), + & A(POSCONTRIB), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, ROW_LENGTH + &) + ENDDO + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + IF (KEEP(219).NE.0) THEN + IF(KEEP(50) .EQ. 2) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NFS4FATHER, + & 1, + & MPI_INTEGER, + & COMM, IERR ) + IF(NFS4FATHER .GT. 0) THEN + CALL ZMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE. 0) THEN + IERROR = BUF_LMAX_ARRAY + IFLAG = -13 + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & BUF_MAX_ARRAY, + & NFS4FATHER, + & MPI_DOUBLE_PRECISION, + & COMM, IERR ) + CALL ZMUMPS_619(N, INODE, IW, LIW, A, LA, + & ISON, NFS4FATHER, + & BUF_MAX_ARRAY, PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8) + ENDIF + ENDIF + ENDIF + ENDIF + IF (NBROWS_ALREADY_SENT + NBROWS_PACKET == NBROW ) THEN + NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE)) - 1 + NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - 1 + IF ( NBPROCFILS(STEP(ISON)) .EQ. 0) THEN + ISTCHK = PIMASTER(STEP(ISON)) + SAME_PROC= ISTCHK .LT. IWPOSCB + IF (SAME_PROC) THEN + CALL ZMUMPS_530(N, ISON, INODE, IWPOSCB, + & PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8) + ENDIF + IF (SAME_PROC) THEN + ISTCHK = PTRIST(STEP(ISON)) + PTRIST(STEP( ISON) ) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL ZMUMPS_152(.FALSE., MYID, N, ISTCHK, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, IWPOSCB, + & LA, KEEP,KEEP8, .FALSE. + & ) + ENDIF + IF ( NBPROCFILS(STEP(INODE)) .EQ. 0 ) THEN + CALL ZMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), + & KEEP(47), STEP, INODE+N ) + IF (KEEP(47) .GE. 3) THEN + CALL ZMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + ENDIF + ENDIF + END IF + IWPOS = IWPOS - LREQI + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + POSFAC = POSFAC - LREQA + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU) + RETURN + END SUBROUTINE ZMUMPS_699 + SUBROUTINE ZMUMPS_143( N, INODE, IW, LIW, A, LA, + & IOLDPS, POSELT, IFLAG, UU, NOFFW, + & NPVW, + & KEEP,KEEP8, STEP, + & PROCNODE_STEPS, MYID, SLAVEF, SEUIL, + & AVOID_DELAYED, ETATASS, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & IWPOS ) + USE ZMUMPS_OOC + IMPLICIT NONE + INTEGER(8) :: LA, POSELT + INTEGER N, INODE, LIW, IFLAG, NOFFW, NPVW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER MYID, SLAVEF, IOLDPS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS( KEEP(28) ), STEP(N) + DOUBLE PRECISION UU, SEUIL + LOGICAL AVOID_DELAYED + INTEGER ETATASS, IWPOS + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER INOPV, IFINB, NFRONT, NPIV, IBEG_BLOCK + INTEGER NASS, NEL1, NPIVB, NPIVE, NBOLKJ, NBTLKJ + DOUBLE PRECISION UUTEMP + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, LNextPiv2beWritten, + & UNextPiv2beWritten, IFLAG_OOC, + & PP_FIRST2SWAP_L, PP_FIRST2SWAP_U, + & PP_LastPIVRPTRFilled_L, + & PP_LastPIVRPTRFilled_U + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INCLUDE 'mumps_headers.h' + EXTERNAL MUMPS_330, ZMUMPS_221, ZMUMPS_233, + & ZMUMPS_229, + & ZMUMPS_225, ZMUMPS_232, ZMUMPS_231, + & ZMUMPS_220, + & ZMUMPS_228, ZMUMPS_236 + INTEGER MUMPS_330 + LOGICAL STATICMODE + DOUBLE PRECISION SEUIL_LOC + INOPV = 0 + SEUIL_LOC = SEUIL + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + UUTEMP=UU + ENDIF + IBEG_BLOCK=1 + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5), NASS ) + ENDIF + NBTLKJ = NBOLKJ + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_BOTH_LU + LNextPiv2beWritten = 1 + UNextPiv2beWritten = 1 + PP_FIRST2SWAP_L = LNextPiv2beWritten + PP_FIRST2SWAP_U = UNextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + MonBloc%LastPanelWritten_U = 0 + PP_LastPIVRPTRFilled_L = 0 + PP_LastPIVRPTRFilled_U = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 1 + MonBloc%NROW = NFRONT + MonBloc%NCOL = NFRONT + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -88877 + NULLIFY(MonBloc%INDICES) + ENDIF + 50 CONTINUE + CALL ZMUMPS_221(NFRONT,NASS,N,INODE,IW,LIW,A,LA,INOPV,NOFFW, + & IFLAG,IOLDPS,POSELT,UU,SEUIL_LOC,KEEP,KEEP8, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U, + & PP_LastPIVRPTRFilled_U) + IF (IFLAG.LT.0) GOTO 500 + IF (INOPV.EQ.1) THEN + IF(STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + GOTO 80 + ENDIF + IF (INOPV.EQ.2) THEN + CALL ZMUMPS_233(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,NBOLKJ, NBTLKJ,KEEP(4),KEEP(IXSZ)) + GOTO 50 + ENDIF + NPVW = NPVW + 1 + IF (NASS.LE.1) THEN + CALL ZMUMPS_229(NFRONT,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,KEEP(IXSZ)) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + GO TO 500 + ENDIF + CALL ZMUMPS_225(IBEG_BLOCK,NFRONT, NASS, N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB, + & NBTLKJ,KEEP(4),KEEP(IXSZ)) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + IF (IFINB.EQ.0) GOTO 50 + IF (KEEP(201).EQ.1) THEN + MonBloc%LastPiv= IW(IOLDPS+1+KEEP(IXSZ)) + STRAT = STRAT_TRY_WRITE + TYPEFile = TYPEF_U + LAST_CALL = .FALSE. + CALL ZMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + ENDIF + IF (IFINB.EQ.(-1)) GOTO 80 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NEL1 = NASS - NPIV + CALL ZMUMPS_232(A,LA, + & NFRONT,NPIV,NASS,POSELT,NBTLKJ) + GO TO 50 + 80 CONTINUE + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + IF (NPIV.LE.0) GO TO 110 + NEL1 = NFRONT - NASS + IF (NEL1.LE.0) GO TO 110 + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_TRY_WRITE + TYPEFile = TYPEF_BOTH_LU + MonBloc%LastPiv= NPIV + CALL ZMUMPS_642(A(POSELT), LAFAC, NFRONT, + & NPIV, NASS, IW(IOLDPS), LIWFAC, + & MonBloc, TYPEFile, MYID, KEEP8, + & STRAT, IFLAG_OOC, + & LNextPiv2beWritten, UNextPiv2beWritten) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + ELSE + CALL ZMUMPS_231(A,LA,NFRONT, NPIV,NASS,POSELT) + ENDIF + 110 CONTINUE + IF (MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + & .EQ.1) THEN + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + IBEG_BLOCK = NPIV + IF (NASS.EQ.NPIV) GOTO 500 + 120 CALL ZMUMPS_220(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IOLDPS,POSELT,UU,SEUIL, + & KEEP, DKEEP, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U, + & PP_LastPIVRPTRFilled_U) + IF (INOPV.NE.1) THEN + NPVW = NPVW + 1 + CALL ZMUMPS_228(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB,KEEP(IXSZ)) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + IF (IFINB.EQ.0) GOTO 120 + ENDIF + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NPIVB = IBEG_BLOCK + NPIVE = NPIV - NPIVB + NEL1 = NFRONT - NASS + IF ((NPIVE.LE.0).OR.(NEL1.EQ.0)) GO TO 500 + CALL ZMUMPS_236(A,LA,NPIVB, + & NFRONT,NPIV,NASS,POSELT) + ENDIF + 500 CONTINUE + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + TYPEFile = TYPEF_BOTH_LU + LAST_CALL = .TRUE. + CALL ZMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC, LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + CALL ZMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_143 + RECURSIVE SUBROUTINE ZMUMPS_322( + & COMM_LOAD, ASS_IRECV, + & MSGSOU, MSGTAG, MSGLEN, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mumps_headers.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER MSGSOU, MSGTAG, MSGLEN + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER KEEP(500), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX(kind=8) DBLARR( max(1,KEEP(13)) ) + INTEGER INIV2, ISHIFT, IBEG + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + LOGICAL FLAG + INTEGER MP, LP + INTEGER TMP( 2 ) + INTEGER NBRECU, POSITION, INODE, ISON, IROOT + INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE, + & LMAP, FPERE, NELIM, + & HDMAPLIG,NFS4FATHER, + & TOT_ROOT_SIZE, TOT_CONT_TO_RECV + DOUBLE PRECISION FLOP1 + INCLUDE 'mumps_tags.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + CHARACTER(LEN=35)::SUBNAME + MP = ICNTL(2) + LP = ICNTL(1) + SUBNAME="??????" + CALL ZMUMPS_467(COMM_LOAD, KEEP) + IF ( MSGTAG .EQ. RACINE ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NBRECU, + & 1, MPI_INTEGER, COMM, IERR) + NBRECU = BUFR( 1 ) + NBFIN = NBFIN - NBRECU + ELSEIF ( MSGTAG .EQ. NOEUD ) THEN + CALL ZMUMPS_269( MYID,KEEP,KEEP8, + & BUFR, LBUFR, LBUFR_BYTES, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, FPERE, FLAG, IFLAG, IERROR, COMM, + & ITLOC, RHS_MUMPS ) + SUBNAME="ZMUMPS_269" + IF ( IFLAG .LT. 0 ) GO TO 500 + IF ( FLAG ) THEN + CALL ZMUMPS_507(N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), STEP, FPERE ) + IF (KEEP(47) .GE. 3) THEN + CALL ZMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + CALL MUMPS_137( FPERE, N, + & PROCNODE_STEPS,SLAVEF, + & ND, FILS, FRERE, STEP, PIMASTER, + & KEEP(28), KEEP(50), KEEP(253), FLOP1, + & IW, LIW, KEEP(IXSZ) ) + IF (FPERE.NE.KEEP(20)) + & CALL ZMUMPS_190(1,.FALSE.,FLOP1,KEEP,KEEP8) + ENDIF + ELSEIF ( MSGTAG .EQ. END_NIV2_LDLT ) THEN + INODE = BUFR( 1 ) + CALL ZMUMPS_507(N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), + & STEP, -INODE ) + IF (KEEP(47) .GE. 3) THEN + CALL ZMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + ELSEIF ( MSGTAG .EQ. TERREUR ) THEN + IFLAG = -001 + IERROR = MSGSOU + GOTO 100 + ELSEIF ( MSGTAG .EQ. MAITRE_DESC_BANDE ) THEN + CALL ZMUMPS_266( MYID,BUFR, LBUFR, + & LBUFR_BYTES, IWPOS, + & IWPOSCB, + & IPTRLU, LRLU, LRLUS, NBPROCFILS, + & N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP, + & KEEP,KEEP8, ITLOC, RHS_MUMPS, + & IFLAG, IERROR ) + SUBNAME="ZMUMPS_266" + IF ( IFLAG .LT. 0 ) GO to 500 + ELSEIF ( MSGTAG .EQ. MAITRE2 ) THEN + CALL ZMUMPS_268(MYID,BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, SLAVEF, IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & KEEP,KEEP8, ND, FILS, FRERE, ITLOC, RHS_MUMPS, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + SUBNAME="ZMUMPS_268" + IF ( IFLAG .LT. 0 ) GO to 500 + ELSEIF ( MSGTAG .EQ. BLOC_FACTO ) THEN + CALL ZMUMPS_264( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM , IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSEIF ( MSGTAG .EQ. BLOC_FACTO_SYM_SLAVE ) THEN + CALL ZMUMPS_263( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSEIF ( MSGTAG .EQ. BLOC_FACTO_SYM ) THEN + CALL ZMUMPS_274( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSEIF ( MSGTAG .EQ. CONTRIB_TYPE2 ) THEN + CALL ZMUMPS_699( COMM_LOAD, ASS_IRECV, + & MSGLEN, BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC, + & N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, NBPROCFILS, COMP, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, NSTK_S, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, NBFIN, MYID, COMM, + & ICNTL, KEEP,KEEP8, IFLAG, IERROR, IPOOL, LPOOL, LEAF, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GO TO 100 + ELSEIF ( MSGTAG .EQ. MAPLIG ) THEN + HDMAPLIG = 7 + INODE = BUFR( 1 ) + ISON = BUFR( 2 ) + NSLAVES_PERE = BUFR( 3 ) + NFRONT_PERE = BUFR( 4 ) + NASS_PERE = BUFR( 5 ) + LMAP = BUFR( 6 ) + NFS4FATHER = BUFR(7) + IF ( (NSLAVES_PERE.NE.0).AND.(KEEP(48).NE.0) ) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + ISHIFT = NSLAVES_PERE+1 + TAB_POS_IN_PERE(1:NSLAVES_PERE+1, INIV2) = + & BUFR(HDMAPLIG+1:HDMAPLIG+1+NSLAVES_PERE) + TAB_POS_IN_PERE(SLAVEF+2, INIV2) = NSLAVES_PERE + ELSE + ISHIFT = 0 + ENDIF + IBEG = HDMAPLIG+1+ISHIFT + CALL ZMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES_PERE, + & BUFR(IBEG), + & NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP, + & BUFR(IBEG+NSLAVES_PERE), + & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GO TO 100 + ELSE IF ( MSGTAG .EQ. ROOT_CONT_STATIC ) THEN + CALL ZMUMPS_700( + & BUFR, LBUFR, LBUFR_BYTES, + & root, N, IW, LIW, A, LA, NBPROCFILS, + & LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, + & COMP, LRLUS, IPOOL, LPOOL, LEAF, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, + & ITLOC, RHS_MUMPS, + & ND, PROCNODE_STEPS, SLAVEF) + SUBNAME="ZMUMPS_700" + IF ( IFLAG .LT. 0 ) GO TO 500 + ELSE IF ( MSGTAG .EQ. ROOT_NON_ELIM_CB ) THEN + IROOT = KEEP( 38 ) + MSGSOU = MUMPS_275( PROCNODE_STEPS(STEP(IROOT)), + & SLAVEF ) + IF ( PTLUST_S( STEP(IROOT)) .EQ. 0 ) THEN + CALL MPI_RECV( TMP, 2 * KEEP(34), MPI_PACKED, + & MSGSOU, ROOT_2SLAVE, + & COMM, STATUS, IERR ) + CALL ZMUMPS_270( TMP( 1 ), TMP( 2 ), + & root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND ) + SUBNAME="ZMUMPS_270" + IF ( IFLAG .LT. 0 ) GOTO 500 + END IF + CALL ZMUMPS_700( + & BUFR, LBUFR, LBUFR_BYTES, + & root, N, IW, LIW, A, LA, NBPROCFILS, + & LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, + & COMP, LRLUS, IPOOL, LPOOL, LEAF, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, + & ITLOC, RHS_MUMPS, + & ND, PROCNODE_STEPS, SLAVEF ) + SUBNAME="ZMUMPS_700" + IF ( IFLAG .LT. 0 ) GO TO 500 + ELSE IF ( MSGTAG .EQ. ROOT_2SON ) THEN + ISON = BUFR( 1 ) + NELIM = BUFR( 2 ) + CALL ZMUMPS_271( COMM_LOAD, ASS_IRECV, + & ISON, NELIM, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GO TO 100 + IF (MYID.NE.MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF)) THEN + IF (KEEP(50).EQ.0) THEN + IF (IW(PTRIST(STEP(ISON))+6+KEEP(IXSZ)).EQ. + & S_REC_CONTSTATIC) THEN + IW(PTRIST(STEP(ISON))+6+KEEP(IXSZ)) = S_ROOT2SON_CALLED + ELSE + CALL ZMUMPS_626( N, ISON, PTRIST, PTRAST, + & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + ENDIF + ELSE + IF (IW(PTRIST(STEP(ISON))+8+KEEP(IXSZ)).EQ. + & S_REC_CONTSTATIC) THEN + IW(PTRIST(STEP(ISON))+8+KEEP(IXSZ)) = S_ROOT2SON_CALLED + ELSE + CALL ZMUMPS_626( N, ISON, PTRIST, PTRAST, + & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + ENDIF + ENDIF + ENDIF + ELSE IF ( MSGTAG .EQ. ROOT_2SLAVE ) THEN + TOT_ROOT_SIZE = BUFR( 1 ) + TOT_CONT_TO_RECV = BUFR( 2 ) + CALL ZMUMPS_270( TOT_ROOT_SIZE, + & TOT_CONT_TO_RECV, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND ) + IF ( IFLAG .LT. 0 ) GO TO 100 + ELSE IF ( MSGTAG .EQ. ROOT_NELIM_INDICES ) THEN + ISON = BUFR( 1 ) + NELIM = BUFR( 2 ) + NSLAVES_PERE = BUFR( 3 ) + CALL ZMUMPS_273( root, + & ISON, NELIM, NSLAVES_PERE, BUFR(4), BUFR(4+BUFR(2)), + & BUFR(4+2*BUFR(2)), + & + & PROCNODE_STEPS, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & ITLOC, RHS_MUMPS, COMP, + & IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8, + & COMM, COMM_LOAD, FILS, ND) + SUBNAME="ZMUMPS_273" + IF ( IFLAG .LT. 0 ) GO TO 500 + ELSE IF ( MSGTAG .EQ. UPDATE_LOAD ) THEN + WRITE(*,*) "Internal error 3 in ZMUMPS_322" + CALL MUMPS_ABORT() + ELSE IF ( MSGTAG .EQ. TAG_DUMMY ) THEN + ELSE + IF ( LP > 0 ) + & WRITE(LP,*) MYID, + &': Internal error, routine ZMUMPS_322.',MSGTAG + IFLAG = -100 + IERROR= MSGTAG + GOTO 500 + ENDIF + 100 CONTINUE + RETURN + 500 CONTINUE + IF ( ICNTL(1) .GT. 0 .AND. ICNTL(4).GE.1 ) THEN + LP=ICNTL(1) + IF (IFLAG.EQ.-9) THEN + WRITE(LP,*) 'FAILURE, WORKSPACE TOO SMALL DURING ',SUBNAME + ENDIF + IF (IFLAG.EQ.-8) THEN + WRITE(LP,*) 'FAILURE IN INTEGER ALLOCATION DURING ',SUBNAME + ENDIF + IF (IFLAG.EQ.-13) THEN + WRITE(LP,*) 'FAILURE IN DYNAMIC ALLOCATION DURING ',SUBNAME + ENDIF + ENDIF + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE ZMUMPS_322 + RECURSIVE SUBROUTINE ZMUMPS_280( + & COMM_LOAD, ASS_IRECV, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT , + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC, LA, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ), + & PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX(kind=8) DBLARR( max(1,KEEP(13)) ) + INTEGER MSGSOU, MSGTAG, MSGLEN, IERR + MSGSOU = STATUS( MPI_SOURCE ) + MSGTAG = STATUS( MPI_TAG ) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) + IF ( MSGLEN .GT. LBUFR_BYTES ) THEN + IFLAG = -20 + IERROR = MSGLEN + WRITE(*,*) ' RECEPTION BUF TOO SMALL, Msgtag/len=', + & MSGTAG,MSGLEN + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + CALL MPI_RECV( BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU, + & MSGTAG, + & COMM, STATUS, IERR ) + CALL ZMUMPS_322( + & COMM_LOAD, ASS_IRECV, + & MSGSOU, MSGTAG, MSGLEN, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + RETURN + END SUBROUTINE ZMUMPS_280 + RECURSIVE SUBROUTINE ZMUMPS_329( + & COMM_LOAD, ASS_IRECV, BLOCKING, SET_IRECV, + & MESSAGE_RECEIVED, MSGSOU, MSGTAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & STACK_RIGHT_AUTHORIZED ) + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL, INTENT (IN) :: BLOCKING + LOGICAL, INTENT (IN) :: SET_IRECV + LOGICAL, INTENT (INOUT) :: MESSAGE_RECEIVED + INTEGER, INTENT (IN) :: MSGSOU, MSGTAG + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ), + & PTLUST_S(KEEP(28)) + INTEGER STEP(N), + & PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX(kind=8) DBLARR( max(1,KEEP(13)) ) + LOGICAL, intent(in) :: STACK_RIGHT_AUTHORIZED + LOGICAL FLAG, RIGHT_MESS, FLAGbis + INTEGER LP, MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC + INTEGER IERR + INTEGER STATUS_BIS( MPI_STATUS_SIZE ) + INTEGER, SAVE :: RECURS = 0 + CALL ZMUMPS_467(COMM_LOAD, KEEP) + IF ( .NOT. STACK_RIGHT_AUTHORIZED ) THEN + RETURN + ENDIF + RECURS = RECURS + 1 + LP = ICNTL(1) + IF (ICNTL(4).LT.1) LP=-1 + IF ( MESSAGE_RECEIVED ) THEN + MSGSOU_LOC = MPI_ANY_SOURCE + MSGTAG_LOC = MPI_ANY_TAG + GOTO 250 + ENDIF + IF ( ASS_IRECV .NE. MPI_REQUEST_NULL) THEN + RIGHT_MESS = .TRUE. + IF (BLOCKING) THEN + CALL MPI_WAIT(ASS_IRECV, + & STATUS, IERR) + FLAG = .TRUE. + IF ( ( (MSGSOU.NE.MPI_ANY_SOURCE) .OR. + & (MSGTAG.NE.MPI_ANY_TAG) ) ) THEN + IF ( MSGSOU.NE.MPI_ANY_SOURCE) THEN + RIGHT_MESS = MSGSOU.EQ.STATUS(MPI_SOURCE) + ENDIF + IF ( MSGTAG.NE.MPI_ANY_TAG) THEN + RIGHT_MESS = + & ( (MSGTAG.EQ.STATUS(MPI_TAG)).AND.RIGHT_MESS ) + ENDIF + IF (.NOT.RIGHT_MESS) THEN + CALL MPI_PROBE(MSGSOU,MSGTAG, + & COMM, STATUS_BIS, IERR) + ENDIF + ENDIF + ELSE + CALL MPI_TEST(ASS_IRECV, + & FLAG, STATUS, IERR) + ENDIF + IF (IERR.LT.0) THEN + IFLAG = -20 + IF (LP.GT.0) + & write(LP,*) ' Error return from MPI_TEST ', + & IFLAG, ' in ZMUMPS_329' + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + IF ( FLAG ) THEN + MESSAGE_RECEIVED = .TRUE. + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN_LOC, IERR ) + IF (.NOT.RIGHT_MESS) RECURS = RECURS + 10 + CALL ZMUMPS_322( COMM_LOAD, ASS_IRECV, + & MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (.NOT.RIGHT_MESS) RECURS = RECURS - 10 + IF ( IFLAG .LT. 0 ) RETURN + IF (.NOT.RIGHT_MESS) THEN + IF (ASS_IRECV .NE. MPI_REQUEST_NULL) THEN + CALL MUMPS_ABORT() + ENDIF + CALL MPI_IPROBE(MSGSOU,MSGTAG, + & COMM, FLAGbis, STATUS, IERR) + IF (FLAGbis) THEN + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + CALL ZMUMPS_280( COMM_LOAD, ASS_IRECV, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + ENDIF + ELSE + IF (BLOCKING) THEN + CALL MPI_PROBE(MSGSOU,MSGTAG, + & COMM, STATUS, IERR) + FLAG = .TRUE. + ELSE + CALL MPI_IPROBE(MPI_ANY_SOURCE,MPI_ANY_TAG, + & COMM, FLAG, STATUS, IERR) + ENDIF + IF (FLAG) THEN + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + MESSAGE_RECEIVED = .TRUE. + CALL ZMUMPS_280( COMM_LOAD, ASS_IRECV, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + 250 CONTINUE + RECURS = RECURS - 1 + IF ( NBFIN .EQ. 0 ) RETURN + IF ( RECURS .GT. 3 ) RETURN + IF ( KEEP(36).EQ.1 .AND. SET_IRECV .AND. + & (ASS_IRECV.EQ.MPI_REQUEST_NULL) .AND. + & MESSAGE_RECEIVED ) THEN + CALL MPI_IRECV ( BUFR(1), + & LBUFR_BYTES, MPI_PACKED, MPI_ANY_SOURCE, + & MPI_ANY_TAG, COMM, + & ASS_IRECV, IERR ) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_329 + SUBROUTINE ZMUMPS_255( INFO1, + & ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & COMM, + & MYID, SLAVEF) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER LBUFR, LBUFR_BYTES + INTEGER ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER COMM + INTEGER MYID, SLAVEF, INFO1, DEST + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL NO_ACTIVE_IRECV + INTEGER MSGSOU_LOC, MSGTAG_LOC + INTEGER IERR, DUMMY + INTRINSIC mod + IF (SLAVEF .EQ. 1) RETURN + IF (ASS_IRECV.EQ.MPI_REQUEST_NULL) THEN + NO_ACTIVE_IRECV=.TRUE. + ELSE + CALL MPI_TEST(ASS_IRECV, NO_ACTIVE_IRECV, + & STATUS, IERR) + ENDIF + CALL MPI_BARRIER(COMM,IERR) + DUMMY = 1 + DEST = mod(MYID+1, SLAVEF) + CALL ZMUMPS_62 + & (DUMMY, DEST, TAG_DUMMY, COMM, IERR) + IF (NO_ACTIVE_IRECV) THEN + CALL MPI_RECV( BUFR, LBUFR, + & MPI_INTEGER, MPI_ANY_SOURCE, + & TAG_DUMMY, COMM, STATUS, IERR ) + ELSE + CALL MPI_WAIT(ASS_IRECV, + & STATUS, IERR) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_255 + SUBROUTINE ZMUMPS_180( + & INFO1, BUFR, LBUFR, LBUFR_BYTES, + & COMM_NODES, COMM_LOAD, SLAVEF, MP ) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER COMM_NODES, COMM_LOAD, SLAVEF, INFO1, MP + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL FLAG, BUFFERS_EMPTY, BUFFERS_EMPTY_ON_ALL_PROCS + INTEGER MSGSOU_LOC, MSGTAG_LOC, COMM_EFF + INTEGER IERR + INTEGER IBUF_EMPTY, IBUF_EMPTY_ON_ALL_PROCS + IF (SLAVEF.EQ.1) RETURN + BUFFERS_EMPTY_ON_ALL_PROCS = .FALSE. + 10 CONTINUE + FLAG = .TRUE. + DO WHILE ( FLAG ) + COMM_EFF = COMM_NODES + CALL MPI_IPROBE(MPI_ANY_SOURCE,MPI_ANY_TAG, + & COMM_NODES, FLAG, STATUS, IERR) + IF ( .NOT. FLAG ) THEN + COMM_EFF = COMM_LOAD + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, + & COMM_LOAD, FLAG, STATUS, IERR) + END IF + IF (FLAG) THEN + MSGSOU_LOC = STATUS( MPI_SOURCE ) + MSGTAG_LOC = STATUS( MPI_TAG ) + CALL MPI_RECV( BUFR, LBUFR_BYTES, + & MPI_PACKED, MSGSOU_LOC, + & MSGTAG_LOC, COMM_EFF, STATUS, IERR ) + ENDIF + END DO + IF (BUFFERS_EMPTY_ON_ALL_PROCS) THEN + RETURN + ENDIF + CALL ZMUMPS_469(BUFFERS_EMPTY) + IF ( BUFFERS_EMPTY ) THEN + IBUF_EMPTY = 0 + ELSE + IBUF_EMPTY = 1 + ENDIF + CALL MPI_ALLREDUCE(IBUF_EMPTY, + & IBUF_EMPTY_ON_ALL_PROCS, + & 1, MPI_INTEGER, MPI_MAX, + & COMM_NODES, IERR) + IF ( IBUF_EMPTY_ON_ALL_PROCS == 0) THEN + BUFFERS_EMPTY_ON_ALL_PROCS = .TRUE. + ELSE + BUFFERS_EMPTY_ON_ALL_PROCS = .FALSE. + ENDIF + GOTO 10 + END SUBROUTINE ZMUMPS_180 + INTEGER FUNCTION ZMUMPS_748 + & ( HBUF_SIZE, NNMAX, K227, K50 ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NNMAX, K227, K50 + INTEGER(8), INTENT(IN) :: HBUF_SIZE + INTEGER K227_LOC + INTEGER NBCOL_MAX + INTEGER EFFECTIVE_SIZE + NBCOL_MAX=int(HBUF_SIZE / int(NNMAX,8)) + K227_LOC = abs(K227) + IF (K50.EQ.2) THEN + K227_LOC=max(K227_LOC,2) + EFFECTIVE_SIZE = min(NBCOL_MAX-1, K227_LOC-1) + ELSE + EFFECTIVE_SIZE = min(NBCOL_MAX, K227_LOC) + ENDIF + IF (EFFECTIVE_SIZE.LE.0) THEN + write(6,*) 'Internal buffers too small to store ', + & ' ONE col/row of size', NNMAX + CALL MUMPS_ABORT() + ENDIF + ZMUMPS_748 = EFFECTIVE_SIZE + RETURN + END FUNCTION ZMUMPS_748 + SUBROUTINE ZMUMPS_698( IPIV, LPIV, ISHIFT, + & THE_PANEL, NBROW, NBCOL, KbeforePanel ) + IMPLICIT NONE + INTEGER LPIV, ISHIFT, NBROW, NBCOL, KbeforePanel + INTEGER IPIV(LPIV) + COMPLEX(kind=8) THE_PANEL(NBROW, NBCOL) + INTEGER I, IPERM + DO I = 1, LPIV + IPERM=IPIV(I) + IF ( I+ISHIFT.NE.IPERM) THEN + CALL zswap(NBCOL, + & THE_PANEL(I+ISHIFT-KbeforePanel,1), NBROW, + & THE_PANEL(IPERM-KbeforePanel,1), NBROW) + ENDIF + END DO + RETURN + END SUBROUTINE ZMUMPS_698 + SUBROUTINE ZMUMPS_667(TYPEF, + & NBPANELS, + & I_PIVPTR, I_PIV, IPOS, IW, LIW) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER, intent(out) :: NBPANELS, I_PIVPTR, I_PIV + INTEGER, intent(in) :: TYPEF + INTEGER, intent(in) :: LIW, IPOS + INTEGER IW(LIW) + INTEGER I_NBPANELS, I_NASS + I_NASS = IPOS + I_NBPANELS = I_NASS + 1 + NBPANELS = IW(I_NBPANELS) + I_PIVPTR = I_NBPANELS + 1 + I_PIV = I_PIVPTR + NBPANELS + IF (TYPEF==TYPEF_U) THEN + I_NBPANELS = I_PIV+IW(I_NASS) + NBPANELS = IW(I_NBPANELS) + I_PIVPTR = I_NBPANELS + 1 + I_PIV = I_PIVPTR + NBPANELS + ENDIF + RETURN + END SUBROUTINE ZMUMPS_667 + SUBROUTINE ZMUMPS_691(K50,NBPANELS_L,NBPANELS_U, + & NASS, IPOS, IW, LIW ) + IMPLICIT NONE + INTEGER K50 + INTEGER IPOS, NASS, NBPANELS_L, NBPANELS_U, LIW + INTEGER IW(LIW) + INTEGER IPOS_U + IF (K50.EQ.1) THEN + WRITE(*,*) "Internal error: ZMUMPS_691 called" + ENDIF + IW(IPOS)=NASS + IW(IPOS+1)=NBPANELS_L + IW(IPOS+2:IPOS+1+NBPANELS_L)=NASS+1 + IF (K50 == 0) THEN + IPOS_U=IPOS+2+NASS+NBPANELS_L + IW(IPOS_U)=NBPANELS_U + IW(IPOS_U+1:IPOS_U+NBPANELS_U)=NASS+1 + ENDIF + RETURN + END SUBROUTINE ZMUMPS_691 + SUBROUTINE ZMUMPS_644 ( + & IWPOS, IOLDPS, IW, LIW, MonBloc, NFRONT, KEEP + & ) + USE ZMUMPS_OOC + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER, INTENT(IN) :: IOLDPS, LIW, NFRONT, + & KEEP(500) + INTEGER, INTENT(INOUT) :: IWPOS, IW(LIW) + TYPE(IO_BLOCK), INTENT(IN):: MonBloc + INTEGER :: NBPANELS_L,I_PIVRPTR_L, I_PIVR_L, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, XSIZE, IBEGOOC + LOGICAL FREESPACE + IF (KEEP(50).EQ.1) RETURN + IF ((IOLDPS+IW(IOLDPS+XXI)).NE.IWPOS) RETURN + XSIZE = KEEP(IXSZ) + IBEGOOC = IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE + CALL ZMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IBEGOOC, IW, LIW) + FREESPACE = + & (MonBloc%LastPiv.EQ.(IW(I_PIVRPTR_L)-1)) + IF (KEEP(50).EQ.0) THEN + CALL ZMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IBEGOOC, IW, LIW) + FREESPACE = FREESPACE .AND. + & (MonBloc%LastPiv.EQ.(IW(I_PIVRPTR_U)-1)) + ENDIF + IF (FREESPACE) THEN + IW(IBEGOOC) = -7777 + IW(IOLDPS+XXI) = IBEGOOC - IOLDPS + 1 + IWPOS = IBEGOOC+1 + ENDIF + RETURN + END SUBROUTINE ZMUMPS_644 + SUBROUTINE ZMUMPS_684(K50, NBROW_L, NBCOL_U, NASS, + & NBPANELS_L, NBPANELS_U, LREQ) + USE ZMUMPS_OOC + IMPLICIT NONE + INTEGER, intent(IN) :: K50, NBROW_L, NBCOL_U, NASS + INTEGER, intent(OUT) :: NBPANELS_L, NBPANELS_U, LREQ + NBPANELS_L=-99999 + NBPANELS_U=-99999 + IF (K50.EQ.1) THEN + LREQ = 0 + RETURN + ENDIF + NBPANELS_L = (NASS / ZMUMPS_690(NBROW_L))+1 + LREQ = 1 + & + 1 + & + NASS + & + NBPANELS_L + IF (K50.eq.0) THEN + NBPANELS_U = (NASS / ZMUMPS_690(NBCOL_U) ) +1 + LREQ = LREQ + 1 + & + NASS + & + NBPANELS_U + ENDIF + RETURN + END SUBROUTINE ZMUMPS_684 + SUBROUTINE ZMUMPS_755 + & (IW_LOCATION, MUST_BE_PERMUTED) + IMPLICIT NONE + INTEGER, INTENT(IN) :: IW_LOCATION + LOGICAL, INTENT(INOUT) :: MUST_BE_PERMUTED + IF (IW_LOCATION .EQ. -7777) THEN + MUST_BE_PERMUTED = .FALSE. + ENDIF + RETURN + END SUBROUTINE ZMUMPS_755 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part2.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part2.F new file mode 100644 index 000000000..ba81e2ad6 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part2.F @@ -0,0 +1,7687 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE ZMUMPS_152(SSARBR, MYID, N, IPOSBLOCK, + & RPOSBLOCK, + & IW, LIW, + & LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP, KEEP8, IN_PLACE_STATS + & ) + USE ZMUMPS_LOAD + IMPLICIT NONE + INTEGER(8) :: RPOSBLOCK + INTEGER IPOSBLOCK, + & LIW, IWPOSCB, N + INTEGER(8) :: LA, LRLU, LRLUS, IPTRLU + LOGICAL IN_PLACE_STATS + INTEGER IW( LIW ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER MYID + LOGICAL SSARBR + INTEGER SIZFI_BLOCK, SIZFI + INTEGER IPOSSHIFT + INTEGER(8) :: SIZFR, SIZFR_BLOCK, SIZFR_BLOCK_EFF, + & SIZEHOLE, MEM_INC + INCLUDE 'mumps_headers.h' + IPOSSHIFT = IPOSBLOCK + KEEP(IXSZ) + SIZFI_BLOCK=IW(IPOSBLOCK+XXI) + CALL MUMPS_729( SIZFR_BLOCK,IW(IPOSBLOCK+XXR) ) + IF (KEEP(216).eq.3) THEN + SIZFR_BLOCK_EFF=SIZFR_BLOCK + ELSE + CALL ZMUMPS_628( IW(IPOSBLOCK), + & LIW-IPOSBLOCK+1, + & SIZEHOLE, KEEP(IXSZ)) + SIZFR_BLOCK_EFF=SIZFR_BLOCK-SIZEHOLE + ENDIF + IF ( IPOSBLOCK .eq. IWPOSCB + 1 ) THEN + IPTRLU = IPTRLU + SIZFR_BLOCK + IWPOSCB = IWPOSCB + SIZFI_BLOCK + LRLU = LRLU + SIZFR_BLOCK + IF (.NOT. IN_PLACE_STATS) THEN + LRLUS = LRLUS + SIZFR_BLOCK_EFF + ENDIF + MEM_INC = -SIZFR_BLOCK_EFF + IF (IN_PLACE_STATS) THEN + MEM_INC= 0_8 + ENDIF + CALL ZMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,0_8,MEM_INC,KEEP,KEEP8,LRLU) + 90 IF ( IWPOSCB .eq. LIW ) GO TO 100 + IPOSSHIFT = IWPOSCB + KEEP(IXSZ) + SIZFI = IW( IWPOSCB+1+XXI ) + CALL MUMPS_729( SIZFR,IW(IWPOSCB+1+XXR) ) + IF ( IW( IWPOSCB+1+XXS ) .EQ. S_FREE ) THEN + IPTRLU = IPTRLU + SIZFR + LRLU = LRLU + SIZFR + IWPOSCB = IWPOSCB + SIZFI + GO TO 90 + ENDIF + 100 CONTINUE + IW( IWPOSCB+1+XXP)=TOP_OF_STACK + ELSE + IW( IPOSBLOCK +XXS)=S_FREE + IF (.NOT. IN_PLACE_STATS) LRLUS = LRLUS + SIZFR_BLOCK_EFF + CALL ZMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,0_8,-SIZFR_BLOCK_EFF,KEEP,KEEP8,LRLU) + END IF + RETURN + END SUBROUTINE ZMUMPS_152 + SUBROUTINE ZMUMPS_144( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, PIMASTER, + & PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP,PIVNUL_LIST,LPN_LIST) + USE ZMUMPS_OOC + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, INODE, FPERE, LIW, NOFFW, NPVW + INTEGER(8) :: LA + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + DOUBLE PRECISION UU, SEUIL + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER COMM, MYID, LBUFR, LBUFR_BYTES + INTEGER LPTRAR, NELT + INTEGER ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NBFIN, SLAVEF, + & IFLAG, IERROR, LEAF, LPOOL + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB, COMP + INTEGER FRTPTR( N + 1 ), FRTELT( NELT ) + INTEGER BUFR( LBUFR ), IPOOL(LPOOL), + & ITLOC(N+KEEP(253)), FILS(N), + & PTRARW(LPTRAR), PTRAIW(LPTRAR), + & ND( KEEP(28) ), FRERE( KEEP(28) ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), NBPROCFILS(KEEP(28)), + & PROCNODE_STEPS(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + LOGICAL AVOID_DELAYED + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER INOPV, IFINB, NFRONT, NPIV, IBEGKJI, NBOLKJ, + & NBTLKJ, IBEG_BLOCK + INTEGER(8) :: POSELT + INTEGER NASS, NEL1, IEND, IOLDPS, dummy, allocok + LOGICAL LASTBL + DOUBLE PRECISION UUTEMP + INTEGER , ALLOCATABLE, DIMENSION ( : ) :: IPIV + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, LNextPiv2beWritten, + & UNextPiv2beWritten, IFLAG_OOC, + & PP_FIRST2SWAP_L, PP_FIRST2SWAP_U, + & PP_LastPIVRPTRFilled_L, PP_LastPIVRPTRFilled_U + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INCLUDE 'mumps_headers.h' + EXTERNAL ZMUMPS_224, ZMUMPS_233, + & ZMUMPS_225, ZMUMPS_232, + & ZMUMPS_294, + & ZMUMPS_44 + LOGICAL STATICMODE + DOUBLE PRECISION SEUIL_LOC + INOPV = 0 + SEUIL_LOC = SEUIL + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + UUTEMP=UU + ENDIF + IBEG_BLOCK=1 + dummy = 0 + IOLDPS = PTLUST_S(STEP( INODE )) + POSELT = PTRAST(STEP( INODE )) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5),NASS ) + ENDIF + NBTLKJ = NBOLKJ + ALLOCATE( IPIV( NASS ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) MYID,' : FACTO_NIV2 :failed to allocate ',NASS, + & ' integers' + IFLAG = -13 + IERROR =NASS + GO TO 490 + END IF + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_U + LNextPiv2beWritten = 1 + UNextPiv2beWritten = 1 + PP_FIRST2SWAP_L = LNextPiv2beWritten + PP_FIRST2SWAP_U = UNextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + MonBloc%LastPanelWritten_U = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 2 + MonBloc%NROW = NASS + MonBloc%NCOL = NFRONT + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -68877 + NULLIFY(MonBloc%INDICES) + ENDIF + 50 CONTINUE + IBEGKJI = IBEG_BLOCK + CALL ZMUMPS_224(NFRONT,NASS,IBEGKJI, NASS, IPIV, + & N,INODE,IW,LIW,A,LA,INOPV,NOFFW, + & IFLAG,IOLDPS,POSELT,UU,SEUIL_LOC,KEEP,KEEP8, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U, + & PP_LastPIVRPTRFilled_U) + IF (IFLAG.LT.0) GOTO 490 + IF (INOPV.EQ.1) THEN + IF(STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + ENDIF + IF (INOPV.GE.1) THEN + LASTBL = (INOPV.EQ.1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL ZMUMPS_294( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, NFRONT, + & IBEGKJI, IEND, IPIV, NASS,LASTBL, dummy, + & + & COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (INOPV.EQ.1) GO TO 500 + IF (INOPV.EQ.2) THEN + CALL ZMUMPS_233(IBEG_BLOCK,NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,NBOLKJ,NBTLKJ,KEEP(4),KEEP(IXSZ)) + GOTO 50 + ENDIF + NPVW = NPVW + 1 + IF (NASS.LE.1) THEN + IFINB = -1 + ELSE + CALL ZMUMPS_225(IBEG_BLOCK, + & NFRONT, NASS, N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB, + & NBTLKJ,KEEP(4),KEEP(IXSZ)) + ENDIF + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + IF (IFINB.EQ.0) GOTO 50 + IF ((IFINB.EQ.1).OR.(IFINB.EQ.-1)) THEN + LASTBL = (IFINB.EQ.-1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL ZMUMPS_294(COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, NFRONT, + & IBEGKJI, IEND, IPIV, NASS, LASTBL, dummy, + & + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (IFINB.EQ.(-1)) GOTO 500 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NEL1 = NASS - NPIV + CALL ZMUMPS_232(A,LA, + & NFRONT,NPIV,NASS,POSELT,NBTLKJ) + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_TRY_WRITE + MonBloc%LastPiv = NPIV + TYPEFile = TYPEF_BOTH_LU + LAST_CALL= .FALSE. + CALL ZMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG<0) RETURN + ENDIF + GO TO 50 + 490 CONTINUE + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + DEALLOCATE( IPIV ) + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + TYPEFile = TYPEF_BOTH_LU + LAST_CALL = .TRUE. + CALL ZMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG<0) RETURN + CALL ZMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_144 + SUBROUTINE ZMUMPS_176( COMM_LOAD, ASS_IRECV, + & root, FRERE, IROOT, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER IROOT + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC,IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER(8) :: LA + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND(KEEP(28)), FRERE(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX(kind=8) DBLARR( max(1,KEEP(13)) ) + INTEGER I, NELIM, NB_CONTRI_GLOBAL, NUMORG, + & NFRONT, IROW, JCOL, PDEST, HF, IOLDPS, + & IN, DEB_ROW, ILOC_ROW, IFSON, ILOC_COL, + & IPOS_SON, NELIM_SON, NSLAVES_SON, HS, + & IROW_SON, ICOL_SON, ISLAVE, IERR, + & NELIM_SENT, IPOS_STATREC + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INCLUDE 'mumps_headers.h' + INCLUDE 'mumps_tags.h' + NB_CONTRI_GLOBAL = KEEP(41) + NUMORG = root%ROOT_SIZE + NELIM = KEEP(42) + NFRONT = NUMORG + KEEP(42) + DO IROW = 0, root%NPROW - 1 + DO JCOL = 0, root%NPCOL - 1 + PDEST = IROW * root%NPCOL + JCOL + IF ( PDEST .NE. MYID ) THEN + CALL ZMUMPS_73(NFRONT, + & NB_CONTRI_GLOBAL, PDEST, COMM, IERR) + if (IERR.lt.0) then + write(6,*) ' error detected by ', + & 'ZMUMPS_73' + CALL MUMPS_ABORT() + endif + ENDIF + END DO + END DO + CALL ZMUMPS_270( NFRONT, + & NB_CONTRI_GLOBAL, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND ) + IF (IFLAG < 0 ) RETURN + HF = 6 + KEEP(IXSZ) + IOLDPS = PTLUST_S(STEP(IROOT)) + IN = IROOT + DEB_ROW = IOLDPS + HF + ILOC_ROW = DEB_ROW + DO WHILE (IN.GT.0) + IW(ILOC_ROW) = IN + IW(ILOC_ROW+NFRONT) = IN + ILOC_ROW = ILOC_ROW + 1 + IN = FILS(IN) + END DO + IFSON = -IN + ILOC_ROW = IOLDPS + HF + NUMORG + ILOC_COL = ILOC_ROW + NFRONT + IF ( NELIM.GT.0 ) THEN + IN = IFSON + DO WHILE (IN.GT.0) + IPOS_SON = PIMASTER(STEP(IN)) + IF (IPOS_SON .EQ. 0) GOTO 100 + NELIM_SON = IW(IPOS_SON+1+KEEP(IXSZ)) + if (NELIM_SON.eq.0) then + write(6,*) ' error 1 in process_last_rtnelind' + CALL MUMPS_ABORT() + endif + NSLAVES_SON = IW(IPOS_SON+5+KEEP(IXSZ)) + HS = 6 + NSLAVES_SON + KEEP(IXSZ) + IROW_SON = IPOS_SON + HS + ICOL_SON = IROW_SON + NELIM_SON + DO I = 1, NELIM_SON + IW( ILOC_ROW+I-1 ) = IW( IROW_SON+I-1 ) + ENDDO + DO I = 1, NELIM_SON + IW( ILOC_COL+I-1 ) = IW( ICOL_SON+I-1 ) + ENDDO + NELIM_SENT = ILOC_ROW - IOLDPS - HF + 1 + DO ISLAVE = 0,NSLAVES_SON + IF (ISLAVE.EQ.0) THEN + PDEST= MUMPS_275(PROCNODE_STEPS(STEP(IN)),SLAVEF) + ELSE + PDEST = IW(IPOS_SON + 5 + ISLAVE+KEEP(IXSZ)) + ENDIF + IF (PDEST.NE.MYID) THEN + CALL ZMUMPS_74(IN, NELIM_SENT, + & PDEST, COMM, IERR ) + if (IERR.lt.0) then + write(6,*) ' error detected by ', + & 'ZMUMPS_73' + CALL MUMPS_ABORT() + endif + ELSE + CALL ZMUMPS_271( COMM_LOAD, ASS_IRECV, + & IN, NELIM_SENT, root, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( ISLAVE .NE. 0 ) THEN + IF (KEEP(50) .EQ. 0) THEN + IPOS_STATREC = PTRIST(STEP(IN))+6+KEEP(IXSZ) + ELSE + IPOS_STATREC = PTRIST(STEP(IN))+8+KEEP(IXSZ) + ENDIF + IF (IW(IPOS_STATREC).EQ. S_REC_CONTSTATIC) THEN + IW(IPOS_STATREC) = S_ROOT2SON_CALLED + ELSE + CALL ZMUMPS_626( N, IN, PTRIST, PTRAST, + & IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + ENDIF + ENDIF + IPOS_SON = PIMASTER(STEP(IN)) + ENDIF + END DO + CALL ZMUMPS_152( .FALSE.,MYID,N, IPOS_SON, + & PTRAST(STEP(IN)), + & IW, LIW, + & LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + ILOC_ROW = ILOC_ROW + NELIM_SON + ILOC_COL = ILOC_COL + NELIM_SON + 100 CONTINUE + IN = FRERE(STEP(IN)) + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_176 + SUBROUTINE ZMUMPS_268(MYID,BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, SLAVEF, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, + & N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, NBPROCFILS, + & IPOOL, LPOOL, LEAF, KEEP,KEEP8, ND, FILS, FRERE, + & ITLOC, RHS_MUMPS, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER MYID + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER SLAVEF + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), STEP(N), PIMASTER(KEEP(28)) + INTEGER PROCNODE_STEPS( KEEP(28) ), ITLOC( N +KEEP(253) ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM, COMM_LOAD + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER ND(KEEP(28)), FILS( N ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER POSITION, IFATH, ISON, NROW, NCOL, NELIM, + & NSLAVES + INTEGER(8) :: NOREAL + INTEGER NOINT, INIV2, NCOL_EFF + DOUBLE PRECISION FLOP1 + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INTEGER NOREAL_PACKET + LOGICAL PERETYPE2 + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + POSITION = 0 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IFATH, 1, MPI_INTEGER + & , COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & ISON , 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NSLAVES, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NROW , 1, MPI_INTEGER + & , COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NCOL , 1, MPI_INTEGER + & , COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, + & MPI_INTEGER, COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, + & MPI_INTEGER, COMM, IERR) + IF ( NSLAVES .NE. 0 .and. KEEP(50).ne.0 ) THEN + NCOL_EFF = NROW + ELSE + NCOL_EFF = NCOL + ENDIF + NOREAL_PACKET = NBROWS_PACKET * NCOL_EFF + IF (NBROWS_ALREADY_SENT .EQ. 0) THEN + NOINT = 6 + NROW + NCOL + NSLAVES + KEEP(IXSZ) + NOREAL= int(NROW,8) * int(NCOL_EFF,8) + CALL ZMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A,LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, + & NOINT, NOREAL, ISON, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) THEN + RETURN + ENDIF + PIMASTER(STEP( ISON )) = IWPOSCB + 1 + PAMASTER(STEP( ISON )) = IPTRLU + 1_8 + IW( IWPOSCB + 1 + KEEP(IXSZ) ) = NCOL + NELIM = NROW + IW( IWPOSCB + 2 + KEEP(IXSZ) ) = NELIM + IW( IWPOSCB + 3 + KEEP(IXSZ) ) = NROW + IF ( NSLAVES .NE. 0 .and. KEEP(50).ne.0 ) THEN + IW( IWPOSCB + 4 + KEEP(IXSZ) ) = NROW - NCOL + IF ( NROW - NCOL .GE. 0 ) THEN + WRITE(*,*) 'Error in PROCESS_MAITRE2:',NROW,NCOL + CALL MUMPS_ABORT() + END IF + ELSE + IW( IWPOSCB + 4 + KEEP(IXSZ) ) = 0 + END IF + IW( IWPOSCB + 5 + KEEP(IXSZ) ) = 1 + IW( IWPOSCB + 6 + KEEP(IXSZ) ) = NSLAVES + IF (NSLAVES.GT.0) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IWPOSCB + 7 + KEEP(IXSZ) ), + & NSLAVES, MPI_INTEGER, COMM, IERR ) + ENDIF + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IW(IWPOSCB + 7 + KEEP(IXSZ) + NSLAVES), + & NROW, MPI_INTEGER, COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IW(IWPOSCB + 7 + KEEP(IXSZ) + NROW + NSLAVES), + & NCOL, MPI_INTEGER, COMM, IERR) + IF ( ( KEEP(48).NE. 0 ).AND.(NSLAVES .GT. 0 )) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(ISON) ) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & TAB_POS_IN_PERE(1,INIV2), + & NSLAVES+1, MPI_INTEGER, COMM, IERR) + TAB_POS_IN_PERE(SLAVEF+2,INIV2) = NSLAVES + ENDIF + ENDIF + IF (NOREAL_PACKET.GT.0) THEN + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & A(PAMASTER(STEP(ISON)) + + & int(NBROWS_ALREADY_SENT,8) * int(NCOL_EFF,8)), + & NOREAL_PACKET, MPI_DOUBLE_COMPLEX, COMM, IERR) + ENDIF + IF ( NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. NROW ) THEN + PERETYPE2 = ( MUMPS_330(PROCNODE_STEPS(STEP(IFATH)), + & SLAVEF) .EQ. 2 ) + NSTK_S( STEP(IFATH )) = NSTK_S( STEP(IFATH) ) - 1 + IF ( NSTK_S( STEP(IFATH)) .EQ. 0 ) THEN + CALL ZMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IFATH ) + IF (KEEP(47) .GE. 3) THEN + CALL ZMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + CALL MUMPS_137( IFATH, N, PROCNODE_STEPS, + & SLAVEF, ND, + & FILS,FRERE, STEP, PIMASTER, + & KEEP(28), KEEP(50), KEEP(253), + & FLOP1,IW, LIW, KEEP(IXSZ) ) + IF (IFATH.NE.KEEP(20)) + & CALL ZMUMPS_190(1, .FALSE., FLOP1, KEEP,KEEP8) + END IF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_268 + SUBROUTINE ZMUMPS_242(DATA, LDATA, MPITYPE, ROOT, COMMW, TAG, + &SLAVEF) + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER LDATA, ROOT, COMMW, TAG, MPITYPE, SLAVEF + INTEGER DEST + INTEGER DATA(LDATA) + DO 10 DEST = 0, SLAVEF - 1 + IF (DEST .NE. ROOT) THEN + IF ( LDATA .EQ. 1 .and. MPITYPE .EQ. MPI_INTEGER ) THEN + CALL ZMUMPS_62( DATA(1), DEST, TAG, + & COMMW, IERR ) + ELSE + WRITE(*,*) 'Error : bad argument to ZMUMPS_242' + CALL MUMPS_ABORT() + END IF + ENDIF + 10 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_242 + SUBROUTINE ZMUMPS_44( MYID, SLAVEF, COMM ) + INTEGER MYID, SLAVEF, COMM + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER DUMMY (1) + CALL ZMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, + & COMM, TERREUR, SLAVEF ) + RETURN + END SUBROUTINE ZMUMPS_44 + SUBROUTINE ZMUMPS_464( K34, K35, K16, K10 ) + IMPLICIT NONE + INTEGER, INTENT(OUT) :: K34, K35, K10, K16 + INTEGER SIZE_INT, SIZE_REAL_OR_DOUBLE + INTEGER I(2) + DOUBLE PRECISION R(2) + CALL MUMPS_SIZE_C(I(1),I(2),SIZE_INT) + CALL MUMPS_SIZE_C(R(1),R(2),SIZE_REAL_OR_DOUBLE) + K34 = int(SIZE_INT) + K10 = 8 / K34 + K16 = int(SIZE_REAL_OR_DOUBLE) + K35 = K16 + K35 = K35 * 2 + RETURN + END SUBROUTINE ZMUMPS_464 + SUBROUTINE ZMUMPS_20( NSLAVES, LWK_USER, CNTL, ICNTL, + & KEEP,KEEP8, + & INFO, INFOG, RINFO, RINFOG, SYM, PAR, + & DKEEP) + IMPLICIT NONE + DOUBLE PRECISION DKEEP(30) + DOUBLE PRECISION CNTL(15), RINFO(40), RINFOG(40) + INTEGER ICNTL(40), KEEP(500), SYM, PAR, NSLAVES + INTEGER INFO(40), INFOG(40) + INTEGER(8) KEEP8(150) + INTEGER LWK_USER +C Let $A_{preproc}$ be the preprocessed matrix to be factored (see + LWK_USER = 0 + KEEP(1:500) = 0 + KEEP8(1:150)= 0_8 + INFO(1:40) = 0 + INFOG(1:40) = 0 + ICNTL(1:40) = 0 + RINFO(1:40) = 0.0D0 + RINFOG(1:40)= 0.0D0 + CNTL(1:15) = 0.0D0 + DKEEP(1:30) = 0.0D0 + KEEP( 50 ) = SYM + IF (SYM.EQ.1) THEN + KEEP(50) = 2 + ENDIF + IF ( KEEP(50).NE.1 .and. KEEP(50).NE.2 ) KEEP( 50 ) = 0 + IF ( KEEP(50) .NE. 1 ) THEN + CNTL(1) = 0.01D0 + ELSE + CNTL(1) = 0.0D0 + END IF + CNTL(2) = sqrt(epsilon(0.0D0)) + CNTL(3) = 0.0D0 + CNTL(4) = -1.0D0 + CNTL(5) = 0.0D0 + CNTL(6) = -1.0D0 + KEEP(46) = PAR + IF ( KEEP(46) .NE. 0 .AND. + & KEEP(46) .NE. 1 ) THEN + KEEP(46) = 1 + END IF + ICNTL(1) = 6 + ICNTL(2) = 0 + ICNTL(3) = 6 + ICNTL(4) = 2 + ICNTL(5) = 0 + IF (SYM.NE.1) THEN + ICNTL(6) = 7 + ELSE + ICNTL(6) = 0 + ENDIF + ICNTL(7) = 7 + ICNTL(8) = 77 + ICNTL(9) = 1 + ICNTL(10) = 0 + ICNTL(11) = 0 + IF(SYM .EQ. 2) THEN + ICNTL(12) = 0 + ELSE + ICNTL(12) = 1 + ENDIF + ICNTL(13) = 0 + IF (SYM.eq.1.AND.NSLAVES.EQ.1) THEN + ICNTL(14) = 5 + ELSE IF (NSLAVES .GT. 4) THEN + ICNTL(14) = 30 + ELSE + ICNTL(14) = 20 + END IF + ICNTL(15) = 0 + ICNTL(16) = 0 + ICNTL(17) = 0 + ICNTL(18) = 0 + ICNTL(19) = 0 + ICNTL(20) = 0 + ICNTL(21) = 0 + ICNTL(22) = 0 + ICNTL(23) = 0 + ICNTL(24) = 0 + ICNTL(27) = -8 + ICNTL(28) = 1 + ICNTL(29) = 0 + ICNTL(39) = 1 + ICNTL(40) = 0 + KEEP(12) = 0 + KEEP(11) = 2147483646 + KEEP(24) = 18 + KEEP(68) = 0 + KEEP(36) = 1 + KEEP(1) = 8 + KEEP(7) = 150 + KEEP(8) = 120 + KEEP(57) = 500 + KEEP(58) = 250 + IF ( SYM .eq. 0 ) THEN + KEEP(4) = 32 + KEEP(3) = 96 + KEEP(5) = 16 + KEEP(6) = 32 + KEEP(9) = 700 + KEEP(85) = 300 + KEEP(62) = 50 + IF (NSLAVES.GE.128) KEEP(62)=200 + IF (NSLAVES.GE.128) KEEP(9)=800 + IF (NSLAVES.GE.256) KEEP(9)=900 + ELSE + KEEP(4) = 24 + KEEP(3) = 96 + KEEP(5) = 16 + KEEP(6) = 48 + KEEP(9) = 400 + KEEP(85) = 100 + KEEP(62) = 100 + IF (NSLAVES.GE.128) KEEP(62)=150 + IF (NSLAVES.GE.64) KEEP(9)=800 + IF (NSLAVES.GE.128) KEEP(9)=900 + END IF + KEEP(63) = 60 + KEEP(48) = 5 + KEEP(17) = 0 + CALL ZMUMPS_464( KEEP(34), KEEP(35), + & KEEP(16), KEEP(10) ) +#if defined(SP_) + KEEP( 51 ) = 70 +#else + KEEP( 51 ) = 48 +#endif + KEEP(37) = max(800, int(sqrt(dble(NSLAVES+1))*dble(KEEP(51)))) + IF ( NSLAVES > 256 ) THEN + KEEP(39) = 10000 + ELSEIF ( NSLAVES > 128 ) THEN + KEEP(39) = 20000 + ELSEIF ( NSLAVES > 64 ) THEN + KEEP(39) = 40000 + ELSEIF ( NSLAVES > 16 ) THEN + KEEP(39) = 80000 + ELSE + KEEP(39) = 160000 + END IF + KEEP(40) = -1 - 456789 + KEEP(45) = 0 + KEEP(47) = 2 + KEEP(64) = 10 + KEEP(69) = 4 + KEEP(75) = 1 + KEEP(76) = 2 + KEEP(77) = 30 + KEEP(79) = 0 + IF (NSLAVES.GT.4) THEN + KEEP(78)=max( + & int(log(dble(NSLAVES))/log(dble(2))) - 2 + & , 0 ) + ENDIF + KEEP(210) = 2 + KEEP8(79) = -10_8 + KEEP(80) = 1 + KEEP(81) = 0 + KEEP(82) = 5 + KEEP(83) = min(8,NSLAVES/4) + KEEP(83) = max(min(4,NSLAVES),max(KEEP(83),1)) + KEEP(86)=1 + KEEP(87)=0 + KEEP(88)=0 + KEEP(90)=1 + KEEP(91)=min(8, NSLAVES) + KEEP(91) = max(min(4,NSLAVES),min(KEEP(83),KEEP(91))) + IF(NSLAVES.LT.48)THEN + KEEP(102)=150 + ELSEIF(NSLAVES.LT.128)THEN + KEEP(102)=150 + ELSEIF(NSLAVES.LT.256)THEN + KEEP(102)=200 + ELSEIF(NSLAVES.LT.512)THEN + KEEP(102)=300 + ELSEIF(NSLAVES.GE.512)THEN + KEEP(102)=400 + ENDIF +#if defined(OLD_OOC_NOPANEL) + KEEP(99)=0 +#else + KEEP(99)=4 +#endif + KEEP(100)=0 + KEEP(204)=0 + KEEP(205)=0 + KEEP(209)=-1 + KEEP(104) = 16 + KEEP(107)=0 + KEEP(211)=2 + IF (NSLAVES .EQ. 2) THEN + KEEP(213) = 101 + ELSE + KEEP(213) = 201 + ENDIF + KEEP(217)=0 + KEEP(215)=0 + KEEP(216)=1 + KEEP(218)=50 + KEEP(219)=1 + IF (KEEP(50).EQ.2) THEN + KEEP(227)= max(2,32) + ELSE + KEEP(227)= max(1,32) + ENDIF + KEEP(231) = 1 + KEEP(232) = 3 + KEEP(233) = 0 + KEEP(239) = 1 + KEEP(240) = 10 + DKEEP(4) = -1.0D0 + DKEEP(5) = -1.0D0 + IF(NSLAVES.LE.8)THEN + KEEP(238)=12 + ELSE + KEEP(238)=7 + ENDIF + KEEP(234)= 1 + DKEEP(3)=-5.0D0 + KEEP(242) = 1 + KEEP(250) = 1 + RETURN + END SUBROUTINE ZMUMPS_20 + SUBROUTINE ZMUMPS_786(id, LP) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (ZMUMPS_STRUC) :: id + INTEGER LP + IF (id%KEEP(72)==1) THEN + IF (LP.GT.0) + & write(LP,*) 'Warning KEEP(72) = 1 !!!!!!!!!! ' + id%KEEP(37) = 2*id%NSLAVES + id%KEEP(3)=3 + id%KEEP(4)=2 + id%KEEP(5)=1 + id%KEEP(6)=2 + id%KEEP(9)=3 + id%KEEP(39)=300 + id%CNTL(1)=0.1D0 + id%KEEP(213) = 101 + id%KEEP(85)=2 + id%KEEP(85)=-4 + id%KEEP(62) = 2 + id%KEEP(1) = 1 + id%KEEP(51) = 2 + ELSE IF (id%KEEP(72)==2) THEN + IF (LP.GT.0) + & write(LP,*)' OOC setting to reduce stack memory', + & ' KEEP(72)=', id%KEEP(72) + id%KEEP(85)=2 + id%KEEP(85)=-10000 + id%KEEP(62) = 10 + id%KEEP(210) = 1 + id%KEEP8(79) = 160000_8 + id%KEEP(1) = 2 + id%KEEP(102) = 110 + id%KEEP(213) = 121 + END IF + RETURN + END SUBROUTINE ZMUMPS_786 + SUBROUTINE ZMUMPS_195(N, NZ, IRN, ICN, LIW, IKEEP, PTRAR, + & IORD, NFSIZ, FILS, FRERE, LISTVAR_SCHUR, SIZE_SCHUR, + & ICNTL, INFO, KEEP,KEEP8, NSLAVES, PIV, id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N,NZ,LIW,IORD,SIZE_SCHUR, NSLAVES + INTEGER PTRAR(N,4), NFSIZ(N), FILS(N), FRERE(N) + INTEGER IKEEP(N,3) + INTEGER LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER INFO(40), ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + TYPE (ZMUMPS_STRUC) :: id + INTEGER IRN(NZ), ICN(NZ) + INTEGER, DIMENSION(:), ALLOCATABLE :: IW + INTEGER IERR + INTEGER K,I,L1,L2,IWFR,NCMPA,LLIW, IN, IFSON + INTEGER NEMIN, LP, MP, LDIAG, ITEMP, symmetry + INTEGER MedDens, NBQD, AvgDens + LOGICAL PROK, COMPRESS_SCHUR + INTEGER NBBUCK + INTEGER, DIMENSION(:), ALLOCATABLE :: HEAD + INTEGER NUMFLAG + INTEGER OPT_METIS_SIZE + INTEGER, DIMENSION(:), ALLOCATABLE :: OPTIONS_METIS + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: COLSCA_TEMP + INTEGER THRESH, IVersion + LOGICAL AGG6 + INTEGER MINSYM + PARAMETER (MINSYM=50) + INTEGER(8) :: K79REF + PARAMETER(K79REF=12000000_8) + INTEGER PIV(N) + INTEGER MTRANS, COMPRESS,NCMP,IERROR,J,JPERM,NCST + INTEGER TOTEL + LOGICAL IDENT,SPLITROOT + EXTERNAL MUMPS_197, ZMUMPS_198, + & ZMUMPS_199, ZMUMPS_351, + & ZMUMPS_557, ZMUMPS_201 +#if defined(OLDDFS) + EXTERNAL ZMUMPS_200 +#endif + EXTERNAL ZMUMPS_623 + EXTERNAL ZMUMPS_547, ZMUMPS_550, + & ZMUMPS_556 + ALLOCATE( IW ( LIW ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = LIW + RETURN + ENDIF + LLIW = LIW - 2*N - 1 + L1 = LLIW + 1 + L2 = L1 + N + LP = ICNTL(1) + MP = ICNTL(3) + PROK = (MP.GT.0) + LDIAG = ICNTL(4) + COMPRESS_SCHUR = .FALSE. + IF (KEEP(1).LT.0) KEEP(1) = 0 + NEMIN = KEEP(1) + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + WRITE (MP,99999) N, NZ, LIW, INFO(1) + K = min0(10,NZ) + IF (LDIAG.EQ.4) K = NZ + IF (K.GT.0) WRITE (MP,99998) (IRN(I),ICN(I),I=1,K) + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (IORD.EQ.1 .AND. K.GT.0) THEN + WRITE (MP,99997) (IKEEP(I,1),I=1,K) + ENDIF + ENDIF + NCMP = N + IF (KEEP(60).NE.0) THEN + IF ((SIZE_SCHUR.LE.0 ).OR. + & (SIZE_SCHUR.GE.N) ) GOTO 90 + ENDIF +#if defined(metis) || defined(parmetis) + IF ( ( KEEP(60).NE.0).AND.(SIZE_SCHUR.GT.0) + & .AND. + & ((IORD.EQ.7).OR.(IORD.EQ.5)) + & )THEN + COMPRESS_SCHUR=.TRUE. + NCMP = N-SIZE_SCHUR + CALL ZMUMPS_623(N,NCMP,NZ,IRN, ICN, IW(1), LLIW, + & IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, + & KEEP(50), MedDens, NBQD, AvgDens, + & LISTVAR_SCHUR, SIZE_SCHUR, + & FRERE,FILS) + IORD = 5 + KEEP(95) = 1 + NBQD = 0 + ELSE +#endif + CALL ZMUMPS_351(N,NZ,IRN, ICN, IW(1), LLIW, + & IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, + & KEEP(50), MedDens, NBQD, AvgDens) +#if defined(metis) || defined(parmetis) + ENDIF +#endif + INFO(8) = symmetry + IF(NBQD .GT. 0) THEN + IF( KEEP(50) .EQ. 2 .AND. ICNTL(12) .LE. 1 ) THEN + IF(KEEP(95) .NE. 1) THEN + IF ( PROK ) + & WRITE( MP,*) + & 'Compressed/constrained ordering set OFF' + KEEP(95) = 1 + ENDIF + ENDIF + ENDIF + IF ( (KEEP(60).NE.0) .AND. (IORD.GT.1) .AND. + & .NOT. COMPRESS_SCHUR ) THEN + IORD = 0 + ENDIF + IF ( (KEEP(50).EQ.2) + & .AND. (KEEP(95) .EQ. 3) + & .AND. (IORD .EQ. 7) ) THEN + IORD = 2 + ENDIF + CALL ZMUMPS_701( N, KEEP(50), NSLAVES, IORD, + & symmetry, MedDens, NBQD, AvgDens, + & PROK, MP ) + IF(KEEP(50) .EQ. 2) THEN + IF(KEEP(95) .EQ. 3 .AND. IORD .NE. 2) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: ZMUMPS_195 constrained ordering not '// + & ' available with selected ordering. Move to' // + & ' compressed ordering.' + KEEP(95) = 2 + ENDIF + IF(KEEP(95) .EQ. 2 .AND. IORD .EQ. 0) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: ZMUMPS_195 AMD not available with ', + & ' compressed ordering -> move to QAMD' + IORD = 6 + ENDIF + ELSE + KEEP(95) = 1 + ENDIF + MTRANS = KEEP(23) + COMPRESS = KEEP(95) - 1 + IF(COMPRESS .GT. 0 .AND. KEEP(52) .EQ. -2) THEN + IF(id%CNTL(4) .GE. 0.0D0) THEN + IF (KEEP(1).LE.8) THEN + NEMIN = 16 + ELSE + NEMIN = 2*KEEP(1) + ENDIF + IF (PROK) + & WRITE(MP,*) 'Setting static pivoting ON, COMPRESS =', + & COMPRESS + ENDIF + ENDIF + IF(MTRANS .GT. 0 .AND. KEEP(50) .EQ. 2) THEN + KEEP(23) = 0 + ENDIF + IF(COMPRESS .EQ. 2) THEN + IF (IORD.NE.2) THEN + WRITE(*,*) "IORD not compatible with COMPRESS:", + & IORD, COMPRESS + CALL MUMPS_ABORT() + ENDIF + CALL ZMUMPS_556( + & N,PIV,FRERE,FILS,NFSIZ,IKEEP, + & NCST,KEEP,KEEP8,id) + ENDIF + IF ( IORD .NE. 1 ) THEN + IF(COMPRESS .GE. 1) THEN + CALL ZMUMPS_547( + & N,NZ, IRN, ICN, PIV, + & NCMP, IW(1), LLIW, IW(L2),PTRAR(1,2),PTRAR, + & IW(L1), FILS, IWFR, + & IERROR, KEEP,KEEP8, ICNTL) + symmetry = 100 + ENDIF + IF ( (symmetry.LT.MINSYM).AND.(KEEP(50).EQ.0) ) THEN + IF(KEEP(23) .EQ. 7 ) THEN + KEEP(23) = -5 + DEALLOCATE (IW) + RETURN + ELSE IF(KEEP(23) .EQ. -9876543) THEN + IDENT = .TRUE. + KEEP(23) = 5 + IF (PROK) WRITE(MP,'(A)') + & ' ... Apply column permutation (already computed)' + DO J=1,N + JPERM = PIV(J) + FILS(JPERM) = J + IF (JPERM.NE.J) IDENT = .FALSE. + ENDDO + IF (.NOT.IDENT) THEN + DO K=1,NZ + J = ICN(K) + IF ((J.LE.0).OR.(J.GT.N)) CYCLE + ICN(K) = FILS(J) + ENDDO + ALLOCATE(COLSCA_TEMP(N), stat=IERR) + IF ( IERR > 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = N + RETURN + ENDIF + DO J = 1, N + COLSCA_TEMP(J)=id%COLSCA(J) + ENDDO + DO J=1, N + id%COLSCA(FILS(J))=COLSCA_TEMP(J) + ENDDO + DEALLOCATE(COLSCA_TEMP) + IF (MP.GT.0 .AND. ICNTL(4).GE.2) + & WRITE(MP,'(/A)') + & ' WARNING input matrix data modified' + CALL ZMUMPS_351 + & (N,NZ,IRN, ICN, IW(1), LLIW, IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, KEEP(50), + & MedDens, NBQD, AvgDens) + INFO(8) = symmetry + NCMP = N + ELSE + KEEP(23) = 0 + ENDIF + ENDIF + ELSE IF (KEEP(23) .EQ. 7 .OR. KEEP(23) .EQ. -9876543 ) THEN + IF (PROK) WRITE(MP,'(A)') + & ' ... No column permutation' + KEEP(23) = 0 + ENDIF + ENDIF + IF (IORD.NE.1 .AND. IORD.NE.5) THEN + IF (PROK) THEN + IF (IORD.EQ.2) THEN + WRITE(MP,'(A)') ' Ordering based on AMF ' +#if defined(scotch) || defined(ptscotch) + ELSE IF (IORD.EQ.3) THEN + WRITE(MP,'(A)') ' Ordering based on SCOTCH ' +#endif +#if defined(pord) + ELSE IF (IORD.EQ.4) THEN + WRITE(MP,'(A)') ' Ordering based on PORD ' +#endif + ELSE IF (IORD.EQ.6) THEN + WRITE(MP,'(A)') ' Ordering based on QAMD ' + ELSE + WRITE(MP,'(A)') ' Ordering based on AMD ' + ENDIF + ENDIF + IF ( KEEP(60) .NE. 0 ) THEN + CALL MUMPS_162(N, LLIW, IW(L2), IWFR, PTRAR(1,2), IW(1), + & IW(L1), IKEEP, + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), PTRAR, PTRAR(1,3), + & LISTVAR_SCHUR, SIZE_SCHUR) + IF (KEEP(60)==1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSE + KEEP(38) = LISTVAR_SCHUR(1) + ENDIF + ELSE + IF ( .FALSE. ) THEN +#if defined(pord) + ELSEIF (IORD .EQ. 4) THEN + IF(COMPRESS .EQ. 1) THEN + DO I=L1,L1-1+KEEP(93)/2 + IW(I) = 2 + ENDDO + DO I=L1+KEEP(93)/2,L1+NCMP-1 + IW(I) = 1 + ENDDO + CALL MUMPS_PORDF_WND(NCMP, IWFR-1, IW(L2), IW, + & IW(L1), NCMPA, N) + CALL ZMUMPS_548(NCMP,IW(L2),IW(L1),FILS) + CALL ZMUMPS_549(NCMP,IW(L2),IKEEP(1,1), + & FRERE,PTRAR(1,1)) + DO I=1,NCMP + IKEEP(IKEEP(I,1),2)=I + ENDDO + ELSE + CALL MUMPS_PORDF(NCMP, IWFR-1, IW(L2), IW(1), + & IW(L1), NCMPA) + ENDIF + IF ( NCMPA .NE. 0 ) THEN + write(6,*) ' Out PORD, NCMPA=', NCMPA + INFO( 1 ) = -9999 + INFO( 2 ) = 4 + RETURN + ENDIF +#endif +#if defined(scotch) || defined(ptscotch) + ELSEIF (IORD .EQ. 3) THEN + CALL MUMPS_SCOTCH(NCMP, LLIW, IW(L2), IWFR, + & PTRAR(1,2), IW(1), IW(L1), IKEEP, + & IKEEP(1,2), NCMPA) + IF ( NCMPA .NE. 0 ) THEN + write(6,*) ' Out SCTOCH, NCMPA=', NCMPA + INFO( 1 ) = -9999 + INFO( 2 ) = 3 + RETURN + ENDIF + IF (COMPRESS .EQ. 1) THEN + CALL ZMUMPS_548(NCMP,IW(L2),IW(L1),FILS) + CALL ZMUMPS_549(NCMP,IW(L2),IKEEP(1,1), + & FRERE,PTRAR(1,1)) + DO I=1,NCMP + IKEEP(IKEEP(I,1),2)=I + ENDDO + ENDIF +#endif + ELSEIF (IORD .EQ. 2) THEN + NBBUCK = 2*N + ALLOCATE( HEAD ( 0: NBBUCK + 1), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = NBBUCK+2 + RETURN + ENDIF + IF(COMPRESS .GE. 1) THEN + DO I=L1,L1-1+KEEP(93)/2 + IW(I) = 2 + ENDDO + DO I=L1+KEEP(93)/2,L1+NCMP-1 + IW(I) = 1 + ENDDO + ELSE + IW(L1) = -1 + ENDIF + IF(COMPRESS .LE. 1) THEN + CALL MUMPS_337(NCMP, NBBUCK, LLIW, IW(L2), + & IWFR, PTRAR(1,2), + & IW(1), IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3), HEAD) + ELSE + IF(PROK) WRITE(MP,'(A)') + & ' Constrained Ordering based on AMF' + CALL MUMPS_560(NCMP, NBBUCK, LLIW, IW(L2), + & IWFR, PTRAR(1,2), + & IW(1), IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3), HEAD, + & NFSIZ, FRERE) + ENDIF + DEALLOCATE(HEAD) + ELSEIF (IORD .EQ. 6) THEN + ALLOCATE( HEAD ( N ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = N + RETURN + ENDIF + THRESH = 1 + IVersion = 2 + IF(COMPRESS .EQ. 1) THEN + DO I=L1,L1-1+KEEP(93)/2 + IW(I) = 2 + ENDDO + DO I=L1+KEEP(93)/2,L1+NCMP-1 + IW(I) = 1 + ENDDO + TOTEL = KEEP(93)+KEEP(94) + ELSE + IW(L1) = -1 + TOTEL = N + ENDIF + CALL MUMPS_421(TOTEL,IVersion, THRESH, HEAD, + & NCMP, LLIW, IW(L2), IWFR, PTRAR(1,2), IW(1), + & IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3)) + DEALLOCATE(HEAD) + ELSE + CALL MUMPS_197(NCMP, LLIW, IW(L2), IWFR, PTRAR(1,2), + & IW(1), IW(L1), IKEEP, IKEEP(1,2), NCMPA, FILS, + & IKEEP(1,3), PTRAR, PTRAR(1,3)) + ENDIF + ENDIF + IF(COMPRESS .GE. 1) THEN + CALL ZMUMPS_550(N,NCMP,KEEP(94),KEEP(93), + & PIV,IKEEP(1,1),IKEEP(1,2)) + COMPRESS = -1 + ENDIF + ENDIF +#if defined(metis) || defined(parmetis) + IF (IORD.EQ.5) THEN + IF (PROK) THEN + WRITE(MP,'(A)') ' Ordering based on METIS ' + ENDIF + NUMFLAG = 1 + OPT_METIS_SIZE = 8 + ALLOCATE( OPTIONS_METIS (OPT_METIS_SIZE ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = OPT_METIS_SIZE + RETURN + ENDIF + OPTIONS_METIS(1) = 0 + IF (COMPRESS .EQ. 1) THEN + DO I=1,KEEP(93)/2 + FILS(I) = 2 + ENDDO + DO I=KEEP(93)/2+1,NCMP + FILS(I) = 1 + ENDDO + CALL METIS_NODEWND(NCMP, IW(L2), IW(1),FILS, + & NUMFLAG, OPTIONS_METIS, + & IKEEP(1,2), IKEEP(1,1) ) + ELSE + CALL METIS_NODEND(NCMP, IW(L2), IW(1), NUMFLAG, + & OPTIONS_METIS, + & IKEEP(1,2), IKEEP(1,1) ) + ENDIF + DEALLOCATE (OPTIONS_METIS) + IF ( COMPRESS_SCHUR ) THEN + CALL ZMUMPS_622( + & N, NCMP, IKEEP(1,1),IKEEP(1,2), + & LISTVAR_SCHUR, SIZE_SCHUR, FILS) + COMPRESS = -1 + ENDIF + IF (COMPRESS .EQ. 1) THEN + CALL ZMUMPS_550(N,NCMP,KEEP(94), + & KEEP(93),PIV,IKEEP(1,1),IKEEP(1,2)) + COMPRESS = -1 + ENDIF + ENDIF +#endif + IF (PROK) THEN + IF (IORD.EQ.1) THEN + WRITE(MP,'(A)') ' Ordering given is used' + ENDIF + ENDIF + IF ((IORD.EQ.1) + & ) THEN + DO K=1,N + PTRAR(K,1) = 0 + ENDDO + DO K=1,N + IF ((IKEEP(K,1).LE.0).OR.(IKEEP(K,1).GT.N)) + & GO TO 40 + IF (PTRAR(IKEEP(K,1),1).EQ.1) THEN + GOTO 40 + ELSE + PTRAR(IKEEP(K,1),1) = 1 + ENDIF + ENDDO + ENDIF + IF (IORD.EQ.1 .OR. IORD.EQ.5 .OR. COMPRESS.EQ.-1) THEN + IF (KEEP(106)==1) THEN + IF ( COMPRESS .EQ. -1 ) THEN + CALL ZMUMPS_351(N,NZ,IRN, ICN, IW(1), LLIW, + & IW(L2), PTRAR(1,2), + & PTRAR, IW(L1), IWFR, KEEP(113), KEEP(114), + & INFO(1), INFO(2), ICNTL, symmetry, KEEP(50), + & MedDens, NBQD, AvgDens) + INFO(8) = symmetry + ENDIF + COMPRESS = 0 + ALLOCATE( HEAD ( 2*N ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = 2*N + RETURN + ENDIF + THRESH = -1 + IF (KEEP(60) == 0) THEN + ITEMP = 0 + ELSE + ITEMP = SIZE_SCHUR + IF (KEEP(60)==1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSE + KEEP(38) = LISTVAR_SCHUR(1) + ENDIF + ENDIF + AGG6 =.TRUE. + CALL MUMPS_422(THRESH, HEAD, + & N, LLIW, IW(L2), IWFR, PTRAR(1,2), IW, + & IW(L1), HEAD(N+1), + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), PTRAR, PTRAR(1,3), + & IKEEP(1,1), LISTVAR_SCHUR, ITEMP, AGG6) + DEALLOCATE(HEAD) + ELSE + CALL ZMUMPS_198(N, NZ, IRN, ICN, IKEEP, IW(1), + & LLIW, IW(L2), + & PTRAR(1,2), IW(L1), IWFR, + & INFO(1),INFO(2), KEEP(11), MP) + IF (KEEP(60) .EQ. 0) THEN + ITEMP = 0 + CALL ZMUMPS_199(N, IW(L2), IW, LLIW, IWFR, IKEEP, + & IKEEP(1,2), IW(L1), + & PTRAR, NCMPA, ITEMP) + ELSE + CALL ZMUMPS_199(N, IW(L2), IW, LLIW, IWFR, IKEEP, + & IKEEP(1,2), IW(L1), + & PTRAR, NCMPA, SIZE_SCHUR) + IF (KEEP(60) .EQ. 1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSE + KEEP(38) = LISTVAR_SCHUR(1) + ENDIF + ENDIF + ENDIF + ENDIF +#if defined(OLDDFS) + CALL ZMUMPS_200 + & (N, IW(L2), IW(L1), IKEEP(1,1), IKEEP(1,2), IKEEP(1,3), + & NFSIZ, INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, KEEP(60)) +#else + CALL ZMUMPS_557 + & (N, IW(L2), IW(L1), IKEEP(1,1), IKEEP(1,2), IKEEP(1,3), + & NFSIZ, PTRAR, INFO(6), FILS, FRERE, + & PTRAR(1,3), NEMIN, PTRAR(1,4), KEEP(60), + & KEEP(20),KEEP(38),PTRAR(1,2),KEEP(104),IW(1),KEEP(50), + & ICNTL(13), KEEP(37), NSLAVES, KEEP(250).EQ.1) +#endif + IF (KEEP(60).NE.0) THEN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO WHILE (IN.GT.0) + IN = FILS (IN) + END DO + IFSON = -IN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO I=2,SIZE_SCHUR + FILS(IN) = LISTVAR_SCHUR (I) + IN = FILS(IN) + FRERE (IN) = N+1 + ENDDO + FILS(IN) = -IFSON + ENDIF + CALL ZMUMPS_201(IKEEP(1,2), + & PTRAR(1,3), INFO(6), + & INFO(5), KEEP(2), KEEP(50), + & KEEP(101),KEEP(108),KEEP(5), + & KEEP(6), KEEP(226), KEEP(253)) + IF ( KEEP(53) .NE. 0 ) THEN + CALL MUMPS_209( N, FRERE, FILS, NFSIZ, KEEP(20) ) + END IF + IF ( (KEEP(48) == 4 .AND. KEEP8(21).GT.0_8) + & .OR. + & (KEEP (48)==5 .AND. KEEP8(21) .GT. 0_8 ) + & .OR. + & (KEEP(24).NE.0.AND.KEEP8(21).GT.0_8) ) THEN + CALL ZMUMPS_510(KEEP8(21), KEEP(2), + & KEEP(48), KEEP(50), NSLAVES) + END IF + IF (KEEP(210).LT.0.OR.KEEP(210).GT.2) KEEP(210)=0 + IF (KEEP(210).EQ.0.AND.KEEP(201).GT.0) KEEP(210)=1 + IF (KEEP(210).EQ.0.AND.KEEP(201).EQ.0) KEEP(210)=2 + IF (KEEP(210).EQ.2) KEEP8(79)=huge(KEEP8(79)) + IF (KEEP(210).EQ.1.AND.KEEP8(79).LE.0_8) THEN + IF ( huge(KEEP8(79)) / K79REF + 1_8 .GE. int(NSLAVES,8) ) THEN + KEEP8(79)=huge(KEEP8(79)) + ELSE + KEEP8(79)=K79REF * int(NSLAVES,8) + ENDIF + ENDIF + IF ( (KEEP(79).EQ.0).OR.(KEEP(79).EQ.2).OR. + & (KEEP(79).EQ.3).OR.(KEEP(79).EQ.5).OR. + & (KEEP(79).EQ.6) + & ) THEN + IF (KEEP(210).EQ.1) THEN + SPLITROOT = .FALSE. + IF ( KEEP(62).GE.1) THEN + CALL ZMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG,INFO(1),INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + ENDIF + ENDIF + SPLITROOT = ((ICNTL(13).GT.0 .AND. NSLAVES.GT.ICNTL(13)) .OR. + & ICNTL(13).EQ.-1 ) + & .AND. (KEEP(60).EQ.0) + IF (SPLITROOT) THEN + CALL ZMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG,INFO(1),INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (K.GT.0) WRITE (MP,99997) (IKEEP(I,1),I=1,K) + IF (K.GT.0) WRITE (MP,99991) (IKEEP(I,2),I=1,K) + IF (K.GT.0) WRITE (MP,99990) (IKEEP(I,3),I=1,K) + IF (K.GT.0) WRITE (MP,99986) (PTRAR(I,1),I=1,K) + IF (K.GT.0) WRITE (MP,99985) (PTRAR(I,2),I=1,K) + IF (K.GT.0) WRITE (MP,99984) (PTRAR(I,3),I=1,K) + IF (K.GT.0) WRITE (MP,99987) (NFSIZ(I),I=1,K) + IF (K.GT.0) WRITE (MP,99989) (FILS(I),I=1,K) + IF (K.GT.0) WRITE (MP,99988) (FRERE(I),I=1,K) + ENDIF + GO TO 90 + 40 INFO(1) = -4 + INFO(2) = K + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99996) INFO(1) + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99982) INFO(2) + GOTO 90 + 90 CONTINUE + DEALLOCATE(IW) + RETURN +99999 FORMAT (/'Entering analysis phase with ...'/ + & ' N NZ LIW INFO(1)'/, + & 9X, I8, I11, I12, I14) +99998 FORMAT ('Matrix entries: IRN() ICN()'/ + & (I12, I7, I12, I7, I12, I7)) +99997 FORMAT ('IKEEP(.,1)=', 10I6/(12X, 10I6)) +99996 FORMAT (/'** Error return ** from Analysis * INFO(1)=', I3) +99991 FORMAT ('IKEEP(.,2)=', 10I6/(12X, 10I6)) +99990 FORMAT ('IKEEP(.,3)=', 10I6/(12X, 10I6)) +99989 FORMAT ('FILS (.) =', 10I6/(12X, 10I6)) +99988 FORMAT ('FRERE(.) =', 10I6/(12X, 10I6)) +99987 FORMAT ('NFSIZ(.) =', 10I6/(12X, 10I6)) +99986 FORMAT ('PTRAR(.,1)=', 10I6/(12X, 10I6)) +99985 FORMAT ('PTRAR(.,2)=', 10I6/(12X, 10I6)) +99984 FORMAT ('PTRAR(.,3)=', 10I6/(12X, 10I6)) +99982 FORMAT ('Error in permutation array KEEP INFO(2)=', I3) + END SUBROUTINE ZMUMPS_195 + SUBROUTINE ZMUMPS_199(N,IPE,IW, LW, IWFR, IPS, IPV, NV, FLAG, + & NCMPA, SIZE_SCHUR) + INTEGER N,LW,IWFR,NCMPA,SIZE_SCHUR + INTEGER FLAG(N) + INTEGER IPS(N), IPV(N) + INTEGER IW(LW), NV(N), IPE(N) + INTEGER I,J,ML,MS,ME,IP,MINJS,IE,KDUMMY,JP + INTEGER LN,JP1,JS,LWFR,JP2,JE + DO 10 I=1,N + FLAG(I) = 0 + NV(I) = 0 + J = IPS(I) + IPV(J) = I + 10 CONTINUE + NCMPA = 0 + DO 100 ML=1,N-SIZE_SCHUR + MS = IPV(ML) + ME = MS + FLAG(MS) = ME + IP = IWFR + MINJS = N + IE = ME + DO 70 KDUMMY=1,N + JP = IPE(IE) + LN = 0 + IF (JP.LE.0) GO TO 60 + LN = IW(JP) + DO 50 JP1=1,LN + JP = JP + 1 + JS = IW(JP) + IF (FLAG(JS).EQ.ME) GO TO 50 + FLAG(JS) = ME + IF (IWFR.LT.LW) GO TO 40 + IPE(IE) = JP + IW(JP) = LN - JP1 + CALL ZMUMPS_194(N, IPE, IW, IP-1, LWFR,NCMPA) + JP2 = IWFR - 1 + IWFR = LWFR + IF (IP.GT.JP2) GO TO 30 + DO 20 JP=IP,JP2 + IW(IWFR) = IW(JP) + IWFR = IWFR + 1 + 20 CONTINUE + 30 IP = LWFR + JP = IPE(IE) + 40 IW(IWFR) = JS + MINJS = min0(MINJS,IPS(JS)+0) + IWFR = IWFR + 1 + 50 CONTINUE + 60 IPE(IE) = -ME + JE = NV(IE) + NV(IE) = LN + 1 + IE = JE + IF (IE.EQ.0) GO TO 80 + 70 CONTINUE + 80 IF (IWFR.GT.IP) GO TO 90 + IPE(ME) = 0 + NV(ME) = 1 + GO TO 100 + 90 MINJS = IPV(MINJS) + NV(ME) = NV(MINJS) + NV(MINJS) = ME + IW(IWFR) = IW(IP) + IW(IP) = IWFR - IP + IPE(ME) = IP + IWFR = IWFR + 1 + 100 CONTINUE + IF (SIZE_SCHUR == 0) RETURN + DO ML = N-SIZE_SCHUR+1,N + ME = IPV(ML) + IE = ME + DO KDUMMY=1,N + JP = IPE(IE) + LN = 0 + IF (JP.LE.0) GO TO 160 + LN = IW(JP) + 160 IPE(IE) = -IPV(N-SIZE_SCHUR+1) + JE = NV(IE) + NV(IE) = LN + 1 + IE = JE + IF (IE.EQ.0) GO TO 190 + ENDDO + 190 NV(ME) = 0 + IPE(ME) = -IPV(N-SIZE_SCHUR+1) + ENDDO + ME = IPV(N-SIZE_SCHUR+1) + IPE(ME) = 0 + NV(ME) = SIZE_SCHUR + RETURN + END SUBROUTINE ZMUMPS_199 + SUBROUTINE ZMUMPS_198(N, NZ, IRN, ICN, PERM, + & IW, LW, IPE, IQ, FLAG, + & IWFR, IFLAG, IERROR, IOVFLO, MP) + INTEGER N,NZ,LW,IWFR,IFLAG,IERROR + INTEGER PERM(N) + INTEGER IQ(N) + INTEGER IRN(NZ), ICN(NZ) + INTEGER IPE(N), IW(LW), FLAG(N) + INTEGER MP + INTEGER IOVFLO + INTEGER I,J,K,LBIG,L,ID,IN,LEN,JDUMMY,K1,K2 + IERROR = 0 + DO 10 I=1,N + IQ(I) = 0 + 10 CONTINUE + DO 80 K=1,NZ + I = IRN(K) + J = ICN(K) + IW(K) = -I + IF (I.EQ.J) GOTO 40 + IF (I.GT.J) GOTO 30 + IF (I.GE.1 .AND. J.LE.N) GO TO 60 + GO TO 50 + 30 IF (J.GE.1 .AND. I.LE.N) GO TO 60 + GO TO 50 + 40 IW(K) = 0 + IF (I.GE.1 .AND. I.LE.N) GO TO 80 + 50 IERROR = IERROR + 1 + IW(K) = 0 + IF (IERROR.LE.1 .AND. MP.GT.0) WRITE (MP,99999) + IF (IERROR.LE.10 .AND. MP.GT.0) WRITE (MP,99998) K, I, J + GO TO 80 + 60 IF (PERM(J).GT.PERM(I)) GO TO 70 + IQ(J) = IQ(J) + 1 + GO TO 80 + 70 IQ(I) = IQ(I) + 1 + 80 CONTINUE + IF (IERROR.GE.1) THEN + IF (mod(IFLAG,2) .EQ. 0) IFLAG = IFLAG+1 + ENDIF + IWFR = 1 + LBIG = 0 + DO 100 I=1,N + L = IQ(I) + LBIG = max0(L,LBIG) + IWFR = IWFR + L + IPE(I) = IWFR - 1 + 100 CONTINUE + DO 140 K=1,NZ + I = -IW(K) + IF (I.LE.0) GO TO 140 + L = K + IW(K) = 0 + DO 130 ID=1,NZ + J = ICN(L) + IF (PERM(I).LT.PERM(J)) GO TO 110 + L = IPE(J) + IPE(J) = L - 1 + IN = IW(L) + IW(L) = I + GO TO 120 + 110 L = IPE(I) + IPE(I) = L - 1 + IN = IW(L) + IW(L) = J + 120 I = -IN + IF (I.LE.0) GO TO 140 + 130 CONTINUE + 140 CONTINUE + K = IWFR - 1 + L = K + N + IWFR = L + 1 + DO 170 I=1,N + FLAG(I) = 0 + J = N + 1 - I + LEN = IQ(J) + IF (LEN.LE.0) GO TO 160 + DO 150 JDUMMY=1,LEN + IW(L) = IW(K) + K = K - 1 + L = L - 1 + 150 CONTINUE + 160 IPE(J) = L + L = L - 1 + 170 CONTINUE + IF (LBIG.GE.IOVFLO) GO TO 190 + DO 180 I=1,N + K = IPE(I) + IW(K) = IQ(I) + IF (IQ(I).EQ.0) IPE(I) = 0 + 180 CONTINUE + GO TO 230 + 190 IWFR = 1 + DO 220 I=1,N + K1 = IPE(I) + 1 + K2 = IPE(I) + IQ(I) + IF (K1.LE.K2) GO TO 200 + IPE(I) = 0 + GO TO 220 + 200 IPE(I) = IWFR + IWFR = IWFR + 1 + DO 210 K=K1,K2 + J = IW(K) + IF (FLAG(J).EQ.I) GO TO 210 + IW(IWFR) = J + IWFR = IWFR + 1 + FLAG(J) = I + 210 CONTINUE + K = IPE(I) + IW(K) = IWFR - K - 1 + 220 CONTINUE + 230 RETURN +99999 FORMAT (' *** WARNING MESSAGE FROM ZMUMPS_198 ***' ) +99998 FORMAT (I6, ' NON-ZERO (IN ROW, I6, 11H AND COLUMN ', I6, + & ') IGNORED') + END SUBROUTINE ZMUMPS_198 + SUBROUTINE ZMUMPS_194(N, IPE, IW, LW, IWFR,NCMPA) + INTEGER N,LW,IWFR,NCMPA + INTEGER IPE(N) + INTEGER IW(LW) + INTEGER I,K1,LWFR,IR,K,K2 + NCMPA = NCMPA + 1 + DO 10 I=1,N + K1 = IPE(I) + IF (K1.LE.0) GO TO 10 + IPE(I) = IW(K1) + IW(K1) = -I + 10 CONTINUE + IWFR = 1 + LWFR = IWFR + DO 60 IR=1,N + IF (LWFR.GT.LW) GO TO 70 + DO 20 K=LWFR,LW + IF (IW(K).LT.0) GO TO 30 + 20 CONTINUE + GO TO 70 + 30 I = -IW(K) + IW(IWFR) = IPE(I) + IPE(I) = IWFR + K1 = K + 1 + K2 = K + IW(IWFR) + IWFR = IWFR + 1 + IF (K1.GT.K2) GO TO 50 + DO 40 K=K1,K2 + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + 40 CONTINUE + 50 LWFR = K2 + 1 + 60 CONTINUE + 70 RETURN + END SUBROUTINE ZMUMPS_194 +#if defined(OLDDFS) + SUBROUTINE ZMUMPS_200(N, IPE, NV, IPS, NE, NA, NFSIZ, + & NSTEPS, + & FILS, FRERE,NDD,NEMIN, KEEP60) + INTEGER N,NSTEPS + INTEGER NDD(N) + INTEGER FILS(N), FRERE(N) + INTEGER IPS(N), NE(N), NA(N), NFSIZ(N) + INTEGER IPE(N), NV(N) + INTEGER NEMIN, KEEP60 + INTEGER I,IF,IS,NR,NR1,INS,INL,INB,INF,INFS,INSW + INTEGER K,L,ISON,IN,INP,IFSON,INC,INO + INTEGER INOS,IB,IL + DO 10 I=1,N + IPS(I) = 0 + NE(I) = 0 + 10 CONTINUE + DO 20 I=1,N + IF (NV(I).GT.0) GO TO 20 + IF = -IPE(I) + IS = -IPS(IF) + IF (IS.GT.0) IPE(I) = IS + IPS(IF) = -I + 20 CONTINUE + NR = N + 1 + DO 50 I=1,N + IF (NV(I).LE.0) GO TO 50 + IF = -IPE(I) + IF (IF.NE.0) THEN + IS = -IPS(IF) + IF (IS.GT.0) IPE(I) = IS + IPS(IF) = -I + ELSE + NR = NR - 1 + NE(NR) = I + ENDIF + 50 CONTINUE + DO 999 I=1,N + FILS(I) = IPS(I) + 999 CONTINUE + NR1 = NR + INS = 0 + 1000 IF (NR1.GT.N) GO TO 1151 + INS = NE(NR1) + NR1 = NR1 + 1 + 1070 INL = FILS(INS) + IF (INL.LT.0) THEN + INS = -INL + GO TO 1070 + ENDIF + 1080 IF (IPE(INS).LT.0) THEN + INS = -IPE(INS) + FILS(INS) = 0 + GO TO 1080 + ENDIF + IF (IPE(INS).EQ.0) THEN + INS = 0 + GO TO 1000 + ENDIF + INB = IPE(INS) + IF (NV(INB).EQ.0) THEN + INS = INB + GO TO 1070 + ENDIF + IF (NV(INB).GE.NV(INS)) THEN + INS = INB + GO TO 1070 + ENDIF + INF = INB + 1090 INF = IPE(INF) + IF (INF.GT.0) GO TO 1090 + INF = -INF + INFS = -FILS(INF) + IF (INFS.EQ.INS) THEN + FILS(INF) = -INB + IPS(INF) = -INB + IPE(INS) = IPE(INB) + IPE(INB) = INS + INS = INB + GO TO 1070 + ENDIF + INSW = INFS + 1100 INFS = IPE(INSW) + IF (INFS.NE.INS) THEN + INSW = INFS + GO TO 1100 + ENDIF + IPE(INS) = IPE(INB) + IPE(INB) = INS + IPE(INSW)= INB + INS =INB + GO TO 1070 + 1151 CONTINUE + DO 51 I=1,N + FRERE(I) = IPE(I) + FILS(I) = IPS(I) + 51 CONTINUE + IS = 1 + I = 0 + IL = 0 + DO 160 K=1,N + IF (I.GT.0) GO TO 60 + I = NE(NR) + NE(NR) = 0 + NR = NR + 1 + IL = N + NA(N) = 0 + 60 DO 70 L=1,N + IF (IPS(I).GE.0) GO TO 80 + ISON = -IPS(I) + IPS(I) = 0 + I = ISON + IL = IL - 1 + NA(IL) = 0 + 70 CONTINUE + 80 IPS(I) = K + NE(IS) = NE(IS) + 1 + IF (NV(I).GT.0) GO TO 89 + IN = I + 81 IN = FRERE(IN) + IF (IN.GT.0) GO TO 81 + IF = -IN + IN = IF + 82 INL = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 82 + IFSON = -IN + FILS(INL) = I + IN = I + 83 INP = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 83 + IF (IFSON .EQ. I) GO TO 86 + FILS(INP) = -IFSON + IN = IFSON + 84 INC =IN + IN = FRERE(IN) + IF (IN.NE.I) GO TO 84 + FRERE(INC) = FRERE(I) + GO TO 120 + 86 IF (FRERE(I).LT.0) FILS(INP) = 0 + IF (FRERE(I).GT.0) FILS(INP) = -FRERE(I) + GO TO 120 + 89 IF (IL.LT.N) NA(IL+1) = NA(IL+1) + 1 + NA(IS) = NA(IL) + NDD(IS) = NV(I) + NFSIZ(I) = NV(I) + IF (NA(IS).LT.1) GO TO 110 + IF ( (KEEP60.NE.0).AND. + & (NE(IS).EQ.NDD(IS)) ) GOTO 110 + IF (NDD(IS-1)-NE(IS-1).EQ.NDD(IS)) GO TO 100 + IF ((NE(IS-1).GE.NEMIN).AND. + & (NE(IS).GE.NEMIN) ) GO TO 110 + IF (2*NE(IS-1)*(NDD(IS)-NDD(IS-1)+NE(IS-1)).GE. + & ((NDD(IS)+NE(IS-1))* + & (NDD(IS)+NE(IS-1))*NEMIN/100)) GO TO 110 + 100 NA(IS-1) = NA(IS-1) + NA(IS) - 1 + NDD(IS-1) = NDD(IS) + NE(IS-1) + NE(IS-1) = NE(IS) + NE(IS-1) + NE(IS) = 0 + IN=I + 101 INL = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 101 + IFSON = -IN + IN = IFSON + 102 INO = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 102 + FILS(INL) = INO + NFSIZ(I) = NDD(IS-1) + IN = INO + 103 INP = IN + IN = FILS(IN) + IF (IN.GT.0) GO TO 103 + INOS = -IN + IF (IFSON.EQ.INO) GO TO 107 + IN = IFSON + FILS(INP) = -IFSON + 105 INS = IN + IN = FRERE(IN) + IF (IN.NE.INO) GO TO 105 + IF (INOS.EQ.0) FRERE(INS) = -I + IF (INOS.NE.0) FRERE(INS) = INOS + IF (INOS.EQ.0) GO TO 109 + 107 IN = INOS + IF (IN.EQ.0) GO TO 109 + 108 INT = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 108 + FRERE(INT) = -I + 109 CONTINUE + GO TO 120 + 110 IS = IS + 1 + 120 IB = IPE(I) + IF (IB.LT.0) GOTO 150 + IF (IB.EQ.0) GOTO 140 + NA(IL) = 0 + 140 I = IB + GO TO 160 + 150 I = -IB + IL = IL + 1 + 160 CONTINUE + NSTEPS = IS - 1 + DO 170 I=1,N + K = FILS(I) + IF (K.GT.0) THEN + FRERE(K) = N + 1 + NFSIZ(K) = 0 + ENDIF + 170 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_200 +#else + SUBROUTINE ZMUMPS_557(N, IPE, NV, IPS, NE, NA, NFSIZ, + & NODE, NSTEPS, + & FILS, FRERE, ND, NEMIN, SUBORD, KEEP60, + & KEEP20, KEEP38, NAMALG,NAMALGMAX, + & CUMUL,KEEP50, ICNTL13, KEEP37, NSLAVES, + & ALLOW_AMALG_TINY_NODES) + IMPLICIT NONE + INTEGER N, NSTEPS, KEEP60, KEEP20, KEEP38, KEEP50 + INTEGER ND(N), NFSIZ(N) + INTEGER IPE(N), FILS(N), FRERE(N), SUBORD(N) + INTEGER NV(N), IPS(N), NE(N), NA(N), NODE(N) + INTEGER NEMIN,AMALG_COUNT + INTEGER NAMALG(N),NAMALGMAX, CUMUL(N) + DOUBLE PRECISION ACCU, FLOPS_FATHER, FLOPS_SON, + & FLOPS_AVANT, FLOPS_APRES + INTEGER ICNTL13, KEEP37, NSLAVES + LOGICAL ALLOW_AMALG_TINY_NODES +#if defined(NOAMALGTOFATHER) +#else +#endif + INTEGER I,IF,IS,NR,INS + INTEGER K,L,ISON,IN,IFSON,INO + INTEGER INOS,IB,IL + INTEGER IPERM +#if defined(NOAMALGTOFATHER) + INTEGER INB,INF,INFS,INL,INSW,INT,NR1 +#else + INTEGER DADI + LOGICAL AMALG_TO_father_OK +#endif + AMALG_COUNT = 0 + DO 10 I=1,N + CUMUL(I)= 0 + IPS(I) = 0 + NE(I) = 0 + NODE(I) = 1 + SUBORD(I) = 0 + NAMALG(I) = 0 + 10 CONTINUE + FRERE(1:N) = IPE(1:N) + NR = N + 1 + DO 50 I=1,N + IF = -FRERE(I) + IF (NV(I).EQ.0) THEN + IF (SUBORD(IF).NE.0) SUBORD(I) = SUBORD(IF) + SUBORD(IF) = I + NODE(IF) = NODE(IF)+1 + ELSE + IF (IF.NE.0) THEN + IS = -IPS(IF) + IF (IS.GT.0) FRERE(I) = IS + IPS(IF) = -I + ELSE + NR = NR - 1 + NE(NR) = I + ENDIF + ENDIF + 50 CONTINUE +#if defined(NOAMALGTOFATHER) + DO 999 I=1,N + FILS(I) = IPS(I) + 999 CONTINUE + NR1 = NR + INS = 0 + 1000 IF (NR1.GT.N) GO TO 1151 + INS = NE(NR1) + NR1 = NR1 + 1 + 1070 INL = FILS(INS) + IF (INL.LT.0) THEN + INS = -INL + GO TO 1070 + ENDIF + 1080 IF (FRERE(INS).LT.0) THEN + INS = -FRERE(INS) + FILS(INS) = 0 + GO TO 1080 + ENDIF + IF (FRERE(INS).EQ.0) THEN + INS = 0 + GO TO 1000 + ENDIF + INB = FRERE(INS) + IF (NV(INB).GE.NV(INS)) THEN + INS = INB + GO TO 1070 + ENDIF + INF = INB + 1090 INF = FRERE(INF) + IF (INF.GT.0) GO TO 1090 + INF = -INF + INFS = -FILS(INF) + IF (INFS.EQ.INS) THEN + FILS(INF) = -INB + IPS(INF) = -INB + FRERE(INS) = FRERE(INB) + FRERE(INB) = INS + ELSE + INSW = INFS + 1100 INFS = FRERE(INSW) + IF (INFS.NE.INS) THEN + INSW = INFS + GO TO 1100 + ENDIF + FRERE(INS) = FRERE(INB) + FRERE(INB) = INS + FRERE(INSW)= INB + ENDIF + INS = INB + GO TO 1070 +#endif + DO 51 I=1,N + FILS(I) = IPS(I) + 51 CONTINUE + IS = 1 + I = 0 + IPERM = 1 + DO 160 K=1,N + AMALG_TO_father_OK=.FALSE. + IF (I.LE.0) THEN + IF (NR.GT.N) EXIT + I = NE(NR) + NE(NR) = 0 + NR = NR + 1 + IL = N + NA(N) = 0 + ENDIF + DO 70 L=1,N + IF (IPS(I).GE.0) EXIT + ISON = -IPS(I) + IPS(I) = 0 + I = ISON + IL = IL - 1 + NA(IL) = 0 + 70 CONTINUE +#if ! defined(NOAMALGTOFATHER) + DADI = -IPE(I) + IF ( (DADI.NE.0) .AND. + & ( + & (KEEP60.EQ.0).OR. + & ( (KEEP20.NE.DADI).AND.(KEEP38.NE.DADI) ) + & ) + & ) THEN + ACCU = + & ( dble(20000)* + & dble(NODE(I))*dble(NV(DADI)-NV(I)+NODE(I)) + & ) + & / + & ( dble(NV(DADI)+NODE(I))* + & dble(NV(DADI)+NODE(I)) ) + ACCU = ACCU + dble(CUMUL(I) ) + AMALG_TO_father_OK = ( (NODE(I).LE.NEMIN).OR. + & (NODE(DADI).LE.NEMIN) ) + AMALG_TO_father_OK = ( AMALG_TO_father_OK .AND. + & ( + & ( dble(2*(NODE(I)))* + & dble((NV(DADI)-NV(I)+NODE(I))) + & ) .LT. + & ( dble(NV(DADI)+NODE(I))* + & dble(NV(DADI)+NODE(I))*dble(NEMIN)/dble(100) + & ) + & ) ) + AMALG_TO_father_OK = ( AMALG_TO_father_OK .AND. + & ( ACCU .LE. dble(NEMIN)*dble(100) ) + & ) + IF (AMALG_TO_father_OK) THEN + CALL MUMPS_511(NV(I),NODE(I),NODE(I), + & KEEP50,1,FLOPS_SON) + CALL MUMPS_511(NV(DADI),NODE(DADI), + & NODE(DADI), + & KEEP50,1,FLOPS_FATHER) + FLOPS_AVANT = FLOPS_FATHER+FLOPS_SON + & + max(dble(200.0) * dble(NV(I)-NODE(I)) + & * dble(NV(I)-NODE(I)), + & dble(10000.0)) + CALL MUMPS_511(NV(DADI)+NODE(I), + & NODE(DADI)+NODE(I), + & NODE(DADI)+NODE(I), + & KEEP50,1,FLOPS_APRES) + IF(FLOPS_APRES .GT. FLOPS_AVANT) THEN + AMALG_TO_father_OK = .FALSE. + ENDIF + ENDIF + IF ( (NV(I).GT. 50*NV(DADI)).AND. (NSLAVES.GT.1) + & .AND. (ICNTL13.LE.0) + & .AND. (NV(I).GT. KEEP37) ) THEN + AMALG_TO_father_OK = .TRUE. + ENDIF + IF ( ALLOW_AMALG_TINY_NODES .AND. + & NODE(I) * 900 .LE. NV(DADI) - NAMALG(DADI)) THEN + IF ( NAMALG(DADI) < (NV(DADI)-NAMALG(DADI))/50 ) THEN + AMALG_TO_father_OK = .TRUE. + NAMALG(DADI) = NAMALG(DADI) + NODE(I) + ENDIF + ENDIF + AMALG_TO_father_OK = ( AMALG_TO_father_OK .OR. + & ( NV(I)-NODE(I).EQ.NV(DADI)) ) + IF (AMALG_TO_father_OK) THEN + CUMUL(DADI)=CUMUL(DADI)+nint(ACCU) + NAMALG(DADI) = NAMALG(DADI) + NAMALG(I) + AMALG_COUNT = AMALG_COUNT+1 + IN = DADI + 75 IF (SUBORD(IN).EQ.0) GOTO 76 + IN = SUBORD(IN) + GOTO 75 + 76 CONTINUE + SUBORD(IN) = I + NV(I) = 0 + IFSON = -FILS(DADI) + IF (IFSON.EQ.I) THEN + IF (FILS(I).LT.0) THEN + FILS(DADI) = FILS(I) + GOTO 78 + ELSE + IF (FRERE(I).GT.0) THEN + FILS(DADI) = -FRERE(I) + ELSE + FILS(DADI) = 0 + ENDIF + GOTO 90 + ENDIF + ENDIF + IN = IFSON + 77 INS = IN + IN = FRERE(IN) + IF (IN.NE.I) GOTO 77 + IF (FILS(I) .LT.0) THEN + FRERE(INS) = -FILS(I) + ELSE + FRERE(INS) = FRERE(I) + GOTO 90 + ENDIF + 78 CONTINUE + IN = -FILS(I) + 79 INO = IN + IN = FRERE(IN) + IF (IN.GT.0) GOTO 79 + FRERE(INO) = FRERE(I) + 90 CONTINUE + NODE(DADI) = NODE(DADI)+ NODE(I) + NV(DADI) = NV(DADI) + NODE(I) + NA(IL+1) = NA(IL+1) + NA(IL) + GOTO 120 + ENDIF + ENDIF +#endif + NE(IS) = NE(IS) + NODE(I) + IF (IL.LT.N) NA(IL+1) = NA(IL+1) + 1 + NA(IS) = NA(IL) + ND(IS) = NV(I) + NODE(I) = IS + IPS(I) = IPERM + IPERM = IPERM + 1 + IN = I + 777 IF (SUBORD(IN).EQ.0) GO TO 778 + IN = SUBORD(IN) + NODE(IN) = IS + IPS(IN) = IPERM + IPERM = IPERM + 1 + GO TO 777 + 778 IF (NA(IS).LE.0) GO TO 110 +#if defined(NOAMALGTOFATHER) + IF ( (KEEP60.NE.0).AND. + & (NE(IS).EQ.ND(IS)) ) GOTO 110 + IF (ND(IS-1)-NE(IS-1).EQ.ND(IS)) THEN + GO TO 100 + ENDIF + IF(NAMALG(IS-1) .GE. NAMALGMAX) THEN + GOTO 110 + ENDIF + IF ((NE(IS-1).GE.NEMIN).AND. + & (NE(IS).GE.NEMIN) ) GO TO 110 + IF (2*NE(IS-1)*(ND(IS)-ND(IS-1)+NE(IS-1)).GE. + & ((ND(IS)+NE(IS-1))* + & (ND(IS)+NE(IS-1))*NEMIN/100)) GO TO 110 + NAMALG(IS-1) = NAMALG(IS-1)+1 + 100 NA(IS-1) = NA(IS-1) + NA(IS) - 1 + ND(IS-1) = ND(IS) + NE(IS-1) + NE(IS-1) = NE(IS) + NE(IS-1) + NE(IS) = 0 + NODE(I) = IS-1 + IFSON = -FILS(I) + IN = IFSON + 102 INO = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 102 + NV(INO) = 0 + IN = I + 888 IF (SUBORD(IN).EQ.0) GO TO 889 + IN = SUBORD(IN) + GO TO 888 + 889 SUBORD(IN) = INO + INOS = -FILS(INO) + IF (IFSON.EQ.INO) THEN + FILS(I) = -INOS + GO TO 107 + ENDIF + IN = IFSON + 105 INS = IN + IN = FRERE(IN) + IF (IN.NE.INO) GO TO 105 + IF (INOS.EQ.0) THEN + FRERE(INS) = -I + GO TO 120 + ELSE + FRERE(INS) = INOS + ENDIF + 107 IN = INOS + IF (IN.EQ.0) GO TO 120 + 108 INT = IN + IN = FRERE(IN) + IF (IN.GT.0) GO TO 108 + FRERE(INT) = -I + GO TO 120 +#endif + 110 IS = IS + 1 + 120 IB = FRERE(I) + IF (IB.GE.0) THEN + IF (IB.GT.0) NA(IL) = 0 + I = IB + ELSE + I = -IB + IL = IL + 1 + ENDIF + 160 CONTINUE + NSTEPS = IS - 1 + DO I=1, N + IF (NV(I).EQ.0) THEN + FRERE(I) = N+1 + NFSIZ(I) = 0 + ELSE + NFSIZ(I) = ND(NODE(I)) + IF (SUBORD(I) .NE.0) THEN + INOS = -FILS(I) + INO = I + DO WHILE (SUBORD(INO).NE.0) + IS = SUBORD(INO) + FILS(INO) = IS + INO = IS + END DO + FILS(INO) = -INOS + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_557 +#endif + SUBROUTINE ZMUMPS_201(NE, ND, NSTEPS, + & MAXFR, MAXELIM, K50, MAXFAC, MAXNPIV, + & K5,K6,PANEL_SIZE,K253) + IMPLICIT NONE + INTEGER NSTEPS,MAXNPIV + INTEGER MAXFR, MAXELIM, K50, MAXFAC + INTEGER K5,K6,PANEL_SIZE,K253 + INTEGER NE(NSTEPS), ND(NSTEPS) + INTEGER ITREE, NFR, NELIM + INTEGER LKJIB + LKJIB = max(K5,K6) + MAXFR = 0 + MAXFAC = 0 + MAXELIM = 0 + MAXNPIV = 0 + PANEL_SIZE = 0 + DO ITREE=1,NSTEPS + NELIM = NE(ITREE) + NFR = ND(ITREE) + K253 + IF (NFR.GT.MAXFR) MAXFR = NFR + IF (NFR-NELIM.GT.MAXELIM) MAXELIM = NFR - NELIM + IF (NELIM .GT. MAXNPIV) THEN + IF(NFR .NE. NELIM) MAXNPIV = NELIM + ENDIF + IF (K50.EQ.0) THEN + MAXFAC = max(MAXFAC, (2*NFR - NELIM)*NELIM ) + PANEL_SIZE = max(PANEL_SIZE, NFR*(LKJIB+1)) + ELSE + MAXFAC = max(MAXFAC, NFR * NELIM) + PANEL_SIZE = max(PANEL_SIZE, NELIM*(LKJIB+1)) + PANEL_SIZE = max(PANEL_SIZE, (NFR-NELIM)*(LKJIB+1)) + ENDIF + END DO + RETURN + END SUBROUTINE ZMUMPS_201 + SUBROUTINE ZMUMPS_348( N, FILS, FRERE, + & NSTK, NA ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: N + INTEGER, INTENT(IN) :: FILS(N), FRERE(N) + INTEGER, INTENT(INOUT) :: NSTK(N), NA(N) + INTEGER NBROOT, NBLEAF, ILEAF, I, IN, ISON + NA = 0 + NSTK = 0 + NBROOT = 0 + ILEAF = 1 + DO 11 I=1,N + IF (FRERE(I).EQ. N+1) CYCLE + IF (FRERE(I).EQ.0) NBROOT = NBROOT + 1 + IN = I + 12 IN = FILS(IN) + IF (IN.GT.0) GO TO 12 + IF (IN.EQ.0) THEN + NA(ILEAF) = I + ILEAF = ILEAF + 1 + CYCLE + ENDIF + ISON = -IN + 13 NSTK(I) = NSTK(I) + 1 + ISON = FRERE(ISON) + IF (ISON.GT.0) GO TO 13 + 11 CONTINUE + NBLEAF = ILEAF-1 + IF (N.GT.1) THEN + IF (NBLEAF.GT.N-2) THEN + IF (NBLEAF.EQ.N-1) THEN + NA(N-1) = -NA(N-1)-1 + NA(N) = NBROOT + ELSE + NA(N) = -NA(N)-1 + ENDIF + ELSE + NA(N-1) = NBLEAF + NA(N) = NBROOT + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_348 + SUBROUTINE ZMUMPS_203( N, NZ, MTRANS, PERM, + & id, ICNTL, INFO) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (ZMUMPS_STRUC) :: id + INTEGER N, NZ, LIWG + INTEGER PERM(N) + INTEGER MTRANS + INTEGER ICNTL(40), INFO(40) + INTEGER allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: IW + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: S2 + TARGET :: S2 + INTEGER LS2,LSC + INTEGER ICNTL64(10), INFO64(10) + INTEGER ICNTL_SYM_MWM(10),INFO_SYM_MWM(10) + DOUBLE PRECISION CNTL64(10) + INTEGER LDW, LDWMIN + INTEGER MPRINT,LP, MP, IPIW, LIW, LIWMIN + INTEGER JPERM + INTEGER NUMNZ, I, J, JPOS, K, NZREAL + INTEGER PLENR, IP, IRNW,RSPOS,CSPOS + LOGICAL PROK, IDENT, DUPPLI + INTEGER NZTOT, K50, KER_SIZE, NZER_DIAG, MTRANSLOC,RZ_DIAG + LOGICAL SCALINGLOC + INTEGER,POINTER,DIMENSION(:) :: ZERODIAG + INTEGER,POINTER,DIMENSION(:) :: STR_KER + INTEGER,POINTER,DIMENSION(:) :: MARKED + INTEGER,POINTER,DIMENSION(:) :: FLAG + INTEGER,POINTER,DIMENSION(:) :: PIV_OUT + DOUBLE PRECISION THEMIN, THEMAX, COLNORM,MAXDBL + DOUBLE PRECISION ZERO,TWO,ONE + PARAMETER(ZERO = 0.0D0,TWO = 2.0D0,ONE = 1.0D0) + MPRINT = ICNTL(3) + LP = ICNTL(1) + MP = ICNTL(2) + PROK = (MPRINT.GT.0) + IF (PROK) WRITE(MPRINT,101) + 101 FORMAT(/'****** Preprocessing of original matrix '/) + K50 = id%KEEP(50) + SCALINGLOC = .FALSE. + IF(id%KEEP(52) .EQ. -2) THEN + IF(.not.associated(id%A)) THEN + INFO(1) = -22 + INFO(2) = 4 + GOTO 500 + ELSE + SCALINGLOC = .TRUE. + ENDIF + ELSE IF(id%KEEP(52) .EQ. 77) THEN + SCALINGLOC = .TRUE. + IF(K50 .NE. 2) THEN + IF( MTRANS .NE. 5 .AND. MTRANS .NE. 6 + & .AND. MTRANS .NE. 7) THEN + SCALINGLOC = .FALSE. + IF (PROK) + & WRITE(MPRINT,*) 'Analysis: auto scaling set OFF' + ENDIF + ENDIF + IF(.not.associated(id%A)) THEN + SCALINGLOC = .FALSE. + IF (PROK) + & WRITE(MPRINT,*) 'Analysis: auto scaling set OFF' + ENDIF + ENDIF + IF(SCALINGLOC) THEN + IF (PROK) WRITE(MPRINT,*) + & 'Scaling will be computed during analysis' + ENDIF + MTRANSLOC = MTRANS + IF (MTRANS.LT.0 .OR. MTRANS.GT.7) GO TO 500 + IF (K50 .EQ. 0) THEN + IF(.NOT. SCALINGLOC .AND. MTRANS .EQ. 7) THEN + GO TO 500 + ENDIF + IF(SCALINGLOC) THEN + MTRANSLOC = 5 + ENDIF + ELSE + IF (MTRANS .EQ. 7) MTRANSLOC = 5 + ENDIF + IF(SCALINGLOC .AND. MTRANSLOC .NE. 5 .AND. + & MTRANSLOC .NE. 6 ) THEN + IF (PROK) WRITE(MPRINT,*) + & 'WARNING scaling required: set MTRANS option to 5' + MTRANSLOC = 5 + ENDIF + IF (N.EQ.1) THEN + MTRANS=0 + GO TO 500 + ENDIF + IF(K50 .EQ. 2) THEN + NZTOT = 2*NZ+N + ELSE + NZTOT = NZ + ENDIF + ZERODIAG => id%IS1(N+1:2*N) + STR_KER => id%IS1(2*N+1:3*N) + CALL ZMUMPS_448(ICNTL64,CNTL64) + ICNTL64(1) = ICNTL(1) + ICNTL64(2) = ICNTL(2) + ICNTL64(3) = ICNTL(2) + ICNTL64(4) = -1 + IF (ICNTL(4).EQ.3) ICNTL64(4) = 0 + IF (ICNTL(4).EQ.4) ICNTL64(4) = 1 + ICNTL64(5) = -1 + IF (PROK) THEN + WRITE(MPRINT,'(A,I3)') + & 'Compute maximum matching (Maximum Transversal):', + & MTRANSLOC + IF (MTRANSLOC.EQ.1) + & WRITE(MPRINT,'(A,I3)')' ... JOB =',MTRANSLOC + IF (MTRANSLOC.EQ.2) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC,': BOTTLENECK THESIS' + IF (MTRANSLOC.EQ.3) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC,': BOTTLENECK SIMAX' + IF (MTRANSLOC.EQ.4) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC,': MAXIMIZE SUM DIAGIONAL' + IF (MTRANSLOC.EQ.5 .OR. MTRANSLOC.EQ.6) + & WRITE(MPRINT,'(A,I3,A)') + & ' ... JOB =',MTRANSLOC, + & ': MAXIMIZE PRODUCT DIAGONAL AND SCALE' + ENDIF + id%INFOG(23) = MTRANSLOC + CNTL64(2) = huge(CNTL64(2)) + IRNW = 1 + IP = IRNW + NZTOT + PLENR = IP + N + 1 + IPIW = PLENR + IF (MTRANSLOC.EQ.1) LIWMIN = 5*N + IF (MTRANSLOC.EQ.2) LIWMIN = 4*N + IF (MTRANSLOC.EQ.3) LIWMIN = 10*N + NZTOT + IF (MTRANSLOC.EQ.4) LIWMIN = 5*N + IF (MTRANSLOC.EQ.5) LIWMIN = 5*N + IF (MTRANSLOC.EQ.6) LIWMIN = 5*N + NZTOT + LIW = LIWMIN + LIWG = LIW + (NZTOT + N + 1) + ALLOCATE(IW(LIWG), stat=allocok) + IF (allocok .GT. 0 ) GOTO 410 + IF (MTRANSLOC.EQ.1) THEN + LDWMIN = N+3 + ENDIF + IF (MTRANSLOC.EQ.2) LDWMIN = max(N+NZTOT,N+3) + IF (MTRANSLOC.EQ.3) LDWMIN = max(NZTOT+1,N+3) + IF (MTRANSLOC.EQ.4) LDWMIN = 2*N + max(NZTOT,N+3) + IF (MTRANSLOC.EQ.5) LDWMIN = 3*N + NZTOT + IF (MTRANSLOC.EQ.6) LDWMIN = 4*N + NZTOT + LDW = LDWMIN + ALLOCATE(S2(LDW), stat=allocok) + IF(MTRANSLOC .NE. 1) LDW = LDW-NZTOT + RSPOS = NZTOT + CSPOS = RSPOS+N + IF (allocok .GT. 0 ) GOTO 430 + NZREAL = 0 + DO 5 J=1,N + IW(PLENR+J-1) = 0 + 5 CONTINUE + IF(K50 .EQ. 0) THEN + DO 10 K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1).AND. + & (I.LE.N).AND.(I.GE.1) ) THEN + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + NZREAL = NZREAL + 1 + ENDIF + 10 CONTINUE + ELSE + ZERODIAG = 0 + NZER_DIAG = N + RZ_DIAG = 0 + DO K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1).AND. + & (I.LE.N).AND.(I.GE.1) ) THEN + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + NZREAL = NZREAL + 1 + IF(I .NE. J) THEN + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + NZREAL = NZREAL + 1 + ELSE + IF(ZERODIAG(I) .EQ. 0) THEN + ZERODIAG(I) = K + IF(associated(id%A)) THEN + IF(abs(id%A(K)) .EQ. dble(0.0D0)) THEN + RZ_DIAG = RZ_DIAG + 1 + ENDIF + ENDIF + NZER_DIAG = NZER_DIAG - 1 + ENDIF + ENDIF + ENDIF + ENDDO + IF(MTRANSLOC .GE. 4) THEN + DO I =1, N + IF(ZERODIAG(I) .EQ. 0) THEN + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + NZREAL = NZREAL + 1 + ENDIF + ENDDO + ENDIF + ENDIF + IW(IP) = 1 + DO 20 J=1,N + IW(IP+J) = IW(IP+J-1)+IW(PLENR+J-1) + 20 CONTINUE + DO 25 J=1, N + IW(PLENR+J-1 ) = IW(IP+J-1 ) + 25 CONTINUE + IF(K50 .EQ. 0) THEN + IF (MTRANSLOC.EQ.1) THEN + DO 30 K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + ENDIF + 30 CONTINUE + ELSE + IF ( .not.associated(id%A)) THEN + INFO(1) = -22 + INFO(2) = 4 + GOTO 500 + ENDIF + DO 35 K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + S2(JPOS) = abs(id%A(K)) + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + ENDIF + 35 CONTINUE + ENDIF + ELSE + IF (MTRANSLOC.EQ.1) THEN + DO K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + IF(I.NE.J) THEN + JPOS = IW(PLENR+I-1) + IW(IRNW+JPOS-1) = J + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + ENDIF + ENDIF + ENDDO + ELSE + IF ( .not.associated(id%A)) THEN + INFO(1) = -22 + INFO(2) = 4 + GOTO 500 + ENDIF + K = 1 + THEMIN = ZERO + DO + IF(THEMIN .NE. ZERO) EXIT + THEMIN = abs(id%A(K)) + K = K+1 + ENDDO + THEMAX = THEMIN + DO K=1,NZ + I = id%IRN(K) + J = id%JCN(K) + IF ( (J.LE.N).AND.(J.GE.1) .AND. + & (I.LE.N).AND.(I.GE.1)) THEN + JPOS = IW(PLENR+J-1) + IW(IRNW+JPOS-1) = I + S2(JPOS) = abs(id%A(K)) + IW(PLENR+J-1) = IW(PLENR+J-1) + 1 + IF(abs(id%A(K)) .GT. THEMAX) THEN + THEMAX = abs(id%A(K)) + ELSE IF(abs(id%A(K)) .LT. THEMIN + & .AND. abs(id%A(K)).GT. ZERO) THEN + THEMIN = abs(id%A(K)) + ENDIF + IF(I.NE.J) THEN + JPOS = IW(PLENR+I-1) + IW(IRNW+JPOS-1) = J + S2(JPOS) = abs(id%A(K)) + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + ENDIF + ENDIF + ENDDO + DO I =1, N + IF(ZERODIAG(I) .EQ. 0) THEN + JPOS = IW(PLENR+I-1) + IW(IRNW+JPOS-1) = I + S2(JPOS) = ZERO + IW(PLENR+I-1) = IW(PLENR+I-1) + 1 + ENDIF + ENDDO + CNTL64(2) = (log(THEMAX/THEMIN))*(dble(N)) + & - log(THEMIN) + ONE + ENDIF + ENDIF + DUPPLI = .FALSE. + I = NZREAL + FLAG => id%IS1(3*N+1:4*N) + IF(MTRANSLOC.NE.1) THEN + CALL ZMUMPS_563(N,NZREAL,IW(IP),IW(IRNW),S2, + & PERM,FLAG(1)) + ELSE + CALL ZMUMPS_562(N,NZREAL,IW(IP),IW(IRNW), + & PERM,FLAG(1)) + ENDIF + IF(NZREAL .NE. I) DUPPLI = .TRUE. + LS2 = NZTOT + IF ( MTRANSLOC .EQ. 1 ) THEN + LS2 = 1 + LDW = 1 + ENDIF + CALL ZMUMPS_559(MTRANSLOC ,N, N, NZREAL, + & IW(IP), IW(IRNW), S2(1), LS2, + & NUMNZ, PERM, LIW, IW(IPIW), LDW, S2(LS2+1), + & ICNTL64, CNTL64, INFO64) + IF (INFO64(1).LT.0) THEN + IF (LP.GT.0 .AND. ICNTL(4).GE.1) + & WRITE(LP,'(A,I5)') + & ' INTERNAL ERROR in MAXTRANS INFO(1)=',INFO64(1) + INFO(1) = -9964 + INFO(2) = INFO64(1) + GO TO 500 + ENDIF + IF (INFO64(1).GT.0) THEN + IF (MP.GT.0 .AND. ICNTL(4).GE.2) + & WRITE(MP,'(A,I5)') + & ' WARNING in MAXTRANS INFO(1)=',INFO64(1) + ENDIF + KER_SIZE = 0 + IF(K50 .EQ. 2) THEN + DO I=1,N + IF(ZERODIAG(I) .EQ. 0) THEN + IF(PERM(I) .EQ. I) THEN + KER_SIZE = KER_SIZE + 1 + PERM(I) = -I + STR_KER(KER_SIZE) = I + ENDIF + ENDIF + ENDDO + ENDIF + IF (NUMNZ.LT.N) GO TO 400 + IF(K50 .EQ. 0) THEN + IDENT = .TRUE. + IF (MTRANS .EQ. 0 ) GOTO 102 + DO 80 J=1,N + JPERM = PERM(J) + IW(PLENR+JPERM-1) = J + IF (JPERM.NE.J) IDENT = .FALSE. + 80 CONTINUE + IF(IDENT) THEN + MTRANS = 0 + ELSE + IF(MTRANS .EQ. 7) THEN + MTRANS = -9876543 + GOTO 102 + ENDIF + IF (PROK) WRITE(MPRINT,'(A)') + & ' ... Apply column permutation' + DO 100 K=1,NZ + J = id%JCN(K) + IF ((J.LE.0).OR.(J.GT.N)) GO TO 100 + id%JCN(K) = IW(PLENR+J-1) + 100 CONTINUE + IF (MP.GT.0 .AND. ICNTL(4).GE.2) + & WRITE(MP,'(/A)') + & ' WARNING input matrix data modified' + ENDIF + 102 CONTINUE + IF (SCALINGLOC) THEN + IF ( associated(id%COLSCA)) + & DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) + & DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in ZMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of COLSCA' + GOTO 500 + ENDIF + ENDIF + ALLOCATE( id%ROWSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in ZMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of ROWSCA' + GOTO 500 + ENDIF + ENDIF + id%KEEP(52) = -2 + id%KEEP(74) = 1 + MAXDBL = log(huge(MAXDBL)) + DO J=1,N + IF(S2(RSPOS+J) .GT. MAXDBL) THEN + S2(RSPOS+J) = ZERO + ENDIF + IF(S2(CSPOS+J) .GT. MAXDBL) THEN + S2(CSPOS+J)= ZERO + ENDIF + ENDDO + DO 105 J=1,N + id%ROWSCA(J) = exp(S2(RSPOS+J)) + IF(id%ROWSCA(J) .EQ. ZERO) THEN + id%ROWSCA(J) = ONE + ENDIF + IF ( MTRANS .EQ. -9876543 .OR. MTRANS.EQ. 0 ) THEN + id%COLSCA(J)= exp(S2(CSPOS+J)) + IF(id%COLSCA(J) .EQ. ZERO) THEN + id%COLSCA(J) = ONE + ENDIF + ELSE + id%COLSCA(IW(PLENR+J-1))= exp(S2(CSPOS+J)) + IF(id%COLSCA(IW(PLENR+J-1)) .EQ. ZERO) THEN + id%COLSCA(IW(PLENR+J-1)) = ONE + ENDIF + ENDIF + 105 CONTINUE + ENDIF + ELSE + IDENT = .FALSE. + IF(SCALINGLOC) THEN + IF ( associated(id%COLSCA)) DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in ZMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of COLSCA' + GOTO 500 + ENDIF + ENDIF + ALLOCATE( id%ROWSCA(N), stat=allocok) + IF (allocok .GT.0) THEN + id%INFO(1)=-5 + id%INFO(2)=N + IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in ZMUMPS_203' + WRITE (LP,'(A)') + & '** Failure during allocation of ROWSCA' + GOTO 500 + ENDIF + ENDIF + id%KEEP(52) = -2 + id%KEEP(74) = 1 + MAXDBL = log(huge(MAXDBL)) + DO J=1,N + IF(S2(RSPOS+J)+S2(CSPOS+J) .GT. MAXDBL) THEN + S2(RSPOS+J) = ZERO + S2(CSPOS+J)= ZERO + ENDIF + ENDDO + DO J=1,N + IF(PERM(J) .GT. 0) THEN + id%ROWSCA(J) = + & exp((S2(RSPOS+J)+S2(CSPOS+J))/TWO) + IF(id%ROWSCA(J) .EQ. ZERO) THEN + id%ROWSCA(J) = ONE + ENDIF + id%COLSCA(J)= id%ROWSCA(J) + ENDIF + ENDDO + DO JPOS=1,KER_SIZE + I = STR_KER(JPOS) + COLNORM = ZERO + DO J = IW(IP+I-1),IW(IP+I) - 1 + IF ( PERM( IW( IRNW+J-1) ) > 0 ) THEN + COLNORM = max(COLNORM,S2(J)) + ENDIF + ENDDO + COLNORM = exp(COLNORM) + id%ROWSCA(I) = ONE / COLNORM + id%COLSCA(I) = id%ROWSCA(I) + ENDDO + ENDIF + IF(MTRANS .EQ. 7 .OR. id%KEEP(95) .EQ. 0) THEN + IF( (NZER_DIAG+RZ_DIAG) .LT. (N/10) + & .AND. id%KEEP(95) .EQ. 0) THEN + MTRANS = 0 + id%KEEP(95) = 1 + GOTO 390 + ELSE + IF(id%KEEP(95) .EQ. 0) THEN + IF(SCALINGLOC) THEN + id%KEEP(95) = 3 + ELSE + id%KEEP(95) = 2 + ENDIF + ENDIF + IF(MTRANS .EQ. 7) MTRANS = 5 + ENDIF + ENDIF + IF(MTRANS .EQ. 0) GOTO 390 + ICNTL_SYM_MWM = 0 + INFO_SYM_MWM = 0 + IF(MTRANS .EQ. 5 .OR. MTRANS .EQ. 6 .OR. + & MTRANS .EQ. 7) THEN + ICNTL_SYM_MWM(1) = 0 + ICNTL_SYM_MWM(2) = 1 + ELSE IF(MTRANS .EQ. 4) THEN + ICNTL_SYM_MWM(1) = 2 + ICNTL_SYM_MWM(2) = 1 + ELSE + ICNTL_SYM_MWM(1) = 0 + ICNTL_SYM_MWM(2) = 1 + ENDIF + MARKED => id%IS1(2*N+1:3*N) + FLAG => id%IS1(3*N+1:4*N) + PIV_OUT => id%IS1(4*N+1:5*N) + IF(MTRANSLOC .LT. 4) THEN + LSC = 1 + ELSE + LSC = 2*N + ENDIF + CALL ZMUMPS_551( + & N, NZREAL, IW(IP), IW(IRNW), S2(1),LSC, PERM, + & ZERODIAG(1), + & ICNTL_SYM_MWM, S2(LSC+1),MARKED(1),FLAG(1), + & PIV_OUT(1), INFO_SYM_MWM) + IF(INFO_SYM_MWM(1) .NE. 0) THEN + WRITE(*,*) '** Error in ZMUMPS_203' + RETURN + ENDIF + IF(INFO_SYM_MWM(3) .EQ. N) THEN + IDENT = .TRUE. + ELSEIF( (N-INFO_SYM_MWM(4)-INFO_SYM_MWM(3)) .GT. N/10 + & ) THEN + IDENT = .TRUE. + id%KEEP(95) = 1 + ELSE + DO I=1,N + PERM(I) = PIV_OUT(I) + ENDDO + ENDIF + id%KEEP(93) = INFO_SYM_MWM(4) + id%KEEP(94) = INFO_SYM_MWM(3) + IF (IDENT) MTRANS=0 + ENDIF + 390 IF(MTRANS .EQ. 0) THEN + id%KEEP(95) = 1 + IF (PROK) THEN + WRITE (MPRINT,'(A)') + & ' ... Column permutation not used' + ENDIF + ENDIF + GO TO 500 + 400 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) + & WRITE (LP,'(/A)') '** Error: Matrix is structurally singular' + INFO(1) = -6 + INFO(2) = NUMNZ + GOTO 500 + 410 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in ZMUMPS_203' + WRITE (LP,'(A,I9)') + & '** Failure during allocation of INTEGER array of size ', + & LIWG + ENDIF + INFO(1) = -5 + INFO(2) = LIWG + GOTO 500 + 430 IF ((LP.GE.0).AND.(ICNTL(4).GE.1)) THEN + WRITE (LP,'(/A)') '** Error in ZMUMPS_203' + WRITE (LP,'(A)') '** Failure during allocation of S2' + ENDIF + INFO(1) = -5 + INFO(2) = LDW + 500 CONTINUE + IF (allocated(IW)) DEALLOCATE(IW) + IF (allocated(S2)) DEALLOCATE(S2) + RETURN + END SUBROUTINE ZMUMPS_203 + SUBROUTINE ZMUMPS_100 + &( MYID, COMM, KEEP,KEEP8, INFO, INFOG, RINFO, RINFOG, ICNTL ) + IMPLICIT NONE + INTEGER COMM, MYID, KEEP(500), INFO(40), ICNTL(40), INFOG(40) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION RINFO(40), RINFOG(40) + INCLUDE 'mpif.h' + INTEGER MASTER, MPG + PARAMETER( MASTER = 0 ) + MPG = ICNTL(3) + IF ( MYID.eq.MASTER.and.MPG.GT.0) THEN + WRITE(MPG, 99992) INFO(1), INFO(2), + & KEEP8(109), KEEP8(111), INFOG(4), + & INFOG(5), KEEP(28), INFOG(32), INFOG(7), KEEP(23), ICNTL(7), + & KEEP(12), KEEP(56), KEEP(61), RINFOG(1) + IF (KEEP(95).GT.1) + & WRITE(MPG, 99993) KEEP(95) + IF (KEEP(54).GT.0) WRITE(MPG, 99994) KEEP(54) + IF (KEEP(60).GT.0) WRITE(MPG, 99995) KEEP(60) + IF (KEEP(253).GT.0) WRITE(MPG, 99996) KEEP(253) + ENDIF + RETURN +99992 FORMAT(/'Leaving analysis phase with ...'/ + & 'INFOG(1) =',I16/ + & 'INFOG(2) =',I16/ + & ' -- (20) Number of entries in factors (estim.) =',I16/ + & ' -- (3) Storage of factors (REAL, estimated) =',I16/ + & ' -- (4) Storage of factors (INT , estimated) =',I16/ + & ' -- (5) Maximum frontal size (estimated) =',I16/ + & ' -- (6) Number of nodes in the tree =',I16/ + & ' -- (32) Type of analysis effectively used =',I16/ + & ' -- (7) Ordering option effectively used =',I16/ + & 'ICNTL(6) Maximum transversal option =',I16/ + & 'ICNTL(7) Pivot order option =',I16/ + & 'Percentage of memory relaxation (effective) =',I16/ + & 'Number of level 2 nodes =',I16/ + & 'Number of split nodes =',I16/ + & 'RINFOG(1) Operations during elimination (estim)= ',1PD10.3) +99993 FORMAT('Ordering compressed/constrained (ICNTL(12)) =',I16) +99994 FORMAT('Distributed matrix entry format (ICNTL(18)) =',I16) +99995 FORMAT('Effective Schur option (ICNTL(19)) =',I16) +99996 FORMAT('Forward solution during factorization, NRHS =',I16) + END SUBROUTINE ZMUMPS_100 + SUBROUTINE ZMUMPS_97 + & ( N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, + & KEEP, KEEP8, SPLITROOT, MP, LDIAG, INFO1, INFO2 ) + IMPLICIT NONE + INTEGER N, NSTEPS, NSLAVES, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER FRERE( N ), FILS( N ), NFSIZ( N ) + LOGICAL SPLITROOT + INTEGER MP, LDIAG + INTEGER INFO1, INFO2 + INTEGER, DIMENSION(:), ALLOCATABLE :: IPOOL + INTEGER INODE, DEPTH, I, IBEG, IEND, IIPOOL, NROOT + INTEGER MAX_DEPTH, ISON, TOT_CUT, MAX_CUT, STRAT + INTEGER(8) :: K79 + INTEGER NFRONT, K82, allocok + K79 = KEEP8(79) + K82 = abs(KEEP(82)) + STRAT=KEEP(62) + IF (KEEP(210).EQ.1) THEN + MAX_DEPTH = 2*NSLAVES*K82 + STRAT = STRAT/4 + ELSE + IF (( NSLAVES .eq. 1 ).AND. (.NOT. SPLITROOT) ) RETURN + IF (NSLAVES.EQ.1) THEN + MAX_DEPTH = 1 + ELSE + MAX_DEPTH = int( log( dble( NSLAVES - 1 ) ) + & / log(2.0D0) ) + ENDIF + ENDIF + ALLOCATE(IPOOL(NSTEPS+1), stat=allocok) + IF (allocok.GT.0) THEN + INFO1= -7 + INFO2= NSTEPS+1 + RETURN + ENDIF + NROOT = 0 + DO INODE = 1, N + IF ( FRERE(INODE) .eq. 0 ) THEN + NROOT = NROOT + 1 + IPOOL( NROOT ) = INODE + END IF + END DO + IBEG = 1 + IEND = NROOT + IIPOOL = NROOT + 1 + IF (SPLITROOT) MAX_DEPTH=1 + DO DEPTH = 1, MAX_DEPTH + DO I = IBEG, IEND + INODE = IPOOL( I ) + ISON = INODE + DO WHILE ( ISON .GT. 0 ) + ISON = FILS( ISON ) + END DO + ISON = - ISON + DO WHILE ( ISON .GT. 0 ) + IPOOL( IIPOOL ) = ISON + IIPOOL = IIPOOL + 1 + ISON = FRERE( ISON ) + END DO + END DO + IPOOL( IBEG ) = -IPOOL( IBEG ) + IBEG = IEND + 1 + IEND = IIPOOL - 1 + END DO + IPOOL( IBEG ) = -IPOOL( IBEG ) + TOT_CUT = 0 + IF (SPLITROOT) THEN + MAX_CUT = NROOT*max(K82,2) + INODE = abs(IPOOL(1)) + NFRONT = NFSIZ( INODE ) + K79 = max( + & int(NFRONT,8)*int(NFRONT,8)/(int(K82+1,8)*int(K82+1,8)), + & 1_8) + ELSE + MAX_CUT = 2 * NSLAVES + IF (KEEP(210).EQ.1) THEN + MAX_CUT = 4 * (MAX_CUT + 4) + ENDIF + ENDIF + DEPTH = -1 + DO I = 1, IIPOOL - 1 + INODE = IPOOL( I ) + IF ( INODE .LT. 0 ) THEN + INODE = -INODE + DEPTH = DEPTH + 1 + END IF + CALL ZMUMPS_313 + & ( INODE, N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, + & KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, + & K79, SPLITROOT, MP, LDIAG ) + IF ( TOT_CUT > MAX_CUT ) EXIT + END DO + KEEP(61) = TOT_CUT + DEALLOCATE(IPOOL) + RETURN + END SUBROUTINE ZMUMPS_97 + RECURSIVE SUBROUTINE ZMUMPS_313 + & ( INODE, N, FRERE, FILS, NFSIZ, NSTEPS, NSLAVES, KEEP,KEEP8, + & TOT_CUT, STRAT, DEPTH, K79, SPLITROOT, MP, LDIAG ) + IMPLICIT NONE + INTEGER(8) :: K79 + INTEGER INODE, N, NSTEPS, NSLAVES, KEEP(500), STRAT, + & DEPTH, TOT_CUT, MP, LDIAG + INTEGER(8) KEEP8(150) + INTEGER FRERE( N ), FILS( N ), NFSIZ( N ) + LOGICAL SPLITROOT + INTEGER I, IN, NPIV, NFRONT, NSLAVES_ESTIM + DOUBLE PRECISION WK_SLAVE, WK_MASTER + INTEGER INODE_SON, INODE_FATH, IN_SON, IN_FATH, IN_GRANDFATH + INTEGER NPIV_SON, NPIV_FATH + INTEGER NCB, NSLAVESMIN, NSLAVESMAX + INTEGER MUMPS_50, + & MUMPS_52 + EXTERNAL MUMPS_50, + & MUMPS_52 + IF ( (KEEP(210).EQ.1.AND.KEEP(60).EQ.0) .OR. + & (SPLITROOT) ) THEN + IF ( FRERE ( INODE ) .eq. 0 ) THEN + NFRONT = NFSIZ( INODE ) + NPIV = NFRONT + NCB = 0 + IF (int(NFRONT,8)*int(NFRONT,8).GT.K79) THEN + GOTO 333 + ENDIF + ENDIF + ENDIF + IF ( FRERE ( INODE ) .eq. 0 ) RETURN + NFRONT = NFSIZ( INODE ) + IN = INODE + NPIV = 0 + DO WHILE( IN > 0 ) + IN = FILS( IN ) + NPIV = NPIV + 1 + END DO + NCB = NFRONT - NPIV + IF ( (NFRONT - (NPIV/2)) .LE. KEEP(9)) RETURN + IF ((KEEP(50) == 0.and.int(NFRONT,8) * int(NPIV,8) > K79 ) .OR. + &(KEEP(50) .NE.0.and.int(NPIV,8) * int(NPIV,8) > K79 )) GOTO 333 + IF (KEEP(210).EQ.1) THEN + NSLAVESMIN = 1 + NSLAVESMAX = 64 + NSLAVES_ESTIM = 32+NSLAVES + ELSE + NSLAVESMIN = MUMPS_50 + & ( NSLAVES, KEEP(48), KEEP8(21), KEEP(50), + & NFRONT, NCB) + NSLAVESMAX = MUMPS_52 + & ( NSLAVES, KEEP(48), KEEP8(21), KEEP(50), + & NFRONT, NCB) + NSLAVES_ESTIM = max (1, + & nint( dble(NSLAVESMAX-NSLAVESMIN)/dble(3) ) + & ) + NSLAVES_ESTIM = min (NSLAVES_ESTIM, NSLAVES-1) + ENDIF + IF ( KEEP(50) .eq. 0 ) THEN + WK_MASTER = 0.6667D0 * + & dble(NPIV)*dble(NPIV)*dble(NPIV) + + & dble(NPIV)*dble(NPIV)*dble(NCB) + WK_SLAVE = dble( NPIV ) * dble( NCB ) * + & ( 2.0D0 * dble(NFRONT) - dble(NPIV) ) + & / dble(NSLAVES_ESTIM) + ELSE + WK_MASTER = dble(NPIV)*dble(NPIV)*dble(NPIV) / dble(3) + WK_SLAVE = + & (dble(NPIV)*dble(NCB)*dble(NFRONT)) + & / dble(NSLAVES_ESTIM) + ENDIF + IF (KEEP(210).EQ.1) THEN + IF ( dble( 100 + STRAT ) + & * WK_SLAVE / dble(100) .GE. WK_MASTER ) RETURN + ELSE + IF ( dble( 100 + STRAT * max( DEPTH-1, 1 ) ) + & * WK_SLAVE / dble(100) .GE. WK_MASTER ) RETURN + ENDIF + 333 CONTINUE + IF (NPIV .LE. 1 ) RETURN + NSTEPS = NSTEPS + 1 + TOT_CUT = TOT_CUT + 1 + NPIV_SON = max(NPIV/2,1) + NPIV_FATH = NPIV - NPIV_SON + INODE_SON = INODE + IN_SON = INODE + DO I = 1, NPIV_SON - 1 + IN_SON = FILS( IN_SON ) + END DO + INODE_FATH = FILS( IN_SON ) + IF ( INODE_FATH .LT. 0 ) THEN + write(*,*) 'Error: INODE_FATH < 0 ', INODE_FATH + END IF + IN_FATH = INODE_FATH + DO WHILE ( FILS( IN_FATH ) > 0 ) + IN_FATH = FILS( IN_FATH ) + END DO + FRERE( INODE_FATH ) = FRERE( INODE_SON ) + FRERE( INODE_SON ) = - INODE_FATH + FILS ( IN_SON ) = FILS( IN_FATH ) + FILS ( IN_FATH ) = - INODE_SON + IN = FRERE( INODE_FATH ) + DO WHILE ( IN > 0 ) + IN = FRERE( IN ) + END DO + IF ( IN .eq. 0 ) GO TO 10 + IN = -IN + DO WHILE ( FILS( IN ) > 0 ) + IN = FILS( IN ) + END DO + IN_GRANDFATH = IN + IF ( FILS( IN_GRANDFATH ) .eq. - INODE_SON ) THEN + FILS( IN_GRANDFATH ) = -INODE_FATH + ELSE + IN = IN_GRANDFATH + IN = - FILS ( IN ) + DO WHILE ( FRERE( IN ) > 0 ) + IF ( FRERE( IN ) .eq. INODE_SON ) THEN + FRERE( IN ) = INODE_FATH + GOTO 10 + END IF + IN = FRERE( IN ) + END DO + WRITE(*,*) 'ERROR 2 in SPLIT NODE', + & IN_GRANDFATH, IN, FRERE(IN) + END IF + 10 CONTINUE + NFSIZ(INODE_SON) = NFRONT + NFSIZ(INODE_FATH) = NFRONT - NPIV_SON + KEEP(2) = max( KEEP(2), NFRONT - NPIV_SON ) + CALL ZMUMPS_313 + & ( INODE_FATH, N, FRERE, FILS, NFSIZ, NSTEPS, + & NSLAVES, KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, + & K79, SPLITROOT, MP, LDIAG ) + IF (.NOT. SPLITROOT) THEN + CALL ZMUMPS_313 + & ( INODE_SON, N, FRERE, FILS, NFSIZ, NSTEPS, + & NSLAVES, KEEP,KEEP8, TOT_CUT, STRAT, DEPTH, + & K79, SPLITROOT, MP, LDIAG ) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_313 + SUBROUTINE ZMUMPS_351 + & (N,NZ, IRN, ICN, IW, LW, IPE, LEN, + & IQ, FLAG, IWFR, + & NRORM, NIORM, IFLAG,IERROR, ICNTL, + & symmetry, SYM, MedDens, NBQD, AvgDens) + INTEGER N,NZ,LW,IFLAG,IERROR,NRORM,NIORM,IWFR + INTEGER symmetry, SYM + INTEGER MedDens, NBQD, AvgDens + INTEGER ICNTL(40) + INTEGER IRN(NZ), ICN(NZ) + INTEGER LEN(N) + INTEGER IPE(N+1) + INTEGER FLAG(N), IW(LW) + INTEGER IQ(N) + INTEGER MP, MPG + INTEGER I,K,J,N1,LAST,NDUP,K1,K2,L + INTEGER NBERR, THRESH + INTEGER NZOFFA, NDIAGA + DOUBLE PRECISION RSYM + INTRINSIC nint + MP = ICNTL(2) + MPG= ICNTL(3) + NIORM = 3*N + NDIAGA = 0 + IERROR = 0 + DO 10 I=1,N + IPE(I) = 0 + 10 CONTINUE + DO 50 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + IERROR = IERROR + 1 + ELSE + IF (I.NE.J) THEN + IPE(I) = IPE(I) + 1 + IPE(J) = IPE(J) + 1 + NIORM = NIORM + 1 + ELSE + NDIAGA = NDIAGA + 1 + ENDIF + ENDIF + 50 CONTINUE + NZOFFA = NIORM - 3*N + IF (IERROR.GE.1) THEN + NBERR = 0 + IF (mod(IFLAG,2) .EQ. 0) IFLAG = IFLAG+1 + IF ((MP.GT.0).AND.(ICNTL(4).GE.2)) THEN + WRITE (MP,99999) + DO 70 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + NBERR = NBERR + 1 + IF (NBERR.LE.10) THEN + IF (mod(K,10).GT.3 .OR. mod(K,10).EQ.0 .OR. + & (10.LE.K .AND. K.LE.20)) THEN + WRITE (MP,'(I8,A,I8,A,I8,A)') + & K,'th entry (in row',I,' and column',J,') ignored' + ELSE + IF (mod(K,10).EQ.1) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'st entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.2) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'nd entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.3) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'rd entry (in row',I,' and column',J,') ignored' + ENDIF + ELSE + GO TO 100 + ENDIF + ENDIF + 70 CONTINUE + ENDIF + ENDIF + 100 NRORM = NIORM - 2*N + IQ(1) = 1 + N1 = N - 1 + IF (N1.GT.0) THEN + DO 110 I=1,N1 + IQ(I+1) = IPE(I) + IQ(I) + 110 CONTINUE + ENDIF + LAST = max(IPE(N)+IQ(N)-1,IQ(N)) + FLAG(1:N) = 0 + IPE(1:N) = IQ(1:N) + IW(1:LAST) = 0 + IWFR = LAST + 1 + DO 200 K=1,NZ + I = IRN(K) + J = ICN(K) + IF (I.NE.J) THEN + IF (I.LT.J) THEN + IF ((I.GE.1).AND.(J.LE.N)) THEN + IW(IQ(I)) = -J + IQ(I) = IQ(I) + 1 + ENDIF + ELSE + IF ((J.GE.1).AND.(I.LE.N)) THEN + IW(IQ(J)) = -I + IQ(J) = IQ(J) + 1 + ENDIF + ENDIF + ENDIF + 200 CONTINUE + NDUP = 0 + DO 260 I=1,N + K1 = IPE(I) + K2 = IQ(I) -1 + IF (K1.GT.K2) THEN + LEN(I) = 0 + IQ(I) = 0 + ELSE + DO 240 K=K1,K2 + J = -IW(K) + IF (J.LE.0) GO TO 250 + L = IQ(J) + IQ(J) = L + 1 + IF (FLAG(J).EQ.I) THEN + NDUP = NDUP + 1 + IW(L) = 0 + IW(K) = 0 + ELSE + IW(L) = I + IW(K) = J + FLAG(J) = I + ENDIF + 240 CONTINUE + 250 IQ(I) = IQ(I) - IPE(I) + IF (NDUP.EQ.0) LEN(I) = IQ(I) + ENDIF + 260 CONTINUE + IF (NDUP.NE.0) THEN + IWFR = 1 + DO 280 I=1,N + IF (IQ(I).EQ.0) THEN + LEN(I) = 0 + IPE(I) = IWFR + GOTO 280 + ENDIF + K1 = IPE(I) + K2 = K1 + IQ(I) - 1 + L = IWFR + IPE(I) = IWFR + DO 270 K=K1,K2 + IF (IW(K).NE.0) THEN + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + ENDIF + 270 CONTINUE + LEN(I) = IWFR - L + 280 CONTINUE + ENDIF + IPE(N+1) = IPE(N) + LEN(N) + IWFR = IPE(N+1) + IF (SYM.EQ.0) THEN + RSYM = dble(NDIAGA+2*NZOFFA - (IWFR-1))/ + & dble(NZOFFA+NDIAGA) + symmetry = nint (100.0D0*RSYM) + IF (MPG .GT. 0) + & write(MPG,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + ELSE + symmetry = 100 + ENDIF + AvgDens = nint(dble(IWFR-1)/dble(N)) + THRESH = AvgDens*50 - AvgDens/10 + 1 + NBQD = 0 + IF (N.GT.2) THEN + IQ(1:N) = 0 + DO I= 1, N + K = max(LEN(I),1) + IQ(K) = IQ(K) + 1 + IF (K.GT.THRESH) NBQD = NBQD+1 + ENDDO + K = 0 + MedDens = 0 + DO WHILE (K .LT. (N/2)) + MedDens = MedDens + 1 + K = K+IQ(MedDens) + ENDDO + ELSE + MedDens = AvgDens + ENDIF + IF (MPG .GT. 0) + & write(MPG,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + RETURN +99999 FORMAT (/'*** Warning message from analysis routine ***') + END SUBROUTINE ZMUMPS_351 + SUBROUTINE ZMUMPS_701(N, SYM, NPROCS, IORD, + & symmetry,MedDens, NBQD, AvgDens, + & PROK, MP) + IMPLICIT NONE + INTEGER, intent(in) :: N, NPROCS, SYM + INTEGER, intent(in) :: symmetry,MedDens, NBQD, AvgDens, MP + LOGICAL, intent(in) :: PROK + INTEGER, intent(inout) :: IORD + INTEGER MAXQD + PARAMETER (MAXQD=2) + INTEGER SMALLSYM, SMALLUNS + PARAMETER (SMALLUNS=5000, SMALLSYM=10000) +#if ! defined(metis) && ! defined(parmetis) + IF ( IORD .EQ. 5 ) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: METIS not available. Ordering set to default.' + IORD = 7 + END IF +#endif +#if ! defined(pord) + IF ( IORD .EQ. 4 ) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: PORD not available. Ordering set to default.' + IORD = 7 + END IF +#endif +#if ! defined(scotch) && ! defined(ptscotch) + IF ( IORD .EQ. 3 ) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: SCOTCH not available. Ordering set to default.' + IORD = 7 + END IF +#endif + IF (IORD.EQ.7) THEN + IF (SYM.NE.0) THEN + IF ( N.LE.SMALLSYM ) THEN + IF (NBQD.GE.MAXQD) THEN + IORD = 6 + ELSE + IORD = 2 + ENDIF + ELSE + IF (NBQD.GE.MedDens*NPROCS) THEN + IORD = 6 + RETURN + ENDIF +#if defined(metis) || defined(parmetis) + IORD = 5 +#else +# if defined(scotch) || defined(ptscotch) + IORD = 3 +# else +# if defined(pord) + IORD = 4 +# else + IORD = 6 +# endif +# endif +#endif + ENDIF + ELSE + IF ( N.LE.SMALLUNS ) THEN + IF (NBQD.GE.MAXQD) THEN + IORD = 6 + ELSE + IORD = 2 + ENDIF + ELSE + IF (NBQD.GE.MedDens*NPROCS) THEN + IORD = 6 + RETURN + ENDIF +#if defined(metis) || defined(parmetis) + IORD = 5 +#else +# if defined(scotch) || defined(ptscotch) + IORD = 3 +# else +# if defined(pord) + IORD = 4 +# else + IORD = 6 +# endif +# endif +#endif + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_701 + SUBROUTINE ZMUMPS_510 + & (KEEP821, KEEP2, KEEP48 ,KEEP50, NSLAVES) + IMPLICIT NONE + INTEGER NSLAVES, KEEP2, KEEP48, KEEP50 + INTEGER (8) :: KEEP821 + INTEGER(8) KEEP2_SQUARE, NSLAVES8 + NSLAVES8= int(NSLAVES,8) + KEEP2_SQUARE = int(KEEP2,8) * int(KEEP2,8) + KEEP821 = max(KEEP821*int(KEEP2,8),1_8) +#if defined(t3e) + KEEP821 = min(1500000_8, KEEP821) +#elif defined(SP_) + KEEP821 = min(3000000_8, KEEP821) +#else + KEEP821 = min(2000000_8, KEEP821) +#endif +#if defined(t3e) + IF (NSLAVES .GT. 64) THEN + KEEP821 = + & min(8_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ELSE + KEEP821 = + & min(4_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ENDIF +#else + IF (NSLAVES.GT.64) THEN + KEEP821 = + & min(6_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ELSE + KEEP821 = + & min(4_8*KEEP2_SQUARE/NSLAVES8+1_8, KEEP821) + ENDIF +#endif + IF (KEEP50 .EQ. 0 ) THEN + KEEP821 = max(KEEP821,(7_8*KEEP2_SQUARE / + & 4_8 / int(max(NSLAVES-1,1),8)) + int(KEEP2,8)) + ELSE + KEEP821 = max(KEEP821,(7_8*KEEP2_SQUARE / + & 4_8 / int(max(NSLAVES-1,1),8)) + int(KEEP2,8)) + ENDIF + IF (KEEP50 .EQ. 0 ) THEN +#if defined(t3e) + KEEP821 = max(KEEP821,200000_8) +#else + KEEP821 = max(KEEP821,300000_8) +#endif + ELSE +#if defined(t3e) + KEEP821 = max(KEEP821,40000_8) +#else + KEEP821 = max(KEEP821,80000_8) +#endif + ENDIF + KEEP821 = -KEEP821 + RETURN + END SUBROUTINE ZMUMPS_510 + SUBROUTINE ZMUMPS_559(JOB,M,N,NE, + & IP,IRN,A,LA,NUM,PERM,LIW,IW,LDW,DW, + & ICNTL,CNTL,INFO) + IMPLICIT NONE + INTEGER NICNTL, NCNTL, NINFO + PARAMETER (NICNTL=10, NCNTL=10, NINFO=10) + INTEGER JOB,M,N,NE,NUM,LIW,LDW + INTEGER IP(N+1),IRN(NE),PERM(M),IW(LIW) + INTEGER ICNTL(NICNTL),INFO(NINFO) + INTEGER LA + DOUBLE PRECISION A(LA) + DOUBLE PRECISION DW(LDW),CNTL(NCNTL) + INTEGER I,J,K,WARN1,WARN2,WARN4 + DOUBLE PRECISION FACT,ZERO,ONE,RINF,RINF2,RINF3 + PARAMETER (ZERO=0.0D+00,ONE=1.0D+0) + EXTERNAL ZMUMPS_457,ZMUMPS_444,ZMUMPS_451, + & ZMUMPS_452,ZMUMPS_454 + INTRINSIC abs,log + RINF = CNTL(2) + RINF2 = huge(RINF2)/dble(2*N) + RINF3 = 0.0D0 + WARN1 = 0 + WARN2 = 0 + WARN4 = 0 + IF (JOB.LT.1 .OR. JOB.GT.6) THEN + INFO(1) = -1 + INFO(2) = JOB + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'JOB',JOB + GO TO 99 + ENDIF + IF (M.LT.1 .OR. M.LT.N) THEN + INFO(1) = -2 + INFO(2) = M + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'M',M + GO TO 99 + ENDIF + IF (N.LT.1) THEN + INFO(1) = -2 + INFO(2) = N + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'N',N + GO TO 99 + ENDIF + IF (NE.LT.1) THEN + INFO(1) = -3 + INFO(2) = NE + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9001) INFO(1),'NE',NE + GO TO 99 + ENDIF + IF (JOB.EQ.1) K = 4*N + M + IF (JOB.EQ.2) K = 2*N + 2*M + IF (JOB.EQ.3) K = 8*N + 2*M + NE + IF (JOB.EQ.4) K = 3*N + 2*M + IF (JOB.EQ.5) K = 3*N + 2*M + IF (JOB.EQ.6) K = 3*N + 2*M + NE + IF (LIW.LT.K) THEN + INFO(1) = -4 + INFO(2) = K + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9004) INFO(1),K + GO TO 99 + ENDIF + IF (JOB.GT.1) THEN + IF (JOB.EQ.2) K = M + IF (JOB.EQ.3) K = 1 + IF (JOB.EQ.4) K = 2*M + IF (JOB.EQ.5) K = N + 2*M + IF (JOB.EQ.6) K = N + 3*M + IF (LDW.LT.K) THEN + INFO(1) = -5 + INFO(2) = K + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9005) INFO(1),K + GO TO 99 + ENDIF + ENDIF + IF (ICNTL(5).EQ.0) THEN + DO 3 I = 1,M + IW(I) = 0 + 3 CONTINUE + DO 6 J = 1,N + DO 4 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (I.LT.1 .OR. I.GT.M) THEN + INFO(1) = -6 + INFO(2) = J + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9006) INFO(1),J,I + GO TO 99 + ENDIF + IF (IW(I).EQ.J) THEN + INFO(1) = -7 + INFO(2) = J + IF (ICNTL(1).GE.0) WRITE(ICNTL(1),9007) INFO(1),J,I + GO TO 99 + ELSE + IW(I) = J + ENDIF + 4 CONTINUE + 6 CONTINUE + ENDIF + IF (ICNTL(3).GE.0) THEN + IF (ICNTL(4).EQ.0 .OR. ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9020) JOB,M,N,NE + IF (ICNTL(4).EQ.0) THEN + WRITE(ICNTL(3),9021) (IP(J),J=1,min(10,N+1)) + WRITE(ICNTL(3),9022) (IRN(J),J=1,min(10,NE)) + IF (JOB.GT.1) WRITE(ICNTL(3),9023) (A(J),J=1,min(10,NE)) + ELSEIF (ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9021) (IP(J),J=1,N+1) + WRITE(ICNTL(3),9022) (IRN(J),J=1,NE) + IF (JOB.GT.1) WRITE(ICNTL(3),9023) (A(J),J=1,NE) + ENDIF + WRITE(ICNTL(3),9024) (ICNTL(J),J=1,NICNTL) + WRITE(ICNTL(3),9025) (CNTL(J),J=1,NCNTL) + ENDIF + ENDIF + DO 8 I=1,NINFO + INFO(I) = 0 + 8 CONTINUE + IF (JOB.EQ.1) THEN + DO 10 J = 1,N + IW(J) = IP(J+1) - IP(J) + 10 CONTINUE + CALL ZMUMPS_457(M,N,IRN,NE,IP,IW(1),PERM,NUM, + & IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1)) + GO TO 90 + ENDIF + IF (JOB.EQ.2) THEN + DW(1) = max(ZERO,CNTL(1)) + CALL ZMUMPS_444(M,N,NE,IP,IRN,A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(2*N+M+1),DW,RINF2) + GO TO 90 + ENDIF + IF (JOB.EQ.3) THEN + DO 20 K = 1,NE + IW(K) = IRN(K) + 20 CONTINUE + CALL ZMUMPS_451(N,NE,IP,IW,A) + FACT = max(ZERO,CNTL(1)) + CALL ZMUMPS_452(M,N,NE,IP,IW(1),A,PERM,NUM,IW(NE+1), + & IW(NE+N+1),IW(NE+2*N+1),IW(NE+3*N+1),IW(NE+4*N+1), + & IW(NE+5*N+1),IW(NE+5*N+M+1),FACT,RINF2) + GO TO 90 + ENDIF + IF (JOB.EQ.4) THEN + DO 50 J = 1,N + FACT = ZERO + DO 30 K = IP(J),IP(J+1)-1 + IF (abs(A(K)).GT.FACT) FACT = abs(A(K)) + 30 CONTINUE + IF(FACT .GT. RINF3) RINF3 = FACT + DO 40 K = IP(J),IP(J+1)-1 + A(K) = FACT - abs(A(K)) + 40 CONTINUE + 50 CONTINUE + DW(1) = max(ZERO,CNTL(1)) + DW(2) = RINF3 + IW(1) = JOB + CALL ZMUMPS_454(M,N,NE,IP,IRN,A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1), + & DW(1),DW(M+1),RINF2) + GO TO 90 + ENDIF + IF (JOB.EQ.5 .or. JOB.EQ.6) THEN + RINF3=ONE + IF (JOB.EQ.5) THEN + DO 75 J = 1,N + FACT = ZERO + DO 60 K = IP(J),IP(J+1)-1 + IF (A(K).GT.FACT) FACT = A(K) + 60 CONTINUE + DW(2*M+J) = FACT + IF (FACT.NE.ZERO) THEN + FACT = log(FACT) + IF(FACT .GT. RINF3) RINF3=FACT + DO 70 K = IP(J),IP(J+1)-1 + IF (A(K).NE.ZERO) THEN + A(K) = FACT - log(A(K)) + IF(A(K) .GT. RINF3) RINF3=A(K) + ELSE + A(K) = FACT + RINF + ENDIF + 70 CONTINUE + ELSE + DO 71 K = IP(J),IP(J+1)-1 + A(K) = ONE + 71 CONTINUE + ENDIF + 75 CONTINUE + ENDIF + IF (JOB.EQ.6) THEN + DO 175 K = 1,NE + IW(3*N+2*M+K) = IRN(K) + 175 CONTINUE + DO 61 I = 1,M + DW(2*M+N+I) = ZERO + 61 CONTINUE + DO 63 J = 1,N + DO 62 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (A(K).GT.DW(2*M+N+I)) THEN + DW(2*M+N+I) = A(K) + ENDIF + 62 CONTINUE + 63 CONTINUE + DO 64 I = 1,M + IF (DW(2*M+N+I).NE.ZERO) THEN + DW(2*M+N+I) = 1.0D0/DW(2*M+N+I) + ENDIF + 64 CONTINUE + DO 66 J = 1,N + DO 65 K = IP(J),IP(J+1)-1 + I = IRN(K) + A(K) = DW(2*M+N+I) * A(K) + 65 CONTINUE + 66 CONTINUE + CALL ZMUMPS_451(N,NE,IP,IW(3*N+2*M+1),A) + DO 176 J = 1,N + IF (IP(J).NE.IP(J+1)) THEN + FACT = A(IP(J)) + ELSE + FACT = ZERO + ENDIF + DW(2*M+J) = FACT + IF (FACT.NE.ZERO) THEN + FACT = log(FACT) + DO 170 K = IP(J),IP(J+1)-1 + IF (A(K).NE.ZERO) THEN + A(K) = FACT - log(A(K)) + IF(A(K) .GT. RINF3) RINF3=A(K) + ELSE + A(K) = FACT + RINF + ENDIF + 170 CONTINUE + ELSE + DO 171 K = IP(J),IP(J+1)-1 + A(K) = ONE + 171 CONTINUE + ENDIF + 176 CONTINUE + ENDIF + DW(1) = max(ZERO,CNTL(1)) + RINF3 = RINF3+ONE + DW(2) = RINF3 + IW(1) = JOB + IF (JOB.EQ.5) THEN + CALL ZMUMPS_454(M,N,NE,IP,IRN,A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1), + & DW(1),DW(M+1),RINF2) + ENDIF + IF (JOB.EQ.6) THEN + CALL ZMUMPS_454(M,N,NE,IP,IW(3*N+2*M+1),A,PERM,NUM, + & IW(1),IW(N+1),IW(2*N+1),IW(3*N+1),IW(3*N+M+1), + & DW(1),DW(M+1),RINF2) + ENDIF + IF (JOB.EQ.6) THEN + DO 79 I = 1,M + IF (DW(2*M+N+I).NE.0.0D0) THEN + DW(I) = DW(I) + log(DW(2*M+N+I)) + ENDIF + 79 CONTINUE + ENDIF + IF (NUM.EQ.N) THEN + DO 80 J = 1,N + IF (DW(2*M+J).NE.ZERO) THEN + DW(M+J) = DW(M+J) - log(DW(2*M+J)) + ELSE + DW(M+J) = ZERO + ENDIF + 80 CONTINUE + ENDIF + FACT = 0.5D0*log(RINF2) + DO 86 I = 1,M + IF (DW(I).LT.FACT) GO TO 86 + WARN2 = 2 + GO TO 90 + 86 CONTINUE + DO 87 J = 1,N + IF (DW(M+J).LT.FACT) GO TO 87 + WARN2 = 2 + GO TO 90 + 87 CONTINUE + ENDIF + 90 IF (NUM.LT.N) WARN1 = 1 + IF (JOB.EQ.4 .OR. JOB.EQ.5 .OR. JOB.EQ.6) THEN + IF (CNTL(1).LT.ZERO) WARN4 = 4 + ENDIF + IF (INFO(1).EQ.0) THEN + INFO(1) = WARN1 + WARN2 + WARN4 + IF (INFO(1).GT.0 .AND. ICNTL(2).GT.0) THEN + WRITE(ICNTL(2),9010) INFO(1) + IF (WARN1.EQ.1) WRITE(ICNTL(2),9011) + IF (WARN2.EQ.2) WRITE(ICNTL(2),9012) + IF (WARN4.EQ.4) WRITE(ICNTL(2),9014) + ENDIF + ENDIF + IF (ICNTL(3).GE.0) THEN + IF (ICNTL(4).EQ.0 .OR. ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9030) (INFO(J),J=1,2) + WRITE(ICNTL(3),9031) NUM + IF (ICNTL(4).EQ.0) THEN + WRITE(ICNTL(3),9032) (PERM(J),J=1,min(10,M)) + IF (JOB.EQ.5 .OR. JOB.EQ.6) THEN + WRITE(ICNTL(3),9033) (DW(J),J=1,min(10,M)) + WRITE(ICNTL(3),9034) (DW(M+J),J=1,min(10,N)) + ENDIF + ELSEIF (ICNTL(4).EQ.1) THEN + WRITE(ICNTL(3),9032) (PERM(J),J=1,M) + IF (JOB.EQ.5 .OR. JOB.EQ.6) THEN + WRITE(ICNTL(3),9033) (DW(J),J=1,M) + WRITE(ICNTL(3),9034) (DW(M+J),J=1,N) + ENDIF + ENDIF + ENDIF + ENDIF + 99 RETURN + 9001 FORMAT (' ****** Error in ZMUMPS_443. INFO(1) = ',I2, + & ' because ',(A),' = ',I10) + 9004 FORMAT (' ****** Error in ZMUMPS_443. INFO(1) = ',I2/ + & ' LIW too small, must be at least ',I8) + 9005 FORMAT (' ****** Error in ZMUMPS_443. INFO(1) = ',I2/ + & ' LDW too small, must be at least ',I8) + 9006 FORMAT (' ****** Error in ZMUMPS_443. INFO(1) = ',I2/ + & ' Column ',I8, + & ' contains an entry with invalid row index ',I8) + 9007 FORMAT (' ****** Error in ZMUMPS_443. INFO(1) = ',I2/ + & ' Column ',I8, + & ' contains two or more entries with row index ',I8) + 9010 FORMAT (' ****** Warning from ZMUMPS_443. INFO(1) = ',I2) + 9011 FORMAT (' - The matrix is structurally singular.') + 9012 FORMAT (' - Some scaling factors may be too large.') + 9014 FORMAT (' - CNTL(1) is negative and was treated as zero.') + 9020 FORMAT (' ****** Input parameters for ZMUMPS_443:'/ + & ' JOB =',I10/' M =',I10/' N =',I10/' NE =',I10) + 9021 FORMAT (' IP(1:N+1) = ',8I8/(15X,8I8)) + 9022 FORMAT (' IRN(1:NE) = ',8I8/(15X,8I8)) + 9023 FORMAT (' A(1:NE) = ',4(1PD14.4)/(15X,4(1PD14.4))) + 9024 FORMAT (' ICNTL(1:10) = ',8I8/(15X,2I8)) + 9025 FORMAT (' CNTL(1:10) = ',4(1PD14.4)/(15X,4(1PD14.4))) + 9030 FORMAT (' ****** Output parameters for ZMUMPS_443:'/ + & ' INFO(1:2) = ',2I8) + 9031 FORMAT (' NUM = ',I8) + 9032 FORMAT (' PERM(1:M) = ',8I8/(15X,8I8)) + 9033 FORMAT (' DW(1:M) = ',5(F11.3)/(15X,5(F11.3))) + 9034 FORMAT (' DW(M+1:M+N) = ',5(F11.3)/(15X,5(F11.3))) + END SUBROUTINE ZMUMPS_559 + SUBROUTINE ZMUMPS_563(N,NZ,IP,IRN,A,FLAG,POSI) + IMPLICIT NONE + INTEGER N,NZ + INTEGER IP(N+1),IRN(NZ) + DOUBLE PRECISION A(NZ) + INTEGER WR_POS,BEG_COL,ROW,COL,K,SV_POS + INTEGER FLAG(N), POSI(N) + FLAG = 0 + WR_POS = 1 + DO COL=1,N + BEG_COL = WR_POS + DO K=IP(COL),IP(COL+1)-1 + ROW = IRN(K) + IF(FLAG(ROW) .NE. COL) THEN + IRN(WR_POS) = ROW + A(WR_POS) = A(K) + FLAG(ROW) = COL + POSI(ROW) = WR_POS + WR_POS = WR_POS+1 + ELSE + SV_POS = POSI(ROW) + A(SV_POS) = A(SV_POS) + A(K) + ENDIF + ENDDO + IP(COL) = BEG_COL + ENDDO + IP(N+1) = WR_POS + NZ = WR_POS-1 + RETURN + END SUBROUTINE ZMUMPS_563 + SUBROUTINE ZMUMPS_562(N,NZ,IP,IRN,FLAG,POSI) + IMPLICIT NONE + INTEGER N,NZ + INTEGER IP(N+1),IRN(NZ) + INTEGER WR_POS,BEG_COL,ROW,COL,K + INTEGER FLAG(N), POSI(N) + FLAG = 0 + WR_POS = 1 + DO COL=1,N + BEG_COL = WR_POS + DO K=IP(COL),IP(COL+1)-1 + ROW = IRN(K) + IF(FLAG(ROW) .NE. COL) THEN + IRN(WR_POS) = ROW + FLAG(ROW) = COL + POSI(ROW) = WR_POS + WR_POS = WR_POS+1 + ENDIF + ENDDO + IP(COL) = BEG_COL + ENDDO + IP(N+1) = WR_POS + NZ = WR_POS-1 + RETURN + END SUBROUTINE ZMUMPS_562 + SUBROUTINE ZMUMPS_181( N, NA, LNA, NE_STEPS, + & PERM, FILS, + & DAD_STEPS, STEP, NSTEPS, INFO) + IMPLICIT NONE + INTEGER, INTENT(IN) :: N, NSTEPS, LNA + INTEGER, INTENT(IN) :: FILS( N ), STEP(N), NA(LNA) + INTEGER, INTENT(IN) :: DAD_STEPS ( NSTEPS ), NE_STEPS (NSTEPS) + INTEGER, INTENT(INOUT) :: INFO(40) + INTEGER, INTENT(OUT) :: PERM( N ) + INTEGER :: IPERM, INODE, IN + INTEGER :: INBLEAF, INBROOT, allocok + INTEGER, ALLOCATABLE, DIMENSION (:) :: POOL, NSTK + INBLEAF = NA(1) + INBROOT = NA(2) + ALLOCATE(POOL(INBLEAF), NSTK(NSTEPS), stat=allocok) + IF (allocok > 0 ) THEN + INFO(1) = -7 + INFO(2) = INBLEAF + NSTEPS + RETURN + ENDIF + POOL(1:INBLEAF) = NA(3:2+INBLEAF) + NSTK(1:NSTEPS) = NE_STEPS(1:NSTEPS) + IPERM = 1 + DO WHILE ( INBLEAF .NE. 0 ) + INODE = POOL( INBLEAF ) + INBLEAF = INBLEAF - 1 + IN = INODE + DO WHILE ( IN .GT. 0 ) + PERM ( IN ) = IPERM + IPERM = IPERM + 1 + IN = FILS( IN ) + END DO + IN = DAD_STEPS(STEP( INODE )) + IF ( IN .eq. 0 ) THEN + INBROOT = INBROOT - 1 + ELSE + NSTK( STEP(IN) ) = NSTK( STEP(IN) ) - 1 + IF ( NSTK( STEP(IN) ) .eq. 0 ) THEN + INBLEAF = INBLEAF + 1 + POOL( INBLEAF ) = IN + END IF + END IF + END DO + DEALLOCATE(POOL, NSTK) + RETURN + END SUBROUTINE ZMUMPS_181 + SUBROUTINE ZMUMPS_746( ID, PTRAR ) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + include 'mpif.h' + TYPE(ZMUMPS_STRUC), INTENT(IN), TARGET :: ID + INTEGER, TARGET :: PTRAR(ID%N,2) + INTEGER :: IERR + INTEGER :: IOLD, K, JOLD, INEW, JNEW, INZ + INTEGER, POINTER :: IIRN(:), IJCN(:), IWORK1(:), IWORK2(:) + LOGICAL :: IDO, PARANAL + PARANAL = .TRUE. + IF (PARANAL) THEN + IF(ID%KEEP(54) .EQ. 3) THEN + IIRN => ID%IRN_loc + IJCN => ID%JCN_loc + INZ = ID%NZ_loc + IWORK1 => PTRAR(1:ID%N,2) + allocate(IWORK2(ID%N)) + IDO = .TRUE. + ELSE + IIRN => ID%IRN + IJCN => ID%JCN + INZ = ID%NZ + IWORK1 => PTRAR(1:ID%N,1) + IWORK2 => PTRAR(1:ID%N,2) + IDO = ID%MYID .EQ. 0 + END IF + ELSE + IIRN => ID%IRN + IJCN => ID%JCN + INZ = ID%NZ + IWORK1 => PTRAR(1:ID%N,1) + IWORK2 => PTRAR(1:ID%N,2) + IDO = ID%MYID .EQ. 0 + END IF + DO 50 IOLD=1,ID%N + IWORK1(IOLD) = 0 + IWORK2(IOLD) = 0 + 50 CONTINUE + IF(IDO) THEN + DO 70 K=1,INZ + IOLD = IIRN(K) + JOLD = IJCN(K) + IF ( (IOLD.GT.ID%N).OR.(JOLD.GT.ID%N).OR.(IOLD.LT.1) + & .OR.(JOLD.LT.1) ) GOTO 70 + IF (IOLD.NE.JOLD) THEN + INEW = ID%SYM_PERM(IOLD) + JNEW = ID%SYM_PERM(JOLD) + IF ( ID%KEEP( 50 ) .EQ. 0 ) THEN + IF (INEW.LT.JNEW) THEN + IWORK2(IOLD) = IWORK2(IOLD) + 1 + ELSE + IWORK1(JOLD) = IWORK1(JOLD) + 1 + ENDIF + ELSE + IF ( INEW .LT. JNEW ) THEN + IWORK1( IOLD ) = IWORK1( IOLD ) + 1 + ELSE + IWORK1( JOLD ) = IWORK1( JOLD ) + 1 + END IF + ENDIF + ENDIF + 70 CONTINUE + END IF + IF(PARANAL .AND. (ID%KEEP(54) .EQ. 3) ) THEN + CALL MPI_ALLREDUCE(IWORK1(1), PTRAR(1,1), ID%N, MPI_INTEGER, + & MPI_SUM, ID%COMM, IERR ) + CALL MPI_ALLREDUCE(IWORK2(1), PTRAR(1,2), ID%N, MPI_INTEGER, + & MPI_SUM, ID%COMM, IERR ) + deallocate(IWORK2) + ELSE + CALL MPI_BCAST( PTRAR, 2*ID%N, MPI_INTEGER, + & 0, ID%COMM, IERR ) + END IF + RETURN + END SUBROUTINE ZMUMPS_746 + MODULE ZMUMPS_PARALLEL_ANALYSIS + USE ZMUMPS_STRUC_DEF + USE TOOLS_COMMON + INCLUDE 'mpif.h' + PUBLIC ZMUMPS_715 + INTERFACE ZMUMPS_715 + MODULE PROCEDURE ZMUMPS_715 + END INTERFACE + PRIVATE + TYPE ORD_TYPE + INTEGER :: CBLKNBR, N + INTEGER, POINTER :: PERMTAB(:) => null() + INTEGER, POINTER :: PERITAB(:) => null() + INTEGER, POINTER :: RANGTAB(:) => null() + INTEGER, POINTER :: TREETAB(:) => null() + INTEGER, POINTER :: BROTHER(:) => null() + INTEGER, POINTER :: SON(:) => null() + INTEGER, POINTER :: NW(:) => null() + INTEGER, POINTER :: FIRST(:) => null() + INTEGER, POINTER :: LAST(:) => null() + INTEGER, POINTER :: TOPNODES(:) => null() + INTEGER :: COMM, COMM_NODES, NPROCS, NSLAVES, MYID + INTEGER :: TOPSTRAT, SUBSTRAT, ORDTOOL, TOPVARS + LOGICAL :: IDO + END TYPE ORD_TYPE + TYPE GRAPH_TYPE + INTEGER :: NZ_LOC, N, COMM + INTEGER, POINTER :: IRN_LOC(:) => null() + INTEGER, POINTER :: JCN_LOC(:) => null() + END TYPE GRAPH_TYPE + TYPE ARRPNT + INTEGER, POINTER :: BUF(:) => null() + END TYPE ARRPNT + INTEGER :: MEMCNT, MAXMEM, MP, MPG, LP, NRL, TOPROWS + LOGICAL :: PROK, PROKG + CONTAINS + SUBROUTINE ZMUMPS_715(id, WORK1, WORK2, NFSIZ, FILS, + & FRERE) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(ZMUMPS_STRUC) :: id + INTEGER, POINTER :: WORK1(:), WORK2(:), + & NFSIZ(:), FILS(:), FRERE(:) + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: IPE(:), NV(:), + & NE(:), NA(:), NODE(:), + & ND(:), SUBORD(:), NAMALG(:), + & IPS(:), CUMUL(:), + & SAVEIRN(:), SAVEJCN(:) + INTEGER :: MYID, NPROCS, IERR, NEMIN, LDIAG + LOGICAL :: SPLITROOT + INTEGER(8), PARAMETER :: K79REF=12000000_8 + nullify(IPE, NV, NE, NA, NODE, ND, SUBORD, NAMALG, IPS, + & CUMUL, SAVEIRN, SAVEJCN) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + LP = id%ICNTL(1) + MP = id%ICNTL(2) + MPG = id%ICNTL(3) + PROK = (MP.GT.0) + PROKG = (MPG.GT.0) .AND. (MYID .EQ. 0) + LDIAG = id%ICNTL(4) + ord%PERMTAB => WORK1(1 : id%N) + ord%PERITAB => WORK1(id%N+1 : 2*id%N) + ord%TREETAB => WORK1(2*id%N+1 : 3*id%N) + IF(id%KEEP(54) .NE. 3) THEN + IF(MYID.EQ.0) THEN + SAVEIRN => id%IRN_loc + SAVEJCN => id%JCN_loc + id%IRN_loc => id%IRN + id%JCN_loc => id%JCN + id%NZ_loc = id%NZ + ELSE + id%NZ_loc = 0 + END IF + END IF + MAXMEM=0 + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + MEMCNT = size(work1)+ size(work2) + + & size(nfsiz) + size(fils) + size(frere) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT entry:',MEMCNT,MAXMEM +#endif + CALL ZMUMPS_716(id, ord) + id%INFOG(7) = id%KEEP(245) + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + CALL ZMUMPS_717(id, ord, WORK2) + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + IF(id%MYID .EQ. 0) THEN + CALL MUMPS_733(IPE, id%N, id%INFO, LP, FORCE=.FALSE., + & COPY=.FALSE., STRING='', + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NV, id%N, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT ipe nv:',MEMCNT,MAXMEM +#endif + END IF + ord%SUBSTRAT = 0 + ord%TOPSTRAT = 0 + CALL ZMUMPS_720(id, ord, IPE, NV, WORK2) + IF(id%KEEP(54) .NE. 3) THEN + IF(MYID.EQ.0) THEN + id%IRN_loc => SAVEIRN + id%JCN_loc => SAVEJCN + END IF + END IF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + NULLIFY(ord%PERMTAB) + NULLIFY(ord%PERITAB) + NULLIFY(ord%TREETAB) + CALL MUMPS_734(ord%FIRST, ord%LAST, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT firstlast:',MEMCNT,MAXMEM +#endif + IF (MYID .EQ. 0) THEN + IPS => WORK1(1:id%N) + NE => WORK1(id%N+1 : 2*id%N) + NA => WORK1(2*id%N+1 : 3*id%N) + NODE => WORK2(1 : id%N ) + ND => WORK2(id%N+1 : 2*id%N) + SUBORD => WORK2(2*id%N+1 : 3*id%N) + NAMALG => WORK2(3*id%N+1 : 4*id%N) + CALL MUMPS_733(CUMUL, id%N, id%INFO, LP, + & STRING='CUMUL', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT cumul:',MEMCNT,MAXMEM +#endif + NEMIN = id%KEEP(1) + CALL ZMUMPS_557(id%N, IPE(1), NV(1), IPS(1), NE(1), + & NA(1), NFSIZ(1), NODE(1), id%INFOG(6), FILS(1), FRERE(1), + & ND(1), NEMIN, SUBORD(1), id%KEEP(60), id%KEEP(20), + & id%KEEP(38), NAMALG(1), id%KEEP(104), CUMUL(1), + & id%KEEP(50), id%ICNTL(13), id%KEEP(37), id%NSLAVES, + & id%KEEP(250).EQ.1) + CALL MUMPS_734(CUMUL, NV, IPE, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall cumul:',MEMCNT,MAXMEM +#endif + CALL ZMUMPS_201(NE(1), ND(1), id%INFOG(6), id%INFOG(5), + & id%KEEP(2), id%KEEP(50), id%KEEP(101), id%KEEP(108), + & id%KEEP(5), id%KEEP(6), id%KEEP(226), id%KEEP(253)) + IF ( id%KEEP(53) .NE. 0 ) THEN + CALL MUMPS_209(id%N, FRERE(1), FILS(1), NFSIZ(1), + & id%KEEP(20)) + END IF + IF ( (id%KEEP(48) == 4 .AND. id%KEEP8(21).GT.0_8) + & .OR. + & (id%KEEP (48)==5 .AND. id%KEEP8(21) .GT. 0_8 ) + & .OR. + & (id%KEEP(24).NE.0.AND.id%KEEP8(21).GT.0_8) ) THEN + CALL ZMUMPS_510(id%KEEP8(21), id%KEEP(2), + & id%KEEP(48), id%KEEP(50), id%NSLAVES) + END IF + IF ((id%KEEP(210).LT.0) .OR. (id%KEEP(210).GT.2)) + & id%KEEP(210)=0 + IF ((id%KEEP(210).EQ.0) .AND. (id%KEEP(201).GT.0)) + & id%KEEP(210)=1 + IF ((id%KEEP(210).EQ.0) .AND. (id%KEEP(201).EQ.0)) + & id%KEEP(210)=2 + IF (id%KEEP(210).EQ.2) id%KEEP8(79)=huge(id%KEEP8(79)) + IF ((id%KEEP(210).EQ.1) .AND. (id%KEEP8(79).LE.0_8)) THEN + IF ( huge(id%KEEP8(79)) / K79REF + 1_8 .GE. + & int(id%NSLAVES,8) ) THEN + id%KEEP8(79)=huge(id%KEEP8(79)) + ELSE + id%KEEP8(79)=K79REF * int(id%NSLAVES,8) + ENDIF + ENDIF + IF ( (id%KEEP(79).EQ.0).OR.(id%KEEP(79).EQ.2).OR. + & (id%KEEP(79).EQ.3).OR.(id%KEEP(79).EQ.5).OR. + & (id%KEEP(79).EQ.6) + & ) THEN + IF (id%KEEP(210).EQ.1) THEN + SPLITROOT = .FALSE. + IF ( id%KEEP(62).GE.1) THEN + CALL ZMUMPS_97(id%N, FRERE(1), FILS(1), + & NFSIZ(1), id%INFOG(6), + & id%NSLAVES, id%KEEP(1), id%KEEP8(1), SPLITROOT, + & MP, LDIAG, id%INFOG(1), id%INFOG(2)) + IF (id%INFOG(1).LT.0) RETURN + ENDIF + ENDIF + ENDIF + SPLITROOT = (((id%ICNTL(13).GT.0) .AND. + & (id%NSLAVES.GT.id%ICNTL(13))) .OR. + & (id%ICNTL(13).EQ.-1)) .AND. (id%KEEP(60).EQ.0) + IF (SPLITROOT) THEN + CALL ZMUMPS_97(id%N, FRERE(1), FILS(1), NFSIZ(1), + & id%INFOG(6), id%NSLAVES, id%KEEP(1), id%KEEP8(1), + & SPLITROOT, MP, LDIAG, id%INFOG(1), id%INFOG(2)) + IF (id%INFOG(1).LT.0) RETURN + ENDIF + END IF +#if defined (memprof) + write(mp,'(i2,a30,3(i8,5x))')myid,'MEMCNT exit:',MEMCNT,MAXMEM, + & estimem(myid, id%n, 2*id%nz/id%n) +#endif + RETURN + END SUBROUTINE ZMUMPS_715 + SUBROUTINE ZMUMPS_716(id, ord) + TYPE(ZMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER :: IERR +#if defined(parmetis) + INTEGER :: I, COLOR, BASE + LOGICAL :: IDO +#endif + IF(id%MYID .EQ. 0) id%KEEP(245) = id%ICNTL(29) + CALL MPI_BCAST( id%KEEP(245), 1, + & MPI_INTEGER, 0, id%COMM, IERR ) + IF ((id%KEEP(245) .LT. 0) .OR. (id%KEEP(245) .GT. 2)) THEN + id%KEEP(245) = 0 + END IF + IF (id%KEEP(245) .EQ. 0) THEN +#if defined(ptscotch) + IF(id%NSLAVES .LT. 2) THEN + IF(PROKG) WRITE(MPG,'("Warning: older versions + &of PT-SCOTCH require at least 2 processors.")') + END IF + ord%ORDTOOL = 1 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%COMM = id%COMM + ord%COMM_NODES = id%COMM_NODES + ord%NPROCS = id%NPROCS + ord%NSLAVES = id%NSLAVES + ord%MYID = id%MYID + ord%IDO = (id%MYID .GE. 1) .OR. (id%KEEP(46) .EQ. 1) + IF(PROKG) WRITE(MPG, + & '("Parallel ordering tool set to PT-SCOTCH.")') + RETURN +#endif +#if defined(parmetis) + I=1 + DO + IF (I .GT. id%NSLAVES) EXIT + ord%NSLAVES = I + I = I*2 + END DO + BASE = id%NPROCS-id%NSLAVES + ord%NPROCS = ord%NSLAVES + BASE + IDO = (id%MYID .GE. BASE) .AND. + & (id%MYID .LE. BASE+ord%NSLAVES-1) + ord%IDO = IDO + IF ( IDO ) THEN + COLOR = 1 + ELSE + COLOR = MPI_UNDEFINED + END IF + CALL MPI_COMM_SPLIT( id%COMM, COLOR, 0, + & ord%COMM_NODES, IERR ) + ord%ORDTOOL = 2 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%MYID = id%MYID + IF(PROKG) WRITE(MPG, + & '("Parallel ordering tool set to ParMETIS.")') + RETURN +#endif + id%INFO(1) = -38 + id%INFOG(1) = -38 + IF(id%MYID .EQ.0 ) THEN + WRITE(LP, + & '("No parallel ordering tools available.")') + WRITE(LP, + & '("Please install PT-SCOTCH or ParMETIS.")') + END IF + RETURN + ELSE IF (id%KEEP(245) .EQ. 1) THEN +#if defined(ptscotch) + IF(id%NSLAVES .LT. 2) THEN + IF(PROKG) WRITE(MPG,'("Warning: older versions + &of PT-SCOTCH require at least 2 processors.")') + END IF + ord%ORDTOOL = 1 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%COMM = id%COMM + ord%COMM_NODES = id%COMM_NODES + ord%NPROCS = id%NPROCS + ord%NSLAVES = id%NSLAVES + ord%MYID = id%MYID + ord%IDO = (id%MYID .GE. 1) .OR. (id%KEEP(46) .EQ. 1) + IF(PROKG) WRITE(MPG, + & '("Using PT-SCOTCH for parallel ordering.")') + RETURN +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) WRITE(LP, + & '("PT-SCOTCH not available.")') + RETURN +#endif + ELSE IF (id%KEEP(245) .EQ. 2) THEN +#if defined(parmetis) + I=1 + DO + IF (I .GT. id%NSLAVES) EXIT + ord%NSLAVES = I + I = I*2 + END DO + BASE = id%NPROCS-id%NSLAVES + ord%NPROCS = ord%NSLAVES + BASE + IDO = (id%MYID .GE. BASE) .AND. + & (id%MYID .LE. BASE+ord%NSLAVES-1) + ord%IDO = IDO + IF ( IDO ) THEN + COLOR = 1 + ELSE + COLOR = MPI_UNDEFINED + END IF + CALL MPI_COMM_SPLIT( id%COMM, COLOR, 0, ord%COMM_NODES, + & IERR ) + ord%ORDTOOL = 2 + ord%TOPSTRAT = 0 + ord%SUBSTRAT = 0 + ord%MYID = id%MYID + IF(PROKG) WRITE(MPG, + & '("Using ParMETIS for parallel ordering.")') + RETURN +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) WRITE(LP, + & '("ParMETIS not available.")') + RETURN +#endif + END IF + END SUBROUTINE ZMUMPS_716 + SUBROUTINE ZMUMPS_717(id, ord, WORK) + IMPLICIT NONE + TYPE(ZMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: WORK(:) +#ifdef parmetis + INTEGER :: IERR +#endif + IF (ord%ORDTOOL .EQ. 1) THEN +#ifdef ptscotch + CALL ZMUMPS_719(id, ord, WORK) +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + WRITE(LP,*)'PT-SCOTCH not available. Aborting...' + CALL MUMPS_ABORT() +#endif + ELSE IF (ord%ORDTOOL .EQ. 2) THEN +#ifdef parmetis + CALL ZMUMPS_718(id, ord, WORK) + if(ord%IDO) CALL MPI_COMM_FREE(ord%COMM_NODES, IERR) +#else + id%INFOG(1) = -38 + id%INFO(1) = -38 + WRITE(LP,*)'ParMETIS not available. Aborting...' + CALL MUMPS_ABORT() +#endif + END IF + RETURN + END SUBROUTINE ZMUMPS_717 +#if defined(parmetis) + SUBROUTINE ZMUMPS_718(id, ord, WORK) + IMPLICIT NONE + TYPE(ZMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: WORK(:) + INTEGER :: I, MYID, NPROCS, IERR, BASE + INTEGER, POINTER :: FIRST(:), + & LAST(:), SWORK(:) + INTEGER :: BASEVAL, VERTLOCNBR, + & EDGELOCNBR, OPTIONS(10), NROWS_LOC + INTEGER, POINTER :: VERTLOCTAB(:), + & EDGELOCTAB(:), RCVCNTS(:) + INTEGER, POINTER :: SIZES(:), ORDER(:) + nullify(FIRST, LAST, SWORK, VERTLOCTAB, EDGELOCTAB, RCVCNTS, + & SIZES, ORDER) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. ID%N*3) THEN + WRITE(LP, + & '("Insufficient workspace inside ZMUMPS_718")') + CALL MUMPS_ABORT() + END IF + CALL MUMPS_733(ord%PERMTAB, id%N, id%INFO, LP, + & STRING='PERMTAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%PERITAB, id%N, id%INFO, LP, + & STRING='PERITAB', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT perm peri:', + & MEMCNT,MAXMEM +#endif + BASEVAL = 1 + BASE = id%NPROCS-id%NSLAVES + VERTLOCTAB => ord%PERMTAB + CALL MUMPS_733(FIRST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT first last:',MEMCNT, + & MAXMEM +#endif + DO I=0, BASE-1 + FIRST(I+1) = 0 + LAST(I+1) = -1 + END DO + DO I=BASE, BASE+ord%NSLAVES-2 + FIRST(I+1) = (id%N/ord%NSLAVES)*(I-BASE)+1 + LAST(I+1) = (id%N/ord%NSLAVES)*(I+1-BASE) + END DO + FIRST(BASE+ord%NSLAVES) = (id%N/ord%NSLAVES)* + & (BASE+ord%NSLAVES-1-BASE)+1 + LAST(BASE+ord%NSLAVES) = id%N + DO I=BASE+ord%NSLAVES, NPROCS + FIRST(I+1) = id%N+1 + LAST(I+1) = id%N + END DO + VERTLOCNBR = LAST(MYID+1)-FIRST(MYID+1) + 1 + SWORK => WORK(id%N+1:3*id%N) + CALL ZMUMPS_776(id, FIRST, LAST, VERTLOCTAB, + & EDGELOCTAB, SWORK) + EDGELOCNBR = VERTLOCTAB(VERTLOCNBR+1)-1 + OPTIONS(:) = 0 + NROWS_LOC = LAST(MYID+1)-FIRST(MYID+1)+1 + ORDER => WORK(1:id%N) + CALL MUMPS_733(SIZES, 2*ord%NSLAVES, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT sizes:',MEMCNT,MAXMEM +#endif + IF(ord%IDO) THEN + CALL MUMPS_PARMETIS(FIRST(1+BASE), VERTLOCTAB, + & EDGELOCTAB, BASEVAL, OPTIONS, ORDER, + & SIZES, ord%COMM_NODES) + END IF + CALL MUMPS_734(EDGELOCTAB, MEMCNT=MEMCNT) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall elt:',MEMCNT,MAXMEM +#endif + NULLIFY(VERTLOCTAB) + CALL MPI_BCAST(SIZES, 2*ord%NSLAVES, MPI_INTEGER, + & BASE, id%COMM, IERR) + ord%CBLKNBR = 2*ord%NSLAVES-1 + CALL MUMPS_733(RCVCNTS, id%NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rcvcnts:',MEMCNT,MAXMEM +#endif + DO I=1, id%NPROCS + RCVCNTS(I) = max(LAST(I)-FIRST(I)+1,0) + END DO + FIRST = FIRST-1 + IF(FIRST(1) .LT. 0) THEN + FIRST(1) = 0 + END IF + CALL MPI_ALLGATHERV ( ORDER, NROWS_LOC, MPI_INTEGER, ord%PERMTAB, + & RCVCNTS, FIRST, MPI_INTEGER, id%COMM, IERR ) + DO I=1, id%N + ord%PERITAB(ord%PERMTAB(I)) = I + END DO + CALL MUMPS_733(ord%RANGTAB, 2*ord%NSLAVES, id%INFO, + & LP, STRING='RANGTAB', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rangtab:',MEMCNT,MAXMEM +#endif + CALL MUMPS_733(ord%TREETAB, ord%CBLKNBR, id%INFO, + & LP, STRING='TREETAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL ZMUMPS_778(ord%TREETAB, ord%RANGTAB, + & SIZES, ord%CBLKNBR) + CALL MUMPS_734(SIZES, FIRST, LAST, + & RCVCNTS, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall sizes:',MEMCNT,MAXMEM +#endif + CALL MUMPS_733(ord%SON, ord%CBLKNBR, id%INFO, + & LP, STRING='SON', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%BROTHER, ord%CBLKNBR, id%INFO, + & LP, STRING='BROTHER', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%NW, ord%CBLKNBR, id%INFO, + & LP, STRING='NW', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT son:',MEMCNT,MAXMEM +#endif + CALL ZMUMPS_777(ord) + ord%N = id%N + ord%COMM = id%COMM + RETURN + END SUBROUTINE ZMUMPS_718 +#endif +#if defined(ptscotch) + SUBROUTINE ZMUMPS_719(id, ord, WORK) + IMPLICIT NONE + INCLUDE 'ptscotchf.h' + TYPE(ZMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: WORK(:) + INTEGER :: I, MYID, NPROCS, IERR + INTEGER, POINTER :: FIRST(:), + & LAST(:), SWORK(:) + INTEGER :: BASEVAL, VERTLOCNBR, + & EDGELOCNBR, MYWORKID, + & BASE + INTEGER, POINTER :: VERTLOCTAB(:), + & EDGELOCTAB(:) + DOUBLE PRECISION :: GRAPHDAT(SCOTCH_DGRAPHDIM), + & ORDEDAT(SCOTCH_DORDERDIM), STRADAT(SCOTCH_STRATDIM), + & CORDEDAT(SCOTCH_ORDERDIM) + CHARACTER STRSTRING*1024 + nullify(FIRST, LAST, SWORK, VERTLOCTAB, EDGELOCTAB) + IF(MUMPS_795(WORK) .LT. ID%N*3) THEN + WRITE(LP, + & '("Insufficient workspace inside ZMUMPS_719")') + CALL MUMPS_ABORT() + END IF + IF(ord%SUBSTRAT .EQ. 0) THEN + STRSTRING='n{sep=m{asc=b{width=3,strat=q{strat=f}},'// + & 'low=q{strat=h},vert=1000,dvert=100,dlevl=0,proc=1,'// + & 'seq=q{strat=m{type=h,vert=100,low=h{pass=10},'// + & 'asc=b{width=3,bnd=f{bal=0.2},org=h{pass=10}'// + & 'f{bal=0.2}}}}},ole=s,ose=s,osq=n{sep=/(vert>120)?'// + & 'm{type=h,vert=100,low=h{pass=10},asc=b{width=3,'// + & 'bnd=f{bal=0.2},org=h{pass=10}f{bal=0.2}}};,'// + & 'ole=f{cmin=15,cmax=100000,frat=0.0},ose=g}}' + ELSE + STRSTRING='n{sep=m{asc=b{width=3,strat=q{strat=f}},'// + & 'low=q{strat=h},vert=1000,dvert=100,dlevl=0,'// + & 'proc=1,seq=q{strat=m{type=h,vert=100,'// + & 'low=h{pass=10},asc=b{width=3,bnd=f{bal=0.2},'// + & 'org=h{pass=10}f{bal=0.2}}}}},ole=s,ose=s,osq=s}' + END IF + CALL MPI_BARRIER(id%COMM, IERR) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + BASE = id%NPROCS-id%NSLAVES + BASEVAL = 1 + CALL MUMPS_733(FIRST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, NPROCS+1, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT first last:',MEMCNT, + & MAXMEM +#endif + DO I=0, BASE-1 + FIRST(I+1) = 0 + LAST(I+1) = -1 + END DO + DO I=BASE, BASE+ord%NSLAVES-2 + FIRST(I+1) = (id%N/ord%NSLAVES)*(I-BASE)+1 + LAST(I+1) = (id%N/ord%NSLAVES)*(I+1-BASE) + END DO + FIRST(BASE+ord%NSLAVES) = (id%N/ord%NSLAVES)* + & (BASE+ord%NSLAVES-1-BASE)+1 + LAST(BASE+ord%NSLAVES) = id%N + DO I=BASE+ord%NSLAVES, NPROCS-1 + FIRST(I+1) = id%N+1 + LAST(I+1) = id%N + END DO + VERTLOCNBR = LAST(MYID+1)-FIRST(MYID+1) + 1 + VERTLOCTAB => WORK(1:id%N) + SWORK => WORK(id%N+1:3*id%N) + CALL ZMUMPS_776(id, FIRST, LAST, VERTLOCTAB, + & EDGELOCTAB, SWORK) + EDGELOCNBR = VERTLOCTAB(VERTLOCNBR+1)-1 + CALL MUMPS_733(ord%PERMTAB, id%N, id%INFO, + & LP, STRING='PERMTAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%PERITAB, id%N, id%INFO, + & LP, STRING='PERITAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%RANGTAB, id%N+1, id%INFO, + & LP, STRING='RANGTAB', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%TREETAB, id%N, id%INFO, + & LP, STRING='TREETAB', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT permtab:',MEMCNT,MAXMEM +#endif + IF(ord%IDO) THEN + CALL MPI_COMM_RANK (ord%COMM_NODES, MYWORKID, IERR) + ELSE + MYWORKID = -1 + END IF + IF(ord%IDO) THEN + CALL MUMPS_DGRAPHINIT(GRAPHDAT, ord%COMM_NODES, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in dgraph init")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFDGRAPHBUILD(GRAPHDAT, BASEVAL, VERTLOCNBR, + & VERTLOCNBR, VERTLOCTAB(1), VERTLOCTAB(2), VERTLOCTAB(1), + & VERTLOCTAB(1), EDGELOCNBR, EDGELOCNBR, EDGELOCTAB(1), + & EDGELOCTAB(1), EDGELOCTAB(1), IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in dgraph build")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFSTRATINIT(STRADAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in strat init")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFSTRATDGRAPHORDER(STRADAT, STRSTRING, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in strat build")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFDGRAPHORDERINIT(GRAPHDAT, ORDEDAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order init")') + CALL MUMPS_ABORT() + END IF + CALL SCOTCHFDGRAPHORDERCOMPUTE(GRAPHDAT, ORDEDAT, STRADAT, + & IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order compute")') + CALL MUMPS_ABORT() + END IF + IF(MYWORKID .EQ. 0) THEN + CALL SCOTCHFDGRAPHCORDERINIT(GRAPHDAT, CORDEDAT, + & ord%PERMTAB, ord%PERITAB, ord%CBLKNBR, ord%RANGTAB, + & ord%TREETAB, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in Corder init")') + CALL MUMPS_ABORT() + END IF + END IF + IF(MYWORKID .EQ. 0) THEN + CALL SCOTCHFDGRAPHORDERGATHER(GRAPHDAT, ORDEDAT, + & CORDEDAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order gather")') + CALL MUMPS_ABORT() + END IF + ELSE + CALL SCOTCHFDGRAPHORDERGATHER(GRAPHDAT, ORDEDAT, + & ORDEDAT, IERR) + IF(IERR.NE.0) THEN + WRITE(LP,'("Error in order gather")') + CALL MUMPS_ABORT() + END IF + END IF + END IF + IF(MYWORKID .EQ. 0) + & CALL SCOTCHFDGRAPHCORDEREXIT(GRAPHDAT, CORDEDAT) + CALL SCOTCHFDGRAPHORDEREXIT(GRAPHDAT, ORDEDAT) + CALL SCOTCHFSTRATEXIT(STRADAT) + CALL SCOTCHFDGRAPHEXIT(GRAPHDAT) + CALL MPI_BCAST (ord%CBLKNBR, 1, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%PERMTAB, id%N, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%PERITAB, id%N, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%RANGTAB, id%N+1, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MPI_BCAST (ord%TREETAB, id%N, MPI_INTEGER, + & BASE, id%COMM, IERR) + CALL MUMPS_733(ord%SON, ord%CBLKNBR, id%INFO, + & LP, STRING='SON', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%BROTHER, ord%CBLKNBR, id%INFO, + & LP, STRING='BROTHER', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%NW, ord%CBLKNBR, id%INFO, + & LP, STRING='NW', MEMCNT=MEMCNT, ERRCODE=-7) + CALL ZMUMPS_777(ord) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT son:',MEMCNT,MAXMEM +#endif + ord%N = id%N + ord%COMM = id%COMM + CALL MUMPS_734(EDGELOCTAB, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall elt:',MEMCNT,MAXMEM +#endif + RETURN + END SUBROUTINE ZMUMPS_719 +#endif + FUNCTION ZMUMPS_793(id, ord, NACTIVE, ANODE, RPROC, + & ALIST, LIST, PEAKMEM, NNODES, CHECKMEM) + IMPLICIT NONE + LOGICAL :: ZMUMPS_793 + INTEGER :: NACTIVE, RPROC, ANODE, PEAKMEM, NNODES + INTEGER :: ALIST(NNODES), LIST(NNODES) + TYPE(ORD_TYPE) :: ord + TYPE(ZMUMPS_STRUC) :: id + LOGICAL, OPTIONAL :: CHECKMEM + INTEGER :: IPEAKMEM, BIG, MAX_NROWS, MIN_NROWS + INTEGER :: TOPROWS, NRL, HOSTMEM, SUBMEM + INTEGER :: I, NZ_ROW, WEIGHT + LOGICAL :: ICHECKMEM + IF(present(CHECKMEM)) THEN + ICHECKMEM = CHECKMEM + ELSE + ICHECKMEM = .FALSE. + END IF + ZMUMPS_793 = .FALSE. + IF(NACTIVE .GE. RPROC) THEN + ZMUMPS_793 = .TRUE. + RETURN + END IF + IF(NACTIVE .EQ. 0) THEN + ZMUMPS_793 = .TRUE. + RETURN + END IF + IF(.NOT. ICHECKMEM) RETURN + BIG = ALIST(NACTIVE) + IF(NACTIVE .GT. 1) THEN + MAX_NROWS = ord%NW(ALIST(NACTIVE-1)) + MIN_NROWS = ord%NW(ALIST(1)) + ELSE + MAX_NROWS = 0 + MIN_NROWS = id%N + END IF + DO I=1, ANODE + WEIGHT = ord%NW(LIST(I)) + IF(WEIGHT .GT. MAX_NROWS) MAX_NROWS = WEIGHT + IF(WEIGHT .LT. MIN_NROWS) MIN_NROWS = WEIGHT + END DO + I = ord%SON(BIG) + DO + WEIGHT = ord%NW(I) + IF(WEIGHT .GT. MAX_NROWS) MAX_NROWS = WEIGHT + IF(WEIGHT .LT. MIN_NROWS) MIN_NROWS = WEIGHT + IF(ord%BROTHER(I) .EQ. -1) EXIT + I = ord%BROTHER(I) + END DO + TOPROWS = ord%TOPNODES(2)+ord%RANGTAB(BIG+1)-ord%RANGTAB(BIG) + SUBMEM = 7 *id%N + HOSTMEM = 12*id%N + NZ_ROW = 2*(id%NZ/id%N) + IF(id%KEEP(46) .EQ. 0) THEN + NRL = 0 + ELSE + NRL = MIN_NROWS + END IF + HOSTMEM = HOSTMEM + 2*TOPROWS*NZ_ROW + HOSTMEM = HOSTMEM +NRL + HOSTMEM = HOSTMEM + max(NRL,TOPROWS)*(NZ_ROW+2) + HOSTMEM = HOSTMEM + 6*max(NRL,TOPROWS) + HOSTMEM = HOSTMEM + 3*TOPROWS + NRL = MAX_NROWS + SUBMEM = SUBMEM +NRL + SUBMEM = SUBMEM + NRL*(NZ_ROW+2) + SUBMEM = SUBMEM + 6*NRL + IPEAKMEM = max(HOSTMEM, SUBMEM) + IF((IPEAKMEM .GT. PEAKMEM) .AND. + & (PEAKMEM .NE. 0)) THEN + ZMUMPS_793 = .TRUE. + RETURN + ELSE + ZMUMPS_793 = .FALSE. + PEAKMEM = IPEAKMEM + RETURN + END IF + END FUNCTION ZMUMPS_793 + FUNCTION ZMUMPS_779(NODE, ord) + IMPLICIT NONE + INTEGER :: ZMUMPS_779 + INTEGER :: NODE + TYPE(ORD_TYPE) :: ord + INTEGER :: CURR + ZMUMPS_779 = 0 + IF(ord%SON(NODE) .EQ. -1) THEN + RETURN + ELSE + ZMUMPS_779 = 1 + CURR = ord%SON(NODE) + DO + IF(ord%BROTHER(CURR) .NE. -1) THEN + ZMUMPS_779 = ZMUMPS_779+1 + CURR = ord%BROTHER(CURR) + ELSE + EXIT + END IF + END DO + END IF + RETURN + END FUNCTION ZMUMPS_779 + SUBROUTINE ZMUMPS_781(ord, id) + USE TOOLS_COMMON + IMPLICIT NONE + TYPE(ORD_TYPE) :: ord + TYPE(ZMUMPS_STRUC) :: id + INTEGER, ALLOCATABLE :: ALIST(:), AWEIGHTS(:), LIST(:), WORK(:) + INTEGER :: NNODES, BIG, CURR, ND, NACTIVE, RPROC, ANODE, BASE, I, + & NK, PEAKMEM + LOGICAL :: SD + NNODES = ord%NSLAVES + ALLOCATE(ALIST(NNODES), AWEIGHTS(NNODES), LIST(NNODES), + & WORK(0:NNODES+1)) + ALIST(1) = ord%CBLKNBR + AWEIGHTS(1) = ord%NW(ord%CBLKNBR) + NACTIVE = 1 + RPROC = NNODES + ANODE = 0 + PEAKMEM = 0 + CALL MUMPS_733(ord%TOPNODES, 2*max(NNODES,2), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%FIRST, id%NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ord%LAST, id%NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')ord%myid,'MEMCNT topnodes:',MEMCNT, + & MAXMEM +#endif + ord%TOPNODES = 0 + IF((ord%CBLKNBR .EQ. 1) .OR. + & ( RPROC .LT. ZMUMPS_779(ord%CBLKNBR, ord) )) THEN + ord%TOPNODES(1) = 1 + ord%TOPNODES(2) = ord%RANGTAB(ord%CBLKNBR+1) - ord%RANGTAB(1) + ord%TOPNODES(3) = ord%RANGTAB(1) + ord%TOPNODES(4) = ord%RANGTAB(ord%CBLKNBR+1)-1 + ord%FIRST = 0 + ord%LAST = -1 + RETURN + END IF + DO + IF(NACTIVE .EQ. 0) EXIT + BIG = ALIST(NACTIVE) + NK = ZMUMPS_779(BIG, ord) + IF((NK .GT. (RPROC-NACTIVE+1)) .OR. (NK .EQ. 0)) THEN + ANODE = ANODE+1 + LIST(ANODE) = BIG + NACTIVE = NACTIVE-1 + RPROC = RPROC-1 + CYCLE + END IF + SD = ZMUMPS_793(id, ord, NACTIVE, ANODE, + & RPROC, ALIST, LIST, PEAKMEM, NNODES, CHECKMEM=.TRUE.) + IF ( SD ) + & THEN + IF(NACTIVE.GT.0) THEN + LIST(ANODE+1:ANODE+NACTIVE) = ALIST(1:NACTIVE) + ANODE = ANODE+NACTIVE + END IF + EXIT + END IF + ord%TOPNODES(1) = ord%TOPNODES(1)+1 + ord%TOPNODES(2) = ord%TOPNODES(2) + + & ord%RANGTAB(BIG+1) - ord%RANGTAB(BIG) + ord%TOPNODES(2+2*(ord%TOPNODES(1)-1)+1) = ord%RANGTAB(BIG) + ord%TOPNODES(2+2*(ord%TOPNODES(1)-1)+2) = + & ord%RANGTAB(BIG+1)-1 + CURR = ord%SON(BIG) + ALIST(NACTIVE) = CURR + AWEIGHTS(NACTIVE) = ord%NW(CURR) + DO + IF(ord%BROTHER(CURR) .EQ. -1) EXIT + NACTIVE = NACTIVE+1 + CURR = ord%BROTHER(CURR) + ALIST(NACTIVE) = CURR + AWEIGHTS(NACTIVE) = ord%NW(CURR) + END DO + CALL ZMUMPS_783(NACTIVE, AWEIGHTS(1:NACTIVE), + & WORK(0:NACTIVE+1)) + CALL ZMUMPS_784(NACTIVE, WORK(0:NACTIVE+1), + & AWEIGHTS(1:NACTIVE), + & ALIST(1:NACTIVE)) + END DO + DO I=1, ANODE + AWEIGHTS(I) = ord%NW(LIST(I)) + END DO + CALL ZMUMPS_783(ANODE, AWEIGHTS(1:ANODE), WORK(0:ANODE+1)) + CALL ZMUMPS_784(ANODE, WORK(0:ANODE+1), AWEIGHTS(1:ANODE), + & ALIST(1:ANODE)) + IF (id%KEEP(46) .EQ. 1) THEN + BASE = 0 + ELSE + ord%FIRST(1) = 0 + ord%LAST(1) = -1 + BASE = 1 + END IF + DO I=1, ANODE + CURR = LIST(I) + ND = CURR + IF(ord%SON(ND) .NE. -1) THEN + ND = ord%SON(ND) + DO + IF((ord%SON(ND) .EQ. -1) .AND. + & (ord%BROTHER(ND).EQ.-1)) THEN + EXIT + ELSE IF(ord%BROTHER(ND) .EQ. -1) THEN + ND = ord%SON(ND) + ELSE + ND = ord%BROTHER(ND) + END IF + END DO + END IF + ord%FIRST(BASE+I) = ord%RANGTAB(ND) + ord%LAST(BASE+I) = ord%RANGTAB(CURR+1)-1 + END DO + DO I=ANODE+1, id%NSLAVES + ord%FIRST(BASE+I) = id%N+1 + ord%LAST(BASE+I) = id%N + END DO + DEALLOCATE(LIST, ALIST, AWEIGHTS, WORK) + RETURN + END SUBROUTINE ZMUMPS_781 + SUBROUTINE ZMUMPS_720(id, ord, GPE, GNV, WORK) + IMPLICIT NONE + TYPE(ZMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + INTEGER, POINTER :: GPE(:), GNV(:) + INTEGER, POINTER :: WORK(:) + TYPE(GRAPH_TYPE) :: top_graph + INTEGER, POINTER :: PE(:), IPE(:), + & LENG(:), I_HALO_MAP(:) + INTEGER, POINTER :: NDENSE(:), LAST(:), + & DEGREE(:), W(:), PERM(:), + & LISTVAR_SCHUR(:), NEXT(:), + & HEAD(:), NV(:), ELEN(:), + & RCVCNT(:), LSTVAR(:) + INTEGER, POINTER :: NROOTS(:), MYLIST(:), + & MYNVAR(:), LVARPT(:), + & DISPLS(:), LPERM(:), + & LIPERM(:), + & IPET(:), NVT(:), BUF_PE1(:), + & BUF_PE2(:), BUF_NV1(:), + & BUF_NV2(:), ROOTPERM(:), + & TMP1(:), TMP2(:), BWORK(:) + INTEGER :: HIDX, NCMPA, I, J, SIZE_SCHUR, MYID, + & NPROCS, IERR, NROWS_LOC, GLOB_IDX, MYNROOTS, PNT, TMP, + & NCLIQUES, NTVAR, PFREES, PFREET, TGSIZE, MAXS, RHANDPE, + & RHANDNV, STATUSPE(MPI_STATUS_SIZE), + & STATUSNV(MPI_STATUS_SIZE), RIDX, PROC, NBBUCK, + & PFS_SAVE, PFT_SAVE + LOGICAL :: AGG6 + INTEGER :: THRESH + nullify(PE, IPE, LENG, I_HALO_MAP) + nullify(NDENSE, LAST, DEGREE, W, PERM, LISTVAR_SCHUR, + & NEXT, HEAD, NV, ELEN, RCVCNT, LSTVAR) + nullify(NROOTS, MYLIST, MYNVAR, LVARPT, DISPLS, + & LPERM, LIPERM, IPET, NVT, BUF_PE1, BUF_PE2, + & BUF_NV1, BUF_NV2, ROOTPERM, TMP1, TMP2, BWORK) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. 4*id%N) THEN + WRITE(LP,*)'Insufficient workspace in ZMUMPS_720' + CALL MUMPS_ABORT() + ELSE + HEAD => WORK( 1 : id%N) + ELEN => WORK( id%N+1 : 2*id%N) + LENG => WORK(2*id%N+1 : 3*id%N) + PERM => WORK(3*id%N+1 : 4*id%N) + END IF + CALL ZMUMPS_781(ord, id) + CALL MUMPS_734(ord%SON, ord%BROTHER, ord%NW, + & ord%RANGTAB, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))') myid,'deall son:',MEMCNT,MAXMEM +#endif + NROWS_LOC = ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1 + NRL = NROWS_LOC + TOPROWS = ord%TOPNODES(2) + BWORK => WORK(1 : 2*id%N) + CALL ZMUMPS_775(id, ord, HIDX, IPE, PE, LENG, + & I_HALO_MAP, top_graph, BWORK) + TMP = id%N + DO I=1, NPROCS + TMP = TMP-(ord%LAST(I)-ord%FIRST(I)+1) + END DO + TMP = ceiling(dble(TMP)*1.10D0) + IF(MYID .EQ. 0) THEN + TMP = max(max(TMP, HIDX),1) + ELSE + TMP = max(HIDX,1) + END IF + SIZE_SCHUR = HIDX - NROWS_LOC + CALL MUMPS_733(NDENSE, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NEXT, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(DEGREE, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(W, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NV, TMP, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LISTVAR_SCHUR, max(SIZE_SCHUR,1), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT allsub:',MEMCNT,MAXMEM +#endif + DO I=1, SIZE_SCHUR + LISTVAR_SCHUR(I) = NROWS_LOC+I + END DO + THRESH = -1 + AGG6 = .TRUE. + PFREES = IPE(NROWS_LOC+1) + PFS_SAVE = PFREES + IF (ord%SUBSTRAT .EQ. 0) THEN + DO I=1, HIDX + PERM(I) = I + END DO + CALL MUMPS_420(1, THRESH, NDENSE(1), HIDX, + & MUMPS_795(PE), IPE(1), PFREES, LENG(1), PE(1), NV(1), + & ELEN(1), LAST(1), NCMPA, DEGREE(1), HEAD(1), NEXT(1), + & W(1), PERM(1), LISTVAR_SCHUR(1), SIZE_SCHUR, AGG6) + ELSE + NBBUCK = 2*TMP + CALL MUMPS_419 (ord%SUBSTRAT, 1, .FALSE., HIDX, NBBUCK, + & MUMPS_795(PE), IPE(1), PFREES, LENG(1), PE(1), NV(1), + & ELEN(1), LAST(1), NCMPA, DEGREE(1), PERM(1), NEXT(1), + & W(1), HEAD(1), AGG6, SIZE_SCHUR, LISTVAR_SCHUR(1) ) + DO I=1, HIDX + PERM(I) = I + END DO + END IF + CALL MUMPS_733(W, 2*NPROCS, id%INFO, + & LP, STRING='W', MEMCNT=MEMCNT, ERRCODE=-7) + if(MEMCNT .gt. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT w:',MEMCNT,MAXMEM +#endif + NROOTS => W + DISPLS => W(NPROCS+1:2*NPROCS) + MYNVAR => DEGREE + MYLIST => NDENSE + LVARPT => NEXT + RCVCNT => HEAD + LSTVAR => LAST + NULLIFY(W, DEGREE, NDENSE, NEXT, HEAD, LAST) + MYNROOTS = 0 + PNT = 0 + DO I=1, HIDX + IF(IPE(I) .GT. 0) THEN + PNT = PNT+LENG(I) + MYNROOTS = MYNROOTS+1 + END IF + END DO + CALL MUMPS_733(MYLIST, PNT, id%INFO, + & LP, STRING='MYLIST', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT mylist:',MEMCNT,MAXMEM +#endif + MYNROOTS = 0 + PNT = 0 + DO I=1, HIDX + IF(IPE(I) .GT. 0) THEN + MYNROOTS = MYNROOTS+1 + MYNVAR(MYNROOTS) = LENG(I) + DO J=1, LENG(I) + MYLIST(PNT+J) = I_HALO_MAP(PE(IPE(I)+J-1)-NROWS_LOC) + END DO + PNT = PNT+LENG(I) + END IF + END DO + CALL MPI_BARRIER(id%COMM, IERR) + CALL MPI_GATHER(MYNROOTS, 1, MPI_INTEGER, NROOTS(1), 1, + & MPI_INTEGER, 0, id%COMM, IERR) + IF(MYID .EQ.0) THEN + DISPLS(1) = 0 + DO I=2, NPROCS + DISPLS(I) = DISPLS(I-1)+NROOTS(I-1) + END DO + NCLIQUES = sum(NROOTS(1:NPROCS)) + CALL MUMPS_733(LVARPT, NCLIQUES+1, id%INFO, + & LP, STRING='LVARPT', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT + ELSE + CALL MUMPS_733(LVARPT, 2, id%INFO, + & LP, STRING='LVARPT', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT + END IF +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT lvarpt:',MEMCNT,MAXMEM +#endif + CALL MPI_GATHERV(MYNVAR(1), MYNROOTS, MPI_INTEGER, LVARPT(2), + & NROOTS(1), DISPLS(1), MPI_INTEGER, 0, id%COMM, IERR) + IF(MYID .EQ. 0) THEN + DO I=1, NPROCS + RCVCNT(I) = sum(LVARPT(2+DISPLS(I):2+DISPLS(I)+NROOTS(I)-1)) + IF(I .EQ. 1) THEN + DISPLS(I) = 0 + ELSE + DISPLS(I) = DISPLS(I-1)+RCVCNT(I-1) + END IF + END DO + CALL MUMPS_733(LSTVAR, sum(RCVCNT(1:NPROCS)), id%INFO, + & LP, STRING='LSTVAR', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT lstvar:',MEMCNT,MAXMEM +#endif + END IF + CALL MPI_GATHERV(MYLIST(1), PNT, MPI_INTEGER, LSTVAR(1), + & RCVCNT(1), DISPLS(1), MPI_INTEGER, 0, id%COMM, IERR) + NULLIFY(DISPLS) + IF(MYID .EQ. 0) THEN + LVARPT(1) = 1 + DO I=2, NCLIQUES+1 + LVARPT(I) = LVARPT(I-1) + LVARPT(I) + END DO + LPERM => WORK(3*id%N+1 : 4*id%N) + NTVAR = ord%TOPNODES(2) + CALL ZMUMPS_782(id, ord%TOPNODES, LPERM, LIPERM, ord) + CALL ZMUMPS_774(id, ord%TOPNODES(2), LPERM, + & top_graph, NCLIQUES, LSTVAR, LVARPT, IPET, PE, LENG, ELEN) + TGSIZE = ord%TOPNODES(2)+NCLIQUES + PFREET = IPET(TGSIZE+1) + PFT_SAVE = PFREET + nullify(LPERM) + CALL MUMPS_734(top_graph%IRN_LOC, + & top_graph%JCN_LOC, ord%TOPNODES, MEMCNT=MEMCNT) + W => NROOTS + DEGREE => MYNVAR + NDENSE => MYLIST + NEXT => LVARPT + HEAD => RCVCNT + LAST => LSTVAR + NULLIFY(NROOTS, MYNVAR, MYLIST, LVARPT, RCVCNT, LSTVAR) + CALL MUMPS_733(PE, max(PFREET+TGSIZE,1), id%INFO, LP, + & COPY=.TRUE., STRING='J2:PE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NDENSE, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:NDENSE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NVT, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:NVT', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LAST, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:LAST', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(DEGREE, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:DEGREE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(NEXT, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:NEXT', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(W, max(TGSIZE,1), id%INFO, LP, + & STRING='J2:W', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LISTVAR_SCHUR, max(NCLIQUES,1), id%INFO, LP, + & STRING='J2:LVSCH', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT pe:',MEMCNT,MAXMEM +#endif + DO I=1, NCLIQUES + LISTVAR_SCHUR(I) = NTVAR+I + END DO + THRESH = -1 + IF(ord%TOPSTRAT .EQ. 0) THEN + CALL MUMPS_733(HEAD, max(TGSIZE,1), id%INFO, + & LP, STRING='J2:HEAD', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(PERM, max(TGSIZE,1), id%INFO, + & LP, COPY=.TRUE., STRING='J2:PERM', + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rehead:',MEMCNT,MAXMEM +#endif + DO I=1, TGSIZE + PERM(I) = I + END DO + CALL MUMPS_420(2, -1, NDENSE(1), TGSIZE, + & MUMPS_795(PE), IPET(1), PFREET, LENG(1), PE(1), + & NVT(1), ELEN(1), LAST(1), NCMPA, DEGREE(1), HEAD(1), + & NEXT(1), W(1), PERM(1), LISTVAR_SCHUR(1), NCLIQUES, + & AGG6) + ELSE + NBBUCK = 2*TGSIZE + CALL MUMPS_733(HEAD, NBBUCK+2, id%INFO, + & LP, STRING='J2:HEAD', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(PERM, TGSIZE, id%INFO, + & LP, STRING='J2:PERM', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rehead:',MEMCNT,MAXMEM +#endif + CALL MUMPS_419 (ord%TOPSTRAT, 2, .FALSE., TGSIZE, + & NBBUCK, MUMPS_795(PE), IPET(1), PFREET, LENG(1), + & PE(1), NVT(1), ELEN(1), LAST(1), NCMPA, DEGREE(1), + & PERM(1), NEXT(1), W(1), HEAD(1), AGG6, NCLIQUES, + & LISTVAR_SCHUR(1) ) + END IF + END IF + CALL MPI_BARRIER(id%COMM, IERR) + CALL MUMPS_734(LISTVAR_SCHUR, PE, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall lvs:',MEMCNT,MAXMEM +#endif + IF(MYID .EQ. 0) THEN + BUF_PE1 => WORK( 1 : id%N) + BUF_PE2 => WORK( id%N+1 : 2*id%N) + BUF_NV1 => WORK(2*id%N+1 : 3*id%N) + BUF_NV2 => WORK(3*id%N+1 : 4*id%N) + MAXS = NROWS_LOC + DO I=2, NPROCS + IF((ord%LAST(I)-ord%FIRST(I)+1) .GT. MAXS) + & MAXS = (ord%LAST(I)-ord%FIRST(I)+1) + END DO + CALL MUMPS_733(BUF_PE1, MAXS, id%INFO, + & LP, STRING='BUF_PE1', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(BUF_PE2, MAXS, id%INFO, + & LP, STRING='BUF_PE2', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(BUF_NV1, MAXS, id%INFO, + & LP, STRING='BUF_NV1', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(BUF_NV2, MAXS, id%INFO, + & LP, STRING='BUF_NV2', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(GPE, id%N, id%INFO, + & LP, STRING='GPE', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(GNV, id%N, id%INFO, + & LP, STRING='GNV', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ROOTPERM, NCLIQUES, id%INFO, + & LP, STRING='ROOTPERM', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT buf_pe1:',MEMCNT, + & MAXMEM +#endif + RIDX = 0 + TMP1 => BUF_PE1 + TMP2 => BUF_NV1 + NULLIFY(BUF_PE1, BUF_NV1) + BUF_PE1 => IPE + BUF_NV1 => NV + DO PROC=0, NPROCS-2 + CALL MPI_IRECV(BUF_PE2(1), ord%LAST(PROC+2)- + & ord%FIRST(PROC+2)+1, MPI_INTEGER, PROC+1, PROC+1, + & id%COMM, RHANDPE, IERR) + CALL MPI_IRECV(BUF_NV2(1), ord%LAST(PROC+2)- + & ord%FIRST(PROC+2)+1, MPI_INTEGER, PROC+1, PROC+1, + & id%COMM, RHANDNV, IERR) + DO I=1, ord%LAST(PROC+1)-ord%FIRST(PROC+1)+1 + GLOB_IDX = ord%PERITAB(I+ord%FIRST(PROC+1)-1) + IF(BUF_PE1(I) .GT. 0) THEN + RIDX=RIDX+1 + ROOTPERM(RIDX) = GLOB_IDX + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE IF (BUF_PE1(I) .EQ. 0) THEN + GPE(GLOB_IDX) = 0 + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE + GPE(GLOB_IDX) = -ord%PERITAB(-BUF_PE1(I)+ + & ord%FIRST(PROC+1)-1) + GNV(GLOB_IDX) = BUF_NV1(I) + END IF + END DO + CALL MPI_WAIT(RHANDPE, STATUSPE, IERR) + CALL MPI_WAIT(RHANDNV, STATUSNV, IERR) + IF(PROC .NE. 0) THEN + TMP1 => BUF_PE1 + TMP2 => BUF_NV1 + END IF + BUF_PE1 => BUF_PE2 + BUF_NV1 => BUF_NV2 + NULLIFY(BUF_PE2, BUF_NV2) + BUF_PE2 => TMP1 + BUF_NV2 => TMP2 + NULLIFY(TMP1, TMP2) + END DO + DO I=1, ord%LAST(PROC+1)-ord%FIRST(PROC+1)+1 + GLOB_IDX = ord%PERITAB(I+ord%FIRST(PROC+1)-1) + IF(BUF_PE1(I) .GT. 0) THEN + RIDX=RIDX+1 + ROOTPERM(RIDX) = GLOB_IDX + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE IF (BUF_PE1(I) .EQ. 0) THEN + GPE(GLOB_IDX) = 0 + GNV(GLOB_IDX) = BUF_NV1(I) + ELSE + GPE(GLOB_IDX) = -ord%PERITAB(-BUF_PE1(I)+ + & ord%FIRST(PROC+1)-1) + GNV(GLOB_IDX) = BUF_NV1(I) + END IF + END DO + DO I=1, NTVAR + GLOB_IDX = LIPERM(I) + IF(IPET(I) .EQ. 0) THEN + GPE(GLOB_IDX) = 0 + GNV(GLOB_IDX) = NVT(I) + ELSE + GPE(GLOB_IDX) = -LIPERM(-IPET(I)) + GNV(GLOB_IDX) = NVT(I) + END IF + END DO + DO I=1, NCLIQUES + GLOB_IDX = ROOTPERM(I) + GPE(GLOB_IDX) = -LIPERM(-IPET(NTVAR+I)) + END DO + ELSE + CALL MPI_SEND(IPE(1), ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1, + & MPI_INTEGER, 0, MYID, id%COMM, IERR) + CALL MPI_SEND(NV(1), ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1, + & MPI_INTEGER, 0, MYID, id%COMM, IERR) + END IF + CALL MUMPS_734(PE, IPE, I_HALO_MAP, NDENSE, + & LAST, DEGREE, MEMCNT=MEMCNT) + CALL MUMPS_734(W, LISTVAR_SCHUR, NEXT, + & NV, MEMCNT=MEMCNT) + CALL MUMPS_734(LSTVAR, NROOTS, MYLIST, MYNVAR, + & LVARPT, MEMCNT=MEMCNT) + CALL MUMPS_734(LPERM, LIPERM, IPET, NVT, + & MEMCNT=MEMCNT) + CALL MUMPS_734(ROOTPERM, TMP1, TMP2, MEMCNT=MEMCNT) + NULLIFY(HEAD, ELEN, LENG, PERM, RCVCNT) + RETURN + END SUBROUTINE ZMUMPS_720 + SUBROUTINE ZMUMPS_782(id, TOPNODES, LPERM, LIPERM, ord) + IMPLICIT NONE + TYPE(ZMUMPS_STRUC) :: id + INTEGER, POINTER :: TOPNODES(:), LPERM(:), LIPERM(:) + TYPE(ORD_TYPE) :: ord + INTEGER :: I, J, K, GIDX + CALL MUMPS_733(LPERM , ord%N, id%INFO, + & LP, STRING='LIDX:LPERM', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(LIPERM, TOPNODES(2), id%INFO, + & LP, STRING='LIDX:LIPERM', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')id%myid,'MEMCNT lperm:',MEMCNT, + & MAXMEM +#endif + LPERM = 0 + K = 1 + DO I=1, TOPNODES(1) + DO J=TOPNODES(2*I+1), TOPNODES(2*I+2) + GIDX = ord%PERITAB(J) + LPERM(GIDX) = K + LIPERM(K) = GIDX + K = K+1 + END DO + END DO + RETURN + END SUBROUTINE ZMUMPS_782 + SUBROUTINE ZMUMPS_774(id, NLOCVARS, LPERM, + & top_graph, NCLIQUES, LSTVAR, LVARPT, IPE, PE, LENG, ELEN) + IMPLICIT NONE + TYPE(ZMUMPS_STRUC) :: id + TYPE(GRAPH_TYPE) :: top_graph + INTEGER, POINTER :: LPERM(:), LSTVAR(:), LVARPT(:), + & IPE(:), PE(:), LENG(:), ELEN(:) + INTEGER :: NCLIQUES + INTEGER :: I, J, IDX, NLOCVARS, PNT, SAVEPNT + CALL MUMPS_733(LENG, max(NLOCVARS+NCLIQUES,1) , id%INFO, + & LP, STRING='ATG:LENG', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(ELEN, max(NLOCVARS+NCLIQUES,1) , id%INFO, + & LP, STRING='ATG:ELEN', MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(IPE , NLOCVARS+NCLIQUES+1, id%INFO, + & LP, STRING='ATG:IPE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')id%myid,'MEMCNT leng:',MEMCNT, + & MAXMEM +#endif + LENG = 0 + ELEN = 0 + DO I=1, top_graph%NZ_LOC + IF((LPERM(top_graph%JCN_LOC(I)) .NE. 0) .AND. + & (top_graph%JCN_LOC(I) .NE. top_graph%IRN_LOC(I))) THEN + LENG(LPERM(top_graph%IRN_LOC(I))) = + & LENG(LPERM(top_graph%IRN_LOC(I))) + 1 + END IF + END DO + DO I=1, NCLIQUES + DO J=LVARPT(I), LVARPT(I+1)-1 + ELEN(LPERM(LSTVAR(J))) = ELEN(LPERM(LSTVAR(J)))+1 + LENG(NLOCVARS+I) = LENG(NLOCVARS+I)+1 + END DO + END DO + IPE(1) = 1 + DO I=1, NLOCVARS+NCLIQUES + IPE(I+1) = IPE(I)+LENG(I)+ELEN(I) + END DO + CALL MUMPS_733(PE, IPE(NLOCVARS+NCLIQUES+1)+NLOCVARS+NCLIQUES, + & id%INFO, LP, STRING='ATG:PE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')id%myid,'MEMCNT repe:',MEMCNT, + & MAXMEM +#endif + LENG = 0 + ELEN = 0 + DO I=1, NCLIQUES + DO J=LVARPT(I), LVARPT(I+1)-1 + IDX = LPERM(LSTVAR(J)) + PE(IPE(IDX)+ELEN(IDX)) = NLOCVARS+I + PE(IPE(NLOCVARS+I)+LENG(NLOCVARS+I)) = IDX + ELEN(LPERM(LSTVAR(J))) = ELEN(LPERM(LSTVAR(J)))+1 + LENG(NLOCVARS+I) = LENG(NLOCVARS+I)+1 + end do + end do + DO I=1, top_graph%NZ_LOC + IF((LPERM(top_graph%JCN_LOC(I)) .NE. 0) .AND. + & (top_graph%JCN_LOC(I) .NE. top_graph%IRN_LOC(I))) THEN + PE(IPE(LPERM(top_graph%IRN_LOC(I)))+ + & ELEN(LPERM(top_graph%IRN_LOC(I))) + + & LENG(LPERM(top_graph%IRN_LOC(I)))) = + & LPERM(top_graph%JCN_LOC(I)) + LENG(LPERM(top_graph%IRN_LOC(I))) = + & LENG(LPERM(top_graph%IRN_LOC(I))) + 1 + END IF + END DO + DO I=1, NLOCVARS+NCLIQUES + LENG(I) = LENG(I)+ELEN(I) + END DO + SAVEPNT = 1 + PNT = 0 + LPERM(1:NLOCVARS+NCLIQUES) = 0 + DO I=1, NLOCVARS+NCLIQUES + DO J=IPE(I), IPE(I+1)-1 + IF(LPERM(PE(J)) .EQ. I) THEN + LENG(I) = LENG(I)-1 + ELSE + LPERM(PE(J)) = I + PNT = PNT+1 + PE(PNT) = PE(J) + END IF + END DO + IPE(I) = SAVEPNT + SAVEPNT = PNT+1 + END DO + IPE(NLOCVARS+NCLIQUES+1) = SAVEPNT + RETURN + END SUBROUTINE ZMUMPS_774 + SUBROUTINE ZMUMPS_778(TREETAB, RANGTAB, SIZES, CBLKNBR) + INTEGER, POINTER :: TREETAB(:), RANGTAB(:), SIZES(:) + INTEGER :: CBLKNBR + INTEGER :: LCHILD, RCHILD, K, I + INTEGER, POINTER :: PERM(:) + ALLOCATE(PERM(CBLKNBR)) + TREETAB(CBLKNBR) = -1 + IF(CBLKNBR .EQ. 1) THEN + DEALLOCATE(PERM) + TREETAB(1) = -1 + RANGTAB(1:2) = (/1, SIZES(1)+1/) + RETURN + END IF + LCHILD = CBLKNBR - (CBLKNBR+1)/2 + RCHILD = CBLKNBR-1 + K = 1 + PERM(CBLKNBR) = CBLKNBR + PERM(LCHILD) = CBLKNBR+1 - (2*K+1) + PERM(RCHILD) = CBLKNBR+1 - (2*K) + TREETAB(RCHILD) = CBLKNBR + TREETAB(LCHILD) = CBLKNBR + IF(CBLKNBR .GT. 3) THEN + CALL REC_TREETAB(TREETAB, PERM, (CBLKNBR-1)/2, + & LCHILD, CBLKNBR, 2*K+1) + CALL REC_TREETAB(TREETAB, PERM, (CBLKNBR-1)/2, + & RCHILD, CBLKNBR, 2*K) + END IF + RANGTAB(1)=1 + DO I=1, CBLKNBR + RANGTAB(I+1) = RANGTAB(I)+SIZES(PERM(I)) + END DO + DEALLOCATE(PERM) + RETURN + CONTAINS + RECURSIVE SUBROUTINE REC_TREETAB(TREETAB, PERM, SUBNODES, + & ROOTN, CBLKNBR, K) + INTEGER, POINTER :: TREETAB(:), PERM(:) + INTEGER :: SUBNODES, ROOTN, K, CBLKNBR + INTEGER :: LCHILD, RCHILD + LCHILD = ROOTN - (SUBNODES+1)/2 + RCHILD = ROOTN-1 + PERM(LCHILD) = CBLKNBR+1 - (2*K+1) + PERM(RCHILD) = CBLKNBR+1 - (2*K) + TREETAB(RCHILD) = ROOTN + TREETAB(LCHILD) = ROOTN + IF(SUBNODES .GT. 3) THEN + CALL REC_TREETAB(TREETAB, PERM, (SUBNODES-1)/2, LCHILD, + & CBLKNBR, 2*K+1) + CALL REC_TREETAB(TREETAB, PERM, (SUBNODES-1)/2, RCHILD, + & CBLKNBR, 2*K) + END IF + END SUBROUTINE REC_TREETAB + END SUBROUTINE ZMUMPS_778 + SUBROUTINE ZMUMPS_776(id, FIRST, LAST, IPE, + & PE, WORK) + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(ZMUMPS_STRUC) :: id + INTEGER, POINTER :: FIRST(:), LAST(:), IPE(:), PE(:), + & WORK(:) + INTEGER :: IERR, MYID, NPROCS + INTEGER :: I, PROC, LOCNNZ, + & NEW_LOCNNZ, J, LOC_ROW + INTEGER :: TOP_CNT, TIDX, + & NROWS_LOC, DUPS, TOTDUPS, OFFDIAG + INTEGER :: STATUS(MPI_STATUS_SIZE) + INTEGER, POINTER :: MAPTAB(:), + & SNDCNT(:), RCVCNT(:), SDISPL(:) + INTEGER, POINTER :: RDISPL(:), + & MSGCNT(:), SIPES(:,:), LENG(:) + INTEGER, POINTER :: PCNT(:), TSENDI(:), + & TSENDJ(:), RCVBUF(:) + TYPE(ARRPNT), POINTER :: APNT(:) + INTEGER :: BUFSIZE, SOURCE, RCVPNT, MAXS, PNT, + & SAVEPNT + INTEGER, PARAMETER :: ITAG=30 + LOGICAL :: FLAG + DOUBLE PRECISION :: SYMMETRY + nullify(MAPTAB, SNDCNT, RCVCNT, SDISPL) + nullify(RDISPL, MSGCNT, SIPES, LENG) + nullify(PCNT, TSENDI, TSENDJ, RCVBUF, APNT) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. id%N*2) THEN + WRITE(LP, + & '("Insufficient workspace inside BUILD_SCOTCH_GRAPH")') + CALL MUMPS_ABORT() + END IF + CALL MUMPS_733(SNDCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(RCVCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(MSGCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT sndcnt:',MEMCNT,MAXMEM +#endif + ALLOCATE(APNT(NPROCS)) + SNDCNT = 0 + TOP_CNT = 0 + BUFSIZE = 1000 + LOCNNZ = id%NZ_loc + NROWS_LOC = LAST(MYID+1)-FIRST(MYID+1)+1 + MAPTAB => WORK( 1 : id%N) + LENG => WORK(id%N+1 : 2*id%N) + MAXS = 0 + DO I=1, NPROCS + IF((LAST(I)-FIRST(I)+1) .GT. MAXS) THEN + MAXS = LAST(I)-FIRST(I)+1 + END IF + DO J=FIRST(I), LAST(I) + MAPTAB(J) = I + END DO + END DO + ALLOCATE(SIPES(max(1,MAXS), NPROCS)) + OFFDIAG=0 + SIPES=0 + DO I=1, id%NZ_loc + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + OFFDIAG = OFFDIAG+1 + PROC = MAPTAB(id%IRN_loc(I)) + LOC_ROW = id%IRN_loc(I)-FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + PROC = MAPTAB(id%JCN_loc(I)) + LOC_ROW = id%JCN_loc(I)-FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + END IF + END DO + CALL MPI_ALLREDUCE (OFFDIAG, id%KEEP(114), 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR) + id%KEEP(114) = id%KEEP(114)+3*id%N + id%KEEP(113) = id%KEEP(114)-2*id%N + CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, id%COMM, IERR) + SNDCNT(:) = MAXS + CALL MPI_REDUCE_SCATTER ( SIPES(1,1), LENG(1), SNDCNT(1), + & MPI_INTEGER, MPI_SUM, id%COMM, IERR ) + DEALLOCATE(SIPES) + CALL MUMPS_733(IPE, NROWS_LOC+1, id%INFO, + & LP, STRING='IPE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT ripe:',MEMCNT,MAXMEM +#endif + IPE(1) = 1 + DO I=1, NROWS_LOC + IPE(I+1) = IPE(I) + LENG(I) + END DO + CALL MUMPS_733(PE, max(IPE(NROWS_LOC+1)-1,1), id%INFO, + & LP, STRING='PE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rrpe:',MEMCNT,MAXMEM +#endif + LENG(:) = 0 + CALL ZMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, LENG, + & RCVBUF, MSGCNT, SNDCNT, id%COMM) + NEW_LOCNNZ = sum(RCVCNT) + DO I=1, NPROCS + MSGCNT(I) = RCVCNT(I)/BUFSIZE + END DO + RCVPNT = 1 + SNDCNT = 0 + TIDX = 0 + DO I=1, id%NZ_loc + IF(mod(I,BUFSIZE/10) .EQ. 0) THEN + CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, MPI_COMM_WORLD, + & FLAG, STATUS, IERR ) + IF(FLAG) THEN + SOURCE = STATUS(MPI_SOURCE) + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, SOURCE, + & ITAG, MPI_COMM_WORLD, STATUS, IERR) + CALL ZMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + RCVPNT = RCVPNT + BUFSIZE + END IF + END IF + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + PROC = MAPTAB(id%IRN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) = id%IRN_loc(I)- + & FIRST(PROC)+1 + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = id%JCN_loc(I) + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL ZMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, + & PE, LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + PROC = MAPTAB(id%JCN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) = id%JCN_loc(I)- + & FIRST(PROC)+1 + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = id%IRN_loc(I) + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL ZMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, + & PE, LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + END IF + END DO + CALL ZMUMPS_785(APNT, -1, NPROCS, BUFSIZE, IPE, PE, LENG, + & RCVBUF, MSGCNT, SNDCNT, id%COMM) + DUPS = 0 + PNT = 0 + SAVEPNT = 1 + MAPTAB = 0 + DO I=1, NROWS_LOC + DO J=IPE(I),IPE(I+1)-1 + IF(MAPTAB(PE(J)) .EQ. I) THEN + DUPS = DUPS+1 + ELSE + MAPTAB(PE(J)) = I + PNT = PNT+1 + PE(PNT) = PE(J) + END IF + END DO + IPE(I) = SAVEPNT + SAVEPNT = PNT+1 + END DO + CALL MPI_REDUCE( DUPS, TOTDUPS, 1, MPI_INTEGER, MPI_SUM, + & 0, id%COMM, IERR ) + SYMMETRY = dble(TOTDUPS)/(dble(id%NZ)-dble(id%N)) + IF(MYID .EQ. 0) THEN + IF(id%KEEP(50) .GE. 1) SYMMETRY = 1.d0 + IF(PROKG) WRITE(MPG,'("Structual symmetry is:",i3,"%")') + & ceiling(SYMMETRY*100.d0) + id%INFOG(8) = ceiling(SYMMETRY*100.0d0) + END IF + IPE(NROWS_LOC+1) = SAVEPNT + CALL MUMPS_734(SNDCNT, RCVCNT, MSGCNT, MEMCNT=MEMCNT) + DEALLOCATE(APNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall sndcnt:',MEMCNT,MAXMEM +#endif + RETURN + END SUBROUTINE ZMUMPS_776 + SUBROUTINE ZMUMPS_775(id, ord, GSIZE, IPE, PE, LENG, + & I_HALO_MAP, top_graph, WORK) + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(ZMUMPS_STRUC) :: id + TYPE(ORD_TYPE) :: ord + TYPE(GRAPH_TYPE) :: top_graph + INTEGER, POINTER :: IPE(:), PE(:), LENG(:), + & I_HALO_MAP(:), WORK(:) + INTEGER :: GSIZE + INTEGER :: IERR, MYID, NPROCS + INTEGER :: I, PROC, LOCNNZ, + & NEW_LOCNNZ, J, LOC_ROW + INTEGER :: TOP_CNT,IIDX,JJDX + INTEGER :: HALO_SIZE, TIDX, NROWS_LOC, DUPS + INTEGER :: STATUS(MPI_STATUS_SIZE) + INTEGER, POINTER :: MAPTAB(:), + & SNDCNT(:), RCVCNT(:), + & SDISPL(:), HALO_MAP(:) + INTEGER, POINTER :: RDISPL(:), + & MSGCNT(:), SIPES(:,:) + INTEGER, POINTER :: PCNT(:), TSENDI(:), + & TSENDJ(:), RCVBUF(:) + TYPE(ARRPNT), POINTER :: APNT(:) + INTEGER :: BUFSIZE, SOURCE, RCVPNT, MAXS, PNT, + & SAVEPNT + INTEGER, PARAMETER :: ITAG=30 + LOGICAL :: FLAG + nullify(MAPTAB, SNDCNT, RCVCNT, SDISPL, HALO_MAP) + nullify(RDISPL, MSGCNT, SIPES) + nullify(PCNT, TSENDI, TSENDJ, RCVBUF, APNT) + CALL MPI_COMM_RANK (id%COMM, MYID, IERR) + CALL MPI_COMM_SIZE (id%COMM, NPROCS, IERR) + IF(MUMPS_795(WORK) .LT. id%N*2) THEN + WRITE(LP, + & '("Insufficient workspace inside BUILD_LOC_GRAPH")') + CALL MUMPS_ABORT() + END IF + MAPTAB => WORK( 1 : id%N) + HALO_MAP => WORK(id%N+1 : 2*id%N) + CALL MUMPS_733(SNDCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(RCVCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(MSGCNT, NPROCS, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rrsndcnt:',MEMCNT,MAXMEM +#endif + ALLOCATE(APNT(NPROCS)) + SNDCNT = 0 + TOP_CNT = 0 + BUFSIZE = 10000 + LOCNNZ = id%NZ_loc + NROWS_LOC = ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1 + MAPTAB = 0 + MAXS = 0 + DO I=1, NPROCS + IF((ord%LAST(I)-ord%FIRST(I)+1) .GT. MAXS) THEN + MAXS = ord%LAST(I)-ord%FIRST(I)+1 + END IF + DO J=ord%FIRST(I), ord%LAST(I) + MAPTAB(ord%PERITAB(J)) = I + END DO + END DO + ALLOCATE(SIPES(max(1,MAXS), NPROCS)) + SIPES(:,:) = 0 + TOP_CNT = 0 + DO I=1, id%NZ_loc + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + PROC = MAPTAB(id%IRN_loc(I)) + IF(PROC .EQ. 0) THEN + TOP_CNT = TOP_CNT+1 + ELSE + IIDX = ord%PERMTAB(id%IRN_loc(I)) + LOC_ROW = IIDX-ord%FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + END IF + PROC = MAPTAB(id%JCN_loc(I)) + IF(PROC .EQ. 0) THEN + TOP_CNT = TOP_CNT+1 + ELSE + IIDX = ord%PERMTAB(id%JCN_loc(I)) + LOC_ROW = IIDX-ord%FIRST(PROC)+1 + SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1 + SNDCNT(PROC) = SNDCNT(PROC)+1 + END IF + END IF + END DO + CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, id%COMM, IERR) + I = ceiling(dble(MAXS)*1.20D0) + CALL MUMPS_733(LENG, max(I,1), id%INFO, + & LP, STRING='B_L_G:LENG', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rrleng2:',MEMCNT, + & MAXMEM +#endif + SNDCNT(:) = MAXS + CALL MPI_REDUCE_SCATTER ( SIPES(1,1), LENG(1), SNDCNT(1), + & MPI_INTEGER, MPI_SUM, id%COMM, IERR ) + DEALLOCATE(SIPES) + I = ceiling(dble(NROWS_LOC+1)*1.20D0) + CALL MUMPS_733(IPE, max(I,1), id%INFO, + & LP, STRING='B_L_G:IPE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT rripe:',MEMCNT,MAXMEM +#endif + IPE(1) = 1 + DO I=1, NROWS_LOC + IPE(I+1) = IPE(I) + LENG(I) + END DO + CALL MUMPS_733(TSENDI, max(TOP_CNT,1), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(TSENDJ, max(TOP_CNT,1), id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT tsendi:',MEMCNT,MAXMEM +#endif + LENG(:) = 0 + CALL ZMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, + & LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + NEW_LOCNNZ = sum(RCVCNT) + DO I=1, NPROCS + MSGCNT(I) = RCVCNT(I)/BUFSIZE + END DO + CALL MUMPS_733(PE, max(NEW_LOCNNZ+2*NROWS_LOC,1), id%INFO, + & LP, STRING='B_L_G:PE', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT rrpe2:',MEMCNT,MAXMEM +#endif + RCVPNT = 1 + SNDCNT = 0 + TIDX = 0 + DO I=1, id%NZ_loc + IF(mod(I,BUFSIZE/10) .EQ. 0) THEN + CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, MPI_COMM_WORLD, + & FLAG, STATUS, IERR ) + IF(FLAG) THEN + SOURCE = STATUS(MPI_SOURCE) + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, SOURCE, + & ITAG, MPI_COMM_WORLD, STATUS, IERR) + CALL ZMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + RCVPNT = RCVPNT + BUFSIZE + END IF + END IF + IF(id%IRN_loc(I) .NE. id%JCN_loc(I)) THEN + PROC = MAPTAB(id%IRN_loc(I)) + IF(PROC .EQ. 0) THEN + TIDX = TIDX+1 + TSENDI(TIDX) = id%IRN_loc(I) + TSENDJ(TIDX) = id%JCN_loc(I) + ELSE + IIDX = ord%PERMTAB(id%IRN_loc(I)) + JJDX = ord%PERMTAB(id%JCN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) =IIDX-ord%FIRST(PROC)+1 + IF( (JJDX .GE. ord%FIRST(PROC)) .AND. + & (JJDX .LE. ord%LAST(PROC)) ) THEN + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = JJDX-ord%FIRST(PROC)+1 + ELSE + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = -id%JCN_loc(I) + END IF + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL ZMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, + & PE, LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + END IF + PROC = MAPTAB(id%JCN_loc(I)) + IF(PROC .EQ. 0) THEN + TIDX = TIDX+1 + TSENDI(TIDX) = id%JCN_loc(I) + TSENDJ(TIDX) = id%IRN_loc(I) + ELSE + IIDX = ord%PERMTAB(id%JCN_loc(I)) + JJDX = ord%PERMTAB(id%IRN_loc(I)) + APNT(PROC)%BUF(2*SNDCNT(PROC)+1) = IIDX-ord%FIRST(PROC)+1 + IF( (JJDX .GE. ord%FIRST(PROC)) .AND. + & (JJDX .LE. ord%LAST(PROC)) ) THEN + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = JJDX-ord%FIRST(PROC)+1 + ELSE + APNT(PROC)%BUF(2*SNDCNT(PROC)+2) = -id%IRN_loc(I) + END IF + SNDCNT(PROC) = SNDCNT(PROC)+1 + IF(SNDCNT(PROC) .EQ. BUFSIZE) THEN + CALL ZMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, + & LENG, RCVBUF, MSGCNT, SNDCNT, id%COMM) + END IF + END IF + END IF + END DO + CALL ZMUMPS_785(APNT, -1, NPROCS, BUFSIZE, IPE, PE, LENG, + & RCVBUF, MSGCNT, SNDCNT, id%COMM) + DUPS = 0 + PNT = 0 + SAVEPNT = 1 + MAPTAB(:) = 0 + HALO_MAP(:) = 0 + HALO_SIZE = 0 + DO I=1, NROWS_LOC + DO J=IPE(I),IPE(I+1)-1 + IF(PE(J) .LT. 0) THEN + IF(HALO_MAP(-PE(J)) .EQ. 0) THEN + HALO_SIZE = HALO_SIZE+1 + HALO_MAP(-PE(J)) = NROWS_LOC+HALO_SIZE + END IF + PE(J) = HALO_MAP(-PE(J)) + END IF + IF(MAPTAB(PE(J)) .EQ. I) THEN + DUPS = DUPS+1 + LENG(I) = LENG(I)-1 + ELSE + MAPTAB(PE(J)) = I + PNT = PNT+1 + PE(PNT) = PE(J) + END IF + END DO + IPE(I) = SAVEPNT + SAVEPNT = PNT+1 + END DO + IPE(NROWS_LOC+1) = SAVEPNT + CALL MUMPS_733(I_HALO_MAP, HALO_SIZE, id%INFO, LP, + & MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid, + & 'MEMCNT i_halo:',MEMCNT,MAXMEM +#endif + J=0 + DO I=1, id%N + IF(HALO_MAP(I) .GT. 0) THEN + J = J+1 + I_HALO_MAP(HALO_MAP(I)-NROWS_LOC) = I + END IF + IF(J .EQ. HALO_SIZE) EXIT + END DO + CALL MUMPS_733(LENG, max(NROWS_LOC+HALO_SIZE,1), id%INFO, + & LP, COPY=.TRUE., + & STRING='lcgrph:leng', MEMCNT=MEMCNT, ERRCODE=-7) + LENG(NROWS_LOC+1:NROWS_LOC+HALO_SIZE) = 0 + CALL MUMPS_733(IPE, NROWS_LOC+HALO_SIZE+1, id%INFO, + & LP, COPY=.TRUE., + & STRING='lcgrph:ipe', MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT lengipe:',MEMCNT, + & MAXMEM +#endif + IPE(NROWS_LOC+2:NROWS_LOC+HALO_SIZE+1) = IPE(NROWS_LOC+1) + GSIZE = NROWS_LOC + HALO_SIZE + CALL MPI_GATHER(TOP_CNT, 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, 0, id%COMM, IERR) + RDISPL => MSGCNT + NULLIFY(MSGCNT) + IF(MYID.EQ.0) THEN + NEW_LOCNNZ = sum(RCVCNT) + RDISPL(1) = 0 + DO I=2, NPROCS + RDISPL(I) = RDISPL(I-1)+RCVCNT(I-1) + END DO + top_graph%NZ_LOC = NEW_LOCNNZ + top_graph%COMM = id%COMM + CALL MUMPS_733(top_graph%IRN_LOC, NEW_LOCNNZ, id%INFO, + & LP, MEMCNT=MEMCNT, ERRCODE=-7) + CALL MUMPS_733(top_graph%JCN_LOC, NEW_LOCNNZ, id%INFO, + & LP, MEMCNT=MEMCNT, ERRCODE=-7) + IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'MEMCNT top_graph:',MEMCNT, + & MAXMEM +#endif + ELSE + ALLOCATE(top_graph%IRN_LOC(1), top_graph%JCN_LOC(1)) + END IF + CALL MPI_GATHERV(TSENDI(1), TOP_CNT, MPI_INTEGER, + & top_graph%IRN_LOC(1), RCVCNT(1), RDISPL(1), MPI_INTEGER, + & 0, id%COMM, IERR) + CALL MPI_GATHERV(TSENDJ(1), TOP_CNT, MPI_INTEGER, + & top_graph%JCN_LOC(1), RCVCNT(1), RDISPL(1), MPI_INTEGER, + & 0, id%COMM, IERR) + CALL MUMPS_734(SNDCNT, RCVCNT, RDISPL, + & TSENDI, TSENDJ, MEMCNT=MEMCNT) +#if defined (memprof) + write(mp,'(i2,a30,2(i8,5x))')myid,'deall sndcnt:',MEMCNT,MAXMEM +#endif + DEALLOCATE(APNT) + RETURN + END SUBROUTINE ZMUMPS_775 + SUBROUTINE ZMUMPS_785(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, + & LENG, RCVBUF, MSGCNT, SNDCNT, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER :: NPROCS, PROC, COMM + TYPE(ARRPNT) :: APNT(:) + INTEGER :: BUFSIZE + INTEGER, POINTER :: RCVBUF(:), LENG(:), PE(:), IPE(:) + INTEGER :: MSGCNT(:), SNDCNT(:) + LOGICAL, SAVE :: INIT = .TRUE. + INTEGER, POINTER, SAVE :: SPACE(:,:,:) + LOGICAL, POINTER, SAVE :: PENDING(:) + INTEGER, POINTER, SAVE :: REQ(:), CPNT(:) + INTEGER :: IERR, MYID, I, SOURCE, TOTMSG + LOGICAL :: FLAG, TFLAG + INTEGER :: STATUS(MPI_STATUS_SIZE), + & TSTATUS(MPI_STATUS_SIZE) + INTEGER, PARAMETER :: ITAG=30, FTAG=31 + INTEGER, POINTER :: TMPI(:), RCVCNT(:) + CALL MPI_COMM_RANK (COMM, MYID, IERR) + CALL MPI_COMM_SIZE (COMM, NPROCS, IERR) + IF(INIT) THEN + ALLOCATE(SPACE(2*BUFSIZE, 2, NPROCS)) + ALLOCATE(RCVBUF(2*BUFSIZE)) + ALLOCATE(PENDING(NPROCS), CPNT(NPROCS)) + ALLOCATE(REQ(NPROCS)) + PENDING = .FALSE. + DO I=1, NPROCS + APNT(I)%BUF => SPACE(:,1,I) + CPNT(I) = 1 + END DO + INIT = .FALSE. + RETURN + END IF + IF(PROC .EQ. -1) THEN + TOTMSG = sum(MSGCNT) + DO + IF(TOTMSG .EQ. 0) EXIT + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, + & MPI_ANY_SOURCE, ITAG, COMM, STATUS, IERR) + CALL ZMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) + SOURCE = STATUS(MPI_SOURCE) + TOTMSG = TOTMSG-1 + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + END DO + DO I=1, NPROCS + IF(PENDING(I)) THEN + CALL MPI_WAIT(REQ(I), TSTATUS, IERR) + END IF + END DO + ALLOCATE(RCVCNT(NPROCS)) + CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1, + & MPI_INTEGER, COMM, IERR) + DO I=1, NPROCS + IF(SNDCNT(I) .GT. 0) THEN + TMPI => APNT(I)%BUF(:) + CALL MPI_ISEND(TMPI(1), 2*SNDCNT(I), MPI_INTEGER, I-1, + & FTAG, COMM, REQ(I), IERR) + END IF + END DO + DO I=1, NPROCS + IF(RCVCNT(I) .GT. 0) THEN + CALL MPI_RECV(RCVBUF(1), 2*RCVCNT(I), MPI_INTEGER, I-1, + & FTAG, COMM, STATUS, IERR) + CALL ZMUMPS_773(RCVCNT(I), RCVBUF, + & IPE, PE, LENG) + END IF + END DO + DO I=1, NPROCS + IF(SNDCNT(I) .GT. 0) THEN + CALL MPI_WAIT(REQ(I), TSTATUS, IERR) + END IF + END DO + DEALLOCATE(SPACE) + DEALLOCATE(PENDING, CPNT) + DEALLOCATE(REQ) + DEALLOCATE(RCVBUF, RCVCNT) + nullify(SPACE, PENDING, CPNT, REQ, RCVBUF, RCVCNT) + INIT = .TRUE. + RETURN + END IF + IF(PENDING(PROC)) THEN + DO + CALL MPI_TEST(REQ(PROC), TFLAG, TSTATUS, IERR) + IF(TFLAG) THEN + PENDING(PROC) = .FALSE. + EXIT + ELSE + CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, COMM, + & FLAG, STATUS, IERR ) + IF(FLAG) THEN + SOURCE = STATUS(MPI_SOURCE) + CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, + & SOURCE, ITAG, COMM, STATUS, IERR) + CALL ZMUMPS_773(BUFSIZE, RCVBUF, IPE, + & PE, LENG) + MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1 + END IF + END IF + END DO + END IF + TMPI => APNT(PROC)%BUF(:) + CALL MPI_ISEND(TMPI(1), 2*BUFSIZE, MPI_INTEGER, PROC-1, + & ITAG, COMM, REQ(PROC), IERR) + PENDING(PROC) = .TRUE. + CPNT(PROC) = mod(CPNT(PROC),2)+1 + APNT(PROC)%BUF => SPACE(:,CPNT(PROC),PROC) + SNDCNT(PROC) = 0 + RETURN + END SUBROUTINE ZMUMPS_785 + SUBROUTINE ZMUMPS_773(BUFSIZE, RCVBUF, IPE, PE, LENG) +#ifdef MPELOG + USE MPEMOD + INCLUDE 'mpif.h' +#endif + IMPLICIT NONE + INTEGER :: BUFSIZE + INTEGER, POINTER :: RCVBUF(:), IPE(:), PE(:), LENG(:) + INTEGER :: I, ROW, COL +#ifdef MPELOG + INTEGER ::IERR + IERR = MPE_LOG_EVENT( MPE_ASM_BUF1, 0, '' ) +#endif + DO I=1, 2*BUFSIZE, 2 + ROW = RCVBUF(I) + COL = RCVBUF(I+1) + PE(IPE(ROW)+LENG(ROW)) = COL + LENG(ROW) = LENG(ROW) + 1 + END DO +#ifdef MPELOG + IERR = MPE_LOG_EVENT( MPE_ASM_BUF2, 0, '' ) +#endif + RETURN + END SUBROUTINE ZMUMPS_773 + SUBROUTINE ZMUMPS_777(ord) + TYPE(ORD_TYPE) :: ord + INTEGER :: I + ord%SON = -1 + ord%BROTHER = -1 + ord%NW = 0 + DO I=1, ord%CBLKNBR + ord%NW(I) = ord%NW(I)+ord%RANGTAB(I+1) - ord%RANGTAB(I) + IF (ord%TREETAB(I) .NE. -1) THEN + IF (ord%SON(ord%TREETAB(I)) .EQ. -1) THEN + ord%SON(ord%TREETAB(I)) = I + ELSE + ord%BROTHER(I) = ord%SON(ord%TREETAB(I)) + ord%SON(ord%TREETAB(I)) = I + END IF + ord%NW(ord%TREETAB(I)) = ord%NW(ord%TREETAB(I))+ ord%NW(I) + END IF + END DO + RETURN + END SUBROUTINE ZMUMPS_777 + SUBROUTINE ZMUMPS_784(N, L, A1, A2) + INTEGER :: I, LP, ISWAP, N + INTEGER :: L(0:), A1(:), A2(:) + LP = L(0) + I = 1 + DO + IF ((LP==0).OR.(I>N)) EXIT + DO + IF (LP >= I) EXIT + LP = L(LP) + END DO + ISWAP = A1(LP) + A1(LP) = A1(I) + A1(I) = ISWAP + ISWAP = A2(LP) + A2(LP) = A2(I) + A2(I) = ISWAP + ISWAP = L(LP) + L(LP) = L(I) + L(I) = LP + LP = ISWAP + I = I + 1 + ENDDO + END SUBROUTINE ZMUMPS_784 + SUBROUTINE ZMUMPS_783(N, K, L) + INTEGER :: N + INTEGER :: K(:), L(0:) + INTEGER :: P, Q, S, T + CONTINUE + L(0) = 1 + T = N + 1 + DO P = 1,N - 1 + IF (K(P) <= K(P+1)) THEN + L(P) = P + 1 + ELSE + L(T) = - (P+1) + T = P + END IF + END DO + L(T) = 0 + L(N) = 0 + IF (L(N+1) == 0) THEN + RETURN + ELSE + L(N+1) = iabs(L(N+1)) + END IF + 200 CONTINUE + S = 0 + T = N+1 + P = L(S) + Q = L(T) + IF(Q .EQ. 0) RETURN + 300 CONTINUE + IF(K(P) .GT. K(Q)) GOTO 600 + CONTINUE + L(S) = sign(P,L(S)) + S = P + P = L(P) + IF (P .GT. 0) GOTO 300 + CONTINUE + L(S) = Q + S = T + DO + T = Q + Q = L(Q) + IF (Q .LE. 0) EXIT + END DO + GOTO 800 + 600 CONTINUE + L(S) = sign(Q, L(S)) + S = Q + Q = L(Q) + IF (Q .GT. 0) GOTO 300 + CONTINUE + L(S) = P + S = T + DO + T = P + P = L(P) + IF (P .LE. 0) EXIT + END DO + 800 CONTINUE + P = -P + Q = -Q + IF(Q.EQ.0) THEN + L(S) = sign(P, L(S)) + L(T) = 0 + GOTO 200 + END IF + GOTO 300 + END SUBROUTINE ZMUMPS_783 + FUNCTION MUMPS_795(A) + INTEGER, POINTER :: A(:) + INTEGER :: MUMPS_795 + IF(associated(A)) THEN + MUMPS_795 = size(A) + ELSE + MUMPS_795 = 0 + END IF + RETURN + END FUNCTION MUMPS_795 + SUBROUTINE MUMPS_734(A1, A2, A3, A4, A5, A6, A7, MEMCNT) + INTEGER, POINTER :: A1(:) + INTEGER, POINTER, OPTIONAL :: A2(:), A3(:), A4(:), A5(:), + & A6(:), A7(:) + INTEGER, OPTIONAL :: MEMCNT + INTEGER :: IMEMCNT + IMEMCNT = 0 + IF(associated(A1)) THEN + IMEMCNT = IMEMCNT+size(A1) + DEALLOCATE(A1) + END IF + IF(present(A2)) THEN + IF(associated(A2)) THEN + IMEMCNT = IMEMCNT+size(A2) + DEALLOCATE(A2) + END IF + END IF + IF(present(A3)) THEN + IF(associated(A3)) THEN + IMEMCNT = IMEMCNT+size(A3) + DEALLOCATE(A3) + END IF + END IF + IF(present(A4)) THEN + IF(associated(A4)) THEN + IMEMCNT = IMEMCNT+size(A4) + DEALLOCATE(A4) + END IF + END IF + IF(present(A5)) THEN + IF(associated(A5)) THEN + IMEMCNT = IMEMCNT+size(A5) + DEALLOCATE(A5) + END IF + END IF + IF(present(A6)) THEN + IF(associated(A6)) THEN + IMEMCNT = IMEMCNT+size(A6) + DEALLOCATE(A6) + END IF + END IF + IF(present(A7)) THEN + IF(associated(A7)) THEN + IMEMCNT = IMEMCNT+size(A7) + DEALLOCATE(A7) + END IF + END IF + IF(present(MEMCNT)) MEMCNT = MEMCNT-IMEMCNT + RETURN + END SUBROUTINE MUMPS_734 +#if defined(memprof) + FUNCTION ESTIMEM(MYID, N, NZR) + INTEGER :: ESTIMEM, MYID, NZR, N + IF(MYID.EQ.0) THEN + ESTIMEM = 12*N + ELSE + ESTIMEM = 7*N + END IF + IF(MYID.NE.0) TOPROWS=0 + IF(MYID .EQ. 0) ESTIMEM = ESTIMEM+2*TOPROWS*NZR + ESTIMEM = ESTIMEM+NRL + ESTIMEM = ESTIMEM+max(NRL,TOPROWS)*(NZR+2) + ESTIMEM = ESTIMEM+6*max(NRL,TOPROWS) + IF(MYID.EQ.0) ESTIMEM=ESTIMEM+3*TOPROWS + RETURN + END FUNCTION ESTIMEM +#endif + END MODULE + SUBROUTINE ZMUMPS_448(ICNTL,CNTL) + IMPLICIT NONE + INTEGER NICNTL, NCNTL + PARAMETER (NICNTL=10, NCNTL=10) + INTEGER ICNTL(NICNTL) + DOUBLE PRECISION CNTL(NCNTL) + INTEGER I + ICNTL(1) = 6 + ICNTL(2) = 6 + ICNTL(3) = -1 + ICNTL(4) = -1 + ICNTL(5) = 0 + DO 10 I = 6,NICNTL + ICNTL(I) = 0 + 10 CONTINUE + CNTL(1) = 0.0D0 + CNTL(2) = 0.0D0 + DO 20 I = 3,NCNTL + CNTL(I) = 0.0D0 + 20 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_448 + SUBROUTINE ZMUMPS_444 + & (M,N,NE,IP,IRN,A,IPERM,NUM,JPERM,PR,Q,L,D,RINF) + IMPLICIT NONE + INTEGER M,N,NE,NUM + INTEGER IP(N+1),IRN(NE),IPERM(M),JPERM(N),PR(N),Q(M),L(M) + DOUBLE PRECISION A(NE) + DOUBLE PRECISION D(M), RINF + INTEGER I,II,J,JJ,JORD,Q0,QLEN,IDUM,JDUM,ISP,JSP, + & K,KK,KK1,KK2,I0,UP,LOW + DOUBLE PRECISION CSP,DI,DNEW,DQ0,AI,A0,BV,TBV,RLX + DOUBLE PRECISION ZERO,MINONE,ONE + PARAMETER (ZERO=0.0D0,MINONE=-1.0D0,ONE=1.0D0) + INTRINSIC abs,min + EXTERNAL ZMUMPS_445, ZMUMPS_446, ZMUMPS_447, ZMUMPS_455 + RLX = D(1) + NUM = 0 + BV = RINF + DO 10 K = 1,N + JPERM(K) = 0 + PR(K) = IP(K) + 10 CONTINUE + DO 12 K = 1,M + IPERM(K) = 0 + D(K) = ZERO + 12 CONTINUE + DO 30 J = 1,N + A0 = MINONE + DO 20 K = IP(J),IP(J+1)-1 + I = IRN(K) + AI = abs(A(K)) + IF (AI.GT.D(I)) D(I) = AI + IF (JPERM(J).NE.0) GO TO 20 + IF (AI.GE.BV) THEN + A0 = BV + IF (IPERM(I).NE.0) GO TO 20 + JPERM(J) = I + IPERM(I) = J + NUM = NUM + 1 + ELSE + IF (AI.LE.A0) GO TO 20 + A0 = AI + I0 = I + ENDIF + 20 CONTINUE + IF (A0.NE.MINONE .AND. A0.LT.BV) THEN + BV = A0 + IF (IPERM(I0).NE.0) GO TO 30 + IPERM(I0) = J + JPERM(J) = I0 + NUM = NUM + 1 + ENDIF + 30 CONTINUE + IF (M.EQ.N) THEN + DO 35 I = 1,M + BV = min(BV,D(I)) + 35 CONTINUE + ENDIF + IF (NUM.EQ.N) GO TO 1000 + DO 95 J = 1,N + IF (JPERM(J).NE.0) GO TO 95 + DO 50 K = IP(J),IP(J+1)-1 + I = IRN(K) + AI = abs(A(K)) + IF (AI.LT.BV) GO TO 50 + IF (IPERM(I).EQ.0) GO TO 90 + JJ = IPERM(I) + KK1 = PR(JJ) + KK2 = IP(JJ+1) - 1 + IF (KK1.GT.KK2) GO TO 50 + DO 70 KK = KK1,KK2 + II = IRN(KK) + IF (IPERM(II).NE.0) GO TO 70 + IF (abs(A(KK)).GE.BV) GO TO 80 + 70 CONTINUE + PR(JJ) = KK2 + 1 + 50 CONTINUE + GO TO 95 + 80 JPERM(JJ) = II + IPERM(II) = JJ + PR(JJ) = KK + 1 + 90 NUM = NUM + 1 + JPERM(J) = I + IPERM(I) = J + PR(J) = K + 1 + 95 CONTINUE + IF (NUM.EQ.N) GO TO 1000 + DO 99 I = 1,M + D(I) = MINONE + L(I) = 0 + 99 CONTINUE + TBV = BV * (ONE-RLX) + DO 100 JORD = 1,N + IF (JPERM(JORD).NE.0) GO TO 100 + QLEN = 0 + LOW = M + 1 + UP = M + 1 + CSP = MINONE + J = JORD + PR(J) = -1 + DO 115 K = IP(J),IP(J+1)-1 + I = IRN(K) + DNEW = abs(A(K)) + IF (CSP.GE.DNEW) GO TO 115 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = I + JSP = J + IF (CSP.GE.TBV) GO TO 160 + ELSE + D(I) = DNEW + IF (DNEW.GE.TBV) THEN + LOW = LOW - 1 + Q(LOW) = I + ELSE + QLEN = QLEN + 1 + L(I) = QLEN + CALL ZMUMPS_445(I,M,Q,D,L,1) + ENDIF + JJ = IPERM(I) + PR(JJ) = J + ENDIF + 115 CONTINUE + DO 150 JDUM = 1,NUM + IF (LOW.EQ.UP) THEN + IF (QLEN.EQ.0) GO TO 160 + I = Q(1) + IF (CSP.GE.D(I)) GO TO 160 + BV = D(I) + TBV = BV * (ONE-RLX) + DO 152 IDUM = 1,M + CALL ZMUMPS_446(QLEN,M,Q,D,L,1) + L(I) = 0 + LOW = LOW - 1 + Q(LOW) = I + IF (QLEN.EQ.0) GO TO 153 + I = Q(1) + IF (D(I).LT.TBV) GO TO 153 + 152 CONTINUE + ENDIF + 153 UP = UP - 1 + Q0 = Q(UP) + DQ0 = D(Q0) + L(Q0) = UP + J = IPERM(Q0) + DO 155 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (L(I).GE.UP) GO TO 155 + DNEW = min(DQ0,abs(A(K))) + IF (CSP.GE.DNEW) GO TO 155 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = I + JSP = J + IF (CSP.GE.TBV) GO TO 160 + ELSE + DI = D(I) + IF (DI.GE.TBV .OR. DI.GE.DNEW) GO TO 155 + D(I) = DNEW + IF (DNEW.GE.TBV) THEN + IF (DI.NE.MINONE) THEN + CALL ZMUMPS_447(L(I),QLEN,M,Q,D,L,1) + ENDIF + L(I) = 0 + LOW = LOW - 1 + Q(LOW) = I + ELSE + IF (DI.EQ.MINONE) THEN + QLEN = QLEN + 1 + L(I) = QLEN + ENDIF + CALL ZMUMPS_445(I,M,Q,D,L,1) + ENDIF + JJ = IPERM(I) + PR(JJ) = J + ENDIF + 155 CONTINUE + 150 CONTINUE + 160 IF (CSP.EQ.MINONE) GO TO 190 + BV = min(BV,CSP) + TBV = BV * (ONE-RLX) + NUM = NUM + 1 + I = ISP + J = JSP + DO 170 JDUM = 1,NUM+1 + I0 = JPERM(J) + JPERM(J) = I + IPERM(I) = J + J = PR(J) + IF (J.EQ.-1) GO TO 190 + I = I0 + 170 CONTINUE + 190 DO 191 KK = UP,M + I = Q(KK) + D(I) = MINONE + L(I) = 0 + 191 CONTINUE + DO 192 KK = LOW,UP-1 + I = Q(KK) + D(I) = MINONE + 192 CONTINUE + DO 193 KK = 1,QLEN + I = Q(KK) + D(I) = MINONE + L(I) = 0 + 193 CONTINUE + 100 CONTINUE + 1000 IF (M.EQ.N .and. NUM.EQ.N) GO TO 2000 + CALL ZMUMPS_455(M,N,IPERM,L,JPERM) + 2000 RETURN + END SUBROUTINE ZMUMPS_444 + SUBROUTINE ZMUMPS_445(I,N,Q,D,L,IWAY) + IMPLICIT NONE + INTEGER I,N,IWAY + INTEGER Q(N),L(N) + DOUBLE PRECISION D(N) + INTEGER IDUM,K,POS,POSK,QK + PARAMETER (K=2) + DOUBLE PRECISION DI + POS = L(I) + IF (POS.LE.1) GO TO 20 + DI = D(I) + IF (IWAY.EQ.1) THEN + DO 10 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.LE.D(QK)) GO TO 20 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 20 + 10 CONTINUE + ELSE + DO 15 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.GE.D(QK)) GO TO 20 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 20 + 15 CONTINUE + ENDIF + 20 Q(POS) = I + L(I) = POS + RETURN + END SUBROUTINE ZMUMPS_445 + SUBROUTINE ZMUMPS_446(QLEN,N,Q,D,L,IWAY) + IMPLICIT NONE + INTEGER QLEN,N,IWAY + INTEGER Q(N),L(N) + DOUBLE PRECISION D(N) + INTEGER I,IDUM,K,POS,POSK + PARAMETER (K=2) + DOUBLE PRECISION DK,DR,DI + I = Q(QLEN) + DI = D(I) + QLEN = QLEN - 1 + POS = 1 + IF (IWAY.EQ.1) THEN + DO 10 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 20 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.LT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.GE.DK) GO TO 20 + Q(POS) = Q(POSK) + L(Q(POS)) = POS + POS = POSK + 10 CONTINUE + ELSE + DO 15 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 20 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.GT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.LE.DK) GO TO 20 + Q(POS) = Q(POSK) + L(Q(POS)) = POS + POS = POSK + 15 CONTINUE + ENDIF + 20 Q(POS) = I + L(I) = POS + RETURN + END SUBROUTINE ZMUMPS_446 + SUBROUTINE ZMUMPS_447(POS0,QLEN,N,Q,D,L,IWAY) + IMPLICIT NONE + INTEGER POS0,QLEN,N,IWAY + INTEGER Q(N),L(N) + DOUBLE PRECISION D(N) + INTEGER I,IDUM,K,POS,POSK,QK + PARAMETER (K=2) + DOUBLE PRECISION DK,DR,DI + IF (QLEN.EQ.POS0) THEN + QLEN = QLEN - 1 + RETURN + ENDIF + I = Q(QLEN) + DI = D(I) + QLEN = QLEN - 1 + POS = POS0 + IF (IWAY.EQ.1) THEN + IF (POS.LE.1) GO TO 20 + DO 10 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.LE.D(QK)) GO TO 20 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 20 + 10 CONTINUE + 20 Q(POS) = I + L(I) = POS + IF (POS.NE.POS0) RETURN + DO 30 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 40 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.LT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.GE.DK) GO TO 40 + QK = Q(POSK) + Q(POS) = QK + L(QK) = POS + POS = POSK + 30 CONTINUE + ELSE + IF (POS.LE.1) GO TO 34 + DO 32 IDUM = 1,N + POSK = POS/K + QK = Q(POSK) + IF (DI.GE.D(QK)) GO TO 34 + Q(POS) = QK + L(QK) = POS + POS = POSK + IF (POS.LE.1) GO TO 34 + 32 CONTINUE + 34 Q(POS) = I + L(I) = POS + IF (POS.NE.POS0) RETURN + DO 36 IDUM = 1,N + POSK = K*POS + IF (POSK.GT.QLEN) GO TO 40 + DK = D(Q(POSK)) + IF (POSK.LT.QLEN) THEN + DR = D(Q(POSK+1)) + IF (DK.GT.DR) THEN + POSK = POSK + 1 + DK = DR + ENDIF + ENDIF + IF (DI.LE.DK) GO TO 40 + QK = Q(POSK) + Q(POS) = QK + L(QK) = POS + POS = POSK + 36 CONTINUE + ENDIF + 40 Q(POS) = I + L(I) = POS + RETURN + END SUBROUTINE ZMUMPS_447 + SUBROUTINE ZMUMPS_450(IP,LENL,LENH,W,WLEN,A,NVAL,VAL) + IMPLICIT NONE + INTEGER WLEN,NVAL + INTEGER IP(*),LENL(*),LENH(*),W(*) + DOUBLE PRECISION A(*),VAL + INTEGER XX,J,K,II,S,POS + PARAMETER (XX=10) + DOUBLE PRECISION SPLIT(XX),HA + NVAL = 0 + DO 10 K = 1,WLEN + J = W(K) + DO 15 II = IP(J)+LENL(J),IP(J)+LENH(J)-1 + HA = A(II) + IF (NVAL.EQ.0) THEN + SPLIT(1) = HA + NVAL = 1 + ELSE + DO 20 S = NVAL,1,-1 + IF (SPLIT(S).EQ.HA) GO TO 15 + IF (SPLIT(S).GT.HA) THEN + POS = S + 1 + GO TO 21 + ENDIF + 20 CONTINUE + POS = 1 + 21 DO 22 S = NVAL,POS,-1 + SPLIT(S+1) = SPLIT(S) + 22 CONTINUE + SPLIT(POS) = HA + NVAL = NVAL + 1 + ENDIF + IF (NVAL.EQ.XX) GO TO 11 + 15 CONTINUE + 10 CONTINUE + 11 IF (NVAL.GT.0) VAL = SPLIT((NVAL+1)/2) + RETURN + END SUBROUTINE ZMUMPS_450 + SUBROUTINE ZMUMPS_451(N,NE,IP,IRN,A) + IMPLICIT NONE + INTEGER N,NE + INTEGER IP(N+1),IRN(NE) + DOUBLE PRECISION A(NE) + INTEGER THRESH,TDLEN + PARAMETER (THRESH=15,TDLEN=50) + INTEGER J,IPJ,K,LEN,R,S,HI,FIRST,MID,LAST,TD + DOUBLE PRECISION HA,KEY + INTEGER TODO(TDLEN) + DO 100 J = 1,N + LEN = IP(J+1) - IP(J) + IF (LEN.LE.1) GO TO 100 + IPJ = IP(J) + IF (LEN.LT.THRESH) GO TO 400 + TODO(1) = IPJ + TODO(2) = IPJ + LEN + TD = 2 + 500 CONTINUE + FIRST = TODO(TD-1) + LAST = TODO(TD) + KEY = A((FIRST+LAST)/2) + DO 475 K = FIRST,LAST-1 + HA = A(K) + IF (HA.EQ.KEY) GO TO 475 + IF (HA.GT.KEY) GO TO 470 + KEY = HA + GO TO 470 + 475 CONTINUE + TD = TD - 2 + GO TO 425 + 470 MID = FIRST + DO 450 K = FIRST,LAST-1 + IF (A(K).LE.KEY) GO TO 450 + HA = A(MID) + A(MID) = A(K) + A(K) = HA + HI = IRN(MID) + IRN(MID) = IRN(K) + IRN(K) = HI + MID = MID + 1 + 450 CONTINUE + IF (MID-FIRST.GE.LAST-MID) THEN + TODO(TD+2) = LAST + TODO(TD+1) = MID + TODO(TD) = MID + ELSE + TODO(TD+2) = MID + TODO(TD+1) = FIRST + TODO(TD) = LAST + TODO(TD-1) = MID + ENDIF + TD = TD + 2 + 425 CONTINUE + IF (TD.EQ.0) GO TO 400 + IF (TODO(TD)-TODO(TD-1).GE.THRESH) GO TO 500 + TD = TD - 2 + GO TO 425 + 400 DO 200 R = IPJ+1,IPJ+LEN-1 + IF (A(R-1) .LT. A(R)) THEN + HA = A(R) + HI = IRN(R) + A(R) = A(R-1) + IRN(R) = IRN(R-1) + DO 300 S = R-1,IPJ+1,-1 + IF (A(S-1) .LT. HA) THEN + A(S) = A(S-1) + IRN(S) = IRN(S-1) + ELSE + A(S) = HA + IRN(S) = HI + GO TO 200 + END IF + 300 CONTINUE + A(IPJ) = HA + IRN(IPJ) = HI + END IF + 200 CONTINUE + 100 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_451 + SUBROUTINE ZMUMPS_452(M,N,NE,IP,IRN,A,IPERM,NUMX, + & W,LEN,LENL,LENH,FC,IW,IW4,RLX,RINF) + IMPLICIT NONE + INTEGER M,N,NE,NUMX + INTEGER IP(N+1),IRN(NE),IPERM(N), + & W(N),LEN(N),LENL(N),LENH(N),FC(N),IW(M),IW4(3*N+M) + DOUBLE PRECISION A(NE),RLX,RINF + INTEGER NUM,NVAL,WLEN,II,I,J,K,L,CNT,MOD,IDUM1,IDUM2,IDUM3 + DOUBLE PRECISION BVAL,BMIN,BMAX + EXTERNAL ZMUMPS_450,ZMUMPS_453,ZMUMPS_455 + DO 20 J = 1,N + FC(J) = J + LEN(J) = IP(J+1) - IP(J) + 20 CONTINUE + DO 21 I = 1,M + IW(I) = 0 + 21 CONTINUE + CNT = 1 + MOD = 1 + NUMX = 0 + CALL ZMUMPS_453(CNT,MOD,M,N,IRN,NE,IP,LEN,FC,IW,NUMX,N, + & IW4(1),IW4(N+1),IW4(2*N+1),IW4(2*N+M+1)) + NUM = NUMX + IF (NUM.NE.N) THEN + BMAX = RINF + ELSE + BMAX = RINF + DO 30 J = 1,N + BVAL = 0.0D0 + DO 25 K = IP(J),IP(J+1)-1 + IF (A(K).GT.BVAL) BVAL = A(K) + 25 CONTINUE + IF (BVAL.LT.BMAX) BMAX = BVAL + 30 CONTINUE + BMAX = 1.001D0 * BMAX + ENDIF + BVAL = 0.0D0 + BMIN = 0.0D0 + WLEN = 0 + DO 48 J = 1,N + L = IP(J+1) - IP(J) + LENH(J) = L + LEN(J) = L + DO 45 K = IP(J),IP(J+1)-1 + IF (A(K).LT.BMAX) GO TO 46 + 45 CONTINUE + K = IP(J+1) + 46 LENL(J) = K - IP(J) + IF (LENL(J).EQ.L) GO TO 48 + WLEN = WLEN + 1 + W(WLEN) = J + 48 CONTINUE + DO 90 IDUM1 = 1,NE + IF (NUM.EQ.NUMX) THEN + DO 50 I = 1,M + IPERM(I) = IW(I) + 50 CONTINUE + DO 80 IDUM2 = 1,NE + BMIN = BVAL + IF (BMAX-BMIN .LE. RLX) GO TO 1000 + CALL ZMUMPS_450(IP,LENL,LEN,W,WLEN,A,NVAL,BVAL) + IF (NVAL.LE.1) GO TO 1000 + K = 1 + DO 70 IDUM3 = 1,N + IF (K.GT.WLEN) GO TO 71 + J = W(K) + DO 55 II = IP(J)+LEN(J)-1,IP(J)+LENL(J),-1 + IF (A(II).GE.BVAL) GO TO 60 + I = IRN(II) + IF (IW(I).NE.J) GO TO 55 + IW(I) = 0 + NUM = NUM - 1 + FC(N-NUM) = J + 55 CONTINUE + 60 LENH(J) = LEN(J) + LEN(J) = II - IP(J) + 1 + IF (LENL(J).EQ.LENH(J)) THEN + W(K) = W(WLEN) + WLEN = WLEN - 1 + ELSE + K = K + 1 + ENDIF + 70 CONTINUE + 71 IF (NUM.LT.NUMX) GO TO 81 + 80 CONTINUE + 81 MOD = 1 + ELSE + BMAX = BVAL + IF (BMAX-BMIN .LE. RLX) GO TO 1000 + CALL ZMUMPS_450(IP,LEN,LENH,W,WLEN,A,NVAL,BVAL) + IF (NVAL.EQ.0. OR. BVAL.EQ.BMIN) GO TO 1000 + K = 1 + DO 87 IDUM3 = 1,N + IF (K.GT.WLEN) GO TO 88 + J = W(K) + DO 85 II = IP(J)+LEN(J),IP(J)+LENH(J)-1 + IF (A(II).LT.BVAL) GO TO 86 + 85 CONTINUE + 86 LENL(J) = LEN(J) + LEN(J) = II - IP(J) + IF (LENL(J).EQ.LENH(J)) THEN + W(K) = W(WLEN) + WLEN = WLEN - 1 + ELSE + K = K + 1 + ENDIF + 87 CONTINUE + 88 MOD = 0 + ENDIF + CNT = CNT + 1 + CALL ZMUMPS_453(CNT,MOD,M,N,IRN,NE,IP,LEN,FC,IW,NUM,NUMX, + & IW4(1),IW4(N+1),IW4(2*N+1),IW4(2*N+M+1)) + 90 CONTINUE + 1000 IF (M.EQ.N .and. NUMX.EQ.N) GO TO 2000 + CALL ZMUMPS_455(M,N,IPERM,IW,W) + 2000 RETURN + END SUBROUTINE ZMUMPS_452 + SUBROUTINE ZMUMPS_453 + & (ID,MOD,M,N,IRN,LIRN,IP,LENC,FC,IPERM,NUM,NUMX, + & PR,ARP,CV,OUT) + IMPLICIT NONE + INTEGER ID,MOD,M,N,LIRN,NUM,NUMX + INTEGER ARP(N),CV(M),IRN(LIRN),IP(N), + & FC(N),IPERM(M),LENC(N),OUT(N),PR(N) + INTEGER I,II,IN1,IN2,J,J1,JORD,K,KK,LAST,NFC, + & NUM0,NUM1,NUM2,ID0,ID1 + IF (ID.EQ.1) THEN + DO 5 I = 1,M + CV(I) = 0 + 5 CONTINUE + DO 6 J = 1,N + ARP(J) = 0 + 6 CONTINUE + NUM1 = N + NUM2 = N + ELSE + IF (MOD.EQ.1) THEN + DO 8 J = 1,N + ARP(J) = 0 + 8 CONTINUE + ENDIF + NUM1 = NUMX + NUM2 = N - NUMX + ENDIF + NUM0 = NUM + NFC = 0 + ID0 = (ID-1)*N + DO 100 JORD = NUM0+1,N + ID1 = ID0 + JORD + J = FC(JORD-NUM0) + PR(J) = -1 + DO 70 K = 1,JORD + IF (ARP(J).GE.LENC(J)) GO TO 30 + IN1 = IP(J) + ARP(J) + IN2 = IP(J) + LENC(J) - 1 + DO 20 II = IN1,IN2 + I = IRN(II) + IF (IPERM(I).EQ.0) GO TO 80 + 20 CONTINUE + ARP(J) = LENC(J) + 30 OUT(J) = LENC(J) - 1 + DO 60 KK = 1,JORD + IN1 = OUT(J) + IF (IN1.LT.0) GO TO 50 + IN2 = IP(J) + LENC(J) - 1 + IN1 = IN2 - IN1 + DO 40 II = IN1,IN2 + I = IRN(II) + IF (CV(I).EQ.ID1) GO TO 40 + J1 = J + J = IPERM(I) + CV(I) = ID1 + PR(J) = J1 + OUT(J1) = IN2 - II - 1 + GO TO 70 + 40 CONTINUE + 50 J1 = PR(J) + IF (J1.EQ.-1) THEN + NFC = NFC + 1 + FC(NFC) = J + IF (NFC.GT.NUM2) THEN + LAST = JORD + GO TO 101 + ENDIF + GO TO 100 + ENDIF + J = J1 + 60 CONTINUE + 70 CONTINUE + 80 IPERM(I) = J + ARP(J) = II - IP(J) + 1 + NUM = NUM + 1 + DO 90 K = 1,JORD + J = PR(J) + IF (J.EQ.-1) GO TO 95 + II = IP(J) + LENC(J) - OUT(J) - 2 + I = IRN(II) + IPERM(I) = J + 90 CONTINUE + 95 IF (NUM.EQ.NUM1) THEN + LAST = JORD + GO TO 101 + ENDIF + 100 CONTINUE + LAST = N + 101 DO 110 JORD = LAST+1,N + NFC = NFC + 1 + FC(NFC) = FC(JORD-NUM0) + 110 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_453 + SUBROUTINE ZMUMPS_454(M,N,NE,IP,IRN,A,IPERM,NUM, + & JPERM,OUT,PR,Q,L,U,D,RINF) + IMPLICIT NONE + INTEGER M,N,NE,NUM + INTEGER IP(N+1),IRN(NE),IPERM(M),JPERM(N),OUT(N),PR(N),Q(M),L(M) + DOUBLE PRECISION A(NE),U(M),D(M),RINF,RINF3 + INTEGER I,I0,II,J,JJ,JORD,Q0,QLEN,JDUM,ISP,JSP, + & K,K0,K1,K2,KK,KK1,KK2,UP,LOW + DOUBLE PRECISION CSP,DI,DMIN,DNEW,DQ0,VJ,RLX + LOGICAL LORD + DOUBLE PRECISION ZERO, ONE + PARAMETER (ZERO=0.0D0,ONE=1.0D0) + EXTERNAL ZMUMPS_445, ZMUMPS_446, ZMUMPS_447, ZMUMPS_455 + RLX = U(1) + RINF3 = U(2) + LORD = (JPERM(1).EQ.6) + NUM = 0 + DO 10 K = 1,N + JPERM(K) = 0 + PR(K) = IP(K) + D(K) = RINF + 10 CONTINUE + DO 15 K = 1,M + U(K) = RINF3 + IPERM(K) = 0 + L(K) = 0 + 15 CONTINUE + DO 30 J = 1,N + IF (IP(J+1)-IP(J) .GT. N/10 .AND. N.GT.50) GO TO 30 + DO 20 K = IP(J),IP(J+1)-1 + I = IRN(K) + IF (A(K).GT.U(I)) GO TO 20 + U(I) = A(K) + IPERM(I) = J + L(I) = K + 20 CONTINUE + 30 CONTINUE + DO 40 I = 1,M + J = IPERM(I) + IF (J.EQ.0) GO TO 40 + IF (JPERM(J).EQ.0) THEN + JPERM(J) = L(I) + D(J) = U(I) + NUM = NUM + 1 + ELSEIF (D(J).GT.U(I)) THEN + K = JPERM(J) + II = IRN(K) + IPERM(II) = 0 + JPERM(J) = L(I) + D(J) = U(I) + ELSE + IPERM(I) = 0 + ENDIF + 40 CONTINUE + IF (NUM.EQ.N) GO TO 1000 + DO 45 K = 1,M + D(K) = ZERO + 45 CONTINUE + DO 95 J = 1,N + IF (JPERM(J).NE.0) GO TO 95 + K1 = IP(J) + K2 = IP(J+1) - 1 + IF (K1.GT.K2) GO TO 95 + VJ = RINF + DO 50 K = K1,K2 + I = IRN(K) + DI = A(K) - U(I) + IF (DI.GT.VJ) GO TO 50 + IF (DI.LT.VJ .OR. DI.EQ.RINF) GO TO 55 + IF (IPERM(I).NE.0 .OR. IPERM(I0).EQ.0) GO TO 50 + 55 VJ = DI + I0 = I + K0 = K + 50 CONTINUE + D(J) = VJ + K = K0 + I = I0 + IF (IPERM(I).EQ.0) GO TO 90 + DO 60 K = K0,K2 + I = IRN(K) + IF (A(K)-U(I).GT.VJ) GO TO 60 + JJ = IPERM(I) + KK1 = PR(JJ) + KK2 = IP(JJ+1) - 1 + IF (KK1.GT.KK2) GO TO 60 + DO 70 KK = KK1,KK2 + II = IRN(KK) + IF (IPERM(II).GT.0) GO TO 70 + IF (A(KK)-U(II).LE.D(JJ)) GO TO 80 + 70 CONTINUE + PR(JJ) = KK2 + 1 + 60 CONTINUE + GO TO 95 + 80 JPERM(JJ) = KK + IPERM(II) = JJ + PR(JJ) = KK + 1 + 90 NUM = NUM + 1 + JPERM(J) = K + IPERM(I) = J + PR(J) = K + 1 + 95 CONTINUE + IF (NUM.EQ.N) GO TO 1000 + DO 99 I = 1,M + D(I) = RINF + L(I) = 0 + 99 CONTINUE + DO 100 JORD = 1,N + IF (JPERM(JORD).NE.0) GO TO 100 + DMIN = RINF + QLEN = 0 + LOW = M + 1 + UP = M + 1 + CSP = RINF + J = JORD + PR(J) = -1 + DO 115 K = IP(J),IP(J+1)-1 + I = IRN(K) + DNEW = A(K) - U(I) + IF (DNEW.GE.CSP) GO TO 115 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = K + JSP = J + ELSE + IF (DNEW.LT.DMIN) DMIN = DNEW + D(I) = DNEW + QLEN = QLEN + 1 + Q(QLEN) = K + ENDIF + 115 CONTINUE + Q0 = QLEN + QLEN = 0 + DO 120 KK = 1,Q0 + K = Q(KK) + I = IRN(K) + IF (CSP.LE.D(I)) THEN + D(I) = RINF + GO TO 120 + ENDIF + IF (D(I).LE.DMIN) THEN + LOW = LOW - 1 + Q(LOW) = I + L(I) = LOW + ELSE + QLEN = QLEN + 1 + L(I) = QLEN + CALL ZMUMPS_445(I,M,Q,D,L,2) + ENDIF + JJ = IPERM(I) + OUT(JJ) = K + PR(JJ) = J + 120 CONTINUE + DO 150 JDUM = 1,NUM + IF (LOW.EQ.UP) THEN + IF (QLEN.EQ.0) GO TO 160 + I = Q(1) + IF (D(I).LT.RINF) DMIN = D(I)*(ONE+RLX) + IF (DMIN.GE.CSP) GO TO 160 + 152 CALL ZMUMPS_446(QLEN,M,Q,D,L,2) + LOW = LOW - 1 + Q(LOW) = I + L(I) = LOW + IF (QLEN.EQ.0) GO TO 153 + I = Q(1) + IF (D(I).GT.DMIN) GO TO 153 + GO TO 152 + ENDIF + 153 Q0 = Q(UP-1) + DQ0 = D(Q0) + IF (DQ0.GE.CSP) GO TO 160 + IF (DMIN.GE.CSP) GO TO 160 + UP = UP - 1 + J = IPERM(Q0) + VJ = DQ0 - A(JPERM(J)) + U(Q0) + K1 = IP(J+1)-1 + IF (LORD) THEN + IF (CSP.NE.RINF) THEN + DI = CSP - VJ + IF (A(K1).GE.DI) THEN + K0 = JPERM(J) + IF (K0.GE.K1-6) GO TO 178 + 177 CONTINUE + K = (K0+K1)/2 + IF (A(K).GE.DI) THEN + K1 = K + ELSE + K0 = K + ENDIF + IF (K0.GE.K1-6) GO TO 178 + GO TO 177 + 178 DO 179 K = K0+1,K1 + IF (A(K).LT.DI) GO TO 179 + K1 = K - 1 + GO TO 181 + 179 CONTINUE + ENDIF + ENDIF + 181 IF (K1.EQ.JPERM(J)) K1 = K1 - 1 + ENDIF + K0 = IP(J) + DI = CSP - VJ + DO 155 K = K0,K1 + I = IRN(K) + IF (L(I).GE.LOW) GO TO 155 + DNEW = A(K) - U(I) + IF (DNEW.GE.DI) GO TO 155 + DNEW = DNEW + VJ + IF (DNEW.GT.D(I)) GO TO 155 + IF (IPERM(I).EQ.0) THEN + CSP = DNEW + ISP = K + JSP = J + DI = CSP - VJ + ELSE + IF (DNEW.GE.D(I)) GO TO 155 + D(I) = DNEW + IF (DNEW.LE.DMIN) THEN + IF (L(I).NE.0) THEN + CALL ZMUMPS_447(L(I),QLEN,M,Q,D,L,2) + ENDIF + LOW = LOW - 1 + Q(LOW) = I + L(I) = LOW + ELSE + IF (L(I).EQ.0) THEN + QLEN = QLEN + 1 + L(I) = QLEN + ENDIF + CALL ZMUMPS_445(I,M,Q,D,L,2) + ENDIF + JJ = IPERM(I) + OUT(JJ) = K + PR(JJ) = J + ENDIF + 155 CONTINUE + 150 CONTINUE + 160 IF (CSP.EQ.RINF) GO TO 190 + NUM = NUM + 1 + I = IRN(ISP) + J = JSP + IPERM(I) = J + JPERM(J) = ISP + DO 170 JDUM = 1,NUM + JJ = PR(J) + IF (JJ.EQ.-1) GO TO 180 + K = OUT(J) + I = IRN(K) + IPERM(I) = JJ + JPERM(JJ) = K + J = JJ + 170 CONTINUE + 180 DO 182 KK = UP,M + I = Q(KK) + U(I) = U(I) + D(I) - CSP + 182 CONTINUE + 190 DO 191 KK = UP,M + I = Q(KK) + D(I) = RINF + L(I) = 0 + 191 CONTINUE + DO 192 KK = LOW,UP-1 + I = Q(KK) + D(I) = RINF + L(I) = 0 + 192 CONTINUE + DO 193 KK = 1,QLEN + I = Q(KK) + D(I) = RINF + L(I) = 0 + 193 CONTINUE + 100 CONTINUE + 1000 CONTINUE + DO 1200 J = 1,N + K = JPERM(J) + IF (K.NE.0) THEN + D(J) = A(K) - U(IRN(K)) + ELSE + D(J) = ZERO + ENDIF + 1200 CONTINUE + DO 1201 I = 1,M + IF (IPERM(I).EQ.0) U(I) = ZERO + 1201 CONTINUE + IF (M.EQ.N .and. NUM.EQ.N) GO TO 2000 + CALL ZMUMPS_455(M,N,IPERM,L,JPERM) + 2000 RETURN + END SUBROUTINE ZMUMPS_454 + SUBROUTINE ZMUMPS_457 + & (M,N,IRN,LIRN,IP,LENC,IPERM,NUM,PR,ARP,CV,OUT) + IMPLICIT NONE + INTEGER LIRN,M,N,NUM + INTEGER ARP(N),CV(M),IRN(LIRN),IP(N),IPERM(M),LENC(N),OUT(N),PR(N) + INTEGER I,II,IN1,IN2,J,J1,JORD,K,KK + EXTERNAL ZMUMPS_455 + DO 10 I = 1,M + CV(I) = 0 + IPERM(I) = 0 + 10 CONTINUE + DO 12 J = 1,N + ARP(J) = LENC(J) - 1 + 12 CONTINUE + NUM = 0 + DO 1000 JORD = 1,N + J = JORD + PR(J) = -1 + DO 70 K = 1,JORD + IN1 = ARP(J) + IF (IN1.LT.0) GO TO 30 + IN2 = IP(J) + LENC(J) - 1 + IN1 = IN2 - IN1 + DO 20 II = IN1,IN2 + I = IRN(II) + IF (IPERM(I).EQ.0) GO TO 80 + 20 CONTINUE + ARP(J) = -1 + 30 CONTINUE + OUT(J) = LENC(J) - 1 + DO 60 KK = 1,JORD + IN1 = OUT(J) + IF (IN1.LT.0) GO TO 50 + IN2 = IP(J) + LENC(J) - 1 + IN1 = IN2 - IN1 + DO 40 II = IN1,IN2 + I = IRN(II) + IF (CV(I).EQ.JORD) GO TO 40 + J1 = J + J = IPERM(I) + CV(I) = JORD + PR(J) = J1 + OUT(J1) = IN2 - II - 1 + GO TO 70 + 40 CONTINUE + 50 CONTINUE + J = PR(J) + IF (J.EQ.-1) GO TO 1000 + 60 CONTINUE + 70 CONTINUE + 80 CONTINUE + IPERM(I) = J + ARP(J) = IN2 - II - 1 + NUM = NUM + 1 + DO 90 K = 1,JORD + J = PR(J) + IF (J.EQ.-1) GO TO 1000 + II = IP(J) + LENC(J) - OUT(J) - 2 + I = IRN(II) + IPERM(I) = J + 90 CONTINUE + 1000 CONTINUE + IF (M.EQ.N .and. NUM.EQ.N) GO TO 2000 + CALL ZMUMPS_455(M,N,IPERM,CV,ARP) + 2000 RETURN + END SUBROUTINE ZMUMPS_457 + SUBROUTINE ZMUMPS_455(M,N,IPERM,RW,CW) + IMPLICIT NONE + INTEGER M,N + INTEGER RW(M),CW(N),IPERM(M) + INTEGER I,J,K + DO 10 J = 1,N + CW(J) = 0 + 10 CONTINUE + K = 0 + DO 20 I = 1,M + IF (IPERM(I).EQ.0) THEN + K = K + 1 + RW(K) = I + ELSE + J = IPERM(I) + CW(J) = I + ENDIF + 20 CONTINUE + K = 0 + DO 30 J = 1,N + IF (CW(J).NE.0) GO TO 30 + K = K + 1 + I = RW(K) + IPERM(I) = -J + 30 CONTINUE + DO 40 J = N+1,M + K = K + 1 + I = RW(K) + IPERM(I) = -J + 40 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_455 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part3.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part3.F new file mode 100644 index 000000000..26a8ab08d --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part3.F @@ -0,0 +1,6719 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + RECURSIVE SUBROUTINE ZMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & + & INODE_PERE, ISON, NSLAVES_PERE, LIST_SLAVES_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP, TROW, + & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, + & root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC ) :: root + INTEGER LBUFR, LBUFR_BYTES + INTEGER ICNTL( 40 ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER SLAVEF, NBFIN + INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS, POSFAC + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), + & PIMASTER(KEEP(28)) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER COMP + INTEGER NSTK( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM, MYID + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER INODE_PERE, ISON + INTEGER NFS4FATHER + INTEGER NBROWS_ALREADY_SENT + INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE + INTEGER LIST_SLAVES_PERE( * ) + INTEGER LMAP + INTEGER TROW( LMAP ) + DOUBLE PRECISION OPASSW, OPELIW + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER NOSLA, I, ISTCHK, ISTCHK_LOC + INTEGER INDICE_PERE + INTEGER INDICE_PERE_ARRAY_ARG(1) + INTEGER PDEST, PDEST_MASTER + INTEGER NFRONT + INTEGER(8) :: SIZFR + INTEGER LDA_SON + INTEGER NSLSON, NBCOLS, NROW, NROWS_TO_SEND, IROW_SON, + & NPIV, NROWS_TO_STACK, II, COLLIST + INTEGER(8) :: POSROW, SHIFTCB_SON + INTEGER NBCOLS_EFF + INTEGER PDEST_MASTER_ISON, IPOS_IN_SLAVE + LOGICAL DESCLU, SLAVE_ISON + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER MSGSOU, MSGTAG + INTEGER LP + INTEGER ITMP + LOGICAL SAME_PROC, COMPRESSCB + LOGICAL IS_ERROR_BROADCASTED, IS_ofType5or6 + INTEGER ITYPE, TYPESPLIT + INTEGER KEEP253_LOC + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275, MUMPS_330, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, MUMPS_810 + INTEGER LMAP_LOC, allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: NBROW + INTEGER, ALLOCATABLE, DIMENSION(:) :: SLAVES_PERE + INTEGER, ALLOCATABLE, DIMENSION(:) :: MAP, PERM + IS_ERROR_BROADCASTED = .FALSE. + TYPESPLIT = MUMPS_810(PROCNODE_STEPS(STEP(INODE_PERE)), + & SLAVEF) + IS_ofType5or6 = ((TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + ALLOCATE(SLAVES_PERE(0:NSLAVES_PERE), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP > 0) write(LP,*) MYID, + & ' : PB allocation SLAVES_PERE in ZMUMPS_210' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 700 + endif + IF (NSLAVES_PERE.GT.0) + &SLAVES_PERE(1:NSLAVES_PERE) = LIST_SLAVES_PERE(1:NSLAVES_PERE) + SLAVES_PERE(0) = MUMPS_275( PROCNODE_STEPS(STEP(INODE_PERE)), + & SLAVEF ) + ALLOCATE(NBROW(0:NSLAVES_PERE), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP>0) write(LP,*) MYID, + & ' : PB allocation NBROW in ZMUMPS_210' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 670 + endif + LMAP_LOC = LMAP + ALLOCATE(MAP(LMAP_LOC), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP>0) THEN + write(LP,*) MYID, ' : PB allocation LMAP in ZMUMPS_210' + ENDIF + IFLAG =-13 + IERROR = LMAP + GOTO 680 + endif + MAP( 1 : LMAP ) = TROW( 1 : LMAP ) + PDEST_MASTER_ISON = MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) + SLAVE_ISON = PDEST_MASTER_ISON .NE. MYID + IF (SLAVE_ISON) THEN + DO WHILE ( PTRIST(STEP( ISON )) .EQ. 0 ) + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & PDEST_MASTER_ISON, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. + & ) + IF ( IFLAG .LT. 0 ) THEN + IS_ERROR_BROADCASTED = .TRUE. + GOTO 670 + ENDIF + END DO + DO WHILE ( + & ( IW( PTRIST(STEP(ISON)) + 1 + KEEP(IXSZ) ) .NE. + & IW( PTRIST(STEP(ISON)) + 3 + KEEP(IXSZ) ) ) .OR. + & ( KEEP(50) .NE. 0 .AND. + & IW( PTRIST(STEP(ISON)) + 6 + KEEP(IXSZ) ) .NE. 0 ) ) + IF ( KEEP(50).eq.0) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO + ELSE + IF ( IW( PTRIST(STEP(ISON)) + 1 + KEEP(IXSZ) ) .NE. + & IW( PTRIST(STEP(ISON)) + 3 + KEEP(IXSZ) ) ) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO_SYM + ELSE + MSGSOU = MPI_ANY_SOURCE + MSGTAG = BLOC_FACTO_SYM_SLAVE + END IF + END IF + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MSGTAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) THEN + IS_ERROR_BROADCASTED = .TRUE. + GOTO 670 + ENDIF + END DO + ENDIF + IF ( NSLAVES_PERE .EQ. 0 ) THEN + NBROW( 0 ) = LMAP + ELSE + DO I = 0, NSLAVES_PERE + NBROW( I ) = 0 + END DO + DO I = 1, LMAP_LOC + INDICE_PERE = MAP( I ) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + NBROW( NOSLA ) = NBROW( NOSLA ) + 1 + END DO + DO I = 1, NSLAVES_PERE + NBROW(I)=NBROW(I)+NBROW(I-1) + ENDDO + ENDIF + ALLOCATE(PERM(LMAP_LOC), stat=allocok) + IF (allocok .GT. 0) THEN + IF (LP.GT.0) THEN + write(LP,*) MYID,': PB allocation PERM in ZMUMPS_210' + ENDIF + IFLAG =-13 + IERROR = LMAP_LOC + GOTO 670 + ENDIF + ISTCHK = PTRIST(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + KEEP253_LOC = 0 + DO I = LMAP_LOC, 1, -1 + INDICE_PERE = MAP( I ) + IF (INDICE_PERE > NFRONT_PERE - KEEP(253)) THEN + KEEP253_LOC = KEEP253_LOC + 1 + ENDIF + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + PERM( NBROW( NOSLA ) ) = I + NBROW( NOSLA ) = NBROW( NOSLA ) - 1 + ENDDO + DO I = 0, NSLAVES_PERE + NBROW(I)=NBROW(I)+1 + END DO + PDEST_MASTER = SLAVES_PERE(0) + DO I = 0, NSLAVES_PERE + PDEST = SLAVES_PERE( I ) + IF ( PDEST .EQ. MYID ) THEN + NBPROCFILS(STEP(INODE_PERE)) = + & NBPROCFILS(STEP(INODE_PERE)) - 1 + IF ( PDEST .EQ. PDEST_MASTER ) THEN + NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - 1 + ENDIF + ISTCHK = PTRIST(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + NROW = IW(ISTCHK+2+KEEP(IXSZ)) + NPIV = IW(ISTCHK+3+KEEP(IXSZ)) + NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) + NFRONT = NPIV + NBCOLS + COMPRESSCB = (IW(ISTCHK+XXS).EQ.S_CB1COMP) + CALL MUMPS_729(SIZFR, IW(ISTCHK+XXR)) + IF (IW(ISTCHK+XXS).EQ.S_NOLCBCONTIG) THEN + LDA_SON = NBCOLS + SHIFTCB_SON = int(NPIV,8)*int(NROW,8) + ELSE IF (IW(ISTCHK+XXS).EQ.S_NOLCLEANED) THEN + LDA_SON = NBCOLS + SHIFTCB_SON = 0_8 + ELSE + LDA_SON = NFRONT + SHIFTCB_SON = int(NPIV,8) + ENDIF + IF (I == NSLAVES_PERE) THEN + NROWS_TO_STACK=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_STACK=NBROW(I+1)-NBROW(I) + ENDIF + IF (PDEST .NE. PDEST_MASTER) THEN + IF ( KEEP(55) .eq. 0 ) THEN + CALL ZMUMPS_539 + & (N, INODE_PERE, IW, LIW, + & A, LA, NROWS_TO_STACK, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP,KEEP8, MYID ) + ELSE + CALL ZMUMPS_123(NELT, FRTPTR, FRTELT, + & N, INODE_PERE, IW, LIW, + & A, LA, NROWS_TO_STACK, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, + & KEEP, KEEP8, MYID ) + ENDIF + ENDIF + DO II = 1,NROWS_TO_STACK + IROW_SON = PERM(NBROW(I)+II-1) + INDICE_PERE=MAP(IROW_SON) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + INDICE_PERE = IPOS_IN_SLAVE + IF ( COMPRESSCB ) THEN + IF (NBCOLS - NROW .EQ. 0 ) THEN + ITMP = IROW_SON + POSROW = PTRAST(STEP(ISON))+ + & int(ITMP,8) * int(ITMP-1,8) / 2_8 + ELSE + ITMP = IROW_SON + NBCOLS - NROW + POSROW = PTRAST(STEP(ISON)) + & + int(ITMP,8) * int(ITMP-1,8) / 2_8 + & - int(NBCOLS-NROW,8) * int(NBCOLS-NROW+1,8)/2_8 + ENDIF + ELSE + POSROW = PTRAST(STEP(ISON)) + SHIFTCB_SON + & +int(IROW_SON-1,8)*int(LDA_SON,8) + ENDIF + IF (PDEST == PDEST_MASTER) THEN + IF (KEEP(50).NE.0) THEN + NBCOLS_EFF = IROW_SON + NBCOLS - NROW + ELSE + NBCOLS_EFF = NBCOLS + ENDIF + INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE + IF ((IS_ofType5or6).AND.(KEEP(50).EQ.0)) THEN + CALL ZMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NROWS_TO_STACK, NBCOLS_EFF, + & INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, LDA_SON + & ) + EXIT + ELSE IF ( (KEEP(50).NE.0) .AND. + & (.NOT.COMPRESSCB).AND.(IS_ofType5or6) ) THEN + CALL ZMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NROWS_TO_STACK, + & NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, LDA_SON + &) + EXIT + ELSE + CALL ZMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB, MYID, KEEP,KEEP8, + & IS_ofType5or6, LDA_SON + &) + ENDIF + ELSE + ISTCHK = PTRIST(STEP(ISON)) + COLLIST = ISTCHK + 6 + KEEP(IXSZ) + & + IW( ISTCHK + 5 +KEEP(IXSZ)) + NROW + NPIV + IF (KEEP(50).NE.0) THEN + NBCOLS_EFF = IROW_SON + NBCOLS - NROW + ELSE + NBCOLS_EFF = NBCOLS + ENDIF + INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE + IF ( (IS_ofType5or6) .AND. + & ( + & ( KEEP(50).EQ.0) + & .OR. + & ( (KEEP(50).NE.0).and. (.NOT.COMPRESSCB) ) + & ) + & ) THEN + CALL ZMUMPS_40(N, INODE_PERE, + & IW, LIW, + & A, LA, NROWS_TO_STACK, NBCOLS, + & INDICE_PERE_ARRAY_ARG, + & IW( COLLIST ), A(POSROW), + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, ICNTL, KEEP,KEEP8, + & MYID, IS_ofType5or6, LDA_SON) + EXIT + ELSE + CALL ZMUMPS_40(N, INODE_PERE, + & IW, LIW, + & A, LA, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & IW( COLLIST ), A(POSROW), + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, + & ITLOC, RHS_MUMPS, + & FILS, ICNTL, KEEP,KEEP8, + & MYID, IS_ofType5or6, LDA_SON) + ENDIF + ENDIF + ENDDO + IF (PDEST.EQ.PDEST_MASTER) THEN + IF (KEEP(219).NE.0) THEN + IF(NSLAVES_PERE.GT.0 .AND. KEEP(50).EQ.2) THEN + IF (COMPRESSCB) THEN + WRITE(*,*) "Error 1 in PARPIV/ZMUMPS_210" + CALL MUMPS_ABORT() + ELSE + POSROW = PTRAST(STEP(ISON))+SHIFTCB_SON+ + & int(NBROW(1)-1,8)*int(LDA_SON,8) + ENDIF + CALL ZMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE.0) THEN + IF (LP .GT. 0) THEN + WRITE(LP, *) "MAX_ARRAY allocation failed" + ENDIF + IFLAG=-13 + IERROR=NFS4FATHER + GOTO 600 + ENDIF + ITMP=-9999 + IF ( LMAP_LOC-NBROW(1)+1-KEEP253_LOC .NE. 0 ) THEN + CALL ZMUMPS_618( + & A(POSROW), + & SIZFR-SHIFTCB_SON-int(NBROW(1)-1,8)*int(LDA_SON,8), + & LDA_SON, LMAP_LOC-NBROW(1)+1-KEEP253_LOC, + & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB,ITMP) + ELSE + CALL ZMUMPS_757( + & BUF_MAX_ARRAY, NFS4FATHER) + ENDIF + CALL ZMUMPS_619(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NFS4FATHER, + & BUF_MAX_ARRAY, PTLUST_S, PTRAST, + & STEP, PIMASTER, + & OPASSW,IWPOSCB,MYID, KEEP,KEEP8) + ENDIF + ENDIF + IF ( NBPROCFILS(STEP(ISON)) .EQ. 0) THEN + ISTCHK_LOC = PIMASTER(STEP(ISON)) + SAME_PROC= ISTCHK_LOC .LT. IWPOSCB + IF (SAME_PROC) THEN + CALL ZMUMPS_530(N, ISON, INODE_PERE, + & IWPOSCB, PIMASTER, PTLUST_S, IW, LIW, STEP, + & KEEP,KEEP8) + ENDIF + IF (SAME_PROC) THEN + ISTCHK_LOC = PTRIST(STEP(ISON)) + PTRIST(STEP( ISON) ) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL ZMUMPS_152(.FALSE., MYID, N, + & ISTCHK_LOC, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, IWPOSCB, + & LA, KEEP,KEEP8, .FALSE. + & ) + ENDIF + IF ( NBPROCFILS(STEP(INODE_PERE)) .EQ. 0 ) THEN + CALL ZMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), + & KEEP(47), STEP, INODE_PERE+N ) + IF (KEEP(47) .GE. 3) THEN + CALL ZMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + ELSE + CALL ZMUMPS_531 + & (N, INODE_PERE, IW, LIW, + & NBROW(I), STEP, PTRIST, ITLOC, RHS_MUMPS, + & KEEP,KEEP8) + END IF + END IF + END DO + DO I = NSLAVES_PERE, 0, -1 + PDEST = SLAVES_PERE( I ) + IF ( PDEST .NE. MYID ) THEN + DESCLU = .FALSE. + NBROWS_ALREADY_SENT = 0 + IF (I == NSLAVES_PERE) THEN + NROWS_TO_SEND=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_SEND=NBROW(I+1)-NBROW(I) + ENDIF + COMPRESSCB=(IW(PTRIST(STEP(ISON))+XXS).EQ.S_CB1COMP) + 95 CONTINUE + IF ( PTRIST(STEP(ISON)) .lt.0 .or. + & IW ( PTRIST(STEP(ISON) )+KEEP(IXSZ) ) .GT. N ) THEN + WRITE(*,*) MYID,': Internal error in Maplig' + WRITE(*,*) MYID,': PTRIST(STEP(ISON))/N=', + & PTRIST(STEP(ISON)), N + WRITE(*,*) MYID,': I, NBROW(I)=',I, NBROW(I) + WRITE(*,*) MYID,': NSLAVES_PERE=',NSLAVES_PERE + WRITE(*,*) MYID,': ISON, INODE_PERE=',ISON,INODE_PERE + WRITE(*,*) MYID,': Son header=', + & IW(PTRIST(STEP(ISON)): PTRIST(STEP(ISON))+5+KEEP(IXSZ)) + CALL MUMPS_ABORT() + END IF + CALL ZMUMPS_67( NBROWS_ALREADY_SENT, + & DESCLU, INODE_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER, + & NSLAVES_PERE, ISON, + & NROWS_TO_SEND, LMAP_LOC, MAP, + & PERM(min(LMAP_LOC,NBROW(I))), + & IW( PTRIST(STEP(ISON))), + & A(PTRAST(STEP(ISON))), I, PDEST, PDEST_MASTER, + & COMM, IERR, + & + & KEEP,KEEP8, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, COMPRESSCB, + & KEEP253_LOC ) + IF ( IERR .EQ. -2 ) THEN + IFLAG = -17 + IF (LP .GT. 0) THEN + WRITE(LP,*) + & "FAILURE: SEND BUFFER TOO SMALL IN ZMUMPS_210" + ENDIF + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * IW(PTRIST(STEP(ISON))+KEEP(IXSZ)) + & * KEEP( 35 ) + GO TO 600 + END IF + IF ( IERR .EQ. -3 ) THEN + IF (LP .GT. 0) THEN + WRITE(LP,*) + & "FAILURE: RECV BUFFER TOO SMALL IN ZMUMPS_210" + ENDIF + IFLAG = -20 + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * IW(PTRIST(STEP(ISON))+KEEP(IXSZ)) + & * KEEP( 35 ) + GOTO 600 + ENDIF + IF (KEEP(219).NE.0) THEN + IF ( IERR .EQ. -4 ) THEN + IFLAG = -13 + IERROR = NFS4FATHER + IF (LP .GT. 0) THEN + WRITE(LP, *) + & "FAILURE: MAX_ARRAY allocation failed IN ZMUMPS_210" + ENDIF + GO TO 600 + END IF + END IF + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) THEN + IS_ERROR_BROADCASTED=.TRUE. + GOTO 600 + ENDIF + GO TO 95 + END IF + END IF + END DO + ITYPE = MUMPS_330(PROCNODE_STEPS(STEP(ISON)), SLAVEF) + IF (KEEP(214) .EQ. 2) THEN + CALL ZMUMPS_314( N, ISON, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE + & ) + IF (IFLAG .LT. 0) THEN + IS_ERROR_BROADCASTED = .TRUE. + GOTO 600 + ENDIF + ENDIF + CALL ZMUMPS_626( N, ISON, PTRIST, PTRAST, IW, LIW, + & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, + & STEP, MYID, KEEP + &) + 600 CONTINUE + DEALLOCATE(PERM) + 670 CONTINUE + DEALLOCATE(MAP) + 680 CONTINUE + DEALLOCATE(NBROW) + DEALLOCATE(SLAVES_PERE) + 700 CONTINUE + IF (IFLAG .LT. 0 .AND. .NOT. IS_ERROR_BROADCASTED) THEN + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_210 + SUBROUTINE ZMUMPS_211( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & + & INODE_PERE, ISON, NSLAVES_PERE, LIST_SLAVES_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER, LMAP, TROW, + & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER ICNTL( 40 ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER SLAVEF, NBFIN + INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS, POSFAC + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + COMPLEX(kind=8) A( LA ) + INTEGER COMP + INTEGER IFLAG, IERROR, COMM, MYID + INTEGER LPOOL, LEAF + INTEGER INODE_PERE, ISON + INTEGER NFS4FATHER + INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE + INTEGER LIST_SLAVES_PERE(NSLAVES_PERE) + INTEGER NELIM, LMAP, TROW( LMAP ) + DOUBLE PRECISION OPASSW, OPELIW + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + INTEGER LPTRAR, NELT + INTEGER IW( LIW ) + INTEGER BUFR( LBUFR ) + INTEGER IPOOL( LPOOL ) + INTEGER NSTK( KEEP(28) ), ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER ITLOC( N+KEEP(253) ), FILS( N ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER LP + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER NOSLA, I, ISTCHK, ISTCHK_LOC + INTEGER NBROWS_ALREADY_SENT + INTEGER INDICE_PERE + INTEGER INDICE_PERE_ARRAY_ARG(1) + INTEGER PDEST, PDEST_MASTER, NFRONT + LOGICAL SAME_PROC, DESCLU + INTEGER(8) :: APOS, POSROW, ASIZE + INTEGER NSLSON, NBCOLS, NROW, NROWS_TO_SEND, + & NPIV, NROWS_TO_STACK, II, IROW_SON, + & IPOS_IN_SLAVE + INTEGER NBCOLS_EFF + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + LOGICAL COMPRESSCB + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER LMAP_LOC, allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: NBROW + INTEGER, ALLOCATABLE, DIMENSION(:) :: SLAVES_PERE + INTEGER, ALLOCATABLE, DIMENSION(:) :: MAP, PERM + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + if (NSLAVES_PERE.le.0) then + write(6,*) ' error 2 in maplig_fils_niv1 ', NSLAVES_PERE + CALL MUMPS_ABORT() + endif + ALLOCATE(NBROW(0:NSLAVES_PERE), stat=allocok) + IF (allocok .GT. 0) THEN + IF (LP > 0) + & write(LP,*) MYID, + & ' : PB allocation NBROW in ZMUMPS_211' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 700 + ENDIF + ALLOCATE(SLAVES_PERE(0:NSLAVES_PERE), stat =allocok) + IF ( allocok .GT. 0 ) THEN + IF (LP > 0) write(LP,*) MYID, + & ' : PB allocation SLAVES_PERE in ZMUMPS_211' + IFLAG =-13 + IERROR = NSLAVES_PERE+1 + GOTO 700 + ENDIF + SLAVES_PERE(1:NSLAVES_PERE) = LIST_SLAVES_PERE(1:NSLAVES_PERE) + SLAVES_PERE(0) = MUMPS_275( + & PROCNODE_STEPS(STEP(INODE_PERE)), + & SLAVEF ) + LMAP_LOC = LMAP + ALLOCATE(MAP(LMAP_LOC), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP > 0) write(LP,*) MYID, + & ' : PB allocation LMAP in ZMUMPS_211' + IFLAG =-13 + IERROR = LMAP_LOC + GOTO 700 + endif + MAP( 1 : LMAP_LOC ) = TROW( 1 : LMAP_LOC ) + DO I = 0, NSLAVES_PERE + NBROW( I ) = 0 + END DO + IF (NSLAVES_PERE == 0) THEN + NBROW(0) = LMAP_LOC + ELSE + DO I = 1, LMAP_LOC + INDICE_PERE = MAP( I ) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + NBROW( NOSLA ) = NBROW( NOSLA ) + 1 + END DO + DO I = 1, NSLAVES_PERE + NBROW(I)=NBROW(I)+NBROW(I-1) + ENDDO + ENDIF + ALLOCATE(PERM(LMAP_LOC), stat=allocok) + if (allocok .GT. 0) THEN + IF (LP > 0) write(LP,*) MYID, + & ': PB allocation PERM in ZMUMPS_211' + IFLAG =-13 + IERROR = LMAP_LOC + GOTO 700 + endif + ISTCHK = PIMASTER(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + DO I = LMAP_LOC, 1, -1 + INDICE_PERE = MAP( I ) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + PERM( NBROW( NOSLA ) ) = I + NBROW( NOSLA ) = NBROW( NOSLA ) - 1 + ENDDO + DO I = 0, NSLAVES_PERE + NBROW(I)=NBROW(I)+1 + END DO + PDEST_MASTER = MYID + IF ( SLAVES_PERE(0) .NE. MYID ) THEN + WRITE(*,*) 'Error 1 in MAPLIG_FILS_NIV1:',MYID, SLAVES_PERE + CALL MUMPS_ABORT() + END IF + PDEST = PDEST_MASTER + I = 0 + NBPROCFILS(STEP(INODE_PERE))=NBPROCFILS(STEP(INODE_PERE))-1 + NBPROCFILS(STEP(ISON)) = NBPROCFILS(STEP(ISON)) - 1 + ISTCHK = PIMASTER(STEP(ISON)) + NBCOLS = IW(ISTCHK+KEEP(IXSZ)) + NELIM = IW(ISTCHK+1+KEEP(IXSZ)) + NROW = IW(ISTCHK+2+KEEP(IXSZ)) + NPIV = IW(ISTCHK+3+KEEP(IXSZ)) + IF (NPIV.LT.0) THEN + write(6,*) ' Error 2 in ZMUMPS_211 ', NPIV + CALL MUMPS_ABORT() + ENDIF + NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) + NFRONT = NPIV + NBCOLS + COMPRESSCB=(IW(PTRIST(STEP(ISON))+XXS) .eq. S_CB1COMP) + IF (I == NSLAVES_PERE) THEN + NROWS_TO_STACK=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_STACK=NBROW(I+1)-NBROW(I) + ENDIF + DO II = 1,NROWS_TO_STACK + IROW_SON=PERM(NBROW(I)+II-1) + INDICE_PERE = MAP(IROW_SON) + CALL MUMPS_47( + & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & + & NASS_PERE, + & NFRONT_PERE - NASS_PERE, + & NSLAVES_PERE, + & INDICE_PERE, + & NOSLA, + & IPOS_IN_SLAVE ) + INDICE_PERE = IPOS_IN_SLAVE + IF (COMPRESSCB) THEN + IF (NELIM.EQ.0) THEN + POSROW = PAMASTER(STEP(ISON)) + + & int(IROW_SON,8)*int(IROW_SON-1,8)/2_8 + ELSE + POSROW = PAMASTER(STEP(ISON)) + + & int(NELIM+IROW_SON,8)*int(NELIM+IROW_SON-1,8)/2_8 + ENDIF + ELSE + POSROW = PAMASTER(STEP(ISON)) + + & int(NELIM+IROW_SON-1,8)*int(NBCOLS,8) + ENDIF + IF (KEEP(50).NE.0) THEN + NBCOLS_EFF = NELIM + IROW_SON + ELSE + NBCOLS_EFF = NBCOLS + ENDIF + INDICE_PERE_ARRAY_ARG(1) = INDICE_PERE + CALL ZMUMPS_39(N, INODE_PERE, IW, LIW, + & A, LA, ISON, 1, NBCOLS_EFF, INDICE_PERE_ARRAY_ARG, + & A(POSROW), PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, IWPOSCB, + & MYID, KEEP,KEEP8,.FALSE.,NBCOLS_EFF) + ENDDO + IF (KEEP(219).NE.0) THEN + IF(NSLAVES_PERE.GT.0 .AND. KEEP(50).EQ.2) THEN + IF (COMPRESSCB) THEN + POSROW = PAMASTER(STEP(ISON)) + & + int(NELIM+NBROW(1),8)*int(NELIM+NBROW(1)-1,8)/2_8 + ASIZE = int(LMAP_LOC+NELIM,8)*int(NELIM+LMAP_LOC+1,8)/2_8 + & - int(NELIM+NBROW(1),8)*int(NELIM+NBROW(1)-1,8)/2_8 + ELSE + POSROW = PAMASTER(STEP(ISON)) + + & int(NELIM+NBROW(1)-1,8)*int(NBCOLS,8) + ASIZE = int(LMAP_LOC-NBROW(1)+1,8) * int(NBCOLS,8) + ENDIF + CALL ZMUMPS_617(NFS4FATHER,IERR) + IF (IERR .NE.0) THEN + IF (LP > 0) WRITE(LP,*) MYID, + & ": PB allocation MAX_ARRAY during ZMUMPS_211" + IFLAG=-13 + IERROR=NFS4FATHER + GOTO 700 + ENDIF + IF ( LMAP_LOC-NBROW(1)+1-KEEP(253).GT. 0 ) THEN + CALL ZMUMPS_618( + & A(POSROW),ASIZE,NBCOLS, + & LMAP_LOC-NBROW(1)+1-KEEP(253), + & BUF_MAX_ARRAY,NFS4FATHER,COMPRESSCB, + & NELIM+NBROW(1)) + ELSE + CALL ZMUMPS_757(BUF_MAX_ARRAY, + & NFS4FATHER) + ENDIF + CALL ZMUMPS_619(N, INODE_PERE, IW, LIW, + & A, LA, ISON, NFS4FATHER, + & BUF_MAX_ARRAY, PTLUST_S, PTRAST, + & STEP, PIMASTER, OPASSW, + & IWPOSCB,MYID, KEEP,KEEP8) + ENDIF + ENDIF + IF ( NBPROCFILS(STEP(ISON)) .EQ. 0) THEN + ISTCHK_LOC = PIMASTER(STEP(ISON)) + SAME_PROC= ISTCHK_LOC .LT. IWPOSCB + IF (SAME_PROC) THEN + CALL ZMUMPS_530(N, ISON, INODE_PERE, + & IWPOSCB, PIMASTER, PTLUST_S, IW, LIW, STEP, + & KEEP,KEEP8) + ENDIF + ENDIF + IF ( NBPROCFILS(STEP(INODE_PERE)) .EQ. 0 ) THEN + CALL ZMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), + & KEEP(47), STEP, INODE_PERE+N ) + IF (KEEP(47) .GE. 3) THEN + CALL ZMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + DO I = 0, NSLAVES_PERE + PDEST = SLAVES_PERE( I ) + IF ( PDEST .NE. MYID ) THEN + NBROWS_ALREADY_SENT = 0 + 95 CONTINUE + NFRONT = IW(PIMASTER(STEP(ISON))+KEEP(IXSZ)) + NELIM = IW(PIMASTER(STEP(ISON))+1+KEEP(IXSZ)) + APOS = PAMASTER(STEP(ISON)) + DESCLU = .TRUE. + IF (I == NSLAVES_PERE) THEN + NROWS_TO_SEND=LMAP_LOC-NBROW(I)+1 + ELSE + NROWS_TO_SEND=NBROW(I+1)-NBROW(I) + ENDIF + CALL ZMUMPS_67(NBROWS_ALREADY_SENT, + & DESCLU, INODE_PERE, + & NFRONT_PERE, NASS_PERE, NFS4FATHER, + & NSLAVES_PERE, + & ISON, NROWS_TO_SEND, LMAP_LOC, + & MAP, PERM(min(LMAP_LOC,NBROW(I))), + & IW(PIMASTER(STEP(ISON))), + & A(APOS), I, PDEST, PDEST_MASTER, COMM, IERR, + & + & KEEP,KEEP8, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & COMPRESSCB, KEEP(253)) + IF ( IERR .EQ. -2 ) THEN + IF (LP > 0) WRITE(LP,*) MYID, + &": FAILURE, SEND BUFFER TOO SMALL DURING ZMUMPS_211" + IFLAG = -17 + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * KEEP( 35 ) + GO TO 700 + END IF + IF ( IERR .EQ. -3 ) THEN + IF (LP > 0) WRITE(LP,*) MYID, + &": FAILURE, RECV BUFFER TOO SMALL DURING ZMUMPS_211" + IFLAG = -20 + IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) + + & NROWS_TO_SEND * KEEP( 35 ) + GO TO 700 + ENDIF + IF (KEEP(219).NE.0) THEN + IF ( IERR .EQ. -4 ) THEN + IFLAG = -13 + IERROR = BUF_LMAX_ARRAY + IF (LP > 0) WRITE(LP,*) MYID, + &": FAILURE, MAX_ARRAY ALLOC FAILED DURING ZMUMPS_211" + GO TO 700 + ENDIF + ENDIF + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + GO TO 95 + END IF + END IF + END DO + ISTCHK = PTRIST(STEP(ISON)) + PTRIST(STEP( ISON )) = -77777777 + IF ( IW(ISTCHK+KEEP(IXSZ)) .GE. 0 ) THEN + WRITE(*,*) 'error 3 in ZMUMPS_211' + CALL MUMPS_ABORT() + ENDIF + CALL ZMUMPS_152(.FALSE., MYID, N, ISTCHK, + & PAMASTER(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + 600 CONTINUE + DEALLOCATE(NBROW) + DEALLOCATE(MAP) + DEALLOCATE(PERM) + DEALLOCATE(SLAVES_PERE) + RETURN + 700 CONTINUE + CALL ZMUMPS_44(MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE ZMUMPS_211 + SUBROUTINE ZMUMPS_93(SIZE_INPLACE, + &MYID,N,IOLDPS,TYPE,IW, LIW, A, LA, + &POSFAC, LRLU, LRLUS, IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8, + &SSARBR,INODE,IERR) + USE ZMUMPS_LOAD + USE ZMUMPS_OOC + IMPLICIT NONE + INTEGER MYID + INTEGER IOLDPS, TYPE, LIW, N, KEEP(500) + INTEGER(8) :: SIZE_INPLACE, LA, POSFAC, LRLU, LRLUS + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) KEEP8(150) + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER IWPOS, LDLT + INTEGER STEP( N ) + INTEGER (8) :: PTRFAC(KEEP(28)) + LOGICAL SSARBR + INTEGER IOLDSHIFT, IPSSHIFT + INCLUDE 'mumps_headers.h' + INTEGER LCONT, NELIM, NROW, NPIV, INTSIZ + INTEGER NFRONT, NSLAVES + INTEGER IPS, IPSIZE + INTEGER(8) :: SIZELU, SIZECB, IAPOS, I + LOGICAL MOVEPTRAST + INTEGER INODE + INTEGER IERR + IERR=0 + LDLT = KEEP(50) + IOLDSHIFT = IOLDPS + KEEP(IXSZ) + IF ( IW( IOLDSHIFT ) < 0 ) THEN + write(*,*) ' ERROR 1 compressLU:Should not point to a band.' + CALL MUMPS_ABORT() + ELSE IF ( IW( IOLDSHIFT + 2 ) < 0 ) THEN + write(*,*) ' ERROR 2 compressLU:Stack not performed yet', + & IW(IOLDSHIFT + 2) + CALL MUMPS_ABORT() + ENDIF + LCONT = IW( IOLDSHIFT ) + NELIM = IW( IOLDSHIFT + 1 ) + NROW = IW( IOLDSHIFT + 2 ) + NPIV = IW( IOLDSHIFT + 3 ) + IAPOS = PTRFAC(IW( IOLDSHIFT + 4 )) + NSLAVES= IW( IOLDSHIFT + 5 ) + NFRONT = LCONT + NPIV + INTSIZ = IW(IOLDPS+XXI) + IF ( (NSLAVES > 0 .AND. TYPE .NE. 2) .OR. + & (NSLAVES .eq. 0 .AND. TYPE .EQ. 2 ) ) THEN + WRITE(*,*) ' ERROR 3 compressLU: problem with level of inode' + CALL MUMPS_ABORT() + END IF + IF (LDLT.EQ.0) THEN + SIZELU = int(LCONT + NROW, 8) * int(NPIV,8) + ELSE + SIZELU = int(NROW,8) * int(NPIV,8) + ENDIF + IF ( TYPE .EQ. 2 ) THEN + IF (LDLT.EQ.0) THEN + SIZECB = int(NELIM,8) * int(LCONT,8) + ELSE + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + SIZECB = int(NELIM+1,8) * int(NELIM + NPIV,8) + ELSE + SIZECB = int(NELIM,8) * int(NELIM + NPIV,8) + ENDIF + ENDIF + ELSE + IF (LDLT.EQ.0) THEN + SIZECB = int(LCONT,8) * int(LCONT,8) + ELSE + SIZECB = int(NROW,8) * int(LCONT,8) + ENDIF + END IF + CALL MUMPS_724( IW(IOLDPS+XXR), SIZECB ) + IF ((SIZECB.EQ.0_8).AND.(KEEP(201).EQ.0)) THEN + GOTO 500 + ENDIF + IF (KEEP(201).EQ.2) THEN + KEEP8(31)=KEEP8(31)+SIZELU + CALL ZMUMPS_576(INODE,PTRFAC,KEEP,KEEP8, + & A,LA,SIZELU, IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID,': Internal error in ZMUMPS_576' + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF ( IOLDPS + INTSIZ .NE. IWPOS ) THEN + IPS = IOLDPS + INTSIZ + MOVEPTRAST = .FALSE. + DO WHILE ( IPS .NE. IWPOS ) + IPSIZE = IW(IPS+XXI) + IPSSHIFT = IPS + KEEP(IXSZ) + IF ( IW( IPSSHIFT + 2 ) < 0 ) THEN + NFRONT = IW( IPSSHIFT ) + IF(KEEP(201).EQ.0)THEN + PTRFAC(IW( IPSSHIFT + 4 )) = + & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB + ELSE + PTRFAC(IW(IPSSHIFT+4))=PTRFAC(IW(IPSSHIFT+4)) - + & SIZECB - SIZELU + ENDIF + MOVEPTRAST = .TRUE. + IF(KEEP(201).EQ.0)THEN + PTRAST(IW(IPSSHIFT+4))=PTRAST(IW(IPSSHIFT+4))-SIZECB + ELSE + PTRAST(IW(IPSSHIFT+4))=PTRAST(IW(IPSSHIFT+4))-SIZECB + & - SIZELU + ENDIF + ELSE IF ( IW( IPSSHIFT ) < 0 ) THEN + IF(KEEP(201).EQ.0)THEN + PTRFAC(IW(IPSSHIFT+3)) = PTRFAC(IW(IPSSHIFT+3))-SIZECB + ELSE + PTRFAC(IW(IPSSHIFT+3)) = PTRFAC(IW(IPSSHIFT+3)) + & -SIZECB-SIZELU + ENDIF + ELSE + NFRONT = IW( IPSSHIFT ) + IW( IPSSHIFT + 3 ) + IF(KEEP(201).EQ.0)THEN + PTRFAC(IW( IPSSHIFT + 4 )) = + & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB + ELSE + PTRFAC(IW( IPSSHIFT + 4 )) = + & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB + & - SIZELU + ENDIF + END IF + IPS = IPS + IPSIZE + END DO + IF ((SIZECB .NE. 0_8).OR.(KEEP(201).NE.0)) THEN + IF (KEEP(201).NE.0) THEN + DO I=IAPOS, POSFAC - SIZECB - SIZELU - 1_8 + A( I ) = A( I + SIZECB + SIZELU) + END DO + ELSE + DO I=IAPOS + SIZELU, POSFAC - SIZECB - 1_8 + A( I ) = A( I + SIZECB ) + END DO + ENDIF + END IF + ENDIF + IF (KEEP(201).NE.0) THEN + POSFAC = POSFAC - (SIZECB+SIZELU) + LRLU = LRLU + (SIZECB+SIZELU) + LRLUS = LRLUS + (SIZECB+SIZELU) - SIZE_INPLACE + ELSE + POSFAC = POSFAC - SIZECB + LRLU = LRLU + SIZECB + LRLUS = LRLUS + SIZECB - SIZE_INPLACE + ENDIF + 500 CONTINUE + CALL ZMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,SIZELU,-SIZECB+SIZE_INPLACE,KEEP,KEEP8,LRLU) + RETURN + END SUBROUTINE ZMUMPS_93 + SUBROUTINE ZMUMPS_314( N, ISON, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, TYPE_SON + & ) + USE ZMUMPS_OOC + USE ZMUMPS_LOAD + IMPLICIT NONE + INTEGER(8) :: LA, LRLU, LRLUS, POSFAC, IPTRLU + INTEGER N, ISON, LIW, IWPOS, IWPOSCB, + & COMP, IFLAG, IERROR, SLAVEF, MYID, COMM, + & TYPE_SON + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), STEP(N), + & PIMASTER(KEEP(28)), IW(LIW) + INTEGER PTLUST_S(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + DOUBLE PRECISION OPELIW + DOUBLE PRECISION FLOP1, FLOP1_EFFECTIVE + COMPLEX(kind=8) A( LA ) + INTEGER(8) :: LREQA, POSA, POSALOC, OLDPOS, JJ + INTEGER NFRONT, NCOL_L, NROW_L, LREQI, NSLAVES_L, + & POSI, I, IROW_L, ICOL_L, LDA_BAND, NASS + LOGICAL NONEED_TO_COPY_FACTORS + INTEGER(8) :: LAFAC, LREQA_HEADER + INTEGER LIWFAC, STRAT, TYPEFile, NextPivDummy, + & IOLDPS_CB + LOGICAL LAST_CALL + TYPE(IO_BLOCK) :: MonBloc + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0d0) + FLOP1 = ZERO + NCOL_L = IW( PTRIST(STEP( ISON )) + 3 + KEEP(IXSZ) ) + NROW_L = IW( PTRIST(STEP( ISON )) + 2 + KEEP(IXSZ) ) + NSLAVES_L = IW( PTRIST(STEP( ISON )) + 5 + KEEP(IXSZ) ) + LDA_BAND = NCOL_L + IW( PTRIST(STEP( ISON )) + KEEP(IXSZ) ) + IF ( KEEP(50) .eq. 0 ) THEN + NFRONT = LDA_BAND + ELSE + NFRONT = IW( PTRIST(STEP( ISON )) + 7 + KEEP(IXSZ) ) + END IF + IF (KEEP(201).EQ.1) THEN + IOLDPS_CB = PTRIST(STEP( ISON )) + CALL MUMPS_729(LAFAC, IW(IOLDPS_CB+XXR)) + LIWFAC = IW(IOLDPS_CB+XXI) + TYPEFile = TYPEF_L + NextPivDummy = -8888 + MonBloc%INODE = ISON + MonBloc%MASTER = .FALSE. + MonBloc%Typenode = 2 + MonBloc%NROW = NROW_L + MonBloc%NCOL = LDA_BAND + MonBloc%NFS = IW(IOLDPS_CB+1+KEEP(IXSZ)) + MonBloc%LastPiv = NCOL_L + NULLIFY(MonBloc%INDICES) + STRAT = STRAT_WRITE_MAX + LAST_CALL = .TRUE. + MonBloc%Last = .TRUE. + CALL ZMUMPS_688 + & ( STRAT, TYPEFile, + & A(PTRAST(STEP(ISON))), LAFAC, MonBloc, + & NextPivDummy, NextPivDummy, + & IW(IOLDPS_CB), LIWFAC, + & MYID, KEEP8(31), IFLAG,LAST_CALL ) + IF ((NCOL_L.EQ.0).OR.(NROW_L.EQ.0)) THEN + ENDIF + ENDIF + NONEED_TO_COPY_FACTORS = (KEEP(201).EQ.1) .OR. (KEEP(201).EQ.-1) + IF ((NCOL_L.EQ.0).OR.(NROW_L.EQ.0)) THEN + GOTO 80 + ENDIF + LREQI = 4 + NCOL_L + NROW_L + KEEP(IXSZ) + LREQA_HEADER = int(NCOL_L,8) * int(NROW_L,8) + IF (NONEED_TO_COPY_FACTORS) THEN + LREQA = 0_8 + ELSE + LREQA = LREQA_HEADER + ENDIF + IF ( LRLU .LT. LREQA .OR. + & IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LREQA ) THEN + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GO TO 700 + END IF + CALL ZMUMPS_94( N,KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS,IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress Stack_band:LRLU,LRLUS=', + & LRLU, LRLUS + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GOTO 700 + END IF + IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + GOTO 700 + END IF + END IF + IF (.NOT. NONEED_TO_COPY_FACTORS) THEN + POSA = POSFAC + POSFAC = POSFAC + LREQA + LRLU = LRLU - LREQA + LRLUS = LRLUS - LREQA + KEEP8(67) = min(LRLUS, KEEP8(67)) + IF(KEEP(201).NE.2)THEN + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,LREQA,LREQA,KEEP,KEEP8,LRLU) + ELSE + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU) + ENDIF + ENDIF + POSI = IWPOS + IWPOS = IWPOS + LREQI + PTLUST_S(STEP( ISON )) = POSI + IW(POSI+XXI)=LREQI + CALL MUMPS_730(LREQA, IW(POSI+XXR)) + CALL MUMPS_730(LREQA_HEADER, IW(POSI+XXR)) + IW(POSI+XXS)=-9999 + POSI=POSI+KEEP(IXSZ) + IW( POSI ) = - NCOL_L + IW( POSI + 1 ) = NROW_L + IW( POSI + 2 ) = NFRONT - NCOL_L + IW( POSI + 3 ) = STEP(ISON) + IF (.NOT. NONEED_TO_COPY_FACTORS) THEN + PTRFAC(STEP(ISON)) = POSA + ELSE + PTRFAC(STEP(ISON)) = -77777_8 + ENDIF + IROW_L = PTRIST(STEP(ISON)) + 6 + NSLAVES_L + KEEP(IXSZ) + ICOL_L = PTRIST(STEP(ISON)) + 6 + NROW_L + NSLAVES_L + KEEP(IXSZ) + DO I = 1, NROW_L + IW( POSI+3+I ) = IW( IROW_L+I-1 ) + ENDDO + DO I = 1, NCOL_L + IW( POSI+NROW_L+3+I) = IW( ICOL_L+I-1 ) + ENDDO + IF (.NOT.NONEED_TO_COPY_FACTORS) THEN + POSALOC = POSA + DO I = 1, NROW_L + OLDPOS = PTRAST( STEP(ISON)) + int(I-1,8)*int(LDA_BAND,8) + DO JJ = 0_8, int(NCOL_L-1,8) + A( POSALOC+JJ ) = A( OLDPOS+JJ ) + ENDDO + POSALOC = POSALOC + int(NCOL_L,8) + END DO + ENDIF + IF (KEEP(201).EQ.2) THEN + KEEP8(31)=KEEP8(31)+LREQA + ENDIF + KEEP8(10) = KEEP8(10) + int(NCOL_L,8) * int(NROW_L,8) + IF (KEEP(201).EQ.2) THEN + CALL ZMUMPS_576(ISON,PTRFAC,KEEP,KEEP8,A,LA,LREQA,IFLAG) + IF(IFLAG.LT.0)THEN + WRITE(*,*)MYID,': Internal error in ZMUMPS_576' + IERROR=0 + GOTO 700 + ENDIF + ENDIF + IF (KEEP(201).EQ.2) THEN + POSFAC = POSFAC - LREQA + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,LREQA,0_8,KEEP,KEEP8,LRLU) + ENDIF + 80 CONTINUE + IF (TYPE_SON == 1) THEN + GOTO 90 + ENDIF + IF ( KEEP(50) .eq. 0 ) THEN + FLOP1 = dble( NCOL_L * NROW_L) + + & dble(NROW_L*NCOL_L)*dble(2*NFRONT-NCOL_L-1) + ELSE + FLOP1 = dble( NCOL_L ) * dble( NROW_L ) + & * dble( 2 * LDA_BAND - NROW_L - NCOL_L + 1) + END IF + OPELIW = OPELIW + FLOP1 + FLOP1_EFFECTIVE = FLOP1 + NASS = IW( PTRIST(STEP( ISON )) + 4 + KEEP(IXSZ) ) + IF ( NCOL_L .NE. NASS ) THEN + IF ( KEEP(50).eq.0 ) THEN + FLOP1 = dble( NASS * NROW_L) + + & dble(NROW_L*NASS)*dble(2*NFRONT-NASS-1) + ELSE + FLOP1 = dble( NASS ) * dble( NROW_L ) * + & dble( 2 * LDA_BAND - NROW_L - NASS + 1) + END IF + END IF + CALL ZMUMPS_190(1,.FALSE.,FLOP1_EFFECTIVE-FLOP1, + & KEEP,KEEP8) + CALL ZMUMPS_190(2,.FALSE.,-FLOP1,KEEP,KEEP8) + 90 CONTINUE + RETURN + 700 CONTINUE + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE ZMUMPS_314 + SUBROUTINE ZMUMPS_626( N, ISON, + & PTRIST, PTRAST, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOSCB, + & IPTRLU, STEP, MYID, KEEP + & ) + IMPLICIT NONE + include 'mumps_headers.h' + INTEGER(8) :: LRLU, LRLUS, IPTRLU, LA + INTEGER ISON, MYID, N, IWPOSCB + INTEGER KEEP(500), STEP(N) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER PTRIST(KEEP(28)) + INTEGER LIW + INTEGER IW(LIW) + COMPLEX(kind=8) A(LA) + INTEGER ISTCHK + ISTCHK = PTRIST(STEP(ISON)) + CALL ZMUMPS_152(.FALSE.,MYID, N, ISTCHK, + & PTRAST(STEP(ISON)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + PTRIST(STEP( ISON )) = -9999888 + PTRAST(STEP( ISON )) = -9999888_8 + RETURN + END SUBROUTINE ZMUMPS_626 + SUBROUTINE ZMUMPS_214( KEEP,KEEP8, + & MYID, N, NELT, LNA, NZ, NA_ELT, NSLAVES, + & MEMORY_MBYTES, EFF, OOC_STRAT, PERLU_ON, + & MEMORY_BYTES ) + IMPLICIT NONE + LOGICAL, INTENT(IN) :: EFF, PERLU_ON + INTEGER, INTENT(IN) :: OOC_STRAT + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER MYID, N, NELT, NSLAVES, LNA, NZ, NA_ELT + INTEGER(8), INTENT(OUT) :: MEMORY_BYTES + INTEGER, INTENT(OUT) :: MEMORY_MBYTES + LOGICAL :: I_AM_SLAVE, I_AM_MASTER + INTEGER :: PERLU, NBRECORDS + INTEGER(8) :: NB_REAL, MAXS_MIN + INTEGER(8) :: TEMP, NB_BYTES, NB_INT + INTEGER :: ZMUMPS_LBUF_INT, ZMUMPS_LBUFR_BYTES, ZMUMPS_LBUF + INTEGER :: NBUFS + INTEGER(8) :: TEMPI + INTEGER(8) :: TEMPR + INTEGER :: MIN_PERLU + INTEGER(8) :: BUF_OOC, BUF_OOC_PANEL, BUF_OOC_NOPANEL + INTEGER(8) :: OOC_NB_FILE_TYPE + INTEGER(8) :: NSTEPS8, N8, NELT8 + INTEGER(8) :: I8OVERI + I8OVERI = int(KEEP(10),8) + PERLU = KEEP(12) + NSTEPS8 = int(KEEP(28),8) + N8 = int(N,8) + NELT8 = int(NELT,8) + IF (.NOT.PERLU_ON) PERLU = 0 + I_AM_MASTER = ( MYID .eq. 0 ) + I_AM_SLAVE = ( KEEP(46).eq. 1 .or. MYID .ne. 0 ) + TEMP = 0_8 + NB_REAL = 0_8 + NB_BYTES = 0_8 + NB_INT = 0_8 + NB_INT = NB_INT + 5_8 * NSTEPS8 + NB_INT = NB_INT + NSTEPS8 + int(KEEP(56),8)*int(NSLAVES+2,8) + NB_INT = NB_INT + 3_8 * N8 + IF (KEEP(23).ne.0 .and. I_AM_MASTER) NB_INT=NB_INT + N8 + IF (KEEP(55).eq.0) THEN + NB_INT = NB_INT + 2_8 * N8 + ELSE + NB_INT = NB_INT + 2_8 * ( NELT8 + 1_8 ) + ENDIF + IF (KEEP(55) .ne. 0 ) THEN + NB_INT = NB_INT + N8 + 1_8 + NELT8 + END IF + NB_INT = NB_INT + int(LNA,8) + IF ( OOC_STRAT .GT. 0 .OR. OOC_STRAT .EQ. -1 ) THEN + MAXS_MIN = KEEP8(14) + ELSE + MAXS_MIN = KEEP8(12) + ENDIF + IF ( .NOT. EFF ) THEN + IF ( KEEP8(24).EQ.0_8 ) THEN + NB_REAL = NB_REAL + MAXS_MIN + + & int(PERLU,8)*(MAXS_MIN / 100_8 + 1_8 ) + ENDIF + ELSE + NB_REAL = NB_REAL + KEEP8(67) + ENDIF + IF ( OOC_STRAT .GT. 0 .AND. I_AM_SLAVE ) THEN + BUF_OOC_NOPANEL = 2_8 * KEEP8(119) + IF (KEEP(50).EQ.0)THEN + BUF_OOC_PANEL = 8_8 * int(KEEP(226),8) + ELSE + BUF_OOC_PANEL = 4_8 * int(KEEP(226),8) + ENDIF + IF (OOC_STRAT .EQ. 2) THEN + BUF_OOC = BUF_OOC_NOPANEL + ELSE + BUF_OOC = BUF_OOC_PANEL + ENDIF + NB_REAL = NB_REAL + min(BUF_OOC + int(max(PERLU,0),8) * + & (BUF_OOC/100_8+1_8),12000000_8) + IF (OOC_STRAT .EQ. 2) THEN + OOC_NB_FILE_TYPE = 1_8 + ELSE + IF (KEEP(50).EQ.0) THEN + OOC_NB_FILE_TYPE = 2_8 + ELSE + OOC_NB_FILE_TYPE = 1_8 + ENDIF + ENDIF + NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 * I8OVERI + NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 * I8OVERI + NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 + ENDIF + NB_REAL = NB_REAL + int(KEEP(13),8) + IF (KEEP(252).EQ.1 .AND. .NOT. I_AM_MASTER) THEN + NB_REAL = NB_REAL + N8 + ENDIF + IF ( .not. ( I_AM_SLAVE .and. I_AM_MASTER .and. KEEP(52) .eq. 0 + & .and. KEEP(55) .ne. 0 ) ) THEN + NB_INT = NB_INT + int(KEEP(14),8) + END IF + IF ( I_AM_SLAVE .and. KEEP(38) .ne. 0 ) THEN + NB_INT = NB_INT + 2_8 * N8 + END IF + TEMPI= 0_8 + TEMPR = 0_8 + NBRECORDS = KEEP(39) + IF (KEEP(55).eq.0) THEN + NBRECORDS = min(KEEP(39), NZ) + ELSE + NBRECORDS = min(KEEP(39), NA_ELT) + ENDIF + IF ( KEEP(54) .eq. 0 ) THEN + IF ( I_AM_MASTER ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + NBUFS = NSLAVES + ELSE + NBUFS = NSLAVES - 1 + IF (KEEP(55) .eq. 0 ) + & TEMPI = TEMPI + 2_8 * N8 + END IF + TEMPI = TEMPI + 2_8 * int(NBRECORDS,8) * int(NBUFS,8) + TEMPR = TEMPR + int(NBRECORDS,8) * int(NBUFS,8) + ELSE + IF ( KEEP(55) .eq. 0 )THEN + TEMPI = TEMPI + 2_8 * int(NBRECORDS,8) + TEMPR = TEMPR + int(NBRECORDS,8) + END IF + END IF + ELSE + IF ( I_AM_SLAVE ) THEN + TEMPI = TEMPI + int(1+4*NSLAVES,8) * int(NBRECORDS,8) + TEMPR = TEMPR + int(1+2*NSLAVES,8) * int(NBRECORDS,8) + END IF + END IF + TEMP = max( NB_BYTES + (NB_INT + TEMPI) * int(KEEP(34),8) + & + (NB_REAL+TEMPR) * int(KEEP(35),8) + & , TEMP ) + IF ( I_AM_SLAVE ) THEN + ZMUMPS_LBUFR_BYTES = KEEP( 44 ) * KEEP( 35 ) + ZMUMPS_LBUFR_BYTES = max( ZMUMPS_LBUFR_BYTES, + & 100000 ) + IF (KEEP(48).EQ.5) THEN + MIN_PERLU=2 + ELSE + MIN_PERLU=0 + ENDIF + ZMUMPS_LBUFR_BYTES = ZMUMPS_LBUFR_BYTES + & + int( 2.0D0 * dble(max(PERLU,MIN_PERLU))* + & dble(ZMUMPS_LBUFR_BYTES)/100D0) + NB_BYTES = NB_BYTES + int(ZMUMPS_LBUFR_BYTES,8) + ZMUMPS_LBUF = int( dble(KEEP(213)) / 100.0D0 + & * dble(KEEP( 43 ) * KEEP( 35 )) ) + ZMUMPS_LBUF = max( ZMUMPS_LBUF, 100000 ) + ZMUMPS_LBUF = ZMUMPS_LBUF + & + int( 2.0D0 * dble(max(PERLU,0))* + & dble(ZMUMPS_LBUF)/100D0) + ZMUMPS_LBUF = max(ZMUMPS_LBUF, ZMUMPS_LBUFR_BYTES) + NB_BYTES = NB_BYTES + int(ZMUMPS_LBUF,8) + ZMUMPS_LBUF_INT = ( KEEP(56) + + & NSLAVES * NSLAVES ) * 5 + & * KEEP(34) + NB_BYTES = NB_BYTES + int(ZMUMPS_LBUF_INT,8) + IF ( EFF ) THEN + IF (OOC_STRAT .GT. 0) THEN + NB_INT = NB_INT + int(KEEP(225),8) + ELSE + NB_INT = NB_INT + int(KEEP(15),8) + ENDIF + ELSE + IF (OOC_STRAT .GT. 0) THEN + NB_INT = NB_INT + int( + & KEEP(225) + 2 * max(PERLU,10) * + & ( KEEP(225) / 100 + 1 ) + & ,8) + ELSE + NB_INT = NB_INT + int( + & KEEP(15) + 2 * max(PERLU,10) * + & ( KEEP(15) / 100 + 1 ) + & ,8) + ENDIF + ENDIF + NB_INT = NB_INT + NSTEPS8 + NB_INT = NB_INT + NSTEPS8 * I8OVERI + NB_INT = NB_INT + N8 + 5_8 * NSTEPS8 + 3_8 + NB_INT = NB_INT + 2_8 * NSTEPS8 * I8OVERI + END IF + MEMORY_BYTES = NB_BYTES + NB_INT * int(KEEP(34),8) + + & NB_REAL * int(KEEP(35),8) + MEMORY_BYTES = max( MEMORY_BYTES, TEMP ) + MEMORY_MBYTES = int( MEMORY_BYTES / 1000000_8 ) + 1 + RETURN + END SUBROUTINE ZMUMPS_214 + SUBROUTINE ZMUMPS_757(M_ARRAY, M_SIZE) + IMPLICIT NONE + INTEGER M_SIZE + DOUBLE PRECISION M_ARRAY(M_SIZE) + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0D0) + M_ARRAY=ZERO + RETURN + END SUBROUTINE ZMUMPS_757 + SUBROUTINE ZMUMPS_618( + & A,ASIZE,NCOL,NROW, + & M_ARRAY,NMAX,COMPRESSCB,LROW1) + IMPLICIT NONE + INTEGER(8) :: ASIZE + INTEGER NROW,NCOL,NMAX,LROW1 + LOGICAL COMPRESSCB + COMPLEX(kind=8) A(ASIZE) + DOUBLE PRECISION M_ARRAY(NMAX) + INTEGER I + INTEGER(8):: APOS, J, LROW + DOUBLE PRECISION ZERO,TMP + PARAMETER (ZERO=0.0D0) + M_ARRAY(1:NMAX) = ZERO + APOS = 0_8 + IF (COMPRESSCB) THEN + LROW=int(LROW1,8) + ELSE + LROW=int(NCOL,8) + ENDIF + DO I=1,NROW + DO J=1_8,int(NMAX,8) + TMP = abs(A(APOS+J)) + IF(TMP.GT.M_ARRAY(J)) M_ARRAY(J) = TMP + ENDDO + APOS = APOS + LROW + IF (COMPRESSCB) LROW=LROW+1_8 + ENDDO + RETURN + END SUBROUTINE ZMUMPS_618 + SUBROUTINE ZMUMPS_710 (id, NB_INT,NB_CMPLX ) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(ZMUMPS_STRUC) :: id + INTEGER(8) NB_INT, NB_CMPLX + INTEGER(8) NB_REAL + NB_INT = 0_8 + NB_CMPLX = 0_8 + NB_REAL = 0_8 + IF (associated(id%IS)) NB_INT=NB_INT+size(id%IS) + IF (associated(id%IS1)) NB_INT=NB_INT+size(id%IS1) + NB_INT=NB_INT+size(id%KEEP) + NB_INT=NB_INT+size(id%ICNTL) + NB_INT=NB_INT+size(id%INFO) + NB_INT=NB_INT+size(id%INFOG) + IF (associated(id%MAPPING)) NB_INT=NB_INT+size(id%MAPPING) + IF (associated(id%POIDS)) NB_INT=NB_INT+size(id%POIDS) + IF (associated(id%BUFR)) NB_INT=NB_INT+size(id%BUFR) + IF (associated(id%STEP)) NB_INT=NB_INT+size(id%STEP) + IF (associated(id%NE_STEPS )) NB_INT=NB_INT+size(id%NE_STEPS ) + IF (associated(id%ND_STEPS)) NB_INT=NB_INT+size(id%ND_STEPS) + IF (associated(id%Step2node)) NB_INT=NB_INT+size(id%Step2node) + IF (associated(id%FRERE_STEPS)) NB_INT=NB_INT+size(id%FRERE_STEPS) + IF (associated(id%DAD_STEPS)) NB_INT=NB_INT+size(id%DAD_STEPS) + IF (associated(id%FILS)) NB_INT=NB_INT+size(id%FILS) + IF (associated(id%PTRAR)) NB_INT=NB_INT+size(id%PTRAR) + IF (associated(id%FRTPTR)) NB_INT=NB_INT+size(id%FRTPTR) + NB_INT=NB_INT+size(id%KEEP8) * id%KEEP(10) + IF (associated(id%PTRFAC)) NB_INT=NB_INT+size(id%PTRFAC) * + & id%KEEP(10) + IF (associated(id%FRTELT)) NB_INT=NB_INT+size(id%FRTELT) + IF (associated(id%NA)) NB_INT=NB_INT+size(id%NA) + IF (associated(id%PROCNODE_STEPS)) + & NB_INT=NB_INT+size(id%PROCNODE_STEPS) + IF (associated(id%PTLUST_S)) NB_INT=NB_INT+size(id%PTLUST_S) + IF (associated(id%PROCNODE)) NB_INT=NB_INT+size(id%PROCNODE) + IF (associated(id%INTARR)) NB_INT=NB_INT+size(id%INTARR) + IF (associated(id%ELTPROC)) NB_INT=NB_INT+size(id%ELTPROC) + IF (associated(id%CANDIDATES)) + & NB_INT=NB_INT+size(id%CANDIDATES) + IF (associated(id%ISTEP_TO_INIV2)) + & NB_INT=NB_INT+size(id%ISTEP_TO_INIV2) + IF (associated(id%FUTURE_NIV2)) + & NB_INT=NB_INT+size(id%FUTURE_NIV2) + IF (associated(id%TAB_POS_IN_PERE)) + & NB_INT=NB_INT+size(id%TAB_POS_IN_PERE) + IF (associated(id%I_AM_CAND)) + & NB_INT=NB_INT+size(id%I_AM_CAND) + IF (associated(id%MEM_DIST)) + & NB_INT=NB_INT+size(id%MEM_DIST) + IF (associated(id%POSINRHSCOMP)) + & NB_INT=NB_INT+size(id%POSINRHSCOMP) + IF (associated(id%MEM_SUBTREE)) + & NB_INT=NB_INT+size(id%MEM_SUBTREE) + IF (associated(id%MY_ROOT_SBTR)) + & NB_INT=NB_INT+size(id%MY_ROOT_SBTR) + IF (associated(id%MY_FIRST_LEAF)) + & NB_INT=NB_INT+size(id%MY_FIRST_LEAF) + IF (associated(id%MY_NB_LEAF)) NB_INT=NB_INT+size(id%MY_NB_LEAF) + IF (associated(id%DEPTH_FIRST)) NB_INT=NB_INT+size(id%DEPTH_FIRST) + IF (associated(id%COST_TRAV)) NB_INT=NB_INT+size(id%COST_TRAV) + IF (associated(id%CB_SON_SIZE)) NB_INT=NB_INT+size(id%CB_SON_SIZE) + IF (associated(id%OOC_INODE_SEQUENCE)) + & NB_INT=NB_INT+size(id%OOC_INODE_SEQUENCE) + IF (associated(id%OOC_SIZE_OF_BLOCK)) + & NB_INT=NB_INT+size(id%OOC_SIZE_OF_BLOCK) + IF (associated(id%OOC_VADDR)) + & NB_INT=NB_INT+size(id%OOC_VADDR) + IF (associated(id%OOC_TOTAL_NB_NODES)) + & NB_INT=NB_INT+size(id%OOC_TOTAL_NB_NODES) + IF (associated(id%OOC_NB_FILES)) + & NB_INT=NB_INT+size(id%OOC_NB_FILES) + IF (associated(id%OOC_FILE_NAME_LENGTH)) + & NB_INT=NB_INT+size(id%OOC_FILE_NAME_LENGTH) + IF (associated(id%PIVNUL_LIST)) NB_INT=NB_INT+size(id%PIVNUL_LIST) + IF (associated(id%SUP_PROC)) NB_INT=NB_INT+size(id%SUP_PROC) + IF (associated(id%DBLARR)) NB_CMPLX=NB_CMPLX+size(id%DBLARR) + IF (associated(id%RHSCOMP)) NB_CMPLX=NB_CMPLX+size(id%RHSCOMP) + IF (associated(id%S)) NB_CMPLX=NB_CMPLX+id%KEEP8(23) + IF (associated(id%COLSCA)) NB_REAL=NB_REAL+size(id%COLSCA) + IF (associated(id%ROWSCA)) NB_REAL=NB_REAL+size(id%ROWSCA) + NB_REAL=NB_REAL+size(id%CNTL) + NB_REAL=NB_REAL+size(id%RINFO) + NB_REAL=NB_REAL+size(id%RINFOG) + NB_REAL=NB_REAL+size(id%DKEEP) + NB_CMPLX = NB_CMPLX + NB_REAL/2_8 + RETURN + END SUBROUTINE ZMUMPS_710 + SUBROUTINE ZMUMPS_756(N8,SRC,DEST) + IMPLICIT NONE + INTEGER(8) :: N8 + COMPLEX(kind=8), intent(in) :: SRC(N8) + COMPLEX(kind=8), intent(out) :: DEST(N8) + INTEGER(8) :: SHIFT8, HUG8 + INTEGER :: I, I4SIZE + HUG8=int(huge(I4SIZE),8) + DO I = 1, int(( N8 + HUG8 - 1_8 ) / HUG8) + SHIFT8 = 1_8 + int(I-1,8) * HUG8 + I4SIZE = int(min(HUG8, N8-SHIFT8+1_8)) + CALL zcopy(I4SIZE, SRC(SHIFT8), 1, DEST(SHIFT8), 1) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_756 + SUBROUTINE ZMUMPS_22( INPLACE, MIN_SPACE_IN_PLACE, + & SSARBR, PROCESS_BANDE, + & MYID,N, KEEP,KEEP8, + & IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP,PIMASTER,PAMASTER, + & LREQ, LREQCB, NODE_ARG, STATE_ARG, SET_HEADER, + & COMP, LRLUS, IFLAG, IERROR ) + USE ZMUMPS_LOAD + IMPLICIT NONE + INTEGER N,LIW, KEEP(500) + INTEGER(8) LA, LRLU, IPTRLU, LRLUS, LREQCB + INTEGER(8) PAMASTER(KEEP(28)), PTRAST(KEEP(28)) + INTEGER IWPOS,IWPOSCB + INTEGER(8) :: MIN_SPACE_IN_PLACE + INTEGER NODE_ARG, STATE_ARG + INTEGER(8) KEEP8(150) + INTEGER IW(LIW),PTRIST(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER MYID, IXXP + COMPLEX(kind=8) A(LA) + LOGICAL INPLACE, PROCESS_BANDE, SSARBR, SET_HEADER + INTEGER COMP, LREQ, IFLAG, IERROR + INCLUDE 'mumps_headers.h' + INTEGER INODE_LOC,NPIV,NASS,NROW,NCB + INTEGER ISIZEHOLE + INTEGER(8) :: MEM_GAIN, RSIZEHOLE, LREQCB_EFF, LREQCB_WISHED + LOGICAL DONE + IF ( INPLACE ) THEN + LREQCB_EFF = MIN_SPACE_IN_PLACE + IF ( MIN_SPACE_IN_PLACE > 0_8 ) THEN + LREQCB_WISHED = LREQCB + ELSE + LREQCB_WISHED = 0_8 + ENDIF + ELSE + LREQCB_EFF = LREQCB + LREQCB_WISHED = LREQCB + ENDIF + IF (IWPOSCB.EQ.LIW) THEN + IF (LREQ.NE.KEEP(IXSZ).OR.LREQCB.NE.0_8 + & .OR. .NOT. SET_HEADER) THEN + WRITE(*,*) "Internal error in ZMUMPS_22", + & SET_HEADER, LREQ, LREQCB + CALL MUMPS_ABORT() + ENDIF + IF (IWPOSCB-IWPOS+1 .LT. KEEP(IXSZ)) THEN + WRITE(*,*) "Problem with integer stack size",IWPOSCB, + & IWPOS, KEEP(IXSZ) + IFLAG = -8 + IERROR = LREQ + RETURN + ENDIF + IWPOSCB=IWPOSCB-KEEP(IXSZ) + IW(IWPOSCB+1+XXI)=KEEP(IXSZ) + CALL MUMPS_730(0_8,IW(IWPOSCB+1+XXR)) + IW(IWPOSCB+1+XXN)=-919191 + IW(IWPOSCB+1+XXS)=S_NOTFREE + IW(IWPOSCB+1+XXP)=TOP_OF_STACK + RETURN + ENDIF + IF (KEEP(214).EQ.1.AND. + & KEEP(216).EQ.1.AND. + & IWPOSCB.NE.LIW) THEN + IF (IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG.OR. + & IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG38) THEN + NCB = IW( IWPOSCB+1 + KEEP(IXSZ) ) + NROW = IW( IWPOSCB+1 + KEEP(IXSZ) + 2) + NPIV = IW( IWPOSCB+1 + KEEP(IXSZ) + 3) + INODE_LOC= IW( IWPOSCB+1 + XXN) + CALL ZMUMPS_632(IWPOSCB+1,IW,LIW, + & ISIZEHOLE,RSIZEHOLE) + IF (IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG) THEN + CALL ZMUMPS_627(A,LA,IPTRLU+1_8, + & NROW,NCB,NPIV+NCB,0, + & IW(IWPOSCB+1 + XXS),RSIZEHOLE) + IW(IWPOSCB+1 + XXS) =S_NOLCLEANED + MEM_GAIN = int(NROW,8)*int(NPIV,8) + ENDIF + IF (IW(IWPOSCB+1 + XXS).EQ.S_NOLCBNOCONTIG38) THEN + NASS = IW( IWPOSCB+1 + KEEP(IXSZ) + 4) + CALL ZMUMPS_627(A,LA,IPTRLU+1_8, + & NROW,NCB,NPIV+NCB,NASS-NPIV, + & IW(IWPOSCB+1 + XXS),RSIZEHOLE) + IW(IWPOSCB+1 + XXS) =S_NOLCLEANED38 + MEM_GAIN = int(NROW,8)*int(NPIV+NCB-(NASS-NPIV),8) + ENDIF + IF (ISIZEHOLE.NE.0) THEN + CALL ZMUMPS_630( IW,LIW,IWPOSCB+1, + & IWPOSCB+IW(IWPOSCB+1+XXI), + & ISIZEHOLE ) + IWPOSCB=IWPOSCB+ISIZEHOLE + IW(IWPOSCB+1+XXP+IW(IWPOSCB+1+XXI))=IWPOSCB+1 + PTRIST(STEP(INODE_LOC))=PTRIST(STEP(INODE_LOC))+ + & ISIZEHOLE + ENDIF + CALL MUMPS_724(IW(IWPOSCB+1+XXR), MEM_GAIN) + IPTRLU = IPTRLU+MEM_GAIN+RSIZEHOLE + LRLU = LRLU+MEM_GAIN+RSIZEHOLE + PTRAST(STEP(INODE_LOC))= + & PTRAST(STEP(INODE_LOC))+MEM_GAIN+RSIZEHOLE + ENDIF + ENDIF + DONE =.FALSE. + IF ((IPTRLU.LT.LREQCB_WISHED).OR.(LRLU.LT.LREQCB_WISHED)) THEN + IF (LRLUS.LT.LREQCB_EFF) THEN + GOTO 620 + ELSE + CALL ZMUMPS_94(N,KEEP(28),IW,LIW,A,LA, + & LRLU,IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST, + & STEP, PIMASTER,PAMASTER,KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress... alloc_cb', + & 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 620 + END IF + DONE = .TRUE. + COMP = COMP + 1 + ENDIF + ENDIF + IF (IWPOSCB-IWPOS+1 .LT. LREQ) THEN + IF (DONE) GOTO 600 + CALL ZMUMPS_94(N,KEEP(28),IW,LIW,A,LA, + & LRLU,IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST, + & STEP, PIMASTER,PAMASTER,KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress... alloc_cb', + & 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 620 + END IF + COMP = COMP + 1 + IF (IWPOSCB-IWPOS+1 .LT. LREQ) GOTO 600 + ENDIF + IXXP=IWPOSCB+XXP+1 + IF (IXXP.GT.LIW) THEN + WRITE(*,*) "Internal error 3 in ZMUMPS_22",IXXP + ENDIF + IF (IW(IXXP).GT.0) THEN + WRITE(*,*) "Internal error 2 in ZMUMPS_22",IW(IXXP),IXXP + ENDIF + IWPOSCB = IWPOSCB - LREQ + IF (SET_HEADER) THEN + IW(IXXP)= IWPOSCB + 1 + IW(IWPOSCB+1+XXI)=LREQ + CALL MUMPS_730(LREQCB, IW(IWPOSCB+1+XXR)) + IW(IWPOSCB+1+XXS)=STATE_ARG + IW(IWPOSCB+1+XXN)=NODE_ARG + IW(IWPOSCB+1+XXP)=TOP_OF_STACK + ENDIF + IPTRLU = IPTRLU - LREQCB + LRLU = LRLU - LREQCB + LRLUS = LRLUS - LREQCB_EFF + KEEP8(67) = min(LRLUS, KEEP8(67)) +#if ! defined(OLD_LOAD_MECHANISM) + CALL ZMUMPS_471(SSARBR,PROCESS_BANDE, + & LA-LRLUS,0_8,LREQCB_EFF,KEEP,KEEP8,LRLU) +#else +#if defined (CHECK_COHERENCE) + CALL ZMUMPS_471(SSARBR,PROCESS_BANDE, + & LA-LRLUS,0_8,LREQCB_EFF,KEEP,KEEP8,LRLU) +#else + CALL ZMUMPS_471(SSARBR,.FALSE., + & LA-LRLUS,0_8,LREQCB_EFF,KEEP,KEEP8,LRLU) +#endif +#endif + RETURN + 600 IFLAG = -8 + IERROR = LREQ + RETURN + 620 IFLAG = -9 + CALL MUMPS_731(LREQCB_EFF - LRLUS, IERROR) + RETURN + END SUBROUTINE ZMUMPS_22 + SUBROUTINE ZMUMPS_244(N, NSTEPS, + & A, LA, IW, LIW, SYM_PERM, NA, LNA, + & NE_STEPS, NFSIZ, FILS, + & STEP, FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & PTRAR, LDPTRAR, + & PTRIST, PTLUST_S, PTRFAC, IW1, IW2, ITLOC, RHS_MUMPS, + & POOL, LPOOL, + & CNTL1, ICNTL, INFO, RINFO, KEEP,KEEP8,PROCNODE_STEPS, + & SLAVEF, + & COMM_NODES, MYID, MYID_NODES, + & BUFR,LBUFR,LBUFR_BYTES,INTARR,DBLARR, + & root, NELT, FRTPTR, FRTELT, COMM_LOAD, + & ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, + & MEM_DISTRIB, + & DKEEP,PIVNUL_LIST,LPN_LIST) + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER(8) :: LA + INTEGER N,NSTEPS,LIW,LPOOL,SLAVEF,COMM_NODES + INTEGER MYID, MYID_NODES,LNA + COMPLEX(kind=8) A(LA) + DOUBLE PRECISION RINFO(40) + INTEGER LBUFR, LBUFR_BYTES + INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB + INTEGER BUFR( LBUFR ) + INTEGER NELT, LDPTRAR + INTEGER FRTPTR(*), FRTELT(*) + DOUBLE PRECISION CNTL1 + INTEGER ICNTL(40) + INTEGER INFO(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IW(LIW), SYM_PERM(N), NA(LNA), + & NE_STEPS(KEEP(28)), FILS(N), + & FRERE(KEEP(28)), NFSIZ(KEEP(28)), + & DAD(KEEP(28)) + INTEGER CAND(SLAVEF+1, max(1,KEEP(56))) + INTEGER STEP(N) + INTEGER PTRAR(LDPTRAR,2) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER IW1(3*KEEP(28)), ITLOC(N+KEEP(253)), POOL(LPOOL) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: IW2(2*KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + DOUBLE PRECISION SEUIL, SEUIL_LDLT_NIV2 + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + DOUBLE PRECISION UULOC + INTEGER LP, MPRINT + INTEGER NSTK,PTRAST, NBPROCFILS + INTEGER PIMASTER, PAMASTER + LOGICAL PROK + DOUBLE PRECISION ZERO, ONE + DATA ZERO /0.0D0/ + DATA ONE /1.0D0/ + INTRINSIC int,real,log + INTEGER IERR + INTEGER NTOTPV, NTOTPVTOT, NMAXNPIV + INTEGER(8) :: POSFAC, LRLU, IPTRLU, LRLUS + INTEGER IWPOS, LEAF, NBROOT, NROOT + KEEP(41)=0 + KEEP(42)=0 + NSTEPS = 0 + LP = ICNTL(1) + MPRINT = ICNTL(2) + PROK = (MPRINT.GT.0) + UULOC = CNTL1 + IF (UULOC.GT.ONE) UULOC=ONE + IF (UULOC.LT.ZERO) UULOC=ZERO + IF (KEEP(50).NE.0.AND.UULOC.GT.0.5D0) THEN + UULOC = 0.5D0 + ENDIF + PIMASTER = 1 + NSTK = PIMASTER + KEEP(28) + NBPROCFILS = NSTK + KEEP(28) + PTRAST = 1 + PAMASTER = 1 + KEEP(28) + IF (KEEP(4).LE.0) KEEP(4)=32 + IF (KEEP(5).LE.0) KEEP(5)=16 + IF (KEEP(5).GT.KEEP(4)) KEEP(5) = KEEP(4) + IF (KEEP(6).LE.0) KEEP(6)=24 + IF (KEEP(3).LE.KEEP(4)) KEEP(3)=KEEP(4)*2 + IF (KEEP(6).GT.KEEP(3)) KEEP(6) = KEEP(3) + POSFAC = 1_8 + IWPOS = 1 + LRLU = LA + LRLUS = LRLU + KEEP8(67) = LRLUS + IPTRLU = LRLU + NTOTPV = 0 + NMAXNPIV = 0 + IW1(NSTK:NSTK+KEEP(28)-1) = NE_STEPS(1:KEEP(28)) + CALL MUMPS_362(N, LEAF, NBROOT, NROOT, + & MYID_NODES, + & SLAVEF, NA, LNA, + & KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & POOL, LPOOL) + CALL ZMUMPS_506(POOL, LPOOL, LEAF) + CALL ZMUMPS_555(POOL, LPOOL,KEEP,KEEP8) + IF ( KEEP( 38 ) .NE. 0 ) THEN + NBROOT = NBROOT + root%NPROW * root%NPCOL - 1 + END IF + IF ( root%yes ) THEN + IF ( MUMPS_275( PROCNODE_STEPS(STEP(KEEP(38))), SLAVEF ) + & .NE. MYID_NODES ) THEN + NROOT = NROOT + 1 + END IF + END IF + CALL ZMUMPS_251(N,IW,LIW,A,LA,IW1(NSTK),IW1(NBPROCFILS), + & INFO(1),NFSIZ,FILS,STEP,FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & INFO(11), NTOTPV, NMAXNPIV, PTRIST,IW2(PTRAST), + & IW1(PIMASTER), IW2(PAMASTER), PTRAR(1,2), + & PTRAR(1,1), + & ITLOC, RHS_MUMPS, INFO(2), POOL, LPOOL, + & RINFO, POSFAC,IWPOS,LRLU,IPTRLU, + & LRLUS, LEAF, NROOT, NBROOT, + & UULOC,ICNTL,PTLUST_S,PTRFAC,NSTEPS,INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS,SLAVEF,MYID,COMM_NODES, + & MYID_NODES, BUFR,LBUFR, LBUFR_BYTES, + & INTARR, DBLARR, root, SYM_PERM, + & NELT, FRTPTR, FRTELT, LDPTRAR, + & COMM_LOAD, ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, + & MEM_DISTRIB,NE_STEPS, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST) + POSFAC = POSFAC -1_8 + IWPOS = IWPOS -1 + IF (KEEP(201).LE.0) THEN + KEEP8(31) = POSFAC + ENDIF + KEEP(32) = IWPOS + CALL MUMPS_735(KEEP8(31), INFO(9)) + INFO(10) = KEEP(32) + KEEP8(67) = LA - KEEP8(67) + KEEP(89) = NTOTPV + KEEP(246) = NMAXNPIV + INFO(23) = KEEP(89) + CALL MPI_ALLREDUCE(NTOTPV, NTOTPVTOT, 1, MPI_INTEGER, MPI_SUM, + & COMM_NODES, IERR) + IF ( ( (INFO(1).EQ.-10 .OR. INFO(1).EQ.-40) + & .AND. (NTOTPVTOT.EQ.N) ) + & .OR. ( NTOTPVTOT.GT.N ) ) THEN + write(*,*) ' Error 1 in mc51d NTOTPVTOT=', NTOTPVTOT + CALL MUMPS_ABORT() + ENDIF + IF ( (KEEP(19).NE.0 ) .AND. (NTOTPVTOT.NE.N) .AND. + & (INFO(1).GE.0) ) THEN + write(*,*) ' Error 2 in mc51d NTOTPVTOT=', NTOTPVTOT + CALL MUMPS_ABORT() + ENDIF + IF ( (INFO(1) .GE. 0 ) + & .AND. (NTOTPVTOT.NE.N) ) THEN + INFO(1) = -10 + INFO(2) = NTOTPVTOT + ENDIF + IF (PROK) THEN + WRITE (MPRINT,99980) INFO(1), INFO(2), + & KEEP(28), KEEP8(31), INFO(10), INFO(11), INFO(12), + & INFO(13), INFO(14), INFO(25), RINFO(2), RINFO(3) + ENDIF + RETURN +99980 FORMAT (/' LEAVING FACTORIZATION PHASE WITH ...'/ + & ' INFO (1) =',I15/ + & ' --- (2) =',I15/ + & ' NUMBER OF NODES IN THE TREE =',I15/ + & ' INFO (9) REAL SPACE FOR FACTORS =',I15/ + & ' --- (10) INTEGER SPACE FOR FACTORS =',I15/ + & ' --- (11) MAXIMUM SIZE OF FRONTAL MATRICES =',I15/ + & ' --- (12) NUMBER OF OFF DIAGONAL PIVOTS =',I15/ + & ' --- (13) NUMBER OF DELAYED PIVOTS =',I15/ + & ' --- (14) NUMBER OF MEMORY COMPRESSES =',I15/ + & ' --- (25) NUMBER OF ENTRIES IN FACTORS =',I15/ + & ' RINFO(2) OPERATIONS DURING NODE ASSEMBLY =',1PD10.3/ + & ' -----(3) OPERATIONS DURING NODE ELIMINATION =',1PD10.3) +99990 FORMAT(/ ' NUMBER OF MSGS RECVD FOR DYNAMIC LOAD =',I15) + END SUBROUTINE ZMUMPS_244 + SUBROUTINE ZMUMPS_269( MYID,KEEP,KEEP8, + & BUFR, LBUFR, LBUFR_BYTES, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, + & N, IW, LIW, A, LA, + & PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, + & FPERE, FLAG, IFLAG, IERROR, COMM, + & ITLOC, RHS_MUMPS ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER MYID + INTEGER LBUFR, LBUFR_BYTES + INTEGER KEEP(500), BUFR( LBUFR ) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER(8) :: PTRAST (KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP, FPERE + LOGICAL FLAG + INTEGER NSTK_S( KEEP(28) ), ITLOC( N + KEEP(253) ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER IFLAG, IERROR, COMM + INTEGER POSITION, FINODE, FLCONT, LREQ + INTEGER(8) :: LREQCB + INTEGER(8) :: IPOS_NODE, ISHIFT_PACKET + INTEGER SIZE_PACKET + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INCLUDE 'mumps_headers.h' + LOGICAL COMPRESSCB + FLAG = .FALSE. + POSITION = 0 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & FINODE, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & FPERE, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & FLCONT, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, MPI_INTEGER, + & COMM, IERR) + COMPRESSCB = (FLCONT.LT.0) + IF (COMPRESSCB) THEN + FLCONT = -FLCONT + LREQCB = (int(FLCONT,8) * int(FLCONT+1,8)) / 2_8 + ELSE + LREQCB = int(FLCONT,8) * int(FLCONT,8) + ENDIF + IF (NBROWS_ALREADY_SENT == 0) THEN + LREQ = 2 * FLCONT + 6 + KEEP(IXSZ) + IF (IPTRLU.LT.0_8) WRITE(*,*) 'before alloc_cb:IPTRLU = ',IPTRLU + CALL ZMUMPS_22( .FALSE., 0_8, .FALSE.,.FALSE., + & MYID,N, KEEP,KEEP8, IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, + & LREQ, LREQCB, FINODE, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF (IPTRLU.LT.0_8) WRITE(*,*) 'after alloc_cb:IPTRLU = ',IPTRLU + IF ( IFLAG .LT. 0 ) RETURN + PIMASTER(STEP( FINODE )) = IWPOSCB + 1 + PAMASTER(STEP( FINODE )) = IPTRLU + 1_8 + IF (COMPRESSCB) IW(IWPOSCB + 1 + XXS ) = S_CB1COMP + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IW(IWPOSCB + 1+KEEP(IXSZ)), LREQ-KEEP(IXSZ), + & MPI_INTEGER, COMM, IERR) + ENDIF + IF (COMPRESSCB) THEN + ISHIFT_PACKET = int(NBROWS_ALREADY_SENT,8) * + & int(NBROWS_ALREADY_SENT+1,8) / 2_8 + SIZE_PACKET = (NBROWS_PACKET * (NBROWS_PACKET+1))/2 + + & NBROWS_ALREADY_SENT * NBROWS_PACKET + ELSE + ISHIFT_PACKET = int(NBROWS_ALREADY_SENT,8) * int(FLCONT,8) + SIZE_PACKET = NBROWS_PACKET * FLCONT + ENDIF + IF (NBROWS_PACKET.NE.0) THEN + IF ( LREQCB .ne. 0_8 ) THEN + IPOS_NODE = PAMASTER(STEP(FINODE))-1_8 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & A(IPOS_NODE + 1_8 + ISHIFT_PACKET), + & SIZE_PACKET, MPI_DOUBLE_COMPLEX, COMM, IERR) + END IF + ENDIF + IF (NBROWS_ALREADY_SENT+NBROWS_PACKET == FLCONT) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF ( NSTK_S(STEP(FPERE)).EQ.0 ) THEN + FLAG = . TRUE. + END IF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_269 + SUBROUTINE ZMUMPS_270( TOT_ROOT_SIZE, + & TOT_CONT_TO_RECV, root, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, COMM_LOAD, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND) + USE ZMUMPS_LOAD + USE ZMUMPS_OOC + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER TOT_ROOT_SIZE, TOT_CONT_TO_RECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA, POSFAC + INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ), ND( KEEP(28) ) + INTEGER IFLAG, IERROR, COMM, COMM_LOAD + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC(N+KEEP(253)), FILS(N), PTRARW(N), PTRAIW(N) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + INTEGER :: allocok + COMPLEX(kind=8), DIMENSION(:,:), POINTER :: TMP + INTEGER NEW_LOCAL_M, NEW_LOCAL_N + INTEGER OLD_LOCAL_M, OLD_LOCAL_N + INTEGER I, J + INTEGER LREQI, IROOT + INTEGER(8) :: LREQA + INTEGER POSHEAD, IPOS_SON,IERR + LOGICAL MASTER_OF_ROOT + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INCLUDE 'mumps_headers.h' + INTEGER numroc, MUMPS_275 + EXTERNAL numroc, MUMPS_275 + IROOT = KEEP( 38 ) + root%TOT_ROOT_SIZE = TOT_ROOT_SIZE + MASTER_OF_ROOT = ( MYID .EQ. + & MUMPS_275( PROCNODE_STEPS(STEP(IROOT)), + & SLAVEF ) ) + NEW_LOCAL_M = numroc( TOT_ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + NEW_LOCAL_M = max( 1, NEW_LOCAL_M ) + NEW_LOCAL_N = numroc( TOT_ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + IF ( PTRIST(STEP( IROOT )).GT.0) THEN + OLD_LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) ) + OLD_LOCAL_M = IW( PTRIST(STEP( IROOT )) + 1 + KEEP(IXSZ)) + ELSE + OLD_LOCAL_N = 0 + OLD_LOCAL_M = NEW_LOCAL_M + ENDIF + IF (KEEP(60) .NE. 0) THEN + IF (root%yes) THEN + IF ( NEW_LOCAL_M .NE. root%SCHUR_MLOC .OR. + & NEW_LOCAL_N .NE. root%SCHUR_NLOC ) THEN + WRITE(*,*) "Internal error 1 in ZMUMPS_270" + CALL MUMPS_ABORT() + ENDIF + ENDIF + PTLUST_S(STEP(IROOT)) = -4444 + PTRFAC(STEP(IROOT)) = -4445_8 + PTRIST(STEP(IROOT)) = 0 + IF ( MASTER_OF_ROOT ) THEN + LREQI=6+2*TOT_ROOT_SIZE+KEEP(IXSZ) + LREQA=0_8 + IF ( IWPOS + LREQI - 1. GT. IWPOSCB ) THEN + CALL ZMUMPS_94( N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB1 compress root2slave:LRLU,LRLUS=', + & LRLU, LRLUS + IFLAG = -9 + CALL MUMPS_731(LREQA-LRLUS, IERROR) + GOTO 700 + END IF + ENDIF + IF ( IWPOS + LREQI - 1. GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + GOTO 700 + ENDIF + PTLUST_S(STEP(IROOT))= IWPOS + IWPOS = IWPOS + LREQI + POSHEAD = PTLUST_S( STEP(IROOT)) + IW( POSHEAD + XXI )=LREQI + CALL MUMPS_730( LREQA, IW(POSHEAD + XXR)) + IW( POSHEAD + XXS )=-9999 + IW( POSHEAD +KEEP(IXSZ)) = 0 + IW( POSHEAD + 1 +KEEP(IXSZ)) = -1 + IW( POSHEAD + 2 +KEEP(IXSZ)) = -1 + IW( POSHEAD + 4 +KEEP(IXSZ)) = STEP(IROOT) + IW( POSHEAD + 5 +KEEP(IXSZ)) = 0 + IW( POSHEAD + 3 +KEEP(IXSZ)) = TOT_ROOT_SIZE + ENDIF + GOTO 100 + ENDIF + IF ( MASTER_OF_ROOT ) THEN + LREQI = 6 + 2 * TOT_ROOT_SIZE+KEEP(IXSZ) + ELSE + LREQI = 6+KEEP(IXSZ) + END IF + LREQA = int(NEW_LOCAL_M, 8) * int(NEW_LOCAL_N, 8) + IF ( LRLU . LT. LREQA .OR. + & IWPOS + LREQI - 1. GT. IWPOSCB )THEN + IF ( LRLUS .LT. LREQA ) THEN + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GOTO 700 + END IF + CALL ZMUMPS_94( N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB2 compress root2slave:LRLU,LRLUS=', + & LRLU, LRLUS + IFLAG = -9 + CALL MUMPS_731(LREQA - LRLUS, IERROR) + GOTO 700 + END IF + IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN + IFLAG = -8 + IERROR = IWPOS + LREQI - 1 - IWPOSCB + GOTO 700 + END IF + END IF + PTLUST_S(STEP( IROOT )) = IWPOS + IWPOS = IWPOS + LREQI + IF (LREQA.EQ.0_8) THEN + PTRAST (STEP(IROOT)) = max(POSFAC-1_8,1_8) + PTRFAC (STEP(IROOT)) = max(POSFAC-1_8,1_8) + ELSE + PTRAST (STEP(IROOT)) = POSFAC + PTRFAC (STEP(IROOT)) = POSFAC + ENDIF + POSFAC = POSFAC + LREQA + LRLU = LRLU - LREQA + LRLUS = LRLUS - LREQA + KEEP8(67) = min(KEEP8(67), LRLUS) + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU) + POSHEAD = PTLUST_S( STEP(IROOT)) + IW( POSHEAD + XXI ) = LREQI + CALL MUMPS_730( LREQA, IW(POSHEAD + XXR)) + IW( POSHEAD + XXS ) = S_NOTFREE + IW( POSHEAD + KEEP(IXSZ) ) = 0 + IW( POSHEAD + 1 + KEEP(IXSZ) ) = NEW_LOCAL_N + IW( POSHEAD + 2 + KEEP(IXSZ) ) = NEW_LOCAL_M + IW( POSHEAD + 4 + KEEP(IXSZ) ) = STEP(IROOT) + IW( POSHEAD + 5 + KEEP(IXSZ) ) = 0 + IF ( MASTER_OF_ROOT ) THEN + IW( POSHEAD + 3 + KEEP(IXSZ) ) = TOT_ROOT_SIZE + ELSE + IW( POSHEAD + 3 + KEEP(IXSZ) ) = 0 + ENDIF + IF ( KEEP( 50 ) .eq. 0 .OR. KEEP(50) .eq. 2 ) THEN + OPELIW = OPELIW + ( dble(2*TOT_ROOT_SIZE) * + & dble(TOT_ROOT_SIZE) * dble(TOT_ROOT_SIZE ) / dble(3) + & - 0.5d0 * dble( TOT_ROOT_SIZE ) * dble( TOT_ROOT_SIZE ) + & - dble( TOT_ROOT_SIZE ) / dble( 6 ) ) + & / dble( root%NPROW * root%NPCOL ) + ELSE + OPELIW = OPELIW + ( dble(TOT_ROOT_SIZE) * + & dble( TOT_ROOT_SIZE) * + & dble( TOT_ROOT_SIZE + 1 ) ) + & / dble( 3 * root%NPROW * root%NPCOL ) + END IF + IF ( PTRIST(STEP( IROOT )) .LE. 0 ) THEN + PTRIST(STEP( IROOT )) = 0 + PAMASTER(STEP( IROOT )) = 0_8 + IF (LREQA.GT.0_8) A(PTRAST(STEP(IROOT)): + & PTRAST(STEP(IROOT))+LREQA-1_8) = ZERO + ELSE + OLD_LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) ) + OLD_LOCAL_M = IW( PTRIST(STEP( IROOT )) + 1 + KEEP(IXSZ)) + IF ( TOT_ROOT_SIZE .eq. root%ROOT_SIZE ) THEN + IF ( LREQA .NE. int(OLD_LOCAL_M,8) * int(OLD_LOCAL_N,8) ) + & THEN + write(*,*) 'error 1 in PROCESS_ROOT2SLAVE', + & OLD_LOCAL_M, OLD_LOCAL_N + CALL MUMPS_ABORT() + END IF + CALL ZMUMPS_756(LREQA, + & A( PAMASTER(STEP(IROOT)) ), + & A( PTRAST (STEP(IROOT)) ) ) + ELSE + CALL ZMUMPS_96( A( PTRAST(STEP(IROOT))), + & NEW_LOCAL_M, + & NEW_LOCAL_N, A( PAMASTER( STEP(IROOT)) ), OLD_LOCAL_M, + & OLD_LOCAL_N ) + END IF + IF ( PTRIST( STEP( IROOT ) ) .GT. 0 ) THEN + IPOS_SON= PTRIST( STEP(IROOT)) + CALL ZMUMPS_152(.FALSE., MYID, N, IPOS_SON, + & PAMASTER(STEP(IROOT)), + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + PTRIST(STEP( IROOT )) = 0 + PAMASTER(STEP( IROOT )) = 0_8 + END IF + END IF + IF (NEW_LOCAL_M.GT.OLD_LOCAL_M) THEN + TMP => root%RHS_ROOT + NULLIFY(root%RHS_ROOT) + ALLOCATE (root%RHS_ROOT(NEW_LOCAL_M, root%RHS_NLOC), + & stat=allocok) + IF ( allocok.GT.0) THEN + IFLAG=-13 + IERROR = NEW_LOCAL_M*root%RHS_NLOC + GOTO 700 + ENDIF + DO J = 1, root%RHS_NLOC + DO I = 1, OLD_LOCAL_M + root%RHS_ROOT(I,J)=TMP(I,J) + ENDDO + DO I = OLD_LOCAL_M+1, NEW_LOCAL_M + root%RHS_ROOT(I,J) = ZERO + ENDDO + ENDDO + DEALLOCATE(TMP) + NULLIFY(TMP) + ENDIF + 100 CONTINUE + NBPROCFILS(STEP(IROOT))=NBPROCFILS(STEP(IROOT)) + TOT_CONT_TO_RECV + IF ( NBPROCFILS(STEP(IROOT)) .eq. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + CALL ZMUMPS_681(IERR) + ELSE IF (KEEP(201).EQ.2) THEN + CALL ZMUMPS_580(IERR) + ENDIF + CALL ZMUMPS_507( N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IROOT + N ) + IF (KEEP(47) .GE. 3) THEN + CALL ZMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + RETURN + 700 CONTINUE + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE ZMUMPS_270 + SUBROUTINE ZMUMPS_96 + &( NEW, M_NEW, N_NEW,OLD, M_OLD, N_OLD ) + INTEGER M_NEW, N_NEW, M_OLD, N_OLD + COMPLEX(kind=8) NEW( M_NEW, N_NEW ), OLD( M_OLD, N_OLD ) + INTEGER J + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + DO J = 1, N_OLD + NEW( 1: M_OLD, J ) = OLD( 1: M_OLD, J ) + NEW( M_OLD + 1: M_NEW, J ) = ZERO + END DO + NEW( 1: M_NEW,N_OLD + 1: N_NEW ) = ZERO + RETURN + END SUBROUTINE ZMUMPS_96 + INTEGER FUNCTION ZMUMPS_505(KEEP,KEEP8) + IMPLICIT NONE + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + ZMUMPS_505 = KEEP(28) + 1 + 3 + RETURN + END FUNCTION ZMUMPS_505 + SUBROUTINE ZMUMPS_506(IPOOL, LPOOL, LEAF) + USE ZMUMPS_LOAD + IMPLICIT NONE + INTEGER LPOOL, LEAF + INTEGER IPOOL(LPOOL) + IPOOL(LPOOL-2) = 0 + IPOOL(LPOOL-1) = 0 + IPOOL(LPOOL) = LEAF-1 + RETURN + END SUBROUTINE ZMUMPS_506 + SUBROUTINE ZMUMPS_507 + & (N, POOL, LPOOL, PROCNODE, SLAVEF, + & K28, K76, K80, K47, STEP, INODE) + USE ZMUMPS_LOAD + IMPLICIT NONE + INTEGER N, INODE, LPOOL, K28, SLAVEF, K76, K80, K47 + INTEGER STEP(N), POOL(LPOOL), PROCNODE(K28) + EXTERNAL MUMPS_170 + LOGICAL MUMPS_170, ATM_CURRENT_NODE + INTEGER NBINSUBTREE, NBTOP, INODE_EFF,POS_TO_INSERT + INTEGER IPOS1, IPOS2, ISWAP + INTEGER NODE,J,I + ATM_CURRENT_NODE = ( K76 == 2 .OR. K76 ==3 .OR. + & K76==4 .OR. K76==5) + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + IF (INODE > N ) THEN + INODE_EFF = INODE - N + ELSE IF (INODE < 0) THEN + INODE_EFF = - INODE + ELSE + INODE_EFF = INODE + ENDIF + IF(((INODE.GT.0).AND.(INODE.LE.N)).AND.(.NOT. + & MUMPS_170(PROCNODE(STEP(INODE_EFF)), + & SLAVEF)) + & ) THEN + IF ((K80 == 1 .AND. K47 .GE. 1) .OR. + & (( K80 == 2 .OR. K80==3 ) .AND. + & ( K47 == 4 ))) THEN + CALL ZMUMPS_514(INODE,1) + ENDIF + ENDIF + IF ( MUMPS_170(PROCNODE(STEP(INODE_EFF)), + & SLAVEF) ) THEN + POOL(NBINSUBTREE + 1 ) = INODE + NBINSUBTREE = NBINSUBTREE + 1 + ELSE + POS_TO_INSERT=NBTOP+1 + IF((K76.EQ.4).OR.(K76.EQ.5))THEN +#if defined(NOT_ATM_POOL_SPECIAL) + J=NBTOP +#else + IF((INODE.GT.N).OR.(INODE.LE.0))THEN + DO J=NBTOP,1,-1 + IF((POOL(LPOOL-2-J).GT.0) + & .AND.(POOL(LPOOL-2-J).LE.N))THEN + GOTO 333 + ENDIF + IF ( POOL(LPOOL-2-J) < 0 ) THEN + NODE=-POOL(LPOOL-2-J) + ELSE IF ( POOL(LPOOL-2-J) > N ) THEN + NODE = POOL(LPOOL-2-J) - N + ELSE + NODE = POOL(LPOOL-2-J) + ENDIF + IF(K76.EQ.4)THEN + IF(DEPTH_FIRST_LOAD(STEP(NODE)).GE. + & DEPTH_FIRST_LOAD(STEP(INODE_EFF)))THEN + GOTO 333 + ENDIF + ENDIF + IF(K76.EQ.5)THEN + IF(COST_TRAV(STEP(NODE)).LE. + & COST_TRAV(STEP(INODE_EFF)))THEN + GOTO 333 + ENDIF + ENDIF + POS_TO_INSERT=POS_TO_INSERT-1 + ENDDO + IF(J.EQ.0) J=1 + 333 CONTINUE + DO I=NBTOP,POS_TO_INSERT,-1 + POOL(LPOOL-2-I-1)=POOL(LPOOL-2-I) + ENDDO + POOL(LPOOL-2-POS_TO_INSERT)=INODE + NBTOP = NBTOP + 1 + GOTO 20 + ENDIF + DO J=NBTOP,1,-1 + IF((POOL(LPOOL-2-J).GT.0).AND.(POOL(LPOOL-2-J).LE.N))THEN + GOTO 888 + ENDIF + POS_TO_INSERT=POS_TO_INSERT-1 + ENDDO + 888 CONTINUE +#endif + DO I=J,1,-1 +#if defined(NOT_ATM_POOL_SPECIAL) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE = POOL(LPOOL-2-I) - N + ELSE + NODE = POOL(LPOOL-2-I) + ENDIF +#else + NODE=POOL(LPOOL-2-I) +#endif + IF(K76.EQ.4)THEN + IF(DEPTH_FIRST_LOAD(STEP(NODE)).GE. + & DEPTH_FIRST_LOAD(STEP(INODE_EFF)))THEN + GOTO 999 + ENDIF + ENDIF + IF(K76.EQ.5)THEN + IF(COST_TRAV(STEP(NODE)).LE. + & COST_TRAV(STEP(INODE_EFF)))THEN + GOTO 999 + ENDIF + ENDIF + POS_TO_INSERT=POS_TO_INSERT-1 + ENDDO + IF(I.EQ.0) I=1 + 999 CONTINUE + DO J=NBTOP,POS_TO_INSERT,-1 + POOL(LPOOL-2-J-1)=POOL(LPOOL-2-J) + ENDDO + POOL(LPOOL-2-POS_TO_INSERT)=INODE + NBTOP = NBTOP + 1 + GOTO 20 + ENDIF + POOL( LPOOL - 2 - ( NBTOP + 1 ) ) = INODE + NBTOP = NBTOP + 1 + IPOS1 = LPOOL - 2 - NBTOP + IPOS2 = LPOOL - 2 - NBTOP + 1 + 10 CONTINUE + IF ( IPOS2 == LPOOL - 2 ) GOTO 20 + IF ( POOL(IPOS1) < 0 ) GOTO 20 + IF ( POOL(IPOS2) < 0 ) GOTO 30 + IF ( ATM_CURRENT_NODE ) THEN + IF ( POOL(IPOS1) > N ) GOTO 20 + IF ( POOL(IPOS2) > N ) GOTO 30 + END IF + GOTO 20 + 30 CONTINUE + ISWAP = POOL(IPOS1) + POOL(IPOS1) = POOL(IPOS2) + POOL(IPOS2) = ISWAP + IPOS1 = IPOS1 + 1 + IPOS2 = IPOS2 + 1 + GOTO 10 + 20 CONTINUE + ENDIF + POOL(LPOOL) = NBINSUBTREE + POOL(LPOOL - 1) = NBTOP + RETURN + END SUBROUTINE ZMUMPS_507 + LOGICAL FUNCTION ZMUMPS_508(POOL, LPOOL) + IMPLICIT NONE + INTEGER LPOOL + INTEGER POOL(LPOOL) + INTEGER NBINSUBTREE, NBTOP + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + ZMUMPS_508 = (NBINSUBTREE + NBTOP == 0) + RETURN + END FUNCTION ZMUMPS_508 + SUBROUTINE ZMUMPS_509( N, POOL, LPOOL, PROCNODE, SLAVEF, + & STEP, INODE, KEEP,KEEP8, MYID, ND, + & FORCE_EXTRACT_TOP_SBTR ) + USE ZMUMPS_LOAD + IMPLICIT NONE + INTEGER INODE, LPOOL, SLAVEF, N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER STEP(N), POOL(LPOOL), PROCNODE(KEEP(28)), + & ND(KEEP(28)) + EXTERNAL MUMPS_167, MUMPS_283, ZMUMPS_508 + LOGICAL MUMPS_167, MUMPS_283, ZMUMPS_508 + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + INTEGER NBINSUBTREE, NBTOP, INSUBTREE, INODE_EFF, MYID + LOGICAL LEFT, ATOMIC_SUBTREE,UPPER,FLAG_MEM,SBTR_FLAG,PROC_FLAG + LOGICAL FORCE_EXTRACT_TOP_SBTR + INTEGER NODE_TO_EXTRACT,I,J,MIN_PROC +#if defined(POOL_EXTRACT_MNG) + INTEGER POS_TO_EXTRACT +#endif + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + IF ( KEEP(76) > 6 .OR. KEEP(76) < 0 ) THEN + WRITE(*,*) "Error 2 in ZMUMPS_509: unknown strategy" + CALL MUMPS_ABORT() + ENDIF + ATOMIC_SUBTREE = ( KEEP(76) == 1 .OR. KEEP(76) == 3) + IF ( ZMUMPS_508(POOL, LPOOL) ) THEN + WRITE(*,*) "Error 1 in ZMUMPS_509" + CALL MUMPS_ABORT() + ENDIF + IF ( .NOT. ATOMIC_SUBTREE ) THEN + LEFT = (NBTOP == 0) + IF(.NOT.LEFT)THEN + IF((KEEP(76).EQ.4).OR.(KEEP(76).EQ.5))THEN + IF(NBINSUBTREE.EQ.0)THEN + LEFT=.FALSE. + ELSE + IF ( POOL(NBINSUBTREE) < 0 ) THEN + I = -POOL(NBINSUBTREE) + ELSE IF ( POOL(NBINSUBTREE) > N ) THEN + I = POOL(NBINSUBTREE) - N + ELSE + I = POOL(NBINSUBTREE) + ENDIF + IF ( POOL(LPOOL-2-NBTOP) < 0 ) THEN + J = -POOL(LPOOL-2-NBTOP) + ELSE IF ( POOL(LPOOL-2-NBTOP) > N ) THEN + J = POOL(LPOOL-2-NBTOP) - N + ELSE + J = POOL(LPOOL-2-NBTOP) + ENDIF + IF(KEEP(76).EQ.4)THEN + IF(DEPTH_FIRST_LOAD(STEP(J)).GE. + & DEPTH_FIRST_LOAD(STEP(I)))THEN + LEFT=.TRUE. + ELSE + LEFT=.FALSE. + ENDIF + ENDIF + IF(KEEP(76).EQ.5)THEN + IF(COST_TRAV(STEP(J)).LE. + & COST_TRAV(STEP(I)))THEN + LEFT=.TRUE. + ELSE + LEFT=.FALSE. + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + IF ( INSUBTREE == 1 ) THEN + IF (NBINSUBTREE == 0) THEN + WRITE(*,*) "Error 3 in ZMUMPS_509" + CALL MUMPS_ABORT() + ENDIF + LEFT = .TRUE. + ELSE + LEFT = ( NBTOP == 0) + ENDIF + ENDIF + 222 CONTINUE + IF ( LEFT ) THEN + INODE = POOL( NBINSUBTREE ) + IF(KEEP(81).EQ.2)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + CALL ZMUMPS_561(INODE,POOL,LPOOL,N, + & STEP,KEEP,KEEP8,PROCNODE,SLAVEF,MYID,SBTR_FLAG, + & PROC_FLAG,MIN_PROC) + IF(.NOT.SBTR_FLAG)THEN + WRITE(*,*)MYID,': ca a change pour moi' + LEFT=.FALSE. + GOTO 222 + ENDIF +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ELSEIF(KEEP(81).EQ.3)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + NODE_TO_EXTRACT=INODE + FLAG_MEM=.FALSE. + CALL ZMUMPS_820(FLAG_MEM) + IF(FLAG_MEM)THEN + CALL ZMUMPS_561(INODE,POOL,LPOOL,N, + & STEP,KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG, + & PROC_FLAG,MIN_PROC) + IF(.NOT.SBTR_FLAG)THEN + LEFT=.FALSE. + WRITE(*,*)MYID,': ca a change pour moi (2)' + GOTO 222 + ENDIF + ENDIF +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF + NBINSUBTREE = NBINSUBTREE - 1 + IF ( INODE < 0 ) THEN + INODE_EFF = -INODE + ELSE IF ( INODE > N ) THEN + INODE_EFF = INODE - N + ELSE + INODE_EFF = INODE + ENDIF + IF ( MUMPS_167( PROCNODE(STEP(INODE_EFF)), SLAVEF) ) THEN + IF((KEEP(47).GE.2.AND.KEEP(81).EQ.1).AND. + & (INSUBTREE.EQ.0))THEN + CALL ZMUMPS_513(.TRUE.) + ENDIF + INSUBTREE = 1 + ELSE IF ( MUMPS_283( PROCNODE(STEP(INODE_EFF)), + & SLAVEF)) THEN + IF((KEEP(47).GE.2.AND.KEEP(81).EQ.1).AND. + & (INSUBTREE.EQ.1))THEN + CALL ZMUMPS_513(.FALSE.) + ENDIF + INSUBTREE = 0 + END IF + ELSE + IF (NBTOP < 1 ) THEN + WRITE(*,*) "Error 5 in ZMUMPS_509", NBTOP + CALL MUMPS_ABORT() + ENDIF + INODE = POOL( LPOOL - 2 - NBTOP ) + IF(KEEP(81).EQ.1)THEN + CALL ZMUMPS_520 + & (INODE,UPPER,SLAVEF,KEEP,KEEP8, + & STEP,POOL,LPOOL,PROCNODE,N) + IF(UPPER)THEN + GOTO 666 + ELSE + NBINSUBTREE=NBINSUBTREE-1 + IF ( MUMPS_167( PROCNODE(STEP(INODE)), + & SLAVEF) ) THEN + INSUBTREE = 1 + ELSE IF ( MUMPS_283( PROCNODE(STEP(INODE)), + & SLAVEF)) THEN + INSUBTREE = 0 + ENDIF + GOTO 777 + ENDIF + ENDIF + IF(KEEP(81).EQ.2)THEN + CALL ZMUMPS_561(INODE,POOL,LPOOL,N,STEP, + & KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) + IF(SBTR_FLAG)THEN + LEFT=.TRUE. + WRITE(*,*)MYID,': ca a change pour moi (3)' + GOTO 222 + ENDIF + ELSE +#if defined(POOL_EXTRACT_MNG) + IF(KEEP(76).EQ.4)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + POS_TO_EXTRACT=-1 + NODE_TO_EXTRACT=-1 + DO I=NBTOP,1,-1 + IF(NODE_TO_EXTRACT.LT.0)THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ELSE + IF(DEPTH_FIRST_LOAD(STEP(POOL(LPOOL-2-I))).LT. + & DEPTH_FIRST_LOAD(STEP(NODE_TO_EXTRACT))) + & THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ENDIF + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + INODE = NODE_TO_EXTRACT +#else + INODE = INODE_EFF +#endif + DO I=POS_TO_EXTRACT,NBTOP + IF(I.NE.NBTOP)THEN + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF + IF(KEEP(76).EQ.5)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + POS_TO_EXTRACT=-1 + NODE_TO_EXTRACT=-1 + DO I=NBTOP,1,-1 + IF(NODE_TO_EXTRACT.LT.0)THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ELSE + IF(COST_TRAV(STEP(POOL(LPOOL-2-I))).GT. + & COST_TRAV(STEP(NODE_TO_EXTRACT)))THEN + POS_TO_EXTRACT=I +#if defined(NOT_ATM_POOL_SPECIAL) + INODE_EFF = POOL(LPOOL-2-I) + IF ( POOL(LPOOL-2-I) < 0 ) THEN + NODE_TO_EXTRACT=-POOL(LPOOL-2-I) + ELSE IF ( POOL(LPOOL-2-I) > N ) THEN + NODE_TO_EXTRACT = POOL(LPOOL-2-I) - N + ELSE + NODE_TO_EXTRACT = POOL(LPOOL-2-I) + ENDIF +#else + NODE_TO_EXTRACT=POOL(LPOOL-2-I) +#endif + ENDIF + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + INODE = NODE_TO_EXTRACT +#else + INODE = INODE_EFF +#endif + DO I=POS_TO_EXTRACT,NBTOP + IF(I.NE.NBTOP)THEN + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDIF + ENDDO +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF +#endif + IF(KEEP(81).EQ.3)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GE.0).AND.(INODE.LE.N))THEN +#endif + NODE_TO_EXTRACT=INODE + FLAG_MEM=.FALSE. + CALL ZMUMPS_820(FLAG_MEM) + IF(FLAG_MEM)THEN + CALL ZMUMPS_561(INODE,POOL,LPOOL,N, + & STEP,KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG, + & PROC_FLAG,MIN_PROC) + IF(SBTR_FLAG)THEN + LEFT=.TRUE. + WRITE(*,*)MYID,': ca a change pour moi (4)' + GOTO 222 + ENDIF + ELSE + CALL ZMUMPS_819(INODE) + ENDIF +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + ENDIF + ENDIF + 666 CONTINUE + NBTOP = NBTOP - 1 + IF((INODE.GT.0).AND.(INODE.LE.N))THEN + IF ((( KEEP(80) == 2 .OR. KEEP(80)==3 ) .AND. + & ( KEEP(47) == 4 ))) THEN + CALL ZMUMPS_514(INODE,2) + ENDIF + ENDIF + IF ( INODE < 0 ) THEN + INODE_EFF = -INODE + ELSE IF ( INODE > N ) THEN + INODE_EFF = INODE - N + ELSE + INODE_EFF = INODE + ENDIF + END IF + 777 CONTINUE + POOL(LPOOL) = NBINSUBTREE + POOL(LPOOL - 1) = NBTOP + POOL(LPOOL - 2) = INSUBTREE + RETURN + END SUBROUTINE ZMUMPS_509 + SUBROUTINE ZMUMPS_552(INODE,POOL,LPOOL,N,STEP, + & KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR,FLAG_SAME_PROC,MIN_PROC) + USE ZMUMPS_LOAD + IMPLICIT NONE + INTEGER INODE,LPOOL,N,MYID,SLAVEF,PROC,MIN_PROC + INTEGER POOL(LPOOL),KEEP(500),STEP(N),PROCNODE(KEEP(28)) + INTEGER(8) KEEP8(150) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + LOGICAL SBTR,FLAG_SAME_PROC + INTEGER POS_TO_EXTRACT,NODE_TO_EXTRACT,NBTOP,I,INSUBTREE, + & NBINSUBTREE + DOUBLE PRECISION MIN_COST, TMP_COST + NBINSUBTREE = POOL(LPOOL) + NBTOP = POOL(LPOOL - 1) + INSUBTREE = POOL(LPOOL - 2) + MIN_COST=huge(MIN_COST) + TMP_COST=huge(TMP_COST) + FLAG_SAME_PROC=.FALSE. + SBTR=.FALSE. + MIN_PROC=-9999 +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GT.0).AND.(INODE.LE.N))THEN +#endif + POS_TO_EXTRACT=-1 + NODE_TO_EXTRACT=-1 + DO I=NBTOP,1,-1 + IF(NODE_TO_EXTRACT.LT.0)THEN + POS_TO_EXTRACT=I + NODE_TO_EXTRACT=POOL(LPOOL-2-I) + CALL ZMUMPS_818(NODE_TO_EXTRACT, + & TMP_COST,PROC) + MIN_COST=TMP_COST + MIN_PROC=PROC + ELSE + CALL ZMUMPS_818(POOL(LPOOL-2-I), + & TMP_COST,PROC) + IF((PROC.NE.MIN_PROC).OR.(TMP_COST.NE.MIN_COST))THEN + FLAG_SAME_PROC=.TRUE. + ENDIF + IF(TMP_COST.GT.MIN_COST)THEN + POS_TO_EXTRACT=I + NODE_TO_EXTRACT=POOL(LPOOL-2-I) + MIN_COST=TMP_COST + MIN_PROC=PROC + ENDIF + ENDIF + ENDDO + IF((KEEP(47).EQ.4).AND.(NBINSUBTREE.NE.0))THEN + CALL ZMUMPS_554(NBINSUBTREE,INSUBTREE,NBTOP, + & MIN_COST,SBTR) + IF(SBTR)THEN + WRITE(*,*)MYID,': selecting from subtree' + RETURN + ENDIF + ENDIF + IF((.NOT.SBTR).AND.(.NOT.FLAG_SAME_PROC))THEN + WRITE(*,*)MYID,': I must search for a task + & to save My friend' + RETURN + ENDIF + INODE = NODE_TO_EXTRACT + DO I=POS_TO_EXTRACT,NBTOP + IF(I.NE.NBTOP)THEN + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDIF + ENDDO + POOL(LPOOL-2-NBTOP)=INODE + CALL ZMUMPS_819(INODE) +#if ! defined(NOT_ATM_POOL_SPECIAL) + ELSE + ENDIF +#endif + END SUBROUTINE ZMUMPS_552 + SUBROUTINE ZMUMPS_561(INODE,POOL,LPOOL,N,STEP, + & KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) + USE ZMUMPS_LOAD + IMPLICIT NONE + INTEGER INODE,LPOOL,N,SLAVEF,MYID,MIN_PROC + INTEGER POOL(LPOOL),KEEP(500),PROCNODE(KEEP(28)),STEP(N) + INTEGER(8) KEEP8(150) + LOGICAL SBTR_FLAG,PROC_FLAG + EXTERNAL MUMPS_167 + LOGICAL MUMPS_167 + INTEGER NODE_TO_EXTRACT,I,POS_TO_EXTRACT,NBTOP,NBINSUBTREE + NBTOP= POOL(LPOOL - 1) + NBINSUBTREE = POOL(LPOOL) + IF(NBTOP.GT.0)THEN + WRITE(*,*)MYID,': NBTOP=',NBTOP + ENDIF + SBTR_FLAG=.FALSE. + PROC_FLAG=.FALSE. + CALL ZMUMPS_552(INODE,POOL,LPOOL,N,STEP,KEEP,KEEP8, + & PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC) + IF(SBTR_FLAG)THEN + RETURN + ENDIF + IF(MIN_PROC.EQ.-9999)THEN +#if ! defined(NOT_ATM_POOL_SPECIAL) + IF((INODE.GT.0).AND.(INODE.LT.N))THEN +#endif + SBTR_FLAG=(NBINSUBTREE.NE.0) +#if ! defined(NOT_ATM_POOL_SPECIAL) + ENDIF +#endif + RETURN + ENDIF + IF(.NOT.PROC_FLAG)THEN + NODE_TO_EXTRACT=INODE + IF((INODE.GE.0).AND.(INODE.LE.N))THEN + CALL ZMUMPS_553(MIN_PROC,POOL, + & LPOOL,INODE) + IF(MUMPS_167(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + WRITE(*,*)MYID,': Extracting from a subtree + & for helping',MIN_PROC + SBTR_FLAG=.TRUE. + RETURN + ELSE + IF(NODE_TO_EXTRACT.NE.INODE)THEN + WRITE(*,*)MYID,': Extracting from top + & inode=',INODE,'for helping',MIN_PROC + ENDIF + CALL ZMUMPS_819(INODE) + ENDIF + ENDIF + DO I=1,NBTOP + IF (POOL(LPOOL-2-I).EQ.INODE)THEN + GOTO 452 + ENDIF + ENDDO + 452 CONTINUE + POS_TO_EXTRACT=I + DO I=POS_TO_EXTRACT,NBTOP-1 + POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1) + ENDDO + POOL(LPOOL-2-NBTOP)=INODE + ENDIF + END SUBROUTINE ZMUMPS_561 + SUBROUTINE ZMUMPS_574 + & ( IPOOL, LPOOL, III, LEAF, + & INODE, STRATEGIE ) + IMPLICIT NONE + INTEGER, INTENT(IN) :: STRATEGIE, LPOOL + INTEGER IPOOL (LPOOL) + INTEGER III,LEAF + INTEGER, INTENT(OUT) :: INODE + LEAF = LEAF - 1 + INODE = IPOOL( LEAF ) + RETURN + END SUBROUTINE ZMUMPS_574 + SUBROUTINE ZMUMPS_128(N, NELT, ELTPTR, ELTVAR, LIW, + & IKEEP, PTRAR, + & IORD, NFSIZ, FILS, FRERE, + & LISTVAR_SCHUR, SIZE_SCHUR, + & ICNTL, INFO, KEEP,KEEP8, + & ELTNOD, NSLAVES, + & XNODEL, NODEL) + IMPLICIT NONE + INTEGER N,NELT,LIW,IORD, SIZE_SCHUR, NSLAVES + INTEGER PTRAR(N,3), NFSIZ(N), FILS(N), FRERE(N) + INTEGER ELTPTR(NELT+1) + INTEGER XNODEL(N+1), NODEL(ELTPTR(NELT+1)-1) + INTEGER ELTVAR(ELTPTR(NELT+1)-1) + INTEGER IKEEP(N,3) + INTEGER LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER INFO(40), ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER ELTNOD(NELT) + INTEGER K,I,L1,L2,IWFR,NCMPA,LLIW,IFSON,IN + INTEGER NEMIN, MPRINT, LP, MP, LDIAG + INTEGER NZ, allocok, ITEMP + LOGICAL PROK, NOSUPERVAR + INTEGER(8) :: K79REF + PARAMETER(K79REF=12000000_8) + LOGICAL SPLITROOT + INTEGER, DIMENSION(:), ALLOCATABLE :: IW + INTEGER, DIMENSION(:), ALLOCATABLE :: IW2 + INTEGER OPT_METIS_SIZE, NUMFLAG + PARAMETER(OPT_METIS_SIZE = 8, NUMFLAG = 1) + INTEGER OPTIONS_METIS(OPT_METIS_SIZE) + INTEGER IDUM + EXTERNAL MUMPS_197, ZMUMPS_130, ZMUMPS_131, + & ZMUMPS_129, ZMUMPS_132, + & ZMUMPS_133, ZMUMPS_134, + & ZMUMPS_199, + & ZMUMPS_557, ZMUMPS_201 +#if defined(OLDDFS) + EXTERNAL ZMUMPS_200 +#endif + ALLOCATE( IW ( LIW ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = LIW + RETURN + ENDIF + MPRINT= ICNTL(3) + PROK = (MPRINT.GT.0) + LP = ICNTL(1) + MP = ICNTL(3) + LDIAG = ICNTL(4) + IF (KEEP(60).NE.0) THEN + NOSUPERVAR=.TRUE. + IF (IORD.GT.1) IORD = 0 + ELSE + NOSUPERVAR=.FALSE. + ENDIF + IF (IORD == 7) THEN + IF ( N < 10000 ) THEN + IORD = 0 + ELSE +#if defined(metis) || defined(parmetis) + IORD = 5 +#else + IORD = 0 +#endif + ENDIF + END IF +#if ! defined(metis) && ! defined(parmetis) + IF (IORD == 5) IORD = 0 +#endif + IF (KEEP(1).LT.1) KEEP(1) = 1 + NEMIN = KEEP(1) + IF (LDIAG.LE.2 .OR. MP.LE.0) GO TO 10 + WRITE (MP,99999) N, NELT, LIW, INFO(1) + K = min0(10,NELT+1) + IF (LDIAG.EQ.4) K = NELT+1 + IF (K.GT.0) WRITE (MP,99998) (ELTPTR(I),I=1,K) + K = min0(10,ELTPTR(NELT+1)-1) + IF (LDIAG.EQ.4) K = ELTPTR(NELT+1)-1 + IF (K.GT.0) WRITE (MP,99995) (ELTVAR(I),I=1,K) + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (IORD.EQ.1 .AND. K.GT.0) THEN + WRITE (MP,99997) (IKEEP(I,1),I=1,K) + ENDIF + 10 L1 = 1 + L2 = L1 + N + IF (LIW .LT. 3*N) THEN + INFO(1)= -2002 + INFO(2) = LIW + ENDIF +#if defined(metis) || defined(parmetis) + IF ( IORD == 5 ) THEN + IF (LIW .LT. N+N+1) THEN + INFO(1)= -2002 + INFO(2) = LIW + RETURN + ENDIF + ELSE +#endif + IF (NOSUPERVAR) THEN + IF ( LIW .LT. 2*N ) THEN + INFO(1)= -2002 + INFO(2) = LIW + RETURN + END IF + ELSE + IF ( LIW .LT. 4*N+4 ) THEN + INFO(1)= -2002 + INFO(2) = LIW + RETURN + END IF + ENDIF +#if defined(metis) || defined(parmetis) + ENDIF +#endif + IDUM=0 + CALL ZMUMPS_258(NELT, N, ELTPTR(NELT+1)-1, ELTPTR, ELTVAR, + & XNODEL, NODEL, IW(L1), IDUM, ICNTL) + IF (IORD.NE.1 .AND. IORD .NE. 5) THEN + IORD = 0 + IF (NOSUPERVAR) THEN + CALL ZMUMPS_129(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & PTRAR(1,2), IW(L1)) + ELSE + CALL ZMUMPS_130(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & PTRAR(1,2), 4*N+4, IW(L1)) + ENDIF + LLIW = max(NZ,N) + ALLOCATE( IW2(LLIW), stat = allocok ) + IF (allocok.GT.0) THEN + INFO(1) = -7 + INFO(2) = LLIW + RETURN + ENDIF + IF (NOSUPERVAR) THEN + CALL ZMUMPS_132(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IW2, LLIW, PTRAR, PTRAR(1,2), + & IW(L1), IWFR) + ELSE + CALL ZMUMPS_131(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IW2, LLIW, PTRAR, PTRAR(1,2), + & IW(L1), IWFR) + ENDIF + IF (NOSUPERVAR) THEN + CALL MUMPS_162(N, LLIW, PTRAR, IWFR, PTRAR(1,2), IW2, + & IW(L1), IKEEP, + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), IW(L2), PTRAR(1,3), + & LISTVAR_SCHUR, SIZE_SCHUR) + IF (KEEP(60) == 1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSEIF (KEEP(60) == 2 .OR. KEEP(60) == 3 ) THEN + KEEP(38) = LISTVAR_SCHUR(1) + ELSE + WRITE(*,*) "Internal error in ZMUMPS_128",KEEP(60) + CALL MUMPS_ABORT() + ENDIF + ELSE + CALL MUMPS_23(N, LLIW, PTRAR, IWFR, PTRAR(1,2), IW2, + & IW(L1), IKEEP, + & IKEEP(1,2), NCMPA, FILS, IKEEP(1,3), IW(L2), PTRAR(1,3)) + ENDIF + ELSE +#if defined(metis) || defined(parmetis) + IF (IORD.EQ.5) THEN + IF (PROK) THEN + WRITE(MPRINT,'(A)') ' Ordering based on METIS ' + ENDIF + CALL ZMUMPS_129(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & PTRAR(1,2), IW(L1)) + LLIW = max(NZ,N) + ALLOCATE( IW2(LLIW), stat = allocok ) + IF (allocok.GT.0) THEN + INFO(1) = -7 + INFO(2) = LLIW + RETURN + ENDIF + CALL ZMUMPS_538(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IW2, LLIW, IW(L2), PTRAR(1,2), + & IW(L1), IWFR) + OPTIONS_METIS(1) = 0 + CALL METIS_NODEND(N, IW(L2), IW2(1), NUMFLAG, OPTIONS_METIS, + & IKEEP(1,2), IKEEP(1,1) ) + DEALLOCATE(IW2) + ELSE IF (IORD.NE.1) THEN + WRITE(*,*) IORD + WRITE(*,*) 'bad option for ordering' + CALL MUMPS_ABORT() + ENDIF +#endif + DO K=1,N + IW(L1+K) = 0 + ENDDO + DO K=1,N + IF ((IKEEP(K,1).LE.0).OR.(IKEEP(K,1).GT.N)) + & GO TO 40 + IF (IW(L1+IKEEP(K,1)).EQ.1) THEN + GOTO 40 + ELSE + IW(L1+IKEEP(K,1)) = 1 + ENDIF + ENDDO + CALL ZMUMPS_133(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IKEEP, PTRAR(1,2), IW(L1)) + LLIW = NZ+N + ALLOCATE( IW2(LLIW), stat = allocok ) + IF (allocok.GT.0) THEN + INFO(1) = -7 + INFO(2) = LLIW + RETURN + ENDIF + CALL ZMUMPS_134(N, NZ, NELT, ELTPTR(NELT+1)-1, + & ELTPTR, ELTVAR, XNODEL, NODEL, + & IKEEP, IW2, LLIW, PTRAR, PTRAR(1,2), + & IW(L1), IWFR) + IF (KEEP(60) == 0) THEN + ITEMP = 0 + ELSE + ITEMP = SIZE_SCHUR + IF (KEEP(60) == 1) THEN + KEEP(20) = LISTVAR_SCHUR(1) + ELSEIF (KEEP(60) == 2 .OR. KEEP(60) == 3 ) THEN + KEEP(38) = LISTVAR_SCHUR(1) + ELSE + WRITE(*,*) "Internal error in ZMUMPS_128",KEEP(60) + CALL MUMPS_ABORT() + ENDIF + ENDIF + CALL ZMUMPS_199(N, PTRAR, IW2, LLIW, IWFR, IKEEP, + & IKEEP(1,2), IW(L1), + & IW(L2), NCMPA, ITEMP) + ENDIF +#if defined(OLDDFS) + CALL ZMUMPS_200(N, PTRAR, IW(L1), IKEEP, IKEEP(1,2), + & IKEEP(1,3), + & NFSIZ, INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, KEEP(60)) +#else + CALL ZMUMPS_557(N, PTRAR, IW(L1), IKEEP, IKEEP(1,2), + & IKEEP(1,3), + & NFSIZ, PTRAR(1,2), + & INFO(6), FILS, FRERE, PTRAR(1,3), NEMIN, + & IW(L2), KEEP(60), KEEP(20), KEEP(38), + & IW2,KEEP(104),IW(L2+N),KEEP(50), + & ICNTL(13), KEEP(37), NSLAVES, KEEP(250).EQ.1) +#endif + DEALLOCATE(IW2) + IF (KEEP(60).NE.0) THEN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO WHILE (IN.GT.0) + IN = FILS (IN) + END DO + IFSON = -IN + IF (KEEP(60)==1) THEN + IN = KEEP(20) + ELSE + IN = KEEP(38) + ENDIF + DO I=2,SIZE_SCHUR + FILS(IN) = LISTVAR_SCHUR (I) + IN = FILS(IN) + FRERE (IN) = N+1 + ENDDO + FILS(IN) = -IFSON + ENDIF + CALL ZMUMPS_201(IKEEP(1,2), + & PTRAR(1,3), INFO(6), + & INFO(5), KEEP(2),KEEP(50), + & KEEP(101), KEEP(108),KEEP(5), + & KEEP(6), KEEP(226), KEEP(253)) + IF ( KEEP(53) .NE. 0 ) THEN + CALL MUMPS_209( N, FRERE, FILS, NFSIZ, KEEP(20) ) + END IF + IF ( KEEP(48) == 4 .OR. + & ( (KEEP(24).NE.0).AND.(KEEP8(21).GT.0_8) ) ) THEN + CALL ZMUMPS_510(KEEP8(21), KEEP(2), + & KEEP(48), KEEP(50), NSLAVES) + END IF + IF (KEEP(210).LT.0.OR.KEEP(210).GT.2) KEEP(210)=0 + IF (KEEP(210).EQ.0.AND.KEEP(201).GT.0) KEEP(210)=1 + IF (KEEP(210).EQ.0.AND.KEEP(201).EQ.0) KEEP(210)=2 + IF (KEEP(210).EQ.2) KEEP8(79)=huge(KEEP8(79)) + IF (KEEP(210).EQ.1.AND.KEEP8(79).LE.0_8) THEN + IF ( huge(KEEP8(79)) / K79REF + 1_8 .GE. int(NSLAVES,8) ) THEN + KEEP8(79)=huge(KEEP8(79)) + ELSE + KEEP8(79)=K79REF * int(NSLAVES,8) + ENDIF + ENDIF + IF (KEEP(79).EQ.0) THEN + IF (KEEP(210).EQ.1) THEN + SPLITROOT = .FALSE. + IF ( KEEP(62).GE.1) THEN + CALL ZMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG, INFO(1), INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + ENDIF + ENDIF + SPLITROOT = ((ICNTL(13).GT.0) .AND. (NSLAVES.GE.ICNTL(13))) + IF (SPLITROOT) THEN + CALL ZMUMPS_97(N, FRERE, FILS, NFSIZ,INFO(6), + & NSLAVES, KEEP,KEEP8, SPLITROOT, + & MP, LDIAG, INFO(1), INFO(2)) + IF (INFO(1).LT.0) RETURN + ENDIF + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + IF (K.GT.0) WRITE (MP,99997) (IKEEP(I,1),I=1,K) + IF (K.GT.0) WRITE (MP,99991) (IKEEP(I,2),I=1,K) + IF (K.GT.0) WRITE (MP,99990) (IKEEP(I,3),I=1,K) + IF (K.GT.0) WRITE (MP,99987) (NFSIZ(I),I=1,K) + IF (K.GT.0) WRITE (MP,99989) (FILS(I),I=1,K) + IF (K.GT.0) WRITE (MP,99988) (FRERE(I),I=1,K) + ENDIF + GO TO 90 + 40 INFO(1) = -4 + INFO(2) = K + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99996) INFO(1) + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) WRITE (LP,99982) INFO(2) + 90 CONTINUE + DEALLOCATE(IW) + RETURN +99999 FORMAT (/'Entering analysis phase with ...'/ + & ' N NELT LIW INFO(1)'/, + & 9X, I8, I11, I12, I14) +99998 FORMAT ('Element pointers: ELTPTR() '/(9X, 7I10)) +99995 FORMAT ('Element variables: ELTVAR() '/(9X, 7I10)) +99997 FORMAT ('IKEEP(.,1)=', 10I6/(12X, 10I6)) +99996 FORMAT (/'** Error return ** from Analysis * INFO(1)=', I3) +99991 FORMAT ('IKEEP(.,2)=', 10I6/(12X, 10I6)) +99990 FORMAT ('IKEEP(.,3)=', 10I6/(12X, 10I6)) +99989 FORMAT ('FILS (.) =', 10I6/(12X, 10I6)) +99988 FORMAT ('FRERE(.) =', 10I6/(12X, 10I6)) +99987 FORMAT ('NFSIZ(.) =', 10I6/(12X, 10I6)) +99982 FORMAT ('Error in permutation array KEEP INFO(2)=', I3) + END SUBROUTINE ZMUMPS_128 + SUBROUTINE ZMUMPS_258( NELT, N, NELNOD, XELNOD, ELNOD, + & XNODEL, NODEL, FLAG, IERROR, ICNTL ) + IMPLICIT NONE + INTEGER NELT, N, NELNOD, IERROR, ICNTL(40) + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & FLAG(N) + INTEGER I, J, K, MP, NBERR + MP = ICNTL(2) + FLAG(1:N) = 0 + XNODEL(1:N) = 0 + IERROR = 0 + DO I = 1, NELT + DO K = XELNOD(I), XELNOD(I+1)-1 + J = ELNOD(K) + IF ( J.LT.1 .OR. J.GT.N ) THEN + IERROR = IERROR + 1 + ELSE + IF ( FLAG(J).NE.I ) THEN + XNODEL(J) = XNODEL(J) + 1 + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + IF ( IERROR.GT.0 .AND. MP.GT.0 .AND. ICNTL(4).GE.2 ) THEN + NBERR = 0 + WRITE(MP,99999) + DO I = 1, NELT + DO K = XELNOD(I), XELNOD(I+1)-1 + J = ELNOD(K) + IF ( J.LT.1 .OR. J.GT.N ) THEN + NBERR = NBERR + 1 + IF (NBERR.LE.10) THEN + WRITE(MP,'(A,I8,A,I8,A)') + & 'Element ',I,' variable ',J,' ignored.' + ELSE + GO TO 100 + ENDIF + ENDIF + ENDDO + ENDDO + ENDIF + 100 CONTINUE + K = 1 + DO I = 1, N + K = K + XNODEL(I) + XNODEL(I) = K + ENDDO + XNODEL(N+1) = XNODEL(N) + FLAG(1:N) = 0 + DO I = 1, NELT + DO K = XELNOD(I), XELNOD(I+1)-1 + J = ELNOD(K) + IF (FLAG(J).NE.I) THEN + XNODEL(J) = XNODEL(J) - 1 + NODEL(XNODEL(J)) = I + FLAG(J) = I + ENDIF + ENDDO + ENDDO + RETURN +99999 FORMAT (/'*** Warning message from subroutine ZMUMPS_258 ***') + END SUBROUTINE ZMUMPS_258 + SUBROUTINE ZMUMPS_129(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & LEN, FLAG) + IMPLICIT NONE + INTEGER N, NELT, NELNOD, NZ + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & FLAG(N) + INTEGER I,J,K1,K2,K3 + FLAG(1:N) = 0 + LEN(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.LT.J) .AND. (FLAG(J).NE.I)) THEN + LEN(I) = LEN(I) + 1 + LEN(J) = LEN(J) + 1 + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + NZ = 0 + DO I = 1,N + NZ = NZ + LEN(I) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_129 + SUBROUTINE ZMUMPS_538(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER LEN(N) + INTEGER IPE(N+1) + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW), FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 1 + DO I = 1,N + IWFR = IWFR + LEN(I) + IPE(I) = IWFR + ENDDO + IPE(N+1)=IPE(N) + FLAG(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.LT.J) .AND. (FLAG(J).NE.I)) THEN + IPE(I) = IPE(I) - 1 + IW(IPE(I)) = J + IPE(J) = IPE(J) - 1 + IW(IPE(J)) = I + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE ZMUMPS_538 + SUBROUTINE ZMUMPS_132(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER LEN(N) + INTEGER IPE(N) + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW), FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 1 + DO I = 1,N + IWFR = IWFR + LEN(I) + IF (LEN(I).GT.0) THEN + IPE(I) = IWFR + ELSE + IPE(I) = 0 + ENDIF + ENDDO + FLAG(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.LT.J) .AND. (FLAG(J).NE.I)) THEN + IPE(I) = IPE(I) - 1 + IW(IPE(I)) = J + IPE(J) = IPE(J) - 1 + IW(IPE(J)) = I + FLAG(J) = I + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE ZMUMPS_132 + SUBROUTINE ZMUMPS_133(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & PERM, LEN, FLAG) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER PERM(N) + INTEGER LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), FLAG(N) + INTEGER I,J,K1,K2,K3 + FLAG(1:N) = 0 + LEN(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I),XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2),XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.NE.J) .AND. (FLAG(J).NE.I)) THEN + IF (PERM(J).GT.PERM(I)) THEN + LEN(I) = LEN(I) + 1 + FLAG(J) = I + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + NZ = 0 + DO I = 1,N + NZ = NZ + LEN(I) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_133 + SUBROUTINE ZMUMPS_134(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & PERM, IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER PERM(N) + INTEGER IPE(N), LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), IW(LW), + & FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 0 + DO I = 1,N + IWFR = IWFR + LEN(I) + 1 + IPE(I) = IWFR + ENDDO + IWFR = IWFR + 1 + FLAG(1:N) = 0 + DO I = 1,N + DO K1 = XNODEL(I),XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2),XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF ((I.NE.J) .AND. (FLAG(J).NE.I)) THEN + IF (PERM(J).GT.PERM(I)) THEN + IW(IPE(I)) = J + IPE(I) = IPE(I) - 1 + FLAG(J) = I + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + DO I = 1,N + J = IPE(I) + IW(J) = LEN(I) + IF (LEN(I).EQ.0) IPE(I) = 0 + ENDDO + RETURN + END SUBROUTINE ZMUMPS_134 + SUBROUTINE ZMUMPS_25( MYID, SLAVEF, N, + & PROCNODE, STEP, PTRAIW, PTRARW, + & NELT, FRTPTR, FRTELT, + & KEEP,KEEP8, ICNTL, SYM ) + IMPLICIT NONE + INTEGER MYID, SLAVEF, N, NELT, SYM + INTEGER KEEP( 500 ), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER PTRAIW( NELT+1 ), PTRARW( NELT+1 ) + INTEGER STEP( N ) + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER PROCNODE( KEEP(28) ) + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER ELT, I, K, IPTRI, IPTRR, NVAR + INTEGER TYPE_PARALL, ITYPE, IRANK + TYPE_PARALL = KEEP(46) + PTRAIW( 1:NELT ) = 0 + DO I = 1, N + IF (STEP(I).LT.0) CYCLE + ITYPE = MUMPS_330( PROCNODE(abs(STEP(I))), SLAVEF ) + IRANK = MUMPS_275( PROCNODE(abs(STEP(I))), SLAVEF ) + IF ( TYPE_PARALL .eq. 0 ) THEN + IRANK = IRANK + 1 + END IF + IF ( (ITYPE .EQ. 2) .OR. + & (ITYPE .EQ. 1 .AND. IRANK .EQ. MYID) ) THEN + DO K = FRTPTR(I),FRTPTR(I+1)-1 + ELT = FRTELT(K) + PTRAIW( ELT ) = PTRARW(ELT+1) - PTRARW(ELT) + ENDDO + ELSE + END IF + END DO + IPTRI = 1 + DO ELT = 1,NELT + NVAR = PTRAIW( ELT ) + PTRAIW( ELT ) = IPTRI + IPTRI = IPTRI + NVAR + ENDDO + PTRAIW( NELT+1 ) = IPTRI + KEEP( 14 ) = IPTRI - 1 + IF ( .TRUE. ) THEN + IF (SYM .EQ. 0) THEN + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRAIW( ELT+1 ) - PTRAIW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + NVAR*NVAR + ENDDO + PTRARW( NELT+1 ) = IPTRR + ELSE + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRAIW( ELT+1 ) - PTRAIW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + (NVAR*(NVAR+1))/2 + ENDDO + PTRARW( NELT+1 ) = IPTRR + ENDIF + ELSE + IF (SYM .EQ. 0) THEN + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRARW( ELT+1 ) - PTRARW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + NVAR*NVAR + ENDDO + PTRARW( NELT+1 ) = IPTRR + ELSE + IPTRR = 1 + DO ELT = 1,NELT + NVAR = PTRARW( ELT+1 ) - PTRARW( ELT ) + PTRARW( ELT ) = IPTRR + IPTRR = IPTRR + (NVAR*(NVAR+1))/2 + ENDDO + PTRARW( NELT+1 ) = IPTRR + ENDIF + ENDIF + KEEP( 13 ) = IPTRR - 1 + RETURN + END SUBROUTINE ZMUMPS_25 + SUBROUTINE ZMUMPS_120( N, NELT, ELTPROC, SLAVEF, PROCNODE ) + IMPLICIT NONE + INTEGER N, NELT, SLAVEF + INTEGER PROCNODE( N ), ELTPROC( NELT ) + INTEGER ELT, I, ITYPE, MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + DO ELT = 1, NELT + I = ELTPROC(ELT) + IF ( I .NE. 0) THEN + ITYPE = MUMPS_330(PROCNODE(I),SLAVEF) + IF (ITYPE.EQ.1) THEN + ELTPROC(ELT) = MUMPS_275(PROCNODE(I),SLAVEF) + ELSE IF (ITYPE.EQ.2) THEN + ELTPROC(ELT) = -1 + ELSE + ELTPROC(ELT) = -2 + ENDIF + ELSE + ELTPROC(ELT) = -3 + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_120 + SUBROUTINE ZMUMPS_153(N, NELT, NELNOD, FRERE, FILS, NA, NE, + & XNODEL, NODEL, FRTPTR, FRTELT, ELTNOD) + IMPLICIT NONE + INTEGER N, NELT, NELNOD + INTEGER FRERE(N), FILS(N), NA(N), NE(N) + INTEGER FRTPTR(N+1), FRTELT(NELT), ELTNOD(NELT) + INTEGER XNODEL(N+1), NODEL(NELNOD) + INTEGER TNSTK( N ), IPOOL( N ) + INTEGER I, K, IFATH + INTEGER INODE, LEAF, NBLEAF, NBROOT, III, IN + TNSTK = NE + LEAF = 1 + IF (N.EQ.1) THEN + NBROOT = 1 + NBLEAF = 1 + IPOOL(1) = 1 + LEAF = LEAF + 1 + ELSEIF (NA(N).LT.0) THEN + NBLEAF = N + NBROOT = N + DO 20 I=1,NBLEAF-1 + INODE = NA(I) + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + 20 CONTINUE + INODE = -NA(N)-1 + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + ELSEIF (NA(N-1).LT.0) THEN + NBLEAF = N-1 + NBROOT = NA(N) + IF (NBLEAF-1.GT.0) THEN + DO 30 I=1,NBLEAF-1 + INODE = NA(I) + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + 30 CONTINUE + ENDIF + INODE = -NA(N-1)-1 + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + ELSE + NBLEAF = NA(N-1) + NBROOT = NA(N) + DO 40 I = 1,NBLEAF + INODE = NA(I) + IPOOL(LEAF) = INODE + LEAF = LEAF + 1 + 40 CONTINUE + ENDIF + ELTNOD(1:NELT) = 0 + III = 1 + 90 CONTINUE + IF (III.NE.LEAF) THEN + INODE=IPOOL(III) + III = III + 1 + ELSE + WRITE(6,*) ' ERROR 1 in file ZMUMPS_153 ' + CALL MUMPS_ABORT() + ENDIF + 95 CONTINUE + IN = INODE + 100 CONTINUE + DO K = XNODEL(IN),XNODEL(IN+1)-1 + I = NODEL(K) + IF (ELTNOD(I).EQ.0) ELTNOD(I) = INODE + ENDDO + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 100 + IN = INODE + 110 IN = FRERE(IN) + IF (IN.GT.0) GO TO 110 + IF (IN.EQ.0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 115 + GOTO 90 + ELSE + IFATH = -IN + ENDIF + TNSTK(IFATH) = TNSTK(IFATH) - 1 + IF ( TNSTK(IFATH) .EQ. 0 ) THEN + INODE = IFATH + GOTO 95 + ELSE + GOTO 90 + ENDIF + 115 CONTINUE + FRTPTR(1:N) = 0 + DO I = 1,NELT + IF (ELTNOD(I) .NE. 0) THEN + FRTPTR(ELTNOD(I)) = FRTPTR(ELTNOD(I)) + 1 + ENDIF + ENDDO + K = 1 + DO I = 1,N + K = K + FRTPTR(I) + FRTPTR(I) = K + ENDDO + FRTPTR(N+1) = FRTPTR(N) + DO K = 1,NELT + INODE = ELTNOD(K) + IF (INODE .NE. 0) THEN + FRTPTR(INODE) = FRTPTR(INODE) - 1 + FRTELT(FRTPTR(INODE)) = K + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_153 + SUBROUTINE ZMUMPS_130(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & LEN, LW, IW) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER LEN(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW) + INTEGER I,J,K1,K2,K3,LP,NSUP,SUPVAR + INTEGER INFO44(6) + EXTERNAL ZMUMPS_315 + LP = 6 + CALL ZMUMPS_315(N,NELT,XELNOD(NELT+1)-1,ELNOD,XELNOD, + & NSUP,IW(3*N+3+1),3*N+3,IW,LP,INFO44) + IF (INFO44(1) .LT. 0) THEN + IF (LP.GE.0) WRITE(LP,*) + & 'Error return from ZMUMPS_315. INFO(1) = ',INFO44(1) + ENDIF + IW(1:NSUP) = 0 + LEN(1:N) = 0 + DO I = 1,N + SUPVAR = IW(3*N+3+1+I) + IF (SUPVAR .EQ. 0) CYCLE + IF (IW(SUPVAR).NE.0) THEN + LEN(I) = -IW(SUPVAR) + ELSE + IW(SUPVAR) = I + ENDIF + ENDDO + IW(N+1:2*N) = 0 + NZ = 0 + DO SUPVAR = 1,NSUP + I = IW(SUPVAR) + DO K1 = XNODEL(I),XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2),XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF (LEN(J).GE.0) THEN + IF ((I.NE.J) .AND. (IW(N+J).NE.I)) THEN + IW(N+J) = I + LEN(I) = LEN(I) + 1 + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + NZ = NZ + LEN(I) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_130 + SUBROUTINE ZMUMPS_131(N, NZ, NELT, NELNOD, + & XELNOD, ELNOD, XNODEL, NODEL, + & IW, LW, IPE, LEN, FLAG, IWFR) + IMPLICIT NONE + INTEGER N,NZ,NELT,NELNOD,LW,IWFR + INTEGER XELNOD(NELT+1), ELNOD(NELNOD) + INTEGER LEN(N) + INTEGER IPE(N) + INTEGER XNODEL(N+1), NODEL(NELNOD), + & IW(LW), FLAG(N) + INTEGER I,J,K1,K2,K3 + IWFR = 1 + DO I = 1,N + IF (LEN(I).GT.0) THEN + IWFR = IWFR + LEN(I) + IPE(I) = IWFR + ELSE + IPE(I) = 0 + ENDIF + ENDDO + FLAG(1:N) = 0 + DO I = 1,N + IF (LEN(I).LE.0) CYCLE + DO K1 = XNODEL(I), XNODEL(I+1)-1 + K2 = NODEL(K1) + DO K3 = XELNOD(K2), XELNOD(K2+1)-1 + J = ELNOD(K3) + IF ((J.GE.1) .AND. (J.LE.N)) THEN + IF (LEN(J) .GT. 0) THEN + IF ((I.NE.J) .AND. (FLAG(J).NE.I)) THEN + IPE(I) = IPE(I) - 1 + IW(IPE(I)) = J + FLAG(J) = I + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + RETURN + END SUBROUTINE ZMUMPS_131 + SUBROUTINE ZMUMPS_315(N,NELT,NZ,ELTVAR,ELTPTR,NSUP,SVAR, + & LIW,IW,LP,INFO) + INTEGER LIW,LP,N,NELT,NSUP,NZ + INTEGER INFO(6) + INTEGER ELTPTR(NELT+1),ELTVAR(NZ) + INTEGER IW(LIW),SVAR(0:N) + INTEGER FLAG,NEW,VARS + EXTERNAL ZMUMPS_316 + INFO(1) = 0 + INFO(2) = 0 + INFO(3) = 0 + INFO(4) = 0 + IF (N.LT.1) GO TO 10 + IF (NELT.LT.1) GO TO 20 + IF (NZ.LT.ELTPTR(NELT+1)-1) GO TO 30 + IF (LIW.LT.6) THEN + INFO(4) = 3*N + 3 + GO TO 40 + END IF + NEW = 1 + VARS = NEW + LIW/3 + FLAG = VARS + LIW/3 + CALL ZMUMPS_316(N,NELT,ELTPTR,NZ,ELTVAR,SVAR,NSUP,LIW/3-1, + & IW(NEW),IW(VARS),IW(FLAG),INFO) + IF (INFO(1).EQ.-4) THEN + INFO(4) = 3*N + 3 + GO TO 40 + ELSE + INFO(4) = 3*NSUP + 3 + END IF + GO TO 50 + 10 INFO(1) = -1 + IF (LP.GT.0) WRITE (LP,FMT=9000) INFO(1) + GO TO 50 + 20 INFO(1) = -2 + IF (LP.GT.0) WRITE (LP,FMT=9000) INFO(1) + GO TO 50 + 30 INFO(1) = -3 + IF (LP.GT.0) WRITE (LP,FMT=9000) INFO(1) + GO TO 50 + 40 INFO(1) = -4 + IF (LP.GT.0) THEN + WRITE (LP,FMT=9000) INFO(1) + WRITE (LP,FMT=9010) INFO(4) + END IF + 50 RETURN + 9000 FORMAT (/3X,'Error message from ZMUMPS_315: INFO(1) = ',I2) + 9010 FORMAT (3X,'LIW is insufficient. Upper bound on required work', + & 'space is ',I8) + END SUBROUTINE ZMUMPS_315 + SUBROUTINE ZMUMPS_316( N, NELT, ELTPTR, NZ, ELTVAR, + & SVAR, NSUP, MAXSUP, NEW, VARS, FLAG, INFO ) + INTEGER MAXSUP,N,NELT,NSUP,NZ + INTEGER ELTPTR(NELT+1),ELTVAR(NZ) + INTEGER INFO(6) + INTEGER FLAG(0:MAXSUP), NEW(0:MAXSUP),SVAR(0:N), + & VARS(0:MAXSUP) + INTEGER I,IS,J,JS,K,K1,K2 + DO 10 I = 0,N + SVAR(I) = 0 + 10 CONTINUE + VARS(0) = N + 1 + NEW(0) = -1 + FLAG(0) = 0 + NSUP = 0 + DO 40 J = 1,NELT + K1 = ELTPTR(J) + K2 = ELTPTR(J+1) - 1 + DO 20 K = K1,K2 + I = ELTVAR(K) + IF (I.LT.1 .OR. I.GT.N) THEN + INFO(2) = INFO(2) + 1 + GO TO 20 + END IF + IS = SVAR(I) + IF (IS.LT.0) THEN + ELTVAR(K) = 0 + INFO(3) = INFO(3) + 1 + GO TO 20 + END IF + SVAR(I) = SVAR(I) - N - 2 + VARS(IS) = VARS(IS) - 1 + 20 CONTINUE + DO 30 K = K1,K2 + I = ELTVAR(K) + IF (I.LT.1 .OR. I.GT.N) GO TO 30 + IS = SVAR(I) + N + 2 + IF (FLAG(IS).LT.J) THEN + FLAG(IS) = J + IF (VARS(IS).GT.0) THEN + NSUP = NSUP + 1 + IF (NSUP.GT.MAXSUP) THEN + INFO(1) = -4 + RETURN + END IF + VARS(NSUP) = 1 + FLAG(NSUP) = J + NEW(IS) = NSUP + SVAR(I) = NSUP + ELSE + VARS(IS) = 1 + NEW(IS) = IS + SVAR(I) = IS + END IF + ELSE + JS = NEW(IS) + VARS(JS) = VARS(JS) + 1 + SVAR(I) = JS + END IF + 30 CONTINUE + 40 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_316 + SUBROUTINE ZMUMPS_36( COMM_LOAD, ASS_IRECV, + & NELT, FRT_PTR, FRT_ELT, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, + & FILS, FRERE, DAD, MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER,PTRARW, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & + & NSTK_S,NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mpif.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER IZERO + PARAMETER (IZERO=0) + INTEGER NELT,N,LIW,NSTEPS + INTEGER(8) LA, LRLU, LRLUS, IPTRLU, POSFAC + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & IWPOS, IWPOSCB, COMP + INTEGER IDUMMY(1) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(NELT+1), PTRAIW(NELT+1), ND(KEEP(28)), PERM(N), + & FILS(N), FRERE(KEEP(28)), DAD(KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)), + & PAMASTER(KEEP(28)) + INTEGER COMM, NBFIN, SLAVEF, MYID + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + LOGICAL SON_LEVEL2 + COMPLEX(kind=8) A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER FRT_PTR(N+1), FRT_ELT(NELT) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + INTEGER LPOOL, LEAF + INTEGER LBUFR, LBUFR_BYTES + INTEGER IPOOL( LPOOL ) + INTEGER NBPROCFILS(KEEP(28)), NSTK_S(KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER BUFR( LBUFR ) + INTEGER ETATASS + INCLUDE 'mumps_headers.h' + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + INTEGER LP, HS, HF + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + INTEGER NFS4FATHER + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER(8) NFRONT8 + INTEGER(8) LAELL8, APOS, APOS2, LAPOS2 + INTEGER(8) POSELT, POSEL1, ICT12, ICT21 + INTEGER(8) IACHK + INTEGER(8) JJ2 + INTEGER(8) LSTK8, SIZFR8 +#if defined(ALLOW_NON_INIT) + INTEGER(8) :: JJ8 +#endif + INTEGER NBPANELS_L, NBPANELS_U, LREQ_OOC + INTEGER SIZFI, NCB + INTEGER JJ,J1,J2 + INTEGER NCOLS, NROWS, LDA_SON + INTEGER NELIM,JJ1,J3, + & IORG, IBROT + INTEGER JPOS,ICT11, IJROW + INTEGER Pos_First_NUMORG,NUMORG,IOLDPS, + & NUMELT, ELBEG + INTEGER AINPUT, + & AII, J + INTEGER NSLAVES, NSLSON, NPIVS, NPIV_ANA, NPIV + INTEGER PTRCOL, ISLAVE, PDEST,LEVEL + LOGICAL LEVEL1, NIV1 + INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX + INTEGER ELTI, SIZE_ELTI + INTEGER II, I + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER NCBSON + LOGICAL SAME_PROC + INTRINSIC real + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + LOGICAL MUMPS_167, SSARBR + EXTERNAL MUMPS_167 + DOUBLE PRECISION FLOP1,FLOP1_EFF + EXTERNAL MUMPS_170 + LOGICAL MUMPS_170 + NFS4FATHER = -1 + ETATASS = 0 + COMPRESSCB=.FALSE. + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + LEVEL = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (LEVEL.NE.1) THEN + write(6,*) 'Error1 in mpi51f_niv1 ' + CALL MUMPS_ABORT() + END IF + NSLAVES = 0 + HF = 6 + NSLAVES + KEEP(IXSZ) + NUMELT = FRT_PTR(INODE+1) - FRT_PTR(INODE) + IF ( NUMELT .ne. 0 ) THEN + ELBEG = FRT_PTR(INODE) + ELSE + ELBEG = 1 + END IF + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + END DO + NPIV_ANA=NUMORG + NSTEPS = NSTEPS + 1 + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + END DO + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + NASS1 = NASS + NUMORG + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL ZMUMPS_684(KEEP(50), NFRONT, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL ZMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + END IF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + END IF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + NIV1 = .TRUE. + IF (KEEP(50).EQ.0) THEN + CALL MUMPS_124( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, NFRONT, NFRONT_EFF, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, + & SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG ) + ELSE + CALL MUMPS_125( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, + & SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + IF (IFLAG.LT.0) GOTO 300 + END IF + IF (NFRONT_EFF.NE.NFRONT) THEN + IF (NFRONT.GT.NFRONT_EFF) THEN + IF(MUMPS_170(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF))THEN + NPIV=NASS1-(NFRONT_EFF-ND(STEP(INODE))) + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1) + NPIV=NPIV_ANA + CALL MUMPS_511(ND(STEP(INODE))+KEEP(253), + & NPIV,NPIV, + & KEEP(50),1,FLOP1_EFF) + CALL ZMUMPS_190(0,.FALSE.,FLOP1-FLOP1_EFF, + & KEEP,KEEP8) + ENDIF + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) ' ERROR 1 during ass_niv1_ELT' + GOTO 270 + ENDIF + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL ZMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + NCB = NFRONT - NASS1 + MAXFRW = max0(MAXFRW, NFRONT) + ICT11 = IOLDPS + HF - 1 + NFRONT + NFRONT8=int(NFRONT,8) + LAELL8 = NFRONT8*NFRONT8 + IF (LRLU .LT. LAELL8) THEN + IF (LRLUS .LT. LAELL8) THEN + GOTO 280 + ELSE + CALL ZMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + END IF + END IF + END IF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + POSFAC = POSFAC + LAELL8 + SSARBR=MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + CALL ZMUMPS_471(SSARBR,.FALSE.,LA-LRLUS,0_8,LAELL8, + & KEEP,KEEP8, + & LRLU) +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. NFRONT .LT. KEEP(63) ) THEN + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO + ELSE + APOS = POSELT + DO JJ8 = 0_8, int(NFRONT -1,8) + A(APOS:APOS+JJ8) = ZERO + APOS = APOS + NFRONT8 + END DO + END IF +#endif + NASS = NASS1 + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + IW(IOLDPS+KEEP(IXSZ)) = NFRONT + IW(IOLDPS+KEEP(IXSZ)+ 1) = 0 + IW(IOLDPS+KEEP(IXSZ) + 2) = -NASS1 + IW(IOLDPS+KEEP(IXSZ) + 3) = -NASS1 + IW(IOLDPS+KEEP(IXSZ) + 4) = STEP(INODE) + IW(IOLDPS+KEEP(IXSZ)+5) = NSLAVES + IF (NUMSTK.NE.0) THEN + ISON = IFSON + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + LSTK = IW(ISTCHK+KEEP(IXSZ)) + LSTK8 = int(LSTK,8) + NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB = + & ( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB = ( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + LEVEL1 = NSLSON.EQ.0 + IF (.NOT.SAME_PROC) THEN + NROWS = IW( ISTCHK + 2+KEEP(IXSZ)) + ELSE + NROWS = NCOLS + ENDIF + SIZFI = HS + NROWS + NCOLS + J1 = ISTCHK + HS + NROWS + NPIVS + IF ( .NOT. LEVEL1 .AND. NELIM.EQ.0 ) GOTO 205 + IF (LEVEL1) THEN + J2 = J1 + LSTK - 1 + IF (COMPRESSCB) THEN + SIZFR8 = (LSTK8*(LSTK8+1_8)/2_8) + ELSE + SIZFR8 = LSTK8*LSTK8 + ENDIF + ELSE + IF ( KEEP(50).eq.0 ) THEN + SIZFR8 = int(NELIM,8) * LSTK8 + ELSE + SIZFR8 = int(NELIM,8) * int(NELIM,8) + END IF + J2 = J1 + NELIM - 1 + ENDIF + OPASSW = OPASSW + dble(SIZFR8) + IACHK = PAMASTER(STEP(ISON)) + IF ( KEEP(50) .eq. 0 ) THEN + POSEL1 = PTRAST(STEP(INODE)) - NFRONT8 + IF (J2.GE.J1) THEN + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * NFRONT8 + DO 160 JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8)) + 160 CONTINUE + IACHK = IACHK + LSTK8 + 170 CONTINUE + END IF + ELSE + IF (LEVEL1) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = SIZFR8 + ELSE + LCB = int(LDA_SON,8)*int(J2 - J1 + 1,8) + ENDIF + CALL ZMUMPS_178(A, LA, + & PTRAST(STEP( INODE )), NFRONT, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), J2 - J1 + 1, NELIM, ETATASS, + & COMPRESSCB, + & .FALSE. + & ) + ENDIF + 205 IF (LEVEL1) THEN + IF (SAME_PROC) ISTCHK = PTRIST(STEP(ISON)) + IF (SAME_PROC) THEN + IF (KEEP(50).NE.0) THEN + J2 = J1 + LSTK - 1 + DO JJ = J1, J2 + IW(JJ) = IW(JJ - NROWS) + END DO + ELSE + J2 = J1 + LSTK - 1 + J3 = J1 + NELIM + DO JJ = J3, J2 + IW(JJ) = IW(JJ - NROWS) + END DO + IF (NELIM .NE. 0) THEN + J3 = J3 - 1 + DO JJ = J1, J3 + JPOS = IW(JJ) + ICT11 + IW(JJ) = IW(JPOS) + END DO + ENDIF + ENDIF + ENDIF + IF ( SAME_PROC ) THEN + PTRIST(STEP( ISON )) = -99999999 + ELSE + PIMASTER(STEP( ISON )) = -99999999 + ENDIF + CALL ZMUMPS_152(SSARBR, MYID, N, ISTCHK, + & IACHK, + & IW, LIW, LRLU, LRLUS, IPTRLU, + & IWPOSCB, LA, KEEP,KEEP8, .FALSE. + & ) + ELSE + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL ZMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, IDUMMY, + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, + & LEAF, NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + END DO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL ZMUMPS_71( INODE, NFRONT, + & NASS1, NFS4FATHER,ISON, MYID, + & IZERO, IDUMMY, IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, + & SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + 220 CONTINUE + END IF + DO IELL=ELBEG,ELBEG+NUMELT-1 + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + AII = PTRARW(ELTI) + SIZE_ELTI = J2 - J1 + 1 + DO II=J1,J2 + I = INTARR(II) + IF (KEEP(50).EQ.0) THEN + AINPUT = AII + II - J1 + ICT12 = POSELT + int(I-1,8) * NFRONT8 + DO JJ=J1,J2 + APOS2 = ICT12 + int(INTARR(JJ) - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + SIZE_ELTI + END DO + ELSE + ICT12 = POSELT + int(- NFRONT + I - 1,8) + ICT21 = POSELT + int(I-1,8)*NFRONT8 - 1_8 + DO JJ=II,J2 + J = INTARR(JJ) + IF (I.LT.J) THEN + APOS2 = ICT12 + int(J,8)*NFRONT8 + ELSE + APOS2 = ICT21 + int(J,8) + ENDIF + A(APOS2) = A(APOS2) + DBLARR(AII) + AII = AII + 1 + END DO + END IF + END DO + END DO + IF (KEEP(253).GT.0) THEN + POSELT = PTRAST(STEP(INODE)) + IBROT = INODE + IJROW = Pos_First_NUMORG + DO IORG = 1, NUMORG + IF (KEEP(50).EQ.0) THEN + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(IJROW-1,8) * NFRONT8 + + & int(NFRONT-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ELSE + DO JJ=1, KEEP(253) + APOS = POSELT+ + & int(NFRONT-KEEP(253)+JJ-1,8) * NFRONT8 + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + IJROW = IJROW+1 + ENDDO + ENDIF + GOTO 500 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE IN INTEGER ALLOCATION DURING ZMUMPS_36' + ENDIF + GOTO 490 + 280 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, WORKSPACE TOO SMALL DURING ZMUMPS_36' + ENDIF + IFLAG = -9 + CALL MUMPS_731(LAELL8-LRLUS, IERROR) + GOTO 500 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, SEND BUFFER TOO SMALL DURING ZMUMPS_36' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, RECV BUFFER TOO SMALL DURING ZMUMPS_36' + ENDIF + IFLAG = -20 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE IN INTEGER', + & ' DYNAMIC ALLOCATION DURING ZMUMPS_36' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 490 CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_36 + SUBROUTINE ZMUMPS_37( COMM_LOAD, ASS_IRECV, + & NELT, FRT_PTR, FRT_ELT, + & N, INODE, IW, LIW, A, LA, IFLAG, + & IERROR, ND, FILS, FRERE, DAD, + & CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, root, + & OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_S, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, LEAF, IPOOL, LPOOL, + & PERM, + & MEM_DISTRIB) + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER NELT, N,LIW,NSTEPS, NBFIN + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER(8) LRLU, IPTRLU, LRLUS, POSFAC, LA + INTEGER(8) LAELL8 + INTEGER JJ + INTEGER IFLAG,IERROR,INODE,MAXFRW, + & LPOOL, LEAF, + & IWPOS, + & IWPOSCB, COMP, SLAVEF + INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB + INTEGER IPOOL(LPOOL) + INTEGER IW(LIW), ITLOC(N+KEEP(253)), + & PTRARW(NELT+1), PTRAIW(NELT+1), ND(KEEP(28)), + & FILS(N), FRERE(KEEP(28)), STEP(N), DAD (KEEP(28)), + & PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), PERM(N) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER(8) :: PTRFAC(KEEP(28)), PAMASTER(KEEP(28)), + & PTRAST(KEEP(28)) + INTEGER CAND(SLAVEF+1,max(1,KEEP(56))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + COMPLEX(kind=8) A(LA) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER FRT_PTR(N+1), FRT_ELT(NELT) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + INTEGER MYID, COMM + INTEGER LBUFR, LBUFR_BYTES + INTEGER NBPROCFILS(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER BUFR( LBUFR ) + INCLUDE 'mumps_headers.h' + INTEGER LP, HS, HF, HF_OLD, NSLAVES_OLD,NCBSON + INTEGER NCBSON_MAX + INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL + LOGICAL COMPRESSCB + INTEGER(8) :: LCB + INTEGER NFS4FATHER + INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ + INTEGER LREQ_OOC, NBPANELS_L, NBPANELS_U + INTEGER NCB + INTEGER J1,J2 + INTEGER(8) NFRONT8, LAPOS2, POSELT, POSEL1, LDAFS8, + & JJ2, IACHK, ICT12, ICT21 +#if defined(ALLOW_NON_INIT) + INTEGER(8) :: JJ8 +#endif + INTEGER(8) APOS, APOS2 + INTEGER NELIM,LDAFS,JJ1,NPIVS,NCOLS,NROWS, + & IORG + INTEGER LDA_SON, IJROW, IBROT + INTEGER Pos_First_NUMORG,NBCOL,NUMORG,IOLDPS + INTEGER AINPUT + INTEGER NSLAVES, NSLSON + INTEGER NBLIG, PTRCOL, PTRROW, ISLAVE, PDEST + INTEGER ELTI, SIZE_ELTI + INTEGER II, ELBEG, NUMELT, I, J, AII + LOGICAL SAME_PROC, NIV1, SON_LEVEL2 + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX + logical :: force_cand + INTEGER(8) APOSMAX + DOUBLE PRECISION MAXARR + INTEGER INIV2, SIZE_TMP_SLAVES_LIST, allocok + INTEGER NUMORG_SPLIT, TYPESPLIT, + & NCB_SPLIT, SIZE_LIST_SPLIT, NBSPLIT + INTEGER, ALLOCATABLE, DIMENSION(:) :: TMP_SLAVES_LIST, COPY_CAND + INTEGER IZERO + INTEGER IDUMMY(1) + INTEGER PDEST1(1) + INTEGER ETATASS + PARAMETER( IZERO = 0 ) + INTEGER MUMPS_275, MUMPS_330, MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, MUMPS_810 + INTRINSIC real + COMPLEX(kind=8) ZERO + DOUBLE PRECISION RZERO + PARAMETER( RZERO = 0.0D0 ) + PARAMETER( ZERO = (0.0D0,0.0D0) ) + COMPRESSCB=.FALSE. + ETATASS = 0 + IN = INODE + NBPROCFILS(STEP(IN)) = 0 + NSTEPS = NSTEPS + 1 + NUMELT = FRT_PTR(INODE+1) - FRT_PTR(INODE) + IF ( NUMELT .NE. 0 ) THEN + ELBEG = FRT_PTR(INODE) + ELSE + ELBEG = 1 + END IF + NUMORG = 0 + DO WHILE (IN.GT.0) + NUMORG = NUMORG + 1 + IN = FILS(IN) + END DO + NUMSTK = 0 + NASS = 0 + IFSON = -IN + ISON = IFSON + NCBSON_MAX = 0 + DO WHILE (ISON .GT. 0) + NUMSTK = NUMSTK + 1 + IF ( KEEP(48)==5 .AND. + & MUMPS_330(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) .EQ. 1) THEN + NCBSON_MAX = + & max(NCBSON_MAX,IW(PIMASTER(STEP(ISON))+KEEP(IXSZ))) + END IF + NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ)) + ISON = FRERE(STEP(ISON)) + END DO + NFRONT = ND(STEP(INODE)) + NASS + KEEP(253) + MAXFRW = max0(MAXFRW, NFRONT) + NASS1 = NASS + NUMORG + NCB = NFRONT - NASS1 + IF((KEEP(24).eq.0).or.(KEEP(24).eq.1)) then + force_cand=.FALSE. + ELSE + force_cand=(mod(KEEP(24),2).eq.0) + end if + IF (force_cand) THEN + INIV2 = ISTEP_TO_INIV2( STEP( INODE )) + SIZE_TMP_SLAVES_LIST = CAND( SLAVEF+1, INIV2 ) + ELSE + INIV2 = 1 + SIZE_TMP_SLAVES_LIST = SLAVEF - 1 + ENDIF + ALLOCATE(TMP_SLAVES_LIST(SIZE_TMP_SLAVES_LIST),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + TYPESPLIT = MUMPS_810 (PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + IF ( (TYPESPLIT.EQ.4) + & .OR.(TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) + & ) THEN + IF (TYPESPLIT.EQ.4) THEN + ALLOCATE(COPY_CAND(SLAVEF+1),stat=allocok) + IF (allocok > 0 ) THEN + GOTO 265 + ENDIF + CALL ZMUMPS_791 ( + & INODE, STEP, N, SLAVEF, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & CAND(1,INIV2), ICNTL, COPY_CAND, + & NBSPLIT, NUMORG_SPLIT, TMP_SLAVES_LIST(1), + & SIZE_TMP_SLAVES_LIST + & ) + NCB_SPLIT = NCB-NUMORG_SPLIT + SIZE_LIST_SPLIT = SIZE_TMP_SLAVES_LIST - NBSPLIT + CALL ZMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, COPY_CAND, + & MEM_DISTRIB(0), NCB_SPLIT, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST(NBSPLIT+1), + & SIZE_LIST_SPLIT,INODE ) + DEALLOCATE (COPY_CAND) + CALL ZMUMPS_790 ( + & INODE, STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, + & TAB_POS_IN_PERE(1,INIV2), + & NSLAVES + & ) + ELSE + ISTCHK = PIMASTER(STEP(IFSON)) + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + TMP_SLAVES_LIST (1:SIZE_TMP_SLAVES_LIST) + & = CAND (1:SIZE_TMP_SLAVES_LIST, INIV2) + CALL ZMUMPS_792 ( + & INODE, TYPESPLIT, IFSON, + & IW(PDEST), NSLSON, + & STEP, N, SLAVEF, NBSPLIT, NCB, + & PROCNODE_STEPS, KEEP, DAD, FILS, + & ICNTL, ISTEP_TO_INIV2, INIV2, + & TAB_POS_IN_PERE, NSLAVES, + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST + & ) + ENDIF + ELSE + CALL ZMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8, + & ICNTL, CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, + & SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + LREQ_OOC = 0 + IF (KEEP(201).EQ.1) THEN + CALL ZMUMPS_684(KEEP(50), NASS1, NFRONT, NASS1, + & NBPANELS_L, NBPANELS_U, LREQ_OOC) + ENDIF + LREQ = HF + 2 * NFRONT + LREQ_OOC + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN + CALL ZMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 270 + ENDIF + IF ((IWPOS + LREQ -1) .GT. IWPOSCB) GOTO 270 + ENDIF + IOLDPS = IWPOS + IWPOS = IWPOS + LREQ + NIV1 = .FALSE. + IF (KEEP(50).EQ.0) THEN + CALL MUMPS_124( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, NFRONT,NFRONT_EFF, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + ELSE + CALL MUMPS_125( + & NUMELT, FRT_ELT(ELBEG), + & MYID, INODE, N, IOLDPS, HF, + & NFRONT, NFRONT_EFF, PERM, + & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, + & IFSON, STEP, PIMASTER, PTRAIW, NELT, IW, LIW, + & INTARR, KEEP(14), ITLOC, RHS_MUMPS, FILS, FRERE, + & KEEP, SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, + & DAD,PROCNODE_STEPS, SLAVEF, + & FRT_PTR, FRT_ELT, Pos_First_NUMORG) + IF (IFLAG.LT.0) GOTO 250 + ENDIF + IF ( NFRONT .NE. NFRONT_EFF ) THEN + IF ( + & (TYPESPLIT.EQ.5) .OR. (TYPESPLIT.EQ.6)) THEN + WRITE(6,*) ' SPLITTING NOT YET READY FOR THAT' + CALL MUMPS_ABORT() + ENDIF + IF (NFRONT.GT.NFRONT_EFF) THEN + NCB = NFRONT_EFF - NASS1 + NSLAVES_OLD = NSLAVES + HF_OLD = HF + IF (TYPESPLIT.EQ.4) THEN + WRITE(6,*) ' Internal error 2 in fac_ass_elt due', + & ' to plitting ', + & ' INODE, NFRONT, NFRONT_EFF =', INODE, NFRONT, NFRONT_EFF + CALL MUMPS_ABORT() + ELSE + CALL ZMUMPS_472( NCBSON_MAX, + & SLAVEF, KEEP,KEEP8,ICNTL, + & CAND(1,INIV2), + & MEM_DISTRIB(0), NCB, NFRONT_EFF, NSLAVES, + & TAB_POS_IN_PERE(1,INIV2), + & TMP_SLAVES_LIST, SIZE_TMP_SLAVES_LIST,INODE ) + ENDIF + HF = NSLAVES + 6 + KEEP(IXSZ) + IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) - + & (NSLAVES_OLD - NSLAVES) + IF (NSLAVES_OLD .NE. NSLAVES) THEN + IF (NSLAVES_OLD > NSLAVES) THEN + DO JJ=0,2*NFRONT_EFF-1 + IW(IOLDPS+HF+JJ)=IW(IOLDPS+HF_OLD+JJ) + ENDDO + ELSE + IF (IWPOS - 1 > IWPOSCB ) GOTO 270 + DO JJ=2*NFRONT_EFF-1, 0, -1 + IW(IOLDPS+HF+JJ) = IW(IOLDPS+HF_OLD+JJ) + ENDDO + END IF + END IF + NFRONT = NFRONT_EFF + LREQ = HF + 2 * NFRONT + LREQ_OOC + ELSE + Write(*,*) ' ERROR 2 during ass_niv2' + GOTO 270 + ENDIF + ENDIF + NFRONT8=int(NFRONT,8) + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL ZMUMPS_691(KEEP(50), + & NBPANELS_L, NBPANELS_U, NASS1, + & IOLDPS + HF + 2 * NFRONT, IW, LIW) + ENDIF + MAXFRW = max0(MAXFRW, NFRONT) + PTLUST_S(STEP(INODE)) = IOLDPS + IW(IOLDPS + 1+KEEP(IXSZ)) = 0 + IW(IOLDPS + 2+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 3+KEEP(IXSZ)) = -NASS1 + IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) + IW(IOLDPS+KEEP(IXSZ)) = NFRONT + IW(IOLDPS+5+KEEP(IXSZ)) = NSLAVES + IW(IOLDPS+6+KEEP(IXSZ):IOLDPS+5+NSLAVES+KEEP(IXSZ))= + & TMP_SLAVES_LIST(1:NSLAVES) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + IF (KEEP(73) .EQ. 0) THEN +#endif +#endif + CALL ZMUMPS_461(MYID, SLAVEF, COMM_LOAD, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP, KEEP8, IW(IOLDPS+6+KEEP(IXSZ)), NSLAVES,INODE) +#if defined(OLD_LOAD_MECHANISM) +#if ! defined (CHECK_COHERENCE) + ENDIF +#endif +#endif + IF(KEEP(86).EQ.1)THEN + IF(mod(KEEP(24),2).eq.0)THEN + CALL ZMUMPS_533(SLAVEF,CAND(SLAVEF+1,INIV2), + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE) + ELSEIF((KEEP(24).EQ.0).OR.(KEEP(24).EQ.1))THEN + CALL ZMUMPS_533(SLAVEF,SLAVEF-1, + & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))), + & NASS1, KEEP,KEEP8,TMP_SLAVES_LIST, NSLAVES,INODE) + ENDIF + ENDIF + DEALLOCATE(TMP_SLAVES_LIST) + IF (KEEP(50).EQ.0) THEN + LAELL8 = int(NASS1,8) * NFRONT8 + LDAFS = NFRONT + LDAFS8 = NFRONT8 + ELSE + LAELL8 = int(NASS1,8)*int(NASS1,8) + IF (KEEP(219).NE.0) THEN + IF(KEEP(50) .EQ. 2) LAELL8 = LAELL8+int(NASS1,8) + ENDIF + LDAFS = NASS1 + LDAFS8 = int(NASS1,8) + ENDIF + IF (LRLU .LT. LAELL8) THEN + IF (LRLUS .LT. LAELL8) THEN + GOTO 280 + ELSE + CALL ZMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + IF (LRLU .NE. LRLUS) THEN + WRITE( *, * ) 'PB compress ass..mpi51f_niv2' + WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS + GOTO 280 + ENDIF + ENDIF + ENDIF + LRLU = LRLU - LAELL8 + LRLUS = LRLUS - LAELL8 + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSELT = POSFAC + PTRAST(STEP(INODE)) = POSELT + PTRFAC(STEP(INODE)) = POSELT + POSFAC = POSFAC + LAELL8 + IW(IOLDPS+XXI) = LREQ + CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR)) + IW(IOLDPS+XXS) =-9999 + IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999 + CALL ZMUMPS_471(.FALSE.,.FALSE.,LA-LRLUS,0_8,LAELL8, + & KEEP,KEEP8, + &LRLU) + POSEL1 = POSELT - LDAFS8 +#if ! defined(ALLOW_NON_INIT) + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO +#else + IF ( KEEP(50) .eq. 0 .OR. LDAFS .lt. KEEP(63) ) THEN + LAPOS2 = POSELT + LAELL8 - 1_8 + A(POSELT:LAPOS2) = ZERO + ELSE + APOS = POSELT + DO JJ8 = 0_8, LDAFS8 - 1_8 + A(APOS:APOS+JJ8) = ZERO + APOS = APOS + LDAFS8 + END DO + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + A(APOS:APOS+LDAFS8-1_8)=ZERO + ENDIF + END IF +#endif + IF ((NUMSTK.NE.0).AND.(NASS.NE.0)) THEN + ISON = IFSON + DO 220 IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + KEEP(IXSZ) + 1) + IF (NELIM.EQ.0) GOTO 210 + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NPIVS = IW(ISTCHK + KEEP(IXSZ) + 3) + IF (NPIVS.LT.0) NPIVS=0 + NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5) + HS = 6 + KEEP(IXSZ) + NSLSON + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF ( SAME_PROC ) THEN + COMPRESSCB=( IW(PTRIST(STEP(ISON))+XXS) .EQ. S_CB1COMP ) + ELSE + COMPRESSCB=( IW(ISTCHK + XXS) .EQ. S_CB1COMP ) + ENDIF + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + KEEP(IXSZ) + 2) + ELSE + NROWS = NCOLS + ENDIF + OPASSW = OPASSW + dble(NELIM*LSTK) + J1 = ISTCHK + HS + NROWS + NPIVS + J2 = J1 + NELIM - 1 + IACHK = PAMASTER(STEP(ISON)) + IF (KEEP(50).eq.0) THEN + DO 170 JJ = J1, J2 + APOS = POSEL1 + int(IW(JJ),8) * LDAFS8 + DO 160 JJ1 = 1, LSTK + JJ2 = APOS + int(IW(J1 + JJ1 - 1),8) - 1_8 + A(JJ2) = A(JJ2) + A(IACHK + int(JJ1,8) - 1_8) + 160 CONTINUE + IACHK = IACHK + int(LSTK,8) + 170 CONTINUE + ELSE + IF (NSLSON.EQ.0) THEN + LDA_SON = LSTK + ELSE + LDA_SON = NELIM + ENDIF + IF (COMPRESSCB) THEN + LCB = (int(NELIM,8)*int(NELIM+1,8))/2_8 + ELSE + LCB = int(LDA_SON,8)*int(NELIM,8) + ENDIF + CALL ZMUMPS_178(A, LA, + & POSELT, LDAFS, NASS1, + & IACHK, LDA_SON, LCB, + & IW( J1 ), NELIM, NELIM, ETATASS, + & COMPRESSCB, + & .FALSE. + & ) + ENDIF + 210 ISON = FRERE(STEP(ISON)) + 220 CONTINUE + ENDIF + APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8) + IF (KEEP(219).NE.0) THEN + IF (KEEP(50).EQ.2) THEN + A( APOSMAX: APOSMAX+int(NASS1-1,8))=ZERO + ENDIF + ENDIF + DO IELL=ELBEG,ELBEG+NUMELT-1 + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + AII = PTRARW(ELTI) + SIZE_ELTI = J2 - J1 + 1 + DO II=J1,J2 + I = INTARR(II) + IF (KEEP(50).EQ.0) THEN + IF (I.LE.NASS1) THEN + AINPUT = AII + II - J1 + ICT12 = POSELT + int(I-1,8) * LDAFS8 + DO JJ=J1,J2 + APOS2 = ICT12 + int(INTARR(JJ) - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + SIZE_ELTI + END DO + ENDIF + ELSE + ICT12 = POSELT - LDAFS8 + int(I,8) - 1_8 + ICT21 = POSELT + int(I-1,8)*LDAFS8 - 1_8 + IF ( I .GT. NASS1 ) THEN + IF (KEEP(219).NE.0) THEN + IF (KEEP(50).EQ.2) THEN + AINPUT=AII + DO JJ=II,J2 + J=INTARR(JJ) + IF (J.LE.NASS1) THEN + A(APOSMAX+int(J-1,8))=cmplx( + & max(dble(A(APOSMAX+int(J-1,8))), + & abs(DBLARR(AINPUT))), + & kind=kind(A) + & ) + ENDIF + AINPUT=AINPUT+1 + ENDDO + ELSE + AII = AII + J2 - II + 1 + CYCLE + ENDIF + ELSE + AII = AII + J2 - II + 1 + CYCLE + ENDIF + ELSE + IF (KEEP(219).NE.0) THEN + MAXARR = RZERO + ENDIF + DO JJ=II,J2 + J = INTARR(JJ) + IF ( J .LE. NASS1) THEN + IF (I.LT.J) THEN + APOS2 = ICT12 + int(J,8)*LDAFS8 + ELSE + APOS2 = ICT21 + int(J,8) + ENDIF + A(APOS2) = A(APOS2) + DBLARR(AII) + ELSE IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + MAXARR = max(MAXARR,abs(DBLARR(AII))) + ENDIF + AII = AII + 1 + END DO + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN + A(APOSMAX+int(I-1,8)) = cmplx( + & max( MAXARR, dble(A(APOSMAX+int(I-1,8)))), + & kind=kind(A) + & ) + ENDIF + ENDIF + END IF + END DO + END DO + IF (KEEP(253).GT.0) THEN + POSELT = PTRAST(STEP(INODE)) + IBROT = INODE + IJROW = Pos_First_NUMORG + DO IORG = 1, NUMORG + IF (KEEP(50).EQ.0) THEN + DO JJ = 1, KEEP(253) + APOS = POSELT + + & int(IJROW-1,8) * int(LDAFS,8) + + & int(LDAFS-KEEP(253)+JJ-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( (JJ-1) * KEEP(254) + IBROT ) + ENDDO + ENDIF + IBROT = FILS(IBROT) + IJROW = IJROW+1 + ENDDO + ENDIF + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + PDEST = IOLDPS + 6 + KEEP(IXSZ) + DO ISLAVE = 1, NSLAVES + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB, + & NSLAVES, + & NBLIG, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + IERR = -1 + DO WHILE (IERR .EQ.-1) + IF ( KEEP(50) .eq. 0 ) THEN + NBCOL = NFRONT + CALL ZMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & IZERO, IDUMMY, + & IW(PDEST), NFRONT, COMM, IERR) + ELSE + NBCOL = NASS1+SHIFT_INDEX+NBLIG + CALL ZMUMPS_68( INODE, + & NBPROCFILS(STEP(INODE)), + & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1, + & NSLAVES-ISLAVE, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE), + & IW(PDEST), NFRONT, COMM, IERR) + ENDIF + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.) + IF ( IFLAG .LT. 0 ) GOTO 500 + IF (MESSAGE_RECEIVED) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + PTRCOL = IOLDPS + HF + NFRONT + PTRROW = IOLDPS + HF + NASS1 + SHIFT_INDEX + ENDIF + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 300 + IF (IERR .EQ. -3) GOTO 305 + PTRROW = PTRROW + NBLIG + PDEST = PDEST + 1 + END DO + IF (NUMSTK.EQ.0) GOTO 500 + ISON = IFSON + DO IELL = 1, NUMSTK + ISTCHK = PIMASTER(STEP(ISON)) + NELIM = IW(ISTCHK + 1 + KEEP(IXSZ)) + LSTK = IW(ISTCHK + KEEP(IXSZ)) + NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ)) + IF ( NPIVS .LT. 0 ) NPIVS = 0 + NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ)) + HS = 6 + NSLSON + KEEP(IXSZ) + NCOLS = NPIVS + LSTK + SAME_PROC = (ISTCHK.LE.IWPOS) + IF (.NOT.SAME_PROC) THEN + NROWS = IW(ISTCHK + 2 + KEEP(IXSZ) ) + ELSE + NROWS = NCOLS + ENDIF + PDEST = ISTCHK + 6 + KEEP(IXSZ) + NCBSON = LSTK - NELIM + PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + NFS4FATHER = NCBSON + DO I=0,NCBSON-1 + IF(IW(PTRCOL+I) .GT. NASS1) THEN + NFS4FATHER = I + EXIT + ENDIF + ENDDO + NFS4FATHER=NFS4FATHER + NELIM + ELSE + NFS4FATHER = 0 + ENDIF + IF (NSLSON.EQ.0) THEN + NSLSON = 1 + PDEST1(1) = MUMPS_275(PROCNODE_STEPS(STEP(ISON)), + & SLAVEF) + IF (PDEST1(1).EQ.MYID) THEN + CALL ZMUMPS_211( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)), + & NFRONT, NASS1, NFS4FATHER,NCBSON, IW( PTRCOL ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, NELT+1, NELT, + & FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ELSE + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + CALL ZMUMPS_71( + & INODE, NFRONT,NASS1,NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)), + & IW(PTRCOL), NCBSON, + & COMM, IERR, PDEST1, NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ELSE + DO ISLAVE = 0, NSLSON-1 + IF (IW(PDEST+ISLAVE).EQ.MYID) THEN + CALL MUMPS_49( + & KEEP,KEEP8, ISON, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE+1, NCBSON, + & NSLSON, + & TROW_SIZE, FIRST_INDEX ) + SHIFT_INDEX = FIRST_INDEX - 1 + INDX = PTRCOL + SHIFT_INDEX + CALL ZMUMPS_210( COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, LBUFR_BYTES, + & INODE, ISON, NSLAVES, + & IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & NFRONT, NASS1,NFS4FATHER, + & TROW_SIZE, IW( INDX ), + & PROCNODE_STEPS, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, N, IW, + & LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF, + & NBFIN, ICNTL, KEEP,KEEP8, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( IFLAG .LT. 0 ) GOTO 500 + EXIT + ENDIF + END DO + IF (PIMASTER(STEP(ISON)).GT.0) THEN + IERR = -1 + DO WHILE (IERR.EQ.-1) + PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM + PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ) + CALL ZMUMPS_71( + & INODE, NFRONT, NASS1, NFS4FATHER, + & ISON, MYID, + & NSLAVES, IW(PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)), + & IW(PTRCOL), NCBSON, + & COMM, IERR, IW(PDEST), NSLSON, SLAVEF, + & KEEP,KEEP8, STEP, N, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & NELT+1, NELT, FRT_PTR, FRT_ELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + END DO + IF (IERR .EQ. -2) GOTO 290 + IF (IERR .EQ. -3) GOTO 295 + ENDIF + ENDIF + ISON = FRERE(STEP(ISON)) + END DO + GOTO 500 + 250 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE IN INTEGER', + & ' DYNAMIC ALLOCATION during assembly' + ENDIF + IFLAG = -13 + IERROR = NUMSTK + 1 + GOTO 490 + 265 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) ' FAILURE ALLOCATING TMP_SLAVES_LIST', + & ' DYNAMIC ALLOCATION during assembly' + ENDIF + IFLAG = -13 + IERROR = SIZE_TMP_SLAVES_LIST + GOTO 490 + 270 CONTINUE + IFLAG = -8 + IERROR = LREQ + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE IN INTEGER ALLOCATION DURING ZMUMPS_37' + ENDIF + GOTO 490 + 280 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + & ' FAILURE, WORKSPACE TOO SMALL DURING ZMUMPS_37' + ENDIF + IFLAG = -9 + CALL MUMPS_731(LAELL8 - LRLUS, IERROR) + GOTO 490 + 290 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SEND BUFFER TOO SMALL (1) DURING ZMUMPS_37' + ENDIF + IFLAG = -17 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 295 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECV BUFFER TOO SMALL (1) DURING ZMUMPS_37' + ENDIF + IFLAG = -20 + LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 300 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, SENDBUFFER TOO SMALL (2) DURING ZMUMPS_37' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 305 CONTINUE + IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN + LP = ICNTL(1) + WRITE( LP, * ) + &' FAILURE, RECVBUFFER TOO SMALL (2) DURING ZMUMPS_37' + ENDIF + IFLAG = -17 + LREQ = NBLIG + NBCOL + 4+KEEP(IXSZ) + IERROR = LREQ * KEEP( 34 ) + GOTO 490 + 490 CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_37 + SUBROUTINE ZMUMPS_123( + & NELT, FRT_PTR, FRT_ELT, + & N, INODE, IW, LIW, A, LA, + & NBROWS, NBCOLS, + & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, + & RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP, KEEP8, MYID) + IMPLICIT NONE + INTEGER NELT, N,LIW + INTEGER(8) :: LA + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER INODE, MYID + INTEGER NBROWS, NBCOLS + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER IW(LIW), ITLOC(N + KEEP(253)), STEP(N), + & PTRIST(KEEP(28)), + & FILS(N), PTRARW(NELT+1), + & PTRAIW(NELT+1) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER FRT_PTR(N+1), FRT_ELT(NELT) + COMPLEX(kind=8) A(LA), + & DBLARR(max(1,KEEP(13))) + DOUBLE PRECISION OPASSW, OPELIW + INTEGER(8) :: POSELT, APOS2, ICT12, APOS + INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, + & K1,K2,K,I,J,JPOS,NASS,JJ, + & IN,AINPUT,J1,J2,IJROW,ILOC, + & ELBEG, NUMELT, ELTI, SIZE_ELTI, IPOS, + & IPOS1, IPOS2, AII, II, IELL + INTEGER :: K1RHS, K2RHS, JFirstRHS + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INCLUDE 'mumps_headers.h' + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + NBCOLF = IW(IOLDPS+KEEP(IXSZ)) + NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) + NASS = IW(IOLDPS+1+KEEP(IXSZ)) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + HF = 6 + NSLAVES+KEEP(IXSZ) + IF (NASS.LT.0) THEN + NASS = -NASS + IW(IOLDPS+1+KEEP(IXSZ)) = NASS + A(POSELT:POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8) = + & ZERO + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -JPOS + JPOS = JPOS + 1 + END DO + K1 = IOLDPS + HF + K2 = K1 + NBROWF - 1 + JPOS = 1 + IF ((KEEP(253).GT.0).AND.(KEEP(50).NE.0)) THEN + K1RHS = 0 + K2RHS = -1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -ITLOC(J)*NBCOLF + JPOS + IF ((K1RHS.EQ.0).AND.(J.GT.N)) THEN + K1RHS = K + JFirstRHS=J-N + ENDIF + JPOS = JPOS + 1 + ENDDO + IF (K1RHS.GT.0) K2RHS=K2 + IF ( K2RHS.GE.K1RHS ) THEN + IN = INODE + DO WHILE (IN.GT.0) + IJROW = -ITLOC(IN) + DO K = K1RHS, K2RHS + J = IW(K) + I = ITLOC(J) + ILOC = mod(I,NBCOLF) + APOS = POSELT+int(ILOC-1,8)*int(NBCOLF,8) + + & int(IJROW-1,8) + A(APOS) = A(APOS) + RHS_MUMPS( + & (JFirstRHS+(K-K1RHS)-1)*KEEP(254)+ IN) + ENDDO + IN = FILS(IN) + ENDDO + ENDIF + ELSE + DO K = K1, K2 + J = IW(K) + ITLOC(J) = -ITLOC(J)*NBCOLF + JPOS + JPOS = JPOS + 1 + END DO + ENDIF + ELBEG = FRT_PTR(INODE) + NUMELT = FRT_PTR(INODE+1) - ELBEG + DO IELL=ELBEG,ELBEG+NUMELT-1 + ELTI = FRT_ELT(IELL) + J1= PTRAIW(ELTI) + J2= PTRAIW(ELTI+1)-1 + AII = PTRARW(ELTI) + SIZE_ELTI = J2 - J1 + 1 + DO II=J1,J2 + I = ITLOC(INTARR(II)) + IF (KEEP(50).EQ.0) THEN + IF (I.LE.0) CYCLE + AINPUT = AII + II - J1 + IPOS = mod(I,NBCOLF) + ICT12 = POSELT + int(IPOS-1,8) * int(NBCOLF,8) + DO JJ = J1, J2 + JPOS = ITLOC(INTARR(JJ)) + IF (JPOS.LE.0) THEN + JPOS = -JPOS + ELSE + JPOS = JPOS/NBCOLF + END IF + APOS2 = ICT12 + int(JPOS - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AINPUT) + AINPUT = AINPUT + SIZE_ELTI + END DO + ELSE + IF ( I .EQ. 0 ) THEN + AII = AII + J2 - II + 1 + CYCLE + ENDIF + IF ( I .LE. 0 ) THEN + IPOS1 = -I + IPOS2 = 0 + ELSE + IPOS1 = I/NBCOLF + IPOS2 = mod(I,NBCOLF) + END IF + ICT12 = POSELT + int(IPOS2-1,8)*int(NBCOLF,8) + DO JJ=II,J2 + AII = AII + 1 + J = ITLOC(INTARR(JJ)) + IF ( J .EQ. 0 ) CYCLE + IF ( IPOS2.EQ.0 .AND. J.LE.0) CYCLE + IF ( J .LE. 0 ) THEN + JPOS = -J + ELSE + JPOS = J/NBCOLF + END IF + IF ( (IPOS1.GE.JPOS) .AND. (IPOS2.GT.0) ) THEN + APOS2 = ICT12 + int(JPOS - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AII-1) + END IF + IF ( (IPOS1.LT.JPOS) .AND. (J.GT.0) ) THEN + IPOS = mod(J,NBCOLF) + JPOS = IPOS1 + APOS2 = POSELT + int(IPOS-1,8)*int(NBCOLF,8) + & + int(JPOS - 1,8) + A(APOS2) = A(APOS2) + DBLARR(AII-1) + END IF + END DO + END IF + END DO + END DO + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = 0 + END DO + END IF + IF (NBROWS.GT.0) THEN + K1 = IOLDPS + HF + NBROWF + K2 = K1 + NBCOLF - 1 + JPOS = 1 + DO K = K1, K2 + J = IW(K) + ITLOC(J) = JPOS + JPOS = JPOS + 1 + END DO + END IF + RETURN + END SUBROUTINE ZMUMPS_123 + SUBROUTINE ZMUMPS_126( + & N, NELT, NA_ELT, + & COMM, MYID, SLAVEF, + & IELPTR_LOC, RELPTR_LOC, + & ELTVAR_LOC, ELTVAL_LOC, + & KEEP,KEEP8, MAXELT_SIZE, + & FRTPTR, FRTELT, A, LA, FILS, + & id, root ) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N, NELT, NA_ELT + INTEGER COMM, MYID, SLAVEF, MAXELT_SIZE, MSGLEN + INTEGER(8), intent(IN) :: LA + INTEGER FRTPTR( N+1 ) + INTEGER FRTELT( NELT ), FILS ( N ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IELPTR_LOC( NELT + 1 ), RELPTR_LOC( NELT + 1 ) + INTEGER ELTVAR_LOC( max(1,KEEP(14)) ) + COMPLEX(kind=8) ELTVAL_LOC( max(1,KEEP(13)) ) + COMPLEX(kind=8) A( LA ) + TYPE(ZMUMPS_STRUC) :: id + TYPE(ZMUMPS_ROOT_STRUC) :: root + INTEGER numroc + EXTERNAL numroc + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR_MPI + INTEGER MSGTAG + INTEGER allocok + INTEGER I, DEST, MAXELT_REAL_SIZE, MPG, IEL, SIZEI, SIZER + INTEGER NBRECORDS, NBUF + INTEGER RECV_IELTPTR, RECV_RELTPTR + INTEGER IELTPTR, RELTPTR, INODE + LOGICAL FINI, PROKG, I_AM_SLAVE + INTEGER(8) :: PTR_ROOT + INTEGER LOCAL_M, LOCAL_N, LP, IBEG, IGLOB, JGLOB + INTEGER ARROW_ROOT + INTEGER IELT, J, K, NB_REC, IREC + INTEGER ILOCROOT, JLOCROOT, IPOSROOT, JPOSROOT, IPTR + INTEGER JCOL_GRID, IROW_GRID + INTEGER IVALPTR + INTEGER NBELROOT + INTEGER MASTER + PARAMETER( MASTER = 0 ) + COMPLEX(kind=8) VAL + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INTEGER, DIMENSION( :, : ), ALLOCATABLE :: BUFI + COMPLEX(kind=8), DIMENSION( :, : ), ALLOCATABLE :: BUFR + COMPLEX(kind=8), DIMENSION( : ), ALLOCATABLE :: TEMP_ELT_R + INTEGER, DIMENSION( : ), ALLOCATABLE :: TEMP_ELT_I + INTEGER, DIMENSION( : ), ALLOCATABLE :: ELROOTPOS + INTEGER, DIMENSION( : ), ALLOCATABLE, TARGET :: RG2LALLOC + INTEGER, DIMENSION( : ), POINTER :: RG2L + MPG = id%ICNTL(3) + LP = id%ICNTL(1) + I_AM_SLAVE = ( KEEP(46) .eq. 1 .or. MYID .ne.MASTER ) + PROKG = ( MPG > 0 .and. MYID .eq. MASTER ) + KEEP(49) = 0 + ARROW_ROOT = 0 + IF ( MYID .eq. MASTER ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + NBUF = SLAVEF + ELSE + NBUF = SLAVEF - 1 + END IF + NBRECORDS = min(KEEP(39),NA_ELT) + IF ( KEEP(50) .eq. 0 ) THEN + MAXELT_REAL_SIZE = MAXELT_SIZE * MAXELT_SIZE + ELSE + MAXELT_REAL_SIZE = MAXELT_SIZE * (MAXELT_SIZE+1)/2 + END IF + IF ( MAXELT_REAL_SIZE .GT. KEEP(39) ) THEN + NBRECORDS = MAXELT_REAL_SIZE + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,*) + & ' ** Warning : For element distrib NBRECORDS set to ', + & MAXELT_REAL_SIZE,' because one element is large' + END IF + END IF + ALLOCATE( BUFI( 2*NBRECORDS+1, NBUF ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 2*NBRECORDS + 1 + GOTO 100 + END IF + ALLOCATE( BUFR( NBRECORDS+1, NBUF ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBRECORDS + 1 + GOTO 100 + END IF + IF ( KEEP(52) .ne. 0 ) THEN + ALLOCATE( TEMP_ELT_R( MAXELT_REAL_SIZE ), stat =allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = MAXELT_REAL_SIZE + GOTO 100 + END IF + END IF + ALLOCATE( TEMP_ELT_I( MAXELT_SIZE ), stat=allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = MAXELT_SIZE + GOTO 100 + END IF + IF ( KEEP(38) .ne. 0 ) THEN + NBELROOT = FRTPTR(KEEP(38)+1)-FRTPTR(KEEP(38)) + ALLOCATE( ELROOTPOS( max(NBELROOT,1) ), + & stat = allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBELROOT + GOTO 100 + END IF + IF (KEEP(46) .eq. 0 ) THEN + ALLOCATE( RG2LALLOC( N ), stat = allocok ) + IF ( allocok .gt. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = N + GOTO 100 + END IF + INODE = KEEP(38) + I = 1 + DO WHILE ( INODE .GT. 0 ) + RG2LALLOC( INODE ) = I + INODE = FILS( INODE ) + I = I + 1 + END DO + RG2L => RG2LALLOC + ELSE + RG2L => root%RG2L_ROW + END IF + END IF + DO I = 1, NBUF + BUFI( 1, I ) = 0 + BUFR( 1, I ) = ZERO + END DO + END IF + 100 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), COMM, MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + CALL MPI_BCAST( NBRECORDS, 1, MPI_INTEGER, MASTER, + & COMM, IERR_MPI ) + RECV_IELTPTR = 1 + RECV_RELTPTR = 1 + IF ( MYID .eq. MASTER ) THEN + NBELROOT = 0 + RELTPTR = 1 + RELPTR_LOC(1) = 1 + DO IEL = 1, NELT + IELTPTR = id%ELTPTR( IEL ) + SIZEI = id%ELTPTR( IEL + 1 ) - IELTPTR + IF ( KEEP( 50 ) .eq. 0 ) THEN + SIZER = SIZEI * SIZEI + ELSE + SIZER = SIZEI * ( SIZEI + 1 ) / 2 + END IF + DEST = id%ELTPROC( IEL ) + IF ( DEST .eq. -2 ) THEN + NBELROOT = NBELROOT + 1 + FRTELT( FRTPTR(KEEP(38)) + NBELROOT - 1 ) = IEL + ELROOTPOS( NBELROOT ) = RELTPTR + GOTO 200 + END IF + IF ( DEST .ge. 0 .and. KEEP(46) .eq. 0 ) DEST = DEST + 1 + IF ( KEEP(52) .ne. 0 ) THEN + CALL ZMUMPS_288( N, SIZEI, SIZER, + & id%ELTVAR( IELTPTR ), id%A_ELT( RELTPTR ), + & TEMP_ELT_R(1), MAXELT_REAL_SIZE, + & id%ROWSCA(1), id%COLSCA(1), KEEP(50) ) + END IF + IF ( DEST .eq. 0 .or. ( DEST .eq. -1 .and. KEEP(46) .ne. 0 ) ) + & THEN + ELTVAR_LOC( RECV_IELTPTR: RECV_IELTPTR + SIZEI - 1 ) + & = id%ELTVAR( IELTPTR: IELTPTR + SIZEI - 1 ) + RECV_IELTPTR = RECV_IELTPTR + SIZEI + IF ( KEEP(52) .ne. 0 ) THEN + ELTVAL_LOC( RECV_RELTPTR: RECV_RELTPTR + SIZER - 1) + & = TEMP_ELT_R( 1: SIZER ) + RECV_RELTPTR = RECV_RELTPTR + SIZER + END IF + END IF + IF ( DEST .NE. 0 .AND. DEST. NE. -3 ) THEN + IF ( KEEP(52) .eq. 0 ) THEN + CALL ZMUMPS_127( + & id%ELTVAR(IELTPTR), + & id%A_ELT (RELTPTR), + & SIZEI, SIZER, + & + & DEST, NBUF, NBRECORDS, + & BUFI, BUFR, COMM ) + ELSE + CALL ZMUMPS_127( + & id%ELTVAR(IELTPTR), + & TEMP_ELT_R( 1 ), + & SIZEI, SIZER, + & + & DEST, NBUF, NBRECORDS, + & BUFI, BUFR, COMM ) + END IF + END IF + 200 CONTINUE + RELTPTR = RELTPTR + SIZER + IF ( KEEP(46) .eq. 0 .OR. KEEP(52) .eq. 0 ) THEN + RELPTR_LOC( IEL + 1 ) = RELTPTR + ELSE + RELPTR_LOC( IEL + 1 ) = RECV_RELTPTR + ENDIF + END DO + IF ( KEEP(46) .eq. 0 .OR. KEEP(52) .eq. 0 ) THEN + KEEP(13) = RELTPTR - 1 + ELSE + KEEP(13) = RECV_RELTPTR - 1 + ENDIF + IF ( RELTPTR - 1 .ne. id%NA_ELT ) THEN + WRITE(*,*) ' ** ERROR ELT DIST: RELPTR - 1 / id%NA_ELT=', + & RELTPTR - 1,id%NA_ELT + CALL MUMPS_ABORT() + END IF + DEST = -2 + IELTPTR = 1 + RELTPTR = 1 + SIZEI = 1 + SIZER = 1 + CALL ZMUMPS_127( + & id%ELTVAR(IELTPTR), + & id%A_ELT (RELTPTR), + & SIZEI, SIZER, + & + & DEST, NBUF, NBRECORDS, + & BUFI, BUFR, COMM ) + IF ( KEEP(52) .NE. 0 ) DEALLOCATE( TEMP_ELT_R ) + ELSE + FINI = ( RECV_IELTPTR .eq. IELPTR_LOC( NELT+1 ) + & .and. RECV_RELTPTR .eq. RELPTR_LOC( NELT+1 ) ) + DO WHILE ( .not. FINI ) + CALL MPI_PROBE( MASTER, MPI_ANY_TAG, + & COMM, STATUS, IERR_MPI ) + MSGTAG = STATUS( MPI_TAG ) + SELECT CASE ( MSGTAG ) + CASE( ELT_INT ) + CALL MPI_GET_COUNT( STATUS, MPI_INTEGER, + & MSGLEN, IERR_MPI ) + CALL MPI_RECV( ELTVAR_LOC( RECV_IELTPTR ), MSGLEN, + & MPI_INTEGER, MASTER, ELT_INT, + & COMM, STATUS, IERR_MPI ) + RECV_IELTPTR = RECV_IELTPTR + MSGLEN + CASE( ELT_REAL ) + CALL MPI_GET_COUNT( STATUS, MPI_DOUBLE_COMPLEX, + & MSGLEN, IERR_MPI ) + CALL MPI_RECV( ELTVAL_LOC( RECV_RELTPTR ), MSGLEN, + & MPI_DOUBLE_COMPLEX, MASTER, ELT_REAL, + & COMM, STATUS, IERR_MPI ) + RECV_RELTPTR = RECV_RELTPTR + MSGLEN + END SELECT + FINI = ( RECV_IELTPTR .eq. IELPTR_LOC( NELT+1 ) + & .and. RECV_RELTPTR .eq. RELPTR_LOC( NELT+1 ) ) + END DO + END IF + IF ( KEEP(38) .NE. 0 ) THEN + IF ( I_AM_SLAVE .and. root%yes ) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I = 1, root%SCHUR_NLOC + root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1: + & (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC)=ZERO + ENDDO + ENDIF + END IF + IF ( MYID .NE. MASTER ) THEN + ALLOCATE( BUFI( NBRECORDS * 2 + 1, 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBRECORDS * 2 + 1 + GOTO 250 + END IF + ALLOCATE( BUFR( NBRECORDS, 1 ) , stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = NBRECORDS + END IF + END IF + 250 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), COMM, MYID ) + IF ( id%INFO(1) .LT. 0 ) RETURN + IF ( MYID .eq. MASTER ) THEN + DO IPTR = FRTPTR(KEEP(38)), FRTPTR(KEEP(38)+1) - 1 + IELT = FRTELT( IPTR ) + SIZEI = id%ELTPTR( IELT + 1 ) - id%ELTPTR( IELT ) + DO I = 1, SIZEI + TEMP_ELT_I( I ) = RG2L + & ( id%ELTVAR( id%ELTPTR(IELT) + I - 1 ) ) + END DO + IVALPTR = ELROOTPOS( IPTR - FRTPTR(KEEP(38)) + 1 ) - 1 + K = 1 + DO J = 1, SIZEI + JGLOB = id%ELTVAR( id%ELTPTR( IELT ) + J - 1 ) + IF ( KEEP(50).eq. 0 ) THEN + IBEG = 1 + ELSE + IBEG = J + END IF + DO I = IBEG, SIZEI + IGLOB = id%ELTVAR( id%ELTPTR( IELT ) + I - 1 ) + IF ( KEEP(52) .eq. 0 ) THEN + VAL = id%A_ELT( IVALPTR + K ) + ELSE + VAL = id%A_ELT( IVALPTR + K ) * + & id%ROWSCA( IGLOB ) * id%COLSCA( JGLOB ) + END IF + IF ( KEEP(50).eq.0 ) THEN + IPOSROOT = TEMP_ELT_I( I ) + JPOSROOT = TEMP_ELT_I( J ) + ELSE + IF ( TEMP_ELT_I(I) .GT. TEMP_ELT_I(J) ) THEN + IPOSROOT = TEMP_ELT_I(I) + JPOSROOT = TEMP_ELT_I(J) + ELSE + IPOSROOT = TEMP_ELT_I(J) + JPOSROOT = TEMP_ELT_I(I) + END IF + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, + & root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, + & root%NPCOL ) + IF ( KEEP(46) .eq. 0 ) THEN + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + 1 + ELSE + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + END IF + IF ( DEST .eq. MASTER ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & = A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & + VAL + ENDIF + ELSE + CALL ZMUMPS_34( + & IPOSROOT, JPOSROOT, VAL, DEST, BUFI, BUFR, NBRECORDS, + & NBUF, LP, COMM, KEEP(46) ) + END IF + K = K + 1 + END DO + END DO + END DO + CALL ZMUMPS_18( + & BUFI, BUFR, NBRECORDS, + & NBUF, LP, COMM, KEEP(46) ) + ELSE + FINI = .FALSE. + DO WHILE ( .not. FINI ) + CALL MPI_RECV( BUFI(1,1), 2*NBRECORDS+1, + & MPI_INTEGER, MASTER, + & ARROWHEAD, + & COMM, STATUS, IERR_MPI ) + NB_REC = BUFI(1,1) + IF (NB_REC.LE.0) THEN + FINI = .TRUE. + NB_REC = -NB_REC + ENDIF + IF (NB_REC.EQ.0) EXIT + CALL MPI_RECV( BUFR(1,1), NBRECORDS, MPI_DOUBLE_COMPLEX, + & MASTER, ARROWHEAD, + & COMM, STATUS, IERR_MPI ) + ARROW_ROOT = ARROW_ROOT + NB_REC + DO IREC = 1, NB_REC + IPOSROOT = BUFI( IREC * 2, 1 ) + JPOSROOT = BUFI( IREC * 2 + 1, 1 ) + VAL = BUFR( IREC, 1 ) + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60).eq.0) THEN + A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8) + & + int(ILOCROOT-1,8)) + & = A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8) + & + int(ILOCROOT-1,8)) + & + VAL + ELSE + root%SCHUR_POINTER(int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + END DO + END DO + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + END IF + END IF + IF ( MYID .eq. MASTER ) THEN + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + IF (KEEP(38).ne.0) THEN + DEALLOCATE(ELROOTPOS) + IF (KEEP(46) .eq. 0 ) THEN + DEALLOCATE(RG2LALLOC) + ENDIF + ENDIF + DEALLOCATE( TEMP_ELT_I ) + END IF + KEEP(49) = ARROW_ROOT + RETURN + END SUBROUTINE ZMUMPS_126 + SUBROUTINE ZMUMPS_127( + & ELNODES, ELVAL, SIZEI, SIZER, + & DEST, NBUF, NBRECORDS, BUFI, BUFR, COMM ) + IMPLICIT NONE + INTEGER SIZEI, SIZER, DEST, NBUF, NBRECORDS, COMM + INTEGER ELNODES( SIZEI ), BUFI( 2*NBRECORDS + 1, NBUF ) + COMPLEX(kind=8) ELVAL( SIZER ), BUFR( NBRECORDS + 1, NBUF ) + INCLUDE 'mumps_tags.h' + INCLUDE 'mpif.h' + INTEGER I, IBEG, IEND, IERR_MPI, NBRECR + INTEGER NBRECI + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + IF ( DEST .lt. 0 ) THEN + IBEG = 1 + IEND = NBUF + ELSE + IBEG = DEST + IEND = DEST + END IF + DO I = IBEG, IEND + NBRECI = BUFI(1,I) + IF ( NBRECI .ne.0 .and. + & ( DEST.eq.-2 .or. + & NBRECI + SIZEI .GT. 2*NBRECORDS ) ) THEN + CALL MPI_SEND( BUFI(2, I), NBRECI, MPI_INTEGER, + & I, ELT_INT, COMM, IERR_MPI ) + BUFI(1,I) = 0 + NBRECI = 0 + END IF + NBRECR = int(dble(BUFR(1,I))+0.5D0) + IF ( NBRECR .ne.0 .and. + & ( DEST.eq.-2 .or. + & NBRECR + SIZER .GT. NBRECORDS ) ) THEN + CALL MPI_SEND( BUFR(2, I), NBRECR, MPI_DOUBLE_COMPLEX, + & I, ELT_REAL, COMM, IERR_MPI ) + BUFR(1,I) = ZERO + NBRECR = 0 + END IF + IF ( DEST .ne. -2 ) THEN + BUFI( 2 + NBRECI : 2 + NBRECI + SIZEI - 1, I ) = + & ELNODES( 1: SIZEI ) + BUFR( 2 + NBRECR : 2 + NBRECR + SIZER - 1, I ) = + & ELVAL( 1: SIZER ) + BUFI(1,I) = NBRECI + SIZEI + BUFR(1,I) = cmplx( NBRECR + SIZER, kind=kind(BUFR) ) + END IF + END DO + RETURN + END SUBROUTINE ZMUMPS_127 + SUBROUTINE ZMUMPS_213( ELTPTR, NELT, MAXELT_SIZE ) + INTEGER NELT, MAXELT_SIZE + INTEGER ELTPTR( NELT + 1 ) + INTEGER I, S + MAXELT_SIZE = 0 + DO I = 1, NELT + S = ELTPTR( I + 1 ) - ELTPTR( I ) + MAXELT_SIZE = max( S, MAXELT_SIZE ) + END DO + RETURN + END SUBROUTINE ZMUMPS_213 + SUBROUTINE ZMUMPS_288( N, SIZEI, SIZER, + & ELTVAR, ELTVAL, + & SELTVAL, LSELTVAL, + & ROWSCA, COLSCA, K50 ) + INTEGER N, SIZEI, SIZER, LSELTVAL, K50 + INTEGER ELTVAR( SIZEI ) + COMPLEX(kind=8) ELTVAL( SIZER ) + COMPLEX(kind=8) SELTVAL( LSELTVAL ) + DOUBLE PRECISION ROWSCA( N ), COLSCA( N ) + INTEGER I, J, K + K = 1 + IF ( K50 .eq. 0 ) THEN + DO J = 1, SIZEI + DO I = 1, SIZEI + SELTVAL(K) = ELTVAL(K) * + & ROWSCA(ELTVAR(I)) * + & COLSCA(ELTVAR(J)) + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + DO I = J, SIZEI + SELTVAL(K) = ELTVAL(K) * + & ROWSCA(ELTVAR(I)) * + & COLSCA(ELTVAR(J)) + K = K + 1 + END DO + END DO + END IF + RETURN + END SUBROUTINE ZMUMPS_288 + SUBROUTINE ZMUMPS_F77( JOB, SYM, PAR, COMM_F77, N, ICNTL, CNTL, + & NZ, IRN, IRNhere, JCN, JCNhere, A, Ahere, + & NZ_loc, IRN_loc, IRN_lochere, + & JCN_loc, JCN_lochere, + & A_loc, A_lochere, + & NELT, ELTPTR, ELTPTRhere, ELTVAR, + & ELTVARhere, A_ELT, A_ELThere, + & PERM_IN, PERM_INhere, + & RHS, RHShere, REDRHS, REDRHShere, + & INFO, RINFO, INFOG, RINFOG, + & DEFICIENCY, LWK_USER, + & SIZE_SCHUR, LISTVAR_SCHUR, + & LISTVAR_SCHURhere, SCHUR, SCHURhere, + & WK_USER, WK_USERhere, + & COLSCA, COLSCAhere, ROWSCA, ROWSCAhere, + & INSTANCE_NUMBER, NRHS, LRHS, LREDRHS, + & + & RHS_SPARSE, RHS_SPARSEhere, + & SOL_loc, SOL_lochere, + & IRHS_SPARSE, IRHS_SPARSEhere, + & IRHS_PTR, IRHS_PTRhere, + & ISOL_loc, ISOL_lochere, + & NZ_RHS, LSOL_loc + & , + & SCHUR_MLOC, + & SCHUR_NLOC, + & SCHUR_LLD, + & MBLOCK, + & NBLOCK, + & NPROW, + & NPCOL, + & + & OOC_TMPDIR, + & OOC_PREFIX, + & WRITE_PROBLEM, + & TMPDIRLEN, + & PREFIXLEN, + & WRITE_PROBLEMLEN + & + & ) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER OOC_PREFIX_MAX_LENGTH, OOC_TMPDIR_MAX_LENGTH + INTEGER PB_MAX_LENGTH + PARAMETER(OOC_PREFIX_MAX_LENGTH=63, OOC_TMPDIR_MAX_LENGTH=255) + PARAMETER(PB_MAX_LENGTH=255) + INTEGER JOB, SYM, PAR, COMM_F77, N, NZ, NZ_loc, NELT, + & DEFICIENCY, LWK_USER, SIZE_SCHUR, INSTANCE_NUMBER, + & NRHS, LRHS, + & NZ_RHS, LSOL_loc, LREDRHS + INTEGER ICNTL(40), INFO(40), INFOG(40) + INTEGER SCHUR_MLOC, SCHUR_NLOC, SCHUR_LLD + INTEGER MBLOCK, NBLOCK, NPROW, NPCOL + INTEGER TMPDIRLEN, PREFIXLEN, WRITE_PROBLEMLEN + DOUBLE PRECISION CNTL(15), RINFO(40), RINFOG(40) + INTEGER, TARGET :: IRN(*), JCN(*), ELTPTR(*), ELTVAR(*) + INTEGER, TARGET :: PERM_IN(*), IRN_loc(*), JCN_loc(*) + INTEGER, TARGET :: LISTVAR_SCHUR(*) + INTEGER, TARGET :: IRHS_PTR(*), IRHS_SPARSE(*), ISOL_loc(*) + COMPLEX(kind=8), TARGET :: A(*), A_ELT(*), A_loc(*), RHS(*) + COMPLEX(kind=8), TARGET :: WK_USER(*) + COMPLEX(kind=8), TARGET :: REDRHS(*) + DOUBLE PRECISION, TARGET :: ROWSCA(*), COLSCA(*) + COMPLEX(kind=8), TARGET :: SCHUR(*) + COMPLEX(kind=8), TARGET :: RHS_SPARSE(*), SOL_loc(*) + INTEGER, INTENT(in) :: OOC_TMPDIR(OOC_TMPDIR_MAX_LENGTH) + INTEGER, INTENT(in) :: OOC_PREFIX(OOC_PREFIX_MAX_LENGTH) + INTEGER, INTENT(in) :: WRITE_PROBLEM(PB_MAX_LENGTH) + INTEGER IRNhere, JCNhere, Ahere, ELTPTRhere, ELTVARhere, + & A_ELThere, PERM_INhere, WK_USERhere, + & RHShere, REDRHShere, IRN_lochere, + & JCN_lochere, A_lochere, LISTVAR_SCHURhere, + & SCHURhere, COLSCAhere, ROWSCAhere, RHS_SPARSEhere, + & SOL_lochere, IRHS_PTRhere, IRHS_SPARSEhere, ISOL_lochere + INCLUDE 'mpif.h' + TYPE ZMUMPS_STRUC_PTR + TYPE (ZMUMPS_STRUC), POINTER :: PTR + END TYPE ZMUMPS_STRUC_PTR + TYPE (ZMUMPS_STRUC), POINTER :: mumps_par + TYPE (ZMUMPS_STRUC_PTR), DIMENSION (:), POINTER, SAVE :: + & mumps_par_array + TYPE (ZMUMPS_STRUC_PTR), DIMENSION (:), POINTER :: + & mumps_par_array_bis + INTEGER, SAVE :: ZMUMPS_STRUC_ARRAY_SIZE = 0 + INTEGER, SAVE :: N_INSTANCES = 0 + INTEGER A_ELT_SIZE, I, Np, IERR + INTEGER ZMUMPS_STRUC_ARRAY_SIZE_INIT + PARAMETER (ZMUMPS_STRUC_ARRAY_SIZE_INIT=10) + EXTERNAL MUMPS_AFFECT_MAPPING, + & MUMPS_AFFECT_PIVNUL_LIST, + & MUMPS_AFFECT_SYM_PERM, + & MUMPS_AFFECT_UNS_PERM + IF (JOB == -1) THEN + DO I = 1, ZMUMPS_STRUC_ARRAY_SIZE + IF ( .NOT. associated(mumps_par_array(I)%PTR) ) GOTO 10 + END DO + ALLOCATE( mumps_par_array_bis(ZMUMPS_STRUC_ARRAY_SIZE + + & ZMUMPS_STRUC_ARRAY_SIZE_INIT), stat=IERR) + IF (IERR /= 0) THEN + WRITE(*,*) ' ** Allocation Error 1 in ZMUMPS_F77.' + CALL MUMPS_ABORT() + END IF + DO I = 1, ZMUMPS_STRUC_ARRAY_SIZE + mumps_par_array_bis(I)%PTR=>mumps_par_array(I)%PTR + ENDDO + IF (associated(mumps_par_array)) DEALLOCATE(mumps_par_array) + mumps_par_array=>mumps_par_array_bis + NULLIFY(mumps_par_array_bis) + DO I = ZMUMPS_STRUC_ARRAY_SIZE+1, ZMUMPS_STRUC_ARRAY_SIZE + + & ZMUMPS_STRUC_ARRAY_SIZE_INIT + NULLIFY(mumps_par_array(I)%PTR) + ENDDO + I = ZMUMPS_STRUC_ARRAY_SIZE+1 + ZMUMPS_STRUC_ARRAY_SIZE = ZMUMPS_STRUC_ARRAY_SIZE + + & ZMUMPS_STRUC_ARRAY_SIZE_INIT + 10 CONTINUE + INSTANCE_NUMBER = I + N_INSTANCES = N_INSTANCES+1 + ALLOCATE( mumps_par_array(INSTANCE_NUMBER)%PTR,stat=IERR ) + IF (IERR /= 0) THEN + WRITE(*,*) '** Allocation Error 2 in ZMUMPS_F77.' + CALL MUMPS_ABORT() + ENDIF + mumps_par_array(INSTANCE_NUMBER)%PTR%KEEP(40) = 0 + mumps_par_array(INSTANCE_NUMBER)%PTR%INSTANCE_NUMBER = + & INSTANCE_NUMBER + END IF + IF ( INSTANCE_NUMBER .LE. 0 .OR. INSTANCE_NUMBER .GT. + & ZMUMPS_STRUC_ARRAY_SIZE ) THEN + WRITE(*,*) ' ** Instance Error 1 in ZMUMPS_F77', + & INSTANCE_NUMBER + CALL MUMPS_ABORT() + END IF + IF ( .NOT. associated ( mumps_par_array(INSTANCE_NUMBER)%PTR ) ) + & THEN + WRITE(*,*) ' Instance Error 2 in ZMUMPS_F77', + & INSTANCE_NUMBER + CALL MUMPS_ABORT() + END IF + mumps_par => mumps_par_array(INSTANCE_NUMBER)%PTR + mumps_par%SYM = SYM + mumps_par%PAR = PAR + mumps_par%JOB = JOB + mumps_par%N = N + mumps_par%NZ = NZ + mumps_par%NZ_loc = NZ_loc + mumps_par%LWK_USER = LWK_USER + mumps_par%SIZE_SCHUR = SIZE_SCHUR + mumps_par%NELT= NELT + mumps_par%ICNTL(1:40)=ICNTL(1:40) + mumps_par%CNTL(1:15)=CNTL(1:15) + mumps_par%NRHS = NRHS + mumps_par%LRHS = LRHS + mumps_par%LREDRHS = LREDRHS + mumps_par%NZ_RHS = NZ_RHS + mumps_par%LSOL_loc = LSOL_loc + mumps_par%SCHUR_MLOC = SCHUR_MLOC + mumps_par%SCHUR_NLOC = SCHUR_NLOC + mumps_par%SCHUR_LLD = SCHUR_LLD + mumps_par%MBLOCK = MBLOCK + mumps_par%NBLOCK = NBLOCK + mumps_par%NPROW = NPROW + mumps_par%NPCOL = NPCOL + IF ( COMM_F77 .NE. -987654 ) THEN + mumps_par%COMM = COMM_F77 + ELSE + mumps_par%COMM = MPI_COMM_WORLD + ENDIF + CALL MPI_BCAST(NRHS,1,MPI_INTEGER,0,mumps_par%COMM,IERR) + IF ( IRNhere /= 0 ) mumps_par%IRN => IRN(1:NZ) + IF ( JCNhere /= 0 ) mumps_par%JCN => JCN(1:NZ) + IF ( Ahere /= 0 ) mumps_par%A => A(1:NZ) + IF ( IRN_lochere /= 0 ) mumps_par%IRN_loc => IRN_loc(1:NZ_loc) + IF ( JCN_lochere /= 0 ) mumps_par%JCN_loc => JCN_loc(1:NZ_loc) + IF ( A_lochere /= 0 ) mumps_par%A_loc => A_loc(1:NZ_loc) + IF ( ELTPTRhere /= 0 ) mumps_par%ELTPTR => ELTPTR(1:NELT+1) + IF ( ELTVARhere /= 0 ) mumps_par%ELTVAR => + & ELTVAR(1:ELTPTR(NELT+1)-1) + IF ( A_ELThere /= 0 ) THEN + A_ELT_SIZE = 0 + DO I = 1, NELT + Np = ELTPTR(I+1) -ELTPTR(I) + IF (SYM == 0) THEN + A_ELT_SIZE = A_ELT_SIZE + Np * Np + ELSE + A_ELT_SIZE = A_ELT_SIZE + Np * ( Np + 1 ) / 2 + END IF + END DO + mumps_par%A_ELT => A_ELT(1:A_ELT_SIZE) + END IF + IF ( PERM_INhere /= 0) mumps_par%PERM_IN => PERM_IN(1:N) + IF ( LISTVAR_SCHURhere /= 0) + & mumps_par%LISTVAR_SCHUR =>LISTVAR_SCHUR(1:SIZE_SCHUR) + IF ( SCHURhere /= 0 ) THEN + mumps_par%SCHUR_CINTERFACE=>SCHUR(1:1) + ENDIF + IF (NRHS .NE. 1) THEN + IF ( RHShere /= 0 ) mumps_par%RHS => RHS(1:NRHS*LRHS) + IF (REDRHShere /= 0)mumps_par%REDRHS=>REDRHS(1:NRHS*LREDRHS) + ELSE + IF ( RHShere /= 0 ) mumps_par%RHS => RHS(1:N) + IF (REDRHShere /= 0)mumps_par%REDRHS=>REDRHS(1:SIZE_SCHUR) + ENDIF + IF ( WK_USERhere /=0 ) THEN + IF (LWK_USER > 0 ) THEN + mumps_par%WK_USER => WK_USER(1:LWK_USER) + ELSE + mumps_par%WK_USER => WK_USER(1_8:-int(LWK_USER,8)*1000000_8) + ENDIF + ENDIF + IF ( COLSCAhere /= 0) mumps_par%COLSCA => COLSCA(1:N) + IF ( ROWSCAhere /= 0) mumps_par%ROWSCA => ROWSCA(1:N) + IF ( RHS_SPARSEhere /=0 ) mumps_par%RHS_SPARSE=> + & RHS_SPARSE(1:NZ_RHS) + IF ( IRHS_SPARSEhere /=0 ) mumps_par%IRHS_SPARSE=> + & IRHS_SPARSE(1:NZ_RHS) + IF ( SOL_lochere /=0 ) mumps_par%SOL_loc=> + & SOL_loc(1:LSOL_loc*NRHS) + IF ( ISOL_lochere /=0 ) mumps_par%ISOL_loc=> + & ISOL_loc(1:LSOL_loc) + IF ( IRHS_PTRhere /=0 ) mumps_par%IRHS_PTR=> + & IRHS_PTR(1:NRHS+1) + DO I=1,TMPDIRLEN + mumps_par%OOC_TMPDIR(I:I)=char(OOC_TMPDIR(I)) + ENDDO + DO I=TMPDIRLEN+1,OOC_TMPDIR_MAX_LENGTH + mumps_par%OOC_TMPDIR(I:I)=' ' + ENDDO + DO I=1,PREFIXLEN + mumps_par%OOC_PREFIX(I:I)=char(OOC_PREFIX(I)) + ENDDO + DO I=PREFIXLEN+1,OOC_PREFIX_MAX_LENGTH + mumps_par%OOC_PREFIX(I:I)=' ' + ENDDO + DO I=1,WRITE_PROBLEMLEN + mumps_par%WRITE_PROBLEM(I:I)=char(WRITE_PROBLEM(I)) + ENDDO + DO I=WRITE_PROBLEMLEN+1,PB_MAX_LENGTH + mumps_par%WRITE_PROBLEM(I:I)=' ' + ENDDO + CALL ZMUMPS( mumps_par ) + INFO(1:40)=mumps_par%INFO(1:40) + INFOG(1:40)=mumps_par%INFOG(1:40) + RINFO(1:40)=mumps_par%RINFO(1:40) + RINFOG(1:40)=mumps_par%RINFOG(1:40) + ICNTL(1:40) = mumps_par%ICNTL(1:40) + CNTL(1:15) = mumps_par%CNTL(1:15) + SYM = mumps_par%SYM + PAR = mumps_par%PAR + JOB = mumps_par%JOB + N = mumps_par%N + NZ = mumps_par%NZ + NRHS = mumps_par%NRHS + LRHS = mumps_par%LRHS + LREDRHS = mumps_par%LREDRHS + NZ_loc = mumps_par%NZ_loc + NZ_RHS = mumps_par%NZ_RHS + LSOL_loc= mumps_par%LSOL_loc + SIZE_SCHUR = mumps_par%SIZE_SCHUR + LWK_USER = mumps_par%LWK_USER + NELT= mumps_par%NELT + DEFICIENCY = mumps_par%Deficiency + SCHUR_MLOC = mumps_par%SCHUR_MLOC + SCHUR_NLOC = mumps_par%SCHUR_NLOC + SCHUR_LLD = mumps_par%SCHUR_LLD + MBLOCK = mumps_par%MBLOCK + NBLOCK = mumps_par%NBLOCK + NPROW = mumps_par%NPROW + NPCOL = mumps_par%NPCOL + IF ( associated (mumps_par%MAPPING) ) THEN + CALL MUMPS_AFFECT_MAPPING(mumps_par%MAPPING(1)) + ELSE + CALL MUMPS_NULLIFY_C_MAPPING() + ENDIF + IF ( associated (mumps_par%PIVNUL_LIST) ) THEN + CALL MUMPS_AFFECT_PIVNUL_LIST(mumps_par%PIVNUL_LIST(1)) + ELSE + CALL MUMPS_NULLIFY_C_PIVNUL_LIST() + ENDIF + IF ( associated (mumps_par%SYM_PERM) ) THEN + CALL MUMPS_AFFECT_SYM_PERM(mumps_par%SYM_PERM(1)) + ELSE + CALL MUMPS_NULLIFY_C_SYM_PERM() + ENDIF + IF ( associated (mumps_par%UNS_PERM) ) THEN + CALL MUMPS_AFFECT_UNS_PERM(mumps_par%UNS_PERM(1)) + ELSE + CALL MUMPS_NULLIFY_C_UNS_PERM() + ENDIF + IF ( JOB == -2 ) THEN + IF (associated(mumps_par_array(INSTANCE_NUMBER)%PTR))THEN + DEALLOCATE(mumps_par_array(INSTANCE_NUMBER)%PTR) + NULLIFY (mumps_par_array(INSTANCE_NUMBER)%PTR) + N_INSTANCES = N_INSTANCES - 1 + IF ( N_INSTANCES == 0 ) THEN + DEALLOCATE(mumps_par_array) + ZMUMPS_STRUC_ARRAY_SIZE = 0 + END IF + ELSE + WRITE(*,*) "** Warning: instance already freed" + WRITE(*,*) " this should normally not happen." + ENDIF + END IF + RETURN + END SUBROUTINE ZMUMPS_F77 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part4.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part4.F new file mode 100644 index 000000000..386579f78 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part4.F @@ -0,0 +1,6853 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE ZMUMPS_246(MYID, N, STEP, FRERE, FILS, + & NA, LNA, NE, DAD, ND, PROCNODE, SLAVEF, + & NRLADU, NIRADU, NIRNEC, NRLNEC, + & NRLNEC_ACTIVE, + & NIRADU_OOC, NIRNEC_OOC, + & MAXFR, OPSA, + & KEEP,KEEP8, LOCAL_M, LOCAL_N, SBUF_RECOLD, + & SBUF_SEND, SBUF_REC, OPS_SUBTREE, NSTEPS, + & I_AM_CAND,NMB_PAR2, ISTEP_TO_INIV2, CANDIDATES, + & IFLAG, IERROR + & ,MAX_FRONT_SURFACE_LOCAL + & ,MAX_SIZE_FACTOR, ENTRIES_IN_FACTORS_LOC + & ,ENTRIES_IN_FACTORS_LOC_MASTERS + & ) + IMPLICIT NONE + INTEGER MYID, N, LNA, IFLAG, IERROR + INTEGER NIRADU, NIRNEC + INTEGER(8) NRLADU, NRLNEC, NRLNEC_ACTIVE + INTEGER(8) NRLADU_CURRENT, NRLADU_ROOT_3 + INTEGER NIRADU_OOC, NIRNEC_OOC + INTEGER MAXFR, NSTEPS + INTEGER(8) MAX_FRONT_SURFACE_LOCAL + INTEGER STEP(N) + INTEGER FRERE(NSTEPS), FILS(N), NA(LNA), NE(NSTEPS), + & ND(NSTEPS), PROCNODE(NSTEPS), DAD(NSTEPS) + INTEGER SLAVEF, KEEP(500), LOCAL_M, LOCAL_N + INTEGER(8) KEEP8(150) + INTEGER(8) ENTRIES_IN_FACTORS_LOC, + & ENTRIES_IN_FACTORS_LOC_MASTERS + INTEGER SBUF_SEND, SBUF_REC + INTEGER(8) SBUF_RECOLD + INTEGER NMB_PAR2 + INTEGER ISTEP_TO_INIV2( KEEP(71) ) + LOGICAL I_AM_CAND(NMB_PAR2) + INTEGER CANDIDATES( SLAVEF+1, NMB_PAR2 ) + DOUBLE PRECISION OPSA + DOUBLE PRECISION OPSA_LOC + INTEGER(8) MAX_SIZE_FACTOR + DOUBLE PRECISION OPS_SUBTREE + DOUBLE PRECISION OPS_SBTR_LOC + INTEGER, ALLOCATABLE, DIMENSION(:) :: TNSTK, IPOOL, LSTKI + INTEGER(8), ALLOCATABLE, DIMENSION(:) :: LSTKR + INTEGER(8) SBUFS_CB, SBUFR_CB + INTEGER SBUFR, SBUFS + INTEGER BLOCKING_RHS + INTEGER ITOP,NELIM,NFR + INTEGER(8) ISTKR, LSTK + INTEGER ISTKI, STKI, ISTKI_OOC + INTEGER K,NSTK, IFATH + INTEGER INODE, LEAF, NBROOT, IN + INTEGER LEVEL, MAXITEMPCB + INTEGER(8) CURRENT_ACTIVE_MEM, MAXTEMPCB + LOGICAL UPDATE, UPDATEF, MASTER, MASTERF, INSSARBR + INTEGER LEVELF, NCB, SIZECBI + INTEGER(8) NCB8 + INTEGER(8) NFR8, NELIM8 + INTEGER(8) SIZECB, SIZECBINFR, SIZECB_SLAVE + INTEGER SIZEHEADER, SIZEHEADER_OOC, XSIZE_OOC + INTEGER EXTRA_PERM_INFO_OOC + INTEGER NBROWMAX, NSLAVES_LOC, NSLAVES_PASSED, + & NELIMF, NFRF, NCBF, + & NBROWMAXF, LKJIB, + & LKJIBT, NBR, NBCOLFAC + INTEGER(8) LEV3MAXREC, CBMAXR, CBMAXS + INTEGER ALLOCOK + INTEGER PANEL_SIZE + LOGICAL COMPRESSCB + DOUBLE PRECISION OPS_NODE, OPS_NODE_MASTER, OPS_NODE_SLAVE + INTEGER(8) ENTRIES_NODE_UPPER_PART, ENTRIES_NODE_LOWER_PART + INCLUDE 'mumps_headers.h' + INTEGER WHAT + INTEGER(8) IDUMMY8 + INTRINSIC min, int, real + INTEGER ZMUMPS_748 + EXTERNAL ZMUMPS_748 + INTEGER MUMPS_275, MUMPS_330 + LOGICAL MUMPS_170 + INTEGER MUMPS_52 + EXTERNAL MUMPS_503, MUMPS_52 + EXTERNAL MUMPS_275, MUMPS_330, + & MUMPS_170 + logical :: FORCE_CAND, CONCERNED, UPDATES, STACKCB, MASTERSON + integer :: IFSON, LEVELSON + IF (KEEP(50).eq.2) THEN + EXTRA_PERM_INFO_OOC = 1 + ELSE IF (KEEP(50).eq.0) THEN + EXTRA_PERM_INFO_OOC = 2 + ELSE + EXTRA_PERM_INFO_OOC = 0 + ENDIF + COMPRESSCB=( KEEP(215).EQ.0 .AND. KEEP(50).NE.0 ) + MAX_FRONT_SURFACE_LOCAL=0_8 + MAX_SIZE_FACTOR=0_8 + ALLOCATE( LSTKR(NSTEPS), TNSTK(NSTEPS), IPOOL(NSTEPS), + & LSTKI(NSTEPS) , stat=ALLOCOK) + if (ALLOCOK .GT. 0) THEN + IFLAG =-7 + IERROR = 4*NSTEPS + RETURN + endif + LKJIB = max(KEEP(5),KEEP(6)) + TNSTK = NE + LEAF = NA(1)+1 + IPOOL(1:LEAF-1) = NA(3:3+LEAF-2) + NBROOT = NA(2) +#if defined(OLD_OOC_NOPANEL) + XSIZE_OOC=XSIZE_OOC_NOPANEL +#else + IF (KEEP(50).EQ.0) THEN + XSIZE_OOC=XSIZE_OOC_UNSYM + ELSE + XSIZE_OOC=XSIZE_OOC_SYM + ENDIF +#endif + SIZEHEADER_OOC = XSIZE_OOC+6 + SIZEHEADER = XSIZE_IC + 6 + ISTKR = 0_8 + ISTKI = 0 + ISTKI_OOC = 0 + OPSA_LOC = dble(0.0D0) + ENTRIES_IN_FACTORS_LOC = 0_8 + ENTRIES_IN_FACTORS_LOC_MASTERS = 0_8 + OPS_SBTR_LOC = dble(0.0D0) + NRLADU = 0_8 + NIRADU = 0 + NIRADU_OOC = 0 + NRLADU_CURRENT = 0_8 + NRLADU_ROOT_3 = 0_8 + NRLNEC_ACTIVE = 0_8 + NRLNEC = 0_8 + NIRNEC = 0 + NIRNEC_OOC = 0 + MAXFR = 0 + ITOP = 0 + MAXTEMPCB = 0_8 + MAXITEMPCB = 0 + SBUFS_CB = 1_8 + SBUFS = 1 + SBUFR_CB = 1_8 + SBUFR = 1 + IF (KEEP(38) .NE. 0 .AND. KEEP(60).EQ.0) THEN + INODE = KEEP(38) + NRLADU_ROOT_3 = int(LOCAL_M,8)*int(LOCAL_N,8) + NRLADU = NRLADU_ROOT_3 + NRLNEC_ACTIVE = NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_ROOT_3) + NRLNEC = NRLADU + IF (MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + & .EQ. MYID) THEN + NIRADU = SIZEHEADER+2*(ND(STEP(INODE))+KEEP(253)) + NIRADU_OOC = SIZEHEADER_OOC+2*(ND(STEP(INODE))+KEEP(253)) + ELSE + NIRADU = SIZEHEADER + NIRADU_OOC = SIZEHEADER_OOC + ENDIF + NIRNEC = NIRADU + NIRNEC_OOC = NIRADU_OOC + ENDIF + IF((KEEP(24).eq.0).OR.(KEEP(24).eq.1)) THEN + FORCE_CAND=.FALSE. + ELSE + FORCE_CAND=(mod(KEEP(24),2).eq.0) + END IF + 90 CONTINUE + IF (LEAF.NE.1) THEN + LEAF = LEAF - 1 + INODE = IPOOL(LEAF) + ELSE + WRITE(MYID+6,*) ' ERROR 1 in ZMUMPS_246 ' + CALL MUMPS_ABORT() + ENDIF + 95 CONTINUE + NFR = ND(STEP(INODE))+KEEP(253) + NFR8 = int(NFR,8) + NSTK = NE(STEP(INODE)) + NELIM = 0 + IN = INODE + 100 NELIM = NELIM + 1 + NELIM8=int(NELIM,8) + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 100 + IFSON = -IN + IFATH = DAD(STEP(INODE)) + MASTER = MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + & .EQ. MYID + LEVEL = MUMPS_330(PROCNODE(STEP(INODE)),SLAVEF) + INSSARBR = MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF) + UPDATE=.FALSE. + if(.NOT.FORCE_CAND) then + UPDATE = ( (MASTER.AND.(LEVEL.NE.3) ).OR. LEVEL.EQ.2 ) + else + if(MASTER.and.(LEVEL.ne.3)) then + UPDATE = .TRUE. + else if(LEVEL.eq.2) then + if ( I_AM_CAND(ISTEP_TO_INIV2(STEP(INODE)))) THEN + UPDATE = .TRUE. + end if + end if + end if + NCB = NFR-NELIM + NCB8 = int(NCB,8) + SIZECBINFR = NCB8*NCB8 + IF (KEEP(50).EQ.0) THEN + SIZECB = SIZECBINFR + ELSE + IFATH = DAD(STEP(INODE)) + IF ( IFATH.NE.KEEP(38) .AND. COMPRESSCB ) THEN + SIZECB = (NCB8*(NCB8+1_8))/2_8 + ELSE + SIZECB = SIZECBINFR + ENDIF + ENDIF + SIZECBI = 2* NCB + SIZEHEADER + IF (LEVEL.NE.2) THEN + NSLAVES_LOC = -99999999 + SIZECB_SLAVE = -99999997_8 + NBROWMAX = NCB + ELSE + IF (KEEP(48) .EQ. 5) THEN + WHAT = 5 + IF (FORCE_CAND) THEN + NSLAVES_LOC=CANDIDATES(SLAVEF+1, + & ISTEP_TO_INIV2(STEP(INODE))) + ELSE + NSLAVES_LOC=SLAVEF-1 + ENDIF + NSLAVES_PASSED=NSLAVES_LOC + ELSE + WHAT = 2 + NSLAVES_PASSED=SLAVEF + NSLAVES_LOC =SLAVEF-1 + ENDIF + CALL MUMPS_503(WHAT, KEEP,KEEP8, + & NCB, NFR, NSLAVES_PASSED, NBROWMAX, SIZECB_SLAVE + & ) + ENDIF + IF (KEEP(60).GT.1) THEN + IF (MASTER .AND. INODE.EQ.KEEP(38)) THEN + NIRADU = NIRADU+SIZEHEADER+2*(ND(STEP(INODE))+KEEP(253)) + NIRADU_OOC = NIRADU_OOC+SIZEHEADER_OOC+ + & 2*(ND(STEP(INODE))+KEEP(253)) + ENDIF + ENDIF + IF (LEVEL.EQ.3) THEN + IF ( + & KEEP(60).LE.1 + & ) THEN + NRLNEC = max(NRLNEC,NRLADU+ISTKR+ + & int(LOCAL_M,8)*int(LOCAL_N,8)) + NRLADU_CURRENT = int(LOCAL_M,8)*int(LOCAL_N,8) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_ROOT_3 + + & NRLADU_CURRENT+ISTKR) + ENDIF + IF (MASTER) THEN + IF (NFR.GT.MAXFR) MAXFR = NFR + ENDIF + ENDIF + IF(KEEP(86).EQ.1)THEN + IF(MASTER.AND.(.NOT.MUMPS_170( + & PROCNODE(STEP(INODE)), SLAVEF)) + & )THEN + IF(LEVEL.EQ.1)THEN + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NFR8*NFR8) + ELSEIF(LEVEL.EQ.2)THEN + IF(KEEP(50).EQ.0)THEN + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NFR8*NELIM8) + ELSE + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NELIM8*NELIM8) + IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN + MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL, + & NELIM8*(NELIM8+1_8)) + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + IF (LEVEL.EQ.2) THEN + IF (MASTER) THEN + IF (KEEP(50).EQ.0) THEN + SBUFS = max(SBUFS, NFR*LKJIB+LKJIB+4) + ELSE + SBUFS = max(SBUFS, NELIM*LKJIB+NELIM+6) + ENDIF + ELSEIF (UPDATE) THEN + if (KEEP(50).EQ.0) THEN + SBUFR = max(SBUFR, NFR*LKJIB+LKJIB+4) + else + SBUFR = max( SBUFR, NELIM*LKJIB+NELIM+6 ) + IF (KEEP(50).EQ.1) THEN + LKJIBT = LKJIB + ELSE + LKJIBT = min( NELIM, LKJIB * 2 ) + ENDIF + SBUFS = max(SBUFS, + & LKJIBT*NBROWMAX+6) + SBUFR = max( SBUFR, NBROWMAX*LKJIBT+6 ) + endif + ENDIF + ENDIF + IF ( UPDATE ) THEN + IF ( (MASTER) .AND. (LEVEL.EQ.1) ) THEN + NIRADU = NIRADU + 2*NFR + SIZEHEADER + NIRADU_OOC = NIRADU_OOC + 2*NFR + SIZEHEADER_OOC + PANEL_SIZE = ZMUMPS_748( + & 2_8*int(KEEP(226),8), NFR, KEEP(227), KEEP(50)) + NIRADU_OOC = NIRADU_OOC + + & EXTRA_PERM_INFO_OOC*(2+NELIM + NELIM/PANEL_SIZE+1) + IF (KEEP(50).EQ.0) THEN + NRLADU_CURRENT = int(NELIM,8)*int(2*NFR-NELIM,8) + NRLADU = NRLADU + NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + ELSE + NRLADU_CURRENT = int(NELIM,8)*int(NFR,8) + NRLADU = NRLADU + NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + ENDIF + SIZECBI = 2* NCB + 6 + 3 + ELSEIF (LEVEL.EQ.2) THEN + IF (MASTER) THEN + NIRADU = NIRADU+SIZEHEADER +SLAVEF-1+2*NFR + NIRADU_OOC = NIRADU_OOC+SIZEHEADER_OOC +SLAVEF-1+2*NFR + IF (KEEP(50).EQ.0) THEN + NBCOLFAC=NFR + ELSE + NBCOLFAC=NELIM + ENDIF + PANEL_SIZE = ZMUMPS_748( + & 2_8*int(KEEP(226),8), NBCOLFAC, KEEP(227), KEEP(50)) + NIRADU_OOC = NIRADU_OOC + + & EXTRA_PERM_INFO_OOC*(2+NELIM + NELIM/PANEL_SIZE+1) + NRLADU_CURRENT = int(NBCOLFAC,8)*int(NELIM,8) + NRLADU = NRLADU + NRLADU_CURRENT + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + SIZECB = 0_8 + SIZECBINFR = 0_8 + SIZECBI = NCB + 5 + SLAVEF - 1 + ELSE + SIZECB=SIZECB_SLAVE + SIZECBINFR = SIZECB + NIRADU = NIRADU+4+NELIM+NBROWMAX + NIRADU_OOC = NIRADU_OOC+4+NELIM+NBROWMAX + IF (KEEP(50).EQ.0) THEN + NRLADU = NRLADU + int(NELIM,8)*int(NBROWMAX,8) + ELSE + NRLADU = NRLADU + int(NELIM,8)*int(NCB/NSLAVES_LOC,8) + ENDIF + NRLADU_CURRENT = int(NELIM,8)*int(NBROWMAX,8) + MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT) + SIZECBI = 4 + NBROWMAX + NCB + IF (KEEP(50).NE.0) THEN + SIZECBI=SIZECBI+NSLAVES_LOC+ + & XTRA_SLAVES_SYM + ELSE + SIZECBI=SIZECBI+NSLAVES_LOC+ + & XTRA_SLAVES_UNSYM + ENDIF + ENDIF + ENDIF + NIRNEC = max0(NIRNEC, + & NIRADU+ISTKI+SIZECBI+MAXITEMPCB) + NIRNEC_OOC = max0(NIRNEC_OOC, + & NIRADU_OOC+ISTKI_OOC+SIZECBI+MAXITEMPCB + + & (XSIZE_OOC-XSIZE_IC) ) + CURRENT_ACTIVE_MEM = ISTKR+SIZECBINFR + IF (NSTK .NE. 0 .AND. INSSARBR .AND. + & KEEP(234).NE.0 .AND. KEEP(55).EQ.0) THEN + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM - LSTKR(ITOP) + ENDIF + IF (KEEP(50).NE.0.AND.UPDATE.AND.LEVEL.EQ.1) THEN + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM + + & int(NELIM,8)*int(NCB,8) + ENDIF + IF (MASTER .AND. KEEP(219).NE.0.AND. + & KEEP(50).EQ.2.AND.LEVEL.EQ.2) THEN + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM + int(NELIM,8) + ENDIF + IF (SLAVEF.EQ.1) THEN + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM) + ELSE + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+MAXTEMPCB) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM+MAXTEMPCB) + ENDIF + IF (NFR.GT.MAXFR) MAXFR = NFR + IF (NSTK.GT.0) THEN + DO 70 K=1,NSTK + LSTK = LSTKR(ITOP) + ISTKR = ISTKR - LSTK + IF (K==1 .AND. INSSARBR.AND.KEEP(234).NE.0 + & .AND.KEEP(55).EQ.0) THEN + ELSE + CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM - LSTK + ENDIF + STKI = LSTKI( ITOP ) + ISTKI = ISTKI - STKI + ISTKI_OOC = ISTKI_OOC - STKI - (XSIZE_OOC-XSIZE_IC) + ITOP = ITOP - 1 + IF (ITOP.LT.0) THEN + write(*,*) MYID, + & ': ERROR 2 in ZMUMPS_246. ITOP = ',ITOP + CALL MUMPS_ABORT() + ENDIF + 70 CONTINUE + ENDIF + ELSE IF (LEVEL.NE.3) THEN + DO WHILE (IFSON.GT.0) + UPDATES=.FALSE. + MASTERSON = MUMPS_275(PROCNODE(STEP(IFSON)),SLAVEF) + & .EQ.MYID + LEVELSON = MUMPS_330(PROCNODE(STEP(IFSON)),SLAVEF) + if(.NOT.FORCE_CAND) then + UPDATES =((MASTERSON.AND.(LEVELSON.NE.3)).OR. + & LEVELSON.EQ.2) + else + if(MASTERSON.and.(LEVELSON.ne.3)) then + UPDATES = .TRUE. + else if(LEVELSON.eq.2) then + if ( I_AM_CAND(ISTEP_TO_INIV2(STEP(IFSON)))) then + UPDATES = .TRUE. + end if + end if + end if + IF (UPDATES) THEN + LSTK = LSTKR(ITOP) + ISTKR = ISTKR - LSTK + STKI = LSTKI( ITOP ) + ISTKI = ISTKI - STKI + ISTKI_OOC = ISTKI_OOC - STKI - (XSIZE_OOC-XSIZE_IC) + ITOP = ITOP - 1 + IF (ITOP.LT.0) THEN + write(*,*) MYID, + & ': ERROR 2 in ZMUMPS_246. ITOP = ',ITOP + CALL MUMPS_ABORT() + ENDIF + ENDIF + IFSON = FRERE(STEP(IFSON)) + END DO + ENDIF + IF ( + & ( (INODE.NE.KEEP(20)).OR.(KEEP(60).EQ.0) ) + & .AND. + & ( (INODE.NE.KEEP(38)).OR.(KEEP(60).LE.1) ) + & ) + &THEN + ENTRIES_NODE_LOWER_PART = int(NFR-NELIM,8) * int(NELIM,8) + IF ( KEEP(50).EQ.0 ) THEN + ENTRIES_NODE_UPPER_PART = int(NFR,8) * int(NELIM,8) + ELSE + ENTRIES_NODE_UPPER_PART = + & (int(NELIM,8)*int(NELIM+1,8))/2_8 + ENDIF + IF (KEEP(50).EQ.2 .AND. LEVEL.EQ.3) THEN + CALL MUMPS_511(NFR, + & NELIM, NELIM,0, + & 1,OPS_NODE) + ELSE + CALL MUMPS_511(NFR, + & NELIM, NELIM,KEEP(50), + & 1,OPS_NODE) + ENDIF + IF (LEVEL.EQ.2) THEN + CALL MUMPS_511(NFR, + & NELIM, NELIM,KEEP(50), + & 2,OPS_NODE_MASTER) + OPS_NODE_SLAVE=OPS_NODE-OPS_NODE_MASTER + ENDIF + ELSE + OPS_NODE = 0.0D0 + ENTRIES_NODE_UPPER_PART = 0_8 + ENTRIES_NODE_LOWER_PART = 0_8 + ENDIF + IF ( MASTER ) + & ENTRIES_IN_FACTORS_LOC_MASTERS = + & ENTRIES_IN_FACTORS_LOC_MASTERS + + & ENTRIES_NODE_UPPER_PART + + & ENTRIES_NODE_LOWER_PART + IF (UPDATE.OR.LEVEL.EQ.3) THEN + IF ( LEVEL .EQ. 3 ) THEN + OPSA_LOC = OPSA_LOC + OPS_NODE / dble( SLAVEF ) + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & ENTRIES_NODE_UPPER_PART / + & int(SLAVEF,8) + IF (MASTER) + & ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & mod(ENTRIES_NODE_UPPER_PART, + & int(SLAVEF,8)) + ELSE IF (MASTER .AND. LEVEL.EQ.2) THEN + OPSA_LOC = OPSA_LOC + OPS_NODE_MASTER + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & ENTRIES_NODE_UPPER_PART + + & mod(ENTRIES_NODE_LOWER_PART, + & int(NSLAVES_LOC,8)) + ELSE IF (MASTER .AND. LEVEL.EQ.1) THEN + OPSA_LOC = OPSA_LOC + dble(OPS_NODE) + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + + & ENTRIES_NODE_UPPER_PART + + & ENTRIES_NODE_LOWER_PART + ELSE IF (UPDATE) THEN + OPSA_LOC = OPSA_LOC + + & dble(OPS_NODE_SLAVE)/dble(NSLAVES_LOC) + ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC + & + ENTRIES_NODE_LOWER_PART / + & int(NSLAVES_LOC,8) + ENDIF + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF) .OR. NE(STEP(INODE))==0) THEN + IF (LEVEL == 1) THEN + OPS_SBTR_LOC = OPS_SBTR_LOC + OPS_NODE + ELSE + CALL MUMPS_511(NFR, + & NELIM, NELIM,KEEP(50), + & 1,OPS_NODE) + OPS_SBTR_LOC = OPS_SBTR_LOC + OPS_NODE + ENDIF + ENDIF + ENDIF + IF (IFATH .EQ. 0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 115 + GOTO 90 + ELSE + NFRF = ND(STEP(IFATH))+KEEP(253) + IF (DAD(STEP(IFATH)).EQ.0) THEN + NELIMF = NFRF + ELSE + NELIMF = 0 + IN = IFATH + DO WHILE (IN.GT.0) + IN = FILS(IN) + NELIMF = NELIMF+1 + ENDDO + ENDIF + NCBF = NFRF - NELIMF + LEVELF = MUMPS_330(PROCNODE(STEP(IFATH)),SLAVEF) + MASTERF= MUMPS_275(PROCNODE(STEP(IFATH)),SLAVEF).EQ.MYID + UPDATEF= .FALSE. + if(.NOT.FORCE_CAND) then + UPDATEF= ((MASTERF.AND.(LEVELF.NE.3)).OR.LEVELF.EQ.2) + else + if(MASTERF.and.(LEVELF.ne.3)) then + UPDATEF = .TRUE. + else if (LEVELF.eq.2) then + if ( I_AM_CAND(ISTEP_TO_INIV2(STEP(IFATH)))) THEN + UPDATEF = .TRUE. + end if + end if + end if + CONCERNED = UPDATEF .OR. UPDATE + IF (LEVELF .NE. 2) THEN + NBROWMAXF = -999999 + ELSE + IF (KEEP(48) .EQ. 5) THEN + WHAT = 4 + IF (FORCE_CAND) THEN + NSLAVES_LOC=CANDIDATES(SLAVEF+1, + & ISTEP_TO_INIV2(STEP(IFATH))) + ELSE + NSLAVES_LOC=SLAVEF-1 + ENDIF + ELSE + WHAT = 1 + NSLAVES_LOC=SLAVEF + ENDIF + CALL MUMPS_503( WHAT, KEEP, KEEP8, + & NCBF, NFRF, NSLAVES_LOC, NBROWMAXF, IDUMMY8 + & ) + ENDIF + IF(LEVEL.EQ.1.AND.UPDATE.AND. + & (UPDATEF.OR.LEVELF.EQ.2) + & .AND.LEVELF.NE.3) THEN + IF ( INSSARBR .AND. KEEP(234).NE.0) THEN + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM) + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM) + ELSE + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM+SIZECB) + NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+SIZECB) + ENDIF + ENDIF + IF (UPDATE .AND. LEVEL.EQ.2 .AND. .NOT. MASTER) THEN + NRLNEC = + & max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+NRLADU_CURRENT) + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,2_8*NRLADU_CURRENT+ + & NRLADU_ROOT_3+CURRENT_ACTIVE_MEM) + ENDIF + IF (LEVELF.EQ.3) THEN + IF (LEVEL.EQ.1) THEN + LEV3MAXREC = int(min(NCB,LOCAL_M),8) * + & int(min(NCB,LOCAL_N),8) + ELSE + LEV3MAXREC = min(SIZECB, + & int(min(NBROWMAX,LOCAL_M),8) + & *int(min(NCB,LOCAL_N),8)) + ENDIF + MAXTEMPCB = max(MAXTEMPCB, LEV3MAXREC) + MAXITEMPCB = max(MAXITEMPCB,SIZECBI+SIZEHEADER) + SBUFR_CB = max(SBUFR_CB, LEV3MAXREC+int(SIZECBI,8)) + NIRNEC = max(NIRNEC,NIRADU+ISTKI+ + & min(NCB,LOCAL_M)+ min(NCB,LOCAL_N)+SIZEHEADER) + NIRNEC_OOC = max(NIRNEC_OOC,NIRADU_OOC+ISTKI_OOC+ + & min(NCB,LOCAL_M)+ min(NCB,LOCAL_N)+SIZEHEADER) + ENDIF + IF (CONCERNED) THEN + IF (LEVELF.EQ.2) THEN + IF (UPDATE.AND.(LEVEL.NE.2.OR..NOT.MASTER)) THEN + IF(MASTERF)THEN + NBR = min(NBROWMAXF,NBROWMAX) + ELSE + NBR = min(max(NELIMF,NBROWMAXF),NBROWMAX) + ENDIF + IF (KEEP(50).EQ.0) THEN + CBMAXS = int(NBR,8)*int(NCB,8) + ELSE + CBMAXS = int(NBR,8)*int(NCB,8) - + & (int(NBR,8)*int(NBR-1,8))/2_8 + ENDIF + ELSE + CBMAXS = 0_8 + END IF + IF (MASTERF) THEN + IF (LEVEL.EQ.1) THEN + IF (.NOT.UPDATE) THEN + NBR = min(NELIMF, NCB) + ELSE + NBR = 0 + ENDIF + ELSE + NBR = min(NELIMF, NBROWMAX) + ENDIF + IF (KEEP(50).EQ.0) THEN + CBMAXR = int(NBR,8)*NCB8 + ELSE + CBMAXR = int(NBR,8)*int(min(NCB,NELIMF),8)- + & (int(NBR,8)*int(NBR-1,8))/2_8 + CBMAXR = min(CBMAXR, int(NELIMF,8)*int(NELIMF+1,8)/2_8) + CBMAXR = min(CBMAXR, SIZECB) + IF ((LEVEL.EQ.1).AND.(.NOT. COMPRESSCB)) THEN + CBMAXR = min(CBMAXR,(NCB8*(NCB8+1_8))/2_8) + ENDIF + ENDIF + ELSE IF (UPDATEF) THEN + NBR = min(NBROWMAXF,NBROWMAX) + CBMAXR = int(NBR,8) * NCB8 + IF (KEEP(50).NE.0) THEN + CBMAXR = CBMAXR - (int(NBR,8)*(int(NBR-1,8)))/2_8 + ENDIF + ELSE + CBMAXR = 0_8 + ENDIF + ELSEIF (LEVELF.EQ.3) THEN + CBMAXR = LEV3MAXREC + IF (UPDATE.AND. .NOT. (MASTER.AND.LEVEL.EQ.2)) THEN + CBMAXS = LEV3MAXREC + ELSE + CBMAXS = 0_8 + ENDIF + ELSE + IF (MASTERF) THEN + CBMAXS = 0_8 + NBR = min(NFRF,NBROWMAX) + IF ((LEVEL.EQ.1).AND.UPDATE) THEN + NBR = 0 + ENDIF + CBMAXR = int(NBR,8)*int(min(NFRF,NCB),8) + IF (LEVEL.EQ.2) + & CBMAXR = min(CBMAXR, SIZECB_SLAVE) + IF ( KEEP(50).NE.0 ) THEN + CBMAXR = min(CBMAXR,(int(NFRF,8)*int(NFRF+1,8))/2_8) + ELSE + CBMAXR = min(CBMAXR,int(NFRF,8)*int(NFRF,8)) + ENDIF + ELSE + CBMAXR = 0_8 + CBMAXS = SIZECB + ENDIF + ENDIF + IF (UPDATE) THEN + CBMAXS = min(CBMAXS, SIZECB) + IF ( .not. ( LEVELF .eq. 1 .AND. UPDATEF ) )THEN + SBUFS_CB = max(SBUFS_CB, CBMAXS+int(SIZECBI,8)) + ENDIF + ENDIF + STACKCB = .FALSE. + IF (UPDATEF) THEN + STACKCB = .TRUE. + SIZECBI = 2 * NFR + SIZEHEADER + IF (LEVEL.EQ.1) THEN + IF (KEEP(50).NE.0.AND.LEVELF.NE.3 + & .AND.COMPRESSCB) THEN + SIZECB = (NCB8*(NCB8+1_8))/2_8 + ELSE + SIZECB = NCB8*NCB8 + ENDIF + IF (MASTER) THEN + SIZECBI = 2+ XSIZE_IC + ELSE IF (LEVELF.EQ.1) THEN + SIZECB = min(CBMAXR,SIZECB) + SIZECBI = 2 * NCB + 9 + SBUFR_CB = max(SBUFR_CB, int(SIZECBI,8)+SIZECB) + SIZECBI = 2 * NCB + SIZEHEADER + ELSE + SIZECBI = 2 * NCB + 9 + SBUFR_CB = max(SBUFR_CB, + & min(SIZECB,CBMAXR) + int(SIZECBI,8)) + MAXTEMPCB = max(MAXTEMPCB, min(SIZECB,CBMAXR)) + SIZECBI = 2 * NCB + SIZEHEADER + MAXITEMPCB = max(MAXITEMPCB, SIZECBI) + SIZECBI = 0 + SIZECB = 0_8 + ENDIF + ELSE + SIZECB = SIZECB_SLAVE + MAXTEMPCB = max(MAXTEMPCB, min(CBMAXR,SIZECB) ) + MAXITEMPCB = max(MAXITEMPCB,NBROWMAX+NCB+SIZEHEADER) + IF (.NOT. + & (UPDATE.AND.(.NOT.MASTER).AND.(NSLAVES_LOC.EQ.1)) + & ) + & SBUFR_CB = max(SBUFR_CB, + & min(CBMAXR,SIZECB) + int(NBROWMAX + NCB + 6,8)) + IF (MASTER) THEN + SIZECBI = NCB + 5 + SLAVEF - 1 + XSIZE_IC + SIZECB = 0_8 + ELSE IF (UPDATE) THEN + SIZECBI = NFR + 6 + SLAVEF - 1 + XSIZE_IC + IF (KEEP(50).EQ.0) THEN + SIZECBI = SIZECBI + NBROWMAX + NFR + + & SIZEHEADER + ELSE + SIZECBI = SIZECBI + NBROWMAX + NFR + + & SIZEHEADER+ NSLAVES_LOC + ENDIF + ELSE + SIZECB = 0_8 + SIZECBI = 0 + ENDIF + ENDIF + ELSE + IF (LEVELF.NE.3) THEN + STACKCB = .TRUE. + SIZECB = 0_8 + SIZECBI = 0 + IF ( (LEVEL.EQ.1) .AND. (LEVELF.NE.1) ) THEN + IF (COMPRESSCB) THEN + SIZECB = (NCB8*(NCB8+1_8))/2_8 + ELSE + SIZECB = NCB8*NCB8 + ENDIF + SIZECBI = 2 * NCB + SIZEHEADER + ELSE IF (LEVEL.EQ.2) THEN + IF (MASTER) THEN + SIZECBI = NCB + 5 + SLAVEF - 1 + XSIZE_IC + ELSE + SIZECB = SIZECB_SLAVE + SIZECBI = SIZECBI + NBROWMAX + NFR + SIZEHEADER + ENDIF + ENDIF + ENDIF + ENDIF + IF (STACKCB) THEN + IF (FRERE(STEP(INODE)).EQ.0) THEN + write(*,*) ' ERROR 3 in ZMUMPS_246' + CALL MUMPS_ABORT() + ENDIF + ITOP = ITOP + 1 + IF ( ITOP .GT. NSTEPS ) THEN + WRITE(*,*) 'ERROR 4 in ZMUMPS_246 ' + ENDIF + LSTKI(ITOP) = SIZECBI + ISTKI=ISTKI + SIZECBI + ISTKI_OOC = ISTKI_OOC + SIZECBI + (XSIZE_OOC-XSIZE_IC) + LSTKR(ITOP) = SIZECB + ISTKR = ISTKR + LSTKR(ITOP) + NRLNEC = max(NRLNEC,NRLADU+ISTKR+MAXTEMPCB) + NIRNEC = max0(NIRNEC,NIRADU+ISTKI+MAXITEMPCB) + NIRNEC_OOC = max0(NIRNEC_OOC,NIRADU_OOC+ISTKI_OOC+ + & MAXITEMPCB + + & (XSIZE_OOC-XSIZE_IC) ) + ENDIF + ENDIF + TNSTK(STEP(IFATH)) = TNSTK(STEP(IFATH)) - 1 + IF ( TNSTK(STEP(IFATH)) .EQ. 0 ) THEN + INODE = IFATH + GOTO 95 + ELSE + GOTO 90 + ENDIF + ENDIF + 115 CONTINUE + BLOCKING_RHS = KEEP(84) + IF (KEEP(84).EQ.0) BLOCKING_RHS=1 + NRLNEC = max(NRLNEC, + & NRLADU+int(4*KEEP(127)*abs(BLOCKING_RHS),8)) + IF (BLOCKING_RHS .LT. 0) THEN + BLOCKING_RHS = - 2 * BLOCKING_RHS + ENDIF + NRLNEC_ACTIVE = max(NRLNEC_ACTIVE, MAX_SIZE_FACTOR+ + & int(4*KEEP(127)*BLOCKING_RHS,8)) + SBUF_RECOLD = max(int(SBUFR,8),SBUFR_CB) + SBUF_RECOLD = max(SBUF_RECOLD, + & MAXTEMPCB+int(MAXITEMPCB,8)) + 10_8 + SBUF_REC = max(SBUFR, int(min(100000_8,SBUFR_CB))) + SBUF_REC = SBUF_REC + 17 + SBUF_REC = SBUF_REC + 2 * KEEP(127) + SLAVEF - 1 + 7 + SBUF_SEND = max(SBUFS, int(min(100000_8,SBUFR_CB))) + SBUF_SEND = SBUF_SEND + 17 + IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN + SBUF_RECOLD = SBUF_RECOLD+int(KEEP(108)+1,8) + SBUF_REC = SBUF_REC+KEEP(108)+1 + SBUF_SEND = SBUF_SEND+KEEP(108)+1 + ENDIF + IF (SLAVEF.EQ.1) THEN + SBUF_RECOLD = 1_8 + SBUF_REC = 1 + SBUF_SEND= 1 + ENDIF + DEALLOCATE( LSTKR, TNSTK, IPOOL, + & LSTKI ) + OPS_SUBTREE = dble(OPS_SBTR_LOC) + OPSA = dble(OPSA_LOC) + KEEP(66) = int(OPSA_LOC/1000000.d0) + RETURN + END SUBROUTINE ZMUMPS_246 + RECURSIVE SUBROUTINE + & ZMUMPS_271( COMM_LOAD, ASS_IRECV, + & INODE, NELIM_ROOT, root, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mpif.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER KEEP(500), ICNTL( 40 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER INODE, NELIM_ROOT + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) ) + INTEGER NBPROCFILS(KEEP(28)) + INTEGER IFLAG, IERROR, COMM + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER MYID, SLAVEF, NBFIN + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INCLUDE 'mumps_tags.h' + INTEGER I, LCONT, NCOL_TO_SEND, LDA + INTEGER(8) :: SHIFT_VAL_SON, POSELT + INTEGER FPERE, IOLDPS, NFRONT, NPIV, NASS, NSLAVES, + & H_INODE, NELIM, NBCOL, LIST_NELIM_ROW, + & LIST_NELIM_COL, NELIM_LOCAL, TYPE_SON, + & NROW, NCOL, NBROW, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON, LDAFS, IERR, + & STATUS( MPI_STATUS_SIZE ), ISON, PDEST_MASTER_ISON + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER MSGSOU, MSGTAG + LOGICAL INVERT + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275, MUMPS_330 + EXTERNAL MUMPS_275, MUMPS_330 + FPERE = KEEP(38) + TYPE_SON = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF ( MUMPS_275( PROCNODE_STEPS(STEP(INODE)), + & SLAVEF ).EQ.MYID) THEN + IOLDPS = PTLUST_S(STEP(INODE)) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) + NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) + H_INODE = 6 + NSLAVES + KEEP(IXSZ) + NELIM = NASS - NPIV + NBCOL = NFRONT - NPIV + LIST_NELIM_ROW = IOLDPS + H_INODE + NPIV + LIST_NELIM_COL = LIST_NELIM_ROW + NFRONT + IF (NELIM.LE.0) THEN + write(6,*) ' ERROR 1 in ZMUMPS_271 ', NELIM + write(6,*) MYID,':Process root2son: INODE=',INODE, + & 'Header=',IW(PTLUST_S(STEP(INODE)):PTLUST_S(STEP(INODE)) + & +5+KEEP(IXSZ)) + CALL MUMPS_ABORT() + ENDIF + NELIM_LOCAL = NELIM_ROOT + DO I=1, NELIM + root%RG2L_ROW(IW(LIST_NELIM_ROW)) = NELIM_LOCAL + root%RG2L_COL(IW(LIST_NELIM_COL)) = NELIM_LOCAL + NELIM_LOCAL = NELIM_LOCAL + 1 + LIST_NELIM_ROW = LIST_NELIM_ROW + 1 + LIST_NELIM_COL = LIST_NELIM_COL + 1 + ENDDO + NBROW = NFRONT - NPIV + NROW = NELIM + IF ( KEEP( 50 ) .eq. 0 ) THEN + NCOL = NFRONT - NPIV + ELSE + NCOL = NELIM + END IF + SHIFT_LIST_ROW_SON = H_INODE + NPIV + SHIFT_LIST_COL_SON = H_INODE + NFRONT + NPIV + IF ( KEEP(50).eq.0 .OR. TYPE_SON .eq. 1 ) THEN + LDAFS = NFRONT + ELSE + LDAFS = NASS + END IF + SHIFT_VAL_SON = int(NPIV,8) * int(LDAFS,8) + int(NPIV,8) + CALL ZMUMPS_80( COMM_LOAD, + & ASS_IRECV, + & N, INODE, FPERE, + & PTLUST_S(1), PTRAST(1), + & root, NROW, NCOL, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDAFS, + & ROOT_NON_ELIM_CB, MYID, COMM, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S(1), PTRFAC(1), PTRAST(1), + & STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0 ) RETURN + IF (TYPE_SON.EQ.1) THEN + NROW = NFRONT - NASS + NCOL = NELIM + SHIFT_LIST_ROW_SON = H_INODE + NASS + SHIFT_LIST_COL_SON = H_INODE + NFRONT + NPIV + SHIFT_VAL_SON = int(NASS,8) * int(NFRONT,8) + int(NPIV,8) + IF ( KEEP( 50 ) .eq. 0 ) THEN + INVERT = .FALSE. + ELSE + INVERT = .TRUE. + END IF + CALL ZMUMPS_80( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTLUST_S, PTRAST, + & root, NROW, NCOL, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT, + & ROOT_NON_ELIM_CB, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0 ) RETURN + ENDIF + IOLDPS = PTLUST_S(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE) + PTRFAC(STEP(INODE))=POSELT + IF ( TYPE_SON .eq. 1 ) THEN + NBROW = NFRONT - NPIV + ELSE + NBROW = NELIM + END IF + IF ( TYPE_SON .eq. 1 .OR. KEEP(50).EQ.0) THEN + LDA = NFRONT + ELSE + LDA = NPIV+NBROW + ENDIF + CALL ZMUMPS_324(A(POSELT), LDA, + & NPIV, NBROW, KEEP(50)) + IW(IOLDPS + KEEP(IXSZ)) = NBCOL + IW(IOLDPS + 1 +KEEP(IXSZ)) = NASS - NPIV + IF (TYPE_SON.EQ.2) THEN + IW(IOLDPS + 2 +KEEP(IXSZ)) = NASS + ELSE + IW(IOLDPS + 2 +KEEP(IXSZ)) = NFRONT + ENDIF + IW(IOLDPS + 3 +KEEP(IXSZ)) = NPIV + CALL ZMUMPS_93(0_8,MYID,N,IOLDPS,TYPE_SON,IW,LIW, + & A, LA, POSFAC, LRLU, LRLUS, + & IWPOS, PTRAST,PTRFAC,STEP, KEEP,KEEP8, .FALSE.,INODE,IERR) + IF(IERR.LT.0)THEN + IFLAG=IERR + IERROR=0 + RETURN + ENDIF + ELSE + ISON = INODE + PDEST_MASTER_ISON = + & MUMPS_275(PROCNODE_STEPS(STEP(ISON)), SLAVEF) + DO WHILE ( PTRIST(STEP(ISON)) .EQ. 0) + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & PDEST_MASTER_ISON, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) RETURN + ENDDO + DO WHILE ( + & ( IW( PTRIST(STEP(ISON)) + 1 +KEEP(IXSZ)) .NE. + & IW( PTRIST(STEP(ISON)) + 3 +KEEP(IXSZ)) ) .OR. + & ( KEEP(50) .NE. 0 .AND. + & IW( PTRIST(STEP(ISON)) + 6 +KEEP(IXSZ)) .NE. 0 ) ) + IF ( KEEP(50).eq.0) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO + ELSE + IF ( IW( PTRIST(STEP(ISON)) + 1 +KEEP(IXSZ)) .NE. + & IW( PTRIST(STEP(ISON)) + 3 +KEEP(IXSZ)) ) THEN + MSGSOU = PDEST_MASTER_ISON + MSGTAG = BLOC_FACTO_SYM + ELSE + MSGSOU = MPI_ANY_SOURCE + MSGTAG = BLOC_FACTO_SYM_SLAVE + END IF + END IF + BLOCKING = .TRUE. + SET_IRECV = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MSGTAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR, + & NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) RETURN + END DO + IOLDPS = PTRIST(STEP(INODE)) + LCONT = IW(IOLDPS+KEEP(IXSZ)) + NROW = IW(IOLDPS+2+KEEP(IXSZ)) + NPIV = IW(IOLDPS+3+KEEP(IXSZ)) + NASS = IW(IOLDPS+4+KEEP(IXSZ)) + NELIM = NASS-NPIV + IF (NELIM.LE.0) THEN + write(6,*) MYID,': INODE,LCONT, NROW, NPIV, NASS, NELIM=', + & INODE,LCONT, NROW, NPIV, NASS, NELIM + write(6,*) MYID,': IOLDPS=',IOLDPS + write(6,*) MYID,': ERROR 2 in ZMUMPS_271 ' + CALL MUMPS_ABORT() + ENDIF + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + H_INODE = 6 + NSLAVES + KEEP(IXSZ) + LIST_NELIM_COL = IOLDPS + H_INODE + NROW + NPIV + NELIM_LOCAL = NELIM_ROOT + DO I = 1, NELIM + root%RG2L_COL(IW(LIST_NELIM_COL)) = NELIM_LOCAL + root%RG2L_ROW(IW(LIST_NELIM_COL)) = NELIM_LOCAL + NELIM_LOCAL = NELIM_LOCAL + 1 + LIST_NELIM_COL = LIST_NELIM_COL + 1 + ENDDO + SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NPIV + NCOL_TO_SEND = NELIM + IF (IW(IOLDPS+XXS).EQ.S_NOLCBNOCONTIG38.OR. + & IW(IOLDPS+XXS).EQ.S_ALL) THEN + SHIFT_VAL_SON = int(NPIV,8) + LDA = LCONT + NPIV + ELSE IF (IW(IOLDPS+XXS).EQ.S_NOLCBCONTIG38) THEN + SHIFT_VAL_SON = int(NROW,8)*int(LCONT+NPIV-NELIM,8) + LDA = NELIM + ELSE IF (IW(IOLDPS+XXS).EQ.S_NOLCLEANED38) THEN + SHIFT_VAL_SON=0_8 + LDA = NELIM + ELSE + write(*,*) MYID,": internal error in ZMUMPS_271", + & IW(IOLDPS+XXS), "INODE=",INODE + CALL MUMPS_ABORT() + ENDIF + IF ( KEEP( 50 ) .eq. 0 ) THEN + INVERT = .FALSE. + ELSE + INVERT = .TRUE. + END IF + CALL ZMUMPS_80( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTRIST, PTRAST, + & root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA, + & ROOT_NON_ELIM_CB, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0 ) RETURN + IF (KEEP(214).EQ.2) THEN + CALL ZMUMPS_314( N, INODE, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, TYPE_SON + & ) + ENDIF + IF (IFLAG.LT.0) THEN + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_271 + SUBROUTINE ZMUMPS_221(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IFLAG,IOLDPS,POSELT,UU, SEUIL,KEEP,KEEP8, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & + & PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV,NOFFW + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + DOUBLE PRECISION UU, SEUIL + INTEGER IW(LIW) + INTEGER(8) :: POSELT + INTEGER IOLDPS + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U + INCLUDE 'mumps_headers.h' + COMPLEX(kind=8) SWOP + INTEGER XSIZE + INTEGER(8) :: APOS, IDIAG + INTEGER(8) :: J1, J2, J3, JJ + INTEGER(8) :: NFRONT8 + DOUBLE PRECISION AMROW + DOUBLE PRECISION RMAX + DOUBLE PRECISION PIVNUL + COMPLEX(kind=8) FIXA, CSEUIL + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,JMAX,J,ISW,ISWPS1 + INTEGER ISWPS2,KSW + INTEGER ZMUMPS_IXAMAX + INTRINSIC max + DOUBLE PRECISION, PARAMETER :: RZERO = 0.0D0 + COMPLEX(kind=8), PARAMETER :: ZERO = (0.0D0, 0.0D0) + INTEGER I_PIVRPTR_L, I_PIVR_L, NBPANELS_L + INTEGER I_PIVRPTR_U, I_PIVR_U, NBPANELS_U + PIVNUL = DKEEP(1) + FIXA = cmplx( DKEEP(2), kind=kind(FIXA)) + CSEUIL = cmplx( SEUIL, kind=kind(CSEUIL)) + XSIZE = KEEP(IXSZ) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NFRONT8 = int(NFRONT,8) + IF (KEEP(201).EQ.1) THEN + CALL ZMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + CALL ZMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + ENDIF + NASSW = iabs(IW(IOLDPS+3+XSIZE)) + IF(INOPV .EQ. -1) THEN + APOS = POSELT + NFRONT8*int(NPIVP1-1,8) + int(NPIV,8) + IDIAG = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF(dble(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + KEEP(98) = KEEP(98)+1 + ELSE IF (KEEP(258) .NE. 0) THEN + CALL ZMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL ZMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL ZMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + NFRONT8*int(IPIV-1,8) + int(NPIV,8) + JMAX = 1 + IF (UU.GT.RZERO) GO TO 340 + IF (abs(A(APOS)).EQ.RZERO) GO TO 630 + GO TO 380 + 340 AMROW = RZERO + J1 = APOS + J2 = APOS + int(- NPIV + NASS - 1,8) + J = NASS -NPIV + JMAX = ZMUMPS_IXAMAX(J,A(J1),1) + JJ = J1 + int(JMAX - 1,8) + AMROW = abs(A(JJ)) + RMAX = AMROW + J1 = J2 + 1_8 + J2 = APOS +int(- NPIV + NFRONT - 1 - KEEP(253),8) + IF (J2.LT.J1) GO TO 370 + DO 360 JJ=J1,J2 + RMAX = max(abs(A(JJ)),RMAX) + 360 CONTINUE + 370 IDIAG = APOS + int(IPIV - NPIVP1,8) + IF ( RMAX .LE. PIVNUL ) THEN + KEEP(109) = KEEP(109)+1 + ISW = IOLDPS+IW(IOLDPS+1+XSIZE)+6+XSIZE+ + & IW(IOLDPS+5+XSIZE)+IPIV-NPIVP1 + PIVNUL_LIST(KEEP(109)) = IW(ISW) + IF(dble(FIXA).GT.RZERO) THEN + IF(dble(A(IDIAG)) .GE. RZERO) THEN + A(IDIAG) = FIXA + ELSE + A(IDIAG) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = APOS + int(- NPIV + NFRONT - 1 - KEEP(253),8) + DO JJ=J1,J2 + A(JJ) = ZERO + ENDDO + A(IDIAG) = -FIXA + ENDIF + JMAX = IPIV - NPIV + GOTO 385 + ENDIF + IF (abs(A(IDIAG)).GT. max(UU*RMAX,SEUIL)) THEN + JMAX = IPIV - NPIV + GO TO 380 + ENDIF + IF (AMROW.LE. max(UU*RMAX,SEUIL)) GO TO 460 + NOFFW = NOFFW + 1 + 380 CONTINUE + IF (KEEP(258) .NE. 0) THEN + CALL ZMUMPS_762( + & A( APOS+int(JMAX-1,8) ), + & DKEEP(6), + & KEEP(259) ) + ENDIF + 385 CONTINUE + IF (IPIV.EQ.NPIVP1) GO TO 400 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8)*NFRONT8 + J2 = J1 + NFRONT8 - 1_8 + J3 = POSELT + int(IPIV-1,8)*NFRONT8 + DO 390 JJ=J1,J2 + SWOP = A(JJ) + A(JJ) = A(J3) + A(J3) = SWOP + J3 = J3 + 1_8 + 390 CONTINUE + ISWPS1 = IOLDPS + 5 + NPIVP1 + XSIZE + ISWPS2 = IOLDPS + 5 + IPIV + XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + 400 IF (JMAX.EQ.1) GO TO 420 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8) + J2 = POSELT + int(NPIV + JMAX - 1,8) + DO 410 KSW=1,NFRONT + SWOP = A(J1) + A(J1) = A(J2) + A(J2) = SWOP + J1 = J1 + NFRONT8 + J2 = J2 + NFRONT8 + 410 CONTINUE + ISWPS1 = IOLDPS + 5 + NFRONT + NPIV + 1 +XSIZE + ISWPS2 = IOLDPS + 5 + NFRONT + NPIV + JMAX +XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + GO TO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 430 + 630 CONTINUE + IFLAG = -10 + WRITE(*,*) 'Detected a null pivot, INODE/NPIV=',INODE,NPIV + GOTO 430 + 420 CONTINUE + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL ZMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, IPIV, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL ZMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIV+JMAX, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + 430 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_221 + SUBROUTINE ZMUMPS_220(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IOLDPS,POSELT,UU,SEUIL,KEEP, DKEEP, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,INOPV + INTEGER(8) :: LA + INTEGER KEEP(500) + DOUBLE PRECISION DKEEP(30) + DOUBLE PRECISION UU, SEUIL + COMPLEX(kind=8) A(LA) + INTEGER IW(LIW) + DOUBLE PRECISION AMROW + DOUBLE PRECISION RMAX + COMPLEX(kind=8) SWOP + INTEGER(8) :: APOS, POSELT + INTEGER(8) :: J1, J2, J3_8, JJ, IDIAG + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS + INTEGER NOFFW,NPIV,IPIV + INTEGER J, J3 + INTEGER NPIVP1,JMAX,ISW,ISWPS1 + INTEGER ISWPS2,KSW,XSIZE + INTEGER I_PIVRPTR_L, I_PIVR_L, NBPANELS_L + INTEGER I_PIVRPTR_U, I_PIVR_U, NBPANELS_U + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U + INTEGER ZMUMPS_IXAMAX + INCLUDE 'mumps_headers.h' + INTRINSIC max + DOUBLE PRECISION, PARAMETER :: RZERO = 0.0D0 + NFRONT8 = int(NFRONT,8) + INOPV = 0 + XSIZE = KEEP(IXSZ) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL ZMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE) + & +KEEP(IXSZ), + & IW, LIW) + CALL ZMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + ENDIF + DO 460 IPIV=NPIVP1,NASS + APOS = POSELT + NFRONT8*int(NPIV,8) + int(IPIV-1,8) + JMAX = 1 + AMROW = RZERO + J1 = APOS + J3 = NASS -NPIV + JMAX = ZMUMPS_IXAMAX(J3,A(J1),NFRONT) + JJ = J1 + int(JMAX-1,8)*NFRONT8 + AMROW = abs(A(JJ)) + RMAX = AMROW + J1 = APOS + int(NASS-NPIV,8) * NFRONT8 + J3 = NFRONT - NASS - KEEP(253) + IF (J3.EQ.0) GOTO 370 + DO 360 J=1,J3 + RMAX = max(abs(A(J1)),RMAX) + J1 = J1 + NFRONT8 + 360 CONTINUE + 370 IF (RMAX.EQ.RZERO) GO TO 460 + IDIAG = APOS + int(IPIV - NPIVP1,8)*NFRONT8 + IF (abs(A(IDIAG)).GE.max(UU*RMAX,SEUIL)) THEN + JMAX = IPIV - NPIV + GO TO 380 + ENDIF + IF (AMROW.LT.max(UU*RMAX,SEUIL)) GO TO 460 + NOFFW = NOFFW + 1 + 380 CONTINUE + IF (KEEP(258) .NE. 0) THEN + CALL ZMUMPS_762( + & A(APOS + int(JMAX - 1,8) * NFRONT8 ), + & DKEEP(6), + & KEEP(259) ) + ENDIF + IF (IPIV.EQ.NPIVP1) GO TO 400 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8) + J3_8 = POSELT + int(IPIV-1,8) + DO 390 J= 1,NFRONT + SWOP = A(J1) + A(J1) = A(J3_8) + A(J3_8) = SWOP + J1 = J1 + NFRONT8 + J3_8 = J3_8 + NFRONT8 + 390 CONTINUE + ISWPS1 = IOLDPS + 5 + NPIVP1 + NFRONT + XSIZE + ISWPS2 = IOLDPS + 5 + IPIV + NFRONT + XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + 400 IF (JMAX.EQ.1) GO TO 420 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8) * NFRONT8 + J2 = POSELT + int(NPIV + JMAX - 1,8) * NFRONT8 + DO 410 KSW=1,NFRONT + SWOP = A(J1) + A(J1) = A(J2) + A(J2) = SWOP + J1 = J1 + 1_8 + J2 = J2 + 1_8 + 410 CONTINUE + ISWPS1 = IOLDPS + 5 + NPIV + 1 + XSIZE + ISWPS2 = IOLDPS + 5 + NPIV + JMAX + XSIZE + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + GO TO 420 + 460 CONTINUE + INOPV = 1 + GOTO 430 + 420 CONTINUE + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL ZMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, NPIV+JMAX, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL ZMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, IPIV, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + 430 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_220 + SUBROUTINE ZMUMPS_225(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB,LKJIB,LKJIT,XSIZE) + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFINB,LKJIB,IBEG_BLOCK + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER IW(LIW) + COMPLEX(kind=8) VALPIV + INTEGER(8) :: APOS, POSELT, UUPOS, LPOS + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS + INTEGER LKJIT, XSIZE + COMPLEX(kind=8) ONE, ALPHA + INTEGER NPIV,JROW2 + INTEGER NEL2,NPIVP1,KROW,NEL + INCLUDE 'mumps_headers.h' + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + NFRONT8= int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NEL = NFRONT - NPIVP1 + IFINB = 0 + IF (IW(IOLDPS+3+XSIZE).LE.0) THEN + IF (NASS.LT.LKJIT) THEN + IW(IOLDPS+3+XSIZE) = NASS + ELSE + IW(IOLDPS+3+XSIZE) = min0(NASS,LKJIB) + ENDIF + ENDIF + JROW2 = IW(IOLDPS+3+XSIZE) + NEL2 = JROW2 - NPIVP1 + IF (NEL2.EQ.0) THEN + IF (JROW2.EQ.NASS) THEN + IFINB = -1 + ELSE + IFINB = 1 + IW(IOLDPS+3+XSIZE) = min0(JROW2+LKJIB,NASS) + IBEG_BLOCK = NPIVP1+1 + ENDIF + ELSE + APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + VALPIV = ONE/A(APOS) + LPOS = APOS + NFRONT8 + DO 541 KROW = 1,NEL2 + A(LPOS) = A(LPOS)*VALPIV + LPOS = LPOS + NFRONT8 + 541 CONTINUE + LPOS = APOS + NFRONT8 + UUPOS = APOS + 1_8 + CALL zgeru(NEL,NEL2,ALPHA,A(UUPOS),1,A(LPOS),NFRONT, + & A(LPOS+1_8),NFRONT) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_225 + SUBROUTINE ZMUMPS_229(NFRONT,N,INODE,IW,LIW,A,LA,IOLDPS, + & POSELT,XSIZE) + IMPLICIT NONE + INTEGER NFRONT,N,INODE,LIW,XSIZE + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER IW(LIW) + COMPLEX(kind=8) ALPHA,VALPIV + INTEGER(8) :: APOS, POSELT, UUPOS + INTEGER(8) :: NFRONT8, LPOS, IRWPOS + INTEGER IOLDPS,NPIV,NEL + INTEGER JROW + INCLUDE 'mumps_headers.h' + COMPLEX(kind=8), PARAMETER :: ONE=(1.0D0,0.0D0) + NFRONT8= int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NEL = NFRONT - NPIV - 1 + APOS = POSELT + int(NPIV,8) * NFRONT8 + int(NPIV,8) + IF (NEL.EQ.0) GO TO 650 + VALPIV = ONE/A(APOS) + LPOS = APOS + NFRONT8 + DO 340 JROW = 1,NEL + A(LPOS) = VALPIV*A(LPOS) + LPOS = LPOS + NFRONT8 + 340 CONTINUE + LPOS = APOS + NFRONT8 + UUPOS = APOS+1_8 + DO 440 JROW = 1,NEL + IRWPOS = LPOS + 1_8 + ALPHA = -A(LPOS) + CALL zaxpy(NEL,ALPHA,A(UUPOS),1,A(IRWPOS),1) + LPOS = LPOS + NFRONT8 + 440 CONTINUE + 650 RETURN + END SUBROUTINE ZMUMPS_229 + SUBROUTINE ZMUMPS_228(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,IFINB,XSIZE) + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER NFRONT,NASS,N,LIW,INODE,IFINB + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER IW(LIW) + COMPLEX(kind=8) ALPHA,VALPIV + INTEGER(8) :: APOS, POSELT, UUPOS, LPOS, IRWPOS + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS,NPIV,KROW, XSIZE + INTEGER NEL,ICOL,NEL2 + INTEGER NPIVP1 + COMPLEX(kind=8), PARAMETER :: ONE=(1.0D0,0.0D0) + NFRONT8=int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NEL = NFRONT - NPIVP1 + NEL2 = NASS - NPIVP1 + IFINB = 0 + IF (NPIVP1.EQ.NASS) IFINB = 1 + APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + VALPIV = ONE/A(APOS) + LPOS = APOS + NFRONT8 + DO 541 KROW = 1,NEL + A(LPOS) = A(LPOS)*VALPIV + LPOS = LPOS + NFRONT8 + 541 CONTINUE + LPOS = APOS + NFRONT8 + UUPOS = APOS + 1_8 + DO 440 ICOL = 1,NEL + IRWPOS = LPOS + 1_8 + ALPHA = -A(LPOS) + CALL zaxpy(NEL2,ALPHA,A(UUPOS),1,A(IRWPOS),1) + LPOS = LPOS + NFRONT8 + 440 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_228 + SUBROUTINE ZMUMPS_231(A,LA,NFRONT, + & NPIV,NASS,POSELT) + IMPLICIT NONE + INTEGER(8) :: LA,POSELT + COMPLEX(kind=8) A(LA) + INTEGER NFRONT, NPIV, NASS + INTEGER(8) :: LPOS, LPOS1, LPOS2 + INTEGER NEL1,NEL11 + COMPLEX(kind=8) ALPHA, ONE + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + NEL1 = NFRONT - NASS + NEL11 = NFRONT - NPIV + LPOS2 = POSELT + int(NASS,8)*int(NFRONT,8) + CALL ztrsm('L','L','N','N',NPIV,NEL1,ONE,A(POSELT),NFRONT, + & A(LPOS2),NFRONT) + LPOS = LPOS2 + int(NPIV,8) + LPOS1 = POSELT + int(NPIV,8) + CALL zgemm('N','N',NEL11,NEL1,NPIV,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE ZMUMPS_231 + SUBROUTINE ZMUMPS_642(A,LAFAC,NFRONT, + & NPIV,NASS, IW, LIWFAC, + & MonBloc, TYPEFile, MYID, KEEP8, + & STRAT, IFLAG_OOC, + & LNextPiv2beWritten, UNextPiv2beWritten) + USE ZMUMPS_OOC + IMPLICIT NONE + INTEGER NFRONT, NPIV, NASS + INTEGER(8) :: LAFAC + INTEGER LIWFAC, TYPEFile, MYID, IFLAG_OOC, + & LNextPiv2beWritten, UNextPiv2beWritten, STRAT + COMPLEX(kind=8) A(LAFAC) + INTEGER IW(LIWFAC) + INTEGER(8) KEEP8(150) + TYPE(IO_BLOCK) :: MonBloc + INTEGER(8) :: LPOS2,LPOS1,LPOS + INTEGER NEL1,NEL11 + COMPLEX(kind=8) ALPHA, ONE + LOGICAL LAST_CALL + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + NEL1 = NFRONT - NASS + NEL11 = NFRONT - NPIV + LPOS2 = 1_8 + int(NASS,8) * int(NFRONT,8) + CALL ztrsm('L','L','N','N',NPIV,NEL1,ONE,A(1),NFRONT, + & A(LPOS2),NFRONT) + LAST_CALL=.FALSE. + CALL ZMUMPS_688 + & ( STRAT, TYPEFile, + & A, LAFAC, MonBloc, + & LNextPiv2beWritten, UNextPiv2beWritten, + & IW, LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + LPOS = LPOS2 + int(NPIV,8) + LPOS1 = int(1 + NPIV,8) + CALL zgemm('N','N',NEL11,NEL1,NPIV,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE ZMUMPS_642 + SUBROUTINE ZMUMPS_232(A,LA,NFRONT,NPIV,NASS,POSELT,LKJIB) + INTEGER NFRONT, NPIV, NASS, LKJIB + INTEGER (8) :: POSELT, LA + COMPLEX(kind=8) A(LA) + INTEGER(8) :: POSELT_LOCAL, LPOS, LPOS1, LPOS2 + INTEGER NEL1, NEL11, NPBEG + COMPLEX(kind=8) ALPHA, ONE + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + POSELT_LOCAL = POSELT + NEL1 = NASS - NPIV + NPBEG = NPIV - LKJIB + 1 + NEL11 = NFRONT - NPIV + LPOS2 = POSELT_LOCAL + int(NPIV,8)*int(NFRONT,8) + & + int(NPBEG - 1,8) + POSELT_LOCAL = POSELT_LOCAL + int(NPBEG-1,8)*int(NFRONT,8) + & + int(NPBEG-1,8) + CALL ztrsm('L','L','N','N',LKJIB,NEL1,ONE,A(POSELT_LOCAL), + & NFRONT,A(LPOS2),NFRONT) + LPOS = LPOS2 + int(LKJIB,8) + LPOS1 = POSELT_LOCAL + int(LKJIB,8) + CALL zgemm('N','N',NEL11,NEL1,LKJIB,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE ZMUMPS_232 + SUBROUTINE ZMUMPS_233(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT,LKJIB_ORIG,LKJIB,LKJIT,XSIZE ) + IMPLICIT NONE + INTEGER NFRONT, NASS,N,LIW + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER IW(LIW) + INTEGER LKJIB_ORIG,LKJIB, INODE, IBEG_BLOCK + INTEGER(8) :: POSELT, LPOS, LPOS1, LPOS2, POSLOCAL + INTEGER(8) :: IPOS, KPOS + INTEGER(8) :: NFRONT8 + INTEGER IOLDPS, NPIV, JROW2, NPBEG + INTEGER NONEL, LKJIW, NEL1, NEL11 + INTEGER LBP, HF + INTEGER LBPT,I1,K1,II,ISWOP,LBP1 + INTEGER LKJIT, XSIZE + INCLUDE 'mumps_headers.h' + COMPLEX(kind=8) ALPHA, ONE + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + NFRONT8=int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + JROW2 = iabs(IW(IOLDPS+3+XSIZE)) + NPBEG = IBEG_BLOCK + HF = 6 + IW(IOLDPS+5+XSIZE) +XSIZE + NONEL = JROW2 - NPIV + 1 + IF ((NASS-NPIV).GE.LKJIT) THEN + LKJIB = LKJIB_ORIG + NONEL + IW(IOLDPS+3+XSIZE)= min0(NPIV+LKJIB,NASS) + ELSE + IW(IOLDPS+3+XSIZE) = NASS + ENDIF + IBEG_BLOCK = NPIV + 1 + NEL1 = NASS - JROW2 + LKJIW = NPIV - NPBEG + 1 + NEL11 = NFRONT - NPIV + IF ((NEL1.NE.0).AND.(LKJIW.NE.0)) THEN + LPOS2 = POSELT + int(JROW2,8)*NFRONT8 + + & int(NPBEG - 1,8) + POSLOCAL = POSELT + int(NPBEG-1,8)*NFRONT8 + int(NPBEG - 1,8) + CALL ztrsm('L','L','N','N',LKJIW,NEL1,ONE, + & A(POSLOCAL),NFRONT, + & A(LPOS2),NFRONT) + LPOS = LPOS2 + int(LKJIW,8) + LPOS1 = POSLOCAL + int(LKJIW,8) + CALL zgemm('N','N',NEL11,NEL1,LKJIW,ALPHA,A(LPOS1), + & NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_233 + SUBROUTINE ZMUMPS_236(A,LA,NPIVB,NFRONT, + & NPIV,NASS,POSELT) + IMPLICIT NONE + INTEGER NPIVB,NASS + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER(8) :: APOS, POSELT + INTEGER NFRONT, NPIV, NASSL + INTEGER(8) :: LPOS, LPOS1, LPOS2 + INTEGER NEL1, NEL11, NPIVE + COMPLEX(kind=8) ALPHA, ONE + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + NEL1 = NFRONT - NASS + NEL11 = NFRONT - NPIV + NPIVE = NPIV - NPIVB + NASSL = NASS - NPIVB + APOS = POSELT + int(NPIVB,8)*int(NFRONT,8) + & + int(NPIVB,8) + LPOS2 = APOS + int(NASSL,8) + CALL ztrsm('R','U','N','U',NEL1,NPIVE,ONE,A(APOS),NFRONT, + & A(LPOS2),NFRONT) + LPOS = LPOS2 + int(NFRONT,8)*int(NPIVE,8) + LPOS1 = APOS + int(NFRONT,8)*int(NPIVE,8) + CALL zgemm('N','N',NEL1,NEL11,NPIVE,ALPHA,A(LPOS2), + & NFRONT,A(LPOS1),NFRONT,ONE,A(LPOS),NFRONT) + RETURN + END SUBROUTINE ZMUMPS_236 + SUBROUTINE ZMUMPS_217(N, NZ, NSCA, + & ASPK, IRN, ICN, COLSCA, ROWSCA, WK, LWK, WK_REAL, + & LWK_REAL, ICNTL, INFO) + IMPLICIT NONE + INTEGER N, NZ, NSCA + INTEGER IRN(NZ), ICN(NZ) + INTEGER ICNTL(40), INFO(40) + COMPLEX(kind=8) ASPK(NZ) + DOUBLE PRECISION COLSCA(*), ROWSCA(*) + INTEGER LWK, LWK_REAL + COMPLEX(kind=8) WK(LWK) + DOUBLE PRECISION WK_REAL(LWK_REAL) + INTEGER MPG,LP + INTEGER IWNOR + INTEGER I, K + LOGICAL PROK + DOUBLE PRECISION ONE + PARAMETER( ONE = 1.0D0 ) + LP = ICNTL(1) + MPG = ICNTL(2) + MPG = ICNTL(3) + PROK = (MPG.GT.0) + IF (PROK) WRITE(MPG,101) + 101 FORMAT(/' ****** SCALING OF ORIGINAL MATRIX '/) + IF (NSCA.EQ.1) THEN + IF (PROK) + & WRITE (MPG,*) ' DIAGONAL SCALING ' + ELSEIF (NSCA.EQ.2) THEN + IF (PROK) + & WRITE (MPG,*) ' SCALING BASED ON (MC29)' + ELSEIF (NSCA.EQ.3) THEN + IF (PROK) + & WRITE (MPG,*) ' COLUMN SCALING' + ELSEIF (NSCA.EQ.4) THEN + IF (PROK) + & WRITE (MPG,*) ' ROW AND COLUMN SCALING (1 Pass)' + ELSEIF (NSCA.EQ.5) THEN + IF (PROK) + & WRITE (MPG,*) ' MC29 FOLLOWED BY ROW &COL SCALING' + ELSEIF (NSCA.EQ.6) THEN + IF (PROK) + & WRITE (MPG,*) ' MC29 FOLLOWED BY COLUMN SCALING' + ENDIF + DO 10 I=1,N + COLSCA(I) = ONE + ROWSCA(I) = ONE + 10 CONTINUE + IF ((NSCA.EQ.5).OR. + & (NSCA.EQ.6)) THEN + IF (NZ.GT.LWK) GOTO 400 + DO 15 K=1,NZ + WK(K) = ASPK(K) + 15 CONTINUE + ENDIF + IF (5*N.GT.LWK_REAL) GOTO 410 + IWNOR = 1 + IF (NSCA.EQ.1) THEN + CALL ZMUMPS_238(N,NZ,ASPK,IRN,ICN, + & COLSCA,ROWSCA,MPG) + ELSEIF (NSCA.EQ.2) THEN + CALL ZMUMPS_239(N,NZ,ASPK,IRN,ICN, + & ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA) + ELSEIF (NSCA.EQ.3) THEN + CALL ZMUMPS_241(N,NZ,ASPK,IRN,ICN,WK_REAL(IWNOR), + & COLSCA, MPG) + ELSEIF (NSCA.EQ.4) THEN + CALL ZMUMPS_287(N,NZ,IRN,ICN,ASPK, + & WK_REAL(IWNOR),WK_REAL(IWNOR+N),COLSCA,ROWSCA,MPG) + ELSEIF (NSCA.EQ.5) THEN + CALL ZMUMPS_239(N,NZ,WK,IRN,ICN, + & ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA) + CALL ZMUMPS_241(N,NZ,WK,IRN,ICN,WK_REAL(IWNOR), + & COLSCA, MPG) + ELSEIF (NSCA.EQ.6) THEN + CALL ZMUMPS_239(N,NZ,WK,IRN,ICN, + & ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA) + CALL ZMUMPS_240(NSCA,N,NZ,IRN,ICN,WK, + & WK_REAL(IWNOR+N),ROWSCA,MPG) + CALL ZMUMPS_241(N,NZ,WK,IRN,ICN, + & WK_REAL(IWNOR), COLSCA, MPG) + ENDIF + GOTO 500 + 400 INFO(1) = -5 + INFO(2) = NZ-LWK + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) + & WRITE(LP,*) '*** ERROR: Not enough space to scale matrix' + GOTO 500 + 410 INFO(1) = -5 + INFO(2) = 5*N-LWK_REAL + IF ((LP.GT.0).AND.(ICNTL(4).GE.1)) + & WRITE(LP,*) '*** ERROR: Not enough space to scale matrix' + GOTO 500 + 500 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_217 + SUBROUTINE ZMUMPS_287(N,NZ,IRN,ICN,VAL, + & RNOR,CNOR,COLSCA,ROWSCA,MPRINT) + INTEGER N, NZ + COMPLEX(kind=8) VAL(NZ) + DOUBLE PRECISION RNOR(N),CNOR(N) + DOUBLE PRECISION COLSCA(N),ROWSCA(N) + DOUBLE PRECISION CMIN,CMAX,RMIN,ARNOR,ACNOR + INTEGER IRN(NZ), ICN(NZ) + DOUBLE PRECISION VDIAG + INTEGER MPRINT + INTEGER I,J,K + DOUBLE PRECISION ZERO, ONE + PARAMETER(ZERO=0.0D0, ONE=1.0D0) + DO 50 J=1,N + CNOR(J) = ZERO + RNOR(J) = ZERO + 50 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.LE.0).OR.(I.GT.N).OR. + & (J.LE.0).OR.(J.GT.N)) GOTO 100 + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.CNOR(J)) THEN + CNOR(J) = VDIAG + ENDIF + IF (VDIAG.GT.RNOR(I)) THEN + RNOR(I) = VDIAG + ENDIF + 100 CONTINUE + IF (MPRINT.GT.0) THEN + CMIN = CNOR(1) + CMAX = CNOR(1) + RMIN = RNOR(1) + DO 111 I=1,N + ARNOR = RNOR(I) + ACNOR = CNOR(I) + IF (ACNOR.GT.CMAX) CMAX=ACNOR + IF (ACNOR.LT.CMIN) CMIN=ACNOR + IF (ARNOR.LT.RMIN) RMIN=ARNOR + 111 CONTINUE + WRITE(MPRINT,*) '**** STAT. OF MATRIX PRIOR ROW&COL SCALING' + WRITE(MPRINT,*) ' MAXIMUM NORM-MAX OF COLUMNS:',CMAX + WRITE(MPRINT,*) ' MINIMUM NORM-MAX OF COLUMNS:',CMIN + WRITE(MPRINT,*) ' MINIMUM NORM-MAX OF ROWS :',RMIN + ENDIF + DO 120 J=1,N + IF (CNOR(J).LE.ZERO) THEN + CNOR(J) = ONE + ELSE + CNOR(J) = ONE / CNOR(J) + ENDIF + 120 CONTINUE + DO 130 J=1,N + IF (RNOR(J).LE.ZERO) THEN + RNOR(J) = ONE + ELSE + RNOR(J) = ONE / RNOR(J) + ENDIF + 130 CONTINUE + DO 110 I=1,N + ROWSCA(I) = ROWSCA(I) * RNOR(I) + COLSCA(I) = COLSCA(I) * CNOR(I) + 110 CONTINUE + IF (MPRINT.GT.0) + & WRITE(MPRINT,*) ' END OF SCALING BY MAX IN ROW AND COL' + RETURN + END SUBROUTINE ZMUMPS_287 + SUBROUTINE ZMUMPS_239(N,NZ,VAL,ROWIND,COLIND, + & RNOR,CNOR,WNOR,MPRINT,MP, + & NSCA) + INTEGER N, NZ + COMPLEX(kind=8) VAL(NZ) + DOUBLE PRECISION WNOR(5*N) + DOUBLE PRECISION RNOR(N), CNOR(N) + INTEGER COLIND(NZ),ROWIND(NZ) + INTEGER J,I,K + INTEGER MPRINT,MP,NSCA + INTEGER IFAIL9 + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0) + DO 15 I=1,N + RNOR(I) = ZERO + CNOR(I) = ZERO + 15 CONTINUE + CALL ZMUMPS_216(N,N,NZ,VAL,ROWIND,COLIND, + & RNOR,CNOR,WNOR, MP,IFAIL9) +*CVD$ NODEPCHK +*CVD$ VECTOR +*CVD$ CONCUR + DO 30 I=1,N + CNOR(I) = exp(CNOR(I)) + RNOR(I) = exp(RNOR(I)) + 30 CONTINUE + IF ((NSCA.EQ.5).OR.(NSCA.EQ.6)) THEN + DO 100 K=1,NZ + I = ROWIND(K) + J = COLIND(K) + IF (min(I,J).LT.1 .OR. I.GT.N .OR. J.GT.N) GOTO 100 + VAL(K) = VAL(K) * CNOR(J) * RNOR(I) + 100 CONTINUE + ENDIF + IF (MPRINT.GT.0) + & WRITE(MPRINT,*) ' END OF SCALING USING MC29' + RETURN + END SUBROUTINE ZMUMPS_239 + SUBROUTINE ZMUMPS_241(N,NZ,VAL,IRN,ICN, + & CNOR,COLSCA,MPRINT) + INTEGER N,NZ + COMPLEX(kind=8) VAL(NZ) + DOUBLE PRECISION CNOR(N) + DOUBLE PRECISION COLSCA(N) + INTEGER IRN(NZ), ICN(NZ) + DOUBLE PRECISION VDIAG + INTEGER MPRINT + INTEGER I,J,K + DOUBLE PRECISION ZERO, ONE + PARAMETER (ZERO=0.0D0,ONE=1.0D0) + DO 10 J=1,N + CNOR(J) = ZERO + 10 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.LE.0).OR.(I.GT.N).OR. + & (J.LE.0).OR.(J.GT.N)) GOTO 100 + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.CNOR(J)) THEN + CNOR(J) = VDIAG + ENDIF + 100 CONTINUE + DO 110 J=1,N + IF (CNOR(J).LE.ZERO) THEN + CNOR(J) = ONE + ELSE + CNOR(J) = ONE/CNOR(J) + ENDIF + 110 CONTINUE + DO 215 I=1,N + COLSCA(I) = COLSCA(I) * CNOR(I) + 215 CONTINUE + IF (MPRINT.GT.0) WRITE(MPRINT,*) ' END OF COLUMN SCALING' + RETURN + END SUBROUTINE ZMUMPS_241 + SUBROUTINE ZMUMPS_238(N,NZ,VAL,IRN,ICN, + & COLSCA,ROWSCA,MPRINT) + INTEGER N, NZ + COMPLEX(kind=8) VAL(NZ) + DOUBLE PRECISION ROWSCA(N),COLSCA(N) + INTEGER IRN(NZ),ICN(NZ) + DOUBLE PRECISION VDIAG + INTEGER MPRINT,I,J,K + INTRINSIC sqrt + DOUBLE PRECISION ZERO, ONE + PARAMETER(ZERO=0.0D0, ONE=1.0D0) + DO 10 I=1,N + ROWSCA(I) = ONE + 10 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + IF ((I.GT.N).OR.(I.LE.0)) GOTO 100 + J = ICN(K) + IF (I.EQ.J) THEN + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.ZERO) THEN + ROWSCA(J) = ONE/(sqrt(VDIAG)) + ENDIF + ENDIF + 100 CONTINUE + DO 110 I=1,N + COLSCA(I) = ROWSCA(I) + 110 CONTINUE + IF (MPRINT.GT.0) WRITE(MPRINT,*) ' END OF DIAGONAL SCALING' + RETURN + END SUBROUTINE ZMUMPS_238 + SUBROUTINE ZMUMPS_240(NSCA,N,NZ,IRN,ICN,VAL, + & RNOR,ROWSCA,MPRINT) + INTEGER N, NZ, NSCA + INTEGER IRN(NZ), ICN(NZ) + COMPLEX(kind=8) VAL(NZ) + DOUBLE PRECISION RNOR(N) + DOUBLE PRECISION ROWSCA(N) + DOUBLE PRECISION VDIAG + INTEGER MPRINT + INTEGER I,J,K + DOUBLE PRECISION ZERO,ONE + PARAMETER (ZERO=0.0D0, ONE=1.0D0) + DO 50 J=1,N + RNOR(J) = ZERO + 50 CONTINUE + DO 100 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.LE.0).OR.(I.GT.N).OR. + & (J.LE.0).OR.(J.GT.N)) GOTO 100 + VDIAG = abs(VAL(K)) + IF (VDIAG.GT.RNOR(I)) THEN + RNOR(I) = VDIAG + ENDIF + 100 CONTINUE + DO 130 J=1,N + IF (RNOR(J).LE.ZERO) THEN + RNOR(J) = ONE + ELSE + RNOR(J) = ONE/RNOR(J) + ENDIF + 130 CONTINUE + DO 110 I=1,N + ROWSCA(I) = ROWSCA(I)* RNOR(I) + 110 CONTINUE + IF ( (NSCA.EQ.4) .OR. (NSCA.EQ.6) ) THEN + DO 150 K=1,NZ + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.N .OR. J.GT.N) GOTO 150 + VAL(K) = VAL(K) * RNOR(I) + 150 CONTINUE + ENDIF + IF (MPRINT.GT.0) + & WRITE(MPRINT,'(A)') ' END OF ROW SCALING' + RETURN + END SUBROUTINE ZMUMPS_240 + SUBROUTINE ZMUMPS_216(M,N,NE,A,IRN,ICN,R,C,W,LP,IFAIL) + INTEGER M,N,NE + COMPLEX(kind=8) A(NE) + INTEGER IRN(NE),ICN(NE) + DOUBLE PRECISION R(M),C(N) + DOUBLE PRECISION W(M*2+N*3) + INTEGER LP,IFAIL + INTRINSIC log,abs,min + INTEGER MAXIT + PARAMETER (MAXIT=100) + DOUBLE PRECISION ONE + DOUBLE PRECISION SMIN,ZERO + PARAMETER (ONE=1.0D0,SMIN=0.1D0,ZERO=0.0D0) + INTEGER I,I1,I2,I3,I4,I5,ITER,J,K + DOUBLE PRECISION E,E1,EM,Q,Q1,QM,S,S1,SM,U,V + IFAIL = 0 + IF (M.LT.1 .OR. N.LT.1) THEN + IFAIL = -1 + GO TO 220 + ELSE IF (NE.LE.0) THEN + IFAIL = -2 + GO TO 220 + END IF + I1 = 0 + I2 = M + I3 = M + N + I4 = M + N*2 + I5 = M + N*3 + DO 10 I = 1,M + R(I) = ZERO + W(I1+I) = ZERO + 10 CONTINUE + DO 20 J = 1,N + C(J) = ZERO + W(I2+J) = ZERO + W(I3+J) = ZERO + W(I4+J) = ZERO + 20 CONTINUE + DO 30 K = 1,NE + U = abs(A(K)) + IF (U.EQ.ZERO) GO TO 30 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 30 + U = log(U) + W(I1+I) = W(I1+I) + ONE + W(I2+J) = W(I2+J) + ONE + R(I) = R(I) + U + W(I3+J) = W(I3+J) + U + 30 CONTINUE + DO 40 I = 1,M + IF (W(I1+I).EQ.ZERO) W(I1+I) = ONE + R(I) = R(I)/W(I1+I) + W(I5+I) = R(I) + 40 CONTINUE + DO 50 J = 1,N + IF (W(I2+J).EQ.ZERO) W(I2+J) = ONE + W(I3+J) = W(I3+J)/W(I2+J) + 50 CONTINUE + SM = SMIN*dble(NE) + DO 60 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 60 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 60 + R(I) = R(I) - W(I3+J)/W(I1+I) + 60 CONTINUE + E = ZERO + Q = ONE + S = ZERO + DO 70 I = 1,M + S = S + W(I1+I)*R(I)**2 + 70 CONTINUE + IF (abs(S).LE.abs(SM)) GO TO 160 + DO 150 ITER = 1,MAXIT + DO 80 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 80 + J = ICN(K) + I = IRN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 80 + C(J) = C(J) + R(I) + 80 CONTINUE + S1 = S + S = ZERO + DO 90 J = 1,N + V = -C(J)/Q + C(J) = V/W(I2+J) + S = S + V*C(J) + 90 CONTINUE + E1 = E + E = Q*S/S1 + Q = ONE - E + IF (abs(S).LE.abs(SM)) E = ZERO + DO 100 I = 1,M + R(I) = R(I)*E*W(I1+I) + 100 CONTINUE + IF (abs(S).LE.abs(SM)) GO TO 180 + EM = E*E1 + DO 110 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 110 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 110 + R(I) = R(I) + C(J) + 110 CONTINUE + S1 = S + S = ZERO + DO 120 I = 1,M + V = -R(I)/Q + R(I) = V/W(I1+I) + S = S + V*R(I) + 120 CONTINUE + E1 = E + E = Q*S/S1 + Q1 = Q + Q = ONE - E + IF (abs(S).LE.abs(SM)) Q = ONE + QM = Q*Q1 + DO 130 J = 1,N + W(I4+J) = (EM*W(I4+J)+C(J))/QM + W(I3+J) = W(I3+J) + W(I4+J) + 130 CONTINUE + IF (abs(S).LE.abs(SM)) GO TO 160 + DO 140 J = 1,N + C(J) = C(J)*E*W(I2+J) + 140 CONTINUE + 150 CONTINUE + 160 DO 170 I = 1,M + R(I) = R(I)*W(I1+I) + 170 CONTINUE + 180 DO 190 K = 1,NE + IF (abs(A(K)).EQ.ZERO) GO TO 190 + I = IRN(K) + J = ICN(K) + IF (min(I,J).LT.1 .OR. I.GT.M .OR. J.GT.N) GO TO 190 + R(I) = R(I) + W(I3+J) + 190 CONTINUE + DO 200 I = 1,M + R(I) = R(I)/W(I1+I) - W(I5+I) + 200 CONTINUE + DO 210 J = 1,N + C(J) = -W(I3+J) + 210 CONTINUE + RETURN + 220 IF (LP.GT.0) WRITE (LP,'(/A/A,I3)') + & ' **** Error return from ZMUMPS_216 ****',' IFAIL =',IFAIL + END SUBROUTINE ZMUMPS_216 + SUBROUTINE ZMUMPS_27( id, ANORMINF, LSCAL ) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MASTER, IERR + PARAMETER( MASTER = 0 ) + TYPE(ZMUMPS_STRUC), TARGET :: id + DOUBLE PRECISION, INTENT(OUT) :: ANORMINF + LOGICAL :: LSCAL + INTEGER, DIMENSION (:), POINTER :: KEEP,INFO + INTEGER(8), DIMENSION (:), POINTER :: KEEP8 + LOGICAL :: I_AM_SLAVE + COMPLEX(kind=8) DUMMY(1) + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0) + DOUBLE PRECISION, ALLOCATABLE :: SUMR(:), SUMR_LOC(:) + INTEGER :: allocok, MTYPE, I + INFO =>id%INFO + KEEP =>id%KEEP + KEEP8 =>id%KEEP8 + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & KEEP(46) .eq. 1 ) ) + IF (id%MYID .EQ. MASTER) THEN + ALLOCATE( SUMR( id%N ), stat =allocok ) + IF (allocok .GT.0 ) THEN + id%INFO(1)=-13 + id%INFO(2)=id%N + RETURN + ENDIF + ENDIF + IF ( KEEP(54) .eq. 0 ) THEN + IF (id%MYID .EQ. MASTER) THEN + IF (KEEP(55).EQ.0) THEN + IF (.NOT.LSCAL) THEN + CALL ZMUMPS_207(id%A(1), + & id%NZ, id%N, + & id%IRN(1), id%JCN(1), + & SUMR, KEEP(1),KEEP8(1) ) + ELSE + CALL ZMUMPS_289(id%A(1), + & id%NZ, id%N, + & id%IRN(1), id%JCN(1), + & SUMR, KEEP(1), KEEP8(1), + & id%COLSCA(1)) + ENDIF + ELSE + MTYPE = 1 + IF (.NOT.LSCAL) THEN + CALL ZMUMPS_119(MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & SUMR, KEEP(1),KEEP8(1) ) + ELSE + CALL ZMUMPS_135(MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & SUMR, KEEP(1),KEEP8(1), id%COLSCA(1)) + ENDIF + ENDIF + ENDIF + ELSE + ALLOCATE( SUMR_LOC( id%N ), stat =allocok ) + IF (allocok .GT.0 ) THEN + id%INFO(1)=-13 + id%INFO(2)=id%N + RETURN + ENDIF + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + IF (.NOT.LSCAL) THEN + CALL ZMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & SUMR_LOC, id%KEEP(1),id%KEEP8(1) ) + ELSE + CALL ZMUMPS_289(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & SUMR_LOC, id%KEEP(1),id%KEEP8(1), + & id%COLSCA(1)) + ENDIF + ELSE + SUMR_LOC = ZERO + ENDIF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( SUMR_LOC, SUMR, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( SUMR_LOC, DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + DEALLOCATE (SUMR_LOC) + ENDIF + IF ( id%MYID .eq. MASTER ) THEN + ANORMINF = dble(ZERO) + IF (LSCAL) THEN + DO I = 1, id%N + ANORMINF = max(abs(id%ROWSCA(I) * SUMR(I)), + & ANORMINF) + ENDDO + ELSE + DO I = 1, id%N + ANORMINF = max(abs(SUMR(I)), + & ANORMINF) + ENDDO + ENDIF + ENDIF + CALL MPI_BCAST(ANORMINF, 1, + & MPI_DOUBLE_PRECISION, MASTER, + & id%COMM, IERR ) + IF (id%MYID .eq. MASTER) DEALLOCATE (SUMR) + RETURN + END SUBROUTINE ZMUMPS_27 + SUBROUTINE ZMUMPS_693(IRN_loc, JCN_loc, A_loc, NZ_loc, + & M, N, NUMPROCS, MYID, COMM, + & RPARTVEC, CPARTVEC, + & RSNDRCVSZ, CSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, COLSCA, WRKRC, ISZWRKRC, + & SYM, NB1, NB2, NB3, EPS, + & ONENORMERR,INFNORMERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER NZ_loc, M, N, IWRKSZ, OP + INTEGER NUMPROCS, MYID, COMM + INTEGER INTSZ, RESZ + INTEGER IRN_loc(NZ_loc) + INTEGER JCN_loc(NZ_loc) + COMPLEX(kind=8) A_loc(NZ_loc) + INTEGER RPARTVEC(M), RSNDRCVSZ(2*NUMPROCS) + INTEGER CPARTVEC(N), CSNDRCVSZ(2*NUMPROCS) + INTEGER IWRK(IWRKSZ) + INTEGER REGISTRE(12) + DOUBLE PRECISION ROWSCA(M) + DOUBLE PRECISION COLSCA(N) + INTEGER ISZWRKRC + DOUBLE PRECISION WRKRC(ISZWRKRC) + DOUBLE PRECISION ONENORMERR,INFNORMERR + INTEGER SYM, NB1, NB2, NB3 + DOUBLE PRECISION EPS + EXTERNAL ZMUMPS_694,ZMUMPS_687, + & ZMUMPS_670 + INTEGER I + IF(SYM.EQ.0) THEN + CALL ZMUMPS_694(IRN_loc, JCN_loc, A_loc, NZ_loc, + & M, N, NUMPROCS, MYID, COMM, + & RPARTVEC, CPARTVEC, + & RSNDRCVSZ, CSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, COLSCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + ELSE + CALL ZMUMPS_687(IRN_loc, JCN_loc, A_loc, NZ_loc, + & N, NUMPROCS, MYID, COMM, + & RPARTVEC, + & RSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + DO I=1,N + COLSCA(I) = ROWSCA(I) + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_693 + SUBROUTINE ZMUMPS_694(IRN_loc, JCN_loc, A_loc, NZ_loc, + & M, N, NUMPROCS, MYID, COMM, + & RPARTVEC, CPARTVEC, + & RSNDRCVSZ, CSNDRCVSZ, REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & ROWSCA, COLSCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER NZ_loc, M, N, IWRKSZ, OP + INTEGER NUMPROCS, MYID, COMM + INTEGER INTSZ, RESZ + INTEGER IRN_loc(NZ_loc) + INTEGER JCN_loc(NZ_loc) + COMPLEX(kind=8) A_loc(NZ_loc) + INTEGER RPARTVEC(M), RSNDRCVSZ(2*NUMPROCS) + INTEGER CPARTVEC(N), CSNDRCVSZ(2*NUMPROCS) + INTEGER IWRK(IWRKSZ) + INTEGER REGISTRE(12) + DOUBLE PRECISION ROWSCA(M) + DOUBLE PRECISION COLSCA(N) + INTEGER ISZWRKRC + DOUBLE PRECISION WRKRC(ISZWRKRC) + DOUBLE PRECISION ONENORMERR,INFNORMERR + INTEGER IRSNDRCVNUM, ORSNDRCVNUM + INTEGER IRSNDRCVVOL, ORSNDRCVVOL + INTEGER ICSNDRCVNUM, OCSNDRCVNUM + INTEGER ICSNDRCVVOL, OCSNDRCVVOL + INTEGER INUMMYR, INUMMYC + INTEGER IMYRPTR,IMYCPTR + INTEGER IRNGHBPRCS, IRSNDRCVIA,IRSNDRCVJA + INTEGER ORNGHBPRCS, ORSNDRCVIA,ORSNDRCVJA + INTEGER ICNGHBPRCS, ICSNDRCVIA,ICSNDRCVJA + INTEGER OCNGHBPRCS, OCSNDRCVIA,OCSNDRCVJA + INTEGER ISTATUS, REQUESTS, TMPWORK + INTEGER ITDRPTR, ITDCPTR, ISRRPTR + INTEGER OSRRPTR, ISRCPTR, OSRCPTR + INTEGER NB1, NB2, NB3 + DOUBLE PRECISION EPS + INTEGER ITER, NZIND, IR, IC + DOUBLE PRECISION ELM + INTEGER TAG_COMM_COL + PARAMETER(TAG_COMM_COL=100) + INTEGER TAG_COMM_ROW + PARAMETER(TAG_COMM_ROW=101) + INTEGER TAG_ITERS + PARAMETER(TAG_ITERS=102) + EXTERNAL ZMUMPS_654, + & ZMUMPS_672, + & ZMUMPS_674, + & ZMUMPS_662, + & ZMUMPS_743, + & ZMUMPS_745, + & ZMUMPS_660, + & ZMUMPS_670, + & ZMUMPS_671, + & ZMUMPS_657, + & ZMUMPS_656 + INTEGER ZMUMPS_743 + INTEGER ZMUMPS_745 + DOUBLE PRECISION ZMUMPS_737 + DOUBLE PRECISION ZMUMPS_738 + INTRINSIC abs + DOUBLE PRECISION RONE, RZERO + PARAMETER(RONE=1.0D0,RZERO=0.0D0) + INTEGER RESZR, RESZC + INTEGER INTSZR, INTSZC + INTEGER MAXMN + INTEGER I, IERROR + DOUBLE PRECISION ONEERRROW, ONEERRCOL, ONEERRL, ONEERRG + DOUBLE PRECISION INFERRROW, INFERRCOL, INFERRL, INFERRG + INTEGER OORANGEIND + INFERRG = -RONE + ONEERRG = -RONE + OORANGEIND = 0 + MAXMN = M + IF(MAXMN < N) MAXMN = N + IF(OP == 1) THEN + IF(NUMPROCS > 1) THEN + CALL ZMUMPS_654(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & RPARTVEC, M, N, + & IWRK, IWRKSZ) + CALL ZMUMPS_654(MYID, NUMPROCS, COMM, + & JCN_loc, IRN_loc, NZ_loc, + & CPARTVEC, N, M, + & IWRK, IWRKSZ) + CALL ZMUMPS_672(MYID, NUMPROCS, M, RPARTVEC, + & NZ_loc, IRN_loc, N, JCN_loc, + & IRSNDRCVNUM,IRSNDRCVVOL, + & ORSNDRCVNUM,ORSNDRCVVOL, + & IWRK,IWRKSZ, + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), COMM) + CALL ZMUMPS_672(MYID, NUMPROCS, N, CPARTVEC, + & NZ_loc, JCN_loc, M, IRN_loc, + & ICSNDRCVNUM,ICSNDRCVVOL, + & OCSNDRCVNUM,OCSNDRCVVOL, + & IWRK,IWRKSZ, + & CSNDRCVSZ(1), CSNDRCVSZ(1+NUMPROCS), COMM) + CALL ZMUMPS_662(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & RPARTVEC, CPARTVEC, M, N, + & INUMMYR, + & INUMMYC, + & IWRK, IWRKSZ) + INTSZR = IRSNDRCVNUM + ORSNDRCVNUM + + & IRSNDRCVVOL + ORSNDRCVVOL + + & 2*(NUMPROCS+1) + INUMMYR + INTSZC = ICSNDRCVNUM + OCSNDRCVNUM + + & ICSNDRCVVOL + OCSNDRCVVOL + + & 2*(NUMPROCS+1) + INUMMYC + INTSZ = INTSZR + INTSZC + MAXMN + + & (MPI_STATUS_SIZE +1) * NUMPROCS + ELSE + IRSNDRCVNUM = 0 + ORSNDRCVNUM = 0 + IRSNDRCVVOL = 0 + ORSNDRCVVOL = 0 + INUMMYR = 0 + ICSNDRCVNUM = 0 + OCSNDRCVNUM = 0 + ICSNDRCVVOL = 0 + OCSNDRCVVOL = 0 + INUMMYC = 0 + INTSZ = 0 + ENDIF + RESZR = M + IRSNDRCVVOL + ORSNDRCVVOL + RESZC = N + ICSNDRCVVOL + OCSNDRCVVOL + RESZ = RESZR + RESZC + REGISTRE(1) = IRSNDRCVNUM + REGISTRE(2) = ORSNDRCVNUM + REGISTRE(3) = IRSNDRCVVOL + REGISTRE(4) = ORSNDRCVVOL + REGISTRE(5) = ICSNDRCVNUM + REGISTRE(6) = OCSNDRCVNUM + REGISTRE(7) = ICSNDRCVVOL + REGISTRE(8) = OCSNDRCVVOL + REGISTRE(9) = INUMMYR + REGISTRE(10) = INUMMYC + REGISTRE(11) = INTSZ + REGISTRE(12) = RESZ + ELSE + IRSNDRCVNUM = REGISTRE(1) + ORSNDRCVNUM = REGISTRE(2) + IRSNDRCVVOL = REGISTRE(3) + ORSNDRCVVOL = REGISTRE(4) + ICSNDRCVNUM = REGISTRE(5) + OCSNDRCVNUM = REGISTRE(6) + ICSNDRCVVOL = REGISTRE(7) + OCSNDRCVVOL = REGISTRE(8) + INUMMYR = REGISTRE(9) + INUMMYC = REGISTRE(10) + IF(NUMPROCS > 1) THEN + CALL ZMUMPS_660(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & RPARTVEC, CPARTVEC, M, N, + & IWRK(1), INUMMYR, + & IWRK(1+INUMMYR), INUMMYC, + & IWRK(1+INUMMYR+INUMMYC), IWRKSZ-INUMMYR-INUMMYC ) + IMYRPTR = 1 + IMYCPTR = IMYRPTR + INUMMYR + IRNGHBPRCS = IMYCPTR+ INUMMYC + IRSNDRCVIA = IRNGHBPRCS+IRSNDRCVNUM + IRSNDRCVJA = IRSNDRCVIA + NUMPROCS+1 + ORNGHBPRCS = IRSNDRCVJA + IRSNDRCVVOL + ORSNDRCVIA = ORNGHBPRCS + ORSNDRCVNUM + ORSNDRCVJA = ORSNDRCVIA + NUMPROCS + 1 + ICNGHBPRCS = ORSNDRCVJA + ORSNDRCVVOL + ICSNDRCVIA = ICNGHBPRCS + ICSNDRCVNUM + ICSNDRCVJA = ICSNDRCVIA + NUMPROCS+1 + OCNGHBPRCS = ICSNDRCVJA + ICSNDRCVVOL + OCSNDRCVIA = OCNGHBPRCS + OCSNDRCVNUM + OCSNDRCVJA = OCSNDRCVIA + NUMPROCS + 1 + REQUESTS = OCSNDRCVJA + OCSNDRCVVOL + ISTATUS = REQUESTS + NUMPROCS + TMPWORK = ISTATUS + MPI_STATUS_SIZE * NUMPROCS + CALL ZMUMPS_674(MYID, NUMPROCS, M, RPARTVEC, + & NZ_loc, IRN_loc,N, JCN_loc, + & IRSNDRCVNUM, IRSNDRCVVOL, + & IWRK(IRNGHBPRCS),IWRK(IRSNDRCVIA),IWRK(IRSNDRCVJA), + & ORSNDRCVNUM, ORSNDRCVVOL, + & IWRK(ORNGHBPRCS),IWRK(ORSNDRCVIA),IWRK(ORSNDRCVJA), + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), + & IWRK(TMPWORK), + & IWRK(ISTATUS), IWRK(REQUESTS), + & TAG_COMM_ROW, COMM) + CALL ZMUMPS_674(MYID, NUMPROCS, N, CPARTVEC, + & NZ_loc, JCN_loc, M, IRN_loc, + & ICSNDRCVNUM, ICSNDRCVVOL, + & IWRK(ICNGHBPRCS), + & IWRK(ICSNDRCVIA), + & IWRK(ICSNDRCVJA), + & OCSNDRCVNUM, OCSNDRCVVOL, + & IWRK(OCNGHBPRCS),IWRK(OCSNDRCVIA),IWRK(OCSNDRCVJA), + & CSNDRCVSZ(1), CSNDRCVSZ(1+NUMPROCS), + & IWRK(TMPWORK), + & IWRK(ISTATUS), IWRK(REQUESTS), + & TAG_COMM_COL, COMM) + CALL ZMUMPS_670(ROWSCA, M, RZERO) + CALL ZMUMPS_670(COLSCA, N, RZERO) + CALL ZMUMPS_671(ROWSCA, M, + & IWRK(IMYRPTR),INUMMYR, RONE) + CALL ZMUMPS_671(COLSCA, N, + & IWRK(IMYCPTR),INUMMYC, RONE) + ELSE + CALL ZMUMPS_670(ROWSCA, M, RONE) + CALL ZMUMPS_670(COLSCA, N, RONE) + ENDIF + ITDRPTR = 1 + ITDCPTR = ITDRPTR + M + ISRRPTR = ITDCPTR + N + OSRRPTR = ISRRPTR + IRSNDRCVVOL + ISRCPTR = OSRRPTR + ORSNDRCVVOL + OSRCPTR = ISRCPTR + ICSNDRCVVOL + IF(NUMPROCS == 1)THEN + OSRCPTR = OSRCPTR - 1 + ISRCPTR = ISRCPTR - 1 + OSRRPTR = OSRRPTR - 1 + ISRRPTR = ISRRPTR - 1 + ELSE + IF(IRSNDRCVVOL == 0) ISRRPTR = ISRRPTR - 1 + IF(ORSNDRCVVOL == 0) OSRRPTR = OSRRPTR - 1 + IF(ICSNDRCVVOL == 0) ISRCPTR = ISRCPTR - 1 + IF(OCSNDRCVVOL == 0) OSRCPTR = OSRCPTR - 1 + ENDIF + ITER = 1 + DO WHILE (ITER.LE.NB1+NB2+NB3) + IF(NUMPROCS > 1) THEN + CALL ZMUMPS_650(WRKRC(ITDRPTR),M, + & IWRK(IMYRPTR),INUMMYR) + CALL ZMUMPS_650(WRKRC(ITDCPTR),N, + & IWRK(IMYCPTR),INUMMYC) + ELSE + CALL ZMUMPS_670(WRKRC(ITDRPTR),M, RZERO) + CALL ZMUMPS_670(WRKRC(ITDCPTR),N, RZERO) + ENDIF + IF((ITER.LE.NB1).OR.(ITER > NB1+NB2)) THEN + IF((ITER.EQ.1).OR.(OORANGEIND.EQ.1)) THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*ROWSCA(IR)*COLSCA(IC) + IF(WRKRC(ITDRPTR-1+IR) 1) THEN + CALL ZMUMPS_657(MYID, NUMPROCS, + & WRKRC(ITDCPTR), N, TAG_ITERS+ITER, + & ICSNDRCVNUM,IWRK(ICNGHBPRCS), + & ICSNDRCVVOL,IWRK(ICSNDRCVIA), IWRK(ICSNDRCVJA), + & WRKRC(ISRCPTR), + & OCSNDRCVNUM,IWRK(OCNGHBPRCS), + & OCSNDRCVVOL,IWRK(OCSNDRCVIA), IWRK(OCSNDRCVJA), + & WRKRC( OSRCPTR), + & IWRK(ISTATUS),IWRK(REQUESTS), + & COMM) + CALL ZMUMPS_657(MYID, NUMPROCS, + & WRKRC(ITDRPTR), M, TAG_ITERS+2+ITER, + & IRSNDRCVNUM,IWRK(IRNGHBPRCS), + & IRSNDRCVVOL,IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM,IWRK(ORNGHBPRCS), + & ORSNDRCVVOL,IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS),IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRROW = ZMUMPS_737(ROWSCA, + & WRKRC(ITDRPTR), M, + & IWRK(IMYRPTR),INUMMYR) + INFERRCOL = ZMUMPS_737(COLSCA, + & WRKRC(ITDCPTR), N, + & IWRK(IMYCPTR),INUMMYC) + INFERRL = INFERRCOL + IF(INFERRROW > INFERRL ) THEN + INFERRL = INFERRROW + ENDIF + CALL MPI_ALLREDUCE(INFERRL, INFERRG, + & 1, MPI_DOUBLE_PRECISION, + & MPI_MAX, COMM, IERROR) + IF(INFERRG.LE.EPS) THEN + CALL ZMUMPS_665(COLSCA, WRKRC(ITDCPTR), + & N, + & IWRK(IMYCPTR),INUMMYC) + CALL ZMUMPS_665(ROWSCA, WRKRC(ITDRPTR), + & M, + & IWRK(IMYRPTR),INUMMYR) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRROW = ZMUMPS_738(ROWSCA, + & WRKRC(ITDRPTR), M) + INFERRCOL = ZMUMPS_738(COLSCA, + & WRKRC(ITDCPTR), N) + INFERRL = INFERRCOL + IF(INFERRROW > INFERRL) THEN + INFERRL = INFERRROW + ENDIF + INFERRG = INFERRL + IF(INFERRG.LE.EPS) THEN + CALL ZMUMPS_666(COLSCA, WRKRC(ITDCPTR), N) + CALL ZMUMPS_666(ROWSCA, WRKRC(ITDRPTR), M) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + IF((ITER .EQ.1).OR.(OORANGEIND.EQ.1))THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*ROWSCA(IR)*COLSCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + WRKRC(ITDCPTR-1+IC) = WRKRC(ITDCPTR-1+IC) + ELM + ELSE + OORANGEIND = 1 + ENDIF + ENDDO + ELSEIF(OORANGEIND.EQ.0) THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + ELM = abs(A_loc(NZIND))*ROWSCA(IR)*COLSCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + WRKRC(ITDCPTR-1+IC) = WRKRC(ITDCPTR-1+IC) + ELM + ENDDO + ENDIF + IF(NUMPROCS > 1) THEN + CALL ZMUMPS_656(MYID, NUMPROCS, + & WRKRC(ITDCPTR), N, TAG_ITERS+ITER, + & ICSNDRCVNUM, IWRK(ICNGHBPRCS), + & ICSNDRCVVOL, IWRK(ICSNDRCVIA), IWRK(ICSNDRCVJA), + & WRKRC(ISRCPTR), + & OCSNDRCVNUM, IWRK(OCNGHBPRCS), + & OCSNDRCVVOL, IWRK(OCSNDRCVIA), IWRK(OCSNDRCVJA), + & WRKRC( OSRCPTR), + & IWRK(ISTATUS), IWRK(REQUESTS), + & COMM) + CALL ZMUMPS_656(MYID, NUMPROCS, + & WRKRC(ITDRPTR), M, TAG_ITERS+2+ITER, + & IRSNDRCVNUM, IWRK(IRNGHBPRCS), + & IRSNDRCVVOL, IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM, IWRK(ORNGHBPRCS), + & ORSNDRCVVOL, IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS), IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRROW = ZMUMPS_737(ROWSCA, + & WRKRC(ITDRPTR), M, + & IWRK(IMYRPTR),INUMMYR) + ONEERRCOL = ZMUMPS_737(COLSCA, + & WRKRC(ITDCPTR), N, + & IWRK(IMYCPTR),INUMMYC) + ONEERRL = ONEERRCOL + IF(ONEERRROW > ONEERRL ) THEN + ONEERRL = ONEERRROW + ENDIF + CALL MPI_ALLREDUCE(ONEERRL, ONEERRG, + & 1, MPI_DOUBLE_PRECISION, + & MPI_MAX, COMM, IERROR) + IF(ONEERRG.LE.EPS) THEN + CALL ZMUMPS_665(COLSCA, WRKRC(ITDCPTR), + & N, + & IWRK(IMYCPTR),INUMMYC) + CALL ZMUMPS_665(ROWSCA, WRKRC(ITDRPTR), + & M, + & IWRK(IMYRPTR),INUMMYR) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRROW = ZMUMPS_738(ROWSCA, + & WRKRC(ITDRPTR), M) + ONEERRCOL = ZMUMPS_738(COLSCA, + & WRKRC(ITDCPTR), N) + ONEERRL = ONEERRCOL + IF(ONEERRROW > ONEERRL) THEN + ONEERRL = ONEERRROW + ENDIF + ONEERRG = ONEERRL + IF(ONEERRG.LE.EPS) THEN + CALL ZMUMPS_666(COLSCA, WRKRC(ITDCPTR), N) + CALL ZMUMPS_666(ROWSCA, WRKRC(ITDRPTR), M) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ENDIF + ENDIF + IF(NUMPROCS > 1) THEN + CALL ZMUMPS_665(COLSCA, WRKRC(ITDCPTR), N, + & IWRK(IMYCPTR),INUMMYC) + CALL ZMUMPS_665(ROWSCA, WRKRC(ITDRPTR), M, + & IWRK(IMYRPTR),INUMMYR) + ELSE + CALL ZMUMPS_666(COLSCA, WRKRC(ITDCPTR), N) + CALL ZMUMPS_666(ROWSCA, WRKRC(ITDRPTR), M) + ENDIF + ITER = ITER + 1 + ENDDO + ONENORMERR = ONEERRG + INFNORMERR = INFERRG + IF(NUMPROCS > 1) THEN + CALL MPI_REDUCE(ROWSCA, WRKRC(1), M, MPI_DOUBLE_PRECISION, + & MPI_MAX, 0, + & COMM, IERROR) + IF(MYID.EQ.0) THEN + DO I=1, M + ROWSCA(I) = WRKRC(I) + ENDDO + ENDIF + CALL MPI_REDUCE(COLSCA, WRKRC(1+M), N, MPI_DOUBLE_PRECISION, + & MPI_MAX, 0, + & COMM, IERROR) + If(MYID.EQ.0) THEN + DO I=1, N + COLSCA(I) = WRKRC(I+M) + ENDDO + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_694 + SUBROUTINE ZMUMPS_687(IRN_loc, JCN_loc, A_loc, NZ_loc, + & N, NUMPROCS, MYID, COMM, + & PARTVEC, + & RSNDRCVSZ, + & REGISTRE, + & IWRK, IWRKSZ, + & INTSZ, RESZ, OP, + & SCA, WRKRC, ISZWRKRC, + & NB1, NB2, NB3, EPS, + & ONENORMERR, INFNORMERR) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER NZ_loc, N, IWRKSZ, OP + INTEGER NUMPROCS, MYID, COMM + INTEGER INTSZ, RESZ + INTEGER IRN_loc(NZ_loc) + INTEGER JCN_loc(NZ_loc) + COMPLEX(kind=8) A_loc(NZ_loc) + INTEGER PARTVEC(N), RSNDRCVSZ(2*NUMPROCS) + INTEGER IWRK(IWRKSZ) + INTEGER REGISTRE(12) + DOUBLE PRECISION SCA(N) + INTEGER ISZWRKRC + DOUBLE PRECISION WRKRC(ISZWRKRC) + INTEGER IRSNDRCVNUM, ORSNDRCVNUM + INTEGER IRSNDRCVVOL, ORSNDRCVVOL + INTEGER INUMMYR + INTEGER IMYRPTR,IMYCPTR + INTEGER IRNGHBPRCS, IRSNDRCVIA,IRSNDRCVJA + INTEGER ORNGHBPRCS, ORSNDRCVIA,ORSNDRCVJA + INTEGER ISTATUS, REQUESTS, TMPWORK + INTEGER ITDRPTR, ISRRPTR, OSRRPTR + DOUBLE PRECISION ONENORMERR,INFNORMERR + INTEGER NB1, NB2, NB3 + DOUBLE PRECISION EPS + INTEGER ITER, NZIND, IR, IC + DOUBLE PRECISION ELM + INTEGER TAG_COMM_ROW + PARAMETER(TAG_COMM_ROW=101) + INTEGER TAG_ITERS + PARAMETER(TAG_ITERS=102) + EXTERNAL ZMUMPS_655, + & ZMUMPS_673, + & ZMUMPS_692, + & ZMUMPS_663, + & ZMUMPS_742, + & ZMUMPS_745, + & ZMUMPS_661, + & ZMUMPS_657, + & ZMUMPS_656, + & ZMUMPS_670, + & ZMUMPS_671 + INTEGER ZMUMPS_742 + INTEGER ZMUMPS_745 + DOUBLE PRECISION ZMUMPS_737 + DOUBLE PRECISION ZMUMPS_738 + INTRINSIC abs + DOUBLE PRECISION RONE, RZERO + PARAMETER(RONE=1.0D0,RZERO=0.0D0) + INTEGER INTSZR + INTEGER MAXMN + INTEGER I, IERROR + DOUBLE PRECISION ONEERRL, ONEERRG + DOUBLE PRECISION INFERRL, INFERRG + INTEGER OORANGEIND + OORANGEIND = 0 + INFERRG = -RONE + ONEERRG = -RONE + MAXMN = N + IF(OP == 1) THEN + IF(NUMPROCS > 1) THEN + CALL ZMUMPS_655(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & IWRK, IWRKSZ) + CALL ZMUMPS_673(MYID, NUMPROCS, N, PARTVEC, + & NZ_loc, IRN_loc,JCN_loc, IRSNDRCVNUM,IRSNDRCVVOL, + & ORSNDRCVNUM, ORSNDRCVVOL, + & IWRK,IWRKSZ, + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), COMM) + CALL ZMUMPS_663(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & INUMMYR, + & IWRK, IWRKSZ) + INTSZR = IRSNDRCVNUM + ORSNDRCVNUM + + & IRSNDRCVVOL + ORSNDRCVVOL + + & 2*(NUMPROCS+1) + INUMMYR + INTSZ = INTSZR + N + + & (MPI_STATUS_SIZE +1) * NUMPROCS + ELSE + IRSNDRCVNUM = 0 + ORSNDRCVNUM = 0 + IRSNDRCVVOL = 0 + ORSNDRCVVOL = 0 + INUMMYR = 0 + INTSZ = 0 + ENDIF + RESZ = N + IRSNDRCVVOL + ORSNDRCVVOL + REGISTRE(1) = IRSNDRCVNUM + REGISTRE(2) = ORSNDRCVNUM + REGISTRE(3) = IRSNDRCVVOL + REGISTRE(4) = ORSNDRCVVOL + REGISTRE(9) = INUMMYR + REGISTRE(11) = INTSZ + REGISTRE(12) = RESZ + ELSE + IRSNDRCVNUM = REGISTRE(1) + ORSNDRCVNUM = REGISTRE(2) + IRSNDRCVVOL = REGISTRE(3) + ORSNDRCVVOL = REGISTRE(4) + INUMMYR = REGISTRE(9) + IF(NUMPROCS > 1) THEN + CALL ZMUMPS_661(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & IWRK(1), INUMMYR, + & IWRK(1+INUMMYR), IWRKSZ-INUMMYR) + IMYRPTR = 1 + IMYCPTR = IMYRPTR + INUMMYR + IRNGHBPRCS = IMYCPTR + IRSNDRCVIA = IRNGHBPRCS+IRSNDRCVNUM + IRSNDRCVJA = IRSNDRCVIA + NUMPROCS+1 + ORNGHBPRCS = IRSNDRCVJA + IRSNDRCVVOL + ORSNDRCVIA = ORNGHBPRCS + ORSNDRCVNUM + ORSNDRCVJA = ORSNDRCVIA + NUMPROCS + 1 + REQUESTS = ORSNDRCVJA + ORSNDRCVVOL + ISTATUS = REQUESTS + NUMPROCS + TMPWORK = ISTATUS + MPI_STATUS_SIZE * NUMPROCS + CALL ZMUMPS_692(MYID, NUMPROCS, N, PARTVEC, + & NZ_loc, IRN_loc, JCN_loc, + & IRSNDRCVNUM, IRSNDRCVVOL, + & IWRK(IRNGHBPRCS),IWRK(IRSNDRCVIA),IWRK(IRSNDRCVJA), + & ORSNDRCVNUM, ORSNDRCVVOL, + & IWRK(ORNGHBPRCS),IWRK(ORSNDRCVIA),IWRK(ORSNDRCVJA), + & RSNDRCVSZ(1), RSNDRCVSZ(1+NUMPROCS), + & IWRK(TMPWORK), + & IWRK(ISTATUS), IWRK(REQUESTS), + & TAG_COMM_ROW, COMM) + CALL ZMUMPS_670(SCA, N, RZERO) + CALL ZMUMPS_671(SCA, N, + & IWRK(IMYRPTR),INUMMYR, RONE) + ELSE + CALL ZMUMPS_670(SCA, N, RONE) + ENDIF + ITDRPTR = 1 + ISRRPTR = ITDRPTR + N + OSRRPTR = ISRRPTR + IRSNDRCVVOL + IF(NUMPROCS == 1)THEN + OSRRPTR = OSRRPTR - 1 + ISRRPTR = ISRRPTR - 1 + ELSE + IF(IRSNDRCVVOL == 0) ISRRPTR = ISRRPTR - 1 + IF(ORSNDRCVVOL == 0) OSRRPTR = OSRRPTR - 1 + ENDIF + ITER = 1 + DO WHILE(ITER.LE.NB1+NB2+NB3) + IF(NUMPROCS > 1) THEN + CALL ZMUMPS_650(WRKRC(ITDRPTR),N, + & IWRK(IMYRPTR),INUMMYR) + ELSE + CALL ZMUMPS_670(WRKRC(ITDRPTR),N, RZERO) + ENDIF + IF((ITER.LE.NB1).OR.(ITER > NB1+NB2)) THEN + IF((ITER.EQ.1).OR.(OORANGEIND.EQ.1)) THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*SCA(IR)*SCA(IC) + IF(WRKRC(ITDRPTR-1+IR) 1) THEN + CALL ZMUMPS_657(MYID, NUMPROCS, + & WRKRC(ITDRPTR), N, TAG_ITERS+2+ITER, + & IRSNDRCVNUM,IWRK(IRNGHBPRCS), + & IRSNDRCVVOL,IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM,IWRK(ORNGHBPRCS), + & ORSNDRCVVOL,IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS),IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRL = ZMUMPS_737(SCA, + & WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + CALL MPI_ALLREDUCE(INFERRL, INFERRG, + & 1, MPI_DOUBLE_PRECISION, + & MPI_MAX, COMM, IERROR) + IF(INFERRG.LE.EPS) THEN + CALL ZMUMPS_665(SCA, WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & (ITER.EQ.NB1).OR. + & ((ITER.EQ.NB1+NB2+NB3).AND. + & (NB1+NB3.GT.0))) THEN + INFERRL = ZMUMPS_738(SCA, + & WRKRC(ITDRPTR), N) + INFERRG = INFERRL + IF(INFERRG.LE.EPS) THEN + CALL ZMUMPS_666(SCA, WRKRC(ITDRPTR), N) + IF(ITER .LE. NB1) THEN + ITER = NB1+1 + CYCLE + ELSE + EXIT + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + IF((ITER.EQ.1).OR.(OORANGEIND.EQ.1))THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & (IC.GE.1).AND.(IC.LE.N)) THEN + ELM = abs(A_loc(NZIND))*SCA(IR)*SCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + IF(IR.NE.IC) THEN + WRKRC(ITDRPTR-1+IC) = + & WRKRC(ITDRPTR-1+IC) + ELM + ENDIF + ELSE + OORANGEIND = 1 + ENDIF + ENDDO + ELSEIF(OORANGEIND.EQ.0)THEN + DO NZIND=1,NZ_loc + IR = IRN_loc(NZIND) + IC = JCN_loc(NZIND) + ELM = abs(A_loc(NZIND))*SCA(IR)*SCA(IC) + WRKRC(ITDRPTR-1+IR) = WRKRC(ITDRPTR-1+IR) + ELM + IF(IR.NE.IC) THEN + WRKRC(ITDRPTR-1+IC) = WRKRC(ITDRPTR-1+IC) + ELM + ENDIF + ENDDO + ENDIF + IF(NUMPROCS > 1) THEN + CALL ZMUMPS_656(MYID, NUMPROCS, + & WRKRC(ITDRPTR), N, TAG_ITERS+2+ITER, + & IRSNDRCVNUM, IWRK(IRNGHBPRCS), + & IRSNDRCVVOL, IWRK(IRSNDRCVIA), IWRK(IRSNDRCVJA), + & WRKRC(ISRRPTR), + & ORSNDRCVNUM, IWRK(ORNGHBPRCS), + & ORSNDRCVVOL, IWRK(ORSNDRCVIA), IWRK(ORSNDRCVJA), + & WRKRC( OSRRPTR), + & IWRK(ISTATUS), IWRK(REQUESTS), + & COMM) + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRL = ZMUMPS_737(SCA, + & WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + CALL MPI_ALLREDUCE(ONEERRL, ONEERRG, + & 1, MPI_DOUBLE_PRECISION, + & MPI_MAX, COMM, IERROR) + IF(ONEERRG.LE.EPS) THEN + CALL ZMUMPS_665(SCA, WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ELSE + IF((EPS .GT. RZERO) .OR. + & ((ITER.EQ.NB1+NB2).AND. + & (NB2.GT.0))) THEN + ONEERRL = ZMUMPS_738(SCA, + & WRKRC(ITDRPTR), N) + ONEERRG = ONEERRL + IF(ONEERRG.LE.EPS) THEN + CALL ZMUMPS_666(SCA, WRKRC(ITDRPTR), N) + ITER = NB1+NB2+1 + CYCLE + ENDIF + ENDIF + ENDIF + ENDIF + IF(NUMPROCS > 1) THEN + CALL ZMUMPS_665(SCA, WRKRC(ITDRPTR), N, + & IWRK(IMYRPTR),INUMMYR) + ELSE + CALL ZMUMPS_666(SCA, WRKRC(ITDRPTR), N) + ENDIF + ITER = ITER + 1 + ENDDO + ONENORMERR = ONEERRG + INFNORMERR = INFERRG + IF(NUMPROCS > 1) THEN + CALL MPI_REDUCE(SCA, WRKRC(1), N, MPI_DOUBLE_PRECISION, + & MPI_MAX, 0, + & COMM, IERROR) + IF(MYID.EQ.0) THEN + DO I=1, N + SCA(I) = WRKRC(I) + ENDDO + ENDIF + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_687 + SUBROUTINE ZMUMPS_654(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & IPARTVEC, ISZ, OSZ, + & IWRK, IWSZ) + IMPLICIT NONE + EXTERNAL ZMUMPS_703 + INTEGER MYID, NUMPROCS, COMM + INTEGER NZ_loc, ISZ, IWSZ, OSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWSZ) + INCLUDE 'mpif.h' + INTEGER I + INTEGER OP, IERROR + INTEGER IR, IC + IF(NUMPROCS.NE.1) THEN + CALL MPI_OP_CREATE(ZMUMPS_703, .TRUE., OP, IERROR) + CALL ZMUMPS_668(IWRK, 4*ISZ, ISZ) + DO I=1,ISZ + IWRK(2*I-1) = 0 + IWRK(2*I) = MYID + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.ISZ).AND. + & (IC.GE.1).AND.(IC.LE.OSZ)) THEN + IWRK(2*IR-1) = IWRK(2*IR-1) + 1 + ENDIF + ENDDO + CALL MPI_ALLREDUCE(IWRK(1), IWRK(1+2*ISZ), ISZ, + & MPI_2INTEGER, OP, COMM, IERROR) + DO I=1,ISZ + IPARTVEC(I) = IWRK(2*I+2*ISZ) + ENDDO + CALL MPI_OP_FREE(OP, IERROR) + ELSE + DO I=1,ISZ + IPARTVEC(I) = 0 + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_654 + SUBROUTINE ZMUMPS_662(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & ROWPARTVEC, COLPARTVEC, M, N, + & INUMMYR, + & INUMMYC, + & IWRK, IWSZ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, M, N + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER ROWPARTVEC(M) + INTEGER COLPARTVEC(N) + INTEGER INUMMYR, INUMMYC + INTEGER IWSZ + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC + INUMMYR = 0 + INUMMYC = 0 + DO I=1,M + IWRK(I) = 0 + IF(ROWPARTVEC(I).EQ.MYID) THEN + IWRK(I)=1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IR) .EQ. 0) THEN + IWRK(IR)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + ENDDO + DO I=1,N + IWRK(I) = 0 + IF(COLPARTVEC(I).EQ.MYID) THEN + IWRK(I)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IC = JCN_loc(I) + IR = IRN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IC) .EQ. 0) THEN + IWRK(IC)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_662 + SUBROUTINE ZMUMPS_660(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & ROWPARTVEC, COLPARTVEC, M, N, + & MYROWINDICES, INUMMYR, + & MYCOLINDICES, INUMMYC, + & IWRK, IWSZ ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, M, N + INTEGER INUMMYR, INUMMYC, IWSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER ROWPARTVEC(M) + INTEGER COLPARTVEC(N) + INTEGER MYROWINDICES(INUMMYR) + INTEGER MYCOLINDICES(INUMMYC) + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC, ITMP, MAXMN + MAXMN = M + IF(N > MAXMN) MAXMN = N + DO I=1,M + IWRK(I) = 0 + IF(ROWPARTVEC(I).EQ.MYID) IWRK(I)=1 + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IR) .EQ. 0) IWRK(IR)= 1 + ENDIF + ENDDO + ITMP = 1 + DO I=1,M + IF(IWRK(I).EQ.1) THEN + MYROWINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + DO I=1,N + IWRK(I) = 0 + IF(COLPARTVEC(I).EQ.MYID) IWRK(I)= 1 + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N)) ) THEN + IF(IWRK(IC) .EQ. 0) IWRK(IC)= 1 + ENDIF + ENDDO + ITMP = 1 + DO I=1,N + IF(IWRK(I).EQ.1) THEN + MYCOLINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_660 + INTEGER FUNCTION ZMUMPS_744(D, DSZ, INDX, INDXSZ, EPS) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + DOUBLE PRECISION D(DSZ) + INTEGER INDX(INDXSZ) + DOUBLE PRECISION EPS + INTEGER I, IID + DOUBLE PRECISION RONE + PARAMETER(RONE=1.0D0) + ZMUMPS_744 = 1 + DO I=1, INDXSZ + IID = INDX(I) + IF (.NOT.( (D(IID).LE.(RONE+EPS)).AND. + & ((RONE-EPS).LE.D(IID)) )) THEN + ZMUMPS_744 = 0 + ENDIF + ENDDO + RETURN + END FUNCTION ZMUMPS_744 + INTEGER FUNCTION ZMUMPS_745(D, DSZ, EPS) + IMPLICIT NONE + INTEGER DSZ + DOUBLE PRECISION D(DSZ) + DOUBLE PRECISION EPS + INTEGER I + DOUBLE PRECISION RONE + PARAMETER(RONE=1.0D0) + ZMUMPS_745 = 1 + DO I=1, DSZ + IF (.NOT.( (D(I).LE.(RONE+EPS)).AND. + & ((RONE-EPS).LE.D(I)) )) THEN + ZMUMPS_745 = 0 + ENDIF + ENDDO + RETURN + END FUNCTION ZMUMPS_745 + INTEGER FUNCTION ZMUMPS_743(DR, M, INDXR, INDXRSZ, + & DC, N, INDXC, INDXCSZ, EPS, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER M, N, INDXRSZ, INDXCSZ + DOUBLE PRECISION DR(M), DC(N) + INTEGER INDXR(INDXRSZ), INDXC(INDXCSZ) + DOUBLE PRECISION EPS + INTEGER COMM + EXTERNAL ZMUMPS_744 + INTEGER ZMUMPS_744 + INTEGER GLORES, MYRESR, MYRESC, MYRES + INTEGER IERR + MYRESR = ZMUMPS_744(DR, M, INDXR, INDXRSZ, EPS) + MYRESC = ZMUMPS_744(DC, N, INDXC, INDXCSZ, EPS) + MYRES = MYRESR + MYRESC + CALL MPI_ALLREDUCE(MYRES, GLORES, 1, MPI_INTEGER, + & MPI_SUM, COMM, IERR) + ZMUMPS_743 = GLORES + RETURN + END FUNCTION ZMUMPS_743 + DOUBLE PRECISION FUNCTION ZMUMPS_737(D, TMPD, DSZ, + & INDX, INDXSZ) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + DOUBLE PRECISION D(DSZ) + DOUBLE PRECISION TMPD(DSZ) + INTEGER INDX(INDXSZ) + DOUBLE PRECISION RONE + PARAMETER(RONE=1.0D0) + INTEGER I, IIND + DOUBLE PRECISION ERRMAX + INTRINSIC abs + ERRMAX = -RONE + DO I=1,INDXSZ + IIND = INDX(I) + IF(abs(RONE-TMPD(IIND)).GT.ERRMAX) THEN + ERRMAX = abs(RONE-TMPD(IIND)) + ENDIF + ENDDO + ZMUMPS_737 = ERRMAX + RETURN + END FUNCTION ZMUMPS_737 + DOUBLE PRECISION FUNCTION ZMUMPS_738(D, TMPD, DSZ) + IMPLICIT NONE + INTEGER DSZ + DOUBLE PRECISION D(DSZ) + DOUBLE PRECISION TMPD(DSZ) + DOUBLE PRECISION RONE + PARAMETER(RONE=1.0D0) + INTEGER I + DOUBLE PRECISION ERRMAX1 + INTRINSIC abs + ERRMAX1 = -RONE + DO I=1,DSZ + IF(abs(RONE-TMPD(I)).GT.ERRMAX1) THEN + ERRMAX1 = abs(RONE-TMPD(I)) + ENDIF + ENDDO + ZMUMPS_738 = ERRMAX1 + RETURN + END FUNCTION ZMUMPS_738 + SUBROUTINE ZMUMPS_665(D, TMPD, DSZ, + & INDX, INDXSZ) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + DOUBLE PRECISION D(DSZ) + DOUBLE PRECISION TMPD(DSZ) + INTEGER INDX(INDXSZ) + INTRINSIC sqrt + INTEGER I, IIND + DOUBLE PRECISION RZERO + PARAMETER(RZERO=0.0D0) + DO I=1,INDXSZ + IIND = INDX(I) + IF (TMPD(IIND).NE.RZERO) D(IIND) = D(IIND)/sqrt(TMPD(IIND)) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_665 + SUBROUTINE ZMUMPS_666(D, TMPD, DSZ) + IMPLICIT NONE + INTEGER DSZ + DOUBLE PRECISION D(DSZ) + DOUBLE PRECISION TMPD(DSZ) + INTRINSIC sqrt + INTEGER I + DOUBLE PRECISION RZERO + PARAMETER(RZERO=0.0D0) + DO I=1,DSZ + IF (TMPD(I) .NE. RZERO) D(I) = D(I)/sqrt(TMPD(I)) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_666 + SUBROUTINE ZMUMPS_671(D, DSZ, INDX, INDXSZ, VAL) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + DOUBLE PRECISION D(DSZ) + INTEGER INDX(INDXSZ) + DOUBLE PRECISION VAL + INTEGER I, IIND + DO I=1,INDXSZ + IIND = INDX(I) + D(IIND) = VAL + ENDDO + RETURN + END SUBROUTINE ZMUMPS_671 + SUBROUTINE ZMUMPS_702(D, DSZ, INDX, INDXSZ) + IMPLICIT NONE + INTEGER DSZ, INDXSZ + DOUBLE PRECISION D(DSZ) + INTEGER INDX(INDXSZ) + INTEGER I, IIND + DO I=1,INDXSZ + IIND = INDX(I) + D(IIND) = 1.0D0/D(IIND) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_702 + SUBROUTINE ZMUMPS_670(D, DSZ, VAL) + IMPLICIT NONE + INTEGER DSZ + DOUBLE PRECISION D(DSZ) + DOUBLE PRECISION VAL + INTEGER I + DO I=1,DSZ + D(I) = VAL + ENDDO + RETURN + END SUBROUTINE ZMUMPS_670 + SUBROUTINE ZMUMPS_650(TMPD, TMPSZ, INDX, INDXSZ) + IMPLICIT NONE + INTEGER TMPSZ,INDXSZ + DOUBLE PRECISION TMPD(TMPSZ) + INTEGER INDX(INDXSZ) + INTEGER I + DOUBLE PRECISION DZERO + PARAMETER(DZERO=0.0D0) + DO I=1,INDXSZ + TMPD(INDX(I)) = DZERO + ENDDO + RETURN + END SUBROUTINE ZMUMPS_650 + SUBROUTINE ZMUMPS_703(INV, INOUTV, LEN, DTYPE) + IMPLICIT NONE + INTEGER LEN + INTEGER INV(2*LEN) + INTEGER INOUTV(2*LEN) + INTEGER DTYPE + INTEGER I + INTEGER DIN, DINOUT, PIN, PINOUT + DO I=1,2*LEN-1,2 + DIN = INV(I) + PIN = INV(I+1) + DINOUT = INOUTV(I) + PINOUT = INOUTV(I+1) + IF (DINOUT < DIN) THEN + INOUTV(I) = DIN + INOUTV(I+1) = PIN + ELSE IF (DINOUT == DIN) THEN + IF ((mod(DINOUT,2).EQ.0).AND.(PINPINOUT)) THEN + INOUTV(I+1) = PIN + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_703 + SUBROUTINE ZMUMPS_668(IW, IWSZ, IVAL) + IMPLICIT NONE + INTEGER IWSZ + INTEGER IW(IWSZ) + INTEGER IVAL + INTEGER I + DO I=1,IWSZ + IW(I)=IVAL + ENDDO + RETURN + END SUBROUTINE ZMUMPS_668 + SUBROUTINE ZMUMPS_704(MYID, NUMPROCS, + & IRN_loc, JCN_loc, NZ_loc, + & ROWPARTVEC, COLPARTVEC, M, N, + & MYROWINDICES, INUMMYR, + & MYCOLINDICES, INUMMYC, + & IWRKROW, IWRKCOL, IWSZR, IWSZC, COMM ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, M, N + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER ROWPARTVEC(M) + INTEGER COLPARTVEC(N) + INTEGER MYROWINDICES(M) + INTEGER MYCOLINDICES(N) + INTEGER INUMMYR, INUMMYC + INTEGER IWSZR, IWSZC + INTEGER IWRKROW(IWSZR) + INTEGER IWRKCOL(IWSZC) + INTEGER COMM + INTEGER I, IR, IC, ITMP + INUMMYR = 0 + INUMMYC = 0 + DO I=1,M + IWRKROW(I) = 0 + IF(ROWPARTVEC(I).EQ.MYID) THEN + IWRKROW(I)=1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRKROW(IR) .EQ. 0) THEN + IWRKROW(IR)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + ENDDO + ITMP = 1 + DO I=1,M + IF(IWRKROW(I).EQ.1) THEN + MYROWINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + DO I=1,N + IWRKCOL(I) = 0 + IF(COLPARTVEC(I).EQ.MYID) THEN + IWRKCOL(I)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.M).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRKCOL(IC) .EQ. 0) THEN + IWRKCOL(IC)= 1 + INUMMYC = INUMMYC + 1 + ENDIF + ENDIF + ENDDO + ITMP = 1 + DO I=1,N + IF(IWRKCOL(I).EQ.1) THEN + MYCOLINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_704 + SUBROUTINE ZMUMPS_672(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX, OSZ, OINDX,ISNDRCVNUM,ISNDRCVVOL, + & OSNDRCVNUM,OSNDRCVVOL, + & IWRK,IWRKSZ, SNDSZ, RCVSZ, COMM) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, IWRKSZ, OSZ + INTEGER ISNDRCVNUM, ISNDRCVVOL + INTEGER OSNDRCVNUM, OSNDRCVVOL + INTEGER COMM + INTEGER INDX(NZ_loc) + INTEGER OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWRKSZ) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INCLUDE 'mpif.h' + INTEGER I + INTEGER IIND, IIND2, PIND + INTEGER IERROR + DO I=1,NUMPROCS + SNDSZ(I) = 0 + RCVSZ(I) = 0 + ENDDO + DO I=1,IWRKSZ + IWRK(I) = 0 + ENDDO + DO I=1,NZ_loc + IIND = INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND. + & (IIND2.GE.1).AND.(IIND2.LE.OSZ))THEN + PIND = IPARTVEC(IIND) + IF(PIND .NE. MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWRK(IIND) = 1 + SNDSZ(PIND+1) = SNDSZ(PIND+1)+1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_ALLTOALL(SNDSZ, 1, MPI_INTEGER, + & RCVSZ, 1, MPI_INTEGER, COMM, IERROR) + ISNDRCVNUM = 0 + ISNDRCVVOL = 0 + OSNDRCVNUM = 0 + OSNDRCVVOL = 0 + DO I=1, NUMPROCS + IF(SNDSZ(I) > 0) OSNDRCVNUM = OSNDRCVNUM + 1 + OSNDRCVVOL = OSNDRCVVOL + SNDSZ(I) + IF(RCVSZ(I) > 0) ISNDRCVNUM = ISNDRCVNUM + 1 + ISNDRCVVOL = ISNDRCVVOL + RCVSZ(I) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_672 + SUBROUTINE ZMUMPS_674(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX, OSZ, OINDX, + & ISNDRCVNUM, ISNDVOL, INGHBPRCS, ISNDRCVIA, ISNDRCVJA, + & OSNDRCVNUM, OSNDVOL, ONGHBPRCS, OSNDRCVIA, OSNDRCVJA, + & SNDSZ, RCVSZ, IWRK, + & ISTATUS, REQUESTS, + & ITAGCOMM, COMM ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, ISNDVOL, OSNDVOL, OSZ + INTEGER INDX(NZ_loc) + INTEGER OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER ISNDRCVNUM, INGHBPRCS(ISNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1) + INTEGER ISNDRCVJA(ISNDVOL) + INTEGER OSNDRCVNUM, ONGHBPRCS(OSNDRCVNUM) + INTEGER OSNDRCVIA(NUMPROCS+1) + INTEGER OSNDRCVJA(OSNDVOL) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INTEGER IWRK(ISZ) + INTEGER ISTATUS(MPI_STATUS_SIZE, ISNDRCVNUM) + INTEGER REQUESTS(ISNDRCVNUM) + INTEGER ITAGCOMM, COMM + INTEGER I, IIND, IIND2, IPID, OFFS + INTEGER IWHERETO, POFFS, ITMP, IERROR + DO I=1,ISZ + IWRK(I) = 0 + ENDDO + OFFS = 1 + POFFS = 1 + DO I=1,NUMPROCS + OSNDRCVIA(I) = OFFS + SNDSZ(I) + IF(SNDSZ(I) > 0) THEN + ONGHBPRCS(POFFS)=I + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + SNDSZ(I) + ENDDO + OSNDRCVIA(NUMPROCS+1) = OFFS + DO I=1,NZ_loc + IIND=INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND. + & (IIND2.GE.1).AND.(IIND2.LE.OSZ) ) THEN + IPID=IPARTVEC(IIND) + IF(IPID.NE.MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWHERETO = OSNDRCVIA(IPID+1)-1 + OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1 + OSNDRCVJA(IWHERETO) = IIND + IWRK(IIND) = 1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + OFFS = 1 + POFFS = 1 + ISNDRCVIA(1) = 1 + DO I=2,NUMPROCS+1 + ISNDRCVIA(I) = OFFS + RCVSZ(I-1) + IF(RCVSZ(I-1) > 0) THEN + INGHBPRCS(POFFS)=I-1 + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + RCVSZ(I-1) + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + DO I=1, ISNDRCVNUM + IPID = INGHBPRCS(I) + OFFS = ISNDRCVIA(IPID) + ITMP = ISNDRCVIA(IPID+1) - ISNDRCVIA(IPID) + CALL MPI_IRECV(ISNDRCVJA(OFFS), ITMP, MPI_INTEGER,IPID-1, + & ITAGCOMM, COMM, REQUESTS(I),IERROR) + ENDDO + DO I=1,OSNDRCVNUM + IPID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(IPID) + ITMP = OSNDRCVIA(IPID+1)-OSNDRCVIA(IPID) + CALL MPI_SEND(OSNDRCVJA(OFFS), ITMP, MPI_INTEGER, IPID-1, + & ITAGCOMM, COMM,IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + CALL MPI_BARRIER(COMM,IERROR) + RETURN + END SUBROUTINE ZMUMPS_674 + SUBROUTINE ZMUMPS_657(MYID, NUMPROCS,TMPD, IDSZ, ITAGCOMM, + & ISNDRCVNUM, INGHBPRCS, + & ISNDRCVVOL, ISNDRCVIA, ISNDRCVJA, ISNDRCVA, + & OSNDRCVNUM, ONGHBPRCS, + & OSNDRCVVOL, OSNDRCVIA, OSNDRCVJA, OSNDRCVA, + & ISTATUS, REQUESTS, + & COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, IDSZ, ITAGCOMM + INTEGER ISNDRCVNUM,OSNDRCVNUM, ISNDRCVVOL, OSNDRCVVOL + DOUBLE PRECISION TMPD(IDSZ) + INTEGER INGHBPRCS(ISNDRCVNUM), ONGHBPRCS(OSNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1), ISNDRCVJA(ISNDRCVVOL) + DOUBLE PRECISION ISNDRCVA(ISNDRCVVOL) + INTEGER OSNDRCVIA(NUMPROCS+1), OSNDRCVJA(OSNDRCVVOL) + DOUBLE PRECISION OSNDRCVA(OSNDRCVVOL) + INTEGER ISTATUS(MPI_STATUS_SIZE, max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER REQUESTS(max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER COMM, IERROR + INTEGER I, PID, OFFS, SZ, J, JS, JE, IID + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1) - ISNDRCVIA(PID) + CALL MPI_IRECV(ISNDRCVA(OFFS), SZ, + & MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS, JE + IID = OSNDRCVJA(J) + OSNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(OSNDRCVA(OFFS), SZ, MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM, COMM, IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1)-1 + DO J=JS,JE + IID = ISNDRCVJA(J) + IF(TMPD(IID) < ISNDRCVA(J)) TMPD(IID)= ISNDRCVA(J) + ENDDO + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + CALL MPI_IRECV(OSNDRCVA(OFFS), SZ, + & MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM+1,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1)-ISNDRCVIA(PID) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1) -1 + DO J=JS, JE + IID = ISNDRCVJA(J) + ISNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(ISNDRCVA(OFFS), SZ, MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM+1, COMM, IERROR) + ENDDO + IF(OSNDRCVNUM > 0) THEN + CALL MPI_WAITALL(OSNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS,JE + IID = OSNDRCVJA(J) + TMPD(IID)=OSNDRCVA(J) + ENDDO + ENDDO + RETURN + END SUBROUTINE ZMUMPS_657 + SUBROUTINE ZMUMPS_656(MYID, NUMPROCS,TMPD, IDSZ, ITAGCOMM, + & ISNDRCVNUM, INGHBPRCS, + & ISNDRCVVOL, ISNDRCVIA, ISNDRCVJA, ISNDRCVA, + & OSNDRCVNUM, ONGHBPRCS, + & OSNDRCVVOL, OSNDRCVIA, OSNDRCVJA, OSNDRCVA, + & ISTATUS, REQUESTS, + & COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, IDSZ, ITAGCOMM + INTEGER ISNDRCVNUM,OSNDRCVNUM, ISNDRCVVOL, OSNDRCVVOL + DOUBLE PRECISION TMPD(IDSZ) + INTEGER INGHBPRCS(ISNDRCVNUM), ONGHBPRCS(OSNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1), ISNDRCVJA(ISNDRCVVOL) + DOUBLE PRECISION ISNDRCVA(ISNDRCVVOL) + INTEGER OSNDRCVIA(NUMPROCS+1), OSNDRCVJA(OSNDRCVVOL) + DOUBLE PRECISION OSNDRCVA(OSNDRCVVOL) + INTEGER ISTATUS(MPI_STATUS_SIZE, max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER REQUESTS(max(ISNDRCVNUM,OSNDRCVNUM)) + INTEGER COMM, IERROR + INTEGER I, PID, OFFS, SZ, J, JS, JE, IID + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1) - ISNDRCVIA(PID) + CALL MPI_IRECV(ISNDRCVA(OFFS), SZ, + & MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS, JE + IID = OSNDRCVJA(J) + OSNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(OSNDRCVA(OFFS), SZ, MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM, COMM, IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1)-1 + DO J=JS,JE + IID = ISNDRCVJA(J) + TMPD(IID) = TMPD(IID)+ ISNDRCVA(J) + ENDDO + ENDDO + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(PID) + SZ = OSNDRCVIA(PID+1) - OSNDRCVIA(PID) + CALL MPI_IRECV(OSNDRCVA(OFFS), SZ, + & MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM+1,COMM,REQUESTS(I), IERROR) + ENDDO + DO I=1,ISNDRCVNUM + PID = INGHBPRCS(I) + OFFS = ISNDRCVIA(PID) + SZ = ISNDRCVIA(PID+1)-ISNDRCVIA(PID) + JS = ISNDRCVIA(PID) + JE = ISNDRCVIA(PID+1) -1 + DO J=JS, JE + IID = ISNDRCVJA(J) + ISNDRCVA(J) = TMPD(IID) + ENDDO + CALL MPI_SEND(ISNDRCVA(OFFS), SZ, MPI_DOUBLE_PRECISION, PID-1, + & ITAGCOMM+1, COMM, IERROR) + ENDDO + IF(OSNDRCVNUM > 0) THEN + CALL MPI_WAITALL(OSNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + DO I=1,OSNDRCVNUM + PID = ONGHBPRCS(I) + JS = OSNDRCVIA(PID) + JE = OSNDRCVIA(PID+1) - 1 + DO J=JS,JE + IID = OSNDRCVJA(J) + TMPD(IID)=OSNDRCVA(J) + ENDDO + ENDDO + RETURN + END SUBROUTINE ZMUMPS_656 + SUBROUTINE ZMUMPS_655(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & IPARTVEC, ISZ, + & IWRK, IWSZ) + IMPLICIT NONE + EXTERNAL ZMUMPS_703 + INTEGER MYID, NUMPROCS, COMM + INTEGER NZ_loc, ISZ, IWSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWSZ) + INCLUDE 'mpif.h' + INTEGER I + INTEGER OP, IERROR + INTEGER IR, IC + IF(NUMPROCS.NE.1) THEN + CALL MPI_OP_CREATE(ZMUMPS_703, .TRUE., OP, IERROR) + CALL ZMUMPS_668(IWRK, 4*ISZ, ISZ) + DO I=1,ISZ + IWRK(2*I-1) = 0 + IWRK(2*I) = MYID + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.ISZ).AND. + & (IC.GE.1).AND.(IC.LE.ISZ)) THEN + IWRK(2*IR-1) = IWRK(2*IR-1) + 1 + IWRK(2*IC-1) = IWRK(2*IC-1) + 1 + ENDIF + ENDDO + CALL MPI_ALLREDUCE(IWRK(1), IWRK(1+2*ISZ), ISZ, + & MPI_2INTEGER, OP, COMM, IERROR) + DO I=1,ISZ + IPARTVEC(I) = IWRK(2*I+2*ISZ) + ENDDO + CALL MPI_OP_FREE(OP, IERROR) + ELSE + DO I=1,ISZ + IPARTVEC(I) = 0 + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_655 + SUBROUTINE ZMUMPS_673(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX,OINDX,ISNDRCVNUM,ISNDRCVVOL,OSNDRCVNUM,OSNDRCVVOL, + & IWRK,IWRKSZ, SNDSZ, RCVSZ, COMM) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, IWRKSZ + INTEGER ISNDRCVNUM, ISNDRCVVOL + INTEGER OSNDRCVNUM, OSNDRCVVOL + INTEGER COMM + INTEGER INDX(NZ_loc), OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER IWRK(IWRKSZ) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INCLUDE 'mpif.h' + INTEGER I + INTEGER IIND, IIND2, PIND + INTEGER IERROR + DO I=1,NUMPROCS + SNDSZ(I) = 0 + RCVSZ(I) = 0 + ENDDO + DO I=1,IWRKSZ + IWRK(I) = 0 + ENDDO + DO I=1,NZ_loc + IIND = INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND.(IIND2.GE.1) + & .AND.(IIND2.LE.ISZ)) THEN + PIND = IPARTVEC(IIND) + IF(PIND .NE. MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWRK(IIND) = 1 + SNDSZ(PIND+1) = SNDSZ(PIND+1)+1 + ENDIF + ENDIF + IIND = OINDX(I) + PIND = IPARTVEC(IIND) + IF(PIND .NE. MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWRK(IIND) = 1 + SNDSZ(PIND+1) = SNDSZ(PIND+1)+1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_ALLTOALL(SNDSZ, 1, MPI_INTEGER, + & RCVSZ, 1, MPI_INTEGER, COMM, IERROR) + ISNDRCVNUM = 0 + ISNDRCVVOL = 0 + OSNDRCVNUM = 0 + OSNDRCVVOL = 0 + DO I=1, NUMPROCS + IF(SNDSZ(I) > 0) OSNDRCVNUM = OSNDRCVNUM + 1 + OSNDRCVVOL = OSNDRCVVOL + SNDSZ(I) + IF(RCVSZ(I) > 0) ISNDRCVNUM = ISNDRCVNUM + 1 + ISNDRCVVOL = ISNDRCVVOL + RCVSZ(I) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_673 + SUBROUTINE ZMUMPS_663(MYID, NUMPROCS, COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & INUMMYR, + & IWRK, IWSZ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, N + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER PARTVEC(N) + INTEGER INUMMYR + INTEGER IWSZ + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC + INUMMYR = 0 + DO I=1,N + IWRK(I) = 0 + IF(PARTVEC(I).EQ.MYID) THEN + IWRK(I)=1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IR) .EQ. 0) THEN + IWRK(IR)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IC).EQ.0) THEN + IWRK(IC)= 1 + INUMMYR = INUMMYR + 1 + ENDIF + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_663 + INTEGER FUNCTION ZMUMPS_742(D, N, INDXR, INDXRSZ, + & EPS, COMM) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER N, INDXRSZ + DOUBLE PRECISION D(N) + INTEGER INDXR(INDXRSZ) + DOUBLE PRECISION EPS + INTEGER COMM + EXTERNAL ZMUMPS_744 + INTEGER ZMUMPS_744 + INTEGER GLORES, MYRESR, MYRES + INTEGER IERR + MYRESR = ZMUMPS_744(D, N, INDXR, INDXRSZ, EPS) + MYRES = 2*MYRESR + CALL MPI_ALLREDUCE(MYRES, GLORES, 1, MPI_INTEGER, + & MPI_SUM, COMM, IERR) + ZMUMPS_742 = GLORES + RETURN + END FUNCTION ZMUMPS_742 + SUBROUTINE ZMUMPS_661(MYID, NUMPROCS,COMM, + & IRN_loc, JCN_loc, NZ_loc, + & PARTVEC, N, + & MYROWINDICES, INUMMYR, + & IWRK, IWSZ ) + IMPLICIT NONE + INTEGER MYID, NUMPROCS, NZ_loc, N + INTEGER INUMMYR, IWSZ + INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc) + INTEGER PARTVEC(N) + INTEGER MYROWINDICES(INUMMYR) + INTEGER IWRK(IWSZ) + INTEGER COMM + INTEGER I, IR, IC, ITMP, MAXMN + MAXMN = N + DO I=1,N + IWRK(I) = 0 + IF(PARTVEC(I).EQ.MYID) IWRK(I)=1 + ENDDO + DO I=1,NZ_loc + IR = IRN_loc(I) + IC = JCN_loc(I) + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IR) .EQ. 0) IWRK(IR)= 1 + ENDIF + IF((IR.GE.1).AND.(IR.LE.N).AND. + & ((IC.GE.1).AND.(IC.LE.N))) THEN + IF(IWRK(IC) .EQ.0) IWRK(IC)=1 + ENDIF + ENDDO + ITMP = 1 + DO I=1,N + IF(IWRK(I).EQ.1) THEN + MYROWINDICES(ITMP) = I + ITMP = ITMP + 1 + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_661 + SUBROUTINE ZMUMPS_692(MYID, NUMPROCS, ISZ, IPARTVEC, + & NZ_loc, INDX, OINDX, + & ISNDRCVNUM, ISNDVOL, INGHBPRCS, ISNDRCVIA, ISNDRCVJA, + & OSNDRCVNUM, OSNDVOL, ONGHBPRCS, OSNDRCVIA, OSNDRCVJA, + & SNDSZ, RCVSZ, IWRK, + & ISTATUS, REQUESTS, + & ITAGCOMM, COMM ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER MYID, NUMPROCS, NZ_loc, ISZ, ISNDVOL, OSNDVOL + INTEGER INDX(NZ_loc), OINDX(NZ_loc) + INTEGER IPARTVEC(ISZ) + INTEGER ISNDRCVNUM, INGHBPRCS(ISNDRCVNUM) + INTEGER ISNDRCVIA(NUMPROCS+1) + INTEGER ISNDRCVJA(ISNDVOL) + INTEGER OSNDRCVNUM, ONGHBPRCS(OSNDRCVNUM) + INTEGER OSNDRCVIA(NUMPROCS+1) + INTEGER OSNDRCVJA(OSNDVOL) + INTEGER SNDSZ(NUMPROCS) + INTEGER RCVSZ(NUMPROCS) + INTEGER IWRK(ISZ) + INTEGER ISTATUS(MPI_STATUS_SIZE, ISNDRCVNUM) + INTEGER REQUESTS(ISNDRCVNUM) + INTEGER ITAGCOMM, COMM + INTEGER I, IIND,IIND2,IPID,OFFS,IWHERETO,POFFS, ITMP, IERROR + DO I=1,ISZ + IWRK(I) = 0 + ENDDO + OFFS = 1 + POFFS = 1 + DO I=1,NUMPROCS + OSNDRCVIA(I) = OFFS + SNDSZ(I) + IF(SNDSZ(I) > 0) THEN + ONGHBPRCS(POFFS)=I + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + SNDSZ(I) + ENDDO + OSNDRCVIA(NUMPROCS+1) = OFFS + DO I=1,NZ_loc + IIND=INDX(I) + IIND2 = OINDX(I) + IF((IIND.GE.1).AND.(IIND.LE.ISZ).AND.(IIND2.GE.1) + & .AND.(IIND2.LE.ISZ)) THEN + IPID=IPARTVEC(IIND) + IF(IPID.NE.MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWHERETO = OSNDRCVIA(IPID+1)-1 + OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1 + OSNDRCVJA(IWHERETO) = IIND + IWRK(IIND) = 1 + ENDIF + ENDIF + IIND = OINDX(I) + IPID=IPARTVEC(IIND) + IF(IPID.NE.MYID) THEN + IF(IWRK(IIND).EQ.0) THEN + IWHERETO = OSNDRCVIA(IPID+1)-1 + OSNDRCVIA(IPID+1) = OSNDRCVIA(IPID+1)-1 + OSNDRCVJA(IWHERETO) = IIND + IWRK(IIND) = 1 + ENDIF + ENDIF + ENDIF + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + OFFS = 1 + POFFS = 1 + ISNDRCVIA(1) = 1 + DO I=2,NUMPROCS+1 + ISNDRCVIA(I) = OFFS + RCVSZ(I-1) + IF(RCVSZ(I-1) > 0) THEN + INGHBPRCS(POFFS)=I-1 + POFFS = POFFS + 1 + ENDIF + OFFS = OFFS + RCVSZ(I-1) + ENDDO + CALL MPI_BARRIER(COMM,IERROR) + DO I=1, ISNDRCVNUM + IPID = INGHBPRCS(I) + OFFS = ISNDRCVIA(IPID) + ITMP = ISNDRCVIA(IPID+1) - ISNDRCVIA(IPID) + CALL MPI_IRECV(ISNDRCVJA(OFFS), ITMP, MPI_INTEGER,IPID-1, + & ITAGCOMM, COMM, REQUESTS(I),IERROR) + ENDDO + DO I=1,OSNDRCVNUM + IPID = ONGHBPRCS(I) + OFFS = OSNDRCVIA(IPID) + ITMP = OSNDRCVIA(IPID+1)-OSNDRCVIA(IPID) + CALL MPI_SEND(OSNDRCVJA(OFFS), ITMP, MPI_INTEGER, IPID-1, + & ITAGCOMM, COMM,IERROR) + ENDDO + IF(ISNDRCVNUM > 0) THEN + CALL MPI_WAITALL(ISNDRCVNUM, REQUESTS(1),ISTATUS(1,1),IERROR) + ENDIF + CALL MPI_BARRIER(COMM,IERROR) + RETURN + END SUBROUTINE ZMUMPS_692 + SUBROUTINE ZMUMPS_628(IW,LREC,SIZE_FREE,XSIZE) + INTEGER, intent(in) :: LREC, XSIZE + INTEGER, intent(in) :: IW(LREC) + INTEGER(8), intent(out):: SIZE_FREE + INCLUDE 'mumps_headers.h' + IF (IW(1+XXS).EQ.S_NOLCBCONTIG .OR. + & IW(1+XXS).EQ.S_NOLCBNOCONTIG) THEN + SIZE_FREE=int(IW(1+XSIZE+2),8)*int(IW(1+XSIZE+3),8) + ELSE IF (IW(1+XXS).EQ.S_NOLCBCONTIG38 .OR. + & IW(1+XXS).EQ.S_NOLCBNOCONTIG38) THEN + SIZE_FREE=int(IW(1+XSIZE+2),8)*int(IW(1+XSIZE)+ + & IW(1+XSIZE + 3) - + & ( IW(1+XSIZE + 4) + & - IW(1+XSIZE + 3) ), 8) + ELSE + SIZE_FREE=0_8 + ENDIF + RETURN + END SUBROUTINE ZMUMPS_628 + SUBROUTINE ZMUMPS_629 + &(IW,LIW,IXXP,ICURRENT,NEXT, RCURRENT,ISIZE2SHIFT) + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER(8) :: RCURRENT + INTEGER LIW,IXXP,ICURRENT,NEXT,ISIZE2SHIFT + INTEGER IW(LIW) + INTEGER(8) :: RSIZE + ICURRENT=NEXT + CALL MUMPS_729( RSIZE, IW(ICURRENT + XXR) ) + RCURRENT = RCURRENT - RSIZE + NEXT=IW(ICURRENT+XXP) + IW(IXXP)=ICURRENT+ISIZE2SHIFT + IXXP=ICURRENT+XXP + RETURN + END SUBROUTINE ZMUMPS_629 + SUBROUTINE ZMUMPS_630(IW,LIW,BEG2SHIFT,END2SHIFT,ISIZE2SHIFT) + IMPLICIT NONE + INTEGER LIW, BEG2SHIFT, END2SHIFT, ISIZE2SHIFT + INTEGER IW(LIW) + INTEGER I + IF (ISIZE2SHIFT.GT.0) THEN + DO I=END2SHIFT,BEG2SHIFT,-1 + IW(I+ISIZE2SHIFT)=IW(I) + ENDDO + ELSE IF (ISIZE2SHIFT.LT.0) THEN + DO I=BEG2SHIFT,END2SHIFT + IW(I+ISIZE2SHIFT)=IW(I) + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_630 + SUBROUTINE ZMUMPS_631(A, LA, BEG2SHIFT, END2SHIFT, RSIZE2SHIFT) + IMPLICIT NONE + INTEGER(8) :: LA, BEG2SHIFT, END2SHIFT, RSIZE2SHIFT + COMPLEX(kind=8) A(LA) + INTEGER(8) :: I + IF (RSIZE2SHIFT.GT.0_8) THEN + DO I=END2SHIFT,BEG2SHIFT,-1_8 + A(I+RSIZE2SHIFT)=A(I) + ENDDO + ELSE IF (RSIZE2SHIFT.LT.0_8) THEN + DO I=BEG2SHIFT,END2SHIFT + A(I+RSIZE2SHIFT)=A(I) + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_631 + SUBROUTINE ZMUMPS_94(N,KEEP28,IW,LIW,A,LA, + & LRLU,IPTRLU,IWPOS, + & IWPOSCB,PTRIST,PTRAST,STEP,PIMASTER,PAMASTER, + & KEEP216,LRLUS,XSIZE) + IMPLICIT NONE + INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS + INTEGER N,LIW,KEEP28, + & IWPOS,IWPOSCB,KEEP216,XSIZE + INTEGER(8) :: PTRAST(KEEP28), PAMASTER(KEEP28) + INTEGER IW(LIW),PTRIST(KEEP28), + & STEP(N), PIMASTER(KEEP28) + COMPLEX(kind=8) A(LA) + INCLUDE 'mumps_headers.h' + INTEGER ICURRENT, NEXT, STATE_NEXT + INTEGER(8) :: RCURRENT + INTEGER ISIZE2SHIFT + INTEGER(8) :: RSIZE2SHIFT + INTEGER IBEGCONTIG + INTEGER(8) :: RBEGCONTIG + INTEGER(8) :: RBEG2SHIFT, REND2SHIFT + INTEGER INODE + INTEGER(8) :: FREE_IN_REC + INTEGER(8) :: RCURRENT_SIZE + INTEGER IXXP + ISIZE2SHIFT=0 + RSIZE2SHIFT=0_8 + ICURRENT = LIW-XSIZE+1 + RCURRENT = LA+1_8 + IBEGCONTIG = -999999 + RBEGCONTIG = -999999_8 + NEXT = IW(ICURRENT+XXP) + IF (NEXT.EQ.TOP_OF_STACK) RETURN + STATE_NEXT = IW(NEXT+XXS) + IXXP = ICURRENT+XXP + 10 CONTINUE + IF ( STATE_NEXT .NE. S_FREE .AND. + & (KEEP216.EQ.3.OR. + & (STATE_NEXT .NE. S_NOLCBNOCONTIG .AND. + & STATE_NEXT .NE. S_NOLCBCONTIG .AND. + & STATE_NEXT .NE. S_NOLCBNOCONTIG38 .AND. + & STATE_NEXT .NE. S_NOLCBCONTIG38))) THEN + CALL ZMUMPS_629(IW,LIW, + & IXXP, ICURRENT, NEXT, RCURRENT, ISIZE2SHIFT) + CALL MUMPS_729(RCURRENT_SIZE, IW(ICURRENT+XXR)) + IF (IBEGCONTIG < 0) THEN + IBEGCONTIG=ICURRENT+IW(ICURRENT+XXI)-1 + ENDIF + IF (RBEGCONTIG < 0_8) THEN + RBEGCONTIG=RCURRENT+RCURRENT_SIZE-1_8 + ENDIF + INODE=IW(ICURRENT+XXN) + IF (RSIZE2SHIFT .NE. 0_8) THEN + IF (PTRAST(STEP(INODE)).EQ.RCURRENT) + & PTRAST(STEP(INODE))= + & PTRAST(STEP(INODE))+RSIZE2SHIFT + IF (PAMASTER(STEP(INODE)).EQ.RCURRENT) + & PAMASTER(STEP(INODE))= + & PAMASTER(STEP(INODE))+RSIZE2SHIFT + ENDIF + IF (ISIZE2SHIFT .NE. 0) THEN + IF (PTRIST(STEP(INODE)).EQ.ICURRENT) + & PTRIST(STEP(INODE))= + & PTRIST(STEP(INODE))+ISIZE2SHIFT + IF (PIMASTER(STEP(INODE)).EQ.ICURRENT) + & PIMASTER(STEP(INODE))= + & PIMASTER(STEP(INODE))+ISIZE2SHIFT + ENDIF + IF (NEXT .NE. TOP_OF_STACK) THEN + STATE_NEXT=IW(NEXT+XXS) + GOTO 10 + ENDIF + ENDIF + 20 CONTINUE + IF (IBEGCONTIG.NE.0 .AND. ISIZE2SHIFT .NE. 0) THEN + CALL ZMUMPS_630(IW,LIW,ICURRENT,IBEGCONTIG,ISIZE2SHIFT) + IF (IXXP .LE.IBEGCONTIG) THEN + IXXP=IXXP+ISIZE2SHIFT + ENDIF + ENDIF + IBEGCONTIG=-9999 + 25 CONTINUE + IF (RBEGCONTIG .GT.0_8 .AND. RSIZE2SHIFT .NE. 0_8) THEN + CALL ZMUMPS_631(A,LA,RCURRENT,RBEGCONTIG,RSIZE2SHIFT) + ENDIF + RBEGCONTIG=-99999_8 + 30 CONTINUE + IF (NEXT.EQ. TOP_OF_STACK) GOTO 100 + IF (STATE_NEXT .EQ. S_NOLCBCONTIG .OR. + & STATE_NEXT .EQ. S_NOLCBNOCONTIG .OR. + & STATE_NEXT .EQ. S_NOLCBCONTIG38 .OR. + & STATE_NEXT .EQ. S_NOLCBNOCONTIG38) THEN + IF ( KEEP216.eq.3) THEN + WRITE(*,*) "Internal error 2 in ZMUMPS_94" + ENDIF + IF (RBEGCONTIG > 0_8) GOTO 25 + CALL ZMUMPS_629 + & (IW,LIW,IXXP,ICURRENT,NEXT, RCURRENT,ISIZE2SHIFT) + IF (IBEGCONTIG < 0 ) THEN + IBEGCONTIG=ICURRENT+IW(ICURRENT+XXI)-1 + ENDIF + CALL ZMUMPS_628(IW(ICURRENT), + & LIW-ICURRENT+1, + & FREE_IN_REC, + & XSIZE) + IF (STATE_NEXT .EQ. S_NOLCBNOCONTIG) THEN + CALL ZMUMPS_627(A,LA,RCURRENT, + & IW(ICURRENT+XSIZE+2), + & IW(ICURRENT+XSIZE), + & IW(ICURRENT+XSIZE)+IW(ICURRENT+XSIZE+3), 0, + & IW(ICURRENT+XXS),RSIZE2SHIFT) + ELSE IF (STATE_NEXT .EQ. S_NOLCBNOCONTIG38) THEN + CALL ZMUMPS_627(A,LA,RCURRENT, + & IW(ICURRENT+XSIZE+2), + & IW(ICURRENT+XSIZE), + & IW(ICURRENT+XSIZE)+IW(ICURRENT+XSIZE+3), + & IW(ICURRENT+XSIZE+4)-IW(ICURRENT+XSIZE+3), + & IW(ICURRENT+XXS),RSIZE2SHIFT) + ELSE IF (RSIZE2SHIFT .GT.0_8) THEN + RBEG2SHIFT = RCURRENT + FREE_IN_REC + CALL MUMPS_729(RCURRENT_SIZE, IW(ICURRENT+XXR)) + REND2SHIFT = RCURRENT + RCURRENT_SIZE - 1_8 + CALL ZMUMPS_631(A, LA, + & RBEG2SHIFT, REND2SHIFT, + & RSIZE2SHIFT) + ENDIF + INODE=IW(ICURRENT+XXN) + IF (ISIZE2SHIFT.NE.0) THEN + PTRIST(STEP(INODE))=PTRIST(STEP(INODE))+ISIZE2SHIFT + ENDIF + PTRAST(STEP(INODE))=PTRAST(STEP(INODE))+RSIZE2SHIFT+ + & FREE_IN_REC + CALL MUMPS_724(IW(ICURRENT+XXR),FREE_IN_REC) + IF (STATE_NEXT.EQ.S_NOLCBCONTIG.OR. + & STATE_NEXT.EQ.S_NOLCBNOCONTIG) THEN + IW(ICURRENT+XXS)=S_NOLCLEANED + ELSE + IW(ICURRENT+XXS)=S_NOLCLEANED38 + ENDIF + RSIZE2SHIFT=RSIZE2SHIFT+FREE_IN_REC + RBEGCONTIG=-9999_8 + IF (NEXT.EQ.TOP_OF_STACK) THEN + GOTO 20 + ELSE + STATE_NEXT=IW(NEXT+XXS) + ENDIF + GOTO 30 + ENDIF + IF (IBEGCONTIG.GT.0) THEN + GOTO 20 + ENDIF + 40 CONTINUE + IF (STATE_NEXT == S_FREE) THEN + ICURRENT = NEXT + CALL MUMPS_729( RCURRENT_SIZE, IW(ICURRENT + XXR) ) + ISIZE2SHIFT = ISIZE2SHIFT + IW(ICURRENT+XXI) + RSIZE2SHIFT = RSIZE2SHIFT + RCURRENT_SIZE + RCURRENT = RCURRENT - RCURRENT_SIZE + NEXT=IW(ICURRENT+XXP) + IF (NEXT.EQ.TOP_OF_STACK) THEN + WRITE(*,*) "Internal error 1 in ZMUMPS_94" + CALL MUMPS_ABORT() + ENDIF + STATE_NEXT = IW(NEXT+XXS) + GOTO 40 + ENDIF + GOTO 10 + 100 CONTINUE + IWPOSCB = IWPOSCB + ISIZE2SHIFT + LRLU = LRLU + RSIZE2SHIFT + IPTRLU = IPTRLU + RSIZE2SHIFT + RETURN + END SUBROUTINE ZMUMPS_94 + SUBROUTINE ZMUMPS_632(IREC, IW, LIW, + & ISIZEHOLE, RSIZEHOLE) + IMPLICIT NONE + INTEGER, intent(in) :: IREC, LIW + INTEGER, intent(in) :: IW(LIW) + INTEGER, intent(out):: ISIZEHOLE + INTEGER(8), intent(out) :: RSIZEHOLE + INTEGER IRECLOC + INTEGER(8) :: RECLOC_SIZE + INCLUDE 'mumps_headers.h' + ISIZEHOLE=0 + RSIZEHOLE=0_8 + IRECLOC = IREC + IW( IREC+XXI ) + 10 CONTINUE + CALL MUMPS_729(RECLOC_SIZE, IW(IRECLOC+XXR)) + IF (IW(IRECLOC+XXS).EQ.S_FREE) THEN + ISIZEHOLE=ISIZEHOLE+IW(IRECLOC+XXI) + RSIZEHOLE=RSIZEHOLE+RECLOC_SIZE + IRECLOC=IRECLOC+IW(IRECLOC+XXI) + GOTO 10 + ENDIF + RETURN + END SUBROUTINE ZMUMPS_632 + SUBROUTINE ZMUMPS_627(A, LA, RCURRENT, + & NROW, NCB, LD, NELIM, NODESTATE, ISHIFT) + IMPLICIT NONE + INCLUDE 'mumps_headers.h' + INTEGER LD, NROW, NCB, NELIM, NODESTATE + INTEGER(8) :: ISHIFT + INTEGER(8) :: LA, RCURRENT + COMPLEX(kind=8) A(LA) + INTEGER I,J + INTEGER(8) :: IOLD,INEW + LOGICAL NELIM_ROOT + NELIM_ROOT=.TRUE. + IF (NODESTATE.EQ. S_NOLCBNOCONTIG) THEN + NELIM_ROOT=.FALSE. + IF (NELIM.NE.0) THEN + WRITE(*,*) "Internal error 1 IN ZMUMPS_627" + CALL MUMPS_ABORT() + ENDIF + ELSE IF (NODESTATE .NE. S_NOLCBNOCONTIG38) THEN + WRITE(*,*) "Internal error 2 in ZMUMPS_627" + & ,NODESTATE + CALL MUMPS_ABORT() + ENDIF + IF (ISHIFT .LT.0_8) THEN + WRITE(*,*) "Internal error 3 in ZMUMPS_627",ISHIFT + CALL MUMPS_ABORT() + ENDIF + IF (NELIM_ROOT) THEN + IOLD=RCURRENT+int(LD,8)*int(NROW,8)+int(NELIM-1-NCB,8) + ELSE + IOLD = RCURRENT+int(LD,8)*int(NROW,8)-1_8 + ENDIF + INEW = RCURRENT+int(LD,8)*int(NROW,8)+ISHIFT-1_8 + DO I = NROW, 1, -1 + IF (I.EQ.NROW .AND. ISHIFT.EQ.0_8.AND. + & .NOT. NELIM_ROOT) THEN + IOLD=IOLD-int(LD,8) + INEW=INEW-int(NCB,8) + CYCLE + ENDIF + IF (NELIM_ROOT) THEN + DO J=1,NELIM + A( INEW ) = A( IOLD + int(- J + 1,8)) + INEW = INEW - 1_8 + ENDDO + ELSE + DO J=1, NCB + A( INEW ) = A( IOLD + int(- J + 1, 8)) + INEW = INEW - 1_8 + ENDDO + ENDIF + IOLD = IOLD - int(LD,8) + ENDDO + IF (NELIM_ROOT) THEN + NODESTATE=S_NOLCBCONTIG38 + ELSE + NODESTATE=S_NOLCBCONTIG + ENDIF + RETURN + END SUBROUTINE ZMUMPS_627 + SUBROUTINE ZMUMPS_700(BUFR,LBUFR, + & LBUFR_BYTES, + & root, N, IW, LIW, A, LA, + & NBPROCFILS, LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER, + & COMP, LRLUS, IPOOL, LPOOL, LEAF, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, + & ITLOC, RHS_MUMPS, + & ND,PROCNODE_STEPS,SLAVEF ) + USE ZMUMPS_LOAD + USE ZMUMPS_OOC + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC ) :: root + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER LBUFR, LBUFR_BYTES, N, LIW, + & IWPOS, IWPOSCB, COMP, COMM, COMM_LOAD, IFLAG, + & IERROR + INTEGER LPOOL, LEAF + INTEGER IPOOL( LEAF ) + INTEGER PTRIST(KEEP(28)) + INTEGER PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)), ITLOC( N+KEEP(253) ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER BUFR( LBUFR_BYTES ), NBPROCFILS( KEEP(28) ) + INTEGER IW( LIW ) + INTEGER ND(KEEP(28)), PROCNODE_STEPS(KEEP(28)),SLAVEF + COMPLEX(kind=8) A( LA ) + INTEGER MYID + INTEGER FILS( N ), PTRAIW(N), PTRARW( N ) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + INCLUDE 'mpif.h' + INTEGER IERR + INTEGER POSITION, LOCAL_M, LOCAL_N, LREQI + INTEGER(8) :: LREQA, POS_ROOT + INTEGER NSUBSET_ROW, NSUBSET_COL, IROOT, ISON, NSUBSET_COL_EFF + INTEGER NSUPCOL_EFF + INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET + INTEGER NSUPROW, NSUPCOL, BBPCBP + INCLUDE 'mumps_headers.h' + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & ISON, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUBSET_ROW, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUPROW, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUBSET_COL, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NSUPCOL, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_ALREADY_SENT, 1, MPI_INTEGER, + & COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NBROWS_PACKET, 1, MPI_INTEGER, + & COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & BBPCBP, 1, MPI_INTEGER, + & COMM, IERR ) + IF (BBPCBP .EQ. 1) THEN + NSUBSET_COL_EFF = NSUBSET_COL - NSUPCOL + NSUPCOL_EFF = 0 + ELSE + NSUBSET_COL_EFF = NSUBSET_COL + NSUPCOL_EFF = NSUPCOL + ENDIF + IROOT = KEEP( 38 ) + IF ( PTRIST( STEP(IROOT) ) .NE. 0 .OR. + & PTLUST_S( STEP(IROOT)) .NE. 0 ) THEN + IF (NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. NSUBSET_ROW + & - NSUPROW .OR. NSUBSET_ROW - NSUPROW.EQ.0 .OR. + & NSUBSET_COL_EFF .EQ. 0)THEN + NBPROCFILS(STEP(IROOT)) = NBPROCFILS(STEP(IROOT))-1 + IF ( NBPROCFILS( STEP(IROOT) ) .eq. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + CALL ZMUMPS_681(IERR) + ELSEIF (KEEP(201).EQ.2) THEN + CALL ZMUMPS_580(IERR) + ENDIF + CALL ZMUMPS_507( N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), + & STEP, IROOT + N) + IF (KEEP(47) .GE. 3) THEN + CALL ZMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + ENDIF + ENDIF + ELSE + IF (NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. + & NSUBSET_ROW - NSUPROW .OR. + & NSUBSET_ROW - NSUPROW.EQ.0 .OR. + & NSUBSET_COL_EFF .EQ. 0)THEN + NBPROCFILS(STEP( IROOT ) ) = -1 + ENDIF + IF (KEEP(60) == 0) THEN + CALL ZMUMPS_284( root, IROOT, N, + & IW, LIW, A, LA, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + IF ( IFLAG .LT. 0 ) RETURN + ELSE + PTRIST(STEP(IROOT)) = -55555 + ENDIF + END IF + IF (KEEP(60) .EQ.0) THEN + IF ( PTRIST(STEP(IROOT)) .GE. 0 ) THEN + IF ( PTRIST(STEP(IROOT)) .NE. 0 ) THEN + LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) ) + LOCAL_M = IW( PTRIST(STEP( IROOT )) + 1 + KEEP(IXSZ)) + POS_ROOT = PAMASTER(STEP( IROOT )) + ELSE + LOCAL_N = IW( PTLUST_S(STEP( IROOT ) ) + 1 + KEEP(IXSZ)) + LOCAL_M = IW( PTLUST_S(STEP( IROOT ) ) + 2 + KEEP(IXSZ)) + POS_ROOT = PTRFAC(IW(PTLUST_S(STEP(IROOT))+4+ + & KEEP(IXSZ))) + END IF + ENDIF + ELSE + LOCAL_M = root%SCHUR_LLD + LOCAL_N = root%SCHUR_NLOC + ENDIF + IF ( (BBPCBP.EQ.1).AND. (NBROWS_ALREADY_SENT.EQ.0).AND. + & (min(NSUPROW, NSUPCOL) .GT. 0) + & ) THEN + LREQI = NSUPROW+NSUPCOL + LREQA = int(NSUPROW,8) * int(NSUPCOL,8) + IF ( (LREQA.NE.0_8) .AND. + & (PTRIST(STEP(IROOT)).LT.0).AND. + & KEEP(60)==0) THEN + WRITE(*,*) ' Error in ZMUMPS_700' + CALL MUMPS_ABORT() + ENDIF + CALL ZMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A, LA, + & LRLU, IPTRLU, IWPOS, IWPOSCB, PTRIST, + & PTRAST, STEP, PIMASTER, PAMASTER, + & LREQI, LREQA, -1234, S_NOTFREE, .FALSE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IWPOSCB + 1 ), LREQI, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A( IPTRLU + 1_8 ), int(LREQA), + & MPI_DOUBLE_COMPLEX, COMM, IERR ) + CALL ZMUMPS_38( NSUPROW, NSUPCOL, + & IW( IWPOSCB + 1 ), + & IW( IWPOSCB + NSUPROW + 1 ), NSUPCOL, + & A( IPTRLU + 1_8 ), + & A( 1 ), + & LOCAL_M, LOCAL_N, + & root%RHS_ROOT(1,1), root%RHS_NLOC, + & 1) + IWPOSCB = IWPOSCB + LREQI + IPTRLU = IPTRLU + LREQA + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU) + ENDIF + LREQI = NBROWS_PACKET + NSUBSET_COL_EFF + LREQA = int(NBROWS_PACKET,8) * int(NSUBSET_COL_EFF,8) + IF ( (LREQA.NE.0_8) .AND. + & (PTRIST(STEP(IROOT)).LT.0).AND. + & KEEP(60)==0) THEN + WRITE(*,*) ' Error in ZMUMPS_700' + CALL MUMPS_ABORT() + ENDIF + IF (LREQA.NE.0_8) THEN + CALL ZMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A, LA, + & LRLU, IPTRLU, IWPOS, IWPOSCB, PTRIST, + & PTRAST, STEP, PIMASTER, PAMASTER, + & LREQI, LREQA, -1234, S_NOTFREE, .FALSE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IWPOSCB + 1 ), LREQI, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A( IPTRLU + 1_8 ), int(LREQA), + & MPI_DOUBLE_COMPLEX, COMM, IERR ) + IF (KEEP(60).EQ.0) THEN + CALL ZMUMPS_38( NBROWS_PACKET, NSUBSET_COL_EFF, + & IW( IWPOSCB + 1 ), + & IW( IWPOSCB + NBROWS_PACKET + 1 ), + & NSUPCOL_EFF, + & A( IPTRLU + 1_8 ), + & A( POS_ROOT ), LOCAL_M, LOCAL_N, + & root%RHS_ROOT(1,1), root%RHS_NLOC, + & 0) + ELSE + CALL ZMUMPS_38( NBROWS_PACKET, NSUBSET_COL_EFF, + & IW( IWPOSCB + 1 ), + & IW( IWPOSCB + NBROWS_PACKET + 1 ), + & NSUPCOL_EFF, + & A( IPTRLU + 1_8 ), + & root%SCHUR_POINTER(1), + & root%SCHUR_LLD , root%SCHUR_NLOC, + & root%RHS_ROOT(1,1), root%RHS_NLOC, + & 0) + ENDIF + IWPOSCB = IWPOSCB + LREQI + IPTRLU = IPTRLU + LREQA + LRLU = LRLU + LREQA + LRLUS = LRLUS + LREQA + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_700 + SUBROUTINE ZMUMPS_762(PIV, DETER, NEXP) + IMPLICIT NONE + COMPLEX(kind=8), intent(in) :: PIV + COMPLEX(kind=8), intent(inout) :: DETER + INTEGER, intent(inout) :: NEXP + DOUBLE PRECISION R_PART, C_PART + INTEGER NEXP_LOC + DETER=DETER*PIV + R_PART=dble(DETER) + C_PART=aimag(DETER) + NEXP_LOC = exponent(abs(R_PART)+abs(C_PART)) + NEXP = NEXP + NEXP_LOC + R_PART=scale(R_PART, -NEXP_LOC) + C_PART=scale(C_PART, -NEXP_LOC) + DETER=cmplx(R_PART,C_PART,kind=kind(DETER)) + RETURN + END SUBROUTINE ZMUMPS_762 + SUBROUTINE ZMUMPS_761(PIV, DETER, NEXP) + IMPLICIT NONE + DOUBLE PRECISION, intent(in) :: PIV + DOUBLE PRECISION, intent(inout) :: DETER + INTEGER, intent(inout) :: NEXP + DETER=DETER*fraction(PIV) + NEXP=NEXP+exponent(PIV)+exponent(DETER) + DETER=fraction(DETER) + RETURN + END SUBROUTINE ZMUMPS_761 + SUBROUTINE ZMUMPS_763(BLOCK_SIZE,IPIV, + & MYROW, MYCOL, NPROW, NPCOL, + & A, LOCAL_M, LOCAL_N, N, MYID, + & DETER,NEXP,SYM) + IMPLICIT NONE + INTEGER, intent (in) :: SYM + INTEGER, intent (inout) :: NEXP + COMPLEX(kind=8), intent (inout) :: DETER + INTEGER, intent (in) :: BLOCK_SIZE, NPROW, NPCOL, + & LOCAL_M, LOCAL_N, N + INTEGER, intent (in) :: MYROW, MYCOL, MYID, IPIV(LOCAL_M) + COMPLEX(kind=8), intent(in) :: A(*) + INTEGER I,IMX,DI,NBLOCK,IBLOCK,ILOC,JLOC, + & ROW_PROC,COL_PROC, K + DI = LOCAL_M + 1 + NBLOCK = ( N - 1 ) / BLOCK_SIZE + DO IBLOCK = 0, NBLOCK + ROW_PROC = mod( IBLOCK, NPROW ) + IF ( MYROW.EQ.ROW_PROC ) THEN + COL_PROC = mod( IBLOCK, NPCOL ) + IF ( MYCOL.EQ.COL_PROC ) THEN + ILOC = ( IBLOCK / NPROW ) * BLOCK_SIZE + JLOC = ( IBLOCK / NPCOL ) * BLOCK_SIZE + I = ILOC + JLOC * LOCAL_M + 1 + IMX = min(ILOC+BLOCK_SIZE,LOCAL_M) + & + (min(JLOC+BLOCK_SIZE,LOCAL_N)-1)*LOCAL_M + & + 1 + K=1 + DO WHILE ( I .LT. IMX ) + CALL ZMUMPS_762(A(I),DETER,NEXP) + IF (SYM.NE.1) THEN + IF (IPIV(ILOC+K) .NE. IBLOCK*BLOCK_SIZE+K) THEN + DETER = -DETER + ENDIF + ENDIF + K = K + 1 + I = I + DI + END DO + END IF + END IF + END DO + RETURN + END SUBROUTINE ZMUMPS_763 + SUBROUTINE ZMUMPS_764( + & COMM, DETER_IN, NEXP_IN, + & DETER_OUT, NEXP_OUT, NPROCS) + IMPLICIT NONE + INTEGER, intent(in) :: COMM, NPROCS + COMPLEX(kind=8), intent(in) :: DETER_IN + INTEGER,intent(in) :: NEXP_IN + COMPLEX(kind=8),intent(out):: DETER_OUT + INTEGER,intent(out):: NEXP_OUT + INTEGER :: IERR_MPI + EXTERNAL ZMUMPS_771 + INTEGER TWO_SCALARS_TYPE, DETERREDUCE_OP + COMPLEX(kind=8) :: INV(2) + COMPLEX(kind=8) :: OUTV(2) + INCLUDE 'mpif.h' + IF (NPROCS .EQ. 1) THEN + DETER_OUT = DETER_IN + NEXP_OUT = NEXP_IN + RETURN + ENDIF + CALL MPI_TYPE_CONTIGUOUS(2, MPI_DOUBLE_COMPLEX, + & TWO_SCALARS_TYPE, + & IERR_MPI) + CALL MPI_TYPE_COMMIT(TWO_SCALARS_TYPE, IERR_MPI) + CALL MPI_OP_CREATE(ZMUMPS_771, + & .TRUE., + & DETERREDUCE_OP, + & IERR_MPI) + INV(1)=DETER_IN + INV(2)=cmplx(NEXP_IN,kind=kind(INV)) + CALL MPI_ALLREDUCE( INV, OUTV, 1, TWO_SCALARS_TYPE, + & DETERREDUCE_OP, COMM, IERR_MPI) + CALL MPI_OP_FREE(DETERREDUCE_OP, IERR_MPI) + CALL MPI_TYPE_FREE(TWO_SCALARS_TYPE, IERR_MPI) + DETER_OUT = OUTV(1) + NEXP_OUT = int(OUTV(2)) + RETURN + END SUBROUTINE ZMUMPS_764 + SUBROUTINE ZMUMPS_771(INV, INOUTV, NEL, DATATYPE) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NEL, DATATYPE + COMPLEX(kind=8), INTENT(IN) :: INV ( 2 * NEL ) + COMPLEX(kind=8), INTENT(INOUT) :: INOUTV ( 2 * NEL ) + INTEGER I, TMPEXPIN, TMPEXPINOUT + DO I = 1, NEL + TMPEXPIN = int(INV (I*2)) + TMPEXPINOUT = int(INOUTV(I*2)) + CALL ZMUMPS_762(INV(I*2-1), + & INOUTV(I*2-1), + & TMPEXPINOUT) + TMPEXPINOUT = TMPEXPINOUT + TMPEXPIN + INOUTV(I*2) = cmplx(TMPEXPINOUT,kind=kind(INOUTV)) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_771 + SUBROUTINE ZMUMPS_765(DETER, NEXP) + IMPLICIT NONE + INTEGER, intent (inout) :: NEXP + COMPLEX(kind=8), intent (inout) :: DETER + DETER=DETER*DETER + NEXP=NEXP+NEXP + RETURN + END SUBROUTINE ZMUMPS_765 + SUBROUTINE ZMUMPS_766(DETER, NEXP) + IMPLICIT NONE + INTEGER, intent (inout) :: NEXP + DOUBLE PRECISION, intent (inout) :: DETER + DETER=1.0D0/DETER + NEXP=-NEXP + RETURN + END SUBROUTINE ZMUMPS_766 + SUBROUTINE ZMUMPS_767(DETER, N, VISITED, PERM) + IMPLICIT NONE + COMPLEX(kind=8), intent(inout) :: DETER + INTEGER, intent(in) :: N + INTEGER, intent(inout) :: VISITED(N) + INTEGER, intent(in) :: PERM(N) + INTEGER I, J, K + K = 0 + DO I = 1, N + IF (VISITED(I) .GT. N) THEN + VISITED(I)=VISITED(I)-N-N-1 + CYCLE + ENDIF + J = PERM(I) + DO WHILE (J.NE.I) + VISITED(J) = VISITED(J) + N + N + 1 + K = K + 1 + J = PERM(J) + ENDDO + ENDDO + IF (mod(K,2).EQ.1) THEN + DETER = -DETER + ENDIF + RETURN + END SUBROUTINE ZMUMPS_767 + SUBROUTINE ZMUMPS_224(NFRONT,NASS,IBEGKJI, LPIV, TIPIV, + & N,INODE,IW,LIW,A,LA, + & INOPV,NOFFW,IFLAG,IOLDPS,POSELT,UU,SEUIL,KEEP,KEEP8, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER IBEGKJI, LPIV + INTEGER TIPIV(LPIV) + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV,NOFFW + DOUBLE PRECISION UU, SEUIL + INTEGER IW(LIW) + INTEGER IOLDPS + INTEGER(8) :: POSELT + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L, + & PP_FIRST2SWAP_U, PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U + COMPLEX(kind=8) SWOP + INTEGER(8) :: APOS, IDIAG + INTEGER(8) :: J1, J2, JJ, J3_8 + INTEGER(8) :: NFRONT8 + INTEGER ILOC + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + DOUBLE PRECISION RZERO, RMAX, AMROW, ONE + DOUBLE PRECISION PIVNUL + COMPLEX(kind=8) FIXA, CSEUIL + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,JMAX,J3,ISW,ISWPS1 + INTEGER ISWPS2,KSW, HF + INCLUDE 'mumps_headers.h' + INTEGER ZMUMPS_IXAMAX + INTRINSIC max + DATA RZERO /0.0D0/ + DATA ONE /1.0D0/ + INTEGER I_PIVRPTR_L, I_PIVR_L, NBPANELS_L + INTEGER I_PIVRPTR_U, I_PIVR_U, NBPANELS_U + INTEGER XSIZE + PIVNUL = DKEEP(1) + FIXA = cmplx(DKEEP(2),kind=kind(FIXA)) + CSEUIL = cmplx(SEUIL,kind=kind(CSEUIL)) + NFRONT8=int(NFRONT,8) + XSIZE = KEEP(IXSZ) + NPIV = IW(IOLDPS+1+XSIZE) + HF = 6 + IW(IOLDPS+5+XSIZE)+XSIZE + NPIVP1 = NPIV + 1 + IF (KEEP(201).EQ.1) THEN + CALL ZMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR_L, I_PIVR_L, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + CALL ZMUMPS_667(TYPEF_U, NBPANELS_U, + & I_PIVRPTR_U, I_PIVR_U, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE, + & IW, LIW) + ENDIF + ILOC = NPIVP1 - IBEGKJI + 1 + TIPIV(ILOC) = ILOC + NASSW = iabs(IW(IOLDPS+3+XSIZE)) + IF(INOPV .EQ. -1) THEN + APOS = POSELT + NFRONT8*int(NPIVP1-1,8) + int(NPIV,8) + IDIAG = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF (dble(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + KEEP(98) = KEEP(98)+1 + ELSE IF (KEEP(258) .NE. 0) THEN + CALL ZMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL ZMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL ZMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + NFRONT8*int(IPIV-1,8) + int(NPIV,8) + JMAX = 1 + IF (UU.GT.RZERO) GO TO 340 + IF (A(APOS).EQ.ZERO) GO TO 630 + GO TO 380 + 340 AMROW = RZERO + J1 = APOS + J2 = APOS +int(- NPIV + NASS - 1,8) + J3 = NASS -NPIV + JMAX = ZMUMPS_IXAMAX(J3,A(J1),1) + JJ = int(JMAX,8) + J1 - 1_8 + AMROW = abs(A(JJ)) + RMAX = AMROW + J1 = J2 + 1_8 + J2 = APOS +int(- NPIV + NFRONT - KEEP(253)- 1,8) + IF (J2.LT.J1) GO TO 370 + DO 360 JJ=J1,J2 + RMAX = max(abs(A(JJ)),RMAX) + 360 CONTINUE + 370 IDIAG = APOS + int(IPIV - NPIVP1,8) + IF (RMAX.LE.PIVNUL) THEN + KEEP(109) = KEEP(109)+1 + ISW = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6+KEEP(IXSZ)+ + & IW(IOLDPS+5+KEEP(IXSZ))+IPIV-NPIVP1 + PIVNUL_LIST(KEEP(109)) = IW(ISW) + IF(dble(FIXA).GT.RZERO) THEN + IF(dble(A(IDIAG)) .GE. RZERO) THEN + A(IDIAG) = FIXA + ELSE + A(IDIAG) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = APOS +int(- NPIV + NFRONT - KEEP(253) - 1,8) + DO JJ=J1,J2 + A(JJ)= ZERO + ENDDO + A(IDIAG) = -FIXA + ENDIF + JMAX = IPIV - NPIV + GOTO 385 + ENDIF + IF (abs(A(IDIAG)).GT.max(UU*RMAX,SEUIL)) THEN + JMAX = IPIV - NPIV + GO TO 380 + ENDIF + IF (AMROW.LE.max(UU*RMAX,SEUIL)) GO TO 460 + NOFFW = NOFFW + 1 + 380 CONTINUE + IF (KEEP(258).NE.0) THEN + CALL ZMUMPS_762( A(APOS+int(JMAX-1,8)), + & DKEEP(6), + & KEEP(259)) + ENDIF + 385 CONTINUE + IF (IPIV.EQ.NPIVP1) GO TO 400 + KEEP(260)=-KEEP(260) + J1 = POSELT + int(NPIV,8)*NFRONT8 + J2 = J1 + NFRONT8 - 1_8 + J3_8 = POSELT + int(IPIV-1,8)*NFRONT8 + DO 390 JJ=J1,J2 + SWOP = A(JJ) + A(JJ) = A(J3_8) + A(J3_8) = SWOP + J3_8 = J3_8 + 1_8 + 390 CONTINUE + ISWPS1 = IOLDPS + HF - 1 + NPIVP1 + ISWPS2 = IOLDPS + HF - 1 + IPIV + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + 400 IF (JMAX.EQ.1) GO TO 420 + KEEP(260)=-KEEP(260) + TIPIV(ILOC) = ILOC + JMAX - 1 + J1 = POSELT + int(NPIV,8) + J2 = POSELT + int(NPIV + JMAX - 1,8) + DO 410 KSW=1,NASS + SWOP = A(J1) + A(J1) = A(J2) + A(J2) = SWOP + J1 = J1 + NFRONT8 + J2 = J2 + NFRONT8 + 410 CONTINUE + ISWPS1 = IOLDPS + HF - 1 + NFRONT + NPIV + 1 + ISWPS2 = IOLDPS + HF - 1 + NFRONT + NPIV + JMAX + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + GO TO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 430 + 630 CONTINUE + IFLAG = -10 + WRITE(*,*) 'NIV2:Detected 0 pivot, INODE,NPIV=',INODE,NPIV + GOTO 430 + 420 CONTINUE + IF (KEEP(201).EQ.1) THEN + IF (KEEP(251).EQ.0) THEN + CALL ZMUMPS_680( IW(I_PIVRPTR_L), + & NBPANELS_L, + & IW(I_PIVR_L), NASS, NPIVP1, IPIV, + & PP_LastPanelonDisk_L, + & PP_LastPIVRPTRFilled_L) + ENDIF + CALL ZMUMPS_680( IW(I_PIVRPTR_U), + & NBPANELS_U, + & IW(I_PIVR_U), NASS, NPIVP1, NPIV+JMAX, + & PP_LastPanelonDisk_U, + & PP_LastPIVRPTRFilled_U) + ENDIF + 430 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_224 + SUBROUTINE ZMUMPS_294( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & IW, LIW, + & IOLDPS, POSELT, A, LA, LDA_FS, + & IBEGKJI, IEND, TIPIV, LPIV, LASTBL, NB_BLOC_FAC, + & + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mpif.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, INODE, FPERE, LIW, IBEGKJI, IEND, LPIV, + & IOLDPS, LDA_FS, NB_BLOC_FAC + INTEGER(8) :: POSELT, LA + INTEGER IW(LIW), TIPIV(LPIV) + LOGICAL LASTBL + COMPLEX(kind=8) A(LA) + INTEGER COMM, MYID, LBUFR, LBUFR_BYTES + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NBFIN, IFLAG, IERROR, LEAF, LPOOL, + & SLAVEF, ICNTL(40) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS + INTEGER IWPOS, IWPOSCB, COMP + INTEGER BUFR( LBUFR ), IPOOL(LPOOL), + & ITLOC(N+KEEP(253)), FILS(N), + & PTRARW(LPTRAR), PTRAIW(LPTRAR), + & ND( KEEP(28) ), FRERE( KEEP(28) ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER(8) :: PTRAST (KEEP(28)) + INTEGER(8) :: PTRFAC (KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), + & STEP(N), PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), + & NBPROCFILS(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + EXTERNAL ZMUMPS_329 + INCLUDE 'mumps_headers.h' + INTEGER(8) :: APOS, LREQA + INTEGER NPIV, NCOL, PDEST, NSLAVES + INTEGER IERR, LREQI + INTEGER STATUS( MPI_STATUS_SIZE ) + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + DOUBLE PRECISION FLOP1,FLOP2 + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + IF (NSLAVES.EQ.0) THEN + WRITE(6,*) ' ERROR 1 in ZMUMPS_294 ' + CALL MUMPS_ABORT() + ENDIF + NPIV = IEND - IBEGKJI + 1 + NCOL = LDA_FS - IBEGKJI + 1 + APOS = POSELT + int(LDA_FS,8)*int(IBEGKJI-1,8) + + & int(IBEGKJI - 1,8) + IF (IBEGKJI > 0) THEN + CALL MUMPS_511( LDA_FS, IBEGKJI-1, LPIV, + & KEEP(50),2,FLOP1) + ELSE + FLOP1=0.0D0 + ENDIF + CALL MUMPS_511( LDA_FS, IEND, LPIV, + & KEEP(50),2,FLOP2) + FLOP2 = FLOP1 - FLOP2 + CALL ZMUMPS_190(1, .FALSE., FLOP2, KEEP,KEEP8) + IF ((NPIV.GT.0) .OR. + & ((NPIV.EQ.0).AND.(LASTBL)) ) THEN + PDEST = IOLDPS + 6 + KEEP(IXSZ) + IERR = -1 + IF ( NPIV .NE. 0 ) THEN + NB_BLOC_FAC = NB_BLOC_FAC + 1 + END IF + DO WHILE (IERR .EQ.-1) + CALL ZMUMPS_65( INODE, LDA_FS, NCOL, + & NPIV, FPERE, LASTBL, TIPIV, A(APOS), + & IW(PDEST), NSLAVES, KEEP(50), NB_BLOC_FAC, + & COMM, IERR ) + IF (IERR.EQ.-1) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG, + & IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF (MESSAGE_RECEIVED) POSELT = PTRAST(STEP(INODE)) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + ENDDO + IF (IERR .EQ. -2 .OR. IERR.EQ.-3 ) THEN + IF (IERR.EQ.-2) IFLAG = -17 + IF (IERR.EQ.-3) IFLAG = -20 + LREQA = int(NCOL,8)*int(NPIV,8) + LREQI = NPIV + 6 + 2*NSLAVES + CALL MUMPS_731( + & int(LREQI,8) * int(KEEP(34),8) + LREQA * int(KEEP(35),8), + & IERROR) + GOTO 300 + ENDIF + ENDIF + GOTO 500 + 300 CONTINUE + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + 500 RETURN + END SUBROUTINE ZMUMPS_294 + SUBROUTINE ZMUMPS_273( ROOT, + & INODE, NELIM, NSLAVES, ROW_LIST, + & COL_LIST, SLAVE_LIST, + & + & PROCNODE_STEPS, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & ITLOC, RHS_MUMPS, COMP, + & IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8, + & COMM,COMM_LOAD,FILS,ND ) + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC) :: ROOT + INTEGER INODE, NELIM, NSLAVES + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER ROW_LIST(*), COL_LIST(*), + & SLAVE_LIST(*) + INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER N, LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER PTRIST( KEEP(28) ), PTLUST_S(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP + INTEGER NSTK_S(KEEP(28)), ITLOC( N + KEEP(253) ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER IFLAG, IERROR + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER MYID, SLAVEF + INTEGER COMM,COMM_LOAD,ND(KEEP(28)),FILS(N) + INTEGER IROOT, TYPE_INODE, DEB_ROW, DEB_COL, + & NOINT + INTEGER(8) :: NOREAL + INCLUDE 'mumps_headers.h' + INCLUDE 'mumps_tags.h' + INTEGER MUMPS_330 + EXTERNAL MUMPS_330 + IROOT = KEEP(38) + NSTK_S(STEP(IROOT))= NSTK_S(STEP(IROOT)) - 1 + KEEP(42) = KEEP(42) + NELIM + TYPE_INODE= MUMPS_330(PROCNODE_STEPS(STEP(INODE)), SLAVEF) + IF (TYPE_INODE.EQ.1) THEN + IF (NELIM.EQ.0) THEN + KEEP(41) = KEEP(41) + 1 + ELSE + KEEP(41) = KEEP(41) + 3 + ENDIF + ELSE + IF (NELIM.EQ.0) THEN + KEEP(41) = KEEP(41) + NSLAVES + ELSE + KEEP(41) = KEEP(41) + 2*NSLAVES + 1 + ENDIF + ENDIF + IF (NELIM.EQ.0) THEN + PIMASTER(STEP(INODE)) = 0 + ELSE + NOINT = 6 + NSLAVES + NELIM + NELIM + KEEP(IXSZ) + NOREAL= 0_8 + CALL ZMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, + & NOINT, NOREAL, INODE, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) THEN + WRITE(*,*) ' Failure in int space allocation in CB area ', + & ' during assembly of root : ZMUMPS_273', + & ' size required was :', NOINT, + & 'INODE=',INODE,' NELIM=',NELIM, ' NSLAVES=', NSLAVES + RETURN + ENDIF + PIMASTER(STEP( INODE )) = IWPOSCB + 1 + PAMASTER(STEP( INODE )) = IPTRLU + 1_8 + IW( IWPOSCB + 1+KEEP(IXSZ) ) = 2*NELIM + IW( IWPOSCB + 2+KEEP(IXSZ) ) = NELIM + IW( IWPOSCB + 3+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 4+KEEP(IXSZ) ) = 0 + IW( IWPOSCB + 5+KEEP(IXSZ) ) = 1 + IW( IWPOSCB + 6+KEEP(IXSZ) ) = NSLAVES + IF (NSLAVES.GT.0) THEN + IW( IWPOSCB+7+KEEP(IXSZ):IWPOSCB+7+KEEP(IXSZ)+NSLAVES-1) = + & SLAVE_LIST(1:NSLAVES) + ENDIF + DEB_ROW = IWPOSCB+7+NSLAVES+KEEP(IXSZ) + IW(DEB_ROW : DEB_ROW+NELIM -1) = ROW_LIST(1:NELIM) + DEB_COL = DEB_ROW + NELIM + IW(DEB_COL : DEB_COL+NELIM -1) = COL_LIST(1:NELIM) + ENDIF + IF (NSTK_S(STEP(IROOT)) .EQ. 0 ) THEN + CALL ZMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IROOT ) + IF (KEEP(47) .GE. 3) THEN + CALL ZMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + RETURN + END SUBROUTINE ZMUMPS_273 + SUBROUTINE ZMUMPS_363(N,FRERE, STEP, FILS, + & NA,LNA,NE,ND, DAD, LDAD, USE_DAD, + & NSTEPS,PERM,SYM,INFO,LP,K215,K234,K55, + & PROCNODE,SLAVEF, PEAK,SBTR_WHICH_M + & ) + IMPLICIT NONE + INTEGER N,PERM,SYM, NSTEPS, LNA, LP,LDAD + INTEGER FRERE(NSTEPS), FILS(N), STEP(N) + INTEGER NA(LNA), NE(NSTEPS), ND(NSTEPS) + INTEGER K215,K234,K55 + INTEGER DAD(LDAD) + LOGICAL USE_DAD + INTEGER INFO(40) + INTEGER SLAVEF,PROCNODE(NSTEPS) + INTEGER :: SBTR_WHICH_M + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + DOUBLE PRECISION PEAK + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: COST_TRAV + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH + INTEGER IFATH,IN,NSTK,INODE,I,allocok,LOCAL_PERM + INTEGER(8) NCB + INTEGER(8) NELIM,NFR + INTEGER NFR4,NELIM4 + INTEGER LEAF,NBLEAF,NBROOT, SIZE_TAB + INTEGER, DIMENSION (:), ALLOCATABLE :: IPOOL,TNSTK + INTEGER, DIMENSION (:), ALLOCATABLE,TARGET :: SON,TEMP + INTEGER(8), DIMENSION (:), ALLOCATABLE :: M,M_TOTAL, fact + INTEGER(8), DIMENSION (:), ALLOCATABLE :: TAB1,TAB2 + INTEGER, DIMENSION (:), POINTER :: TAB + INTEGER dernier,fin + INTEGER cour,II + INTEGER CB_current,CB_MAX,ROOT_OF_CUR_SBTR + INTEGER(8), DIMENSION (:), ALLOCATABLE :: T1,T2 + INTEGER, DIMENSION (:), ALLOCATABLE :: RESULT + INTEGER(8) MEM_SIZE,FACT_SIZE,SUM,MEM_SEC_PERM,FACT_SIZE_T, + & MEM_SIZE_T,TOTAL_MEM_SIZE,TMP_TOTAL_MEM_SIZE,TMP_SUM, + & SIZECB, SIZECB_LASTSON + INTEGER(8) TMP8 + LOGICAL SBTR_M + INTEGER FIRST_LEAF,SIZE_SBTR + EXTERNAL MUMPS_170,MUMPS_167 + LOGICAL MUMPS_170,MUMPS_167 + DOUBLE PRECISION COST_NODE + INCLUDE 'mumps_headers.h' + TOTAL_MEM_SIZE=0_8 + ROOT_OF_CUR_SBTR=0 + IF((PERM.EQ.0).OR.(PERM.EQ.1).OR. + & (PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4).OR. + & (PERM.EQ.5).OR.(PERM.EQ.6))THEN + LOCAL_PERM=0 + ENDIF + SBTR_M=.FALSE. + MEM_SIZE=0_8 + FACT_SIZE=0_8 + IF ((PERM.LT.0 .OR. PERM.GT.7)) THEN + WRITE(*,*) "Internal Error in ZMUMPS_363",PERM + CALL MUMPS_ABORT() + END IF + NBLEAF = NA(1) + NBROOT = NA(2) + IF((PERM.EQ.0).AND.(NBROOT.EQ.NBLEAF)) RETURN + IF ((PERM.NE.7).AND.(SBTR_M.OR.(PERM.EQ.2))) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + ALLOCATE(M_TOTAL(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & ZMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ENDIF + ENDIF + IF(PERM.NE.7)THEN + ALLOCATE(M(NSTEPS),stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error + &in ZMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ENDIF + ALLOCATE( IPOOL(NBLEAF), fact(NSTEPS),TNSTK(NSTEPS), + & stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in ZMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + II=0 + DO I=1,NSTEPS + TNSTK(I) = NE(I) + IF(NE(I).GE.II) II=NE(I) + ENDDO + SIZE_TAB=max(II,NBROOT) + ALLOCATE(SON(II), TEMP(II), + & TAB1(SIZE_TAB), TAB2(SIZE_TAB), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in ZMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ALLOCATE(T1(SIZE_TAB),T2(SIZE_TAB), + & RESULT(SIZE_TAB),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in ZMUMPS_363' + INFO(1)=-7 + INFO(2)=SIZE_TAB + RETURN + ENDIF + IF(PERM.EQ.7) THEN + GOTO 001 + ENDIF + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + ALLOCATE(COST_TRAV(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error + & in ZMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + COST_TRAV=0.0D0 + COST_NODE=0.0d0 + ENDIF + IF(NBROOT.EQ.NBLEAF)THEN + IF((PERM.NE.1).OR.(PERM.EQ.4).OR.(PERM.EQ.6))THEN + WRITE(*,*)'Internal Error in reordertree:' + WRITE(*,*)' problem with perm parameter in reordertree' + CALL MUMPS_ABORT() + ENDIF + DO I=1,NBROOT + TAB1(I)=int(ND(STEP(NA(I+2+NBLEAF))),8) + IPOOL(I)=NA(I+2+NBLEAF) + M(STEP(IPOOL(I)))=TAB1(I)*TAB1(I) + ENDDO + CALL ZMUMPS_462(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4, + & RESULT,T1,T2) + GOTO 789 + ENDIF + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + ALLOCATE(DEPTH(NSTEPS),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & ZMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + DEPTH=0 + NBROOT = NA(2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + fin=NBROOT + LEAF=NA(1) + 499 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IN=INODE + 4602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + GOTO 4602 + ENDIF + IN=-IN + DO I=1,NE(STEP(INODE)) + SON(I)=IN + IN=FRERE(STEP(IN)) + ENDDO + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=SON(I) + DEPTH(STEP(SON(I)))=DEPTH(STEP(INODE))+1 + SON(I)=0 + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 499 + ENDIF + fin=fin-1 + IF(fin.EQ.0) GOTO 489 + GOTO 499 + 489 CONTINUE + ENDIF + DO I=1,NSTEPS + M(I)=0_8 + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + M_TOTAL(I)=0_8 + ENDIF + ENDIF + ENDDO + DO I=1,NSTEPS + fact(I)=0_8 + ENDDO + IPOOL(1:NBLEAF)=NA(3:2+NBLEAF) + LEAF = NBLEAF + 1 + 91 CONTINUE + IF (LEAF.NE.1) THEN + LEAF = LEAF -1 + INODE = IPOOL(LEAF) + ENDIF + 96 CONTINUE + NFR = int(ND(STEP(INODE)),8) + NSTK = NE(STEP(INODE)) + NELIM4 = 0 + IN = INODE + 101 NELIM4 = NELIM4 + 1 + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 101 + NELIM=int(NELIM4,8) + IF(NE(STEP(INODE)).EQ.0) THEN + M(STEP(INODE))=NFR*NFR + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + M_TOTAL(STEP(INODE))=NFR*NFR + ENDIF + ENDIF + IF((PERM.EQ.4).OR.(PERM.EQ.3))THEN + IF(MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + DEPTH(STEP(INODE))=0 + ENDIF + ENDIF + IF ( SYM .eq. 0 ) THEN + fact(STEP(INODE))=fact(STEP(INODE))+ + & (2_8*NFR*NELIM)-(NELIM*NELIM) + ELSE + fact(STEP(INODE))=fact(STEP(INODE))+NFR*NELIM + ENDIF + IF (USE_DAD) THEN + IFATH = DAD( STEP(INODE) ) + ELSE + IN = INODE + 113 IN = FRERE(IN) + IF (IN.GT.0) GO TO 113 + IFATH = -IN + ENDIF + IF (IFATH.EQ.0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 116 + GOTO 91 + ELSE + fact(STEP(IFATH))=fact(STEP(IFATH))+fact(STEP(INODE)) + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + DEPTH(STEP(IFATH))=max(DEPTH(STEP(INODE)), + & DEPTH(STEP(IFATH))) + ENDIF + ENDIF + TNSTK(STEP(IFATH)) = TNSTK(STEP(IFATH)) - 1 + IF ( TNSTK(STEP(IFATH)) .EQ. 0 ) THEN + INODE = IFATH + IN=INODE + dernier=IN + I=1 + 5700 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + dernier=IN + I=I+1 + GOTO 5700 + ENDIF + NCB=int(ND(STEP(INODE))-I,8) + IN=-IN + IF(PERM.NE.7)THEN + DO I=1,NE(STEP(INODE)) + SON(I)=IN + TEMP(I)=IN + IF(IN.GT.0) IN=FRERE(STEP(IN)) + ENDDO + ELSE + DO I=NE(STEP(INODE)),1,-1 + SON(I)=IN + TEMP(I)=IN + IF(IN.GT.0) IN=FRERE(STEP(IN)) + ENDDO + ENDIF + NFR = int(ND(STEP(INODE)),8) + DO II=1,NE(STEP(INODE)) + TAB1(II)=0_8 + TAB2(II)=0_8 + cour=SON(II) + NELIM4=1 + 151 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 151 + ENDIF + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0)) THEN + SIZECB=(int(ND(STEP(SON(II))),8)-NELIM) + & *(int(ND(STEP(SON(II))),8)-NELIM) + ELSE + SIZECB=(int(ND(STEP(SON(II))),8)-NELIM) + & *(int(ND(STEP(SON(II))),8)- + & NELIM+1_8)/2_8 + ENDIF + IF((PERM.EQ.0).OR.(PERM.EQ.5))THEN + IF (K234 .NE. 0 .AND. K55.EQ.0 ) THEN + TMP8=NFR + TMP8=TMP8*TMP8 + TAB1(II)=max(TMP8, M(STEP(SON(II)))) - SIZECB + TAB2(II)=SIZECB + ELSE + TAB1(II)=M(STEP(SON(II)))- SIZECB + TAB2(II)=SIZECB + ENDIF + ENDIF + IF((PERM.EQ.1).OR.(PERM.EQ.6)) THEN + TAB1(II)=M(STEP(SON(II)))-SIZECB + TAB1(II)=TAB1(II)-fact(STEP(SON(II))) + TAB2(II)=SIZECB+fact(STEP(SON(II))) + ENDIF + IF(PERM.EQ.2)THEN + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + TAB1(II)=M_TOTAL(STEP(SON(II)))-SIZECB + & -fact(STEP(SON(II))) + TAB2(II)=SIZECB + ELSE + TAB1(II)=M(STEP(SON(II)))-SIZECB + TAB2(II)=SIZECB + ENDIF + ENDIF + IF(PERM.EQ.3)THEN + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + TAB1(II)=M(STEP(SON(II)))-SIZECB + TAB2(II)=SIZECB + ELSE + TAB1(II)=int(DEPTH(STEP(SON(II))),8) + TAB2(II)=M(STEP(SON(II))) + ENDIF + ENDIF + IF(PERM.EQ.4)THEN + IF (MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + TAB1(II)=M(STEP(SON(II)))- + & SIZECB-fact(STEP(SON(II))) + TAB2(II)=SIZECB + ELSE + TAB1(II)=int(DEPTH(STEP(SON(II))),8) + TAB2(II)=M(STEP(SON(II))) + ENDIF + ENDIF + ENDDO + CALL ZMUMPS_462(SON,NE(STEP(INODE)),TAB1,TAB2, + & LOCAL_PERM + & ,RESULT,T1,T2) + IF(PERM.EQ.0) THEN + DO II=1,NE(STEP(INODE)) + cour=TEMP(II) + NELIM4=1 + 153 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 153 + ENDIF + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM) + ELSE + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM+1_8)/2_8 + ENDIF + TAB1(II)=SIZECB + ENDDO + CALL ZMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2,3, + & RESULT,T1,T2) + ENDIF + IF(PERM.EQ.1) THEN + DO II=1,NE(STEP(INODE)) + cour=TEMP(II) + NELIM4=1 + 187 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 187 + ENDIF + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM) + ELSE + SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)* + & (int(ND(STEP(TEMP(II))),8)-NELIM+1_8)/2_8 + ENDIF + TAB1(II)=SIZECB+fact(STEP(TEMP(II))) + ENDDO + CALL ZMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2,3, + & RESULT,T1,T2) + ENDIF + CONTINUE + IFATH=INODE + DO II=1,2 + SUM=0_8 + FACT_SIZE=0_8 + FACT_SIZE_T=0_8 + MEM_SIZE=0_8 + MEM_SIZE_T=0_8 + CB_MAX=0 + CB_current=0 + TMP_SUM=0_8 + IF(II.EQ.1) TAB=>SON + IF(II.EQ.2) TAB=>TEMP + DO I=1,NE(STEP(INODE)) + cour=TAB(I) + NELIM4=1 + 149 cour=FILS(cour) + IF(cour.GT.0) THEN + NELIM4=NELIM4+1 + GOTO 149 + ENDIF + NELIM=int(NELIM4, 8) + NFR=int(ND(STEP(TAB(I))),8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(NFR-NELIM)*(NFR-NELIM) + ELSE + SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8 + ENDIF + MEM_SIZE=max(MEM_SIZE,(M(STEP(TAB(I)))+SUM+FACT_SIZE)) + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + MEM_SIZE_T=max(MEM_SIZE_T,(M_TOTAL(STEP(TAB(I)))+ + & SUM+ + & FACT_SIZE_T)) + FACT_SIZE_T=FACT_SIZE_T+fact(STEP(TAB(I))) + ENDIF + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & (M(STEP(TAB(I)))+SUM+FACT_SIZE)) + TMP_SUM=TMP_SUM+fact(STEP(TAB(I))) + SUM=SUM+SIZECB + SIZECB_LASTSON = SIZECB + IF((PERM.EQ.1).OR.(PERM.EQ.4))THEN + FACT_SIZE=FACT_SIZE+fact(STEP(TAB(I))) + ENDIF + ENDDO + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=NCB*NCB + ELSE + SIZECB=(NCB*(NCB+1_8))/2_8 + ENDIF + IF (K234.NE.0 .AND. K55.EQ.0) THEN + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & ( ( int(ND(STEP(IFATH)),8) + & * int(ND(STEP(IFATH)),8) ) + & + SUM-SIZECB_LASTSON+TMP_SUM ) + & ) + ELSE IF (K234.NE.0 .AND. K55.NE.0) THEN + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & ( ( int(ND(STEP(IFATH)),8) + & * int(ND(STEP(IFATH)),8) ) + & + SUM + TMP_SUM ) + & ) + ELSE + TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE, + & ( ( int(ND(STEP(IFATH)),8) + & * int(ND(STEP(IFATH)),8)) + & + max(SUM,SIZECB) + TMP_SUM ) + & ) + ENDIF + IF(II.EQ.1)THEN + TMP_TOTAL_MEM_SIZE=TOTAL_MEM_SIZE + ENDIF + IF(II.EQ.1)THEN + IF (K234.NE.0 .AND. K55.EQ.0) THEN + M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+SUM-SIZECB_LASTSON+ + & FACT_SIZE)) + ELSE IF (K234.NE.0 .AND. K55.NE.0) THEN + M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+SUM+FACT_SIZE)) + ELSE + M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+FACT_SIZE)) + ENDIF + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + M_TOTAL(STEP(IFATH))=max(MEM_SIZE_T, + & ((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+ + & FACT_SIZE_T)) + ENDIF + ENDIF + IF((II.EQ.2).AND.(PERM.EQ.1).OR.(PERM.EQ.0).OR. + & (PERM.EQ.5).OR.(PERM.EQ.6).OR. + & (.NOT.SBTR_M.OR.(SBTR_WHICH_M.NE.1)))THEN + MEM_SEC_PERM=max(MEM_SIZE,((int(ND(STEP(IFATH)),8) + & *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+FACT_SIZE)) + ENDIF + IF((PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4))THEN + MEM_SEC_PERM=huge(MEM_SEC_PERM) + ENDIF + ENDDO + IF(MEM_SEC_PERM.EQ.M(STEP(IFATH))) THEN + TAB=>TEMP + ELSE IF (MEM_SEC_PERM.LT.M(STEP(IFATH))) THEN + WRITE(*,*)'Probleme dans reorder!!!!' + CALL MUMPS_ABORT() + ELSE + TOTAL_MEM_SIZE=TMP_TOTAL_MEM_SIZE + TAB=>SON + ENDIF + DO I=NE(STEP(INODE)),1,-1 + IF(I.EQ.NE(STEP(INODE))) THEN + FILS(dernier)=-TAB(I) + dernier=TAB(I) + GOTO 222 + ENDIF + IF(I.EQ.1) THEN + FRERE(STEP(dernier))=TAB(I) + FRERE(STEP(TAB(I)))=-INODE + GOTO 222 + ENDIF + IF(I.GT.1) THEN + FRERE(STEP(dernier))=TAB(I) + dernier=TAB(I) + GOTO 222 + ENDIF + 222 CONTINUE + ENDDO + GOTO 96 + ELSE + GOTO 91 + ENDIF + 116 CONTINUE + NBROOT = NA(2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + IF (PERM.eq.1) THEN + DO I=1,NBROOT + TAB1(I)=M(STEP(NA(I+2+NBLEAF)))-fact(STEP(NA(I+2+NBLEAF))) + TAB1(I)=-TAB1(I) + ENDDO + CALL ZMUMPS_462(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4, + & RESULT,T1,T2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + ENDIF + 001 CONTINUE + fin=NBROOT + LEAF=NA(1) + FIRST_LEAF=-9999 + SIZE_SBTR=0 + 999 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IN=INODE + 5602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + dernier=IN + GOTO 5602 + ENDIF + IN=-IN + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + IF(SLAVEF.NE.1)THEN + IF (USE_DAD) THEN + IFATH=DAD(INODE) + ELSE + IN = INODE + 395 IN = FRERE(IN) + IF (IN.GT.0) GO TO 395 + IFATH = -IN + ENDIF + NFR4 = ND(STEP(INODE)) + NFR = int(NFR4,8) + NELIM4 = 0 + IN = INODE + 396 NELIM4 = NELIM4 + 1 + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 396 + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(NFR-NELIM)*(NFR-NELIM) + ELSE + SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8 + ENDIF + CALL MUMPS_511(NFR4,NELIM4,NELIM4, + & SYM,1,COST_NODE) + IF(IFATH.NE.0)THEN + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + COST_TRAV(STEP(INODE))=COST_TRAV(STEP( + & ROOT_OF_CUR_SBTR)) + ELSE + COST_TRAV(STEP(INODE))=dble(COST_NODE)+ + & COST_TRAV(STEP(IFATH))+ + & dble(SIZECB*18_8) + ENDIF + ELSE + COST_TRAV(STEP(INODE))=dble(COST_NODE) + ENDIF + ENDIF + ENDIF + DO I=1,NE(STEP(INODE)) + TEMP(I)=IN + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + IF((SLAVEF.NE.1).AND.(.NOT.MUMPS_170( + & PROCNODE(STEP(INODE)),SLAVEF)))THEN + NFR4 = ND(STEP(INODE)) + NFR = int(NFR4,8) + NELIM4 = 0 + II = TEMP(I) + 845 NELIM4 = NELIM4 + 1 + II = FILS(II) + IF (II .GT. 0 ) GOTO 845 + NELIM=int(NELIM4,8) + CALL MUMPS_511(NFR4,NELIM4,NELIM4, + & SYM,1,COST_NODE) + TAB1(I)=int(dble(COST_NODE)+ + & COST_TRAV(STEP(INODE)),8) + TAB2(I)=0_8 + ELSE + SON(I)=IN + ENDIF + ELSE + SON(I)=IN + ENDIF + IN=FRERE(STEP(IN)) + ENDDO + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + IF((SLAVEF.NE.1).AND.(.NOT.MUMPS_170( + & PROCNODE(STEP(INODE)),SLAVEF)))THEN + CALL ZMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2, + & LOCAL_PERM + & ,RESULT,T1,T2) + TAB=>TEMP + DO I=NE(STEP(INODE)),1,-1 + IF(I.EQ.NE(STEP(INODE))) THEN + FILS(dernier)=-TAB(I) + dernier=TAB(I) + GOTO 221 + ENDIF + IF(I.EQ.1) THEN + FRERE(STEP(dernier))=TAB(I) + FRERE(STEP(TAB(I)))=-INODE + GOTO 221 + ENDIF + IF(I.GT.1) THEN + FRERE(STEP(dernier))=TAB(I) + dernier=TAB(I) + GOTO 221 + ENDIF + 221 CONTINUE + SON(NE(STEP(INODE))-I+1)=TAB(I) + ENDDO + ENDIF + ENDIF + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=SON(I) + SON(I)=0 + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + IF(PERM.NE.7)THEN + NA(LEAF+2)=INODE + ENDIF + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 999 + ENDIF + fin=fin-1 + IF(fin.EQ.0) THEN + GOTO 789 + ENDIF + GOTO 999 + 789 CONTINUE + IF(PERM.EQ.7) GOTO 5483 + NBROOT=NA(2) + NBLEAF=NA(1) + PEAK=0.0D0 + FACT_SIZE=0_8 + DO I=1,NBROOT + PEAK=max(PEAK,dble(M(STEP(NA(2+NBLEAF+I))))) + FACT_SIZE=FACT_SIZE+fact(STEP(NA(2+NBLEAF+I))) + ENDDO + 5483 CONTINUE + DEALLOCATE(IPOOL) + DEALLOCATE(fact) + DEALLOCATE(TNSTK) + DEALLOCATE(SON) + DEALLOCATE(TAB2) + DEALLOCATE(TAB1) + DEALLOCATE(T1) + DEALLOCATE(T2) + DEALLOCATE(RESULT) + DEALLOCATE(TEMP) + IF(PERM.NE.7)THEN + DEALLOCATE(M) + ENDIF + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + DEALLOCATE(DEPTH) + ENDIF + IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN + DEALLOCATE(COST_TRAV) + ENDIF + IF ((PERM.NE.7).AND.(SBTR_M.OR.(PERM.EQ.2))) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1).OR.(PERM.EQ.2))THEN + DEALLOCATE(M_TOTAL) + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_363 + SUBROUTINE ZMUMPS_364(N,FRERE, STEP, FILS, + & NA,LNA,NE,ND, DAD, LDAD, USE_DAD, + & NSTEPS,PERM,SYM,INFO,LP,K47,K81,K76,K215,K234,K55, + & PROCNODE,MEM_SUBTREE,SLAVEF, SIZE_MEM_SBTR, PEAK + & ,SBTR_WHICH_M,SIZE_DEPTH_FIRST,SIZE_COST_TRAV, + & DEPTH_FIRST_TRAV,DEPTH_FIRST_SEQ,COST_TRAV,MY_FIRST_LEAF, + & MY_NB_LEAF,MY_ROOT_SBTR,SBTR_ID + & ) + IMPLICIT NONE + INTEGER N,PERM,SYM, NSTEPS, LNA, LP, SIZE_MEM_SBTR,LDAD + INTEGER FRERE(NSTEPS), FILS(N), STEP(N) + INTEGER NA(LNA), NE(NSTEPS), ND(NSTEPS) + INTEGER K47,K81,K76,K215,K234,K55 + INTEGER DAD(LDAD) + LOGICAL USE_DAD + INTEGER INFO(40) + INTEGER SLAVEF,PROCNODE(NSTEPS) + DOUBLE PRECISION, intent(out) :: MEM_SUBTREE(SIZE_MEM_SBTR,SLAVEF) + INTEGER :: SBTR_WHICH_M + INTEGER MY_FIRST_LEAF(SIZE_MEM_SBTR,SLAVEF), + & MY_ROOT_SBTR(SIZE_MEM_SBTR,SLAVEF), + & MY_NB_LEAF(SIZE_MEM_SBTR,SLAVEF) + EXTERNAL MUMPS_283,MUMPS_275 + LOGICAL MUMPS_283 + INTEGER MUMPS_275 + DOUBLE PRECISION PEAK + INTEGER SIZE_DEPTH_FIRST,DEPTH_FIRST_TRAV(SIZE_DEPTH_FIRST), + & DEPTH_FIRST_SEQ(SIZE_DEPTH_FIRST) + INTEGER SIZE_COST_TRAV + INTEGER SBTR_ID(SIZE_DEPTH_FIRST),OOC_CUR_SBTR + DOUBLE PRECISION COST_TRAV(SIZE_COST_TRAV) + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH + INTEGER IFATH,IN,INODE,I,allocok,LOCAL_PERM + INTEGER(8) NELIM,NFR + INTEGER NFR4,NELIM4 + INTEGER LEAF,NBLEAF,NBROOT, SIZE_TAB + INTEGER, DIMENSION (:), ALLOCATABLE :: IPOOL,TNSTK + INTEGER, DIMENSION (:), ALLOCATABLE,TARGET :: SON,TEMP + INTEGER(8), DIMENSION (:), ALLOCATABLE :: M,M_TOTAL, fact + INTEGER(8), DIMENSION (:), ALLOCATABLE :: TAB1,TAB2 + INTEGER x,dernier,fin,RANK_TRAV + INTEGER II + INTEGER ROOT_OF_CUR_SBTR + INTEGER(8), DIMENSION (:), ALLOCATABLE :: T1,T2 + INTEGER, DIMENSION (:), ALLOCATABLE :: RESULT + INTEGER(8) MEM_SIZE,FACT_SIZE, + & TOTAL_MEM_SIZE, + & SIZECB + LOGICAL SBTR_M + INTEGER INDICE(SLAVEF),ID,FIRST_LEAF,SIZE_SBTR + EXTERNAL MUMPS_170,MUMPS_167 + LOGICAL MUMPS_170,MUMPS_167 + DOUBLE PRECISION COST_NODE + INTEGER CUR_DEPTH_FIRST_RANK + INCLUDE 'mumps_headers.h' + TOTAL_MEM_SIZE=0_8 + ROOT_OF_CUR_SBTR=0 + IF((PERM.EQ.0).OR.(PERM.EQ.1).OR. + & (PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4).OR. + & (PERM.EQ.5).OR.(PERM.EQ.6))THEN + LOCAL_PERM=0 + ENDIF + IF (K47 == 4 .OR. ((K47.GE.2).AND.(K81.GE. 1))) THEN + DO I=1,SLAVEF + INDICE(I)=1 + ENDDO + DO I=1,SLAVEF + DO x=1,SIZE_MEM_SBTR + MEM_SUBTREE(x,I)=-1.0D0 + ENDDO + ENDDO + ENDIF + SBTR_M=((K47 == 4 .OR. ((K47.GE.2).AND.(K81 .GE. 1)))) + MEM_SIZE=0_8 + FACT_SIZE=0_8 + IF ((PERM.GT.7).AND. + & (.NOT.(K47 == 4 .OR. ((K47.GE.2).AND.(K81 .GE. 1))))) THEN + WRITE(*,*) "Internal Error in ZMUMPS_363",PERM + CALL MUMPS_ABORT() + END IF + NBLEAF = NA(1) + NBROOT = NA(2) + CUR_DEPTH_FIRST_RANK=1 + IF((PERM.EQ.0).AND.(NBROOT.EQ.NBLEAF)) RETURN + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + ALLOCATE(M_TOTAL(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & ZMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ENDIF + ENDIF + ALLOCATE( IPOOL(NBLEAF), M(NSTEPS), fact(NSTEPS), + & TNSTK(NSTEPS), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in ZMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + II=0 + DO I=1,NSTEPS + TNSTK(I) = NE(I) + IF(NE(I).GE.II) II=NE(I) + ENDDO + SIZE_TAB=max(II,NBROOT) + ALLOCATE(SON(II), TEMP(II), + & TAB1(SIZE_TAB), TAB2(SIZE_TAB), stat=allocok ) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in ZMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + ALLOCATE(T1(SIZE_TAB),T2(SIZE_TAB), + & RESULT(SIZE_TAB),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in ZMUMPS_363' + INFO(1)=-7 + INFO(2)=SIZE_TAB + RETURN + ENDIF + IF(NBROOT.EQ.NBLEAF)THEN + IF((PERM.NE.1).OR.(PERM.EQ.4).OR.(PERM.EQ.6))THEN + WRITE(*,*)'Internal Error in reordertree:' + WRITE(*,*)' problem with perm parameter in reordertree' + CALL MUMPS_ABORT() + ENDIF + DO I=1,NBROOT + TAB1(I)=int(ND(STEP(NA(I+2+NBLEAF))),8) + IPOOL(I)=NA(I+2+NBLEAF) + M(STEP(IPOOL(I)))=TAB1(I)*TAB1(I) + ENDDO + CALL ZMUMPS_462(NA(2+NBLEAF+1),NBROOT,TAB1,TAB2,4, + & RESULT,T1,T2) + GOTO 789 + ENDIF + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + ALLOCATE(DEPTH(NSTEPS),stat=allocok) + IF (allocok > 0) THEN + IF ( LP .GT. 0 ) + & WRITE(LP,*)'Memory allocation error in + & ZMUMPS_363' + INFO(1)=-7 + INFO(2)=NSTEPS + RETURN + ENDIF + DEPTH=0 + NBROOT = NA(2) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + fin=NBROOT + LEAF=NA(1) + 499 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IN=INODE + 4602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + GOTO 4602 + ENDIF + IN=-IN + DO I=1,NE(STEP(INODE)) + SON(I)=IN + IN=FRERE(STEP(IN)) + ENDDO + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=SON(I) + DEPTH(STEP(SON(I)))=DEPTH(STEP(INODE))+1 + SON(I)=0 + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 499 + ENDIF + fin=fin-1 + IF(fin.EQ.0) GOTO 489 + GOTO 499 + 489 CONTINUE + ENDIF + IF(K76.EQ.4.OR.(K76.EQ.6))THEN + RANK_TRAV=NSTEPS + DEPTH_FIRST_TRAV=0 + DEPTH_FIRST_SEQ=0 + ENDIF + IF((K76.EQ.5).OR.(PERM.EQ.5).OR.(PERM.EQ.6))THEN + COST_TRAV=0.0D0 + COST_NODE=0.0d0 + ENDIF + DO I=1,NSTEPS + M(I)=0_8 + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + M_TOTAL(I)=0_8 + ENDIF + ENDIF + ENDDO + DO I=1,NSTEPS + fact(I)=0_8 + ENDDO + NBROOT = NA(2) + NBLEAF = NA(1) + IPOOL(1:NBROOT) = NA(3+NBLEAF:2+NBLEAF+NBROOT) + CONTINUE + fin=NBROOT + LEAF=NA(1) + FIRST_LEAF=-9999 + SIZE_SBTR=0 + 999 CONTINUE + INODE=IPOOL(fin) + IF(INODE.LT.0)THEN + WRITE(*,*)'Internal Error in reordertree INODE < 0 !' + CALL MUMPS_ABORT() + ENDIF + IF(SIZE_SBTR.NE.0)THEN + IF(.NOT.MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF((SLAVEF.NE.1))THEN + MY_FIRST_LEAF(INDICE(ID+1)-1,ID+1)=FIRST_LEAF + MY_NB_LEAF(INDICE(ID+1)-1,ID+1)=SIZE_SBTR + FIRST_LEAF=-9999 + SIZE_SBTR=0 + ENDIF + ENDIF + ENDIF + ENDIF + IF(MUMPS_283(PROCNODE(STEP(INODE)),SLAVEF))THEN + ROOT_OF_CUR_SBTR=INODE + ENDIF + IF (K76.EQ.4)THEN + IF(SLAVEF.NE.1)THEN + WRITE(*,*)'INODE=',INODE,'RANK',RANK_TRAV + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + DEPTH_FIRST_TRAV(STEP(INODE))=DEPTH_FIRST_TRAV(STEP( + & ROOT_OF_CUR_SBTR)) + ELSE + DEPTH_FIRST_TRAV(STEP(INODE))=RANK_TRAV + ENDIF + RANK_TRAV=RANK_TRAV-1 + ENDIF + ENDIF + IF (K76.EQ.5)THEN + IF(SLAVEF.NE.1)THEN + IF (USE_DAD) THEN + IFATH=DAD(INODE) + ELSE + IN = INODE + 395 IN = FRERE(IN) + IF (IN.GT.0) GO TO 395 + IFATH = -IN + ENDIF + NFR4 = ND(STEP(INODE)) + NFR = int(NFR4,8) + NELIM4 = 0 + IN = INODE + 396 NELIM4 = NELIM4 + 1 + IN = FILS(IN) + IF (IN .GT. 0 ) GOTO 396 + NELIM=int(NELIM4,8) + IF((SYM.EQ.0).OR.(K215.NE.0))THEN + SIZECB=(NFR-NELIM)*(NFR-NELIM) + ELSE + SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8 + ENDIF + CALL MUMPS_511(NFR4,NELIM4,NELIM4, + & SYM,1,COST_NODE) + IF(IFATH.NE.0)THEN + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + COST_TRAV(STEP(INODE))=COST_TRAV(STEP( + & ROOT_OF_CUR_SBTR)) + ELSE + COST_TRAV(STEP(INODE))=dble(COST_NODE)+ + & COST_TRAV(STEP(IFATH))+ + & dble(SIZECB*18_8) + ENDIF + ELSE + COST_TRAV(STEP(INODE))=dble(COST_NODE) + ENDIF + IF(K76.EQ.5)THEN + WRITE(*,*)'INODE=',INODE,'COST=',COST_TRAV(STEP(INODE)) + ENDIF + ENDIF + ENDIF + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF((SLAVEF.NE.1).AND. + & MUMPS_283(PROCNODE(STEP(INODE)),SLAVEF))THEN + IF (NE(STEP(INODE)).NE.0) THEN + ID=MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M_TOTAL(STEP(INODE))) + ELSE + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M(STEP(INODE))) + ENDIF + MY_ROOT_SBTR(INDICE(ID+1),ID+1)=INODE + INDICE(ID+1)=INDICE(ID+1)+1 + ENDIF + ENDIF + IF((SLAVEF.EQ.1).AND.FRERE(STEP(INODE)).EQ.0)THEN + ID=MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M_TOTAL(STEP(INODE))) + ELSE + MEM_SUBTREE(INDICE(ID+1),ID+1)= + & dble(M(STEP(INODE))) + ENDIF + INDICE(ID+1)=INDICE(ID+1)+1 + ENDIF + ENDIF + IN=INODE + 5602 IN = FILS(IN) + IF (IN .GT. 0 ) THEN + dernier=IN + GOTO 5602 + ENDIF + IN=-IN + DO I=1,NE(STEP(INODE)) + IPOOL(fin)=IN + IF(IN.GT.0) IN=FRERE(STEP(IN)) + fin=fin+1 + ENDDO + IF(NE(STEP(INODE)).EQ.0)THEN + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF(SLAVEF.NE.1)THEN + IF(MUMPS_167(PROCNODE(STEP(INODE)),SLAVEF))THEN + IF(FIRST_LEAF.EQ.-9999)THEN + FIRST_LEAF=INODE + ENDIF + SIZE_SBTR=SIZE_SBTR+1 + ENDIF + ENDIF + ENDIF + IF(PERM.NE.7)THEN + NA(LEAF+2)=INODE + ENDIF + LEAF=LEAF-1 + ELSE + fin=fin-1 + GOTO 999 + ENDIF + fin=fin-1 + IF(fin.EQ.0) THEN + IF(SIZE_SBTR.NE.0)THEN + IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN + IF((SLAVEF.NE.1))THEN + MY_FIRST_LEAF(INDICE(ID+1)-1,ID+1)=FIRST_LEAF + MY_NB_LEAF(INDICE(ID+1)-1,ID+1)=SIZE_SBTR + FIRST_LEAF=-9999 + SIZE_SBTR=0 + ENDIF + ENDIF + ENDIF + GOTO 789 + ENDIF + GOTO 999 + 789 CONTINUE + IF(K76.EQ.6)THEN + OOC_CUR_SBTR=1 + DO I=1,NSTEPS + TNSTK(I) = NE(I) + ENDDO + NBROOT=NA(2) + NBLEAF=NA(1) + IPOOL(1:NBLEAF)=NA(3:2+NBLEAF) + LEAF = NBLEAF + 1 + 9100 CONTINUE + IF (LEAF.NE.1) THEN + LEAF = LEAF -1 + INODE = IPOOL(LEAF) + ENDIF + 9600 CONTINUE + IF(SLAVEF.NE.1)THEN + ID=MUMPS_275(PROCNODE(STEP(INODE)),SLAVEF) + DEPTH_FIRST_TRAV(STEP(INODE))=CUR_DEPTH_FIRST_RANK + DEPTH_FIRST_SEQ(CUR_DEPTH_FIRST_RANK)=INODE + WRITE(*,*)ID,': INODE -> ',INODE,'DF =', + & CUR_DEPTH_FIRST_RANK + CUR_DEPTH_FIRST_RANK=CUR_DEPTH_FIRST_RANK+1 + IF(MUMPS_170(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + SBTR_ID(STEP(INODE))=OOC_CUR_SBTR + ELSE + SBTR_ID(STEP(INODE))=-9999 + ENDIF + IF(MUMPS_283(PROCNODE(STEP(INODE)), + & SLAVEF))THEN + OOC_CUR_SBTR=OOC_CUR_SBTR+1 + ENDIF + ENDIF + IF (USE_DAD) THEN + IFATH = DAD( STEP(INODE) ) + ELSE + IN = INODE + 1133 IN = FRERE(IN) + IF (IN.GT.0) GO TO 1133 + IFATH = -IN + ENDIF + IF (IFATH.EQ.0) THEN + NBROOT = NBROOT - 1 + IF (NBROOT.EQ.0) GOTO 1163 + GOTO 9100 + ENDIF + TNSTK(STEP(IFATH))=TNSTK(STEP(IFATH))-1 + IF(TNSTK(STEP(IFATH)).EQ.0) THEN + INODE=IFATH + GOTO 9600 + ELSE + GOTO 9100 + ENDIF + 1163 CONTINUE + ENDIF + PEAK=0.0D0 + FACT_SIZE=0_8 + DO I=1,NBROOT + PEAK=max(PEAK,dble(M(STEP(NA(2+NBLEAF+I))))) + FACT_SIZE=FACT_SIZE+fact(STEP(NA(2+NBLEAF+I))) + ENDDO + CONTINUE + DEALLOCATE(IPOOL) + DEALLOCATE(M) + DEALLOCATE(fact) + DEALLOCATE(TNSTK) + DEALLOCATE(SON) + DEALLOCATE(TAB2) + DEALLOCATE(TAB1) + DEALLOCATE(T1) + DEALLOCATE(T2) + DEALLOCATE(RESULT) + DEALLOCATE(TEMP) + IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN + DEALLOCATE(DEPTH) + ENDIF + IF (SBTR_M.OR.(PERM.EQ.2)) THEN + IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1).OR.(PERM.EQ.2))THEN + DEALLOCATE(M_TOTAL) + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_364 + RECURSIVE SUBROUTINE ZMUMPS_462(TAB,DIM,TAB1,TAB2,PERM, + & RESULT,TEMP1,TEMP2) + IMPLICIT NONE + INTEGER DIM + INTEGER(8) TAB1(DIM),TAB2(DIM) + INTEGER(8) TEMP1(DIM),TEMP2(DIM) + INTEGER TAB(DIM), PERM,RESULT(DIM) + INTEGER I,J,I1,I2 + IF(DIM.EQ.1) THEN + RESULT(1)=TAB(1) + TEMP1(1)=TAB1(1) + TEMP2(1)=TAB2(1) + RETURN + ENDIF + I=DIM/2 + CALL ZMUMPS_462(TAB(1),I,TAB1(1),TAB2(1),PERM, + & RESULT(1),TEMP1(1),TEMP2(1)) + CALL ZMUMPS_462(TAB(I+1),DIM-I,TAB1(I+1),TAB2(I+1), + & PERM,RESULT(I+1),TEMP1(I+1),TEMP2(I+1)) + I1=1 + I2=I+1 + J=1 + DO WHILE ((I1.LE.I).AND.(I2.LE.DIM)) + IF((PERM.EQ.3))THEN + IF(TEMP1(I1).LE.TEMP1(I2))THEN + TAB(J)=RESULT(I1) + TAB1(J)=TEMP1(I1) + J=J+1 + I1=I1+1 + ELSE + TAB(J)=RESULT(I2) + TAB1(J)=TEMP1(I2) + J=J+1 + I2=I2+1 + ENDIF + GOTO 3 + ENDIF + IF((PERM.EQ.4).OR.(PERM.EQ.5))THEN + IF (TEMP1(I1).GE.TEMP1(I2))THEN + TAB(J)=RESULT(I1) + TAB1(J)=TEMP1(I1) + J=J+1 + I1=I1+1 + ELSE + TAB(J)=RESULT(I2) + TAB1(J)=TEMP1(I2) + J=J+1 + I2=I2+1 + ENDIF + GOTO 3 + ENDIF + IF((PERM.EQ.0).OR.(PERM.EQ.1).OR.(PERM.EQ.2)) THEN + IF(TEMP1(I1).GT.TEMP1(I2))THEN + TAB1(J)=TEMP1(I1) + TAB2(J)=TEMP2(I1) + TAB(J)=RESULT(I1) + J=J+1 + I1=I1+1 + GOTO 3 + ENDIF + IF(TEMP1(I1).LT.TEMP1(I2))THEN + TAB1(J)=TEMP1(I2) + TAB2(J)=TEMP2(I2) + TAB(J)=RESULT(I2) + J=J+1 + I2=I2+1 + GOTO 3 + ENDIF + IF((TEMP1(I1).EQ.TEMP1(I2)))THEN + IF(TEMP2(I1).LE.TEMP2(I2))THEN + TAB1(J)=TEMP1(I1) + TAB2(J)=TEMP2(I1) + TAB(J)=RESULT(I1) + J=J+1 + I1=I1+1 + ELSE + TAB1(J)=TEMP1(I2) + TAB2(J)=TEMP2(I2) + TAB(J)=RESULT(I2) + J=J+1 + I2=I2+1 + ENDIF + ENDIF + ENDIF + 3 CONTINUE + ENDDO + IF(I1.GT.I)THEN + DO WHILE(I2.LE.DIM) + TAB(J)=RESULT(I2) + TAB1(J)=TEMP1(I2) + TAB2(J)=TEMP2(I2) + J=J+1 + I2=I2+1 + ENDDO + ELSE + IF(I2.GT.DIM)THEN + DO WHILE(I1.LE.I) + TAB1(J)=TEMP1(I1) + TAB2(J)=TEMP2(I1) + TAB(J)=RESULT(I1) + J=J+1 + I1=I1+1 + ENDDO + ENDIF + ENDIF + DO I=1,DIM + TEMP1(I)=TAB1(I) + TEMP2(I)=TAB2(I) + RESULT(I)=TAB(I) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_462 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part5.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part5.F new file mode 100644 index 000000000..4b575d3c8 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part5.F @@ -0,0 +1,7690 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE ZMUMPS_26(id) + USE ZMUMPS_LOAD + USE MUMPS_STATIC_MAPPING + USE ZMUMPS_STRUC_DEF + USE TOOLS_COMMON + USE ZMUMPS_PARALLEL_ANALYSIS + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, MASTER + PARAMETER( MASTER = 0 ) + TYPE(ZMUMPS_STRUC), TARGET :: id + INTEGER LIW, IKEEP, FILS, FRERE, PTRAR, NFSIZ + INTEGER NE, NA + INTEGER I, allocok + INTEGER MAXIS1_CHECK + INTEGER NB_NIV2, IDEST + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER LOCAL_M, LOCAL_N + INTEGER numroc + EXTERNAL numroc + INTEGER IRANK + INTEGER MP, LP, MPG + LOGICAL PROK, PROKG, LISTVAR_SCHUR_2BE_FREED + INTEGER SIZE_SCHUR_PASSED + INTEGER SBUF_SEND, SBUF_REC, TOTAL_MBYTES + INTEGER(8) SBUF_RECOLD8, MIN_BUF_SIZE8 + INTEGER MIN_BUF_SIZE + INTEGER(8) MAX_SIZE_FACTOR_TMP + INTEGER LEAF, INODE, ISTEP, INN, LPTRAR + INTEGER NBLEAF, NBROOT, MYROW_CHECK, INIV2 + INTEGER(8) K13TMP8, K14TMP8 + DOUBLE PRECISION PEAK + INTEGER, ALLOCATABLE, DIMENSION(:) :: PAR2_NODES + INTEGER, DIMENSION(:), ALLOCATABLE :: IWtemp + INTEGER, DIMENSION(:), ALLOCATABLE :: XNODEL, NODEL + INTEGER, DIMENSION(:), POINTER :: SSARBR + INTEGER, POINTER :: NELT, LELTVAR + INTEGER, DIMENSION(:), POINTER :: KEEP,INFO, INFOG + INTEGER(8), DIMENSION(:), POINTER :: KEEP8 + INTEGER(8) :: ENTRIES_IN_FACTORS_LOC_MASTERS + DOUBLE PRECISION, DIMENSION(:), POINTER :: RINFO + DOUBLE PRECISION, DIMENSION(:), POINTER :: RINFOG + INTEGER, DIMENSION(:), POINTER :: ICNTL + LOGICAL I_AM_SLAVE, PERLU_ON, COND + INTEGER :: OOC_STAT + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER K,J, IFS + INTEGER SIZE_TEMP_MEM,SIZE_DEPTH_FIRST,SIZE_COST_TRAV + LOGICAL IS_BUILD_LOAD_MEM_CALLED + DOUBLE PRECISION, DIMENSION (:,:), ALLOCATABLE :: TEMP_MEM + INTEGER, DIMENSION (:,:), ALLOCATABLE :: TEMP_ROOT + INTEGER, DIMENSION (:,:), ALLOCATABLE :: TEMP_LEAF + INTEGER, DIMENSION (:,:), ALLOCATABLE :: TEMP_SIZE + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH_FIRST + INTEGER, DIMENSION (:), ALLOCATABLE :: DEPTH_FIRST_SEQ + INTEGER, DIMENSION (:), ALLOCATABLE :: SBTR_ID + DOUBLE PRECISION, DIMENSION (:), ALLOCATABLE :: COST_TRAV_TMP + INTEGER(8) :: TOTAL_BYTES + INTEGER, POINTER, DIMENSION(:) :: WORK1PTR, WORK2PTR, + & NFSIZPTR, + & FILSPTR, + & FREREPTR + IS_BUILD_LOAD_MEM_CALLED=.FALSE. + KEEP => id%KEEP + KEEP8 => id%KEEP8 + INFO => id%INFO + RINFO => id%RINFO + INFOG => id%INFOG + RINFOG => id%RINFOG + ICNTL => id%ICNTL + NELT => id%NELT + LELTVAR => id%LELTVAR + KEEP8(24) = 0_8 + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & id%KEEP(46) .eq. 1 ) ) + LP = ICNTL( 1 ) + MP = ICNTL( 2 ) + MPG = ICNTL( 3 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF (PROK) WRITE( MP, 220 ) + IF (PROKG.AND.(MPG .NE. MP)) WRITE( MPG, 220 ) id%VERSION_NUMBER + 220 FORMAT( /' ZMUMPS ',A ) + IF ( PROK ) THEN + IF ( KEEP(50) .eq. 0 ) THEN + WRITE(MP, '(A)') 'L U Solver for unsymmetric matrices' + ELSE IF ( KEEP(50) .eq. 1 ) THEN + WRITE(MP, '(A)') + & 'L D L^T Solver for symmetric positive definite matrices' + ELSE + WRITE(MP, '(A)') + & 'L D L^T Solver for general symmetric matrices' + END IF + IF ( KEEP(46) .eq. 1 ) THEN + WRITE(MP, '(A)') 'Type of parallelism: Working host' + ELSE + WRITE(MP, '(A)') 'Type of parallelism: Host not working' + END IF + END IF + IF ( PROKG .AND. (MP.NE.MPG)) THEN + IF ( KEEP(50) .eq. 0 ) THEN + WRITE(MPG, '(A)') 'L U Solver for unsymmetric matrices' + ELSE IF ( KEEP(50) .eq. 1 ) THEN + WRITE(MPG, '(A)') + & 'L D L^T Solver for symmetric positive definite matrices' + ELSE + WRITE(MPG, '(A)') + & 'L D L^T Solver for general symmetric matrices' + END IF + IF ( KEEP(46) .eq. 1 ) THEN + WRITE(MPG, '(A)') 'Type of parallelism: Working host' + ELSE + WRITE(MPG, '(A)') 'Type of parallelism: Host not working' + END IF + END IF + IF (PROK) WRITE( MP, 110 ) + IF (PROKG .AND. (MPG.NE.MP)) WRITE( MPG, 110 ) + CALL ZMUMPS_647(id) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + CALL MPI_BCAST( KEEP(60), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + IF (id%KEEP(60) .EQ. 2 .or. id%KEEP(60). EQ. 3) THEN + CALL MPI_BCAST( id%NPROW, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%NPCOL, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%MBLOCK, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%NBLOCK, 1, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + CALL MPI_BCAST( KEEP(54), 2, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(69), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(201), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(244), 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(251), 3, MPI_INTEGER,MASTER,id%COMM,IERR) + CALL MPI_BCAST( id%N, 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + IF ( KEEP(55) .EQ. 0) THEN + IF ( KEEP(54) .eq. 3 ) THEN + CALL MPI_ALLREDUCE( id%NZ_loc, id%NZ, 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR ) + ELSE + CALL MPI_BCAST( id%NZ, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + END IF + ELSE + CALL MPI_BCAST( id%NA_ELT, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + ENDIF + IF ( associated(id%MEM_DIST) ) deallocate( id%MEM_DIST ) + allocate( id%MEM_DIST( 0:id%NSLAVES-1 ), STAT=IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -7 + INFO(2) = id%NSLAVES + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'MEM_DIST' + END IF + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + id%MEM_DIST(0:id%NSLAVES-1) = 0 + CALL MUMPS_427( + & id%COMM,id%COMM_NODES,KEEP(69),KEEP(46), + & id%NSLAVES,id%MEM_DIST,INFO) + CALL ZMUMPS_658(id) + IF (KEEP(244) .EQ. 1) THEN + IF ( KEEP(54) .eq. 3 ) THEN + CALL ZMUMPS_664(id) + END IF + IF ( id%MYID .eq. MASTER ) THEN + 1234 CONTINUE + IF ( ( (KEEP(23) .NE. 0) .AND. + & ( (KEEP(23).NE.7) .OR. KEEP(50).EQ. 2 ) ) + & .OR. + & ( associated(id%A) .AND. KEEP(52) .EQ. 77 .AND. + & (KEEP(50).EQ.2)) + & .OR. + & KEEP(52) .EQ. -2 ) THEN + IF (.not.associated(id%A)) THEN + IF (KEEP(23).GT.2) KEEP(23) = 1 + ENDIF + CALL ZMUMPS_203(id%N, id%NZ, KEEP(23), id%IS1(1), id, + & ICNTL(1), INFO(1)) + IF (INFO(1) .LT. 0) THEN + KEEP(23) = 0 + GOTO 10 + END IF + END IF + IF (KEEP(55) .EQ. 0) THEN + IF ( KEEP(256) .EQ. 1 ) THEN + LIW = 2 * id%NZ + 3 * id%N + 2 + ELSE + LIW = 2 * id%NZ + 3 * id%N + 2 + ENDIF + IF (LIW.LT.3*id%N) LIW = 3*id%N + ELSE +#if defined(metis) || defined(parmetis) + COND = (KEEP(60) .NE. 0) .OR. (KEEP(256) .EQ. 5) +#else + COND = (KEEP(60) .NE. 0) +#endif + IF( COND ) THEN + LIW = id%N + id%N + 1 + ELSE + LIW = id%N + id%N + id%N+3 + id%N+1 + ENDIF + ENDIF + IF (LIW.LT.3*id%N) LIW = 3*id%N + IF (KEEP(23) .NE. 0) THEN + IKEEP = id%N + 1 + ELSE + IKEEP = 1 + END IF + NA = IKEEP + id%N + NE = IKEEP + 2 * id%N + FILS = IKEEP + 3 * id%N + FRERE = FILS + id%N + PTRAR = FRERE + id%N + IF (KEEP(55) .EQ. 0) THEN + NFSIZ = PTRAR + 4 * id%N + MAXIS1_CHECK = NFSIZ + id%N - 1 + ELSE + NFSIZ = PTRAR + 2 * (NELT + 1) + MAXIS1_CHECK = NFSIZ + id%N -1 + ENDIF + IF ( id%MAXIS1 .LT. MAXIS1_CHECK ) THEN + IF (LP.GE.0) THEN + WRITE(LP,*) '***********************************' + WRITE(LP,*) 'MAXIS1 and MAXIS1_CHECK are different !!' + WRITE(LP,*) 'MAXIS1, MAXIS1_CHECK=',id%MAXIS1, + & MAXIS1_CHECK + WRITE(LP,*) 'This might cause problems ...' + WRITE(LP,*) '***********************************' + ENDIF + END IF + IF ( KEEP(256) .EQ. 1 ) THEN + DO I = 1, id%N + id%IS1( IKEEP + I - 1 ) = id%PERM_IN( I ) + END DO + END IF + INFOG(1) = 0 + INFOG(2) = 0 + INFOG(8) = -1 + IF ( .NOT. associated( id%LISTVAR_SCHUR ) ) THEN + SIZE_SCHUR_PASSED = 1 + LISTVAR_SCHUR_2BE_FREED=.TRUE. + allocate( id%LISTVAR_SCHUR( 1 ), STAT=allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) + & 'PB allocating an array of size 1 in Schur ' + CALL MUMPS_ABORT() + END IF + ELSE + SIZE_SCHUR_PASSED=id%SIZE_SCHUR + LISTVAR_SCHUR_2BE_FREED = .FALSE. + END IF + IF (KEEP(55) .EQ. 0) THEN + CALL ZMUMPS_195(id%N, id%NZ, id%IRN(1), id%JCN(1), + & LIW, id%IS1(IKEEP), + & id%IS1(PTRAR), KEEP(256), id%IS1(NFSIZ), + & id%IS1(FILS), id%IS1(FRERE), + & id%LISTVAR_SCHUR(1), SIZE_SCHUR_PASSED, + & ICNTL(1), INFOG(1), KEEP(1),KEEP8(1),id%NSLAVES, + & id%IS1(1),id) + IF ( (KEEP(23).LE.-1).AND.(KEEP(23).GE.-6) ) THEN + KEEP(23) = -KEEP(23) + IF (.NOT. associated(id%A)) KEEP(23) = 1 + GOTO 1234 + ENDIF + INFOG(7) = KEEP(256) + ELSE + allocate( IWtemp ( 3*id%N ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = 3*id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'IWtemp' + END IF + GOTO 10 + ENDIF + allocate( XNODEL ( id%N+1 ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = id%N + 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'XNODEL' + END IF + GOTO 10 + ENDIF + IF (LELTVAR.ne.id%ELTPTR(NELT+1)-1) THEN + INFO(1) = -2002 + INFO(2) = id%ELTPTR(NELT+1)-1 + GOTO 10 + ENDIF + allocate( NODEL ( LELTVAR ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO( 1 ) = -7 + INFO( 2 ) = LELTVAR + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'NODEL' + END IF + GOTO 10 + ENDIF + CALL ZMUMPS_128(id%N, NELT, + & id%ELTPTR(1), id%ELTVAR(1), LIW, + & id%IS1(IKEEP), + & IWtemp(1), KEEP(256), id%IS1(NFSIZ), id%IS1(FILS), + & id%IS1(FRERE), id%LISTVAR_SCHUR(1), + & SIZE_SCHUR_PASSED, + & ICNTL(1), INFOG(1), KEEP(1),KEEP8(1), + & id%ELTPROC(1), id%NSLAVES, + & XNODEL(1), NODEL(1)) + DEALLOCATE(IWtemp) + INFOG(7)=KEEP(256) + ENDIF + IF ( LISTVAR_SCHUR_2BE_FREED ) THEN + deallocate( id%LISTVAR_SCHUR ) + NULLIFY ( id%LISTVAR_SCHUR ) + ENDIF + INFO(1)=INFOG(1) + INFO(2)=INFOG(2) + KEEP(28) = INFOG(6) + IF ( INFO(1) .LT. 0 ) THEN + GO TO 10 + ENDIF + ENDIF + ELSE + IKEEP = 1 + NA = IKEEP + id%N + NE = IKEEP + 2 * id%N + FILS = IKEEP + 3 * id%N + FRERE = FILS + id%N + PTRAR = FRERE + id%N + NFSIZ = PTRAR + 4 * id%N + IF(id%MYID .EQ. MASTER) THEN + WORK1PTR => id%IS1(IKEEP : IKEEP + 3*id%N-1) + WORK2PTR => id%IS1(PTRAR : PTRAR + 4*id%N-1) + NFSIZPTR => id%IS1(NFSIZ : NFSIZ + id%N-1) + FILSPTR => id%IS1(FILS : FILS + id%N-1) + FREREPTR => id%IS1(FRERE : FRERE + id%N-1) + ELSE + ALLOCATE(WORK1PTR(3*id%N)) + ALLOCATE(WORK2PTR(4*id%N)) + END IF + CALL ZMUMPS_715(id, + & WORK1PTR, + & WORK2PTR, + & NFSIZPTR, + & FILSPTR, + & FREREPTR) + IF(id%MYID .EQ. 0) THEN + NULLIFY(WORK1PTR, WORK2PTR, NFSIZPTR) + NULLIFY(FILSPTR, FREREPTR) + ELSE + DEALLOCATE(WORK1PTR, WORK2PTR) + END IF + KEEP(28) = INFOG(6) + END IF + 10 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + IF(id%MYID .EQ. MASTER) THEN + CALL MUMPS_633(KEEP(12),ICNTL(14), + & KEEP(50),KEEP(54),ICNTL(6),KEEP(52)) + CALL ZMUMPS_348(id%N, id%IS1(FILS), id%IS1(FRERE), + & id%IS1(IKEEP+2*id%N), id%IS1(IKEEP+id%N)) + IF (id%NSLAVES .EQ. 1) THEN + id%NBSA = 0 + IF ( (id%KEEP(60).EQ.0). + & AND.(id%KEEP(53).EQ.0)) THEN + id%KEEP(20)=0 + id%KEEP(38)=0 + ENDIF + id%KEEP(56)=0 + id%PROCNODE = 0 + IF (id%KEEP(60) .EQ. 2 .OR. id%KEEP(60).EQ.3) THEN + CALL ZMUMPS_564(id%KEEP(38), id%PROCNODE(1), + & 1+2*id%NSLAVES, id%IS1(FILS),id%N) + ENDIF + ELSE + PEAK = dble(id%INFOG(5))*dble(id%INFOG(5)) + + & dble(id%KEEP(2))*dble(id%KEEP(2)) + SSARBR => id%IS1(IKEEP:IKEEP+id%N-1) + CALL ZMUMPS_537(id%N,id%NSLAVES,ICNTL(1), + & INFOG(1), + & id%IS1(NE), + & id%IS1(NFSIZ), + & id%IS1(FRERE), + & id%IS1(FILS), + & KEEP(1),KEEP8(1),id%PROCNODE(1), + & SSARBR(1),id%NBSA,PEAK,IERR + & ) + NULLIFY(SSARBR) + if(IERR.eq.-999) then + write(6,*) ' Internal error in MUMPS_369' + INFO(1) = IERR + GOTO 11 + ENDIF + IF(IERR.NE.0) THEN + INFO(1) = -135 + INFO(2) = IERR + GOTO 11 + ENDIF + CALL ZMUMPS_348(id%N, id%IS1(FILS), + & id%IS1(FRERE), id%IS1(IKEEP+2*id%N), + & id%IS1(IKEEP+id%N)) + ENDIF + 11 CONTINUE + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + CALL MPI_BCAST( id%NELT, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + IF (KEEP(55) .EQ. 0) THEN + if (associated(id%FRTPTR)) DEALLOCATE(id%FRTPTR) + if (associated(id%FRTELT)) DEALLOCATE(id%FRTELT) + allocate( id%FRTPTR(1), id%FRTELT(1) ) + ELSE + LPTRAR = id%NELT+id%NELT+2 + CALL MUMPS_733(id%PTRAR, LPTRAR, id%INFO, LP, + & FORCE=.TRUE., STRING='id%PTRAR (Analysis)', ERRCODE=-7) + CALL MUMPS_733(id%FRTPTR, id%N+1, id%INFO, LP, + & FORCE=.TRUE., STRING='id%FRTPTR (Analysis)', ERRCODE=-7) + CALL MUMPS_733(id%FRTELT, id%NELT, id%INFO, LP, + & FORCE=.TRUE., STRING='id%FRTELT (Analysis)', ERRCODE=-7) + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + IF(id%MYID .EQ. MASTER) THEN + CALL ZMUMPS_153( + & id%N, NELT, id%ELTPTR(NELT+1)-1, id%IS1(FRERE), + & id%IS1(FILS), + & id%IS1(IKEEP+id%N), id%IS1(IKEEP+2*id%N), XNODEL, + & NODEL, id%FRTPTR(1), id%FRTELT(1), id%ELTPROC(1)) + DO I=1, id%NELT+1 + id%PTRAR(id%NELT+I+1)=id%ELTPTR(I) + ENDDO + deallocate(XNODEL) + deallocate(NODEL) + END IF + CALL MPI_BCAST( id%PTRAR(id%NELT+2), id%NELT+1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%FRTPTR(1), id%N+1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%FRTELT(1), id%NELT, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + ENDIF + IF(id%MYID .EQ. MASTER) THEN + IF ( INFO( 1 ) .LT. 0 ) GOTO 12 + IF ( KEEP(55) .ne. 0 ) THEN + CALL ZMUMPS_120(id%N, NELT, id%ELTPROC(1),id%NSLAVES, + & id%PROCNODE(1)) + END IF + NB_NIV2 = KEEP(56) + IF ( NB_NIV2.GT.0 ) THEN + allocate(PAR2_NODES(NB_NIV2), + & STAT=allocok) + IF (allocok .GT.0) then + INFO(1)= -7 + INFO(2)= NB_NIV2 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'PAR2_NODES' + END IF + GOTO 12 + END IF + ENDIF + IF ((NB_NIV2.GT.0) .AND. (KEEP(24).EQ.0)) THEN + INIV2 = 0 + DO 777 INODE = 1, id%N + IF ( ( id%IS1(FRERE+INODE-1) .NE. id%N+1 ) .AND. + & ( MUMPS_330(id%PROCNODE(INODE),id%NSLAVES) + & .eq. 2) ) THEN + INIV2 = INIV2 + 1 + PAR2_NODES(INIV2) = INODE + END IF + 777 CONTINUE + IF ( INIV2 .NE. NB_NIV2 ) THEN + WRITE(*,*) "Internal Error 2 in ZMUMPS_26", + & INIV2, NB_NIV2 + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF ( (KEEP(24) .NE. 0) .AND. (NB_NIV2.GT.0) ) THEN + IF ( associated(id%CANDIDATES)) deallocate(id%CANDIDATES) + allocate( id%CANDIDATES(id%NSLAVES+1,NB_NIV2), + & stat=allocok) + if (allocok .gt.0) then + INFO(1)= -7 + INFO(2)= NB_NIV2*(id%NSLAVES+1) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'CANDIDATES' + END IF + GOTO 12 + END IF + CALL MUMPS_393 + & (PAR2_NODES,id%CANDIDATES,IERR) + IF(IERR.NE.0) THEN + INFO(1) = -2002 + GOTO 12 + ENDIF + CALL MUMPS_494() + IF(IERR.NE.0) THEN + INFO(1) = -2002 + GOTO 12 + ENDIF + ELSE + IF (associated(id%CANDIDATES)) DEALLOCATE(id%CANDIDATES) + allocate(id%CANDIDATES(1,1), stat=allocok) + IF (allocok .NE. 0) THEN + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'CANDIDATES' + END IF + GOTO 12 + ENDIF + ENDIF + 12 CONTINUE + KEEP(84) = ICNTL(27) + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), id%COMM, id%MYID ) + IF ( INFO(1) < 0 ) RETURN + CALL MPI_BCAST( id%KEEP(1), 110, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MUMPS_749( id%KEEP8(21), MASTER, + & id%MYID, id%COMM, IERR) + CALL MPI_BCAST( id%KEEP(205), 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MPI_BCAST( id%NBSA, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + IF (id%MYID==MASTER) KEEP(127)=INFOG(5) + CALL MPI_BCAST( id%KEEP(127), 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MPI_BCAST( id%KEEP(226), 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + CALL MUMPS_733(id%STEP, id%N, id%INFO, LP, FORCE=.TRUE., + & STRING='id%STEP (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%PROCNODE_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%PROCNODE_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%NE_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%NE_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%ND_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%ND_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%FRERE_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%FRERE_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%DAD_STEPS, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%DAD_STEPS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%FILS, id%N, id%INFO, LP, FORCE=.TRUE., + & STRING='id%FILS (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + CALL MUMPS_733(id%SYM_PERM, id%N, id%INFO, LP, FORCE=.TRUE., + & STRING='id%SYM_PERM (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + IF (KEEP(55) .EQ. 0) THEN + LPTRAR = id%N+id%N + CALL MUMPS_733(id%PTRAR, LPTRAR, id%INFO, LP, FORCE=.TRUE., + & STRING='id%PTRAR (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 94 + ENDIF + IF ( associated( id%UNS_PERM ) ) deallocate(id%UNS_PERM) + IF ( id%MYID == MASTER .AND. id%KEEP(23) .NE. 0 ) THEN + allocate(id%UNS_PERM(id%N),stat=allocok) + IF ( allocok .ne. 0) THEN + INFO(1) = -7 + INFO(2) = id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%UNS_PERM' + END IF + GOTO 94 + ENDIF + DO I=1,id%N + id%UNS_PERM(I) = id%IS1(I) + END DO + ENDIF + 94 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( id%MYID .EQ. MASTER ) THEN + DO I=1,id%N + id%FILS(I) = id%IS1(FILS+I-1) + ENDDO + END IF + IF (id%MYID .EQ. MASTER ) THEN + IF (id%N.eq.1) THEN + NBROOT = 1 + NBLEAF = 1 + ELSE IF (id%IS1(NA+id%N-1) .LT.0) THEN + NBLEAF = id%N + NBROOT = id%N + ELSE IF (id%IS1(NA+id%N-2) .LT.0) THEN + NBLEAF = id%N-1 + NBROOT = id%IS1(NA+id%N-1) + ELSE + NBLEAF = id%IS1(NA+id%N-2) + NBROOT = id%IS1(NA+id%N-1) + ENDIF + id%LNA = 2+NBLEAF+NBROOT + ENDIF + CALL MPI_BCAST( id%LNA, 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MUMPS_733(id%NA, id%LNA, id%INFO, LP, FORCE=.TRUE., + & STRING='id%NA (Analysis)', ERRCODE=-7) + IF(INFO(1).LT.0) GOTO 96 + IF (id%MYID .EQ.MASTER ) THEN + id%NA(1) = NBLEAF + id%NA(2) = NBROOT + LEAF = 3 + IF ( id%N == 1 ) THEN + id%NA(LEAF) = 1 + LEAF = LEAF + 1 + ELSE IF (id%IS1(NA+id%N-1) < 0) THEN + id%NA(LEAF) = - id%IS1(NA+id%N-1)-1 + LEAF = LEAF + 1 + DO I = 1, NBLEAF - 1 + id%NA(LEAF) = id%IS1(NA+I-1) + LEAF = LEAF + 1 + ENDDO + ELSE IF (id%IS1(NA+id%N-2) < 0 ) THEN + INODE = - id%IS1(NA+id%N-2) - 1 + id%NA(LEAF) = INODE + LEAF =LEAF + 1 + IF ( NBLEAF > 1 ) THEN + DO I = 1, NBLEAF - 1 + id%NA(LEAF) = id%IS1(NA+I-1) + LEAF = LEAF + 1 + ENDDO + ENDIF + ELSE + DO I = 1, NBLEAF + id%NA(LEAF) = id%IS1(NA+I-1) + LEAF = LEAF + 1 + ENDDO + END IF + END IF + 96 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF (associated(id%Step2node)) THEN + DEALLOCATE(id%Step2node) + NULLIFY(id%Step2node) + ENDIF + IF ( id%MYID .EQ. MASTER ) THEN + ISTEP = 0 + DO I = 1, id%N + IF ( id%IS1(FRERE+I-1) .ne. id%N + 1 ) THEN + ISTEP = ISTEP + 1 + id%STEP(I)=ISTEP + INN = id%IS1(FILS+I-1) + DO WHILE ( INN .GT. 0 ) + id%STEP(INN) = - ISTEP + INN = id%IS1(FILS + INN -1) + END DO + IF (id%IS1(FRERE+I-1) .eq. 0) THEN + id%NA(LEAF) = I + LEAF = LEAF + 1 + ENDIF + ENDIF + END DO + IF ( LEAF - 1 .NE. 2+NBROOT + NBLEAF ) THEN + WRITE(*,*) 'Internal error 2 in ZMUMPS_26' + CALL MUMPS_ABORT() + ENDIF + IF ( ISTEP .NE. id%KEEP(28) ) THEN + write(*,*) 'Internal error 3 in ZMUMPS_26' + CALL MUMPS_ABORT() + ENDIF + DO I = 1, id%N + IF (id%IS1(FRERE+I-1) .NE. id%N+1) THEN + id%PROCNODE_STEPS(id%STEP(I)) = id%PROCNODE( I ) + id%FRERE_STEPS(id%STEP(I)) = id%IS1(FRERE+I-1) + id%NE_STEPS(id%STEP(I)) = id%IS1(NE+I-1) + id%ND_STEPS(id%STEP(I)) = id%IS1(NFSIZ+I-1) + ENDIF + ENDDO + DO I = 1, id%N + IF ( id%STEP(I) .LE. 0) CYCLE + IF (id%IS1(FRERE+I-1) .eq. 0) THEN + id%DAD_STEPS(id%STEP(I)) = 0 + ENDIF + IFS = id%IS1(FILS+I-1) + DO WHILE ( IFS .GT. 0 ) + IFS= id%IS1(FILS + IFS -1) + END DO + IFS = -IFS + DO WHILE (IFS.GT.0) + id%DAD_STEPS(id%STEP(IFS)) = I + IFS = id%IS1(FRERE+IFS-1) + ENDDO + END DO + deallocate(id%PROCNODE) + NULLIFY(id%PROCNODE) + deallocate(id%IS1) + NULLIFY(id%IS1) + CALL ZMUMPS_363(id%N, id%FRERE_STEPS(1), + & id%STEP(1),id%FILS(1), id%NA(1), id%LNA, + & id%NE_STEPS(1), id%ND_STEPS(1), id%DAD_STEPS(1), + & id%KEEP(28), .TRUE., id%KEEP(28), id%KEEP(70), + & id%KEEP(50), id%INFO(1), id%ICNTL(1),id%KEEP(215), + & id%KEEP(234), id%KEEP(55), + & id%PROCNODE_STEPS(1),id%NSLAVES,PEAK,id%KEEP(90) + & ) + IF ((id%KEEP(76).GE.4).OR.(id%KEEP(76).GE.6).OR. + & (id%KEEP(47).EQ.4).OR.((id%KEEP(81).GT.0) + & .AND.(id%KEEP(47).GE.2)))THEN + IS_BUILD_LOAD_MEM_CALLED=.TRUE. + IF ((id%KEEP(47) .EQ. 4).OR. + & (( id%KEEP(81) .GT. 0).AND.(id%KEEP(47).GE.2))) THEN + IF(id%NSLAVES.GT.1) THEN + SIZE_TEMP_MEM = id%NBSA + ELSE + SIZE_TEMP_MEM = id%NA(2) + ENDIF + ELSE + SIZE_TEMP_MEM = 1 + ENDIF + IF((id%KEEP(76).EQ.4).OR.(id%KEEP(76).EQ.6))THEN + SIZE_DEPTH_FIRST=id%KEEP(28) + ELSE + SIZE_DEPTH_FIRST=1 + ENDIF + allocate(TEMP_MEM(SIZE_TEMP_MEM,id%NSLAVES),STAT=allocok) + IF (allocok .NE.0) THEN + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_MEM' + END IF + GOTO 80 + END IF + allocate(TEMP_LEAF(SIZE_TEMP_MEM,id%NSLAVES), + & stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_LEAF' + END IF + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + GOTO 80 + end if + allocate(TEMP_SIZE(SIZE_TEMP_MEM,id%NSLAVES), + & stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_SIZE' + END IF + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + GOTO 80 + end if + allocate(TEMP_ROOT(SIZE_TEMP_MEM,id%NSLAVES), + & stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'TEMP_ROOT' + END IF + INFO(1)= -7 + INFO(2)= SIZE_TEMP_MEM*id%NSLAVES + GOTO 80 + end if + allocate(DEPTH_FIRST(SIZE_DEPTH_FIRST),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'DEPTH_FIRST' + END IF + INFO(1)= -7 + INFO(2)= SIZE_DEPTH_FIRST + GOTO 80 + end if + ALLOCATE(DEPTH_FIRST_SEQ(SIZE_DEPTH_FIRST),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'DEPTH_FIRST_SEQ' + END IF + INFO(1)= -7 + INFO(2)= SIZE_DEPTH_FIRST + GOTO 80 + end if + ALLOCATE(SBTR_ID(SIZE_DEPTH_FIRST),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'SBTR_ID' + END IF + INFO(1)= -7 + INFO(2)= SIZE_DEPTH_FIRST + GOTO 80 + end if + IF(id%KEEP(76).EQ.5)THEN + SIZE_COST_TRAV=id%KEEP(28) + ELSE + SIZE_COST_TRAV=1 + ENDIF + allocate(COST_TRAV_TMP(SIZE_COST_TRAV),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'COST_TRAV_TMP' + END IF + INFO(1)= -7 + INFO(2)= SIZE_COST_TRAV + GOTO 80 + END IF + IF(id%KEEP(76).EQ.5)THEN + IF(id%KEEP(70).EQ.0)THEN + id%KEEP(70)=5 + ENDIF + IF(id%KEEP(70).EQ.1)THEN + id%KEEP(70)=6 + ENDIF + ENDIF + IF(id%KEEP(76).EQ.4)THEN + IF(id%KEEP(70).EQ.0)THEN + id%KEEP(70)=3 + ENDIF + IF(id%KEEP(70).EQ.1)THEN + id%KEEP(70)=4 + ENDIF + ENDIF + CALL ZMUMPS_364(id%N, id%FRERE_STEPS(1), + & id%STEP(1),id%FILS(1), id%NA(1), id%LNA, + & id%NE_STEPS(1), id%ND_STEPS(1), id%DAD_STEPS(1), + & id%KEEP(28), .TRUE., id%KEEP(28), id%KEEP(70), + & id%KEEP(50), id%INFO(1), id%ICNTL(1),id%KEEP(47), + & id%KEEP(81),id%KEEP(76),id%KEEP(215), + & id%KEEP(234), id%KEEP(55), + & id%PROCNODE_STEPS(1),TEMP_MEM,id%NSLAVES, + & SIZE_TEMP_MEM, PEAK,id%KEEP(90),SIZE_DEPTH_FIRST, + & SIZE_COST_TRAV,DEPTH_FIRST(1),DEPTH_FIRST_SEQ(1), + & COST_TRAV_TMP(1), + & TEMP_LEAF,TEMP_SIZE,TEMP_ROOT,SBTR_ID(1) + & ) + END IF + CALL ZMUMPS_181(id%N, id%NA(1), id%LNA, + & id%NE_STEPS(1), id%SYM_PERM(1), + & id%FILS(1), id%DAD_STEPS(1), + & id%STEP(1), id%KEEP(28), id%INFO(1) ) + ENDIF + 80 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + CALL MPI_BCAST( id%FILS(1), id%N, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%NA(1), id%LNA, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%STEP(1), id%N, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%PROCNODE_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%DAD_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%FRERE_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR) + CALL MPI_BCAST( id%NE_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%ND_STEPS(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%SYM_PERM(1), id%N, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (KEEP(55) .EQ. 0) THEN + CALL ZMUMPS_746(id, id%PTRAR(1)) + IF(id%MYID .EQ. MASTER) THEN + IF ( (KEEP(244) .EQ. 1) .AND. (KEEP(54) .EQ. 3) ) THEN + DEALLOCATE( id%IRN ) + DEALLOCATE( id%JCN ) + END IF + END IF + ENDIF + IF((id%KEEP(76).EQ.4).OR.(id%KEEP(76).EQ.6))THEN + IF(associated(id%DEPTH_FIRST)) + & deallocate(id%DEPTH_FIRST) + allocate(id%DEPTH_FIRST(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= id%KEEP(28) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST' + END IF + GOTO 87 + END IF + IF(associated(id%DEPTH_FIRST_SEQ)) + * DEALLOCATE(id%DEPTH_FIRST_SEQ) + ALLOCATE(id%DEPTH_FIRST_SEQ(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= id%KEEP(28) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + IF(associated(id%SBTR_ID)) + * DEALLOCATE(id%SBTR_ID) + ALLOCATE(id%SBTR_ID(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= id%KEEP(28) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + IF(id%MYID.EQ.MASTER)THEN + id%DEPTH_FIRST(1:id%KEEP(28))=DEPTH_FIRST(1:id%KEEP(28)) + id%DEPTH_FIRST_SEQ(1:id%KEEP(28))= + & DEPTH_FIRST_SEQ(1:id%KEEP(28)) + id%SBTR_ID(1:KEEP(28))=SBTR_ID(1:KEEP(28)) + ENDIF + CALL MPI_BCAST( id%DEPTH_FIRST(1), id%KEEP(28), MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%DEPTH_FIRST_SEQ(1), id%KEEP(28), + & MPI_INTEGER,MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%SBTR_ID(1), id%KEEP(28), + & MPI_INTEGER,MASTER, id%COMM, IERR ) + ELSE + IF(associated(id%DEPTH_FIRST)) + & deallocate(id%DEPTH_FIRST) + allocate(id%DEPTH_FIRST(1),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST' + END IF + GOTO 87 + END IF + IF(associated(id%DEPTH_FIRST_SEQ)) + * DEALLOCATE(id%DEPTH_FIRST_SEQ) + ALLOCATE(id%DEPTH_FIRST_SEQ(1),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + IF(associated(id%SBTR_ID)) + * DEALLOCATE(id%SBTR_ID) + ALLOCATE(id%SBTR_ID(1),stat=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%DEPTH_FIRST_SEQ' + END IF + GOTO 87 + END IF + id%SBTR_ID(1)=0 + id%DEPTH_FIRST(1)=0 + id%DEPTH_FIRST_SEQ(1)=0 + ENDIF + IF(id%KEEP(76).EQ.5)THEN + IF(associated(id%COST_TRAV)) + & deallocate(id%COST_TRAV) + allocate(id%COST_TRAV(id%KEEP(28)),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%COST_TRAV' + END IF + INFO(1)= -7 + INFO(2)= id%KEEP(28) + GOTO 87 + END IF + IF(id%MYID.EQ.MASTER)THEN + id%COST_TRAV(1:id%KEEP(28))= + & dble(COST_TRAV_TMP(1:id%KEEP(28))) + ENDIF + CALL MPI_BCAST( id%COST_TRAV(1), id%KEEP(28), + & MPI_DOUBLE_PRECISION,MASTER, id%COMM, IERR ) + ELSE + IF(associated(id%COST_TRAV)) + & deallocate(id%COST_TRAV) + allocate(id%COST_TRAV(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%COST_TRAV(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + id%COST_TRAV(1)=0.0d0 + ENDIF + IF (id%KEEP(47) .EQ. 4 .OR. + & ((id%KEEP(81) .GT. 0).AND.(id%KEEP(47).GE.2))) THEN + IF(id%MYID .EQ. MASTER)THEN + DO K=1,id%NSLAVES + DO J=1,SIZE_TEMP_MEM + IF(TEMP_MEM(J,K) < 0.0D0) GOTO 666 + ENDDO + 666 CONTINUE + J=J-1 + IF (id%KEEP(46) == 1) THEN + IDEST = K - 1 + ELSE + IDEST = K + ENDIF + IF (IDEST .NE. MASTER) THEN + CALL MPI_SEND(J,1,MPI_INTEGER,IDEST,0, + & id%COMM,IERR) + CALL MPI_SEND(TEMP_MEM(1,K),J,MPI_DOUBLE_PRECISION, + & IDEST, 0, id%COMM,IERR) + CALL MPI_SEND(TEMP_LEAF(1,K),J,MPI_INTEGER, + & IDEST, 0, id%COMM,IERR) + CALL MPI_SEND(TEMP_SIZE(1,K),J,MPI_INTEGER, + & IDEST, 0, id%COMM,IERR) + CALL MPI_SEND(TEMP_ROOT(1,K),J,MPI_INTEGER, + & IDEST, 0, id%COMM,IERR) + ELSE + IF(associated(id%MEM_SUBTREE)) + & deallocate(id%MEM_SUBTREE) + allocate(id%MEM_SUBTREE(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MEM_SUBTREE' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%NBSA_LOCAL = J + id%MEM_SUBTREE(1:J)=TEMP_MEM(1:J,1) + IF(associated(id%MY_ROOT_SBTR)) + & deallocate(id%MY_ROOT_SBTR) + allocate(id%MY_ROOT_SBTR(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_ROOT_SBTR' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%MY_ROOT_SBTR(1:J)=TEMP_ROOT(1:J,1) + IF(associated(id%MY_FIRST_LEAF)) + & deallocate(id%MY_FIRST_LEAF) + allocate(id%MY_FIRST_LEAF(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_FIRST_LEAF' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%MY_FIRST_LEAF(1:J)=TEMP_LEAF(1:J,1) + IF(associated(id%MY_NB_LEAF)) + & deallocate(id%MY_NB_LEAF) + allocate(id%MY_NB_LEAF(J),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_NB_LEAF' + END IF + INFO(1)= -7 + INFO(2)= J + GOTO 87 + END IF + id%MY_NB_LEAF(1:J)=TEMP_SIZE(1:J,1) + ENDIF + ENDDO + ELSE + CALL MPI_RECV(id%NBSA_LOCAL,1,MPI_INTEGER, + & MASTER,0,id%COMM,STATUS, IERR) + IF(associated(id%MEM_SUBTREE)) + & deallocate(id%MEM_SUBTREE) + allocate(id%MEM_SUBTREE(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MEM_SUBTREE' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + IF(associated(id%MY_ROOT_SBTR)) + & deallocate(id%MY_ROOT_SBTR) + allocate(id%MY_ROOT_SBTR(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_ROOT_SBTR' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + IF(associated(id%MY_FIRST_LEAF)) + & deallocate(id%MY_FIRST_LEAF) + allocate(id%MY_FIRST_LEAF(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'MY_FIRST_LEAF' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + IF(associated(id%MY_NB_LEAF)) + & deallocate(id%MY_NB_LEAF) + allocate(id%MY_NB_LEAF(id%NBSA_LOCAL),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'MY_NB_LEAF' + END IF + INFO(1)= -7 + INFO(2)= id%NBSA_LOCAL + GOTO 87 + END IF + CALL MPI_RECV(id%MEM_SUBTREE(1),id%NBSA_LOCAL, + & MPI_DOUBLE_PRECISION,MASTER,0, + & id%COMM,STATUS,IERR) + CALL MPI_RECV(id%MY_FIRST_LEAF(1),id%NBSA_LOCAL, + & MPI_INTEGER,MASTER,0, + & id%COMM,STATUS,IERR) + CALL MPI_RECV(id%MY_NB_LEAF(1),id%NBSA_LOCAL, + & MPI_INTEGER,MASTER,0, + & id%COMM,STATUS,IERR) + CALL MPI_RECV(id%MY_ROOT_SBTR(1),id%NBSA_LOCAL, + & MPI_INTEGER,MASTER,0, + & id%COMM,STATUS,IERR) + ENDIF + ELSE + id%NBSA_LOCAL = -999999 + IF(associated(id%MEM_SUBTREE)) + & deallocate(id%MEM_SUBTREE) + allocate(id%MEM_SUBTREE(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MEM_SUBTREE(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + IF(associated(id%MY_ROOT_SBTR)) + & deallocate(id%MY_ROOT_SBTR) + allocate(id%MY_ROOT_SBTR(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_ROOT_SBTR(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + IF(associated(id%MY_FIRST_LEAF)) + & deallocate(id%MY_FIRST_LEAF) + allocate(id%MY_FIRST_LEAF(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_FIRST_LEAF(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + IF(associated(id%MY_NB_LEAF)) + & deallocate(id%MY_NB_LEAF) + allocate(id%MY_NB_LEAF(1),stat=allocok) + IF (allocok .ne.0) then + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MY_NB_LEAF(1)' + END IF + INFO(1)= -7 + INFO(2)= 1 + GOTO 87 + END IF + ENDIF + IF(id%MYID.EQ.MASTER)THEN + IF(IS_BUILD_LOAD_MEM_CALLED)THEN + deallocate(TEMP_MEM) + deallocate(TEMP_SIZE) + deallocate(TEMP_ROOT) + deallocate(TEMP_LEAF) + deallocate(COST_TRAV_TMP) + deallocate(DEPTH_FIRST) + deallocate(DEPTH_FIRST_SEQ) + deallocate(SBTR_ID) + ENDIF + ENDIF + 87 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + NB_NIV2 = KEEP(56) + IF ( NB_NIV2.GT.0 ) THEN + if (id%MYID.ne.MASTER) then + IF (associated(id%CANDIDATES)) deallocate(id%CANDIDATES) + allocate(PAR2_NODES(NB_NIV2), + & id%CANDIDATES(id%NSLAVES+1,NB_NIV2), + & STAT=allocok) + IF (allocok .ne.0) then + INFO(1)= -7 + INFO(2)= NB_NIV2*(id%NSLAVES+1) + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'PAR2_NODES/id%CANDIDATES' + END IF + end if + end if + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + CALL MPI_BCAST(PAR2_NODES(1),NB_NIV2, + & MPI_INTEGER, MASTER, id%COMM, IERR ) + IF (KEEP(24) .NE.0 ) THEN + CALL MPI_BCAST(id%CANDIDATES(1,1), + & (NB_NIV2*(id%NSLAVES+1)), + & MPI_INTEGER, MASTER, id%COMM, IERR ) + ENDIF + ENDIF + IF ( associated(id%ISTEP_TO_INIV2)) THEN + deallocate(id%ISTEP_TO_INIV2) + NULLIFY(id%ISTEP_TO_INIV2) + ENDIF + IF ( associated(id%I_AM_CAND)) THEN + deallocate(id%I_AM_CAND) + NULLIFY(id%I_AM_CAND) + ENDIF + IF (NB_NIV2.EQ.0) THEN + id%KEEP(71) = 1 + ELSE + id%KEEP(71) = id%KEEP(28) + ENDIF + allocate(id%ISTEP_TO_INIV2(id%KEEP(71)), + & id%I_AM_CAND(max(NB_NIV2,1)), + & stat=allocok) + IF (allocok .gt.0) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%ISTEP_TO_INIV2' + WRITE(LP, 150) 'id%TAB_POS_IN_PERE' + END IF + INFO(1)= -7 + IF (NB_NIV2.EQ.0) THEN + INFO(2)= 2 + ELSE + INFO(2)= id%KEEP(28)+NB_NIV2*(id%NSLAVES+2) + END IF + GOTO 321 + ENDIF + IF ( NB_NIV2 .GT.0 ) THEN + DO INIV2 = 1, NB_NIV2 + INN = PAR2_NODES(INIV2) + id%ISTEP_TO_INIV2(id%STEP(INN)) = INIV2 + END DO + CALL ZMUMPS_649( id%NSLAVES, + & NB_NIV2, id%MYID_NODES, + & id%CANDIDATES(1,1), id%I_AM_CAND(1) ) + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + IF (associated(id%FUTURE_NIV2)) THEN + deallocate(id%FUTURE_NIV2) + NULLIFY(id%FUTURE_NIV2) + ENDIF + allocate(id%FUTURE_NIV2(id%NSLAVES), stat=allocok) + IF (allocok .gt.0) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'FUTURE_NIV2' + END IF + INFO(1)= -7 + INFO(2)= id%NSLAVES + GOTO 321 + ENDIF + id%FUTURE_NIV2=0 + DO INIV2 = 1, NB_NIV2 + IDEST = MUMPS_275( + & id%PROCNODE_STEPS(id%STEP(PAR2_NODES(INIV2))), + & id%NSLAVES) + id%FUTURE_NIV2(IDEST+1)=id%FUTURE_NIV2(IDEST+1)+1 + ENDDO +#endif + IF ( I_AM_SLAVE ) THEN + IF ( associated(id%TAB_POS_IN_PERE)) THEN + deallocate(id%TAB_POS_IN_PERE) + NULLIFY(id%TAB_POS_IN_PERE) + ENDIF + allocate(id%TAB_POS_IN_PERE(id%NSLAVES+2,max(NB_NIV2,1)), + & stat=allocok) + IF (allocok .gt.0) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%ISTEP_TO_INIV2' + WRITE(LP, 150) 'id%TAB_POS_IN_PERE' + END IF + INFO(1)= -7 + IF (NB_NIV2.EQ.0) THEN + INFO(2)= 2 + ELSE + INFO(2)= id%KEEP(28)+NB_NIV2*(id%NSLAVES+2) + END IF + GOTO 321 + ENDIF + END IF + IF (NB_NIV2.GT.0) deallocate (PAR2_NODES) + 321 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF ( KEEP(23).NE.0 .and. id%MYID .EQ. MASTER ) THEN + IKEEP = id%N + 1 + ELSE + IKEEP = 1 + END IF + FILS = IKEEP + 3 * id%N + NE = IKEEP + 2 * id%N + NA = IKEEP + id%N + FRERE = FILS + id%N + PTRAR = FRERE + id%N + IF (KEEP(55) .EQ. 0) THEN + IF ( id%MYID.EQ.MASTER ) THEN + NFSIZ = PTRAR + 4 * id%N + ELSE + NFSIZ = PTRAR + 2 * id%N + ENDIF + ELSE + NFSIZ = PTRAR + 2 * (NELT + 1) + END IF + IF ( KEEP(38) .NE. 0 ) THEN + CALL ZMUMPS_164( id%MYID, + & id%NSLAVES, id%N, id%root, + & id%COMM_NODES, KEEP( 38 ), id%FILS(1), + & id%KEEP(50), id%KEEP(46), + & id%KEEP(51) + & , id%KEEP(60), id%NPROW, id%NPCOL, id%MBLOCK, id%NBLOCK + & ) + ELSE + id%root%yes = .FALSE. + END IF + IF ( KEEP(38) .NE. 0 .and. I_AM_SLAVE ) THEN + CALL MPI_ALLREDUCE(id%root%MYROW, MYROW_CHECK, 1, + & MPI_INTEGER, MPI_MAX, id%COMM_NODES, IERR) + IF ( MYROW_CHECK .eq. -1) THEN + INFO(1) = -25 + INFO(2) = 0 + END IF + IF ( id%root%MYROW .LT. -1 .OR. + & id%root%MYCOL .LT. -1 ) THEN + INFO(1) = -25 + INFO(2) = 0 + END IF + IF ( LP > 0 .AND. INFO(1) == -25 ) THEN + WRITE(LP, '(A)') + & 'Problem with your version of the BLACS.' + WRITE(LP, '(A)') 'Try using a BLACS version from netlib.' + ENDIF + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF ( I_AM_SLAVE ) THEN + IF (KEEP(55) .EQ. 0) THEN + CALL ZMUMPS_24( id%MYID, + & id%NSLAVES, id%N, id%PROCNODE_STEPS(1), + & id%STEP(1), id%PTRAR(1), + & id%PTRAR(id%N +1), + & id%ISTEP_TO_INIV2(1), id%I_AM_CAND(1), + & KEEP(1),KEEP8(1), ICNTL(1), id ) + ELSE + CALL ZMUMPS_25( id%MYID, + & id%NSLAVES, id%N, id%PROCNODE_STEPS(1), + & id%STEP(1), + & id%PTRAR(1), + & id%PTRAR(id%NELT+2 ), + & id%NELT, + & id%FRTPTR(1), id%FRTELT(1), + & KEEP(1), KEEP8(1), ICNTL(1), id%KEEP(50) ) + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + IF ( id%root%yes ) THEN + LOCAL_M = numroc( id%ND_STEPS(id%STEP(KEEP(38))), + & id%root%MBLOCK, id%root%MYROW, 0, + & id%root%NPROW ) + LOCAL_M = max(1, LOCAL_M) + LOCAL_N = numroc( id%ND_STEPS(id%STEP(KEEP(38))), + & id%root%NBLOCK, id%root%MYCOL, 0, + & id%root%NPCOL ) + ELSE + LOCAL_M = 0 + LOCAL_N = 0 + END IF + IF ( KEEP(60) .EQ. 2 .OR. KEEP(60) .EQ. 3 ) THEN + id%SCHUR_MLOC=LOCAL_M + id%SCHUR_NLOC=LOCAL_N + id%root%SCHUR_MLOC=LOCAL_M + id%root%SCHUR_NLOC=LOCAL_N + ENDIF + IF ( .NOT. associated(id%CANDIDATES)) THEN + ALLOCATE(id%CANDIDATES(id%NSLAVES+1,1)) + ENDIF + CALL ZMUMPS_246( id%MYID_NODES, id%N, + & id%STEP(1), id%FRERE_STEPS(1), id%FILS(1), + & id%NA(1), id%LNA, id%NE_STEPS(1), id%DAD_STEPS(1), + & id%ND_STEPS(1), id%PROCNODE_STEPS(1), + & id%NSLAVES, + & KEEP8(11), KEEP(26), KEEP(15), + & KEEP8(12), + & KEEP8(14), + & KEEP(224), KEEP(225), + & KEEP(27), RINFO(1), + & KEEP(1), KEEP8(1), LOCAL_M, LOCAL_N, SBUF_RECOLD8, + & SBUF_SEND, SBUF_REC, id%COST_SUBTREES, KEEP(28), + & id%I_AM_CAND(1), max(KEEP(56),1), + & id%ISTEP_TO_INIV2(1), id%CANDIDATES(1,1), + & INFO(1), INFO(2) + & ,KEEP8(15) + & ,MAX_SIZE_FACTOR_TMP, KEEP8(9) + & ,ENTRIES_IN_FACTORS_LOC_MASTERS + & ) + id%MAX_SURF_MASTER = KEEP8(15) + KEEP8(19)=MAX_SIZE_FACTOR_TMP + KEEP( 29 ) = KEEP(15) + 2* max(KEEP(12),10) + & * ( KEEP(15) / 100 + 1) + INFO( 19 ) = KEEP(225) + 2* max(KEEP(12),10) + & * ( KEEP(225) / 100 + 1) + KEEP8(13) = KEEP8(12) + int(KEEP(12),8) * + & ( KEEP8(12) / 100_8 + 1_8 ) + KEEP8(17) = KEEP8(14) + int(KEEP(12),8) * + & ( KEEP8(14) /100_8 +1_8) + CALL MUMPS_736 ( SBUF_RECOLD8, KEEP8(22), MPI_MAX, + & id%COMM_NODES ) + SBUF_SEND = max(SBUF_SEND,KEEP(27)) + SBUF_REC = max(SBUF_REC ,KEEP(27)) + CALL MPI_ALLREDUCE (SBUF_REC, KEEP(44), 1, + & MPI_INTEGER, MPI_MAX, + & id%COMM_NODES, IERR) + IF (KEEP(48)==5) THEN + KEEP(43)=KEEP(44) + ELSE + KEEP(43)=SBUF_SEND + ENDIF + MIN_BUF_SIZE8 = KEEP8(22) / int(KEEP(238),8) + MIN_BUF_SIZE8 = min( MIN_BUF_SIZE8, int(huge (KEEP(43)),8)) + MIN_BUF_SIZE = int( MIN_BUF_SIZE8 ) + KEEP(44) = max(KEEP(44), MIN_BUF_SIZE) + KEEP(43) = max(KEEP(43), MIN_BUF_SIZE) + IF ( MP .GT. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' Estimated INTEGER space for factors :', + & KEEP(26) + WRITE(MP,'(A,I10) ') + & ' INFO(3), est. complex space to store factors:', + & KEEP8(11) + WRITE(MP,'(A,I10) ') + & ' Estimated number of entries in factors :', + & KEEP8(9) + WRITE(MP,'(A,I10) ') + & ' Current value of space relaxation parameter :', + & KEEP(12) + WRITE(MP,'(A,I10) ') + & ' Estimated size of IS (In Core factorization):', + & KEEP(29) + WRITE(MP,'(A,I10) ') + & ' Estimated size of S (In Core factorization):', + & KEEP8(13) + WRITE(MP,'(A,I10) ') + & ' Estimated size of S (OOC factorization) :', + & KEEP8(17) + END IF + ELSE + ENTRIES_IN_FACTORS_LOC_MASTERS = 0_8 + KEEP8(13) = 0_8 + KEEP(29) = 0 + KEEP8(17)= 0_8 + INFO(19) = 0 + KEEP8(11) = 0_8 + KEEP(26) = 0 + KEEP(27) = 0 + RINFO(1) = 0.0D0 + END IF + CALL MUMPS_736( ENTRIES_IN_FACTORS_LOC_MASTERS, + & KEEP8(109), MPI_SUM, id%COMM) + CALL MUMPS_736( KEEP8(19), KEEP8(119), + & MPI_MAX, id%COMM) + CALL MPI_ALLREDUCE( KEEP(27), KEEP(127), 1, + & MPI_INTEGER, MPI_MAX, + & id%COMM, IERR) + CALL MPI_ALLREDUCE( KEEP(26), KEEP(126), 1, + & MPI_INTEGER, MPI_SUM, + & id%COMM, IERR) + CALL MUMPS_646( KEEP8(11), KEEP8(111), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735( KEEP8(111), INFOG(3) ) + CALL MPI_ALLREDUCE( RINFO(1), RINFOG(1), 1, + & MPI_DOUBLE_PRECISION, MPI_SUM, + & id%COMM, IERR) + CALL MUMPS_735( KEEP8(11), INFO(3) ) + INFO ( 4 ) = KEEP( 26 ) + INFO ( 5 ) = KEEP( 27 ) + INFO ( 7 ) = KEEP( 29 ) + CALL MUMPS_735( KEEP8(13), INFO(8) ) + CALL MUMPS_735( KEEP8(17), INFO(20) ) + CALL MUMPS_735( KEEP8(9), INFO(24) ) + INFOG( 4 ) = KEEP( 126 ) + INFOG( 5 ) = KEEP( 127 ) + CALL MUMPS_735( KEEP8(109), INFOG(20) ) + CALL ZMUMPS_100(id%MYID, id%COMM, KEEP(1), KEEP8(1), + & INFO(1), INFOG(1), RINFO(1), RINFOG(1), ICNTL(1)) + OOC_STAT = KEEP(201) + IF (KEEP(201) .NE. -1) OOC_STAT=0 + PERLU_ON = .FALSE. + CALL ZMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + KEEP8(2) = TOTAL_BYTES + PERLU_ON = .TRUE. + CALL ZMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + IF ( MP .gt. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' Estimated space in MBYTES for IC factorization :', + & TOTAL_MBYTES + END IF + id%INFO(15) = TOTAL_MBYTES + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(15), id%INFOG(16), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Rank of proc needing largest memory in IC facto :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Estimated corresponding MBYTES for IC facto :', + & id%INFOG(16) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (IC) :' + & ,(id%INFOG(17)-id%INFO(15))/id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (IC) :' + & ,id%INFOG(17)/id%NSLAVES + END IF + WRITE(MPG,'(A,I10) ') + & ' ** TOTAL space in MBYTES for IC factorization :' + & ,id%INFOG(17) + END IF + OOC_STAT = KEEP(201) +#if defined(OLD_OOC_NOPANEL) + IF (OOC_STAT .NE. -1) OOC_STAT=2 +#else + IF (OOC_STAT .NE. -1) OOC_STAT=1 +#endif + PERLU_ON = .FALSE. + CALL ZMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + KEEP8(3) = TOTAL_BYTES + PERLU_ON = .TRUE. + CALL ZMUMPS_214( KEEP(1), KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., + & OOC_STAT, PERLU_ON, TOTAL_BYTES) + id%INFO(17) = TOTAL_MBYTES + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(17), id%INFOG(26), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Rank of proc needing largest memory for OOC facto :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Estimated corresponding MBYTES for OOC facto :', + & id%INFOG(26) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (OOC) :' + & ,(id%INFOG(27)-id%INFO(15))/id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Estimated avg. MBYTES per work. proc at facto (OOC) :' + & ,id%INFOG(27)/id%NSLAVES + END IF + WRITE(MPG,'(A,I10) ') + & ' ** TOTAL space in MBYTES for OOC factorization :' + & ,id%INFOG(27) + END IF + IF ( id%MYID. eq. MASTER .AND. KEEP(54) .eq. 1 ) THEN + IF (associated( id%MAPPING)) + & deallocate( id%MAPPING) + allocate( id%MAPPING(id%NZ), stat=allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1) = -7 + INFO(2) = id%NZ + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'id%MAPPING' + END IF + GOTO 92 + END IF + allocate(IWtemp( id%N ), stat=allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-7 + INFO(2)=id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'IWtemp(N)' + END IF + GOTO 92 + END IF + CALL ZMUMPS_83( + & id%N, id%MAPPING(1), + & id%NZ, id%IRN(1),id%JCN(1), id%PROCNODE_STEPS(1), + & id%STEP(1), + & id%NSLAVES, id%SYM_PERM(1), + & id%FILS(1), IWtemp, id%KEEP(1),id%KEEP8(1), + & id%root%MBLOCK, id%root%NBLOCK, + & id%root%NPROW, id%root%NPCOL ) + deallocate( IWtemp ) + 92 CONTINUE + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + RETURN + 110 FORMAT(/' ****** ANALYSIS STEP ********'/) + 150 FORMAT( + & /' ** FAILURE DURING ZMUMPS_26, DYNAMIC ALLOCATION OF', + & A30) + END SUBROUTINE ZMUMPS_26 + SUBROUTINE ZMUMPS_537(N,NSLAVES, + & ICNTL,INFOG, NE, NFSIZ, + & FRERE, FILS, + & KEEP,KEEP8,PROCNODE, + & SSARBR,NBSA,PEAK,IERR + & ) + USE MUMPS_STATIC_MAPPING + IMPLICIT NONE + INTEGER N, NSLAVES, NBSA, IERR + INTEGER ICNTL(40),INFOG(40),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER NE(N),NFSIZ(N),FRERE(N),FILS(N),PROCNODE(N) + INTEGER SSARBR(N) + DOUBLE PRECISION PEAK + CALL MUMPS_369(N,NSLAVES, + & ICNTL,INFOG, NE, NFSIZ, + & FRERE, FILS, + & KEEP,KEEP8,PROCNODE, + & SSARBR,NBSA,dble(PEAK),IERR + & ) + RETURN + END SUBROUTINE ZMUMPS_537 + SUBROUTINE ZMUMPS_564(INODE, PROCNODE, VALUE, FILS, N) + INTEGER, intent(in) :: INODE, N, VALUE + INTEGER, intent(in) :: FILS(N) + INTEGER, intent(inout) :: PROCNODE(N) + INTEGER IN + IN=INODE + DO WHILE ( IN > 0 ) + PROCNODE( IN ) = VALUE + IN=FILS( IN ) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_564 + SUBROUTINE ZMUMPS_647(id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(ZMUMPS_STRUC) :: id + INTEGER :: LP, MP, MPG, I + INTEGER :: MASTER + LOGICAL :: PROK, PROKG + PARAMETER( MASTER = 0 ) + LP = id%ICNTL( 1 ) + MP = id%ICNTL( 2 ) + MPG = id%ICNTL( 3 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF (id%MYID.eq.MASTER) THEN + id%KEEP(256) = id%ICNTL(7) + id%KEEP(252) = id%ICNTL(32) + IF (id%KEEP(252) < 0 .OR. id%KEEP(252) > 1 ) THEN + id%KEEP(252) = 0 + ENDIF + id%KEEP(251) = id%ICNTL(31) + IF (id%KEEP(251) < 0 .OR. id%KEEP(251) > 2 ) THEN + id%KEEP(251)=0 + ENDIF + IF (id%KEEP(50) .EQ. 0 .AND. id%KEEP(252).EQ.1) THEN + IF (id%KEEP(251) .NE. 1) id%KEEP(251) = 2 + ENDIF + IF (id%KEEP(50) .NE.0 .AND. id%KEEP(251) .EQ. 2) THEN + id%KEEP(251) = 0 + ENDIF + IF (id%KEEP(251) .EQ. 1) THEN + id%KEEP(201) = -1 + ENDIF + IF (id%KEEP(252).EQ.1) THEN + id%KEEP(253) = id%NRHS + IF (id%KEEP(253) .LE. 0) THEN + id%INFO(1)=-42 + id%INFO(2)=id%NRHS + RETURN + ENDIF + ELSE + id%KEEP(253) = 0 + ENDIF + ENDIF + IF ( (id%KEEP(24).NE.0) .AND. + & id%NSLAVES.eq.1 ) THEN + id%KEEP(24) = 0 + IF ( PROKG ) THEN + WRITE(MPG, '(A)') + & ' Resetting candidate strategy to 0 because NSLAVES=1' + WRITE(MPG, '(A)') ' ' + END IF + END IF + IF ( (id%KEEP(24).EQ.0) .AND. + & id%NSLAVES.GT.1 ) THEN + id%KEEP(24) = 8 + ENDIF + IF ( (id%KEEP(24).NE.0) .AND. (id%KEEP(24).NE.1) .AND. + & (id%KEEP(24).NE.8) .AND. (id%KEEP(24).NE.10) .AND. + & (id%KEEP(24).NE.12) .AND. (id%KEEP(24).NE.14) .AND. + & (id%KEEP(24).NE.16) .AND. (id%KEEP(24).NE.18)) THEN + id%KEEP(24) = 8 + IF ( PROKG ) THEN + WRITE(MPG, '(A)') + & ' Resetting candidate strategy to 8 ' + WRITE(MPG, '(A)') ' ' + END IF + END IF + id%KEEP8(21) = int(id%KEEP(85),8) + IF ( id%MYID .EQ. MASTER ) THEN + IF (id%KEEP(201).NE.-1) THEN + id%KEEP(201)=id%ICNTL(22) + IF (id%KEEP(201) .GT. 0) THEN +#if defined(OLD_OOC_NOPANEL) + id%KEEP(201)=2 +#else + id%KEEP(201)=1 +#endif + ENDIF + ENDIF + id%KEEP(54) = id%ICNTL(18) + IF ( id%KEEP(54) .LT. 0 .or. id%KEEP(54).GT.3 ) THEN + IF ( PROKG ) THEN + WRITE(MPG, *) ' Out-of-range value for id%ICNTL(18).' + WRITE(MPG, *) ' Used 0 ie matrix not distributed' + END IF + id%KEEP(54) = 0 + END IF + id%KEEP(55) = id%ICNTL(5) + IF ( id%KEEP(55) .LT. 0 .OR. id%KEEP(55) .GT. 1 ) THEN + IF ( PROKG ) THEN + WRITE(MPG, *) ' Out-of-range value for id%ICNTL(5).' + WRITE(MPG, *) ' Used 0 ie matrix is assembled' + END IF + id%KEEP(55) = 0 + END IF + id%KEEP(60) = id%ICNTL(19) + IF ( id%KEEP( 60 ) .LE. 0 ) id%KEEP( 60 ) = 0 + IF ( id%KEEP( 60 ) .GT. 3 ) id%KEEP( 60 ) = 0 + IF (id%KEEP(60) .NE. 0 .AND. id%SIZE_SCHUR == 0 ) THEN + WRITE(MPG,'(A)') + & ' ** Schur option ignored because SIZE_SCHUR=0' + id%KEEP(60)=0 + END IF + IF ( id%KEEP(60) .NE.0 ) THEN + id%KEEP(116) = id%SIZE_SCHUR + IF (id%SIZE_SCHUR .LT. 0 .OR. id%SIZE_SCHUR .GE. id%N) THEN + id%INFO(1)=-49 + id%INFO(2)=id%SIZE_SCHUR + RETURN + ENDIF + IF ( .NOT. associated( id%LISTVAR_SCHUR ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 8 + RETURN + ELSE IF (size(id%LISTVAR_SCHUR) 0 .AND. id%NBLOCK > 0 .AND. + & id%NPROW > 0 .AND. id%NPCOL > 0 ) THEN + IF (id%NPROW *id%NPCOL .LE. id%NSLAVES) THEN + IF (id%MBLOCK .NE. id%NBLOCK ) THEN + id%INFO(1)=-31 + id%INFO(2)=id%MBLOCK - id%NBLOCK + RETURN + ENDIF + ENDIF + ENDIF + ENDIF + id%KEEP(244) = id%ICNTL(28) + id%KEEP(245) = id%ICNTL(29) +#if ! defined(parmetis) + IF ((id%KEEP(244) .EQ. 2) .AND. (id%KEEP(245) .EQ. 2)) THEN + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) THEN + WRITE(LP,'("ParMETIS not available.")') + WRITE(LP,'("Aborting.")') + RETURN + END IF + END IF +#endif +#if ! defined(ptscotch) + IF ((id%KEEP(244) .EQ. 2) .AND. (id%KEEP(245) .EQ. 1)) THEN + id%INFO(1) = -38 + IF(id%MYID .EQ.0 ) THEN + WRITE(LP,'("PT-SCOTCH not available.")') + WRITE(LP,'("Aborting.")') + RETURN + END IF + END IF +#endif + IF((id%KEEP(244) .GT. 2) .OR. + & (id%KEEP(244) .LT. 0)) id%KEEP(244)=0 + IF(id%KEEP(244) .EQ. 0) THEN + id%KEEP(244) = 1 + ELSE IF (id%KEEP(244) .EQ. 2) THEN + IF(id%KEEP(55) .NE. 0) THEN + id%INFO(1) = -39 + WRITE(LP, + & '("Incompatible values for ICNTL(5), ICNTL(28)")') + WRITE(LP, + & '("Parallel analysis is not possible if the")') + WRITE(LP, + & '("matrix is not assembled")') + RETURN + ELSE IF(id%KEEP(60) .NE. 0) THEN + id%INFO(1) = -39 + WRITE(LP, + & '("Incompatible values for ICNTL(19), ICNTL(28)")') + WRITE(LP, + & '("Parallel analysis is not possible if SCHUR")') + WRITE(LP, + & '("complement must be returned")') + RETURN + END IF + IF(id%NSLAVES .LT. 2) THEN + id%KEEP(244) = 1 + IF(PROKG) WRITE(MPG, + & '("Too few processes. + & Reverting to sequential analysis")',advance='no') + IF(id%KEEP(245) .EQ. 1) THEN + IF(PROKG) WRITE(MPG, '(" with SCOTCH")') + id%KEEP(256) = 3 + ELSE IF(id%KEEP(245) .EQ. 2) THEN + IF(PROKG) WRITE(MPG, '(" with Metis")') + id%KEEP(256) = 5 + ELSE + IF(PROKG) WRITE(MPG, '(".")') + id%KEEP(256) = 0 + END IF + END IF + END IF + id%INFOG(32) = id%KEEP(244) + IF ( (id%KEEP(244) .EQ. 1) .AND. + & (id%KEEP(256) .EQ. 1) ) THEN + IF ( .NOT. associated( id%PERM_IN ) ) THEN + id%INFO(1) = -22 + id%INFO(2) = 3 + RETURN + ELSE IF ( size( id%PERM_IN ) < id%N ) THEN + id%INFO(1) = -22 + id%INFO(2) = 3 + RETURN + END IF + ENDIF + IF (id%KEEP(9) .LE. 1 ) id%KEEP(9) = 500 + IF ( id%KEEP8(21) .GT. 0_8 ) THEN + IF ((id%KEEP8(21).LE.1_8) .OR. + & (id%KEEP8(21).GT.int(id%KEEP(9),8))) + & id%KEEP8(21) = int(min(id%KEEP(9),100),8) + ENDIF + IF (id%KEEP(48). EQ. 1 ) id%KEEP(48) = -12345 + IF ( (id%KEEP(48).LT.0) .OR. (id%KEEP(48).GT.5) ) THEN + id%KEEP(48)=5 + ENDIF + IF ( (id%KEEP(60) .NE. 0) .AND. (id%KEEP(256) .EQ. 1) ) THEN + DO I = 1, id%SIZE_SCHUR + IF (id%PERM_IN(id%LISTVAR_SCHUR(I)) + & .EQ. id%N-id%SIZE_SCHUR+I) + & CYCLE + id%INFO(1) = -22 + id%INFO(2) = 8 + RETURN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Ignoring user-ordering, because incompatible with Schur.' + WRITE(MPG,'(A)') ' ** id%ICNTL(7) treated as 0.' + END IF + EXIT + ENDDO + END IF + id%KEEP(95) = id%ICNTL(12) + IF (id%KEEP(50).NE.2) id%KEEP(95) = 1 + IF ((id%KEEP(95).GT.3).OR.(id%KEEP(95).LT.0)) id%KEEP(95) = 0 + id%KEEP(23) = id%ICNTL(6) + IF (id%KEEP(23).LT.0.OR.id%KEEP(23).GT.7) id%KEEP(23) = 7 + IF ( id%KEEP(50) .EQ. 1 ) THEN + IF (id%KEEP(23) .NE. 0) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not compatible with LLT factorization' + END IF + id%KEEP(23) = 0 + ENDIF + IF (id%KEEP(95) .GT. 1) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) ignored: not compatible with LLT factorization' + END IF + ENDIF + id%KEEP(95) = 1 + END IF + IF (id%KEEP(60) .GT. 0) THEN + IF (id%KEEP(23) .NE. 0) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed because of Schur' + END IF + id%KEEP(23) = 0 + ENDIF + IF (id%KEEP(52).NE.0) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Scaling during analysis not allowed because of Schur' + ENDIF + id%KEEP(52) = 0 + ENDIF + IF (id%KEEP(95) .GT. 1) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) option not allowed because of Schur' + END IF + ENDIF + id%KEEP(95) = 1 + END IF + IF ( (id%KEEP(23) .NE. 0) .AND. (id%KEEP(256).EQ.1)) THEN + id%KEEP(23) = 0 + id%KEEP(95) = 1 + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed because ordering is given' + END IF + END IF + IF ( id%KEEP(256) .EQ. 1 ) THEN + IF (id%KEEP(95) > 1 .AND. MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) option incompatible with given ordering' + END IF + id%KEEP(95) = 1 + END IF + IF (id%KEEP(54) .NE. 0) THEN + IF( id%KEEP(23) .NE. 0 ) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed because matrix is distributed' + END IF + id%KEEP(23) = 0 + ENDIF + IF (id%KEEP(52).EQ.-2) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Scaling during analysis not allowed (matrix is distributed)' + ENDIF + ENDIF + id%KEEP(52) = 0 + IF (id%KEEP(95) .GT. 1 .AND. MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** ICNTL(12) option not allowed because matrix is + &distributed' + ENDIF + id%KEEP(95) = 1 + END IF + IF ( id%KEEP(55) .NE. 0 ) THEN + IF( id%KEEP(23) .NE. 0 ) THEN + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Max-trans not allowed for element matrix' + END IF + id%KEEP(23) = 0 + ENDIF + IF (MPG.GT.0 .AND. id%KEEP(52).EQ.-2) THEN + WRITE(MPG,'(A)') + & ' ** Scaling not allowed at analysis for element matrix' + ENDIF + id%KEEP(52) = 0 + id%KEEP(95) = 1 + ENDIF + IF(id%KEEP(244) .EQ. 2) THEN + IF(id%KEEP(23) .EQ. 7) THEN + id%KEEP(23) = 0 + ELSE IF (id%KEEP(23) .GT. 0) THEN + id%INFO(1) = -39 + id%KEEP(23) = 0 + WRITE(LP, + & '("Incompatible values for ICNTL(6), ICNTL(28)")') + WRITE(LP, + & '("Maximum transversal not allowed + & in parallel analysis")') + RETURN + END IF + END IF + IF ( id%KEEP(54) .NE. 0 .AND. id%KEEP(55) .NE. 0 ) THEN + id%KEEP(54) = 0 + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + & ' ** Distributed entry not available for element matrix' + END IF + ENDIF + IF (id%ICNTL(39).NE.1 .and. id%ICNTL(39).NE.2) THEN + id%KEEP(106)=1 + ELSE + id%KEEP(106)=id%ICNTL(39) + ENDIF + IF(id%KEEP(50) .EQ. 2) THEN + IF( .NOT. associated(id%A) ) THEN + IF(id%KEEP(95) .EQ. 3) THEN + id%KEEP(95) = 2 + ENDIF + ENDIF + IF(id%KEEP(95) .EQ. 3 .AND. id%KEEP(256) .NE. 2) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: ZMUMPS_203 constrained ordering not ', + & 'available with selected ordering' + id%KEEP(95) = 2 + ENDIF + IF(id%KEEP(95) .EQ. 3) THEN + id%KEEP(23) = 5 + id%KEEP(52) = -2 + ELSE IF(id%KEEP(95) .EQ. 2 .AND. + & (id%KEEP(23) .EQ. 0 .OR. id%KEEP(23) .EQ. 7) ) THEN + IF( associated(id%A) ) THEN + id%KEEP(23) = 5 + ELSE + id%KEEP(23) = 1 + ENDIF + ELSE IF(id%KEEP(95) .EQ. 1) THEN + id%KEEP(23) = 0 + ELSE IF(id%KEEP(95) .EQ. 0 .AND. id%KEEP(23) .EQ. 0) THEN + id%KEEP(95) = 1 + ENDIF + ELSE + id%KEEP(95) = 1 + ENDIF + id%KEEP(53)=0 + IF(id%KEEP(86).EQ.1)THEN + IF(id%KEEP(47).LT.2) id%KEEP(47)=2 + ENDIF + IF(id%KEEP(48).EQ.5)THEN + IF(id%KEEP(50).EQ.0)THEN + id%KEEP(87)=50 + id%KEEP(88)=50 + ELSE + id%KEEP(87)=70 + id%KEEP(88)=70 + ENDIF + ENDIF + IF((id%NSLAVES.EQ.1).AND.(id%KEEP(76).GT.3))THEN + id%KEEP(76)=2 + ENDIF + IF(id%KEEP(81).GT.0)THEN + IF(id%KEEP(47).LT.2) id%KEEP(47)=2 + ENDIF + END IF + RETURN + END SUBROUTINE ZMUMPS_647 + SUBROUTINE ZMUMPS_664(id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + TYPE(ZMUMPS_STRUC) :: id + INTEGER, ALLOCATABLE :: REQPTR(:,:) + INTEGER :: MASTER, IERR, INDX, NRECV + INTEGER :: STATUS( MPI_STATUS_SIZE ) + INTEGER :: LP, MP, MPG, I + LOGICAL :: PROK, PROKG + PARAMETER( MASTER = 0 ) + LP = id%ICNTL( 1 ) + MP = id%ICNTL( 2 ) + MPG = id%ICNTL( 3 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF ( id%KEEP(46) .EQ. 0 .AND. id%MYID .EQ. MASTER ) THEN + id%NZ_loc = 0 + END IF + IF ( id%MYID .eq. MASTER ) THEN + allocate( REQPTR( id%NPROCS, 3 ), STAT = IERR ) + IF ( IERR .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = 3 * id%NPROCS + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'REQPTR' + END IF + GOTO 13 + END IF + allocate( id%IRN( id%NZ ), STAT = IERR ) + IF ( IERR .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = id%NZ + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'IRN' + END IF + GOTO 13 + END IF + allocate( id%JCN( id%NZ ), STAT = IERR ) + IF ( IERR .GT. 0 ) THEN + id%INFO(1) = -7 + id%INFO(2) = id%NZ + IF ( LP .GT. 0 ) THEN + WRITE(LP, 150) 'JCN' + END IF + GOTO 13 + END IF + END IF + 13 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) < 0 ) RETURN + IF ( id%MYID .EQ. MASTER ) THEN + DO I = 1, id%NPROCS - 1 + CALL MPI_RECV( REQPTR( I+1, 1 ), 1, + & MPI_INTEGER, I, + & COLLECT_NZ, id%COMM, STATUS, IERR ) + END DO + IF ( id%KEEP(46) .eq. 0 ) THEN + REQPTR( 1, 1 ) = 1 + ELSE + REQPTR( 1, 1 ) = id%NZ_loc + 1 + END IF + DO I = 2, id%NPROCS + REQPTR( I, 1 ) = REQPTR( I, 1 ) + REQPTR( I-1, 1 ) + END DO + ELSE + CALL MPI_SEND( id%NZ_loc, 1, MPI_INTEGER, MASTER, + & COLLECT_NZ, id%COMM, IERR ) + END IF + IF ( id%MYID .eq. MASTER ) THEN + NRECV = 0 + DO I = 1, id%NPROCS - 1 + IF ( REQPTR( I + 1, 1 ) - REQPTR( I, 1 ) .NE. 0 ) THEN + NRECV = NRECV + 2 + CALL MPI_IRECV( id%IRN( REQPTR( I, 1 ) ), + & REQPTR( I + 1, 1 ) - REQPTR( I, 1 ), + & MPI_INTEGER, + & I, COLLECT_IRN, id%COMM, REQPTR(I, 2), IERR ) + CALL MPI_IRECV( id%JCN( REQPTR( I, 1 ) ), + & REQPTR( I + 1, 1 ) - REQPTR( I, 1 ), + & MPI_INTEGER, + & I, COLLECT_JCN, id%COMM, REQPTR(I, 3), IERR ) + ELSE + REQPTR(I, 2) = MPI_REQUEST_NULL + REQPTR(I, 3) = MPI_REQUEST_NULL + END IF + END DO + ELSE + IF ( id%NZ_loc .NE. 0 ) THEN + CALL MPI_SEND( id%IRN_loc(1), id%NZ_loc, + & MPI_INTEGER, MASTER, + & COLLECT_IRN, id%COMM, IERR ) + CALL MPI_SEND( id%JCN_loc(1), id%NZ_loc, + & MPI_INTEGER, MASTER, + & COLLECT_JCN, id%COMM, IERR ) + END IF + END IF + IF ( id%MYID .eq. MASTER ) THEN + IF ( id%NZ_loc .NE. 0 ) THEN + DO I=1,id%NZ_loc + id%IRN(I) = id%IRN_loc(I) + id%JCN(I) = id%JCN_loc(I) + ENDDO + END IF + REQPTR( id%NPROCS, 2 ) = MPI_REQUEST_NULL + REQPTR( id%NPROCS, 3 ) = MPI_REQUEST_NULL + DO I = 1, NRECV + CALL MPI_WAITANY + & ( 2 * id%NPROCS, REQPTR( 1, 2 ), INDX, STATUS, IERR ) + END DO + deallocate( REQPTR ) + END IF + RETURN + 150 FORMAT( + &/' ** FAILURE DURING ZMUMPS_664, DYNAMIC ALLOCATION OF', + & A30) + END SUBROUTINE ZMUMPS_664 + SUBROUTINE ZMUMPS_658(id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + INCLUDE 'mpif.h' + TYPE(ZMUMPS_STRUC) :: id + INTEGER :: MASTER, IERR + INTEGER :: IUNIT + LOGICAL :: IS_ELEMENTAL + LOGICAL :: IS_DISTRIBUTED + INTEGER :: MM_WRITE + INTEGER :: MM_WRITE_CHECK + CHARACTER(LEN=20) :: MM_IDSTR + LOGICAL :: I_AM_SLAVE, I_AM_MASTER + PARAMETER( MASTER = 0 ) + IUNIT = 69 + I_AM_SLAVE = ( id%MYID .NE. MASTER .OR. + & ( id%MYID .EQ. MASTER .AND. + & id%KEEP(46) .EQ. 1 ) ) + I_AM_MASTER = (id%MYID.EQ.MASTER) + IS_DISTRIBUTED = (id%KEEP(54) .EQ. 3) + IS_ELEMENTAL = (id%KEEP(55) .NE. 0) + IF (id%MYID.EQ.MASTER .AND. .NOT. IS_DISTRIBUTED) THEN + IF (id%WRITE_PROBLEM(1:20) .NE. "NAME_NOT_INITIALIZED")THEN + OPEN(IUNIT,FILE=trim(id%WRITE_PROBLEM)) + CALL ZMUMPS_166( id, IUNIT, I_AM_SLAVE, I_AM_MASTER, + & IS_DISTRIBUTED, + & IS_ELEMENTAL ) + CLOSE(IUNIT) + ENDIF + ELSE IF (id%KEEP(54).EQ.3) THEN + IF (id%WRITE_PROBLEM(1:20) .EQ. "NAME_NOT_INITIALIZED" + & .OR. .NOT. I_AM_SLAVE )THEN + MM_WRITE = 0 + ELSE + MM_WRITE = 1 + ENDIF + CALL MPI_ALLREDUCE(MM_WRITE, MM_WRITE_CHECK, 1, + & MPI_INTEGER, MPI_SUM, id%COMM, IERR) + IF (MM_WRITE_CHECK.EQ.id%NSLAVES .AND. I_AM_SLAVE) THEN + WRITE(MM_IDSTR,'(I7)') id%MYID_NODES + OPEN(IUNIT, + & FILE=trim(id%WRITE_PROBLEM)//trim(adjustl(MM_IDSTR))) + CALL ZMUMPS_166(id, IUNIT, I_AM_SLAVE, I_AM_MASTER, + & IS_DISTRIBUTED, + & IS_ELEMENTAL ) + CLOSE(IUNIT) + ENDIF + ENDIF + IF ( id%MYID.EQ.MASTER .AND. + & associated(id%RHS) .AND. + & id%WRITE_PROBLEM(1:20) + & .NE. "NAME_NOT_INITIALIZED")THEN + OPEN(IUNIT,FILE=trim(id%WRITE_PROBLEM) //".rhs") + CALL ZMUMPS_179(IUNIT, id) + CLOSE(IUNIT) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_658 + SUBROUTINE ZMUMPS_166 + & (id, IUNIT, I_AM_SLAVE, I_AM_MASTER, + & IS_DISTRIBUTED, IS_ELEMENTAL ) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + LOGICAL, intent(in) :: I_AM_SLAVE, + & I_AM_MASTER, + & IS_DISTRIBUTED, + & IS_ELEMENTAL + INTEGER, intent(in) :: IUNIT + TYPE(ZMUMPS_STRUC), intent(in) :: id + CHARACTER (LEN=10) :: SYMM + CHARACTER (LEN=8) :: ARITH + INTEGER :: I + IF (IS_ELEMENTAL) THEN + RETURN + ENDIF + IF (I_AM_MASTER .AND. .NOT. IS_DISTRIBUTED) THEN + IF (associated(id%A)) THEN + ARITH='complex' + ELSE + ARITH='pattern ' + ENDIF + IF (id%KEEP(50) .eq. 0) THEN + SYMM="general" + ELSE + SYMM="symmetric" + END IF + WRITE(IUNIT,FMT=*)'%%MatrixMarket matrix coordinate ', + & trim(ARITH)," ",trim(SYMM) + WRITE(IUNIT,*) id%N, id%N, id%NZ + IF (associated(id%A)) THEN + DO I=1,id%NZ + IF (id%KEEP(50).NE.0 .AND. id%IRN(I).LT.id%JCN(I)) THEN + WRITE(IUNIT,*) id%JCN(I), id%IRN(I), + & dble(id%A(I)), aimag(id%A(I)) + ELSE + WRITE(IUNIT,*) id%IRN(I), id%JCN(I), + & dble(id%A(I)), aimag(id%A(I)) + ENDIF + ENDDO + ELSE + DO I=1,id%NZ + IF (id%KEEP(50).NE.0 .AND. id%IRN(I).LT.id%JCN(I)) THEN + WRITE(IUNIT,*) id%JCN(I), id%IRN(I) + ELSE + WRITE(IUNIT,*) id%IRN(I), id%JCN(I) + ENDIF + ENDDO + ENDIF + ELSE IF ( IS_DISTRIBUTED .AND. I_AM_SLAVE ) THEN + IF (associated(id%A_loc)) THEN + ARITH='complex' + ELSE + ARITH='pattern ' + ENDIF + IF (id%KEEP(50) .eq. 0) THEN + SYMM="general" + ELSE + SYMM="symmetric" + END IF + WRITE(IUNIT,FMT=*)'%%MatrixMarket matrix coordinate ', + & trim(ARITH)," ",trim(SYMM) + WRITE(IUNIT,*) id%N, id%N, id%NZ_loc + IF (associated(id%A_loc)) THEN + DO I=1,id%NZ_loc + IF (id%KEEP(50).NE.0 .AND. + & id%IRN_loc(I).LT.id%JCN_loc(I)) THEN + WRITE(IUNIT,*) id%JCN_loc(I), id%IRN_loc(I), + & dble(id%A_loc(I)), aimag(id%A_loc(I)) + ELSE + WRITE(IUNIT,*) id%IRN_loc(I), id%JCN_loc(I), + & dble(id%A_loc(I)), aimag(id%A_loc(I)) + ENDIF + ENDDO + ELSE + DO I=1,id%NZ_loc + IF (id%KEEP(50).NE.0 .AND. + & id%IRN_loc(I).LT.id%JCN_loc(I)) THEN + WRITE(IUNIT,*) id%JCN_loc(I), id%IRN_loc(I) + ELSE + WRITE(IUNIT,*) id%IRN_loc(I), id%JCN_loc(I) + ENDIF + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_166 + SUBROUTINE ZMUMPS_179(IUNIT, id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(ZMUMPS_STRUC), intent(in) :: id + INTEGER, intent(in) :: IUNIT + CHARACTER (LEN=8) :: ARITH + INTEGER :: I, J, K, LD_RHS + IF (associated(id%RHS)) THEN + ARITH='complex' + WRITE(IUNIT,FMT=*)'%%MatrixMarket matrix array ', + & trim(ARITH), + & ' general' + WRITE(IUNIT,*) id%N, id%NRHS + IF ( id%NRHS .EQ. 1 ) THEN + LD_RHS = id%N + ELSE + LD_RHS = id%LRHS + ENDIF + DO J = 1, id%NRHS + DO I = 1, id%N + K=(J-1)*LD_RHS+I + WRITE(IUNIT,*) dble(id%RHS(K)), aimag(id%RHS(K)) + ENDDO + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_179 + SUBROUTINE ZMUMPS_649( NSLAVES, NB_NIV2, MYID_NODES, + & CANDIDATES, I_AM_CAND ) + IMPLICIT NONE + INTEGER, intent(in) :: NSLAVES, NB_NIV2, MYID_NODES + INTEGER, intent(in) :: CANDIDATES( NSLAVES+1, NB_NIV2 ) + LOGICAL, intent(out):: I_AM_CAND( NB_NIV2 ) + INTEGER I, INIV2, NCAND + DO INIV2=1, NB_NIV2 + I_AM_CAND(INIV2)=.FALSE. + NCAND = CANDIDATES(NSLAVES+1,INIV2) + DO I=1, NCAND + IF (CANDIDATES(I,INIV2).EQ.MYID_NODES) THEN + I_AM_CAND(INIV2)=.TRUE. + EXIT + ENDIF + ENDDO + END DO + RETURN + END SUBROUTINE ZMUMPS_649 + SUBROUTINE ZMUMPS_251(N,IW,LIW,A,LA, + & NSTK_STEPS, NBPROCFILS,IFLAG,ND,FILS,STEP, + & FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRT, NTOTPV, NMAXNPIV, PTRIST, PTRAST, + & PIMASTER, PAMASTER, PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, IERROR,IPOOL, LPOOL, + & RINFO, POSFAC ,IWPOS, LRLU, IPTRLU, + & LRLUS, LEAF, NBROOT, NBRTOT, + & UU, ICNTL, PTLUST_S, PTRFAC, NSTEPS, INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS,SLAVEF,MYID, COMM_NODES, + & MYID_NODES, + & BUFR,LBUFR,LBUFR_BYTES,INTARR,DBLARR,root, + & PERM, NELT, FRTPTR, FRTELT, LPTRAR, + & COMM_LOAD, ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, + & MEM_DISTRIB, NE, + & DKEEP,PIVNUL_LIST,LPN_LIST) + USE ZMUMPS_LOAD + USE ZMUMPS_OOC + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER N,IFLAG,NTOTPV,MAXFRT,LIW, LPTRAR, NMAXNPIV, + & IERROR, NSTEPS, INFO(40) + INTEGER(8) :: LA + COMPLEX(kind=8), TARGET :: A(LA) + INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES + INTEGER, DIMENSION(0: SLAVEF - 1) :: MEM_DISTRIB + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + INTEGER LPOOL + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER ITLOC(N+KEEP(253)) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER IW(LIW), NSTK_STEPS(KEEP(28)), NBPROCFILS(KEEP(28)) + INTEGER PTRARW(LPTRAR), PTRAIW(LPTRAR), ND(KEEP(28)) + INTEGER FILS(N),PTRIST(KEEP(28)) + INTEGER STEP(N), FRERE(KEEP(28)), DAD(KEEP(28)) + INTEGER PIMASTER(KEEP(28)) + INTEGER PTLUST_S(KEEP(28)), PERM(N) + INTEGER CAND(SLAVEF+1,max(1,KEEP(56))) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER IPOOL(LPOOL) + INTEGER NE(KEEP(28)) + DOUBLE PRECISION RINFO(40) + INTEGER(8) :: PAMASTER(KEEP(28)), PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: POSFAC, LRLU, LRLUS, IPTRLU + INTEGER IWPOS, LEAF, NBROOT + INTEGER COMM_LOAD, ASS_IRECV + DOUBLE PRECISION UU, SEUIL, SEUIL_LDLT_NIV2 + INTEGER NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX(kind=8) DBLARR( max(1,KEEP(13)) ) + LOGICAL IS_ISOLATED_NODE + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + DOUBLE PRECISION, PARAMETER :: DZERO = 0.0D0, DONE = 1.0D0 + INTEGER INODE + INTEGER IWPOSCB + INTEGER FPERE, TYPEF + INTEGER MP, LP, DUMMY(1) + INTEGER NBFIN, NBRTOT, NBROOT_TRAITEES + INTEGER NFRONT, IOLDPS + INTEGER(8) NFRONT8 + INTEGER(8) :: POSELT + INTEGER IPOSROOT, IPOSROOTROWINDICES + INTEGER GLOBK109 + INTEGER(8) :: LBUFRX + COMPLEX(kind=8), POINTER, DIMENSION(:) :: BUFRX + LOGICAL :: IS_BUFRX_ALLOCATED + DOUBLE PRECISION FLOP1 + INTEGER TYPE + LOGICAL SON_LEVEL2, SET_IRECV, BLOCKING, + & MESSAGE_RECEIVED + LOGICAL AVOID_DELAYED + LOGICAL LAST_CALL + INTEGER MASTER_ROOT + INTEGER LOCAL_M, LOCAL_N + INTEGER LRHS_CNTR_MASTER_ROOT, FWD_LOCAL_N_RHS + LOGICAL ROOT_OWNER + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER MUMPS_330, MUMPS_275 + LOGICAL MUMPS_167,MUMPS_283 + EXTERNAL MUMPS_167,MUMPS_283 + LOGICAL ZMUMPS_508 + EXTERNAL ZMUMPS_508, ZMUMPS_509 + LOGICAL STACK_RIGHT_AUTHORIZED + INTEGER numroc + EXTERNAL numroc + INTEGER MAXFRW, NPVW, NOFFW, NELVAW, COMP, + & JOBASS, ETATASS + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten, + & IDUMMY + INTEGER(8) :: ITMP8 + TYPE(IO_BLOCK) :: MonBloc + INCLUDE 'mumps_headers.h' + DOUBLE PRECISION OPASSW, OPELIW + ASS_IRECV = MPI_REQUEST_NULL + ITLOC(1:N+KEEP(253)) =0 + PTRIST (1:KEEP(28))=0 + PTLUST_S(1:KEEP(28))=0 + PTRAST(1:KEEP(28))=0_8 + PTRFAC(1:KEEP(28))=-99999_8 + MP = ICNTL(2) + LP = ICNTL(1) + MAXFRW = 0 + NPVW = 0 + NOFFW = 0 + NELVAW = 0 + COMP = 0 + OPASSW = DZERO + OPELIW = DZERO + IWPOSCB = LIW + STACK_RIGHT_AUTHORIZED = .TRUE. + CALL ZMUMPS_22( .FALSE., 0_8, + & .FALSE., .FALSE., MYID_NODES, N, KEEP, KEEP8, + & IW, LIW, A, LA, LRLU, IPTRLU, IWPOS, IWPOSCB, + & PTRIST, PTRAST, STEP, PIMASTER, + & PAMASTER, KEEP(IXSZ), 0_8, -444, -444, .true., + & COMP, LRLUS, + & IFLAG, IERROR + & ) + JOBASS = 0 + ETATASS = 0 + NBFIN = NBRTOT + NBROOT_TRAITEES = 0 + NBPROCFILS(1:KEEP(28)) = 0 + IF ( KEEP(38).NE.0 ) THEN + IF (root%yes) THEN + CALL ZMUMPS_284( + & root, KEEP(38), N, IW, LIW, + & A, LA, + & FILS, MYID_NODES, PTRAIW, PTRARW, + & INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + ENDIF + IF ( IFLAG .LT. 0 ) GOTO 635 + END IF + 20 CONTINUE + NIV1_FLAG=0 + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( + & COMM_LOAD, ASS_IRECV, BLOCKING, SET_IRECV, + & MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, + & PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_STEPS, + & COMP, IFLAG, + & IERROR, COMM_NODES, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, MYID_NODES, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & STACK_RIGHT_AUTHORIZED ) + CALL ZMUMPS_467(COMM_LOAD, KEEP) + IF (MESSAGE_RECEIVED) THEN + IF ( IFLAG .LT. 0 ) GO TO 640 + IF ( NBFIN .eq. 0 ) GOTO 640 + ELSE + IF ( .NOT. ZMUMPS_508( IPOOL, LPOOL) )THEN + CALL ZMUMPS_509( N, IPOOL, LPOOL, + & PROCNODE_STEPS, + & SLAVEF, STEP, INODE, KEEP,KEEP8, MYID_NODES, ND, + & (.NOT. STACK_RIGHT_AUTHORIZED) ) + STACK_RIGHT_AUTHORIZED = .TRUE. + IF (KEEP(47) .GE. 3) THEN + CALL ZMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID_NODES, STEP, N, ND, FILS ) + ENDIF + IF (KEEP(47).EQ.4) THEN + IF(INODE.GT.0.AND.INODE.LE.N)THEN + IF((NE(STEP(INODE)).EQ.0).AND. + & (FRERE(STEP(INODE)).EQ.0))THEN + IS_ISOLATED_NODE=.TRUE. + ELSE + IS_ISOLATED_NODE=.FALSE. + ENDIF + ENDIF + CALL ZMUMPS_501( + & IS_ISOLATED_NODE,INODE,IPOOL,LPOOL, + & MYID_NODES,SLAVEF,COMM_LOAD,KEEP,KEEP8) + ENDIF + IF ((( KEEP(80) == 2 .OR. KEEP(80)==3 ) .AND. + & ( KEEP(47) == 4 )).OR. + & (KEEP(80) == 1 .AND. KEEP(47) .GE. 1)) THEN + CALL ZMUMPS_512(INODE,STEP,KEEP(28), + & PROCNODE_STEPS,FRERE,ND,COMM_LOAD,SLAVEF, + & MYID_NODES,KEEP,KEEP8,N) + END IF + GOTO 30 + ENDIF + ENDIF + GO TO 20 + 30 CONTINUE + IF ( INODE .LT. 0 ) THEN + INODE = -INODE + FPERE = DAD(STEP(INODE)) + GOTO 130 + ELSE IF (INODE.GT.N) THEN + INODE = INODE - N + IF (INODE.EQ.KEEP(38)) THEN + NBROOT_TRAITEES = NBROOT_TRAITEES + 1 + IF ( NBROOT_TRAITEES .EQ. NBROOT ) THEN + NBFIN = NBFIN - NBROOT + IF (SLAVEF.GT.1) THEN + DUMMY(1) = NBROOT + CALL ZMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID_NODES, + & COMM_NODES, RACINE, SLAVEF) + END IF + ENDIF + IF (NBFIN.EQ.0) GOTO 640 + GOTO 20 + ENDIF + TYPE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (TYPE.EQ.1) GOTO 100 + FPERE = DAD(STEP(INODE)) + AVOID_DELAYED = ( (FPERE .eq. KEEP(20) .OR. FPERE .eq. KEEP(38)) + & .AND. KEEP(60).ne.0 ) + IF ( KEEP(50) .eq. 0 ) THEN + CALL ZMUMPS_144( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM_NODES, MYID_NODES, BUFR, LBUFR,LBUFR_BYTES, + & NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_STEPS,NBPROCFILS,PROCNODE_STEPS, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST) + IF ( IFLAG .LT. 0 ) GOTO 640 + ELSE + CALL ZMUMPS_141( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM_NODES, MYID_NODES, BUFR, LBUFR,LBUFR_BYTES, + & NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, + & STEP, PIMASTER, PAMASTER, + & NSTK_STEPS,NBPROCFILS,PROCNODE_STEPS, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL_LDLT_NIV2, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST) + IF ( IFLAG .LT. 0 ) GOTO 640 + IF ( IW( PTLUST_S(STEP(INODE)) + KEEP(IXSZ) + 5 ) .GT. 1 ) THEN + GOTO 20 + END IF + END IF + GOTO 130 + ENDIF + IF (INODE.EQ.KEEP(38)) THEN + CALL ZMUMPS_176( COMM_LOAD, ASS_IRECV, + & root, FRERE, + & INODE, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_STEPS, COMP, + & IFLAG, IERROR, COMM_NODES, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID_NODES, SLAVEF, + & + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 640 + GOTO 20 + ENDIF + TYPE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF (TYPE.EQ.1) THEN + IF (KEEP(55).NE.0) THEN + CALL ZMUMPS_36( COMM_LOAD, ASS_IRECV, + & NELT, FRTPTR, FRTELT, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP, PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ELSE + JOBASS = 0 + CALL ZMUMPS_252(COMM_LOAD, ASS_IRECV, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP, PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & JOBASS,ETATASS ) + ENDIF + IF ( IFLAG .LT. 0 ) GOTO 640 + IF ((NBPROCFILS(STEP(INODE)).GT.0).OR.(SON_LEVEL2)) GOTO 20 + ELSE + IF ( KEEP(55) .eq. 0 ) THEN + CALL ZMUMPS_253(COMM_LOAD, ASS_IRECV, + & N, INODE, IW, LIW, A, LA, + & IFLAG, IERROR, + & ND, FILS, FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, + & root, OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_STEPS, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM_NODES, + & MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & NBFIN, LEAF, IPOOL, LPOOL, PERM, + & MEM_DISTRIB(0) + & ) + ELSE + CALL ZMUMPS_37( COMM_LOAD, ASS_IRECV, + & NELT, FRTPTR, FRTELT, + & N, INODE, IW, LIW, A, LA, IFLAG, IERROR, + & ND, FILS, FRERE, DAD, CAND, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & MAXFRW, + & root, OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_STEPS, + & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, + & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8,INTARR,DBLARR, + & NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM_NODES, + & MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & NBFIN, LEAF, IPOOL, LPOOL, PERM, + & MEM_DISTRIB(0)) + END IF + IF (IFLAG.LT.0) GOTO 640 + GOTO 20 + ENDIF + 100 CONTINUE + FPERE = DAD(STEP(INODE)) + IF ( INODE .eq. KEEP(20) ) THEN + POSELT = PTRAST(STEP(INODE)) + IF (PTRFAC(STEP(INODE)).NE.POSELT) THEN + WRITE(*,*) "ERROR 2 in ZMUMPS_251", POSELT + CALL MUMPS_ABORT() + ENDIF + CALL ZMUMPS_87 + & ( IW(PTLUST_S(STEP(INODE))+KEEP(IXSZ)), KEEP(253) ) + GOTO 200 + END IF + POSELT = PTRAST(STEP(INODE)) + IOLDPS = PTLUST_S(STEP(INODE)) + AVOID_DELAYED = ( (FPERE .eq. KEEP(20) .OR. FPERE .eq. KEEP(38)) + & .AND. KEEP(60).ne.0 ) + IF (KEEP(50).EQ.0) THEN + CALL ZMUMPS_143( N, INODE, IW, LIW, A, LA, + & IOLDPS, POSELT, + & IFLAG, UU, NOFFW, NPVW, + & KEEP,KEEP8, + & STEP, PROCNODE_STEPS, MYID_NODES, SLAVEF, + & SEUIL, AVOID_DELAYED, ETATASS, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, IWPOS) + JOBASS = ETATASS + IF (JOBASS.EQ.1) THEN + CALL ZMUMPS_252(COMM_LOAD, ASS_IRECV, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP,PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & JOBASS,ETATASS ) + ENDIF + ELSE + IW( IOLDPS+4+KEEP(IXSZ) ) = 1 + CALL ZMUMPS_140( N, INODE, + & IW, LIW, A, LA, + & IOLDPS, POSELT, + & IFLAG, UU, NOFFW, NPVW, + & KEEP,KEEP8, MYID_NODES, SEUIL, AVOID_DELAYED, + & ETATASS, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, IWPOS) + IW( IOLDPS+4+KEEP(IXSZ) ) = STEP(INODE) + JOBASS = ETATASS + IF (JOBASS.EQ.1) THEN + CALL ZMUMPS_252(COMM_LOAD, ASS_IRECV, + & N,INODE,IW,LIW,A,LA, + & IFLAG,IERROR,ND, + & FILS,FRERE,DAD,MAXFRW,root,OPASSW, OPELIW, + & PTRIST,PTLUST_S,PTRFAC,PTRAST,STEP,PIMASTER,PAMASTER, + & PTRARW,PTRAIW, + & ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2, + & COMP, LRLU, IPTRLU, + & IWPOS,IWPOSCB, POSFAC, LRLUS, + & ICNTL, KEEP,KEEP8, INTARR, DBLARR, + & NSTK_STEPS,NBPROCFILS, PROCNODE_STEPS, SLAVEF, + & COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF, + & PERM, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & JOBASS,ETATASS ) + ENDIF + ENDIF + IF (IFLAG.LT.0) GOTO 635 + 130 CONTINUE + TYPE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + IF ( FPERE .NE. 0 ) THEN + TYPEF = MUMPS_330(PROCNODE_STEPS(STEP(FPERE)),SLAVEF) + ELSE + TYPEF = -9999 + END IF + CALL ZMUMPS_254( COMM_LOAD, ASS_IRECV, + & N,INODE,TYPE,TYPEF,LA,IW,LIW,A, + & IFLAG,IERROR,OPELIW,NELVAW,NMAXNPIV, + & PTRIST,PTLUST_S,PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NE, POSFAC,LRLU, + & LRLUS,IPTRLU,ICNTL,KEEP,KEEP8,COMP,IWPOS,IWPOSCB, + & PROCNODE_STEPS,SLAVEF,FPERE,COMM_NODES,MYID_NODES, + & IPOOL, LPOOL, LEAF, + & NSTK_STEPS, NBPROCFILS, BUFR, LBUFR, LBUFR_BYTES, NBFIN, + & root, OPASSW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG.LT.0) GOTO 640 + 200 CONTINUE + IF ( INODE .eq. KEEP(38) ) THEN + WRITE(*,*) 'Error .. in ZMUMPS_251: ', + & ' INODE == KEEP(38)' + Stop + END IF + IF ( FPERE.EQ.0 ) THEN + NBROOT_TRAITEES = NBROOT_TRAITEES + 1 + IF ( NBROOT_TRAITEES .EQ. NBROOT ) THEN + IF (KEEP(201).EQ.1) THEN + CALL ZMUMPS_681(IERR) + ELSE IF ( KEEP(201).EQ.2) THEN + CALL ZMUMPS_580(IERR) + ENDIF + NBFIN = NBFIN - NBROOT + IF ( NBFIN .LT. 0 ) THEN + WRITE(*,*) ' ERROR 1 in ZMUMPS_251: ', + & ' NBFIN=', NBFIN + CALL MUMPS_ABORT() + END IF + IF ( NBROOT .LT. 0 ) THEN + WRITE(*,*) ' ERROR 1 in ZMUMPS_251: ', + & ' NBROOT=', NBROOT + CALL MUMPS_ABORT() + END IF + IF (SLAVEF.GT.1) THEN + DUMMY(1) = NBROOT + CALL ZMUMPS_242( DUMMY(1), 1, MPI_INTEGER, + & MYID_NODES, COMM_NODES, RACINE, SLAVEF) + END IF + ENDIF + IF (NBFIN.EQ.0)THEN + GOTO 640 + ENDIF + ELSEIF ( FPERE.NE.KEEP(38) .AND. + & MUMPS_275(PROCNODE_STEPS(STEP(FPERE)),SLAVEF).EQ. + & MYID_NODES ) THEN + NSTK_STEPS(STEP(FPERE)) = NSTK_STEPS(STEP(FPERE))-1 + IF ( NSTK_STEPS( STEP( FPERE )).EQ.0) THEN + IF (KEEP(234).NE.0 .AND. + & MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF)) + & THEN + STACK_RIGHT_AUTHORIZED = .FALSE. + ENDIF + CALL ZMUMPS_507(N, IPOOL, LPOOL, + & PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76), + & KEEP(80), KEEP(47), STEP, FPERE ) + IF (KEEP(47) .GE. 3) THEN + CALL ZMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID_NODES, STEP, N, ND, FILS ) + ENDIF + CALL MUMPS_137( FPERE, N, PROCNODE_STEPS,SLAVEF, + & ND, FILS, FRERE, STEP, PIMASTER, KEEP(28), + & KEEP(50), KEEP(253), FLOP1, + & IW, LIW, KEEP(IXSZ) ) + IF (FPERE.NE.KEEP(20)) + & CALL ZMUMPS_190(1,.FALSE.,FLOP1,KEEP,KEEP8) + ENDIF + ENDIF + GO TO 20 + 635 CONTINUE + CALL ZMUMPS_44( MYID_NODES, SLAVEF, COMM_NODES ) + 640 CONTINUE + CALL ZMUMPS_255( INFO(1), + & ASS_IRECV, BUFR, LBUFR, + & LBUFR_BYTES, + & COMM_NODES, + & MYID_NODES, SLAVEF) + CALL ZMUMPS_180( INFO(1), + & BUFR, LBUFR, + & LBUFR_BYTES, + & COMM_NODES, COMM_LOAD, SLAVEF, MP) + CALL MPI_BARRIER( COMM_NODES, IERR ) + IF ( INFO(1) .GE. 0 ) THEN + IF( KEEP(38) .NE. 0 .OR. KEEP(20).NE.0) THEN + MASTER_ROOT = MUMPS_275( + & PROCNODE_STEPS(STEP(max(KEEP(38),KEEP(20)))), + & SLAVEF) + ROOT_OWNER = (MASTER_ROOT .EQ. MYID_NODES) + IF ( KEEP(38) .NE. 0 )THEN + IF (KEEP(60).EQ.0) THEN + IOLDPS = PTLUST_S(STEP(KEEP(38))) + LOCAL_M = IW(IOLDPS+2+KEEP(IXSZ)) + LOCAL_N = IW(IOLDPS+1+KEEP(IXSZ)) + ELSE + IOLDPS = -999 + LOCAL_M = root%SCHUR_MLOC + LOCAL_N = root%SCHUR_NLOC + ENDIF + ITMP8 = int(LOCAL_M,8)*int(LOCAL_N,8) + LBUFRX = min(int(root%MBLOCK,8)*int(root%NBLOCK,8), + & int(root%TOT_ROOT_SIZE,8)*int(root%TOT_ROOT_SIZE,8) ) + IF ( LRLU .GT. LBUFRX ) THEN + BUFRX => A(POSFAC:POSFAC+LRLU-1_8) + LBUFRX=LRLU + IS_BUFRX_ALLOCATED = .FALSE. + ELSE + ALLOCATE( BUFRX( LBUFRX ), stat = IERR ) + IF (IERR.gt.0) THEN + INFO(1) = -9 + CALL MUMPS_731(LBUFRX, INFO(2) ) + IF (LP > 0 ) + & write(LP,*) ' Error allocating, real array ', + & 'of size before ZMUMPS_146', LBUFRX + CALL MUMPS_ABORT() + ENDIF + IS_BUFRX_ALLOCATED = .FALSE. + ENDIF + CALL ZMUMPS_146( MYID_NODES, + & root, N, KEEP(38), + & COMM_NODES, IW, LIW, IWPOS + 1, + & A, LA, PTRAST, PTLUST_S, PTRFAC, STEP, + & INFO(1), KEEP(50), KEEP(19), + & BUFRX(1), LBUFRX, KEEP,KEEP8, DKEEP ) + IF (IS_BUFRX_ALLOCATED) DEALLOCATE ( BUFRX ) + NULLIFY(BUFRX) + IF ( MYID_NODES .eq. + & MUMPS_275(PROCNODE_STEPS(STEP(KEEP(38))), + & SLAVEF) + & ) THEN + IF ( INFO(1) .EQ. -10 .OR. INFO(1) .EQ. -40 ) THEN + NPVW = NPVW + INFO(2) + ELSE + NPVW = NPVW + root%TOT_ROOT_SIZE + NMAXNPIV = max(NMAXNPIV,root%TOT_ROOT_SIZE) + END IF + END IF + IF (root%yes.AND.KEEP(60).EQ.0) THEN + IF (KEEP(252).EQ.0) THEN + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_L + NextPiv2beWritten = 1 + MonBloc%INODE = KEEP(38) + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 3 + MonBloc%NROW = LOCAL_M + MonBloc%NCOL = LOCAL_N + MonBloc%NFS = MonBloc%NCOL + MonBloc%Last = .TRUE. + MonBloc%LastPiv = MonBloc%NCOL + NULLIFY(MonBloc%INDICES) + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + LAST_CALL = .TRUE. + CALL ZMUMPS_688 + & ( STRAT, TYPEFile, + & A(PTRFAC(STEP(KEEP(38)))), + & LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IERR,LAST_CALL) + ELSE IF (KEEP(201).EQ.2) THEN + KEEP8(31)=KEEP8(31)+ ITMP8 + CALL ZMUMPS_576(KEEP(38),PTRFAC, + & KEEP,KEEP8,A,LA, ITMP8, IERR) + IF(IERR.LT.0)THEN + WRITE(*,*)MYID, + & ': Internal error in ZMUMPS_576' + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + IF (KEEP(201).NE.0 .OR. KEEP(252).NE.0) THEN + LRLUS = LRLUS + ITMP8 + IF (KEEP(252).NE.0) THEN + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS + & ,0_8,-ITMP8, + & KEEP,KEEP8,LRLU) + ELSE + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS + & ,ITMP8, + & 0_8, + & KEEP,KEEP8,LRLU) + ENDIF + IF (PTRFAC(STEP(KEEP(38))).EQ.POSFAC-ITMP8) THEN + POSFAC = POSFAC - ITMP8 + LRLU = LRLU + ITMP8 + ENDIF + ELSE + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS + & ,ITMP8, + & 0_8, + & KEEP,KEEP8,LRLU) + ENDIF + ENDIF + IF (root%yes. AND. KEEP(252) .NE. 0 .AND. + & (KEEP(60).EQ.0 .OR. KEEP(221).EQ.1)) THEN + IF (MYID_NODES .EQ. MASTER_ROOT) THEN + LRHS_CNTR_MASTER_ROOT = root%TOT_ROOT_SIZE*KEEP(253) + ELSE + LRHS_CNTR_MASTER_ROOT = 1 + ENDIF + ALLOCATE(root%RHS_CNTR_MASTER_ROOT( + & LRHS_CNTR_MASTER_ROOT), stat=IERR ) + IF (IERR.gt.0) THEN + INFO(1) = -13 + CALL MUMPS_731(LRHS_CNTR_MASTER_ROOT,INFO(2)) + IF (LP > 0 ) + & write(LP,*) ' Error allocating, real array ', + & 'of size before ZMUMPS_146', + & LRHS_CNTR_MASTER_ROOT + CALL MUMPS_ABORT() + ENDIF + FWD_LOCAL_N_RHS = numroc(KEEP(253), root%NBLOCK, + & root%MYCOL, 0, root%NPCOL) + FWD_LOCAL_N_RHS = max(1,FWD_LOCAL_N_RHS) + CALL ZMUMPS_156( MYID_NODES, + & root%TOT_ROOT_SIZE, KEEP(253), + & root%RHS_CNTR_MASTER_ROOT(1), LOCAL_M, + & FWD_LOCAL_N_RHS, root%MBLOCK, root%NBLOCK, + & root%RHS_ROOT(1,1), MASTER_ROOT, + & root%NPROW, root%NPCOL, COMM_NODES ) + & + ENDIF + ELSE + IF (KEEP(19).NE.0) THEN + CALL MPI_REDUCE(KEEP(109), GLOBK109, 1, + & MPI_INTEGER, MPI_SUM, + & MASTER_ROOT, + & COMM_NODES, IERR) + ENDIF + IF (ROOT_OWNER) THEN + IPOSROOT = PTLUST_S(STEP(KEEP(20))) + NFRONT = IW(IPOSROOT+KEEP(IXSZ)+3) + NFRONT8 = int(NFRONT,8) + IPOSROOTROWINDICES=IPOSROOT+6+KEEP(IXSZ)+ + & IW(IPOSROOT+5+KEEP(IXSZ)) + NPVW = NPVW + NFRONT + NMAXNPIV = max(NMAXNPIV,NFRONT) + END IF + IF (ROOT_OWNER.AND.KEEP(60).NE.0) THEN + IF ( PTRFAC(STEP(KEEP(20))) .EQ. POSFAC - + & NFRONT8*NFRONT8 ) THEN + POSFAC = POSFAC - NFRONT8*NFRONT8 + LRLUS = LRLUS + NFRONT8*NFRONT8 + LRLU = LRLUS + NFRONT8*NFRONT8 + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-NFRONT8*NFRONT8,KEEP,KEEP8,LRLU) + ENDIF + ENDIF + END IF + END IF + END IF + IF ( KEEP(38) .NE. 0 ) THEN + IF (MYID_NODES.EQ. + & MUMPS_275(PROCNODE_STEPS(STEP(KEEP(38))),SLAVEF) + & ) THEN + MAXFRW = max ( MAXFRW, root%TOT_ROOT_SIZE) + END IF + END IF + MAXFRT = MAXFRW + NTOTPV = NPVW + INFO(12) = NOFFW + RINFO(2) = dble(OPASSW) + RINFO(3) = dble(OPELIW) + INFO(13) = NELVAW + INFO(14) = COMP + RETURN + END SUBROUTINE ZMUMPS_251 + SUBROUTINE ZMUMPS_87( HEADER, KEEP253 ) + INTEGER HEADER( 6 ), KEEP253 + INTEGER NFRONT, NASS + NFRONT = HEADER(1) + IF ( HEADER(2) .ne. 0 ) THEN + WRITE(*,*) ' *** CHG_HEADER ERROR 1 :',HEADER(2) + CALL MUMPS_ABORT() + END IF + NASS = abs( HEADER( 3 ) ) + IF ( NASS .NE. abs( HEADER( 4 ) ) ) THEN + WRITE(*,*) ' *** CHG_HEADER ERROR 2 :',HEADER(3:4) + CALL MUMPS_ABORT() + END IF + IF ( NASS+KEEP253 .NE. NFRONT ) THEN + WRITE(*,*) ' *** CHG_HEADER ERROR 3 : not root' + CALL MUMPS_ABORT() + END IF + HEADER( 1 ) = KEEP253 + HEADER( 2 ) = 0 + HEADER( 3 ) = NFRONT + HEADER( 4 ) = NFRONT-KEEP253 + RETURN + END SUBROUTINE ZMUMPS_87 + SUBROUTINE ZMUMPS_136( id ) + USE ZMUMPS_OOC + USE ZMUMPS_STRUC_DEF + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + include 'mpif.h' + TYPE( ZMUMPS_STRUC ) :: id + LOGICAL I_AM_SLAVE + INTEGER IERR, MASTER + PARAMETER ( MASTER = 0 ) + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. id%KEEP(46) .NE. 0 ) + IF (id%KEEP(201).GT.0 .AND. I_AM_SLAVE) THEN + CALL ZMUMPS_587(id,IERR) + IF (IERR < 0) THEN + id%INFO(1) = -90 + id%INFO(2) = 0 + ENDIF + END IF + CALL MUMPS_276(id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID) + IF (id%root%gridinit_done) THEN + IF ( id%KEEP(38).NE.0 .and. id%root%yes ) THEN + CALL blacs_gridexit( id%root%CNTXT_BLACS ) + id%root%gridinit_done = .FALSE. + END IF + END IF + IF ( id%MYID .NE. MASTER .OR. id%KEEP(46) .ne. 0 ) THEN + CALL MPI_COMM_FREE( id%COMM_NODES, IERR ) + CALL MPI_COMM_FREE( id%COMM_LOAD, IERR ) + END IF + IF (associated(id%MEM_DIST)) THEN + DEALLOCATE(id%MEM_DIST) + NULLIFY(id%MEM_DIST) + ENDIF + IF (associated(id%MAPPING)) THEN + DEALLOCATE(id%MAPPING) + NULLIFY(id%MAPPING) + END IF + NULLIFY(id%SCHUR_CINTERFACE) + IF ( id%KEEP(52) .NE. -1 .or. id%MYID .ne. MASTER ) THEN + IF (associated(id%COLSCA)) THEN + DEALLOCATE(id%COLSCA) + NULLIFY(id%COLSCA) + ENDIF + IF (associated(id%ROWSCA)) THEN + DEALLOCATE(id%ROWSCA) + NULLIFY(id%ROWSCA) + ENDIF + END IF + IF (associated(id%PTLUST_S)) THEN + DEALLOCATE(id%PTLUST_S) + NULLIFY(id%PTLUST_S) + END IF + IF (associated(id%PTRFAC)) THEN + DEALLOCATE(id%PTRFAC) + NULLIFY(id%PTRFAC) + END IF + IF (associated(id%POIDS)) THEN + DEALLOCATE(id%POIDS) + NULLIFY(id%POIDS) + ENDIF + IF (associated(id%IS)) THEN + DEALLOCATE(id%IS) + NULLIFY(id%IS) + ENDIF + IF (associated(id%IS1)) THEN + DEALLOCATE(id%IS1) + NULLIFY(id%IS1) + ENDIF + IF (associated(id%STEP)) THEN + DEALLOCATE(id%STEP) + NULLIFY(id%STEP) + ENDIF + IF (associated(id%Step2node)) THEN + DEALLOCATE(id%Step2node) + NULLIFY(id%Step2node) + ENDIF + IF (associated(id%NE_STEPS)) THEN + DEALLOCATE(id%NE_STEPS) + NULLIFY(id%NE_STEPS) + ENDIF + IF (associated(id%ND_STEPS)) THEN + DEALLOCATE(id%ND_STEPS) + NULLIFY(id%ND_STEPS) + ENDIF + IF (associated(id%FRERE_STEPS)) THEN + DEALLOCATE(id%FRERE_STEPS) + NULLIFY(id%FRERE_STEPS) + ENDIF + IF (associated(id%DAD_STEPS)) THEN + DEALLOCATE(id%DAD_STEPS) + NULLIFY(id%DAD_STEPS) + ENDIF + IF (associated(id%SYM_PERM)) THEN + DEALLOCATE(id%SYM_PERM) + NULLIFY(id%SYM_PERM) + ENDIF + IF (associated(id%UNS_PERM)) THEN + DEALLOCATE(id%UNS_PERM) + NULLIFY(id%UNS_PERM) + ENDIF + IF (associated(id%PIVNUL_LIST)) THEN + DEALLOCATE(id%PIVNUL_LIST) + NULLIFY(id%PIVNUL_LIST) + ENDIF + IF (associated(id%FILS)) THEN + DEALLOCATE(id%FILS) + NULLIFY(id%FILS) + ENDIF + IF (associated(id%PTRAR)) THEN + DEALLOCATE(id%PTRAR) + NULLIFY(id%PTRAR) + ENDIF + IF (associated(id%FRTPTR)) THEN + DEALLOCATE(id%FRTPTR) + NULLIFY(id%FRTPTR) + ENDIF + IF (associated(id%FRTELT)) THEN + DEALLOCATE(id%FRTELT) + NULLIFY(id%FRTELT) + ENDIF + IF (associated(id%NA)) THEN + DEALLOCATE(id%NA) + NULLIFY(id%NA) + ENDIF + IF (associated(id%PROCNODE_STEPS)) THEN + DEALLOCATE(id%PROCNODE_STEPS) + NULLIFY(id%PROCNODE_STEPS) + ENDIF + IF (associated(id%PROCNODE)) THEN + DEALLOCATE(id%PROCNODE) + NULLIFY(id%PROCNODE) + ENDIF + IF (associated(id%RHSCOMP)) THEN + DEALLOCATE(id%RHSCOMP) + NULLIFY(id%RHSCOMP) + ENDIF + IF (associated(id%POSINRHSCOMP)) THEN + DEALLOCATE(id%POSINRHSCOMP) + NULLIFY(id%POSINRHSCOMP) + ENDIF + IF (id%KEEP(46).eq.1 .and. + & id%KEEP(55).ne.0 .and. + & id%MYID .eq. MASTER .and. + & id%KEEP(52) .eq. 0 ) THEN + NULLIFY(id%DBLARR) + ELSE + IF (associated(id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + END IF + IF (associated(id%INTARR)) THEN + DEALLOCATE(id%INTARR) + NULLIFY(id%INTARR) + ENDIF + IF (associated(id%root%RG2L_ROW))THEN + DEALLOCATE(id%root%RG2L_ROW) + NULLIFY(id%root%RG2L_ROW) + ENDIF + IF (associated(id%root%RG2L_COL))THEN + DEALLOCATE(id%root%RG2L_COL) + NULLIFY(id%root%RG2L_COL) + ENDIF + IF (associated(id%root%IPIV)) THEN + DEALLOCATE(id%root%IPIV) + NULLIFY(id%root%IPIV) + ENDIF + IF (associated(id%root%RHS_CNTR_MASTER_ROOT)) THEN + DEALLOCATE(id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY(id%root%RHS_CNTR_MASTER_ROOT) + ENDIF + IF (associated(id%root%RHS_ROOT))THEN + DEALLOCATE(id%root%RHS_ROOT) + NULLIFY(id%root%RHS_ROOT) + ENDIF + CALL ZMUMPS_636(id) + IF (associated(id%ELTPROC)) THEN + DEALLOCATE(id%ELTPROC) + NULLIFY(id%ELTPROC) + ENDIF + IF (associated(id%CANDIDATES)) THEN + DEALLOCATE(id%CANDIDATES) + NULLIFY(id%CANDIDATES) + ENDIF + IF (associated(id%I_AM_CAND)) THEN + DEALLOCATE(id%I_AM_CAND) + NULLIFY(id%I_AM_CAND) + ENDIF + IF (associated(id%ISTEP_TO_INIV2)) THEN + DEALLOCATE(id%ISTEP_TO_INIV2) + NULLIFY(id%ISTEP_TO_INIV2) + ENDIF + IF (I_AM_SLAVE) THEN + IF (associated(id%TAB_POS_IN_PERE)) THEN + DEALLOCATE(id%TAB_POS_IN_PERE) + NULLIFY(id%TAB_POS_IN_PERE) + ENDIF + IF (associated(id%FUTURE_NIV2)) THEN + DEALLOCATE(id%FUTURE_NIV2) + NULLIFY(id%FUTURE_NIV2) + ENDIF + ENDIF + IF(associated(id%DEPTH_FIRST))THEN + DEALLOCATE(id%DEPTH_FIRST) + NULLIFY(id%DEPTH_FIRST) + ENDIF + IF(associated(id%DEPTH_FIRST_SEQ))THEN + DEALLOCATE(id%DEPTH_FIRST_SEQ) + NULLIFY(id%DEPTH_FIRST_SEQ) + ENDIF + IF(associated(id%SBTR_ID))THEN + DEALLOCATE(id%SBTR_ID) + NULLIFY(id%SBTR_ID) + ENDIF + IF (associated(id%MEM_SUBTREE)) THEN + DEALLOCATE(id%MEM_SUBTREE) + NULLIFY(id%MEM_SUBTREE) + ENDIF + IF (associated(id%MY_ROOT_SBTR)) THEN + DEALLOCATE(id%MY_ROOT_SBTR) + NULLIFY(id%MY_ROOT_SBTR) + ENDIF + IF (associated(id%MY_FIRST_LEAF)) THEN + DEALLOCATE(id%MY_FIRST_LEAF) + NULLIFY(id%MY_FIRST_LEAF) + ENDIF + IF (associated(id%MY_NB_LEAF)) THEN + DEALLOCATE(id%MY_NB_LEAF) + NULLIFY(id%MY_NB_LEAF) + ENDIF + IF (associated(id%COST_TRAV)) THEN + DEALLOCATE(id%COST_TRAV) + NULLIFY(id%COST_TRAV) + ENDIF + IF(associated (id%OOC_INODE_SEQUENCE))THEN + DEALLOCATE(id%OOC_INODE_SEQUENCE) + NULLIFY(id%OOC_INODE_SEQUENCE) + ENDIF + IF(associated (id%OOC_TOTAL_NB_NODES))THEN + DEALLOCATE(id%OOC_TOTAL_NB_NODES) + NULLIFY(id%OOC_TOTAL_NB_NODES) + ENDIF + IF(associated (id%OOC_SIZE_OF_BLOCK))THEN + DEALLOCATE(id%OOC_SIZE_OF_BLOCK) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + ENDIF + IF(associated (id%OOC_VADDR))THEN + DEALLOCATE(id%OOC_VADDR) + NULLIFY(id%OOC_VADDR) + ENDIF + IF(associated (id%OOC_NB_FILES))THEN + DEALLOCATE(id%OOC_NB_FILES) + NULLIFY(id%OOC_NB_FILES) + ENDIF + IF (id%KEEP8(24).EQ.0_8) THEN + IF (associated(id%S)) DEALLOCATE(id%S) + ELSE + ENDIF + NULLIFY(id%S) + IF (I_AM_SLAVE) THEN + CALL ZMUMPS_57( IERR ) + CALL ZMUMPS_59( IERR ) + END IF + IF ( associated( id%BUFR ) ) DEALLOCATE( id%BUFR ) + NULLIFY( id%BUFR ) + RETURN + END SUBROUTINE ZMUMPS_136 + SUBROUTINE ZMUMPS_150(MYID,COMM,S,MAXS,MAXS_BYTES) + IMPLICIT NONE + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + INTEGER COMM, MYID, MAXS, MAXS_BYTES + INTEGER S( MAXS ) + INTEGER MSGTAG, MSGSOU, MSGLEN + LOGICAL FLAG + FLAG = .TRUE. + DO WHILE ( FLAG ) + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + IF (FLAG) THEN + MSGTAG=STATUS(MPI_TAG) + MSGSOU=STATUS(MPI_SOURCE) + CALL MPI_GET_COUNT(STATUS,MPI_PACKED,MSGLEN,IERR) + IF (MSGLEN <= MAXS_BYTES) THEN + CALL MPI_RECV(S(1),MAXS_BYTES,MPI_PACKED, + & MSGSOU, MSGTAG, COMM, STATUS, IERR) + ELSE + EXIT + ENDIF + END IF + END DO + CALL MPI_BARRIER( COMM, IERR ) + RETURN + END SUBROUTINE ZMUMPS_150 + SUBROUTINE ZMUMPS_254(COMM_LOAD, ASS_IRECV, + & N, INODE, TYPE, TYPEF, + & LA, IW, LIW, A, + & IFLAG, IERROR, OPELIW, NELVAW, NMAXNPIV, + & PTRIST, PTLUST_S, + & PTRFAC, PTRAST, + & STEP, PIMASTER, PAMASTER, NE, + & POSFAC, LRLU, LRLUS, IPTRLU, ICNTL, KEEP,KEEP8, + & COMP, IWPOS, IWPOSCB, PROCNODE_STEPS, SLAVEF, + & FPERE, COMM, MYID, + & IPOOL, LPOOL, LEAF, NSTK_S, + & NBPROCFILS, + & BUFR, LBUFR, LBUFR_BYTES, NBFIN, root, + & OPASSW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, INTARR, DBLARR, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER COMM, MYID, TYPE, TYPEF + INTEGER N, LIW, INODE,IFLAG,IERROR + INTEGER ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA, POSFAC, LRLU, LRLUS, IPTRLU + INTEGER IWPOSCB, IWPOS, + & FPERE, SLAVEF, NELVAW, NMAXNPIV + INTEGER IW(LIW),PROCNODE_STEPS(KEEP(28)) + INTEGER(8) :: PTRAST (KEEP(28)) + INTEGER(8) :: PTRFAC (KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)), NE(KEEP(28)) + COMPLEX(kind=8) A(LA) + DOUBLE PRECISION OPASSW, OPELIW + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER ITLOC( N + KEEP(253) ), FILS( N ), + & ND( KEEP(28) ), FRERE( KEEP(28) ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER LPOOL, LEAF, COMP + INTEGER IPOOL( LPOOL ) + INTEGER NSTK_S( KEEP(28) ) + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER NBFIN + INTEGER NFRONT_ESTIM,NELIM_ESTIM + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER LP + INTEGER NBROWS_ALREADY_SENT + INTEGER(8) :: POSELT, OPSFAC + INTEGER(8) :: IOLD, INEW, FACTOR_POS + INTEGER NSLAVES, NCB, + & H_INODE, IERR, NBCOL, NBROW, NBROW_SEND, + & NBROW_STACK, NBCOL_STACK, NELIM + INTEGER NCBROW_ALREADY_MOVED, NCBROW_PREVIOUSLY_MOVED, + &NCBROW_NEWLY_MOVED + INTEGER(8) :: LAST_ALLOWED_POS + INTEGER(8) :: LREQCB, MIN_SPACE_IN_PLACE + INTEGER(8) :: SHIFT_VAL_SON + INTEGER SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON, + & LIST_ROW_SON, LIST_COL_SON, LIST_SLAVES + INTEGER IOLDPS,NFRONT,NPIV,NASS,IOLDP1,PTROWEND, + & LREQI, LCONT + INTEGER I,LDA, INIV2 + INTEGER MSGDEST, MSGTAG, CHK_LOAD + INCLUDE 'mumps_headers.h' + LOGICAL COMPRESSCB, MUST_COMPACT_FACTORS + LOGICAL INPLACE + INTEGER(8) :: SIZE_INPLACE + INTEGER INTSIZ + DOUBLE PRECISION FLOP1, FLOP1_EFFECTIVE + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + LOGICAL SSARBR, SSARBR_ROOT, MUMPS_167, + &MUMPS_170 + EXTERNAL MUMPS_167, MUMPS_170 + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + INPLACE = .FALSE. + MIN_SPACE_IN_PLACE = 0_8 + IOLDPS = PTLUST_S(STEP(INODE)) + INTSIZ = IW(IOLDPS+XXI) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NPIV = IW(IOLDPS + 1+KEEP(IXSZ)) + NMAXNPIV = max(NPIV, NMAXNPIV) + NASS = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) + NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) + H_INODE= 6 + NSLAVES + KEEP(IXSZ) + LCONT = NFRONT - NPIV + NBCOL = LCONT + SSARBR = MUMPS_167(PROCNODE_STEPS(STEP(INODE)),SLAVEF) + SSARBR_ROOT = MUMPS_170 + & (PROCNODE_STEPS(STEP(INODE)),SLAVEF) + LREQCB = 0_8 + INPLACE = .FALSE. + COMPRESSCB= ((KEEP(215).EQ.0) + & .AND.(KEEP(50).NE.0) + & .AND.(TYPEF.EQ.1 + & .OR.TYPEF.EQ.2 + & ) + & .AND.(TYPE.EQ.1)) + MUST_COMPACT_FACTORS = .TRUE. + IF (KEEP(201).EQ.1 .OR. KEEP(201).EQ.-1) THEN + MUST_COMPACT_FACTORS = .FALSE. + ENDIF + IF ((FPERE.EQ.0).AND.(NASS.NE.NPIV)) THEN + IFLAG = -10 + GOTO 600 + ENDIF + NBROW = LCONT + IF (TYPE.EQ.2) NBROW = NASS - NPIV + IF ((KEEP(50).NE.0).AND.(TYPE.EQ.2)) THEN + LDA = NASS + ELSE + LDA = NFRONT + ENDIF + NBROW_SEND = NBROW + NELIM = NASS-NPIV + IF (TYPEF.EQ.2) NBROW_SEND = NELIM + POSELT = PTRAST(STEP(INODE)) + IF (POSELT .ne. PTRFAC(STEP(INODE))) THEN + WRITE(*,*) "Error 1 in G" + CALL MUMPS_ABORT() + END IF + NELVAW = NELVAW + NASS - NPIV + IF (KEEP(50) .eq. 0) THEN + KEEP8(10) = KEEP8(10) + int(NPIV,8) * int(NFRONT,8) + ELSE + KEEP8(10) = KEEP8(10) + ( int(NPIV,8)*int(NPIV+1,8) )/ 2_8 + ENDIF + KEEP8(10) = KEEP8(10) + int(NBROW,8) * int(NPIV,8) + CALL MUMPS_511( NFRONT, NPIV, NASS, + & KEEP(50), TYPE,FLOP1 ) + IF ( (.NOT. SSARBR_ROOT) .and. TYPE == 1) THEN + IF (NE(STEP(INODE))==0) THEN + CHK_LOAD=0 + ELSE + CHK_LOAD=1 + ENDIF + CALL ZMUMPS_190(CHK_LOAD, .FALSE., -FLOP1, + & KEEP,KEEP8) + ENDIF + FLOP1_EFFECTIVE = FLOP1 + OPELIW = OPELIW + FLOP1 + IF ( NPIV .NE. NASS ) THEN + CALL MUMPS_511( NFRONT, NASS, NASS, + & KEEP(50), TYPE,FLOP1 ) + IF (.NOT. SSARBR_ROOT ) THEN + IF (NE(STEP(INODE))==0) THEN + CHK_LOAD=0 + ELSE + CHK_LOAD=1 + ENDIF + CALL ZMUMPS_190(CHK_LOAD, .FALSE., + & FLOP1_EFFECTIVE-FLOP1, + & KEEP,KEEP8) + ENDIF + END IF + IF ( SSARBR_ROOT ) THEN + NFRONT_ESTIM=ND(STEP(INODE)) + KEEP(253) + NELIM_ESTIM=NASS-(NFRONT-NFRONT_ESTIM) + CALL MUMPS_511(NFRONT_ESTIM,NELIM_ESTIM,NELIM_ESTIM, + & KEEP(50),1,FLOP1) + END IF + FLOP1=-FLOP1 + IF (SSARBR_ROOT) THEN + CALL ZMUMPS_190(0,.FALSE.,FLOP1,KEEP,KEEP8) + ELSE + CALL ZMUMPS_190(2,.FALSE.,FLOP1,KEEP,KEEP8) + ENDIF + IF ( FPERE .EQ. 0 ) THEN + IF ( KEEP(253) .NE. 0 .AND. KEEP(201).NE.-1 + & .AND. KEEP(201).NE.1 ) THEN + MUST_COMPACT_FACTORS = .TRUE. + GOTO 190 + ELSE + MUST_COMPACT_FACTORS = .FALSE. + GOTO 190 + ENDIF + ENDIF + IF ( FPERE.EQ.KEEP(38) ) THEN + NCB = NFRONT - NASS + SHIFT_LIST_ROW_SON = H_INODE + NASS + SHIFT_LIST_COL_SON = H_INODE + NFRONT + NASS + SHIFT_VAL_SON = int(NASS,8)*int(NFRONT+1,8) + IF (TYPE.EQ.1) THEN + CALL ZMUMPS_80( + & COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTLUST_S, PTRAST, + & root, NCB, NCB, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT, + & ROOT_CONT_STATIC, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF (IFLAG < 0 ) GOTO 500 + ENDIF + MSGDEST= MUMPS_275(PROCNODE_STEPS(STEP(FPERE)),SLAVEF) + IOLDPS = PTLUST_S(STEP(INODE)) + LIST_ROW_SON = IOLDPS + H_INODE + NPIV + LIST_COL_SON = IOLDPS + H_INODE + NFRONT + NPIV + LIST_SLAVES = IOLDPS + 6 + KEEP(IXSZ) + IF (MSGDEST.EQ.MYID) THEN + CALL ZMUMPS_273( root, + & INODE, NELIM, NSLAVES, IW(LIST_ROW_SON), + & IW(LIST_COL_SON), IW(LIST_SLAVES), + & + & PROCNODE_STEPS, IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, + & ITLOC, RHS_MUMPS, COMP, + & IFLAG, IERROR, + & IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8, + & COMM, COMM_LOAD, FILS, ND) + IF (IFLAG.LT.0) GOTO 600 + ELSE + IERR = -1 + DO WHILE (IERR.EQ.-1) + CALL ZMUMPS_76( INODE, NELIM, + & IW(LIST_ROW_SON), IW(LIST_COL_SON), NSLAVES, + & IW(LIST_SLAVES), MSGDEST, COMM, IERR) + IF ( IERR .EQ. -1 ) THEN + BLOCKING =.FALSE. + SET_IRECV =.TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, + & ND, FRERE, LPTRAR, NELT, + & FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & .TRUE.) + IF ( IFLAG .LT. 0 ) GOTO 500 + IOLDPS = PTLUST_S(STEP(INODE)) + LIST_ROW_SON = IOLDPS + H_INODE + NPIV + LIST_COL_SON = IOLDPS + H_INODE + NFRONT + NPIV + LIST_SLAVES = IOLDPS + 6 + KEEP(IXSZ) + ENDIF + ENDDO + IF ( IERR .EQ. -2 ) THEN + IERROR = ( 3 + NSLAVES + 2 * NELIM ) * KEEP( 34 ) + IFLAG = - 17 + GOTO 600 + ELSE IF ( IERR .EQ. -3 ) THEN + IERROR = ( 3 + NSLAVES + 2 * NELIM ) * KEEP( 34 ) + IFLAG = -20 + GOTO 600 + ENDIF + ENDIF + IF (NELIM.EQ.0) THEN + POSELT = PTRAST(STEP(INODE)) + OPSFAC = POSELT + int(NPIV,8) * int(NFRONT,8) + int(NPIV,8) + GOTO 190 + ELSE + GOTO 500 + ENDIF + ENDIF + OPSFAC = POSELT + int(NPIV,8) * int(LDA,8) + int(NPIV,8) + IF ( MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .NE. MYID ) THEN + MSGTAG =NOEUD + MSGDEST=MUMPS_275( PROCNODE_STEPS(STEP(FPERE)), SLAVEF ) + IERR = -1 + NBROWS_ALREADY_SENT = 0 + DO WHILE (IERR.EQ.-1) + IF ( (TYPE.EQ.1) .AND. (TYPEF.EQ.1) ) THEN + CALL ZMUMPS_66( NBROWS_ALREADY_SENT, + & INODE, FPERE, NFRONT, + & LCONT, NASS, NPIV, IW( IOLDPS + H_INODE + NPIV ), + & IW( IOLDPS + H_INODE + NPIV + NFRONT ), + & A( OPSFAC ), COMPRESSCB, + & MSGDEST, MSGTAG, COMM, IERR ) + ELSE + IF ( (TYPE.EQ.2).AND.(KEEP(48).NE.0)) THEN + INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) ) + ELSE + INIV2 = -9999 + ENDIF + CALL ZMUMPS_70( NBROWS_ALREADY_SENT, + & FPERE, INODE, + & NBROW_SEND, IW(IOLDPS + H_INODE + NPIV ), + & NBCOL, IW(IOLDPS + H_INODE + NPIV + NFRONT ), + & A(OPSFAC), LDA, NELIM, TYPE, + & NSLAVES, IW(IOLDPS+6+KEEP(IXSZ)), MSGDEST, + & COMM, IERR, + & + & SLAVEF, KEEP,KEEP8, INIV2, TAB_POS_IN_PERE ) + END IF + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IOLDPS = PTLUST_S(STEP( INODE )) + OPSFAC = POSELT + int(NPIV,8) * int(LDA,8) + int(NPIV,8) + END DO + IF ( IERR .EQ. -2 .OR. IERR .EQ. -3 ) THEN + IF ( (TYPE.EQ.1) .AND. (TYPEF.EQ.1) ) THEN + IERROR = ( 2*LCONT + 9 ) * KEEP( 34 ) + + & LCONT*LCONT * KEEP( 35 ) + ELSE IF (KEEP(50).ne.0 .AND. TYPE .eq. 2 ) THEN + IERROR = ( NBROW_SEND + NBCOL+ 5 + NSLAVES) + & * KEEP( 34 ) + + & NBROW_SEND*NBROW_SEND*KEEP( 35 ) + ELSE + IERROR = ( NBROW_SEND + NBCOL+ 5 + NSLAVES) * KEEP( 34 ) + + & NBROW_SEND*NBCOL*KEEP( 35 ) + ENDIF + IF (IERR .EQ. -2) THEN + IFLAG = -17 + IF ( LP > 0 ) THEN + WRITE(LP, *) MYID, + & ": FAILURE, SEND BUFFER TOO SMALL DURING + & ZMUMPS_254", TYPE, TYPEF + ENDIF + ENDIF + IF (IERR .EQ. -3) THEN + IFLAG = -20 + IF ( LP > 0 ) THEN + WRITE(LP, *) MYID, + & ": FAILURE, RECV BUFFER TOO SMALL DURING + & ZMUMPS_254", TYPE, TYPEF + ENDIF + ENDIF + GOTO 600 + ENDIF + ENDIF + IF ( MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .EQ. MYID ) THEN + LREQI = 2 + KEEP(IXSZ) + NBROW_STACK = NBROW + NBROW_SEND = 0 + IF ((KEEP(50).NE.0).AND.(TYPE.EQ.2)) THEN + NBCOL_STACK = NBROW + ELSE + NBCOL_STACK = NBCOL + ENDIF + ELSE + NBROW_STACK = NBROW-NBROW_SEND + NBCOL_STACK = NBCOL + LREQI = 6 + NBROW_STACK + NBCOL + KEEP(IXSZ) + IF (.NOT. (TYPE.EQ.1 .AND. TYPEF.EQ.2 ) ) GOTO 190 + IF (FPERE.EQ.0) GOTO 190 + ENDIF + IF (COMPRESSCB) THEN + LREQCB = ( int(NBCOL_STACK,8) * int( NBCOL_STACK + 1, 8) ) / 2_8 + & - ( int(NBROW_SEND ,8) * int( NBROW_SEND + 1, 8) ) / 2_8 + ELSE + LREQCB = int(NBROW_STACK,8) * int(NBCOL_STACK,8) + ENDIF + INPLACE = ( KEEP(234).NE.0 ) + IF (KEEP(50).NE.0 .AND. TYPE .EQ. 2) INPLACE = .FALSE. + INPLACE = INPLACE .OR. .NOT. MUST_COMPACT_FACTORS + INPLACE = INPLACE .AND. + & ( PTLUST_S(STEP(INODE)) + INTSIZ .EQ. IWPOS ) + MIN_SPACE_IN_PLACE = 0_8 + IF ( INPLACE .AND. KEEP(50).eq. 0 .AND. + & MUST_COMPACT_FACTORS) THEN + MIN_SPACE_IN_PLACE = int(NBCOL_STACK,8) + ENDIF + IF ( MIN_SPACE_IN_PLACE .GT. LREQCB ) THEN + INPLACE = .FALSE. + ENDIF + CALL ZMUMPS_22( INPLACE, MIN_SPACE_IN_PLACE, + & SSARBR, .FALSE., + & MYID,N,KEEP,KEEP8,IW, LIW, A, LA, + & LRLU, IPTRLU,IWPOS,IWPOSCB, + & PTRIST,PTRAST,STEP, PIMASTER,PAMASTER, + & LREQI, LREQCB, INODE, S_NOTFREE, .TRUE., + & COMP, LRLUS, IFLAG, IERROR ) + IF (IFLAG.LT.0) GOTO 600 + PTRIST(STEP(INODE)) = IWPOSCB+1 + IF ( MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .EQ. MYID ) THEN + PIMASTER (STEP(INODE)) = PTLUST_S(STEP(INODE)) + PAMASTER(STEP(INODE)) = IPTRLU + 1_8 + PTRAST(STEP(INODE)) = -99999999_8 + IW(IWPOSCB+1+KEEP(IXSZ)) = min(-NBCOL_STACK,-1) + IW(IWPOSCB+2+KEEP(IXSZ)) = NBROW_STACK + IF (COMPRESSCB) IW(IWPOSCB+1+XXS) = S_CB1COMP + ELSE + PTRAST(STEP(INODE)) = IPTRLU+1_8 + IF (COMPRESSCB) IW(IWPOSCB+1+XXS)=S_CB1COMP + IW(IWPOSCB+1+KEEP(IXSZ)) = NBCOL + IW(IWPOSCB+2+KEEP(IXSZ)) = 0 + IW(IWPOSCB+3+KEEP(IXSZ)) = NBROW_STACK + IW(IWPOSCB+4+KEEP(IXSZ)) = 0 + IW(IWPOSCB+5+KEEP(IXSZ)) = 1 + IW(IWPOSCB+6+KEEP(IXSZ)) = 0 + IOLDP1 = PTLUST_S(STEP(INODE))+H_INODE + PTROWEND = IWPOSCB+6+NBROW_STACK+KEEP(IXSZ) + DO I = 1, NBROW_STACK + IW(IWPOSCB+7+KEEP(IXSZ)+I-1) = + & IW(IOLDP1+NFRONT-NBROW_STACK+I-1) + ENDDO + DO I = 1, NBCOL + IW(PTROWEND+I)=IW(IOLDP1+NFRONT+NPIV+I-1) + ENDDO + END IF + IF ( KEEP(50).NE.0 .AND. TYPE .EQ. 1 + & .AND. MUST_COMPACT_FACTORS ) THEN + POSELT = PTRFAC(STEP(INODE)) + CALL ZMUMPS_324(A(POSELT), LDA, + & NPIV, NBROW, KEEP(50)) + MUST_COMPACT_FACTORS = .FALSE. + ENDIF + IF ( KEEP(50).EQ.0 .AND. MUST_COMPACT_FACTORS ) + & THEN + LAST_ALLOWED_POS = POSELT + int(LDA,8)*int(NPIV+NBROW-1,8) + & + int(NPIV,8) + ELSE + LAST_ALLOWED_POS = -1_8 + ENDIF + NCBROW_ALREADY_MOVED = 0 + 10 CONTINUE + NCBROW_PREVIOUSLY_MOVED = NCBROW_ALREADY_MOVED + IF (IPTRLU .LT. POSFAC ) THEN + CALL ZMUMPS_652( A, LA, LDA, + & POSELT, IPTRLU, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, LREQCB, KEEP, COMPRESSCB, + & LAST_ALLOWED_POS, NCBROW_ALREADY_MOVED ) + ELSE + CALL ZMUMPS_705( A, LA, LDA, + & POSELT, IPTRLU, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, LREQCB, KEEP, COMPRESSCB ) + NCBROW_ALREADY_MOVED = NBROW_STACK + ENDIF + IF (LAST_ALLOWED_POS .NE. -1_8) THEN + MUST_COMPACT_FACTORS =.FALSE. + IF ( NCBROW_ALREADY_MOVED .EQ. NBROW_STACK ) THEN + NCBROW_ALREADY_MOVED = NCBROW_ALREADY_MOVED + NBROW_SEND + ENDIF + NCBROW_NEWLY_MOVED = NCBROW_ALREADY_MOVED + & - NCBROW_PREVIOUSLY_MOVED + FACTOR_POS = POSELT + + & int(LDA,8)*int(NPIV+NBROW-NCBROW_ALREADY_MOVED,8) + CALL ZMUMPS_651( A(FACTOR_POS), LDA, NPIV, + & NCBROW_NEWLY_MOVED ) + INEW = FACTOR_POS + int(NPIV,8) * int(NCBROW_NEWLY_MOVED,8) + IOLD = INEW + int(NCBROW_NEWLY_MOVED,8) * int(NBCOL_STACK,8) + DO I = 1, NCBROW_PREVIOUSLY_MOVED*NPIV + A(INEW) = A(IOLD) + IOLD = IOLD + 1_8 + INEW = INEW + 1_8 + ENDDO + KEEP8(8)=KEEP8(8) + int(NCBROW_PREVIOUSLY_MOVED,8) + & * int(NPIV,8) + LAST_ALLOWED_POS = INEW + IF (NCBROW_ALREADY_MOVED.LT.NBROW_STACK) THEN + GOTO 10 + ENDIF + ENDIF + 190 CONTINUE + IF (MUST_COMPACT_FACTORS) THEN + POSELT = PTRFAC(STEP(INODE)) + CALL ZMUMPS_324(A(POSELT), LDA, + & NPIV, NBROW, KEEP(50)) + MUST_COMPACT_FACTORS = .FALSE. + ENDIF + IOLDPS = PTLUST_S(STEP(INODE)) + IW(IOLDPS+KEEP(IXSZ)) = NBCOL + IW(IOLDPS + 1+KEEP(IXSZ)) = NASS - NPIV + IF (TYPE.EQ.2) THEN + IW(IOLDPS + 2+KEEP(IXSZ)) = NASS + ELSE + IW(IOLDPS + 2+KEEP(IXSZ)) = NFRONT + ENDIF + IW(IOLDPS + 3+KEEP(IXSZ)) = NPIV + IF (INPLACE) THEN + SIZE_INPLACE = LREQCB - MIN_SPACE_IN_PLACE + ELSE + SIZE_INPLACE = 0_8 + ENDIF + CALL ZMUMPS_93(SIZE_INPLACE,MYID,N,IOLDPS,TYPE, IW, LIW, + & A, LA, POSFAC, LRLU, LRLUS, + & IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8, SSARBR,INODE,IERR) + IF(IERR.LT.0)THEN + IFLAG=IERR + IERROR=0 + GOTO 600 + ENDIF + 500 CONTINUE + RETURN + 600 CONTINUE + IF (IFLAG .NE. -1) CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE ZMUMPS_254 + SUBROUTINE ZMUMPS_142( id) + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_LOAD + USE ZMUMPS_OOC + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE +#ifndef SUN_ + INTERFACE + SUBROUTINE ZMUMPS_27(id, ANORMINF, LSCAL) + USE ZMUMPS_STRUC_DEF + TYPE (ZMUMPS_STRUC), TARGET :: id + DOUBLE PRECISION, INTENT(OUT) :: ANORMINF + LOGICAL :: LSCAL + END SUBROUTINE ZMUMPS_27 + END INTERFACE +#endif + TYPE(ZMUMPS_STRUC), TARGET :: id + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER IERR, MASTER + PARAMETER( MASTER = 0 ) + INCLUDE 'mumps_headers.h' + INTEGER NSEND, NSEND_TOT, LDPTRAR, NELT + INTEGER NLOCAL, NLOCAL_TOT, KEEP13_SAVE, ITMP + INTEGER(8) K67 + INTEGER(8) ITMP8 + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER MP, LP, MPG, allocok + LOGICAL PROK, PROKG, LSCAL + INTEGER ZMUMPS_LBUF, ZMUMPS_LBUFR_BYTES, ZMUMPS_LBUF_INT + INTEGER PTRIST, PTRWB, MAXELT_SIZE, + & ITLOC, IPOOL, NSTEPS, K28, LPOOL, LIW + INTEGER IRANK, ID_ROOT + INTEGER KKKK, NZ_locMAX + INTEGER(8) MEMORY_MD_ARG + INTEGER(8) MAXS_BASE8, MAXS_BASE_RELAXED8 + DOUBLE PRECISION CNTL4 + INTEGER MIN_PERLU, MAXIS_ESTIM + INTEGER MAXIS + INTEGER(8) :: MAXS + DOUBLE PRECISION TIME + DOUBLE PRECISION ZERO + PARAMETER( ZERO = 0.0D0 ) + INTEGER PERLU, TOTAL_MBYTES, K231, K232, K233 + INTEGER COLOUR, COMM_FOR_SCALING + INTEGER LIWK, LWK, LWK_REAL + LOGICAL I_AM_SLAVE, PERLU_ON, WK_USER_PROVIDED + DOUBLE PRECISION :: ANORMINF, SEUIL, SEUIL_LDLT_NIV2 + DOUBLE PRECISION :: CNTL1, CNTL3, CNTL5, CNTL6, EPS + INTEGER N, LPN_LIST,POSBUF + INTEGER, DIMENSION (:), ALLOCATABLE :: ITMP2 + INTEGER I,K + INTEGER, DIMENSION(:), ALLOCATABLE :: IWK + COMPLEX(kind=8), DIMENSION(:), ALLOCATABLE :: WK + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: WK_REAL + INTEGER(8), DIMENSION(:), ALLOCATABLE :: IWK8 + INTEGER, DIMENSION(:), ALLOCATABLE :: BURP + INTEGER, DIMENSION(:), ALLOCATABLE :: BUCP + INTEGER, DIMENSION(:), ALLOCATABLE :: BURS + INTEGER, DIMENSION(:), ALLOCATABLE :: BUCS + INTEGER BUREGISTRE(12) + INTEGER BUINTSZ, BURESZ, BUJOB + INTEGER BUMAXMN, M, SCMYID, SCNPROCS + DOUBLE PRECISION SCONEERR, SCINFERR + INTEGER, POINTER :: JOB, NZ + DOUBLE PRECISION,DIMENSION(:),POINTER::RINFO, RINFOG + DOUBLE PRECISION,DIMENSION(:),POINTER:: CNTL + INTEGER,DIMENSION(:),POINTER::INFO, INFOG, KEEP + INTEGER, DIMENSION(:), POINTER :: MYIRN_loc, MYJCN_loc + COMPLEX(kind=8), DIMENSION(:), POINTER :: MYA_loc + INTEGER, TARGET :: DUMMYIRN_loc(1), DUMMYJCN_loc(1) + COMPLEX(kind=8), TARGET :: DUMMYA_loc(1) + INTEGER(8),DIMENSION(:),POINTER::KEEP8 + INTEGER,DIMENSION(:),POINTER::ICNTL + EXTERNAL ZMUMPS_505 + INTEGER ZMUMPS_505 + INTEGER(8) TOTAL_BYTES + INTEGER(8) :: I8TMP + INTEGER numroc + EXTERNAL numroc + COMPLEX(kind=8), DIMENSION(:), POINTER :: RHS_MUMPS + LOGICAL :: RHS_MUMPS_ALLOCATED + JOB=>id%JOB + NZ=>id%NZ + RINFO=>id%RINFO + RINFOG=>id%RINFOG + CNTL=>id%CNTL + INFO=>id%INFO + INFOG=>id%INFOG + KEEP=>id%KEEP + KEEP8=>id%KEEP8 + ICNTL=>id%ICNTL + IF (id%NZ_loc .NE. 0) THEN + MYIRN_loc=>id%IRN_loc + MYJCN_loc=>id%JCN_loc + MYA_loc=>id%A_loc + ELSE + MYIRN_loc=>DUMMYIRN_loc + MYJCN_loc=>DUMMYJCN_loc + MYA_loc=>DUMMYA_loc + ENDIF + N = id%N + EPS = epsilon ( ZERO ) + NULLIFY(RHS_MUMPS) + RHS_MUMPS_ALLOCATED = .FALSE. + IF (KEEP8(24).GT.0_8) THEN + NULLIFY(id%S) + ENDIF + WK_USER_PROVIDED = (id%LWK_USER.NE.0) + IF (WK_USER_PROVIDED) THEN + IF (id%LWK_USER.GT.0) THEN + KEEP8(24) = int(id%LWK_USER,8) + ELSE + KEEP8(24) = -int(id%LWK_USER,8)* 1000000_8 + ENDIF + ELSE + KEEP8(24) = 0_8 + ENDIF + KEEP13_SAVE = KEEP(13) + id%DKEEP(4)=-1.0D0 + id%DKEEP(5)=-1.0D0 + MP = ICNTL( 2 ) + MPG = ICNTL( 3 ) + LP = ICNTL( 1 ) + PROK = ( MP .GT. 0 ) + PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER ) + IF ( PROK ) WRITE( MP, 130 ) + IF ( PROKG ) WRITE( MPG, 130 ) + IF ( PROKG .and. KEEP(53).GT.0 ) THEN + WRITE(MPG,'(/A,I3)') ' Null space option :', KEEP(19) + IF ( KEEP(21) .ne. 0 ) THEN + WRITE( MPG, '(A,I10)') ' Max deficiency : ', KEEP(21) + END IF + IF ( KEEP(22) .ne. 0 ) THEN + WRITE( MPG, '(A,I10)') ' Min deficiency : ', KEEP(22) + END IF + END IF + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & KEEP(46) .eq. 1 ) ) + IF (id%MYID .EQ. MASTER .AND. KEEP(201) .NE. -1) THEN + KEEP(201)=id%ICNTL(22) + IF (KEEP(201) .NE. 0) THEN +# if defined(OLD_OOC_NOPANEL) + KEEP(201)=2 +# else + KEEP(201)=1 +# endif + ENDIF + ENDIF + CALL MPI_BCAST( KEEP(12), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(19), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(21), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(201), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (id%MYID.EQ.MASTER) THEN + IF (KEEP(217).GT.2.OR.KEEP(217).LT.0) THEN + KEEP(217)=0 + ENDIF + KEEP(214)=KEEP(217) + IF (KEEP(214).EQ.0) THEN + IF (KEEP(201).NE.0) THEN + KEEP(214)=1 + ELSE + KEEP(214)=2 + ENDIF + ENDIF + ENDIF + CALL MPI_BCAST( KEEP(214), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (KEEP(201).NE.0) THEN + CALL MPI_BCAST( KEEP(99), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(205), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(211), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + ENDIF + IF ( KEEP(50) .eq. 1 ) THEN + IF (id%CNTL(1) .ne. ZERO ) THEN + IF ( MPG .GT. 0 ) THEN + WRITE(MPG,'(A)') + &' ** Warning : SPD solver called, resetting CNTL(1) to 0.0D0' + END IF + END IF + id%CNTL(1) = ZERO + END IF + IF (KEEP(219).NE.0) THEN + CALL ZMUMPS_617(max(KEEP(108),1),IERR) + IF (IERR .NE. 0) THEN + INFO(1) = -13 + INFO(2) = max(KEEP(108),1) + END IF + ENDIF + IF (id%KEEP(252).EQ.1 .AND. id%MYID.EQ.MASTER) THEN + IF (id%ICNTL(20).EQ.1) THEN + id%INFO(1)=-43 + id%INFO(2)=20 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Sparse RHS is incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ELSE IF (id%ICNTL(30).NE.0) THEN + id%INFO(1)=-43 + id%INFO(2)=30 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ELSE IF (id%ICNTL(9) .NE. 1) THEN + id%INFO(1)=-43 + id%INFO(2)=9 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: sparse RHS incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ENDIF + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 530 + IF ( PROKG ) THEN + WRITE( MPG, 172 ) id%NSLAVES, id%ICNTL(22), + & KEEP8(111), KEEP(126), KEEP(127), KEEP(28) + IF (KEEP(252).GT.0) + & WRITE(MPG,173) KEEP(253) + ENDIF + IF (KEEP(201).LE.0) THEN + KEEP(IXSZ)=XSIZE_IC + ELSE IF (KEEP(201).EQ.2) THEN + KEEP(IXSZ)=XSIZE_OOC_NOPANEL + ELSE IF (KEEP(201).EQ.1) THEN + IF (KEEP(50).EQ.0) THEN + KEEP(IXSZ)=XSIZE_OOC_UNSYM + ELSE + KEEP(IXSZ)=XSIZE_OOC_SYM + ENDIF + ENDIF + IF (id%MYID.EQ.MASTER) KEEP(258)=ICNTL(33) + CALL MPI_BCAST(KEEP(258), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + IF (KEEP(258) .NE. 0) THEN + KEEP(259) = 0 + KEEP(260) = 1 + id%DKEEP(6) = 1.0D0 + id%DKEEP(7) = 0.0D0 + ENDIF + CALL MPI_BCAST(KEEP(52), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + LSCAL = ((KEEP(52) .GT. 0) .AND. (KEEP(52) .LE. 8)) + IF (LSCAL) THEN + IF ( id%MYID.EQ.MASTER ) THEN + ENDIF + IF (KEEP(52) .EQ. 7) THEN + K231= KEEP(231) + K232= KEEP(232) + K233= KEEP(233) + ELSEIF (KEEP(52) .EQ. 8) THEN + K231= KEEP(239) + K232= KEEP(240) + K233= KEEP(241) + ENDIF + CALL MPI_BCAST(id%DKEEP(3),1,MPI_DOUBLE_PRECISION,MASTER, + & id%COMM,IERR) + IF ( ((KEEP(52).EQ.7).OR.(KEEP(52).EQ.8)) .AND. + & KEEP(54).NE.0 ) THEN + IF ( id%MYID .NE. MASTER ) THEN + IF ( associated(id%COLSCA)) + & DEALLOCATE( id%COLSCA ) + IF ( associated(id%ROWSCA)) + & DEALLOCATE( id%ROWSCA ) + ALLOCATE( id%COLSCA(N), stat=IERR) + IF (IERR .GT.0) THEN + id%INFO(1)=-13 + id%INFO(2)=N + ENDIF + ALLOCATE( id%ROWSCA(N), stat=IERR) + IF (IERR .GT.0) THEN + id%INFO(1)=-13 + id%INFO(2)=N + ENDIF + ENDIF + M = N + BUMAXMN=M + IF(N > BUMAXMN) BUMAXMN = N + LIWK = 4*BUMAXMN + ALLOCATE (IWK(LIWK),BURP(M),BUCP(N), + & BURS(2* (id%NPROCS)),BUCS(2* (id%NPROCS)), + & stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=LIWK+M+N+4* (id%NPROCS) + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 530 + BUJOB = 1 + LWK_REAL = 1 + ALLOCATE(WK_REAL(LWK_REAL)) + CALL ZMUMPS_693( + & MYIRN_loc(1), MYJCN_loc(1), MYA_loc(1), + & id%NZ_loc, + & M, N, id%NPROCS, id%MYID, id%COMM, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + IF(LIWK < BUINTSZ) THEN + DEALLOCATE(IWK) + LIWK = BUINTSZ + ALLOCATE(IWK(LIWK), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=LIWK + ENDIF + ENDIF + LWK_REAL = BURESZ + DEALLOCATE(WK_REAL) + ALLOCATE (WK_REAL(LWK_REAL), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=LWK_REAL + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 530 + BUJOB = 2 + CALL ZMUMPS_693( + & MYIRN_loc(1), MYJCN_loc(1), MYA_loc(1), + & id%NZ_loc, + & M, N, id%NPROCS, id%MYID, id%COMM, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + id%DKEEP(4) = SCONEERR + id%DKEEP(5) = SCINFERR + DEALLOCATE(IWK, WK_REAL,BURP,BUCP,BURS, BUCS) + ELSE IF ( KEEP(54) .EQ. 0 ) THEN + IF ((KEEP(52).EQ.7).OR.(KEEP(52).EQ.8)) THEN + IF (id%MYID.EQ.MASTER) THEN + COLOUR = 0 + ELSE + COLOUR = MPI_UNDEFINED + ENDIF + CALL MPI_COMM_SPLIT( id%COMM, COLOUR, 0, + & COMM_FOR_SCALING, IERR ) + IF (id%MYID.EQ.MASTER) THEN + M = N + BUMAXMN=N + IF(N > BUMAXMN) BUMAXMN = N + LIWK = 1 + ALLOCATE (IWK(LIWK),BURP(1),BUCP(1), + & BURS(1),BUCS(1), + & stat=allocok) + LWK_REAL = M + N + ALLOCATE (WK_REAL(LWK_REAL), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=1 + ENDIF + IF (INFO(1) .LT. 0) GOTO 400 + CALL MPI_COMM_RANK(COMM_FOR_SCALING, SCMYID, IERR) + CALL MPI_COMM_SIZE(COMM_FOR_SCALING, SCNPROCS, IERR) + BUJOB = 1 + CALL ZMUMPS_693( + & id%IRN(1), id%JCN(1), id%A(1), + & id%NZ, + & M, N, SCNPROCS, SCMYID, COMM_FOR_SCALING, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + IF(LWK_REAL < BURESZ) THEN + INFO(1) = -136 + GOTO 400 + ENDIF + BUJOB = 2 + CALL ZMUMPS_693(id%IRN(1), + & id%JCN(1), id%A(1), + & id%NZ, + & M, N, SCNPROCS, SCMYID, COMM_FOR_SCALING, + & BURP, BUCP, + & BURS, BUCS, BUREGISTRE, + & IWK, LIWK, + & BUINTSZ, BURESZ, BUJOB, + & id%ROWSCA(1), id%COLSCA(1), WK_REAL, LWK_REAL, + & id%KEEP(50), + & K231, K232, K233, + & id%DKEEP(3), + & SCONEERR, SCINFERR) + id%DKEEP(4) = SCONEERR + id%DKEEP(5) = SCINFERR + DEALLOCATE(WK_REAL) + DEALLOCATE (IWK,BURP,BUCP, + & BURS,BUCS) + ENDIF + CALL MPI_BCAST( id%DKEEP(4),2,MPI_DOUBLE_PRECISION, + & MASTER, id%COMM, IERR ) + 400 CONTINUE + IF (id%MYID.EQ.MASTER) THEN + CALL MPI_COMM_FREE(COMM_FOR_SCALING, IERR) + ENDIF + CALL MUMPS_276(ICNTL(1), INFO(1), id%COMM, id%MYID) + IF (INFO(1).LT.0) GOTO 530 + ELSE IF (id%MYID.EQ.MASTER) THEN + IF (KEEP(52).GT.0 .AND. KEEP(52).LE.6) THEN + IF ( KEEP(52) .eq. 5 .or. + & KEEP(52) .eq. 6 ) THEN + LWK = NZ + ELSE + LWK = 1 + END IF + LWK_REAL = 5 * N + ALLOCATE( WK_REAL( LWK_REAL ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LWK_REAL + GOTO 137 + END IF + ALLOCATE( WK( LWK ), stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LWK + GOTO 137 + END IF + CALL ZMUMPS_217(N, NZ, KEEP(52), id%A(1), + & id%IRN(1), id%JCN(1), + & id%COLSCA(1), id%ROWSCA(1), + & WK, LWK, WK_REAL, LWK_REAL, ICNTL(1), INFO(1) ) + DEALLOCATE( WK_REAL ) + DEALLOCATE( WK ) + ENDIF + ENDIF + ENDIF + IF (id%MYID.EQ.MASTER) THEN + IF (PROKG.AND.(KEEP(52).EQ.7.OR.KEEP(52).EQ.8) + & .AND. (K233+K231+K232).GT.0) THEN + IF (K232.GT.0) WRITE(MPG, 166) id%DKEEP(4) + ENDIF + ENDIF + ENDIF + LSCAL = (LSCAL .OR. (KEEP(52) .EQ. -1) .OR. KEEP(52) .EQ. -2) + IF (LSCAL .AND. KEEP(258).NE.0 .AND. id%MYID .EQ. MASTER) THEN + DO I = 1, id%N + CALL ZMUMPS_761(id%ROWSCA(I), + & id%DKEEP(6), + & KEEP(259)) + ENDDO + IF (KEEP(50) .EQ. 0) THEN + DO I = 1, id%N + CALL ZMUMPS_761(id%COLSCA(I), + & id%DKEEP(6), + & KEEP(259)) + ENDDO + ELSE + CALL ZMUMPS_765(id%DKEEP(6), KEEP(259)) + ENDIF + CALL ZMUMPS_766(id%DKEEP(6), KEEP(259)) + ENDIF + 137 CONTINUE + IF (associated(id%root%RHS_CNTR_MASTER_ROOT)) THEN + DEALLOCATE (id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY (id%root%RHS_CNTR_MASTER_ROOT) + ENDIF + IF ( id%MYID.EQ.MASTER.AND. KEEP(252).EQ.1 .AND. + & id%NRHS .NE. id%KEEP(253) ) THEN + id%INFO(1)=-42 + id%INFO(2)=id%KEEP(253) + ENDIF + IF (id%KEEP(252) .EQ. 1) THEN + IF ( id%MYID.NE.MASTER ) THEN + id%KEEP(254) = N + id%KEEP(255) = N*id%KEEP(253) + ALLOCATE(RHS_MUMPS(id%KEEP(255)),stat=IERR) + IF (IERR > 0) THEN + INFO(1)=-13 + INFO(2)=id%KEEP(255) + IF (LP > 0) + & WRITE(LP,*) 'ERREUR while allocating RHS on a slave' + NULLIFY(RHS_MUMPS) + ENDIF + RHS_MUMPS_ALLOCATED = .TRUE. + ELSE + id%KEEP(254)=id%LRHS + id%KEEP(255)=id%LRHS*(id%KEEP(253)-1)+id%N + RHS_MUMPS=>id%RHS + RHS_MUMPS_ALLOCATED = .FALSE. + IF (LSCAL) THEN + DO K=1, id%KEEP(253) + DO I=1, N + RHS_MUMPS( id%KEEP(254) * (K-1) + I ) + & = RHS_MUMPS( id%KEEP(254) * (K-1) + I ) + & * id%ROWSCA(I) + ENDDO + ENDDO + ENDIF + ENDIF + DO I= 1, id%KEEP(253) + CALL MPI_BCAST(RHS_MUMPS((I-1)*id%KEEP(254)+1), N, + & MPI_DOUBLE_COMPLEX, MASTER,id%COMM,IERR) + END DO + ELSE + id%KEEP(255)=1 + ALLOCATE(RHS_MUMPS(1)) + RHS_MUMPS_ALLOCATED = .TRUE. + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).lt.0 ) GOTO 530 + KEEP(110)=ICNTL(24) + CALL MPI_BCAST(KEEP(110), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + IF (KEEP(110).NE.1) KEEP(110)=0 + IF (id%MYID .EQ. MASTER) CNTL3 = id%CNTL(3) + CALL MPI_BCAST(CNTL3, 1, MPI_DOUBLE_PRECISION, + & MASTER, id%COMM, IERR) + IF (id%MYID .EQ. MASTER) CNTL5 = id%CNTL(5) + CALL MPI_BCAST(CNTL5, 1, MPI_DOUBLE_PRECISION, + & MASTER, id%COMM, IERR) + IF (id%MYID .EQ. MASTER) CNTL6 = id%CNTL(6) + CALL MPI_BCAST(CNTL6, 1, MPI_DOUBLE_PRECISION, + & MASTER, id%COMM, IERR) + IF (id%MYID .EQ. MASTER) CNTL1 = id%CNTL(1) + CALL MPI_BCAST(CNTL1, 1, MPI_DOUBLE_PRECISION, + & MASTER, id%COMM, IERR) + ANORMINF = ZERO + IF (KEEP(19).EQ.0) THEN + SEUIL = ZERO + ELSE + CALL ZMUMPS_27( id , ANORMINF, LSCAL ) + IF (CNTL6 .LT. ZERO) THEN + SEUIL = EPS*ANORMINF + ELSE + SEUIL = CNTL6*ANORMINF + ENDIF + IF (PROKG) WRITE(MPG,*) + & ' ABSOLUTE PIVOT THRESHOLD for rank revealing =',SEUIL + ENDIF + SEUIL_LDLT_NIV2 = SEUIL + IF (KEEP(110).EQ.0) THEN + id%DKEEP(1) = -1.0D0 + id%DKEEP(2) = ZERO + ELSE + IF (ANORMINF.EQ.ZERO) + & CALL ZMUMPS_27( id , ANORMINF, LSCAL ) + IF (CNTL3 .LT. ZERO) THEN + id%DKEEP(1) = abs(CNTL(3)) + ELSE IF (CNTL3 .GT. ZERO) THEN + id%DKEEP(1) = CNTL3*ANORMINF + ELSE + id%DKEEP(1) = 1.0D-5*EPS*ANORMINF + ENDIF + IF (PROKG) WRITE(MPG,*) + & ' ZERO PIVOT DETECTION ON, THRESHOLD =',id%DKEEP(1) + IF (CNTL5.GT.ZERO) THEN + id%DKEEP(2) = CNTL5 * ANORMINF + IF (PROKG) WRITE(MPG,*) + & ' FIXATION FOR NULL PIVOTS =',id%DKEEP(2) + ELSE + IF (PROKG) WRITE(MPG,*) 'INFINITE FIXATION ' + IF (id%KEEP(50).EQ.0) THEN + id%DKEEP(2) = -max(1.0D10*ANORMINF, + & sqrt(huge(ANORMINF))/1.0D8) + ELSE + id%DKEEP(2) = ZERO + ENDIF + ENDIF + ENDIF + IF (KEEP(53).NE.0) THEN + ID_ROOT =MUMPS_275(id%PROCNODE_STEPS(id%STEP(KEEP(20))), + & id%NSLAVES) + IF ( KEEP( 46 ) .NE. 1 ) THEN + ID_ROOT = ID_ROOT + 1 + END IF + ENDIF + IF ( associated( id%PIVNUL_LIST) ) DEALLOCATE(id%PIVNUL_LIST) + IF(KEEP(110) .EQ. 1) THEN + LPN_LIST = N + ELSE + LPN_LIST = 1 + ENDIF + IF (KEEP(19).NE.0 .AND. + & (ID_ROOT.EQ.id%MYID .OR. id%MYID.EQ.MASTER)) THEN + LPN_LIST = N + ENDIF + ALLOCATE( id%PIVNUL_LIST(LPN_LIST),stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=LPN_LIST + END IF + id%PIVNUL_LIST(1:LPN_LIST) = 0 + KEEP(109) = 0 + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).lt.0 ) GOTO 530 + IF ((KEEP(19).EQ.0).AND.(KEEP(110).EQ.0)) THEN + IF (id%MYID .EQ. MASTER) CNTL4 = id%CNTL(4) + CALL MPI_BCAST( CNTL4, 1, MPI_DOUBLE_PRECISION, + & MASTER, id%COMM, IERR ) + IF ( CNTL4 .GE. ZERO ) THEN + KEEP(97) = 1 + IF ( CNTL4 .EQ. ZERO ) THEN + IF(ANORMINF .EQ. ZERO) THEN + CALL ZMUMPS_27( id , ANORMINF, LSCAL ) + ENDIF + SEUIL = sqrt(EPS) * ANORMINF + ELSE + SEUIL = CNTL4 + ENDIF + SEUIL_LDLT_NIV2 = SEUIL + ELSE + SEUIL = ZERO + ENDIF + ENDIF + KEEP(98) = 0 + KEEP(103) = 0 + KEEP(105) = 0 + MAXS = 1_8 + IF ( id%MYID.EQ.MASTER ) THEN + ITMP = ICNTL(23) + END IF + CALL MPI_BCAST( ITMP, 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + IF (WK_USER_PROVIDED) ITMP = 0 + ITMP8 = int(ITMP, 8) + KEEP8(4) = ITMP8 * 1000000_8 + PERLU = KEEP(12) + IF (KEEP(201) .EQ. 0) THEN + MAXS_BASE8=KEEP8(12) + ELSE + MAXS_BASE8=KEEP8(14) + ENDIF + IF (WK_USER_PROVIDED) THEN + MAXS = KEEP8(24) + ELSE + IF ( MAXS_BASE8 .GT. 0_8 ) THEN + MAXS_BASE_RELAXED8 = + & MAXS_BASE8 + int(PERLU,8) * ( MAXS_BASE8 / 100_8 + 1_8) + IF (MAXS_BASE_RELAXED8 > huge(MAXS)) THEN + WRITE(*,*) "Internal error: I8 overflow" + CALL MUMPS_ABORT() + ENDIF + MAXS_BASE_RELAXED8 = max(MAXS_BASE_RELAXED8, 1_8) + MAXS = MAXS_BASE_RELAXED8 + ELSE + MAXS = 1_8 + MAXS_BASE_RELAXED8 = 1_8 + END IF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1) .LT. 0) THEN + GOTO 530 + ENDIF + IF ((.NOT.WK_USER_PROVIDED).AND.(I_AM_SLAVE)) THEN + IF (KEEP(96).GT.0) THEN + MAXS=int(KEEP(96),8) + ELSE + IF (KEEP8(4) .NE. 0_8) THEN + PERLU_ON = .TRUE. + CALL ZMUMPS_214( id%KEEP(1), id%KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., KEEP(201), + & PERLU_ON, TOTAL_BYTES) + MAXS_BASE_RELAXED8=MAXS_BASE_RELAXED8 + + & (KEEP8(4)-TOTAL_BYTES)/int(KEEP(35),8) + IF (MAXS_BASE_RELAXED8 > int(huge(MAXS),8)) THEN + WRITE(*,*) "Internal error: I8 overflow" + CALL MUMPS_ABORT() + ELSE IF (MAXS_BASE_RELAXED8 .LE. 0_8) THEN + id%INFO(1)=-9 + IF ( -MAXS_BASE_RELAXED8 .GT. + & int(huge(id%INFO(1)),8) ) THEN + WRITE(*,*) "I8: OVERFLOW" + CALL MUMPS_ABORT() + ENDIF + id%INFO(2)=-int(MAXS_BASE_RELAXED8,4) + ELSE + MAXS=MAXS_BASE_RELAXED8 + ENDIF + ENDIF + ENDIF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1) .LT. 0) THEN + GOTO 530 + ENDIF + CALL ZMUMPS_713(PROKG, MPG, MAXS, id%NSLAVES, + & id%COMM, "effective relaxed size of S =") + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (id%INFO(1) .LT. 0) THEN + GOTO 530 + ENDIF + IF ( I_AM_SLAVE ) THEN + CALL ZMUMPS_188( dble(id%COST_SUBTREES), + & KEEP(64), KEEP(66),MAXS ) + K28=KEEP(28) + MEMORY_MD_ARG = min(int(PERLU,8) * ( MAXS_BASE8 / 100_8 + 1_8 ), + & max(0_8, MAXS-MAXS_BASE8)) + CALL ZMUMPS_185( id, MEMORY_MD_ARG, MAXS ) + CALL ZMUMPS_587(id, IERR) + IF (IERR < 0) THEN + INFO(1) = -90 + INFO(2) = 0 + GOTO 112 + ENDIF + IF (KEEP(201) .GT. 0) THEN + IF (KEEP(201).EQ.1 + & .AND.KEEP(50).EQ.0 + & .AND.KEEP(251).NE.2 + & ) THEN + OOC_NB_FILE_TYPE=2 + ELSE + OOC_NB_FILE_TYPE=1 + ENDIF + IF (KEEP(205) .GT. 0) THEN + KEEP(100) = KEEP(205) + ELSE + IF (KEEP(201).EQ.1) THEN + I8TMP = int(OOC_NB_FILE_TYPE,8) * 2_8 * int(KEEP(226),8) + ELSE + I8TMP = 2_8 * KEEP8(119) + ENDIF + I8TMP = I8TMP + int(max(KEEP(12),0),8) * + & (I8TMP/100_8+1_8) + I8TMP = min(I8TMP, 12000000_8) + KEEP(100)=int(I8TMP) + ENDIF + IF (KEEP(201).EQ.1) THEN + IF ( KEEP(99) < 3 ) THEN + KEEP(99) = KEEP(99) + 3 + ENDIF + IF (id%MYID_NODES .eq. MASTER) THEN + write(6,*) ' PANEL: INIT and force STRAT_IO= ', + & id%KEEP(99) + ENDIF + ENDIF + IF (KEEP(99) .LT.3) KEEP(100)=0 + IF((dble(KEEP(100))*dble(KEEP(35))/dble(2)).GT. + & (dble(1999999999)))THEN + IF (PROKG) THEN + WRITE(MPG,*)id%MYID,': Warning: DIM_BUF_IO might be + & too big for Filesystem' + ENDIF + ENDIF + ALLOCATE (id%OOC_INODE_SEQUENCE(KEEP(28), + & OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE*KEEP(28) + NULLIFY(id%OOC_INODE_SEQUENCE) + GOTO 112 + ENDIF + ALLOCATE (id%OOC_TOTAL_NB_NODES(OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE + NULLIFY(id%OOC_TOTAL_NB_NODES) + GOTO 112 + ENDIF + ALLOCATE (id%OOC_SIZE_OF_BLOCK(KEEP(28), + & OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE*KEEP(28) + NULLIFY(id%OOC_SIZE_OF_BLOCK) + GOTO 112 + ENDIF + ALLOCATE (id%OOC_VADDR(KEEP(28),OOC_NB_FILE_TYPE), + & stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = OOC_NB_FILE_TYPE*KEEP(28) + NULLIFY(id%OOC_VADDR) + GOTO 112 + ENDIF + ENDIF + ENDIF + 112 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1) < 0) THEN + GOTO 513 + ENDIF + IF (I_AM_SLAVE) THEN + IF (KEEP(201) .GT. 0) THEN + IF ((KEEP(201).EQ.1).OR.(KEEP(201).EQ.2)) THEN + CALL ZMUMPS_575(id,MAXS) + ELSE + WRITE(*,*) "Internal error in ZMUMPS_142" + CALL MUMPS_ABORT() + ENDIF + IF(INFO(1).LT.0)THEN + GOTO 111 + ENDIF + ENDIF +#if ! defined(OLD_LOAD_MECHANISM) + CALL ZMUMPS_190(0,.FALSE.,dble(id%COST_SUBTREES), + & id%KEEP(1),id%KEEP8(1)) +#endif + IF (INFO(1).LT.0) GOTO 111 +#if defined(stephinfo) + write(*,*) 'proc ',id%MYID,' array of dist : ', + & id%MEM_DIST(0:id%NSLAVES - 1) +#endif + END IF + IF ( associated (id%S) ) THEN + DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF +#if defined (LARGEMATRICES) + IF ( id%MYID .ne. MASTER ) THEN +#endif + IF (.NOT.WK_USER_PROVIDED) THEN + ALLOCATE (id%S(MAXS),stat=IERR) + KEEP8(23) = MAXS + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + CALL MUMPS_735(MAXS, INFO(2)) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + ELSE + id%S => id%WK_USER(1:KEEP8(24)) + ENDIF +#if defined (LARGEMATRICES) + END IF +#endif + 111 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( KEEP(55) .eq. 0 ) THEN + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + IF ( I_AM_SLAVE .and. KEEP(13) .ne. 0 ) THEN + ALLOCATE( id%DBLARR( KEEP(13) ), stat = IERR ) + ELSE + ALLOCATE( id%DBLARR( 1 ), stat =IERR ) + END IF + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID, + & ':Error allocating DBLARR : IERR = ', IERR + INFO(1)=-13 + INFO(2)=KEEP(13) + NULLIFY(id%DBLARR) + GOTO 100 + END IF + ELSE + IF ( associated( id%INTARR ) ) THEN + DEALLOCATE( id%INTARR ) + NULLIFY( id%INTARR ) + END IF + IF ( I_AM_SLAVE .and. KEEP(14) .ne. 0 ) THEN + ALLOCATE( id%INTARR( KEEP(14) ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = KEEP(14) + NULLIFY(id%INTARR) + GOTO 100 + END IF + ELSE + ALLOCATE( id%INTARR(1),stat=allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 1 + NULLIFY(id%INTARR) + GOTO 100 + END IF + END IF + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + IF ( I_AM_SLAVE ) THEN + IF ( id%MYID_NODES .eq. MASTER + & .AND. KEEP(46) .eq. 1 + & .AND. KEEP(52) .eq. 0 ) THEN + id%DBLARR => id%A_ELT + ELSE + IF ( KEEP(13) .ne. 0 ) THEN + ALLOCATE( id%DBLARR( KEEP(13) ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = KEEP(13) + NULLIFY(id%DBLARR) + GOTO 100 + END IF + ELSE + ALLOCATE( id%DBLARR(1), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 1 + NULLIFY(id%DBLARR) + GOTO 100 + END IF + END IF + END IF + ELSE + ALLOCATE( id%DBLARR(1), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + id%INFO(1) = -13 + id%INFO(2) = 1 + NULLIFY(id%DBLARR) + GOTO 100 + END IF + END IF + END IF + IF ( KEEP(38).NE.0 .AND. I_AM_SLAVE ) THEN + CALL ZMUMPS_165( id%N, + & id%root, id%FILS(1), KEEP(38), id%KEEP(1), id%INFO(1) ) + END IF + 100 CONTINUE + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( KEEP( 55 ) .eq. 0 ) THEN + IF (KEEP(38).NE.0 .AND. I_AM_SLAVE) THEN + LWK = numroc( id%root%ROOT_SIZE, id%root%MBLOCK, + & id%root%MYROW, 0, id%root%NPROW ) + LWK = max( 1, LWK ) + LWK = LWK* + & numroc( id%root%ROOT_SIZE, id%root%NBLOCK, + & id%root%MYCOL, 0, id%root%NPCOL ) + LWK = max( 1, LWK ) + ELSE + LWK = 1 + ENDIF + IF (MAXS .LT. int(LWK,8)) THEN + INFO(1) = -9 + INFO(2) = LWK + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( KEEP(54) .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + ALLOCATE(IWK(id%N), stat=allocok) + IF ( allocok .NE. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + END IF +#if defined(LARGEMATRICES) + IF ( associated (id%S) ) THEN + DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + ALLOCATE (WK(LWK),stat=IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LWK + write(6,*) ' PB1 ALLOC LARGEMAT' + ENDIF +#endif + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) GOTO 500 + IF ( id%MYID .eq. MASTER ) THEN + IF (PROKG ) THEN + CALL MUMPS_291(TIME) + END IF + IF ( .not. associated( id%INTARR ) ) THEN + ALLOCATE( id%INTARR( 1 ) ) + ENDIF +#if defined(LARGEMATRICES) + CALL ZMUMPS_148(id%N, NZ, id%A(1), + & id%IRN(1), id%JCN(1), id%SYM_PERM(1), + & LSCAL, id%COLSCA(1), id%ROWSCA(1), + & id%MYID, id%NSLAVES, id%PROCNODE_STEPS(1), + & min(KEEP(39),id%NZ), + & LP, id%COMM, id%root, KEEP,KEEP8, + & id%FILS(1), IWK(1), + & + & id%INTARR(1), id%DBLARR(1), + & id%PTRAR(1), id%PTRAR(id%N+1), + & id%FRERE_STEPS(1), id%STEP(1), WK(1), int(LWK,8), + & id%ISTEP_TO_INIV2, id%I_AM_CAND, + & id%CANDIDATES) + write(6,*) '!!! A,IRN,JCN are freed during facto ' + DEALLOCATE (id%A) + NULLIFY(id%A) + DEALLOCATE (id%IRN) + NULLIFY (id%IRN) + DEALLOCATE (id%JCN) + NULLIFY (id%JCN) + IF (.NOT.WK_USER_PROVIDED) THEN + ALLOCATE (id%S(MAXS),stat=IERR) + KEEP8(23) = MAXS + IF ( IERR .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = MAXS + NULLIFY(id%S) + KEEP8(23)=0_8 + write(6,*) ' PB2 ALLOC LARGEMAT',MAXS + CALL MUMPS_ABORT() + ENDIF + ELSE + id%S => id%WK_USER(1:KEEP8(24)) + ENDIF + id%S(MAXS-LWK+1:MAXS) = WK(1:LWK) + DEALLOCATE (WK) +#else + CALL ZMUMPS_148(id%N, NZ, id%A(1), + & id%IRN(1), id%JCN(1), id%SYM_PERM(1), + & LSCAL, id%COLSCA(1), id%ROWSCA(1), + & id%MYID, id%NSLAVES, id%PROCNODE_STEPS(1), + & min(KEEP(39),id%NZ), + & LP, id%COMM, id%root, KEEP(1),KEEP8(1), + & id%FILS(1), IWK(1), + & + & id%INTARR(1), id%DBLARR(1), + & id%PTRAR(1), id%PTRAR(id%N+1), + & id%FRERE_STEPS(1), id%STEP(1), id%S(1), MAXS, + & id%ISTEP_TO_INIV2(1), id%I_AM_CAND(1), + & id%CANDIDATES(1,1) ) +#endif + DEALLOCATE(IWK) + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,160) TIME + CALL MUMPS_291(TIME) + END IF + ELSE + CALL ZMUMPS_145( id%N, + & id%DBLARR( 1 ), max(1,KEEP( 13 )), + & id%INTARR( 1 ), max(1,KEEP( 14 )), + & id%PTRAR( 1 ), + & id%PTRAR(id%N+1), + & KEEP( 1 ), KEEP8(1), id%MYID, id%COMM, + & min(id%KEEP(39),id%NZ), + & + & id%S(1), MAXS, + & id%root, + & id%PROCNODE_STEPS(1), id%NSLAVES, + & id%SYM_PERM(1), id%FRERE_STEPS(1), id%STEP(1), + & id%INFO(1), id%INFO(2) ) + ENDIF + ELSE + IF (PROKG ) THEN + CALL MUMPS_291(TIME) + END IF + IF ( I_AM_SLAVE ) THEN + NZ_locMAX = 0 + CALL MPI_ALLREDUCE(id%NZ_loc, NZ_locMAX, 1, MPI_INTEGER, + & MPI_MAX, id%COMM_NODES, IERR) + CALL ZMUMPS_282( id%N, + & id%NZ_loc, + & id, + & id%DBLARR(1), KEEP(13), id%INTARR(1), + & KEEP(14), id%PTRAR(1), id%PTRAR(id%N+1), + & KEEP(1), KEEP8(1), id%MYID_NODES, + & id%COMM_NODES, min(id%KEEP(39),NZ_locMAX), + & id%S(1), MAXS, id%root, id%PROCNODE_STEPS(1), + & id%NSLAVES, id%SYM_PERM(1), id%STEP(1), + & id%ICNTL(1), id%INFO(1), NSEND, NLOCAL, + & id%ISTEP_TO_INIV2(1), + & id%CANDIDATES(1,1) ) + IF ( ( KEEP(52).EQ.7 ).OR. (KEEP(52).EQ.8) ) THEN + IF ( id%MYID > 0 ) THEN + IF (associated(id%ROWSCA)) THEN + DEALLOCATE(id%ROWSCA) + NULLIFY(id%ROWSCA) + ENDIF + IF (associated(id%COLSCA)) THEN + DEALLOCATE(id%COLSCA) + NULLIFY(id%COLSCA) + ENDIF + ENDIF + ENDIF +#if defined(LARGEMATRICES) + IF (associated(id%IRN_loc)) THEN + DEALLOCATE(id%IRN_loc) + NULLIFY(id%IRN_loc) + ENDIF + IF (associated(id%JCN_loc)) THEN + DEALLOCATE(id%JCN_loc) + NULLIFY(id%JCN_loc) + ENDIF + IF (associated(id%A_loc)) THEN + DEALLOCATE(id%A_loc) + NULLIFY(id%A_loc) + ENDIF + write(6,*) ' Warning :', + & ' id%A_loc, IRN_loc, JCN_loc deallocated !!! ' +#endif + IF (PROK) THEN + WRITE(MP,120) NLOCAL, NSEND + END IF + END IF + IF ( KEEP(46) .eq. 0 .AND. id%MYID.eq.MASTER ) THEN + NSEND = 0 + NLOCAL = 0 + END IF + CALL MPI_REDUCE( NSEND, NSEND_TOT, 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR ) + CALL MPI_REDUCE( NLOCAL, NLOCAL_TOT, 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR ) + IF ( PROKG ) THEN + WRITE(MPG,125) NLOCAL_TOT, NSEND_TOT + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 500 + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,160) TIME + CALL MUMPS_291(TIME) + END IF + END IF + ELSE + IF (PROKG ) THEN + CALL MUMPS_291(TIME) + END IF + IF ( id%MYID.eq.MASTER) + &CALL ZMUMPS_213( id%ELTPTR(1), + & id%NELT, + & MAXELT_SIZE ) + CALL ZMUMPS_126( id%N, id%NELT, id%NA_ELT, + & id%COMM, id%MYID, + & id%NSLAVES, id%PTRAR(1), + & id%PTRAR(id%NELT+2), + & id%INTARR(1), id%DBLARR(1), + & id%KEEP(1), id%KEEP8(1), MAXELT_SIZE, + & id%FRTPTR(1), id%FRTELT(1), + & id%S(1), MAXS, id%FILS(1), + & id, id%root ) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 500 + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,160) TIME + CALL MUMPS_291(TIME) + END IF + END IF + IF ( I_AM_SLAVE ) THEN + CALL ZMUMPS_528(id%MYID_NODES) + ZMUMPS_LBUFR_BYTES = KEEP( 44 ) * KEEP( 35 ) + ZMUMPS_LBUFR_BYTES = max( ZMUMPS_LBUFR_BYTES, + & 100000 ) + PERLU = KEEP( 12 ) + IF (KEEP(48).EQ.5) THEN + MIN_PERLU=2 + ELSE + MIN_PERLU=0 + ENDIF + ZMUMPS_LBUFR_BYTES = ZMUMPS_LBUFR_BYTES + & + int( 2.0D0 * dble(max(PERLU,MIN_PERLU))* + & dble(ZMUMPS_LBUFR_BYTES)/100D0) + IF (KEEP(48)==5) THEN + KEEP8(21) = KEEP8(22) + int( dble(max(PERLU,MIN_PERLU))* + & dble(KEEP8(22))/100D0,8) + ENDIF + ZMUMPS_LBUF = int( dble(KEEP(213)) / 100.0D0 * + & dble(KEEP(43)) * dble(KEEP(35)) ) + ZMUMPS_LBUF = max( ZMUMPS_LBUF, 100000 ) + ZMUMPS_LBUF = ZMUMPS_LBUF + & + int( 2.0D0 * dble(max(PERLU,MIN_PERLU))* + & dble(ZMUMPS_LBUF)/100D0) + ZMUMPS_LBUF = max(ZMUMPS_LBUF, ZMUMPS_LBUFR_BYTES+3*KEEP(34)) + IF(id%KEEP(48).EQ.4)THEN + ZMUMPS_LBUFR_BYTES=ZMUMPS_LBUFR_BYTES*5 + ZMUMPS_LBUF=ZMUMPS_LBUF*5 + ENDIF + ZMUMPS_LBUF_INT = ( KEEP(56) + id%NSLAVES * id%NSLAVES ) * 5 + & * KEEP(34) + IF ( KEEP( 38 ) .NE. 0 ) THEN + KKKK = MUMPS_275( id%PROCNODE_STEPS(id%STEP(KEEP(38))), + & id%NSLAVES ) + IF ( KKKK .EQ. id%MYID_NODES ) THEN + ZMUMPS_LBUF_INT = ZMUMPS_LBUF_INT + + & 10 * + & 2 * ( id%NE_STEPS(id%STEP(KEEP(38))) + 1 ) * id%NSLAVES + & * KEEP(34) + END IF + END IF + IF ( MP .GT. 0 ) THEN + WRITE( MP, 9999 ) ZMUMPS_LBUFR_BYTES, + & ZMUMPS_LBUF, ZMUMPS_LBUF_INT + END IF + 9999 FORMAT( /,' Allocated buffers',/,' ------------------',/, + & ' Size of reception buffer in bytes ...... = ', I10, + & /, + & ' Size of async. emission buffer (bytes).. = ', I10,/, + & ' Small emission buffer (bytes) .......... = ', I10) + CALL ZMUMPS_55( ZMUMPS_LBUF_INT, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID, + & ':Error allocating small Send buffer:IERR=' + & ,IERR + INFO(1)= -13 + INFO(2)= (ZMUMPS_LBUF_INT+KEEP(34)-1)/KEEP(34) + GO TO 110 + END IF + CALL ZMUMPS_53( ZMUMPS_LBUF, IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating Send buffer:IERR=' + & ,IERR + INFO(1)= -13 + INFO(2)= (ZMUMPS_LBUF+KEEP(34)-1)/KEEP(34) + GO TO 110 + END IF + id%LBUFR_BYTES = ZMUMPS_LBUFR_BYTES + id%LBUFR = (ZMUMPS_LBUFR_BYTES+KEEP(34)-1)/KEEP(34) + IF (associated(id%BUFR)) DEALLOCATE(id%BUFR) + ALLOCATE( id%BUFR( id%LBUFR ),stat=IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating BUFR:IERR=' + & ,IERR + INFO(1)=-13 + INFO(2)=id%LBUFR + NULLIFY(id%BUFR) + GO TO 110 + END IF + PERLU = KEEP( 12 ) + IF (KEEP(201).GT.0) THEN + MAXIS_ESTIM = KEEP(225) + ELSE + MAXIS_ESTIM = KEEP(15) + ENDIF + MAXIS = max( 1, + & MAXIS_ESTIM + 2 * max(PERLU,10) * + & ( MAXIS_ESTIM / 100 + 1 ) + & ) + IF (associated(id%IS)) DEALLOCATE( id%IS ) + ALLOCATE( id%IS( MAXIS ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating IS:IERR=',IERR + INFO(1)=-13 + INFO(2)=MAXIS + NULLIFY(id%IS) + GO TO 110 + END IF + LIW = MAXIS + IF (associated( id%PTLUST_S )) DEALLOCATE(id%PTLUST_S) + ALLOCATE( id%PTLUST_S( id%KEEP(28) ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocatingPTLUST:IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=id%KEEP(28) + NULLIFY(id%PTLUST_S) + GOTO 100 + END IF + IF (associated( id%PTRFAC )) DEALLOCATE(id%PTRFAC) + ALLOCATE( id%PTRFAC( id%KEEP(28) ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocatingPTRFAC:IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=id%KEEP(28) + NULLIFY(id%PTRFAC) + GOTO 100 + END IF + PTRIST = 1 + PTRWB = PTRIST + id%KEEP(28) + ITLOC = PTRWB + 3 * id%KEEP(28) + IPOOL = ITLOC + id%N + id%KEEP(253) + LPOOL = ZMUMPS_505(id%KEEP(1),id%KEEP8(1)) + ALLOCATE( IWK( IPOOL + LPOOL - 1 ), stat = IERR ) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating IWK : IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=IPOOL + LPOOL - 1 + GOTO 110 + END IF + ALLOCATE(IWK8( 2 * id%KEEP(28)), stat = IERR) + IF ( IERR .NE. 0 ) THEN + WRITE(*,*) id%MYID,':Error allocating IWK : IERR = ', + & IERR + INFO(1)=-13 + INFO(2)=2 * id%KEEP(28) + GOTO 110 + END IF + ENDIF + 110 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 500 + IF ( I_AM_SLAVE ) THEN + CALL ZMUMPS_60( id%LBUFR_BYTES ) + IF (MP .GT. 0) THEN + WRITE( MP, 170 ) MAXS, MAXIS, KEEP8(12), KEEP(15), KEEP(13), + & KEEP(14), KEEP8(11), KEEP(26), KEEP(27) + ENDIF + END IF + PERLU_ON = .TRUE. + CALL ZMUMPS_214( id%KEEP(1), id%KEEP8(1), + & id%MYID, id%N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .FALSE., id%KEEP(201), + & PERLU_ON, TOTAL_BYTES) + id%INFO(16) = TOTAL_MBYTES + IF ( MP .gt. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' ** Space in MBYTES used during factorization :', + & id%INFO(16) + END IF + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(16), id%INFOG(18), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Memory relaxation parameter ( ICNTL(14) ) :', + & KEEP(12) + WRITE( MPG,'(A,I10) ') + & ' ** Rank of processor needing largest memory in facto :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Space in MBYTES used by this processor for facto :', + & id%INFOG(18) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during facto :', + & ( id%INFOG(19)-id%INFO(16) ) / id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during facto :', + & id%INFOG(19) / id%NSLAVES + END IF + END IF + KEEP8(31)= 0_8 + KEEP8(10) = 0_8 + KEEP8(8)=0_8 + INFO(9:14)=0 + RINFO(2:3)=ZERO + IF ( I_AM_SLAVE ) THEN + IF ( KEEP(55) .eq. 0 ) THEN + LDPTRAR = id%N + ELSE + LDPTRAR = id%NELT + 1 + END IF + IF ( id%KEEP(55) .NE. 0 ) THEN + NELT = id%NELT + ELSE + NELT = 1 + END IF + CALL ZMUMPS_244( id%N, NSTEPS, id%S(1), + & MAXS, id%IS( 1 ), LIW, + & id%SYM_PERM(1), id%NA(1), id%LNA, id%NE_STEPS(1), + & id%ND_STEPS(1), id%FILS(1), id%STEP(1), + & id%FRERE_STEPS(1), id%DAD_STEPS(1), id%CANDIDATES(1,1), + & id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & id%PTRAR(1), LDPTRAR, IWK( PTRIST ), + & id%PTLUST_S(1), id%PTRFAC(1), IWK( PTRWB ), + & IWK8, + & IWK( ITLOC ), RHS_MUMPS(1), IWK( IPOOL ), LPOOL, + & CNTL1, ICNTL(1), INFO(1), RINFO(1), KEEP(1),KEEP8(1), + & id%PROCNODE_STEPS(1), + & id%NSLAVES, id%COMM_NODES, + & id%MYID, id%MYID_NODES, + & id%BUFR(1),id%LBUFR,id%LBUFR_BYTES, + & id%INTARR(1), id%DBLARR(1), id%root, + & NELT, id%FRTPTR(1), + & id%FRTELT(1), id%COMM_LOAD, id%ASS_IRECV, SEUIL, + & SEUIL_LDLT_NIV2, id%MEM_DIST(0), + & id%DKEEP(1),id%PIVNUL_LIST(1),LPN_LIST) + IF ( MP . GT. 0 .and. KEEP(38) .ne. 0 ) THEN + WRITE( MP, 175 ) KEEP(49) + END IF + DEALLOCATE( IWK ) + DEALLOCATE( IWK8 ) + ENDIF + IF ( KEEP(55) .eq. 0 ) THEN + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + ELSE + DEALLOCATE( id%INTARR) + NULLIFY( id%INTARR ) + IF ( id%MYID_NODES .eq. MASTER + & .AND. KEEP(46) .eq. 1 + & .AND. KEEP(52) .eq. 0 ) THEN + NULLIFY( id%DBLARR ) + ELSE + IF (associated( id%DBLARR)) THEN + DEALLOCATE(id%DBLARR) + NULLIFY(id%DBLARR) + ENDIF + END IF + END IF + IF ( KEEP(19) .NE. 0 ) THEN + IF ( KEEP(46) .NE. 1 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_RECV( KEEP(17), 1, MPI_INTEGER, 1, DEFIC_TAG, + & id%COMM, STATUS, IERR ) + ELSE IF ( id%MYID .EQ. 1 ) THEN + CALL MPI_SEND( KEEP(17), 1, MPI_INTEGER, 0, DEFIC_TAG, + & id%COMM, IERR ) + END IF + END IF + END IF + IF (associated(id%BUFR)) THEN + DEALLOCATE(id%BUFR) + NULLIFY(id%BUFR) + END IF + CALL ZMUMPS_57( IERR ) + CALL ZMUMPS_59( IERR ) + IF (KEEP(219).NE.0) THEN + CALL ZMUMPS_620() + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + CALL ZMUMPS_770(id) + IF (KEEP(201) .GT. 0) THEN + IF ((KEEP(201).EQ.1) .OR. (KEEP(201).EQ.2)) THEN + IF ( I_AM_SLAVE ) THEN + CALL ZMUMPS_591(IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + ENDIF + ENDIF + CALL MUMPS_276( id%ICNTL(1), id%INFO(1), + & id%COMM, id%MYID ) + END IF + END IF + IF ( PROKG ) THEN + CALL MUMPS_292(TIME) + WRITE(MPG,180) TIME + END IF + PERLU_ON = .TRUE. + CALL ZMUMPS_214( id%KEEP(1),id%KEEP8(1), + & id%MYID, N, id%NELT, id%LNA, id%NZ, + & id%NA_ELT, + & id%NSLAVES, TOTAL_MBYTES, .TRUE., id%KEEP(201), + & PERLU_ON, TOTAL_BYTES) + KEEP8(7) = TOTAL_BYTES + id%INFO(22) = TOTAL_MBYTES + IF ( MP .gt. 0 ) THEN + WRITE(MP,'(A,I10) ') + & ' ** Effective minimum Space in MBYTES for facto :', + & TOTAL_MBYTES + ENDIF + IF (I_AM_SLAVE) THEN + K67 = KEEP8(67) + ELSE + K67 = 0_8 + ENDIF + CALL MUMPS_735(K67,id%INFO(21)) + CALL ZMUMPS_713(PROKG, MPG, K67, id%NSLAVES, + & id%COMM, "effective space used in S (KEEP8(67) =") + CALL MUMPS_243( id%MYID, id%COMM, + & TOTAL_MBYTES, id%INFOG(21), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Rank of processor needing largest memory :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Space in MBYTES used by this processor :', + & id%INFOG(21) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Avg. Space in MBYTES per working proc :', + & ( id%INFOG(22)-TOTAL_MBYTES ) / id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** EFF Min: Avg. Space in MBYTES per working proc :', + & id%INFOG(22) / id%NSLAVES + END IF + END IF + KEEP(33) = INFO(11) + CALL MPI_REDUCE( RINFO(2), RINFOG(2), 2, + & MPI_DOUBLE_PRECISION, + & MPI_SUM, MASTER, id%COMM, IERR) + KEEP(247) = 0 + CALL MPI_REDUCE( KEEP(246), KEEP(247), 1, MPI_INTEGER, + & MPI_MAX, MASTER, id%COMM, IERR) + CALL MPI_REDUCE( RINFO(2), RINFOG(2), 2, + & MPI_DOUBLE_PRECISION, + & MPI_SUM, MASTER, id%COMM, IERR) + CALL MUMPS_646( KEEP8(31),KEEP8(6), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735(KEEP8(6), INFOG(9)) + CALL MPI_REDUCE( INFO(10), INFOG(10), 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + CALL MPI_ALLREDUCE( INFO(11), INFOG(11), 1, MPI_INTEGER, + & MPI_MAX, id%COMM, IERR) + KEEP(133) = INFOG(11) + CALL MPI_REDUCE( INFO(12), INFOG(12), 3, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + CALL MPI_REDUCE( KEEP(103), INFOG(25), 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + KEEP(229) = INFOG(25) + CALL MPI_REDUCE( KEEP(105), INFOG(25), 1, MPI_INTEGER, + & MPI_SUM, MASTER, id%COMM, IERR) + KEEP(230) = INFOG(25) + INFO(25) = KEEP(98) + CALL MPI_ALLREDUCE( INFO(25), INFOG(25), 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR) + CALL MUMPS_646( KEEP8(8), KEEP8(108), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735(KEEP8(10), INFO(27)) + CALL MUMPS_646( KEEP8(10),KEEP8(110), MPI_SUM, + & MASTER, id%COMM ) + CALL MUMPS_735(KEEP8(110), INFOG(29)) + IF (KEEP(258).NE.0) THEN + IF (KEEP(260).EQ.-1) THEN + id%DKEEP(6)=-id%DKEEP(6) + id%DKEEP(7)=-id%DKEEP(7) + ENDIF + CALL ZMUMPS_764( + & id%COMM, id%DKEEP(6), KEEP(259), + & RINFOG(12), INFOG(34), id%NPROCS) + IF (id%KEEP(50).EQ.0 .AND. id%MYID.EQ. MASTER) THEN + IF (id%KEEP(23).NE.0) THEN + CALL ZMUMPS_767( + & RINFOG(12), id%N, + & id%STEP(1), + & id%UNS_PERM(1) ) + ENDIF + ENDIF + ENDIF + IF(KEEP(110) .EQ. 1) THEN + INFO(18) = KEEP(109) + CALL MPI_ALLREDUCE( KEEP(109), KEEP(112), 1, MPI_INTEGER, + & MPI_SUM, id%COMM, IERR) + ELSE + INFO(18) = 0 + KEEP(109) = 0 + KEEP(112) = 0 + ENDIF + INFOG(28)=KEEP(112)+KEEP(17) + IF (KEEP(17) .NE. 0) THEN + IF (id%MYID .EQ. ID_ROOT) THEN + INFO(18)=INFO(18)+KEEP(17) + ENDIF + IF (ID_ROOT .EQ. MASTER) THEN + IF (id%MYID.EQ.MASTER) THEN + DO I=1, KEEP(17) + id%PIVNUL_LIST(KEEP(112)+I)=id%PIVNUL_LIST(KEEP(109)+I) + ENDDO + ENDIF + ELSE + IF (id%MYID .EQ. ID_ROOT) THEN + CALL MPI_SEND(id%PIVNUL_LIST(KEEP(109)+1), KEEP(17), + & MPI_INTEGER, MASTER, ZERO_PIV, + & id%COMM, IERR) + ELSE IF (id%MYID .EQ. MASTER) THEN + CALL MPI_RECV(id%PIVNUL_LIST(KEEP(112)+1), KEEP(17), + & MPI_INTEGER, ID_ROOT, ZERO_PIV, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + ENDIF + IF(KEEP(110) .EQ. 1) THEN + ALLOCATE(ITMP2(id%NPROCS),stat = IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%NPROCS + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF (INFO(1).LT.0) GOTO 490 + CALL MPI_GATHER ( KEEP(109),1, MPI_INTEGER, + & ITMP2(1), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR) + IF(id%MYID .EQ. MASTER) THEN + POSBUF = ITMP2(1)+1 + KEEP(220)=1 + DO I = 1,id%NPROCS-1 + CALL MPI_RECV(id%PIVNUL_LIST(POSBUF), ITMP2(I+1), + & MPI_INTEGER,I, + & ZERO_PIV, id%COMM, STATUS, IERR) + CALL MPI_SEND(POSBUF, 1, MPI_INTEGER, I, ZERO_PIV, + & id%COMM, IERR) + POSBUF = POSBUF + ITMP2(I+1) + ENDDO + ELSE + CALL MPI_SEND( id%PIVNUL_LIST(1), KEEP(109), MPI_INTEGER, + & MASTER,ZERO_PIV, id%COMM, IERR) + CALL MPI_RECV( KEEP(220), 1, MPI_INTEGER, MASTER, ZERO_PIV, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + 490 IF (allocated(ITMP2)) DEALLOCATE(ITMP2) + IF ( PROKG ) THEN + WRITE(MPG,99984) RINFOG(2),RINFOG(3),KEEP8(6),INFOG(10), + & INFOG(11), KEEP8(110) + IF (id%KEEP(50) == 0) THEN + WRITE(MPG, 99985) INFOG(12) + END IF + IF (id%KEEP(50) .NE. 1) THEN + WRITE(MPG, 99982) INFOG(13) + END IF + IF (KEEP(97) .NE. 0) THEN + WRITE(MPG, 99986) KEEP(98) + ENDIF + IF (id%KEEP(50) == 2) THEN + WRITE(MPG, 99988) KEEP(229) + WRITE(MPG, 99989) KEEP(230) + ENDIF + IF (KEEP(110) .NE.0) THEN + WRITE(MPG, 99991) KEEP(112) + ENDIF + IF ( KEEP(17) .ne. 0 ) + & WRITE(MPG, 99983) KEEP(17) + IF (KEEP(110).NE.0.OR.KEEP(17).NE.0) + & WRITE(MPG, 99992) KEEP(17)+KEEP(112) + WRITE(MPG, 99981) INFOG(14) + IF ((KEEP(201).EQ.0.OR.KEEP(201).EQ.2).AND. + & KEEP(50).EQ.0) THEN + WRITE(MPG, 99980) KEEP8(108) + ENDIF + IF ((KEEP(60).NE.0) .AND. INFOG(25).GT.0) THEN + WRITE(MPG, '(A)') + & " ** Warning Static pivoting was necessary" + WRITE(MPG, '(A)') + & " ** to factor interior variables with Schur ON" + ENDIF + IF (KEEP(258).NE.0) THEN + WRITE(MPG,99978) RINFOG(12) + WRITE(MPG,99979) RINFOG(13) + WRITE(MPG,99977) INFOG(34) + ENDIF + END IF + 500 CONTINUE + IF ( I_AM_SLAVE ) THEN + IF ((KEEP(201).EQ.1).OR.(KEEP(201).EQ.2)) THEN + CALL ZMUMPS_592(id,IERR) + IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR + ENDIF + IF (WK_USER_PROVIDED) THEN + NULLIFY(id%S) + ELSE IF (KEEP(201).NE.0) THEN + IF (associated(id%S)) DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + ELSE + IF (WK_USER_PROVIDED) THEN + NULLIFY(id%S) + ELSE + IF (associated(id%S)) DEALLOCATE(id%S) + NULLIFY(id%S) + KEEP8(23)=0_8 + END IF + END IF + 513 CONTINUE + IF ( I_AM_SLAVE ) THEN + CALL ZMUMPS_183( INFO(1), IERR ) + IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + 530 CONTINUE + IF (RHS_MUMPS_ALLOCATED) DEALLOCATE(RHS_MUMPS) + NULLIFY(RHS_MUMPS) + id%KEEP(13) = KEEP13_SAVE + RETURN + 120 FORMAT(/' LOCAL REDISTRIB: DATA LOCAL/SENT =',I12,I12) + 125 FORMAT(/' REDISTRIB: TOTAL DATA LOCAL/SENT =',I12,I12) + 130 FORMAT(/' ****** FACTORIZATION STEP ********'/) + 160 FORMAT(' GLOBAL TIME FOR MATRIX DISTRIBUTION =',F12.4) + 165 FORMAT(' Convergence error after scaling for INF-NORM', + & ' (option 7/8) =',D9.2) + 166 FORMAT(' Convergence error after scaling for ONE-NORM', + & ' (option 7/8) =',D9.2) + 170 FORMAT(/' STATISTICS PRIOR NUMERICAL FACTORIZATION ...'/ + & ' Size of internal working array S =',I12/ + & ' Size of internal working array IS =',I12/ + & ' MINIMUM (ICNTL(14)=0) size of S =',I12/ + & ' MINIMUM (ICNTL(14)=0) size of IS =',I12/ + & ' REAL SPACE FOR ORIGINAL MATRIX =',I12/ + & ' INTEGER SPACE FOR ORIGINAL MATRIX =',I12/ + & ' REAL SPACE FOR FACTORS =',I12/ + & ' INTEGER SPACE FOR FACTORS =',I12/ + & ' MAXIMUM FRONTAL SIZE (ESTIMATED) =',I12) + 172 FORMAT(/' GLOBAL STATISTICS PRIOR NUMERICAL FACTORIZATION ...'/ + & ' NUMBER OF WORKING PROCESSES =',I12/ + & ' OUT-OF-CORE OPTION (ICNTL(22)) =',I12/ + & ' REAL SPACE FOR FACTORS =',I12/ + & ' INTEGER SPACE FOR FACTORS =',I12/ + & ' MAXIMUM FRONTAL SIZE (ESTIMATED) =',I12/ + & ' NUMBER OF NODES IN THE TREE =',I12) + 173 FORMAT( ' PERFORM FORWARD DURING FACTO, NRHS =',I12) + 175 FORMAT(/' NUMBER OF ENTRIES FOR // ROOT =',I12) + 180 FORMAT(/' ELAPSED TIME FOR FACTORIZATION =',F12.4) +99977 FORMAT( ' INFOG(34) DETERMINANT (base 2 exponent) =',I12) +99978 FORMAT( ' RINFOG(12) DETERMINANT (real part) =',F12.4) +99979 FORMAT( ' RINFOG(12) DETERMINANT (imaginary part) =',F12.4) +99980 FORMAT( ' KEEP8(108) Extra copies IP stacking =',I12) +99981 FORMAT( ' INFOG(14) NUMBER OF MEMORY COMPRESS =',I12) +99982 FORMAT( ' INFOG(13) NUMBER OF DELAYED PIVOTS =',I12) +99983 FORMAT( ' NB OF NULL PIVOTS DETECTED BY ICNTL(16) =',I12) +99991 FORMAT( ' NB OF NULL PIVOTS DETECTED BY ICNTL(24) =',I12) +99992 FORMAT( ' INFOG(28) ESTIMATED DEFICIENCY =',I12) +99984 FORMAT(/' GLOBAL STATISTICS '/ + & ' RINFOG(2) OPERATIONS IN NODE ASSEMBLY =',1PD10.3/ + & ' ------(3) OPERATIONS IN NODE ELIMINATION=',1PD10.3/ + & ' INFOG (9) REAL SPACE FOR FACTORS =',I12/ + & ' INFOG(10) INTEGER SPACE FOR FACTORS =',I12/ + & ' INFOG(11) MAXIMUM FRONT SIZE =',I12/ + & ' INFOG(29) NUMBER OF ENTRIES IN FACTORS =',I12) +99985 FORMAT( ' INFOG(12) NB OF OFF DIAGONAL PIVOTS =',I12) +99986 FORMAT( ' INFOG(25) NB TINY PIVOTS/STATIC PIVOTING =',I12) +99988 FORMAT( ' NUMBER OF 2x2 PIVOTS in type 1 nodes =',I12) +99989 FORMAT( ' NUMBER OF 2x2 PIVOTS in type 2 nodes =',I12) + END SUBROUTINE ZMUMPS_142 + SUBROUTINE ZMUMPS_713(PROKG, MPG, VAL, NSLAVES, + & COMM, MSG) + IMPLICIT NONE + INCLUDE 'mpif.h' + LOGICAL PROKG + INTEGER MPG + INTEGER(8) VAL + INTEGER NSLAVES + INTEGER COMM + CHARACTER*42 MSG + INTEGER(8) MAX_VAL + INTEGER IERR, MASTER + DOUBLE PRECISION LOC_VAL, AVG_VAL + PARAMETER(MASTER=0) + CALL MUMPS_646( VAL, MAX_VAL, MPI_MAX, MASTER, COMM) + LOC_VAL = dble(VAL)/dble(NSLAVES) + CALL MPI_REDUCE( LOC_VAL, AVG_VAL, 1, MPI_DOUBLE_PRECISION, + & MPI_SUM, MASTER, COMM, IERR ) + IF (PROKG) THEN + WRITE(MPG,100) " Maximum ", MSG, MAX_VAL + WRITE(MPG,100) " Average ", MSG, int(AVG_VAL,8) + ENDIF + RETURN + 100 FORMAT(A9,A42,I12) + END SUBROUTINE ZMUMPS_713 + SUBROUTINE ZMUMPS_770(id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE(ZMUMPS_STRUC) :: id + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INCLUDE 'mumps_headers.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER IERR, MASTER + PARAMETER( MASTER = 0 ) + INTEGER :: ID_SCHUR, SIZE_SCHUR, LD_SCHUR, IB, BL4 + INTEGER :: ROW_LENGTH, I + INTEGER(8) :: SURFSCHUR8, BL8, SHIFT8 + INTEGER(8) :: ISCHUR_SRC, ISCHUR_DEST, ISCHUR_SYM, ISCHUR_UNS + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + IF (id%INFO(1) .LT. 0) RETURN + IF (id%KEEP(60) .EQ. 0) RETURN + ID_SCHUR =MUMPS_275( + & id%PROCNODE_STEPS(id%STEP(max(id%KEEP(20),id%KEEP(38)))), + & id%NSLAVES) + IF ( id%KEEP( 46 ) .NE. 1 ) THEN + ID_SCHUR = ID_SCHUR + 1 + END IF + IF (id%MYID.EQ.ID_SCHUR) THEN + IF (id%KEEP(60).EQ.1) THEN + LD_SCHUR = + & id%IS(id%PTLUST_S(id%STEP(id%KEEP(20)))+2+id%KEEP(IXSZ)) + SIZE_SCHUR = LD_SCHUR - id%KEEP(253) + ELSE + LD_SCHUR = -999999 + SIZE_SCHUR = id%root%TOT_ROOT_SIZE + ENDIF + ELSE IF (id%MYID .EQ. MASTER) THEN + SIZE_SCHUR = id%KEEP(116) + LD_SCHUR = -44444 + ELSE + RETURN + ENDIF + SURFSCHUR8 = int(SIZE_SCHUR,8)*int(SIZE_SCHUR,8) + IF (id%KEEP(60) .GT. 1) THEN + IF (id%KEEP(221).EQ.1) THEN + DO I = 1, id%KEEP(253) + IF (ID_SCHUR.EQ.MASTER) THEN + CALL zcopy(SIZE_SCHUR, + & id%root%RHS_CNTR_MASTER_ROOT((I-1)*SIZE_SCHUR+1), 1, + & id%REDRHS((I-1)*id%LREDRHS+1), 1) + ELSE + IF (id%MYID.EQ.ID_SCHUR) THEN + CALL MPI_SEND( + & id%root%RHS_CNTR_MASTER_ROOT((I-1)*SIZE_SCHUR+1), + & SIZE_SCHUR, + & MPI_DOUBLE_COMPLEX, + & MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE + CALL MPI_RECV( id%REDRHS((I-1)*id%LREDRHS+1), + & SIZE_SCHUR, + & MPI_DOUBLE_COMPLEX, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + ENDDO + IF (id%MYID.EQ.ID_SCHUR) THEN + DEALLOCATE(id%root%RHS_CNTR_MASTER_ROOT) + NULLIFY (id%root%RHS_CNTR_MASTER_ROOT) + ENDIF + ENDIF + RETURN + ENDIF + IF (id%KEEP(252).EQ.0) THEN + IF ( ID_SCHUR .EQ. MASTER ) THEN + CALL ZMUMPS_756( SURFSCHUR8, + & id%S(id%PTRFAC(id%STEP(id%KEEP(20)))), + & id%SCHUR(1) ) + ELSE + BL8=int(huge(BL4)/id%KEEP(35)/10,8) + DO IB=1, int((SURFSCHUR8+BL8-1_8) / BL8) + SHIFT8 = int(IB-1,8) * BL8 + BL4 = int(min(BL8,SURFSCHUR8-SHIFT8)) + IF ( id%MYID .eq. ID_SCHUR ) THEN + CALL MPI_SEND( id%S( SHIFT8 + + & id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ)))), + & BL4, + & MPI_DOUBLE_COMPLEX, + & MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_RECV( id%SCHUR(1_8 + SHIFT8), + & BL4, + & MPI_DOUBLE_COMPLEX, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + END IF + ENDDO + END IF + ELSE + ISCHUR_SRC = id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ))) + ISCHUR_DEST= 1_8 + DO I=1, SIZE_SCHUR + ROW_LENGTH = SIZE_SCHUR + IF (ID_SCHUR.EQ.MASTER) THEN + CALL zcopy(ROW_LENGTH, id%S(ISCHUR_SRC), 1, + & id%SCHUR(ISCHUR_DEST),1) + ELSE + IF (id%MYID.EQ.ID_SCHUR) THEN + CALL MPI_SEND( id%S(ISCHUR_SRC), ROW_LENGTH, + & MPI_DOUBLE_COMPLEX, + & MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE + CALL MPI_RECV( id%SCHUR(ISCHUR_DEST), + & ROW_LENGTH, + & MPI_DOUBLE_COMPLEX, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + ISCHUR_SRC = ISCHUR_SRC+int(LD_SCHUR,8) + ISCHUR_DEST= ISCHUR_DEST+int(SIZE_SCHUR,8) + ENDDO + IF (id%KEEP(221).EQ.1) THEN + ISCHUR_SYM = id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ))) + int(SIZE_SCHUR,8) * + & int(LD_SCHUR,8) + ISCHUR_UNS = + & id%PTRFAC(id%IS(id%PTLUST_S(id%STEP(id%KEEP(20))) + & +4+id%KEEP(IXSZ))) + int(SIZE_SCHUR,8) + ISCHUR_DEST = 1_8 + DO I = 1, id%KEEP(253) + IF (ID_SCHUR .EQ. MASTER) THEN + IF (id%KEEP(50) .EQ. 0) THEN + CALL zcopy(SIZE_SCHUR, id%S(ISCHUR_UNS), LD_SCHUR, + & id%REDRHS(ISCHUR_DEST), 1) + ELSE + CALL zcopy(SIZE_SCHUR, id%S(ISCHUR_SYM), 1, + & id%REDRHS(ISCHUR_DEST), 1) + ENDIF + ELSE + IF (id%MYID .NE. MASTER) THEN + IF (id%KEEP(50) .EQ. 0) THEN + CALL zcopy(SIZE_SCHUR, id%S(ISCHUR_UNS), LD_SCHUR, + & id%S(ISCHUR_SYM), 1) + ENDIF + CALL MPI_SEND(id%S(ISCHUR_SYM), SIZE_SCHUR, + & MPI_DOUBLE_COMPLEX, MASTER, TAG_SCHUR, + & id%COMM, IERR ) + ELSE + CALL MPI_RECV(id%REDRHS(ISCHUR_DEST), + & SIZE_SCHUR, MPI_DOUBLE_COMPLEX, ID_SCHUR, TAG_SCHUR, + & id%COMM, STATUS, IERR ) + ENDIF + ENDIF + IF (id%KEEP(50).EQ.0) THEN + ISCHUR_UNS = ISCHUR_UNS + int(LD_SCHUR,8) + ELSE + ISCHUR_SYM = ISCHUR_SYM + int(LD_SCHUR,8) + ENDIF + ISCHUR_DEST = ISCHUR_DEST + int(id%LREDRHS,8) + ENDDO + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_770 + SUBROUTINE ZMUMPS_83 + & ( N, MAPPING, NZ, IRN, JCN, PROCNODE, STEP, + & SLAVEF, PERM, FILS, + & RG2L, KEEP,KEEP8, MBLOCK, NBLOCK, NPROW, NPCOL ) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N, NZ, SLAVEF, MBLOCK, NBLOCK, NPROW, NPCOL + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IRN( NZ ), JCN( NZ ) + INTEGER MAPPING( NZ ), STEP( N ) + INTEGER PROCNODE( KEEP(28) ), PERM( N ), FILS( N ), RG2L( N ) + INTEGER MUMPS_275, MUMPS_330 + EXTERNAL MUMPS_275, MUMPS_330 + INTEGER K, IOLD, JOLD, INEW, JNEW, ISEND, JSEND, IARR, INODE + INTEGER TYPE_NODE, DEST + INTEGER IPOSROOT, JPOSROOT, IROW_GRID, JCOL_GRID + INODE = KEEP(38) + K = 1 + DO WHILE ( INODE .GT. 0 ) + RG2L( INODE ) = K + INODE = FILS( INODE ) + K = K + 1 + END DO + DO K = 1, NZ + IOLD = IRN( K ) + JOLD = JCN( K ) + IF ( IOLD .GT. N .OR. IOLD .LT. 1 .OR. + & JOLD .GT. N .OR. JOLD .LT. 1 ) THEN + MAPPING( K ) = -1 + CYCLE + END IF + IF ( IOLD .eq. JOLD ) THEN + ISEND = IOLD + JSEND = JOLD + ELSE + INEW = PERM( IOLD ) + JNEW = PERM( JOLD ) + IF ( INEW .LT. JNEW ) THEN + ISEND = IOLD + IF ( KEEP(50) .ne. 0 ) ISEND = -IOLD + JSEND = JOLD + ELSE + ISEND = -JOLD + JSEND = IOLD + END IF + END IF + IARR = abs( ISEND ) + TYPE_NODE = MUMPS_330( PROCNODE(abs(STEP(IARR))), + & SLAVEF ) + IF ( TYPE_NODE .eq. 1 .or. TYPE_NODE .eq. 2 ) THEN + IF ( KEEP(46) .eq. 0 ) THEN + DEST = MUMPS_275( PROCNODE(abs(STEP(IARR))), + & SLAVEF ) + 1 + ELSE + DEST = MUMPS_275( PROCNODE(abs(STEP(IARR))), + & SLAVEF ) + END IF + ELSE + IF ( ISEND .LT. 0 ) THEN + IPOSROOT = RG2L( JSEND ) + JPOSROOT = RG2L( IARR ) + ELSE + IPOSROOT = RG2L( IARR ) + JPOSROOT = RG2L( JSEND ) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/MBLOCK, NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/NBLOCK, NPCOL ) + IF ( KEEP( 46 ) .eq. 0 ) THEN + DEST = IROW_GRID * NPCOL + JCOL_GRID + 1 + ELSE + DEST = IROW_GRID * NPCOL + JCOL_GRID + END IF + END IF + MAPPING( K ) = DEST + END DO + RETURN + END SUBROUTINE ZMUMPS_83 + SUBROUTINE ZMUMPS_282( + & N, NZ_loc, id, + & DBLARR, LDBLARR, INTARR, LINTARR, + & PTRAIW, PTRARW, KEEP,KEEP8, MYID, COMM, NBRECORDS, + & + & A, LA, root, PROCNODE_STEPS, SLAVEF, PERM, STEP, + & ICNTL, INFO, NSEND, NLOCAL, + & ISTEP_TO_INIV2, CANDIDATES + & ) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + INTEGER N, NZ_loc + TYPE (ZMUMPS_STRUC) :: id + INTEGER LDBLARR, LINTARR + COMPLEX(kind=8) DBLARR( LDBLARR ) + INTEGER INTARR( LINTARR ) + INTEGER PTRAIW( N ), PTRARW( N ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER MYID, COMM, NBRECORDS + INTEGER(8) :: LA + INTEGER SLAVEF + INTEGER ISTEP_TO_INIV2(KEEP(71)) + INTEGER CANDIDATES(SLAVEF+1, max(1,KEEP(56))) + COMPLEX(kind=8) A( LA ) + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER PROCNODE_STEPS(KEEP(28)), PERM( N ), STEP( N ) + INTEGER INFO( 40 ), ICNTL(40) + INTEGER MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + EXTERNAL MUMPS_275, MUMPS_330, numroc, + & MUMPS_810 + INCLUDE 'mumps_tags.h' + INCLUDE 'mpif.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ), MSGSOU + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IW4 + INTEGER END_MSG_2_RECV + INTEGER I, K, I1, IA + INTEGER TYPE_NODE, DEST + INTEGER IOLD, JOLD, IARR, ISEND, JSEND, INEW, JNEW + INTEGER allocok, TYPESPLIT, T4MASTER, INIV2 + LOGICAL T4_MASTER_CONCERNED + COMPLEX(kind=8) VAL + INTEGER(8) :: PTR_ROOT + INTEGER LOCAL_M, LOCAL_N, ARROW_ROOT + INTEGER IROW_GRID, JCOL_GRID, IPOSROOT, JPOSROOT + INTEGER MP,LP + INTEGER KPROBE, FREQPROBE + INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: BUFI + COMPLEX(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: BUFR + INTEGER, ALLOCATABLE, DIMENSION(:) :: BUFRECI + COMPLEX(kind=8), ALLOCATABLE, DIMENSION(:) :: BUFRECR + INTEGER IACT( SLAVEF ), IREQI( SLAVEF ), IREQR( SLAVEF ) + LOGICAL SEND_ACTIVE( SLAVEF ) + LOGICAL FLAG + INTEGER NSEND, NLOCAL + INTEGER MASTER_NODE, ISTEP + NSEND = 0 + NLOCAL = 0 + LP = ICNTL(1) + MP = ICNTL(2) + END_MSG_2_RECV = SLAVEF + ALLOCATE( BUFI( NBRECORDS * 2 + 1, 2, SLAVEF ), stat=allocok) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating int buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = ( NBRECORDS * 2 + 1 ) * SLAVEF * 2 + END IF + ALLOCATE( BUFR( NBRECORDS, 2, SLAVEF), stat = allocok) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating real buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = NBRECORDS * SLAVEF * 2 + GOTO 20 + END IF + ALLOCATE( BUFRECI( NBRECORDS * 2 + 1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating int recv buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = NBRECORDS * 2 + 1 + GOTO 20 + END IF + ALLOCATE( BUFRECR( NBRECORDS ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF ( LP > 0 ) THEN + WRITE(LP,*) + & '** Error allocating int recv buffer for matrix distribution' + END IF + INFO(1) = -13 + INFO(2) = NBRECORDS + GOTO 20 + END IF + ALLOCATE( IW4( N, 2 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(LP,*) '** Error allocating IW4 for matrix distribution' + INFO(1) = -13 + INFO(2) = N * 2 + END IF + 20 CONTINUE + CALL MUMPS_276( ICNTL, INFO, COMM, MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + ARROW_ROOT = 0 + DO I = 1, N + I1 = PTRAIW( I ) + IA = PTRARW( I ) + IF ( IA .GT. 0 ) THEN + DBLARR( IA ) = ZERO + IW4( I, 1 ) = INTARR( I1 ) + IW4( I, 2 ) = -INTARR( I1 + 1 ) + INTARR( I1 + 2 ) = I + END IF + END DO + IF ( KEEP(38) .NE. 0 ) THEN + IF (KEEP(60)==0) THEN + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8 + IF ( PTR_ROOT .LE. LA ) THEN + A( PTR_ROOT:LA ) = ZERO + END IF + ELSE + DO I = 1, root%SCHUR_NLOC + root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1: + & (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC) = ZERO + ENDDO + ENDIF + END IF + DO I = 1, SLAVEF + BUFI( 1, 1, I ) = 0 + END DO + DO I = 1, SLAVEF + BUFI( 1, 2, I ) = 0 + END DO + DO I = 1, SLAVEF + SEND_ACTIVE( I ) = .FALSE. + IACT( I ) = 1 + END DO + KPROBE = 0 + FREQPROBE = max(1,NBRECORDS/10) + DO K = 1, NZ_loc + KPROBE = KPROBE + 1 + IF ( KPROBE .eq. FREQPROBE ) THEN + KPROBE = 0 + CALL MPI_IPROBE( MPI_ANY_SOURCE, ARR_INT, COMM, + & FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + MSGSOU = STATUS( MPI_SOURCE ) + CALL MPI_RECV( BUFRECI(1), NBRECORDS * 2 + 1, + & MPI_INTEGER, + & MSGSOU, ARR_INT, COMM, STATUS, IERR ) + CALL MPI_RECV( BUFRECR(1), NBRECORDS, MPI_DOUBLE_COMPLEX, + & MSGSOU, ARR_REAL, COMM, STATUS, IERR ) + CALL ZMUMPS_102( + & BUFRECI, BUFRECR, NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END IF + END IF + IOLD = id%IRN_loc(K) + JOLD = id%JCN_loc(K) + IF ( (IOLD.GT.N).OR.(JOLD.GT.N).OR.(IOLD.LT.1) + & .OR.(JOLD.LT.1) ) CYCLE + VAL = id%A_loc(K) + IF ((KEEP(52).EQ.7).OR.(KEEP(52).EQ.8)) THEN + VAL = VAL * id%ROWSCA(IOLD)*id%COLSCA(JOLD) + ENDIF + IF (IOLD.EQ.JOLD) THEN + ISEND = IOLD + JSEND = JOLD + ELSE + INEW = PERM(IOLD) + JNEW = PERM(JOLD) + IF (INEW.LT.JNEW) THEN + ISEND = IOLD + IF ( KEEP(50) .NE. 0 ) ISEND = -IOLD + JSEND = JOLD + ELSE + ISEND = -JOLD + JSEND = IOLD + ENDIF + ENDIF + IARR = abs( ISEND ) + ISTEP = abs(STEP(IARR)) + TYPE_NODE = MUMPS_330( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + MASTER_NODE= MUMPS_275( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + TYPESPLIT = MUMPS_810( PROCNODE_STEPS(ISTEP), + & SLAVEF ) + T4_MASTER_CONCERNED = .FALSE. + T4MASTER = -9999 + IF (TYPE_NODE.EQ.2) THEN + INIV2 = ISTEP_TO_INIV2(ISTEP) + IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6)) THEN + T4_MASTER_CONCERNED = .TRUE. + T4MASTER=CANDIDATES(CANDIDATES(SLAVEF+1,INIV2)+1,INIV2) + ENDIF + ENDIF + IF ( TYPE_NODE .eq. 1 ) THEN + DEST = MASTER_NODE + ELSE IF ( TYPE_NODE .eq. 2 ) THEN + IF ( ISEND .LT. 0 ) THEN + DEST = -1 + ELSE + DEST = MASTER_NODE + END IF + ELSE + IF ( ISEND < 0 ) THEN + IPOSROOT = root%RG2L_ROW(JSEND) + JPOSROOT = root%RG2L_ROW(IARR ) + ELSE + IPOSROOT = root%RG2L_ROW(IARR ) + JPOSROOT = root%RG2L_ROW(JSEND) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, root%NPCOL ) + DEST = IROW_GRID * root%NPCOL + JCOL_GRID + END IF + if (DEST .eq. -1) then + NLOCAL = NLOCAL + 1 + NSEND = NSEND + SLAVEF -1 + else + if (DEST .eq.MYID ) then + NLOCAL = NLOCAL + 1 + else + NSEND = NSEND + 1 + endif + end if + IF ( DEST.EQ.-1) THEN + DO I=1, CANDIDATES(SLAVEF+1,ISTEP_TO_INIV2(ISTEP)) + DEST=CANDIDATES(I,ISTEP_TO_INIV2(ISTEP)) + CALL ZMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + ENDDO + DEST=MASTER_NODE + CALL ZMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + IF (T4_MASTER_CONCERNED) THEN + DEST = T4MASTER + CALL ZMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + ENDIF + ELSE + CALL ZMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + IF (T4_MASTER_CONCERNED) THEN + DEST = T4MASTER + CALL ZMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4(1,1), + & root, KEEP,KEEP8 ) + ENDIF + ENDIF + END DO + DEST = -2 + CALL ZMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, + & N, PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, + & IW4(1,1), root, KEEP,KEEP8 ) + DO WHILE ( END_MSG_2_RECV .NE. 0 ) + CALL MPI_RECV( BUFRECI(1), NBRECORDS * 2 + 1, MPI_INTEGER, + & MPI_ANY_SOURCE, ARR_INT, COMM, STATUS, IERR ) + MSGSOU = STATUS( MPI_SOURCE ) + CALL MPI_RECV( BUFRECR(1), NBRECORDS, MPI_DOUBLE_COMPLEX, + & MSGSOU, ARR_REAL, COMM, STATUS, IERR ) + CALL ZMUMPS_102( + & BUFRECI, BUFRECR, NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END DO + DO I = 1, SLAVEF + IF ( SEND_ACTIVE( I ) ) THEN + CALL MPI_WAIT( IREQI( I ), STATUS, IERR ) + CALL MPI_WAIT( IREQR( I ), STATUS, IERR ) + END IF + END DO + KEEP(49) = ARROW_ROOT + DEALLOCATE( IW4 ) + DEALLOCATE( BUFI ) + DEALLOCATE( BUFR ) + DEALLOCATE( BUFRECI ) + DEALLOCATE( BUFRECR ) + RETURN + END SUBROUTINE ZMUMPS_282 + SUBROUTINE ZMUMPS_101( DEST, ISEND, JSEND, VAL, + & BUFI, BUFR, BUFRECI, BUFRECR, + & NBRECORDS, SLAVEF, COMM, MYID, IACT, IREQI, IREQR, + & SEND_ACTIVE, INTARR, LINTARR, DBLARR, LDBLARR, N, + & PTRAIW, PTRARW, PERM, STEP, ARROW_ROOT, END_MSG_2_RECV, + & PROCNODE_STEPS, A, LA, PTR_ROOT, LOCAL_M, LOCAL_N, IW4, root, + & KEEP,KEEP8 ) + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER ISEND, JSEND, DEST, NBRECORDS, SLAVEF, COMM, MYID, N + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER ARROW_ROOT, END_MSG_2_RECV, LOCAL_M, LOCAL_N + INTEGER LINTARR, LDBLARR + INTEGER(8) :: LA, PTR_ROOT + INTEGER BUFI( NBRECORDS * 2 + 1, 2, SLAVEF ) + INTEGER BUFRECI( NBRECORDS * 2 + 1 ) + INTEGER IREQI(SLAVEF), IREQR(SLAVEF), IACT(SLAVEF) + INTEGER IW4( N, 2 ) + INTEGER PTRAIW( N ), PTRARW( N ), PERM( N ), STEP( N ) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER INTARR( LINTARR ) + COMPLEX(kind=8) DBLARR( LDBLARR ), A( LA ) + LOGICAL SEND_ACTIVE(SLAVEF) + COMPLEX(kind=8) BUFR( NBRECORDS, 2, SLAVEF ) + COMPLEX(kind=8) BUFRECR( NBRECORDS ) + COMPLEX(kind=8) VAL + INTEGER ISLAVE, IBEG, IEND, NBREC, IREQ + INTEGER TAILLE_SEND_I, TAILLE_SEND_R, MSGSOU + LOGICAL FLAG, SEND_LOCAL + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, STATUS(MPI_STATUS_SIZE) + IF ( DEST .eq. -2 ) THEN + IBEG = 1 + IEND = SLAVEF + ELSE + IBEG = DEST + 1 + IEND = DEST + 1 + END IF + SEND_LOCAL = .FALSE. + DO ISLAVE = IBEG, IEND + NBREC = BUFI(1,IACT(ISLAVE),ISLAVE) + IF ( DEST .eq. -2 ) THEN + BUFI(1,IACT(ISLAVE),ISLAVE) = - NBREC + END IF + IF ( DEST .eq. -2 .or. NBREC + 1 > NBRECORDS ) THEN + DO WHILE ( SEND_ACTIVE( ISLAVE ) ) + CALL MPI_TEST( IREQR( ISLAVE ), FLAG, STATUS, IERR ) + IF ( .NOT. FLAG ) THEN + CALL MPI_IPROBE( MPI_ANY_SOURCE, ARR_INT, COMM, + & FLAG, STATUS, IERR ) + IF ( FLAG ) THEN + MSGSOU = STATUS(MPI_SOURCE) + CALL MPI_RECV( BUFRECI(1), 2*NBRECORDS+1, + & MPI_INTEGER, MSGSOU, ARR_INT, COMM, + & STATUS, IERR ) + CALL MPI_RECV( BUFRECR(1), NBRECORDS, + & MPI_DOUBLE_COMPLEX, MSGSOU, + & ARR_REAL, COMM, STATUS, IERR ) + CALL ZMUMPS_102( + & BUFRECI, BUFRECR, NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END IF + ELSE + CALL MPI_WAIT( IREQI( ISLAVE ), STATUS, IERR ) + SEND_ACTIVE( ISLAVE ) = .FALSE. + END IF + END DO + IF ( ISLAVE - 1 .ne. MYID ) THEN + TAILLE_SEND_I = NBREC * 2 + 1 + TAILLE_SEND_R = NBREC + CALL MPI_ISEND( BUFI(1, IACT(ISLAVE), ISLAVE ), + & TAILLE_SEND_I, + & MPI_INTEGER, ISLAVE - 1, ARR_INT, COMM, + & IREQI( ISLAVE ), IERR ) + CALL MPI_ISEND( BUFR(1, IACT(ISLAVE), ISLAVE ), + & TAILLE_SEND_R, + & MPI_DOUBLE_COMPLEX, ISLAVE - 1, ARR_REAL, COMM, + & IREQR( ISLAVE ), IERR ) + SEND_ACTIVE( ISLAVE ) = .TRUE. + ELSE + SEND_LOCAL = .TRUE. + END IF + IACT( ISLAVE ) = 3 - IACT( ISLAVE ) + BUFI( 1, IACT( ISLAVE ), ISLAVE ) = 0 + END IF + IF ( DEST .ne. -2 ) THEN + IREQ = BUFI(1,IACT(ISLAVE),ISLAVE) + 1 + BUFI(1,IACT(ISLAVE),ISLAVE) = IREQ + BUFI(IREQ*2,IACT(ISLAVE),ISLAVE) = ISEND + BUFI(IREQ*2+1,IACT(ISLAVE),ISLAVE) = JSEND + BUFR(IREQ,IACT(ISLAVE),ISLAVE ) = VAL + END IF + END DO + IF ( SEND_LOCAL ) THEN + ISLAVE = MYID + 1 + CALL ZMUMPS_102( + & BUFI(1,3-IACT(ISLAVE),ISLAVE), + & BUFR(1,3-IACT(ISLAVE),ISLAVE), + & NBRECORDS, N, IW4(1,1), + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, + & A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, SLAVEF, + & ARROW_ROOT, PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR + & ) + END IF + RETURN + END SUBROUTINE ZMUMPS_101 + SUBROUTINE ZMUMPS_102 + & ( BUFI, BUFR, NBRECORDS, N, IW4, + & KEEP,KEEP8, LOCAL_M, LOCAL_N, root, PTR_ROOT, A, LA, + & END_MSG_2_RECV, MYID, PROCNODE_STEPS, + & SLAVEF, ARROW_ROOT, + & PTRAIW, PTRARW, PERM, STEP, + & INTARR, LINTARR, DBLARR, LDBLARR ) + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER NBRECORDS, N, ARROW_ROOT, MYID, SLAVEF + INTEGER BUFI( NBRECORDS * 2 + 1 ) + COMPLEX(kind=8) BUFR( NBRECORDS ) + INTEGER IW4( N, 2 ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER END_MSG_2_RECV + INTEGER PTRAIW( N ), PTRARW( N ), PERM( N ), STEP( N ) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER LINTARR, LDBLARR + INTEGER INTARR( LINTARR ) + INTEGER LOCAL_M, LOCAL_N + INTEGER(8) :: PTR_ROOT, LA + COMPLEX(kind=8) A( LA ), DBLARR( LDBLARR ) + INTEGER MUMPS_330, MUMPS_275 + EXTERNAL MUMPS_330, MUMPS_275 + INTEGER IREC, NB_REC, NODE_TYPE, IPROC + INTEGER IPOSROOT, JPOSROOT, IROW_GRID, JCOL_GRID, + & ILOCROOT, JLOCROOT + INTEGER IA, IS1, ISHIFT, IIW, IS, IAS, IARR, JARR + INTEGER TAILLE + COMPLEX(kind=8) VAL + NB_REC = BUFI( 1 ) + IF ( NB_REC .LE. 0 ) THEN + END_MSG_2_RECV = END_MSG_2_RECV - 1 + NB_REC = - NB_REC + END IF + IF ( NB_REC .eq. 0 ) GOTO 100 + DO IREC = 1, NB_REC + IARR = BUFI( IREC * 2 ) + JARR = BUFI( IREC * 2 + 1 ) + VAL = BUFR( IREC ) + NODE_TYPE = MUMPS_330( + & PROCNODE_STEPS(abs(STEP(abs( IARR )))), + & SLAVEF ) + IF ( NODE_TYPE .eq. 3 ) THEN + ARROW_ROOT = ARROW_ROOT + 1 + IF ( IARR .GT. 0 ) THEN + IPOSROOT = root%RG2L_ROW( IARR ) + JPOSROOT = root%RG2L_COL( JARR ) + ELSE + IPOSROOT = root%RG2L_ROW( JARR ) + JPOSROOT = root%RG2L_COL( -IARR ) + END IF + IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK, root%NPROW ) + JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK, root%NPCOL ) + IF ( IROW_GRID .NE. root%MYROW .OR. + & JCOL_GRID .NE. root%MYCOL ) THEN + WRITE(*,*) MYID,':INTERNAL Error: recvd root arrowhead ' + WRITE(*,*) MYID,':not belonging to me. IARR,JARR=',IARR,JARR + WRITE(*,*) MYID,':IROW_GRID,JCOL_GRID=',IROW_GRID,JCOL_GRID + WRITE(*,*) MYID,':MYROW, MYCOL=', root%MYROW, root%MYCOL + WRITE(*,*) MYID,':IPOSROOT,JPOSROOT=', IPOSROOT, JPOSROOT + CALL MUMPS_ABORT() + END IF + ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOSROOT - 1, root%MBLOCK ) + 1 + JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOSROOT - 1, root%NBLOCK ) + 1 + IF (KEEP(60)==0) THEN + A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8) + & + int(ILOCROOT-1,8)) = A( PTR_ROOT + & + int(JLOCROOT - 1,8) * int(LOCAL_M,8) + & + int(ILOCROOT - 1,8) ) + & + VAL + ELSE + root%SCHUR_POINTER( int(JLOCROOT-1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8) ) + & = root%SCHUR_POINTER( int(JLOCROOT - 1,8) + & * int(root%SCHUR_LLD,8) + & + int(ILOCROOT,8)) + & + VAL + ENDIF + ELSE IF (IARR.GE.0) THEN + IF (IARR.EQ.JARR) THEN + IA = PTRARW(IARR) + DBLARR(IA) = DBLARR(IA) + VAL + ELSE + IS1 = PTRAIW(IARR) + ISHIFT = INTARR(IS1) + IW4(IARR,2) + IW4(IARR,2) = IW4(IARR,2) - 1 + IIW = IS1 + ISHIFT + 2 + INTARR(IIW) = JARR + IS = PTRARW(IARR) + IAS = IS + ISHIFT + DBLARR(IAS) = VAL + ENDIF + ELSE + IARR = -IARR + ISHIFT = PTRAIW(IARR)+IW4(IARR,1)+2 + INTARR(ISHIFT) = JARR + IAS = PTRARW(IARR)+IW4(IARR,1) + IW4(IARR,1) = IW4(IARR,1) - 1 + DBLARR(IAS) = VAL + IPROC = MUMPS_275( PROCNODE_STEPS(abs(STEP(IARR))), + & SLAVEF ) + IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0) + & .AND. + & IW4(IARR,1) .EQ. 0 .AND. + & IPROC .EQ. MYID + & .AND. STEP(IARR) > 0 ) THEN + TAILLE = INTARR( PTRAIW(IARR) ) + CALL ZMUMPS_310( N, PERM, + & INTARR( PTRAIW(IARR) + 3 ), + & DBLARR( PTRARW(IARR) + 1 ), + & TAILLE, 1, TAILLE ) + END IF + ENDIF + ENDDO + 100 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_102 + SUBROUTINE ZMUMPS_151( NRHS, N, KEEP28, IWCB, LIWW, + & W, LWC, + & POSWCB,IWPOSCB,PTRICB,PTRACB) + IMPLICIT NONE + INTEGER NRHS, N,LIWW,LWC,POSWCB,IWPOSCB, KEEP28 + INTEGER IWCB(LIWW),PTRICB(KEEP28),PTRACB(KEEP28) + COMPLEX(kind=8) W(LWC) + INTEGER SIZFI, SIZFR + IF ( IWPOSCB .eq. LIWW ) RETURN + DO WHILE ( IWCB( IWPOSCB + 2 ) .eq. 0 ) + SIZFR = IWCB( IWPOSCB + 1 ) + SIZFI = 2 + SIZFR = SIZFR * NRHS + IWPOSCB = IWPOSCB + SIZFI + POSWCB = POSWCB + SIZFR + IF ( IWPOSCB .eq. LIWW ) RETURN + END DO + RETURN + END SUBROUTINE ZMUMPS_151 + SUBROUTINE ZMUMPS_95(NRHS,N,KEEP28,IWCB,LIWW,W,LWC, + & POSWCB,IWPOSCB,PTRICB,PTRACB) + IMPLICIT NONE + INTEGER NRHS,N,LIWW,LWC,POSWCB,IWPOSCB,KEEP28 + INTEGER IWCB(LIWW),PTRICB(KEEP28),PTRACB(KEEP28) + COMPLEX(kind=8) W(LWC) + INTEGER IPTIW,IPTA,SIZFI,SIZFR,LONGI,LONGR + INTEGER I + IPTIW = IWPOSCB + IPTA = POSWCB + LONGI = 0 + LONGR = 0 + IF ( IPTIW .EQ. LIWW ) RETURN +10 CONTINUE + IF (IWCB(IPTIW+2).EQ.0) THEN + SIZFR = IWCB(IPTIW+1) + SIZFI = 2 + SIZFR = SIZFR * NRHS + IF (LONGI.NE.0) THEN + DO 20 I=0,LONGI-1 + IWCB(IPTIW + SIZFI - I) = IWCB (IPTIW - I ) + 20 CONTINUE + DO 30 I=0,LONGR-1 + W(IPTA + SIZFR - I) = W(IPTA - I ) + 30 CONTINUE + ENDIF + DO 40 I=1,KEEP28 + IF ((PTRICB(I).LE.(IPTIW+1)).AND. + & (PTRICB(I).GT.IWPOSCB) ) THEN + PTRICB(I) = PTRICB(I) + SIZFI + PTRACB(I) = PTRACB(I) + SIZFR + ENDIF +40 CONTINUE + IWPOSCB = IWPOSCB + SIZFI + IPTIW = IPTIW + SIZFI + POSWCB = POSWCB + SIZFR + IPTA = IPTA + SIZFR + ELSE + SIZFR = IWCB(IPTIW+1) + SIZFI = 2 + SIZFR = SIZFR * NRHS + IPTIW = IPTIW + SIZFI + LONGI = LONGI + SIZFI + IPTA = IPTA + SIZFR + LONGR = LONGR + SIZFR + ENDIF + IF (IPTIW.NE.LIWW) GOTO 10 + RETURN + END SUBROUTINE ZMUMPS_95 + SUBROUTINE ZMUMPS_205(MTYPE, IFLAG, N, NZ, + & LHS, WRHS, W, RHS, GIVSOL, SOL, ANORM, XNORM, SCLNRM, + & MPRINT, ICNTL, KEEP,KEEP8) + INTEGER MTYPE,N,NZ,IFLAG,ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + COMPLEX(kind=8) RHS(N),LHS(N) + COMPLEX(kind=8) WRHS(N),SOL(*) + DOUBLE PRECISION W(N) + DOUBLE PRECISION RESMAX,RESL2,XNORM, ERMAX,MAXSOL, + & COMAX, SCLNRM, ERL2, ERREL + DOUBLE PRECISION ANORM,DZERO,EPSI + LOGICAL GIVSOL,PROK + INTEGER MPRINT, MP + INTEGER K + INTRINSIC abs, max, sqrt + MP = ICNTL(2) + PROK = (MPRINT .GT. 0) + DZERO = 0.0D0 + EPSI = 0.1D-9 + ANORM = DZERO + RESMAX = DZERO + RESL2 = DZERO + DO 40 K = 1, N + RESMAX = max(RESMAX, abs(RHS(K))) + RESL2 = RESL2 + abs(RHS(K)) * abs(RHS(K)) + ANORM = max(ANORM, W(K)) + 40 CONTINUE + XNORM = DZERO + DO 50 K = 1, N + XNORM = max(XNORM, abs(LHS(K))) + 50 CONTINUE + IF (XNORM .GT. EPSI) THEN + SCLNRM = RESMAX / (ANORM * XNORM) + ELSE + IFLAG = IFLAG + 2 + IF ((MP .GT. 0) .AND. (ICNTL(4) .GE. 2)) WRITE( MP, * ) + &' max-NORM of computed solut. is zero' + SCLNRM = RESMAX / ANORM + ENDIF + RESL2 = sqrt(RESL2) + ERMAX = DZERO + COMAX = DZERO + ERL2 = DZERO + IF (.NOT.GIVSOL) THEN + IF (PROK) WRITE( MPRINT, 90 ) RESMAX, RESL2, ANORM, XNORM, + & SCLNRM + ELSE + MAXSOL = DZERO + DO 60 K = 1, N + MAXSOL = max(MAXSOL, abs(SOL(K))) + 60 CONTINUE + DO 70 K = 1, N + ERL2 = abs(LHS(K) - SOL(K)) ** 2 + ERL2 + ERMAX = max(ERMAX, abs(LHS(K) - SOL(K))) + 70 CONTINUE + DO 80 K = 1, N + IF (abs(SOL(K)) .GT. EPSI) THEN + COMAX = max(COMAX, (abs(LHS(K) - SOL(K)) / abs(SOL(K)))) + ENDIF + 80 CONTINUE + ERL2 = sqrt(ERL2) + IF (MAXSOL .GT. EPSI) THEN + ERREL = ERMAX / MAXSOL + ELSE + IFLAG = IFLAG + 2 + IF ((MP .GT. 0) .AND. (ICNTL(4) .GE. 2)) WRITE( MP, * ) + &' MAX-NORM of exact solution is zero' + ERREL = ERMAX + ENDIF + IF (PROK) WRITE( MPRINT, 100 ) ERMAX, ERL2, ERREL, COMAX, RESMAX + & , RESL2, ANORM, XNORM, SCLNRM + ENDIF + 90 FORMAT (/' RESIDUAL IS ............ (MAX-NORM) =',1PD9.2/ + & ' .. (2-NORM) =',1PD9.2/ + & ' RINFOG(4):NORM OF input Matrix (MAX-NORM)=',1PD9.2/ + & ' RINFOG(5):NORM OF Computed SOLUT (MAX-NORM)=',1PD9.2/ + & ' RINFOG(6):SCALED RESIDUAL ...... (MAX-NORM)=',1PD9.2) + RETURN + 100 FORMAT (/' ERROR IS ............ (MAX-NORM) =',1PD9.2/ + & ' ............ (2-NORM) =',1PD9.2/ + & ' RELATIVE ERROR........... (MAX-NORM) =',1PD9.2/ + & ' Comp. Wise ERROR......... (MAX-NORM) =',1PD9.2/ + & ' AND RESIDUAL IS ......... (MAX-NORM) =',1PD9.2/ + & ' .. (2-NORM) =',1PD9.2/ + & ' NORM OF input MATRIX ... (MAX-NORM) =',1PD9.2/ + & ' NORM of computed SOLUT... (MAX-NORM) =',1PD9.2/ + & ' SCALED RESIDUAL ......... (MAX-NORM) =',1PD9.2) + END SUBROUTINE ZMUMPS_205 + SUBROUTINE ZMUMPS_206(NZ, N, RHS, + & X, Y, D, R_W, C_W, IW, KASE, + & OMEGA, ERX, JOB, COND, MAXIT, NOITER, LP, KEEP,KEEP8, + & ARRET ) + IMPLICIT NONE + INTEGER NZ, N, KASE, KEEP(500), JOB + INTEGER(8) KEEP8(150) + INTEGER IW(N,2) + COMPLEX(kind=8) RHS(N) + COMPLEX(kind=8) X(N), Y(N) + DOUBLE PRECISION D(N) + DOUBLE PRECISION R_W(N,2) + COMPLEX(kind=8) C_W(N) + INTEGER LP, MAXIT, NOITER + DOUBLE PRECISION COND(2),OMEGA(2) + DOUBLE PRECISION ARRET + DOUBLE PRECISION CGCE, CTAU + DATA CTAU /1.0D3/, CGCE /0.2D0/ + LOGICAL LCOND1, LCOND2 + INTEGER IFLAG, JUMP, I, IMAX + DOUBLE PRECISION ERX, DXMAX + DOUBLE PRECISION CONVER, OM1, OM2, DXIMAX + DOUBLE PRECISION ZERO, ONE,TAU, DD + DOUBLE PRECISION OLDOMG(2) + INTEGER ZMUMPS_IXAMAX + INTRINSIC abs, max + SAVE LCOND1, LCOND2, JUMP, DXIMAX, DXMAX, CONVER, + & OM1, OLDOMG, IFLAG + DATA ZERO /0.0D0/, ONE /1.0D0/ + IF (KASE .EQ. 0) THEN + LCOND1 = .FALSE. + LCOND2 = .FALSE. + COND(1) = ONE + COND(2) = ONE + ERX = ZERO + OM1 = ZERO + IFLAG = 0 + NOITER = 0 + JUMP = 1 + ENDIF + SELECT CASE (JUMP) + CASE (1) + GOTO 30 + CASE(2) + GOTO 10 + CASE(3) + GOTO 110 + CASE(4) + GOTO 150 + CASE(5) + GOTO 35 + CASE DEFAULT + END SELECT + 10 CONTINUE + DO 20 I = 1, N + X(I) = X(I) + Y(I) + 20 CONTINUE + IF (NOITER .GT. MAXIT) THEN + IFLAG = IFLAG + 8 + GOTO 70 + ENDIF + 30 CONTINUE + KASE = 14 + JUMP = 5 + RETURN + 35 CONTINUE + IMAX = ZMUMPS_IXAMAX(N, X, 1) + DXMAX = abs(X(IMAX)) + OMEGA(1) = ZERO + OMEGA(2) = ZERO + DO 40 I = 1, N + TAU = (R_W(I, 2) * DXMAX + abs(RHS(I))) * dble(N) * CTAU + DD = R_W(I, 1) + abs(RHS(I)) + IF ((DD + TAU) .GT. TAU) THEN + OMEGA(1) = max(OMEGA(1), abs(Y(I)) / DD) + IW(I, 1) = 1 + ELSE + IF (TAU .GT. ZERO) THEN + OMEGA(2) = max(OMEGA(2), + & abs(Y(I)) / (DD + R_W(I, 2) * DXMAX)) + ENDIF + IW(I, 1) = 2 + ENDIF + 40 CONTINUE + OM2 = OMEGA(1) + OMEGA(2) + IF (OM2 .LT. ARRET ) GOTO 70 + IF (MAXIT .EQ. 0) GOTO 70 + IF (NOITER .GT. 1 .AND. OM2 .GT. OM1 * CGCE) THEN + CONVER = OM2 / OM1 + IF (OM2 .GT. OM1) THEN + OMEGA(1) = OLDOMG(1) + OMEGA(2) = OLDOMG(2) + DO 50 I = 1, N + X(I) = C_W(I) + 50 CONTINUE + ENDIF + GOTO 70 + ENDIF + DO 60 I = 1, N + C_W(I) = X(I) + 60 CONTINUE + OLDOMG(1) = OMEGA(1) + OLDOMG(2) = OMEGA(2) + OM1 = OM2 + NOITER = NOITER + 1 + KASE = 2 + JUMP = 2 + RETURN + 70 KASE = 0 + IF (JOB .LE. 0) GOTO 170 + DO 80 I = 1, N + IF (IW(I, 1) .EQ. 1) THEN + R_W(I, 1) = R_W(I, 1) + abs(RHS(I)) + R_W(I, 2) = ZERO + LCOND1 = .TRUE. + ELSE + R_W(I, 2) = R_W(I, 2) * DXMAX + R_W(I, 1) + R_W(I, 1) = ZERO + LCOND2 = .TRUE. + ENDIF + 80 CONTINUE + DO 90 I = 1, N + C_W(I) = X(I) * D(I) + 90 CONTINUE + IMAX = ZMUMPS_IXAMAX(N, C_W(1), 1) + DXIMAX = abs(C_W(IMAX)) + IF (.NOT.LCOND1) GOTO 130 + 100 CALL ZMUMPS_218(N, KASE, Y, COND(1), C_W, IW(1, 2)) + IF (KASE .EQ. 0) GOTO 120 + IF (KASE .EQ. 1) CALL ZMUMPS_204(N, Y, D) + IF (KASE .EQ. 2) CALL ZMUMPS_204(N, Y, R_W) + JUMP = 3 + RETURN + 110 CONTINUE + IF (KASE .EQ. 1) CALL ZMUMPS_204(N, Y, R_W) + IF (KASE .EQ. 2) CALL ZMUMPS_204(N, Y, D) + GOTO 100 + 120 IF (DXIMAX .GT. ZERO) COND(1) = COND(1) / DXIMAX + ERX = OMEGA(1) * COND(1) + 130 IF (.NOT.LCOND2) GOTO 170 + KASE = 0 + 140 CALL ZMUMPS_218(N, KASE, Y, COND(2), C_W, IW(1, 2)) + IF (KASE .EQ. 0) GOTO 160 + IF (KASE .EQ. 1) CALL ZMUMPS_204(N, Y, D) + IF (KASE .EQ. 2) CALL ZMUMPS_204(N, Y, R_W(1, 2)) + JUMP = 4 + RETURN + 150 CONTINUE + IF (KASE .EQ. 1) CALL ZMUMPS_204(N, Y, R_W(1, 2)) + IF (KASE .EQ. 2) CALL ZMUMPS_204(N, Y, D) + GOTO 140 + 160 IF (DXIMAX .GT. ZERO) THEN + COND(2) = COND(2) / DXIMAX + ENDIF + ERX = ERX + OMEGA(2) * COND(2) + 170 KASE = -IFLAG + RETURN + END SUBROUTINE ZMUMPS_206 + SUBROUTINE ZMUMPS_207(A, NZ, N, IRN, ICN, Z, KEEP,KEEP8) + INTEGER NZ, N, I, J, K, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IRN(NZ), ICN(NZ) + COMPLEX(kind=8) A(NZ) + DOUBLE PRECISION Z(N) + DOUBLE PRECISION ZERO + INTRINSIC abs + DATA ZERO /0.0D0/ + DO 10 I = 1, N + Z(I) = ZERO + 10 CONTINUE + IF (KEEP(50) .EQ.0) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)) + IF (J.NE.I) THEN + Z(J) = Z(J) + abs(A(K)) + ENDIF + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_207 + SUBROUTINE ZMUMPS_289(A, NZ, N, IRN, ICN, Z, + & KEEP, KEEP8, COLSCA) + INTEGER, intent(in) :: NZ, N, KEEP(500) + INTEGER(8), intent(in) :: KEEP8(150) + INTEGER, intent(in) :: IRN(NZ), ICN(NZ) + COMPLEX(kind=8), intent(in) :: A(NZ) + DOUBLE PRECISION, intent(in) :: COLSCA(N) + DOUBLE PRECISION, intent(out) :: Z(N) + DOUBLE PRECISION ZERO + DATA ZERO /0.0D0/ + INTEGER I, J, K + DO 10 I = 1, N + Z(I) = ZERO + 10 CONTINUE + IF (KEEP(50) .EQ.0) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)*COLSCA(J)) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LT. 1) .OR. (I .GT. N)) CYCLE + IF ((J .LT. 1) .OR. (J .GT. N)) CYCLE + Z(I) = Z(I) + abs(A(K)*COLSCA(J)) + IF (J.NE.I) THEN + Z(J) = Z(J) + abs(A(K)*COLSCA(I)) + ENDIF + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_289 + SUBROUTINE ZMUMPS_208(A, NZ, N, IRN, ICN, RHS, X, R, W, + & KEEP,KEEP8) + IMPLICIT NONE + INTEGER, intent(in) :: NZ, N, KEEP(500) + INTEGER(8), intent(in) :: KEEP8(150) + INTEGER, intent(in) :: IRN(NZ), ICN(NZ) + COMPLEX(kind=8), intent(in) :: A(NZ), RHS(N), X(N) + DOUBLE PRECISION, intent(out) :: W(N) + COMPLEX(kind=8), intent(out) :: R(N) + INTEGER I, K, J + DOUBLE PRECISION ZERO + DATA ZERO /0.0D0/ + COMPLEX(kind=8) D + DO I = 1, N + R(I) = RHS(I) + W(I) = ZERO + ENDDO + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .GT. N) .OR. (J .GT. N) .OR. (I .LT. 1) .OR. (J .LT. 1)) + & CYCLE + D = A(K) * X(J) + R(I) = R(I) - D + W(I) = W(I) + abs(D) + IF ((I.NE.J) .AND. (KEEP(50).NE.0) ) THEN + D = A(K) * X(I) + R(J) = R(J) - D + W(J) = W(J) + abs(D) + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_208 + SUBROUTINE ZMUMPS_204(N, R, W) + INTEGER, intent(in) :: N + DOUBLE PRECISION, intent(in) :: W(N) + COMPLEX(kind=8), intent(inout) :: R(N) + INTEGER I + DO 10 I = 1, N + R(I) = R(I) * W(I) + 10 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_204 + SUBROUTINE ZMUMPS_218(N, KASE, X, EST, W, IW) + INTEGER, intent(in) :: N + INTEGER, intent(inout) :: KASE + INTEGER IW(N) + COMPLEX(kind=8) W(N), X(N) + DOUBLE PRECISION EST + INTRINSIC abs, nint, real, sign + INTEGER ZMUMPS_IXAMAX + EXTERNAL ZMUMPS_IXAMAX + INTEGER ITMAX + PARAMETER (ITMAX = 5) + INTEGER I, ITER, J, JLAST, JUMP + DOUBLE PRECISION ALTSGN + DOUBLE PRECISION TEMP + SAVE ITER, J, JLAST, JUMP + COMPLEX(kind=8) ZERO, ONE + PARAMETER( ZERO = (0.0D0,0.0D0) ) + PARAMETER( ONE = (1.0D0,0.0D0) ) + DOUBLE PRECISION, PARAMETER :: RZERO = 0.0D0 + DOUBLE PRECISION, PARAMETER :: RONE = 1.0D0 + IF (KASE .EQ. 0) THEN + DO 10 I = 1, N + X(I) = ONE / dble(N) + 10 CONTINUE + KASE = 1 + JUMP = 1 + RETURN + ENDIF + SELECT CASE (JUMP) + CASE (1) + GOTO 20 + CASE(2) + GOTO 40 + CASE(3) + GOTO 70 + CASE(4) + GOTO 120 + CASE(5) + GOTO 160 + CASE DEFAULT + END SELECT + 20 CONTINUE + IF (N .EQ. 1) THEN + W(1) = X(1) + EST = abs(W(1)) + GOTO 190 + ENDIF + DO 30 I = 1, N + X(I) = cmplx( sign(RONE,dble(X(I))), kind=kind(X)) + IW(I) = nint(dble(X(I))) + 30 CONTINUE + KASE = 2 + JUMP = 2 + RETURN + 40 CONTINUE + J = ZMUMPS_IXAMAX(N, X, 1) + ITER = 2 + 50 CONTINUE + DO 60 I = 1, N + X(I) = ZERO + 60 CONTINUE + X(J) = ONE + KASE = 1 + JUMP = 3 + RETURN + 70 CONTINUE + DO 80 I = 1, N + W(I) = X(I) + 80 CONTINUE + DO 90 I = 1, N + IF (nint(sign(RONE, dble(X(I)))) .NE. IW(I)) GOTO 100 + 90 CONTINUE + GOTO 130 + 100 CONTINUE + DO 110 I = 1, N + X(I) = cmplx( sign(RONE, dble(X(I))), kind=kind(X) ) + IW(I) = nint(dble(X(I))) + 110 CONTINUE + KASE = 2 + JUMP = 4 + RETURN + 120 CONTINUE + JLAST = J + J = ZMUMPS_IXAMAX(N, X, 1) + IF ((abs(X(JLAST)) .NE. abs(X(J))) .AND. (ITER .LT. ITMAX)) THEN + ITER = ITER + 1 + GOTO 50 + ENDIF + 130 CONTINUE + EST = RZERO + DO 140 I = 1, N + EST = EST + abs(W(I)) + 140 CONTINUE + ALTSGN = RONE + DO 150 I = 1, N + X(I) = cmplx(ALTSGN * (RONE + dble(I - 1) / dble(N - 1)), + & kind=kind(X)) + ALTSGN = -ALTSGN + 150 CONTINUE + KASE = 1 + JUMP = 5 + RETURN + 160 CONTINUE + TEMP = RZERO + DO 170 I = 1, N + TEMP = TEMP + abs(X(I)) + 170 CONTINUE + TEMP = 2.0D0 * TEMP / dble(3 * N) + IF (TEMP .GT. EST) THEN + DO 180 I = 1, N + W(I) = X(I) + 180 CONTINUE + EST = TEMP + ENDIF + 190 KASE = 0 + RETURN + END SUBROUTINE ZMUMPS_218 + SUBROUTINE ZMUMPS_278( MTYPE, N, NZ, ASPK, IRN, ICN, + & LHS, WRHS, W, RHS, KEEP,KEEP8) + IMPLICIT NONE + INTEGER MTYPE, N, NZ + INTEGER IRN( NZ ), ICN( NZ ) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + COMPLEX(kind=8), intent(in) :: ASPK( NZ ) + COMPLEX(kind=8), intent(in) :: LHS( N ), WRHS( N ) + COMPLEX(kind=8), intent(out):: RHS( N ) + DOUBLE PRECISION, intent(out):: W( N ) + INTEGER K, I, J + DOUBLE PRECISION DZERO + PARAMETER(DZERO = 0.0D0) + DO 10 K = 1, N + W(K) = DZERO + RHS(K) = WRHS(K) + 10 CONTINUE + IF ( KEEP(50) .EQ. 0 ) THEN + IF (MTYPE .EQ. 1) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + RHS(I) = RHS(I) - ASPK(K) * LHS(J) + W(I) = W(I) + abs(ASPK(K)) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + RHS(J) = RHS(J) - ASPK(K) * LHS(I) + W(J) = W(J) + abs(ASPK(K)) + ENDDO + ENDIF + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + RHS(I) = RHS(I) - ASPK(K) * LHS(J) + W(I) = W(I) + abs(ASPK(K)) + IF (J.NE.I) THEN + RHS(J) = RHS(J) - ASPK(K) * LHS(I) + W(J) = W(J) + abs(ASPK(K)) + ENDIF + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_278 + SUBROUTINE ZMUMPS_121( MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & LHS, WRHS, W, RHS, KEEP,KEEP8) + IMPLICIT NONE + INTEGER MTYPE, N, NELT, LELTVAR, NA_ELT + INTEGER ELTPTR(NELT+1), ELTVAR(LELTVAR) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + COMPLEX(kind=8) A_ELT(NA_ELT) + COMPLEX(kind=8) LHS( N ), WRHS( N ), RHS( N ) + DOUBLE PRECISION W(N) + CALL ZMUMPS_257(N, NELT, ELTPTR, ELTVAR, A_ELT, + & LHS, RHS, KEEP(50), MTYPE ) + RHS = WRHS - RHS + CALL ZMUMPS_119( MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & W, KEEP,KEEP8 ) + RETURN + END SUBROUTINE ZMUMPS_121 + SUBROUTINE ZMUMPS_119( MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & W, KEEP,KEEP8 ) + IMPLICIT NONE + INTEGER MTYPE, N, NELT, LELTVAR, NA_ELT + INTEGER ELTPTR(NELT+1), ELTVAR(LELTVAR) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + COMPLEX(kind=8) A_ELT(NA_ELT) + DOUBLE PRECISION TEMP + DOUBLE PRECISION W(N) + INTEGER K, I, J, IEL, SIZEI, IELPTR + DOUBLE PRECISION DZERO + PARAMETER(DZERO = 0.0D0) + W = DZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( KEEP(50).EQ.0 ) THEN + IF (MTYPE.EQ.1) THEN + DO J = 1, SIZEI + DO I = 1, SIZEI + W( ELTVAR( IELPTR + I) ) = + & W( ELTVAR( IELPTR + I) ) + & + abs(A_ELT( K )) + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = W( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + TEMP = TEMP + abs( A_ELT(K)) + K = K + 1 + END DO + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + TEMP + END DO + ENDIF + ELSE + DO J = 1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + abs(A_ELT( K )) + K = K + 1 + DO I = J+1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + abs(A_ELT( K )) + W(ELTVAR( IELPTR + I ) ) = + & W(ELTVAR( IELPTR + I )) + abs(A_ELT( K )) + K = K + 1 + END DO + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_119 + SUBROUTINE ZMUMPS_135(MTYPE, N, + & NELT, ELTPTR, LELTVAR, ELTVAR, NA_ELT, A_ELT, + & W, KEEP,KEEP8, COLSCA ) + IMPLICIT NONE + INTEGER MTYPE, N, NELT, LELTVAR, NA_ELT + INTEGER ELTPTR(NELT+1), ELTVAR(LELTVAR) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION COLSCA(N) + COMPLEX(kind=8) A_ELT(NA_ELT) + DOUBLE PRECISION W(N) + DOUBLE PRECISION TEMP, TEMP2 + INTEGER K, I, J, IEL, SIZEI, IELPTR + DOUBLE PRECISION DZERO + PARAMETER(DZERO = 0.0D0) + W = DZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( KEEP(50).EQ.0 ) THEN + IF (MTYPE.EQ.1) THEN + DO J = 1, SIZEI + TEMP2 = abs(COLSCA(ELTVAR( IELPTR + J) )) + DO I = 1, SIZEI + W( ELTVAR( IELPTR + I) ) = + & W( ELTVAR( IELPTR + I) ) + & + abs(A_ELT( K )) * TEMP2 + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = W( ELTVAR( IELPTR + J ) ) + TEMP2= abs(COLSCA(ELTVAR( IELPTR + J) )) + DO I = 1, SIZEI + TEMP = TEMP + abs(A_ELT( K )) * TEMP2 + K = K + 1 + END DO + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + TEMP + END DO + ENDIF + ELSE + DO J = 1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + + & abs( A_ELT( K )*COLSCA(ELTVAR( IELPTR + J)) ) + K = K + 1 + DO I = J+1, SIZEI + W(ELTVAR( IELPTR + J )) = + & W(ELTVAR( IELPTR + J )) + + & abs(A_ELT( K )*COLSCA(ELTVAR( IELPTR + J))) + W(ELTVAR( IELPTR + I ) ) = + & W(ELTVAR( IELPTR + I )) + + & abs(A_ELT( K )*COLSCA(ELTVAR( IELPTR + I))) + K = K + 1 + END DO + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_135 + SUBROUTINE ZMUMPS_122( MTYPE, N, NELT, ELTPTR, + & LELTVAR, ELTVAR, NA_ELT, A_ELT, + & SAVERHS, X, Y, W, K50 ) + IMPLICIT NONE + INTEGER N, NELT, K50, MTYPE, LELTVAR, NA_ELT + INTEGER ELTPTR( NELT + 1 ), ELTVAR( LELTVAR ) + COMPLEX(kind=8) A_ELT( NA_ELT ), X( N ), Y( N ), + & SAVERHS(N) + DOUBLE PRECISION W(N) + INTEGER IEL, I , J, K, SIZEI, IELPTR + DOUBLE PRECISION ZERO + COMPLEX(kind=8) TEMP + DOUBLE PRECISION TEMP2 + PARAMETER( ZERO = 0.0D0 ) + Y = SAVERHS + W = ZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( K50 .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO J = 1, SIZEI + TEMP = X( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) - + & A_ELT( K ) * TEMP + W( ELTVAR( IELPTR + I ) ) = + & W( ELTVAR( IELPTR + I ) ) + + & abs( A_ELT( K ) * TEMP ) + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = Y( ELTVAR( IELPTR + J ) ) + TEMP2 = W( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + TEMP = TEMP - + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + TEMP2 = TEMP2 + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) ) + K = K + 1 + END DO + Y( ELTVAR( IELPTR + J ) ) = TEMP + W( ELTVAR( IELPTR + J ) ) = TEMP2 + END DO + END IF + ELSE + DO J = 1, SIZEI + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) - + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + W( ELTVAR( IELPTR + J ) ) = + & W( ELTVAR( IELPTR + J ) ) + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) ) + K = K + 1 + DO I = J+1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) - + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) - + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + W( ELTVAR( IELPTR + I ) ) = + & W( ELTVAR( IELPTR + I ) ) + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) ) + W( ELTVAR( IELPTR + J ) ) = + & W( ELTVAR( IELPTR + J ) ) + abs( + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) ) + K = K + 1 + END DO + END DO + END IF + END DO + RETURN + END SUBROUTINE ZMUMPS_122 + SUBROUTINE ZMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + USE ZMUMPS_OOC + IMPLICIT NONE + INTEGER INODE,KEEP(500),N + INTEGER(8) KEEP8(150) + INTEGER(8) :: LA + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N) + INTEGER IERR + COMPLEX(kind=8) A(LA) + INTEGER RETURN_VALUE + LOGICAL MUST_BE_PERMUTED + RETURN_VALUE=ZMUMPS_726(INODE,PTRFAC, + & KEEP(28),A,LA,IERR) + IF(RETURN_VALUE.EQ.OOC_NODE_NOT_IN_MEM)THEN + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL ZMUMPS_578(INODE,PTRFAC, + & KEEP,KEEP8,A,IERR) + IF(IERR.LT.0)THEN + RETURN + ENDIF + CALL ZMUMPS_577( + & A(PTRFAC(STEP(INODE))), + & INODE,IERR + & ) + IF(IERR.LT.0)THEN + RETURN + ENDIF + ELSE + IF(IERR.LT.0)THEN + RETURN + ENDIF + ENDIF + IF(RETURN_VALUE.NE.OOC_NODE_PERMUTED)THEN + MUST_BE_PERMUTED=.TRUE. + CALL ZMUMPS_682(INODE) + ELSE + MUST_BE_PERMUTED=.FALSE. + ENDIF + RETURN + END SUBROUTINE ZMUMPS_643 + SUBROUTINE ZMUMPS_257( N, NELT, ELTPTR, ELTVAR, A_ELT, + & X, Y, K50, MTYPE ) + IMPLICIT NONE + INTEGER N, NELT, K50, MTYPE + INTEGER ELTPTR( NELT + 1 ), ELTVAR( * ) + COMPLEX(kind=8) A_ELT( * ), X( N ), Y( N ) + INTEGER IEL, I , J, K, SIZEI, IELPTR + COMPLEX(kind=8) TEMP + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + Y = ZERO + K = 1 + DO IEL = 1, NELT + SIZEI = ELTPTR( IEL + 1 ) - ELTPTR( IEL ) + IELPTR = ELTPTR( IEL ) - 1 + IF ( K50 .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO J = 1, SIZEI + TEMP = X( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) + + & A_ELT( K ) * TEMP + K = K + 1 + END DO + END DO + ELSE + DO J = 1, SIZEI + TEMP = Y( ELTVAR( IELPTR + J ) ) + DO I = 1, SIZEI + TEMP = TEMP + + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + K = K + 1 + END DO + Y( ELTVAR( IELPTR + J ) ) = TEMP + END DO + END IF + ELSE + DO J = 1, SIZEI + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) + + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + K = K + 1 + DO I = J+1, SIZEI + Y( ELTVAR( IELPTR + I ) ) = + & Y( ELTVAR( IELPTR + I ) ) + + & A_ELT( K ) * X( ELTVAR( IELPTR + J ) ) + Y( ELTVAR( IELPTR + J ) ) = + & Y( ELTVAR( IELPTR + J ) ) + + & A_ELT( K ) * X( ELTVAR( IELPTR + I ) ) + K = K + 1 + END DO + END DO + END IF + END DO + RETURN + END SUBROUTINE ZMUMPS_257 + SUBROUTINE ZMUMPS_192 + &( N, NZ_loc, IRN_loc, JCN_loc, A_loc, X, Y_loc, + & LDLT, MTYPE) + IMPLICIT NONE + INTEGER N, NZ_loc + INTEGER IRN_loc( NZ_loc ), JCN_loc( NZ_loc ) + COMPLEX(kind=8) A_loc( NZ_loc ), X( N ), Y_loc( N ) + INTEGER LDLT, MTYPE + INTEGER I, J, K + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + Y_loc = ZERO + IF ( LDLT .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + A_loc(K) * X(J) + ENDDO + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) + & .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(J) = Y_loc(J) + A_loc(K) * X(I) + ENDDO + END IF + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + A_loc(K) * X(J) + IF (J.NE.I) THEN + Y_loc(J) = Y_loc(J) + A_loc(K) * X(I) + ENDIF + ENDDO + END IF + RETURN + END SUBROUTINE ZMUMPS_192 + SUBROUTINE ZMUMPS_256( N, NZ, IRN, ICN, ASPK, X, Y, + & LDLT, MTYPE, MAXTRANS, PERM ) + INTEGER N, NZ, LDLT, MTYPE, MAXTRANS + INTEGER IRN( NZ ), ICN( NZ ) + INTEGER PERM( N ) + COMPLEX(kind=8) ASPK( NZ ), X( N ), Y( N ) + INTEGER K, I, J + COMPLEX(kind=8) PX( N ) + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + Y = ZERO + IF ( MAXTRANS .eq. 1 .and. MTYPE .eq. 1) THEN + DO I = 1, N + PX(I) = X( PERM( I ) ) + END DO + ELSE + PX = X + END IF + IF ( LDLT .eq. 0 ) THEN + IF (MTYPE .EQ. 1) THEN + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y(I) = Y(I) + ASPK(K) * PX(J) + ENDDO + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y(J) = Y(J) + ASPK(K) * PX(I) + ENDDO + ENDIF + ELSE + DO K = 1, NZ + I = IRN(K) + J = ICN(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y(I) = Y(I) + ASPK(K) * PX(J) + IF (J.NE.I) THEN + Y(J) = Y(J) + ASPK(K) * PX(I) + ENDIF + ENDDO + END IF + IF ( MAXTRANS .EQ. 1 .AND. MTYPE .eq. 0 ) THEN + PX = Y + DO I = 1, N + Y( PERM( I ) ) = PX( I ) + END DO + END IF + RETURN + END SUBROUTINE ZMUMPS_256 + SUBROUTINE ZMUMPS_193 + &( N, NZ_loc, IRN_loc, JCN_loc, A_loc, X, Y_loc, + & LDLT, MTYPE) + IMPLICIT NONE + INTEGER N, NZ_loc + INTEGER IRN_loc( NZ_loc ), JCN_loc( NZ_loc ) + COMPLEX(kind=8) A_loc( NZ_loc ), X( N ) + DOUBLE PRECISION Y_loc( N ) + INTEGER LDLT, MTYPE + INTEGER I, J, K + DOUBLE PRECISION RZERO + PARAMETER( RZERO = 0.0D0 ) + Y_loc = RZERO + IF ( LDLT .eq. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + abs( A_loc(K) * X(J) ) + ENDDO + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) + & .OR. (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(J) = Y_loc(J) + abs( A_loc(K) * X(I) ) + ENDDO + END IF + ELSE + DO K = 1, NZ_loc + I = IRN_loc(K) + J = JCN_loc(K) + IF ((I .LE. 0) .OR. (I .GT. N) .OR. + & (J .LE. 0) .OR. (J .GT. N) + & ) CYCLE + Y_loc(I) = Y_loc(I) + abs( A_loc(K) * X(J) ) + IF (J.NE.I) THEN + Y_loc(J) = Y_loc(J) + abs( A_loc(K) * X(I) ) + ENDIF + ENDDO + END IF + RETURN + END SUBROUTINE ZMUMPS_193 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part6.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part6.F new file mode 100644 index 000000000..ceb06f7ef --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part6.F @@ -0,0 +1,4378 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE ZMUMPS_324(A, LDA, NPIV, NBROW, K50 ) + IMPLICIT NONE + INTEGER LDA, NPIV, NBROW, K50 + COMPLEX(kind=8) A(int(LDA,8)*int(NBROW+NPIV,8)) + INTEGER(8) :: IOLD, INEW, J8 + INTEGER I , ILAST + INTEGER NBROW_L_RECTANGLE_TO_MOVE + IF ((NPIV.EQ.0).OR.(LDA.EQ.NPIV)) GOTO 500 + IF ( K50.NE.0 ) THEN + IOLD = int(LDA + 1,8) + INEW = int(NPIV + 1,8) + IF (IOLD .EQ. INEW ) THEN + INEW = INEW + int(NPIV,8) * int(NPIV - 1,8) + IOLD = IOLD + int(LDA,8) * int(NPIV - 1,8) + ELSE + DO I = 1, NPIV - 1 + IF ( I .LE. NPIV-2 ) THEN + ILAST = I+1 + ELSE + ILAST = I + ENDIF + DO J8 = 0_8, int(ILAST,8) + A( INEW + J8 ) = A( IOLD + J8 ) + END DO + INEW = INEW + int(NPIV,8) + IOLD = IOLD + int(LDA,8) + END DO + ENDIF + NBROW_L_RECTANGLE_TO_MOVE = NBROW + ELSE + INEW = 1_8 + int(NPIV,8) * int(LDA + 1,8) + IOLD = 1_8 + int(LDA,8) * int(NPIV +1,8) + NBROW_L_RECTANGLE_TO_MOVE = NBROW - 1 + ENDIF + DO I = 1, NBROW_L_RECTANGLE_TO_MOVE + DO J8 = 0_8, int(NPIV - 1,8) + A( INEW + J8 ) = A( IOLD + J8 ) + END DO + INEW = INEW + int(NPIV,8) + IOLD = IOLD + int(LDA,8) + ENDDO + 500 RETURN + END SUBROUTINE ZMUMPS_324 + SUBROUTINE ZMUMPS_651(A, LDA, NPIV, NCONTIG ) + IMPLICIT NONE + INTEGER NCONTIG, NPIV, LDA + COMPLEX(kind=8) A(NCONTIG*LDA) + INTEGER I, J + INTEGER(8) :: INEW, IOLD + INEW = int(NPIV+1,8) + IOLD = int(LDA+1,8) + DO I = 2, NCONTIG + DO J = 1, NPIV + A(INEW)=A(IOLD) + INEW = INEW + 1_8 + IOLD = IOLD + 1_8 + ENDDO + IOLD = IOLD + int(LDA - NPIV,8) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_651 + SUBROUTINE ZMUMPS_652( A, LA, LDA, POSELT, + & IPTRLU, NPIV, + & NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, SIZECB, KEEP, COMPRESSCB, + & LAST_ALLOWED, NBROW_ALREADY_STACKED ) + IMPLICIT NONE + INTEGER(8), intent (in) :: POSELT, IPTRLU, LA, SIZECB + LOGICAL, intent (in) :: COMPRESSCB + COMPLEX(kind=8) A(LA) + INTEGER, intent(in):: LDA, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND + INTEGER, intent(inout) :: NBROW_ALREADY_STACKED + INTEGER(8), intent(in) :: LAST_ALLOWED + INTEGER(8) :: APOS, NPOS + INTEGER NBROW + INTEGER(8) :: J + INTEGER I, KEEP(500) +#if ! defined(ALLOW_NON_INIT) + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) +#endif + NBROW = NBROW_STACK + NBROW_SEND + IF (NBROW_STACK .NE. 0 ) THEN + NPOS = IPTRLU + SIZECB + APOS = POSELT + int(NPIV+NBROW,8) * int(LDA,8) - 1_8 + IF ( KEEP(50) .EQ. 0 .OR. .NOT. COMPRESSCB ) THEN + APOS = APOS - int(LDA,8) * int(NBROW_ALREADY_STACKED,8) + NPOS = NPOS + & - int(NBCOL_STACK,8) * int(NBROW_ALREADY_STACKED,8) + ELSE + APOS = APOS - int(LDA - 1,8) * int(NBROW_ALREADY_STACKED,8) + NPOS = NPOS - ( int(NBROW_ALREADY_STACKED,8) * + & int(NBROW_ALREADY_STACKED+1,8) ) / 2_8 + ENDIF + DO I = NBROW - NBROW_ALREADY_STACKED, NBROW_SEND+1, -1 + IF (KEEP(50).EQ.0) THEN + IF ( NPOS - int(NBCOL_STACK,8) + 1_8 .LT. + & LAST_ALLOWED ) THEN + EXIT + ENDIF + DO J= 1_8,int(NBCOL_STACK,8) + A(NPOS-J+1_8) = A(APOS-J+1_8) + ENDDO + NPOS = NPOS - int(NBCOL_STACK,8) + ELSE + IF (.NOT. COMPRESSCB) THEN + IF ( NPOS - int(NBCOL_STACK,8) + 1_8 .LT. + & LAST_ALLOWED ) THEN + EXIT + ENDIF +#if ! defined(ALLOW_NON_INIT) + DO J = 1_8, int(NBCOL_STACK - I,8) + A(NPOS - J + 1_8) = ZERO + END DO +#endif + NPOS = NPOS + int(- NBCOL_STACK + I,8) + ENDIF + IF ( NPOS - int(I,8) + 1_8 .LT. LAST_ALLOWED ) THEN + EXIT + ENDIF + DO J =1_8, int(I,8) + A(NPOS-J+1_8) = A(APOS-J+1_8) + ENDDO + NPOS = NPOS - int(I,8) + ENDIF + IF (KEEP(50).EQ.0) THEN + APOS = APOS - int(LDA,8) + ELSE + APOS = APOS - int(LDA + 1,8) + ENDIF + NBROW_ALREADY_STACKED = NBROW_ALREADY_STACKED + 1 + ENDDO + END IF + RETURN + END SUBROUTINE ZMUMPS_652 + SUBROUTINE ZMUMPS_705( A, LA, LDA, POSELT, + & IPTRLU, NPIV, + & NBCOL_STACK, NBROW_STACK, + & NBROW_SEND, SIZECB, KEEP, COMPRESSCB) + IMPLICIT NONE + INTEGER(8), intent (in) :: POSELT, IPTRLU, LA, SIZECB + LOGICAL, intent (in) :: COMPRESSCB + COMPLEX(kind=8) A(LA) + INTEGER, intent(in):: LDA, NPIV, NBCOL_STACK, NBROW_STACK, + & NBROW_SEND + INTEGER(8) :: APOS, NPOS, APOS_ini, NPOS_ini + INTEGER I, KEEP(500) + INTEGER(8) :: J, LDA8 +#if ! defined(ALLOW_NON_INIT) + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) +#endif + LDA8 = int(LDA,8) + NPOS_ini = IPTRLU + 1_8 + APOS_ini = POSELT + int(NPIV+NBROW_SEND,8)* LDA8 + int(NPIV,8) + DO I = 1, NBROW_STACK + IF (COMPRESSCB) THEN + NPOS = NPOS_ini + int(I-1,8) * int(I,8)/2_8 + + & int(I-1,8) * int(NBROW_SEND,8) + ELSE + NPOS = NPOS_ini + int(I-1,8) * int(NBCOL_STACK,8) + ENDIF + APOS = APOS_ini + int(I-1,8) * LDA8 + IF (KEEP(50).EQ.0) THEN + DO J = 1_8, int(NBCOL_STACK,8) + A(NPOS+J-1_8) = A(APOS+J-1_8) + ENDDO + ELSE + DO J = 1_8, int(I + NBROW_SEND,8) + A(NPOS+J-1_8)=A(APOS+J-1_8) + ENDDO +#if ! defined(ALLOW_NON_INIT) + IF (.NOT. COMPRESSCB) THEN + A(NPOS+int(I+NBROW_SEND,8): + & NPOS+int(NBCOL_STACK-1,8))=ZERO + ENDIF +#endif + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_705 + SUBROUTINE ZMUMPS_140( N, INODE, IW, LIW, A, LA, + & IOLDPS, POSELT, IFLAG, + & UU, NNEG, NPVW, + & KEEP,KEEP8, + & MYID, SEUIL, AVOID_DELAYED, ETATASS, + & DKEEP,PIVNUL_LIST,LPN_LIST, IWPOS ) + USE ZMUMPS_OOC + IMPLICIT NONE + INTEGER(8) :: LA, POSELT + INTEGER N, INODE, LIW, IFLAG, NNEG, NPVW + INTEGER MYID, IOLDPS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + DOUBLE PRECISION UU, SEUIL + COMPLEX(kind=8) A( LA ) + INTEGER, TARGET :: IW( LIW ) + LOGICAL AVOID_DELAYED + INTEGER ETATASS, IWPOS + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER INOPV, IFINB, NFRONT, NPIV, NBOLKJ, + & NBTLKJ,IBEG_BLOCK + INTEGER NASS, NEL1, IFLAG_OOC + INTEGER :: LDA + DOUBLE PRECISION UUTEMP + INCLUDE 'mumps_headers.h' + EXTERNAL ZMUMPS_222, ZMUMPS_234, + & ZMUMPS_230, ZMUMPS_226, + & ZMUMPS_237 + LOGICAL STATICMODE + DOUBLE PRECISION SEUIL_LOC + INTEGER PIVSIZ,IWPOSP2 + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten, + & IDUMMY + LOGICAL POSTPONE_COL_UPDATE, IS_MAXFROMM_AVAIL + DOUBLE PRECISION MAXFROMM + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INTEGER PP_FIRST2SWAP_L + INTEGER PP_LastPIVRPTRFilled + IS_MAXFROMM_AVAIL = .FALSE. + INOPV = 0 + SEUIL_LOC = SEUIL + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + UUTEMP=UU + ENDIF + POSTPONE_COL_UPDATE = (UUTEMP == 0.0D0 .AND. KEEP(201).NE.1) + IBEG_BLOCK = 1 + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + LDA = NFRONT + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5), NASS ) + ENDIF + NBTLKJ = NBOLKJ + IF (KEEP(201).EQ.1) THEN + IDUMMY = -8765 + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_L + NextPiv2beWritten = 1 + PP_FIRST2SWAP_L = NextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + PP_LastPIVRPTRFilled = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 1 + MonBloc%NROW = NFRONT + MonBloc%NCOL = NFRONT + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -77777 + MonBloc%INDICES => + & IW(IOLDPS+6+NFRONT+KEEP(IXSZ): + & IOLDPS+5+NFRONT+KEEP(IXSZ)+NFRONT) + ENDIF + IW(IOLDPS+3+KEEP(IXSZ)) = min0(NASS,NBTLKJ) + UUTEMP = UU + 50 CONTINUE + CALL ZMUMPS_222(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & INOPV, NNEG, IFLAG,IOLDPS,POSELT,UUTEMP, + & SEUIL_LOC,KEEP,KEEP8,PIVSIZ, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, KEEP(IXSZ), + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled, MAXFROMM, IS_MAXFROMM_AVAIL) + IF (IFLAG.LT.0) GOTO 500 + IF(KEEP(109).GT. 0) THEN + IF(PIVNUL_LIST(KEEP(109)).EQ.-1) THEN + IWPOSP2 = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6+KEEP(IXSZ) + & +IW(IOLDPS+5+KEEP(IXSZ)) + PIVNUL_LIST(KEEP(109)) = IW(IWPOSP2) + ENDIF + ENDIF + IF (INOPV.EQ.1) THEN + IF(STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + CALL ZMUMPS_237(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, KEEP,KEEP8, POSTPONE_COL_UPDATE, + & ETATASS, + & TYPEFile, LAFAC, MonBloc, NextPiv2beWritten, + & LIWFAC, MYID, IFLAG) + GOTO 500 + END IF + IF (INOPV.EQ.2) THEN + CALL ZMUMPS_234(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, NBOLKJ, NBTLKJ,KEEP(4), + & POSTPONE_COL_UPDATE, + & KEEP,KEEP8) + GOTO 50 + ENDIF + NPVW = NPVW + PIVSIZ + IF (NASS.LE.1) THEN + CALL ZMUMPS_230(NFRONT,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT) + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1 + GO TO 500 + ENDIF + CALL ZMUMPS_226(IBEG_BLOCK, + & NFRONT, NASS, N,INODE,IW,LIW,A,LA, + & LDA, POSTPONE_COL_UPDATE, IOLDPS, + & POSELT,IFINB, + & NBTLKJ,PIVSIZ, KEEP(IXSZ),MAXFROMM, + & IS_MAXFROMM_AVAIL, (UUTEMP.NE.0.0D0), + & KEEP(253) ) + IF(PIVSIZ .EQ. 2) THEN + IWPOSP2 = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6 + IW(IWPOSP2+NFRONT+KEEP(IXSZ)) = -IW(IWPOSP2+NFRONT+KEEP(IXSZ)) + ENDIF + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + PIVSIZ + IF (IFINB.EQ.0) GOTO 50 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NEL1 = NASS - NPIV + IF (KEEP(201).EQ.1) THEN + IF (IFINB.EQ.-1) THEN + MonBloc%Last = .TRUE. + ELSE + MonBloc%Last = .FALSE. + ENDIF + MonBloc%LastPiv= NPIV + LAST_CALL=.FALSE. + CALL ZMUMPS_688( + & STRAT_TRY_WRITE, + & TYPEFile, A(POSELT), + & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS), + & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + ENDIF + CALL ZMUMPS_234(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, NBOLKJ, NBTLKJ,KEEP(4), + & POSTPONE_COL_UPDATE, + & KEEP,KEEP8) + IF (IFINB.EQ.-1) THEN + CALL ZMUMPS_237(NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, IOLDPS,POSELT, KEEP,KEEP8, + & POSTPONE_COL_UPDATE, ETATASS, + & TYPEFile, LAFAC, MonBloc, NextPiv2beWritten, + & LIWFAC, MYID, IFLAG) + & + GOTO 500 + ENDIF + GO TO 50 + 500 CONTINUE + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + LAST_CALL=.TRUE. + CALL ZMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC + IF (IFLAG < 0 ) RETURN + CALL ZMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_140 + SUBROUTINE ZMUMPS_222 + & (NFRONT,NASS,N,INODE,IW,LIW, + & A,LA, INOPV, + & NNEG, + & IFLAG,IOLDPS,POSELT,UU, SEUIL,KEEP,KEEP8,PIVSIZ, + & DKEEP,PIVNUL_LIST,LPN_LIST, XSIZE, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled,MAXFROMM,IS_MAXFROMM_AVAIL) +#if defined (PROFILE_BLAS_ASS_G) + USE ZMUMPS_LOAD +#endif + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER(8) :: POSELT, LA + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV, + & IOLDPS, NNEG + INTEGER PIVSIZ,LPIV, XSIZE + COMPLEX(kind=8) A(LA) + DOUBLE PRECISION UU, UULOC, SEUIL + INTEGER IW(LIW) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk + INTEGER PP_LastPIVRPTRIndexFilled + DOUBLE PRECISION, intent(in) :: MAXFROMM + LOGICAL, intent(inout) :: IS_MAXFROMM_AVAIL + include 'mpif.h' + INTEGER (8) :: POSPV1,POSPV2,OFFDAG,APOSJ + INTEGER JMAX + DOUBLE PRECISION RMAX,AMAX,TMAX,TOL + DOUBLE PRECISION MAXPIV + DOUBLE PRECISION PIVNUL + COMPLEX(kind=8) FIXA, CSEUIL + COMPLEX(kind=8) PIVOT,DETPIV + PARAMETER(TOL = 1.0D-20) + INCLUDE 'mumps_headers.h' + INTEGER :: J + INTEGER(8) :: APOS, J1, J2, JJ, NFRONT8, KK, J1_ini, JJ_ini + INTEGER :: LDA + INTEGER(8) :: LDA8 + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,K + INTRINSIC max + COMPLEX(kind=8) ZERO, ONE + PARAMETER( ZERO = (0.0D0,0.0D0) ) + PARAMETER( ONE = (1.0D0,1.0D0) ) + DOUBLE PRECISION RZERO,RONE + PARAMETER(RZERO=0.0D0, RONE=1.0D0) + LOGICAL OMP_FLAG + INTEGER I_PIVRPTR, I_PIVR, NBPANELS_L + PIVNUL = DKEEP(1) + FIXA = cmplx(DKEEP(2),kind=kind(FIXA)) + CSEUIL = cmplx(SEUIL,kind=kind(CSEUIL)) + LDA = NFRONT + LDA8 = int(LDA,8) + NFRONT8 = int(NFRONT,8) + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL ZMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR, I_PIVR, IOLDPS+2*NFRONT+6+KEEP(IXSZ), + & IW, LIW) + ENDIF + UULOC = UU + PIVSIZ = 1 + NPIV = IW(IOLDPS+1+XSIZE) + NPIVP1 = NPIV + 1 + NASSW = iabs(IW(IOLDPS+3+XSIZE)) + IF(INOPV .EQ. -1) THEN + APOS = POSELT + (LDA8+1_8) * int(NPIV,8) + POSPV1 = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF(dble(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + KEEP(98) = KEEP(98)+1 + ELSE IF (KEEP(258) .NE. 0) THEN + CALL ZMUMPS_762( A(APOS), DKEEP(6), KEEP(259) ) + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL ZMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + LDA8*int(IPIV-1,8) + int(NPIV,8) + POSPV1 = APOS + int(IPIV - NPIVP1,8) + PIVOT = A(POSPV1) + IF (UULOC.EQ.RZERO) THEN + IF (abs(A(APOS)).EQ.RZERO) GO TO 630 + IF (KEEP(258) .NE. 0) THEN + CALL ZMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + GO TO 420 + ENDIF + AMAX = RZERO + JMAX = 0 + IF ( IS_MAXFROMM_AVAIL ) THEN + IF ( MAXFROMM > PIVNUL .AND. abs(PIVOT) > TOL) THEN + IF ( abs(PIVOT) .GT. max(UULOC*MAXFROMM,SEUIL) ) THEN + IF (KEEP(258) .NE. 0) THEN + CALL ZMUMPS_762(PIVOT, DKEEP(6), KEEP(259)) + ENDIF + GOTO 415 + ENDIF + ENDIF + IS_MAXFROMM_AVAIL = .FALSE. + ENDIF + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(abs(A(JJ)) .GT. AMAX) THEN + AMAX = abs(A(JJ)) + JMAX = IPIV - int(POSPV1-JJ) + ENDIF + ENDDO + J1 = POSPV1 + LDA8 + DO J=1, NASSW - IPIV + IF(abs(A(J1)) .GT. AMAX) THEN + AMAX = abs(A(J1)) + JMAX = IPIV + J + ENDIF + J1 = J1 + LDA8 + ENDDO + RMAX = RZERO + J1_ini = J1 + IF ( (NFRONT - KEEP(253) - NASSW).GE.300 ) THEN + OMP_FLAG = .TRUE. + ELSE + OMP_FLAG = .FALSE. + ENDIF + DO J=1, NFRONT - KEEP(253) - NASSW + J1 = J1_ini + int(J-1,8) * LDA8 + RMAX = max(abs(A(J1)),RMAX) + ENDDO + IF (max(AMAX,RMAX,abs(PIVOT)).LE.PIVNUL) THEN + KEEP(109) = KEEP(109)+1 + PIVNUL_LIST(KEEP(109)) = -1 + IF(dble(FIXA).GT.RZERO) THEN + IF(dble(PIVOT) .GE. RZERO) THEN + A(POSPV1) = FIXA + ELSE + A(POSPV1) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + A(JJ) = ZERO + ENDDO + J1 = POSPV1 + LDA8 + DO J=1, NASSW - IPIV + A(J1) = ZERO + J1 = J1 + LDA8 + ENDDO + DO J=1,NFRONT - NASSW + A(J1) = ZERO + J1 = J1 + LDA8 + ENDDO + A(POSPV1) = ONE + ENDIF + PIVOT = A(POSPV1) + GO TO 415 + ENDIF + IF ((KEEP(19).EQ.0).AND.(KEEP(110).EQ.0)) THEN + IF (max(AMAX,RMAX,abs(PIVOT)).LE.TOL) THEN + IF(SEUIL .GT. epsilon(SEUIL)) THEN + IF(dble(PIVOT) .GE. RZERO) THEN + A(POSPV1) = CSEUIL + ELSE + A(POSPV1) = -CSEUIL + ENDIF + PIVOT = A(POSPV1) + KEEP(98) = KEEP(98)+1 + GO TO 415 + ENDIF + ENDIF + ENDIF + IF (max(AMAX,abs(PIVOT)).LE.TOL) GO TO 460 + IF (abs(PIVOT).GT.max(UULOC*max(RMAX,AMAX),SEUIL)) THEN + IF (KEEP(258) .NE.0 ) THEN + CALL ZMUMPS_762(PIVOT, DKEEP(6), KEEP(259)) + ENDIF + GO TO 415 + END IF + IF (AMAX.LE.TOL) GO TO 460 + IF (RMAX.LT.AMAX) THEN + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(int(POSPV1-JJ) .NE. IPIV-JMAX) THEN + RMAX = max(RMAX,abs(A(JJ))) + ENDIF + ENDDO + J1 = POSPV1 + LDA8 + DO J=1,NASS-IPIV + IF(IPIV+J .NE. JMAX) THEN + RMAX = max(abs(A(J1)),RMAX) + ENDIF + J1 = J1 + LDA8 + ENDDO + ENDIF + APOSJ = POSELT + int(JMAX-1,8)*LDA8 + int(NPIV,8) + POSPV2 = APOSJ + int(JMAX - NPIVP1,8) + IF (IPIV.LT.JMAX) THEN + OFFDAG = APOSJ + int(IPIV - NPIVP1,8) + ELSE + OFFDAG = APOS + int(JMAX - NPIVP1,8) + END IF + TMAX = RZERO + IF(JMAX .LT. IPIV) THEN + JJ_ini = POSPV2 + OMP_FLAG = (NFRONT-JMAX-KEEP(253). GE. 300) + DO K = 1, NFRONT - JMAX - KEEP(253) + JJ = JJ_ini+ int(K,8)*NFRONT8 + IF (JMAX+K.NE.IPIV) THEN + TMAX=max(TMAX,abs(A(JJ))) + ENDIF + ENDDO + DO KK = APOSJ, POSPV2-1_8 + TMAX = max(TMAX,abs(A(KK))) + ENDDO + ELSE + JJ_ini = POSPV2 + OMP_FLAG = (NFRONT-JMAX-KEEP(253). GE. 300) + DO K = 1, NFRONT-JMAX-KEEP(253) + JJ = JJ_ini + int(K,8)*NFRONT8 + TMAX=max(TMAX,abs(A(JJ))) + ENDDO + DO KK = APOSJ, POSPV2 - 1_8 + IF (KK.NE.OFFDAG) THEN + TMAX = max(TMAX,abs(A(KK))) + ENDIF + ENDDO + ENDIF + DETPIV = A(POSPV1)*A(POSPV2) - A(OFFDAG)**2 + IF (SEUIL.GT.RZERO) THEN + IF (sqrt(abs(DETPIV)) .LE. SEUIL ) GOTO 460 + ENDIF + MAXPIV = max(abs(A(POSPV1)),abs(A(POSPV2))) + IF (MAXPIV.EQ.RZERO) MAXPIV = RONE + IF (abs(DETPIV)/MAXPIV.LE.TOL) GO TO 460 + IF ((abs(A(POSPV2))*RMAX+AMAX*TMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF ((abs(A(POSPV1))*TMAX+AMAX*RMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF (KEEP(258) .NE.0 ) THEN + CALL ZMUMPS_762(DETPIV, DKEEP(6), KEEP(259)) + ENDIF + PIVSIZ = 2 + KEEP(103) = KEEP(103)+1 + 415 CONTINUE + DO K=1,PIVSIZ + IF (PIVSIZ .EQ. 2) THEN + IF (K==1) THEN + LPIV = min(IPIV,JMAX) + ELSE + LPIV = max(IPIV,JMAX) + ENDIF + ELSE + LPIV = IPIV + ENDIF + IF (LPIV.EQ.NPIVP1) THEN + GOTO 416 + ENDIF + CALL ZMUMPS_319( A, LA, IW, LIW, + & IOLDPS, NPIVP1, LPIV, POSELT, NASS, + & LDA, NFRONT, 1, KEEP(219), KEEP(50), + & KEEP(IXSZ)) + 416 CONTINUE + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL ZMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, LPIV, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + NPIVP1 = NPIVP1 + 1 + ENDDO + IF(PIVSIZ .EQ. 2) THEN + A(POSELT+(LDA8+1_8)*int(NPIV,8)+1_8) = DETPIV + ENDIF + GOTO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 420 + 630 CONTINUE + PIVSIZ = 0 + IFLAG = -10 + 420 CONTINUE + IS_MAXFROMM_AVAIL = .FALSE. + RETURN + END SUBROUTINE ZMUMPS_222 + SUBROUTINE ZMUMPS_680( PIVRPTR, NBPANELS, PIVR, NASS, + & K, P, LastPanelonDisk, + & LastPIVRPTRIndexFilled) + IMPLICIT NONE + INTEGER, intent(in) :: NBPANELS, NASS, K, P + INTEGER, intent(inout) :: PIVRPTR(NBPANELS), PIVR(NASS) + INTEGER LastPanelonDisk, LastPIVRPTRIndexFilled + INTEGER I + IF ( LastPanelonDisk+1 > NBPANELS ) THEN + WRITE(*,*) "INTERNAL ERROR IN ZMUMPS_680!" + WRITE(*,*) "NASS=",NASS,"PIVRPTR=",PIVRPTR(1:NBPANELS) + WRITE(*,*) "K=",K, "P=",P, "LastPanelonDisk=",LastPanelonDisk + WRITE(*,*) "LastPIVRPTRIndexFilled=", LastPIVRPTRIndexFilled + CALL MUMPS_ABORT() + ENDIF + PIVRPTR(LastPanelonDisk+1) = K + 1 + IF (LastPanelonDisk.NE.0) THEN + PIVR(K - PIVRPTR(1) + 1) = P + DO I = LastPIVRPTRIndexFilled + 1, LastPanelonDisk + PIVRPTR(I)=PIVRPTR(LastPIVRPTRIndexFilled) + ENDDO + ENDIF + LastPIVRPTRIndexFilled = LastPanelonDisk + 1 + RETURN + END SUBROUTINE ZMUMPS_680 + SUBROUTINE ZMUMPS_226(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW, + & A,LA,LDA, POSTPONE_COL_UPDATE, + & IOLDPS,POSELT,IFINB,LKJIB,PIVSIZ,XSIZE, + & MAXFROMM, IS_MAXFROMM_AVAIL, IS_MAX_USEFUL, + & KEEP253) + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFINB,LKJIB, + & NPBEG, IBEG_BLOCK + INTEGER LDA + INTEGER(8) :: LA + INTEGER(8) :: NFRONT8 + COMPLEX(kind=8) A(LA) + LOGICAL POSTPONE_COL_UPDATE + INTEGER IW(LIW) + COMPLEX(kind=8) VALPIV + INTEGER(8) :: POSELT + DOUBLE PRECISION, intent(out) :: MAXFROMM + LOGICAL, intent(out) :: IS_MAXFROMM_AVAIL + LOGICAL, intent(in) :: IS_MAX_USEFUL + INTEGER, INTENT(in) :: KEEP253 + DOUBLE PRECISION :: MAXFROMMTMP + INTEGER IOLDPS, NCB1 + INTEGER(8) :: LDA8 + INTEGER(8) :: K1POS + INTEGER NPIV,JROW2 + INTEGER NEL2,NEL + INTEGER XSIZE + COMPLEX(kind=8) ONE, ZERO + INTEGER(8) :: APOS, LPOS, LPOS1, LPOS2 + INTEGER(8) :: POSPV1, POSPV2 + INTEGER PIVSIZ,NPIV_NEW,J2,I + INTEGER(8) :: OFFDAG, OFFDAG_OLD, IBEG, IEND + INTEGER(8) :: JJ, K1, K2, IROW + COMPLEX(kind=8) SWOP,DETPIV,MULT1,MULT2 + INCLUDE 'mumps_headers.h' + PARAMETER(ONE = (1.0D0,0.0D0), + & ZERO = (0.0D0,0.0D0)) + LDA8 = int(LDA,8) + NFRONT8= int(NFRONT,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIV_NEW = NPIV + PIVSIZ + NEL = NFRONT - NPIV_NEW + IFINB = 0 + IS_MAXFROMM_AVAIL = .FALSE. + JROW2 = IW(IOLDPS+3+XSIZE) + NPBEG = IBEG_BLOCK + NEL2 = JROW2 - NPIV_NEW + IF (NEL2.EQ.0) THEN + IF (JROW2.EQ.NASS) THEN + IFINB = -1 + ELSE + IFINB = 1 + ENDIF + ENDIF + IF(PIVSIZ .EQ. 1) THEN + APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + VALPIV = ONE/A(APOS) + A(APOS) = VALPIV + LPOS = APOS + LDA8 + MAXFROMM = 0.0D00 + IF (NEL2 > 0) THEN + IF (.NOT. IS_MAX_USEFUL) THEN + DO I=1, NEL2 + K1POS = LPOS + int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + DO JJ=1_8, int(I,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + ELSE + IS_MAXFROMM_AVAIL = .TRUE. + DO I=1, NEL2 + K1POS = LPOS + int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + A(K1POS+1_8)=A(K1POS+1_8) - A(K1POS) * A(APOS+1_8) + MAXFROMM=max( MAXFROMM,abs(A(K1POS+1_8)) ) + DO JJ = 2_8, int(I,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + ENDIF + ENDIF + IF (POSTPONE_COL_UPDATE) THEN + NCB1 = NASS - JROW2 + ELSE + NCB1 = NFRONT - JROW2 + ENDIF + IF (.NOT. IS_MAX_USEFUL) THEN + DO I=NEL2+1, NEL2 + NCB1 + K1POS = LPOS+ int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + DO JJ = 1_8, int(NEL2,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + ELSE + MAXFROMMTMP=0.0D0 + DO I=NEL2+1, NEL2 + NCB1 - KEEP253 + K1POS = LPOS+ int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + IF (NEL2 > 0) THEN + A(K1POS+1_8) = A(K1POS+1_8) - A(K1POS) * A(APOS+1_8) + MAXFROMMTMP=max(MAXFROMMTMP, abs(A(K1POS+1_8))) + DO JJ = 2_8, int(NEL2,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDIF + ENDDO + DO I = NEL2 + NCB1 - KEEP253 + 1, NEL2 + NCB1 + K1POS = LPOS+ int(I-1,8)*LDA8 + A(APOS+int(I,8))=A(K1POS) + A(K1POS) = A(K1POS) * VALPIV + DO JJ = 1_8, int(NEL2,8) + A(K1POS+JJ)=A(K1POS+JJ) - A(K1POS) * A(APOS+JJ) + ENDDO + ENDDO + MAXFROMM=max(MAXFROMM, MAXFROMMTMP) + ENDIF + ELSE + POSPV1 = POSELT + int(NPIV,8)*(NFRONT8 + 1_8) + POSPV2 = POSPV1 + NFRONT8 + 1_8 + OFFDAG_OLD = POSPV2 - 1_8 + OFFDAG = POSPV1 + 1_8 + SWOP = A(POSPV2) + DETPIV = A(OFFDAG) + A(POSPV2) = A(POSPV1)/DETPIV + A(POSPV1) = SWOP/DETPIV + A(OFFDAG) = -A(OFFDAG_OLD)/DETPIV + A(OFFDAG_OLD) = ZERO + LPOS1 = POSPV2 + LDA8 - 1_8 + LPOS2 = LPOS1 + 1_8 + CALL zcopy(NFRONT-NPIV_NEW, A(LPOS1), LDA, A(POSPV1+2_8), 1) + CALL zcopy(NFRONT-NPIV_NEW, A(LPOS2), LDA, A(POSPV2+1_8), 1) + JJ = POSPV2 + NFRONT8-1_8 + IBEG = JJ + 2_8 + IEND = IBEG + DO J2 = 1,NEL2 + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(OFFDAG)*A(K2)) + MULT2 = - (A(OFFDAG)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1 + 2_8 + K2 = POSPV2 + 1_8 + DO IROW = IBEG, IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A( JJ ) = -MULT1 + A( JJ + 1_8 ) = -MULT2 + IBEG = IBEG + NFRONT8 + IEND = IEND + NFRONT8 + 1_8 + JJ = JJ+NFRONT8 + ENDDO + IEND = IEND-1_8 + DO J2 = JROW2+1,NFRONT + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(OFFDAG)*A(K2)) + MULT2 = - (A(OFFDAG)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1 + 2_8 + K2 = POSPV2 + 1_8 + DO IROW = IBEG, IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A( JJ ) = -MULT1 + A( JJ + 1_8 ) = -MULT2 + IBEG = IBEG + NFRONT8 + IEND = IEND + NFRONT8 + JJ = JJ + NFRONT8 + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_226 + SUBROUTINE ZMUMPS_230(NFRONT,N,INODE,IW,LIW,A,LA, + & IOLDPS,POSELT) + IMPLICIT NONE + INTEGER NFRONT,N,INODE,LIW + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER IW(LIW) + COMPLEX(kind=8) VALPIV + INTEGER (8) :: APOS, POSELT, LPOS, NFRONT8 + INTEGER IOLDPS,NEL + INTEGER JROW + COMPLEX(kind=8), PARAMETER :: ONE = (1.0D0,0.0D0) + APOS = POSELT + VALPIV = ONE/A(APOS) + A(APOS) = VALPIV + NEL = NFRONT - 1 + IF (NEL.EQ.0) GO TO 500 + NFRONT8 = int(NFRONT,8) + LPOS = APOS + NFRONT8 + CALL ZMUMPS_XSYR('U',NEL, -VALPIV, + & A(LPOS), NFRONT, A(LPOS+1_8), NFRONT) + DO JROW = 1,NEL + A(LPOS) = VALPIV*A(LPOS) + LPOS = LPOS + NFRONT8 + END DO + 500 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_230 + SUBROUTINE ZMUMPS_234(IBEG_BLOCK, + & NFRONT,NASS,N,INODE,IW,LIW,A,LA, + & LDA, + & IOLDPS,POSELT,LKJIB_ORIG,LKJIB,LKJIT, + & POSTPONE_COL_UPDATE, + & KEEP,KEEP8 ) + IMPLICIT NONE + INTEGER NFRONT, NASS,N,LIW, IBEG_BLOCK + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER IW(LIW) + INTEGER LKJIB_ORIG, LKJIB, INODE, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: POSELT + INTEGER LDA + INTEGER(8) :: LDA8 + INTEGER IOLDPS, NPIV, JROW2, NPBEG + INTEGER NONEL, LKJIW, NEL1, NEL11 + INTEGER LBP, HF + INTEGER(8) :: LPOS,UPOS,APOS + INTEGER LKJIT + INTEGER LKJIBOLD, IROW + INTEGER I, Block + INTEGER BLSIZE + LOGICAL POSTPONE_COL_UPDATE + COMPLEX(kind=8) ONE, ALPHA + INCLUDE 'mumps_headers.h' + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + LDA8 = int(LDA,8) + LKJIBOLD = LKJIB + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + JROW2 = iabs(IW(IOLDPS+3+KEEP(IXSZ))) + NPBEG = IBEG_BLOCK + HF = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + NEL1 = NASS - JROW2 + LKJIW = NPIV - NPBEG + 1 + NEL11 = NFRONT - NPIV + IF ( LKJIW .NE. LKJIB ) THEN + NONEL = JROW2 - NPIV + 1 + IF ((NASS-NPIV).GE.LKJIT) THEN + LKJIB = LKJIB_ORIG + NONEL + IW(IOLDPS+3+KEEP(IXSZ))= min0(NPIV+LKJIB,NASS) + LKJIB = min0(LKJIB, NASS - NPIV) + ELSE + LKJIB = NASS - NPIV + IW(IOLDPS+3+KEEP(IXSZ)) = NASS + ENDIF + IBEG_BLOCK = NPIV + 1 + ELSEIF (JROW2.LT.NASS) THEN + IBEG_BLOCK = NPIV + 1 + IW(IOLDPS+3+KEEP(IXSZ)) = min0(JROW2+LKJIB,NASS) + LKJIB = min0(LKJIB,NASS-NPIV) + ENDIF + IF (LKJIW.EQ.0) GO TO 500 + IF (NEL1.NE.0) THEN + IF ( NASS - JROW2 > KEEP(7) ) THEN + BLSIZE = KEEP(8) + ELSE + BLSIZE = NASS - JROW2 + END IF + IF ( NASS - JROW2 .GT. 0 ) THEN +#if defined(SAK_BYROW) + DO IROW = JROW2+1, NASS, BLSIZE + Block = min( BLSIZE, NASS - IROW + 1 ) + LPOS = POSELT + int(IROW - 1,8) * LDA8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG - 1,8) * LDA8 + int(IROW - 1,8) + APOS = POSELT + int(IROW - 1,8) * LDA8 + int(JROW2,8) + CALL zgemm( 'N','N', IROW + Block - JROW2 - 1, Block, LKJIW, + & ALPHA, A( UPOS ), LDA, + & A( LPOS ), LDA, ONE, A( APOS ), LDA ) + ENDDO +#else + DO IROW = JROW2+1, NASS, BLSIZE + Block = min( BLSIZE, NASS - IROW + 1 ) + LPOS = POSELT + int( IROW - 1,8) * LDA8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG - 1,8) * LDA8 + int( IROW - 1,8) + APOS = POSELT + int( IROW - 1,8) * LDA8 + int( IROW - 1,8) + CALL zgemm( 'N','N', Block, NASS - IROW + 1, LKJIW, + & ALPHA, A( UPOS ), LDA, + & A( LPOS ), LDA, ONE, A( APOS ), LDA ) + END DO +#endif + END IF + LPOS = POSELT + int(NASS,8)*LDA8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG-1,8) * LDA8 + int(JROW2,8) + APOS = POSELT + int(NASS,8)*LDA8 + int(JROW2,8) + IF ( .NOT. POSTPONE_COL_UPDATE ) THEN + CALL zgemm('N', 'N', NEL1, NFRONT-NASS, LKJIW, ALPHA, + & A(UPOS), LDA, A(LPOS), LDA, ONE, + & A(APOS), LDA) + END IF + ENDIF + 500 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_234 + SUBROUTINE ZMUMPS_319( A, LA, IW, LIW, + & IOLDPS, NPIVP1, IPIV, POSELT, NASS, + & LDA, NFRONT, LEVEL, K219, K50, XSIZE ) + IMPLICIT NONE + INTEGER(8) :: POSELT, LA + INTEGER LIW, IOLDPS, NPIVP1, IPIV + INTEGER LDA, NFRONT, NASS, LEVEL, K219, K50, XSIZE + COMPLEX(kind=8) A( LA ) + INTEGER IW( LIW ) + INCLUDE 'mumps_headers.h' + INTEGER ISW, ISWPS1, ISWPS2, HF + INTEGER(8) :: IDIAG, APOS + INTEGER(8) :: LDA8 + COMPLEX(kind=8) SWOP + LDA8 = int(LDA,8) + APOS = POSELT + LDA8*int(IPIV-1,8) + int(NPIVP1-1,8) + IDIAG = APOS + int(IPIV - NPIVP1,8) + HF = 6 + IW( IOLDPS + 5 + XSIZE) + XSIZE + ISWPS1 = IOLDPS + HF + NPIVP1 - 1 + ISWPS2 = IOLDPS + HF + IPIV - 1 + ISW = IW(ISWPS1) + IW(ISWPS1) = IW(ISWPS2) + IW(ISWPS2) = ISW + ISW = IW(ISWPS1+NFRONT) + IW(ISWPS1+NFRONT) = IW(ISWPS2+NFRONT) + IW(ISWPS2+NFRONT) = ISW + IF ( LEVEL .eq. 2 ) THEN + CALL zswap( NPIVP1 - 1, + & A( POSELT + int(NPIVP1-1,8) ), LDA, + & A( POSELT + int(IPIV-1,8) ), LDA ) + END IF + CALL zswap( NPIVP1-1, + & A( POSELT+int(NPIVP1-1,8) * LDA8 ), 1, + & A( POSELT + int(IPIV-1,8) * LDA8 ), 1 ) + CALL zswap( IPIV - NPIVP1 - 1, + & A( POSELT+int(NPIVP1,8) * LDA8 + int(NPIVP1-1,8) ), + & LDA, A( APOS + 1_8 ), 1 ) + SWOP = A(IDIAG) + A(IDIAG) = A( POSELT+int(NPIVP1-1,8)*LDA8+int(NPIVP1-1,8) ) + A( POSELT + int(NPIVP1-1,8)*LDA8 + int(NPIVP1-1,8) ) = SWOP + CALL zswap( NASS - IPIV, A( APOS + LDA8 ), LDA, + & A( IDIAG + LDA8 ), LDA ) + IF ( LEVEL .eq. 1 ) THEN + CALL zswap( NFRONT - NASS, + & A( APOS + int(NASS-IPIV+1,8) * LDA8 ), LDA, + & A( IDIAG + int(NASS-IPIV+1,8) * LDA8 ), LDA ) + END IF + IF (K219.NE.0 .AND.K50.EQ.2) THEN + IF ( LEVEL .eq. 2) THEN + APOS = POSELT+LDA8*LDA8-1_8 + SWOP = A(APOS+int(NPIVP1,8)) + A(APOS+int(NPIVP1,8))= A(APOS+int(IPIV,8)) + A(APOS+int(IPIV,8)) = SWOP + ENDIF + ENDIF + RETURN + END SUBROUTINE ZMUMPS_319 + SUBROUTINE ZMUMPS_237(NFRONT,NASS,N,INODE, + & IW,LIW,A,LA, + & LDA, + & IOLDPS,POSELT,KEEP,KEEP8, + & POSTPONE_COL_UPDATE, ETATASS, + & TYPEFile, LAFAC, MonBloc, NextPiv2beWritten, + & LIWFAC, MYID, IFLAG + & ) + USE ZMUMPS_OOC + IMPLICIT NONE + INTEGER NFRONT, NASS,N,INODE,LIW + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER IW(LIW) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER(8) :: POSELT + INTEGER LDA + INTEGER IOLDPS, ETATASS + LOGICAL POSTPONE_COL_UPDATE + INTEGER(8) :: LAFAC + INTEGER TYPEFile, NextPiv2beWritten + INTEGER LIWFAC, MYID, IFLAG + TYPE(IO_BLOCK):: MonBloc + INTEGER IDUMMY + LOGICAL LAST_CALL + INCLUDE 'mumps_headers.h' + INTEGER(8) :: UPOS, APOS, LPOS + INTEGER(8) :: LDA8 + INTEGER BLSIZE, BLSIZE2, Block, IROW, NPIV, I, IROWEND + INTEGER I2, I2END, Block2 + COMPLEX(kind=8) ONE, ALPHA, BETA, ZERO + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + PARAMETER (ZERO=(0.0D0,0.0D0)) + LDA8 = int(LDA,8) + IF (ETATASS.EQ.1) THEN + BETA = ZERO + ELSE + BETA = ONE + ENDIF + IF ( NFRONT - NASS > KEEP(57) ) THEN + BLSIZE = KEEP(58) + ELSE + BLSIZE = NFRONT - NASS + END IF + BLSIZE2 = KEEP(218) + NPIV = IW( IOLDPS + 1 + KEEP(IXSZ)) + IF ( NFRONT - NASS .GT. 0 ) THEN + IF ( POSTPONE_COL_UPDATE ) THEN + CALL ztrsm( 'L', 'U', 'T', 'U', + & NPIV, NFRONT-NPIV, ONE, + & A( POSELT ), LDA, + & A( POSELT + LDA8 * int(NPIV,8) ), LDA ) + ENDIF + DO IROWEND = NFRONT - NASS, 1, -BLSIZE + Block = min( BLSIZE, IROWEND ) + IROW = IROWEND - Block + 1 + LPOS = POSELT + int(NASS,8)*LDA8 + int(IROW-1,8) * LDA8 + APOS = POSELT + int(NASS,8)*LDA8 + int(IROW-1,8) * LDA8 + + & int(NASS + IROW - 1,8) + UPOS = POSELT + int(NASS,8) + IF (.NOT. POSTPONE_COL_UPDATE) THEN + UPOS = POSELT + int(NASS + IROW - 1,8) + ENDIF + IF (POSTPONE_COL_UPDATE) THEN + DO I = 1, NPIV + CALL zcopy( Block, A( LPOS+int(I-1,8) ), LDA, + & A( UPOS+int(I-1,8)*LDA8 ), 1 ) + CALL zscal( Block, A(POSELT+(LDA8+1_8)*int(I-1,8)), + & A( LPOS + int(I - 1,8) ), LDA ) + ENDDO + ENDIF + DO I2END = Block, 1, -BLSIZE2 + Block2 = min(BLSIZE2, I2END) + I2 = I2END - Block2+1 + CALL zgemm('N', 'N', Block2, Block-I2+1, NPIV, ALPHA, + & A(UPOS+int(I2-1,8)), LDA, + & A(LPOS+int(I2-1,8)*LDA8), LDA, + & BETA, + & A(APOS + int(I2-1,8) + int(I2-1,8)*LDA8), LDA) + IF (KEEP(201).EQ.1) THEN + IF (NextPiv2beWritten.LE.NPIV) THEN + LAST_CALL=.FALSE. + CALL ZMUMPS_688( + & STRAT_TRY_WRITE, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, MYID, + & KEEP8(31), + & IFLAG,LAST_CALL ) + IF (IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + ENDDO + IF ( NFRONT - NASS - IROW + 1 - Block > 0 ) THEN + CALL zgemm( 'N', 'N', Block, NFRONT-NASS-Block-IROW+1, NPIV, + & ALPHA, A( UPOS ), LDA, + & A( LPOS + LDA8 * int(Block,8) ), LDA, + & BETA, + & A( APOS + LDA8 * int(Block,8) ), LDA ) + ENDIF + END DO + END IF + RETURN + END SUBROUTINE ZMUMPS_237 + SUBROUTINE ZMUMPS_320( BUF, BLOCK_SIZE, + & MYROW, MYCOL, NPROW, NPCOL, + & A, LOCAL_M, LOCAL_N, N, MYID, COMM ) + IMPLICIT NONE + INTEGER BLOCK_SIZE, NPROW, NPCOL, LOCAL_M, LOCAL_N, N, COMM + INTEGER MYROW, MYCOL, MYID + COMPLEX(kind=8) BUF( BLOCK_SIZE * BLOCK_SIZE ) + COMPLEX(kind=8) A( LOCAL_M, LOCAL_N ) + INTEGER NBLOCK, IBLOCK, JBLOCK, IBLOCK_SIZE, JBLOCK_SIZE + INTEGER ROW_SOURCE, ROW_DEST, COL_SOURCE, COL_DEST + INTEGER IGLOB, JGLOB + INTEGER IROW_LOC_SOURCE, JCOL_LOC_SOURCE + INTEGER IROW_LOC_DEST, JCOL_LOC_DEST + INTEGER PROC_SOURCE, PROC_DEST + NBLOCK = ( N - 1 ) / BLOCK_SIZE + 1 + DO IBLOCK = 1, NBLOCK + IF ( IBLOCK .NE. NBLOCK + & ) THEN + IBLOCK_SIZE = BLOCK_SIZE + ELSE + IBLOCK_SIZE = N - ( NBLOCK - 1 ) * BLOCK_SIZE + END IF + ROW_SOURCE = mod( IBLOCK - 1, NPROW ) + COL_DEST = mod( IBLOCK - 1, NPCOL ) + IGLOB = ( IBLOCK - 1 ) * BLOCK_SIZE + 1 + IROW_LOC_SOURCE = BLOCK_SIZE * + & ( ( IGLOB - 1 ) / (BLOCK_SIZE*NPROW) ) + & + mod( IGLOB - 1, BLOCK_SIZE ) + 1 + JCOL_LOC_DEST = BLOCK_SIZE * + & ( ( IGLOB - 1 ) / (BLOCK_SIZE*NPCOL) ) + & + mod( IGLOB - 1, BLOCK_SIZE ) + 1 + DO JBLOCK = 1, IBLOCK + IF ( JBLOCK .NE. NBLOCK + & ) THEN + JBLOCK_SIZE = BLOCK_SIZE + ELSE + JBLOCK_SIZE = N - ( NBLOCK - 1 ) * BLOCK_SIZE + END IF + COL_SOURCE = mod( JBLOCK - 1, NPCOL ) + ROW_DEST = mod( JBLOCK - 1, NPROW ) + PROC_SOURCE = ROW_SOURCE * NPCOL + COL_SOURCE + PROC_DEST = ROW_DEST * NPCOL + COL_DEST + IF ( PROC_SOURCE .eq. PROC_DEST ) THEN + IF ( MYID .eq. PROC_DEST ) THEN + JGLOB = ( JBLOCK - 1 ) * BLOCK_SIZE + 1 + JCOL_LOC_SOURCE = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPCOL) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + IROW_LOC_DEST = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPROW) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + IF ( IBLOCK .eq. JBLOCK ) THEN + IF ( IBLOCK_SIZE .ne. JBLOCK_SIZE ) THEN + WRITE(*,*) MYID,': Error in calling transdiag:unsym' + CALL MUMPS_ABORT() + END IF + CALL ZMUMPS_327( A( IROW_LOC_SOURCE, + & JCOL_LOC_SOURCE), + & IBLOCK_SIZE, LOCAL_M ) + ELSE + CALL ZMUMPS_326( + & A( IROW_LOC_SOURCE, JCOL_LOC_SOURCE ), + & A( IROW_LOC_DEST, JCOL_LOC_DEST ), + & IBLOCK_SIZE, JBLOCK_SIZE, LOCAL_M ) + END IF + END IF + ELSE IF ( MYROW .eq. ROW_SOURCE + & .AND. MYCOL .eq. COL_SOURCE ) THEN + JGLOB = ( JBLOCK - 1 ) * BLOCK_SIZE + 1 + JCOL_LOC_SOURCE = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPCOL) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + CALL ZMUMPS_293( BUF, + & A( IROW_LOC_SOURCE, JCOL_LOC_SOURCE ), LOCAL_M, + & IBLOCK_SIZE, JBLOCK_SIZE, COMM, PROC_DEST ) + ELSE IF ( MYROW .eq. ROW_DEST + & .AND. MYCOL .eq. COL_DEST ) THEN + JGLOB = ( JBLOCK - 1 ) * BLOCK_SIZE + 1 + IROW_LOC_DEST = BLOCK_SIZE * + & ( ( JGLOB - 1 ) / (BLOCK_SIZE*NPROW) ) + & + mod( JGLOB - 1, BLOCK_SIZE ) + 1 + CALL ZMUMPS_281( BUF, + & A( IROW_LOC_DEST, JCOL_LOC_DEST ), LOCAL_M, + & JBLOCK_SIZE, IBLOCK_SIZE, COMM, PROC_SOURCE ) + END IF + END DO + END DO + RETURN + END SUBROUTINE ZMUMPS_320 + SUBROUTINE ZMUMPS_293( BUF, A, LDA, M, N, COMM, DEST ) + IMPLICIT NONE + INTEGER M, N, LDA, DEST, COMM + COMPLEX(kind=8) BUF(*), A(LDA,*) + INTEGER I, IBUF, IERR + INTEGER J + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + IBUF = 1 + DO J = 1, N + BUF( IBUF: IBUF + M - 1 ) = A( 1 : M, J ) + DO I = 1, M + END DO + IBUF = IBUF + M + END DO + CALL MPI_SEND( BUF, M * N, MPI_DOUBLE_COMPLEX, + & DEST, SYMMETRIZE, COMM, IERR ) + RETURN + END SUBROUTINE ZMUMPS_293 + SUBROUTINE ZMUMPS_281( BUF, A, LDA, M, N, COMM, SOURCE ) + IMPLICIT NONE + INTEGER LDA, M, N, COMM, SOURCE + COMPLEX(kind=8) BUF(*), A( LDA, *) + INTEGER I, IBUF, IERR + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + CALL MPI_RECV( BUF(1), M * N, MPI_DOUBLE_COMPLEX, SOURCE, + & SYMMETRIZE, COMM, STATUS, IERR ) + IBUF = 1 + DO I = 1, M + CALL zcopy( N, BUF(IBUF), 1, A(I,1), LDA ) + IBUF = IBUF + N + END DO + RETURN + END SUBROUTINE ZMUMPS_281 + SUBROUTINE ZMUMPS_327( A, N, LDA ) + IMPLICIT NONE + INTEGER N,LDA + COMPLEX(kind=8) A( LDA, * ) + INTEGER I, J + DO I = 2, N + DO J = 1, I - 1 + A( J, I ) = A( I, J ) + END DO + END DO + RETURN + END SUBROUTINE ZMUMPS_327 + SUBROUTINE ZMUMPS_326( A1, A2, M, N, LD ) + IMPLICIT NONE + INTEGER M,N,LD + COMPLEX(kind=8) A1( LD,* ), A2( LD, * ) + INTEGER I, J + DO J = 1, N + DO I = 1, M + A2( J, I ) = A1( I, J ) + END DO + END DO + RETURN + END SUBROUTINE ZMUMPS_326 + RECURSIVE SUBROUTINE ZMUMPS_274( + & COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_LOAD + USE ZMUMPS_OOC + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mumps_headers.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER(8) IPTRLU, LRLU, LRLUS, LA, POSFAC + INTEGER COMP + INTEGER IFLAG, IERROR, NBFIN, MSGSOU + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)) + INTEGER(8) PTRAST(KEEP(28)), PTRFAC(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER NBPROCFILS( KEEP(28) ), STEP(N), + & PIMASTER(KEEP(28)) + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER COMM, MYID + INTEGER PTLUST_S(KEEP(28)), + & ITLOC(N+KEEP(253)), FILS(N), ND(KEEP(28)) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER FRERE_STEPS(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION FLOP1 + COMPLEX(kind=8) DBLARR( max(1,KEEP(13)) ) + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER PIVI + INTEGER (8) POSPV1,POSPV2,OFFDAG,LPOS1 + INTEGER J2 + COMPLEX(kind=8) MULT1,MULT2 + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER LP + INTEGER INODE, POSITION, NPIV, IERR + INTEGER NCOL + INTEGER(8) LAELL, POSBLOCFACTO + INTEGER(8) POSELT + INTEGER IOLDPS, LCONT1, NASS1, NROW1, NCOL1, NPIV1 + INTEGER NSLAV1, HS, ISW, DEST + INTEGER ICT11 + INTEGER(8) LPOS, LPOS2, DPOS, UPOS + INTEGER (8) IPOS, KPOS + INTEGER I, IPIV, FPERE, NSLAVES_TOT, + & NSLAVES_FOLLOW, NB_BLOC_FAC + INTEGER IPOSK, JPOSK, NPIVSENT, Block, IROW, BLSIZE + INTEGER allocok, TO_UPDATE_CPT_END + COMPLEX(kind=8), DIMENSION(:),ALLOCATABLE :: UIP21K + INTEGER, DIMENSION(:), ALLOCATABLE :: LIST_SLAVES_FOLLOW + LOGICAL LASTBL + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + COMPLEX(kind=8) ONE,ALPHA + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, NextPivDummy + LOGICAL LAST_CALL + TYPE(IO_BLOCK) :: MonBloc + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + LP = ICNTL(1) + IF (ICNTL(4) .LE. 0) LP = -1 + FPERE = -1 + POSITION = 0 + TO_UPDATE_CPT_END = -654321 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, + & MPI_INTEGER, COMM, IERR ) + LASTBL = (NPIV.LE.0) + IF (LASTBL) THEN + NPIV = -NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NSLAVES_TOT, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NB_BLOC_FAC, 1, + & MPI_INTEGER, COMM, IERR ) + ENDIF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOL, 1, + & MPI_INTEGER, COMM, IERR ) + LAELL = int(NPIV,8) * int(NCOL,8) + IF ( NPIV.GT.0 ) THEN + IF ( LRLU .LT. LAELL .OR. IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF ( LRLUS .LT. LAELL ) THEN + IFLAG = -9 + CALL MUMPS_731(LAELL-LRLUS, IERROR) + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE IN ZMUMPS_274, + & REAL WORKSPACE TOO SMALL" + GOTO 700 + END IF + CALL ZMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS=' + & ,LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731(LAELL-LRLUS,IERROR) + GOTO 700 + END IF + IF ( IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE IN ZMUMPS_274, + & INTEGER WORKSPACE TOO SMALL" + IFLAG = -8 + IERROR = IWPOS + NPIV - 1 - IWPOSCB + GOTO 700 + END IF + END IF + LRLU = LRLU - LAELL + LRLUS = LRLUS - LAELL + ENDIF + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSBLOCFACTO = POSFAC + POSFAC = POSFAC + LAELL + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,LAELL,KEEP,KEEP8,LRLU) + IF ( NPIV.GT.0 ) THEN + IPIV = IWPOS + IWPOS = IWPOS + NPIV + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IW( IPIV ), NPIV, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSBLOCFACTO), NPIV*NCOL, MPI_DOUBLE_COMPLEX, + & COMM, IERR ) + ENDIF + IF (PTRIST(STEP( INODE )) .EQ. 0) THEN + DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 ) + BLOCKING = .TRUE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + ENDIF + DO WHILE ( NBPROCFILS(STEP(INODE)) .NE. 0 ) + BLOCKING = .TRUE. + SET_IRECV=.FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, CONTRIB_TYPE2, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .TRUE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IOLDPS = PTRIST(STEP(INODE)) + POSELT = PTRAST(STEP(INODE)) + LCONT1 = IW( IOLDPS + KEEP(IXSZ)) + NASS1 = IW( IOLDPS + 1 + KEEP(IXSZ)) + NROW1 = IW( IOLDPS + 2 + KEEP(IXSZ)) + NPIV1 = IW( IOLDPS + 3 + KEEP(IXSZ)) + NSLAV1 = IW( IOLDPS + 5 + KEEP(IXSZ)) + NSLAVES_FOLLOW = NSLAV1 - XTRA_SLAVES_SYM + HS = 6 + NSLAV1 + KEEP(IXSZ) + NCOL1 = LCONT1 + NPIV1 + IF ( LASTBL ) THEN + TO_UPDATE_CPT_END = ( NSLAVES_TOT - NSLAVES_FOLLOW - 1 ) * + & NB_BLOC_FAC + END IF + IF (NPIV.GT.0) THEN + IF ( NPIV1 + NCOL .NE. NASS1 ) THEN + WRITE(*,*) 'SymBLFC Error: NPIV1 + NCOL .NE. NASS1 :', + & NPIV1,NCOL,NASS1 + CALL MUMPS_ABORT() + END IF + ICT11 = IOLDPS+HS+NROW1+NPIV1 - 1 + DO I = 1, NPIV + PIVI = abs(IW(IPIV+I-1)) + IF (PIVI.EQ.I) CYCLE + ISW = IW(ICT11+I) + IW(ICT11+I) = IW(ICT11+PIVI) + IW(ICT11+PIVI) = ISW + IPOS = POSELT + int(NPIV1 + I - 1,8) + KPOS = POSELT + int(NPIV1 + PIVI - 1,8) + CALL zswap(NROW1, A(IPOS), NCOL1, A(KPOS), NCOL1) + ENDDO + ALLOCATE( UIP21K( NPIV * NROW1 ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": ALLOCATION FAILURE FOR UIP21K IN ZMUMPS_274" + IFLAG = -13 + IERROR = NPIV * NROW1 + GOTO 700 + END IF + IF ( NSLAVES_FOLLOW .NE. 0 .and. NPIV .NE. 0 ) THEN + ALLOCATE( LIST_SLAVES_FOLLOW ( NSLAVES_FOLLOW ), + & stat = allocok ) + IF ( allocok .GT. 0 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": ALLOCATION FAILURE FOR LIST_SLAVES_FOLLOW + & IN ZMUMPS_274" + IFLAG = -13 + IERROR = NSLAVES_FOLLOW + GOTO 700 + END IF + LIST_SLAVES_FOLLOW(1:NSLAVES_FOLLOW)= + & IW(IOLDPS+6+XTRA_SLAVES_SYM+KEEP(IXSZ): + & IOLDPS+5+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_FOLLOW) + END IF + CALL ztrsm( 'L', 'U', 'T', 'U', NPIV, NROW1, ONE, + & A( POSBLOCFACTO ), NCOL, + & A(POSELT+int(NPIV1,8)), NCOL1 ) + LPOS = POSELT + int(NPIV1,8) + UPOS = 1_8 + DO I = 1, NROW1 + UIP21K( UPOS: UPOS + int(NPIV-1,8) ) = + & A(LPOS: LPOS+int(NPIV-1,8)) + LPOS = LPOS + int(NCOL1,8) + UPOS = UPOS + int(NPIV,8) + END DO + LPOS = POSELT + int(NPIV1,8) + DPOS = POSBLOCFACTO + I = 1 + DO + IF(I .GT. NPIV) EXIT + IF(IW(IPIV+I-1) .GT. 0) THEN + CALL zscal( NROW1, A(DPOS), A(LPOS), NCOL1 ) + LPOS = LPOS + 1_8 + DPOS = DPOS + int(NCOL + 1,8) + I = I+1 + ELSE + POSPV1 = DPOS + POSPV2 = DPOS+ int(NCOL + 1,8) + OFFDAG = POSPV1+1_8 + LPOS1 = LPOS + DO J2 = 1,NROW1 + MULT1 = A(POSPV1)*A(LPOS1)+A(OFFDAG)*A(LPOS1+1_8) + MULT2 = A(OFFDAG)*A(LPOS1)+A(POSPV2)*A(LPOS1+1_8) + A(LPOS1) = MULT1 + A(LPOS1+1_8) = MULT2 + LPOS1 = LPOS1 + int(NCOL1,8) + ENDDO + LPOS = LPOS + 2_8 + DPOS = POSPV2 + int(NCOL + 1,8) + I = I+2 + ENDIF + ENDDO + ENDIF + IF (KEEP(201).eq.1) THEN + MonBloc%INODE = INODE + MonBloc%MASTER = .FALSE. + MonBloc%Typenode = 2 + MonBloc%NROW = NROW1 + MonBloc%NCOL = NCOL1 + MonBloc%NFS = NASS1 + MonBloc%LastPiv = NPIV1 + NPIV + NULLIFY(MonBloc%INDICES) + MonBloc%Last = LASTBL + STRAT = STRAT_TRY_WRITE + NextPivDummy = -8888 + LIWFAC = IW(IOLDPS+XXI) + CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR)) + LAST_CALL=.FALSE. + CALL ZMUMPS_688( STRAT, TYPEF_L, A(POSELT), + & LAFAC, MonBloc, NextPivDummy, NextPivDummy, + & IW(IOLDPS), LIWFAC, MYID, KEEP8(31), IFLAG,LAST_CALL) + ENDIF + IF (NPIV.GT.0) THEN + LPOS2 = POSELT + int(NPIV1,8) + UPOS = POSBLOCFACTO+int(NPIV,8) + LPOS = LPOS2 + int(NPIV,8) + CALL zgemm('N','N', NCOL-NPIV,NROW1,NPIV,ALPHA,A(UPOS),NCOL, + & A(LPOS2),NCOL1,ONE, A(LPOS),NCOL1) + DPOS = POSELT + int(NCOL1 - NROW1,8) + IF ( NROW1 .GT. KEEP(7) ) THEN + BLSIZE = KEEP(8) + ELSE + BLSIZE = NROW1 + ENDIF + IF ( NROW1 .GT. 0 ) THEN + DO IROW = 1, NROW1, BLSIZE + Block = min( BLSIZE, NROW1 - IROW + 1 ) + DPOS = POSELT + int(NCOL1 - NROW1,8) + & + int( IROW - 1, 8 ) * int( NCOL1 + 1, 8 ) + LPOS2 = POSELT + int(NPIV1,8) + & + int( IROW - 1, 8 ) * int( NCOL1, 8 ) + UPOS = int( IROW - 1, 8 ) * int(NPIV, 8) + 1_8 + DO I = 1, Block + CALL zgemv( 'T', NPIV, Block-I+1, ALPHA, + & A( LPOS2 + int(I - 1,8) * int(NCOL1,8) ), NCOL1, + & UIP21K( UPOS + int(NPIV,8) * int( I - 1, 8 ) ), + & 1, ONE, A(DPOS+int(NCOL1+1,8)*int(I-1,8)),NCOL1 ) + END DO + IF ( NROW1-IROW+1-Block .ne. 0 ) + & CALL zgemm( 'T', 'N', Block, NROW1-IROW+1-Block, NPIV, ALPHA, + & UIP21K( UPOS ), NPIV, + & A( LPOS2 + int(Block,8) * int(NCOL1,8) ), NCOL1, ONE, + & A( DPOS + int(Block,8) * int(NCOL1,8) ), NCOL1 ) + ENDDO + ENDIF + FLOP1 = dble(NROW1) * dble(NPIV) * + & dble( 2 * NCOL - NPIV + NROW1 +1 ) + FLOP1 = -FLOP1 + CALL ZMUMPS_190( 1, .FALSE., FLOP1, KEEP,KEEP8 ) + ENDIF + IW(IOLDPS+KEEP(IXSZ)) = IW(IOLDPS+KEEP(IXSZ)) - NPIV + IW(IOLDPS + 3+KEEP(IXSZ)) = IW(IOLDPS+3+KEEP(IXSZ)) + NPIV + IF (LASTBL) IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS + 3+KEEP(IXSZ)) + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + IWPOS = IWPOS - NPIV + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + IF ( NSLAVES_FOLLOW .NE. 0 .and. NPIV .NE. 0 ) THEN + IPOSK = NPIV1 + 1 + JPOSK = NCOL1 - NROW1 + 1 + NPIVSENT = NPIV + IERR = -1 + DO WHILE ( IERR .eq. -1 ) + CALL ZMUMPS_64( + & INODE, NPIVSENT, FPERE, + & IPOSK, JPOSK, + & UIP21K, NROW1, + & NSLAVES_FOLLOW, + & LIST_SLAVES_FOLLOW(1), + & COMM, IERR ) + IF (IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV= .FALSE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END IF + END DO + IF ( IERR .eq. -2 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE, SEND BUFFER TOO SMALL DURING + & ZMUMPS_274" + WRITE(LP,*) "NPIV=", NPIV, "NROW1=",NROW1 + IFLAG = -17 + IERROR = 5 * KEEP(34) + NPIV * NROW1 * KEEP(35) + GOTO 700 + END IF + IF ( IERR .eq. -3 ) THEN + IF (LP > 0 ) WRITE(LP,*) MYID, + &": FAILURE, RECV BUFFER TOO SMALL DURING + & ZMUMPS_274" + IFLAG = -20 + IERROR = 5 * KEEP(34) + NPIV * NROW1 * KEEP(35) + GOTO 700 + END IF + DEALLOCATE(LIST_SLAVES_FOLLOW) + END IF + IF ( NPIV .NE. 0 ) DEALLOCATE( UIP21K ) + IOLDPS = PTRIST(STEP(INODE)) + IF (LASTBL) THEN + IW(IOLDPS+6+KEEP(IXSZ)) = IW(IOLDPS+6+KEEP(IXSZ)) - + & TO_UPDATE_CPT_END + IF ( IW(IOLDPS+6+KEEP(IXSZ) ) .eq. 0 + & .and. KEEP(50) .ne. 0 .and. NSLAVES_FOLLOW .eq. 0 + & .and. NSLAVES_TOT.NE.1)THEN + DEST = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + CALL ZMUMPS_62( INODE, DEST, END_NIV2_LDLT, + & COMM, IERR ) + IF ( IERR .LT. 0 ) THEN + write(*,*) ' Internal error in PROCESS_SYM_BLOCFACTO.' + IFLAG = -99 + GOTO 700 + END IF + ENDIF + END IF + IF (LASTBL) THEN + IF (IW(IOLDPS+6+KEEP(IXSZ)) .eq. 0 ) THEN + CALL ZMUMPS_759( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ENDIF + ENDIF + 600 CONTINUE + RETURN + 700 CONTINUE + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE ZMUMPS_274 + RECURSIVE SUBROUTINE ZMUMPS_759( + & COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mumps_headers.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER INODE, FPERE + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER COMM, MYID + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)), PTLUST_S(KEEP(28)) + INTEGER IWPOS, IWPOSCB + INTEGER LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)) + INTEGER COMP, IFLAG, IERROR + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER NBFIN, SLAVEF + DOUBLE PRECISION OPASSW, OPELIW + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER ND( KEEP(28) ) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER FRERE_STEPS(KEEP(28)) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX(kind=8) DBLARR( max(1,KEEP(13)) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER ITYPE2 + INTEGER IHDR_REC + PARAMETER (ITYPE2=2) + INTEGER IOLDPS, NROW, LDA + INTEGER NPIV, LCONT, NELIM, NASS, NCOL_TO_SEND, + & SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON + INTEGER(8) :: SHIFT_VAL_SON + INTEGER(8) MEM_GAIN + IF (KEEP(50).EQ.0) THEN + IHDR_REC=6 + ELSE + IHDR_REC=8 + ENDIF + IOLDPS = PTRIST(STEP(INODE)) + IW(IOLDPS+XXS)=S_ALL + IF (KEEP(214).EQ.1) THEN + CALL ZMUMPS_314( N, INODE, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE2 + & ) + IOLDPS = PTRIST(STEP(INODE)) + IF (KEEP(38).NE.FPERE) THEN + IW(IOLDPS+XXS)=S_NOLCBNOCONTIG + IF (KEEP(216).NE.3) THEN + MEM_GAIN=int(IW( IOLDPS + 2 + KEEP(IXSZ) ),8)* + & int(IW( IOLDPS + 3 + KEEP(IXSZ) ),8) + LRLUS = LRLUS+MEM_GAIN + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLU) + ENDIF + ENDIF + IF (KEEP(216).EQ.2) THEN + IF (FPERE.NE.KEEP(38)) THEN + CALL ZMUMPS_627(A,LA,PTRAST(STEP(INODE)), + & IW( IOLDPS + 2 + KEEP(IXSZ) ), + & IW( IOLDPS + KEEP(IXSZ) ), + & IW( IOLDPS + 3 + KEEP(IXSZ) )+ + & IW( IOLDPS + KEEP(IXSZ) ), 0, + & IW( IOLDPS + XXS ), 0_8 ) + IW(IOLDPS+XXS)=S_NOLCBCONTIG + IW(IOLDPS+XXS)=S_NOLCBCONTIG + ENDIF + ENDIF + ENDIF + IF ( KEEP(38).EQ.FPERE) THEN + LCONT = IW(IOLDPS+KEEP(IXSZ)) + NROW = IW(IOLDPS+2+KEEP(IXSZ)) + NPIV = IW(IOLDPS+3+KEEP(IXSZ)) + NASS = IW(IOLDPS+4+KEEP(IXSZ)) + NELIM = NASS-NPIV + NCOL_TO_SEND = LCONT-NELIM + SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NASS + SHIFT_VAL_SON = int(NASS,8) + LDA = LCONT + NPIV + IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOTBAND_INIT) THEN + IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_REC_CONTSTATIC + ELSE + ENDIF + CALL ZMUMPS_80( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & PTRIST, PTRAST, + & root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA, + & ROOT_CONT_STATIC, MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, + & PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG < 0 ) GOTO 600 + IF (NELIM.EQ.0) THEN + IF (KEEP(214).EQ.2) THEN + CALL ZMUMPS_314( N, INODE, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, + & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, + & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, + & IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE2 + & ) + ENDIF + CALL ZMUMPS_626( N, INODE, PTRIST, PTRAST, IW, LIW, + & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP, + & MYID, KEEP + & ) + ELSE + IOLDPS = PTRIST(STEP(INODE)) + IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOT2SON_CALLED) THEN + CALL ZMUMPS_626( N, INODE, PTRIST, PTRAST, IW, LIW, + & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP, + & MYID, KEEP + & ) + ELSE + IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_ROOTBAND_INIT + IF (KEEP(214).EQ.1.AND.KEEP(216).NE.3) THEN + IW(IOLDPS+XXS)=S_NOLCBNOCONTIG38 + CALL ZMUMPS_628( IW(IOLDPS), + & LIW-IOLDPS+1, + & MEM_GAIN, KEEP(IXSZ) ) + LRLUS = LRLUS + MEM_GAIN + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLU) + IF (KEEP(216).EQ.2) THEN + CALL ZMUMPS_627(A,LA,PTRAST(STEP(INODE)), + & IW( IOLDPS + 2 + KEEP(IXSZ) ), + & IW( IOLDPS + KEEP(IXSZ) ), + & IW( IOLDPS + 3 + KEEP(IXSZ) )+ + & IW( IOLDPS + KEEP(IXSZ) ), + & IW( IOLDPS + 4 + KEEP(IXSZ) ) - + & IW( IOLDPS + 3 + KEEP(IXSZ) ), + & IW( IOLDPS + XXS ),0_8) + IW(IOLDPS+XXS)=S_NOLCBCONTIG38 + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + 600 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_759 + SUBROUTINE ZMUMPS_141( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, A, LA, + & UU, NOFFW, + & NPVW, + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED, + & DKEEP,PIVNUL_LIST,LPN_LIST ) + USE ZMUMPS_OOC + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, INODE, FPERE, LIW, NOFFW, NPVW + INTEGER(8) :: LA + COMPLEX(kind=8) A( LA ) + DOUBLE PRECISION UU, SEUIL + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER COMM, MYID, LBUFR, LBUFR_BYTES + INTEGER LPTRAR, NELT + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS + INTEGER NBFIN, IFLAG, IERROR, LEAF, LPOOL, SLAVEF, + & IWPOS, IWPOSCB, COMP + INTEGER NB_BLOC_FAC + INTEGER ICNTL(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER, TARGET :: IW( LIW ) + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER BUFR( LBUFR ), IPOOL(LPOOL), ITLOC(N+KEEP(253)) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER PTRARW(LPTRAR), PTRAIW(LPTRAR), ND( KEEP(28) ) + INTEGER FRERE(KEEP(28)), FILS(N) + INTEGER INTARR(max(1,KEEP(14))) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST(KEEP(28)), + & PTLUST_S(KEEP(28)), + & + & PIMASTER(KEEP(28)), + & NSTK_S(KEEP(28)), NBPROCFILS(KEEP(28)), + & PROCNODE_STEPS(KEEP(28)), STEP(N) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + DOUBLE PRECISION OPASSW, OPELIW + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + LOGICAL AVOID_DELAYED + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER(8) :: POSELT + INTEGER INOPV, IFINB, NFRONT, NPIV, IBEGKJI, NBOLKJ, NBTLKJ + INTEGER NASS, IEND, IOLDPS, LDAFS,allocok, IBEG_BLOCK + LOGICAL LASTBL + LOGICAL RESET_TO_ONE, TO_UPDATE + INTEGER K109_ON_ENTRY + INTEGER I,J,JJ,K,IDEB + DOUBLE PRECISION UUTEMP + INCLUDE 'mumps_headers.h' + INTEGER , ALLOCATABLE, DIMENSION ( : ) :: IPIV + INTEGER(8) :: LAFAC + INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten, + & IDUMMY + TYPE(IO_BLOCK) :: MonBloc + LOGICAL LAST_CALL + INTEGER PP_FIRST2SWAP_L, IFLAG_OOC + INTEGER PP_LastPIVRPTRFilled + EXTERNAL ZMUMPS_223, ZMUMPS_235, + & ZMUMPS_227, ZMUMPS_294, + & ZMUMPS_44 + LOGICAL STATICMODE + DOUBLE PRECISION SEUIL_LOC + INTEGER PIVSIZ,IWPOSPIV + COMPLEX(kind=8) ONE + PARAMETER (ONE=(1.0D0,0.0D0)) + INOPV = 0 + IF(KEEP(97) .EQ. 0) THEN + STATICMODE = .FALSE. + ELSE + STATICMODE = .TRUE. + ENDIF + IF (AVOID_DELAYED) THEN + STATICMODE = .TRUE. + UUTEMP=UU + SEUIL_LOC = max(SEUIL,epsilon(SEUIL)) + ELSE + SEUIL_LOC=SEUIL + UUTEMP=UU + ENDIF + RESET_TO_ONE = ((KEEP(110).GT.0).AND.(DKEEP(2).LE.0.0D0)) + IF (RESET_TO_ONE) THEN + K109_ON_ENTRY = KEEP(109) + ENDIF + IBEG_BLOCK=1 + NB_BLOC_FAC = 0 + IOLDPS = PTLUST_S(STEP( INODE )) + POSELT = PTRAST( STEP( INODE )) + NFRONT = IW(IOLDPS+KEEP(IXSZ)) + NASS = iabs(IW(IOLDPS+2+KEEP(IXSZ))) + LDAFS = NASS + IF (NASS .GT. KEEP(3)) THEN + NBOLKJ = min( KEEP(6), NASS ) + ELSE + NBOLKJ = min( KEEP(5), NASS ) + ENDIF + NBTLKJ = NBOLKJ + IW(IOLDPS+3+KEEP(IXSZ)) = min0(NASS,NBTLKJ) + IF (KEEP(201).EQ.1) THEN + IDUMMY = -9876 + CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR)) + LIWFAC = IW(IOLDPS+XXI) + TYPEFile = TYPEF_L + NextPiv2beWritten = 1 + PP_FIRST2SWAP_L = NextPiv2beWritten + MonBloc%LastPanelWritten_L = 0 + MonBloc%INODE = INODE + MonBloc%MASTER = .TRUE. + MonBloc%Typenode = 2 + MonBloc%NROW = NASS + MonBloc%NCOL = NASS + MonBloc%NFS = NASS + MonBloc%Last = .FALSE. + MonBloc%LastPiv = -66666 + MonBloc%INDICES => + & IW(IOLDPS+6+NFRONT+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ)) + & :IOLDPS+5+2*NFRONT+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))) + ENDIF + ALLOCATE( IPIV( NASS ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) MYID,' : FACTO_NIV2 :failed to allocate ',NASS, + & ' integers' + IFLAG=-13 + IERROR=NASS + GO TO 490 + END IF + 50 CONTINUE + IBEGKJI = IBEG_BLOCK + CALL ZMUMPS_223( + & NFRONT,NASS,IBEGKJI, NASS, IPIV, + & N,INODE,IW,LIW,A,LA,NOFFW,INOPV, + & IFLAG,IOLDPS,POSELT,UU, SEUIL_LOC, + & KEEP,KEEP8,PIVSIZ, + & DKEEP(1),PIVNUL_LIST(1),LPN_LIST, + & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L, + & PP_LastPIVRPTRFilled) + IF (IFLAG.LT.0) GOTO 490 + IF(KEEP(109).GT. 0) THEN + IF(PIVNUL_LIST(KEEP(109)).EQ.-1) THEN + IWPOSPIV = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6 + & +IW(IOLDPS+5+KEEP(IXSZ)) + PIVNUL_LIST(KEEP(109)) = IW(IWPOSPIV+KEEP(IXSZ)) + ENDIF + ENDIF + IF(INOPV.EQ. 1 .AND. STATICMODE) THEN + INOPV = -1 + GOTO 50 + ENDIF + IF (INOPV.GE.1) THEN + LASTBL = (INOPV.EQ.1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL ZMUMPS_294( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, LDAFS, + & IBEGKJI, IEND, IPIV, NASS,LASTBL, NB_BLOC_FAC, + & + & COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (INOPV.EQ.1) GO TO 500 + IF (INOPV.EQ.2) THEN + CALL ZMUMPS_235(IBEG_BLOCK, + & NASS,N,INODE,IW,LIW,A,LA, + & LDAFS, + & IOLDPS,POSELT,NBOLKJ, NBTLKJ,KEEP(4),KEEP,KEEP8) + GOTO 50 + ENDIF + NPVW = NPVW + PIVSIZ + IF (NASS.LE.1) THEN + IFINB = -1 + IF (NASS == 1) A(POSELT)=ONE/A(POSELT) + ELSE + CALL ZMUMPS_227(IBEG_BLOCK, + & NASS, N,INODE,IW,LIW,A,LA, + & LDAFS, IOLDPS,POSELT,IFINB, + & NBTLKJ,KEEP(4),PIVSIZ,KEEP(IXSZ)) + IF(PIVSIZ .EQ. 2) THEN + IWPOSPIV = IOLDPS+KEEP(IXSZ)+IW(IOLDPS+1+KEEP(IXSZ))+6+ + & IW(IOLDPS+5+KEEP(IXSZ)) + IW(IWPOSPIV+NFRONT) = -IW(IWPOSPIV+NFRONT) + ENDIF + ENDIF + IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + PIVSIZ + IF (IFINB.EQ.0) GOTO 50 + IF ((IFINB.EQ.1).OR.(IFINB.EQ.-1)) THEN + LASTBL = (IFINB.EQ.-1) + IEND = IW(IOLDPS+1+KEEP(IXSZ)) + CALL ZMUMPS_294(COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, IW, LIW, + & IOLDPS, POSELT, A, LA, LDAFS, + & IBEGKJI, IEND, IPIV, NASS, LASTBL,NB_BLOC_FAC, + & + & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF, + & IFLAG, IERROR, IPOOL,LPOOL, + & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, + & LRLUS, COMP, + & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP, + & PIMASTER, PAMASTER, + & NSTK_S,NBPROCFILS,PROCNODE_STEPS, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + IF ( IFLAG .LT. 0 ) GOTO 500 + ENDIF + IF (IFINB.EQ.(-1)) GOTO 500 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + IF (KEEP(201).EQ.1) THEN + IF (.NOT.RESET_TO_ONE.OR.K109_ON_ENTRY.EQ.KEEP(109)) THEN + MonBloc%Last = .FALSE. + MonBloc%LastPiv= NPIV + LAST_CALL=.FALSE. + CALL ZMUMPS_688( + & STRAT_TRY_WRITE, + & TYPEFile, A(POSELT), + & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS), + & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC .LT. 0 ) IFLAG = IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + ENDIF + ENDIF + CALL ZMUMPS_235(IBEG_BLOCK, + & NASS,N,INODE,IW,LIW,A,LA, + & LDAFS, + & IOLDPS,POSELT,NBOLKJ,NBTLKJ,KEEP(4),KEEP,KEEP8) + IF (KEEP(201).EQ.1) THEN + IF (RESET_TO_ONE.AND.K109_ON_ENTRY.LT.KEEP(109)) THEN + IDEB = IOLDPS+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))+6 + JJ= IDEB + TO_UPDATE=.FALSE. + DO K = K109_ON_ENTRY+1, KEEP(109) + I = PIVNUL_LIST(K) + DO J=JJ,JJ+NASS + IF (IW(J).EQ.I) THEN + TO_UPDATE=.TRUE. + EXIT + ENDIF + ENDDO + IF (TO_UPDATE) THEN + JJ= J + J = J-IDEB+1 + A(POSELT+int(J-1,8)+int(LDAFS,8)*int(J-1,8))= ONE + TO_UPDATE=.FALSE. + ELSE + IF (ICNTL(1).GT.0) THEN + write(ICNTL(1),*) ' Internal error related ', + & 'to null pivot row detection' + ENDIF + EXIT + ENDIF + ENDDO + ENDIF + K109_ON_ENTRY = KEEP(109) + MonBloc%Last = .FALSE. + MonBloc%LastPiv= NPIV + LAST_CALL=.FALSE. + CALL ZMUMPS_688( + & STRAT_TRY_WRITE, + & TYPEFile, A(POSELT), + & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS), + & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL ) + IF (IFLAG_OOC .LT. 0 ) IFLAG = IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + ENDIF + GO TO 50 + 490 CONTINUE + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + 500 CONTINUE + IF (RESET_TO_ONE.AND.K109_ON_ENTRY.LT.KEEP(109)) THEN + IDEB = IOLDPS+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))+6 + JJ= IDEB + TO_UPDATE=.FALSE. + DO K = K109_ON_ENTRY+1, KEEP(109) + I = PIVNUL_LIST(K) + DO J=JJ,JJ+NASS + IF (IW(J).EQ.I) THEN + TO_UPDATE=.TRUE. + EXIT + ENDIF + ENDDO + IF (TO_UPDATE) THEN + JJ= J + J = J-IDEB+1 + A(POSELT+int(J-1,8)+int(LDAFS,8)*int(J-1,8))= ONE + TO_UPDATE=.FALSE. + ELSE + IF (ICNTL(1).GT.0) THEN + write(ICNTL(1),*) ' Internal error related ', + & 'to null pivot row detection' + ENDIF + EXIT + ENDIF + ENDDO + ENDIF + IF (KEEP(201).EQ.1) THEN + STRAT = STRAT_WRITE_MAX + MonBloc%Last = .TRUE. + MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ)) + LAST_CALL = .TRUE. + CALL ZMUMPS_688 + & ( STRAT, TYPEFile, + & A(POSELT), LAFAC, MonBloc, + & NextPiv2beWritten, IDUMMY, + & IW(IOLDPS), LIWFAC, + & MYID, KEEP8(31), IFLAG_OOC, LAST_CALL ) + IF (IFLAG_OOC .LT. 0 ) IFLAG = IFLAG_OOC + IF (IFLAG .LT. 0 ) RETURN + CALL ZMUMPS_644 (IWPOS, + & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP) + ENDIF + DEALLOCATE( IPIV ) + RETURN + END SUBROUTINE ZMUMPS_141 + SUBROUTINE ZMUMPS_223( NFRONT, NASS, + & IBEGKJI, NASS2, TIPIV, + & N, INODE, IW, LIW, + & A, LA, NNEG, + & INOPV, IFLAG, + & IOLDPS, POSELT, UU, + & SEUIL,KEEP,KEEP8,PIVSIZ, + & DKEEP,PIVNUL_LIST,LPN_LIST, + & PP_FIRST2SWAP_L, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + USE MUMPS_OOC_COMMON + IMPLICIT NONE + INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV + INTEGER NASS2, IBEGKJI, NNEG + INTEGER TIPIV( NASS2 ) + INTEGER PIVSIZ,LPIV + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + DOUBLE PRECISION UU, UULOC, SEUIL + COMPLEX(kind=8) CSEUIL + INTEGER IW(LIW) + INTEGER IOLDPS + INTEGER(8) :: POSELT + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER LPN_LIST + INTEGER PIVNUL_LIST(LPN_LIST) + DOUBLE PRECISION DKEEP(30) + INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk + INTEGER PP_LastPIVRPTRIndexFilled + include 'mpif.h' + INTEGER(8) :: POSPV1,POSPV2,OFFDAG,APOSJ + INTEGER JMAX + DOUBLE PRECISION RMAX,AMAX,TMAX,TOL + DOUBLE PRECISION MAXPIV + COMPLEX(kind=8) PIVOT,DETPIV + PARAMETER(TOL = 1.0D-20) + INCLUDE 'mumps_headers.h' + INTEGER(8) :: APOSMAX + INTEGER(8) :: APOS + INTEGER(8) :: J1, J2, JJ, KK + INTEGER :: LDAFS + INTEGER(8) :: LDAFS8 + DOUBLE PRECISION, PARAMETER :: RZERO = 0.0D0 + DOUBLE PRECISION, PARAMETER :: RONE = 1.0D0 + COMPLEX(kind=8) ZERO, ONE + PARAMETER( ZERO = (0.0D0,0.0D0) ) + PARAMETER( ONE = (1.0D0,0.0D0) ) + DOUBLE PRECISION PIVNUL, VALTMP + COMPLEX(kind=8) FIXA + INTEGER NPIV,NASSW,IPIV + INTEGER NPIVP1,ILOC,K,J + INTRINSIC max + INTEGER I_PIVRPTR, I_PIVR, NBPANELS_L + PIVNUL = DKEEP(1) + FIXA = cmplx(DKEEP(2),kind=kind(FIXA)) + CSEUIL = cmplx(SEUIL,kind=kind(CSEUIL)) + LDAFS = NASS + LDAFS8 = int(LDAFS,8) + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL ZMUMPS_667(TYPEF_L, NBPANELS_L, + & I_PIVRPTR, I_PIVR, + & IOLDPS+2*NFRONT+6+IW(IOLDPS+5+KEEP(IXSZ)) + & +KEEP(IXSZ), + & IW, LIW) + ENDIF + UULOC = UU + PIVSIZ = 1 + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + NPIVP1 = NPIV + 1 + ILOC = NPIVP1 - IBEGKJI + 1 + TIPIV( ILOC ) = ILOC + NASSW = iabs(IW(IOLDPS+3+KEEP(IXSZ))) + APOSMAX = POSELT+LDAFS8*LDAFS8-1_8 + IF(INOPV .EQ. -1) THEN + APOS = POSELT + LDAFS8*int(NPIVP1-1,8) + int(NPIV,8) + POSPV1 = APOS + IF(abs(A(APOS)).LT.SEUIL) THEN + IF(dble(A(APOS)) .GE. RZERO) THEN + A(APOS) = CSEUIL + ELSE + A(APOS) = -CSEUIL + ENDIF + ELSE IF (KEEP(258) .NE.0 ) THEN + CALL ZMUMPS_762( A(APOS), DKEEP(6), KEEP(259) ) + ENDIF + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL ZMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, NPIVP1, + & PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + GO TO 420 + ENDIF + INOPV = 0 + DO 460 IPIV=NPIVP1,NASSW + APOS = POSELT + LDAFS8*int(IPIV-1,8) + int(NPIV,8) + POSPV1 = APOS + int(IPIV - NPIVP1,8) + PIVOT = A(POSPV1) + IF (UULOC.EQ.RZERO) THEN + IF (abs(A(APOS)).EQ.RZERO) GO TO 630 + IF (KEEP(258) .NE. 0) THEN + CALL ZMUMPS_762(A(APOS), DKEEP(6), KEEP(259)) + ENDIF + GO TO 420 + ENDIF + AMAX = RZERO + JMAX = 0 + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(abs(A(JJ)) .GT. AMAX) THEN + AMAX = abs(A(JJ)) + JMAX = IPIV - int(POSPV1-JJ) + ENDIF + ENDDO + J1 = POSPV1 + LDAFS8 + DO J=1, NASSW - IPIV + IF(abs(A(J1)) .GT. AMAX) THEN + AMAX = max(abs(A(J1)),AMAX) + JMAX = IPIV + J + ENDIF + J1 = J1 + LDAFS8 + ENDDO + IF (KEEP(219).NE.0) THEN + RMAX = dble(A(APOSMAX+int(IPIV,8))) + ELSE + RMAX = RZERO + ENDIF + DO J=1,NASS - NASSW + RMAX = max(abs(A(J1)),RMAX) + J1 = J1 + LDAFS8 + ENDDO + IF (max(AMAX,RMAX,abs(PIVOT)).LE.PIVNUL) THEN + KEEP(109) = KEEP(109)+1 + PIVNUL_LIST(KEEP(109)) = -1 + IF (dble(FIXA).GT.RZERO) THEN + IF(dble(PIVOT) .GE. RZERO) THEN + A(POSPV1) = FIXA + ELSE + A(POSPV1) = -FIXA + ENDIF + ELSE + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + A(JJ) = ZERO + ENDDO + J1 = POSPV1 + LDAFS8 + DO J=1, NASSW - IPIV + A(J1) = ZERO + J1 = J1 + LDAFS8 + ENDDO + DO J=1,NASS - NASSW + A(J1) = ZERO + J1 = J1 + LDAFS8 + ENDDO + VALTMP = max(1.0D10*RMAX, sqrt(huge(RMAX))/1.0D8) + A(POSPV1) = cmplx(VALTMP,kind=kind(A)) + ENDIF + PIVOT = A(POSPV1) + GO TO 415 + ENDIF + IF ((KEEP(19).EQ.0).AND.(KEEP(110).EQ.0)) THEN + IF (max(AMAX,RMAX,abs(PIVOT)).LE.TOL) THEN + IF(SEUIL .GT. epsilon(SEUIL)) THEN + IF(dble(PIVOT) .GE. RZERO) THEN + A(POSPV1) = CSEUIL + ELSE + A(POSPV1) = -CSEUIL + ENDIF + PIVOT = A(POSPV1) + WRITE(*,*) 'WARNING matrix may be singular' + KEEP(98) = KEEP(98)+1 + GO TO 415 + ENDIF + ENDIF + ENDIF + IF (max(AMAX,abs(PIVOT)) .LE. TOL) GOTO 460 + IF (abs(PIVOT).GT.max(UULOC*max(RMAX,AMAX),SEUIL)) THEN + IF (KEEP(258) .NE.0 ) THEN + CALL ZMUMPS_762(PIVOT, DKEEP(6), KEEP(259)) + ENDIF + GO TO 415 + END IF + IF (AMAX.LE.TOL) GO TO 460 + IF (RMAX.LT.AMAX) THEN + J1 = APOS + J2 = POSPV1 - 1_8 + DO JJ=J1,J2 + IF(int(POSPV1-JJ) .NE. IPIV-JMAX) THEN + RMAX = max(RMAX,abs(A(JJ))) + ENDIF + ENDDO + J1 = POSPV1 + LDAFS8 + DO J=1,NASS-IPIV + IF(IPIV+J .NE. JMAX) THEN + RMAX = max(abs(A(J1)),RMAX) + ENDIF + J1 = J1 + LDAFS8 + ENDDO + ENDIF + APOSJ = POSELT + int(JMAX-1,8)*LDAFS8 + int(NPIV,8) + POSPV2 = APOSJ + int(JMAX - NPIVP1,8) + IF (IPIV.LT.JMAX) THEN + OFFDAG = APOSJ + int(IPIV - NPIVP1,8) + ELSE + OFFDAG = APOS + int(JMAX - NPIVP1,8) + END IF + IF (KEEP(219).NE.0) THEN + TMAX = max(SEUIL/UULOC,dble(A(APOSMAX+int(JMAX,8)))) + ELSE + TMAX = SEUIL/UULOC + ENDIF + IF(JMAX .LT. IPIV) THEN + JJ = POSPV2 + DO K = 1, NASS-JMAX + JJ = JJ+int(NASS,8) + IF (JMAX+K.NE.IPIV) THEN + TMAX=max(TMAX,abs(A(JJ))) + ENDIF + ENDDO + DO KK = APOSJ, POSPV2-1_8 + TMAX = max(TMAX,abs(A(KK))) + ENDDO + ELSE + JJ = POSPV2 + DO K = 1, NASS-JMAX + JJ = JJ+int(NASS,8) + TMAX=max(TMAX,abs(A(JJ))) + ENDDO + DO KK = APOSJ, POSPV2 - 1_8 + IF (KK.NE.OFFDAG) THEN + TMAX = max(TMAX,abs(A(KK))) + ENDIF + ENDDO + ENDIF + DETPIV = A(POSPV1)*A(POSPV2) - A(OFFDAG)**2 + IF (SEUIL.GT.RZERO) THEN + IF (sqrt(abs(DETPIV)) .LE. SEUIL ) GOTO 460 + ENDIF + MAXPIV = max(abs(A(POSPV1)),abs(A(POSPV2))) + IF (MAXPIV.EQ.RZERO) MAXPIV = RONE + IF (abs(DETPIV)/MAXPIV.LE.TOL) GO TO 460 + IF ((abs(A(POSPV2))*RMAX+AMAX*TMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF ((abs(A(POSPV1))*TMAX+AMAX*RMAX)*UULOC.GT. + & abs(DETPIV)) GO TO 460 + IF (KEEP(258).NE.0) THEN + CALL ZMUMPS_762(DETPIV, DKEEP(6), KEEP(259)) + ENDIF + PIVSIZ = 2 + KEEP(105) = KEEP(105)+1 + 415 CONTINUE + DO K=1,PIVSIZ + IF (PIVSIZ .EQ. 2 ) THEN + IF (K==1) THEN + LPIV = min(IPIV, JMAX) + TIPIV(ILOC) = -(LPIV - IBEGKJI + 1) + ELSE + LPIV = max(IPIV, JMAX) + TIPIV(ILOC+1) = -(LPIV - IBEGKJI + 1) + ENDIF + ELSE + LPIV = IPIV + TIPIV(ILOC) = IPIV - IBEGKJI + 1 + ENDIF + IF (LPIV.EQ.NPIVP1) THEN + GOTO 416 + ENDIF + CALL ZMUMPS_319( A, LA, IW, LIW, + & IOLDPS, NPIVP1, LPIV, POSELT, NASS, + & LDAFS, NFRONT, 2, KEEP(219), KEEP(50), + & KEEP(IXSZ)) + 416 CONTINUE + IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN + CALL ZMUMPS_680( IW(I_PIVRPTR), NBPANELS_L, + & IW(I_PIVR), NASS, NPIVP1, LPIV, PP_LastPanelonDisk, + & PP_LastPIVRPTRIndexFilled) + ENDIF + NPIVP1 = NPIVP1+1 + ENDDO + IF(PIVSIZ .EQ. 2) THEN + A(POSELT+LDAFS8*int(NPIV,8)+int(NPIV+1,8)) = DETPIV + ENDIF + GOTO 420 + 460 CONTINUE + IF (NASSW.EQ.NASS) THEN + INOPV = 1 + ELSE + INOPV = 2 + ENDIF + GO TO 420 + 630 CONTINUE + IFLAG = -10 + 420 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_223 + SUBROUTINE ZMUMPS_235( + & IBEG_BLOCK, + & NASS, N, INODE, + & IW, LIW, A, LA, + & LDAFS, + & IOLDPS, POSELT, + & LKJIB_ORIG, LKJIB, LKJIT, KEEP,KEEP8 ) + IMPLICIT NONE + INTEGER NASS,N,LIW + INTEGER(8) :: LA + COMPLEX(kind=8) A(LA) + INTEGER IW(LIW) + INTEGER LKJIB_ORIG, LKJIB, INODE, KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER (8) :: POSELT + INTEGER (8) :: LDAFS8 + INTEGER LDAFS, IBEG_BLOCK + INTEGER IOLDPS, NPIV, JROW2, NPBEG + INTEGER NONEL, LKJIW, NEL1 + INTEGER HF + INTEGER(8) :: LPOS,UPOS,APOS + INTEGER LKJIT + INTEGER LKJIBOLD, IROW + INTEGER J, Block + INTEGER BLSIZE + COMPLEX(kind=8) ONE, ALPHA + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + INCLUDE 'mumps_headers.h' + LDAFS8 = int(LDAFS,8) + LKJIBOLD = LKJIB + NPIV = IW(IOLDPS+1+KEEP(IXSZ)) + JROW2 = iabs(IW(IOLDPS+3+KEEP(IXSZ))) + NPBEG = IBEG_BLOCK + HF = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ) + NEL1 = NASS - JROW2 + LKJIW = NPIV - NPBEG + 1 + IF ( LKJIW .NE. LKJIB ) THEN + NONEL = JROW2 - NPIV + 1 + IF ((NASS-NPIV).GE.LKJIT) THEN + LKJIB = LKJIB_ORIG + NONEL + IW(IOLDPS+3+KEEP(IXSZ))= min0(NPIV+LKJIB,NASS) + LKJIB = min0(LKJIB, NASS - NPIV) + ELSE + LKJIB = NASS - NPIV + IW(IOLDPS+3+KEEP(IXSZ)) = NASS + ENDIF + ELSEIF (JROW2.LT.NASS) THEN + IW(IOLDPS+3+KEEP(IXSZ)) = min0(JROW2+LKJIB,NASS) + ENDIF + IBEG_BLOCK = NPIV + 1 + IF (LKJIW.EQ.0) GO TO 500 + IF (NEL1.NE.0) THEN + IF ( NASS - JROW2 > KEEP(7) ) THEN + BLSIZE = KEEP(8) + ELSE + BLSIZE = NASS - JROW2 + END IF + IF ( NASS - JROW2 .GT. 0 ) THEN + DO IROW = JROW2+1, NASS, BLSIZE + Block = min( BLSIZE, NASS - IROW + 1 ) + LPOS = POSELT + int(IROW - 1,8) * LDAFS8 + int(NPBEG - 1,8) + UPOS = POSELT + int(NPBEG - 1,8) * LDAFS8 + int(IROW - 1,8) + APOS = POSELT + int(IROW-1,8) * LDAFS8 + int(IROW - 1,8) + DO J=1, Block + CALL zgemv( 'T', LKJIW, Block - J + 1, ALPHA, + & A( LPOS ), LDAFS, A( UPOS ), LDAFS, + & ONE, A( APOS ), LDAFS ) + LPOS = LPOS + LDAFS8 + APOS = APOS + LDAFS8 + 1_8 + UPOS = UPOS + 1_8 + END DO + LPOS = POSELT + int(IROW-1+Block,8) * LDAFS8 + & + int(NPBEG-1,8) + UPOS = POSELT + int(NPBEG-1,8) * LDAFS8 + int(IROW-1,8) + APOS = POSELT + int( IROW - 1 + Block,8 ) * LDAFS8 + & + int(IROW - 1,8) + CALL zgemm( 'N','N', Block, NASS - IROW + 1 - Block, LKJIW, + & ALPHA, A( UPOS ), LDAFS, + & A( LPOS ), LDAFS, ONE, A( APOS ), LDAFS ) + END DO + END IF + END IF + 500 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_235 + SUBROUTINE ZMUMPS_227 + & ( IBEG_BLOCK, NASS, N, INODE, IW, LIW, + & A, LA, LDAFS, + & IOLDPS,POSELT,IFINB,LKJIB,LKJIT,PIVSIZ, + & XSIZE) + IMPLICIT NONE + INTEGER(8) :: LA, POSELT + INTEGER :: LIW + COMPLEX(kind=8) A(LA) + INTEGER IW(LIW) + COMPLEX(kind=8) VALPIV + INTEGER IOLDPS, NCB1 + INTEGER LKJIT, IBEG_BLOCK + INTEGER NPIV,JROW2 + INTEGER(8) :: APOS + INTEGER(8) :: LPOS, LPOS1, LPOS2, K1POS + INTEGER(8) :: JJ, K1, K2 + INTEGER(8) :: POSPV1, POSPV2, OFFDAG, OFFDAG_OLD + INTEGER(8) :: LDAFS8 + INTEGER NASS,N,INODE,IFINB,LKJIB,LDAFS, + & NPBEG + INTEGER NEL2 + INTEGER XSIZE + COMPLEX(kind=8) ONE, ALPHA + COMPLEX(kind=8) ZERO + INTEGER PIVSIZ,NPIV_NEW + INTEGER(8) :: IBEG, IEND, IROW + INTEGER :: J2 + COMPLEX(kind=8) SWOP,DETPIV,MULT1,MULT2 + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + PARAMETER (ZERO=(0.0D0,0.0D0)) + INCLUDE 'mumps_headers.h' + LDAFS8 = int(LDAFS,8) + NPIV = IW(IOLDPS+1+XSIZE) + NPIV_NEW = NPIV + PIVSIZ + IFINB = 0 + IF (IW(IOLDPS+3+XSIZE).LE.0) THEN + IW(IOLDPS+3+XSIZE) = min0(NASS,LKJIB) + ENDIF + JROW2 = IW(IOLDPS+3+XSIZE) + NPBEG = IBEG_BLOCK + NEL2 = JROW2 - NPIV_NEW + IF (NEL2.EQ.0) THEN + IF (JROW2.EQ.NASS) THEN + IFINB = -1 + ELSE + IFINB = 1 + ENDIF + ENDIF + IF(PIVSIZ .EQ. 1) THEN + APOS = POSELT + int(NPIV,8)*(LDAFS8 + 1_8) + VALPIV = ONE/A(APOS) + A(APOS) = VALPIV + LPOS = APOS + LDAFS8 + CALL zcopy(NASS-NPIV_NEW, A(LPOS), LDAFS, A(APOS+1_8), 1) + CALL ZMUMPS_XSYR('U', NEL2, -VALPIV, A(LPOS), LDAFS, + & A(LPOS+1_8), LDAFS) + CALL zscal(NASS-NPIV_NEW, VALPIV, A(LPOS), LDAFS) + IF (NEL2.GT.0) THEN + K1POS = LPOS + int(NEL2,8)*LDAFS8 + NCB1 = NASS - JROW2 + CALL zgeru(NEL2, NCB1 , ALPHA, A(APOS+1_8), 1, + & A(K1POS), LDAFS, A(K1POS+1_8), LDAFS) + ENDIF + ELSE + POSPV1 = POSELT + int(NPIV,8)*(LDAFS8 + 1_8) + POSPV2 = POSPV1+LDAFS8+1_8 + OFFDAG_OLD = POSPV2 - 1_8 + OFFDAG = POSPV1+1_8 + SWOP = A(POSPV2) + DETPIV = A(OFFDAG) + A(POSPV2) = A(POSPV1)/DETPIV + A(POSPV1) = SWOP/DETPIV + A(OFFDAG) = -A(OFFDAG_OLD)/DETPIV + A(OFFDAG_OLD) = ZERO + LPOS1 = POSPV2 + LDAFS8 - 1_8 + LPOS2 = LPOS1 + 1_8 + CALL zcopy(NASS-NPIV_NEW, A(LPOS1), LDAFS, A(POSPV1+2_8), 1) + CALL zcopy(NASS-NPIV_NEW, A(LPOS2), LDAFS, A(POSPV2+1_8), 1) + JJ = POSPV2 + int(NASS-1,8) + IBEG = JJ + 2_8 + IEND = IBEG + DO J2 = 1,NEL2 + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(OFFDAG)*A(K2)) + MULT2 = - (A(OFFDAG)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1+2_8 + K2 = POSPV2+1_8 + DO IROW = IBEG,IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A(JJ) = -MULT1 + A(JJ+1_8) = -MULT2 + IBEG = IBEG + int(NASS,8) + IEND = IEND + int(NASS + 1,8) + JJ = JJ+int(NASS,8) + ENDDO + IEND = IEND-1_8 + DO J2 = JROW2+1,NASS + K1 = JJ + K2 = JJ+1_8 + MULT1 = - (A(POSPV1)*A(K1)+A(POSPV1+1_8)*A(K2)) + MULT2 = - (A(POSPV1+1_8)*A(K1)+A(POSPV2)*A(K2)) + K1 = POSPV1+2_8 + K2 = POSPV2+1_8 + DO IROW = IBEG,IEND + A(IROW) = A(IROW) + MULT1*A(K1) + MULT2*A(K2) + K1 = K1 + 1_8 + K2 = K2 + 1_8 + ENDDO + A(JJ) = -MULT1 + A(JJ+1_8) = -MULT2 + IBEG = IBEG + int(NASS,8) + IEND = IEND + int(NASS,8) + JJ = JJ+int(NASS,8) + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_227 + RECURSIVE SUBROUTINE ZMUMPS_263( + & COMM_LOAD, ASS_IRECV, + & BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, MSGSOU, + & SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW, + & A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS, + & COMP, STEP, PIMASTER, PAMASTER, POSFAC, + & MYID, COMM, IFLAG, IERROR, NBFIN, + & + & PTLUST_S, PTRFAC, root, OPASSW, OPELIW, + & ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, + & ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER ICNTL( 40 ), KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER LBUFR, LBUFR_BYTES + INTEGER COMM_LOAD, ASS_IRECV + INTEGER BUFR( LBUFR ) + INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER COMP + INTEGER IFLAG, IERROR, NBFIN, MSGSOU + INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)), + & NSTK_S(KEEP(28)) + INTEGER NBPROCFILS(KEEP(28)), STEP(N), PIMASTER(KEEP(28)) + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER NELT, LPTRAR + INTEGER FRTPTR( N + 1 ), FRTELT( NELT ) + INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER COMM, MYID + INTEGER PTLUST_S(KEEP(28)) + INTEGER ITLOC( N + KEEP(253)), FILS( N ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER ND( KEEP(28) ), FRERE_STEPS( KEEP(28) ) + INTEGER INTARR( max(1,KEEP(14)) ) + DOUBLE PRECISION OPASSW, OPELIW + DOUBLE PRECISION FLOP1 + COMPLEX(kind=8) DBLARR( max(1,KEEP(13)) ) + INTEGER LEAF, LPOOL + INTEGER IPOOL( LPOOL ) + INCLUDE 'mumps_headers.h' + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER INODE, IPOSK, JPOSK, NCOLU, NPIV, POSITION, IERR + INTEGER(8) POSELT, POSBLOCFACTO + INTEGER(8) LAELL + INTEGER IOLDPS, LCONT1, NROW1, NCOL1, NPIV1 + INTEGER NSLAVES_TOT, HS, DEST, NSLAVES_FOLLOW + INTEGER FPERE + INTEGER(8) CPOS, LPOS + LOGICAL DYNAMIC + LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED + INTEGER allocok + COMPLEX(kind=8), ALLOCATABLE, DIMENSION(:) :: UDYNAMIC + COMPLEX(kind=8) ONE,ALPHA + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + DYNAMIC = .FALSE. + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, IPOSK, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, JPOSK, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1, + & MPI_INTEGER, COMM, IERR ) + IF ( NPIV .LE. 0 ) THEN + NPIV = - NPIV + WRITE(*,*) MYID,':error, received negative NPIV in BLFAC' + CALL MUMPS_ABORT() + END IF + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1, + & MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOLU, 1, + & MPI_INTEGER, COMM, IERR ) + LAELL = int(NPIV,8) * int(NCOLU,8) + IF ( LRLU .LT. LAELL ) THEN + IF ( LRLUS .LT. LAELL ) THEN + IFLAG = -9 + CALL MUMPS_731(LAELL - LRLUS, IERROR) + GOTO 700 + END IF + CALL ZMUMPS_94(N, KEEP(28), IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP+1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS=' + & ,LRLU,LRLUS + IFLAG = -9 + CALL MUMPS_731(LAELL - LRLU, IERROR) + GOTO 700 + END IF + END IF + LRLU = LRLU - LAELL + LRLUS = LRLUS - LAELL + KEEP8(67) = min(LRLUS, KEEP8(67)) + POSBLOCFACTO = POSFAC + POSFAC = POSFAC + LAELL + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8, LAELL,KEEP,KEEP8,LRLU) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & A(POSBLOCFACTO), NPIV*NCOLU, + & MPI_DOUBLE_COMPLEX, + & COMM, IERR ) + IF (PTRIST(STEP( INODE )) .EQ. 0) DYNAMIC = .TRUE. + IF ( (PTRIST(STEP( INODE )).NE.0) .AND. + & (IPOSK + NPIV -1 .GT. + & IW(PTRIST(STEP(INODE))+3+KEEP(IXSZ))) )THEN + DYNAMIC = .TRUE. + ENDIF + IF (DYNAMIC) THEN + ALLOCATE(UDYNAMIC(LAELL), stat=allocok) + if (allocok .GT. 0) THEN + write(*,*) MYID, ' : PB allocation U in blfac_slave ' + & , LAELL + IFLAG = -13 + CALL MUMPS_731(LAELL,IERROR) + GOTO 700 + endif + UDYNAMIC(1_8:LAELL) = A(POSBLOCFACTO:POSBLOCFACTO+LAELL-1_8) + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + ENDIF + DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 ) + MSGSOU = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), + & SLAVEF ) + SET_IRECV = .FALSE. + BLOCKING = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, MAITRE_DESC_BANDE, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + ENDDO + DO WHILE ( IPOSK + NPIV -1 .GT. + & IW( PTRIST(STEP( INODE )) + 3 +KEEP(IXSZ)) ) + MSGSOU = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + SET_IRECV = .FALSE. + BLOCKING = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MSGSOU, BLOC_FACTO_SYM, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 600 + END DO + SET_IRECV = .TRUE. + BLOCKING = .FALSE. + MESSAGE_RECEIVED = .TRUE. + CALL ZMUMPS_329( COMM_LOAD, + & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, + & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, + & PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, + & IFLAG, IERROR, COMM, + & NBPROCFILS, + & IPOOL, LPOOL, LEAF, + & NBFIN, MYID, SLAVEF, + & + & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IOLDPS = PTRIST(STEP( INODE )) + POSELT = PTRAST(STEP( INODE )) + LCONT1 = IW( IOLDPS + KEEP(IXSZ) ) + NROW1 = IW( IOLDPS + 2 + KEEP(IXSZ)) + NPIV1 = IW( IOLDPS + 3 + KEEP(IXSZ)) + NSLAVES_TOT = IW( IOLDPS + 5 + KEEP(IXSZ)) + HS = 6 + NSLAVES_TOT + KEEP(IXSZ) + NCOL1 = LCONT1 + NPIV1 + CPOS = POSELT + int(JPOSK - 1,8) + LPOS = POSELT + int(IPOSK - 1,8) + IF ( NPIV .GT. 0 ) THEN + IF (DYNAMIC) THEN + CALL zgemm( 'T', 'N', NCOLU, NROW1, NPIV, ALPHA, + & UDYNAMIC(1), NPIV, + & A( LPOS ), NCOL1, ONE, + & A( CPOS ), NCOL1 ) + ELSE + CALL zgemm( 'T', 'N', NCOLU, NROW1, NPIV, ALPHA, + & A( POSBLOCFACTO ), NPIV, + & A( LPOS ), NCOL1, ONE, + & A( CPOS ), NCOL1 ) + ENDIF + FLOP1 = dble(NCOLU*NPIV)*dble(2*NROW1) + FLOP1 = -FLOP1 + CALL ZMUMPS_190(1, .FALSE., FLOP1, KEEP,KEEP8 ) + ENDIF + IW( IOLDPS + 6 + KEEP(IXSZ) ) = IW( IOLDPS + 6+ KEEP(IXSZ) ) + 1 + IF (DYNAMIC) THEN + DEALLOCATE(UDYNAMIC) + ELSE + LRLU = LRLU + LAELL + LRLUS = LRLUS + LAELL + POSFAC = POSFAC - LAELL + CALL ZMUMPS_471(.FALSE.,.FALSE., + & LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU) + ENDIF + NSLAVES_FOLLOW = IW( IOLDPS + 5 +KEEP(IXSZ) ) - XTRA_SLAVES_SYM + IF ( IW( IOLDPS + 6 +KEEP(IXSZ)) .eq. 0 .and. + & KEEP(50) .ne. 0 .and. NSLAVES_FOLLOW .eq. 0 ) + & THEN + DEST = MUMPS_275( PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + CALL ZMUMPS_62( INODE, DEST, END_NIV2_LDLT, + & COMM, IERR ) + IF ( IERR .LT. 0 ) THEN + write(*,*) ' Internal error in PROCESS_BLFAC_SLAVE.' + IFLAG = -99 + GOTO 700 + END IF + END IF + IF (IW(PTRIST(STEP(INODE)) + 6+KEEP(IXSZ) ) .eq. 0) THEN + CALL ZMUMPS_759( COMM_LOAD, ASS_IRECV, + & N, INODE, FPERE, + & root, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + ENDIF + 600 CONTINUE + RETURN + 700 CONTINUE + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE ZMUMPS_263 + SUBROUTINE ZMUMPS_38( NROW_SON, NCOL_SON, INDROW_SON, + & INDCOL_SON, NSUPCOL, VAL_SON, VAL_ROOT, + & LOCAL_M, LOCAL_N, + & RHS_ROOT, NLOC_ROOT, CBP ) + IMPLICIT NONE + INTEGER NCOL_SON, NROW_SON, NSUPCOL + INTEGER, intent(in) :: CBP + INTEGER INDROW_SON( NROW_SON ), INDCOL_SON( NCOL_SON ) + INTEGER LOCAL_M, LOCAL_N + COMPLEX(kind=8) VAL_SON( NCOL_SON, NROW_SON ) + COMPLEX(kind=8) VAL_ROOT( LOCAL_M, LOCAL_N ) + INTEGER NLOC_ROOT + COMPLEX(kind=8) RHS_ROOT( LOCAL_M, NLOC_ROOT ) + INTEGER I, J + IF (CBP .EQ. 0) THEN + DO I = 1, NROW_SON + DO J = 1, NCOL_SON-NSUPCOL + VAL_ROOT( INDROW_SON( I ), INDCOL_SON( J ) ) = + & VAL_ROOT( INDROW_SON( I ), INDCOL_SON( J ) ) + VAL_SON(J,I) + END DO + DO J = NCOL_SON-NSUPCOL+1, NCOL_SON + RHS_ROOT( INDROW_SON( I ), INDCOL_SON(J)) = + & RHS_ROOT(INDROW_SON(I),INDCOL_SON(J)) + VAL_SON(J,I) + ENDDO + END DO + ELSE + DO I=1, NROW_SON + DO J = 1, NCOL_SON + RHS_ROOT( INDROW_SON( I ), INDCOL_SON(J)) = + & RHS_ROOT(INDROW_SON(I),INDCOL_SON(J)) + VAL_SON(J,I) + ENDDO + ENDDO + ENDIF + RETURN + END SUBROUTINE ZMUMPS_38 + RECURSIVE SUBROUTINE ZMUMPS_80 + & ( COMM_LOAD, ASS_IRECV, N, ISON, IROOT, + & PTRI, PTRR, + & root, + & NBROW, NBCOL, SHIFT_LIST_ROW_SON, + & SHIFT_LIST_COL_SON, + & SHIFT_VAL_SON, LDA, TAG, + & MYID, COMM, + & + & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC, + & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, + & PTRAST, STEP, PIMASTER, PAMASTER, + & NSTK, COMP, IFLAG, IERROR, NBPROCFILS, + & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, + & FILS, PTRARW, PTRAIW, + & INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE, + & LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE ) + USE ZMUMPS_OOC + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_LOAD + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INTEGER KEEP(500), ICNTL(40) + INTEGER(8) KEEP8(150) + TYPE (ZMUMPS_ROOT_STRUC) :: root + INTEGER COMM_LOAD, ASS_IRECV + INTEGER N, ISON, IROOT, TAG + INTEGER PTRI( KEEP(28) ) + INTEGER(8) :: PTRR( KEEP(28) ) + INTEGER NBROW, NBCOL, LDA + INTEGER(8) :: SHIFT_VAL_SON + INTEGER SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON + INTEGER MYID, COMM + LOGICAL INVERT + INCLUDE 'mpif.h' + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA + INTEGER IWPOS, IWPOSCB + INTEGER LIW + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER LPTRAR, NELT + INTEGER FRTPTR( N+1 ), FRTELT( NELT ) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER(8) :: PAMASTER(KEEP(28)) + INTEGER PTRIST( KEEP(28) ), PTLUST_S(KEEP(28)) + INTEGER STEP(N), PIMASTER(KEEP(28)), NSTK( N ) + INTEGER COMP, IFLAG, IERROR + INTEGER NBPROCFILS( KEEP(28) ) + INTEGER LPOOL, LEAF + INTEGER IPOOL( LPOOL ) + INTEGER NBFIN, SLAVEF + DOUBLE PRECISION OPASSW, OPELIW + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER ITLOC( N + KEEP(253) ), FILS( N ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER ND( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR ) + INTEGER INTARR( max(1,KEEP(14)) ) + COMPLEX(kind=8) DBLARR( max(1,KEEP(13)) ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER allocok + INTEGER, ALLOCATABLE, DIMENSION(:) :: PTRROW, PTRCOL + INTEGER, ALLOCATABLE, DIMENSION(:) :: NSUPROW, NSUPCOL + INTEGER, ALLOCATABLE, DIMENSION(:) :: ROW_INDEX_LIST + INTEGER, ALLOCATABLE, DIMENSION(:) :: COL_INDEX_LIST + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER I, POS_IN_ROOT, IROW, JCOL, IGLOB, JGLOB + INTEGER PDEST, IERR + INTEGER LOCAL_M, LOCAL_N + INTEGER(8) :: POSROOT + INTEGER NSUBSET_ROW, NSUBSET_COL + INTEGER NRLOCAL, NCLOCAL + LOGICAL SET_IRECV, BLOCKING, MESSAGE_RECEIVED + INTEGER NBROWS_ALREADY_SENT + INTEGER SIZE_MSG + INTEGER LP + INCLUDE 'mumps_headers.h' + LOGICAL SKIPLAST_RHS_ROWS, BCP_SYM_NONEMPTY + INTEGER BBPCBP + BBPCBP = 0 + LP = ICNTL(1) + IF ( ICNTL(4) .LE. 0 ) LP = -1 + ALLOCATE(PTRROW(root%NPROW + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPROW + 1 + endif + ALLOCATE(PTRCOL(root%NPCOL + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPCOL + 1 + endif + ALLOCATE(NSUPROW(root%NPROW + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPROW + 1 + endif + ALLOCATE(NSUPCOL(root%NPCOL + 1 ), stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = root%NPCOL + 1 + endif + IF (IFLAG.LT.0) THEN + IF (LP > 0) write(6,*) MYID, ' : MEMORY ALLOCATION ', + & 'FAILURE in ZMUMPS_80' + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + SKIPLAST_RHS_ROWS = ((KEEP(253).GT.0).AND.(KEEP(50).EQ.0)) + BCP_SYM_NONEMPTY = .FALSE. + PTRROW = 0 + PTRCOL = 0 + NSUPROW = 0 + NSUPCOL = 0 + DO I = 1, NBROW + IGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_ROW_SON + I - 1 ) + IF (SKIPLAST_RHS_ROWS.AND.(IGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF (IGLOB.GT.N) THEN + BCP_SYM_NONEMPTY = .TRUE. + POS_IN_ROOT = IGLOB - N + JCOL = mod((POS_IN_ROOT-1)/root%NBLOCK,root%NPCOL) + NSUPCOL(JCOL+1) = NSUPCOL(JCOL+1) + 1 + PTRCOL( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + ELSE + POS_IN_ROOT = root%RG2L_ROW( IGLOB ) + IROW = mod((POS_IN_ROOT-1)/root%MBLOCK,root%NPROW) + PTRROW ( IROW + 2 ) = PTRROW( IROW + 2 ) + 1 + ENDIF + ELSE + IF (IGLOB .GT. N) THEN + POS_IN_ROOT = IGLOB - N + ELSE + POS_IN_ROOT = root%RG2L_COL( IGLOB ) + ENDIF + JCOL = mod( ( POS_IN_ROOT - 1 ) / root%NBLOCK, root%NPCOL ) + IF (IGLOB.GT.N) + & NSUPCOL(JCOL+1) = NSUPCOL(JCOL+1) + 1 + PTRCOL( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + END IF + END DO + IF ((KEEP(50).NE.0).AND.(.NOT.INVERT).AND.BCP_SYM_NONEMPTY) + & BBPCBP = 1 + DO I = 1, NBCOL + JGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_COL_SON + I - 1 ) + IF ((KEEP(50).GT.0) .AND. (JGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF (KEEP(50).EQ.0) THEN + IF (JGLOB.LE.N) THEN + POS_IN_ROOT = root%RG2L_COL(JGLOB) + ELSE + POS_IN_ROOT = JGLOB-N + ENDIF + JCOL = mod((POS_IN_ROOT-1) / root%NBLOCK, root%NPCOL ) + IF (JGLOB.GT.N) THEN + NSUPCOL(JCOL+1) = NSUPCOL(JCOL+1) + 1 + ENDIF + PTRCOL ( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + ELSE + POS_IN_ROOT = root%RG2L_COL(JGLOB) + JCOL = mod((POS_IN_ROOT-1) / root%NBLOCK, root%NPCOL ) + PTRCOL ( JCOL + 2 ) = PTRCOL( JCOL + 2 ) + 1 + IF (BCP_SYM_NONEMPTY) THEN + POS_IN_ROOT = root%RG2L_ROW(JGLOB) + IROW = mod((POS_IN_ROOT-1)/root%MBLOCK,root%NPROW) + NSUPROW(IROW+1) = NSUPROW(IROW+1)+1 + PTRROW( IROW + 2 ) = PTRROW( IROW + 2 ) + 1 + ENDIF + ENDIF + ELSE + IF (JGLOB.LE.N) THEN + POS_IN_ROOT = root%RG2L_ROW( JGLOB ) + ELSE + POS_IN_ROOT = JGLOB-N + ENDIF + IROW = mod( ( POS_IN_ROOT - 1 ) / + & root%MBLOCK, root%NPROW ) + PTRROW ( IROW + 2 ) = PTRROW( IROW + 2 ) + 1 + END IF + END DO + PTRROW( 1 ) = 1 + DO IROW = 2, root%NPROW + 1 + PTRROW( IROW ) = PTRROW( IROW ) + PTRROW( IROW - 1 ) + END DO + PTRCOL( 1 ) = 1 + DO JCOL = 2, root%NPCOL + 1 + PTRCOL( JCOL ) = PTRCOL( JCOL ) + PTRCOL( JCOL - 1 ) + END DO + ALLOCATE(ROW_INDEX_LIST(PTRROW(root%NPROW+1)-1+1), + & stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = PTRROW(root%NPROW+1)-1+1 + endif + ALLOCATE(COL_INDEX_LIST(PTRCOL(root%NPCOL+1)-1+1), + & stat=allocok) + if (allocok .GT. 0) THEN + IFLAG =-13 + IERROR = PTRCOL(root%NPCOL+1)-1+1 + endif + DO I = 1, NBROW + IGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_ROW_SON + I - 1 ) + IF (SKIPLAST_RHS_ROWS.AND.(IGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF (IGLOB.GT.N) CYCLE + POS_IN_ROOT = root%RG2L_ROW( IGLOB ) + IROW = mod( ( POS_IN_ROOT - 1 ) / root%MBLOCK, + & root%NPROW ) + ROW_INDEX_LIST( PTRROW( IROW + 1 ) ) = I + PTRROW ( IROW + 1 ) = PTRROW( IROW + 1 ) + 1 + ELSE + IF (IGLOB.LE.N) THEN + POS_IN_ROOT = root%RG2L_COL( IGLOB ) + ELSE + POS_IN_ROOT = IGLOB - N + ENDIF + JCOL = mod( ( POS_IN_ROOT - 1 ) / root%NBLOCK, + & root%NPCOL ) + COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ) = I + PTRCOL ( JCOL + 1 ) = PTRCOL( JCOL + 1 ) + 1 + END IF + END DO + DO I = 1, NBCOL + JGLOB = IW( PTRI(STEP(ISON))+SHIFT_LIST_COL_SON+I - 1 ) + IF ((KEEP(50).GT.0) .AND. (JGLOB.GT.N)) CYCLE + IF ( .NOT. INVERT ) THEN + IF ( JGLOB.LE.N ) THEN + POS_IN_ROOT = root%RG2L_COL( JGLOB ) + ELSE + POS_IN_ROOT = JGLOB - N + ENDIF + JCOL = mod( ( POS_IN_ROOT - 1 ) / + & root%NBLOCK, root%NPCOL ) + COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ) = I + PTRCOL ( JCOL + 1 ) = PTRCOL( JCOL + 1 ) + 1 + ELSE + IF ( JGLOB.LE.N ) THEN + POS_IN_ROOT = root%RG2L_ROW( JGLOB ) + ELSE + POS_IN_ROOT = JGLOB - N + ENDIF + IROW = mod( ( POS_IN_ROOT - 1 ) / + & root%MBLOCK, root%NPROW ) + ROW_INDEX_LIST( PTRROW( IROW + 1 ) ) = I + PTRROW( IROW + 1 ) = PTRROW( IROW + 1 ) + 1 + END IF + END DO + IF (BCP_SYM_NONEMPTY) THEN + DO I = 1, NBROW + IGLOB = IW( PTRI(STEP(ISON)) + + & SHIFT_LIST_ROW_SON + I - 1 ) + IF (IGLOB.LE.N) CYCLE + POS_IN_ROOT = IGLOB - N + JCOL = mod((POS_IN_ROOT-1)/root%NBLOCK,root%NPCOL) + COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ) = I + PTRCOL ( JCOL + 1 ) = PTRCOL( JCOL + 1 ) + 1 + ENDDO + DO I=1, NBCOL + JGLOB = IW( PTRI(STEP(ISON))+SHIFT_LIST_COL_SON+I - 1 ) + IF (JGLOB.GT.N) THEN + EXIT + ELSE + POS_IN_ROOT = root%RG2L_ROW(JGLOB) + ENDIF + IROW = mod((POS_IN_ROOT-1)/root%MBLOCK,root%NPROW) + ROW_INDEX_LIST( PTRROW( IROW + 1 ) ) = I + PTRROW( IROW + 1 ) = PTRROW( IROW + 1 ) + 1 + ENDDO + ENDIF + DO IROW = root%NPROW, 2, -1 + PTRROW( IROW ) = PTRROW( IROW - 1 ) + END DO + PTRROW( 1 ) = 1 + DO JCOL = root%NPCOL, 2, -1 + PTRCOL( JCOL ) = PTRCOL( JCOL - 1 ) + END DO + PTRCOL( 1 ) = 1 + JCOL = root%MYCOL + IROW = root%MYROW + IF ( root%yes ) THEN + if (IROW .ne. root%MYROW .or. JCOL.ne.root%MYCOL) then + write(*,*) ' error in grid position buildandsendcbroot' + CALL MUMPS_ABORT() + end if + IF ( PTRIST(STEP(IROOT)).EQ.0.AND. + & PTLUST_S(STEP(IROOT)).EQ.0) THEN + NBPROCFILS( STEP(IROOT) ) = -1 + CALL ZMUMPS_284(root, IROOT, N, IW, LIW, + & A, LA, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + IF (IFLAG.LT.0) THEN + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + ENDIF + ELSE + NBPROCFILS(STEP(IROOT)) = NBPROCFILS(STEP(IROOT)) - 1 + IF ( NBPROCFILS( STEP(IROOT) ) .eq. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + CALL ZMUMPS_681(IERR) + ELSE IF (KEEP(201).EQ.2) THEN + CALL ZMUMPS_580(IERR) + ENDIF + CALL ZMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS, + & SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47), + & STEP, IROOT+N ) + IF (KEEP(47) .GE. 3) THEN + CALL ZMUMPS_500( + & IPOOL, LPOOL, + & PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD, + & MYID, STEP, N, ND, FILS ) + ENDIF + END IF + END IF + IF (KEEP(60) .NE. 0 ) THEN + LOCAL_M = root%SCHUR_LLD + LOCAL_N = root%SCHUR_NLOC + NRLOCAL = PTRROW( IROW + 2 ) - PTRROW( IROW + 1 ) + NCLOCAL = PTRCOL( JCOL + 2 ) - PTRCOL( JCOL + 1 ) + CALL ZMUMPS_285( N, + & root%SCHUR_POINTER(1), + & LOCAL_M, LOCAL_N, + & root%NPCOL, root%NPROW, root%MBLOCK, root%NBLOCK, + & NBCOL, NBROW, + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_COL_SON ), + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_ROW_SON ), + & LDA, A( PTRR( STEP(ISON)) + SHIFT_VAL_SON ), + & ROW_INDEX_LIST( PTRROW( IROW + 1 ) ), + & COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ), + & NRLOCAL, + & NCLOCAL, + & NSUPROW(IROW+1), NSUPCOL(JCOL+1), + & root%RG2L_ROW(1), root%RG2L_COL(1), INVERT, + & KEEP, + & root%RHS_ROOT(1,1), root%RHS_NLOC ) + ELSE + IF ( PTRIST(STEP( IROOT )) .GE. 0 ) THEN + IF ( PTRIST(STEP( IROOT )) .EQ. 0 ) THEN + LOCAL_N = IW( PTLUST_S(STEP(IROOT)) + 1 + KEEP(IXSZ)) + LOCAL_M = IW( PTLUST_S(STEP(IROOT)) + 2 + KEEP(IXSZ)) + POSROOT = PTRFAC(IW( PTLUST_S(STEP(IROOT)) +4+KEEP(IXSZ) )) + ELSE + LOCAL_N = - IW( PTRIST(STEP(IROOT)) +KEEP(IXSZ)) + LOCAL_M = IW( PTRIST(STEP(IROOT)) + 1 +KEEP(IXSZ)) + POSROOT = PAMASTER(STEP( IROOT )) + ENDIF + NCLOCAL = PTRCOL( JCOL + 2 ) - PTRCOL( JCOL + 1 ) + NRLOCAL = PTRROW( IROW + 2 ) - PTRROW( IROW + 1 ) + CALL ZMUMPS_285( N, A( POSROOT ), + & LOCAL_M, LOCAL_N, + & root%NPCOL, root%NPROW, root%MBLOCK, root%NBLOCK, + & NBCOL, NBROW, + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_COL_SON ), + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_ROW_SON ), + & LDA, A( PTRR( STEP(ISON)) + SHIFT_VAL_SON ), + & ROW_INDEX_LIST( PTRROW( IROW + 1 ) ), + & COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ), + & NRLOCAL, + & NCLOCAL, + & NSUPROW(IROW+1), NSUPCOL(JCOL+1), + & root%RG2L_ROW(1), root%RG2L_COL(1), INVERT, + & KEEP, + & root%RHS_ROOT(1,1), root%RHS_NLOC ) + END IF + ENDIF + END IF + DO IROW = 0, root%NPROW - 1 + DO JCOL = 0, root%NPCOL - 1 + PDEST = IROW * root%NPCOL + JCOL + IF ( (root%MYROW.eq.IROW.and.root%MYCOL.eq.JCOL) .and. + & MYID.ne.PDEST) THEN + write(*,*) 'error: myrow,mycol=',root%MYROW,root%MYCOL + write(*,*) ' MYID,PDEST=',MYID,PDEST + CALL MUMPS_ABORT() + END IF + IF ( root%MYROW .NE. IROW .OR. root%MYCOL .NE. JCOL) THEN + NBROWS_ALREADY_SENT = 0 + IERR = -1 + DO WHILE ( IERR .EQ. -1 ) + NSUBSET_ROW = PTRROW( IROW + 2 ) - PTRROW( IROW + 1 ) + NSUBSET_COL = PTRCOL( JCOL + 2 ) - PTRCOL( JCOL + 1 ) + IF ( LRLU .LT. int(NSUBSET_ROW,8) * int(NSUBSET_COL,8) + & .AND. LRLUS .GT. int(NSUBSET_ROW,8) * int(NSUBSET_COL,8) ) + & THEN + CALL ZMUMPS_94(N, KEEP(28), + & IW, LIW, A, LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, + & KEEP(IXSZ)) + COMP = COMP + 1 + IF ( LRLU .NE. LRLUS ) THEN + WRITE(*,*) MYID,': Error in b&scbroot: pb compress' + WRITE(*,*) MYID,': LRLU, LRLUS=',LRLU,LRLUS + CALL MUMPS_ABORT() + END IF + END IF + CALL ZMUMPS_648( N, ISON, + & NBCOL, NBROW, + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_COL_SON ), + & IW( PTRI(STEP(ISON)) + SHIFT_LIST_ROW_SON ), + & LDA, A( PTRR(STEP(ISON)) + SHIFT_VAL_SON ), + & TAG, + & ROW_INDEX_LIST( PTRROW( IROW + 1 ) ), + & COL_INDEX_LIST( PTRCOL( JCOL + 1 ) ), + & NSUBSET_ROW, NSUBSET_COL, + & NSUPROW(IROW+1), NSUPCOL(JCOL+1), + & root%NPROW, root%NPCOL, root%MBLOCK, + & root%RG2L_ROW, root%RG2L_COL, + & root%NBLOCK, PDEST, + & COMM, IERR, A( POSFAC ), LRLU, INVERT, + & SIZE_MSG, NBROWS_ALREADY_SENT, KEEP, BBPCBP ) + IF ( IERR .EQ. -1 ) THEN + BLOCKING = .FALSE. + SET_IRECV = .TRUE. + MESSAGE_RECEIVED = .FALSE. + CALL ZMUMPS_329( COMM_LOAD, ASS_IRECV, + & BLOCKING, SET_IRECV, MESSAGE_RECEIVED, + & MPI_ANY_SOURCE, MPI_ANY_TAG, + & STATUS, BUFR, LBUFR, + & LBUFR_BYTES, PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, + & IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA, + & PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, + & PIMASTER, PAMASTER, NSTK, + & COMP, IFLAG, IERROR, COMM, NBPROCFILS, IPOOL, LPOOL, + & LEAF, NBFIN, MYID, SLAVEF, root, + & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, + & PTRARW, PTRAIW, INTARR, DBLARR, ICNTL, KEEP,KEEP8, + & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. ) + IF ( IFLAG .LT. 0 ) GOTO 500 + END IF + END DO + IF ( IERR == -2 ) THEN + IFLAG = -17 + IERROR = SIZE_MSG + IF (LP > 0) WRITE(LP, *) "FAILURE, SEND BUFFER TOO + & SMALL DURING ZMUMPS_80" + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + GOTO 500 + ENDIF + IF ( IERR == -3 ) THEN + IF (LP > 0) WRITE(LP, *) "FAILURE, RECV BUFFER TOO + & SMALL DURING ZMUMPS_80" + IFLAG = -20 + IERROR = SIZE_MSG + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + GOTO 500 + ENDIF + END IF + END DO + END DO + 500 CONTINUE + DEALLOCATE(PTRROW) + DEALLOCATE(PTRCOL) + DEALLOCATE(ROW_INDEX_LIST) + DEALLOCATE(COL_INDEX_LIST) + RETURN + END SUBROUTINE ZMUMPS_80 + SUBROUTINE ZMUMPS_285( N, VAL_ROOT, + & LOCAL_M, LOCAL_N, + & NPCOL, NPROW, MBLOCK, NBLOCK, NBCOL_SON, NBROW_SON, INDCOL_SON, + & INDROW_SON, LD_SON, VAL_SON, SUBSET_ROW, SUBSET_COL, + & NSUBSET_ROW, NSUBSET_COL, NSUPROW, NSUPCOL, + & RG2L_ROW, RG2L_COL, INVERT, + & KEEP, RHS_ROOT, NLOC ) + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INTEGER N, LOCAL_M, LOCAL_N + COMPLEX(kind=8) VAL_ROOT( LOCAL_M, LOCAL_N ) + INTEGER NPCOL, NPROW, MBLOCK, NBLOCK + INTEGER NBCOL_SON, NBROW_SON + INTEGER INDCOL_SON( NBCOL_SON ), INDROW_SON( NBROW_SON ) + INTEGER LD_SON + INTEGER NSUPROW, NSUPCOL + COMPLEX(kind=8) VAL_SON( LD_SON, NBROW_SON ) + INTEGER KEEP(500) + INTEGER NSUBSET_ROW, NSUBSET_COL + INTEGER SUBSET_ROW( NSUBSET_ROW ), SUBSET_COL( NSUBSET_COL ) + INTEGER RG2L_ROW( N ), RG2L_COL( N ) + LOGICAL INVERT + INTEGER NLOC + COMPLEX(kind=8) RHS_ROOT( LOCAL_M, NLOC) + INTEGER ISUB, JSUB, I, J, IPOS_ROOT, JPOS_ROOT + INTEGER ILOC_ROOT, JLOC_ROOT, IGLOB, JGLOB + IF (KEEP(50).EQ.0) THEN + DO ISUB = 1, NSUBSET_ROW + I = SUBSET_ROW( ISUB ) + IGLOB = INDROW_SON( I ) + IPOS_ROOT = RG2L_ROW( IGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + DO JSUB = 1, NSUBSET_COL-NSUPCOL + J = SUBSET_COL( JSUB ) + JGLOB = INDCOL_SON( J ) + JPOS_ROOT = RG2L_COL( JGLOB ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + DO JSUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL + J = SUBSET_COL( JSUB ) + JGLOB = INDCOL_SON( J ) + JPOS_ROOT = JGLOB - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + RHS_ROOT(ILOC_ROOT, JLOC_ROOT) = + & RHS_ROOT(ILOC_ROOT, JLOC_ROOT) + VAL_SON( J, I ) + ENDDO + END DO + ELSE + IF ( .NOT. INVERT ) THEN + DO ISUB = 1, NSUBSET_ROW - NSUPROW + I = SUBSET_ROW( ISUB ) + IGLOB = INDROW_SON( I ) + IPOS_ROOT = RG2L_ROW( IGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + DO JSUB = 1, NSUBSET_COL -NSUPCOL + J = SUBSET_COL( JSUB ) + JGLOB = INDCOL_SON( J ) + JPOS_ROOT = RG2L_COL( JGLOB ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + END DO + DO JSUB = NSUBSET_COL -NSUPCOL+1, NSUBSET_COL + J = SUBSET_COL( JSUB ) + JGLOB = INDROW_SON( J ) + JPOS_ROOT = JGLOB - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + DO ISUB = NSUBSET_ROW - NSUPROW +1, NSUBSET_ROW + I = SUBSET_ROW( ISUB ) + IGLOB = INDCOL_SON( I ) + IPOS_ROOT = RG2L_ROW(IGLOB) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + RHS_ROOT(ILOC_ROOT, JLOC_ROOT) = + & RHS_ROOT(ILOC_ROOT, JLOC_ROOT) + VAL_SON( I, J ) + END DO + END DO + ELSE + DO ISUB = 1, NSUBSET_COL-NSUPCOL + I = SUBSET_COL( ISUB ) + IGLOB = INDROW_SON( I ) + JPOS_ROOT = RG2L_COL( IGLOB ) + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + DO JSUB = 1, NSUBSET_ROW + J = SUBSET_ROW( JSUB ) + JGLOB = INDCOL_SON( J ) + IPOS_ROOT = RG2L_ROW( JGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & VAL_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + ENDDO + DO ISUB = NSUBSET_COL-NSUPCOL+1, NSUBSET_COL + I = SUBSET_COL( ISUB ) + IGLOB = INDROW_SON( I ) + JPOS_ROOT = IGLOB - N + JLOC_ROOT = NBLOCK + & * ( ( JPOS_ROOT - 1 ) / ( NBLOCK * NPCOL ) ) + & + mod( JPOS_ROOT - 1, NBLOCK ) + 1 + DO JSUB = 1, NSUBSET_ROW + J = SUBSET_ROW( JSUB ) + JGLOB = INDCOL_SON( J ) + IPOS_ROOT = RG2L_ROW( JGLOB ) + ILOC_ROOT = MBLOCK + & * ( ( IPOS_ROOT - 1 ) / ( MBLOCK * NPROW ) ) + & + mod( IPOS_ROOT - 1, MBLOCK ) + 1 + RHS_ROOT( ILOC_ROOT, JLOC_ROOT ) = + & RHS_ROOT( ILOC_ROOT, JLOC_ROOT ) + VAL_SON( J, I ) + END DO + ENDDO + END IF + END IF + RETURN + END SUBROUTINE ZMUMPS_285 + SUBROUTINE ZMUMPS_164 + &( MYID, NPROCS, N, root, COMM_ROOT, IROOT, FILS, + & K50, K46, K51 + & , K60, IDNPROW, IDNPCOL, IDMBLOCK, IDNBLOCK + & ) + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INTEGER MYID, MYID_ROOT + TYPE (ZMUMPS_ROOT_STRUC)::root + INTEGER COMM_ROOT + INTEGER N, IROOT, NPROCS, K50, K46, K51 + INTEGER FILS( N ) + INTEGER K60, IDNPROW, IDNPCOL, IDMBLOCK, IDNBLOCK + INTEGER INODE, NPROWtemp, NPCOLtemp + LOGICAL SLAVE + root%ROOT_SIZE = 0 + root%TOT_ROOT_SIZE = 0 + SLAVE = ( MYID .ne. 0 .or. + & ( MYID .eq. 0 .and. K46 .eq. 1 ) ) + INODE = IROOT + DO WHILE ( INODE .GT. 0 ) + INODE = FILS( INODE ) + root%ROOT_SIZE = root%ROOT_SIZE + 1 + END DO + IF ( ( K60 .NE. 2 .AND. K60 .NE. 3 ) .OR. + & IDNPROW .LE. 0 .OR. IDNPCOL .LE. 0 + & .OR. IDMBLOCK .LE.0 .OR. IDNBLOCK.LE.0 + & .OR. IDNPROW * IDNPCOL .GT. NPROCS ) THEN + root%MBLOCK = K51 + root%NBLOCK = K51 + CALL ZMUMPS_99( NPROCS, root%NPROW, root%NPCOL, + & root%ROOT_SIZE, K50 ) + IF ( K60 .EQ. 2 .OR. K60 .EQ. 3 ) THEN + IDNPROW = root%NPROW + IDNPCOL = root%NPCOL + IDMBLOCK = root%MBLOCK + IDNBLOCK = root%NBLOCK + ENDIF + ELSE IF ( K60 .EQ. 2 .OR. K60 .EQ. 3 ) THEN + root%NPROW = IDNPROW + root%NPCOL = IDNPCOL + root%MBLOCK = IDMBLOCK + root%NBLOCK = IDNBLOCK + ENDIF + IF ( K60 .EQ. 2 .OR. K60 .EQ. 3 ) THEN + IF (SLAVE) THEN + root%LPIV = 0 + IF (K46.EQ.0) THEN + MYID_ROOT=MYID-1 + ELSE + MYID_ROOT=MYID + ENDIF + IF (MYID_ROOT < root%NPROW*root%NPCOL) THEN + root%MYROW = MYID_ROOT / root%NPCOL + root%MYCOL = mod(MYID_ROOT, root%NPCOL) + root%yes = .true. + ELSE + root%MYROW = -1 + root%MYCOL = -1 + root%yes = .FALSE. + ENDIF + ELSE + root%yes = .FALSE. + ENDIF + ELSE IF ( SLAVE ) THEN + IF ( root%gridinit_done) THEN + CALL blacs_gridexit( root%CNTXT_BLACS ) + root%gridinit_done = .FALSE. + END IF + root%CNTXT_BLACS = COMM_ROOT + CALL blacs_gridinit( root%CNTXT_BLACS, 'R', + & root%NPROW, root%NPCOL ) + root%gridinit_done = .TRUE. + CALL blacs_gridinfo( root%CNTXT_BLACS, + & NPROWtemp, NPCOLtemp, + & root%MYROW, root%MYCOL ) + IF ( root%MYROW .NE. -1 ) THEN + root%yes = .true. + ELSE + root%yes = .false. + END IF + root%LPIV = 0 + ELSE + root%yes = .FALSE. + ENDIF + RETURN + END SUBROUTINE ZMUMPS_164 + SUBROUTINE ZMUMPS_165( N, root, FILS, IROOT, + & KEEP, INFO ) + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + TYPE ( ZMUMPS_ROOT_STRUC ):: root + INTEGER N, IROOT, INFO(40), KEEP(500) + INTEGER FILS( N ) + INTEGER INODE, I, allocok + IF ( associated( root%RG2L_ROW ) ) DEALLOCATE( root%RG2L_ROW ) + IF ( associated( root%RG2L_COL ) ) DEALLOCATE( root%RG2L_COL ) + ALLOCATE( root%RG2L_ROW( N ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=N + RETURN + ENDIF + ALLOCATE( root%RG2L_COL( N ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=N + RETURN + ENDIF + INODE = IROOT + I = 1 + DO WHILE ( INODE .GT. 0 ) + root%RG2L_ROW( INODE ) = I + root%RG2L_COL( INODE ) = I + I = I + 1 + INODE = FILS( INODE ) + END DO + RETURN + END SUBROUTINE ZMUMPS_165 + SUBROUTINE ZMUMPS_99( NPROCS, NPROW, NPCOL, SIZE, K50 ) + IMPLICIT NONE + INTEGER NPROCS, NPROW, NPCOL, SIZE, K50 + INTEGER NPROWtemp, NPCOLtemp, NPROCSused, FLATNESS + LOGICAL KEEPIT + IF ( K50 .EQ. 1 ) THEN + FLATNESS = 2 + ELSE + FLATNESS = 3 + ENDIF + NPROW = int(sqrt(dble(NPROCS))) + NPROWtemp = NPROW + NPCOL = int(NPROCS / NPROW) + NPCOLtemp = NPCOL + NPROCSused = NPROWtemp * NPCOLtemp + 10 CONTINUE + IF ( NPROWtemp >= NPCOLtemp/FLATNESS .AND. NPROWtemp > 1) THEN + NPROWtemp = NPROWtemp - 1 + NPCOLtemp = int(NPROCS / NPROWtemp) + KEEPIT=.FALSE. + IF ( NPROWtemp * NPCOLtemp .GE. NPROCSused ) THEN + IF ( ( K50 .NE. 1 .AND. NPROWtemp >= NPCOLtemp/FLATNESS) + & .OR. NPROWtemp * NPCOLtemp .GT. NPROCSused ) + & KEEPIT=.TRUE. + END IF + IF ( KEEPIT ) THEN + NPROW = NPROWtemp + NPCOL = NPCOLtemp + NPROCSused = NPROW * NPCOL + END IF + GO TO 10 + END IF + RETURN + END SUBROUTINE ZMUMPS_99 + SUBROUTINE ZMUMPS_290(MYID, M, N, ASEQ, + & LOCAL_M, LOCAL_N, + & MBLOCK, NBLOCK, + & APAR, + & MASTER_ROOT, + & NPROW, NPCOL, + & COMM) + IMPLICIT NONE + INTEGER MYID, MASTER_ROOT, COMM + INTEGER M, N + INTEGER NPROW, NPCOL + INTEGER LOCAL_M, LOCAL_N + INTEGER MBLOCK, NBLOCK + COMPLEX(kind=8) APAR( LOCAL_M, LOCAL_N ) + COMPLEX(kind=8) ASEQ( M, N ) + INCLUDE 'mpif.h' + INTEGER I, J, SIZE_IBLOCK, SIZE_JBLOCK, IDEST, IROW, ICOL + INTEGER IBLOCK, JBLOCK, II, JJ, KK + INTEGER IAPAR, JAPAR, IERR + INTEGER STATUS(MPI_STATUS_SIZE) + COMPLEX(kind=8) WK( MBLOCK * NBLOCK ) + LOGICAL JUPDATE + IAPAR = 1 + JAPAR = 1 + DO J = 1, N, NBLOCK + SIZE_JBLOCK = NBLOCK + IF ( J + NBLOCK > N ) THEN + SIZE_JBLOCK = N - J + 1 + END IF + JUPDATE = .FALSE. + DO I = 1, M, MBLOCK + SIZE_IBLOCK = MBLOCK + IF ( I + MBLOCK > M ) THEN + SIZE_IBLOCK = M - I + 1 + END IF + IBLOCK = I / MBLOCK + JBLOCK = J / NBLOCK + IROW = mod ( IBLOCK, NPROW ) + ICOL = mod ( JBLOCK, NPCOL ) + IDEST = IROW * NPCOL + ICOL + IF ( IDEST .NE. MASTER_ROOT ) THEN + IF ( MYID .EQ. MASTER_ROOT ) THEN + KK=1 + DO JJ=J,J+SIZE_JBLOCK-1 + DO II=I,I+SIZE_IBLOCK-1 + WK(KK)=ASEQ(II,JJ) + KK=KK+1 + END DO + END DO + CALL MPI_SSEND( WK, SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_DOUBLE_COMPLEX, + & IDEST, 128, COMM, IERR ) + ELSE IF ( MYID .EQ. IDEST ) THEN + CALL MPI_RECV( WK(1), + & SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_DOUBLE_COMPLEX, + & MASTER_ROOT,128,COMM,STATUS,IERR) + KK=1 + DO JJ=JAPAR,JAPAR+SIZE_JBLOCK-1 + DO II=IAPAR,IAPAR+SIZE_IBLOCK-1 + APAR(II,JJ)=WK(KK) + KK=KK+1 + END DO + END DO + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + ELSE IF ( MYID.EQ. MASTER_ROOT ) THEN + APAR( IAPAR:IAPAR+SIZE_IBLOCK-1, + & JAPAR:JAPAR+SIZE_JBLOCK-1 ) + & = ASEQ(I:I+SIZE_IBLOCK-1,J:J+SIZE_JBLOCK-1) + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + END DO + IF ( JUPDATE ) THEN + IAPAR = 1 + JAPAR = JAPAR + SIZE_JBLOCK + END IF + END DO + RETURN + END SUBROUTINE ZMUMPS_290 + SUBROUTINE ZMUMPS_156(MYID, M, N, ASEQ, + & LOCAL_M, LOCAL_N, + & MBLOCK, NBLOCK, + & APAR, + & MASTER_ROOT, + & NPROW, NPCOL, + & COMM) + IMPLICIT NONE + INTEGER MYID, MASTER_ROOT, COMM + INTEGER M, N + INTEGER NPROW, NPCOL + INTEGER LOCAL_M, LOCAL_N + INTEGER MBLOCK, NBLOCK + COMPLEX(kind=8) APAR( LOCAL_M, LOCAL_N ) + COMPLEX(kind=8) ASEQ( M, N ) + INCLUDE 'mpif.h' + INTEGER I, J, SIZE_IBLOCK, SIZE_JBLOCK, ISOUR, IROW, ICOL + INTEGER IBLOCK, JBLOCK, II, JJ, KK + INTEGER IAPAR, JAPAR, IERR + INTEGER STATUS(MPI_STATUS_SIZE) + COMPLEX(kind=8) WK( MBLOCK * NBLOCK ) + LOGICAL JUPDATE + IAPAR = 1 + JAPAR = 1 + DO J = 1, N, NBLOCK + SIZE_JBLOCK = NBLOCK + IF ( J + NBLOCK > N ) THEN + SIZE_JBLOCK = N - J + 1 + END IF + JUPDATE = .FALSE. + DO I = 1, M, MBLOCK + SIZE_IBLOCK = MBLOCK + IF ( I + MBLOCK > M ) THEN + SIZE_IBLOCK = M - I + 1 + END IF + IBLOCK = I / MBLOCK + JBLOCK = J / NBLOCK + IROW = mod ( IBLOCK, NPROW ) + ICOL = mod ( JBLOCK, NPCOL ) + ISOUR = IROW * NPCOL + ICOL + IF ( ISOUR .NE. MASTER_ROOT ) THEN + IF ( MYID .EQ. MASTER_ROOT ) THEN + CALL MPI_RECV( WK(1), SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_DOUBLE_COMPLEX, + & ISOUR, 128, COMM, STATUS, IERR ) + KK=1 + DO JJ=J,J+SIZE_JBLOCK-1 + DO II=I,I+SIZE_IBLOCK-1 + ASEQ(II,JJ)=WK(KK) + KK=KK+1 + END DO + END DO + ELSE IF ( MYID .EQ. ISOUR ) THEN + KK=1 + DO JJ=JAPAR,JAPAR+SIZE_JBLOCK-1 + DO II=IAPAR,IAPAR+SIZE_IBLOCK-1 + WK(KK)=APAR(II,JJ) + KK=KK+1 + END DO + END DO + CALL MPI_SSEND( WK( 1 ), + & SIZE_IBLOCK*SIZE_JBLOCK, + & MPI_DOUBLE_COMPLEX, + & MASTER_ROOT,128,COMM,IERR) + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + ELSE IF ( MYID.EQ. MASTER_ROOT ) THEN + ASEQ(I:I+SIZE_IBLOCK-1,J:J+SIZE_JBLOCK-1) + & = APAR( IAPAR:IAPAR+SIZE_IBLOCK-1, + & JAPAR:JAPAR+SIZE_JBLOCK-1 ) + JUPDATE = .TRUE. + IAPAR = IAPAR + SIZE_IBLOCK + END IF + END DO + IF ( JUPDATE ) THEN + IAPAR = 1 + JAPAR = JAPAR + SIZE_JBLOCK + END IF + END DO + RETURN + END SUBROUTINE ZMUMPS_156 + SUBROUTINE ZMUMPS_284(root, IROOT, N, + & IW, LIW, A, LA, + & FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, ITLOC, RHS_MUMPS, + & COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR ) + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INTEGER MYID + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + TYPE (ZMUMPS_ROOT_STRUC ) :: root + INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS + INTEGER IROOT, LIW, N, IWPOS, IWPOSCB + INTEGER IW( LIW ) + COMPLEX(kind=8) A( LA ) + INTEGER PTRIST(KEEP(28)), STEP(N) + INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) + INTEGER PIMASTER(KEEP(28)) + INTEGER ITLOC( N + KEEP(253) ) + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER COMP, IFLAG, IERROR + INCLUDE 'mumps_headers.h' + INTEGER FILS( N ), PTRAIW(N), PTRARW( N ) + INTEGER INTARR(max(1,KEEP(14))) + COMPLEX(kind=8) DBLARR(max(1,KEEP(13))) + INTEGER numroc + EXTERNAL numroc + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INTEGER(8) :: LREQA_ROOT + INTEGER LREQI_ROOT, LOCAL_M, LOCAL_N, allocok + LOCAL_M = numroc( root%ROOT_SIZE, root%MBLOCK, + & root%MYROW, 0, root%NPROW ) + LOCAL_M = max( 1, LOCAL_M ) + LOCAL_N = numroc( root%ROOT_SIZE, root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + IF (KEEP(253).GT.0) THEN + root%RHS_NLOC = numroc( KEEP(253), root%NBLOCK, + & root%MYCOL, 0, root%NPCOL ) + root%RHS_NLOC = max(1, root%RHS_NLOC) + ELSE + root%RHS_NLOC = 1 + ENDIF + IF (associated( root%RHS_ROOT) ) + & DEALLOCATE (root%RHS_ROOT) + ALLOCATE(root%RHS_ROOT(LOCAL_M,root%RHS_NLOC), + & stat=allocok) + IF ( allocok.GT.0) THEN + IFLAG=-13 + IERROR = LOCAL_M*root%RHS_NLOC + RETURN + ENDIF + IF (KEEP(253).NE.0) THEN + root%RHS_ROOT = ZERO + CALL ZMUMPS_760 ( N, FILS, + & root, KEEP, RHS_MUMPS, + & IFLAG, IERROR ) + IF ( IFLAG .LT. 0 ) RETURN + ENDIF + IF (KEEP(60) .NE. 0) THEN + PTRIST(STEP(IROOT)) = -6666666 + RETURN + ENDIF + LREQI_ROOT = 2 + KEEP(IXSZ) + LREQA_ROOT = int(LOCAL_M,8) * int(LOCAL_N,8) + IF (LREQA_ROOT.EQ.0_8) THEN + PTRIST(STEP(IROOT)) = -9999999 + RETURN + ENDIF + CALL ZMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE., + & MYID,N,KEEP,KEEP8,IW,LIW,A,LA, + & LRLU, IPTRLU, + & IWPOS, IWPOSCB, PTRIST, PTRAST, + & STEP, PIMASTER, PAMASTER, LREQI_ROOT, + & LREQA_ROOT, IROOT, S_NOTFREE, .TRUE., COMP, + & LRLUS, IFLAG, IERROR + & ) + IF ( IFLAG .LT. 0 ) RETURN + PTRIST ( STEP(IROOT) ) = IWPOSCB + 1 + PAMASTER( STEP(IROOT) ) = IPTRLU + 1_8 + IW( IWPOSCB + 1 + KEEP(IXSZ)) = - LOCAL_N + IW( IWPOSCB + 2 + KEEP(IXSZ)) = LOCAL_M + RETURN + END SUBROUTINE ZMUMPS_284 + SUBROUTINE ZMUMPS_760 + & ( N, FILS, root, KEEP, RHS_MUMPS, + & IFLAG, IERROR ) + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INTEGER N, KEEP(500), IFLAG, IERROR + INTEGER FILS(N) + TYPE (ZMUMPS_ROOT_STRUC ) :: root + COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255)) + INTEGER JCOL, IPOS_ROOT, JPOS_ROOT, + & IROW_GRID, JCOL_GRID, ILOCRHS, JLOCRHS, + & INODE + INODE = KEEP(38) + DO WHILE (INODE.GT.0) + IPOS_ROOT = root%RG2L_ROW( INODE ) + IROW_GRID = mod( ( IPOS_ROOT - 1 ) / root%MBLOCK, root%NPROW ) + IF ( IROW_GRID .NE. root%MYROW ) GOTO 100 + ILOCRHS = root%MBLOCK * ( ( IPOS_ROOT - 1 ) / + & ( root%MBLOCK * root%NPROW ) ) + & + mod( IPOS_ROOT - 1, root%MBLOCK ) + 1 + DO JCOL = 1, KEEP(253) + JPOS_ROOT = JCOL + JCOL_GRID = mod((JPOS_ROOT-1)/root%NBLOCK, root%NPCOL) + IF (JCOL_GRID.NE.root%MYCOL ) CYCLE + JLOCRHS = root%NBLOCK * ( ( JPOS_ROOT - 1 ) / + & ( root%NBLOCK * root%NPCOL ) ) + & + mod( JPOS_ROOT - 1, root%NBLOCK ) + 1 + root%RHS_ROOT(ILOCRHS, JLOCRHS) = + & RHS_MUMPS(INODE+(JCOL-1)*KEEP(254)) + ENDDO + 100 CONTINUE + INODE=FILS(INODE) + ENDDO + RETURN + END SUBROUTINE ZMUMPS_760 + INTEGER FUNCTION ZMUMPS_IXAMAX(n,x,incx) + COMPLEX(kind=8) x(*) + DOUBLE PRECISION smax + integer i,ix + integer incx,n + ZMUMPS_IXAMAX = 0 + if( n.lt.1 ) return + ZMUMPS_IXAMAX = 1 + if( n.eq.1 .or. incx.le.0 )return + if(incx.eq.1)go to 20 + ix = 1 + smax = abs(x(1)) + ix = ix + incx + do 10 i = 2,n + if(abs(x(ix)).le.smax) go to 5 + ZMUMPS_IXAMAX = i + smax = abs(x(ix)) + 5 ix = ix + incx + 10 continue + return + 20 smax = abs(x(1)) + do 30 i = 2,n + if(abs(x(i)).le.smax) go to 30 + ZMUMPS_IXAMAX = i + smax = abs(x(i)) + 30 continue + return + END FUNCTION ZMUMPS_IXAMAX + SUBROUTINE ZMUMPS_XSYR( UPLO, N, ALPHA, X, INCX, A, LDA ) + CHARACTER UPLO + INTEGER INCX, LDA, N + COMPLEX(kind=8) ALPHA + COMPLEX(kind=8) A( LDA, * ), X( * ) + COMPLEX(kind=8) ZERO + PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) ) + INTEGER I, INFO, IX, J, JX, KX + COMPLEX(kind=8) TEMP + INTRINSIC max + INFO = 0 + IF( UPLO.NE.'U' .AND. UPLO.NE.'L' ) THEN + INFO = 1 + ELSE IF( N.LT.0 ) THEN + INFO = 2 + ELSE IF( INCX.EQ.0 ) THEN + INFO = 5 + ELSE IF( LDA.LT.max( 1, N ) ) THEN + INFO = 7 + END IF + IF( INFO.NE.0 ) THEN + WRITE(*,*) "Internal error in ZMUMPS_XSYR" + CALL MUMPS_ABORT() + RETURN + END IF + IF( ( N.EQ.0 ) .OR. ( ALPHA.EQ.ZERO ) ) + & RETURN + IF( INCX.LE.0 ) THEN + KX = 1 - ( N-1 )*INCX + ELSE IF( INCX.NE.1 ) THEN + KX = 1 + END IF + IF( UPLO.EQ.'U' ) THEN + IF( INCX.EQ.1 ) THEN + DO 20 J = 1, N + IF( X( J ).NE.ZERO ) THEN + TEMP = ALPHA*X( J ) + DO 10 I = 1, J + A( I, J ) = A( I, J ) + X( I )*TEMP + 10 CONTINUE + END IF + 20 CONTINUE + ELSE + JX = KX + DO 40 J = 1, N + IF( X( JX ).NE.ZERO ) THEN + TEMP = ALPHA*X( JX ) + IX = KX + DO 30 I = 1, J + A( I, J ) = A( I, J ) + X( IX )*TEMP + IX = IX + INCX + 30 CONTINUE + END IF + JX = JX + INCX + 40 CONTINUE + END IF + ELSE + IF( INCX.EQ.1 ) THEN + DO 60 J = 1, N + IF( X( J ).NE.ZERO ) THEN + TEMP = ALPHA*X( J ) + DO 50 I = J, N + A( I, J ) = A( I, J ) + X( I )*TEMP + 50 CONTINUE + END IF + 60 CONTINUE + ELSE + JX = KX + DO 80 J = 1, N + IF( X( JX ).NE.ZERO ) THEN + TEMP = ALPHA*X( JX ) + IX = JX + DO 70 I = J, N + A( I, J ) = A( I, J ) + X( IX )*TEMP + IX = IX + INCX + 70 CONTINUE + END IF + JX = JX + INCX + 80 CONTINUE + END IF + END IF + RETURN + END SUBROUTINE ZMUMPS_XSYR diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part7.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part7.F new file mode 100644 index 000000000..f9969d7c3 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part7.F @@ -0,0 +1,1037 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE ZMUMPS_635(N,KEEP,ICNTL,MPG) + IMPLICIT NONE + INTEGER N, KEEP(500), ICNTL(40), MPG + KEEP(19)=0 + RETURN + END SUBROUTINE ZMUMPS_635 + SUBROUTINE ZMUMPS_634(ICNTL,KEEP,MPG,INFO) + IMPLICIT NONE + INTEGER KEEP(500), MPG, INFO(40), ICNTL(40) + IF (KEEP(19).EQ.0.AND.KEEP(110).EQ.0) THEN + IF (KEEP(111).NE.0) THEN + INFO(1) = -37 + INFO(2) = 16 + IF (KEEP(110).EQ.0) INFO(2) = 24 + IF(MPG.GT.0) THEN + WRITE( MPG,'(A)') + &'** ERROR : Null space computation requirement' + WRITE( MPG,'(A)') + &'** not consistent with factorization options' + ENDIF + GOTO 333 + ENDIF + ENDIF + IF (ICNTL(9).NE.1) THEN + IF (KEEP(111).NE.0) THEN + INFO(1) = -37 + INFO(2) = 9 + IF (MPG.GT.0) THEN + WRITE(MPG,'(A)') + &'** ERROR ICNTL(25) incompatible with ' + WRITE( MPG,'(A)') + &'** option transposed system (ICNLT(9)=1) ' + ENDIF + ENDIF + GOTO 333 + ENDIF + 333 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_634 + SUBROUTINE ZMUMPS_637(id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (ZMUMPS_STRUC) id + NULLIFY(id%root%QR_TAU) + RETURN + END SUBROUTINE ZMUMPS_637 + SUBROUTINE ZMUMPS_636(id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (ZMUMPS_STRUC) id + IF (associated(id%root%QR_TAU)) THEN + DEALLOCATE(id%root%QR_TAU) + NULLIFY(id%root%QR_TAU) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_636 + SUBROUTINE ZMUMPS_146( MYID, root, N, IROOT, + & COMM, IW, LIW, IFREE, + & A, LA, PTRAST, PTLUST_S, PTRFAC, + & STEP, INFO, LDLT, QR, + & WK, LWK, KEEP,KEEP8,DKEEP) + IMPLICIT NONE + INCLUDE 'zmumps_root.h' + INCLUDE 'mpif.h' + TYPE ( ZMUMPS_ROOT_STRUC ) :: root + INTEGER N, IROOT, COMM, LIW, MYID, IFREE + INTEGER(8) :: LA + INTEGER(8) :: LWK + COMPLEX(kind=8) WK( LWK ) + INTEGER KEEP(500) + DOUBLE PRECISION DKEEP(30) + INTEGER(8) KEEP8(150) + INTEGER(8) :: PTRAST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PTLUST_S(KEEP(28)), STEP(N), IW( LIW ) + INTEGER INFO( 2 ), LDLT, QR + COMPLEX(kind=8) A( LA ) + INTEGER IOLDPS + INTEGER(8) :: IAPOS + INTEGER LOCAL_M, LOCAL_N, LPIV, IERR, allocok + INTEGER FWD_LOCAL_N_RHS, FWD_MTYPE + INCLUDE 'mumps_headers.h' + EXTERNAL numroc + INTEGER numroc + IF ( .NOT. root%yes ) RETURN + IF ( KEEP(60) .NE. 0 ) THEN + IF ((LDLT == 1 .OR. LDLT == 2) .AND. KEEP(60) == 3 ) THEN + CALL ZMUMPS_320( WK, root%MBLOCK, + & root%MYROW, root%MYCOL, root%NPROW, root%NPCOL, + & root%SCHUR_POINTER(1), + & root%SCHUR_LLD, root%SCHUR_NLOC, + & root%TOT_ROOT_SIZE, MYID, COMM ) + ENDIF + RETURN + ENDIF + IOLDPS = PTLUST_S(STEP(IROOT))+KEEP(IXSZ) + IAPOS = PTRAST(STEP(IROOT)) + LOCAL_M = IW( IOLDPS + 2 ) + LOCAL_N = IW( IOLDPS + 1 ) + IAPOS = PTRFAC(IW ( IOLDPS + 4 )) + IF ( LDLT.EQ.0 .OR. LDLT.EQ.2 .OR. QR.ne.0 ) THEN + LPIV = LOCAL_M + root%MBLOCK + ELSE + LPIV = 1 + END IF + IF (associated( root%IPIV )) DEALLOCATE(root%IPIV) + root%LPIV = LPIV + ALLOCATE( root%IPIV( LPIV ), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1) = -13 + INFO(2) = LPIV + WRITE(*,*) MYID,': problem allocating IPIV(',LPIV,') in root' + CALL MUMPS_ABORT() + END IF + CALL DESCINIT( root%DESCRIPTOR(1), root%TOT_ROOT_SIZE, + & root%TOT_ROOT_SIZE, root%MBLOCK, root%NBLOCK, + & 0, 0, root%CNTXT_BLACS, LOCAL_M, IERR ) + IF ( LDLT.EQ.2 ) THEN + IF(root%MBLOCK.NE.root%NBLOCK) THEN + WRITE(*,*) ' Error: symmetrization only works for' + WRITE(*,*) ' square block sizes, MBLOCK/NBLOCK=', + & root%MBLOCK, root%NBLOCK + CALL MUMPS_ABORT() + END IF + IF ( LWK .LT. min( + & int(root%MBLOCK,8) * int(root%NBLOCK,8), + & int(root%TOT_ROOT_SIZE,8)* int(root%TOT_ROOT_SIZE,8 ) + & )) THEN + WRITE(*,*) 'Not enough workspace for symmetrization.' + CALL MUMPS_ABORT() + END IF + CALL ZMUMPS_320( WK, root%MBLOCK, + & root%MYROW, root%MYCOL, root%NPROW, root%NPCOL, + & A( IAPOS ), LOCAL_M, LOCAL_N, + & root%TOT_ROOT_SIZE, MYID, COMM ) + END IF + IF (LDLT.EQ.0.OR.LDLT.EQ.2) THEN + CALL pzgetrf( root%TOT_ROOT_SIZE, root%TOT_ROOT_SIZE, + & A( IAPOS ), + & 1, 1, root%DESCRIPTOR(1), root%IPIV(1), IERR ) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-10 + INFO(2)=IERR-1 + END IF + ELSE + CALL pzpotrf('L',root%TOT_ROOT_SIZE,A(IAPOS), + & 1,1,root%DESCRIPTOR(1),IERR) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-40 + INFO(2)=IERR-1 + END IF + END IF + IF (KEEP(258).NE.0) THEN + IF (root%MBLOCK.NE.root%NBLOCK) THEN + write(*,*) "Internal error in ZMUMPS_146:", + & "Block size different for rows and columns", + & root%MBLOCK, root%NBLOCK + CALL MUMPS_ABORT() + ENDIF + CALL ZMUMPS_763(root%MBLOCK, root%IPIV(1),root%MYROW, + & root%MYCOL, root%NPROW, root%NPCOL, A(IAPOS), LOCAL_M, + & LOCAL_N, root%TOT_ROOT_SIZE, MYID, DKEEP(6), KEEP(259), + & LDLT) + ENDIF + IF (KEEP(252) .NE. 0) THEN + FWD_LOCAL_N_RHS = numroc(KEEP(253), root%NBLOCK, + & root%MYCOL, 0, root%NPCOL) + FWD_LOCAL_N_RHS = max(1,FWD_LOCAL_N_RHS) + FWD_MTYPE = 1 + CALL ZMUMPS_768( + & root%TOT_ROOT_SIZE, + & KEEP(253), + & FWD_MTYPE, + & A(IAPOS), + & root%DESCRIPTOR(1), + & LOCAL_M, LOCAL_N, FWD_LOCAL_N_RHS, + & root%IPIV(1), LPIV, + & root%RHS_ROOT(1,1), LDLT, + & root%MBLOCK, root%NBLOCK, + & root%CNTXT_BLACS, IERR) + ENDIF + RETURN + END SUBROUTINE ZMUMPS_146 + SUBROUTINE ZMUMPS_556( + & N,PIV,FRERE,FILS,NFSIZ,IKEEP, + & NCST,KEEP,KEEP8,id) + USE ZMUMPS_STRUC_DEF + IMPLICIT NONE + TYPE (ZMUMPS_STRUC) :: id + INTEGER N,NCST + INTEGER PIV(N),FRERE(N),FILS(N),NFSIZ(N),IKEEP(N,3) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER I,P11,P1,P2,K1,K2,NLOCKED + LOGICAL V1,V2 + NCST = 0 + NLOCKED = 0 + P11 = KEEP(93) + DO I=KEEP(93)-1,1,-2 + P1 = PIV(I) + P2 = PIV(I+1) + K1 = IKEEP(P1,1) + IF(K1 .GT. 0) THEN + V1 = (abs(id%A(K1))*(id%ROWSCA(P1)**2).GE.1.0D-1) + ELSE + V1 = .FALSE. + ENDIF + K2 = IKEEP(P2,1) + IF(K2 .GT. 0) THEN + V2 = (abs(id%A(K2))*(id%ROWSCA(P2)**2).GE.1.0D-1) + ELSE + V2 = .FALSE. + ENDIF + IF(V1 .AND. V2) THEN + PIV(P11) = P1 + P11 = P11 - 1 + PIV(P11) = P2 + P11 = P11 - 1 + ELSE IF(V1) THEN + NCST = NCST+1 + FRERE(NCST) = P1 + NCST = NCST+1 + FRERE(NCST) = P2 + ELSE IF(V2) THEN + NCST = NCST+1 + FRERE(NCST) = P2 + NCST = NCST+1 + FRERE(NCST) = P1 + ELSE + NLOCKED = NLOCKED + 1 + FILS(NLOCKED) = P1 + NLOCKED = NLOCKED + 1 + FILS(NLOCKED) = P2 + ENDIF + ENDDO + DO I=1,NLOCKED + PIV(I) = FILS(I) + ENDDO + KEEP(94) = KEEP(94) + KEEP(93) - NLOCKED + KEEP(93) = NLOCKED + DO I=1,NCST + NLOCKED = NLOCKED + 1 + PIV(NLOCKED) = FRERE(I) + ENDDO + DO I=1,KEEP(93)/2 + NFSIZ(I) = 0 + ENDDO + DO I=(KEEP(93)/2)+1,(KEEP(93)/2)+NCST,2 + NFSIZ(I) = I+1 + NFSIZ(I+1) = -1 + ENDDO + DO I=(KEEP(93)/2)+NCST+1,(KEEP(93)/2)+KEEP(94) + NFSIZ(I) = 0 + ENDDO + END SUBROUTINE ZMUMPS_556 + SUBROUTINE ZMUMPS_550(N,NCMP,N11,N22,PIV, + & INVPERM,PERM) + IMPLICIT NONE + INTEGER N11,N22,N,NCMP + INTEGER, intent(in) :: PIV(N),PERM(N) + INTEGER, intent (out):: INVPERM(N) + INTEGER CMP_POS,EXP_POS,I,J,N2,K + N2 = N22/2 + EXP_POS = 1 + DO CMP_POS=1,NCMP + J = PERM(CMP_POS) + IF(J .LE. N2) THEN + K = 2*J-1 + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + K = K+1 + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + ELSE + K = N2 + J + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + ENDIF + ENDDO + DO K=N22+N11+1,N + I = PIV(K) + INVPERM(I) = EXP_POS + EXP_POS = EXP_POS+1 + ENDDO + RETURN + END SUBROUTINE ZMUMPS_550 + SUBROUTINE ZMUMPS_547( + & N,NZ, IRN, ICN, PIV, + & NCMP, IW, LW, IPE, LEN, IQ, + & FLAG, ICMP, IWFR, + & IERROR, KEEP,KEEP8, ICNTL) + IMPLICIT NONE + INTEGER N,NZ,NCMP,LW,IWFR,IERROR + INTEGER ICNTL(40),KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IRN(NZ),ICN(NZ),IW(LW),PIV(N),IPE(N+1) + INTEGER LEN(N),IQ(N),FLAG(N),ICMP(N) + INTEGER MP,N11,N22,NDUP + INTEGER I,K,J,N1,LAST,K1,K2,L + MP = ICNTL(2) + IERROR = 0 + N22 = KEEP(93) + N11 = KEEP(94) + NCMP = N22/2 + N11 + DO I=1,NCMP + IPE(I) = 0 + ENDDO + K = 1 + DO I=1,N22/2 + J = PIV(K) + ICMP(J) = I + K = K + 1 + J = PIV(K) + ICMP(J) = I + K = K + 1 + ENDDO + K = N22/2 + 1 + DO I=N22+1,N22+N11 + J = PIV(I) + ICMP(J) = K + K = K + 1 + ENDDO + DO I=N11+N22+1,N + J = PIV(I) + ICMP(J) = 0 + ENDDO + DO K=1,NZ + I = IRN(K) + J = ICN(K) + I = ICMP(I) + J = ICMP(J) + IF ((I.GT.N).OR.(J.GT.N).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + IERROR = IERROR + 1 + ELSE + IF (I.NE.J) THEN + IPE(I) = IPE(I) + 1 + IPE(J) = IPE(J) + 1 + ENDIF + ENDIF + ENDDO + IQ(1) = 1 + N1 = NCMP - 1 + IF (N1.GT.0) THEN + DO I=1,N1 + IQ(I+1) = IPE(I) + IQ(I) + ENDDO + ENDIF + LAST = max(IPE(NCMP)+IQ(NCMP)-1,IQ(NCMP)) + DO I = 1,NCMP + FLAG(I) = 0 + IPE(I) = IQ(I) + ENDDO + DO K=1,LAST + IW(K) = 0 + ENDDO + IWFR = LAST + 1 + DO K=1,NZ + I = IRN(K) + J = ICN(K) + I = ICMP(I) + J = ICMP(J) + IF (I.NE.J) THEN + IF (I.LT.J) THEN + IF ((I.GE.1).AND.(J.LE.N)) THEN + IW(IQ(I)) = -J + IQ(I) = IQ(I) + 1 + ENDIF + ELSE + IF ((J.GE.1).AND.(I.LE.N)) THEN + IW(IQ(J)) = -I + IQ(J) = IQ(J) + 1 + ENDIF + ENDIF + ENDIF + ENDDO + NDUP = 0 + DO I=1,NCMP + K1 = IPE(I) + K2 = IQ(I) -1 + IF (K1.GT.K2) THEN + LEN(I) = 0 + IQ(I) = 0 + ELSE + DO K=K1,K2 + J = -IW(K) + IF (J.LE.0) GO TO 250 + L = IQ(J) + IQ(J) = L + 1 + IF (FLAG(J).EQ.I) THEN + NDUP = NDUP + 1 + IW(L) = 0 + IW(K) = 0 + ELSE + IW(L) = I + IW(K) = J + FLAG(J) = I + ENDIF + ENDDO + 250 IQ(I) = IQ(I) - IPE(I) + IF (NDUP.EQ.0) LEN(I) = IQ(I) + ENDIF + ENDDO + IF (NDUP.NE.0) THEN + IWFR = 1 + DO I=1,NCMP + K1 = IPE(I) + IF (IQ(I).EQ.0) THEN + LEN(I) = 0 + IPE(I) = IWFR + CYCLE + ENDIF + K2 = K1 + IQ(I) - 1 + L = IWFR + IPE(I) = IWFR + DO K=K1,K2 + IF (IW(K).NE.0) THEN + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + ENDIF + ENDDO + LEN(I) = IWFR - L + ENDDO + ENDIF + IPE(NCMP+1) = IPE(NCMP) + LEN(NCMP) + IWFR = IPE(NCMP+1) + RETURN + END SUBROUTINE ZMUMPS_547 + SUBROUTINE ZMUMPS_551( + & N, NE, IP, IRN, SCALING,LSC,CPERM, DIAG, + & ICNTL, WEIGHT,MARKED,FLAG, + & PIV_OUT, INFO) + IMPLICIT NONE + INTEGER N, NE, ICNTL(10), INFO(10),LSC + INTEGER CPERM(N),PIV_OUT(N),IP(N+1),IRN(NE), DIAG(N) + DOUBLE PRECISION SCALING(LSC),WEIGHT(N+2) + INTEGER MARKED(N),FLAG(N) + INTEGER NUM1,NUM2,NUMTOT,PATH_LENGTH,NLAST + INTEGER I,CUR_EL,CUR_EL_PATH,CUR_EL_PATH_NEXT,BEST_BEG + INTEGER L1,L2,PTR_SET1,PTR_SET2,TUP,T22 + DOUBLE PRECISION BEST_SCORE,CUR_VAL,TMP,VAL + DOUBLE PRECISION INITSCORE, ZMUMPS_739, + & ZMUMPS_740, ZMUMPS_741 + LOGICAL VRAI,FAUX,MAX_CARD_DIAG,USE_SCALING + INTEGER SUM + DOUBLE PRECISION ZERO,ONE + PARAMETER (SUM = 1, VRAI = .TRUE., FAUX = .FALSE.) + PARAMETER(ZERO = 0.0D0, ONE = 1.0D0) + MAX_CARD_DIAG = .TRUE. + NUM1 = 0 + NUM2 = 0 + NUMTOT = 0 + NLAST = N + INFO = 0 + MARKED = 1 + FLAG = 0 + VAL = ONE + IF(LSC .GT. 1) THEN + USE_SCALING = .TRUE. + ELSE + USE_SCALING = .FALSE. + ENDIF + TUP = ICNTL(2) + IF(TUP .EQ. SUM) THEN + INITSCORE = ZERO + ELSE + INITSCORE = ONE + ENDIF + IF(ICNTL(2) .GT. 2 .OR. ICNTL(2) .LE. 0) THEN + WRITE(*,*) + & 'ERROR: WRONG VALUE FOR ICNTL(2) = ',ICNTL(2) + INFO(1) = -1 + RETURN + ENDIF + T22 = ICNTL(1) + IF(ICNTL(1) .LT. 0 .OR. ICNTL(1) .GT. 2) THEN + WRITE(*,*) + & 'ERROR: WRONG VALUE FOR ICNTL(1) = ',ICNTL(1) + INFO(1) = -1 + RETURN + ENDIF + DO CUR_EL=1,N + IF(MARKED(CUR_EL) .LE. 0) THEN + CYCLE + ENDIF + IF(CPERM(CUR_EL) .LT. 0) THEN + MARKED(CUR_EL) = -1 + CYCLE + ENDIF + PATH_LENGTH = 2 + CUR_EL_PATH = CPERM(CUR_EL) + IF(CUR_EL_PATH .EQ. CUR_EL) THEN + MARKED(CUR_EL) = -1 + CYCLE + ENDIF + MARKED(CUR_EL) = 0 + WEIGHT(1) = INITSCORE + WEIGHT(2) = INITSCORE + L1 = IP(CUR_EL+1)-IP(CUR_EL) + L2 = IP(CUR_EL_PATH+1)-IP(CUR_EL_PATH) + PTR_SET1 = IP(CUR_EL) + PTR_SET2 = IP(CUR_EL_PATH) + IF(USE_SCALING) THEN + VAL = -SCALING(CUR_EL_PATH) - SCALING(CUR_EL+N) + ENDIF + CUR_VAL = ZMUMPS_741( + & CUR_EL,CUR_EL_PATH, + & IRN(PTR_SET1),IRN(PTR_SET2), + & L1,L2, + & VAL,DIAG,N,FLAG,FAUX,T22) + WEIGHT(PATH_LENGTH+1) = + & ZMUMPS_739(WEIGHT(1),CUR_VAL,TUP) + DO + IF(CUR_EL_PATH .EQ. CUR_EL) EXIT + PATH_LENGTH = PATH_LENGTH+1 + MARKED(CUR_EL_PATH) = 0 + CUR_EL_PATH_NEXT = CPERM(CUR_EL_PATH) + L1 = IP(CUR_EL_PATH+1)-IP(CUR_EL_PATH) + L2 = IP(CUR_EL_PATH_NEXT+1)-IP(CUR_EL_PATH_NEXT) + PTR_SET1 = IP(CUR_EL_PATH) + PTR_SET2 = IP(CUR_EL_PATH_NEXT) + IF(USE_SCALING) THEN + VAL = -SCALING(CUR_EL_PATH_NEXT) + & - SCALING(CUR_EL_PATH+N) + ENDIF + CUR_VAL = ZMUMPS_741( + & CUR_EL_PATH,CUR_EL_PATH_NEXT, + & IRN(PTR_SET1),IRN(PTR_SET2), + & L1,L2, + & VAL,DIAG,N,FLAG,VRAI,T22) + WEIGHT(PATH_LENGTH+1) = + & ZMUMPS_739(WEIGHT(PATH_LENGTH-1),CUR_VAL,TUP) + CUR_EL_PATH = CUR_EL_PATH_NEXT + ENDDO + IF(mod(PATH_LENGTH,2) .EQ. 1) THEN + IF(WEIGHT(PATH_LENGTH+1) .GE. WEIGHT(PATH_LENGTH)) THEN + CUR_EL_PATH = CPERM(CUR_EL) + ELSE + CUR_EL_PATH = CUR_EL + ENDIF + DO I=1,(PATH_LENGTH-1)/2 + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + ENDDO + NUMTOT = NUMTOT + PATH_LENGTH - 1 + ELSE + IF(MAX_CARD_DIAG) THEN + CUR_EL_PATH = CPERM(CUR_EL) + IF(DIAG(CUR_EL) .NE. 0) THEN + BEST_BEG = CUR_EL_PATH + GOTO 1000 + ENDIF + DO I=1,(PATH_LENGTH/2) + CUR_EL_PATH_NEXT = CPERM(CUR_EL_PATH) + IF(DIAG(CUR_EL_PATH) .NE. 0) THEN + BEST_BEG = CUR_EL_PATH_NEXT + GOTO 1000 + ENDIF + ENDDO + ENDIF + BEST_BEG = CUR_EL + BEST_SCORE = WEIGHT(PATH_LENGTH-1) + CUR_EL_PATH = CPERM(CUR_EL) + DO I=1,(PATH_LENGTH/2)-1 + TMP = ZMUMPS_739(WEIGHT(PATH_LENGTH), + & WEIGHT(2*I-1),TUP) + TMP = ZMUMPS_740(TMP,WEIGHT(2*I),TUP) + IF(TMP .GT. BEST_SCORE) THEN + BEST_SCORE = TMP + BEST_BEG = CUR_EL_PATH + ENDIF + CUR_EL_PATH = CPERM(CUR_EL_PATH) + TMP = ZMUMPS_739(WEIGHT(PATH_LENGTH+1), + & WEIGHT(2*I),TUP) + TMP = ZMUMPS_740(TMP,WEIGHT(2*I+1),TUP) + IF(TMP .GT. BEST_SCORE) THEN + BEST_SCORE = TMP + BEST_BEG = CUR_EL_PATH + ENDIF + CUR_EL_PATH = CPERM(CUR_EL_PATH) + ENDDO + 1000 CUR_EL_PATH = BEST_BEG + DO I=1,(PATH_LENGTH/2)-1 + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + NUM2 = NUM2+1 + PIV_OUT(NUM2) = CUR_EL_PATH + CUR_EL_PATH = CPERM(CUR_EL_PATH) + ENDDO + NUMTOT = NUMTOT + PATH_LENGTH - 2 + MARKED(CUR_EL_PATH) = -1 + ENDIF + ENDDO + DO I=1,N + IF(MARKED(I) .LT. 0) THEN + IF(DIAG(I) .EQ. 0) THEN + PIV_OUT(NLAST) = I + NLAST = NLAST - 1 + ELSE + NUM1 = NUM1 + 1 + PIV_OUT(NUM2+NUM1) = I + NUMTOT = NUMTOT + 1 + ENDIF + ENDIF + ENDDO + INFO(2) = NUMTOT + INFO(3) = NUM1 + INFO(4) = NUM2 + RETURN + END SUBROUTINE ZMUMPS_551 + FUNCTION ZMUMPS_739(A,B,T) + IMPLICIT NONE + DOUBLE PRECISION ZMUMPS_739 + DOUBLE PRECISION A,B + INTEGER T + INTEGER SUM + PARAMETER(SUM = 1) + IF(T .EQ. SUM) THEN + ZMUMPS_739 = A+B + ELSE + ZMUMPS_739 = A*B + ENDIF + END FUNCTION ZMUMPS_739 + FUNCTION ZMUMPS_740(A,B,T) + IMPLICIT NONE + DOUBLE PRECISION ZMUMPS_740 + DOUBLE PRECISION A,B + INTEGER T + INTEGER SUM + PARAMETER(SUM = 1) + IF(T .EQ. SUM) THEN + ZMUMPS_740 = A-B + ELSE + ZMUMPS_740 = A/B + ENDIF + END FUNCTION ZMUMPS_740 + FUNCTION ZMUMPS_741(CUR_EL,CUR_EL_PATH, + & SET1,SET2,L1,L2,VAL,DIAG,N,FLAG,FLAGON,T) + IMPLICIT NONE + DOUBLE PRECISION ZMUMPS_741 + INTEGER CUR_EL,CUR_EL_PATH,L1,L2,N + INTEGER SET1(L1),SET2(L2),DIAG(N),FLAG(N) + DOUBLE PRECISION VAL + LOGICAL FLAGON + INTEGER T + INTEGER I,INTER,MERGE + INTEGER STRUCT,MA47 + PARAMETER(STRUCT=0,MA47=1) + IF(T .EQ. STRUCT) THEN + IF(.NOT. FLAGON) THEN + DO I=1,L1 + FLAG(SET1(I)) = CUR_EL + ENDDO + ENDIF + INTER = 0 + DO I=1,L2 + IF(FLAG(SET2(I)) .EQ. CUR_EL) THEN + INTER = INTER + 1 + FLAG(SET2(I)) = CUR_EL_PATH + ENDIF + ENDDO + MERGE = L1 + L2 - INTER + ZMUMPS_741 = dble(INTER) / dble(MERGE) + ELSE IF (T .EQ. MA47) THEN + MERGE = 3 + IF(DIAG(CUR_EL) .NE. 0) MERGE = 2 + IF(DIAG(CUR_EL_PATH) .NE. 0) MERGE = MERGE - 2 + IF(MERGE .EQ. 0) THEN + ZMUMPS_741 = dble(L1+L2-2) + ZMUMPS_741 = -(ZMUMPS_741**2)/2.0D0 + ELSE IF(MERGE .EQ. 1) THEN + ZMUMPS_741 = - dble(L1+L2-4) * dble(L1-2) + ELSE IF(MERGE .EQ. 2) THEN + ZMUMPS_741 = - dble(L1+L2-4) * dble(L2-2) + ELSE + ZMUMPS_741 = - dble(L1-2) * dble(L2-2) + ENDIF + ELSE + ZMUMPS_741 = VAL + ENDIF + RETURN + END FUNCTION + SUBROUTINE ZMUMPS_622(NA, NCMP, + & INVPERM,PERM, + & LISTVAR_SCHUR, SIZE_SCHUR, AOTOA) + IMPLICIT NONE + INTEGER, INTENT(IN):: SIZE_SCHUR, LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER, INTENT(IN):: NA, NCMP + INTEGER, INTENT(IN):: AOTOA(NCMP), PERM(NCMP) + INTEGER, INTENT(OUT):: INVPERM(NA) + INTEGER CMP_POS, IO, I, K, IPOS + DO CMP_POS=1, NCMP + IO = PERM(CMP_POS) + INVPERM(AOTOA(IO)) = CMP_POS + ENDDO + IPOS = NCMP + DO K =1, SIZE_SCHUR + I = LISTVAR_SCHUR(K) + IPOS = IPOS+1 + INVPERM(I) = IPOS + ENDDO + RETURN + END SUBROUTINE ZMUMPS_622 + SUBROUTINE ZMUMPS_623 + & (NA,N,NZ, IRN, ICN, IW, LW, IPE, LEN, + & IQ, FLAG, IWFR, + & NRORM, NIORM, IFLAG,IERROR, ICNTL, + & symmetry, SYM, MedDens, NBQD, AvgDens, + & LISTVAR_SCHUR, SIZE_SCHUR, ATOAO, AOTOA) + IMPLICIT NONE + INTEGER, INTENT(IN) :: NA,N,NZ,LW + INTEGER, INTENT(IN) :: SIZE_SCHUR, LISTVAR_SCHUR(SIZE_SCHUR) + INTEGER, INTENT(IN) :: IRN(NZ), ICN(NZ) + INTEGER, INTENT(IN) :: ICNTL(40), SYM + INTEGER, INTENT(INOUT) :: IFLAG + INTEGER, INTENT(OUT) :: IERROR,NRORM,NIORM,IWFR + INTEGER, INTENT(OUT) :: AOTOA(N) + INTEGER, INTENT(OUT) :: ATOAO(NA) + INTEGER, INTENT(OUT) :: LEN(N), IPE(N+1) + INTEGER, INTENT(OUT) :: symmetry, + & MedDens, NBQD, AvgDens + INTEGER, INTENT(OUT) :: FLAG(N), IW(LW), IQ(N) + INTEGER MP, MPG + INTEGER I,K,J,N1,LAST,NDUP,K1,K2,L + INTEGER NBERR, THRESH, IAO + INTEGER NZOFFA, NDIAGA + DOUBLE PRECISION RSYM + INTRINSIC nint + ATOAO(1:NA) = 0 + DO I = 1, SIZE_SCHUR + ATOAO(LISTVAR_SCHUR(I)) = -1 + ENDDO + IAO = 0 + DO I= 1, NA + IF (ATOAO(I).LT.0) CYCLE + IAO = IAO +1 + ATOAO(I) = IAO + AOTOA(IAO) = I + ENDDO + MP = ICNTL(2) + MPG= ICNTL(3) + NIORM = 3*N + NDIAGA = 0 + IERROR = 0 + IPE(1:N+1) = 0 + DO K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.NA).OR.(J.GT.NA).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + IERROR = IERROR + 1 + ELSE + I = ATOAO(I) + J = ATOAO(J) + IF ((I.LT.0).OR.(J.LT.0)) CYCLE + IF (I.NE.J) THEN + IPE(I) = IPE(I) + 1 + IPE(J) = IPE(J) + 1 + NIORM = NIORM + 1 + ELSE + NDIAGA = NDIAGA + 1 + ENDIF + ENDIF + ENDDO + NZOFFA = NIORM - 3*N + IF (IERROR.GE.1) THEN + NBERR = 0 + IF (mod(IFLAG,2).EQ.0) IFLAG = IFLAG+1 + IF ((MP.GT.0).AND.(ICNTL(4).GE.2)) THEN + WRITE (MP,99999) + DO 70 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.NA).OR.(J.GT.NA).OR.(I.LT.1) + & .OR.(J.LT.1)) THEN + NBERR = NBERR + 1 + IF (NBERR.LE.10) THEN + IF (mod(K,10).GT.3 .OR. mod(K,10).EQ.0 .OR. + & (10.LE.K .AND. K.LE.20)) THEN + WRITE (MP,'(I8,A,I8,A,I8,A)') + & K,'th entry (in row',I,' and column',J,') ignored' + ELSE + IF (mod(K,10).EQ.1) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'st entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.2) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'nd entry (in row',I,' and column',J,') ignored' + IF (mod(K,10).EQ.3) WRITE(MP,'(I8,A,I8,A,I8,A)') + & K,'rd entry (in row',I,' and column',J,') ignored' + ENDIF + ELSE + GO TO 100 + ENDIF + ENDIF + 70 CONTINUE + ENDIF + ENDIF + 100 NRORM = NIORM - 2*N + IQ(1) = 1 + N1 = N - 1 + IF (N1.GT.0) THEN + DO 110 I=1,N1 + IQ(I+1) = IPE(I) + IQ(I) + 110 CONTINUE + ENDIF + LAST = max(IPE(N)+IQ(N)-1,IQ(N)) + FLAG(1:N) = 0 + IPE(1:N) = IQ(1:N) + IW(1:LAST) = 0 + IWFR = LAST + 1 + DO 200 K=1,NZ + I = IRN(K) + J = ICN(K) + IF ((I.GT.NA).OR.(J.GT.NA).OR.(I.LT.1) + & .OR.(J.LT.1)) CYCLE + I = ATOAO(I) + J = ATOAO(J) + IF ((I.LT.0).OR.(J.LT.0)) CYCLE + IF (I.NE.J) THEN + IF (I.LT.J) THEN + IW(IQ(I)) = -J + IQ(I) = IQ(I) + 1 + ELSE + IW(IQ(J)) = -I + IQ(J) = IQ(J) + 1 + ENDIF + ENDIF + 200 CONTINUE + NDUP = 0 + DO 260 I=1,N + K1 = IPE(I) + K2 = IQ(I) -1 + IF (K1.GT.K2) THEN + LEN(I) = 0 + IQ(I) = 0 + ELSE + DO 240 K=K1,K2 + J = -IW(K) + IF (J.LE.0) GO TO 250 + L = IQ(J) + IQ(J) = L + 1 + IF (FLAG(J).EQ.I) THEN + NDUP = NDUP + 1 + IW(L) = 0 + IW(K) = 0 + ELSE + IW(L) = I + IW(K) = J + FLAG(J) = I + ENDIF + 240 CONTINUE + 250 IQ(I) = IQ(I) - IPE(I) + IF (NDUP.EQ.0) LEN(I) = IQ(I) + ENDIF + 260 CONTINUE + IF (NDUP.NE.0) THEN + IWFR = 1 + DO 280 I=1,N + IF (IQ(I).EQ.0) THEN + LEN(I) = 0 + IPE(I) = IWFR + GOTO 280 + ENDIF + K1 = IPE(I) + K2 = K1 + IQ(I) - 1 + L = IWFR + IPE(I) = IWFR + DO 270 K=K1,K2 + IF (IW(K).NE.0) THEN + IW(IWFR) = IW(K) + IWFR = IWFR + 1 + ENDIF + 270 CONTINUE + LEN(I) = IWFR - L + 280 CONTINUE + ENDIF + IPE(N+1) = IPE(N) + LEN(N) + IWFR = IPE(N+1) + IF (SYM.EQ.0) THEN + RSYM = dble(NDIAGA+2*NZOFFA - (IWFR-1))/ + & dble(NZOFFA+NDIAGA) + symmetry = nint (100.0D0*RSYM) + IF (MPG .GT. 0) + & write(MPG,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,I5)') + & ' ... Structural symmetry (in percent)=', symmetry + ELSE + symmetry = 100 + ENDIF + AvgDens = nint(dble(IWFR-1)/dble(N)) + THRESH = AvgDens*50 - AvgDens/10 + 1 + NBQD = 0 + IF (N.GT.2) THEN + IQ(1:N) = 0 + DO I= 1, N + K = max(LEN(I),1) + IQ(K) = IQ(K) + 1 + IF (K.GT.THRESH) NBQD = NBQD+1 + ENDDO + K = 0 + MedDens = 0 + DO WHILE (K .LT. (N/2)) + MedDens = MedDens + 1 + K = K+IQ(MedDens) + ENDDO + ELSE + MedDens = AvgDens + ENDIF + IF (MPG .GT. 0) + & write(MPG,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + IF (MP.GT.0 .AND. MPG.NE.MP) + & write(MP,'(A,3I5)') + & ' Density: NBdense, Average, Median =', + & NBQD, AvgDens, MedDens + RETURN +99999 FORMAT (/'*** Warning message from analysis routine ***') + END SUBROUTINE ZMUMPS_623 + SUBROUTINE ZMUMPS_549(N,PE,INVPERM,NFILS,WORK) + IMPLICIT NONE + INTEGER N + INTEGER PE(N),INVPERM(N),NFILS(N),WORK(N) + INTEGER I,FATHER,STKLEN,STKPOS,PERMPOS,CURVAR + NFILS = 0 + DO I=1,N + FATHER = -PE(I) + IF(FATHER .NE. 0) NFILS(FATHER) = NFILS(FATHER) + 1 + ENDDO + STKLEN = 0 + PERMPOS = 1 + DO I=1,N + IF(NFILS(I) .EQ. 0) THEN + STKLEN = STKLEN + 1 + WORK(STKLEN) = I + INVPERM(I) = PERMPOS + PERMPOS = PERMPOS + 1 + ENDIF + ENDDO + DO STKPOS = 1,STKLEN + CURVAR = WORK(STKPOS) + FATHER = -PE(CURVAR) + DO + IF(FATHER .EQ. 0) EXIT + IF(NFILS(FATHER) .EQ. 1) THEN + INVPERM(FATHER) = PERMPOS + FATHER = -PE(FATHER) + PERMPOS = PERMPOS + 1 + ELSE + NFILS(FATHER) = NFILS(FATHER) - 1 + EXIT + ENDIF + ENDDO + ENDDO + RETURN + END SUBROUTINE ZMUMPS_549 + SUBROUTINE ZMUMPS_548(N,PE,NV,WORK) + IMPLICIT NONE + INTEGER N + INTEGER PE(N),NV(N),WORK(N) + INTEGER I,FATHER,LEN,NEWSON,NEWFATHER + DO I=1,N + IF(NV(I) .GT. 0) CYCLE + LEN = 1 + WORK(LEN) = I + FATHER = -PE(I) + DO + IF(NV(FATHER) .GT. 0) THEN + NEWSON = FATHER + EXIT + ENDIF + LEN = LEN + 1 + WORK(LEN) = FATHER + NV(FATHER) = 1 + FATHER = -PE(FATHER) + ENDDO + NEWFATHER = -PE(FATHER) + PE(WORK(LEN)) = -NEWFATHER + PE(NEWSON) = -WORK(1) + ENDDO + END SUBROUTINE ZMUMPS_548 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part8.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part8.F new file mode 100644 index 000000000..00e78613d --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_part8.F @@ -0,0 +1,7522 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + SUBROUTINE ZMUMPS_301( id) + USE ZMUMPS_STRUC_DEF + USE MUMPS_SOL_ES + USE ZMUMPS_COMM_BUFFER + USE ZMUMPS_OOC + USE TOOLS_COMMON + IMPLICIT NONE + INTERFACE + SUBROUTINE ZMUMPS_710( id, NB_INT,NB_CMPLX ) + USE ZMUMPS_STRUC_DEF + TYPE (ZMUMPS_STRUC) :: id + INTEGER(8) :: NB_INT,NB_CMPLX + END SUBROUTINE ZMUMPS_710 + SUBROUTINE ZMUMPS_758 + &(idRHS, idINFO, idN, idNRHS, idLRHS) + COMPLEX(kind=8), DIMENSION(:), POINTER :: idRHS + INTEGER, intent(in) :: idN, idNRHS, idLRHS + INTEGER, intent(inout) :: idINFO(:) + END SUBROUTINE ZMUMPS_758 + END INTERFACE + INCLUDE 'mpif.h' + INCLUDE 'mumps_headers.h' +#if defined(V_T) + INCLUDE 'VT.inc' +#endif + INTEGER STATUS( MPI_STATUS_SIZE ) + INTEGER MASTER, IERR + PARAMETER( MASTER = 0 ) + TYPE (ZMUMPS_STRUC), TARGET :: id + INTEGER MP,LP, MPG + LOGICAL PROK, PROKG + INTEGER MTYPE, ICNTL21 + LOGICAL LSCAL, ERANAL, GIVSOL + INTEGER ICNTL10, ICNTL11 + INTEGER I,K,JPERM, J, II, IZ2 + INTEGER IZ, NZ_THIS_BLOCK + INTEGER LIW + INTEGER(8) :: LA, LA_PASSED + INTEGER LIW_PASSED + INTEGER LWCB_MIN, LWCB, LWCB_SOL_C + INTEGER(8) :: TMP_LWCB8 + INTEGER ZMUMPS_LBUF, ZMUMPS_LBUF_INT + INTEGER MSG_MAX_BYTES_SOLVE, MSG_MAX_BYTES_GTHRSOL + INTEGER IBEG_ROOT_DEF, IEND_ROOT_DEF, + & IBEG_GLOB_DEF, IEND_GLOB_DEF, + & IROOT_DEF_RHS_COL1 + INTEGER NITREF, NOITER, SOLVET, KASE, JOBIREF + COMPLEX(kind=8) RSOL(1) + LOGICAL INTERLEAVE_PAR, DO_PERMUTE_RHS + INTEGER :: NRHS_NONEMPTY + INTEGER :: STRAT_PERMAM1 + INTEGER :: K220(0:id%NSLAVES) + LOGICAL :: DO_NULL_PIV + INTEGER, DIMENSION(:), POINTER :: IRHS_PTR_COPY + INTEGER, DIMENSION(:), POINTER :: IRHS_SPARSE_COPY + COMPLEX(kind=8), DIMENSION(:), POINTER :: RHS_SPARSE_COPY + LOGICAL IRHS_SPARSE_COPY_ALLOCATED, IRHS_PTR_COPY_ALLOCATED, + & RHS_SPARSE_COPY_ALLOCATED + INTEGER :: NBCOL, COLSIZE, JBEG_RHS, JEND_RHS, JBEG_NEW, + & NBCOL_INBLOC, IPOS, NBT + INTEGER :: PERM_PIV_LIST(max(id%KEEP(112),1)) + INTEGER :: MAP_PIVNUL_LIST(max(id%KEEP(112),1)) + INTEGER, DIMENSION(:), ALLOCATABLE :: PERM_RHS + COMPLEX(kind=8) ONE + COMPLEX(kind=8) ZERO + PARAMETER( ONE = (1.0D0,0.0D0) ) + PARAMETER( ZERO = (0.0D0,0.0D0) ) + DOUBLE PRECISION RZERO, RONE + PARAMETER( RZERO = 0.0D0, RONE = 1.0D0 ) + COMPLEX(kind=8), DIMENSION(:), POINTER :: RHS_MUMPS + COMPLEX(kind=8), DIMENSION(:), POINTER :: WORK_WCB + COMPLEX(kind=8), DIMENSION(:), POINTER :: PTR_RHS_ROOT + INTEGER :: LPTR_RHS_ROOT + COMPLEX(kind=8), ALLOCATABLE :: SAVERHS(:), C_RW1(:), + & C_RW2(:), + & SRW3(:), C_Y(:), + & C_W(:) + COMPLEX(kind=8), ALLOCATABLE :: CWORK(:) + DOUBLE PRECISION, ALLOCATABLE :: R_RW1(:), R_Y(:), D(:) + DOUBLE PRECISION, ALLOCATABLE :: R_W(:) + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: R_LOCWK54 + COMPLEX(kind=8), ALLOCATABLE, DIMENSION(:) :: C_LOCWK54 + INTEGER, DIMENSION(:), ALLOCATABLE :: UNS_PERM_INV, + & POSINRHSCOMP_N + INTEGER LIWK_SOLVE, LIWCB + INTEGER, ALLOCATABLE :: IW1(:), IWK_SOLVE(:), IWCB(:) + INTEGER(8) :: MAXS + DOUBLE PRECISION, DIMENSION(:), POINTER :: CNTL + INTEGER, DIMENSION (:), POINTER :: KEEP,ICNTL,INFO + INTEGER(8), DIMENSION (:), POINTER :: KEEP8 + INTEGER, DIMENSION (:), POINTER :: IS + DOUBLE PRECISION, DIMENSION(:),POINTER:: RINFOG + type scaling_data_t + SEQUENCE + DOUBLE PRECISION, dimension(:), pointer :: SCALING + DOUBLE PRECISION, dimension(:), pointer :: SCALING_LOC + end type scaling_data_t + type (scaling_data_t) :: scaling_data + DOUBLE PRECISION, DIMENSION(:), POINTER :: PT_SCALING + DOUBLE PRECISION, TARGET :: Dummy_SCAL(1) + DOUBLE PRECISION ARRET + COMPLEX(kind=8) C_DUMMY(1) + DOUBLE PRECISION R_DUMMY(1) + INTEGER IDUMMY(1), JDUMMY(1), KDUMMY(1), LDUMMY(1), MDUMMY(1) + INTEGER, TARGET :: IDUMMY_TARGET(1) + COMPLEX(kind=8), TARGET :: CDUMMY_TARGET(1) + INTEGER JJ, WHAT + INTEGER allocok + INTEGER NBRHS, NBRHS_EFF, BEG_RHS, NB_RHSSKIPPED, + & IBEG, LD_RHS, KDEC, + & MASTER_ROOT, MASTER_ROOT_IN_COMM + INTEGER IPT_RHS_ROOT, SIZE_ROOT, LD_REDRHS + INTEGER IBEG_REDRHS, IBEG_RHSCOMP, LD_RHSCOMP, LENRHSCOMP + INTEGER NB_K133, IRANK, TSIZE + INTEGER KMAX_246_247 + LOGICAL WORKSPACE_MINIMAL_PREFERRED, WK_USER_PROVIDED + INTEGER(8) NB_BYTES + INTEGER(8) NB_BYTES_MAX + INTEGER(8) NB_BYTES_EXTRA + INTEGER(8) NB_INT, NB_CMPLX, K34_8, K35_8, NB_BYTES_ON_ENTRY + INTEGER(8) K16_8, ITMP8 +#if defined(V_T) + INTEGER soln_drive_class, glob_comm_ini, perm_scal_ini, soln_dist, + & soln_assem, perm_scal_post +#endif + LOGICAL I_AM_SLAVE, BUILD_POSINRHSCOMP + LOGICAL WORK_WCB_ALLOCATED, IS_INIT_OOC_DONE + LOGICAL STOP_AT_NEXT_EMPTY_COL + INTEGER MTYPE_LOC + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 +#if defined(V_T) + CALL VTCLASSDEF( 'Soln driver',soln_drive_class,IERR) + CALL VTFUNCDEF( 'glob_comm_ini',soln_drive_class, + & glob_comm_ini,IERR) + CALL VTFUNCDEF( 'perm_scal_ini',soln_drive_class, + & perm_scal_ini,IERR) + CALL VTFUNCDEF( 'soln_dist',soln_drive_class,soln_dist,IERR) + CALL VTFUNCDEF( 'soln_assem',soln_drive_class,soln_assem,IERR) + CALL VTFUNCDEF( 'perm_scal_post',soln_drive_class, + & perm_scal_post,IERR) +#endif + IRHS_PTR_COPY => IDUMMY_TARGET + IRHS_PTR_COPY_ALLOCATED = .FALSE. + IRHS_SPARSE_COPY => IDUMMY_TARGET + IRHS_SPARSE_COPY_ALLOCATED=.FALSE. + RHS_SPARSE_COPY => CDUMMY_TARGET + RHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(RHS_MUMPS) + NULLIFY(WORK_WCB) + IS_INIT_OOC_DONE = .FALSE. + WK_USER_PROVIDED = .FALSE. + WORK_WCB_ALLOCATED = .FALSE. + CNTL =>id%CNTL + KEEP =>id%KEEP + KEEP8=>id%KEEP8 + IS =>id%IS + ICNTL=>id%ICNTL + INFO =>id%INFO + RINFOG =>id%RINFOG + MP = ICNTL( 2 ) + MPG = ICNTL( 3 ) + LP = id%ICNTL( 1 ) + PROK = (MP.GT.0) + PROKG = (MPG.GT.0 .and. id%MYID.eq.MASTER) + IF ( PROK ) WRITE(MP,100) + IF ( PROKG ) WRITE(MPG,100) + NB_BYTES = 0_8 + NB_BYTES_MAX = 0_8 + NB_BYTES_EXTRA = 0_8 + K34_8 = int(KEEP(34), 8) + K35_8 = int(KEEP(35), 8) + K16_8 = int(KEEP(16), 8) + NB_RHSSKIPPED = 0 + LSCAL = .FALSE. + WORK_WCB_ALLOCATED = .FALSE. + ICNTL21 = -99998 + I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & KEEP(46) .eq. 1 ) ) + CALL ZMUMPS_710 (id, NB_INT,NB_CMPLX ) + NB_BYTES = NB_BYTES + NB_INT * K34_8 + NB_CMPLX * K35_8 + NB_BYTES_ON_ENTRY = NB_BYTES + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID .EQ. MASTER) THEN + CALL ZMUMPS_807(id) + id%KEEP(111) = id%ICNTL(25) + id%KEEP(248) = id%ICNTL(20) + ICNTL21 = id%ICNTL(21) + IF (ICNTL21 .ne.0.and.ICNTL21.ne.1) ICNTL21=0 + IF ( id%ICNTL(30) .NE.0 ) THEN + id%KEEP(237) = 1 + ELSE + id%KEEP(237) = 0 + ENDIF + IF (id%KEEP(248) .eq.0.and. id%KEEP(237).ne.0) THEN + id%KEEP(248)=1 + ENDIF + IF (id%KEEP(248) .ne.0.and.id%KEEP(248).ne.1) id%KEEP(248)=0 + IF ((id%KEEP(221).EQ.2 ).AND.(id%KEEP(248).NE.0) ) THEN + id%KEEP(248) = 0 + ENDIF + IF ((id%KEEP(221).EQ.2 ).AND.(id%KEEP(235).NE.0) ) THEN + id%KEEP(235) = 0 + ENDIF + IF ( (id%KEEP(248).EQ.0).AND.(id%KEEP(111).EQ.0) ) THEN + id%KEEP(235) = 0 + ENDIF + MTYPE = ICNTL( 9 ) + IF (id%KEEP(237).NE.0) MTYPE = 1 + ENDIF + CALL MPI_BCAST(MTYPE,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST( id%KEEP(111), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( id%KEEP(248), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( ICNTL21, 1, MPI_INTEGER, MASTER, id%COMM, IERR ) + CALL MPI_BCAST( id%KEEP(235), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( id%KEEP(221), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + CALL MPI_BCAST( id%NRHS,1, MPI_INTEGER, MASTER, id%COMM,IERR) + CALL MPI_BCAST( id%KEEP(237), 1, MPI_INTEGER, MASTER, id%COMM, + & IERR ) + IF ( id%MYID .EQ. MASTER ) THEN + IF (KEEP(201) .EQ. -1) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Solve impossible because factors not kept' + id%INFO(1)=-44 + id%INFO(2)=KEEP(251) + GOTO 333 + ELSE IF (KEEP(221).EQ.0 .AND. KEEP(251) .EQ. 2 + & .AND. KEEP(252).EQ.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Solve impossible because factors not kept' + id%INFO(1)=-44 + id%INFO(2)=KEEP(251) + GOTO 333 + ENDIF + IF (KEEP(252).NE.0 .AND. id%NRHS .NE. id%KEEP(253)) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: id%NRHS not allowed to change when ICNTL(32)=1' + id%INFO(1)=-42 + id%INFO(2)=id%KEEP(253) + GOTO 333 + ENDIF + IF (KEEP(252).NE.0 .AND. ICNTL(9).NE.1) THEN + INFO(1) = -43 + INFO(2) = 9 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: Transpose system (ICNTL(9).NE.0) not ', + & ' compatible with forward performed during', + & ' factorization (ICNTL(32)=1)' + GOTO 333 + ENDIF + IF (KEEP(248) .NE. 0.AND.KEEP(252).NE.0) THEN + INFO(1) = -43 + IF (KEEP(237).NE.0) THEN + INFO(2) = 30 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ELSE + INFO(2) = 20 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: sparse RHS incompatible with forward', + & ' performed during factorization (ICNTL(32)=1)' + ENDIF + GOTO 333 + ENDIF + IF (KEEP(237) .NE. 0 .AND. ICNTL21.NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality is incompatible', + & ' with distributed solution.' + INFO(1)=-48 + INFO(2)=21 + GOTO 333 + ENDIF + IF (KEEP(237) .NE. 0 .AND. KEEP(60) .NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality is incompatible', + & ' with Schur.' + INFO(1)=-48 + INFO(2)=19 + GOTO 333 + ENDIF + IF (KEEP(237) .NE. 0 .AND. KEEP(111) .NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: A-1 functionality is incompatible', + & ' with null space.' + INFO(1)=-48 + INFO(2)=25 + GOTO 333 + ENDIF + IF (id%NRHS .LE. 0) THEN + id%INFO(1)=-45 + id%INFO(2)=id%NRHS + GOTO 333 + ENDIF + IF ( (id%KEEP(237).EQ.0) ) THEN + IF ((id%KEEP(248) == 0 .AND.KEEP(221).NE.2) + & .OR. ICNTL21==0) THEN + CALL ZMUMPS_758 + & (id%RHS,id%INFO,id%N,id%NRHS,id%LRHS) + IF (id%INFO(1) .LT. 0) GOTO 333 + ENDIF + ELSE + IF (id%NRHS .NE. id%N) THEN + id%INFO(1)=-47 + id%INFO(2)=id%NRHS + GOTO 333 + ENDIF + ENDIF + IF (id%KEEP(248) == 1) THEN + IF ((id%NZ_RHS.LE.0).AND.(KEEP(237).NE.0)) THEN + id%INFO(1)=-46 + id%INFO(2)=id%NZ_RHS + GOTO 333 + ENDIF + IF (( id%NZ_RHS .LE.0 ).AND.(KEEP(221).EQ.1)) THEN + id%INFO(1)=-46 + id%INFO(2)=id%NZ_RHS + GOTO 333 + ENDIF + IF ( .not. associated(id%RHS_SPARSE) )THEN + id%INFO(1)=-22 + id%INFO(2)=10 + GOTO 333 + ENDIF + IF ( .not. associated(id%IRHS_SPARSE) )THEN + id%INFO(1)=-22 + id%INFO(2)=11 + GOTO 333 + ENDIF + IF ( .not. associated(id%IRHS_PTR) )THEN + id%INFO(1)=-22 + id%INFO(2)=12 + GOTO 333 + ENDIF + IF (size(id%IRHS_PTR) < id%NRHS + 1) THEN + id%INFO(1)=-22 + id%INFO(2)=12 + GOTO 333 + END IF + IF (id%IRHS_PTR(id%NRHS + 1).ne.id%NZ_RHS+1) THEN + id%INFO(1)=-27 + id%INFO(2)=id%IRHS_PTR(id%NRHS+1) + GOTO 333 + END IF + IF (dble(id%N)*dble(id%NRHS).LT.dble(id%NZ_RHS)) THEN + IF (PROKG) THEN + write(MPG,*)id%MYID, + & " Incompatible values for sparse RHS ", + & " id%NZ_RHS,id%N,id%NRHS =", + & id%NZ_RHS,id%N,id%NRHS + ENDIF + id%INFO(1)=-22 + id%INFO(2)=11 + GOTO 333 + END IF + IF (id%IRHS_PTR(1).ne.1) THEN + id%INFO(1)=-28 + id%INFO(2)=id%IRHS_PTR(1) + GOTO 333 + END IF + IF (size(id%IRHS_SPARSE) < id%NZ_RHS) THEN + id%INFO(1)=-22 + id%INFO(2)=11 + GOTO 333 + END IF + IF (size(id%RHS_SPARSE) < id%NZ_RHS) THEN + id%INFO(1)=-22 + id%INFO(2)=10 + GOTO 333 + END IF + ENDIF + CALL ZMUMPS_634(ICNTL(1),KEEP(1),MPG,INFO(1)) + IF (INFO(1) .LT. 0) GOTO 333 + IF (KEEP(111).eq.-1.AND.id%NRHS.NE.KEEP(112)+KEEP(17))THEN + INFO(1)=-32 + INFO(2)=id%NRHS + GOTO 333 + ENDIF + IF (KEEP(111).gt.0 .AND. id%NRHS .NE. 1) THEN + INFO(1)=-32 + INFO(2)=id%NRHS + GOTO 333 + ENDIF + IF (KEEP(111) .NE. 0 .AND. id%KEEP(50) .EQ. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: null space not available for unsymmetric matrices' + INFO(1) = -37 + INFO(2) = 0 + GOTO 333 + ENDIF + IF (KEEP(248) .NE.0.AND.KEEP(111).NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: ICNTL(20) and ICNTL(30) functionalities ', + & ' incompatible with null space' + INFO(1) = -37 + IF (KEEP(237).NE.0) THEN + INFO(2) = 30 + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: ICNTL(30) functionality ', + & ' incompatible with null space' + ELSE + IF (PROKG) WRITE(MPG,'(A)') + & ' ERROR: ICNTL(20) functionality ', + & ' incompatible with null space' + INFO(2) = 20 + ENDIF + GOTO 333 + ENDIF + IF (( KEEP(111) .LT. -1 ) .OR. + & (KEEP(111).GT.KEEP(112)+KEEP(17)) .OR. + & (KEEP(111) .EQ.-1 .AND. KEEP(112)+KEEP(17).EQ.0)) + & THEN + INFO(1)=-36 + INFO(2)=KEEP(111) + GOTO 333 + ENDIF + END IF + IF (ICNTL21==1) THEN + IF ( id%MYID .ne. MASTER .OR. + & ( id%MYID .eq. MASTER .AND. + & id%KEEP(46) .eq. 1 ) ) THEN + IF ( id%LSOL_loc < id%KEEP(89) ) THEN + id%INFO(1)= -29 + id%INFO(2)= id%LSOL_loc + GOTO 333 + ENDIF + IF (id%KEEP(89) .NE. 0) THEN + IF ( .not. associated(id%ISOL_loc) )THEN + id%INFO(1)=-22 + id%INFO(2)=13 + GOTO 333 + ENDIF + IF ( .not. associated(id%SOL_loc) )THEN + id%INFO(1)=-22 + id%INFO(2)=14 + GOTO 333 + ENDIF + IF (size(id%ISOL_loc) < id%KEEP(89) ) THEN + id%INFO(1)=-22 + id%INFO(2)=13 + GOTO 333 + END IF + IF (size(id%SOL_loc) < + & (id%NRHS-1)*id%LSOL_loc+id%KEEP(89)) THEN + id%INFO(1)=-22 + id%INFO(2)=14 + GOTO 333 + END IF + ENDIF + ENDIF + ENDIF + IF (id%MYID .NE. MASTER) THEN + IF (id%KEEP(248) == 1) THEN + IF ( associated( id%RHS ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 7 + GOTO 333 + END IF + IF ( associated( id%RHS_SPARSE ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 10 + GOTO 333 + END IF + IF ( associated( id%IRHS_SPARSE ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 11 + GOTO 333 + END IF + IF ( associated( id%IRHS_PTR ) ) THEN + id%INFO( 1 ) = -22 + id%INFO( 2 ) = 12 + GOTO 333 + END IF + END IF + ENDIF + IF (id%MYID.EQ.MASTER) THEN + CALL ZMUMPS_769(id) + END IF + IF (id%INFO(1) .LT. 0) GOTO 333 + 333 CONTINUE + CALL MUMPS_276( id%ICNTL(1), + & id%INFO(1), + & id%COMM, id%MYID ) + IF ( id%INFO(1) .LT. 0 ) GO TO 90 + IF ((id%KEEP(248).EQ.1).AND.(id%KEEP(237).EQ.0)) THEN + CALL MPI_BCAST(id%NZ_RHS,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + IF (id%NZ_RHS.EQ.0) THEN + IF ((ICNTL21.EQ.1).AND.(I_AM_SLAVE)) THEN + LIW_PASSED=max(1,KEEP(32)) + IF (KEEP(89) .GT. 0) THEN + CALL ZMUMPS_535( MTYPE, id%ISOL_loc(1), + & id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%IS(1), LIW_PASSED,id%MYID_NODES, + & id%N, id%STEP(1), id%PROCNODE_STEPS(1), + & id%NSLAVES, scaling_data, LSCAL ) + DO J=1, id%NRHS + DO I=1, KEEP(89) + id%SOL_loc((J-1)*id%LSOL_loc + I) =ZERO + ENDDO + ENDDO + ENDIF + ENDIF + IF (ICNTL21.NE.1) THEN + IF (id%MYID.EQ.MASTER) THEN + DO J=1, id%NRHS + DO I=1, id%N + id%RHS((J-1)*id%LRHS + I) =ZERO + ENDDO + ENDDO + ENDIF + ENDIF + IF ( PROKG ) THEN + WRITE( MPG, 150 ) + & id%NRHS, ICNTL(27), ICNTL(9), ICNTL(10), ICNTL(11), + & ICNTL(20), ICNTL(21), ICNTL(30) + IF (KEEP(221).NE.0) THEN + WRITE (MPG, 152) KEEP(221) + ENDIF + IF (KEEP(252).GT.0) THEN + WRITE (MPG, 153) KEEP(252) + ENDIF + ENDIF + GOTO 90 + ENDIF + ENDIF + IF (id%MYID.EQ.MASTER) THEN + IF ((KEEP(111).NE.0)) THEN + KEEP(242) = 0 + ENDIF + ENDIF + INTERLEAVE_PAR =.FALSE. + DO_PERMUTE_RHS =.FALSE. + IF ((id%KEEP(235).NE.0).or.(id%KEEP(237).NE.0)) THEN + IF (id%KEEP(237).NE.0.AND. + & id%KEEP(248).EQ.0) THEN + IF (LP.GT.0) THEN + WRITE(LP,'(A,I4,I4)') + & ' Internal Error in solution driver (A-1) ', + & id%KEEP(237), id%KEEP(248) + ENDIF + CALL MUMPS_ABORT() + ENDIF + NBT = 0 + CALL MUMPS_733(id%Step2node, id%KEEP(28), id%INFO, LP, + & FORCE=.TRUE., + & STRING='id%Step2node (Solve)', MEMCNT=NBT, ERRCODE=-13) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM, id%MYID ) + IF ( INFO(1).LT.0 ) RETURN + IF (NBT.NE.0) THEN + DO I=1, id%N + IF (id%STEP(I).LE.0) CYCLE + id%Step2node(id%STEP(I)) = I + ENDDO + ENDIF + NB_BYTES = NB_BYTES + int(NBT,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + NB_BYTES_EXTRA = NB_BYTES_EXTRA + int(NBT,8) * K34_8 + ENDIF + IF ( I_AM_SLAVE ) + & CALL MUMPS_804(id%OOC_SIZE_OF_BLOCK, id%KEEP(201)) + DO_NULL_PIV = .TRUE. + NBCOL_INBLOC = -9998 + NZ_THIS_BLOCK= -9998 + JBEG_RHS = -9998 + IF (id%MYID.EQ.MASTER) THEN + IF( KEEP(111)==0 .AND. KEEP(248)==1 ) THEN + NRHS_NONEMPTY = 0 + DO I=1, id%NRHS + IF (id%IRHS_PTR(I).LT.id%IRHS_PTR(I+1)) + & NRHS_NONEMPTY = NRHS_NONEMPTY+1 + ENDDO + IF (NRHS_NONEMPTY.LE.0) THEN + IF (LP.GT.0) + & WRITE(LP,*) 'Internal error : NRHS_NONEMPTY=', + & NRHS_NONEMPTY + CALL MUMPS_ABORT() + ENDIF + ELSE + NRHS_NONEMPTY = id%NRHS + ENDIF + ENDIF + BUILD_POSINRHSCOMP = .TRUE. + IF (KEEP(221).EQ.2 .AND. KEEP(252).EQ.0) THEN + BUILD_POSINRHSCOMP = .FALSE. + ENDIF + SIZE_ROOT = -33333 + IF ( KEEP( 38 ) .ne. 0 ) THEN + MASTER_ROOT = MUMPS_275( + & id%PROCNODE_STEPS(id%STEP( KEEP(38))), + & id%NSLAVES ) + IF (id%MYID_NODES .eq. MASTER_ROOT) THEN + SIZE_ROOT = id%root%TOT_ROOT_SIZE + ELSE IF ((id%MYID.EQ.MASTER).AND.KEEP(60).NE.0) THEN + SIZE_ROOT=id%KEEP(116) + ENDIF + ELSE IF (KEEP( 20 ) .ne. 0 ) THEN + MASTER_ROOT = MUMPS_275( + & id%PROCNODE_STEPS(id%STEP(KEEP(20))), + & id%NSLAVES ) + IF (id%MYID_NODES .eq. MASTER_ROOT) THEN + SIZE_ROOT = id%IS( + & id%PTLUST_S(id%STEP(KEEP(20)))+KEEP(IXSZ) + 3) + ELSE IF ((id%MYID.EQ.MASTER).AND.KEEP(60).NE.0) THEN + SIZE_ROOT=id%KEEP(116) + ENDIF + ELSE + MASTER_ROOT = -44444 + END IF + IF (id%MYID .eq. MASTER) THEN + KEEP(84) = ICNTL(27) + IF (KEEP(252).NE.0) THEN + NBRHS = KEEP(253) + ELSE + IF (KEEP(201) .EQ. 0 .OR. KEEP(84) .GT. 0) THEN + NBRHS = abs(KEEP(84)) + ELSE + NBRHS = -2*KEEP(84) + END IF + IF (NBRHS .GT. NRHS_NONEMPTY ) NBRHS = NRHS_NONEMPTY + ENDIF + ENDIF +#if defined(V_T) + CALL VTBEGIN(glob_comm_ini,IERR) +#endif + CALL MPI_BCAST(NRHS_NONEMPTY,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(NBRHS,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + IF (KEEP(201).GT.0) THEN + IF (I_AM_SLAVE) THEN + IF (KEEP(201).EQ.1 + & .AND.KEEP(50).EQ.0 + & .AND.KEEP(251).NE.2 + & ) THEN + OOC_NB_FILE_TYPE=2 + ELSE + OOC_NB_FILE_TYPE=1 + ENDIF + ENDIF + WORKSPACE_MINIMAL_PREFERRED = .FALSE. + IF (id%MYID .eq. MASTER) THEN + KEEP(107) = max(0,KEEP(107)) + IF ((KEEP(107).EQ.0).AND. + & (KEEP(204).EQ.0).AND.(KEEP(211).NE.1) ) THEN + WORKSPACE_MINIMAL_PREFERRED=.TRUE. + ENDIF + ENDIF + CALL MPI_BCAST( KEEP(107), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(204), 1, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( KEEP(208), 2, MPI_INTEGER, + & MASTER, id%COMM, IERR ) + CALL MPI_BCAST( WORKSPACE_MINIMAL_PREFERRED, 1, + & MPI_LOGICAL, + & MASTER, id%COMM, IERR ) + ENDIF + IF ( I_AM_SLAVE ) THEN + NB_K133 = 3 + IF ( KEEP( 38 ) .NE. 0 .OR. KEEP( 20 ) .NE. 0 ) THEN + IF ( MASTER_ROOT .eq. id%MYID_NODES ) THEN + IF ( + & .NOT. associated(id%root%RHS_CNTR_MASTER_ROOT) + & ) THEN + NB_K133 = NB_K133 + 1 + ENDIF + END IF + ENDIF + LWCB_MIN = NB_K133*KEEP(133)*NBRHS + WK_USER_PROVIDED = (id%LWK_USER.NE.0) + IF (id%LWK_USER.EQ.0) THEN + ITMP8 = 0_8 + ELSE IF (id%LWK_USER.GT.0) THEN + ITMP8= int(id%LWK_USER,8) + ELSE + ITMP8 = -int(id%LWK_USER,8)* 1000000_8 + ENDIF + IF (KEEP(201).EQ.0) THEN + IF (ITMP8.NE.KEEP8(24)) THEN + INFO(1) = -41 + INFO(2) = id%LWK_USER + GOTO 99 + ENDIF + ELSE + KEEP8(24)=ITMP8 + ENDIF + MAXS = 0_8 + IF (WK_USER_PROVIDED) THEN + MAXS = KEEP8(24) + IF (MAXS.LT. KEEP8(20)) THEN + INFO(1)= -11 + ITMP8 = KEEP8(20)+1_8-MAXS + CALL MUMPS_731(ITMP8, INFO(2)) + ENDIF + IF (INFO(1) .GE. 0 ) id%S => id%WK_USER(1:KEEP8(24)) + ELSE IF (associated(id%S)) THEN + MAXS = KEEP8(23) + ELSE + IF (KEEP(201).EQ.0) THEN + WRITE(*,*) ' Working array S not allocated ', + & ' on entry to solve phase (in core) ' + CALL MUMPS_ABORT() + ELSE + IF ( KEEP(209).EQ.-1 .AND. WORKSPACE_MINIMAL_PREFERRED) + & THEN + MAXS = KEEP8(20) + 1_8 + ELSE IF ( KEEP(209) .GE.0 ) THEN + MAXS = max(int(KEEP(209),8), KEEP8(20) + 1_8) + ELSE + MAXS = id%KEEP8(14) + ENDIF + ALLOCATE (id%S(MAXS), stat = allocok) + KEEP8(23)=MAXS + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) ' Problem allocation of S at solve' + INFO(1) = -13 + CALL MUMPS_731(MAXS, INFO(2)) + NULLIFY(id%S) + KEEP8(23)=0_8 + ENDIF + NB_BYTES = NB_BYTES + KEEP8(23) * K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + ENDIF + IF(KEEP(201).EQ.0)THEN + LA = KEEP8(31) + ELSE + LA = MAXS + IF(MAXS.GT.KEEP8(31)+KEEP8(20)*int(KEEP(107)+1,8))THEN + LA=KEEP8(31)+KEEP8(20)*int(KEEP(107)+1,8) + ENDIF + ENDIF + IF ( MAXS-LA .GT. int(LWCB_MIN,8) ) THEN + TMP_LWCB8 = min( MAXS - LA, int(huge(LWCB),8) ) + LWCB = int( TMP_LWCB8, kind(LWCB) ) + WORK_WCB => id%S(LA+1_8:LA+TMP_LWCB8) + WORK_WCB_ALLOCATED=.FALSE. + ELSE + LWCB = LWCB_MIN + ALLOCATE(WORK_WCB(LWCB_MIN), stat = allocok) + IF (allocok < 0 ) THEN + INFO(1)=-13 + INFO(2)=LWCB_MIN + ENDIF + WORK_WCB_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(size(WORK_WCB),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + ENDIF + 99 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) < 0) GOTO 90 + IF ( I_AM_SLAVE ) THEN + IF (KEEP(201).GT.0) THEN + CALL ZMUMPS_590(LA) + CALL ZMUMPS_586(id) + IS_INIT_OOC_DONE = .TRUE. + ENDIF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) < 0) GOTO 90 + IF (id%MYID .eq. MASTER) THEN + IF ( (KEEP(242).NE.0) .or. (KEEP(243).NE.0) ) THEN + IF ( (KEEP(237) .EQ.0) .and. (KEEP(111).EQ.0) ) THEN + KEEP(242) = 0 + KEEP(243) = 0 + ENDIF + ENDIF + IF ( PROKG ) THEN + WRITE( MPG, 150 ) + & id%NRHS, NBRHS, ICNTL(9), ICNTL(10), ICNTL(11), + & ICNTL(20), ICNTL(21), ICNTL(30) + IF (KEEP(111).NE.0) THEN + WRITE (MPG, 151) KEEP(111) + ENDIF + IF (KEEP(221).NE.0) THEN + WRITE (MPG, 152) KEEP(221) + ENDIF + IF (KEEP(252).GT.0) THEN + WRITE (MPG, 153) KEEP(252) + ENDIF + ENDIF + LSCAL = (((KEEP(52) .GT. 0) .AND. (KEEP(52) .LE. 8)) .OR. ( + & KEEP(52) .EQ. -1) .OR. KEEP(52) .EQ. -2) + ERANAL = ((ICNTL(11) .GT. 0) .OR. (ICNTL(10) .GT. 0)) + IF ( (KEEP(55).eq.0) .AND. KEEP(54).eq.0 .AND. + & .NOT.associated(id%A) ) THEN + ICNTL10 = 0 + ICNTL11 = 0 + ERANAL = .FALSE. + ELSE + ICNTL10 = ICNTL(10) + ICNTL11 = ICNTL(11) + ENDIF + IF ((KEEP(111).NE.0).OR.(KEEP(237).NE.0).OR. + & (KEEP(252).NE.0) ) THEN + IF (ICNTL10 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(10) treated as if set to 0 ' + ENDIF + IF (ICNTL11 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(11) treated as if set to 0 ' + ENDIF + ICNTL10 = 0 + ICNTL11 = 0 + ERANAL = .FALSE. + END IF + IF (KEEP(221).NE.0) THEN + IF (ICNTL10 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(10) treated as if set to 0 (reduced RHS))' + ENDIF + IF (ICNTL11 .GT. 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(11) treated as if set to 0 (reduced RHS)' + ENDIF + ICNTL10 = 0 + ICNTL11 = 0 + ERANAL = .FALSE. + END IF + IF ((ERANAL .AND. NBRHS > 1) .OR. ICNTL(21) > 0) THEN + IF (ICNTL11 > 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(11) treated as if set to zero' + ICNTL11=0 + ENDIF + IF (ICNTL10 > 0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: ICNTL(10) treated as if set to zero' + ICNTL10=0 + ENDIF + ERANAL = .FALSE. + ENDIF + IF (ERANAL) THEN + ALLOCATE(SAVERHS(id%N*NBRHS),stat = allocok) + IF ( allocok .GT. 0 ) THEN + WRITE(*,*) ' Problem in solve: error allocating SAVERHS' + INFO(1) = -13 + INFO(2) = id%N*NBRHS + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(size(SAVERHS),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + IF (KEEP(237).NE.0 .AND.KEEP(111).NE.0) THEN + IF (PROKG) WRITE(MPG,'(A)') + & ' WARNING: KEEP(237) treated as if set to 0 (null space)' + KEEP(237)=0 + ENDIF + IF (KEEP(242).EQ.0) KEEP(243)=0 + END IF + CALL MPI_BCAST(ICNTL10,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(ICNTL11,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(ICNTL21,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(ERANAL,1,MPI_LOGICAL,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(LSCAL,1,MPI_LOGICAL,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(KEEP(111),1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(KEEP(242),1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + CALL MPI_BCAST(KEEP(243),1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + DO_PERMUTE_RHS = (KEEP(242).NE.0) + IF ( KEEP(242).NE.0) THEN + IF ((KEEP(237).EQ.0).AND.(KEEP(111).EQ.0)) THEN + IF (MP.GT.0) THEN + write(MP,*) ' Warning incompatible options ', + & ' permute RHS reset to false ' + ENDIF + DO_PERMUTE_RHS = .FALSE. + ENDIF + ENDIF + IF ( (id%NSLAVES.GT.1) .AND. (KEEP(243).NE.0) + & ) THEN + IF ((KEEP(237).NE.0).or.(KEEP(111).GT.0)) THEN + INTERLEAVE_PAR= .TRUE. + ELSE + IF (PROKG) THEN + write(MPG,*) ' Warning incompatible options ', + & ' interleave RHS reset to false ' + ENDIF + ENDIF + ENDIF +#if defined(check) + IF ( id%MYID_NODES .EQ. MASTER ) THEN + WRITE(*,*) " ES A-1 DO_Perm Interleave =" + WRITE(*,144) id%KEEP(235), id%KEEP(237), + & id%KEEP(242),id%KEEP(243) + ENDIF +#endif + MSG_MAX_BYTES_SOLVE = ( 4 + KEEP(133) ) * KEEP(34) + + & KEEP(133) * NBRHS * KEEP(35) + & + 16 * KEEP(34) + IF (KEEP(237).EQ.0) THEN + KMAX_246_247 = max(KEEP(246),KEEP(247)) + MSG_MAX_BYTES_GTHRSOL = ( ( 2 + KMAX_246_247 ) * KEEP(34) + + & KMAX_246_247 * NBRHS * KEEP(35) ) + ELSE + MSG_MAX_BYTES_GTHRSOL = ( 3 * KEEP(34) + KEEP(35) ) + ENDIF + id%LBUFR_BYTES = max(MSG_MAX_BYTES_SOLVE, MSG_MAX_BYTES_GTHRSOL) + TSIZE = int(min(100_8*int(MSG_MAX_BYTES_GTHRSOL,8), + & 10000000_8)) + id%LBUFR_BYTES = max(id%LBUFR_BYTES,TSIZE) + id%LBUFR = ( id%LBUFR_BYTES + KEEP(34) - 1 ) / KEEP(34) + IF ( associated (id%BUFR) ) THEN + NB_BYTES = NB_BYTES - int(size(id%BUFR),8)*K34_8 + DEALLOCATE(id%BUFR) + NULLIFY(id%BUFR) + ENDIF + ALLOCATE (id%BUFR(id%LBUFR),stat=allocok) + IF ( allocok .GT. 0 ) THEN + IF (LP.GT.0) + & WRITE(LP,*) id%MYID, + & ' Problem in solve: error allocating BUFR' + INFO(1) = -13 + INFO(2) = id%LBUFR + GOTO 111 + ENDIF + NB_BYTES = NB_BYTES + int(size(id%BUFR),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( I_AM_SLAVE ) THEN + ZMUMPS_LBUF_INT = ( 20 + id%NSLAVES * id%NSLAVES * 4 ) + & * KEEP(34) + CALL ZMUMPS_55( ZMUMPS_LBUF_INT, IERR ) + IF ( IERR .NE. 0 ) THEN + INFO(1) = -13 + INFO(2) = ZMUMPS_LBUF_INT + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) id%MYID, + & ':Error allocating small Send buffer:IERR=',IERR + END IF + GOTO 111 + END IF + ZMUMPS_LBUF = (MSG_MAX_BYTES_SOLVE + 2*KEEP(34) )*id%NSLAVES + ZMUMPS_LBUF = min(ZMUMPS_LBUF, 100 000 000) + ZMUMPS_LBUF = max(ZMUMPS_LBUF, + & (MSG_MAX_BYTES_SOLVE+2*KEEP(34)) * min(id%NSLAVES,3)) + ZMUMPS_LBUF = ZMUMPS_LBUF + KEEP(34) + CALL ZMUMPS_53( ZMUMPS_LBUF, IERR ) + IF ( IERR .NE. 0 ) THEN + INFO(1) = -13 + INFO(2) = ZMUMPS_LBUF/KEEP(34) + 1 + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) id%MYID, + & ':Error allocating Send buffer:IERR=', IERR + END IF + GOTO 111 + END IF + ENDIF + IF ( + & ( id%MYID .NE. MASTER ) + & .or. + & ( I_AM_SLAVE .AND. id%MYID .EQ. MASTER .AND. + & ICNTL21 .NE.0 .AND. + & ( KEEP(248).ne.0 .OR. KEEP(221).EQ.2 + & .OR. KEEP(111).NE.0 ) + & ) + & .or. + & ( id%MYID .EQ. MASTER .AND. (KEEP(237).NE.0) ) + & ) THEN + ALLOCATE(RHS_MUMPS(id%N*NBRHS),stat=IERR) + NB_BYTES = NB_BYTES + int(size(RHS_MUMPS),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( IERR .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N*NBRHS + IF (LP > 0) + & WRITE(LP,*) 'ERROR while allocating RHS on a slave' + GOTO 111 + END IF + ELSE + RHS_MUMPS=>id%RHS + ENDIF + IF ( I_AM_SLAVE ) THEN + LD_RHSCOMP = max(KEEP(89),1) + IF (id%MYID.EQ.MASTER) THEN + LD_RHSCOMP = max(LD_RHSCOMP, KEEP(247)) + ENDIF + IF (KEEP(221).EQ.2 .AND. KEEP(252).EQ.0) THEN + IF (.NOT.associated(id%RHSCOMP)) THEN + INFO(1) = -35 + INFO(2) = 1 + GOTO 111 + ENDIF + IF (.NOT.associated(id%POSINRHSCOMP)) THEN + INFO(1) = -35 + INFO(2) = 2 + GOTO 111 + ENDIF + LENRHSCOMP = size(id%RHSCOMP) + LD_RHSCOMP = LENRHSCOMP/id%NRHS + ELSE IF (KEEP(221).EQ.1) THEN + IF (associated(id%RHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8 + DEALLOCATE(id%RHSCOMP) + ENDIF + LENRHSCOMP = LD_RHSCOMP*id%NRHS + ALLOCATE (id%RHSCOMP(LENRHSCOMP)) + NB_BYTES = NB_BYTES + int(size(id%RHSCOMP),8)*K35_8 + IF (associated(id%POSINRHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%POSINRHSCOMP),8)*K34_8 + DEALLOCATE(id%POSINRHSCOMP) + ENDIF + ALLOCATE (id%POSINRHSCOMP(KEEP(28)) ) + NB_BYTES = NB_BYTES + int(size(id%POSINRHSCOMP),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ELSE + LENRHSCOMP = LD_RHSCOMP*NBRHS + IF (associated(id%RHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8 + DEALLOCATE(id%RHSCOMP) + NULLIFY(id%RHSCOMP) + ENDIF + ALLOCATE (id%RHSCOMP(LENRHSCOMP)) + NB_BYTES = NB_BYTES + int(size(id%RHSCOMP),8)*K35_8 + IF (associated(id%POSINRHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%POSINRHSCOMP),8)*K34_8 + DEALLOCATE(id%POSINRHSCOMP) + ENDIF + ALLOCATE (id%POSINRHSCOMP(KEEP(28)) ) + NB_BYTES = NB_BYTES + int(size(id%POSINRHSCOMP),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + LIWK_SOLVE = 4 * KEEP(28) + 1 + IF (KEEP(201).EQ.1) THEN + LIWK_SOLVE = LIWK_SOLVE + KEEP(228) + 1 + ELSE + LIWK_SOLVE = LIWK_SOLVE + 1 + ENDIF + ALLOCATE ( IWK_SOLVE( LIWK_SOLVE), stat = allocok ) + IF (allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=LIWK_SOLVE + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(LIWK_SOLVE,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + LIWCB = 20*NB_K133*2 + KEEP(133) + ALLOCATE ( IWCB( LIWCB), stat = allocok ) + IF (allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=LIWCB + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(LIWCB,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + LIW = KEEP(32) + ALLOCATE(SRW3(KEEP(133)), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=KEEP(133) + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(size(SRW3),8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( (KEEP(111).NE.0) .OR. (KEEP(248).NE.0) ) THEN + ALLOCATE(POSINRHSCOMP_N(id%N), stat=allocok) + IF ( allocok .GT. 0 ) THEN + IF (LP.GT.0) WRITE(LP,*) + & ' ERROR in ZMUMPS_301: allocating POSINRHSCOMP_N' + INFO(1) = -13 + INFO(2) = id%N + GOTO 111 + END IF + NB_BYTES = NB_BYTES + int(size(POSINRHSCOMP_N),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + END IF + ELSE + LIW=0 + END IF + IF (allocated(UNS_PERM_INV)) DEALLOCATE(UNS_PERM_INV) + IF ( ( id%MYID .eq. MASTER.AND.(KEEP(23).GT.0) .AND. + & (MTYPE .NE. 1).AND.(KEEP(248).NE.0) + & ) + & .OR. ( ( KEEP(237).NE.0 ) .AND. (KEEP(23).NE.0) ) + & ) THEN + ALLOCATE(UNS_PERM_INV(id%N),stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 111 + endif + NB_BYTES = NB_BYTES + int(id%N,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID.EQ.MASTER) THEN + DO I = 1, id%N + UNS_PERM_INV(id%UNS_PERM(I))=I + ENDDO + ENDIF + ELSE + ALLOCATE(UNS_PERM_INV(1), stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=1 + GOTO 111 + endif + NB_BYTES = NB_BYTES + 1_8*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + 111 CONTINUE +#if defined(V_T) + CALL VTEND(glob_comm_ini,IERR) +#endif + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF ( ( KEEP(237).NE.0 ) .AND. (KEEP(23).NE.0) ) THEN + CALL MPI_BCAST(UNS_PERM_INV,id%N,MPI_INTEGER,MASTER, + & id%COMM,IERR) + ENDIF + IF ( ICNTL21==1 ) THEN + IF (LSCAL) THEN + IF (id%MYID.NE.MASTER) THEN + IF (MTYPE == 1) THEN + ALLOCATE(id%COLSCA(id%N),stat=allocok) + ELSE + ALLOCATE(id%ROWSCA(id%N),stat=allocok) + ENDIF + IF (allocok > 0) THEN + IF (LP > 0) THEN + WRITE(LP,*) 'Error allocating temporary scaling array' + ENDIF + INFO(1)=-13 + INFO(2)=id%N + GOTO 40 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + IF (MTYPE == 1) THEN + CALL MPI_BCAST(id%COLSCA(1),id%N, + & MPI_DOUBLE_PRECISION,MASTER, + & id%COMM,IERR) + scaling_data%SCALING=>id%COLSCA + ELSE + CALL MPI_BCAST(id%ROWSCA(1),id%N, + & MPI_DOUBLE_PRECISION,MASTER, + & id%COMM,IERR) + scaling_data%SCALING=>id%ROWSCA + ENDIF + IF (I_AM_SLAVE) THEN + ALLOCATE(scaling_data%SCALING_LOC(id%KEEP(89)), + & stat=allocok) + IF (allocok > 0) THEN + IF (LP > 0) THEN + WRITE(LP,*) 'Error allocating local scaling array' + ENDIF + INFO(1)=-13 + INFO(2)=id%KEEP(89) + GOTO 40 + ENDIF + NB_BYTES = NB_BYTES + int(id%KEEP(89),8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + LIW_PASSED=max(1,LIW) + IF (KEEP(89) .GT. 0) THEN + CALL ZMUMPS_535( MTYPE, id%ISOL_loc(1), + & id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%IS(1), LIW_PASSED,id%MYID_NODES, + & id%N, id%STEP(1), id%PROCNODE_STEPS(1), + & id%NSLAVES, scaling_data, LSCAL ) + ENDIF + IF (id%MYID.NE.MASTER .AND. LSCAL) THEN + IF (MTYPE == 1) THEN + DEALLOCATE(id%COLSCA) + NULLIFY(id%COLSCA) + ELSE + DEALLOCATE(id%ROWSCA) + NULLIFY(id%ROWSCA) + ENDIF + NB_BYTES = NB_BYTES - int(id%N,8)*K16_8 + ENDIF + ENDIF + IF (KEEP(23) .NE. 0 .AND. MTYPE==1) THEN + IF (id%MYID.NE.MASTER) THEN + ALLOCATE(id%UNS_PERM(id%N),stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 40 + ENDIF + ENDIF + ENDIF + 40 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF (KEEP(23) .NE. 0 .AND. MTYPE==1) THEN + CALL MPI_BCAST(id%UNS_PERM(1),id%N,MPI_INTEGER,MASTER, + & id%COMM,IERR) + IF (I_AM_SLAVE) THEN + DO I=1, KEEP(89) + id%ISOL_loc(I) = id%UNS_PERM(id%ISOL_loc(I)) + ENDDO + ENDIF + IF (id%MYID.NE.MASTER) THEN + DEALLOCATE(id%UNS_PERM) + NULLIFY(id%UNS_PERM) + ENDIF + ENDIF + ENDIF + IF ( ( KEEP(221) .EQ. 1 ) .OR. + & ( KEEP(221) .EQ. 2 ) + & ) THEN + IF (KEEP(46).EQ.1) THEN + MASTER_ROOT_IN_COMM=MASTER_ROOT + ELSE + MASTER_ROOT_IN_COMM =MASTER_ROOT+1 + ENDIF + IF ( id%MYID .EQ. MASTER ) THEN + IF (id%NRHS.EQ.1) THEN + LD_REDRHS = id%KEEP(116) + ELSE + LD_REDRHS = id%LREDRHS + ENDIF + ENDIF + IF (MASTER.NE.MASTER_ROOT_IN_COMM) THEN + IF ( id%MYID .EQ. MASTER ) THEN + CALL MPI_SEND(LD_REDRHS,1,MPI_INTEGER, + & MASTER_ROOT_IN_COMM, 0, id%COMM,IERR) + ELSEIF ( id%MYID.EQ.MASTER_ROOT_IN_COMM) THEN + CALL MPI_RECV(LD_REDRHS,1,MPI_INTEGER, + & MASTER, 0, id%COMM,STATUS,IERR) + ENDIF + ENDIF + ENDIF + IF ( KEEP(248)==1 ) THEN + JEND_RHS = 0 + IF (DO_PERMUTE_RHS) THEN + ALLOCATE(PERM_RHS(id%NRHS),stat=allocok) + IF (allocok > 0) THEN + INFO(1) = -13 + INFO(2) = id%NRHS + GOTO 109 + ENDIF + NB_BYTES = NB_BYTES + int(id%NRHS,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID.EQ.MASTER) THEN + STRAT_PERMAM1 = KEEP(242) + CALL MUMPS_780 + & (STRAT_PERMAM1, id%SYM_PERM(1), + & id%IRHS_PTR(1), id%NRHS+1, + & PERM_RHS, id%NRHS, + & IERR + & ) + ENDIF + ENDIF + ENDIF +109 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF (id%NSLAVES .EQ. 1) THEN + IF (DO_PERMUTE_RHS .AND. KEEP(111).NE.0 ) THEN + WRITE(*,*) id%MYID, ':INTERNAL ERROR 1 : ', + & ' PERMUTE RHS during null space computation ', + & ' not available yet ' + CALL MUMPS_ABORT() + ENDIF + ELSE + IF (DO_PERMUTE_RHS .AND. KEEP(111).NE.0 ) THEN + WRITE(*,*) id%MYID, ':INTERNAL ERROR 2 : ', + & ' PERMUTE RHS during null space computation ', + & ' not available yet ' + CALL MUMPS_ABORT() + ENDIF + IF (INTERLEAVE_PAR) THEN + IF ( KEEP(111).NE.0 ) THEN + WRITE(*,*) id%MYID, ':INTERNAL ERROR 3 : ', + & ' INTERLEAVE RHS during null space computation ', + & ' not available yet ' + CALL MUMPS_ABORT() + ELSE + IF (id%MYID.EQ.MASTER) THEN + CALL MUMPS_772 + & (PERM_RHS, id%NRHS, id%N, id%KEEP(28), + & id%PROCNODE_STEPS(1), id%STEP(1), id%NSLAVES, + & id%Step2node(1), + & IERR) + ENDIF + ENDIF + ENDIF + ENDIF + IF (DO_PERMUTE_RHS.AND.(KEEP(111).EQ.0)) THEN + CALL MPI_BCAST(PERM_RHS(1), + & id%NRHS, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + ENDIF + BEG_RHS=1 + DO WHILE (BEG_RHS.LE.NRHS_NONEMPTY) + NBRHS_EFF = min(NRHS_NONEMPTY-BEG_RHS+1, NBRHS) + IF (IRHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_SPARSE_COPY),8)*K34_8 + DEALLOCATE(IRHS_SPARSE_COPY) + IRHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_SPARSE_COPY) + ENDIF + IF (IRHS_PTR_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_PTR_COPY),8)*K34_8 + DEALLOCATE(IRHS_PTR_COPY) + IRHS_PTR_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_PTR_COPY) + ENDIF + IF (RHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(RHS_SPARSE_COPY),8)*K35_8 + DEALLOCATE(RHS_SPARSE_COPY) + RHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(RHS_SPARSE_COPY) + ENDIF + IF ( + & ( id%MYID .NE. MASTER ) + & .or. + & ( I_AM_SLAVE .AND. id%MYID .EQ. MASTER .AND. + & ICNTL21 .NE.0 .AND. + & ( KEEP(248).ne.0 .OR. KEEP(221).EQ.2 + & .OR. KEEP(111).NE.0 ) + & ) + & .or. + & ( id%MYID .EQ. MASTER .AND. (KEEP(237).NE.0) ) + & ) THEN + LD_RHS = id%N + IBEG = 1 + ELSE + IF ( associated(id%RHS) ) THEN + LD_RHS = max(id%LRHS, id%N) + ELSE + LD_RHS = id%N + ENDIF + IBEG = (BEG_RHS-1) * LD_RHS + 1 + ENDIF + JBEG_RHS = BEG_RHS + IF ( (id%MYID.EQ.MASTER) .AND. + & KEEP(248)==1 ) THEN + JBEG_RHS = JEND_RHS + 1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + DO WHILE ( id%IRHS_PTR(PERM_RHS(JBEG_RHS)) .EQ. + & id%IRHS_PTR(PERM_RHS(JBEG_RHS)+1) ) + IF ((KEEP(237).EQ.0).AND.(ICNTL21.EQ.0).AND. + & (KEEP(221).NE.1) ) THEN + DO I=1, id%N + RHS_MUMPS((PERM_RHS(JBEG_RHS) -1)*LD_RHS+I) + & = ZERO + ENDDO + ENDIF + JBEG_RHS = JBEG_RHS +1 + CYCLE + ENDDO + ELSE + DO WHILE( id%IRHS_PTR(JBEG_RHS) .EQ. + & id%IRHS_PTR(JBEG_RHS+1) ) + IF ((KEEP(237).EQ.0).AND.(ICNTL21.EQ.0).AND. + & (KEEP(221).NE.1)) THEN + DO I=1, id%N + RHS_MUMPS((JBEG_RHS -1)*LD_RHS + I) = ZERO + ENDDO + ENDIF + IF (KEEP(221).EQ.1) THEN + DO I = 1, id%SIZE_SCHUR + id%REDRHS((JBEG_RHS-1)*LD_REDRHS + I) = ZERO + ENDDO + ENDIF + JBEG_RHS = JBEG_RHS +1 + ENDDO + ENDIF + NB_RHSSKIPPED = JBEG_RHS - (JEND_RHS + 1) + IF ((KEEP(248).EQ.1).AND.(KEEP(237).EQ.0) + & .AND. (ICNTL21.EQ.0)) + & THEN + IBEG = (JBEG_RHS-1) * LD_RHS + 1 + ENDIF + ENDIF + CALL MPI_BCAST( JBEG_RHS,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + IF (id%MYID.EQ.MASTER .AND. KEEP(221).NE.0) THEN + IBEG_REDRHS= (JBEG_RHS-1)*LD_REDRHS + 1 + ELSE + IBEG_REDRHS=-142424 + ENDIF + IF ( I_AM_SLAVE ) THEN + IF ( KEEP(221).EQ.0 ) THEN + IBEG_RHSCOMP= 1 + ELSE + IBEG_RHSCOMP= (JBEG_RHS-1)*LD_RHSCOMP + 1 + ENDIF + ELSE + IBEG_RHSCOMP=-152525 + ENDIF +#if defined(V_T) + CALL VTBEGIN(perm_scal_ini,IERR) +#endif + IF (id%MYID .eq. MASTER) THEN + IF (KEEP(248)==1) THEN + NBCOL = 0 + NBCOL_INBLOC = 0 + NZ_THIS_BLOCK = 0 + STOP_AT_NEXT_EMPTY_COL = .FALSE. + DO I=JBEG_RHS, id%NRHS + NBCOL_INBLOC = NBCOL_INBLOC +1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + ELSE + COLSIZE = id%IRHS_PTR(I+1) - id%IRHS_PTR(I) + ENDIF + IF ((.NOT.STOP_AT_NEXT_EMPTY_COL).AND.(COLSIZE.GT.0).AND. + & (KEEP(237).EQ.0)) + & STOP_AT_NEXT_EMPTY_COL =.TRUE. + IF (COLSIZE.GT.0) THEN + NBCOL = NBCOL+1 + NZ_THIS_BLOCK = NZ_THIS_BLOCK + COLSIZE + ELSE IF (STOP_AT_NEXT_EMPTY_COL) THEN + NBCOL_INBLOC = NBCOL_INBLOC -1 + NBRHS_EFF = NBCOL + EXIT + ENDIF + IF (NBCOL.EQ.NBRHS_EFF) EXIT + ENDDO + IF (NBCOL.NE.NBRHS_EFF) THEN + WRITE(6,*) 'INTERNAL ERROR 1 in ZMUMPS_301 ', + & NBCOL, NBRHS_EFF + call MUMPS_ABORT() + ENDIF + ALLOCATE(IRHS_PTR_COPY(NBCOL_INBLOC+1),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NBCOL_INBLOC+1 + GOTO 30 + endif + IRHS_PTR_COPY_ALLOCATED = .TRUE. + NB_BYTES = NB_BYTES + int(NBCOL_INBLOC+1,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + JEND_RHS =JBEG_RHS + NBCOL_INBLOC - 1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + IPOS = 1 + J = 0 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + J = J+1 + IRHS_PTR_COPY(J) = IPOS + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + IPOS = IPOS + COLSIZE + ENDDO + ELSE + IPOS = 1 + J = 0 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + J = J+1 + IRHS_PTR_COPY(J) = IPOS + COLSIZE = id%IRHS_PTR(I+1) + & - id%IRHS_PTR(I) + IPOS = IPOS + COLSIZE + ENDDO + ENDIF + IRHS_PTR_COPY(NBCOL_INBLOC+1)= IPOS + IF ( IPOS-1 .NE. NZ_THIS_BLOCK ) THEN + WRITE(*,*) "Error in compressed copy of IRHS_PTR" + IERR = 99 + call MUMPS_ABORT() + ENDIF + IF (KEEP(23) .NE. 0 .and. MTYPE .NE. 1) THEN + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 30 + endif + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ELSE + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (KEEP(237).NE.0)) THEN + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK), stat=allocok) + IF (allocok .GT.0 ) THEN + IERR = 99 + GOTO 30 + ENDIF + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( DO_PERMUTE_RHS.OR.INTERLEAVE_PAR ) THEN + IPOS = 1 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + IRHS_SPARSE_COPY(IPOS:IPOS+COLSIZE-1) = + & id%IRHS_SPARSE(id%IRHS_PTR(PERM_RHS(I)): + & id%IRHS_PTR(PERM_RHS(I)+1) -1) + IPOS = IPOS + COLSIZE + ENDDO + ELSE + IRHS_SPARSE_COPY = id%IRHS_SPARSE(id%IRHS_PTR(JBEG_RHS): + & id%IRHS_PTR(JBEG_RHS)+NZ_THIS_BLOCK-1) + ENDIF + ELSE + IRHS_SPARSE_COPY + & => + & id%IRHS_SPARSE(id%IRHS_PTR(JBEG_RHS): + & id%IRHS_PTR(JBEG_RHS)+NZ_THIS_BLOCK-1) + ENDIF + ENDIF + IF (LSCAL.OR.DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (KEEP(237).NE.0)) THEN + ALLOCATE(RHS_SPARSE_COPY(NZ_THIS_BLOCK), stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 30 + endif + RHS_SPARSE_COPY_ALLOCATED = .TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ELSE + IF ( KEEP(248)==1 ) THEN + RHS_SPARSE_COPY + & => id%RHS_SPARSE(id%IRHS_PTR(JBEG_RHS): + & id%IRHS_PTR(JBEG_RHS)+NZ_THIS_BLOCK-1) + ELSE + RHS_SPARSE_COPY + & => id%RHS_SPARSE(id%IRHS_PTR(BEG_RHS): + & id%IRHS_PTR(BEG_RHS)+NZ_THIS_BLOCK-1) + ENDIF + ENDIF + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (id%KEEP(237).NE.0)) THEN + IF (id%KEEP(237).NE.0) THEN + RHS_SPARSE_COPY = ONE + ELSE IF (.NOT. LSCAL) THEN + IPOS = 1 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + COLSIZE = id%IRHS_PTR(PERM_RHS(I)+1) + & - id%IRHS_PTR(PERM_RHS(I)) + IF (COLSIZE .EQ. 0) CYCLE + RHS_SPARSE_COPY(IPOS:IPOS+COLSIZE-1) = + & id%RHS_SPARSE(id%IRHS_PTR(PERM_RHS(I)): + & id%IRHS_PTR(PERM_RHS(I)+1) -1) + IPOS = IPOS + COLSIZE + ENDDO + ENDIF + ENDIF + ENDIF + IF (KEEP(23) .NE. 0) THEN + IF (MTYPE .NE. 1) THEN + IF (KEEP(248)==0) THEN + ALLOCATE( C_RW2( id%N ),stat =allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) id%MYID, + & ':Error allocating C_RW2 in ZMUMPS_SOLVE_DRIVE' + END IF + GOTO 30 + END IF + DO K = 1, NBRHS_EFF + KDEC = IBEG+(K-1)*LD_RHS + DO I = 1, id%N + C_RW2(I)=RHS_MUMPS(I-1+KDEC) + END DO + DO I = 1, id%N + JPERM = id%UNS_PERM(I) + RHS_MUMPS(I-1+KDEC) = C_RW2(JPERM) + END DO + END DO + DEALLOCATE(C_RW2) + ELSE + IPOS = 1 + DO I=1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(I+1) - IRHS_PTR_COPY(I) + DO K = 1, COLSIZE + JPERM = UNS_PERM_INV(IRHS_SPARSE_COPY(IPOS+K-1)) + IRHS_SPARSE_COPY(IPOS+K-1) = JPERM + ENDDO + IPOS = IPOS + COLSIZE + ENDDO + ENDIF + ENDIF + ENDIF + IF (ERANAL) THEN + IF ( KEEP(248) == 0 ) THEN + DO K = 1, NBRHS_EFF + KDEC = IBEG+(K-1)*LD_RHS + DO I = 1, id%N + SAVERHS(I+(K-1)*id%N) = RHS_MUMPS(KDEC+I-1) + END DO + ENDDO + ENDIF + ENDIF + IF (LSCAL) THEN + IF (KEEP(248)==0) THEN + IF (MTYPE .EQ. 1) THEN + DO K =1, NBRHS_EFF + KDEC = (K-1) * LD_RHS + IBEG - 1 + DO I = 1, id%N + RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) * + & id%ROWSCA(I) + END DO + ENDDO + ELSE + DO K =1, NBRHS_EFF + KDEC = (K-1) * LD_RHS + IBEG - 1 + DO I = 1, id%N + RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) * + & id%COLSCA(I) + END DO + ENDDO + ENDIF + ELSE + KDEC=id%IRHS_PTR(JBEG_RHS) + IF ((KEEP(248)==1) .AND. + & (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR.OR. + & (id%KEEP(237).NE.0)) + & ) THEN + IPOS = 1 + J = 0 + DO I=JBEG_RHS, JBEG_RHS + NBCOL_INBLOC -1 + J = J+1 + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE .EQ. 0) CYCLE + IF (id%KEEP(237).NE.0) THEN + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + RHS_SPARSE_COPY(IPOS) = id%ROWSCA(PERM_RHS(I)) * + & ONE + ELSE + RHS_SPARSE_COPY(IPOS) = id%ROWSCA(I) * ONE + ENDIF + ELSE + DO K = 1, COLSIZE + II = id%IRHS_SPARSE(id%IRHS_PTR(PERM_RHS(I))+K-1) + IF (MTYPE.EQ.1) THEN + RHS_SPARSE_COPY(IPOS+K-1) = + & id%RHS_SPARSE(id%IRHS_PTR(PERM_RHS(I))+K-1)* + & id%ROWSCA(II) + ELSE + RHS_SPARSE_COPY(IPOS+K-1) = + & id%RHS_SPARSE(id%IRHS_PTR(PERM_RHS(I))+K-1)* + & id%COLSCA(II) + ENDIF + ENDDO + ENDIF + IPOS = IPOS + COLSIZE + ENDDO + ELSE + IF (MTYPE .eq. 1) THEN + DO IZ=1,NZ_THIS_BLOCK + I=IRHS_SPARSE_COPY(IZ) + RHS_SPARSE_COPY(IZ)=id%RHS_SPARSE(KDEC+IZ-1)* + & id%ROWSCA(I) + ENDDO + ELSE + DO IZ=1,NZ_THIS_BLOCK + I=IRHS_SPARSE_COPY(IZ) + RHS_SPARSE_COPY(IZ)=id%RHS_SPARSE(KDEC+IZ-1)* + & id%COLSCA(I) + ENDDO + ENDIF + ENDIF + ENDIF + END IF + ENDIF +#if defined(V_T) + CALL VTEND(perm_scal_ini,IERR) +#endif + 30 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + IF ( I_AM_SLAVE ) THEN + IF ( (KEEP(111).NE.0) .OR. (KEEP(248).NE.0) .OR. + & (KEEP(252).NE.0) ) THEN + IF (BUILD_POSINRHSCOMP) THEN + IF (KEEP(111).NE.0) THEN + WHAT = 2 + MTYPE_LOC = 1 + ELSE IF (KEEP(252).NE.0) THEN + WHAT = 0 + MTYPE_LOC = 1 + ELSE + WHAT = 1 + MTYPE_LOC = MTYPE + ENDIF + LIW_PASSED=max(1,LIW) + IF (WHAT.EQ.0) THEN + CALL ZMUMPS_639(id%NSLAVES,id%N, + & id%MYID_NODES, id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%PROCNODE_STEPS(1), id%IS(1), LIW_PASSED, + & id%STEP(1), + & id%POSINRHSCOMP(1), IDUMMY, 1, MTYPE_LOC, + & WHAT ) + ELSE + CALL ZMUMPS_639(id%NSLAVES,id%N, + & id%MYID_NODES, id%PTLUST_S(1), + & id%KEEP(1),id%KEEP8(1), + & id%PROCNODE_STEPS(1), id%IS(1), LIW_PASSED, + & id%STEP(1), + & id%POSINRHSCOMP(1), POSINRHSCOMP_N(1), + & id%N, MTYPE_LOC, + & WHAT ) + ENDIF + BUILD_POSINRHSCOMP = .FALSE. + ENDIF + ENDIF + ENDIF + IF (KEEP(248)==1) THEN + CALL MPI_BCAST( NBCOL_INBLOC,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + ELSE + NBCOL_INBLOC = NBRHS_EFF + ENDIF + JEND_RHS =JBEG_RHS + NBCOL_INBLOC - 1 + IF ((KEEP(248).EQ.1).AND.(KEEP(237).EQ.0)) THEN + CALL MPI_BCAST( NBRHS_EFF,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(NB_RHSSKIPPED,1,MPI_INTEGER,MASTER, + & id%COMM,IERR) + ENDIF +#if defined(V_T) + CALL VTBEGIN(soln_dist,IERR) +#endif + IF ((KEEP(111).eq.0).AND.(KEEP(252).EQ.0)) THEN + IF (KEEP(248) == 0) THEN + IF ( .NOT.I_AM_SLAVE ) THEN + CALL ZMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & JDUMMY, id%KEEP(1), id%KEEP8(1), id%PROCNODE_STEPS(1), + & IDUMMY, 1, + & id%STEP(1), KDUMMY, 1, BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + BUILD_POSINRHSCOMP=.FALSE. + ELSE + LIW_PASSED = max( LIW, 1 ) + CALL ZMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), + & IS(1), LIW_PASSED, + & id%STEP(1), id%POSINRHSCOMP(1), KEEP(28), + & BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + BUILD_POSINRHSCOMP=.FALSE. + ENDIF + IF (INFO(1).LT.0) GOTO 90 + ELSE + CALL MPI_BCAST( NZ_THIS_BLOCK,1, MPI_INTEGER, + & MASTER, id%COMM,IERR) + IF (id%MYID.NE.MASTER) THEN + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 45 + endif + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + ALLOCATE(RHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 45 + endif + RHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*(K34_8+K35_8) + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ALLOCATE(IRHS_PTR_COPY(NBCOL_INBLOC+1),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NBCOL_INBLOC+1 + GOTO 45 + endif + IRHS_PTR_COPY_ALLOCATED = .TRUE. + NB_BYTES = NB_BYTES + int(NBCOL_INBLOC+1,8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + 45 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + CALL MPI_BCAST(IRHS_SPARSE_COPY(1), + & NZ_THIS_BLOCK, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(RHS_SPARSE_COPY(1), + & NZ_THIS_BLOCK, + & MPI_DOUBLE_COMPLEX, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(IRHS_PTR_COPY(1), + & NBCOL_INBLOC+1, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + IF (IERR.GT.0) THEN + WRITE (*,*)'NOT OK FOR ALLOC PTR ON SLAVES' + call MUMPS_ABORT() + ENDIF + IF ( I_AM_SLAVE ) THEN + IF (KEEP(237).NE.0) THEN + K=1 + RHS_MUMPS(1:NBRHS_EFF*LD_RHS) = ZERO + IPOS = 1 + DO I = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(I+1) - IRHS_PTR_COPY(I) + IF (COLSIZE.GT.0) THEN + J = I - 1 + JBEG_RHS + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + J = PERM_RHS(J) + ENDIF + IF (POSINRHSCOMP_N(J).NE.0) THEN + RHS_MUMPS((K-1) * LD_RHS + J) = + & RHS_SPARSE_COPY(IPOS) + ENDIF + K = K + 1 + IPOS = IPOS + COLSIZE + ENDIF + ENDDO + IF (K.NE.NBRHS_EFF+1) THEN + WRITE(6,*) 'INTERNAL ERROR 2 in ZMUMPS_301 ', + & K, NBRHS_EFF + call MUMPS_ABORT() + ENDIF + ELSE + IF ((KEEP(221).EQ.1).AND.(NB_RHSSKIPPED.GT.0)) THEN + DO K = JBEG_RHS-NB_RHSSKIPPED, JBEG_RHS-1 + DO I = 1, LD_RHSCOMP + id%RHSCOMP((K-1)*LD_RHSCOMP + I) = ZERO + ENDDO + ENDDO + ENDIF + DO K = 1, NBCOL_INBLOC + KDEC = (K-1) * LD_RHS + IBEG - 1 + RHS_MUMPS(KDEC+1:KDEC+id%N) = ZERO + DO IZ=IRHS_PTR_COPY(K), IRHS_PTR_COPY(K+1)-1 + I=IRHS_SPARSE_COPY(IZ) + IF (POSINRHSCOMP_N(I).NE.0) THEN + RHS_MUMPS(KDEC+I)= RHS_SPARSE_COPY(IZ) + ENDIF + ENDDO + ENDDO + END IF + ENDIF + ENDIF + ELSE IF (I_AM_SLAVE) THEN + IF (KEEP(111).NE.0) THEN + IF (KEEP(111).GT.0) THEN + IBEG_GLOB_DEF = KEEP(111) + IEND_GLOB_DEF = KEEP(111) + ELSE + IBEG_GLOB_DEF = BEG_RHS + IEND_GLOB_DEF = BEG_RHS+NBRHS_EFF-1 + ENDIF + IF ( id%KEEP(112) .GT. 0 .AND. DO_NULL_PIV) THEN + IF (IBEG_GLOB_DEF .GT.id%KEEP(112)) THEN + id%KEEP(235) = 0 + DO_NULL_PIV = .FALSE. + ENDIF + IF (IBEG_GLOB_DEF .LT.id%KEEP(112) + & .AND. IEND_GLOB_DEF .GT.id%KEEP(112) + & .AND. DO_NULL_PIV ) THEN + IEND_GLOB_DEF = id%KEEP(112) + id%KEEP(235) = 1 + DO_NULL_PIV = .FALSE. + ENDIF + ENDIF + IF (id%KEEP(235).NE.0) THEN + NZ_THIS_BLOCK=IEND_GLOB_DEF-IBEG_GLOB_DEF+1 + ALLOCATE(IRHS_PTR_COPY(NZ_THIS_BLOCK+1),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 50 + endif + IRHS_PTR_COPY_ALLOCATED = .TRUE. + ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok) + if (allocok .GT.0 ) then + INFO(1)=-13 + INFO(2)=NZ_THIS_BLOCK + GOTO 50 + endif + IRHS_SPARSE_COPY_ALLOCATED=.TRUE. + NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*(K34_8+K35_8) + & + K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF (id%MYID.eq.MASTER) THEN + II = 1 + DO I = IBEG_GLOB_DEF, IEND_GLOB_DEF + IRHS_PTR_COPY(I-IBEG_GLOB_DEF+1) = I + IF (INTERLEAVE_PAR .AND.(id%NSLAVES .GT. 1) )THEN + IRHS_SPARSE_COPY(II) = PERM_PIV_LIST(I) + ELSE + IRHS_SPARSE_COPY(II) = id%PIVNUL_LIST(I) + ENDIF + II = II +1 + ENDDO + IRHS_PTR_COPY(NZ_THIS_BLOCK+1) = NZ_THIS_BLOCK+1 + ENDIF + 50 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1) .LT.0 ) GOTO 90 + CALL MPI_BCAST(IRHS_SPARSE_COPY(1), + & NZ_THIS_BLOCK, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + CALL MPI_BCAST(IRHS_PTR_COPY(1), + & NZ_THIS_BLOCK+1, + & MPI_INTEGER, + & MASTER, id%COMM,IERR) + RHS_MUMPS( IBEG : + & (IBEG + (NBRHS_EFF)*LD_RHS -1) ) = ZERO + ENDIF + DO K=1, NBRHS_EFF + KDEC = (K-1) *LD_RHSCOMP + id%RHSCOMP(KDEC+1:KDEC+LD_RHSCOMP)=ZERO + END DO + IF ((KEEP(235).NE.0).AND. INTERLEAVE_PAR) THEN + DO I=IBEG_GLOB_DEF,IEND_GLOB_DEF + IF (id%MYID_NODES .EQ. MAP_PIVNUL_LIST(I) ) THEN + JJ= POSINRHSCOMP_N(PERM_PIV_LIST(I)) + IF (JJ.GT.LD_RHSCOMP) THEN + WRITE(6,*) ' Internal ERROR JJ, LD_RHSCOMP=', + & JJ, LD_RHSCOMP + ENDIF + IF (JJ.GT.0) THEN + IF (KEEP(50).EQ.0) THEN + id%RHSCOMP(IBEG_RHSCOMP -1+ + & (I-IBEG_GLOB_DEF)*LD_RHSCOMP + JJ) = + & cmplx(abs(id%DKEEP(2)),kind=kind(id%RHSCOMP)) + ELSE + id%RHSCOMP(IBEG_RHSCOMP -1+ + & (I-IBEG_GLOB_DEF)*LD_RHSCOMP + JJ) = ONE + ENDIF + ENDIF + ENDIF + ENDDO + ELSE + DO I=max(IBEG_GLOB_DEF,KEEP(220)), + & min(IEND_GLOB_DEF,KEEP(220)+KEEP(109)-1) + JJ= POSINRHSCOMP_N(id%PIVNUL_LIST(I-KEEP(220)+1)) + IF (JJ.GT.0) THEN + IF (KEEP(50).EQ.0) THEN + id%RHSCOMP(IBEG_RHSCOMP-1+(I-IBEG_GLOB_DEF)*LD_RHSCOMP + & + JJ) = cmplx(id%DKEEP(2),kind=kind(id%RHSCOMP)) + ELSE + id%RHSCOMP(IBEG_RHSCOMP-1+(I-IBEG_GLOB_DEF)*LD_RHSCOMP + & + JJ) = ONE + ENDIF + ENDIF + ENDDO + ENDIF + IF ( KEEP(17).NE.0 .and. id%MYID_NODES.EQ.MASTER_ROOT) THEN + IBEG_ROOT_DEF = max(IBEG_GLOB_DEF,KEEP(112)+1) + IEND_ROOT_DEF = min(IEND_GLOB_DEF,KEEP(112)+KEEP(17)) + IROOT_DEF_RHS_COL1 = IBEG_ROOT_DEF-IBEG_GLOB_DEF + 1 + IBEG_ROOT_DEF = IBEG_ROOT_DEF-KEEP(112) + IEND_ROOT_DEF = IEND_ROOT_DEF-KEEP(112) + ELSE + IBEG_ROOT_DEF = -90999 + IEND_ROOT_DEF = -90999 + ENDIF + ELSE + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + LWCB_SOL_C = LWCB + IF ( id%MYID_NODES .EQ. MASTER_ROOT ) THEN + IF ( associated(id%root%RHS_CNTR_MASTER_ROOT) ) THEN + PTR_RHS_ROOT => id%root%RHS_CNTR_MASTER_ROOT + LPTR_RHS_ROOT = size(id%root%RHS_CNTR_MASTER_ROOT) + ELSE + LPTR_RHS_ROOT = NBRHS_EFF * SIZE_ROOT + IPT_RHS_ROOT = LWCB - LPTR_RHS_ROOT + 1 + PTR_RHS_ROOT => WORK_WCB(IPT_RHS_ROOT:LWCB) + LWCB_SOL_C = LWCB_SOL_C - LPTR_RHS_ROOT + ENDIF + ELSE + LPTR_RHS_ROOT = 1 + IPT_RHS_ROOT = LWCB + PTR_RHS_ROOT => WORK_WCB(IPT_RHS_ROOT:LWCB) + LWCB_SOL_C = LWCB_SOL_C - LPTR_RHS_ROOT + ENDIF + ENDIF + IF (KEEP(221) .EQ. 2 ) THEN + IF ( ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) .AND. + & ( id%MYID .EQ. MASTER ) ) THEN + II = 0 + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS -1 + DO I = 1, SIZE_ROOT + PTR_RHS_ROOT(II+I) = id%REDRHS(KDEC+I) + ENDDO + II = II+SIZE_ROOT + ENDDO + ELSE + IF ( id%MYID .EQ. MASTER) THEN + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + KDEC = IBEG_REDRHS + CALL MPI_SEND(id%REDRHS(KDEC), + & SIZE_ROOT*NBRHS_EFF, + & MPI_DOUBLE_COMPLEX, + & MASTER_ROOT_IN_COMM, 0, id%COMM,IERR) + ELSE + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS + CALL MPI_SEND(id%REDRHS(KDEC),SIZE_ROOT, + & MPI_DOUBLE_COMPLEX, + & MASTER_ROOT_IN_COMM, 0, id%COMM,IERR) + ENDDO + ENDIF + ELSE IF ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) THEN + II = 1 + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + CALL MPI_RECV(PTR_RHS_ROOT(II), + & SIZE_ROOT*NBRHS_EFF, + & MPI_DOUBLE_COMPLEX, + & MASTER, 0, id%COMM,STATUS,IERR) + ELSE + DO K=1, NBRHS_EFF + CALL MPI_RECV(PTR_RHS_ROOT(II),SIZE_ROOT, + & MPI_DOUBLE_COMPLEX, + & MASTER, 0, id%COMM,STATUS,IERR) + II = II + SIZE_ROOT + ENDDO + ENDIF + ENDIF + ENDIF + ENDIF + IF ( I_AM_SLAVE ) THEN + LIW_PASSED = max( LIW, 1 ) + LA_PASSED = max( LA, 1_8 ) + IF ((id%KEEP(235).EQ.0).and.(id%KEEP(237).EQ.0) ) THEN + PRUNED_SIZE_LOADED = 0_8 + CALL ZMUMPS_245(id%root, id%N, id%S(1), LA_PASSED, + & IS(1), LIW_PASSED, WORK_WCB(1), LWCB_SOL_C, + & IWCB, LIWCB, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%NA(1),id%LNA,id%NE_STEPS(1), SRW3, MTYPE, + & ICNTL(1), id%STEP(1), id%FRERE_STEPS(1), + & id%DAD_STEPS(1), id%FILS(1), id%PTLUST_S(1), id%PTRFAC(1), + & IWK_SOLVE, LIWK_SOLVE, id%PROCNODE_STEPS(1), + & id%NSLAVES, INFO(1), KEEP(1), KEEP8(1), + & id%COMM_NODES, id%MYID, id%MYID_NODES, + & id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & IBEG_ROOT_DEF, IEND_ROOT_DEF, + & IROOT_DEF_RHS_COL1, + & PTR_RHS_ROOT(1), LPTR_RHS_ROOT, SIZE_ROOT, MASTER_ROOT, + & id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP, + & id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP + & , 1 , 1 , 1 + & , 1 + & , IDUMMY, 1, JDUMMY, KDUMMY, 1, LDUMMY, 1, MDUMMY + & ) + ELSE + IF ((KEEP(235).NE.0).AND.KEEP(221).NE.2.AND. + & KEEP(111).EQ.0) THEN + DO K=1, NBRHS_EFF + DO I=1, LD_RHSCOMP + id%RHSCOMP(IBEG_RHSCOMP+(K-1)*LD_RHSCOMP+I-1)= ZERO + ENDDO + ENDDO + ELSEIF (KEEP(237).NE.0) THEN + DO K=1, NBRHS_EFF + DO I=1, LD_RHSCOMP + id%RHSCOMP(IBEG_RHSCOMP+(K-1)*LD_RHSCOMP+I-1)= ZERO + ENDDO + ENDDO + ENDIF + IF (.NOT. allocated(PERM_RHS)) THEN + ALLOCATE(PERM_RHS(1),stat=allocok) + NB_BYTES = NB_BYTES + int(size(PERM_RHS),8)*K34_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + ENDIF + CALL ZMUMPS_245(id%root, id%N, id%S(1), LA_PASSED, + & IS(1), LIW_PASSED, WORK_WCB(1), LWCB_SOL_C, IWCB, LIWCB, + & RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, id%NA(1),id%LNA, + & id%NE_STEPS(1), SRW3, MTYPE, ICNTL(1), id%STEP(1), + & id%FRERE_STEPS(1), id%DAD_STEPS(1), id%FILS(1), + & id%PTLUST_S(1), id%PTRFAC(1), IWK_SOLVE, LIWK_SOLVE, + & id%PROCNODE_STEPS(1), id%NSLAVES, INFO(1),KEEP(1),KEEP8(1), + & id%COMM_NODES, id%MYID, id%MYID_NODES, + & id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1, + & PTR_RHS_ROOT(1), LPTR_RHS_ROOT, SIZE_ROOT, MASTER_ROOT, + & id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP, + & id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP, + & NZ_THIS_BLOCK, NBCOL_INBLOC, id%NRHS, + & JBEG_RHS , id%Step2node(1), id%KEEP(28), IRHS_SPARSE_COPY(1), + & IRHS_PTR_COPY(1), + & size(PERM_RHS), PERM_RHS, size(UNS_PERM_INV), UNS_PERM_INV + & ) + ENDIF + END IF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1).eq.-2) then + INFO(1)=-11 + IF (LP.GT.0) + & write(LP,*) + & ' WARNING : -11 error code obtained in solve' + END IF + IF (INFO(1).eq.-3) then + INFO(1)=-14 + IF (LP.GT.0) + & write(LP,*) + & ' WARNING : -14 error code obtained in solve' + END IF + IF (INFO(1).LT.0) GO TO 90 + IF ( KEEP(221) .EQ. 1 ) THEN + IF ( ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) .AND. + & ( id%MYID .EQ. MASTER ) ) THEN + II = 0 + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS -1 + DO I = 1, SIZE_ROOT + id%REDRHS(KDEC+I) = PTR_RHS_ROOT(II+I) + ENDDO + II = II+SIZE_ROOT + ENDDO + ELSE + IF ( id%MYID .EQ. MASTER ) THEN + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + KDEC = IBEG_REDRHS + CALL MPI_RECV(id%REDRHS(KDEC), + & SIZE_ROOT*NBRHS_EFF, + & MPI_DOUBLE_COMPLEX, + & MASTER_ROOT_IN_COMM, 0, id%COMM, + & STATUS,IERR) + ELSE + DO K=1, NBRHS_EFF + KDEC = IBEG_REDRHS+(K-1)*LD_REDRHS + CALL MPI_RECV(id%REDRHS(KDEC),SIZE_ROOT, + & MPI_DOUBLE_COMPLEX, + & MASTER_ROOT_IN_COMM, 0, id%COMM, + & STATUS,IERR) + ENDDO + ENDIF + ELSE IF ( id%MYID .EQ. MASTER_ROOT_IN_COMM ) THEN + II = 1 + IF (LD_REDRHS.EQ.SIZE_ROOT) THEN + CALL MPI_SEND(PTR_RHS_ROOT(II), + & SIZE_ROOT*NBRHS_EFF, + & MPI_DOUBLE_COMPLEX, + & MASTER, 0, id%COMM,IERR) + ELSE + DO K=1, NBRHS_EFF + CALL MPI_SEND(PTR_RHS_ROOT(II),SIZE_ROOT, + & MPI_DOUBLE_COMPLEX, + & MASTER, 0, id%COMM,IERR) + II = II + SIZE_ROOT + ENDDO + ENDIF + ENDIF + ENDIF + ENDIF + IF ( KEEP(221) .NE. 1 ) THEN + IF (ICNTL21 == 0) THEN + IF ((.NOT. I_AM_SLAVE).AND.KEEP(237).EQ.0) THEN + ALLOCATE( CWORK(KEEP(247)*NBRHS_EFF), stat=allocok) + IF (allocok > 0) THEN + ALLOCATE( CWORK(KEEP(247)), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=KEEP(247) + ENDIF + ENDIF + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1).LT.0) GO TO 90 + IF ((id%MYID.NE.MASTER).OR. .NOT.LSCAL) THEN + PT_SCALING => Dummy_SCAL + ELSE + IF (MTYPE.EQ.1) THEN + PT_SCALING => id%COLSCA + ELSE + PT_SCALING => id%ROWSCA + ENDIF + ENDIF + LIW_PASSED = max( LIW, 1 ) + IF ( .NOT.I_AM_SLAVE ) THEN + IF (KEEP(237).EQ.0) THEN + CALL ZMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & JDUMMY, id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), IDUMMY, 1, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & CWORK(1), size(CWORK), + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & ) + DEALLOCATE( CWORK ) + ELSE + CALL ZMUMPS_812(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%KEEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & ,IRHS_PTR_COPY(1), size(IRHS_PTR_COPY), + & IRHS_SPARSE_COPY(1), size(IRHS_SPARSE_COPY), + & RHS_SPARSE_COPY(1), size(RHS_SPARSE_COPY), + & UNS_PERM_INV, size(UNS_PERM_INV), IDUMMY, 1 + & ) + ENDIF + ELSE + IF (KEEP(237).EQ.0) THEN + CALL ZMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), IS(1), LIW_PASSED, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%RHSCOMP(1), LENRHSCOMP, + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & ) + ELSE + CALL ZMUMPS_812(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%KEEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & LSCAL, PT_SCALING(1), size(PT_SCALING) + & , IRHS_PTR_COPY(1), size(IRHS_PTR_COPY), + & IRHS_SPARSE_COPY(1), size(IRHS_SPARSE_COPY), + & RHS_SPARSE_COPY(1), size(RHS_SPARSE_COPY), + & UNS_PERM_INV, size(UNS_PERM_INV), POSINRHSCOMP_N, + & id%N + & ) + ENDIF + ENDIF + IF ( (id%MYID.EQ.MASTER).AND. (KEEP(237).NE.0) + & ) THEN + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + DO J = JBEG_RHS, JBEG_RHS+NBCOL_INBLOC-1 + COLSIZE = id%IRHS_PTR(PERM_RHS(J)+1) - + & id%IRHS_PTR(PERM_RHS(J)) + IF (COLSIZE.EQ.0) CYCLE + JJ = J-JBEG_RHS+1 + DO IZ= id%IRHS_PTR(PERM_RHS(J)), + & id%IRHS_PTR(PERM_RHS(J)+1)-1 + I = id%IRHS_SPARSE (IZ) + DO IZ2 = IRHS_PTR_COPY(JJ),IRHS_PTR_COPY(JJ+1)-1 + IF (IRHS_SPARSE_COPY(IZ2).EQ.I) EXIT + IF (IZ2.EQ.IRHS_PTR_COPY(JJ+1)-1) THEN + WRITE(6,*) " INTERNAL ERROR 1 gather sol_driver" + CALL MUMPS_ABORT() + ENDIF + ENDDO + id%RHS_SPARSE(IZ) = RHS_SPARSE_COPY(IZ2) + ENDDO + ENDDO + ELSE + DO J = JBEG_RHS, JBEG_RHS+NBCOL_INBLOC-1 + COLSIZE = id%IRHS_PTR(J+1) - id%IRHS_PTR(J) + IF (COLSIZE.EQ.0) CYCLE + JJ = J-JBEG_RHS+1 + DO IZ= id%IRHS_PTR(J), id%IRHS_PTR(J+1) - 1 + I = id%IRHS_SPARSE (IZ) + DO IZ2 = IRHS_PTR_COPY(JJ),IRHS_PTR_COPY(JJ+1)-1 + IF (IRHS_SPARSE_COPY(IZ2).EQ.I) EXIT + IF (IZ2.EQ.IRHS_PTR_COPY(JJ+1)-1) THEN + WRITE(6,*) " INTERNAL ERROR 2 gather sol_driver" + CALL MUMPS_ABORT() + ENDIF + ENDDO + id%RHS_SPARSE(IZ) = RHS_SPARSE_COPY(IZ2) + ENDDO + ENDDO + ENDIF + ENDIF + ELSE + IF ( I_AM_SLAVE ) THEN + LIW_PASSED = max( LIW, 1 ) + IF ( KEEP(89) .GT. 0 ) THEN + CALL ZMUMPS_532(id%NSLAVES, + & id%N, id%MYID_NODES, + & MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF, + & id%ISOL_loc(1), + & id%SOL_loc(1), JBEG_RHS-NB_RHSSKIPPED, id%LSOL_loc, + & id%PTLUST_S(1), id%PROCNODE_STEPS(1), + & id%KEEP(1),id%KEEP8(1), + & IS(1), LIW_PASSED, + & id%STEP(1), scaling_data, LSCAL, NB_RHSSKIPPED ) + ENDIF + ENDIF + ENDIF + ENDIF + IF ( ICNTL10 > 0 .AND. NBRHS_EFF > 1 ) THEN + DO I = 1, ICNTL10 + write(*,*) 'FIXME: to be implemented' + END DO + END IF + IF (ERANAL) THEN + IF ((ICNTL10 .GT. 0) .AND. (ICNTL11 .GT. 0)) THEN + IF (id%MYID .EQ. MASTER) THEN + GIVSOL = .FALSE. + IF (MP .GT. 0) WRITE( MP, 170 ) + ALLOCATE(R_RW1(id%N),stat=allocok) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 776 + ENDIF + ALLOCATE(C_RW2(id%N),stat=allocok) + IF (allocok .GT.0) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 776 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + int(id%N,8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + END IF + 776 CONTINUE + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + IF ( KEEP(54) .eq. 0 ) THEN + IF (id%MYID .EQ. MASTER) THEN + IF (KEEP(55).EQ.0) THEN + CALL ZMUMPS_278( ICNTL(9), id%N, id%NZ, id%A(1), + & id%IRN(1), id%JCN(1), + & RHS_MUMPS(IBEG), SAVERHS, R_RW1, C_RW2, + & KEEP(1),KEEP8(1) ) + ELSE + CALL ZMUMPS_121( ICNTL(9), id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & RHS_MUMPS(IBEG), SAVERHS, R_RW1, C_RW2, + & KEEP(1),KEEP8(1) ) + ENDIF + END IF + ELSE + CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N, + & MPI_DOUBLE_COMPLEX, MASTER, + & id%COMM, IERR ) + ALLOCATE( C_LOCWK54( id%N ), stat =allocok ) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + endif + CALL MUMPS_276(ICNTL(1), INFO(1), id%COMM, id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL ZMUMPS_192( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE ) + ELSE + C_LOCWK54 = ZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( C_LOCWK54, C_RW2, + & id%N, MPI_DOUBLE_COMPLEX, + & MPI_SUM,MASTER,id%COMM, IERR) + C_RW2 = SAVERHS - C_RW2 + ELSE + CALL MPI_REDUCE( C_LOCWK54, C_DUMMY, + & id%N, MPI_DOUBLE_COMPLEX, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + NB_BYTES = NB_BYTES - int(size(C_LOCWK54),8)*K35_8 + DEALLOCATE( C_LOCWK54 ) + ALLOCATE( R_LOCWK54( id%N ), stat =allocok ) + if (allocok .GT.0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + endif + CALL MUMPS_276(ICNTL(1), INFO(1), id%COMM, id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + IF ( I_AM_SLAVE .AND. id%NZ_loc .NE. 0 ) THEN + CALL ZMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1)) + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_RW1, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + NB_BYTES = NB_BYTES - int(size(R_LOCWK54),8)*K16_8 + DEALLOCATE( R_LOCWK54 ) + END IF + IF ( id%MYID .EQ. MASTER ) THEN + CALL ZMUMPS_205(ICNTL(9),INFO(1),id%N,id%NZ, + & RHS_MUMPS(IBEG), SAVERHS,R_RW1,C_RW2,GIVSOL, + & RSOL,RINFOG(4),RINFOG(5),RINFOG(6),MP,ICNTL(1), + & KEEP(1),KEEP8(1)) + NB_BYTES = NB_BYTES - int(size(R_RW1),8)*K16_8 + & - int(size(C_RW2),8)*K35_8 + DEALLOCATE(R_RW1) + DEALLOCATE(C_RW2) + END IF + END IF + IF ( PROK .AND. ICNTL10 .GT. 0 ) WRITE( MP, 270 ) + IF ( PROKG .AND. ICNTL10 .GT. 0 ) WRITE( MPG, 270 ) + ALLOCATE(R_Y(id%N), stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + ALLOCATE(C_Y(id%N), stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + IF ( id%MYID .EQ. MASTER ) THEN + ALLOCATE( IW1( 2 * id%N ),stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=2 * id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(2*id%N,8)*K34_8 + ALLOCATE( D(id%N),stat =allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + ALLOCATE( C_W(id%N), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + ALLOCATE( R_W(2*id%N), stat = allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(2*id%N,8)*K16_8 + NITREF = ICNTL10 + JOBIREF= ICNTL11 + IF ( PROKG .AND. ICNTL10 .GT. 0 ) + & WRITE( MPG, 240) 'MAXIMUM NUMBER OF STEPS =', NITREF + DO I = 1, id%N + D( I ) = RONE + END DO + END IF + ALLOCATE(C_LOCWK54(id%N),stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K35_8 + ALLOCATE(R_LOCWK54(id%N),stat = allocok) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + GOTO 777 + ENDIF + NB_BYTES = NB_BYTES + int(id%N,8)*K16_8 + KASE = 0 + 777 CONTINUE + NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES) + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF ( INFO(1) .LT. 0 ) GOTO 90 + 22 CONTINUE + IF ( KEEP(54) .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + IF ( KASE .eq. 0 ) THEN + IF (KEEP(55).NE.0) THEN + CALL ZMUMPS_119(MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & R_W(id%N+1), KEEP(1),KEEP8(1) ) + ELSE + IF ( MTYPE .eq. 1 ) THEN + CALL ZMUMPS_207 + & ( id%A(1), id%NZ, id%N, id%IRN(1), id%JCN(1), + & R_W(id%N+1), KEEP(1),KEEP8(1)) + ELSE + CALL ZMUMPS_207 + & ( id%A(1), id%NZ, id%N, id%JCN(1), id%IRN(1), + & R_W(id%N+1), KEEP(1),KEEP8(1)) + END IF + ENDIF + ENDIF + END IF + ELSE + IF ( KASE .eq. 0 ) THEN + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + CALL ZMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1) ) + ELSE + CALL ZMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%JCN_loc(1), id%IRN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1) ) + END IF + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_W( id%N + 1 ), + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + END IF + END IF + IF ( id%MYID .eq. MASTER ) THEN + ARRET = CNTL(2) + IF (ARRET .LT. 0.0D0) THEN + ARRET = sqrt(epsilon(0.0D0)) + END IF + CALL ZMUMPS_206(id%NZ,id%N,SAVERHS,RHS_MUMPS(IBEG), + & C_Y, D, R_W, C_W, + & IW1, KASE,RINFOG(7), + & RINFOG(9), JOBIREF, RINFOG(10), NITREF, NOITER, MP, + & KEEP(1),KEEP8(1), ARRET ) + END IF + IF ( KEEP(54) .ne. 0 ) THEN + CALL MPI_BCAST( KASE, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR ) + END IF + IF ( KEEP(54) .eq. 0 ) THEN + IF ( id%MYID .eq. MASTER ) THEN + IF ( KASE .eq. 14 ) THEN + IF (KEEP(55).NE.0) THEN + CALL ZMUMPS_122( MTYPE, id%N, + & id%NELT, id%ELTPTR(1), id%LELTVAR, + & id%ELTVAR(1), id%NA_ELT, id%A_ELT(1), + & SAVERHS, RHS_MUMPS(IBEG), + & C_Y, R_W, KEEP(50)) + ELSE + IF ( MTYPE .eq. 1 ) THEN + CALL ZMUMPS_208 + & (id%A(1), id%NZ, id%N, id%IRN(1), id%JCN(1), SAVERHS, + & RHS_MUMPS(IBEG), C_Y, R_W, KEEP(1),KEEP8(1)) + ELSE + CALL ZMUMPS_208 + & (id%A(1), id%NZ, id%N, id%JCN(1), id%IRN(1), SAVERHS, + & RHS_MUMPS(IBEG), C_Y, R_W, KEEP(1),KEEP8(1)) + END IF + ENDIF + GOTO 22 + END IF + END IF + ELSE + IF ( KASE.eq.14 ) THEN + CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N, + & MPI_DOUBLE_COMPLEX, MASTER, + & id%COMM, IERR ) + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL ZMUMPS_192( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE ) + ELSE + C_LOCWK54 = ZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( C_LOCWK54, C_Y, + & id%N, MPI_DOUBLE_COMPLEX, + & MPI_SUM,MASTER,id%COMM, IERR) + C_Y = SAVERHS - C_Y + ELSE + CALL MPI_REDUCE( C_LOCWK54, C_DUMMY, + & id%N, MPI_DOUBLE_COMPLEX, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + IF ( I_AM_SLAVE .and. id%NZ_loc .NE. 0 ) THEN + CALL ZMUMPS_193( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), R_LOCWK54, KEEP(50), MTYPE ) + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_W, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM, MASTER, id%COMM, IERR) + END IF + GOTO 22 + END IF + END IF + IF ( id%MYID .eq. MASTER ) THEN + IF ( KASE .GT. 0 ) THEN + IF ( MTYPE .EQ. 1 ) THEN + SOLVET = KASE - 1 + ELSE + SOLVET = KASE + END IF + IF ( LSCAL ) THEN + IF ( SOLVET .EQ. 1 ) THEN + DO K = 1, id%N + C_Y( K ) = C_Y( K ) * id%ROWSCA( K ) + END DO + ELSE + DO K = 1, id%N + C_Y( K ) = C_Y( K ) * id%COLSCA( K ) + END DO + END IF + END IF + END IF + END IF + CALL MPI_BCAST( KASE , 1, MPI_INTEGER, MASTER, + & id%COMM, IERR) + CALL MPI_BCAST( SOLVET, 1, MPI_INTEGER, MASTER, + & id%COMM, IERR) + IF ( KASE .GT. 0 ) THEN + BUILD_POSINRHSCOMP=.FALSE. + IF ( .NOT.I_AM_SLAVE ) THEN + CALL ZMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, C_Y(1), id%N, 1, + & JDUMMY, id%KEEP(1), id%KEEP8(1), id%PROCNODE_STEPS(1), + & IDUMMY, 1, + & id%STEP(1), KDUMMY, 1, BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + ELSE + LIW_PASSED = max( LIW, 1 ) + CALL ZMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM, + & MTYPE, C_Y(1), id%N, 1, + & id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1), + & id%PROCNODE_STEPS(1), + & IS(1), LIW_PASSED, + & id%STEP(1), id%POSINRHSCOMP(1), KEEP(28), + & BUILD_POSINRHSCOMP, + & id%ICNTL(1),id%INFO(1)) + ENDIF + IF (INFO(1).LT.0) GOTO 89 + IF ( I_AM_SLAVE ) THEN + LIW_PASSED = max( LIW, 1 ) + LA_PASSED = max( LA, 1_8 ) + CALL ZMUMPS_245( id%root, id%N, id%S(1), LA_PASSED, + & id%IS(1), LIW_PASSED, WORK_WCB(1), LWCB_SOL_C, IWCB, LIWCB, C_Y, + & id%N, NBRHS_EFF, id%NA(1), id%LNA, id%NE_STEPS(1), SRW3, SOLVET, + & ICNTL(1), id%STEP(1), id%FRERE_STEPS(1), id%DAD_STEPS(1), id% + & FILS(1), id%PTLUST_S(1), id%PTRFAC(1), IWK_SOLVE(1), LIWK_SOLVE, + & id%PROCNODE_STEPS(1), id%NSLAVES, INFO(1), KEEP(1), KEEP8(1), + & id%COMM_NODES, id%MYID, id%MYID_NODES, id%BUFR(1), id%LBUFR, + & id%LBUFR_BYTES, id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1), + & IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1, + & PTR_RHS_ROOT(1), LPTR_RHS_ROOT, SIZE_ROOT, MASTER_ROOT, + & id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP, + & id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP + & , 1 , 1 , 1 + & , 1 + & , IDUMMY, 1, JDUMMY, KDUMMY, 1, LDUMMY, 1, MDUMMY + & ) + END IF + IF (INFO(1).eq.-2) INFO(1)=-12 + IF (INFO(1).eq.-3) INFO(1)=-15 + IF ( .NOT. I_AM_SLAVE .AND. INFO(1) .GE. 0) THEN + ALLOCATE( CWORK(KEEP(247)*NBRHS_EFF), stat=allocok) + IF (allocok > 0) THEN + ALLOCATE( CWORK(KEEP(247)), stat=allocok) + IF (allocok > 0) THEN + INFO(1)=-13 + INFO(2)=KEEP(247) + ENDIF + ENDIF + ENDIF + 89 CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + IF (INFO(1).LT.0) GO TO 90 + IF ((id%MYID.NE.MASTER).OR. .NOT.LSCAL) THEN + PT_SCALING => Dummy_SCAL + ELSE + IF (SOLVET.EQ.1) THEN + PT_SCALING => id%COLSCA + ELSE + PT_SCALING => id%ROWSCA + ENDIF + ENDIF + LIW_PASSED = max( LIW, 1 ) + IF ( .NOT. I_AM_SLAVE ) THEN + CALL ZMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & SOLVET, C_Y, id%N, NBRHS_EFF, + & JDUMMY, id%KEEP(1),id%KEEP8(1), id%PROCNODE_STEPS(1), + & IDUMMY, 1, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & CWORK, size(CWORK), + & LSCAL, PT_SCALING(1), size(PT_SCALING)) + DEALLOCATE( CWORK ) + ELSE + CALL ZMUMPS_521(id%NSLAVES,id%N, + & id%MYID, id%COMM, + & SOLVET, C_Y, id%N, NBRHS_EFF, + & id%PTLUST_S(1), id%KEEP(1),id%KEEP8(1), + & id%PROCNODE_STEPS(1), + & IS(1), LIW_PASSED, + & id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES, + & id%RHSCOMP(1), LENRHSCOMP, + & LSCAL, PT_SCALING(1), size(PT_SCALING)) + ENDIF + GO TO 22 + ELSEIF ( KASE .LT. 0 ) THEN + INFO( 1 ) = INFO( 1 ) + 8 + END IF + IF ( id%MYID .eq. MASTER ) THEN + NB_BYTES = NB_BYTES - int(size(R_W),8)*K16_8 + & - int(size(D ),8)*K16_8 + & - int(size(IW1),8)*K34_8 + DEALLOCATE(R_W,D) + DEALLOCATE(IW1) + ENDIF + IF ( PROKG ) THEN + IF (NITREF.GT.0) THEN + WRITE( MPG, 81 ) + WRITE( MPG, 141 ) 'NUMBER OF STEPS OF ITERATIVE REFINEMENTS + &=', NOITER + ENDIF + ENDIF + IF ( id%MYID .EQ. MASTER ) THEN + IF ( NITREF .GT. 0 ) THEN + id%INFOG(15) = NOITER + END IF + END IF + IF ( PROK .AND. ICNTL10 .GT.0 ) WRITE( MP, 131 ) + IF (ICNTL11 .GT. 0) THEN + IF ( KEEP(54) .eq. 0 ) THEN + IF (id%MYID .EQ. MASTER) THEN + IF (KEEP(55).EQ.0) THEN + CALL ZMUMPS_278( MTYPE, id%N, id%NZ, id%A(1), + & id%IRN(1), id%JCN(1), + & RHS_MUMPS(IBEG), SAVERHS, R_Y, C_W, KEEP(1),KEEP8(1)) + ELSE + CALL ZMUMPS_121( MTYPE, id%N, + & id%NELT, id%ELTPTR(1), + & id%LELTVAR, id%ELTVAR(1), + & id%NA_ELT, id%A_ELT(1), + & RHS_MUMPS(IBEG), SAVERHS, R_Y, C_W, KEEP(1),KEEP8(1)) + ENDIF + END IF + ELSE + CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N, + & MPI_DOUBLE_COMPLEX, MASTER, + & id%COMM, IERR ) + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL ZMUMPS_192( id%N, id%NZ_loc, + & id%IRN_loc(1), id%JCN_loc(1), id%A_loc(1), + & RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE ) + ELSE + C_LOCWK54 = ZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( C_LOCWK54, C_W, + & id%N, MPI_DOUBLE_COMPLEX, + & MPI_SUM,MASTER,id%COMM, IERR) + C_W = SAVERHS - C_W + ELSE + CALL MPI_REDUCE( C_LOCWK54, C_DUMMY, + & id%N, MPI_DOUBLE_COMPLEX, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + IF ( I_AM_SLAVE .and. + & id%NZ_loc .NE. 0 ) THEN + CALL ZMUMPS_207(id%A_loc(1), + & id%NZ_loc, id%N, + & id%IRN_loc(1), id%JCN_loc(1), + & R_LOCWK54, id%KEEP(1),id%KEEP8(1) ) + ELSE + R_LOCWK54 = RZERO + END IF + IF ( id%MYID .eq. MASTER ) THEN + CALL MPI_REDUCE( R_LOCWK54, R_Y, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + ELSE + CALL MPI_REDUCE( R_LOCWK54, R_DUMMY, + & id%N, MPI_DOUBLE_PRECISION, + & MPI_SUM,MASTER,id%COMM, IERR) + END IF + END IF + IF (id%MYID .EQ. MASTER) THEN + IF ((MPG .GT. 0) .AND. (NITREF .GT. 0)) WRITE( MPG, 65 ) + IF ((MPG .GT. 0) .AND. (NITREF .LE. 0)) WRITE( MPG, 170 ) + GIVSOL = .FALSE. + CALL ZMUMPS_205(MTYPE,INFO(1),id%N,id%NZ,RHS_MUMPS(IBEG), + & SAVERHS,R_Y,C_W,GIVSOL, + & RSOL,RINFOG(4),RINFOG(5),RINFOG(6),MPG,ICNTL(1), + & KEEP(1),KEEP8(1)) + IF ( MPG .GT. 0 ) THEN + WRITE( MPG, 115 ) + &'RINFOG(7):COMPONENTWISE SCALED RESIDUAL(W1)=', RINFOG(7) + WRITE( MPG, 115 ) + &'------(8):---------------------------- (W2)=', RINFOG(8) + WRITE( MPG, 115 ) + &'------(9):Upper bound ERROR ...............=', RINFOG(9) + WRITE( MPG, 115 ) + &'-----(10):CONDITION NUMBER (1) ............=', RINFOG(10) + WRITE( MPG, 115 ) + &'-----(11):CONDITION NUMBER (2) ............=', RINFOG(11) + END IF + END IF + END IF + IF (id%MYID == MASTER) THEN + NB_BYTES = NB_BYTES - int(size(C_W),8)*K35_8 + DEALLOCATE(C_W) + ENDIF + NB_BYTES = NB_BYTES - + & (int(size(R_Y),8)+int(size(R_LOCWK54),8))*K16_8 + NB_BYTES = NB_BYTES - + & (int(size(C_Y),8)+int(size(C_LOCWK54),8))*K35_8 + DEALLOCATE(R_Y) + DEALLOCATE(C_Y) + DEALLOCATE(R_LOCWK54) + DEALLOCATE(C_LOCWK54) + END IF + IF ( id%MYID .EQ. MASTER .AND. ICNTL21==0 + & .AND. KEEP(23) .NE. 0 .AND. KEEP(237).EQ.0 ) THEN + IF ((KEEP(221).NE.1 .AND. ICNTL(9) .EQ. 1) + & .OR. KEEP(111) .NE.0 .OR. KEEP(252).NE.0 ) THEN + ALLOCATE( C_RW1( id%N ),stat =allocok ) + IF ( allocok .GT. 0 ) THEN + INFO(1)=-13 + INFO(2)=id%N + WRITE(*,*) 'could not allocate ', id%N, 'integers.' + CALL MUMPS_ABORT() + END IF + DO K = 1, NBRHS_EFF + KDEC = (K-1)*LD_RHS+IBEG-1 + DO 70 I = 1, id%N + C_RW1(I) = RHS_MUMPS(KDEC+I) + 70 CONTINUE + DO 80 I = 1, id%N + JPERM = id%UNS_PERM(I) + RHS_MUMPS( KDEC+JPERM ) = C_RW1( I ) + 80 CONTINUE + END DO + DEALLOCATE( C_RW1 ) + END IF + END IF + IF (id%MYID.EQ.MASTER .and.ICNTL21==0.and.KEEP(221).NE.1 + & .and. KEEP(237).EQ.0 ) THEN + IF ( INFO(1) .GE. 0 .AND. ICNTL(4).GE.3 .AND. ICNTL(3).GT.0) + & THEN + K = min0(10, id%N) + IF (ICNTL(4) .eq. 4 ) K = id%N + J = min0(10,NBRHS_EFF) + IF (ICNTL(4) .eq. 4 ) J = NBRHS_EFF + DO II=1, J + WRITE(ICNTL(3),110) BEG_RHS+II-1 + WRITE(ICNTL(3),160) + & (RHS_MUMPS(IBEG+(II-1)*LD_RHS+I-1),I=1,K) + ENDDO + END IF + END IF + IF ((KEEP(248).EQ.1).AND.(KEEP(237).EQ.0)) THEN + BEG_RHS = BEG_RHS + NBRHS_EFF + ELSE + BEG_RHS = BEG_RHS + NBRHS + ENDIF + ENDDO + IF ( (id%MYID.EQ.MASTER) + & .AND. ( KEEP(248).NE.0 ) + & .AND. ( KEEP(237).EQ.0 ) + & .AND. ( ICNTL21.EQ.0 ) + & .AND. ( KEEP(221) .NE.1 ) + & .AND. ( JEND_RHS .LT. id%NRHS ) + & ) + & THEN + JBEG_NEW = JEND_RHS + 1 + IF (DO_PERMUTE_RHS.OR.INTERLEAVE_PAR) THEN + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, id%N + RHS_MUMPS((PERM_RHS(JBEG_NEW) -1)*LD_RHS+I) + & = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + CYCLE + ENDDO + ELSE + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, id%N + RHS_MUMPS((JBEG_NEW -1)*LD_RHS + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + ENDIF + IF ( I_AM_SLAVE .AND. (ICNTL21.NE.0) .AND. + & ( JEND_RHS .LT. id%NRHS ) .AND. KEEP(221).NE.1 ) THEN + JBEG_NEW = JEND_RHS + 1 + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, KEEP(89) + id%SOL_loc((JBEG_NEW -1)*id%LSOL_loc + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + IF ((KEEP(221).EQ.1) .AND. + & ( JEND_RHS .LT. id%NRHS ) ) THEN + IF (id%MYID .EQ. MASTER) THEN + JBEG_NEW = JEND_RHS + 1 + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1, id%SIZE_SCHUR + id%REDRHS((JBEG_NEW -1)*LD_REDRHS + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + IF (I_AM_SLAVE) THEN + JBEG_NEW = JEND_RHS + 1 + DO WHILE ( JBEG_NEW.LE. id%NRHS) + DO I=1,LD_RHSCOMP + id%RHSCOMP((JBEG_NEW -1)*LD_RHSCOMP + I) = ZERO + ENDDO + JBEG_NEW = JBEG_NEW +1 + ENDDO + ENDIF + ENDIF + id%INFO(26) = int(NB_BYTES_MAX / 1000000_8, 4) + CALL MUMPS_243( id%MYID, id%COMM, + & id%INFO(26), id%INFOG(30), IRANK ) + IF ( PROKG ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Rank of processor needing largest memory in solve :', + & IRANK + WRITE( MPG,'(A,I10) ') + & ' ** Space in MBYTES used by this processor for solve :', + & id%INFOG(30) + IF ( KEEP(46) .eq. 0 ) THEN + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during solve :', + & ( id%INFOG(31)-id%INFO(26) ) / id%NSLAVES + ELSE + WRITE( MPG,'(A,I10) ') + & ' ** Avg. Space in MBYTES per working proc during solve :', + & id%INFOG(31) / id%NSLAVES + END IF + END IF + 90 CONTINUE + IF (INFO(1) .LT.0 ) THEN + ENDIF + IF (KEEP(201).GT.0)THEN + IF (IS_INIT_OOC_DONE) THEN + CALL ZMUMPS_582(IERR) + IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR + ENDIF + CALL MUMPS_276( ICNTL(1), INFO(1), + & id%COMM,id%MYID) + ENDIF + IF (IRHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_SPARSE_COPY),8)*K34_8 + DEALLOCATE(IRHS_SPARSE_COPY) + IRHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_SPARSE_COPY) + ENDIF + IF (IRHS_PTR_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(IRHS_PTR_COPY),8)*K34_8 + DEALLOCATE(IRHS_PTR_COPY) + IRHS_PTR_COPY_ALLOCATED=.FALSE. + NULLIFY(IRHS_PTR_COPY) + ENDIF + IF (RHS_SPARSE_COPY_ALLOCATED) THEN + NB_BYTES = NB_BYTES - + & int(size(RHS_SPARSE_COPY),8)*K35_8 + DEALLOCATE(RHS_SPARSE_COPY) + RHS_SPARSE_COPY_ALLOCATED=.FALSE. + NULLIFY(RHS_SPARSE_COPY) + ENDIF + IF (allocated(PERM_RHS)) THEN + NB_BYTES = NB_BYTES - int(size(PERM_RHS),8)*K34_8 + DEALLOCATE(PERM_RHS) + ENDIF + IF (allocated(UNS_PERM_INV)) THEN + NB_BYTES = NB_BYTES - int(size(UNS_PERM_INV),8)*K34_8 + DEALLOCATE(UNS_PERM_INV) + ENDIF + IF (associated(id%BUFR)) THEN + NB_BYTES = NB_BYTES - int(size(id%BUFR),8)*K34_8 + DEALLOCATE(id%BUFR) + NULLIFY(id%BUFR) + ENDIF + IF ( I_AM_SLAVE ) THEN + IF (allocated(IWK_SOLVE)) THEN + NB_BYTES = NB_BYTES - int(size(IWK_SOLVE),8)*K34_8 + DEALLOCATE( IWK_SOLVE ) + ENDIF + IF (allocated(IWCB)) THEN + NB_BYTES = NB_BYTES - int(size(IWCB),8)*K34_8 + DEALLOCATE( IWCB ) + ENDIF + CALL ZMUMPS_57( IERR ) + CALL ZMUMPS_59( IERR ) + END IF + IF ( id%MYID .eq. MASTER ) THEN + IF (allocated(SAVERHS)) THEN + NB_BYTES = NB_BYTES - int(size(SAVERHS),8)*K35_8 + DEALLOCATE( SAVERHS) + ENDIF + IF ( + & ( + & ( KEEP(248).ne.0 .OR. KEEP(221).EQ.2 + & .OR. KEEP(111).NE.0 ) + & .and. ICNTL21.ne.0 ) + & .or. + & ( KEEP(237).NE.0 ) + & ) + & THEN + IF ( I_AM_SLAVE ) THEN + IF (associated(RHS_MUMPS) ) THEN + NB_BYTES = NB_BYTES - int(size(RHS_MUMPS),8)*K35_8 + DEALLOCATE(RHS_MUMPS) + ENDIF + ENDIF + ENDIF + NULLIFY(RHS_MUMPS) + ELSE + IF (associated(RHS_MUMPS)) THEN + NB_BYTES = NB_BYTES - int(size(RHS_MUMPS),8)*K35_8 + DEALLOCATE(RHS_MUMPS) + NULLIFY(RHS_MUMPS) + END IF + END IF + IF (I_AM_SLAVE) THEN + IF (allocated(SRW3)) THEN + NB_BYTES = NB_BYTES - int(size(SRW3),8)*K35_8 + DEALLOCATE(SRW3) + ENDIF + IF (allocated(POSINRHSCOMP_N)) THEN + NB_BYTES = NB_BYTES - int(size(POSINRHSCOMP_N),8)*K34_8 + DEALLOCATE(POSINRHSCOMP_N) + ENDIF + IF (LSCAL .AND. ICNTL21==1) THEN + NB_BYTES = NB_BYTES - + & int(size(scaling_data%SCALING_LOC),8)*K16_8 + DEALLOCATE(scaling_data%SCALING_LOC) + NULLIFY(scaling_data%SCALING_LOC) + ENDIF + IF (WK_USER_PROVIDED) THEN + NULLIFY(id%S) + ELSE IF (associated(id%S).AND.KEEP(201).GT.0) THEN + NB_BYTES = NB_BYTES - KEEP8(23)*K35_8 + id%KEEP8(23)=0_8 + DEALLOCATE(id%S) + NULLIFY(id%S) + ENDIF + IF (KEEP(221).NE.1) THEN + IF (associated(id%RHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8 + DEALLOCATE(id%RHSCOMP) + NULLIFY(id%RHSCOMP) + ENDIF + IF (associated(id%POSINRHSCOMP)) THEN + NB_BYTES = NB_BYTES - int(size(id%POSINRHSCOMP),8)*K34_8 + DEALLOCATE(id%POSINRHSCOMP) + NULLIFY(id%POSINRHSCOMP) + ENDIF + ENDIF + IF ( WORK_WCB_ALLOCATED ) THEN + NB_BYTES = NB_BYTES - int(size(WORK_WCB),8)*K35_8 + DEALLOCATE( WORK_WCB ) + ENDIF + NULLIFY( WORK_WCB ) + ENDIF + RETURN + 65 FORMAT (//' ERROR ANALYSIS AFTER ITERATIVE REFINEMENT') + 100 FORMAT(//' ****** SOLVE & CHECK STEP ********'/) + 110 FORMAT (//' VECTOR SOLUTION FOR COLUMN ',I12) + 115 FORMAT(1X, A44,1P,D9.2) + 150 FORMAT (/' STATISTICS PRIOR SOLVE PHASE ...........'/ + & ' NUMBER OF RIGHT-HAND-SIDES =',I12/ + & ' BLOCKING FACTOR FOR MULTIPLE RHS =',I12/ + & ' ICNTL (9) =',I12/ + & ' --- (10) =',I12/ + & ' --- (11) =',I12/ + & ' --- (20) =',I12/ + & ' --- (21) =',I12/ + & ' --- (30) =',I12) + 151 FORMAT (' --- (25) =',I12) + 152 FORMAT (' --- (26) =',I12) + 153 FORMAT (' --- (32) =',I12) + 160 FORMAT (' RHS'/(1X,1P,5D14.6)) + 170 FORMAT (//' ERROR ANALYSIS' ) + 240 FORMAT (1X, A42,I4) + 270 FORMAT (//' BEGIN ITERATIVE REFINEMENT' ) + 81 FORMAT (/' STATISTICS AFTER ITERATIVE REFINEMENT ') + 131 FORMAT (/' END ITERATIVE REFINEMENT ') + 141 FORMAT(1X, A42,I4) + END SUBROUTINE ZMUMPS_301 + SUBROUTINE ZMUMPS_245(root, N, A, LA, IW, LIW, W, LWC, + & IWCB,LIWW,RHS,LRHS,NRHS,NA,LNA,NE_STEPS, W2, + & MTYPE, ICNTL, + & STEP, FRERE, DAD, FILS, PTRIST, PTRFAC, IW1,LIW1, + & PROCNODE_STEPS, SLAVEF, + & INFO, KEEP,KEEP8, COMM_NODES, MYID, + & MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & IBEG_ROOT_DEF, IEND_ROOT_DEF, + & IROOT_DEF_RHS_COL1, PTR_RHS_ROOT, LPTR_RHS_ROOT, + & SIZE_ROOT, MASTER_ROOT, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, BUILD_POSINRHSCOMP + & , NZ_RHS, NBCOL_INBLOC, NRHS_ORIG + & , JBEG_RHS + & , Step2node, LStep2node + & , IRHS_SPARSE + & , IRHS_PTR + & , SIZE_PERM_RHS, PERM_RHS + & , SIZE_UNS_PERM_INV, UNS_PERM_INV + & ) + USE ZMUMPS_OOC + USE MUMPS_SOL_ES + IMPLICIT NONE + INCLUDE 'zmumps_root.h' +#if defined(V_T) + INCLUDE 'VT.inc' +#endif + TYPE ( ZMUMPS_ROOT_STRUC ) :: root + INTEGER(8) :: LA + INTEGER LWC,N,LIW,MTYPE,LIW1,LIWW,LNA + INTEGER ICNTL(40),INFO(40), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER IW(LIW),IW1(LIW1),NA(LNA),NE_STEPS(KEEP(28)),IWCB(LIWW) + INTEGER STEP(N), FRERE(KEEP(28)), FILS(N), PTRIST(KEEP(28)), + & DAD(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER LRHS, NRHS, LRHSCOMP + COMPLEX(kind=8) A(LA), W(LWC), RHS(LRHS,NRHS), + & W2(KEEP(133)), + & RHSCOMP(LRHSCOMP,NRHS) + INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES + INTEGER PROCNODE_STEPS(KEEP(28)), POSINRHSCOMP(KEEP(28)) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR(LBUFR) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1 + INTEGER SIZE_ROOT, MASTER_ROOT + INTEGER LPTR_RHS_ROOT + COMPLEX(kind=8) PTR_RHS_ROOT(LPTR_RHS_ROOT) + LOGICAL BUILD_POSINRHSCOMP + INTEGER MP, LP, LDIAG + INTEGER K,I,II + INTEGER allocok + INTEGER LPOOL,MYLEAF,LPANEL_POS + INTEGER NSTK_S,IPOOL,IPANEL_POS,PTRICB,PTRACB + INTEGER MTYPE_LOC + INTEGER IERR + INTEGER(8) :: IAPOS + INTEGER IOLDPS, + & LOCAL_M, + & LOCAL_N +#if defined(V_T) + INTEGER soln_c_class, forw_soln, back_soln, root_soln +#endif + INTEGER IZERO + LOGICAL DOFORWARD, DOROOT, DOBACKWARD + LOGICAL I_WORKED_ON_ROOT, SPECIAL_ROOT_REACHED + INTEGER IROOT + LOGICAL DOROOT_FWD_OOC, DOROOT_BWD_PANEL + LOGICAL SWITCH_OFF_ES + LOGICAL DUMMY_BOOL + PARAMETER (IZERO = 0 ) + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INCLUDE 'mumps_headers.h' + EXTERNAL ZMUMPS_248, ZMUMPS_249 + INTEGER, intent(in) :: NZ_RHS, NBCOL_INBLOC, NRHS_ORIG + INTEGER, intent(in) :: SIZE_UNS_PERM_INV + INTEGER, intent(in) :: SIZE_PERM_RHS + INTEGER, intent(in) :: JBEG_RHS + INTEGER, intent(in) :: IRHS_SPARSE(NZ_RHS) + INTEGER, intent(in) :: IRHS_PTR(NBCOL_INBLOC+1) + INTEGER, intent(in) :: PERM_RHS(SIZE_PERM_RHS) + INTEGER, intent(in) :: UNS_PERM_INV(SIZE_UNS_PERM_INV) + INTEGER, intent(in) :: LStep2node + INTEGER, intent(in) :: Step2node(LStep2node) + INTEGER, DIMENSION(:), ALLOCATABLE :: nodes_RHS + INTEGER nb_nodes_RHS + INTEGER nb_prun_leaves + INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_Leaves + INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_List + INTEGER nb_prun_nodes + INTEGER nb_prun_roots, JAM1 + INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_SONS, Pruned_Roots + INTEGER, DIMENSION(:), ALLOCATABLE :: prun_NA + INTEGER :: SIZE_TO_PROCESS + LOGICAL, DIMENSION(:), ALLOCATABLE :: TO_PROCESS + INTEGER ISTEP, INODE_PRINC + LOGICAL AM1, DO_PRUN + LOGICAL Exploit_Sparsity + INTEGER :: OOC_FCT_TYPE_TMP + INTEGER :: MUMPS_808 + EXTERNAL :: MUMPS_808 + MYLEAF = -1 + LP = ICNTL(1) + MP = ICNTL(2) + LDIAG = ICNTL(4) +#if defined(V_T) + CALL VTCLASSDEF( 'Soln_c',soln_c_class,ierr) + CALL VTFUNCDEF( 'forw_soln',soln_c_class,forw_soln,ierr) + CALL VTFUNCDEF( 'back_soln',soln_c_class,back_soln,ierr) + CALL VTFUNCDEF( 'root_soln',soln_c_class,root_soln,ierr) +#endif + NSTK_S = 1 + PTRICB = NSTK_S + KEEP(28) + PTRACB = PTRICB + KEEP(28) + IPOOL = PTRACB + KEEP(28) + LPOOL = KEEP(28)+1 + IPANEL_POS = IPOOL + LPOOL + IF (KEEP(201).EQ.1) THEN + LPANEL_POS = KEEP(228)+1 + ELSE + LPANEL_POS = 1 + ENDIF + IF (IPANEL_POS + LPANEL_POS -1 .ne. LIW1 ) THEN + WRITE(*,*) MYID, ": Internal Error in ZMUMPS_245", + & IPANEL_POS, LPANEL_POS, LIW1 + CALL MUMPS_ABORT() + ENDIF + DOFORWARD = .TRUE. + DOBACKWARD= .TRUE. + SPECIAL_ROOT_REACHED = .TRUE. + SWITCH_OFF_ES = .FALSE. + IF ( KEEP(111).NE.0 .OR. KEEP(252).NE.0 ) THEN + DOFORWARD = .FALSE. + ENDIF + IF (KEEP(221).eq.1) DOBACKWARD = .FALSE. + IF (KEEP(221).eq.2) DOFORWARD = .FALSE. + IF ( KEEP(60).EQ.0 .AND. + & ( + & (KEEP(38).NE.0 .AND. root%yes) + & .OR. + & (KEEP(20).NE.0 .AND. MYID_NODES.EQ.MASTER_ROOT) + & ) + & .AND. KEEP(252).EQ.0 + & ) + &THEN + DOROOT = .TRUE. + ELSE + DOROOT = .FALSE. + ENDIF + DOROOT_BWD_PANEL = DOROOT .AND. MTYPE.NE.1 .AND. KEEP(50).EQ.0 + & .AND. KEEP(201).EQ.1 + DOROOT_FWD_OOC = DOROOT .AND. .NOT.DOROOT_BWD_PANEL + AM1 = (KEEP(237) .NE. 0) + Exploit_Sparsity = (KEEP(235) .NE. 0) .AND. (.NOT. AM1) + DO_PRUN = (Exploit_Sparsity.OR.AM1) + IF ( DO_PRUN ) THEN + IF (.not. allocated(Pruned_SONS)) THEN + ALLOCATE (Pruned_SONS(KEEP(28)), stat=I) + IF(I.GT.0) THEN + INFO(1)=-13 + INFO(2)=KEEP(28) + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + END IF + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + IF (.not. allocated(TO_PROCESS)) THEN + SIZE_TO_PROCESS = KEEP(28) + ALLOCATE (TO_PROCESS(SIZE_TO_PROCESS), stat=I) + IF(I.GT.0) THEN + INFO(1)=-13 + INFO(2)=KEEP(28) + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + END IF + TO_PROCESS(:) = .TRUE. + ENDIF + IF ( DOFORWARD .AND. DO_PRUN ) THEN + nb_prun_nodes = 0 + nb_prun_roots = 0 + Pruned_SONS(:) = -1 + IF ( Exploit_Sparsity ) THEN + nb_nodes_RHS = 0 + DO I = 1, NZ_RHS + ISTEP = abs( STEP(IRHS_SPARSE(I)) ) + INODE_PRINC = Step2node( ISTEP ) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_nodes_RHS + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + nb_nodes_RHS = 0 + Pruned_SONS = -1 + DO I = 1, NZ_RHS + ISTEP = abs( STEP(IRHS_SPARSE(I)) ) + INODE_PRINC = Step2node( ISTEP ) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + nodes_RHS(nb_nodes_RHS) = INODE_PRINC + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ELSE IF ( AM1 ) THEN +#if defined(NOT_USED) + IF ( KEEP(201).GT.0) THEN + CALL ZMUMPS_789(KEEP(28), + & KEEP(38), KEEP(20) ) + ENDIF +#endif + nb_nodes_RHS = 0 +#if defined(check) + WRITE(*,*) "NBCOL_INBLOC=",NBCOL_INBLOC + WRITE(*,*) "JBEG SIZE=",JBEG_RHS, SIZE(IRHS_PTR) +#endif + DO I = 1, NBCOL_INBLOC + IF ( (IRHS_PTR(I+1)-IRHS_PTR(I)).EQ.0) CYCLE + IF ( (KEEP(242) .NE. 0 ).OR. (KEEP(243).NE.0) ) THEN + JAM1 = PERM_RHS(JBEG_RHS+I-1) + ELSE + JAM1 = JBEG_RHS+I-1 + ENDIF + ISTEP = abs(STEP(JAM1)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_nodes_RHS + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + nb_nodes_RHS = 0 + Pruned_SONS = -1 + DO I = 1, NBCOL_INBLOC + IF ( (IRHS_PTR(I+1)-IRHS_PTR(I)).EQ.0) CYCLE + IF ( (KEEP(242) .NE. 0 ).OR. (KEEP(243).NE.0) ) THEN + JAM1 = PERM_RHS(JBEG_RHS+I-1) + ELSE + JAM1 = JBEG_RHS+I-1 + ENDIF + ISTEP = abs(STEP(JAM1)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + nodes_RHS(nb_nodes_RHS) = INODE_PRINC + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ENDIF + CALL MUMPS_797( + & .FALSE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves ) + ALLOCATE(Pruned_List(nb_prun_nodes), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_nodes + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Roots(nb_prun_roots), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_roots + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Leaves(nb_prun_leaves), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + CALL MUMPS_797( + & .TRUE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves ) + IF(allocated(nodes_RHS)) DEALLOCATE(nodes_RHS) + CALL ZMUMPS_809(N, + & KEEP(201), Pruned_List, nb_prun_nodes, + & STEP) + IF ( KEEP(201) .GT. 0) THEN + OOC_FCT_TYPE_TMP=MUMPS_808 + & ('F',MTYPE,KEEP(201),KEEP(50)) + ELSE + OOC_FCT_TYPE_TMP = -5959 + ENDIF + CALL MUMPS_802( + & MYID_NODES, N, KEEP(28), KEEP(201), KEEP8(31), + & STEP, Pruned_List, nb_prun_nodes, OOC_FCT_TYPE_TMP + & ) + SPECIAL_ROOT_REACHED = .FALSE. + DO I= 1, nb_prun_roots + IF ( (Pruned_Roots(I).EQ.KEEP(38)).OR. + & (Pruned_Roots(I).EQ.KEEP(20)) ) THEN + SPECIAL_ROOT_REACHED = .TRUE. + EXIT + ENDIF + ENDDO + ENDIF + IF (KEEP(201).GT.0) THEN + IF (DOFORWARD .OR. DOROOT_FWD_OOC) THEN + CALL ZMUMPS_583(PTRFAC,KEEP(28),MTYPE, + & A,LA,DOFORWARD,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + CALL MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + IF (DOFORWARD) THEN + IF ( KEEP( 50 ) .eq. 0 ) THEN + MTYPE_LOC = MTYPE + ELSE + MTYPE_LOC = 1 + ENDIF +#if defined(V_T) + CALL VTBEGIN(forw_soln,ierr) +#endif + IF (.NOT.DO_PRUN) THEN + CALL ZMUMPS_248(N, A(1), LA, IW(1), LIW, W(1), + & LWC, RHS, LRHS, NRHS, + & IW1(PTRICB), IWCB, LIWW, + & RHSCOMP,LRHSCOMP,POSINRHSCOMP,BUILD_POSINRHSCOMP, + & NE_STEPS, NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(NSTK_S),IW1(IPOOL),LPOOL,PTRIST,PTRFAC, + & MYLEAF,INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS, SLAVEF, COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, MTYPE_LOC, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + ELSE + ALLOCATE(prun_NA(nb_prun_leaves+nb_prun_roots+2), + & STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves+nb_prun_roots+2 + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(I.LT.0) GOTO 500 + prun_NA(1) = nb_prun_leaves + prun_NA(2) = nb_prun_roots + DO I = 1, nb_prun_leaves + prun_NA(I+2) = Pruned_Leaves(I) + ENDDO + DO I = 1, nb_prun_roots + prun_NA(I+2+nb_prun_leaves) = Pruned_Roots(I) + ENDDO + DEALLOCATE(Pruned_List) + DEALLOCATE(Pruned_Leaves) + IF (AM1) THEN + DEALLOCATE(Pruned_Roots) + END IF + IF ((Exploit_Sparsity).AND.(nb_prun_roots.EQ.NA(2))) THEN + DEALLOCATE(Pruned_Roots) + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + SWITCH_OFF_ES = .TRUE. + ENDIF + CALL ZMUMPS_248(N, A(1), LA, IW(1), LIW, W(1), + & LWC, RHS, LRHS, NRHS, + & IW1(PTRICB), IWCB, LIWW, + & RHSCOMP,LRHSCOMP,POSINRHSCOMP,BUILD_POSINRHSCOMP, + & Pruned_SONS, prun_NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(NSTK_S),IW1(IPOOL),LPOOL,PTRIST,PTRFAC, + & MYLEAF,INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS, SLAVEF, COMM_NODES, MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, MTYPE_LOC, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + DEALLOCATE(prun_NA) + ENDIF + BUILD_POSINRHSCOMP = .FALSE. +#if defined(V_T) + CALL VTEND(forw_soln,ierr) +#endif + ENDIF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF ( INFO(1) .LT. 0 ) THEN + IF ( LP .GT. 0 ) THEN + WRITE(LP,*) MYID, + & ': ** ERROR RETURN FROM ZMUMPS_248,INFO(1:2)=', + & INFO(1:2) + END IF + GOTO 500 + END IF + CALL MPI_BARRIER( COMM_NODES, IERR ) + IF (DO_PRUN.AND.SWITCH_OFF_ES) THEN + DO_PRUN = .FALSE. + Exploit_Sparsity = .FALSE. + ENDIF + IF ( DOBACKWARD .AND. DO_PRUN ) THEN + nb_prun_leaves = 0 + IF ( Exploit_Sparsity .AND. (KEEP(111).EQ.0) ) THEN + nb_nodes_RHS = nb_prun_roots + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + WRITE(*,*)'Problem with allocation of nodes_RHS' + INFO(1) = -13 + INFO(2) = nb_nodes_RHS + CALL MUMPS_ABORT() + END IF + nodes_RHS(1:nb_prun_roots)=Pruned_Roots(1:nb_prun_roots) + DEALLOCATE(Pruned_Roots) + ELSE + nb_nodes_RHS = 0 + Pruned_SONS(:) = -1 + DO II = 1, NZ_RHS + I = IRHS_SPARSE(II) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + ISTEP = abs(STEP(I)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ALLOCATE(nodes_RHS(nb_nodes_RHS), STAT = allocok) + IF(allocok.GT.0) THEN + WRITE(*,*)'Problem with allocation of nodes_RHS' + INFO(1) = -13 + INFO(2) = nb_nodes_RHS + CALL MUMPS_ABORT() + END IF + nb_nodes_RHS = 0 + Pruned_SONS(:) = -1 + DO II = 1, NZ_RHS + I = IRHS_SPARSE(II) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + ISTEP = abs(STEP(I)) + INODE_PRINC = Step2node(ISTEP) + IF ( Pruned_SONS(ISTEP) .eq. -1) THEN + nb_nodes_RHS = nb_nodes_RHS +1 + nodes_RHS(nb_nodes_RHS) = INODE_PRINC + Pruned_SONS(ISTEP) = 0 + ENDIF + ENDDO + ENDIF + IF ( Exploit_Sparsity ) THEN + CALL MUMPS_798( + & .FALSE., + & DAD, NE_STEPS, FRERE, KEEP(28), + & FILS, STEP, N, + & nodes_RHS, nb_nodes_RHS, + & TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves + & ) + ALLOCATE(Pruned_List(nb_prun_nodes), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_nodes + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Roots(nb_prun_roots), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_roots + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Leaves(nb_prun_leaves), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + CALL MUMPS_798( + & .TRUE., + & DAD, NE_STEPS, FRERE, KEEP(28), + & FILS, STEP, N, + & nodes_RHS, nb_nodes_RHS, + & TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves + & ) + CALL ZMUMPS_809(N, + & KEEP(201), Pruned_List, nb_prun_nodes, + & STEP) + IF(allocated(nodes_RHS)) DEALLOCATE(nodes_RHS) + IF (KEEP(201).GT.0) THEN + OOC_FCT_TYPE_TMP=MUMPS_808 + & ('B',MTYPE,KEEP(201),KEEP(50)) + ELSE + OOC_FCT_TYPE_TMP = -5959 + ENDIF + CALL MUMPS_803( + & MYID_NODES, N, KEEP(28), KEEP(201), + & KEEP8(31), STEP, + & Pruned_List, + & nb_prun_nodes, OOC_FCT_TYPE_TMP) + ENDIF + ENDIF + IF(KEEP(201).EQ.1.AND.DOROOT_BWD_PANEL) THEN + I_WORKED_ON_ROOT = .FALSE. + CALL ZMUMPS_584(PTRFAC,KEEP(28),MTYPE, + & I_WORKED_ON_ROOT, IROOT, A, LA, IERR) + IF (IERR .LT. 0) THEN + INFO(1) = -90 + INFO(2) = IERR + ENDIF + ENDIF + IF (KEEP(201).EQ.1) THEN + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF ( INFO(1) .LT. 0 ) GOTO 500 + ENDIF + IF (KEEP(60).NE.0 .AND. KEEP(221).EQ.0 + & .AND. MYID_NODES .EQ. MASTER_ROOT) THEN + PTR_RHS_ROOT(1:NRHS*SIZE_ROOT) = ZERO + ENDIF + IF ( ( KEEP( 38 ) .NE. 0 ).AND. SPECIAL_ROOT_REACHED ) THEN + IF ( KEEP(60) .EQ. 0 .AND. KEEP(252) .EQ. 0 ) THEN + IF ( root%yes ) THEN + IF (KEEP(201).GT.0) THEN + IF ( (Exploit_Sparsity.AND.(KEEP(111).NE.0)) .and. + & (OOC_STATE_NODE(STEP(KEEP(38))).eq.-6) ) THEN + write(6,*) " CPA to be double checked " + GOTO 1010 + ENDIF + ENDIF + IOLDPS = PTRIST(STEP(KEEP(38))) + LOCAL_M = IW( IOLDPS + 2 + KEEP(IXSZ)) + LOCAL_N = IW( IOLDPS + 1 + KEEP(IXSZ)) + IF (KEEP(201).GT.0) THEN + CALL ZMUMPS_643( + & KEEP(38),PTRFAC,KEEP,A,LA, + & STEP,KEEP8,N,DUMMY_BOOL,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + WRITE(*,*) '** ERROR after ZMUMPS_643', + & INFO(1) + call MUMPS_ABORT() + ENDIF + ENDIF + IAPOS = PTRFAC(IW( IOLDPS + 4 + KEEP(IXSZ))) +#if defined(V_T) + CALL VTBEGIN(root_soln,ierr) +#endif + CALL ZMUMPS_286( NRHS, root%DESCRIPTOR(1), + & root%CNTXT_BLACS, LOCAL_M, LOCAL_N, + & root%MBLOCK, root%NBLOCK, + & root%IPIV(1), root%LPIV, MASTER_ROOT, MYID_NODES, + & COMM_NODES, + & PTR_RHS_ROOT(1), + & root%TOT_ROOT_SIZE, A( IAPOS ), + & INFO(1), MTYPE, KEEP(50)) + IF(KEEP(201).GT.0)THEN + CALL ZMUMPS_598(KEEP(38), + & PTRFAC,KEEP(28),A,LA,.FALSE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + WRITE(*,*) + & '** ERROR after ZMUMPS_598 ', + & INFO(1) + call MUMPS_ABORT() + ENDIF + ENDIF + ENDIF + ENDIF + ELSE IF ( ( KEEP(20) .NE. 0) .AND. SPECIAL_ROOT_REACHED ) THEN + IF ( MYID_NODES .eq. MASTER_ROOT ) THEN + END IF + END IF +#if defined(V_T) + CALL VTEND(root_soln,ierr) +#endif + 1010 CONTINUE + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF ( INFO(1) .LT. 0 ) RETURN + IF (DOBACKWARD) THEN + IF ( KEEP(201).GT.0 .AND. .NOT. DOROOT_BWD_PANEL ) + & THEN + I_WORKED_ON_ROOT = DOROOT + IF (KEEP(111).NE.0) + & I_WORKED_ON_ROOT = .FALSE. + IF (KEEP(38).gt.0 ) THEN + IF ( ( Exploit_Sparsity.AND.(KEEP(111).EQ.0) ) + & .OR. AM1 ) THEN + IF (OOC_STATE_NODE(STEP(KEEP(38))).eq.-6) THEN + OOC_STATE_NODE(STEP(KEEP(38)))=-4 + ENDIF + ENDIF + IF (Exploit_Sparsity.AND.(KEEP(111).NE.0)) THEN + IF (OOC_STATE_NODE(STEP(KEEP(38))).eq.-6) THEN + I_WORKED_ON_ROOT = .FALSE. + ENDIF + ENDIF + ENDIF + ENDIF + IF ( AM1 ) THEN + CALL MUMPS_797( + & .FALSE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves) + ALLOCATE(Pruned_List(nb_prun_nodes), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_nodes + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Roots(nb_prun_roots), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_roots + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + ALLOCATE(Pruned_Leaves(nb_prun_leaves), STAT=allocok) + IF(allocok.GT.0) THEN + INFO(1)=-13 + INFO(2)=nb_prun_leaves + END IF + CALL MUMPS_276(ICNTL, INFO, COMM_NODES, MYID ) + IF(INFO(1).LT.0) GOTO 500 + CALL MUMPS_797( + & .TRUE., + & DAD, KEEP(28), + & STEP, N, + & nodes_RHS, nb_nodes_RHS, + & Pruned_SONS, TO_PROCESS, + & nb_prun_nodes, nb_prun_roots, nb_prun_leaves, + & Pruned_List, Pruned_Roots, Pruned_Leaves ) + CALL ZMUMPS_809(N, + & KEEP(201), Pruned_List, nb_prun_nodes, + & STEP) + IF (KEEP(201).GT.0) THEN + OOC_FCT_TYPE_TMP=MUMPS_808 + & ('B',MTYPE,KEEP(201),KEEP(50)) + ELSE + OOC_FCT_TYPE_TMP = -5959 + ENDIF + CALL MUMPS_802( + & MYID_NODES, N, KEEP(28), KEEP(201), KEEP8(31), + & STEP, Pruned_List, nb_prun_nodes, OOC_FCT_TYPE_TMP + & ) + ENDIF + IF ( KEEP(201).GT.0 ) THEN + IROOT = max(KEEP(20),KEEP(38)) + CALL ZMUMPS_584(PTRFAC,KEEP(28),MTYPE, + & I_WORKED_ON_ROOT, IROOT, A, LA, IERR) + ENDIF + IF ( KEEP( 50 ) .eq. 0 ) THEN + MTYPE_LOC = MTYPE + ELSE + MTYPE_LOC = IZERO + ENDIF +#if defined(V_T) + CALL VTBEGIN(back_soln,ierr) +#endif + IF ( .NOT.SPECIAL_ROOT_REACHED ) THEN + PTR_RHS_ROOT(1:NRHS*SIZE_ROOT) = ZERO + ENDIF + IF ( .NOT. DO_PRUN ) THEN + SIZE_TO_PROCESS = 1 + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + ALLOCATE (TO_PROCESS(SIZE_TO_PROCESS), stat=I) + TO_PROCESS(:) = .TRUE. + CALL ZMUMPS_249( N, A, LA, IW, LIW, W(1), LWC, + & RHS, LRHS, NRHS, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & IW1(PTRICB),IW1(PTRACB),IWCB,LIWW, + & W2, NE_STEPS, NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(IPOOL),LPOOL,PTRIST,PTRFAC,MYLEAF,INFO, + & PROCNODE_STEPS, SLAVEF, COMM_NODES,MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, KEEP,KEEP8, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, + & MTYPE_LOC, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, IW1(IPANEL_POS), + & LPANEL_POS, TO_PROCESS, SIZE_TO_PROCESS) + ELSE + ALLOCATE(prun_NA(nb_prun_leaves+nb_prun_roots+2), + & STAT=allocok) + IF(allocok.GT.0) THEN + WRITE(*,*)'Problem with allocation of prun_na' + CALL MUMPS_ABORT() + END IF + prun_NA(1) = nb_prun_leaves + prun_NA(2) = nb_prun_roots + DO I = 1, nb_prun_leaves + prun_NA(I+2) = Pruned_Leaves(I) + ENDDO + DO I = 1, nb_prun_roots + prun_NA(I+2+nb_prun_leaves) = Pruned_Roots(I) + ENDDO + CALL ZMUMPS_249( N, A, LA, IW, LIW, W(1), LWC, + & RHS, LRHS, NRHS, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & IW1(PTRICB),IW1(PTRACB),IWCB,LIWW, + & W2, NE_STEPS, prun_NA, LNA, STEP, FRERE,DAD,FILS, + & IW1(IPOOL),LPOOL,PTRIST,PTRFAC,MYLEAF,INFO, + & PROCNODE_STEPS, SLAVEF, COMM_NODES,MYID_NODES, + & BUFR, LBUFR, LBUFR_BYTES, KEEP,KEEP8, + & PTR_RHS_ROOT, LPTR_RHS_ROOT, + & MTYPE_LOC, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, IW1(IPANEL_POS), + & LPANEL_POS, TO_PROCESS, SIZE_TO_PROCESS) + ENDIF +#if defined(V_T) + CALL VTEND(back_soln,ierr) +#endif + ENDIF + IF (LDIAG.GT.2 .AND. MP.GT.0) THEN + IF (DOFORWARD) THEN + K = min0(10,N) + IF (LDIAG.EQ.4) K = N + WRITE (MP,99992) + IF (N.GT.0) WRITE (MP,99993) (RHS(I,1),I=1,K) + IF (N.GT.0.and.NRHS>1) + & WRITE (MP,99994) (RHS(I,2),I=1,K) + ENDIF + ENDIF +500 CONTINUE + IF ( allocated(TO_PROCESS)) DEALLOCATE (TO_PROCESS) + IF (Exploit_Sparsity.OR.AM1.OR.SWITCH_OFF_ES) THEN + IF ( allocated(nodes_RHS)) DEALLOCATE (nodes_RHS) + IF ( allocated(Pruned_SONS)) DEALLOCATE (Pruned_SONS) + IF ( allocated(Pruned_Roots)) DEALLOCATE (Pruned_Roots) + IF ( allocated(prun_NA)) DEALLOCATE (prun_NA) + IF ( allocated(Pruned_List)) DEALLOCATE (Pruned_List) + IF ( allocated(Pruned_Leaves)) DEALLOCATE (Pruned_Leaves) + ENDIF + RETURN +99993 FORMAT (' RHS (first column)'/(1X,1P,5D14.6)) +99994 FORMAT (' RHS (2 nd column)'/(1X,1P,5D14.6)) +99992 FORMAT (//' LEAVING SOLVE (MPI41C) WITH') + END SUBROUTINE ZMUMPS_245 + SUBROUTINE ZMUMPS_521(NSLAVES, N, MYID, COMM, + & MTYPE, RHS, LRHS, NRHS, PTRIST, + & KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, BUFFER, + & SIZE_BUF, SIZE_BUF_BYTES, CWORK, LCWORK, + & LSCAL, SCALING, LSCALING) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID, COMM, LIW, MTYPE + INTEGER NRHS, LRHS, LCWORK + COMPLEX(kind=8) RHS (LRHS, NRHS) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + COMPLEX(kind=8) :: CWORK(LCWORK) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N) + INTEGER SIZE_BUF, SIZE_BUF_BYTES + INTEGER BUFFER(SIZE_BUF) + LOGICAL, intent(in) :: LSCAL + INTEGER, intent(in) :: LSCALING + DOUBLE PRECISION, intent(in) :: SCALING(LSCALING) + INTEGER I, II, J, J1, ISTEP, MASTER, + & MYID_NODES, TYPE_PARAL, N2RECV + INTEGER LIELL, IPOS, NPIV, MAXNPIV_estim, MAXSurf + INTEGER STATUS(MPI_STATUS_SIZE), IERR + PARAMETER(MASTER=0) + LOGICAL I_AM_SLAVE + INTEGER RECORD_SIZE_P_1, SIZE1, SIZE2 + INTEGER POS_BUF, N2SEND + INTEGER SK38, SK20 + INTEGER, PARAMETER :: FIN = -1 + INTEGER, PARAMETER :: yes = 1 + INTEGER, PARAMETER :: no = 0 + INTEGER, ALLOCATABLE, DIMENSION(:) :: IROWlist(:) + INTEGER :: ONE_PACK + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + TYPE_PARAL = KEEP(46) + I_AM_SLAVE = MYID .ne. MASTER .OR. TYPE_PARAL .eq. 1 + IF ( TYPE_PARAL == 1 ) THEN + MYID_NODES = MYID + ELSE + MYID_NODES = MYID-1 + ENDIF + IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.1) THEN + IF (LSCAL) THEN + DO J=1, NRHS + DO I=1,N + RHS(I,J) = RHS(I,J)*SCALING(I) + ENDDO + ENDDO + ENDIF + RETURN + ENDIF + IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.0) THEN + DO J=1, NRHS + IF ( I_AM_SLAVE ) THEN + CALL MPI_SEND(RHS(1, J), N, MPI_DOUBLE_COMPLEX, MASTER, + & GatherSol, COMM, IERR) + & + ELSE + CALL MPI_RECV(RHS(1, J), N, MPI_DOUBLE_COMPLEX, + & 1, + & GatherSol, COMM, STATUS, IERR ) + IF (LSCAL) THEN + DO I=1,N + RHS(I,J) = RHS(I,J)*SCALING(I) + ENDDO + ENDIF + ENDIF + ENDDO + RETURN + ENDIF + MAXNPIV_estim = max(KEEP(246), KEEP(247)) + MAXSurf = MAXNPIV_estim*NRHS + IF (LCWORK .GE. MAXSurf) THEN + ONE_PACK = yes + ELSE IF (LCWORK .GE. MAXNPIV_estim) THEN + ONE_PACK = no + ELSE + WRITE(*,*) + & "Internal error 2 in ZMUMPS_521:", + & TYPE_PARAL, LCWORK, KEEP(247), NRHS + CALL MUMPS_ABORT() + ENDIF + IF (ONE_PACK .EQ. no .AND. I_AM_SLAVE) THEN + WRITE(*,*) + & "Internal error 1 in ZMUMPS_521:", + & TYPE_PARAL, LCWORK, KEEP(246),KEEP(247), NRHS + CALL MUMPS_ABORT() + ENDIF + IF (TYPE_PARAL .EQ. 0) + &CALL MPI_BCAST(ONE_PACK, 1, MPI_INTEGER, + & MASTER, COMM, IERR) + IF (MYID.EQ.MASTER) THEN + ALLOCATE(IROWlist(KEEP(247))) + ENDIF + IF (NSLAVES .EQ. 1 .AND. TYPE_PARAL .EQ. 1) THEN + CALL MUMPS_ABORT() + ENDIF + SIZE1=0 + CALL MPI_PACK_SIZE(MAXNPIV_estim+2,MPI_INTEGER, COMM, + & SIZE1, IERR) + SIZE2=0 + CALL MPI_PACK_SIZE(MAXSurf,MPI_DOUBLE_COMPLEX, COMM, + & SIZE2, IERR) + RECORD_SIZE_P_1= SIZE1+SIZE2 + IF (RECORD_SIZE_P_1.GT.SIZE_BUF_BYTES) THEN + write(6,*) MYID, + & ' Internal error 3 in ZMUMPS_521 ' + write(6,*) MYID, ' RECORD_SIZE_P_1, SIZE_BUF_BYTES=', + & RECORD_SIZE_P_1, SIZE_BUF_BYTES + CALL MUMPS_ABORT() + ENDIF + N2SEND =0 + N2RECV =N + POS_BUF =0 + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + IF (I_AM_SLAVE) THEN + POS_BUF = 0 + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & NSLAVES)) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP)+KEEP(IXSZ) + NPIV = IW(IPOS+3) + LIELL = IW(IPOS) + NPIV + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2+ KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .AND. KEEP(50).EQ.0) THEN + J1=IPOS+1+LIELL + ELSE + J1=IPOS+1 + END IF + IF (MYID .EQ. MASTER) THEN + N2RECV=N2RECV-NPIV + IF (NPIV.GT.0.AND.LSCAL) + & CALL ZMUMPS_522 ( ONE_PACK, .TRUE. ) + ELSE + IF (NPIV.GT.0) + & CALL ZMUMPS_522 ( ONE_PACK, .FALSE.) + ENDIF + ENDIF + ENDDO + CALL ZMUMPS_523() + ENDIF + IF ( MYID .EQ. MASTER ) THEN + DO WHILE (N2RECV .NE. 0) + CALL MPI_RECV( BUFFER, SIZE_BUF_BYTES, MPI_PACKED, + & MPI_ANY_SOURCE, + & GatherSol, COMM, STATUS, IERR ) + POS_BUF = 0 + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & NPIV, 1, MPI_INTEGER, COMM, IERR) + DO WHILE (NPIV.NE.FIN) + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & IROWlist, NPIV, MPI_INTEGER, COMM, IERR) + IF (ONE_PACK.EQ.yes) THEN + CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF, + & CWORK, NPIV*NRHS, MPI_DOUBLE_COMPLEX, + & COMM, IERR) + IF (LSCAL) THEN + DO J=1, NRHS + DO I=1,NPIV + RHS(IROWlist(I),J)= + & CWORK(I+(J-1)*NPIV)*SCALING(IROWlist(I)) + ENDDO + END DO + ELSE + DO J=1, NRHS + DO I=1,NPIV + RHS(IROWlist(I),J)= CWORK(I+(J-1)*NPIV) + ENDDO + END DO + ENDIF + ELSE + DO J=1,NRHS + CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF, + & CWORK, NPIV, MPI_DOUBLE_COMPLEX, + & COMM, IERR) + IF (LSCAL) THEN + DO I=1,NPIV + RHS(IROWlist(I),J)=CWORK(I)*SCALING(IROWlist(I)) + ENDDO + ELSE + DO I=1,NPIV + RHS(IROWlist(I),J)=CWORK(I) + ENDDO + ENDIF + ENDDO + ENDIF + N2RECV=N2RECV-NPIV + CALL MPI_UNPACK( BUFFER, SIZE_BUF_BYTES, POS_BUF, + & NPIV, 1, MPI_INTEGER, COMM, IERR) + ENDDO + ENDDO + DEALLOCATE(IROWlist) + ENDIF + RETURN + CONTAINS + SUBROUTINE ZMUMPS_522 ( ONE_PACK, SCALE_ONLY ) + INTEGER, intent(in) :: ONE_PACK + LOGICAL, intent(in) :: SCALE_ONLY + INTEGER III + IF (SCALE_ONLY) THEN + DO II=1,NPIV + I=IW(J1+II-1) + DO J=1, NRHS + RHS(I,J) = RHS(I,J)*SCALING(I) + ENDDO + ENDDO + RETURN + ENDIF + DO II=1,NPIV + I=IW(J1+II-1) + DO J=1, NRHS + CWORK(II+(J-1)*NPIV) = RHS(I,J) + ENDDO + ENDDO + CALL MPI_PACK(NPIV, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_PACK(IW(J1), NPIV, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + IF (ONE_PACK.EQ.yes) THEN + CALL MPI_PACK(CWORK(1), NPIV*NRHS, MPI_DOUBLE_COMPLEX, + & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM, + & IERR) + ELSE + III = 1 + DO J=1,NRHS + CALL MPI_PACK(CWORK(III), NPIV, MPI_DOUBLE_COMPLEX, + & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM, + & IERR) + III =III+NPIV + ENDDO + ENDIF + N2SEND=N2SEND+NPIV + IF ( POS_BUF + RECORD_SIZE_P_1 > SIZE_BUF_BYTES ) THEN + CALL ZMUMPS_523() + END IF + RETURN + END SUBROUTINE ZMUMPS_522 + SUBROUTINE ZMUMPS_523() + IF (N2SEND .NE. 0) THEN + CALL MPI_PACK(FIN, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_SEND(BUFFER, POS_BUF, MPI_PACKED, MASTER, + & GatherSol, COMM, IERR) + ENDIF + POS_BUF=0 + N2SEND=0 + RETURN + END SUBROUTINE ZMUMPS_523 + END SUBROUTINE ZMUMPS_521 + SUBROUTINE ZMUMPS_812(NSLAVES, N, MYID, COMM, + & RHS, LRHS, NRHS, KEEP, BUFFER, + & SIZE_BUF, SIZE_BUF_BYTES, + & LSCAL, SCALING, LSCALING, + & IRHS_PTR_COPY, LIRHS_PTR_COPY, + & IRHS_SPARSE_COPY, LIRHS_SPARSE_COPY, + & RHS_SPARSE_COPY, LRHS_SPARSE_COPY, + & UNS_PERM_INV, LUNS_PERM_INV, + & POSINRHSCOMP_N, LPOS_N ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID, COMM + INTEGER NRHS, LRHS, LPOS_N + COMPLEX(kind=8) RHS (LRHS, NRHS) + INTEGER KEEP(500) + INTEGER SIZE_BUF, SIZE_BUF_BYTES + INTEGER BUFFER(SIZE_BUF) + INTEGER, intent(in) :: LIRHS_PTR_COPY, LIRHS_SPARSE_COPY, + & LRHS_SPARSE_COPY, LUNS_PERM_INV + INTEGER :: IRHS_SPARSE_COPY(LIRHS_SPARSE_COPY), + & IRHS_PTR_COPY(LIRHS_PTR_COPY), + & UNS_PERM_INV(LUNS_PERM_INV), + & POSINRHSCOMP_N(LPOS_N) + COMPLEX(kind=8) :: RHS_SPARSE_COPY(LRHS_SPARSE_COPY) + LOGICAL, intent(in) :: LSCAL + INTEGER, intent(in) :: LSCALING + DOUBLE PRECISION, intent(in) :: SCALING(LSCALING) + INTEGER COLSIZE, K, IZ, IPREV, NBCOL_INBLOC + INTEGER I, II, J, MASTER, + & TYPE_PARAL, N2RECV + INTEGER STATUS(MPI_STATUS_SIZE), IERR + PARAMETER(MASTER=0) + LOGICAL I_AM_SLAVE + INTEGER RECORD_SIZE_P_1, SIZE1, SIZE2 + INTEGER POS_BUF, N2SEND + INTEGER, PARAMETER :: FIN = -1 + INCLUDE 'mumps_headers.h' + TYPE_PARAL = KEEP(46) + I_AM_SLAVE = MYID .ne. MASTER .OR. TYPE_PARAL .eq. 1 + NBCOL_INBLOC = size(IRHS_PTR_COPY)-1 + IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.1) THEN + K=1 + DO J = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE.EQ.0) CYCLE + DO IZ=IRHS_PTR_COPY(J), IRHS_PTR_COPY(J+1)-1 + I = IRHS_SPARSE_COPY(IZ) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + IF (POSINRHSCOMP_N(I).NE.0) THEN + IF (LSCAL) THEN + RHS_SPARSE_COPY(IZ)=RHS(I,K)*SCALING(I) + ELSE + RHS_SPARSE_COPY(IZ)=RHS(I,K) + ENDIF + ENDIF + ENDDO + K = K + 1 + ENDDO + RETURN + ENDIF + IF (I_AM_SLAVE) THEN + K=1 + DO J = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE.EQ.0) CYCLE + DO IZ=IRHS_PTR_COPY(J), IRHS_PTR_COPY(J+1)-1 + I = IRHS_SPARSE_COPY(IZ) + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + IF (POSINRHSCOMP_N(I).NE.0) THEN + RHS_SPARSE_COPY(IZ)=RHS(I,K) + ENDIF + ENDDO + K = K + 1 + ENDDO + ENDIF + SIZE1=0 + CALL MPI_PACK_SIZE(3,MPI_INTEGER, COMM, + & SIZE1, IERR) + SIZE2=0 + CALL MPI_PACK_SIZE(1,MPI_DOUBLE_COMPLEX, COMM, + & SIZE2, IERR) + RECORD_SIZE_P_1= SIZE1+SIZE2 + IF (RECORD_SIZE_P_1.GT.SIZE_BUF_BYTES) THEN + write(6,*) MYID, + & ' Internal error 3 in ZMUMPS_812 ' + write(6,*) MYID, ' RECORD_SIZE_P_1, SIZE_BUF_BYTES=', + & RECORD_SIZE_P_1, SIZE_BUF_BYTES + CALL MUMPS_ABORT() + ENDIF + N2SEND =0 + N2RECV =size(IRHS_SPARSE_COPY) + POS_BUF =0 + IF (I_AM_SLAVE) THEN + DO J = 1, NBCOL_INBLOC + COLSIZE = IRHS_PTR_COPY(J+1) - IRHS_PTR_COPY(J) + IF (COLSIZE.LE.0) CYCLE + K = 0 + DO IZ=IRHS_PTR_COPY(J), IRHS_PTR_COPY(J+1)-1 + I = IRHS_SPARSE_COPY(IZ) + II = I + IF (KEEP(23).NE.0) II = UNS_PERM_INV(I) + IF (POSINRHSCOMP_N(II).NE.0) THEN + IF (MYID .EQ. MASTER) THEN + N2RECV=N2RECV-1 + IF (LSCAL) + & CALL ZMUMPS_813 ( .TRUE. ) + IRHS_SPARSE_COPY( IRHS_PTR_COPY(J) + K) = + & I + RHS_SPARSE_COPY( IRHS_PTR_COPY(J) + K) = + & RHS_SPARSE_COPY(IZ) + K = K+1 + ELSE + CALL ZMUMPS_813 ( .FALSE. ) + ENDIF + ENDIF + ENDDO + IF (MYID.EQ.MASTER) + & IRHS_PTR_COPY(J) = IRHS_PTR_COPY(J) + K + ENDDO + CALL ZMUMPS_814() + ENDIF + IF ( MYID .EQ. MASTER ) THEN + DO WHILE (N2RECV .NE. 0) + CALL MPI_RECV( BUFFER, SIZE_BUF_BYTES, MPI_PACKED, + & MPI_ANY_SOURCE, + & GatherSol, COMM, STATUS, IERR ) + POS_BUF = 0 + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & J, 1, MPI_INTEGER, COMM, IERR) + DO WHILE (J.NE.FIN) + IZ = IRHS_PTR_COPY(J) + CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF, + & I, 1, MPI_INTEGER, COMM, IERR) + IRHS_SPARSE_COPY(IZ) = I + CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF, + & RHS_SPARSE_COPY(IZ), 1, MPI_DOUBLE_COMPLEX, + & COMM, IERR) + IF (LSCAL) THEN + IF (KEEP(23).NE.0) I = UNS_PERM_INV(I) + RHS_SPARSE_COPY(IZ) = RHS_SPARSE_COPY(IZ)*SCALING(I) + ENDIF + N2RECV=N2RECV-1 + IRHS_PTR_COPY(J) = IRHS_PTR_COPY(J) + 1 + CALL MPI_UNPACK( BUFFER, SIZE_BUF_BYTES, POS_BUF, + & J, 1, MPI_INTEGER, COMM, IERR) + ENDDO + ENDDO + IPREV = 1 + DO J=1, size(IRHS_PTR_COPY)-1 + I= IRHS_PTR_COPY(J) + IRHS_PTR_COPY(J) = IPREV + IPREV = I + ENDDO + ENDIF + RETURN + CONTAINS + SUBROUTINE ZMUMPS_813 ( SCALE_ONLY ) + LOGICAL, intent(in) :: SCALE_ONLY + INTEGER III + IF (SCALE_ONLY) THEN + III = I + IF (KEEP(23).NE.0) III = UNS_PERM_INV(I) + IF (LSCAL) THEN + RHS_SPARSE_COPY(IZ)=RHS_SPARSE_COPY(IZ)*SCALING(III) + ENDIF + RETURN + ENDIF + CALL MPI_PACK(J, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_PACK(I, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_PACK(RHS_SPARSE_COPY(IZ), 1, MPI_DOUBLE_COMPLEX, + & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM, + & IERR) + N2SEND=N2SEND+1 + IF ( POS_BUF + RECORD_SIZE_P_1 > SIZE_BUF_BYTES ) THEN + CALL ZMUMPS_814() + END IF + RETURN + END SUBROUTINE ZMUMPS_813 + SUBROUTINE ZMUMPS_814() + IF (N2SEND .NE. 0) THEN + CALL MPI_PACK(FIN, 1, MPI_INTEGER, BUFFER, + & SIZE_BUF_BYTES, POS_BUF, COMM, IERR ) + CALL MPI_SEND(BUFFER, POS_BUF, MPI_PACKED, MASTER, + & GatherSol, COMM, IERR) + ENDIF + POS_BUF=0 + N2SEND=0 + RETURN + END SUBROUTINE ZMUMPS_814 + END SUBROUTINE ZMUMPS_812 + SUBROUTINE ZMUMPS_535(MTYPE, ISOL_LOC, + & PTRIST, KEEP,KEEP8, + & IW, LIW_PASSED, MYID_NODES, N, STEP, + & PROCNODE, NSLAVES, scaling_data, LSCAL) + IMPLICIT NONE + INTEGER MTYPE, MYID_NODES, N, NSLAVES + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE(KEEP(28)) + INTEGER ISOL_LOC(KEEP(89)) + INTEGER LIW_PASSED + INTEGER IW(LIW_PASSED) + INTEGER STEP(N) + LOGICAL LSCAL + type scaling_data_t + SEQUENCE + DOUBLE PRECISION, dimension(:), pointer :: SCALING + DOUBLE PRECISION, dimension(:), pointer :: SCALING_LOC + end type scaling_data_t + type (scaling_data_t) :: scaling_data + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INTEGER ISTEP, K + INTEGER J1, IPOS, LIELL, NPIV, JJ + INTEGER SK38,SK20 + INCLUDE 'mumps_headers.h' + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + K=0 + DO ISTEP=1, KEEP(28) + IF ( MYID_NODES == MUMPS_275( PROCNODE(ISTEP), + & NSLAVES)) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP)+KEEP(IXSZ) + LIELL = IW(IPOS+3) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 + KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .AND. KEEP(50).EQ.0) THEN + J1=IPOS+1+LIELL + ELSE + J1=IPOS+1 + END IF + DO JJ=J1,J1+NPIV-1 + K=K+1 + ISOL_LOC(K)=IW(JJ) + IF (LSCAL) THEN + scaling_data%SCALING_LOC(K)= + & scaling_data%SCALING(IW(JJ)) + ENDIF + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_535 + SUBROUTINE ZMUMPS_532( + & SLAVEF, N, MYID_NODES, + & MTYPE, RHS, LD_RHS, NRHS, + & ISOL_LOC, SOL_LOC, BEG_RHS, LSOL_LOC, + & PTRIST, + & PROCNODE_STEPS, KEEP,KEEP8, IW, LIW, STEP, + & scaling_data, LSCAL, NB_RHSSKIPPED) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + type scaling_data_t + SEQUENCE + DOUBLE PRECISION, dimension(:), pointer :: SCALING + DOUBLE PRECISION, dimension(:), pointer :: SCALING_LOC + end type scaling_data_t + TYPE (scaling_data_t) :: scaling_data + LOGICAL LSCAL + INTEGER SLAVEF, N, MYID_NODES, LIW, MTYPE, NRHS, LD_RHS + INTEGER LSOL_LOC, BEG_RHS, NB_RHSSKIPPED + INTEGER ISOL_LOC(LSOL_LOC) + COMPLEX(kind=8) SOL_LOC( LSOL_LOC, BEG_RHS+NRHS+NB_RHSSKIPPED-1) + COMPLEX(kind=8) RHS( LD_RHS , NRHS) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N) + INTEGER JJ, J1, ISTEP, K, JEMPTY, JEND + INTEGER IPOS, LIELL, NPIV + LOGICAL ROOT + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + K=0 + JEMPTY = BEG_RHS+NB_RHSSKIPPED-1 + JEND = BEG_RHS+NB_RHSSKIPPED+NRHS-1 + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & SLAVEF)) THEN + ROOT=.false. + IF (KEEP(38).ne.0) ROOT = STEP(KEEP(38))==ISTEP + IF (KEEP(20).ne.0) ROOT = STEP(KEEP(20))==ISTEP + IF ( ROOT ) THEN + IPOS = PTRIST(ISTEP) + KEEP(IXSZ) + LIELL = IW(IPOS+3) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2 +KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .AND. KEEP(50).EQ.0) THEN + J1=IPOS+1+LIELL + ELSE + J1=IPOS+1 + END IF + DO JJ=J1,J1+NPIV-1 + K=K+1 + IF (NB_RHSSKIPPED.GT.0) + & SOL_LOC(K, BEG_RHS:JEMPTY) = ZERO + IF (LSCAL) THEN + SOL_LOC(K,JEMPTY+1:JEND) = + & scaling_data%SCALING_LOC(K)*RHS(IW(JJ),1:NRHS) + ELSE + SOL_LOC(K,JEMPTY+1:JEND) = + & RHS(IW(JJ),1:NRHS) + ENDIF + ENDDO + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_532 + SUBROUTINE ZMUMPS_638 + & (NSLAVES, N, MYID, COMM, + & MTYPE, RHS, LRHS, NRHS, PTRIST, + & KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, + & POSINRHSCOMP, LENPOSINRHSCOMP, + & BUILD_POSINRHSCOMP, ICNTL, INFO) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID, COMM, LIW, MTYPE + INTEGER NRHS, LRHS, LENPOSINRHSCOMP + INTEGER ICNTL(40), INFO(40) + COMPLEX(kind=8) RHS (LRHS, NRHS) + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N), POSINRHSCOMP(LENPOSINRHSCOMP) + LOGICAL BUILD_POSINRHSCOMP + INTEGER BUF_MAXSIZE, BUF_MAXREF + PARAMETER (BUF_MAXREF=200000) + INTEGER, ALLOCATABLE, DIMENSION(:) :: BUF_INDX + COMPLEX(kind=8), ALLOCATABLE, DIMENSION(:,:) :: BUF_RHS + INTEGER ENTRIES_2_PROCESS, PROC_WHO_ASKS, BUF_EFFSIZE + INTEGER INDX + INTEGER allocok + COMPLEX(kind=8) ZERO + PARAMETER( ZERO = (0.0D0,0.0D0) ) + INTEGER I, K, JJ, J1, ISTEP, MASTER, + & MYID_NODES, TYPE_PARAL + INTEGER LIELL, IPOS, NPIV + INTEGER STATUS(MPI_STATUS_SIZE), IERR + PARAMETER(MASTER=0) + LOGICAL I_AM_SLAVE + INTEGER SK38, SK20, IPOSINRHSCOMP + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + TYPE_PARAL = KEEP(46) + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + I_AM_SLAVE = MYID .ne. 0 .OR. TYPE_PARAL .eq. 1 + IF ( TYPE_PARAL == 1 ) THEN + MYID_NODES = MYID + ELSE + MYID_NODES = MYID-1 + ENDIF + BUF_EFFSIZE = 0 + BUF_MAXSIZE = max(min(BUF_MAXREF,int(2000000/NRHS)),2000) + ALLOCATE (BUF_INDX(BUF_MAXSIZE), + & BUF_RHS(NRHS,BUF_MAXSIZE), + & stat=allocok) + IF (allocok .GT. 0) THEN + INFO(1)=-13 + INFO(2)=BUF_MAXSIZE*(NRHS+1) + ENDIF + CALL MUMPS_276(ICNTL, INFO, COMM, MYID ) + IF (INFO(1).LT.0) RETURN + IF (MYID.EQ.MASTER) THEN + ENTRIES_2_PROCESS = N - KEEP(89) + DO WHILE ( ENTRIES_2_PROCESS .NE. 0) + CALL MPI_RECV( BUF_INDX, BUF_MAXSIZE, MPI_INTEGER, + & MPI_ANY_SOURCE, + & ScatterRhsI, COMM, STATUS, IERR ) + CALL MPI_GET_COUNT( STATUS, MPI_INTEGER, BUF_EFFSIZE, IERR ) + PROC_WHO_ASKS = STATUS(MPI_SOURCE) + DO I = 1, BUF_EFFSIZE + INDX = BUF_INDX( I ) + DO K = 1, NRHS + BUF_RHS( K, I ) = RHS( INDX, K ) + RHS( BUF_INDX(I), K ) = ZERO + ENDDO + ENDDO + CALL MPI_SEND( BUF_RHS, NRHS*BUF_EFFSIZE, + & MPI_DOUBLE_COMPLEX, PROC_WHO_ASKS, + & ScatterRhsR, COMM, IERR) + ENTRIES_2_PROCESS = ENTRIES_2_PROCESS - BUF_EFFSIZE + ENDDO + BUF_EFFSIZE= 0 + ENDIF + IF (I_AM_SLAVE) THEN + IF (BUILD_POSINRHSCOMP) THEN + IPOSINRHSCOMP = 1 + POSINRHSCOMP = -9678 + ENDIF + IF (MYID.NE.MASTER) RHS = ZERO + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & NSLAVES)) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP) + LIELL = IW(IPOS+3+KEEP(IXSZ)) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2+ KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + END IF + IF (MTYPE.eq.1 .OR. KEEP(50).NE.0) THEN + J1=IPOS+1 + ELSE + J1=IPOS+1+LIELL + END IF + IF (BUILD_POSINRHSCOMP) THEN + POSINRHSCOMP(ISTEP) = IPOSINRHSCOMP + IPOSINRHSCOMP = IPOSINRHSCOMP + NPIV + ENDIF + IF (MYID.NE.MASTER) THEN + DO JJ=J1,J1+NPIV-1 + BUF_EFFSIZE = BUF_EFFSIZE + 1 + BUF_INDX(BUF_EFFSIZE) = IW(JJ) + IF (BUF_EFFSIZE + 1 .GT. BUF_MAXSIZE) THEN + CALL ZMUMPS_640() + ENDIF + ENDDO + ENDIF + ENDIF + ENDDO + IF ( BUF_EFFSIZE .NE. 0 .AND. MYID.NE.MASTER ) + & CALL ZMUMPS_640() + ENDIF + DEALLOCATE (BUF_INDX, BUF_RHS) + RETURN + CONTAINS + SUBROUTINE ZMUMPS_640() + CALL MPI_SEND(BUF_INDX, BUF_EFFSIZE, MPI_INTEGER, + & MASTER, ScatterRhsI, COMM, IERR ) + CALL MPI_RECV(BUF_RHS, BUF_EFFSIZE*NRHS, + & MPI_DOUBLE_COMPLEX, + & MASTER, + & ScatterRhsR, COMM, STATUS, IERR ) + DO I = 1, BUF_EFFSIZE + INDX = BUF_INDX(I) + DO K = 1, NRHS + RHS( INDX, K ) = BUF_RHS( K, I ) + ENDDO + ENDDO + BUF_EFFSIZE = 0 + RETURN + END SUBROUTINE ZMUMPS_640 + END SUBROUTINE ZMUMPS_638 + SUBROUTINE ZMUMPS_639 + & (NSLAVES, N, MYID_NODES, + & PTRIST, + & KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, + & POSINRHSCOMP, POSINRHSCOMP_N, LPIRC_N, MTYPE, + & WHAT ) + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER NSLAVES, N, MYID_NODES, LIW + INTEGER KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28)) + INTEGER IW(LIW), STEP(N), POSINRHSCOMP(KEEP(28)) + INTEGER LPIRC_N, WHAT, MTYPE + INTEGER POSINRHSCOMP_N(LPIRC_N) + INTEGER ISTEP + INTEGER NPIV + INTEGER SK38, SK20, IPOS, LIELL + INTEGER JJ, J1 + INTEGER IPOSINRHSCOMP + INCLUDE 'mumps_headers.h' + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + IF (WHAT .NE. 0.AND. WHAT.NE.1.AND.WHAT.NE.2) THEN + WRITE(*,*) "Internal error in ZMUMPS_639" + CALL MUMPS_ABORT() + ENDIF + IF (KEEP(38).NE.0) THEN + SK38=STEP(KEEP(38)) + ELSE + SK38=0 + ENDIF + IF (KEEP(20).NE.0) THEN + SK20=STEP(KEEP(20)) + ELSE + SK20=0 + ENDIF + IPOSINRHSCOMP = 1 + POSINRHSCOMP = -9678 + IF (WHAT .NE. 0) THEN + POSINRHSCOMP_N = 0 + ENDIF + DO ISTEP = 1, KEEP(28) + IF (MYID_NODES == MUMPS_275(PROCNODE_STEPS(ISTEP), + & NSLAVES)) THEN + IPOS = PTRIST(ISTEP) + NPIV = IW(IPOS+3+KEEP(IXSZ)) + POSINRHSCOMP(ISTEP) = IPOSINRHSCOMP + IF (WHAT .NE. 0) THEN + IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN + IPOS = PTRIST(ISTEP) + LIELL = IW(IPOS+3+KEEP(IXSZ)) + NPIV = LIELL + IPOS= PTRIST(ISTEP)+5+KEEP(IXSZ) + ELSE + IPOS = PTRIST(ISTEP) + 2+ KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + IPOS= IPOS+1 + NPIV = IW(IPOS) + IPOS= IPOS+1 + IPOS= IPOS+1+IW( PTRIST(ISTEP) + 5 +KEEP(IXSZ)) + ENDIF + IF (MTYPE.eq.1 .OR. KEEP(50).NE.0) THEN + J1=IPOS+1 + ELSE + J1=IPOS+1+LIELL + END IF + DO JJ = J1, J1+NPIV-1 + POSINRHSCOMP_N(IW(JJ)) = IPOSINRHSCOMP+JJ-J1 + END DO + ENDIF + IPOSINRHSCOMP = IPOSINRHSCOMP + NPIV + ENDIF + ENDDO + RETURN + END SUBROUTINE ZMUMPS_639 + SUBROUTINE ZMUMPS_248(N, A, LA, IW, LIW, WCB, LWCB, + & RHS, LRHS, NRHS, + & PTRICB, IWCB, LIWCB, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, BUILD_POSINRHSCOMP, + & NE_STEPS, NA, LNA, STEP, + & FRERE, DAD, FILS, + & NSTK_S, IPOOL, LPOOL, PTRIST, PTRFAC, MYLEAF, INFO, + & KEEP,KEEP8, + & PROCNODE_STEPS, + & SLAVEF, COMM, MYID, BUFR, LBUFR, LBUFR_BYTES, + & RHS_ROOT, LRHS_ROOT, MTYPE, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + USE ZMUMPS_OOC + IMPLICIT NONE + INTEGER MTYPE + INTEGER(8) :: LA + INTEGER N, LIW, LWCB, LPOOL, LIWCB, LNA + INTEGER SLAVEF, MYLEAF, COMM, MYID + INTEGER INFO( 40 ), KEEP(500) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS( KEEP(28) ) + INTEGER LRHS, NRHS + COMPLEX(kind=8) A( LA ), RHS( LRHS, NRHS ), WCB( LWCB ) + INTEGER LRHS_ROOT + COMPLEX(kind=8) RHS_ROOT( LRHS_ROOT ) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER NA( LNA ), NE_STEPS( KEEP(28) ) + INTEGER STEP( N ), FRERE( KEEP(28) ), FILS( N ), + & DAD( KEEP(28) ) + INTEGER NSTK_S(KEEP(28)), IPOOL( LPOOL ) + INTEGER PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PTRICB( KEEP(28) ) + INTEGER IW( LIW ), IWCB( LIWCB ) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER POSINRHSCOMP(KEEP(28)), LRHSCOMP + LOGICAL BUILD_POSINRHSCOMP + COMPLEX(kind=8) RHSCOMP( LRHSCOMP, NRHS ) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER MSGTAG, MSGSOU, DUMMY(1) + LOGICAL FLAG + INTEGER NBFIN, MYROOT + INTEGER POSIWCB,POSWCB,PLEFTWCB + INTEGER INODE + INTEGER RHSCOMPFREEPOS + INTEGER I + INTEGER III, NBROOT,LEAF + LOGICAL BLOQ + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + POSIWCB = LIWCB + POSWCB = LWCB + PLEFTWCB= 1 + IF (BUILD_POSINRHSCOMP) RHSCOMPFREEPOS= 1 + DO I = 1, KEEP(28) + NSTK_S(I) = NE_STEPS(I) + ENDDO + PTRICB = 0 + CALL MUMPS_362(N, LEAF, NBROOT, MYROOT, MYID, + & SLAVEF, NA, LNA, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, IPOOL, LPOOL) + NBFIN = SLAVEF + IF ( MYROOT .EQ. 0 ) THEN + NBFIN = NBFIN - 1 + DUMMY(1) = 1 + CALL ZMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, + & RACINE_SOLVE, SLAVEF) + END IF + MYLEAF = LEAF - 1 + III = 1 + 50 CONTINUE + IF (SLAVEF .EQ. 1) THEN + CALL ZMUMPS_574 + & ( IPOOL(1), LPOOL, III, LEAF, INODE, + & KEEP(208) ) + GOTO 60 + ENDIF + BLOQ = ( ( III .EQ. LEAF ) + & ) + CALL ZMUMPS_303( BLOQ, FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 .OR. NBFIN .EQ. 0 ) GOTO 260 + IF (.not. FLAG) THEN + IF (III .NE. LEAF) THEN + CALL ZMUMPS_574 + & (IPOOL(1), LPOOL, III, LEAF, INODE, + & KEEP(208) ) + GOTO 60 + ENDIF + ENDIF + GOTO 50 + 60 CONTINUE + CALL ZMUMPS_302( INODE, BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, N, + & IPOOL, LPOOL, III, LEAF, NBFIN, NSTK_S, + & IWCB, LIWCB, WCB, LWCB, A, LA, + & IW, LIW, RHS, LRHS, NRHS, + & POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS, + & FILS, STEP, FRERE, DAD, + & MYROOT, INFO, KEEP,KEEP8, RHS_ROOT, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & RHSCOMPFREEPOS, BUILD_POSINRHSCOMP, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & ) + IF ( INFO( 1 ) .LT. 0 .OR. NBFIN .EQ. 0 ) GOTO 260 + GOTO 50 + 260 CONTINUE + CALL ZMUMPS_150( MYID,COMM,BUFR, + & LBUFR,LBUFR_BYTES ) + RETURN + END SUBROUTINE ZMUMPS_248 + RECURSIVE SUBROUTINE ZMUMPS_323 + & ( BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, + & PTRFAC, IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, + & INFO, KEEP,KEEP8, STEP, PROCNODE_STEPS, + & RHS, LRHS + & ) + USE ZMUMPS_OOC + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER LBUFR, LBUFR_BYTES + INTEGER MSGTAG, MSGSOU, MYID, SLAVEF, COMM + INTEGER LIW + INTEGER(8) :: LA + INTEGER N, NRHS, LPOOL, III, LEAF, NBFIN + INTEGER LIWCB, LWCB, POSWCB, PLEFTWCB, POSIWCB + INTEGER INFO( 40 ), KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER BUFR( LBUFR ) + INTEGER IPOOL( LPOOL ), NSTK_S( N ) + INTEGER IWCB( LIWCB ) + INTEGER IW( LIW ) + INTEGER PTRICB(KEEP(28)),PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N) + INTEGER PROCNODE_STEPS(KEEP(28)) + COMPLEX(kind=8) WCB( LWCB ), A( LA ) + INTEGER LRHS + COMPLEX(kind=8) RHS(LRHS, NRHS) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, K, JJ + INTEGER FINODE, FPERE, LONG, NCB, POSITION, NCV, NPIV + INTEGER PTRX, PTRY, PDEST, I + INTEGER(8) :: APOS + LOGICAL DUMMY + LOGICAL FLAG + EXTERNAL MUMPS_275 + INTEGER MUMPS_275 + COMPLEX(kind=8) ALPHA, ONE + PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0)) + INCLUDE 'mumps_headers.h' + IF ( MSGTAG .EQ. RACINE_SOLVE ) THEN + NBFIN = NBFIN - 1 + IF ( NBFIN .eq. 0 ) GOTO 270 + ELSE IF (MSGTAG .EQ. ContVec ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FINODE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FPERE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NCB, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & LONG, 1, MPI_INTEGER, COMM, IERR ) + IF ( NCB .eq. 0 ) THEN + PTRICB(STEP(FINODE)) = -1 + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF ( NSTK_S(STEP(FPERE)) .EQ. 0 ) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + IF ( LEAF > LPOOL ) THEN + WRITE(*,*) 'Internal error 41r2 : Pool is too small.' + CALL MUMPS_ABORT() + END IF + END IF + ELSE + IF ( PTRICB(STEP(FINODE)) .EQ. 0 ) THEN + PTRICB(STEP(FINODE)) = NCB + 1 + END IF + IF ( ( POSIWCB - LONG ) .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = LONG + GOTO 260 + END IF + IF ( POSWCB - PLEFTWCB + 1 .LT. LONG * NRHS) THEN + INFO( 1 ) = -11 + INFO( 2 ) = PLEFTWCB - POSWCB - 1 + LONG * NRHS + GOTO 260 + END IF + IF (LONG .GT. 0) THEN + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & IWCB( 1 ), + & LONG, MPI_INTEGER, COMM, IERR ) + DO K = 1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WCB( PLEFTWCB ), + & LONG, MPI_DOUBLE_COMPLEX, COMM, IERR ) + DO I = 1, LONG + RHS(IWCB(I),K) = RHS(IWCB(I),K) +WCB(PLEFTWCB+I-1) + ENDDO + END DO + PTRICB(STEP(FINODE)) = PTRICB(STEP(FINODE)) - LONG + ENDIF + IF ( PTRICB(STEP(FINODE)) == 1 ) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + END IF + IF ( NSTK_S(STEP(FPERE)) .EQ. 0 ) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + IF ( LEAF > LPOOL ) THEN + WRITE(*,*) 'Internal error 41r2 : Pool is too small.' + CALL MUMPS_ABORT() + END IF + ENDIF + END IF + ELSEIF ( MSGTAG .EQ. Master2Slave ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FINODE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & FPERE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NCV, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NPIV, 1, MPI_INTEGER, COMM, IERR ) + PTRY = PLEFTWCB + PTRX = PLEFTWCB + NCV * NRHS + PLEFTWCB = PLEFTWCB + (NPIV + NCV) * NRHS + IF ( POSWCB - PLEFTWCB + 1 .LT. 0 ) THEN + INFO(1) = -11 + INFO(2) = -POSWCB + PLEFTWCB -1 + GO TO 260 + END IF + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WCB( PTRY + (K-1) * NCV ), NCV, + & MPI_DOUBLE_COMPLEX, COMM, IERR ) + ENDDO + IF ( NPIV .GT. 0 ) THEN + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & WCB( PTRX + (K-1)*NPIV ), NPIV, + & MPI_DOUBLE_COMPLEX, COMM, IERR ) + END DO + END IF + IF (KEEP(201).GT.0) THEN + CALL ZMUMPS_643( + & FINODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,DUMMY,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + APOS = PTRFAC(STEP(FINODE)) + IF (KEEP(201).EQ.1) THEN + IF ( NRHS == 1 ) THEN + CALL zgemv( 'N', NCV, NPIV, ALPHA, A(APOS), NCV, + & WCB( PTRX ), 1, ONE, + & WCB( PTRY ), 1 ) + ELSE + CALL zgemm( 'N', 'N', NCV, NRHS, NPIV, ALPHA, + & A(APOS), NCV, + & WCB( PTRX), NPIV, ONE, + & WCB( PTRY), NCV ) + ENDIF + ELSE + IF ( NRHS == 1 ) THEN + CALL zgemv( 'T', NPIV, NCV, ALPHA, A(APOS), NPIV, + & WCB( PTRX ), 1, ONE, + & WCB( PTRY ), 1 ) + ELSE + CALL zgemm( 'T', 'N', NCV, NRHS, NPIV, ALPHA, + & A(APOS), NPIV, + & WCB( PTRX), NPIV, ONE, + & WCB( PTRY), NCV ) + ENDIF + ENDIF + IF (KEEP(201).GT.0) THEN + CALL ZMUMPS_598(FINODE,PTRFAC, + & KEEP(28),A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + PLEFTWCB = PLEFTWCB - NPIV * NRHS + PDEST = MUMPS_275( PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF ) + IF ( PDEST .EQ. MYID ) THEN + IF ( PTRICB(STEP(FINODE)) .EQ. 0 ) THEN + NCB = IW( PTRIST(STEP(FINODE)) + 2 + KEEP(IXSZ) ) + PTRICB(STEP(FINODE)) = NCB + 1 + END IF + DO I = 1, NCV + JJ=IW(PTRIST(STEP(FINODE))+3+I+ KEEP(IXSZ) ) + DO K=1, NRHS + RHS(JJ,K)= RHS(JJ,K) + WCB(PTRY+I-1+(K-1)*NCV) + ENDDO + END DO + PTRICB(STEP(FINODE)) = + & PTRICB(STEP(FINODE)) - NCV + IF ( PTRICB( STEP( FINODE ) ) == 1 ) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + END IF + IF ( NSTK_S(STEP(FPERE)) .EQ. 0 ) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + IF ( LEAF > LPOOL ) THEN + WRITE(*,*) 'INTERNAL Error 41r: Pool is too small.' + CALL MUMPS_ABORT() + END IF + ENDIF + ELSE + 210 CONTINUE + CALL ZMUMPS_78( NRHS, FINODE, FPERE, + & IW(PTRIST(STEP( FINODE )) + 2 + KEEP(IXSZ) ), NCV,NCV, + & IW(PTRIST(STEP(FINODE))+4+ KEEP(IXSZ) ), + & WCB( PTRY ), PDEST, ContVec, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL ZMUMPS_303( .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 210 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = ( NCV + 4 ) * KEEP( 34 ) + + & NCV * KEEP( 35 ) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = ( NCV + 4 ) * KEEP( 34 ) + + & NCV * KEEP( 35 ) + END IF + END IF + PLEFTWCB = PLEFTWCB - NCV * NRHS + ELSEIF ( MSGTAG .EQ. TERREUR ) THEN + INFO(1) = -001 + INFO(2) = MSGSOU + GOTO 270 + ELSE IF ( (MSGTAG.EQ.UPDATE_LOAD).OR. + & (MSGTAG.EQ.TAG_DUMMY) ) THEN + GO TO 270 + ELSE + INFO(1)=-100 + INFO(2)=MSGTAG + GO TO 260 + ENDIF + GO TO 270 + 260 CONTINUE + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + 270 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_323 + SUBROUTINE ZMUMPS_302( INODE, + & BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, + & N, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, + & IWCB, LIWCB, + & WCB, LWCB, A, LA, IW, LIW, + & RHS, LRHS, NRHS, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS, + & FILS, STEP, FRERE, DAD, + & MYROOT, + & INFO, KEEP,KEEP8, RHS_ROOT, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & RHSCOMPFREEPOS, BUILD_POSINRHSCOMP, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE + & + & ) + USE ZMUMPS_OOC + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER MTYPE + INTEGER INODE, LBUFR, LBUFR_BYTES + INTEGER MSGTAG, MSGSOU, MYID, SLAVEF, COMM + INTEGER LIWCB, LWCB, LIW, POSWCB, PLEFTWCB, POSIWCB + INTEGER(8) :: LA + INTEGER N, LPOOL, III, LEAF, NBFIN + INTEGER MYROOT + INTEGER INFO( 40 ), KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER BUFR( LBUFR ) + INTEGER IPOOL( LPOOL ), NSTK_S(KEEP(28)) + INTEGER IWCB( LIWCB ), IW( LIW ) + INTEGER LRHS, NRHS + COMPLEX(kind=8) WCB( LWCB ), A( LA ) + COMPLEX(kind=8) RHS(LRHS, NRHS ), RHS_ROOT( * ) + INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER FILS( N ), STEP( N ), FRERE(KEEP(28)), DAD(KEEP(28)) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER POSINRHSCOMP(KEEP(28)), LRHSCOMP, RHSCOMPFREEPOS + COMPLEX(kind=8) RHSCOMP(LRHSCOMP, NRHS) + LOGICAL BUILD_POSINRHSCOMP + EXTERNAL zgemv, ztrsv, zgemm, ztrsm, MUMPS_275 + INTEGER MUMPS_275 + COMPLEX(kind=8) ALPHA,ONE,ZERO + PARAMETER (ZERO=(0.0D0,0.0D0), + & ONE=(1.0D0,0.0D0), + & ALPHA=(-1.0D0,0.0D0)) + INTEGER(8) :: APOS, APOS1, APOS2, APOSOFF + INTEGER I, J, K, IPOS, NSLAVES, J1, J2, J3, FPERE, NPIV, NCB, + & IERR, IFR_ini, + & IFR, LIELL, JJ, + & NELIM, PLEFT, PCB_COURANT, PPIV_COURANT + INTEGER IPOSINRHSCOMP + INTEGER Effective_CB_Size, NUPDATE, ISLAVE, PDEST, FirstIndex + LOGICAL FLAG, OMP_FLAG + INCLUDE 'mumps_headers.h' + INTEGER POSWCB1,POSWCB2 + INTEGER(8) :: APOSDEB + INTEGER TempNROW, TempNCOL, PANEL_SIZE, LIWFAC, + & JFIN, NBJ, NUPDATE_PANEL, + & PPIV_PANEL, PCB_PANEL, NBK, TYPEF + INTEGER LD_WCBPIV + INTEGER LD_WCBCB + INTEGER LDAJ, LDAJ_FIRST_PANEL + INTEGER TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPANEL + LOGICAL MUST_BE_PERMUTED + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER DUMMY( 1 ) + IF ( INODE .eq. KEEP( 38 ) .OR. INODE .eq.KEEP( 20 ) ) THEN + LIELL = IW( PTRIST( STEP(INODE)) + 3 + KEEP(IXSZ)) + NPIV = LIELL + NELIM = 0 + NSLAVES = 0 + IPOS = PTRIST( STEP(INODE)) + 5 + KEEP(IXSZ) + ELSE + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + NELIM = IW(IPOS-1) + NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) ) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + IPOS = IPOS + 1 + IF (KEEP(201).GT.0) THEN + CALL ZMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL ZMUMPS_755( + & IW(IPOS+1+2*LIELL+1+NSLAVES), + & MUST_BE_PERMUTED ) + ENDIF + ENDIF + NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ)) + IPOS = IPOS + 1 + NSLAVES + END IF + IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN + J1 = IPOS + 1 + J2 = IPOS + LIELL + J3 = IPOS + NPIV + ELSE + J1 = IPOS + LIELL + 1 + J2 = IPOS + 2 * LIELL + J3 = IPOS + LIELL + NPIV + END IF + NCB = LIELL-NPIV + IF ( INODE .eq. KEEP( 38 ) .OR. INODE .eq. KEEP(20) ) THEN + IFR = 0 + DO JJ = J1, J3 + J = IW( JJ ) + IFR = IFR + 1 + DO K=1,NRHS + RHS_ROOT(IFR+NPIV*(K-1)) = RHS(J,K) + END DO + END DO + IF ( NPIV .LT. LIELL ) THEN + WRITE(*,*) ' Internal error in SOLVE_NODE for Root node' + CALL MUMPS_ABORT() + END IF + MYROOT = MYROOT - 1 + IF ( MYROOT .EQ. 0 ) THEN + NBFIN = NBFIN - 1 + IF (SLAVEF .GT. 1) THEN + DUMMY (1) = 1 + CALL ZMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, + & COMM, RACINE_SOLVE, SLAVEF) + ENDIF + END IF + GO TO 270 + END IF + APOS = PTRFAC(STEP(INODE)) + IF (KEEP(201).EQ.1) THEN + IF (MTYPE.EQ.1) THEN + IF ((MTYPE.EQ.1).AND.NSLAVES.NE.0) THEN + TempNROW= NPIV+NELIM + TempNCOL= NPIV + LDAJ_FIRST_PANEL=TempNROW + ELSE + TempNROW= LIELL + TempNCOL= NPIV + LDAJ_FIRST_PANEL=TempNROW + ENDIF + TYPEF=TYPEF_L + ELSE + TempNCOL= LIELL + TempNROW= NPIV + LDAJ_FIRST_PANEL=TempNCOL + TYPEF= TYPEF_U + ENDIF + LIWFAC = IW(PTRIST(STEP(INODE))+XXI) + PANEL_SIZE = ZMUMPS_690( LDAJ_FIRST_PANEL ) + ENDIF + PLEFT = PLEFTWCB + PPIV_COURANT = PLEFTWCB + PLEFTWCB = PLEFTWCB + LIELL * NRHS + IF ( POSWCB - PLEFTWCB + 1 .LT. 0 ) THEN + INFO(1) = -11 + INFO(2) = PLEFTWCB - POSWCB - 1 + GO TO 260 + END IF + IF (KEEP(201).EQ.1) THEN + LD_WCBPIV = LIELL + LD_WCBCB = LIELL + PCB_COURANT = PPIV_COURANT + NPIV + DO K=1, NRHS + IFR = PPIV_COURANT + (K-1)*LIELL - 1 + DO JJ = J1, J3 + J = IW(JJ) + IFR = IFR + 1 + WCB(IFR) = RHS(J,K) + ENDDO + IF (NCB.GT.0) THEN + DO JJ = J3+1, J2 + J = IW(JJ) + IFR = IFR + 1 + WCB(IFR) = RHS(J,K) + RHS (J,K) = ZERO + ENDDO + ENDIF + END DO + ELSE + LD_WCBPIV = NPIV + LD_WCBCB = NCB + PCB_COURANT = PPIV_COURANT + NPIV*NRHS + IFR = PPIV_COURANT - 1 + OMP_FLAG = NRHS.GT.4 + IFR_ini = IFR + DO 130 JJ = J1, J3 + J = IW(JJ) + IFR = IFR_ini + (JJ-J1) + 1 + DO K=1, NRHS + WCB(IFR+(K-1)*NPIV) = RHS(J,K) + END DO + 130 CONTINUE + IFR = PCB_COURANT - 1 + IF (NPIV .LT. LIELL) THEN + IFR_ini = IFR + DO 140 JJ = J3 + 1, J2 + J = IW(JJ) + IFR = IFR_ini + (JJ-J3) + DO K=1, NRHS + WCB(IFR+(K-1)*NCB) = RHS(J,K) + RHS(J,K)=ZERO + ENDDO + 140 CONTINUE + ENDIF + ENDIF + IF ( NPIV .NE. 0 ) THEN + IF (KEEP(201).EQ.1) THEN + APOSDEB = APOS + J = 1 + IPANEL = 0 + 10 CONTINUE + IPANEL = IPANEL + 1 + JFIN = min(J+PANEL_SIZE-1, NPIV) + IF (IW(IPOS+ LIELL + JFIN) < 0) THEN + JFIN=JFIN+1 + ENDIF + NBJ = JFIN-J+1 + LDAJ = LDAJ_FIRST_PANEL-J+1 + IF ( (KEEP(50).NE.1).AND. MUST_BE_PERMUTED ) THEN + CALL ZMUMPS_667(TYPEF, TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPOS+1+2*LIELL, IW, LIW) + IF (NPIV.EQ.(IW(I_PIVRPTR+IPANEL-1)-1)) THEN + MUST_BE_PERMUTED=.FALSE. + ELSE + CALL ZMUMPS_698( + & IW( I_PIVR+ IW(I_PIVRPTR+IPANEL-1)- + & IW(I_PIVRPTR)), + & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, + & IW(I_PIVRPTR+IPANEL-1)-1, + & + & A(APOSDEB), + & LDAJ, NBJ, J-1 ) + ENDIF + ENDIF + NUPDATE_PANEL = LDAJ - NBJ + PPIV_PANEL = PPIV_COURANT+J-1 + PCB_PANEL = PPIV_PANEL+NBJ + APOS1 = APOSDEB+int(NBJ,8) + IF (MTYPE.EQ.1) THEN + IF ( NRHS == 1 ) THEN + CALL ztrsv( 'L', 'N', 'U', NBJ, A(APOSDEB), LDAJ, + & WCB(PPIV_PANEL), 1 ) + IF (NUPDATE_PANEL.GT.0) THEN + CALL zgemv('N', NUPDATE_PANEL,NBJ,ALPHA, A(APOS1), + & LDAJ, WCB(PPIV_PANEL), 1, ONE, + & WCB(PCB_PANEL), 1) + ENDIF + ELSE + CALL ztrsm( 'L','L','N','U', NBJ, NRHS, ONE, + & A(APOSDEB), LDAJ, WCB(PPIV_PANEL), + & LIELL ) + IF (NUPDATE_PANEL.GT.0) THEN + CALL zgemm('N', 'N', NUPDATE_PANEL, NRHS, NBJ, + & ALPHA, + & A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE, + & WCB(PCB_PANEL), LIELL) + ENDIF + ENDIF + ELSE + IF (NRHS == 1) THEN + CALL ztrsv( 'L', 'N', 'N', NBJ, A(APOSDEB), LDAJ, + & WCB(PPIV_PANEL), 1 ) + IF (NUPDATE_PANEL.GT.0) THEN + CALL zgemv('N',NUPDATE_PANEL, NBJ, ALPHA, A(APOS1), + & LDAJ, WCB(PPIV_PANEL), 1, + & ONE, WCB(PCB_PANEL), 1 ) + ENDIF + ELSE + CALL ztrsm('L','L','N','N',NBJ, NRHS, ONE, + & A(APOSDEB), LDAJ, WCB(PPIV_PANEL), + & LIELL) + IF (NUPDATE_PANEL.GT.0) THEN + CALL zgemm('N', 'N', NUPDATE_PANEL, NRHS, NBJ, + & ALPHA, + & A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE, + & WCB(PCB_PANEL), LIELL) + ENDIF + ENDIF + ENDIF + APOSDEB = APOSDEB+int(LDAJ,8)*int(NBJ,8) + J=JFIN+1 + IF ( J .LE. NPIV ) GOTO 10 + ELSE + IF (KEEP(50).NE.0) THEN + IF ( NRHS == 1 ) THEN + CALL ztrsv( 'U', 'T', 'U', NPIV, A(APOS), NPIV, + & WCB(PPIV_COURANT), 1 ) + ELSE + CALL ztrsm( 'L','U','T','U', NPIV, NRHS, ONE, + & A(APOS), NPIV, WCB(PPIV_COURANT), + & NPIV ) + ENDIF + ELSE + IF ( MTYPE .eq. 1 ) THEN + IF ( NRHS == 1) THEN + CALL ztrsv( 'U', 'T', 'U', NPIV, A(APOS), LIELL, + & WCB(PPIV_COURANT), 1 ) + ELSE + CALL ztrsm( 'L','U','T','U', NPIV, NRHS, ONE, + & A(APOS), LIELL, WCB(PPIV_COURANT), + & NPIV ) + ENDIF + ELSE + IF (NRHS == 1) THEN + CALL ztrsv( 'L', 'N', 'N', NPIV, A(APOS), LIELL, + & WCB(PPIV_COURANT), 1 ) + ELSE + CALL ztrsm('L','L','N','N',NPIV, NRHS, ONE, + & A(APOS), LIELL, WCB(PPIV_COURANT), + & NPIV) + ENDIF + END IF + END IF + END IF + END IF + NCB = LIELL - NPIV + IF ( MTYPE .EQ. 1 ) THEN + IF ( KEEP(50) .eq. 0 ) THEN + APOS1 = APOS + int(NPIV,8) * int(LIELL,8) + ELSE + APOS1 = APOS + int(NPIV,8) * int(NPIV,8) + END IF + IF ( NSLAVES .EQ. 0 .OR. NPIV .eq. 0 ) THEN + NUPDATE = NCB + ELSE + NUPDATE = NELIM + END IF + ELSE + APOS1 = APOS + int(NPIV,8) + NUPDATE = NCB + END IF + IF (KEEP(201).NE.1) THEN + IF ( NPIV .NE. 0 .AND. NUPDATE.NE.0 ) THEN + IF ( MTYPE .eq. 1 ) THEN + IF ( NRHS == 1 ) THEN + CALL zgemv('T', NPIV, NUPDATE, ALPHA, A(APOS1), + & NPIV, WCB(PPIV_COURANT), 1, ONE, + & WCB(PCB_COURANT), 1) + ELSE + CALL zgemm('T', 'N', NUPDATE, NRHS, NPIV, ALPHA, + & A(APOS1), NPIV, WCB(PPIV_COURANT), NPIV, ONE, + & WCB(PCB_COURANT), NCB) + END IF + ELSE + IF ( NRHS == 1 ) THEN + CALL zgemv('N',NUPDATE, NPIV, ALPHA, A(APOS1), + & LIELL, WCB(PPIV_COURANT), 1, + & ONE, WCB(PCB_COURANT), 1 ) + ELSE + CALL zgemm('N', 'N', NUPDATE, NRHS, NPIV, ALPHA, + & A(APOS1), LIELL, WCB(PPIV_COURANT), NPIV, ONE, + & WCB(PCB_COURANT), NCB) + END IF + END IF + END IF + END IF + IF (BUILD_POSINRHSCOMP) THEN + POSINRHSCOMP(STEP(INODE)) = RHSCOMPFREEPOS + RHSCOMPFREEPOS = RHSCOMPFREEPOS + NPIV + ENDIF + IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + IF ( KEEP(50) .eq. 0 ) THEN + DO K=1,NRHS + IFR = PPIV_COURANT + (K-1)*LD_WCBPIV + RHSCOMP(IPOSINRHSCOMP:IPOSINRHSCOMP+NPIV-1, K) = + & WCB(IFR:IFR+NPIV-1) + ENDDO + ELSE + IFR = PPIV_COURANT - 1 + IF (KEEP(201).EQ.1) THEN + LDAJ = TempNROW + ELSE + LDAJ = NPIV + ENDIF + APOS1 = APOS + JJ = J1 + IF (KEEP(201).EQ.1) THEN + NBK = 0 + ENDIF + DO + IF(JJ .GT. J3) EXIT + IFR = IFR + 1 + IF(IW(JJ+LIELL) .GT. 0) THEN + DO K=1, NRHS + RHSCOMP(IPOSINRHSCOMP+JJ-J1 , K ) = + & WCB( IFR+(K-1)*LD_WCBPIV ) * A( APOS1 ) + END DO + IF (KEEP(201).EQ.1) THEN + NBK = NBK+1 + IF (NBK.EQ.PANEL_SIZE) THEN + NBK = 0 + LDAJ = LDAJ - PANEL_SIZE + ENDIF + ENDIF + APOS1 = APOS1 + int(LDAJ + 1,8) + JJ = JJ+1 + ELSE + IF (KEEP(201).EQ.1) THEN + NBK = NBK+1 + ENDIF + APOS2 = APOS1+int(LDAJ+1,8) + IF (KEEP(201).EQ.1) THEN + APOSOFF = APOS1+int(LDAJ,8) + ELSE + APOSOFF=APOS1+1_8 + ENDIF + DO K=1, NRHS + POSWCB1 = IFR+(K-1)*LD_WCBPIV + POSWCB2 = POSWCB1+1 + RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = WCB(POSWCB1)*A(APOS1) + & + WCB(POSWCB2)*A(APOSOFF) + RHSCOMP(IPOSINRHSCOMP+JJ-J1+1,K) = + & WCB(POSWCB1)*A(APOSOFF) + & + WCB(POSWCB2)*A(APOS2) + END DO + IF (KEEP(201).EQ.1) THEN + NBK = NBK+1 + IF (NBK.GE.PANEL_SIZE) THEN + LDAJ = LDAJ - NBK + NBK = 0 + ENDIF + ENDIF + APOS1 = APOS2 + int(LDAJ + 1,8) + JJ = JJ+2 + IFR = IFR+1 + ENDIF + ENDDO + END IF + IF (KEEP(201).GT.0) THEN + CALL ZMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + END IF + FPERE = DAD(STEP(INODE)) + IF ( FPERE .EQ. 0 ) THEN + MYROOT = MYROOT - 1 + PLEFTWCB = PLEFTWCB - LIELL *NRHS + IF ( MYROOT .EQ. 0 ) THEN + NBFIN = NBFIN - 1 + IF (SLAVEF .GT. 1) THEN + DUMMY (1) = 1 + CALL ZMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, + & COMM, RACINE_SOLVE, SLAVEF) + ENDIF + END IF + GO TO 270 + ENDIF + IF ( NUPDATE .NE. 0 .OR. NCB.eq.0 ) THEN + IF (MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), + & SLAVEF) .EQ. MYID) THEN + IF ( NCB .ne. 0 ) THEN + PTRICB(STEP(INODE)) = NCB + 1 + DO 190 I = 1, NUPDATE + DO K=1, NRHS + RHS( IW(J3 + I), K ) = RHS( IW(J3 + I), K ) + & + WCB(PCB_COURANT + I-1 +(K-1)*LD_WCBCB) + ENDDO + 190 CONTINUE + PTRICB(STEP( INODE )) = PTRICB(STEP( INODE )) - NUPDATE + IF ( PTRICB(STEP(INODE)) == 1 ) THEN + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF (NSTK_S(STEP(FPERE)) .EQ. 0) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + ENDIF + END IF + ELSE + PTRICB(STEP( INODE )) = -1 + NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1 + IF (NSTK_S(STEP(FPERE)) .EQ. 0) THEN + IPOOL( LEAF ) = FPERE + LEAF = LEAF + 1 + ENDIF + ENDIF + ELSE + 210 CONTINUE + CALL ZMUMPS_78( NRHS, INODE, FPERE, NCB, LD_WCBCB, + & NUPDATE, + & IW( J3 + 1 ), WCB( PCB_COURANT ), + & MUMPS_275(PROCNODE_STEPS(STEP(FPERE)), SLAVEF), + & ContVec, + & COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL ZMUMPS_303( .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 210 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = NUPDATE * KEEP( 35 ) + + & ( NUPDATE + 3 ) * KEEP( 34 ) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = NUPDATE * KEEP( 35 ) + + & ( NUPDATE + 3 ) * KEEP( 34 ) + GOTO 260 + END IF + ENDIF + END IF + IF ( NSLAVES .NE. 0 .AND. MTYPE .eq. 1 + & .and. NPIV .NE. 0 ) THEN + DO ISLAVE = 1, NSLAVES + PDEST = IW( PTRIST(STEP(INODE)) + 5 + ISLAVE +KEEP(IXSZ)) + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB - NELIM, + & NSLAVES, + & Effective_CB_Size, FirstIndex ) + 222 CALL ZMUMPS_72( NRHS, + & INODE, FPERE, + & Effective_CB_Size, LD_WCBCB, LD_WCBPIV, NPIV, + & WCB( PCB_COURANT + NELIM + FirstIndex - 1 ), + & WCB( PPIV_COURANT ), + & PDEST, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL ZMUMPS_303( .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 222 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = (NPIV+Effective_CB_Size)*NRHS*KEEP(35) + + & ( Effective_CB_Size + 4 ) * KEEP( 34 ) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = (NPIV+Effective_CB_Size)*NRHS*KEEP(35) + + & ( Effective_CB_Size + 4 ) * KEEP( 34 ) + GOTO 260 + END IF + END DO + END IF + PLEFTWCB = PLEFTWCB - LIELL*NRHS + 270 CONTINUE + RETURN + 260 CONTINUE + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + RETURN + END SUBROUTINE ZMUMPS_302 + RECURSIVE SUBROUTINE ZMUMPS_303( BLOQ, FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, PROCNODE_STEPS, + & RHS, LRHS + & ) + IMPLICIT NONE + LOGICAL BLOQ + INTEGER LBUFR, LBUFR_BYTES + INTEGER MYID, SLAVEF, COMM + INTEGER N, NRHS, LPOOL, III, LEAF, NBFIN + INTEGER LIWCB, LWCB, POSWCB, PLEFTWCB, POSIWCB + INTEGER LIW + INTEGER(8) :: LA + INTEGER INFO( 40 ), KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER BUFR( LBUFR ), IPOOL(LPOOL) + INTEGER NSTK_S( KEEP(28) ) + INTEGER IWCB( LIWCB ) + INTEGER IW( LIW ) + COMPLEX(kind=8) WCB( LWCB ), A( LA ) + INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER STEP(N) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER LRHS + COMPLEX(kind=8) RHS(LRHS, NRHS) + LOGICAL FLAG + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR, STATUS( MPI_STATUS_SIZE ) + INTEGER MSGSOU, MSGTAG, MSGLEN + FLAG = .FALSE. + IF ( BLOQ ) THEN + CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, + & COMM, STATUS, IERR ) + FLAG = .TRUE. + ELSE + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + END IF + IF ( FLAG ) THEN + MSGSOU = STATUS( MPI_SOURCE ) + MSGTAG = STATUS( MPI_TAG ) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) + IF ( MSGLEN .GT. LBUFR_BYTES ) THEN + INFO(1) = -20 + INFO(2) = MSGLEN + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + ELSE + CALL MPI_RECV( BUFR, LBUFR_BYTES, MPI_PACKED, + & MSGSOU, MSGTAG, COMM, STATUS, IERR ) + CALL ZMUMPS_323( BUFR, LBUFR, LBUFR_BYTES, + & MSGTAG, MSGSOU, MYID, SLAVEF, COMM, + & N, NRHS, IPOOL, LPOOL, III, LEAF, + & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC, + & IWCB, LIWCB, + & WCB, LWCB, POSWCB, + & PLEFTWCB, POSIWCB, + & PTRICB, INFO, KEEP,KEEP8, STEP, + & PROCNODE_STEPS, + & RHS, LRHS + & ) + END IF + END IF + RETURN + END SUBROUTINE ZMUMPS_303 + SUBROUTINE ZMUMPS_249(N, A, LA, IW, LIW, W, LWC, + & RHS, LRHS, NRHS, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP, + & PTRICB, PTRACB, IWCB, LIWW, W2, + & NE_STEPS, NA, LNA, STEP, + & FRERE, DAD, FILS, IPOOL, LPOOL, PTRIST, PTRFAC, + & MYLEAF, INFO, + & PROCNODE_STEPS, + & SLAVEF, COMM,MYID, BUFR, LBUFR, LBUFR_BYTES, + & KEEP,KEEP8, RHS_ROOT, LRHS_ROOT, MTYPE, + & + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, PANEL_POS, LPANEL_POS + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + USE ZMUMPS_OOC + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER MTYPE + INTEGER(8) :: LA + INTEGER N,LIW,LIWW,LWC,LPOOL,LNA + INTEGER SLAVEF,MYLEAF,COMM,MYID + INTEGER LPANEL_POS + INTEGER KEEP( 500 ) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER NA(LNA),NE_STEPS(KEEP(28)) + INTEGER IPOOL(LPOOL) + INTEGER PANEL_POS(LPANEL_POS) + INTEGER INFO(40) + INTEGER PTRIST(KEEP(28)), + & PTRICB(KEEP(28)),PTRACB(KEEP(28)) + INTEGER(8) :: PTRFAC(KEEP(28)) + INTEGER LRHS, NRHS + COMPLEX(kind=8) A(LA), RHS(LRHS,NRHS), W(LWC) + COMPLEX(kind=8) W2(KEEP(133)) + INTEGER IW(LIW),IWCB(LIWW) + INTEGER STEP(N), FRERE(KEEP(28)),DAD(KEEP(28)),FILS(N) + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR(LBUFR) + INTEGER ISTEP_TO_INIV2(KEEP(71)), + & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) + INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28)) + COMPLEX(kind=8) RHSCOMP(LRHSCOMP,NRHS) + INTEGER LRHS_ROOT + COMPLEX(kind=8) RHS_ROOT( LRHS_ROOT ) + INTEGER, intent(in) :: SIZE_TO_PROCESS + LOGICAL, intent(in) :: TO_PROCESS(SIZE_TO_PROCESS) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275 + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER IERR + LOGICAL FLAG + INTEGER POSIWCB,POSWCB,K + INTEGER(8) :: APOS, IST + INTEGER NPIV + INTEGER IPOS,LIELL,NELIM,IFR,JJ,I + INTEGER J1,J2,J,NCB,NBFINF + INTEGER NBLEAF,INODE,NBROOT,NROOT,NBFILS + INTEGER IN,IF,LONG,POOL_FIRST_POS,TMP + INTEGER III,IIPOOL,MYLEAFE + INTEGER NSLAVES + COMPLEX(kind=8) ALPHA,ONE,ZERO + PARAMETER (ZERO=(0.0D0,0.0D0), + & ONE=(1.0D0,0.0D0), + & ALPHA=(-1.0D0,0.0D0)) + LOGICAL BLOQ,DEBUT + INTEGER PROCDEST, DEST + INTEGER POSINDICES, IPOSINRHSCOMP + INTEGER DUMMY(1) + INTEGER PLEFTW, PTWCB + INTEGER Offset, EffectiveSize, ISLAVE, FirstIndex + LOGICAL LTLEVEL2, IN_SUBTREE + INTEGER TYPENODE + INCLUDE 'mumps_headers.h' + LOGICAL BLOCK_SEQUENCE + INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR + LOGICAL MUST_BE_PERMUTED + LOGICAL NO_CHILDREN + LOGICAL Exploit_Sparsity, AM1 + LOGICAL DEJA_SEND( 0:SLAVEF-1 ) + INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS + INTEGER LDAJ, NBJ, LIWFAC, + & NBJLAST, NPIV_LAST, PANEL_SIZE, + & PTWCB_PANEL, NCB_PANEL, TYPEF + INTEGER BEG_PANEL + LOGICAL TWOBYTWO + INTEGER NPANELS, IPANEL + LOGICAL MUMPS_170 + INTEGER MUMPS_330 + EXTERNAL zgemv, ztrsv, ztrsm, zgemm, + & MUMPS_330, + & MUMPS_170 + PLEFTW = 1 + POSIWCB = LIWW + POSWCB = LWC + NROOT = 0 + NBLEAF = NA(1) + NBROOT = NA(2) + DO I = NBROOT, 1, -1 + INODE = NA(NBLEAF+I+2) + IF (MUMPS_275(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) .EQ. MYID) THEN + NROOT = NROOT + 1 + IPOOL(NROOT) = INODE + ENDIF + END DO + III = 1 + IIPOOL = NROOT + 1 + BLOCK_SEQUENCE = .FALSE. + Exploit_Sparsity = .FALSE. + AM1 = .FALSE. + IF (KEEP(235).NE.0) Exploit_Sparsity = .TRUE. + IF (KEEP(237).NE.0) AM1 = .TRUE. + NO_CHILDREN = .FALSE. + IF (Exploit_Sparsity .OR. AM1) MYLEAF = -1 + IF (MYLEAF .EQ. -1) THEN + MYLEAF = 0 + DO I=1, NBLEAF + INODE=NA(I+2) + IF (MUMPS_275(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) .EQ. MYID) THEN + MYLEAF = MYLEAF + 1 + ENDIF + ENDDO + ENDIF + MYLEAFE=MYLEAF + NBFINF = SLAVEF + IF (MYLEAFE .EQ. 0) THEN + CALL ZMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, FEUILLE, + & SLAVEF) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) THEN + GOTO 340 + ENDIF + ENDIF + 50 CONTINUE + BLOQ = ( ( III .EQ. IIPOOL ) + & ) + CALL ZMUMPS_41( BLOQ, FLAG, BUFR, LBUFR, + & LBUFR_BYTES, MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO(1) .LT. 0 ) GOTO 340 + IF ( .NOT. FLAG ) THEN + IF (III .NE. IIPOOL) THEN + INODE = IPOOL(IIPOOL-1) + IIPOOL = IIPOOL - 1 + GO TO 60 + ENDIF + END IF + IF ( NBFINF .eq. 0 ) GOTO 340 + GOTO 50 + 60 CONTINUE + IF ( INODE .EQ. KEEP( 38 ) .OR. INODE .EQ. KEEP( 20 ) ) THEN + IPOS = PTRIST(STEP(INODE))+KEEP(IXSZ) + NPIV = IW(IPOS+3) + LIELL = IW(IPOS) + NPIV + IPOS = PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) + IF ( MTYPE .EQ. 1 .AND. KEEP(50) .EQ. 0) THEN + J1 = IPOS + LIELL + 1 + J2 = IPOS + LIELL + NPIV + ELSE + J1 = IPOS + 1 + J2 = IPOS + NPIV + END IF + IFR = 0 + DO JJ = J1, J2 + J = IW( JJ ) + IFR = IFR + 1 + DO K=1,NRHS + RHS(J,K) = RHS_ROOT(IFR+NPIV*(K-1)) + END DO + END DO + IN = INODE + 270 IN = FILS(IN) + IF (IN .GT. 0) GOTO 270 + IF (IN .EQ. 0) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL ZMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + ENDIF + GOTO 50 + ENDIF + IF = -IN + LONG = NPIV + NBFILS = NE_STEPS(STEP(INODE)) + IF ( AM1 ) THEN + I = NBFILS + NBFILS = 0 + DO WHILE (I.GT.0) + IF ( TO_PROCESS(STEP(IF)) ) NBFILS = NBFILS+1 + IF = FRERE(STEP(IF)) + I = I -1 + ENDDO + IF (NBFILS.EQ.0) THEN + NO_CHILDREN = .TRUE. + ELSE + NO_CHILDREN = .FALSE. + ENDIF + IF = -IN + ENDIF + DEBUT = .TRUE. + DO I = 0, SLAVEF - 1 + DEJA_SEND( I ) = .FALSE. + END DO + POOL_FIRST_POS=IIPOOL + DO I = 1, NBFILS + IF ( AM1 ) THEN + 1030 IF ( .NOT.TO_PROCESS(STEP(IF)) ) THEN + IF = FRERE(STEP(IF)) + GOTO 1030 + ENDIF + NO_CHILDREN = .FALSE. + ENDIF + IF (MUMPS_275(PROCNODE_STEPS(STEP(IF)),SLAVEF) + & .EQ. MYID) THEN + IPOOL(IIPOOL) = IF + IIPOOL = IIPOOL + 1 + ELSE + PROCDEST = MUMPS_275(PROCNODE_STEPS(STEP(IF)), + & SLAVEF) + IF (.NOT. DEJA_SEND( PROCDEST )) THEN + 600 CALL ZMUMPS_78( NRHS, IF, 0, 0, + & LONG, LONG, IW( J1 ), + & RHS_ROOT( 1 ), PROCDEST, + & NOEUD, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL ZMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 340 + GOTO 600 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = LONG * KEEP(35) + + & ( LONG + 2 ) * KEEP(34) + GOTO 330 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = LONG * KEEP(35) + + & ( LONG + 2 ) * KEEP(34) + GOTO 330 + END IF + DEJA_SEND( PROCDEST ) = .TRUE. + END IF + IF ( IERR .NE. 0 ) CALL MUMPS_ABORT() + ENDIF + IF = FRERE(STEP(IF)) + ENDDO + IF (AM1 .AND.NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL ZMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + GOTO 50 + ENDIF + ENDIF + IF (IIPOOL.NE.POOL_FIRST_POS) THEN + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + ENDIF + GOTO 50 + END IF + IN_SUBTREE = MUMPS_170( + & PROCNODE_STEPS(STEP(INODE)), SLAVEF ) + TYPENODE = MUMPS_330(PROCNODE_STEPS(STEP(INODE)), + & SLAVEF) + LTLEVEL2= ( + & (TYPENODE .eq.2 ) .AND. + & (MTYPE.NE.1) ) + NPIV = IW(PTRIST(STEP(INODE))+2+KEEP(IXSZ)+1) + IF ((NPIV.NE.0).AND.(LTLEVEL2)) THEN + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + NELIM = IW(IPOS-1) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + NCB = LIELL - NPIV - NELIM + IPOS = IPOS + 2 + NSLAVES = IW( IPOS ) + Offset = 0 + IPOS = IPOS + NSLAVES + IW(PTRIST(STEP(INODE))+XXS)= C_FINI+NSLAVES + IF ( POSIWCB - 2 .LT. 0 .or. + & POSWCB - NCB*NRHS .LT. PLEFTW - 1 ) THEN + CALL ZMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - NCB*NRHS .LT. PLEFTW - 1 ) THEN + INFO( 1 ) = -11 + INFO( 2 ) = NCB * NRHS - POSWCB - PLEFTW + 1 + GOTO 330 + END IF + IF ( POSIWCB - 2 .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = 2 - POSIWCB + GO TO 330 + END IF + END IF + POSIWCB = POSIWCB - 2 + POSWCB = POSWCB - NCB*NRHS + PTRICB(STEP( INODE )) = POSIWCB + 1 + PTRACB(STEP( INODE )) = POSWCB + 1 + IWCB( PTRICB(STEP( INODE )) ) = NCB + IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 + IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN + POSINDICES = IPOS + LIELL + 1 + ELSE + POSINDICES = IPOS + 1 + END IF + IF ( NCB.EQ.0 ) THEN + write(6,*) ' Internal Error type 2 node with no CB ' + CALL MUMPS_ABORT() + ENDIF + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN + J1 = IPOS + LIELL + NPIV + NELIM +1 + J2 = IPOS + 2 * LIELL + ELSE + J1 = IPOS + NPIV + NELIM +1 + J2 = IPOS + LIELL + END IF + IFR = PTRACB(STEP( INODE )) - 1 + DO JJ = J1, J2 - KEEP(253) + J = IW(JJ) + IFR = IFR + 1 + DO K=1, NRHS + W(IFR+(K-1)*NCB) = RHS(J,K) + ENDDO + ENDDO + IF (KEEP(252).NE.0) THEN + DO JJ = J2-KEEP(253)+1, J2 + IFR = IFR + 1 + DO K=1, NRHS + IF (K.EQ.JJ-J2+KEEP(253)) THEN + W(IFR+(K-1)*NCB) = ALPHA + ELSE + W(IFR+(K-1)*NCB) = ZERO + ENDIF + ENDDO + ENDDO + ENDIF + DO ISLAVE = 1, NSLAVES + CALL MUMPS_49( + & KEEP,KEEP8, INODE, STEP, N, SLAVEF, + & ISTEP_TO_INIV2, TAB_POS_IN_PERE, + & ISLAVE, NCB, + & NSLAVES, + & EffectiveSize, + & FirstIndex ) + 500 DEST = IW( PTRIST(STEP(INODE))+5+ISLAVE+KEEP(IXSZ)) + CALL ZMUMPS_63(NRHS, INODE, + & W(Offset+PTRACB(STEP(INODE))), EffectiveSize, + & NCB, DEST, + & BACKSLV_MASTER2SLAVE, + & COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL ZMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, + & PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 340 + GOTO 500 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = EffectiveSize * KEEP(35) + + & 2 * KEEP(34) + GOTO 330 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = EffectiveSize * KEEP(35) + + & 2 * KEEP(34) + GOTO 330 + END IF + Offset = Offset + EffectiveSize + END DO + IWCB( PTRICB(STEP( INODE )) + 1 ) = 0 + CALL ZMUMPS_151(NRHS,N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB,POSIWCB,PTRICB,PTRACB) + GOTO 50 + ENDIF + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + NELIM = IW(IPOS-1) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + IPOS = IPOS + 1 + IF (KEEP(201).GT.0) THEN + CALL ZMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 330 + ENDIF + ENDIF + APOS = PTRFAC(IW(IPOS)) + NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) ) + IPOS = IPOS + 1 + NSLAVES + IF (KEEP(201).EQ.1) THEN + LIWFAC = IW(PTRIST(STEP(INODE))+XXI) + IF (MTYPE.NE.1) THEN + TYPEF = TYPEF_L + ELSE + TYPEF = TYPEF_U + ENDIF + PANEL_SIZE = ZMUMPS_690( LIELL ) + IF (KEEP(50).NE.1) THEN + CALL ZMUMPS_755( + & IW(IPOS+1+2*LIELL), + & MUST_BE_PERMUTED ) + ENDIF + ENDIF + LONG = 0 + IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN + J1 = IPOS + 1 + J2 = IPOS + NPIV + ELSE + J1 = IPOS + LIELL + 1 + J2 = IPOS + NPIV + LIELL + END IF + IF (IN_SUBTREE) THEN + PTWCB = PLEFTW + IF ( POSWCB .LT. LIELL*NRHS ) THEN + CALL ZMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB .LT. LIELL*NRHS ) THEN + INFO(1) = -11 + INFO(2) = LIELL*NRHS - POSWCB + GOTO 330 + END IF + END IF + ELSE + IF ( POSIWCB - 2 .LT. 0 .or. + & POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + CALL ZMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + INFO( 1 ) = -11 + INFO( 2 ) = LIELL * NRHS - POSWCB - PLEFTW + 1 + GOTO 330 + END IF + IF ( POSIWCB - 2 .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = 2 - POSIWCB + GO TO 330 + END IF + END IF + POSIWCB = POSIWCB - 2 + POSWCB = POSWCB - LIELL*NRHS + PTRICB(STEP( INODE )) = POSIWCB + 1 + PTRACB(STEP( INODE )) = POSWCB + 1 + IWCB( PTRICB(STEP( INODE )) ) = LIELL + IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 + IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN + POSINDICES = IPOS + LIELL + 1 + ELSE + POSINDICES = IPOS + 1 + END IF + PTWCB = PTRACB(STEP( INODE )) + ENDIF + IF (KEEP(252).EQ.0) IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + DO K=1, NRHS + IF (KEEP(252).NE.0) THEN + DO JJ = J1, J2 + W(PTWCB+JJ-J1+(K-1)*LIELL) = ZERO + ENDDO + ELSE + DO JJ = J1, J2 + W(PTWCB+JJ-J1+(K-1)*LIELL) = RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + ENDDO + ENDIF + END DO + IFR = PTWCB + NPIV - 1 + IF ( LIELL .GT. NPIV ) THEN + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN + J1 = IPOS + LIELL + NPIV + 1 + J2 = IPOS + 2 * LIELL + ELSE + J1 = IPOS + NPIV + 1 + J2 = IPOS + LIELL + END IF + DO JJ = J1, J2-KEEP(253) + J = IW(JJ) + IFR = IFR + 1 + DO K=1, NRHS + W(IFR+(K-1)*LIELL) = RHS(J,K) + ENDDO + ENDDO + IF (KEEP(252).NE.0) THEN + DO JJ = J2-KEEP(253)+1, J2 + IFR = IFR + 1 + DO K=1, NRHS + IF (K.EQ.JJ-J2+KEEP(253)) THEN + W(IFR+(K-1)*LIELL) = ALPHA + ELSE + W(IFR+(K-1)*LIELL) = ZERO + ENDIF + ENDDO + ENDDO + ENDIF + NCB = LIELL - NPIV + IF (NPIV .EQ. 0) GOTO 160 + ENDIF + IF (KEEP(201).EQ.1) THEN + J = NPIV / PANEL_SIZE + TWOBYTWO = KEEP(50).EQ.2 .AND. + & ((TYPENODE.EQ.1.AND.KEEP(103).GT.0) .OR. + & (TYPENODE.EQ.2.AND.KEEP(105).GT.0)) + IF (TWOBYTWO) THEN + CALL ZMUMPS_641(PANEL_SIZE, PANEL_POS, LPANEL_POS, + & IW(IPOS+1+LIELL), NPIV, NPANELS, LIELL, + & NBENTRIES_ALLPANELS) + ELSE + IF (NPIV.EQ.J*PANEL_SIZE) THEN + NPIV_LAST = NPIV + NBJLAST = PANEL_SIZE + NPANELS = J + ELSE + NPIV_LAST = (J+1)* PANEL_SIZE + NBJLAST = NPIV-J*PANEL_SIZE + NPANELS = J+1 + ENDIF + NBENTRIES_ALLPANELS = + & int(LIELL,8) * int(NPIV,8) + & - int( ( J * ( J - 1 ) ) / 2,8 ) + & * int(PANEL_SIZE,8) * int(PANEL_SIZE,8) + & - int(J,8) + & * int(mod(NPIV, PANEL_SIZE),8) + & * int(PANEL_SIZE,8) + JJ=NPIV_LAST + ENDIF + APOSDEB = APOS + NBENTRIES_ALLPANELS + DO IPANEL = NPANELS, 1, -1 + IF (TWOBYTWO) THEN + NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL) + BEG_PANEL = PANEL_POS(IPANEL) + ELSE + IF (JJ.EQ.NPIV_LAST) THEN + NBJ = NBJLAST + ELSE + NBJ = PANEL_SIZE + ENDIF + BEG_PANEL = JJ- PANEL_SIZE+1 + ENDIF + LDAJ = LIELL-BEG_PANEL+1 + APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8) + PTWCB_PANEL = PTWCB + BEG_PANEL - 1 + NCB_PANEL = LDAJ - NBJ + IF (KEEP(50).NE.1 .AND. MUST_BE_PERMUTED) THEN + CALL ZMUMPS_667(TYPEF, TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW) + IF (NPIV.EQ.(IW(I_PIVRPTR)-1)) THEN + MUST_BE_PERMUTED=.FALSE. + ELSE + CALL ZMUMPS_698( + & IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)), + & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, + & IW(I_PIVRPTR+IPANEL-1)-1, + & A(APOSDEB), + & LDAJ, NBJ, BEG_PANEL-1) + ENDIF + ENDIF + IF ( NRHS == 1 ) THEN + IF (NCB_PANEL.NE.0) THEN + CALL zgemv( 'T', NCB_PANEL, NBJ, ALPHA, + & A( APOSDEB + int(NBJ,8) ), LDAJ, + & W( NBJ + PTWCB_PANEL ), + & 1, ONE, + & W(PTWCB_PANEL), 1 ) + ENDIF + IF (MTYPE.NE.1) THEN + CALL ztrsv('L','T','U', NBJ, A(APOSDEB), LDAJ, + & W(PTWCB_PANEL), 1) + ELSE + CALL ztrsv('L','T','N', NBJ, A(APOSDEB), LDAJ, + & W(PTWCB_PANEL), 1) + ENDIF + ELSE + IF (NCB_PANEL.NE.0) THEN + CALL zgemm( 'T', 'N', NBJ, NRHS, NCB_PANEL, ALPHA, + & A(APOSDEB +int(NBJ,8)), LDAJ, + & W(NBJ+PTWCB_PANEL),LIELL, + & ONE, W(PTWCB_PANEL),LIELL) + ENDIF + IF (MTYPE.NE.1) THEN + CALL ztrsm('L','L','T','U',NBJ, NRHS, ONE, + & A(APOSDEB), + & LDAJ, W(PTWCB_PANEL), LIELL) + ELSE + CALL ztrsm('L','L','T','N',NBJ, NRHS, ONE, + & A(APOSDEB), + & LDAJ, W(PTWCB_PANEL), LIELL) + ENDIF + ENDIF + IF (.NOT. TWOBYTWO) JJ=BEG_PANEL-1 + ENDDO + ENDIF + IF (KEEP(201).EQ.0.OR.KEEP(201).EQ.2)THEN + IF ( LIELL .GT. NPIV ) THEN + IF ( MTYPE .eq. 1 ) THEN + IST = APOS + int(NPIV,8) + IF (NRHS == 1) THEN + CALL zgemv( 'T', NCB, NPIV, ALPHA, A(IST), LIELL, + & W(NPIV + PTWCB), 1, + & ONE, + & W(PTWCB), 1 ) + ELSE + CALL zgemm('T','N', NPIV, NRHS, NCB, ALPHA, A(IST), LIELL, + & W(NPIV+PTWCB), LIELL, ONE, + & W(PTWCB), LIELL) + ENDIF + ELSE + IF ( KEEP(50) .eq. 0 ) THEN + IST = APOS + int(NPIV,8) * int(LIELL,8) + ELSE + IST = APOS + int(NPIV,8) * int(NPIV,8) + END IF + IF ( NRHS == 1 ) THEN + CALL zgemv( 'N', NPIV, NCB, ALPHA, A( IST ), NPIV, + & W( NPIV + PTWCB ), + & 1, ONE, + & W(PTWCB), 1 ) + ELSE + CALL zgemm( 'N', 'N', NPIV, NRHS, NCB, ALPHA, + & A(IST), NPIV, W(NPIV+PTWCB),LIELL, + & ONE, W(PTWCB),LIELL) + END IF + END IF + ENDIF + IF ( MTYPE .eq. 1 ) THEN + IF ( NRHS == 1 ) THEN + CALL ztrsv('L', 'T', 'N', NPIV, A(APOS), LIELL, + & W(PTWCB), 1) + ELSE + CALL ztrsm('L','L','T','N', NPIV, NRHS, ONE, A(APOS), + & LIELL, W(PTWCB), LIELL) + ENDIF + ELSE + IF ( KEEP(50) .EQ. 0 ) THEN + IF ( NRHS == 1 ) THEN + CALL ztrsv('U','N','U', NPIV, A(APOS), LIELL, + & W(PTWCB), 1) + ELSE + CALL ztrsm('L','U','N','U', NPIV, NRHS, ONE, A(APOS), + & LIELL,W(PTWCB),LIELL) + END IF + ELSE + IF ( NRHS == 1 ) THEN + CALL ztrsv('U','N','U', NPIV, A(APOS), NPIV, + & W(PTWCB), 1) + ELSE + CALL ztrsm('L','U','N','U',NPIV, NRHS, ONE, A(APOS), + & NPIV, W(PTWCB), LIELL) + END IF + END IF + END IF + ENDIF + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0) THEN + J1 = IPOS + LIELL + 1 + ELSE + J1 = IPOS + 1 + END IF + DO 150 I = 1, NPIV + JJ = IW(J1 + I - 1) + DO K=1, NRHS + RHS(JJ, K) = W(PTWCB+I-1+(K-1)*LIELL) + ENDDO + 150 CONTINUE + 160 CONTINUE + IF (KEEP(201).GT.0) THEN + CALL ZMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 330 + ENDIF + ENDIF + IN = INODE + 170 IN = FILS(IN) + IF (IN .GT. 0) GOTO 170 + IF (IN .EQ. 0) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL ZMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + ENDIF + GOTO 50 + ENDIF + IF = -IN + NBFILS = NE_STEPS(STEP(INODE)) + IF (AM1) THEN + I = NBFILS + NBFILS = 0 + DO WHILE (I.GT.0) + IF ( TO_PROCESS(STEP(IF)) ) NBFILS = NBFILS+1 + IF = FRERE(STEP(IF)) + I = I -1 + ENDDO + IF (NBFILS.EQ.0) THEN + NO_CHILDREN = .TRUE. + ELSE + NO_CHILDREN = .FALSE. + ENDIF + IF = -IN + ENDIF + IF (IN_SUBTREE) THEN + DO I = 1, NBFILS + IF ( AM1 ) THEN + 1010 IF ( .NOT.TO_PROCESS(STEP(IF)) ) THEN + IF = FRERE(STEP(IF)) + GOTO 1010 + ENDIF + NO_CHILDREN = .FALSE. + ENDIF + IPOOL((IIPOOL-I+1)+NBFILS-I) = IF + IIPOOL = IIPOOL + 1 + IF = FRERE(STEP(IF)) + ENDDO + IF (AM1 .AND. NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL ZMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + GOTO 50 + ENDIF + ENDIF + ELSE + DEBUT = .TRUE. + DO I = 0, SLAVEF - 1 + DEJA_SEND( I ) = .FALSE. + END DO + POOL_FIRST_POS=IIPOOL + DO 190 I = 1, NBFILS + IF ( AM1 ) THEN +1020 IF ( .NOT.TO_PROCESS(STEP(IF)) ) THEN + IF = FRERE(STEP(IF)) + GOTO 1020 + ENDIF + NO_CHILDREN = .FALSE. + ENDIF + IF (MUMPS_275(PROCNODE_STEPS(STEP(IF)), + & SLAVEF) .EQ. MYID) THEN + IPOOL(IIPOOL) = IF + IIPOOL = IIPOOL + 1 + IF = FRERE(STEP(IF)) + ELSE + PROCDEST = MUMPS_275(PROCNODE_STEPS(STEP(IF)),SLAVEF) + IF (.not. DEJA_SEND( PROCDEST )) THEN + 400 CONTINUE + CALL ZMUMPS_78( NRHS, IF, 0, 0, LIELL, + & LIELL - KEEP(253), + & IW( POSINDICES ), + & W ( PTRACB(STEP( INODE ))), PROCDEST, + & NOEUD, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL ZMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 340 + GOTO 400 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 330 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 330 + END IF + DEJA_SEND( PROCDEST ) = .TRUE. + END IF + IF = FRERE(STEP(IF)) + ENDIF + 190 CONTINUE + IF (AM1 .AND. NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL ZMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + IF (NBFINF .EQ. 0) GOTO 340 + GOTO 50 + ENDIF + ENDIF + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + IWCB(PTRICB(STEP(INODE))+1) = IWCB(PTRICB(STEP(INODE))+1)-1 + CALL ZMUMPS_151(NRHS,N, KEEP(28), IWCB, LIWW, + & W, LWC, + & POSWCB,POSIWCB,PTRICB,PTRACB) + ENDIF + GOTO 50 + 330 CONTINUE + CALL ZMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, TERREUR, + & SLAVEF) + 340 CONTINUE + CALL ZMUMPS_150( MYID,COMM,BUFR, + & LBUFR,LBUFR_BYTES ) + RETURN + END SUBROUTINE ZMUMPS_249 + RECURSIVE SUBROUTINE ZMUMPS_41( + & BLOQ, FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, + & STEP, FRERE, FILS, PROCNODE_STEPS, + & PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, RHS, + & LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IMPLICIT NONE + LOGICAL BLOQ, FLAG + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER MYID, SLAVEF, COMM + INTEGER N, LIWW + INTEGER IWCB( LIWW ) + INTEGER LWC + COMPLEX(kind=8) W( LWC ) + INTEGER POSIWCB, POSWCB + INTEGER IIPOOL, LPOOL + INTEGER IPOOL( LPOOL ) + INTEGER LPANEL_POS + INTEGER PANEL_POS( LPANEL_POS ) + INTEGER NBFINF, INFO(40) + INTEGER PLEFTW, KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER PROCNODE_STEPS( KEEP(28) ), FRERE( KEEP(28) ) + INTEGER PTRICB(KEEP(28)), PTRACB(KEEP(28)), STEP( N ), FILS( N ) + INTEGER LIW + INTEGER(8) :: LA + INTEGER PTRIST(KEEP(28)), IW( LIW ) + INTEGER (8) :: PTRFAC(KEEP(28)) + COMPLEX(kind=8) A( LA ), W2( KEEP(133) ) + INTEGER LRHS, NRHS + COMPLEX(kind=8) RHS(LRHS, NRHS) + INTEGER MYLEAFE, MTYPE + INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28)) + COMPLEX(kind=8) RHSCOMP(LRHSCOMP,NRHS) + INTEGER SIZE_TO_PROCESS + LOGICAL TO_PROCESS(SIZE_TO_PROCESS) + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER MSGSOU, MSGTAG, MSGLEN + INTEGER STATUS( MPI_STATUS_SIZE ), IERR + FLAG = .FALSE. + IF ( BLOQ ) THEN + CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, + & COMM, STATUS, IERR ) + FLAG = .TRUE. + ELSE + CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM, + & FLAG, STATUS, IERR ) + END IF + IF (FLAG) THEN + MSGSOU=STATUS(MPI_SOURCE) + MSGTAG=STATUS(MPI_TAG) + CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR ) + IF ( MSGLEN .GT. LBUFR_BYTES ) THEN + INFO(1) = -20 + INFO(2) = MSGLEN + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + ELSE + CALL MPI_RECV(BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU, + & MSGTAG, COMM, STATUS, IERR) + CALL ZMUMPS_42( MSGTAG, MSGSOU, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, + & KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + END IF + END IF + RETURN + END SUBROUTINE ZMUMPS_41 + RECURSIVE SUBROUTINE ZMUMPS_42( + & MSGTAG, MSGSOU, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + USE ZMUMPS_OOC + USE ZMUMPS_COMM_BUFFER + IMPLICIT NONE + INTEGER MSGTAG, MSGSOU + INTEGER LBUFR, LBUFR_BYTES + INTEGER BUFR( LBUFR ) + INTEGER MYID, SLAVEF, COMM + INTEGER N, LIWW + INTEGER IWCB( LIWW ) + INTEGER LWC + COMPLEX(kind=8) W( LWC ) + INTEGER POSIWCB, POSWCB + INTEGER IIPOOL, LPOOL, LPANEL_POS + INTEGER IPOOL( LPOOL ) + INTEGER PANEL_POS( LPANEL_POS ) + INTEGER NBFINF, INFO(40) + INTEGER PLEFTW, KEEP( 500) + INTEGER(8) KEEP8(150) + INTEGER PTRICB(KEEP(28)), PTRACB(KEEP(28)), STEP( N ), FILS( N ) + INTEGER FRERE(KEEP(28)) + INTEGER PROCNODE_STEPS(KEEP(28)) + INTEGER LIW + INTEGER(8) :: LA + INTEGER IW( LIW ), PTRIST( KEEP(28) ) + INTEGER(8) :: PTRFAC(KEEP(28)) + COMPLEX(kind=8) A( LA ), W2( KEEP(133) ) + INTEGER LRHS, NRHS + COMPLEX(kind=8) RHS(LRHS, NRHS) + INTEGER MYLEAFE, MTYPE + INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28)) + COMPLEX(kind=8) RHSCOMP(LRHSCOMP,NRHS) + INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR + LOGICAL MUST_BE_PERMUTED + INTEGER SIZE_TO_PROCESS + LOGICAL TO_PROCESS(SIZE_TO_PROCESS), NO_CHILDREN + INCLUDE 'mpif.h' + INCLUDE 'mumps_tags.h' + INTEGER POSITION, IF, INODE, IERR, LONG, DUMMY(1) + INTEGER P_UPDATE, P_SOL_MAS, LIELL, K + INTEGER(8) :: APOS, IST + INTEGER NPIV, NROW_L, IPOS, NROW_RECU + INTEGER I, JJ, IN, PROCDEST, J1, J2, IFR, LDA + INTEGER NSLAVES, NELIM, J, POSINDICES, INODEPOS, + & IPOSINRHSCOMP + LOGICAL FLAG + COMPLEX(kind=8) ZERO, ALPHA, ONE + PARAMETER (ZERO=(0.0D0,0.0D0), + & ONE=(1.0D0,0.0D0), + & ALPHA=(-1.0D0,0.0D0)) + INCLUDE 'mumps_headers.h' + INTEGER POOL_FIRST_POS, TMP + LOGICAL DEJA_SEND( 0:SLAVEF-1 ) + INTEGER MUMPS_275 + EXTERNAL MUMPS_275, ztrsv, ztrsm, zgemv, zgemm + INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS + INTEGER LDAJ, NBJ, LIWFAC, + & NBJLAST, NPIV_LAST, PANEL_SIZE, + & PTWCB_PANEL, NCB_PANEL, TYPEF + LOGICAL TWOBYTWO + INTEGER BEG_PANEL + INTEGER IPANEL, NPANELS + IF (MSGTAG .EQ. FEUILLE) THEN + NBFINF = NBFINF - 1 + ELSE IF (MSGTAG .EQ. NOEUD) THEN + POSITION = 0 + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & INODE, 1, MPI_INTEGER, + & COMM, IERR) + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & LONG, 1, MPI_INTEGER, + & COMM, IERR) + IF ( POSIWCB - LONG - 2 .LT. 0 + & .OR. POSWCB - PLEFTW + 1 .LT. LONG ) THEN + CALL ZMUMPS_95(NRHS, N, KEEP(28), IWCB, + & LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ((POSIWCB - LONG - 2 ) .LT. 0) THEN + INFO(1)=-14 + INFO(2)=-POSIWCB + LONG + 2 + WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' + GOTO 260 + END IF + IF ( POSWCB - PLEFTW + 1 .LT. LONG ) THEN + INFO(1) = -11 + INFO(2) = LONG + PLEFTW - POSWCB - 1 + WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' + GOTO 260 + END IF + ENDIF + POSIWCB = POSIWCB - LONG + POSWCB = POSWCB - LONG + IF (LONG .GT. 0) THEN + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & IWCB(POSIWCB + 1), + & LONG, MPI_INTEGER, COMM, IERR) + DO K=1,NRHS + CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION, + & W(POSWCB + 1), LONG, + & MPI_DOUBLE_COMPLEX, COMM, IERR) + DO JJ=0, LONG-1 + RHS(IWCB(POSIWCB+1+JJ),K) = W(POSWCB+1+JJ) + ENDDO + ENDDO + POSIWCB = POSIWCB + LONG + POSWCB = POSWCB + LONG + ENDIF + POOL_FIRST_POS = IIPOOL + IF ( KEEP(237).GT. 0 ) THEN + IF (.NOT.TO_PROCESS(STEP(INODE))) + & GOTO 1010 + ENDIF + IPOOL( IIPOOL ) = INODE + IIPOOL = IIPOOL + 1 + 1010 CONTINUE + IF = FRERE( STEP(INODE) ) + DO WHILE ( IF .GT. 0 ) + IF ( MUMPS_275(PROCNODE_STEPS(STEP(IF)), + & SLAVEF) .eq. MYID ) THEN + IF ( KEEP(237).GT. 0 ) THEN + IF (.NOT.TO_PROCESS(STEP(IF))) THEN + IF = FRERE(STEP(IF)) + CYCLE + ENDIF + ENDIF + IPOOL( IIPOOL ) = IF + IIPOOL = IIPOOL + 1 + END IF + IF = FRERE( STEP( IF ) ) + END DO + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + ELSE IF ( MSGTAG .EQ. BACKSLV_MASTER2SLAVE ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE, 1, MPI_INTEGER, COMM, IERR ) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NROW_RECU, 1, MPI_INTEGER, COMM, IERR ) + IPOS = PTRIST( STEP(INODE) ) + KEEP(IXSZ) + NPIV = - IW( IPOS ) + NROW_L = IW( IPOS + 1 ) + IF (KEEP(201).GT.0) THEN + CALL ZMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + APOS = PTRFAC(IW( IPOS + 3 )) + IF ( NROW_L .NE. NROW_RECU ) THEN + WRITE(*,*) 'Error1 in 41S : NROW L/RECU=',NROW_L, NROW_RECU + CALL MUMPS_ABORT() + END IF + LONG = NROW_L + NPIV + IF ( POSWCB - LONG*NRHS .LT. PLEFTW - 1 ) THEN + CALL ZMUMPS_95(NRHS, N, KEEP(28), IWCB, + & LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - LONG*NRHS .LT. PLEFTW - 1 ) THEN + INFO(1) = -11 + INFO(2) = LONG * NRHS- POSWCB + WRITE(6,*) MYID,' Internal error in bwd solve COMPSO' + GOTO 260 + END IF + END IF + P_UPDATE = PLEFTW + P_SOL_MAS = PLEFTW + NPIV * NRHS + PLEFTW = P_SOL_MAS + NROW_L * NRHS + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & W( P_SOL_MAS+(K-1)*NROW_L),NROW_L, + & MPI_DOUBLE_COMPLEX, + & COMM, IERR ) + ENDDO + IF (KEEP(201).EQ.1) THEN + IF ( NRHS == 1 ) THEN + CALL zgemv( 'T', NROW_L, NPIV, ALPHA, A( APOS ), NROW_L, + & W( P_SOL_MAS ), 1, ZERO, + & W( P_UPDATE ), 1 ) + ELSE + CALL zgemm( 'T', 'N', NPIV, NRHS, NROW_L, ALPHA, A(APOS), + & NROW_L, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ), + & NPIV ) + ENDIF + ELSE + IF ( NRHS == 1 ) THEN + CALL zgemv( 'N', NPIV, NROW_L, ALPHA, A( APOS ), NPIV, + & W( P_SOL_MAS ), 1, ZERO, + & W( P_UPDATE ), 1 ) + ELSE + CALL zgemm( 'N', 'N', NPIV, NRHS, NROW_L, ALPHA, A(APOS), + & NPIV, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ), + & NPIV ) + END IF + ENDIF + IF (KEEP(201).GT.0) THEN + CALL ZMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + PLEFTW = PLEFTW - NROW_L * NRHS + 100 CONTINUE + CALL ZMUMPS_63( NRHS, INODE, W(P_UPDATE), + & NPIV, NPIV, + & MSGSOU, + & BACKSLV_UPDATERHS, + & COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL ZMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 100 + ELSE IF ( IERR .EQ. -2 ) THEN + INFO( 1 ) = -17 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 260 + ELSE IF ( IERR .EQ. -3 ) THEN + INFO( 1 ) = -20 + INFO( 2 ) = NPIV * KEEP(35) + 2 * KEEP(34) + GOTO 260 + END IF + PLEFTW = PLEFTW - NPIV * NRHS + ELSE IF ( MSGTAG .EQ. BACKSLV_UPDATERHS ) THEN + POSITION = 0 + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & INODE, 1, MPI_INTEGER, COMM, IERR ) + IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ) + LIELL = IW(IPOS-2)+IW(IPOS+1) + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & NPIV, 1, MPI_INTEGER, COMM, IERR ) + NELIM = IW(IPOS-1) + IPOS = IPOS + 1 + NPIV = IW(IPOS) + IPOS = IPOS + 1 + NSLAVES = IW( IPOS + 1 ) + IPOS = IPOS + 1 + NSLAVES + INODEPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 4 + IF ( KEEP(50) .eq. 0 ) THEN + LDA = LIELL + ELSE + LDA = NPIV + ENDIF + IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN + J1 = IPOS + 1 + J2 = IPOS + NPIV + ELSE + J1 = IPOS + LIELL + 1 + J2 = IPOS + NPIV + LIELL + END IF + DO K=1, NRHS + CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, + & W2, NPIV, MPI_DOUBLE_COMPLEX, + & COMM, IERR ) + IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + I = 1 + IF ( (KEEP(253).NE.0) .AND. + & (IW(PTRIST(STEP(INODE))+XXS).EQ.C_FINI+NSLAVES) + & ) THEN + DO JJ = J1,J2 + RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = W2(I) + I = I+1 + ENDDO + ELSE + DO JJ = J1,J2 + RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = + & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + W2(I) + I = I+1 + ENDDO + ENDIF + ENDDO + IW(PTRIST(STEP(INODE))+XXS) = + & IW(PTRIST(STEP(INODE))+XXS) - 1 + IF ( IW(PTRIST(STEP(INODE))+XXS).EQ.C_FINI ) THEN + IF (KEEP(201).GT.0) THEN + CALL ZMUMPS_643( + & INODE,PTRFAC,KEEP,A,LA,STEP, + & KEEP8,N,MUST_BE_PERMUTED,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN + CALL ZMUMPS_755( + & IW(IPOS+1+2*LIELL), + & MUST_BE_PERMUTED ) + ENDIF + ENDIF + APOS = PTRFAC(IW(INODEPOS)) + IF (KEEP(201).EQ.1) THEN + LIWFAC = IW(PTRIST(STEP(INODE))+XXI) + TYPEF = TYPEF_L + NROW_L = NPIV+NELIM + PANEL_SIZE = ZMUMPS_690(NROW_L) + IF (PANEL_SIZE.LT.0) THEN + WRITE(6,*) ' Internal error in bwd solve PANEL_SIZE=', + & PANEL_SIZE + CALL MUMPS_ABORT() + ENDIF + ENDIF + IF ( POSIWCB - 2 .LT. 0 .or. + & POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + CALL ZMUMPS_95( NRHS, N, KEEP(28), IWCB, + & LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + IF ( POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN + INFO( 1 ) = -11 + INFO( 2 ) = LIELL * NRHS - POSWCB - PLEFTW + 1 + GOTO 260 + END IF + IF ( POSIWCB - 2 .LT. 0 ) THEN + INFO( 1 ) = -14 + INFO( 2 ) = 2 - POSIWCB + GO TO 260 + END IF + END IF + POSIWCB = POSIWCB - 2 + POSWCB = POSWCB - LIELL*NRHS + PTRICB(STEP( INODE )) = POSIWCB + 1 + PTRACB(STEP( INODE )) = POSWCB + 1 + IWCB( PTRICB(STEP( INODE )) ) = LIELL + IWCB( PTRICB(STEP( INODE )) + 1 ) = 1 + IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 5 + NSLAVES + IF ( MTYPE.EQ.1 .AND. KEEP(50).EQ.0 ) THEN + POSINDICES = IPOS + LIELL + 1 + ELSE + POSINDICES = IPOS + 1 + END IF + IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE)) + IFR = PTRACB(STEP( INODE )) + DO K=1, NRHS + DO JJ = J1, J2 + W(IFR+JJ-J1+(K-1)*LIELL) = + & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + ENDDO + END DO + IFR = PTRACB(STEP(INODE))-1+NPIV + IF ( MTYPE .EQ. 1 .AND. KEEP(50).EQ.0 ) THEN + J1 = IPOS + LIELL + NPIV + 1 + J2 = IPOS + 2 * LIELL + ELSE + J1 = IPOS + NPIV + 1 + J2 = IPOS + LIELL + END IF + DO JJ = J1, J2-KEEP(253) + J = IW(JJ) + IFR = IFR + 1 + DO K=1, NRHS + W(IFR+(K-1)*LIELL) = RHS(J,K) + ENDDO + ENDDO + IF ( KEEP(201).EQ.1 .AND. + & (( NELIM .GT. 0 ).OR. (MTYPE.NE.1 ))) THEN + J = NPIV / PANEL_SIZE + TWOBYTWO = KEEP(50).EQ.2 .AND. KEEP(105).GT.0 + IF (TWOBYTWO) THEN + CALL ZMUMPS_641(PANEL_SIZE, PANEL_POS, + & LPANEL_POS, IW(IPOS+1+LIELL), NPIV, NPANELS, + & NROW_L, NBENTRIES_ALLPANELS) + ELSE + IF (NPIV.EQ.J*PANEL_SIZE) THEN + NPIV_LAST = NPIV + NBJLAST = PANEL_SIZE + NPANELS = J + ELSE + NPIV_LAST = (J+1)* PANEL_SIZE + NBJLAST = NPIV-J*PANEL_SIZE + NPANELS = J+1 + ENDIF + NBENTRIES_ALLPANELS = + & int(NROW_L,8) * int(NPIV,8) + & - int( ( J * ( J - 1 ) ) / 2,8 ) + & * int(PANEL_SIZE,8) * int(PANEL_SIZE,8) + & - int(J,8) + & * int(mod(NPIV, PANEL_SIZE),8) + & * int(PANEL_SIZE,8) + JJ=NPIV_LAST + ENDIF + APOSDEB = APOS + NBENTRIES_ALLPANELS + DO IPANEL=NPANELS,1,-1 + IF (TWOBYTWO) THEN + NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL) + BEG_PANEL = PANEL_POS(IPANEL) + ELSE + IF (JJ.EQ.NPIV_LAST) THEN + NBJ = NBJLAST + ELSE + NBJ = PANEL_SIZE + ENDIF + BEG_PANEL = JJ- PANEL_SIZE+1 + ENDIF + LDAJ = NROW_L-BEG_PANEL+1 + APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8) + PTWCB_PANEL = PTRACB(STEP(INODE)) + BEG_PANEL - 1 + NCB_PANEL = LDAJ - NBJ + IF (KEEP(50).NE.1 .AND.MUST_BE_PERMUTED) THEN + CALL ZMUMPS_667(TYPEF, TMP_NBPANELS, + & I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW) + CALL ZMUMPS_698( + & IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)), + & NPIV-IW(I_PIVRPTR+IPANEL-1)+1, + & IW(I_PIVRPTR+IPANEL-1)-1, + & A(APOSDEB), + & LDAJ, NBJ, BEG_PANEL-1) + ENDIF + IF ( NRHS == 1 ) THEN + IF (NCB_PANEL.NE.0) THEN + CALL zgemv( 'T', NCB_PANEL, NBJ, ALPHA, + & A( APOSDEB + int(NBJ,8) ), LDAJ, + & W( NBJ + PTWCB_PANEL ), + & 1, ONE, + & W(PTWCB_PANEL), 1 ) + ENDIF + CALL ztrsv('L','T','U', NBJ, A(APOSDEB), LDAJ, + & W(PTWCB_PANEL), 1) + ELSE + IF (NCB_PANEL.NE.0) THEN + CALL zgemm( 'T', 'N', NBJ, NRHS, NCB_PANEL, ALPHA, + & A(APOSDEB + int(NBJ,8)), LDAJ, + & W(NBJ+PTWCB_PANEL),LIELL, + & ONE, W(PTWCB_PANEL),LIELL) + ENDIF + CALL ztrsm('L','L','T','U',NBJ, NRHS, ONE, + & A(APOSDEB), + & LDAJ, W(PTWCB_PANEL), LIELL) + ENDIF + IF (.NOT. TWOBYTWO) JJ=BEG_PANEL-1 + ENDDO + GOTO 1234 + ENDIF + IF (NELIM .GT.0) THEN + IF ( KEEP(50) .eq. 0 ) THEN + IST = APOS + int(NPIV,8) * int(LIELL,8) + ELSE + IST = APOS + int(NPIV,8) * int(NPIV,8) + END IF + IF ( NRHS == 1 ) THEN + CALL zgemv( 'N', NPIV, NELIM, ALPHA, + & A( IST ), NPIV, + & W( NPIV + PTRACB(STEP(INODE)) ), + & 1, ONE, + & W(PTRACB(STEP(INODE))), 1 ) + ELSE + CALL zgemm( 'N', 'N', NPIV, NRHS, NELIM, ALPHA, + & A(IST), NPIV, W(NPIV+PTRACB(STEP(INODE))),LIELL, + & ONE, W(PTRACB(STEP(INODE))),LIELL) + END IF + ENDIF + IF ( NRHS == 1 ) THEN + CALL ztrsv( 'U', 'N', 'U', NPIV, A(APOS), LDA, + & W(PTRACB(STEP(INODE))),1) + ELSE + CALL ztrsm( 'L','U', 'N', 'U', NPIV, NRHS, ONE, + & A(APOS), LDA, + & W(PTRACB(STEP(INODE))),LIELL) + END IF + 1234 CONTINUE + IF (KEEP(201).GT.0) THEN + CALL ZMUMPS_598(INODE,PTRFAC,KEEP(28), + & A,LA,.TRUE.,IERR) + IF(IERR.LT.0)THEN + INFO(1)=IERR + INFO(2)=0 + GOTO 260 + ENDIF + ENDIF + IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 6 + NSLAVES + DO I = 1, NPIV + JJ = IW( IPOS + I - 1 ) + DO K=1,NRHS + RHS( JJ, K ) = W( PTRACB(STEP(INODE))+I-1 + & + (K-1)*LIELL ) + ENDDO + END DO + IN = INODE + 200 IN = FILS(IN) + IF (IN .GT. 0) GOTO 200 + IF (IN .EQ. 0) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL ZMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM, + & FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + ENDIF + IWCB( PTRICB(STEP(INODE)) + 1 ) = 0 + CALL ZMUMPS_151(NRHS, N, KEEP(28), + & IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + GOTO 270 + ENDIF + DO I = 0, SLAVEF - 1 + DEJA_SEND( I ) = .FALSE. + END DO + IN = -IN + IF ( KEEP(237).GT.0 ) THEN + NO_CHILDREN = .TRUE. + ELSE + NO_CHILDREN = .FALSE. + ENDIF + DO WHILE (IN.GT.0) + IF ( KEEP(237).GT.0 ) THEN + IF (.NOT.TO_PROCESS(STEP(IN))) THEN + IN = FRERE(STEP(IN)) + CYCLE + ELSE + NO_CHILDREN = .FALSE. + ENDIF + ENDIF + POOL_FIRST_POS = IIPOOL + IF (MUMPS_275(PROCNODE_STEPS(STEP(IN)), + & SLAVEF) .EQ. MYID) THEN + IPOOL(IIPOOL ) = IN + IIPOOL = IIPOOL + 1 + ELSE + PROCDEST = MUMPS_275( PROCNODE_STEPS(STEP(IN)), + & SLAVEF ) + IF ( .NOT. DEJA_SEND( PROCDEST ) ) THEN + 110 CALL ZMUMPS_78( NRHS, IN, 0, 0, + & LIELL, LIELL-KEEP(253), + & IW( POSINDICES ) , + & W( PTRACB(STEP(INODE))), + & PROCDEST, NOEUD, COMM, IERR ) + IF ( IERR .EQ. -1 ) THEN + CALL ZMUMPS_41( + & .FALSE., FLAG, + & BUFR, LBUFR, LBUFR_BYTES, + & MYID, SLAVEF, COMM, + & N, IWCB, LIWW, POSIWCB, + & W, LWC, POSWCB, + & IIPOOL, NBFINF, PTRICB, PTRACB, INFO, + & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP, + & FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8, + & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, + & RHS, LRHS, NRHS, MTYPE, + & RHSCOMP, LRHSCOMP, POSINRHSCOMP + & , TO_PROCESS, SIZE_TO_PROCESS + & ) + IF ( INFO( 1 ) .LT. 0 ) GOTO 270 + GOTO 110 + ELSE IF ( IERR .eq. -2 ) THEN + INFO(1) = -17 + INFO(2) = LIELL * NRHS * KEEP(35) + + & ( LIELL + 2 ) * KEEP(34) + GOTO 260 + ELSE IF ( IERR .eq. -3 ) THEN + INFO(1) = -20 + INFO(2) = LIELL * NRHS * KEEP(35) + + & ( LIELL + 2 ) * KEEP(34) + GOTO 260 + END IF + DEJA_SEND( PROCDEST ) = .TRUE. + END IF + END IF + IN = FRERE( STEP( IN ) ) + END DO + IF (NO_CHILDREN) THEN + MYLEAFE = MYLEAFE - 1 + IF (MYLEAFE .EQ. 0) THEN + CALL ZMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, + & COMM, FEUILLE, SLAVEF ) + NBFINF = NBFINF - 1 + ENDIF + IWCB( PTRICB(STEP(INODE)) + 1 ) = 0 + CALL ZMUMPS_151(NRHS, N, KEEP(28), + & IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + GOTO 270 + ENDIF + DO I=1,(IIPOOL-POOL_FIRST_POS)/2 + TMP=IPOOL(POOL_FIRST_POS+I-1) + IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I) + IPOOL(IIPOOL-I)=TMP + ENDDO + IWCB( PTRICB(STEP( INODE )) + 1 ) = 0 + CALL ZMUMPS_151(NRHS, N, KEEP(28), + & IWCB, LIWW, W, LWC, + & POSWCB, POSIWCB, PTRICB, PTRACB) + END IF + ELSE IF (MSGTAG.EQ.TERREUR) THEN + INFO(1) = -001 + INFO(2) = MSGSOU + GO TO 270 + ELSE IF ( (MSGTAG.EQ.UPDATE_LOAD).OR. + & (MSGTAG.EQ.TAG_DUMMY) ) THEN + GO TO 270 + ELSE + INFO(1) = -100 + INFO(2) = MSGTAG + GOTO 260 + ENDIF + GO TO 270 + 260 CONTINUE + CALL ZMUMPS_44( MYID, SLAVEF, COMM ) + 270 CONTINUE + RETURN + END SUBROUTINE ZMUMPS_42 + SUBROUTINE ZMUMPS_641(PANEL_SIZE, PANEL_POS, + & LEN_PANEL_POS, INDICES, NPIV, + & NPANELS, NFRONT_OR_NASS, + & NBENTRIES_ALLPANELS) + IMPLICIT NONE + INTEGER, intent (in) :: PANEL_SIZE, NPIV + INTEGER, intent (in) :: INDICES(NPIV) + INTEGER, intent (in) :: LEN_PANEL_POS + INTEGER, intent (out) :: NPANELS + INTEGER, intent (out) :: PANEL_POS(LEN_PANEL_POS) + INTEGER, intent (in) :: NFRONT_OR_NASS + INTEGER(8), intent(out):: NBENTRIES_ALLPANELS + INTEGER NPANELS_MAX, I, NBeff + INTEGER(8) :: NBENTRIES_THISPANEL + NBENTRIES_ALLPANELS = 0_8 + NPANELS_MAX = (NPIV+PANEL_SIZE-1)/PANEL_SIZE + IF (LEN_PANEL_POS .LT. NPANELS_MAX + 1) THEN + WRITE(*,*) "Error 1 in ZMUMPS_641", + & LEN_PANEL_POS,NPANELS_MAX + CALL MUMPS_ABORT() + ENDIF + I = 1 + NPANELS = 0 + IF (I .GT. NPIV) RETURN + 10 CONTINUE + NPANELS = NPANELS + 1 + PANEL_POS(NPANELS) = I + NBeff = min(PANEL_SIZE, NPIV-I+1) + IF ( INDICES(I+NBeff-1) < 0) THEN + NBeff=NBeff+1 + ENDIF + NBENTRIES_THISPANEL = int(NFRONT_OR_NASS-I+1,8) * int(NBeff,8) + NBENTRIES_ALLPANELS = NBENTRIES_ALLPANELS + NBENTRIES_THISPANEL + I=I+NBeff + IF ( I .LE. NPIV ) GOTO 10 + PANEL_POS(NPANELS+1)=NPIV+1 + RETURN + END SUBROUTINE ZMUMPS_641 + SUBROUTINE ZMUMPS_286( NRHS, DESCA_PAR, + & CNTXT_PAR,LOCAL_M,LOCAL_N,MBLOCK,NBLOCK, + & IPIV,LPIV,MASTER_ROOT,MYID,COMM, + & RHS_SEQ,SIZE_ROOT,A,INFO,MTYPE,LDLT ) + IMPLICIT NONE + INTEGER NRHS, MTYPE + INTEGER DESCA_PAR( 9 ) + INTEGER LOCAL_M, LOCAL_N, MBLOCK, NBLOCK + INTEGER CNTXT_PAR, MASTER_ROOT, SIZE_ROOT + INTEGER MYID, COMM + INTEGER LPIV, IPIV( LPIV ) + INTEGER INFO(40), LDLT + COMPLEX(kind=8) RHS_SEQ( SIZE_ROOT *NRHS) + COMPLEX(kind=8) A( LOCAL_M, LOCAL_N ) + INTEGER IERR, NPROW, NPCOL, MYROW, MYCOL + INTEGER LOCAL_N_RHS + COMPLEX(kind=8), ALLOCATABLE, DIMENSION( :,: ) ::RHS_PAR + EXTERNAL numroc + INTEGER numroc + INTEGER allocok + CALL blacs_gridinfo( CNTXT_PAR, NPROW, NPCOL, MYROW, MYCOL ) + LOCAL_N_RHS = numroc(NRHS, NBLOCK, MYCOL, 0, NPCOL) + LOCAL_N_RHS = max(1,LOCAL_N_RHS) + ALLOCATE(RHS_PAR(LOCAL_M, LOCAL_N_RHS),stat=allocok) + IF (allocok > 0 ) THEN + WRITE(*,*) ' Problem during solve of the root.' + WRITE(*,*) ' Reduce number of right hand sides.' + CALL MUMPS_ABORT() + ENDIF + CALL ZMUMPS_290( MYID, SIZE_ROOT, NRHS, RHS_SEQ, + & LOCAL_M, LOCAL_N_RHS, + & MBLOCK, NBLOCK, RHS_PAR, MASTER_ROOT, + & NPROW, NPCOL, COMM ) + CALL ZMUMPS_768 (SIZE_ROOT, NRHS, MTYPE, + & A, DESCA_PAR, LOCAL_M, LOCAL_N, LOCAL_N_RHS, + & IPIV, LPIV, RHS_PAR, LDLT, + & MBLOCK, NBLOCK, CNTXT_PAR, + & IERR) + CALL ZMUMPS_156( MYID, SIZE_ROOT, NRHS, + & RHS_SEQ, LOCAL_M, LOCAL_N_RHS, + & MBLOCK, NBLOCK, RHS_PAR, MASTER_ROOT, + & NPROW, NPCOL, COMM ) + DEALLOCATE(RHS_PAR) + RETURN + END SUBROUTINE ZMUMPS_286 + SUBROUTINE ZMUMPS_768 (SIZE_ROOT, NRHS, MTYPE, + & A, DESCA_PAR, LOCAL_M, LOCAL_N, LOCAL_N_RHS, + & IPIV, LPIV, RHS_PAR, LDLT, + & MBLOCK, NBLOCK, CNTXT_PAR, + & IERR) + IMPLICIT NONE + INTEGER, intent (in) :: SIZE_ROOT, NRHS, LDLT, LOCAL_M, + & LOCAL_N, LOCAL_N_RHS, + & MBLOCK, NBLOCK, CNTXT_PAR, MTYPE + INTEGER, intent (in) :: DESCA_PAR( 9 ) + INTEGER, intent (in) :: LPIV, IPIV( LPIV ) + COMPLEX(kind=8), intent (in) :: A( LOCAL_M, LOCAL_N ) + COMPLEX(kind=8), intent (inout) :: RHS_PAR(LOCAL_M, LOCAL_N_RHS) + INTEGER, intent (out) :: IERR + INTEGER :: DESCB_PAR( 9 ) + IERR = 0 + CALL DESCINIT( DESCB_PAR, SIZE_ROOT, + & NRHS, MBLOCK, NBLOCK, 0, 0, + & CNTXT_PAR, LOCAL_M, IERR ) + IF (IERR.NE.0) THEN + WRITE(*,*) 'After DESCINIT, IERR = ', IERR + CALL MUMPS_ABORT() + END IF + IF ( LDLT .eq. 0 .OR. LDLT .eq. 2 ) THEN + IF ( MTYPE .eq. 1 ) THEN + CALL pzgetrs('N',SIZE_ROOT,NRHS,A,1,1,DESCA_PAR,IPIV, + & RHS_PAR,1,1,DESCB_PAR,IERR) + ELSE + CALL pzgetrs('T',SIZE_ROOT,NRHS,A,1,1,DESCA_PAR,IPIV, + & RHS_PAR, 1, 1, DESCB_PAR,IERR) + END IF + ELSE + CALL pzpotrs( 'L', SIZE_ROOT, NRHS, A, 1, 1, DESCA_PAR, + & RHS_PAR, 1, 1, DESCB_PAR, IERR ) + END IF + IF ( IERR .LT. 0 ) THEN + WRITE(*,*) ' Problem during solve of the root' + CALL MUMPS_ABORT() + END IF + RETURN + END SUBROUTINE ZMUMPS_768 diff --git a/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_struc_def.F b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_struc_def.F new file mode 100644 index 000000000..bd95b7e5a --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MUMPS/src/zmumps_struc_def.F @@ -0,0 +1,50 @@ +C +C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 +C +C +C This version of MUMPS is provided to you free of charge. It is public +C domain, based on public domain software developed during the Esprit IV +C European project PARASOL (1996-1999). Since this first public domain +C version in 1999, research and developments have been supported by the +C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, +C INRIA, and University of Bordeaux. +C +C The MUMPS team at the moment of releasing this version includes +C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, +C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora +C Ucar and Clement Weisbecker. +C +C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil +C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, +C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire +C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who +C have been contributing to this project. +C +C Up-to-date copies of the MUMPS package can be obtained +C from the Web pages: +C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS +C +C +C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY +C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. +C +C +C User documentation of any code that uses this software can +C include this complete notice. You can acknowledge (using +C references [1] and [2]) the contribution of this package +C in any scientific publication dependent upon the use of the +C package. You shall use reasonable endeavours to notify +C the authors of the package of this publication. +C +C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, +C A fully asynchronous multifrontal solver using distributed dynamic +C scheduling, SIAM Journal of Matrix Analysis and Applications, +C Vol 23, No 1, pp 15-41 (2001). +C +C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and +C S. Pralet, Hybrid scheduling for the parallel solution of linear +C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). +C + MODULE ZMUMPS_STRUC_DEF + INCLUDE 'zmumps_struc.h' + END MODULE ZMUMPS_STRUC_DEF diff --git a/Ipopt-3.13.4/ThirdParty/Metis/CMakeLists.txt b/Ipopt-3.13.4/ThirdParty/Metis/CMakeLists.txt new file mode 100644 index 000000000..127843e3c --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/Metis/CMakeLists.txt @@ -0,0 +1,131 @@ +cmake_minimum_required(VERSION 2.6) + +project(metis C) + +set(METIS_SRCS Lib/coarsen.c + Lib/fm.c + Lib/initpart.c + Lib/match.c + Lib/ccgraph.c + Lib/memory.c + Lib/pmetis.c + Lib/pqueue.c + Lib/refine.c + Lib/util.c + Lib/timing.c + Lib/debug.c + Lib/bucketsort.c + Lib/graph.c + Lib/stat.c + Lib/kmetis.c + Lib/kwayrefine.c + Lib/kwayfm.c + Lib/balance.c + Lib/ometis.c + Lib/srefine.c + Lib/sfm.c + Lib/separator.c + Lib/mincover.c + Lib/mmd.c + Lib/mesh.c + Lib/meshpart.c + Lib/frename.c + Lib/fortran.c + Lib/myqsort.c + Lib/compress.c + Lib/parmetis.c + Lib/estmem.c + Lib/mpmetis.c + Lib/mcoarsen.c + Lib/mmatch.c + Lib/minitpart.c + Lib/mbalance.c + Lib/mrefine.c + Lib/mutil.c + Lib/mfm.c + Lib/mkmetis.c + Lib/mkwayrefine.c + Lib/mkwayfmh.c + Lib/mrefine2.c + Lib/minitpart2.c + Lib/mbalance2.c + Lib/mfm2.c + Lib/kvmetis.c + Lib/kwayvolrefine.c + Lib/kwayvolfm.c + Lib/subdomains.c) + +#need to add this directory to the includes since metis uses #include<...> for some reason. +include_directories(${CMAKE_CURRENT_SOURCE_DIR}/Lib) + +if (WIN32) + set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} /NODEFAULTLIB}") +endif () + +add_library(metis ${METIS_SRCS}) + +set_target_properties(metis PROPERTIES DEBUG_POSTFIX -d) + +add_executable(pmetis Programs/pmetis.c Programs/io.c) +target_link_libraries(pmetis metis) +if (UNIX) + target_link_libraries(pmetis m) +endif () + +add_executable(kmetis Programs/kmetis.c Programs/io.c) +target_link_libraries(kmetis metis) +if (UNIX) + target_link_libraries(kmetis m) +endif () + +add_executable(oemetis Programs/oemetis.c Programs/io.c Programs/smbfactor.c) +target_link_libraries(oemetis metis) +if (UNIX) + target_link_libraries(oemetis m) +endif () + +add_executable(onmetis Programs/onmetis.c Programs/io.c Programs/smbfactor.c) +target_link_libraries(onmetis metis) +if (UNIX) + target_link_libraries(onmetis m) +endif () + +add_executable(mesh2dual Programs/mesh2dual.c Programs/io.c) +target_link_libraries(mesh2dual metis) +if (UNIX) + target_link_libraries(mesh2dual m) +endif () + +add_executable(mesh2nodal Programs/mesh2nodal.c Programs/io.c) +target_link_libraries(mesh2nodal metis) +if (UNIX) + target_link_libraries(mesh2nodal m) +endif () + +add_executable(partdmesh Programs/partdmesh.c Programs/io.c) +target_link_libraries(partdmesh metis) +if (UNIX) + target_link_libraries(partdmesh m) +endif () + +add_executable(partnmesh Programs/partnmesh.c Programs/io.c) +target_link_libraries(partnmesh metis) +if (UNIX) + target_link_libraries(partnmesh m) +endif () + +add_executable(graphchk Programs/graphchk.c Programs/io.c) +target_link_libraries(graphchk metis) +if (UNIX) + target_link_libraries(graphchk m) +endif () + +add_executable(mtest Test/mtest.c Programs/io.c) +target_link_libraries(mtest metis) +if (UNIX) + target_link_libraries(mtest m) +endif () + +install(TARGETS metis) + +install(TARGETS pmetis kmetis oemetis onmetis mesh2dual mesh2nodal partdmesh partnmesh graphchk) diff --git a/Ipopt-3.13.4/ThirdParty/MinLpTests.cmake b/Ipopt-3.13.4/ThirdParty/MinLpTests.cmake new file mode 100644 index 000000000..4f8a08f07 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/MinLpTests.cmake @@ -0,0 +1,3053 @@ +include(coin-macros) + +set(IPOPT_INSTANCES_DIR "${EP_InstallDir}/MINLPLIB/src/EP_MINLPLIB/nl/") + +# TODO: +# 116 - ampl_carton7_nl_ipopt_minlplib (Timeout) +# 120 - ampl_catmix100_nl_ipopt_minlplib (Failed) +# 154 - ampl_crudeoil_lee1_06_nl_ipopt_minlplib (Timeout) +# 178 - ampl_crudeoil_li02_nl_ipopt_minlplib (Timeout) +# 180 - ampl_crudeoil_li05_nl_ipopt_minlplib (Timeout) +# 215 - ampl_deb8_nl_ipopt_minlplib (Failed) +# 216 - ampl_deb9_nl_ipopt_minlplib (Failed) +# 246 - ampl_eg_all_s_nl_ipopt_minlplib (Failed) +# 251 - ampl_elec200_nl_ipopt_minlplib (Timeout) +# 276 - ampl_ex1244_nl_ipopt_minlplib (Failed) +# 336 - ampl_ex5_3_3_nl_ipopt_minlplib (Failed) +# 521 - ampl_glider200_nl_ipopt_minlplib (Failed) +# 635 - ampl_kall_ellipsoids_tc05a_nl_ipopt_minlplib (Timeout) +# 739 - ampl_nuclear25_nl_ipopt_minlplib (Timeout) +# 742 - ampl_nuclear49_nl_ipopt_minlplib (Timeout) +# 792 - ampl_pb302055_nl_ipopt_minlplib (Timeout) +# 794 - ampl_pb302095_nl_ipopt_minlplib (Timeout) +# 796 - ampl_pb351555_nl_ipopt_minlplib (Timeout) +# 829 - ampl_pooling_bental4stp_nl_ipopt_minlplib (Failed) +# 835 - ampl_pooling_digabel19_nl_ipopt_minlplib (Failed) +# 836 - ampl_pooling_epa1_nl_ipopt_minlplib (Failed) +# 840 - ampl_pooling_foulds2stp_nl_ipopt_minlplib (Failed) +# 846 - ampl_pooling_haverly2stp_nl_ipopt_minlplib (Failed) +# 849 - ampl_pooling_haverly3stp_nl_ipopt_minlplib (Failed) +# 852 - ampl_pooling_rt2stp_nl_ipopt_minlplib (Failed) +# 907 - ampl_qspp_0_12_0_1_10_1_nl_ipopt_minlplib (Failed) +# 1124 - ampl_squfl030_100persp_nl_ipopt_minlplib (Timeout) +# 1128 - ampl_squfl040_080persp_nl_ipopt_minlplib (Timeout) +# 1271 - ampl_super1_nl_ipopt_minlplib (Failed) +# 1279 - ampl_supplychainp1_053050_nl_ipopt_minlplib (Timeout) +# 1381 - ampl_tspn08_nl_ipopt_minlplib (Failed) +# 1388 - ampl_uselinear_nl_ipopt_minlplib (Timeout) +# 1449 - ampl_waterund28_nl_ipopt_minlplib (Timeout) + +set(IPOPT_TEST_LIST 4stufen.nl + abel.nl + alan.nl + alkylation.nl + alkyl.nl + arki0001.nl + arki0002.nl + arki0003.nl + arki0004.nl + arki0005.nl + arki0006.nl + arki0008.nl + arki0009.nl + arki0010.nl + arki0011.nl + arki0012.nl + arki0013.nl + arki0014.nl + arki0015.nl + arki0016.nl + arki0017.nl + arki0018.nl + arki0019.nl + arki0020.nl + arki0021.nl + arki0022.nl + arki0023.nl + arki0024.nl + autocorr_bern20-03.nl + autocorr_bern20-05.nl + autocorr_bern20-10.nl + autocorr_bern20-15.nl + autocorr_bern25-03.nl + autocorr_bern25-06.nl + autocorr_bern25-13.nl + autocorr_bern25-19.nl + autocorr_bern25-25.nl + autocorr_bern30-04.nl + autocorr_bern30-08.nl + autocorr_bern30-15.nl + autocorr_bern30-23.nl + autocorr_bern30-30.nl + autocorr_bern35-04.nl + autocorr_bern35-09.nl + autocorr_bern35-18.nl + autocorr_bern35-26.nl + autocorr_bern35-35fix.nl + autocorr_bern35-35.nl + autocorr_bern40-05.nl + autocorr_bern40-10.nl + autocorr_bern40-20.nl + autocorr_bern40-30.nl + autocorr_bern40-40.nl + autocorr_bern45-05.nl + autocorr_bern45-11.nl + autocorr_bern45-23.nl + autocorr_bern45-34.nl + autocorr_bern45-45.nl + autocorr_bern50-06.nl + autocorr_bern50-13.nl + autocorr_bern50-25.nl + autocorr_bern50-38.nl + autocorr_bern50-50.nl + autocorr_bern55-06.nl + autocorr_bern55-14.nl + autocorr_bern55-28.nl + autocorr_bern55-41.nl + autocorr_bern55-55.nl + autocorr_bern60-08.nl + autocorr_bern60-15.nl + autocorr_bern60-30.nl + autocorr_bern60-45.nl + autocorr_bern60-60.nl + ball_mk2_10.nl + ball_mk2_30.nl + ball_mk3_10.nl + ball_mk3_20.nl + ball_mk3_30.nl + ball_mk4_05.nl + ball_mk4_10.nl + ball_mk4_15.nl + batch0812_nc.nl + batch0812.nl + batchdes.nl + batch_nc.nl + batch.nl + batchs101006m.nl + batchs121208m.nl + batchs151208m.nl + batchs201210m.nl + bayes2_10.nl + bayes2_20.nl + bayes2_30.nl + bayes2_50.nl + bchoco05.nl + bchoco06.nl + bchoco07.nl + bchoco08.nl + bearing.nl + beuster.nl + blend029.nl + blend146.nl + blend480.nl + blend531.nl + blend718.nl + blend721.nl + blend852.nl + btest14.nl + camcns.nl + camshape100.nl + camshape200.nl + camshape400.nl + camshape800.nl + cardqp_inlp.nl + cardqp_iqp.nl + carton7.nl + carton9.nl + casctanks.nl + case_1scv2.nl + catmix100.nl + catmix200.nl + catmix400.nl + catmix800.nl + cecil_13.nl + cesam2log.nl + chain100.nl + chain200.nl + chain400.nl + chain50.nl + chakra.nl + chance.nl + chem.nl + chenery.nl + chp_partload.nl + circle.nl + clay0203h.nl + clay0203m.nl + clay0204h.nl + clay0204m.nl + clay0205h.nl + clay0205m.nl + clay0303h.nl + clay0303m.nl + clay0304h.nl + clay0304m.nl + clay0305h.nl + clay0305m.nl + color_lab2_4x0.nl + color_lab6b_4x20.nl + contvar.nl + crossdock_15x7.nl + crossdock_15x8.nl + crudeoil_lee1_05.nl + crudeoil_lee1_06.nl + crudeoil_lee1_07.nl + crudeoil_lee1_08.nl + crudeoil_lee1_09.nl + crudeoil_lee1_10.nl + crudeoil_lee2_05.nl + crudeoil_lee2_06.nl + crudeoil_lee2_07.nl + crudeoil_lee2_08.nl + crudeoil_lee2_09.nl + crudeoil_lee2_10.nl + crudeoil_lee3_05.nl + crudeoil_lee3_06.nl + crudeoil_lee3_07.nl + crudeoil_lee3_08.nl + crudeoil_lee3_09.nl + crudeoil_lee3_10.nl + crudeoil_lee4_05.nl + crudeoil_lee4_06.nl + crudeoil_lee4_07.nl + crudeoil_lee4_08.nl + crudeoil_lee4_09.nl + crudeoil_lee4_10.nl + crudeoil_li01.nl + crudeoil_li02.nl + crudeoil_li03.nl + crudeoil_li05.nl + crudeoil_li06.nl + crudeoil_li11.nl + crudeoil_li21.nl + csched1a.nl + csched1.nl + csched2a.nl + csched2.nl + cvxnonsep_normcon20.nl + cvxnonsep_normcon20r.nl + cvxnonsep_normcon30.nl + cvxnonsep_normcon30r.nl + cvxnonsep_normcon40.nl + cvxnonsep_normcon40r.nl + cvxnonsep_nsig20.nl + cvxnonsep_nsig20r.nl + cvxnonsep_nsig30.nl + cvxnonsep_nsig30r.nl + cvxnonsep_nsig40.nl + cvxnonsep_nsig40r.nl + cvxnonsep_pcon20.nl + cvxnonsep_pcon20r.nl + cvxnonsep_pcon30.nl + cvxnonsep_pcon30r.nl + cvxnonsep_pcon40.nl + cvxnonsep_pcon40r.nl + cvxnonsep_psig20.nl + cvxnonsep_psig20r.nl + cvxnonsep_psig30.nl + cvxnonsep_psig30r.nl + cvxnonsep_psig40.nl + cvxnonsep_psig40r.nl + deb10.nl + deb6.nl + deb7.nl + deb8.nl + deb9.nl + demo7.nl + densitymod.nl + dispatch.nl + du-opt5.nl + du-opt.nl + edgecross10-010.nl + edgecross10-020.nl + edgecross10-030.nl + edgecross10-040.nl + edgecross10-050.nl + edgecross10-060.nl + edgecross10-070.nl + edgecross10-080.nl + edgecross10-090.nl + edgecross14-019.nl + edgecross14-039.nl + edgecross14-058.nl + edgecross14-078.nl + edgecross14-098.nl + edgecross14-117.nl + edgecross14-137.nl + edgecross14-156.nl + edgecross14-176.nl + edgecross20-040.nl + edgecross20-080.nl + edgecross22-048.nl + edgecross22-096.nl + edgecross24-057.nl + edgecross24-115.nl + eg_all_s.nl + eg_disc2_s.nl + eg_disc_s.nl + eg_int_s.nl + elec100.nl + elec200.nl + elec25.nl + elec50.nl + elf.nl + emfl050_3_3.nl + emfl050_5_5.nl + emfl100_3_3.nl + emfl100_5_5.nl + eniplac.nl + enpro48pb.nl + enpro56pb.nl + eq6_1.nl + etamac.nl + ethanolh.nl + ethanolm.nl + ex1221.nl + ex1222.nl + ex1223a.nl + ex1223b.nl + ex1223.nl + ex1224.nl + ex1225.nl + ex1226.nl + ex1233.nl + ex1243.nl + ex1244.nl + ex1252a.nl + ex1252.nl + ex1263a.nl + ex1263.nl + ex1264a.nl + ex1264.nl + ex1265a.nl + ex1265.nl + ex1266a.nl + ex1266.nl + ex14_1_1.nl + ex14_1_2.nl + ex14_1_3.nl + ex14_1_4.nl + ex14_1_5.nl + ex14_1_6.nl + ex14_1_7.nl + ex14_1_8.nl + ex14_1_9.nl + ex14_2_1.nl + ex14_2_2.nl + ex14_2_3.nl + ex14_2_4.nl + ex14_2_5.nl + ex14_2_6.nl + ex14_2_7.nl + ex14_2_8.nl + ex14_2_9.nl + ex2_1_10.nl + ex2_1_1.nl + ex2_1_2.nl + ex2_1_3.nl + ex2_1_4.nl + ex2_1_5.nl + ex2_1_6.nl + ex2_1_7.nl + ex2_1_8.nl + ex2_1_9.nl + ex3_1_1.nl + ex3_1_2.nl + ex3_1_3.nl + ex3_1_4.nl + ex3pb.nl + ex4_1_1.nl + ex4_1_2.nl + ex4_1_3.nl + ex4_1_4.nl + ex4_1_5.nl + ex4_1_6.nl + ex4_1_7.nl + ex4_1_8.nl + ex4_1_9.nl + ex4.nl + ex5_2_2_case1.nl + ex5_2_2_case2.nl + ex5_2_2_case3.nl + ex5_2_4.nl + ex5_2_5.nl + ex5_3_2.nl + ex5_3_3.nl + ex5_4_2.nl + ex5_4_3.nl + ex5_4_4.nl + ex6_1_1.nl + ex6_1_2.nl + ex6_1_3.nl + ex6_1_4.nl + ex6_2_10.nl + ex6_2_11.nl + ex6_2_12.nl + ex6_2_13.nl + ex6_2_14.nl + ex6_2_5.nl + ex6_2_6.nl + ex6_2_7.nl + ex6_2_8.nl + ex6_2_9.nl + ex7_2_1.nl + ex7_2_2.nl + ex7_2_3.nl + ex7_2_4.nl + ex7_3_1.nl + ex7_3_2.nl + ex7_3_3.nl + ex7_3_4.nl + ex7_3_5.nl + ex7_3_6.nl + ex8_1_1.nl + ex8_1_2.nl + ex8_1_3.nl + ex8_1_4.nl + ex8_1_5.nl + ex8_1_6.nl + ex8_1_7.nl + ex8_2_1b.nl + ex8_2_2b.nl + ex8_2_3b.nl + ex8_2_4b.nl + ex8_2_5b.nl + ex8_3_11.nl + ex8_3_12.nl + ex8_3_13.nl + ex8_3_14.nl + ex8_3_1.nl + ex8_3_2.nl + ex8_3_3.nl + ex8_3_4.nl + ex8_3_5.nl + ex8_3_7.nl + ex8_3_8.nl + ex8_3_9.nl + ex8_4_1.nl + ex8_4_2.nl + ex8_4_3.nl + ex8_4_4.nl + ex8_4_5.nl + ex8_4_6.nl + ex8_4_7.nl + ex8_4_8_bnd.nl + ex8_5_1.nl + ex8_5_2.nl + ex8_5_3.nl + ex8_5_4.nl + ex8_5_5.nl + ex8_5_6.nl + ex8_6_1.nl + ex8_6_2.nl + ex9_1_1.nl + ex9_1_2.nl + ex9_1_4.nl + ex9_1_5.nl + ex9_1_8.nl + ex9_2_2.nl + ex9_2_3.nl + ex9_2_4.nl + ex9_2_5.nl + ex9_2_6.nl + ex9_2_7.nl + ex9_2_8.nl + fac1.nl + fac2.nl + fac3.nl + faclay20h.nl + faclay25.nl + faclay30h.nl + faclay30.nl + faclay33.nl + faclay35.nl + faclay60.nl + faclay70.nl + faclay75.nl + faclay80.nl + fdesign10.nl + fdesign25.nl + fdesign50.nl + feedtray2.nl + feedtray.nl + filter.nl + fin2bb.nl + flay02h.nl + flay02m.nl + flay03h.nl + flay03m.nl + flay04h.nl + flay04m.nl + flay05h.nl + flay05m.nl + flay06h.nl + flay06m.nl + flowchan100fix.nl + flowchan200fix.nl + flowchan400fix.nl + flowchan50fix.nl + fo7_2.nl + fo7_ar2_1.nl + fo7_ar25_1.nl + fo7_ar3_1.nl + fo7_ar4_1.nl + fo7_ar5_1.nl + fo7.nl + fo8_ar2_1.nl + fo8_ar25_1.nl + fo8_ar3_1.nl + fo8_ar4_1.nl + fo8_ar5_1.nl + fo8.nl + fo9_ar2_1.nl + fo9_ar25_1.nl + fo9_ar3_1.nl + fo9_ar4_1.nl + fo9_ar5_1.nl + fo9.nl + fuel.nl + fuzzy.nl + gams01.nl + gams02.nl + gams03.nl + gancns.nl + gasnet.nl + gasoil100.nl + gasoil200.nl + gasoil400.nl + gasoil50.nl + gasprod_sarawak01.nl + gasprod_sarawak16.nl + gasprod_sarawak81.nl + gastrans040.nl + gastrans135.nl + gastrans582_cold13_95.nl + gastrans582_cold13.nl + gastrans582_cold17_95.nl + gastrans582_cold17.nl + gastrans582_cool12_95.nl + gastrans582_cool12.nl + gastrans582_cool14_95.nl + gastrans582_cool14.nl + gastrans582_freezing27_95.nl + gastrans582_freezing27.nl + gastrans582_freezing30_95.nl + gastrans582_freezing30.nl + gastrans582_mild10_95.nl + gastrans582_mild10.nl + gastrans582_mild11_95.nl + gastrans582_mild11.nl + gastrans582_warm15_95.nl + gastrans582_warm15.nl + gastrans582_warm31_95.nl + gastrans582_warm31.nl + gastrans.nl + gbd.nl + gear2.nl + gear3.nl + gear4.nl + gear.nl + genpooling_lee1.nl + genpooling_lee2.nl + genpooling_meyer04.nl + genpooling_meyer10.nl + genpooling_meyer15.nl + ghg_1veh.nl + ghg_2veh.nl + ghg_3veh.nl + gkocis.nl + glider100.nl + glider200.nl + glider400.nl + glider50.nl + graphpart_2g-0044-1601.nl + graphpart_2g-0055-0062.nl + graphpart_2g-0066-0066.nl + graphpart_2g-0077-0077.nl + graphpart_2g-0088-0088.nl + graphpart_2g-0099-9211.nl + graphpart_2g-1010-0824.nl + graphpart_2pm-0044-0044.nl + graphpart_2pm-0055-0055.nl + graphpart_2pm-0066-0066.nl + graphpart_2pm-0077-0777.nl + graphpart_2pm-0088-0888.nl + graphpart_2pm-0099-0999.nl + graphpart_3g-0234-0234.nl + graphpart_3g-0244-0244.nl + graphpart_3g-0333-0333.nl + graphpart_3g-0334-0334.nl + graphpart_3g-0344-0344.nl + graphpart_3g-0444-0444.nl + graphpart_3pm-0234-0234.nl + graphpart_3pm-0244-0244.nl + graphpart_3pm-0333-0333.nl + graphpart_3pm-0334-0334.nl + graphpart_3pm-0344-0344.nl + graphpart_3pm-0444-0444.nl + graphpart_clique-20.nl + graphpart_clique-30.nl + graphpart_clique-40.nl + graphpart_clique-50.nl + graphpart_clique-60.nl + graphpart_clique-70.nl + gsg_0001.nl + gtm.nl + hadamard_4.nl + hadamard_5.nl + hadamard_6.nl + hadamard_7.nl + hadamard_8.nl + hadamard_9.nl + harker.nl + haverly.nl + hda.nl + heatexch_gen1.nl + heatexch_gen2.nl + heatexch_gen3.nl + heatexch_spec1.nl + heatexch_spec2.nl + heatexch_spec3.nl + heatexch_trigen.nl + hhfair.nl + himmel11.nl + himmel16.nl + hmittelman.nl + house.nl + hs62.nl + hvycrash.nl + hybriddynamic_fixedcc.nl + hybriddynamic_fixed.nl + hybriddynamic_varcc.nl + hybriddynamic_var.nl + hydroenergy1.nl + hydroenergy2.nl + hydroenergy3.nl + hydro.nl + ibs2.nl + immun.nl + infeas1.nl + ising2_5-300_5555.nl + jbearing100.nl + jbearing25.nl + jbearing50.nl + jbearing75.nl + jit1.nl + johnall.nl + kall_circles_c6a.nl + kall_circles_c6b.nl + kall_circles_c6c.nl + kall_circles_c7a.nl + kall_circles_c8a.nl + kall_circlespolygons_c1p11.nl + kall_circlespolygons_c1p12.nl + kall_circlespolygons_c1p13.nl + kall_circlespolygons_c1p5a.nl + kall_circlespolygons_c1p5b.nl + kall_circlespolygons_c1p6a.nl + kall_circlesrectangles_c1r11.nl + kall_circlesrectangles_c1r12.nl + kall_circlesrectangles_c1r13.nl + kall_circlesrectangles_c6r1.nl + kall_circlesrectangles_c6r29.nl + kall_circlesrectangles_c6r39.nl + kall_congruentcircles_c31.nl + kall_congruentcircles_c32.nl + kall_congruentcircles_c41.nl + kall_congruentcircles_c42.nl + kall_congruentcircles_c51.nl + kall_congruentcircles_c52.nl + kall_congruentcircles_c61.nl + kall_congruentcircles_c62.nl + kall_congruentcircles_c63.nl + kall_congruentcircles_c71.nl + kall_congruentcircles_c72.nl + kall_diffcircles_10.nl + kall_diffcircles_5a.nl + kall_diffcircles_5b.nl + kall_diffcircles_6.nl + kall_diffcircles_7.nl + kall_diffcircles_8.nl + kall_diffcircles_9.nl + kall_ellipsoids_tc02b.nl + kall_ellipsoids_tc03c.nl + kall_ellipsoids_tc05a.nl + knp3-12.nl + knp4-24.nl + knp5-40.nl + knp5-41.nl + knp5-42.nl + knp5-43.nl + knp5-44.nl + korcns.nl + kport20.nl + kport40.nl + lakes.nl + launch.nl + least.nl + like.nl + linear.nl + lip.nl + lnts100.nl + lnts200.nl + lnts400.nl + lnts50.nl + lop97ic.nl + lop97icx.nl + m3.nl + m6.nl + m7_ar2_1.nl + m7_ar25_1.nl + m7_ar3_1.nl + m7_ar4_1.nl + m7_ar5_1.nl + m7.nl + mathopt1.nl + mathopt2.nl + mathopt3.nl + mathopt4.nl + mathopt5_1.nl + mathopt5_2.nl + mathopt5_3.nl + mathopt5_4.nl + mathopt5_5.nl + mathopt5_6.nl + mathopt5_7.nl + mathopt5_8.nl + mathopt6.nl + maxmineig2.nl + maxmin.nl + mbtd.nl + meanvar.nl + meanvarx.nl + meanvarxsc.nl + methanol100.nl + methanol200.nl + methanol400.nl + methanol50.nl + mhw4d.nl + milinfract.nl + minlphi.nl + minlphix.nl + minsurf100.nl + minsurf25.nl + minsurf50.nl + minsurf75.nl + multiplants_mtg1a.nl + multiplants_mtg1b.nl + multiplants_mtg1c.nl + multiplants_mtg2.nl + multiplants_mtg5.nl + multiplants_mtg6.nl + multiplants_stg1a.nl + multiplants_stg1b.nl + multiplants_stg1c.nl + multiplants_stg1.nl + multiplants_stg5.nl + multiplants_stg6.nl + ndcc12.nl + ndcc12persp.nl + ndcc13.nl + ndcc13persp.nl + ndcc14.nl + ndcc14persp.nl + ndcc15.nl + ndcc15persp.nl + ndcc16.nl + ndcc16persp.nl + nemhaus.nl + netmod_dol1.nl + netmod_dol2.nl + netmod_kar1.nl + netmod_kar2.nl + no7_ar2_1.nl + no7_ar25_1.nl + no7_ar3_1.nl + no7_ar4_1.nl + no7_ar5_1.nl + nous1.nl + nous2.nl + nuclear104.nl + nuclear10a.nl + nuclear10b.nl + nuclear14a.nl + nuclear14b.nl + nuclear14.nl + nuclear25a.nl + nuclear25b.nl + nuclear25.nl + nuclear49a.nl + nuclear49b.nl + nuclear49.nl + nuclearva.nl + nuclearvb.nl + nuclearvc.nl + nuclearvd.nl + nuclearve.nl + nuclearvf.nl + nvs01.nl + nvs02.nl + nvs03.nl + nvs04.nl + nvs05.nl + nvs06.nl + nvs07.nl + nvs08.nl + nvs09.nl + nvs10.nl + nvs11.nl + nvs12.nl + nvs13.nl + nvs14.nl + nvs15.nl + nvs16.nl + nvs17.nl + nvs18.nl + nvs19.nl + nvs20.nl + nvs21.nl + nvs22.nl + nvs23.nl + nvs24.nl + o7_2.nl + o7_ar2_1.nl + o7_ar25_1.nl + o7_ar3_1.nl + o7_ar4_1.nl + o7_ar5_1.nl + o7.nl + o8_ar4_1.nl + o9_ar4_1.nl + oaer.nl + oil2.nl + oil.nl + ortez.nl + orth_d3m6.nl + orth_d3m6_pl.nl + orth_d4m6_pl.nl + otpop.nl + parallel.nl + pb302035.nl + pb302055.nl + pb302075.nl + pb302095.nl + pb351535.nl + pb351555.nl + pb351575.nl + pb351595.nl + pedigree_sp_top4_350tr.nl + pindyck.nl + pinene100.nl + pinene200.nl + pinene50.nl + pointpack02.nl + pointpack04.nl + pointpack06.nl + pointpack08.nl + pointpack10.nl + pointpack12.nl + pointpack14.nl + pollut.nl + polygon100.nl + polygon25.nl + polygon50.nl + polygon75.nl + pooling_adhya1pq.nl + pooling_adhya1stp.nl + pooling_adhya1tp.nl + pooling_adhya2pq.nl + pooling_adhya2stp.nl + pooling_adhya2tp.nl + pooling_adhya3pq.nl + pooling_adhya3stp.nl + pooling_adhya3tp.nl + pooling_adhya4pq.nl + pooling_adhya4stp.nl + pooling_adhya4tp.nl + pooling_bental4pq.nl + pooling_bental4stp.nl + pooling_bental4tp.nl + pooling_bental5pq.nl + pooling_bental5stp.nl + pooling_bental5tp.nl + pooling_digabel16.nl + pooling_digabel19.nl + pooling_epa1.nl + pooling_epa2.nl + pooling_epa3.nl + pooling_foulds2pq.nl + pooling_foulds2stp.nl + pooling_foulds2tp.nl + pooling_haverly1pq.nl + pooling_haverly1stp.nl + pooling_haverly1tp.nl + pooling_haverly2pq.nl + pooling_haverly2stp.nl + pooling_haverly2tp.nl + pooling_haverly3pq.nl + pooling_haverly3stp.nl + pooling_haverly3tp.nl + pooling_rt2pq.nl + pooling_rt2stp.nl + pooling_rt2tp.nl + popdynm100.nl + popdynm200.nl + popdynm25.nl + popdynm50.nl + portfol_buyin.nl + portfol_card.nl + portfol_classical050_1.nl + portfol_classical200_2.nl + portfol_robust050_34.nl + portfol_robust100_09.nl + portfol_robust200_03.nl + portfol_roundlot.nl + portfol_shortfall050_68.nl + portfol_shortfall100_04.nl + portfol_shortfall200_05.nl + powerflow0009p.nl + powerflow0009r.nl + powerflow0014p.nl + powerflow0014r.nl + powerflow0030p.nl + powerflow0030r.nl + powerflow0039p.nl + powerflow0039r.nl + powerflow0057p.nl + powerflow0057r.nl + powerflow0118p.nl + powerflow0118r.nl + powerflow0300p.nl + powerflow0300r.nl + powerflow2383wpp.nl + powerflow2383wpr.nl + powerflow2736spp.nl + powerflow2736spr.nl + primary.nl + prob02.nl + prob03.nl + prob06.nl + prob07.nl + prob09.nl + prob10.nl + process.nl + procsel.nl + procsyn.nl + product2.nl + product.nl + prolog.nl + qap.nl + qapw.nl + qp2.nl + qp3.nl + qp4.nl + qspp_0_10_0_1_10_1.nl + qspp_0_11_0_1_10_1.nl + qspp_0_12_0_1_10_1.nl + ramsey.nl + ravempb.nl + rbrock.nl + risk2bpb.nl + robot100.nl + robot200.nl + robot400.nl + robot50.nl + rocket100.nl + rocket200.nl + rocket400.nl + rocket50.nl + routingdelay_bigm.nl + routingdelay_proj.nl + rsyn0805h.nl + rsyn0805m02h.nl + rsyn0805m02m.nl + rsyn0805m03h.nl + rsyn0805m03m.nl + rsyn0805m04h.nl + rsyn0805m04m.nl + rsyn0805m.nl + rsyn0810h.nl + rsyn0810m02h.nl + rsyn0810m02m.nl + rsyn0810m03h.nl + rsyn0810m03m.nl + rsyn0810m04h.nl + rsyn0810m04m.nl + rsyn0810m.nl + rsyn0815h.nl + rsyn0815m02h.nl + rsyn0815m02m.nl + rsyn0815m03h.nl + rsyn0815m03m.nl + rsyn0815m04h.nl + rsyn0815m04m.nl + rsyn0815m.nl + rsyn0820h.nl + rsyn0820m02h.nl + rsyn0820m02m.nl + rsyn0820m03h.nl + rsyn0820m03m.nl + rsyn0820m04h.nl + rsyn0820m04m.nl + rsyn0820m.nl + rsyn0830h.nl + rsyn0830m02h.nl + rsyn0830m02m.nl + rsyn0830m03h.nl + rsyn0830m03m.nl + rsyn0830m04h.nl + rsyn0830m04m.nl + rsyn0830m.nl + rsyn0840h.nl + rsyn0840m02h.nl + rsyn0840m02m.nl + rsyn0840m03h.nl + rsyn0840m03m.nl + rsyn0840m04h.nl + rsyn0840m04m.nl + rsyn0840m.nl + saa_2.nl + sambal.nl + sample.nl + sep1.nl + sepasequ_complex.nl + sepasequ_convent.nl + sfacloc1_2_80.nl + sfacloc1_2_90.nl + sfacloc1_2_95.nl + sfacloc1_3_80.nl + sfacloc1_3_90.nl + sfacloc1_3_95.nl + sfacloc1_4_80.nl + sfacloc1_4_90.nl + sfacloc1_4_95.nl + sfacloc2_2_80.nl + sfacloc2_2_90.nl + sfacloc2_2_95.nl + sfacloc2_3_80.nl + sfacloc2_3_90.nl + sfacloc2_3_95.nl + sfacloc2_4_80.nl + sfacloc2_4_90.nl + sfacloc2_4_95.nl + shiporig.nl + slay04h.nl + slay04m.nl + slay05h.nl + slay05m.nl + slay06h.nl + slay06m.nl + slay07h.nl + slay07m.nl + slay08h.nl + slay08m.nl + slay09h.nl + slay09m.nl + slay10h.nl + slay10m.nl + smallinvDAXr1b010-011.nl + smallinvDAXr1b020-022.nl + smallinvDAXr1b050-055.nl + smallinvDAXr1b100-110.nl + smallinvDAXr1b150-165.nl + smallinvDAXr1b200-220.nl + smallinvDAXr2b010-011.nl + smallinvDAXr2b020-022.nl + smallinvDAXr2b050-055.nl + smallinvDAXr2b100-110.nl + smallinvDAXr2b150-165.nl + smallinvDAXr2b200-220.nl + smallinvDAXr3b010-011.nl + smallinvDAXr3b020-022.nl + smallinvDAXr3b050-055.nl + smallinvDAXr3b100-110.nl + smallinvDAXr3b150-165.nl + smallinvDAXr3b200-220.nl + smallinvDAXr4b010-011.nl + smallinvDAXr4b020-022.nl + smallinvDAXr4b050-055.nl + smallinvDAXr4b100-110.nl + smallinvDAXr4b150-165.nl + smallinvDAXr4b200-220.nl + smallinvDAXr5b010-011.nl + smallinvDAXr5b020-022.nl + smallinvDAXr5b050-055.nl + smallinvDAXr5b100-110.nl + smallinvDAXr5b150-165.nl + smallinvDAXr5b200-220.nl + smallinvSNPr1b010-011.nl + smallinvSNPr1b020-022.nl + smallinvSNPr1b050-055.nl + smallinvSNPr1b100-110.nl + smallinvSNPr1b150-165.nl + smallinvSNPr1b200-220.nl + smallinvSNPr2b010-011.nl + smallinvSNPr2b020-022.nl + smallinvSNPr2b050-055.nl + smallinvSNPr2b100-110.nl + smallinvSNPr2b150-165.nl + smallinvSNPr2b200-220.nl + smallinvSNPr3b010-011.nl + smallinvSNPr3b020-022.nl + smallinvSNPr3b050-055.nl + smallinvSNPr3b100-110.nl + smallinvSNPr3b150-165.nl + smallinvSNPr3b200-220.nl + smallinvSNPr4b010-011.nl + smallinvSNPr4b020-022.nl + smallinvSNPr4b050-055.nl + smallinvSNPr4b100-110.nl + smallinvSNPr4b150-165.nl + smallinvSNPr4b200-220.nl + smallinvSNPr5b010-011.nl + smallinvSNPr5b020-022.nl + smallinvSNPr5b050-055.nl + smallinvSNPr5b100-110.nl + smallinvSNPr5b150-165.nl + smallinvSNPr5b200-220.nl + sonet22v5.nl + sonet23v4.nl + sonet24v5.nl + sonetgr17.nl + space25a.nl + space25.nl + space960.nl + spectra2.nl + sporttournament06.nl + sporttournament08.nl + sporttournament10.nl + sporttournament12.nl + sporttournament14.nl + sporttournament16.nl + sporttournament18.nl + sporttournament20.nl + sporttournament22.nl + sporttournament24.nl + sporttournament26.nl + sporttournament28.nl + sporttournament30.nl + sporttournament32.nl + sporttournament34.nl + sporttournament36.nl + sporttournament38.nl + sporttournament40.nl + sporttournament42.nl + sporttournament44.nl + sporttournament46.nl + sporttournament48.nl + sporttournament50.nl + spring.nl + squfl010-025.nl + squfl010-025persp.nl + squfl010-040.nl + squfl010-040persp.nl + squfl010-080.nl + squfl010-080persp.nl + squfl015-060.nl + squfl015-060persp.nl + squfl015-080.nl + squfl015-080persp.nl + squfl020-040.nl + squfl020-040persp.nl + squfl020-050.nl + squfl020-050persp.nl + squfl020-150.nl + squfl020-150persp.nl + squfl025-025.nl + squfl025-025persp.nl + squfl025-030.nl + squfl025-030persp.nl + squfl025-040.nl + squfl025-040persp.nl + squfl030-100.nl + squfl030-100persp.nl + squfl030-150.nl + squfl030-150persp.nl + squfl040-080.nl + squfl040-080persp.nl + srcpm.nl + sssd08-04.nl + sssd08-04persp.nl + sssd12-05.nl + sssd12-05persp.nl + sssd15-04.nl + sssd15-04persp.nl + sssd15-06.nl + sssd15-06persp.nl + sssd15-08.nl + sssd15-08persp.nl + sssd16-07.nl + sssd16-07persp.nl + sssd18-06.nl + sssd18-06persp.nl + sssd18-08.nl + sssd18-08persp.nl + sssd20-04.nl + sssd20-04persp.nl + sssd20-08.nl + sssd20-08persp.nl + sssd22-08.nl + sssd22-08persp.nl + sssd25-04.nl + sssd25-04persp.nl + sssd25-08.nl + sssd25-08persp.nl + st_bpaf1a.nl + st_bpaf1b.nl + st_bpk1.nl + st_bpv1.nl + st_bpv2.nl + st_bsj2.nl + st_bsj3.nl + st_bsj4.nl + st_cqpf.nl + st_cqpjk1.nl + st_cqpjk2.nl + st_e01.nl + st_e02.nl + st_e03.nl + st_e04.nl + st_e05.nl + st_e06.nl + st_e07.nl + st_e08.nl + st_e09.nl + st_e11.nl + st_e12.nl + st_e13.nl + st_e14.nl + st_e15.nl + st_e16.nl + st_e17.nl + st_e18.nl + st_e19.nl + st_e21.nl + st_e22.nl + st_e23.nl + st_e24.nl + st_e25.nl + st_e26.nl + st_e27.nl + st_e28.nl + st_e29.nl + st_e30.nl + st_e31.nl + st_e32.nl + st_e33.nl + st_e34.nl + st_e35.nl + st_e36.nl + st_e37.nl + st_e38.nl + st_e40.nl + st_e41.nl + st_e42.nl + st_fp7a.nl + st_fp7b.nl + st_fp7c.nl + st_fp7d.nl + st_fp7e.nl + st_fp8.nl + st_glmp_fp1.nl + st_glmp_fp2.nl + st_glmp_fp3.nl + st_glmp_kk90.nl + st_glmp_kk92.nl + st_glmp_kky.nl + st_glmp_ss1.nl + st_glmp_ss2.nl + st_ht.nl + st_iqpbk1.nl + st_iqpbk2.nl + st_jcbpaf2.nl + st_m1.nl + st_m2.nl + st_miqp1.nl + st_miqp2.nl + st_miqp3.nl + st_miqp4.nl + st_miqp5.nl + stockcycle.nl + st_pan1.nl + st_ph10.nl + st_ph11.nl + st_ph12.nl + st_ph13.nl + st_ph14.nl + st_ph15.nl + st_ph1.nl + st_ph20.nl + st_ph2.nl + st_ph3.nl + st_phex.nl + st_qpc-m0.nl + st_qpc-m1.nl + st_qpc-m3a.nl + st_qpc-m3b.nl + st_qpc-m3c.nl + st_qpc-m4.nl + st_qpk1.nl + st_qpk2.nl + st_qpk3.nl + st_robot.nl + st_rv1.nl + st_rv2.nl + st_rv3.nl + st_rv7.nl + st_rv8.nl + st_rv9.nl + st_test1.nl + st_test2.nl + st_test3.nl + st_test4.nl + st_test5.nl + st_test6.nl + st_test8.nl + st_testgr1.nl + st_testgr3.nl + st_testph4.nl + st_z.nl + super1.nl + super2.nl + super3.nl + super3t.nl + supplychain.nl + supplychainp1_020306.nl + supplychainp1_022020.nl + supplychainp1_030510.nl + supplychainp1_053050.nl + supplychainr1_020306.nl + supplychainr1_022020.nl + supplychainr1_030510.nl + supplychainr1_053050.nl + syn05h.nl + syn05m02h.nl + syn05m02m.nl + syn05m03h.nl + syn05m03m.nl + syn05m04h.nl + syn05m04m.nl + syn05m.nl + syn10h.nl + syn10m02h.nl + syn10m02m.nl + syn10m03h.nl + syn10m03m.nl + syn10m04h.nl + syn10m04m.nl + syn10m.nl + syn15h.nl + syn15m02h.nl + syn15m02m.nl + syn15m03h.nl + syn15m03m.nl + syn15m04h.nl + syn15m04m.nl + syn15m.nl + syn20h.nl + syn20m02h.nl + syn20m02m.nl + syn20m03h.nl + syn20m03m.nl + syn20m04h.nl + syn20m04m.nl + syn20m.nl + syn30h.nl + syn30m02h.nl + syn30m02m.nl + syn30m03h.nl + syn30m03m.nl + syn30m04h.nl + syn30m04m.nl + syn30m.nl + syn40h.nl + syn40m02h.nl + syn40m02m.nl + syn40m03h.nl + syn40m03m.nl + syn40m04h.nl + syn40m04m.nl + syn40m.nl + synheat.nl + synthes1.nl + synthes2.nl + synthes3.nl + tanksize.nl + telecomsp_metro.nl + telecomsp_njlata.nl + telecomsp_nor_sun.nl + telecomsp_pacbell.nl + tln12.nl + tln2.nl + tln4.nl + tln5.nl + tln6.nl + tln7.nl + tloss.nl + tls12.nl + tls2.nl + tls4.nl + tls5.nl + tls6.nl + tls7.nl + tltr.nl + torsion100.nl + torsion25.nl + torsion50.nl + torsion75.nl + transswitch0009p.nl + transswitch0009r.nl + transswitch0014p.nl + transswitch0014r.nl + transswitch0030p.nl + transswitch0030r.nl + transswitch0039p.nl + transswitch0039r.nl + transswitch0057p.nl + transswitch0057r.nl + transswitch0118p.nl + transswitch0118r.nl + transswitch0300p.nl + transswitch0300r.nl + transswitch2383wpp.nl + transswitch2383wpr.nl + transswitch2736spp.nl + transswitch2736spr.nl + tricp.nl + trig.nl + trigx.nl + tspn05.nl + tspn08.nl + tspn10.nl + tspn12.nl + tspn15.nl + turkey.nl + unitcommit1.nl + unitcommit2.nl + uselinear.nl + util.nl + var_con10.nl + var_con5.nl + wager.nl + wall.nl + waste.nl + wastepaper3.nl + wastepaper4.nl + wastepaper5.nl + wastepaper6.nl + wastewater02m1.nl + wastewater02m2.nl + wastewater04m1.nl + wastewater04m2.nl + wastewater05m1.nl + wastewater05m2.nl + wastewater11m1.nl + wastewater11m2.nl + wastewater12m1.nl + wastewater12m2.nl + wastewater13m1.nl + wastewater13m2.nl + wastewater14m1.nl + wastewater14m2.nl + wastewater15m1.nl + wastewater15m2.nl + water3.nl + water4.nl + watercontamination0202.nl + watercontamination0202r.nl + watercontamination0303.nl + watercontamination0303r.nl + waterful2.nl + waternd1.nl + waternd2.nl + water.nl + waterno2_01.nl + waterno2_02.nl + waterno2_03.nl + waterno2_04.nl + waterno2_06.nl + waterno2_09.nl + waterno2_12.nl + waterno2_18.nl + waterno2_24.nl + watersbp.nl + waters.nl + watersym1.nl + watersym2.nl + watertreatnd_conc.nl + watertreatnd_flow.nl + waterund01.nl + waterund08.nl + waterund11.nl + waterund14.nl + waterund17.nl + waterund18.nl + waterund22.nl + waterund25.nl + waterund27.nl + waterund28.nl + waterund32.nl + waterund36.nl + waterx.nl + waterz.nl + weapons.nl + windfac.nl) + +add_ipopt_test_list(ampl ipopt_minlplib IPOPT_TEST_LIST "NL;IPOPT;MINLPLIB" 30) + +if (NOT COIN_TESTS_DISABLE_TIMEOUT) + set_tests_properties(ampl_pb302095_nl_ipopt_minlplib PROPERTIES TIMEOUT 60) + set_tests_properties(ampl_pb302055_nl_ipopt_minlplib PROPERTIES TIMEOUT 60) + set_tests_properties(ampl_pb302035_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_pb351595_nl_ipopt_minlplib PROPERTIES TIMEOUT 60) + set_tests_properties(ampl_pb302075_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_pb351535_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_pb351575_nl_ipopt_minlplib PROPERTIES TIMEOUT 60) + set_tests_properties(ampl_pb351555_nl_ipopt_minlplib PROPERTIES TIMEOUT 60) + set_tests_properties(ampl_telecomsp_nor_sun_nl_ipopt_minlplib PROPERTIES TIMEOUT 2000) + set_tests_properties(ampl_elec200_nl_ipopt_minlplib PROPERTIES TIMEOUT 60) + set_tests_properties(ampl_densitymod_nl_ipopt_minlplib PROPERTIES TIMEOUT 800) + set_tests_properties(ampl_gams03_nl_ipopt_minlplib PROPERTIES TIMEOUT 200) + set_tests_properties(ampl_telecomsp_metro_nl_ipopt_minlplib PROPERTIES TIMEOUT 18000) + set_tests_properties(ampl_supplychainp1_053050_nl_ipopt_minlplib PROPERTIES TIMEOUT 60) + set_tests_properties(ampl_nuclear10b_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_nuclear104_nl_ipopt_minlplib PROPERTIES TIMEOUT 16000) + set_tests_properties(ampl_nuclear10a_nl_ipopt_minlplib PROPERTIES TIMEOUT 360) + set_tests_properties(ampl_arki0011_nl_ipopt_minlplib PROPERTIES TIMEOUT 300) + set_tests_properties(ampl_milinfract_nl_ipopt_minlplib PROPERTIES TIMEOUT 800) + set_tests_properties(ampl_crudeoil_lee2_10_nl_ipopt_minlplib PROPERTIES TIMEOUT 1100) + set_tests_properties(ampl_crudeoil_lee4_07_nl_ipopt_minlplib PROPERTIES TIMEOUT 1900) + set_tests_properties(ampl_gasprod_sarawak81_nl_ipopt_minlplib PROPERTIES TIMEOUT 180) + set_tests_properties(ampl_squfl030_150persp_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_crudeoil_lee4_08_nl_ipopt_minlplib PROPERTIES TIMEOUT 1200) + set_tests_properties(ampl_crudeoil_lee3_09_nl_ipopt_minlplib PROPERTIES TIMEOUT 1000) + set_tests_properties(ampl_arki0009_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_telecomsp_njlata_nl_ipopt_minlplib PROPERTIES TIMEOUT 21600) + set_tests_properties(ampl_supplychainr1_053050_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_crudeoil_lee4_10_nl_ipopt_minlplib PROPERTIES TIMEOUT 7200) + set_tests_properties(ampl_crudeoil_lee4_06_nl_ipopt_minlplib PROPERTIES TIMEOUT 660) + set_tests_properties(ampl_crudeoil_lee3_08_nl_ipopt_minlplib PROPERTIES TIMEOUT 900) + set_tests_properties(ampl_squfl040_080persp_nl_ipopt_minlplib PROPERTIES TIMEOUT 60) + set_tests_properties(ampl_crudeoil_lee3_10_nl_ipopt_minlplib PROPERTIES TIMEOUT 1800) + set_tests_properties(ampl_crudeoil_li21_nl_ipopt_minlplib PROPERTIES TIMEOUT 180) + set_tests_properties(ampl_crudeoil_lee4_05_nl_ipopt_minlplib PROPERTIES TIMEOUT 660) + set_tests_properties(ampl_crudeoil_lee2_07_nl_ipopt_minlplib PROPERTIES TIMEOUT 800) + set_tests_properties(ampl_crudeoil_lee4_09_nl_ipopt_minlplib PROPERTIES TIMEOUT 3600) + set_tests_properties(ampl_crudeoil_lee3_07_nl_ipopt_minlplib PROPERTIES TIMEOUT 800) + set_tests_properties(ampl_crudeoil_lee1_10_nl_ipopt_minlplib PROPERTIES TIMEOUT 180) + set_tests_properties(ampl_crudeoil_lee1_09_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_crudeoil_li11_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_crudeoil_lee2_09_nl_ipopt_minlplib PROPERTIES TIMEOUT 1200) + set_tests_properties(ampl_crudeoil_lee3_06_nl_ipopt_minlplib PROPERTIES TIMEOUT 600) + set_tests_properties(ampl_crudeoil_lee2_06_nl_ipopt_minlplib PROPERTIES TIMEOUT 180) + set_tests_properties(ampl_pooling_epa3_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_crudeoil_lee2_05_nl_ipopt_minlplib PROPERTIES TIMEOUT 240) + set_tests_properties(ampl_crudeoil_lee2_08_nl_ipopt_minlplib PROPERTIES TIMEOUT 600) + set_tests_properties(ampl_crudeoil_li06_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_gasprod_sarawak16_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_crudeoil_li03_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_crudeoil_li05_nl_ipopt_minlplib PROPERTIES TIMEOUT 60) + set_tests_properties(ampl_crudeoil_lee1_07_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_fuzzy_nl_ipopt_minlplib PROPERTIES TIMEOUT 60) + set_tests_properties(ampl_super1_nl_ipopt_minlplib PROPERTIES TIMEOUT 60) + set_tests_properties(ampl_crudeoil_lee1_08_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_case_1scv2_nl_ipopt_minlplib PROPERTIES TIMEOUT 660) + set_tests_properties(ampl_crudeoil_lee3_05_nl_ipopt_minlplib PROPERTIES TIMEOUT 400) + set_tests_properties(ampl_crudeoil_lee1_05_nl_ipopt_minlplib PROPERTIES TIMEOUT 120) + set_tests_properties(ampl_telecomsp_pacbell_nl_ipopt_minlplib PROPERTIES TIMEOUT 2600) +endif () + +set_tests_properties(ampl_arki0012_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_arki0013_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_arki0014_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_casctanks_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_eq6_1_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_heatexch_trigen_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_kall_ellipsoids_tc02b_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_kall_ellipsoids_tc03c_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_lip_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_portfol_buyin_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_portfol_card_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_portfol_roundlot_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_primary_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_st_e04_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_st_e11_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_st_e12_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_st_e15_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_st_e21_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_st_e35_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_watertreatnd_conc_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") +set_tests_properties(ampl_watertreatnd_flow_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;FAIL") + +set_tests_properties(ampl_pb302035_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_pb302075_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_pb351535_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_telecomsp_nor_sun_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_densitymod_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_gams03_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_telecomsp_metro_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_nuclear10b_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_nuclear104_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_nuclear10a_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_arki0011_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_milinfract_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee2_10_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee4_07_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_gasprod_sarawak81_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_squfl030_150persp_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee4_08_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee3_09_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_arki0009_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_telecomsp_njlata_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_supplychainr1_053050_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee4_10_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee4_06_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee3_08_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee3_10_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_li21_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee4_05_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee2_07_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee4_09_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee3_07_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee1_10_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee1_09_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_li11_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee2_09_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee3_06_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee2_06_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_pooling_epa3_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee2_05_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee2_08_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_li06_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_gasprod_sarawak16_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_li03_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee1_07_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee1_08_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_case_1scv2_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee3_05_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_crudeoil_lee1_05_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") +set_tests_properties(ampl_telecomsp_pacbell_nl_ipopt_minlplib PROPERTIES LABELS "NL;IPOPT;MINLPLIB;LONG") + +set_tests_properties(ampl_4stufen_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_abel_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_alan_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_alkylation_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_alkyl_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0001_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0002_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0003_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_arki0004_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0008_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_arki0009_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0010_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0011_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0015_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0016_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_arki0017_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0018_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0019_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0020_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0021_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0022_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_arki0023_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_autocorr_bern20_03_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern20_05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern20_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern20_15_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern25_03_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern25_06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern25_13_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern25_19_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern25_25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern30_04_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern30_08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern30_15_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern30_23_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern30_30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern35_04_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern35_09_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern35_18_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern35_26_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern35_35fix_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern35_35_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern40_05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern40_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern40_20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern40_30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern40_40_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern45_05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern45_11_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern45_23_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern45_34_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern45_45_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern50_06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern50_13_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern50_25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern50_38_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern50_50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern55_06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern55_14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern55_28_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern55_41_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern55_55_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern60_08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern60_15_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern60_30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern60_45_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_autocorr_bern60_60_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ball_mk2_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ball_mk2_30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ball_mk3_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ball_mk3_20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ball_mk3_30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ball_mk4_05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ball_mk4_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ball_mk4_15_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_batch0812_nc_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_batch0812_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_batchdes_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_batch_nc_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_batch_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_batchs101006m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_batchs121208m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_batchs151208m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_batchs201210m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_bayes2_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_bayes2_20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_bayes2_30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_bayes2_50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_bchoco05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_bchoco06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_bchoco07_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_bchoco08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_bearing_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_beuster_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_blend029_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_blend146_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_blend480_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_blend531_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_blend718_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_blend721_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_blend852_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_btest14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_camcns_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_camshape100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_camshape200_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_camshape400_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_camshape800_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cardqp_inlp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cardqp_iqp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_carton7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_carton9_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_case_1scv2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_catmix100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Problem has too few degrees of freedom.") +set_tests_properties(ampl_catmix200_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_catmix400_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_catmix800_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_cecil_13_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cesam2log_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_chain100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_chain200_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_chain400_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_chain50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_chakra_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_chance_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_chem_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_chenery_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_chp_partload_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_circle_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_clay0203h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_clay0203m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_clay0204h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_clay0204m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_clay0205h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_clay0205m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_clay0303h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_clay0303m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_clay0304h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_clay0304m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_clay0305h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_clay0305m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_color_lab2_4x0_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_color_lab6b_4x20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_contvar_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_crossdock_15x7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_crossdock_15x8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_crudeoil_lee1_05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee1_06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_crudeoil_lee1_07_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_crudeoil_lee1_08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_crudeoil_lee1_09_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee1_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_crudeoil_lee2_05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_crudeoil_lee2_06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee2_07_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee2_08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee2_09_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee2_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee3_05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee3_06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee3_07_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee3_08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee3_09_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee3_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee4_05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee4_06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee4_07_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee4_08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee4_09_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_lee4_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_li01_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_crudeoil_li02_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_crudeoil_li03_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_li05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_li06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_li11_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_crudeoil_li21_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_csched1a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_csched1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_csched2a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_csched2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_cvxnonsep_normcon20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_normcon20r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_normcon30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_normcon30r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_normcon40_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_normcon40r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_nsig20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_nsig20r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_nsig30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_nsig30r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_nsig40_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_nsig40r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_pcon20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_pcon20r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_pcon30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_pcon30r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_pcon40_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_pcon40r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_psig20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_psig20r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_psig30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_psig30r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_psig40_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_cvxnonsep_psig40r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_deb10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_deb6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_deb7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_deb8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_deb9_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_demo7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_densitymod_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_dispatch_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_du_opt5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_du_opt_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_edgecross10_010_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross10_020_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross10_030_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross10_040_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross10_050_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross10_060_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross10_070_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross10_080_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross10_090_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross14_019_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross14_039_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross14_058_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross14_078_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross14_098_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross14_117_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross14_137_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross14_156_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross14_176_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross20_040_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross20_080_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross22_048_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross22_096_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross24_057_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_edgecross24_115_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_eg_all_s_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Problem has too few degrees of freedom.") +set_tests_properties(ampl_eg_disc2_s_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_eg_disc_s_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_eg_int_s_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_elec100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_elec200_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_elec25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_elec50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_elf_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_emfl050_3_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_emfl050_5_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_emfl100_3_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_emfl100_5_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_eniplac_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_enpro48pb_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_enpro56pb_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_etamac_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ethanolh_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ethanolm_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1221_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1222_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1223a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1223b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1223_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex1224_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1225_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1226_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1233_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1243_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1244_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed") +set_tests_properties(ampl_ex1252a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1252_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1263a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1263_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1264a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1264_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1265a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1265_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1266a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex1266_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex14_1_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_1_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_1_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_1_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_1_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_1_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_1_7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_1_8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_1_9_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_2_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex14_2_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_2_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex14_2_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_2_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex14_2_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_2_7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex14_2_8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex14_2_9_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex2_1_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex2_1_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex2_1_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex2_1_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex2_1_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex2_1_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex2_1_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex2_1_7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex2_1_8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex2_1_9_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex3_1_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex3_1_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex3_1_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex3_1_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex3pb_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex4_1_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex4_1_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex4_1_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex4_1_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex4_1_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex4_1_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex4_1_7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex4_1_8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex4_1_9_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex5_2_2_case1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex5_2_2_case2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex5_2_2_case3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex5_2_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_ex5_2_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex5_3_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex5_3_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex5_4_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex5_4_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex5_4_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex6_1_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex6_1_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex6_1_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex6_1_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex6_2_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex6_2_11_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex6_2_12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex6_2_13_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex6_2_14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex6_2_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex6_2_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex6_2_7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex6_2_8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex6_2_9_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_ex7_2_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex7_2_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex7_2_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex7_2_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex7_3_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex7_3_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex7_3_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex7_3_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex7_3_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex7_3_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_ex8_1_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex8_1_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_1_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_1_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex8_1_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex8_1_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_1_7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ex8_2_1b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_2_2b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_2_3b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_2_4b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_2_5b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_3_11_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_3_12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_3_13_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_3_14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_3_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_3_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_3_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_3_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_3_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_3_7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_3_8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_3_9_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_4_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_4_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_4_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_4_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_4_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_4_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_4_7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_4_8_bnd_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_5_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_5_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_5_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_5_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_5_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_5_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_6_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex8_6_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex9_1_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_ex9_1_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex9_1_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex9_1_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex9_1_8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_ex9_2_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_ex9_2_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex9_2_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex9_2_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex9_2_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex9_2_7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ex9_2_8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_fac1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_fac2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_fac3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_faclay20h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_faclay25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_faclay30h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_faclay30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_faclay33_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_faclay35_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_faclay60_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_faclay70_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_faclay80_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fdesign10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_fdesign25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_fdesign50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_feedtray2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_feedtray_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_filter_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_fin2bb_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_flay02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_flay02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_flay03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_flay03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_flay04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_flay04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_flay05h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_flay05m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_flay06h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_flay06m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_flowchan100fix_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_flowchan200fix_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_flowchan400fix_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_flowchan50fix_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo7_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo7_ar2_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo7_ar25_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo7_ar3_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo7_ar4_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo7_ar5_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo8_ar2_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo8_ar25_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo8_ar3_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo8_ar4_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo8_ar5_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo9_ar2_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo9_ar25_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo9_ar3_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo9_ar4_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo9_ar5_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fo9_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_fuel_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_fuzzy_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_gams01_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_gams02_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gams03_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_gancns_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gasnet_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gasoil100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gasoil200_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gasoil400_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gasoil50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_gasprod_sarawak01_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_gasprod_sarawak16_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_gasprod_sarawak81_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_gastrans040_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans135_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_cold13_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_cold13_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_cold17_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_cold17_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_cool12_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_cool12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_cool14_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_cool14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_freezing27_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_freezing27_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_freezing30_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_freezing30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_mild10_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_mild10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_mild11_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_mild11_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_warm15_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_warm15_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_warm31_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans582_warm31_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gastrans_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_gbd_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_gear2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_gear3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_gear4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_gear_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_genpooling_lee1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_genpooling_lee2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_genpooling_meyer04_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_genpooling_meyer10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_genpooling_meyer15_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ghg_1veh_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ghg_2veh_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ghg_3veh_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_gkocis_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_glider100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_glider200_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Problem has too few degrees of freedom.") +set_tests_properties(ampl_glider400_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_glider50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_graphpart_2g_0044_1601_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_2g_0055_0062_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_2g_0066_0066_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_2g_0077_0077_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_2g_0088_0088_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_2g_0099_9211_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_2g_1010_0824_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_2pm_0044_0044_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_2pm_0055_0055_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_2pm_0066_0066_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_2pm_0077_0777_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_2pm_0088_0888_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_2pm_0099_0999_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_3g_0234_0234_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_3g_0244_0244_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_3g_0333_0333_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_3g_0334_0334_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_3g_0344_0344_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_3g_0444_0444_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_3pm_0234_0234_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_3pm_0244_0244_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_3pm_0333_0333_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_3pm_0334_0334_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_3pm_0344_0344_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_3pm_0444_0444_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_clique_20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_clique_30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_clique_40_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_clique_50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_clique_60_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_graphpart_clique_70_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_gsg_0001_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_gtm_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_hadamard_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_hadamard_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_hadamard_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_hadamard_7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_hadamard_8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_harker_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_haverly_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_hda_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_heatexch_gen1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_heatexch_gen2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_heatexch_gen3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_heatexch_spec1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_heatexch_spec2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_heatexch_spec3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_hhfair_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_himmel11_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_himmel16_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_hmittelman_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_house_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_hs62_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_hvycrash_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_hybriddynamic_fixedcc_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_hybriddynamic_fixed_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_hybriddynamic_varcc_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_hybriddynamic_var_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_hydroenergy1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_hydroenergy2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_hydroenergy3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_hydro_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ibs2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_immun_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_infeas1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ising2_5_300_5555_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_jbearing100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_jbearing25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_jbearing50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_jbearing75_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_jit1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_johnall_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circles_c6a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circles_c6b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circles_c6c_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circles_c7a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circles_c8a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circlespolygons_c1p11_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circlespolygons_c1p12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circlespolygons_c1p13_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circlespolygons_c1p5a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circlespolygons_c1p5b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_kall_circlespolygons_c1p6a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_kall_circlesrectangles_c1r11_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circlesrectangles_c1r12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circlesrectangles_c1r13_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circlesrectangles_c6r1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_kall_circlesrectangles_c6r29_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_circlesrectangles_c6r39_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_kall_congruentcircles_c31_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_congruentcircles_c32_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_congruentcircles_c41_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_congruentcircles_c42_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_congruentcircles_c51_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_congruentcircles_c52_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_congruentcircles_c61_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_congruentcircles_c62_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_congruentcircles_c63_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_congruentcircles_c71_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_congruentcircles_c72_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_diffcircles_10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_kall_diffcircles_5a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_diffcircles_5b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_diffcircles_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_kall_diffcircles_7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_kall_diffcircles_8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_diffcircles_9_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_kall_ellipsoids_tc05a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_knp3_12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_knp4_24_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_knp5_40_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_knp5_41_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_knp5_42_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_knp5_43_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_knp5_44_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_korcns_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_kport20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_kport40_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_lakes_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_launch_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_least_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_like_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_linear_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_lnts100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_lnts200_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_lnts400_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_lnts50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_lop97ic_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_lop97icx_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_m3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_m6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_m7_ar2_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_m7_ar25_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_m7_ar3_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_m7_ar4_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_m7_ar5_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_m7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_mathopt1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_mathopt2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_mathopt3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_mathopt4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_mathopt5_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_mathopt5_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_mathopt5_3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_mathopt5_4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_mathopt5_5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_mathopt5_6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_mathopt5_7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_mathopt5_8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_mathopt6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_maxmineig2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_maxmin_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_mbtd_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_meanvar_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_meanvarx_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_meanvarxsc_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_methanol100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_methanol200_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_methanol400_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_methanol50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_mhw4d_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_milinfract_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_minlphi_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_minlphix_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_minsurf100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_minsurf25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_minsurf50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_minsurf75_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_multiplants_mtg1a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_multiplants_mtg1b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_multiplants_mtg1c_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_multiplants_mtg2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_multiplants_mtg5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_multiplants_mtg6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_multiplants_stg1a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_multiplants_stg1b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_multiplants_stg1c_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_multiplants_stg1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_multiplants_stg5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_multiplants_stg6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_ndcc12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ndcc12persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ndcc13_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ndcc13persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ndcc14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ndcc14persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ndcc15_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ndcc15persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ndcc16_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ndcc16persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nemhaus_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_netmod_dol1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_netmod_dol2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_netmod_kar1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_netmod_kar2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_no7_ar2_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_no7_ar25_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_no7_ar3_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_no7_ar4_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_no7_ar5_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_nous1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nous2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_nuclear104_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_nuclear10a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclear10b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclear14a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclear14b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclear14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclear25a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclear25b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclear25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclear49a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclear49b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclear49_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclearva_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclearvb_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclearvc_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclearvd_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclearve_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nuclearvf_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs01_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs02_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs03_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs04_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_nvs06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs07_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs09_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs11_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs13_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs15_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs16_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs17_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs18_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs19_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs21_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs22_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs23_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_nvs24_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_o7_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_o7_ar2_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_o7_ar25_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_o7_ar3_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_o7_ar4_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_o7_ar5_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_o7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_o8_ar4_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_o9_ar4_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_oaer_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_oil2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_oil_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ortez_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_orth_d3m6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_orth_d4m6_pl_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_otpop_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_parallel_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_pb302035_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pb302055_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pb302075_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pb302095_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pb351535_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pb351555_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pb351575_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pb351595_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pedigree_sp_top4_350tr_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pindyck_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_pinene100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pinene200_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pinene50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pointpack02_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_pointpack04_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_pointpack06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_pointpack08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_pointpack10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_pointpack12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_pointpack14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_pollut_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_polygon100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_polygon25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_polygon50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_polygon75_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_adhya1pq_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_adhya1stp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_pooling_adhya1tp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_adhya2pq_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_adhya2stp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_pooling_adhya2tp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_adhya3pq_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_adhya3stp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_pooling_adhya3tp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_adhya4pq_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_adhya4tp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_bental4pq_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_bental4stp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_pooling_bental4tp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_bental5pq_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_bental5tp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_digabel16_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_digabel19_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_pooling_epa1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_pooling_epa2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_pooling_epa3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_pooling_foulds2pq_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_foulds2stp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_pooling_foulds2tp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_haverly1pq_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_haverly1stp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_pooling_haverly1tp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_haverly2pq_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_haverly2stp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_haverly2tp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_haverly3pq_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_haverly3stp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_pooling_haverly3tp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_rt2pq_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_rt2stp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_pooling_rt2tp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_popdynm100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_popdynm200_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_popdynm25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_popdynm50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_portfol_classical050_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_portfol_classical200_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_portfol_robust050_34_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_portfol_robust100_09_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_portfol_robust200_03_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_portfol_shortfall050_68_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_portfol_shortfall100_04_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_portfol_shortfall200_05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_powerflow0009p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0009r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0014p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0014r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0030p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0030r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0039p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0039r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0057p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0057r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0118p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0118r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0300p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow0300r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow2383wpp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow2383wpr_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow2736spp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_powerflow2736spr_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_prob02_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_prob03_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_prob06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_prob07_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_prob09_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_prob10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_process_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_procsel_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_procsyn_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_product2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_product_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_prolog_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_qap_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_qapw_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_qp2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_qp3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_qp4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_qspp_0_10_0_1_10_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_qspp_0_11_0_1_10_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_qspp_0_12_0_1_10_1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_ramsey_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_ravempb_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rbrock_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_risk2bpb_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_robot100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Iterates diverging; problem might be unbounded.") +set_tests_properties(ampl_robot200_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Iterates diverging; problem might be unbounded.") +set_tests_properties(ampl_robot400_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Iterates diverging; problem might be unbounded.") +set_tests_properties(ampl_robot50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Iterates diverging; problem might be unbounded.") +set_tests_properties(ampl_rocket100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rocket200_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rocket400_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rocket50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_routingdelay_bigm_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_routingdelay_proj_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_rsyn0805h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0805m02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0805m02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0805m03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0805m03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0805m04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0805m04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0805m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0810h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0810m02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0810m02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0810m03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0810m03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0810m04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0810m04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0810m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0815h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0815m02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0815m02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0815m03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0815m03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0815m04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0815m04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0815m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0820h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0820m02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0820m02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0820m03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0820m03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0820m04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0820m04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0820m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0830h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0830m02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0830m02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0830m03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0830m03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0830m04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0830m04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0830m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0840h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0840m02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0840m02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0840m03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0840m03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0840m04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0840m04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_rsyn0840m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_saa_2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sambal_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sample_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sep1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sepasequ_complex_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sepasequ_convent_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_sfacloc1_2_80_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc1_2_90_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc1_2_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc1_3_80_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc1_3_90_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc1_3_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc1_4_80_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc1_4_90_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc1_4_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc2_2_80_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc2_2_90_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc2_2_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc2_3_80_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc2_3_90_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc2_3_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc2_4_80_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc2_4_90_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sfacloc2_4_95_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_shiporig_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay05h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay05m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay06h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay06m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay07h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay07m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay08h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay08m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay09h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay09m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay10h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_slay10m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_smallinvDAXr1b010_011_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr1b020_022_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr1b050_055_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr1b100_110_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr1b150_165_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr1b200_220_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr2b010_011_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr2b020_022_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr2b050_055_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr2b100_110_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr2b150_165_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr2b200_220_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr3b010_011_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr3b020_022_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr3b050_055_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr3b100_110_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr3b150_165_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr3b200_220_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr4b010_011_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr4b020_022_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr4b050_055_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr4b100_110_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr4b150_165_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr4b200_220_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr5b010_011_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr5b020_022_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr5b050_055_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr5b100_110_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr5b150_165_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvDAXr5b200_220_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr1b010_011_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr1b020_022_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr1b050_055_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr1b100_110_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr1b150_165_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr1b200_220_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr2b010_011_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr2b020_022_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr2b050_055_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr2b100_110_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr2b150_165_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr2b200_220_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr3b010_011_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr3b020_022_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr3b050_055_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr3b100_110_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr3b150_165_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr3b200_220_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr4b010_011_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr4b020_022_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr4b050_055_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr4b100_110_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr4b150_165_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr4b200_220_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr5b010_011_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr5b020_022_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr5b050_055_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr5b100_110_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr5b150_165_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_smallinvSNPr5b200_220_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sonet22v5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sonet23v4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sonet24v5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sonetgr17_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_space25a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_space25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_space960_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_spectra2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament16_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament18_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament22_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament24_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament26_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament28_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament32_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament34_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament36_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament38_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament40_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament42_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament44_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament46_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament48_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_sporttournament50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_spring_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl010_025_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl010_025persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl010_040_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl010_040persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl010_080_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl010_080persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl015_060_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl015_060persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl015_080_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl015_080persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl020_040_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl020_040persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl020_050_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl020_050persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl020_150_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl020_150persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl025_025_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl025_025persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl025_030_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl025_030persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl025_040_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl025_040persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl030_100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl030_100persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl030_150_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl030_150persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_squfl040_080_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_squfl040_080persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_srcpm_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd08_04_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd08_04persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd12_05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd12_05persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd15_04_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd15_04persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd15_06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd15_06persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd15_08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd15_08persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd16_07_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd16_07persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd18_06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd18_06persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd18_08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd18_08persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd20_04_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd20_04persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd20_08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd20_08persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd22_08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd22_08persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd25_04_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd25_04persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd25_08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_sssd25_08persp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_bpaf1a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_bpaf1b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_bpk1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_bpv1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_bpv2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_bsj2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_bsj3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_bsj4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_cqpf_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_cqpjk1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_cqpjk2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e01_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e02_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_st_e03_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_e07_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e09_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e13_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_e16_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e17_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e18_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_e19_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e22_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e23_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e24_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e26_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e27_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e28_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e29_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e30_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_e31_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e32_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e33_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e34_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e36_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_st_e37_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_e38_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e40_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_st_e41_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_e42_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_fp7a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_fp7b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_fp7c_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_fp7d_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_fp7e_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_fp8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_glmp_fp1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_glmp_fp2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_glmp_fp3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_glmp_kk90_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_glmp_kk92_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_glmp_kky_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_glmp_ss1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_glmp_ss2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_ht_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_iqpbk1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_iqpbk2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_jcbpaf2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_m1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_m2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_miqp1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_miqp2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_miqp3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_miqp4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_miqp5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_stockcycle_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_pan1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_ph10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_ph11_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_ph12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_ph13_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_ph14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_ph15_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_ph1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_ph20_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_ph2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_ph3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_phex_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_qpc_m0_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_qpc_m1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_qpc_m3a_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_qpc_m3b_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_qpc_m3c_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_qpc_m4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_qpk1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_qpk2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_qpk3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_robot_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_st_rv1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_rv2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_rv3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_rv7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_rv8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_rv9_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_test1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_test2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_test3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_test4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_test5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_test6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_test8_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_testgr1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_testgr3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_testph4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_st_z_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_super1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_super2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_super3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_super3t_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_supplychain_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_supplychainp1_020306_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_supplychainp1_022020_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_supplychainp1_030510_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_supplychainp1_053050_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_supplychainr1_020306_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_supplychainr1_022020_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_supplychainr1_030510_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Solved To Acceptable Level.") +set_tests_properties(ampl_supplychainr1_053050_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_syn05h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn05m02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn05m02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn05m03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn05m03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn05m04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn05m04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn05m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn10h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn10m02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn10m02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn10m03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn10m03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn10m04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn10m04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn10m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn15h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn15m02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn15m02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn15m03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn15m03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn15m04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn15m04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn15m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn20h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn20m02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn20m02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn20m03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn20m03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn20m04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn20m04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn20m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn30h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn30m02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn30m02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn30m03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn30m03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn30m04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn30m04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn30m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn40h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn40m02h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn40m02m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn40m03h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn40m03m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn40m04h_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn40m04m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_syn40m_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_synheat_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_synthes1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_synthes2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Restoration Failed!") +set_tests_properties(ampl_synthes3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tanksize_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_telecomsp_metro_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_telecomsp_njlata_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_telecomsp_nor_sun_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Not enough memory.") +set_tests_properties(ampl_telecomsp_pacbell_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Converged to a point of local infeasibility. Problem may be infeasible.") +set_tests_properties(ampl_tln12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tln2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tln4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tln5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tln6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tln7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tloss_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tls12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tls2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tls4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tls5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tls6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tls7_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tltr_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_torsion100_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_torsion25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_torsion50_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_torsion75_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0009p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0009r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0014p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0014r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0030p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0030r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0039p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0039r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0057p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0057r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0118p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0118r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0300p_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch0300r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch2383wpp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch2383wpr_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch2736spp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_transswitch2736spr_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_tricp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_trig_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_trigx_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_tspn05_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tspn08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tspn10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tspn12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_tspn15_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Maximum Number of Iterations Exceeded.") +set_tests_properties(ampl_turkey_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_unitcommit1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_unitcommit2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_uselinear_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_util_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_var_con10_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_var_con5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wager_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_wall_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waste_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_wastepaper3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastepaper4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastepaper5_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastepaper6_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater02m1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater02m2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater04m1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater05m1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater11m1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater11m2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater12m1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater12m2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater13m1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater13m2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater14m1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater14m2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_wastewater15m1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_water3_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_water4_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_watercontamination0202_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_watercontamination0202r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_watercontamination0303_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_watercontamination0303r_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_waterful2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_waternd1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waternd2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_water_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_waterno2_01_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterno2_02_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterno2_03_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterno2_04_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterno2_06_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterno2_09_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterno2_12_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterno2_18_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterno2_24_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_watersbp_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_waters_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_watersym1_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_watersym2_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_waterund01_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterund08_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterund11_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterund14_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterund17_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterund18_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterund22_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterund25_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterund27_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterund28_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterund32_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterund36_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_waterx_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_waterz_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") +set_tests_properties(ampl_weapons_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Optimal Solution Found.") +set_tests_properties(ampl_windfac_nl_ipopt_minlplib PROPERTIES PASS_REGULAR_EXPRESSION "EXIT: Invalid number in NLP function or derivative detected.") diff --git a/Ipopt-3.13.4/ThirdParty/f2c.h b/Ipopt-3.13.4/ThirdParty/f2c.h new file mode 100644 index 000000000..0b1ebac99 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/f2c.h @@ -0,0 +1,223 @@ +/* f2c.h -- Standard Fortran to C header file */ + +/** barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed." + + - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */ + +#ifndef F2C_INCLUDE +#define F2C_INCLUDE + +typedef int integer; +typedef unsigned int uinteger; +typedef char *address; +typedef short int shortint; +typedef float real; +typedef double doublereal; +typedef struct { real r, i; } complex; +typedef struct { doublereal r, i; } doublecomplex; +typedef long int logical; +typedef short int shortlogical; +typedef char logical1; +typedef char integer1; +#ifdef INTEGER_STAR_8 /* Adjust for integer*8. */ +typedef long long longint; /* system-dependent */ +typedef unsigned long long ulongint; /* system-dependent */ +#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b))) +#define qbit_set(a,b) ((a) | ((ulongint)1 << (b))) +#endif + +#define TRUE_ (1) +#define FALSE_ (0) + +/* Extern is for use with -E */ +#ifndef Extern +#define Extern extern +#endif + +/* I/O stuff */ + +#ifdef f2c_i2 +/* for -i2 */ +typedef short flag; +typedef short ftnlen; +typedef short ftnint; +#else +typedef long int flag; +typedef long int ftnlen; +typedef long int ftnint; +#endif + +/*external read, write*/ +typedef struct +{ flag cierr; + ftnint ciunit; + flag ciend; + char *cifmt; + ftnint cirec; +} cilist; + +/*internal read, write*/ +typedef struct +{ flag icierr; + char *iciunit; + flag iciend; + char *icifmt; + ftnint icirlen; + ftnint icirnum; +} icilist; + +/*open*/ +typedef struct +{ flag oerr; + ftnint ounit; + char *ofnm; + ftnlen ofnmlen; + char *osta; + char *oacc; + char *ofm; + ftnint orl; + char *oblnk; +} olist; + +/*close*/ +typedef struct +{ flag cerr; + ftnint cunit; + char *csta; +} cllist; + +/*rewind, backspace, endfile*/ +typedef struct +{ flag aerr; + ftnint aunit; +} alist; + +/* inquire */ +typedef struct +{ flag inerr; + ftnint inunit; + char *infile; + ftnlen infilen; + ftnint *inex; /*parameters in standard's order*/ + ftnint *inopen; + ftnint *innum; + ftnint *innamed; + char *inname; + ftnlen innamlen; + char *inacc; + ftnlen inacclen; + char *inseq; + ftnlen inseqlen; + char *indir; + ftnlen indirlen; + char *infmt; + ftnlen infmtlen; + char *inform; + ftnint informlen; + char *inunf; + ftnlen inunflen; + ftnint *inrecl; + ftnint *innrec; + char *inblank; + ftnlen inblanklen; +} inlist; + +#define VOID void + +union Multitype { /* for multiple entry points */ + integer1 g; + shortint h; + integer i; + /* longint j; */ + real r; + doublereal d; + complex c; + doublecomplex z; + }; + +typedef union Multitype Multitype; + +/*typedef long int Long;*/ /* No longer used; formerly in Namelist */ + +struct Vardesc { /* for Namelist */ + char *name; + char *addr; + ftnlen *dims; + int type; + }; +typedef struct Vardesc Vardesc; + +struct Namelist { + char *name; + Vardesc **vars; + int nvars; + }; +typedef struct Namelist Namelist; + +#define abs(x) ((x) >= 0 ? (x) : -(x)) +#define dabs(x) (doublereal)abs(x) +#define min(a,b) ((a) <= (b) ? (a) : (b)) +#define max(a,b) ((a) >= (b) ? (a) : (b)) +#define dmin(a,b) (doublereal)min(a,b) +#define dmax(a,b) (doublereal)max(a,b) +#define bit_test(a,b) ((a) >> (b) & 1) +#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b))) +#define bit_set(a,b) ((a) | ((uinteger)1 << (b))) + +/* procedure parameter types for -A and -C++ */ + +#define F2C_proc_par_types 1 +#ifdef __cplusplus +typedef int /* Unknown procedure type */ (*U_fp)(...); +typedef shortint (*J_fp)(...); +typedef integer (*I_fp)(...); +typedef real (*R_fp)(...); +typedef doublereal (*D_fp)(...), (*E_fp)(...); +typedef /* Complex */ VOID (*C_fp)(...); +typedef /* Double Complex */ VOID (*Z_fp)(...); +typedef logical (*L_fp)(...); +typedef shortlogical (*K_fp)(...); +typedef /* Character */ VOID (*H_fp)(...); +typedef /* Subroutine */ int (*S_fp)(...); +#else +typedef int /* Unknown procedure type */ (*U_fp)(); +typedef shortint (*J_fp)(); +typedef integer (*I_fp)(); +typedef real (*R_fp)(); +typedef doublereal (*D_fp)(), (*E_fp)(); +typedef /* Complex */ VOID (*C_fp)(); +typedef /* Double Complex */ VOID (*Z_fp)(); +typedef logical (*L_fp)(); +typedef shortlogical (*K_fp)(); +typedef /* Character */ VOID (*H_fp)(); +typedef /* Subroutine */ int (*S_fp)(); +#endif +/* E_fp is for real functions when -R is not specified */ +typedef VOID C_f; /* complex function */ +typedef VOID H_f; /* character function */ +typedef VOID Z_f; /* double complex function */ +typedef doublereal E_f; /* real function with -R not specified */ + +/* undef any lower-case symbols that your C compiler predefines, e.g.: */ + +#ifndef Skip_f2c_Undefs +#undef cray +#undef gcos +#undef mc68010 +#undef mc68020 +#undef mips +#undef pdp11 +#undef sgi +#undef sparc +#undef sun +#undef sun2 +#undef sun3 +#undef sun4 +#undef u370 +#undef u3b +#undef u3b2 +#undef u3b5 +#undef unix +#undef vax +#endif +#endif diff --git a/Ipopt-3.13.4/ThirdParty/mumps.patch b/Ipopt-3.13.4/ThirdParty/mumps.patch new file mode 100644 index 000000000..6be9a10c7 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/mumps.patch @@ -0,0 +1,45 @@ +--- /home/stefan/work/coin/CoinAll-trunk/ThirdParty/Mumps/MUMPS/src/dmumps_part2.F 2011-05-10 14:57:26.000000000 +0200 ++++ MUMPS/src/dmumps_part2.F 2013-04-26 12:21:16.000000000 +0200 +@@ -1146,7 +1146,7 @@ + IF ( (KEEP(50).EQ.2) + & .AND. (KEEP(95) .EQ. 3) + & .AND. (IORD .EQ. 7) ) THEN +- IORD = 2 ++ IORD = 0 + ENDIF + CALL DMUMPS_701( N, KEEP(50), NSLAVES, IORD, + & symmetry, MedDens, NBQD, AvgDens, +@@ -1162,8 +1162,13 @@ + IF(KEEP(95) .EQ. 2 .AND. IORD .EQ. 0) THEN + IF (PROK) WRITE(MP,*) + & 'WARNING: DMUMPS_195 AMD not available with ', +- & ' compressed ordering -> move to QAMD' +- IORD = 6 ++#if defined(metis) || defined(parmetis) ++ & 'compressed ordering -> move to METIS' ++ IORD = 5 ++#else ++ & 'compressed ordering -> move to AMF' ++ IORD = 2 ++#endif + ENDIF + ELSE + KEEP(95) = 1 +@@ -3642,7 +3647,7 @@ + IF (NBQD.GE.MAXQD) THEN + IORD = 6 + ELSE +- IORD = 2 ++ IORD = 0 + ENDIF + ELSE + IF (NBQD.GE.MedDens*NPROCS) THEN +@@ -3668,7 +3673,7 @@ + IF (NBQD.GE.MAXQD) THEN + IORD = 6 + ELSE +- IORD = 2 ++ IORD = 0 + ENDIF + ELSE + IF (NBQD.GE.MedDens*NPROCS) THEN diff --git a/Ipopt-3.13.4/ThirdParty/mumps_mpi.patch b/Ipopt-3.13.4/ThirdParty/mumps_mpi.patch new file mode 100644 index 000000000..86f9e1f76 --- /dev/null +++ b/Ipopt-3.13.4/ThirdParty/mumps_mpi.patch @@ -0,0 +1,67 @@ +--- a/MUMPS/examples/c_example.c 2011-05-10 08:56:40.000000000 -0400 ++++ MUMPS/examples/c_example.c 2016-11-25 05:20:40.562687719 -0500 +@@ -10,7 +10,11 @@ + * Solution is [1 2]^T */ + #include + #include ++#ifdef MPI + #include "mpi.h" ++#else ++#include "mumps_mpi.h" ++#endif + #include "dmumps_c.h" + #define JOB_INIT -1 + #define JOB_END -2 +--- a/MUMPS/libseq/mpic.c 2011-05-10 08:56:39.000000000 -0400 ++++ MUMPS/libseq/mpic.c 2016-11-25 05:17:47.318664538 -0500 +@@ -47,7 +47,7 @@ + * systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). + * + */ +-#include ++#include "mumps_mpi.h" + int MPI_Init(int *pargc, char ***pargv) + { + return 0; +--- a/MUMPS/src/mumps_orderings.c 2011-05-10 08:56:41.000000000 -0400 ++++ MUMPS/src/mumps_orderings.c 2016-11-25 05:22:56.511565349 -0500 +@@ -347,7 +347,12 @@ + } + #endif /* scotch */ + #if defined(ptscotch) +-/*#include "mpi.h" ++/* ++#ifdef MPI ++#include "mpi.h" ++#else ++#include "mumps_mpi.h" ++#endif + #include + #include "ptscotch.h" + int mumps_dgraphinit( SCOTCH_Dgraph *, MPI_Fint *, MPI_Fint *); +--- a/MUMPS/src/mumps_orderings.h 2011-05-10 08:56:41.000000000 -0400 ++++ MUMPS/src/mumps_orderings.h 2016-11-25 05:24:10.333871363 -0500 +@@ -86,7 +86,11 @@ + int * const ncmpa ); + #endif /*scotch or ptscotch*/ + #if defined(ptscotch) ++#ifdef MPI + #include "mpi.h" ++#else ++#include "mumps_mpi.h" ++#endif + #include + #include "ptscotch.h" + int mumps_dgraphinit( SCOTCH_Dgraph *, MPI_Fint *, MPI_Fint *); +@@ -96,7 +100,11 @@ + MUMPS_DGRAPHINIT(SCOTCH_Dgraph *graphptr, MPI_Fint *comm, MPI_Fint *ierr); + #endif /*ptscotch*/ + #if defined(parmetis) ++#ifdef MPI + #include "mpi.h" ++#else ++#include "mumps_mpi.h" ++#endif + #include "parmetis.h" + void mumps_parmetis(int *first, int *vertloctab, + int *edgeloctab, int *numflag, diff --git a/Ipopt-3.13.4/appveyor.yml b/Ipopt-3.13.4/appveyor.yml new file mode 100644 index 000000000..9c14ba4dc --- /dev/null +++ b/Ipopt-3.13.4/appveyor.yml @@ -0,0 +1,28 @@ +platform: + - x64 + +environment: + matrix: + - APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2019 + ARCH: win64-mingw + #- APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2017 + # ARCH: win64-msvc15 + #- APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2019 + # ARCH: win64-msvc16 + +install: + - IF %ARCH%==win64-msvc14 (CALL "C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin\SetEnv.cmd" /x64) + - IF %ARCH%==win64-msvc14 (CALL C:\"Program Files (x86)\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" x86_amd64) + - IF %ARCH%==win64-msvc15 (CALL C:\"Program Files (x86)\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build\vcvarsall.bat" x64 8.1) + - IF %ARCH%==win64-msvc16 (CALL C:\"Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" x64 8.1) + - IF %ARCH%==win64-mingw (CALL C:\msys64\usr\bin\bash -lc "pacman -S mingw-w64-x86_64-lapack mingw-w64-x86_64-metis --noconfirm") + - IF %ARCH%==win64-mingw (CALL C:\msys64\usr\bin\bash -lc "PATH=/mingw64/bin:$PATH ; gcc --version; g++ --version; gfortran --version; pkg-config --libs lapack ; echo PATH=$PATH") + +build_script: + - IF %ARCH%==win64-mingw (CALL C:\msys64\usr\bin\bash -lc "PATH=/mingw64/bin:$PATH ; git clone --depth 1 --branch stable/2.0 https://github.com/coin-or-tools/ThirdParty-ASL && cd ThirdParty-ASL && ./get.ASL && ./configure --prefix=$HOME/install && make && make install") + - IF %ARCH%==win64-mingw (CALL C:\msys64\usr\bin\bash -lc "PATH=/mingw64/bin:$PATH ; git clone --depth 1 --branch stable/2.1 https://github.com/coin-or-tools/ThirdParty-Mumps && cd ThirdParty-Mumps && ./get.Mumps && ./configure --prefix=$HOME/install && make && make install") + - IF %ARCH%==win64-mingw (CALL C:\msys64\usr\bin\bash -lc "PATH=/mingw64/bin:$PATH ; JAVA_HOME=/c/Progra~2/Java/jdk1.8.0 ; /c/projects/ipopt/configure --prefix=$HOME/install && make && make install") + - IF %ARCH%==win64-msvc15 (CALL C:\msys64\usr\bin\bash -lc "/c/projects/ipopt/configure --enable-msvc && make") + +test_script: + - IF %ARCH%==win64-mingw (CALL C:\msys64\usr\bin\bash -lc "PATH=/mingw64/bin:$PATH ; make test") diff --git a/Ipopt-3.13.4/ar-lib b/Ipopt-3.13.4/ar-lib new file mode 100755 index 000000000..1e9388e2a --- /dev/null +++ b/Ipopt-3.13.4/ar-lib @@ -0,0 +1,271 @@ +#! /bin/sh +# Wrapper for Microsoft lib.exe + +me=ar-lib +scriptversion=2019-07-04.01; # UTC + +# Copyright (C) 2010-2020 Free Software Foundation, Inc. +# Written by Peter Rosin . +# +# 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 Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + +# This file is maintained in Automake, please report +# bugs to or send patches to +# . + + +# func_error message +func_error () +{ + echo "$me: $1" 1>&2 + exit 1 +} + +file_conv= + +# func_file_conv build_file +# Convert a $build file to $host form and store it in $file +# Currently only supports Windows hosts. +func_file_conv () +{ + file=$1 + case $file in + / | /[!/]*) # absolute file, and not a UNC file + if test -z "$file_conv"; then + # lazily determine how to convert abs files + case `uname -s` in + MINGW*) + file_conv=mingw + ;; + CYGWIN* | MSYS*) + file_conv=cygwin + ;; + *) + file_conv=wine + ;; + esac + fi + case $file_conv in + mingw) + file=`cmd //C echo "$file " | sed -e 's/"\(.*\) " *$/\1/'` + ;; + cygwin | msys) + file=`cygpath -m "$file" || echo "$file"` + ;; + wine) + file=`winepath -w "$file" || echo "$file"` + ;; + esac + ;; + esac +} + +# func_at_file at_file operation archive +# Iterate over all members in AT_FILE performing OPERATION on ARCHIVE +# for each of them. +# When interpreting the content of the @FILE, do NOT use func_file_conv, +# since the user would need to supply preconverted file names to +# binutils ar, at least for MinGW. +func_at_file () +{ + operation=$2 + archive=$3 + at_file_contents=`cat "$1"` + eval set x "$at_file_contents" + shift + + for member + do + $AR -NOLOGO $operation:"$member" "$archive" || exit $? + done +} + +case $1 in + '') + func_error "no command. Try '$0 --help' for more information." + ;; + -h | --h*) + cat <\n") + endforeach () + + set(CMAKE_CONFIGURABLE_FILE_CONTENT "${CMAKE_CONFIGURABLE_FILE_CONTENT}\nint main()\n{if ((DIR *) 0) return 0;}\n") + + configure_file("${CMAKE_ROOT}/Modules/CMakeConfigurableFile.in" "${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/CMakeTmp/CheckDIRSymbolExists.c" @ONLY) + + message(STATUS "Looking for DIR in ${FILES}") + + try_compile(${VARIABLE} + ${CMAKE_CURRENT_BINARY_DIR} + ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/CMakeTmp/CheckDIRSymbolExists.c + COMPILE_DEFINITIONS ${CMAKE_REQUIRED_DEFINITIONS} + CMAKE_FLAGS + -DCOMPILE_DEFINITIONS:STRING=${MACRO_CHECK_DIRSYMBOL_EXISTS_FLAGS} + "${CHECK_DIRSYMBOL_EXISTS_LIBS}" + "${CMAKE_DIRSYMBOL_EXISTS_INCLUDES}" + OUTPUT_VARIABLE OUTPUT) + + if (${VARIABLE}) + message(STATUS "Looking for DIR in ${FILES} - found") + set(${VARIABLE} 1 CACHE INTERNAL "Have symbol DIR") + file(APPEND ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/CMakeOutput.log + "Determining if the DIR symbol is defined as in AC_HEADER_DIRENT " + "passed with the following output:\n" + "${OUTPUT}\nFile ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/CMakeTmp/CheckDIRSymbolExists.c:\n" + "${CMAKE_CONFIGURABLE_FILE_CONTENT}\n") + else () + message(STATUS "Looking for DIR in ${FILES} - not found.") + set(${VARIABLE} "" CACHE INTERNAL "Have symbol DIR") + file(APPEND ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/CMakeError.log + "Determining if the DIR symbol is defined as in AC_HEADER_DIRENT " + "failed with the following output:\n" + "${OUTPUT}\nFile ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/CMakeTmp/CheckDIRSymbolExists.c:\n" + "${CMAKE_CONFIGURABLE_FILE_CONTENT}\n") + endif () + endif () +endmacro () diff --git a/Ipopt-3.13.4/cmake/CheckPrototypeExists.cmake b/Ipopt-3.13.4/cmake/CheckPrototypeExists.cmake new file mode 100644 index 000000000..41b881005 --- /dev/null +++ b/Ipopt-3.13.4/cmake/CheckPrototypeExists.cmake @@ -0,0 +1,38 @@ +# AWI, downloaded from KDE repository since has not yet been transferred +# to cmake repository as of 2006-07-31. +# http://websvn.kde.org/trunk/KDE/kdelibs/cmake/modules/CheckPrototypeExists.cmake?rev=505849&view=markup +# +# - Check if the prototype for a function exists. +# CHECK_PROTOTYPE_EXISTS (FUNCTION HEADER VARIABLE) +# +# FUNCTION - the name of the function you are looking for +# HEADER - the header(s) where the prototype should be declared +# VARIABLE - variable to store the result +# + +include(CheckCSourceCompiles) + +macro(CHECK_PROTOTYPE_EXISTS _SYMBOL _HEADER _RESULT) + set(_INCLUDE_FILES) + foreach(it ${_HEADER}) + set(_INCLUDE_FILES "${_INCLUDE_FILES}#include <${it}>\n") + endforeach() + + set(_CHECK_PROTO_EXISTS_SOURCE_CODE " +${_INCLUDE_FILES} +void cmakeRequireSymbol(int dummy,...){(void)dummy;} +int main() +{ +#ifndef ${_SYMBOL} +#ifndef _MSC_VER + cmakeRequireSymbol(0,&${_SYMBOL}); +#else + char i = sizeof(&${_SYMBOL}); +#endif +#endif + return 0; +} +") + + check_c_source_compiles("${_CHECK_PROTO_EXISTS_SOURCE_CODE}" ${_RESULT}) +endmacro() diff --git a/Ipopt-3.13.4/cmake/FindAMD.cmake b/Ipopt-3.13.4/cmake/FindAMD.cmake new file mode 100644 index 000000000..bccebc468 --- /dev/null +++ b/Ipopt-3.13.4/cmake/FindAMD.cmake @@ -0,0 +1,64 @@ +# - Try to find AMD +# Once done this will define +# +# AMD_FOUND - system has AMD +# AMD_INCLUDE_DIRS - include directories for AMD +# AMD_LIBRARIES - libraries for AMD + +#============================================================================= +# Copyright (C) 2010 Anders Logg +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in +# the documentation and/or other materials provided with the +# distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +# COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, +# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, +# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. +#============================================================================= + +message(STATUS "Checking for package 'AMD'") + +# Check for header file +find_path(AMD_INCLUDE_DIRS amd.h + HINTS ${AMD_DIR}/include $ENV{AMD_DIR}/include + PATH_SUFFIXES suitesparse ufsparse + DOC "Directory where the AMD header is located") + +mark_as_advanced(AMD_INCLUDE_DIRS) + +# Check for AMD library +find_library(AMD_LIBRARIES amd + HINTS ${AMD_DIR}/lib $ENV{AMD_DIR}/lib + ${AMD_DIR}/lib64 $ENV{AMD_DIR}/lib64 + NO_DEFAULT_PATH + DOC "The AMD library") + +find_library(AMD_LIBRARIES amd + DOC "The AMD library") + +mark_as_advanced(AMD_LIBRARY) + +# Standard package handling +include(FindPackageHandleStandardArgs) + +find_package_handle_standard_args(AMD + "AMD could not be found. Be sure to set AMD_DIR." + AMD_LIBRARIES AMD_INCLUDE_DIRS) diff --git a/Ipopt-3.13.4/cmake/FindCHOLMOD.cmake b/Ipopt-3.13.4/cmake/FindCHOLMOD.cmake new file mode 100644 index 000000000..6899b52d1 --- /dev/null +++ b/Ipopt-3.13.4/cmake/FindCHOLMOD.cmake @@ -0,0 +1,227 @@ +# - Try to find CHOLMOD +# Once done this will define +# +# CHOLMOD_FOUND - system has CHOLMOD +# CHOLMOD_INCLUDE_DIRS - include directories for CHOLMOD +# CHOLMOD_LIBRARIES - libraries for CHOLMOD + +#============================================================================= +# Copyright (C) 2010-2011 Garth N. Wells, Anders Logg and Johannes Ring +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in +# the documentation and/or other materials provided with the +# distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +# COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, +# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, +# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. +#============================================================================= + +message(STATUS "Checking for package 'CHOLMOD'") + +# Find packages that CHOLMOD depends on +set(CMAKE_LIBRARY_PATH ${BLAS_DIR}/lib $ENV{BLAS_DIR}/lib ${CMAKE_LIBRARY_PATH}) +set(CMAKE_LIBRARY_PATH ${LAPACK_DIR}/lib $ENV{LAPACK_DIR}/lib ${CMAKE_LIBRARY_PATH}) + +find_package(AMD QUIET) +find_package(BLAS QUIET) +find_package(LAPACK QUIET) +find_package(ParMETIS 4.0.2 QUIET) + +# FIXME: Should we have separate FindXX modules for CAMD, COLAMD, and CCOLAMD? +# FIXME: find_package(CAMD) +# FIXME: find_package(COLAMD) +# FIXME: find_package(CCOLAMD) + +# FIXME: It may be necessary to link to LAPACK and BLAS (or the vecLib +# FIXME: framework on Darwin). + +# Check for header file +find_path(CHOLMOD_INCLUDE_DIRS cholmod.h + HINTS ${CHOLMOD_DIR}/include $ENV{CHOLMOD_DIR}/include + PATH_SUFFIXES suitesparse ufsparse + DOC "Directory where the CHOLMOD header is located") + +# Check for CHOLMOD library +find_library(CHOLMOD_LIBRARY cholmod + HINTS ${CHOLMOD_DIR}/lib $ENV{CHOLMOD_DIR}/lib + ${CHOLMOD_DIR}/lib64 $ENV{CHOLMOD_DIR}/lib64 + NO_DEFAULT_PATH + DOC "The CHOLMOD library") + +find_library(CHOLMOD_LIBRARY cholmod + DOC "The CHOLMOD library") + +# Check for CAMD library +find_library(CAMD_LIBRARY camd + HINTS ${CHOLMOD_DIR}/lib ${CAMD_DIR}/lib $ENV{CHOLMOD_DIR}/lib $ENV{CAMD_DIR}/lib + ${CHOLMOD_DIR}/lib64 ${CAMD_DIR}/lib64 $ENV{CHOLMOD_DIR}/lib64 $ENV{CAMD_DIR}/lib64 + NO_DEFAULT_PATH + DOC "The CAMD library") + +find_library(CAMD_LIBRARY camd + DOC "The CAMD library") + +# Check for COLAMD library +find_library(COLAMD_LIBRARY colamd + HINTS ${CHOLMOD_DIR}/lib ${COLAMD_DIR}/lib $ENV{CHOLMOD_DIR}/lib $ENV{COLAMD_DIR}/lib + ${CHOLMOD_DIR}/lib64 ${COLAMD_DIR}/lib64 $ENV{CHOLMOD_DIR}/lib64 $ENV{COLAMD_DIR}/lib64 + NO_DEFAULT_PATH + DOC "The COLAMD library") + +find_library(COLAMD_LIBRARY colamd + DOC "The COLAMD library") + +# Check for CCOLAMD library +find_library(CCOLAMD_LIBRARY ccolamd + HINTS ${CHOLMOD_DIR}/lib ${CCOLAMD_DIR}/lib $ENV{CHOLMOD_DIR}/lib $ENV{CCOLAMD_DIR}/lib + ${CHOLMOD_DIR}/lib64 ${CCOLAMD_DIR}/lib64 $ENV{CHOLMOD_DIR}/lib64 $ENV{CCOLAMD_DIR}/lib64 + NO_DEFAULT_PATH + DOC "The CCOLAMD library") + +find_library(CCOLAMD_LIBRARY ccolamd + DOC "The CCOLAMD library") + +# Check for SUITESPARSECONFIG library +find_library(SUITESPARSE_LIBRARY suitesparseconfig + HINTS ${CHOLMOD_DIR}/lib ${CCOLAMD_DIR}/lib $ENV{CHOLMOD_DIR}/lib $ENV{CCOLAMD_DIR}/lib + NO_DEFAULT_PATH + DOC "The SUITESPARSECONFIG library") + +find_library(SUITESPARSE_LIBRARY suitesparseconfig + DOC "The SUITESPARSECONFIG library") + +if ("${CMAKE_CXX_COMPILER_ID}" STREQUAL "GNU" AND NOT APPLE) + # Check for rt library + find_library(RT_LIBRARY rt + DOC "The RT library") +endif() + +# Collect libraries (order is important) +if (AMD_FOUND) + set(CHOLMOD_LIBRARIES ${CHOLMOD_LIBRARY} ${AMD_LIBRARIES}) +endif() +if (CAMD_LIBRARY) + set(CHOLMOD_LIBRARIES ${CHOLMOD_LIBRARIES} ${CAMD_LIBRARY}) +endif() +if (COLAMD_LIBRARY) + set(CHOLMOD_LIBRARIES ${CHOLMOD_LIBRARIES} ${COLAMD_LIBRARY}) +endif() +if (CCOLAMD_LIBRARY) + set(CHOLMOD_LIBRARIES ${CHOLMOD_LIBRARIES} ${CCOLAMD_LIBRARY}) +endif() +if (SUITESPARSE_LIBRARY) + set(CHOLMOD_LIBRARIES ${CHOLMOD_LIBRARIES} ${SUITESPARSE_LIBRARY}) +endif() +if (RT_LIBRARY) + set(CHOLMOD_LIBRARIES ${CHOLMOD_LIBRARIES} ${RT_LIBRARY}) +endif() + +if (PARMETIS_FOUND) + set(CHOLMOD_LIBRARIES ${CHOLMOD_LIBRARIES} ${PARMETIS_LIBRARIES}) +endif() +if (LAPACK_FOUND) + set(CHOLMOD_LIBRARIES ${CHOLMOD_LIBRARIES} ${LAPACK_LIBRARIES}) +endif() +if (BLAS_FOUND) + set(CHOLMOD_LIBRARIES ${CHOLMOD_LIBRARIES} ${BLAS_LIBRARIES}) +endif() + +find_program(GFORTRAN_EXECUTABLE gfortran) +if (GFORTRAN_EXECUTABLE) + execute_process(COMMAND ${GFORTRAN_EXECUTABLE} -print-file-name=libgfortran.so + OUTPUT_VARIABLE GFORTRAN_LIBRARY + OUTPUT_STRIP_TRAILING_WHITESPACE) + if (EXISTS "${GFORTRAN_LIBRARY}") + set(CHOLMOD_LIBRARIES ${CHOLMOD_LIBRARIES} ${GFORTRAN_LIBRARY}) + endif() +endif() + +mark_as_advanced( + CHOLMOD_INCLUDE_DIRS + CHOLMOD_LIBRARY + CHOLMOD_LIBRARIES + CAMD_LIBRARY + COLAMD_LIBRARY + CCOLAMD_LIBRARY + ) + +# Try to run a test program that uses CHOLMOD +if (CHOLMOD_SKIP_BUILD_TESTS) + set(CHOLMOD_TEST_RUNS TRUE) +elseif (CHOLMOD_INCLUDE_DIRS AND CHOLMOD_LIBRARIES AND AMD_FOUND) + set(CMAKE_REQUIRED_INCLUDES ${CHOLMOD_INCLUDE_DIRS} ${AMD_INCLUDE_DIRS}) + set(CMAKE_REQUIRED_LIBRARIES ${CHOLMOD_LIBRARIES}) + + # Build and run test program + include(CheckCXXSourceRuns) + check_cxx_source_runs(" +#include +#include + +int main() +{ + cholmod_dense *D; + cholmod_sparse *S; + cholmod_dense *x, *b, *r; + cholmod_factor *L; + double one[2] = {1,0}, m1[2] = {-1,0}; + double *dx; + cholmod_common c; + int n = 5; + double K[5][5] = {{1.0, 0.0, 0.0, 0.0, 0.0}, + {0.0, 2.0,-1.0, 0.0, 0.0}, + {0.0,-1.0, 2.0,-1.0, 0.0}, + {0.0, 0.0,-1.0, 2.0, 0.0}, + {0.0, 0.0, 0.0, 0.0, 1.0}}; + cholmod_start (&c); + D = cholmod_allocate_dense(n, n, n, CHOLMOD_REAL, &c); + dx = (double*)D->x; + for (int i=0; i < n; i++) + for (int j=0; j < n; j++) + dx[i+j*n] = K[i][j]; + S = cholmod_dense_to_sparse(D, 1, &c); + S->stype = 1; + cholmod_reallocate_sparse(cholmod_nnz(S, &c), S, &c); + b = cholmod_ones(S->nrow, 1, S->xtype, &c); + L = cholmod_analyze(S, &c); + cholmod_factorize(S, L, &c); + x = cholmod_solve(CHOLMOD_A, L, b, &c); + r = cholmod_copy_dense(b, &c); + cholmod_sdmult(S, 0, m1, one, x, r, &c); + cholmod_free_factor(&L, &c); + cholmod_free_dense(&D, &c); + cholmod_free_sparse(&S, &c); + cholmod_free_dense(&r, &c); + cholmod_free_dense(&x, &c); + cholmod_free_dense(&b, &c); + cholmod_finish(&c); + return 0; +} +" CHOLMOD_TEST_RUNS) + +endif() + +# Standard package handling +include(FindPackageHandleStandardArgs) +find_package_handle_standard_args(CHOLMOD "CHOLMOD could not be found. Be sure to set CHOLMOD_DIR." + CHOLMOD_LIBRARIES + CHOLMOD_INCLUDE_DIRS + CHOLMOD_TEST_RUNS) diff --git a/Ipopt-3.13.4/cmake/FindDL.cmake b/Ipopt-3.13.4/cmake/FindDL.cmake new file mode 100644 index 000000000..59a83c2b8 --- /dev/null +++ b/Ipopt-3.13.4/cmake/FindDL.cmake @@ -0,0 +1,35 @@ +############################################################################### +# CMake macro to find libdl library. +# +# On success, the macro sets the following variables: +# DL_FOUND = if the library found +# DL_LIBRARY = full path to the library +# DL_INCLUDE_DIR = where to find the library headers +# +# Author: Mateusz Loskot +# +# Redistribution and use is allowed according to the terms of the BSD license. +# For details see the accompanying COPYING-CMAKE-SCRIPTS file. +# +############################################################################### +if(DL_INCLUDE_DIR) + set(DL_FIND_QUIETLY TRUE) +endif() + +find_path(DL_INCLUDE_DIR dlfcn.h) +find_library(DL_LIBRARY NAMES dl) + +include(FindPackageHandleStandardArgs) +find_package_handle_standard_args(DL DEFAULT_MSG DL_LIBRARY DL_INCLUDE_DIR) + +if(NOT DL_FOUND) + # if dlopen can be found without linking in dl then, + # dlopen is part of libc, so don't need to link extra libs. + check_function_exists(dlopen DL_FOUND) + set(DL_LIBRARY "") +endif() + +set(DL_LIBRARIES ${DL_LIBRARY}) + +mark_as_advanced(DL_LIBRARY DL_INCLUDE_DIR) + diff --git a/Ipopt-3.13.4/cmake/FindMKL.cmake b/Ipopt-3.13.4/cmake/FindMKL.cmake new file mode 100644 index 000000000..92564ff01 --- /dev/null +++ b/Ipopt-3.13.4/cmake/FindMKL.cmake @@ -0,0 +1,117 @@ +# - Find the MKL libraries +# Modified from Armadillo's ARMA_FindMKL.cmake +# This module defines +# MKL_INCLUDE_DIR, the directory for the MKL headers +# MKL_LIB_DIR, the directory for the MKL library files +# MKL_COMPILER_LIB_DIR, the directory for the MKL compiler library files +# MKL_LIBRARIES, the libraries needed to use Intel's implementation of BLAS & LAPACK. +# MKL_FOUND, If false, do not try to use MKL; if true, the macro definition USE_MKL is added. + +# Set the include path +# TODO: what if MKL is not installed in /opt/intel/mkl? +# try to find at /opt/intel/mkl +# in windows, try to find MKL at C:/Program Files (x86)/Intel/Composer XE/mkl + +if (WIN32) + if (NOT DEFINED ENV{MKLROOT_PATH}) + set(MKLROOT_PATH "C:/Program Files (x86)/Intel/Composer XE" CACHE PATH "Where the MKL are stored") + endif () +else () + set(MKLROOT_PATH "/opt/intel" CACHE PATH "Where the MKL are stored") +endif () + +if (EXISTS ${MKLROOT_PATH}/mkl OR EXISTS ${MKLROOT_PATH}) + set(MKL_FOUND TRUE) + if (EXISTS ${MKLROOT_PATH}/mkl) + message("MKL is found at ${MKLROOT_PATH}/mkl") + else () + message("MKL is found at ${MKLROOT_PATH}") + endif () + + if (CMAKE_SIZEOF_VOID_P EQUAL 8) + set(USE_MKL_64BIT ON) + if (ARMADILLO_FOUND) + if (ARMADILLO_BLAS_LONG_LONG) + set(USE_MKL_64BIT_LIB ON) + add_definitions(-DMKL_ILP64) + message("MKL is linked against ILP64 interface ... ") + endif () + endif () + else () + set(USE_MKL_64BIT OFF) + endif () +else () + set(MKL_FOUND FALSE) + message("MKL is NOT found ... ") +endif () + +if (MKL_FOUND) + if (EXISTS ${MKLROOT_PATH}/mkl) + set(MKL_INCLUDE_DIR "${MKLROOT_PATH}/mkl/include") + else () + set(MKL_INCLUDE_DIR "${MKLROOT_PATH}/include") + endif () + add_definitions(-DUSE_MKL) + if (USE_MKL_64BIT) + if (EXISTS ${MKLROOT_PATH}/mkl) + set(MKL_LIB_DIR "${MKLROOT_PATH}/mkl/lib/intel64") + else () + set(MKL_LIB_DIR "${MKLROOT_PATH}/lib/intel64") + endif () + set(MKL_COMPILER_LIB_DIR "${MKLROOT_PATH}/compiler/lib/intel64") + set(MKL_COMPILER_LIB_DIR ${MKL_COMPILER_LIB_DIR} "${MKLROOT_PATH}/lib/intel64") + if (USE_MKL_64BIT_LIB) + if (WIN32) + set(MKL_LIBRARIES ${MKL_LIBRARIES} mkl_intel_ilp64) + else () + set(MKL_LIBRARIES ${MKL_LIBRARIES} mkl_intel_ilp64) + endif () + else () + if (WIN32) + set(MKL_LIBRARIES ${MKL_LIBRARIES} mkl_intel_lp64) + else () + set(MKL_LIBRARIES ${MKL_LIBRARIES} mkl_intel_lp64) + endif () + endif () + else () + if (EXISTS ${MKLROOT_PATH}/mkl) + set(MKL_LIB_DIR "${MKLROOT_PATH}/mkl/lib/ia32") + else () + set(MKL_LIB_DIR "${MKLROOT_PATH}/lib/ia32") + endif () + set(MKL_COMPILER_LIB_DIR "${MKLROOT_PATH}/compiler/lib/ia32") + set(MKL_COMPILER_LIB_DIR ${MKL_COMPILER_LIB_DIR} "${MKLROOT_PATH}/lib/ia32") + if (WIN32) + set(MKL_LIBRARIES ${MKL_LIBRARIES} mkl_intel_c) + else ( ) + set(MKL_LIBRARIES ${MKL_LIBRARIES} mkl_intel) + endif ( ) + endif () + + if (WIN32) + set(MKL_LIBRARIES ${MKL_LIBRARIES} mkl_intel_thread) + set(MKL_LIBRARIES ${MKL_LIBRARIES} mkl_core) + set(MKL_LIBRARIES ${MKL_LIBRARIES} libiomp5md) + else () + set(MKL_LIBRARIES ${MKL_LIBRARIES} mkl_gnu_thread) + set(MKL_LIBRARIES ${MKL_LIBRARIES} mkl_core) + endif () +endif () + +if (MKL_FOUND) + if (NOT MKL_FIND_QUIETLY) + message(STATUS "Found MKL libraries: ${MKL_LIBRARIES}") + message(STATUS "MKL_INCLUDE_DIR: ${MKL_INCLUDE_DIR}") + message(STATUS "MKL_LIB_DIR: ${MKL_LIB_DIR}") + message(STATUS "MKL_COMPILER_LIB_DIR: ${MKL_COMPILER_LIB_DIR}") + endif () + + include_directories(${MKL_INCLUDE_DIR}) + link_directories(${MKL_LIB_DIR} ${MKLROOT_PATH}/lib ${MKLROOT_PATH} ${MKL_COMPILER_LIB_DIR}) +else () + if (MKL_FIND_REQUIRED) + message(FATAL_ERROR "Could not find MKL libraries") + endif () +endif () + +# MARK_AS_ADVANCED(MKL_LIBRARY) diff --git a/Ipopt-3.13.4/cmake/FindParMETIS.cmake b/Ipopt-3.13.4/cmake/FindParMETIS.cmake new file mode 100644 index 000000000..241aa661a --- /dev/null +++ b/Ipopt-3.13.4/cmake/FindParMETIS.cmake @@ -0,0 +1,148 @@ +# - Try to find ParMETIS +# Once done this will define +# +# PARMETIS_FOUND - system has ParMETIS +# PARMETIS_INCLUDE_DIRS - include directories for ParMETIS +# PARMETIS_LIBRARIES - libraries for ParMETIS +# PARMETIS_VERSION - version for ParMETIS + +#============================================================================= +# Copyright (C) 2010 Garth N. Wells, Anders Logg and Johannes Ring +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in +# the documentation and/or other materials provided with the +# distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +# COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, +# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, +# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. +#============================================================================= + +if (MPI_CXX_FOUND) + find_path(PARMETIS_INCLUDE_DIRS parmetis.h + HINTS ${PARMETIS_DIR}/include $ENV{PARMETIS_DIR}/include ${PETSC_DIR}/include ${PETSC_DIR}/${PETSC_ARCH}/include + DOC "Directory where the ParMETIS header files are located") + + find_library(PARMETIS_LIBRARY parmetis + HINTS ${PARMETIS_DIR}/lib $ENV{PARMETIS_DIR}/lib ${PETSC_DIR}/lib ${PETSC_DIR}/${PETSC_ARCH}/lib + ${PARMETIS_DIR}/lib64 $ENV{PARMETIS_DIR}/lib64 ${PETSC_DIR}/lib64 ${PETSC_DIR}/${PETSC_ARCH}/lib64 + NO_DEFAULT_PATH + DOC "Directory where the ParMETIS library is located") + + find_library(PARMETIS_LIBRARY parmetis + DOC "Directory where the ParMETIS library is located") + + find_library(METIS_LIBRARY metis + HINTS ${PARMETIS_DIR}/lib $ENV{PARMETIS_DIR}/lib ${PETSC_DIR}/lib ${PETSC_DIR}/${PETSC_ARCH}/lib + NO_DEFAULT_PATH + DOC "Directory where the METIS library is located") + + find_library(METIS_LIBRARY metis + DOC "Directory where the METIS library is located") + + set(PARMETIS_LIBRARIES ${PARMETIS_LIBRARY}) + if (METIS_LIBRARY) + set(PARMETIS_LIBRARIES ${PARMETIS_LIBRARIES} ${METIS_LIBRARY}) + endif() + + # Try compiling and running test program + if (DOLFIN_SKIP_BUILD_TESTS) + set(PARMETIS_TEST_RUNS TRUE) + set(PARMETIS_VERSION "UNKNOWN") + set(PARMETIS_VERSION_OK TRUE) + elseif (PARMETIS_INCLUDE_DIRS AND PARMETIS_LIBRARY) + # Set flags for building test program + set(CMAKE_REQUIRED_INCLUDES ${PARMETIS_INCLUDE_DIRS} ${MPI_CXX_INCLUDE_PATH}) + set(CMAKE_REQUIRED_LIBRARIES ${PARMETIS_LIBRARIES} ${MPI_CXX_LIBRARIES}) + set(CMAKE_REQUIRED_FLAGS ${CMAKE_REQUIRED_FLAGS} ${MPI_CXX_COMPILE_FLAGS}) + + # Check ParMETIS version + set(PARMETIS_CONFIG_TEST_VERSION_CPP "${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/parmetis_config_test_version.cpp") + + file(WRITE ${PARMETIS_CONFIG_TEST_VERSION_CPP} " +#define MPICH_IGNORE_CXX_SEEK 1 +#include +#include \"parmetis.h\" + +int main() { +#ifdef PARMETIS_SUBMINOR_VERSION + std::cout << PARMETIS_MAJOR_VERSION << \".\" + << PARMETIS_MINOR_VERSION << \".\" + << PARMETIS_SUBMINOR_VERSION; +#else + std::cout << PARMETIS_MAJOR_VERSION << \".\" + << PARMETIS_MINOR_VERSION; +#endif + return 0; +} +") + + try_run(PARMETIS_CONFIG_TEST_VERSION_EXITCODE + PARMETIS_CONFIG_TEST_VERSION_COMPILED + ${CMAKE_CURRENT_BINARY_DIR} + ${PARMETIS_CONFIG_TEST_VERSION_CPP} + CMAKE_FLAGS "-DINCLUDE_DIRECTORIES:STRING=${CMAKE_REQUIRED_INCLUDES}" + "-DLINK_LIBRARIES:STRING=${CMAKE_REQUIRED_LIBRARIES}" + COMPILE_OUTPUT_VARIABLE PARMETIS_CONFIG_TEST_VERSION_COMPILE_OUTPUT + RUN_OUTPUT_VARIABLE PARMETIS_CONFIG_TEST_VERSION_OUTPUT) + + if (PARMETIS_CONFIG_TEST_VERSION_EXITCODE EQUAL 0) + set(PARMETIS_VERSION ${PARMETIS_CONFIG_TEST_VERSION_OUTPUT} CACHE TYPE STRING) + mark_as_advanced(PARMETIS_VERSION) + endif() + + if (ParMETIS_FIND_VERSION) + # Check if version found is >= required version + if (NOT "${PARMETIS_VERSION}" VERSION_LESS "${ParMETIS_FIND_VERSION}") + set(PARMETIS_VERSION_OK TRUE) + endif() + else() + # No specific version requested + set(PARMETIS_VERSION_OK TRUE) + endif() + mark_as_advanced(PARMETIS_VERSION_OK) + + # Build and run test program + include(CheckCXXSourceRuns) + + check_cxx_source_runs(" +#define MPICH_IGNORE_CXX_SEEK 1 +#include +#include + +int main() +{ + // FIXME: Find a simple but sensible test for ParMETIS + + return 0; +} +" PARMETIS_TEST_RUNS) + + endif() +endif() + +# Standard package handling +find_package_handle_standard_args(ParMETIS + "ParMETIS could not be found/configured." + PARMETIS_LIBRARIES + PARMETIS_TEST_RUNS + PARMETIS_INCLUDE_DIRS + PARMETIS_VERSION + PARMETIS_VERSION_OK) diff --git a/Ipopt-3.13.4/cmake/FindReadline.cmake b/Ipopt-3.13.4/cmake/FindReadline.cmake new file mode 100644 index 000000000..5d6e34520 --- /dev/null +++ b/Ipopt-3.13.4/cmake/FindReadline.cmake @@ -0,0 +1,75 @@ +# - Find the readline library +# This module defines +# READLINE_INCLUDE_DIR, path to readline/readline.h, etc. +# READLINE_LIBRARIES, the libraries required to use READLINE. +# READLINE_FOUND, If false, do not try to use READLINE. +# also defined, but not for general use are +# READLINE_readline_LIBRARY, where to find the READLINE library. +# READLINE_ncurses_LIBRARY, where to find the ncurses library [might not be defined] + +# Apple readline does not support readline hooks +# So we look for another one by default +if (APPLE) + find_path(READLINE_INCLUDE_DIR NAMES readline/readline.h + PATHS /sw/include + /opt/local/include + /opt/include + /usr/local/include + /usr/include/ + NO_DEFAULT_PATH) +endif () + +find_path(READLINE_INCLUDE_DIR NAMES readline/readline.h) + +# Apple readline does not support readline hooks +# So we look for another one by default +if (APPLE) + find_library(READLINE_readline_LIBRARY NAMES readline + PATHS /sw/lib + /opt/local/lib + /opt/lib + /usr/local/lib + /usr/lib + NO_DEFAULT_PATH) +endif () + +find_library(READLINE_readline_LIBRARY NAMES readline) + +# Sometimes readline really needs ncurses +if (APPLE) + find_library(READLINE_ncurses_LIBRARY NAMES ncurses + PATHS /sw/lib + /opt/local/lib + /opt/lib + /usr/local/lib + /usr/lib + NO_DEFAULT_PATH) +endif () + +find_library(READLINE_ncurses_LIBRARY NAMES ncurses) + +mark_as_advanced(READLINE_INCLUDE_DIR + READLINE_readline_LIBRARY + READLINE_ncurses_LIBRARY) + +set(READLINE_FOUND "NO") + +if (READLINE_INCLUDE_DIR) + if (READLINE_readline_LIBRARY) + set(READLINE_FOUND "YES") + set(READLINE_LIBRARIES ${READLINE_readline_LIBRARY}) + + # some readline libraries depend on ncurses + if (READLINE_ncurses_LIBRARY) + set(READLINE_LIBRARIES ${READLINE_LIBRARIES} ${READLINE_ncurses_LIBRARY}) + endif () + endif () +endif () + +if (READLINE_FOUND) + message(STATUS "Found readline library") +else () + if (READLINE_FIND_REQUIRED) + message(FATAL_ERROR "Could not find readline -- please give some paths to CMake") + endif () +endif () diff --git a/Ipopt-3.13.4/cmake/FindSSE.cmake b/Ipopt-3.13.4/cmake/FindSSE.cmake new file mode 100644 index 000000000..e4c28c07f --- /dev/null +++ b/Ipopt-3.13.4/cmake/FindSSE.cmake @@ -0,0 +1,292 @@ +# Check if SSE/AVX instructions are available on the machine where +# the project is compiled. + +# -mmmx +# +# -msse +# -msse2 +# -msse3 +# -mssse3 +# -msse4 +# -msse4.1 +# -msse4.2 +# -msse4a +# -mfpmath=sse +# +# -mavx +# -mavx2 +# -mavx512f +# -mavx512pf +# -mavx512er +# -mavx512cd +# -mavx512vl +# -mavx512bw +# -mavx512dq +# -mavx512ifma +# -mavx512vbmi +# +# -m3dnow + +if (CMAKE_SYSTEM_NAME MATCHES "Linux") + execute_process(COMMAND cat /proc/cpuinfo OUTPUT_VARIABLE CPUINFO) + + string(REGEX REPLACE "^.*(mmx).*$" "\\1" MMX_THERE ${CPUINFO}) + string(COMPARE EQUAL "mmx" "${MMX_THERE}" MMX_TRUE) + if (MMX_TRUE) + set(MMX_FOUND true CACHE BOOL "MMX available on host") + else () + set(MMX_FOUND false CACHE BOOL "MMX available on host") + endif () + + string(REGEX REPLACE "^.*(sse2).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "sse2" "${SSE_THERE}" SSE2_TRUE) + if (SSE2_TRUE) + set(SSE2_FOUND true CACHE BOOL "SSE2 available on host") + else () + set(SSE2_FOUND false CACHE BOOL "SSE2 available on host") + endif () + + # /proc/cpuinfo apparently omits sse3 :( + string(REGEX REPLACE "^.*[^s](sse3).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "sse3" "${SSE_THERE}" SSE3_TRUE) + if (NOT SSE3_TRUE) + string(REGEX REPLACE "^.*(T2300).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "T2300" "${SSE_THERE}" SSE3_TRUE) + endif () + + string(REGEX REPLACE "^.*(ssse3).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "ssse3" "${SSE_THERE}" SSSE3_TRUE) + if (SSE3_TRUE OR SSSE3_TRUE) + set(SSE3_FOUND true CACHE BOOL "SSE3 available on host") + else () + set(SSE3_FOUND false CACHE BOOL "SSE3 available on host") + endif () + + if (SSSE3_TRUE) + set(SSSE3_FOUND true CACHE BOOL "SSSE3 available on host") + else () + set(SSSE3_FOUND false CACHE BOOL "SSSE3 available on host") + endif () + + string(REGEX REPLACE "^.*(sse4_1).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "sse4_1" "${SSE_THERE}" SSE41_TRUE) + if (SSE41_TRUE) + set(SSE4_1_FOUND true CACHE BOOL "SSE4.1 available on host") + else () + set(SSE4_1_FOUND false CACHE BOOL "SSE4.1 available on host") + endif () + + string(REGEX REPLACE "^.*(sse4_2).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "sse4_2" "${SSE_THERE}" SSE42_TRUE) + if (SSE42_TRUE) + set(SSE4_2_FOUND true CACHE BOOL "SSE4.2 available on host") + else () + set(SSE4_2_FOUND false CACHE BOOL "SSE4.2 available on host") + endif () + + string(REGEX REPLACE "^.*(avx).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "avx" "${SSE_THERE}" AVX_TRUE) + if (AVX_TRUE) + set(AVX_FOUND true CACHE BOOL "AVX available on host") + else () + set(AVX_FOUND false CACHE BOOL "AVX available on host") + endif () + + string(REGEX REPLACE "^.*(avx2).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "avx2" "${SSE_THERE}" AVX2_TRUE) + if (AVX2_TRUE) + set(AVX2_FOUND true CACHE BOOL "AVX2 available on host") + else () + set(AVX2_FOUND false CACHE BOOL "AVX2 available on host") + endif () +elseif (CMAKE_SYSTEM_NAME MATCHES "Darwin") + execute_process(COMMAND /usr/sbin/sysctl -n machdep.cpu.features OUTPUT_VARIABLE CPUINFO) + + string(REGEX REPLACE "^.*(mmx).*$" "\\1" MMX_THERE ${CPUINFO}) + string(COMPARE EQUAL "mmx" "${MMX_THERE}" MMX_TRUE) + if (MMX_TRUE) + set(MMX_FOUND true CACHE BOOL "MMX available on host") + else () + set(MMX_FOUND false CACHE BOOL "MMX available on host") + endif () + + string(REGEX REPLACE "^.*[^S](SSE2).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "SSE2" "${SSE_THERE}" SSE2_TRUE) + if (SSE2_TRUE) + set(SSE2_FOUND true CACHE BOOL "SSE2 available on host") + else () + set(SSE2_FOUND false CACHE BOOL "SSE2 available on host") + endif () + + string(REGEX REPLACE "^.*[^S](SSE3).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "SSE3" "${SSE_THERE}" SSE3_TRUE) + if (SSE3_TRUE) + set(SSE3_FOUND true CACHE BOOL "SSE3 available on host") + else () + set(SSE3_FOUND false CACHE BOOL "SSE3 available on host") + endif () + + string(REGEX REPLACE "^.*(SSSE3).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "SSSE3" "${SSE_THERE}" SSSE3_TRUE) + if (SSSE3_TRUE) + set(SSSE3_FOUND true CACHE BOOL "SSSE3 available on host") + else () + set(SSSE3_FOUND false CACHE BOOL "SSSE3 available on host") + endif () + + string(REGEX REPLACE "^.*(SSE4.1).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "SSE4.1" "${SSE_THERE}" SSE41_TRUE) + if (SSE41_TRUE) + set(SSE4_1_FOUND true CACHE BOOL "SSE4.1 available on host") + else () + set(SSE4_1_FOUND false CACHE BOOL "SSE4.1 available on host") + endif () + + string(REGEX REPLACE "^.*(SSE4.2).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "SSE4.2" "${SSE_THERE}" SSE42_TRUE) + if (SSE42_TRUE) + set(SSE4_2_FOUND true CACHE BOOL "SSE4.2 available on host") + else () + set(SSE4_2_FOUND false CACHE BOOL "SSE4.2 available on host") + endif () + + string(REGEX REPLACE "^.*(AVX).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "AVX" "${SSE_THERE}" AVX_TRUE) + if (AVX_TRUE) + set(AVX_FOUND true CACHE BOOL "AVX available on host") + else () + set(AVX_FOUND false CACHE BOOL "AVX available on host") + endif () + + string(REGEX REPLACE "^.*(AVX2).*$" "\\1" SSE_THERE ${CPUINFO}) + string(COMPARE EQUAL "AVX2" "${SSE_THERE}" AVX2_TRUE) + if (AVX2_TRUE) + set(AVX2_FOUND true CACHE BOOL "AVX2 available on host") + else () + set(AVX2_FOUND false CACHE BOOL "AVX2 available on host") + endif () +elseif (CMAKE_SYSTEM_NAME MATCHES "Windows") + # TODO + set(MMX_FOUND false CACHE BOOL "MMX available on host") + set(SSE2_FOUND true CACHE BOOL "SSE2 available on host") + set(SSE3_FOUND false CACHE BOOL "SSE3 available on host") + set(SSSE3_FOUND false CACHE BOOL "SSSE3 available on host") + set(SSE4_1_FOUND false CACHE BOOL "SSE4.1 available on host") + set(SSE4_2_FOUND false CACHE BOOL "SSE4.2 available on host") + set(AVX_FOUND false CACHE BOOL "AVX available on host") + set(AVX2_FOUND false CACHE BOOL "AVX2 available on host") +else () + set(MMX_FOUND true CACHE BOOL "MMX available on host") + set(SSE2_FOUND true CACHE BOOL "SSE2 available on host") + set(SSE3_FOUND false CACHE BOOL "SSE3 available on host") + set(SSSE3_FOUND false CACHE BOOL "SSSE3 available on host") + set(SSE4_1_FOUND false CACHE BOOL "SSE4.1 available on host") + set(SSE4_2_FOUND false CACHE BOOL "SSE4.2 available on host") + set(AVX_FOUND false CACHE BOOL "AVX available on host") + set(AVX2_FOUND false CACHE BOOL "AVX2 available on host") +endif () + +if (NOT MMX_FOUND) + message(STATUS "Could not find hardware support for MMX on this machine.") +endif () + +if (NOT SSE2_FOUND) + message(STATUS "Could not find hardware support for SSE2 on this machine.") +endif () + +if (NOT SSE3_FOUND) + message(STATUS "Could not find hardware support for SSE3 on this machine.") +endif () + +if (NOT SSSE3_FOUND) + message(STATUS "Could not find hardware support for SSSE3 on this machine.") +endif () + +if (NOT SSE4_1_FOUND) + message(STATUS "Could not find hardware support for SSE4.1 on this machine.") +endif () + +if (NOT SSE4_2_FOUND) + message(STATUS "Could not find hardware support for SSE4.2 on this machine.") +endif () + +if (NOT AVX_FOUND) + message(STATUS "Could not find hardware support for AVX on this machine.") +endif () + +if (NOT AVX2_FOUND) + message(STATUS "Could not find hardware support for AVX2 on this machine.") +endif () + +set(SSE_COMPILER_FLAGS ) + +if ((CMAKE_SYSTEM_NAME MATCHES "Darwin") OR (CMAKE_SYSTEM_NAME MATCHES "Linux")) + if (MMX_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} -mmmx") + endif () + + if (SSE2_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} -mfpmath=sse -msse -msse2") + endif () + + if (SSE3_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} -msse3") + endif () + + if (SSSE3_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} -mssse3") + endif () + + if (SSE4_1_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} -msse4 -msse4.1") + endif () + + if (SSE4_2_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} -msse4.2") + endif () + + if (AVX_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} -mavx") + endif () + + if (AVX2_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} -mavx2") + endif () +endif () + +if (CMAKE_SYSTEM_NAME MATCHES "Windows") + if (MMX_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} /QMMX") + endif () + + if (SSE2_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} /QSSE /QSSE2") + endif () + + if (SSE3_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} /QSSE3") + endif () + + if (SSSE3_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} /QSSSE3") + endif () + + if (SSE4_1_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} /QSSE4 /QSSE4.1") + endif () + + if (SSE4_2_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} /QSSE4.2") + endif () + + if (AVX_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} /QAVX") + endif () + + if (AVX2_FOUND) + set(SSE_COMPILER_FLAGS "${SSE_COMPILER_FLAGS} /QAVX2") + endif () +endif () + +mark_as_advanced(MMX_FOUND SSE2_FOUND SSE3_FOUND SSSE3_FOUND SSE4_1_FOUND SSE4_2_FOUND AVX_FOUND AVX2_FOUND SSE_COMPILER_FLAGS) + diff --git a/Ipopt-3.13.4/cmake/GetAcInitVersion.cmake b/Ipopt-3.13.4/cmake/GetAcInitVersion.cmake new file mode 100644 index 000000000..28d0591e3 --- /dev/null +++ b/Ipopt-3.13.4/cmake/GetAcInitVersion.cmake @@ -0,0 +1,35 @@ +# Read the package version number specified as the second argument +# to the AC_INIT macro in a GNU Autoconf configure.in file. +# +# Input parameter: +# FileName: path to configure.ac file +# +# Define the following variables: +# VERSION_STRING: The second argument to AC_INIT +# MAJOR_VERSION: For a version string of the form m.n.p..., m +# MINOR_VERSION: For a version string of the form m.n.p..., n +# PATCH_VERSION: For a version string of the form m.n.p..., p + +macro(get_ac_init_version FileName Prefix) + file(READ ${FileName} configure_IN) + # AC_INIT([Cbc],[2.9.8],[cbc@lists.coin-or.org]) + #string(REGEX REPLACE "(AC_INIT\\(\\[Cbc\\],\\[)(.*)(\\],\\[cbc@lists.coin-or.org\\]\\).*)" "\\2" configure_REGEX ${configure_IN}) + string(REGEX REPLACE "(AC_INIT.*)" "\\1" configure_REGEX ${configure_IN}) + + string(REGEX REPLACE "^.*AC_INIT *\\([^,]+, *\\[([^, )]+)\\].*$" "\\1" ${Prefix}_VERSION_STRING "${configure_REGEX}") + if (${Prefix}_VERSION_STRING STREQUAL "trunk") + set(${Prefix}_MAJOR_VERSION "9") + set(${Prefix}_MINOR_VERSION "9") + set(${Prefix}_PATCH_VERSION "9999") + else () + message(STATUS "${Prefix}_VERSION_STRING = ${${Prefix}_VERSION_STRING}") + + string(REGEX REPLACE "^([0-9]+)(\\..*)?$" "\\1" ${Prefix}_MAJOR_VERSION "${${Prefix}_VERSION_STRING}") + string(REGEX REPLACE "^[0-9]+\\.([0-9]+)(\\..*)?$" "\\1" ${Prefix}_MINOR_VERSION "${${Prefix}_VERSION_STRING}") + if (${Prefix}_VERSION_STRING MATCHES "^[0-9]+\\.[0-9]+\\.[0-9]+.*$") + string(REGEX REPLACE "^[0-9]+\\.[0-9]+\\.([0-9]+).*$" "\\1" ${Prefix}_PATCH_VERSION "${${Prefix}_VERSION_STRING}") + else () + set(${Prefix}_PATCH_VERSION "0") + endif () + endif () +endmacro () diff --git a/Ipopt-3.13.4/cmake/VA_COPY.cmake b/Ipopt-3.13.4/cmake/VA_COPY.cmake new file mode 100644 index 000000000..fde4985cc --- /dev/null +++ b/Ipopt-3.13.4/cmake/VA_COPY.cmake @@ -0,0 +1,43 @@ +macro(VA_COPY) + write_file("${CMAKE_CURRENT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/cmake_try_compile.c" + "#include + void f (int i, ...) { + va_list args1, args2; + va_start (args1, i); + va_copy (args2, args1); + if (va_arg (args2, int) != 42 || va_arg (args1, int) != 42) + exit (1); + va_end (args1); va_end (args2); + } + int main() { + f (0, 42); + return 0; + }") + + try_compile(IPOPT_HAS_VA_COPY ${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_CURRENT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/cmake_try_compile.c) + + if (IPOPT_HAS_VA_COPY) + set(VA_COPY va_copy CACHE STRING "va_copy function") + else () + write_file("${CMAKE_CURRENT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/cmake_try_compile.c" + "#include + void f (int i, ...) { + va_list args1, args2; + va_start (args1, i); + __va_copy (args2, args1); + if (va_arg (args2, int) != 42 || va_arg (args1, int) != 42) + exit (1); + va_end (args1); va_end (args2); + } + int main() { + f (0, 42); + return 0; + }") + + try_compile(IPOPT_HAS_VA_COPY ${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_CURRENT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/cmake_try_compile.c) + + if (HAVE___VA_COPY) + set(_VA_COPY __va_copy CACHE STRING "va_copy function") + endif () + endif() +endmacro() diff --git a/Ipopt-3.13.4/cmake/arm-toolchain.cmake b/Ipopt-3.13.4/cmake/arm-toolchain.cmake new file mode 100644 index 000000000..d72febf3b --- /dev/null +++ b/Ipopt-3.13.4/cmake/arm-toolchain.cmake @@ -0,0 +1,43 @@ +# the name of the target operating system +set(CMAKE_SYSTEM_NAME Generic) +#set(CMAKE_SYSTEM_NAME Linux) +set(CMAKE_SYSTEM_PROCESSOR arm) +set(CMAKE_CROSSCOMPILING 1) + +# which compilers to use for C and C++ +set(CMAKE_C_COMPILER arm-none-eabi-gcc) +set(CMAKE_CXX_COMPILER arm-none-eabi-g++) + +set(CMAKE_AR "arm-none-eabi-ar" CACHE PATH "" FORCE) +set(CMAKE_RANLIB "arm-none-eabi-ranlib" CACHE PATH "" FORCE) +set(CMAKE_LINKER "arm-none-eabi-ld" CACHE PATH "" FORCE) +set(CMAKE_SIZE "arm-none-eabi-size") +set(CMAKE_OBJCOPY "arm-none-eabi-objcopy") + +# $ dnf install arm-none-eabi-gcc-cs-c++.x86_64 arm-none-eabi-gcc-cs.x86_64 +# $ dnf install arm-none-eabi-newlib + +set(CMAKE_SHARED_LIBRARY_LINK_C_FLAGS "") +set(CMAKE_SHARED_LIBRARY_LINK_CXX_FLAGS "") + +#set(CMAKE_C_COMPILER_WORKS 1) +#set(CMAKE_CXX_COMPILER_WORKS 1) +set(CMAKE_TRY_COMPILE_TARGET_TYPE STATIC_LIBRARY) + +# error "NEON intrinsics not available with the soft-float ABI. Please use -mfloat-abi=softfp + -mthumb or -mfloat-abi=hard" +set(CMAKE_CXX_FLAGS "-mfloat-abi=hard --specs=nosys.specs") +set(CMAKE_C_FLAGS "-mfloat-abi=hard --specs=nosys.specs") + +set(CMAKE_CXX_EXTENSIONS OFF) + +# here is the target environment located +set(CMAKE_FIND_ROOT_PATH /usr/arm-non-eabi/ /home/user/arm-install ) +set(CMAKE_STAGING_PREFIX /home/user/stage) + +# adjust the default behaviour of the FIND_XXX() commands: +# search headers and libraries in the target environment, search +# programs in the host environment +set(CMAKE_FIND_ROOT_PATH_MODE_PROGRAM NEVER) +set(CMAKE_FIND_ROOT_PATH_MODE_LIBRARY ONLY) +set(CMAKE_FIND_ROOT_PATH_MODE_INCLUDE ONLY) +set(CMAKE_FIND_ROOT_PATH_MODE_PACKAGE ONLY) diff --git a/Ipopt-3.13.4/cmake/coin-macros.cmake b/Ipopt-3.13.4/cmake/coin-macros.cmake new file mode 100644 index 000000000..a5e4acd9c --- /dev/null +++ b/Ipopt-3.13.4/cmake/coin-macros.cmake @@ -0,0 +1,486 @@ +# coin_check_and_add_include_path: check if ${dir}/include is a path and exists +# dir must be a variable containing "None" or a path +macro(coin_check_and_add_include_path dir) + if (NOT ${dir} STREQUAL "None") + if (NOT EXISTS "${${dir}}") + message(FATAL_ERROR "Error: ${dir} = ${${dir}} which is not an existing directory") + else () + include_directories(${${dir}}) + endif () + endif () +endmacro () + +# coin_check_and_add_library_path: check if ${dir}/lib is a path and exists +# dir must be a variable containing "None" or a path +macro(coin_check_and_add_library_path dir) + if (NOT ${dir} STREQUAL "None") + if (NOT EXISTS "${${dir}}") + message(FATAL_ERROR "Error: ${dir} = ${${dir}} which is not an existing directory") + else () + link_directories(${${dir}}) + endif () + endif () +endmacro () + +# coin_check_and_add_include_library_path: check if ${dir}/lib and ${dir}/include are pathes and exists +# dir must be a variable containing "None" or a path +macro(coin_check_and_add_include_library_path dir) + if (NOT ${dir} STREQUAL "None") + if (NOT EXISTS "${${dir}}/include") + message(FATAL_ERROR "Error: ${dir} = ${${dir}}/include which is not an existing directory") + else () + include_directories(${${dir}}/include) + endif () + + if (NOT EXISTS "${${dir}}/lib") + message(FATAL_ERROR "Error: ${dir} = ${${dir}}/lib which is not an existing directory") + else () + link_directories(${${dir}}/lib) + endif () + endif () +endmacro() + +# +# macros to manage files and version +# + +macro(add_source_files ListFiles FilesToInclude Version VersionToCheck) + if (("${${Version}}" VERSION_GREATER "${VersionToCheck}") OR ("${${Version}}" VERSION_EQUAL "${VersionToCheck}")) + set(${ListFiles} ${${ListFiles}} + ${${FilesToInclude}}) + endif () +endmacro() + +macro(remove_source_files ListFiles FilesToExclude Version VersionToCheck) + if (("${${Version}}" VERSION_EQUAL "${VersionToCheck}") OR ("${${Version}}" VERSION_GREATER "${VersionToCheck}")) + foreach(Item IN LIST ${FilesToExclude}) + list(REMOVE_ITEM ${ListFiles} ${Item}) + endforeach() + endif () +endmacro() + +# +# macros for tests +# + +find_package(PythonInterp REQUIRED) + +set(COIN_TEST_LOG_DIR "${CMAKE_CURRENT_BINARY_DIR}/tests" CACHE PATH "The log and output directory for tests") + +mark_as_advanced(COIN_TEST_LOG_DIR) + +if (NOT EXISTS ${CMAKE_CURRENT_BINARY_DIR}/CoinTests) + make_directory(${CMAKE_CURRENT_BINARY_DIR}/CoinTests) +endif () + +if (NOT EXISTS ${COIN_TEST_LOG_DIR}) + make_directory(${COIN_TEST_LOG_DIR}) +endif () + +# add_coin_test: generate a cmake wrapper around cbc / clp executable and then add the test +# SolverName: the name of the solver. Will be appended to the out and log filename (must have the same name as the built target) +# Name: the name of the test +# FileData: the name of the mps / lp data file + +macro(add_coin_test Name SolverName FileData) + if (WIN32) + file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.bat "cmd.exe /C \"${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/${SolverName} ${FileData} %COIN_EXE_OPTIONS% -solution ${COIN_TEST_LOG_DIR}/${Name}.out -solve > ${COIN_TEST_LOG_DIR}/${Name}.log 2>&1 \"") + + add_test(NAME ${Name} + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.bat) + else () + file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh "sh -c \"${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/${SolverName} ${FileData} $COIN_EXE_OPTIONS -solution ${COIN_TEST_LOG_DIR}/${Name}.out -solve > ${COIN_TEST_LOG_DIR}/${Name}.log 2>&1 \"") + + execute_process(COMMAND chmod a+x ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh) + add_test(NAME ${Name} + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh) + endif () + + if (WIN32) + # Escape each ';' in the %PATH% environment variable + string(REGEX REPLACE "\\\\" "/" WINPATH "$ENV{PATH}") + string(REGEX REPLACE "\;" "\\\\;" WINPATH "${WINPATH}") + + set(ENV_COIN_TESTS "PATH=${WINPATH}\\;${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/lib\\;${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/bin") + set_tests_properties(${Name} PROPERTIES ENVIRONMENT "PATH=${ENV_COIN_TESTS}") + endif () +endmacro() + +# add_coin_test_list: generate a cmake wrapper around cbc / clp executable and then add the test +# SolverName: the name of the solver. Will be appended to the out and log filename (must have the same name as the built target) +# Prefix: a prefix which will be added to the test name +# Suffix: a suffix which will be added to the test name +# FileList: the list of test file +# Label: a default label to tag tests +# Timeout: a dafault timeout for tests +macro(add_coin_test_list SolverName Prefix Suffix FileList Label Timeout) + foreach(File ${${FileList}}) + get_filename_component(_NAME ${File} NAME) + string(REGEX REPLACE "[\\.]" "_" _NAME "${_NAME}") + + add_coin_test(${Prefix}_${_NAME}_${Suffix} ${SolverName} ${File}) + + if (NOT COIN_TESTS_DISABLE_TIMEOUT) + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES TIMEOUT ${Timeout}) + else () + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES TIMEOUT 1000000) + endif () + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES LABELS "${Label}") + endforeach () +endmacro() + +# add_coin_sym_test: generate a cmake wrapper around symphony executable and then add the test +# SolverName: the name of the solver. Will be appended to the out and log filename (must have the same name as the built target) +# Name: the name of the test +# FileData: the name of the mps / lp data file + +macro(add_coin_sym_test Name SolverName FileData) + if (WIN32) + file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.bat "cmd.exe /C \"${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/symphony.exe -F ${FileData} %COIN_EXE_OPTIONS% > ${COIN_TEST_LOG_DIR}/${Name}.log 2>&1 \"") + + add_test(NAME ${Name} + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.bat) + else () + file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh "sh -c \"${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/symphony -F ${FileData} $COIN_EXE_OPTIONS > ${COIN_TEST_LOG_DIR}/${Name}.log 2>&1 \"") + + execute_process(COMMAND chmod a+x ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh) + add_test(NAME ${Name} + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh) + endif () + + if (WIN32) + # Escape each ';' in the %PATH% environment variable + string(REGEX REPLACE "\\\\" "/" WINPATH "$ENV{PATH}") + string(REGEX REPLACE "\;" "\\\\;" WINPATH "${WINPATH}") + + set(ENV_COIN_TESTS "PATH=${WINPATH}\\;${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/lib\\;${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/bin") + set_tests_properties(${Name} PROPERTIES ENVIRONMENT "PATH=${ENV_COIN_TESTS}") + endif () +endmacro() + +# add_coin_sym_test_list: generate a cmake wrapper around symphony executable and then add the test +# SolverName: the name of the solver. Will be appended to the out and log filename (must have the same name as the built target) +# Prefix: a prefix which will be added to the test name +# Suffix: a suffix which will be added to the test name +# FileList: the list of test file +# Label: a default label to tag tests +# Timeout: a dafault timeout for tests +macro(add_coin_sym_test_list SolverName Prefix Suffix FileList Label Timeout) + foreach(File ${${FileList}}) + get_filename_component(_NAME ${File} NAME) + string(REGEX REPLACE "[\\.]" "_" _NAME "${_NAME}") + + add_coin_sym_test(${Prefix}_${_NAME}_${Suffix} ${SolverName} ${File}) + + if (NOT COIN_TESTS_DISABLE_TIMEOUT) + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES TIMEOUT ${Timeout}) + else () + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES TIMEOUT 1000000) + endif () + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES LABELS "${Label}") + endforeach () +endmacro() + +# add_coin_vol_test: generate a cmake wrapper for Vol and then add the test +# SolverName: the name of the solver. Will be appended to the out and log filename (must have the same name as the built target) +# Name: the name of the test +# FileData: the name of the mps / lp data file + +macro(add_coin_vol_test Name SolverName FileData) + if (WIN32) + file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.bat "cmd.exe /C \"${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/vollp.exe -F ${FileData} > ${COIN_TEST_LOG_DIR}/${Name}.log 2>&1 \"") + + add_test(NAME ${Name} + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.bat) + else () + file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh "sh -c \"${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/vollp -F ${FileData} > ${COIN_TEST_LOG_DIR}/${Name}.log 2>&1 \"") + + execute_process(COMMAND chmod a+x ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh) + add_test(NAME ${Name} + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh) + endif () + + if (WIN32) + # Escape each ';' in the %PATH% environment variable + string(REGEX REPLACE "\\\\" "/" WINPATH "$ENV{PATH}") + string(REGEX REPLACE "\;" "\\\\;" WINPATH "${WINPATH}") + + set(ENV_COIN_TESTS "PATH=${WINPATH}\\;${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/lib\\;${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/bin") + set_tests_properties(${Name} PROPERTIES ENVIRONMENT "PATH=${ENV_COIN_TESTS}") + endif () +endmacro() + +# add_coin_vol_test_list: generate a cmake wrapper around osi_vol executable and then add the test +# Prefix: a prefix which will be added to the test name +# Suffix: a suffix which will be added to the test name +# FileList: the list of test file +# Label: a default label to tag tests +# Timeout: a dafault timeout for tests +macro(add_coin_vol_test_list Prefix Suffix FileList Label Timeout) + foreach(File ${${FileList}}) + get_filename_component(_NAME ${File} NAME) + string(REGEX REPLACE "[\\.]" "_" _NAME "${_NAME}") + + add_coin_test(${Prefix}_${_NAME}_${Suffix} osi_vol ${File}) + + if (NOT COIN_TESTS_DISABLE_TIMEOUT) + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES TIMEOUT ${Timeout}) + else () + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES TIMEOUT 1000000) + endif () + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES LABELS "${Label}") + endforeach () +endmacro() + +# add_coin_dylp_test: generate a cmake wrapper around osi_dylp executable and then add the test +# SolverName: the name of the solver. Will be appended to the out and log filename (must have the same name as the built target) +# Name: the name of the test +# FileData: the name of the mps / lp data file + +macro(add_coin_dylp_test Name SolverName FileData) + if (NOT EXISTS ${CMAKE_CURRENT_BINARY_DIR}/tmp) + make_directory(${CMAKE_CURRENT_BINARY_DIR}/tmp) + endif () + + get_filename_component(FileData_EXT ${FileData} EXT) + get_filename_component(FileData_NAME ${FileData} NAME) + + if ((FileData_EXT STREQUAL ".mps.gz") OR (FileData_EXT STREQUAL ".lp.gz") OR (FileData_EXT STREQUAL ".gz")) + string(REGEX REPLACE ".gz" "" FileData_NAME_NOGZ ${FileData_NAME}) + + if (WIN32) + file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.bat + "cmd.exe /C \"${CMAKE_COMMAND} -E copy ${FileData} ${CMAKE_CURRENT_BINARY_DIR}/tmp " + " && gunzip.exe -f ${CMAKE_CURRENT_BINARY_DIR}/tmp/${FileData_NAME} " + " && ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/osi_dylp.exe -L ${COIN_TEST_LOG_DIR}/${Name}.log -e ${CMAKE_CURRENT_SOURCE_DIR}/DyLP/src/Dylp/dy_errmsgs.txt ${CMAKE_CURRENT_BINARY_DIR}/tmp/${FileData_NAME_NOGZ})\"") + + add_test(NAME ${Name} + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.bat) + else () + file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh + "sh -c \"${CMAKE_COMMAND} -E copy ${FileData} ${CMAKE_CURRENT_BINARY_DIR}/tmp " + " && gunzip -f ${CMAKE_CURRENT_BINARY_DIR}/tmp/${FileData_NAME} " + " && ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/osi_dylp -L ${COIN_TEST_LOG_DIR}/${Name}.log -e ${CMAKE_CURRENT_SOURCE_DIR}/DyLP/src/Dylp/dy_errmsgs.txt ${CMAKE_CURRENT_BINARY_DIR}/tmp/${FileData_NAME_NOGZ})\"") + + execute_process(COMMAND chmod a+x ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh) + add_test(NAME ${Name} + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh) + endif () + else () + if (WIN32) + file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.bat + "cmd /C \"${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/osi_dylp.exe -L ${COIN_TEST_LOG_DIR}/${Name}.log -e ${CMAKE_CURRENT_SOURCE_DIR}/DyLP/src/Dylp/dy_errmsgs.txt ${FileData})\"") + + add_test(NAME ${Name} + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.bat) + else () + file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh + "sh -c \"${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/osi_dylp -L ${COIN_TEST_LOG_DIR}/${Name}.log -e ${CMAKE_CURRENT_SOURCE_DIR}/DyLP/src/Dylp/dy_errmsgs.txt ${FileData})\"") + + execute_process(COMMAND chmod a+x ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh) + add_test(NAME ${Name} + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/CoinTests/${Name}_${SolverName}.sh) + endif () + endif () + + if (WIN32) + # Escape each ';' in the %PATH% environment variable + string(REGEX REPLACE "\\\\" "/" WINPATH "$ENV{PATH}") + string(REGEX REPLACE "\;" "\\\\;" WINPATH "${WINPATH}") + + set(ENV_COIN_TESTS "PATH=${WINPATH}\\;${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/lib\\;${CMAKE_CURRENT_BINARY_DIR}/Dependencies/${CMAKE_CFG_INTDIR}/bin") + set_tests_properties(${Name} PROPERTIES ENVIRONMENT "PATH=${ENV_COIN_TESTS}") + endif () +endmacro() + +# add_coin_dylp_test_list: generate a cmake wrapper around osi_dylp executable and then add the test +# Prefix: a prefix which will be added to the test name +# Suffix: a suffix which will be added to the test name +# FileList: the list of test file +# Label: a default label to tag tests +# Timeout: a dafault timeout for tests +macro(add_coin_dylp_test_list Prefix Suffix FileList Label Timeout) + foreach(File ${${FileList}}) + get_filename_component(_NAME ${File} NAME) + string(REGEX REPLACE "[\\.]" "_" _NAME "${_NAME}") + + add_coin_test(${Prefix}_${_NAME}_${Suffix} osi_dylp ${File}) + + if (NOT COIN_TESTS_DISABLE_TIMEOUT) + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES TIMEOUT ${Timeout}) + else () + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES TIMEOUT 1000000) + endif () + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES LABELS "${Label}") + endforeach () +endmacro() + +# create_log_analysis: build a log analysis test for one solver. The string FAILED is returned is case of failure and PASSED in case of success +# - Name: a value corresponding to the name of the test +# - AdditionalName: a value corresponding to the suffix name of the test +# - TestRegex: the regex to be extracted with where the result must be found +# - TestRefVal: the reference result +# - TestRelLevel: the test threshold +macro(create_log_analysis Name AdditionalName TestRegex TestRefVal TestRelLevel) + add_test(NAME ${Name}_${AdditionalName} + WORKING_DIRECTORY ${BinTestPath} + COMMAND ${PYTHON_EXECUTABLE} ${CMAKE_CURRENT_SOURCE_DIR}/../cmake/parse_results.py ${COIN_TEST_LOG_DIR}/${Name}.log ${TestRegex} ${TestRefVal} ${TestRelLevel}) + + set_tests_properties(${Name}_${AdditionalName} PROPERTIES DEPENDS "${TestName}_${TestSolverName}") + set_tests_properties(${Name}_${AdditionalName} PROPERTIES ENVIRONMENT "${TEST_ENV_VAR}") + set_tests_properties(${Name}_${AdditionalName} PROPERTIES PASS_REGULAR_EXPRESSION "PASSED") + set_tests_properties(${Name}_${AdditionalName} PROPERTIES LABELS "ANALYSIS") +endmacro() + +# From hydrogen CMakeLists.txt file +string( ASCII 27 _escape) + +set(color_black "${_escape}[0;30m") # Black - Regular +set(color_red "${_escape}[0;31m") # Red +set(color_green "${_escape}[0;32m") # Green +set(color_yellow "${_escape}[0;33m") # Yellow +set(color_blue "${_escape}[0;34m") # Blue +set(color_purple "${_escape}[0;35m") # Purple +set(color_cyan "${_escape}[0;36m") # Cyan +set(color_white "${_escape}[0;37m") # White +set(color_bblack "${_escape}[1;30m") # Black - Bold +set(color_bred "${_escape}[1;31m") # Red +set(color_bgreen "${_escape}[1;32m") # Green +set(color_byellow "${_escape}[1;33m") # Yellow +set(color_bblue "${_escape}[1;34m") # Blue +set(color_bpurple "${_escape}[1;35m") # Purple +set(color_bcyan "${_escape}[1;36m") # Cyan +set(color_bwhite "${_escape}[1;37m") # White +set(color_ublack "${_escape}[4;30m") # Black - Underline +set(color_ured "${_escape}[4;31m") # Red +set(color_ugreen "${_escape}[4;32m") # Green +set(color_uyellow "${_escape}[4;33m") # Yellow +set(color_ublue "${_escape}[4;34m") # Blue +set(color_upurple "${_escape}[4;35m") # Purple +set(color_ucyan "${_escape}[4;36m") # Cyan +set(color_uwhite "${_escape}[4;37m") # White +set(color_bgblack "${_escape}[40m") # Black - Background +set(color_bgred "${_escape}[41m") # Red +set(color_bggreen "${_escape}[42m") # Green +set(color_bgyellow "${_escape}[43m") # Yellow +set(color_bgblue "${_escape}[44m") # Blue +set(color_bgpurple "${_escape}[45m") # Purple +set(color_bgcyan "${_escape}[46m") # Cyan +set(color_bgwhite "${_escape}[47m") # White +set(color_reset "${_escape}[0m") # Text Reset + +# Example of use: +# COLOR_MESSAGE("${color_cyan}Installation Summary${color_reset}") + +function(COLOR_MESSAGE TEXT) + if (CMAKE_COLOR_MAKEFILE AND NOT WIN32) + message(${TEXT}) + else () + string(REGEX REPLACE "${_escape}[\\[0123456789;]*m" "" __TEXT ${TEXT}) + message("${__TEXT} ") + endif () +endfunction () + +# add_regex: allow to concat several regex into one for using it with cmake +macro(add_regex VARIABLE REGEX) + set(${VARIABLE} "${${VARIABLE}}${REGEX}.*") +endmacro () + +# Example of use: +# +# set(TEST_REGEX "") +# add_regex(TEST_REGEX "INFO : Overall capacity cost : 7.54846e[+]09" ) +# add_regex(TEST_REGEX "INFO : Overall simulation cost : 3.40945e[+]09") +# add_regex(TEST_REGEX "INFO : Overall reward : -1.09579e[+]10" ) +# set_tests_properties(Test_Name PROPERTIES PASS_REGULAR_EXPRESSION "${TEST_REGEX}" ) + +# +# macros to manage files and version +# + +# add_source_files(ListFiles FilesToInclude VersionRef VersionToCheck) +# ListFiles: a variable name which will contain the resulting list of files +# FilesToInclude: a variable name containing a list of files to be included +# VersionRef: a string containing the reference version (above or equal to this version, the files are included in the resulting list) +# VersionToCheck: a string containing the test version. If the version is above or equal to this version, the files are included in the resulting list +macro(add_source_files ListFiles FilesToInclude VersionRef VersionToCheck) + if (("${VersionToCheck}" VERSION_GREATER "${VersionRef}") OR ("${VersionToCheck}" VERSION_EQUAL "${VersionRef}")) + set(${ListFiles} ${${ListFiles}} + ${FilesToInclude}) + endif () +endmacro() + +# remove_source_files(ListFiles FilesToExclude VersionRef VersionToCheck) +# ListFiles: a variable name which will contain the resulting list of files +# FilesToInclude: a variable name containing a list of files to be excluded +# VersionRef: a string containing the reference version (above or equal to this version, the files are excluded from the resulting list) +# VersionToCheck: a string containing the test version. If the version is above or equal to this version, the files are excluded from the resulting list +macro(remove_source_files ListFiles FilesToExclude VersionRef VersionToCheck) + if (("${VersionToCheck}" VERSION_GREATER "${VersionRef}") OR ("${VersionToCheck}" VERSION_EQUAL "${VersionRef}")) + set(TMP_LIST ${FilesToExclude}) + #foreach(Item ${TMP_LIST}) + foreach(Item IN LISTS TMP_LIST) + list(REMOVE_ITEM ${ListFiles} ${Item}) + endforeach() + endif () +endmacro() + +# +# How to use these macros: +# +# +# set(LIST_SRCS file1.cpp +# file2.cpp +# file3.cpp) +# +# set(LIST_TO_ADD_SRCS file4.cpp +# file5.cpp +# file6.cpp) +# +# set(VERSION "1.1") +# +# add_source_files(LIST_SRCS "${LIST_TO_ADD_SRCS}" "1.0" "${VERSION}") +# +# set(LIST_TO_ADD_SRCS file7.cpp) +# +# set(VERSION "0.9") +# +# add_source_files(LIST_SRCS "${LIST_TO_ADD_SRCS}" "1.0" "${VERSION}") +# +# message(STATUS "RESULT: ADD - LIST_SRCS = ${LIST_SRCS}") +# +# set(LIST_TO_REMOVE_SRCS file4.cpp) +# +# set(VERSION "1.1") +# +# remove_source_files(LIST_SRCS LIST_TO_REMOVE_SRCS "1.0" "${VERSION}") +# +# set(LIST_TO_REMOVE_SRCS file5.cpp) +# +# set(VERSION "0.9") +# +# remove_source_files(LIST_SRCS LIST_TO_REMOVE_SRCS "1.0" "${VERSION}") +# +# message(STATUS "RESULT: REMOVE - LIST_SRCS = ${LIST_SRCS}") + +macro(add_ipopt_test Name FileData) + add_test(NAME ${Name} + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/bin/ipopt -- ${FileData}) +endmacro() + +macro(add_ipopt_test_list Prefix Suffix FileList Label Timeout) + foreach(File ${${FileList}}) + string(REGEX REPLACE "[\\.]" "_" _NAME "${File}") + string(REGEX REPLACE "[-]" "_" _NAME "${_NAME}") + string(REGEX REPLACE "[/]" "_" _NAME "${_NAME}") + + add_ipopt_test(${Prefix}_${_NAME}_${Suffix} ${IPOPT_INSTANCES_DIR}/${File}) + + if (NOT COIN_TESTS_DISABLE_TIMEOUT) + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES TIMEOUT ${Timeout}) + else () + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES TIMEOUT 1000000) + endif () + set_tests_properties(${Prefix}_${_NAME}_${Suffix} PROPERTIES LABELS "${Label}") + endforeach () +endmacro() diff --git a/Ipopt-3.13.4/cmake/compat.c b/Ipopt-3.13.4/cmake/compat.c new file mode 100644 index 000000000..9fb447d2d --- /dev/null +++ b/Ipopt-3.13.4/cmake/compat.c @@ -0,0 +1,17 @@ +#include +#include + +#ifdef __cplusplus +extern "C" { +#endif + +// Prior to GLIBC_2.14, memcpy was aliased to memmove. +void* memmove(void* a, const void* b, size_t c); +void* memcpy(void* a, const void* b, size_t c); +void* memcpy(void* a, const void* b, size_t c) { + return memmove(a, b, c); +} + +#ifdef __cplusplus +} +#endif diff --git a/Ipopt-3.13.4/cmake/compat.cpp b/Ipopt-3.13.4/cmake/compat.cpp new file mode 100644 index 000000000..134acdc86 --- /dev/null +++ b/Ipopt-3.13.4/cmake/compat.cpp @@ -0,0 +1,80 @@ +#include +#include +#include +#include + +#ifndef _GLIBCXX_USE_NOEXCEPT +# define _GLIBCXX_USE_NOEXCEPT throw() +#endif + +namespace std { + +const char* bad_exception::what() const throw() +{ + return "std::bad_exception"; +} + +const char* bad_cast::what() const throw() +{ + return "std::bad_cast"; +} + +const char* bad_alloc::what() const throw() +{ + return "std::bad_alloc"; +} + +namespace __detail +{ +struct _List_node_base +{ + void _M_hook(std::__detail::_List_node_base* const __position) throw () __attribute__((used)) + { + _M_next = __position; + _M_prev = __position->_M_prev; + __position->_M_prev->_M_next = this; + __position->_M_prev = this; + } + void _M_unhook() __attribute__((used)) + { + _List_node_base* const __next_node = _M_next; + _List_node_base* const __prev_node = _M_prev; + __prev_node->_M_next = __next_node; + __next_node->_M_prev = __prev_node; + } + _List_node_base* _M_next; + _List_node_base* _M_prev; +}; +} // namespace detail + +template ostream& ostream::_M_insert(bool); +template ostream& ostream::_M_insert(long); +template ostream& ostream::_M_insert(double); +template ostream& ostream::_M_insert(unsigned long); +template ostream& ostream::_M_insert(const void*); +template ostream& __ostream_insert(ostream&, const char*, streamsize); +template istream& istream::_M_extract(long&); +template istream& istream::_M_extract(unsigned short&); + +out_of_range::~out_of_range() _GLIBCXX_USE_NOEXCEPT { } + +// Used with permission. +// See: https://github.com/madlib/madlib/commit/c3db418c0d34d6813608f2137fef1012ce03043d + +void +ctype::_M_widen_init() const { + char __tmp[sizeof(_M_widen)]; + for (unsigned __i = 0; __i < sizeof(_M_widen); ++__i) + __tmp[__i] = __i; + do_widen(__tmp, __tmp + sizeof(__tmp), _M_widen); + + _M_widen_ok = 1; + // Set _M_widen_ok to 2 if memcpy can't be used. + for (unsigned __i = 0; __i < sizeof(_M_widen); ++__i) + if (__tmp[__i] != _M_widen[__i]) { + _M_widen_ok = 2; + break; + } +} + +}// namespace std diff --git a/Ipopt-3.13.4/cmake/compatibility.h b/Ipopt-3.13.4/cmake/compatibility.h new file mode 100644 index 000000000..004e57992 --- /dev/null +++ b/Ipopt-3.13.4/cmake/compatibility.h @@ -0,0 +1,11 @@ +#if defined(__linux) && !defined(DISABLE_SYMVER) +__asm__(".symver memcpy, memcpy@GLIBC_2.2.5"); +__asm__(".symver omp_set_lock, omp_set_lock@OMP_1.0"); +__asm__(".symver omp_unset_lock, omp_unset_lock@OMP_1.0"); +__asm__(".symver omp_init_lock, omp_init_lock@OMP_1.0"); +#endif + +#ifdef _MSC_VER +# define stricmp _stricmp +# define inline __inline +#endif diff --git a/Ipopt-3.13.4/cmake/export_git.cmake b/Ipopt-3.13.4/cmake/export_git.cmake new file mode 100644 index 000000000..447fa7d04 --- /dev/null +++ b/Ipopt-3.13.4/cmake/export_git.cmake @@ -0,0 +1,176 @@ +#------------------------------------------------------------ +# Find Git +#------------------------------------------------------------ + +# GIT_EXECUTABLE - path to git command line client +# GIT_FOUND - true if the command line client was found +# GIT_VERSION_STRING - the version of git found (since CMake 2.8.8) + +find_package(Git) + +if (NOT GIT_FOUND) + message(ERROR "Git required to build this tool") +endif () + +if (NOT TARGET git-update) + add_custom_target(git-update) +endif () + +# GIT_WC_INFO(dir prefix) +# Input parameters: +# - dir: the root directory of the git repository +# - prefix: the prefix which will be prefixed to each result variable +# Macro which return 2 informations related to the git repo: +# - ${prefix}_WC_REVISION: the hash revision number of the current state of the repo +# - ${prefix}_WC_ROOT: the origin URL of the repository +# - ${prefix}_WC_DESCRIBE: the 'git describe' version of the working copy +# - ${prefix}_WC_SVNEQUIV: return an equivalent to a svn revision number (the number of commit after a tag) + +macro(GIT_WC_INFO dir prefix) + execute_process(COMMAND ${GIT_EXECUTABLE} rev-list -n 1 HEAD + WORKING_DIRECTORY ${dir} + ERROR_VARIABLE GIT_error + OUTPUT_VARIABLE ${prefix}_WC_REVISION_HASH + OUTPUT_STRIP_TRAILING_WHITESPACE) + + set(${prefix}_WC_REVISION ${${prefix}_WC_REVISION_HASH}) + + if (NOT ${GIT_error} EQUAL 0) + message(SEND_ERROR "Command \"${GIT_EXECUTABLE} rev-list -n 1 HEAD\" in directory ${dir} failed with output:\n${GIT_error}") + else () + execute_process(COMMAND ${GIT_EXECUTABLE} name-rev ${${prefix}_WC_REVISION_HASH} + WORKING_DIRECTORY ${dir} + OUTPUT_VARIABLE ${prefix}_WC_REVISION_NAME + OUTPUT_STRIP_TRAILING_WHITESPACE) + endif () + + execute_process(COMMAND ${GIT_EXECUTABLE} config --get remote.origin.url + WORKING_DIRECTORY ${dir} + OUTPUT_VARIABLE ${prefix}_WC_URL + OUTPUT_STRIP_TRAILING_WHITESPACE) + + set(${prefix}_WC_ROOT ${${prefix}_WC_URL}) + + execute_process(COMMAND ${GIT_EXECUTABLE} describe --tags --abbrev=8 + WORKING_DIRECTORY ${dir} + OUTPUT_VARIABLE ${prefix}_WC_DESCRIBE + ERROR_VARIABLE GIT_ERROR_VAR + OUTPUT_STRIP_TRAILING_WHITESPACE) + + if (NOT GIT_ERROR_VAR STREQUAL "") + message(FATAL_ERROR "Error: Git describe doesn't work - missing tags ?") + endif () + + string(REGEX REPLACE "(.*-)([0-9]*)(-g.*)" "\\2" ${prefix}_WC_SVNEQUIV "${${prefix}_WC_DESCRIBE}") +endmacro(GIT_WC_INFO) + +# Clone a git repository by branch. +# Input variables: +# - Path_repo: the URL of the repo (git@192.168.0.18:NetworkDesignerDemo for example) +# - Path_dest: the URL of the destination directory (/home/me/myclonedrepo/ for example) +# - Repo_branch: the name of the branch to be cloned +# - Repo_commit: the hash tag of the commit to be retrieved (HEAD for example) +# - Rule_name: the name of the rule to update the repo +macro(clone_git_branch Path_repo Path_dest Repo_branch Repo_commit Rule_name) + if ("${Repo_branch}" STREQUAL "master") + message(FATAL_ERROR "Can't clone the master branch, use the 'clone_git' macro instead") + endif () + + if ("${Repo_commit}" STREQUAL "") + set (Repo_commit "HEAD") + endif () + + if (NOT EXISTS ${Path_dest}) + execute_process(COMMAND ${CMAKE_COMMAND} -E make_directory ${Path_dest}) + execute_process(COMMAND ${GIT_EXECUTABLE} clone -b ${Repo_branch} ${Path_repo} ${Path_dest} + OUTPUT_VARIABLE _GIT_CLONE_GIT_BRANCH_OUTPUT + ERROR_VARIABLE _GIT_CLONE_GIT_BRANCH_ERROR) + if (NOT ${_GIT_CLONE_GIT_BRANCH_ERROR} EQUAL 0) + message(SEND_ERROR "Command ${GIT_EXECUTABLE} clone failed with output:\n${_GIT_CLONE_GIT_BRANCH_ERROR}") + endif () + endif () + + add_custom_target(git-update-branch-${Rule_name}) + add_custom_command(TARGET git-update-branch-${Rule_name} + COMMAND ${GIT_EXECUTABLE} pull + WORKING_DIRECTORY ${Path_dest} + COMMENT "clone_git_branch: updating repository branch ${Repo_branch} in ${Path_dest}") + + add_dependencies(git-update git-update-branch-${Rule_name}) + + add_subdirectory(${Path_dest}) +endmacro(clone_git_branch) + +# Clone a git repository by tag. +# Input variables: +# - Path_repo: the URL of the repo (git@192.168.0.18:NetworkDesignerDemo for example) +# - Path_dest: the URL of the destination directory (/home/me/myclonedrepo/ for example) +# - Repo_branch: the name of the branch to be cloned +# - Repo_commit: the hash tag of the commit to be retrieved (HEAD for example) +# - Rule_name: the name of the rule to update the repo +macro(clone_git_tag Path_repo Path_dest Repo_tag Repo_commit Rule_name) + if ("${Repo_tag}" STREQUAL "master") + message(FATAL_ERROR "Can't clone the tag branch, use the 'clone_git' macro instead") + endif () + + if ("${Repo_commit}" STREQUAL "") + set (Repo_commit "HEAD") + endif () + + if (NOT EXISTS ${Path_dest}) + execute_process(COMMAND ${CMAKE_COMMAND} -E make_directory ${Path_dest}) + execute_process(COMMAND ${GIT_EXECUTABLE} clone ${Path_repo} ${Path_dest} + COMMAND ${GIT_EXECUTABLE} checkout tags/${Repo_tag} ${Repo_commit} + WORKING_DIRECTORY ${Path_dest} + OUTPUT_VARIABLE _GIT_CLONE_GIT_TAG_OUTPUT + ERROR_VARIABLE _GIT_CLONE_GIT_TAG_ERROR) + + if (NOT ${_GIT_CLONE_GIT_TAG_ERROR} EQUAL 0) + message(SEND_ERROR "Command ${GIT_EXECUTABLE} clone failed with output:\n${_GIT_CLONE_GIT_TAG_ERROR}") + endif () + endif () + + add_custom_target(git-update-tag-${Rule_name}) + add_custom_command(TARGET git-update-tag-${Rule_name} + COMMAND ${GIT_EXECUTABLE} pull + WORKING_DIRECTORY ${Path_dest} + COMMENT "clone_git_tag: updating repository tag ${Repo_branch} in ${Path_dest}") + + add_dependencies(git-update git-update-tag-${Rule_name}) + + add_subdirectory(${Path_dest}) +endmacro(clone_git_tag) + +# Clone a git repository +# Input variables: +# - Path_repo: the URL of the repo (git@192.168.0.18:NetworkDesignerDemo for example) +# - Path_dest: the URL of the destination directory (/home/me/myclonedrepo/ for example) +# - Repo_commit: the hash tag of the commit to be retrieved (HEAD for example) +# - Rule_name: the name of the rule to update the repo +macro(clone_git Path_repo Path_dest Repo_commit Rule_name) + if ("${Repo_commit}" STREQUAL "") + set (Repo_commit "HEAD") + endif () + + if (NOT EXISTS ${Path_dest}) + execute_process(COMMAND ${CMAKE_COMMAND} -E make_directory ${Path_dest}) + execute_process(COMMAND ${GIT_EXECUTABLE} clone ${Path_repo} ${Path_dest} + WORKING_DIRECTORY ${Path_dest} + OUTPUT_VARIABLE _GIT_CLONE_GIT_BRANCH_OUTPUT + ERROR_VARIABLE _GIT_CLONE_GIT_BRANCH_ERROR) + + if (NOT ${_GIT_CLONE_GIT_BRANCH_ERROR} EQUAL 0) + message(SEND_ERROR "Command ${GIT_EXECUTABLE} clone failed with output:\n${_GIT_CLONE_GIT_BRANCH_ERROR}") + endif () + endif () + + add_custom_target(git-update-${Rule_name}) + add_custom_command(TARGET git-update-${Rule_name} + COMMAND ${GIT_EXECUTABLE} pull + WORKING_DIRECTORY ${Path_dest} + COMMENT "clone_git: updating repository tag ${Repo_branch} in ${Path_dest}") + + add_dependencies(git-update git-update-${Rule_name}) + + add_subdirectory(${Path_dest}) +endmacro(clone_git) diff --git a/Ipopt-3.13.4/cmake/ipopt_macros.cmake b/Ipopt-3.13.4/cmake/ipopt_macros.cmake new file mode 100644 index 000000000..22eb16286 --- /dev/null +++ b/Ipopt-3.13.4/cmake/ipopt_macros.cmake @@ -0,0 +1,274 @@ +# Attempt to automatically determine the Fortran name-mangling scheme. +# We do this by: +# +# 1) creating a library from a Fortran source file which defines a function "mysub" +# 2) attempting to link with this library a C source file which calls the "mysub" +# function using various possible schemes (6 different schemes, corresponding +# to all combinations lower/upper case and none/one/two underscores) +# +# Note that, since names of symbols with and without underscore may be mangled +# differently (e.g. g77 mangles mysub to mysub_ and my_sub to my_sub__), we have +# to consider both cases. The two name mangling schemes are encoded in the cached +# variables SCHEME_NO_UNDERSCORES and SCHEME_WITH_UNDERSCORES. +# +# Once the name mangling schemes are determined, we use them to define two C +# preprocessor macros, F77_FUNC and F77_FUNC_, corresponding to the two cases: +# symbols with names not containing underscores and symbols with names containing +# underscores. For example, if using g77 the definitions of these two macros will be: +# #define F77_FUNC(name,NAME) name ## _ +# #define F77_FUNC_(name,NAME) name ## __ +# The appropriate #define lines are stored in the cached variables DEFINE_F77_FUNC and +# DEFINE_F77_FUNC_, respectively, and can be used to generate a configuration header +# file (using CONFIGURE_FILE). + +# Need Fortran support for this +ENABLE_LANGUAGE(Fortran) + +# Make sure that the following tests use the C and Fortran flags corresponding +# to the current build type. These flags are stored in the variables TMP_C_FLAGS +# and TMP_Fortran_FLAGS, respectively, and are used in the generated CMakeLists files. +IF(NOT CMAKE_BUILD_TYPE) + SET(TMP_C_FLAGS ${CMAKE_C_FLAGS}) + SET(TMP_Fortran_FLAGS ${CMAKE_Fortran_FLAGS}) +ENDIF(NOT CMAKE_BUILD_TYPE) +IF(CMAKE_BUILD_TYPE MATCHES "Default") + SET(TMP_C_FLAGS ${CMAKE_C_FLAGS}) + SET(TMP_Fortran_FLAGS ${CMAKE_Fortran_FLAGS}) +ENDIF(CMAKE_BUILD_TYPE MATCHES "Default") +IF(CMAKE_BUILD_TYPE MATCHES "Release") + SET(TMP_C_FLAGS ${CMAKE_C_FLAGS_RELEASE}) + SET(TMP_Fortran_FLAGS ${CMAKE_Fortran_FLAGS_RELEASE}) +ENDIF(CMAKE_BUILD_TYPE MATCHES "Release") +IF(CMAKE_BUILD_TYPE MATCHES "Debug") + SET(TMP_C_FLAGS ${CMAKE_C_FLAGS_DEBUG}) + SET(TMP_Fortran_FLAGS ${CMAKE_Fortran_FLAGS_DEBUG}) +ENDIF(CMAKE_BUILD_TYPE MATCHES "Debug") +IF(CMAKE_BUILD_TYPE MATCHES "RelWithDebInfo") + SET(TMP_C_FLAGS ${CMAKE_C_FLAGS_RELWITHDEBINFO}) + SET(TMP_Fortran_FLAGS ${CMAKE_Fortran_FLAGS_RELWITHDEBINFO}) +ENDIF(CMAKE_BUILD_TYPE MATCHES "RelWithDebInfo") +IF(CMAKE_BUILD_TYPE MATCHES "MinSizeRel") + SET(TMP_C_FLAGS ${CMAKE_C_FLAGS_MINSIZE}) + SET(TMP_Fortran_FLAGS ${CMAKE_Fortran_FLAGS_MINSIZE}) +ENDIF(CMAKE_BUILD_TYPE MATCHES "MinSizeRel") + +# Create a CMakeLists.txt file which will generate the "flib" library +FILE(WRITE ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/CMakeLists.txt + "PROJECT(FortranTest Fortran)\n" + "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" + "SET(CMAKE_Fortran_FLAGS \"${TMP_Fortran_FLAGS}\")\n" + "ADD_LIBRARY(flib ftest.f)\n" + ) + +# Create a simple Fortran source which defines two subroutines, "mysub" and "my_sub" +FILE(WRITE ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/ftest.f + " SUBROUTINE mysub\n" + " RETURN\n" + " END\n" + " SUBROUTINE my_sub\n" + " RETURN\n" + " END\n" + ) + +# Use TRY_COMPILE to make the target "flib" +TRY_COMPILE( + FTEST_OK + ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp + ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp + flib + OUTPUT_VARIABLE MY_OUTPUT) + +message("${MY_OUTPUT}") + +# Initialize the name mangling schemes for symbol names +# with and without underscores +SET(SCHEME_NO_UNDERSCORES "" + CACHE INTERNAL "Name mangling scheme (symbol names without underscores)") +SET(SCHEME_WITH_UNDERSCORES "" + CACHE INTERNAL "Name mangling scheme (symbol names with underscores)") + +# Continue only if we were successful in creating the "flib" library +IF(FTEST_OK) + + # CASE 1: symbol names WITHOUT undersores + # --------------------------------------- + + # Overwrite CMakeLists.txt with one which will generate the "ctest1" executable + FILE(WRITE ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/CMakeLists.txt + "PROJECT(FortranTest C)\n" + "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" + "SET(CMAKE_C_FLAGS \"${TMP_C_FLAGS}\")\n" + "ADD_EXECUTABLE(ctest1 ctest1.c)\n" + "FIND_LIBRARY(FLIB flib ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp)\n" + "TARGET_LINK_LIBRARIES(ctest1 \${FLIB})\n") + + # Define the list "options" of all possible schemes that we want to consider + # Get its length and initialize the counter "iopt" to zero + SET(options mysub mysub_ mysub__ MYSUB MYSUB_ MYSUB__) + LIST(LENGTH options imax) + SET(iopt 0) + + # We will attempt to sucessfully generate the "ctest" executable as long as + # there still are entries in the "options" list + WHILE(${iopt} LESS ${imax}) + + # Get the current list entry (current scheme) + LIST(GET options ${iopt} opt) + + # Generate C source which calls the "mysub" function using the current scheme + FILE(WRITE ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/ctest1.c + "int main(){${opt}();return(0);}\n") + + # Use TRY_COMPILE to make the "ctest1" executable from the current C source + # and linking to the previously created "flib" library. + TRY_COMPILE( + CTEST_OK + ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp + ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp + ctest1 + OUTPUT_VARIABLE MY_OUTPUT) + + # To ensure we do not use stuff from the previous attempts, we must remove the + # CMakeFiles directory. + # ??? I didn't think I'll have to do this, but it doesn't work otherwise + FILE(REMOVE_RECURSE ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/CMakeFiles) + + # Test if we successfully created the "ctest" executable. + # If yes, flag that we have successfuly determined the name mangling scheme, + # save the current scheme, and set the counter "iopt" to "imax" so that we + # exit the while loop. + # Otherwise, increment the counter "iopt" and go back in the while loop. + IF(CTEST_OK) + SET(SCHEME_NO_UNDERSCORES ${opt} + CACHE INTERNAL "Name mangling scheme (symbol names without underscores)") + SET(iopt ${imax}) + ELSE(CTEST_OK) + MATH(EXPR iopt ${iopt}+1) + ENDIF(CTEST_OK) + + ENDWHILE(${iopt} LESS ${imax}) + + # CASE 2: symbol names WITH undersores + # ------------------------------------ + + FILE(WRITE ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/CMakeLists.txt + "PROJECT(FortranTest C)\n" + "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" + "SET(CMAKE_C_FLAGS \"${TMP_C_FLAGS}\")\n" + "ADD_EXECUTABLE(ctest2 ctest2.c)\n" + "FIND_LIBRARY(FLIB flib ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp)\n" + "TARGET_LINK_LIBRARIES(ctest2 \${FLIB})\n") + + SET(options my_sub my_sub_ my_sub__ MY_SUB MY_SUB_ MY_SUB__) + LIST(LENGTH options imax) + SET(iopt 0) + + WHILE(${iopt} LESS ${imax}) + LIST(GET options ${iopt} opt) + FILE(WRITE ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/ctest2.c + "int main(){${opt}();return(0);}\n") + TRY_COMPILE( + CTEST_OK + ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp + ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp + ctest2 + OUTPUT_VARIABLE MY_OUTPUT) + FILE(REMOVE_RECURSE ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/CMakeFiles) + IF(CTEST_OK) + SET(SCHEME_WITH_UNDERSCORES ${opt} + CACHE INTERNAL "Name mangling scheme (symbol names with underscores)") + SET(iopt ${imax}) + ELSE(CTEST_OK) + MATH(EXPR iopt ${iopt}+1) + ENDIF(CTEST_OK) + ENDWHILE(${iopt} LESS ${imax}) + +ENDIF(FTEST_OK) + +# If the name mangling scheme of symbol names not containing underscores +# was successfully determined, set the appropriate C preprocessor macro + +SET(CPP_macro "") + +IF(SCHEME_NO_UNDERSCORES) + + IF(SCHEME_NO_UNDERSCORES MATCHES "mysub") + SET(CPP_macro "#define F77_FUNC(name,NAME) name") + ENDIF(SCHEME_NO_UNDERSCORES MATCHES "mysub") + + IF(SCHEME_NO_UNDERSCORES MATCHES "mysub_") + SET(CPP_macro "#define F77_FUNC(name,NAME) name ## _") + ENDIF(SCHEME_NO_UNDERSCORES MATCHES "mysub_") + + IF(SCHEME_NO_UNDERSCORES MATCHES "mysub__") + SET(CPP_macro "#define F77_FUNC(name,NAME) name ## __") + ENDIF(SCHEME_NO_UNDERSCORES MATCHES "mysub__") + + IF(SCHEME_NO_UNDERSCORES MATCHES "MYSUB") + SET(CPP_macro "#define F77_FUNC(name,NAME) NAME") + ENDIF(SCHEME_NO_UNDERSCORES MATCHES "MYSUB") + + IF(SCHEME_NO_UNDERSCORES MATCHES "MYSUB_") + SET(CPP_macro "#define F77_FUNC(name,NAME) NAME ## _") + ENDIF(SCHEME_NO_UNDERSCORES MATCHES "MYSUB_") + + IF(SCHEME_NO_UNDERSCORES MATCHES "MYSUB__") + SET(CPP_macro "#define F77_FUNC(name,NAME) NAME ## __") + ENDIF(SCHEME_NO_UNDERSCORES MATCHES "MYSUB__") + +ENDIF(SCHEME_NO_UNDERSCORES) + +SET(DEFINE_F77_FUNC ${CPP_macro} + CACHE INTERNAL "CPP macro for name mangling scheme of symbols without underscores") + +IF(SCHEME_NO_UNDERSCORES) + MESSAGE("Name mangling scheme for symbol names without underscores:\n" + " mysub -> ${SCHEME_NO_UNDERSCORES}\n" + " ${DEFINE_F77_FUNC}") +ELSE(SCHEME_NO_UNDERSCORES) + MESSAGE("Unable to determine name mangling scheme for symbol names without underscores!") +ENDIF(SCHEME_NO_UNDERSCORES) + +# If the name mangling scheme of symbol names containing underscores +# was successfully determined, set the appropriate C preprocessor macro + +SET(CPP_macro "") + +IF(SCHEME_WITH_UNDERSCORES) + + IF(SCHEME_WITH_UNDERSCORES MATCHES "my_sub") + SET(CPP_macro "#define F77_FUNC_(name,NAME) name") + ENDIF(SCHEME_WITH_UNDERSCORES MATCHES "my_sub") + + IF(SCHEME_WITH_UNDERSCORES MATCHES "my_sub_") + SET(CPP_macro "#define F77_FUNC_(name,NAME) name ## _") + ENDIF(SCHEME_WITH_UNDERSCORES MATCHES "my_sub_") + + IF(SCHEME_WITH_UNDERSCORES MATCHES "my_sub__") + SET(CPP_macro "#define F77_FUNC_(name,NAME) name ## __") + ENDIF(SCHEME_WITH_UNDERSCORES MATCHES "my_sub__") + + IF(SCHEME_WITH_UNDERSCORES MATCHES "MY_SUB") + SET(CPP_macro "#define F77_FUNC_(name,NAME) NAME") + ENDIF(SCHEME_WITH_UNDERSCORES MATCHES "MY_SUB") + + IF(SCHEME_WITH_UNDERSCORES MATCHES "MY_SUB_") + SET(CPP_macro "#define F77_FUNC_(name,NAME) NAME ## _") + ENDIF(SCHEME_WITH_UNDERSCORES MATCHES "MY_SUB_") + + IF(SCHEME_WITH_UNDERSCORES MATCHES "MY_SUB__") + SET(CPP_macro "#define F77_FUNC_(name,NAME) NAME ## __") + ENDIF(SCHEME_WITH_UNDERSCORES MATCHES "MY_SUB__") + +ENDIF(SCHEME_WITH_UNDERSCORES) + +SET(DEFINE_F77_FUNC_ "${CPP_macro}" + CACHE INTERNAL "CPP macro for name mangling scheme of symbols with underscores") + +IF(SCHEME_WITH_UNDERSCORES) + MESSAGE("Name mangling scheme for symbol names with underscores:\n" + " my_sub -> ${SCHEME_WITH_UNDERSCORES}\n" + " ${DEFINE_F77_FUNC_}") +ELSE(SCHEME_WITH_UNDERSCORES) + MESSAGE("Unable to determine name mangling scheme for symbol names with underscores!") +ENDIF(SCHEME_WITH_UNDERSCORES) \ No newline at end of file diff --git a/Ipopt-3.13.4/cmake/libstdc++-compatibility.cpp b/Ipopt-3.13.4/cmake/libstdc++-compatibility.cpp new file mode 100644 index 000000000..6fa189ec3 --- /dev/null +++ b/Ipopt-3.13.4/cmake/libstdc++-compatibility.cpp @@ -0,0 +1,232 @@ +/* ----------------------------------------------------------------------- *//** + * + * @file libstdcxx-compatibility.cpp + * + * @brief Declarations/definitions for using an "old" libstdc++ with a newer g++ + * + * This file follows ideas proposed here: http://glandium.org/blog/?p=1901 + * Unfortunately, MADlib seems to use libstdc++ to a greater extend than + * Firefox 4.0 did, so we need to do a bit more. + * + * The declarations and definitions in this file make it possible to build + * MADlib with the following versions of gcc (please add to the list), while + * continuing to only rely on libstdc++.so.6.0.8 (which corresponds to + * gcc 4.1.2, and labels GLIBCXX_3.4.8, CXXABI_1.3.1). + * + * As of September 2012, there is still the need to support libstdc++.so.6.0.8, + * as this is the libstdc++ that shipped with RedHad/CentOS 5. + * + * Tested with the following versions of gcc: + * - gcc 4.4.2 + * - gcc 4.5.4 + * - gcc 4.6.2 + * + * For a mapping between gcc versions, libstdc++ versions, and symbol versioning + * on the libstdc++.so binary, see: + * http://gcc.gnu.org/onlinedocs/libstdc++/manual/abi.html + * + *//* ----------------------------------------------------------------------- */ + +#include + +// The following macro was introduced with this commit: +// http://gcc.gnu.org/viewcvs?diff_format=h&view=revision&revision=173774 +#ifndef _GLIBCXX_USE_NOEXCEPT + #define _GLIBCXX_USE_NOEXCEPT throw() +#endif + +#define GCC_VERSION ( __GNUC__ * 10000 \ + + __GNUC_MINOR__ * 100 \ + + __GNUC_PATCHLEVEL__) + +// CXXABI_1.3.2 symbols + +#if (LIBSTDCXX_COMPAT < 40300 && GCC_VERSION >= 40300) + +namespace __cxxabiv1 { + +/** + * @brief Virtual destructor for forced-unwinding class + * + * We provide an implementation to avoid CXXABI_1.3.2 symbol versions. + * + * Older versions of libstdc++ had the problem that POSIX thread cancellations + * while writing to an ostream caused an abort: + * http://gcc.gnu.org/bugzilla/show_bug.cgi?id=28145 + * + * Newer versions have an additional catch block for references of type + * __cxxabiv1::__forced_unwind, which represents the POSIX cancellation object: + * http://gcc.gnu.org/onlinedocs/libstdc++/manual/using_exceptions.html + * See, e.g., file included from . Catching + * exceptions of this type requires its \c type_info object. However, this + * object is not normally present in the current binary, as explained in the + * following. + * + * The type __cxxabiv1::__forced_unwind was only introduced in May 2007 (see + * attachments to the previous bug report) and thus after the release of + * gcc 4.1.2 (Feb 13, 2007, see http://gcc.gnu.org/releases.html). + * + * As http://gcc.gnu.org/onlinedocs/gcc/Vague-Linkage.html explains: + *
    + * If the class declares any non-inline, non-pure virtual functions, the + * first one is chosen as the "key method" for the class, and the vtable is + * only emitted in the translation unit where the key method is defined. + *
    + * + * And later on the same page: + *
    + * For polymorphic classes (classes with virtual functions), the + * \c type_info object is written out along with the vtable [...]. + *
    + * + * Hence, to include a vtable, we need a definition for the key method, which is + * the constructor. See the declaration here: + * http://gcc.gnu.org/viewcvs/trunk/libstdc%2B%2B-v3/libsupc%2B%2B/cxxabi_forced.h + */ +__forced_unwind::~__forced_unwind() _GLIBCXX_USE_NOEXCEPT { } + +} // namespace __cxxabiv1 + +#endif // (LIBSTDCXX_COMPAT < 40300 && GCC_VERSION >= 40300) + + +// GLIBCXX_3.4.9 symbols + +#if (LIBSTDCXX_COMPAT < 40200 && GCC_VERSION >= 40200) + +namespace std { + +/** + * @brief Write a value to an ostream + * + * In recent versions of libstdc++, \c _M_insert contains the implementation for + * the various operator<<() overloads. Now, as http://glandium.org/blog/?p=1901 + * explains, newer libstdc++ versions contain various instantiations for + * \c _M_insert, even though contains a general (template) + * definition. + * + * Older versions of libstdc++ did not contain implementations for \c _M_insert, + * so we instantiate them here. See this change: + * http://gcc.gnu.org/viewcvs/trunk/libstdc%2B%2B-v3/include/bits/ostream.tcc?r1=109235&r2=109236& + */ +template ostream& ostream::_M_insert(bool); +// The following four lines are not needed and commented out. Specialized +// implementations exist for ostream<<([unsigned] {short|int}). +// template ostream& ostream::_M_insert(short); +// template ostream& ostream::_M_insert(unsigned short); +// template ostream& ostream::_M_insert(int); +// template ostream& ostream::_M_insert(unsigned int); +template ostream& ostream::_M_insert(long); +template ostream& ostream::_M_insert(unsigned long); +#ifdef _GLIBCXX_USE_LONG_LONG +template ostream& ostream::_M_insert(long long); +template ostream& ostream::_M_insert(unsigned long long); +#endif +template ostream& ostream::_M_insert(float); +template ostream& ostream::_M_insert(double); +template ostream& ostream::_M_insert(long double); +template ostream& ostream::_M_insert(const void*); + +/** + * @brief Write a sequence of characters to an ostream + * + * This function was only added with this commit: + * http://gcc.gnu.org/viewcvs?view=revision&revision=123692 + */ +template ostream& __ostream_insert(ostream&, const char*, streamsize); + +} // namespace std + +#endif // (LIBSTDCXX_COMPAT < 40200 && GCC_VERSION >= 40200) + + +// GLIBCXX_3.4.11 symbols + +#if (LIBSTDCXX_COMPAT < 40400 && GCC_VERSION >= 40400) + +namespace std { + +/** + * @brief Initialize an internal data structure of ctype + * + * This was previously an inline function and moved out of line with this + * commit: + * http://gcc.gnu.org/viewcvs?view=revision&revision=140238 + * + * See also this bug report: + * http://gcc.gnu.org/bugzilla/show_bug.cgi?id=37455 + * + * std::ctype::_M_widen_init() is a function added to libstdc++ by + * Jerry Quinn with revision 74662 on Dec 16, 2003: + * http://gcc.gnu.org/viewcvs?diff_format=h&view=revision&revision=74662 + * + * With explicit permission by Jerry Quinn from Oct 9, 2012, we include a + * verbatim copy of _M_widen_init() here. However, a static_cast was added to + * avoid a warning. + * + * Revision 74662 of the libstdc++-v3 file include/bits/locale_facets.h, where + * std::ctype::_M_widen_init() has been copied from, also included the + * following notice in the file header: + * http://gcc.gnu.org/viewcvs/trunk/libstdc%2B%2B-v3/include/bits/locale_facets.h?diff_format=h&view=markup&pathrev=74662 + * + *
    + * As a special exception, you may use this file as part of a free software + * library without restriction. [...] + *
    + */ +void +ctype::_M_widen_init() const { + char __tmp[sizeof(_M_widen)]; + for (unsigned __i = 0; __i < sizeof(_M_widen); ++__i) + __tmp[__i] = static_cast(__i); + do_widen(__tmp, __tmp + sizeof(__tmp), _M_widen); + + _M_widen_ok = 1; + // Set _M_widen_ok to 2 if memcpy can't be used. + for (unsigned __i = 0; __i < sizeof(_M_widen); ++__i) + if (__tmp[__i] != _M_widen[__i]) { + _M_widen_ok = 2; + break; + } +} + +} // namespace std + +#endif // (LIBSTDCXX_COMPAT < 40400 && GCC_VERSION >= 40400) + + +// GLIBCXX_3.5.15 symbols + +#if (LIBSTDCXX_COMPAT < 40600 && GCC_VERSION >= 40600) + +#include + +namespace std { + +/** + * @brief Empty dtors for standard exceptions + * + * Later versions of libstdc++ added destructors to some standard exceptions. + * Definitions for these are missing in older versions of libstdc++. + * + * Of course, additing destructors is potentially dangerous and can change the + * ABI. However, these classes derived from \c runtime_error and \c logic_error + * before and therefore have always had virtual members. + * + * The first commit that added these destructors is: + * http://gcc.gnu.org/viewcvs?diff_format=h&view=revision&revision=170975 + * This commit was included already in the first gcc 4.6.0 release: + * http://gcc.gnu.org/viewcvs/tags/gcc_4_6_0_release/libstdc%2B%2B-v3/src/stdexcept.cc + */ +domain_error::~domain_error() _GLIBCXX_USE_NOEXCEPT { } +invalid_argument::~invalid_argument() _GLIBCXX_USE_NOEXCEPT { } +length_error::~length_error() _GLIBCXX_USE_NOEXCEPT { } +out_of_range::~out_of_range() _GLIBCXX_USE_NOEXCEPT { } +runtime_error::~runtime_error() _GLIBCXX_USE_NOEXCEPT { } +range_error::~range_error() _GLIBCXX_USE_NOEXCEPT { } +overflow_error::~overflow_error() _GLIBCXX_USE_NOEXCEPT { } +underflow_error::~underflow_error() _GLIBCXX_USE_NOEXCEPT { } + +} // namespace std + +#endif // (LIBSTDCXX_COMPAT < 40600 && GCC_VERSION >= 40600) diff --git a/Ipopt-3.13.4/cmake/mingw-toolchain.cmake b/Ipopt-3.13.4/cmake/mingw-toolchain.cmake new file mode 100644 index 000000000..483899cf1 --- /dev/null +++ b/Ipopt-3.13.4/cmake/mingw-toolchain.cmake @@ -0,0 +1,18 @@ +# the name of the target operating system +set(CMAKE_SYSTEM_NAME Windows) + +# which compilers to use for C and C++ +set(CMAKE_C_COMPILER x86_64-w64-mingw32-gcc) +set(CMAKE_CXX_COMPILER x86_64-w64-mingw32-g++) + +# $ dnf install mingw64-gcc mingw64-gcc-c++ mingw64-gcc-gfortran + +# here is the target environment located +set(CMAKE_FIND_ROOT_PATH /usr/x86_64-w64-mingw32/sys-root/mingw/ $ENV{HOME}/mingw-install ) + +# adjust the default behaviour of the FIND_XXX() commands: +# search headers and libraries in the target environment, search +# programs in the host environment +set(CMAKE_FIND_ROOT_PATH_MODE_PROGRAM NEVER) +set(CMAKE_FIND_ROOT_PATH_MODE_LIBRARY ONLY) +set(CMAKE_FIND_ROOT_PATH_MODE_INCLUDE ONLY) diff --git a/Ipopt-3.13.4/cmake/mingw64-toolchain.cmake b/Ipopt-3.13.4/cmake/mingw64-toolchain.cmake new file mode 100644 index 000000000..cd33799d1 --- /dev/null +++ b/Ipopt-3.13.4/cmake/mingw64-toolchain.cmake @@ -0,0 +1,30 @@ +# based on http://www.cmake.org/Wiki/CmakeMingw + +# the name of the target operating system +SET(CMAKE_SYSTEM_NAME Windows) + +# Choose an appropriate compiler prefix + +# for classical mingw32 +# see http://www.mingw.org/ +#set(COMPILER_PREFIX "i586-mingw32msvc") + +# for 32 or 64 bits mingw-w64 +# see http://mingw-w64.sourceforge.net/ +set(COMPILER_PREFIX "x86_64-w64-mingw32") + +# which compilers to use for C and C++ +find_program(CMAKE_RC_COMPILER NAMES ${COMPILER_PREFIX}-windres) +find_program(CMAKE_C_COMPILER NAMES ${COMPILER_PREFIX}-gcc) +find_program(CMAKE_CXX_COMPILER NAMES ${COMPILER_PREFIX}-g++) +find_program(CMAKE_Fortran_COMPILER NAMES ${COMPILER_PREFIX}-gfortran) + +# here is the target environment located +SET(CMAKE_FIND_ROOT_PATH /usr/${COMPILER_PREFIX}) + +# adjust the default behaviour of the FIND_XXX() commands: +# search headers and libraries in the target environment, search +# programs in the host environment +set(CMAKE_FIND_ROOT_PATH_MODE_PROGRAM NEVER) +set(CMAKE_FIND_ROOT_PATH_MODE_LIBRARY ONLY) +set(CMAKE_FIND_ROOT_PATH_MODE_INCLUDE ONLY) \ No newline at end of file diff --git a/Ipopt-3.13.4/cmake/parse_results.py b/Ipopt-3.13.4/cmake/parse_results.py new file mode 100644 index 000000000..411f25363 --- /dev/null +++ b/Ipopt-3.13.4/cmake/parse_results.py @@ -0,0 +1,91 @@ +#!/usr/bin/python + +import re +import sys + +# Example command line +# parse_results.py netlib_fit2d_cbc.log 'Optimal objective ' -68464.293294 1e-6 +# parse_results.py netlib_fit2d_cbc.log 'Optimal objective ' -68464.293294 + +# comparator = 0 -> "<=" +# comparator = 1 -> "<" +# comparator = 2 -> "=" +# comparator = 3 -> ">" +# comparator = 4 -> ">=" + +rel_level = 1e-6 +epsilon = 1e-9 +comparator = 1 + +if (len(sys.argv) <= 4): + filename = sys.argv[1] + patterns = sys.argv[2] + ref_value = float(sys.argv[3]) +elif (len(sys.argv) <= 5): + filename = sys.argv[1] + patterns = sys.argv[2] + ref_value = float(sys.argv[3]) + rel_level = float(sys.argv[4]) +elif (len(sys.argv) <= 6): + filename = sys.argv[1] + patterns = sys.argv[2] + ref_value = float(sys.argv[3]) + rel_level = float(sys.argv[4]) + comparator = int(sys.argv[5]) +else: + print('usage: parse_result.py filename pattern ref_value [rel_level=1e-6] [comparator=1]') + sys.exit(1) + +if comparator > 4: + print('wrong value for comparator (0,1,2,3,4) here: %s' % comparator) + comparator = 1 + +# Internal variables +number_re = '([-+]?\d+\.*\d*)' + +# Generate the regular expression +patterns = patterns.replace('', number_re) +patterns = patterns.split("<|>") + +# Make sure file gets closed after being iterated +with open(filename, 'r') as f: + # Read the file contents and generate a list with each line + lines = f.readlines() + +# Iterate each line +for line in lines: + for pattern in patterns: + # Regex applied to each line + match = re.findall(pattern, line) + if match: + if comparator == 0: # <= + res = abs(float(match[0]) - ref_value) / max(abs(ref_value), epsilon) + result = res <= rel_level + print('abs(float(%s) - %d) / max(abs(%d), 1e-9) (=%f) <= %f ==> %s' % (match[0],ref_value,ref_value,res,rel_level,result)) + elif comparator == 1: # < + res = abs(float(match[0]) - ref_value) / max(abs(ref_value), epsilon) + result = res < rel_level + print('abs(float(%s) - %d) / max(abs(%d), 1e-9) (=%f) < %f ==> %s' % (match[0],ref_value,ref_value,res,rel_level,result)) + elif comparator == 2: # = + res = abs(float(match[0]) - ref_value) / max(abs(ref_value), epsilon) + result = res == rel_level + print('abs(float(%s) - %d) / max(abs(%d), 1e-9) (=%f) == %f ==> %s' % (match[0],ref_value,ref_value,res,rel_level,result)) + elif comparator == 3: # > + res = abs(float(match[0]) - ref_value) / max(abs(ref_value), epsilon) + result = res > rel_level + print('abs(float(%s) - %d) / max(abs(%d), 1e-9) (=%f) > %f ==> %s' % (match[0],ref_value,ref_value,res,rel_level,result)) + elif comparator == 4: # >= + res = abs(float(match[0]) - ref_value) / max(abs(ref_value), epsilon) + result = res >= rel_level + print('abs(float(%s) - %d) / max(abs(%d), 1e-9) (=%f) >= %f ==> %s' % (match[0],ref_value,ref_value,res,rel_level,result)) + + if (not result): + print('FAILED') + sys.exit(-1) + else: + print('PASSED') + sys.exit(0) + +print('NOT FOUND') +sys.exit(-1) + diff --git a/Ipopt-3.13.4/cmake/uninstall.cmake b/Ipopt-3.13.4/cmake/uninstall.cmake new file mode 100644 index 000000000..8fc7d78bd --- /dev/null +++ b/Ipopt-3.13.4/cmake/uninstall.cmake @@ -0,0 +1,27 @@ +message(STATUS "Attempting to create uninstall target for make") + +set(INSTALL_MANIFEST_PATH "${CMAKE_CURRENT_BINARY_DIR}/install_manifest.txt") + +if (EXISTS ${INSTALL_MANIFEST_PATH}) + message(STATUS "install_manifest.txt found") + + file(STRINGS ${INSTALL_MANIFEST_PATH} FILES_TO_REMOVE) + + foreach(FILE_TO_REMOVE ${FILES_TO_REMOVE}) + if (EXISTS ${FILE_TO_REMOVE}) + exec_program(${CMAKE_COMMAND} ARGS "-E remove \"${FILE_TO_REMOVE}\"" + OUTPUT_VARIABLE STDOUT + RETURN_VALUE EXIT_CODE) + + if (${EXIT_CODE} EQUAL 0) + message(STATUS "Successfully removed file ${FILE_TO_REMOVE}") + else () + message(FATAL_ERROR "Failed to remove file ${FILE_TO_REMOVE} with error code ${EXIT_CODE}") + endif () + else () + message(WARNING "Could not find file ${FILE_TO_REMOVE}") + endif () + endforeach(FILE_TO_REMOVE) +else () + message(FATAL_ERROR "Could not find install manifest at ${CMAKE_CURRENT_BINARY_DIR}/install_manifest.txt\nThis may be because 'make install' has non been run or install_manifest.txt has been deleted") +endif () diff --git a/Ipopt-3.13.4/compile b/Ipopt-3.13.4/compile new file mode 100755 index 000000000..209573fe7 --- /dev/null +++ b/Ipopt-3.13.4/compile @@ -0,0 +1,384 @@ +#! /bin/sh +# Wrapper for compilers which do not understand '-c -o'. + +scriptversion=2018-03-07.03; # UTC + +# Copyright (C) 1999-2020 Free Software Foundation, Inc. +# Written by Tom Tromey . +# +# 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 Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + +# This file is maintained in Automake, please report +# bugs to or send patches to +# . + +nl=' +' + +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent tools from complaining about whitespace usage. +IFS=" "" $nl" + +file_conv= + +# func_file_conv build_file lazy +# Convert a $build file to $host form and store it in $file +# Currently only supports Windows hosts. If the determined conversion +# type is listed in (the comma separated) LAZY, no conversion will +# take place. +func_file_conv () +{ + file=$1 + case $file in + / | /[!/]*) # absolute file, and not a UNC file + if test -z "$file_conv"; then + # lazily determine how to convert abs files + case `uname -s` in + MINGW*) + file_conv=mingw + ;; + CYGWIN* | MSYS*) + file_conv=cygwin + ;; + *) + file_conv=wine + ;; + esac + fi + case $file_conv/,$2, in + *,$file_conv,*) + ;; + mingw/*) + file=`cmd //C echo "$file " | sed -e 's/"\(.*\) " *$/\1/'` + ;; + cygwin/* | msys/*) + file=`cygpath -m "$file" || echo "$file"` + ;; + wine/*) + file=`winepath -w "$file" || echo "$file"` + ;; + esac + ;; + esac +} + +# func_cl_dashL linkdir +# Make cl look for libraries in LINKDIR +func_cl_dashL () +{ + func_file_conv "$1" + if test -z "$lib_path"; then + lib_path=$file + else + lib_path="$lib_path;$file" + fi + linker_opts="$linker_opts -LIBPATH:$file" +} + +# func_cl_dashl library +# Do a library search-path lookup for cl +func_cl_dashl () +{ + lib=$1 + found=no + save_IFS=$IFS + IFS=';' + for dir in $lib_path $LIB + do + IFS=$save_IFS + if $shared && test -f "$dir/$lib.dll.lib"; then + found=yes + lib=$dir/$lib.dll.lib + break + fi + if test -f "$dir/$lib.lib"; then + found=yes + lib=$dir/$lib.lib + break + fi + if test -f "$dir/lib$lib.a"; then + found=yes + lib=$dir/lib$lib.a + break + fi + done + IFS=$save_IFS + + if test "$found" != yes; then + lib=$lib.lib + fi +} + +# func_cl_wrapper cl arg... +# Adjust compile command to suit cl +func_cl_wrapper () +{ + # Assume a capable shell + lib_path= + shared=: + linker_opts= + outfile= + implib= + linking=1 + for arg + do + if test -n "$eat"; then + eat= + else + case $1 in + -o) + # configure might choose to run compile as 'compile cc -o foo foo.c'. + eat=1 + case $2 in + *.o | *.[oO][bB][jJ]) + func_file_conv "$2" + set x "$@" -Fo"$file" + shift + outfile="$file" + ;; + *) + func_file_conv "$2" + set x "$@" -Fe"$file" + shift + outfile="$file" + ;; + esac + ;; + -I) + eat=1 + func_file_conv "$2" mingw + set x "$@" -I"$file" + shift + ;; + -I*) + func_file_conv "${1#-I}" mingw + set x "$@" -I"$file" + shift + ;; + -l) + eat=1 + func_cl_dashl "$2" + set x "$@" "$lib" + shift + ;; + -l*) + func_cl_dashl "${1#-l}" + set x "$@" "$lib" + shift + ;; + -L) + eat=1 + func_cl_dashL "$2" + ;; + -L*) + func_cl_dashL "${1#-L}" + ;; + -static) + shared=false + ;; + -Wl,*) + arg=${1#-Wl,} + save_ifs="$IFS"; IFS=',' + for flag in $arg; do + IFS="$save_ifs" + linker_opts="$linker_opts $flag" + case "$flag" in -IMPLIB:*) implib=${flag#-IMPLIB:} ;; esac + done + IFS="$save_ifs" + ;; + -Xlinker) + eat=1 + linker_opts="$linker_opts $2" + ;; + -std=*) + set x "$@" -std:"${1#-std=}" + shift + ;; + -*) + set x "$@" "$1" + shift + ;; + *.cc | *.CC | *.cxx | *.CXX | *.[cC]++) + func_file_conv "$1" + set x "$@" -Tp"$file" + shift + ;; + *.c | *.cpp | *.CPP | *.lib | *.LIB | *.Lib | *.OBJ | *.obj | *.[oO]) + func_file_conv "$1" mingw + set x "$@" "$file" + shift + ;; + -c) + linking=0 + set x "$@" "$1" + shift + ;; + *) + set x "$@" "$1" + shift + ;; + esac + fi + shift + done + if test -n "$linker_opts"; then + linker_opts="-link$linker_opts" + fi + # remove old $implib, so we can distinguish between generated and not-generated implib below + if test -n "$implib" && test -f "$implib" ; then rm "$implib" ; fi + + # add path to MSVC link in front on PATH if we seem to link (check isn't so accurate, but some false-positives shouldn't matter) + # compiler will call the link it finds in the PATH, and we don't want it to use MSYS' /bin/link + # we assume that MSVC link is in same directory as cl and that cl is found in PATH + if test "$linking" = 1 && comppath=`which cl 2>/dev/null` ; then + comppath=`dirname "$comppath"` + #echo "Adding $comppath to front of PATH" + PATH="$comppath:$PATH" + fi + + #echo "compile: $@ $linker_opts" + "$@" $linker_opts || exit $? + + # if -implib got lost or ignored, then the lib should be named ${outfile/.dll/.lib} and we rename that file + if test -n "$implib" && test ! -f "$implib" ; then + echo "compile: mv ${outfile/.dll/.lib} $implib" + mv "${outfile/.dll/.lib}" "$implib" + fi + + exit 0 +} + +eat= + +case $1 in + '') + echo "$0: No command. Try '$0 --help' for more information." 1>&2 + exit 1; + ;; + -h | --h*) + cat <<\EOF +Usage: compile [--help] [--version] PROGRAM [ARGS] + +Wrapper for compilers which do not understand '-c -o'. +Remove '-o dest.o' from ARGS, run PROGRAM with the remaining +arguments, and rename the output as expected. + +If you are trying to build a whole package this is not the +right script to run: please start by reading the file 'INSTALL'. + +Report bugs to . +EOF + exit $? + ;; + -v | --v*) + echo "compile $scriptversion" + exit $? + ;; + cl | *[/\\]cl | cl.exe | *[/\\]cl.exe | \ + icl | *[/\\]icl | icl.exe | *[/\\]icl.exe | \ + ifort | *[/\\]ifort | ifort.exe | *[/\\]ifort.exe ) + func_cl_wrapper "$@" # Doesn't return... + ;; +esac + +ofile= +cfile= + +for arg +do + if test -n "$eat"; then + eat= + else + case $1 in + -o) + # configure might choose to run compile as 'compile cc -o foo foo.c'. + # So we strip '-o arg' only if arg is an object. + eat=1 + case $2 in + *.o | *.obj) + ofile=$2 + ;; + *) + set x "$@" -o "$2" + shift + ;; + esac + ;; + *.c) + cfile=$1 + set x "$@" "$1" + shift + ;; + *) + set x "$@" "$1" + shift + ;; + esac + fi + shift +done + +if test -z "$ofile" || test -z "$cfile"; then + # If no '-o' option was seen then we might have been invoked from a + # pattern rule where we don't need one. That is ok -- this is a + # normal compilation that the losing compiler can handle. If no + # '.c' file was seen then we are probably linking. That is also + # ok. + exec "$@" +fi + +# Name of file we expect compiler to create. +cofile=`echo "$cfile" | sed 's|^.*[\\/]||; s|^[a-zA-Z]:||; s/\.c$/.o/'` + +# Create the lock directory. +# Note: use '[/\\:.-]' here to ensure that we don't use the same name +# that we are using for the .o file. Also, base the name on the expected +# object file name, since that is what matters with a parallel build. +lockdir=`echo "$cofile" | sed -e 's|[/\\:.-]|_|g'`.d +while true; do + if mkdir "$lockdir" >/dev/null 2>&1; then + break + fi + sleep 1 +done +# FIXME: race condition here if user kills between mkdir and trap. +trap "rmdir '$lockdir'; exit 1" 1 2 15 + +# Run the compile. +"$@" +ret=$? + +if test -f "$cofile"; then + test "$cofile" = "$ofile" || mv "$cofile" "$ofile" +elif test -f "${cofile}bj"; then + test "${cofile}bj" = "$ofile" || mv "${cofile}bj" "$ofile" +fi + +rmdir "$lockdir" +exit $ret + +# Local Variables: +# mode: shell-script +# sh-indentation: 2 +# eval: (add-hook 'before-save-hook 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC0" +# time-stamp-end: "; # UTC" +# End: diff --git a/Ipopt-3.13.4/config.guess b/Ipopt-3.13.4/config.guess new file mode 100755 index 000000000..45001cfec --- /dev/null +++ b/Ipopt-3.13.4/config.guess @@ -0,0 +1,1667 @@ +#! /bin/sh +# Attempt to guess a canonical system name. +# Copyright 1992-2020 Free Software Foundation, Inc. + +timestamp='2020-01-01' + +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, see . +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. +# +# You can get the latest version of this script from: +# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess +# +# Please send patches to . + + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] + +Output the configuration name of the system \`$me' is run on. + +Options: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.guess ($timestamp) + +Originally written by Per Bothner. +Copyright 1992-2020 Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + * ) + break ;; + esac +done + +if test $# != 0; then + echo "$me: too many arguments$help" >&2 + exit 1 +fi + +# CC_FOR_BUILD -- compiler used by this script. Note that the use of a +# compiler to aid in system detection is discouraged as it requires +# temporary files to be created and, as you can see below, it is a +# headache to deal with in a portable fashion. + +# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still +# use `HOST_CC' if defined, but it is deprecated. + +# Portable tmp directory creation inspired by the Autoconf team. + +tmp= +# shellcheck disable=SC2172 +trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15 + +set_cc_for_build() { + # prevent multiple calls if $tmp is already set + test "$tmp" && return 0 + : "${TMPDIR=/tmp}" + # shellcheck disable=SC2039 + { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } + dummy=$tmp/dummy + case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in + ,,) echo "int x;" > "$dummy.c" + for driver in cc gcc c89 c99 ; do + if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then + CC_FOR_BUILD="$driver" + break + fi + done + if test x"$CC_FOR_BUILD" = x ; then + CC_FOR_BUILD=no_compiler_found + fi + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; + esac +} + +# This is needed to find uname on a Pyramid OSx when run in the BSD universe. +# (ghazi@noc.rutgers.edu 1994-08-24) +if test -f /.attbin/uname ; then + PATH=$PATH:/.attbin ; export PATH +fi + +UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown +UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown +UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown +UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown + +case "$UNAME_SYSTEM" in +Linux|GNU|GNU/*) + # If the system lacks a compiler, then just pick glibc. + # We could probably try harder. + LIBC=gnu + + set_cc_for_build + cat <<-EOF > "$dummy.c" + #include + #if defined(__UCLIBC__) + LIBC=uclibc + #elif defined(__dietlibc__) + LIBC=dietlibc + #else + LIBC=gnu + #endif + EOF + eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`" + + # If ldd exists, use it to detect musl libc. + if command -v ldd >/dev/null && \ + ldd --version 2>&1 | grep -q ^musl + then + LIBC=musl + fi + ;; +esac + +# Note: order is significant - the case branches are not exclusive. + +case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in + *:NetBSD:*:*) + # NetBSD (nbsd) targets should (where applicable) match one or + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, + # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently + # switched to ELF, *-*-netbsd* would select the old + # object file format. This provides both forward + # compatibility and a consistent mechanism for selecting the + # object file format. + # + # Note: NetBSD doesn't particularly care about the vendor + # portion of the name. We always set it to "unknown". + sysctl="sysctl -n hw.machine_arch" + UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \ + "/sbin/$sysctl" 2>/dev/null || \ + "/usr/sbin/$sysctl" 2>/dev/null || \ + echo unknown)` + case "$UNAME_MACHINE_ARCH" in + armeb) machine=armeb-unknown ;; + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; + earmv*) + arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'` + endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'` + machine="${arch}${endian}"-unknown + ;; + *) machine="$UNAME_MACHINE_ARCH"-unknown ;; + esac + # The Operating System including object format, if it has switched + # to ELF recently (or will in the future) and ABI. + case "$UNAME_MACHINE_ARCH" in + earm*) + os=netbsdelf + ;; + arm*|i386|m68k|ns32k|sh3*|sparc|vax) + set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ELF__ + then + # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). + # Return netbsd for either. FIX? + os=netbsd + else + os=netbsdelf + fi + ;; + *) + os=netbsd + ;; + esac + # Determine ABI tags. + case "$UNAME_MACHINE_ARCH" in + earm*) + expr='s/^earmv[0-9]/-eabi/;s/eb$//' + abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"` + ;; + esac + # The OS release + # Debian GNU/NetBSD machines have a different userland, and + # thus, need a distinct triplet. However, they do not need + # kernel version information, so it can be replaced with a + # suitable tag, in the style of linux-gnu. + case "$UNAME_VERSION" in + Debian*) + release='-gnu' + ;; + *) + release=`echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2` + ;; + esac + # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + echo "$machine-${os}${release}${abi-}" + exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo "$UNAME_MACHINE_ARCH"-unknown-bitrig"$UNAME_RELEASE" + exit ;; + *:OpenBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` + echo "$UNAME_MACHINE_ARCH"-unknown-openbsd"$UNAME_RELEASE" + exit ;; + *:LibertyBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'` + echo "$UNAME_MACHINE_ARCH"-unknown-libertybsd"$UNAME_RELEASE" + exit ;; + *:MidnightBSD:*:*) + echo "$UNAME_MACHINE"-unknown-midnightbsd"$UNAME_RELEASE" + exit ;; + *:ekkoBSD:*:*) + echo "$UNAME_MACHINE"-unknown-ekkobsd"$UNAME_RELEASE" + exit ;; + *:SolidBSD:*:*) + echo "$UNAME_MACHINE"-unknown-solidbsd"$UNAME_RELEASE" + exit ;; + *:OS108:*:*) + echo "$UNAME_MACHINE"-unknown-os108_"$UNAME_RELEASE" + exit ;; + macppc:MirBSD:*:*) + echo powerpc-unknown-mirbsd"$UNAME_RELEASE" + exit ;; + *:MirBSD:*:*) + echo "$UNAME_MACHINE"-unknown-mirbsd"$UNAME_RELEASE" + exit ;; + *:Sortix:*:*) + echo "$UNAME_MACHINE"-unknown-sortix + exit ;; + *:Twizzler:*:*) + echo "$UNAME_MACHINE"-unknown-twizzler + exit ;; + *:Redox:*:*) + echo "$UNAME_MACHINE"-unknown-redox + exit ;; + mips:OSF1:*.*) + echo mips-dec-osf1 + exit ;; + alpha:OSF1:*:*) + case $UNAME_RELEASE in + *4.0) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` + ;; + *5.*) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + ;; + esac + # According to Compaq, /usr/sbin/psrinfo has been available on + # OSF/1 and Tru64 systems produced since 1995. I hope that + # covers most systems running today. This code pipes the CPU + # types through head -n 1, so we only detect the type of CPU 0. + ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` + case "$ALPHA_CPU_TYPE" in + "EV4 (21064)") + UNAME_MACHINE=alpha ;; + "EV4.5 (21064)") + UNAME_MACHINE=alpha ;; + "LCA4 (21066/21068)") + UNAME_MACHINE=alpha ;; + "EV5 (21164)") + UNAME_MACHINE=alphaev5 ;; + "EV5.6 (21164A)") + UNAME_MACHINE=alphaev56 ;; + "EV5.6 (21164PC)") + UNAME_MACHINE=alphapca56 ;; + "EV5.7 (21164PC)") + UNAME_MACHINE=alphapca57 ;; + "EV6 (21264)") + UNAME_MACHINE=alphaev6 ;; + "EV6.7 (21264A)") + UNAME_MACHINE=alphaev67 ;; + "EV6.8CB (21264C)") + UNAME_MACHINE=alphaev68 ;; + "EV6.8AL (21264B)") + UNAME_MACHINE=alphaev68 ;; + "EV6.8CX (21264D)") + UNAME_MACHINE=alphaev68 ;; + "EV6.9A (21264/EV69A)") + UNAME_MACHINE=alphaev69 ;; + "EV7 (21364)") + UNAME_MACHINE=alphaev7 ;; + "EV7.9 (21364A)") + UNAME_MACHINE=alphaev79 ;; + esac + # A Pn.n version is a patched version. + # A Vn.n version is a released version. + # A Tn.n version is a released field test version. + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. + echo "$UNAME_MACHINE"-dec-osf"`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`" + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; + Amiga*:UNIX_System_V:4.0:*) + echo m68k-unknown-sysv4 + exit ;; + *:[Aa]miga[Oo][Ss]:*:*) + echo "$UNAME_MACHINE"-unknown-amigaos + exit ;; + *:[Mm]orph[Oo][Ss]:*:*) + echo "$UNAME_MACHINE"-unknown-morphos + exit ;; + *:OS/390:*:*) + echo i370-ibm-openedition + exit ;; + *:z/VM:*:*) + echo s390-ibm-zvmoe + exit ;; + *:OS400:*:*) + echo powerpc-ibm-os400 + exit ;; + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + echo arm-acorn-riscix"$UNAME_RELEASE" + exit ;; + arm*:riscos:*:*|arm*:RISCOS:*:*) + echo arm-unknown-riscos + exit ;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) + echo hppa1.1-hitachi-hiuxmpp + exit ;; + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. + if test "`(/bin/universe) 2>/dev/null`" = att ; then + echo pyramid-pyramid-sysv3 + else + echo pyramid-pyramid-bsd + fi + exit ;; + NILE*:*:*:dcosx) + echo pyramid-pyramid-svr4 + exit ;; + DRS?6000:unix:4.0:6*) + echo sparc-icl-nx6 + exit ;; + DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) + case `/usr/bin/uname -p` in + sparc) echo sparc-icl-nx7; exit ;; + esac ;; + s390x:SunOS:*:*) + echo "$UNAME_MACHINE"-ibm-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" + exit ;; + sun4H:SunOS:5.*:*) + echo sparc-hal-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" + exit ;; + sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) + echo sparc-sun-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" + exit ;; + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux"$UNAME_RELEASE" + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + set_cc_for_build + SUN_ARCH=i386 + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != no_compiler_found ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH=x86_64 + fi + fi + echo "$SUN_ARCH"-pc-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" + exit ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + echo sparc-sun-solaris3"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" + exit ;; + sun4*:SunOS:*:*) + case "`/usr/bin/arch -k`" in + Series*|S4*) + UNAME_RELEASE=`uname -v` + ;; + esac + # Japanese Language versions have a version number like `4.1.3-JL'. + echo sparc-sun-sunos"`echo "$UNAME_RELEASE"|sed -e 's/-/_/'`" + exit ;; + sun3*:SunOS:*:*) + echo m68k-sun-sunos"$UNAME_RELEASE" + exit ;; + sun*:*:4.2BSD:*) + UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` + test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3 + case "`/bin/arch`" in + sun3) + echo m68k-sun-sunos"$UNAME_RELEASE" + ;; + sun4) + echo sparc-sun-sunos"$UNAME_RELEASE" + ;; + esac + exit ;; + aushp:SunOS:*:*) + echo sparc-auspex-sunos"$UNAME_RELEASE" + exit ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor + # > m68000). The system name ranges from "MiNT" over "FreeMiNT" + # to the lowercase version "mint" (or "freemint"). Finally + # the system name "TOS" denotes a system which is actually not + # MiNT. But MiNT is downward compatible to TOS, so this should + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint"$UNAME_RELEASE" + exit ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint"$UNAME_RELEASE" + exit ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) + echo m68k-atari-mint"$UNAME_RELEASE" + exit ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) + echo m68k-milan-mint"$UNAME_RELEASE" + exit ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) + echo m68k-hades-mint"$UNAME_RELEASE" + exit ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) + echo m68k-unknown-mint"$UNAME_RELEASE" + exit ;; + m68k:machten:*:*) + echo m68k-apple-machten"$UNAME_RELEASE" + exit ;; + powerpc:machten:*:*) + echo powerpc-apple-machten"$UNAME_RELEASE" + exit ;; + RISC*:Mach:*:*) + echo mips-dec-mach_bsd4.3 + exit ;; + RISC*:ULTRIX:*:*) + echo mips-dec-ultrix"$UNAME_RELEASE" + exit ;; + VAX*:ULTRIX*:*:*) + echo vax-dec-ultrix"$UNAME_RELEASE" + exit ;; + 2020:CLIX:*:* | 2430:CLIX:*:*) + echo clipper-intergraph-clix"$UNAME_RELEASE" + exit ;; + mips:*:*:UMIPS | mips:*:*:RISCos) + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" +#ifdef __cplusplus +#include /* for printf() prototype */ + int main (int argc, char *argv[]) { +#else + int main (argc, argv) int argc; char *argv[]; { +#endif + #if defined (host_mips) && defined (MIPSEB) + #if defined (SYSTYPE_SYSV) + printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_SVR4) + printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) + printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0); + #endif + #endif + exit (-1); + } +EOF + $CC_FOR_BUILD -o "$dummy" "$dummy.c" && + dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` && + SYSTEM_NAME=`"$dummy" "$dummyarg"` && + { echo "$SYSTEM_NAME"; exit; } + echo mips-mips-riscos"$UNAME_RELEASE" + exit ;; + Motorola:PowerMAX_OS:*:*) + echo powerpc-motorola-powermax + exit ;; + Motorola:*:4.3:PL8-*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:Power_UNIX:*:*) + echo powerpc-harris-powerunix + exit ;; + m88k:CX/UX:7*:*) + echo m88k-harris-cxux7 + exit ;; + m88k:*:4*:R4*) + echo m88k-motorola-sysv4 + exit ;; + m88k:*:3*:R3*) + echo m88k-motorola-sysv3 + exit ;; + AViiON:dgux:*:*) + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` + if [ "$UNAME_PROCESSOR" = mc88100 ] || [ "$UNAME_PROCESSOR" = mc88110 ] + then + if [ "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx ] || \ + [ "$TARGET_BINARY_INTERFACE"x = x ] + then + echo m88k-dg-dgux"$UNAME_RELEASE" + else + echo m88k-dg-dguxbcs"$UNAME_RELEASE" + fi + else + echo i586-dg-dgux"$UNAME_RELEASE" + fi + exit ;; + M88*:DolphinOS:*:*) # DolphinOS (SVR3) + echo m88k-dolphin-sysv3 + exit ;; + M88*:*:R3*:*) + # Delta 88k system running SVR3 + echo m88k-motorola-sysv3 + exit ;; + XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) + echo m88k-tektronix-sysv3 + exit ;; + Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) + echo m68k-tektronix-bsd + exit ;; + *:IRIX*:*:*) + echo mips-sgi-irix"`echo "$UNAME_RELEASE"|sed -e 's/-/_/g'`" + exit ;; + ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. + echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id + exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + i*86:AIX:*:*) + echo i386-ibm-aix + exit ;; + ia64:AIX:*:*) + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" + fi + echo "$UNAME_MACHINE"-ibm-aix"$IBM_REV" + exit ;; + *:AIX:2:3) + if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" + #include + + main() + { + if (!__power_pc()) + exit(1); + puts("powerpc-ibm-aix3.2.5"); + exit(0); + } +EOF + if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` + then + echo "$SYSTEM_NAME" + else + echo rs6000-ibm-aix3.2.5 + fi + elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then + echo rs6000-ibm-aix3.2.4 + else + echo rs6000-ibm-aix3.2 + fi + exit ;; + *:AIX:*:[4567]) + IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` + if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then + IBM_ARCH=rs6000 + else + IBM_ARCH=powerpc + fi + if [ -x /usr/bin/lslpp ] ; then + IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | + awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` + else + IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" + fi + echo "$IBM_ARCH"-ibm-aix"$IBM_REV" + exit ;; + *:AIX:*:*) + echo rs6000-ibm-aix + exit ;; + ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*) + echo romp-ibm-bsd4.4 + exit ;; + ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and + echo romp-ibm-bsd"$UNAME_RELEASE" # 4.3 with uname added to + exit ;; # report: romp-ibm BSD 4.3 + *:BOSX:*:*) + echo rs6000-bull-bosx + exit ;; + DPX/2?00:B.O.S.:*:*) + echo m68k-bull-sysv3 + exit ;; + 9000/[34]??:4.3bsd:1.*:*) + echo m68k-hp-bsd + exit ;; + hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) + echo m68k-hp-bsd4.4 + exit ;; + 9000/[34678]??:HP-UX:*:*) + HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'` + case "$UNAME_MACHINE" in + 9000/31?) HP_ARCH=m68000 ;; + 9000/[34]??) HP_ARCH=m68k ;; + 9000/[678][0-9][0-9]) + if [ -x /usr/bin/getconf ]; then + sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "$sc_cpu_version" in + 523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0 + 528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "$sc_kernel_bits" in + 32) HP_ARCH=hppa2.0n ;; + 64) HP_ARCH=hppa2.0w ;; + '') HP_ARCH=hppa2.0 ;; # HP-UX 10.20 + esac ;; + esac + fi + if [ "$HP_ARCH" = "" ]; then + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" + + #define _HPUX_SOURCE + #include + #include + + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); + + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } +EOF + (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=`"$dummy"` + test -z "$HP_ARCH" && HP_ARCH=hppa + fi ;; + esac + if [ "$HP_ARCH" = hppa2.0w ] + then + set_cc_for_build + + # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating + # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler + # generating 64-bit code. GNU and HP use different nomenclature: + # + # $ CC_FOR_BUILD=cc ./config.guess + # => hppa2.0w-hp-hpux11.23 + # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess + # => hppa64-hp-hpux11.23 + + if echo __LP64__ | (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | + grep -q __LP64__ + then + HP_ARCH=hppa2.0w + else + HP_ARCH=hppa64 + fi + fi + echo "$HP_ARCH"-hp-hpux"$HPUX_REV" + exit ;; + ia64:HP-UX:*:*) + HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'` + echo ia64-hp-hpux"$HPUX_REV" + exit ;; + 3050*:HI-UX:*:*) + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" + #include + int + main () + { + long cpu = sysconf (_SC_CPU_VERSION); + /* The order matters, because CPU_IS_HP_MC68K erroneously returns + true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct + results, however. */ + if (CPU_IS_PA_RISC (cpu)) + { + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; + case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; + default: puts ("hppa-hitachi-hiuxwe2"); break; + } + } + else if (CPU_IS_HP_MC68K (cpu)) + puts ("m68k-hitachi-hiuxwe2"); + else puts ("unknown-hitachi-hiuxwe2"); + exit (0); + } +EOF + $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` && + { echo "$SYSTEM_NAME"; exit; } + echo unknown-hitachi-hiuxwe2 + exit ;; + 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*) + echo hppa1.1-hp-bsd + exit ;; + 9000/8??:4.3bsd:*:*) + echo hppa1.0-hp-bsd + exit ;; + *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) + echo hppa1.0-hp-mpeix + exit ;; + hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*) + echo hppa1.1-hp-osf + exit ;; + hp8??:OSF1:*:*) + echo hppa1.0-hp-osf + exit ;; + i*86:OSF1:*:*) + if [ -x /usr/sbin/sysversion ] ; then + echo "$UNAME_MACHINE"-unknown-osf1mk + else + echo "$UNAME_MACHINE"-unknown-osf1 + fi + exit ;; + parisc*:Lites*:*:*) + echo hppa1.1-hp-lites + exit ;; + C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) + echo c1-convex-bsd + exit ;; + C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) + echo c34-convex-bsd + exit ;; + C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) + echo c38-convex-bsd + exit ;; + C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) + echo c4-convex-bsd + exit ;; + CRAY*Y-MP:*:*:*) + echo ymp-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*[A-Z]90:*:*:*) + echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \ + | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ + -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ + -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*TS:*:*:*) + echo t90-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*T3E:*:*:*) + echo alphaev5-cray-unicosmk"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*SV1:*:*:*) + echo sv1-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + *:UNICOS/mp:*:*) + echo craynv-cray-unicosmp"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) + FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz` + FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` + FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + 5000:UNIX_System_V:4.*:*) + FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` + FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) + echo "$UNAME_MACHINE"-pc-bsdi"$UNAME_RELEASE" + exit ;; + sparc*:BSD/OS:*:*) + echo sparc-unknown-bsdi"$UNAME_RELEASE" + exit ;; + *:BSD/OS:*:*) + echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE" + exit ;; + arm:FreeBSD:*:*) + UNAME_PROCESSOR=`uname -p` + set_cc_for_build + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabi + else + echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabihf + fi + exit ;; + *:FreeBSD:*:*) + UNAME_PROCESSOR=`/usr/bin/uname -p` + case "$UNAME_PROCESSOR" in + amd64) + UNAME_PROCESSOR=x86_64 ;; + i386) + UNAME_PROCESSOR=i586 ;; + esac + echo "$UNAME_PROCESSOR"-unknown-freebsd"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`" + exit ;; + i*:CYGWIN*:*) + echo "$UNAME_MACHINE"-pc-cygwin + exit ;; + *:MINGW64*:*) + echo "$UNAME_MACHINE"-pc-mingw64 + exit ;; + *:MINGW*:*) + echo "$UNAME_MACHINE"-pc-mingw32 + exit ;; + *:MSYS*:*) + echo "$UNAME_MACHINE"-pc-msys + exit ;; + i*:PW*:*) + echo "$UNAME_MACHINE"-pc-pw32 + exit ;; + *:Interix*:*) + case "$UNAME_MACHINE" in + x86) + echo i586-pc-interix"$UNAME_RELEASE" + exit ;; + authenticamd | genuineintel | EM64T) + echo x86_64-unknown-interix"$UNAME_RELEASE" + exit ;; + IA64) + echo ia64-unknown-interix"$UNAME_RELEASE" + exit ;; + esac ;; + i*:UWIN*:*) + echo "$UNAME_MACHINE"-pc-uwin + exit ;; + amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) + echo x86_64-pc-cygwin + exit ;; + prep*:SunOS:5.*:*) + echo powerpcle-unknown-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" + exit ;; + *:GNU:*:*) + # the GNU system + echo "`echo "$UNAME_MACHINE"|sed -e 's,[-/].*$,,'`-unknown-$LIBC`echo "$UNAME_RELEASE"|sed -e 's,/.*$,,'`" + exit ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland + echo "$UNAME_MACHINE-unknown-`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"``echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`-$LIBC" + exit ;; + *:Minix:*:*) + echo "$UNAME_MACHINE"-unknown-minix + exit ;; + aarch64:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC=gnulibc1 ; fi + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + arc:Linux:*:* | arceb:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + arm*:Linux:*:*) + set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabi + else + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabihf + fi + fi + exit ;; + avr32*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + cris:Linux:*:*) + echo "$UNAME_MACHINE"-axis-linux-"$LIBC" + exit ;; + crisv32:Linux:*:*) + echo "$UNAME_MACHINE"-axis-linux-"$LIBC" + exit ;; + e2k:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + frv:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + hexagon:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + i*86:Linux:*:*) + echo "$UNAME_MACHINE"-pc-linux-"$LIBC" + exit ;; + ia64:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + k1om:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + m32r*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + m68*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + mips:Linux:*:* | mips64:Linux:*:*) + set_cc_for_build + IS_GLIBC=0 + test x"${LIBC}" = xgnu && IS_GLIBC=1 + sed 's/^ //' << EOF > "$dummy.c" + #undef CPU + #undef mips + #undef mipsel + #undef mips64 + #undef mips64el + #if ${IS_GLIBC} && defined(_ABI64) + LIBCABI=gnuabi64 + #else + #if ${IS_GLIBC} && defined(_ABIN32) + LIBCABI=gnuabin32 + #else + LIBCABI=${LIBC} + #endif + #endif + + #if ${IS_GLIBC} && defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 + CPU=mipsisa64r6 + #else + #if ${IS_GLIBC} && !defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 + CPU=mipsisa32r6 + #else + #if defined(__mips64) + CPU=mips64 + #else + CPU=mips + #endif + #endif + #endif + + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + MIPS_ENDIAN=el + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + MIPS_ENDIAN= + #else + MIPS_ENDIAN= + #endif + #endif +EOF + eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI'`" + test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; } + ;; + mips64el:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + openrisc*:Linux:*:*) + echo or1k-unknown-linux-"$LIBC" + exit ;; + or32:Linux:*:* | or1k*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + padre:Linux:*:*) + echo sparc-unknown-linux-"$LIBC" + exit ;; + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-"$LIBC" + exit ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in + PA7*) echo hppa1.1-unknown-linux-"$LIBC" ;; + PA8*) echo hppa2.0-unknown-linux-"$LIBC" ;; + *) echo hppa-unknown-linux-"$LIBC" ;; + esac + exit ;; + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-"$LIBC" + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-"$LIBC" + exit ;; + ppc64le:Linux:*:*) + echo powerpc64le-unknown-linux-"$LIBC" + exit ;; + ppcle:Linux:*:*) + echo powerpcle-unknown-linux-"$LIBC" + exit ;; + riscv32:Linux:*:* | riscv64:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + s390:Linux:*:* | s390x:Linux:*:*) + echo "$UNAME_MACHINE"-ibm-linux-"$LIBC" + exit ;; + sh64*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + sh*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + sparc:Linux:*:* | sparc64:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + tile*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + vax:Linux:*:*) + echo "$UNAME_MACHINE"-dec-linux-"$LIBC" + exit ;; + x86_64:Linux:*:*) + echo "$UNAME_MACHINE"-pc-linux-"$LIBC" + exit ;; + xtensa*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. + # earlier versions are messed up and put the nodename in both + # sysname and nodename. + echo i386-sequent-sysv4 + exit ;; + i*86:UNIX_SV:4.2MP:2.*) + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, + # I just have to hope. -- rms. + # Use sysv4.2uw... so that sysv4* matches it. + echo "$UNAME_MACHINE"-pc-sysv4.2uw"$UNAME_VERSION" + exit ;; + i*86:OS/2:*:*) + # If we were able to find `uname', then EMX Unix compatibility + # is probably installed. + echo "$UNAME_MACHINE"-pc-os2-emx + exit ;; + i*86:XTS-300:*:STOP) + echo "$UNAME_MACHINE"-unknown-stop + exit ;; + i*86:atheos:*:*) + echo "$UNAME_MACHINE"-unknown-atheos + exit ;; + i*86:syllable:*:*) + echo "$UNAME_MACHINE"-pc-syllable + exit ;; + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) + echo i386-unknown-lynxos"$UNAME_RELEASE" + exit ;; + i*86:*DOS:*:*) + echo "$UNAME_MACHINE"-pc-msdosdjgpp + exit ;; + i*86:*:4.*:*) + UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'` + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then + echo "$UNAME_MACHINE"-univel-sysv"$UNAME_REL" + else + echo "$UNAME_MACHINE"-pc-sysv"$UNAME_REL" + fi + exit ;; + i*86:*:5:[678]*) + # UnixWare 7.x, OpenUNIX and OpenServer 6. + case `/bin/uname -X | grep "^Machine"` in + *486*) UNAME_MACHINE=i486 ;; + *Pentium) UNAME_MACHINE=i586 ;; + *Pent*|*Celeron) UNAME_MACHINE=i686 ;; + esac + echo "$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}" + exit ;; + i*86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then + UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` + (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 + (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ + && UNAME_MACHINE=i586 + (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ + && UNAME_MACHINE=i686 + (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ + && UNAME_MACHINE=i686 + echo "$UNAME_MACHINE"-pc-sco"$UNAME_REL" + else + echo "$UNAME_MACHINE"-pc-sysv32 + fi + exit ;; + pc:*:*:*) + # Left here for compatibility: + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configure will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; + Intel:Mach:3*:*) + echo i386-pc-mach3 + exit ;; + paragon:*:*:*) + echo i860-intel-osf1 + exit ;; + i860:*:4.*:*) # i860-SVR4 + if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then + echo i860-stardent-sysv"$UNAME_RELEASE" # Stardent Vistra i860-SVR4 + else # Add other i860-SVR4 vendors below as they are discovered. + echo i860-unknown-sysv"$UNAME_RELEASE" # Unknown i860-SVR4 + fi + exit ;; + mini*:CTIX:SYS*5:*) + # "miniframe" + echo m68010-convergent-sysv + exit ;; + mc68k:UNIX:SYSTEM5:3.51m) + echo m68k-convergent-sysv + exit ;; + M680?0:D-NIX:5.3:*) + echo m68k-diab-dnix + exit ;; + M68*:*:R3V[5678]*:*) + test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; + 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) + OS_REL='' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; + 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; + m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) + echo m68k-unknown-lynxos"$UNAME_RELEASE" + exit ;; + mc68030:UNIX_System_V:4.*:*) + echo m68k-atari-sysv4 + exit ;; + TSUNAMI:LynxOS:2.*:*) + echo sparc-unknown-lynxos"$UNAME_RELEASE" + exit ;; + rs6000:LynxOS:2.*:*) + echo rs6000-unknown-lynxos"$UNAME_RELEASE" + exit ;; + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) + echo powerpc-unknown-lynxos"$UNAME_RELEASE" + exit ;; + SM[BE]S:UNIX_SV:*:*) + echo mips-dde-sysv"$UNAME_RELEASE" + exit ;; + RM*:ReliantUNIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + RM*:SINIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + *:SINIX-*:*:*) + if uname -p 2>/dev/null >/dev/null ; then + UNAME_MACHINE=`(uname -p) 2>/dev/null` + echo "$UNAME_MACHINE"-sni-sysv4 + else + echo ns32k-sni-sysv + fi + exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says + echo i586-unisys-sysv4 + exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes . + # How about differentiating between stratus architectures? -djm + echo hppa1.1-stratus-sysv4 + exit ;; + *:*:*:FTX*) + # From seanf@swdc.stratus.com. + echo i860-stratus-sysv4 + exit ;; + i*86:VOS:*:*) + # From Paul.Green@stratus.com. + echo "$UNAME_MACHINE"-stratus-vos + exit ;; + *:VOS:*:*) + # From Paul.Green@stratus.com. + echo hppa1.1-stratus-vos + exit ;; + mc68*:A/UX:*:*) + echo m68k-apple-aux"$UNAME_RELEASE" + exit ;; + news*:NEWS-OS:6*:*) + echo mips-sony-newsos6 + exit ;; + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) + if [ -d /usr/nec ]; then + echo mips-nec-sysv"$UNAME_RELEASE" + else + echo mips-unknown-sysv"$UNAME_RELEASE" + fi + exit ;; + BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. + echo powerpc-be-beos + exit ;; + BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. + echo powerpc-apple-beos + exit ;; + BePC:BeOS:*:*) # BeOS running on Intel PC compatible. + echo i586-pc-beos + exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux"$UNAME_RELEASE" + exit ;; + SX-5:SUPER-UX:*:*) + echo sx5-nec-superux"$UNAME_RELEASE" + exit ;; + SX-6:SUPER-UX:*:*) + echo sx6-nec-superux"$UNAME_RELEASE" + exit ;; + SX-7:SUPER-UX:*:*) + echo sx7-nec-superux"$UNAME_RELEASE" + exit ;; + SX-8:SUPER-UX:*:*) + echo sx8-nec-superux"$UNAME_RELEASE" + exit ;; + SX-8R:SUPER-UX:*:*) + echo sx8r-nec-superux"$UNAME_RELEASE" + exit ;; + SX-ACE:SUPER-UX:*:*) + echo sxace-nec-superux"$UNAME_RELEASE" + exit ;; + Power*:Rhapsody:*:*) + echo powerpc-apple-rhapsody"$UNAME_RELEASE" + exit ;; + *:Rhapsody:*:*) + echo "$UNAME_MACHINE"-apple-rhapsody"$UNAME_RELEASE" + exit ;; + *:Darwin:*:*) + UNAME_PROCESSOR=`uname -p` + case $UNAME_PROCESSOR in + unknown) UNAME_PROCESSOR=powerpc ;; + esac + if command -v xcode-select > /dev/null 2> /dev/null && \ + ! xcode-select --print-path > /dev/null 2> /dev/null ; then + # Avoid executing cc if there is no toolchain installed as + # cc will be a stub that puts up a graphical alert + # prompting the user to install developer tools. + CC_FOR_BUILD=no_compiler_found + else + set_cc_for_build + fi + if [ "$CC_FOR_BUILD" != no_compiler_found ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + case $UNAME_PROCESSOR in + i386) UNAME_PROCESSOR=x86_64 ;; + powerpc) UNAME_PROCESSOR=powerpc64 ;; + esac + fi + # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc + if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_PPC >/dev/null + then + UNAME_PROCESSOR=powerpc + fi + elif test "$UNAME_PROCESSOR" = i386 ; then + # uname -m returns i386 or x86_64 + UNAME_PROCESSOR=$UNAME_MACHINE + fi + echo "$UNAME_PROCESSOR"-apple-darwin"$UNAME_RELEASE" + exit ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) + UNAME_PROCESSOR=`uname -p` + if test "$UNAME_PROCESSOR" = x86; then + UNAME_PROCESSOR=i386 + UNAME_MACHINE=pc + fi + echo "$UNAME_PROCESSOR"-"$UNAME_MACHINE"-nto-qnx"$UNAME_RELEASE" + exit ;; + *:QNX:*:4*) + echo i386-pc-qnx + exit ;; + NEO-*:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk"$UNAME_RELEASE" + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) + echo nse-tandem-nsk"$UNAME_RELEASE" + exit ;; + NSR-*:NONSTOP_KERNEL:*:*) + echo nsr-tandem-nsk"$UNAME_RELEASE" + exit ;; + NSV-*:NONSTOP_KERNEL:*:*) + echo nsv-tandem-nsk"$UNAME_RELEASE" + exit ;; + NSX-*:NONSTOP_KERNEL:*:*) + echo nsx-tandem-nsk"$UNAME_RELEASE" + exit ;; + *:NonStop-UX:*:*) + echo mips-compaq-nonstopux + exit ;; + BS2000:POSIX*:*:*) + echo bs2000-siemens-sysv + exit ;; + DS/*:UNIX_System_V:*:*) + echo "$UNAME_MACHINE"-"$UNAME_SYSTEM"-"$UNAME_RELEASE" + exit ;; + *:Plan9:*:*) + # "uname -m" is not consistent, so use $cputype instead. 386 + # is converted to i386 for consistency with other x86 + # operating systems. + # shellcheck disable=SC2154 + if test "$cputype" = 386; then + UNAME_MACHINE=i386 + else + UNAME_MACHINE="$cputype" + fi + echo "$UNAME_MACHINE"-unknown-plan9 + exit ;; + *:TOPS-10:*:*) + echo pdp10-unknown-tops10 + exit ;; + *:TENEX:*:*) + echo pdp10-unknown-tenex + exit ;; + KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) + echo pdp10-dec-tops20 + exit ;; + XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) + echo pdp10-xkl-tops20 + exit ;; + *:TOPS-20:*:*) + echo pdp10-unknown-tops20 + exit ;; + *:ITS:*:*) + echo pdp10-unknown-its + exit ;; + SEI:*:*:SEIUX) + echo mips-sei-seiux"$UNAME_RELEASE" + exit ;; + *:DragonFly:*:*) + echo "$UNAME_MACHINE"-unknown-dragonfly"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`" + exit ;; + *:*VMS:*:*) + UNAME_MACHINE=`(uname -p) 2>/dev/null` + case "$UNAME_MACHINE" in + A*) echo alpha-dec-vms ; exit ;; + I*) echo ia64-dec-vms ; exit ;; + V*) echo vax-dec-vms ; exit ;; + esac ;; + *:XENIX:*:SysV) + echo i386-pc-xenix + exit ;; + i*86:skyos:*:*) + echo "$UNAME_MACHINE"-pc-skyos"`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'`" + exit ;; + i*86:rdos:*:*) + echo "$UNAME_MACHINE"-pc-rdos + exit ;; + i*86:AROS:*:*) + echo "$UNAME_MACHINE"-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo "$UNAME_MACHINE"-unknown-esx + exit ;; + amd64:Isilon\ OneFS:*:*) + echo x86_64-unknown-onefs + exit ;; + *:Unleashed:*:*) + echo "$UNAME_MACHINE"-unknown-unleashed"$UNAME_RELEASE" + exit ;; +esac + +# No uname command or uname output not recognized. +set_cc_for_build +cat > "$dummy.c" < +#include +#endif +#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) +#if defined (vax) || defined (__vax) || defined (__vax__) || defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) +#include +#if defined(_SIZE_T_) || defined(SIGLOST) +#include +#endif +#endif +#endif +main () +{ +#if defined (sony) +#if defined (MIPSEB) + /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, + I don't know.... */ + printf ("mips-sony-bsd\n"); exit (0); +#else +#include + printf ("m68k-sony-newsos%s\n", +#ifdef NEWSOS4 + "4" +#else + "" +#endif + ); exit (0); +#endif +#endif + +#if defined (NeXT) +#if !defined (__ARCHITECTURE__) +#define __ARCHITECTURE__ "m68k" +#endif + int version; + version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; + if (version < 4) + printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + else + printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); + exit (0); +#endif + +#if defined (MULTIMAX) || defined (n16) +#if defined (UMAXV) + printf ("ns32k-encore-sysv\n"); exit (0); +#else +#if defined (CMU) + printf ("ns32k-encore-mach\n"); exit (0); +#else + printf ("ns32k-encore-bsd\n"); exit (0); +#endif +#endif +#endif + +#if defined (__386BSD__) + printf ("i386-pc-bsd\n"); exit (0); +#endif + +#if defined (sequent) +#if defined (i386) + printf ("i386-sequent-dynix\n"); exit (0); +#endif +#if defined (ns32000) + printf ("ns32k-sequent-dynix\n"); exit (0); +#endif +#endif + +#if defined (_SEQUENT_) + struct utsname un; + + uname(&un); + if (strncmp(un.version, "V2", 2) == 0) { + printf ("i386-sequent-ptx2\n"); exit (0); + } + if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ + printf ("i386-sequent-ptx1\n"); exit (0); + } + printf ("i386-sequent-ptx\n"); exit (0); +#endif + +#if defined (vax) +#if !defined (ultrix) +#include +#if defined (BSD) +#if BSD == 43 + printf ("vax-dec-bsd4.3\n"); exit (0); +#else +#if BSD == 199006 + printf ("vax-dec-bsd4.3reno\n"); exit (0); +#else + printf ("vax-dec-bsd\n"); exit (0); +#endif +#endif +#else + printf ("vax-dec-bsd\n"); exit (0); +#endif +#else +#if defined(_SIZE_T_) || defined(SIGLOST) + struct utsname un; + uname (&un); + printf ("vax-dec-ultrix%s\n", un.release); exit (0); +#else + printf ("vax-dec-ultrix\n"); exit (0); +#endif +#endif +#endif +#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) +#if defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) +#if defined(_SIZE_T_) || defined(SIGLOST) + struct utsname *un; + uname (&un); + printf ("mips-dec-ultrix%s\n", un.release); exit (0); +#else + printf ("mips-dec-ultrix\n"); exit (0); +#endif +#endif +#endif + +#if defined (alliant) && defined (i860) + printf ("i860-alliant-bsd\n"); exit (0); +#endif + + exit (1); +} +EOF + +$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`$dummy` && + { echo "$SYSTEM_NAME"; exit; } + +# Apollos put the system type in the environment. +test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; } + +echo "$0: unable to guess system type" >&2 + +case "$UNAME_MACHINE:$UNAME_SYSTEM" in + mips:Linux | mips64:Linux) + # If we got here on MIPS GNU/Linux, output extra information. + cat >&2 <&2 </dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null` + +hostinfo = `(hostinfo) 2>/dev/null` +/bin/universe = `(/bin/universe) 2>/dev/null` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` +/bin/arch = `(/bin/arch) 2>/dev/null` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` + +UNAME_MACHINE = "$UNAME_MACHINE" +UNAME_RELEASE = "$UNAME_RELEASE" +UNAME_SYSTEM = "$UNAME_SYSTEM" +UNAME_VERSION = "$UNAME_VERSION" +EOF + +exit 1 + +# Local variables: +# eval: (add-hook 'before-save-hook 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/Ipopt-3.13.4/config.sub b/Ipopt-3.13.4/config.sub new file mode 100755 index 000000000..f02d43ad5 --- /dev/null +++ b/Ipopt-3.13.4/config.sub @@ -0,0 +1,1793 @@ +#! /bin/sh +# Configuration validation subroutine script. +# Copyright 1992-2020 Free Software Foundation, Inc. + +timestamp='2020-01-01' + +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, see . +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). + + +# Please send patches to . +# +# Configuration subroutine to validate and canonicalize a configuration type. +# Supply the specified configuration type as an argument. +# If it is invalid, we print an error message on stderr and exit with code 1. +# Otherwise, we print the canonical config type on stdout and succeed. + +# You can get the latest version of this script from: +# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub + +# This file is supposed to be the same for all GNU packages +# and recognize all the CPU types, system types and aliases +# that are meaningful with *any* GNU software. +# Each package is responsible for reporting which valid configurations +# it does not support. The user should be able to distinguish +# a failure to support a valid configuration from a meaningless +# configuration. + +# The goal of this file is to map all the various variations of a given +# machine specification into a single specification in the form: +# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM +# or in some cases, the newer four-part form: +# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM +# It is wrong to echo any other type of specification. + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS + +Canonicalize a configuration name. + +Options: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.sub ($timestamp) + +Copyright 1992-2020 Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + + *local*) + # First pass through any local machine types. + echo "$1" + exit ;; + + * ) + break ;; + esac +done + +case $# in + 0) echo "$me: missing argument$help" >&2 + exit 1;; + 1) ;; + *) echo "$me: too many arguments$help" >&2 + exit 1;; +esac + +# Split fields of configuration type +# shellcheck disable=SC2162 +IFS="-" read field1 field2 field3 field4 <&2 + exit 1 + ;; + *-*-*-*) + basic_machine=$field1-$field2 + os=$field3-$field4 + ;; + *-*-*) + # Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two + # parts + maybe_os=$field2-$field3 + case $maybe_os in + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc \ + | linux-newlib* | linux-musl* | linux-uclibc* | uclinux-uclibc* \ + | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \ + | netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \ + | storm-chaos* | os2-emx* | rtmk-nova*) + basic_machine=$field1 + os=$maybe_os + ;; + android-linux) + basic_machine=$field1-unknown + os=linux-android + ;; + *) + basic_machine=$field1-$field2 + os=$field3 + ;; + esac + ;; + *-*) + # A lone config we happen to match not fitting any pattern + case $field1-$field2 in + decstation-3100) + basic_machine=mips-dec + os= + ;; + *-*) + # Second component is usually, but not always the OS + case $field2 in + # Prevent following clause from handling this valid os + sun*os*) + basic_machine=$field1 + os=$field2 + ;; + # Manufacturers + dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \ + | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \ + | unicom* | ibm* | next | hp | isi* | apollo | altos* \ + | convergent* | ncr* | news | 32* | 3600* | 3100* \ + | hitachi* | c[123]* | convex* | sun | crds | omron* | dg \ + | ultra | tti* | harris | dolphin | highlevel | gould \ + | cbm | ns | masscomp | apple | axis | knuth | cray \ + | microblaze* | sim | cisco \ + | oki | wec | wrs | winbond) + basic_machine=$field1-$field2 + os= + ;; + *) + basic_machine=$field1 + os=$field2 + ;; + esac + ;; + esac + ;; + *) + # Convert single-component short-hands not valid as part of + # multi-component configurations. + case $field1 in + 386bsd) + basic_machine=i386-pc + os=bsd + ;; + a29khif) + basic_machine=a29k-amd + os=udi + ;; + adobe68k) + basic_machine=m68010-adobe + os=scout + ;; + alliant) + basic_machine=fx80-alliant + os= + ;; + altos | altos3068) + basic_machine=m68k-altos + os= + ;; + am29k) + basic_machine=a29k-none + os=bsd + ;; + amdahl) + basic_machine=580-amdahl + os=sysv + ;; + amiga) + basic_machine=m68k-unknown + os= + ;; + amigaos | amigados) + basic_machine=m68k-unknown + os=amigaos + ;; + amigaunix | amix) + basic_machine=m68k-unknown + os=sysv4 + ;; + apollo68) + basic_machine=m68k-apollo + os=sysv + ;; + apollo68bsd) + basic_machine=m68k-apollo + os=bsd + ;; + aros) + basic_machine=i386-pc + os=aros + ;; + aux) + basic_machine=m68k-apple + os=aux + ;; + balance) + basic_machine=ns32k-sequent + os=dynix + ;; + blackfin) + basic_machine=bfin-unknown + os=linux + ;; + cegcc) + basic_machine=arm-unknown + os=cegcc + ;; + convex-c1) + basic_machine=c1-convex + os=bsd + ;; + convex-c2) + basic_machine=c2-convex + os=bsd + ;; + convex-c32) + basic_machine=c32-convex + os=bsd + ;; + convex-c34) + basic_machine=c34-convex + os=bsd + ;; + convex-c38) + basic_machine=c38-convex + os=bsd + ;; + cray) + basic_machine=j90-cray + os=unicos + ;; + crds | unos) + basic_machine=m68k-crds + os= + ;; + da30) + basic_machine=m68k-da30 + os= + ;; + decstation | pmax | pmin | dec3100 | decstatn) + basic_machine=mips-dec + os= + ;; + delta88) + basic_machine=m88k-motorola + os=sysv3 + ;; + dicos) + basic_machine=i686-pc + os=dicos + ;; + djgpp) + basic_machine=i586-pc + os=msdosdjgpp + ;; + ebmon29k) + basic_machine=a29k-amd + os=ebmon + ;; + es1800 | OSE68k | ose68k | ose | OSE) + basic_machine=m68k-ericsson + os=ose + ;; + gmicro) + basic_machine=tron-gmicro + os=sysv + ;; + go32) + basic_machine=i386-pc + os=go32 + ;; + h8300hms) + basic_machine=h8300-hitachi + os=hms + ;; + h8300xray) + basic_machine=h8300-hitachi + os=xray + ;; + h8500hms) + basic_machine=h8500-hitachi + os=hms + ;; + harris) + basic_machine=m88k-harris + os=sysv3 + ;; + hp300 | hp300hpux) + basic_machine=m68k-hp + os=hpux + ;; + hp300bsd) + basic_machine=m68k-hp + os=bsd + ;; + hppaosf) + basic_machine=hppa1.1-hp + os=osf + ;; + hppro) + basic_machine=hppa1.1-hp + os=proelf + ;; + i386mach) + basic_machine=i386-mach + os=mach + ;; + isi68 | isi) + basic_machine=m68k-isi + os=sysv + ;; + m68knommu) + basic_machine=m68k-unknown + os=linux + ;; + magnum | m3230) + basic_machine=mips-mips + os=sysv + ;; + merlin) + basic_machine=ns32k-utek + os=sysv + ;; + mingw64) + basic_machine=x86_64-pc + os=mingw64 + ;; + mingw32) + basic_machine=i686-pc + os=mingw32 + ;; + mingw32ce) + basic_machine=arm-unknown + os=mingw32ce + ;; + monitor) + basic_machine=m68k-rom68k + os=coff + ;; + morphos) + basic_machine=powerpc-unknown + os=morphos + ;; + moxiebox) + basic_machine=moxie-unknown + os=moxiebox + ;; + msdos) + basic_machine=i386-pc + os=msdos + ;; + msys) + basic_machine=i686-pc + os=msys + ;; + mvs) + basic_machine=i370-ibm + os=mvs + ;; + nacl) + basic_machine=le32-unknown + os=nacl + ;; + ncr3000) + basic_machine=i486-ncr + os=sysv4 + ;; + netbsd386) + basic_machine=i386-pc + os=netbsd + ;; + netwinder) + basic_machine=armv4l-rebel + os=linux + ;; + news | news700 | news800 | news900) + basic_machine=m68k-sony + os=newsos + ;; + news1000) + basic_machine=m68030-sony + os=newsos + ;; + necv70) + basic_machine=v70-nec + os=sysv + ;; + nh3000) + basic_machine=m68k-harris + os=cxux + ;; + nh[45]000) + basic_machine=m88k-harris + os=cxux + ;; + nindy960) + basic_machine=i960-intel + os=nindy + ;; + mon960) + basic_machine=i960-intel + os=mon960 + ;; + nonstopux) + basic_machine=mips-compaq + os=nonstopux + ;; + os400) + basic_machine=powerpc-ibm + os=os400 + ;; + OSE68000 | ose68000) + basic_machine=m68000-ericsson + os=ose + ;; + os68k) + basic_machine=m68k-none + os=os68k + ;; + paragon) + basic_machine=i860-intel + os=osf + ;; + parisc) + basic_machine=hppa-unknown + os=linux + ;; + pw32) + basic_machine=i586-unknown + os=pw32 + ;; + rdos | rdos64) + basic_machine=x86_64-pc + os=rdos + ;; + rdos32) + basic_machine=i386-pc + os=rdos + ;; + rom68k) + basic_machine=m68k-rom68k + os=coff + ;; + sa29200) + basic_machine=a29k-amd + os=udi + ;; + sei) + basic_machine=mips-sei + os=seiux + ;; + sequent) + basic_machine=i386-sequent + os= + ;; + sps7) + basic_machine=m68k-bull + os=sysv2 + ;; + st2000) + basic_machine=m68k-tandem + os= + ;; + stratus) + basic_machine=i860-stratus + os=sysv4 + ;; + sun2) + basic_machine=m68000-sun + os= + ;; + sun2os3) + basic_machine=m68000-sun + os=sunos3 + ;; + sun2os4) + basic_machine=m68000-sun + os=sunos4 + ;; + sun3) + basic_machine=m68k-sun + os= + ;; + sun3os3) + basic_machine=m68k-sun + os=sunos3 + ;; + sun3os4) + basic_machine=m68k-sun + os=sunos4 + ;; + sun4) + basic_machine=sparc-sun + os= + ;; + sun4os3) + basic_machine=sparc-sun + os=sunos3 + ;; + sun4os4) + basic_machine=sparc-sun + os=sunos4 + ;; + sun4sol2) + basic_machine=sparc-sun + os=solaris2 + ;; + sun386 | sun386i | roadrunner) + basic_machine=i386-sun + os= + ;; + sv1) + basic_machine=sv1-cray + os=unicos + ;; + symmetry) + basic_machine=i386-sequent + os=dynix + ;; + t3e) + basic_machine=alphaev5-cray + os=unicos + ;; + t90) + basic_machine=t90-cray + os=unicos + ;; + toad1) + basic_machine=pdp10-xkl + os=tops20 + ;; + tpf) + basic_machine=s390x-ibm + os=tpf + ;; + udi29k) + basic_machine=a29k-amd + os=udi + ;; + ultra3) + basic_machine=a29k-nyu + os=sym1 + ;; + v810 | necv810) + basic_machine=v810-nec + os=none + ;; + vaxv) + basic_machine=vax-dec + os=sysv + ;; + vms) + basic_machine=vax-dec + os=vms + ;; + vsta) + basic_machine=i386-pc + os=vsta + ;; + vxworks960) + basic_machine=i960-wrs + os=vxworks + ;; + vxworks68) + basic_machine=m68k-wrs + os=vxworks + ;; + vxworks29k) + basic_machine=a29k-wrs + os=vxworks + ;; + xbox) + basic_machine=i686-pc + os=mingw32 + ;; + ymp) + basic_machine=ymp-cray + os=unicos + ;; + *) + basic_machine=$1 + os= + ;; + esac + ;; +esac + +# Decode 1-component or ad-hoc basic machines +case $basic_machine in + # Here we handle the default manufacturer of certain CPU types. It is in + # some cases the only manufacturer, in others, it is the most popular. + w89k) + cpu=hppa1.1 + vendor=winbond + ;; + op50n) + cpu=hppa1.1 + vendor=oki + ;; + op60c) + cpu=hppa1.1 + vendor=oki + ;; + ibm*) + cpu=i370 + vendor=ibm + ;; + orion105) + cpu=clipper + vendor=highlevel + ;; + mac | mpw | mac-mpw) + cpu=m68k + vendor=apple + ;; + pmac | pmac-mpw) + cpu=powerpc + vendor=apple + ;; + + # Recognize the various machine names and aliases which stand + # for a CPU type and a company and sometimes even an OS. + 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) + cpu=m68000 + vendor=att + ;; + 3b*) + cpu=we32k + vendor=att + ;; + bluegene*) + cpu=powerpc + vendor=ibm + os=cnk + ;; + decsystem10* | dec10*) + cpu=pdp10 + vendor=dec + os=tops10 + ;; + decsystem20* | dec20*) + cpu=pdp10 + vendor=dec + os=tops20 + ;; + delta | 3300 | motorola-3300 | motorola-delta \ + | 3300-motorola | delta-motorola) + cpu=m68k + vendor=motorola + ;; + dpx2*) + cpu=m68k + vendor=bull + os=sysv3 + ;; + encore | umax | mmax) + cpu=ns32k + vendor=encore + ;; + elxsi) + cpu=elxsi + vendor=elxsi + os=${os:-bsd} + ;; + fx2800) + cpu=i860 + vendor=alliant + ;; + genix) + cpu=ns32k + vendor=ns + ;; + h3050r* | hiux*) + cpu=hppa1.1 + vendor=hitachi + os=hiuxwe2 + ;; + hp3k9[0-9][0-9] | hp9[0-9][0-9]) + cpu=hppa1.0 + vendor=hp + ;; + hp9k2[0-9][0-9] | hp9k31[0-9]) + cpu=m68000 + vendor=hp + ;; + hp9k3[2-9][0-9]) + cpu=m68k + vendor=hp + ;; + hp9k6[0-9][0-9] | hp6[0-9][0-9]) + cpu=hppa1.0 + vendor=hp + ;; + hp9k7[0-79][0-9] | hp7[0-79][0-9]) + cpu=hppa1.1 + vendor=hp + ;; + hp9k78[0-9] | hp78[0-9]) + # FIXME: really hppa2.0-hp + cpu=hppa1.1 + vendor=hp + ;; + hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) + # FIXME: really hppa2.0-hp + cpu=hppa1.1 + vendor=hp + ;; + hp9k8[0-9][13679] | hp8[0-9][13679]) + cpu=hppa1.1 + vendor=hp + ;; + hp9k8[0-9][0-9] | hp8[0-9][0-9]) + cpu=hppa1.0 + vendor=hp + ;; + i*86v32) + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc + os=sysv32 + ;; + i*86v4*) + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc + os=sysv4 + ;; + i*86v) + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc + os=sysv + ;; + i*86sol2) + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc + os=solaris2 + ;; + j90 | j90-cray) + cpu=j90 + vendor=cray + os=${os:-unicos} + ;; + iris | iris4d) + cpu=mips + vendor=sgi + case $os in + irix*) + ;; + *) + os=irix4 + ;; + esac + ;; + miniframe) + cpu=m68000 + vendor=convergent + ;; + *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*) + cpu=m68k + vendor=atari + os=mint + ;; + news-3600 | risc-news) + cpu=mips + vendor=sony + os=newsos + ;; + next | m*-next) + cpu=m68k + vendor=next + case $os in + openstep*) + ;; + nextstep*) + ;; + ns2*) + os=nextstep2 + ;; + *) + os=nextstep3 + ;; + esac + ;; + np1) + cpu=np1 + vendor=gould + ;; + op50n-* | op60c-*) + cpu=hppa1.1 + vendor=oki + os=proelf + ;; + pa-hitachi) + cpu=hppa1.1 + vendor=hitachi + os=hiuxwe2 + ;; + pbd) + cpu=sparc + vendor=tti + ;; + pbb) + cpu=m68k + vendor=tti + ;; + pc532) + cpu=ns32k + vendor=pc532 + ;; + pn) + cpu=pn + vendor=gould + ;; + power) + cpu=power + vendor=ibm + ;; + ps2) + cpu=i386 + vendor=ibm + ;; + rm[46]00) + cpu=mips + vendor=siemens + ;; + rtpc | rtpc-*) + cpu=romp + vendor=ibm + ;; + sde) + cpu=mipsisa32 + vendor=sde + os=${os:-elf} + ;; + simso-wrs) + cpu=sparclite + vendor=wrs + os=vxworks + ;; + tower | tower-32) + cpu=m68k + vendor=ncr + ;; + vpp*|vx|vx-*) + cpu=f301 + vendor=fujitsu + ;; + w65) + cpu=w65 + vendor=wdc + ;; + w89k-*) + cpu=hppa1.1 + vendor=winbond + os=proelf + ;; + none) + cpu=none + vendor=none + ;; + leon|leon[3-9]) + cpu=sparc + vendor=$basic_machine + ;; + leon-*|leon[3-9]-*) + cpu=sparc + vendor=`echo "$basic_machine" | sed 's/-.*//'` + ;; + + *-*) + # shellcheck disable=SC2162 + IFS="-" read cpu vendor <&2 + exit 1 + ;; + esac + ;; +esac + +# Here we canonicalize certain aliases for manufacturers. +case $vendor in + digital*) + vendor=dec + ;; + commodore*) + vendor=cbm + ;; + *) + ;; +esac + +# Decode manufacturer-specific aliases for certain operating systems. + +if [ x$os != x ] +then +case $os in + # First match some system type aliases that might get confused + # with valid system types. + # solaris* is a basic system type, with this one exception. + auroraux) + os=auroraux + ;; + bluegene*) + os=cnk + ;; + solaris1 | solaris1.*) + os=`echo $os | sed -e 's|solaris1|sunos4|'` + ;; + solaris) + os=solaris2 + ;; + unixware*) + os=sysv4.2uw + ;; + gnu/linux*) + os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` + ;; + # es1800 is here to avoid being matched by es* (a different OS) + es1800*) + os=ose + ;; + # Some version numbers need modification + chorusos*) + os=chorusos + ;; + isc) + os=isc2.2 + ;; + sco6) + os=sco5v6 + ;; + sco5) + os=sco3.2v5 + ;; + sco4) + os=sco3.2v4 + ;; + sco3.2.[4-9]*) + os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` + ;; + sco3.2v[4-9]* | sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + ;; + scout) + # Don't match below + ;; + sco*) + os=sco3.2v2 + ;; + psos*) + os=psos + ;; + # Now accept the basic system types. + # The portable systems comes first. + # Each alternative MUST end in a * to match a version number. + # sysv* is not here because it comes later, after sysvr4. + gnu* | bsd* | mach* | minix* | genix* | ultrix* | irix* \ + | *vms* | esix* | aix* | cnk* | sunos | sunos[34]*\ + | hpux* | unos* | osf* | luna* | dgux* | auroraux* | solaris* \ + | sym* | kopensolaris* | plan9* \ + | amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \ + | aos* | aros* | cloudabi* | sortix* | twizzler* \ + | nindy* | vxsim* | vxworks* | ebmon* | hms* | mvs* \ + | clix* | riscos* | uniplus* | iris* | isc* | rtu* | xenix* \ + | knetbsd* | mirbsd* | netbsd* \ + | bitrig* | openbsd* | solidbsd* | libertybsd* | os108* \ + | ekkobsd* | kfreebsd* | freebsd* | riscix* | lynxos* \ + | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \ + | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \ + | udi* | eabi* | lites* | ieee* | go32* | aux* | hcos* \ + | chorusrdb* | cegcc* | glidix* \ + | cygwin* | msys* | pe* | moss* | proelf* | rtems* \ + | midipix* | mingw32* | mingw64* | linux-gnu* | linux-android* \ + | linux-newlib* | linux-musl* | linux-uclibc* \ + | uxpv* | beos* | mpeix* | udk* | moxiebox* \ + | interix* | uwin* | mks* | rhapsody* | darwin* \ + | openstep* | oskit* | conix* | pw32* | nonstopux* \ + | storm-chaos* | tops10* | tenex* | tops20* | its* \ + | os2* | vos* | palmos* | uclinux* | nucleus* \ + | morphos* | superux* | rtmk* | windiss* \ + | powermax* | dnix* | nx6 | nx7 | sei* | dragonfly* \ + | skyos* | haiku* | rdos* | toppers* | drops* | es* \ + | onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \ + | midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \ + | nsk* | powerunix) + # Remember, each alternative MUST END IN *, to match a version number. + ;; + qnx*) + case $cpu in + x86 | i*86) + ;; + *) + os=nto-$os + ;; + esac + ;; + hiux*) + os=hiuxwe2 + ;; + nto-qnx*) + ;; + nto*) + os=`echo $os | sed -e 's|nto|nto-qnx|'` + ;; + sim | xray | os68k* | v88r* \ + | windows* | osx | abug | netware* | os9* \ + | macos* | mpw* | magic* | mmixware* | mon960* | lnews*) + ;; + linux-dietlibc) + os=linux-dietlibc + ;; + linux*) + os=`echo $os | sed -e 's|linux|linux-gnu|'` + ;; + lynx*178) + os=lynxos178 + ;; + lynx*5) + os=lynxos5 + ;; + lynx*) + os=lynxos + ;; + mac*) + os=`echo "$os" | sed -e 's|mac|macos|'` + ;; + opened*) + os=openedition + ;; + os400*) + os=os400 + ;; + sunos5*) + os=`echo "$os" | sed -e 's|sunos5|solaris2|'` + ;; + sunos6*) + os=`echo "$os" | sed -e 's|sunos6|solaris3|'` + ;; + wince*) + os=wince + ;; + utek*) + os=bsd + ;; + dynix*) + os=bsd + ;; + acis*) + os=aos + ;; + atheos*) + os=atheos + ;; + syllable*) + os=syllable + ;; + 386bsd) + os=bsd + ;; + ctix* | uts*) + os=sysv + ;; + nova*) + os=rtmk-nova + ;; + ns2) + os=nextstep2 + ;; + # Preserve the version number of sinix5. + sinix5.*) + os=`echo $os | sed -e 's|sinix|sysv|'` + ;; + sinix*) + os=sysv4 + ;; + tpf*) + os=tpf + ;; + triton*) + os=sysv3 + ;; + oss*) + os=sysv3 + ;; + svr4*) + os=sysv4 + ;; + svr3) + os=sysv3 + ;; + sysvr4) + os=sysv4 + ;; + # This must come after sysvr4. + sysv*) + ;; + ose*) + os=ose + ;; + *mint | mint[0-9]* | *MiNT | MiNT[0-9]*) + os=mint + ;; + zvmoe) + os=zvmoe + ;; + dicos*) + os=dicos + ;; + pikeos*) + # Until real need of OS specific support for + # particular features comes up, bare metal + # configurations are quite functional. + case $cpu in + arm*) + os=eabi + ;; + *) + os=elf + ;; + esac + ;; + nacl*) + ;; + ios) + ;; + none) + ;; + *-eabi) + ;; + *) + echo Invalid configuration \`"$1"\': system \`"$os"\' not recognized 1>&2 + exit 1 + ;; +esac +else + +# Here we handle the default operating systems that come with various machines. +# The value should be what the vendor currently ships out the door with their +# machine or put another way, the most popular os provided with the machine. + +# Note that if you're going to try to match "-MANUFACTURER" here (say, +# "-sun"), then you have to tell the case statement up towards the top +# that MANUFACTURER isn't an operating system. Otherwise, code above +# will signal an error saying that MANUFACTURER isn't an operating +# system, and we'll never get to this point. + +case $cpu-$vendor in + score-*) + os=elf + ;; + spu-*) + os=elf + ;; + *-acorn) + os=riscix1.2 + ;; + arm*-rebel) + os=linux + ;; + arm*-semi) + os=aout + ;; + c4x-* | tic4x-*) + os=coff + ;; + c8051-*) + os=elf + ;; + clipper-intergraph) + os=clix + ;; + hexagon-*) + os=elf + ;; + tic54x-*) + os=coff + ;; + tic55x-*) + os=coff + ;; + tic6x-*) + os=coff + ;; + # This must come before the *-dec entry. + pdp10-*) + os=tops20 + ;; + pdp11-*) + os=none + ;; + *-dec | vax-*) + os=ultrix4.2 + ;; + m68*-apollo) + os=domain + ;; + i386-sun) + os=sunos4.0.2 + ;; + m68000-sun) + os=sunos3 + ;; + m68*-cisco) + os=aout + ;; + mep-*) + os=elf + ;; + mips*-cisco) + os=elf + ;; + mips*-*) + os=elf + ;; + or32-*) + os=coff + ;; + *-tti) # must be before sparc entry or we get the wrong os. + os=sysv3 + ;; + sparc-* | *-sun) + os=sunos4.1.1 + ;; + pru-*) + os=elf + ;; + *-be) + os=beos + ;; + *-ibm) + os=aix + ;; + *-knuth) + os=mmixware + ;; + *-wec) + os=proelf + ;; + *-winbond) + os=proelf + ;; + *-oki) + os=proelf + ;; + *-hp) + os=hpux + ;; + *-hitachi) + os=hiux + ;; + i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) + os=sysv + ;; + *-cbm) + os=amigaos + ;; + *-dg) + os=dgux + ;; + *-dolphin) + os=sysv3 + ;; + m68k-ccur) + os=rtu + ;; + m88k-omron*) + os=luna + ;; + *-next) + os=nextstep + ;; + *-sequent) + os=ptx + ;; + *-crds) + os=unos + ;; + *-ns) + os=genix + ;; + i370-*) + os=mvs + ;; + *-gould) + os=sysv + ;; + *-highlevel) + os=bsd + ;; + *-encore) + os=bsd + ;; + *-sgi) + os=irix + ;; + *-siemens) + os=sysv4 + ;; + *-masscomp) + os=rtu + ;; + f30[01]-fujitsu | f700-fujitsu) + os=uxpv + ;; + *-rom68k) + os=coff + ;; + *-*bug) + os=coff + ;; + *-apple) + os=macos + ;; + *-atari*) + os=mint + ;; + *-wrs) + os=vxworks + ;; + *) + os=none + ;; +esac +fi + +# Here we handle the case where we know the os, and the CPU type, but not the +# manufacturer. We pick the logical manufacturer. +case $vendor in + unknown) + case $os in + riscix*) + vendor=acorn + ;; + sunos*) + vendor=sun + ;; + cnk*|-aix*) + vendor=ibm + ;; + beos*) + vendor=be + ;; + hpux*) + vendor=hp + ;; + mpeix*) + vendor=hp + ;; + hiux*) + vendor=hitachi + ;; + unos*) + vendor=crds + ;; + dgux*) + vendor=dg + ;; + luna*) + vendor=omron + ;; + genix*) + vendor=ns + ;; + clix*) + vendor=intergraph + ;; + mvs* | opened*) + vendor=ibm + ;; + os400*) + vendor=ibm + ;; + ptx*) + vendor=sequent + ;; + tpf*) + vendor=ibm + ;; + vxsim* | vxworks* | windiss*) + vendor=wrs + ;; + aux*) + vendor=apple + ;; + hms*) + vendor=hitachi + ;; + mpw* | macos*) + vendor=apple + ;; + *mint | mint[0-9]* | *MiNT | MiNT[0-9]*) + vendor=atari + ;; + vos*) + vendor=stratus + ;; + esac + ;; +esac + +echo "$cpu-$vendor-$os" +exit + +# Local variables: +# eval: (add-hook 'before-save-hook 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/Ipopt-3.13.4/configure b/Ipopt-3.13.4/configure new file mode 100755 index 000000000..cb029cc61 --- /dev/null +++ b/Ipopt-3.13.4/configure @@ -0,0 +1,29302 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.69 for Ipopt 3.13.5. +# +# Report bugs to . +# +# +# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +# +# +# Copyright 2004, 2011 International Business Machines and others. +# All Rights Reserved. +# This file is part of the open source package IPOPT which is distributed +# under the Eclipse Public License. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 + + test -n \"\${ZSH_VERSION+set}\${BASH_VERSION+set}\" || ( + ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' + ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO + ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO + PATH=/empty FPATH=/empty; export PATH FPATH + test \"X\`printf %s \$ECHO\`\" = \"X\$ECHO\" \\ + || test \"X\`print -r -- \$ECHO\`\" = \"X\$ECHO\" ) || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org and +$0: https://github.com/coin-or/Ipopt/issues/new about your +$0: system, including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + +SHELL=${CONFIG_SHELL-/bin/sh} + + +test -n "$DJDIR" || exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='Ipopt' +PACKAGE_TARNAME='ipopt' +PACKAGE_VERSION='3.13.5' +PACKAGE_STRING='Ipopt 3.13.5' +PACKAGE_BUGREPORT='https://github.com/coin-or/Ipopt/issues/new' +PACKAGE_URL='https://github.com/coin-or/Ipopt' + +ac_unique_file="src/Common/IpDebug.hpp" +# Factoring default headers for most tests. +ac_includes_default="\ +#include +#ifdef HAVE_SYS_TYPES_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif +#ifdef STDC_HEADERS +# include +# include +#else +# ifdef HAVE_STDLIB_H +# include +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include +# endif +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_INTTYPES_H +# include +#endif +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_UNISTD_H +# include +#endif" + +ac_subst_vars='am__EXEEXT_FALSE +am__EXEEXT_TRUE +LTLIBOBJS +LIBOBJS +SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC +SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC +IPOPTAMPLINTERFACELIB_CFLAGS_NOPC +IPOPTAMPLINTERFACELIB_LFLAGS_NOPC +IPOPTLIB_CFLAGS_NOPC +IPOPTLIB_LFLAGS_NOPC +BUILD_SIPOPT_FALSE +BUILD_SIPOPT_TRUE +BUILD_LINEARSOLVERLOADER_FALSE +BUILD_LINEARSOLVERLOADER_TRUE +IPALLLIBS +BUILD_JAVA_FALSE +BUILD_JAVA_TRUE +JAVADOC +JAVA +JAR +_ACJNI_JAVAC +JAVAC +BUILD_INEXACT_FALSE +BUILD_INEXACT_TRUE +BIT64FCOMMENT +BIT32FCOMMENT +BITS_PER_POINTER +HAVE_WSMP_FALSE +HAVE_WSMP_TRUE +HAVE_PARDISO_FALSE +HAVE_PARDISO_TRUE +HAVE_MA28_FALSE +HAVE_MA28_TRUE +HSLLIB_CFLAGS_NOPC +HSLLIB_LFLAGS_NOPC +IPOPT_HAS_HSL_FALSE +IPOPT_HAS_HSL_TRUE +HSLLIB_PCFILES +HSLLIB_CFLAGS +HSLLIB_LFLAGS +IPOPT_HAS_MUMPS_FALSE +IPOPT_HAS_MUMPS_TRUE +IPOPT_HAS_ASL_FALSE +IPOPT_HAS_ASL_TRUE +SIPOPTAMPLINTERFACELIB_PCFILES +SIPOPTAMPLINTERFACELIB_CFLAGS +SIPOPTAMPLINTERFACELIB_LFLAGS +IPOPTAMPLINTERFACELIB_PCFILES +IPOPTAMPLINTERFACELIB_CFLAGS +IPOPTAMPLINTERFACELIB_LFLAGS +IPOPT_HAS_LAPACK_FALSE +IPOPT_HAS_LAPACK_TRUE +COIN_PKG_CONFIG_PATH +COIN_HAS_PKGCONFIG_FALSE +COIN_HAS_PKGCONFIG_TRUE +ac_ct_PKG_CONFIG +PKG_CONFIG +IPOPTLIB_PCFILES +IPOPTLIB_CFLAGS +IPOPTLIB_LFLAGS +coin_doxy_tagfiles +COIN_HAS_LATEX_FALSE +COIN_HAS_LATEX_TRUE +COIN_HAS_DOXYGEN_FALSE +COIN_HAS_DOXYGEN_TRUE +coin_doxy_logname +coin_doxy_tagname +coin_doxy_usedot +coin_have_latex +coin_have_doxygen +CXXLIBS +RPATH_FLAGS +COIN_STATIC_BUILD_FALSE +COIN_STATIC_BUILD_TRUE +LT_LDFLAGS +CXXCPP +CPP +LT_SYS_LIBRARY_PATH +OTOOL64 +OTOOL +LIPO +NMEDIT +DSYMUTIL +MANIFEST_TOOL +RANLIB +LN_S +NM +ac_ct_DUMPBIN +DUMPBIN +LD +FGREP +EGREP +GREP +SED +LIBTOOL +OBJDUMP +DLLTOOL +AS +ac_ct_AR +AR +FLIBS +ADD_FFLAGS +COIN_HAS_F77_FALSE +COIN_HAS_F77_TRUE +ac_ct_F77 +FFLAGS +F77 +ADD_CXXFLAGS +am__fastdepCXX_FALSE +am__fastdepCXX_TRUE +CXXDEPMODE +ac_ct_CXX +CXXFLAGS +CXX +ADD_CFLAGS +am__fastdepCC_FALSE +am__fastdepCC_TRUE +CCDEPMODE +am__nodep +AMDEPBACKSLASH +AMDEP_FALSE +AMDEP_TRUE +am__include +DEPDIR +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +COIN_RELOCATABLE_FALSE +COIN_RELOCATABLE_TRUE +am__untar +am__tar +AMTAR +am__leading_dot +SET_MAKE +AWK +mkdir_p +MKDIR_P +INSTALL_STRIP_PROGRAM +STRIP +install_sh +MAKEINFO +AUTOHEADER +AUTOMAKE +AUTOCONF +ACLOCAL +VERSION +PACKAGE +CYGPATH_W +am__isrc +INSTALL_DATA +INSTALL_SCRIPT +INSTALL_PROGRAM +MAINT +MAINTAINER_MODE_FALSE +MAINTAINER_MODE_TRUE +AM_BACKSLASH +AM_DEFAULT_VERBOSITY +AM_DEFAULT_V +AM_V +host_os +host_vendor +host_cpu +host +CC +build_os +build_vendor +build_cpu +build +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL +am__quote' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +enable_msvc +enable_debug +enable_silent_rules +enable_maintainer_mode +enable_relocatable +enable_dependency_tracking +enable_f77 +enable_static +with_pic +enable_shared +enable_fast_install +with_aix_soname +with_gnu_ld +with_sysroot +enable_libtool_lock +with_dot +with_ipopt_verbosity +with_ipopt_checklevel +with_lapack +with_lapack_lflags +with_asl +with_asl_lflags +with_asl_cflags +with_mumps +with_mumps_lflags +with_mumps_cflags +with_hsl +with_hsl_lflags +with_hsl_cflags +with_pardiso +with_wsmp +enable_inexact_solver +enable_java +enable_linear_solver_loader +enable_sipopt +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +ADD_CFLAGS +CXX +CXXFLAGS +CCC +ADD_CXXFLAGS +F77 +FFLAGS +ADD_FFLAGS +LT_SYS_LIBRARY_PATH +CPP +CXXCPP +LT_LDFLAGS +CXXLIBS +PKG_CONFIG' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures Ipopt 3.13.5 to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/ipopt] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF + +Program names: + --program-prefix=PREFIX prepend PREFIX to installed program names + --program-suffix=SUFFIX append SUFFIX to installed program names + --program-transform-name=PROGRAM run sed PROGRAM on installed program names + +System types: + --build=BUILD configure for building on BUILD [guessed] + --host=HOST cross-compile to build programs to run on HOST [BUILD] +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of Ipopt 3.13.5:";; + esac + cat <<\_ACEOF + +Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --enable-msvc look for and allow only Intel/Microsoft compilers on + MinGW/MSys/Cygwin + --enable-debug build debugging symbols and turn off compiler + optimization + --enable-silent-rules less verbose build output (undo: "make V=1") + --disable-silent-rules verbose build output (undo: "make V=0") + --enable-maintainer-mode + enable make rules and dependencies not useful (and + sometimes confusing) to the casual installer + --enable-relocatable whether prefix in installed .pc files should be + setup relative to pcfiledir + --enable-dependency-tracking + do not reject slow dependency extractors + --disable-dependency-tracking + speeds up one-time build + --disable-f77 disable checking for F77 compiler + --enable-static[=PKGS] build static libraries [default=no] + --enable-shared[=PKGS] build shared libraries [default=yes] + --enable-fast-install[=PKGS] + optimize for fast installation [default=yes] + --disable-libtool-lock avoid locking (might break parallel builds) + --enable-inexact-solver enable inexact linear solver version EXPERIMENTAL! + (default: no) + --disable-java disable building of Java interface + --disable-linear-solver-loader + disable build of linear solver loader + --disable-sipopt disable build of sIpopt + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-pic[=PKGS] try to use only PIC/non-PIC objects [default=use + both] + --with-aix-soname=aix|svr4|both + shared library versioning (aka "SONAME") variant to + provide on AIX, [default=aix]. + --with-gnu-ld assume the C compiler uses GNU ld [default=no] + --with-sysroot[=DIR] Search for dependent libraries within DIR (or the + compiler's sysroot if not specified). + --with-dot use dot (from graphviz) when creating documentation + with doxygen if available; --without-dot to disable + --with-ipopt-verbosity specify the debug verbosity level + --with-ipopt-checklevel specify the sanity check level + --with-lapack Use lapack. If an argument is given, 'yes' is + equivalent to --with-lapack, 'no' is + equivalent to --without-lapack. Any other argument + is applied as for --with-lapack-lflags + --with-lapack-lflags Linker flags for lapack appropriate for your + environment. (Most often, -l specs for libraries.) + --with-asl Use ASL. If an argument is given, 'yes' is + equivalent to --with-asl, 'no' is + equivalent to --without-asl, 'build' will look for a + COIN-OR ThirdParty package. Any other argument is + applied as for --with-asl-lflags + --with-asl-lflags Linker flags for ASL appropriate for your + environment. (Most often, -l specs for libraries.) + --with-asl-cflags Compiler flags for ASL appropriate for your + environment. (Most often, -I specs for header file + directories.) + --with-mumps Use Mumps. If an argument is given, 'yes' is + equivalent to --with-mumps, 'no' is + equivalent to --without-mumps, 'build' will look for + a COIN-OR ThirdParty package. Any other argument is + applied as for --with-mumps-lflags + --with-mumps-lflags Linker flags for Mumps appropriate for your + environment. (Most often, -l specs for libraries.) + --with-mumps-cflags Compiler flags for Mumps appropriate for your + environment. (Most often, -I specs for header file + directories.) + --with-hsl Use HSL. If an argument is given, 'yes' is + equivalent to --with-hsl, 'no' is + equivalent to --without-hsl, 'build' will look for a + COIN-OR ThirdParty package. Any other argument is + applied as for --with-hsl-lflags + --with-hsl-lflags Linker flags for HSL appropriate for your + environment. (Most often, -l specs for libraries.) + --with-hsl-cflags Compiler flags for HSL appropriate for your + environment. (Most often, -I specs for header file + directories.) + --with-pardiso specify Pardiso library (>= 4.0) from + pardiso-project.org; use --without-pardiso to + disable also MKL Pardiso check + --with-wsmp specify WSMP library + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + ADD_CFLAGS Additional C compiler options (if not overwriting CFLAGS) + CXX C++ compiler command + CXXFLAGS C++ compiler flags + ADD_CXXFLAGS + Additional C++ compiler options (if not overwriting CXXFLAGS) + F77 Fortran 77 compiler command + FFLAGS Fortran 77 compiler flags + ADD_FFLAGS Additional Fortran 77 compiler options (if not overwriting + FFLAGS) + LT_SYS_LIBRARY_PATH + User-defined run-time library search path. + CPP C preprocessor + CXXCPP C++ preprocessor + LT_LDFLAGS Flags passed to libtool when building libraries or executables + that are installed + CXXLIBS Libraries necessary for linking C++ code with non-C++ compiler + PKG_CONFIG path to pkg-config utility + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to . +Ipopt home page: . +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +Ipopt configure 3.13.5 +generated by GNU Autoconf 2.69 + +Copyright (C) 2012 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. + + +Copyright 2004, 2011 International Business Machines and others. +All Rights Reserved. +This file is part of the open source package IPOPT which is distributed +under the Eclipse Public License. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_cxx_try_compile LINENO +# ---------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_cxx_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_cxx_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_cxx_try_compile + +# ac_fn_f77_try_compile LINENO +# ---------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_f77_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_f77_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_f77_try_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_cpp + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case declares $2. + For example, HP-UX 11i declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func + +# ac_fn_cxx_try_cpp LINENO +# ------------------------ +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_cxx_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_cxx_preproc_warn_flag$ac_cxx_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_cxx_try_cpp + +# ac_fn_cxx_try_link LINENO +# ------------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_cxx_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_cxx_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_cxx_try_link + +# ac_fn_f77_try_link LINENO +# ------------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_f77_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_f77_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_f77_try_link + +# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES +# -------------------------------------------- +# Tries to find the compile-time value of EXPR in a program that includes +# INCLUDES, setting VAR accordingly. Returns whether the value could be +# computed +ac_fn_c_compute_int () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +static int test_array [1 - 2 * !(($2) >= 0)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_lo=0 ac_mid=0 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=$ac_mid; break +else + as_fn_arith $ac_mid + 1 && ac_lo=$as_val + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid + 1 && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + done +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +static int test_array [1 - 2 * !(($2) < 0)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=-1 ac_mid=-1 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +static int test_array [1 - 2 * !(($2) >= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_lo=$ac_mid; break +else + as_fn_arith '(' $ac_mid ')' - 1 && ac_hi=$as_val + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + done +else + ac_lo= ac_hi= +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +# Binary search between lo and hi bounds. +while test "x$ac_lo" != "x$ac_hi"; do + as_fn_arith '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo && ac_mid=$as_val + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=$ac_mid +else + as_fn_arith '(' $ac_mid ')' + 1 && ac_lo=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done +case $ac_lo in #(( +?*) eval "$3=\$ac_lo"; ac_retval=0 ;; +'') ac_retval=1 ;; +esac + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +static long int longval () { return $2; } +static unsigned long int ulongval () { return $2; } +#include +#include +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + return 1; + if (($2) < 0) + { + long int i = longval (); + if (i != ($2)) + return 1; + fprintf (f, "%ld", i); + } + else + { + unsigned long int i = ulongval (); + if (i != ($2)) + return 1; + fprintf (f, "%lu", i); + } + /* Do not output a trailing newline, as this causes \r\n confusion + on some platforms. */ + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + echo >>conftest.val; read $3 &5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.i conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_cxx_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} +( $as_echo "## ---------------------------------------------------------- ## +## Report this to https://github.com/coin-or/Ipopt/issues/new ## +## ---------------------------------------------------------- ##" + ) | sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=\$ac_header_compiler" +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_cxx_check_header_mongrel + +# ac_fn_cxx_check_decl LINENO SYMBOL VAR INCLUDES +# ----------------------------------------------- +# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR +# accordingly. +ac_fn_cxx_check_decl () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + as_decl_name=`echo $2|sed 's/ *(.*//'` + as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5 +$as_echo_n "checking whether $as_decl_name is declared... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +#ifndef $as_decl_name +#ifdef __cplusplus + (void) $as_decl_use; +#else + (void) $as_decl_name; +#endif +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_cxx_check_decl + +# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists, giving a warning if it cannot be compiled using +# the include files in INCLUDES and setting the cache variable VAR +# accordingly. +ac_fn_c_check_header_mongrel () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if eval \${$3+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.i conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} +( $as_echo "## ---------------------------------------------------------- ## +## Report this to https://github.com/coin-or/Ipopt/issues/new ## +## ---------------------------------------------------------- ##" + ) | sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=\$ac_header_compiler" +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_mongrel +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by Ipopt $as_me 3.13.5, which was +generated by GNU Autoconf 2.69. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + $as_echo "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + $as_echo "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + $as_echo "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + +# List one file in the package so that the configure script can test +# whether the package is actually there + + +# Do some project-level initialization work (version numbers, ...) +ac_aux_dir= +for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do + if test -f "$ac_dir/install-sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f "$ac_dir/install.sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f "$ac_dir/shtool"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi +done +if test -z "$ac_aux_dir"; then + as_fn_error $? "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5 +fi + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. +ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. +ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + +# Make sure we can run config.sub. +$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || + as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 +$as_echo_n "checking build system type... " >&6; } +if ${ac_cv_build+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_build_alias=$build_alias +test "x$ac_build_alias" = x && + ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` +test "x$ac_build_alias" = x && + as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5 +ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 +$as_echo "$ac_cv_build" >&6; } +case $ac_cv_build in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; +esac +build=$ac_cv_build +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_build +shift +build_cpu=$1 +build_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +build_os=$* +IFS=$ac_save_IFS +case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac + + + + + + # Check whether --enable-msvc was given. +if test "${enable_msvc+set}" = set; then : + enableval=$enable_msvc; enable_msvc=$enableval +else + enable_msvc=no + case $build in + *-mingw* | *-cygwin* | *-msys* ) + for ac_prog in gcc clang icl cl +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break +done + + case "$CC" in *cl ) enable_msvc=yes ;; esac + ;; + esac +fi + + + + + + # Check whether --enable-debug was given. +if test "${enable_debug+set}" = set; then : + enableval=$enable_debug; enable_debug=$enableval +else + enable_debug=no +fi + + + + + + + + if test "$enable_debug" = yes ; then + if test "$enable_msvc" = yes ; then + : ${FFLAGS:="-nologo -fpp -Z7 -MDd $ADD_FFLAGS"} + : ${FCFLAGS:="-nologo -fpp -Z7 -MDd $ADD_FCFLAGS"} + : ${CFLAGS:="-nologo -Z7 -MDd $ADD_CFLAGS"} + : ${CXXFLAGS:="-nologo -EHs -Z7 -MDd $ADD_CXXFLAGS"} + else + : ${FFLAGS:="-g $ADD_FFLAGS"} + : ${FCFLAGS:="-g $ADD_FCFLAGS"} + : ${CFLAGS:="-g $ADD_CFLAGS"} + : ${CXXFLAGS:="-g $ADD_CXXFLAGS"} + fi + else + if test "$enable_msvc" = yes ; then + : ${FFLAGS:="-nologo -fpp -O2 -MD $ADD_FFLAGS"} + : ${FCFLAGS:="-nologo -fpp -O2 -MD $ADD_FCFLAGS"} + : ${CFLAGS:="-nologo -DNDEBUG -O2 -MD $ADD_CFLAGS"} + : ${CXXFLAGS:="-nologo -EHs -DNDEBUG -O2 -MD $ADD_CXXFLAGS"} + else + : ${FFLAGS:="-O2 $ADD_FFLAGS"} + : ${FCFLAGS:="-O2 $ADD_FCFLAGS"} + : ${CFLAGS:="-O2 -DNDEBUG $ADD_CFLAGS"} + : ${CXXFLAGS:="-O2 -DNDEBUG $ADD_CXXFLAGS"} + fi + fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 +$as_echo_n "checking host system type... " >&6; } +if ${ac_cv_host+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "x$host_alias" = x; then + ac_cv_host=$ac_cv_build +else + ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5 +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5 +$as_echo "$ac_cv_host" >&6; } +case $ac_cv_host in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;; +esac +host=$ac_cv_host +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_host +shift +host_cpu=$1 +host_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +host_os=$* +IFS=$ac_save_IFS +case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac + + +am__api_version='1.16' + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AmigaOS /C/install, which installs bootblocks on floppy discs +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# OS/2's system install, which has a completely different semantic +# ./install, which can be erroneously created by make from ./install.sh. +# Reject install programs that cannot install multiple files. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 +$as_echo_n "checking for a BSD-compatible install... " >&6; } +if test -z "$INSTALL"; then +if ${ac_cv_path_install+:} false; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + # Account for people who put trailing slashes in PATH elements. +case $as_dir/ in #(( + ./ | .// | /[cC]/* | \ + /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ + ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \ + /usr/ucb/* ) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then + if test $ac_prog = install && + grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + elif test $ac_prog = install && + grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : + else + rm -rf conftest.one conftest.two conftest.dir + echo one > conftest.one + echo two > conftest.two + mkdir conftest.dir + if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && + test -s conftest.one && test -s conftest.two && + test -s conftest.dir/conftest.one && + test -s conftest.dir/conftest.two + then + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi + fi + fi + done + done + ;; +esac + + done +IFS=$as_save_IFS + +rm -rf conftest.one conftest.two conftest.dir + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL=$ac_cv_path_install + else + # As a last resort, use the slow shell script. Don't cache a + # value for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + INSTALL=$ac_install_sh + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5 +$as_echo "$INSTALL" >&6; } + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether build environment is sane" >&5 +$as_echo_n "checking whether build environment is sane... " >&6; } +# Reject unsafe characters in $srcdir or the absolute working directory +# name. Accept space and tab only in the latter. +am_lf=' +' +case `pwd` in + *[\\\"\#\$\&\'\`$am_lf]*) + as_fn_error $? "unsafe absolute working directory name" "$LINENO" 5;; +esac +case $srcdir in + *[\\\"\#\$\&\'\`$am_lf\ \ ]*) + as_fn_error $? "unsafe srcdir value: '$srcdir'" "$LINENO" 5;; +esac + +# Do 'set' in a subshell so we don't clobber the current shell's +# arguments. Must try -L first in case configure is actually a +# symlink; some systems play weird games with the mod time of symlinks +# (eg FreeBSD returns the mod time of the symlink's containing +# directory). +if ( + am_has_slept=no + for am_try in 1 2; do + echo "timestamp, slept: $am_has_slept" > conftest.file + set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null` + if test "$*" = "X"; then + # -L didn't work. + set X `ls -t "$srcdir/configure" conftest.file` + fi + if test "$*" != "X $srcdir/configure conftest.file" \ + && test "$*" != "X conftest.file $srcdir/configure"; then + + # If neither matched, then we have a broken ls. This can happen + # if, for instance, CONFIG_SHELL is bash and it inherits a + # broken ls alias from the environment. This has actually + # happened. Such a system could not be considered "sane". + as_fn_error $? "ls -t appears to fail. Make sure there is not a broken + alias in your environment" "$LINENO" 5 + fi + if test "$2" = conftest.file || test $am_try -eq 2; then + break + fi + # Just in case. + sleep 1 + am_has_slept=yes + done + test "$2" = conftest.file + ) +then + # Ok. + : +else + as_fn_error $? "newly created file is older than distributed files! +Check your system clock" "$LINENO" 5 +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +# If we didn't sleep, we still need to ensure time stamps of config.status and +# generated files are strictly newer. +am_sleep_pid= +if grep 'slept: no' conftest.file >/dev/null 2>&1; then + ( sleep 1 ) & + am_sleep_pid=$! +fi + +rm -f conftest.file + +test "$program_prefix" != NONE && + program_transform_name="s&^&$program_prefix&;$program_transform_name" +# Use a double $ so make ignores it. +test "$program_suffix" != NONE && + program_transform_name="s&\$&$program_suffix&;$program_transform_name" +# Double any \ or $. +# By default was `s,x,x', remove it if useless. +ac_script='s/[\\$]/&&/g;s/;s,x,x,$//' +program_transform_name=`$as_echo "$program_transform_name" | sed "$ac_script"` + +# Expand $ac_aux_dir to an absolute path. +am_aux_dir=`cd "$ac_aux_dir" && pwd` + +if test x"${MISSING+set}" != xset; then + case $am_aux_dir in + *\ * | *\ *) + MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;; + *) + MISSING="\${SHELL} $am_aux_dir/missing" ;; + esac +fi +# Use eval to expand $SHELL +if eval "$MISSING --is-lightweight"; then + am_missing_run="$MISSING " +else + am_missing_run= + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 'missing' script is too old or missing" >&5 +$as_echo "$as_me: WARNING: 'missing' script is too old or missing" >&2;} +fi + +if test x"${install_sh+set}" != xset; then + case $am_aux_dir in + *\ * | *\ *) + install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;; + *) + install_sh="\${SHELL} $am_aux_dir/install-sh" + esac +fi + +# Installed binaries are usually stripped using 'strip' when the user +# run "make install-strip". However 'strip' might not be the right +# tool to use in cross-compilation environments, therefore Automake +# will honor the 'STRIP' environment variable to overrule this program. +if test "$cross_compiling" != no; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. +set dummy ${ac_tool_prefix}strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_STRIP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$STRIP"; then + ac_cv_prog_STRIP="$STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_STRIP="${ac_tool_prefix}strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +STRIP=$ac_cv_prog_STRIP +if test -n "$STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5 +$as_echo "$STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_STRIP"; then + ac_ct_STRIP=$STRIP + # Extract the first word of "strip", so it can be a program name with args. +set dummy strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_STRIP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_STRIP"; then + ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_STRIP="strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP +if test -n "$ac_ct_STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5 +$as_echo "$ac_ct_STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_STRIP" = x; then + STRIP=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + STRIP=$ac_ct_STRIP + fi +else + STRIP="$ac_cv_prog_STRIP" +fi + +fi +INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a thread-safe mkdir -p" >&5 +$as_echo_n "checking for a thread-safe mkdir -p... " >&6; } +if test -z "$MKDIR_P"; then + if ${ac_cv_path_mkdir+:} false; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/opt/sfw/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in mkdir gmkdir; do + for ac_exec_ext in '' $ac_executable_extensions; do + as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext" || continue + case `"$as_dir/$ac_prog$ac_exec_ext" --version 2>&1` in #( + 'mkdir (GNU coreutils) '* | \ + 'mkdir (coreutils) '* | \ + 'mkdir (fileutils) '4.1*) + ac_cv_path_mkdir=$as_dir/$ac_prog$ac_exec_ext + break 3;; + esac + done + done + done +IFS=$as_save_IFS + +fi + + test -d ./--version && rmdir ./--version + if test "${ac_cv_path_mkdir+set}" = set; then + MKDIR_P="$ac_cv_path_mkdir -p" + else + # As a last resort, use the slow shell script. Don't cache a + # value for MKDIR_P within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + MKDIR_P="$ac_install_sh -d" + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MKDIR_P" >&5 +$as_echo "$MKDIR_P" >&6; } + +for ac_prog in gawk mawk nawk awk +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AWK+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AWK"; then + ac_cv_prog_AWK="$AWK" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AWK="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AWK=$ac_cv_prog_AWK +if test -n "$AWK"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5 +$as_echo "$AWK" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$AWK" && break +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } +set x ${MAKE-make} +ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat >conftest.make <<\_ACEOF +SHELL = /bin/sh +all: + @echo '@@@%%%=$(MAKE)=@@@%%%' +_ACEOF +# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. +case `${MAKE-make} -f conftest.make 2>/dev/null` in + *@@@%%%=?*=@@@%%%*) + eval ac_cv_prog_make_${ac_make}_set=yes;; + *) + eval ac_cv_prog_make_${ac_make}_set=no;; +esac +rm -f conftest.make +fi +if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + SET_MAKE= +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + SET_MAKE="MAKE=${MAKE-make}" +fi + +rm -rf .tst 2>/dev/null +mkdir .tst 2>/dev/null +if test -d .tst; then + am__leading_dot=. +else + am__leading_dot=_ +fi +rmdir .tst 2>/dev/null + + + + + + + + + + +cat >>confdefs.h <<_ACEOF +#define IPOPT_VERSION "3.13.5" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define IPOPT_VERSION_MAJOR 3 +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define IPOPT_VERSION_MINOR 13 +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define IPOPT_VERSION_RELEASE 5 +_ACEOF + + + + + + + + + + + # libtool has some magic for host_os and build_os being mingw, but doesn't know about msys + if test $host_os = msys ; then + host_os=mingw + host=`echo $host | sed -e 's/msys/mingw/'` + fi + + if test $build_os = msys ; then + build_os=mingw + build=`echo $build | sed -e 's/msys/mingw/'` + fi + + # Check whether --enable-silent-rules was given. +if test "${enable_silent_rules+set}" = set; then : + enableval=$enable_silent_rules; +fi + +case $enable_silent_rules in # ((( + yes) AM_DEFAULT_VERBOSITY=0;; + no) AM_DEFAULT_VERBOSITY=1;; + *) AM_DEFAULT_VERBOSITY=0;; +esac +am_make=${MAKE-make} +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $am_make supports nested variables" >&5 +$as_echo_n "checking whether $am_make supports nested variables... " >&6; } +if ${am_cv_make_support_nested_variables+:} false; then : + $as_echo_n "(cached) " >&6 +else + if $as_echo 'TRUE=$(BAR$(V)) +BAR0=false +BAR1=true +V=1 +am__doit: + @$(TRUE) +.PHONY: am__doit' | $am_make -f - >/dev/null 2>&1; then + am_cv_make_support_nested_variables=yes +else + am_cv_make_support_nested_variables=no +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_make_support_nested_variables" >&5 +$as_echo "$am_cv_make_support_nested_variables" >&6; } +if test $am_cv_make_support_nested_variables = yes; then + AM_V='$(V)' + AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)' +else + AM_V=$AM_DEFAULT_VERBOSITY + AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY +fi +AM_BACKSLASH='\' + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to enable maintainer-specific portions of Makefiles" >&5 +$as_echo_n "checking whether to enable maintainer-specific portions of Makefiles... " >&6; } + # Check whether --enable-maintainer-mode was given. +if test "${enable_maintainer_mode+set}" = set; then : + enableval=$enable_maintainer_mode; USE_MAINTAINER_MODE=$enableval +else + USE_MAINTAINER_MODE=no +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $USE_MAINTAINER_MODE" >&5 +$as_echo "$USE_MAINTAINER_MODE" >&6; } + if test $USE_MAINTAINER_MODE = yes; then + MAINTAINER_MODE_TRUE= + MAINTAINER_MODE_FALSE='#' +else + MAINTAINER_MODE_TRUE='#' + MAINTAINER_MODE_FALSE= +fi + + MAINT=$MAINTAINER_MODE_TRUE + + + + if test "`cd $srcdir && pwd`" != "`pwd`"; then + # Use -I$(srcdir) only when $(srcdir) != ., so that make's output + # is not polluted with repeated "-I." + am__isrc=' -I$(srcdir)' + # test to see if srcdir already configured + if test -f $srcdir/config.status; then + as_fn_error $? "source directory already configured; run \"make distclean\" there first" "$LINENO" 5 + fi +fi + +# test whether we have cygpath +if test -z "$CYGPATH_W"; then + if (cygpath --version) >/dev/null 2>/dev/null; then + CYGPATH_W='cygpath -w' + else + CYGPATH_W=echo + fi +fi + + +# Define the identity of the package. + PACKAGE='ipopt' + VERSION='3.13.5' + + +# Some tools Automake needs. + +ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal-${am__api_version}"} + + +AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"} + + +AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake-${am__api_version}"} + + +AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"} + + +MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"} + +# For better backward compatibility. To be removed once Automake 1.9.x +# dies out for good. For more background, see: +# +# +mkdir_p='$(MKDIR_P)' + +# We need awk for the "check" target (and possibly the TAP driver). The +# system "awk" is bad on some platforms. +# Always define AMTAR for backward compatibility. Yes, it's still used +# in the wild :-( We should find a proper way to deprecate it ... +AMTAR='$${TAR-tar}' + + +# We'll loop over all known methods to create a tar archive until one works. +_am_tools='gnutar pax cpio none' + +am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -' + + + + + + +# POSIX will say in a future version that running "rm -f" with no argument +# is OK; and we want to be able to make that assumption in our Makefile +# recipes. So use an aggressive probe to check that the usage we want is +# actually supported "in the wild" to an acceptable degree. +# See automake bug#10828. +# To make any issue more visible, cause the running configure to be aborted +# by default if the 'rm' program in use doesn't match our expectations; the +# user can still override this though. +if rm -f && rm -fr && rm -rf; then : OK; else + cat >&2 <<'END' +Oops! + +Your 'rm' program seems unable to run without file operands specified +on the command line, even when the '-f' option is present. This is contrary +to the behaviour of most rm programs out there, and not conforming with +the upcoming POSIX standard: + +Please tell bug-automake@gnu.org about your system, including the value +of your $PATH and any error possibly output before this message. This +can help us improve future automake versions. + +END + if test x"$ACCEPT_INFERIOR_RM_PROGRAM" = x"yes"; then + echo 'Configuration will proceed anyway, since you have set the' >&2 + echo 'ACCEPT_INFERIOR_RM_PROGRAM variable to "yes"' >&2 + echo >&2 + else + cat >&2 <<'END' +Aborting the configuration process, to ensure you take notice of the issue. + +You can download and install GNU coreutils to get an 'rm' implementation +that behaves properly: . + +If you want to complete the configuration process using your problematic +'rm' anyway, export the environment variable ACCEPT_INFERIOR_RM_PROGRAM +to "yes", and re-run configure. + +END + as_fn_error $? "Your 'rm' program is bad, sorry." "$LINENO" 5 + fi +fi + + + # Figure out the path where libraries are installed. + # Unless the user specifies --prefix, prefix is set to NONE until the + # end of configuration, at which point it will be set to $ac_default_prefix. + # Unless the user specifies --exec-prefix, exec-prefix is set to NONE until + # the end of configuration, at which point it's set to '${prefix}'. + # Sheesh. So do the expansion, then back it out. + save_prefix=$prefix + save_exec_prefix=$exec_prefix + if test "x$prefix" = xNONE ; then + prefix=$ac_default_prefix + fi + if test "x$exec_prefix" = xNONE ; then + exec_prefix=$prefix + fi + expanded_libdir=$libdir + while expr "$expanded_libdir" : '.*$.*' >/dev/null 2>&1 ; do + eval expanded_libdir=$expanded_libdir + done + prefix=$save_prefix + exec_prefix=$save_exec_prefix + + # Check whether --enable-relocatable was given. +if test "${enable_relocatable+set}" = set; then : + enableval=$enable_relocatable; coin_enable_relocatable=$enableval +else + coin_enable_relocatable=no +fi + + if test $coin_enable_relocatable = yes; then + COIN_RELOCATABLE_TRUE= + COIN_RELOCATABLE_FALSE='#' +else + COIN_RELOCATABLE_TRUE='#' + COIN_RELOCATABLE_FALSE= +fi + + + +############################################################################# +# Standard build tool stuff # +############################################################################# + +# Get the name of the C, C++, and Fortran compilers and appropriate compiler options. +DEPDIR="${am__leading_dot}deps" + +ac_config_commands="$ac_config_commands depfiles" + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} supports the include directive" >&5 +$as_echo_n "checking whether ${MAKE-make} supports the include directive... " >&6; } +cat > confinc.mk << 'END' +am__doit: + @echo this is the am__doit target >confinc.out +.PHONY: am__doit +END +am__include="#" +am__quote= +# BSD make does it like this. +echo '.include "confinc.mk" # ignored' > confmf.BSD +# Other make implementations (GNU, Solaris 10, AIX) do it like this. +echo 'include confinc.mk # ignored' > confmf.GNU +_am_result=no +for s in GNU BSD; do + { echo "$as_me:$LINENO: ${MAKE-make} -f confmf.$s && cat confinc.out" >&5 + (${MAKE-make} -f confmf.$s && cat confinc.out) >&5 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } + case $?:`cat confinc.out 2>/dev/null` in #( + '0:this is the am__doit target') : + case $s in #( + BSD) : + am__include='.include' am__quote='"' ;; #( + *) : + am__include='include' am__quote='' ;; +esac ;; #( + *) : + ;; +esac + if test "$am__include" != "#"; then + _am_result="yes ($s style)" + break + fi +done +rm -f confinc.* confmf.* +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ${_am_result}" >&5 +$as_echo "${_am_result}" >&6; } + +# Check whether --enable-dependency-tracking was given. +if test "${enable_dependency_tracking+set}" = set; then : + enableval=$enable_dependency_tracking; +fi + +if test "x$enable_dependency_tracking" != xno; then + am_depcomp="$ac_aux_dir/depcomp" + AMDEPBACKSLASH='\' + am__nodep='_no' +fi + if test "x$enable_dependency_tracking" != xno; then + AMDEP_TRUE= + AMDEP_FALSE='#' +else + AMDEP_TRUE='#' + AMDEP_FALSE= +fi + + + + + + + + if test $enable_msvc = yes ; then + for ac_prog in icl cl +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break +done + + if test -n "$CC" ; then + CC="$am_aux_dir/compile $CC" + ac_cv_prog_CC="$CC" + LD="$CC" + : ${AR:=lib} + else + as_fn_error $? "Neither MS nor Intel C compiler found in PATH and CC is unset." "$LINENO" 5 + fi + fi + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + for ac_prog in gcc clang cc icc icl cl cc xlc xlc_r pgcc + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in gcc clang cc icc icl cl cc xlc xlc_r pgcc +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi +if test -z "$ac_file"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +$as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if ${ac_cv_objext+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC understands -c and -o together" >&5 +$as_echo_n "checking whether $CC understands -c and -o together... " >&6; } +if ${am_cv_prog_cc_c_o+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF + # Make sure it works both with $CC and with simple cc. + # Following AC_PROG_CC_C_O, we do the test twice because some + # compilers refuse to overwrite an existing .o file with -o, + # though they will create one. + am_cv_prog_cc_c_o=yes + for am_i in 1 2; do + if { echo "$as_me:$LINENO: $CC -c conftest.$ac_ext -o conftest2.$ac_objext" >&5 + ($CC -c conftest.$ac_ext -o conftest2.$ac_objext) >&5 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } \ + && test -f conftest2.$ac_objext; then + : OK + else + am_cv_prog_cc_c_o=no + break + fi + done + rm -f core conftest* + unset am_i +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_prog_cc_c_o" >&5 +$as_echo "$am_cv_prog_cc_c_o" >&6; } +if test "$am_cv_prog_cc_c_o" != yes; then + # Losing compiler, so override with the script. + # FIXME: It is wrong to rewrite CC. + # But if we don't then we get into trouble of one sort or another. + # A longer-term fix would be to have automake use am__CC in this case, + # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)" + CC="$am_aux_dir/compile $CC" +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +depcc="$CC" am_compiler_list= + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5 +$as_echo_n "checking dependency style of $depcc... " >&6; } +if ${am_cv_CC_dependencies_compiler_type+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then + # We make a subdir and do the tests there. Otherwise we can end up + # making bogus files that we don't know about and never remove. For + # instance it was reported that on HP-UX the gcc test will end up + # making a dummy file named 'D' -- because '-MD' means "put the output + # in D". + rm -rf conftest.dir + mkdir conftest.dir + # Copy depcomp to subdir because otherwise we won't find it if we're + # using a relative directory. + cp "$am_depcomp" conftest.dir + cd conftest.dir + # We will build objects and dependencies in a subdirectory because + # it helps to detect inapplicable dependency modes. For instance + # both Tru64's cc and ICC support -MD to output dependencies as a + # side effect of compilation, but ICC will put the dependencies in + # the current directory while Tru64 will put them in the object + # directory. + mkdir sub + + am_cv_CC_dependencies_compiler_type=none + if test "$am_compiler_list" = ""; then + am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp` + fi + am__universal=false + case " $depcc " in #( + *\ -arch\ *\ -arch\ *) am__universal=true ;; + esac + + for depmode in $am_compiler_list; do + # Setup a source with many dependencies, because some compilers + # like to wrap large dependency lists on column 80 (with \), and + # we should not choose a depcomp mode which is confused by this. + # + # We need to recreate these files for each test, as the compiler may + # overwrite some of them when testing with obscure command lines. + # This happens at least with the AIX C compiler. + : > sub/conftest.c + for i in 1 2 3 4 5 6; do + echo '#include "conftst'$i'.h"' >> sub/conftest.c + # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with + # Solaris 10 /bin/sh. + echo '/* dummy */' > sub/conftst$i.h + done + echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf + + # We check with '-c' and '-o' for the sake of the "dashmstdout" + # mode. It turns out that the SunPro C++ compiler does not properly + # handle '-M -o', and we need to detect this. Also, some Intel + # versions had trouble with output in subdirs. + am__obj=sub/conftest.${OBJEXT-o} + am__minus_obj="-o $am__obj" + case $depmode in + gcc) + # This depmode causes a compiler race in universal mode. + test "$am__universal" = false || continue + ;; + nosideeffect) + # After this tag, mechanisms are not by side-effect, so they'll + # only be used when explicitly requested. + if test "x$enable_dependency_tracking" = xyes; then + continue + else + break + fi + ;; + msvc7 | msvc7msys | msvisualcpp | msvcmsys) + # This compiler won't grok '-c -o', but also, the minuso test has + # not run yet. These depmodes are late enough in the game, and + # so weak that their functioning should not be impacted. + am__obj=conftest.${OBJEXT-o} + am__minus_obj= + ;; + none) break ;; + esac + if depmode=$depmode \ + source=sub/conftest.c object=$am__obj \ + depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ + $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ + >/dev/null 2>conftest.err && + grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && + grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && + grep $am__obj sub/conftest.Po > /dev/null 2>&1 && + ${MAKE-make} -s -f confmf > /dev/null 2>&1; then + # icc doesn't choke on unknown options, it will just issue warnings + # or remarks (even with -Werror). So we grep stderr for any message + # that says an option was ignored or not supported. + # When given -MP, icc 7.0 and 7.1 complain thusly: + # icc: Command line warning: ignoring option '-M'; no argument required + # The diagnosis changed in icc 8.0: + # icc: Command line remark: option '-MP' not supported + if (grep 'ignoring option' conftest.err || + grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else + am_cv_CC_dependencies_compiler_type=$depmode + break + fi + fi + done + + cd .. + rm -rf conftest.dir +else + am_cv_CC_dependencies_compiler_type=none +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CC_dependencies_compiler_type" >&5 +$as_echo "$am_cv_CC_dependencies_compiler_type" >&6; } +CCDEPMODE=depmode=$am_cv_CC_dependencies_compiler_type + + if + test "x$enable_dependency_tracking" != xno \ + && test "$am_cv_CC_dependencies_compiler_type" = gcc3; then + am__fastdepCC_TRUE= + am__fastdepCC_FALSE='#' +else + am__fastdepCC_TRUE='#' + am__fastdepCC_FALSE= +fi + + + + + + + + + + if test $enable_msvc = yes ; then + for ac_prog in icl cl +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CXX"; then + ac_cv_prog_CXX="$CXX" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CXX="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CXX=$ac_cv_prog_CXX +if test -n "$CXX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CXX" >&5 +$as_echo "$CXX" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CXX" && break +done + + if test -n "$CXX" ; then + CXX="$am_aux_dir/compile $CXX" + ac_cv_prog_CXX="$CXX" + LD="$CXX" + : ${AR:=lib} + else + as_fn_error $? "Neither MS nor Intel C++ compiler found in PATH and CXX is unset." "$LINENO" 5 + fi + fi + + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu +if test -z "$CXX"; then + if test -n "$CCC"; then + CXX=$CCC + else + if test -n "$ac_tool_prefix"; then + for ac_prog in g++ clang++ c++ pgCC icpc gpp cxx cc++ icl cl FCC KCC RCC xlC_r aCC CC + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CXX"; then + ac_cv_prog_CXX="$CXX" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CXX="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CXX=$ac_cv_prog_CXX +if test -n "$CXX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CXX" >&5 +$as_echo "$CXX" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CXX" && break + done +fi +if test -z "$CXX"; then + ac_ct_CXX=$CXX + for ac_prog in g++ clang++ c++ pgCC icpc gpp cxx cc++ icl cl FCC KCC RCC xlC_r aCC CC +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CXX"; then + ac_cv_prog_ac_ct_CXX="$ac_ct_CXX" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CXX="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CXX=$ac_cv_prog_ac_ct_CXX +if test -n "$ac_ct_CXX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CXX" >&5 +$as_echo "$ac_ct_CXX" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CXX" && break +done + + if test "x$ac_ct_CXX" = x; then + CXX="g++" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CXX=$ac_ct_CXX + fi +fi + + fi +fi +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C++ compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C++ compiler" >&5 +$as_echo_n "checking whether we are using the GNU C++ compiler... " >&6; } +if ${ac_cv_cxx_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_cxx_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cxx_compiler_gnu" >&5 +$as_echo "$ac_cv_cxx_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GXX=yes +else + GXX= +fi +ac_test_CXXFLAGS=${CXXFLAGS+set} +ac_save_CXXFLAGS=$CXXFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX accepts -g" >&5 +$as_echo_n "checking whether $CXX accepts -g... " >&6; } +if ${ac_cv_prog_cxx_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_cxx_werror_flag=$ac_cxx_werror_flag + ac_cxx_werror_flag=yes + ac_cv_prog_cxx_g=no + CXXFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ac_cv_prog_cxx_g=yes +else + CXXFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + +else + ac_cxx_werror_flag=$ac_save_cxx_werror_flag + CXXFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ac_cv_prog_cxx_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_cxx_werror_flag=$ac_save_cxx_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cxx_g" >&5 +$as_echo "$ac_cv_prog_cxx_g" >&6; } +if test "$ac_test_CXXFLAGS" = set; then + CXXFLAGS=$ac_save_CXXFLAGS +elif test $ac_cv_prog_cxx_g = yes; then + if test "$GXX" = yes; then + CXXFLAGS="-g -O2" + else + CXXFLAGS="-g" + fi +else + if test "$GXX" = yes; then + CXXFLAGS="-O2" + else + CXXFLAGS= + fi +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +depcc="$CXX" am_compiler_list= + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5 +$as_echo_n "checking dependency style of $depcc... " >&6; } +if ${am_cv_CXX_dependencies_compiler_type+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then + # We make a subdir and do the tests there. Otherwise we can end up + # making bogus files that we don't know about and never remove. For + # instance it was reported that on HP-UX the gcc test will end up + # making a dummy file named 'D' -- because '-MD' means "put the output + # in D". + rm -rf conftest.dir + mkdir conftest.dir + # Copy depcomp to subdir because otherwise we won't find it if we're + # using a relative directory. + cp "$am_depcomp" conftest.dir + cd conftest.dir + # We will build objects and dependencies in a subdirectory because + # it helps to detect inapplicable dependency modes. For instance + # both Tru64's cc and ICC support -MD to output dependencies as a + # side effect of compilation, but ICC will put the dependencies in + # the current directory while Tru64 will put them in the object + # directory. + mkdir sub + + am_cv_CXX_dependencies_compiler_type=none + if test "$am_compiler_list" = ""; then + am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp` + fi + am__universal=false + case " $depcc " in #( + *\ -arch\ *\ -arch\ *) am__universal=true ;; + esac + + for depmode in $am_compiler_list; do + # Setup a source with many dependencies, because some compilers + # like to wrap large dependency lists on column 80 (with \), and + # we should not choose a depcomp mode which is confused by this. + # + # We need to recreate these files for each test, as the compiler may + # overwrite some of them when testing with obscure command lines. + # This happens at least with the AIX C compiler. + : > sub/conftest.c + for i in 1 2 3 4 5 6; do + echo '#include "conftst'$i'.h"' >> sub/conftest.c + # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with + # Solaris 10 /bin/sh. + echo '/* dummy */' > sub/conftst$i.h + done + echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf + + # We check with '-c' and '-o' for the sake of the "dashmstdout" + # mode. It turns out that the SunPro C++ compiler does not properly + # handle '-M -o', and we need to detect this. Also, some Intel + # versions had trouble with output in subdirs. + am__obj=sub/conftest.${OBJEXT-o} + am__minus_obj="-o $am__obj" + case $depmode in + gcc) + # This depmode causes a compiler race in universal mode. + test "$am__universal" = false || continue + ;; + nosideeffect) + # After this tag, mechanisms are not by side-effect, so they'll + # only be used when explicitly requested. + if test "x$enable_dependency_tracking" = xyes; then + continue + else + break + fi + ;; + msvc7 | msvc7msys | msvisualcpp | msvcmsys) + # This compiler won't grok '-c -o', but also, the minuso test has + # not run yet. These depmodes are late enough in the game, and + # so weak that their functioning should not be impacted. + am__obj=conftest.${OBJEXT-o} + am__minus_obj= + ;; + none) break ;; + esac + if depmode=$depmode \ + source=sub/conftest.c object=$am__obj \ + depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ + $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ + >/dev/null 2>conftest.err && + grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && + grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && + grep $am__obj sub/conftest.Po > /dev/null 2>&1 && + ${MAKE-make} -s -f confmf > /dev/null 2>&1; then + # icc doesn't choke on unknown options, it will just issue warnings + # or remarks (even with -Werror). So we grep stderr for any message + # that says an option was ignored or not supported. + # When given -MP, icc 7.0 and 7.1 complain thusly: + # icc: Command line warning: ignoring option '-M'; no argument required + # The diagnosis changed in icc 8.0: + # icc: Command line remark: option '-MP' not supported + if (grep 'ignoring option' conftest.err || + grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else + am_cv_CXX_dependencies_compiler_type=$depmode + break + fi + fi + done + + cd .. + rm -rf conftest.dir +else + am_cv_CXX_dependencies_compiler_type=none +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CXX_dependencies_compiler_type" >&5 +$as_echo "$am_cv_CXX_dependencies_compiler_type" >&6; } +CXXDEPMODE=depmode=$am_cv_CXX_dependencies_compiler_type + + if + test "x$enable_dependency_tracking" != xno \ + && test "$am_cv_CXX_dependencies_compiler_type" = gcc3; then + am__fastdepCXX_TRUE= + am__fastdepCXX_FALSE='#' +else + am__fastdepCXX_TRUE='#' + am__fastdepCXX_FALSE= +fi + + + + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX understands -c and -o together" >&5 +$as_echo_n "checking whether $CXX understands -c and -o together... " >&6; } +if ${ac_cv_prog_cxx_c_o+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +# We test twice because some compilers refuse to overwrite an existing +# `.o' file with `-o', although they will create one. +ac_try='$CXX $CXXFLAGS -c conftest.$ac_ext -o conftest2.$ac_objext >&5' +rm -f conftest2.* +if { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && + test -f conftest2.$ac_objext && + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + ac_cv_prog_cxx_c_o=yes +else + ac_cv_prog_cxx_c_o=no +fi +rm -f conftest* +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cxx_c_o" >&5 +$as_echo "$ac_cv_prog_cxx_c_o" >&6; } +if test $ac_cv_prog_cxx_c_o = no; then + +$as_echo "#define CXX_NO_MINUS_C_MINUS_O 1" >>confdefs.h + +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + if test $ac_cv_prog_cxx_c_o = no ; then + CXX="$am_aux_dir/compile $CXX" + fi + + + + + + + # Check whether --enable-f77 was given. +if test "${enable_f77+set}" = set; then : + enableval=$enable_f77; enable_f77=$enableval +else + enable_f77=yes +fi + + + if test "$enable_f77" = no ; then + # make sure F77 is not set + unset F77 + else + # If enable-msvc, then test for Intel Fortran compiler for Windows + # explicitly and add the compile wrapper. The compile wrapper works + # around issues related to finding MS link.exe. (Unix link.exe occurs + # first in PATH, which causes compile and link checks to fail.) + # For the same reason, set LD to use the compile wrapper. + if test $enable_msvc = yes ; then + for ac_prog in ifort +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$F77"; then + ac_cv_prog_F77="$F77" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_F77="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +F77=$ac_cv_prog_F77 +if test -n "$F77"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $F77" >&5 +$as_echo "$F77" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$F77" && break +done + + if test -n "$F77" ; then + F77="$am_aux_dir/compile $F77" + ac_cv_prog_F77="$F77" + LD="$F77" + : ${AR:=lib} + fi + fi + + # If not msvc-enabled, then look for some Fortran compiler and check + # whether it works. If F77 is set, this simply checks whether it works. + if test $enable_msvc = no || test -n "$F77" ; then + ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu +if test -n "$ac_tool_prefix"; then + for ac_prog in gfortran ifort g95 fort77 f77 f95 f90 g77 pgf90 pgf77 ifc frt af77 xlf_r fl32 + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$F77"; then + ac_cv_prog_F77="$F77" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_F77="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +F77=$ac_cv_prog_F77 +if test -n "$F77"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $F77" >&5 +$as_echo "$F77" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$F77" && break + done +fi +if test -z "$F77"; then + ac_ct_F77=$F77 + for ac_prog in gfortran ifort g95 fort77 f77 f95 f90 g77 pgf90 pgf77 ifc frt af77 xlf_r fl32 +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_F77"; then + ac_cv_prog_ac_ct_F77="$ac_ct_F77" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_F77="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_F77=$ac_cv_prog_ac_ct_F77 +if test -n "$ac_ct_F77"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_F77" >&5 +$as_echo "$ac_ct_F77" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_F77" && break +done + + if test "x$ac_ct_F77" = x; then + F77="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + F77=$ac_ct_F77 + fi +fi + + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran 77 compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done +rm -f a.out + +# If we don't use `.F' as extension, the preprocessor is not run on the +# input file. (Note that this only needs to work for GNU compilers.) +ac_save_ext=$ac_ext +ac_ext=F +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU Fortran 77 compiler" >&5 +$as_echo_n "checking whether we are using the GNU Fortran 77 compiler... " >&6; } +if ${ac_cv_f77_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main +#ifndef __GNUC__ + choke me +#endif + + end +_ACEOF +if ac_fn_f77_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_f77_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_f77_compiler_gnu" >&5 +$as_echo "$ac_cv_f77_compiler_gnu" >&6; } +ac_ext=$ac_save_ext +ac_test_FFLAGS=${FFLAGS+set} +ac_save_FFLAGS=$FFLAGS +FFLAGS= +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $F77 accepts -g" >&5 +$as_echo_n "checking whether $F77 accepts -g... " >&6; } +if ${ac_cv_prog_f77_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + FFLAGS=-g +cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_f77_try_compile "$LINENO"; then : + ac_cv_prog_f77_g=yes +else + ac_cv_prog_f77_g=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_f77_g" >&5 +$as_echo "$ac_cv_prog_f77_g" >&6; } +if test "$ac_test_FFLAGS" = set; then + FFLAGS=$ac_save_FFLAGS +elif test $ac_cv_prog_f77_g = yes; then + if test "x$ac_cv_f77_compiler_gnu" = xyes; then + FFLAGS="-g -O2" + else + FFLAGS="-g" + fi +else + if test "x$ac_cv_f77_compiler_gnu" = xyes; then + FFLAGS="-O2" + else + FFLAGS= + fi +fi + +if test $ac_compiler_gnu = yes; then + G77=yes +else + G77= +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + fi + fi + + # Allow for the possibility that there is no Fortran compiler on the system. + if test -z "$F77" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: No Fortran 77 compiler available." >&5 +$as_echo "$as_me: No Fortran 77 compiler available." >&6;} + fi + if test -n "$F77"; then + COIN_HAS_F77_TRUE= + COIN_HAS_F77_FALSE='#' +else + COIN_HAS_F77_TRUE='#' + COIN_HAS_F77_FALSE= +fi + + + + + +# If there is a Fortran compiler, then setup everything to use it, including F77_FUNC +if test -n "$F77" ; then + +ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to get verbose linking output from $F77" >&5 +$as_echo_n "checking how to get verbose linking output from $F77... " >&6; } +if ${ac_cv_prog_f77_v+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_f77_try_compile "$LINENO"; then : + ac_cv_prog_f77_v= +# Try some options frequently used verbose output +for ac_verb in -v -verbose --verbose -V -\#\#\#; do + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF + +# Compile and link our simple test program by passing a flag (argument +# 1 to this macro) to the Fortran compiler in order to get +# "verbose" output that we can then parse for the Fortran linker +# flags. +ac_save_FFLAGS=$FFLAGS +FFLAGS="$FFLAGS $ac_verb" +eval "set x $ac_link" +shift +$as_echo "$as_me:${as_lineno-$LINENO}: $*" >&5 +# gfortran 4.3 outputs lines setting COLLECT_GCC_OPTIONS, COMPILER_PATH, +# LIBRARY_PATH; skip all such settings. +ac_f77_v_output=`eval $ac_link 5>&1 2>&1 | + sed '/^Driving:/d; /^Configured with:/d; + '"/^[_$as_cr_Letters][_$as_cr_alnum]*=/d"` +$as_echo "$ac_f77_v_output" >&5 +FFLAGS=$ac_save_FFLAGS + +rm -rf conftest* + +# On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where +# /foo, /bar, and /baz are search directories for the Fortran linker. +# Here, we change these into -L/foo -L/bar -L/baz (and put it first): +ac_f77_v_output="`echo $ac_f77_v_output | + grep 'LPATH is:' | + sed 's|.*LPATH is\(: *[^ ]*\).*|\1|;s|: */| -L/|g'` $ac_f77_v_output" + +# FIXME: we keep getting bitten by quoted arguments; a more general fix +# that detects unbalanced quotes in FLIBS should be implemented +# and (ugh) tested at some point. +case $ac_f77_v_output in + # With xlf replace commas with spaces, + # and remove "-link" and closing parenthesis. + *xlfentry*) + ac_f77_v_output=`echo $ac_f77_v_output | + sed ' + s/,/ /g + s/ -link / /g + s/) *$// + ' + ` ;; + + # With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted + # $LIBS confuse us, and the libraries appear later in the output anyway). + *mGLOB_options_string*) + ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"-mGLOB[^"]*"/ /g'` ;; + + # Portland Group compiler has singly- or doubly-quoted -cmdline argument + # Singly-quoted arguments were reported for versions 5.2-4 and 6.0-4. + # Doubly-quoted arguments were reported for "PGF90/x86 Linux/x86 5.0-2". + *-cmdline\ * | *-ignore\ * | *-def\ *) + ac_f77_v_output=`echo $ac_f77_v_output | sed "\ + s/-cmdline *'[^']*'/ /g; s/-cmdline *\"[^\"]*\"/ /g + s/-ignore *'[^']*'/ /g; s/-ignore *\"[^\"]*\"/ /g + s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;; + + # If we are using fort77 (the f2c wrapper) then filter output and delete quotes. + *fort77*f2c*gcc*) + ac_f77_v_output=`echo "$ac_f77_v_output" | sed -n ' + /:[ ]\+Running[ ]\{1,\}"gcc"/{ + /"-c"/d + /[.]c"*/d + s/^.*"gcc"/"gcc"/ + s/"//gp + }'` ;; + + # If we are using Cray Fortran then delete quotes. + *cft90*) + ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"//g'` ;; +esac + + + # look for -l* and *.a constructs in the output + for ac_arg in $ac_f77_v_output; do + case $ac_arg in + [\\/]*.a | ?:[\\/]*.a | -[lLRu]*) + ac_cv_prog_f77_v=$ac_verb + break 2 ;; + esac + done +done +if test -z "$ac_cv_prog_f77_v"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot determine how to obtain linking information from $F77" >&5 +$as_echo "$as_me: WARNING: cannot determine how to obtain linking information from $F77" >&2;} +fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: compilation failed" >&5 +$as_echo "$as_me: WARNING: compilation failed" >&2;} +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_f77_v" >&5 +$as_echo "$ac_cv_prog_f77_v" >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran 77 libraries of $F77" >&5 +$as_echo_n "checking for Fortran 77 libraries of $F77... " >&6; } +if ${ac_cv_f77_libs+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "x$FLIBS" != "x"; then + ac_cv_f77_libs="$FLIBS" # Let the user override the test. +else + +cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF + +# Compile and link our simple test program by passing a flag (argument +# 1 to this macro) to the Fortran compiler in order to get +# "verbose" output that we can then parse for the Fortran linker +# flags. +ac_save_FFLAGS=$FFLAGS +FFLAGS="$FFLAGS $ac_cv_prog_f77_v" +eval "set x $ac_link" +shift +$as_echo "$as_me:${as_lineno-$LINENO}: $*" >&5 +# gfortran 4.3 outputs lines setting COLLECT_GCC_OPTIONS, COMPILER_PATH, +# LIBRARY_PATH; skip all such settings. +ac_f77_v_output=`eval $ac_link 5>&1 2>&1 | + sed '/^Driving:/d; /^Configured with:/d; + '"/^[_$as_cr_Letters][_$as_cr_alnum]*=/d"` +$as_echo "$ac_f77_v_output" >&5 +FFLAGS=$ac_save_FFLAGS + +rm -rf conftest* + +# On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where +# /foo, /bar, and /baz are search directories for the Fortran linker. +# Here, we change these into -L/foo -L/bar -L/baz (and put it first): +ac_f77_v_output="`echo $ac_f77_v_output | + grep 'LPATH is:' | + sed 's|.*LPATH is\(: *[^ ]*\).*|\1|;s|: */| -L/|g'` $ac_f77_v_output" + +# FIXME: we keep getting bitten by quoted arguments; a more general fix +# that detects unbalanced quotes in FLIBS should be implemented +# and (ugh) tested at some point. +case $ac_f77_v_output in + # With xlf replace commas with spaces, + # and remove "-link" and closing parenthesis. + *xlfentry*) + ac_f77_v_output=`echo $ac_f77_v_output | + sed ' + s/,/ /g + s/ -link / /g + s/) *$// + ' + ` ;; + + # With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted + # $LIBS confuse us, and the libraries appear later in the output anyway). + *mGLOB_options_string*) + ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"-mGLOB[^"]*"/ /g'` ;; + + # Portland Group compiler has singly- or doubly-quoted -cmdline argument + # Singly-quoted arguments were reported for versions 5.2-4 and 6.0-4. + # Doubly-quoted arguments were reported for "PGF90/x86 Linux/x86 5.0-2". + *-cmdline\ * | *-ignore\ * | *-def\ *) + ac_f77_v_output=`echo $ac_f77_v_output | sed "\ + s/-cmdline *'[^']*'/ /g; s/-cmdline *\"[^\"]*\"/ /g + s/-ignore *'[^']*'/ /g; s/-ignore *\"[^\"]*\"/ /g + s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;; + + # If we are using fort77 (the f2c wrapper) then filter output and delete quotes. + *fort77*f2c*gcc*) + ac_f77_v_output=`echo "$ac_f77_v_output" | sed -n ' + /:[ ]\+Running[ ]\{1,\}"gcc"/{ + /"-c"/d + /[.]c"*/d + s/^.*"gcc"/"gcc"/ + s/"//gp + }'` ;; + + # If we are using Cray Fortran then delete quotes. + *cft90*) + ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"//g'` ;; +esac + + + +ac_cv_f77_libs= + +# Save positional arguments (if any) +ac_save_positional="$@" + +set X $ac_f77_v_output +while test $# != 1; do + shift + ac_arg=$1 + case $ac_arg in + [\\/]*.a | ?:[\\/]*.a) + ac_exists=false + for ac_i in $ac_cv_f77_libs; do + if test x"$ac_arg" = x"$ac_i"; then + ac_exists=true + break + fi + done + + if test x"$ac_exists" = xtrue; then : + +else + ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" +fi + ;; + -bI:*) + ac_exists=false + for ac_i in $ac_cv_f77_libs; do + if test x"$ac_arg" = x"$ac_i"; then + ac_exists=true + break + fi + done + + if test x"$ac_exists" = xtrue; then : + +else + if test "$ac_compiler_gnu" = yes; then + for ac_link_opt in $ac_arg; do + ac_cv_f77_libs="$ac_cv_f77_libs -Xlinker $ac_link_opt" + done +else + ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" +fi +fi + ;; + # Ignore these flags. + -lang* | -lcrt*.o | -lc | -lgcc* | -lSystem | -libmil | -little \ + |-LANG:=* | -LIST:* | -LNO:* | -link) + ;; + -lkernel32) + case $host_os in + *cygwin*) ;; + *) ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" + ;; + esac + ;; + -[LRuYz]) + # These flags, when seen by themselves, take an argument. + # We remove the space between option and argument and re-iterate + # unless we find an empty arg or a new option (starting with -) + case $2 in + "" | -*);; + *) + ac_arg="$ac_arg$2" + shift; shift + set X $ac_arg "$@" + ;; + esac + ;; + -YP,*) + for ac_j in `$as_echo "$ac_arg" | sed -e 's/-YP,/-L/;s/:/ -L/g'`; do + ac_exists=false + for ac_i in $ac_cv_f77_libs; do + if test x"$ac_j" = x"$ac_i"; then + ac_exists=true + break + fi + done + + if test x"$ac_exists" = xtrue; then : + +else + ac_arg="$ac_arg $ac_j" + ac_cv_f77_libs="$ac_cv_f77_libs $ac_j" +fi + done + ;; + -[lLR]*) + ac_exists=false + for ac_i in $ac_cv_f77_libs; do + if test x"$ac_arg" = x"$ac_i"; then + ac_exists=true + break + fi + done + + if test x"$ac_exists" = xtrue; then : + +else + ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" +fi + ;; + -zallextract*| -zdefaultextract) + ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" + ;; + # Ignore everything else. + esac +done +# restore positional arguments +set X $ac_save_positional; shift + +# We only consider "LD_RUN_PATH" on Solaris systems. If this is seen, +# then we insist that the "run path" must be an absolute path (i.e. it +# must begin with a "/"). +case `(uname -sr) 2>/dev/null` in + "SunOS 5"*) + ac_ld_run_path=`$as_echo "$ac_f77_v_output" | + sed -n 's,^.*LD_RUN_PATH *= *\(/[^ ]*\).*$,-R\1,p'` + test "x$ac_ld_run_path" != x && + if test "$ac_compiler_gnu" = yes; then + for ac_link_opt in $ac_ld_run_path; do + ac_cv_f77_libs="$ac_cv_f77_libs -Xlinker $ac_link_opt" + done +else + ac_cv_f77_libs="$ac_cv_f77_libs $ac_ld_run_path" +fi + ;; +esac +fi # test "x$[]_AC_LANG_PREFIX[]LIBS" = "x" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_f77_libs" >&5 +$as_echo "$ac_cv_f77_libs" >&6; } +FLIBS="$ac_cv_f77_libs" + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dummy main to link with Fortran 77 libraries" >&5 +$as_echo_n "checking for dummy main to link with Fortran 77 libraries... " >&6; } +if ${ac_cv_f77_dummy_main+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_f77_dm_save_LIBS=$LIBS + LIBS="$LIBS $FLIBS" + ac_fortran_dm_var=F77_DUMMY_MAIN + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + # First, try linking without a dummy main: + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_fortran_dummy_main=none +else + ac_cv_fortran_dummy_main=unknown +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + + if test $ac_cv_fortran_dummy_main = unknown; then + for ac_func in MAIN__ MAIN_ __main MAIN _MAIN __MAIN main_ main__ _main; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define $ac_fortran_dm_var $ac_func +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_fortran_dummy_main=$ac_func; break +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + done + fi + ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu + ac_cv_f77_dummy_main=$ac_cv_fortran_dummy_main + rm -rf conftest* + LIBS=$ac_f77_dm_save_LIBS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_f77_dummy_main" >&5 +$as_echo "$ac_cv_f77_dummy_main" >&6; } +F77_DUMMY_MAIN=$ac_cv_f77_dummy_main +if test "$F77_DUMMY_MAIN" != unknown; then : + if test $F77_DUMMY_MAIN != none; then + +cat >>confdefs.h <<_ACEOF +#define F77_DUMMY_MAIN $F77_DUMMY_MAIN +_ACEOF + + if test "x$ac_cv_fc_dummy_main" = "x$ac_cv_f77_dummy_main"; then + +$as_echo "#define FC_DUMMY_MAIN_EQ_F77 1" >>confdefs.h + + fi +fi +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "linking to Fortran libraries from C fails +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran 77 name-mangling scheme" >&5 +$as_echo_n "checking for Fortran 77 name-mangling scheme... " >&6; } +if ${ac_cv_f77_mangling+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + subroutine foobar() + return + end + subroutine foo_bar() + return + end +_ACEOF +if ac_fn_f77_try_compile "$LINENO"; then : + mv conftest.$ac_objext cfortran_test.$ac_objext + + ac_save_LIBS=$LIBS + LIBS="cfortran_test.$ac_objext $LIBS $FLIBS" + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + ac_success=no + for ac_foobar in foobar FOOBAR; do + for ac_underscore in "" "_"; do + ac_func="$ac_foobar$ac_underscore" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_func (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_func (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_success=yes; break 2 +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + done + done + ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu + + if test "$ac_success" = "yes"; then + case $ac_foobar in + foobar) + ac_case=lower + ac_foo_bar=foo_bar + ;; + FOOBAR) + ac_case=upper + ac_foo_bar=FOO_BAR + ;; + esac + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + ac_success_extra=no + for ac_extra in "" "_"; do + ac_func="$ac_foo_bar$ac_underscore$ac_extra" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_func (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_func (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_success_extra=yes; break +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + done + ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu + + if test "$ac_success_extra" = "yes"; then + ac_cv_f77_mangling="$ac_case case" + if test -z "$ac_underscore"; then + ac_cv_f77_mangling="$ac_cv_f77_mangling, no underscore" + else + ac_cv_f77_mangling="$ac_cv_f77_mangling, underscore" + fi + if test -z "$ac_extra"; then + ac_cv_f77_mangling="$ac_cv_f77_mangling, no extra underscore" + else + ac_cv_f77_mangling="$ac_cv_f77_mangling, extra underscore" + fi + else + ac_cv_f77_mangling="unknown" + fi + else + ac_cv_f77_mangling="unknown" + fi + + LIBS=$ac_save_LIBS + rm -rf conftest* + rm -f cfortran_test* +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compile a simple Fortran program +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_f77_mangling" >&5 +$as_echo "$ac_cv_f77_mangling" >&6; } + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu +case $ac_cv_f77_mangling in + "lower case, no underscore, no extra underscore") + $as_echo "#define F77_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) name" >>confdefs.h + ;; + "lower case, no underscore, extra underscore") + $as_echo "#define F77_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, no extra underscore") + $as_echo "#define F77_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, extra underscore") + $as_echo "#define F77_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) name ## __" >>confdefs.h + ;; + "upper case, no underscore, no extra underscore") + $as_echo "#define F77_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) NAME" >>confdefs.h + ;; + "upper case, no underscore, extra underscore") + $as_echo "#define F77_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, no extra underscore") + $as_echo "#define F77_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, extra underscore") + $as_echo "#define F77_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define F77_FUNC_(name,NAME) NAME ## __" >>confdefs.h + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unknown Fortran name-mangling scheme" >&5 +$as_echo "$as_me: WARNING: unknown Fortran name-mangling scheme" >&2;} + ;; +esac + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + # check whether compile script should be used to wrap around Fortran 77 compiler + ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $F77 understands -c and -o together" >&5 +$as_echo_n "checking whether $F77 understands -c and -o together... " >&6; } +if ${ac_cv_prog_f77_c_o+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +# We test twice because some compilers refuse to overwrite an existing +# `.o' file with `-o', although they will create one. +ac_try='$F77 $FFLAGS -c conftest.$ac_ext -o conftest2.$ac_objext >&5' +rm -f conftest2.* +if { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && + test -f conftest2.$ac_objext && + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + ac_cv_prog_f77_c_o=yes +else + ac_cv_prog_f77_c_o=no +fi +rm -f conftest* +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_f77_c_o" >&5 +$as_echo "$ac_cv_prog_f77_c_o" >&6; } +if test $ac_cv_prog_f77_c_o = no; then + +$as_echo "#define F77_NO_MINUS_C_MINUS_O 1" >>confdefs.h + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + if test $ac_cv_prog_f77_c_o = no ; then + F77="$am_aux_dir/compile $F77" + else + case "$F77" in *ifort ) + case $build in + *-mingw* | *-cygwin* | *-msys* ) F77="$am_aux_dir/compile $F77" ;; esac + ;; + esac + fi + +fi + +# This is a C++ package, set the language accordingly. +#AC_LANG_PUSH(C++) + +# Initialize libtool +case `pwd` in + *\ * | *\ *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5 +$as_echo "$as_me: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&2;} ;; +esac + + + +macro_version='2.4.6' +macro_revision='2.4.6' + + + + + + + + + + + + + +ltmain=$ac_aux_dir/ltmain.sh + +# Backslashify metacharacters that are still active within +# double-quoted strings. +sed_quote_subst='s/\(["`$\\]\)/\\\1/g' + +# Same as above, but do not quote variable references. +double_quote_subst='s/\(["`\\]\)/\\\1/g' + +# Sed substitution to delay expansion of an escaped shell variable in a +# double_quote_subst'ed string. +delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g' + +# Sed substitution to delay expansion of an escaped single quote. +delay_single_quote_subst='s/'\''/'\'\\\\\\\'\''/g' + +# Sed substitution to avoid accidental globbing in evaled expressions +no_glob_subst='s/\*/\\\*/g' + +ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO +ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to print strings" >&5 +$as_echo_n "checking how to print strings... " >&6; } +# Test print first, because it will be a builtin if present. +if test "X`( print -r -- -n ) 2>/dev/null`" = X-n && \ + test "X`print -r -- $ECHO 2>/dev/null`" = "X$ECHO"; then + ECHO='print -r --' +elif test "X`printf %s $ECHO 2>/dev/null`" = "X$ECHO"; then + ECHO='printf %s\n' +else + # Use this function as a fallback that always works. + func_fallback_echo () + { + eval 'cat <<_LTECHO_EOF +$1 +_LTECHO_EOF' + } + ECHO='func_fallback_echo' +fi + +# func_echo_all arg... +# Invoke $ECHO with all args, space-separated. +func_echo_all () +{ + $ECHO "" +} + +case $ECHO in + printf*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: printf" >&5 +$as_echo "printf" >&6; } ;; + print*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: print -r" >&5 +$as_echo "print -r" >&6; } ;; + *) { $as_echo "$as_me:${as_lineno-$LINENO}: result: cat" >&5 +$as_echo "cat" >&6; } ;; +esac + + + + + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a sed that does not truncate output" >&5 +$as_echo_n "checking for a sed that does not truncate output... " >&6; } +if ${ac_cv_path_SED+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_script=s/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb/ + for ac_i in 1 2 3 4 5 6 7; do + ac_script="$ac_script$as_nl$ac_script" + done + echo "$ac_script" 2>/dev/null | sed 99q >conftest.sed + { ac_script=; unset ac_script;} + if test -z "$SED"; then + ac_path_SED_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in sed gsed; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_SED="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_SED" || continue +# Check for GNU ac_path_SED and select it if it is found. + # Check for GNU $ac_path_SED +case `"$ac_path_SED" --version 2>&1` in +*GNU*) + ac_cv_path_SED="$ac_path_SED" ac_path_SED_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo '' >> "conftest.nl" + "$ac_path_SED" -f conftest.sed < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_SED_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_SED="$ac_path_SED" + ac_path_SED_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_SED_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_SED"; then + as_fn_error $? "no acceptable sed could be found in \$PATH" "$LINENO" 5 + fi +else + ac_cv_path_SED=$SED +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_SED" >&5 +$as_echo "$ac_cv_path_SED" >&6; } + SED="$ac_cv_path_SED" + rm -f conftest.sed + +test -z "$SED" && SED=sed +Xsed="$SED -e 1s/^X//" + + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_GREP" || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if ${ac_cv_path_EGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP" || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fgrep" >&5 +$as_echo_n "checking for fgrep... " >&6; } +if ${ac_cv_path_FGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo 'ab*c' | $GREP -F 'ab*c' >/dev/null 2>&1 + then ac_cv_path_FGREP="$GREP -F" + else + if test -z "$FGREP"; then + ac_path_FGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in fgrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_FGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_FGREP" || continue +# Check for GNU ac_path_FGREP and select it if it is found. + # Check for GNU $ac_path_FGREP +case `"$ac_path_FGREP" --version 2>&1` in +*GNU*) + ac_cv_path_FGREP="$ac_path_FGREP" ac_path_FGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'FGREP' >> "conftest.nl" + "$ac_path_FGREP" FGREP < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_FGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_FGREP="$ac_path_FGREP" + ac_path_FGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_FGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_FGREP"; then + as_fn_error $? "no acceptable fgrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_FGREP=$FGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_FGREP" >&5 +$as_echo "$ac_cv_path_FGREP" >&6; } + FGREP="$ac_cv_path_FGREP" + + +test -z "$GREP" && GREP=grep + + + + + + + + + + + + + + + + + + + +# Check whether --with-gnu-ld was given. +if test "${with_gnu_ld+set}" = set; then : + withval=$with_gnu_ld; test no = "$withval" || with_gnu_ld=yes +else + with_gnu_ld=no +fi + +ac_prog=ld +if test yes = "$GCC"; then + # Check if gcc -print-prog-name=ld gives a path. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5 +$as_echo_n "checking for ld used by $CC... " >&6; } + case $host in + *-*-mingw*) + # gcc leaves a trailing carriage return, which upsets mingw + ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; + *) + ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; + esac + case $ac_prog in + # Accept absolute paths. + [\\/]* | ?:[\\/]*) + re_direlt='/[^/][^/]*/\.\./' + # Canonicalize the pathname of ld + ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'` + while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do + ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"` + done + test -z "$LD" && LD=$ac_prog + ;; + "") + # If it fails, then pretend we aren't using GCC. + ac_prog=ld + ;; + *) + # If it is relative, then search for the first ld in PATH. + with_gnu_ld=unknown + ;; + esac +elif test yes = "$with_gnu_ld"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5 +$as_echo_n "checking for GNU ld... " >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5 +$as_echo_n "checking for non-GNU ld... " >&6; } +fi +if ${lt_cv_path_LD+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$LD"; then + lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR + for ac_dir in $PATH; do + IFS=$lt_save_ifs + test -z "$ac_dir" && ac_dir=. + if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then + lt_cv_path_LD=$ac_dir/$ac_prog + # Check to see if the program is GNU ld. I'd rather use --version, + # but apparently some variants of GNU ld only accept -v. + # Break only if it was the GNU/non-GNU ld that we prefer. + case `"$lt_cv_path_LD" -v 2>&1 &5 +$as_echo "$LD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi +test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5 +$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; } +if ${lt_cv_prog_gnu_ld+:} false; then : + $as_echo_n "(cached) " >&6 +else + # I'd rather use --version here, but apparently some GNU lds only accept -v. +case `$LD -v 2>&1 &5 +$as_echo "$lt_cv_prog_gnu_ld" >&6; } +with_gnu_ld=$lt_cv_prog_gnu_ld + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for BSD- or MS-compatible name lister (nm)" >&5 +$as_echo_n "checking for BSD- or MS-compatible name lister (nm)... " >&6; } +if ${lt_cv_path_NM+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$NM"; then + # Let the user override the test. + lt_cv_path_NM=$NM +else + lt_nm_to_check=${ac_tool_prefix}nm + if test -n "$ac_tool_prefix" && test "$build" = "$host"; then + lt_nm_to_check="$lt_nm_to_check nm" + fi + for lt_tmp_nm in $lt_nm_to_check; do + lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR + for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do + IFS=$lt_save_ifs + test -z "$ac_dir" && ac_dir=. + tmp_nm=$ac_dir/$lt_tmp_nm + if test -f "$tmp_nm" || test -f "$tmp_nm$ac_exeext"; then + # Check to see if the nm accepts a BSD-compat flag. + # Adding the 'sed 1q' prevents false positives on HP-UX, which says: + # nm: unknown option "B" ignored + # Tru64's nm complains that /dev/null is an invalid object file + # MSYS converts /dev/null to NUL, MinGW nm treats NUL as empty + case $build_os in + mingw*) lt_bad_file=conftest.nm/nofile ;; + *) lt_bad_file=/dev/null ;; + esac + case `"$tmp_nm" -B $lt_bad_file 2>&1 | sed '1q'` in + *$lt_bad_file* | *'Invalid file or object type'*) + lt_cv_path_NM="$tmp_nm -B" + break 2 + ;; + *) + case `"$tmp_nm" -p /dev/null 2>&1 | sed '1q'` in + */dev/null*) + lt_cv_path_NM="$tmp_nm -p" + break 2 + ;; + *) + lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but + continue # so that we can try to find one that supports BSD flags + ;; + esac + ;; + esac + fi + done + IFS=$lt_save_ifs + done + : ${lt_cv_path_NM=no} +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_NM" >&5 +$as_echo "$lt_cv_path_NM" >&6; } +if test no != "$lt_cv_path_NM"; then + NM=$lt_cv_path_NM +else + # Didn't find any BSD compatible name lister, look for dumpbin. + if test -n "$DUMPBIN"; then : + # Let the user override the test. + else + if test -n "$ac_tool_prefix"; then + for ac_prog in dumpbin "link -dump" + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_DUMPBIN+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$DUMPBIN"; then + ac_cv_prog_DUMPBIN="$DUMPBIN" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_DUMPBIN="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +DUMPBIN=$ac_cv_prog_DUMPBIN +if test -n "$DUMPBIN"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DUMPBIN" >&5 +$as_echo "$DUMPBIN" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$DUMPBIN" && break + done +fi +if test -z "$DUMPBIN"; then + ac_ct_DUMPBIN=$DUMPBIN + for ac_prog in dumpbin "link -dump" +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_DUMPBIN+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_DUMPBIN"; then + ac_cv_prog_ac_ct_DUMPBIN="$ac_ct_DUMPBIN" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_DUMPBIN="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_DUMPBIN=$ac_cv_prog_ac_ct_DUMPBIN +if test -n "$ac_ct_DUMPBIN"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DUMPBIN" >&5 +$as_echo "$ac_ct_DUMPBIN" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_DUMPBIN" && break +done + + if test "x$ac_ct_DUMPBIN" = x; then + DUMPBIN=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + DUMPBIN=$ac_ct_DUMPBIN + fi +fi + + case `$DUMPBIN -symbols -headers /dev/null 2>&1 | sed '1q'` in + *COFF*) + DUMPBIN="$DUMPBIN -symbols -headers" + ;; + *) + DUMPBIN=: + ;; + esac + fi + + if test : != "$DUMPBIN"; then + NM=$DUMPBIN + fi +fi +test -z "$NM" && NM=nm + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the name lister ($NM) interface" >&5 +$as_echo_n "checking the name lister ($NM) interface... " >&6; } +if ${lt_cv_nm_interface+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_nm_interface="BSD nm" + echo "int some_variable = 0;" > conftest.$ac_ext + (eval echo "\"\$as_me:$LINENO: $ac_compile\"" >&5) + (eval "$ac_compile" 2>conftest.err) + cat conftest.err >&5 + (eval echo "\"\$as_me:$LINENO: $NM \\\"conftest.$ac_objext\\\"\"" >&5) + (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out) + cat conftest.err >&5 + (eval echo "\"\$as_me:$LINENO: output\"" >&5) + cat conftest.out >&5 + if $GREP 'External.*some_variable' conftest.out > /dev/null; then + lt_cv_nm_interface="MS dumpbin" + fi + rm -f conftest* +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_nm_interface" >&5 +$as_echo "$lt_cv_nm_interface" >&6; } + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5 +$as_echo_n "checking whether ln -s works... " >&6; } +LN_S=$as_ln_s +if test "$LN_S" = "ln -s"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5 +$as_echo "no, using $LN_S" >&6; } +fi + +# find the maximum length of command line arguments +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the maximum length of command line arguments" >&5 +$as_echo_n "checking the maximum length of command line arguments... " >&6; } +if ${lt_cv_sys_max_cmd_len+:} false; then : + $as_echo_n "(cached) " >&6 +else + i=0 + teststring=ABCD + + case $build_os in + msdosdjgpp*) + # On DJGPP, this test can blow up pretty badly due to problems in libc + # (any single argument exceeding 2000 bytes causes a buffer overrun + # during glob expansion). Even if it were fixed, the result of this + # check would be larger than it should be. + lt_cv_sys_max_cmd_len=12288; # 12K is about right + ;; + + gnu*) + # Under GNU Hurd, this test is not required because there is + # no limit to the length of command line arguments. + # Libtool will interpret -1 as no limit whatsoever + lt_cv_sys_max_cmd_len=-1; + ;; + + cygwin* | mingw* | cegcc*) + # On Win9x/ME, this test blows up -- it succeeds, but takes + # about 5 minutes as the teststring grows exponentially. + # Worse, since 9x/ME are not pre-emptively multitasking, + # you end up with a "frozen" computer, even though with patience + # the test eventually succeeds (with a max line length of 256k). + # Instead, let's just punt: use the minimum linelength reported by + # all of the supported platforms: 8192 (on NT/2K/XP). + lt_cv_sys_max_cmd_len=8192; + ;; + + mint*) + # On MiNT this can take a long time and run out of memory. + lt_cv_sys_max_cmd_len=8192; + ;; + + amigaos*) + # On AmigaOS with pdksh, this test takes hours, literally. + # So we just punt and use a minimum line length of 8192. + lt_cv_sys_max_cmd_len=8192; + ;; + + bitrig* | darwin* | dragonfly* | freebsd* | netbsd* | openbsd*) + # This has been around since 386BSD, at least. Likely further. + if test -x /sbin/sysctl; then + lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax` + elif test -x /usr/sbin/sysctl; then + lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax` + else + lt_cv_sys_max_cmd_len=65536 # usable default for all BSDs + fi + # And add a safety zone + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` + ;; + + interix*) + # We know the value 262144 and hardcode it with a safety zone (like BSD) + lt_cv_sys_max_cmd_len=196608 + ;; + + os2*) + # The test takes a long time on OS/2. + lt_cv_sys_max_cmd_len=8192 + ;; + + osf*) + # Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure + # due to this test when exec_disable_arg_limit is 1 on Tru64. It is not + # nice to cause kernel panics so lets avoid the loop below. + # First set a reasonable default. + lt_cv_sys_max_cmd_len=16384 + # + if test -x /sbin/sysconfig; then + case `/sbin/sysconfig -q proc exec_disable_arg_limit` in + *1*) lt_cv_sys_max_cmd_len=-1 ;; + esac + fi + ;; + sco3.2v5*) + lt_cv_sys_max_cmd_len=102400 + ;; + sysv5* | sco5v6* | sysv4.2uw2*) + kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null` + if test -n "$kargmax"; then + lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[ ]//'` + else + lt_cv_sys_max_cmd_len=32768 + fi + ;; + *) + lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null` + if test -n "$lt_cv_sys_max_cmd_len" && \ + test undefined != "$lt_cv_sys_max_cmd_len"; then + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` + else + # Make teststring a little bigger before we do anything with it. + # a 1K string should be a reasonable start. + for i in 1 2 3 4 5 6 7 8; do + teststring=$teststring$teststring + done + SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}} + # If test is not a shell built-in, we'll probably end up computing a + # maximum length that is only half of the actual maximum length, but + # we can't tell. + while { test X`env echo "$teststring$teststring" 2>/dev/null` \ + = "X$teststring$teststring"; } >/dev/null 2>&1 && + test 17 != "$i" # 1/2 MB should be enough + do + i=`expr $i + 1` + teststring=$teststring$teststring + done + # Only check the string length outside the loop. + lt_cv_sys_max_cmd_len=`expr "X$teststring" : ".*" 2>&1` + teststring= + # Add a significant safety factor because C++ compilers can tack on + # massive amounts of additional arguments before passing them to the + # linker. It appears as though 1/2 is a usable value. + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2` + fi + ;; + esac + +fi + +if test -n "$lt_cv_sys_max_cmd_len"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sys_max_cmd_len" >&5 +$as_echo "$lt_cv_sys_max_cmd_len" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5 +$as_echo "none" >&6; } +fi +max_cmd_len=$lt_cv_sys_max_cmd_len + + + + + + +: ${CP="cp -f"} +: ${MV="mv -f"} +: ${RM="rm -f"} + +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + lt_unset=unset +else + lt_unset=false +fi + + + + + +# test EBCDIC or ASCII +case `echo X|tr X '\101'` in + A) # ASCII based system + # \n is not interpreted correctly by Solaris 8 /usr/ucb/tr + lt_SP2NL='tr \040 \012' + lt_NL2SP='tr \015\012 \040\040' + ;; + *) # EBCDIC based system + lt_SP2NL='tr \100 \n' + lt_NL2SP='tr \r\n \100\100' + ;; +esac + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to convert $build file names to $host format" >&5 +$as_echo_n "checking how to convert $build file names to $host format... " >&6; } +if ${lt_cv_to_host_file_cmd+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $host in + *-*-mingw* ) + case $build in + *-*-mingw* ) # actually msys + lt_cv_to_host_file_cmd=func_convert_file_msys_to_w32 + ;; + *-*-cygwin* ) + lt_cv_to_host_file_cmd=func_convert_file_cygwin_to_w32 + ;; + * ) # otherwise, assume *nix + lt_cv_to_host_file_cmd=func_convert_file_nix_to_w32 + ;; + esac + ;; + *-*-cygwin* ) + case $build in + *-*-mingw* ) # actually msys + lt_cv_to_host_file_cmd=func_convert_file_msys_to_cygwin + ;; + *-*-cygwin* ) + lt_cv_to_host_file_cmd=func_convert_file_noop + ;; + * ) # otherwise, assume *nix + lt_cv_to_host_file_cmd=func_convert_file_nix_to_cygwin + ;; + esac + ;; + * ) # unhandled hosts (and "normal" native builds) + lt_cv_to_host_file_cmd=func_convert_file_noop + ;; +esac + +fi + +to_host_file_cmd=$lt_cv_to_host_file_cmd +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_to_host_file_cmd" >&5 +$as_echo "$lt_cv_to_host_file_cmd" >&6; } + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to convert $build file names to toolchain format" >&5 +$as_echo_n "checking how to convert $build file names to toolchain format... " >&6; } +if ${lt_cv_to_tool_file_cmd+:} false; then : + $as_echo_n "(cached) " >&6 +else + #assume ordinary cross tools, or native build. +lt_cv_to_tool_file_cmd=func_convert_file_noop +case $host in + *-*-mingw* ) + case $build in + *-*-mingw* ) # actually msys + lt_cv_to_tool_file_cmd=func_convert_file_msys_to_w32 + ;; + esac + ;; +esac + +fi + +to_tool_file_cmd=$lt_cv_to_tool_file_cmd +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_to_tool_file_cmd" >&5 +$as_echo "$lt_cv_to_tool_file_cmd" >&6; } + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $LD option to reload object files" >&5 +$as_echo_n "checking for $LD option to reload object files... " >&6; } +if ${lt_cv_ld_reload_flag+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ld_reload_flag='-r' +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_reload_flag" >&5 +$as_echo "$lt_cv_ld_reload_flag" >&6; } +reload_flag=$lt_cv_ld_reload_flag +case $reload_flag in +"" | " "*) ;; +*) reload_flag=" $reload_flag" ;; +esac +reload_cmds='$LD$reload_flag -o $output$reload_objs' +case $host_os in + cygwin* | mingw* | pw32* | cegcc*) + if test yes != "$GCC"; then + reload_cmds=false + fi + ;; + darwin*) + if test yes = "$GCC"; then + reload_cmds='$LTCC $LTCFLAGS -nostdlib $wl-r -o $output$reload_objs' + else + reload_cmds='$LD$reload_flag -o $output$reload_objs' + fi + ;; +esac + + + + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args. +set dummy ${ac_tool_prefix}objdump; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_OBJDUMP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OBJDUMP"; then + ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OBJDUMP=$ac_cv_prog_OBJDUMP +if test -n "$OBJDUMP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OBJDUMP" >&5 +$as_echo "$OBJDUMP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OBJDUMP"; then + ac_ct_OBJDUMP=$OBJDUMP + # Extract the first word of "objdump", so it can be a program name with args. +set dummy objdump; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_OBJDUMP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OBJDUMP"; then + ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OBJDUMP="objdump" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP +if test -n "$ac_ct_OBJDUMP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OBJDUMP" >&5 +$as_echo "$ac_ct_OBJDUMP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OBJDUMP" = x; then + OBJDUMP="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OBJDUMP=$ac_ct_OBJDUMP + fi +else + OBJDUMP="$ac_cv_prog_OBJDUMP" +fi + +test -z "$OBJDUMP" && OBJDUMP=objdump + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to recognize dependent libraries" >&5 +$as_echo_n "checking how to recognize dependent libraries... " >&6; } +if ${lt_cv_deplibs_check_method+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_file_magic_cmd='$MAGIC_CMD' +lt_cv_file_magic_test_file= +lt_cv_deplibs_check_method='unknown' +# Need to set the preceding variable on all platforms that support +# interlibrary dependencies. +# 'none' -- dependencies not supported. +# 'unknown' -- same as none, but documents that we really don't know. +# 'pass_all' -- all dependencies passed with no checks. +# 'test_compile' -- check by making test program. +# 'file_magic [[regex]]' -- check by looking for files in library path +# that responds to the $file_magic_cmd with a given extended regex. +# If you have 'file' or equivalent on your system and you're not sure +# whether 'pass_all' will *always* work, you probably want this one. + +case $host_os in +aix[4-9]*) + lt_cv_deplibs_check_method=pass_all + ;; + +beos*) + lt_cv_deplibs_check_method=pass_all + ;; + +bsdi[45]*) + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)' + lt_cv_file_magic_cmd='/usr/bin/file -L' + lt_cv_file_magic_test_file=/shlib/libc.so + ;; + +cygwin*) + # func_win32_libid is a shell function defined in ltmain.sh + lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' + lt_cv_file_magic_cmd='func_win32_libid' + ;; + +mingw* | pw32*) + # Base MSYS/MinGW do not provide the 'file' command needed by + # func_win32_libid shell function, so use a weaker test based on 'objdump', + # unless we find 'file', for example because we are cross-compiling. + if ( file / ) >/dev/null 2>&1; then + lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' + lt_cv_file_magic_cmd='func_win32_libid' + else + # Keep this pattern in sync with the one in func_win32_libid. + lt_cv_deplibs_check_method='file_magic file format (pei*-i386(.*architecture: i386)?|pe-arm-wince|pe-x86-64)' + lt_cv_file_magic_cmd='$OBJDUMP -f' + fi + ;; + +cegcc*) + # use the weaker test based on 'objdump'. See mingw*. + lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?' + lt_cv_file_magic_cmd='$OBJDUMP -f' + ;; + +darwin* | rhapsody*) + lt_cv_deplibs_check_method=pass_all + ;; + +freebsd* | dragonfly*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then + case $host_cpu in + i*86 ) + # Not sure whether the presence of OpenBSD here was a mistake. + # Let's accept both of them until this is cleared up. + lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[3-9]86 (compact )?demand paged shared library' + lt_cv_file_magic_cmd=/usr/bin/file + lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*` + ;; + esac + else + lt_cv_deplibs_check_method=pass_all + fi + ;; + +haiku*) + lt_cv_deplibs_check_method=pass_all + ;; + +hpux10.20* | hpux11*) + lt_cv_file_magic_cmd=/usr/bin/file + case $host_cpu in + ia64*) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF-[0-9][0-9]) shared object file - IA64' + lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so + ;; + hppa*64*) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF[ -][0-9][0-9])(-bit)?( [LM]SB)? shared object( file)?[, -]* PA-RISC [0-9]\.[0-9]' + lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl + ;; + *) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|PA-RISC[0-9]\.[0-9]) shared library' + lt_cv_file_magic_test_file=/usr/lib/libc.sl + ;; + esac + ;; + +interix[3-9]*) + # PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|\.a)$' + ;; + +irix5* | irix6* | nonstopux*) + case $LD in + *-32|*"-32 ") libmagic=32-bit;; + *-n32|*"-n32 ") libmagic=N32;; + *-64|*"-64 ") libmagic=64-bit;; + *) libmagic=never-match;; + esac + lt_cv_deplibs_check_method=pass_all + ;; + +# This must be glibc/ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + lt_cv_deplibs_check_method=pass_all + ;; + +netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$' + else + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|_pic\.a)$' + fi + ;; + +newos6*) + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (executable|dynamic lib)' + lt_cv_file_magic_cmd=/usr/bin/file + lt_cv_file_magic_test_file=/usr/lib/libnls.so + ;; + +*nto* | *qnx*) + lt_cv_deplibs_check_method=pass_all + ;; + +openbsd* | bitrig*) + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|\.so|_pic\.a)$' + else + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$' + fi + ;; + +osf3* | osf4* | osf5*) + lt_cv_deplibs_check_method=pass_all + ;; + +rdos*) + lt_cv_deplibs_check_method=pass_all + ;; + +solaris*) + lt_cv_deplibs_check_method=pass_all + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + lt_cv_deplibs_check_method=pass_all + ;; + +sysv4 | sysv4.3*) + case $host_vendor in + motorola) + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]' + lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*` + ;; + ncr) + lt_cv_deplibs_check_method=pass_all + ;; + sequent) + lt_cv_file_magic_cmd='/bin/file' + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )' + ;; + sni) + lt_cv_file_magic_cmd='/bin/file' + lt_cv_deplibs_check_method="file_magic ELF [0-9][0-9]*-bit [LM]SB dynamic lib" + lt_cv_file_magic_test_file=/lib/libc.so + ;; + siemens) + lt_cv_deplibs_check_method=pass_all + ;; + pc) + lt_cv_deplibs_check_method=pass_all + ;; + esac + ;; + +tpf*) + lt_cv_deplibs_check_method=pass_all + ;; +os2*) + lt_cv_deplibs_check_method=pass_all + ;; +esac + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_deplibs_check_method" >&5 +$as_echo "$lt_cv_deplibs_check_method" >&6; } + +file_magic_glob= +want_nocaseglob=no +if test "$build" = "$host"; then + case $host_os in + mingw* | pw32*) + if ( shopt | grep nocaseglob ) >/dev/null 2>&1; then + want_nocaseglob=yes + else + file_magic_glob=`echo aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ | $SED -e "s/\(..\)/s\/[\1]\/[\1]\/g;/g"` + fi + ;; + esac +fi + +file_magic_cmd=$lt_cv_file_magic_cmd +deplibs_check_method=$lt_cv_deplibs_check_method +test -z "$deplibs_check_method" && deplibs_check_method=unknown + + + + + + + + + + + + + + + + + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}dlltool", so it can be a program name with args. +set dummy ${ac_tool_prefix}dlltool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_DLLTOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$DLLTOOL"; then + ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_DLLTOOL="${ac_tool_prefix}dlltool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +DLLTOOL=$ac_cv_prog_DLLTOOL +if test -n "$DLLTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DLLTOOL" >&5 +$as_echo "$DLLTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_DLLTOOL"; then + ac_ct_DLLTOOL=$DLLTOOL + # Extract the first word of "dlltool", so it can be a program name with args. +set dummy dlltool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_DLLTOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_DLLTOOL"; then + ac_cv_prog_ac_ct_DLLTOOL="$ac_ct_DLLTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_DLLTOOL="dlltool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_DLLTOOL=$ac_cv_prog_ac_ct_DLLTOOL +if test -n "$ac_ct_DLLTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DLLTOOL" >&5 +$as_echo "$ac_ct_DLLTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_DLLTOOL" = x; then + DLLTOOL="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + DLLTOOL=$ac_ct_DLLTOOL + fi +else + DLLTOOL="$ac_cv_prog_DLLTOOL" +fi + +test -z "$DLLTOOL" && DLLTOOL=dlltool + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to associate runtime and link libraries" >&5 +$as_echo_n "checking how to associate runtime and link libraries... " >&6; } +if ${lt_cv_sharedlib_from_linklib_cmd+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_sharedlib_from_linklib_cmd='unknown' + +case $host_os in +cygwin* | mingw* | pw32* | cegcc*) + # two different shell functions defined in ltmain.sh; + # decide which one to use based on capabilities of $DLLTOOL + case `$DLLTOOL --help 2>&1` in + *--identify-strict*) + lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib + ;; + *) + lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib_fallback + ;; + esac + ;; +*) + # fallback: assume linklib IS sharedlib + lt_cv_sharedlib_from_linklib_cmd=$ECHO + ;; +esac + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sharedlib_from_linklib_cmd" >&5 +$as_echo "$lt_cv_sharedlib_from_linklib_cmd" >&6; } +sharedlib_from_linklib_cmd=$lt_cv_sharedlib_from_linklib_cmd +test -z "$sharedlib_from_linklib_cmd" && sharedlib_from_linklib_cmd=$ECHO + + + + + + + +if test -n "$ac_tool_prefix"; then + for ac_prog in ar + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$AR" && break + done +fi +if test -z "$AR"; then + ac_ct_AR=$AR + for ac_prog in ar +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AR"; then + ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_AR="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AR=$ac_cv_prog_ac_ct_AR +if test -n "$ac_ct_AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_AR" && break +done + + if test "x$ac_ct_AR" = x; then + AR="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi +fi + +: ${AR=ar} +: ${AR_FLAGS=cru} + + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for archiver @FILE support" >&5 +$as_echo_n "checking for archiver @FILE support... " >&6; } +if ${lt_cv_ar_at_file+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ar_at_file=no + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + echo conftest.$ac_objext > conftest.lst + lt_ar_try='$AR $AR_FLAGS libconftest.a @conftest.lst >&5' + { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$lt_ar_try\""; } >&5 + (eval $lt_ar_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if test 0 -eq "$ac_status"; then + # Ensure the archiver fails upon bogus file names. + rm -f conftest.$ac_objext libconftest.a + { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$lt_ar_try\""; } >&5 + (eval $lt_ar_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if test 0 -ne "$ac_status"; then + lt_cv_ar_at_file=@ + fi + fi + rm -f conftest.* libconftest.a + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ar_at_file" >&5 +$as_echo "$lt_cv_ar_at_file" >&6; } + +if test no = "$lt_cv_ar_at_file"; then + archiver_list_spec= +else + archiver_list_spec=$lt_cv_ar_at_file +fi + + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. +set dummy ${ac_tool_prefix}strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_STRIP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$STRIP"; then + ac_cv_prog_STRIP="$STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_STRIP="${ac_tool_prefix}strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +STRIP=$ac_cv_prog_STRIP +if test -n "$STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5 +$as_echo "$STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_STRIP"; then + ac_ct_STRIP=$STRIP + # Extract the first word of "strip", so it can be a program name with args. +set dummy strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_STRIP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_STRIP"; then + ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_STRIP="strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP +if test -n "$ac_ct_STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5 +$as_echo "$ac_ct_STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_STRIP" = x; then + STRIP=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + STRIP=$ac_ct_STRIP + fi +else + STRIP="$ac_cv_prog_STRIP" +fi + +test -z "$STRIP" && STRIP=: + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + +test -z "$RANLIB" && RANLIB=: + + + + + + +# Determine commands to create old-style static archives. +old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs' +old_postinstall_cmds='chmod 644 $oldlib' +old_postuninstall_cmds= + +if test -n "$RANLIB"; then + case $host_os in + bitrig* | openbsd*) + old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$tool_oldlib" + ;; + *) + old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$tool_oldlib" + ;; + esac + old_archive_cmds="$old_archive_cmds~\$RANLIB \$tool_oldlib" +fi + +case $host_os in + darwin*) + lock_old_archive_extraction=yes ;; + *) + lock_old_archive_extraction=no ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + + +# Check for command to grab the raw symbol name followed by C symbol from nm. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking command to parse $NM output from $compiler object" >&5 +$as_echo_n "checking command to parse $NM output from $compiler object... " >&6; } +if ${lt_cv_sys_global_symbol_pipe+:} false; then : + $as_echo_n "(cached) " >&6 +else + +# These are sane defaults that work on at least a few old systems. +# [They come from Ultrix. What could be older than Ultrix?!! ;)] + +# Character class describing NM global symbol codes. +symcode='[BCDEGRST]' + +# Regexp to match symbols that can be accessed directly from C. +sympat='\([_A-Za-z][_A-Za-z0-9]*\)' + +# Define system-specific variables. +case $host_os in +aix*) + symcode='[BCDT]' + ;; +cygwin* | mingw* | pw32* | cegcc*) + symcode='[ABCDGISTW]' + ;; +hpux*) + if test ia64 = "$host_cpu"; then + symcode='[ABCDEGRST]' + fi + ;; +irix* | nonstopux*) + symcode='[BCDEGRST]' + ;; +osf*) + symcode='[BCDEGQRST]' + ;; +solaris*) + symcode='[BDRT]' + ;; +sco3.2v5*) + symcode='[DT]' + ;; +sysv4.2uw2*) + symcode='[DT]' + ;; +sysv5* | sco5v6* | unixware* | OpenUNIX*) + symcode='[ABDT]' + ;; +sysv4) + symcode='[DFNSTU]' + ;; +esac + +# If we're using GNU nm, then use its standard symbol codes. +case `$NM -V 2>&1` in +*GNU* | *'with BFD'*) + symcode='[ABCDGIRSTW]' ;; +esac + +if test "$lt_cv_nm_interface" = "MS dumpbin"; then + # Gets list of data symbols to import. + lt_cv_sys_global_symbol_to_import="sed -n -e 's/^I .* \(.*\)$/\1/p'" + # Adjust the below global symbol transforms to fixup imported variables. + lt_cdecl_hook=" -e 's/^I .* \(.*\)$/extern __declspec(dllimport) char \1;/p'" + lt_c_name_hook=" -e 's/^I .* \(.*\)$/ {\"\1\", (void *) 0},/p'" + lt_c_name_lib_hook="\ + -e 's/^I .* \(lib.*\)$/ {\"\1\", (void *) 0},/p'\ + -e 's/^I .* \(.*\)$/ {\"lib\1\", (void *) 0},/p'" +else + # Disable hooks by default. + lt_cv_sys_global_symbol_to_import= + lt_cdecl_hook= + lt_c_name_hook= + lt_c_name_lib_hook= +fi + +# Transform an extracted symbol line into a proper C declaration. +# Some systems (esp. on ia64) link data and code symbols differently, +# so use this general approach. +lt_cv_sys_global_symbol_to_cdecl="sed -n"\ +$lt_cdecl_hook\ +" -e 's/^T .* \(.*\)$/extern int \1();/p'"\ +" -e 's/^$symcode$symcode* .* \(.*\)$/extern char \1;/p'" + +# Transform an extracted symbol line into symbol name and symbol address +lt_cv_sys_global_symbol_to_c_name_address="sed -n"\ +$lt_c_name_hook\ +" -e 's/^: \(.*\) .*$/ {\"\1\", (void *) 0},/p'"\ +" -e 's/^$symcode$symcode* .* \(.*\)$/ {\"\1\", (void *) \&\1},/p'" + +# Transform an extracted symbol line into symbol name with lib prefix and +# symbol address. +lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n"\ +$lt_c_name_lib_hook\ +" -e 's/^: \(.*\) .*$/ {\"\1\", (void *) 0},/p'"\ +" -e 's/^$symcode$symcode* .* \(lib.*\)$/ {\"\1\", (void *) \&\1},/p'"\ +" -e 's/^$symcode$symcode* .* \(.*\)$/ {\"lib\1\", (void *) \&\1},/p'" + +# Handle CRLF in mingw tool chain +opt_cr= +case $build_os in +mingw*) + opt_cr=`$ECHO 'x\{0,1\}' | tr x '\015'` # option cr in regexp + ;; +esac + +# Try without a prefix underscore, then with it. +for ac_symprfx in "" "_"; do + + # Transform symcode, sympat, and symprfx into a raw symbol and a C symbol. + symxfrm="\\1 $ac_symprfx\\2 \\2" + + # Write the raw and C identifiers. + if test "$lt_cv_nm_interface" = "MS dumpbin"; then + # Fake it for dumpbin and say T for any non-static function, + # D for any global variable and I for any imported variable. + # Also find C++ and __fastcall symbols from MSVC++, + # which start with @ or ?. + lt_cv_sys_global_symbol_pipe="$AWK '"\ +" {last_section=section; section=\$ 3};"\ +" /^COFF SYMBOL TABLE/{for(i in hide) delete hide[i]};"\ +" /Section length .*#relocs.*(pick any)/{hide[last_section]=1};"\ +" /^ *Symbol name *: /{split(\$ 0,sn,\":\"); si=substr(sn[2],2)};"\ +" /^ *Type *: code/{print \"T\",si,substr(si,length(prfx))};"\ +" /^ *Type *: data/{print \"I\",si,substr(si,length(prfx))};"\ +" \$ 0!~/External *\|/{next};"\ +" / 0+ UNDEF /{next}; / UNDEF \([^|]\)*()/{next};"\ +" {if(hide[section]) next};"\ +" {f=\"D\"}; \$ 0~/\(\).*\|/{f=\"T\"};"\ +" {split(\$ 0,a,/\||\r/); split(a[2],s)};"\ +" s[1]~/^[@?]/{print f,s[1],s[1]; next};"\ +" s[1]~prfx {split(s[1],t,\"@\"); print f,t[1],substr(t[1],length(prfx))}"\ +" ' prfx=^$ac_symprfx" + else + lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[ ]\($symcode$symcode*\)[ ][ ]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'" + fi + lt_cv_sys_global_symbol_pipe="$lt_cv_sys_global_symbol_pipe | sed '/ __gnu_lto/d'" + + # Check to see that the pipe works correctly. + pipe_works=no + + rm -f conftest* + cat > conftest.$ac_ext <<_LT_EOF +#ifdef __cplusplus +extern "C" { +#endif +char nm_test_var; +void nm_test_func(void); +void nm_test_func(void){} +#ifdef __cplusplus +} +#endif +int main(){nm_test_var='a';nm_test_func();return(0);} +_LT_EOF + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + # Now try to grab the symbols. + nlist=conftest.nm + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist\""; } >&5 + (eval $NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s "$nlist"; then + # Try sorting and uniquifying the output. + if sort "$nlist" | uniq > "$nlist"T; then + mv -f "$nlist"T "$nlist" + else + rm -f "$nlist"T + fi + + # Make sure that we snagged all the symbols we need. + if $GREP ' nm_test_var$' "$nlist" >/dev/null; then + if $GREP ' nm_test_func$' "$nlist" >/dev/null; then + cat <<_LT_EOF > conftest.$ac_ext +/* Keep this code in sync between libtool.m4, ltmain, lt_system.h, and tests. */ +#if defined _WIN32 || defined __CYGWIN__ || defined _WIN32_WCE +/* DATA imports from DLLs on WIN32 can't be const, because runtime + relocations are performed -- see ld's documentation on pseudo-relocs. */ +# define LT_DLSYM_CONST +#elif defined __osf__ +/* This system does not cope well with relocations in const data. */ +# define LT_DLSYM_CONST +#else +# define LT_DLSYM_CONST const +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +_LT_EOF + # Now generate the symbol file. + eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | $GREP -v main >> conftest.$ac_ext' + + cat <<_LT_EOF >> conftest.$ac_ext + +/* The mapping between symbol names and symbols. */ +LT_DLSYM_CONST struct { + const char *name; + void *address; +} +lt__PROGRAM__LTX_preloaded_symbols[] = +{ + { "@PROGRAM@", (void *) 0 }, +_LT_EOF + $SED "s/^$symcode$symcode* .* \(.*\)$/ {\"\1\", (void *) \&\1},/" < "$nlist" | $GREP -v main >> conftest.$ac_ext + cat <<\_LT_EOF >> conftest.$ac_ext + {0, (void *) 0} +}; + +/* This works around a problem in FreeBSD linker */ +#ifdef FREEBSD_WORKAROUND +static const void *lt_preloaded_setup() { + return lt__PROGRAM__LTX_preloaded_symbols; +} +#endif + +#ifdef __cplusplus +} +#endif +_LT_EOF + # Now try linking the two files. + mv conftest.$ac_objext conftstm.$ac_objext + lt_globsym_save_LIBS=$LIBS + lt_globsym_save_CFLAGS=$CFLAGS + LIBS=conftstm.$ac_objext + CFLAGS="$CFLAGS$lt_prog_compiler_no_builtin_flag" + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s conftest$ac_exeext; then + pipe_works=yes + fi + LIBS=$lt_globsym_save_LIBS + CFLAGS=$lt_globsym_save_CFLAGS + else + echo "cannot find nm_test_func in $nlist" >&5 + fi + else + echo "cannot find nm_test_var in $nlist" >&5 + fi + else + echo "cannot run $lt_cv_sys_global_symbol_pipe" >&5 + fi + else + echo "$progname: failed program was:" >&5 + cat conftest.$ac_ext >&5 + fi + rm -rf conftest* conftst* + + # Do not use the global_symbol_pipe unless it works. + if test yes = "$pipe_works"; then + break + else + lt_cv_sys_global_symbol_pipe= + fi +done + +fi + +if test -z "$lt_cv_sys_global_symbol_pipe"; then + lt_cv_sys_global_symbol_to_cdecl= +fi +if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: failed" >&5 +$as_echo "failed" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 +$as_echo "ok" >&6; } +fi + +# Response file support. +if test "$lt_cv_nm_interface" = "MS dumpbin"; then + nm_file_list_spec='@' +elif $NM --help 2>/dev/null | grep '[@]FILE' >/dev/null; then + nm_file_list_spec='@' +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sysroot" >&5 +$as_echo_n "checking for sysroot... " >&6; } + +# Check whether --with-sysroot was given. +if test "${with_sysroot+set}" = set; then : + withval=$with_sysroot; +else + with_sysroot=no +fi + + +lt_sysroot= +case $with_sysroot in #( + yes) + if test yes = "$GCC"; then + lt_sysroot=`$CC --print-sysroot 2>/dev/null` + fi + ;; #( + /*) + lt_sysroot=`echo "$with_sysroot" | sed -e "$sed_quote_subst"` + ;; #( + no|'') + ;; #( + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $with_sysroot" >&5 +$as_echo "$with_sysroot" >&6; } + as_fn_error $? "The sysroot must be an absolute path." "$LINENO" 5 + ;; +esac + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${lt_sysroot:-no}" >&5 +$as_echo "${lt_sysroot:-no}" >&6; } + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a working dd" >&5 +$as_echo_n "checking for a working dd... " >&6; } +if ${ac_cv_path_lt_DD+:} false; then : + $as_echo_n "(cached) " >&6 +else + printf 0123456789abcdef0123456789abcdef >conftest.i +cat conftest.i conftest.i >conftest2.i +: ${lt_DD:=$DD} +if test -z "$lt_DD"; then + ac_path_lt_DD_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in dd; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_lt_DD="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_lt_DD" || continue +if "$ac_path_lt_DD" bs=32 count=1 conftest.out 2>/dev/null; then + cmp -s conftest.i conftest.out \ + && ac_cv_path_lt_DD="$ac_path_lt_DD" ac_path_lt_DD_found=: +fi + $ac_path_lt_DD_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_lt_DD"; then + : + fi +else + ac_cv_path_lt_DD=$lt_DD +fi + +rm -f conftest.i conftest2.i conftest.out +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_lt_DD" >&5 +$as_echo "$ac_cv_path_lt_DD" >&6; } + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to truncate binary pipes" >&5 +$as_echo_n "checking how to truncate binary pipes... " >&6; } +if ${lt_cv_truncate_bin+:} false; then : + $as_echo_n "(cached) " >&6 +else + printf 0123456789abcdef0123456789abcdef >conftest.i +cat conftest.i conftest.i >conftest2.i +lt_cv_truncate_bin= +if "$ac_cv_path_lt_DD" bs=32 count=1 conftest.out 2>/dev/null; then + cmp -s conftest.i conftest.out \ + && lt_cv_truncate_bin="$ac_cv_path_lt_DD bs=4096 count=1" +fi +rm -f conftest.i conftest2.i conftest.out +test -z "$lt_cv_truncate_bin" && lt_cv_truncate_bin="$SED -e 4q" +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_truncate_bin" >&5 +$as_echo "$lt_cv_truncate_bin" >&6; } + + + + + + + +# Calculate cc_basename. Skip known compiler wrappers and cross-prefix. +func_cc_basename () +{ + for cc_temp in $*""; do + case $cc_temp in + compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; + distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; + \-*) ;; + *) break;; + esac + done + func_cc_basename_result=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"` +} + +# Check whether --enable-libtool-lock was given. +if test "${enable_libtool_lock+set}" = set; then : + enableval=$enable_libtool_lock; +fi + +test no = "$enable_libtool_lock" || enable_libtool_lock=yes + +# Some flags need to be propagated to the compiler or linker for good +# libtool support. +case $host in +ia64-*-hpux*) + # Find out what ABI is being produced by ac_compile, and set mode + # options accordingly. + echo 'int i;' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + case `/usr/bin/file conftest.$ac_objext` in + *ELF-32*) + HPUX_IA64_MODE=32 + ;; + *ELF-64*) + HPUX_IA64_MODE=64 + ;; + esac + fi + rm -rf conftest* + ;; +*-*-irix6*) + # Find out what ABI is being produced by ac_compile, and set linker + # options accordingly. + echo '#line '$LINENO' "configure"' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + if test yes = "$lt_cv_prog_gnu_ld"; then + case `/usr/bin/file conftest.$ac_objext` in + *32-bit*) + LD="${LD-ld} -melf32bsmip" + ;; + *N32*) + LD="${LD-ld} -melf32bmipn32" + ;; + *64-bit*) + LD="${LD-ld} -melf64bmip" + ;; + esac + else + case `/usr/bin/file conftest.$ac_objext` in + *32-bit*) + LD="${LD-ld} -32" + ;; + *N32*) + LD="${LD-ld} -n32" + ;; + *64-bit*) + LD="${LD-ld} -64" + ;; + esac + fi + fi + rm -rf conftest* + ;; + +mips64*-*linux*) + # Find out what ABI is being produced by ac_compile, and set linker + # options accordingly. + echo '#line '$LINENO' "configure"' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + emul=elf + case `/usr/bin/file conftest.$ac_objext` in + *32-bit*) + emul="${emul}32" + ;; + *64-bit*) + emul="${emul}64" + ;; + esac + case `/usr/bin/file conftest.$ac_objext` in + *MSB*) + emul="${emul}btsmip" + ;; + *LSB*) + emul="${emul}ltsmip" + ;; + esac + case `/usr/bin/file conftest.$ac_objext` in + *N32*) + emul="${emul}n32" + ;; + esac + LD="${LD-ld} -m $emul" + fi + rm -rf conftest* + ;; + +x86_64-*kfreebsd*-gnu|x86_64-*linux*|powerpc*-*linux*| \ +s390*-*linux*|s390*-*tpf*|sparc*-*linux*) + # Find out what ABI is being produced by ac_compile, and set linker + # options accordingly. Note that the listed cases only cover the + # situations where additional linker options are needed (such as when + # doing 32-bit compilation for a host where ld defaults to 64-bit, or + # vice versa); the common cases where no linker options are needed do + # not appear in the list. + echo 'int i;' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + case `/usr/bin/file conftest.o` in + *32-bit*) + case $host in + x86_64-*kfreebsd*-gnu) + LD="${LD-ld} -m elf_i386_fbsd" + ;; + x86_64-*linux*) + case `/usr/bin/file conftest.o` in + *x86-64*) + LD="${LD-ld} -m elf32_x86_64" + ;; + *) + LD="${LD-ld} -m elf_i386" + ;; + esac + ;; + powerpc64le-*linux*) + LD="${LD-ld} -m elf32lppclinux" + ;; + powerpc64-*linux*) + LD="${LD-ld} -m elf32ppclinux" + ;; + s390x-*linux*) + LD="${LD-ld} -m elf_s390" + ;; + sparc64-*linux*) + LD="${LD-ld} -m elf32_sparc" + ;; + esac + ;; + *64-bit*) + case $host in + x86_64-*kfreebsd*-gnu) + LD="${LD-ld} -m elf_x86_64_fbsd" + ;; + x86_64-*linux*) + LD="${LD-ld} -m elf_x86_64" + ;; + powerpcle-*linux*) + LD="${LD-ld} -m elf64lppc" + ;; + powerpc-*linux*) + LD="${LD-ld} -m elf64ppc" + ;; + s390*-*linux*|s390*-*tpf*) + LD="${LD-ld} -m elf64_s390" + ;; + sparc*-*linux*) + LD="${LD-ld} -m elf64_sparc" + ;; + esac + ;; + esac + fi + rm -rf conftest* + ;; + +*-*-sco3.2v5*) + # On SCO OpenServer 5, we need -belf to get full-featured binaries. + SAVE_CFLAGS=$CFLAGS + CFLAGS="$CFLAGS -belf" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler needs -belf" >&5 +$as_echo_n "checking whether the C compiler needs -belf... " >&6; } +if ${lt_cv_cc_needs_belf+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + lt_cv_cc_needs_belf=yes +else + lt_cv_cc_needs_belf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_cc_needs_belf" >&5 +$as_echo "$lt_cv_cc_needs_belf" >&6; } + if test yes != "$lt_cv_cc_needs_belf"; then + # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf + CFLAGS=$SAVE_CFLAGS + fi + ;; +*-*solaris*) + # Find out what ABI is being produced by ac_compile, and set linker + # options accordingly. + echo 'int i;' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + case `/usr/bin/file conftest.o` in + *64-bit*) + case $lt_cv_prog_gnu_ld in + yes*) + case $host in + i?86-*-solaris*|x86_64-*-solaris*) + LD="${LD-ld} -m elf_x86_64" + ;; + sparc*-*-solaris*) + LD="${LD-ld} -m elf64_sparc" + ;; + esac + # GNU ld 2.21 introduced _sol2 emulations. Use them if available. + if ${LD-ld} -V | grep _sol2 >/dev/null 2>&1; then + LD=${LD-ld}_sol2 + fi + ;; + *) + if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then + LD="${LD-ld} -64" + fi + ;; + esac + ;; + esac + fi + rm -rf conftest* + ;; +esac + +need_locks=$enable_libtool_lock + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}mt", so it can be a program name with args. +set dummy ${ac_tool_prefix}mt; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_MANIFEST_TOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$MANIFEST_TOOL"; then + ac_cv_prog_MANIFEST_TOOL="$MANIFEST_TOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_MANIFEST_TOOL="${ac_tool_prefix}mt" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +MANIFEST_TOOL=$ac_cv_prog_MANIFEST_TOOL +if test -n "$MANIFEST_TOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MANIFEST_TOOL" >&5 +$as_echo "$MANIFEST_TOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_MANIFEST_TOOL"; then + ac_ct_MANIFEST_TOOL=$MANIFEST_TOOL + # Extract the first word of "mt", so it can be a program name with args. +set dummy mt; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_MANIFEST_TOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_MANIFEST_TOOL"; then + ac_cv_prog_ac_ct_MANIFEST_TOOL="$ac_ct_MANIFEST_TOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_MANIFEST_TOOL="mt" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_MANIFEST_TOOL=$ac_cv_prog_ac_ct_MANIFEST_TOOL +if test -n "$ac_ct_MANIFEST_TOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_MANIFEST_TOOL" >&5 +$as_echo "$ac_ct_MANIFEST_TOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_MANIFEST_TOOL" = x; then + MANIFEST_TOOL=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + MANIFEST_TOOL=$ac_ct_MANIFEST_TOOL + fi +else + MANIFEST_TOOL="$ac_cv_prog_MANIFEST_TOOL" +fi + +test -z "$MANIFEST_TOOL" && MANIFEST_TOOL=mt +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $MANIFEST_TOOL is a manifest tool" >&5 +$as_echo_n "checking if $MANIFEST_TOOL is a manifest tool... " >&6; } +if ${lt_cv_path_mainfest_tool+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_path_mainfest_tool=no + echo "$as_me:$LINENO: $MANIFEST_TOOL '-?'" >&5 + $MANIFEST_TOOL '-?' 2>conftest.err > conftest.out + cat conftest.err >&5 + if $GREP 'Manifest Tool' conftest.out > /dev/null; then + lt_cv_path_mainfest_tool=yes + fi + rm -f conftest* +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_mainfest_tool" >&5 +$as_echo "$lt_cv_path_mainfest_tool" >&6; } +if test yes != "$lt_cv_path_mainfest_tool"; then + MANIFEST_TOOL=: +fi + + + + + + + case $host_os in + rhapsody* | darwin*) + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}dsymutil", so it can be a program name with args. +set dummy ${ac_tool_prefix}dsymutil; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_DSYMUTIL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$DSYMUTIL"; then + ac_cv_prog_DSYMUTIL="$DSYMUTIL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_DSYMUTIL="${ac_tool_prefix}dsymutil" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +DSYMUTIL=$ac_cv_prog_DSYMUTIL +if test -n "$DSYMUTIL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DSYMUTIL" >&5 +$as_echo "$DSYMUTIL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_DSYMUTIL"; then + ac_ct_DSYMUTIL=$DSYMUTIL + # Extract the first word of "dsymutil", so it can be a program name with args. +set dummy dsymutil; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_DSYMUTIL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_DSYMUTIL"; then + ac_cv_prog_ac_ct_DSYMUTIL="$ac_ct_DSYMUTIL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_DSYMUTIL="dsymutil" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_DSYMUTIL=$ac_cv_prog_ac_ct_DSYMUTIL +if test -n "$ac_ct_DSYMUTIL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DSYMUTIL" >&5 +$as_echo "$ac_ct_DSYMUTIL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_DSYMUTIL" = x; then + DSYMUTIL=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + DSYMUTIL=$ac_ct_DSYMUTIL + fi +else + DSYMUTIL="$ac_cv_prog_DSYMUTIL" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}nmedit", so it can be a program name with args. +set dummy ${ac_tool_prefix}nmedit; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_NMEDIT+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$NMEDIT"; then + ac_cv_prog_NMEDIT="$NMEDIT" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_NMEDIT="${ac_tool_prefix}nmedit" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +NMEDIT=$ac_cv_prog_NMEDIT +if test -n "$NMEDIT"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $NMEDIT" >&5 +$as_echo "$NMEDIT" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_NMEDIT"; then + ac_ct_NMEDIT=$NMEDIT + # Extract the first word of "nmedit", so it can be a program name with args. +set dummy nmedit; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_NMEDIT+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_NMEDIT"; then + ac_cv_prog_ac_ct_NMEDIT="$ac_ct_NMEDIT" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_NMEDIT="nmedit" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_NMEDIT=$ac_cv_prog_ac_ct_NMEDIT +if test -n "$ac_ct_NMEDIT"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_NMEDIT" >&5 +$as_echo "$ac_ct_NMEDIT" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_NMEDIT" = x; then + NMEDIT=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + NMEDIT=$ac_ct_NMEDIT + fi +else + NMEDIT="$ac_cv_prog_NMEDIT" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}lipo", so it can be a program name with args. +set dummy ${ac_tool_prefix}lipo; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_LIPO+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$LIPO"; then + ac_cv_prog_LIPO="$LIPO" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_LIPO="${ac_tool_prefix}lipo" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +LIPO=$ac_cv_prog_LIPO +if test -n "$LIPO"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIPO" >&5 +$as_echo "$LIPO" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_LIPO"; then + ac_ct_LIPO=$LIPO + # Extract the first word of "lipo", so it can be a program name with args. +set dummy lipo; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_LIPO+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_LIPO"; then + ac_cv_prog_ac_ct_LIPO="$ac_ct_LIPO" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_LIPO="lipo" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_LIPO=$ac_cv_prog_ac_ct_LIPO +if test -n "$ac_ct_LIPO"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_LIPO" >&5 +$as_echo "$ac_ct_LIPO" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_LIPO" = x; then + LIPO=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + LIPO=$ac_ct_LIPO + fi +else + LIPO="$ac_cv_prog_LIPO" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}otool", so it can be a program name with args. +set dummy ${ac_tool_prefix}otool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_OTOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OTOOL"; then + ac_cv_prog_OTOOL="$OTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OTOOL="${ac_tool_prefix}otool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OTOOL=$ac_cv_prog_OTOOL +if test -n "$OTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL" >&5 +$as_echo "$OTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OTOOL"; then + ac_ct_OTOOL=$OTOOL + # Extract the first word of "otool", so it can be a program name with args. +set dummy otool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_OTOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OTOOL"; then + ac_cv_prog_ac_ct_OTOOL="$ac_ct_OTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OTOOL="otool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OTOOL=$ac_cv_prog_ac_ct_OTOOL +if test -n "$ac_ct_OTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL" >&5 +$as_echo "$ac_ct_OTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OTOOL" = x; then + OTOOL=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OTOOL=$ac_ct_OTOOL + fi +else + OTOOL="$ac_cv_prog_OTOOL" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}otool64", so it can be a program name with args. +set dummy ${ac_tool_prefix}otool64; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_OTOOL64+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OTOOL64"; then + ac_cv_prog_OTOOL64="$OTOOL64" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OTOOL64="${ac_tool_prefix}otool64" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OTOOL64=$ac_cv_prog_OTOOL64 +if test -n "$OTOOL64"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL64" >&5 +$as_echo "$OTOOL64" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OTOOL64"; then + ac_ct_OTOOL64=$OTOOL64 + # Extract the first word of "otool64", so it can be a program name with args. +set dummy otool64; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_OTOOL64+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OTOOL64"; then + ac_cv_prog_ac_ct_OTOOL64="$ac_ct_OTOOL64" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OTOOL64="otool64" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OTOOL64=$ac_cv_prog_ac_ct_OTOOL64 +if test -n "$ac_ct_OTOOL64"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL64" >&5 +$as_echo "$ac_ct_OTOOL64" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OTOOL64" = x; then + OTOOL64=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OTOOL64=$ac_ct_OTOOL64 + fi +else + OTOOL64="$ac_cv_prog_OTOOL64" +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -single_module linker flag" >&5 +$as_echo_n "checking for -single_module linker flag... " >&6; } +if ${lt_cv_apple_cc_single_mod+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_apple_cc_single_mod=no + if test -z "$LT_MULTI_MODULE"; then + # By default we will add the -single_module flag. You can override + # by either setting the environment variable LT_MULTI_MODULE + # non-empty at configure time, or by adding -multi_module to the + # link flags. + rm -rf libconftest.dylib* + echo "int foo(void){return 1;}" > conftest.c + echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ +-dynamiclib -Wl,-single_module conftest.c" >&5 + $LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ + -dynamiclib -Wl,-single_module conftest.c 2>conftest.err + _lt_result=$? + # If there is a non-empty error log, and "single_module" + # appears in it, assume the flag caused a linker warning + if test -s conftest.err && $GREP single_module conftest.err; then + cat conftest.err >&5 + # Otherwise, if the output was created with a 0 exit code from + # the compiler, it worked. + elif test -f libconftest.dylib && test 0 = "$_lt_result"; then + lt_cv_apple_cc_single_mod=yes + else + cat conftest.err >&5 + fi + rm -rf libconftest.dylib* + rm -f conftest.* + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_apple_cc_single_mod" >&5 +$as_echo "$lt_cv_apple_cc_single_mod" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -exported_symbols_list linker flag" >&5 +$as_echo_n "checking for -exported_symbols_list linker flag... " >&6; } +if ${lt_cv_ld_exported_symbols_list+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ld_exported_symbols_list=no + save_LDFLAGS=$LDFLAGS + echo "_main" > conftest.sym + LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + lt_cv_ld_exported_symbols_list=yes +else + lt_cv_ld_exported_symbols_list=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_exported_symbols_list" >&5 +$as_echo "$lt_cv_ld_exported_symbols_list" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -force_load linker flag" >&5 +$as_echo_n "checking for -force_load linker flag... " >&6; } +if ${lt_cv_ld_force_load+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ld_force_load=no + cat > conftest.c << _LT_EOF +int forced_loaded() { return 2;} +_LT_EOF + echo "$LTCC $LTCFLAGS -c -o conftest.o conftest.c" >&5 + $LTCC $LTCFLAGS -c -o conftest.o conftest.c 2>&5 + echo "$AR cru libconftest.a conftest.o" >&5 + $AR cru libconftest.a conftest.o 2>&5 + echo "$RANLIB libconftest.a" >&5 + $RANLIB libconftest.a 2>&5 + cat > conftest.c << _LT_EOF +int main() { return 0;} +_LT_EOF + echo "$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a" >&5 + $LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a 2>conftest.err + _lt_result=$? + if test -s conftest.err && $GREP force_load conftest.err; then + cat conftest.err >&5 + elif test -f conftest && test 0 = "$_lt_result" && $GREP forced_load conftest >/dev/null 2>&1; then + lt_cv_ld_force_load=yes + else + cat conftest.err >&5 + fi + rm -f conftest.err libconftest.a conftest conftest.c + rm -rf conftest.dSYM + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_force_load" >&5 +$as_echo "$lt_cv_ld_force_load" >&6; } + case $host_os in + rhapsody* | darwin1.[012]) + _lt_dar_allow_undefined='$wl-undefined ${wl}suppress' ;; + darwin1.*) + _lt_dar_allow_undefined='$wl-flat_namespace $wl-undefined ${wl}suppress' ;; + darwin*) # darwin 5.x on + # if running on 10.5 or later, the deployment target defaults + # to the OS version, if on x86, and 10.4, the deployment + # target defaults to 10.4. Don't you love it? + case ${MACOSX_DEPLOYMENT_TARGET-10.0},$host in + 10.0,*86*-darwin8*|10.0,*-darwin[91]*) + _lt_dar_allow_undefined='$wl-undefined ${wl}dynamic_lookup' ;; + 10.[012][,.]*) + _lt_dar_allow_undefined='$wl-flat_namespace $wl-undefined ${wl}suppress' ;; + 10.*) + _lt_dar_allow_undefined='$wl-undefined ${wl}dynamic_lookup' ;; + esac + ;; + esac + if test yes = "$lt_cv_apple_cc_single_mod"; then + _lt_dar_single_mod='$single_module' + fi + if test yes = "$lt_cv_ld_exported_symbols_list"; then + _lt_dar_export_syms=' $wl-exported_symbols_list,$output_objdir/$libname-symbols.expsym' + else + _lt_dar_export_syms='~$NMEDIT -s $output_objdir/$libname-symbols.expsym $lib' + fi + if test : != "$DSYMUTIL" && test no = "$lt_cv_ld_force_load"; then + _lt_dsymutil='~$DSYMUTIL $lib || :' + else + _lt_dsymutil= + fi + ;; + esac + +# func_munge_path_list VARIABLE PATH +# ----------------------------------- +# VARIABLE is name of variable containing _space_ separated list of +# directories to be munged by the contents of PATH, which is string +# having a format: +# "DIR[:DIR]:" +# string "DIR[ DIR]" will be prepended to VARIABLE +# ":DIR[:DIR]" +# string "DIR[ DIR]" will be appended to VARIABLE +# "DIRP[:DIRP]::[DIRA:]DIRA" +# string "DIRP[ DIRP]" will be prepended to VARIABLE and string +# "DIRA[ DIRA]" will be appended to VARIABLE +# "DIR[:DIR]" +# VARIABLE will be replaced by "DIR[ DIR]" +func_munge_path_list () +{ + case x$2 in + x) + ;; + *:) + eval $1=\"`$ECHO $2 | $SED 's/:/ /g'` \$$1\" + ;; + x:*) + eval $1=\"\$$1 `$ECHO $2 | $SED 's/:/ /g'`\" + ;; + *::*) + eval $1=\"\$$1\ `$ECHO $2 | $SED -e 's/.*:://' -e 's/:/ /g'`\" + eval $1=\"`$ECHO $2 | $SED -e 's/::.*//' -e 's/:/ /g'`\ \$$1\" + ;; + *) + eval $1=\"`$ECHO $2 | $SED 's/:/ /g'`\" + ;; + esac +} + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then : + : +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +# On IRIX 5.3, sys/types and inttypes.h are conflicting. +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + +for ac_header in dlfcn.h +do : + ac_fn_c_check_header_compile "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default +" +if test "x$ac_cv_header_dlfcn_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_DLFCN_H 1 +_ACEOF + +fi + +done + + + + +func_stripname_cnf () +{ + case $2 in + .*) func_stripname_result=`$ECHO "$3" | $SED "s%^$1%%; s%\\\\$2\$%%"`;; + *) func_stripname_result=`$ECHO "$3" | $SED "s%^$1%%; s%$2\$%%"`;; + esac +} # func_stripname_cnf + + + if test -n "$ac_tool_prefix"; then + for ac_prog in ar lib "link -lib" + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$AR" && break + done +fi +if test -z "$AR"; then + ac_ct_AR=$AR + for ac_prog in ar lib "link -lib" +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AR"; then + ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_AR="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AR=$ac_cv_prog_ac_ct_AR +if test -n "$ac_ct_AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_AR" && break +done + + if test "x$ac_ct_AR" = x; then + AR="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi +fi + +: ${AR=ar} + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the archiver ($AR) interface" >&5 +$as_echo_n "checking the archiver ($AR) interface... " >&6; } +if ${am_cv_ar_interface+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + am_cv_ar_interface=ar + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +int some_variable = 0; +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + am_ar_try='$AR cru libconftest.a conftest.$ac_objext >&5' + { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$am_ar_try\""; } >&5 + (eval $am_ar_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if test "$ac_status" -eq 0; then + am_cv_ar_interface=ar + else + am_ar_try='$AR -NOLOGO -OUT:conftest.lib conftest.$ac_objext >&5' + { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$am_ar_try\""; } >&5 + (eval $am_ar_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if test "$ac_status" -eq 0; then + am_cv_ar_interface=lib + else + am_cv_ar_interface=unknown + fi + fi + rm -f conftest.lib libconftest.a + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_ar_interface" >&5 +$as_echo "$am_cv_ar_interface" >&6; } + +case $am_cv_ar_interface in +ar) + ;; +lib) + # Microsoft lib, so override with the ar-lib wrapper script. + # FIXME: It is wrong to rewrite AR. + # But if we don't then we get into trouble of one sort or another. + # A longer-term fix would be to have automake use am__AR in this case, + # and then we could set am__AR="$am_aux_dir/ar-lib \$(AR)" or something + # similar. + AR="$am_aux_dir/ar-lib $AR" + ;; +unknown) + as_fn_error $? "could not determine $AR interface" "$LINENO" 5 + ;; +esac + + + + + + +# Set options +# Check whether --enable-static was given. +if test "${enable_static+set}" = set; then : + enableval=$enable_static; p=${PACKAGE-default} + case $enableval in + yes) enable_static=yes ;; + no) enable_static=no ;; + *) + enable_static=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, + for pkg in $enableval; do + IFS=$lt_save_ifs + if test "X$pkg" = "X$p"; then + enable_static=yes + fi + done + IFS=$lt_save_ifs + ;; + esac +else + enable_static=no +fi + + + + + + + + +# Check whether --with-pic was given. +if test "${with_pic+set}" = set; then : + withval=$with_pic; lt_p=${PACKAGE-default} + case $withval in + yes|no) pic_mode=$withval ;; + *) + pic_mode=default + # Look at the argument we got. We use all the common list separators. + lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, + for lt_pkg in $withval; do + IFS=$lt_save_ifs + if test "X$lt_pkg" = "X$lt_p"; then + pic_mode=yes + fi + done + IFS=$lt_save_ifs + ;; + esac +else + pic_mode=yes +fi + + + + + + +enable_win32_dll=yes + +case $host in +*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-cegcc*) + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}as", so it can be a program name with args. +set dummy ${ac_tool_prefix}as; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AS+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AS"; then + ac_cv_prog_AS="$AS" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AS="${ac_tool_prefix}as" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AS=$ac_cv_prog_AS +if test -n "$AS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AS" >&5 +$as_echo "$AS" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_AS"; then + ac_ct_AS=$AS + # Extract the first word of "as", so it can be a program name with args. +set dummy as; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_AS+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AS"; then + ac_cv_prog_ac_ct_AS="$ac_ct_AS" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_AS="as" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AS=$ac_cv_prog_ac_ct_AS +if test -n "$ac_ct_AS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AS" >&5 +$as_echo "$ac_ct_AS" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_AS" = x; then + AS="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AS=$ac_ct_AS + fi +else + AS="$ac_cv_prog_AS" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}dlltool", so it can be a program name with args. +set dummy ${ac_tool_prefix}dlltool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_DLLTOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$DLLTOOL"; then + ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_DLLTOOL="${ac_tool_prefix}dlltool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +DLLTOOL=$ac_cv_prog_DLLTOOL +if test -n "$DLLTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DLLTOOL" >&5 +$as_echo "$DLLTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_DLLTOOL"; then + ac_ct_DLLTOOL=$DLLTOOL + # Extract the first word of "dlltool", so it can be a program name with args. +set dummy dlltool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_DLLTOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_DLLTOOL"; then + ac_cv_prog_ac_ct_DLLTOOL="$ac_ct_DLLTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_DLLTOOL="dlltool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_DLLTOOL=$ac_cv_prog_ac_ct_DLLTOOL +if test -n "$ac_ct_DLLTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DLLTOOL" >&5 +$as_echo "$ac_ct_DLLTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_DLLTOOL" = x; then + DLLTOOL="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + DLLTOOL=$ac_ct_DLLTOOL + fi +else + DLLTOOL="$ac_cv_prog_DLLTOOL" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args. +set dummy ${ac_tool_prefix}objdump; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_OBJDUMP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OBJDUMP"; then + ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OBJDUMP=$ac_cv_prog_OBJDUMP +if test -n "$OBJDUMP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OBJDUMP" >&5 +$as_echo "$OBJDUMP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OBJDUMP"; then + ac_ct_OBJDUMP=$OBJDUMP + # Extract the first word of "objdump", so it can be a program name with args. +set dummy objdump; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_OBJDUMP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OBJDUMP"; then + ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OBJDUMP="objdump" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP +if test -n "$ac_ct_OBJDUMP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OBJDUMP" >&5 +$as_echo "$ac_ct_OBJDUMP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OBJDUMP" = x; then + OBJDUMP="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OBJDUMP=$ac_ct_OBJDUMP + fi +else + OBJDUMP="$ac_cv_prog_OBJDUMP" +fi + + ;; +esac + +test -z "$AS" && AS=as + + + + + +test -z "$DLLTOOL" && DLLTOOL=dlltool + + + + + +test -z "$OBJDUMP" && OBJDUMP=objdump + + + + + + + + enable_dlopen=no + + + + # Check whether --enable-shared was given. +if test "${enable_shared+set}" = set; then : + enableval=$enable_shared; p=${PACKAGE-default} + case $enableval in + yes) enable_shared=yes ;; + no) enable_shared=no ;; + *) + enable_shared=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, + for pkg in $enableval; do + IFS=$lt_save_ifs + if test "X$pkg" = "X$p"; then + enable_shared=yes + fi + done + IFS=$lt_save_ifs + ;; + esac +else + enable_shared=yes +fi + + + + + + + + + + + + # Check whether --enable-fast-install was given. +if test "${enable_fast_install+set}" = set; then : + enableval=$enable_fast_install; p=${PACKAGE-default} + case $enableval in + yes) enable_fast_install=yes ;; + no) enable_fast_install=no ;; + *) + enable_fast_install=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, + for pkg in $enableval; do + IFS=$lt_save_ifs + if test "X$pkg" = "X$p"; then + enable_fast_install=yes + fi + done + IFS=$lt_save_ifs + ;; + esac +else + enable_fast_install=yes +fi + + + + + + + + + shared_archive_member_spec= +case $host,$enable_shared in +power*-*-aix[5-9]*,yes) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking which variant of shared library versioning to provide" >&5 +$as_echo_n "checking which variant of shared library versioning to provide... " >&6; } + +# Check whether --with-aix-soname was given. +if test "${with_aix_soname+set}" = set; then : + withval=$with_aix_soname; case $withval in + aix|svr4|both) + ;; + *) + as_fn_error $? "Unknown argument to --with-aix-soname" "$LINENO" 5 + ;; + esac + lt_cv_with_aix_soname=$with_aix_soname +else + if ${lt_cv_with_aix_soname+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_with_aix_soname=aix +fi + + with_aix_soname=$lt_cv_with_aix_soname +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $with_aix_soname" >&5 +$as_echo "$with_aix_soname" >&6; } + if test aix != "$with_aix_soname"; then + # For the AIX way of multilib, we name the shared archive member + # based on the bitwidth used, traditionally 'shr.o' or 'shr_64.o', + # and 'shr.imp' or 'shr_64.imp', respectively, for the Import File. + # Even when GNU compilers ignore OBJECT_MODE but need '-maix64' flag, + # the AIX toolchain works better with OBJECT_MODE set (default 32). + if test 64 = "${OBJECT_MODE-32}"; then + shared_archive_member_spec=shr_64 + else + shared_archive_member_spec=shr + fi + fi + ;; +*) + with_aix_soname=aix + ;; +esac + + + + + + + + + + +# This can be used to rebuild libtool when needed +LIBTOOL_DEPS=$ltmain + +# Always use our own libtool. +LIBTOOL='$(SHELL) $(top_builddir)/libtool' + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +test -z "$LN_S" && LN_S="ln -s" + + + + + + + + + + + + + + +if test -n "${ZSH_VERSION+set}"; then + setopt NO_GLOB_SUBST +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for objdir" >&5 +$as_echo_n "checking for objdir... " >&6; } +if ${lt_cv_objdir+:} false; then : + $as_echo_n "(cached) " >&6 +else + rm -f .libs 2>/dev/null +mkdir .libs 2>/dev/null +if test -d .libs; then + lt_cv_objdir=.libs +else + # MS-DOS does not allow filenames that begin with a dot. + lt_cv_objdir=_libs +fi +rmdir .libs 2>/dev/null +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_objdir" >&5 +$as_echo "$lt_cv_objdir" >&6; } +objdir=$lt_cv_objdir + + + + + +cat >>confdefs.h <<_ACEOF +#define LT_OBJDIR "$lt_cv_objdir/" +_ACEOF + + + + +case $host_os in +aix3*) + # AIX sometimes has problems with the GCC collect2 program. For some + # reason, if we set the COLLECT_NAMES environment variable, the problems + # vanish in a puff of smoke. + if test set != "${COLLECT_NAMES+set}"; then + COLLECT_NAMES= + export COLLECT_NAMES + fi + ;; +esac + +# Global variables: +ofile=libtool +can_build_shared=yes + +# All known linkers require a '.a' archive for static linking (except MSVC, +# which needs '.lib'). +libext=a + +with_gnu_ld=$lt_cv_prog_gnu_ld + +old_CC=$CC +old_CFLAGS=$CFLAGS + +# Set sane defaults for various variables +test -z "$CC" && CC=cc +test -z "$LTCC" && LTCC=$CC +test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS +test -z "$LD" && LD=ld +test -z "$ac_objext" && ac_objext=o + +func_cc_basename $compiler +cc_basename=$func_cc_basename_result + + +# Only perform the check for file, if the check method requires it +test -z "$MAGIC_CMD" && MAGIC_CMD=file +case $deplibs_check_method in +file_magic*) + if test "$file_magic_cmd" = '$MAGIC_CMD'; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${ac_tool_prefix}file" >&5 +$as_echo_n "checking for ${ac_tool_prefix}file... " >&6; } +if ${lt_cv_path_MAGIC_CMD+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $MAGIC_CMD in +[\\/*] | ?:[\\/]*) + lt_cv_path_MAGIC_CMD=$MAGIC_CMD # Let the user override the test with a path. + ;; +*) + lt_save_MAGIC_CMD=$MAGIC_CMD + lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR + ac_dummy="/usr/bin$PATH_SEPARATOR$PATH" + for ac_dir in $ac_dummy; do + IFS=$lt_save_ifs + test -z "$ac_dir" && ac_dir=. + if test -f "$ac_dir/${ac_tool_prefix}file"; then + lt_cv_path_MAGIC_CMD=$ac_dir/"${ac_tool_prefix}file" + if test -n "$file_magic_test_file"; then + case $deplibs_check_method in + "file_magic "*) + file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` + MAGIC_CMD=$lt_cv_path_MAGIC_CMD + if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | + $EGREP "$file_magic_regex" > /dev/null; then + : + else + cat <<_LT_EOF 1>&2 + +*** Warning: the command libtool uses to detect shared libraries, +*** $file_magic_cmd, produces output that libtool cannot recognize. +*** The result is that libtool may fail to recognize shared libraries +*** as such. This will affect the creation of libtool libraries that +*** depend on shared libraries, but programs linked with such libtool +*** libraries will work regardless of this problem. Nevertheless, you +*** may want to report the problem to your system manager and/or to +*** bug-libtool@gnu.org + +_LT_EOF + fi ;; + esac + fi + break + fi + done + IFS=$lt_save_ifs + MAGIC_CMD=$lt_save_MAGIC_CMD + ;; +esac +fi + +MAGIC_CMD=$lt_cv_path_MAGIC_CMD +if test -n "$MAGIC_CMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5 +$as_echo "$MAGIC_CMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + + +if test -z "$lt_cv_path_MAGIC_CMD"; then + if test -n "$ac_tool_prefix"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for file" >&5 +$as_echo_n "checking for file... " >&6; } +if ${lt_cv_path_MAGIC_CMD+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $MAGIC_CMD in +[\\/*] | ?:[\\/]*) + lt_cv_path_MAGIC_CMD=$MAGIC_CMD # Let the user override the test with a path. + ;; +*) + lt_save_MAGIC_CMD=$MAGIC_CMD + lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR + ac_dummy="/usr/bin$PATH_SEPARATOR$PATH" + for ac_dir in $ac_dummy; do + IFS=$lt_save_ifs + test -z "$ac_dir" && ac_dir=. + if test -f "$ac_dir/file"; then + lt_cv_path_MAGIC_CMD=$ac_dir/"file" + if test -n "$file_magic_test_file"; then + case $deplibs_check_method in + "file_magic "*) + file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` + MAGIC_CMD=$lt_cv_path_MAGIC_CMD + if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | + $EGREP "$file_magic_regex" > /dev/null; then + : + else + cat <<_LT_EOF 1>&2 + +*** Warning: the command libtool uses to detect shared libraries, +*** $file_magic_cmd, produces output that libtool cannot recognize. +*** The result is that libtool may fail to recognize shared libraries +*** as such. This will affect the creation of libtool libraries that +*** depend on shared libraries, but programs linked with such libtool +*** libraries will work regardless of this problem. Nevertheless, you +*** may want to report the problem to your system manager and/or to +*** bug-libtool@gnu.org + +_LT_EOF + fi ;; + esac + fi + break + fi + done + IFS=$lt_save_ifs + MAGIC_CMD=$lt_save_MAGIC_CMD + ;; +esac +fi + +MAGIC_CMD=$lt_cv_path_MAGIC_CMD +if test -n "$MAGIC_CMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5 +$as_echo "$MAGIC_CMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + else + MAGIC_CMD=: + fi +fi + + fi + ;; +esac + +# Use C for the default configuration in the libtool script + +lt_save_CC=$CC +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +# Source file extension for C test sources. +ac_ext=c + +# Object file extension for compiled C test sources. +objext=o +objext=$objext + +# Code to be used in simple compile tests +lt_simple_compile_test_code="int some_variable = 0;" + +# Code to be used in simple link tests +lt_simple_link_test_code='int main(){return(0);}' + + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + +# Save the default compiler, since it gets overwritten when the other +# tags are being tested, and _LT_TAGVAR(compiler, []) is a NOP. +compiler_DEFAULT=$CC + +# save warnings/boilerplate of simple test code +ac_outfile=conftest.$ac_objext +echo "$lt_simple_compile_test_code" >conftest.$ac_ext +eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_compiler_boilerplate=`cat conftest.err` +$RM conftest* + +ac_outfile=conftest.$ac_objext +echo "$lt_simple_link_test_code" >conftest.$ac_ext +eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_linker_boilerplate=`cat conftest.err` +$RM -r conftest* + + +if test -n "$compiler"; then + +lt_prog_compiler_no_builtin_flag= + +if test yes = "$GCC"; then + case $cc_basename in + nvcc*) + lt_prog_compiler_no_builtin_flag=' -Xcompiler -fno-builtin' ;; + *) + lt_prog_compiler_no_builtin_flag=' -fno-builtin' ;; + esac + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -fno-rtti -fno-exceptions" >&5 +$as_echo_n "checking if $compiler supports -fno-rtti -fno-exceptions... " >&6; } +if ${lt_cv_prog_compiler_rtti_exceptions+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_rtti_exceptions=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="-fno-rtti -fno-exceptions" ## exclude from sc_useless_quotes_in_assignment + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_rtti_exceptions=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_rtti_exceptions" >&5 +$as_echo "$lt_cv_prog_compiler_rtti_exceptions" >&6; } + +if test yes = "$lt_cv_prog_compiler_rtti_exceptions"; then + lt_prog_compiler_no_builtin_flag="$lt_prog_compiler_no_builtin_flag -fno-rtti -fno-exceptions" +else + : +fi + +fi + + + + + + + lt_prog_compiler_wl= +lt_prog_compiler_pic= +lt_prog_compiler_static= + + + if test yes = "$GCC"; then + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_static='-static' + + case $host_os in + aix*) + # All AIX code is PIC. + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static='-Bstatic' + fi + lt_prog_compiler_pic='-fPIC' + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + lt_prog_compiler_pic='-fPIC' + ;; + m68k) + # FIXME: we need at least 68020 code to build shared libraries, but + # adding the '-m68020' flag to GCC prevents building anything better, + # like '-m68040'. + lt_prog_compiler_pic='-m68020 -resident32 -malways-restore-a4' + ;; + esac + ;; + + beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) + # PIC is the default for these OSes. + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + # Although the cygwin gcc ignores -fPIC, still need this for old-style + # (--disable-auto-import) libraries + lt_prog_compiler_pic='-DDLL_EXPORT' + case $host_os in + os2*) + lt_prog_compiler_static='$wl-static' + ;; + esac + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic='-fno-common' + ;; + + haiku*) + # PIC is the default for Haiku. + # The "-static" flag exists, but is broken. + lt_prog_compiler_static= + ;; + + hpux*) + # PIC is the default for 64-bit PA HP-UX, but not for 32-bit + # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag + # sets the default TLS model and affects inlining. + case $host_cpu in + hppa*64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic='-fPIC' + ;; + esac + ;; + + interix[3-9]*) + # Interix 3.x gcc -fpic/-fPIC options generate broken code. + # Instead, we relocate shared libraries at runtime. + ;; + + msdosdjgpp*) + # Just because we use GCC doesn't mean we suddenly get shared libraries + # on systems that don't support them. + lt_prog_compiler_can_build_shared=no + enable_shared=no + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic='-fPIC -shared' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic=-Kconform_pic + fi + ;; + + *) + lt_prog_compiler_pic='-fPIC' + ;; + esac + + case $cc_basename in + nvcc*) # Cuda Compiler Driver 2.2 + lt_prog_compiler_wl='-Xlinker ' + if test -n "$lt_prog_compiler_pic"; then + lt_prog_compiler_pic="-Xcompiler $lt_prog_compiler_pic" + fi + ;; + esac + else + # PORTME Check for flag to pass linker flags through the system compiler. + case $host_os in + aix*) + lt_prog_compiler_wl='-Wl,' + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static='-Bstatic' + else + lt_prog_compiler_static='-bnso -bI:/lib/syscalls.exp' + fi + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic='-fno-common' + case $cc_basename in + nagfor*) + # NAG Fortran compiler + lt_prog_compiler_wl='-Wl,-Wl,,' + lt_prog_compiler_pic='-PIC' + lt_prog_compiler_static='-Bstatic' + ;; + esac + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + lt_prog_compiler_pic='-DDLL_EXPORT' + case $host_os in + os2*) + lt_prog_compiler_static='$wl-static' + ;; + esac + ;; + + hpux9* | hpux10* | hpux11*) + lt_prog_compiler_wl='-Wl,' + # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but + # not for PA HP-UX. + case $host_cpu in + hppa*64*|ia64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic='+Z' + ;; + esac + # Is there a better lt_prog_compiler_static that works with the bundled CC? + lt_prog_compiler_static='$wl-a ${wl}archive' + ;; + + irix5* | irix6* | nonstopux*) + lt_prog_compiler_wl='-Wl,' + # PIC (with -KPIC) is the default. + lt_prog_compiler_static='-non_shared' + ;; + + linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + case $cc_basename in + # old Intel for x86_64, which still supported -KPIC. + ecc*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-static' + ;; + # icc used to be incompatible with GCC. + # ICC 10 doesn't accept -KPIC any more. + icc* | ifort*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fPIC' + lt_prog_compiler_static='-static' + ;; + # Lahey Fortran 8.1. + lf95*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='--shared' + lt_prog_compiler_static='--static' + ;; + nagfor*) + # NAG Fortran compiler + lt_prog_compiler_wl='-Wl,-Wl,,' + lt_prog_compiler_pic='-PIC' + lt_prog_compiler_static='-Bstatic' + ;; + tcc*) + # Fabrice Bellard et al's Tiny C Compiler + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fPIC' + lt_prog_compiler_static='-static' + ;; + pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group compilers (*not* the Pentium gcc compiler, + # which looks to be a dead project) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fpic' + lt_prog_compiler_static='-Bstatic' + ;; + ccc*) + lt_prog_compiler_wl='-Wl,' + # All Alpha code is PIC. + lt_prog_compiler_static='-non_shared' + ;; + xl* | bgxl* | bgf* | mpixl*) + # IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-qpic' + lt_prog_compiler_static='-qstaticlink' + ;; + *) + case `$CC -V 2>&1 | sed 5q` in + *Sun\ Ceres\ Fortran* | *Sun*Fortran*\ [1-7].* | *Sun*Fortran*\ 8.[0-3]*) + # Sun Fortran 8.3 passes all unrecognized flags to the linker + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + lt_prog_compiler_wl='' + ;; + *Sun\ F* | *Sun*Fortran*) + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + lt_prog_compiler_wl='-Qoption ld ' + ;; + *Sun\ C*) + # Sun C 5.9 + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + lt_prog_compiler_wl='-Wl,' + ;; + *Intel*\ [CF]*Compiler*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fPIC' + lt_prog_compiler_static='-static' + ;; + *Portland\ Group*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fpic' + lt_prog_compiler_static='-Bstatic' + ;; + esac + ;; + esac + ;; + + newsos6) + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic='-fPIC -shared' + ;; + + osf3* | osf4* | osf5*) + lt_prog_compiler_wl='-Wl,' + # All OSF/1 code is PIC. + lt_prog_compiler_static='-non_shared' + ;; + + rdos*) + lt_prog_compiler_static='-non_shared' + ;; + + solaris*) + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + case $cc_basename in + f77* | f90* | f95* | sunf77* | sunf90* | sunf95*) + lt_prog_compiler_wl='-Qoption ld ';; + *) + lt_prog_compiler_wl='-Wl,';; + esac + ;; + + sunos4*) + lt_prog_compiler_wl='-Qoption ld ' + lt_prog_compiler_pic='-PIC' + lt_prog_compiler_static='-Bstatic' + ;; + + sysv4 | sysv4.2uw2* | sysv4.3*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic='-Kconform_pic' + lt_prog_compiler_static='-Bstatic' + fi + ;; + + sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + ;; + + unicos*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_can_build_shared=no + ;; + + uts4*) + lt_prog_compiler_pic='-pic' + lt_prog_compiler_static='-Bstatic' + ;; + + *) + lt_prog_compiler_can_build_shared=no + ;; + esac + fi + +case $host_os in + # For platforms that do not support PIC, -DPIC is meaningless: + *djgpp*) + lt_prog_compiler_pic= + ;; + *) + lt_prog_compiler_pic="$lt_prog_compiler_pic -DPIC" + ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5 +$as_echo_n "checking for $compiler option to produce PIC... " >&6; } +if ${lt_cv_prog_compiler_pic+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic=$lt_prog_compiler_pic +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic" >&5 +$as_echo "$lt_cv_prog_compiler_pic" >&6; } +lt_prog_compiler_pic=$lt_cv_prog_compiler_pic + +# +# Check to make sure the PIC flag actually works. +# +if test -n "$lt_prog_compiler_pic"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic works" >&5 +$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic works... " >&6; } +if ${lt_cv_prog_compiler_pic_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_works=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="$lt_prog_compiler_pic -DPIC" ## exclude from sc_useless_quotes_in_assignment + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_pic_works=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works" >&5 +$as_echo "$lt_cv_prog_compiler_pic_works" >&6; } + +if test yes = "$lt_cv_prog_compiler_pic_works"; then + case $lt_prog_compiler_pic in + "" | " "*) ;; + *) lt_prog_compiler_pic=" $lt_prog_compiler_pic" ;; + esac +else + lt_prog_compiler_pic= + lt_prog_compiler_can_build_shared=no +fi + +fi + + + + + + + + + + + +# +# Check to make sure the static flag actually works. +# +wl=$lt_prog_compiler_wl eval lt_tmp_static_flag=\"$lt_prog_compiler_static\" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5 +$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; } +if ${lt_cv_prog_compiler_static_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_static_works=no + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS $lt_tmp_static_flag" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_static_works=yes + fi + else + lt_cv_prog_compiler_static_works=yes + fi + fi + $RM -r conftest* + LDFLAGS=$save_LDFLAGS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works" >&5 +$as_echo "$lt_cv_prog_compiler_static_works" >&6; } + +if test yes = "$lt_cv_prog_compiler_static_works"; then + : +else + lt_prog_compiler_static= +fi + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5 +$as_echo "$lt_cv_prog_compiler_c_o" >&6; } + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5 +$as_echo "$lt_cv_prog_compiler_c_o" >&6; } + + + + +hard_links=nottested +if test no = "$lt_cv_prog_compiler_c_o" && test no != "$need_locks"; then + # do not overwrite the value of need_locks provided by the user + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5 +$as_echo_n "checking if we can lock with hard links... " >&6; } + hard_links=yes + $RM conftest* + ln conftest.a conftest.b 2>/dev/null && hard_links=no + touch conftest.a + ln conftest.a conftest.b 2>&5 || hard_links=no + ln conftest.a conftest.b 2>/dev/null && hard_links=no + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5 +$as_echo "$hard_links" >&6; } + if test no = "$hard_links"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&5 +$as_echo "$as_me: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&2;} + need_locks=warn + fi +else + need_locks=no +fi + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 +$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } + + runpath_var= + allow_undefined_flag= + always_export_symbols=no + archive_cmds= + archive_expsym_cmds= + compiler_needs_object=no + enable_shared_with_static_runtimes=no + export_dynamic_flag_spec= + export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' + hardcode_automatic=no + hardcode_direct=no + hardcode_direct_absolute=no + hardcode_libdir_flag_spec= + hardcode_libdir_separator= + hardcode_minus_L=no + hardcode_shlibpath_var=unsupported + inherit_rpath=no + link_all_deplibs=unknown + module_cmds= + module_expsym_cmds= + old_archive_from_new_cmds= + old_archive_from_expsyms_cmds= + thread_safe_flag_spec= + whole_archive_flag_spec= + # include_expsyms should be a list of space-separated symbols to be *always* + # included in the symbol list + include_expsyms= + # exclude_expsyms can be an extended regexp of symbols to exclude + # it will be wrapped by ' (' and ')$', so one must not match beginning or + # end of line. Example: 'a|bc|.*d.*' will exclude the symbols 'a' and 'bc', + # as well as any symbol that contains 'd'. + exclude_expsyms='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' + # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out + # platforms (ab)use it in PIC code, but their linkers get confused if + # the symbol is explicitly referenced. Since portable code cannot + # rely on this symbol name, it's probably fine to never include it in + # preloaded symbol tables. + # Exclude shared library initialization/finalization symbols. + extract_expsyms_cmds= + + case $host_os in + cygwin* | mingw* | pw32* | cegcc*) + # FIXME: the MSVC++ port hasn't been tested in a loooong time + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + if test yes != "$GCC"; then + with_gnu_ld=no + fi + ;; + interix*) + # we just hope/assume this is gcc and not c89 (= MSVC++) + with_gnu_ld=yes + ;; + openbsd* | bitrig*) + with_gnu_ld=no + ;; + esac + + ld_shlibs=yes + + # On some targets, GNU ld is compatible enough with the native linker + # that we're better off using the native interface for both. + lt_use_gnu_ld_interface=no + if test yes = "$with_gnu_ld"; then + case $host_os in + aix*) + # The AIX port of GNU ld has always aspired to compatibility + # with the native linker. However, as the warning in the GNU ld + # block says, versions before 2.19.5* couldn't really create working + # shared libraries, regardless of the interface used. + case `$LD -v 2>&1` in + *\ \(GNU\ Binutils\)\ 2.19.5*) ;; + *\ \(GNU\ Binutils\)\ 2.[2-9]*) ;; + *\ \(GNU\ Binutils\)\ [3-9]*) ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + fi + + if test yes = "$lt_use_gnu_ld_interface"; then + # If archive_cmds runs LD, not CC, wlarc should be empty + wlarc='$wl' + + # Set some defaults for GNU ld with shared library support. These + # are reset later if shared libraries are not supported. Putting them + # here allows them to be overridden if necessary. + runpath_var=LD_RUN_PATH + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + export_dynamic_flag_spec='$wl--export-dynamic' + # ancient GNU ld didn't support --whole-archive et. al. + if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then + whole_archive_flag_spec=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' + else + whole_archive_flag_spec= + fi + supports_anon_versioning=no + case `$LD -v | $SED -e 's/(^)\+)\s\+//' 2>&1` in + *GNU\ gold*) supports_anon_versioning=yes ;; + *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11 + *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... + *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... + *\ 2.11.*) ;; # other 2.11 versions + *) supports_anon_versioning=yes ;; + esac + + # See if GNU ld supports shared libraries. + case $host_os in + aix[3-9]*) + # On AIX/PPC, the GNU linker is very broken + if test ia64 != "$host_cpu"; then + ld_shlibs=no + cat <<_LT_EOF 1>&2 + +*** Warning: the GNU linker, at least up to release 2.19, is reported +*** to be unable to reliably create shared libraries on AIX. +*** Therefore, libtool is disabling shared libraries support. If you +*** really care for shared libraries, you may want to install binutils +*** 2.20 or above, or modify your PATH so that a non-GNU linker is found. +*** You will then need to restart the configuration process. + +_LT_EOF + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds='' + ;; + m68k) + archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + ;; + esac + ;; + + beos*) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + allow_undefined_flag=unsupported + # Joseph Beckenbach says some releases of gcc + # support --undefined. This deserves some investigation. FIXME + archive_cmds='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + else + ld_shlibs=no + fi + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # _LT_TAGVAR(hardcode_libdir_flag_spec, ) is actually meaningless, + # as there is no search path for DLLs. + hardcode_libdir_flag_spec='-L$libdir' + export_dynamic_flag_spec='$wl--export-all-symbols' + allow_undefined_flag=unsupported + always_export_symbols=no + enable_shared_with_static_runtimes=yes + export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/;s/^.*[ ]__nm__\([^ ]*\)[ ][^ ]*/\1 DATA/;/^I[ ]/d;/^[AITW][ ]/s/.* //'\'' | sort | uniq > $export_symbols' + exclude_expsyms='[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname' + + if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + # If the export-symbols file already is a .def file, use it as + # is; otherwise, prepend EXPORTS... + archive_expsym_cmds='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp $export_symbols $output_objdir/$soname.def; + else + echo EXPORTS > $output_objdir/$soname.def; + cat $export_symbols >> $output_objdir/$soname.def; + fi~ + $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + else + ld_shlibs=no + fi + ;; + + haiku*) + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + link_all_deplibs=yes + ;; + + os2*) + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + allow_undefined_flag=unsupported + shrext_cmds=.dll + archive_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + archive_expsym_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + prefix_cmds="$SED"~ + if test EXPORTS = "`$SED 1q $export_symbols`"; then + prefix_cmds="$prefix_cmds -e 1d"; + fi~ + prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ + cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + old_archive_From_new_cmds='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' + enable_shared_with_static_runtimes=yes + ;; + + interix[3-9]*) + hardcode_direct=no + hardcode_shlibpath_var=no + hardcode_libdir_flag_spec='$wl-rpath,$libdir' + export_dynamic_flag_spec='$wl-E' + # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. + # Instead, shared libraries are loaded at an image base (0x10000000 by + # default) and relocated if they conflict, which is a slow very memory + # consuming and fragmenting process. To avoid this, we pick a random, + # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link + # time. Moving up from 0x10000000 also allows more sbrk(2) space. + archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + archive_expsym_cmds='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + ;; + + gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) + tmp_diet=no + if test linux-dietlibc = "$host_os"; then + case $cc_basename in + diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn) + esac + fi + if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \ + && test no = "$tmp_diet" + then + tmp_addflag=' $pic_flag' + tmp_sharedflag='-shared' + case $cc_basename,$host_cpu in + pgcc*) # Portland Group C compiler + whole_archive_flag_spec='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + tmp_addflag=' $pic_flag' + ;; + pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group f77 and f90 compilers + whole_archive_flag_spec='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + tmp_addflag=' $pic_flag -Mnomain' ;; + ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 + tmp_addflag=' -i_dynamic' ;; + efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 + tmp_addflag=' -i_dynamic -nofor_main' ;; + ifc* | ifort*) # Intel Fortran compiler + tmp_addflag=' -nofor_main' ;; + lf95*) # Lahey Fortran 8.1 + whole_archive_flag_spec= + tmp_sharedflag='--shared' ;; + nagfor*) # NAGFOR 5.3 + tmp_sharedflag='-Wl,-shared' ;; + xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below) + tmp_sharedflag='-qmkshrobj' + tmp_addflag= ;; + nvcc*) # Cuda Compiler Driver 2.2 + whole_archive_flag_spec='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + compiler_needs_object=yes + ;; + esac + case `$CC -V 2>&1 | sed 5q` in + *Sun\ C*) # Sun C 5.9 + whole_archive_flag_spec='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + compiler_needs_object=yes + tmp_sharedflag='-G' ;; + *Sun\ F*) # Sun Fortran 8.3 + tmp_sharedflag='-G' ;; + esac + archive_cmds='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + + if test yes = "$supports_anon_versioning"; then + archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib' + fi + + case $cc_basename in + tcc*) + export_dynamic_flag_spec='-rdynamic' + ;; + xlf* | bgf* | bgxlf* | mpixlf*) + # IBM XL Fortran 10.1 on PPC cannot create shared libs itself + whole_archive_flag_spec='--whole-archive$convenience --no-whole-archive' + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + archive_cmds='$LD -shared $libobjs $deplibs $linker_flags -soname $soname -o $lib' + if test yes = "$supports_anon_versioning"; then + archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $LD -shared $libobjs $deplibs $linker_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib' + fi + ;; + esac + else + ld_shlibs=no + fi + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' + wlarc= + else + archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + fi + ;; + + solaris*) + if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then + ld_shlibs=no + cat <<_LT_EOF 1>&2 + +*** Warning: The releases 2.8.* of the GNU linker cannot reliably +*** create shared libraries on Solaris systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.9.1 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs=no + fi + ;; + + sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) + case `$LD -v 2>&1` in + *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) + ld_shlibs=no + cat <<_LT_EOF 1>&2 + +*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 cannot +*** reliably create shared libraries on SCO systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.16.91.0.3 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + ;; + *) + # For security reasons, it is highly recommended that you always + # use absolute paths for naming shared libraries, and exclude the + # DT_RUNPATH tag from executables and libraries. But doing so + # requires that you compile everything twice, which is a pain. + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs=no + fi + ;; + esac + ;; + + sunos4*) + archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' + wlarc= + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + *) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs=no + fi + ;; + esac + + if test no = "$ld_shlibs"; then + runpath_var= + hardcode_libdir_flag_spec= + export_dynamic_flag_spec= + whole_archive_flag_spec= + fi + else + # PORTME fill in a description of your system's linker (not GNU ld) + case $host_os in + aix3*) + allow_undefined_flag=unsupported + always_export_symbols=yes + archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' + # Note: this linker hardcodes the directories in LIBPATH if there + # are no directories specified by -L. + hardcode_minus_L=yes + if test yes = "$GCC" && test -z "$lt_prog_compiler_static"; then + # Neither direct hardcoding nor static linking is supported with a + # broken collect2. + hardcode_direct=unsupported + fi + ;; + + aix[4-9]*) + if test ia64 = "$host_cpu"; then + # On IA64, the linker does run time linking by default, so we don't + # have to do anything special. + aix_use_runtimelinking=no + exp_sym_flag='-Bexport' + no_entry_flag= + else + # If we're using GNU nm, then we don't want the "-C" option. + # -C means demangle to GNU nm, but means don't demangle to AIX nm. + # Without the "-l" option, or with the "-B" option, AIX nm treats + # weak defined symbols like other global defined symbols, whereas + # GNU nm marks them as "W". + # While the 'weak' keyword is ignored in the Export File, we need + # it in the Import File for the 'aix-soname' feature, so we have + # to replace the "-B" option with "-P" for AIX nm. + if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then + export_symbols_cmds='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols' + else + export_symbols_cmds='`func_echo_all $NM | $SED -e '\''s/B\([^B]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && (substr(\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols' + fi + aix_use_runtimelinking=no + + # Test if we are trying to use run time linking or normal + # AIX style linking. If -brtl is somewhere in LDFLAGS, we + # have runtime linking enabled, and use it for executables. + # For shared libraries, we enable/disable runtime linking + # depending on the kind of the shared library created - + # when "with_aix_soname,aix_use_runtimelinking" is: + # "aix,no" lib.a(lib.so.V) shared, rtl:no, for executables + # "aix,yes" lib.so shared, rtl:yes, for executables + # lib.a static archive + # "both,no" lib.so.V(shr.o) shared, rtl:yes + # lib.a(lib.so.V) shared, rtl:no, for executables + # "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a(lib.so.V) shared, rtl:no + # "svr4,*" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a static archive + case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) + for ld_flag in $LDFLAGS; do + if (test x-brtl = "x$ld_flag" || test x-Wl,-brtl = "x$ld_flag"); then + aix_use_runtimelinking=yes + break + fi + done + if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then + # With aix-soname=svr4, we create the lib.so.V shared archives only, + # so we don't have lib.a shared libs to link our executables. + # We have to force runtime linking in this case. + aix_use_runtimelinking=yes + LDFLAGS="$LDFLAGS -Wl,-brtl" + fi + ;; + esac + + exp_sym_flag='-bexport' + no_entry_flag='-bnoentry' + fi + + # When large executables or shared objects are built, AIX ld can + # have problems creating the table of contents. If linking a library + # or program results in "error TOC overflow" add -mminimal-toc to + # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not + # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. + + archive_cmds='' + hardcode_direct=yes + hardcode_direct_absolute=yes + hardcode_libdir_separator=':' + link_all_deplibs=yes + file_list_spec='$wl-f,' + case $with_aix_soname,$aix_use_runtimelinking in + aix,*) ;; # traditional, no import file + svr4,* | *,yes) # use import file + # The Import File defines what to hardcode. + hardcode_direct=no + hardcode_direct_absolute=no + ;; + esac + + if test yes = "$GCC"; then + case $host_os in aix4.[012]|aix4.[012].*) + # We only want to do this on AIX 4.2 and lower, the check + # below for broken collect2 doesn't work under 4.3+ + collect2name=`$CC -print-prog-name=collect2` + if test -f "$collect2name" && + strings "$collect2name" | $GREP resolve_lib_name >/dev/null + then + # We have reworked collect2 + : + else + # We have old collect2 + hardcode_direct=unsupported + # It fails to find uninstalled libraries when the uninstalled + # path is not listed in the libpath. Setting hardcode_minus_L + # to unsupported forces relinking + hardcode_minus_L=yes + hardcode_libdir_flag_spec='-L$libdir' + hardcode_libdir_separator= + fi + ;; + esac + shared_flag='-shared' + if test yes = "$aix_use_runtimelinking"; then + shared_flag="$shared_flag "'$wl-G' + fi + # Need to ensure runtime linking is disabled for the traditional + # shared library, or the linker may eventually find shared libraries + # /with/ Import File - we do not want to mix them. + shared_flag_aix='-shared' + shared_flag_svr4='-shared $wl-G' + else + # not using gcc + if test ia64 = "$host_cpu"; then + # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release + # chokes on -Wl,-G. The following line is correct: + shared_flag='-G' + else + if test yes = "$aix_use_runtimelinking"; then + shared_flag='$wl-G' + else + shared_flag='$wl-bM:SRE' + fi + shared_flag_aix='$wl-bM:SRE' + shared_flag_svr4='$wl-G' + fi + fi + + export_dynamic_flag_spec='$wl-bexpall' + # It seems that -bexpall does not export symbols beginning with + # underscore (_), so it is better to generate a list of symbols to export. + always_export_symbols=yes + if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then + # Warning - without using the other runtime loading flags (-brtl), + # -berok will link without error, but may produce a broken library. + allow_undefined_flag='-berok' + # Determine the default libpath from the value encoded in an + # empty executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath_+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath_=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath_"; then + lt_cv_aix_libpath_=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath_"; then + lt_cv_aix_libpath_=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath_ +fi + + hardcode_libdir_flag_spec='$wl-blibpath:$libdir:'"$aix_libpath" + archive_expsym_cmds='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag + else + if test ia64 = "$host_cpu"; then + hardcode_libdir_flag_spec='$wl-R $libdir:/usr/lib:/lib' + allow_undefined_flag="-z nodefs" + archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols" + else + # Determine the default libpath from the value encoded in an + # empty executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath_+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath_=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath_"; then + lt_cv_aix_libpath_=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath_"; then + lt_cv_aix_libpath_=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath_ +fi + + hardcode_libdir_flag_spec='$wl-blibpath:$libdir:'"$aix_libpath" + # Warning - without using the other run time loading flags, + # -berok will link without error, but may produce a broken library. + no_undefined_flag=' $wl-bernotok' + allow_undefined_flag=' $wl-berok' + if test yes = "$with_gnu_ld"; then + # We only use this code for GNU lds that support --whole-archive. + whole_archive_flag_spec='$wl--whole-archive$convenience $wl--no-whole-archive' + else + # Exported symbols can be pulled into shared objects from archives + whole_archive_flag_spec='$convenience' + fi + archive_cmds_need_lc=yes + archive_expsym_cmds='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d' + # -brtl affects multiple linker settings, -berok does not and is overridden later + compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([, ]\\)%-berok\\1%g"`' + if test svr4 != "$with_aix_soname"; then + # This is similar to how AIX traditionally builds its shared libraries. + archive_expsym_cmds="$archive_expsym_cmds"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname' + fi + if test aix != "$with_aix_soname"; then + archive_expsym_cmds="$archive_expsym_cmds"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp' + else + # used by -dlpreopen to get the symbols + archive_expsym_cmds="$archive_expsym_cmds"'~$MV $output_objdir/$realname.d/$soname $output_objdir' + fi + archive_expsym_cmds="$archive_expsym_cmds"'~$RM -r $output_objdir/$realname.d' + fi + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds='' + ;; + m68k) + archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + ;; + esac + ;; + + bsdi[45]*) + export_dynamic_flag_spec=-rdynamic + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++ or Intel C++/Fortran Compiler. + # hardcode_libdir_flag_spec is actually meaningless, as there is + # no search path for DLLs. + case $cc_basename in + cl* | icl*| ifort*) + # Native MSVC or ICC or IFORT + hardcode_libdir_flag_spec=' ' + allow_undefined_flag=unsupported + always_export_symbols=yes + file_list_spec='@' + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=.dll + # FIXME: Setting linknames here is a bad hack. + archive_cmds='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames=' + archive_expsym_cmds='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp "$export_symbols" "$output_objdir/$soname.def"; + echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp"; + else + $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp; + fi~ + $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~ + linknames=' + # The linker will not automatically build a static lib if we build a DLL. + # _LT_TAGVAR(old_archive_from_new_cmds, )='true' + enable_shared_with_static_runtimes=yes + exclude_expsyms='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*' + export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1,DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols' + # Don't use ranlib + old_postinstall_cmds='chmod 644 $oldlib' + postlink_cmds='lt_outputfile="@OUTPUT@"~ + lt_tool_outputfile="@TOOL_OUTPUT@"~ + case $lt_outputfile in + *.exe|*.EXE) ;; + *) + lt_outputfile=$lt_outputfile.exe + lt_tool_outputfile=$lt_tool_outputfile.exe + ;; + esac~ + if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then + $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1; + $RM "$lt_outputfile.manifest"; + fi' + ;; + *) + # Assume MSVC and ICC and IFORT wrapper + hardcode_libdir_flag_spec=' ' + allow_undefined_flag=unsupported + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=.dll + # FIXME: Setting linknames here is a bad hack. + archive_cmds='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames=' + # The linker will automatically build a .lib file if we build a DLL. + old_archive_from_new_cmds='true' + # FIXME: Should let the user specify the lib program. + old_archive_cmds='lib -OUT:$oldlib$oldobjs$old_deplibs' + enable_shared_with_static_runtimes=yes + ;; + esac + ;; + + darwin* | rhapsody*) + + + archive_cmds_need_lc=no + hardcode_direct=no + hardcode_automatic=yes + hardcode_shlibpath_var=unsupported + if test yes = "$lt_cv_ld_force_load"; then + whole_archive_flag_spec='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience $wl-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`' + + else + whole_archive_flag_spec='' + fi + link_all_deplibs=yes + allow_undefined_flag=$_lt_dar_allow_undefined + case $cc_basename in + ifort*|nagfor*) _lt_dar_can_shared=yes ;; + *) _lt_dar_can_shared=$GCC ;; + esac + if test yes = "$_lt_dar_can_shared"; then + output_verbose_link_cmd=func_echo_all + archive_cmds="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dsymutil" + module_cmds="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dsymutil" + archive_expsym_cmds="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dar_export_syms$_lt_dsymutil" + module_expsym_cmds="sed -e 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dar_export_syms$_lt_dsymutil" + + else + ld_shlibs=no + fi + + ;; + + dgux*) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_shlibpath_var=no + ;; + + # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor + # support. Future versions do this automatically, but an explicit c++rt0.o + # does not break anything, and helps significantly (at the cost of a little + # extra space). + freebsd2.2*) + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' + hardcode_libdir_flag_spec='-R$libdir' + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + # Unfortunately, older versions of FreeBSD 2 do not have this feature. + freebsd2.*) + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=yes + hardcode_minus_L=yes + hardcode_shlibpath_var=no + ;; + + # FreeBSD 3 and greater uses gcc -shared to do shared libraries. + freebsd* | dragonfly*) + archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec='-R$libdir' + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + hpux9*) + if test yes = "$GCC"; then + archive_cmds='$RM $output_objdir/$soname~$CC -shared $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + else + archive_cmds='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + fi + hardcode_libdir_flag_spec='$wl+b $wl$libdir' + hardcode_libdir_separator=: + hardcode_direct=yes + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L=yes + export_dynamic_flag_spec='$wl-E' + ;; + + hpux10*) + if test yes,no = "$GCC,$with_gnu_ld"; then + archive_cmds='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' + fi + if test no = "$with_gnu_ld"; then + hardcode_libdir_flag_spec='$wl+b $wl$libdir' + hardcode_libdir_separator=: + hardcode_direct=yes + hardcode_direct_absolute=yes + export_dynamic_flag_spec='$wl-E' + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L=yes + fi + ;; + + hpux11*) + if test yes,no = "$GCC,$with_gnu_ld"; then + case $host_cpu in + hppa*64*) + archive_cmds='$CC -shared $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds='$CC -shared $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + else + case $host_cpu in + hppa*64*) + archive_cmds='$CC -b $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + + # Older versions of the 11.00 compiler do not understand -b yet + # (HP92453-01 A.11.01.20 doesn't, HP92453-01 B.11.X.35175-35176.GP does) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $CC understands -b" >&5 +$as_echo_n "checking if $CC understands -b... " >&6; } +if ${lt_cv_prog_compiler__b+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler__b=no + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS -b" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler__b=yes + fi + else + lt_cv_prog_compiler__b=yes + fi + fi + $RM -r conftest* + LDFLAGS=$save_LDFLAGS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler__b" >&5 +$as_echo "$lt_cv_prog_compiler__b" >&6; } + +if test yes = "$lt_cv_prog_compiler__b"; then + archive_cmds='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' +else + archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' +fi + + ;; + esac + fi + if test no = "$with_gnu_ld"; then + hardcode_libdir_flag_spec='$wl+b $wl$libdir' + hardcode_libdir_separator=: + + case $host_cpu in + hppa*64*|ia64*) + hardcode_direct=no + hardcode_shlibpath_var=no + ;; + *) + hardcode_direct=yes + hardcode_direct_absolute=yes + export_dynamic_flag_spec='$wl-E' + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L=yes + ;; + esac + fi + ;; + + irix5* | irix6* | nonstopux*) + if test yes = "$GCC"; then + archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + # Try to use the -exported_symbol ld option, if it does not + # work, assume that -exports_file does not work either and + # implicitly export all symbols. + # This should be the same for all languages, so no per-tag cache variable. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $host_os linker accepts -exported_symbol" >&5 +$as_echo_n "checking whether the $host_os linker accepts -exported_symbol... " >&6; } +if ${lt_cv_irix_exported_symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS -shared $wl-exported_symbol ${wl}foo $wl-update_registry $wl/dev/null" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +int foo (void) { return 0; } +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + lt_cv_irix_exported_symbol=yes +else + lt_cv_irix_exported_symbol=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_irix_exported_symbol" >&5 +$as_echo "$lt_cv_irix_exported_symbol" >&6; } + if test yes = "$lt_cv_irix_exported_symbol"; then + archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations $wl-exports_file $wl$export_symbols -o $lib' + fi + else + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -exports_file $export_symbols -o $lib' + fi + archive_cmds_need_lc='no' + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + hardcode_libdir_separator=: + inherit_rpath=yes + link_all_deplibs=yes + ;; + + linux*) + case $cc_basename in + tcc*) + # Fabrice Bellard et al's Tiny C Compiler + ld_shlibs=yes + archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out + else + archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF + fi + hardcode_libdir_flag_spec='-R$libdir' + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + newsos6) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=yes + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + hardcode_libdir_separator=: + hardcode_shlibpath_var=no + ;; + + *nto* | *qnx*) + ;; + + openbsd* | bitrig*) + if test -f /usr/libexec/ld.so; then + hardcode_direct=yes + hardcode_shlibpath_var=no + hardcode_direct_absolute=yes + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags $wl-retain-symbols-file,$export_symbols' + hardcode_libdir_flag_spec='$wl-rpath,$libdir' + export_dynamic_flag_spec='$wl-E' + else + archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec='$wl-rpath,$libdir' + fi + else + ld_shlibs=no + fi + ;; + + os2*) + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + allow_undefined_flag=unsupported + shrext_cmds=.dll + archive_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + archive_expsym_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + prefix_cmds="$SED"~ + if test EXPORTS = "`$SED 1q $export_symbols`"; then + prefix_cmds="$prefix_cmds -e 1d"; + fi~ + prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ + cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + old_archive_From_new_cmds='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' + enable_shared_with_static_runtimes=yes + ;; + + osf3*) + if test yes = "$GCC"; then + allow_undefined_flag=' $wl-expect_unresolved $wl\*' + archive_cmds='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + else + allow_undefined_flag=' -expect_unresolved \*' + archive_cmds='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + fi + archive_cmds_need_lc='no' + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + hardcode_libdir_separator=: + ;; + + osf4* | osf5*) # as osf3* with the addition of -msym flag + if test yes = "$GCC"; then + allow_undefined_flag=' $wl-expect_unresolved $wl\*' + archive_cmds='$CC -shared$allow_undefined_flag $pic_flag $libobjs $deplibs $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' + else + allow_undefined_flag=' -expect_unresolved \*' + archive_cmds='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + archive_expsym_cmds='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~ + $CC -shared$allow_undefined_flag $wl-input $wl$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~$RM $lib.exp' + + # Both c and cxx compiler support -rpath directly + hardcode_libdir_flag_spec='-rpath $libdir' + fi + archive_cmds_need_lc='no' + hardcode_libdir_separator=: + ;; + + solaris*) + no_undefined_flag=' -z defs' + if test yes = "$GCC"; then + wlarc='$wl' + archive_cmds='$CC -shared $pic_flag $wl-z ${wl}text $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -shared $pic_flag $wl-z ${wl}text $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + else + case `$CC -V 2>&1` in + *"Compilers 5.0"*) + wlarc='' + archive_cmds='$LD -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $linker_flags' + archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $LD -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp' + ;; + *) + wlarc='$wl' + archive_cmds='$CC -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + ;; + esac + fi + hardcode_libdir_flag_spec='-R$libdir' + hardcode_shlibpath_var=no + case $host_os in + solaris2.[0-5] | solaris2.[0-5].*) ;; + *) + # The compiler driver will combine and reorder linker options, + # but understands '-z linker_flag'. GCC discards it without '$wl', + # but is careful enough not to reorder. + # Supported since Solaris 2.6 (maybe 2.5.1?) + if test yes = "$GCC"; then + whole_archive_flag_spec='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract' + else + whole_archive_flag_spec='-z allextract$convenience -z defaultextract' + fi + ;; + esac + link_all_deplibs=yes + ;; + + sunos4*) + if test sequent = "$host_vendor"; then + # Use $CC to link under sequent, because it throws in some extra .o + # files that make .init and .fini sections work. + archive_cmds='$CC -G $wl-h $soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' + fi + hardcode_libdir_flag_spec='-L$libdir' + hardcode_direct=yes + hardcode_minus_L=yes + hardcode_shlibpath_var=no + ;; + + sysv4) + case $host_vendor in + sni) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=yes # is this really true??? + ;; + siemens) + ## LD is ld it makes a PLAMLIB + ## CC just makes a GrossModule. + archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags' + reload_cmds='$CC -r -o $output$reload_objs' + hardcode_direct=no + ;; + motorola) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=no #Motorola manual says yes, but my tests say they lie + ;; + esac + runpath_var='LD_RUN_PATH' + hardcode_shlibpath_var=no + ;; + + sysv4.3*) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var=no + export_dynamic_flag_spec='-Bexport' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var=no + runpath_var=LD_RUN_PATH + hardcode_runpath_var=yes + ld_shlibs=yes + fi + ;; + + sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) + no_undefined_flag='$wl-z,text' + archive_cmds_need_lc=no + hardcode_shlibpath_var=no + runpath_var='LD_RUN_PATH' + + if test yes = "$GCC"; then + archive_cmds='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + sysv5* | sco3.2v5* | sco5v6*) + # Note: We CANNOT use -z defs as we might desire, because we do not + # link with -lc, and that would cause any symbols used from libc to + # always be unresolved, which means just about no library would + # ever link correctly. If we're not using GNU ld we use -z text + # though, which does catch some bad symbols but isn't as heavy-handed + # as -z defs. + no_undefined_flag='$wl-z,text' + allow_undefined_flag='$wl-z,nodefs' + archive_cmds_need_lc=no + hardcode_shlibpath_var=no + hardcode_libdir_flag_spec='$wl-R,$libdir' + hardcode_libdir_separator=':' + link_all_deplibs=yes + export_dynamic_flag_spec='$wl-Bexport' + runpath_var='LD_RUN_PATH' + + if test yes = "$GCC"; then + archive_cmds='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + uts4*) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_shlibpath_var=no + ;; + + *) + ld_shlibs=no + ;; + esac + + if test sni = "$host_vendor"; then + case $host in + sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) + export_dynamic_flag_spec='$wl-Blargedynsym' + ;; + esac + fi + fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs" >&5 +$as_echo "$ld_shlibs" >&6; } +test no = "$ld_shlibs" && can_build_shared=no + +with_gnu_ld=$with_gnu_ld + + + + + + + + + + + + + + + +# +# Do we need to explicitly link libc? +# +case "x$archive_cmds_need_lc" in +x|xyes) + # Assume -lc should be added + archive_cmds_need_lc=yes + + if test yes,yes = "$GCC,$enable_shared"; then + case $archive_cmds in + *'~'*) + # FIXME: we may have to deal with multi-command sequences. + ;; + '$CC '*) + # Test whether the compiler implicitly links with -lc since on some + # systems, -lgcc has to come before -lc. If gcc already passes -lc + # to ld, don't add -lc before -lgcc. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5 +$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; } +if ${lt_cv_archive_cmds_need_lc+:} false; then : + $as_echo_n "(cached) " >&6 +else + $RM conftest* + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } 2>conftest.err; then + soname=conftest + lib=conftest + libobjs=conftest.$ac_objext + deplibs= + wl=$lt_prog_compiler_wl + pic_flag=$lt_prog_compiler_pic + compiler_flags=-v + linker_flags=-v + verstring= + output_objdir=. + libname=conftest + lt_save_allow_undefined_flag=$allow_undefined_flag + allow_undefined_flag= + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5 + (eval $archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + then + lt_cv_archive_cmds_need_lc=no + else + lt_cv_archive_cmds_need_lc=yes + fi + allow_undefined_flag=$lt_save_allow_undefined_flag + else + cat conftest.err 1>&5 + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc" >&5 +$as_echo "$lt_cv_archive_cmds_need_lc" >&6; } + archive_cmds_need_lc=$lt_cv_archive_cmds_need_lc + ;; + esac + fi + ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5 +$as_echo_n "checking dynamic linker characteristics... " >&6; } + +if test yes = "$GCC"; then + case $host_os in + darwin*) lt_awk_arg='/^libraries:/,/LR/' ;; + *) lt_awk_arg='/^libraries:/' ;; + esac + case $host_os in + mingw* | cegcc*) lt_sed_strip_eq='s|=\([A-Za-z]:\)|\1|g' ;; + *) lt_sed_strip_eq='s|=/|/|g' ;; + esac + lt_search_path_spec=`$CC -print-search-dirs | awk $lt_awk_arg | $SED -e "s/^libraries://" -e $lt_sed_strip_eq` + case $lt_search_path_spec in + *\;*) + # if the path contains ";" then we assume it to be the separator + # otherwise default to the standard path separator (i.e. ":") - it is + # assumed that no part of a normal pathname contains ";" but that should + # okay in the real world where ";" in dirpaths is itself problematic. + lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED 's/;/ /g'` + ;; + *) + lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED "s/$PATH_SEPARATOR/ /g"` + ;; + esac + # Ok, now we have the path, separated by spaces, we can step through it + # and add multilib dir if necessary... + lt_tmp_lt_search_path_spec= + lt_multi_os_dir=/`$CC $CPPFLAGS $CFLAGS $LDFLAGS -print-multi-os-directory 2>/dev/null` + # ...but if some path component already ends with the multilib dir we assume + # that all is fine and trust -print-search-dirs as is (GCC 4.2? or newer). + case "$lt_multi_os_dir; $lt_search_path_spec " in + "/; "* | "/.; "* | "/./; "* | *"$lt_multi_os_dir "* | *"$lt_multi_os_dir/ "*) + lt_multi_os_dir= + ;; + esac + for lt_sys_path in $lt_search_path_spec; do + if test -d "$lt_sys_path$lt_multi_os_dir"; then + lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path$lt_multi_os_dir" + elif test -n "$lt_multi_os_dir"; then + test -d "$lt_sys_path" && \ + lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path" + fi + done + lt_search_path_spec=`$ECHO "$lt_tmp_lt_search_path_spec" | awk ' +BEGIN {RS = " "; FS = "/|\n";} { + lt_foo = ""; + lt_count = 0; + for (lt_i = NF; lt_i > 0; lt_i--) { + if ($lt_i != "" && $lt_i != ".") { + if ($lt_i == "..") { + lt_count++; + } else { + if (lt_count == 0) { + lt_foo = "/" $lt_i lt_foo; + } else { + lt_count--; + } + } + } + } + if (lt_foo != "") { lt_freq[lt_foo]++; } + if (lt_freq[lt_foo] == 1) { print lt_foo; } +}'` + # AWK program above erroneously prepends '/' to C:/dos/paths + # for these hosts. + case $host_os in + mingw* | cegcc*) lt_search_path_spec=`$ECHO "$lt_search_path_spec" |\ + $SED 's|/\([A-Za-z]:\)|\1|g'` ;; + esac + sys_lib_search_path_spec=`$ECHO "$lt_search_path_spec" | $lt_NL2SP` +else + sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" +fi +library_names_spec= +libname_spec='lib$name' +soname_spec= +shrext_cmds=.so +postinstall_cmds= +postuninstall_cmds= +finish_cmds= +finish_eval= +shlibpath_var= +shlibpath_overrides_runpath=unknown +version_type=none +dynamic_linker="$host_os ld.so" +sys_lib_dlsearch_path_spec="/lib /usr/lib" +need_lib_prefix=unknown +hardcode_into_libs=no + +# when you set need_version to no, make sure it does not cause -set_version +# flags to be left without arguments +need_version=unknown + + + +case $host_os in +aix3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname.a' + shlibpath_var=LIBPATH + + # AIX 3 has no versioning support, so we append a major version to the name. + soname_spec='$libname$release$shared_ext$major' + ;; + +aix[4-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + hardcode_into_libs=yes + if test ia64 = "$host_cpu"; then + # AIX 5 supports IA64 + library_names_spec='$libname$release$shared_ext$major $libname$release$shared_ext$versuffix $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + else + # With GCC up to 2.95.x, collect2 would create an import file + # for dependence libraries. The import file would start with + # the line '#! .'. This would cause the generated library to + # depend on '.', always an invalid library. This was fixed in + # development snapshots of GCC prior to 3.0. + case $host_os in + aix4 | aix4.[01] | aix4.[01].*) + if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' + echo ' yes ' + echo '#endif'; } | $CC -E - | $GREP yes > /dev/null; then + : + else + can_build_shared=no + fi + ;; + esac + # Using Import Files as archive members, it is possible to support + # filename-based versioning of shared library archives on AIX. While + # this would work for both with and without runtime linking, it will + # prevent static linking of such archives. So we do filename-based + # shared library versioning with .so extension only, which is used + # when both runtime linking and shared linking is enabled. + # Unfortunately, runtime linking may impact performance, so we do + # not want this to be the default eventually. Also, we use the + # versioned .so libs for executables only if there is the -brtl + # linker flag in LDFLAGS as well, or --with-aix-soname=svr4 only. + # To allow for filename-based versioning support, we need to create + # libNAME.so.V as an archive file, containing: + # *) an Import File, referring to the versioned filename of the + # archive as well as the shared archive member, telling the + # bitwidth (32 or 64) of that shared object, and providing the + # list of exported symbols of that shared object, eventually + # decorated with the 'weak' keyword + # *) the shared object with the F_LOADONLY flag set, to really avoid + # it being seen by the linker. + # At run time we better use the real file rather than another symlink, + # but for link time we create the symlink libNAME.so -> libNAME.so.V + + case $with_aix_soname,$aix_use_runtimelinking in + # AIX (on Power*) has no versioning support, so currently we cannot hardcode correct + # soname into executable. Probably we can add versioning support to + # collect2, so additional links can be useful in future. + aix,yes) # traditional libtool + dynamic_linker='AIX unversionable lib.so' + # If using run time linking (on AIX 4.2 or later) use lib.so + # instead of lib.a to let people know that these are not + # typical AIX shared libraries. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + aix,no) # traditional AIX only + dynamic_linker='AIX lib.a(lib.so.V)' + # We preserve .a as extension for shared libraries through AIX4.2 + # and later when we are not doing run time linking. + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + ;; + svr4,*) # full svr4 only + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,yes) # both, prefer svr4 + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o), lib.a(lib.so.V)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # unpreferred sharedlib libNAME.a needs extra handling + postinstall_cmds='test -n "$linkname" || linkname="$realname"~func_stripname "" ".so" "$linkname"~$install_shared_prog "$dir/$func_stripname_result.$libext" "$destdir/$func_stripname_result.$libext"~test -z "$tstripme" || test -z "$striplib" || $striplib "$destdir/$func_stripname_result.$libext"' + postuninstall_cmds='for n in $library_names $old_library; do :; done~func_stripname "" ".so" "$n"~test "$func_stripname_result" = "$n" || func_append rmfiles " $odir/$func_stripname_result.$libext"' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,no) # both, prefer aix + dynamic_linker="AIX lib.a(lib.so.V), lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + # unpreferred sharedlib libNAME.so.V and symlink libNAME.so need extra handling + postinstall_cmds='test -z "$dlname" || $install_shared_prog $dir/$dlname $destdir/$dlname~test -z "$tstripme" || test -z "$striplib" || $striplib $destdir/$dlname~test -n "$linkname" || linkname=$realname~func_stripname "" ".a" "$linkname"~(cd "$destdir" && $LN_S -f $dlname $func_stripname_result.so)' + postuninstall_cmds='test -z "$dlname" || func_append rmfiles " $odir/$dlname"~for n in $old_library $library_names; do :; done~func_stripname "" ".a" "$n"~func_append rmfiles " $odir/$func_stripname_result.so"' + ;; + esac + shlibpath_var=LIBPATH + fi + ;; + +amigaos*) + case $host_cpu in + powerpc) + # Since July 2007 AmigaOS4 officially supports .so libraries. + # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + m68k) + library_names_spec='$libname.ixlibrary $libname.a' + # Create ${libname}_ixlibrary.a entries in /sys/libs. + finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' + ;; + esac + ;; + +beos*) + library_names_spec='$libname$shared_ext' + dynamic_linker="$host_os ld.so" + shlibpath_var=LIBRARY_PATH + ;; + +bsdi[45]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" + sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" + # the default ld.so.conf also contains /usr/contrib/lib and + # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow + # libtool to hard-code these into programs + ;; + +cygwin* | mingw* | pw32* | cegcc*) + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + + case $GCC,$cc_basename in + yes,*) + # gcc + library_names_spec='$libname.dll.a' + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + + case $host_os in + cygwin*) + # Cygwin DLLs use 'cyg' prefix rather than 'lib' + soname_spec='`echo $libname | sed -e 's/^lib/cyg/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + + sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/lib/w32api" + ;; + mingw* | cegcc*) + # MinGW DLLs use traditional 'lib' prefix + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + pw32*) + # pw32 DLLs use 'pw' prefix rather than 'lib' + library_names_spec='`echo $libname | sed -e 's/^lib/pw/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + esac + dynamic_linker='Win32 ld.exe' + ;; + + *,cl* | *,icl* | *,ifort*) + # Native MSVC or ICC or IFORT + libname_spec='$name' + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + library_names_spec='$libname.dll.lib' + + case $build_os in + mingw*) + sys_lib_search_path_spec= + lt_save_ifs=$IFS + IFS=';' + for lt_path in $LIB + do + IFS=$lt_save_ifs + # Let DOS variable expansion print the short 8.3 style file name. + lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"` + sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path" + done + IFS=$lt_save_ifs + # Convert to MSYS style. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([a-zA-Z]\\):| /\\1|g' -e 's|^ ||'` + ;; + cygwin*) + # Convert to unix form, then to dos form, then back to unix form + # but this time dos style (no spaces!) so that the unix form looks + # like /cygdrive/c/PROGRA~1:/cygdr... + sys_lib_search_path_spec=`cygpath --path --unix "$LIB"` + sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null` + sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + ;; + *) + sys_lib_search_path_spec=$LIB + if $ECHO "$sys_lib_search_path_spec" | $GREP ';[c-zC-Z]:/' >/dev/null; then + # It is most probably a Windows format PATH. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` + else + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + fi + # FIXME: find the short name or the path components, as spaces are + # common. (e.g. "Program Files" -> "PROGRA~1") + ;; + esac + + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + dynamic_linker='Win32 link.exe' + ;; + + *) + # Assume MSVC wrapper + library_names_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext $libname.lib' + dynamic_linker='Win32 ld.exe' + ;; + esac + # FIXME: first we should search . and the directory the executable is in + shlibpath_var=PATH + ;; + +darwin* | rhapsody*) + dynamic_linker="$host_os dyld" + version_type=darwin + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$major$shared_ext $libname$shared_ext' + soname_spec='$libname$release$major$shared_ext' + shlibpath_overrides_runpath=yes + shlibpath_var=DYLD_LIBRARY_PATH + shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' + + sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/local/lib" + sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' + ;; + +dgux*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +freebsd* | dragonfly*) + # DragonFly does not have aout. When/if they implement a new + # versioning mechanism, adjust this. + if test -x /usr/bin/objformat; then + objformat=`/usr/bin/objformat` + else + case $host_os in + freebsd[23].*) objformat=aout ;; + *) objformat=elf ;; + esac + fi + version_type=freebsd-$objformat + case $version_type in + freebsd-elf*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + need_version=no + need_lib_prefix=no + ;; + freebsd-*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + need_version=yes + ;; + esac + shlibpath_var=LD_LIBRARY_PATH + case $host_os in + freebsd2.*) + shlibpath_overrides_runpath=yes + ;; + freebsd3.[01]* | freebsdelf3.[01]*) + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ + freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + *) # from 4.6 on, and DragonFly + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + esac + ;; + +haiku*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + dynamic_linker="$host_os runtime_loader" + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LIBRARY_PATH + shlibpath_overrides_runpath=no + sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib' + hardcode_into_libs=yes + ;; + +hpux9* | hpux10* | hpux11*) + # Give a soname corresponding to the major version so that dld.sl refuses to + # link against other versions. + version_type=sunos + need_lib_prefix=no + need_version=no + case $host_cpu in + ia64*) + shrext_cmds='.so' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.so" + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + if test 32 = "$HPUX_IA64_MODE"; then + sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" + sys_lib_dlsearch_path_spec=/usr/lib/hpux32 + else + sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" + sys_lib_dlsearch_path_spec=/usr/lib/hpux64 + fi + ;; + hppa*64*) + shrext_cmds='.sl' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.sl" + shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + *) + shrext_cmds='.sl' + dynamic_linker="$host_os dld.sl" + shlibpath_var=SHLIB_PATH + shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + ;; + esac + # HP-UX runs *really* slowly unless shared libraries are mode 555, ... + postinstall_cmds='chmod 555 $lib' + # or fails outright, so override atomically: + install_override_mode=555 + ;; + +interix[3-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +irix5* | irix6* | nonstopux*) + case $host_os in + nonstopux*) version_type=nonstopux ;; + *) + if test yes = "$lt_cv_prog_gnu_ld"; then + version_type=linux # correct to gnu/linux during the next big refactor + else + version_type=irix + fi ;; + esac + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$release$shared_ext $libname$shared_ext' + case $host_os in + irix5* | nonstopux*) + libsuff= shlibsuff= + ;; + *) + case $LD in # libtool.m4 will add one of these switches to LD + *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") + libsuff= shlibsuff= libmagic=32-bit;; + *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") + libsuff=32 shlibsuff=N32 libmagic=N32;; + *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") + libsuff=64 shlibsuff=64 libmagic=64-bit;; + *) libsuff= shlibsuff= libmagic=never-match;; + esac + ;; + esac + shlibpath_var=LD_LIBRARY${shlibsuff}_PATH + shlibpath_overrides_runpath=no + sys_lib_search_path_spec="/usr/lib$libsuff /lib$libsuff /usr/local/lib$libsuff" + sys_lib_dlsearch_path_spec="/usr/lib$libsuff /lib$libsuff" + hardcode_into_libs=yes + ;; + +# No shared lib support for Linux oldld, aout, or coff. +linux*oldld* | linux*aout* | linux*coff*) + dynamic_linker=no + ;; + +linux*android*) + version_type=none # Android doesn't support versioned libraries. + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext' + soname_spec='$libname$release$shared_ext' + finish_cmds= + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + dynamic_linker='Android linker' + # Don't embed -rpath directories since the linker doesn't support them. + hardcode_libdir_flag_spec='-L$libdir' + ;; + +# This must be glibc/ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + + # Some binutils ld are patched to set DT_RUNPATH + if ${lt_cv_shlibpath_overrides_runpath+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_shlibpath_overrides_runpath=no + save_LDFLAGS=$LDFLAGS + save_libdir=$libdir + eval "libdir=/foo; wl=\"$lt_prog_compiler_wl\"; \ + LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec\"" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then : + lt_cv_shlibpath_overrides_runpath=yes +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS + libdir=$save_libdir + +fi + + shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + # Ideally, we could use ldconfig to report *all* directores which are + # searched for libraries, however this is still not possible. Aside from not + # being certain /sbin/ldconfig is available, command + # 'ldconfig -N -X -v | grep ^/' on 64bit Fedora does not report /usr/lib64, + # even though it is searched at run-time. Try to do the best guess by + # appending ld.so.conf contents (and includes) to the search path. + if test -f /etc/ld.so.conf; then + lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '` + sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" + fi + + # We used to test for /lib/ld.so.1 and disable shared libraries on + # powerpc, because MkLinux only supported shared libraries with the + # GNU dynamic linker. Since this was broken with cross compilers, + # most powerpc-linux boxes support dynamic linking these days and + # people can always --disable-shared, the test was removed, and we + # assume the GNU/Linux dynamic linker is in use. + dynamic_linker='GNU/Linux ld.so' + ;; + +netbsd*) + version_type=sunos + need_lib_prefix=no + need_version=no + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + dynamic_linker='NetBSD (a.out) ld.so' + else + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='NetBSD ld.elf_so' + fi + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + +newsos6) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +*nto* | *qnx*) + version_type=qnx + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + dynamic_linker='ldqnx.so' + ;; + +openbsd* | bitrig*) + version_type=sunos + sys_lib_dlsearch_path_spec=/usr/lib + need_lib_prefix=no + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + need_version=no + else + need_version=yes + fi + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +os2*) + libname_spec='$name' + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + # OS/2 can only load a DLL with a base name of 8 characters or less. + soname_spec='`test -n "$os2dllname" && libname="$os2dllname"; + v=$($ECHO $release$versuffix | tr -d .-); + n=$($ECHO $libname | cut -b -$((8 - ${#v})) | tr . _); + $ECHO $n$v`$shared_ext' + library_names_spec='${libname}_dll.$libext' + dynamic_linker='OS/2 ld.exe' + shlibpath_var=BEGINLIBPATH + sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; $ECHO \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; $ECHO \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + ;; + +osf3* | osf4* | osf5*) + version_type=osf + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + +rdos*) + dynamic_linker=no + ;; + +solaris*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + # ldd complains unless libraries are executable + postinstall_cmds='chmod +x $lib' + ;; + +sunos4*) + version_type=sunos + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + if test yes = "$with_gnu_ld"; then + need_lib_prefix=no + fi + need_version=yes + ;; + +sysv4 | sysv4.3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + case $host_vendor in + sni) + shlibpath_overrides_runpath=no + need_lib_prefix=no + runpath_var=LD_RUN_PATH + ;; + siemens) + need_lib_prefix=no + ;; + motorola) + need_lib_prefix=no + need_version=no + shlibpath_overrides_runpath=no + sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' + ;; + esac + ;; + +sysv4*MP*) + if test -d /usr/nec; then + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$shared_ext.$versuffix $libname$shared_ext.$major $libname$shared_ext' + soname_spec='$libname$shared_ext.$major' + shlibpath_var=LD_LIBRARY_PATH + fi + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + version_type=sco + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + if test yes = "$with_gnu_ld"; then + sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' + else + sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' + case $host_os in + sco3.2v5*) + sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" + ;; + esac + fi + sys_lib_dlsearch_path_spec='/usr/lib' + ;; + +tpf*) + # TPF is a cross-target only. Preferred cross-host = GNU/Linux. + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +uts4*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +*) + dynamic_linker=no + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5 +$as_echo "$dynamic_linker" >&6; } +test no = "$dynamic_linker" && can_build_shared=no + +variables_saved_for_relink="PATH $shlibpath_var $runpath_var" +if test yes = "$GCC"; then + variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" +fi + +if test set = "${lt_cv_sys_lib_search_path_spec+set}"; then + sys_lib_search_path_spec=$lt_cv_sys_lib_search_path_spec +fi + +if test set = "${lt_cv_sys_lib_dlsearch_path_spec+set}"; then + sys_lib_dlsearch_path_spec=$lt_cv_sys_lib_dlsearch_path_spec +fi + +# remember unaugmented sys_lib_dlsearch_path content for libtool script decls... +configure_time_dlsearch_path=$sys_lib_dlsearch_path_spec + +# ... but it needs LT_SYS_LIBRARY_PATH munging for other configure-time code +func_munge_path_list sys_lib_dlsearch_path_spec "$LT_SYS_LIBRARY_PATH" + +# to be used as default LT_SYS_LIBRARY_PATH value in generated libtool +configure_time_lt_sys_library_path=$LT_SYS_LIBRARY_PATH + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5 +$as_echo_n "checking how to hardcode library paths into programs... " >&6; } +hardcode_action= +if test -n "$hardcode_libdir_flag_spec" || + test -n "$runpath_var" || + test yes = "$hardcode_automatic"; then + + # We can hardcode non-existent directories. + if test no != "$hardcode_direct" && + # If the only mechanism to avoid hardcoding is shlibpath_var, we + # have to relink, otherwise we might link with an installed library + # when we should be linking with a yet-to-be-installed one + ## test no != "$_LT_TAGVAR(hardcode_shlibpath_var, )" && + test no != "$hardcode_minus_L"; then + # Linking always hardcodes the temporary library directory. + hardcode_action=relink + else + # We can link without hardcoding, and we can hardcode nonexisting dirs. + hardcode_action=immediate + fi +else + # We cannot hardcode anything, or else we can only hardcode existing + # directories. + hardcode_action=unsupported +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action" >&5 +$as_echo "$hardcode_action" >&6; } + +if test relink = "$hardcode_action" || + test yes = "$inherit_rpath"; then + # Fast installation is not supported + enable_fast_install=no +elif test yes = "$shlibpath_overrides_runpath" || + test no = "$enable_shared"; then + # Fast installation is not necessary + enable_fast_install=needless +fi + + + + + + + if test yes != "$enable_dlopen"; then + enable_dlopen=unknown + enable_dlopen_self=unknown + enable_dlopen_self_static=unknown +else + lt_cv_dlopen=no + lt_cv_dlopen_libs= + + case $host_os in + beos*) + lt_cv_dlopen=load_add_on + lt_cv_dlopen_libs= + lt_cv_dlopen_self=yes + ;; + + mingw* | pw32* | cegcc*) + lt_cv_dlopen=LoadLibrary + lt_cv_dlopen_libs= + ;; + + cygwin*) + lt_cv_dlopen=dlopen + lt_cv_dlopen_libs= + ;; + + darwin*) + # if libdl is installed we need to link against it + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +$as_echo_n "checking for dlopen in -ldl... " >&6; } +if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dl_dlopen=yes +else + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +$as_echo "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = xyes; then : + lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-ldl +else + + lt_cv_dlopen=dyld + lt_cv_dlopen_libs= + lt_cv_dlopen_self=yes + +fi + + ;; + + tpf*) + # Don't try to run any link tests for TPF. We know it's impossible + # because TPF is a cross-compiler, and we know how we open DSOs. + lt_cv_dlopen=dlopen + lt_cv_dlopen_libs= + lt_cv_dlopen_self=no + ;; + + *) + ac_fn_c_check_func "$LINENO" "shl_load" "ac_cv_func_shl_load" +if test "x$ac_cv_func_shl_load" = xyes; then : + lt_cv_dlopen=shl_load +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 +$as_echo_n "checking for shl_load in -ldld... " >&6; } +if ${ac_cv_lib_dld_shl_load+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldld $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char shl_load (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return shl_load (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dld_shl_load=yes +else + ac_cv_lib_dld_shl_load=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 +$as_echo "$ac_cv_lib_dld_shl_load" >&6; } +if test "x$ac_cv_lib_dld_shl_load" = xyes; then : + lt_cv_dlopen=shl_load lt_cv_dlopen_libs=-ldld +else + ac_fn_c_check_func "$LINENO" "dlopen" "ac_cv_func_dlopen" +if test "x$ac_cv_func_dlopen" = xyes; then : + lt_cv_dlopen=dlopen +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +$as_echo_n "checking for dlopen in -ldl... " >&6; } +if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dl_dlopen=yes +else + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +$as_echo "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = xyes; then : + lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-ldl +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -lsvld" >&5 +$as_echo_n "checking for dlopen in -lsvld... " >&6; } +if ${ac_cv_lib_svld_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsvld $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_svld_dlopen=yes +else + ac_cv_lib_svld_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_svld_dlopen" >&5 +$as_echo "$ac_cv_lib_svld_dlopen" >&6; } +if test "x$ac_cv_lib_svld_dlopen" = xyes; then : + lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-lsvld +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dld_link in -ldld" >&5 +$as_echo_n "checking for dld_link in -ldld... " >&6; } +if ${ac_cv_lib_dld_dld_link+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldld $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dld_link (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return dld_link (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dld_dld_link=yes +else + ac_cv_lib_dld_dld_link=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_dld_link" >&5 +$as_echo "$ac_cv_lib_dld_dld_link" >&6; } +if test "x$ac_cv_lib_dld_dld_link" = xyes; then : + lt_cv_dlopen=dld_link lt_cv_dlopen_libs=-ldld +fi + + +fi + + +fi + + +fi + + +fi + + +fi + + ;; + esac + + if test no = "$lt_cv_dlopen"; then + enable_dlopen=no + else + enable_dlopen=yes + fi + + case $lt_cv_dlopen in + dlopen) + save_CPPFLAGS=$CPPFLAGS + test yes = "$ac_cv_header_dlfcn_h" && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H" + + save_LDFLAGS=$LDFLAGS + wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\" + + save_LIBS=$LIBS + LIBS="$lt_cv_dlopen_libs $LIBS" + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a program can dlopen itself" >&5 +$as_echo_n "checking whether a program can dlopen itself... " >&6; } +if ${lt_cv_dlopen_self+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test yes = "$cross_compiling"; then : + lt_cv_dlopen_self=cross +else + lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 + lt_status=$lt_dlunknown + cat > conftest.$ac_ext <<_LT_EOF +#line $LINENO "configure" +#include "confdefs.h" + +#if HAVE_DLFCN_H +#include +#endif + +#include + +#ifdef RTLD_GLOBAL +# define LT_DLGLOBAL RTLD_GLOBAL +#else +# ifdef DL_GLOBAL +# define LT_DLGLOBAL DL_GLOBAL +# else +# define LT_DLGLOBAL 0 +# endif +#endif + +/* We may have to define LT_DLLAZY_OR_NOW in the command line if we + find out it does not work in some platform. */ +#ifndef LT_DLLAZY_OR_NOW +# ifdef RTLD_LAZY +# define LT_DLLAZY_OR_NOW RTLD_LAZY +# else +# ifdef DL_LAZY +# define LT_DLLAZY_OR_NOW DL_LAZY +# else +# ifdef RTLD_NOW +# define LT_DLLAZY_OR_NOW RTLD_NOW +# else +# ifdef DL_NOW +# define LT_DLLAZY_OR_NOW DL_NOW +# else +# define LT_DLLAZY_OR_NOW 0 +# endif +# endif +# endif +# endif +#endif + +/* When -fvisibility=hidden is used, assume the code has been annotated + correspondingly for the symbols needed. */ +#if defined __GNUC__ && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)) +int fnord () __attribute__((visibility("default"))); +#endif + +int fnord () { return 42; } +int main () +{ + void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); + int status = $lt_dlunknown; + + if (self) + { + if (dlsym (self,"fnord")) status = $lt_dlno_uscore; + else + { + if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; + else puts (dlerror ()); + } + /* dlclose (self); */ + } + else + puts (dlerror ()); + + return status; +} +_LT_EOF + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s "conftest$ac_exeext" 2>/dev/null; then + (./conftest; exit; ) >&5 2>/dev/null + lt_status=$? + case x$lt_status in + x$lt_dlno_uscore) lt_cv_dlopen_self=yes ;; + x$lt_dlneed_uscore) lt_cv_dlopen_self=yes ;; + x$lt_dlunknown|x*) lt_cv_dlopen_self=no ;; + esac + else : + # compilation failed + lt_cv_dlopen_self=no + fi +fi +rm -fr conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self" >&5 +$as_echo "$lt_cv_dlopen_self" >&6; } + + if test yes = "$lt_cv_dlopen_self"; then + wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a statically linked program can dlopen itself" >&5 +$as_echo_n "checking whether a statically linked program can dlopen itself... " >&6; } +if ${lt_cv_dlopen_self_static+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test yes = "$cross_compiling"; then : + lt_cv_dlopen_self_static=cross +else + lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 + lt_status=$lt_dlunknown + cat > conftest.$ac_ext <<_LT_EOF +#line $LINENO "configure" +#include "confdefs.h" + +#if HAVE_DLFCN_H +#include +#endif + +#include + +#ifdef RTLD_GLOBAL +# define LT_DLGLOBAL RTLD_GLOBAL +#else +# ifdef DL_GLOBAL +# define LT_DLGLOBAL DL_GLOBAL +# else +# define LT_DLGLOBAL 0 +# endif +#endif + +/* We may have to define LT_DLLAZY_OR_NOW in the command line if we + find out it does not work in some platform. */ +#ifndef LT_DLLAZY_OR_NOW +# ifdef RTLD_LAZY +# define LT_DLLAZY_OR_NOW RTLD_LAZY +# else +# ifdef DL_LAZY +# define LT_DLLAZY_OR_NOW DL_LAZY +# else +# ifdef RTLD_NOW +# define LT_DLLAZY_OR_NOW RTLD_NOW +# else +# ifdef DL_NOW +# define LT_DLLAZY_OR_NOW DL_NOW +# else +# define LT_DLLAZY_OR_NOW 0 +# endif +# endif +# endif +# endif +#endif + +/* When -fvisibility=hidden is used, assume the code has been annotated + correspondingly for the symbols needed. */ +#if defined __GNUC__ && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)) +int fnord () __attribute__((visibility("default"))); +#endif + +int fnord () { return 42; } +int main () +{ + void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); + int status = $lt_dlunknown; + + if (self) + { + if (dlsym (self,"fnord")) status = $lt_dlno_uscore; + else + { + if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; + else puts (dlerror ()); + } + /* dlclose (self); */ + } + else + puts (dlerror ()); + + return status; +} +_LT_EOF + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s "conftest$ac_exeext" 2>/dev/null; then + (./conftest; exit; ) >&5 2>/dev/null + lt_status=$? + case x$lt_status in + x$lt_dlno_uscore) lt_cv_dlopen_self_static=yes ;; + x$lt_dlneed_uscore) lt_cv_dlopen_self_static=yes ;; + x$lt_dlunknown|x*) lt_cv_dlopen_self_static=no ;; + esac + else : + # compilation failed + lt_cv_dlopen_self_static=no + fi +fi +rm -fr conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self_static" >&5 +$as_echo "$lt_cv_dlopen_self_static" >&6; } + fi + + CPPFLAGS=$save_CPPFLAGS + LDFLAGS=$save_LDFLAGS + LIBS=$save_LIBS + ;; + esac + + case $lt_cv_dlopen_self in + yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;; + *) enable_dlopen_self=unknown ;; + esac + + case $lt_cv_dlopen_self_static in + yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;; + *) enable_dlopen_self_static=unknown ;; + esac +fi + + + + + + + + + + + + + + + + + +striplib= +old_striplib= +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stripping libraries is possible" >&5 +$as_echo_n "checking whether stripping libraries is possible... " >&6; } +if test -n "$STRIP" && $STRIP -V 2>&1 | $GREP "GNU strip" >/dev/null; then + test -z "$old_striplib" && old_striplib="$STRIP --strip-debug" + test -z "$striplib" && striplib="$STRIP --strip-unneeded" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else +# FIXME - insert some real tests, host_os isn't really good enough + case $host_os in + darwin*) + if test -n "$STRIP"; then + striplib="$STRIP -x" + old_striplib="$STRIP -S" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + fi + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + ;; + esac +fi + + + + + + + + + + + + + # Report what library types will actually be built + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5 +$as_echo_n "checking if libtool supports shared libraries... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5 +$as_echo "$can_build_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5 +$as_echo_n "checking whether to build shared libraries... " >&6; } + test no = "$can_build_shared" && enable_shared=no + + # On AIX, shared libraries and static libraries use the same namespace, and + # are all built from PIC. + case $host_os in + aix3*) + test yes = "$enable_shared" && enable_static=no + if test -n "$RANLIB"; then + archive_cmds="$archive_cmds~\$RANLIB \$lib" + postinstall_cmds='$RANLIB $lib' + fi + ;; + + aix[4-9]*) + if test ia64 != "$host_cpu"; then + case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in + yes,aix,yes) ;; # shared object as lib.so file only + yes,svr4,*) ;; # shared object as lib.so archive member only + yes,*) enable_static=no ;; # shared object in lib.a archive as well + esac + fi + ;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5 +$as_echo "$enable_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5 +$as_echo_n "checking whether to build static libraries... " >&6; } + # Make sure either enable_shared or enable_static is yes. + test yes = "$enable_shared" || enable_static=yes + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5 +$as_echo "$enable_static" >&6; } + + + + +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +CC=$lt_save_CC + + if test -n "$CXX" && ( test no != "$CXX" && + ( (test g++ = "$CXX" && `g++ -v >/dev/null 2>&1` ) || + (test g++ != "$CXX"))); then + ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C++ preprocessor" >&5 +$as_echo_n "checking how to run the C++ preprocessor... " >&6; } +if test -z "$CXXCPP"; then + if ${ac_cv_prog_CXXCPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CXXCPP needs to be expanded + for CXXCPP in "$CXX -E" "/lib/cpp" + do + ac_preproc_ok=false +for ac_cxx_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CXXCPP=$CXXCPP + +fi + CXXCPP=$ac_cv_prog_CXXCPP +else + ac_cv_prog_CXXCPP=$CXXCPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CXXCPP" >&5 +$as_echo "$CXXCPP" >&6; } +ac_preproc_ok=false +for ac_cxx_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_cxx_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C++ preprocessor \"$CXXCPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +else + _lt_caught_CXX_error=yes +fi + +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + +archive_cmds_need_lc_CXX=no +allow_undefined_flag_CXX= +always_export_symbols_CXX=no +archive_expsym_cmds_CXX= +compiler_needs_object_CXX=no +export_dynamic_flag_spec_CXX= +hardcode_direct_CXX=no +hardcode_direct_absolute_CXX=no +hardcode_libdir_flag_spec_CXX= +hardcode_libdir_separator_CXX= +hardcode_minus_L_CXX=no +hardcode_shlibpath_var_CXX=unsupported +hardcode_automatic_CXX=no +inherit_rpath_CXX=no +module_cmds_CXX= +module_expsym_cmds_CXX= +link_all_deplibs_CXX=unknown +old_archive_cmds_CXX=$old_archive_cmds +reload_flag_CXX=$reload_flag +reload_cmds_CXX=$reload_cmds +no_undefined_flag_CXX= +whole_archive_flag_spec_CXX= +enable_shared_with_static_runtimes_CXX=no + +# Source file extension for C++ test sources. +ac_ext=cpp + +# Object file extension for compiled C++ test sources. +objext=o +objext_CXX=$objext + +# No sense in running all these tests if we already determined that +# the CXX compiler isn't working. Some variables (like enable_shared) +# are currently assumed to apply to all compilers on this platform, +# and will be corrupted by setting them based on a non-working compiler. +if test yes != "$_lt_caught_CXX_error"; then + # Code to be used in simple compile tests + lt_simple_compile_test_code="int some_variable = 0;" + + # Code to be used in simple link tests + lt_simple_link_test_code='int main(int, char *[]) { return(0); }' + + # ltmain only uses $CC for tagged configurations so make sure $CC is set. + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + + + # save warnings/boilerplate of simple test code + ac_outfile=conftest.$ac_objext +echo "$lt_simple_compile_test_code" >conftest.$ac_ext +eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_compiler_boilerplate=`cat conftest.err` +$RM conftest* + + ac_outfile=conftest.$ac_objext +echo "$lt_simple_link_test_code" >conftest.$ac_ext +eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_linker_boilerplate=`cat conftest.err` +$RM -r conftest* + + + # Allow CC to be a program name with arguments. + lt_save_CC=$CC + lt_save_CFLAGS=$CFLAGS + lt_save_LD=$LD + lt_save_GCC=$GCC + GCC=$GXX + lt_save_with_gnu_ld=$with_gnu_ld + lt_save_path_LD=$lt_cv_path_LD + if test -n "${lt_cv_prog_gnu_ldcxx+set}"; then + lt_cv_prog_gnu_ld=$lt_cv_prog_gnu_ldcxx + else + $as_unset lt_cv_prog_gnu_ld + fi + if test -n "${lt_cv_path_LDCXX+set}"; then + lt_cv_path_LD=$lt_cv_path_LDCXX + else + $as_unset lt_cv_path_LD + fi + test -z "${LDCXX+set}" || LD=$LDCXX + CC=${CXX-"c++"} + CFLAGS=$CXXFLAGS + compiler=$CC + compiler_CXX=$CC + func_cc_basename $compiler +cc_basename=$func_cc_basename_result + + + if test -n "$compiler"; then + # We don't want -fno-exception when compiling C++ code, so set the + # no_builtin_flag separately + if test yes = "$GXX"; then + lt_prog_compiler_no_builtin_flag_CXX=' -fno-builtin' + else + lt_prog_compiler_no_builtin_flag_CXX= + fi + + if test yes = "$GXX"; then + # Set up default GNU C++ configuration + + + +# Check whether --with-gnu-ld was given. +if test "${with_gnu_ld+set}" = set; then : + withval=$with_gnu_ld; test no = "$withval" || with_gnu_ld=yes +else + with_gnu_ld=no +fi + +ac_prog=ld +if test yes = "$GCC"; then + # Check if gcc -print-prog-name=ld gives a path. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5 +$as_echo_n "checking for ld used by $CC... " >&6; } + case $host in + *-*-mingw*) + # gcc leaves a trailing carriage return, which upsets mingw + ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; + *) + ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; + esac + case $ac_prog in + # Accept absolute paths. + [\\/]* | ?:[\\/]*) + re_direlt='/[^/][^/]*/\.\./' + # Canonicalize the pathname of ld + ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'` + while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do + ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"` + done + test -z "$LD" && LD=$ac_prog + ;; + "") + # If it fails, then pretend we aren't using GCC. + ac_prog=ld + ;; + *) + # If it is relative, then search for the first ld in PATH. + with_gnu_ld=unknown + ;; + esac +elif test yes = "$with_gnu_ld"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5 +$as_echo_n "checking for GNU ld... " >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5 +$as_echo_n "checking for non-GNU ld... " >&6; } +fi +if ${lt_cv_path_LD+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$LD"; then + lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR + for ac_dir in $PATH; do + IFS=$lt_save_ifs + test -z "$ac_dir" && ac_dir=. + if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then + lt_cv_path_LD=$ac_dir/$ac_prog + # Check to see if the program is GNU ld. I'd rather use --version, + # but apparently some variants of GNU ld only accept -v. + # Break only if it was the GNU/non-GNU ld that we prefer. + case `"$lt_cv_path_LD" -v 2>&1 &5 +$as_echo "$LD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi +test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5 +$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; } +if ${lt_cv_prog_gnu_ld+:} false; then : + $as_echo_n "(cached) " >&6 +else + # I'd rather use --version here, but apparently some GNU lds only accept -v. +case `$LD -v 2>&1 &5 +$as_echo "$lt_cv_prog_gnu_ld" >&6; } +with_gnu_ld=$lt_cv_prog_gnu_ld + + + + + + + + # Check if GNU C++ uses GNU ld as the underlying linker, since the + # archiving commands below assume that GNU ld is being used. + if test yes = "$with_gnu_ld"; then + archive_cmds_CXX='$CC $pic_flag -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_CXX='$CC $pic_flag -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + + hardcode_libdir_flag_spec_CXX='$wl-rpath $wl$libdir' + export_dynamic_flag_spec_CXX='$wl--export-dynamic' + + # If archive_cmds runs LD, not CC, wlarc should be empty + # XXX I think wlarc can be eliminated in ltcf-cxx, but I need to + # investigate it a little bit more. (MM) + wlarc='$wl' + + # ancient GNU ld didn't support --whole-archive et. al. + if eval "`$CC -print-prog-name=ld` --help 2>&1" | + $GREP 'no-whole-archive' > /dev/null; then + whole_archive_flag_spec_CXX=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' + else + whole_archive_flag_spec_CXX= + fi + else + with_gnu_ld=no + wlarc= + + # A generic and very simple default shared library creation + # command for GNU C++ for the case where it uses the native + # linker, instead of GNU ld. If possible, this setting should + # overridden to take advantage of the native linker features on + # the platform it is being used on. + archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib' + fi + + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"' + + else + GXX=no + with_gnu_ld=no + wlarc= + fi + + # PORTME: fill in a description of your system's C++ link characteristics + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 +$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } + ld_shlibs_CXX=yes + case $host_os in + aix3*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + aix[4-9]*) + if test ia64 = "$host_cpu"; then + # On IA64, the linker does run time linking by default, so we don't + # have to do anything special. + aix_use_runtimelinking=no + exp_sym_flag='-Bexport' + no_entry_flag= + else + aix_use_runtimelinking=no + + # Test if we are trying to use run time linking or normal + # AIX style linking. If -brtl is somewhere in LDFLAGS, we + # have runtime linking enabled, and use it for executables. + # For shared libraries, we enable/disable runtime linking + # depending on the kind of the shared library created - + # when "with_aix_soname,aix_use_runtimelinking" is: + # "aix,no" lib.a(lib.so.V) shared, rtl:no, for executables + # "aix,yes" lib.so shared, rtl:yes, for executables + # lib.a static archive + # "both,no" lib.so.V(shr.o) shared, rtl:yes + # lib.a(lib.so.V) shared, rtl:no, for executables + # "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a(lib.so.V) shared, rtl:no + # "svr4,*" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a static archive + case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) + for ld_flag in $LDFLAGS; do + case $ld_flag in + *-brtl*) + aix_use_runtimelinking=yes + break + ;; + esac + done + if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then + # With aix-soname=svr4, we create the lib.so.V shared archives only, + # so we don't have lib.a shared libs to link our executables. + # We have to force runtime linking in this case. + aix_use_runtimelinking=yes + LDFLAGS="$LDFLAGS -Wl,-brtl" + fi + ;; + esac + + exp_sym_flag='-bexport' + no_entry_flag='-bnoentry' + fi + + # When large executables or shared objects are built, AIX ld can + # have problems creating the table of contents. If linking a library + # or program results in "error TOC overflow" add -mminimal-toc to + # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not + # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. + + archive_cmds_CXX='' + hardcode_direct_CXX=yes + hardcode_direct_absolute_CXX=yes + hardcode_libdir_separator_CXX=':' + link_all_deplibs_CXX=yes + file_list_spec_CXX='$wl-f,' + case $with_aix_soname,$aix_use_runtimelinking in + aix,*) ;; # no import file + svr4,* | *,yes) # use import file + # The Import File defines what to hardcode. + hardcode_direct_CXX=no + hardcode_direct_absolute_CXX=no + ;; + esac + + if test yes = "$GXX"; then + case $host_os in aix4.[012]|aix4.[012].*) + # We only want to do this on AIX 4.2 and lower, the check + # below for broken collect2 doesn't work under 4.3+ + collect2name=`$CC -print-prog-name=collect2` + if test -f "$collect2name" && + strings "$collect2name" | $GREP resolve_lib_name >/dev/null + then + # We have reworked collect2 + : + else + # We have old collect2 + hardcode_direct_CXX=unsupported + # It fails to find uninstalled libraries when the uninstalled + # path is not listed in the libpath. Setting hardcode_minus_L + # to unsupported forces relinking + hardcode_minus_L_CXX=yes + hardcode_libdir_flag_spec_CXX='-L$libdir' + hardcode_libdir_separator_CXX= + fi + esac + shared_flag='-shared' + if test yes = "$aix_use_runtimelinking"; then + shared_flag=$shared_flag' $wl-G' + fi + # Need to ensure runtime linking is disabled for the traditional + # shared library, or the linker may eventually find shared libraries + # /with/ Import File - we do not want to mix them. + shared_flag_aix='-shared' + shared_flag_svr4='-shared $wl-G' + else + # not using gcc + if test ia64 = "$host_cpu"; then + # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release + # chokes on -Wl,-G. The following line is correct: + shared_flag='-G' + else + if test yes = "$aix_use_runtimelinking"; then + shared_flag='$wl-G' + else + shared_flag='$wl-bM:SRE' + fi + shared_flag_aix='$wl-bM:SRE' + shared_flag_svr4='$wl-G' + fi + fi + + export_dynamic_flag_spec_CXX='$wl-bexpall' + # It seems that -bexpall does not export symbols beginning with + # underscore (_), so it is better to generate a list of symbols to + # export. + always_export_symbols_CXX=yes + if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then + # Warning - without using the other runtime loading flags (-brtl), + # -berok will link without error, but may produce a broken library. + # The "-G" linker flag allows undefined symbols. + no_undefined_flag_CXX='-bernotok' + # Determine the default libpath from the value encoded in an empty + # executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath__CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath__CXX=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath__CXX"; then + lt_cv_aix_libpath__CXX=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath__CXX"; then + lt_cv_aix_libpath__CXX=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath__CXX +fi + + hardcode_libdir_flag_spec_CXX='$wl-blibpath:$libdir:'"$aix_libpath" + + archive_expsym_cmds_CXX='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag + else + if test ia64 = "$host_cpu"; then + hardcode_libdir_flag_spec_CXX='$wl-R $libdir:/usr/lib:/lib' + allow_undefined_flag_CXX="-z nodefs" + archive_expsym_cmds_CXX="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols" + else + # Determine the default libpath from the value encoded in an + # empty executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath__CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath__CXX=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath__CXX"; then + lt_cv_aix_libpath__CXX=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath__CXX"; then + lt_cv_aix_libpath__CXX=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath__CXX +fi + + hardcode_libdir_flag_spec_CXX='$wl-blibpath:$libdir:'"$aix_libpath" + # Warning - without using the other run time loading flags, + # -berok will link without error, but may produce a broken library. + no_undefined_flag_CXX=' $wl-bernotok' + allow_undefined_flag_CXX=' $wl-berok' + if test yes = "$with_gnu_ld"; then + # We only use this code for GNU lds that support --whole-archive. + whole_archive_flag_spec_CXX='$wl--whole-archive$convenience $wl--no-whole-archive' + else + # Exported symbols can be pulled into shared objects from archives + whole_archive_flag_spec_CXX='$convenience' + fi + archive_cmds_need_lc_CXX=yes + archive_expsym_cmds_CXX='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d' + # -brtl affects multiple linker settings, -berok does not and is overridden later + compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([, ]\\)%-berok\\1%g"`' + if test svr4 != "$with_aix_soname"; then + # This is similar to how AIX traditionally builds its shared + # libraries. Need -bnortl late, we may have -brtl in LDFLAGS. + archive_expsym_cmds_CXX="$archive_expsym_cmds_CXX"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname' + fi + if test aix != "$with_aix_soname"; then + archive_expsym_cmds_CXX="$archive_expsym_cmds_CXX"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp' + else + # used by -dlpreopen to get the symbols + archive_expsym_cmds_CXX="$archive_expsym_cmds_CXX"'~$MV $output_objdir/$realname.d/$soname $output_objdir' + fi + archive_expsym_cmds_CXX="$archive_expsym_cmds_CXX"'~$RM -r $output_objdir/$realname.d' + fi + fi + ;; + + beos*) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + allow_undefined_flag_CXX=unsupported + # Joseph Beckenbach says some releases of gcc + # support --undefined. This deserves some investigation. FIXME + archive_cmds_CXX='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + else + ld_shlibs_CXX=no + fi + ;; + + chorus*) + case $cc_basename in + *) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + esac + ;; + + cygwin* | mingw* | pw32* | cegcc*) + case $GXX,$cc_basename in + ,cl* | no,cl* | ,icl* | no,icl* | ,ifort* | no,ifort*) + # Native MSVC or ICC or IFORT + # hardcode_libdir_flag_spec is actually meaningless, as there is + # no search path for DLLs. + hardcode_libdir_flag_spec_CXX=' ' + allow_undefined_flag_CXX=unsupported + always_export_symbols_CXX=yes + file_list_spec_CXX='@' + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=.dll + # FIXME: Setting linknames here is a bad hack. + archive_cmds_CXX='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames=' + archive_expsym_cmds_CXX='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp "$export_symbols" "$output_objdir/$soname.def"; + echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp"; + else + $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp; + fi~ + $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~ + linknames=' + # The linker will not automatically build a static lib if we build a DLL. + # _LT_TAGVAR(old_archive_from_new_cmds, CXX)='true' + enable_shared_with_static_runtimes_CXX=yes + # Don't use ranlib + old_postinstall_cmds_CXX='chmod 644 $oldlib' + postlink_cmds_CXX='lt_outputfile="@OUTPUT@"~ + lt_tool_outputfile="@TOOL_OUTPUT@"~ + case $lt_outputfile in + *.exe|*.EXE) ;; + *) + lt_outputfile=$lt_outputfile.exe + lt_tool_outputfile=$lt_tool_outputfile.exe + ;; + esac~ + func_to_tool_file "$lt_outputfile"~ + if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then + $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1; + $RM "$lt_outputfile.manifest"; + fi' + ;; + *) + # g++ + # _LT_TAGVAR(hardcode_libdir_flag_spec, CXX) is actually meaningless, + # as there is no search path for DLLs. + hardcode_libdir_flag_spec_CXX='-L$libdir' + export_dynamic_flag_spec_CXX='$wl--export-all-symbols' + allow_undefined_flag_CXX=unsupported + always_export_symbols_CXX=no + enable_shared_with_static_runtimes_CXX=yes + + if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then + archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + # If the export-symbols file already is a .def file, use it as + # is; otherwise, prepend EXPORTS... + archive_expsym_cmds_CXX='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp $export_symbols $output_objdir/$soname.def; + else + echo EXPORTS > $output_objdir/$soname.def; + cat $export_symbols >> $output_objdir/$soname.def; + fi~ + $CC -shared -nostdlib $output_objdir/$soname.def $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + else + ld_shlibs_CXX=no + fi + ;; + esac + ;; + darwin* | rhapsody*) + + + archive_cmds_need_lc_CXX=no + hardcode_direct_CXX=no + hardcode_automatic_CXX=yes + hardcode_shlibpath_var_CXX=unsupported + if test yes = "$lt_cv_ld_force_load"; then + whole_archive_flag_spec_CXX='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience $wl-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`' + + else + whole_archive_flag_spec_CXX='' + fi + link_all_deplibs_CXX=yes + allow_undefined_flag_CXX=$_lt_dar_allow_undefined + case $cc_basename in + ifort*|nagfor*) _lt_dar_can_shared=yes ;; + *) _lt_dar_can_shared=$GCC ;; + esac + if test yes = "$_lt_dar_can_shared"; then + output_verbose_link_cmd=func_echo_all + archive_cmds_CXX="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dsymutil" + module_cmds_CXX="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dsymutil" + archive_expsym_cmds_CXX="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dar_export_syms$_lt_dsymutil" + module_expsym_cmds_CXX="sed -e 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dar_export_syms$_lt_dsymutil" + if test yes != "$lt_cv_apple_cc_single_mod"; then + archive_cmds_CXX="\$CC -r -keep_private_externs -nostdlib -o \$lib-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$lib-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring$_lt_dsymutil" + archive_expsym_cmds_CXX="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -r -keep_private_externs -nostdlib -o \$lib-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$lib-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring$_lt_dar_export_syms$_lt_dsymutil" + fi + + else + ld_shlibs_CXX=no + fi + + ;; + + os2*) + hardcode_libdir_flag_spec_CXX='-L$libdir' + hardcode_minus_L_CXX=yes + allow_undefined_flag_CXX=unsupported + shrext_cmds=.dll + archive_cmds_CXX='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + archive_expsym_cmds_CXX='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + prefix_cmds="$SED"~ + if test EXPORTS = "`$SED 1q $export_symbols`"; then + prefix_cmds="$prefix_cmds -e 1d"; + fi~ + prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ + cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + old_archive_From_new_cmds_CXX='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' + enable_shared_with_static_runtimes_CXX=yes + ;; + + dgux*) + case $cc_basename in + ec++*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + ghcx*) + # Green Hills C++ Compiler + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + *) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + esac + ;; + + freebsd2.*) + # C++ shared libraries reported to be fairly broken before + # switch to ELF + ld_shlibs_CXX=no + ;; + + freebsd-elf*) + archive_cmds_need_lc_CXX=no + ;; + + freebsd* | dragonfly*) + # FreeBSD 3 and later use GNU C++ and GNU ld with standard ELF + # conventions + ld_shlibs_CXX=yes + ;; + + haiku*) + archive_cmds_CXX='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + link_all_deplibs_CXX=yes + ;; + + hpux9*) + hardcode_libdir_flag_spec_CXX='$wl+b $wl$libdir' + hardcode_libdir_separator_CXX=: + export_dynamic_flag_spec_CXX='$wl-E' + hardcode_direct_CXX=yes + hardcode_minus_L_CXX=yes # Not in the search PATH, + # but as the default + # location of the library. + + case $cc_basename in + CC*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + aCC*) + archive_cmds_CXX='$RM $output_objdir/$soname~$CC -b $wl+b $wl$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + # + # There doesn't appear to be a way to prevent this compiler from + # explicitly linking system object files so we need to strip them + # from the output so that they don't get included in the library + # dependencies. + output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $EGREP "\-L"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"' + ;; + *) + if test yes = "$GXX"; then + archive_cmds_CXX='$RM $output_objdir/$soname~$CC -shared -nostdlib $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + else + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + fi + ;; + esac + ;; + + hpux10*|hpux11*) + if test no = "$with_gnu_ld"; then + hardcode_libdir_flag_spec_CXX='$wl+b $wl$libdir' + hardcode_libdir_separator_CXX=: + + case $host_cpu in + hppa*64*|ia64*) + ;; + *) + export_dynamic_flag_spec_CXX='$wl-E' + ;; + esac + fi + case $host_cpu in + hppa*64*|ia64*) + hardcode_direct_CXX=no + hardcode_shlibpath_var_CXX=no + ;; + *) + hardcode_direct_CXX=yes + hardcode_direct_absolute_CXX=yes + hardcode_minus_L_CXX=yes # Not in the search PATH, + # but as the default + # location of the library. + ;; + esac + + case $cc_basename in + CC*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + aCC*) + case $host_cpu in + hppa*64*) + archive_cmds_CXX='$CC -b $wl+h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + ;; + ia64*) + archive_cmds_CXX='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + ;; + *) + archive_cmds_CXX='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + ;; + esac + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + # + # There doesn't appear to be a way to prevent this compiler from + # explicitly linking system object files so we need to strip them + # from the output so that they don't get included in the library + # dependencies. + output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $GREP "\-L"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"' + ;; + *) + if test yes = "$GXX"; then + if test no = "$with_gnu_ld"; then + case $host_cpu in + hppa*64*) + archive_cmds_CXX='$CC -shared -nostdlib -fPIC $wl+h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + ;; + ia64*) + archive_cmds_CXX='$CC -shared -nostdlib $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + ;; + *) + archive_cmds_CXX='$CC -shared -nostdlib $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + ;; + esac + fi + else + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + fi + ;; + esac + ;; + + interix[3-9]*) + hardcode_direct_CXX=no + hardcode_shlibpath_var_CXX=no + hardcode_libdir_flag_spec_CXX='$wl-rpath,$libdir' + export_dynamic_flag_spec_CXX='$wl-E' + # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. + # Instead, shared libraries are loaded at an image base (0x10000000 by + # default) and relocated if they conflict, which is a slow very memory + # consuming and fragmenting process. To avoid this, we pick a random, + # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link + # time. Moving up from 0x10000000 also allows more sbrk(2) space. + archive_cmds_CXX='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + archive_expsym_cmds_CXX='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + ;; + irix5* | irix6*) + case $cc_basename in + CC*) + # SGI C++ + archive_cmds_CXX='$CC -shared -all -multigot $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + + # Archives containing C++ object files must be created using + # "CC -ar", where "CC" is the IRIX C++ compiler. This is + # necessary to make sure instantiated templates are included + # in the archive. + old_archive_cmds_CXX='$CC -ar -WR,-u -o $oldlib $oldobjs' + ;; + *) + if test yes = "$GXX"; then + if test no = "$with_gnu_ld"; then + archive_cmds_CXX='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + else + archive_cmds_CXX='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` -o $lib' + fi + fi + link_all_deplibs_CXX=yes + ;; + esac + hardcode_libdir_flag_spec_CXX='$wl-rpath $wl$libdir' + hardcode_libdir_separator_CXX=: + inherit_rpath_CXX=yes + ;; + + linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + case $cc_basename in + KCC*) + # Kuck and Associates, Inc. (KAI) C++ Compiler + + # KCC will only create a shared library if the output file + # ends with ".so" (or ".sl" for HP-UX), so rename the library + # to its proper name (with version) after linking. + archive_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\$tempext\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib' + archive_expsym_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\$tempext\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib $wl-retain-symbols-file,$export_symbols; mv \$templib $lib' + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + # + # There doesn't appear to be a way to prevent this compiler from + # explicitly linking system object files so we need to strip them + # from the output so that they don't get included in the library + # dependencies. + output_verbose_link_cmd='templist=`$CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1 | $GREP "ld"`; rm -f libconftest$shared_ext; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"' + + hardcode_libdir_flag_spec_CXX='$wl-rpath,$libdir' + export_dynamic_flag_spec_CXX='$wl--export-dynamic' + + # Archives containing C++ object files must be created using + # "CC -Bstatic", where "CC" is the KAI C++ compiler. + old_archive_cmds_CXX='$CC -Bstatic -o $oldlib $oldobjs' + ;; + icpc* | ecpc* ) + # Intel C++ + with_gnu_ld=yes + # version 8.0 and above of icpc choke on multiply defined symbols + # if we add $predep_objects and $postdep_objects, however 7.1 and + # earlier do not add the objects themselves. + case `$CC -V 2>&1` in + *"Version 7."*) + archive_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + ;; + *) # Version 8.0 or newer + tmp_idyn= + case $host_cpu in + ia64*) tmp_idyn=' -i_dynamic';; + esac + archive_cmds_CXX='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_CXX='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + ;; + esac + archive_cmds_need_lc_CXX=no + hardcode_libdir_flag_spec_CXX='$wl-rpath,$libdir' + export_dynamic_flag_spec_CXX='$wl--export-dynamic' + whole_archive_flag_spec_CXX='$wl--whole-archive$convenience $wl--no-whole-archive' + ;; + pgCC* | pgcpp*) + # Portland Group C++ compiler + case `$CC -V` in + *pgCC\ [1-5].* | *pgcpp\ [1-5].*) + prelink_cmds_CXX='tpldir=Template.dir~ + rm -rf $tpldir~ + $CC --prelink_objects --instantiation_dir $tpldir $objs $libobjs $compile_deplibs~ + compile_command="$compile_command `find $tpldir -name \*.o | sort | $NL2SP`"' + old_archive_cmds_CXX='tpldir=Template.dir~ + rm -rf $tpldir~ + $CC --prelink_objects --instantiation_dir $tpldir $oldobjs$old_deplibs~ + $AR $AR_FLAGS $oldlib$oldobjs$old_deplibs `find $tpldir -name \*.o | sort | $NL2SP`~ + $RANLIB $oldlib' + archive_cmds_CXX='tpldir=Template.dir~ + rm -rf $tpldir~ + $CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~ + $CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | sort | $NL2SP` $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_CXX='tpldir=Template.dir~ + rm -rf $tpldir~ + $CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~ + $CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | sort | $NL2SP` $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + ;; + *) # Version 6 and above use weak symbols + archive_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + ;; + esac + + hardcode_libdir_flag_spec_CXX='$wl--rpath $wl$libdir' + export_dynamic_flag_spec_CXX='$wl--export-dynamic' + whole_archive_flag_spec_CXX='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + ;; + cxx*) + # Compaq C++ + archive_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib $wl-retain-symbols-file $wl$export_symbols' + + runpath_var=LD_RUN_PATH + hardcode_libdir_flag_spec_CXX='-rpath $libdir' + hardcode_libdir_separator_CXX=: + + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + # + # There doesn't appear to be a way to prevent this compiler from + # explicitly linking system object files so we need to strip them + # from the output so that they don't get included in the library + # dependencies. + output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld"`; templist=`func_echo_all "$templist" | $SED "s/\(^.*ld.*\)\( .*ld .*$\)/\1/"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "X$list" | $Xsed' + ;; + xl* | mpixl* | bgxl*) + # IBM XL 8.0 on PPC, with GNU ld + hardcode_libdir_flag_spec_CXX='$wl-rpath $wl$libdir' + export_dynamic_flag_spec_CXX='$wl--export-dynamic' + archive_cmds_CXX='$CC -qmkshrobj $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + if test yes = "$supports_anon_versioning"; then + archive_expsym_cmds_CXX='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $CC -qmkshrobj $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib' + fi + ;; + *) + case `$CC -V 2>&1 | sed 5q` in + *Sun\ C*) + # Sun C++ 5.9 + no_undefined_flag_CXX=' -zdefs' + archive_cmds_CXX='$CC -G$allow_undefined_flag -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + archive_expsym_cmds_CXX='$CC -G$allow_undefined_flag -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-retain-symbols-file $wl$export_symbols' + hardcode_libdir_flag_spec_CXX='-R$libdir' + whole_archive_flag_spec_CXX='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + compiler_needs_object_CXX=yes + + # Not sure whether something based on + # $CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1 + # would be better. + output_verbose_link_cmd='func_echo_all' + + # Archives containing C++ object files must be created using + # "CC -xar", where "CC" is the Sun C++ compiler. This is + # necessary to make sure instantiated templates are included + # in the archive. + old_archive_cmds_CXX='$CC -xar -o $oldlib $oldobjs' + ;; + esac + ;; + esac + ;; + + lynxos*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + + m88k*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + + mvs*) + case $cc_basename in + cxx*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + *) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + esac + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds_CXX='$LD -Bshareable -o $lib $predep_objects $libobjs $deplibs $postdep_objects $linker_flags' + wlarc= + hardcode_libdir_flag_spec_CXX='-R$libdir' + hardcode_direct_CXX=yes + hardcode_shlibpath_var_CXX=no + fi + # Workaround some broken pre-1.5 toolchains + output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP conftest.$objext | $SED -e "s:-lgcc -lc -lgcc::"' + ;; + + *nto* | *qnx*) + ld_shlibs_CXX=yes + ;; + + openbsd* | bitrig*) + if test -f /usr/libexec/ld.so; then + hardcode_direct_CXX=yes + hardcode_shlibpath_var_CXX=no + hardcode_direct_absolute_CXX=yes + archive_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib' + hardcode_libdir_flag_spec_CXX='$wl-rpath,$libdir' + if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`"; then + archive_expsym_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-retain-symbols-file,$export_symbols -o $lib' + export_dynamic_flag_spec_CXX='$wl-E' + whole_archive_flag_spec_CXX=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' + fi + output_verbose_link_cmd=func_echo_all + else + ld_shlibs_CXX=no + fi + ;; + + osf3* | osf4* | osf5*) + case $cc_basename in + KCC*) + # Kuck and Associates, Inc. (KAI) C++ Compiler + + # KCC will only create a shared library if the output file + # ends with ".so" (or ".sl" for HP-UX), so rename the library + # to its proper name (with version) after linking. + archive_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo "$lib" | $SED -e "s/\$tempext\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib' + + hardcode_libdir_flag_spec_CXX='$wl-rpath,$libdir' + hardcode_libdir_separator_CXX=: + + # Archives containing C++ object files must be created using + # the KAI C++ compiler. + case $host in + osf3*) old_archive_cmds_CXX='$CC -Bstatic -o $oldlib $oldobjs' ;; + *) old_archive_cmds_CXX='$CC -o $oldlib $oldobjs' ;; + esac + ;; + RCC*) + # Rational C++ 2.4.1 + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + cxx*) + case $host in + osf3*) + allow_undefined_flag_CXX=' $wl-expect_unresolved $wl\*' + archive_cmds_CXX='$CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $soname `test -n "$verstring" && func_echo_all "$wl-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + hardcode_libdir_flag_spec_CXX='$wl-rpath $wl$libdir' + ;; + *) + allow_undefined_flag_CXX=' -expect_unresolved \*' + archive_cmds_CXX='$CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + archive_expsym_cmds_CXX='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done~ + echo "-hidden">> $lib.exp~ + $CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname $wl-input $wl$lib.exp `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~ + $RM $lib.exp' + hardcode_libdir_flag_spec_CXX='-rpath $libdir' + ;; + esac + + hardcode_libdir_separator_CXX=: + + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + # + # There doesn't appear to be a way to prevent this compiler from + # explicitly linking system object files so we need to strip them + # from the output so that they don't get included in the library + # dependencies. + output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld" | $GREP -v "ld:"`; templist=`func_echo_all "$templist" | $SED "s/\(^.*ld.*\)\( .*ld.*$\)/\1/"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"' + ;; + *) + if test yes,no = "$GXX,$with_gnu_ld"; then + allow_undefined_flag_CXX=' $wl-expect_unresolved $wl\*' + case $host in + osf3*) + archive_cmds_CXX='$CC -shared -nostdlib $allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + ;; + *) + archive_cmds_CXX='$CC -shared $pic_flag -nostdlib $allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + ;; + esac + + hardcode_libdir_flag_spec_CXX='$wl-rpath $wl$libdir' + hardcode_libdir_separator_CXX=: + + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"' + + else + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + fi + ;; + esac + ;; + + psos*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + + sunos4*) + case $cc_basename in + CC*) + # Sun C++ 4.x + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + lcc*) + # Lucid + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + *) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + esac + ;; + + solaris*) + case $cc_basename in + CC* | sunCC*) + # Sun C++ 4.2, 5.x and Centerline C++ + archive_cmds_need_lc_CXX=yes + no_undefined_flag_CXX=' -zdefs' + archive_cmds_CXX='$CC -G$allow_undefined_flag -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' + archive_expsym_cmds_CXX='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -G$allow_undefined_flag $wl-M $wl$lib.exp -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp' + + hardcode_libdir_flag_spec_CXX='-R$libdir' + hardcode_shlibpath_var_CXX=no + case $host_os in + solaris2.[0-5] | solaris2.[0-5].*) ;; + *) + # The compiler driver will combine and reorder linker options, + # but understands '-z linker_flag'. + # Supported since Solaris 2.6 (maybe 2.5.1?) + whole_archive_flag_spec_CXX='-z allextract$convenience -z defaultextract' + ;; + esac + link_all_deplibs_CXX=yes + + output_verbose_link_cmd='func_echo_all' + + # Archives containing C++ object files must be created using + # "CC -xar", where "CC" is the Sun C++ compiler. This is + # necessary to make sure instantiated templates are included + # in the archive. + old_archive_cmds_CXX='$CC -xar -o $oldlib $oldobjs' + ;; + gcx*) + # Green Hills C++ Compiler + archive_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-h $wl$soname -o $lib' + + # The C++ compiler must be used to create the archive. + old_archive_cmds_CXX='$CC $LDFLAGS -archive -o $oldlib $oldobjs' + ;; + *) + # GNU C++ compiler with Solaris linker + if test yes,no = "$GXX,$with_gnu_ld"; then + no_undefined_flag_CXX=' $wl-z ${wl}defs' + if $CC --version | $GREP -v '^2\.7' > /dev/null; then + archive_cmds_CXX='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-h $wl$soname -o $lib' + archive_expsym_cmds_CXX='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -shared $pic_flag -nostdlib $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp' + + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"' + else + # g++ 2.7 appears to require '-G' NOT '-shared' on this + # platform. + archive_cmds_CXX='$CC -G -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-h $wl$soname -o $lib' + archive_expsym_cmds_CXX='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -G -nostdlib $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp' + + # Commands to make compiler produce verbose output that lists + # what "hidden" libraries, object files and flags are used when + # linking a shared library. + output_verbose_link_cmd='$CC -G $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"' + fi + + hardcode_libdir_flag_spec_CXX='$wl-R $wl$libdir' + case $host_os in + solaris2.[0-5] | solaris2.[0-5].*) ;; + *) + whole_archive_flag_spec_CXX='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract' + ;; + esac + fi + ;; + esac + ;; + + sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) + no_undefined_flag_CXX='$wl-z,text' + archive_cmds_need_lc_CXX=no + hardcode_shlibpath_var_CXX=no + runpath_var='LD_RUN_PATH' + + case $cc_basename in + CC*) + archive_cmds_CXX='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_CXX='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds_CXX='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_CXX='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + ;; + + sysv5* | sco3.2v5* | sco5v6*) + # Note: We CANNOT use -z defs as we might desire, because we do not + # link with -lc, and that would cause any symbols used from libc to + # always be unresolved, which means just about no library would + # ever link correctly. If we're not using GNU ld we use -z text + # though, which does catch some bad symbols but isn't as heavy-handed + # as -z defs. + no_undefined_flag_CXX='$wl-z,text' + allow_undefined_flag_CXX='$wl-z,nodefs' + archive_cmds_need_lc_CXX=no + hardcode_shlibpath_var_CXX=no + hardcode_libdir_flag_spec_CXX='$wl-R,$libdir' + hardcode_libdir_separator_CXX=':' + link_all_deplibs_CXX=yes + export_dynamic_flag_spec_CXX='$wl-Bexport' + runpath_var='LD_RUN_PATH' + + case $cc_basename in + CC*) + archive_cmds_CXX='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_CXX='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + old_archive_cmds_CXX='$CC -Tprelink_objects $oldobjs~ + '"$old_archive_cmds_CXX" + reload_cmds_CXX='$CC -Tprelink_objects $reload_objs~ + '"$reload_cmds_CXX" + ;; + *) + archive_cmds_CXX='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_CXX='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + ;; + + tandem*) + case $cc_basename in + NCC*) + # NonStop-UX NCC 3.20 + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + *) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + esac + ;; + + vxworks*) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + + *) + # FIXME: insert proper C++ library support + ld_shlibs_CXX=no + ;; + esac + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs_CXX" >&5 +$as_echo "$ld_shlibs_CXX" >&6; } + test no = "$ld_shlibs_CXX" && can_build_shared=no + + GCC_CXX=$GXX + LD_CXX=$LD + + ## CAVEAT EMPTOR: + ## There is no encapsulation within the following macros, do not change + ## the running order or otherwise move them around unless you know exactly + ## what you are doing... + # Dependencies to place before and after the object being linked: +predep_objects_CXX= +postdep_objects_CXX= +predeps_CXX= +postdeps_CXX= +compiler_lib_search_path_CXX= + +cat > conftest.$ac_ext <<_LT_EOF +class Foo +{ +public: + Foo (void) { a = 0; } +private: + int a; +}; +_LT_EOF + + +_lt_libdeps_save_CFLAGS=$CFLAGS +case "$CC $CFLAGS " in #( +*\ -flto*\ *) CFLAGS="$CFLAGS -fno-lto" ;; +*\ -fwhopr*\ *) CFLAGS="$CFLAGS -fno-whopr" ;; +*\ -fuse-linker-plugin*\ *) CFLAGS="$CFLAGS -fno-use-linker-plugin" ;; +esac + +if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + # Parse the compiler output and extract the necessary + # objects, libraries and library flags. + + # Sentinel used to keep track of whether or not we are before + # the conftest object file. + pre_test_object_deps_done=no + + for p in `eval "$output_verbose_link_cmd"`; do + case $prev$p in + + -L* | -R* | -l*) + # Some compilers place space between "-{L,R}" and the path. + # Remove the space. + if test x-L = "$p" || + test x-R = "$p"; then + prev=$p + continue + fi + + # Expand the sysroot to ease extracting the directories later. + if test -z "$prev"; then + case $p in + -L*) func_stripname_cnf '-L' '' "$p"; prev=-L; p=$func_stripname_result ;; + -R*) func_stripname_cnf '-R' '' "$p"; prev=-R; p=$func_stripname_result ;; + -l*) func_stripname_cnf '-l' '' "$p"; prev=-l; p=$func_stripname_result ;; + esac + fi + case $p in + =*) func_stripname_cnf '=' '' "$p"; p=$lt_sysroot$func_stripname_result ;; + esac + if test no = "$pre_test_object_deps_done"; then + case $prev in + -L | -R) + # Internal compiler library paths should come after those + # provided the user. The postdeps already come after the + # user supplied libs so there is no need to process them. + if test -z "$compiler_lib_search_path_CXX"; then + compiler_lib_search_path_CXX=$prev$p + else + compiler_lib_search_path_CXX="${compiler_lib_search_path_CXX} $prev$p" + fi + ;; + # The "-l" case would never come before the object being + # linked, so don't bother handling this case. + esac + else + if test -z "$postdeps_CXX"; then + postdeps_CXX=$prev$p + else + postdeps_CXX="${postdeps_CXX} $prev$p" + fi + fi + prev= + ;; + + *.lto.$objext) ;; # Ignore GCC LTO objects + *.$objext) + # This assumes that the test object file only shows up + # once in the compiler output. + if test "$p" = "conftest.$objext"; then + pre_test_object_deps_done=yes + continue + fi + + if test no = "$pre_test_object_deps_done"; then + if test -z "$predep_objects_CXX"; then + predep_objects_CXX=$p + else + predep_objects_CXX="$predep_objects_CXX $p" + fi + else + if test -z "$postdep_objects_CXX"; then + postdep_objects_CXX=$p + else + postdep_objects_CXX="$postdep_objects_CXX $p" + fi + fi + ;; + + *) ;; # Ignore the rest. + + esac + done + + # Clean up. + rm -f a.out a.exe +else + echo "libtool.m4: error: problem compiling CXX test program" +fi + +$RM -f confest.$objext +CFLAGS=$_lt_libdeps_save_CFLAGS + +# PORTME: override above test on systems where it is broken +case $host_os in +interix[3-9]*) + # Interix 3.5 installs completely hosed .la files for C++, so rather than + # hack all around it, let's just trust "g++" to DTRT. + predep_objects_CXX= + postdep_objects_CXX= + postdeps_CXX= + ;; +esac + + +case " $postdeps_CXX " in +*" -lc "*) archive_cmds_need_lc_CXX=no ;; +esac + compiler_lib_search_dirs_CXX= +if test -n "${compiler_lib_search_path_CXX}"; then + compiler_lib_search_dirs_CXX=`echo " ${compiler_lib_search_path_CXX}" | $SED -e 's! -L! !g' -e 's!^ !!'` +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + lt_prog_compiler_wl_CXX= +lt_prog_compiler_pic_CXX= +lt_prog_compiler_static_CXX= + + + # C++ specific cases for pic, static, wl, etc. + if test yes = "$GXX"; then + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_static_CXX='-static' + + case $host_os in + aix*) + # All AIX code is PIC. + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static_CXX='-Bstatic' + fi + lt_prog_compiler_pic_CXX='-fPIC' + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + lt_prog_compiler_pic_CXX='-fPIC' + ;; + m68k) + # FIXME: we need at least 68020 code to build shared libraries, but + # adding the '-m68020' flag to GCC prevents building anything better, + # like '-m68040'. + lt_prog_compiler_pic_CXX='-m68020 -resident32 -malways-restore-a4' + ;; + esac + ;; + + beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) + # PIC is the default for these OSes. + ;; + mingw* | cygwin* | os2* | pw32* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + # Although the cygwin gcc ignores -fPIC, still need this for old-style + # (--disable-auto-import) libraries + lt_prog_compiler_pic_CXX='-DDLL_EXPORT' + case $host_os in + os2*) + lt_prog_compiler_static_CXX='$wl-static' + ;; + esac + ;; + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic_CXX='-fno-common' + ;; + *djgpp*) + # DJGPP does not support shared libraries at all + lt_prog_compiler_pic_CXX= + ;; + haiku*) + # PIC is the default for Haiku. + # The "-static" flag exists, but is broken. + lt_prog_compiler_static_CXX= + ;; + interix[3-9]*) + # Interix 3.x gcc -fpic/-fPIC options generate broken code. + # Instead, we relocate shared libraries at runtime. + ;; + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic_CXX=-Kconform_pic + fi + ;; + hpux*) + # PIC is the default for 64-bit PA HP-UX, but not for 32-bit + # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag + # sets the default TLS model and affects inlining. + case $host_cpu in + hppa*64*) + ;; + *) + lt_prog_compiler_pic_CXX='-fPIC' + ;; + esac + ;; + *qnx* | *nto*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic_CXX='-fPIC -shared' + ;; + *) + lt_prog_compiler_pic_CXX='-fPIC' + ;; + esac + else + case $host_os in + aix[4-9]*) + # All AIX code is PIC. + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static_CXX='-Bstatic' + else + lt_prog_compiler_static_CXX='-bnso -bI:/lib/syscalls.exp' + fi + ;; + chorus*) + case $cc_basename in + cxch68*) + # Green Hills C++ Compiler + # _LT_TAGVAR(lt_prog_compiler_static, CXX)="--no_auto_instantiation -u __main -u __premain -u _abort -r $COOL_DIR/lib/libOrb.a $MVME_DIR/lib/CC/libC.a $MVME_DIR/lib/classix/libcx.s.a" + ;; + esac + ;; + mingw* | cygwin* | os2* | pw32* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + lt_prog_compiler_pic_CXX='-DDLL_EXPORT' + ;; + dgux*) + case $cc_basename in + ec++*) + lt_prog_compiler_pic_CXX='-KPIC' + ;; + ghcx*) + # Green Hills C++ Compiler + lt_prog_compiler_pic_CXX='-pic' + ;; + *) + ;; + esac + ;; + freebsd* | dragonfly*) + # FreeBSD uses GNU C++ + ;; + hpux9* | hpux10* | hpux11*) + case $cc_basename in + CC*) + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_static_CXX='$wl-a ${wl}archive' + if test ia64 != "$host_cpu"; then + lt_prog_compiler_pic_CXX='+Z' + fi + ;; + aCC*) + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_static_CXX='$wl-a ${wl}archive' + case $host_cpu in + hppa*64*|ia64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic_CXX='+Z' + ;; + esac + ;; + *) + ;; + esac + ;; + interix*) + # This is c89, which is MS Visual C++ (no shared libs) + # Anyone wants to do a port? + ;; + irix5* | irix6* | nonstopux*) + case $cc_basename in + CC*) + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_static_CXX='-non_shared' + # CC pic flag -KPIC is the default. + ;; + *) + ;; + esac + ;; + linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + case $cc_basename in + KCC*) + # KAI C++ Compiler + lt_prog_compiler_wl_CXX='--backend -Wl,' + lt_prog_compiler_pic_CXX='-fPIC' + ;; + ecpc* ) + # old Intel C++ for x86_64, which still supported -KPIC. + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_pic_CXX='-KPIC' + lt_prog_compiler_static_CXX='-static' + ;; + icpc* ) + # Intel C++, used to be incompatible with GCC. + # ICC 10 doesn't accept -KPIC any more. + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_pic_CXX='-fPIC' + lt_prog_compiler_static_CXX='-static' + ;; + pgCC* | pgcpp*) + # Portland Group C++ compiler + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_pic_CXX='-fpic' + lt_prog_compiler_static_CXX='-Bstatic' + ;; + cxx*) + # Compaq C++ + # Make sure the PIC flag is empty. It appears that all Alpha + # Linux and Compaq Tru64 Unix objects are PIC. + lt_prog_compiler_pic_CXX= + lt_prog_compiler_static_CXX='-non_shared' + ;; + xlc* | xlC* | bgxl[cC]* | mpixl[cC]*) + # IBM XL 8.0, 9.0 on PPC and BlueGene + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_pic_CXX='-qpic' + lt_prog_compiler_static_CXX='-qstaticlink' + ;; + *) + case `$CC -V 2>&1 | sed 5q` in + *Sun\ C*) + # Sun C++ 5.9 + lt_prog_compiler_pic_CXX='-KPIC' + lt_prog_compiler_static_CXX='-Bstatic' + lt_prog_compiler_wl_CXX='-Qoption ld ' + ;; + esac + ;; + esac + ;; + lynxos*) + ;; + m88k*) + ;; + mvs*) + case $cc_basename in + cxx*) + lt_prog_compiler_pic_CXX='-W c,exportall' + ;; + *) + ;; + esac + ;; + netbsd*) + ;; + *qnx* | *nto*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic_CXX='-fPIC -shared' + ;; + osf3* | osf4* | osf5*) + case $cc_basename in + KCC*) + lt_prog_compiler_wl_CXX='--backend -Wl,' + ;; + RCC*) + # Rational C++ 2.4.1 + lt_prog_compiler_pic_CXX='-pic' + ;; + cxx*) + # Digital/Compaq C++ + lt_prog_compiler_wl_CXX='-Wl,' + # Make sure the PIC flag is empty. It appears that all Alpha + # Linux and Compaq Tru64 Unix objects are PIC. + lt_prog_compiler_pic_CXX= + lt_prog_compiler_static_CXX='-non_shared' + ;; + *) + ;; + esac + ;; + psos*) + ;; + solaris*) + case $cc_basename in + CC* | sunCC*) + # Sun C++ 4.2, 5.x and Centerline C++ + lt_prog_compiler_pic_CXX='-KPIC' + lt_prog_compiler_static_CXX='-Bstatic' + lt_prog_compiler_wl_CXX='-Qoption ld ' + ;; + gcx*) + # Green Hills C++ Compiler + lt_prog_compiler_pic_CXX='-PIC' + ;; + *) + ;; + esac + ;; + sunos4*) + case $cc_basename in + CC*) + # Sun C++ 4.x + lt_prog_compiler_pic_CXX='-pic' + lt_prog_compiler_static_CXX='-Bstatic' + ;; + lcc*) + # Lucid + lt_prog_compiler_pic_CXX='-pic' + ;; + *) + ;; + esac + ;; + sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) + case $cc_basename in + CC*) + lt_prog_compiler_wl_CXX='-Wl,' + lt_prog_compiler_pic_CXX='-KPIC' + lt_prog_compiler_static_CXX='-Bstatic' + ;; + esac + ;; + tandem*) + case $cc_basename in + NCC*) + # NonStop-UX NCC 3.20 + lt_prog_compiler_pic_CXX='-KPIC' + ;; + *) + ;; + esac + ;; + vxworks*) + ;; + *) + lt_prog_compiler_can_build_shared_CXX=no + ;; + esac + fi + +case $host_os in + # For platforms that do not support PIC, -DPIC is meaningless: + *djgpp*) + lt_prog_compiler_pic_CXX= + ;; + *) + lt_prog_compiler_pic_CXX="$lt_prog_compiler_pic_CXX -DPIC" + ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5 +$as_echo_n "checking for $compiler option to produce PIC... " >&6; } +if ${lt_cv_prog_compiler_pic_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_CXX=$lt_prog_compiler_pic_CXX +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_CXX" >&5 +$as_echo "$lt_cv_prog_compiler_pic_CXX" >&6; } +lt_prog_compiler_pic_CXX=$lt_cv_prog_compiler_pic_CXX + +# +# Check to make sure the PIC flag actually works. +# +if test -n "$lt_prog_compiler_pic_CXX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic_CXX works" >&5 +$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic_CXX works... " >&6; } +if ${lt_cv_prog_compiler_pic_works_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_works_CXX=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="$lt_prog_compiler_pic_CXX -DPIC" ## exclude from sc_useless_quotes_in_assignment + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_pic_works_CXX=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works_CXX" >&5 +$as_echo "$lt_cv_prog_compiler_pic_works_CXX" >&6; } + +if test yes = "$lt_cv_prog_compiler_pic_works_CXX"; then + case $lt_prog_compiler_pic_CXX in + "" | " "*) ;; + *) lt_prog_compiler_pic_CXX=" $lt_prog_compiler_pic_CXX" ;; + esac +else + lt_prog_compiler_pic_CXX= + lt_prog_compiler_can_build_shared_CXX=no +fi + +fi + + + + + +# +# Check to make sure the static flag actually works. +# +wl=$lt_prog_compiler_wl_CXX eval lt_tmp_static_flag=\"$lt_prog_compiler_static_CXX\" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5 +$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; } +if ${lt_cv_prog_compiler_static_works_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_static_works_CXX=no + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS $lt_tmp_static_flag" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_static_works_CXX=yes + fi + else + lt_cv_prog_compiler_static_works_CXX=yes + fi + fi + $RM -r conftest* + LDFLAGS=$save_LDFLAGS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works_CXX" >&5 +$as_echo "$lt_cv_prog_compiler_static_works_CXX" >&6; } + +if test yes = "$lt_cv_prog_compiler_static_works_CXX"; then + : +else + lt_prog_compiler_static_CXX= +fi + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o_CXX=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o_CXX=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_CXX" >&5 +$as_echo "$lt_cv_prog_compiler_c_o_CXX" >&6; } + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o_CXX=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o_CXX=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_CXX" >&5 +$as_echo "$lt_cv_prog_compiler_c_o_CXX" >&6; } + + + + +hard_links=nottested +if test no = "$lt_cv_prog_compiler_c_o_CXX" && test no != "$need_locks"; then + # do not overwrite the value of need_locks provided by the user + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5 +$as_echo_n "checking if we can lock with hard links... " >&6; } + hard_links=yes + $RM conftest* + ln conftest.a conftest.b 2>/dev/null && hard_links=no + touch conftest.a + ln conftest.a conftest.b 2>&5 || hard_links=no + ln conftest.a conftest.b 2>/dev/null && hard_links=no + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5 +$as_echo "$hard_links" >&6; } + if test no = "$hard_links"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&5 +$as_echo "$as_me: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&2;} + need_locks=warn + fi +else + need_locks=no +fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 +$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } + + export_symbols_cmds_CXX='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' + exclude_expsyms_CXX='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' + case $host_os in + aix[4-9]*) + # If we're using GNU nm, then we don't want the "-C" option. + # -C means demangle to GNU nm, but means don't demangle to AIX nm. + # Without the "-l" option, or with the "-B" option, AIX nm treats + # weak defined symbols like other global defined symbols, whereas + # GNU nm marks them as "W". + # While the 'weak' keyword is ignored in the Export File, we need + # it in the Import File for the 'aix-soname' feature, so we have + # to replace the "-B" option with "-P" for AIX nm. + if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then + export_symbols_cmds_CXX='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols' + else + export_symbols_cmds_CXX='`func_echo_all $NM | $SED -e '\''s/B\([^B]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && (substr(\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols' + fi + ;; + pw32*) + export_symbols_cmds_CXX=$ltdll_cmds + ;; + cygwin* | mingw* | cegcc*) + case $cc_basename in + cl* | icl* | ifort*) + exclude_expsyms_CXX='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*' + ;; + *) + export_symbols_cmds_CXX='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/;s/^.*[ ]__nm__\([^ ]*\)[ ][^ ]*/\1 DATA/;/^I[ ]/d;/^[AITW][ ]/s/.* //'\'' | sort | uniq > $export_symbols' + exclude_expsyms_CXX='[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname' + ;; + esac + ;; + *) + export_symbols_cmds_CXX='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' + ;; + esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs_CXX" >&5 +$as_echo "$ld_shlibs_CXX" >&6; } +test no = "$ld_shlibs_CXX" && can_build_shared=no + +with_gnu_ld_CXX=$with_gnu_ld + + + + + + +# +# Do we need to explicitly link libc? +# +case "x$archive_cmds_need_lc_CXX" in +x|xyes) + # Assume -lc should be added + archive_cmds_need_lc_CXX=yes + + if test yes,yes = "$GCC,$enable_shared"; then + case $archive_cmds_CXX in + *'~'*) + # FIXME: we may have to deal with multi-command sequences. + ;; + '$CC '*) + # Test whether the compiler implicitly links with -lc since on some + # systems, -lgcc has to come before -lc. If gcc already passes -lc + # to ld, don't add -lc before -lgcc. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5 +$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; } +if ${lt_cv_archive_cmds_need_lc_CXX+:} false; then : + $as_echo_n "(cached) " >&6 +else + $RM conftest* + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } 2>conftest.err; then + soname=conftest + lib=conftest + libobjs=conftest.$ac_objext + deplibs= + wl=$lt_prog_compiler_wl_CXX + pic_flag=$lt_prog_compiler_pic_CXX + compiler_flags=-v + linker_flags=-v + verstring= + output_objdir=. + libname=conftest + lt_save_allow_undefined_flag=$allow_undefined_flag_CXX + allow_undefined_flag_CXX= + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds_CXX 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5 + (eval $archive_cmds_CXX 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + then + lt_cv_archive_cmds_need_lc_CXX=no + else + lt_cv_archive_cmds_need_lc_CXX=yes + fi + allow_undefined_flag_CXX=$lt_save_allow_undefined_flag + else + cat conftest.err 1>&5 + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc_CXX" >&5 +$as_echo "$lt_cv_archive_cmds_need_lc_CXX" >&6; } + archive_cmds_need_lc_CXX=$lt_cv_archive_cmds_need_lc_CXX + ;; + esac + fi + ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5 +$as_echo_n "checking dynamic linker characteristics... " >&6; } + +library_names_spec= +libname_spec='lib$name' +soname_spec= +shrext_cmds=.so +postinstall_cmds= +postuninstall_cmds= +finish_cmds= +finish_eval= +shlibpath_var= +shlibpath_overrides_runpath=unknown +version_type=none +dynamic_linker="$host_os ld.so" +sys_lib_dlsearch_path_spec="/lib /usr/lib" +need_lib_prefix=unknown +hardcode_into_libs=no + +# when you set need_version to no, make sure it does not cause -set_version +# flags to be left without arguments +need_version=unknown + + + +case $host_os in +aix3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname.a' + shlibpath_var=LIBPATH + + # AIX 3 has no versioning support, so we append a major version to the name. + soname_spec='$libname$release$shared_ext$major' + ;; + +aix[4-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + hardcode_into_libs=yes + if test ia64 = "$host_cpu"; then + # AIX 5 supports IA64 + library_names_spec='$libname$release$shared_ext$major $libname$release$shared_ext$versuffix $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + else + # With GCC up to 2.95.x, collect2 would create an import file + # for dependence libraries. The import file would start with + # the line '#! .'. This would cause the generated library to + # depend on '.', always an invalid library. This was fixed in + # development snapshots of GCC prior to 3.0. + case $host_os in + aix4 | aix4.[01] | aix4.[01].*) + if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' + echo ' yes ' + echo '#endif'; } | $CC -E - | $GREP yes > /dev/null; then + : + else + can_build_shared=no + fi + ;; + esac + # Using Import Files as archive members, it is possible to support + # filename-based versioning of shared library archives on AIX. While + # this would work for both with and without runtime linking, it will + # prevent static linking of such archives. So we do filename-based + # shared library versioning with .so extension only, which is used + # when both runtime linking and shared linking is enabled. + # Unfortunately, runtime linking may impact performance, so we do + # not want this to be the default eventually. Also, we use the + # versioned .so libs for executables only if there is the -brtl + # linker flag in LDFLAGS as well, or --with-aix-soname=svr4 only. + # To allow for filename-based versioning support, we need to create + # libNAME.so.V as an archive file, containing: + # *) an Import File, referring to the versioned filename of the + # archive as well as the shared archive member, telling the + # bitwidth (32 or 64) of that shared object, and providing the + # list of exported symbols of that shared object, eventually + # decorated with the 'weak' keyword + # *) the shared object with the F_LOADONLY flag set, to really avoid + # it being seen by the linker. + # At run time we better use the real file rather than another symlink, + # but for link time we create the symlink libNAME.so -> libNAME.so.V + + case $with_aix_soname,$aix_use_runtimelinking in + # AIX (on Power*) has no versioning support, so currently we cannot hardcode correct + # soname into executable. Probably we can add versioning support to + # collect2, so additional links can be useful in future. + aix,yes) # traditional libtool + dynamic_linker='AIX unversionable lib.so' + # If using run time linking (on AIX 4.2 or later) use lib.so + # instead of lib.a to let people know that these are not + # typical AIX shared libraries. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + aix,no) # traditional AIX only + dynamic_linker='AIX lib.a(lib.so.V)' + # We preserve .a as extension for shared libraries through AIX4.2 + # and later when we are not doing run time linking. + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + ;; + svr4,*) # full svr4 only + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,yes) # both, prefer svr4 + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o), lib.a(lib.so.V)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # unpreferred sharedlib libNAME.a needs extra handling + postinstall_cmds='test -n "$linkname" || linkname="$realname"~func_stripname "" ".so" "$linkname"~$install_shared_prog "$dir/$func_stripname_result.$libext" "$destdir/$func_stripname_result.$libext"~test -z "$tstripme" || test -z "$striplib" || $striplib "$destdir/$func_stripname_result.$libext"' + postuninstall_cmds='for n in $library_names $old_library; do :; done~func_stripname "" ".so" "$n"~test "$func_stripname_result" = "$n" || func_append rmfiles " $odir/$func_stripname_result.$libext"' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,no) # both, prefer aix + dynamic_linker="AIX lib.a(lib.so.V), lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + # unpreferred sharedlib libNAME.so.V and symlink libNAME.so need extra handling + postinstall_cmds='test -z "$dlname" || $install_shared_prog $dir/$dlname $destdir/$dlname~test -z "$tstripme" || test -z "$striplib" || $striplib $destdir/$dlname~test -n "$linkname" || linkname=$realname~func_stripname "" ".a" "$linkname"~(cd "$destdir" && $LN_S -f $dlname $func_stripname_result.so)' + postuninstall_cmds='test -z "$dlname" || func_append rmfiles " $odir/$dlname"~for n in $old_library $library_names; do :; done~func_stripname "" ".a" "$n"~func_append rmfiles " $odir/$func_stripname_result.so"' + ;; + esac + shlibpath_var=LIBPATH + fi + ;; + +amigaos*) + case $host_cpu in + powerpc) + # Since July 2007 AmigaOS4 officially supports .so libraries. + # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + m68k) + library_names_spec='$libname.ixlibrary $libname.a' + # Create ${libname}_ixlibrary.a entries in /sys/libs. + finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' + ;; + esac + ;; + +beos*) + library_names_spec='$libname$shared_ext' + dynamic_linker="$host_os ld.so" + shlibpath_var=LIBRARY_PATH + ;; + +bsdi[45]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" + sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" + # the default ld.so.conf also contains /usr/contrib/lib and + # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow + # libtool to hard-code these into programs + ;; + +cygwin* | mingw* | pw32* | cegcc*) + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + + case $GCC,$cc_basename in + yes,*) + # gcc + library_names_spec='$libname.dll.a' + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + + case $host_os in + cygwin*) + # Cygwin DLLs use 'cyg' prefix rather than 'lib' + soname_spec='`echo $libname | sed -e 's/^lib/cyg/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + + ;; + mingw* | cegcc*) + # MinGW DLLs use traditional 'lib' prefix + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + pw32*) + # pw32 DLLs use 'pw' prefix rather than 'lib' + library_names_spec='`echo $libname | sed -e 's/^lib/pw/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + esac + dynamic_linker='Win32 ld.exe' + ;; + + *,cl* | *,icl* | *,ifort*) + # Native MSVC or ICC or IFORT + libname_spec='$name' + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + library_names_spec='$libname.dll.lib' + + case $build_os in + mingw*) + sys_lib_search_path_spec= + lt_save_ifs=$IFS + IFS=';' + for lt_path in $LIB + do + IFS=$lt_save_ifs + # Let DOS variable expansion print the short 8.3 style file name. + lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"` + sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path" + done + IFS=$lt_save_ifs + # Convert to MSYS style. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([a-zA-Z]\\):| /\\1|g' -e 's|^ ||'` + ;; + cygwin*) + # Convert to unix form, then to dos form, then back to unix form + # but this time dos style (no spaces!) so that the unix form looks + # like /cygdrive/c/PROGRA~1:/cygdr... + sys_lib_search_path_spec=`cygpath --path --unix "$LIB"` + sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null` + sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + ;; + *) + sys_lib_search_path_spec=$LIB + if $ECHO "$sys_lib_search_path_spec" | $GREP ';[c-zC-Z]:/' >/dev/null; then + # It is most probably a Windows format PATH. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` + else + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + fi + # FIXME: find the short name or the path components, as spaces are + # common. (e.g. "Program Files" -> "PROGRA~1") + ;; + esac + + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + dynamic_linker='Win32 link.exe' + ;; + + *) + # Assume MSVC wrapper + library_names_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext $libname.lib' + dynamic_linker='Win32 ld.exe' + ;; + esac + # FIXME: first we should search . and the directory the executable is in + shlibpath_var=PATH + ;; + +darwin* | rhapsody*) + dynamic_linker="$host_os dyld" + version_type=darwin + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$major$shared_ext $libname$shared_ext' + soname_spec='$libname$release$major$shared_ext' + shlibpath_overrides_runpath=yes + shlibpath_var=DYLD_LIBRARY_PATH + shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' + + sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' + ;; + +dgux*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +freebsd* | dragonfly*) + # DragonFly does not have aout. When/if they implement a new + # versioning mechanism, adjust this. + if test -x /usr/bin/objformat; then + objformat=`/usr/bin/objformat` + else + case $host_os in + freebsd[23].*) objformat=aout ;; + *) objformat=elf ;; + esac + fi + version_type=freebsd-$objformat + case $version_type in + freebsd-elf*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + need_version=no + need_lib_prefix=no + ;; + freebsd-*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + need_version=yes + ;; + esac + shlibpath_var=LD_LIBRARY_PATH + case $host_os in + freebsd2.*) + shlibpath_overrides_runpath=yes + ;; + freebsd3.[01]* | freebsdelf3.[01]*) + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ + freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + *) # from 4.6 on, and DragonFly + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + esac + ;; + +haiku*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + dynamic_linker="$host_os runtime_loader" + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LIBRARY_PATH + shlibpath_overrides_runpath=no + sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib' + hardcode_into_libs=yes + ;; + +hpux9* | hpux10* | hpux11*) + # Give a soname corresponding to the major version so that dld.sl refuses to + # link against other versions. + version_type=sunos + need_lib_prefix=no + need_version=no + case $host_cpu in + ia64*) + shrext_cmds='.so' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.so" + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + if test 32 = "$HPUX_IA64_MODE"; then + sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" + sys_lib_dlsearch_path_spec=/usr/lib/hpux32 + else + sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" + sys_lib_dlsearch_path_spec=/usr/lib/hpux64 + fi + ;; + hppa*64*) + shrext_cmds='.sl' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.sl" + shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + *) + shrext_cmds='.sl' + dynamic_linker="$host_os dld.sl" + shlibpath_var=SHLIB_PATH + shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + ;; + esac + # HP-UX runs *really* slowly unless shared libraries are mode 555, ... + postinstall_cmds='chmod 555 $lib' + # or fails outright, so override atomically: + install_override_mode=555 + ;; + +interix[3-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +irix5* | irix6* | nonstopux*) + case $host_os in + nonstopux*) version_type=nonstopux ;; + *) + if test yes = "$lt_cv_prog_gnu_ld"; then + version_type=linux # correct to gnu/linux during the next big refactor + else + version_type=irix + fi ;; + esac + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$release$shared_ext $libname$shared_ext' + case $host_os in + irix5* | nonstopux*) + libsuff= shlibsuff= + ;; + *) + case $LD in # libtool.m4 will add one of these switches to LD + *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") + libsuff= shlibsuff= libmagic=32-bit;; + *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") + libsuff=32 shlibsuff=N32 libmagic=N32;; + *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") + libsuff=64 shlibsuff=64 libmagic=64-bit;; + *) libsuff= shlibsuff= libmagic=never-match;; + esac + ;; + esac + shlibpath_var=LD_LIBRARY${shlibsuff}_PATH + shlibpath_overrides_runpath=no + sys_lib_search_path_spec="/usr/lib$libsuff /lib$libsuff /usr/local/lib$libsuff" + sys_lib_dlsearch_path_spec="/usr/lib$libsuff /lib$libsuff" + hardcode_into_libs=yes + ;; + +# No shared lib support for Linux oldld, aout, or coff. +linux*oldld* | linux*aout* | linux*coff*) + dynamic_linker=no + ;; + +linux*android*) + version_type=none # Android doesn't support versioned libraries. + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext' + soname_spec='$libname$release$shared_ext' + finish_cmds= + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + dynamic_linker='Android linker' + # Don't embed -rpath directories since the linker doesn't support them. + hardcode_libdir_flag_spec_CXX='-L$libdir' + ;; + +# This must be glibc/ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + + # Some binutils ld are patched to set DT_RUNPATH + if ${lt_cv_shlibpath_overrides_runpath+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_shlibpath_overrides_runpath=no + save_LDFLAGS=$LDFLAGS + save_libdir=$libdir + eval "libdir=/foo; wl=\"$lt_prog_compiler_wl_CXX\"; \ + LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec_CXX\"" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_link "$LINENO"; then : + if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then : + lt_cv_shlibpath_overrides_runpath=yes +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS + libdir=$save_libdir + +fi + + shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + # Ideally, we could use ldconfig to report *all* directores which are + # searched for libraries, however this is still not possible. Aside from not + # being certain /sbin/ldconfig is available, command + # 'ldconfig -N -X -v | grep ^/' on 64bit Fedora does not report /usr/lib64, + # even though it is searched at run-time. Try to do the best guess by + # appending ld.so.conf contents (and includes) to the search path. + if test -f /etc/ld.so.conf; then + lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '` + sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" + fi + + # We used to test for /lib/ld.so.1 and disable shared libraries on + # powerpc, because MkLinux only supported shared libraries with the + # GNU dynamic linker. Since this was broken with cross compilers, + # most powerpc-linux boxes support dynamic linking these days and + # people can always --disable-shared, the test was removed, and we + # assume the GNU/Linux dynamic linker is in use. + dynamic_linker='GNU/Linux ld.so' + ;; + +netbsd*) + version_type=sunos + need_lib_prefix=no + need_version=no + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + dynamic_linker='NetBSD (a.out) ld.so' + else + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='NetBSD ld.elf_so' + fi + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + +newsos6) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +*nto* | *qnx*) + version_type=qnx + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + dynamic_linker='ldqnx.so' + ;; + +openbsd* | bitrig*) + version_type=sunos + sys_lib_dlsearch_path_spec=/usr/lib + need_lib_prefix=no + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + need_version=no + else + need_version=yes + fi + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +os2*) + libname_spec='$name' + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + # OS/2 can only load a DLL with a base name of 8 characters or less. + soname_spec='`test -n "$os2dllname" && libname="$os2dllname"; + v=$($ECHO $release$versuffix | tr -d .-); + n=$($ECHO $libname | cut -b -$((8 - ${#v})) | tr . _); + $ECHO $n$v`$shared_ext' + library_names_spec='${libname}_dll.$libext' + dynamic_linker='OS/2 ld.exe' + shlibpath_var=BEGINLIBPATH + sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; $ECHO \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; $ECHO \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + ;; + +osf3* | osf4* | osf5*) + version_type=osf + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + +rdos*) + dynamic_linker=no + ;; + +solaris*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + # ldd complains unless libraries are executable + postinstall_cmds='chmod +x $lib' + ;; + +sunos4*) + version_type=sunos + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + if test yes = "$with_gnu_ld"; then + need_lib_prefix=no + fi + need_version=yes + ;; + +sysv4 | sysv4.3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + case $host_vendor in + sni) + shlibpath_overrides_runpath=no + need_lib_prefix=no + runpath_var=LD_RUN_PATH + ;; + siemens) + need_lib_prefix=no + ;; + motorola) + need_lib_prefix=no + need_version=no + shlibpath_overrides_runpath=no + sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' + ;; + esac + ;; + +sysv4*MP*) + if test -d /usr/nec; then + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$shared_ext.$versuffix $libname$shared_ext.$major $libname$shared_ext' + soname_spec='$libname$shared_ext.$major' + shlibpath_var=LD_LIBRARY_PATH + fi + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + version_type=sco + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + if test yes = "$with_gnu_ld"; then + sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' + else + sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' + case $host_os in + sco3.2v5*) + sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" + ;; + esac + fi + sys_lib_dlsearch_path_spec='/usr/lib' + ;; + +tpf*) + # TPF is a cross-target only. Preferred cross-host = GNU/Linux. + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +uts4*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +*) + dynamic_linker=no + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5 +$as_echo "$dynamic_linker" >&6; } +test no = "$dynamic_linker" && can_build_shared=no + +variables_saved_for_relink="PATH $shlibpath_var $runpath_var" +if test yes = "$GCC"; then + variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" +fi + +if test set = "${lt_cv_sys_lib_search_path_spec+set}"; then + sys_lib_search_path_spec=$lt_cv_sys_lib_search_path_spec +fi + +if test set = "${lt_cv_sys_lib_dlsearch_path_spec+set}"; then + sys_lib_dlsearch_path_spec=$lt_cv_sys_lib_dlsearch_path_spec +fi + +# remember unaugmented sys_lib_dlsearch_path content for libtool script decls... +configure_time_dlsearch_path=$sys_lib_dlsearch_path_spec + +# ... but it needs LT_SYS_LIBRARY_PATH munging for other configure-time code +func_munge_path_list sys_lib_dlsearch_path_spec "$LT_SYS_LIBRARY_PATH" + +# to be used as default LT_SYS_LIBRARY_PATH value in generated libtool +configure_time_lt_sys_library_path=$LT_SYS_LIBRARY_PATH + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5 +$as_echo_n "checking how to hardcode library paths into programs... " >&6; } +hardcode_action_CXX= +if test -n "$hardcode_libdir_flag_spec_CXX" || + test -n "$runpath_var_CXX" || + test yes = "$hardcode_automatic_CXX"; then + + # We can hardcode non-existent directories. + if test no != "$hardcode_direct_CXX" && + # If the only mechanism to avoid hardcoding is shlibpath_var, we + # have to relink, otherwise we might link with an installed library + # when we should be linking with a yet-to-be-installed one + ## test no != "$_LT_TAGVAR(hardcode_shlibpath_var, CXX)" && + test no != "$hardcode_minus_L_CXX"; then + # Linking always hardcodes the temporary library directory. + hardcode_action_CXX=relink + else + # We can link without hardcoding, and we can hardcode nonexisting dirs. + hardcode_action_CXX=immediate + fi +else + # We cannot hardcode anything, or else we can only hardcode existing + # directories. + hardcode_action_CXX=unsupported +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action_CXX" >&5 +$as_echo "$hardcode_action_CXX" >&6; } + +if test relink = "$hardcode_action_CXX" || + test yes = "$inherit_rpath_CXX"; then + # Fast installation is not supported + enable_fast_install=no +elif test yes = "$shlibpath_overrides_runpath" || + test no = "$enable_shared"; then + # Fast installation is not necessary + enable_fast_install=needless +fi + + + + + + + + fi # test -n "$compiler" + + CC=$lt_save_CC + CFLAGS=$lt_save_CFLAGS + LDCXX=$LD + LD=$lt_save_LD + GCC=$lt_save_GCC + with_gnu_ld=$lt_save_with_gnu_ld + lt_cv_path_LDCXX=$lt_cv_path_LD + lt_cv_path_LD=$lt_save_path_LD + lt_cv_prog_gnu_ldcxx=$lt_cv_prog_gnu_ld + lt_cv_prog_gnu_ld=$lt_save_with_gnu_ld +fi # test yes != "$_lt_caught_CXX_error" + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + ac_ext=f +ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' +ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_f77_compiler_gnu + +if test -z "$F77" || test no = "$F77"; then + _lt_disable_F77=yes +fi + +archive_cmds_need_lc_F77=no +allow_undefined_flag_F77= +always_export_symbols_F77=no +archive_expsym_cmds_F77= +export_dynamic_flag_spec_F77= +hardcode_direct_F77=no +hardcode_direct_absolute_F77=no +hardcode_libdir_flag_spec_F77= +hardcode_libdir_separator_F77= +hardcode_minus_L_F77=no +hardcode_automatic_F77=no +inherit_rpath_F77=no +module_cmds_F77= +module_expsym_cmds_F77= +link_all_deplibs_F77=unknown +old_archive_cmds_F77=$old_archive_cmds +reload_flag_F77=$reload_flag +reload_cmds_F77=$reload_cmds +no_undefined_flag_F77= +whole_archive_flag_spec_F77= +enable_shared_with_static_runtimes_F77=no + +# Source file extension for f77 test sources. +ac_ext=f + +# Object file extension for compiled f77 test sources. +objext=o +objext_F77=$objext + +# No sense in running all these tests if we already determined that +# the F77 compiler isn't working. Some variables (like enable_shared) +# are currently assumed to apply to all compilers on this platform, +# and will be corrupted by setting them based on a non-working compiler. +if test yes != "$_lt_disable_F77"; then + # Code to be used in simple compile tests + lt_simple_compile_test_code="\ + subroutine t + return + end +" + + # Code to be used in simple link tests + lt_simple_link_test_code="\ + program t + end +" + + # ltmain only uses $CC for tagged configurations so make sure $CC is set. + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + + + # save warnings/boilerplate of simple test code + ac_outfile=conftest.$ac_objext +echo "$lt_simple_compile_test_code" >conftest.$ac_ext +eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_compiler_boilerplate=`cat conftest.err` +$RM conftest* + + ac_outfile=conftest.$ac_objext +echo "$lt_simple_link_test_code" >conftest.$ac_ext +eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_linker_boilerplate=`cat conftest.err` +$RM -r conftest* + + + # Allow CC to be a program name with arguments. + lt_save_CC=$CC + lt_save_GCC=$GCC + lt_save_CFLAGS=$CFLAGS + CC=${F77-"f77"} + CFLAGS=$FFLAGS + compiler=$CC + compiler_F77=$CC + func_cc_basename $compiler +cc_basename=$func_cc_basename_result + + GCC=$G77 + if test -n "$compiler"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5 +$as_echo_n "checking if libtool supports shared libraries... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5 +$as_echo "$can_build_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5 +$as_echo_n "checking whether to build shared libraries... " >&6; } + test no = "$can_build_shared" && enable_shared=no + + # On AIX, shared libraries and static libraries use the same namespace, and + # are all built from PIC. + case $host_os in + aix3*) + test yes = "$enable_shared" && enable_static=no + if test -n "$RANLIB"; then + archive_cmds="$archive_cmds~\$RANLIB \$lib" + postinstall_cmds='$RANLIB $lib' + fi + ;; + aix[4-9]*) + if test ia64 != "$host_cpu"; then + case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in + yes,aix,yes) ;; # shared object as lib.so file only + yes,svr4,*) ;; # shared object as lib.so archive member only + yes,*) enable_static=no ;; # shared object in lib.a archive as well + esac + fi + ;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5 +$as_echo "$enable_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5 +$as_echo_n "checking whether to build static libraries... " >&6; } + # Make sure either enable_shared or enable_static is yes. + test yes = "$enable_shared" || enable_static=yes + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5 +$as_echo "$enable_static" >&6; } + + GCC_F77=$G77 + LD_F77=$LD + + ## CAVEAT EMPTOR: + ## There is no encapsulation within the following macros, do not change + ## the running order or otherwise move them around unless you know exactly + ## what you are doing... + lt_prog_compiler_wl_F77= +lt_prog_compiler_pic_F77= +lt_prog_compiler_static_F77= + + + if test yes = "$GCC"; then + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_static_F77='-static' + + case $host_os in + aix*) + # All AIX code is PIC. + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static_F77='-Bstatic' + fi + lt_prog_compiler_pic_F77='-fPIC' + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + lt_prog_compiler_pic_F77='-fPIC' + ;; + m68k) + # FIXME: we need at least 68020 code to build shared libraries, but + # adding the '-m68020' flag to GCC prevents building anything better, + # like '-m68040'. + lt_prog_compiler_pic_F77='-m68020 -resident32 -malways-restore-a4' + ;; + esac + ;; + + beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) + # PIC is the default for these OSes. + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + # Although the cygwin gcc ignores -fPIC, still need this for old-style + # (--disable-auto-import) libraries + lt_prog_compiler_pic_F77='-DDLL_EXPORT' + case $host_os in + os2*) + lt_prog_compiler_static_F77='$wl-static' + ;; + esac + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic_F77='-fno-common' + ;; + + haiku*) + # PIC is the default for Haiku. + # The "-static" flag exists, but is broken. + lt_prog_compiler_static_F77= + ;; + + hpux*) + # PIC is the default for 64-bit PA HP-UX, but not for 32-bit + # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag + # sets the default TLS model and affects inlining. + case $host_cpu in + hppa*64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic_F77='-fPIC' + ;; + esac + ;; + + interix[3-9]*) + # Interix 3.x gcc -fpic/-fPIC options generate broken code. + # Instead, we relocate shared libraries at runtime. + ;; + + msdosdjgpp*) + # Just because we use GCC doesn't mean we suddenly get shared libraries + # on systems that don't support them. + lt_prog_compiler_can_build_shared_F77=no + enable_shared=no + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic_F77='-fPIC -shared' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic_F77=-Kconform_pic + fi + ;; + + *) + lt_prog_compiler_pic_F77='-fPIC' + ;; + esac + + case $cc_basename in + nvcc*) # Cuda Compiler Driver 2.2 + lt_prog_compiler_wl_F77='-Xlinker ' + if test -n "$lt_prog_compiler_pic_F77"; then + lt_prog_compiler_pic_F77="-Xcompiler $lt_prog_compiler_pic_F77" + fi + ;; + esac + else + # PORTME Check for flag to pass linker flags through the system compiler. + case $host_os in + aix*) + lt_prog_compiler_wl_F77='-Wl,' + if test ia64 = "$host_cpu"; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static_F77='-Bstatic' + else + lt_prog_compiler_static_F77='-bnso -bI:/lib/syscalls.exp' + fi + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic_F77='-fno-common' + case $cc_basename in + nagfor*) + # NAG Fortran compiler + lt_prog_compiler_wl_F77='-Wl,-Wl,,' + lt_prog_compiler_pic_F77='-PIC' + lt_prog_compiler_static_F77='-Bstatic' + ;; + esac + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + lt_prog_compiler_pic_F77='-DDLL_EXPORT' + case $host_os in + os2*) + lt_prog_compiler_static_F77='$wl-static' + ;; + esac + ;; + + hpux9* | hpux10* | hpux11*) + lt_prog_compiler_wl_F77='-Wl,' + # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but + # not for PA HP-UX. + case $host_cpu in + hppa*64*|ia64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic_F77='+Z' + ;; + esac + # Is there a better lt_prog_compiler_static that works with the bundled CC? + lt_prog_compiler_static_F77='$wl-a ${wl}archive' + ;; + + irix5* | irix6* | nonstopux*) + lt_prog_compiler_wl_F77='-Wl,' + # PIC (with -KPIC) is the default. + lt_prog_compiler_static_F77='-non_shared' + ;; + + linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + case $cc_basename in + # old Intel for x86_64, which still supported -KPIC. + ecc*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-static' + ;; + # icc used to be incompatible with GCC. + # ICC 10 doesn't accept -KPIC any more. + icc* | ifort*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-fPIC' + lt_prog_compiler_static_F77='-static' + ;; + # Lahey Fortran 8.1. + lf95*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='--shared' + lt_prog_compiler_static_F77='--static' + ;; + nagfor*) + # NAG Fortran compiler + lt_prog_compiler_wl_F77='-Wl,-Wl,,' + lt_prog_compiler_pic_F77='-PIC' + lt_prog_compiler_static_F77='-Bstatic' + ;; + tcc*) + # Fabrice Bellard et al's Tiny C Compiler + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-fPIC' + lt_prog_compiler_static_F77='-static' + ;; + pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group compilers (*not* the Pentium gcc compiler, + # which looks to be a dead project) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-fpic' + lt_prog_compiler_static_F77='-Bstatic' + ;; + ccc*) + lt_prog_compiler_wl_F77='-Wl,' + # All Alpha code is PIC. + lt_prog_compiler_static_F77='-non_shared' + ;; + xl* | bgxl* | bgf* | mpixl*) + # IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-qpic' + lt_prog_compiler_static_F77='-qstaticlink' + ;; + *) + case `$CC -V 2>&1 | sed 5q` in + *Sun\ Ceres\ Fortran* | *Sun*Fortran*\ [1-7].* | *Sun*Fortran*\ 8.[0-3]*) + # Sun Fortran 8.3 passes all unrecognized flags to the linker + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + lt_prog_compiler_wl_F77='' + ;; + *Sun\ F* | *Sun*Fortran*) + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + lt_prog_compiler_wl_F77='-Qoption ld ' + ;; + *Sun\ C*) + # Sun C 5.9 + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + lt_prog_compiler_wl_F77='-Wl,' + ;; + *Intel*\ [CF]*Compiler*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-fPIC' + lt_prog_compiler_static_F77='-static' + ;; + *Portland\ Group*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-fpic' + lt_prog_compiler_static_F77='-Bstatic' + ;; + esac + ;; + esac + ;; + + newsos6) + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic_F77='-fPIC -shared' + ;; + + osf3* | osf4* | osf5*) + lt_prog_compiler_wl_F77='-Wl,' + # All OSF/1 code is PIC. + lt_prog_compiler_static_F77='-non_shared' + ;; + + rdos*) + lt_prog_compiler_static_F77='-non_shared' + ;; + + solaris*) + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + case $cc_basename in + f77* | f90* | f95* | sunf77* | sunf90* | sunf95*) + lt_prog_compiler_wl_F77='-Qoption ld ';; + *) + lt_prog_compiler_wl_F77='-Wl,';; + esac + ;; + + sunos4*) + lt_prog_compiler_wl_F77='-Qoption ld ' + lt_prog_compiler_pic_F77='-PIC' + lt_prog_compiler_static_F77='-Bstatic' + ;; + + sysv4 | sysv4.2uw2* | sysv4.3*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic_F77='-Kconform_pic' + lt_prog_compiler_static_F77='-Bstatic' + fi + ;; + + sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_pic_F77='-KPIC' + lt_prog_compiler_static_F77='-Bstatic' + ;; + + unicos*) + lt_prog_compiler_wl_F77='-Wl,' + lt_prog_compiler_can_build_shared_F77=no + ;; + + uts4*) + lt_prog_compiler_pic_F77='-pic' + lt_prog_compiler_static_F77='-Bstatic' + ;; + + *) + lt_prog_compiler_can_build_shared_F77=no + ;; + esac + fi + +case $host_os in + # For platforms that do not support PIC, -DPIC is meaningless: + *djgpp*) + lt_prog_compiler_pic_F77= + ;; + *) + lt_prog_compiler_pic_F77="$lt_prog_compiler_pic_F77" + ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5 +$as_echo_n "checking for $compiler option to produce PIC... " >&6; } +if ${lt_cv_prog_compiler_pic_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_F77=$lt_prog_compiler_pic_F77 +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_F77" >&5 +$as_echo "$lt_cv_prog_compiler_pic_F77" >&6; } +lt_prog_compiler_pic_F77=$lt_cv_prog_compiler_pic_F77 + +# +# Check to make sure the PIC flag actually works. +# +if test -n "$lt_prog_compiler_pic_F77"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic_F77 works" >&5 +$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic_F77 works... " >&6; } +if ${lt_cv_prog_compiler_pic_works_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_works_F77=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="$lt_prog_compiler_pic_F77" ## exclude from sc_useless_quotes_in_assignment + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_pic_works_F77=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works_F77" >&5 +$as_echo "$lt_cv_prog_compiler_pic_works_F77" >&6; } + +if test yes = "$lt_cv_prog_compiler_pic_works_F77"; then + case $lt_prog_compiler_pic_F77 in + "" | " "*) ;; + *) lt_prog_compiler_pic_F77=" $lt_prog_compiler_pic_F77" ;; + esac +else + lt_prog_compiler_pic_F77= + lt_prog_compiler_can_build_shared_F77=no +fi + +fi + + + + + +# +# Check to make sure the static flag actually works. +# +wl=$lt_prog_compiler_wl_F77 eval lt_tmp_static_flag=\"$lt_prog_compiler_static_F77\" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5 +$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; } +if ${lt_cv_prog_compiler_static_works_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_static_works_F77=no + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS $lt_tmp_static_flag" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_static_works_F77=yes + fi + else + lt_cv_prog_compiler_static_works_F77=yes + fi + fi + $RM -r conftest* + LDFLAGS=$save_LDFLAGS + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works_F77" >&5 +$as_echo "$lt_cv_prog_compiler_static_works_F77" >&6; } + +if test yes = "$lt_cv_prog_compiler_static_works_F77"; then + : +else + lt_prog_compiler_static_F77= +fi + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o_F77=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o_F77=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_F77" >&5 +$as_echo "$lt_cv_prog_compiler_c_o_F77" >&6; } + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o_F77=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o_F77=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_F77" >&5 +$as_echo "$lt_cv_prog_compiler_c_o_F77" >&6; } + + + + +hard_links=nottested +if test no = "$lt_cv_prog_compiler_c_o_F77" && test no != "$need_locks"; then + # do not overwrite the value of need_locks provided by the user + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5 +$as_echo_n "checking if we can lock with hard links... " >&6; } + hard_links=yes + $RM conftest* + ln conftest.a conftest.b 2>/dev/null && hard_links=no + touch conftest.a + ln conftest.a conftest.b 2>&5 || hard_links=no + ln conftest.a conftest.b 2>/dev/null && hard_links=no + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5 +$as_echo "$hard_links" >&6; } + if test no = "$hard_links"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&5 +$as_echo "$as_me: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&2;} + need_locks=warn + fi +else + need_locks=no +fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 +$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } + + runpath_var= + allow_undefined_flag_F77= + always_export_symbols_F77=no + archive_cmds_F77= + archive_expsym_cmds_F77= + compiler_needs_object_F77=no + enable_shared_with_static_runtimes_F77=no + export_dynamic_flag_spec_F77= + export_symbols_cmds_F77='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' + hardcode_automatic_F77=no + hardcode_direct_F77=no + hardcode_direct_absolute_F77=no + hardcode_libdir_flag_spec_F77= + hardcode_libdir_separator_F77= + hardcode_minus_L_F77=no + hardcode_shlibpath_var_F77=unsupported + inherit_rpath_F77=no + link_all_deplibs_F77=unknown + module_cmds_F77= + module_expsym_cmds_F77= + old_archive_from_new_cmds_F77= + old_archive_from_expsyms_cmds_F77= + thread_safe_flag_spec_F77= + whole_archive_flag_spec_F77= + # include_expsyms should be a list of space-separated symbols to be *always* + # included in the symbol list + include_expsyms_F77= + # exclude_expsyms can be an extended regexp of symbols to exclude + # it will be wrapped by ' (' and ')$', so one must not match beginning or + # end of line. Example: 'a|bc|.*d.*' will exclude the symbols 'a' and 'bc', + # as well as any symbol that contains 'd'. + exclude_expsyms_F77='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' + # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out + # platforms (ab)use it in PIC code, but their linkers get confused if + # the symbol is explicitly referenced. Since portable code cannot + # rely on this symbol name, it's probably fine to never include it in + # preloaded symbol tables. + # Exclude shared library initialization/finalization symbols. + extract_expsyms_cmds= + + case $host_os in + cygwin* | mingw* | pw32* | cegcc*) + # FIXME: the MSVC++ port hasn't been tested in a loooong time + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + if test yes != "$GCC"; then + with_gnu_ld=no + fi + ;; + interix*) + # we just hope/assume this is gcc and not c89 (= MSVC++) + with_gnu_ld=yes + ;; + openbsd* | bitrig*) + with_gnu_ld=no + ;; + esac + + ld_shlibs_F77=yes + + # On some targets, GNU ld is compatible enough with the native linker + # that we're better off using the native interface for both. + lt_use_gnu_ld_interface=no + if test yes = "$with_gnu_ld"; then + case $host_os in + aix*) + # The AIX port of GNU ld has always aspired to compatibility + # with the native linker. However, as the warning in the GNU ld + # block says, versions before 2.19.5* couldn't really create working + # shared libraries, regardless of the interface used. + case `$LD -v 2>&1` in + *\ \(GNU\ Binutils\)\ 2.19.5*) ;; + *\ \(GNU\ Binutils\)\ 2.[2-9]*) ;; + *\ \(GNU\ Binutils\)\ [3-9]*) ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + fi + + if test yes = "$lt_use_gnu_ld_interface"; then + # If archive_cmds runs LD, not CC, wlarc should be empty + wlarc='$wl' + + # Set some defaults for GNU ld with shared library support. These + # are reset later if shared libraries are not supported. Putting them + # here allows them to be overridden if necessary. + runpath_var=LD_RUN_PATH + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + export_dynamic_flag_spec_F77='$wl--export-dynamic' + # ancient GNU ld didn't support --whole-archive et. al. + if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then + whole_archive_flag_spec_F77=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' + else + whole_archive_flag_spec_F77= + fi + supports_anon_versioning=no + case `$LD -v | $SED -e 's/(^)\+)\s\+//' 2>&1` in + *GNU\ gold*) supports_anon_versioning=yes ;; + *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11 + *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... + *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... + *\ 2.11.*) ;; # other 2.11 versions + *) supports_anon_versioning=yes ;; + esac + + # See if GNU ld supports shared libraries. + case $host_os in + aix[3-9]*) + # On AIX/PPC, the GNU linker is very broken + if test ia64 != "$host_cpu"; then + ld_shlibs_F77=no + cat <<_LT_EOF 1>&2 + +*** Warning: the GNU linker, at least up to release 2.19, is reported +*** to be unable to reliably create shared libraries on AIX. +*** Therefore, libtool is disabling shared libraries support. If you +*** really care for shared libraries, you may want to install binutils +*** 2.20 or above, or modify your PATH so that a non-GNU linker is found. +*** You will then need to restart the configuration process. + +_LT_EOF + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_F77='' + ;; + m68k) + archive_cmds_F77='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_minus_L_F77=yes + ;; + esac + ;; + + beos*) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + allow_undefined_flag_F77=unsupported + # Joseph Beckenbach says some releases of gcc + # support --undefined. This deserves some investigation. FIXME + archive_cmds_F77='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + else + ld_shlibs_F77=no + fi + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # _LT_TAGVAR(hardcode_libdir_flag_spec, F77) is actually meaningless, + # as there is no search path for DLLs. + hardcode_libdir_flag_spec_F77='-L$libdir' + export_dynamic_flag_spec_F77='$wl--export-all-symbols' + allow_undefined_flag_F77=unsupported + always_export_symbols_F77=no + enable_shared_with_static_runtimes_F77=yes + export_symbols_cmds_F77='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/;s/^.*[ ]__nm__\([^ ]*\)[ ][^ ]*/\1 DATA/;/^I[ ]/d;/^[AITW][ ]/s/.* //'\'' | sort | uniq > $export_symbols' + exclude_expsyms_F77='[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname' + + if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then + archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + # If the export-symbols file already is a .def file, use it as + # is; otherwise, prepend EXPORTS... + archive_expsym_cmds_F77='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp $export_symbols $output_objdir/$soname.def; + else + echo EXPORTS > $output_objdir/$soname.def; + cat $export_symbols >> $output_objdir/$soname.def; + fi~ + $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + else + ld_shlibs_F77=no + fi + ;; + + haiku*) + archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + link_all_deplibs_F77=yes + ;; + + os2*) + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_minus_L_F77=yes + allow_undefined_flag_F77=unsupported + shrext_cmds=.dll + archive_cmds_F77='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + archive_expsym_cmds_F77='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + prefix_cmds="$SED"~ + if test EXPORTS = "`$SED 1q $export_symbols`"; then + prefix_cmds="$prefix_cmds -e 1d"; + fi~ + prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ + cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + old_archive_From_new_cmds_F77='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' + enable_shared_with_static_runtimes_F77=yes + ;; + + interix[3-9]*) + hardcode_direct_F77=no + hardcode_shlibpath_var_F77=no + hardcode_libdir_flag_spec_F77='$wl-rpath,$libdir' + export_dynamic_flag_spec_F77='$wl-E' + # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. + # Instead, shared libraries are loaded at an image base (0x10000000 by + # default) and relocated if they conflict, which is a slow very memory + # consuming and fragmenting process. To avoid this, we pick a random, + # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link + # time. Moving up from 0x10000000 also allows more sbrk(2) space. + archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + archive_expsym_cmds_F77='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + ;; + + gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) + tmp_diet=no + if test linux-dietlibc = "$host_os"; then + case $cc_basename in + diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn) + esac + fi + if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \ + && test no = "$tmp_diet" + then + tmp_addflag=' $pic_flag' + tmp_sharedflag='-shared' + case $cc_basename,$host_cpu in + pgcc*) # Portland Group C compiler + whole_archive_flag_spec_F77='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + tmp_addflag=' $pic_flag' + ;; + pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group f77 and f90 compilers + whole_archive_flag_spec_F77='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + tmp_addflag=' $pic_flag -Mnomain' ;; + ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 + tmp_addflag=' -i_dynamic' ;; + efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 + tmp_addflag=' -i_dynamic -nofor_main' ;; + ifc* | ifort*) # Intel Fortran compiler + tmp_addflag=' -nofor_main' ;; + lf95*) # Lahey Fortran 8.1 + whole_archive_flag_spec_F77= + tmp_sharedflag='--shared' ;; + nagfor*) # NAGFOR 5.3 + tmp_sharedflag='-Wl,-shared' ;; + xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below) + tmp_sharedflag='-qmkshrobj' + tmp_addflag= ;; + nvcc*) # Cuda Compiler Driver 2.2 + whole_archive_flag_spec_F77='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + compiler_needs_object_F77=yes + ;; + esac + case `$CC -V 2>&1 | sed 5q` in + *Sun\ C*) # Sun C 5.9 + whole_archive_flag_spec_F77='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' + compiler_needs_object_F77=yes + tmp_sharedflag='-G' ;; + *Sun\ F*) # Sun Fortran 8.3 + tmp_sharedflag='-G' ;; + esac + archive_cmds_F77='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + + if test yes = "$supports_anon_versioning"; then + archive_expsym_cmds_F77='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib' + fi + + case $cc_basename in + tcc*) + export_dynamic_flag_spec_F77='-rdynamic' + ;; + xlf* | bgf* | bgxlf* | mpixlf*) + # IBM XL Fortran 10.1 on PPC cannot create shared libs itself + whole_archive_flag_spec_F77='--whole-archive$convenience --no-whole-archive' + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + archive_cmds_F77='$LD -shared $libobjs $deplibs $linker_flags -soname $soname -o $lib' + if test yes = "$supports_anon_versioning"; then + archive_expsym_cmds_F77='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $LD -shared $libobjs $deplibs $linker_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib' + fi + ;; + esac + else + ld_shlibs_F77=no + fi + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds_F77='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' + wlarc= + else + archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + fi + ;; + + solaris*) + if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then + ld_shlibs_F77=no + cat <<_LT_EOF 1>&2 + +*** Warning: The releases 2.8.* of the GNU linker cannot reliably +*** create shared libraries on Solaris systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.9.1 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs_F77=no + fi + ;; + + sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) + case `$LD -v 2>&1` in + *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) + ld_shlibs_F77=no + cat <<_LT_EOF 1>&2 + +*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 cannot +*** reliably create shared libraries on SCO systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.16.91.0.3 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + ;; + *) + # For security reasons, it is highly recommended that you always + # use absolute paths for naming shared libraries, and exclude the + # DT_RUNPATH tag from executables and libraries. But doing so + # requires that you compile everything twice, which is a pain. + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs_F77=no + fi + ;; + esac + ;; + + sunos4*) + archive_cmds_F77='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' + wlarc= + hardcode_direct_F77=yes + hardcode_shlibpath_var_F77=no + ;; + + *) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs_F77=no + fi + ;; + esac + + if test no = "$ld_shlibs_F77"; then + runpath_var= + hardcode_libdir_flag_spec_F77= + export_dynamic_flag_spec_F77= + whole_archive_flag_spec_F77= + fi + else + # PORTME fill in a description of your system's linker (not GNU ld) + case $host_os in + aix3*) + allow_undefined_flag_F77=unsupported + always_export_symbols_F77=yes + archive_expsym_cmds_F77='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' + # Note: this linker hardcodes the directories in LIBPATH if there + # are no directories specified by -L. + hardcode_minus_L_F77=yes + if test yes = "$GCC" && test -z "$lt_prog_compiler_static"; then + # Neither direct hardcoding nor static linking is supported with a + # broken collect2. + hardcode_direct_F77=unsupported + fi + ;; + + aix[4-9]*) + if test ia64 = "$host_cpu"; then + # On IA64, the linker does run time linking by default, so we don't + # have to do anything special. + aix_use_runtimelinking=no + exp_sym_flag='-Bexport' + no_entry_flag= + else + # If we're using GNU nm, then we don't want the "-C" option. + # -C means demangle to GNU nm, but means don't demangle to AIX nm. + # Without the "-l" option, or with the "-B" option, AIX nm treats + # weak defined symbols like other global defined symbols, whereas + # GNU nm marks them as "W". + # While the 'weak' keyword is ignored in the Export File, we need + # it in the Import File for the 'aix-soname' feature, so we have + # to replace the "-B" option with "-P" for AIX nm. + if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then + export_symbols_cmds_F77='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols' + else + export_symbols_cmds_F77='`func_echo_all $NM | $SED -e '\''s/B\([^B]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && (substr(\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols' + fi + aix_use_runtimelinking=no + + # Test if we are trying to use run time linking or normal + # AIX style linking. If -brtl is somewhere in LDFLAGS, we + # have runtime linking enabled, and use it for executables. + # For shared libraries, we enable/disable runtime linking + # depending on the kind of the shared library created - + # when "with_aix_soname,aix_use_runtimelinking" is: + # "aix,no" lib.a(lib.so.V) shared, rtl:no, for executables + # "aix,yes" lib.so shared, rtl:yes, for executables + # lib.a static archive + # "both,no" lib.so.V(shr.o) shared, rtl:yes + # lib.a(lib.so.V) shared, rtl:no, for executables + # "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a(lib.so.V) shared, rtl:no + # "svr4,*" lib.so.V(shr.o) shared, rtl:yes, for executables + # lib.a static archive + case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) + for ld_flag in $LDFLAGS; do + if (test x-brtl = "x$ld_flag" || test x-Wl,-brtl = "x$ld_flag"); then + aix_use_runtimelinking=yes + break + fi + done + if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then + # With aix-soname=svr4, we create the lib.so.V shared archives only, + # so we don't have lib.a shared libs to link our executables. + # We have to force runtime linking in this case. + aix_use_runtimelinking=yes + LDFLAGS="$LDFLAGS -Wl,-brtl" + fi + ;; + esac + + exp_sym_flag='-bexport' + no_entry_flag='-bnoentry' + fi + + # When large executables or shared objects are built, AIX ld can + # have problems creating the table of contents. If linking a library + # or program results in "error TOC overflow" add -mminimal-toc to + # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not + # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. + + archive_cmds_F77='' + hardcode_direct_F77=yes + hardcode_direct_absolute_F77=yes + hardcode_libdir_separator_F77=':' + link_all_deplibs_F77=yes + file_list_spec_F77='$wl-f,' + case $with_aix_soname,$aix_use_runtimelinking in + aix,*) ;; # traditional, no import file + svr4,* | *,yes) # use import file + # The Import File defines what to hardcode. + hardcode_direct_F77=no + hardcode_direct_absolute_F77=no + ;; + esac + + if test yes = "$GCC"; then + case $host_os in aix4.[012]|aix4.[012].*) + # We only want to do this on AIX 4.2 and lower, the check + # below for broken collect2 doesn't work under 4.3+ + collect2name=`$CC -print-prog-name=collect2` + if test -f "$collect2name" && + strings "$collect2name" | $GREP resolve_lib_name >/dev/null + then + # We have reworked collect2 + : + else + # We have old collect2 + hardcode_direct_F77=unsupported + # It fails to find uninstalled libraries when the uninstalled + # path is not listed in the libpath. Setting hardcode_minus_L + # to unsupported forces relinking + hardcode_minus_L_F77=yes + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_libdir_separator_F77= + fi + ;; + esac + shared_flag='-shared' + if test yes = "$aix_use_runtimelinking"; then + shared_flag="$shared_flag "'$wl-G' + fi + # Need to ensure runtime linking is disabled for the traditional + # shared library, or the linker may eventually find shared libraries + # /with/ Import File - we do not want to mix them. + shared_flag_aix='-shared' + shared_flag_svr4='-shared $wl-G' + else + # not using gcc + if test ia64 = "$host_cpu"; then + # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release + # chokes on -Wl,-G. The following line is correct: + shared_flag='-G' + else + if test yes = "$aix_use_runtimelinking"; then + shared_flag='$wl-G' + else + shared_flag='$wl-bM:SRE' + fi + shared_flag_aix='$wl-bM:SRE' + shared_flag_svr4='$wl-G' + fi + fi + + export_dynamic_flag_spec_F77='$wl-bexpall' + # It seems that -bexpall does not export symbols beginning with + # underscore (_), so it is better to generate a list of symbols to export. + always_export_symbols_F77=yes + if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then + # Warning - without using the other runtime loading flags (-brtl), + # -berok will link without error, but may produce a broken library. + allow_undefined_flag_F77='-berok' + # Determine the default libpath from the value encoded in an + # empty executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath__F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_f77_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath__F77=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath__F77"; then + lt_cv_aix_libpath__F77=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath__F77"; then + lt_cv_aix_libpath__F77=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath__F77 +fi + + hardcode_libdir_flag_spec_F77='$wl-blibpath:$libdir:'"$aix_libpath" + archive_expsym_cmds_F77='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag + else + if test ia64 = "$host_cpu"; then + hardcode_libdir_flag_spec_F77='$wl-R $libdir:/usr/lib:/lib' + allow_undefined_flag_F77="-z nodefs" + archive_expsym_cmds_F77="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols" + else + # Determine the default libpath from the value encoded in an + # empty executable. + if test set = "${lt_cv_aix_libpath+set}"; then + aix_libpath=$lt_cv_aix_libpath +else + if ${lt_cv_aix_libpath__F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_f77_try_link "$LINENO"; then : + + lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\([^ ]*\) *$/\1/ + p + } + }' + lt_cv_aix_libpath__F77=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + # Check for a 64-bit object if we didn't find anything. + if test -z "$lt_cv_aix_libpath__F77"; then + lt_cv_aix_libpath__F77=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` + fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test -z "$lt_cv_aix_libpath__F77"; then + lt_cv_aix_libpath__F77=/usr/lib:/lib + fi + +fi + + aix_libpath=$lt_cv_aix_libpath__F77 +fi + + hardcode_libdir_flag_spec_F77='$wl-blibpath:$libdir:'"$aix_libpath" + # Warning - without using the other run time loading flags, + # -berok will link without error, but may produce a broken library. + no_undefined_flag_F77=' $wl-bernotok' + allow_undefined_flag_F77=' $wl-berok' + if test yes = "$with_gnu_ld"; then + # We only use this code for GNU lds that support --whole-archive. + whole_archive_flag_spec_F77='$wl--whole-archive$convenience $wl--no-whole-archive' + else + # Exported symbols can be pulled into shared objects from archives + whole_archive_flag_spec_F77='$convenience' + fi + archive_cmds_need_lc_F77=yes + archive_expsym_cmds_F77='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d' + # -brtl affects multiple linker settings, -berok does not and is overridden later + compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([, ]\\)%-berok\\1%g"`' + if test svr4 != "$with_aix_soname"; then + # This is similar to how AIX traditionally builds its shared libraries. + archive_expsym_cmds_F77="$archive_expsym_cmds_F77"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname' + fi + if test aix != "$with_aix_soname"; then + archive_expsym_cmds_F77="$archive_expsym_cmds_F77"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp' + else + # used by -dlpreopen to get the symbols + archive_expsym_cmds_F77="$archive_expsym_cmds_F77"'~$MV $output_objdir/$realname.d/$soname $output_objdir' + fi + archive_expsym_cmds_F77="$archive_expsym_cmds_F77"'~$RM -r $output_objdir/$realname.d' + fi + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' + archive_expsym_cmds_F77='' + ;; + m68k) + archive_cmds_F77='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_minus_L_F77=yes + ;; + esac + ;; + + bsdi[45]*) + export_dynamic_flag_spec_F77=-rdynamic + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++ or Intel C++/Fortran Compiler. + # hardcode_libdir_flag_spec is actually meaningless, as there is + # no search path for DLLs. + case $cc_basename in + cl* | icl*| ifort*) + # Native MSVC or ICC or IFORT + hardcode_libdir_flag_spec_F77=' ' + allow_undefined_flag_F77=unsupported + always_export_symbols_F77=yes + file_list_spec_F77='@' + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=.dll + # FIXME: Setting linknames here is a bad hack. + archive_cmds_F77='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames=' + archive_expsym_cmds_F77='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then + cp "$export_symbols" "$output_objdir/$soname.def"; + echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp"; + else + $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp; + fi~ + $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~ + linknames=' + # The linker will not automatically build a static lib if we build a DLL. + # _LT_TAGVAR(old_archive_from_new_cmds, F77)='true' + enable_shared_with_static_runtimes_F77=yes + exclude_expsyms_F77='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*' + export_symbols_cmds_F77='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1,DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols' + # Don't use ranlib + old_postinstall_cmds_F77='chmod 644 $oldlib' + postlink_cmds_F77='lt_outputfile="@OUTPUT@"~ + lt_tool_outputfile="@TOOL_OUTPUT@"~ + case $lt_outputfile in + *.exe|*.EXE) ;; + *) + lt_outputfile=$lt_outputfile.exe + lt_tool_outputfile=$lt_tool_outputfile.exe + ;; + esac~ + if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then + $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1; + $RM "$lt_outputfile.manifest"; + fi' + ;; + *) + # Assume MSVC and ICC and IFORT wrapper + hardcode_libdir_flag_spec_F77=' ' + allow_undefined_flag_F77=unsupported + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=.dll + # FIXME: Setting linknames here is a bad hack. + archive_cmds_F77='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames=' + # The linker will automatically build a .lib file if we build a DLL. + old_archive_from_new_cmds_F77='true' + # FIXME: Should let the user specify the lib program. + old_archive_cmds_F77='lib -OUT:$oldlib$oldobjs$old_deplibs' + enable_shared_with_static_runtimes_F77=yes + ;; + esac + ;; + + darwin* | rhapsody*) + + + archive_cmds_need_lc_F77=no + hardcode_direct_F77=no + hardcode_automatic_F77=yes + hardcode_shlibpath_var_F77=unsupported + if test yes = "$lt_cv_ld_force_load"; then + whole_archive_flag_spec_F77='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience $wl-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`' + compiler_needs_object_F77=yes + else + whole_archive_flag_spec_F77='' + fi + link_all_deplibs_F77=yes + allow_undefined_flag_F77=$_lt_dar_allow_undefined + case $cc_basename in + ifort*|nagfor*) _lt_dar_can_shared=yes ;; + *) _lt_dar_can_shared=$GCC ;; + esac + if test yes = "$_lt_dar_can_shared"; then + output_verbose_link_cmd=func_echo_all + archive_cmds_F77="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dsymutil" + module_cmds_F77="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dsymutil" + archive_expsym_cmds_F77="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dar_export_syms$_lt_dsymutil" + module_expsym_cmds_F77="sed -e 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dar_export_syms$_lt_dsymutil" + + else + ld_shlibs_F77=no + fi + + ;; + + dgux*) + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_shlibpath_var_F77=no + ;; + + # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor + # support. Future versions do this automatically, but an explicit c++rt0.o + # does not break anything, and helps significantly (at the cost of a little + # extra space). + freebsd2.2*) + archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' + hardcode_libdir_flag_spec_F77='-R$libdir' + hardcode_direct_F77=yes + hardcode_shlibpath_var_F77=no + ;; + + # Unfortunately, older versions of FreeBSD 2 do not have this feature. + freebsd2.*) + archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_F77=yes + hardcode_minus_L_F77=yes + hardcode_shlibpath_var_F77=no + ;; + + # FreeBSD 3 and greater uses gcc -shared to do shared libraries. + freebsd* | dragonfly*) + archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec_F77='-R$libdir' + hardcode_direct_F77=yes + hardcode_shlibpath_var_F77=no + ;; + + hpux9*) + if test yes = "$GCC"; then + archive_cmds_F77='$RM $output_objdir/$soname~$CC -shared $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + else + archive_cmds_F77='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' + fi + hardcode_libdir_flag_spec_F77='$wl+b $wl$libdir' + hardcode_libdir_separator_F77=: + hardcode_direct_F77=yes + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L_F77=yes + export_dynamic_flag_spec_F77='$wl-E' + ;; + + hpux10*) + if test yes,no = "$GCC,$with_gnu_ld"; then + archive_cmds_F77='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_F77='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' + fi + if test no = "$with_gnu_ld"; then + hardcode_libdir_flag_spec_F77='$wl+b $wl$libdir' + hardcode_libdir_separator_F77=: + hardcode_direct_F77=yes + hardcode_direct_absolute_F77=yes + export_dynamic_flag_spec_F77='$wl-E' + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L_F77=yes + fi + ;; + + hpux11*) + if test yes,no = "$GCC,$with_gnu_ld"; then + case $host_cpu in + hppa*64*) + archive_cmds_F77='$CC -shared $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds_F77='$CC -shared $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds_F77='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + else + case $host_cpu in + hppa*64*) + archive_cmds_F77='$CC -b $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds_F77='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds_F77='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + fi + if test no = "$with_gnu_ld"; then + hardcode_libdir_flag_spec_F77='$wl+b $wl$libdir' + hardcode_libdir_separator_F77=: + + case $host_cpu in + hppa*64*|ia64*) + hardcode_direct_F77=no + hardcode_shlibpath_var_F77=no + ;; + *) + hardcode_direct_F77=yes + hardcode_direct_absolute_F77=yes + export_dynamic_flag_spec_F77='$wl-E' + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L_F77=yes + ;; + esac + fi + ;; + + irix5* | irix6* | nonstopux*) + if test yes = "$GCC"; then + archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + # Try to use the -exported_symbol ld option, if it does not + # work, assume that -exports_file does not work either and + # implicitly export all symbols. + # This should be the same for all languages, so no per-tag cache variable. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $host_os linker accepts -exported_symbol" >&5 +$as_echo_n "checking whether the $host_os linker accepts -exported_symbol... " >&6; } +if ${lt_cv_irix_exported_symbol+:} false; then : + $as_echo_n "(cached) " >&6 +else + save_LDFLAGS=$LDFLAGS + LDFLAGS="$LDFLAGS -shared $wl-exported_symbol ${wl}foo $wl-update_registry $wl/dev/null" + cat > conftest.$ac_ext <<_ACEOF + + subroutine foo + end +_ACEOF +if ac_fn_f77_try_link "$LINENO"; then : + lt_cv_irix_exported_symbol=yes +else + lt_cv_irix_exported_symbol=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_irix_exported_symbol" >&5 +$as_echo "$lt_cv_irix_exported_symbol" >&6; } + if test yes = "$lt_cv_irix_exported_symbol"; then + archive_expsym_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations $wl-exports_file $wl$export_symbols -o $lib' + fi + else + archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + archive_expsym_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -exports_file $export_symbols -o $lib' + fi + archive_cmds_need_lc_F77='no' + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + hardcode_libdir_separator_F77=: + inherit_rpath_F77=yes + link_all_deplibs_F77=yes + ;; + + linux*) + case $cc_basename in + tcc*) + # Fabrice Bellard et al's Tiny C Compiler + ld_shlibs_F77=yes + archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out + else + archive_cmds_F77='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF + fi + hardcode_libdir_flag_spec_F77='-R$libdir' + hardcode_direct_F77=yes + hardcode_shlibpath_var_F77=no + ;; + + newsos6) + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_F77=yes + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + hardcode_libdir_separator_F77=: + hardcode_shlibpath_var_F77=no + ;; + + *nto* | *qnx*) + ;; + + openbsd* | bitrig*) + if test -f /usr/libexec/ld.so; then + hardcode_direct_F77=yes + hardcode_shlibpath_var_F77=no + hardcode_direct_absolute_F77=yes + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags $wl-retain-symbols-file,$export_symbols' + hardcode_libdir_flag_spec_F77='$wl-rpath,$libdir' + export_dynamic_flag_spec_F77='$wl-E' + else + archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec_F77='$wl-rpath,$libdir' + fi + else + ld_shlibs_F77=no + fi + ;; + + os2*) + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_minus_L_F77=yes + allow_undefined_flag_F77=unsupported + shrext_cmds=.dll + archive_cmds_F77='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + archive_expsym_cmds_F77='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ + $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ + $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ + $ECHO EXPORTS >> $output_objdir/$libname.def~ + prefix_cmds="$SED"~ + if test EXPORTS = "`$SED 1q $export_symbols`"; then + prefix_cmds="$prefix_cmds -e 1d"; + fi~ + prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ + cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ + $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ + emximp -o $lib $output_objdir/$libname.def' + old_archive_From_new_cmds_F77='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' + enable_shared_with_static_runtimes_F77=yes + ;; + + osf3*) + if test yes = "$GCC"; then + allow_undefined_flag_F77=' $wl-expect_unresolved $wl\*' + archive_cmds_F77='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + else + allow_undefined_flag_F77=' -expect_unresolved \*' + archive_cmds_F77='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + fi + archive_cmds_need_lc_F77='no' + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + hardcode_libdir_separator_F77=: + ;; + + osf4* | osf5*) # as osf3* with the addition of -msym flag + if test yes = "$GCC"; then + allow_undefined_flag_F77=' $wl-expect_unresolved $wl\*' + archive_cmds_F77='$CC -shared$allow_undefined_flag $pic_flag $libobjs $deplibs $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' + hardcode_libdir_flag_spec_F77='$wl-rpath $wl$libdir' + else + allow_undefined_flag_F77=' -expect_unresolved \*' + archive_cmds_F77='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' + archive_expsym_cmds_F77='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~ + $CC -shared$allow_undefined_flag $wl-input $wl$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~$RM $lib.exp' + + # Both c and cxx compiler support -rpath directly + hardcode_libdir_flag_spec_F77='-rpath $libdir' + fi + archive_cmds_need_lc_F77='no' + hardcode_libdir_separator_F77=: + ;; + + solaris*) + no_undefined_flag_F77=' -z defs' + if test yes = "$GCC"; then + wlarc='$wl' + archive_cmds_F77='$CC -shared $pic_flag $wl-z ${wl}text $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -shared $pic_flag $wl-z ${wl}text $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + else + case `$CC -V 2>&1` in + *"Compilers 5.0"*) + wlarc='' + archive_cmds_F77='$LD -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $linker_flags' + archive_expsym_cmds_F77='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $LD -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp' + ;; + *) + wlarc='$wl' + archive_cmds_F77='$CC -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + ;; + esac + fi + hardcode_libdir_flag_spec_F77='-R$libdir' + hardcode_shlibpath_var_F77=no + case $host_os in + solaris2.[0-5] | solaris2.[0-5].*) ;; + *) + # The compiler driver will combine and reorder linker options, + # but understands '-z linker_flag'. GCC discards it without '$wl', + # but is careful enough not to reorder. + # Supported since Solaris 2.6 (maybe 2.5.1?) + if test yes = "$GCC"; then + whole_archive_flag_spec_F77='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract' + else + whole_archive_flag_spec_F77='-z allextract$convenience -z defaultextract' + fi + ;; + esac + link_all_deplibs_F77=yes + ;; + + sunos4*) + if test sequent = "$host_vendor"; then + # Use $CC to link under sequent, because it throws in some extra .o + # files that make .init and .fini sections work. + archive_cmds_F77='$CC -G $wl-h $soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_F77='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' + fi + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_direct_F77=yes + hardcode_minus_L_F77=yes + hardcode_shlibpath_var_F77=no + ;; + + sysv4) + case $host_vendor in + sni) + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_F77=yes # is this really true??? + ;; + siemens) + ## LD is ld it makes a PLAMLIB + ## CC just makes a GrossModule. + archive_cmds_F77='$LD -G -o $lib $libobjs $deplibs $linker_flags' + reload_cmds_F77='$CC -r -o $output$reload_objs' + hardcode_direct_F77=no + ;; + motorola) + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_F77=no #Motorola manual says yes, but my tests say they lie + ;; + esac + runpath_var='LD_RUN_PATH' + hardcode_shlibpath_var_F77=no + ;; + + sysv4.3*) + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var_F77=no + export_dynamic_flag_spec_F77='-Bexport' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var_F77=no + runpath_var=LD_RUN_PATH + hardcode_runpath_var=yes + ld_shlibs_F77=yes + fi + ;; + + sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) + no_undefined_flag_F77='$wl-z,text' + archive_cmds_need_lc_F77=no + hardcode_shlibpath_var_F77=no + runpath_var='LD_RUN_PATH' + + if test yes = "$GCC"; then + archive_cmds_F77='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_F77='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + sysv5* | sco3.2v5* | sco5v6*) + # Note: We CANNOT use -z defs as we might desire, because we do not + # link with -lc, and that would cause any symbols used from libc to + # always be unresolved, which means just about no library would + # ever link correctly. If we're not using GNU ld we use -z text + # though, which does catch some bad symbols but isn't as heavy-handed + # as -z defs. + no_undefined_flag_F77='$wl-z,text' + allow_undefined_flag_F77='$wl-z,nodefs' + archive_cmds_need_lc_F77=no + hardcode_shlibpath_var_F77=no + hardcode_libdir_flag_spec_F77='$wl-R,$libdir' + hardcode_libdir_separator_F77=':' + link_all_deplibs_F77=yes + export_dynamic_flag_spec_F77='$wl-Bexport' + runpath_var='LD_RUN_PATH' + + if test yes = "$GCC"; then + archive_cmds_F77='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_F77='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_F77='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + uts4*) + archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec_F77='-L$libdir' + hardcode_shlibpath_var_F77=no + ;; + + *) + ld_shlibs_F77=no + ;; + esac + + if test sni = "$host_vendor"; then + case $host in + sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) + export_dynamic_flag_spec_F77='$wl-Blargedynsym' + ;; + esac + fi + fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs_F77" >&5 +$as_echo "$ld_shlibs_F77" >&6; } +test no = "$ld_shlibs_F77" && can_build_shared=no + +with_gnu_ld_F77=$with_gnu_ld + + + + + + +# +# Do we need to explicitly link libc? +# +case "x$archive_cmds_need_lc_F77" in +x|xyes) + # Assume -lc should be added + archive_cmds_need_lc_F77=yes + + if test yes,yes = "$GCC,$enable_shared"; then + case $archive_cmds_F77 in + *'~'*) + # FIXME: we may have to deal with multi-command sequences. + ;; + '$CC '*) + # Test whether the compiler implicitly links with -lc since on some + # systems, -lgcc has to come before -lc. If gcc already passes -lc + # to ld, don't add -lc before -lgcc. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5 +$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; } +if ${lt_cv_archive_cmds_need_lc_F77+:} false; then : + $as_echo_n "(cached) " >&6 +else + $RM conftest* + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } 2>conftest.err; then + soname=conftest + lib=conftest + libobjs=conftest.$ac_objext + deplibs= + wl=$lt_prog_compiler_wl_F77 + pic_flag=$lt_prog_compiler_pic_F77 + compiler_flags=-v + linker_flags=-v + verstring= + output_objdir=. + libname=conftest + lt_save_allow_undefined_flag=$allow_undefined_flag_F77 + allow_undefined_flag_F77= + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds_F77 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5 + (eval $archive_cmds_F77 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + then + lt_cv_archive_cmds_need_lc_F77=no + else + lt_cv_archive_cmds_need_lc_F77=yes + fi + allow_undefined_flag_F77=$lt_save_allow_undefined_flag + else + cat conftest.err 1>&5 + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc_F77" >&5 +$as_echo "$lt_cv_archive_cmds_need_lc_F77" >&6; } + archive_cmds_need_lc_F77=$lt_cv_archive_cmds_need_lc_F77 + ;; + esac + fi + ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5 +$as_echo_n "checking dynamic linker characteristics... " >&6; } + +library_names_spec= +libname_spec='lib$name' +soname_spec= +shrext_cmds=.so +postinstall_cmds= +postuninstall_cmds= +finish_cmds= +finish_eval= +shlibpath_var= +shlibpath_overrides_runpath=unknown +version_type=none +dynamic_linker="$host_os ld.so" +sys_lib_dlsearch_path_spec="/lib /usr/lib" +need_lib_prefix=unknown +hardcode_into_libs=no + +# when you set need_version to no, make sure it does not cause -set_version +# flags to be left without arguments +need_version=unknown + + + +case $host_os in +aix3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname.a' + shlibpath_var=LIBPATH + + # AIX 3 has no versioning support, so we append a major version to the name. + soname_spec='$libname$release$shared_ext$major' + ;; + +aix[4-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + hardcode_into_libs=yes + if test ia64 = "$host_cpu"; then + # AIX 5 supports IA64 + library_names_spec='$libname$release$shared_ext$major $libname$release$shared_ext$versuffix $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + else + # With GCC up to 2.95.x, collect2 would create an import file + # for dependence libraries. The import file would start with + # the line '#! .'. This would cause the generated library to + # depend on '.', always an invalid library. This was fixed in + # development snapshots of GCC prior to 3.0. + case $host_os in + aix4 | aix4.[01] | aix4.[01].*) + if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' + echo ' yes ' + echo '#endif'; } | $CC -E - | $GREP yes > /dev/null; then + : + else + can_build_shared=no + fi + ;; + esac + # Using Import Files as archive members, it is possible to support + # filename-based versioning of shared library archives on AIX. While + # this would work for both with and without runtime linking, it will + # prevent static linking of such archives. So we do filename-based + # shared library versioning with .so extension only, which is used + # when both runtime linking and shared linking is enabled. + # Unfortunately, runtime linking may impact performance, so we do + # not want this to be the default eventually. Also, we use the + # versioned .so libs for executables only if there is the -brtl + # linker flag in LDFLAGS as well, or --with-aix-soname=svr4 only. + # To allow for filename-based versioning support, we need to create + # libNAME.so.V as an archive file, containing: + # *) an Import File, referring to the versioned filename of the + # archive as well as the shared archive member, telling the + # bitwidth (32 or 64) of that shared object, and providing the + # list of exported symbols of that shared object, eventually + # decorated with the 'weak' keyword + # *) the shared object with the F_LOADONLY flag set, to really avoid + # it being seen by the linker. + # At run time we better use the real file rather than another symlink, + # but for link time we create the symlink libNAME.so -> libNAME.so.V + + case $with_aix_soname,$aix_use_runtimelinking in + # AIX (on Power*) has no versioning support, so currently we cannot hardcode correct + # soname into executable. Probably we can add versioning support to + # collect2, so additional links can be useful in future. + aix,yes) # traditional libtool + dynamic_linker='AIX unversionable lib.so' + # If using run time linking (on AIX 4.2 or later) use lib.so + # instead of lib.a to let people know that these are not + # typical AIX shared libraries. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + aix,no) # traditional AIX only + dynamic_linker='AIX lib.a(lib.so.V)' + # We preserve .a as extension for shared libraries through AIX4.2 + # and later when we are not doing run time linking. + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + ;; + svr4,*) # full svr4 only + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,yes) # both, prefer svr4 + dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o), lib.a(lib.so.V)" + library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' + # unpreferred sharedlib libNAME.a needs extra handling + postinstall_cmds='test -n "$linkname" || linkname="$realname"~func_stripname "" ".so" "$linkname"~$install_shared_prog "$dir/$func_stripname_result.$libext" "$destdir/$func_stripname_result.$libext"~test -z "$tstripme" || test -z "$striplib" || $striplib "$destdir/$func_stripname_result.$libext"' + postuninstall_cmds='for n in $library_names $old_library; do :; done~func_stripname "" ".so" "$n"~test "$func_stripname_result" = "$n" || func_append rmfiles " $odir/$func_stripname_result.$libext"' + # We do not specify a path in Import Files, so LIBPATH fires. + shlibpath_overrides_runpath=yes + ;; + *,no) # both, prefer aix + dynamic_linker="AIX lib.a(lib.so.V), lib.so.V($shared_archive_member_spec.o)" + library_names_spec='$libname$release.a $libname.a' + soname_spec='$libname$release$shared_ext$major' + # unpreferred sharedlib libNAME.so.V and symlink libNAME.so need extra handling + postinstall_cmds='test -z "$dlname" || $install_shared_prog $dir/$dlname $destdir/$dlname~test -z "$tstripme" || test -z "$striplib" || $striplib $destdir/$dlname~test -n "$linkname" || linkname=$realname~func_stripname "" ".a" "$linkname"~(cd "$destdir" && $LN_S -f $dlname $func_stripname_result.so)' + postuninstall_cmds='test -z "$dlname" || func_append rmfiles " $odir/$dlname"~for n in $old_library $library_names; do :; done~func_stripname "" ".a" "$n"~func_append rmfiles " $odir/$func_stripname_result.so"' + ;; + esac + shlibpath_var=LIBPATH + fi + ;; + +amigaos*) + case $host_cpu in + powerpc) + # Since July 2007 AmigaOS4 officially supports .so libraries. + # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + ;; + m68k) + library_names_spec='$libname.ixlibrary $libname.a' + # Create ${libname}_ixlibrary.a entries in /sys/libs. + finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' + ;; + esac + ;; + +beos*) + library_names_spec='$libname$shared_ext' + dynamic_linker="$host_os ld.so" + shlibpath_var=LIBRARY_PATH + ;; + +bsdi[45]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" + sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" + # the default ld.so.conf also contains /usr/contrib/lib and + # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow + # libtool to hard-code these into programs + ;; + +cygwin* | mingw* | pw32* | cegcc*) + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + + case $GCC,$cc_basename in + yes,*) + # gcc + library_names_spec='$libname.dll.a' + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + + case $host_os in + cygwin*) + # Cygwin DLLs use 'cyg' prefix rather than 'lib' + soname_spec='`echo $libname | sed -e 's/^lib/cyg/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + + ;; + mingw* | cegcc*) + # MinGW DLLs use traditional 'lib' prefix + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + pw32*) + # pw32 DLLs use 'pw' prefix rather than 'lib' + library_names_spec='`echo $libname | sed -e 's/^lib/pw/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + ;; + esac + dynamic_linker='Win32 ld.exe' + ;; + + *,cl* | *,icl* | *,ifort*) + # Native MSVC or ICC or IFORT + libname_spec='$name' + soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' + library_names_spec='$libname.dll.lib' + + case $build_os in + mingw*) + sys_lib_search_path_spec= + lt_save_ifs=$IFS + IFS=';' + for lt_path in $LIB + do + IFS=$lt_save_ifs + # Let DOS variable expansion print the short 8.3 style file name. + lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"` + sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path" + done + IFS=$lt_save_ifs + # Convert to MSYS style. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([a-zA-Z]\\):| /\\1|g' -e 's|^ ||'` + ;; + cygwin*) + # Convert to unix form, then to dos form, then back to unix form + # but this time dos style (no spaces!) so that the unix form looks + # like /cygdrive/c/PROGRA~1:/cygdr... + sys_lib_search_path_spec=`cygpath --path --unix "$LIB"` + sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null` + sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + ;; + *) + sys_lib_search_path_spec=$LIB + if $ECHO "$sys_lib_search_path_spec" | $GREP ';[c-zC-Z]:/' >/dev/null; then + # It is most probably a Windows format PATH. + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` + else + sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` + fi + # FIXME: find the short name or the path components, as spaces are + # common. (e.g. "Program Files" -> "PROGRA~1") + ;; + esac + + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + dynamic_linker='Win32 link.exe' + ;; + + *) + # Assume MSVC wrapper + library_names_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext $libname.lib' + dynamic_linker='Win32 ld.exe' + ;; + esac + # FIXME: first we should search . and the directory the executable is in + shlibpath_var=PATH + ;; + +darwin* | rhapsody*) + dynamic_linker="$host_os dyld" + version_type=darwin + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$major$shared_ext $libname$shared_ext' + soname_spec='$libname$release$major$shared_ext' + shlibpath_overrides_runpath=yes + shlibpath_var=DYLD_LIBRARY_PATH + shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' + + sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' + ;; + +dgux*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +freebsd* | dragonfly*) + # DragonFly does not have aout. When/if they implement a new + # versioning mechanism, adjust this. + if test -x /usr/bin/objformat; then + objformat=`/usr/bin/objformat` + else + case $host_os in + freebsd[23].*) objformat=aout ;; + *) objformat=elf ;; + esac + fi + version_type=freebsd-$objformat + case $version_type in + freebsd-elf*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + need_version=no + need_lib_prefix=no + ;; + freebsd-*) + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + need_version=yes + ;; + esac + shlibpath_var=LD_LIBRARY_PATH + case $host_os in + freebsd2.*) + shlibpath_overrides_runpath=yes + ;; + freebsd3.[01]* | freebsdelf3.[01]*) + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ + freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + *) # from 4.6 on, and DragonFly + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + esac + ;; + +haiku*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + dynamic_linker="$host_os runtime_loader" + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LIBRARY_PATH + shlibpath_overrides_runpath=no + sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib' + hardcode_into_libs=yes + ;; + +hpux9* | hpux10* | hpux11*) + # Give a soname corresponding to the major version so that dld.sl refuses to + # link against other versions. + version_type=sunos + need_lib_prefix=no + need_version=no + case $host_cpu in + ia64*) + shrext_cmds='.so' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.so" + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + if test 32 = "$HPUX_IA64_MODE"; then + sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" + sys_lib_dlsearch_path_spec=/usr/lib/hpux32 + else + sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" + sys_lib_dlsearch_path_spec=/usr/lib/hpux64 + fi + ;; + hppa*64*) + shrext_cmds='.sl' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.sl" + shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + *) + shrext_cmds='.sl' + dynamic_linker="$host_os dld.sl" + shlibpath_var=SHLIB_PATH + shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + ;; + esac + # HP-UX runs *really* slowly unless shared libraries are mode 555, ... + postinstall_cmds='chmod 555 $lib' + # or fails outright, so override atomically: + install_override_mode=555 + ;; + +interix[3-9]*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +irix5* | irix6* | nonstopux*) + case $host_os in + nonstopux*) version_type=nonstopux ;; + *) + if test yes = "$lt_cv_prog_gnu_ld"; then + version_type=linux # correct to gnu/linux during the next big refactor + else + version_type=irix + fi ;; + esac + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$release$shared_ext $libname$shared_ext' + case $host_os in + irix5* | nonstopux*) + libsuff= shlibsuff= + ;; + *) + case $LD in # libtool.m4 will add one of these switches to LD + *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") + libsuff= shlibsuff= libmagic=32-bit;; + *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") + libsuff=32 shlibsuff=N32 libmagic=N32;; + *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") + libsuff=64 shlibsuff=64 libmagic=64-bit;; + *) libsuff= shlibsuff= libmagic=never-match;; + esac + ;; + esac + shlibpath_var=LD_LIBRARY${shlibsuff}_PATH + shlibpath_overrides_runpath=no + sys_lib_search_path_spec="/usr/lib$libsuff /lib$libsuff /usr/local/lib$libsuff" + sys_lib_dlsearch_path_spec="/usr/lib$libsuff /lib$libsuff" + hardcode_into_libs=yes + ;; + +# No shared lib support for Linux oldld, aout, or coff. +linux*oldld* | linux*aout* | linux*coff*) + dynamic_linker=no + ;; + +linux*android*) + version_type=none # Android doesn't support versioned libraries. + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext' + soname_spec='$libname$release$shared_ext' + finish_cmds= + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + dynamic_linker='Android linker' + # Don't embed -rpath directories since the linker doesn't support them. + hardcode_libdir_flag_spec_F77='-L$libdir' + ;; + +# This must be glibc/ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + + # Some binutils ld are patched to set DT_RUNPATH + if ${lt_cv_shlibpath_overrides_runpath+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_shlibpath_overrides_runpath=no + save_LDFLAGS=$LDFLAGS + save_libdir=$libdir + eval "libdir=/foo; wl=\"$lt_prog_compiler_wl_F77\"; \ + LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec_F77\"" + cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_f77_try_link "$LINENO"; then : + if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then : + lt_cv_shlibpath_overrides_runpath=yes +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS + libdir=$save_libdir + +fi + + shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + # Ideally, we could use ldconfig to report *all* directores which are + # searched for libraries, however this is still not possible. Aside from not + # being certain /sbin/ldconfig is available, command + # 'ldconfig -N -X -v | grep ^/' on 64bit Fedora does not report /usr/lib64, + # even though it is searched at run-time. Try to do the best guess by + # appending ld.so.conf contents (and includes) to the search path. + if test -f /etc/ld.so.conf; then + lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '` + sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" + fi + + # We used to test for /lib/ld.so.1 and disable shared libraries on + # powerpc, because MkLinux only supported shared libraries with the + # GNU dynamic linker. Since this was broken with cross compilers, + # most powerpc-linux boxes support dynamic linking these days and + # people can always --disable-shared, the test was removed, and we + # assume the GNU/Linux dynamic linker is in use. + dynamic_linker='GNU/Linux ld.so' + ;; + +netbsd*) + version_type=sunos + need_lib_prefix=no + need_version=no + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + dynamic_linker='NetBSD (a.out) ld.so' + else + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + dynamic_linker='NetBSD ld.elf_so' + fi + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + +newsos6) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +*nto* | *qnx*) + version_type=qnx + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + dynamic_linker='ldqnx.so' + ;; + +openbsd* | bitrig*) + version_type=sunos + sys_lib_dlsearch_path_spec=/usr/lib + need_lib_prefix=no + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then + need_version=no + else + need_version=yes + fi + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +os2*) + libname_spec='$name' + version_type=windows + shrext_cmds=.dll + need_version=no + need_lib_prefix=no + # OS/2 can only load a DLL with a base name of 8 characters or less. + soname_spec='`test -n "$os2dllname" && libname="$os2dllname"; + v=$($ECHO $release$versuffix | tr -d .-); + n=$($ECHO $libname | cut -b -$((8 - ${#v})) | tr . _); + $ECHO $n$v`$shared_ext' + library_names_spec='${libname}_dll.$libext' + dynamic_linker='OS/2 ld.exe' + shlibpath_var=BEGINLIBPATH + sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + postinstall_cmds='base_file=`basename \$file`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; $ECHO \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; $ECHO \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + ;; + +osf3* | osf4* | osf5*) + version_type=osf + need_lib_prefix=no + need_version=no + soname_spec='$libname$release$shared_ext$major' + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + +rdos*) + dynamic_linker=no + ;; + +solaris*) + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + # ldd complains unless libraries are executable + postinstall_cmds='chmod +x $lib' + ;; + +sunos4*) + version_type=sunos + library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' + finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + if test yes = "$with_gnu_ld"; then + need_lib_prefix=no + fi + need_version=yes + ;; + +sysv4 | sysv4.3*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + case $host_vendor in + sni) + shlibpath_overrides_runpath=no + need_lib_prefix=no + runpath_var=LD_RUN_PATH + ;; + siemens) + need_lib_prefix=no + ;; + motorola) + need_lib_prefix=no + need_version=no + shlibpath_overrides_runpath=no + sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' + ;; + esac + ;; + +sysv4*MP*) + if test -d /usr/nec; then + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$shared_ext.$versuffix $libname$shared_ext.$major $libname$shared_ext' + soname_spec='$libname$shared_ext.$major' + shlibpath_var=LD_LIBRARY_PATH + fi + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + version_type=sco + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + if test yes = "$with_gnu_ld"; then + sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' + else + sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' + case $host_os in + sco3.2v5*) + sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" + ;; + esac + fi + sys_lib_dlsearch_path_spec='/usr/lib' + ;; + +tpf*) + # TPF is a cross-target only. Preferred cross-host = GNU/Linux. + version_type=linux # correct to gnu/linux during the next big refactor + need_lib_prefix=no + need_version=no + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +uts4*) + version_type=linux # correct to gnu/linux during the next big refactor + library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' + soname_spec='$libname$release$shared_ext$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +*) + dynamic_linker=no + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5 +$as_echo "$dynamic_linker" >&6; } +test no = "$dynamic_linker" && can_build_shared=no + +variables_saved_for_relink="PATH $shlibpath_var $runpath_var" +if test yes = "$GCC"; then + variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" +fi + +if test set = "${lt_cv_sys_lib_search_path_spec+set}"; then + sys_lib_search_path_spec=$lt_cv_sys_lib_search_path_spec +fi + +if test set = "${lt_cv_sys_lib_dlsearch_path_spec+set}"; then + sys_lib_dlsearch_path_spec=$lt_cv_sys_lib_dlsearch_path_spec +fi + +# remember unaugmented sys_lib_dlsearch_path content for libtool script decls... +configure_time_dlsearch_path=$sys_lib_dlsearch_path_spec + +# ... but it needs LT_SYS_LIBRARY_PATH munging for other configure-time code +func_munge_path_list sys_lib_dlsearch_path_spec "$LT_SYS_LIBRARY_PATH" + +# to be used as default LT_SYS_LIBRARY_PATH value in generated libtool +configure_time_lt_sys_library_path=$LT_SYS_LIBRARY_PATH + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5 +$as_echo_n "checking how to hardcode library paths into programs... " >&6; } +hardcode_action_F77= +if test -n "$hardcode_libdir_flag_spec_F77" || + test -n "$runpath_var_F77" || + test yes = "$hardcode_automatic_F77"; then + + # We can hardcode non-existent directories. + if test no != "$hardcode_direct_F77" && + # If the only mechanism to avoid hardcoding is shlibpath_var, we + # have to relink, otherwise we might link with an installed library + # when we should be linking with a yet-to-be-installed one + ## test no != "$_LT_TAGVAR(hardcode_shlibpath_var, F77)" && + test no != "$hardcode_minus_L_F77"; then + # Linking always hardcodes the temporary library directory. + hardcode_action_F77=relink + else + # We can link without hardcoding, and we can hardcode nonexisting dirs. + hardcode_action_F77=immediate + fi +else + # We cannot hardcode anything, or else we can only hardcode existing + # directories. + hardcode_action_F77=unsupported +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action_F77" >&5 +$as_echo "$hardcode_action_F77" >&6; } + +if test relink = "$hardcode_action_F77" || + test yes = "$inherit_rpath_F77"; then + # Fast installation is not supported + enable_fast_install=no +elif test yes = "$shlibpath_overrides_runpath" || + test no = "$enable_shared"; then + # Fast installation is not necessary + enable_fast_install=needless +fi + + + + + + + + fi # test -n "$compiler" + + GCC=$lt_save_GCC + CC=$lt_save_CC + CFLAGS=$lt_save_CFLAGS +fi # test yes != "$_lt_disable_F77" + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + + + + + + + + + + ac_config_commands="$ac_config_commands libtool" + + + + +# Only expand once: + + + + case "$am_cv_ar_interface" in + lib ) + ac_config_commands="$ac_config_commands libtoolclpatch" + + ;; + * ) + case $build in + *-mingw* ) + ac_config_commands="$ac_config_commands libtoolmingwpatch" + + ;; + esac + ;; + esac + + + + LT_LDFLAGS="$LT_LDFLAGS -version-number 3:13:5" + { $as_echo "$as_me:${as_lineno-$LINENO}: libtool version info: -version-number 3:13:5" >&5 +$as_echo "$as_me: libtool version info: -version-number 3:13:5" >&6;} + + + LT_LDFLAGS="$LT_LDFLAGS -no-undefined" + + if test "$enable_shared" = no; then + COIN_STATIC_BUILD_TRUE= + COIN_STATIC_BUILD_FALSE='#' +else + COIN_STATIC_BUILD_TRUE='#' + COIN_STATIC_BUILD_FALSE= +fi + + + +# set RPATH_FLAGS to the compiler link flags required to hardcode location +# of the shared objects (expanded_libdir is set somewhere in configure before) +RPATH_FLAGS= + +if test $enable_shared = yes; then + case $build in + *-linux-*) + if test "$GCC" = "yes"; then + RPATH_FLAGS= + for dir in $expanded_libdir; do + RPATH_FLAGS="$RPATH_FLAGS -Wl,--rpath -Wl,$dir" + done + fi ;; + *-darwin*) + RPATH_FLAGS=nothing ;; + *-ibm-*) + case "$CC" in + xlc* | */xlc* | mpxlc* | */mpxlc*) + RPATH_FLAGS=nothing ;; + esac ;; + *-hp-*) + RPATH_FLAGS=nothing ;; + *-mingw* | *-msys* ) + RPATH_FLAGS=nothing ;; + *-*-solaris*) + RPATH_FLAGS= + for dir in $expanded_libdir; do + RPATH_FLAGS="$RPATH_FLAGS -R$dir" + done + esac + + if test "$RPATH_FLAGS" = ""; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Could not automatically determine how to tell the linker about automatic inclusion of the path for shared libraries. The test examples might not work if you link against shared objects. You will need to set the LD_LIBRARY_PATH, DYLP_LIBRARY_PATH, or LIBDIR variable manually." >&5 +$as_echo "$as_me: WARNING: Could not automatically determine how to tell the linker about automatic inclusion of the path for shared libraries. The test examples might not work if you link against shared objects. You will need to set the LD_LIBRARY_PATH, DYLP_LIBRARY_PATH, or LIBDIR variable manually." >&2;} + fi + if test "$RPATH_FLAGS" = "nothing"; then + RPATH_FLAGS= + fi +fi + + + + +# Get the C++ runtime libraries in case we want to link a static Ipopt library +# with a C or Fortran compiler +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + + +if test -z "$CXXLIBS"; then + if test "$GXX" = "yes"; then + case "$CXX" in + icpc* | */icpc*) + CXXLIBS="-lstdc++" + ;; + *) + # clang uses libc++ as the default standard C++ library, not libstdc++ + # this test is supposed to recognize whether the compiler is clang + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ + +#ifndef _LIBCPP_VERSION + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + CXXLIBS="-lc++" +else + CXXLIBS="-lstdc++ -lm" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ;; + esac + else + case $build in + *-mingw* | *-cygwin* | *-msys* ) + if test "$enable_msvc" = yes ; then + CXXLIBS=nothing + fi;; + *-linux-*) + case "$CXX" in + icpc* | */icpc*) + CXXLIBS="-lstdc++" + ;; + pgCC* | */pgCC*) + CXXLIBS="-lstd -lC -lc" + ;; + esac;; + *-ibm-*) + CXXLIBS="-lC -lc" + ;; + *-hp-*) + CXXLIBS="-L/opt/aCC/lib -l++ -lstd_v2 -lCsup_v2 -lm -lcl -lc" + ;; + *-*-solaris*) + CXXLIBS="-lCstd -lCrun" + esac + fi +fi +if test -z "$CXXLIBS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Could not automatically determine CXXLIBS (C++ link libraries; necessary if main program is in Fortran or C)." >&5 +$as_echo "$as_me: WARNING: Could not automatically determine CXXLIBS (C++ link libraries; necessary if main program is in Fortran or C)." >&2;} +else + { $as_echo "$as_me:${as_lineno-$LINENO}: Assuming that CXXLIBS is \"$CXXLIBS\"." >&5 +$as_echo "$as_me: Assuming that CXXLIBS is \"$CXXLIBS\"." >&6;} +fi +if test x"$CXXLIBS" = xnothing; then + CXXLIBS= +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +# Doxygen + + { $as_echo "$as_me:${as_lineno-$LINENO}: configuring doxygen documentation options" >&5 +$as_echo "$as_me: configuring doxygen documentation options" >&6;} + + # Check to see if Doxygen and LaTeX are available. + # Extract the first word of "doxygen", so it can be a program name with args. +set dummy doxygen; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_coin_have_doxygen+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$coin_have_doxygen"; then + ac_cv_prog_coin_have_doxygen="$coin_have_doxygen" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_coin_have_doxygen="yes" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_coin_have_doxygen" && ac_cv_prog_coin_have_doxygen="no" +fi +fi +coin_have_doxygen=$ac_cv_prog_coin_have_doxygen +if test -n "$coin_have_doxygen"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $coin_have_doxygen" >&5 +$as_echo "$coin_have_doxygen" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + # Extract the first word of "latex", so it can be a program name with args. +set dummy latex; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_coin_have_latex+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$coin_have_latex"; then + ac_cv_prog_coin_have_latex="$coin_have_latex" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_coin_have_latex="yes" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_coin_have_latex" && ac_cv_prog_coin_have_latex="no" +fi +fi +coin_have_latex=$ac_cv_prog_coin_have_latex +if test -n "$coin_have_latex"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $coin_have_latex" >&5 +$as_echo "$coin_have_latex" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + +# Check whether --with-dot was given. +if test "${with_dot+set}" = set; then : + withval=$with_dot; +else + withval=yes +fi + + + # Look for the dot tool from the graphviz package, unless the user has disabled it. + if test x"$withval" = xno ; then + coin_doxy_usedot=NO + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dot " >&5 +$as_echo_n "checking for dot ... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5 +$as_echo "disabled" >&6; } + else + # Extract the first word of "dot", so it can be a program name with args. +set dummy dot; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_coin_doxy_usedot+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$coin_doxy_usedot"; then + ac_cv_prog_coin_doxy_usedot="$coin_doxy_usedot" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_coin_doxy_usedot="YES" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_coin_doxy_usedot" && ac_cv_prog_coin_doxy_usedot="NO" +fi +fi +coin_doxy_usedot=$ac_cv_prog_coin_doxy_usedot +if test -n "$coin_doxy_usedot"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $coin_doxy_usedot" >&5 +$as_echo "$coin_doxy_usedot" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi + + # Generate a tag file name and a log file name. + coin_doxy_tagname=ipopt_doxy.tag + + coin_doxy_logname=ipopt_doxy.log + + + if test $coin_have_doxygen = yes; then + COIN_HAS_DOXYGEN_TRUE= + COIN_HAS_DOXYGEN_FALSE='#' +else + COIN_HAS_DOXYGEN_TRUE='#' + COIN_HAS_DOXYGEN_FALSE= +fi + + if test $coin_have_latex = yes; then + COIN_HAS_LATEX_TRUE= + COIN_HAS_LATEX_FALSE='#' +else + COIN_HAS_LATEX_TRUE='#' + COIN_HAS_LATEX_FALSE= +fi + + + coin_doxy_tagfiles="" + + + +# IPOPT_VERBOSITY and IPOPT_DEBUGLEVEL + + +# Check whether --with-ipopt-verbosity was given. +if test "${with_ipopt_verbosity+set}" = set; then : + withval=$with_ipopt_verbosity; if test "$withval" = yes; then withval=1 ; fi + coin_verbosity=$withval +else + coin_verbosity=0 +fi + + +cat >>confdefs.h <<_ACEOF +#define IPOPT_VERBOSITY $coin_verbosity +_ACEOF + + + +# Check whether --with-ipopt-checklevel was given. +if test "${with_ipopt_checklevel+set}" = set; then : + withval=$with_ipopt_checklevel; if test "$withval" = yes; then withval=1 ; fi + coin_checklevel=$withval +else + coin_checklevel=0 +fi + + +cat >>confdefs.h <<_ACEOF +#define IPOPT_CHECKLEVEL $coin_checklevel +_ACEOF + + + +############################################################################# +# Dependencies # +############################################################################# + + + + + + + coin_save_LIBS="$LIBS" + LIBS= + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing cos" >&5 +$as_echo_n "checking for library containing cos... " >&6; } +if ${ac_cv_search_cos+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cos (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return cos (); + ; + return 0; +} +_ACEOF +for ac_lib in '' m; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if ac_fn_c_try_link "$LINENO"; then : + ac_cv_search_cos=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext + if ${ac_cv_search_cos+:} false; then : + break +fi +done +if ${ac_cv_search_cos+:} false; then : + +else + ac_cv_search_cos=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_cos" >&5 +$as_echo "$ac_cv_search_cos" >&6; } +ac_res=$ac_cv_search_cos +if test "$ac_res" != no; then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + if test "$ac_cv_search_cos" != 'none required' ; then + IPOPTLIB_LFLAGS="$ac_cv_search_cos $IPOPTLIB_LFLAGS" + + fi +fi + + LIBS="$coin_save_LIBS" + + + + + + if test -z "$PKG_CONFIG" ; then + if test -n "$ac_tool_prefix"; then + for ac_prog in pkgconf pkg-config + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_PKG_CONFIG+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$PKG_CONFIG"; then + ac_cv_prog_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_PKG_CONFIG="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +PKG_CONFIG=$ac_cv_prog_PKG_CONFIG +if test -n "$PKG_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 +$as_echo "$PKG_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$PKG_CONFIG" && break + done +fi +if test -z "$PKG_CONFIG"; then + ac_ct_PKG_CONFIG=$PKG_CONFIG + for ac_prog in pkgconf pkg-config +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_PKG_CONFIG+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_PKG_CONFIG"; then + ac_cv_prog_ac_ct_PKG_CONFIG="$ac_ct_PKG_CONFIG" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_PKG_CONFIG="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_PKG_CONFIG=$ac_cv_prog_ac_ct_PKG_CONFIG +if test -n "$ac_ct_PKG_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_PKG_CONFIG" >&5 +$as_echo "$ac_ct_PKG_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_PKG_CONFIG" && break +done + + if test "x$ac_ct_PKG_CONFIG" = x; then + PKG_CONFIG="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + PKG_CONFIG=$ac_ct_PKG_CONFIG + fi +fi + + fi + if test -n "$PKG_CONFIG" ; then + pkg_min_version=0.16.0 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking $PKG_CONFIG is at least version $pkg_min_version" >&5 +$as_echo_n "checking $PKG_CONFIG is at least version $pkg_min_version... " >&6; } + if $PKG_CONFIG --atleast-pkgconfig-version $pkg_min_version ; then + pkg_version=`$PKG_CONFIG --version` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes: $pkg_version" >&5 +$as_echo "yes: $pkg_version" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + PKG_CONFIG="" + fi + fi + + # Check if PKG_CONFIG supports the short-errors flag. + if test -n "$PKG_CONFIG" && + $PKG_CONFIG --atleast-pkgconfig-version 0.20 ; then + pkg_short_errors=" --short-errors " + else + pkg_short_errors="" + fi + + # Check whether -static option of pkg-config should be used when requesting libs + pkg_static= + if test -n "$PKG_CONFIG" ; then + case "$LDFLAGS" in "-static" | "* -static*" ) pkg_static=--static ;; esac + fi + + if test -n "$PKG_CONFIG"; then + COIN_HAS_PKGCONFIG_TRUE= + COIN_HAS_PKGCONFIG_FALSE='#' +else + COIN_HAS_PKGCONFIG_TRUE='#' + COIN_HAS_PKGCONFIG_FALSE= +fi + + + + COIN_PKG_CONFIG_PATH="${PKG_CONFIG_PATH}" + + + COIN_PKG_CONFIG_PATH="${expanded_libdir}/pkgconfig:${COIN_PKG_CONFIG_PATH}" + if test -n "$PKG_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: $PKG_CONFIG path is \"$COIN_PKG_CONFIG_PATH\"" >&5 +$as_echo "$as_me: $PKG_CONFIG path is \"$COIN_PKG_CONFIG_PATH\"" >&6;} + fi + + + + + + + + + + + +# Check whether --with-lapack was given. +if test "${with_lapack+set}" = set; then : + withval=$with_lapack; +fi + + + +# Check whether --with-lapack-lflags was given. +if test "${with_lapack_lflags+set}" = set; then : + withval=$with_lapack_lflags; +fi + + + + + + + + # Look for user-specified lapack flags, but skip any checks via a .pc file. + # The result (coin_has_lapack) will be one of + # - yes (the user specified something), + # - no (user specified nothing), or + # - skipping (user said do not use). + # We'll also have variables lapack_lflags, lapack_cflags, and lapack_pcfiles. + + + + dflt_action=yes + + # Initialize variables for the primary package. + coin_has_lapack=noInfo + lapack_lflags= + lapack_cflags= + lapack_data= + lapack_pcfiles= + + # --with-prim is always present. + withval="$with_lapack" + if test -n "$withval" ; then + case "$withval" in + no ) + coin_has_lapack=skipping + ;; + yes ) + coin_has_lapack=requested + ;; + build ) + coin_has_lapack=build + ;; + * ) + coin_has_lapack=yes + lapack_lflags="$withval" + ;; + esac + fi + + # Specifying --with-prim=no overrides the individual options for lflags and cflags. + if test "$coin_has_lapack" != skipping ; then + withval="$with_lapack_lflags" + if test -n "$withval" ; then + case "$withval" in + build | no | yes ) + as_fn_error $? "\"$withval\" is not valid here; please specify linker flags appropriate for your environment." "$LINENO" 5 + ;; + * ) + coin_has_lapack=yes + lapack_lflags="$withval" + ;; + esac + fi + + withval="$with_lapack_cflags" + if test -n "$withval" ; then + case "$withval" in + build | no | yes ) + as_fn_error $? "\"$withval\" is not valid here; please specify compiler flags appropriate for your environment." "$LINENO" 5 + ;; + * ) + coin_has_lapack=yes + lapack_cflags="$withval" + ;; + esac + fi + fi + + + + # At this point, coin_has_prim can be one of + # - noInfo (no user options specified), + # - skipping (user said no), + # - requested, + # - build (user said yes or build and gave no further guidance), + # - or yes (user specified one or more --with-prim options). + # If we're already at yes or skipping, we're done looking. + + # If there are no user options (noInfo) and the default is no, we're skipping. + # Otherwise, the default must be yes or build; consider the package requested. + # A default action we don't recognise defaults to yes. + if test "$coin_has_lapack" = noInfo ; then + case $dflt_action in + no ) + coin_has_lapack=skipping + ;; + build ) + coin_has_lapack=build + ;; + * ) + coin_has_lapack=requested + ;; + esac + fi + + # Now coin_has_prim can be one of skipping, yes, requested, or build. + # For requested or build, try pkgconf, if it's available. + # If it's not available, well, hope that the user knows their system + # and prim can be used with no additional flags. + case $coin_has_lapack in + requested | build ) + if test -n "$PKG_CONFIG" -a "skip" != skip ; then + pcfile="skip" + + + + if test -n "$PKG_CONFIG" ; then + if PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --exists "$pcfile" ; then + LAPACK_VERSIONS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --modversion "$pcfile" 2>/dev/null | tr '\n' ' '` + coin_has_lapack=yes + lapack_data=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --variable=datadir "$pcfile" 2>/dev/null` + lapack_pcfiles="$pcfile" + else + LAPACK_PKG_ERRORS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG $pkg_short_errors --errors-to-stdout --print-errors "$pcfile"` + coin_has_lapack=no + fi + else + as_fn_error $? "\"Cannot check for existence of module lapack without pkgconf\"" "$LINENO" 5 + fi + + else + coin_has_lapack=no + fi + ;; + skipping | yes ) + ;; + * ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Unexpected status \"$coin_has_lapack\" in COIN_FIND_PRIM_PKG" >&5 +$as_echo "$as_me: WARNING: Unexpected status \"$coin_has_lapack\" in COIN_FIND_PRIM_PKG" >&2;} + ;; + esac + + # The final value of coin_has_prim will be yes, no, or skipping. + # No means we looked (with pkgconfig) and didn't find anything. + # Skipping means the user said `don't use.' + # Yes means we have something, from the user or from pkgconfig. + # Note that we haven't run a useability test! + + # Define BUILDTOOLS_DEBUG to enable debugging output + if test "$BUILDTOOLS_DEBUG" = 1 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: FIND_PRIM_PKG result for lapack: \"$coin_has_lapack\"" >&5 +$as_echo "$as_me: FIND_PRIM_PKG result for lapack: \"$coin_has_lapack\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: Collected values for package 'lapack'" >&5 +$as_echo "$as_me: Collected values for package 'lapack'" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: lapack_lflags is \"$lapack_lflags\"" >&5 +$as_echo "$as_me: lapack_lflags is \"$lapack_lflags\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: lapack_cflags is \"$lapack_cflags\"" >&5 +$as_echo "$as_me: lapack_cflags is \"$lapack_cflags\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: lapack_data is \"$lapack_data\"" >&5 +$as_echo "$as_me: lapack_data is \"$lapack_data\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: lapack_pcfiles is \"$lapack_pcfiles\"" >&5 +$as_echo "$as_me: lapack_pcfiles is \"$lapack_pcfiles\"" >&6;} + fi + + + + # If found something, then we'll do a link check to figure + # out whether it is working and what the name mangling scheme is. + # This sets dsyev_namemangling + if test "$coin_has_lapack" = yes ; then + + ac_save_LIBS="$LIBS" + LIBS="$lapack_lflags $LIBS" + if test -n "$lapack_pcfiles" ; then + + temp_LFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --libs $pkg_static $lapack_pcfiles` + LIBS="$temp_LFLAGS $LIBS" + fi + + dsyev_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=dsyev + ;; + "upper case") + ac_name=DSYEV + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + dsyev_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + : + else as_fn_error $? "Could not find dsyev in Lapack" "$LINENO" 5 + fi + + fi + + # If not found anything, try a few more guesses for optimized blas/lapack libs (based on build system type). + if test "$coin_has_lapack" = no ; then + case $build in + *-linux*) + + ac_save_LIBS="$LIBS" + LIBS="-lmkl_intel_lp64 -lmkl_sequential -lmkl_core -lm $LIBS" + + + dsyev_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=dsyev + ;; + "upper case") + ac_name=DSYEV + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + dsyev_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + + coin_has_lapack=yes + lapack_lflags="-lmkl_intel_lp64 -lmkl_sequential -lmkl_core -lm" + + fi + + ;; + + *-sgi-*) + + ac_save_LIBS="$LIBS" + LIBS="-lcomplib.sgimath $LIBS" + + + dsyev_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=dsyev + ;; + "upper case") + ac_name=DSYEV + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + dsyev_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + + coin_has_lapack=yes + lapack_lflags=-lcomplib.sgimath + + fi + + ;; + + *-*-solaris*) + + ac_save_LIBS="$LIBS" + LIBS="-lsunperf $LIBS" + + + dsyev_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=dsyev + ;; + "upper case") + ac_name=DSYEV + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + dsyev_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + + coin_has_lapack=yes + lapack_lflags=-lsunperf + + fi + + ;; + + *-cygwin* | *-mingw* | *-msys*) + # check for 64-bit sequential MKL in $LIB + old_IFS="$IFS" + IFS=";" + coin_mkl="" + for d in $LIB ; do + # turn $d into unix-style short path (no spaces); cannot do -us, so first do -ws, then -u + d=`cygpath -ws "$d"` + d=`cygpath -u "$d"` + if test "$enable_shared" = yes ; then + if test -e "$d/mkl_core_dll.lib" ; then + coin_mkl="$d/mkl_intel_lp64_dll.lib $d/mkl_sequential_dll.lib $d/mkl_core_dll.lib" + break + fi + else + if test -e "$d/mkl_core.lib" ; then + coin_mkl="$d/mkl_intel_lp64.lib $d/mkl_sequential.lib $d/mkl_core.lib" + break + fi + fi + done + IFS="$old_IFS" + if test -n "$coin_mkl" ; then + + ac_save_LIBS="$LIBS" + LIBS="$coin_mkl $LIBS" + + + dsyev_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=dsyev + ;; + "upper case") + ac_name=DSYEV + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + dsyev_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + coin_has_lapack=yes + lapack_lflags="$coin_mkl" + + fi + + fi + ;; + + *-darwin*) + + ac_save_LIBS="$LIBS" + LIBS="-lmkl_intel_lp64 -lmkl_sequential -lmkl_core -lm $LIBS" + + + dsyev_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=dsyev + ;; + "upper case") + ac_name=DSYEV + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + dsyev_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + + coin_has_lapack=yes + lapack_lflags="-lmkl_intel_lp64 -lmkl_sequential -lmkl_core -lm" + + fi + + if test "$coin_has_lapack" = no ; then + + ac_save_LIBS="$LIBS" + LIBS="-framework Accelerate $LIBS" + + + dsyev_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=dsyev + ;; + "upper case") + ac_name=DSYEV + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + dsyev_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + + coin_has_lapack=yes + lapack_lflags="-framework Accelerate" + + fi + + fi + ;; + esac + fi + + # If none of the above worked, check whether lapack.pc blas.pc exists and links. + # We check for both to ensure that blas lib also appears on link line in case + # someone wants to use Blas functions but tests only for Lapack. + if test "$coin_has_lapack" = no ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for lapack.pc and blas.pc" >&5 +$as_echo_n "checking for lapack.pc and blas.pc... " >&6; } + + + + if test -n "$PKG_CONFIG" ; then + if PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --exists "lapack blas" ; then + LAPACK_VERSIONS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --modversion "lapack blas" 2>/dev/null | tr '\n' ' '` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + + ac_save_LIBS="$LIBS" + + if test -n "lapack" ; then + + temp_LFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --libs $pkg_static lapack` + LIBS="$temp_LFLAGS $LIBS" + fi + + dsyev_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=dsyev + ;; + "upper case") + ac_name=DSYEV + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + dsyev_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + coin_has_lapack=yes + lapack_pcfiles="lapack blas" + else { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: lapack.pc and blas.pc present, but could not find dsyev when trying to link with it." >&5 +$as_echo "$as_me: WARNING: lapack.pc and blas.pc present, but could not find dsyev when trying to link with it." >&2;} + fi + + else + LAPACK_PKG_ERRORS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG $pkg_short_errors --errors-to-stdout --print-errors "lapack blas"` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + fi + else + as_fn_error $? "\"Cannot check for existence of module lapack without pkgconf\"" "$LINENO" 5 + fi + + fi + + # If none of the above worked, try the generic -llapack -lblas as last resort. + # We check for both to ensure that blas lib also appears on link line in case + # someone wants to use Blas functions but tests only for Lapack. + if test "$coin_has_lapack" = no ; then + + ac_save_LIBS="$LIBS" + LIBS="-llapack -lblas $LIBS" + + + dsyev_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=dsyev + ;; + "upper case") + ac_name=DSYEV + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + dsyev_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + + coin_has_lapack=yes + lapack_lflags="-llapack -lblas" + + fi + + fi + + if test $coin_has_lapack = yes; then + IPOPT_HAS_LAPACK_TRUE= + IPOPT_HAS_LAPACK_FALSE='#' +else + IPOPT_HAS_LAPACK_TRUE='#' + IPOPT_HAS_LAPACK_FALSE= +fi + + + # If we've located the package, define preprocessor symbol IPOPT_HAS_LAPACK + # and IPOPT_LAPACK_FUNC[_] and augment the necessary variables for the client packages. + if test $coin_has_lapack = yes ; then + +$as_echo "#define IPOPT_HAS_LAPACK 1" >>confdefs.h + + + + + case "${dsyev_namemangling}" in + "lower case, no underscore, no extra underscore") + $as_echo "#define IPOPT_LAPACK_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define IPOPT_LAPACK_FUNC_(name,NAME) name" >>confdefs.h + ;; + "lower case, no underscore, extra underscore") + $as_echo "#define IPOPT_LAPACK_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define IPOPT_LAPACK_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, no extra underscore") + $as_echo "#define IPOPT_LAPACK_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define IPOPT_LAPACK_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, extra underscore") + $as_echo "#define IPOPT_LAPACK_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define IPOPT_LAPACK_FUNC_(name,NAME) name ## __" >>confdefs.h + ;; + "upper case, no underscore, no extra underscore") + $as_echo "#define IPOPT_LAPACK_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define IPOPT_LAPACK_FUNC_(name,NAME) NAME" >>confdefs.h + ;; + "upper case, no underscore, extra underscore") + $as_echo "#define IPOPT_LAPACK_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define IPOPT_LAPACK_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, no extra underscore") + $as_echo "#define IPOPT_LAPACK_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define IPOPT_LAPACK_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, extra underscore") + $as_echo "#define IPOPT_LAPACK_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define IPOPT_LAPACK_FUNC_(name,NAME) NAME ## __" >>confdefs.h + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Unsupported or unknown name-mangling scheme: ${dsyev_namemangling}" >&5 +$as_echo "$as_me: WARNING: Unsupported or unknown name-mangling scheme: ${dsyev_namemangling}" >&2;} + ;; + esac + + if test -n "$lapack_pcfiles" ; then IPOPTLIB_PCFILES="$lapack_pcfiles $IPOPTLIB_PCFILES" ; fi + IPOPTLIB_LFLAGS="$lapack_lflags $IPOPTLIB_LFLAGS" + IPOPTLIB_CFLAGS="$lapack_cflags $IPOPTLIB_CFLAGS" + + fi + +if test $coin_has_lapack != yes; then + as_fn_error $? "Required package LAPACK not found." "$LINENO" 5 +# AC_MSG_WARN([Compiling code without LAPACK. Certain options (e.g., quasi-Newton) will not work.]) +fi + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for package ASL" >&5 +$as_echo_n "checking for package ASL... " >&6; } + + + + + + + + + + # Check to see if the user has set an override to skip this primary. + coin_has_asl=noInfo + if test x"$COIN_SKIP_PROJECTS" != x ; then + for pkg in $COIN_SKIP_PROJECTS ; do + if test "$pkg" = "$asl" ; then + coin_has_asl=skipping + fi + done + fi + + if test "$coin_has_asl" != skipping ; then + + + + +# Check whether --with-asl was given. +if test "${with_asl+set}" = set; then : + withval=$with_asl; +fi + + + +# Check whether --with-asl-lflags was given. +if test "${with_asl_lflags+set}" = set; then : + withval=$with_asl_lflags; +fi + + + +# Check whether --with-asl-cflags was given. +if test "${with_asl_cflags+set}" = set; then : + withval=$with_asl_cflags; +fi + + + + + + + + dflt_action=build + + # Initialize variables for the primary package. + coin_has_asl=noInfo + asl_lflags= + asl_cflags= + asl_data= + asl_pcfiles= + + # --with-prim is always present. + withval="$with_asl" + if test -n "$withval" ; then + case "$withval" in + no ) + coin_has_asl=skipping + ;; + yes ) + coin_has_asl=requested + ;; + build ) + coin_has_asl=build + ;; + * ) + coin_has_asl=yes + asl_lflags="$withval" + ;; + esac + fi + + # Specifying --with-prim=no overrides the individual options for lflags and cflags. + if test "$coin_has_asl" != skipping ; then + withval="$with_asl_lflags" + if test -n "$withval" ; then + case "$withval" in + build | no | yes ) + as_fn_error $? "\"$withval\" is not valid here; please specify linker flags appropriate for your environment." "$LINENO" 5 + ;; + * ) + coin_has_asl=yes + asl_lflags="$withval" + ;; + esac + fi + + withval="$with_asl_cflags" + if test -n "$withval" ; then + case "$withval" in + build | no | yes ) + as_fn_error $? "\"$withval\" is not valid here; please specify compiler flags appropriate for your environment." "$LINENO" 5 + ;; + * ) + coin_has_asl=yes + asl_cflags="$withval" + ;; + esac + fi + fi + + + + # At this point, coin_has_prim can be one of + # - noInfo (no user options specified), + # - skipping (user said no), + # - requested, + # - build (user said yes or build and gave no further guidance), + # - or yes (user specified one or more --with-prim options). + # If we're already at yes or skipping, we're done looking. + + # If there are no user options (noInfo) and the default is no, we're skipping. + # Otherwise, the default must be yes or build; consider the package requested. + # A default action we don't recognise defaults to yes. + if test "$coin_has_asl" = noInfo ; then + case $dflt_action in + no ) + coin_has_asl=skipping + ;; + build ) + coin_has_asl=build + ;; + * ) + coin_has_asl=requested + ;; + esac + fi + + # Now coin_has_prim can be one of skipping, yes, requested, or build. + # For requested or build, try pkgconf, if it's available. + # If it's not available, well, hope that the user knows their system + # and prim can be used with no additional flags. + case $coin_has_asl in + requested | build ) + if test -n "$PKG_CONFIG" -a "coinasl" != skip ; then + pcfile="coinasl" + + + + if test -n "$PKG_CONFIG" ; then + if PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --exists "$pcfile" ; then + ASL_VERSIONS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --modversion "$pcfile" 2>/dev/null | tr '\n' ' '` + coin_has_asl=yes + asl_data=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --variable=datadir "$pcfile" 2>/dev/null` + asl_pcfiles="$pcfile" + else + ASL_PKG_ERRORS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG $pkg_short_errors --errors-to-stdout --print-errors "$pcfile"` + coin_has_asl=no + fi + else + as_fn_error $? "\"Cannot check for existence of module asl without pkgconf\"" "$LINENO" 5 + fi + + else + coin_has_asl=no + fi + ;; + skipping | yes ) + ;; + * ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Unexpected status \"$coin_has_asl\" in COIN_FIND_PRIM_PKG" >&5 +$as_echo "$as_me: WARNING: Unexpected status \"$coin_has_asl\" in COIN_FIND_PRIM_PKG" >&2;} + ;; + esac + + # The final value of coin_has_prim will be yes, no, or skipping. + # No means we looked (with pkgconfig) and didn't find anything. + # Skipping means the user said `don't use.' + # Yes means we have something, from the user or from pkgconfig. + # Note that we haven't run a useability test! + + # Define BUILDTOOLS_DEBUG to enable debugging output + if test "$BUILDTOOLS_DEBUG" = 1 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: FIND_PRIM_PKG result for asl: \"$coin_has_asl\"" >&5 +$as_echo "$as_me: FIND_PRIM_PKG result for asl: \"$coin_has_asl\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: Collected values for package 'asl'" >&5 +$as_echo "$as_me: Collected values for package 'asl'" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: asl_lflags is \"$asl_lflags\"" >&5 +$as_echo "$as_me: asl_lflags is \"$asl_lflags\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: asl_cflags is \"$asl_cflags\"" >&5 +$as_echo "$as_me: asl_cflags is \"$asl_cflags\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: asl_data is \"$asl_data\"" >&5 +$as_echo "$as_me: asl_data is \"$asl_data\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: asl_pcfiles is \"$asl_pcfiles\"" >&5 +$as_echo "$as_me: asl_pcfiles is \"$asl_pcfiles\"" >&6;} + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $coin_has_asl" >&5 +$as_echo "$coin_has_asl" >&6; } + + if test "$PKG_CONFIG$coin_has_asl" = no ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Check for ASL via pkg-config was skipped as no pkg-config available. If ASL was meant to be found, then consider installing pkg-config or provide appropriate --with-asl-lflags, --with-asl-cflags, etc." >&5 +$as_echo "$as_me: WARNING: Check for ASL via pkg-config was skipped as no pkg-config available. If ASL was meant to be found, then consider installing pkg-config or provide appropriate --with-asl-lflags, --with-asl-cflags, etc." >&2;} + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $coin_has_asl due to COIN_SKIP_PROJECTS" >&5 +$as_echo "$coin_has_asl due to COIN_SKIP_PROJECTS" >&6; } + fi + + # Possibilities are `yes', 'no', or `skipping'. Normalise to `yes' or `no'. + if test "$coin_has_asl" != yes ; then + coin_has_asl=no + fi + + if test $coin_has_asl = yes; then + IPOPT_HAS_ASL_TRUE= + IPOPT_HAS_ASL_FALSE='#' +else + IPOPT_HAS_ASL_TRUE='#' + IPOPT_HAS_ASL_FALSE= +fi + + + # If we have located the package, define preprocessor symbol PKG_HAS_PRIM and + # augment the necessary variables for the client packages. + if test $coin_has_asl = yes ; then + +$as_echo "#define IPOPT_HAS_ASL 1" >>confdefs.h + + if test -n "$asl_pcfiles" ; then IPOPTAMPLINTERFACELIB_PCFILES="$asl_pcfiles $IPOPTAMPLINTERFACELIB_PCFILES" ; fi + IPOPTAMPLINTERFACELIB_LFLAGS="$asl_lflags $IPOPTAMPLINTERFACELIB_LFLAGS" + IPOPTAMPLINTERFACELIB_CFLAGS="$asl_cflags $IPOPTAMPLINTERFACELIB_CFLAGS" + if test -n "$asl_pcfiles" ; then SIPOPTAMPLINTERFACELIB_PCFILES="$asl_pcfiles $SIPOPTAMPLINTERFACELIB_PCFILES" ; fi + SIPOPTAMPLINTERFACELIB_LFLAGS="$asl_lflags $SIPOPTAMPLINTERFACELIB_LFLAGS" + SIPOPTAMPLINTERFACELIB_CFLAGS="$asl_cflags $SIPOPTAMPLINTERFACELIB_CFLAGS" + + + + fi + + +######### +# MUMPS # +######### + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for package Mumps" >&5 +$as_echo_n "checking for package Mumps... " >&6; } + + + + + + + # Check to see if the user has set an override to skip this primary. + coin_has_mumps=noInfo + if test x"$COIN_SKIP_PROJECTS" != x ; then + for pkg in $COIN_SKIP_PROJECTS ; do + if test "$pkg" = "$mumps" ; then + coin_has_mumps=skipping + fi + done + fi + + if test "$coin_has_mumps" != skipping ; then + + + + +# Check whether --with-mumps was given. +if test "${with_mumps+set}" = set; then : + withval=$with_mumps; +fi + + + +# Check whether --with-mumps-lflags was given. +if test "${with_mumps_lflags+set}" = set; then : + withval=$with_mumps_lflags; +fi + + + +# Check whether --with-mumps-cflags was given. +if test "${with_mumps_cflags+set}" = set; then : + withval=$with_mumps_cflags; +fi + + + + + + + + dflt_action=build + + # Initialize variables for the primary package. + coin_has_mumps=noInfo + mumps_lflags= + mumps_cflags= + mumps_data= + mumps_pcfiles= + + # --with-prim is always present. + withval="$with_mumps" + if test -n "$withval" ; then + case "$withval" in + no ) + coin_has_mumps=skipping + ;; + yes ) + coin_has_mumps=requested + ;; + build ) + coin_has_mumps=build + ;; + * ) + coin_has_mumps=yes + mumps_lflags="$withval" + ;; + esac + fi + + # Specifying --with-prim=no overrides the individual options for lflags and cflags. + if test "$coin_has_mumps" != skipping ; then + withval="$with_mumps_lflags" + if test -n "$withval" ; then + case "$withval" in + build | no | yes ) + as_fn_error $? "\"$withval\" is not valid here; please specify linker flags appropriate for your environment." "$LINENO" 5 + ;; + * ) + coin_has_mumps=yes + mumps_lflags="$withval" + ;; + esac + fi + + withval="$with_mumps_cflags" + if test -n "$withval" ; then + case "$withval" in + build | no | yes ) + as_fn_error $? "\"$withval\" is not valid here; please specify compiler flags appropriate for your environment." "$LINENO" 5 + ;; + * ) + coin_has_mumps=yes + mumps_cflags="$withval" + ;; + esac + fi + fi + + + + # At this point, coin_has_prim can be one of + # - noInfo (no user options specified), + # - skipping (user said no), + # - requested, + # - build (user said yes or build and gave no further guidance), + # - or yes (user specified one or more --with-prim options). + # If we're already at yes or skipping, we're done looking. + + # If there are no user options (noInfo) and the default is no, we're skipping. + # Otherwise, the default must be yes or build; consider the package requested. + # A default action we don't recognise defaults to yes. + if test "$coin_has_mumps" = noInfo ; then + case $dflt_action in + no ) + coin_has_mumps=skipping + ;; + build ) + coin_has_mumps=build + ;; + * ) + coin_has_mumps=requested + ;; + esac + fi + + # Now coin_has_prim can be one of skipping, yes, requested, or build. + # For requested or build, try pkgconf, if it's available. + # If it's not available, well, hope that the user knows their system + # and prim can be used with no additional flags. + case $coin_has_mumps in + requested | build ) + if test -n "$PKG_CONFIG" -a "coinmumps" != skip ; then + pcfile="coinmumps" + + + + if test -n "$PKG_CONFIG" ; then + if PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --exists "$pcfile" ; then + MUMPS_VERSIONS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --modversion "$pcfile" 2>/dev/null | tr '\n' ' '` + coin_has_mumps=yes + mumps_data=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --variable=datadir "$pcfile" 2>/dev/null` + mumps_pcfiles="$pcfile" + else + MUMPS_PKG_ERRORS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG $pkg_short_errors --errors-to-stdout --print-errors "$pcfile"` + coin_has_mumps=no + fi + else + as_fn_error $? "\"Cannot check for existence of module mumps without pkgconf\"" "$LINENO" 5 + fi + + else + coin_has_mumps=no + fi + ;; + skipping | yes ) + ;; + * ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Unexpected status \"$coin_has_mumps\" in COIN_FIND_PRIM_PKG" >&5 +$as_echo "$as_me: WARNING: Unexpected status \"$coin_has_mumps\" in COIN_FIND_PRIM_PKG" >&2;} + ;; + esac + + # The final value of coin_has_prim will be yes, no, or skipping. + # No means we looked (with pkgconfig) and didn't find anything. + # Skipping means the user said `don't use.' + # Yes means we have something, from the user or from pkgconfig. + # Note that we haven't run a useability test! + + # Define BUILDTOOLS_DEBUG to enable debugging output + if test "$BUILDTOOLS_DEBUG" = 1 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: FIND_PRIM_PKG result for mumps: \"$coin_has_mumps\"" >&5 +$as_echo "$as_me: FIND_PRIM_PKG result for mumps: \"$coin_has_mumps\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: Collected values for package 'mumps'" >&5 +$as_echo "$as_me: Collected values for package 'mumps'" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: mumps_lflags is \"$mumps_lflags\"" >&5 +$as_echo "$as_me: mumps_lflags is \"$mumps_lflags\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: mumps_cflags is \"$mumps_cflags\"" >&5 +$as_echo "$as_me: mumps_cflags is \"$mumps_cflags\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: mumps_data is \"$mumps_data\"" >&5 +$as_echo "$as_me: mumps_data is \"$mumps_data\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: mumps_pcfiles is \"$mumps_pcfiles\"" >&5 +$as_echo "$as_me: mumps_pcfiles is \"$mumps_pcfiles\"" >&6;} + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $coin_has_mumps" >&5 +$as_echo "$coin_has_mumps" >&6; } + + if test "$PKG_CONFIG$coin_has_mumps" = no ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Check for Mumps via pkg-config was skipped as no pkg-config available. If Mumps was meant to be found, then consider installing pkg-config or provide appropriate --with-mumps-lflags, --with-mumps-cflags, etc." >&5 +$as_echo "$as_me: WARNING: Check for Mumps via pkg-config was skipped as no pkg-config available. If Mumps was meant to be found, then consider installing pkg-config or provide appropriate --with-mumps-lflags, --with-mumps-cflags, etc." >&2;} + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $coin_has_mumps due to COIN_SKIP_PROJECTS" >&5 +$as_echo "$coin_has_mumps due to COIN_SKIP_PROJECTS" >&6; } + fi + + # Possibilities are `yes', 'no', or `skipping'. Normalise to `yes' or `no'. + if test "$coin_has_mumps" != yes ; then + coin_has_mumps=no + fi + + if test $coin_has_mumps = yes; then + IPOPT_HAS_MUMPS_TRUE= + IPOPT_HAS_MUMPS_FALSE='#' +else + IPOPT_HAS_MUMPS_TRUE='#' + IPOPT_HAS_MUMPS_FALSE= +fi + + + # If we have located the package, define preprocessor symbol PKG_HAS_PRIM and + # augment the necessary variables for the client packages. + if test $coin_has_mumps = yes ; then + +$as_echo "#define IPOPT_HAS_MUMPS 1" >>confdefs.h + + if test -n "$mumps_pcfiles" ; then IPOPTLIB_PCFILES="$mumps_pcfiles $IPOPTLIB_PCFILES" ; fi + IPOPTLIB_LFLAGS="$mumps_lflags $IPOPTLIB_LFLAGS" + IPOPTLIB_CFLAGS="$mumps_cflags $IPOPTLIB_CFLAGS" + + + + fi + + +# Check whether MPI_Initialized is available +# we assume that MPI_Finalized is present if MPI_Initialized is present +for ac_func in MPI_Initialized +do : + ac_fn_c_check_func "$LINENO" "MPI_Initialized" "ac_cv_func_MPI_Initialized" +if test "x$ac_cv_func_MPI_Initialized" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_MPI_INITIALIZED 1 +_ACEOF + +fi +done + + +####### +# HSL # +####### + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for package HSL" >&5 +$as_echo_n "checking for package HSL... " >&6; } + + + + + + + + + + # Check to see if the user has set an override to skip this primary. + coin_has_hsl=noInfo + if test x"$COIN_SKIP_PROJECTS" != x ; then + for pkg in $COIN_SKIP_PROJECTS ; do + if test "$pkg" = "$hsl" ; then + coin_has_hsl=skipping + fi + done + fi + + if test "$coin_has_hsl" != skipping ; then + + + + +# Check whether --with-hsl was given. +if test "${with_hsl+set}" = set; then : + withval=$with_hsl; +fi + + + +# Check whether --with-hsl-lflags was given. +if test "${with_hsl_lflags+set}" = set; then : + withval=$with_hsl_lflags; +fi + + + +# Check whether --with-hsl-cflags was given. +if test "${with_hsl_cflags+set}" = set; then : + withval=$with_hsl_cflags; +fi + + + + + + + + dflt_action=build + + # Initialize variables for the primary package. + coin_has_hsl=noInfo + hsl_lflags= + hsl_cflags= + hsl_data= + hsl_pcfiles= + + # --with-prim is always present. + withval="$with_hsl" + if test -n "$withval" ; then + case "$withval" in + no ) + coin_has_hsl=skipping + ;; + yes ) + coin_has_hsl=requested + ;; + build ) + coin_has_hsl=build + ;; + * ) + coin_has_hsl=yes + hsl_lflags="$withval" + ;; + esac + fi + + # Specifying --with-prim=no overrides the individual options for lflags and cflags. + if test "$coin_has_hsl" != skipping ; then + withval="$with_hsl_lflags" + if test -n "$withval" ; then + case "$withval" in + build | no | yes ) + as_fn_error $? "\"$withval\" is not valid here; please specify linker flags appropriate for your environment." "$LINENO" 5 + ;; + * ) + coin_has_hsl=yes + hsl_lflags="$withval" + ;; + esac + fi + + withval="$with_hsl_cflags" + if test -n "$withval" ; then + case "$withval" in + build | no | yes ) + as_fn_error $? "\"$withval\" is not valid here; please specify compiler flags appropriate for your environment." "$LINENO" 5 + ;; + * ) + coin_has_hsl=yes + hsl_cflags="$withval" + ;; + esac + fi + fi + + + + # At this point, coin_has_prim can be one of + # - noInfo (no user options specified), + # - skipping (user said no), + # - requested, + # - build (user said yes or build and gave no further guidance), + # - or yes (user specified one or more --with-prim options). + # If we're already at yes or skipping, we're done looking. + + # If there are no user options (noInfo) and the default is no, we're skipping. + # Otherwise, the default must be yes or build; consider the package requested. + # A default action we don't recognise defaults to yes. + if test "$coin_has_hsl" = noInfo ; then + case $dflt_action in + no ) + coin_has_hsl=skipping + ;; + build ) + coin_has_hsl=build + ;; + * ) + coin_has_hsl=requested + ;; + esac + fi + + # Now coin_has_prim can be one of skipping, yes, requested, or build. + # For requested or build, try pkgconf, if it's available. + # If it's not available, well, hope that the user knows their system + # and prim can be used with no additional flags. + case $coin_has_hsl in + requested | build ) + if test -n "$PKG_CONFIG" -a "coinhsl" != skip ; then + pcfile="coinhsl" + + + + if test -n "$PKG_CONFIG" ; then + if PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --exists "$pcfile" ; then + HSL_VERSIONS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --modversion "$pcfile" 2>/dev/null | tr '\n' ' '` + coin_has_hsl=yes + hsl_data=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --variable=datadir "$pcfile" 2>/dev/null` + hsl_pcfiles="$pcfile" + else + HSL_PKG_ERRORS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG $pkg_short_errors --errors-to-stdout --print-errors "$pcfile"` + coin_has_hsl=no + fi + else + as_fn_error $? "\"Cannot check for existence of module hsl without pkgconf\"" "$LINENO" 5 + fi + + else + coin_has_hsl=no + fi + ;; + skipping | yes ) + ;; + * ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Unexpected status \"$coin_has_hsl\" in COIN_FIND_PRIM_PKG" >&5 +$as_echo "$as_me: WARNING: Unexpected status \"$coin_has_hsl\" in COIN_FIND_PRIM_PKG" >&2;} + ;; + esac + + # The final value of coin_has_prim will be yes, no, or skipping. + # No means we looked (with pkgconfig) and didn't find anything. + # Skipping means the user said `don't use.' + # Yes means we have something, from the user or from pkgconfig. + # Note that we haven't run a useability test! + + # Define BUILDTOOLS_DEBUG to enable debugging output + if test "$BUILDTOOLS_DEBUG" = 1 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: FIND_PRIM_PKG result for hsl: \"$coin_has_hsl\"" >&5 +$as_echo "$as_me: FIND_PRIM_PKG result for hsl: \"$coin_has_hsl\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: Collected values for package 'hsl'" >&5 +$as_echo "$as_me: Collected values for package 'hsl'" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: hsl_lflags is \"$hsl_lflags\"" >&5 +$as_echo "$as_me: hsl_lflags is \"$hsl_lflags\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: hsl_cflags is \"$hsl_cflags\"" >&5 +$as_echo "$as_me: hsl_cflags is \"$hsl_cflags\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: hsl_data is \"$hsl_data\"" >&5 +$as_echo "$as_me: hsl_data is \"$hsl_data\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: hsl_pcfiles is \"$hsl_pcfiles\"" >&5 +$as_echo "$as_me: hsl_pcfiles is \"$hsl_pcfiles\"" >&6;} + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $coin_has_hsl" >&5 +$as_echo "$coin_has_hsl" >&6; } + + if test "$PKG_CONFIG$coin_has_hsl" = no ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Check for HSL via pkg-config was skipped as no pkg-config available. If HSL was meant to be found, then consider installing pkg-config or provide appropriate --with-hsl-lflags, --with-hsl-cflags, etc." >&5 +$as_echo "$as_me: WARNING: Check for HSL via pkg-config was skipped as no pkg-config available. If HSL was meant to be found, then consider installing pkg-config or provide appropriate --with-hsl-lflags, --with-hsl-cflags, etc." >&2;} + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $coin_has_hsl due to COIN_SKIP_PROJECTS" >&5 +$as_echo "$coin_has_hsl due to COIN_SKIP_PROJECTS" >&6; } + fi + + # Possibilities are `yes', 'no', or `skipping'. Normalise to `yes' or `no'. + if test "$coin_has_hsl" != yes ; then + coin_has_hsl=no + fi + + if test $coin_has_hsl = yes; then + IPOPT_HAS_HSL_TRUE= + IPOPT_HAS_HSL_FALSE='#' +else + IPOPT_HAS_HSL_TRUE='#' + IPOPT_HAS_HSL_FALSE= +fi + + + # If we have located the package, define preprocessor symbol PKG_HAS_PRIM and + # augment the necessary variables for the client packages. + if test $coin_has_hsl = yes ; then + +$as_echo "#define IPOPT_HAS_HSL 1" >>confdefs.h + + if test -n "$hsl_pcfiles" ; then IPOPTLIB_PCFILES="$hsl_pcfiles $IPOPTLIB_PCFILES" ; fi + IPOPTLIB_LFLAGS="$hsl_lflags $IPOPTLIB_LFLAGS" + IPOPTLIB_CFLAGS="$hsl_cflags $IPOPTLIB_CFLAGS" + if test -n "$hsl_pcfiles" ; then HSLLIB_PCFILES="$hsl_pcfiles $HSLLIB_PCFILES" ; fi + HSLLIB_LFLAGS="$hsl_lflags $HSLLIB_LFLAGS" + HSLLIB_CFLAGS="$hsl_cflags $HSLLIB_CFLAGS" + + + + fi + + +have_ma28=no +if test "$coin_has_hsl" = yes ; then + + if test "$BUILDTOOLS_DEBUG" = 1 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: FINALIZE_FLAGS for HSLLib:" >&5 +$as_echo "$as_me: FINALIZE_FLAGS for HSLLib:" >&6;} + fi + HSLLIB_LFLAGS_NOPC=$HSLLIB_LFLAGS + + HSLLIB_CFLAGS_NOPC=$HSLLIB_CFLAGS + + if test -n "${HSLLIB_PCFILES}" ; then + temp_CFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --cflags ${HSLLIB_PCFILES}` + temp_LFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --libs $pkg_static ${HSLLIB_PCFILES}` + HSLLIB_CFLAGS="$temp_CFLAGS ${HSLLIB_CFLAGS}" + HSLLIB_LFLAGS="$temp_LFLAGS ${HSLLIB_LFLAGS}" + fi + + # setup XYZ_EXPORT symbol for library users + libexport_attribute= + if test "$enable_shared" = yes ; then + case $build_os in + cygwin* | mingw* | msys* | cegcc* ) + libexport_attribute="__declspec(dllimport)" + if test "$enable_static" = yes ; then + as_fn_error $? "Cannot do DLL and static LIB builds simultaneously. Do not add --enable-static without --disable-shared." "$LINENO" 5 + fi + ;; + esac + fi + +cat >>confdefs.h <<_ACEOF +#define HSLLIB_EXPORT $libexport_attribute +_ACEOF + + + # add -DXYZ_BUILD to XYZ_CFLAGS + HSLLIB_CFLAGS="${HSLLIB_CFLAGS} -DHSLLIB_BUILD" + + # Define BUILDTOOLS_DEBUG to enable debugging output + if test "$BUILDTOOLS_DEBUG" = 1 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: HSLLIB_LFLAGS_NOPC: \"${HSLLIB_LFLAGS_NOPC}\"" >&5 +$as_echo "$as_me: HSLLIB_LFLAGS_NOPC: \"${HSLLIB_LFLAGS_NOPC}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: HSLLIB_CFLAGS_NOPC: \"${HSLLIB_CFLAGS_NOPC}\"" >&5 +$as_echo "$as_me: HSLLIB_CFLAGS_NOPC: \"${HSLLIB_CFLAGS_NOPC}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: adding \"${HSLLIB_PCFILES}\"" >&5 +$as_echo "$as_me: adding \"${HSLLIB_PCFILES}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: HSLLIB_LFLAGS: \"${HSLLIB_LFLAGS}\"" >&5 +$as_echo "$as_me: HSLLIB_LFLAGS: \"${HSLLIB_LFLAGS}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: HSLLIB_CFLAGS: \"${HSLLIB_CFLAGS}\"" >&5 +$as_echo "$as_me: HSLLIB_CFLAGS: \"${HSLLIB_CFLAGS}\"" >&6;} + fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking HSL name mangling scheme" >&5 +$as_echo_n "checking HSL name mangling scheme... " >&6; } +if ${ac_cv_hsl_namemangling+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_save_LIBS=$LIBS + LIBS="$HSLLIB_LFLAGS" + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + for ac_extra in "no extra underscore" "extra underscore" ; do + ac_cv_hsl_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + case $ac_case in + "lower case") + ac_name=ma27ad + ;; + "upper case") + ac_name=MA27AD + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test $ac_success = yes ; then + break 3 + fi + done + done + done + if test "$ac_success" = "no" ; then + ac_cv_hsl_namemangling=unknown + fi + LIBS=$ac_save_LIBS + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_hsl_namemangling" >&5 +$as_echo "$ac_cv_hsl_namemangling" >&6; } + + + + + case "$ac_cv_hsl_namemangling" in + "lower case, no underscore, no extra underscore") + $as_echo "#define IPOPT_HSL_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define IPOPT_HSL_FUNC_(name,NAME) name" >>confdefs.h + ;; + "lower case, no underscore, extra underscore") + $as_echo "#define IPOPT_HSL_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define IPOPT_HSL_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, no extra underscore") + $as_echo "#define IPOPT_HSL_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define IPOPT_HSL_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, extra underscore") + $as_echo "#define IPOPT_HSL_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define IPOPT_HSL_FUNC_(name,NAME) name ## __" >>confdefs.h + ;; + "upper case, no underscore, no extra underscore") + $as_echo "#define IPOPT_HSL_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define IPOPT_HSL_FUNC_(name,NAME) NAME" >>confdefs.h + ;; + "upper case, no underscore, extra underscore") + $as_echo "#define IPOPT_HSL_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define IPOPT_HSL_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, no extra underscore") + $as_echo "#define IPOPT_HSL_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define IPOPT_HSL_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, extra underscore") + $as_echo "#define IPOPT_HSL_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define IPOPT_HSL_FUNC_(name,NAME) NAME ## __" >>confdefs.h + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Unsupported or unknown name-mangling scheme: $ac_cv_hsl_namemangling" >&5 +$as_echo "$as_me: WARNING: Unsupported or unknown name-mangling scheme: $ac_cv_hsl_namemangling" >&2;} + ;; + esac + + + if test "$ac_cv_hsl_namemangling" = "unknown" ; then + as_fn_error $? "Provided package HSL is not working or does not contain MA27." "$LINENO" 5 + fi + + # extra check for MA28, since that decides whether we have to build IpMa28Partition.F + if test -n "$F77" ; then + + ac_save_LIBS="$LIBS" + LIBS="$HSLLIB_LFLAGS $LIBS" + + + ma28ad_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=ma28ad + ;; + "upper case") + ac_name=MA28AD + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ma28ad_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + + if test "$ma28ad_namemangling" != "$ac_cv_f77_mangling" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Name mangling of MA28 different than Fortran. This will not link. Disabling MA28" >&5 +$as_echo "$as_me: WARNING: Name mangling of MA28 different than Fortran. This will not link. Disabling MA28" >&2;} + else + have_ma28=yes + fi + + + fi + + fi +fi + if test "$have_ma28" = yes; then + HAVE_MA28_TRUE= + HAVE_MA28_FALSE='#' +else + HAVE_MA28_TRUE='#' + HAVE_MA28_FALSE= +fi + + +########### +# PARDISO # +########### + + +# Check whether --with-pardiso was given. +if test "${with_pardiso+set}" = set; then : + withval=$with_pardiso; case "$withval" in + yes) have_pardiso_project=no ;; # no linker flags given; --with-pardiso[=yes] actually doesn't make sense, but we use it as signal to fall back to checking MKL + no) have_pardiso_project=no ;; # so with_pardiso=no, we use that below to skip checking MKL + *) have_pardiso_project=yes; pardiso_lflags="$withval" ;; + esac +else + have_pardiso_project=no +fi + + +have_pardiso_mkl=no +if test "$have_pardiso_project" = yes ; then + # check whether flags from --with-pardiso work and figure out name mangling + # if so, define IPOPT_PARDISO_FUNC and keep lflags + + ac_save_LIBS="$LIBS" + LIBS="$pardiso_lflags $lapack_lflags $LIBS" + if test -n "$lapack_pcfiles" ; then + + temp_LFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --libs $pkg_static $lapack_pcfiles` + LIBS="$temp_LFLAGS $LIBS" + fi + + pardiso_ipopt_newinterface_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=pardiso_ipopt_newinterface + ;; + "upper case") + ac_name=PARDISO_IPOPT_NEWINTERFACE + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + pardiso_ipopt_newinterface_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + + + + case "$pardiso_ipopt_newinterface_namemangling" in + "lower case, no underscore, no extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) name" >>confdefs.h + ;; + "lower case, no underscore, extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, no extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) name ## __" >>confdefs.h + ;; + "upper case, no underscore, no extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) NAME" >>confdefs.h + ;; + "upper case, no underscore, extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, no extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) NAME ## __" >>confdefs.h + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Unsupported or unknown name-mangling scheme: $pardiso_ipopt_newinterface_namemangling" >&5 +$as_echo "$as_me: WARNING: Unsupported or unknown name-mangling scheme: $pardiso_ipopt_newinterface_namemangling" >&2;} + ;; + esac + + IPOPTLIB_LFLAGS="$pardiso_lflags $IPOPTLIB_LFLAGS" + +$as_echo "#define IPOPT_HAS_PARDISO 1" >>confdefs.h + + + else as_fn_error $? "Symbol pardiso_ipopt_newinterface not found with Pardiso flags $pardiso_lflags and Lapack. Require Pardiso >= 4.0." "$LINENO" 5 + fi + + + + ac_save_LIBS="$LIBS" + LIBS="$pardiso_lflags $lapack_lflags $LIBS" + if test -n "$lapack_pcfiles" ; then + + temp_LFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --libs $pkg_static $lapack_pcfiles` + LIBS="$temp_LFLAGS $LIBS" + fi + + pardiso_exist_parallel_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=pardiso_exist_parallel + ;; + "upper case") + ac_name=PARDISO_EXIST_PARALLEL + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + pardiso_exist_parallel_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + +$as_echo "#define IPOPT_HAS_PARDISO_PARALLEL 1" >>confdefs.h + + + fi + + +elif test "$with_pardiso" != no ; then + # check whether Pardiso is available via Lapack, which should then be MKL + # figure out name mangling and define IPOPT_PARDISO_FUNC + + ac_save_LIBS="$LIBS" + LIBS="$lapack_lflags $LIBS" + if test -n "$lapack_pcfiles" ; then + + temp_LFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --libs $pkg_static $lapack_pcfiles` + LIBS="$temp_LFLAGS $LIBS" + fi + + pardiso_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=pardiso + ;; + "upper case") + ac_name=PARDISO + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + pardiso_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + + + + case "$pardiso_namemangling" in + "lower case, no underscore, no extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) name" >>confdefs.h + ;; + "lower case, no underscore, extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, no extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) name ## __" >>confdefs.h + ;; + "upper case, no underscore, no extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) NAME" >>confdefs.h + ;; + "upper case, no underscore, extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, no extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, extra underscore") + $as_echo "#define IPOPT_PARDISO_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define IPOPT_PARDISO_FUNC_(name,NAME) NAME ## __" >>confdefs.h + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Unsupported or unknown name-mangling scheme: $pardiso_namemangling" >&5 +$as_echo "$as_me: WARNING: Unsupported or unknown name-mangling scheme: $pardiso_namemangling" >&2;} + ;; + esac + + have_pardiso_mkl=yes + +$as_echo "#define IPOPT_HAS_PARDISO 1" >>confdefs.h + + # assume MKL Pardiso is parallel (it never has pardiso_exist_parallel) + # TODO does sequential MKL also have a parallel Pardiso? do we need some check here? + +$as_echo "#define IPOPT_HAS_PARDISO_PARALLEL 1" >>confdefs.h + + +$as_echo "#define IPOPT_HAS_PARDISO_MKL 1" >>confdefs.h + + + + fi + +fi + + if test "$have_pardiso_mkl$have_pardiso_project" != nono; then + HAVE_PARDISO_TRUE= + HAVE_PARDISO_FALSE='#' +else + HAVE_PARDISO_TRUE='#' + HAVE_PARDISO_FALSE= +fi + + +######## +# WSMP # +######## + + +# Check whether --with-wsmp was given. +if test "${with_wsmp+set}" = set; then : + withval=$with_wsmp; have_wsmp=yes; wsmp_lflags=$withval +else + have_wsmp=no +fi + + +if test "$have_wsmp" = "yes"; then + + ac_save_LIBS="$LIBS" + LIBS="$wsmp_lflags $LIBS" + + + wssmp_namemangling=unknown + + for ac_extra in "no extra underscore" ; do + for ac_case in "lower case" "upper case" ; do + for ac_trail in "underscore" "no underscore" ; do + case $ac_case in + "lower case") + ac_name=wssmp + ;; + "upper case") + ac_name=WSSMP + ;; + esac + if test "$ac_trail" = underscore ; then + ac_name=${ac_name}_ + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for function $ac_name in $LIBS" >&5 +$as_echo_n "checking for function $ac_name in $LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $ac_name (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return $ac_name (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + wssmp_namemangling="${ac_case}, ${ac_trail}, ${ac_extra}" + ac_success=yes +else + ac_success=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_success" >&5 +$as_echo "$ac_success" >&6; } + if test $ac_success = yes ; then + break 3 + fi + done + done + done + LIBS=$ac_save_LIBS + + if test $ac_success = yes ; then + + + + case "$wssmp_namemangling" in + "lower case, no underscore, no extra underscore") + $as_echo "#define IPOPT_WSMP_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define IPOPT_WSMP_FUNC_(name,NAME) name" >>confdefs.h + ;; + "lower case, no underscore, extra underscore") + $as_echo "#define IPOPT_WSMP_FUNC(name,NAME) name" >>confdefs.h + + $as_echo "#define IPOPT_WSMP_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, no extra underscore") + $as_echo "#define IPOPT_WSMP_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define IPOPT_WSMP_FUNC_(name,NAME) name ## _" >>confdefs.h + ;; + "lower case, underscore, extra underscore") + $as_echo "#define IPOPT_WSMP_FUNC(name,NAME) name ## _" >>confdefs.h + + $as_echo "#define IPOPT_WSMP_FUNC_(name,NAME) name ## __" >>confdefs.h + ;; + "upper case, no underscore, no extra underscore") + $as_echo "#define IPOPT_WSMP_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define IPOPT_WSMP_FUNC_(name,NAME) NAME" >>confdefs.h + ;; + "upper case, no underscore, extra underscore") + $as_echo "#define IPOPT_WSMP_FUNC(name,NAME) NAME" >>confdefs.h + + $as_echo "#define IPOPT_WSMP_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, no extra underscore") + $as_echo "#define IPOPT_WSMP_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define IPOPT_WSMP_FUNC_(name,NAME) NAME ## _" >>confdefs.h + ;; + "upper case, underscore, extra underscore") + $as_echo "#define IPOPT_WSMP_FUNC(name,NAME) NAME ## _" >>confdefs.h + + $as_echo "#define IPOPT_WSMP_FUNC_(name,NAME) NAME ## __" >>confdefs.h + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Unsupported or unknown name-mangling scheme: $wssmp_namemangling" >&5 +$as_echo "$as_me: WARNING: Unsupported or unknown name-mangling scheme: $wssmp_namemangling" >&2;} + ;; + esac + + IPOPTLIB_LFLAGS="$wsmp_lflags $IPOPTLIB_LFLAGS" + +$as_echo "#define IPOPT_HAS_WSMP 1" >>confdefs.h + + + else as_fn_error $? "Symbol wssmp not found with WSMP flags $wsmp_lflags." "$LINENO" 5 + fi + +fi + + if test $have_wsmp = yes; then + HAVE_WSMP_TRUE= + HAVE_WSMP_FALSE='#' +else + HAVE_WSMP_TRUE='#' + HAVE_WSMP_FALSE= +fi + + +############################################################################# +# Stuff for examples # +############################################################################# + +# find out how long an int pointer is to know if we need INTEGER*4 or +# INTEGER*8 in Fortran to capture pointers. +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +# The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of int *" >&5 +$as_echo_n "checking size of int *... " >&6; } +if ${ac_cv_sizeof_int_p+:} false; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (int *))" "ac_cv_sizeof_int_p" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_int_p" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot compute sizeof (int *) +See \`config.log' for more details" "$LINENO" 5; } + else + ac_cv_sizeof_int_p=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_int_p" >&5 +$as_echo "$ac_cv_sizeof_int_p" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_INT_P $ac_cv_sizeof_int_p +_ACEOF + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + +case "$ac_cv_sizeof_int_p" in + 4 | 4?) BITS_PER_POINTER=32 + BIT32FCOMMENT='' + BIT64FCOMMENT='C' ;; + 8 | 8?) BITS_PER_POINTER=64 + BIT32FCOMMENT='C' + BIT64FCOMMENT='' ;; + *) as_fn_error $? "Unknown length of int *" "$LINENO" 5;; +esac + +############################################################################ +############################################################################ +# Stuff that we need for C++ programs # +############################################################################ +############################################################################ + +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + + +##################### +# Function isfinite # +##################### + + + + for ac_header in cmath math.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_cxx_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + break +fi + +done + + for ac_header in cfloat float.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_cxx_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + break +fi + +done + + for ac_header in cieeefp ieeefp.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_cxx_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + break +fi + +done + + + + + + IPOPT_C_FINITE= + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for std::isfinite" >&5 +$as_echo_n "checking for std::isfinite... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #ifdef HAVE_CMATH + # include + #else + # ifdef HAVE_MATH_H + # include + # endif + #endif + #ifdef HAVE_CFLOAT + # include + #else + # ifdef HAVE_FLOAT_H + # include + # endif + #endif + #ifdef HAVE_CIEEEFP + # include + #else + # ifdef HAVE_IEEEFP_H + # include + # endif + #endif + + int main () + { (void) std::isfinite(1.0) ; + return 0 ; } + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + IPOPT_C_FINITE=std::isfinite + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + + + if test -z "$IPOPT_C_FINITE"; then + for fname in isfinite finite _finite ; do + as_ac_Symbol=`$as_echo "ac_cv_have_decl_$fname" | $as_tr_sh` +ac_fn_cxx_check_decl "$LINENO" "$fname" "$as_ac_Symbol" " + #ifdef HAVE_CMATH + # include + #else + # ifdef HAVE_MATH_H + # include + # endif + #endif + #ifdef HAVE_CFLOAT + # include + #else + # ifdef HAVE_FLOAT_H + # include + # endif + #endif + #ifdef HAVE_CIEEEFP + # include + #else + # ifdef HAVE_IEEEFP_H + # include + # endif + #endif + +" +if eval test \"x\$"$as_ac_Symbol"\" = x"yes"; then : + IPOPT_C_FINITE=$fname +fi + + if test -n "$IPOPT_C_FINITE" ; then + break + fi + done + fi + + if test -z "$IPOPT_C_FINITE"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Cannot find C-function for checking Inf." >&5 +$as_echo "$as_me: WARNING: Cannot find C-function for checking Inf." >&2;} + else + +cat >>confdefs.h <<_ACEOF +#define IPOPT_C_FINITE $IPOPT_C_FINITE +_ACEOF + + fi + + +########### +# va_copy # +########### + +ac_fn_cxx_check_decl "$LINENO" "va_copy" "ac_cv_have_decl_va_copy" "#include +" +if test "x$ac_cv_have_decl_va_copy" = xyes; then : + +$as_echo "#define IPOPT_HAS_VA_COPY 1" >>confdefs.h + +fi + + +########################### +# Random number generator # +########################### + +ac_fn_cxx_check_decl "$LINENO" "drand48" "ac_cv_have_decl_drand48" "#include +" +if test "x$ac_cv_have_decl_drand48" = xyes; then : + +$as_echo "#define IPOPT_HAS_DRAND48 1" >>confdefs.h + +fi + + +ac_fn_cxx_check_decl "$LINENO" "rand" "ac_cv_have_decl_rand" "#include +" +if test "x$ac_cv_have_decl_rand" = xyes; then : + +$as_echo "#define IPOPT_HAS_RAND 1" >>confdefs.h + +fi + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for std::srand" >&5 +$as_echo_n "checking for std::srand... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + int main () + { (void) std::srand(1) ; + return 0 ; } + +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + +$as_echo "#define IPOPT_HAS_STD__RAND 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + + +########################################################################## + +################################################### +# Check if user wants inexact algorithm available # +################################################### + +# Check whether --enable-inexact-solver was given. +if test "${enable_inexact_solver+set}" = set; then : + enableval=$enable_inexact_solver; case "$enableval" in + no | yes) ;; + *) + as_fn_error $? "invalid argument for --enable-inexact-solver: $enableval" "$LINENO" 5;; + esac + use_inexact=$enableval +else + use_inexact=no +fi + + +if test $use_inexact = yes; then + if test $have_pardiso_project = no; then + as_fn_error $? "The inexact solver option is currently only available with Pardiso from pardiso-project.org" "$LINENO" 5 + fi + +$as_echo "#define BUILD_INEXACT 1" >>confdefs.h + +fi + if test $use_inexact = yes; then + BUILD_INEXACT_TRUE= + BUILD_INEXACT_FALSE='#' +else + BUILD_INEXACT_TRUE='#' + BUILD_INEXACT_FALSE= +fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +###################################### +# Equivalent int Fortran and C types # +###################################### + +# FIXME: The following test should be active, but this requires change in +# code to copy Index* to ipfint* arrays... +if test "$cross_compiling" = no && test "$is_bg" != yes; then + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +$as_echo "#define IPOPT_FORTRAN_INTEGER_TYPE int" >>confdefs.h + +# AC_CHECK_SIZEOF([long]) +# AC_CHECK_SIZEOF([int]) +# AC_CHECK_SIZEOF([double]) +# AC_MSG_CHECKING([for C type corresponding to Fortran INTEGER]) +# if test $ac_cv_sizeof_long = $ac_cv_sizeof_double; then +# AC_DEFINE([IPOPT_FORTRAN_INTEGER_TYPE],[int],[Define to the C type corresponding to Fortran INTEGER]) +# AC_MSG_RESULT([int]) +# else +# AC_DEFINE([IPOPT_FORTRAN_INTEGER_TYPE],[long]) +# AC_MSG_RESULT([long]) +# fi + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: We are cross compiling, assuming Fortran 'INTEGER' type corresponds to C 'int' type" >&5 +$as_echo "$as_me: WARNING: We are cross compiling, assuming Fortran 'INTEGER' type corresponds to C 'int' type" >&2;} + $as_echo "#define IPOPT_FORTRAN_INTEGER_TYPE int" >>confdefs.h + +fi + +############# JAVA + +# Check whether --enable-java was given. +if test "${enable_java+set}" = set; then : + enableval=$enable_java; enable_java="$enableval" +else + case "$JAVA_HOME" in + *\ * ) enable_java=no ;; # do not enable java-check by default, if there are spaces in JAVA_HOME - that causes trouble + * ) enable_java="$enable_shared" ;; + esac + +fi + + +if test "$enable_java" != no ; then + # look for javac: required to compile Java code and build C-header + # this is a modified version of AX_PROG_JAVAC + if test "x$JAVAPREFIX" = x; then : + test "x$JAVAC" = x && for ac_prog in "gcj -C" guavac jikes javac +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_JAVAC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$JAVAC"; then + ac_cv_prog_JAVAC="$JAVAC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_JAVAC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +JAVAC=$ac_cv_prog_JAVAC +if test -n "$JAVAC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $JAVAC" >&5 +$as_echo "$JAVAC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$JAVAC" && break +done + +else + test "x$JAVAC" = x && for ac_prog in "gcj -C" guavac jikes javac +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_JAVAC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$JAVAC"; then + ac_cv_prog_JAVAC="$JAVAC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $JAVAPREFIX/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_JAVAC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +JAVAC=$ac_cv_prog_JAVAC +if test -n "$JAVAC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $JAVAC" >&5 +$as_echo "$JAVAC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$JAVAC" && break +done + +fi + + if test -z "$JAVAC" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: No JAVA compiler. Disabling build of Java interface." >&5 +$as_echo "$as_me: No JAVA compiler. Disabling build of Java interface." >&6;} + enable_java=no + else + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $JAVAC works" >&5 +$as_echo_n "checking if $JAVAC works... " >&6; } +if ${ac_cv_prog_javac_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + +JAVA_TEST=Test.java +CLASS_TEST=Test.class +cat << \EOF > $JAVA_TEST +/* #line 24906 "configure" */ +public class Test { +} +EOF +if { ac_try='$JAVAC $JAVACFLAGS $JAVA_TEST' + { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5 + (eval $ac_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; } >/dev/null 2>&1; then + ac_cv_prog_javac_works=yes +else + as_fn_error $? "The Java compiler $JAVAC failed (see config.log, check the CLASSPATH?)" "$LINENO" 5 + echo "configure: failed program was:" >&5 + cat $JAVA_TEST >&5 +fi +rm -f $JAVA_TEST $CLASS_TEST + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_javac_works" >&5 +$as_echo "$ac_cv_prog_javac_works" >&6; } + + fi +fi + +if test "$enable_java" != no ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if javac supports -h" >&5 +$as_echo_n "checking if javac supports -h... " >&6; } + echo "public abstract class conftest { private native boolean test(); }" > conftest.java + $as_echo "$as_me:${as_lineno-$LINENO}: $JAVAC conftest.java -h conftest.header" >&5 + "$JAVAC" conftest.java -h conftest.header >&5 + if test -e conftest.header/conftest.h ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + echo "configure: failed program was:" >&5 + cat conftest.java >&5 + enable_java=no + fi +fi + +if test "$enable_java" != no ; then + # look for jni header: required to compile C++ part of Java interface + + + + +JNI_INCLUDE_DIRS="" + +if test "x$JAVA_HOME" != x; then + _JTOPDIR="$JAVA_HOME" +else + if test "x$JAVAC" = x; then + JAVAC=javac + fi + # Extract the first word of "$JAVAC", so it can be a program name with args. +set dummy $JAVAC; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path__ACJNI_JAVAC+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $_ACJNI_JAVAC in + [\\/]* | ?:[\\/]*) + ac_cv_path__ACJNI_JAVAC="$_ACJNI_JAVAC" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path__ACJNI_JAVAC="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path__ACJNI_JAVAC" && ac_cv_path__ACJNI_JAVAC="no" + ;; +esac +fi +_ACJNI_JAVAC=$ac_cv_path__ACJNI_JAVAC +if test -n "$_ACJNI_JAVAC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $_ACJNI_JAVAC" >&5 +$as_echo "$_ACJNI_JAVAC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + if test "x$_ACJNI_JAVAC" = xno; then + as_fn_error $? "cannot find JDK; try setting \$JAVAC or \$JAVA_HOME" "$LINENO" 5 + fi + +# find the include directory relative to the javac executable +_cur=""$_ACJNI_JAVAC"" +while ls -ld "$_cur" 2>/dev/null | grep " -> " >/dev/null; do + { $as_echo "$as_me:${as_lineno-$LINENO}: checking symlink for $_cur" >&5 +$as_echo_n "checking symlink for $_cur... " >&6; } + _slink=`ls -ld "$_cur" | sed 's/.* -> //'` + case "$_slink" in + /*) _cur="$_slink";; + # 'X' avoids triggering unwanted echo options. + *) _cur=`echo "X$_cur" | sed -e 's/^X//' -e 's:[^/]*$::'`"$_slink";; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $_cur" >&5 +$as_echo "$_cur" >&6; } +done +_ACJNI_FOLLOWED="$_cur" + + _JTOPDIR=`echo "$_ACJNI_FOLLOWED" | sed -e 's://*:/:g' -e 's:/[^/]*$::'` +fi + +case "$host_os" in + darwin*) # Apple Java headers are inside the Xcode bundle. + macos_version=$(sw_vers -productVersion | sed -n -e 's/^[0-9]*.\([0-9]*\).[0-9]*/\1/p') + if [ "$macos_version" -gt "7" ]; then + _JTOPDIR="$(xcrun --show-sdk-path)/System/Library/Frameworks/JavaVM.framework" + _JINC="$_JTOPDIR/Headers" + else + _JTOPDIR="/System/Library/Frameworks/JavaVM.framework" + _JINC="$_JTOPDIR/Headers" + fi + ;; + *) _JINC="$_JTOPDIR/include";; +esac +$as_echo "$as_me:${as_lineno-$LINENO}: _JTOPDIR=$_JTOPDIR" >&5 +$as_echo "$as_me:${as_lineno-$LINENO}: _JINC=$_JINC" >&5 + +# On Mac OS X 10.6.4, jni.h is a symlink: +# /System/Library/Frameworks/JavaVM.framework/Versions/Current/Headers/jni.h +# -> ../../CurrentJDK/Headers/jni.h. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking jni headers" >&5 +$as_echo_n "checking jni headers... " >&6; } +if ${ac_cv_jni_header_path+:} false; then : + $as_echo_n "(cached) " >&6 +else + + if test -f "$_JINC/jni.h"; then + ac_cv_jni_header_path="$_JINC" + JNI_INCLUDE_DIRS="$JNI_INCLUDE_DIRS $ac_cv_jni_header_path" + else + _JTOPDIR=`echo "$_JTOPDIR" | sed -e 's:/[^/]*$::'` + if test -f "$_JTOPDIR/include/jni.h"; then + ac_cv_jni_header_path="$_JTOPDIR/include" + JNI_INCLUDE_DIRS="$JNI_INCLUDE_DIRS $ac_cv_jni_header_path" + else + ac_cv_jni_header_path=none + fi + fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_jni_header_path" >&5 +$as_echo "$ac_cv_jni_header_path" >&6; } + +# get the likely subdirectories for system specific java includes +case "$host_os" in +bsdi*) _JNI_INC_SUBDIRS="bsdos";; +freebsd*) _JNI_INC_SUBDIRS="freebsd";; +darwin*) _JNI_INC_SUBDIRS="darwin";; +linux*) _JNI_INC_SUBDIRS="linux genunix";; +osf*) _JNI_INC_SUBDIRS="alpha";; +solaris*) _JNI_INC_SUBDIRS="solaris";; +mingw*) _JNI_INC_SUBDIRS="win32";; +cygwin*) _JNI_INC_SUBDIRS="win32";; +*) _JNI_INC_SUBDIRS="genunix";; +esac + +if test "x$ac_cv_jni_header_path" != "xnone"; then + # add any subdirectories that are present + for JINCSUBDIR in $_JNI_INC_SUBDIRS + do + if test -d "$_JTOPDIR/include/$JINCSUBDIR"; then + JNI_INCLUDE_DIRS="$JNI_INCLUDE_DIRS $_JTOPDIR/include/$JINCSUBDIR" + fi + done +fi + + if test -z "$JNI_INCLUDE_DIRS" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: No JNI header directory. Disabling build of Java interface." >&5 +$as_echo "$as_me: No JNI header directory. Disabling build of Java interface." >&6;} + enable_java=no + else + for JNI_INCLUDE_DIR in $JNI_INCLUDE_DIRS ; do + CPPFLAGS="$CPPFLAGS -I$JNI_INCLUDE_DIR" + done + fi +fi + +if test "$enable_java" != no ; then + # the following macros can make configure stop with an error + # we could work around that, but having javac and no jar, java, or javadoc would be odd anyway + + # look for jar: required to pack Java interface + +if test "x$JAVAPREFIX" = x; then : + test "x$JAR" = x && for ac_prog in jar +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_JAR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$JAR"; then + ac_cv_prog_JAR="$JAR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_JAR="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +JAR=$ac_cv_prog_JAR +if test -n "$JAR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $JAR" >&5 +$as_echo "$JAR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$JAR" && break +done + +else + test "x$JAR" = x && for ac_prog in jar +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_JAR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$JAR"; then + ac_cv_prog_JAR="$JAR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $JAVAPREFIX/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_JAR="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +JAR=$ac_cv_prog_JAR +if test -n "$JAR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $JAR" >&5 +$as_echo "$JAR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$JAR" && break +done + +fi +test "x$JAR" = x && as_fn_error $? "no acceptable jar program found in \$PATH" "$LINENO" 5 + + # look for more java to run tests and examples and do documentation + +if test "x$JAVAPREFIX" = x; then : + test x$JAVA = x && for ac_prog in kaffe java +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_JAVA+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$JAVA"; then + ac_cv_prog_JAVA="$JAVA" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_JAVA="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +JAVA=$ac_cv_prog_JAVA +if test -n "$JAVA"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $JAVA" >&5 +$as_echo "$JAVA" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$JAVA" && break +done + +else + test x$JAVA = x && for ac_prog in kaffe java +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_JAVA+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$JAVA"; then + ac_cv_prog_JAVA="$JAVA" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $JAVAPREFIX/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_JAVA="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +JAVA=$ac_cv_prog_JAVA +if test -n "$JAVA"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $JAVA" >&5 +$as_echo "$JAVA" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$JAVA" && break +done + +fi +test x$JAVA = x && as_fn_error $? "no acceptable Java virtual machine found in \$PATH" "$LINENO" 5 + + if test x$ac_cv_prog_javac_works = xno; then + as_fn_error $? "Cannot compile java source. $JAVAC does not work properly" "$LINENO" 5 + fi + if test x$ac_cv_prog_javac_works = x; then + +if test "x$JAVAPREFIX" = x; then : + test "x$JAVAC" = x && for ac_prog in "gcj -C" guavac jikes javac +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_JAVAC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$JAVAC"; then + ac_cv_prog_JAVAC="$JAVAC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_JAVAC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +JAVAC=$ac_cv_prog_JAVAC +if test -n "$JAVAC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $JAVAC" >&5 +$as_echo "$JAVAC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$JAVAC" && break +done + +else + test "x$JAVAC" = x && for ac_prog in "gcj -C" guavac jikes javac +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_JAVAC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$JAVAC"; then + ac_cv_prog_JAVAC="$JAVAC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $JAVAPREFIX/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_JAVAC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +JAVAC=$ac_cv_prog_JAVAC +if test -n "$JAVAC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $JAVAC" >&5 +$as_echo "$JAVAC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$JAVAC" && break +done + +fi +test "x$JAVAC" = x && as_fn_error $? "no acceptable Java compiler found in \$PATH" "$LINENO" 5 + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $JAVAC works" >&5 +$as_echo_n "checking if $JAVAC works... " >&6; } +if ${ac_cv_prog_javac_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + +JAVA_TEST=Test.java +CLASS_TEST=Test.class +cat << \EOF > $JAVA_TEST +/* #line 25392 "configure" */ +public class Test { +} +EOF +if { ac_try='$JAVAC $JAVACFLAGS $JAVA_TEST' + { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5 + (eval $ac_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; } >/dev/null 2>&1; then + ac_cv_prog_javac_works=yes +else + as_fn_error $? "The Java compiler $JAVAC failed (see config.log, check the CLASSPATH?)" "$LINENO" 5 + echo "configure: failed program was:" >&5 + cat $JAVA_TEST >&5 +fi +rm -f $JAVA_TEST $CLASS_TEST + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_javac_works" >&5 +$as_echo "$ac_cv_prog_javac_works" >&6; } + + + fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $JAVA works" >&5 +$as_echo_n "checking if $JAVA works... " >&6; } +if ${ac_cv_prog_java_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + +JAVA_TEST=Test.java +CLASS_TEST=Test.class +TEST=Test +cat << \EOF > $JAVA_TEST +/* [#]line 25426 "configure" */ +public class Test { +public static void main (String args[]) { + System.exit (0); +} } +EOF + if { ac_try='$JAVAC $JAVACFLAGS $JAVA_TEST' + { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5 + (eval $ac_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; } && test -s $CLASS_TEST; then + : + else + echo "configure: failed program was:" >&5 + cat $JAVA_TEST >&5 + as_fn_error $? "The Java compiler $JAVAC failed (see config.log, check the CLASSPATH?)" "$LINENO" 5 + fi +if { ac_try='$JAVA -classpath . $JAVAFLAGS $TEST' + { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5 + (eval $ac_try) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; } >/dev/null 2>&1; then + ac_cv_prog_java_works=yes +else + echo "configure: failed program was:" >&5 + cat $JAVA_TEST >&5 + as_fn_error $? "The Java VM $JAVA failed (see config.log, check the CLASSPATH?)" "$LINENO" 5 +fi +rm -f $JAVA_TEST $CLASS_TEST + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_java_works" >&5 +$as_echo "$ac_cv_prog_java_works" >&6; } + + + + +if test "x$JAVAPREFIX" = x; then : + test "x$JAVADOC" = x && for ac_prog in javadoc +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_JAVADOC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$JAVADOC"; then + ac_cv_prog_JAVADOC="$JAVADOC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_JAVADOC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +JAVADOC=$ac_cv_prog_JAVADOC +if test -n "$JAVADOC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $JAVADOC" >&5 +$as_echo "$JAVADOC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$JAVADOC" && break +done + +else + test "x$JAVADOC" = x && for ac_prog in javadoc +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_JAVADOC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$JAVADOC"; then + ac_cv_prog_JAVADOC="$JAVADOC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $JAVAPREFIX/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_JAVADOC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +JAVADOC=$ac_cv_prog_JAVADOC +if test -n "$JAVADOC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $JAVADOC" >&5 +$as_echo "$JAVADOC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$JAVADOC" && break +done + +fi +test "x$JAVADOC" = x && as_fn_error $? "no acceptable javadoc generator found in \$PATH" "$LINENO" 5 + +fi + + if test "$enable_java" != no; then + BUILD_JAVA_TRUE= + BUILD_JAVA_FALSE='#' +else + BUILD_JAVA_TRUE='#' + BUILD_JAVA_FALSE= +fi + + +######################### +# Makefile conditionals # +######################### + +# The following variable collects the names of libraries that should +# be included into libipopt.a (relative to subdir Interfaces, where it +# is made) + + +IPALLLIBS="../contrib/CGPenalty/libcgpenalty.la ../Algorithm/libipoptalg.la ../Algorithm/LinearSolvers/liblinsolvers.la ../Common/libcommon.la ../LinAlg/liblinalg.la ../LinAlg/TMatrices/libtmatrices.la" + + if test $use_inexact = yes; then + BUILD_INEXACT_TRUE= + BUILD_INEXACT_FALSE='#' +else + BUILD_INEXACT_TRUE='#' + BUILD_INEXACT_FALSE= +fi + +if test $use_inexact = yes; then + IPALLLIBS="../Algorithm/Inexact/libinexact.la $IPALLLIBS" +fi + +######################################################################## +## Linear solver loader ## +######################################################################## + +# Check whether --enable-linear-solver-loader was given. +if test "${enable_linear_solver_loader+set}" = set; then : + enableval=$enable_linear_solver_loader; case "$enableval" in + no | yes) ;; + *) + as_fn_error $? "invalid argument for --enable-linear-solver-loader: $enableval" "$LINENO" 5;; + esac + use_linearsolverloader=$enableval +else + use_linearsolverloader=yes +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the linear solver loader should be compiled" >&5 +$as_echo_n "checking whether the linear solver loader should be compiled... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $use_linearsolverloader" >&5 +$as_echo "$use_linearsolverloader" >&6; } + +if test $use_linearsolverloader = yes; then + +$as_echo "#define IPOPT_HAS_LINEARSOLVERLOADER 1" >>confdefs.h + + IPALLLIBS="../contrib/LinearSolverLoader/libLinearSolverLoader.la $IPALLLIBS" +fi + + if test $use_linearsolverloader = yes; then + BUILD_LINEARSOLVERLOADER_TRUE= + BUILD_LINEARSOLVERLOADER_FALSE='#' +else + BUILD_LINEARSOLVERLOADER_TRUE='#' + BUILD_LINEARSOLVERLOADER_FALSE= +fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +ac_fn_c_check_header_mongrel "$LINENO" "windows.h" "ac_cv_header_windows_h" "$ac_includes_default" +if test "x$ac_cv_header_windows_h" = xyes; then : + +$as_echo "#define HAVE_WINDOWS_H 1" >>confdefs.h + +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +$as_echo_n "checking for dlopen in -ldl... " >&6; } +if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +#ifdef F77_DUMMY_MAIN + +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } + +#endif +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dl_dlopen=yes +else + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +$as_echo "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = xyes; then : + IPOPTLIB_LFLAGS="$IPOPTLIB_LFLAGS -ldl" +fi + +for ac_func in snprintf _snprintf +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + break +fi +done + +for ac_func in vsnprintf _vsnprintf +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + break +fi +done + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +######################################################################## +## sIpopt ## +######################################################################## + +# Check whether --enable-sipopt was given. +if test "${enable_sipopt+set}" = set; then : + enableval=$enable_sipopt; case "$enableval" in + no | yes) ;; + *) + as_fn_error $? "invalid argument for --enable-sipopt: $enableval" "$LINENO" 5;; + esac + use_sipopt=$enableval +else + use_sipopt=yes +fi + + if test "$use_sipopt" = yes; then + BUILD_SIPOPT_TRUE= + BUILD_SIPOPT_FALSE='#' +else + BUILD_SIPOPT_TRUE='#' + BUILD_SIPOPT_FALSE= +fi + + +######################################################################## +## Create links for the test source files ## +######################################################################## + +ac_config_links="$ac_config_links test/hs071_main.cpp:examples/hs071_cpp/hs071_main.cpp test/hs071_nlp.cpp:examples/hs071_cpp/hs071_nlp.cpp test/hs071_nlp.hpp:examples/hs071_cpp/hs071_nlp.hpp test/hs071_c.c:examples/hs071_c/hs071_c.c" + + +if test "$use_sipopt" = yes ; then +ac_config_links="$ac_config_links test/parametric_driver.cpp:contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp test/parametricTNLP.cpp:contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp test/MySensTNLP.cpp:contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp test/redhess_cpp.cpp:contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp" + +fi + +######################################################################## +## Create links for VPATH config of certain files ## +######################################################################## + + + ac_config_links="$ac_config_links contrib/RInterface/DESCRIPTION:contrib/RInterface/DESCRIPTION" + + + + ac_config_links="$ac_config_links contrib/RInterface/NAMESPACE:contrib/RInterface/NAMESPACE" + + + + ac_config_links="$ac_config_links contrib/RInterface/inst/CITATION:contrib/RInterface/inst/CITATION" + + + + ac_config_links="$ac_config_links contrib/RInterface/inst/doc/ipoptr.Rnw:contrib/RInterface/inst/doc/ipoptr.Rnw" + + + + ac_config_links="$ac_config_links contrib/RInterface/inst/doc/ipoptr.pdf:contrib/RInterface/inst/doc/ipoptr.pdf" + + + + ac_config_links="$ac_config_links contrib/RInterface/inst/doc/reflist.bib:contrib/RInterface/inst/doc/reflist.bib" + + + + ac_config_links="$ac_config_links contrib/RInterface/man/ipoptr-package.Rd:contrib/RInterface/man/ipoptr-package.Rd" + + + + ac_config_links="$ac_config_links contrib/RInterface/man/ipoptr.Rd:contrib/RInterface/man/ipoptr.Rd" + + + + ac_config_links="$ac_config_links contrib/RInterface/man/is.ipoptr.Rd:contrib/RInterface/man/is.ipoptr.Rd" + + + + ac_config_links="$ac_config_links contrib/RInterface/man/make.sparse.Rd:contrib/RInterface/man/make.sparse.Rd" + + + + ac_config_links="$ac_config_links contrib/RInterface/man/plot.sparseness.Rd:contrib/RInterface/man/plot.sparseness.Rd" + + + + ac_config_links="$ac_config_links contrib/RInterface/man/print.ipoptr.Rd:contrib/RInterface/man/print.ipoptr.Rd" + + + + ac_config_links="$ac_config_links contrib/RInterface/man/print.sparseness.Rd:contrib/RInterface/man/print.sparseness.Rd" + + + + ac_config_links="$ac_config_links contrib/RInterface/R/get.option.types.R:contrib/RInterface/R/get.option.types.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/R/ipoptr.R:contrib/RInterface/R/ipoptr.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/R/is.ipoptr.R:contrib/RInterface/R/is.ipoptr.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/R/make.sparse.R:contrib/RInterface/R/make.sparse.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/R/plot.sparseness.R:contrib/RInterface/R/plot.sparseness.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/R/print.ipoptr.R:contrib/RInterface/R/print.ipoptr.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/R/print.sparseness.R:contrib/RInterface/R/print.sparseness.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/tests/approx_banana.R:contrib/RInterface/tests/approx_banana.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/tests/banana.R:contrib/RInterface/tests/banana.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/tests/hs071_nlp.R:contrib/RInterface/tests/hs071_nlp.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/tests/lasso.R:contrib/RInterface/tests/lasso.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/tests/mynlp.R:contrib/RInterface/tests/mynlp.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/tests/parameters.R:contrib/RInterface/tests/parameters.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/tests/sparseness.R:contrib/RInterface/tests/sparseness.R" + + + + ac_config_links="$ac_config_links contrib/RInterface/src/ipoptr.cpp:contrib/RInterface/src/ipoptr.cpp" + + + + ac_config_links="$ac_config_links contrib/RInterface/src/IpoptRJournal.cpp:contrib/RInterface/src/IpoptRJournal.cpp" + + + + ac_config_links="$ac_config_links contrib/RInterface/src/IpoptRNLP.cpp:contrib/RInterface/src/IpoptRNLP.cpp" + + + + + ac_config_links="$ac_config_links examples/Cpp_example/cpp_example.cpp:examples/Cpp_example/cpp_example.cpp" + + + + ac_config_links="$ac_config_links examples/Cpp_example/MyNLP.cpp:examples/Cpp_example/MyNLP.cpp" + + + + ac_config_links="$ac_config_links examples/Cpp_example/MyNLP.hpp:examples/Cpp_example/MyNLP.hpp" + + + + ac_config_links="$ac_config_links examples/hs071_cpp/hs071_main.cpp:examples/hs071_cpp/hs071_main.cpp" + + + + ac_config_links="$ac_config_links examples/hs071_cpp/hs071_nlp.cpp:examples/hs071_cpp/hs071_nlp.cpp" + + + + ac_config_links="$ac_config_links examples/hs071_cpp/hs071_nlp.hpp:examples/hs071_cpp/hs071_nlp.hpp" + + + + ac_config_links="$ac_config_links examples/hs071_c/hs071_c.c:examples/hs071_c/hs071_c.c" + + +if test "$enable_java" != no ; then + + ac_config_links="$ac_config_links examples/hs071_java/HS071.java:examples/hs071_java/HS071.java" + + +fi + + + ac_config_links="$ac_config_links tutorial/AmplExperiments/hs71.mod:tutorial/AmplExperiments/hs71.mod" + + + + ac_config_links="$ac_config_links tutorial/AmplExperiments/infeasible.mod:tutorial/AmplExperiments/infeasible.mod" + + + + ac_config_links="$ac_config_links tutorial/AmplExperiments/MoreAmplModels.txt:tutorial/AmplExperiments/MoreAmplModels.txt" + + + + ac_config_links="$ac_config_links tutorial/AmplExperiments/car1.run:tutorial/AmplExperiments/car1.run" + + + + ac_config_links="$ac_config_links tutorial/AmplExperiments/car1.gp:tutorial/AmplExperiments/car1.gp" + + + + + ac_config_links="$ac_config_links tutorial/Modeling/bad1.mod:tutorial/Modeling/bad1.mod" + + + + ac_config_links="$ac_config_links tutorial/Modeling/bad1-fix1.mod:tutorial/Modeling/bad1-fix1.mod" + + + + ac_config_links="$ac_config_links tutorial/Modeling/bad1-fix2.mod:tutorial/Modeling/bad1-fix2.mod" + + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/exercise_example.mod:tutorial/CodingExercise/exercise_example.mod" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/C/1-skeleton/TutorialC.c:tutorial/CodingExercise/C/1-skeleton/TutorialC.c" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/C/2-mistake/TutorialC.c:tutorial/CodingExercise/C/2-mistake/TutorialC.c" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/C/3-solution/TutorialC.c:tutorial/CodingExercise/C/3-solution/TutorialC.c" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_main.cpp:tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_main.cpp" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.hpp:tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.hpp" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.cpp:tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.cpp" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_main.cpp:tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_main.cpp" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.hpp:tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.hpp" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.cpp:tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.cpp" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_main.cpp:tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_main.cpp" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.hpp:tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.hpp" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.cpp:tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.cpp" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/Matlab/1-skeleton/TutorialMatlab.m:tutorial/CodingExercise/Matlab/1-skeleton/TutorialMatlab.m" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/Matlab/2-mistake/TutorialMatlab.m:tutorial/CodingExercise/Matlab/2-mistake/TutorialMatlab.m" + + + + ac_config_links="$ac_config_links tutorial/CodingExercise/Matlab/3-solution/TutorialMatlab.m:tutorial/CodingExercise/Matlab/3-solution/TutorialMatlab.m" + + + +if test "$use_sipopt" = yes ; then + + ac_config_links="$ac_config_links contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp:contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp" + + + + ac_config_links="$ac_config_links contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp:contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp" + + + + ac_config_links="$ac_config_links contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.hpp:contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.hpp" + + + + ac_config_links="$ac_config_links contrib/sIPOPT/examples/parametric_dsdp_cpp/parametric_dsdp_driver.cpp:contrib/sIPOPT/examples/parametric_dsdp_cpp/parametric_dsdp_driver.cpp" + + + + ac_config_links="$ac_config_links contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.cpp:contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.cpp" + + + + ac_config_links="$ac_config_links contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.hpp:contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.hpp" + + + + ac_config_links="$ac_config_links contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp:contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp" + + + + ac_config_links="$ac_config_links contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.hpp:contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.hpp" + + + + ac_config_links="$ac_config_links contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp:contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp" + + +fi + +######################################################################## +## Create Makefiles and other stuff ## +######################################################################## + + + if test "$BUILDTOOLS_DEBUG" = 1 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: FINALIZE_FLAGS for IpoptLib:" >&5 +$as_echo "$as_me: FINALIZE_FLAGS for IpoptLib:" >&6;} + fi + IPOPTLIB_LFLAGS_NOPC=$IPOPTLIB_LFLAGS + + IPOPTLIB_CFLAGS_NOPC=$IPOPTLIB_CFLAGS + + if test -n "${IPOPTLIB_PCFILES}" ; then + temp_CFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --cflags ${IPOPTLIB_PCFILES}` + temp_LFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --libs $pkg_static ${IPOPTLIB_PCFILES}` + IPOPTLIB_CFLAGS="$temp_CFLAGS ${IPOPTLIB_CFLAGS}" + IPOPTLIB_LFLAGS="$temp_LFLAGS ${IPOPTLIB_LFLAGS}" + fi + + # setup XYZ_EXPORT symbol for library users + libexport_attribute= + if test "$enable_shared" = yes ; then + case $build_os in + cygwin* | mingw* | msys* | cegcc* ) + libexport_attribute="__declspec(dllimport)" + if test "$enable_static" = yes ; then + as_fn_error $? "Cannot do DLL and static LIB builds simultaneously. Do not add --enable-static without --disable-shared." "$LINENO" 5 + fi + ;; + esac + fi + +cat >>confdefs.h <<_ACEOF +#define IPOPTLIB_EXPORT $libexport_attribute +_ACEOF + + + # add -DXYZ_BUILD to XYZ_CFLAGS + IPOPTLIB_CFLAGS="${IPOPTLIB_CFLAGS} -DIPOPTLIB_BUILD" + + # Define BUILDTOOLS_DEBUG to enable debugging output + if test "$BUILDTOOLS_DEBUG" = 1 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: IPOPTLIB_LFLAGS_NOPC: \"${IPOPTLIB_LFLAGS_NOPC}\"" >&5 +$as_echo "$as_me: IPOPTLIB_LFLAGS_NOPC: \"${IPOPTLIB_LFLAGS_NOPC}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: IPOPTLIB_CFLAGS_NOPC: \"${IPOPTLIB_CFLAGS_NOPC}\"" >&5 +$as_echo "$as_me: IPOPTLIB_CFLAGS_NOPC: \"${IPOPTLIB_CFLAGS_NOPC}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: adding \"${IPOPTLIB_PCFILES}\"" >&5 +$as_echo "$as_me: adding \"${IPOPTLIB_PCFILES}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: IPOPTLIB_LFLAGS: \"${IPOPTLIB_LFLAGS}\"" >&5 +$as_echo "$as_me: IPOPTLIB_LFLAGS: \"${IPOPTLIB_LFLAGS}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: IPOPTLIB_CFLAGS: \"${IPOPTLIB_CFLAGS}\"" >&5 +$as_echo "$as_me: IPOPTLIB_CFLAGS: \"${IPOPTLIB_CFLAGS}\"" >&6;} + fi + if test "$BUILDTOOLS_DEBUG" = 1 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: FINALIZE_FLAGS for IpoptAmplInterfaceLib:" >&5 +$as_echo "$as_me: FINALIZE_FLAGS for IpoptAmplInterfaceLib:" >&6;} + fi + IPOPTAMPLINTERFACELIB_LFLAGS_NOPC=$IPOPTAMPLINTERFACELIB_LFLAGS + + IPOPTAMPLINTERFACELIB_CFLAGS_NOPC=$IPOPTAMPLINTERFACELIB_CFLAGS + + if test -n "${IPOPTAMPLINTERFACELIB_PCFILES}" ; then + temp_CFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --cflags ${IPOPTAMPLINTERFACELIB_PCFILES}` + temp_LFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --libs $pkg_static ${IPOPTAMPLINTERFACELIB_PCFILES}` + IPOPTAMPLINTERFACELIB_CFLAGS="$temp_CFLAGS ${IPOPTAMPLINTERFACELIB_CFLAGS}" + IPOPTAMPLINTERFACELIB_LFLAGS="$temp_LFLAGS ${IPOPTAMPLINTERFACELIB_LFLAGS}" + fi + + # setup XYZ_EXPORT symbol for library users + libexport_attribute= + if test "$enable_shared" = yes ; then + case $build_os in + cygwin* | mingw* | msys* | cegcc* ) + libexport_attribute="__declspec(dllimport)" + if test "$enable_static" = yes ; then + as_fn_error $? "Cannot do DLL and static LIB builds simultaneously. Do not add --enable-static without --disable-shared." "$LINENO" 5 + fi + ;; + esac + fi + +cat >>confdefs.h <<_ACEOF +#define IPOPTAMPLINTERFACELIB_EXPORT $libexport_attribute +_ACEOF + + + # add -DXYZ_BUILD to XYZ_CFLAGS + IPOPTAMPLINTERFACELIB_CFLAGS="${IPOPTAMPLINTERFACELIB_CFLAGS} -DIPOPTAMPLINTERFACELIB_BUILD" + + # Define BUILDTOOLS_DEBUG to enable debugging output + if test "$BUILDTOOLS_DEBUG" = 1 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: IPOPTAMPLINTERFACELIB_LFLAGS_NOPC: \"${IPOPTAMPLINTERFACELIB_LFLAGS_NOPC}\"" >&5 +$as_echo "$as_me: IPOPTAMPLINTERFACELIB_LFLAGS_NOPC: \"${IPOPTAMPLINTERFACELIB_LFLAGS_NOPC}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: IPOPTAMPLINTERFACELIB_CFLAGS_NOPC: \"${IPOPTAMPLINTERFACELIB_CFLAGS_NOPC}\"" >&5 +$as_echo "$as_me: IPOPTAMPLINTERFACELIB_CFLAGS_NOPC: \"${IPOPTAMPLINTERFACELIB_CFLAGS_NOPC}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: adding \"${IPOPTAMPLINTERFACELIB_PCFILES}\"" >&5 +$as_echo "$as_me: adding \"${IPOPTAMPLINTERFACELIB_PCFILES}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: IPOPTAMPLINTERFACELIB_LFLAGS: \"${IPOPTAMPLINTERFACELIB_LFLAGS}\"" >&5 +$as_echo "$as_me: IPOPTAMPLINTERFACELIB_LFLAGS: \"${IPOPTAMPLINTERFACELIB_LFLAGS}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: IPOPTAMPLINTERFACELIB_CFLAGS: \"${IPOPTAMPLINTERFACELIB_CFLAGS}\"" >&5 +$as_echo "$as_me: IPOPTAMPLINTERFACELIB_CFLAGS: \"${IPOPTAMPLINTERFACELIB_CFLAGS}\"" >&6;} + fi + if test "$BUILDTOOLS_DEBUG" = 1 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: FINALIZE_FLAGS for SIpoptAmplInterfaceLib:" >&5 +$as_echo "$as_me: FINALIZE_FLAGS for SIpoptAmplInterfaceLib:" >&6;} + fi + SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC=$SIPOPTAMPLINTERFACELIB_LFLAGS + + SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC=$SIPOPTAMPLINTERFACELIB_CFLAGS + + if test -n "${SIPOPTAMPLINTERFACELIB_PCFILES}" ; then + temp_CFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --cflags ${SIPOPTAMPLINTERFACELIB_PCFILES}` + temp_LFLAGS=`PKG_CONFIG_PATH="$COIN_PKG_CONFIG_PATH" $PKG_CONFIG --libs $pkg_static ${SIPOPTAMPLINTERFACELIB_PCFILES}` + SIPOPTAMPLINTERFACELIB_CFLAGS="$temp_CFLAGS ${SIPOPTAMPLINTERFACELIB_CFLAGS}" + SIPOPTAMPLINTERFACELIB_LFLAGS="$temp_LFLAGS ${SIPOPTAMPLINTERFACELIB_LFLAGS}" + fi + + # setup XYZ_EXPORT symbol for library users + libexport_attribute= + if test "$enable_shared" = yes ; then + case $build_os in + cygwin* | mingw* | msys* | cegcc* ) + libexport_attribute="__declspec(dllimport)" + if test "$enable_static" = yes ; then + as_fn_error $? "Cannot do DLL and static LIB builds simultaneously. Do not add --enable-static without --disable-shared." "$LINENO" 5 + fi + ;; + esac + fi + +cat >>confdefs.h <<_ACEOF +#define SIPOPTAMPLINTERFACELIB_EXPORT $libexport_attribute +_ACEOF + + + # add -DXYZ_BUILD to XYZ_CFLAGS + SIPOPTAMPLINTERFACELIB_CFLAGS="${SIPOPTAMPLINTERFACELIB_CFLAGS} -DSIPOPTAMPLINTERFACELIB_BUILD" + + # Define BUILDTOOLS_DEBUG to enable debugging output + if test "$BUILDTOOLS_DEBUG" = 1 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC: \"${SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC}\"" >&5 +$as_echo "$as_me: SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC: \"${SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC: \"${SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC}\"" >&5 +$as_echo "$as_me: SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC: \"${SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: adding \"${SIPOPTAMPLINTERFACELIB_PCFILES}\"" >&5 +$as_echo "$as_me: adding \"${SIPOPTAMPLINTERFACELIB_PCFILES}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: SIPOPTAMPLINTERFACELIB_LFLAGS: \"${SIPOPTAMPLINTERFACELIB_LFLAGS}\"" >&5 +$as_echo "$as_me: SIPOPTAMPLINTERFACELIB_LFLAGS: \"${SIPOPTAMPLINTERFACELIB_LFLAGS}\"" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: SIPOPTAMPLINTERFACELIB_CFLAGS: \"${SIPOPTAMPLINTERFACELIB_CFLAGS}\"" >&5 +$as_echo "$as_me: SIPOPTAMPLINTERFACELIB_CFLAGS: \"${SIPOPTAMPLINTERFACELIB_CFLAGS}\"" >&6;} + fi + + + +ac_config_files="$ac_config_files Makefile src/Common/Makefile src/LinAlg/Makefile src/LinAlg/TMatrices/Makefile src/Interfaces/Makefile src/Algorithm/Makefile src/Algorithm/LinearSolvers/Makefile src/Algorithm/Inexact/Makefile src/contrib/CGPenalty/Makefile src/contrib/LinearSolverLoader/Makefile src/Apps/Makefile src/Apps/AmplSolver/Makefile test/Makefile test/run_unitTests ipopt.pc doc/Doxyfile examples/Cpp_example/Makefile examples/recursive_nlp/Makefile examples/hs071_cpp/Makefile examples/hs071_c/Makefile examples/ScalableProblems/Makefile tutorial/CodingExercise/C/1-skeleton/Makefile tutorial/CodingExercise/C/2-mistake/Makefile tutorial/CodingExercise/C/3-solution/Makefile tutorial/CodingExercise/Cpp/1-skeleton/Makefile tutorial/CodingExercise/Cpp/2-mistake/Makefile tutorial/CodingExercise/Cpp/3-solution/Makefile tutorial/CodingExercise/Matlab/1-skeleton/startup.m tutorial/CodingExercise/Matlab/2-mistake/startup.m tutorial/CodingExercise/Matlab/3-solution/startup.m" + + +if test -n "$F77" ; then + ac_config_files="$ac_config_files examples/hs071_f/hs071_f.f examples/hs071_f/Makefile tutorial/CodingExercise/Fortran/1-skeleton/TutorialFortran.f tutorial/CodingExercise/Fortran/2-mistake/TutorialFortran.f tutorial/CodingExercise/Fortran/3-solution/TutorialFortran.f tutorial/CodingExercise/Fortran/1-skeleton/Makefile tutorial/CodingExercise/Fortran/2-mistake/Makefile tutorial/CodingExercise/Fortran/3-solution/Makefile" + +fi + +if test "$enable_java" != no ; then + ac_config_files="$ac_config_files examples/hs071_java/Makefile examples/ScalableProblems_java/Makefile" + +fi + +if test "$use_sipopt" = yes ; then + ac_config_files="$ac_config_files contrib/sIPOPT/Makefile contrib/sIPOPT/src/Makefile contrib/sIPOPT/AmplSolver/Makefile contrib/sIPOPT/examples/parametric_cpp/Makefile contrib/sIPOPT/examples/parametric_dsdp_cpp/Makefile contrib/sIPOPT/examples/redhess_cpp/Makefile" + +fi + + +# under Windows, the Makevars file for the R Interface need to be named Makevars.win +case $build in + *-cygwin* | *-mingw* | *-msys* ) + ac_config_files="$ac_config_files contrib/RInterface/src/Makevars.win:contrib/RInterface/src/Makevars.in" + + ;; + *) + ac_config_files="$ac_config_files contrib/RInterface/src/Makevars" + + ;; +esac + +if test $coin_has_asl = yes ; then + ac_config_files="$ac_config_files ipoptamplinterface.pc:src/Apps/AmplSolver/ipoptamplinterface.pc.in" + +fi + +ac_config_headers="$ac_config_headers src/Common/config.h src/Common/config_ipopt.h" + + + + cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +DEFS=-DHAVE_CONFIG_H + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + +if test -z "${MAINTAINER_MODE_TRUE}" && test -z "${MAINTAINER_MODE_FALSE}"; then + as_fn_error $? "conditional \"MAINTAINER_MODE\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking that generated files are newer than configure" >&5 +$as_echo_n "checking that generated files are newer than configure... " >&6; } + if test -n "$am_sleep_pid"; then + # Hide warnings about reused PIDs. + wait $am_sleep_pid 2>/dev/null + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5 +$as_echo "done" >&6; } + if test -n "$EXEEXT"; then + am__EXEEXT_TRUE= + am__EXEEXT_FALSE='#' +else + am__EXEEXT_TRUE='#' + am__EXEEXT_FALSE= +fi + +if test -z "${COIN_RELOCATABLE_TRUE}" && test -z "${COIN_RELOCATABLE_FALSE}"; then + as_fn_error $? "conditional \"COIN_RELOCATABLE\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${AMDEP_TRUE}" && test -z "${AMDEP_FALSE}"; then + as_fn_error $? "conditional \"AMDEP\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${am__fastdepCC_TRUE}" && test -z "${am__fastdepCC_FALSE}"; then + as_fn_error $? "conditional \"am__fastdepCC\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${am__fastdepCXX_TRUE}" && test -z "${am__fastdepCXX_FALSE}"; then + as_fn_error $? "conditional \"am__fastdepCXX\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${COIN_HAS_F77_TRUE}" && test -z "${COIN_HAS_F77_FALSE}"; then + as_fn_error $? "conditional \"COIN_HAS_F77\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${COIN_STATIC_BUILD_TRUE}" && test -z "${COIN_STATIC_BUILD_FALSE}"; then + as_fn_error $? "conditional \"COIN_STATIC_BUILD\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${COIN_HAS_DOXYGEN_TRUE}" && test -z "${COIN_HAS_DOXYGEN_FALSE}"; then + as_fn_error $? "conditional \"COIN_HAS_DOXYGEN\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${COIN_HAS_LATEX_TRUE}" && test -z "${COIN_HAS_LATEX_FALSE}"; then + as_fn_error $? "conditional \"COIN_HAS_LATEX\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${COIN_HAS_PKGCONFIG_TRUE}" && test -z "${COIN_HAS_PKGCONFIG_FALSE}"; then + as_fn_error $? "conditional \"COIN_HAS_PKGCONFIG\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${IPOPT_HAS_LAPACK_TRUE}" && test -z "${IPOPT_HAS_LAPACK_FALSE}"; then + as_fn_error $? "conditional \"IPOPT_HAS_LAPACK\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${IPOPT_HAS_ASL_TRUE}" && test -z "${IPOPT_HAS_ASL_FALSE}"; then + as_fn_error $? "conditional \"IPOPT_HAS_ASL\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${IPOPT_HAS_MUMPS_TRUE}" && test -z "${IPOPT_HAS_MUMPS_FALSE}"; then + as_fn_error $? "conditional \"IPOPT_HAS_MUMPS\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${IPOPT_HAS_HSL_TRUE}" && test -z "${IPOPT_HAS_HSL_FALSE}"; then + as_fn_error $? "conditional \"IPOPT_HAS_HSL\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${HAVE_MA28_TRUE}" && test -z "${HAVE_MA28_FALSE}"; then + as_fn_error $? "conditional \"HAVE_MA28\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${HAVE_PARDISO_TRUE}" && test -z "${HAVE_PARDISO_FALSE}"; then + as_fn_error $? "conditional \"HAVE_PARDISO\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${HAVE_WSMP_TRUE}" && test -z "${HAVE_WSMP_FALSE}"; then + as_fn_error $? "conditional \"HAVE_WSMP\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_INEXACT_TRUE}" && test -z "${BUILD_INEXACT_FALSE}"; then + as_fn_error $? "conditional \"BUILD_INEXACT\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_JAVA_TRUE}" && test -z "${BUILD_JAVA_FALSE}"; then + as_fn_error $? "conditional \"BUILD_JAVA\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_INEXACT_TRUE}" && test -z "${BUILD_INEXACT_FALSE}"; then + as_fn_error $? "conditional \"BUILD_INEXACT\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_LINEARSOLVERLOADER_TRUE}" && test -z "${BUILD_LINEARSOLVERLOADER_FALSE}"; then + as_fn_error $? "conditional \"BUILD_LINEARSOLVERLOADER\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${BUILD_SIPOPT_TRUE}" && test -z "${BUILD_SIPOPT_FALSE}"; then + as_fn_error $? "conditional \"BUILD_SIPOPT\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by Ipopt $as_me 3.13.5, which was +generated by GNU Autoconf 2.69. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + +case $ac_config_headers in *" +"*) set x $ac_config_headers; shift; ac_config_headers=$*;; +esac + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" +config_headers="$ac_config_headers" +config_links="$ac_config_links" +config_commands="$ac_config_commands" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + --header=FILE[:TEMPLATE] + instantiate the configuration header FILE + +Configuration files: +$config_files + +Configuration headers: +$config_headers + +Configuration links: +$config_links + +Configuration commands: +$config_commands + +Report bugs to . +Ipopt home page: ." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +Ipopt config.status 3.13.5 +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +INSTALL='$INSTALL' +MKDIR_P='$MKDIR_P' +AWK='$AWK' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append CONFIG_HEADERS " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h) + # Conflict between --help and --header + as_fn_error $? "ambiguous option: \`$1' +Try \`$0 --help' for more information.";; + --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# +# INIT-COMMANDS +# +AMDEP_TRUE="$AMDEP_TRUE" MAKE="${MAKE-make}" + + +# The HP-UX ksh and POSIX shell print the target directory to stdout +# if CDPATH is set. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +sed_quote_subst='$sed_quote_subst' +double_quote_subst='$double_quote_subst' +delay_variable_subst='$delay_variable_subst' +macro_version='`$ECHO "$macro_version" | $SED "$delay_single_quote_subst"`' +macro_revision='`$ECHO "$macro_revision" | $SED "$delay_single_quote_subst"`' +enable_static='`$ECHO "$enable_static" | $SED "$delay_single_quote_subst"`' +pic_mode='`$ECHO "$pic_mode" | $SED "$delay_single_quote_subst"`' +AS='`$ECHO "$AS" | $SED "$delay_single_quote_subst"`' +DLLTOOL='`$ECHO "$DLLTOOL" | $SED "$delay_single_quote_subst"`' +OBJDUMP='`$ECHO "$OBJDUMP" | $SED "$delay_single_quote_subst"`' +enable_shared='`$ECHO "$enable_shared" | $SED "$delay_single_quote_subst"`' +enable_fast_install='`$ECHO "$enable_fast_install" | $SED "$delay_single_quote_subst"`' +shared_archive_member_spec='`$ECHO "$shared_archive_member_spec" | $SED "$delay_single_quote_subst"`' +SHELL='`$ECHO "$SHELL" | $SED "$delay_single_quote_subst"`' +ECHO='`$ECHO "$ECHO" | $SED "$delay_single_quote_subst"`' +PATH_SEPARATOR='`$ECHO "$PATH_SEPARATOR" | $SED "$delay_single_quote_subst"`' +host_alias='`$ECHO "$host_alias" | $SED "$delay_single_quote_subst"`' +host='`$ECHO "$host" | $SED "$delay_single_quote_subst"`' +host_os='`$ECHO "$host_os" | $SED "$delay_single_quote_subst"`' +build_alias='`$ECHO "$build_alias" | $SED "$delay_single_quote_subst"`' +build='`$ECHO "$build" | $SED "$delay_single_quote_subst"`' +build_os='`$ECHO "$build_os" | $SED "$delay_single_quote_subst"`' +SED='`$ECHO "$SED" | $SED "$delay_single_quote_subst"`' +Xsed='`$ECHO "$Xsed" | $SED "$delay_single_quote_subst"`' +GREP='`$ECHO "$GREP" | $SED "$delay_single_quote_subst"`' +EGREP='`$ECHO "$EGREP" | $SED "$delay_single_quote_subst"`' +FGREP='`$ECHO "$FGREP" | $SED "$delay_single_quote_subst"`' +LD='`$ECHO "$LD" | $SED "$delay_single_quote_subst"`' +NM='`$ECHO "$NM" | $SED "$delay_single_quote_subst"`' +LN_S='`$ECHO "$LN_S" | $SED "$delay_single_quote_subst"`' +max_cmd_len='`$ECHO "$max_cmd_len" | $SED "$delay_single_quote_subst"`' +ac_objext='`$ECHO "$ac_objext" | $SED "$delay_single_quote_subst"`' +exeext='`$ECHO "$exeext" | $SED "$delay_single_quote_subst"`' +lt_unset='`$ECHO "$lt_unset" | $SED "$delay_single_quote_subst"`' +lt_SP2NL='`$ECHO "$lt_SP2NL" | $SED "$delay_single_quote_subst"`' +lt_NL2SP='`$ECHO "$lt_NL2SP" | $SED "$delay_single_quote_subst"`' +lt_cv_to_host_file_cmd='`$ECHO "$lt_cv_to_host_file_cmd" | $SED "$delay_single_quote_subst"`' +lt_cv_to_tool_file_cmd='`$ECHO "$lt_cv_to_tool_file_cmd" | $SED "$delay_single_quote_subst"`' +reload_flag='`$ECHO "$reload_flag" | $SED "$delay_single_quote_subst"`' +reload_cmds='`$ECHO "$reload_cmds" | $SED "$delay_single_quote_subst"`' +deplibs_check_method='`$ECHO "$deplibs_check_method" | $SED "$delay_single_quote_subst"`' +file_magic_cmd='`$ECHO "$file_magic_cmd" | $SED "$delay_single_quote_subst"`' +file_magic_glob='`$ECHO "$file_magic_glob" | $SED "$delay_single_quote_subst"`' +want_nocaseglob='`$ECHO "$want_nocaseglob" | $SED "$delay_single_quote_subst"`' +sharedlib_from_linklib_cmd='`$ECHO "$sharedlib_from_linklib_cmd" | $SED "$delay_single_quote_subst"`' +AR='`$ECHO "$AR" | $SED "$delay_single_quote_subst"`' +AR_FLAGS='`$ECHO "$AR_FLAGS" | $SED "$delay_single_quote_subst"`' +archiver_list_spec='`$ECHO "$archiver_list_spec" | $SED "$delay_single_quote_subst"`' +STRIP='`$ECHO "$STRIP" | $SED "$delay_single_quote_subst"`' +RANLIB='`$ECHO "$RANLIB" | $SED "$delay_single_quote_subst"`' +old_postinstall_cmds='`$ECHO "$old_postinstall_cmds" | $SED "$delay_single_quote_subst"`' +old_postuninstall_cmds='`$ECHO "$old_postuninstall_cmds" | $SED "$delay_single_quote_subst"`' +old_archive_cmds='`$ECHO "$old_archive_cmds" | $SED "$delay_single_quote_subst"`' +lock_old_archive_extraction='`$ECHO "$lock_old_archive_extraction" | $SED "$delay_single_quote_subst"`' +CC='`$ECHO "$CC" | $SED "$delay_single_quote_subst"`' +CFLAGS='`$ECHO "$CFLAGS" | $SED "$delay_single_quote_subst"`' +compiler='`$ECHO "$compiler" | $SED "$delay_single_quote_subst"`' +GCC='`$ECHO "$GCC" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_pipe='`$ECHO "$lt_cv_sys_global_symbol_pipe" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_cdecl='`$ECHO "$lt_cv_sys_global_symbol_to_cdecl" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_import='`$ECHO "$lt_cv_sys_global_symbol_to_import" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_c_name_address='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_c_name_address_lib_prefix='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address_lib_prefix" | $SED "$delay_single_quote_subst"`' +lt_cv_nm_interface='`$ECHO "$lt_cv_nm_interface" | $SED "$delay_single_quote_subst"`' +nm_file_list_spec='`$ECHO "$nm_file_list_spec" | $SED "$delay_single_quote_subst"`' +lt_sysroot='`$ECHO "$lt_sysroot" | $SED "$delay_single_quote_subst"`' +lt_cv_truncate_bin='`$ECHO "$lt_cv_truncate_bin" | $SED "$delay_single_quote_subst"`' +objdir='`$ECHO "$objdir" | $SED "$delay_single_quote_subst"`' +MAGIC_CMD='`$ECHO "$MAGIC_CMD" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_no_builtin_flag='`$ECHO "$lt_prog_compiler_no_builtin_flag" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_pic='`$ECHO "$lt_prog_compiler_pic" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_wl='`$ECHO "$lt_prog_compiler_wl" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_static='`$ECHO "$lt_prog_compiler_static" | $SED "$delay_single_quote_subst"`' +lt_cv_prog_compiler_c_o='`$ECHO "$lt_cv_prog_compiler_c_o" | $SED "$delay_single_quote_subst"`' +need_locks='`$ECHO "$need_locks" | $SED "$delay_single_quote_subst"`' +MANIFEST_TOOL='`$ECHO "$MANIFEST_TOOL" | $SED "$delay_single_quote_subst"`' +DSYMUTIL='`$ECHO "$DSYMUTIL" | $SED "$delay_single_quote_subst"`' +NMEDIT='`$ECHO "$NMEDIT" | $SED "$delay_single_quote_subst"`' +LIPO='`$ECHO "$LIPO" | $SED "$delay_single_quote_subst"`' +OTOOL='`$ECHO "$OTOOL" | $SED "$delay_single_quote_subst"`' +OTOOL64='`$ECHO "$OTOOL64" | $SED "$delay_single_quote_subst"`' +libext='`$ECHO "$libext" | $SED "$delay_single_quote_subst"`' +shrext_cmds='`$ECHO "$shrext_cmds" | $SED "$delay_single_quote_subst"`' +extract_expsyms_cmds='`$ECHO "$extract_expsyms_cmds" | $SED "$delay_single_quote_subst"`' +archive_cmds_need_lc='`$ECHO "$archive_cmds_need_lc" | $SED "$delay_single_quote_subst"`' +enable_shared_with_static_runtimes='`$ECHO "$enable_shared_with_static_runtimes" | $SED "$delay_single_quote_subst"`' +export_dynamic_flag_spec='`$ECHO "$export_dynamic_flag_spec" | $SED "$delay_single_quote_subst"`' +whole_archive_flag_spec='`$ECHO "$whole_archive_flag_spec" | $SED "$delay_single_quote_subst"`' +compiler_needs_object='`$ECHO "$compiler_needs_object" | $SED "$delay_single_quote_subst"`' +old_archive_from_new_cmds='`$ECHO "$old_archive_from_new_cmds" | $SED "$delay_single_quote_subst"`' +old_archive_from_expsyms_cmds='`$ECHO "$old_archive_from_expsyms_cmds" | $SED "$delay_single_quote_subst"`' +archive_cmds='`$ECHO "$archive_cmds" | $SED "$delay_single_quote_subst"`' +archive_expsym_cmds='`$ECHO "$archive_expsym_cmds" | $SED "$delay_single_quote_subst"`' +module_cmds='`$ECHO "$module_cmds" | $SED "$delay_single_quote_subst"`' +module_expsym_cmds='`$ECHO "$module_expsym_cmds" | $SED "$delay_single_quote_subst"`' +with_gnu_ld='`$ECHO "$with_gnu_ld" | $SED "$delay_single_quote_subst"`' +allow_undefined_flag='`$ECHO "$allow_undefined_flag" | $SED "$delay_single_quote_subst"`' +no_undefined_flag='`$ECHO "$no_undefined_flag" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec='`$ECHO "$hardcode_libdir_flag_spec" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_separator='`$ECHO "$hardcode_libdir_separator" | $SED "$delay_single_quote_subst"`' +hardcode_direct='`$ECHO "$hardcode_direct" | $SED "$delay_single_quote_subst"`' +hardcode_direct_absolute='`$ECHO "$hardcode_direct_absolute" | $SED "$delay_single_quote_subst"`' +hardcode_minus_L='`$ECHO "$hardcode_minus_L" | $SED "$delay_single_quote_subst"`' +hardcode_shlibpath_var='`$ECHO "$hardcode_shlibpath_var" | $SED "$delay_single_quote_subst"`' +hardcode_automatic='`$ECHO "$hardcode_automatic" | $SED "$delay_single_quote_subst"`' +inherit_rpath='`$ECHO "$inherit_rpath" | $SED "$delay_single_quote_subst"`' +link_all_deplibs='`$ECHO "$link_all_deplibs" | $SED "$delay_single_quote_subst"`' +always_export_symbols='`$ECHO "$always_export_symbols" | $SED "$delay_single_quote_subst"`' +export_symbols_cmds='`$ECHO "$export_symbols_cmds" | $SED "$delay_single_quote_subst"`' +exclude_expsyms='`$ECHO "$exclude_expsyms" | $SED "$delay_single_quote_subst"`' +include_expsyms='`$ECHO "$include_expsyms" | $SED "$delay_single_quote_subst"`' +prelink_cmds='`$ECHO "$prelink_cmds" | $SED "$delay_single_quote_subst"`' +postlink_cmds='`$ECHO "$postlink_cmds" | $SED "$delay_single_quote_subst"`' +file_list_spec='`$ECHO "$file_list_spec" | $SED "$delay_single_quote_subst"`' +variables_saved_for_relink='`$ECHO "$variables_saved_for_relink" | $SED "$delay_single_quote_subst"`' +need_lib_prefix='`$ECHO "$need_lib_prefix" | $SED "$delay_single_quote_subst"`' +need_version='`$ECHO "$need_version" | $SED "$delay_single_quote_subst"`' +version_type='`$ECHO "$version_type" | $SED "$delay_single_quote_subst"`' +runpath_var='`$ECHO "$runpath_var" | $SED "$delay_single_quote_subst"`' +shlibpath_var='`$ECHO "$shlibpath_var" | $SED "$delay_single_quote_subst"`' +shlibpath_overrides_runpath='`$ECHO "$shlibpath_overrides_runpath" | $SED "$delay_single_quote_subst"`' +libname_spec='`$ECHO "$libname_spec" | $SED "$delay_single_quote_subst"`' +library_names_spec='`$ECHO "$library_names_spec" | $SED "$delay_single_quote_subst"`' +soname_spec='`$ECHO "$soname_spec" | $SED "$delay_single_quote_subst"`' +install_override_mode='`$ECHO "$install_override_mode" | $SED "$delay_single_quote_subst"`' +postinstall_cmds='`$ECHO "$postinstall_cmds" | $SED "$delay_single_quote_subst"`' +postuninstall_cmds='`$ECHO "$postuninstall_cmds" | $SED "$delay_single_quote_subst"`' +finish_cmds='`$ECHO "$finish_cmds" | $SED "$delay_single_quote_subst"`' +finish_eval='`$ECHO "$finish_eval" | $SED "$delay_single_quote_subst"`' +hardcode_into_libs='`$ECHO "$hardcode_into_libs" | $SED "$delay_single_quote_subst"`' +sys_lib_search_path_spec='`$ECHO "$sys_lib_search_path_spec" | $SED "$delay_single_quote_subst"`' +configure_time_dlsearch_path='`$ECHO "$configure_time_dlsearch_path" | $SED "$delay_single_quote_subst"`' +configure_time_lt_sys_library_path='`$ECHO "$configure_time_lt_sys_library_path" | $SED "$delay_single_quote_subst"`' +hardcode_action='`$ECHO "$hardcode_action" | $SED "$delay_single_quote_subst"`' +enable_dlopen='`$ECHO "$enable_dlopen" | $SED "$delay_single_quote_subst"`' +enable_dlopen_self='`$ECHO "$enable_dlopen_self" | $SED "$delay_single_quote_subst"`' +enable_dlopen_self_static='`$ECHO "$enable_dlopen_self_static" | $SED "$delay_single_quote_subst"`' +old_striplib='`$ECHO "$old_striplib" | $SED "$delay_single_quote_subst"`' +striplib='`$ECHO "$striplib" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_dirs='`$ECHO "$compiler_lib_search_dirs" | $SED "$delay_single_quote_subst"`' +predep_objects='`$ECHO "$predep_objects" | $SED "$delay_single_quote_subst"`' +postdep_objects='`$ECHO "$postdep_objects" | $SED "$delay_single_quote_subst"`' +predeps='`$ECHO "$predeps" | $SED "$delay_single_quote_subst"`' +postdeps='`$ECHO "$postdeps" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_path='`$ECHO "$compiler_lib_search_path" | $SED "$delay_single_quote_subst"`' +LD_CXX='`$ECHO "$LD_CXX" | $SED "$delay_single_quote_subst"`' +LD_F77='`$ECHO "$LD_F77" | $SED "$delay_single_quote_subst"`' +reload_flag_CXX='`$ECHO "$reload_flag_CXX" | $SED "$delay_single_quote_subst"`' +reload_flag_F77='`$ECHO "$reload_flag_F77" | $SED "$delay_single_quote_subst"`' +reload_cmds_CXX='`$ECHO "$reload_cmds_CXX" | $SED "$delay_single_quote_subst"`' +reload_cmds_F77='`$ECHO "$reload_cmds_F77" | $SED "$delay_single_quote_subst"`' +old_archive_cmds_CXX='`$ECHO "$old_archive_cmds_CXX" | $SED "$delay_single_quote_subst"`' +old_archive_cmds_F77='`$ECHO "$old_archive_cmds_F77" | $SED "$delay_single_quote_subst"`' +compiler_CXX='`$ECHO "$compiler_CXX" | $SED "$delay_single_quote_subst"`' +compiler_F77='`$ECHO "$compiler_F77" | $SED "$delay_single_quote_subst"`' +GCC_CXX='`$ECHO "$GCC_CXX" | $SED "$delay_single_quote_subst"`' +GCC_F77='`$ECHO "$GCC_F77" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_no_builtin_flag_CXX='`$ECHO "$lt_prog_compiler_no_builtin_flag_CXX" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_no_builtin_flag_F77='`$ECHO "$lt_prog_compiler_no_builtin_flag_F77" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_pic_CXX='`$ECHO "$lt_prog_compiler_pic_CXX" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_pic_F77='`$ECHO "$lt_prog_compiler_pic_F77" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_wl_CXX='`$ECHO "$lt_prog_compiler_wl_CXX" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_wl_F77='`$ECHO "$lt_prog_compiler_wl_F77" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_static_CXX='`$ECHO "$lt_prog_compiler_static_CXX" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_static_F77='`$ECHO "$lt_prog_compiler_static_F77" | $SED "$delay_single_quote_subst"`' +lt_cv_prog_compiler_c_o_CXX='`$ECHO "$lt_cv_prog_compiler_c_o_CXX" | $SED "$delay_single_quote_subst"`' +lt_cv_prog_compiler_c_o_F77='`$ECHO "$lt_cv_prog_compiler_c_o_F77" | $SED "$delay_single_quote_subst"`' +archive_cmds_need_lc_CXX='`$ECHO "$archive_cmds_need_lc_CXX" | $SED "$delay_single_quote_subst"`' +archive_cmds_need_lc_F77='`$ECHO "$archive_cmds_need_lc_F77" | $SED "$delay_single_quote_subst"`' +enable_shared_with_static_runtimes_CXX='`$ECHO "$enable_shared_with_static_runtimes_CXX" | $SED "$delay_single_quote_subst"`' +enable_shared_with_static_runtimes_F77='`$ECHO "$enable_shared_with_static_runtimes_F77" | $SED "$delay_single_quote_subst"`' +export_dynamic_flag_spec_CXX='`$ECHO "$export_dynamic_flag_spec_CXX" | $SED "$delay_single_quote_subst"`' +export_dynamic_flag_spec_F77='`$ECHO "$export_dynamic_flag_spec_F77" | $SED "$delay_single_quote_subst"`' +whole_archive_flag_spec_CXX='`$ECHO "$whole_archive_flag_spec_CXX" | $SED "$delay_single_quote_subst"`' +whole_archive_flag_spec_F77='`$ECHO "$whole_archive_flag_spec_F77" | $SED "$delay_single_quote_subst"`' +compiler_needs_object_CXX='`$ECHO "$compiler_needs_object_CXX" | $SED "$delay_single_quote_subst"`' +compiler_needs_object_F77='`$ECHO "$compiler_needs_object_F77" | $SED "$delay_single_quote_subst"`' +old_archive_from_new_cmds_CXX='`$ECHO "$old_archive_from_new_cmds_CXX" | $SED "$delay_single_quote_subst"`' +old_archive_from_new_cmds_F77='`$ECHO "$old_archive_from_new_cmds_F77" | $SED "$delay_single_quote_subst"`' +old_archive_from_expsyms_cmds_CXX='`$ECHO "$old_archive_from_expsyms_cmds_CXX" | $SED "$delay_single_quote_subst"`' +old_archive_from_expsyms_cmds_F77='`$ECHO "$old_archive_from_expsyms_cmds_F77" | $SED "$delay_single_quote_subst"`' +archive_cmds_CXX='`$ECHO "$archive_cmds_CXX" | $SED "$delay_single_quote_subst"`' +archive_cmds_F77='`$ECHO "$archive_cmds_F77" | $SED "$delay_single_quote_subst"`' +archive_expsym_cmds_CXX='`$ECHO "$archive_expsym_cmds_CXX" | $SED "$delay_single_quote_subst"`' +archive_expsym_cmds_F77='`$ECHO "$archive_expsym_cmds_F77" | $SED "$delay_single_quote_subst"`' +module_cmds_CXX='`$ECHO "$module_cmds_CXX" | $SED "$delay_single_quote_subst"`' +module_cmds_F77='`$ECHO "$module_cmds_F77" | $SED "$delay_single_quote_subst"`' +module_expsym_cmds_CXX='`$ECHO "$module_expsym_cmds_CXX" | $SED "$delay_single_quote_subst"`' +module_expsym_cmds_F77='`$ECHO "$module_expsym_cmds_F77" | $SED "$delay_single_quote_subst"`' +with_gnu_ld_CXX='`$ECHO "$with_gnu_ld_CXX" | $SED "$delay_single_quote_subst"`' +with_gnu_ld_F77='`$ECHO "$with_gnu_ld_F77" | $SED "$delay_single_quote_subst"`' +allow_undefined_flag_CXX='`$ECHO "$allow_undefined_flag_CXX" | $SED "$delay_single_quote_subst"`' +allow_undefined_flag_F77='`$ECHO "$allow_undefined_flag_F77" | $SED "$delay_single_quote_subst"`' +no_undefined_flag_CXX='`$ECHO "$no_undefined_flag_CXX" | $SED "$delay_single_quote_subst"`' +no_undefined_flag_F77='`$ECHO "$no_undefined_flag_F77" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec_CXX='`$ECHO "$hardcode_libdir_flag_spec_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec_F77='`$ECHO "$hardcode_libdir_flag_spec_F77" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_separator_CXX='`$ECHO "$hardcode_libdir_separator_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_separator_F77='`$ECHO "$hardcode_libdir_separator_F77" | $SED "$delay_single_quote_subst"`' +hardcode_direct_CXX='`$ECHO "$hardcode_direct_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_direct_F77='`$ECHO "$hardcode_direct_F77" | $SED "$delay_single_quote_subst"`' +hardcode_direct_absolute_CXX='`$ECHO "$hardcode_direct_absolute_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_direct_absolute_F77='`$ECHO "$hardcode_direct_absolute_F77" | $SED "$delay_single_quote_subst"`' +hardcode_minus_L_CXX='`$ECHO "$hardcode_minus_L_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_minus_L_F77='`$ECHO "$hardcode_minus_L_F77" | $SED "$delay_single_quote_subst"`' +hardcode_shlibpath_var_CXX='`$ECHO "$hardcode_shlibpath_var_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_shlibpath_var_F77='`$ECHO "$hardcode_shlibpath_var_F77" | $SED "$delay_single_quote_subst"`' +hardcode_automatic_CXX='`$ECHO "$hardcode_automatic_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_automatic_F77='`$ECHO "$hardcode_automatic_F77" | $SED "$delay_single_quote_subst"`' +inherit_rpath_CXX='`$ECHO "$inherit_rpath_CXX" | $SED "$delay_single_quote_subst"`' +inherit_rpath_F77='`$ECHO "$inherit_rpath_F77" | $SED "$delay_single_quote_subst"`' +link_all_deplibs_CXX='`$ECHO "$link_all_deplibs_CXX" | $SED "$delay_single_quote_subst"`' +link_all_deplibs_F77='`$ECHO "$link_all_deplibs_F77" | $SED "$delay_single_quote_subst"`' +always_export_symbols_CXX='`$ECHO "$always_export_symbols_CXX" | $SED "$delay_single_quote_subst"`' +always_export_symbols_F77='`$ECHO "$always_export_symbols_F77" | $SED "$delay_single_quote_subst"`' +export_symbols_cmds_CXX='`$ECHO "$export_symbols_cmds_CXX" | $SED "$delay_single_quote_subst"`' +export_symbols_cmds_F77='`$ECHO "$export_symbols_cmds_F77" | $SED "$delay_single_quote_subst"`' +exclude_expsyms_CXX='`$ECHO "$exclude_expsyms_CXX" | $SED "$delay_single_quote_subst"`' +exclude_expsyms_F77='`$ECHO "$exclude_expsyms_F77" | $SED "$delay_single_quote_subst"`' +include_expsyms_CXX='`$ECHO "$include_expsyms_CXX" | $SED "$delay_single_quote_subst"`' +include_expsyms_F77='`$ECHO "$include_expsyms_F77" | $SED "$delay_single_quote_subst"`' +prelink_cmds_CXX='`$ECHO "$prelink_cmds_CXX" | $SED "$delay_single_quote_subst"`' +prelink_cmds_F77='`$ECHO "$prelink_cmds_F77" | $SED "$delay_single_quote_subst"`' +postlink_cmds_CXX='`$ECHO "$postlink_cmds_CXX" | $SED "$delay_single_quote_subst"`' +postlink_cmds_F77='`$ECHO "$postlink_cmds_F77" | $SED "$delay_single_quote_subst"`' +file_list_spec_CXX='`$ECHO "$file_list_spec_CXX" | $SED "$delay_single_quote_subst"`' +file_list_spec_F77='`$ECHO "$file_list_spec_F77" | $SED "$delay_single_quote_subst"`' +hardcode_action_CXX='`$ECHO "$hardcode_action_CXX" | $SED "$delay_single_quote_subst"`' +hardcode_action_F77='`$ECHO "$hardcode_action_F77" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_dirs_CXX='`$ECHO "$compiler_lib_search_dirs_CXX" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_dirs_F77='`$ECHO "$compiler_lib_search_dirs_F77" | $SED "$delay_single_quote_subst"`' +predep_objects_CXX='`$ECHO "$predep_objects_CXX" | $SED "$delay_single_quote_subst"`' +predep_objects_F77='`$ECHO "$predep_objects_F77" | $SED "$delay_single_quote_subst"`' +postdep_objects_CXX='`$ECHO "$postdep_objects_CXX" | $SED "$delay_single_quote_subst"`' +postdep_objects_F77='`$ECHO "$postdep_objects_F77" | $SED "$delay_single_quote_subst"`' +predeps_CXX='`$ECHO "$predeps_CXX" | $SED "$delay_single_quote_subst"`' +predeps_F77='`$ECHO "$predeps_F77" | $SED "$delay_single_quote_subst"`' +postdeps_CXX='`$ECHO "$postdeps_CXX" | $SED "$delay_single_quote_subst"`' +postdeps_F77='`$ECHO "$postdeps_F77" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_path_CXX='`$ECHO "$compiler_lib_search_path_CXX" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_path_F77='`$ECHO "$compiler_lib_search_path_F77" | $SED "$delay_single_quote_subst"`' + +LTCC='$LTCC' +LTCFLAGS='$LTCFLAGS' +compiler='$compiler_DEFAULT' + +# A function that is used when there is no print builtin or printf. +func_fallback_echo () +{ + eval 'cat <<_LTECHO_EOF +\$1 +_LTECHO_EOF' +} + +# Quote evaled strings. +for var in AS \ +DLLTOOL \ +OBJDUMP \ +SHELL \ +ECHO \ +PATH_SEPARATOR \ +SED \ +GREP \ +EGREP \ +FGREP \ +LD \ +NM \ +LN_S \ +lt_SP2NL \ +lt_NL2SP \ +reload_flag \ +deplibs_check_method \ +file_magic_cmd \ +file_magic_glob \ +want_nocaseglob \ +sharedlib_from_linklib_cmd \ +AR \ +AR_FLAGS \ +archiver_list_spec \ +STRIP \ +RANLIB \ +CC \ +CFLAGS \ +compiler \ +lt_cv_sys_global_symbol_pipe \ +lt_cv_sys_global_symbol_to_cdecl \ +lt_cv_sys_global_symbol_to_import \ +lt_cv_sys_global_symbol_to_c_name_address \ +lt_cv_sys_global_symbol_to_c_name_address_lib_prefix \ +lt_cv_nm_interface \ +nm_file_list_spec \ +lt_cv_truncate_bin \ +lt_prog_compiler_no_builtin_flag \ +lt_prog_compiler_pic \ +lt_prog_compiler_wl \ +lt_prog_compiler_static \ +lt_cv_prog_compiler_c_o \ +need_locks \ +MANIFEST_TOOL \ +DSYMUTIL \ +NMEDIT \ +LIPO \ +OTOOL \ +OTOOL64 \ +shrext_cmds \ +export_dynamic_flag_spec \ +whole_archive_flag_spec \ +compiler_needs_object \ +with_gnu_ld \ +allow_undefined_flag \ +no_undefined_flag \ +hardcode_libdir_flag_spec \ +hardcode_libdir_separator \ +exclude_expsyms \ +include_expsyms \ +file_list_spec \ +variables_saved_for_relink \ +libname_spec \ +library_names_spec \ +soname_spec \ +install_override_mode \ +finish_eval \ +old_striplib \ +striplib \ +compiler_lib_search_dirs \ +predep_objects \ +postdep_objects \ +predeps \ +postdeps \ +compiler_lib_search_path \ +LD_CXX \ +LD_F77 \ +reload_flag_CXX \ +reload_flag_F77 \ +compiler_CXX \ +compiler_F77 \ +lt_prog_compiler_no_builtin_flag_CXX \ +lt_prog_compiler_no_builtin_flag_F77 \ +lt_prog_compiler_pic_CXX \ +lt_prog_compiler_pic_F77 \ +lt_prog_compiler_wl_CXX \ +lt_prog_compiler_wl_F77 \ +lt_prog_compiler_static_CXX \ +lt_prog_compiler_static_F77 \ +lt_cv_prog_compiler_c_o_CXX \ +lt_cv_prog_compiler_c_o_F77 \ +export_dynamic_flag_spec_CXX \ +export_dynamic_flag_spec_F77 \ +whole_archive_flag_spec_CXX \ +whole_archive_flag_spec_F77 \ +compiler_needs_object_CXX \ +compiler_needs_object_F77 \ +with_gnu_ld_CXX \ +with_gnu_ld_F77 \ +allow_undefined_flag_CXX \ +allow_undefined_flag_F77 \ +no_undefined_flag_CXX \ +no_undefined_flag_F77 \ +hardcode_libdir_flag_spec_CXX \ +hardcode_libdir_flag_spec_F77 \ +hardcode_libdir_separator_CXX \ +hardcode_libdir_separator_F77 \ +exclude_expsyms_CXX \ +exclude_expsyms_F77 \ +include_expsyms_CXX \ +include_expsyms_F77 \ +file_list_spec_CXX \ +file_list_spec_F77 \ +compiler_lib_search_dirs_CXX \ +compiler_lib_search_dirs_F77 \ +predep_objects_CXX \ +predep_objects_F77 \ +postdep_objects_CXX \ +postdep_objects_F77 \ +predeps_CXX \ +predeps_F77 \ +postdeps_CXX \ +postdeps_F77 \ +compiler_lib_search_path_CXX \ +compiler_lib_search_path_F77; do + case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in + *[\\\\\\\`\\"\\\$]*) + eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED \\"\\\$sed_quote_subst\\"\\\`\\\\\\"" ## exclude from sc_prohibit_nested_quotes + ;; + *) + eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\"" + ;; + esac +done + +# Double-quote double-evaled strings. +for var in reload_cmds \ +old_postinstall_cmds \ +old_postuninstall_cmds \ +old_archive_cmds \ +extract_expsyms_cmds \ +old_archive_from_new_cmds \ +old_archive_from_expsyms_cmds \ +archive_cmds \ +archive_expsym_cmds \ +module_cmds \ +module_expsym_cmds \ +export_symbols_cmds \ +prelink_cmds \ +postlink_cmds \ +postinstall_cmds \ +postuninstall_cmds \ +finish_cmds \ +sys_lib_search_path_spec \ +configure_time_dlsearch_path \ +configure_time_lt_sys_library_path \ +reload_cmds_CXX \ +reload_cmds_F77 \ +old_archive_cmds_CXX \ +old_archive_cmds_F77 \ +old_archive_from_new_cmds_CXX \ +old_archive_from_new_cmds_F77 \ +old_archive_from_expsyms_cmds_CXX \ +old_archive_from_expsyms_cmds_F77 \ +archive_cmds_CXX \ +archive_cmds_F77 \ +archive_expsym_cmds_CXX \ +archive_expsym_cmds_F77 \ +module_cmds_CXX \ +module_cmds_F77 \ +module_expsym_cmds_CXX \ +module_expsym_cmds_F77 \ +export_symbols_cmds_CXX \ +export_symbols_cmds_F77 \ +prelink_cmds_CXX \ +prelink_cmds_F77 \ +postlink_cmds_CXX \ +postlink_cmds_F77; do + case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in + *[\\\\\\\`\\"\\\$]*) + eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED -e \\"\\\$double_quote_subst\\" -e \\"\\\$sed_quote_subst\\" -e \\"\\\$delay_variable_subst\\"\\\`\\\\\\"" ## exclude from sc_prohibit_nested_quotes + ;; + *) + eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\"" + ;; + esac +done + +ac_aux_dir='$ac_aux_dir' + +# See if we are running on zsh, and set the options that allow our +# commands through without removal of \ escapes INIT. +if test -n "\${ZSH_VERSION+set}"; then + setopt NO_GLOB_SUBST +fi + + + PACKAGE='$PACKAGE' + VERSION='$VERSION' + RM='$RM' + ofile='$ofile' + + + + + + + + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "depfiles") CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;; + "libtool") CONFIG_COMMANDS="$CONFIG_COMMANDS libtool" ;; + "libtoolclpatch") CONFIG_COMMANDS="$CONFIG_COMMANDS libtoolclpatch" ;; + "libtoolmingwpatch") CONFIG_COMMANDS="$CONFIG_COMMANDS libtoolmingwpatch" ;; + "test/hs071_main.cpp") CONFIG_LINKS="$CONFIG_LINKS test/hs071_main.cpp:examples/hs071_cpp/hs071_main.cpp" ;; + "test/hs071_nlp.cpp") CONFIG_LINKS="$CONFIG_LINKS test/hs071_nlp.cpp:examples/hs071_cpp/hs071_nlp.cpp" ;; + "test/hs071_nlp.hpp") CONFIG_LINKS="$CONFIG_LINKS test/hs071_nlp.hpp:examples/hs071_cpp/hs071_nlp.hpp" ;; + "test/hs071_c.c") CONFIG_LINKS="$CONFIG_LINKS test/hs071_c.c:examples/hs071_c/hs071_c.c" ;; + "test/parametric_driver.cpp") CONFIG_LINKS="$CONFIG_LINKS test/parametric_driver.cpp:contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp" ;; + "test/parametricTNLP.cpp") CONFIG_LINKS="$CONFIG_LINKS test/parametricTNLP.cpp:contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp" ;; + "test/MySensTNLP.cpp") CONFIG_LINKS="$CONFIG_LINKS test/MySensTNLP.cpp:contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp" ;; + "test/redhess_cpp.cpp") CONFIG_LINKS="$CONFIG_LINKS test/redhess_cpp.cpp:contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp" ;; + "contrib/RInterface/DESCRIPTION") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/DESCRIPTION:contrib/RInterface/DESCRIPTION" ;; + "contrib/RInterface/NAMESPACE") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/NAMESPACE:contrib/RInterface/NAMESPACE" ;; + "contrib/RInterface/inst/CITATION") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/inst/CITATION:contrib/RInterface/inst/CITATION" ;; + "contrib/RInterface/inst/doc/ipoptr.Rnw") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/inst/doc/ipoptr.Rnw:contrib/RInterface/inst/doc/ipoptr.Rnw" ;; + "contrib/RInterface/inst/doc/ipoptr.pdf") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/inst/doc/ipoptr.pdf:contrib/RInterface/inst/doc/ipoptr.pdf" ;; + "contrib/RInterface/inst/doc/reflist.bib") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/inst/doc/reflist.bib:contrib/RInterface/inst/doc/reflist.bib" ;; + "contrib/RInterface/man/ipoptr-package.Rd") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/man/ipoptr-package.Rd:contrib/RInterface/man/ipoptr-package.Rd" ;; + "contrib/RInterface/man/ipoptr.Rd") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/man/ipoptr.Rd:contrib/RInterface/man/ipoptr.Rd" ;; + "contrib/RInterface/man/is.ipoptr.Rd") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/man/is.ipoptr.Rd:contrib/RInterface/man/is.ipoptr.Rd" ;; + "contrib/RInterface/man/make.sparse.Rd") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/man/make.sparse.Rd:contrib/RInterface/man/make.sparse.Rd" ;; + "contrib/RInterface/man/plot.sparseness.Rd") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/man/plot.sparseness.Rd:contrib/RInterface/man/plot.sparseness.Rd" ;; + "contrib/RInterface/man/print.ipoptr.Rd") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/man/print.ipoptr.Rd:contrib/RInterface/man/print.ipoptr.Rd" ;; + "contrib/RInterface/man/print.sparseness.Rd") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/man/print.sparseness.Rd:contrib/RInterface/man/print.sparseness.Rd" ;; + "contrib/RInterface/R/get.option.types.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/R/get.option.types.R:contrib/RInterface/R/get.option.types.R" ;; + "contrib/RInterface/R/ipoptr.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/R/ipoptr.R:contrib/RInterface/R/ipoptr.R" ;; + "contrib/RInterface/R/is.ipoptr.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/R/is.ipoptr.R:contrib/RInterface/R/is.ipoptr.R" ;; + "contrib/RInterface/R/make.sparse.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/R/make.sparse.R:contrib/RInterface/R/make.sparse.R" ;; + "contrib/RInterface/R/plot.sparseness.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/R/plot.sparseness.R:contrib/RInterface/R/plot.sparseness.R" ;; + "contrib/RInterface/R/print.ipoptr.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/R/print.ipoptr.R:contrib/RInterface/R/print.ipoptr.R" ;; + "contrib/RInterface/R/print.sparseness.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/R/print.sparseness.R:contrib/RInterface/R/print.sparseness.R" ;; + "contrib/RInterface/tests/approx_banana.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/tests/approx_banana.R:contrib/RInterface/tests/approx_banana.R" ;; + "contrib/RInterface/tests/banana.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/tests/banana.R:contrib/RInterface/tests/banana.R" ;; + "contrib/RInterface/tests/hs071_nlp.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/tests/hs071_nlp.R:contrib/RInterface/tests/hs071_nlp.R" ;; + "contrib/RInterface/tests/lasso.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/tests/lasso.R:contrib/RInterface/tests/lasso.R" ;; + "contrib/RInterface/tests/mynlp.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/tests/mynlp.R:contrib/RInterface/tests/mynlp.R" ;; + "contrib/RInterface/tests/parameters.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/tests/parameters.R:contrib/RInterface/tests/parameters.R" ;; + "contrib/RInterface/tests/sparseness.R") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/tests/sparseness.R:contrib/RInterface/tests/sparseness.R" ;; + "contrib/RInterface/src/ipoptr.cpp") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/src/ipoptr.cpp:contrib/RInterface/src/ipoptr.cpp" ;; + "contrib/RInterface/src/IpoptRJournal.cpp") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/src/IpoptRJournal.cpp:contrib/RInterface/src/IpoptRJournal.cpp" ;; + "contrib/RInterface/src/IpoptRNLP.cpp") CONFIG_LINKS="$CONFIG_LINKS contrib/RInterface/src/IpoptRNLP.cpp:contrib/RInterface/src/IpoptRNLP.cpp" ;; + "examples/Cpp_example/cpp_example.cpp") CONFIG_LINKS="$CONFIG_LINKS examples/Cpp_example/cpp_example.cpp:examples/Cpp_example/cpp_example.cpp" ;; + "examples/Cpp_example/MyNLP.cpp") CONFIG_LINKS="$CONFIG_LINKS examples/Cpp_example/MyNLP.cpp:examples/Cpp_example/MyNLP.cpp" ;; + "examples/Cpp_example/MyNLP.hpp") CONFIG_LINKS="$CONFIG_LINKS examples/Cpp_example/MyNLP.hpp:examples/Cpp_example/MyNLP.hpp" ;; + "examples/hs071_cpp/hs071_main.cpp") CONFIG_LINKS="$CONFIG_LINKS examples/hs071_cpp/hs071_main.cpp:examples/hs071_cpp/hs071_main.cpp" ;; + "examples/hs071_cpp/hs071_nlp.cpp") CONFIG_LINKS="$CONFIG_LINKS examples/hs071_cpp/hs071_nlp.cpp:examples/hs071_cpp/hs071_nlp.cpp" ;; + "examples/hs071_cpp/hs071_nlp.hpp") CONFIG_LINKS="$CONFIG_LINKS examples/hs071_cpp/hs071_nlp.hpp:examples/hs071_cpp/hs071_nlp.hpp" ;; + "examples/hs071_c/hs071_c.c") CONFIG_LINKS="$CONFIG_LINKS examples/hs071_c/hs071_c.c:examples/hs071_c/hs071_c.c" ;; + "examples/hs071_java/HS071.java") CONFIG_LINKS="$CONFIG_LINKS examples/hs071_java/HS071.java:examples/hs071_java/HS071.java" ;; + "tutorial/AmplExperiments/hs71.mod") CONFIG_LINKS="$CONFIG_LINKS tutorial/AmplExperiments/hs71.mod:tutorial/AmplExperiments/hs71.mod" ;; + "tutorial/AmplExperiments/infeasible.mod") CONFIG_LINKS="$CONFIG_LINKS tutorial/AmplExperiments/infeasible.mod:tutorial/AmplExperiments/infeasible.mod" ;; + "tutorial/AmplExperiments/MoreAmplModels.txt") CONFIG_LINKS="$CONFIG_LINKS tutorial/AmplExperiments/MoreAmplModels.txt:tutorial/AmplExperiments/MoreAmplModels.txt" ;; + "tutorial/AmplExperiments/car1.run") CONFIG_LINKS="$CONFIG_LINKS tutorial/AmplExperiments/car1.run:tutorial/AmplExperiments/car1.run" ;; + "tutorial/AmplExperiments/car1.gp") CONFIG_LINKS="$CONFIG_LINKS tutorial/AmplExperiments/car1.gp:tutorial/AmplExperiments/car1.gp" ;; + "tutorial/Modeling/bad1.mod") CONFIG_LINKS="$CONFIG_LINKS tutorial/Modeling/bad1.mod:tutorial/Modeling/bad1.mod" ;; + "tutorial/Modeling/bad1-fix1.mod") CONFIG_LINKS="$CONFIG_LINKS tutorial/Modeling/bad1-fix1.mod:tutorial/Modeling/bad1-fix1.mod" ;; + "tutorial/Modeling/bad1-fix2.mod") CONFIG_LINKS="$CONFIG_LINKS tutorial/Modeling/bad1-fix2.mod:tutorial/Modeling/bad1-fix2.mod" ;; + "tutorial/CodingExercise/exercise_example.mod") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/exercise_example.mod:tutorial/CodingExercise/exercise_example.mod" ;; + "tutorial/CodingExercise/C/1-skeleton/TutorialC.c") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/C/1-skeleton/TutorialC.c:tutorial/CodingExercise/C/1-skeleton/TutorialC.c" ;; + "tutorial/CodingExercise/C/2-mistake/TutorialC.c") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/C/2-mistake/TutorialC.c:tutorial/CodingExercise/C/2-mistake/TutorialC.c" ;; + "tutorial/CodingExercise/C/3-solution/TutorialC.c") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/C/3-solution/TutorialC.c:tutorial/CodingExercise/C/3-solution/TutorialC.c" ;; + "tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_main.cpp") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_main.cpp:tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_main.cpp" ;; + "tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.hpp") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.hpp:tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.hpp" ;; + "tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.cpp") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.cpp:tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.cpp" ;; + "tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_main.cpp") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_main.cpp:tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_main.cpp" ;; + "tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.hpp") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.hpp:tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.hpp" ;; + "tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.cpp") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.cpp:tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.cpp" ;; + "tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_main.cpp") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_main.cpp:tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_main.cpp" ;; + "tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.hpp") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.hpp:tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.hpp" ;; + "tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.cpp") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.cpp:tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.cpp" ;; + "tutorial/CodingExercise/Matlab/1-skeleton/TutorialMatlab.m") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/Matlab/1-skeleton/TutorialMatlab.m:tutorial/CodingExercise/Matlab/1-skeleton/TutorialMatlab.m" ;; + "tutorial/CodingExercise/Matlab/2-mistake/TutorialMatlab.m") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/Matlab/2-mistake/TutorialMatlab.m:tutorial/CodingExercise/Matlab/2-mistake/TutorialMatlab.m" ;; + "tutorial/CodingExercise/Matlab/3-solution/TutorialMatlab.m") CONFIG_LINKS="$CONFIG_LINKS tutorial/CodingExercise/Matlab/3-solution/TutorialMatlab.m:tutorial/CodingExercise/Matlab/3-solution/TutorialMatlab.m" ;; + "contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp") CONFIG_LINKS="$CONFIG_LINKS contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp:contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp" ;; + "contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp") CONFIG_LINKS="$CONFIG_LINKS contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp:contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp" ;; + "contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.hpp") CONFIG_LINKS="$CONFIG_LINKS contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.hpp:contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.hpp" ;; + "contrib/sIPOPT/examples/parametric_dsdp_cpp/parametric_dsdp_driver.cpp") CONFIG_LINKS="$CONFIG_LINKS contrib/sIPOPT/examples/parametric_dsdp_cpp/parametric_dsdp_driver.cpp:contrib/sIPOPT/examples/parametric_dsdp_cpp/parametric_dsdp_driver.cpp" ;; + "contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.cpp") CONFIG_LINKS="$CONFIG_LINKS contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.cpp:contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.cpp" ;; + "contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.hpp") CONFIG_LINKS="$CONFIG_LINKS contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.hpp:contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.hpp" ;; + "contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp") CONFIG_LINKS="$CONFIG_LINKS contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp:contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp" ;; + "contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.hpp") CONFIG_LINKS="$CONFIG_LINKS contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.hpp:contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.hpp" ;; + "contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp") CONFIG_LINKS="$CONFIG_LINKS contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp:contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp" ;; + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "src/Common/Makefile") CONFIG_FILES="$CONFIG_FILES src/Common/Makefile" ;; + "src/LinAlg/Makefile") CONFIG_FILES="$CONFIG_FILES src/LinAlg/Makefile" ;; + "src/LinAlg/TMatrices/Makefile") CONFIG_FILES="$CONFIG_FILES src/LinAlg/TMatrices/Makefile" ;; + "src/Interfaces/Makefile") CONFIG_FILES="$CONFIG_FILES src/Interfaces/Makefile" ;; + "src/Algorithm/Makefile") CONFIG_FILES="$CONFIG_FILES src/Algorithm/Makefile" ;; + "src/Algorithm/LinearSolvers/Makefile") CONFIG_FILES="$CONFIG_FILES src/Algorithm/LinearSolvers/Makefile" ;; + "src/Algorithm/Inexact/Makefile") CONFIG_FILES="$CONFIG_FILES src/Algorithm/Inexact/Makefile" ;; + "src/contrib/CGPenalty/Makefile") CONFIG_FILES="$CONFIG_FILES src/contrib/CGPenalty/Makefile" ;; + "src/contrib/LinearSolverLoader/Makefile") CONFIG_FILES="$CONFIG_FILES src/contrib/LinearSolverLoader/Makefile" ;; + "src/Apps/Makefile") CONFIG_FILES="$CONFIG_FILES src/Apps/Makefile" ;; + "src/Apps/AmplSolver/Makefile") CONFIG_FILES="$CONFIG_FILES src/Apps/AmplSolver/Makefile" ;; + "test/Makefile") CONFIG_FILES="$CONFIG_FILES test/Makefile" ;; + "test/run_unitTests") CONFIG_FILES="$CONFIG_FILES test/run_unitTests" ;; + "ipopt.pc") CONFIG_FILES="$CONFIG_FILES ipopt.pc" ;; + "doc/Doxyfile") CONFIG_FILES="$CONFIG_FILES doc/Doxyfile" ;; + "examples/Cpp_example/Makefile") CONFIG_FILES="$CONFIG_FILES examples/Cpp_example/Makefile" ;; + "examples/recursive_nlp/Makefile") CONFIG_FILES="$CONFIG_FILES examples/recursive_nlp/Makefile" ;; + "examples/hs071_cpp/Makefile") CONFIG_FILES="$CONFIG_FILES examples/hs071_cpp/Makefile" ;; + "examples/hs071_c/Makefile") CONFIG_FILES="$CONFIG_FILES examples/hs071_c/Makefile" ;; + "examples/ScalableProblems/Makefile") CONFIG_FILES="$CONFIG_FILES examples/ScalableProblems/Makefile" ;; + "tutorial/CodingExercise/C/1-skeleton/Makefile") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/C/1-skeleton/Makefile" ;; + "tutorial/CodingExercise/C/2-mistake/Makefile") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/C/2-mistake/Makefile" ;; + "tutorial/CodingExercise/C/3-solution/Makefile") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/C/3-solution/Makefile" ;; + "tutorial/CodingExercise/Cpp/1-skeleton/Makefile") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/Cpp/1-skeleton/Makefile" ;; + "tutorial/CodingExercise/Cpp/2-mistake/Makefile") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/Cpp/2-mistake/Makefile" ;; + "tutorial/CodingExercise/Cpp/3-solution/Makefile") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/Cpp/3-solution/Makefile" ;; + "tutorial/CodingExercise/Matlab/1-skeleton/startup.m") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/Matlab/1-skeleton/startup.m" ;; + "tutorial/CodingExercise/Matlab/2-mistake/startup.m") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/Matlab/2-mistake/startup.m" ;; + "tutorial/CodingExercise/Matlab/3-solution/startup.m") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/Matlab/3-solution/startup.m" ;; + "examples/hs071_f/hs071_f.f") CONFIG_FILES="$CONFIG_FILES examples/hs071_f/hs071_f.f" ;; + "examples/hs071_f/Makefile") CONFIG_FILES="$CONFIG_FILES examples/hs071_f/Makefile" ;; + "tutorial/CodingExercise/Fortran/1-skeleton/TutorialFortran.f") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/Fortran/1-skeleton/TutorialFortran.f" ;; + "tutorial/CodingExercise/Fortran/2-mistake/TutorialFortran.f") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/Fortran/2-mistake/TutorialFortran.f" ;; + "tutorial/CodingExercise/Fortran/3-solution/TutorialFortran.f") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/Fortran/3-solution/TutorialFortran.f" ;; + "tutorial/CodingExercise/Fortran/1-skeleton/Makefile") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/Fortran/1-skeleton/Makefile" ;; + "tutorial/CodingExercise/Fortran/2-mistake/Makefile") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/Fortran/2-mistake/Makefile" ;; + "tutorial/CodingExercise/Fortran/3-solution/Makefile") CONFIG_FILES="$CONFIG_FILES tutorial/CodingExercise/Fortran/3-solution/Makefile" ;; + "examples/hs071_java/Makefile") CONFIG_FILES="$CONFIG_FILES examples/hs071_java/Makefile" ;; + "examples/ScalableProblems_java/Makefile") CONFIG_FILES="$CONFIG_FILES examples/ScalableProblems_java/Makefile" ;; + "contrib/sIPOPT/Makefile") CONFIG_FILES="$CONFIG_FILES contrib/sIPOPT/Makefile" ;; + "contrib/sIPOPT/src/Makefile") CONFIG_FILES="$CONFIG_FILES contrib/sIPOPT/src/Makefile" ;; + "contrib/sIPOPT/AmplSolver/Makefile") CONFIG_FILES="$CONFIG_FILES contrib/sIPOPT/AmplSolver/Makefile" ;; + "contrib/sIPOPT/examples/parametric_cpp/Makefile") CONFIG_FILES="$CONFIG_FILES contrib/sIPOPT/examples/parametric_cpp/Makefile" ;; + "contrib/sIPOPT/examples/parametric_dsdp_cpp/Makefile") CONFIG_FILES="$CONFIG_FILES contrib/sIPOPT/examples/parametric_dsdp_cpp/Makefile" ;; + "contrib/sIPOPT/examples/redhess_cpp/Makefile") CONFIG_FILES="$CONFIG_FILES contrib/sIPOPT/examples/redhess_cpp/Makefile" ;; + "contrib/RInterface/src/Makevars.win") CONFIG_FILES="$CONFIG_FILES contrib/RInterface/src/Makevars.win:contrib/RInterface/src/Makevars.in" ;; + "contrib/RInterface/src/Makevars") CONFIG_FILES="$CONFIG_FILES contrib/RInterface/src/Makevars" ;; + "ipoptamplinterface.pc") CONFIG_FILES="$CONFIG_FILES ipoptamplinterface.pc:src/Apps/AmplSolver/ipoptamplinterface.pc.in" ;; + "src/Common/config.h") CONFIG_HEADERS="$CONFIG_HEADERS src/Common/config.h" ;; + "src/Common/config_ipopt.h") CONFIG_HEADERS="$CONFIG_HEADERS src/Common/config_ipopt.h" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files + test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers + test "${CONFIG_LINKS+set}" = set || CONFIG_LINKS=$config_links + test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + +# Set up the scripts for CONFIG_HEADERS section. +# No need to generate them if there are no CONFIG_HEADERS. +# This happens for instance with `./config.status Makefile'. +if test -n "$CONFIG_HEADERS"; then +cat >"$ac_tmp/defines.awk" <<\_ACAWK || +BEGIN { +_ACEOF + +# Transform confdefs.h into an awk script `defines.awk', embedded as +# here-document in config.status, that substitutes the proper values into +# config.h.in to produce config.h. + +# Create a delimiter string that does not exist in confdefs.h, to ease +# handling of long lines. +ac_delim='%!_!# ' +for ac_last_try in false false :; do + ac_tt=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_tt"; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done + +# For the awk script, D is an array of macro values keyed by name, +# likewise P contains macro parameters if any. Preserve backslash +# newline sequences. + +ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* +sed -n ' +s/.\{148\}/&'"$ac_delim"'/g +t rset +:rset +s/^[ ]*#[ ]*define[ ][ ]*/ / +t def +d +:def +s/\\$// +t bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3"/p +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p +d +:bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3\\\\\\n"\\/p +t cont +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p +t cont +d +:cont +n +s/.\{148\}/&'"$ac_delim"'/g +t clear +:clear +s/\\$// +t bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/"/p +d +:bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p +b cont +' >$CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + for (key in D) D_is_set[key] = 1 + FS = "" +} +/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { + line = \$ 0 + split(line, arg, " ") + if (arg[1] == "#") { + defundef = arg[2] + mac1 = arg[3] + } else { + defundef = substr(arg[1], 2) + mac1 = arg[2] + } + split(mac1, mac2, "(") #) + macro = mac2[1] + prefix = substr(line, 1, index(line, defundef) - 1) + if (D_is_set[macro]) { + # Preserve the white space surrounding the "#". + print prefix "define", macro P[macro] D[macro] + next + } else { + # Replace #undef with comments. This is necessary, for example, + # in the case of _POSIX_SOURCE, which is predefined and required + # on some systems where configure will not decide to define it. + if (defundef == "undef") { + print "/*", prefix defundef, macro, "*/" + next + } + } +} +{ print } +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 +fi # test -n "$CONFIG_HEADERS" + + +eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS :L $CONFIG_LINKS :C $CONFIG_COMMANDS" +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; + esac + ac_MKDIR_P=$MKDIR_P + case $MKDIR_P in + [\\/$]* | ?:[\\/]* ) ;; + */*) ac_MKDIR_P=$ac_top_build_prefix$MKDIR_P ;; + esac +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +s&@INSTALL@&$ac_INSTALL&;t t +s&@MKDIR_P@&$ac_MKDIR_P&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + :H) + # + # CONFIG_HEADER + # + if test x"$ac_file" != x-; then + { + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" + } >"$ac_tmp/config.h" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 +$as_echo "$as_me: $ac_file is unchanged" >&6;} + else + rm -f "$ac_file" + mv "$ac_tmp/config.h" "$ac_file" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + fi + else + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ + || as_fn_error $? "could not create -" "$LINENO" 5 + fi +# Compute "$ac_file"'s index in $config_headers. +_am_arg="$ac_file" +_am_stamp_count=1 +for _am_header in $config_headers :; do + case $_am_header in + $_am_arg | $_am_arg:* ) + break ;; + * ) + _am_stamp_count=`expr $_am_stamp_count + 1` ;; + esac +done +echo "timestamp for $_am_arg" >`$as_dirname -- "$_am_arg" || +$as_expr X"$_am_arg" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$_am_arg" : 'X\(//\)[^/]' \| \ + X"$_am_arg" : 'X\(//\)$' \| \ + X"$_am_arg" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$_am_arg" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'`/stamp-h$_am_stamp_count + ;; + :L) + # + # CONFIG_LINK + # + + if test "$ac_source" = "$ac_file" && test "$srcdir" = '.'; then + : + else + # Prefer the file from the source tree if names are identical. + if test "$ac_source" = "$ac_file" || test ! -r "$ac_source"; then + ac_source=$srcdir/$ac_source + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: linking $ac_source to $ac_file" >&5 +$as_echo "$as_me: linking $ac_source to $ac_file" >&6;} + + if test ! -r "$ac_source"; then + as_fn_error $? "$ac_source: file not found" "$LINENO" 5 + fi + rm -f "$ac_file" + + # Try a relative symlink, then a hard link, then a copy. + case $ac_source in + [\\/$]* | ?:[\\/]* ) ac_rel_source=$ac_source ;; + *) ac_rel_source=$ac_top_build_prefix$ac_source ;; + esac + ln -s "$ac_rel_source" "$ac_file" 2>/dev/null || + ln "$ac_source" "$ac_file" 2>/dev/null || + cp -p "$ac_source" "$ac_file" || + as_fn_error $? "cannot link or copy $ac_source to $ac_file" "$LINENO" 5 + fi + ;; + :C) { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5 +$as_echo "$as_me: executing $ac_file commands" >&6;} + ;; + esac + + + case $ac_file$ac_mode in + "depfiles":C) test x"$AMDEP_TRUE" != x"" || { + # Older Autoconf quotes --file arguments for eval, but not when files + # are listed without --file. Let's play safe and only enable the eval + # if we detect the quoting. + # TODO: see whether this extra hack can be removed once we start + # requiring Autoconf 2.70 or later. + case $CONFIG_FILES in #( + *\'*) : + eval set x "$CONFIG_FILES" ;; #( + *) : + set x $CONFIG_FILES ;; #( + *) : + ;; +esac + shift + # Used to flag and report bootstrapping failures. + am_rc=0 + for am_mf + do + # Strip MF so we end up with the name of the file. + am_mf=`$as_echo "$am_mf" | sed -e 's/:.*$//'` + # Check whether this is an Automake generated Makefile which includes + # dependency-tracking related rules and includes. + # Grep'ing the whole file directly is not great: AIX grep has a line + # limit of 2048, but all sed's we know have understand at least 4000. + sed -n 's,^am--depfiles:.*,X,p' "$am_mf" | grep X >/dev/null 2>&1 \ + || continue + am_dirpart=`$as_dirname -- "$am_mf" || +$as_expr X"$am_mf" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$am_mf" : 'X\(//\)[^/]' \| \ + X"$am_mf" : 'X\(//\)$' \| \ + X"$am_mf" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$am_mf" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + am_filepart=`$as_basename -- "$am_mf" || +$as_expr X/"$am_mf" : '.*/\([^/][^/]*\)/*$' \| \ + X"$am_mf" : 'X\(//\)$' \| \ + X"$am_mf" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$am_mf" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + { echo "$as_me:$LINENO: cd "$am_dirpart" \ + && sed -e '/# am--include-marker/d' "$am_filepart" \ + | $MAKE -f - am--depfiles" >&5 + (cd "$am_dirpart" \ + && sed -e '/# am--include-marker/d' "$am_filepart" \ + | $MAKE -f - am--depfiles) >&5 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } || am_rc=$? + done + if test $am_rc -ne 0; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "Something went wrong bootstrapping makefile fragments + for automatic dependency tracking. If GNU make was not used, consider + re-running the configure script with MAKE=\"gmake\" (or whatever is + necessary). You can also try re-running configure with the + '--disable-dependency-tracking' option to at least be able to build + the package (albeit without support for automatic dependency tracking). +See \`config.log' for more details" "$LINENO" 5; } + fi + { am_dirpart=; unset am_dirpart;} + { am_filepart=; unset am_filepart;} + { am_mf=; unset am_mf;} + { am_rc=; unset am_rc;} + rm -f conftest-deps.mk +} + ;; + "libtool":C) + + # See if we are running on zsh, and set the options that allow our + # commands through without removal of \ escapes. + if test -n "${ZSH_VERSION+set}"; then + setopt NO_GLOB_SUBST + fi + + cfgfile=${ofile}T + trap "$RM \"$cfgfile\"; exit 1" 1 2 15 + $RM "$cfgfile" + + cat <<_LT_EOF >> "$cfgfile" +#! $SHELL +# Generated automatically by $as_me ($PACKAGE) $VERSION +# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: +# NOTE: Changes made to this file will be lost: look at ltmain.sh. + +# Provide generalized library-building support services. +# Written by Gordon Matzigkeit, 1996 + +# Copyright (C) 2014 Free Software Foundation, Inc. +# This is free software; see the source for copying conditions. There is NO +# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +# GNU Libtool is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of of the License, or +# (at your option) any later version. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program or library that is built +# using GNU Libtool, you may include this file under the same +# distribution terms that you use for the rest of that program. +# +# GNU Libtool is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + + +# The names of the tagged configurations supported by this script. +available_tags='CXX F77 ' + +# Configured defaults for sys_lib_dlsearch_path munging. +: \${LT_SYS_LIBRARY_PATH="$configure_time_lt_sys_library_path"} + +# ### BEGIN LIBTOOL CONFIG + +# Which release of libtool.m4 was used? +macro_version=$macro_version +macro_revision=$macro_revision + +# Whether or not to build static libraries. +build_old_libs=$enable_static + +# What type of objects to build. +pic_mode=$pic_mode + +# Assembler program. +AS=$lt_AS + +# DLL creation program. +DLLTOOL=$lt_DLLTOOL + +# Object dumper program. +OBJDUMP=$lt_OBJDUMP + +# Whether or not to build shared libraries. +build_libtool_libs=$enable_shared + +# Whether or not to optimize for fast installation. +fast_install=$enable_fast_install + +# Shared archive member basename,for filename based shared library versioning on AIX. +shared_archive_member_spec=$shared_archive_member_spec + +# Shell to use when invoking shell scripts. +SHELL=$lt_SHELL + +# An echo program that protects backslashes. +ECHO=$lt_ECHO + +# The PATH separator for the build system. +PATH_SEPARATOR=$lt_PATH_SEPARATOR + +# The host system. +host_alias=$host_alias +host=$host +host_os=$host_os + +# The build system. +build_alias=$build_alias +build=$build +build_os=$build_os + +# A sed program that does not truncate output. +SED=$lt_SED + +# Sed that helps us avoid accidentally triggering echo(1) options like -n. +Xsed="\$SED -e 1s/^X//" + +# A grep program that handles long lines. +GREP=$lt_GREP + +# An ERE matcher. +EGREP=$lt_EGREP + +# A literal string matcher. +FGREP=$lt_FGREP + +# A BSD- or MS-compatible name lister. +NM=$lt_NM + +# Whether we need soft or hard links. +LN_S=$lt_LN_S + +# What is the maximum length of a command? +max_cmd_len=$max_cmd_len + +# Object file suffix (normally "o"). +objext=$ac_objext + +# Executable file suffix (normally ""). +exeext=$exeext + +# whether the shell understands "unset". +lt_unset=$lt_unset + +# turn spaces into newlines. +SP2NL=$lt_lt_SP2NL + +# turn newlines into spaces. +NL2SP=$lt_lt_NL2SP + +# convert \$build file names to \$host format. +to_host_file_cmd=$lt_cv_to_host_file_cmd + +# convert \$build files to toolchain format. +to_tool_file_cmd=$lt_cv_to_tool_file_cmd + +# Method to check whether dependent libraries are shared objects. +deplibs_check_method=$lt_deplibs_check_method + +# Command to use when deplibs_check_method = "file_magic". +file_magic_cmd=$lt_file_magic_cmd + +# How to find potential files when deplibs_check_method = "file_magic". +file_magic_glob=$lt_file_magic_glob + +# Find potential files using nocaseglob when deplibs_check_method = "file_magic". +want_nocaseglob=$lt_want_nocaseglob + +# Command to associate shared and link libraries. +sharedlib_from_linklib_cmd=$lt_sharedlib_from_linklib_cmd + +# The archiver. +AR=$lt_AR + +# Flags to create an archive. +AR_FLAGS=$lt_AR_FLAGS + +# How to feed a file listing to the archiver. +archiver_list_spec=$lt_archiver_list_spec + +# A symbol stripping program. +STRIP=$lt_STRIP + +# Commands used to install an old-style archive. +RANLIB=$lt_RANLIB +old_postinstall_cmds=$lt_old_postinstall_cmds +old_postuninstall_cmds=$lt_old_postuninstall_cmds + +# Whether to use a lock for old archive extraction. +lock_old_archive_extraction=$lock_old_archive_extraction + +# A C compiler. +LTCC=$lt_CC + +# LTCC compiler flags. +LTCFLAGS=$lt_CFLAGS + +# Take the output of nm and produce a listing of raw symbols and C names. +global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe + +# Transform the output of nm in a proper C declaration. +global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl + +# Transform the output of nm into a list of symbols to manually relocate. +global_symbol_to_import=$lt_lt_cv_sys_global_symbol_to_import + +# Transform the output of nm in a C name address pair. +global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address + +# Transform the output of nm in a C name address pair when lib prefix is needed. +global_symbol_to_c_name_address_lib_prefix=$lt_lt_cv_sys_global_symbol_to_c_name_address_lib_prefix + +# The name lister interface. +nm_interface=$lt_lt_cv_nm_interface + +# Specify filename containing input files for \$NM. +nm_file_list_spec=$lt_nm_file_list_spec + +# The root where to search for dependent libraries,and where our libraries should be installed. +lt_sysroot=$lt_sysroot + +# Command to truncate a binary pipe. +lt_truncate_bin=$lt_lt_cv_truncate_bin + +# The name of the directory that contains temporary libtool files. +objdir=$objdir + +# Used to examine libraries when file_magic_cmd begins with "file". +MAGIC_CMD=$MAGIC_CMD + +# Must we lock files when doing compilation? +need_locks=$lt_need_locks + +# Manifest tool. +MANIFEST_TOOL=$lt_MANIFEST_TOOL + +# Tool to manipulate archived DWARF debug symbol files on Mac OS X. +DSYMUTIL=$lt_DSYMUTIL + +# Tool to change global to local symbols on Mac OS X. +NMEDIT=$lt_NMEDIT + +# Tool to manipulate fat objects and archives on Mac OS X. +LIPO=$lt_LIPO + +# ldd/readelf like tool for Mach-O binaries on Mac OS X. +OTOOL=$lt_OTOOL + +# ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4. +OTOOL64=$lt_OTOOL64 + +# Old archive suffix (normally "a"). +libext=$libext + +# Shared library suffix (normally ".so"). +shrext_cmds=$lt_shrext_cmds + +# The commands to extract the exported symbol list from a shared archive. +extract_expsyms_cmds=$lt_extract_expsyms_cmds + +# Variables whose values should be saved in libtool wrapper scripts and +# restored at link time. +variables_saved_for_relink=$lt_variables_saved_for_relink + +# Do we need the "lib" prefix for modules? +need_lib_prefix=$need_lib_prefix + +# Do we need a version for libraries? +need_version=$need_version + +# Library versioning type. +version_type=$version_type + +# Shared library runtime path variable. +runpath_var=$runpath_var + +# Shared library path variable. +shlibpath_var=$shlibpath_var + +# Is shlibpath searched before the hard-coded library search path? +shlibpath_overrides_runpath=$shlibpath_overrides_runpath + +# Format of library name prefix. +libname_spec=$lt_libname_spec + +# List of archive names. First name is the real one, the rest are links. +# The last name is the one that the linker finds with -lNAME +library_names_spec=$lt_library_names_spec + +# The coded name of the library, if different from the real name. +soname_spec=$lt_soname_spec + +# Permission mode override for installation of shared libraries. +install_override_mode=$lt_install_override_mode + +# Command to use after installation of a shared archive. +postinstall_cmds=$lt_postinstall_cmds + +# Command to use after uninstallation of a shared archive. +postuninstall_cmds=$lt_postuninstall_cmds + +# Commands used to finish a libtool library installation in a directory. +finish_cmds=$lt_finish_cmds + +# As "finish_cmds", except a single script fragment to be evaled but +# not shown. +finish_eval=$lt_finish_eval + +# Whether we should hardcode library paths into libraries. +hardcode_into_libs=$hardcode_into_libs + +# Compile-time system search path for libraries. +sys_lib_search_path_spec=$lt_sys_lib_search_path_spec + +# Detected run-time system search path for libraries. +sys_lib_dlsearch_path_spec=$lt_configure_time_dlsearch_path + +# Explicit LT_SYS_LIBRARY_PATH set during ./configure time. +configure_time_lt_sys_library_path=$lt_configure_time_lt_sys_library_path + +# Whether dlopen is supported. +dlopen_support=$enable_dlopen + +# Whether dlopen of programs is supported. +dlopen_self=$enable_dlopen_self + +# Whether dlopen of statically linked programs is supported. +dlopen_self_static=$enable_dlopen_self_static + +# Commands to strip libraries. +old_striplib=$lt_old_striplib +striplib=$lt_striplib + + +# The linker used to build libraries. +LD=$lt_LD + +# How to create reloadable object files. +reload_flag=$lt_reload_flag +reload_cmds=$lt_reload_cmds + +# Commands used to build an old-style archive. +old_archive_cmds=$lt_old_archive_cmds + +# A language specific compiler. +CC=$lt_compiler + +# Is the compiler the GNU compiler? +with_gcc=$GCC + +# Compiler flag to turn off builtin functions. +no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag + +# Additional compiler flags for building library objects. +pic_flag=$lt_lt_prog_compiler_pic + +# How to pass a linker flag through the compiler. +wl=$lt_lt_prog_compiler_wl + +# Compiler flag to prevent dynamic linking. +link_static_flag=$lt_lt_prog_compiler_static + +# Does compiler simultaneously support -c and -o options? +compiler_c_o=$lt_lt_cv_prog_compiler_c_o + +# Whether or not to add -lc for building shared libraries. +build_libtool_need_lc=$archive_cmds_need_lc + +# Whether or not to disallow shared libs when runtime libs are static. +allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes + +# Compiler flag to allow reflexive dlopens. +export_dynamic_flag_spec=$lt_export_dynamic_flag_spec + +# Compiler flag to generate shared objects directly from archives. +whole_archive_flag_spec=$lt_whole_archive_flag_spec + +# Whether the compiler copes with passing no objects directly. +compiler_needs_object=$lt_compiler_needs_object + +# Create an old-style archive from a shared archive. +old_archive_from_new_cmds=$lt_old_archive_from_new_cmds + +# Create a temporary old-style archive to link instead of a shared archive. +old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds + +# Commands used to build a shared archive. +archive_cmds=$lt_archive_cmds +archive_expsym_cmds=$lt_archive_expsym_cmds + +# Commands used to build a loadable module if different from building +# a shared archive. +module_cmds=$lt_module_cmds +module_expsym_cmds=$lt_module_expsym_cmds + +# Whether we are building with GNU ld or not. +with_gnu_ld=$lt_with_gnu_ld + +# Flag that allows shared libraries with undefined symbols to be built. +allow_undefined_flag=$lt_allow_undefined_flag + +# Flag that enforces no undefined symbols. +no_undefined_flag=$lt_no_undefined_flag + +# Flag to hardcode \$libdir into a binary during linking. +# This must work even if \$libdir does not exist +hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec + +# Whether we need a single "-rpath" flag with a separated argument. +hardcode_libdir_separator=$lt_hardcode_libdir_separator + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary. +hardcode_direct=$hardcode_direct + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary and the resulting library dependency is +# "absolute",i.e impossible to change by setting \$shlibpath_var if the +# library is relocated. +hardcode_direct_absolute=$hardcode_direct_absolute + +# Set to "yes" if using the -LDIR flag during linking hardcodes DIR +# into the resulting binary. +hardcode_minus_L=$hardcode_minus_L + +# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR +# into the resulting binary. +hardcode_shlibpath_var=$hardcode_shlibpath_var + +# Set to "yes" if building a shared library automatically hardcodes DIR +# into the library and all subsequent libraries and executables linked +# against it. +hardcode_automatic=$hardcode_automatic + +# Set to yes if linker adds runtime paths of dependent libraries +# to runtime path list. +inherit_rpath=$inherit_rpath + +# Whether libtool must link a program against all its dependency libraries. +link_all_deplibs=$link_all_deplibs + +# Set to "yes" if exported symbols are required. +always_export_symbols=$always_export_symbols + +# The commands to list exported symbols. +export_symbols_cmds=$lt_export_symbols_cmds + +# Symbols that should not be listed in the preloaded symbols. +exclude_expsyms=$lt_exclude_expsyms + +# Symbols that must always be exported. +include_expsyms=$lt_include_expsyms + +# Commands necessary for linking programs (against libraries) with templates. +prelink_cmds=$lt_prelink_cmds + +# Commands necessary for finishing linking programs. +postlink_cmds=$lt_postlink_cmds + +# Specify filename containing input files. +file_list_spec=$lt_file_list_spec + +# How to hardcode a shared library path into an executable. +hardcode_action=$hardcode_action + +# The directories searched by this compiler when creating a shared library. +compiler_lib_search_dirs=$lt_compiler_lib_search_dirs + +# Dependencies to place before and after the objects being linked to +# create a shared library. +predep_objects=$lt_predep_objects +postdep_objects=$lt_postdep_objects +predeps=$lt_predeps +postdeps=$lt_postdeps + +# The library search path used internally by the compiler when linking +# a shared library. +compiler_lib_search_path=$lt_compiler_lib_search_path + +# ### END LIBTOOL CONFIG + +_LT_EOF + + cat <<'_LT_EOF' >> "$cfgfile" + +# ### BEGIN FUNCTIONS SHARED WITH CONFIGURE + +# func_munge_path_list VARIABLE PATH +# ----------------------------------- +# VARIABLE is name of variable containing _space_ separated list of +# directories to be munged by the contents of PATH, which is string +# having a format: +# "DIR[:DIR]:" +# string "DIR[ DIR]" will be prepended to VARIABLE +# ":DIR[:DIR]" +# string "DIR[ DIR]" will be appended to VARIABLE +# "DIRP[:DIRP]::[DIRA:]DIRA" +# string "DIRP[ DIRP]" will be prepended to VARIABLE and string +# "DIRA[ DIRA]" will be appended to VARIABLE +# "DIR[:DIR]" +# VARIABLE will be replaced by "DIR[ DIR]" +func_munge_path_list () +{ + case x$2 in + x) + ;; + *:) + eval $1=\"`$ECHO $2 | $SED 's/:/ /g'` \$$1\" + ;; + x:*) + eval $1=\"\$$1 `$ECHO $2 | $SED 's/:/ /g'`\" + ;; + *::*) + eval $1=\"\$$1\ `$ECHO $2 | $SED -e 's/.*:://' -e 's/:/ /g'`\" + eval $1=\"`$ECHO $2 | $SED -e 's/::.*//' -e 's/:/ /g'`\ \$$1\" + ;; + *) + eval $1=\"`$ECHO $2 | $SED 's/:/ /g'`\" + ;; + esac +} + + +# Calculate cc_basename. Skip known compiler wrappers and cross-prefix. +func_cc_basename () +{ + for cc_temp in $*""; do + case $cc_temp in + compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; + distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; + \-*) ;; + *) break;; + esac + done + func_cc_basename_result=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"` +} + + +# ### END FUNCTIONS SHARED WITH CONFIGURE + +_LT_EOF + + case $host_os in + aix3*) + cat <<\_LT_EOF >> "$cfgfile" +# AIX sometimes has problems with the GCC collect2 program. For some +# reason, if we set the COLLECT_NAMES environment variable, the problems +# vanish in a puff of smoke. +if test set != "${COLLECT_NAMES+set}"; then + COLLECT_NAMES= + export COLLECT_NAMES +fi +_LT_EOF + ;; + esac + + +ltmain=$ac_aux_dir/ltmain.sh + + + # We use sed instead of cat because bash on DJGPP gets confused if + # if finds mixed CR/LF and LF-only lines. Since sed operates in + # text mode, it properly converts lines to CR/LF. This bash problem + # is reportedly fixed, but why not run on old versions too? + sed '$q' "$ltmain" >> "$cfgfile" \ + || (rm -f "$cfgfile"; exit 1) + + mv -f "$cfgfile" "$ofile" || + (rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile") + chmod +x "$ofile" + + + cat <<_LT_EOF >> "$ofile" + +# ### BEGIN LIBTOOL TAG CONFIG: CXX + +# The linker used to build libraries. +LD=$lt_LD_CXX + +# How to create reloadable object files. +reload_flag=$lt_reload_flag_CXX +reload_cmds=$lt_reload_cmds_CXX + +# Commands used to build an old-style archive. +old_archive_cmds=$lt_old_archive_cmds_CXX + +# A language specific compiler. +CC=$lt_compiler_CXX + +# Is the compiler the GNU compiler? +with_gcc=$GCC_CXX + +# Compiler flag to turn off builtin functions. +no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag_CXX + +# Additional compiler flags for building library objects. +pic_flag=$lt_lt_prog_compiler_pic_CXX + +# How to pass a linker flag through the compiler. +wl=$lt_lt_prog_compiler_wl_CXX + +# Compiler flag to prevent dynamic linking. +link_static_flag=$lt_lt_prog_compiler_static_CXX + +# Does compiler simultaneously support -c and -o options? +compiler_c_o=$lt_lt_cv_prog_compiler_c_o_CXX + +# Whether or not to add -lc for building shared libraries. +build_libtool_need_lc=$archive_cmds_need_lc_CXX + +# Whether or not to disallow shared libs when runtime libs are static. +allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes_CXX + +# Compiler flag to allow reflexive dlopens. +export_dynamic_flag_spec=$lt_export_dynamic_flag_spec_CXX + +# Compiler flag to generate shared objects directly from archives. +whole_archive_flag_spec=$lt_whole_archive_flag_spec_CXX + +# Whether the compiler copes with passing no objects directly. +compiler_needs_object=$lt_compiler_needs_object_CXX + +# Create an old-style archive from a shared archive. +old_archive_from_new_cmds=$lt_old_archive_from_new_cmds_CXX + +# Create a temporary old-style archive to link instead of a shared archive. +old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds_CXX + +# Commands used to build a shared archive. +archive_cmds=$lt_archive_cmds_CXX +archive_expsym_cmds=$lt_archive_expsym_cmds_CXX + +# Commands used to build a loadable module if different from building +# a shared archive. +module_cmds=$lt_module_cmds_CXX +module_expsym_cmds=$lt_module_expsym_cmds_CXX + +# Whether we are building with GNU ld or not. +with_gnu_ld=$lt_with_gnu_ld_CXX + +# Flag that allows shared libraries with undefined symbols to be built. +allow_undefined_flag=$lt_allow_undefined_flag_CXX + +# Flag that enforces no undefined symbols. +no_undefined_flag=$lt_no_undefined_flag_CXX + +# Flag to hardcode \$libdir into a binary during linking. +# This must work even if \$libdir does not exist +hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec_CXX + +# Whether we need a single "-rpath" flag with a separated argument. +hardcode_libdir_separator=$lt_hardcode_libdir_separator_CXX + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary. +hardcode_direct=$hardcode_direct_CXX + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary and the resulting library dependency is +# "absolute",i.e impossible to change by setting \$shlibpath_var if the +# library is relocated. +hardcode_direct_absolute=$hardcode_direct_absolute_CXX + +# Set to "yes" if using the -LDIR flag during linking hardcodes DIR +# into the resulting binary. +hardcode_minus_L=$hardcode_minus_L_CXX + +# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR +# into the resulting binary. +hardcode_shlibpath_var=$hardcode_shlibpath_var_CXX + +# Set to "yes" if building a shared library automatically hardcodes DIR +# into the library and all subsequent libraries and executables linked +# against it. +hardcode_automatic=$hardcode_automatic_CXX + +# Set to yes if linker adds runtime paths of dependent libraries +# to runtime path list. +inherit_rpath=$inherit_rpath_CXX + +# Whether libtool must link a program against all its dependency libraries. +link_all_deplibs=$link_all_deplibs_CXX + +# Set to "yes" if exported symbols are required. +always_export_symbols=$always_export_symbols_CXX + +# The commands to list exported symbols. +export_symbols_cmds=$lt_export_symbols_cmds_CXX + +# Symbols that should not be listed in the preloaded symbols. +exclude_expsyms=$lt_exclude_expsyms_CXX + +# Symbols that must always be exported. +include_expsyms=$lt_include_expsyms_CXX + +# Commands necessary for linking programs (against libraries) with templates. +prelink_cmds=$lt_prelink_cmds_CXX + +# Commands necessary for finishing linking programs. +postlink_cmds=$lt_postlink_cmds_CXX + +# Specify filename containing input files. +file_list_spec=$lt_file_list_spec_CXX + +# How to hardcode a shared library path into an executable. +hardcode_action=$hardcode_action_CXX + +# The directories searched by this compiler when creating a shared library. +compiler_lib_search_dirs=$lt_compiler_lib_search_dirs_CXX + +# Dependencies to place before and after the objects being linked to +# create a shared library. +predep_objects=$lt_predep_objects_CXX +postdep_objects=$lt_postdep_objects_CXX +predeps=$lt_predeps_CXX +postdeps=$lt_postdeps_CXX + +# The library search path used internally by the compiler when linking +# a shared library. +compiler_lib_search_path=$lt_compiler_lib_search_path_CXX + +# ### END LIBTOOL TAG CONFIG: CXX +_LT_EOF + + + cat <<_LT_EOF >> "$ofile" + +# ### BEGIN LIBTOOL TAG CONFIG: F77 + +# The linker used to build libraries. +LD=$lt_LD_F77 + +# How to create reloadable object files. +reload_flag=$lt_reload_flag_F77 +reload_cmds=$lt_reload_cmds_F77 + +# Commands used to build an old-style archive. +old_archive_cmds=$lt_old_archive_cmds_F77 + +# A language specific compiler. +CC=$lt_compiler_F77 + +# Is the compiler the GNU compiler? +with_gcc=$GCC_F77 + +# Compiler flag to turn off builtin functions. +no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag_F77 + +# Additional compiler flags for building library objects. +pic_flag=$lt_lt_prog_compiler_pic_F77 + +# How to pass a linker flag through the compiler. +wl=$lt_lt_prog_compiler_wl_F77 + +# Compiler flag to prevent dynamic linking. +link_static_flag=$lt_lt_prog_compiler_static_F77 + +# Does compiler simultaneously support -c and -o options? +compiler_c_o=$lt_lt_cv_prog_compiler_c_o_F77 + +# Whether or not to add -lc for building shared libraries. +build_libtool_need_lc=$archive_cmds_need_lc_F77 + +# Whether or not to disallow shared libs when runtime libs are static. +allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes_F77 + +# Compiler flag to allow reflexive dlopens. +export_dynamic_flag_spec=$lt_export_dynamic_flag_spec_F77 + +# Compiler flag to generate shared objects directly from archives. +whole_archive_flag_spec=$lt_whole_archive_flag_spec_F77 + +# Whether the compiler copes with passing no objects directly. +compiler_needs_object=$lt_compiler_needs_object_F77 + +# Create an old-style archive from a shared archive. +old_archive_from_new_cmds=$lt_old_archive_from_new_cmds_F77 + +# Create a temporary old-style archive to link instead of a shared archive. +old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds_F77 + +# Commands used to build a shared archive. +archive_cmds=$lt_archive_cmds_F77 +archive_expsym_cmds=$lt_archive_expsym_cmds_F77 + +# Commands used to build a loadable module if different from building +# a shared archive. +module_cmds=$lt_module_cmds_F77 +module_expsym_cmds=$lt_module_expsym_cmds_F77 + +# Whether we are building with GNU ld or not. +with_gnu_ld=$lt_with_gnu_ld_F77 + +# Flag that allows shared libraries with undefined symbols to be built. +allow_undefined_flag=$lt_allow_undefined_flag_F77 + +# Flag that enforces no undefined symbols. +no_undefined_flag=$lt_no_undefined_flag_F77 + +# Flag to hardcode \$libdir into a binary during linking. +# This must work even if \$libdir does not exist +hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec_F77 + +# Whether we need a single "-rpath" flag with a separated argument. +hardcode_libdir_separator=$lt_hardcode_libdir_separator_F77 + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary. +hardcode_direct=$hardcode_direct_F77 + +# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes +# DIR into the resulting binary and the resulting library dependency is +# "absolute",i.e impossible to change by setting \$shlibpath_var if the +# library is relocated. +hardcode_direct_absolute=$hardcode_direct_absolute_F77 + +# Set to "yes" if using the -LDIR flag during linking hardcodes DIR +# into the resulting binary. +hardcode_minus_L=$hardcode_minus_L_F77 + +# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR +# into the resulting binary. +hardcode_shlibpath_var=$hardcode_shlibpath_var_F77 + +# Set to "yes" if building a shared library automatically hardcodes DIR +# into the library and all subsequent libraries and executables linked +# against it. +hardcode_automatic=$hardcode_automatic_F77 + +# Set to yes if linker adds runtime paths of dependent libraries +# to runtime path list. +inherit_rpath=$inherit_rpath_F77 + +# Whether libtool must link a program against all its dependency libraries. +link_all_deplibs=$link_all_deplibs_F77 + +# Set to "yes" if exported symbols are required. +always_export_symbols=$always_export_symbols_F77 + +# The commands to list exported symbols. +export_symbols_cmds=$lt_export_symbols_cmds_F77 + +# Symbols that should not be listed in the preloaded symbols. +exclude_expsyms=$lt_exclude_expsyms_F77 + +# Symbols that must always be exported. +include_expsyms=$lt_include_expsyms_F77 + +# Commands necessary for linking programs (against libraries) with templates. +prelink_cmds=$lt_prelink_cmds_F77 + +# Commands necessary for finishing linking programs. +postlink_cmds=$lt_postlink_cmds_F77 + +# Specify filename containing input files. +file_list_spec=$lt_file_list_spec_F77 + +# How to hardcode a shared library path into an executable. +hardcode_action=$hardcode_action_F77 + +# The directories searched by this compiler when creating a shared library. +compiler_lib_search_dirs=$lt_compiler_lib_search_dirs_F77 + +# Dependencies to place before and after the objects being linked to +# create a shared library. +predep_objects=$lt_predep_objects_F77 +postdep_objects=$lt_postdep_objects_F77 +predeps=$lt_predeps_F77 +postdeps=$lt_postdeps_F77 + +# The library search path used internally by the compiler when linking +# a shared library. +compiler_lib_search_path=$lt_compiler_lib_search_path_F77 + +# ### END LIBTOOL TAG CONFIG: F77 +_LT_EOF + + ;; + "libtoolclpatch":C) sed -e '/^deplibs_check_method/s/.*/deplibs_check_method="pass_all"/g' \ + -e 's|always_export_symbols=yes|always_export_symbols=no|g' \ + -e '/func_append old_deplibs/s/\(.*\)/case $arg in *mkl_*.lib) ;; *) \1 ;; esac/g' \ + -e '/static library .deplib is not portable/a case $deplib in *mkl_*.lib) newdependency_libs="$deplib $newdependency_libs" ;; esac' \ + libtool > libtool.tmp + mv libtool.tmp libtool + chmod 755 libtool ;; + "libtoolmingwpatch":C) sed -e '/^deplibs_check_method/s/.*/deplibs_check_method="pass_all"/g' libtool > libtool.tmp + mv libtool.tmp libtool + chmod 755 libtool ;; + + esac +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: Configuration of $PACKAGE_NAME successful" >&5 +$as_echo "$as_me: Configuration of $PACKAGE_NAME successful" >&6;} + diff --git a/Ipopt-3.13.4/configure.ac b/Ipopt-3.13.4/configure.ac new file mode 100644 index 000000000..aa8969d20 --- /dev/null +++ b/Ipopt-3.13.4/configure.ac @@ -0,0 +1,597 @@ +# Copyright (C) 2004, 2011 International Business Machines and others. +# All Rights Reserved. +# This file is distributed under the Eclipse Public License. +# +# Authors: Carl Laird, Andreas Waechter IBM 2004-08-13 + +############################################################################# +# Names and other basic things # +############################################################################# + +AC_INIT([Ipopt],[3.13.5],[https://github.com/coin-or/Ipopt/issues/new],,[https://github.com/coin-or/Ipopt]) + +AC_COPYRIGHT([ +Copyright 2004, 2011 International Business Machines and others. +All Rights Reserved. +This file is part of the open source package IPOPT which is distributed +under the Eclipse Public License.]) + +# List one file in the package so that the configure script can test +# whether the package is actually there +AC_CONFIG_SRCDIR(src/Common/IpDebug.hpp) + +# Do some project-level initialization work (version numbers, ...) +AC_COIN_INITIALIZE + +############################################################################# +# Standard build tool stuff # +############################################################################# + +# Get the name of the C, C++, and Fortran compilers and appropriate compiler options. +AC_COIN_PROG_CC +AC_COIN_PROG_CXX +AC_COIN_PROG_F77 + +# If there is a Fortran compiler, then setup everything to use it, including F77_FUNC +if test -n "$F77" ; then + AC_COIN_F77_SETUP +fi + +# This is a C++ package, set the language accordingly. +#AC_LANG_PUSH(C++) + +# Initialize libtool +AC_COIN_PROG_LIBTOOL + +# set RPATH_FLAGS to the compiler link flags required to hardcode location +# of the shared objects (expanded_libdir is set somewhere in configure before) +AC_COIN_RPATH_FLAGS([$expanded_libdir]) + +# Get the C++ runtime libraries in case we want to link a static Ipopt library +# with a C or Fortran compiler +AC_COIN_CXXLIBS + +# Doxygen +AC_COIN_DOXYGEN + +# IPOPT_VERBOSITY and IPOPT_DEBUGLEVEL +AC_COIN_DEBUGLEVEL + +############################################################################# +# Dependencies # +############################################################################# + +AC_COIN_CHK_LIBM(IpoptLib) + +AC_COIN_CHK_LAPACK(IpoptLib) +if test $coin_has_lapack != yes; then + AC_MSG_ERROR([Required package LAPACK not found.]) +# AC_MSG_WARN([Compiling code without LAPACK. Certain options (e.g., quasi-Newton) will not work.]) +fi + +AC_COIN_CHK_PKG(ASL,[IpoptAmplInterfaceLib SIpoptAmplInterfaceLib],[coinasl],[build]) + +######### +# MUMPS # +######### + +AC_COIN_CHK_PKG(Mumps,[IpoptLib],[coinmumps],[build]) + +# Check whether MPI_Initialized is available +# we assume that MPI_Finalized is present if MPI_Initialized is present +AC_CHECK_FUNCS([MPI_Initialized]) + +####### +# HSL # +####### + +AC_COIN_CHK_PKG(HSL,[IpoptLib HSLLib],[coinhsl],[build]) + +have_ma28=no +if test "$coin_has_hsl" = yes ; then + AC_COIN_FINALIZE_FLAGS([HSLLib]) + AC_COIN_NAMEMANGLING([HSL],[ma27ad],[$HSLLIB_LFLAGS]) + if test "$ac_cv_hsl_namemangling" = "unknown" ; then + AC_MSG_ERROR([Provided package HSL is not working or does not contain MA27.]) + fi + + # extra check for MA28, since that decides whether we have to build IpMa28Partition.F + if test -n "$F77" ; then + AC_COIN_TRY_LINK([ma28ad],[$HSLLIB_LFLAGS],,[ + if test "$ma28ad_namemangling" != "$ac_cv_f77_mangling" ; then + AC_MSG_WARN([Name mangling of MA28 different than Fortran. This will not link. Disabling MA28]) + else + have_ma28=yes + fi + ]) + fi +fi +AM_CONDITIONAL([HAVE_MA28],[test "$have_ma28" = yes]) + +########### +# PARDISO # +########### + +AC_ARG_WITH([pardiso], + [AC_HELP_STRING([--with-pardiso],[specify Pardiso library (>= 4.0) from pardiso-project.org; use --without-pardiso to disable also MKL Pardiso check])], + [case "$withval" in + yes) have_pardiso_project=no ;; # no linker flags given; --with-pardiso[=yes] actually doesn't make sense, but we use it as signal to fall back to checking MKL + no) have_pardiso_project=no ;; # so with_pardiso=no, we use that below to skip checking MKL + *) have_pardiso_project=yes; pardiso_lflags="$withval" ;; + esac], + [have_pardiso_project=no]) + +have_pardiso_mkl=no +if test "$have_pardiso_project" = yes ; then + # check whether flags from --with-pardiso work and figure out name mangling + # if so, define IPOPT_PARDISO_FUNC and keep lflags + AC_COIN_TRY_LINK([pardiso_ipopt_newinterface],[$pardiso_lflags $lapack_lflags],[$lapack_pcfiles], + [AC_COIN_DEFINENAMEMANGLING([IPOPT_PARDISO],[$pardiso_ipopt_newinterface_namemangling]) + IPOPTLIB_LFLAGS="$pardiso_lflags $IPOPTLIB_LFLAGS" + AC_DEFINE(IPOPT_HAS_PARDISO,1,[Define to 1 if Pardiso is available]) + ], + [AC_MSG_ERROR([Symbol pardiso_ipopt_newinterface not found with Pardiso flags $pardiso_lflags and Lapack. Require Pardiso >= 4.0.])]) + + AC_COIN_TRY_LINK([pardiso_exist_parallel],[$pardiso_lflags $lapack_lflags],[$lapack_pcfiles], + [AC_DEFINE(IPOPT_HAS_PARDISO_PARALLEL,1,[Define to 1 if you are using the parallel version of Pardiso])]) + +elif test "$with_pardiso" != no ; then + # check whether Pardiso is available via Lapack, which should then be MKL + # figure out name mangling and define IPOPT_PARDISO_FUNC + AC_COIN_TRY_LINK([pardiso],[$lapack_lflags],[$lapack_pcfiles], + [AC_COIN_DEFINENAMEMANGLING([IPOPT_PARDISO],[$pardiso_namemangling]) + have_pardiso_mkl=yes + AC_DEFINE(IPOPT_HAS_PARDISO,1,[Define to 1 if Pardiso is available]) + # assume MKL Pardiso is parallel (it never has pardiso_exist_parallel) + # TODO does sequential MKL also have a parallel Pardiso? do we need some check here? + AC_DEFINE(IPOPT_HAS_PARDISO_PARALLEL,1,[Define to 1 if you are using the parallel version of Pardiso]) + AC_DEFINE(IPOPT_HAS_PARDISO_MKL,1,[Define to 1 if you are using Pardiso from MKL]) + ]) +fi + +AM_CONDITIONAL([HAVE_PARDISO],[test "$have_pardiso_mkl$have_pardiso_project" != nono]) + +######## +# WSMP # +######## + +AC_ARG_WITH([wsmp], + AC_HELP_STRING([--with-wsmp],[specify WSMP library]), + [have_wsmp=yes; wsmp_lflags=$withval], + [have_wsmp=no]) + +if test "$have_wsmp" = "yes"; then + AC_COIN_TRY_LINK([wssmp],[$wsmp_lflags],[], + [AC_COIN_DEFINENAMEMANGLING([IPOPT_WSMP],[$wssmp_namemangling]) + IPOPTLIB_LFLAGS="$wsmp_lflags $IPOPTLIB_LFLAGS" + AC_DEFINE(IPOPT_HAS_WSMP,1,[Define to 1 if WSMP is available]) + ], + [AC_MSG_ERROR([Symbol wssmp not found with WSMP flags $wsmp_lflags.])]) +fi + +AM_CONDITIONAL([HAVE_WSMP],[test $have_wsmp = yes]) + +############################################################################# +# Stuff for examples # +############################################################################# + +# find out how long an int pointer is to know if we need INTEGER*4 or +# INTEGER*8 in Fortran to capture pointers. +AC_LANG_PUSH(C) +AC_CHECK_SIZEOF(int *) +AC_LANG_POP(C) +AC_SUBST(BITS_PER_POINTER) +AC_SUBST(BIT32FCOMMENT) +AC_SUBST(BIT64FCOMMENT) +case "$ac_cv_sizeof_int_p" in + 4 | 4?) BITS_PER_POINTER=32 + BIT32FCOMMENT='' + BIT64FCOMMENT='C' ;; + 8 | 8?) BITS_PER_POINTER=64 + BIT32FCOMMENT='C' + BIT64FCOMMENT='' ;; + *) AC_MSG_ERROR([Unknown length of int *]);; +esac + +############################################################################ +############################################################################ +# Stuff that we need for C++ programs # +############################################################################ +############################################################################ + +AC_LANG_PUSH(C++) + +##################### +# Function isfinite # +##################### + +AC_COIN_CHECK_ISFINITE + +########### +# va_copy # +########### + +AC_CHECK_DECL([va_copy],[AC_DEFINE([IPOPT_HAS_VA_COPY],[1], + [Define to 1 if va_copy is available])],,[#include ]) + +########################### +# Random number generator # +########################### + +AC_CHECK_DECL([drand48],[AC_DEFINE([IPOPT_HAS_DRAND48],[1], + [Define to 1 if function drand48 is available])],,[#include ]) + +AC_CHECK_DECL([rand],[AC_DEFINE([IPOPT_HAS_RAND],[1], + [Define to 1 if function rand is available])],,[#include ]) + +AC_COIN_CHECK_NAMESPACE_DECL([std::srand],[1], + [AC_DEFINE([IPOPT_HAS_STD__RAND],[1],[Define to 1 if function std::rand is available])],[], + [#include ]) + +########################################################################## + +################################################### +# Check if user wants inexact algorithm available # +################################################### + +AC_ARG_ENABLE([inexact-solver], + [AC_HELP_STRING([--enable-inexact-solver], + [enable inexact linear solver version EXPERIMENTAL! (default: no)])], + [case "$enableval" in + no | yes) ;; + *) + AC_MSG_ERROR([invalid argument for --enable-inexact-solver: $enableval]);; + esac + use_inexact=$enableval], + [use_inexact=no]) + +if test $use_inexact = yes; then + if test $have_pardiso_project = no; then + AC_MSG_ERROR([The inexact solver option is currently only available with Pardiso from pardiso-project.org]) + fi + AC_DEFINE([BUILD_INEXACT],[1],[Define to 1 if the inexact linear solver option is included]) +fi +AM_CONDITIONAL([BUILD_INEXACT], [test $use_inexact = yes]) + +AC_LANG_POP(C++) + +###################################### +# Equivalent int Fortran and C types # +###################################### + +# FIXME: The following test should be active, but this requires change in +# code to copy Index* to ipfint* arrays... +if test "$cross_compiling" = no && test "$is_bg" != yes; then + AC_LANG_PUSH(C) + AC_DEFINE([IPOPT_FORTRAN_INTEGER_TYPE],[int],[Define to the C type corresponding to Fortran INTEGER]) +# AC_CHECK_SIZEOF([long]) +# AC_CHECK_SIZEOF([int]) +# AC_CHECK_SIZEOF([double]) +# AC_MSG_CHECKING([for C type corresponding to Fortran INTEGER]) +# if test $ac_cv_sizeof_long = $ac_cv_sizeof_double; then +# AC_DEFINE([IPOPT_FORTRAN_INTEGER_TYPE],[int],[Define to the C type corresponding to Fortran INTEGER]) +# AC_MSG_RESULT([int]) +# else +# AC_DEFINE([IPOPT_FORTRAN_INTEGER_TYPE],[long]) +# AC_MSG_RESULT([long]) +# fi + AC_LANG_POP(C) +else + AC_MSG_WARN([We are cross compiling, assuming Fortran 'INTEGER' type corresponds to C 'int' type]) + AC_DEFINE([IPOPT_FORTRAN_INTEGER_TYPE],[int]) +fi + +############# JAVA + +AC_ARG_ENABLE([java], + [AC_HELP_STRING([--disable-java],[disable building of Java interface])], + [enable_java="$enableval"], + [case "$JAVA_HOME" in + *\ * ) enable_java=no ;; # do not enable java-check by default, if there are spaces in JAVA_HOME - that causes trouble + * ) enable_java="$enable_shared" ;; + esac + ]) + +if test "$enable_java" != no ; then + # look for javac: required to compile Java code and build C-header + # this is a modified version of AX_PROG_JAVAC + m4_define([m4_ax_prog_javac_list],["gcj -C" guavac jikes javac])dnl + AS_IF([test "x$JAVAPREFIX" = x], + [test "x$JAVAC" = x && AC_CHECK_PROGS([JAVAC], [m4_ax_prog_javac_list])], + [test "x$JAVAC" = x && AC_CHECK_PROGS([JAVAC], [m4_ax_prog_javac_list], [], [$JAVAPREFIX/bin])]) + m4_undefine([m4_ax_prog_javac_list])dnl + + if test -z "$JAVAC" ; then + AC_MSG_NOTICE([No JAVA compiler. Disabling build of Java interface.]) + enable_java=no + else + AX_PROG_JAVAC_WORKS + fi +fi + +if test "$enable_java" != no ; then + AC_MSG_CHECKING([if javac supports -h]) + echo "public abstract class conftest { private native boolean test(); }" > conftest.java + $as_echo "$as_me:${as_lineno-$LINENO}: $JAVAC conftest.java -h conftest.header" >&AS_MESSAGE_LOG_FD + "$JAVAC" conftest.java -h conftest.header >&AS_MESSAGE_LOG_FD + if test -e conftest.header/conftest.h ; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.java >&AS_MESSAGE_LOG_FD + enable_java=no + fi +fi + +if test "$enable_java" != no ; then + # look for jni header: required to compile C++ part of Java interface + AX_JNI_INCLUDE_DIR + if test -z "$JNI_INCLUDE_DIRS" ; then + AC_MSG_NOTICE([No JNI header directory. Disabling build of Java interface.]) + enable_java=no + else + for JNI_INCLUDE_DIR in $JNI_INCLUDE_DIRS ; do + CPPFLAGS="$CPPFLAGS -I$JNI_INCLUDE_DIR" + done + fi +fi + +if test "$enable_java" != no ; then + # the following macros can make configure stop with an error + # we could work around that, but having javac and no jar, java, or javadoc would be odd anyway + + # look for jar: required to pack Java interface + AX_PROG_JAR + # look for more java to run tests and examples and do documentation + AX_PROG_JAVA + AX_PROG_JAVADOC +fi + +AM_CONDITIONAL([BUILD_JAVA], [test "$enable_java" != no]) + +######################### +# Makefile conditionals # +######################### + +# The following variable collects the names of libraries that should +# be included into libipopt.a (relative to subdir Interfaces, where it +# is made) + +AC_SUBST(IPALLLIBS) +IPALLLIBS="../contrib/CGPenalty/libcgpenalty.la ../Algorithm/libipoptalg.la ../Algorithm/LinearSolvers/liblinsolvers.la ../Common/libcommon.la ../LinAlg/liblinalg.la ../LinAlg/TMatrices/libtmatrices.la" + +AM_CONDITIONAL([BUILD_INEXACT], [test $use_inexact = yes]) +if test $use_inexact = yes; then + IPALLLIBS="../Algorithm/Inexact/libinexact.la $IPALLLIBS" +fi + +######################################################################## +## Linear solver loader ## +######################################################################## + +AC_ARG_ENABLE([linear-solver-loader], + [AC_HELP_STRING([--disable-linear-solver-loader],[disable build of linear solver loader])], + [case "$enableval" in + no | yes) ;; + *) + AC_MSG_ERROR([invalid argument for --enable-linear-solver-loader: $enableval]);; + esac + use_linearsolverloader=$enableval], + [use_linearsolverloader=yes]) + +AC_MSG_CHECKING([whether the linear solver loader should be compiled]) +AC_MSG_RESULT([$use_linearsolverloader]) + +if test $use_linearsolverloader = yes; then + AC_DEFINE([IPOPT_HAS_LINEARSOLVERLOADER],[1], + [Define to 1 if the linear solver loader should be compiled to allow dynamic loading of shared libraries with linear solvers]) + IPALLLIBS="../contrib/LinearSolverLoader/libLinearSolverLoader.la $IPALLLIBS" +fi + +AM_CONDITIONAL([BUILD_LINEARSOLVERLOADER],[test $use_linearsolverloader = yes]) + +AC_LANG_PUSH(C) +AC_CHECK_HEADER([windows.h],AC_DEFINE(HAVE_WINDOWS_H,[1],[Define to 1 if windows.h is available.])) +AC_CHECK_LIB(dl,[dlopen],[IPOPTLIB_LFLAGS="$IPOPTLIB_LFLAGS -ldl"],[]) +AC_CHECK_FUNCS([snprintf _snprintf],[break]) +AC_CHECK_FUNCS([vsnprintf _vsnprintf],[break]) +AC_LANG_POP(C) + +######################################################################## +## sIpopt ## +######################################################################## + +AC_ARG_ENABLE([sipopt], + [AC_HELP_STRING([--disable-sipopt],[disable build of sIpopt])], + [case "$enableval" in + no | yes) ;; + *) + AC_MSG_ERROR([invalid argument for --enable-sipopt: $enableval]);; + esac + use_sipopt=$enableval], + [use_sipopt=yes]) +AM_CONDITIONAL(BUILD_SIPOPT, [test "$use_sipopt" = yes]) + +######################################################################## +## Create links for the test source files ## +######################################################################## + +AC_CONFIG_LINKS([test/hs071_main.cpp:examples/hs071_cpp/hs071_main.cpp + test/hs071_nlp.cpp:examples/hs071_cpp/hs071_nlp.cpp + test/hs071_nlp.hpp:examples/hs071_cpp/hs071_nlp.hpp + test/hs071_c.c:examples/hs071_c/hs071_c.c]) + +if test "$use_sipopt" = yes ; then +AC_CONFIG_LINKS([test/parametric_driver.cpp:contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp + test/parametricTNLP.cpp:contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp + test/MySensTNLP.cpp:contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp + test/redhess_cpp.cpp:contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp]) +fi + +######################################################################## +## Create links for VPATH config of certain files ## +######################################################################## + +AC_COIN_VPATH_LINK(contrib/RInterface/DESCRIPTION) +AC_COIN_VPATH_LINK(contrib/RInterface/NAMESPACE) +AC_COIN_VPATH_LINK(contrib/RInterface/inst/CITATION) +AC_COIN_VPATH_LINK(contrib/RInterface/inst/doc/ipoptr.Rnw) +AC_COIN_VPATH_LINK(contrib/RInterface/inst/doc/ipoptr.pdf) +AC_COIN_VPATH_LINK(contrib/RInterface/inst/doc/reflist.bib) +AC_COIN_VPATH_LINK(contrib/RInterface/man/ipoptr-package.Rd) +AC_COIN_VPATH_LINK(contrib/RInterface/man/ipoptr.Rd) +AC_COIN_VPATH_LINK(contrib/RInterface/man/is.ipoptr.Rd) +AC_COIN_VPATH_LINK(contrib/RInterface/man/make.sparse.Rd) +AC_COIN_VPATH_LINK(contrib/RInterface/man/plot.sparseness.Rd) +AC_COIN_VPATH_LINK(contrib/RInterface/man/print.ipoptr.Rd) +AC_COIN_VPATH_LINK(contrib/RInterface/man/print.sparseness.Rd) +AC_COIN_VPATH_LINK(contrib/RInterface/R/get.option.types.R) +AC_COIN_VPATH_LINK(contrib/RInterface/R/ipoptr.R) +AC_COIN_VPATH_LINK(contrib/RInterface/R/is.ipoptr.R) +AC_COIN_VPATH_LINK(contrib/RInterface/R/make.sparse.R) +AC_COIN_VPATH_LINK(contrib/RInterface/R/plot.sparseness.R) +AC_COIN_VPATH_LINK(contrib/RInterface/R/print.ipoptr.R) +AC_COIN_VPATH_LINK(contrib/RInterface/R/print.sparseness.R) +AC_COIN_VPATH_LINK(contrib/RInterface/tests/approx_banana.R) +AC_COIN_VPATH_LINK(contrib/RInterface/tests/banana.R) +AC_COIN_VPATH_LINK(contrib/RInterface/tests/hs071_nlp.R) +AC_COIN_VPATH_LINK(contrib/RInterface/tests/lasso.R) +AC_COIN_VPATH_LINK(contrib/RInterface/tests/mynlp.R) +AC_COIN_VPATH_LINK(contrib/RInterface/tests/parameters.R) +AC_COIN_VPATH_LINK(contrib/RInterface/tests/sparseness.R) +AC_COIN_VPATH_LINK(contrib/RInterface/src/ipoptr.cpp) +AC_COIN_VPATH_LINK(contrib/RInterface/src/IpoptRJournal.cpp) +AC_COIN_VPATH_LINK(contrib/RInterface/src/IpoptRNLP.cpp) + +AC_COIN_VPATH_LINK(examples/Cpp_example/cpp_example.cpp) +AC_COIN_VPATH_LINK(examples/Cpp_example/MyNLP.cpp) +AC_COIN_VPATH_LINK(examples/Cpp_example/MyNLP.hpp) +AC_COIN_VPATH_LINK(examples/hs071_cpp/hs071_main.cpp) +AC_COIN_VPATH_LINK(examples/hs071_cpp/hs071_nlp.cpp) +AC_COIN_VPATH_LINK(examples/hs071_cpp/hs071_nlp.hpp) +AC_COIN_VPATH_LINK(examples/hs071_c/hs071_c.c) +if test "$enable_java" != no ; then + AC_COIN_VPATH_LINK(examples/hs071_java/HS071.java) +fi + +AC_COIN_VPATH_LINK(tutorial/AmplExperiments/hs71.mod) +AC_COIN_VPATH_LINK(tutorial/AmplExperiments/infeasible.mod) +AC_COIN_VPATH_LINK(tutorial/AmplExperiments/MoreAmplModels.txt) +AC_COIN_VPATH_LINK(tutorial/AmplExperiments/car1.run) +AC_COIN_VPATH_LINK(tutorial/AmplExperiments/car1.gp) + +AC_COIN_VPATH_LINK(tutorial/Modeling/bad1.mod) +AC_COIN_VPATH_LINK(tutorial/Modeling/bad1-fix1.mod) +AC_COIN_VPATH_LINK(tutorial/Modeling/bad1-fix2.mod) + +AC_COIN_VPATH_LINK(tutorial/CodingExercise/exercise_example.mod) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/C/1-skeleton/TutorialC.c) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/C/2-mistake/TutorialC.c) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/C/3-solution/TutorialC.c) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_main.cpp) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.hpp) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/Cpp/1-skeleton/TutorialCpp_nlp.cpp) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_main.cpp) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.hpp) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/Cpp/2-mistake/TutorialCpp_nlp.cpp) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_main.cpp) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.hpp) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/Cpp/3-solution/TutorialCpp_nlp.cpp) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/Matlab/1-skeleton/TutorialMatlab.m) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/Matlab/2-mistake/TutorialMatlab.m) +AC_COIN_VPATH_LINK(tutorial/CodingExercise/Matlab/3-solution/TutorialMatlab.m) + +if test "$use_sipopt" = yes ; then + AC_COIN_VPATH_LINK(contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp) + AC_COIN_VPATH_LINK(contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp) + AC_COIN_VPATH_LINK(contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.hpp) + AC_COIN_VPATH_LINK(contrib/sIPOPT/examples/parametric_dsdp_cpp/parametric_dsdp_driver.cpp) + AC_COIN_VPATH_LINK(contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.cpp) + AC_COIN_VPATH_LINK(contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.hpp) + AC_COIN_VPATH_LINK(contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp) + AC_COIN_VPATH_LINK(contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.hpp) + AC_COIN_VPATH_LINK(contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp) +fi + +######################################################################## +## Create Makefiles and other stuff ## +######################################################################## + +AC_COIN_FINALIZE_FLAGS([IpoptLib IpoptAmplInterfaceLib SIpoptAmplInterfaceLib]) + +AC_CONFIG_FILES([Makefile + src/Common/Makefile + src/LinAlg/Makefile + src/LinAlg/TMatrices/Makefile + src/Interfaces/Makefile + src/Algorithm/Makefile + src/Algorithm/LinearSolvers/Makefile + src/Algorithm/Inexact/Makefile + src/contrib/CGPenalty/Makefile + src/contrib/LinearSolverLoader/Makefile + src/Apps/Makefile + src/Apps/AmplSolver/Makefile + test/Makefile + test/run_unitTests + ipopt.pc + doc/Doxyfile + examples/Cpp_example/Makefile + examples/recursive_nlp/Makefile + examples/hs071_cpp/Makefile + examples/hs071_c/Makefile + examples/ScalableProblems/Makefile + tutorial/CodingExercise/C/1-skeleton/Makefile + tutorial/CodingExercise/C/2-mistake/Makefile + tutorial/CodingExercise/C/3-solution/Makefile + tutorial/CodingExercise/Cpp/1-skeleton/Makefile + tutorial/CodingExercise/Cpp/2-mistake/Makefile + tutorial/CodingExercise/Cpp/3-solution/Makefile + tutorial/CodingExercise/Matlab/1-skeleton/startup.m + tutorial/CodingExercise/Matlab/2-mistake/startup.m + tutorial/CodingExercise/Matlab/3-solution/startup.m +]) + +if test -n "$F77" ; then + AC_CONFIG_FILES([examples/hs071_f/hs071_f.f examples/hs071_f/Makefile + tutorial/CodingExercise/Fortran/1-skeleton/TutorialFortran.f + tutorial/CodingExercise/Fortran/2-mistake/TutorialFortran.f + tutorial/CodingExercise/Fortran/3-solution/TutorialFortran.f + tutorial/CodingExercise/Fortran/1-skeleton/Makefile + tutorial/CodingExercise/Fortran/2-mistake/Makefile + tutorial/CodingExercise/Fortran/3-solution/Makefile]) +fi + +if test "$enable_java" != no ; then + AC_CONFIG_FILES([examples/hs071_java/Makefile examples/ScalableProblems_java/Makefile]) +fi + +if test "$use_sipopt" = yes ; then + AC_CONFIG_FILES([ + contrib/sIPOPT/Makefile + contrib/sIPOPT/src/Makefile + contrib/sIPOPT/AmplSolver/Makefile + contrib/sIPOPT/examples/parametric_cpp/Makefile + contrib/sIPOPT/examples/parametric_dsdp_cpp/Makefile + contrib/sIPOPT/examples/redhess_cpp/Makefile + ]) +fi + + +# under Windows, the Makevars file for the R Interface need to be named Makevars.win +case $build in + *-cygwin* | *-mingw* | *-msys* ) + AC_CONFIG_FILES([contrib/RInterface/src/Makevars.win:contrib/RInterface/src/Makevars.in]) + ;; + *) + AC_CONFIG_FILES([contrib/RInterface/src/Makevars]) + ;; +esac + +if test $coin_has_asl = yes ; then + AC_CONFIG_FILES([ipoptamplinterface.pc:src/Apps/AmplSolver/ipoptamplinterface.pc.in]) +fi + +AC_CONFIG_HEADER([src/Common/config.h src/Common/config_ipopt.h]) + +AC_COIN_FINALIZE diff --git a/Ipopt-3.13.4/contrib/RInterface/CHANGELOG b/Ipopt-3.13.4/contrib/RInterface/CHANGELOG new file mode 100644 index 000000000..c2071459e --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/CHANGELOG @@ -0,0 +1,22 @@ +09 March 2012, version 0.8.4: + + * Included additional variables to the object that is returned from ipoptr (thanks to Michael Schedl). These are: + z_L : final values for the lower bound multipliers + z_U : final values for the upper bound multipliers + constraints : final values for the constraints + lambda : final values for the Lagrange mulipliers + After solving the NLP using + R> res <- ipoptr( ... ) + They can be accessed using + R> res$z_L + R> res$z_U + R> res$constraints + R> res$lambda + + * Removed ipoptr_environment as argument in ipoptr because it wasn't useful and it caused undesired behaviour in + combination with the data.table package (thanks to Florian Oswald for reporting). + +20 November 2011, version 0.8.3: + + * Added #include to src/IpoptRNLP.hpp + diff --git a/Ipopt-3.13.4/contrib/RInterface/DESCRIPTION b/Ipopt-3.13.4/contrib/RInterface/DESCRIPTION new file mode 100644 index 000000000..06a449e1f --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/DESCRIPTION @@ -0,0 +1,9 @@ +Package: ipoptr +Type: Package +Title: R interface to Ipopt +Version: 0.8.4 +Date: 2011-03-09 +Author: Jelmer Ypma +Maintainer: Jelmer Ypma +Description: ipoptr is an R interface to Ipopt (Interior Point Optimizer), an open source software package for large-scale nonlinear optimization. It can be used to solve general nonlinear programming problems with nonlinear constraints and lower and upper bounds for the controls. Ipopt is written in C++ and is released as open source code under the Eclipse Public License (EPL). It is available from the COIN-OR initiative. The code has been written by Carl Laird and Andreas Waechter, who is the COIN project leader for Ipopt. +License: EPL diff --git a/Ipopt-3.13.4/contrib/RInterface/NAMESPACE b/Ipopt-3.13.4/contrib/RInterface/NAMESPACE new file mode 100644 index 000000000..eb42a75e0 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/NAMESPACE @@ -0,0 +1,3 @@ +useDynLib(ipoptr, IpoptRSolve) +export(ipoptr, is.ipoptr, print.sparseness, plot.sparseness, make.sparse) +S3method(print, ipoptr) diff --git a/Ipopt-3.13.4/contrib/RInterface/R/get.option.types.R b/Ipopt-3.13.4/contrib/RInterface/R/get.option.types.R new file mode 100644 index 000000000..270b224ef --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/R/get.option.types.R @@ -0,0 +1,217 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: get.option.types.R +# Author: Jelmer Ypma +# Date: 18 April 2010 +# +# This function converts a list with ipopt options into +# three sub-lists, where the options are sorted into +# the different value types (integer, numeric, string). +# +# Input: list of ipopt options and their values +# Output: list containing three sub-lists by type with ipopt options and their values + +get.option.types <- function(opts) { + + # define types of ipopt options + ipopt.option.types <- list( + + # Output + "print_level"="integer", + "print_user_options"="string", + "print_options_documentation"="string", + "output_file"="string", + "file_print_level"="integer", + "option_file_name"="string", + + # Termination + "tol"="numeric", + "max_iter"="integer", + "max_cpu_time"="numeric", + "dual_inf_tol"="numeric", + "constr_viol_tol"="numeric", + "compl_inf_tol"="numeric", + "acceptable_tol"="numeric", + "acceptable_iter"="integer", + "acceptable_constr_viol_tol"="numeric", + "acceptable_dual_inf_tol"="numeric", + "acceptable_compl_inf_tol"="numeric", + "acceptable_obj_change_tol"="numeric", + "diverging_iterates_tol"="numeric", + + # NLP Scaling + "obj_scaling_factor"="numeric", + "nlp_scaling_method"="string", + "nlp_scaling_max_gradient"="numeric", + + # NLP + "bound_relax_factor"="numeric", + "honor_original_bounds"="string", + "check_derivatives_for_naninf"="string", + "nlp_lower_bound_inf"="numeric", + "nlp_upper_bound_inf"="numeric", + "fixed_variable_treatment"="string", + "jac_c_constant"="string", + "jac_d_constant"="string", + "hessian_constant"="string", + + # Initialization + "bound_frac"="numeric", + "bound_push"="numeric", + "slack_bound_frac"="numeric", + "slack_bound_push"="numeric", + "bound_mult_init_val"="numeric", + "constr_mult_init_max"="numeric", + "bound_mult_init_method"="string", + + # Barrier Parameter + "mehrotra_algorithm"="string", + "mu_strategy"="string", + "mu_oracle"="string", + "quality_function_max_section_steps"="integer", + "fixed_mu_oracle"="string", + "mu_init"="numeric", + "mu_max_fact"="numeric", + "mu_max"="numeric", + "mu_min"="numeric", + "barrier_tol_factor"="numeric", + "mu_linear_decrease_factor"="numeric", + "mu_superlinear_decrease_power"="numeric", + + # Multiplier Updates + "alpha_for_y"="string", + "alpha_for_y_tol"="numeric", + "recalc_y"="string", + "recalc_y_feas_tol"="numeric", + + # Line Search + "max_soc"="integer", + "watchdog_shortened_iter_trigger"="integer", + "watchdog_trial_iter_max"="integer", + "accept_every_trial_step"="string", + "corrector_type"="string", + + # Warm Start + "warm_start_init_point"="string", + "warm_start_bound_push"="numeric", + "warm_start_bound_frac"="numeric", + "warm_start_slack_bound_frac"="numeric", + "warm_start_slack_bound_push"="numeric", + "warm_start_mult_bound_push"="numeric", + "warm_start_mult_init_max"="numeric", + + # Restoration Phase + "expect_infeasible_problem"="string", + "expect_infeasible_problem_ctol"="numeric", + "expect_infeasible_problem_ytol"="numeric", + "start_with_resto"="string", + "soft_resto_pderror_reduction_factor"="numeric", + "required_infeasibility_reduction"="numeric", + "bound_mult_reset_threshold"="numeric", + "constr_mult_reset_threshold"="numeric", + "evaluate_orig_obj_at_resto_trial"="string", + + # Linear Solver + "linear_solver"="string", + "linear_system_scaling"="string", + "linear_scaling_on_demand"="string", + "max_refinement_steps"="integer", + "min_refinement_steps"="integer", + + # Hessian Perturbation + "max_hessian_perturbation"="numeric", + "min_hessian_perturbation"="numeric", + "first_hessian_perturbation"="numeric", + "perturb_inc_fact_first"="numeric", + "perturb_inc_fact"="numeric", + "perturb_dec_fact"="numeric", + "jacobian_regularization_value"="numeric", + + # Quasi-Newton + "hessian_approximation"="string", + "limited_memory_max_history"="integer", + "limited_memory_max_skipping"="integer", + + # Derivative Test + "derivative_test"="string", + "derivative_test_perturbation"="numeric", + "derivative_test_tol"="numeric", + "derivative_test_print_all"="string", + "point_perturbation_radius"="numeric", + + # MA27 Linear Solver + "ma27_pivtol"="numeric", + "ma27_pivtolmax"="numeric", + "ma27_liw_init_factor"="numeric", + "ma27_la_init_factor"="numeric", + "ma27_meminc_factor"="numeric", + + # MA57 Linear Solver + "ma57_pivtol"="numeric", + "ma57_pivtolmax"="numeric", + "ma57_pre_alloc"="numeric", + "ma57_pivot_order"="integer", + + # MUMPS Linear Solver + "mumps_pivtol"="numeric", + "mumps_pivtolmax"="numeric", + "mumps_mem_percent"="integer", + "mumps_permuting_scaling"="integer", + "mumps_pivot_order"="integer", + "mumps_scaling"="integer", + + # Pardis"Linear Solver + "pardiso_msglvl"="integer", + "pardiso_matching_strategy"="string", + "pardiso_out_of_core_power"="integer", + + # WSMP Linear Solver + "wsmp_num_threads"="integer", + "wsmp_ordering_option"="integer", + "wsmp_pivtol"="numeric", + "wsmp_pivtolmax"="numeric", + "wsmp_scaling"="integer", + "wsmp_singularity_threshold"="numeric" + ) + + + + # initialize list with options sorted by type + converted.opts <- list( "integer"=list(), "string"=list(), "numeric"=list() ) + + is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol + + # check if we have at least 1 element in the list, otherwise the + # loop runs from 1 to down 0 and we get errors + if ( length( opts ) > 0 ) { + + # loop over all options and give them the correct type + for ( i in 1:length( opts ) ) { + tmp.type <- ipopt.option.types[[match( names(opts)[i], names(ipopt.option.types) )]] + if ( is.null( tmp.type ) ) { + # determine type + if ( is.character(opts[[i]]) ) { + tmp.type <- "string" + } else if ( is.wholenumber(opts[[i]]) ) { + tmp.type <- "integer" + } else { + tmp.type <- "numeric" + } + cat( paste( "Warning: ", names(opts)[i], " is not a recognized option, we try to pass it to Ipopt as ", tmp.type, "\n" ) ) + } + + if ( tmp.type=="string" ) { + converted.opts$string[[ names(opts)[i] ]] <- as.character(opts[[i]]) + } else if ( tmp.type=="integer" ) { + converted.opts$integer[[ names(opts)[i] ]] <- as.integer(opts[[i]]) + } else if ( tmp.type=="numeric" ) { + converted.opts$numeric[[ names(opts)[i] ]] <- as.numeric(opts[[i]]) + } else { + stop(paste("Type of option ", names(opts)[i], " not recognized")) + } + } + } + + return ( converted.opts ) +} diff --git a/Ipopt-3.13.4/contrib/RInterface/R/ipoptr.R b/Ipopt-3.13.4/contrib/RInterface/R/ipoptr.R new file mode 100644 index 000000000..dd7e89dd5 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/R/ipoptr.R @@ -0,0 +1,169 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: ipoptr.R +# Author: Jelmer Ypma +# Date: 18 April 2010 +# +# Changelog: +# 09/03/2012: Added outputs, z_L, z_U, constraints, lambda (thanks to Michael Schedl) +# 09/03/2012: Removed ipoptr_environment because this caused a bug in combination with +# data.table and it wasn't useful (thanks to Florian Oswald for reporting) +# +# Input: +# x0 : vector with initial values +# eval_f : function to evaluate objective function +# eval_grad_f : function to evaluate gradient of objective function +# lb : lower bounds of the control +# ub : upper bounds of the control +# eval_g : function to evaluate (non-)linear constraints that should hold in the solution +# eval_jac_g : function to evaluate the jacobian of the (non-)linear constraints that should hold in the solution +# eval_jac_g_structure : sparseness structure of the jacobian +# constraint_lb : lower bounds of the (non-)linear constraints +# constraint_ub : upper bounds of the (non-)linear constraints +# eval_h : function to evaluate the hessian +# eval_h_structure : sparseness structure of the hessian +# opts : list with options that are passed to Ipopt +# ... : arguments that will be passed to user-defined functions +# +# Output: structure with inputs and +# call : the call that was made to solve +# status : integer value with the status of the optimization (0 is success) +# message : more informative message with the status of the optimization +# iterations : number of iterations that were executed +# objective : final value of the objective function +# solution : final values for the controls +# z_L : final values for the lower bound multipliers +# z_U : final values for the upper bound multipliers +# constraints : final values for the constraints +# lambda : final values for the Lagrange mulipliers + +ipoptr <- +function( x0, + eval_f, + eval_grad_f, + lb = NULL, + ub = NULL, + eval_g = function( x ) { return( numeric(0) ) }, + eval_jac_g = function( x ) { return( numeric(0) ) }, + eval_jac_g_structure = list(), + constraint_lb = numeric(0), + constraint_ub = numeric(0), + eval_h = NULL, + eval_h_structure = NULL, + opts = list(), + ... ) { + + # define 'infinite' lower and upper bounds of the control if they haven't been set + if ( is.null( lb ) ) { lb <- rep( -Inf, length(x0) ) } + if ( is.null( ub ) ) { ub <- rep( Inf, length(x0) ) } + + # internal function to check the arguments of the functions + checkFunctionArguments <- function( fun, arglist, funname ) { + if( !is.function(fun) ) stop(paste(funname, " must be a function\n", sep = "")) + + # determine function arguments + fargs <- formals(fun) + + if ( length(fargs) > 1 ) { + # determine argument names user-defined function + argnames_udf <- names(fargs)[2:length(fargs)] # remove first argument, which is x + + # determine argument names that where supplied to ipoptr() + argnames_supplied <- names(arglist) + + # determine which arguments where required but not supplied + m1 = match(argnames_udf, argnames_supplied) + if( any(is.na(m1)) ){ + mx1 = which( is.na(m1) ) + for( i in 1:length(mx1) ){ + stop(paste(funname, " requires argument '", argnames_udf[mx1], "' but this has not been passed to the 'ipoptr' function.\n", sep = "")) + } + } + + # determine which arguments where supplied but not required + m2 = match(argnames_supplied, argnames_udf) + if( any(is.na(m2)) ){ + mx2 = which( is.na(m2) ) + for( i in 1:length(mx2) ){ + stop(paste("'", argnames_supplied[mx2], "' passed to (...) in 'ipoptr' but this is not required in the ", funname, " function.\n", sep = "")) + } + } + } + return( 0 ) + } + + # extract list of additional arguments and check user-defined functions + arglist <- list(...) + checkFunctionArguments( eval_f, arglist, 'eval_f' ) + checkFunctionArguments( eval_grad_f, arglist, 'eval_grad_f' ) + + num.constraints <- length( constraint_lb ) + if ( num.constraints > 0 ) { + checkFunctionArguments( eval_g, arglist, 'eval_g' ) + checkFunctionArguments( eval_jac_g, arglist, 'eval_jac_g' ) + } + + # write wrappers around user-defined functions to pass additional arguments + eval_f_wrapper = function(x){ eval_f(x, ...) } + eval_grad_f_wrapper = function(x){ eval_grad_f(x, ...) } + + if ( num.constraints > 0 ) { + eval_g_wrapper = function( x ) { eval_g(x, ...) } + eval_jac_g_wrapper = function( x ) { eval_jac_g(x, ...) } + } else { + eval_g_wrapper = function( x ) { return( numeric(0) ) } + eval_jac_g_wrapper = function( x ) { return( numeric(0) ) } + } + + # approximate Hessian + if ( is.null( eval_h ) && is.null( eval_h_structure ) ) { + opts$hessian_approximation <- "limited-memory" + eval_h_wrapper = NULL + } else { + checkFunctionArguments( eval_h, c( arglist, obj_factor=0, hessian_lambda=0 ), 'eval_h' ) + eval_h_wrapper = function( x, obj_factor, hessian_lambda ) { eval_h(x, obj_factor, hessian_lambda, ...) } + } + + + + # build ipoptr object + ret <- list( "x0"=x0, + "eval_f"=eval_f_wrapper, + "eval_grad_f"=eval_grad_f_wrapper, + "lower_bounds"=lb, + "upper_bounds"=ub, + "eval_g"=eval_g_wrapper, + "eval_jac_g"=eval_jac_g_wrapper, + "constraint_lower_bounds"=constraint_lb, + "constraint_upper_bounds"=constraint_ub, + "eval_jac_g_structure"=eval_jac_g_structure, + "eval_h"=eval_h_wrapper, + "eval_h_structure"=eval_h_structure, + "options"=get.option.types(opts), + "environment" = new.env() ) + + attr(ret, "class") <- "ipoptr" + + # add the current call to the list + ret$call <- match.call() + + # check whether we have a correctly formed ipoptr object + is.ipoptr( ret ) + + # pass ipoptr object to C code + solution <- .Call( IpoptRSolve, ret ) + + # add solution variables to object + ret$status <- solution$status + ret$message <- solution$message + ret$iterations <- solution$iterations + ret$objective <- solution$objective + ret$solution <- solution$solution + ret$z_L <- solution$z_L + ret$z_U <- solution$z_U + ret$constraints <- solution$constraints + ret$lambda <- solution$lambda + + return( ret ) +} diff --git a/Ipopt-3.13.4/contrib/RInterface/R/is.ipoptr.R b/Ipopt-3.13.4/contrib/RInterface/R/is.ipoptr.R new file mode 100644 index 000000000..780904605 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/R/is.ipoptr.R @@ -0,0 +1,99 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: is.ipoptr.R +# Author: Jelmer Ypma +# Date: 18 April 2010 +# +# Input: object +# Output: bool telling whether the object is an ipoptr or not +# +# Changelog: +# 09/03/2012: Removed ipoptr_environment because this caused a bug in combination with +# data.table and it wasn't useful (thanks to Florian Oswald for reporting) + +is.ipoptr <- function(x) { + + # Check whether the object exists and is a list + if( is.null(x) ) { return( FALSE ) } + if( !is.list(x) ) { return( FALSE ) } + + # Define local flag defining whether we approximate the Hessian or not + flag_hessian_approximation = FALSE + if ( !is.null( x$options$string$hessian_approximation ) ) { + flag_hessian_approximation = ( x$options$string$hessian_approximation == "limited-memory" ) + } + + # Check whether the needed functions are supplied + stopifnot( is.function(x$eval_f) ) + stopifnot( is.function(x$eval_grad_f) ) + stopifnot( is.function(x$eval_g) ) + stopifnot( is.function(x$eval_jac_g) ) + if ( !flag_hessian_approximation ) { stopifnot( is.function(x$eval_h) ) } + + # Check whether bounds are defined for all controls + stopifnot( length( x$x0 ) == length( x$lower_bounds ) ) + stopifnot( length( x$x0 ) == length( x$upper_bounds ) ) + + # Check whether the initial value is within the bounds + stopifnot( all( x$x0 >= x$lower_bounds ) ) + stopifnot( all( x$x0 <= x$upper_bounds ) ) + + num.controls <- length( x$x0 ) + num.constraints <- length( x$constraint_lower_bounds ) + + # Check the length of some return values + stopifnot( length(x$eval_f( x$x0 ))==1 ) + stopifnot( length(x$eval_grad_f( x$x0 ))==num.controls ) + stopifnot( length(x$eval_g( x$x0 ))==num.constraints ) + stopifnot( length(x$eval_jac_g( x$x0 ))==length(unlist(x$eval_jac_g_structure)) ) # the number of non-zero elements in the Jacobian + if ( !flag_hessian_approximation ) { + stopifnot( length(x$eval_h( x$x0, 1, rep(1,num.constraints) ))==length(unlist(x$eval_h_structure)) ) # the number of non-zero elements in the Hessian + } + + # Check the whether we don't have NA's in initial values + stopifnot( all(!is.na(x$eval_f( x$x0 ))) ) + stopifnot( all(!is.na(x$eval_grad_f( x$x0 ))) ) + stopifnot( all(!is.na(x$eval_g( x$x0 ))) ) + stopifnot( all(!is.na(x$eval_jac_g( x$x0 ))) ) # the number of non-zero elements in the Jacobian + if ( !flag_hessian_approximation ) { + stopifnot( all(!is.na(x$eval_h( x$x0, 1, rep(1,num.constraints) ))) ) # the number of non-zero elements in the Hessian + } + + # Check whether a correct structure was supplied, and check the size + stopifnot( is.list(x$eval_jac_g_structure) ) + + stopifnot( length(x$eval_jac_g_structure)==num.constraints ) + if ( !flag_hessian_approximation ) { + stopifnot( length(x$eval_h_structure)==num.controls ) + stopifnot( is.list(x$eval_h_structure) ) + } + + # Check the number of non-linear constraints + stopifnot( length(x$constraint_lower_bounds)==length(x$constraint_upper_bounds) ) + + # Check whether none of the non-zero indices are larger than the number of controls + # Also, the smallest index should be bigger than 0 + if ( length( x$eval_jac_g_structure ) > 0 ) { + stopifnot( max(unlist(x$eval_jac_g_structure)) <= num.controls ) + stopifnot( min(unlist(x$eval_jac_g_structure)) > 0 ) + } + if ( !flag_hessian_approximation ) { + stopifnot( max(unlist(x$eval_h_structure)) <= num.controls ) + stopifnot( min(unlist(x$eval_h_structure)) > 0 ) + } + + # Check whether option to approximate hessian and eval_h are both set + # If we approximate the hessian, then we don't want to set eval_h + if ( flag_hessian_approximation ) { + if( !is.null( x$eval_h ) ) { + warning("Option supplied to approximate hessian, but eval_h is defined.\nSolution: remove option hessian_approximation=limited-memory to use analytic derivatives.") + } + if( !is.null( x$eval_h_structure ) ) { + warning("Option supplied to approximate hessian, but eval_h_structure is defined.\nSolution: remove option hessian_approximation=limited-memory to use analytic derivatives.") + } + } + + + return( TRUE ) +} diff --git a/Ipopt-3.13.4/contrib/RInterface/R/make.sparse.R b/Ipopt-3.13.4/contrib/RInterface/R/make.sparse.R new file mode 100644 index 000000000..6cb2ab080 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/R/make.sparse.R @@ -0,0 +1,28 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: make.sparse.R +# Author: Jelmer Ypma +# Date: 18 April 2010 +# +# Input: matrix with logical elements +# Output: list with as elements a vector of indices denoting non-zero (TRUE) elements of the matrix + +make.sparse <- function( A ) { + + # start with empty list to append to + S <- list() + + # loop over matrix by row + for ( i in 1:nrow(A) ) { + indices <- c() + for ( j in 1:ncol(A) ) { + if (A[i,j]) { + indices <- c( indices, j ) + } + } + S <- c( S, list(indices) ) + } + + return( S ) +} diff --git a/Ipopt-3.13.4/contrib/RInterface/R/plot.sparseness.R b/Ipopt-3.13.4/contrib/RInterface/R/plot.sparseness.R new file mode 100644 index 000000000..67e2eb7d0 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/R/plot.sparseness.R @@ -0,0 +1,34 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: plot.sparseness.R +# Author: Jelmer Ypma +# Date: 23 June 2010 +# +# Input: sparse matrix structure (as list with non-zero indices) +# Output: plot a the non-zero elements in the matrix as dots +# useful for matrices with many elements, for smaller ones +# use print.sparseness + +plot.sparseness <- function( x, pch='.', asp=1, xaxs='i', yaxs='i', ... ) { + # make a list of y indices corresponding to the non-zero x indices + structure.y <- lapply( 1:length( x ), function(i) { rep( i, length( x[[i]] ) ) } ) + + indices.x <- unlist( x ) + indices.y <- unlist( structure.y ) + + # plot non-zero elements, where we revert the y-axis (top-left element is 1,1), + # fix the aspect ratio (asp=1) and do not extend the x and y axis (x/yaxs='i') + plot( indices.x, + indices.y, + xlim=c(min(indices.x), max(indices.x)), + ylim=c(max(indices.y), min(indices.y)), + type='p', + pch=pch, + asp=asp, + xaxs=xaxs, + yaxs=yaxs, + ... ) + + return( list( x=indices.x, y=indices.y ) ) +} diff --git a/Ipopt-3.13.4/contrib/RInterface/R/print.ipoptr.R b/Ipopt-3.13.4/contrib/RInterface/R/print.ipoptr.R new file mode 100644 index 000000000..f4d4351eb --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/R/print.ipoptr.R @@ -0,0 +1,57 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: print.ipoptr.R +# Author: Jelmer Ypma +# Date: 18 April 2010 +# +# This function prints some basic output of a ipoptr +# ojbect. The information is only available after it +# has been solved. + +print.ipoptr <- function(x, show.controls=TRUE, ...) { + cat("\nCall:\n", deparse(x$call), "\n\n", sep = "", fill=TRUE) + cat( unlist(strsplit(paste( "Ipopt solver status:", x$status, "(", x$message, ")\n" ),' ')), fill=TRUE ) + cat( paste( "Number of Iterations....:", x$iterations, "\n" ) ) + + # if show.controls is TRUE or FALSE, show all or none of the controls + if ( is.logical( show.controls ) ) { + # show all control variables + if ( show.controls ) { + controls.indices = 1:length(x$solution) + } + } + + # if show.controls is a vector with indices, rename this vector + # and define show.controls as TRUE + if ( is.numeric( show.controls ) ) { + controls.indices = show.controls + show.controls = TRUE + } + + # if solved successfully + if ( x$status<=0 ) { + cat( paste( "Optimal value of objective function: ", x$objective, "\n" ) ) + if ( show.controls ) { + if ( length( controls.indices ) < length(x$solution) ) { + cat( "Optimal value of user-defined subset of controls: " ) + } else { + cat( "Optimal value of controls: " ) + } + cat( x$solution[ controls.indices ], fill=TRUE) + cat("\n") + } + } else { + cat( paste( "Current value of objective function: ", x$objective, "\n" ) ) + if ( show.controls ) { + if ( length( controls.indices ) < length(x$solution) ) { + cat( "Current value of user-defined subset of controls: " ) + } else { + cat( "Current value of controls: " ) + } + cat( x$solution[ controls.indices ], fill=TRUE ) + cat("\n") + } + } + cat("\n") +} diff --git a/Ipopt-3.13.4/contrib/RInterface/R/print.sparseness.R b/Ipopt-3.13.4/contrib/RInterface/R/print.sparseness.R new file mode 100644 index 000000000..e82affc18 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/R/print.sparseness.R @@ -0,0 +1,46 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: print.sparseness.R +# Author: Jelmer Ypma +# Date: 18 April 2010 +# +# Input: sparse matrix structure (as list with non-zero indices) +# Output: print a table with 'x' for non-zero element and '.' for zero element + +print.sparseness <- function( x, indices=TRUE, data=NULL, ncol=NULL, ... ) { + stopifnot( is.list(x) ) + + # if number of columns is not supplied, take it as the maximum + # value of the indices + if ( is.null(ncol) ) { + ncol <- max(unlist(x)) + } + + # create matrix with dots + p <- data.frame( matrix( ".", nrow=length(x), ncol ), stringsAsFactors=FALSE ) + names( p ) <- 1:ncol + + # change dots by 'x' or count of index + cnt=1 + for ( row in 1:length(x) ) { + for ( col in x[[row]] ) { + if ( indices ) { + if ( is.null( data ) ) { + p[ row, col ] <- cnt + } else { + p[ row, col ] <- paste( cnt, ':', data[cnt] ) + } + } else { + if ( is.null( data ) ) { + p[ row, col ] <- 'x' + } else { + p[ row, col ] <- data[cnt] + } + } + cnt = cnt+1 + } + } + + return( p ) +} diff --git a/Ipopt-3.13.4/contrib/RInterface/README b/Ipopt-3.13.4/contrib/RInterface/README new file mode 100644 index 000000000..9ddd45723 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/README @@ -0,0 +1,15 @@ +Package: ipoptr +Type: Package +Title: R interface to Ipopt +Version: 0.8 +Date: 2010-07-18 +Author: Jelmer Ypma +Maintainer: Jelmer Ypma +Description: ipoptr is an R interface to Ipopt (Interior Point Optimizer), an open source software package for large-scale nonlinear optimization. It can be used to solve general nonlinear programming problems with nonlinear constraints and lower and upper bounds for the controls. Ipopt is written in C++ and is released as open source code under the Eclipse Public License (EPL). It is available from the COIN-OR initiative. The code has been written by Carl Laird and Andreas Waechter, who is the COIN project leader for Ipopt. +License: EPL +Directories follow the standard structure of an R package: + - inst Contains citation information that is displayed by the R citation('ipoptr') command, and the TeX/Sweave code of the documentation. + - man Contains help-files for the commands available in this package. E.g. ?ipoptr in R shows the help-file for the ipoptr command. + - R Contains R code defining the R commands. Each command is defined in a separate file. + - src Contains C++ code interfacing between R and Ipopt. + - tests Contains some examples/tests to show how the R interface works. \ No newline at end of file diff --git a/Ipopt-3.13.4/contrib/RInterface/inst/CITATION b/Ipopt-3.13.4/contrib/RInterface/inst/CITATION new file mode 100644 index 000000000..73d6146dd --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/inst/CITATION @@ -0,0 +1,12 @@ +citHeader("To cite Ipopt in publications use:") + +citEntry(entry="Article", + title = "On the Implementation of a Primal-Dual Interior Point Filter Line Search Algorithm for Large-Scale Nonlinear Programming", + author = personList(as.person("A. W\"{a}chter"), + as.person("L. T. Biegler")), + year = "2006", + journal = "Mathematical Programming", + volume = "106", + number = "1", + pages = "25--57", + textVersion = "A. W\"{a}chter and L. T. Biegler, On the Implementation of a Primal-Dual Interior Point Filter Line Search Algorithm for Large-Scale Nonlinear Programming, Mathematical Programming 106(1), pp. 25-57, 2006" ) diff --git a/Ipopt-3.13.4/contrib/RInterface/inst/doc/ipoptr.Rnw b/Ipopt-3.13.4/contrib/RInterface/inst/doc/ipoptr.Rnw new file mode 100644 index 000000000..461f42304 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/inst/doc/ipoptr.Rnw @@ -0,0 +1,472 @@ +\documentclass[a4paper]{article} +\usepackage[english]{babel} +\usepackage{apacite} +\usepackage{graphicx} + +% \VignetteIndexEntry{Introduction to ipoptr: an R interface to Ipopt} +% \VignetteKeyword{optimize} +% \VignetteKeyword{interface} + +\SweaveOpts{keep.source=TRUE} +\SweaveOpts{prefix.string = figs/plot, eps = FALSE, pdf = TRUE, tikz = FALSE} + +%\pgfrealjobname{ipoptr} + +\title{Introduction to \texttt{ipoptr}: an R interface to Ipopt +\thanks{This package should be considered in beta and comments about any aspect of the package are welcome. Thanks to Alexios Ghalanos for comments. This document is an R vignette prepared with the aid of \texttt{Sweave}, Leisch(2002). Financial support of the UK Economic and Social Research Council through a grant (RES-589-28-0001) to the ESRC Centre for Microdata Methods and Practice (CeMMAP) is gratefully acknowledged.}} +\author{Jelmer Ypma} +\begin{document} +\maketitle +\nocite{Leisch2002} + +\DefineVerbatimEnvironment{Sinput}{Verbatim}{xleftmargin=2em} +\DefineVerbatimEnvironment{Soutput}{Verbatim}{xleftmargin=2em} +\DefineVerbatimEnvironment{Scode}{Verbatim}{xleftmargin=2em} +\fvset{listparameters={\setlength{\topsep}{0pt}}} +\renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} + + +<>= +# have an (invisible) initialization noweb chunk +# to remove the default continuation prompt '>' +options(continue = " ") +options(width = 60) + +# eliminate margin space above plots +options(SweaveHooks=list(fig=function() + par(mar=c(5.1, 4.1, 1.1, 2.1)))) +@ + +\begin{abstract} +This document describes how to use \texttt{ipoptr}, which is an R interface to Ipopt (Interior Point Optimizer). Ipopt is an open source software package for large-scale nonlinear optimization \cite{WachterBiegler2006}. It can be used to solve general nonlinear programming problems with nonlinear constraints and lower and upper bounds for the controls. Ipopt is written in C++ and is released as open source code under the Eclipse Public License (EPL). It is available from the COIN-OR initiative. The code has been written by Carl Laird and Andreas W\"achter, who is the COIN project leader for Ipopt. +\end{abstract} + +\section{Introduction} +Ipopt is designed to find (local) solutions of mathematical optimization problems of the from +\begin{eqnarray*} +&&\min_{x \in R^n} f(x) \\ +&s.t.& g_L <= g(x) <= g_U \\ +&& x_L <= x <= x_U +\end{eqnarray*} +where $f(x): R^n \rightarrow R$ is the objective function, and $g(x): R^n \rightarrow R^m$ are the constraint functions. The vectors $g_L$ and $g_U$ denote the lower and upper bounds on the constraints, and the vectors $x_L$ and $x_U$ are the bounds on the variables $x$. The functions $f(x)$ and $g(x)$ can be nonlinear and nonconvex, but should be twice continuously differentiable. Note that equality constraints can be formulated in the above formulation by setting the corresponding components of $g_L$ and $g_U$ to the same value. + +This vignette describes how to formulate minimization problems to be solved with the R interface to Ipopt. If you want to use the C++ interface directly or are interested in the Matlab interface, there are other sources of documentation available. Some of the information here is heavily based on the Ipopt documentation\footnote{\texttt{https://coin-or.github.io/Ipopt/}} and generally that is a good source to find additional information, for instance on which options to use. All credit for implementing the C++ code for Ipopt should go to Andreas W\"achter and Carl Laird. Please show your appreciation by citing their paper. + +\section{Installation} +Installing the \texttt{ipoptr} package is not as straightforward as most other R packages, because it depends on Ipopt. To install (and compile) Ipopt and the R interface a C/C++ compiler has to be available. On Windows I was successful using MSYS to compile Ipopt and then use Rtools\footnote{\texttt{http://www.murdoch-sutherland.com/Rtools/}} to compile the R interface from source. On Ubuntu no additional tools were needed. + +The code for the R interface to Ipopt is available from R-Forge and from the Ipopt website. Additional information is also available on \texttt{http://www.ucl.ac.uk/\textasciitilde uctpjyy/ipoptr.html}. The R interface to Ipopt comes with the most recent version of Ipopt, so there is no need to download it separately. + +Detailed installation instructions for Ipopt are available on \texttt{http://www.coin-or.org/Ipopt/documentation}. You should follow these first, before trying to install the R interface. Ipopt needs to be configured using the \texttt{-fPIC} flag for all GNU compilers, which usually happens by default. In builds of debug or static libraries, one need to use the option \verb|--with-pic| for configure. + +For the installation of the R interface, I will assume that you have a working installation of Ipopt (i.e. \texttt{configure}, \texttt{make} and \texttt{make install} executed without problems). + +During the installation of Ipopt a file \texttt{Makevars} (or \texttt{Makevars.win} on Windows) has been created in the \texttt{src} subdirectory of the build directory of the R interface, e.g., \texttt{\$IPOPTDIR/build/Ipopt/contrib/RInterface/src} if you used the same build directory as in the Ipopt installation notes, \texttt{\$IPOPTDIR/build}. The file \texttt{Makevars}(\texttt{.win}) in this directory has been configured for your system. + +You can then install the package from R with the command +<>= +install.packages('$IPOPTDIR/build/Ipopt/contrib/RInterface', repos=NULL, type='source') +@ +where the first argument specifies the build directory for the R interface of Ipopt. You should now be able to load the R interface to Ipopt and read the help. +<>= +library('ipoptr') +?ipoptr +@ + +\section{Minimizing the Rosenbrock Banana function} +As a first example we will solve an unconstrained minimization problem. The function we look at is the Rosenbrock Banana function +\[ +f( x ) = 100 \left( x_2 - x_1^2 \right)^2 + \left(1 - x_1 \right)^2, +\] +which is also used as an example in the documentation for the standard R optimizer \texttt{optim}. The gradient of the objective function is given by +\[ +\nabla f( x ) = +\left( \begin{array}[1]{c} +-400 \cdot x_1 \cdot (x_2 - x_1^2) - 2 \cdot (1 - x_1) \\ + 200 \cdot (x_2 - x_1^2) +\end{array} \right). +\] +Ipopt always needs gradients to be supplied by the user. After loading the library +<>= +library(ipoptr) +@ +we start by specifying the objective function and its gradient +<>= +## Rosenbrock Banana function +eval_f <- function(x) { + return( 100 * (x[2] - x[1] * x[1])^2 + (1 - x[1])^2 ) +} + +## Gradient of Rosenbrock Banana function +eval_grad_f <- function(x) { + return( c( -400 * x[1] * (x[2] - x[1] * x[1]) - 2 * (1 - x[1]), + 200 * (x[2] - x[1] * x[1]) ) ) +} +@ +We define initial values +<>= +# initial values +x0 <- c( -1.2, 1 ) +@ +and then minimize the function using the \texttt{ipoptr} command. This command runs some checks on the supplied inputs and returns an object with the exit code of the solver, the optimal value of the objective function and the solution. The checks do not always return very informative messages, but usually there is something wrong with dimensions (e.g. \texttt{eval\_grad\_f} returns a vector that doesn't have the same size as \texttt{x0}). +<>= +# solve Rosenbrock Banana function +res <- ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=eval_grad_f ) +@ +These are the minimal arguments that have to be supplied. If, like above, no Hessian is defined, Ipopt uses an approximation. The Ipopt website has a detailed explanation of the output. We can see a summary of the results by printing the resulting object. +<>= +print( res ) +@ +It's advised to always check the exit code for convergence of the problem and in this case we can see that the algorithm terminated successfully. Ipopt used 47 iterations to find the solution and the optimal value of the objective function and the controls are given as well. + +If you do not want to, or cannot calculate the gradient analytically, you can supply a function \texttt{eval\_grad\_f} that approximates the gradient. However, this is not advisable and might result in convergence problems, for instance by not finding the minimum, or by finding the wrong minimum. We can see this from the following example where we approximate \texttt{eval\_grad\_f} using finite differences +<>= +# http://en.wikipedia.org/wiki/Numerical_differentiation +finite.diff <- function( func, + x, + minAbsValue=0, + stepSize=sqrt( .Machine$double.eps ), ... ) { + + stepSizeVec <- pmax( abs(x), 1 ) * stepSize + + fx <- func( x, ... ) + approx.gradf.index <- function(i, x, func, fx, stepSizeVec, ...) { + x_prime <- x + x_prime[i] <- x[i] + stepSizeVec[i] + stepSizeVec[i] <- x_prime[i] - x[i] + fx_prime <- func( x_prime, ... ) + return( ( fx_prime - fx )/stepSizeVec[i] ) + } + grad_fx <- sapply( 1:length(x), + approx.gradf.index, + x=x, + func=func, + fx=fx, + stepSizeVec=stepSizeVec, + ... ) + + return( grad_fx ) +} + +# Approximate eval_f using finite differences +approx_grad_f <- function( x ) { + return( finite.diff( eval_f, x ) ) +} +@ +and using this approximation to minimize the same Rosenbrock Banana function. We suppress the output by the \texttt{print\_level} option. +<>= +# increase the maximum number of iterations +opts <- list("tol"=1.0e-8, "max_iter"=5000, "print_level"=0) + +# solve Rosenbrock Banana function with approximated gradient +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=approx_grad_f, + opts=opts) ) +@ +In this case 5000 iterations are not enough to solve the minimization problem to the required tolerance. This has to do with the step size we choose to approximate the gradient +<>= +sqrt( .Machine$double.eps ) +@ +which is of the same order of magnitude. If we decrease the tolerance, the algorithm converges, but the solution is less precise than if we supply gradients and it takes more iterations to get there. +<>= +# decrease the convergence criterium +opts <- list("tol"=1.0e-7, "print_level"=0) + +# solve Rosenbrock Banana function with approximated gradient +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=approx_grad_f, + opts=opts) ) +@ + +\section{Sparse matrix structure} +Ipopt can handle sparseness in the Jacobian of the constraints and the Hessian. The sparseness structure should be defined in advance and stay the same throughout the minimization procedure. A sparseness structure can be defined as a list of vectors, where each vector contains the indices of the non-zero elements of one row. E.g. the matrix +\[ +\left( \begin{array}[4]{cccc} +. & . & . & 1 \\ +1 & 1 & . & . \\ +1 & 1 & 1 & 1 +\end{array} \right) +\] +has a non-zero element in position 4 in the first row. In the second row it has non-zero elements in position 1 and 2, and the third row contains non-zero elements at every position. Its structure can be defined as +<>= +sparse_structure <- list( c( 4 ), c( 1, 2 ), c( 1, 2, 3, 4 ) ) +@ +The function \texttt{make.sparse} can simplify this procedure +<>= +make.sparse( rbind( c(0, 0, 0, 1), c( 1, 1, 0, 0 ), c( 1, 1, 1, 1 ) ) ) +@ +This function takes a matrix as argument. All non-zero elements in this matrix will be defined as non-zero in the sparseness structure, \texttt{NA} or \texttt{NaN} are not allowed. The function \texttt{print.sparseness} shows the non-zero elements +<>= +print.sparseness( sparse_structure ) +@ +By default \texttt{print.sparseness} shows the indices of the non-zero elements in the sparse matrix. Values for the non-zero elements of a sparse matrix have to be supplied in one vector, in the same order as the the non-zero elements occur in the structure. I.e. the order of the indices matters and the values of the following two matrices should be supplied in a different order +<>= +print.sparseness( list( c(1,3,6,8), c(2,5), c(3,7,9) ) ) +print.sparseness( list( c(3,1,6,8), c(2,5), c(3,9,7) ) ) +@ +Since the sparseness structure defines the indices of non-zero elements by row, the order of the rows cannot be changed in the R implementation. In principle a more general order of the non-zero elements (independent of row or column) could be specified, which can be added as a feature on request. Below are two final examples on sparseness structure (see \texttt{?print.sparseness} for more options and examples) +<>= +# print lower-diagonal 5x5 matrix generated with make.sparse +A_lower <- make.sparse( lower.tri( matrix(1, nrow=5, ncol=5), diag=TRUE ) ) +print.sparseness( A_lower ) + +# print a diagonal 5x5 matrix without indices counts +A_diag <- make.sparse( diag(5) > 0 ) +print.sparseness( A_diag, indices=FALSE ) +@ + +For larger matrices it is easier to plot them using the \texttt{plot.sparseness} command +<>= +s <- do.call( "cbind", lapply( 1:5, function(i) { + diag(5) %x% matrix(1, nrow=5, ncol=20) + } ) ) +s <- do.call( "rbind", lapply( 1:5, function(i) { s } ) ) +s <- cbind( matrix( 1, nrow=nrow(s), ncol=40 ), s ) +plot.sparseness( make.sparse( s ) ) +@ +The resulting sparse matrix structure from this code can be seen in figure \ref{fig:sparse}. All non-zero elements are shown as black dots by default. + +\begin{figure}[htbp] +\begin{center} +\includegraphics[width=12.0cm]{figs/plot-sparsefig.pdf} +\caption{Plot of large sparseness structure} +\label{fig:sparse} +\end{center} +\end{figure} + +\section{Supplying the Hessian} +Now that we know how to define a sparseness structure we can supply the Hessian to the Rosenbrock Banana function from above. Its Hessian is given by +\[ +\nabla^2 f( x ) = \left( \begin{array}[2]{rr} +2 - 400 \cdot (x_2 - x_1^2) + 800 x_1^2 & -400 x_1 \\ +-400 x_1 & 200 +\end{array} \right) +\] +Ipopt needs the Hessian of the Lagrangian in the following form +\[ +\sigma_f \nabla^2 f(x) + \sum_{i=1}^m \lambda_i \nabla^2 g_i(x), +\] +where $g_i(x)$ represents the $i$th of $m$ constraints, $\lambda_i$ are the multipliers of the constraints and $\sigma_f$ is introduced so that Ipopt can ask for the Hessian of the objective or the constraints independently if required. + +In this case we don't have any constraints. The user-defined function \texttt{eval\_h} to define the Hessian takes three arguments. The first argument contains the value of the control variables, $x$, the second argument contains the multiplication factor of the Hessian of the objective function, $\sigma_f$, and the third argument contains a vector with the multipliers of the constraints, $\lambda$. We can define the structure of the Hessian and the function to evaluate the Hessian as follows +<>= +# The Hessian for this problem is actually dense, +# This is a symmetric matrix, fill the lower left triangle only. +eval_h_structure <- list( c(1), c(1,2) ) + +eval_h <- function( x, obj_factor, hessian_lambda ) { + return( obj_factor*c( 2 - 400*(x[2] - x[1]^2) + 800*x[1]^2, # 1,1 + -400*x[1], # 2,1 + 200 ) ) # 2,2 +} +@ +Note that we only specify the lower half of the Hessian, since it is a symmetric matrix. Also, \texttt{eval\_h} returns a vector with all the non-zero elements of the Hessian in the same order as the non-zero indices in the sparseness structure. Then we minimize the function using the \texttt{ipoptr} command +<>= +opts <- list("print_level"=0, + "file_print_level"=12, + "output_file"="banana.out", + "tol"=1.0e-8) + +# solve Rosenbrock Banana function with analytic Hessian +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=eval_grad_f, + eval_h=eval_h, + eval_h_structure=eval_h_structure, + opts=opts) ) +@ +Here we also supplied options to not print any intermediate information to the R screen (\texttt{print\_level=0}). Printing output to the screen directly from Ipopt does not work in all R terminals correctly, so it might be that even though you specify a positive number here, there will still be no output visible on the screen. If you want to print things to the screen, a workaround is to do this directly in the R functions you defined, such as \texttt{eval\_f}. + +Also, to inspect more details about the minimization we can write all the output to a file, which will be created in the current working directory. For larger problems, having a large number for \texttt{file\_print\_level} can easily generate very large files, which is probably not desirable. Many more options are available, and a full list of all the options can be found at the Ipopt website, \texttt{http://www.coin-or.org/Ipopt/documentation/node59.html\#app.options\_ref}. Options can also be supplied from an option file, which can be specified in \texttt{option\_file\_name}. + +\section{Adding constraints} +To look at how we can add constraints to a problem, we take example problem number 71 from the Hock-Schittkowsky test suite, which is also used in the Ipopt C++ tutorial. The problem is +\begin{eqnarray*} +&&\min_{x} x_1 \cdot x_4 \cdot (x_1 + x_2 + x_3) + x_3 \\ +&s.t.& \\ +&& x_1 \cdot x_2 \cdot x_3 \cdot x_4 >= 25 \\ +&& x_1^2 + x_2^2 + x_3^2 + x_4^2 = 40 \\ +&& 1 <= x_1,x_2,x_3,x_4 <= 5, +\end{eqnarray*} +and we use $x = (1, 5, 5, 1)$ as initial values. In this problem we have one inequality constraint, one equality constraint and upper and lower bounds for all the variables. The optimal solution is $(1.00000000, 4.74299963, 3.82114998, 1.37940829)$. First we define the objective function and its gradient +<>= +eval_f <- function( x ) { + return( x[1]*x[4]*(x[1] + x[2] + x[3]) + x[3] ) +} + +eval_grad_f <- function( x ) { + return( c( x[1] * x[4] + x[4] * (x[1] + x[2] + x[3]), + x[1] * x[4], + x[1] * x[4] + 1.0, + x[1] * (x[1] + x[2] + x[3]) ) ) +} +@ +Then we define a function that returns the value of the two constraints. We define the bounds of the constraints (in this case the $g_L$ and $g_U$ are $25$ and $40$) later. +<>= +# constraint functions +eval_g <- function( x ) { + return( c( x[1] * x[2] * x[3] * x[4], + x[1]^2 + x[2]^2 + x[3]^2 + x[4]^2 ) ) +} +@ +Then we define the structure of the Jacobian, which is a dense matrix in this case, and function to evaluate it +<>= +eval_jac_g_structure <- list( c(1,2,3,4), c(1,2,3,4) ) + +eval_jac_g <- function( x ) { + return( c ( x[2]*x[3]*x[4], + x[1]*x[3]*x[4], + x[1]*x[2]*x[4], + x[1]*x[2]*x[3], + 2.0*x[1], + 2.0*x[2], + 2.0*x[3], + 2.0*x[4] ) ) +} +@ +The Hessian is also dense, but it looks slightly more complicated because we have to take into account the Hessian of the objective function and of the constraints at the same time, although you could write a function to calculate them both separately and then return the combined result in \texttt{eval\_h}. +<>= +# The Hessian for this problem is actually dense, +# This is a symmetric matrix, fill the lower left triangle only. +eval_h_structure <- list( c(1), c(1,2), c(1,2,3), c(1,2,3,4) ) + +eval_h <- function( x, obj_factor, hessian_lambda ) { + + values <- numeric(10) + values[1] = obj_factor * (2*x[4]) # 1,1 + + values[2] = obj_factor * (x[4]) # 2,1 + values[3] = 0 # 2,2 + + values[4] = obj_factor * (x[4]) # 3,1 + values[5] = 0 # 4,2 + values[6] = 0 # 3,3 + + values[7] = obj_factor * (2*x[1] + x[2] + x[3]) # 4,1 + values[8] = obj_factor * (x[1]) # 4,2 + values[9] = obj_factor * (x[1]) # 4,3 + values[10] = 0 # 4,4 + + + # add the portion for the first constraint + values[2] = values[2] + hessian_lambda[1] * (x[3] * x[4]) # 2,1 + + values[4] = values[4] + hessian_lambda[1] * (x[2] * x[4]) # 3,1 + values[5] = values[5] + hessian_lambda[1] * (x[1] * x[4]) # 3,2 + + values[7] = values[7] + hessian_lambda[1] * (x[2] * x[3]) # 4,1 + values[8] = values[8] + hessian_lambda[1] * (x[1] * x[3]) # 4,2 + values[9] = values[9] + hessian_lambda[1] * (x[1] * x[2]) # 4,3 + + # add the portion for the second constraint + values[1] = values[1] + hessian_lambda[2] * 2 # 1,1 + values[3] = values[3] + hessian_lambda[2] * 2 # 2,2 + values[6] = values[6] + hessian_lambda[2] * 2 # 3,3 + values[10] = values[10] + hessian_lambda[2] * 2 # 4,4 + + return ( values ) +} +@ +After the hard part is done, we only have to define the initial values, the lower and upper bounds of the control variables, and the lower and upper bounds of the constraints. If a variable or a constraint does not have lower or upper bounds, the values \texttt{-Inf} or \texttt{Inf} can be used. If the upper and lower bounds of a constraint are equal, Ipopt recognizes this as an equality constraint and acts accordingly. +<>= +# initial values +x0 <- c( 1, 5, 5, 1 ) + +# lower and upper bounds of control +lb <- c( 1, 1, 1, 1 ) +ub <- c( 5, 5, 5, 5 ) + +# lower and upper bounds of constraints +constraint_lb <- c( 25, 40 ) +constraint_ub <- c( Inf, 40 ) + +opts <- list("print_level"=0, + "file_print_level"=12, + "output_file"="hs071_nlp.out") + +print( ipoptr( x0 = x0, + eval_f = eval_f, + eval_grad_f = eval_grad_f, + lb = lb, + ub = ub, + eval_g = eval_g, + eval_jac_g = eval_jac_g, + constraint_lb = constraint_lb, + constraint_ub = constraint_ub, + eval_jac_g_structure = eval_jac_g_structure, + eval_h = eval_h, + eval_h_structure = eval_h_structure, + opts = opts) ) +@ + +\section{Using data} +The final subject we have to cover, is how to pass data to an objective function or the constraints. There are two ways to do this. The first is to supply additional arguments to the user defined functions and \texttt{ipoptr}. The second way is to define an environment that holds the data and pass this environment to \texttt{ipoptr}. Both methods are shown in \texttt{tests/parameters.R}. + +As a very simple example\footnote{A more interesting example is given in \texttt{tests/lasso.R}} suppose we want to find the minimum of +\[ +f( x ) = a_1 x^2 + a_2 x + a_3 +\] +for different values of the parameters $a_1$, $a_2$ and $a_3$. + +First we define the objective function and its gradient using, assuming that there is some variable \texttt{params} that contains the values of the parameters. +<>= +eval_f_ex1 <- function(x, params) { + return( params[1]*x^2 + params[2]*x + params[3] ) +} +eval_grad_f_ex1 <- function(x, params) { + return( 2*params[1]*x + params[2] ) +} +@ +Note that the first parameter should always be the control variable. All of the user-defined functions should contain the same set of additional parameters. You have to supply them as input argument to all functions, even if you're not using them in some of the functions. + +Then we can solve the problem for a specific set of parameters, in this case $a_1=1$, $a_2=2$ and $a_3=3$, from initial value $x_0=0$, with the following command +<>= +# solve using ipoptr with additional parameters +ipoptr( x0 = 0, + eval_f = eval_f_ex1, + eval_grad_f = eval_grad_f_ex1, + opts = list("print_level"=0), + params = c(1,2,3) ) +@ + +For the second method, we don't have to supply the parameters as additional arguments to the function. +<>= +eval_f_ex2 <- function(x) { + return( params[1]*x^2 + params[2]*x + params[3] ) +} +eval_grad_f_ex2 <- function(x) { + return( 2*params[1]*x + params[2] ) +} +@ +Instead, we define an environment that contains specific values of \texttt{params} +<>= +# define a new environment that contains params +auxdata <- new.env() +auxdata$params <- c(1,2,3) +@ +To solve this we supply \texttt{auxdata} as an argument to \texttt{ipoptr}, which will take care of evaluating the functions in the correct environment, so that auxiliary data is available. +<>= +# pass the environment that should be used to evaluate functions to ipoptr +ipoptr( x0 = 0, + eval_f = eval_f_ex2, + eval_grad_f = eval_grad_f_ex2, + ipoptr_environment = auxdata, + opts = list("print_level"=0) ) +@ + +\section{Options} +There are many options available, all of which are described on the Ipopt website. One of the options can test whether your derivatives are correct. This option is activated by setting \texttt{derivative\_test} to \texttt{first-order} or \texttt{second-order} if you want to test second derivatives as well. This process can take quite some time. To see all the output from this process you can set \texttt{derivative\_test\_print\_all} to \texttt{yes}, preferably when writing to a file, because of the problems with displaying on some terminals mentioned above. Without this option the derivative checker only shows those lines where an error occurs if a high enough \texttt{print\_level} is supplied. + +\section{Remarks} +If you run many large optimization problems in a row on Windows, at some point you'll get errors that Mumps is running out of memory and you won't get any solutions. On Linux this same problem hasn't occurred yet. + +From version 0.8.2 output is shown in the R terminal under Windows as well. + +\bibliographystyle{apacite} +\bibliography{reflist} + +\end{document} diff --git a/Ipopt-3.13.4/contrib/RInterface/inst/doc/ipoptr.pdf b/Ipopt-3.13.4/contrib/RInterface/inst/doc/ipoptr.pdf new file mode 100644 index 000000000..ffc35d1ac Binary files /dev/null and b/Ipopt-3.13.4/contrib/RInterface/inst/doc/ipoptr.pdf differ diff --git a/Ipopt-3.13.4/contrib/RInterface/inst/doc/reflist.bib b/Ipopt-3.13.4/contrib/RInterface/inst/doc/reflist.bib new file mode 100644 index 000000000..7def676d9 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/inst/doc/reflist.bib @@ -0,0 +1,23 @@ +@inproceedings{Leisch2002, + author = {Friedrich Leisch}, + title = {Sweave: Dynamic Generation of Statistical Reports Using + Literate Data Analysis}, + booktitle = {Compstat 2002 --- Proceedings in Computational + Statistics}, + pages = {575--580}, + year = 2002, + editor = {Wolfgang H{\"a}rdle and Bernd R{\"o}nz}, + publisher = {Physica Verlag, Heidelberg}, + note = {ISBN 3-7908-1517-9}, + url = {http://www.stat.uni-muenchen.de/~leisch/Sweave} +} + +@article{WachterBiegler2006, + author = {A. W{\"a}chter and L. T. Biegler}, + title = {On the Implementation of a Primal-Dual Interior Point Filter Line Search Algorithm for Large-Scale Nonlinear Programming}, + journal = {Mathematical Programming}, + volume = {106}, + number = {1}, + pages = {25--57}, + year = {2006} +} diff --git a/Ipopt-3.13.4/contrib/RInterface/man/ipoptr-package.Rd b/Ipopt-3.13.4/contrib/RInterface/man/ipoptr-package.Rd new file mode 100644 index 000000000..04f7feba0 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/man/ipoptr-package.Rd @@ -0,0 +1,167 @@ +\name{ipoptr-package} +\alias{ipoptr-package} +\docType{package} +\title{ +R interface to Ipopt +} +\description{ +ipoptr is an R interface to Ipopt (Interior Point Optimizer), an open source software +package for large-scale nonlinear optimization. It can be used to solve general nonlinear +programming problems with nonlinear constraints and lower and upper bounds for the controls. +Ipopt is written in C++ and is released as open source code under the Eclipse Public License (EPL). +It is available from the COIN-OR initiative. The code has been written by Carl Laird and +Andreas Waechter, who is the COIN project leader for Ipopt. + +Ipopt is designed to find (local) solutions of mathematical optimization problems of the from + + min f(x) +x in R^n + +s.t. g_L <= g(x) <= g_U + x_L <= x <= x_U + +where f(x): R^n --> R is the objective function, and g(x): R^n --> R^m are the constraint +functions. The vectors g_L and g_U denote the lower and upper bounds on the constraints, +and the vectors x_L and x_U are the bounds on the variables x. The functions f(x) and g(x) +can be nonlinear and nonconvex, but should be twice continuously differentiable. Note that +equality constraints can be formulated in the above formulation by setting the corresponding +components of g_L and g_U to the same value. +} +\author{ +Jelmer Ypma +} +\references{ +A. Waechter and L. T. Biegler, On the Implementation of a Primal-Dual Interior Point Filter Line Search Algorithm for Large-Scale Nonlinear Programming, Mathematical Programming 106(1), pp. 25-57, 2006 +} +\keyword{ optimize } +\keyword{ interface } +\seealso{ +\code{\link{optim}} +\code{\link{nlm}} +\code{\link{nlminb}} +\code{\link[Rsolnp:Rsolnp-package]{Rsolnp}} +} +\note{See ?ipoptr for more examples.} +\examples{ +# Example problem, number 71 from the Hock-Schittkowsky test suite +# +# \min_{x} x1*x4*(x1 + x2 + x3) + x3 +# s.t. +# x1*x2*x3*x4 >= 25 +# x1^2 + x2^2 + x3^2 + x4^2 = 40 +# 1 <= x1,x2,x3,x4 <= 5 +# +# x0 = (1,5,5,1) +# +# optimal solution = (1.00000000, 4.74299963, 3.82114998, 1.37940829) +# +# Adapted from the Ipopt C++ interface example. + + +library('ipoptr') + +# +# f(x) = x1*x4*(x1 + x2 + x3) + x3 +# +eval_f <- function( x ) { + return( x[1]*x[4]*(x[1] + x[2] + x[3]) + x[3] ) +} + +eval_grad_f <- function( x ) { + return( c( x[1] * x[4] + x[4] * (x[1] + x[2] + x[3]), + x[1] * x[4], + x[1] * x[4] + 1.0, + x[1] * (x[1] + x[2] + x[3]) ) ) +} + +# constraint functions +eval_g <- function( x ) { + return( c( x[1] * x[2] * x[3] * x[4], + x[1]^2 + x[2]^2 + x[3]^2 + x[4]^2 ) ) +} + +# The Jacobian for this problem is dense +eval_jac_g_structure <- list( c(1,2,3,4), c(1,2,3,4) ) + +eval_jac_g <- function( x ) { + return( c ( x[2]*x[3]*x[4], + x[1]*x[3]*x[4], + x[1]*x[2]*x[4], + x[1]*x[2]*x[3], + 2.0*x[1], + 2.0*x[2], + 2.0*x[3], + 2.0*x[4] ) ) +} + +# The Hessian for this problem is actually dense, +# This is a symmetric matrix, fill the lower left triangle only. +eval_h_structure <- list( c(1), c(1,2), c(1,2,3), c(1,2,3,4) ) + +eval_h <- function( x, obj_factor, hessian_lambda ) { + + values <- numeric(10) + values[1] = obj_factor * (2*x[4]) # 1,1 + + values[2] = obj_factor * (x[4]) # 2,1 + values[3] = 0 # 2,2 + + values[4] = obj_factor * (x[4]) # 3,1 + values[5] = 0 # 4,2 + values[6] = 0 # 3,3 + + values[7] = obj_factor * (2*x[1] + x[2] + x[3]) # 4,1 + values[8] = obj_factor * (x[1]) # 4,2 + values[9] = obj_factor * (x[1]) # 4,3 + values[10] = 0 # 4,4 + + + # add the portion for the first constraint + values[2] = values[2] + hessian_lambda[1] * (x[3] * x[4]) # 2,1 + + values[4] = values[4] + hessian_lambda[1] * (x[2] * x[4]) # 3,1 + values[5] = values[5] + hessian_lambda[1] * (x[1] * x[4]) # 3,2 + + values[7] = values[7] + hessian_lambda[1] * (x[2] * x[3]) # 4,1 + values[8] = values[8] + hessian_lambda[1] * (x[1] * x[3]) # 4,2 + values[9] = values[9] + hessian_lambda[1] * (x[1] * x[2]) # 4,3 + + # add the portion for the second constraint + values[1] = values[1] + hessian_lambda[2] * 2 # 1,1 + values[3] = values[3] + hessian_lambda[2] * 2 # 2,2 + values[6] = values[6] + hessian_lambda[2] * 2 # 3,3 + values[10] = values[10] + hessian_lambda[2] * 2 # 4,4 + + return ( values ) +} + +# initial values +x0 <- c( 1, 5, 5, 1 ) + +# lower and upper bounds of control +lb <- c( 1, 1, 1, 1 ) +ub <- c( 5, 5, 5, 5 ) + +# lower and upper bounds of constraints +constraint_lb <- c( 25, 40 ) +constraint_ub <- c( Inf, 40 ) + + +opts <- list("print_level"=0, + "file_print_level"=12, + "output_file"="hs071_nlp.out") + +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=eval_grad_f, + lb=lb, + ub=ub, + eval_g=eval_g, + eval_jac_g=eval_jac_g, + constraint_lb=constraint_lb, + constraint_ub=constraint_ub, + eval_jac_g_structure=eval_jac_g_structure, + eval_h=eval_h, + eval_h_structure=eval_h_structure, + opts=opts) ) +} diff --git a/Ipopt-3.13.4/contrib/RInterface/man/ipoptr.Rd b/Ipopt-3.13.4/contrib/RInterface/man/ipoptr.Rd new file mode 100644 index 000000000..e0cb8fdae --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/man/ipoptr.Rd @@ -0,0 +1,261 @@ +\name{ipoptr} +\alias{ipoptr} +\title{ +R interface to Ipopt +} +\description{ +ipoptr is an R interface to Ipopt (Interior Point Optimizer), an open source +software package for large-scale nonlinear optimization. It can be used to +solve general nonlinear programming problems with nonlinear constraints and +lower and upper bounds for the controls. Ipopt is written in C++ and is released +as open source code under the Eclipse Public License (EPL). It is available from +the COIN-OR initiative. The code has been written by Carl Laird and Andreas Waechter, +who is the COIN project leader for Ipopt. + +Ipopt is designed to find (local) solutions of mathematical optimization problems of the from + + min f(x) +x in R^n + +s.t. g_L <= g(x) <= g_U + x_L <= x <= x_U + +where f(x): R^n --> R is the objective function, and g(x): R^n --> R^m are the constraint +functions. The vectors g_L and g_U denote the lower and upper bounds on the constraints, +and the vectors x_L and x_U are the bounds on the variables x. The functions f(x) and g(x) +can be nonlinear and nonconvex, but should be twice continuously differentiable. Note that +equality constraints can be formulated in the above formulation by setting the corresponding +components of g_L and g_U to the same value. +} +\usage{ +ipoptr( x0, + eval_f, + eval_grad_f, + lb = NULL, + ub = NULL, + eval_g = function( x ) { return( numeric(0) ) }, + eval_jac_g = function( x ) { return( numeric(0) ) }, + eval_jac_g_structure = list(), + constraint_lb = numeric(0), + constraint_ub = numeric(0), + eval_h = NULL, + eval_h_structure = NULL, + opts = list(), + ipoptr_environment = new.env(), + ... ) +} + +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{x0}{ + vector with starting values for the optimization. +} + \item{eval_f}{ + function that returns the value of the objective function. +} + \item{eval_grad_f}{ + function that returns the value of the gradient of the objective function. +} + \item{lb}{ + vector with lower bounds of the controls (use -1.0e19 for controls without lower bound). +} + \item{ub}{ + vector with upper bounds of the controls (use 1.0e19 for controls without upper bound). +} + \item{eval_g}{ + function to evaluate (non-)linear constraints that should hold in the solution. +} + \item{eval_jac_g}{ + function to evaluate the jacobian of the (non-)linear constraints that should hold in the solution. +} + \item{eval_jac_g_structure}{ + list of vectors with indices defining the sparseness structure of the Jacobian. + Each element of the list corresponds to a row in the matrix. Each index corresponds + to a non-zero element in the matrix (see also \code{\link[ipoptr:print.sparseness]{print.sparseness}}). +} + \item{constraint_lb}{ + vector with lower bounds of the (non-)linear constraints +} + \item{constraint_ub}{ + vector with upper bounds of the (non-)linear constraints +} + \item{eval_h}{ + function to evaluate the hessian. +} + \item{eval_h_structure}{ + list of vectors with indices defining the sparseness structure of the Hessian. + Each element of the list corresponds to a row in the matrix. Each index corresponds + to a non-zero element in the matrix (see also \code{\link[ipoptr:print.sparseness]{print.sparseness}}). +} + \item{opts}{ + list with options, see examples below. For a full list of options use the option + "print_options_documentation"='yes', or have a look at the Ipopt documentation at + \url{http://www.coin-or.org/Ipopt/documentation/}. + } + \item{ipoptr_environment}{ + environment that is used to evaluate the functions. Use this to pass + additional data or parameters to a function. See the second example in + \code{parameters.R} in the \code{tests} directory. + } + \item{...}{ + arguments that will be passed to the user-defined objective and constraints functions. + } +} +\value{ + The return value contains a list with the inputs, and additional elements + \item{call}{the call that was made to solve} + \item{status}{integer value with the status of the optimization (0 is success)} + \item{message}{more informative message with the status of the optimization} + \item{iterations}{number of iterations that were executed} + \item{objective}{value if the objective function in the solution} + \item{solution}{optimal value of the controls} +} +\references{ +A. Waechter and L. T. Biegler, On the Implementation of a Primal-Dual Interior Point Filter Line Search Algorithm for Large-Scale Nonlinear Programming, Mathematical Programming 106(1), pp. 25-57, 2006 +} +\author{ +Jelmer Ypma +} +\seealso{ +\code{\link{optim}} +\code{\link{nlm}} +\code{\link{nlminb}} +\code{\link[Rsolnp:Rsolnp-package]{Rsolnp}} +\code{\link[Rsolnp:solnp]{ssolnp}} +\code{\link[ipoptr:print.sparseness]{print.sparseness}} +\code{\link[ipoptr:make.sparse]{make.sparse}} +} +\note{See ?`ipoptr-package` for an extended example.} +\examples{ +library('ipoptr') + +## Rosenbrock Banana function +eval_f <- function(x) { + return( 100 * (x[2] - x[1] * x[1])^2 + (1 - x[1])^2 ) + } + +## Gradient of Rosenbrock Banana function +eval_grad_f <- function(x) { + c(-400 * x[1] * (x[2] - x[1] * x[1]) - 2 * (1 - x[1]), + 200 * (x[2] - x[1] * x[1])) + } + +# The Hessian for this problem is actually dense, +# This is a symmetric matrix, fill the lower left triangle only. +eval_h_structure <- list( c(1), c(1,2) ) + +eval_h <- function( x, obj_factor, hessian_lambda ) { + + return( obj_factor*c( 2 - 400*(x[2] - x[1]^2) + 800*x[1]^2, # 1,1 + -400*x[1], # 2,1 + 200 ) ) # 2,2 +} + +# initial values +x0 <- c( -1.2, 1 ) + +opts <- list("print_level"=0, + "file_print_level"=12, + "output_file"="banana.out", + "tol"=1.0e-8) + +# solve Rosenbrock Banana function with analytic hessian +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=eval_grad_f, + eval_h=eval_h, + eval_h_structure=eval_h_structure, + opts=opts) ) + +# solve Rosenbrock Banana function with approximated hessian +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=eval_grad_f, + opts=opts) ) + + + +## +# +# Solve the example taken from the Ipopt C++ +# tutorial document (see Examples/CppTutorial/). +# +# min_x f(x) = -(x2-2)^2 +# s.t. +# 0 = x1^2 + x2 - 1 +# -1 <= x1 <= 1 +# +## + +eval_f <- function( x ) { + print( paste( "In R::eval_f, x = ", paste( c(1,2), collapse=', ' ) ) ) + + return( -(x[2] - 2.0)*(x[2] - 2.0) ) +} + +eval_grad_f <- function( x ) { + return( c(0.0, -2.0*(x[2] - 2.0) ) ) +} + +eval_g <- function( x ) { + return( -(x[1]*x[1] + x[2] - 1.0) ); +} + +# list with indices of non-zero elements +# each element of the list corresponds to the derivative of one constraint +# +# e.g. +# / 0 x x \ +# \ x 0 x / +# would be +# list( c(2,3), c(1,3) ) +eval_jac_g_structure <- list( c(1,2) ) + + +# this should return a vector with all the non-zero elements +# so, no list here, because that is slower I guess +# TODO: make an R-function that shows the structure in matrix form +eval_jac_g <- function( x ) { + return ( c ( -2.0 * x[1], -1.0 ) ) +} + + +# diagonal matrix, usually only fill the lower triangle +eval_h_structure <- list( c(1), c(2) ) + +eval_h <- function( x, obj_factor, hessian_lambda ) { + return ( c( -2.0*hessian_lambda[1], -2.0*obj_factor ) ) +} + +x0 <- c(0.5,1.5) + +lb <- c( -1, -1.0e19 ) +ub <- c( 1, 1.0e19 ) + +constraint_lb <- 0 +constraint_ub <- 0 + +opts <- list("print_level"=0, + "file_print_level"=12, + "output_file"="ipopttest.out") + +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=eval_grad_f, + lb=lb, + ub=ub, + eval_g=eval_g, + eval_jac_g=eval_jac_g, + eval_jac_g_structure=eval_jac_g_structure, + constraint_lb=constraint_lb, + constraint_ub=constraint_ub, + eval_h=eval_h, + eval_h_structure=eval_h_structure, + opts=opts) ) + +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ optimize } +\keyword{ interface } + diff --git a/Ipopt-3.13.4/contrib/RInterface/man/is.ipoptr.Rd b/Ipopt-3.13.4/contrib/RInterface/man/is.ipoptr.Rd new file mode 100644 index 000000000..6b28beaf2 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/man/is.ipoptr.Rd @@ -0,0 +1,35 @@ +\name{is.ipoptr} +\alias{is.ipoptr} +\title{ +R interface to Ipopt +} +\description{ +is.ipoptr preforms checks to see if a fully specified problem is supplied to ipoptr. Mostly for internal use. +} +\usage{ +is.ipoptr( x ) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{x}{ +object to be tested. + } +} +\value{ + Logical. Return TRUE if all tests were passed, otherwise return FALSE or exit with Error. +} +\references{ +A. Waechter and L. T. Biegler, On the Implementation of a Primal-Dual Interior Point Filter Line Search Algorithm for Large-Scale Nonlinear Programming, Mathematical Programming 106(1), pp. 25-57, 2006 +} +\author{ +Jelmer Ypma +} +\seealso{ +\code{\link[ipoptr:ipoptr]{ipoptr}} +\code{\link[ipoptr:print.sparseness]{print.sparseness}} +} + +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ optimize } +\keyword{ interface } diff --git a/Ipopt-3.13.4/contrib/RInterface/man/make.sparse.Rd b/Ipopt-3.13.4/contrib/RInterface/man/make.sparse.Rd new file mode 100644 index 000000000..66bf80328 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/man/make.sparse.Rd @@ -0,0 +1,41 @@ +\name{make.sparse} +\alias{make.sparse} +\title{ +Create sparseness structure from logical matrix +} +\description{ +This function creates the sparseness structure of a logical matrix in the format that is required by ipoptr. +} +\usage{ +make.sparse( A ) +} +\arguments{ + \item{A}{ + Matrix with logicals. TRUE denotes a non-zero element in the matrix. + } +} +\value{ + List of vectors with indices. Each element of the list corresponds to a row in + the matrix. Each index corresponds to a non-zero element in the matrix. +} +\author{ +Jelmer Ypma +} +\seealso{ +\code{\link[ipoptr:ipoptr]{ipoptr}} +\code{\link[ipoptr:print.sparseness]{print.sparseness}} +} +\examples{ +library('ipoptr') +# print lower-diagonal 5x5 matrix generated with make.sparse +A_lower <- make.sparse( lower.tri( matrix(1, nrow=5, ncol=5), diag=TRUE ) ) +print.sparseness( A_lower ) + +# prnit a diagonal 5x5 matrix without indices counts +A_diag <- make.sparse( diag(5) > 0 ) +print.sparseness( A_diag ) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ optimize } +\keyword{ interface } diff --git a/Ipopt-3.13.4/contrib/RInterface/man/plot.sparseness.Rd b/Ipopt-3.13.4/contrib/RInterface/man/plot.sparseness.Rd new file mode 100644 index 000000000..4aaa9965d --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/man/plot.sparseness.Rd @@ -0,0 +1,60 @@ +\name{plot.sparseness} +\alias{plot.sparseness} +\title{ +Plot sparseness structure of matrix +} +\description{ +This function plots the sparseness structure of a matrix in the format that is required by ipoptr. +} +\usage{ +plot.sparseness( x, pch='.', asp=1, xaxs='i', yaxs='i', ... ) +} +\arguments{ + \item{x}{ + list of vectors with indices. Each element of the list corresponds to a row in + the matrix. Each index corresponds to a non-zero element in the matrix. + } + \item{pch}{ + plotting `character'. See \code{\link[graphics:plot]{points}} for possible values. + } + \item{asp}{ + aspect ratio, default = 1. + } + \item{xaxs, yaxs}{ + style of axis interval calculation, default = 'i' (do not extend the axis). See \code{\link[graphics:plot]{par}} for more information. + } + \item{...}{ + further graphical parameters that will be passed to \code{\link[graphics:plot]{plot}}. + } +} +\value{ + A list with the non-zero x and y indices is returned. +} +\author{ +Jelmer Ypma +} +\seealso{ +\code{\link[ipoptr:ipoptr]{ipoptr}} +\code{\link[ipoptr:print.sparseness]{print.sparseness}} +\code{\link[ipoptr:make.sparse]{make.sparse}} +} +\examples{ +library('ipoptr') + +# use different plotting symbol for small matrices +plot.sparseness( make.sparse(diag(5)), pch='x' ) + +# plot large matrix example +s <- make.sparse( lower.tri( matrix( 1, 500, 500), diag=TRUE ) ) +plot.sparseness( s ) + +# plot another large matrix +s <- do.call( "cbind", lapply( 1:5, function(i) { diag(5) \%x\% matrix(1, nrow=5, ncol=20) } ) ) +s <- do.call( "rbind", lapply( 1:10, function(i) { s } ) ) +s <- cbind( matrix( 1, nrow=nrow(s), ncol=40 ), s ) +plot.sparseness( make.sparse( s ) ) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ optimize } +\keyword{ interface } diff --git a/Ipopt-3.13.4/contrib/RInterface/man/print.ipoptr.Rd b/Ipopt-3.13.4/contrib/RInterface/man/print.ipoptr.Rd new file mode 100644 index 000000000..cf4ef257d --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/man/print.ipoptr.Rd @@ -0,0 +1,32 @@ +\name{print.ipoptr} +\alias{print.ipoptr} +\title{ +Print results after running ipoptr +} +\description{ +This function prints the ipoptr object that holds the results from a minimization using \code{ipoptr}. +} +\usage{ +\method{print}{ipoptr}( x, show.controls=TRUE, \dots ) +} +\arguments{ + \item{x}{ + object containing result from minimization. + } + \item{show.controls}{ + Logical or vector with indices. Should we show the value of the control variables in the solution? If code{show.controls} is a vector with indices, it is used to select which control variables should be shown. This can be useful if the model contains a set of parameters of interest and a set of nuisance parameters that are not of immediate interest. + } + \item{...}{ + further arguments passed to or from other methods. + } +} +\author{ +Jelmer Ypma +} +\seealso{ +\code{\link[ipoptr:ipoptr]{ipoptr}} +\code{\link[ipoptr:make.sparse]{make.sparse}} +\code{\link[ipoptr:print.sparseness]{print.sparseness}} +} +\keyword{ optimize } +\keyword{ interface } diff --git a/Ipopt-3.13.4/contrib/RInterface/man/print.sparseness.Rd b/Ipopt-3.13.4/contrib/RInterface/man/print.sparseness.Rd new file mode 100644 index 000000000..7c605a5a7 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/man/print.sparseness.Rd @@ -0,0 +1,92 @@ +\name{print.sparseness} +\alias{print.sparseness} +\title{ +Show sparseness structure of matrix +} +\description{ +This function shows the sparseness structure of a matrix in the format that is required by ipoptr. +} +\usage{ +print.sparseness( x, indices=TRUE, data=NULL, ncol=NULL, ... ) +} +\arguments{ + \item{x}{ + list of vectors with indices. Each element of the list corresponds to a row in + the matrix. Each index corresponds to a non-zero element in the matrix. + } + \item{indices}{ + Logical. Should we show the order of the non-zero elements or just whether an element is non-zero? + } + \item{data}{ + vector with non-zero elements of the sparse matrix. + } + \item{ncol}{ + integer supplying the number of columns of the sparse matrix. If this is not supplied, + we take the number of columns as the largest index in \code{s}. + } + \item{...}{ + further arguments passed to or from other methods. + } +} +\value{ + A matrix showing the sparseness structure is returned. +} +\author{ +Jelmer Ypma +} +\seealso{ +\code{\link[ipoptr:ipoptr]{ipoptr}} +\code{\link[ipoptr:plot.sparseness]{plot.sparseness}} +\code{\link[ipoptr:make.sparse]{make.sparse}} +} +\examples{ +library('ipoptr') + +# print lower-diagonal 4x4 matrix +print.sparseness( list( c(1), c(1,2), c(1,2,3), c(1,2,3,4) ) ) + +# print diagonal 3x3 matrix without indices counts +print.sparseness( list( c(1), c(2), c(3) ), indices=FALSE ) + +# print a third sparse matrix +print.sparseness( list( c(1,3,6,8), c(2,5), c(3,7,9) ) ) + +# and a fourth one, where the elements are in a different order +print.sparseness( list( c(3,1,6,8), c(2,5), c(3,9,7) ) ) + +# print lower-diagonal 5x5 matrix generated with make.sparse +A_lower <- make.sparse( lower.tri( matrix(1, nrow=5, ncol=5), diag=TRUE ) ) +print.sparseness( A_lower ) + +# print a diagonal 5x5 matrix without indices counts +A_diag <- make.sparse( diag(5) > 0 ) +print.sparseness( A_diag ) + +# example from tests/lasso.R +n <- 100 # number of observations +m <- 5 # number of variables + +# define hessian function +hessian <- function( A ) { + H <- t(A) %*% A + H <- unlist( lapply( 1:m, function(i) { H[i,1:i] } ) ) + + return( H ) +} + +# define the structure +hessian_structure <- c( lapply( 1:m, function(x) { return( c(1:x) ) } ), + lapply( 1:m, function(x) { return( c() ) } ) ) + +# generate data +set.seed( 3141 ) +A <- hessian( matrix( rnorm( n*m ), nrow=n, ncol=m ) ) +print.sparseness( x = hessian_structure, + indices = TRUE, + data = format( A, digits=2, nsmall=2, justify='right'), + ncol = 2*m ) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ optimize } +\keyword{ interface } diff --git a/Ipopt-3.13.4/contrib/RInterface/src/IpoptRJournal.cpp b/Ipopt-3.13.4/contrib/RInterface/src/IpoptRJournal.cpp new file mode 100644 index 000000000..1749be574 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/src/IpoptRJournal.cpp @@ -0,0 +1,57 @@ +/* Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. + * This code is published under the Eclipse Public License. + * + * file: IpoptRJournal.cpp + * author: Jelmer Ypma + * date: 30 January 2011 + * + * This file defines a C++ class that takes care of re-directing + * output to the R terminal. Needed for Windows. + * + * Financial support of the UK Economic and Social Research Council + * through a grant (RES-589-28-0001) to the ESRC Centre for Microdata + * Methods and Practice (CeMMAP) is gratefully acknowledged. + */ + +#include "IpoptRJournal.hpp" + +IpoptRJournal::IpoptRJournal( + Ipopt::EJournalLevel default_level +) + : Journal("IpoptRJournal", default_level) +{ } + +void IpoptRJournal::PrintImpl( + Ipopt::EJournalCategory /*category*/, + Ipopt::EJournalLevel /*level*/, + const char* str +) +{ + // print string to R console + Rprintf(str); +} + +void IpoptRJournal::PrintfImpl( + Ipopt::EJournalCategory /*category*/, + Ipopt::EJournalLevel /*level*/, + const char* pformat, + va_list ap +) +{ + // Define string + const int MaxStrLen = 8192; + char s[MaxStrLen]; + + // R guarantees to have an implementation of vsnprintf available + // http://www.mail-archive.com/r-devel@stat.math.ethz.ch/msg07054.html + if( vsnprintf(s, MaxStrLen, pformat, ap) > MaxStrLen ) + { + Rprintf("Warning: not all characters of next line are printed to the R console.\n"); + } + + // print string to R console + Rprintf(s); +} + +void IpoptRJournal::FlushBufferImpl() +{ } diff --git a/Ipopt-3.13.4/contrib/RInterface/src/IpoptRJournal.hpp b/Ipopt-3.13.4/contrib/RInterface/src/IpoptRJournal.hpp new file mode 100644 index 000000000..fe6817dcb --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/src/IpoptRJournal.hpp @@ -0,0 +1,52 @@ +/* Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. + * This code is published under the Eclipse Public License. + * + * file: IpoptRJournal.hpp + * author: Jelmer Ypma + * date: 30 January 2011 + * + * This file defines a C++ class that takes care of re-directing + * output to the R terminal. Needed for Windows. + * + * Financial support of the UK Economic and Social Research Council + * through a grant (RES-589-28-0001) to the ESRC Centre for Microdata + * Methods and Practice (CeMMAP) is gratefully acknowledged. + */ + +#ifndef __IpoptRJournal_HPP__ +#define __IpoptRJournal_HPP__ + +#include "IpJournalist.hpp" // ISA Journal +#include // USES Rprintf + +class IpoptRJournal: public Ipopt::Journal +{ +public: + // The constructor. + IpoptRJournal( + Ipopt::EJournalLevel default_level + ); + + // The destructor. + virtual ~IpoptRJournal() + { } + +protected: + // These functions override the functions in the Journal class. + virtual void PrintImpl( + Ipopt::EJournalCategory category, + Ipopt::EJournalLevel level, + const char* str + ); + + virtual void PrintfImpl( + Ipopt::EJournalCategory category, + Ipopt::EJournalLevel level, + const char* pformat, + va_list ap + ); + + virtual void FlushBufferImpl(); +}; + +#endif diff --git a/Ipopt-3.13.4/contrib/RInterface/src/IpoptRNLP.cpp b/Ipopt-3.13.4/contrib/RInterface/src/IpoptRNLP.cpp new file mode 100644 index 000000000..36629d668 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/src/IpoptRNLP.cpp @@ -0,0 +1,722 @@ +/* Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. + * This code is published under the Eclipse Public License. + * + * file: IpoptRNLP.cpp + * author: Jelmer Ypma + * date: 18 April 2010 + * + * This file defines a C++ class that derives from Ipopt::TNLP. The class + * takes care of interaction between Ipopt and user-defined functions in R. + * + * Financial support of the UK Economic and Social Research Council + * through a grant (RES-589-28-0001) to the ESRC Centre for Microdata + * Methods and Practice (CeMMAP) is gratefully acknowledged. + * + * Changelog: + * 09/03/2012: added outputs in finalize_solution; z_L, z_U, constraints, lambda (thanks to Michael Schedl) + */ + +#include "IpoptRNLP.hpp" + +/* Constructor. */ +IpoptRNLP::IpoptRNLP() + : d_hessian_approximation(false), + d_num_protected_members(0) +{ } + +IpoptRNLP::~IpoptRNLP() +{ + // UNPROTECT all SEXP members that we PROTECT + UNPROTECT(d_num_protected_members); +} + +// +// Functions to load R Objects into IpoptRProblem +// +void IpoptRNLP::set_R_environment( + SEXP env +) +{ + PROTECT(R_environment = env); + d_num_protected_members++; +} + +void IpoptRNLP::set_R_eval_f( + SEXP f +) +{ + PROTECT(R_eval_f = f); + d_num_protected_members++; +} + +void IpoptRNLP::set_R_eval_grad_f( + SEXP f +) +{ + PROTECT(R_eval_grad_f = f); + d_num_protected_members++; +} + +void IpoptRNLP::set_R_init_values( + SEXP x0 +) +{ + PROTECT(R_init_values = x0); + d_num_protected_members++; +} + +void IpoptRNLP::set_R_lower_bounds( + SEXP lb +) +{ + PROTECT(R_lower_bounds = lb); + d_num_protected_members++; +} + +void IpoptRNLP::set_R_upper_bounds( + SEXP ub +) +{ + PROTECT(R_upper_bounds = ub); + d_num_protected_members++; +} + +void IpoptRNLP::set_R_eval_g( + SEXP g +) +{ + PROTECT(R_eval_g = g); + d_num_protected_members++; +} + +void IpoptRNLP::set_R_eval_jac_g( + SEXP g +) +{ + PROTECT(R_eval_jac_g = g); + d_num_protected_members++; +} + +void IpoptRNLP::set_R_eval_jac_g_structure( + SEXP s +) +{ + PROTECT(R_eval_jac_g_structure = s); + d_num_protected_members++; +} + +void IpoptRNLP::set_R_constraint_lower_bounds( + SEXP lb +) +{ + PROTECT(R_constraint_lower_bounds = lb); + d_num_protected_members++; +} + +void IpoptRNLP::set_R_constraint_upper_bounds( + SEXP ub +) +{ + PROTECT(R_constraint_upper_bounds = ub); + d_num_protected_members++; +} + +void IpoptRNLP::set_R_eval_h( + SEXP h +) +{ + PROTECT(R_eval_h = h); + d_num_protected_members++; +} + +void IpoptRNLP::set_R_eval_h_structure( + SEXP s +) +{ + PROTECT(R_eval_h_structure = s); + d_num_protected_members++; +} + +void IpoptRNLP::set_hessian_approximation( + bool b +) +{ + d_hessian_approximation = b; +} + +SEXP IpoptRNLP::get_R_result_list() +{ + return R_result_list; +} + +bool IpoptRNLP::get_nlp_info( + Ipopt::Index& n, + Ipopt::Index& m, + Ipopt::Index& nnz_jac_g, + Ipopt::Index& nnz_h_lag, + IndexStyleEnum& index_style +) +{ + // Check for user interruption from R + R_CheckUserInterrupt(); + + // number of control variables + n = length(R_init_values); + + // number of constraints + m = length(R_constraint_lower_bounds); + + // Loop over the elements in R_eval_jac_g_structure and count the number of non-zero indices + // in the Jacobian. As far as I know unlist() does not exist in C, so we cannot call that directly. + nnz_jac_g = 0; + for( int list_cnt = 0; list_cnt < length(R_eval_jac_g_structure); list_cnt++ ) + { + + SEXP R_list_element; + PROTECT(R_list_element = AS_INTEGER(VECTOR_ELT(R_eval_jac_g_structure, list_cnt))); + + nnz_jac_g += length(R_list_element); + UNPROTECT(1); + } + + // Loop over the elements in R_eval_h_structure and count the number of non-zero indices + // in the hessian of the lagrangian (combined hessian of the objective and hessian of the constraints). + + nnz_h_lag = 0; + for( int list_cnt = 0; list_cnt < length(R_eval_h_structure); list_cnt++ ) + { + + SEXP R_list_element; + PROTECT(R_list_element = AS_INTEGER(VECTOR_ELT(R_eval_h_structure, list_cnt))); + + nnz_h_lag += length(R_list_element); + UNPROTECT(1); + } + + // We use the standard Fortran Ipopt::Index style for row/col entries, + // This is the same as R, start counting indices in the structure matrices at 1 + index_style = FORTRAN_STYLE; + + return true; +} + +bool IpoptRNLP::get_bounds_info( + Ipopt::Index n, + Ipopt::Number* x_l, + Ipopt::Number* x_u, + Ipopt::Index m, + Ipopt::Number* g_l, + Ipopt::Number* g_u +) +{ + // Check that the number of controls, n, and the number of constraints, m + // are of the same length as the R variables that were passed. + assert(n == length(R_init_values)); + assert(n == length(R_lower_bounds)); + assert(n == length(R_upper_bounds)); + assert(m == length(R_constraint_lower_bounds)); + assert(m == length(R_constraint_upper_bounds)); + + // Check for user interruption from R + R_CheckUserInterrupt(); + + // set the upper and lower bounds of the control + for( Ipopt::Index i = 0; i < n; i++ ) + { + x_l[i] = REAL(R_lower_bounds)[i]; // lower bound + x_u[i] = REAL(R_upper_bounds)[i]; // upper bound + } + + // set the upper and lower bounds of the inequality constraints + for( Ipopt::Index i = 0; i < m; i++ ) + { + g_l[i] = REAL(R_constraint_lower_bounds)[i]; // lower bound + g_u[i] = REAL(R_constraint_upper_bounds)[i]; // upper bound + } + + return true; +} + +bool IpoptRNLP::get_starting_point( + Ipopt::Index n, + bool init_x, + Ipopt::Number* x, + bool init_z, + Ipopt::Number* /*z_L*/, + Ipopt::Number* /*z_U*/, + Ipopt::Index /*m*/, + bool init_lambda, + Ipopt::Number* /*lambda*/ +) +{ + // We have starting values for the control, x, only. + assert(init_x == true); + (void) init_x; + assert(init_z == false); + (void) init_z; + assert(init_lambda == false); + (void) init_lambda; + + // Check for user interruption from R + R_CheckUserInterrupt(); + + // set initial values of the controls + for( Ipopt::Index i = 0; i < n; i++ ) + { + x[i] = REAL(R_init_values)[i]; + } + + return true; +} + +bool IpoptRNLP::eval_f( + Ipopt::Index n, + const Ipopt::Number* x, + bool /*new_x*/, + Ipopt::Number& obj_value +) +{ + // Calculate and return the value of the objective function + + // Check for user interruption from R + R_CheckUserInterrupt(); + + SEXP rargs, Rcall, result; + + // Allocate memory for a vector of reals. + // This vector will contain the elements of x, + // x is the argument to the R function R_eval_f + PROTECT(rargs = allocVector(REALSXP, n)); + for( Ipopt::Index i = 0; i < n; i++ ) + { + REAL(rargs)[i] = x[i]; + } + + // evaluate R function R_eval_f with the control x as an argument + PROTECT(Rcall = lang2(R_eval_f, rargs)); + PROTECT(result = eval(Rcall, R_environment)); + + // recode the return value from SEXP to Number + obj_value = REAL(result)[0]; + + UNPROTECT(3); + + return true; +} + +bool IpoptRNLP::eval_grad_f( + Ipopt::Index n, + const Ipopt::Number* x, + bool /*new_x*/, + Ipopt::Number* grad_f +) +{ + // Calculate and return the gradient of the objective function grad_{x} f(x) + + // if we have two controls, x1 and x2: + // grad_f[0] = grad_{x1} f(x) + // grad_f[1] = grad_{x2} f(x) + + // Check for user interruption from R + R_CheckUserInterrupt(); + + SEXP rargs, Rcall, result; + + // allocate memory for a vector of reals + // this vector will contain the elements of x + // x is the argument to the R function R_eval_grad_f + PROTECT(rargs = allocVector(REALSXP, n)); + for( Ipopt::Index i = 0; i < n; i++ ) + { + REAL(rargs)[i] = x[i]; + } + + // evaluate R function R_eval_grad_f with the control x as an argument + PROTECT(Rcall = lang2(R_eval_grad_f, rargs)); + PROTECT(result = eval(Rcall, R_environment)); + + // recode the return values from SEXP to Numbers + for( Ipopt::Index i = 0; i < n; i++ ) + { + grad_f[i] = REAL(result)[i]; + } + + UNPROTECT(3); + + return true; +} + +bool IpoptRNLP::eval_g( + Ipopt::Index n, + const Ipopt::Number* x, + bool /*new_x*/, + Ipopt::Index m, + Ipopt::Number* g +) +{ + // Calculate and return the value of the constraints: g(x) + + // Check for user interruption from R + R_CheckUserInterrupt(); + + SEXP rargs, Rcall, result; + + // Allocate memory for a vector of reals + // this vector will contain the elements of x + // x is the argument to the R function R_eval_g + PROTECT(rargs = allocVector(REALSXP, n)); + for( Ipopt::Index i = 0; i < n; i++ ) + { + REAL(rargs)[i] = x[i]; + } + + PROTECT(Rcall = lang2(R_eval_g, rargs)); + PROTECT(result = eval(Rcall, R_environment)); + + for( Ipopt::Index i = 0; i < m; i++ ) + { + g[i] = REAL(result)[i]; + } + + UNPROTECT(3); + + return true; +} + +bool IpoptRNLP::eval_jac_g( + Ipopt::Index n, + const Ipopt::Number* x, + bool /*new_x*/, + Ipopt::Index /*m*/, + Ipopt::Index nele_jac, + Ipopt::Index* iRow, + Ipopt::Index* jCol, + Ipopt::Number* values +) +{ + // These use Fortran indexing style and start counting at 1 + + // Check for user interruption from R + R_CheckUserInterrupt(); + + if( values == NULL ) + { + // return the structure of the jacobian of the constraints + + // element at 1,1: grad_{x1} g_{1}(x) + //iRow[0] = 1; + //jCol[0] = 1; + + // element at 1,2: grad_{x2} g_{1}(x) + //iRow[1] = 1; + //jCol[1] = 2; + + Ipopt::Index total_cnt = 0; + for( int list_cnt = 0; list_cnt < length(R_eval_jac_g_structure); list_cnt++ ) + { + + SEXP R_list_element; + PROTECT(R_list_element = AS_INTEGER(VECTOR_ELT(R_eval_jac_g_structure, list_cnt))); + for( int vector_cnt = 0; vector_cnt < length(R_list_element); vector_cnt++ ) + { + iRow[total_cnt] = list_cnt + 1; // we have to add 1 to turn it into Fortran styl indexing + jCol[total_cnt] = INTEGER(R_list_element)[vector_cnt]; + total_cnt++; + } + UNPROTECT(1); + } + + } + else + { + // return the values of the jacobian of the constraints + + SEXP rargs, Rcall, result; + + // allocate memory for a vector of reals + // this vector will contain the elements of x + // x is the argument to the R function R_eval_g_jac + PROTECT(rargs = allocVector(REALSXP, n)); + for( Ipopt::Index i = 0; i < n; i++ ) + { + REAL(rargs)[i] = x[i]; + } + + PROTECT(Rcall = lang2(R_eval_jac_g, rargs)); + PROTECT(result = eval(Rcall, R_environment)); + + for( Ipopt::Index i = 0; i < nele_jac; i++ ) + { + values[i] = REAL(result)[i]; + } + + UNPROTECT(3); + + } + + return true; +} + +bool IpoptRNLP::eval_h( + Ipopt::Index n, + const Ipopt::Number* x, + bool /*new_x*/, + Ipopt::Number obj_factor, + Ipopt::Index m, + const Ipopt::Number* lambda, + bool /*new_lambda*/, + Ipopt::Index nele_hess, + Ipopt::Index* iRow, + Ipopt::Index* jCol, + Ipopt::Number* values +) +{ + + // Check for user interruption from R + R_CheckUserInterrupt(); + + if( d_hessian_approximation ) + { + return false; + } + else + { + + if( values == NULL ) + { + // return the structure. This is a symmetric matrix, fill the lower left + // triangle only. + // Note: off-diagonal elements are zero for this problem + // element at 1,1: grad^2_{x1,x1} L(x,lambda) + // iRow[0] = 1; + // jCol[0] = 1; + + // element at 2,2: grad^2_{x2,x2} L(x,lambda) + // iRow[1] = 2; + // jCol[1] = 2; + + Ipopt::Index total_cnt = 0; + for( int list_cnt = 0; list_cnt < length(R_eval_h_structure); list_cnt++ ) + { + + SEXP R_list_element; + PROTECT(R_list_element = AS_INTEGER(VECTOR_ELT(R_eval_h_structure, list_cnt))); + for( int vector_cnt = 0; vector_cnt < length(R_list_element); vector_cnt++ ) + { + iRow[total_cnt] = list_cnt + 1; // we have to add 1 to turn it into Fortran styl indexing + jCol[total_cnt] = INTEGER(R_list_element)[vector_cnt]; + total_cnt++; + } + UNPROTECT(1); + } + + } + else + { + // return the values + + // element at 1,1: grad^2_{x1,x1} L(x,lambda) + // values[0] = -2.0 * lambda[0]; + + // element at 2,2: grad^2_{x2,x2} L(x,lambda) + // values[1] = -2.0 * obj_factor; + + SEXP rargs_x; + PROTECT(rargs_x = allocVector(REALSXP, n)); + for( Ipopt::Index i = 0; i < n; i++ ) + { + REAL(rargs_x)[i] = x[i]; + } + + SEXP rargs_obj_factor; + PROTECT(rargs_obj_factor = allocVector(REALSXP, 1)); + REAL(rargs_obj_factor)[0] = obj_factor; + + SEXP rargs_lambda; + PROTECT(rargs_lambda = allocVector(REALSXP, m)); + for( Ipopt::Index i = 0; i < m; i++ ) + { + REAL(rargs_lambda)[i] = lambda[i]; + } + + SEXP Rcall, result; + PROTECT(Rcall = lang4(R_eval_h, rargs_x, rargs_obj_factor, rargs_lambda)); + PROTECT(result = eval(Rcall, R_environment)); + + for( Ipopt::Index i = 0; i < nele_hess; i++ ) + { + values[i] = REAL(result)[i]; + } + + UNPROTECT(5); + } + + return true; + } +} + +void IpoptRNLP::finalize_solution( + Ipopt::SolverReturn status, + Ipopt::Index n, + const Ipopt::Number* x, + const Ipopt::Number* z_L, + const Ipopt::Number* z_U, + Ipopt::Index m, + const Ipopt::Number* g, + const Ipopt::Number* lambda, + Ipopt::Number obj_value, + const Ipopt::IpoptData* /*ip_data*/, + Ipopt::IpoptCalculatedQuantities* /*ip_cq*/ +) +{ + // Here we convert the results from c++ to an SEXP list with elements + // 0. status; integer with convergence status + // 1. message; string with convergence status + // 2. iterations; number of iterations + // 3. objective; final value of the objective function + // 4. solution; final values for the control variables + // 5. z_L; final values for the lower bound multipliers + // 6. z_U; final values for the upper bound multipliers + // 7. constraints; final values for the constraints + // 8. lambda; final values for the Lagrange multipliers + int num_return_elements = 9; + + // R_result_list is a member object, which has been protected in the constructor + // and will be unprotected in the destructor. + PROTECT(R_result_list = allocVector(VECSXP, num_return_elements)); + d_num_protected_members++; + + // attach names to the return list + SEXP names; + PROTECT(names = allocVector(STRSXP, num_return_elements)); + + SET_STRING_ELT(names, 0, mkChar("status")); + SET_STRING_ELT(names, 1, mkChar("message")); + SET_STRING_ELT(names, 2, mkChar("iterations")); + SET_STRING_ELT(names, 3, mkChar("objective")); + SET_STRING_ELT(names, 4, mkChar("solution")); + SET_STRING_ELT(names, 5, mkChar("z_L")); + SET_STRING_ELT(names, 6, mkChar("z_U")); + SET_STRING_ELT(names, 7, mkChar("constraints")); + SET_STRING_ELT(names, 8, mkChar("lambda")); + setAttrib(R_result_list, R_NamesSymbol, names); + + // convert status to an R object + SEXP R_status; + PROTECT(R_status = allocVector(INTSXP, 1)); + INTEGER(R_status)[0] = (int) status; + + SEXP R_status_message; + PROTECT(R_status_message = allocVector(STRSXP, 1)); + switch( status ) + { + case Ipopt::SUCCESS: + SET_STRING_ELT(R_status_message, 0, + mkChar( + "SUCCESS: Algorithm terminated successfully at a locally optimal point, satisfying the convergence tolerances (can be specified by options).")); + break; + case Ipopt::MAXITER_EXCEEDED: + SET_STRING_ELT(R_status_message, 0, + mkChar("MAXITER_EXCEEDED: Maximum number of iterations exceeded (can be specified by an option).")); + break; + case Ipopt::STOP_AT_TINY_STEP: + SET_STRING_ELT(R_status_message, 0, + mkChar("STOP_AT_TINY_STEP: Algorithm proceeds with very little progress.")); + break; + case Ipopt::STOP_AT_ACCEPTABLE_POINT: + SET_STRING_ELT(R_status_message, 0, + mkChar( + "STOP_AT_ACCEPTABLE_POINT: Algorithm stopped at a point that was converged, not to ``desired'' tolerances, but to ``acceptable'' tolerances (see the acceptable-... options).")); + break; + case Ipopt::LOCAL_INFEASIBILITY: + SET_STRING_ELT(R_status_message, 0, + mkChar( + "LOCAL_INFEASIBILITY: Algorithm converged to a point of local infeasibility. Problem may be infeasible.")); + break; + case Ipopt::USER_REQUESTED_STOP: + SET_STRING_ELT(R_status_message, 0, + mkChar( + "USER_REQUESTED_STOP: The user call-back function intermediate_callback (see Section 3.3.4) returned false, i.e., the user code requested a premature termination of the optimization.")); + break; + case Ipopt::DIVERGING_ITERATES: + SET_STRING_ELT(R_status_message, 0, mkChar("DIVERGING_ITERATES: It seems that the iterates diverge.")); + break; + case Ipopt::RESTORATION_FAILURE: + SET_STRING_ELT(R_status_message, 0, + mkChar("RESTORATION_FAILURE: Restoration phase failed, algorithm doesn't know how to proceed.")); + break; + case Ipopt::ERROR_IN_STEP_COMPUTATION: + SET_STRING_ELT(R_status_message, 0, + mkChar( + "ERROR_IN_STEP_COMPUTATION: An unrecoverable error occurred while IPOPT tried to compute the search direction.")); + break; + case Ipopt::INVALID_NUMBER_DETECTED: + SET_STRING_ELT(R_status_message, 0, + mkChar( + "INVALID_NUMBER_DETECTED: Algorithm received an invalid number (such as NaN or Inf) from the NLP; see also option check_derivatives_for_naninf.")); + break; + case Ipopt::INTERNAL_ERROR: + SET_STRING_ELT(R_status_message, 0, + mkChar( + "INTERNAL_ERROR: An unknown internal error occurred. Please contact the IPOPT authors through the mailing list.")); + break; + default: + SET_STRING_ELT(R_status_message, 0, mkChar("Return status not recognized.")); + + } + + // !!! we add number of iterations in the main program + + // convert value of objective function to an R object + SEXP R_objective; + PROTECT(R_objective = allocVector(REALSXP, 1)); + REAL(R_objective)[0] = obj_value; + + // convert the value of the controls to an R object + SEXP R_solution; + PROTECT(R_solution = allocVector(REALSXP, n)); + for( Ipopt::Index i = 0; i < n; i++ ) + { + REAL(R_solution)[i] = x[i]; + } + + SEXP R_z_L; + PROTECT(R_z_L = allocVector(REALSXP, n)); + for( Ipopt::Index i = 0; i < n; i++ ) + { + REAL(R_z_L)[i] = z_L[i]; + } + + SEXP R_z_U; + PROTECT(R_z_U = allocVector(REALSXP, n)); + for( Ipopt::Index i = 0; i < n; i++ ) + { + REAL(R_z_U)[i] = z_U[i]; + } + + SEXP R_constraints; + PROTECT(R_constraints = allocVector(REALSXP, m)); + for( Ipopt::Index i = 0; i < m; i++ ) + { + REAL(R_constraints)[i] = g[i]; + } + + SEXP R_lambda; + PROTECT(R_lambda = allocVector(REALSXP, m)); + for( Ipopt::Index i = 0; i < m; i++ ) + { + REAL(R_lambda)[i] = lambda[i]; + } + + // add elements to the list + SET_VECTOR_ELT(R_result_list, 0, R_status); + SET_VECTOR_ELT(R_result_list, 1, R_status_message); + SET_VECTOR_ELT(R_result_list, 3, R_objective); + SET_VECTOR_ELT(R_result_list, 4, R_solution); + SET_VECTOR_ELT(R_result_list, 5, R_z_L); + SET_VECTOR_ELT(R_result_list, 6, R_z_U); + SET_VECTOR_ELT(R_result_list, 7, R_constraints); + SET_VECTOR_ELT(R_result_list, 8, R_lambda); + + UNPROTECT(num_return_elements); +} diff --git a/Ipopt-3.13.4/contrib/RInterface/src/IpoptRNLP.hpp b/Ipopt-3.13.4/contrib/RInterface/src/IpoptRNLP.hpp new file mode 100644 index 000000000..8549abd0b --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/src/IpoptRNLP.hpp @@ -0,0 +1,228 @@ +/* Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. + * This code is published under the Eclipse Public License. + * + * file: IpoptRNLP.hpp + * author: Jelmer Ypma + * date: 18 April 2010 + * + * This file defines a C++ class that derives from Ipopt::TNLP. The class + * takes care of interaction between Ipopt and user-defined functions in R. + * + * Financial support of the UK Economic and Social Research Council + * through a grant (RES-589-28-0001) to the ESRC Centre for Microdata + * Methods and Practice (CeMMAP) is gratefully acknowledged. + */ + +#ifndef __IpoptRNLP_HPP__ +#define __IpoptRNLP_HPP__ + +#include "IpTNLP.hpp" // ISA TNLP + +#include + +#include +#include +#include +// Rdefines.h is somewhat more higher level then Rinternal.h, and is preferred if the code might be shared with S at any stage. +// Utils.h defines void R_CheckUserInterrupt(void); to allow user interuption from R + +class IpoptRNLP: public Ipopt::TNLP +{ + /** This is the environment that the function gets called in. + * This environment can be used to pass common data to the R functions. + */ + SEXP R_environment; + SEXP R_eval_f; ///< objective function + SEXP R_eval_grad_f; ///< gradient of objective function + + SEXP R_init_values; ///< vector with initial values, we get the Ipopt::Number of controls from the length of this vector + + SEXP R_lower_bounds; ///< lower bounds of the control x + SEXP R_upper_bounds; ///< upper bounds of the control x + + SEXP R_eval_g; ///< function to evaluate constraints + SEXP R_eval_jac_g; ///< function to evaluate jacobian of constraints + SEXP R_eval_jac_g_structure; ///< list with non-zero elements in the Jacobian, this defines the sparse structure + + SEXP R_constraint_lower_bounds; ///< lower bounds of the contraint function g() + SEXP R_constraint_upper_bounds; ///< upper bounds of the contraint function g() + + SEXP R_eval_h; ///< function to evaluate Hessian + SEXP R_eval_h_structure; ///< list with non-zero elements of the Hessian, this defines the sparse structure + + SEXP R_result_list; ///< structure that will contain the return values + + bool d_hessian_approximation; ///< should we approximate the Hessian? default: false + + int d_num_protected_members; ///< counter of the number of PROTECT calls of the SEXPs above +public: + /** default constructor */ + IpoptRNLP(); + + /** default destructor */ + virtual ~IpoptRNLP(); + + void set_R_environment( + SEXP env + ); + + void set_R_eval_f( + SEXP f + ); + void set_R_eval_grad_f( + SEXP f + ); + + void set_R_init_values( + SEXP x0 + ); + void set_R_lower_bounds( + SEXP lb + ); + void set_R_upper_bounds( + SEXP ub + ); + + void set_R_eval_g( + SEXP g + ); + void set_R_eval_jac_g( + SEXP g + ); + void set_R_eval_jac_g_structure( + SEXP s + ); + + void set_R_constraint_lower_bounds( + SEXP lb + ); + void set_R_constraint_upper_bounds( + SEXP ub + ); + + void set_R_eval_h( + SEXP h + ); + void set_R_eval_h_structure( + SEXP s + ); + + void set_hessian_approximation( + bool b + ); + + SEXP get_R_result_list(); + + virtual bool get_nlp_info( + Ipopt::Index& n, + Ipopt::Index& m, + Ipopt::Index& nnz_jac_g, + Ipopt::Index& nnz_h_lag, + IndexStyleEnum& Index_style + ); + + virtual bool get_bounds_info( + Ipopt::Index n, + Ipopt::Number* x_l, + Ipopt::Number* x_u, + Ipopt::Index m, + Ipopt::Number* g_l, + Ipopt::Number* g_u + ); + + virtual bool get_starting_point( + Ipopt::Index n, + bool init_x, + Ipopt::Number* x, + bool init_z, + Ipopt::Number* z_L, + Ipopt::Number* z_U, + Ipopt::Index m, + bool init_lambda, + Ipopt::Number* lambda + ); + + virtual bool eval_f( + Ipopt::Index n, + const Ipopt::Number* x, + bool new_x, + Ipopt::Number& obj_value + ); + + virtual bool eval_grad_f( + Ipopt::Index n, + const Ipopt::Number* x, + bool new_x, + Ipopt::Number* grad_f + ); + + virtual bool eval_g( + Ipopt::Index n, + const Ipopt::Number* x, + bool new_x, + Ipopt::Index m, + Ipopt::Number* g + ); + + virtual bool eval_jac_g( + Ipopt::Index n, + const Ipopt::Number* x, + bool new_x, + Ipopt::Index m, + Ipopt::Index nele_jac, + Ipopt::Index* iRow, + Ipopt::Index* jCol, + Ipopt::Number* values + ); + + virtual bool eval_h( + Ipopt::Index n, + const Ipopt::Number* x, + bool new_x, + Ipopt::Number obj_factor, + Ipopt::Index m, + const Ipopt::Number* lambda, + bool new_lambda, + Ipopt::Index nele_hess, + Ipopt::Index* iRow, + Ipopt::Index* jCol, + Ipopt::Number* values + ); + + virtual void finalize_solution( + Ipopt::SolverReturn status, + Ipopt::Index n, + const Ipopt::Number* x, + const Ipopt::Number* z_L, + const Ipopt::Number* z_U, + Ipopt::Index m, + const Ipopt::Number* g, + const Ipopt::Number* lambda, + Ipopt::Number obj_value, + const Ipopt::IpoptData* ip_data, + Ipopt::IpoptCalculatedQuantities* ip_cq + ); + +private: + /**@name Methods to block default compiler methods. + * The compiler automatically generates the following three methods. + * Since the default compiler implementation is generally not what + * you want (for all but the most simple classes), we usually + * put the declarations of these methods in the private section + * and never implement them. This prevents the compiler from + * implementing an incorrect "default" behavior without us + * knowing. (See Scott Meyers book, "Effective C++") + * + */ + //@{ + // IpoptRNLP(); + IpoptRNLP( + const IpoptRNLP& + ); + IpoptRNLP& operator=( + const IpoptRNLP& + ); + //@} +}; + +#endif diff --git a/Ipopt-3.13.4/contrib/RInterface/src/Makevars.in b/Ipopt-3.13.4/contrib/RInterface/src/Makevars.in new file mode 100644 index 000000000..92720330a --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/src/Makevars.in @@ -0,0 +1,37 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: Makevars.in +# Author: Jelmer Ypma +# Date: 14 April 2010 +# +# Changelog: +# 30/01/2011 - Changed LIBS to IPOPT_LIBS and INCL to IPOPT_INCL, since R re-defines LIBS and INCL. + + +# C++ Compiler command +CXX = @CXX@ + +# C++ Compiler options +IPOPT_CXXFLAGS = @CXXFLAGS@ + +# additional C++ Compiler options for linking +IPOPT_CXXLINKFLAGS = @RPATH_FLAGS@ + +prefix=@prefix@ +exec_prefix=@exec_prefix@ + +# Include directories +@COIN_HAS_PKGCONFIG_TRUE@IPOPT_INCL = `PKG_CONFIG_PATH=@COIN_PKG_CONFIG_PATH@ @PKG_CONFIG@ --cflags ipopt` +@COIN_HAS_PKGCONFIG_FALSE@IPOPT_INCL = -I@includedir@/coin @IPOPTLIB_CFLAGS@ + +# Linker flags +@COIN_HAS_PKGCONFIG_TRUE@IPOPT_LIBS = `PKG_CONFIG_PATH=@COIN_PKG_CONFIG_PATH@ @PKG_CONFIG@ --libs ipopt` +@COIN_HAS_PKGCONFIG_FALSE@IPOPT_LIBS = -L@libdir@ -lipopt @IPOPTLIB_LFLAGS@ + +# Define objects for R to build +OBJECTS = ipoptr.o IpoptRNLP.o IpoptRJournal.o + +# Convert to R macros +PKG_LIBS = ${IPOPT_CXXLINKFLAGS} ${IPOPT_LIBS} +PKG_CXXFLAGS = ${IPOPT_CXXFLAGS} ${IPOPT_INCL} -I@srcdir@ diff --git a/Ipopt-3.13.4/contrib/RInterface/src/ipoptr.cpp b/Ipopt-3.13.4/contrib/RInterface/src/ipoptr.cpp new file mode 100644 index 000000000..c45447cae --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/src/ipoptr.cpp @@ -0,0 +1,210 @@ +/* Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. + * This code is published under the Eclipse Public License. + * + * File: ipoptr.cpp + * Author: Jelmer Ypma + * Date: 18 April 2010 + * + * This file defines the main function IpoptRSolve that provides + * an interface to Ipopt from R. + * The function converts and R object containing objective function, + * constraints, etc. into an IpoptApplication, solves the problem, + * and returns the result. + * + * Financial support of the UK Economic and Social Research Council + * through a grant (RES-589-28-0001) to the ESRC Centre for Microdata + * Methods and Practice (CeMMAP) is gratefully acknowledged. + * + * 30/01/2011: added IpoptRJournal to correctly direct output to R terminal. + */ + +#include "IpIpoptApplication.hpp" +#include "IpSolveStatistics.hpp" +#include "IpoptRNLP.hpp" +#include "IpoptRJournal.hpp" + +#include +#include +// Rdefines.h is somewhat more higher level then Rinternal.h, and is preferred if the code might be shared with S at any stage. + +#include + +/// Extracts element with name 'str' from R object 'list' +/// and returns that element. +SEXP getListElement( + SEXP list, + std::string str +) +{ + SEXP elmt = R_NilValue, names = getAttrib(list, R_NamesSymbol); + int i; + for( i = 0; i < length(list); i++ ) + if( str.compare(CHAR(STRING_ELT(names, i))) == 0 ) + { + elmt = VECTOR_ELT(list, i); + break; + } + return elmt; +} + +/** Set options specified in R object opts in IpoptApplcation app. + * + * If we set the option to approximate the Hessian, then IpoptRNLP + * needs to know that, so it can return false when calling eval_h, + * instead of trying to find an R function that evaluates the Hessian. + * + * SEXP opts is an R list containing three sub-lists, with names + * integer, string and numeric. These sub-lists contain the actual + * options and there values that were specified by the user. + * Passing the options in this way makes it easier to call different + * SetValue function in IpoptApplication of the different types. + */ +void setApplicationOptions( + Ipopt::SmartPtr app, + Ipopt::SmartPtr nlp, + SEXP opts +) +{ + // extract the sub-lists with options of the different types into separate lists + SEXP opts_integer = getListElement(opts, "integer"); + SEXP opts_numeric = getListElement(opts, "numeric"); + SEXP opts_string = getListElement(opts, "string"); + + // loop over the integer options and set them + SEXP opts_integer_names; + opts_integer_names = getAttrib(opts_integer, R_NamesSymbol); + for( int list_cnt = 0; list_cnt < length(opts_integer); list_cnt++ ) + { + SEXP opt_value; + PROTECT(opt_value = AS_INTEGER(VECTOR_ELT(opts_integer, list_cnt))); + + app->Options()->SetIntegerValue(CHAR(STRING_ELT(opts_integer_names, list_cnt)), INTEGER(opt_value)[0]); + UNPROTECT(1); + } + + // loop over the numeric options and set them + SEXP opts_numeric_names; + opts_numeric_names = getAttrib(opts_numeric, R_NamesSymbol); + for( int list_cnt = 0; list_cnt < length(opts_numeric); list_cnt++ ) + { + SEXP opt_value; + PROTECT(opt_value = VECTOR_ELT(opts_numeric, list_cnt)); + + app->Options()->SetNumericValue(CHAR(STRING_ELT(opts_numeric_names, list_cnt)), REAL(opt_value)[0]); + UNPROTECT(1); + } + + // loop over the string options and set them + SEXP opts_string_names; + opts_string_names = getAttrib(opts_string, R_NamesSymbol); + for( int list_cnt = 0; list_cnt < length(opts_string); list_cnt++ ) + { + // opt_value will contain the first (should be the only one) element of the list + SEXP opt_value; + PROTECT(opt_value = STRING_ELT(VECTOR_ELT(opts_string, list_cnt), 0)); + + app->Options()->SetStringValue(CHAR(STRING_ELT(opts_string_names, list_cnt)), CHAR(opt_value)); + + // change the setting to approximate the hessian in nlp if this is part of the options + if( std::string(CHAR(STRING_ELT(opts_string_names, list_cnt))) == "hessian_approximation" + && std::string(CHAR(opt_value)) == "limited-memory" ) + { + nlp->set_hessian_approximation(true); + } + + UNPROTECT(1); + } +} + +// we want this function to be available in R, so we put extern around it. +extern "C" { + +#if defined(__GNUC__) && __GNUC__ >= 4 + __attribute__((__visibility__("default"))) +#endif + SEXP IpoptRSolve( + SEXP args + ) + { + // Create an instance of your nlp... + // (use a SmartPtr, not raw) + Ipopt::SmartPtr ipoptr_nlp; + Ipopt::SmartPtr ipoptr_tnlp; + + ipoptr_nlp = new IpoptRNLP(); + ipoptr_tnlp = GetRawPtr(ipoptr_nlp); + + // Set initial values, bounds, functions, etc. + // These are taking from args, which is a list containing the needed elements. + // Checking whether all elements are there and have correct values is done in R. + ipoptr_nlp->set_R_environment(getListElement(args, "environment")); + ipoptr_nlp->set_R_init_values(getListElement(args, "x0")); + ipoptr_nlp->set_R_lower_bounds(getListElement(args, "lower_bounds")); + ipoptr_nlp->set_R_upper_bounds(getListElement(args, "upper_bounds")); + ipoptr_nlp->set_R_eval_f(getListElement(args, "eval_f")); + ipoptr_nlp->set_R_eval_grad_f(getListElement(args, "eval_grad_f")); + + ipoptr_nlp->set_R_eval_g(getListElement(args, "eval_g")); + ipoptr_nlp->set_R_eval_jac_g(getListElement(args, "eval_jac_g")); + ipoptr_nlp->set_R_eval_jac_g_structure(getListElement(args, "eval_jac_g_structure")); + ipoptr_nlp->set_R_constraint_lower_bounds(getListElement(args, "constraint_lower_bounds")); + ipoptr_nlp->set_R_constraint_upper_bounds(getListElement(args, "constraint_upper_bounds")); + + ipoptr_nlp->set_R_eval_h(getListElement(args, "eval_h")); + ipoptr_nlp->set_R_eval_h_structure(getListElement(args, "eval_h_structure")); + + // Create an instance of the IpoptApplication + Ipopt::SmartPtr app = new Ipopt::IpoptApplication(); + app->RethrowNonIpoptException(false); + + // Set options that were passed from R + setApplicationOptions(app, ipoptr_nlp, getListElement(args, "options")); + + // Set up the IPOPT console. + // + // Get print_level from options + Ipopt::Index print_level; + app->Options()->GetIntegerValue("print_level", print_level, ""); + + // Set print_level to 0 for default console (to avoid double output under Linux) + app->Options()->SetIntegerValue("print_level", 0); + + // Add new journal with user-supplied print_level to print output to R console + Ipopt::SmartPtr console = new IpoptRJournal(static_cast(print_level)); + app->Jnlst()->AddJournal(console); + + // Initialize the IpoptApplication and process the options + Ipopt::ApplicationReturnStatus status; + status = app->Initialize(); + if( status != Ipopt::Solve_Succeeded ) + { + printf("\n\n*** Error during initialization!\n"); + + SEXP answer; + PROTECT(answer = allocVector(INTSXP, 1)); + INTEGER(answer)[0] = (int) status; + UNPROTECT(1); + return (answer); + } + + // Solve the optimization problem + status = app->OptimizeTNLP(ipoptr_tnlp); + + // Retrieve results that were saved in IpoptRNLP::finalize_solution() + SEXP R_result_list; + PROTECT(R_result_list = ipoptr_nlp->get_R_result_list()); + + // convert number of iterations to an R object and add to the result_list + // memory in R_result_list has already been allocated in IpoptRNLP::finalize_solution() + SEXP R_num_iterations; + PROTECT(R_num_iterations = allocVector(INTSXP, 1)); + INTEGER(R_num_iterations)[0] = (int) app->Statistics()->IterationCount(); + + SET_VECTOR_ELT(R_result_list, 2, R_num_iterations); + UNPROTECT(2); + + return (R_result_list); + } + +} // extern "C" + diff --git a/Ipopt-3.13.4/contrib/RInterface/tests/approx_banana.R b/Ipopt-3.13.4/contrib/RInterface/tests/approx_banana.R new file mode 100644 index 000000000..30aae8457 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/tests/approx_banana.R @@ -0,0 +1,62 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: approx_banana.R +# Author: Jelmer Ypma +# Date: 5 July 2010 +# +# Example showing how to solve the Rosenbrock Banana function +# with an approximated gradient, which doesn't work so well. + +library('ipoptr') + +# Rosenbrock Banana function +eval_f <- function(x) { + return( 100 * (x[2] - x[1] * x[1])^2 + (1 - x[1])^2 ) +} + +# Approximate eval_f using finite differences +# http://en.wikipedia.org/wiki/Numerical_differentiation +approx_grad_f <- function( x ) { + minAbsValue <- 0 + stepSize <- sqrt( .Machine$double.eps ) + + # if we evaluate at 0, we need a different step size + stepSizeVec <- ifelse(abs(x) <= minAbsValue, stepSize^3, x * stepSize) + + x_prime <- x + f <- eval_f( x ) + grad_f <- rep( 0, length(x) ) + for (i in 1:length(x)) { + x_prime[i] <- x[i] + stepSizeVec[i] + stepSizeVec[i] <- x_prime[i] - x[i] + + f_prime <- eval_f( x_prime ) + grad_f[i] <- ( f_prime - f )/stepSizeVec[i] + x_prime[i] <- x[i] + } + + return( grad_f ) +} + +# initial values +x0 <- c( -1.2, 1 ) + +opts <- list("tol"=1.0e-8, "max_iter"=5000) + +# solve Rosenbrock Banana function with approximated gradient +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=approx_grad_f, + opts=opts) ) + +opts <- list("tol"=1.0e-7) + +# solve Rosenbrock Banana function with approximated gradient +# and lower tolerance +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=approx_grad_f, + opts=opts) ) + + \ No newline at end of file diff --git a/Ipopt-3.13.4/contrib/RInterface/tests/banana.R b/Ipopt-3.13.4/contrib/RInterface/tests/banana.R new file mode 100644 index 000000000..29f0001b7 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/tests/banana.R @@ -0,0 +1,53 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: banana.R +# Author: Jelmer Ypma +# Date: 18 April 2010 +# +# Example showing how to solve the Rosenbrock Banana function. + +library('ipoptr') + +## Rosenbrock Banana function +eval_f <- function(x) { + return( 100 * (x[2] - x[1] * x[1])^2 + (1 - x[1])^2 ) +} + +## Gradient of Rosenbrock Banana function +eval_grad_f <- function(x) { + return( c( -400 * x[1] * (x[2] - x[1] * x[1]) - 2 * (1 - x[1]), + 200 * (x[2] - x[1] * x[1])) ) +} + +# The Hessian for this problem is actually dense, +# This is a symmetric matrix, fill the lower left triangle only. +eval_h_structure <- list( c(1), c(1,2) ) + +eval_h <- function( x, obj_factor, hessian_lambda ) { + return( obj_factor*c( 2 - 400*(x[2] - x[1]^2) + 800*x[1]^2, # 1,1 + -400*x[1], # 2,1 + 200 ) ) # 2,2 +} + +# initial values +x0 <- c( -1.2, 1 ) + +opts <- list("print_level"=5, + "file_print_level"=12, + "output_file"="banana.out", + "tol"=1.0e-8) + +# solve Rosenbrock Banana function with analytic hessian +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=eval_grad_f, + eval_h=eval_h, + eval_h_structure=eval_h_structure, + opts=opts) ) + +# solve Rosenbrock Banana function with approximated hessian +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=eval_grad_f, + opts=opts) ) diff --git a/Ipopt-3.13.4/contrib/RInterface/tests/hs071_nlp.R b/Ipopt-3.13.4/contrib/RInterface/tests/hs071_nlp.R new file mode 100644 index 000000000..2cb04985d --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/tests/hs071_nlp.R @@ -0,0 +1,127 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: hs071_nlp.R +# Author: Jelmer Ypma +# Date: 18 April 2010 +# +# Example problem, number 71 from the Hock-Schittkowsky test suite +# +# \min_{x} x1*x4*(x1 + x2 + x3) + x3 +# s.t. +# x1*x2*x3*x4 >= 25 +# x1^2 + x2^2 + x3^2 + x4^2 = 40 +# 1 <= x1,x2,x3,x4 <= 5 +# +# x0 = (1,5,5,1) +# +# optimal solution = (1.00000000, 4.74299963, 3.82114998, 1.37940829) +# +# Adapted from the Ipopt C++ interface example. + +library('ipoptr') + +# +# f(x) = x1*x4*(x1 + x2 + x3) + x3 +# +eval_f <- function( x ) { + return( x[1]*x[4]*(x[1] + x[2] + x[3]) + x[3] ) +} + +eval_grad_f <- function( x ) { + return( c( x[1] * x[4] + x[4] * (x[1] + x[2] + x[3]), + x[1] * x[4], + x[1] * x[4] + 1.0, + x[1] * (x[1] + x[2] + x[3]) ) ) +} + +# constraint functions +eval_g <- function( x ) { + return( c( x[1] * x[2] * x[3] * x[4], + x[1]^2 + x[2]^2 + x[3]^2 + x[4]^2 ) ) +} + +# The Jacobian for this problem is dense +eval_jac_g_structure <- list( c(1,2,3,4), c(1,2,3,4) ) + +eval_jac_g <- function( x ) { + return( c ( x[2]*x[3]*x[4], + x[1]*x[3]*x[4], + x[1]*x[2]*x[4], + x[1]*x[2]*x[3], + 2.0*x[1], + 2.0*x[2], + 2.0*x[3], + 2.0*x[4] ) ) +} + +# The Hessian for this problem is actually dense, +# This is a symmetric matrix, fill the lower left triangle only. +eval_h_structure <- list( c(1), c(1,2), c(1,2,3), c(1,2,3,4) ) + +eval_h <- function( x, obj_factor, hessian_lambda ) { + + values <- numeric(10) + values[1] = obj_factor * (2*x[4]) # 1,1 + + values[2] = obj_factor * (x[4]) # 2,1 + values[3] = 0 # 2,2 + + values[4] = obj_factor * (x[4]) # 3,1 + values[5] = 0 # 4,2 + values[6] = 0 # 3,3 + + values[7] = obj_factor * (2*x[1] + x[2] + x[3]) # 4,1 + values[8] = obj_factor * (x[1]) # 4,2 + values[9] = obj_factor * (x[1]) # 4,3 + values[10] = 0 # 4,4 + + + # add the portion for the first constraint + values[2] = values[2] + hessian_lambda[1] * (x[3] * x[4]) # 2,1 + + values[4] = values[4] + hessian_lambda[1] * (x[2] * x[4]) # 3,1 + values[5] = values[5] + hessian_lambda[1] * (x[1] * x[4]) # 3,2 + + values[7] = values[7] + hessian_lambda[1] * (x[2] * x[3]) # 4,1 + values[8] = values[8] + hessian_lambda[1] * (x[1] * x[3]) # 4,2 + values[9] = values[9] + hessian_lambda[1] * (x[1] * x[2]) # 4,3 + + # add the portion for the second constraint + values[1] = values[1] + hessian_lambda[2] * 2 # 1,1 + values[3] = values[3] + hessian_lambda[2] * 2 # 2,2 + values[6] = values[6] + hessian_lambda[2] * 2 # 3,3 + values[10] = values[10] + hessian_lambda[2] * 2 # 4,4 + + return ( values ) +} + +# initial values +x0 <- c( 1, 5, 5, 1 ) + +# lower and upper bounds of control +lb <- c( 1, 1, 1, 1 ) +ub <- c( 5, 5, 5, 5 ) + +# lower and upper bounds of constraints +constraint_lb <- c( 25, 40 ) +constraint_ub <- c( Inf, 40 ) + + +opts <- list("print_level"=0, + "file_print_level"=12, + "output_file"="hs071_nlp.out") + +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=eval_grad_f, + lb=lb, + ub=ub, + eval_g=eval_g, + eval_jac_g=eval_jac_g, + constraint_lb=constraint_lb, + constraint_ub=constraint_ub, + eval_jac_g_structure=eval_jac_g_structure, + eval_h=eval_h, + eval_h_structure=eval_h_structure, + opts=opts) ) diff --git a/Ipopt-3.13.4/contrib/RInterface/tests/lasso.R b/Ipopt-3.13.4/contrib/RInterface/tests/lasso.R new file mode 100644 index 000000000..9f9f67784 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/tests/lasso.R @@ -0,0 +1,147 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: lasso.R +# Author: Jelmer Ypma +# Date: 18 April 2010 +# +# Example showing how to estimate a LASSO model. Based on +# the example from the Matlab interface to Ipopt. There are +# other packages in R that can estimate LASSO models, e.g. +# using the package glmnet. + +library('ipoptr') + +# Experiment parameters. +lambda <- 1 # Level of L1 regularization. +n <- 100 # Number of training examples. +e <- 1 # Std. dev. in noise of outputs. +beta <- c( 0, 0, 2, -4, 0, 0, -1, 3 ) # "True" regression coefficients. + +# Set the random number generator seed. +ranseed <- 7 +set.seed( ranseed ) + +# CREATE DATA SET. +# Generate the input vectors from the standard normal, and generate the +# responses from the regression with some additional noise. The variable +# "beta" is the set of true regression coefficients. +m <- length(beta) # Number of features. +A <- matrix( rnorm(n*m), nrow=n, ncol=m ) # The n x m matrix of examples. +noise <- rnorm(n, sd=e) # Noise in outputs. +y <- A %*% beta + noise # The outputs. + + +# DEFINE LASSO FUNCTIONS +# m, lambda, y, A are all defined in the ipoptr_environment +eval_f <- function(x) { + # separate x in two parts + w <- x[ 1:m ] # parameters + u <- x[ (m+1):(2*m) ] + + return( sum( (y - A %*% w)^2 )/2 + lambda*sum(u) ) +} + +# ------------------------------------------------------------------ +eval_grad_f <- function(x) { + w <- x[ 1:m ] + return( c( -t(A) %*% (y - A %*% w), + rep(lambda,m) ) ) +} + +# ------------------------------------------------------------------ +eval_g <- function(x) { + # separate x in two parts + w <- x[ 1:m ] # parameters + u <- x[ (m+1):(2*m) ] + + return( c( w + u, u - w ) ) +} + +# ------------------------------------------------------------------ +# J = [ I I +# -I I ], +# where I is and identity matrix of size m +eval_jac_g <- function(x) { + # return a vector of 1 and minus 1, since those are the values of the non-zero elements + return( c( rep( 1, 2*m ), rep( c(-1,1), m ) ) ) +} + +# For m=5, The structure looks like this: +# 1 . . . . 2 . . . . +# . 3 . . . . 4 . . . +# . . 5 . . . . 6 . . +# . . . 7 . . . . 8 . +# . . . . 9 . . . . 10 +# 11 . . . . 12 . . . . +# . 13 . . . . 14 . . . +# . . 15 . . . . 16 . . +# . . . 17 . . . . 18 . +# . . . . 19 . . . . 20 +eval_jac_g_structure <- lapply( c(1:m,1:m), function(x) { return( c(x,m+x) ) } ) + + +# ------------------------------------------------------------------ +# rename lambda so it doesn't cause confusion with lambda in auxdata +eval_h <- function( x, obj_factor, hessian_lambda ) { + H <- t(A) %*% A + H <- unlist( lapply( 1:m, function(i) { H[i,1:i] } ) ) + + return( obj_factor * H ) +} + +# For m=5, The structure looks like this: +# 1 . . . . . . . . . +# 2 3 . . . . . . . . +# 4 5 6 . . . . . . . +# 7 8 9 10 . . . . . . +# 11 12 13 14 15 . . . . . +# . . . . . . . . . . +# . . . . . . . . . . +# . . . . . . . . . . +# . . . . . . . . . . +# . . . . . . . . . . +eval_h_structure <- c( lapply( 1:m, function(x) { return( c(1:x) ) } ), + lapply( 1:m, function(x) { return( c() ) } ) ) + + +# ------------------------------------------------------------------ + + +# The starting point. +x0 = c( rep(0, m), + rep(1, m) ) + + +# The constraint functions are bounded from below by zero. +constraint_lb = rep( 0, 2*m ) +constraint_ub = rep( Inf, 2*m ) + +ipoptr_opts <- list( "jac_d_constant" = 'yes', + "hessian_constant" = 'yes', + "mu_strategy" = 'adaptive', + "max_iter" = 100, + "tol" = 1e-8 ) + +# Set up the auxiliary data. +auxdata <- new.env() +auxdata$m <- m +auxdata$A <- A +auxdata$y <- y +auxdata$lambda <- lambda + +# COMPUTE SOLUTION WITH IPOPT. +# Compute the L1-regularized maximum likelihood estimator. +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=eval_grad_f, + eval_g=eval_g, + eval_jac_g=eval_jac_g, + eval_jac_g_structure=eval_jac_g_structure, + constraint_lb=constraint_lb, + constraint_ub=constraint_ub, + eval_h=eval_h, + eval_h_structure=eval_h_structure, + opts=ipoptr_opts, + ipoptr_environment=auxdata ) ) + diff --git a/Ipopt-3.13.4/contrib/RInterface/tests/mynlp.R b/Ipopt-3.13.4/contrib/RInterface/tests/mynlp.R new file mode 100644 index 000000000..91c990fcb --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/tests/mynlp.R @@ -0,0 +1,84 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: mynlp.R +# Author: Jelmer Ypma +# Date: 18 April 2010 +# +# Example NLP for interfacing a problem with IPOPT. +# This example is adapted from the C++ example that +# goes along with the Ipopt tutorial document. +# This example solves the following problem: +# +# min_x f(x) = -(x2-2)^2 +# s.t. +# 0 = x1^2 + x2 - 1 +# -1 <= x1 <= 1 + +library('ipoptr') + +eval_f <- function( x ) { + print( paste( "In R::eval_f, x = ", paste( x, collapse=', ' ) ) ) + + return( -(x[2] - 2.0)*(x[2] - 2.0) ) +} + +eval_grad_f <- function( x ) { + return( c(0.0, -2.0*(x[2] - 2.0) ) ) +} + +eval_g <- function( x ) { + return( -(x[1]*x[1] + x[2] - 1.0) ); +} + +# list with indices of non-zero elements +# each element of the list corresponds to the derivative of one constraint +# +# e.g. +# / 0 x x \ +# \ x 0 x / +# would be +# list( c(2,3), c(1,3) ) +eval_jac_g_structure <- list( c(1,2) ) + + +# this should return a vector with all the non-zero elements +# so, no list here, because that is slower I guess +# TODO: make an R-function that shows the structure in matrix form +eval_jac_g <- function( x ) { + return ( c ( -2.0 * x[1], -1.0 ) ) +} + + +# diagonal matrix, usually only fill the lower triangle +eval_h_structure <- list( c(1), c(2) ) + +eval_h <- function( x, obj_factor, hessian_lambda ) { + return ( c( -2.0*hessian_lambda[1], -2.0*obj_factor ) ) +} + +x0 <- c(0.5,1.5) + +lb <- c( -1, -1.0e19 ) +ub <- c( 1, 1.0e19 ) + +constraint_lb <- 0 +constraint_ub <- 0 + +opts <- list("print_level"=0, + "file_print_level"=12, + "output_file"="ipopttest.out") + +print( ipoptr( x0=x0, + eval_f=eval_f, + eval_grad_f=eval_grad_f, + lb=lb, + ub=ub, + eval_g=eval_g, + eval_jac_g=eval_jac_g, + eval_jac_g_structure=eval_jac_g_structure, + constraint_lb=constraint_lb, + constraint_ub=constraint_ub, + eval_h=eval_h, + eval_h_structure=eval_h_structure, + opts=opts) ) diff --git a/Ipopt-3.13.4/contrib/RInterface/tests/parameters.R b/Ipopt-3.13.4/contrib/RInterface/tests/parameters.R new file mode 100644 index 000000000..54e4a8bf2 --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/tests/parameters.R @@ -0,0 +1,70 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: parameters.R +# Author: Jelmer Ypma +# Date: 18 April 2010 +# +# Example showing two ways how we can have an objective +# function depend on parameters or data. The objective +# function is a simple polynomial. + +library('ipoptr') + + +# +# First example: supply additional arguments in user-defined functions +# + +# objective function and gradient in terms of parameters +eval_f_ex1 <- function(x, params) { + return( params[1]*x^2 + params[2]*x + params[3] ) +} +eval_grad_f_ex1 <- function(x, params) { + return( 2*params[1]*x + params[2] ) +} + +# define parameters that we want to use +params <- c(1,2,3) + +# define initial value of the optimzation problem +x0 <- 0 + +# solve using ipoptr +ipoptr( x0 = x0, + eval_f = eval_f_ex1, + eval_grad_f = eval_grad_f_ex1, + params = params ) + + +# +# Second example: define an environment that contains extra parameters +# + +# objective function and gradient in terms of parameters +# without supplying params as an argument +eval_f_ex2 <- function(x) { + return( params[1]*x^2 + params[2]*x + params[3] ) +} +eval_grad_f_ex2 <- function(x) { + return( 2*params[1]*x + params[2] ) +} + +# define initial value of the optimzation problem +x0 <- 0 + +# define a new environment that contains params +auxdata <- new.env() +auxdata$params <- c(1,2,3) + +# pass the environment that should be used to evaluate functions to ipoptr +ipoptr( x0 = x0, + eval_f = eval_f_ex2, + eval_grad_f = eval_grad_f_ex2, + ipoptr_environment = auxdata ) + + +# solve using algebra +cat( paste( "Minimizing f(x) = ax^2 + bx + c\n" ) ) +cat( paste( "Optimal value of control is -b/(2a) = ", -params[2]/(2*params[1]), "\n" ) ) +cat( paste( "With value of the objective function f(-b/(2a)) = ", eval_f_ex1( -params[2]/(2*params[1]), params ), "\n" ) ) diff --git a/Ipopt-3.13.4/contrib/RInterface/tests/sparseness.R b/Ipopt-3.13.4/contrib/RInterface/tests/sparseness.R new file mode 100644 index 000000000..692e513cb --- /dev/null +++ b/Ipopt-3.13.4/contrib/RInterface/tests/sparseness.R @@ -0,0 +1,63 @@ +# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# File: sparseness.R +# Author: Jelmer Ypma +# Date: 18 April 2010 +# +# Example showing how the functions print.sparseness and +# make.sparse work. These show and create the sparseness +# structure of a matrix as it should be used for input +# to ipoptr(). + +library('ipoptr') + +# print lower-diagonal 4x4 matrix +print.sparseness( list( c(1), c(1,2), c(1,2,3), c(1,2,3,4) ) ) + +# print diagonal 3x3 matrix without indices counts +print.sparseness( list( c(1), c(2), c(3) ), indices=FALSE ) + +# print a third sparse matrix +print.sparseness( list( c(1,3,6,8), c(2,5), c(3,7,9) ) ) + +# and a fourth one, where the elements are in a different order +print.sparseness( list( c(3,1,6,8), c(2,5), c(3,9,7) ) ) + +# print lower-diagonal 5x5 matrix generated with make.sparse +A_lower <- make.sparse( lower.tri( matrix(1, nrow=5, ncol=5), diag=TRUE ) ) +print.sparseness( A_lower ) + +# print a diagonal 5x5 matrix without indices counts +A_diag <- make.sparse( diag(5) > 0 ) +print.sparseness( A_diag ) + +# example from tests/lasso.R +n <- 100 # number of observations +m <- 5 # number of variables + +# define hessian function +hessian <- function( A ) { + H <- t(A) %*% A + H <- unlist( lapply( 1:m, function(i) { H[i,1:i] } ) ) + + return( H ) +} + +# define the structure +hessian_structure <- c( lapply( 1:m, function(x) { return( c(1:x) ) } ), + lapply( 1:m, function(x) { return( c() ) } ) ) + +# generate data +set.seed( 3141 ) +A <- hessian( matrix( rnorm( n*m ), nrow=n, ncol=m ) ) +print.sparseness( x = hessian_structure, + indices = TRUE, + data = format( A, digits=2, nsmall=2, justify='right'), + ncol = 2*m ) + +# make a large sparseness structure and use plot +s <- do.call( "cbind", lapply( 1:5, function(i) { diag(5) %x% matrix(1, nrow=5, ncol=20) } ) ) +s <- do.call( "rbind", lapply( 1:5, function(i) { s } ) ) +s <- cbind( matrix( 1, nrow=nrow(s), ncol=40 ), s ) +plot.sparseness( make.sparse( s ) ) diff --git a/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/Makefile.am b/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/Makefile.am new file mode 100644 index 000000000..b056387b8 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/Makefile.am @@ -0,0 +1,22 @@ +# Copyright (C) 2019 COIN-OR +# All Rights Reserved. +# This file is distributed under the Eclipse Public License. + +bin_PROGRAMS = ipopt_sens + +ipopt_sens_SOURCES = ampl_sipopt.cpp SensAmplTNLP.cpp + +ipopt_sens_LDADD = ../src/libsipopt.la \ + ../../../src/Apps/AmplSolver/libipoptamplinterface.la \ + $(SIPOPTAMPLINTERFACELIB_LFLAGS) + +AM_LDFLAGS = $(LT_LDFLAGS) + +AM_CPPFLAGS = \ + -I$(srcdir)/../src \ + -I$(srcdir)/../../../src/Common \ + -I$(srcdir)/../../../src/Interfaces \ + -I$(srcdir)/../../../src/LinAlg \ + -I$(srcdir)/../../../src/Algorithm \ + -I$(srcdir)/../../../src/Apps/AmplSolver \ + $(SIPOPTAMPLINTERFACELIB_CFLAGS) diff --git a/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/Makefile.in b/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/Makefile.in new file mode 100644 index 000000000..7d0e64b7d --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/Makefile.in @@ -0,0 +1,678 @@ +# Makefile.in generated by automake 1.16.2 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2020 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +# Copyright (C) 2019 COIN-OR +# All Rights Reserved. +# This file is distributed under the Eclipse Public License. + +VPATH = @srcdir@ +am__is_gnu_make = { \ + if test -z '$(MAKELEVEL)'; then \ + false; \ + elif test -n '$(MAKE_HOST)'; then \ + true; \ + elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ + true; \ + else \ + false; \ + fi; \ +} +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +bin_PROGRAMS = ipopt_sens$(EXEEXT) +subdir = contrib/sIPOPT/AmplSolver +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +DIST_COMMON = $(srcdir)/Makefile.am +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/src/Common/config.h \ + $(top_builddir)/src/Common/config_ipopt.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +am__installdirs = "$(DESTDIR)$(bindir)" +PROGRAMS = $(bin_PROGRAMS) +am_ipopt_sens_OBJECTS = ampl_sipopt.$(OBJEXT) SensAmplTNLP.$(OBJEXT) +ipopt_sens_OBJECTS = $(am_ipopt_sens_OBJECTS) +am__DEPENDENCIES_1 = +ipopt_sens_DEPENDENCIES = ../src/libsipopt.la \ + ../../../src/Apps/AmplSolver/libipoptamplinterface.la \ + $(am__DEPENDENCIES_1) +AM_V_lt = $(am__v_lt_@AM_V@) +am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@) +am__v_lt_0 = --silent +am__v_lt_1 = +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)/src/Common +depcomp = $(SHELL) $(top_srcdir)/depcomp +am__maybe_remake_depfiles = depfiles +am__depfiles_remade = ./$(DEPDIR)/SensAmplTNLP.Po \ + ./$(DEPDIR)/ampl_sipopt.Po +am__mv = mv -f +CXXCOMPILE = $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) +LTCXXCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) \ + $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ + $(AM_CXXFLAGS) $(CXXFLAGS) +AM_V_CXX = $(am__v_CXX_@AM_V@) +am__v_CXX_ = $(am__v_CXX_@AM_DEFAULT_V@) +am__v_CXX_0 = @echo " CXX " $@; +am__v_CXX_1 = +CXXLD = $(CXX) +CXXLINK = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=link $(CXXLD) $(AM_CXXFLAGS) \ + $(CXXFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CXXLD = $(am__v_CXXLD_@AM_V@) +am__v_CXXLD_ = $(am__v_CXXLD_@AM_DEFAULT_V@) +am__v_CXXLD_0 = @echo " CXXLD " $@; +am__v_CXXLD_1 = +SOURCES = $(ipopt_sens_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +ACLOCAL = @ACLOCAL@ +ADD_CFLAGS = @ADD_CFLAGS@ +ADD_CXXFLAGS = @ADD_CXXFLAGS@ +ADD_FFLAGS = @ADD_FFLAGS@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AR = @AR@ +AS = @AS@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +BIT32FCOMMENT = @BIT32FCOMMENT@ +BIT64FCOMMENT = @BIT64FCOMMENT@ +BITS_PER_POINTER = @BITS_PER_POINTER@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +COIN_PKG_CONFIG_PATH = @COIN_PKG_CONFIG_PATH@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CXX = @CXX@ +CXXCPP = @CXXCPP@ +CXXDEPMODE = @CXXDEPMODE@ +CXXFLAGS = @CXXFLAGS@ +CXXLIBS = @CXXLIBS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DLLTOOL = @DLLTOOL@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +F77 = @F77@ +FFLAGS = @FFLAGS@ +FGREP = @FGREP@ +FLIBS = @FLIBS@ +GREP = @GREP@ +HSLLIB_CFLAGS = @HSLLIB_CFLAGS@ +HSLLIB_CFLAGS_NOPC = @HSLLIB_CFLAGS_NOPC@ +HSLLIB_LFLAGS = @HSLLIB_LFLAGS@ +HSLLIB_LFLAGS_NOPC = @HSLLIB_LFLAGS_NOPC@ +HSLLIB_PCFILES = @HSLLIB_PCFILES@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +IPALLLIBS = @IPALLLIBS@ +IPOPTAMPLINTERFACELIB_CFLAGS = @IPOPTAMPLINTERFACELIB_CFLAGS@ +IPOPTAMPLINTERFACELIB_CFLAGS_NOPC = @IPOPTAMPLINTERFACELIB_CFLAGS_NOPC@ +IPOPTAMPLINTERFACELIB_LFLAGS = @IPOPTAMPLINTERFACELIB_LFLAGS@ +IPOPTAMPLINTERFACELIB_LFLAGS_NOPC = @IPOPTAMPLINTERFACELIB_LFLAGS_NOPC@ +IPOPTAMPLINTERFACELIB_PCFILES = @IPOPTAMPLINTERFACELIB_PCFILES@ +IPOPTLIB_CFLAGS = @IPOPTLIB_CFLAGS@ +IPOPTLIB_CFLAGS_NOPC = @IPOPTLIB_CFLAGS_NOPC@ +IPOPTLIB_LFLAGS = @IPOPTLIB_LFLAGS@ +IPOPTLIB_LFLAGS_NOPC = @IPOPTLIB_LFLAGS_NOPC@ +IPOPTLIB_PCFILES = @IPOPTLIB_PCFILES@ +JAR = @JAR@ +JAVA = @JAVA@ +JAVAC = @JAVAC@ +JAVADOC = @JAVADOC@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +LT_LDFLAGS = @LT_LDFLAGS@ +LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ +MAINT = @MAINT@ +MAKEINFO = @MAKEINFO@ +MANIFEST_TOOL = @MANIFEST_TOOL@ +MKDIR_P = @MKDIR_P@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PKG_CONFIG = @PKG_CONFIG@ +RANLIB = @RANLIB@ +RPATH_FLAGS = @RPATH_FLAGS@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +SIPOPTAMPLINTERFACELIB_CFLAGS = @SIPOPTAMPLINTERFACELIB_CFLAGS@ +SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC = @SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC@ +SIPOPTAMPLINTERFACELIB_LFLAGS = @SIPOPTAMPLINTERFACELIB_LFLAGS@ +SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC = @SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC@ +SIPOPTAMPLINTERFACELIB_PCFILES = @SIPOPTAMPLINTERFACELIB_PCFILES@ +STRIP = @STRIP@ +VERSION = @VERSION@ +_ACJNI_JAVAC = @_ACJNI_JAVAC@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_AR = @ac_ct_AR@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_CXX = @ac_ct_CXX@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +ac_ct_F77 = @ac_ct_F77@ +ac_ct_PKG_CONFIG = @ac_ct_PKG_CONFIG@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +coin_doxy_logname = @coin_doxy_logname@ +coin_doxy_tagfiles = @coin_doxy_tagfiles@ +coin_doxy_tagname = @coin_doxy_tagname@ +coin_doxy_usedot = @coin_doxy_usedot@ +coin_have_doxygen = @coin_have_doxygen@ +coin_have_latex = @coin_have_latex@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +ipopt_sens_SOURCES = ampl_sipopt.cpp SensAmplTNLP.cpp +ipopt_sens_LDADD = ../src/libsipopt.la \ + ../../../src/Apps/AmplSolver/libipoptamplinterface.la \ + $(SIPOPTAMPLINTERFACELIB_LFLAGS) + +AM_LDFLAGS = $(LT_LDFLAGS) +AM_CPPFLAGS = \ + -I$(srcdir)/../src \ + -I$(srcdir)/../../../src/Common \ + -I$(srcdir)/../../../src/Interfaces \ + -I$(srcdir)/../../../src/LinAlg \ + -I$(srcdir)/../../../src/Algorithm \ + -I$(srcdir)/../../../src/Apps/AmplSolver \ + $(SIPOPTAMPLINTERFACELIB_CFLAGS) + +all: all-am + +.SUFFIXES: +.SUFFIXES: .cpp .lo .o .obj +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign contrib/sIPOPT/AmplSolver/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign contrib/sIPOPT/AmplSolver/Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): +install-binPROGRAMS: $(bin_PROGRAMS) + @$(NORMAL_INSTALL) + @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(bindir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(bindir)" || exit 1; \ + fi; \ + for p in $$list; do echo "$$p $$p"; done | \ + sed 's/$(EXEEXT)$$//' | \ + while read p p1; do if test -f $$p \ + || test -f $$p1 \ + ; then echo "$$p"; echo "$$p"; else :; fi; \ + done | \ + sed -e 'p;s,.*/,,;n;h' \ + -e 's|.*|.|' \ + -e 'p;x;s,.*/,,;s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/' | \ + sed 'N;N;N;s,\n, ,g' | \ + $(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1 } \ + { d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \ + if ($$2 == $$4) files[d] = files[d] " " $$1; \ + else { print "f", $$3 "/" $$4, $$1; } } \ + END { for (d in files) print "f", d, files[d] }' | \ + while read type dir files; do \ + if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \ + test -z "$$files" || { \ + echo " $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files '$(DESTDIR)$(bindir)$$dir'"; \ + $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \ + } \ + ; done + +uninstall-binPROGRAMS: + @$(NORMAL_UNINSTALL) + @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ + files=`for p in $$list; do echo "$$p"; done | \ + sed -e 'h;s,^.*/,,;s/$(EXEEXT)$$//;$(transform)' \ + -e 's/$$/$(EXEEXT)/' \ + `; \ + test -n "$$list" || exit 0; \ + echo " ( cd '$(DESTDIR)$(bindir)' && rm -f" $$files ")"; \ + cd "$(DESTDIR)$(bindir)" && rm -f $$files + +clean-binPROGRAMS: + @list='$(bin_PROGRAMS)'; test -n "$$list" || exit 0; \ + echo " rm -f" $$list; \ + rm -f $$list || exit $$?; \ + test -n "$(EXEEXT)" || exit 0; \ + list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \ + echo " rm -f" $$list; \ + rm -f $$list + +ipopt_sens$(EXEEXT): $(ipopt_sens_OBJECTS) $(ipopt_sens_DEPENDENCIES) $(EXTRA_ipopt_sens_DEPENDENCIES) + @rm -f ipopt_sens$(EXEEXT) + $(AM_V_CXXLD)$(CXXLINK) $(ipopt_sens_OBJECTS) $(ipopt_sens_LDADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensAmplTNLP.Po@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ampl_sipopt.Po@am__quote@ # am--include-marker + +$(am__depfiles_remade): + @$(MKDIR_P) $(@D) + @echo '# dummy' >$@-t && $(am__mv) $@-t $@ + +am--depfiles: $(am__depfiles_remade) + +.cpp.o: +@am__fastdepCXX_TRUE@ $(AM_V_CXX)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.o$$||'`;\ +@am__fastdepCXX_TRUE@ $(CXXCOMPILE) -MT $@ -MD -MP -MF $$depbase.Tpo -c -o $@ $< &&\ +@am__fastdepCXX_TRUE@ $(am__mv) $$depbase.Tpo $$depbase.Po +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ $(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ $< + +.cpp.obj: +@am__fastdepCXX_TRUE@ $(AM_V_CXX)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.obj$$||'`;\ +@am__fastdepCXX_TRUE@ $(CXXCOMPILE) -MT $@ -MD -MP -MF $$depbase.Tpo -c -o $@ `$(CYGPATH_W) '$<'` &&\ +@am__fastdepCXX_TRUE@ $(am__mv) $$depbase.Tpo $$depbase.Po +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ $(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` + +.cpp.lo: +@am__fastdepCXX_TRUE@ $(AM_V_CXX)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.lo$$||'`;\ +@am__fastdepCXX_TRUE@ $(LTCXXCOMPILE) -MT $@ -MD -MP -MF $$depbase.Tpo -c -o $@ $< &&\ +@am__fastdepCXX_TRUE@ $(am__mv) $$depbase.Tpo $$depbase.Plo +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ $(AM_V_CXX)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(LTCXXCOMPILE) -c -o $@ $< + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags +check-am: all-am +check: check-am +all-am: Makefile $(PROGRAMS) +installdirs: + for dir in "$(DESTDIR)$(bindir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-binPROGRAMS clean-generic clean-libtool mostlyclean-am + +distclean: distclean-am + -rm -f ./$(DEPDIR)/SensAmplTNLP.Po + -rm -f ./$(DEPDIR)/ampl_sipopt.Po + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: install-binPROGRAMS + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -f ./$(DEPDIR)/SensAmplTNLP.Po + -rm -f ./$(DEPDIR)/ampl_sipopt.Po + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-binPROGRAMS + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am am--depfiles check check-am clean \ + clean-binPROGRAMS clean-generic clean-libtool cscopelist-am \ + ctags ctags-am distclean distclean-compile distclean-generic \ + distclean-libtool distclean-tags dvi dvi-am html html-am info \ + info-am install install-am install-binPROGRAMS install-data \ + install-data-am install-dvi install-dvi-am install-exec \ + install-exec-am install-html install-html-am install-info \ + install-info-am install-man install-pdf install-pdf-am \ + install-ps install-ps-am install-strip installcheck \ + installcheck-am installdirs maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-compile \ + mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \ + tags tags-am uninstall uninstall-am uninstall-binPROGRAMS + +.PRECIOUS: Makefile + + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/SensAmplTNLP.cpp b/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/SensAmplTNLP.cpp new file mode 100644 index 000000000..2e64bdaa5 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/SensAmplTNLP.cpp @@ -0,0 +1,455 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-11 + +#include "SensAmplTNLP.hpp" +#include "SensUtils.hpp" +#include "IpDenseVector.hpp" +#include "IpIteratesVector.hpp" +#include "IpBlas.hpp" +#include "IpIpoptData.hpp" + +/* AMPL includes */ +#include "asl.h" +#include "asl_pfgh.h" +#include "getstub.h" + +namespace Ipopt +{ +#if IPOPT_VERBOSITY > 0 +static const Index dbg_verbosity = 1; +#endif + +SensAmplTNLP::SensAmplTNLP( + const SmartPtr& jnlst, + const SmartPtr options, + char**& argv, + SmartPtr suffix_handler /* = NULL */, + bool allow_discrete /* = false */, + SmartPtr ampl_options_list /* = NULL */, + const char* ampl_option_string /* = NULL */, + const char* ampl_invokation_string /* = NULL */, + const char* ampl_banner_string /* = NULL */, + std::string* nl_file_content /* = NULL */ +) + : AmplTNLP( + jnlst, // gotta call constructor of base class properly + options, argv, suffix_handler /* = NULL */, allow_discrete /* = false */, ampl_options_list /* = NULL */, + ampl_option_string /* = NULL */, ampl_invokation_string /* = NULL */, ampl_banner_string /* = NULL */, + nl_file_content /* = NULL */), + jnlst_(jnlst), + options_(options), + have_parameters_(false), + parameter_flags_(NULL), + parameter_values_(NULL) +{ + DBG_START_METH("SensAmplTNLP::SensAmplTNLP", dbg_verbosity); + + SmartPtr suff_handler = get_suffix_handler(); + ASL_pfgh* asl = AmplSolverObject(); + + const Index* parameter_flags = suff_handler->GetIntegerSuffixValues("parameter", AmplSuffixHandler::Variable_Source); + + if( parameter_flags_ != NULL ) + { + have_parameters_ = true; + for( Index i = 0; i < n_var; ++i ) + { + parameter_flags_[i] = parameter_flags[i]; + } + parameter_values_ = new Number[n_var]; + const Number* nominal_values = suff_handler->GetNumberSuffixValues("nominal_value", + AmplSuffixHandler::Variable_Source); + if( nominal_values == NULL ) + { + for( Index i = 0; i < n_var; ++i ) + { + parameter_values_[i] = 0; + } + } + else + { + for( Index i = 0; i < n_var; ++i ) + { + parameter_values_[i] = nominal_values[i]; + } + } + } + std::string prefix = ""; + options->GetIntegerValue("n_sens_steps", n_sens_steps_, prefix); + sens_sol_.resize(n_sens_steps_, NULL); + if( n_sens_steps_ == 0 ) + { + options->SetStringValue("run_sens", "no"); + run_sens_ = false; + } + + options->GetBoolValue("run_sens", run_sens_, ""); + options->GetBoolValue("compute_red_hessian", compute_red_hessian_, ""); +} + +SensAmplTNLP::~SensAmplTNLP() +{ + DBG_START_METH("SensAmplTNLP::~SensAmplTNLP", dbg_verbosity); + + delete[] parameter_values_; +} + +bool SensAmplTNLP::get_bounds_info( + Index n, + Number* x_l, + Number* x_u, + Index m, + Number* g_l, + Number* g_u +) +{ + DBG_START_METH("SensAmplTNLP::get_bounds_info", dbg_verbosity); + + ASL_pfgh* asl = AmplSolverObject(); + + DBG_ASSERT(n == n_var); + DBG_ASSERT(m == n_con); + + for( Index i = 0; i < n; i++ ) + { + x_l[i] = LUv[2 * i]; + x_u[i] = LUv[2 * i + 1]; + } + + for( Index i = 0; i < m; i++ ) + { + g_l[i] = LUrhs[2 * i]; + g_u[i] = LUrhs[2 * i + 1]; + } + + /* Sensitivity: Fix parameters by bounds */ + if( have_parameters_ ) + { + // parameters are set in the model. Set Bounds to current parameters + for( Index i = 0; i < n; i++ ) + { + if( parameter_flags_[i] ) + { + x_l[i] = parameter_values_[i]; + x_u[i] = parameter_values_[i]; + } + } + } + return true; +} + +void SensAmplTNLP::set_sens_solution( + Index idx, + SmartPtr sens_sol +) +{ + DBG_START_METH("SensAmplTNLP::set_sens_solution", dbg_verbosity); + + DBG_PRINT((dbg_verbosity, "n_sens_steps=%d\n", sens_sol_.size())); + DBG_ASSERT(idx > 0); + DBG_ASSERT(idx <= (Index)sens_sol_.size()); + + sens_sol_[idx - 1] = sens_sol; +} + +void SensAmplTNLP::finalize_metadata( + Index /*n*/, + const StringMetaDataMapType& /*var_string_md*/, + const IntegerMetaDataMapType& /*var_integer_md*/, + const NumericMetaDataMapType& var_numeric_md, + Index /*m*/, + const StringMetaDataMapType& /*con_string_md*/, + const IntegerMetaDataMapType& /*con_integer_md*/, + const NumericMetaDataMapType& con_numeric_md +) +{ + DBG_START_METH("SensAmplTNLP::finalize_metadata", dbg_verbosity); + ASL_pfgh* asl = AmplSolverObject(); + + if( run_sens_ ) + { + for( Index step = 1; step <= n_sens_steps_; ++step ) + { + std::string sol_state_id = "sens_sol_state_"; + append_Index(sol_state_id, step); + NumericMetaDataMapType::const_iterator num_it; + num_it = var_numeric_md.find(sol_state_id); + if( num_it != var_numeric_md.end() ) + { + suf_rput(sol_state_id.c_str(), ASL_Sufkind_var, const_cast(&num_it->second[0])); + } + std::string sol_state_z_L_id = sol_state_id + "_z_L"; + num_it = var_numeric_md.find(sol_state_z_L_id); + if( num_it != var_numeric_md.end() ) + { + suf_rput(sol_state_z_L_id.c_str(), ASL_Sufkind_var, const_cast(&num_it->second[0])); + } + std::string sol_state_z_U_id = sol_state_id + "_z_U"; + num_it = var_numeric_md.find(sol_state_z_U_id); + if( num_it != var_numeric_md.end() ) + { + suf_rput(sol_state_z_U_id.c_str(), ASL_Sufkind_var, const_cast(&num_it->second[0])); + } + num_it = con_numeric_md.find(sol_state_id); + if( num_it != con_numeric_md.end() ) + { + suf_rput(sol_state_id.c_str(), ASL_Sufkind_con, const_cast(&num_it->second[0])); + } + } + } +} + +void SensAmplTNLP::finalize_solution( + SolverReturn status, + Index n, + const Number* x, + const Number* z_L, + const Number* z_U, + Index m, + const Number* g, + const Number* lambda, + Number obj_value, + const IpoptData* ip_data, + IpoptCalculatedQuantities* ip_cq +) +{ + DBG_START_METH("SensAmplTNLP::finalize_solution", dbg_verbosity); + + AmplTNLP::finalize_solution(status, n, x, z_L, z_U, m, g, lambda, obj_value, ip_data, ip_cq); +} + +bool SensAmplTNLP::get_var_con_metadata( + Index n, + StringMetaDataMapType& var_string_md, + IntegerMetaDataMapType& var_integer_md, + NumericMetaDataMapType& var_numeric_md, + Index m, + StringMetaDataMapType& con_string_md, + IntegerMetaDataMapType& con_integer_md, + NumericMetaDataMapType& con_numeric_md +) +{ + DBG_START_METH("SensAmplTNLP::get_var_con_metadata", dbg_verbosity); + + try + { + if( run_sens_ ) + { + // Get Sens Suffixes + std::string sens_state = "sens_state_"; + std::vector state; + for( Index i = 1; i <= n_sens_steps_; ++i ) + { + append_Index(sens_state, i); + state = get_index_suffix_vec(sens_state.c_str()); + set_integer_metadata_for_var(sens_state, state); + sens_state = "sens_state_"; + } + std::string sens_state_value = "sens_state_value_"; + std::vector state_val; + for( Index i = 1; i <= n_sens_steps_; ++i ) + { + append_Index(sens_state_value, i); + state_val = get_number_suffix_vec(sens_state_value.c_str()); + set_numeric_metadata_for_var(sens_state_value, state_val); + sens_state_value = "sens_state_value_"; + } + std::string init_constr = "sens_init_constr"; + if( n_sens_steps_ > 0 ) + { + std::vector init_idx = get_index_suffix_constr_vec(init_constr.c_str()); + set_integer_metadata_for_con(init_constr, init_idx); + } + } + } + catch( SUFFIX_EMPTY& exc ) + { + //exc.ReportException(*jnlst_); + // const std::string exc_mess = exc.Message(); + const std::string exc_mess = exc.Message(); + jnlst_->Printf(J_WARNING, J_INITIALIZATION, " WARNING: Will not run sIPOPT " + "because of incorrect AMPL suffix!\n" + " Message: %s\n\n", exc_mess.c_str()); + options_->SetStringValue("sens_internal_abort", "yes"); + bool ignore_suffix_error; + options_->GetBoolValue("ignore_suffix_error", ignore_suffix_error, ""); + if( !ignore_suffix_error ) + { + THROW_EXCEPTION(SUFFIX_EMPTY, "Encountered Suffix Error"); + } + } + + try + { + if( compute_red_hessian_ ) + { + std::string red_hess_str = "red_hessian"; + std::vector red_hess_idx = get_index_suffix_vec(red_hess_str.c_str()); + set_integer_metadata_for_var(red_hess_str.c_str(), red_hess_idx); + } + } + catch( SUFFIX_EMPTY& exc ) + { + const std::string exc_mess = exc.Message(); + jnlst_->Printf(J_WARNING, J_INITIALIZATION, " WARNING: Will not run reduced hessian computation " + "because of incorrect AMPL suffix!\n" + " Message: %s\n\n", exc_mess.c_str()); + options_->SetStringValue("sens_internal_abort", "yes"); + bool ignore_suffix_error; + options_->GetBoolValue("ignore_suffix_error", ignore_suffix_error, ""); + if( !ignore_suffix_error ) + { + THROW_EXCEPTION(SUFFIX_EMPTY, "Encountered Suffix Error"); + } + } + + bool retval = AmplTNLP::get_var_con_metadata(n, var_string_md, var_integer_md, var_numeric_md, m, con_string_md, + con_integer_md, con_numeric_md); + return retval; +} + +const Index* SensAmplTNLP::get_index_suffix( + const char* suffix_name +) +{ + DBG_START_METH("SensAmplTNLP::get_index_suffix", dbg_verbosity); + + SmartPtr suffix_handler = get_suffix_handler(); + + const Index* index_suffix = suffix_handler->GetIntegerSuffixValues(suffix_name, AmplSuffixHandler::Variable_Source); + + return index_suffix; +} + +std::vector SensAmplTNLP::get_index_suffix_vec( + const char* suffix_name +) +{ + DBG_START_METH("SensAmplTNLP::get_index_suffix_vec", dbg_verbosity); + + ASL_pfgh* asl = AmplSolverObject(); + SmartPtr suffix_handler = get_suffix_handler(); + DBG_ASSERT(IsValid(suffix_handler)); + + std::vector index_suffix = suffix_handler->GetIntegerSuffixValues(n_var, suffix_name, + AmplSuffixHandler::Variable_Source); + if( index_suffix.size() == 0 ) + { + index_suffix.resize(n_var, 0); + } + return index_suffix; +} + +const Number* SensAmplTNLP::get_number_suffix( + const char* suffix_name +) +{ + DBG_START_METH("SensAmplTNLP::get_number_suffix", dbg_verbosity); + + SmartPtr suffix_handler = get_suffix_handler(); + + const Number* number_suffix = suffix_handler->GetNumberSuffixValues(suffix_name, AmplSuffixHandler::Variable_Source); + + if( number_suffix == NULL ) + { + // suffix invalid + std::string except = suffix_name; + except.append(" is empty"); + THROW_EXCEPTION(SUFFIX_EMPTY, except); + } + + return number_suffix; +} + +std::vector SensAmplTNLP::get_number_suffix_vec( + const char* suffix_name +) +{ + DBG_START_METH("SensAmplTNLP::get_number_suffix_vec", dbg_verbosity); + ASL_pfgh* asl = AmplSolverObject(); + SmartPtr suffix_handler = get_suffix_handler(); + + std::vector number_suffix = suffix_handler->GetNumberSuffixValues(n_var, suffix_name, + AmplSuffixHandler::Variable_Source); + + if( number_suffix.empty() ) + { + // suffix invalid + std::string except = suffix_name; + except.append(" is empty"); + THROW_EXCEPTION(SUFFIX_EMPTY, except); + } + + return number_suffix; +} + +const Index* SensAmplTNLP::get_index_suffix_constr( + const char* suffix_name +) +{ + DBG_START_METH("SensAmplTNLP::get_index_suffix_constr", dbg_verbosity); + + SmartPtr suffix_handler = get_suffix_handler(); + + const Index* index_suffix = suffix_handler->GetIntegerSuffixValues(suffix_name, + AmplSuffixHandler::Constraint_Source); + + if( index_suffix == NULL ) + { + // suffix invalid + std::string except = suffix_name; + except.append(" is empty"); + THROW_EXCEPTION(SUFFIX_EMPTY, except); + } + + return index_suffix; +} + +std::vector SensAmplTNLP::get_index_suffix_constr_vec( + const char* suffix_name +) +{ + DBG_START_METH("SensAmplTNLP::get_index_suffix_constr_vec", dbg_verbosity); + ASL_pfgh* asl = AmplSolverObject(); + SmartPtr suffix_handler = get_suffix_handler(); + + std::vector index_suffix = suffix_handler->GetIntegerSuffixValues(n_con, suffix_name, + AmplSuffixHandler::Constraint_Source); + + if( index_suffix.empty() ) + { + // suffix invalid + std::string except = suffix_name; + except.append(" is empty"); + THROW_EXCEPTION(SUFFIX_EMPTY, except); + } + + return index_suffix; +} + +const Number* SensAmplTNLP::get_number_suffix_constr( + const char* suffix_name +) +{ + DBG_START_METH("SensAmplTNLP::get_number_suffix_constr", dbg_verbosity); + + SmartPtr suffix_handler = get_suffix_handler(); + + const Number* number_suffix = suffix_handler->GetNumberSuffixValues(suffix_name, + AmplSuffixHandler::Constraint_Source); + + if( number_suffix == NULL ) + { + // suffix invalid + std::string except = suffix_name; + except.append(" is empty"); + THROW_EXCEPTION(SUFFIX_EMPTY, except); + } + + return number_suffix; +} + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/SensAmplTNLP.hpp b/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/SensAmplTNLP.hpp new file mode 100644 index 000000000..5aab69f83 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/SensAmplTNLP.hpp @@ -0,0 +1,164 @@ +// Copyright 2009 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-11 + +#ifndef __SENSAMPLTNLP_HPP__ +#define __SENSAMPLTNLP_HPP__ + +#include "AmplTNLP.hpp" +#include "SensUtils.hpp" + +namespace Ipopt +{ +// same as DECLARE_STD_EXCEPTION, but not using any export +class SUFFIX_EMPTY: public Ipopt::IpoptException +{ +public: + SUFFIX_EMPTY( + std::string msg, + std::string fname, + Ipopt::Index line + ) + : Ipopt::IpoptException(msg, fname, line, "SUFFIX_EMPTY") + { } + + SUFFIX_EMPTY( + const SUFFIX_EMPTY& copy + ) + : Ipopt::IpoptException(copy) + { } + +private: + SUFFIX_EMPTY(); + void operator=( + const SUFFIX_EMPTY& + ); +}; + +class SensAmplTNLP: public AmplTNLP +{ + /** This class is the Sens-wrapper for the ampltnlp, adapts + * the get bounds function and some others to our needs. */ + +public: + /** constructor */ + SensAmplTNLP( + const SmartPtr& jnlst, + const SmartPtr options, + char**& argv, + SmartPtr suffix_handler = NULL, + bool allow_discrete = false, + SmartPtr ampl_options_list = NULL, + const char* ampl_option_string = NULL, + const char* ampl_invokation_string = NULL, + const char* ampl_banner_string = NULL, + std::string* nl_file_content = NULL + ); + + virtual ~SensAmplTNLP(); + + /** returns bounds of the nlp. Overloaded from AmplTNLP */ + virtual bool get_bounds_info( + Index n, + Number* x_l, + Number* x_u, + Index m, + Number* g_l, + Number* g_u + ); + + void set_sens_solution( + Index idx, + SmartPtr sens_sol + ); + + virtual void finalize_metadata( + Index n, + const StringMetaDataMapType& var_string_md, + const IntegerMetaDataMapType& var_integer_md, + const NumericMetaDataMapType& var_numeric_md, + Index m, + const StringMetaDataMapType& con_string_md, + const IntegerMetaDataMapType& con_integer_md, + const NumericMetaDataMapType& con_numeric_md + ); + + virtual void finalize_solution( + SolverReturn status, + Index n, + const Number* x, + const Number* z_L, + const Number* z_U, + Index m, + const Number* g, + const Number* lambda, + Number obj_value, + const IpoptData* ip_data, + IpoptCalculatedQuantities* ip_cq + ); + + const Index* get_index_suffix( + const char* suffix_name + ); + + std::vector get_index_suffix_vec( + const char* suffix_name + ); + + const Number* get_number_suffix( + const char* suffix_name + ); + + std::vector get_number_suffix_vec( + const char* suffix_name + ); + + const Index* get_index_suffix_constr( + const char* suffix_name + ); + + std::vector get_index_suffix_constr_vec( + const char* suffix_name + ); + + const Number* get_number_suffix_constr( + const char* suffix_name + ); + + virtual bool get_var_con_metadata( + Index n, + StringMetaDataMapType& var_string_md, + IntegerMetaDataMapType& var_integer_md, + NumericMetaDataMapType& var_numeric_md, + Index m, + StringMetaDataMapType& con_string_md, + IntegerMetaDataMapType& con_integer_md, + NumericMetaDataMapType& con_numeric_md + ); + +private: + + /** local copy of current lower and upper bounds - needed for parameter change */ + // Number* x_L; + // Number* x_U; + SmartPtr jnlst_; + SmartPtr options_; + + bool have_parameters_; + + Index* parameter_flags_; + Number* parameter_values_; + + /** important Options */ + Index n_sens_steps_; + bool run_sens_; + bool compute_red_hessian_; + + std::vector > sens_sol_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/ampl_sipopt.cpp b/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/ampl_sipopt.cpp new file mode 100644 index 000000000..2a174ead0 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/AmplSolver/ampl_sipopt.cpp @@ -0,0 +1,143 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-11 + +#include "SensAmplTNLP.hpp" +#include "IpIpoptApplication.hpp" +#include "SensApplication.hpp" +#include "IpPDSearchDirCalc.hpp" +#include "IpIpoptAlg.hpp" +#include "SensRegOp.hpp" + +int main( + int /*argv*/, + char** argc +) +{ + using namespace Ipopt; + + SmartPtr app_ipopt = new IpoptApplication(); + app_ipopt->RethrowNonIpoptException(false); + + SmartPtr app_sens = new SensApplication(app_ipopt->Jnlst(), app_ipopt->Options(), + app_ipopt->RegOptions()); + + // Register sIPOPT options + RegisterOptions_sIPOPT(app_ipopt->RegOptions()); + app_ipopt->Options()->SetRegisteredOptions(app_ipopt->RegOptions()); + + // Call Initialize the first time to create a journalist, but ignore + // any options file + ApplicationReturnStatus retval; + retval = app_ipopt->Initialize(""); + if( retval != Solve_Succeeded ) + { + //printf("ampl_ipopt.cpp: Error in first Initialize!!!!\n"); + exit(-100); + } + + app_ipopt->Initialize(); + + // prepare suffixes, or metadata ... + SmartPtr suffix_handler = new AmplSuffixHandler(); + // Modified for warm-start from AMPL + suffix_handler->AddAvailableSuffix("ipopt_zL_out", AmplSuffixHandler::Variable_Source, + AmplSuffixHandler::Number_Type); + suffix_handler->AddAvailableSuffix("ipopt_zU_out", AmplSuffixHandler::Variable_Source, + AmplSuffixHandler::Number_Type); + suffix_handler->AddAvailableSuffix("ipopt_zL_in", AmplSuffixHandler::Variable_Source, + AmplSuffixHandler::Number_Type); + suffix_handler->AddAvailableSuffix("ipopt_zU_in", AmplSuffixHandler::Variable_Source, + AmplSuffixHandler::Number_Type); + + suffix_handler->AddAvailableSuffix("parameter", AmplSuffixHandler::Variable_Source, AmplSuffixHandler::Index_Type); + suffix_handler->AddAvailableSuffix("nominal_value", AmplSuffixHandler::Variable_Source, + AmplSuffixHandler::Number_Type); + suffix_handler->AddAvailableSuffix("perturbed_value", AmplSuffixHandler::Variable_Source, + AmplSuffixHandler::Number_Type); + + // Suffixes for sIPOPT + suffix_handler->AddAvailableSuffix("sens_init_constr", AmplSuffixHandler::Constraint_Source, + AmplSuffixHandler::Index_Type); + + int n_sens_steps = 0; + app_ipopt->Options()->GetIntegerValue("n_sens_steps", n_sens_steps, ""); + std::string state; + std::string state_value; + std::string state_value_zL; + std::string state_value_zU; + std::string sol_state; + std::string sol_state_zL; + std::string sol_state_zU; + for( int k = 0; k < n_sens_steps + 1; ++k ) + { + state = "sens_state_"; + state_value = "sens_state_value_"; + sol_state = "sens_sol_state_"; + state_value_zL = state_value; + state_value_zU = state_value; + sol_state_zL = sol_state; + sol_state_zU = sol_state; + append_Index(state, k); + append_Index(state_value, k); + append_Index(state_value_zL, k); + append_Index(state_value_zU, k); + append_Index(sol_state, k); + append_Index(sol_state_zL, k); + append_Index(sol_state_zU, k); + sol_state_zL += "_z_L"; + sol_state_zU += "_z_U"; + state_value_zL += "_z_L"; + state_value_zU += "_z_U"; + suffix_handler->AddAvailableSuffix(state, AmplSuffixHandler::Variable_Source, AmplSuffixHandler::Index_Type); + suffix_handler->AddAvailableSuffix(state_value, AmplSuffixHandler::Variable_Source, + AmplSuffixHandler::Number_Type); + suffix_handler->AddAvailableSuffix(state_value_zL, AmplSuffixHandler::Variable_Source, + AmplSuffixHandler::Number_Type); + suffix_handler->AddAvailableSuffix(state_value_zU, AmplSuffixHandler::Variable_Source, + AmplSuffixHandler::Number_Type); + suffix_handler->AddAvailableSuffix(sol_state, AmplSuffixHandler::Variable_Source, AmplSuffixHandler::Number_Type); + suffix_handler->AddAvailableSuffix(sol_state, AmplSuffixHandler::Constraint_Source, + AmplSuffixHandler::Number_Type); + suffix_handler->AddAvailableSuffix(sol_state_zL, AmplSuffixHandler::Variable_Source, + AmplSuffixHandler::Number_Type); + suffix_handler->AddAvailableSuffix(sol_state_zU, AmplSuffixHandler::Variable_Source, + AmplSuffixHandler::Number_Type); + } + + // for reduced hessian computation + suffix_handler->AddAvailableSuffix("red_hessian", AmplSuffixHandler::Variable_Source, AmplSuffixHandler::Index_Type); + + // Create AmplOptionsList for sIPOPT AMPL options + SmartPtr ampl_options_list = new AmplOptionsList(); + + ampl_options_list->AddAmplOption("run_sens", "run_sens", AmplOptionsList::String_Option, + "Set to yes if sens algorithm should be run."); + ampl_options_list->AddAmplOption("compute_red_hessian", "compute_red_hessian", AmplOptionsList::String_Option, + "Set to yes if reduced hessian should be computed."); + ampl_options_list->AddAmplOption("sens_boundcheck", "sens_boundcheck", AmplOptionsList::String_Option, + "Set to yes to enable the fix-relax QP adaption to a possible bound check. This feature is experimental."); + ampl_options_list->AddAmplOption("n_sens_steps", "n_sens_steps", AmplOptionsList::Integer_Option, + "Number of sensitivity steps"); + + // create AmplSensTNLP from argc. + SmartPtr sens_tnlp = new SensAmplTNLP(ConstPtr(app_ipopt->Jnlst()), app_ipopt->Options(), argc, suffix_handler, + false, ampl_options_list); + + app_sens->Initialize(); + + const int n_loops = 1; // make larger for profiling + for( Index i = 0; i < n_loops; i++ ) + { + retval = app_ipopt->OptimizeTNLP(sens_tnlp); + } + + /* give pointers to Ipopt algorithm objects to Sens Application */ + app_sens->SetIpoptAlgorithmObjects(app_ipopt, retval); + + app_sens->Run(); + + return 0; +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/Makefile.am b/Ipopt-3.13.4/contrib/sIPOPT/Makefile.am new file mode 100644 index 000000000..f76360c71 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/Makefile.am @@ -0,0 +1,9 @@ +# Copyright (C) 2019 COIN-OR +# All Rights Reserved. +# This file is distributed under the Eclipse Public License. + +SUBDIRS = src + +if IPOPT_HAS_ASL + SUBDIRS += AmplSolver +endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/Makefile.in b/Ipopt-3.13.4/contrib/sIPOPT/Makefile.in new file mode 100644 index 000000000..6c294b146 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/Makefile.in @@ -0,0 +1,588 @@ +# Makefile.in generated by automake 1.16.2 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2020 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +# Copyright (C) 2019 COIN-OR +# All Rights Reserved. +# This file is distributed under the Eclipse Public License. +VPATH = @srcdir@ +am__is_gnu_make = { \ + if test -z '$(MAKELEVEL)'; then \ + false; \ + elif test -n '$(MAKE_HOST)'; then \ + true; \ + elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ + true; \ + else \ + false; \ + fi; \ +} +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +@IPOPT_HAS_ASL_TRUE@am__append_1 = AmplSolver +subdir = contrib/sIPOPT +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +DIST_COMMON = $(srcdir)/Makefile.am +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/src/Common/config.h \ + $(top_builddir)/src/Common/config_ipopt.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +SOURCES = +RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \ + ctags-recursive dvi-recursive html-recursive info-recursive \ + install-data-recursive install-dvi-recursive \ + install-exec-recursive install-html-recursive \ + install-info-recursive install-pdf-recursive \ + install-ps-recursive install-recursive installcheck-recursive \ + installdirs-recursive pdf-recursive ps-recursive \ + tags-recursive uninstall-recursive +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \ + distclean-recursive maintainer-clean-recursive +am__recursive_targets = \ + $(RECURSIVE_TARGETS) \ + $(RECURSIVE_CLEAN_TARGETS) \ + $(am__extra_recursive_targets) +AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +DIST_SUBDIRS = src AmplSolver +ACLOCAL = @ACLOCAL@ +ADD_CFLAGS = @ADD_CFLAGS@ +ADD_CXXFLAGS = @ADD_CXXFLAGS@ +ADD_FFLAGS = @ADD_FFLAGS@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AR = @AR@ +AS = @AS@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +BIT32FCOMMENT = @BIT32FCOMMENT@ +BIT64FCOMMENT = @BIT64FCOMMENT@ +BITS_PER_POINTER = @BITS_PER_POINTER@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +COIN_PKG_CONFIG_PATH = @COIN_PKG_CONFIG_PATH@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CXX = @CXX@ +CXXCPP = @CXXCPP@ +CXXDEPMODE = @CXXDEPMODE@ +CXXFLAGS = @CXXFLAGS@ +CXXLIBS = @CXXLIBS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DLLTOOL = @DLLTOOL@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +F77 = @F77@ +FFLAGS = @FFLAGS@ +FGREP = @FGREP@ +FLIBS = @FLIBS@ +GREP = @GREP@ +HSLLIB_CFLAGS = @HSLLIB_CFLAGS@ +HSLLIB_CFLAGS_NOPC = @HSLLIB_CFLAGS_NOPC@ +HSLLIB_LFLAGS = @HSLLIB_LFLAGS@ +HSLLIB_LFLAGS_NOPC = @HSLLIB_LFLAGS_NOPC@ +HSLLIB_PCFILES = @HSLLIB_PCFILES@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +IPALLLIBS = @IPALLLIBS@ +IPOPTAMPLINTERFACELIB_CFLAGS = @IPOPTAMPLINTERFACELIB_CFLAGS@ +IPOPTAMPLINTERFACELIB_CFLAGS_NOPC = @IPOPTAMPLINTERFACELIB_CFLAGS_NOPC@ +IPOPTAMPLINTERFACELIB_LFLAGS = @IPOPTAMPLINTERFACELIB_LFLAGS@ +IPOPTAMPLINTERFACELIB_LFLAGS_NOPC = @IPOPTAMPLINTERFACELIB_LFLAGS_NOPC@ +IPOPTAMPLINTERFACELIB_PCFILES = @IPOPTAMPLINTERFACELIB_PCFILES@ +IPOPTLIB_CFLAGS = @IPOPTLIB_CFLAGS@ +IPOPTLIB_CFLAGS_NOPC = @IPOPTLIB_CFLAGS_NOPC@ +IPOPTLIB_LFLAGS = @IPOPTLIB_LFLAGS@ +IPOPTLIB_LFLAGS_NOPC = @IPOPTLIB_LFLAGS_NOPC@ +IPOPTLIB_PCFILES = @IPOPTLIB_PCFILES@ +JAR = @JAR@ +JAVA = @JAVA@ +JAVAC = @JAVAC@ +JAVADOC = @JAVADOC@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +LT_LDFLAGS = @LT_LDFLAGS@ +LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ +MAINT = @MAINT@ +MAKEINFO = @MAKEINFO@ +MANIFEST_TOOL = @MANIFEST_TOOL@ +MKDIR_P = @MKDIR_P@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PKG_CONFIG = @PKG_CONFIG@ +RANLIB = @RANLIB@ +RPATH_FLAGS = @RPATH_FLAGS@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +SIPOPTAMPLINTERFACELIB_CFLAGS = @SIPOPTAMPLINTERFACELIB_CFLAGS@ +SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC = @SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC@ +SIPOPTAMPLINTERFACELIB_LFLAGS = @SIPOPTAMPLINTERFACELIB_LFLAGS@ +SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC = @SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC@ +SIPOPTAMPLINTERFACELIB_PCFILES = @SIPOPTAMPLINTERFACELIB_PCFILES@ +STRIP = @STRIP@ +VERSION = @VERSION@ +_ACJNI_JAVAC = @_ACJNI_JAVAC@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_AR = @ac_ct_AR@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_CXX = @ac_ct_CXX@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +ac_ct_F77 = @ac_ct_F77@ +ac_ct_PKG_CONFIG = @ac_ct_PKG_CONFIG@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +coin_doxy_logname = @coin_doxy_logname@ +coin_doxy_tagfiles = @coin_doxy_tagfiles@ +coin_doxy_tagname = @coin_doxy_tagname@ +coin_doxy_usedot = @coin_doxy_usedot@ +coin_have_doxygen = @coin_have_doxygen@ +coin_have_latex = @coin_have_latex@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +SUBDIRS = src $(am__append_1) +all: all-recursive + +.SUFFIXES: +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign contrib/sIPOPT/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign contrib/sIPOPT/Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +# This directory's subdirectories are mostly independent; you can cd +# into them and run 'make' without going through this Makefile. +# To change the values of 'make' variables: instead of editing Makefiles, +# (1) if the variable is set in 'config.status', edit 'config.status' +# (which will cause the Makefiles to be regenerated when you run 'make'); +# (2) otherwise, pass the desired values on the 'make' command line. +$(am__recursive_targets): + @fail=; \ + if $(am__make_keepgoing); then \ + failcom='fail=yes'; \ + else \ + failcom='exit 1'; \ + fi; \ + dot_seen=no; \ + target=`echo $@ | sed s/-recursive//`; \ + case "$@" in \ + distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \ + *) list='$(SUBDIRS)' ;; \ + esac; \ + for subdir in $$list; do \ + echo "Making $$target in $$subdir"; \ + if test "$$subdir" = "."; then \ + dot_seen=yes; \ + local_target="$$target-am"; \ + else \ + local_target="$$target"; \ + fi; \ + ($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ + || eval $$failcom; \ + done; \ + if test "$$dot_seen" = "no"; then \ + $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \ + fi; test -z "$$fail" + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-recursive +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \ + include_option=--etags-include; \ + empty_fix=.; \ + else \ + include_option=--include; \ + empty_fix=; \ + fi; \ + list='$(SUBDIRS)'; for subdir in $$list; do \ + if test "$$subdir" = .; then :; else \ + test ! -f $$subdir/TAGS || \ + set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \ + fi; \ + done; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-recursive + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-recursive + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags +check-am: all-am +check: check-recursive +all-am: Makefile +installdirs: installdirs-recursive +installdirs-am: +install: install-recursive +install-exec: install-exec-recursive +install-data: install-data-recursive +uninstall: uninstall-recursive + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-recursive +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-recursive + +clean-am: clean-generic clean-libtool mostlyclean-am + +distclean: distclean-recursive + -rm -f Makefile +distclean-am: clean-am distclean-generic distclean-tags + +dvi: dvi-recursive + +dvi-am: + +html: html-recursive + +html-am: + +info: info-recursive + +info-am: + +install-data-am: + +install-dvi: install-dvi-recursive + +install-dvi-am: + +install-exec-am: + +install-html: install-html-recursive + +install-html-am: + +install-info: install-info-recursive + +install-info-am: + +install-man: + +install-pdf: install-pdf-recursive + +install-pdf-am: + +install-ps: install-ps-recursive + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-recursive + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-recursive + +mostlyclean-am: mostlyclean-generic mostlyclean-libtool + +pdf: pdf-recursive + +pdf-am: + +ps: ps-recursive + +ps-am: + +uninstall-am: + +.MAKE: $(am__recursive_targets) install-am install-strip + +.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am check \ + check-am clean clean-generic clean-libtool cscopelist-am ctags \ + ctags-am distclean distclean-generic distclean-libtool \ + distclean-tags dvi dvi-am html html-am info info-am install \ + install-am install-data install-data-am install-dvi \ + install-dvi-am install-exec install-exec-am install-html \ + install-html-am install-info install-info-am install-man \ + install-pdf install-pdf-am install-ps install-ps-am \ + install-strip installcheck installcheck-am installdirs \ + installdirs-am maintainer-clean maintainer-clean-generic \ + mostlyclean mostlyclean-generic mostlyclean-libtool pdf pdf-am \ + ps ps-am tags tags-am uninstall uninstall-am + +.PRECIOUS: Makefile + + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/Ipopt-3.13.4/contrib/sIPOPT/doc/Makefile b/Ipopt-3.13.4/contrib/sIPOPT/doc/Makefile new file mode 100644 index 000000000..1317d3304 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/doc/Makefile @@ -0,0 +1,20 @@ +# Copyright (C) 2009 International Business Machines. All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# Author: Andreas Waechter, 2010-05-26 + + +DOCS = sipopt_manual.pdf + +all: $(DOCS) + +.SUFFIXES: .tex .pdf + +.tex.pdf: + pdflatex $* + bibtex $* + pdflatex $* + pdflatex $* + +clean: + rm -f *.aux *.log *.bbl *.blg *.toc diff --git a/Ipopt-3.13.4/contrib/sIPOPT/doc/iecrv5.bst b/Ipopt-3.13.4/contrib/sIPOPT/doc/iecrv5.bst new file mode 100644 index 000000000..235833e45 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/doc/iecrv5.bst @@ -0,0 +1,1550 @@ +%% +%% This is file `iecrv5.bst', +%% generated with the docstrip utility. +%% +%% The original source files were: +%% +%% merlin.mbs (with options: `ay,nat,seq-no,nm-rvvc,aunm-semi,xlab-it,keyxyr,blkyear,yr-com,dtbf,note-yr,atit-u,volp-com,jwdpg,pp-last,num-xser,jnm-x,pre-edn,edpar,bkedcap,edby,edbyx,blk-tit,pp,ed,ord,jabr,varand,etal-it,nfss,') +%% ---------------------------------------- +%% *** iecrv5 *** +%% +%% Copyright 1994-2005 Patrick W Daly + % =============================================================== + % IMPORTANT NOTICE: + % This bibliographic style (bst) file has been generated from one or + % more master bibliographic style (mbs) files, listed above. + % + % This generated file can be redistributed and/or modified under the terms + % of the LaTeX Project Public License Distributed from CTAN + % archives in directory macros/latex/base/lppl.txt; either + % version 1 of the License, or any later version. + % =============================================================== + % Name and version information of the main mbs file: + % \ProvidesFile{merlin.mbs}[2005/10/17 4.14 (PWD, AO, DPC)] + % For use with BibTeX version 0.99a or later + %------------------------------------------------------------------- + % This bibliography style file is intended for texts in ENGLISH + % This is an author-year citation style bibliography. As such, it is + % non-standard LaTeX, and requires a special package file to function properly. + % Such a package is natbib.sty by Patrick W. Daly + % The form of the \bibitem entries is + % \bibitem[Jones et al.(1990)]{key}... + % \bibitem[Jones et al.(1990)Jones, Baker, and Smith]{key}... + % The essential feature is that the label (the part in brackets) consists + % of the author names, as they should appear in the citation, with the year + % in parentheses following. There must be no space before the opening + % parenthesis! + % With natbib v5.3, a full list of authors may also follow the year. + % In natbib.sty, it is possible to define the type of enclosures that is + % really wanted (brackets or parentheses), but in either case, there must + % be parentheses in the label. + % The \cite command functions as follows: + % \citet{key} ==>> Jones et al. (1990) + % \citet*{key} ==>> Jones, Baker, and Smith (1990) + % \citep{key} ==>> (Jones et al., 1990) + % \citep*{key} ==>> (Jones, Baker, and Smith, 1990) + % \citep[chap. 2]{key} ==>> (Jones et al., 1990, chap. 2) + % \citep[e.g.][]{key} ==>> (e.g. Jones et al., 1990) + % \citep[e.g.][p. 32]{key} ==>> (e.g. Jones et al., p. 32) + % \citeauthor{key} ==>> Jones et al. + % \citeauthor*{key} ==>> Jones, Baker, and Smith + % \citeyear{key} ==>> 1990 + %--------------------------------------------------------------------- + +ENTRY + { address + author + booktitle + chapter + edition + editor + eid + howpublished + institution + journal + key + month + note + number + organization + pages + publisher + school + series + title + type + volume + year + } + {} + { label extra.label sort.label short.list } +INTEGERS { output.state before.all mid.sentence after.sentence after.block } +FUNCTION {init.state.consts} +{ #0 'before.all := + #1 'mid.sentence := + #2 'after.sentence := + #3 'after.block := +} +STRINGS { s t} +FUNCTION {output.nonnull} +{ 's := + output.state mid.sentence = + { ", " * write$ } + { output.state after.block = + { add.period$ write$ + newline$ + "\newblock " write$ + } + { output.state before.all = + 'write$ + { add.period$ " " * write$ } + if$ + } + if$ + mid.sentence 'output.state := + } + if$ + s +} +FUNCTION {output} +{ duplicate$ empty$ + 'pop$ + 'output.nonnull + if$ +} +FUNCTION {output.check} +{ 't := + duplicate$ empty$ + { pop$ "empty " t * " in " * cite$ * warning$ } + 'output.nonnull + if$ +} +FUNCTION {fin.entry} +{ add.period$ + write$ + newline$ +} + +FUNCTION {new.block} +{ output.state before.all = + 'skip$ + { after.block 'output.state := } + if$ +} +FUNCTION {new.sentence} +{ output.state after.block = + 'skip$ + { output.state before.all = + 'skip$ + { after.sentence 'output.state := } + if$ + } + if$ +} +FUNCTION {add.blank} +{ " " * before.all 'output.state := +} + +FUNCTION {date.block} +{ + skip$ +} + +FUNCTION {not} +{ { #0 } + { #1 } + if$ +} +FUNCTION {and} +{ 'skip$ + { pop$ #0 } + if$ +} +FUNCTION {or} +{ { pop$ #1 } + 'skip$ + if$ +} +FUNCTION {new.block.checkb} +{ empty$ + swap$ empty$ + and + 'skip$ + 'new.block + if$ +} +FUNCTION {field.or.null} +{ duplicate$ empty$ + { pop$ "" } + 'skip$ + if$ +} +FUNCTION {emphasize} +{ duplicate$ empty$ + { pop$ "" } + { "\emph{" swap$ * "}" * } + if$ +} +FUNCTION {bolden} +{ duplicate$ empty$ + { pop$ "" } + { "\textbf{" swap$ * "}" * } + if$ +} +FUNCTION {tie.or.space.prefix} +{ duplicate$ text.length$ #3 < + { "~" } + { " " } + if$ + swap$ +} + +FUNCTION {capitalize} +{ "u" change.case$ "t" change.case$ } + +FUNCTION {space.word} +{ " " swap$ * " " * } + % Here are the language-specific definitions for explicit words. + % Each function has a name bbl.xxx where xxx is the English word. + % The language selected here is ENGLISH +FUNCTION {bbl.and} +{ "\protect\BIBand{}"} + +FUNCTION {bbl.etal} +{ "et~al." } + +FUNCTION {bbl.editors} +{ "eds." } + +FUNCTION {bbl.editor} +{ "ed." } + +FUNCTION {bbl.edby} +{ "edited by" } + +FUNCTION {bbl.edition} +{ "edition" } + +FUNCTION {bbl.volume} +{ "volume" } + +FUNCTION {bbl.of} +{ "of" } + +FUNCTION {bbl.number} +{ "number" } + +FUNCTION {bbl.nr} +{ "no." } + +FUNCTION {bbl.in} +{ "in" } + +FUNCTION {bbl.pages} +{ "pp." } + +FUNCTION {bbl.page} +{ "p." } + +FUNCTION {bbl.chapter} +{ "chapter" } + +FUNCTION {bbl.techrep} +{ "Technical Report" } + +FUNCTION {bbl.mthesis} +{ "Master's thesis" } + +FUNCTION {bbl.phdthesis} +{ "Ph.D. thesis" } + +FUNCTION {bbl.first} +{ "1st" } + +FUNCTION {bbl.second} +{ "2nd" } + +FUNCTION {bbl.third} +{ "3rd" } + +FUNCTION {bbl.fourth} +{ "4th" } + +FUNCTION {bbl.fifth} +{ "5th" } + +FUNCTION {bbl.st} +{ "st" } + +FUNCTION {bbl.nd} +{ "nd" } + +FUNCTION {bbl.rd} +{ "rd" } + +FUNCTION {bbl.th} +{ "th" } + +MACRO {jan} {"January"} + +MACRO {feb} {"February"} + +MACRO {mar} {"March"} + +MACRO {apr} {"April"} + +MACRO {may} {"May"} + +MACRO {jun} {"June"} + +MACRO {jul} {"July"} + +MACRO {aug} {"August"} + +MACRO {sep} {"September"} + +MACRO {oct} {"October"} + +MACRO {nov} {"November"} + +MACRO {dec} {"December"} + +FUNCTION {eng.ord} +{ duplicate$ "1" swap$ * + #-2 #1 substring$ "1" = + { bbl.th * } + { duplicate$ #-1 #1 substring$ + duplicate$ "1" = + { pop$ bbl.st * } + { duplicate$ "2" = + { pop$ bbl.nd * } + { "3" = + { bbl.rd * } + { bbl.th * } + if$ + } + if$ + } + if$ + } + if$ +} + +MACRO {acmcs} {"ACM Comput. Surv."} + +MACRO {acta} {"Acta Inf."} + +MACRO {cacm} {"Commun. ACM"} + +MACRO {ibmjrd} {"IBM J. Res. Dev."} + +MACRO {ibmsj} {"IBM Syst.~J."} + +MACRO {ieeese} {"IEEE Trans. Software Eng."} + +MACRO {ieeetc} {"IEEE Trans. Comput."} + +MACRO {ieeetcad} + {"IEEE Trans. Comput. Aid. Des."} + +MACRO {ipl} {"Inf. Process. Lett."} + +MACRO {jacm} {"J.~ACM"} + +MACRO {jcss} {"J.~Comput. Syst. Sci."} + +MACRO {scp} {"Sci. Comput. Program."} + +MACRO {sicomp} {"SIAM J. Comput."} + +MACRO {tocs} {"ACM Trans. Comput. Syst."} + +MACRO {tods} {"ACM Trans. Database Syst."} + +MACRO {tog} {"ACM Trans. Graphic."} + +MACRO {toms} {"ACM Trans. Math. Software"} + +MACRO {toois} {"ACM Trans. Office Inf. Syst."} + +MACRO {toplas} {"ACM Trans. Progr. Lang. Syst."} + +MACRO {tcs} {"Theor. Comput. Sci."} + +FUNCTION {bibinfo.check} +{ swap$ + duplicate$ missing$ + { + pop$ pop$ + "" + } + { duplicate$ empty$ + { + swap$ pop$ + } + { swap$ + pop$ + } + if$ + } + if$ +} +FUNCTION {bibinfo.warn} +{ swap$ + duplicate$ missing$ + { + swap$ "missing " swap$ * " in " * cite$ * warning$ pop$ + "" + } + { duplicate$ empty$ + { + swap$ "empty " swap$ * " in " * cite$ * warning$ + } + { swap$ + pop$ + } + if$ + } + if$ +} +STRINGS { bibinfo} +INTEGERS { nameptr namesleft numnames } + +FUNCTION {format.names} +{ 'bibinfo := + duplicate$ empty$ 'skip$ { + 's := + "" 't := + #1 'nameptr := + s num.names$ 'numnames := + numnames 'namesleft := + { namesleft #0 > } + { s nameptr + "{vv~}{ll}{, jj}{, f{.}.}" + format.name$ + bibinfo bibinfo.check + 't := + nameptr #1 > + { + namesleft #1 > + { "; " * t * } + { + s nameptr "{ll}" format.name$ duplicate$ "others" = + { 't := } + { pop$ } + if$ + numnames #2 > + { ";" * } + 'skip$ + if$ + t "others" = + { + " " * bbl.etal emphasize * + } + { + bbl.and + space.word * t * + } + if$ + } + if$ + } + 't + if$ + nameptr #1 + 'nameptr := + namesleft #1 - 'namesleft := + } + while$ + } if$ +} +FUNCTION {format.names.ed} +{ + 'bibinfo := + duplicate$ empty$ 'skip$ { + 's := + "" 't := + #1 'nameptr := + s num.names$ 'numnames := + numnames 'namesleft := + { namesleft #0 > } + { s nameptr + "{f{.}.~}{vv~}{ll}{ jj}" + format.name$ + bibinfo bibinfo.check + 't := + nameptr #1 > + { + namesleft #1 > + { "; " * t * } + { + s nameptr "{ll}" format.name$ duplicate$ "others" = + { 't := } + { pop$ } + if$ + numnames #2 > + { ";" * } + 'skip$ + if$ + t "others" = + { + + " " * bbl.etal emphasize * + } + { + bbl.and + space.word * t * + } + if$ + } + if$ + } + 't + if$ + nameptr #1 + 'nameptr := + namesleft #1 - 'namesleft := + } + while$ + } if$ +} +FUNCTION {format.key} +{ empty$ + { key field.or.null } + { "" } + if$ +} + +FUNCTION {format.authors} +{ author "author" format.names +} +FUNCTION {get.bbl.editor} +{ editor num.names$ #1 > 'bbl.editors 'bbl.editor if$ } + +FUNCTION {format.editors} +{ editor "editor" format.names duplicate$ empty$ 'skip$ + { + " " * + get.bbl.editor + capitalize + "(" swap$ * ")" * + * + } + if$ +} +FUNCTION {format.note} +{ + note empty$ + { "" } + { note #1 #1 substring$ + duplicate$ "{" = + 'skip$ + { output.state mid.sentence = + { "l" } + { "u" } + if$ + change.case$ + } + if$ + note #2 global.max$ substring$ * "note" bibinfo.check + } + if$ +} + +FUNCTION {format.title} +{ title + "title" bibinfo.check +} +FUNCTION {format.full.names} +{'s := + "" 't := + #1 'nameptr := + s num.names$ 'numnames := + numnames 'namesleft := + { namesleft #0 > } + { s nameptr + "{vv~}{ll}" format.name$ + 't := + nameptr #1 > + { + namesleft #1 > + { ", " * t * } + { + s nameptr "{ll}" format.name$ duplicate$ "others" = + { 't := } + { pop$ } + if$ + t "others" = + { + " " * bbl.etal emphasize * + } + { + numnames #2 > + { "," * } + 'skip$ + if$ + bbl.and + space.word * t * + } + if$ + } + if$ + } + 't + if$ + nameptr #1 + 'nameptr := + namesleft #1 - 'namesleft := + } + while$ +} + +FUNCTION {author.editor.key.full} +{ author empty$ + { editor empty$ + { key empty$ + { cite$ #1 #3 substring$ } + 'key + if$ + } + { editor format.full.names } + if$ + } + { author format.full.names } + if$ +} + +FUNCTION {author.key.full} +{ author empty$ + { key empty$ + { cite$ #1 #3 substring$ } + 'key + if$ + } + { author format.full.names } + if$ +} + +FUNCTION {editor.key.full} +{ editor empty$ + { key empty$ + { cite$ #1 #3 substring$ } + 'key + if$ + } + { editor format.full.names } + if$ +} + +FUNCTION {make.full.names} +{ type$ "book" = + type$ "inbook" = + or + 'author.editor.key.full + { type$ "proceedings" = + 'editor.key.full + 'author.key.full + if$ + } + if$ +} + +FUNCTION {output.bibitem} +{ newline$ + "\bibitem[{" write$ + label write$ + ")" make.full.names duplicate$ short.list = + { pop$ } + { * } + if$ + "}]{" * write$ + cite$ write$ + "}" write$ + newline$ + "" + before.all 'output.state := +} + +FUNCTION {n.dashify} +{ + 't := + "" + { t empty$ not } + { t #1 #1 substring$ "-" = + { t #1 #2 substring$ "--" = not + { "--" * + t #2 global.max$ substring$ 't := + } + { { t #1 #1 substring$ "-" = } + { "-" * + t #2 global.max$ substring$ 't := + } + while$ + } + if$ + } + { t #1 #1 substring$ * + t #2 global.max$ substring$ 't := + } + if$ + } + while$ +} + +FUNCTION {word.in} +{ bbl.in capitalize + " " * } + +FUNCTION {format.date} +{ year "year" bibinfo.check duplicate$ empty$ + { + } + 'skip$ + if$ + bolden + extra.label * + before.all 'output.state := + ", " swap$ * +} +FUNCTION {format.btitle} +{ title "title" bibinfo.check + duplicate$ empty$ 'skip$ + { + emphasize + } + if$ +} +FUNCTION {either.or.check} +{ empty$ + 'pop$ + { "can't use both " swap$ * " fields in " * cite$ * warning$ } + if$ +} +FUNCTION {format.bvolume} +{ volume empty$ + { "" } + { bbl.volume volume tie.or.space.prefix + "volume" bibinfo.check * * + series "series" bibinfo.check + duplicate$ empty$ 'pop$ + { swap$ bbl.of space.word * swap$ + emphasize * } + if$ + "volume and number" number either.or.check + } + if$ +} +FUNCTION {format.number.series} +{ volume empty$ + { number empty$ + { series field.or.null } + { series empty$ + { number "number" bibinfo.check } + { output.state mid.sentence = + { bbl.number } + { bbl.number capitalize } + if$ + number tie.or.space.prefix "number" bibinfo.check * * + bbl.in space.word * + series "series" bibinfo.check * + } + if$ + } + if$ + } + { "" } + if$ +} +FUNCTION {is.num} +{ chr.to.int$ + duplicate$ "0" chr.to.int$ < not + swap$ "9" chr.to.int$ > not and +} + +FUNCTION {extract.num} +{ duplicate$ 't := + "" 's := + { t empty$ not } + { t #1 #1 substring$ + t #2 global.max$ substring$ 't := + duplicate$ is.num + { s swap$ * 's := } + { pop$ "" 't := } + if$ + } + while$ + s empty$ + 'skip$ + { pop$ s } + if$ +} + +FUNCTION {convert.edition} +{ extract.num "l" change.case$ 's := + s "first" = s "1" = or + { bbl.first 't := } + { s "second" = s "2" = or + { bbl.second 't := } + { s "third" = s "3" = or + { bbl.third 't := } + { s "fourth" = s "4" = or + { bbl.fourth 't := } + { s "fifth" = s "5" = or + { bbl.fifth 't := } + { s #1 #1 substring$ is.num + { s eng.ord 't := } + { edition 't := } + if$ + } + if$ + } + if$ + } + if$ + } + if$ + } + if$ + t +} + +FUNCTION {format.edition} +{ edition duplicate$ empty$ 'skip$ + { + convert.edition + output.state mid.sentence = + { "l" } + { "t" } + if$ change.case$ + "edition" bibinfo.check + " " * bbl.edition * + } + if$ +} +INTEGERS { multiresult } +FUNCTION {multi.page.check} +{ 't := + #0 'multiresult := + { multiresult not + t empty$ not + and + } + { t #1 #1 substring$ + duplicate$ "-" = + swap$ duplicate$ "," = + swap$ "+" = + or or + { #1 'multiresult := } + { t #2 global.max$ substring$ 't := } + if$ + } + while$ + multiresult +} +FUNCTION {format.pages} +{ pages duplicate$ empty$ 'skip$ + { duplicate$ multi.page.check + { + bbl.pages swap$ + n.dashify + } + { + bbl.page swap$ + } + if$ + tie.or.space.prefix + "pages" bibinfo.check + * * + } + if$ +} +FUNCTION {format.journal.pages} +{ pages duplicate$ empty$ 'pop$ + { swap$ duplicate$ empty$ + { pop$ pop$ format.pages } + { + ", " * + swap$ + n.dashify + pages multi.page.check + 'bbl.pages + 'bbl.page + if$ + swap$ tie.or.space.prefix + "pages" bibinfo.check + * * + * + } + if$ + } + if$ +} +FUNCTION {format.journal.eid} +{ eid "eid" bibinfo.check + duplicate$ empty$ 'pop$ + { swap$ duplicate$ empty$ 'skip$ + { + ", " * + } + if$ + swap$ * + } + if$ +} +FUNCTION {format.vol.num.pages} +{ volume field.or.null + duplicate$ empty$ 'skip$ + { + "volume" bibinfo.check + } + if$ + number "number" bibinfo.check duplicate$ empty$ 'skip$ + { + swap$ duplicate$ empty$ + { "there's a number but no volume in " cite$ * warning$ } + 'skip$ + if$ + swap$ + "(" swap$ * ")" * + } + if$ * +} + +FUNCTION {format.chapter.pages} +{ chapter empty$ + { "" } + { type empty$ + { bbl.chapter } + { type "l" change.case$ + "type" bibinfo.check + } + if$ + chapter tie.or.space.prefix + "chapter" bibinfo.check + * * + } + if$ +} + +FUNCTION {format.booktitle} +{ + booktitle "booktitle" bibinfo.check + emphasize +} +FUNCTION {format.in.ed.booktitle} +{ format.booktitle duplicate$ empty$ 'skip$ + { + editor "editor" format.names.ed duplicate$ empty$ 'pop$ + { + get.bbl.editor + " " * swap$ * + swap$ + "," * + " " * swap$ + * } + if$ + word.in swap$ * + } + if$ +} +FUNCTION {format.thesis.type} +{ type duplicate$ empty$ + 'pop$ + { swap$ pop$ + "t" change.case$ "type" bibinfo.check + } + if$ +} +FUNCTION {format.tr.number} +{ number "number" bibinfo.check + type duplicate$ empty$ + { pop$ bbl.techrep } + 'skip$ + if$ + "type" bibinfo.check + swap$ duplicate$ empty$ + { pop$ "t" change.case$ } + { tie.or.space.prefix * * } + if$ +} +FUNCTION {format.article.crossref} +{ + word.in + " \cite{" * crossref * "}" * +} +FUNCTION {format.book.crossref} +{ volume duplicate$ empty$ + { "empty volume in " cite$ * "'s crossref of " * crossref * warning$ + pop$ word.in + } + { bbl.volume + capitalize + swap$ tie.or.space.prefix "volume" bibinfo.check * * bbl.of space.word * + } + if$ + " \cite{" * crossref * "}" * +} +FUNCTION {format.incoll.inproc.crossref} +{ + word.in + " \cite{" * crossref * "}" * +} +FUNCTION {format.org.or.pub} +{ 't := + "" + address empty$ t empty$ and + 'skip$ + { + t empty$ + { address "address" bibinfo.check * + } + { t * + address empty$ + 'skip$ + { ", " * address "address" bibinfo.check * } + if$ + } + if$ + } + if$ +} +FUNCTION {format.publisher.address} +{ publisher "publisher" bibinfo.warn format.org.or.pub +} + +FUNCTION {format.organization.address} +{ organization "organization" bibinfo.check format.org.or.pub +} + +FUNCTION {article} +{ output.bibitem + format.authors "author" output.check + author format.key output + format.title "title" output.check + new.sentence + crossref missing$ + { + journal + "journal" bibinfo.check + emphasize + "journal" output.check + add.blank + format.vol.num.pages output + format.date "year" output.check + } + { format.article.crossref output.nonnull + } + if$ + eid empty$ + { format.journal.pages } + { format.journal.eid } + if$ + format.note output + fin.entry +} +FUNCTION {book} +{ output.bibitem + author empty$ + { format.editors "author and editor" output.check + editor format.key output + } + { format.authors output.nonnull + crossref missing$ + { "author and editor" editor either.or.check } + 'skip$ + if$ + } + if$ + format.btitle "title" output.check + crossref missing$ + { format.bvolume output + new.sentence + format.number.series output + format.edition output + format.publisher.address output + } + { + new.sentence + format.book.crossref output.nonnull + } + if$ + format.date "year" output.check + format.note output + fin.entry +} +FUNCTION {booklet} +{ output.bibitem + format.authors output + author format.key output + format.title "title" output.check + new.sentence + howpublished "howpublished" bibinfo.check output + address "address" bibinfo.check output + format.date "year" output.check + format.note output + fin.entry +} + +FUNCTION {inbook} +{ output.bibitem + author empty$ + { format.editors "author and editor" output.check + editor format.key output + } + { format.authors output.nonnull + crossref missing$ + { "author and editor" editor either.or.check } + 'skip$ + if$ + } + if$ + format.btitle "title" output.check + crossref missing$ + { + format.bvolume output + format.chapter.pages "chapter and pages" output.check + new.sentence + format.number.series output + format.edition output + format.publisher.address output + } + { + format.chapter.pages "chapter and pages" output.check + new.sentence + format.book.crossref output.nonnull + } + if$ + format.date "year" output.check + format.pages "pages" output.check + format.note output + fin.entry +} + +FUNCTION {incollection} +{ output.bibitem + format.authors "author" output.check + author format.key output + format.title "title" output.check + new.sentence + crossref missing$ + { format.in.ed.booktitle "booktitle" output.check + format.bvolume output + format.number.series output + format.edition output + format.chapter.pages output + format.publisher.address output + format.date "year" output.check + } + { format.incoll.inproc.crossref output.nonnull + format.chapter.pages output + } + if$ + format.pages "pages" output.check + format.note output + fin.entry +} +FUNCTION {inproceedings} +{ output.bibitem + format.authors "author" output.check + author format.key output + format.title "title" output.check + new.sentence + crossref missing$ + { format.in.ed.booktitle "booktitle" output.check + format.bvolume output + format.number.series output + publisher empty$ + { format.organization.address output } + { organization "organization" bibinfo.check output + format.publisher.address output + } + if$ + format.date "year" output.check + } + { format.incoll.inproc.crossref output.nonnull + } + if$ + format.pages "pages" output.check + format.note output + fin.entry +} +FUNCTION {conference} { inproceedings } +FUNCTION {manual} +{ output.bibitem + format.authors output + author format.key output + format.btitle "title" output.check + new.sentence + organization "organization" bibinfo.check output + address "address" bibinfo.check output + format.edition output + format.date "year" output.check + format.note output + fin.entry +} + +FUNCTION {mastersthesis} +{ output.bibitem + format.authors "author" output.check + author format.key output + format.btitle + "title" output.check + new.sentence + bbl.mthesis format.thesis.type output.nonnull + school "school" bibinfo.warn output + address "address" bibinfo.check output + format.date "year" output.check + format.note output + fin.entry +} + +FUNCTION {misc} +{ output.bibitem + format.authors output + author format.key output + format.title output + new.sentence + howpublished "howpublished" bibinfo.check output + format.date "year" output.check + format.note output + fin.entry +} +FUNCTION {phdthesis} +{ output.bibitem + format.authors "author" output.check + author format.key output + format.btitle + "title" output.check + new.sentence + bbl.phdthesis format.thesis.type output.nonnull + school "school" bibinfo.warn output + address "address" bibinfo.check output + format.date "year" output.check + format.note output + fin.entry +} + +FUNCTION {proceedings} +{ output.bibitem + format.editors output + editor format.key output + format.btitle "title" output.check + format.bvolume output + format.number.series output + publisher empty$ + { format.organization.address output } + { organization "organization" bibinfo.check output + format.publisher.address output + } + if$ + format.date "year" output.check + format.note output + fin.entry +} + +FUNCTION {techreport} +{ output.bibitem + format.authors "author" output.check + author format.key output + format.title + "title" output.check + new.sentence + format.tr.number output.nonnull + institution "institution" bibinfo.warn output + address "address" bibinfo.check output + format.date "year" output.check + format.note output + fin.entry +} + +FUNCTION {unpublished} +{ output.bibitem + format.authors "author" output.check + author format.key output + format.title "title" output.check + format.date "year" output.check + format.note "note" output.check + fin.entry +} + +FUNCTION {default.type} { misc } +READ +FUNCTION {sortify} +{ purify$ + "l" change.case$ +} +INTEGERS { len } +FUNCTION {chop.word} +{ 's := + 'len := + s #1 len substring$ = + { s len #1 + global.max$ substring$ } + 's + if$ +} +FUNCTION {format.lab.names} +{ 's := + "" 't := + s #1 "{vv~}{ll}" format.name$ + s num.names$ duplicate$ + #2 > + { pop$ + " " * bbl.etal emphasize * + } + { #2 < + 'skip$ + { s #2 "{ff }{vv }{ll}{ jj}" format.name$ "others" = + { + " " * bbl.etal emphasize * + } + { bbl.and space.word * s #2 "{vv~}{ll}" format.name$ + * } + if$ + } + if$ + } + if$ +} + +FUNCTION {author.key.label} +{ author empty$ + { key empty$ + { cite$ #1 #3 substring$ } + 'key + if$ + } + { author format.lab.names } + if$ +} + +FUNCTION {author.editor.key.label} +{ author empty$ + { editor empty$ + { key empty$ + { cite$ #1 #3 substring$ } + 'key + if$ + } + { editor format.lab.names } + if$ + } + { author format.lab.names } + if$ +} + +FUNCTION {editor.key.label} +{ editor empty$ + { key empty$ + { cite$ #1 #3 substring$ } + 'key + if$ + } + { editor format.lab.names } + if$ +} + +FUNCTION {calc.short.authors} +{ type$ "book" = + type$ "inbook" = + or + 'author.editor.key.label + { type$ "proceedings" = + 'editor.key.label + 'author.key.label + if$ + } + if$ + 'short.list := +} + +FUNCTION {calc.label} +{ calc.short.authors + short.list + "(" + * + year duplicate$ empty$ + short.list key field.or.null = or + { pop$ "" } + 'skip$ + if$ + * + 'label := +} + +FUNCTION {sort.format.names} +{ 's := + #1 'nameptr := + "" + s num.names$ 'numnames := + numnames 'namesleft := + { namesleft #0 > } + { s nameptr + "{vv{ } }{ll{ }}{ ff{ }}{ jj{ }}" + format.name$ 't := + nameptr #1 > + { + " " * + namesleft #1 = t "others" = and + { "zzzzz" * } + { t sortify * } + if$ + } + { t sortify * } + if$ + nameptr #1 + 'nameptr := + namesleft #1 - 'namesleft := + } + while$ +} + +FUNCTION {sort.format.title} +{ 't := + "A " #2 + "An " #3 + "The " #4 t chop.word + chop.word + chop.word + sortify + #1 global.max$ substring$ +} +FUNCTION {author.sort} +{ author empty$ + { key empty$ + { "to sort, need author or key in " cite$ * warning$ + "" + } + { key sortify } + if$ + } + { author sort.format.names } + if$ +} +FUNCTION {author.editor.sort} +{ author empty$ + { editor empty$ + { key empty$ + { "to sort, need author, editor, or key in " cite$ * warning$ + "" + } + { key sortify } + if$ + } + { editor sort.format.names } + if$ + } + { author sort.format.names } + if$ +} +FUNCTION {editor.sort} +{ editor empty$ + { key empty$ + { "to sort, need editor or key in " cite$ * warning$ + "" + } + { key sortify } + if$ + } + { editor sort.format.names } + if$ +} +INTEGERS { seq.num } +FUNCTION {init.seq} +{ #0 'seq.num :=} +EXECUTE {init.seq} +FUNCTION {int.to.fix} +{ "000000000" swap$ int.to.str$ * + #-1 #10 substring$ +} +FUNCTION {presort} +{ calc.label + label sortify + " " + * + seq.num #1 + 'seq.num := + seq.num int.to.fix + 'sort.label := + sort.label + * + " " + * + title field.or.null + sort.format.title + * + #1 entry.max$ substring$ + 'sort.key$ := +} + +ITERATE {presort} +SORT +STRINGS { last.label next.extra } +INTEGERS { last.extra.num number.label } +FUNCTION {initialize.extra.label.stuff} +{ #0 int.to.chr$ 'last.label := + "" 'next.extra := + #0 'last.extra.num := + #0 'number.label := +} +FUNCTION {forward.pass} +{ last.label label = + { last.extra.num #1 + 'last.extra.num := + last.extra.num int.to.chr$ 'extra.label := + } + { "a" chr.to.int$ 'last.extra.num := + "" 'extra.label := + label 'last.label := + } + if$ + number.label #1 + 'number.label := +} +FUNCTION {reverse.pass} +{ next.extra "b" = + { "a" 'extra.label := } + 'skip$ + if$ + extra.label 'next.extra := + extra.label + emphasize + duplicate$ empty$ + 'skip$ + { "{\natexlab{" swap$ * "}}" * } + if$ + 'extra.label := + label extra.label * 'label := +} +EXECUTE {initialize.extra.label.stuff} +ITERATE {forward.pass} +REVERSE {reverse.pass} +FUNCTION {bib.sort.order} +{ sort.label + " " + * + year field.or.null sortify + * + " " + * + title field.or.null + sort.format.title + * + #1 entry.max$ substring$ + 'sort.key$ := +} +ITERATE {bib.sort.order} +SORT +FUNCTION {begin.bib} +{ preamble$ empty$ + 'skip$ + { preamble$ write$ newline$ } + if$ + "\begin{thebibliography}{" number.label int.to.str$ * "}" * + write$ newline$ + "\providecommand{\natexlab}[1]{#1}" + write$ newline$ +} +EXECUTE {begin.bib} +EXECUTE {init.state.consts} +ITERATE {call.type$} +FUNCTION {end.bib} +{ newline$ + "\end{thebibliography}" write$ newline$ +} +EXECUTE {end.bib} +%% End of customized bst file +%% +%% End of file `iecrv5.bst'. diff --git a/Ipopt-3.13.4/contrib/sIPOPT/doc/sipopt.bib b/Ipopt-3.13.4/contrib/sIPOPT/doc/sipopt.bib new file mode 100644 index 000000000..9b2b83f39 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/doc/sipopt.bib @@ -0,0 +1,474 @@ +% This file was created with JabRef 2.6. +% Encoding: UTF-8 + +@BOOK{Ascher1988, + title = {Numerical Solution of Boundary Value Problems for Ordinary Differential + Equations.}, + publisher = {Prentice Hall}, + year = {1988}, + author = {Ascher, Uri M. and Mattheij, Robert M. M. and Russell, Robert D.}, + series = {Series in Computational Mathematics}, + owner = {hans}, + timestamp = {2009.10.29} +} + +@BOOK{Ascher1998, + title = {Computer Methods for Ordinary Differential Equations and Differential-Algebraic + Equations}, + publisher = {SIAM}, + year = {1998}, + author = {Ascher, Uri M. and Petzold, Linda R.}, + owner = {hans}, + timestamp = {2009.11.01} +} + +@INCOLLECTION{Buskens, + author = {C. B\"{u}skens and H. Maurer}, + title = {{Sensitivity analysis and real-time control of parametric control + problems using nonlinear programming methods}}, + booktitle = {{Online Optimization of Large-scale Systems}}, + publisher = {Springer-Verlag}, + year = {2001}, + editor = {M. Gr\"{o}tschel, S. Krumke and J. Rambau}, + pages = {57-68}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@ARTICLE{Bartlett2006, + author = {Bartlett, Roscoe A. and Biegler, Lorenz T.}, + title = {QPSchur: A dual, active-set, Schur-complement method for large-scale + and structured convex quadratic programming}, + journal = {Optimization and Engineering}, + year = {2006}, + volume = {7}, + pages = {5-32}, + owner = {hans}, + timestamp = {2009.11.09} +} + +@TECHREPORT{beltracchi, + author = {T. J. Beltracchi and G. A. Gabriele}, + title = {{An Investigation of New Methods for Estimating Parameter Sensitivities}}, + institution = {NASA Contractor Report}, + year = {1989}, + number = {4245}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@BOOK{larrybook, + title = {Nonlinear Programming: Concepts, Algorithms, and Applications to + Chemical Processes}, + publisher = {SIAM}, + year = {2010}, + author = {Lorenz T. Biegler}, + owner = {rlopezne}, + timestamp = {2011.02.15} +} + +@ARTICLE{Biegler1992, + author = {Biegler, Lorenz T.}, + title = {Optimization Strategies for Complex Process Models}, + journal = {Advances in Chemical Engineering}, + year = {1992}, + volume = {18}, + pages = {197}, + owner = {hans}, + timestamp = {2009.11.01} +} + +@ARTICLE{Biegler2002, + author = {Lorenz T. Biegler and Arturo M. Cervantes and Andreas Wächter}, + title = {Advances in simultaneous strategies for dynamic process optimization}, + journal = {Chemical Engineering Science}, + year = {2002}, + volume = {57}, + pages = {575 - 593}, + number = {4}, + doi = {DOI: 10.1016/S0009-2509(01)00376-1}, + issn = {0009-2509}, + keywords = {Interior point}, + owner = {hans}, + timestamp = {2009.07.25}, + url = {http://www.sciencedirect.com/science/article/B6TFK-44HTMKP-2/2/1def833c57d912e4aad7027ad582dd2b} +} + +@PHDTHESIS{Diehl2001, + author = {M. Diehl}, + title = {Real-Time Optimization for Large Scale Nonlinear Processes}, + school = {Universit\"at Heidelberg}, + year = {2001}, + note = {http://www.ub.uni-heidelberg.de/archiv/1659/}, + file = {Diehl2001.pdf:Diehl2001.pdf:PDF}, + keywords = {agbock NMPC chemistry multiple shooting optimal control}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@INBOOK{Diehl2007, + chapter = {A Stabilizing Real-Time Implementation of Nonlinear Model Predictive + Control}, + pages = {25-52}, + title = {Real-Time PDE-Constrained Optimization}, + publisher = {SIAM}, + year = {2007}, + editor = {Biegler, Lorenz T. and Keyes, David and Ghattas, Omar and van Bloemen + Waanders, Bart and Heinkenschloss, Mathias}, + author = {Diehl, Moritz and Findeisen, Rolf and Allg\"ower, Frank}, + owner = {hans}, + timestamp = {2009.11.09} +} + +@BOOK{Fiacco1983, + title = {Introduction to Sensitivity and Stability Analysis in Nonlinear Programming}, + publisher = {Academic Press}, + year = {1983}, + author = {Anthony V. Fiacco}, + volume = {165}, + series = {Mathematics in Science and Engineering}, + owner = {hans}, + timestamp = {2009.07.26} +} + +@TECHREPORT{sensumt, + author = {A. V. Fiacco and A. Ghaemi}, + title = {A user's manual for SENSUMT. A penalty function computer program + for solution, sensitivity analysis and optimal bound value calculation + in parametric nonlinear programs}, + institution = {Management Science and Engineering, George Washington University}, + year = {1980}, + number = {T-434}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@ARTICLE{Fiacco90, + author = {A. V. Fiacco and Y. Ishizuka}, + title = {Sensitivity and Stability Analysis for Nonlinear Programming}, + journal = {Annals of Operations Research}, + year = {1990}, + volume = {27}, + pages = {215-236}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@ARTICLE{marlin1, + author = {Forbes, J.F. and T. E. Marlin}, + title = {{Design cost: a systematic approach to technology selection for model-based + real-time optimization systems}}, + journal = {Comput. Chem. Eng.}, + year = {1996}, + volume = {20}, + pages = {717--734}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@ARTICLE{forsgren, + author = {A. Forsgren and P. E. Gill and M. H. Wright}, + title = {Interior Point Methods for Nonlinear Optimization}, + journal = {SIAM Review}, + year = {2002}, + volume = {44}, + pages = {525-597}, + number = {4}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@BOOK{ampl, + title = {AMPL: A Modeling Language for Mathematical Programming}, + publisher = {Duxbury Press}, + year = {2002}, + author = {Fourer, Robert and Gay, David M. and Kernighan, Brian W.}, + address = {Pacific Grove}, + owner = {rlopezne}, + timestamp = {2009.06.12} +} + +@ARTICLE{Ganesh1987, + author = {N. Ganesh and Biegler, Lorenz T.}, + title = {A reduced hessian strategy for sensitivity analysis of optimal flowsheets.}, + journal = {AIChE}, + year = {1987}, + volume = {33}, + pages = {282-296}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@ARTICLE{Hicks1971, + author = {G. A. Hicks and W. H. Ray}, + title = {Approximation methods for optimal control synthesis}, + journal = {The Canadian Journal of Chemical Engineering}, + year = {1971}, + volume = {49}, + pages = {522-528}, + owner = {hans}, + timestamp = {2009.07.25} +} + +@ARTICLE{Huang2009, + author = {Rui Huang and Victor M. Zavala and Lorenz T. Biegler}, + title = {Advanced step nonlinear model predictive control for air separation + units}, + journal = {Journal of Process Control}, + year = {2009}, + volume = {19}, + pages = {678 - 685}, + number = {4}, + doi = {DOI: 10.1016/j.jprocont.2008.07.006}, + issn = {0959-1524}, + keywords = {Air separation units}, + owner = {hans}, + timestamp = {2009.07.22}, + url = {http://www.sciencedirect.com/science/article/B6V4N-4TFH2GW-1/2/061dea994c5a92b4e6dec4029f98c871} +} + +@BOOK{Jongen2000, + title = {Nonlinear Optimization in Finite Dimensions}, + publisher = {Kluwer Academic Publishers}, + year = {2000}, + author = {Jongen, Hubertus T. and Jonker, Peter and Twilt, Frank}, + owner = {hans}, + timestamp = {2010.01.12} +} + +@BOOK{Jongen2004, + title = {Optimization Theory}, + publisher = {Kluwer Academic Publishers}, + year = {2004}, + author = {Jongen, Hubertus T. and Meer, Klaus and Triesch, Eberhard}, + owner = {hans}, + timestamp = {2009.11.02} +} + +@INCOLLECTION{kadam, + author = {J. Kadam and W. Marquardt}, + title = {{Sensitivity-based Solution Updates in Closed-loop Dynamic Optimization}}, + booktitle = {{Proceedings of the DYCOPS 7 Conference}}, + publisher = {Elsevier}, + year = {2004}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@ARTICLE{Kameswaran2008, + author = {Kameswaran, Shivakumar and Biegler, Lorenz T.}, + title = {Convergence rates for direct transcription of optimal control problems + using collocation at Radau points}, + journal = {Comput. Optim. Appl.}, + year = {2008}, + volume = {41}, + pages = {81--126}, + number = {1}, + address = {Norwell, MA, USA}, + doi = {http://dx.doi.org/10.1007/s10589-007-9098-9}, + issn = {0926-6003}, + owner = {rlopezne}, + publisher = {Kluwer Academic Publishers}, + timestamp = {2011.03.29} +} + +@INCOLLECTION{Kojima1980, + author = {M. Kojima}, + title = {{Strongly State Stationary Solutions in Nonlinear Programs}}, + booktitle = {{Analysis and Computation of Fixed Points}}, + publisher = {Academic Press}, + year = {1980}, + editor = {S. M. Robinson}, + address = {New York}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@ARTICLE{Kojima1984, + author = {M. Kojima and R. Hirabayashi}, + title = {Continuous Deformation of Nonlinear Programs}, + journal = {Mathematical Programming Study}, + year = {1984}, + volume = {21}, + pages = {150-198}, + owner = {hans}, + timestamp = {2010.01.12} +} + +@ARTICLE{kyparsis90, + author = {J. Kyparsis}, + title = {Sensitivity Analysis for Nonlinear Programs and Variational Inequalities + with Nonunique Multipliers}, + journal = {Mathematics of Operations Research}, + year = {1990}, + volume = {15}, + pages = {286-298}, + number = {2}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@BOOK{nocedalbook, + title = {Numerical Optimization}, + publisher = {Springer}, + year = {2006}, + author = {Jorge Nocedal and Stephen Wright}, + series = {Operations Research and Financial Engineering}, + address = {New York}, + edition = {2nd}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@BOOK{Nocedal1999, + title = {Numerical Optimization}, + publisher = {Springer}, + year = {1999}, + author = {Nocedal, Jorge and Wright, Steven J.}, + owner = {hans}, + timestamp = {2009.11.02} +} + +@MANUAL{askkt, + title = {\emph{sensKKT} Reference Manual}, + author = {Hans Pirnay and Rodrigo L\'opez-Negrete and Lorenz T. Biegler}, + organization = {Carnegie Mellon University}, + year = {2011}, + owner = {rlopezne}, + timestamp = {2011.03.28} +} + +@UNPUBLISHED{pirnay:2011, + author = {Hans Pirnay and Rodrigo L\'opez-Negrete and Lorenz T. Biegler}, + title = {Optimal Sensitivity Based on IPOPT}, + year = {2011}, + comment = {In preparation}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@ARTICLE{Vassiliadis1994, + author = {Vassiliadis, V. S. and Sargent, R. W. H. and Pantelides, C. C.}, + title = {Solution of a class of multistage dynamic optimization problems. + Part one - Algorithmic Framework}, + journal = {Journal of Industrial and Engineering Chemistry Research}, + year = {1994}, + volume = {33}, + pages = {2115-2123}, + owner = {hans}, + timestamp = {2009.10.28} +} + +@ARTICLE{Vassiliadis1994a, + author = {Vassiliadis, V. S. and Sargent, R. W. H. and Pantelides, C. C.}, + title = {Solution of a class of multistage dynamic optimization problems. + Part two - Problems with Path Constraints}, + journal = {Journal of Industrial and Engineering Chemistry Research}, + year = {1994}, + volume = {33}, + pages = {2123-2133}, + owner = {hans}, + timestamp = {2009.10.28} +} + +@ARTICLE{Waechter2006, + author = {W\"achter, Andreas and Biegler, Lorenz T.}, + title = {On the Implementation of a Primal-Dual Interior Point Filter Line + Search Algorithm for Large-Scale Nonlinear Programming}, + journal = {Mathematical Programming}, + year = {2006}, + volume = {106(1)}, + pages = {25-57}, + owner = {hans}, + timestamp = {2009.08.03} +} + +@ARTICLE{wolbert, + author = {Wolbert, D. and X. Joulia and B. Koehret and L. T. Biegler}, + title = {{Flowsheet Optimization and Optimal Sensitivity Analysis Using Exact + Derivatives}}, + journal = {Computers and Chemical Engineering}, + year = {1994}, + volume = {18}, + pages = {1083}, + owner = {rlopezne}, + timestamp = {2011.03.29} +} + +@PHDTHESIS{ZavalaPhd, + author = {Zavala, Victor M.}, + title = {Computational Strategies for the Operation of Large-Scale Chemical + Processes}, + school = {Carnegie Mellon University}, + year = {2008}, + owner = {hans}, + timestamp = {2009.07.28} +} + +@ARTICLE{Zavala2009, + author = {Victor M. Zavala and Lorenz T. Biegler}, + title = {The advanced-step NMPC controller: Optimality, stability and robustness}, + journal = {Automatica}, + year = {2009}, + volume = {45}, + pages = {86 - 93}, + number = {1}, + doi = {DOI: 10.1016/j.automatica.2008.06.011}, + issn = {0005-1098}, + keywords = {Nonlinear model predictive control}, + owner = {hans}, + timestamp = {2009.07.22}, + url = {http://www.sciencedirect.com/science/article/B6V21-4V28T0V-6/2/2f93266b2f0847c9a00bd59bf4788157} +} + +@ARTICLE{Zavala2008, + author = {Zavala, Victor M. and Laird, Carl D. and Biegler, Lorenz T.}, + title = {{Fast implementations and rigorous models: Can both be accomodated + in NMPC?}}, + journal = {International Journal of Robust Nonlinear Control}, + year = {2008}, + volume = {18}, + pages = {800-815}, + owner = {hans}, + timestamp = {2009.07.22} +} + +@ARTICLE{Zavala2008a, + author = {Victor M. Zavala and Carl D. Laird and Lorenz T. Biegler}, + title = {A fast moving horizon estimation algorithm based on nonlinear programming + sensitivity}, + journal = {Journal of Process Control}, + year = {2008}, + volume = {18}, + pages = {876 - 884}, + number = {9}, + note = {Selected Papers From Two Joint Conferences: 8th International Symposium + on Dynamics and Control of Process Systems and the 10th Conference + Applications in Biotechnology, 8th International Symposium on Dynamics + and Control of Process Systems and the 10th Conference Applications + in Biotechnology}, + doi = {DOI: 10.1016/j.jprocont.2008.06.003}, + issn = {0959-1524}, + keywords = {Estimation algorithms}, + owner = {hans}, + timestamp = {2009.07.22}, + url = {http://www.sciencedirect.com/science/article/B6V4N-4T1X2DR-2/2/816f809d57e3f6e00359b4163849b4b4} +} + +@PROCEEDINGS{Bock1983, + title = {Numerical Treatment of Inverse Problems in Differential and Integral + Equations: Proceedings of an International Workshop}, + year = {1983}, + editor = {Bock, H. G.}, + owner = {hans}, + timestamp = {2009.10.29} +} + +@comment{jabref-meta: selector_publisher:} + +@comment{jabref-meta: selector_author:} + +@comment{jabref-meta: selector_journal:} + +@comment{jabref-meta: selector_keywords:} + diff --git a/Ipopt-3.13.4/contrib/sIPOPT/doc/sipopt_manual.pdf b/Ipopt-3.13.4/contrib/sIPOPT/doc/sipopt_manual.pdf new file mode 100644 index 000000000..cc160e496 Binary files /dev/null and b/Ipopt-3.13.4/contrib/sIPOPT/doc/sipopt_manual.pdf differ diff --git a/Ipopt-3.13.4/contrib/sIPOPT/doc/sipopt_manual.tex b/Ipopt-3.13.4/contrib/sIPOPT/doc/sipopt_manual.tex new file mode 100644 index 000000000..c559815da --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/doc/sipopt_manual.tex @@ -0,0 +1,932 @@ +\documentclass[letter, 11pt]{article} +% \usepackage[utf8]{inputenc} +\usepackage{amsmath} +\usepackage{amsfonts} +\usepackage{amssymb} +\usepackage{graphicx} +\usepackage[listofformat=subparens]{subfig} +\usepackage{setspace} +\usepackage{theorem} + +\usepackage{palatino} + + +% Bibliography related +\def\BIBand{and} + +\usepackage[numbers,sort]{natbib} +%\bibliographystyle{achemso} +\bibliographystyle{iecrv5} +\usepackage{natmove} + +\usepackage[top=3cm,bottom=3cm,left=1.8cm,right=1.8cm,centering]{geometry} % proposal + +\newcommand{\RR}{{\mathbb{R}}} +\newcommand{\vect}[1]{{\left[\begin{array}{c} #1 \end{array}\right]}} +\newcommand{\matr}[2]{{\left[\begin{array}{#1} #2 \end{array}\right]}} + +\newtheorem{property}{Property} +\newtheorem{definition}{Definition} +\usepackage{setspace} + +\usepackage{listings} +\renewcommand{\lstlistingname}{Code Listing} +\lstset{aboveskip=22pt,belowskip=22pt} + +\usepackage{array,multirow} + +\newcommand{\sensKKT}{\emph{sIPOPT}} +\newcommand{\AMPL}{AMPL} + +% Citation related +\newcommand{\citetcomma}[1]{\citeauthor{#1},\cite{#1}\ } +\newcommand{\citetperiod}[1]{\citeauthor{#1}.\cite{#1}\ } +\newcommand{\citetfcomma}[1]{\citeauthor{#1}.\cite{#1}\ } + + +\newcommand{\parens}[1]{\ensuremath{\left( #1 \right)}} +\newcommand{\bracs}[1]{\ensuremath{\left[ #1 \right]}} +\newcommand{\curls}[1]{\ensuremath{\left\{ #1 \right\}}} +\newcommand{\bars}[1]{\ensuremath{\left\| #1 \right\|}} + +\newcommand{\func}[2]{\ensuremath{ #1\parens{#2} }} +\newcommand{\norms}[2]{\ensuremath{ \bars{#1}_{#2} }} + +\newcommand{\expect}[1]{\ensuremath{\mathbb{E}\bracs{#1}}} +\newcommand{\expectc}[1]{\ensuremath{\mathbb{E}\curls{#1}}} + + +% Folders and directories +\newcommand{\ipoptf}{\$IPOPT} + + +%\newcommand{\sensdir}{AsNMPC} +%\newcommand{\sensexe}{ampl\_asnmpc} +%\newcommand{\senslib}{libasnmpc} +\newcommand{\sensdir}{sIPOPT} +\newcommand{\sensexe}{ipopt\_sens} +\newcommand{\senslib}{libsipopt} + + + +% options and suffixes +%\newcommand{\runaskkt}{run\_nmpc} +%\newcommand{\statez}{nmpc\_state\_0} +%\newcommand{\stateo}{nmpc\_state\_1} +%\newcommand{\statevo}{nmpc\_state\_value\_1} +%\newcommand{\initc}{nmpc\_init\_constr} +% +%\newcommand{\sstateo}{nmpc\_sol\_state\_1} +%\newcommand{\sstatezl}{nmpc\_sol\_state\_1\_z\_L} +%\newcommand{\sstatezu}{nmpc\_sol\_state\_1\_z\_U} +% +%\newcommand{\redhessopt}{compute\_red\_hessian} +%\newcommand{\redhess}{red\_hessian} +% +%\newcommand{\selectstep}{select\_step} +% +%\newcommand{\nstepsopt}{n\_nmpc\_steps} +%\newcommand{\boundcheckopt}{nmpc\_boundcheck} +%\newcommand{\boundepsopt}{nmpc\_bound\_eps} +%\newcommand{\maxpdpertopt}{nmpc\_max\_pdpert} +%\newcommand{\eigendecompopt}{rh\_eigendecomp} + +\newcommand{\runaskkt}{run\_sens} +\newcommand{\statez}{sens\_state\_0} +\newcommand{\stateo}{sens\_state\_1} +\newcommand{\statevo}{sens\_state\_value\_1} +\newcommand{\initc}{sens\_init\_constr} + +\newcommand{\sstateo}{sens\_sol\_state\_1} +\newcommand{\sstatezl}{sens\_sol\_state\_1\_z\_L} +\newcommand{\sstatezu}{sens\_sol\_state\_1\_z\_U} + +\newcommand{\statei}[1]{sens\_state\_#1} +\newcommand{\statevi}[1]{sens\_state\_value\_#1} + +\newcommand{\sstatei}[1]{sens\_sol\_state\_#1} +\newcommand{\sstatezli}[1]{sens\_sol\_state\_#1\_z\_L} +\newcommand{\sstatezui}[1]{sens\_sol\_state\_#1\_z\_U} + +\newcommand{\redhessopt}{compute\_red\_hessian} +\newcommand{\redhess}{red\_hessian} + +\newcommand{\selectstep}{select\_step} + +\newcommand{\nstepsopt}{n\_sens\_steps} +\newcommand{\boundcheckopt}{sens\_boundcheck} +\newcommand{\boundepsopt}{sens\_bound\_eps} +\newcommand{\maxpdpertopt}{sens\_max\_pdpert} +\newcommand{\eigendecompopt}{rh\_eigendecomp} +\newcommand{\senskktresiduals}{sens\_kkt\_residuals} +\newcommand{\allowinex}{sens\_allow\_inexact\_backsolve} + + + +% Define ampl language for listings +\lstdefinelanguage{ampl} { + alsoletter={.,:, >, <, =}, + morekeywords={param, var, minimize, maximize, let, solve, display, printf, + suffix, reset, subject, to, options, option, =,:=, >=, <=, s.t., + IN, OUT}, + sensitive=false, + morecomment=[l]{\#}, + morecomment=[s]{/*}{*/} +} + + +\title{ \sensKKT\ Reference Manual} +\author{Hans Pirnay, Rodrigo L\'opez-Negrete, and + Lorenz T. Biegler \\ +Chemical Engineering Department \\ +Carnegie Mellon University \\ +Pittsburgh, PA 15213} + +\begin{document} +\maketitle +\tableofcontents +%\newpage + +\section{Introduction} +\onehalfspacing + +Sensitivity of nonlinear programming problems is a key +step in any optimization study. Sensitivity provides +information on regularity and curvature conditions at KKT points, +assesses which variables play dominant roles in the optimization, and +provides first order estimates for parametric nonlinear programs. +Moreover, for NLP algorithms that use exact second derivatives, +sensitivity can be implemented very efficiently within NLP solvers and +provide valuable information with very little added computation. This +implementation provides IPOPT with the capabilities to calculate +sensitivities, and approximate perturbed solutions with them. + +The basic sensitivity strategy implemented here is based on the +application of the Implicit Function Theorem (IFT) to the KKT conditions +of the NLP. As shown in \citet{Fiacco1983}, +sensitivities can be obtained from a solution with suitable regularity +conditions merely by solving a linearization of the KKT +conditions. In \citet{pirnay:2011} we have extended these results to +the barrier penalty method implemented in IPOPT. In the following subsections +we have summarized the main concepts in the paper. + +\subsection{Barrier Sensitivity} \label{sec:barrier} + +Consider the parametric nonlinear program of the form: + +\begin{subequations} \label{NLPsens} + \begin{eqnarray} + &\min_x & f(x; p) \\ + &\mbox{s.t.} & c(x; p) = 0, x \geq 0 + \end{eqnarray} +\end{subequations} + +\noindent with the vectors $x \in \mathbb{R}^{n_x}$, $p \in \mathbb{R}^{n_p}$, +and $c(x; p): \mathbb{R}^{n_x+n_p} \to \mathbb{R}^{m}$. Without loss of generality, +only the variables $x$ have been assumed zero or positive. However, +the following derivations can be extended to the case where there are both +upper and lower bounds. + +The IPOPT NLP algorithm substitutes a barrier function for the inequality +constraints and solves the following sequence of problems with +$\mu \rightarrow 0$: + +\begin{subequations} +\label{IPNLP2} +\begin{eqnarray} +& \min_x & \; \; B(x; p, \mu) = f(x; p) - \mu_{\ell} \sum_{i=1}^{n_x} ln (x_i) \\ +& \mbox{s.t.} & c(x; p) = 0 +\end{eqnarray} +\end{subequations} + +At a solution with $p = p_0$ (the nominal value) we compute the +sensitivities $\frac{d x^{*}(p_0)}{dp}$ and $\frac{df(x^*; p_0)}{d p} = +\frac{\partial f(x^*; p_0)}{\partial p} + \frac{d x(p_0)}{d p}\frac{\partial f(x^*; p_0)}{\partial x}$. To +calculate these sensitivities, we first +consider properties of the solutions of (\ref{NLPsens}) obtained by +IPOPT when $p = p_0$ \cite{Fiacco1983,forsgren}. + + +For NLP (\ref{NLPsens}), the Karush-Kuhn-Tucker (KKT) conditions +are defined as: + +\begin{subequations}\label{kktc} +\begin{eqnarray} +& \nabla_x L(x^*, \lambda^*, \nu^*; p_0) = +\nabla_x f(x^*; p_0) + \nabla_x c(x^*; p_0)\lambda^* - \nu^* = 0 \\ +& c(x^*; p_0) = 0 \\ +& 0 \leq \nu^* \perp x^* \geq 0 +\end{eqnarray} +\end{subequations} + +For the KKT conditions to serve as necessary conditions for a local +minimum of (\ref{NLPsens}), constraint qualifications are needed, +such as Linear Independence Constraint Qualification (LICQ) +or Mangasarian-Fromowitz Constraint Qualification (MFCQ). +Definitions of these regularity conditions may be found in \citet{larrybook}, +\citet{nocedalbook}, or \citet{Fiacco1983}. + + +Calculation of the sensitivity of the primal and dual variables with +respect to $p$ now proceeds from the implicit function theorem (IFT) +applied to the optimality conditions of (\ref{IPNLP2}) at +$p_0$. Defining the quantities: + +\begin{equation} \label{mdef} + M(s(\mu; p_0)) = + \matr{ccc}{ + \func{W}{\func{s}{\mu;p_0}} & \func{A}{\func{x}{\mu;p_0}} & -I\\ + \func{A}{\func{x}{\mu;p_0}} ^T &0 &0\\ \func{V}{\mu;p_0} &0&X(\mu; p_0)} +\end{equation} + +\noindent and + +\begin{equation} \label{ndef} +N_p(s(\mu; p_0)) = +\vect{\nabla_{xp} L(s(\mu; p_0)) \\ \nabla_p c(x(\mu; p_0))\\ 0}, \quad +N_{\mu} = \vect{0 \\ 0 \\ -\mu e} +\end{equation} + +\noindent where $W(s(\mu; p_0))$ denotes the Hessian $\nabla_{xx} L(x +,\lambda, \nu)$ of the Lagrangian function evaluated at $s(\mu; p_0)$, +$A(x(\mu; p_0)) = \nabla_{x} c(x)$ evaluated at $x(\mu; p_0)$, $X = +diag\{x\}$ and $V = diag\{\nu\}$, application of IFT leads to: + +\begin{equation}\label{sensfiacco} +M(s(\mu; p_0)) \frac{d s(\mu; p_0)}{d p}^T + N_p(s(\mu; p_0)) = 0. +\end{equation} + +When LICQ, Strict Complementarity (SC), and SSOSC +hold, $M(s(\mu; p_0))$ is nonsingular and +the sensitivities can be calculated from: + +\begin{equation} \label{sens:1} +\frac{d s(\mu; p_0)}{d p}^T = - \func{M}{\func{s}{\mu; p_0}}^{-1} \func{N_p}{ \func{s}{\mu; p_0} } . +\end{equation} + +We note that at the solution of (\ref{IPNLP2}) these assumptions can +be checked by the inertia of $M$ as well as other information in IPOPT +(see \cite{Waechter2006}). Moreover, in IPOPT, $M(s(\mu; p_0))$ is directly +available in factored form from the solution of (\ref{IPNLP2}), so the +sensitivity can be calculated through a simple backsolve. For small +values of $\mu$ and $\|p-p_0\|$ it can be shown from the above properties +\cite{Fiacco1983} that + +\begin{equation} \label{init1} +s(\mu; p) = s(\mu; p_0) - M(s(\mu; p_0))^{-1}N_p(s(\mu; p_0)) (p-p_0) + +o\|p-p_0\| . %= s(0; p) + O(\mu). +\end{equation} + +%\noindent or +% +%\begin{equation} \label{init2} +%s(0; p) = s(\mu; p_0) - M(s(\mu; p_0))^{-1} \bracs{ N_p(s(\mu; p_0))(p-p_0) + N_{\mu}(s(\mu; p_0)) } + o\|p-p_0\| + o\| \mu \|. +%\end{equation} + + +Finally, in the way IPOPT is implemented, it cannot distinguish between +variables and parameters. Thus we can make this distinction apparent by +adding some artificial variables and constraints. In this way we write: + +\begin{subequations} \label{NLPsens2} +\begin{eqnarray} +& \min_{x, w} & f(x, w) \\ +& \mbox{s.t.} & c(x, w) = 0, x \geq 0 \\ +& & w - p_0 = 0 +\end{eqnarray} +\end{subequations} + +Note that the NLP solution is equivalent to (\ref{NLPsens}), and +it is easy to see that the NLP sensitivity is equivalent as well. +Writing the KKT conditions for (\ref{NLPsens2}) leads to: + +\begin{subequations}\label{eq:reform} +\begin{eqnarray} +& \nabla_x f(x, w) + \nabla_x c^T(x, w)\lambda -\nu = 0\\ +& \nabla_w f(x, w) + \nabla_w c^T(x, w)\lambda + \bar{\lambda} = 0\\ +& c(x) = 0 \\ & XVe =0 \\ & w - p = 0 +\end{eqnarray} +\end{subequations} + +In this definition $\bar{\lambda}$ represents the Lagrange multiplier +corresponding to the equation $w - p =0$. For the Newton step we write: + +\begin{equation} + \label{eq:reordered_K_3} + \left[ + \begin{array}{ccccc} + W& \nabla_{xw} L(x, w, \lambda, \nu) & A & -I & 0 \\ + \nabla_{wx} L(x, w, \lambda, \nu) & \nabla_{ww} L(x, w, \lambda, \nu) + & \nabla_w c(x, w) & 0 & I \\ + A^T& \nabla_w c(x, w)^T & 0 & 0 & 0 \\ + V &0&0& X & 0 \\ + 0 & I &0&0&0\\ + \end{array} + \right] + \left[ + \begin{array}{c} + \Delta z\\ \Delta w \\ \Delta \lambda\\\Delta\nu\\ \Delta\bar{\lambda} + \end{array} + \right] + = + \left[ + \begin{array}{c} + 0 \\0 \\ 0 \\ 0 \\ \Delta p + \end{array} \right]. +\end{equation} + +Since $\Delta w = \Delta p$, the step computed by this matrix (without +the second row) is the same as the optimal step stated in +(\ref{sensfiacco}). + + +\subsection{Multiple Sequential Parameter Perturbations} \label{sec:multirhs} + + +In the derivations in the previous sections we considered changes to the parameter vector. +However, in some cases we may be interested in making multiple parameter perturbations in a sequential manner. +For example we may want to perturb the current solution {\func{s}{\mu; p_0}} using the parameter vectors +$p_1, \ldots, p_{n_{\mbox{\tiny pert}}}$. This amounts to solving system \eqref{sensfiacco} with different right hand sides +{\func{N_p}{\func{s}{\mu;p_0}}} (Eq. \eqref{ndef}). Note that, because we already have \eqref{mdef} +factorized at the solution, it is very +cheap to obtain the $n_{\mbox{\tiny pert}}$ sensitivities. With them and using Equation \eqref{init1} +we can determine the approximated solutions {\func{s}{\mu; p_1}}, \ldots, {\func{s}{\mu; p_{n_{\mbox{\tiny pert}}}}}. + + +\section{Usage} + +In the following sections we describe how the \sensKKT\ library can be used through the \AMPL\ interface. +However, we also provide examples for the C++ interface in the examples folder of the distribution. +To help illustrate the use of \sensKKT\ the following NLP, taken from \cite{Ganesh1987}, will be used: + +\begin{eqnarray} \label{eq:ex1} + \min&& x_1^2+x_2^2+x_3^2\\ + \mathrm{s.t.}&&6x_1+3x_2+2x_3-p_1 = 0\nonumber\\ + &&p_2x_1+x_2-x_3-1 = 0\nonumber\\ + &&x_1,x_2,x_3\geq 0 , \nonumber +\end{eqnarray} + +\noindent with variables $x_1,x_2$, and $x_3$ and parameters $p_1$, and $p_2$. +Since IPOPT does not distinguish variables from parameters, we reformulate +the NLP as \eqref{NLPsens2} by introducing equations +that fix the parameters $p_1$ and $p_2$ to their nominal values +$p_{1,a}$ and $p_{2,a}$. + +\begin{subequations}\label{eq:exr} +\begin{eqnarray} + \min&& x_1^2+x_2^2+x_3^2\\ + \mathrm{s.t.}&&6x_1+3x_2+2x_3-p_1 = 0\\ + &&p_2x_1+x_2-x_3-1 = 0\\ + &&p_1 = p_{1,a}\\ + &&p_2 = p_{2,a}\\ + &&x_1,x_2,x_3\geq 0. +\end{eqnarray} +\end{subequations} + +For \eqref{eq:exr}, the KKT conditions are: + +\begin{eqnarray} \label{eq:exr:kkt} + 2x_1+6\lambda_1+p_2\lambda_2-\nu_1 &=& 0\\ + 2x_2+3\lambda_1+\lambda_2-\nu_2&=& 0\\ + 2x_3+2\lambda_1-\lambda_2-\nu_3 &=&0\\ + -\lambda_1+\lambda_3&=&0\\ + \lambda_2x_1+\lambda_4&=&0\\ + 6x_1+3x_2+2x_3-p_1 &=&0\\ + p_2x_1+x_2-x_3-1 &=&0\\ + p_1-p_{1,a}&=&0\\ + p_2-p_{2,a}&=&0\\ + \nu_1x_1-\mu &=& 0\\ + \nu_2x_2-\mu&=& 0\\ + \nu_3x_3-\mu&=& 0\\ + x_1,x_2,x_3,\nu_1,\nu_2,\nu_3&\geq& 0, +\end{eqnarray} + +\noindent and the corresponding Newton step is + +\begin{equation} \label{eq:exr:newton} + \left[ + \begin{array}{cccccccccccc} + 2&&&&\lambda_2&6&p_2&&&-1\\ + &2&&&&3&1&&&&-1\\ + &&2&&&2&-1&&&&&-1\\ + &&&&&-1&&1\\ + \lambda_2&&&&&&x_1&&1\\ + 6&3&2&-1\\ + p_2&1&-1&&x_1\\ + &&&1\\ + &&&&1\\ + \nu_1&&&&&&&&&x_1\\ + &\nu_2&&&&&&&&&x_2\\ + &&\nu_3&&&&&&&&&x_3 + \end{array} + \right] + \left[ + \begin{array}{c} + \Delta x_1\\ + \Delta x_2\\ + \Delta x_3\\ + \Delta p_1\\ + \Delta p_2\\ + \Delta \lambda_1\\ + \Delta \lambda_2\\ + \Delta \lambda_3\\ + \Delta \lambda_4\\ + \Delta \nu_1\\ + \Delta \nu_2\\ + \Delta \nu_3\\ + \end{array} + \right] + =- + \left[ + \begin{array}{c} + 2x^{*}_1+6\lambda^{*}_1+p_2\lambda^{*}_2-\nu^{*}_1\\ + 2x^{*}_2+3\lambda^{*}_1+\lambda^{*}_2-\nu^{*}_2\\ + 2x^{*}_3+2\lambda^{*}_1-\lambda^{*}_2-\nu^{*}_3\\ + -\lambda^{*}_1+\lambda^{*}_3\\ + \lambda^{*}_2x^{*}_1+\lambda^{*}_4\\ + 6x^{*}_1+3x^{*}_2+2x^{*}_3-p^{*}_1\\ + p^{*}_2x^{*}_1+x^{*}_2-x^{*}_3-1\\ + p^{*}_1-p_{1,a}\\ + p^{*}_2-p_{2,a}\\ + \nu^{*}_1x^{*}_1-\mu\\ + \nu^{*}_2x^{*}_2-\mu\\ + \nu^{*}_3x^{*}_3-\mu\\ + \end{array} + \right] +\end{equation} + +\noindent where the right hand side is zero at the solution. + +\subsection{\AMPL\ Interface} + +In this section we will show how to use \sensKKT\ through the \AMPL\ interface \cite{ampl}. This is the preferred method for using IPOPT, +because this allows us to take advantage of the exact first and second order derivatives provided by the modeling language. +The first thing to do is to write the problem in the \AMPL\ language as shown in code listing \ref{ampl:ex1}. + +%\begin{minipage}{0.9\textwidth}\centering +\begin{lstlisting}[language=ampl, caption={\AMPL\ code for Problem \ref{eq:exr}.}, label={ampl:ex1}, frame=single, captionpos=b] +reset ; + +# Define parameters +param et1p ; +param et2p ; + +# Original parameter values +let et1p := 5 ; +let et2p := 1 ; + +# Define variables, with bounds and initial guess +var x1 >= 0, := 0.15 ; +var x2 >= 0, := 0.15 ; +var x3 >= 0, := 0.00 ; + +# objective function +minimize objf: x1^2 + x2^2 + x3^2 ; + +# constraints +subject to + +r1: 6*x1 + 3*x2 + 2*x3 - et1p = 0 ; +r2: et2p*x1 + x2 - x3 - 1 = 0 ; + +# Define solver and Ampl options in this case we don't want Ampl's +# presolve to accidentally remove artificial variables. +options solver ipopt_sens ; +option presolve 0 ; + +# Solve problem +solve ; +\end{lstlisting} +%\end{minipage} + + +We can now proceed to modify the above code to add the information needed to use \sensKKT. +For this we need to create the following suffixes. These will be used to communicate the nominal and perturbed values of the +parameters, and also some will serve as flags to indicate to IPOPT which are the artificial constraints that were added. + + +\begin{description} +\item[\statez] This is used to enumerate the parameters that will be perturbed. It takes values from 1 to length($p$), and + the values may not be repeated. Note that the order of the values is crucial. +\item[\stateo] This is similar to \textbf{\statez}, but it now indicates the order for the parameters at the perturbed value. + This suffix should have the same values as \textbf{\statez}. It takes values from 1 to length($p$), and + the values may not be repeated. +\item[\statevo] This is used to communicate the values of the perturbed parameters. + It has to be set for the same variables as \textbf{\stateo}. +\item[\initc] This is a flag that indicates the constraint is artificial, e.g., $w - p_0=0$ in Problem \eqref{eq:reform}. + If the constraint is artificial, set this suffix to 1 (no indexing is necessary). +\end{description} + +Once these suffixes have been set, we must enable \sensKKT\ by setting the \emph{\runaskkt} to `\emph{yes}'. Note that +this option can alternatively be set in the ipopt.opt file. In addition, to ensure that +\AMPL's presolve feature does not eliminate the initial value constraints, we disable it. Thus, the modified code is + +\begin{lstlisting}[language=ampl, caption={\AMPL\ code for sensitivity update of Problem \ref{eq:exr}.}, label={ampl:ex2}, frame=single, captionpos=b] +reset ; + +# Suffixes for sensitivity update +suffix sens_state_0, IN; +suffix sens_state_1, IN; +suffix sens_state_value_1, IN; +suffix sens_sol_state_1, OUT; +suffix sens_init_constr, IN; + +# Original value of parameters +param et1p ; +param et2p ; + +# Original parameter values +let et1p := 5 ; +let et2p := 1 ; + +# Define variables, with bounds and initial guess +var x1 >= 0, := 0.15 ; +var x2 >= 0, := 0.15 ; +var x3 >= 0, := 0.00 ; + +# Artificial variables so IPOPT sees the parameters +var et1 ; +var et2 ; + +# objective function +minimize objf: x1^2 + x2^2 + x3^2 ; + +# constraints +subject to + +r1: 6*x1 + 3*x2 + 2*x3 - et1 = 0 ; +r2: et2*x1 + x2 - x3 - 1 = 0 ; + +# Artificial constraints to pass parameters to IPOPT +r3: et1 = et1p ; +r4: et2 = et2p ; + +# Define solver and Ampl options in this case we don't want Ampl's +# presolve to accidentally remove artificial variables. +options solver ipopt_sens ; +option presolve 0; + +# define an order to the parameters that will change. +# In step 0, only et1 changes, and has position 1 +let et1.sens_state_0 := 1 ; + +# in the first step/change et1 has position 1 +let et1.sens_state_1 := 1 ; + +# Perturbed value of parameter et1 (in step 1) +let et1.sens_state_value_1 := 4.5 ; + +# In step 0, et2 has position 1 +let et2.sens_state_0 := 2 ; + +# in the first step/change et1 has position 2 +let et2.sens_state_1 := 2 ; + +# Perturbed value of parameter et2 (in step 1) +let et2.sens_state_value_1 := 1 ; + +# Artificial constraints +let r3.sens_init_constr := 1 ; +let r4.sens_init_constr := 1 ; + +# solve problem +solve ; +\end{lstlisting} + + + +After the algorithm has completed successfully, the perturbed solution is stored in the following \AMPL\ suffixes: + +\begin{description} +\item[\sstateo] This holds the updated variables as well as the updated constraint multiplier + values computed in the sensitivity update. +\item[\sstatezl] This suffix holds updated lower bound multipliers. +\item[\sstatezu] This suffix holds updated upper bound multipliers. +\end{description} + +For example we could append the following code to Listing \ref{ampl:ex2} in order to print both the nominal +solution, as well as the updated values. + +% +\begin{lstlisting}[language=ampl, frame=single, captionpos=b,caption={\AMPL\ code to print updated solution.}, label={ampl:ex3}] +#********************************************** +# Print nominal solution and bound multipliers +#********************************************** +display x1, x2, x3, et1, et2 ; +display x1.ipopt_zU_out, x2.ipopt_zU_out, x3.ipopt_zU_out, + et1.ipopt_zU_out, et2.ipopt_zU_out ; + +display x1.ipopt_zL_out, x2.ipopt_zL_out, x3.ipopt_zL_out, + et1.ipopt_zL_out, et2.ipopt_zL_out ; + +# Constraint multipliers +display r1, r2, r3, r4 ; + +#************************ +# Print updated solution +#************************ +display x1.sens_sol_state_1, x2.sens_sol_state_1, + x3.sens_sol_state_1, et1.sens_sol_state_1, + et2.sens_sol_state_1 ; + +display x1.sens_sol_state_1_z_U, x2.sens_sol_state_1_z_U, + x3.sens_sol_state_1_z_U, + et1.sens_sol_state_1_z_U, et2.sens_sol_state_1_z_U ; + +display x1.sens_sol_state_1_z_L, x2.sens_sol_state_1_z_L, + x3.sens_sol_state_1_z_L, + et1.sens_sol_state_1_z_L, et2.sens_sol_state_1_z_L ; + +# and updated constraint multipliers +display r1.sens_sol_state_1, r2.sens_sol_state_1, + r3.sens_sol_state_1, r4.sens_sol_state_1 ; +\end{lstlisting} + + +An example implementation of the above is provided in the directory: + +\begin{description} +\item {\tt \ipoptf/Ipopt/contrib/\sensdir/examples/parametric\_ampl}. +\end{description} + +%\subsection{C++ Interface} + +\section{Reduced Hessian} + +An important byproduct of the sensitivity calculation is information +related to the Hessian of the Lagrange function pertinent to the +second order conditions. At the solution of (\ref{NLPsens}) we again +consider the sensitivity system, $M S = N_{rh}$, and partition the +variables into free and bounded variables, i.e., $x^* = [x_f^T \; x_b^T]$ where $x^*_f > 0, +x^*_b = 0$. Assuming strict complementarity (SC), the IFT sensitivity +system using (\ref{mdef}) can be partitioned with: + +\begin{equation} +M = \matr{ccccc}{W_{ff}(x^*,\lambda^*) & W_{fb}(x^*,\lambda^*) & A_f(x^*) & -I_f & 0 \\ +W_{bf}(x^*,\lambda^*) & W_{bb}(x^*,\lambda^*) & A_b(x^*) & 0 & -I_b \\ +A_f(x^*)^T & A_b(x^*))^T &0 &0 & 0\\ +0 & 0 & 0 &X_f^* & 0 \\ +0 & V_b^*& 0 & 0 & 0}, +S = \vect{S_{x_f} \\ S_{x_b} \\ S_{\lambda} \\ S_{\nu_f} \\ S_{\nu_b}}, +\mbox{ and } +N_{rh} = \vect{E \\ 0 \\ 0 \\ 0 \\ 0} \label{matdef} +\end{equation} + +%\noindent where $E$ is defined below. +From (\ref{matdef}) it is easy to see that $S_{x_b} = 0, S_{\nu_f} += 0$. These variables and the last two rows can therefore be removed, +leading to: + +\begin{equation*} +\matr{ccc}{W_{ff}(x^*,\lambda^*) & A_f(x^*) & 0 \\ +A_f(x^*))^T &0 & 0\\ +W_{bf}(x^*,\lambda^*) & A_b(x^*) & -I_b} +\vect{S_{x_f} \\ S_{\lambda} \\ S_{\nu_b}} += \vect{E \\ 0 \\ 0} +\end{equation*} + +For a chosen set of $n_I \leq n_x - +m$ independent variables with elements reordered at the end of the +$x$ vector, $A_D$ nonsingular, $E^T = [0 \;|\: I_{n_I}]$ +and the matrices defined in (\ref{matdef}), the reduced Hessian can be +found directly by solving $M S = N_{rh}$. As described in \cite{pirnay:2011}, +the reduced Hessian can be +extracted easily from the rows of $S$. Thus taking advantage of the +implementation described in Section \ref{sec:barrier} for sensitivity +based updates, we can obtain an approximation of the reduced Hessian +via backsolves involving the factorized KKT matrix. + +\section{Usage} + +In the following sections we describe the usage of the reduced Hessian +calculator using the \AMPL. We also provide examples of +the C++ interface in the examples folder. + + +\subsection{\AMPL\ Interface} + +The usage of the reduced Hessian calculation is similar to the sensitivity updates described above. +The critical step here is deciding which variables will be independent variables at the optimal solution. +Theses independent variables are then identified with the suffix \textbf{\redhess}. + +This suffix provides an enumeration of the independent variables, thus it needs to take ordered values from +$1..n_I$, where $n_I$ is the number of independent variables. The columns of the inverse reduced Hessian will be printed to +the screen, and their order is determined by the ordering of these indices. + +To enable reduced Hessian calculations we need to set the option +The algorithm is enabled by setting the solver option \emph{\redhessopt} to `\emph{yes}'. +Using Example 1 defined by Problem \eqref{eq:ex1}, we illustrate the use of the +reduced Hessian calculator. The code for this is shown in Listing \ref{ampl:exrh}. +In addition, the calculated reduced Hessian is displayed on the screen automatically +at the end of IPOPT's normal output. + + +\begin{lstlisting}[language=ampl, caption={\AMPL\ code for Problem \ref{eq:exr}.}, label={ampl:exrh}, frame=single, captionpos=b] +reset ; + +# Define reduced Hessian suffixes +suffix red_hessian, IN ; + +# Define parameters +param et1 ; +param et2 ; + +# Parameter values +let et1p := 5 ; +let et2p := 1 ; + +# Define variables, with bounds and initial guess +var x1 >= 0, := 0.15 ; +var x2 >= 0, := 0.15 ; +var x3 >= 0, := 0.00 ; + +# objective function +minimize objf: x1^2 + x2^2 + x3^2 ; + +# constraints +subject to + +r1: 6*x1 + 3*x2 + 2*x3 - et1p = 0 ; +r2: et2p*x1 + x2 - x3 - 1 = 0 ; + +# Define solver and Ampl options in this case we don't want Ampl's +# presolve to accidentally remove artificial variables. +options solver ipopt_sens ; +option presolve 0 ; + +# Define free variables +let x3.red_hess := 1 ; + +# Solve problem +solve ; +\end{lstlisting} + + + + +\section{C++ Interface} + +The C++ interface is very simple to apply to an existing {\tt Ipopt::TNLP} implementation. +The member function {\tt TNLP::::get\_var\_con\_metadata} in Ipopt provides a feature very +similar to that of \AMPL\ suffixes. + +The steps taken to make a TNLP class ready for using the \sensKKT\ code are similar to those used in \AMPL. +First, the parameter values are defined with artificial variables and constraints. Note that +because of this the Jacobian and Hessian computations have to be adjusted accordingly. Finally, +the suffixes need to be set the same way they would in \AMPL\ as described above. +This is done using member function {\tt TNLP::::get\_var\_con\_metadata}. +This is illustrated in examples \texttt{examples/redhess\_cpp} and \\ +\texttt{examples/parametric\_cpp}. + +\section{Installation} + +The first step to install the software is to install the \emph{trunk} version of IPOPT, once this is done +installing \sensKKT\ is very simple. IPOPT's installation instructions can be +found in the following website. + +\begin{description} +\item \texttt{https://coin-or.github.io/Ipopt/} +\end{description} + +Also note that in the following we refer to {\tt \ipoptf} as the main folder, +where the Ipopt, ThirdParty, BuildTools, \ldots, +folders are located. If you wish to use the \AMPL\ interface, make sure that your IPOPT +installation also includes it. To +do this you need to download the ASL library, with the {\tt get.ASL} +script located in {\tt \ipoptf/ThirdParty/ASL}. Finally, we assume that you created +a build folder to install IPOPT in {\tt \ipoptf/build/}. In this case, to download +the \emph{trunk} version of IPOPT you would type: + +\begin{description} + \item {\tt \$ svn co https://projects.coin-or.org/svn/Ipopt/trunk \ipoptf} +\end{description} + +Once IPOPT has been compiled and installed, we can proceed to build \sensKKT. To do this go +to the {\tt \ipoptf/build/Ipopt/contrib/\sensdir/} folder, and type {\tt make} there. + +\begin{description} + \item {\tt \$ cd \ipoptf/build/Ipopt/contrib/\sensdir} + \item {\tt \$ make} +\end{description} + +If no errors are shown after compilation you can proceed to install the libraries and +to generate the \AMPL\ executable. To do this type + +\begin{description} + \item {\tt \$ make install} +\end{description} + +This should copy the generated libraries ({\tt \senslib.*}) to {\tt \ipoptf/build/lib}, and the \AMPL\ +executable ({\tt \sensexe}) to {\tt \ipoptf/build/bin/}. + +\section{Options} + +There are several new options that can be set in the {\tt ipopt.opt} file, that determine the behavior of the \sensKKT\ code. The more important options are the ones enable the execution of the post-optimal \sensKKT code. These are + +\begin{verbatim} +run_sens yes +\end{verbatim} + +\noindent to enable sensitivity computations, and + +\begin{verbatim} +compute_red_hessian yes +\end{verbatim} + +\noindent to enable the computation of the reduced Hessian. + +\paragraph{Other options are:} + +\begin{description} + +%\item[\selectstep] This option determines how the sensitivity update is performed, and it +% can take any of the following values: +% +% \begin{tabular}{lp{0.7\textwidth}} +% \textbf{\texttt{iftsensitivity}} & This option calculates the update using Equation \eqref{init1}. +% Note that here we consider the problem is formulated as Problem (11) from the +% implementation paper \cite{pirnay:2011}, and +% also we use general upper and lower bounds (see Section 2.6 from \cite{pirnay:2011}). +% This is the default. \\ +% \texttt{advanced} & for the full advanced step with Schur complement and multiplier correction \\ +% \texttt{sensitivity}& for the Schur step without multiplier correction, \\ +% \texttt{ift} & for the fast back solve without Schur complement computation, but with multiplier correction \\ +% \end{tabular} +% +% For parametric problems, the options \texttt{sensitivity} and \texttt{iftsensitivity} should be used, +% whereas for advanced step problems, the options \texttt{advanced} and \texttt{ift} are more suitable. + +\item[\texttt{\textbf{\nstepsopt}}] In general, the update can be done sequentially for any number of parameters. However, + for now, the valid range for this integer option is $1 \leq \mbox{\nstepsopt} \leq \infty$, + and the default value is 1. Please see Section \ref{sec:multirhs} for more details on this. + +\item[\texttt{\textbf{\boundcheckopt}}] If set to \texttt{yes}, this option turns on the bound correction algorithm (see Section 2.4 in the + implementation paper). The default value of this string option is \texttt{no}. + +\item[\texttt{\textbf{\boundepsopt}}] This option makes sure that only variables that violate the bound by more than\\ {\texttt{\boundepsopt}} + are considered as real violations. Otherwise, bound checking might continue until the full active set has been covered. + This is only used if the \texttt{\boundcheckopt} is set to \texttt{yes}. The valid range of this real valued option is: + $0 \leq \mbox{\texttt{\boundepsopt}} \leq \infty$, and the default value is $10^{-3}$. + +\item[\texttt{\textbf{\maxpdpertopt}}] For certain problems, IPOPT uses inertia correction of the primal dual matrix to achieve better convergence properties. This inertia correction changes the matrix and renders it useless for the use with \sensKKT. This option sets an upper bound, which the inertia correction may have. If any of the inertia correction values is above this bound, the \sensKKT\ algorithm is aborted. The valid range of this real valued option is: $0 \leq \mbox{\texttt{\maxpdpertopt}} \leq \infty$, and the default is $10^{-3}$. Please see Section 2.2 of the IPOPT implementation paper \cite{Waechter2006} for more details. + +\item[\texttt{\textbf{\eigendecompopt}}] If this option is set to \texttt{yes}, the reduced Hessian code will compute the eigenvalue decomposition of the reduced Hessian matrix. The default value of this string option is \texttt{no}. + +\item[\texttt{\textbf{\allowinex}}] This option is used to enable or disable IPOPT's Iterative Refinement. See Section 3.10 of the IPOPT implementation paper \cite{Waechter2006}. By default this string option is set to \texttt{yes} (do not do iterative refinement), and it can take values of \texttt{yes} or \texttt{no}. + +\item[\texttt{\textbf{\senskktresiduals}}] The residuals of the KKT conditions should be zero at the optimal solution. + However, in practice, especially for large problems and depending on the termination criteria, they may deviate from this theoretical state. If this option is set to the default \texttt{yes}, the residuals will be taken into account when computing the right hand side for the sensitivity step. If set to \texttt{no}, the residuals will not be computed and assumed to be zero. +\end{description} + +\bibliography{sipopt} + +\newpage +\appendix +\section{Summary of Suffixes} + +In this section we summarize the suffixes that need to be set for sensitivity updates, or reduced Hessian calculations. + + +\paragraph{Sensitivity Calculations:} Set the option \texttt{{\runaskkt}} to \texttt{yes}.\\ + +Some suffixes will need to be defined by the user, while others are automatically generated by {\sensKKT}. Moreover, +some of the suffixes need to be indexed by $\curls{i: 1 \leq i \leq \mbox{\texttt{\nstepsopt}}}$. Also note that the +direction column below is used to indicate to {\AMPL} if the suffix will be sent to the solver, or passed by the solver to {\AMPL}. +More information on this can be found in \cite{ampl}.\\ + +\begin{tabular}{|>{\centering}m{3.5cm}|>{\centering}m{2cm}|m{0.6\textwidth}|}\hline +\multicolumn{3}{|c|}{\textbf{Defined by User}} \\ \hline +Suffix & Direction & \multicolumn{1}{c|}{Description} \\ \hline +\textbf{\statez} & IN & This is used to enumerate the parameters that will be perturbed. It takes values from 1 to length($p$), and + the values may not be repeated. Note that the order of the values is crucial.\\ \hline +\multirow{2}{*}{\textbf{\statei{\emph{i}}}} & \multirow{2}{*}{IN } & + This is similar to \textbf{\statez}, but it now indicates the order for the parameters at the perturbed value. + You must define one for each $\curls{i: 1 \leq i \leq \mbox{\texttt{\nstepsopt}}}$. \\ + && This suffix should have the same values as \textbf{\statez}. It takes values from 1 to length($p$), and + the values may no be repeated.\\ \hline +\multirow{2}{*}{\textbf{\statevi{\emph{i}}}} & \multirow{2}{*}{IN} & + This is used to communicate the values of the perturbed parameters. + You must define one for each $\curls{i: 1 \leq i \leq \mbox{\texttt{\nstepsopt}}}$. \\ + && It has to be set for the same variables as \textbf{\stateo}.\\ \hline +\textbf{\initc} & IN & This is a flag that indicates the constraint is artificial, e.g., $w - p_0=0$ in Problem \eqref{eq:reform}. + If the constraint is artificial, set this suffix to 1 (no indexing is necessary). \\ \hline +\multicolumn{3}{|c|}{\textbf{Defined by \sensKKT}} \\ \hline +\multirow{2}{*}{\textbf{\sstatei{\emph{i}}}} & \multirow{2}{*}{OUT} & This holds the updated variables, as well as, the updated constraint multiplier + values computed in the sensitivity update. \\ + && One for each $\curls{i: 1 \leq i \leq \mbox{\texttt{\nstepsopt}}}$ will be defined. \\ \hline +\multirow{2}{*}{\textbf{\sstatezli{\emph{i}}}} & \multirow{2}{*}{OUT} & This suffix holds updated lower bound multipliers.\\ + && One for each $\curls{i: 1 \leq i \leq \mbox{\texttt{\nstepsopt}}}$ will be defined.\\ \hline +\multirow{2}{*}{\textbf{\sstatezui{\emph{i}}}} & \multirow{2}{*}{OUT} & This suffix holds updated upper bound multipliers.\\ + && One for each $\curls{i: 1 \leq i \leq \mbox{\texttt{\nstepsopt}}}$ will be defined.\\ \hline +\end{tabular} + +\paragraph{Reduced Hessian Calculations:} Set the option \texttt{{\redhessopt}} to \texttt{yes}. \\ + +\begin{tabular}{|>{\centering}m{3.5cm}|>{\centering}m{2cm}|m{0.6\textwidth}|}\hline +Suffix & Direction & \multicolumn{1}{c|}{Description} \\ \hline + \textbf{\redhess} & IN & This is used to enumerate the independent variables, thus it needs to take ordered values from +$1..n_I$, and $n_I$ is the number of independent variables. \\ \hline +\end{tabular} + + +\end{document} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/hicks.dat b/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/hicks.dat new file mode 100644 index 000000000..65f6dce5e --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/hicks.dat @@ -0,0 +1,85 @@ +# =================================================================== +# dynamic optimization formulation of the hicks-ray reactor +# data declaration +# victor m zavala march 2006 +# adapted for asNMPC by Hans Pirnay 2009, 2011 +# =================================================================== + +param a: 1 2 3 := # + 1 0.19681547722366 0.39442431473909 0.37640306270047 + 2 -0.06553542585020 0.29207341166523 0.51248582618842 + 3 0.02377097434822 -0.04154875212600 0.11111111111111; + +# mathematical model parameters + +let jj := 100 ; +let cf := 7.6 ; +let alpha := 1.95e-04 ; +let tf := 300 ; +let k10 := 300 ; +let tc := 290 ; +let n := 5 ; +let alpha1 := 1e6 ; +let alpha2 := 2e3 ; +let alpha3 := 1e-03 ; + +let nfe := 40 ; +let ncp := 3 ; +let r1 := 0.15505102572168 ; +let r2 := 0.64494897427832 ; +let r3 := 1 ; + +# initial and end transition points + +let c_des := 0.0944 ; +let t_des := 0.7766 ; +let u_des := 340 ; +let c_init := 0.1367 ; +let t_init := 0.7293 ; +let u_init := 390 ; +let time := 9 ; +let theta := 20 ; + +# initial guesses of the decision variables + +let point := 0 ; +let slopec := (c_des-c_init)/(nfe*ncp) ; +let slopet := (t_des-t_init)/(nfe*ncp) ; +let slopeu := (u_des-u_init)/(nfe*ncp) ; + +for {i in fe} +{ + for {j in cp} + { + let point := point+1 ; + let c[i,j] := slopec*point+c_init ; + let t[i,j] := slopet*point+t_init ; + let u[i,j] := slopeu*point+u_init ; + } +let h[i] := 1/nfe ; +} + + +#----------------------------------------- +# AsNMPC specific part: +# Here, the suffixes are set for the advanced step computations: +# +# 1. Define the order of the initial variables +let c_init_var.sens_state_0 := 1; +let t_init_var.sens_state_0 := 2; +# +# 2. Identify the variables at first sampling time +let c[5,1].sens_state_1 := 1; +let t[5,1].sens_state_1 := 2; +# +# 3. Set the measurement of the variables at first sampling time +let c[5,1].sens_state_value_1 := 0.135; +let t[5,1].sens_state_value_1 := 0.745; +# +# 4. Identify the initial constraints, that will be relaxed +# in favor of the new measurements +let c_init_constr.sens_init_constr :=1; +let t_init_constr.sens_init_constr :=1; + +#-- end of the hicks.dat file - + diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/hicks.mod b/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/hicks.mod new file mode 100644 index 000000000..580eeec00 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/hicks.mod @@ -0,0 +1,88 @@ +# =================================================================== +# dynamic optimization formulation of the hicks-ray reactor +# model declaration +# victor m zavala march 2006 +# adapted for asNMPC by Hans Pirnay 2009, 2011 +# =================================================================== + +# define indexes and general variables + +param nfe >= 1 integer ; +param ncp >= 1 integer ; + +# define mathematical model parameters + +param time ; +param jj ; +param cf ; +param alpha ; +param tf ; +param k10 ; +param tc ; +param n ; +param alpha1 ; +param alpha2 ; +param alpha3 ; +param c_des ; +param t_des ; +param u_des ; +param c_init ; +param t_init ; +param u_init ; +param r1 ; +param r2 ; +param r3 ; +param theta ; +param point ; +param slopec ; +param slopet ; +param slopeu ; + +# define dimensions for all indexed variables + +set fe := 1..nfe ; # number of finite elements +set cp := 1..ncp ; # number of collocation points + +param a{cp,cp} ; # collocation matrix +param h{fe} ; # finite element length + +# define the decision variables + +var c {fe,cp} >= 0 ; +var t {fe,cp} >= 0 ; +var u {fe,cp} >= 0 ; + +# auxiliary equations + +param yc := tc/(jj*cf) ; +param yf := tf/(jj*cf) ; + +# states first order derivatives +var cdot{i in fe, j in cp} = (1-c[i,j])/theta-k10*exp(-n/t[i,j])*c[i,j] ; +var tdot{i in fe, j in cp} = (yf-t[i,j])/theta+k10*exp(-n/t[i,j])*c[i,j]-alpha*u[i,j]*(t[i,j]-yc) ; + +#--------------------------------- +# This is specific to the asNMPC code: +# The initial constraints have to be defined as variables. +# They have to be set explictly with initial constraints. +# These constraints need to be identified by the +# sens_init_constr suffix. +var c_init_var; +var t_init_var; + +c_init_constr: c_init_var = c_init; +t_init_constr: t_init_var = t_init; #0.7293; +#--------------------------------- + +# collocation equations +fecolc{i in fe diff{1},j in cp}: c[i,j] = c[i-1,ncp]+time*h[i]*sum{k in cp} a[k,j]*cdot[i,k]; +fecolt{i in fe diff{1},j in cp}: t[i,j] = t[i-1,ncp]+time*h[i]*sum{k in cp} a[k,j]*tdot[i,k]; + +fecolc0{i in 1..1,j in cp}: c[i,j] = c_init_var+time*h[i]*sum{k in cp} a[k,j]*cdot[i,k]; +fecolt0{i in 1..1,j in cp}: t[i,j] = t_init_var+time*h[i]*sum{k in cp} a[k,j]*tdot[i,k]; + +# objective function... + +minimize cost: sum{i in 2..nfe} (h[i]*sum{j in cp} ((alpha1*(c[i,j]-c_des)^2+ alpha2*(t[i,j]-t_des)^2+alpha3*(u[i,j]-u_des)^2 )*a[j,ncp])) + h[1]*sum{j in cp} ((alpha1*((c_init_var+time*h[1]*sum{k in cp} a[k,j]*cdot[1,k]) - c_des)^2 + alpha2*((t_init_var+time*h[1]*sum{k in cp} a[k,j]*tdot[1,k])-t_des)^2 + alpha3*(u[1,j]-u_des)^2)*a[j,ncp]); + +#-- end of the hicks.mod file -- diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/hicks.run b/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/hicks.run new file mode 100644 index 000000000..d8608d823 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/hicks.run @@ -0,0 +1,26 @@ +# Copyright 2009, 2011 Hans Pirnay +# All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# Date : 2010-10-04 + +reset ; + +suffix sens_state_0, IN; +suffix sens_state_1, IN; +suffix sens_state_value_1, IN; +suffix sens_sol_state_1, OUT; +suffix sens_init_constr, IN; + + +option solver ipopt_sens ; + +option presolve 0; +option ipopt_options 'run_sens no'; + +model hicks.mod ; +data hicks.dat ; + +option ipopt_options 'run_sens yes'; +solve; +include nmpcresults.inc ; diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/ipopt.opt b/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/ipopt.opt new file mode 100644 index 000000000..df6cc6d68 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/ipopt.opt @@ -0,0 +1,9 @@ +n_sens_steps 1 +sens_boundcheck yes +#sens_bound_eps -1e-10 + +# Turn off the NLP scaling +#nlp_scaling_method none + +print_options_documentation no +#run_sens yes diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/nmpcresults.inc b/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/nmpcresults.inc new file mode 100644 index 000000000..f531f894e --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/hicks_ampl/nmpcresults.inc @@ -0,0 +1,98 @@ +# =================================================================== +# dynamic optimization formulation of the hicks-ray reactor +# create results file for matlab +# victor m zavala march 2006 +# Adapted for sIPOPT by Hans Pirnay 2009, 2011 +# =================================================================== + +printf "clc\n" >graph.m; +printf "clear all" >graph.m; +printf "\n" >graph.m; + +#display variables and parameters + +printf "c=[" >graph.m; +printf "%5.5f ",c_init>>graph.m; +printf {j in fe,k in cp}: +"%5.5f ",c[j,k]>>graph.m; +printf "]';\n" >>graph.m; + +printf "t=[" >graph.m; +printf "%5.5f ",t_init>>graph.m; +printf {j in fe,k in cp}: +"%5.5f ",t[j,k]>>graph.m; +printf "]';\n" >>graph.m; + +printf "u=[" >graph.m; +printf "%5.5f ",u_init>>graph.m; +printf {j in fe,k in cp}: +"%5.5f ",u[j,k]>>graph.m; +printf "]';\n" >>graph.m; + +printf "c1=[" >graph.m; +printf "%5.5f ",c_init>>graph.m; +printf {j in fe,k in cp}: +"%5.5f ",c[j,k].sens_sol_state_1>>graph.m; +printf "]';\n" >>graph.m; + +printf "t1=[" >graph.m; +printf "%5.5f ",t_init>>graph.m; +printf {j in fe,k in cp}: +"%5.5f ",t[j,k].sens_sol_state_1>>graph.m; +printf "]';\n" >>graph.m; + +printf "u1=[" >graph.m; +printf "%5.5f ",u_init>>graph.m; +printf {j in fe,k in cp}: +"%5.5f ",u[j,k].sens_sol_state_1>>graph.m; +printf "]';\n" >>graph.m; + +printf "nfe= %5i ",nfe>>graph.m; printf ";\n">>graph.m; +printf "ncp= %5i ",ncp>>graph.m; printf ";\n">>graph.m; +printf "ncp= ncp-1">>graph.m; printf ";\n">>graph.m; +printf "tt= %5.5f ",time>>graph.m; printf ";\n">>graph.m; +printf "r1= %5.5f ",r1>>graph.m; printf ";\n">>graph.m; +printf "r2= %5.5f ",r2>>graph.m; printf ";\n">>graph.m; +printf "r3= %5.5f ",r3>>graph.m; printf ";\n">>graph.m; +printf "roots(1)= r1 ">>graph.m; printf ";\n">>graph.m; +printf "roots(2)= r2 ">>graph.m; printf ";\n">>graph.m; +printf "roots(3)= r3 ">>graph.m; printf ";\n">>graph.m; +printf "h= tt/nfe ">>graph.m; printf ";\n">>graph.m; +printf "index= 0 ">>graph.m; printf ";\n">>graph.m; +printf "nelement= 0 ">>graph.m; printf ";\n">>graph.m; +printf "for i=1:nfe,">>graph.m; printf "\n">>graph.m; +printf "nelement=nelement+1">>graph.m; printf ";\n">>graph.m; +printf "for j=1:ncp+1,">>graph.m; printf "\n">>graph.m; +printf "index=index+1">>graph.m; printf ";\n">>graph.m; +printf "if i == 1">>graph.m; printf "\n">>graph.m; +printf "time(index) = h*roots(j)">>graph.m; printf ";\n">>graph.m; +printf "else">>graph.m; printf "\n">>graph.m; +printf "time(index) = (nelement-1)*h+h*roots(j)">>graph.m; printf ";\n">>graph.m; +printf "end">>graph.m; printf "\n">>graph.m; +printf "end">>graph.m; printf "\n">>graph.m; +printf "end">>graph.m; printf "\n">>graph.m; +printf "time= [0,time]'">>graph.m; printf ";\n">>graph.m; + +# plot the results + +printf "subplot(3,1,1)\n" >>graph.m; +printf "plot(time,c,'k')\nhold on\n" >>graph.m; +printf "plot(time,c1,'k')\n" >>graph.m; +printf "xlabel ('time')">>graph.m; printf ";\n">>graph.m; +printf "ylabel ('concentration')">>graph.m; printf ";\n">>graph.m; +printf "subplot(3,1,2)\n" >>graph.m; +printf "plot(time,[t,t1],'k')\n" >>graph.m; +printf "xlabel ('time')">>graph.m; printf ";\n">>graph.m; +printf "ylabel ('temperature')">>graph.m; printf ";\n">>graph.m; +printf "subplot(3,1,3)\n" >>graph.m; +printf "plot(time,[u,u1],'k')\n" >>graph.m; +printf "xlabel ('time')">>graph.m; printf ";\n">>graph.m; +printf "ylabel ('cooling w flowrate')">>graph.m; printf ";\n">>graph.m; + +printf "print -deps hicks.eps\n">>graph.m; + +close graph.m; +printf "output written to matlab m-file: graph.m ...\n"; + +#-- end of the graphshicks.inc file - + diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_ampl/parametric.mod b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_ampl/parametric.mod new file mode 100644 index 000000000..6a06af4b0 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_ampl/parametric.mod @@ -0,0 +1,25 @@ +# Copyright 2009, 2011 Hans Pirnay +# All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# Date : 2010-10-04 + +# variables +var x1>=0 := 0.15; +var x2>=0 := 0.15; +var x3>=0 := 0.0 ; + +# parameters +var eta1; +var eta2; + +# model +const1: 6*x1+3*x2+2*x3-eta1=0; +const2: eta2*x1+x2-x3-1=0; + +# initial constraints for parameters +consteta1: eta1=nominal_eta1; +consteta2: eta2=nominal_eta2; + +# objective +minimize cost: x1^2+x2^2+x3^2; diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_ampl/parametric.run b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_ampl/parametric.run new file mode 100644 index 000000000..a13810c4d --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_ampl/parametric.run @@ -0,0 +1,70 @@ +# Copyright 2009, 2011, 2012 Hans Pirnay +# All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# Date : 2010-10-04 + +reset; + +# --------------------------------- +# Set parameter values here +# --------------------------------- +# +param nominal_eta1 := 5.0; +param perturbed_eta1 := 4.5; + +param nominal_eta2 := 1; +param perturbed_eta2 := 1; +# +# --------------------------------- +# + +# declare AMPL suffixes for sIPOPT code +suffix sens_state_0, IN; +suffix sens_state_1, IN; +suffix sens_state_value_1, IN; +suffix sens_sol_state_1, OUT; +suffix sens_init_constr, IN; + +option presolve 0; + +# turn presolve off so no variables / equations are eliminated +# by AMPL +option solver ipopt_sens; + +# set run_sens to yes +#option ipopt_options 'run_sens yes n_sens_steps=1 sens_boundcheck no'; +option ipopt_options 'run_sens yes sens_boundcheck no'; + +model parametric.mod; + +# sIPOPT data +let eta1.sens_state_0 := 1; +let eta1.sens_state_1 := 1; +let eta1.sens_state_value_1 := perturbed_eta1; +let eta2.sens_state_0 := 2; +let eta2.sens_state_1 := 2; +let eta2.sens_state_value_1 := perturbed_eta2; + +let consteta1.sens_init_constr := 1; +let consteta2.sens_init_constr := 1; + +solve; +print ""; +print "Sensitivity without bound checking"; +print ""; +print "Nominal Solution:"; +display x1, x2, x3, eta1, eta2; +print "Estimation of Perturbed Solution with sIPOPT:"; +display x1.sens_sol_state_1, x2.sens_sol_state_1, x3.sens_sol_state_1, eta1.sens_sol_state_1, eta2.sens_sol_state_1; + +option ipopt_options 'run_sens yes sens_boundcheck yes'; +solve; + +print ""; +print "Sensitivity with bound checking"; +print ""; +print "Nominal Solution:"; +display x1, x2, x3, eta1, eta2; +print "Estimation of Perturbed Solution with sIPOPT:"; +display x1.sens_sol_state_1, x2.sens_sol_state_1, x3.sens_sol_state_1, eta1.sens_sol_state_1, eta2.sens_sol_state_1; diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_cpp/Makefile.in b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_cpp/Makefile.in new file mode 100644 index 000000000..76b8e8a87 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_cpp/Makefile.in @@ -0,0 +1,62 @@ +# Copyright (C) 2010 Hans Pirnay +# All Rights Reserved. +# This file is distributed under the Eclipse Public License. + +########################################################################## +# You can modify this example makefile to fit for your own program. # +# Usually, you only need to change the four CHANGEME entries below. # +########################################################################## + +# CHANGEME: This should be the name of your executable +EXE = parametric_driver@EXEEXT@ + +# CHANGEME: Here is the name of all object files corresponding to the source +# code that you wrote in order to define the problem statement +OBJS = parametric_driver.@OBJEXT@ \ + parametricTNLP.@OBJEXT@ + +# CHANGEME: Additional libraries +ADDLIBS = + +# CHANGEME: Additional flags for compilation (e.g., include flags) +ADDINCFLAGS = + +########################################################################## +# Usually, you don't have to change anything below. Note that if you # +# change certain compiler options, you might have to recompile Ipopt. # +########################################################################## + +# C++ Compiler command +CXX = @CXX@ + +# C++ Compiler options +CXXFLAGS = @CXXFLAGS@ + +# additional C++ Compiler options for linking +CXXLINKFLAGS = @RPATH_FLAGS@ + +prefix=@prefix@ +exec_prefix=@exec_prefix@ + +# TODO there should be an sipopt .pc file from which to get flags + +# Include directories +@COIN_HAS_PKGCONFIG_TRUE@INCL = `PKG_CONFIG_PATH=@COIN_PKG_CONFIG_PATH@ @PKG_CONFIG@ --cflags ipopt` $(ADDINCFLAGS) +@COIN_HAS_PKGCONFIG_FALSE@INCL = -I@includedir@/coin @IPOPTLIB_CFLAGS@ $(ADDINCFLAGS) + +# Linker flags +@COIN_HAS_PKGCONFIG_TRUE@LIBS = `PKG_CONFIG_PATH=@COIN_PKG_CONFIG_PATH@ @PKG_CONFIG@ --libs ipopt` -lsipopt +@COIN_HAS_PKGCONFIG_FALSE@LIBS = -L@libdir@ -lsipopt -lipopt @IPOPTLIB_LFLAGS@ + +all: $(EXE) + +.SUFFIXES: .cpp .@OBJEXT@ + +$(EXE): $(OBJS) + $(CXX) $(CXXLINKFLAGS) $(CXXFLAGS) -o $@ $(OBJS) $(LIBS) $(ADDLIBS) + +clean: + rm -rf $(EXE) $(OBJS) + +.cpp.@OBJEXT@: + $(CXX) $(CXXFLAGS) $(INCL) -c -o $@ $< diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp new file mode 100644 index 000000000..bd1840232 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.cpp @@ -0,0 +1,372 @@ +// Copyright 2010, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2010-30-04 + +#include "parametricTNLP.hpp" +#include "IpDenseVector.hpp" +#include "IpIpoptData.hpp" +#include + +using namespace Ipopt; + +/* Constructor */ +ParametricTNLP::ParametricTNLP() + : nominal_eta1_(5.0), + nominal_eta2_(1.0), + eta_1_perturbed_value_(4.5), + eta_2_perturbed_value_(1.0) +{ } + +ParametricTNLP::~ParametricTNLP() +{ } + +bool ParametricTNLP::get_nlp_info( + Index& n, + Index& m, + Index& nnz_jac_g, + Index& nnz_h_lag, + IndexStyleEnum& index_style) +{ + // x1, x2, x3, eta1, eta2 + n = 5; + + // 2 constraints + 2 parametric initial value constraints + m = 4; + + nnz_jac_g = 10; + + nnz_h_lag = 5; + + index_style = FORTRAN_STYLE; + + return true; +} + +bool ParametricTNLP::get_bounds_info( + Index /*n*/, + Number* x_l, + Number* x_u, + Index /*m*/, + Number* g_l, + Number* g_u +) +{ + for( Index k = 0; k < 3; ++k ) + { + x_l[k] = 0.0; + x_u[k] = 1.0e19; + } + x_l[3] = -1.0e19; + x_u[3] = 1.0e19; + x_l[4] = -1.0e19; + x_u[4] = 1.0e19; + + g_l[0] = 0.0; + g_u[0] = 0.0; + g_l[1] = 0.0; + g_u[1] = 0.0; + + // initial value constraints + g_l[2] = nominal_eta1_; + g_u[2] = nominal_eta1_; + g_l[3] = nominal_eta2_; + g_u[3] = nominal_eta2_; + + return true; +} + +bool ParametricTNLP::get_starting_point( + Index /*n*/, + bool /*init_x*/, + Number* x, + bool /*init_z*/, + Number* /*z_L*/, + Number* /*z_U*/, + Index /*m*/, + bool /*init_lambda*/, + Number* /*lambda*/ +) +{ + x[0] = 0.15; + x[1] = 0.15; + x[2] = 0.0; + x[3] = 0.0; + x[4] = 0.0; + + return true; +} + +bool ParametricTNLP::eval_f( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Number& obj_value +) +{ + obj_value = 0; + for( Index k = 0; k < 3; ++k ) + { + obj_value += x[k] * x[k]; + } + return true; +} + +bool ParametricTNLP::eval_grad_f( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Number* grad_f +) +{ + grad_f[0] = 2 * x[0]; + grad_f[1] = 2 * x[1]; + grad_f[2] = 2 * x[2]; + grad_f[3] = 0.0; + grad_f[4] = 0.0; + return true; +} + +bool ParametricTNLP::eval_g( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Index /*m*/, + Number* g +) +{ + Number x1, x2, x3, eta1, eta2; + x1 = x[0]; + x2 = x[1]; + x3 = x[2]; + eta1 = x[3]; + eta2 = x[4]; + g[0] = 6 * x1 + 3 * x2 + 2 * x3 - eta1; + g[1] = eta2 * x1 + x2 - x3 - 1; + g[2] = eta1; + g[3] = eta2; + return true; +} + +bool ParametricTNLP::eval_jac_g( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Index /*m*/, + Index /*nele_jac*/, + Index* iRow, + Index* jCol, + Number* values +) +{ + if( values == NULL ) + { + iRow[0] = 1; // dg1/dx1 + jCol[0] = 1; + iRow[1] = 1; // dg1/dx2 + jCol[1] = 2; + iRow[2] = 1; // dg1/dx3 + jCol[2] = 3; + iRow[3] = 1; // dg1/deta1 + jCol[3] = 4; + iRow[4] = 2; // dg2/dx1 + jCol[4] = 1; + iRow[5] = 2; // dg2/dx2 + jCol[5] = 2; + iRow[6] = 2; // dg2/dx3 + jCol[6] = 3; + iRow[7] = 2; // dg2/deta2 + jCol[7] = 5; + iRow[8] = 3; + jCol[8] = 4; + iRow[9] = 4; + jCol[9] = 5; + } + else + { + values[0] = 6.0; + values[1] = 3.0; + values[2] = 2.0; + values[3] = -1.0; + values[4] = x[4]; + values[5] = 1.0; + values[6] = -1.0; + values[7] = x[0]; + values[8] = 1.0; + values[9] = 1.0; + } + return true; +} + +bool ParametricTNLP::eval_h( + Index /*n*/, + const Number* /*x*/, + bool /*new_x*/, + Number obj_factor, + Index /*m*/, + const Number* lambda, + bool /*new_lambda*/, + Index /*nele_hess*/, + Index* iRow, + Index* jCol, + Number* values +) +{ + if( values == NULL ) + { + iRow[0] = 1; + jCol[0] = 1; + + iRow[1] = 2; + jCol[1] = 2; + + iRow[2] = 3; + jCol[2] = 3; + + iRow[3] = 1; + jCol[3] = 5; + + iRow[4] = 5; + jCol[4] = 1; + } + else + { + values[0] = 2.0 * obj_factor; + values[1] = 2.0 * obj_factor; + values[2] = 2.0 * obj_factor; + values[3] = 0.5 * lambda[1]; + values[4] = 0.5 * lambda[1]; + } + return true; +} + +bool ParametricTNLP::get_var_con_metadata( + Index n, + StringMetaDataMapType& /*var_string_md*/, + IntegerMetaDataMapType& var_integer_md, + NumericMetaDataMapType& var_numeric_md, + Index m, + StringMetaDataMapType& /*con_string_md*/, + IntegerMetaDataMapType& con_integer_md, + NumericMetaDataMapType& /*con_numeric_md*/ +) +{ + /* In this function, the indices for the parametric computations are set. + * To keep track of the parameters, each parameter gets an index from 1 to n_parameters. + * In this case, [1] eta_1, [2] eta_2. + * The following metadata vectors are important: + */ + + /* 1. sens_init_constr: in this list, the constraints that set the initial + * values for the parameters are indicated. + * For parameter 1 (eta_1) this is constraint 3 (e.g. C++ index 2), which is + * the constraint eta_1 = eta_1_nominal; + * For parameter 2 (eta_2) this is constraint 4 (e.g. C++ index 3). + */ + std::vector sens_init_constr(m, 0); + sens_init_constr[2] = 1; + sens_init_constr[3] = 2; + con_integer_md["sens_init_constr"] = sens_init_constr; + + /* 2. sens_state_1: in this index list, the parameters are indicated: + * Here: [1] eta_1, [2] eta_2 + */ + std::vector sens_state_1(n, 0); + sens_state_1[3] = 1; + sens_state_1[4] = 2; + var_integer_md["sens_state_1"] = sens_state_1; + + /* 3. sens_state_values_1: In this list of Numbers (=doubles), the perturbed + * values for the parameters are set. + */ + std::vector sens_state_value_1(n, 0); + sens_state_value_1[3] = eta_1_perturbed_value_; + sens_state_value_1[4] = eta_2_perturbed_value_; + var_numeric_md["sens_state_value_1"] = sens_state_value_1; + + return true; +} + +void ParametricTNLP::finalize_solution( + SolverReturn /*status*/, + Index /*n*/, + const Number* x, + const Number* /*z_L*/, + const Number* /*z_U*/, + Index m, + const Number* /*g*/, + const Number* lambda, + Number /*obj_value*/, + const IpoptData* ip_data, + IpoptCalculatedQuantities* /*ip_cq*/ +) +{ + // Check whether sIPOPT Algorithm aborted internally + // bool sens_internal_abort; + //options_->GetBoolValue("sens_internal_abort", sens_internal_abort, ""); + + // Get access to the metadata, where the solutions are stored. The metadata is part of the DenseVectorSpace. + SmartPtr x_owner_space = dynamic_cast(GetRawPtr( + ip_data->curr()->x()->OwnerSpace())); + + if( !IsValid(x_owner_space) ) + { + printf("Error IsValid(x_owner_space) failed\n"); + return; + } + std::string state; + std::vector sens_sol_vec; + state = "sens_sol_state_1"; + sens_sol_vec = x_owner_space->GetNumericMetaData(state.c_str()); + + // Print the solution vector + printf("\n" + " Nominal Perturbed\n"); + for( Index k = 0; k < (Index) sens_sol_vec.size(); ++k ) + { + printf("x[%3d] % .23f % .23f\n", k, x[k], sens_sol_vec[k]); + } + + printf("\n**********\n"); + for( Index k = 0; k < m; ++k ) + { + printf("lambda[%3d] (nom) % .23f \n", k, lambda[k]); + } + +} + +void ParametricTNLP::finalize_metadata( + Index n, + const StringMetaDataMapType& /*var_string_md*/, + const IntegerMetaDataMapType& /*var_integer_md*/, + const NumericMetaDataMapType& var_numeric_md, + Index m, + const StringMetaDataMapType& /*con_string_md*/, + const IntegerMetaDataMapType& /*con_integer_md*/, + const NumericMetaDataMapType& con_numeric_md +) +{ + // bound multipliers for lower and upper bounds + printf("\nDual bound multipliers:\n"); + NumericMetaDataMapType::const_iterator z_L_solution = var_numeric_md.find("sens_sol_state_1_z_L"); + NumericMetaDataMapType::const_iterator z_U_solution = var_numeric_md.find("sens_sol_state_1_z_U"); + if( z_L_solution != var_numeric_md.end() && z_U_solution != var_numeric_md.end() ) + { + for( Index k = 0; k < n; ++k ) + { + printf("z_L[%d] = %f z_U[%d] = %f\n", k, z_L_solution->second[k], k, z_U_solution->second[k]); + } + } + + // constraint mutlipliers + printf("\nConstraint multipliers:\n"); + NumericMetaDataMapType::const_iterator lambda_solution = con_numeric_md.find("sens_sol_state_1"); + if( lambda_solution != con_numeric_md.end() ) + { + for( Index k = 0; k < m; ++k ) + { + printf("lambda[%d] (upd) = %.14g\n", k, lambda_solution->second[k]); + } + } +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.hpp b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.hpp new file mode 100644 index 000000000..3ce6c2b30 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_cpp/parametricTNLP.hpp @@ -0,0 +1,167 @@ +// Copyright 2010 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2010-01-05 + +#ifndef __PARAMETRICTNLPEXAMPLE_HPP__ +#define __PARAMETRICTNLPEXAMPLE_HPP__ + +#include "IpTNLP.hpp" + +namespace Ipopt +{ + +class ParametricTNLP: public TNLP +{ +public: + + /** default constructor */ + ParametricTNLP(); + + /** default destructor */ + virtual ~ParametricTNLP(); + + /**@name Overloaded from TNLP */ + //@{ + virtual bool get_nlp_info( + Index& n, + Index& m, + Index& nnz_jac_g, + Index& nnz_h_lag, + IndexStyleEnum& index_style + ); + + virtual bool get_bounds_info( + Index n, + Number* x_l, + Number* x_u, + Index m, + Number* g_l, + Number* g_u + ); + + virtual bool get_starting_point( + Index n, + bool init_x, + Number* x, + bool init_z, + Number* z_L, + Number* z_U, + Index m, + bool init_lambda, + Number* lambda + ); + + virtual bool eval_f( + Index n, + const Number* x, + bool new_x, + Number& obj_value + ); + + virtual bool eval_grad_f( + Index n, + const Number* x, + bool new_x, + Number* grad_f + ); + + virtual bool eval_g( + Index n, + const Number* x, + bool new_x, + Index m, + Number* g + ); + + virtual bool eval_jac_g( + Index n, + const Number* x, + bool new_x, + Index m, + Index nele_jac, + Index* iRow, + Index* jCol, + Number* values + ); + + virtual bool eval_h( + Index n, + const Number* x, + bool new_x, + Number obj_factor, + Index m, + const Number* lambda, + bool new_lambda, + Index nele_hess, + Index* iRow, + Index* jCol, + Number* values + ); + + virtual bool get_var_con_metadata( + Index n, + StringMetaDataMapType& var_string_md, + IntegerMetaDataMapType& var_integer_md, + NumericMetaDataMapType& var_numeric_md, + Index m, + StringMetaDataMapType& con_string_md, + IntegerMetaDataMapType& con_integer_md, + NumericMetaDataMapType& con_numeric_md + ); + + virtual void finalize_solution( + SolverReturn status, + Index n, + const Number* x, + const Number* z_L, + const Number* z_U, + Index m, + const Number* g, + const Number* lambda, + Number obj_value, + const IpoptData* ip_data, + IpoptCalculatedQuantities* ip_cq + ); + + virtual void finalize_metadata( + Index n, + const StringMetaDataMapType& var_string_md, + const IntegerMetaDataMapType& var_integer_md, + const NumericMetaDataMapType& var_numeric_md, + Index m, + const StringMetaDataMapType& con_string_md, + const IntegerMetaDataMapType& con_integer_md, + const NumericMetaDataMapType& con_numeric_md + ); + +private: + /**@name Methods to block default compiler methods. + * The compiler automatically generates the following three methods. + * Since the default compiler implementation is generally not what + * you want (for all but the most simple classes), we usually + * put the declarations of these methods in the private section + * and never implement them. This prevents the compiler from + * implementing an incorrect "default" behavior without us + * knowing. (See Scott Meyers book, "Effective C++") + * + */ + //@{ + ParametricTNLP( + const ParametricTNLP&); + ParametricTNLP& operator=( + const ParametricTNLP&); + //@} + + /* Nominal and perturbed parameter values */ + Number nominal_eta1_; + Number nominal_eta2_; + + Number eta_1_perturbed_value_; + Number eta_2_perturbed_value_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp new file mode 100644 index 000000000..7ccad2e3a --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_cpp/parametric_driver.cpp @@ -0,0 +1,67 @@ +// Copyright 2010, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2010-01-05 + +#include "parametricTNLP.hpp" + +#include "IpIpoptApplication.hpp" +#include "SensApplication.hpp" +#include "IpIpoptAlg.hpp" +#include "SensRegOp.hpp" + +int main( + int /*argv*/, + char** /*argc*/ +) +{ + using namespace Ipopt; + + SmartPtr app_ipopt = new IpoptApplication(); + + SmartPtr app_sens = new SensApplication(app_ipopt->Jnlst(), app_ipopt->Options(), + app_ipopt->RegOptions()); + + // Register sIPOPT options + RegisterOptions_sIPOPT(app_ipopt->RegOptions()); + app_ipopt->Options()->SetRegisteredOptions(app_ipopt->RegOptions()); + + // Call Initialize the first time to create a journalist, but ignore + // any options file + ApplicationReturnStatus retval; + retval = app_ipopt->Initialize(""); + if( retval != Solve_Succeeded ) + { + //printf("ampl_ipopt.cpp: Error in first Initialize!!!!\n"); + exit(-100); + } + app_ipopt->Initialize(); + + // create AmplSensTNLP from argc. This is an nlp because we are using our own TNLP Adapter + SmartPtr sens_tnlp = new ParametricTNLP(); + + app_ipopt->Options()->SetStringValueIfUnset("run_sens", "yes"); + app_ipopt->Options()->SetIntegerValueIfUnset("n_sens_steps", 1); + + app_sens->Initialize(); + + retval = app_ipopt->OptimizeTNLP(sens_tnlp); + + /* give pointers to Ipopt algorithm objects to Sens Application */ + app_sens->SetIpoptAlgorithmObjects(app_ipopt, retval); + + printf("\n"); + printf("#-------------------------------------------\n"); + printf("# Sensitivity without bound checking\n"); + printf("#-------------------------------------------\n"); + + app_sens->Run(); + + printf("\n"); + printf("#-------------------------------------------\n"); + printf("# Sensitivity with bound checking\n"); + printf("#-------------------------------------------\n"); + app_ipopt->Options()->SetStringValue("sens_boundcheck", "yes"); + app_sens->Run(); +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/Makefile.in b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/Makefile.in new file mode 100644 index 000000000..33b62140d --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/Makefile.in @@ -0,0 +1,62 @@ +# Copyright (C) 2010 Hans Pirnay +# All Rights Reserved. +# This file is distributed under the Eclipse Public License. + +########################################################################## +# You can modify this example makefile to fit for your own program. # +# Usually, you only need to change the four CHANGEME entries below. # +########################################################################## + +# CHANGEME: This should be the name of your executable +EXE = parametric_dsdp_driver@EXEEXT@ + +# CHANGEME: Here is the name of all object files corresponding to the source +# code that you wrote in order to define the problem statement +OBJS = parametric_dsdp_driver.@OBJEXT@ \ + parametricTNLP.@OBJEXT@ + +# CHANGEME: Additional libraries +ADDLIBS = + +# CHANGEME: Additional flags for compilation (e.g., include flags) +ADDINCFLAGS = + +########################################################################## +# Usually, you don't have to change anything below. Note that if you # +# change certain compiler options, you might have to recompile Ipopt. # +########################################################################## + +# C++ Compiler command +CXX = @CXX@ + +# C++ Compiler options +CXXFLAGS = @CXXFLAGS@ + +# additional C++ Compiler options for linking +CXXLINKFLAGS = @RPATH_FLAGS@ + +prefix=@prefix@ +exec_prefix=@exec_prefix@ + +# TODO there should be an sipopt .pc file from which to get flags + +# Include directories +@COIN_HAS_PKGCONFIG_TRUE@INCL = `PKG_CONFIG_PATH=@COIN_PKG_CONFIG_PATH@ @PKG_CONFIG@ --cflags ipopt` $(ADDINCFLAGS) +@COIN_HAS_PKGCONFIG_FALSE@INCL = -I@includedir@/coin @IPOPTLIB_CFLAGS@ $(ADDINCFLAGS) + +# Linker flags +@COIN_HAS_PKGCONFIG_TRUE@LIBS = `PKG_CONFIG_PATH=@COIN_PKG_CONFIG_PATH@ @PKG_CONFIG@ --libs ipopt` -lsipopt +@COIN_HAS_PKGCONFIG_FALSE@LIBS = -L@libdir@ -lsipopt -lipopt @IPOPTLIB_LFLAGS@ + +all: $(EXE) + +.SUFFIXES: .cpp .@OBJEXT@ + +$(EXE): $(OBJS) + $(CXX) $(CXXLINKFLAGS) $(CXXFLAGS) -o $@ $(OBJS) $(LIBS) $(ADDLIBS) + +clean: + rm -rf $(EXE) $(OBJS) + +.cpp.@OBJEXT@: + $(CXX) $(CXXFLAGS) $(INCL) -c -o $@ $< diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.cpp b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.cpp new file mode 100644 index 000000000..2df407b78 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.cpp @@ -0,0 +1,373 @@ +// Copyright 2010, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2010-30-04 + +#include "parametricTNLP.hpp" +#include "IpDenseVector.hpp" +#include "IpIpoptData.hpp" +#include + +using namespace Ipopt; + +/* Constructor */ +ParametricTNLP::ParametricTNLP() + : nominal_eta1_(5.0), + nominal_eta2_(1.0), + eta_1_perturbed_value_(4.5), + eta_2_perturbed_value_(1.0) +{ } + +ParametricTNLP::~ParametricTNLP() +{ } + +bool ParametricTNLP::get_nlp_info( + Index& n, + Index& m, + Index& nnz_jac_g, + Index& nnz_h_lag, + IndexStyleEnum& index_style +) +{ + // x1, x2, x3, eta1, eta2 + n = 5; + + // 2 constraints + 2 parametric initial value constraints + m = 4; + + nnz_jac_g = 10; + + nnz_h_lag = 5; + + index_style = FORTRAN_STYLE; + + return true; +} + +bool ParametricTNLP::get_bounds_info( + Index /*n*/, + Number* x_l, + Number* x_u, + Index /*m*/, + Number* g_l, + Number* g_u +) +{ + for( Index k = 0; k < 3; ++k ) + { + x_l[k] = 0.0; + x_u[k] = 1.0e19; + } + x_l[3] = -1.0e19; + x_u[3] = 1.0e19; + x_l[4] = -1.0e19; + x_u[4] = 1.0e19; + + g_l[0] = 0.0; + g_u[0] = 0.0; + g_l[1] = 0.0; + g_u[1] = 0.0; + + // initial value constraints + g_l[2] = nominal_eta1_; + g_u[2] = nominal_eta1_; + g_l[3] = nominal_eta2_; + g_u[3] = nominal_eta2_; + + return true; +} + +bool ParametricTNLP::get_starting_point( + Index /*n*/, + bool /*init_x*/, + Number* x, + bool /*init_z*/, + Number* /*z_L*/, + Number* /*z_U*/, + Index /*m*/, + bool /*init_lambda*/, + Number* /*lambda*/ +) +{ + x[0] = 0.15; + x[1] = 0.15; + x[2] = 0.0; + x[3] = 0.0; + x[4] = 0.0; + + return true; +} + +bool ParametricTNLP::eval_f( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Number& obj_value +) +{ + obj_value = 0; + for( Index k = 0; k < 3; ++k ) + { + obj_value += x[k] * x[k]; + } + return true; +} + +bool ParametricTNLP::eval_grad_f( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Number* grad_f +) +{ + grad_f[0] = 2 * x[0]; + grad_f[1] = 2 * x[1]; + grad_f[2] = 2 * x[2]; + grad_f[3] = 0.0; + grad_f[4] = 0.0; + return true; +} + +bool ParametricTNLP::eval_g( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Index /*m*/, + Number* g +) +{ + Number x1, x2, x3, eta1, eta2; + x1 = x[0]; + x2 = x[1]; + x3 = x[2]; + eta1 = x[3]; + eta2 = x[4]; + g[0] = 6 * x1 + 3 * x2 + 2 * x3 - eta1; + g[1] = eta2 * x1 + x2 - x3 - 1; + g[2] = eta1; + g[3] = eta2; + return true; +} + +bool ParametricTNLP::eval_jac_g( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Index /*m*/, + Index /*nele_jac*/, + Index* iRow, + Index* jCol, + Number* values +) +{ + if( values == NULL ) + { + iRow[0] = 1; // dg1/dx1 + jCol[0] = 1; + iRow[1] = 1; // dg1/dx2 + jCol[1] = 2; + iRow[2] = 1; // dg1/dx3 + jCol[2] = 3; + iRow[3] = 1; // dg1/deta1 + jCol[3] = 4; + iRow[4] = 2; // dg2/dx1 + jCol[4] = 1; + iRow[5] = 2; // dg2/dx2 + jCol[5] = 2; + iRow[6] = 2; // dg2/dx3 + jCol[6] = 3; + iRow[7] = 2; // dg2/deta2 + jCol[7] = 5; + iRow[8] = 3; + jCol[8] = 4; + iRow[9] = 4; + jCol[9] = 5; + } + else + { + values[0] = 6.0; + values[1] = 3.0; + values[2] = 2.0; + values[3] = -1.0; + values[4] = x[4]; + values[5] = 1.0; + values[6] = -1.0; + values[7] = x[0]; + values[8] = 1.0; + values[9] = 1.0; + } + return true; +} + +bool ParametricTNLP::eval_h( + Index /*n*/, + const Number* /*x*/, + bool /*new_x*/, + Number obj_factor, + Index /*m*/, + const Number* lambda, + bool /*new_lambda*/, + Index /*nele_hess*/, + Index* iRow, + Index* jCol, + Number* values +) +{ + if( values == NULL ) + { + iRow[0] = 1; + jCol[0] = 1; + + iRow[1] = 2; + jCol[1] = 2; + + iRow[2] = 3; + jCol[2] = 3; + + iRow[3] = 1; + jCol[3] = 5; + + iRow[4] = 5; + jCol[4] = 1; + } + else + { + values[0] = 2.0 * obj_factor; + values[1] = 2.0 * obj_factor; + values[2] = 2.0 * obj_factor; + values[3] = 0.5 * lambda[1]; + values[4] = 0.5 * lambda[1]; + } + return true; +} + +bool ParametricTNLP::get_var_con_metadata( + Index n, + StringMetaDataMapType& /*var_string_md*/, + IntegerMetaDataMapType& var_integer_md, + NumericMetaDataMapType& var_numeric_md, + Index m, + StringMetaDataMapType& /*con_string_md*/, + IntegerMetaDataMapType& con_integer_md, + NumericMetaDataMapType& /*con_numeric_md*/ +) +{ + /* In this function, the indices for the parametric computations are set. + * To keep track of the parameters, each parameter gets an index from 1 to n_parameters. + * In this case, [1] eta_1, [2] eta_2. + * The following metadata vectors are important: + */ + + /* 1. sens_init_constr: in this list, the constraints that set the initial + * values for the parameters are indicated. + * For parameter 1 (eta_1) this is constraint 3 (e.g. C++ index 2), which is + * the constraint eta_1 = eta_1_nominal; + * For parameter 2 (eta_2) this is constraint 4 (e.g. C++ index 3). + */ + std::vector sens_init_constr(m, 0); + sens_init_constr[2] = 1; + sens_init_constr[3] = 2; + con_integer_md["sens_init_constr"] = sens_init_constr; + + /* 2. sens_state_1: in this index list, the parameters are indicated: + * Here: [1] eta_1, [2] eta_2 + */ + std::vector sens_state_1(n, 0); + sens_state_1[3] = 1; + sens_state_1[4] = 2; + var_integer_md["sens_state_1"] = sens_state_1; + + /* 3. sens_state_values_1: In this list of Numbers (=doubles), the perturbed + * values for the parameters are set. + */ + std::vector sens_state_value_1(n, 0); + sens_state_value_1[3] = eta_1_perturbed_value_; + sens_state_value_1[4] = eta_2_perturbed_value_; + var_numeric_md["sens_state_value_1"] = sens_state_value_1; + + return true; +} + +void ParametricTNLP::finalize_solution( + SolverReturn /*status*/, + Index /*n*/, + const Number* x, + const Number* /*z_L*/, + const Number* /*z_U*/, + Index m, + const Number* /*g*/, + const Number* lambda, + Number /*obj_value*/, + const IpoptData* ip_data, + IpoptCalculatedQuantities* /*ip_cq*/ +) +{ + // Check whether sIPOPT Algorithm aborted internally + // bool sens_internal_abort; + //options_->GetBoolValue("sens_internal_abort", sens_internal_abort, ""); + + // Get access to the metadata, where the solutions are stored. The metadata is part of the DenseVectorSpace. + SmartPtr x_owner_space = dynamic_cast(GetRawPtr( + ip_data->curr()->x()->OwnerSpace())); + + if( !IsValid(x_owner_space) ) + { + printf("Error IsValid(x_owner_space) failed\n"); + return; + } + std::string state; + std::vector sens_sol_vec; + state = "sens_sol_state_1"; + sens_sol_vec = x_owner_space->GetNumericMetaData(state.c_str()); + + // Print the solution vector + printf("\n" + " Nominal Perturbed\n"); + for( Index k = 0; k < (Index) sens_sol_vec.size(); ++k ) + { + printf("x[%3d] % .23f % .23f\n", k, x[k], sens_sol_vec[k]); + } + + printf("\n**********\n"); + for( Index k = 0; k < m; ++k ) + { + printf("lambda[%3d] (nom) % .23f \n", k, lambda[k]); + } + +} + +void ParametricTNLP::finalize_metadata( + Index n, + const StringMetaDataMapType& /*var_string_md*/, + const IntegerMetaDataMapType& /*var_integer_md*/, + const NumericMetaDataMapType& var_numeric_md, + Index m, + const StringMetaDataMapType& /*con_string_md*/, + const IntegerMetaDataMapType& /*con_integer_md*/, + const NumericMetaDataMapType& con_numeric_md +) +{ + // bound multipliers for lower and upper bounds + printf("\nDual bound multipliers:\n"); + NumericMetaDataMapType::const_iterator z_L_solution = var_numeric_md.find("sens_sol_state_1_z_L"); + NumericMetaDataMapType::const_iterator z_U_solution = var_numeric_md.find("sens_sol_state_1_z_U"); + if( z_L_solution != var_numeric_md.end() && z_U_solution != var_numeric_md.end() ) + { + for( Index k = 0; k < n; ++k ) + { + printf("z_L[%d] = %f z_U[%d] = %f\n", k, z_L_solution->second[k], k, z_U_solution->second[k]); + } + } + + // constraint mutlipliers + printf("\nConstraint multipliers:\n"); + NumericMetaDataMapType::const_iterator lambda_solution = con_numeric_md.find("sens_sol_state_1"); + if( lambda_solution != con_numeric_md.end() ) + { + for( Index k = 0; k < m; ++k ) + { + printf("lambda[%d] (upd) = %.14g\n", k, lambda_solution->second[k]); + } + } +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.hpp b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.hpp new file mode 100644 index 000000000..3ce6c2b30 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP.hpp @@ -0,0 +1,167 @@ +// Copyright 2010 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2010-01-05 + +#ifndef __PARAMETRICTNLPEXAMPLE_HPP__ +#define __PARAMETRICTNLPEXAMPLE_HPP__ + +#include "IpTNLP.hpp" + +namespace Ipopt +{ + +class ParametricTNLP: public TNLP +{ +public: + + /** default constructor */ + ParametricTNLP(); + + /** default destructor */ + virtual ~ParametricTNLP(); + + /**@name Overloaded from TNLP */ + //@{ + virtual bool get_nlp_info( + Index& n, + Index& m, + Index& nnz_jac_g, + Index& nnz_h_lag, + IndexStyleEnum& index_style + ); + + virtual bool get_bounds_info( + Index n, + Number* x_l, + Number* x_u, + Index m, + Number* g_l, + Number* g_u + ); + + virtual bool get_starting_point( + Index n, + bool init_x, + Number* x, + bool init_z, + Number* z_L, + Number* z_U, + Index m, + bool init_lambda, + Number* lambda + ); + + virtual bool eval_f( + Index n, + const Number* x, + bool new_x, + Number& obj_value + ); + + virtual bool eval_grad_f( + Index n, + const Number* x, + bool new_x, + Number* grad_f + ); + + virtual bool eval_g( + Index n, + const Number* x, + bool new_x, + Index m, + Number* g + ); + + virtual bool eval_jac_g( + Index n, + const Number* x, + bool new_x, + Index m, + Index nele_jac, + Index* iRow, + Index* jCol, + Number* values + ); + + virtual bool eval_h( + Index n, + const Number* x, + bool new_x, + Number obj_factor, + Index m, + const Number* lambda, + bool new_lambda, + Index nele_hess, + Index* iRow, + Index* jCol, + Number* values + ); + + virtual bool get_var_con_metadata( + Index n, + StringMetaDataMapType& var_string_md, + IntegerMetaDataMapType& var_integer_md, + NumericMetaDataMapType& var_numeric_md, + Index m, + StringMetaDataMapType& con_string_md, + IntegerMetaDataMapType& con_integer_md, + NumericMetaDataMapType& con_numeric_md + ); + + virtual void finalize_solution( + SolverReturn status, + Index n, + const Number* x, + const Number* z_L, + const Number* z_U, + Index m, + const Number* g, + const Number* lambda, + Number obj_value, + const IpoptData* ip_data, + IpoptCalculatedQuantities* ip_cq + ); + + virtual void finalize_metadata( + Index n, + const StringMetaDataMapType& var_string_md, + const IntegerMetaDataMapType& var_integer_md, + const NumericMetaDataMapType& var_numeric_md, + Index m, + const StringMetaDataMapType& con_string_md, + const IntegerMetaDataMapType& con_integer_md, + const NumericMetaDataMapType& con_numeric_md + ); + +private: + /**@name Methods to block default compiler methods. + * The compiler automatically generates the following three methods. + * Since the default compiler implementation is generally not what + * you want (for all but the most simple classes), we usually + * put the declarations of these methods in the private section + * and never implement them. This prevents the compiler from + * implementing an incorrect "default" behavior without us + * knowing. (See Scott Meyers book, "Effective C++") + * + */ + //@{ + ParametricTNLP( + const ParametricTNLP&); + ParametricTNLP& operator=( + const ParametricTNLP&); + //@} + + /* Nominal and perturbed parameter values */ + Number nominal_eta1_; + Number nominal_eta2_; + + Number eta_1_perturbed_value_; + Number eta_2_perturbed_value_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP2.cpp b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP2.cpp new file mode 100644 index 000000000..69f7bf6a7 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/parametricTNLP2.cpp @@ -0,0 +1,397 @@ +// Copyright 2010, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2010-30-04 + +#include "parametricTNLP.hpp" +#include "IpDenseVector.hpp" +#include "IpIpoptData.hpp" +#include + +using namespace Ipopt; + +/* Constructor */ +ParametricTNLP::ParametricTNLP() + : nominal_eta1_(5.0), + nominal_eta2_(1.0), + eta_1_perturbed_value_(4.5), + eta_2_perturbed_value_(1.0) +{ } + +ParametricTNLP::~ParametricTNLP() +{ } + +bool ParametricTNLP::get_nlp_info( + Index& n, + Index& m, + Index& nnz_jac_g, + Index& nnz_h_lag, + IndexStyleEnum& index_style +) +{ + // x1, x2, x3, eta1, eta2 + n = 5; + + // 2 constraints + 2 parametric initial value constraints + m = 4; //+2; + + nnz_jac_g = 10; //+2; + + nnz_h_lag = 5; + + index_style = FORTRAN_STYLE; + + return true; +} + +bool ParametricTNLP::get_bounds_info( + Index /*n*/, + Number* x_l, + Number* x_u, + Index /*m*/, + Number* g_l, + Number* g_u +) +{ + for( Index k = 0; k < 3; ++k ) + { + x_l[k] = 0.0; + x_u[k] = 1.0e19; + } + x_l[3] = -1.0e19; + x_u[3] = 1.0e19; + x_l[4] = -1.0e19; + x_u[4] = 1.0e19; + + g_l[0] = 0.0; + g_u[0] = 0.0; + g_l[1] = 0.0; + g_u[1] = 0.0; + + // initial value constraints + g_l[2] = nominal_eta1_; + g_u[2] = nominal_eta1_; + g_l[3] = nominal_eta2_; + g_u[3] = nominal_eta2_; + + /* + g_l[4] = 0.0 ; + g_u[4] = 100.0 ; + + g_l[5] = -100.0 ; + g_u[5] = 0.0 ; + */ + + return true; +} + +bool ParametricTNLP::get_starting_point( + Index /*n*/, + bool /*init_x*/, + Number* x, + bool /*init_z*/, + Number* /*z_L*/, + Number* /*z_U*/, + Index /*m*/, + bool /*init_lambda*/, + Number* /*lambda*/ +) +{ + x[0] = 0.15; + x[1] = 0.15; + x[2] = 0.0; + x[3] = 0.0; + x[4] = 0.0; + + return true; +} + +bool ParametricTNLP::eval_f( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Number& obj_value +) +{ + obj_value = 0; + for( Index k = 0; k < 3; ++k ) + { + obj_value += x[k] * x[k]; + } + return true; +} + +bool ParametricTNLP::eval_grad_f( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Number* grad_f +) +{ + grad_f[0] = 2 * x[0]; + grad_f[1] = 2 * x[1]; + grad_f[2] = 2 * x[2]; + grad_f[3] = 0.0; + grad_f[4] = 0.0; + return true; +} + +bool ParametricTNLP::eval_g( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Index /*m*/, + Number* g +) +{ + Number x1, x2, x3, eta1, eta2; + x1 = x[0]; + x2 = x[1]; + x3 = x[2]; + eta1 = x[3]; + eta2 = x[4]; + g[0] = 6 * x1 + 3 * x2 + 2 * x3 - eta1; + g[1] = eta2 * x1 + x2 - x3 - 1; + g[2] = eta1; + g[3] = eta2; + + /* + g[4] = x1 + 10 ; + g[5] = -100 + x2 ; + */ + + return true; +} + +bool ParametricTNLP::eval_jac_g( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Index /*m*/, + Index /*nele_jac*/, + Index* iRow, + Index* jCol, + Number* values +) +{ + if( values == NULL ) + { + iRow[0] = 1; // dg1/dx1 + jCol[0] = 1; + iRow[1] = 1; // dg1/dx2 + jCol[1] = 2; + iRow[2] = 1; // dg1/dx3 + jCol[2] = 3; + iRow[3] = 1; // dg1/deta1 + jCol[3] = 4; + iRow[4] = 2; // dg2/dx1 + jCol[4] = 1; + iRow[5] = 2; // dg2/dx2 + jCol[5] = 2; + iRow[6] = 2; // dg2/dx3 + jCol[6] = 3; + iRow[7] = 2; // dg2/deta2 + jCol[7] = 5; + iRow[8] = 3; + jCol[8] = 4; + iRow[9] = 4; + jCol[9] = 5; + /* + iRow[10] = 5; + jCol[10] = 1; + iRow[11] = 6; + jCol[11] = 2; + */ + } + else + { + values[0] = 6.0; + values[1] = 3.0; + values[2] = 2.0; + values[3] = -1.0; + values[4] = x[4]; + values[5] = 1.0; + values[6] = -1.0; + values[7] = x[0]; + values[8] = 1.0; + values[9] = 1.0; + /* + values[10] = 1.0 ; + values[11] = 1.0 ; + */ + } + return true; +} + +bool ParametricTNLP::eval_h( + Index /*n*/, + const Number* /*x*/, + bool /*new_x*/, + Number obj_factor, + Index /*m*/, + const Number* lambda, + bool /*new_lambda*/, + Index /*nele_hess*/, + Index* iRow, + Index* jCol, + Number* values +) +{ + if( values == NULL ) + { + iRow[0] = 1; + jCol[0] = 1; + + iRow[1] = 2; + jCol[1] = 2; + + iRow[2] = 3; + jCol[2] = 3; + + iRow[3] = 1; + jCol[3] = 5; + + iRow[4] = 5; + jCol[4] = 1; + } + else + { + values[0] = 2.0 * obj_factor; + values[1] = 2.0 * obj_factor; + values[2] = 2.0 * obj_factor; + values[3] = 0.5 * lambda[1]; + values[4] = 0.5 * lambda[1]; + } + return true; +} + +bool ParametricTNLP::get_var_con_metadata( + Index n, + StringMetaDataMapType& /*var_string_md*/, + IntegerMetaDataMapType& var_integer_md, + NumericMetaDataMapType& var_numeric_md, + Index m, + StringMetaDataMapType& /*con_string_md*/, + IntegerMetaDataMapType& con_integer_md, + NumericMetaDataMapType& /*con_numeric_md*/ +) +{ + /* In this function, the indices for the parametric computations are set. + * To keep track of the parameters, each parameter gets an index from 1 to n_parameters. + * In this case, [1] eta_1, [2] eta_2. + * The following metadata vectors are important: + */ + + /* 1. sens_init_constr: in this list, the constraints that set the initial + * values for the parameters are indicated. + * For parameter 1 (eta_1) this is constraint 3 (e.g. C++ index 2), which is + * the constraint eta_1 = eta_1_nominal; + * For parameter 2 (eta_2) this is constraint 4 (e.g. C++ index 3). + */ + std::vector sens_init_constr(m, 0); + sens_init_constr[2] = 1; + sens_init_constr[3] = 2; + con_integer_md["sens_init_constr"] = sens_init_constr; + + /* 2. sens_state_1: in this index list, the parameters are indicated: + * Here: [1] eta_1, [2] eta_2 + */ + std::vector sens_state_1(n, 0); + sens_state_1[3] = 1; + sens_state_1[4] = 2; + var_integer_md["sens_state_1"] = sens_state_1; + + /* 3. sens_state_values_1: In this list of Numbers (=doubles), the perturbed + * values for the parameters are set. + */ + std::vector sens_state_value_1(n, 0); + sens_state_value_1[3] = eta_1_perturbed_value_; + sens_state_value_1[4] = eta_2_perturbed_value_; + var_numeric_md["sens_state_value_1"] = sens_state_value_1; + + return true; +} + +void ParametricTNLP::finalize_solution( + SolverReturn /*status*/, + Index /*n*/, + const Number* x, + const Number* /*z_L*/, + const Number* /*z_U*/, + Index m, + const Number* /*g*/, + const Number* lambda, + Number /*obj_value*/, + const IpoptData* ip_data, + IpoptCalculatedQuantities* /*ip_cq*/ +) +{ + // Check whether sIPOPT Algorithm aborted internally + // bool sens_internal_abort; + //options_->GetBoolValue("sens_internal_abort", sens_internal_abort, ""); + + // Get access to the metadata, where the solutions are stored. The metadata is part of the DenseVectorSpace. + SmartPtr x_owner_space = dynamic_cast(GetRawPtr( + ip_data->curr()->x()->OwnerSpace())); + + if( !IsValid(x_owner_space) ) + { + printf("Error IsValid(x_owner_space) failed\n"); + return; + } + std::string state; + std::vector sens_sol_vec; + state = "sens_sol_state_1"; + sens_sol_vec = x_owner_space->GetNumericMetaData(state.c_str()); + + // Print the solution vector + printf("\n" + " Nominal Perturbed\n"); + for( Index k = 0; k < (Index) sens_sol_vec.size(); ++k ) + { + printf("x[%3d] % .23f % .23f\n", k, x[k], sens_sol_vec[k]); + } + + printf("\n**********\n"); + for( Index k = 0; k < m; ++k ) + { + printf("lambda[%3d] (nom) % .23f \n", k, lambda[k]); + } + +} + +void ParametricTNLP::finalize_metadata( + Index n, + const StringMetaDataMapType& /*var_string_md*/, + const IntegerMetaDataMapType& /*var_integer_md*/, + const NumericMetaDataMapType& var_numeric_md, + Index m, + const StringMetaDataMapType& /*con_string_md*/, + const IntegerMetaDataMapType& /*con_integer_md*/, + const NumericMetaDataMapType& con_numeric_md +) +{ + // bound multipliers for lower and upper bounds + printf("\nDual bound multipliers:\n"); + NumericMetaDataMapType::const_iterator z_L_solution = var_numeric_md.find("sens_sol_state_1_z_L"); + NumericMetaDataMapType::const_iterator z_U_solution = var_numeric_md.find("sens_sol_state_1_z_U"); + if( z_L_solution != var_numeric_md.end() && z_U_solution != var_numeric_md.end() ) + { + for( Index k = 0; k < n; ++k ) + { + printf("z_L[%d] = %f z_U[%d] = %f\n", k, z_L_solution->second[k], k, z_U_solution->second[k]); + } + } + + // constraint mutlipliers + printf("\nConstraint multipliers:\n"); + NumericMetaDataMapType::const_iterator lambda_solution = con_numeric_md.find("sens_sol_state_1"); + if( lambda_solution != con_numeric_md.end() ) + { + for( Index k = 0; k < m; ++k ) + { + printf("lambda[%d] (upd) = %.14g\n", k, lambda_solution->second[k]); + } + } +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/parametric_dsdp_driver.cpp b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/parametric_dsdp_driver.cpp new file mode 100644 index 000000000..56c28936b --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/parametric_dsdp_cpp/parametric_dsdp_driver.cpp @@ -0,0 +1,172 @@ +// Copyright 2010, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2010-01-05 + +#include "parametricTNLP.hpp" + +#include "IpIpoptApplication.hpp" +#include "SensApplication.hpp" +#include "IpIpoptAlg.hpp" +#include "SensRegOp.hpp" + +int main( + int /*argv*/, + char** /*argc*/ +) +{ + using namespace Ipopt; + + SmartPtr app_ipopt = new IpoptApplication(); + + SmartPtr app_sens = new SensApplication(app_ipopt->Jnlst(), app_ipopt->Options(), + app_ipopt->RegOptions()); + + // Register sIPOPT options + RegisterOptions_sIPOPT(app_ipopt->RegOptions()); + app_ipopt->Options()->SetRegisteredOptions(app_ipopt->RegOptions()); + + // Call Initialize the first time to create a journalist, but ignore + // any options file + ApplicationReturnStatus retval; + retval = app_ipopt->Initialize(""); + if( retval != Solve_Succeeded ) + { + //printf("ampl_ipopt.cpp: Error in first Initialize!!!!\n"); + exit(-100); + } + app_ipopt->Initialize(); + + // create AmplSensTNLP from argc. This is an nlp because we are using our own TNLP Adapter + SmartPtr sens_tnlp = new ParametricTNLP(); + + app_ipopt->Options()->SetStringValueIfUnset("run_sens", "yes"); + app_ipopt->Options()->SetIntegerValueIfUnset("n_sens_steps", 1); + app_ipopt->Options()->SetStringValueIfUnset("compute_dsdp", "yes"); + + app_sens->Initialize(); + + retval = app_ipopt->OptimizeTNLP(sens_tnlp); + + /* give pointers to Ipopt algorithm objects to Sens Application */ + app_sens->SetIpoptAlgorithmObjects(app_ipopt, retval); + + printf("\n"); + printf("#-------------------------------------------\n"); + printf("# Sensitivity without bound checking\n"); + printf("#-------------------------------------------\n"); + + app_sens->Run(); + + Index m = app_sens->nl(); + Index n = app_sens->nx(); + Index nzl = app_sens->nzl(); + Index nzu = app_sens->nzu(); + Index np = app_sens->np(); + + Number* DDX = new Number[n]; + Number* DDL = new Number[m]; + Number* DDZL = new Number[nzl]; + Number* DDZU = new Number[nzu]; + + Number* SX = new Number[n * np]; + Number* SL = new Number[m * np]; + Number* SZL = new Number[nzl * np]; + Number* SZU = new Number[nzu * np]; + + app_sens->GetDirectionalDerivatives(DDX, DDL, DDZL, DDZU); + app_sens->GetSensitivityMatrix(SX, SL, SZL, SZU); + + printf("\n** Directional Derivative (Eq. 14 of implementation paper) ** \n"); + for( int i = 0; i < n; ++i ) + { + printf("* ds/dp(x)(p-p0)[%i] = %.14g\n", i + 1, DDX[i]); + } + for( int i = 0; i < m; ++i ) + { + printf("* ds/dp(l)(p-p0)[%i] = %.14g\n", i + 1, DDL[i]); + } + for( int i = 0; i < nzl; ++i ) + { + printf("* ds/dp(zl)(p-p0)[%i] = %.14g\n", i + 1, DDZL[i]); + } + for( int i = 0; i < nzu; ++i ) + { + printf("* ds/dp(zu)(p-p0)[%i] = %.14g\n", i + 1, DDZU[i]); + } + + printf("\n** Sensitivity Matrix (Eq. 9 of implementation paper) ** \n"); + for( int i = 0; i < n * np; ++i ) + { + printf("* ds/dp(x)[%i] = %.14g\n", i + 1, SX[i]); + } + for( int i = 0; i < m * np; ++i ) + { + printf("* ds/dp(l)[%i] = %.14g\n", i + 1, SL[i]); + } + for( int i = 0; i < nzl * np; ++i ) + { + printf("* ds/dp(zl)[%i] = %.14g\n", i + 1, SZL[i]); + } + for( int i = 0; i < nzu * np; ++i ) + { + printf("* ds/dp(zu)[%i] = %.14g\n", i + 1, SZU[i]); + } + + printf("\n"); + printf("#-------------------------------------------\n"); + printf("# Sensitivity with bound checking\n"); + printf("#-------------------------------------------\n"); + app_ipopt->Options()->SetStringValue("sens_boundcheck", "yes"); + app_sens->Run(); + + app_sens->GetDirectionalDerivatives(DDX, DDL, DDZL, DDZU); + app_sens->GetSensitivityMatrix(SX, SL, SZL, SZU); + + printf("\n** Directional Derivative (Eq. 14 of implementation paper) ** \n"); + for( int i = 0; i < n; ++i ) + { + printf("* ds/dp(x)(p-p0)[%i] = %.14g\n", i + 1, DDX[i]); + } + for( int i = 0; i < m; ++i ) + { + printf("* ds/dp(l)(p-p0)[%i] = %.14g\n", i + 1, DDL[i]); + } + for( int i = 0; i < nzl; ++i ) + { + printf("* ds/dp(zl)(p-p0)[%i] = %.14g\n", i + 1, DDZL[i]); + } + for( int i = 0; i < nzu; ++i ) + { + printf("* ds/dp(zu)(p-p0)[%i] = %.14g\n", i + 1, DDZU[i]); + } + + printf("\n** Sensitivity Matrix (Eq. 9 of implementation paper) ** \n"); + for( int i = 0; i < n * np; ++i ) + { + printf("* ds/dp(x)[%i] = %.14g\n", i + 1, SX[i]); + } + for( int i = 0; i < m * np; ++i ) + { + printf("* ds/dp(l)[%i] = %.14g\n", i + 1, SL[i]); + } + for( int i = 0; i < nzl * np; ++i ) + { + printf("* ds/dp(zl)[%i] = %.14g\n", i + 1, SZL[i]); + } + for( int i = 0; i < nzu * np; ++i ) + { + printf("* ds/dp(zu)[%i] = %.14g\n", i + 1, SZU[i]); + } + + delete[] SX; + delete[] SL; + delete[] SZL; + delete[] SZU; + delete[] DDX; + delete[] DDL; + delete[] DDZL; + delete[] DDZU; + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_ampl/red_hess.run b/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_ampl/red_hess.run new file mode 100644 index 000000000..33a8c4343 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_ampl/red_hess.run @@ -0,0 +1,37 @@ +# Copyright 2009, 2011 Hans Pirnay +# All Rights Reserved. +# This code is published under the Eclipse Public License. +# +# Date : 2010-10-04 + +# This AMPL script shows how to use the reduced hessian feature +# of the asNMPC code. + +reset; +option solver ipopt_sens; + +# set option to compute reduced hessian +option ipopt_options 'compute_red_hessian yes'; + +# turn presolve off so no variables / equations are eliminated +# by AMPL +option presolve 0; + +# Introduce the reduced hessian suffix +suffix red_hessian, IN; + +# define the variables +var x1:=25e7; +var x2:=0; +var x3:=0; + +# set the variables 2 and 3 free variables. The ordering of the +# variable suffixes will correspond to the ordering of the columns +let x2.red_hessian := 1; +let x3.red_hessian := 2; + +con1: x1+2*x2+3*x3=0; + +minimize obj: (x1-1)^2 +(x2-2)^2 + (x3-3)^2; + +solve; diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_cpp/Makefile.in b/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_cpp/Makefile.in new file mode 100644 index 000000000..d668e78de --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_cpp/Makefile.in @@ -0,0 +1,62 @@ +# Copyright (C) 2010 Hans Pirnay +# All Rights Reserved. +# This file is distributed under the Eclipse Public License. + +########################################################################## +# You can modify this example makefile to fit for your own program. # +# Usually, you only need to change the four CHANGEME entries below. # +########################################################################## + +# CHANGEME: This should be the name of your executable +EXE = redhess_cpp@EXEEXT@ + +# CHANGEME: Here is the name of all object files corresponding to the source +# code that you wrote in order to define the problem statement +OBJS = redhess_cpp.@OBJEXT@ \ + MySensTNLP.@OBJEXT@ + +# CHANGEME: Additional libraries +ADDLIBS = + +# CHANGEME: Additional flags for compilation (e.g., include flags) +ADDINCFLAGS = + +########################################################################## +# Usually, you don't have to change anything below. Note that if you # +# change certain compiler options, you might have to recompile Ipopt. # +########################################################################## + +# C++ Compiler command +CXX = @CXX@ + +# C++ Compiler options +CXXFLAGS = @CXXFLAGS@ + +# additional C++ Compiler options for linking +CXXLINKFLAGS = @RPATH_FLAGS@ + +prefix=@prefix@ +exec_prefix=@exec_prefix@ + +# TODO there should be an sipopt .pc file from which to get flags + +# Include directories +@COIN_HAS_PKGCONFIG_TRUE@INCL = `PKG_CONFIG_PATH=@COIN_PKG_CONFIG_PATH@ @PKG_CONFIG@ --cflags ipopt` $(ADDINCFLAGS) +@COIN_HAS_PKGCONFIG_FALSE@INCL = -I@includedir@/coin @IPOPTLIB_CFLAGS@ $(ADDINCFLAGS) + +# Linker flags +@COIN_HAS_PKGCONFIG_TRUE@LIBS = `PKG_CONFIG_PATH=@COIN_PKG_CONFIG_PATH@ @PKG_CONFIG@ --libs ipopt` -lsipopt +@COIN_HAS_PKGCONFIG_FALSE@LIBS = -L@libdir@ -lsipopt -lipopt @IPOPTLIB_LFLAGS@ + +all: $(EXE) + +.SUFFIXES: .cpp .@OBJEXT@ + +$(EXE): $(OBJS) + $(CXX) $(CXXLINKFLAGS) $(CXXFLAGS) -o $@ $(OBJS) $(LIBS) $(ADDLIBS) + +clean: + rm -rf $(EXE) $(OBJS) + +.cpp.@OBJEXT@: + $(CXX) $(CXXFLAGS) $(INCL) -c -o $@ $< diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp b/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp new file mode 100644 index 000000000..1e0385117 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.cpp @@ -0,0 +1,272 @@ +// Copyright 2009 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2010-10-04 + +#include "MySensTNLP.hpp" +#include "IpDenseVector.hpp" + +#include + +using namespace Ipopt; + +/* Constructor. */ +MySensTNLP::MySensTNLP() +{ } + +MySensTNLP::~MySensTNLP() +{ } + +bool MySensTNLP::get_nlp_info( + Index& n, + Index& m, + Index& nnz_jac_g, + Index& nnz_h_lag, + IndexStyleEnum& index_style +) +{ + // The problem has 3 variables + n = 3; + + // one equality constraint + m = 1; + + nnz_jac_g = 3; + + nnz_h_lag = 3; + + index_style = FORTRAN_STYLE; + + return true; +} + +bool MySensTNLP::get_bounds_info( + Index n, + Number* x_l, + Number* x_u, + Index m, + Number* g_l, + Number* g_u +) +{ + assert(n == 3); + (void) n; + assert(m == 1); + (void) m; + + for( Index k = 0; k < 3; k++ ) + { + x_l[k] = -1.0e19; + x_u[k] = +1.0e19; + } + + g_l[0] = 0.0; + g_u[0] = 0.0; + + return true; +} + +bool MySensTNLP::get_starting_point( + Index /*n*/, + bool /*init_x*/, + Number* x, + bool /*init_z*/, + Number* /*z_L*/, + Number* /*z_U*/, + Index /*m*/, + bool /*init_lambda*/, + Number* /*lambda*/ +) +{ + + x[0] = 25; + x[1] = 0; + x[2] = 0; + + return true; +} + +bool MySensTNLP::eval_f( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Number& obj_value +) +{ + // return the value of the objective function + Number x1 = x[0]; + Number x2 = x[1]; + Number x3 = x[2]; + obj_value = (x1 - 1) * (x1 - 1) + (x2 - 2) * (x2 - 2) + (x3 - 3) * (x3 - 3); + + return true; +} + +bool MySensTNLP::eval_grad_f( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Number* grad_f +) +{ + // return the gradient of the objective function grad_{x} f(x) + + Number x1 = x[0]; + Number x2 = x[1]; + Number x3 = x[2]; + + grad_f[0] = 2 * (x1 - 1); + grad_f[1] = 2 * (x2 - 2); + grad_f[2] = 2 * (x3 - 3); + + return true; +} + +bool MySensTNLP::eval_g( + Index /*n*/, + const Number* x, + bool /*new_x*/, + Index /*m*/, + Number* g +) +{ + // return the value of the constraints: g(x) + Number x1 = x[0]; + Number x2 = x[1]; + Number x3 = x[2]; + + g[0] = x1 + 2 * x2 + 3 * x3; + + return true; +} + +bool MySensTNLP::eval_jac_g( + Index /*n*/, + const Number* /*x*/, + bool /*new_x*/, + Index /*m*/, + Index /*nele_jac*/, + Index* iRow, + Index* jCol, + Number* values +) +{ + if( values == NULL ) + { + // return the structure of the jacobian of the constraints + + // element at 1,1: grad_{x1} g_{1}(x) + iRow[0] = 1; + jCol[0] = 1; + + // element at 1,2: grad_{x2} g_{1}(x) + iRow[1] = 1; + jCol[1] = 2; + + // element at 1,3: grad_{x3} g_{1}(x) + iRow[2] = 1; + jCol[2] = 3; + } + else + { + // return the values of the jacobian of the constraints + + // element at 1,1: grad_{x1} g_{1}(x) + values[0] = 1.0; + + // element at 1,2: grad_{x1} g_{1}(x) + values[1] = 2.0; + + values[2] = 3.0; + } + + return true; +} + +bool MySensTNLP::eval_h( + Index /*n*/, + const Number* /*x*/, + bool /*new_x*/, + Number /*obj_factor*/, + Index /*m*/, + const Number* /*lambda*/, + bool /*new_lambda*/, + Index /*nele_hess*/, + Index* iRow, + Index* jCol, + Number* values +) +{ + if( values == NULL ) + { + // return the structure. This is a symmetric matrix, fill the lower left + // triangle only. + + // element at 1,1: grad^2_{x1,x1} L(x,lambda) + iRow[0] = 1; + jCol[0] = 1; + + // element at 2,2: grad^2_{x2,x2} L(x,lambda) + iRow[1] = 2; + jCol[1] = 2; + + iRow[2] = 3; + jCol[2] = 3; + + // Note: off-diagonal elements are zero for this problem + } + else + { + // return the values + + // element at 1,1: grad^2_{x1,x1} L(x,lambda) + values[0] = 2.0; + + // element at 2,2: grad^2_{x2,x2} L(x,lambda) + values[1] = 2.0; + + values[2] = 2.0; + // Note: off-diagonal elements are zero for this problem + } + + return true; +} + +bool MySensTNLP::get_var_con_metadata( + Index /*n*/, + StringMetaDataMapType& /*var_string_md*/, + IntegerMetaDataMapType& var_integer_md, + NumericMetaDataMapType& /*var_numeric_md*/, + Index /*m*/, + StringMetaDataMapType& /*con_string_md*/, + IntegerMetaDataMapType& /*con_integer_md*/, + NumericMetaDataMapType& /*con_numeric_md*/ +) +{ + std::vector red_hess_idx(3, 0); + red_hess_idx[1] = 1; + red_hess_idx[2] = 2; + + var_integer_md["red_hessian"] = red_hess_idx; + + return true; +} + +void MySensTNLP::finalize_solution( + SolverReturn /*status*/, + Index /*n*/, + const Number* /*x*/, + const Number* /*z_L*/, + const Number* /*z_U*/, + Index /*m*/, + const Number* /*g*/, + const Number* /*lambda*/, + Number /*obj_value*/, + const IpoptData* /*ip_data*/, + IpoptCalculatedQuantities* /*ip_cq*/) +{ + // here is where we would store the solution to variables, or write to a file, etc + // so we could use the solution. Since the solution is displayed to the console, + // we currently do nothing here. +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.hpp b/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.hpp new file mode 100644 index 000000000..4dd046607 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_cpp/MySensTNLP.hpp @@ -0,0 +1,149 @@ +// Copyright 2009 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2010-10-04 + +#ifndef __MYSENSNLP_HPP__ +#define __MYSENSNLP_HPP__ + +#include "IpTNLP.hpp" + +namespace Ipopt +{ + +class MySensTNLP: public TNLP +{ +public: + + /** default constructor */ + MySensTNLP(); + + /** default destructor */ + virtual ~MySensTNLP(); + + /**@name Overloaded from TNLP */ + //@{ + virtual bool get_nlp_info( + Index& n, + Index& m, + Index& nnz_jac_g, + Index& nnz_h_lag, + IndexStyleEnum& index_style + ); + + virtual bool get_bounds_info( + Index n, + Number* x_l, + Number* x_u, + Index m, + Number* g_l, + Number* g_u + ); + + virtual bool get_starting_point( + Index n, + bool init_x, + Number* x, + bool init_z, + Number* z_L, + Number* z_U, + Index m, + bool init_lambda, + Number* lambda + ); + + virtual bool eval_f( + Index n, + const Number* x, + bool new_x, + Number& obj_value + ); + + virtual bool eval_grad_f( + Index n, + const Number* x, + bool new_x, + Number* grad_f + ); + + virtual bool eval_g( + Index n, + const Number* x, + bool new_x, + Index m, + Number* g + ); + + virtual bool eval_jac_g( + Index n, + const Number* x, + bool new_x, + Index m, + Index nele_jac, + Index* iRow, + Index* jCol, + Number* values + ); + + virtual bool eval_h( + Index n, + const Number* x, + bool new_x, + Number obj_factor, + Index m, + const Number* lambda, + bool new_lambda, + Index nele_hess, + Index* iRow, + Index* jCol, + Number* values + ); + + virtual bool get_var_con_metadata( + Index n, + StringMetaDataMapType& var_string_md, + IntegerMetaDataMapType& var_integer_md, + NumericMetaDataMapType& var_numeric_md, + Index m, + StringMetaDataMapType& con_string_md, + IntegerMetaDataMapType& con_integer_md, + NumericMetaDataMapType& con_numeric_md + ); + + virtual void finalize_solution( + SolverReturn status, + Index n, + const Number* x, + const Number* z_L, + const Number* z_U, + Index m, + const Number* g, + const Number* lambda, + Number obj_value, + const IpoptData* ip_data, + IpoptCalculatedQuantities* ip_cq + ); + +private: + /**@name Methods to block default compiler methods. + * The compiler automatically generates the following three methods. + * Since the default compiler implementation is generally not what + * you want (for all but the most simple classes), we usually + * put the declarations of these methods in the private section + * and never implement them. This prevents the compiler from + * implementing an incorrect "default" behavior without us + * knowing. (See Scott Meyers book, "Effective C++") + * + */ + //@{ + MySensTNLP( + const MySensTNLP&); + MySensTNLP& operator=( + const MySensTNLP&); + //@} +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp b/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp new file mode 100644 index 000000000..b560a30ba --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/examples/redhess_cpp/redhess_cpp.cpp @@ -0,0 +1,59 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2010-10-04 + +#include "MySensTNLP.hpp" + +#include "IpIpoptApplication.hpp" +#include "SensApplication.hpp" +#include "IpIpoptAlg.hpp" +#include "SensRegOp.hpp" + +int main( + int /*argv*/, + char** /*argc*/ +) +{ + + using namespace Ipopt; + + SmartPtr app_ipopt = new IpoptApplication(); + + SmartPtr app_sens = new SensApplication(app_ipopt->Jnlst(), app_ipopt->Options(), + app_ipopt->RegOptions()); + + // Register sIPOPT options + RegisterOptions_sIPOPT(app_ipopt->RegOptions()); + app_ipopt->Options()->SetRegisteredOptions(app_ipopt->RegOptions()); + + // Call Initialize the first time to create a journalist, but ignore + // any options file + ApplicationReturnStatus retval; + retval = app_ipopt->Initialize(""); + if( retval != Solve_Succeeded ) + { + //printf("ampl_ipopt.cpp: Error in first Initialize!!!!\n"); + exit(-100); + } + + app_ipopt->Initialize(); + + // create AmplSensTNLP from argc. This is an nlp because we are using our own TNLP Adapter + SmartPtr sens_tnlp = new MySensTNLP(); + + app_ipopt->Options()->SetStringValueIfUnset("compute_red_hessian", "yes"); + + app_sens->Initialize(); + + retval = app_ipopt->OptimizeTNLP(sens_tnlp); + + /* give pointers to Ipopt algorithm objects to Sens Application */ + app_sens->SetIpoptAlgorithmObjects(app_ipopt, retval); + + app_sens->Run(); + + return 0; + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/readme.txt b/Ipopt-3.13.4/contrib/sIPOPT/readme.txt new file mode 100644 index 000000000..d15934a27 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/readme.txt @@ -0,0 +1,23 @@ + sIPOPT Toolbox for IPOPT + ======================== + +This is the Sensitivity with IPOPT toolbox. Its purpose is to compute +fast approximate solutions when parameters in the NLP change. For +more information on the project please see the implementation paper, +or the project website. + +Documentation, tutorials and test examples can be found in the IPOPT +documentation as well as on the project documentation and website. + +Just like IPOPT, the sIPOPT code is separated into a library +"libsipopt" that holds the main algorithm, and an executable that acts +as a solver for AMPL. By default, the library is installed in the same +directory as libipopt, and the executable is installed in the same +directory as IPOPT's ampl executable. They are build in the same build +process as for main Ipopt, unless --disable-sipopt has been specified +for configure. + +Contact: The sIPOPT code was developed by Hans Pirnay (RWTH-Aachen), +Rodrigo Lopez-Negrete (CMU), and Prof. Lorenz Biegler (CMU). Any +questions / problems / bugs may be sent to the Hans Pirnay or the IPOPT +mailing list. diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/Makefile.am b/Ipopt-3.13.4/contrib/sIPOPT/src/Makefile.am new file mode 100644 index 000000000..6e08a3a9e --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/Makefile.am @@ -0,0 +1,49 @@ +# Copyright (C) 2004, 2008 International Business Machines and others. +# All Rights Reserved. +# This file is distributed under the Eclipse Public License. +# +# Authors: Carl Laird, Andreas Waechter, Hans Pirnay IBM 2009-12-19 + +includesipoptdir = $(includedir)/coin-or +includesipopt_HEADERS = \ + SensAlgorithm.hpp \ + SensApplication.hpp \ + SensBacksolver.hpp \ + SensMeasurement.hpp \ + SensPCalculator.hpp \ + SensRegOp.hpp \ + SensSchurData.hpp \ + SensSchurDriver.hpp \ + SensSimpleBacksolver.hpp \ + SensStepCalc.hpp \ + SensUtils.hpp + +lib_LTLIBRARIES = libsipopt.la + +libsipopt_la_SOURCES = \ + SensAlgorithm.cpp \ + SensRegOp.cpp \ + SensDenseGenSchurDriver.cpp \ + SensIndexPCalculator.cpp \ + SensIndexSchurData.cpp \ + SensMetadataMeasurement.cpp \ + SensApplication.cpp \ + SensUtils.cpp \ + SensReducedHessianCalculator.cpp \ + SensBuilder.cpp \ + SensSimpleBacksolver.cpp \ + SensStdStepCalc.cpp + +libsipopt_la_LIBADD = ../../../src/Interfaces/libipopt.la + +AM_LDFLAGS = $(LT_LDFLAGS) + +AM_CPPFLAGS = -DSIPOPTLIB_BUILD \ + -I$(srcdir)/../../../src/Common \ + -I$(srcdir)/../../../src/Interfaces \ + -I$(srcdir)/../../../src/LinAlg \ + -I$(srcdir)/../../../src/Algorithm/LinearSolvers \ + -I$(srcdir)/../../../src/LinAlg/TMatrices \ + -I$(srcdir)/../../../src/Algorithm \ + -I$(srcdir)/../../../src/Algorithm/Inexact \ + -I$(srcdir)/../../../src/contrib/CGPenalty diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/Makefile.in b/Ipopt-3.13.4/contrib/sIPOPT/src/Makefile.in new file mode 100644 index 000000000..4a49e6f01 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/Makefile.in @@ -0,0 +1,783 @@ +# Makefile.in generated by automake 1.16.2 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2020 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +# Copyright (C) 2004, 2008 International Business Machines and others. +# All Rights Reserved. +# This file is distributed under the Eclipse Public License. +# +# Authors: Carl Laird, Andreas Waechter, Hans Pirnay IBM 2009-12-19 + + +VPATH = @srcdir@ +am__is_gnu_make = { \ + if test -z '$(MAKELEVEL)'; then \ + false; \ + elif test -n '$(MAKE_HOST)'; then \ + true; \ + elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ + true; \ + else \ + false; \ + fi; \ +} +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = contrib/sIPOPT/src +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +DIST_COMMON = $(srcdir)/Makefile.am $(includesipopt_HEADERS) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/src/Common/config.h \ + $(top_builddir)/src/Common/config_ipopt.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; +am__install_max = 40 +am__nobase_strip_setup = \ + srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` +am__nobase_strip = \ + for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" +am__nobase_list = $(am__nobase_strip_setup); \ + for p in $$list; do echo "$$p $$p"; done | \ + sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ + $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ + if (++n[$$2] == $(am__install_max)) \ + { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ + END { for (dir in files) print dir, files[dir] }' +am__base_list = \ + sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ + sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' +am__uninstall_files_from_dir = { \ + test -z "$$files" \ + || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ + || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ + $(am__cd) "$$dir" && rm -f $$files; }; \ + } +am__installdirs = "$(DESTDIR)$(libdir)" \ + "$(DESTDIR)$(includesipoptdir)" +LTLIBRARIES = $(lib_LTLIBRARIES) +libsipopt_la_DEPENDENCIES = ../../../src/Interfaces/libipopt.la +am_libsipopt_la_OBJECTS = SensAlgorithm.lo SensRegOp.lo \ + SensDenseGenSchurDriver.lo SensIndexPCalculator.lo \ + SensIndexSchurData.lo SensMetadataMeasurement.lo \ + SensApplication.lo SensUtils.lo \ + SensReducedHessianCalculator.lo SensBuilder.lo \ + SensSimpleBacksolver.lo SensStdStepCalc.lo +libsipopt_la_OBJECTS = $(am_libsipopt_la_OBJECTS) +AM_V_lt = $(am__v_lt_@AM_V@) +am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@) +am__v_lt_0 = --silent +am__v_lt_1 = +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)/src/Common +depcomp = $(SHELL) $(top_srcdir)/depcomp +am__maybe_remake_depfiles = depfiles +am__depfiles_remade = ./$(DEPDIR)/SensAlgorithm.Plo \ + ./$(DEPDIR)/SensApplication.Plo ./$(DEPDIR)/SensBuilder.Plo \ + ./$(DEPDIR)/SensDenseGenSchurDriver.Plo \ + ./$(DEPDIR)/SensIndexPCalculator.Plo \ + ./$(DEPDIR)/SensIndexSchurData.Plo \ + ./$(DEPDIR)/SensMetadataMeasurement.Plo \ + ./$(DEPDIR)/SensReducedHessianCalculator.Plo \ + ./$(DEPDIR)/SensRegOp.Plo ./$(DEPDIR)/SensSimpleBacksolver.Plo \ + ./$(DEPDIR)/SensStdStepCalc.Plo ./$(DEPDIR)/SensUtils.Plo +am__mv = mv -f +CXXCOMPILE = $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) +LTCXXCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) \ + $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ + $(AM_CXXFLAGS) $(CXXFLAGS) +AM_V_CXX = $(am__v_CXX_@AM_V@) +am__v_CXX_ = $(am__v_CXX_@AM_DEFAULT_V@) +am__v_CXX_0 = @echo " CXX " $@; +am__v_CXX_1 = +CXXLD = $(CXX) +CXXLINK = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=link $(CXXLD) $(AM_CXXFLAGS) \ + $(CXXFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CXXLD = $(am__v_CXXLD_@AM_V@) +am__v_CXXLD_ = $(am__v_CXXLD_@AM_DEFAULT_V@) +am__v_CXXLD_0 = @echo " CXXLD " $@; +am__v_CXXLD_1 = +SOURCES = $(libsipopt_la_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +HEADERS = $(includesipopt_HEADERS) +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +ACLOCAL = @ACLOCAL@ +ADD_CFLAGS = @ADD_CFLAGS@ +ADD_CXXFLAGS = @ADD_CXXFLAGS@ +ADD_FFLAGS = @ADD_FFLAGS@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AR = @AR@ +AS = @AS@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +BIT32FCOMMENT = @BIT32FCOMMENT@ +BIT64FCOMMENT = @BIT64FCOMMENT@ +BITS_PER_POINTER = @BITS_PER_POINTER@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +COIN_PKG_CONFIG_PATH = @COIN_PKG_CONFIG_PATH@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CXX = @CXX@ +CXXCPP = @CXXCPP@ +CXXDEPMODE = @CXXDEPMODE@ +CXXFLAGS = @CXXFLAGS@ +CXXLIBS = @CXXLIBS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DLLTOOL = @DLLTOOL@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +F77 = @F77@ +FFLAGS = @FFLAGS@ +FGREP = @FGREP@ +FLIBS = @FLIBS@ +GREP = @GREP@ +HSLLIB_CFLAGS = @HSLLIB_CFLAGS@ +HSLLIB_CFLAGS_NOPC = @HSLLIB_CFLAGS_NOPC@ +HSLLIB_LFLAGS = @HSLLIB_LFLAGS@ +HSLLIB_LFLAGS_NOPC = @HSLLIB_LFLAGS_NOPC@ +HSLLIB_PCFILES = @HSLLIB_PCFILES@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +IPALLLIBS = @IPALLLIBS@ +IPOPTAMPLINTERFACELIB_CFLAGS = @IPOPTAMPLINTERFACELIB_CFLAGS@ +IPOPTAMPLINTERFACELIB_CFLAGS_NOPC = @IPOPTAMPLINTERFACELIB_CFLAGS_NOPC@ +IPOPTAMPLINTERFACELIB_LFLAGS = @IPOPTAMPLINTERFACELIB_LFLAGS@ +IPOPTAMPLINTERFACELIB_LFLAGS_NOPC = @IPOPTAMPLINTERFACELIB_LFLAGS_NOPC@ +IPOPTAMPLINTERFACELIB_PCFILES = @IPOPTAMPLINTERFACELIB_PCFILES@ +IPOPTLIB_CFLAGS = @IPOPTLIB_CFLAGS@ +IPOPTLIB_CFLAGS_NOPC = @IPOPTLIB_CFLAGS_NOPC@ +IPOPTLIB_LFLAGS = @IPOPTLIB_LFLAGS@ +IPOPTLIB_LFLAGS_NOPC = @IPOPTLIB_LFLAGS_NOPC@ +IPOPTLIB_PCFILES = @IPOPTLIB_PCFILES@ +JAR = @JAR@ +JAVA = @JAVA@ +JAVAC = @JAVAC@ +JAVADOC = @JAVADOC@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +LT_LDFLAGS = @LT_LDFLAGS@ +LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ +MAINT = @MAINT@ +MAKEINFO = @MAKEINFO@ +MANIFEST_TOOL = @MANIFEST_TOOL@ +MKDIR_P = @MKDIR_P@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PKG_CONFIG = @PKG_CONFIG@ +RANLIB = @RANLIB@ +RPATH_FLAGS = @RPATH_FLAGS@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +SIPOPTAMPLINTERFACELIB_CFLAGS = @SIPOPTAMPLINTERFACELIB_CFLAGS@ +SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC = @SIPOPTAMPLINTERFACELIB_CFLAGS_NOPC@ +SIPOPTAMPLINTERFACELIB_LFLAGS = @SIPOPTAMPLINTERFACELIB_LFLAGS@ +SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC = @SIPOPTAMPLINTERFACELIB_LFLAGS_NOPC@ +SIPOPTAMPLINTERFACELIB_PCFILES = @SIPOPTAMPLINTERFACELIB_PCFILES@ +STRIP = @STRIP@ +VERSION = @VERSION@ +_ACJNI_JAVAC = @_ACJNI_JAVAC@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_AR = @ac_ct_AR@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_CXX = @ac_ct_CXX@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +ac_ct_F77 = @ac_ct_F77@ +ac_ct_PKG_CONFIG = @ac_ct_PKG_CONFIG@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +coin_doxy_logname = @coin_doxy_logname@ +coin_doxy_tagfiles = @coin_doxy_tagfiles@ +coin_doxy_tagname = @coin_doxy_tagname@ +coin_doxy_usedot = @coin_doxy_usedot@ +coin_have_doxygen = @coin_have_doxygen@ +coin_have_latex = @coin_have_latex@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +includesipoptdir = $(includedir)/coin-or +includesipopt_HEADERS = \ + SensAlgorithm.hpp \ + SensApplication.hpp \ + SensBacksolver.hpp \ + SensMeasurement.hpp \ + SensPCalculator.hpp \ + SensRegOp.hpp \ + SensSchurData.hpp \ + SensSchurDriver.hpp \ + SensSimpleBacksolver.hpp \ + SensStepCalc.hpp \ + SensUtils.hpp + +lib_LTLIBRARIES = libsipopt.la +libsipopt_la_SOURCES = \ + SensAlgorithm.cpp \ + SensRegOp.cpp \ + SensDenseGenSchurDriver.cpp \ + SensIndexPCalculator.cpp \ + SensIndexSchurData.cpp \ + SensMetadataMeasurement.cpp \ + SensApplication.cpp \ + SensUtils.cpp \ + SensReducedHessianCalculator.cpp \ + SensBuilder.cpp \ + SensSimpleBacksolver.cpp \ + SensStdStepCalc.cpp + +libsipopt_la_LIBADD = ../../../src/Interfaces/libipopt.la +AM_LDFLAGS = $(LT_LDFLAGS) +AM_CPPFLAGS = -DSIPOPTLIB_BUILD \ + -I$(srcdir)/../../../src/Common \ + -I$(srcdir)/../../../src/Interfaces \ + -I$(srcdir)/../../../src/LinAlg \ + -I$(srcdir)/../../../src/Algorithm/LinearSolvers \ + -I$(srcdir)/../../../src/LinAlg/TMatrices \ + -I$(srcdir)/../../../src/Algorithm \ + -I$(srcdir)/../../../src/Algorithm/Inexact \ + -I$(srcdir)/../../../src/contrib/CGPenalty + +all: all-am + +.SUFFIXES: +.SUFFIXES: .cpp .lo .o .obj +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign contrib/sIPOPT/src/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign contrib/sIPOPT/src/Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +install-libLTLIBRARIES: $(lib_LTLIBRARIES) + @$(NORMAL_INSTALL) + @list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \ + list2=; for p in $$list; do \ + if test -f $$p; then \ + list2="$$list2 $$p"; \ + else :; fi; \ + done; \ + test -z "$$list2" || { \ + echo " $(MKDIR_P) '$(DESTDIR)$(libdir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(libdir)" || exit 1; \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(libdir)'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(libdir)"; \ + } + +uninstall-libLTLIBRARIES: + @$(NORMAL_UNINSTALL) + @list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \ + for p in $$list; do \ + $(am__strip_dir) \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(libdir)/$$f'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(libdir)/$$f"; \ + done + +clean-libLTLIBRARIES: + -test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES) + @list='$(lib_LTLIBRARIES)'; \ + locs=`for p in $$list; do echo $$p; done | \ + sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \ + sort -u`; \ + test -z "$$locs" || { \ + echo rm -f $${locs}; \ + rm -f $${locs}; \ + } + +libsipopt.la: $(libsipopt_la_OBJECTS) $(libsipopt_la_DEPENDENCIES) $(EXTRA_libsipopt_la_DEPENDENCIES) + $(AM_V_CXXLD)$(CXXLINK) -rpath $(libdir) $(libsipopt_la_OBJECTS) $(libsipopt_la_LIBADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensAlgorithm.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensApplication.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensBuilder.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensDenseGenSchurDriver.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensIndexPCalculator.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensIndexSchurData.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensMetadataMeasurement.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensReducedHessianCalculator.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensRegOp.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensSimpleBacksolver.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensStdStepCalc.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SensUtils.Plo@am__quote@ # am--include-marker + +$(am__depfiles_remade): + @$(MKDIR_P) $(@D) + @echo '# dummy' >$@-t && $(am__mv) $@-t $@ + +am--depfiles: $(am__depfiles_remade) + +.cpp.o: +@am__fastdepCXX_TRUE@ $(AM_V_CXX)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.o$$||'`;\ +@am__fastdepCXX_TRUE@ $(CXXCOMPILE) -MT $@ -MD -MP -MF $$depbase.Tpo -c -o $@ $< &&\ +@am__fastdepCXX_TRUE@ $(am__mv) $$depbase.Tpo $$depbase.Po +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ $(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ $< + +.cpp.obj: +@am__fastdepCXX_TRUE@ $(AM_V_CXX)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.obj$$||'`;\ +@am__fastdepCXX_TRUE@ $(CXXCOMPILE) -MT $@ -MD -MP -MF $$depbase.Tpo -c -o $@ `$(CYGPATH_W) '$<'` &&\ +@am__fastdepCXX_TRUE@ $(am__mv) $$depbase.Tpo $$depbase.Po +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ $(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` + +.cpp.lo: +@am__fastdepCXX_TRUE@ $(AM_V_CXX)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.lo$$||'`;\ +@am__fastdepCXX_TRUE@ $(LTCXXCOMPILE) -MT $@ -MD -MP -MF $$depbase.Tpo -c -o $@ $< &&\ +@am__fastdepCXX_TRUE@ $(am__mv) $$depbase.Tpo $$depbase.Plo +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ $(AM_V_CXX)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(LTCXXCOMPILE) -c -o $@ $< + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs +install-includesipoptHEADERS: $(includesipopt_HEADERS) + @$(NORMAL_INSTALL) + @list='$(includesipopt_HEADERS)'; test -n "$(includesipoptdir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(includesipoptdir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(includesipoptdir)" || exit 1; \ + fi; \ + for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + echo "$$d$$p"; \ + done | $(am__base_list) | \ + while read files; do \ + echo " $(INSTALL_HEADER) $$files '$(DESTDIR)$(includesipoptdir)'"; \ + $(INSTALL_HEADER) $$files "$(DESTDIR)$(includesipoptdir)" || exit $$?; \ + done + +uninstall-includesipoptHEADERS: + @$(NORMAL_UNINSTALL) + @list='$(includesipopt_HEADERS)'; test -n "$(includesipoptdir)" || list=; \ + files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ + dir='$(DESTDIR)$(includesipoptdir)'; $(am__uninstall_files_from_dir) + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags +check-am: all-am +check: check-am +all-am: Makefile $(LTLIBRARIES) $(HEADERS) +installdirs: + for dir in "$(DESTDIR)$(libdir)" "$(DESTDIR)$(includesipoptdir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-libLTLIBRARIES clean-libtool \ + mostlyclean-am + +distclean: distclean-am + -rm -f ./$(DEPDIR)/SensAlgorithm.Plo + -rm -f ./$(DEPDIR)/SensApplication.Plo + -rm -f ./$(DEPDIR)/SensBuilder.Plo + -rm -f ./$(DEPDIR)/SensDenseGenSchurDriver.Plo + -rm -f ./$(DEPDIR)/SensIndexPCalculator.Plo + -rm -f ./$(DEPDIR)/SensIndexSchurData.Plo + -rm -f ./$(DEPDIR)/SensMetadataMeasurement.Plo + -rm -f ./$(DEPDIR)/SensReducedHessianCalculator.Plo + -rm -f ./$(DEPDIR)/SensRegOp.Plo + -rm -f ./$(DEPDIR)/SensSimpleBacksolver.Plo + -rm -f ./$(DEPDIR)/SensStdStepCalc.Plo + -rm -f ./$(DEPDIR)/SensUtils.Plo + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: install-includesipoptHEADERS + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: install-libLTLIBRARIES + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -f ./$(DEPDIR)/SensAlgorithm.Plo + -rm -f ./$(DEPDIR)/SensApplication.Plo + -rm -f ./$(DEPDIR)/SensBuilder.Plo + -rm -f ./$(DEPDIR)/SensDenseGenSchurDriver.Plo + -rm -f ./$(DEPDIR)/SensIndexPCalculator.Plo + -rm -f ./$(DEPDIR)/SensIndexSchurData.Plo + -rm -f ./$(DEPDIR)/SensMetadataMeasurement.Plo + -rm -f ./$(DEPDIR)/SensReducedHessianCalculator.Plo + -rm -f ./$(DEPDIR)/SensRegOp.Plo + -rm -f ./$(DEPDIR)/SensSimpleBacksolver.Plo + -rm -f ./$(DEPDIR)/SensStdStepCalc.Plo + -rm -f ./$(DEPDIR)/SensUtils.Plo + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-includesipoptHEADERS uninstall-libLTLIBRARIES + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am am--depfiles check check-am clean \ + clean-generic clean-libLTLIBRARIES clean-libtool cscopelist-am \ + ctags ctags-am distclean distclean-compile distclean-generic \ + distclean-libtool distclean-tags dvi dvi-am html html-am info \ + info-am install install-am install-data install-data-am \ + install-dvi install-dvi-am install-exec install-exec-am \ + install-html install-html-am install-includesipoptHEADERS \ + install-info install-info-am install-libLTLIBRARIES \ + install-man install-pdf install-pdf-am install-ps \ + install-ps-am install-strip installcheck installcheck-am \ + installdirs maintainer-clean maintainer-clean-generic \ + mostlyclean mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \ + uninstall-am uninstall-includesipoptHEADERS \ + uninstall-libLTLIBRARIES + +.PRECIOUS: Makefile + + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensAlgorithm.cpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensAlgorithm.cpp new file mode 100644 index 000000000..190403489 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensAlgorithm.cpp @@ -0,0 +1,438 @@ +// Copyright 2009 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-16 + +#include "SensAlgorithm.hpp" +#include "SensUtils.hpp" +#include "IpSmartPtr.hpp" + +#include "IpVector.hpp" + +namespace Ipopt +{ +#if IPOPT_VERBOSITY > 0 +static const Index dbg_verbosity = 1; +#endif + +SensAlgorithm::SensAlgorithm( + std::vector >& driver_vec, + SmartPtr sens_step_calc, + SmartPtr measurement, + Index n_sens_steps +) + : DirectionalD_X_(NULL), + DirectionalD_L_(NULL), + DirectionalD_Z_L_(NULL), + DirectionalD_Z_U_(NULL), + SensitivityM_X_(NULL), + SensitivityM_L_(NULL), + SensitivityM_Z_L_(NULL), + SensitivityM_Z_U_(NULL), + driver_vec_(driver_vec), + sens_step_calc_(sens_step_calc), + measurement_(measurement), + n_sens_steps_(n_sens_steps) // why doesn't he get this from the options? +{ + DBG_START_METH("SensAlgorithm::SensAlgorithm", dbg_verbosity); + DBG_ASSERT(n_sens_steps <= (int)driver_vec.size()); +} + +SensAlgorithm::~SensAlgorithm() +{ + DBG_START_METH("SensAlgorithm::~SensAlgorithm", dbg_verbosity); + if( NULL != DirectionalD_X_ ) + { + delete[] DirectionalD_X_; + } + if( NULL != DirectionalD_L_ ) + { + delete[] DirectionalD_L_; + } + if( NULL != DirectionalD_Z_U_ ) + { + delete[] DirectionalD_Z_U_; + } + if( NULL != DirectionalD_Z_L_ ) + { + delete[] DirectionalD_Z_L_; + } + if( NULL != SensitivityM_X_ ) + { + delete[] SensitivityM_X_; + } + if( NULL != SensitivityM_L_ ) + { + delete[] SensitivityM_L_; + } + if( NULL != SensitivityM_Z_U_ ) + { + delete[] SensitivityM_Z_U_; + } + if( NULL != SensitivityM_Z_L_ ) + { + delete[] SensitivityM_Z_L_; + } +} + +bool SensAlgorithm::InitializeImpl( + const OptionsList& /*options*/, + const std::string& /*prefix*/ +) +{ + // initialize values for variable sizes, and allocate memory for sensitivity vectors + nx_ = dynamic_cast(GetRawPtr(IpData().curr()->x()))->Dim(); + nceq_ = dynamic_cast(GetRawPtr(IpData().curr()->y_c()))->Dim(); + ncineq_ = dynamic_cast(GetRawPtr(IpData().curr()->y_d()))->Dim(); + nzl_ = dynamic_cast(GetRawPtr(IpData().curr()->z_L()))->Dim(); + nzu_ = dynamic_cast(GetRawPtr(IpData().curr()->z_U()))->Dim(); + nl_ = nceq_ + ncineq_; + + ns_ = nx_ + nl_ + nzl_ + nzu_; + + DirectionalD_X_ = new Number[nx_]; + if( NULL == DirectionalD_X_ ) + { + return false; + } + DirectionalD_L_ = new Number[nceq_ + ncineq_]; + if( NULL == DirectionalD_L_ ) + { + return false; + } + DirectionalD_Z_L_ = new Number[nzl_]; + if( NULL == DirectionalD_Z_L_ ) + { + return false; + } + DirectionalD_Z_U_ = new Number[nzu_]; + if( NULL == DirectionalD_Z_U_ ) + { + return false; + } + + std::string state; + std::string statevalue; + + state = "sens_init_constr"; + statevalue = "sens_init_constr"; + + SmartPtr x_owner_space_ = dynamic_cast( + GetRawPtr(IpData().curr()->y_c()->OwnerSpace())); + const std::vector idx_ipopt = x_owner_space_->GetIntegerMetaData(state.c_str()); + + np_ = 0; + for( Index i = 0; i < (int) idx_ipopt.size(); ++i ) + { + if( idx_ipopt[i] > 0 ) + { + ++np_; + } + } + + SensitivityM_X_ = new Number[nx_ * np_]; + if( NULL == SensitivityM_X_ ) + { + return false; + } + SensitivityM_L_ = new Number[nl_ * np_]; + if( NULL == SensitivityM_L_ ) + { + return false; + } + SensitivityM_Z_L_ = new Number[nzl_ * np_]; + if( NULL == SensitivityM_Z_L_ ) + { + return false; + } + SensitivityM_Z_U_ = new Number[nzu_ * np_]; + if( NULL == SensitivityM_Z_U_ ) + { + return false; + } + return true; +} + +/** Main loop: Wait for new measurement, Get new step, maybe deal with + * bounds, see to it that everything happens in the required + * timeframe. */ +SensAlgorithmExitStatus SensAlgorithm::Run() +{ + DBG_START_METH("SensAlgorithm::Run", dbg_verbosity); + + SensAlgorithmExitStatus retval = SOLVE_SUCCESS; + + /* Loop through all steps */ + SmartPtr < IteratesVector > sol = IpData().curr()->MakeNewIteratesVector(); + SmartPtr < DenseVector > delta_u; + SmartPtr unscaled_x; + SmartPtr unscaled_yc; + + SmartPtr < IteratesVector > trialcopy; + for( Index step_i = 0; step_i < n_sens_steps_; ++step_i ) + { + sens_step_calc_->SetSchurDriver(driver_vec_[step_i]); + delta_u = measurement_->GetMeasurement(step_i + 1); + delta_u->Print(Jnlst(), J_VECTOR, J_USER1, "delta_u"); + sens_step_calc_->Step(*delta_u, *sol); + SmartPtr < IteratesVector > saved_sol = sol->MakeNewIteratesVectorCopy(); + saved_sol->Print(Jnlst(), J_VECTOR, J_USER1, "sol_vec"); + + // unscale solution... + UnScaleIteratesVector (&saved_sol); + + // update variables + measurement_->SetSolution(step_i + 1, saved_sol); + + // get sensitivity vector + GetDirectionalDerivatives(); + + } + + return retval; +} + +SensAlgorithmExitStatus SensAlgorithm::ComputeSensitivityMatrix(void) +{ + DBG_START_METH("SensAlgorithm::ComputeSensitivityMatrix", dbg_verbosity); + + SensAlgorithmExitStatus retval = SOLVE_SUCCESS; + + /* Loop through all steps */ + SmartPtr < IteratesVector > sol = IpData().curr()->MakeNewIteratesVector(); + SmartPtr unscaled_x; + SmartPtr unscaled_yc; + + SmartPtr < IteratesVector > trialcopy; + + SmartPtr < DenseVectorSpace > delta_u_space; + delta_u_space = new DenseVectorSpace(2); + + SmartPtr < DenseVector > delta_u = new DenseVector(GetRawPtr(ConstPtr(delta_u_space))); + + Number* du_val = delta_u->Values(); + + std::string state; + std::string statevalue; + + state = "sens_init_constr"; + statevalue = "sens_init_constr"; + + SmartPtr x_owner_space_ = dynamic_cast( + GetRawPtr(IpData().curr()->y_c()->OwnerSpace())); + //= dynamic_cast(GetRawPtr(IpData().curr()->x()->OwnerSpace())); + + const std::vector idx_ipopt = x_owner_space_->GetIntegerMetaData(state.c_str()); + + char buffer[250]; + + Index col = 0; + for( Index Scol = 0; Scol < (int) idx_ipopt.size(); ++Scol ) + { + + if( idx_ipopt[Scol] > 0 ) + { + + // reset rhs vector to zero + for( Index j = 0; j < (int) idx_ipopt.size(); ++j ) + { + if( idx_ipopt[j] > 0 ) + { + du_val[idx_ipopt[j] - 1] = 0; + } + } + + sprintf(buffer, "Column %i", idx_ipopt[Scol]); + + sens_step_calc_->SetSchurDriver(driver_vec_[0]); + + // set rhs to 1 (eq. 9-10) + du_val[idx_ipopt[Scol] - 1] = 1; + + delta_u->SetValues(du_val); + //delta_u->Print(Jnlst(),J_VECTOR,J_USER1,"delta_u 1234567"); + sens_step_calc_->Step(*delta_u, *sol); + SmartPtr < IteratesVector > saved_sol = sol->MakeNewIteratesVectorCopy(); + saved_sol->Print(Jnlst(), J_VECTOR, J_USER1, "sol_vec"); + + // unscale solution... + UnScaleIteratesVector (&saved_sol); + + saved_sol->Print(Jnlst(), J_VECTOR, J_USER1, buffer); + + // Save column + GetSensitivityMatrix(col); + ++col; // increase column counter + } + } + return retval; +} + +void SensAlgorithm::GetSensitivityMatrix( + Index col +) +{ + + /* + Extract sensitivity vector for each vector type primal, + lagrange, and bound multipliers(zl,zu) of column col of S. + */ + + Index offset; + + SmartPtr < IteratesVector > SV = sens_step_calc_->GetSensitivityVector(); + UnScaleIteratesVector (&SV); + + const Number* X_ = dynamic_cast(GetRawPtr((*SV).x()))->Values(); + offset = col * nx_; + for( int i = 0; i < nx_; ++i ) + { + //printf(" ds/dp(X)[%3d] = %.14g\n", i+1, X_[i]); + SensitivityM_X_[i + offset] = X_[i]; + } + + const Number* Z_L_ = dynamic_cast(GetRawPtr((*SV).z_L()))->Values(); + offset = col * nzl_; + for( int i = 0; i < nzl_; ++i ) + { + //printf(" ds/dp(X)[%3d] = %.14g\n", i+1, X_[i]); + SensitivityM_Z_L_[i + offset] = Z_L_[i]; + } + + const Number* Z_U_ = dynamic_cast(GetRawPtr((*SV).z_U()))->Values(); + offset = col * nzu_; + for( int i = 0; i < nzu_; ++i ) + { + //printf(" ds/dp(X)[%3d] = %.14g\n", i+1, X_[i]); + SensitivityM_Z_U_[i + offset] = Z_U_[i]; + } + + const Number* LE_ = dynamic_cast(GetRawPtr((*SV).y_c()))->Values(); + offset = col * nl_; + for( int i = 0; i < nceq_; ++i ) + { + //printf(" ds/dp(LE)[%3d] = %.14g\n", i+1, LE_[i]); + SensitivityM_L_[i + offset] = LE_[i]; + } + + const Number* LIE_ = dynamic_cast(GetRawPtr((*SV).y_d()))->Values(); + for( int i = 0; i < ncineq_; ++i ) + { + //printf(" ds/dp(LIE)[%3d] = %.14g\n", i+1, LIE_[i]); + SensitivityM_L_[i + nceq_ + offset] = LIE_[i]; + } + +} + +void SensAlgorithm::GetDirectionalDerivatives(void) +{ + /* + Extract directional derivative vector for each vector type + primal, lagrange, and bound multipliers(zl,zu) + */ + SmartPtr < IteratesVector > SV = sens_step_calc_->GetSensitivityVector(); + UnScaleIteratesVector (&SV); + + const Number* X_ = dynamic_cast(GetRawPtr((*SV).x()))->Values(); + + for( int i = 0; i < nx_; ++i ) + { + //printf(" ds/dp(X)[%3d] = %.14g\n", i+1, X_[i]); + DirectionalD_X_[i] = X_[i]; + } + + const Number* Z_L_ = dynamic_cast(GetRawPtr((*SV).z_L()))->Values(); + for( int i = 0; i < nzl_; ++i ) + { + //printf(" ds/dp(X)[%3d] = %.14g\n", i+1, X_[i]); + DirectionalD_Z_L_[i] = Z_L_[i]; + } + + const Number* Z_U_ = dynamic_cast(GetRawPtr((*SV).z_U()))->Values(); + for( int i = 0; i < nzu_; ++i ) + { + //printf(" ds/dp(X)[%3d] = %.14g\n", i+1, X_[i]); + DirectionalD_Z_U_[i] = Z_U_[i]; + } + + const Number* LE_ = dynamic_cast(GetRawPtr((*SV).y_c()))->Values(); + for( int i = 0; i < nceq_; ++i ) + { + //printf(" ds/dp(LE)[%3d] = %.14g\n", i+1, LE_[i]); + DirectionalD_L_[i] = LE_[i]; + } + + const Number* LIE_ = dynamic_cast(GetRawPtr((*SV).y_d()))->Values(); + for( int i = 0; i < ncineq_; ++i ) + { + //printf(" ds/dp(LIE)[%3d] = %.14g\n", i+1, LIE_[i]); + DirectionalD_L_[i + nceq_] = LIE_[i]; + } + +} + +void SensAlgorithm::UnScaleIteratesVector( + SmartPtr* V +) +{ + + // unscale the iterates vector + // pretty much a copy from IpOrigIpopt::finalize_solution + + SmartPtr unscaled_x; + unscaled_x = IpNLP().NLP_scaling()->unapply_vector_scaling_x((*V)->x()); + DBG_ASSERT(IsValid(unscaled_x)); + (*V)->Set_x(*unscaled_x); + unscaled_x = NULL; + + SmartPtr Px_L = IpNLP().Px_L(); + SmartPtr Px_U = IpNLP().Px_U(); + SmartPtr x_space = IpNLP().x_space(); + + SmartPtr y_c = (*V)->y_c(); + SmartPtr y_d = (*V)->y_d(); + + SmartPtr z_L = (*V)->z_L(); + SmartPtr z_U = (*V)->z_U(); + + // unscale y_c + SmartPtr unscaled_yc; + SmartPtr unscaled_yd; + SmartPtr unscaled_z_L; + SmartPtr unscaled_z_U; + + Number obj_unscale_factor = IpNLP().NLP_scaling()->unapply_obj_scaling(1.); + if( obj_unscale_factor != 1. ) + { + SmartPtr < Vector > tmp = IpNLP().NLP_scaling()->apply_vector_scaling_x_LU_NonConst(*Px_L, z_L, *x_space); + tmp->Scal(obj_unscale_factor); + unscaled_z_L = ConstPtr(tmp); + + tmp = IpNLP().NLP_scaling()->apply_vector_scaling_x_LU_NonConst(*Px_U, z_U, *x_space); + tmp->Scal(obj_unscale_factor); + unscaled_z_U = ConstPtr(tmp); + + tmp = IpNLP().NLP_scaling()->apply_vector_scaling_c_NonConst(y_c); + tmp->Scal(obj_unscale_factor); + unscaled_yc = ConstPtr(tmp); + + tmp = IpNLP().NLP_scaling()->apply_vector_scaling_d_NonConst(y_d); + tmp->Scal(obj_unscale_factor); + unscaled_yd = ConstPtr(tmp); + } + else + { + unscaled_z_L = IpNLP().NLP_scaling()->apply_vector_scaling_x_LU(*Px_L, z_L, *x_space); + unscaled_z_U = IpNLP().NLP_scaling()->apply_vector_scaling_x_LU(*Px_U, z_U, *x_space); + unscaled_yc = IpNLP().NLP_scaling()->apply_vector_scaling_c(y_c); + unscaled_yd = IpNLP().NLP_scaling()->apply_vector_scaling_d(y_d); + } + + (*V)->Set_z_U(*unscaled_z_U); + (*V)->Set_z_L(*unscaled_z_L); + (*V)->Set_y_c(*unscaled_yc); + (*V)->Set_y_d(*unscaled_yd); +} + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensAlgorithm.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensAlgorithm.hpp new file mode 100644 index 000000000..0e79b1437 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensAlgorithm.hpp @@ -0,0 +1,114 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-06 + +#ifndef __SENSALGORITHM_HPP__ +#define __SENSALGORITHM_HPP__ + +#include "IpAlgStrategy.hpp" +#include "SensStepCalc.hpp" +#include "SensMeasurement.hpp" +#include "SensSchurDriver.hpp" +#include "SensUtils.hpp" + +namespace Ipopt +{ + +/** This is the interface for the actual controller. + * + * It handles Data input to the controller (measurement) and returns controls. + */ +class SIPOPTLIB_EXPORT SensAlgorithm : public AlgorithmStrategyObject +{ +public: + SensAlgorithm( + std::vector< SmartPtr >& driver_vec, + SmartPtr sens_step_calc, + SmartPtr measurement, + Index n_sens_steps + ); + + virtual ~SensAlgorithm(); + + virtual bool InitializeImpl( + const OptionsList& options, + const std::string& prefix + ); + + /** Main loop: Wait for new measurement, Get new step, maybe deal with + * bounds, see to it that everything happens in the required + * timeframe. */ + SensAlgorithmExitStatus Run(); + SensAlgorithmExitStatus ComputeSensitivityMatrix(void); + + /** accessor methods to get access to variable sizes */ + Index nl(void) + { + return nl_; + } + Index nx(void) + { + return nx_; + } + Index nzl(void) + { + return nzl_; + } + Index nzu(void) + { + return nzu_; + } + Index ns(void) + { + return ns_; + } + Index np(void) + { + return np_; + } + + /** array place holders to store the vector of sensitivities */ + Number* DirectionalD_X_; + Number* DirectionalD_L_; + Number* DirectionalD_Z_L_; + Number* DirectionalD_Z_U_; + + /** array place holders for the sensitivity matrix */ + Number* SensitivityM_X_; + Number* SensitivityM_L_; + Number* SensitivityM_Z_L_; + Number* SensitivityM_Z_U_; + +private: + Index nl_; + Index nx_; + Index nzl_; + Index nzu_; + Index nceq_; + Index ncineq_; + Index ns_; + Index np_; + + std::vector< SmartPtr > driver_vec_; + SmartPtr sens_step_calc_; + SmartPtr measurement_; + Index n_sens_steps_; // I think it is useful to state this number explicitly in the constructor and here. + + /** method to extract sensitivity vectors */ + void GetDirectionalDerivatives(void); + + /** method to extract sensitivity matrix */ + void GetSensitivityMatrix( + Index col + ); + + /** private method used to uncale perturbed solution and sensitivities */ + void UnScaleIteratesVector( + SmartPtr* V + ); +}; +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensApplication.cpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensApplication.cpp new file mode 100644 index 000000000..f1bc7092f --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensApplication.cpp @@ -0,0 +1,416 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-11 + +#include "SensApplication.hpp" +#include "SensBuilder.hpp" +#include "SensUtils.hpp" +#include "SensRegOp.hpp" + +// Ipopt includes +#include "IpPDSearchDirCalc.hpp" +#include "IpIpoptAlg.hpp" + +namespace Ipopt +{ +#if IPOPT_VERBOSITY > 0 +static const Index dbg_verbosity = 1; +#endif + +SensApplication::SensApplication( + SmartPtr jnlst, + SmartPtr options, + SmartPtr reg_options +) + : DirectionalD_X(NULL), + DirectionalD_L(NULL), + DirectionalD_Z_L(NULL), + DirectionalD_Z_U(NULL), + SensitivityM_X(NULL), + SensitivityM_L(NULL), + SensitivityM_Z_L(NULL), + SensitivityM_Z_U(NULL), + jnlst_(jnlst), + options_(options), + reg_options_(reg_options), + ipopt_retval_(Internal_Error), + controller(NULL) +{ + DBG_START_METH("SensApplication::SensApplication", dbg_verbosity); + + // Initialize Journalist + DBG_DO(SmartPtr sens_jrnl = jnlst_->AddFileJournal("Sensitivity", "sensdebug.out", J_ITERSUMMARY); + sens_jrnl->SetPrintLevel(J_USER1, J_ALL)); + +} + +SensApplication::~SensApplication() +{ + DBG_START_METH("SensApplication::~SensApplication", dbg_verbosity); +} + +void SensApplication::RegisterOptions( + SmartPtr roptions +) +{ + // Options for parameter sensitivity + roptions->SetRegisteringCategory("sIPOPT"); + roptions->AddLowerBoundedIntegerOption("n_sens_steps", + "Number of steps computed by sIPOPT", + 0, 1); + roptions->AddStringOption2("sens_boundcheck", + "Activate boundcheck and re-solve for sIPOPT", + "no", + "no", "don't check bounds and do another SchurSolve", + "yes", "check bounds and resolve Schur decomposition", + "If this option is activated, the algorithm will check the iterate after an initial Schursolve and will resolve the decomposition if any bounds are not satisfied"); + roptions->AddLowerBoundedNumberOption("sens_bound_eps", + "Bound accuracy within which a bound still is considered to be valid", + 0, true, 1e-3, + "The schur complement solution cannot make sure that variables stay inside bounds. " + "I cannot use the primal-frac-to-the-bound step because I don't know if the initial iterate is feasible. " + "To make things easier for me I have decided to make bounds not so strict."); + roptions->AddStringOption2("compute_red_hessian", + "Determines if reduced Hessian should be computed", + "no", + "yes", "compute reduced hessian", + "no", "don't compute reduced hessian"); + roptions->AddStringOption2("compute_dsdp", + "Determines if matrix of sensitivites should be computed", + "no", + "yes", "compute matrix of sensitivites", + "no", "don't compute matrix of sensitivities"); + // This option must be in IpInterfacesRegOp.cpp + roptions->AddStringOption2("run_sens", + "Determines if sIPOPT alg runs", + "no", + "yes", "run sIPOPT", + "no", "don't run sIPOPT"); + roptions->AddStringOption2("sens_internal_abort", + "Internal option - if set (internally), sens algorithm is not conducted", + "no", + "yes", "abort sIPOPT", + "no", "run sIPOPT"); + roptions->AddStringOption2("redhess_internal_abort", + "Internal option - if set (internally), reduced hessian computation is not conducted", + "no", + "yes", "abort redhess computation", + "no", "run redhess computation"); + roptions->AddStringOption2("ignore_suffix_error", + "If set, IPOPT runs even if there are errors in the suffixes", + "no", + "yes", "don't abort on suffix error", + "no", "abort on suffix error"); + roptions->AddLowerBoundedNumberOption("sens_max_pdpert", + "Maximum perturbation of primal dual system, for that the sIPOPT algorithm will not abort", + 0.0, true, 1e-3, + "For certain problems, IPOPT uses inertia correction of the primal dual matrix to achieve " + "better convergence properties. This inertia correction changes the matrix and renders it " + "useless for the use with sIPOPT. This option sets an upper bound, which the inertia correction " + "may have. If any of the inertia correction values is above this bound, the sIPOPT algorithm " + "is aborted."); + roptions->AddStringOption2("rh_eigendecomp", + "If yes, the eigenvalue decomposition of the reduced hessian matrix is computed", + "no", + "yes", "compute eigenvalue decomposition of reduced hessian", + "no", "don't compute eigenvalue decomposition of reduced hessian", + "The eigenvalue decomposition of the reduced hessian has different meanings depending on the specific problem. For parameter estimation problems, the eigenvalues are linked to the confidence interval of the parameters. See for example Victor Zavala's Phd thesis, chapter 4 for details."); + roptions->AddStringOption2("sens_allow_inexact_backsolve", + "Allow inexact computation of backsolve in sIPOPT.", + "yes", + "yes", "Allow inexact computation of backsolve in sIPOPT.", + "no", "Don't allow inexact computation of backsolve in sIPOPT."); + roptions->AddStringOption2("sens_kkt_residuals", + "For sensitivity solution, take KKT residuals into account", + "yes", + "yes", "Take residuals into account", + "no", "Don't take residuals into account", + "The residuals of the KKT conditions should be zero at the optimal solution. However, in practice, especially for large problems and depending on the termination criteria, they may deviate from this theoretical state. If this option is set to yes, the residuals will be taken into account when computing the right hand side for the sensitivity step."); +} + +SensAlgorithmExitStatus SensApplication::Run() +{ + DBG_START_METH("SensApplication::Run", dbg_verbosity); + + SensAlgorithmExitStatus retval = SOLVE_SUCCESS; + + bool sens_internal_abort, redhess_internal_abort; + Options()->GetBoolValue("sens_internal_abort", sens_internal_abort, ""); + Options()->GetBoolValue("redhess_internal_abort", redhess_internal_abort, ""); + if( run_sens_ && sens_internal_abort ) + { + jnlst_->Printf(J_WARNING, J_MAIN, + "\n\t--------------= Warning =--------------\nInternal abort has been called for the sensitivity calculations.\n"); + } + if( compute_red_hessian_ && redhess_internal_abort ) + { + jnlst_->Printf(J_WARNING, J_MAIN, + "\n\t--------------= Warning =--------------\nInternal abort has been called for the sensitivity calculations.\n"); + } + + SolverReturn status = AppReturn2SolverReturn(ipopt_retval_); + + // Check for perturbation of primal dual system + Number max_pdpert; + if( ipopt_retval_ == 0 || ipopt_retval_ == 1 ) + { + // otherwise, the values might not be available + Options()->GetNumericValue("sens_max_pdpert", max_pdpert, ""); + Number pdpert_x, pdpert_s, pdpert_c, pdpert_d; + ip_data_->getPDPert(pdpert_x, pdpert_s, pdpert_c, pdpert_d); + if( Max(pdpert_x, pdpert_s, pdpert_c, pdpert_d) > max_pdpert ) + { + jnlst_->Printf(J_WARNING, J_MAIN, + "\n\t--------------= Warning =--------------\nInertia correction of primal dual system is too large for meaningful sIPOPT results.\n" + "\t... aborting computation.\n" + "Set option sens_max_pdpert to a higher value (current: %f) to run sIPOPT algorithm anyway\n", + max_pdpert); + sens_internal_abort = true; + redhess_internal_abort = true; + } + } + + if( compute_red_hessian_ && !redhess_internal_abort ) + { + SmartPtr schur_builder = new SensBuilder(); + const std::string prefix = ""; // I should be getting this somewhere else... + SmartPtr red_hess_calc = schur_builder->BuildRedHessCalc(*jnlst_, *options_, prefix, + *ip_nlp_, *ip_data_, *ip_cq_, *pd_solver_); + + red_hess_calc->ComputeReducedHessian(); + } + if( run_sens_ && n_sens_steps_ > 0 && !sens_internal_abort ) + { + SmartPtr schur_builder = new SensBuilder(); + const std::string prefix = ""; // I should be getting this somewhere else... + /* + SmartPtr controller = schur_builder->BuildSensAlg(*jnlst_, + *options_, + prefix, + *ip_nlp_, + *ip_data_, + *ip_cq_, + *pd_solver_); + */ + controller = schur_builder->BuildSensAlg(*jnlst_, *options_, prefix, *ip_nlp_, *ip_data_, *ip_cq_, *pd_solver_); + retval = controller->Run(); + + if( compute_dsdp_ ) + { + controller->ComputeSensitivityMatrix(); + } + } + else if( run_sens_ ) + { + if( n_sens_steps_ <= 0 ) + { + jnlst_->Printf(J_WARNING, J_MAIN, "\n" + "The run_sens option was set to true, but the specified\n" + "number of sensitivity steps was set to zero.\n" + "Computation is aborted.\n\n"); + } + } + + if( IsValid(ip_data_->curr()) && IsValid(ip_data_->curr()->x()) ) + { + // point pointers to sensitivity vectors... + // only if controller (sens_app) is created + if( NULL != GetRawPtr(controller) ) + { + DirectionalD_X = controller->DirectionalD_X_; + DirectionalD_L = controller->DirectionalD_L_; + DirectionalD_Z_L = controller->DirectionalD_Z_L_; + DirectionalD_Z_U = controller->DirectionalD_Z_U_; + + if( compute_dsdp_ ) + { + SensitivityM_X = controller->SensitivityM_X_; + SensitivityM_L = controller->SensitivityM_L_; + SensitivityM_Z_L = controller->SensitivityM_Z_L_; + SensitivityM_Z_U = controller->SensitivityM_Z_U_; + } + } + SmartPtr c; + SmartPtr d; + SmartPtr zL; + SmartPtr zU; + SmartPtr yc; + SmartPtr yd; + Number obj = 0.; + + switch( status ) + { + case SUCCESS: + /*c = ip_cq_->curr_c(); + d = ip_cq_->curr_d(); + obj = ip_cq_->curr_f(); + zL = ip_data_->curr()->z_L(); + zU = ip_data_->curr()->z_U(); + yc = ip_data_->curr()->y_c(); + yd = ip_data_->curr()->y_d();*/ + case MAXITER_EXCEEDED: + case STOP_AT_TINY_STEP: + case STOP_AT_ACCEPTABLE_POINT: + case LOCAL_INFEASIBILITY: + case USER_REQUESTED_STOP: + case FEASIBLE_POINT_FOUND: + case DIVERGING_ITERATES: + case RESTORATION_FAILURE: + case ERROR_IN_STEP_COMPUTATION: + c = ip_cq_->curr_c(); + d = ip_cq_->curr_d(); + obj = ip_cq_->curr_f(); + zL = ip_data_->curr()->z_L(); + zU = ip_data_->curr()->z_U(); + yc = ip_data_->curr()->y_c(); + yd = ip_data_->curr()->y_d(); + break; + default: + SmartPtr tmp = ip_data_->curr()->y_c()->MakeNew(); + tmp->Set(0.); + c = ConstPtr(tmp); + yc = ConstPtr(tmp); + tmp = ip_data_->curr()->y_d()->MakeNew(); + tmp->Set(0.); + d = ConstPtr(tmp); + yd = ConstPtr(tmp); + tmp = ip_data_->curr()->z_L()->MakeNew(); + tmp->Set(0.); + zL = ConstPtr(tmp); + tmp = ip_data_->curr()->z_U()->MakeNew(); + tmp->Set(0.); + zU = ConstPtr(tmp); + } + + if( compute_red_hessian_ && redhess_internal_abort ) + { + jnlst_->Printf(J_WARNING, J_MAIN, "\nReduced hessian was not computed " + "because an error occured.\n" + "See exception message above for details.\n\n"); + } + if( run_sens_ && sens_internal_abort ) + { + jnlst_->Printf(J_WARNING, J_MAIN, "\nsIPOPT was not called " + "because an error occured.\n" + "See exception message above for details.\n\n"); + } + + ip_nlp_->FinalizeSolution(status, *ip_data_->curr()->x(), *zL, *zU, *c, *d, *yc, *yd, obj, GetRawPtr(ip_data_), + GetRawPtr(ip_cq_)); + } + return retval; +} + +void SensApplication::Initialize() +{ + DBG_START_METH("SensApplication::Initialize", dbg_verbosity); + + const std::string prefix = ""; // I should be getting this somewhere else... + + Options()->GetIntegerValue("n_sens_steps", n_sens_steps_, prefix.c_str()); + Options()->GetBoolValue("run_sens", run_sens_, prefix.c_str()); + Options()->GetBoolValue("compute_red_hessian", compute_red_hessian_, prefix.c_str()); + Options()->GetBoolValue("compute_dsdp", compute_dsdp_, prefix.c_str()); + + if( compute_dsdp_ && !run_sens_ ) + { + // cannot compute sensitivities if run_sens is not active. + jnlst_->Printf(J_WARNING, J_INITIALIZATION, + "Compute sensitivity matrix was chosed but run_sens is set to no.\nReverting compute sensitivities to no.\n"); + compute_dsdp_ = false; + } + + // make sure run_sens and skip_finalize_solution_call are consistent + if( run_sens_ || compute_red_hessian_ ) + { + Options()->SetStringValue("skip_finalize_solution_call", "yes"); + } + else + { + Options()->SetStringValue("skip_finalize_solution_call", "no"); + } + +} + +void SensApplication::SetIpoptAlgorithmObjects( + SmartPtr app_ipopt, + ApplicationReturnStatus ipopt_retval +) +{ + DBG_START_METH("SensApplication::SetIpoptAlgorithmObjects", dbg_verbosity); + + // get optionsList and Journalist + options_ = app_ipopt->Options(); + jnlst_ = app_ipopt->Jnlst(); + ipopt_retval_ = ipopt_retval; + + // Check whether Ipopt solved to optimality - if not, end computation. + if( ipopt_retval != Solve_Succeeded && ipopt_retval != Solved_To_Acceptable_Level ) + { + jnlst_->Printf(J_ERROR, J_MAIN, "sIPOPT: Aborting sIPOPT computation, because IPOPT did not succeed\n\n"); + options_->SetStringValue("sens_internal_abort", "yes"); + options_->SetStringValue("redhess_internal_abort", "yes"); + } + + // get pointers from IpoptApplication assessor methods + SmartPtr alg = app_ipopt->AlgorithmObject(); + + SmartPtr pd_search; + pd_search = dynamic_cast(GetRawPtr(alg->SearchDirCalc())); + + // get PD_Solver + pd_solver_ = pd_search->PDSolver(); + + // get data + ip_data_ = app_ipopt->IpoptDataObject(); + + // get calulated quantities + ip_cq_ = app_ipopt->IpoptCQObject(); + + // get NLP + ip_nlp_ = app_ipopt->IpoptNLPObject(); + + options_->GetIntegerValue("n_sens_steps", n_sens_steps_, ""); + + // This checking should be rewritten + /* if (false && run_sens_) { + // check suffixes + std::string state; + std::string state_value; + const Index* index; + const Number* number; + Index n_sens_indices, n_this_nmpc_indices; + // collect information from suffixes + state = "sens_state_1"; + //index = ampl_tnlp_->get_index_suffix(state.c_str()); + if (index==NULL) { + THROW_EXCEPTION(NMPC_SUFFIX_ERROR, "Suffix sens_state_1 is not set"); + } + n_nmpc_indices = AsIndexSum(ip_data_->curr()->x()->Dim(), index, 1); + for (Index i=1; i<=n_sens_steps_; ++i) { + state = "sens_state_"; + state_value = "sens_state_value_"; + append_Index(state, i); + append_Index(state_value, i); + //index = ampl_tnlp_->get_index_suffix(state.c_str()); + if (index==NULL) { + std::string msg = "Suffix " + state + " is not set"; + THROW_EXCEPTION(NMPC_SUFFIX_ERROR, msg); + } + n_this_nmpc_indices = AsIndexSum(ip_data_->curr()->x()->Dim(), index, 1); + if (n_this_nmpc_indices!=n_nmpc_indices) { + std::string msg = "Suffix" + state + "does not have the correct number of flags"; + THROW_EXCEPTION(NMPC_SUFFIX_ERROR, msg); + } + //number = ampl_tnlp_->get_number_suffix(state_value.c_str()); + if (number==NULL) { + std::string msg = "Suffix " + state_value + " is not set"; + THROW_EXCEPTION(NMPC_SUFFIX_ERROR, msg); + } + } + } */ +} + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensApplication.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensApplication.hpp new file mode 100644 index 000000000..c9e62f4d3 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensApplication.hpp @@ -0,0 +1,188 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-06 + +#ifndef __SENSAPPLICATION_HPP__ +#define __SENSAPPLICATION_HPP__ + +#include "IpReferenced.hpp" +#include "SensUtils.hpp" +#include "SensUtils.hpp" +#include "SensAlgorithm.hpp" +#include "IpRegOptions.hpp" + +#include "IpIpoptApplication.hpp" +#include "IpPDSystemSolver.hpp" + +#include "IpSmartPtr.hpp" + +namespace Ipopt +{ +/** Standard exception for wrong/inconsistent suffixes for sipopt */ +DECLARE_STD_SIPOPT_EXCEPTION(SENS_SUFFIX_ERROR); + +class SIPOPTLIB_EXPORT SensApplication: public ReferencedObject +{ +public: + // constructor + SensApplication( + SmartPtr jnlst, + SmartPtr options, + SmartPtr reg_options + ); + + ~SensApplication(); + + static void RegisterOptions( + SmartPtr roptions + ); + + SensAlgorithmExitStatus Run(); + + void Initialize(); + + void SetIpoptAlgorithmObjects( + SmartPtr app_ipopt, + ApplicationReturnStatus ipopt_retval + ); + + SmartPtr Jnlst() + { + return jnlst_; + } + + SmartPtr Options() + { + return options_; + } + + /** Get the options list for setting options (const version) */ + SmartPtr Options() const + { + return ConstPtr(options_); + } + + /** Copy over value of Directional Derivatives K^(-1)N_p(p-p0) */ + void GetDirectionalDerivatives( + Number* SX, + Number* SL, + Number* SZL, + Number* SZU + ) + { + if( GetRawPtr(controller) != NULL && NULL != DirectionalD_X && NULL != DirectionalD_Z_L + && NULL != DirectionalD_Z_U && NULL != DirectionalD_L ) + { + + for( int i = 0; i < controller->nx(); ++i ) + { + SX[i] = DirectionalD_X[i]; + } + for( int i = 0; i < controller->nzu(); ++i ) + { + SZU[i] = DirectionalD_Z_U[i]; + } + for( int i = 0; i < controller->nzl(); ++i ) + { + SZL[i] = DirectionalD_Z_L[i]; + } + for( int i = 0; i < controller->nl(); ++i ) + { + SL[i] = DirectionalD_L[i]; + } + } + } + + /** Copy over value of ds/dp */ + void GetSensitivityMatrix( + Number* SX, + Number* SL, + Number* SZL, + Number* SZU + ) + { + if( GetRawPtr(controller) != NULL && NULL != SensitivityM_X && NULL != SensitivityM_Z_L + && NULL != SensitivityM_Z_U && NULL != SensitivityM_L ) + { + for( int i = 0; i < controller->nx() * controller->np(); ++i ) + { + SX[i] = SensitivityM_X[i]; + } + for( int i = 0; i < controller->nzu() * controller->np(); ++i ) + { + SZU[i] = SensitivityM_Z_U[i]; + } + for( int i = 0; i < controller->nzl() * controller->np(); ++i ) + { + SZL[i] = SensitivityM_Z_L[i]; + } + for( int i = 0; i < controller->nl() * controller->np(); ++i ) + { + SL[i] = SensitivityM_L[i]; + } + + } + } + + /** accessor methods to get sizing info */ + Index nx() + { + return (GetRawPtr(controller) != NULL) ? controller->nx() : -1; + } + Index nl() + { + return (GetRawPtr(controller) != NULL) ? controller->nl() : -1; + } + Index nzu() + { + return (GetRawPtr(controller) != NULL) ? controller->nzu() : -1; + } + Index nzl() + { + return (GetRawPtr(controller) != NULL) ? controller->nzl() : -1; + } + Index np() + { + return (GetRawPtr(controller) != NULL) ? controller->np() : -1; + } + + /* place holders to keep the values of the directional derivatives for each type of variable */ + Number* DirectionalD_X; + Number* DirectionalD_L; + Number* DirectionalD_Z_L; + Number* DirectionalD_Z_U; + + /* place holders to keep the values of ds/dp for each type of variable */ + Number* SensitivityM_X; + Number* SensitivityM_L; + Number* SensitivityM_Z_L; + Number* SensitivityM_Z_U; + +private: + // standard constructor just so it can't be used + // SensApplication(); + + // Pointers that are immediately passed from Ipopt and initialized by the constructor + SmartPtr jnlst_; + SmartPtr options_; + SmartPtr ip_data_; + SmartPtr ip_cq_; + SmartPtr pd_solver_; + SmartPtr ip_nlp_; + SmartPtr reg_options_; + ApplicationReturnStatus ipopt_retval_; + + SmartPtr controller; + + /** storing options values */ + bool run_sens_; + bool compute_red_hessian_; + bool compute_dsdp_; + Index n_sens_steps_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensBacksolver.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensBacksolver.hpp new file mode 100644 index 000000000..44af2bc68 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensBacksolver.hpp @@ -0,0 +1,36 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-14 + +#ifndef __ASASBACKSOLVER_HPP__ +#define __ASASBACKSOLVER_HPP__ + +#include "IpAlgStrategy.hpp" +#include "IpIteratesVector.hpp" + +namespace Ipopt +{ + +class SIPOPTLIB_EXPORT SensBacksolver: public AlgorithmStrategyObject +{ + + /** This class is the interface to all backsolvers that may + * be used for the sIPOPT. */ +public: + SensBacksolver() + { } + + virtual ~SensBacksolver() + { } + + virtual bool Solve( + SmartPtr delta_lhs, + SmartPtr delta_rhs + ) = 0; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensBuilder.cpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensBuilder.cpp new file mode 100644 index 000000000..4df819ce3 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensBuilder.cpp @@ -0,0 +1,164 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-10 + +#include "SensBuilder.hpp" +#include "SensPCalculator.hpp" +#include "SensIndexPCalculator.hpp" +#include "SensSchurData.hpp" +#include "SensIndexSchurData.hpp" +#include "SensDenseGenSchurDriver.hpp" +#include "SensMeasurement.hpp" +#include "SensMetadataMeasurement.hpp" +#include "SensStdStepCalc.hpp" + +#include +#include + +namespace Ipopt +{ +#if IPOPT_VERBOSITY > 0 +static const Index dbg_verbosity = 1; +#endif + +SensBuilder::SensBuilder() +{ + DBG_START_METH("SensBuilder::SensBuilder", dbg_verbosity); +} + +SensBuilder::~SensBuilder() +{ + DBG_START_METH("SensBuilder::~SensBuilder", dbg_verbosity); +} + +SmartPtr SensBuilder::BuildSensAlg( + const Journalist& jnlst, + const OptionsList& options, + const std::string& prefix, + IpoptNLP& ip_nlp, + IpoptData& ip_data, + IpoptCalculatedQuantities& ip_cq, + PDSystemSolver& pd_solver +) +{ + DBG_START_METH("SensBuilder::BuildSensAlg", dbg_verbosity); + + // Very first thing is setting trial = curr. + SmartPtr trialcopyvector = ip_data.curr()->MakeNewIteratesVectorCopy(); + ip_data.set_trial(trialcopyvector); + + // Check options which Backsolver to use here + SmartPtr backsolver = new SimpleBacksolver(&pd_solver); + + // Create measurement unit + SmartPtr measurement = new MetadataMeasurement(); + (dynamic_cast(GetRawPtr(measurement)))->Initialize(jnlst, ip_nlp, ip_data, ip_cq, options, + prefix); + + // Check ParameterData, send it to Pcalculator + SmartPtr E_0; + E_0 = new IndexSchurData(); + + std::vector initial_c = measurement->GetInitialEqConstraints(); // type: List + E_0->SetData_List(initial_c); + E_0->Print(jnlst, J_VECTOR, J_USER1, "E_0"); + + SmartPtr pcalc; + bool bound_check; + options.GetBoolValue("sens_boundcheck", bound_check, prefix); + if( bound_check ) + { + pcalc = new IndexPCalculator(backsolver, new IndexSchurData()); + bool retval = pcalc->Initialize(jnlst, ip_nlp, ip_data, ip_cq, options, prefix); + DBG_ASSERT(retval); + (void) retval; + } + + // Find out how many steps there are and create as many SchurSolveDrivers + int n_sens_steps; + options.GetIntegerValue("n_sens_steps", n_sens_steps, prefix); + + // Create std::vector container in which we are going to keep the SchurDrivers + std::vector > driver_vec(n_sens_steps); + + /** Here there should be the point to pass on the driver_vec and fork off the + * Schurcomputations to a different function/process if needed. */ + std::vector sens_state_list; + Index schur_retval; + std::string E_i_name; + + /** THIS FOR-LOOP should be done better with a better + * Measurement class. This should get it's own branch! */ + for( Index i = 0; i < n_sens_steps; ++i ) + { + driver_vec[i] = new DenseGenSchurDriver(backsolver, pcalc, E_0); + driver_vec[i]->Initialize(jnlst, ip_nlp, ip_data, ip_cq, options, prefix); + schur_retval = driver_vec[i]->SchurBuild(); + DBG_ASSERT(schur_retval); + schur_retval = driver_vec[i]->SchurFactorize(); + DBG_ASSERT(schur_retval); + (void) schur_retval; + } + + SmartPtr sens_stepper = new StdStepCalculator(E_0, backsolver); + + sens_stepper->Initialize(jnlst, ip_nlp, ip_data, ip_cq, options, prefix); + + SmartPtr controller = new SensAlgorithm(driver_vec, sens_stepper, measurement, n_sens_steps); + + controller->Initialize(jnlst, ip_nlp, ip_data, ip_cq, options, prefix); + return controller; +} + +SmartPtr SensBuilder::BuildRedHessCalc( + const Journalist& jnlst, + const OptionsList& options, + const std::string& prefix, + IpoptNLP& ip_nlp, + IpoptData& ip_data, + IpoptCalculatedQuantities& ip_cq, + PDSystemSolver& pd_solver +) +{ + DBG_START_METH("SensBuilder::BuildRedHessCalc", dbg_verbosity); + + // Check options which Backsolver to use here + SmartPtr backsolver = new SimpleBacksolver(&pd_solver); + + // Create suffix handler + SmartPtr suffix_handler = new MetadataMeasurement(); + dynamic_cast(GetRawPtr(suffix_handler))->Initialize(jnlst, ip_nlp, ip_data, ip_cq, options, + prefix); + SmartPtr E_0; + E_0 = new IndexSchurData(); + + std::vector hessian_suff = suffix_handler->GetIntegerSuffix("red_hessian"); + + Index setdata_error = E_0->SetData_Index(hessian_suff.size(), &hessian_suff[0], 1.0); + if( setdata_error ) + { + jnlst.Printf(J_ERROR, J_MAIN, + "\nEXIT: An Error Occured while processing the Indices for the reduced Hessian computation: " + "Something is wrong with index %d\n", setdata_error); + THROW_EXCEPTION(SENS_BUILDER_ERROR, "Reduced Hessian Index Error"); + } + + SmartPtr pcalc; + pcalc = new IndexPCalculator(backsolver, E_0); + + bool retval = pcalc->Initialize(jnlst, ip_nlp, ip_data, ip_cq, options, prefix); + DBG_ASSERT(retval); + (void) retval; + + pcalc->ComputeP(); + + SmartPtr red_hess_calc = new ReducedHessianCalculator(E_0, pcalc); + + red_hess_calc->Initialize(jnlst, ip_nlp, ip_data, ip_cq, options, prefix); + + return red_hess_calc; +} + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensBuilder.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensBuilder.hpp new file mode 100644 index 000000000..05d314f04 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensBuilder.hpp @@ -0,0 +1,53 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-10 + +#ifndef __ASSCHURBUILDER_HPP__ +#define __ASSCHURBUILDER_HPP__ + +#include "IpReferenced.hpp" +#include "SensAlgorithm.hpp" +#include "IpPDSystemSolver.hpp" +#include "SensUtils.hpp" +#include "SensReducedHessianCalculator.hpp" + +namespace Ipopt +{ +DECLARE_STD_SIPOPT_EXCEPTION(SENS_BUILDER_ERROR); + +class SensBuilder: public ReferencedObject +{ + /** This class sets up everything necessary and + * builds the P matrix which is an intermediate step + * in calculating the schur matrix. */ +public: + SensBuilder(); + + ~SensBuilder(); + + SmartPtr BuildSensAlg( + const Journalist& jnlst, + const OptionsList& options, + const std::string& prefix, + IpoptNLP& ip_nlp, + IpoptData& ip_data, + IpoptCalculatedQuantities& ip_cq, + PDSystemSolver& pd_solver + ); + + SmartPtr BuildRedHessCalc( + const Journalist& jnlst, + const OptionsList& options, + const std::string& prefix, + IpoptNLP& ip_nlp, + IpoptData& ip_data, + IpoptCalculatedQuantities& ip_cq, + PDSystemSolver& pd_solver + ); +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensDenseGenSchurDriver.cpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensDenseGenSchurDriver.cpp new file mode 100644 index 000000000..80bdb131a --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensDenseGenSchurDriver.cpp @@ -0,0 +1,106 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-11-19 + +#include "SensDenseGenSchurDriver.hpp" +#include "SensIndexSchurData.hpp" + +namespace Ipopt +{ +#if IPOPT_VERBOSITY > 0 +static const Index dbg_verbosity = 1; +#endif + +DenseGenSchurDriver::DenseGenSchurDriver( + SmartPtr backsolver, + SmartPtr pcalc, + SmartPtr /*data_B*/ +) + : SchurDriver(pcalc, new IndexSchurData()), + backsolver_(backsolver), + S_(NULL) +{ + DBG_START_METH("DenseGenSchurDriver::DenseGenSchurDriver", dbg_verbosity); +} + +DenseGenSchurDriver::~DenseGenSchurDriver() +{ + DBG_START_METH("DenseGenSchurDriver::~DenseGenSchurDriver", dbg_verbosity); +} + +bool DenseGenSchurDriver::SchurBuild() +{ + DBG_START_METH("DenseGenSchurDriver::SchurBuild", dbg_verbosity); + /* This function is the very same as the one in DenseGenSchurDriver */ + bool retval = true; + Index dim_S = 0; + if( IsValid(data_B()) ) + { + dim_S = data_B()->GetNRowsAdded(); + } + if( dim_S > 0 ) + { + S_ = NULL; + SmartPtr S_space = new DenseGenMatrixSpace(dim_S, dim_S); + S_ = new DenseGenMatrix(GetRawPtr(S_space)); + SmartPtr S2 = GetRawPtr(S_); + //retval = pcalc_nonconst()->GetSchurMatrix(GetRawPtr(data_B()), dynamic_cast(GetRawPtr(S_))); + retval = pcalc_nonconst()->GetSchurMatrix(data_B(), S2); + S_->Print(Jnlst(), J_VECTOR, J_USER1, "S_"); + } + return retval; +} + +bool DenseGenSchurDriver::SchurFactorize() +{ + DBG_START_METH("DenseGenSchurDriver::SchurFactorize", dbg_verbosity); + /* This function is the very same as the one in DenseGenSchurDriver */ + bool retval; + if( IsValid(S_) ) + { + retval = S_->ComputeLUFactorInPlace(); + return retval; + } + return true; +} + +/* The functions SchurSolve do IFT step, if S_==NULL, and DenseGenSchurDriver otherwise. */ +bool DenseGenSchurDriver::SchurSolve( + SmartPtr lhs, ///< new left hand side will be stored here + SmartPtr rhs, ///< rhs r_s + SmartPtr delta_u, ///< should be (u_p - u_0) WATCH OUT FOR THE SIGN! I like it this way, so that u_0+delta_u = u_p, but victor always used it the other way round, so be careful. At the end, delta_nu is saved in here. + SmartPtr sol ///< the vector K^(-1)*r_s which usually should have been computed before. +) +{ + DBG_START_METH("DenseGenSchurDriver::SchurSolve", dbg_verbosity); + DBG_ASSERT(IsValid(S_)); + bool retval; + + // set up rhs of equation (3.48a) + SmartPtr delta_rhs = delta_u->MakeNew(); + data_B()->Multiply(*sol, *delta_rhs); + delta_rhs->Print(Jnlst(), J_VECTOR, J_USER1, "delta_rhs"); + delta_rhs->Scal(-1.0); + delta_rhs->Axpy(1.0, *delta_u); + delta_rhs->Print(Jnlst(), J_VECTOR, J_USER1, "rhs 3.48a"); + + // solve equation (3.48a) for delta_nu + SmartPtr delta_nu = dynamic_cast(GetRawPtr(delta_rhs))->MakeNewDenseVector(); + delta_nu->Copy(*delta_rhs); + S_->LUSolveVector(*delta_nu); // why is LUSolveVector not bool?? + delta_nu->Print(Jnlst(), J_VECTOR, J_USER1, "delta_nu"); + + // solve equation (3.48b) for lhs (=delta_s) + SmartPtr new_rhs = lhs->MakeNewIteratesVector(); + data_A()->TransMultiply(*delta_nu, *new_rhs); + new_rhs->Axpy(-1.0, *rhs); + new_rhs->Scal(-1.0); + new_rhs->Print(Jnlst(), J_VECTOR, J_USER1, "new_rhs"); + retval = backsolver_->Solve(lhs, ConstPtr(new_rhs)); + + return retval; +} + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensDenseGenSchurDriver.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensDenseGenSchurDriver.hpp new file mode 100644 index 000000000..7cf881c82 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensDenseGenSchurDriver.hpp @@ -0,0 +1,73 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-11-19 + +#ifndef __ASIFTSCHURDRIVER_HPP__ +#define __ASIFTSCHURDRIVER_HPP__ + +#include "SensSchurDriver.hpp" +#include "SensBacksolver.hpp" +#include "IpDenseGenMatrix.hpp" + +namespace Ipopt +{ + +class DenseGenSchurDriver: public SchurDriver +{ + +public: + DenseGenSchurDriver( + SmartPtr backsolver, + SmartPtr pcalc, + SmartPtr data_B + ); + + virtual ~DenseGenSchurDriver(); + + /** Creates the SchurMatrix from B and P */ + virtual bool SchurBuild(); + + /** Calls the factorization routine for the SchurMatrix */ + virtual bool SchurFactorize(); + + /** Performs a backsolve on S and : Solves the system + * + * \f$\left[\begin{array}{c|c} + * K & E\\\hline + * E^T & 0 + * \end{array} + * \right] + * \left[\begin{array}{c}x\\y\end{array}\right] = + * \left[\begin{array}{c}f\\g\end{array}\right]\f$ + * + * y will be stored in g at exit. + * Kf should hold + * + * \f$K^{-1}f\f$ + * + * if it has been computed previously. If it is not available, just + * pass in Kf=NULL and it will be computed internally. + */ + virtual bool SchurSolve( + SmartPtr x, + SmartPtr f, + SmartPtr g, + SmartPtr Kf = NULL + ); + + /** DEPRECATED Performs a backsolve on S and K + virtual bool SchurSolve(SmartPtr lhs, + SmartPtr rhs, + SmartPtr delta_u); + */ +private: + SmartPtr ift_data_; + SmartPtr backsolver_; + SmartPtr S_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensIndexPCalculator.cpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensIndexPCalculator.cpp new file mode 100644 index 000000000..e4151f625 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensIndexPCalculator.cpp @@ -0,0 +1,235 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-27 + +#include "SensIndexPCalculator.hpp" +#include "SensIndexSchurData.hpp" +#include "IpDenseVector.hpp" +#include "IpDenseGenMatrix.hpp" +#include "IpBlas.hpp" +#include + +namespace Ipopt +{ +#if IPOPT_VERBOSITY > 0 +static const Index dbg_verbosity = 1; +#endif + +IndexPCalculator::IndexPCalculator( + SmartPtr backsolver, + SmartPtr A_data +) + : PCalculator(backsolver, A_data), + nrows_(0), + ncols_(A_data->GetNRowsAdded()) +{ + DBG_START_METH("IndexPCalculator::IndexPCalculator", dbg_verbosity); +} + +IndexPCalculator::~IndexPCalculator() +{ + DBG_START_METH("IndexPCalculator::~IndexPCalculator", dbg_verbosity); +} + +bool IndexPCalculator::InitializeImpl( + const OptionsList& /*options*/, + const std::string& /*prefix*/ +) +{ + DBG_START_METH("IndexPCalculator::InitializeImpl", dbg_verbosity); + + SmartPtr iv = IpData().curr(); + nrows_ = 0; + for( Index i = 0; i < iv->NComps(); ++i ) + { + nrows_ += iv->GetComp(i)->Dim(); + } + data_A()->Print(Jnlst(), J_VECTOR, J_USER1, "PCalc SchurData"); + + return true; +} + +bool IndexPCalculator::ComputeP() +{ + DBG_START_METH("IndexPCalculator::ComputeP", dbg_verbosity); + bool retval = true; + + // 1. check whether all columns needed by data_A() are in map cols_ - we suppose data_A is IndexSchurData + const std::vector* p2col_idx = dynamic_cast(GetRawPtr(data_A()))->GetColIndices(); + Index col; + Number* col_values = NULL; + Index curr_dim, curr_schur_row = 0; + SmartPtr comp_vec; + const Number* comp_values; + std::map >::iterator find_it; + SmartPtr col_vec = IpData().curr()->MakeNewIteratesVector(); + SmartPtr sol_vec = col_vec->MakeNewIteratesVector(); + for( std::vector::const_iterator col_it = p2col_idx->begin(); col_it != p2col_idx->end(); ++col_it ) + { + col = *col_it; + + find_it = cols_.find(col); + if( find_it == cols_.end() ) + { + // column is in data_A but not in P-matrix ->create + data_A()->GetRow(curr_schur_row, *col_vec); + retval = Solver()->Solve(sol_vec, ConstPtr(col_vec)); + DBG_ASSERT(retval); + + /* This part is for displaying norm2(I_z*K^(-1)*I_1) */ + DBG_PRINT((dbg_verbosity, "\ncurr_schur_row=%d, ", curr_schur_row)); + DBG_PRINT((dbg_verbosity, "norm2(z)=%23.16e\n", sol_vec->x()->Nrm2())); + /* end displaying norm2 */ + + DBG_ASSERT(col_values == NULL); + col_values = new Number[nrows_]; + curr_dim = 0; + for( Index j = 0; j < sol_vec->NComps(); ++j ) + { + comp_vec = dynamic_cast(GetRawPtr(sol_vec->GetComp(j))); + comp_values = comp_vec->Values(); + IpBlasDcopy(comp_vec->Dim(), comp_values, 1, col_values + curr_dim, 1); + curr_dim += comp_vec->Dim(); + } + cols_[col] = new PColumn(col_values); + col_values = NULL; + } + curr_schur_row++; + } + + return retval; +} + +bool IndexPCalculator::GetSchurMatrix( + const SmartPtr& B, + SmartPtr& S +) +{ + DBG_START_METH("IndexPCalculator::GetSchurMatrix", dbg_verbosity); + bool retval = true; + + Number* S_values; + if( !IsValid(S) ) + { + if( B == data_A() ) + { + SmartPtr S_sym_space = new DenseSymMatrixSpace(B->GetNRowsAdded()); + SmartPtr dS = new DenseSymMatrix(GetRawPtr(S_sym_space)); + S_values = dS->Values(); + S = GetRawPtr(dS); + } + else + { + SmartPtr S_sym_space = new DenseGenMatrixSpace(B->GetNRowsAdded(), B->GetNRowsAdded()); + SmartPtr dS = new DenseGenMatrix(GetRawPtr(S_sym_space)); + S_values = dS->Values(); + S = GetRawPtr(dS); + } + } + else + { + // Try DenseGenMatrix - if NULL, try DenseSymMatrix + SmartPtr dS_gen = dynamic_cast(GetRawPtr(S)); + if( !IsValid(dS_gen) ) + { + SmartPtr dS_sym = dynamic_cast(GetRawPtr(S)); + S_values = dS_sym->Values(); + } + else + { + S_values = dS_gen->Values(); + } + } + /* + DenseGenMatrix* dS = static_cast(&S); + DBG_ASSERT(dynamic_cast(&S)); + */ + // Check whether data_A was changed from the outside + if( ncols_ != data_A()->GetNRowsAdded() ) + { + ncols_ = data_A()->GetNRowsAdded(); + ComputeP(); + } + /* + DBG_ASSERT(dS->NRows()==dS->NCols()); + DBG_ASSERT(dS->NRows()==data_A()->GetNRowsAdded()); + */ + std::vector indices; + std::vector factors; + + // Compute S = B^T*P from indices, factors and P + const std::vector* data_A_idx = dynamic_cast(GetRawPtr(data_A()))->GetColIndices(); + const std::vector* data_B_idx = dynamic_cast(GetRawPtr(B))->GetColIndices(); + Index col_count = 0; + for( std::vector::const_iterator a_it = data_A_idx->begin(); a_it != data_A_idx->end(); ++a_it ) + { + cols_[*a_it]->GetSchurMatrixRows(data_B_idx, S_values + col_count * ncols_); + col_count++; + } + + return retval; +} + +void IndexPCalculator::PrintImpl( + const Journalist& jnlst, + EJournalLevel level, + EJournalCategory category, + const std::string& name, + Index indent, + const std::string& prefix +) const +{ + DBG_START_METH("IndexPCalculator::PrintImpl", dbg_verbosity); + + const Number* col_val; + jnlst.PrintfIndented(level, category, indent, "%sIndexPCalculator \"%s\" with %d rows and %d columns:\n", + prefix.c_str(), name.c_str(), nrows_, ncols_); + Index col_counter = 0; + for( std::map >::const_iterator j = cols_.begin(); j != cols_.end(); ++j ) + { + col_val = j->second->Values(); + for( Index i = 0; i < nrows_; ++i ) + { + jnlst.PrintfIndented(level, category, indent, "%s%s[%5d,%5d]=%23.16e\n", prefix.c_str(), name.c_str(), i, + col_counter, col_val[i]); + } + col_counter++; + } +} + +PColumn::PColumn( + Number* values +) + : val_(values) +{ + DBG_START_METH("PColumn::PColumn", dbg_verbosity); +} + +PColumn::~PColumn() +{ + DBG_START_METH("PColumn::~PColumn", dbg_verbosity); + delete[] val_; +} + +void PColumn::GetSchurMatrixRows( + const std::vector* row_idx_B, + Number* S_col +) const +{ + DBG_START_METH("PColumn::GetSchurMatrixRows", dbg_verbosity); + + for( Index i = 0; i < (int) row_idx_B->size(); ++i ) + { + S_col[i] = -val_[(*row_idx_B)[i]]; + } +} + +const Number* PColumn::Values() const +{ + DBG_START_METH("PColumn::Values", dbg_verbosity); + return val_; +} + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensIndexPCalculator.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensIndexPCalculator.hpp new file mode 100644 index 000000000..9dcbdc1c8 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensIndexPCalculator.hpp @@ -0,0 +1,88 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-06 + +#ifndef __ASINDEXPCALCULATOR_HPP__ +#define __ASINDEXPCALCULATOR_HPP__ + +#include "SensPCalculator.hpp" + +namespace Ipopt +{ +/* Forward declarations */ +class PColumn; + +class IndexPCalculator: public PCalculator +{ + /** This class is the implementation of the PCalculator that corresponds + * to IndexSchurData. It expects to be used with a kind of IndexSchurData. */ + +public: + + IndexPCalculator( + SmartPtr backsolver, + SmartPtr A_data + ); + + virtual ~IndexPCalculator(); + + /** Overloaded from PCalculator */ + virtual bool InitializeImpl( + const OptionsList& options, + const std::string& prefix + ); + + virtual bool ComputeP(); + + virtual bool GetSchurMatrix( + const SmartPtr& B, + SmartPtr& S + ); + + virtual void PrintImpl( + const Journalist& jnlst, + EJournalLevel level, + EJournalCategory category, + const std::string& name, + Index indent, + const std::string& prefix + ) const; + +private: + /** Rows of P = Rows of KKT */ + Index nrows_; + + /** Cols of P */ + Index ncols_; + + std::map > cols_; + +}; + +/** This class provides an easy interface for PCalculators with data where columns are + * not necessarily in adjacent parts of memory. */ +class PColumn: public ReferencedObject +{ +public: + PColumn( + Number* values + ); + + virtual ~PColumn(); + + virtual void GetSchurMatrixRows( + const std::vector* row_idx_B, + Number* S + ) const; + + virtual const Number* Values() const; + +private: + Number* val_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensIndexSchurData.cpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensIndexSchurData.cpp new file mode 100644 index 000000000..06c442df8 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensIndexSchurData.cpp @@ -0,0 +1,441 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-27 + +#include "SensIndexSchurData.hpp" +#include "IpIteratesVector.hpp" +#include "IpDenseVector.hpp" +#include "IpBlas.hpp" +#include "SensUtils.hpp" + +namespace Ipopt +{ +#if IPOPT_VERBOSITY > 0 +static const Index dbg_verbosity = 1; +#endif + +IndexSchurData::IndexSchurData() +{ + DBG_START_METH("IndexSchurData::IndexSchurData", dbg_verbosity); +} + +IndexSchurData::IndexSchurData( + const std::vector idx, + const std::vector val +) +{ + DBG_START_METH("IndexSchurData::IndexSchurData(vector,vector)", dbg_verbosity); + + idx_ = idx; + val_ = val; + + Set_NRows((Index) idx_.size()); + Set_Initialized(); +} + +IndexSchurData::~IndexSchurData() +{ + DBG_START_METH("IndexSchurData::~IndexSchurData", dbg_verbosity); +} + +SmartPtr IndexSchurData::MakeNewSchurDataCopy() const +{ + DBG_START_METH("IndexSchurData::MakeNewSchurDataCopy", dbg_verbosity); + + SmartPtr retval = new IndexSchurData(idx_, val_); + return retval; +} + +void IndexSchurData::SetData_Flag( + Index dim, + const Index* flags, + Number v +) +{ + DBG_START_METH("IndexSchurData::SetData_Flag", dbg_verbosity); + + DBG_ASSERT(idx_.size() == 0); + DBG_ASSERT(!Is_Initialized()); + DBG_ASSERT(v != 0); + + Index w; + (v > 0) ? w = 1 : w = -1; + + for( Index i = 0; i < dim; ++i ) + { + DBG_ASSERT(flags[i] == 1 || flags[i] == 0); + DBG_ASSERT(v != 0); + if( flags[i] ) + { + idx_.push_back(i); + val_.push_back(w); + } + } + Set_Initialized(); + Set_NRows((Index) val_.size()); +} + +void IndexSchurData::SetData_Flag( + Index dim, + const Index* flags, + const Number* values +) +{ + DBG_START_METH("InexSchurData::SetData_Flag", dbg_verbosity); + + DBG_ASSERT(idx_.size() == 0); + DBG_ASSERT(!Is_Initialized()); + + for( Index i = 0; i < dim; ++i ) + { + DBG_ASSERT(flags[i] == 1 || flags[i] == 0); + DBG_ASSERT(values[i] != 0); + if( flags[i] ) + { + idx_.push_back(i); + (values[i] > 0) ? val_.push_back(1) : val_.push_back(-1); + } + } + Set_Initialized(); + Set_NRows((Index) val_.size()); +} + +Index IndexSchurData::SetData_Index( + Index dim, + const Index* index, + Number v +) +{ + DBG_START_METH("IndexSchurData::SetData_Index", dbg_verbosity); + + DBG_ASSERT(idx_.empty()); + DBG_ASSERT(!Is_Initialized()); + + Index w; + (v > 0) ? w = 1 : w = -1; + DBG_PRINT((dbg_verbosity, "Schurdata::w=%d\n", w)); + Index n_ind = AsIndexMax(dim, index, 1); + std::vector sortvec(n_ind, -1); + // fill up sortlist + for( Index i = 0; i < dim; ++i ) + { + if( index[i] > 0 ) + { + DBG_ASSERT(sortvec[index[i] - 1] == -1); // THIS SHOULD THROW AN EXCEPTION! (OR SWITCH TO FLAG?) + if( sortvec[index[i] - 1] != -1 ) + { + return index[i]; + } + sortvec[index[i] - 1] = i; + } + } + + idx_.resize(n_ind, 0); + val_.resize(n_ind, 0); + for( Index i = 0; i < n_ind; ++i ) + { + DBG_ASSERT(sortvec[i] > -1); + idx_[i] = sortvec[i]; + val_[i] = w; + } + + Set_Initialized(); + Set_NRows((Index) val_.size()); + return 0; +} + +void IndexSchurData::SetData_List( + const std::vector& list, + Number v +) +{ + DBG_START_METH("IndexSchurData::SetData_List", dbg_verbosity); + + DBG_ASSERT(!Is_Initialized()); + DBG_ASSERT(idx_.empty()); + DBG_ASSERT(v != 0); + + Index w; + (v > 0) ? w = 1 : w = -1; + + val_.resize(list.size(), w); + idx_ = list; + + Set_Initialized(); +} + +void IndexSchurData::GetRow( + Index row, + IteratesVector& v +) const +{ + DBG_START_METH("IndexSchurData::GetRow", dbg_verbosity); + + DBG_ASSERT(Is_Initialized()); + DBG_ASSERT(row < GetNRowsAdded()); + + // retrieve structure of IteratesVector - this should probably be cached or sth. + //Index n_comps = v.NComps(); + Index* v_lens = GetVectorLengths(v); + // set vector v to 0 + v.Set(0.0); + + // find the vector and index in iteratesvector to which idx_[row] corresponds + Index col = idx_[row]; + + Index vec_idx = 0; + while( !(col < v_lens[vec_idx]) ) + { + vec_idx++; + } + + dynamic_cast(GetRawPtr(v.GetCompNonConst(vec_idx)))->Values()[col + v.GetComp(vec_idx)->Dim() - v_lens[vec_idx]] = (Number) val_[row]; + + delete[] v_lens; +} + +void IndexSchurData::GetMultiplyingVectors( + Index row, + std::vector& indices, + std::vector& factors +) const +{ + DBG_START_METH("IndexSchurData::GetMultiplyingVectors", dbg_verbosity); + + DBG_ASSERT(indices.size() == 0); + DBG_ASSERT(factors.size() == 0); + + indices.push_back(idx_[row]); + factors.push_back(val_[row]); +} + +void IndexSchurData::Multiply( + const IteratesVector& v, + Vector& u +) const +{ + DBG_START_METH("IndexSchurData::Multiply", dbg_verbosity); + + // this is awful. + DenseVector* du = static_cast(&u); + du->Set(0.0); + Number* u_val = du->Values(); + + Index* v_lens = GetVectorLengths(v); + + Index v_row, vec_idx; + for( unsigned int i = 0; i < idx_.size(); ++i ) + { + v_row = idx_[i]; + + // find vector in CompoundVector that corresponds to the given col in matrix/row in v. + vec_idx = -1; + while( !(v_row < v_lens[++vec_idx]) ) + { + } + + SmartPtr d_ptr = dynamic_cast(GetRawPtr(v.GetComp(vec_idx))); + if( !d_ptr->IsHomogeneous() ) + { + u_val[i] += val_[i] * d_ptr->Values()[v_row + v.GetComp(vec_idx)->Dim() - v_lens[vec_idx]]; + } + else + { + u_val[i] += val_[i] * d_ptr->Scalar(); + } + } + + delete[] v_lens; +} + +void IndexSchurData::TransMultiply( + const Vector& u, + IteratesVector& v +) const +{ + DBG_START_METH("IndexSchurData::TransMultiply", dbg_verbosity); + + DBG_ASSERT(u.Dim() == GetNRowsAdded()); + + const DenseVector* du = static_cast(&u); + + // Get total number of elements of v + Index ncols = 0; + for( Index i = 0; i < v.NComps(); ++i ) + { + ncols += v.GetComp(i)->Dim(); + } + + // Create space in which v_vals will be saved + Number* v_vals = new Number[ncols]; + + const Number* u_vals = du->Values(); + + // set v to zero + for( Index i = 0; i < ncols; ++i ) + { + v_vals[i] = 0; + } + + // perform v_vals <- A^T*u + Index row, col; + Number val; + for( unsigned int i = 0; i < idx_.size(); ++i ) + { + row = i; + col = idx_[i]; + val = val_[i]; + + v_vals[col] += val * u_vals[row]; + } + + // save v_vals in v + Index v_idx = 0, curr_dim; + Number* curr_val; + for( Index i = 0; i < v.NComps(); ++i ) + { + curr_dim = v.GetCompNonConst(i)->Dim(); + curr_val = dynamic_cast(GetRawPtr(v.GetCompNonConst(i)))->Values(); + IpBlasDcopy(curr_dim, v_vals + v_idx, 1, curr_val, 1); + + v_idx += curr_dim; + } + + delete[] v_vals; +} + +Index* IndexSchurData::GetVectorLengths( + const IteratesVector& v +) const +{ + DBG_START_METH("IndexSchurData::GetVectorLengths", dbg_verbosity); + // retrieve structure of IteratesVector - this should probably be cached or sth. + Index n_comps = v.NComps(); + Index* v_lens = new Index[n_comps]; + + // v_lens[i] holds the maximum number up to which component i belongs in there. + v_lens[0] = v.GetComp(0)->Dim(); + for( Index i = 1; i < n_comps; ++i ) + { + v_lens[i] = v_lens[i - 1] + v.GetComp(i)->Dim(); + } + return v_lens; +} + +void IndexSchurData::PrintImpl( + const Journalist& jnlst, + EJournalLevel level, + EJournalCategory category, + const std::string& name, + Index indent, + const std::string& prefix +) const +{ + DBG_START_METH("IndexSchurData::PrintImpl", dbg_verbosity); + + jnlst.PrintfIndented(level, category, indent, "%sIndexSchurData \"%s\" with %d rows:\n", prefix.c_str(), + name.c_str(), GetNRowsAdded()); + if( Is_Initialized() ) + { + for( unsigned int i = 0; i < idx_.size(); i++ ) + { + jnlst.PrintfIndented(level, category, indent, "%s%s[%5d,%5d]=%d\n", prefix.c_str(), name.c_str(), i, idx_[i], + val_[i]); + } + } + else + { + jnlst.PrintfIndented(level, category, indent, "%sUninitialized!\n", prefix.c_str()); + } +} + +void IndexSchurData::AddData_Flag( + Index dim, + Index* flags, + std::vector& delta_u_sort, + Index v +) +{ + DBG_START_METH("IndexSchurData::AddData_Flag", dbg_verbosity); + + Index sortcounter = (Index) idx_.size(); + bool oldindex; + for( Index i = 0; i < dim; ++i ) + { + if( flags[i] ) + { + oldindex = false; + for( unsigned int j = 0; j < idx_.size(); ++j ) + { + if( i == idx_[j] ) + { + delta_u_sort.push_back(j); + val_[j] = v; + oldindex = true; + break; + } + } + if( !oldindex ) + { + delta_u_sort.push_back(sortcounter++); + idx_.push_back(i); + val_.push_back(v); + } + } + } +} + +void IndexSchurData::AddData_List( + std::vector cols, + std::vector& delta_u_sort, + Index& new_du_size, + Index v +) +{ + DBG_START_METH("IndexSchurData::AddData_List", dbg_verbosity); + + new_du_size = (Index) idx_.size(); + bool oldindex; + for( unsigned int i = 0; i < cols.size(); ++i ) + { + oldindex = false; + for( unsigned int j = 0; j < idx_.size(); ++j ) + { + if( cols[i] == idx_[j] ) + { + delta_u_sort.push_back(j); + val_[j] = v; + oldindex = true; + break; + } + } + if( !oldindex ) + { + delta_u_sort.push_back(new_du_size++); + idx_.push_back(cols[i]); + val_.push_back(v); + } + } + Set_NRows((Index) idx_.size()); + if( !Is_Initialized() ) + { + Set_Initialized(); + } +} + +Index IndexSchurData::GetNRowsAdded() const +{ + DBG_START_METH("IndexSchurData::GetNRowsAdded", dbg_verbosity); + + return (Index) idx_.size(); +} + +const std::vector* IndexSchurData::GetColIndices() const +{ + DBG_START_METH("IndexSchurData::GetColIndices", dbg_verbosity); + return &idx_; +} + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensIndexSchurData.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensIndexSchurData.hpp new file mode 100644 index 000000000..a21f8c752 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensIndexSchurData.hpp @@ -0,0 +1,133 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-08 + +#ifndef __ASINDEXSCHURDATA_HPP__ +#define __ASINDEXSCHURDATA_HPP__ + +#include "SensSchurData.hpp" + +namespace Ipopt +{ + +class IndexSchurData: public SchurData +{ + /** This class is the implementation aimed at applications where + * only SchurData matrices with entries 1 or -1 appear. */ + +public: + + IndexSchurData(); + + IndexSchurData( + const std::vector idx, + const std::vector val + ); + + virtual ~IndexSchurData(); + + virtual SmartPtr MakeNewSchurDataCopy() const; + + virtual Index GetNRowsAdded() const; + + virtual void SetData_Flag( + Index dim, + const Index* flags, + Number v = 1.0 + ); + + virtual void SetData_Flag( + Index dim, + const Index* flags, + const Number* values + ); + + virtual Index SetData_Index( + Index dim, + const Index* index, + Number v = 1.0 + ); + + virtual void SetData_List( + const std::vector& list, + Number v = 1.0 + ); + + virtual void GetRow( + Index i, + IteratesVector& v + ) const; + + virtual void GetMultiplyingVectors( + Index i, + std::vector& indices, + std::vector& factors + ) const; + + virtual void Multiply( + const IteratesVector& v, + Vector& u + ) const; + + virtual void TransMultiply( + const Vector& u, + IteratesVector& v + ) const; + + virtual void PrintImpl( + const Journalist& jnlst, + EJournalLevel level, + EJournalCategory category, + const std::string& name, + Index indent, + const std::string& prefix + ) const; + + /* Functions specific to IndexSchurData */ + + /** This function is for adding data to a SchurData object. + * + * It takes a set of column-indices + * a value v and adds indices accordingly. If the column is already set in the data, + * it stays at the same place, otherwise the new indices are added at the bottom, + * in the order specified by the indices. The vector delta_u_sort returns the actual + * sorting so that the user knows how to place the new values inside the elongated + * delta_u vector. These places are in C++ index style, so they correspond exactly + * to the indices used for the C++-array of the delta_u DenseVector. + */ + void AddData_Flag( + Index dim, + Index* flags, + std::vector& delta_u_sort, + Index v + ); + + void AddData_List( + std::vector cols, + std::vector& delta_u_sort, + Index& new_du_size, + Index v + ); + + const std::vector* GetColIndices() const; + +private: + + /** returns a vector that holds the accumulated length of each vector component + * + * v_len[0] = v.GetComp(0)->Dim() + * v_len[i] = sum(k=0..i, v.GetComp(k)->Dim()) + */ + Index* GetVectorLengths( + const IteratesVector& v + ) const; + + std::vector idx_; + std::vector val_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensMeasurement.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensMeasurement.hpp new file mode 100644 index 000000000..15324187e --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensMeasurement.hpp @@ -0,0 +1,56 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-16 + +#ifndef __AS_MEASUREMENT_HPP__ +#define __AS_MEASUREMENT_HPP__ + +#include "IpReferenced.hpp" +#include "IpDenseVector.hpp" +#include "IpIteratesVector.hpp" + +namespace Ipopt +{ + +class SIPOPTLIB_EXPORT Measurement: public ReferencedObject +{ + /** This class provides an abstraction for the measurements of the states coming in + * and the solutions of the controller. + * + * It basically acts as the "plant" of the controller. + */ +public: + + Measurement() + { } + + virtual ~Measurement() + { } + + /** This function returns a std::vector holding the indices in IteratesVector of the + * equations that are to be "slacked" to free the initial values for sIPOPT. + * + * This std::vector is used in the construction of the A-SchurData for the Schur Decomposition. + */ + virtual std::vector GetInitialEqConstraints() = 0; + + /** This function returns delta_u. + * + * It should use the values of IpData().trial()->x() + */ + virtual SmartPtr GetMeasurement( + Index measurement_number + ) = 0; + + /** This function does whatever the measurement machine does with the solution of the SensAlgorithm */ + virtual void SetSolution( + Index measurement_number, + SmartPtr sol + ) = 0; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensMetadataMeasurement.cpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensMetadataMeasurement.cpp new file mode 100644 index 000000000..e093d4d4b --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensMetadataMeasurement.cpp @@ -0,0 +1,185 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-07-10 + +#include "SensMetadataMeasurement.hpp" +#include "SensUtils.hpp" + +#include + +namespace Ipopt +{ +#if IPOPT_VERBOSITY > 0 +static const Index dbg_verbosity = 1; +#endif + +MetadataMeasurement::MetadataMeasurement() + : n_idx_(0), + x_owner_space_(NULL), + s_owner_space_(NULL), + y_c_owner_space_(NULL), + y_d_owner_space_(NULL), + z_L_owner_space_(NULL), + z_U_owner_space_(NULL) +{ + DBG_START_METH("MetadataMeasurement::MetadataMeasurement", dbg_verbosity); +} + +MetadataMeasurement::~MetadataMeasurement() +{ + DBG_START_METH("MetadataMeasurement::~MetadataMeasurement", dbg_verbosity); +} + +bool MetadataMeasurement::InitializeImpl( + const OptionsList& options, + const std::string& prefix +) +{ + DBG_START_METH("MetadataMeasurement::InitializeImpl", dbg_verbosity); + + x_owner_space_ = dynamic_cast(GetRawPtr(IpData().curr()->x()->OwnerSpace())); + s_owner_space_ = dynamic_cast(GetRawPtr(IpData().curr()->s()->OwnerSpace())); + y_c_owner_space_ = dynamic_cast(GetRawPtr(IpData().curr()->y_c()->OwnerSpace())); + y_d_owner_space_ = dynamic_cast(GetRawPtr(IpData().curr()->y_d()->OwnerSpace())); + z_L_owner_space_ = dynamic_cast(GetRawPtr(IpData().curr()->z_L()->OwnerSpace())); + z_U_owner_space_ = dynamic_cast(GetRawPtr(IpData().curr()->z_U()->OwnerSpace())); + DBG_ASSERT(IsValid(x_owner_space_) && IsValid(s_owner_space_) && + IsValid(y_c_owner_space_) && IsValid(y_d_owner_space_) && + IsValid(z_L_owner_space_) && IsValid(z_U_owner_space_)); + + bool run_sens; + options.GetBoolValue("run_sens", run_sens, prefix); + if( run_sens ) + { + std::string sens_state_0 = "sens_state_1"; // sens_state_0 doesn't exist anymore... + std::vector tmp_idx = x_owner_space_->GetIntegerMetaData(sens_state_0); + + n_idx_ = AsIndexMax((Index) tmp_idx.size(), &tmp_idx[0], 1); + } + + return true; +} + +std::vector MetadataMeasurement::GetInitialEqConstraints() +{ + DBG_START_METH("MetadataMeasurement::GetInitialEqConstraints", dbg_verbosity); + + SmartPtr it = IpData().curr(); + Index n_base = it->x()->Dim() + it->s()->Dim(); + + const std::vector constr_metadata = y_c_owner_space_->GetIntegerMetaData("sens_init_constr"); + + std::vector retval; + for( Index i = 0; i < (int) constr_metadata.size(); ++i ) + { + if( constr_metadata[i] != 0 ) + { + retval.push_back(n_base + i); + } + } + return retval; +} + +SmartPtr MetadataMeasurement::GetMeasurement( + Index measurement_number +) +{ + DBG_START_METH("MetadataMeasurement::GetMeasurement", dbg_verbosity); + + DBG_ASSERT(measurement_number > 0 && measurement_number < 7); + + std::string state; + std::string statevalue; + + state = "sens_state_"; + statevalue = "sens_state_value_"; + append_Index(state, measurement_number); + append_Index(statevalue, measurement_number); + + const std::vector idx_ipopt = x_owner_space_->GetIntegerMetaData(state.c_str()); + const std::vector val_ipopt = x_owner_space_->GetNumericMetaData(statevalue.c_str()); + + SmartPtr delta_u_space; + delta_u_space = new DenseVectorSpace(n_idx_); + + SmartPtr delta_u = new DenseVector(GetRawPtr(ConstPtr(delta_u_space))); + Number* du_val = delta_u->Values(); + + const Number* u_0_val = dynamic_cast(GetRawPtr(IpData().trial()->x()))->Values(); + + // Fill up values of delta_u vector + for( Index i = 0; i < (int) val_ipopt.size(); ++i ) + { + if( idx_ipopt[i] > 0 ) + { + du_val[idx_ipopt[i] - 1] = val_ipopt[i] - u_0_val[i]; //initial_val[idx_ipopt[i]-1]; + //du_val[idx_ipopt[i]-1] = val_ipopt[i]; + } + } + + delta_u->SetValues(du_val); + + return delta_u; +} + +void MetadataMeasurement::SetSolution( + Index measurement_number, + SmartPtr sol +) +{ + DBG_START_METH("MetadataMeasurement::SetSolution", dbg_verbosity); + + std::string sens_sol = "sens_sol_state_"; + append_Index(sens_sol, measurement_number); + + const Number* sol_x_val = dynamic_cast(GetRawPtr(sol->x()))->Values(); + std::vector x_sol = std::vector(sol_x_val, sol_x_val + sol->x()->Dim()); + SmartPtr x_owner_space_nonconst = const_cast(GetRawPtr(x_owner_space_)); + x_owner_space_nonconst->SetNumericMetaData(sens_sol, x_sol); + + SmartPtr s_dv = dynamic_cast(GetRawPtr(sol->s())); + if( IsValid(s_dv) ) + { + const Number* sol_s_val = s_dv->Values(); + std::vector s_sol = std::vector(sol_s_val, sol_s_val + sol->s()->Dim()); + SmartPtr s_owner_space_nonconst = const_cast(GetRawPtr(s_owner_space_)); + s_owner_space_nonconst->SetNumericMetaData(sens_sol, s_sol); + } + + const Number* sol_y_c_val = dynamic_cast(GetRawPtr(sol->y_c()))->Values(); + std::vector y_c_sol = std::vector(sol_y_c_val, sol_y_c_val + sol->y_c()->Dim()); + SmartPtr y_c_owner_space_nonconst = const_cast(GetRawPtr(y_c_owner_space_)); + y_c_owner_space_nonconst->SetNumericMetaData(sens_sol, y_c_sol); + + const Number* sol_y_d_val = dynamic_cast(GetRawPtr(sol->y_d()))->Values(); + std::vector y_d_sol = std::vector(sol_y_d_val, sol_y_d_val + sol->y_d()->Dim()); + SmartPtr y_d_owner_space_nonconst = const_cast(GetRawPtr(y_d_owner_space_)); + y_d_owner_space_nonconst->SetNumericMetaData(sens_sol, y_d_sol); + + const Number* sol_z_L_val = dynamic_cast(GetRawPtr(sol->z_L()))->Values(); + std::vector z_L_sol = std::vector(sol_z_L_val, sol_z_L_val + sol->z_L()->Dim()); + SmartPtr z_L_owner_space_nonconst = const_cast(GetRawPtr(z_L_owner_space_)); + z_L_owner_space_nonconst->SetNumericMetaData(sens_sol, z_L_sol); + + const Number* sol_z_U_val = dynamic_cast(GetRawPtr(sol->z_U()))->Values(); + std::vector z_U_sol = std::vector(sol_z_U_val, sol_z_U_val + sol->z_U()->Dim()); + SmartPtr z_U_owner_space_nonconst = const_cast(GetRawPtr(z_U_owner_space_)); + z_U_owner_space_nonconst->SetNumericMetaData(sens_sol, z_U_sol); +} + +std::vector MetadataMeasurement::GetIntegerSuffix( + std::string suffix_string +) +{ + DBG_START_METH("MetadataMeasurement::GetIntegerSuffix", dbg_verbosity); + + const std::vector idx_ipopt = x_owner_space_->GetIntegerMetaData(suffix_string.c_str()); + + std::vector retval = idx_ipopt; + + return retval; +} + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensMetadataMeasurement.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensMetadataMeasurement.hpp new file mode 100644 index 000000000..874cf32e4 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensMetadataMeasurement.hpp @@ -0,0 +1,70 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-07-10 + +#ifndef __AS_METADATAMEASUREMENT_HPP__ +#define __AS_METADATAMEASUREMENT_HPP__ + +#include "SensMeasurement.hpp" +#include "SensSuffixHandler.hpp" +#include "IpAlgStrategy.hpp" + +namespace Ipopt +{ + +class MetadataMeasurement: public Measurement, public SuffixHandler, public AlgorithmStrategyObject +{ +public: + MetadataMeasurement(); + + virtual ~MetadataMeasurement(); + + /* AlgorithmStrategyObject */ + virtual bool InitializeImpl( + const OptionsList& options, + const std::string& prefix + ); + + /* measurement methods */ + virtual std::vector GetInitialEqConstraints(); + + virtual SmartPtr GetMeasurement( + Index measurement_number + ); + + virtual void SetSolution( + Index measurement_number, + SmartPtr sol + ); + + /* suffix handler methods */ + + virtual std::vector GetIntegerSuffix( + std::string suffix_string + ); + +private: + + /** Number of sens_indices */ + Index n_idx_; + + /** owner space of x */ + SmartPtr x_owner_space_; + /** owner space of s */ + SmartPtr s_owner_space_; + /** owner space of y_c */ + SmartPtr y_c_owner_space_; + /** owner space of y_d */ + SmartPtr y_d_owner_space_; + /** owner space of z_L */ + SmartPtr z_L_owner_space_; + /** owner space of z_U */ + SmartPtr z_U_owner_space_; + +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensPCalculator.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensPCalculator.hpp new file mode 100644 index 000000000..6434fc990 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensPCalculator.hpp @@ -0,0 +1,137 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-06 + +#ifndef __ASPCALCULATOR_HPP__ +#define __ASPCALCULATOR_HPP__ + +#include "IpAlgStrategy.hpp" +#include "SensSimpleBacksolver.hpp" +#include "SensSchurData.hpp" + +namespace Ipopt +{ + +/** This class is the interface for implementations of any class that calculates the matrix \f$P =K^{-1}A\f$ + * of the following matrix: + * \f[ + * \left(\begin{array}{cc} + * K & A\\ + * B & 0 + * \end{array}\right) + * \f] + */ +class SIPOPTLIB_EXPORT PCalculator: public AlgorithmStrategyObject +{ +public: + PCalculator( + SmartPtr backsolver, + SmartPtr A_data + ) + : backsolver_(backsolver), + data_A_init(ConstPtr(A_data->MakeNewSchurDataCopy())), + data_A_(A_data) + { } + + virtual ~PCalculator() + { } + + /* Overloaded from AlgorithmStrategyObject */ + virtual bool InitializeImpl( + const OptionsList& /*options*/, + const std::string& /*prefix*/ + ) + { + return true; + } + + /** Function to start the computation of P from E_0 and KKT*/ + virtual bool ComputeP() = 0; + + /** Function to extract a SchurMatrix corresponding to $B K^{-1} A$. + * + * If B==NULL, use A=B. + */ + virtual bool GetSchurMatrix( + const SmartPtr& B, + SmartPtr& S + ) = 0; + + virtual void PrintImpl( + const Journalist& jnlst, + EJournalLevel level, + EJournalCategory category, + const std::string& name, + Index indent, + const std::string& prefix + ) const = 0; + + void Print( + const Journalist& jnlst, + EJournalLevel level, + EJournalCategory category, + const std::string& name, + Index indent = 0, + const std::string& prefix = "" + ) const + { + if( jnlst.ProduceOutput(level, category) ) + { + PrintImpl(jnlst, level, category, name, indent, prefix); + } + } + + void Print( + SmartPtr jnlst, + EJournalLevel level, + EJournalCategory category, + const std::string& name, + Index indent, + const std::string& prefix + ) const + { + if( IsValid(jnlst) && jnlst->ProduceOutput(level, category) ) + { + PrintImpl(*jnlst, level, category, name, indent, prefix); + } + } + + /** Accessor methods for data and backsolver. + * + * This unconstness seems + * kind of dangerous but I don't think there is a way around it. Anyway, + * there is no difference between this and the IpData() method of AlgStrategy. + */ + SmartPtr Solver() const + { + return backsolver_; + } + + SmartPtr data_A() const + { + return ConstPtr(data_A_); + } + + SmartPtr data_A_nonconst() const + { + return data_A_; + } + + void reset_data_A() + { + data_A_ = data_A_init->MakeNewSchurDataCopy(); + } + +private: + + SmartPtr backsolver_; + + SmartPtr data_A_init; + SmartPtr data_A_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensReducedHessianCalculator.cpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensReducedHessianCalculator.cpp new file mode 100644 index 000000000..26af191a5 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensReducedHessianCalculator.cpp @@ -0,0 +1,115 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-08-01 + +#include "SensReducedHessianCalculator.hpp" +#include "IpDenseGenMatrix.hpp" + +namespace Ipopt +{ +#if IPOPT_VERBOSITY > 0 +static const Index dbg_verbosity = 1; +#endif + +ReducedHessianCalculator::ReducedHessianCalculator( + SmartPtr hess_data, + SmartPtr pcalc +) + : hess_data_(hess_data), + pcalc_(pcalc) +{ + DBG_START_METH("ReducedHessianCalculator::ReducedHessianCalculator", dbg_verbosity); +} + +ReducedHessianCalculator::~ReducedHessianCalculator() +{ + DBG_START_METH("ReducedHessianCalculator::~ReducedHessianCalculator", dbg_verbosity); +} + +bool ReducedHessianCalculator::InitializeImpl( + const OptionsList& options, + const std::string& prefix +) +{ + DBG_START_METH("ReducedHessianCalculator::InitializeImpl", dbg_verbosity); + + options.GetBoolValue("rh_eigendecomp", compute_eigenvalues_, prefix); + return true; +} + +bool ReducedHessianCalculator::ComputeReducedHessian() +{ + DBG_START_METH("ReducedHessianCalculator::ComputeReducedHessian", dbg_verbosity); + + Index dim_S = hess_data_->GetNRowsAdded(); + //SmartPtr S_space = new DenseGenMatrixSpace(dim_S, dim_S); + //SmartPtr S = new DenseGenMatrix(GetRawPtr(S_space)); + SmartPtr S; + bool retval = pcalc_->GetSchurMatrix(GetRawPtr(hess_data_), S); + + SmartPtr S_sym = dynamic_cast(GetRawPtr(S)); + if( !IsValid(S_sym) ) + { + std::exception exc; + throw(exc); + } + + bool have_x_scaling, have_c_scaling, have_d_scaling; + have_x_scaling = IpNLP().NLP_scaling()->have_x_scaling(); + have_c_scaling = IpNLP().NLP_scaling()->have_c_scaling(); + have_d_scaling = IpNLP().NLP_scaling()->have_d_scaling(); + + if( have_x_scaling || have_c_scaling || have_d_scaling ) + { + Jnlst().Printf(J_WARNING, J_MAIN, "\n" + "-------------------------------------------------------------------------------\n" + " *** WARNING ***\n" + "-------------------------------------------------------------------------------\n" + "You are using the reduced hessian feature with scaling of\n"); + if( have_x_scaling ) + { + Jnlst().Printf(J_WARNING, J_MAIN, "*** variables\n"); + } + if( have_c_scaling ) + { + Jnlst().Printf(J_WARNING, J_MAIN, "*** equality constraints\n"); + } + if( have_d_scaling ) + { + Jnlst().Printf(J_WARNING, J_MAIN, "*** inequality constraints\n"); + } + Jnlst().Printf(J_WARNING, J_MAIN, "enabled.\n" + "A correct unscaled solution of the reduced hessian cannot be guaranteed in this\n" + "case. Please consider rerunning with scaling turned off.\n" + "-------------------------------------------------------------------------------\n\n"); + + } + + // Unscale by objective factor and multiply by (-1) + Number obj_scal = IpNLP().NLP_scaling()->apply_obj_scaling(1.0); + DBG_PRINT((dbg_verbosity, "Objective scaling = %f\n", obj_scal)); + Number* s_val = S_sym->Values(); + for( Index k = 0; k < (S->NRows()) * (S->NCols()); ++k ) + { + s_val[k] *= -obj_scal; + } + + S->Print(Jnlst(), J_INSUPPRESSIBLE, J_USER1, "RedHessian unscaled"); + + if( compute_eigenvalues_ ) + { + SmartPtr eigenvectorspace = new DenseGenMatrixSpace(dim_S, dim_S); + SmartPtr eigenvectors = new DenseGenMatrix(GetRawPtr(eigenvectorspace)); + SmartPtr eigenvaluesspace = new DenseVectorSpace(dim_S); + SmartPtr eigenvalues = new DenseVector(GetRawPtr(eigenvaluesspace)); + + eigenvectors->ComputeEigenVectors(*S_sym, *eigenvalues); + eigenvalues->Print(Jnlst(), J_INSUPPRESSIBLE, J_USER1, "Eigenvalues of reduced hessian matrix"); + } + + return retval; +} + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensReducedHessianCalculator.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensReducedHessianCalculator.hpp new file mode 100644 index 000000000..2765861f2 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensReducedHessianCalculator.hpp @@ -0,0 +1,53 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-08-01 + +#ifndef __ASREDUCEDHESSIANCALCULATOR_HPP__ +#define __ASREDUCEDHESSIANCALCULATOR_HPP__ + +#include "IpAlgStrategy.hpp" +#include "SensSchurData.hpp" +#include "SensPCalculator.hpp" + +namespace Ipopt +{ + +/** This is the interface for the actual controller. + * + * It handles Data input to the controller (measurement) and returns controls. + */ +class ReducedHessianCalculator: public AlgorithmStrategyObject +{ +public: + ReducedHessianCalculator( + SmartPtr hess_data, + SmartPtr pcalc + ); + + virtual ~ReducedHessianCalculator(); + + virtual bool InitializeImpl( + const OptionsList& options, + const std::string& prefix + ); + + /** This function computes the unscaled reduced hessian matrix */ + virtual bool ComputeReducedHessian(); + +private: + + /** Pointer to Schurdata object holding the indices for selecting the free variables */ + SmartPtr hess_data_; + + /** Pointer to the P Calculator object that returns the reduced hessian matrix */ + SmartPtr pcalc_; + + /** True, if option rh_eigendecomp was set to yes */ + bool compute_eigenvalues_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensRegOp.cpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensRegOp.cpp new file mode 100644 index 000000000..2ad89071b --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensRegOp.cpp @@ -0,0 +1,23 @@ +// Copyright (C) 2005, 2006 International Business Machines and others. +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Authors: Carl Laird, Andreas Waechter IBM 2005-08-16 +// modified for sIPOPT by Hans Pirnay, 2009-07-22 + +#include "IpRegOptions.hpp" +#include "SensApplication.hpp" +#include "SensRegOp.hpp" + +namespace Ipopt +{ + +void RegisterOptions_sIPOPT( + const SmartPtr& roptions +) +{ + roptions->SetRegisteringCategory("Uncategorized"); + SensApplication::RegisterOptions(roptions); +} + +} // namespace Ipopt diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensRegOp.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensRegOp.hpp new file mode 100644 index 000000000..9fd12a67b --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensRegOp.hpp @@ -0,0 +1,21 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. + +#ifndef __SENSREGOP_HPP__ +#define __SENSREGOP_HPP__ + +#include "IpSmartPtr.hpp" + +namespace Ipopt +{ + +class RegisteredOptions; + +SIPOPTLIB_EXPORT void RegisterOptions_sIPOPT( + const SmartPtr& roptions +); + +} // namespace Ipopt + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensSchurData.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensSchurData.hpp new file mode 100644 index 000000000..686ec2099 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensSchurData.hpp @@ -0,0 +1,182 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-06 + +#ifndef __ASSCHURDATA_HPP__ +#define __ASSCHURDATA_HPP__ + +#include "IpVector.hpp" +#include "IpIteratesVector.hpp" +#include + +namespace Ipopt +{ + +/** This interface serves as a reference point for multiple classes + * that need to use SchurData (PCalculator, SchurDriver). + * + * It declares as little as possible, so that SchurData implementations + * can be very special and fast. + * + * I have not decided yet if there are certain ways I want to impose + * that SchurData can be set. I will figure this out as soon as I + * write the upstream classes that need to do that + * + * Nomenclature in this program is based on Victor Zavalas thesis. + */ +class SIPOPTLIB_EXPORT SchurData: public ReferencedObject +{ +public: + SchurData() + : initialized_(false), + nrows_(0) + { } + + virtual ~SchurData() + { } + + virtual SmartPtr MakeNewSchurDataCopy() const = 0; + + /* Functions to set the Schurdata. At least one must be overloaded */ + + /** Set Data to one for given indices. Size of vector is ipopt_x_& list, + Number v = 1.0 + ) = 0; + + virtual void AddData_List( + std::vector cols, + std::vector& delta_u_sort, + Index& new_du_size, + Index v + ) = 0; + + /** Returns number of rows/columns in schur matrix */ + virtual Index GetNRowsAdded() const + { + return nrows_; + } + + virtual bool Is_Initialized() const + { + return initialized_; + } + + /** Returns the i-th column vector of the matrix */ + virtual void GetRow( + Index i, + IteratesVector& v + ) const = 0; + + /** Returns two vectors that are needed for matrix-vector + * multiplication of B and P. + * + * The index is the row, the first vector are the indices + * of non-zero components, in this row of B, + * the second vector gives the numbers in B(row,indices)/ + */ + virtual void GetMultiplyingVectors( + Index row, + std::vector& indices, + std::vector& factors + ) const = 0; + + /** Computes B*v with B in R(mxn) */ + virtual void Multiply( + const IteratesVector& v, + Vector& u + ) const = 0; + + /** Computes A*u with A in R(nxm), KKT in R(n,n) */ + virtual void TransMultiply( + const Vector& u, + IteratesVector& v + ) const = 0; + + virtual void PrintImpl( + const Journalist& jnlst, + EJournalLevel level, + EJournalCategory category, + const std::string& name, + Index indent, + const std::string& prefix + ) const = 0; + + void Print( + const Journalist& jnlst, + EJournalLevel level, + EJournalCategory category, + const std::string& name, + Index indent = 0, + const std::string& prefix = "" + ) const + { + if( jnlst.ProduceOutput(level, category) ) + { + PrintImpl(jnlst, level, category, name, indent, prefix); + } + } + + void Print( + SmartPtr jnlst, + EJournalLevel level, + EJournalCategory category, + const std::string& name, + Index indent, + const std::string& prefix + ) const + { + if( IsValid(jnlst) && jnlst->ProduceOutput(level, category) ) + { + PrintImpl(*jnlst, level, category, name, indent, prefix); + } + } + +protected: + + virtual void Set_Initialized() + { + initialized_ = true; + } + + virtual void Set_NRows( + Index nrows + ) + { + nrows_ = nrows; + } + +private: + + /** Makes sure that data is not set twice accidentially */ + bool initialized_; + + /** Number of columns/rows of corresponding Schur Matrix*/ + Index nrows_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensSchurDriver.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensSchurDriver.hpp new file mode 100644 index 000000000..52281ef66 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensSchurDriver.hpp @@ -0,0 +1,118 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-06 + +#ifndef __ASSCHURDRIVER_HPP__ +#define __ASSCHURDRIVER_HPP__ + +#include "SensSchurData.hpp" +#include "SensPCalculator.hpp" +#include "IpVector.hpp" +#include "IpIteratesVector.hpp" + +namespace Ipopt +{ + +/** This class is the interface for any class that deals with the Schur matrix + * from the point when it is constructed by the PCalculator to the solution + * against one vector. + * + * Specific implementations may also incorporate the + * treatment of adding rows/cols (like QPSchur). + * + * The computations done by this class are + * 1. Solve \f$S \Delta\nu = r_s\f$ + * 2. Solve \f$K\Delta s = ... - \Delta nu\f$ (really?) + */ +class SIPOPTLIB_EXPORT SchurDriver: public AlgorithmStrategyObject +{ +public: + + SchurDriver( + SmartPtr pcalc, + SmartPtr data_B + ) + : pcalc_(pcalc), + data_B_(data_B) + { } + + virtual ~SchurDriver() + { } + + virtual bool InitializeImpl( + const OptionsList& /*options*/, + const std::string& /*prefix*/ + ) + { + return true; + } + + /** Const accessor methods to the SchurData for for the derived classes */ + virtual SmartPtr data_A() const + { + return pcalc_->data_A(); + } + + virtual SmartPtr data_B() const + { + return ConstPtr(data_B_); + } + + virtual SmartPtr data_A_nonconst() + { + return pcalc_->data_A_nonconst(); + } + + virtual SmartPtr data_B_nonconst() + { + return data_B_; + } + + virtual SmartPtr pcalc() const + { + return ConstPtr(pcalc_); + } + + virtual SmartPtr pcalc_nonconst() + { + return pcalc_; + } + + /* Sets the Data for which this SchurMatrix will be built. */ + + /** Creates the SchurMatrix from B and P */ + virtual bool SchurBuild() = 0; + + /** Calls the factorization routine for the SchurMatrix */ + virtual bool SchurFactorize() = 0; + + /** Performs a backsolve on S and K + * + * sol is the vector K^(-1)*r_s which usually should have been computed before + */ + virtual bool SchurSolve( + SmartPtr lhs, + SmartPtr rhs, + SmartPtr delta_u, + SmartPtr sol = NULL + ) = 0; + + /* Performs a backsolve on S and K; calls the latter with sol=K^(-1)*r_s=0 + virtual bool SchurSolve(SmartPtr lhs, + SmartPtr rhs, + SmartPtr delta_u) =0; + */ +private: + SchurDriver() + { } + + SmartPtr pcalc_; + + SmartPtr data_B_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensSimpleBacksolver.cpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensSimpleBacksolver.cpp new file mode 100644 index 000000000..d60bc3e9c --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensSimpleBacksolver.cpp @@ -0,0 +1,52 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-04-06 +// +// Purpose : This is the same as IpSensitivityCalculator.hpp + +#include "SensSimpleBacksolver.hpp" + +namespace Ipopt +{ +#if IPOPT_VERBOSITY > 0 +static const Index dbg_verbosity = 1; +#endif + +SimpleBacksolver::SimpleBacksolver( + SmartPtr pd_solver +) + : pd_solver_(pd_solver), + allow_inexact_(true) +{ + DBG_START_METH("SimpleBacksolver::SimpleBacksolver", dbg_verbosity); +} + +bool SimpleBacksolver::InitializeImpl( + const OptionsList& options, + const std::string& prefix +) +{ + DBG_START_METH("SimpleBackSolver::InitializeImpl", dbg_verbosity); + + options.GetBoolValue("sens_allow_inexact_backsolve", allow_inexact_, prefix); + return true; +} + +bool SimpleBacksolver::Solve( + SmartPtr delta_lhs, + SmartPtr delta_rhs +) +{ + DBG_START_METH("SimpleBacksolver::Solve(IteratesVector,IteratesVector)", dbg_verbosity); + + bool retval; + bool improve_solution = false; + + retval = pd_solver_->Solve(1.0, 0.0, *delta_rhs, *delta_lhs, allow_inexact_, improve_solution); + + return retval; +} + +} // end namespace diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensSimpleBacksolver.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensSimpleBacksolver.hpp new file mode 100644 index 000000000..152bc3e91 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensSimpleBacksolver.hpp @@ -0,0 +1,49 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-04-06 +// +// Purpose : This is the same as IpSensitivityCalculator.hpp +// It implements the SensBacksolver Interface. + +#ifndef __ASSIMPLEBACKSOLVER_HPP__ +#define __ASSIMPLEBACKSOLVER_HPP__ + +#include "IpPDSystemSolver.hpp" +#include "SensBacksolver.hpp" + +namespace Ipopt +{ + +class SIPOPTLIB_EXPORT SimpleBacksolver: public SensBacksolver +{ +public: + + SimpleBacksolver( + SmartPtr pd_solver + ); + + ~SimpleBacksolver() + { } + + bool InitializeImpl( + const OptionsList& options, + const std::string& prefix + ); + + bool Solve( + SmartPtr delta_lhs, + SmartPtr delta_rhs + ); + +private: + SimpleBacksolver(); + + SmartPtr pd_solver_; + bool allow_inexact_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensStdStepCalc.cpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensStdStepCalc.cpp new file mode 100644 index 000000000..b634ab98e --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensStdStepCalc.cpp @@ -0,0 +1,282 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-16 + +#include "SensStdStepCalc.hpp" +#include "IpDenseVector.hpp" +#include "IpIteratesVector.hpp" +#include "IpBlas.hpp" +#include "SensIndexSchurData.hpp" + +namespace Ipopt +{ +#if IPOPT_VERBOSITY > 0 +static const Index dbg_verbosity = 1; +#endif + +StdStepCalculator::StdStepCalculator( + SmartPtr ift_data, + SmartPtr backsolver +) + : ift_data_(ift_data), + backsolver_(backsolver), + bound_eps_(1e-3), + kkt_residuals_(true), + SensitivityVector(NULL) +{ + DBG_START_METH("StdStepCalculator::StdStepCalculator", dbg_verbosity); +} + +StdStepCalculator::~StdStepCalculator() +{ + DBG_START_METH("StdStepCalculator::~StdStepCalculator", dbg_verbosity); +} + +bool StdStepCalculator::InitializeImpl( + const OptionsList& options, + const std::string& prefix +) +{ + options.GetNumericValue("sens_bound_eps", bound_eps_, prefix); + options.GetBoolValue("sens_kkt_residuals", kkt_residuals_, prefix); + SensitivityStepCalculator::InitializeImpl(options, prefix); + return true; +} + +bool StdStepCalculator::Step( + DenseVector& delta_u, + IteratesVector& sol +) +{ + DBG_START_METH("StdStepCalculator::Step", dbg_verbosity); + + bool retval; + retval = true; /* FIXME added to have retval initialized, but does it make sense??? */ + + SmartPtr delta_u_long = IpData().trial()->MakeNewIteratesVector(); + ift_data_->TransMultiply(delta_u, *delta_u_long); + + SmartPtr r_s = IpData().trial()->MakeNewIteratesVector(); + if( kkt_residuals_ ) + { + /* This should be almost zero... */ + r_s->Set_x_NonConst(*IpCq().curr_grad_lag_x()->MakeNewCopy()); + r_s->Set_s_NonConst(*IpCq().curr_grad_lag_s()->MakeNewCopy()); + r_s->Set_y_c_NonConst(*IpCq().curr_c()->MakeNewCopy()); + r_s->Set_y_d_NonConst(*IpCq().curr_d_minus_s()->MakeNewCopy()); + r_s->Set_z_L_NonConst(*IpCq().curr_compl_x_L()->MakeNewCopy()); + r_s->Set_z_U_NonConst(*IpCq().curr_compl_x_U()->MakeNewCopy()); + r_s->Set_v_L_NonConst(*IpCq().curr_compl_s_L()->MakeNewCopy()); + r_s->Set_v_U_NonConst(*IpCq().curr_compl_s_U()->MakeNewCopy()); + + r_s->Print(Jnlst(), J_VECTOR, J_USER1, "r_s init"); + delta_u.Print(Jnlst(), J_VECTOR, J_USER1, "delta_u init"); + DBG_PRINT((dbg_verbosity, "r_s init Nrm2=%23.16e\n", r_s->Asum())); + + delta_u_long->Print(Jnlst(), J_VECTOR, J_USER1, "delta_u_long before"); + delta_u_long->Axpy(-1.0, *r_s); + } + + delta_u_long->Print(Jnlst(), J_VECTOR, J_USER1, "delta_u_long"); + backsolver_->Solve(&sol, ConstPtr(delta_u_long)); + + // make a copy of the sensitivites + SensitivityVector = (&sol)->MakeNewIteratesVectorCopy(); + + // print it out + SensitivityVector->Print(Jnlst(), J_VECTOR, J_USER1, "SensitivityVector stdcalc"); + + SmartPtr Kr_s; + if( Do_Boundcheck() ) + { + Kr_s = sol.MakeNewIteratesVectorCopy(); + } + + sol.Axpy(1.0, *IpData().trial()); + + if( Do_Boundcheck() ) + { + DBG_PRINT((dbg_verbosity, "Entering boundcheck")); + // initialize + Index new_du_size = 0; + Number* new_du_values; + std::vector x_bound_violations_idx; + std::vector x_bound_violations_du; + std::vector delta_u_sort; + bool bounds_violated; + SmartPtr delta_u_space = new DenseVectorSpace(0); + SmartPtr old_delta_u = new DenseVector(GetRawPtr(delta_u_space)); + SmartPtr new_delta_u; + + bounds_violated = BoundCheck(sol, x_bound_violations_idx, x_bound_violations_du); + while( bounds_violated ) + { + Driver()->data_A()->Print(Jnlst(), J_VECTOR, J_USER1, "data_A_init"); + Driver()->data_B()->Print(Jnlst(), J_VECTOR, J_USER1, "data_B_init"); + // write new schurdata A + dynamic_cast(GetRawPtr(Driver()->data_A_nonconst()))->AddData_List(x_bound_violations_idx, + delta_u_sort, new_du_size, 1); + // write new schurdata B + dynamic_cast(GetRawPtr(Driver()->data_B_nonconst()))->AddData_List(x_bound_violations_idx, + delta_u_sort, new_du_size, 1); + Driver()->data_A()->Print(Jnlst(), J_VECTOR, J_USER1, "data_A"); + Driver()->data_B()->Print(Jnlst(), J_VECTOR, J_USER1, "data_B"); + Driver()->SchurBuild(); + Driver()->SchurFactorize(); + + old_delta_u->Print(Jnlst(), J_VECTOR, J_USER1, "old_delta_u"); + delta_u_space = NULL; // delete old delta_u space + delta_u_space = new DenseVectorSpace(new_du_size); // create new delta_u space + new_delta_u = new DenseVector(GetRawPtr(ConstPtr(delta_u_space))); + new_du_values = new_delta_u->Values(); + IpBlasDcopy(old_delta_u->Dim(), old_delta_u->Values(), 1, new_du_values, 1); + for( Index i = 0; i < (int) x_bound_violations_idx.size(); ++i ) + { + // printf("i=%d, delta_u_sort[i]=%d, x_bound_viol_du[i]=%f\n", i, delta_u_sort[i], x_bound_violations_du[i]); + new_du_values[delta_u_sort[i]] = x_bound_violations_du[i]; + } + SmartPtr new_sol = sol.MakeNewIteratesVector(); + new_delta_u->Print(Jnlst(), J_VECTOR, J_USER1, "new_delta_u"); + + // solve with new data_B and delta_u + retval = Driver()->SchurSolve(&sol, ConstPtr(delta_u_long), dynamic_cast(GetRawPtr(new_delta_u)), + Kr_s); + + // make a copy of the sensitivites with bound checks + SensitivityVector = (&sol)->MakeNewIteratesVectorCopy(); + + sol.Axpy(1.0, *IpData().trial()); + + x_bound_violations_idx.clear(); + x_bound_violations_du.clear(); + delta_u_sort.clear(); + bounds_violated = BoundCheck(sol, x_bound_violations_idx, x_bound_violations_du); + // copy new vector in old vector ->has to be done becpause otherwise only pointers will be copied and then it makes no sense + old_delta_u = new_delta_u->MakeNewDenseVector(); + old_delta_u->Copy(*new_delta_u); + } + } + + return retval; +} + +bool StdStepCalculator::BoundCheck( + IteratesVector& sol, + std::vector& x_bound_violations_idx, + std::vector& x_bound_violations_du +) +{ + DBG_START_METH("StdStepCalculator::BoundCheck", dbg_verbosity); + + DBG_ASSERT(x_bound_violations_idx.empty()); + DBG_ASSERT(x_bound_violations_du.empty()); + + // find bound violations in x vector + const Number* x_val = dynamic_cast(GetRawPtr(IpData().curr()->x()))->Values(); + const Number* sol_val = dynamic_cast(GetRawPtr(sol.x()))->Values(); + + SmartPtr x_L_exp = IpData().curr()->x()->MakeNew(); + SmartPtr x_U_exp = IpData().curr()->x()->MakeNew(); + + SmartPtr x_L_comp = IpNLP().x_L()->MakeNew(); + SmartPtr x_U_comp = IpNLP().x_U()->MakeNew(); + + IpNLP().Px_L()->TransMultVector(1.0, *sol.x(), 0.0, *x_L_comp); + IpNLP().Px_U()->TransMultVector(1.0, *sol.x(), 0.0, *x_U_comp); + + x_L_comp->Print(Jnlst(), J_VECTOR, J_USER1, "x_L_comp"); + x_U_comp->Print(Jnlst(), J_VECTOR, J_USER1, "x_U_comp"); + // return false; + + Number* x_L_val = dynamic_cast(GetRawPtr(x_L_comp))->Values(); + Number* x_U_val = dynamic_cast(GetRawPtr(x_U_comp))->Values(); + + const Number* x_L_bound = dynamic_cast(GetRawPtr(IpNLP().x_L()))->Values(); + const Number* x_U_bound = dynamic_cast(GetRawPtr(IpNLP().x_U()))->Values(); + + for( Index i = 0; i < x_L_comp->Dim(); ++i ) + { + x_L_val[i] -= x_L_bound[i]; + } + + for( Index i = 0; i < x_U_comp->Dim(); ++i ) + { + x_U_val[i] -= x_U_bound[i]; + } + + // project back + IpNLP().Px_L()->MultVector(1.0, *x_L_comp, 0.0, *x_L_exp); + IpNLP().Px_U()->MultVector(1.0, *x_U_comp, 0.0, *x_U_exp); + + const Number* x_L_exp_val = dynamic_cast(GetRawPtr(x_L_exp))->Values(); + const Number* x_U_exp_val = dynamic_cast(GetRawPtr(x_U_exp))->Values(); + + for( Index i = 0; i < x_L_exp->Dim(); ++i ) + { + if( x_L_exp_val[i] < -bound_eps_ ) + { + x_bound_violations_idx.push_back(i); + x_bound_violations_du.push_back(-x_L_exp_val[i] + sol_val[i] - x_val[i]); // this is just an awkward way to compute x_bound[i] - x_curr_val[i]. + } + else if( -x_U_exp_val[i] < -bound_eps_ ) + { + x_bound_violations_idx.push_back(i); + x_bound_violations_du.push_back(-x_U_exp_val[i] + sol_val[i] - x_val[i]); + } + } + + // z_L and z_U bound violations -> These are much easier since there is no projecting back and forth + SmartPtr z_L = dynamic_cast(GetRawPtr(sol.z_L())); + SmartPtr z_U = dynamic_cast(GetRawPtr(sol.z_U())); + z_L->Print(Jnlst(), J_VECTOR, J_USER1, "z_L_boundcheck"); + z_U->Print(Jnlst(), J_VECTOR, J_USER1, "z_U_boundcheck"); + const Number* z_L_val = z_L->Values(); + const Number* z_U_val = z_U->Values(); + + SmartPtr z_L_trial = dynamic_cast(GetRawPtr(IpData().trial()->z_L())); + SmartPtr z_U_trial = dynamic_cast(GetRawPtr(IpData().trial()->z_U())); + const Number* z_L_trial_val = z_L_trial->Values(); + const Number* z_U_trial_val = z_U_trial->Values(); + + // find absolute index of z_L and z_U in IteratesVector + Index z_L_ItVec_idx = 0; + for( Index i = 0; i < 4; ++i ) + { + z_L_ItVec_idx += (sol.GetComp(i))->Dim(); + } + Index z_U_ItVec_idx = z_L_ItVec_idx + sol.z_L()->Dim(); + + for( Index i = 0; i < z_L->Dim(); ++i ) + { + if( z_L_val[i] < -bound_eps_ ) + { + x_bound_violations_idx.push_back(i + z_L_ItVec_idx); + x_bound_violations_du.push_back(-z_L_trial_val[i]); + //printf("Lower Bound Mult. no. i=%d invalid: delta_u=%f\n", i+z_L_ItVec_idx, z_L_val[i]); + } + } + + for( Index i = 0; i < z_U->Dim(); ++i ) + { + if( z_U_val[i] < -bound_eps_ ) + { + x_bound_violations_idx.push_back(i + z_U_ItVec_idx); + x_bound_violations_du.push_back(-z_U_trial_val[i]); + //printf("Upper Bound Mult. no. i=%d invalid: delta_u=%f\n", i+z_U_ItVec_idx, z_U_val[i]); + } + } + + // if (x_bound_violations_idx.empty() || z_L_bound_violations_idx.empty() || z_U_bound_violations_idx.empty()) { + if( x_bound_violations_idx.empty() ) + { + return false; + } + else + { + return true; + } +} + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensStdStepCalc.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensStdStepCalc.hpp new file mode 100644 index 000000000..c350164fb --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensStdStepCalc.hpp @@ -0,0 +1,67 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-16 + +#ifndef __ASSTDSTEPCALC_HPP__ +#define __ASSTDSTEPCALC_HPP__ + +#include "SensBacksolver.hpp" +#include "SensStepCalc.hpp" +#include "IpDenseVector.hpp" +#include "IpIteratesVector.hpp" + +#include + +namespace Ipopt +{ + +class StdStepCalculator: public SensitivityStepCalculator +{ +public: + StdStepCalculator( + SmartPtr ift_data, + SmartPtr backsolver + ); + + virtual ~StdStepCalculator(); + + virtual bool InitializeImpl( + const OptionsList& options, + const std::string& prefix + ); + + /** This is the main algorithmic function of this class. + * + * It calculates a step using its SchurDriver, checks bounds, and returns it + */ + virtual bool Step( + DenseVector& delta_u, + IteratesVector& sol + ); + + bool BoundCheck( + IteratesVector& sol, + std::vector& x_bound_violations_idx, + std::vector& x_bound_violations_du + ); + + /** return the sensitivity vector */ + virtual SmartPtr GetSensitivityVector(void) + { + return SensitivityVector; + } + +private: + SmartPtr ift_data_; + SmartPtr backsolver_; + Number bound_eps_; + bool kkt_residuals_; + + SmartPtr SensitivityVector; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensStepCalc.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensStepCalc.hpp new file mode 100644 index 000000000..406ca8d35 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensStepCalc.hpp @@ -0,0 +1,85 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-14 + +#ifndef __ASSENSSTEPCALC_HPP__ +#define __ASSENSSTEPCALC_HPP__ + +#include "IpAlgStrategy.hpp" +#include "SensSchurDriver.hpp" + +namespace Ipopt +{ +/* Forward declarations */ +class DenseVector; +class IteratesVector; + +/** This is the interface for the classes that perform the actual step. */ +class SIPOPTLIB_EXPORT SensitivityStepCalculator: public AlgorithmStrategyObject +{ +public: + SensitivityStepCalculator() + : driver_(NULL), + do_boundcheck_(false) + { } + + virtual ~SensitivityStepCalculator() + { } + + virtual bool InitializeImpl( + const OptionsList& options, + const std::string& prefix + ) + { + options.GetBoolValue("sens_boundcheck", do_boundcheck_, prefix); + return true; + } + + bool Do_Boundcheck() const + { + return do_boundcheck_; + } + + void SetSchurDriver( + SmartPtr driver + ) + { + DBG_ASSERT(IsValid(driver)); + + driver_ = driver; + if( IsValid(driver_->pcalc_nonconst()) ) + { + driver_->pcalc_nonconst()->reset_data_A(); + // when the schurdriver is set, the data in the pcalculator has to be reset to its data? + } + } + + SmartPtr Driver() // this should be const or protected + { + DBG_ASSERT(IsValid(driver_)); + + return driver_; + } + + /** This is the main algorithmic function of this class. + * + * It calculates a step using its SchurDriver, checks bounds, and returns it + */ + virtual bool Step( + DenseVector& delta_u, + IteratesVector& sol + ) = 0; + + /** return the sensitivity vector */ + virtual SmartPtr GetSensitivityVector() = 0; + +private: + SmartPtr driver_; + bool do_boundcheck_; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensSuffixHandler.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensSuffixHandler.hpp new file mode 100644 index 000000000..c8fbaa179 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensSuffixHandler.hpp @@ -0,0 +1,37 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-08-01 + +#ifndef __SENS_ASSUFFIXHANDLER_HPP__ +#define __SENS_ASSUFFIXHANDLER_HPP__ + +#include "IpReferenced.hpp" +#include +#include + +namespace Ipopt +{ + +/** This class is the interface for all classes that can return indices. + * + * The implementation for Ampl is done in the MetadataMeasurement class. + */ +class SuffixHandler: public ReferencedObject +{ +public: + SuffixHandler() + { } + + virtual ~SuffixHandler() + { } + + virtual std::vector GetIntegerSuffix( + std::string suffix_string + ) = 0; +}; + +} + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensUtils.cpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensUtils.cpp new file mode 100644 index 000000000..93fa97d72 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensUtils.cpp @@ -0,0 +1,129 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-19 + +#include "SensUtils.hpp" +#include + +namespace Ipopt +{ + +Index AsIndexMax( + Index length, + const Index* x, + Index Incr +) +{ + if( length == 0 ) + { + return 0; + } + Index maxval = x[0]; + for( Index i = 1; i < length; i += Incr ) + { + if( x[i] > maxval ) + { + maxval = x[i]; + } + } + return maxval; +} + +Index AsIndexSum( + Index length, + const Index* x, + Index Incr +) +{ + Index retval = 0; + for( Index i = 0; i < length; i += Incr ) + { + retval += x[i]; + } + return retval; +} + +void append_Index( + std::string& str, + Index idx +) +{ + std::stringstream idx_stream; + idx_stream << idx; + std::string idx_string = idx_stream.str(); + str.append(idx_string); +} + +SolverReturn AppReturn2SolverReturn( + ApplicationReturnStatus ipopt_retval +) +{ + SolverReturn retval; + switch( ipopt_retval ) + { + case Solve_Succeeded: + retval = SUCCESS; + break; + case Solved_To_Acceptable_Level: + retval = STOP_AT_ACCEPTABLE_POINT; + break; + case Infeasible_Problem_Detected: + retval = LOCAL_INFEASIBILITY; + break; + case Search_Direction_Becomes_Too_Small: + retval = STOP_AT_TINY_STEP; + break; + case Diverging_Iterates: + retval = DIVERGING_ITERATES; + break; + case User_Requested_Stop: + retval = USER_REQUESTED_STOP; + break; + case Feasible_Point_Found: + retval = FEASIBLE_POINT_FOUND; + break; + case Maximum_Iterations_Exceeded: + retval = MAXITER_EXCEEDED; + break; + case Restoration_Failed: + retval = RESTORATION_FAILURE; + break; + case Error_In_Step_Computation: + retval = ERROR_IN_STEP_COMPUTATION; + break; + case Maximum_CpuTime_Exceeded: + retval = CPUTIME_EXCEEDED; + break; + case Not_Enough_Degrees_Of_Freedom: + retval = TOO_FEW_DEGREES_OF_FREEDOM; + break; + case Invalid_Problem_Definition: + retval = UNASSIGNED; + break; + case Invalid_Option: + retval = INVALID_OPTION; + break; + case Invalid_Number_Detected: + retval = INVALID_NUMBER_DETECTED; + break; + case Unrecoverable_Exception: + retval = UNASSIGNED; + break; + case NonIpopt_Exception_Thrown: + retval = UNASSIGNED; + break; + case Insufficient_Memory: + retval = OUT_OF_MEMORY; + break; + case Internal_Error: + retval = INTERNAL_ERROR; + break; + default: + retval = UNASSIGNED; + } + return retval; +} + +} diff --git a/Ipopt-3.13.4/contrib/sIPOPT/src/SensUtils.hpp b/Ipopt-3.13.4/contrib/sIPOPT/src/SensUtils.hpp new file mode 100644 index 000000000..8bf73b5c0 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/src/SensUtils.hpp @@ -0,0 +1,63 @@ +// Copyright 2009, 2011 Hans Pirnay +// All Rights Reserved. +// This code is published under the Eclipse Public License. +// +// Date : 2009-05-14 + +#ifndef __SENSCUTILS_HPP__ +#define __SENSCUTILS_HPP__ + +#include "IpUtils.hpp" +#include "IpAlgTypes.hpp" +#include "IpReturnCodes.hpp" + +#include + +namespace Ipopt +{ + +/* This header file provides some definitions used throughout the program. */ + +enum SensAlgorithmExitStatus +{ + SOLVE_SUCCESS, + FATAL_ERROR +}; + +SIPOPTLIB_EXPORT Index AsIndexMax( + Index length, + const Index* x, + Index Incr +); + +SIPOPTLIB_EXPORT Index AsIndexSum( + Index length, + const Index* x, + Index Incr +); + +SIPOPTLIB_EXPORT void append_Index( + std::string& str, + Index idx +); + +SIPOPTLIB_EXPORT SolverReturn AppReturn2SolverReturn( + ApplicationReturnStatus ipopt_retval +); +} + +// same as DECLARE_STD_EXCEPTION, but using SIPOPTLIB_EXPORT instead of IPOPTLIB_EXPORT +#define DECLARE_STD_SIPOPT_EXCEPTION(__except_type) \ + class SIPOPTLIB_EXPORT __except_type : public Ipopt::IpoptException \ + { \ + public: \ + __except_type(std::string msg, std::string fname, Ipopt::Index line) \ + : Ipopt::IpoptException(msg,fname,line, #__except_type) {} \ + __except_type(const __except_type& copy) \ + : Ipopt::IpoptException(copy) {} \ + private: \ + __except_type(); \ + void operator=(const __except_type&); \ + } + +#endif diff --git a/Ipopt-3.13.4/contrib/sIPOPT/toDo.txt b/Ipopt-3.13.4/contrib/sIPOPT/toDo.txt new file mode 100644 index 000000000..1917d9e68 --- /dev/null +++ b/Ipopt-3.13.4/contrib/sIPOPT/toDo.txt @@ -0,0 +1,65 @@ +AmplTNLP +- rewrite get_suffixhandler as const + +SensAmplTNLP +- errorcheck in get_number_suffix for NULL suffix +- remove get_bounds_info ? + +AmplMeasurement ++ replace string operations by append_Index function + +SchurData ++ try easy implementations for Multiply/Transmultiply in SchurData (see e.g. TransMultiply) ++ write functions that set the schurdata from z.b. arrays ++ write MakeNewCopy() functions for all implementations ++ write new constructor to make this easier +- Remove StdSchurData? +- exchange GetMultiplyingVectors by a transmultiply implementation that accepts pointers. + (see StdPCalculator for the only use of this function) + +AsSensStepCalc ++ move InitializeImpl to the implementation! +- change boundchecking: instead of bound_check yes/no have option bound_check active_set/step_until_bound/none which will then call the appropriate module. Make sure that active_set is only used in conjunction with the Schur algorithms + +AsIndexPCalculator ++ use std::map instead of std::vector for PColumn list so it is easier to sort/find them + +SchurDriver ++ write InitializeImpl + +SensController ++ write InitializeImpl + +SensApplication +- in function SetIpoptAlgorithmObjects: rewrite checking of consistency of inputs + +SensTNLPAdapter ++ write inverse of ResortX in TNLPAdapter + +MakeFile ++ Remove AsSenscSetup if decided so + +General ++ include print functions for all major classes. Allows deep testing ++ include #ifndefs in all new header files ++ make sure debug mode is switched on in every cpp file +- think about using the same ownerspace for all u-vectors - makes use of meta-data possible ++ decide on AsSenscSetup (decision made: get rid of it) ++ Add options to decide which Pcalc to use ++ Add options to decide which SchurData to use (this is in a lot of places...) +- Add options to decide which SchurDriver to use ++ All classes that have at least one virtual function should have virtual destructors +- Add assignment operator and copy constructor to all classes +- All these warnings with vector.size() comparisons? +- test with valgrind +- where does the function go that resets the SchurData?? +- measure time for each action +- decent output at beginning and end ++ is SensAmplTNLP necessary to be given to SensApplication?? +- the measurement class should go outside the library so everyone can/must write their own measurement class + +Milestones ++ wrote method to deal with scaling that resembles IpOrigIpopt:finalize_solution ++ write a makefile.am and get it to compile as an add-on to ipopt with the new nlp structure. ++ write print functions and test schur calculation + diff --git a/Ipopt-3.13.4/depcomp b/Ipopt-3.13.4/depcomp new file mode 100755 index 000000000..6b391623c --- /dev/null +++ b/Ipopt-3.13.4/depcomp @@ -0,0 +1,791 @@ +#! /bin/sh +# depcomp - compile a program generating dependencies as side-effects + +scriptversion=2018-03-07.03; # UTC + +# Copyright (C) 1999-2020 Free Software Foundation, Inc. + +# 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 Free Software Foundation; either version 2, or (at your option) +# any later version. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + +# Originally written by Alexandre Oliva . + +case $1 in + '') + echo "$0: No command. Try '$0 --help' for more information." 1>&2 + exit 1; + ;; + -h | --h*) + cat <<\EOF +Usage: depcomp [--help] [--version] PROGRAM [ARGS] + +Run PROGRAMS ARGS to compile a file, generating dependencies +as side-effects. + +Environment variables: + depmode Dependency tracking mode. + source Source file read by 'PROGRAMS ARGS'. + object Object file output by 'PROGRAMS ARGS'. + DEPDIR directory where to store dependencies. + depfile Dependency file to output. + tmpdepfile Temporary file to use when outputting dependencies. + libtool Whether libtool is used (yes/no). + +Report bugs to . +EOF + exit $? + ;; + -v | --v*) + echo "depcomp $scriptversion" + exit $? + ;; +esac + +# Get the directory component of the given path, and save it in the +# global variables '$dir'. Note that this directory component will +# be either empty or ending with a '/' character. This is deliberate. +set_dir_from () +{ + case $1 in + */*) dir=`echo "$1" | sed -e 's|/[^/]*$|/|'`;; + *) dir=;; + esac +} + +# Get the suffix-stripped basename of the given path, and save it the +# global variable '$base'. +set_base_from () +{ + base=`echo "$1" | sed -e 's|^.*/||' -e 's/\.[^.]*$//'` +} + +# If no dependency file was actually created by the compiler invocation, +# we still have to create a dummy depfile, to avoid errors with the +# Makefile "include basename.Plo" scheme. +make_dummy_depfile () +{ + echo "#dummy" > "$depfile" +} + +# Factor out some common post-processing of the generated depfile. +# Requires the auxiliary global variable '$tmpdepfile' to be set. +aix_post_process_depfile () +{ + # If the compiler actually managed to produce a dependency file, + # post-process it. + if test -f "$tmpdepfile"; then + # Each line is of the form 'foo.o: dependency.h'. + # Do two passes, one to just change these to + # $object: dependency.h + # and one to simply output + # dependency.h: + # which is needed to avoid the deleted-header problem. + { sed -e "s,^.*\.[$lower]*:,$object:," < "$tmpdepfile" + sed -e "s,^.*\.[$lower]*:[$tab ]*,," -e 's,$,:,' < "$tmpdepfile" + } > "$depfile" + rm -f "$tmpdepfile" + else + make_dummy_depfile + fi +} + +# A tabulation character. +tab=' ' +# A newline character. +nl=' +' +# Character ranges might be problematic outside the C locale. +# These definitions help. +upper=ABCDEFGHIJKLMNOPQRSTUVWXYZ +lower=abcdefghijklmnopqrstuvwxyz +digits=0123456789 +alpha=${upper}${lower} + +if test -z "$depmode" || test -z "$source" || test -z "$object"; then + echo "depcomp: Variables source, object and depmode must be set" 1>&2 + exit 1 +fi + +# Dependencies for sub/bar.o or sub/bar.obj go into sub/.deps/bar.Po. +depfile=${depfile-`echo "$object" | + sed 's|[^\\/]*$|'${DEPDIR-.deps}'/&|;s|\.\([^.]*\)$|.P\1|;s|Pobj$|Po|'`} +tmpdepfile=${tmpdepfile-`echo "$depfile" | sed 's/\.\([^.]*\)$/.T\1/'`} + +rm -f "$tmpdepfile" + +# Avoid interferences from the environment. +gccflag= dashmflag= + +# Some modes work just like other modes, but use different flags. We +# parameterize here, but still list the modes in the big case below, +# to make depend.m4 easier to write. Note that we *cannot* use a case +# here, because this file can only contain one case statement. +if test "$depmode" = hp; then + # HP compiler uses -M and no extra arg. + gccflag=-M + depmode=gcc +fi + +if test "$depmode" = dashXmstdout; then + # This is just like dashmstdout with a different argument. + dashmflag=-xM + depmode=dashmstdout +fi + +cygpath_u="cygpath -u -f -" +if test "$depmode" = msvcmsys; then + # This is just like msvisualcpp but w/o cygpath translation. + # Just convert the backslash-escaped backslashes to single forward + # slashes to satisfy depend.m4 + cygpath_u='sed s,\\\\,/,g' + depmode=msvisualcpp +fi + +if test "$depmode" = msvc7msys; then + # This is just like msvc7 but w/o cygpath translation. + # Just convert the backslash-escaped backslashes to single forward + # slashes to satisfy depend.m4 + cygpath_u='sed s,\\\\,/,g' + depmode=msvc7 +fi + +if test "$depmode" = xlc; then + # IBM C/C++ Compilers xlc/xlC can output gcc-like dependency information. + gccflag=-qmakedep=gcc,-MF + depmode=gcc +fi + +case "$depmode" in +gcc3) +## gcc 3 implements dependency tracking that does exactly what +## we want. Yay! Note: for some reason libtool 1.4 doesn't like +## it if -MD -MP comes after the -MF stuff. Hmm. +## Unfortunately, FreeBSD c89 acceptance of flags depends upon +## the command line argument order; so add the flags where they +## appear in depend2.am. Note that the slowdown incurred here +## affects only configure: in makefiles, %FASTDEP% shortcuts this. + for arg + do + case $arg in + -c) set fnord "$@" -MT "$object" -MD -MP -MF "$tmpdepfile" "$arg" ;; + *) set fnord "$@" "$arg" ;; + esac + shift # fnord + shift # $arg + done + "$@" + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile" + exit $stat + fi + mv "$tmpdepfile" "$depfile" + ;; + +gcc) +## Note that this doesn't just cater to obsosete pre-3.x GCC compilers. +## but also to in-use compilers like IMB xlc/xlC and the HP C compiler. +## (see the conditional assignment to $gccflag above). +## There are various ways to get dependency output from gcc. Here's +## why we pick this rather obscure method: +## - Don't want to use -MD because we'd like the dependencies to end +## up in a subdir. Having to rename by hand is ugly. +## (We might end up doing this anyway to support other compilers.) +## - The DEPENDENCIES_OUTPUT environment variable makes gcc act like +## -MM, not -M (despite what the docs say). Also, it might not be +## supported by the other compilers which use the 'gcc' depmode. +## - Using -M directly means running the compiler twice (even worse +## than renaming). + if test -z "$gccflag"; then + gccflag=-MD, + fi + "$@" -Wp,"$gccflag$tmpdepfile" + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile" + exit $stat + fi + rm -f "$depfile" + echo "$object : \\" > "$depfile" + # The second -e expression handles DOS-style file names with drive + # letters. + sed -e 's/^[^:]*: / /' \ + -e 's/^['$alpha']:\/[^:]*: / /' < "$tmpdepfile" >> "$depfile" +## This next piece of magic avoids the "deleted header file" problem. +## The problem is that when a header file which appears in a .P file +## is deleted, the dependency causes make to die (because there is +## typically no way to rebuild the header). We avoid this by adding +## dummy dependencies for each header file. Too bad gcc doesn't do +## this for us directly. +## Some versions of gcc put a space before the ':'. On the theory +## that the space means something, we add a space to the output as +## well. hp depmode also adds that space, but also prefixes the VPATH +## to the object. Take care to not repeat it in the output. +## Some versions of the HPUX 10.20 sed can't process this invocation +## correctly. Breaking it into two sed invocations is a workaround. + tr ' ' "$nl" < "$tmpdepfile" \ + | sed -e 's/^\\$//' -e '/^$/d' -e "s|.*$object$||" -e '/:$/d' \ + | sed -e 's/$/ :/' >> "$depfile" + rm -f "$tmpdepfile" + ;; + +hp) + # This case exists only to let depend.m4 do its work. It works by + # looking at the text of this script. This case will never be run, + # since it is checked for above. + exit 1 + ;; + +sgi) + if test "$libtool" = yes; then + "$@" "-Wp,-MDupdate,$tmpdepfile" + else + "$@" -MDupdate "$tmpdepfile" + fi + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile" + exit $stat + fi + rm -f "$depfile" + + if test -f "$tmpdepfile"; then # yes, the sourcefile depend on other files + echo "$object : \\" > "$depfile" + # Clip off the initial element (the dependent). Don't try to be + # clever and replace this with sed code, as IRIX sed won't handle + # lines with more than a fixed number of characters (4096 in + # IRIX 6.2 sed, 8192 in IRIX 6.5). We also remove comment lines; + # the IRIX cc adds comments like '#:fec' to the end of the + # dependency line. + tr ' ' "$nl" < "$tmpdepfile" \ + | sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' \ + | tr "$nl" ' ' >> "$depfile" + echo >> "$depfile" + # The second pass generates a dummy entry for each header file. + tr ' ' "$nl" < "$tmpdepfile" \ + | sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' -e 's/$/:/' \ + >> "$depfile" + else + make_dummy_depfile + fi + rm -f "$tmpdepfile" + ;; + +xlc) + # This case exists only to let depend.m4 do its work. It works by + # looking at the text of this script. This case will never be run, + # since it is checked for above. + exit 1 + ;; + +aix) + # The C for AIX Compiler uses -M and outputs the dependencies + # in a .u file. In older versions, this file always lives in the + # current directory. Also, the AIX compiler puts '$object:' at the + # start of each line; $object doesn't have directory information. + # Version 6 uses the directory in both cases. + set_dir_from "$object" + set_base_from "$object" + if test "$libtool" = yes; then + tmpdepfile1=$dir$base.u + tmpdepfile2=$base.u + tmpdepfile3=$dir.libs/$base.u + "$@" -Wc,-M + else + tmpdepfile1=$dir$base.u + tmpdepfile2=$dir$base.u + tmpdepfile3=$dir$base.u + "$@" -M + fi + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" + exit $stat + fi + + for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" + do + test -f "$tmpdepfile" && break + done + aix_post_process_depfile + ;; + +tcc) + # tcc (Tiny C Compiler) understand '-MD -MF file' since version 0.9.26 + # FIXME: That version still under development at the moment of writing. + # Make that this statement remains true also for stable, released + # versions. + # It will wrap lines (doesn't matter whether long or short) with a + # trailing '\', as in: + # + # foo.o : \ + # foo.c \ + # foo.h \ + # + # It will put a trailing '\' even on the last line, and will use leading + # spaces rather than leading tabs (at least since its commit 0394caf7 + # "Emit spaces for -MD"). + "$@" -MD -MF "$tmpdepfile" + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile" + exit $stat + fi + rm -f "$depfile" + # Each non-empty line is of the form 'foo.o : \' or ' dep.h \'. + # We have to change lines of the first kind to '$object: \'. + sed -e "s|.*:|$object :|" < "$tmpdepfile" > "$depfile" + # And for each line of the second kind, we have to emit a 'dep.h:' + # dummy dependency, to avoid the deleted-header problem. + sed -n -e 's|^ *\(.*\) *\\$|\1:|p' < "$tmpdepfile" >> "$depfile" + rm -f "$tmpdepfile" + ;; + +## The order of this option in the case statement is important, since the +## shell code in configure will try each of these formats in the order +## listed in this file. A plain '-MD' option would be understood by many +## compilers, so we must ensure this comes after the gcc and icc options. +pgcc) + # Portland's C compiler understands '-MD'. + # Will always output deps to 'file.d' where file is the root name of the + # source file under compilation, even if file resides in a subdirectory. + # The object file name does not affect the name of the '.d' file. + # pgcc 10.2 will output + # foo.o: sub/foo.c sub/foo.h + # and will wrap long lines using '\' : + # foo.o: sub/foo.c ... \ + # sub/foo.h ... \ + # ... + set_dir_from "$object" + # Use the source, not the object, to determine the base name, since + # that's sadly what pgcc will do too. + set_base_from "$source" + tmpdepfile=$base.d + + # For projects that build the same source file twice into different object + # files, the pgcc approach of using the *source* file root name can cause + # problems in parallel builds. Use a locking strategy to avoid stomping on + # the same $tmpdepfile. + lockdir=$base.d-lock + trap " + echo '$0: caught signal, cleaning up...' >&2 + rmdir '$lockdir' + exit 1 + " 1 2 13 15 + numtries=100 + i=$numtries + while test $i -gt 0; do + # mkdir is a portable test-and-set. + if mkdir "$lockdir" 2>/dev/null; then + # This process acquired the lock. + "$@" -MD + stat=$? + # Release the lock. + rmdir "$lockdir" + break + else + # If the lock is being held by a different process, wait + # until the winning process is done or we timeout. + while test -d "$lockdir" && test $i -gt 0; do + sleep 1 + i=`expr $i - 1` + done + fi + i=`expr $i - 1` + done + trap - 1 2 13 15 + if test $i -le 0; then + echo "$0: failed to acquire lock after $numtries attempts" >&2 + echo "$0: check lockdir '$lockdir'" >&2 + exit 1 + fi + + if test $stat -ne 0; then + rm -f "$tmpdepfile" + exit $stat + fi + rm -f "$depfile" + # Each line is of the form `foo.o: dependent.h', + # or `foo.o: dep1.h dep2.h \', or ` dep3.h dep4.h \'. + # Do two passes, one to just change these to + # `$object: dependent.h' and one to simply `dependent.h:'. + sed "s,^[^:]*:,$object :," < "$tmpdepfile" > "$depfile" + # Some versions of the HPUX 10.20 sed can't process this invocation + # correctly. Breaking it into two sed invocations is a workaround. + sed 's,^[^:]*: \(.*\)$,\1,;s/^\\$//;/^$/d;/:$/d' < "$tmpdepfile" \ + | sed -e 's/$/ :/' >> "$depfile" + rm -f "$tmpdepfile" + ;; + +hp2) + # The "hp" stanza above does not work with aCC (C++) and HP's ia64 + # compilers, which have integrated preprocessors. The correct option + # to use with these is +Maked; it writes dependencies to a file named + # 'foo.d', which lands next to the object file, wherever that + # happens to be. + # Much of this is similar to the tru64 case; see comments there. + set_dir_from "$object" + set_base_from "$object" + if test "$libtool" = yes; then + tmpdepfile1=$dir$base.d + tmpdepfile2=$dir.libs/$base.d + "$@" -Wc,+Maked + else + tmpdepfile1=$dir$base.d + tmpdepfile2=$dir$base.d + "$@" +Maked + fi + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile1" "$tmpdepfile2" + exit $stat + fi + + for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" + do + test -f "$tmpdepfile" && break + done + if test -f "$tmpdepfile"; then + sed -e "s,^.*\.[$lower]*:,$object:," "$tmpdepfile" > "$depfile" + # Add 'dependent.h:' lines. + sed -ne '2,${ + s/^ *// + s/ \\*$// + s/$/:/ + p + }' "$tmpdepfile" >> "$depfile" + else + make_dummy_depfile + fi + rm -f "$tmpdepfile" "$tmpdepfile2" + ;; + +tru64) + # The Tru64 compiler uses -MD to generate dependencies as a side + # effect. 'cc -MD -o foo.o ...' puts the dependencies into 'foo.o.d'. + # At least on Alpha/Redhat 6.1, Compaq CCC V6.2-504 seems to put + # dependencies in 'foo.d' instead, so we check for that too. + # Subdirectories are respected. + set_dir_from "$object" + set_base_from "$object" + + if test "$libtool" = yes; then + # Libtool generates 2 separate objects for the 2 libraries. These + # two compilations output dependencies in $dir.libs/$base.o.d and + # in $dir$base.o.d. We have to check for both files, because + # one of the two compilations can be disabled. We should prefer + # $dir$base.o.d over $dir.libs/$base.o.d because the latter is + # automatically cleaned when .libs/ is deleted, while ignoring + # the former would cause a distcleancheck panic. + tmpdepfile1=$dir$base.o.d # libtool 1.5 + tmpdepfile2=$dir.libs/$base.o.d # Likewise. + tmpdepfile3=$dir.libs/$base.d # Compaq CCC V6.2-504 + "$@" -Wc,-MD + else + tmpdepfile1=$dir$base.d + tmpdepfile2=$dir$base.d + tmpdepfile3=$dir$base.d + "$@" -MD + fi + + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" + exit $stat + fi + + for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" + do + test -f "$tmpdepfile" && break + done + # Same post-processing that is required for AIX mode. + aix_post_process_depfile + ;; + +msvc7) + if test "$libtool" = yes; then + showIncludes=-Wc,-showIncludes + else + showIncludes=-showIncludes + fi + "$@" $showIncludes > "$tmpdepfile" + stat=$? + grep -v '^Note: including file: ' "$tmpdepfile" + if test $stat -ne 0; then + rm -f "$tmpdepfile" + exit $stat + fi + rm -f "$depfile" + echo "$object : \\" > "$depfile" + # The first sed program below extracts the file names and escapes + # backslashes for cygpath. The second sed program outputs the file + # name when reading, but also accumulates all include files in the + # hold buffer in order to output them again at the end. This only + # works with sed implementations that can handle large buffers. + sed < "$tmpdepfile" -n ' +/^Note: including file: *\(.*\)/ { + s//\1/ + s/\\/\\\\/g + p +}' | $cygpath_u | sort -u | sed -n ' +s/ /\\ /g +s/\(.*\)/'"$tab"'\1 \\/p +s/.\(.*\) \\/\1:/ +H +$ { + s/.*/'"$tab"'/ + G + p +}' >> "$depfile" + echo >> "$depfile" # make sure the fragment doesn't end with a backslash + rm -f "$tmpdepfile" + ;; + +msvc7msys) + # This case exists only to let depend.m4 do its work. It works by + # looking at the text of this script. This case will never be run, + # since it is checked for above. + exit 1 + ;; + +#nosideeffect) + # This comment above is used by automake to tell side-effect + # dependency tracking mechanisms from slower ones. + +dashmstdout) + # Important note: in order to support this mode, a compiler *must* + # always write the preprocessed file to stdout, regardless of -o. + "$@" || exit $? + + # Remove the call to Libtool. + if test "$libtool" = yes; then + while test "X$1" != 'X--mode=compile'; do + shift + done + shift + fi + + # Remove '-o $object'. + IFS=" " + for arg + do + case $arg in + -o) + shift + ;; + $object) + shift + ;; + *) + set fnord "$@" "$arg" + shift # fnord + shift # $arg + ;; + esac + done + + test -z "$dashmflag" && dashmflag=-M + # Require at least two characters before searching for ':' + # in the target name. This is to cope with DOS-style filenames: + # a dependency such as 'c:/foo/bar' could be seen as target 'c' otherwise. + "$@" $dashmflag | + sed "s|^[$tab ]*[^:$tab ][^:][^:]*:[$tab ]*|$object: |" > "$tmpdepfile" + rm -f "$depfile" + cat < "$tmpdepfile" > "$depfile" + # Some versions of the HPUX 10.20 sed can't process this sed invocation + # correctly. Breaking it into two sed invocations is a workaround. + tr ' ' "$nl" < "$tmpdepfile" \ + | sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' \ + | sed -e 's/$/ :/' >> "$depfile" + rm -f "$tmpdepfile" + ;; + +dashXmstdout) + # This case only exists to satisfy depend.m4. It is never actually + # run, as this mode is specially recognized in the preamble. + exit 1 + ;; + +makedepend) + "$@" || exit $? + # Remove any Libtool call + if test "$libtool" = yes; then + while test "X$1" != 'X--mode=compile'; do + shift + done + shift + fi + # X makedepend + shift + cleared=no eat=no + for arg + do + case $cleared in + no) + set ""; shift + cleared=yes ;; + esac + if test $eat = yes; then + eat=no + continue + fi + case "$arg" in + -D*|-I*) + set fnord "$@" "$arg"; shift ;; + # Strip any option that makedepend may not understand. Remove + # the object too, otherwise makedepend will parse it as a source file. + -arch) + eat=yes ;; + -*|$object) + ;; + *) + set fnord "$@" "$arg"; shift ;; + esac + done + obj_suffix=`echo "$object" | sed 's/^.*\././'` + touch "$tmpdepfile" + ${MAKEDEPEND-makedepend} -o"$obj_suffix" -f"$tmpdepfile" "$@" + rm -f "$depfile" + # makedepend may prepend the VPATH from the source file name to the object. + # No need to regex-escape $object, excess matching of '.' is harmless. + sed "s|^.*\($object *:\)|\1|" "$tmpdepfile" > "$depfile" + # Some versions of the HPUX 10.20 sed can't process the last invocation + # correctly. Breaking it into two sed invocations is a workaround. + sed '1,2d' "$tmpdepfile" \ + | tr ' ' "$nl" \ + | sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' \ + | sed -e 's/$/ :/' >> "$depfile" + rm -f "$tmpdepfile" "$tmpdepfile".bak + ;; + +cpp) + # Important note: in order to support this mode, a compiler *must* + # always write the preprocessed file to stdout. + "$@" || exit $? + + # Remove the call to Libtool. + if test "$libtool" = yes; then + while test "X$1" != 'X--mode=compile'; do + shift + done + shift + fi + + # Remove '-o $object'. + IFS=" " + for arg + do + case $arg in + -o) + shift + ;; + $object) + shift + ;; + *) + set fnord "$@" "$arg" + shift # fnord + shift # $arg + ;; + esac + done + + "$@" -E \ + | sed -n -e '/^# [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' \ + -e '/^#line [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' \ + | sed '$ s: \\$::' > "$tmpdepfile" + rm -f "$depfile" + echo "$object : \\" > "$depfile" + cat < "$tmpdepfile" >> "$depfile" + sed < "$tmpdepfile" '/^$/d;s/^ //;s/ \\$//;s/$/ :/' >> "$depfile" + rm -f "$tmpdepfile" + ;; + +msvisualcpp) + # Important note: in order to support this mode, a compiler *must* + # always write the preprocessed file to stdout. + "$@" || exit $? + + # Remove the call to Libtool. + if test "$libtool" = yes; then + while test "X$1" != 'X--mode=compile'; do + shift + done + shift + fi + + IFS=" " + for arg + do + case "$arg" in + -o) + shift + ;; + $object) + shift + ;; + "-Gm"|"/Gm"|"-Gi"|"/Gi"|"-ZI"|"/ZI") + set fnord "$@" + shift + shift + ;; + *) + set fnord "$@" "$arg" + shift + shift + ;; + esac + done + "$@" -E 2>/dev/null | + sed -n '/^#line [0-9][0-9]* "\([^"]*\)"/ s::\1:p' | $cygpath_u | sort -u > "$tmpdepfile" + rm -f "$depfile" + echo "$object : \\" > "$depfile" + sed < "$tmpdepfile" -n -e 's% %\\ %g' -e '/^\(.*\)$/ s::'"$tab"'\1 \\:p' >> "$depfile" + echo "$tab" >> "$depfile" + sed < "$tmpdepfile" -n -e 's% %\\ %g' -e '/^\(.*\)$/ s::\1\::p' >> "$depfile" + rm -f "$tmpdepfile" + ;; + +msvcmsys) + # This case exists only to let depend.m4 do its work. It works by + # looking at the text of this script. This case will never be run, + # since it is checked for above. + exit 1 + ;; + +none) + exec "$@" + ;; + +*) + echo "Unknown depmode $depmode" 1>&2 + exit 1 + ;; +esac + +exit 0 + +# Local Variables: +# mode: shell-script +# sh-indentation: 2 +# eval: (add-hook 'before-save-hook 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC0" +# time-stamp-end: "; # UTC" +# End: diff --git a/Ipopt-3.13.4/doc/Doxyfile.in b/Ipopt-3.13.4/doc/Doxyfile.in new file mode 100644 index 000000000..aefd02224 --- /dev/null +++ b/Ipopt-3.13.4/doc/Doxyfile.in @@ -0,0 +1,2529 @@ +# Doxyfile 1.8.18 + +# This file describes the settings to be used by the documentation system +# doxygen (www.doxygen.org) for a project. +# +# All text after a double hash (##) is considered a comment and is placed in +# front of the TAG it is preceding. +# +# All text after a single hash (#) is considered a comment and will be ignored. +# The format is: +# TAG = value [value, ...] +# For lists, items can also be appended using: +# TAG += value [value, ...] +# Values that contain spaces should be placed between quotes (\" \"). + +#--------------------------------------------------------------------------- +# Project related configuration options +#--------------------------------------------------------------------------- + +# This tag specifies the encoding used for all characters in the configuration +# file that follow. The default is UTF-8 which is also the encoding used for all +# text before the first occurrence of this tag. Doxygen uses libiconv (or the +# iconv built into libc) for the transcoding. See +# https://www.gnu.org/software/libiconv/ for the list of possible encodings. +# The default value is: UTF-8. + +DOXYFILE_ENCODING = UTF-8 + +# The PROJECT_NAME tag is a single word (or a sequence of words surrounded by +# double-quotes, unless you are using Doxywizard) that should identify the +# project for which the documentation is generated. This name is used in the +# title of most generated pages and in a few other places. +# The default value is: My Project. + +PROJECT_NAME = @PACKAGE_NAME@ + +# The PROJECT_NUMBER tag can be used to enter a project or revision number. This +# could be handy for archiving the generated documentation or if some version +# control system is used. + +PROJECT_NUMBER = @PACKAGE_VERSION@ + +# Using the PROJECT_BRIEF tag one can provide an optional one line description +# for a project that appears at the top of each page and should give viewer a +# quick idea about the purpose of the project. Keep the description short. + +PROJECT_BRIEF = + +# With the PROJECT_LOGO tag one can specify a logo or an icon that is included +# in the documentation. The maximum height of the logo should not exceed 55 +# pixels and the maximum width should not exceed 200 pixels. Doxygen will copy +# the logo to the output directory. + +PROJECT_LOGO = + +# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path +# into which the generated documentation will be written. If a relative path is +# entered, it will be relative to the location where doxygen was started. If +# left blank the current directory will be used. + +OUTPUT_DIRECTORY = + +# If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub- +# directories (in 2 levels) under the output directory of each output format and +# will distribute the generated files over these directories. Enabling this +# option can be useful when feeding doxygen a huge amount of source files, where +# putting all generated files in the same directory would otherwise causes +# performance problems for the file system. +# The default value is: NO. + +CREATE_SUBDIRS = NO + +# If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII +# characters to appear in the names of generated files. If set to NO, non-ASCII +# characters will be escaped, for example _xE3_x81_x84 will be used for Unicode +# U+3044. +# The default value is: NO. + +ALLOW_UNICODE_NAMES = NO + +# The OUTPUT_LANGUAGE tag is used to specify the language in which all +# documentation generated by doxygen is written. Doxygen will use this +# information to generate all constant output in the proper language. +# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese, +# Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States), +# Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian, +# Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages), +# Korean, Korean-en (Korean with English messages), Latvian, Lithuanian, +# Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian, +# Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish, +# Ukrainian and Vietnamese. +# The default value is: English. + +OUTPUT_LANGUAGE = English + +# The OUTPUT_TEXT_DIRECTION tag is used to specify the direction in which all +# documentation generated by doxygen is written. Doxygen will use this +# information to generate all generated output in the proper direction. +# Possible values are: None, LTR, RTL and Context. +# The default value is: None. + +OUTPUT_TEXT_DIRECTION = None + +# If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member +# descriptions after the members that are listed in the file and class +# documentation (similar to Javadoc). Set to NO to disable this. +# The default value is: YES. + +BRIEF_MEMBER_DESC = YES + +# If the REPEAT_BRIEF tag is set to YES, doxygen will prepend the brief +# description of a member or function before the detailed description +# +# Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the +# brief descriptions will be completely suppressed. +# The default value is: YES. + +REPEAT_BRIEF = YES + +# This tag implements a quasi-intelligent brief description abbreviator that is +# used to form the text in various listings. Each string in this list, if found +# as the leading text of the brief description, will be stripped from the text +# and the result, after processing the whole list, is used as the annotated +# text. Otherwise, the brief description is used as-is. If left blank, the +# following values are used ($name is automatically replaced with the name of +# the entity):The $name class, The $name widget, The $name file, is, provides, +# specifies, contains, represents, a, an and the. + +ABBREVIATE_BRIEF = + +# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then +# doxygen will generate a detailed section even if there is only a brief +# description. +# The default value is: NO. + +ALWAYS_DETAILED_SEC = NO + +# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all +# inherited members of a class in the documentation of that class as if those +# members were ordinary class members. Constructors, destructors and assignment +# operators of the base classes will not be shown. +# The default value is: NO. + +INLINE_INHERITED_MEMB = NO + +# If the FULL_PATH_NAMES tag is set to YES, doxygen will prepend the full path +# before files name in the file list and in the header files. If set to NO the +# shortest path that makes the file name unique will be used +# The default value is: YES. + +FULL_PATH_NAMES = YES + +# The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path. +# Stripping is only done if one of the specified strings matches the left-hand +# part of the path. The tag can be used to show relative paths in the file list. +# If left blank the directory from which doxygen is run is used as the path to +# strip. +# +# Note that you can specify absolute paths here, but also relative paths, which +# will be relative from the directory where doxygen is started. +# This tag requires that the tag FULL_PATH_NAMES is set to YES. + +STRIP_FROM_PATH = "@abs_top_srcdir@" + +# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the +# path mentioned in the documentation of a class, which tells the reader which +# header file to include in order to use a class. If left blank only the name of +# the header file containing the class definition is used. Otherwise one should +# specify the list of include paths that are normally passed to the compiler +# using the -I flag. + +STRIP_FROM_INC_PATH = + +# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but +# less readable) file names. This can be useful is your file systems doesn't +# support long names like on DOS, Mac, or CD-ROM. +# The default value is: NO. + +SHORT_NAMES = NO + +# If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the +# first line (until the first dot) of a Javadoc-style comment as the brief +# description. If set to NO, the Javadoc-style will behave just like regular Qt- +# style comments (thus requiring an explicit @brief command for a brief +# description.) +# The default value is: NO. + +JAVADOC_AUTOBRIEF = YES + +# If the JAVADOC_BANNER tag is set to YES then doxygen will interpret a line +# such as +# /*************** +# as being the beginning of a Javadoc-style comment "banner". If set to NO, the +# Javadoc-style will behave just like regular comments and it will not be +# interpreted by doxygen. +# The default value is: NO. + +JAVADOC_BANNER = NO + +# If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first +# line (until the first dot) of a Qt-style comment as the brief description. If +# set to NO, the Qt-style will behave just like regular Qt-style comments (thus +# requiring an explicit \brief command for a brief description.) +# The default value is: NO. + +QT_AUTOBRIEF = YES + +# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a +# multi-line C++ special comment block (i.e. a block of //! or /// comments) as +# a brief description. This used to be the default behavior. The new default is +# to treat a multi-line C++ comment block as a detailed description. Set this +# tag to YES if you prefer the old behavior instead. +# +# Note that setting this tag to YES also means that rational rose comments are +# not recognized any more. +# The default value is: NO. + +MULTILINE_CPP_IS_BRIEF = NO + +# If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the +# documentation from any documented member that it re-implements. +# The default value is: YES. + +INHERIT_DOCS = YES + +# If the SEPARATE_MEMBER_PAGES tag is set to YES then doxygen will produce a new +# page for each member. If set to NO, the documentation of a member will be part +# of the file/class/namespace that contains it. +# The default value is: NO. + +SEPARATE_MEMBER_PAGES = NO + +# The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen +# uses this value to replace tabs by spaces in code fragments. +# Minimum value: 1, maximum value: 16, default value: 4. + +TAB_SIZE = 3 + +# This tag can be used to specify a number of aliases that act as commands in +# the documentation. An alias has the form: +# name=value +# For example adding +# "sideeffect=@par Side Effects:\n" +# will allow you to put the command \sideeffect (or @sideeffect) in the +# documentation, which will result in a user-defined paragraph with heading +# "Side Effects:". You can put \n's in the value part of an alias to insert +# newlines (in the resulting output). You can put ^^ in the value part of an +# alias to insert a newline as if a physical newline was in the original file. +# When you need a literal { or } or , in the value part of an alias you have to +# escape them by means of a backslash (\), this can lead to conflicts with the +# commands \{ and \} for these it is advised to use the version @{ and @} or use +# a double escape (\\{ and \\}) + +ALIASES = "Ipopt=`%Ipopt`" \ + "value=" + +# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources +# only. Doxygen will then generate output that is more tailored for C. For +# instance, some of the names that are used will be different. The list of all +# members will be omitted, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_FOR_C = NO + +# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or +# Python sources only. Doxygen will then generate output that is more tailored +# for that language. For instance, namespaces will be presented as packages, +# qualified scopes will look different, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_JAVA = NO + +# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran +# sources. Doxygen will then generate output that is tailored for Fortran. +# The default value is: NO. + +OPTIMIZE_FOR_FORTRAN = NO + +# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL +# sources. Doxygen will then generate output that is tailored for VHDL. +# The default value is: NO. + +OPTIMIZE_OUTPUT_VHDL = NO + +# Set the OPTIMIZE_OUTPUT_SLICE tag to YES if your project consists of Slice +# sources only. Doxygen will then generate output that is more tailored for that +# language. For instance, namespaces will be presented as modules, types will be +# separated into more groups, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_SLICE = NO + +# Doxygen selects the parser to use depending on the extension of the files it +# parses. With this tag you can assign which parser to use for a given +# extension. Doxygen has a built-in mapping, but you can override or extend it +# using this tag. The format is ext=language, where ext is a file extension, and +# language is one of the parsers supported by doxygen: IDL, Java, JavaScript, +# Csharp (C#), C, C++, D, PHP, md (Markdown), Objective-C, Python, Slice, VHDL, +# Fortran (fixed format Fortran: FortranFixed, free formatted Fortran: +# FortranFree, unknown formatted Fortran: Fortran. In the later case the parser +# tries to guess whether the code is fixed or free formatted code, this is the +# default for Fortran type files). For instance to make doxygen treat .inc files +# as Fortran files (default is PHP), and .f files as C (default is Fortran), +# use: inc=Fortran f=C. +# +# Note: For files without extension you can use no_extension as a placeholder. +# +# Note that for custom extensions you also need to set FILE_PATTERNS otherwise +# the files are not read by doxygen. + +EXTENSION_MAPPING = + +# If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments +# according to the Markdown format, which allows for more readable +# documentation. See https://daringfireball.net/projects/markdown/ for details. +# The output of markdown processing is further processed by doxygen, so you can +# mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in +# case of backward compatibilities issues. +# The default value is: YES. + +MARKDOWN_SUPPORT = YES + +# When the TOC_INCLUDE_HEADINGS tag is set to a non-zero value, all headings up +# to that level are automatically included in the table of contents, even if +# they do not have an id attribute. +# Note: This feature currently applies only to Markdown headings. +# Minimum value: 0, maximum value: 99, default value: 5. +# This tag requires that the tag MARKDOWN_SUPPORT is set to YES. + +TOC_INCLUDE_HEADINGS = 0 + +# When enabled doxygen tries to link words that correspond to documented +# classes, or namespaces to their corresponding documentation. Such a link can +# be prevented in individual cases by putting a % sign in front of the word or +# globally by setting AUTOLINK_SUPPORT to NO. +# The default value is: YES. + +AUTOLINK_SUPPORT = YES + +# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want +# to include (a tag file for) the STL sources as input, then you should set this +# tag to YES in order to let doxygen match functions declarations and +# definitions whose arguments contain STL classes (e.g. func(std::string); +# versus func(std::string) {}). This also make the inheritance and collaboration +# diagrams that involve STL classes more complete and accurate. +# The default value is: NO. + +BUILTIN_STL_SUPPORT = NO + +# If you use Microsoft's C++/CLI language, you should set this option to YES to +# enable parsing support. +# The default value is: NO. + +CPP_CLI_SUPPORT = NO + +# Set the SIP_SUPPORT tag to YES if your project consists of sip (see: +# https://www.riverbankcomputing.com/software/sip/intro) sources only. Doxygen +# will parse them like normal C++ but will assume all classes use public instead +# of private inheritance when no explicit protection keyword is present. +# The default value is: NO. + +SIP_SUPPORT = NO + +# For Microsoft's IDL there are propget and propput attributes to indicate +# getter and setter methods for a property. Setting this option to YES will make +# doxygen to replace the get and set methods by a property in the documentation. +# This will only work if the methods are indeed getting or setting a simple +# type. If this is not the case, or you want to show the methods anyway, you +# should set this option to NO. +# The default value is: YES. + +IDL_PROPERTY_SUPPORT = YES + +# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC +# tag is set to YES then doxygen will reuse the documentation of the first +# member in the group (if any) for the other members of the group. By default +# all members of a group must be documented explicitly. +# The default value is: NO. + +DISTRIBUTE_GROUP_DOC = NO + +# If one adds a struct or class to a group and this option is enabled, then also +# any nested class or struct is added to the same group. By default this option +# is disabled and one has to add nested compounds explicitly via \ingroup. +# The default value is: NO. + +GROUP_NESTED_COMPOUNDS = NO + +# Set the SUBGROUPING tag to YES to allow class member groups of the same type +# (for instance a group of public functions) to be put as a subgroup of that +# type (e.g. under the Public Functions section). Set it to NO to prevent +# subgrouping. Alternatively, this can be done per class using the +# \nosubgrouping command. +# The default value is: YES. + +SUBGROUPING = YES + +# When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions +# are shown inside the group in which they are included (e.g. using \ingroup) +# instead of on a separate page (for HTML and Man pages) or section (for LaTeX +# and RTF). +# +# Note that this feature does not work in combination with +# SEPARATE_MEMBER_PAGES. +# The default value is: NO. + +INLINE_GROUPED_CLASSES = NO + +# When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions +# with only public data fields or simple typedef fields will be shown inline in +# the documentation of the scope in which they are defined (i.e. file, +# namespace, or group documentation), provided this scope is documented. If set +# to NO, structs, classes, and unions are shown on a separate page (for HTML and +# Man pages) or section (for LaTeX and RTF). +# The default value is: NO. + +INLINE_SIMPLE_STRUCTS = NO + +# When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or +# enum is documented as struct, union, or enum with the name of the typedef. So +# typedef struct TypeS {} TypeT, will appear in the documentation as a struct +# with name TypeT. When disabled the typedef will appear as a member of a file, +# namespace, or class. And the struct will be named TypeS. This can typically be +# useful for C code in case the coding convention dictates that all compound +# types are typedef'ed and only the typedef is referenced, never the tag name. +# The default value is: NO. + +TYPEDEF_HIDES_STRUCT = NO + +# The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This +# cache is used to resolve symbols given their name and scope. Since this can be +# an expensive process and often the same symbol appears multiple times in the +# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small +# doxygen will become slower. If the cache is too large, memory is wasted. The +# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range +# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536 +# symbols. At the end of a run doxygen will report the cache usage and suggest +# the optimal cache size from a speed point of view. +# Minimum value: 0, maximum value: 9, default value: 0. + +LOOKUP_CACHE_SIZE = 0 + +#--------------------------------------------------------------------------- +# Build related configuration options +#--------------------------------------------------------------------------- + +# If the EXTRACT_ALL tag is set to YES, doxygen will assume all entities in +# documentation are documented, even if no documentation was available. Private +# class members and static file members will be hidden unless the +# EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES. +# Note: This will also disable the warnings about undocumented members that are +# normally produced when WARNINGS is set to YES. +# The default value is: NO. + +EXTRACT_ALL = YES + +# If the EXTRACT_PRIVATE tag is set to YES, all private members of a class will +# be included in the documentation. +# The default value is: NO. + +EXTRACT_PRIVATE = YES + +# If the EXTRACT_PRIV_VIRTUAL tag is set to YES, documented private virtual +# methods of a class will be included in the documentation. +# The default value is: NO. + +EXTRACT_PRIV_VIRTUAL = NO + +# If the EXTRACT_PACKAGE tag is set to YES, all members with package or internal +# scope will be included in the documentation. +# The default value is: NO. + +EXTRACT_PACKAGE = NO + +# If the EXTRACT_STATIC tag is set to YES, all static members of a file will be +# included in the documentation. +# The default value is: NO. + +EXTRACT_STATIC = YES + +# If the EXTRACT_LOCAL_CLASSES tag is set to YES, classes (and structs) defined +# locally in source files will be included in the documentation. If set to NO, +# only classes defined in header files are included. Does not have any effect +# for Java sources. +# The default value is: YES. + +EXTRACT_LOCAL_CLASSES = NO + +# This flag is only useful for Objective-C code. If set to YES, local methods, +# which are defined in the implementation section but not in the interface are +# included in the documentation. If set to NO, only methods in the interface are +# included. +# The default value is: NO. + +EXTRACT_LOCAL_METHODS = NO + +# If this flag is set to YES, the members of anonymous namespaces will be +# extracted and appear in the documentation as a namespace called +# 'anonymous_namespace{file}', where file will be replaced with the base name of +# the file that contains the anonymous namespace. By default anonymous namespace +# are hidden. +# The default value is: NO. + +EXTRACT_ANON_NSPACES = YES + +# If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all +# undocumented members inside documented classes or files. If set to NO these +# members will be included in the various overviews, but no documentation +# section is generated. This option has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + +HIDE_UNDOC_MEMBERS = NO + +# If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all +# undocumented classes that are normally visible in the class hierarchy. If set +# to NO, these classes will be included in the various overviews. This option +# has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + +HIDE_UNDOC_CLASSES = NO + +# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend +# declarations. If set to NO, these declarations will be included in the +# documentation. +# The default value is: NO. + +HIDE_FRIEND_COMPOUNDS = NO + +# If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any +# documentation blocks found inside the body of a function. If set to NO, these +# blocks will be appended to the function's detailed documentation block. +# The default value is: NO. + +HIDE_IN_BODY_DOCS = NO + +# The INTERNAL_DOCS tag determines if documentation that is typed after a +# \internal command is included. If the tag is set to NO then the documentation +# will be excluded. Set it to YES to include the internal documentation. +# The default value is: NO. + +INTERNAL_DOCS = NO + +# If the CASE_SENSE_NAMES tag is set to NO then doxygen will only generate file +# names in lower-case letters. If set to YES, upper-case letters are also +# allowed. This is useful if you have classes or files whose names only differ +# in case and if your file system supports case sensitive file names. Windows +# (including Cygwin) ands Mac users are advised to set this option to NO. +# The default value is: system dependent. + +CASE_SENSE_NAMES = YES + +# If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with +# their full class and namespace scopes in the documentation. If set to YES, the +# scope will be hidden. +# The default value is: NO. + +HIDE_SCOPE_NAMES = NO + +# If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then doxygen will +# append additional text to a page's title, such as Class Reference. If set to +# YES the compound reference will be hidden. +# The default value is: NO. + +HIDE_COMPOUND_REFERENCE= NO + +# If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of +# the files that are included by a file in the documentation of that file. +# The default value is: YES. + +SHOW_INCLUDE_FILES = YES + +# If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each +# grouped member an include statement to the documentation, telling the reader +# which file to include in order to use the member. +# The default value is: NO. + +SHOW_GROUPED_MEMB_INC = NO + +# If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include +# files with double quotes in the documentation rather than with sharp brackets. +# The default value is: NO. + +FORCE_LOCAL_INCLUDES = NO + +# If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the +# documentation for inline members. +# The default value is: YES. + +INLINE_INFO = YES + +# If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the +# (detailed) documentation of file and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. +# The default value is: YES. + +SORT_MEMBER_DOCS = NO + +# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief +# descriptions of file, namespace and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. Note that +# this will also influence the order of the classes in the class list. +# The default value is: NO. + +SORT_BRIEF_DOCS = NO + +# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the +# (brief and detailed) documentation of class members so that constructors and +# destructors are listed first. If set to NO the constructors will appear in the +# respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS. +# Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief +# member documentation. +# Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting +# detailed member documentation. +# The default value is: NO. + +SORT_MEMBERS_CTORS_1ST = NO + +# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy +# of group names into alphabetical order. If set to NO the group names will +# appear in their defined order. +# The default value is: NO. + +SORT_GROUP_NAMES = NO + +# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by +# fully-qualified names, including namespaces. If set to NO, the class list will +# be sorted only by class name, not including the namespace part. +# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. +# Note: This option applies only to the class list, not to the alphabetical +# list. +# The default value is: NO. + +SORT_BY_SCOPE_NAME = NO + +# If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper +# type resolution of all parameters of a function it will reject a match between +# the prototype and the implementation of a member function even if there is +# only one candidate or it is obvious which candidate to choose by doing a +# simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still +# accept a match between prototype and implementation in such cases. +# The default value is: NO. + +STRICT_PROTO_MATCHING = NO + +# The GENERATE_TODOLIST tag can be used to enable (YES) or disable (NO) the todo +# list. This list is created by putting \todo commands in the documentation. +# The default value is: YES. + +GENERATE_TODOLIST = NO + +# The GENERATE_TESTLIST tag can be used to enable (YES) or disable (NO) the test +# list. This list is created by putting \test commands in the documentation. +# The default value is: YES. + +GENERATE_TESTLIST = NO + +# The GENERATE_BUGLIST tag can be used to enable (YES) or disable (NO) the bug +# list. This list is created by putting \bug commands in the documentation. +# The default value is: YES. + +GENERATE_BUGLIST = YES + +# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or disable (NO) +# the deprecated list. This list is created by putting \deprecated commands in +# the documentation. +# The default value is: YES. + +GENERATE_DEPRECATEDLIST= YES + +# The ENABLED_SECTIONS tag can be used to enable conditional documentation +# sections, marked by \if ... \endif and \cond +# ... \endcond blocks. + +ENABLED_SECTIONS = + +# The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the +# initial value of a variable or macro / define can have for it to appear in the +# documentation. If the initializer consists of more lines than specified here +# it will be hidden. Use a value of 0 to hide initializers completely. The +# appearance of the value of individual variables and macros / defines can be +# controlled using \showinitializer or \hideinitializer command in the +# documentation regardless of this setting. +# Minimum value: 0, maximum value: 10000, default value: 30. + +MAX_INITIALIZER_LINES = 30 + +# Set the SHOW_USED_FILES tag to NO to disable the list of files generated at +# the bottom of the documentation of classes and structs. If set to YES, the +# list will mention the files that were used to generate the documentation. +# The default value is: YES. + +SHOW_USED_FILES = YES + +# Set the SHOW_FILES tag to NO to disable the generation of the Files page. This +# will remove the Files entry from the Quick Index and from the Folder Tree View +# (if specified). +# The default value is: YES. + +SHOW_FILES = YES + +# Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces +# page. This will remove the Namespaces entry from the Quick Index and from the +# Folder Tree View (if specified). +# The default value is: YES. + +SHOW_NAMESPACES = NO + +# The FILE_VERSION_FILTER tag can be used to specify a program or script that +# doxygen should invoke to get the current version for each file (typically from +# the version control system). Doxygen will invoke the program by executing (via +# popen()) the command command input-file, where command is the value of the +# FILE_VERSION_FILTER tag, and input-file is the name of an input file provided +# by doxygen. Whatever the program writes to standard output is used as the file +# version. For an example see the documentation. + +FILE_VERSION_FILTER = + +# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed +# by doxygen. The layout file controls the global structure of the generated +# output files in an output format independent way. To create the layout file +# that represents doxygen's defaults, run doxygen with the -l option. You can +# optionally specify a file name after the option, if omitted DoxygenLayout.xml +# will be used as the name of the layout file. +# +# Note that if you run doxygen from a directory containing a file called +# DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE +# tag is left empty. + +LAYOUT_FILE = @abs_top_srcdir@/doc/layout.xml + +# The CITE_BIB_FILES tag can be used to specify one or more bib files containing +# the reference definitions. This must be a list of .bib files. The .bib +# extension is automatically appended if omitted. This requires the bibtex tool +# to be installed. See also https://en.wikipedia.org/wiki/BibTeX for more info. +# For LaTeX the style of the bibliography can be controlled using +# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the +# search path. See also \cite for info how to create references. + +CITE_BIB_FILES = @abs_top_srcdir@/doc/ipopt.bib + +#--------------------------------------------------------------------------- +# Configuration options related to warning and progress messages +#--------------------------------------------------------------------------- + +# The QUIET tag can be used to turn on/off the messages that are generated to +# standard output by doxygen. If QUIET is set to YES this implies that the +# messages are off. +# The default value is: NO. + +QUIET = YES + +# The WARNINGS tag can be used to turn on/off the warning messages that are +# generated to standard error (stderr) by doxygen. If WARNINGS is set to YES +# this implies that the warnings are on. +# +# Tip: Turn warnings on while writing the documentation. +# The default value is: YES. + +WARNINGS = YES + +# If the WARN_IF_UNDOCUMENTED tag is set to YES then doxygen will generate +# warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag +# will automatically be disabled. +# The default value is: YES. + +WARN_IF_UNDOCUMENTED = YES + +# If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for +# potential errors in the documentation, such as not documenting some parameters +# in a documented function, or documenting parameters that don't exist or using +# markup commands wrongly. +# The default value is: YES. + +WARN_IF_DOC_ERROR = YES + +# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that +# are documented, but have no documentation for their parameters or return +# value. If set to NO, doxygen will only warn about wrong or incomplete +# parameter documentation, but not about the absence of documentation. If +# EXTRACT_ALL is set to YES then this flag will automatically be disabled. +# The default value is: NO. + +WARN_NO_PARAMDOC = NO + +# If the WARN_AS_ERROR tag is set to YES then doxygen will immediately stop when +# a warning is encountered. +# The default value is: NO. + +WARN_AS_ERROR = NO + +# The WARN_FORMAT tag determines the format of the warning messages that doxygen +# can produce. The string should contain the $file, $line, and $text tags, which +# will be replaced by the file and line number from which the warning originated +# and the warning text. Optionally the format may contain $version, which will +# be replaced by the version of the file (if it could be obtained via +# FILE_VERSION_FILTER) +# The default value is: $file:$line: $text. + +WARN_FORMAT = "$file:$line: $text" + +# The WARN_LOGFILE tag can be used to specify a file to which warning and error +# messages should be written. If left blank the output is written to standard +# error (stderr). + +#WARN_LOGFILE = @coin_doxy_logname@ + +#--------------------------------------------------------------------------- +# Configuration options related to the input files +#--------------------------------------------------------------------------- + +# The INPUT tag is used to specify the files and/or directories that contain +# documented source files. You may enter file names like myfile.cpp or +# directories like /usr/src/myproject. Separate the files or directories with +# spaces. See also FILE_PATTERNS and EXTENSION_MAPPING +# Note: If this tag is empty the current directory is searched. + +INPUT = @abs_top_srcdir@/doc \ + @abs_top_srcdir@/src \ + @abs_top_srcdir@/contrib/sIPOPT/src \ + @abs_top_srcdir@/contrib/sIPOPT/AmplSolver + +# This tag can be used to specify the character encoding of the source files +# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses +# libiconv (or the iconv built into libc) for the transcoding. See the libiconv +# documentation (see: https://www.gnu.org/software/libiconv/) for the list of +# possible encodings. +# The default value is: UTF-8. + +INPUT_ENCODING = UTF-8 + +# If the value of the INPUT tag contains directories, you can use the +# FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and +# *.h) to filter out the source-files in the directories. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# read by doxygen. +# +# If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp, +# *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, +# *.hh, *.hxx, *.hpp, *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, +# *.m, *.markdown, *.md, *.mm, *.dox (to be provided as doxygen C comment), +# *.doc (to be provided as doxygen C comment), *.txt (to be provided as doxygen +# C comment), *.py, *.pyw, *.f90, *.f95, *.f03, *.f08, *.f18, *.f, *.for, *.vhd, +# *.vhdl, *.ucf, *.qsf and *.ice. + +FILE_PATTERNS = *.hpp \ + *.h \ + *.java \ + *.dox + +# The RECURSIVE tag can be used to specify whether or not subdirectories should +# be searched for input files as well. +# The default value is: NO. + +RECURSIVE = YES + +# The EXCLUDE tag can be used to specify files and/or directories that should be +# excluded from the INPUT source files. This way you can easily exclude a +# subdirectory from a directory tree whose root is specified with the INPUT tag. +# +# Note that relative paths are relative to the directory from which doxygen is +# run. + +EXCLUDE = + +# The EXCLUDE_SYMLINKS tag can be used to select whether or not files or +# directories that are symbolic links (a Unix file system feature) are excluded +# from the input. +# The default value is: NO. + +EXCLUDE_SYMLINKS = NO + +# If the value of the INPUT tag contains directories, you can use the +# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude +# certain files from those directories. +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories for example use the pattern */test/* + +EXCLUDE_PATTERNS = @coin_doxy_excludes@ + +# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names +# (namespaces, classes, functions, etc.) that should be excluded from the +# output. The symbol name can be a fully qualified name, a word, or if the +# wildcard * is used, a substring. Examples: ANamespace, AClass, +# AClass::ANamespace, ANamespace::*Test +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories use the pattern */test/* + +EXCLUDE_SYMBOLS = + +# The EXAMPLE_PATH tag can be used to specify one or more files or directories +# that contain example code fragments that are included (see the \include +# command). + +EXAMPLE_PATH = @abs_top_srcdir@/examples \ + @abs_top_srcdir@/src/Interfaces \ + @abs_top_srcdir@/ChangeLog \ + @abs_top_srcdir@/AUTHORS \ + @abs_top_srcdir@/LICENSE + +# If the value of the EXAMPLE_PATH tag contains directories, you can use the +# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and +# *.h) to filter out the source-files in the directories. If left blank all +# files are included. + +EXAMPLE_PATTERNS = + +# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be +# searched for input files to be used with the \include or \dontinclude commands +# irrespective of the value of the RECURSIVE tag. +# The default value is: NO. + +EXAMPLE_RECURSIVE = NO + +# The IMAGE_PATH tag can be used to specify one or more files or directories +# that contain images that are to be included in the documentation (see the +# \image command). + +IMAGE_PATH = + +# The INPUT_FILTER tag can be used to specify a program that doxygen should +# invoke to filter for each input file. Doxygen will invoke the filter program +# by executing (via popen()) the command: +# +# +# +# where is the value of the INPUT_FILTER tag, and is the +# name of an input file. Doxygen will then use the output that the filter +# program writes to standard output. If FILTER_PATTERNS is specified, this tag +# will be ignored. +# +# Note that the filter must not add or remove lines; it is applied before the +# code is scanned, but not when the output code is generated. If lines are added +# or removed, the anchors will not be placed correctly. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by doxygen. + +INPUT_FILTER = + +# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern +# basis. Doxygen will compare the file name with each pattern and apply the +# filter if there is a match. The filters are a list of the form: pattern=filter +# (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how +# filters are used. If the FILTER_PATTERNS tag is empty or if none of the +# patterns match the file name, INPUT_FILTER is applied. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by doxygen. + +FILTER_PATTERNS = + +# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using +# INPUT_FILTER) will also be used to filter the input files that are used for +# producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES). +# The default value is: NO. + +FILTER_SOURCE_FILES = NO + +# The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file +# pattern. A pattern will override the setting for FILTER_PATTERN (if any) and +# it is also possible to disable source filtering for a specific pattern using +# *.ext= (so without naming a filter). +# This tag requires that the tag FILTER_SOURCE_FILES is set to YES. + +FILTER_SOURCE_PATTERNS = + +# If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that +# is part of the input, its contents will be placed on the main page +# (index.html). This can be useful if you have a project on for instance GitHub +# and want to reuse the introduction page also for the doxygen output. + +USE_MDFILE_AS_MAINPAGE = + +#--------------------------------------------------------------------------- +# Configuration options related to source browsing +#--------------------------------------------------------------------------- + +# If the SOURCE_BROWSER tag is set to YES then a list of source files will be +# generated. Documented entities will be cross-referenced with these sources. +# +# Note: To get rid of all source code in the generated output, make sure that +# also VERBATIM_HEADERS is set to NO. +# The default value is: NO. + +SOURCE_BROWSER = YES + +# Setting the INLINE_SOURCES tag to YES will include the body of functions, +# classes and enums directly into the documentation. +# The default value is: NO. + +INLINE_SOURCES = NO + +# Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any +# special comment blocks from generated source code fragments. Normal C, C++ and +# Fortran comments will always remain visible. +# The default value is: YES. + +STRIP_CODE_COMMENTS = YES + +# If the REFERENCED_BY_RELATION tag is set to YES then for each documented +# entity all documented functions referencing it will be listed. +# The default value is: NO. + +REFERENCED_BY_RELATION = NO + +# If the REFERENCES_RELATION tag is set to YES then for each documented function +# all documented entities called/used by that function will be listed. +# The default value is: NO. + +REFERENCES_RELATION = NO + +# If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set +# to YES then the hyperlinks from functions in REFERENCES_RELATION and +# REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will +# link to the documentation. +# The default value is: YES. + +REFERENCES_LINK_SOURCE = YES + +# If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the +# source code will show a tooltip with additional information such as prototype, +# brief description and links to the definition and documentation. Since this +# will make the HTML file larger and loading of large files a bit slower, you +# can opt to disable this feature. +# The default value is: YES. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + +SOURCE_TOOLTIPS = YES + +# If the USE_HTAGS tag is set to YES then the references to source code will +# point to the HTML generated by the htags(1) tool instead of doxygen built-in +# source browser. The htags tool is part of GNU's global source tagging system +# (see https://www.gnu.org/software/global/global.html). You will need version +# 4.8.6 or higher. +# +# To use it do the following: +# - Install the latest version of global +# - Enable SOURCE_BROWSER and USE_HTAGS in the configuration file +# - Make sure the INPUT points to the root of the source tree +# - Run doxygen as normal +# +# Doxygen will invoke htags (and that will in turn invoke gtags), so these +# tools must be available from the command line (i.e. in the search path). +# +# The result: instead of the source browser generated by doxygen, the links to +# source code will now point to the output of htags. +# The default value is: NO. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + +USE_HTAGS = NO + +# If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a +# verbatim copy of the header file for each class for which an include is +# specified. Set to NO to disable this. +# See also: Section \class. +# The default value is: YES. + +VERBATIM_HEADERS = YES + +#--------------------------------------------------------------------------- +# Configuration options related to the alphabetical class index +#--------------------------------------------------------------------------- + +# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all +# compounds will be generated. Enable this if the project contains a lot of +# classes, structs, unions or interfaces. +# The default value is: YES. + +ALPHABETICAL_INDEX = YES + +# The COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns in +# which the alphabetical index list will be split. +# Minimum value: 1, maximum value: 20, default value: 5. +# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. + +COLS_IN_ALPHA_INDEX = 3 + +# In case all classes in a project start with a common prefix, all classes will +# be put under the same header in the alphabetical index. The IGNORE_PREFIX tag +# can be used to specify a prefix (or a list of prefixes) that should be ignored +# while generating the index headers. +# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. + +IGNORE_PREFIX = + +#--------------------------------------------------------------------------- +# Configuration options related to the HTML output +#--------------------------------------------------------------------------- + +# If the GENERATE_HTML tag is set to YES, doxygen will generate HTML output +# The default value is: YES. + +GENERATE_HTML = YES + +# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a +# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of +# it. +# The default directory is: html. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_OUTPUT = html + +# The HTML_FILE_EXTENSION tag can be used to specify the file extension for each +# generated HTML page (for example: .htm, .php, .asp). +# The default value is: .html. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FILE_EXTENSION = .html + +# The HTML_HEADER tag can be used to specify a user-defined HTML header file for +# each generated HTML page. If the tag is left blank doxygen will generate a +# standard header. +# +# To get valid HTML the header file that includes any scripts and style sheets +# that doxygen needs, which is dependent on the configuration options used (e.g. +# the setting GENERATE_TREEVIEW). It is highly recommended to start with a +# default header using +# doxygen -w html new_header.html new_footer.html new_stylesheet.css +# YourConfigFile +# and then modify the file new_header.html. See also section "Doxygen usage" +# for information on how to generate the default header that doxygen normally +# uses. +# Note: The header is subject to change so you typically have to regenerate the +# default header when upgrading to a newer version of doxygen. For a description +# of the possible markers and block names see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_HEADER = @abs_top_srcdir@/doc/header.html + +# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each +# generated HTML page. If the tag is left blank doxygen will generate a standard +# footer. See HTML_HEADER for more information on how to generate a default +# footer and what special commands can be used inside the footer. See also +# section "Doxygen usage" for information on how to generate the default footer +# that doxygen normally uses. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FOOTER = @abs_top_srcdir@/doc/footer.html + +# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style +# sheet that is used by each HTML page. It can be used to fine-tune the look of +# the HTML output. If left blank doxygen will generate a default style sheet. +# See also section "Doxygen usage" for information on how to generate the style +# sheet that doxygen normally uses. +# Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as +# it is more robust and this tag (HTML_STYLESHEET) will in the future become +# obsolete. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_STYLESHEET = @abs_top_srcdir@/doc/stylesheet.css + +# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined +# cascading style sheets that are included after the standard style sheets +# created by doxygen. Using this option one can overrule certain style aspects. +# This is preferred over using HTML_STYLESHEET since it does not replace the +# standard style sheet and is therefore more robust against future updates. +# Doxygen will copy the style sheet files to the output directory. +# Note: The order of the extra style sheet files is of importance (e.g. the last +# style sheet in the list overrules the setting of the previous ones in the +# list). For an example see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_STYLESHEET = + +# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or +# other source files which should be copied to the HTML output directory. Note +# that these files will be copied to the base HTML output directory. Use the +# $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these +# files. In the HTML_STYLESHEET file, use the file name only. Also note that the +# files will be copied as-is; there are no commands or markers available. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_FILES = + +# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen +# will adjust the colors in the style sheet and background images according to +# this color. Hue is specified as an angle on a colorwheel, see +# https://en.wikipedia.org/wiki/Hue for more information. For instance the value +# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 +# purple, and 360 is red again. +# Minimum value: 0, maximum value: 359, default value: 220. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_HUE = 220 + +# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors +# in the HTML output. For a value of 0 the output will use grayscales only. A +# value of 255 will produce the most vivid colors. +# Minimum value: 0, maximum value: 255, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_SAT = 100 + +# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the +# luminance component of the colors in the HTML output. Values below 100 +# gradually make the output lighter, whereas values above 100 make the output +# darker. The value divided by 100 is the actual gamma applied, so 80 represents +# a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not +# change the gamma. +# Minimum value: 40, maximum value: 240, default value: 80. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_GAMMA = 80 + +# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML +# page will contain the date and time when the page was generated. Setting this +# to YES can help to show when doxygen was last run and thus if the +# documentation is up to date. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_TIMESTAMP = YES + +# If the HTML_DYNAMIC_MENUS tag is set to YES then the generated HTML +# documentation will contain a main index with vertical navigation menus that +# are dynamically created via JavaScript. If disabled, the navigation index will +# consists of multiple levels of tabs that are statically embedded in every HTML +# page. Disable this option to support browsers that do not have JavaScript, +# like the Qt help browser. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_DYNAMIC_MENUS = YES + +# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML +# documentation will contain sections that can be hidden and shown after the +# page has loaded. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_DYNAMIC_SECTIONS = YES + +# With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries +# shown in the various tree structured indices initially; the user can expand +# and collapse entries dynamically later on. Doxygen will expand the tree to +# such a level that at most the specified number of entries are visible (unless +# a fully collapsed tree already exceeds this amount). So setting the number of +# entries 1 will produce a full collapsed tree by default. 0 is a special value +# representing an infinite number of entries and will result in a full expanded +# tree by default. +# Minimum value: 0, maximum value: 9999, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_INDEX_NUM_ENTRIES = 100 + +# If the GENERATE_DOCSET tag is set to YES, additional index files will be +# generated that can be used as input for Apple's Xcode 3 integrated development +# environment (see: https://developer.apple.com/xcode/), introduced with OSX +# 10.5 (Leopard). To create a documentation set, doxygen will generate a +# Makefile in the HTML output directory. Running make will produce the docset in +# that directory and running make install will install the docset in +# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at +# startup. See https://developer.apple.com/library/archive/featuredarticles/Doxy +# genXcode/_index.html for more information. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_DOCSET = NO + +# This tag determines the name of the docset feed. A documentation feed provides +# an umbrella under which multiple documentation sets from a single provider +# (such as a company or product suite) can be grouped. +# The default value is: Doxygen generated docs. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_FEEDNAME = "Doxygen generated docs" + +# This tag specifies a string that should uniquely identify the documentation +# set bundle. This should be a reverse domain-name style string, e.g. +# com.mycompany.MyDocSet. Doxygen will append .docset to the name. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_BUNDLE_ID = org.doxygen.Project + +# The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify +# the documentation publisher. This should be a reverse domain-name style +# string, e.g. com.mycompany.MyDocSet.documentation. +# The default value is: org.doxygen.Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_PUBLISHER_ID = org.doxygen.Publisher + +# The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher. +# The default value is: Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_PUBLISHER_NAME = Publisher + +# If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three +# additional HTML index files: index.hhp, index.hhc, and index.hhk. The +# index.hhp is a project file that can be read by Microsoft's HTML Help Workshop +# (see: https://www.microsoft.com/en-us/download/details.aspx?id=21138) on +# Windows. +# +# The HTML Help Workshop contains a compiler that can convert all HTML output +# generated by doxygen into a single compiled HTML file (.chm). Compiled HTML +# files are now used as the Windows 98 help format, and will replace the old +# Windows help format (.hlp) on all Windows platforms in the future. Compressed +# HTML files also contain an index, a table of contents, and you can search for +# words in the documentation. The HTML workshop also contains a viewer for +# compressed HTML files. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_HTMLHELP = NO + +# The CHM_FILE tag can be used to specify the file name of the resulting .chm +# file. You can add a path in front of the file if the result should not be +# written to the html output directory. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +CHM_FILE = + +# The HHC_LOCATION tag can be used to specify the location (absolute path +# including file name) of the HTML help compiler (hhc.exe). If non-empty, +# doxygen will try to run the HTML help compiler on the generated index.hhp. +# The file has to be specified with full path. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +HHC_LOCATION = + +# The GENERATE_CHI flag controls if a separate .chi index file is generated +# (YES) or that it should be included in the master .chm file (NO). +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +GENERATE_CHI = NO + +# The CHM_INDEX_ENCODING is used to encode HtmlHelp index (hhk), content (hhc) +# and project file content. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +CHM_INDEX_ENCODING = + +# The BINARY_TOC flag controls whether a binary table of contents is generated +# (YES) or a normal table of contents (NO) in the .chm file. Furthermore it +# enables the Previous and Next buttons. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +BINARY_TOC = NO + +# The TOC_EXPAND flag can be set to YES to add extra items for group members to +# the table of contents of the HTML help documentation and to the tree view. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +TOC_EXPAND = NO + +# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and +# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that +# can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help +# (.qch) of the generated HTML documentation. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_QHP = NO + +# If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify +# the file name of the resulting .qch file. The path specified is relative to +# the HTML output folder. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QCH_FILE = + +# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help +# Project output. For more information please see Qt Help Project / Namespace +# (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#namespace). +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_NAMESPACE = + +# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt +# Help Project output. For more information please see Qt Help Project / Virtual +# Folders (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#virtual- +# folders). +# The default value is: doc. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_VIRTUAL_FOLDER = doc + +# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom +# filter to add. For more information please see Qt Help Project / Custom +# Filters (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom- +# filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_CUST_FILTER_NAME = + +# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the +# custom filter to add. For more information please see Qt Help Project / Custom +# Filters (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom- +# filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_CUST_FILTER_ATTRS = + +# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this +# project's filter section matches. Qt Help Project / Filter Attributes (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#filter-attributes). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_SECT_FILTER_ATTRS = + +# The QHG_LOCATION tag can be used to specify the location of Qt's +# qhelpgenerator. If non-empty doxygen will try to run qhelpgenerator on the +# generated .qhp file. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHG_LOCATION = + +# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be +# generated, together with the HTML files, they form an Eclipse help plugin. To +# install this plugin and make it available under the help contents menu in +# Eclipse, the contents of the directory containing the HTML and XML files needs +# to be copied into the plugins directory of eclipse. The name of the directory +# within the plugins directory should be the same as the ECLIPSE_DOC_ID value. +# After copying Eclipse needs to be restarted before the help appears. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_ECLIPSEHELP = NO + +# A unique identifier for the Eclipse help plugin. When installing the plugin +# the directory name containing the HTML and XML files should also have this +# name. Each documentation set should have its own identifier. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES. + +ECLIPSE_DOC_ID = org.doxygen.Project + +# If you want full control over the layout of the generated HTML pages it might +# be necessary to disable the index and replace it with your own. The +# DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top +# of each HTML page. A value of NO enables the index and the value YES disables +# it. Since the tabs in the index contain the same information as the navigation +# tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +DISABLE_INDEX = YES + +# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index +# structure should be generated to display hierarchical information. If the tag +# value is set to YES, a side panel will be generated containing a tree-like +# index structure (just like the one that is generated for HTML Help). For this +# to work a browser that supports JavaScript, DHTML, CSS and frames is required +# (i.e. any modern browser). Windows users are probably better off using the +# HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can +# further fine-tune the look of the index. As an example, the default style +# sheet generated by doxygen has an example that shows how to put an image at +# the root of the tree instead of the PROJECT_NAME. Since the tree basically has +# the same information as the tab index, you could consider setting +# DISABLE_INDEX to YES when enabling this option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_TREEVIEW = YES + +# The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that +# doxygen will group on one line in the generated HTML documentation. +# +# Note that a value of 0 will completely suppress the enum values from appearing +# in the overview section. +# Minimum value: 0, maximum value: 20, default value: 4. +# This tag requires that the tag GENERATE_HTML is set to YES. + +ENUM_VALUES_PER_LINE = 4 + +# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used +# to set the initial width (in pixels) of the frame in which the tree is shown. +# Minimum value: 0, maximum value: 1500, default value: 250. +# This tag requires that the tag GENERATE_HTML is set to YES. + +TREEVIEW_WIDTH = 200 + +# If the EXT_LINKS_IN_WINDOW option is set to YES, doxygen will open links to +# external symbols imported via tag files in a separate window. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +EXT_LINKS_IN_WINDOW = NO + +# If the HTML_FORMULA_FORMAT option is set to svg, doxygen will use the pdf2svg +# tool (see https://github.com/dawbarton/pdf2svg) or inkscape (see +# https://inkscape.org) to generate formulas as SVG images instead of PNGs for +# the HTML output. These images will generally look nicer at scaled resolutions. +# Possible values are: png The default and svg Looks nicer but requires the +# pdf2svg tool. +# The default value is: png. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FORMULA_FORMAT = png + +# Use this tag to change the font size of LaTeX formulas included as images in +# the HTML documentation. When you change the font size after a successful +# doxygen run you need to manually remove any form_*.png images from the HTML +# output directory to force them to be regenerated. +# Minimum value: 8, maximum value: 50, default value: 10. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FORMULA_FONTSIZE = 11 + +# Use the FORMULA_TRANSPARENT tag to determine whether or not the images +# generated for formulas are transparent PNGs. Transparent PNGs are not +# supported properly for IE 6.0, but are supported on all modern browsers. +# +# Note that when changing this option you need to delete any form_*.png files in +# the HTML output directory before the changes have effect. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FORMULA_TRANSPARENT = YES + +# The FORMULA_MACROFILE can contain LaTeX \newcommand and \renewcommand commands +# to create new LaTeX commands to be used in formulas as building blocks. See +# the section "Including formulas" for details. + +FORMULA_MACROFILE = + +# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see +# https://www.mathjax.org) which uses client side JavaScript for the rendering +# instead of using pre-rendered bitmaps. Use this if you do not have LaTeX +# installed or if you want to formulas look prettier in the HTML output. When +# enabled you may also need to install MathJax separately and configure the path +# to it using the MATHJAX_RELPATH option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +USE_MATHJAX = YES + +# When MathJax is enabled you can set the default output format to be used for +# the MathJax output. See the MathJax site (see: +# http://docs.mathjax.org/en/latest/output.html) for more details. +# Possible values are: HTML-CSS (which is slower, but has the best +# compatibility), NativeMML (i.e. MathML) and SVG. +# The default value is: HTML-CSS. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_FORMAT = HTML-CSS + +# When MathJax is enabled you need to specify the location relative to the HTML +# output directory using the MATHJAX_RELPATH option. The destination directory +# should contain the MathJax.js script. For instance, if the mathjax directory +# is located at the same level as the HTML output directory, then +# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax +# Content Delivery Network so you can quickly see the result without installing +# MathJax. However, it is strongly recommended to install a local copy of +# MathJax from https://www.mathjax.org before deployment. +# The default value is: https://cdn.jsdelivr.net/npm/mathjax@2. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_RELPATH = https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5 + +# The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax +# extension names that should be enabled during MathJax rendering. For example +# MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_EXTENSIONS = + +# The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces +# of code that will be used on startup of the MathJax code. See the MathJax site +# (see: http://docs.mathjax.org/en/latest/output.html) for more details. For an +# example see the documentation. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_CODEFILE = + +# When the SEARCHENGINE tag is enabled doxygen will generate a search box for +# the HTML output. The underlying search engine uses javascript and DHTML and +# should work on any modern browser. Note that when using HTML help +# (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET) +# there is already a search function so this one should typically be disabled. +# For large projects the javascript based search engine can be slow, then +# enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to +# search using the keyboard; to jump to the search box use + S +# (what the is depends on the OS and browser, but it is typically +# , /